From: morioka Date: Tue, 10 Mar 1998 04:56:55 +0000 (+0000) Subject: tm 7.85. X-Git-Tag: tm7_85~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8b9c3576bf55a6d7317ceb5e199cf450c130887e;p=elisp%2Fapel.git tm 7.85. --- diff --git a/ChangeLog b/ChangeLog index 9080be6..c18a8be 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,58 @@ +Sun Sep 15 08:04:02 1996 MORIOKA Tomohiko + + * tl: Version 7.61.4 was released. + + * emu-x20.el: `code-converter-is-broken' was abolished. + +Sun Sep 15 07:55:48 1996 MORIOKA Tomohiko + + * TL-ELS (tl-modules): Don't use `running-xemacs-20'. + +Sun Sep 15 07:53:34 1996 MORIOKA Tomohiko + + * TL-ELS (tl-modules): Use variable `running-mule-merged-emacs' + and `running-xemacs-with-mule'. + +Sun Sep 15 07:49:19 1996 MORIOKA Tomohiko + + * emu-18.el (directory-files): redefine. + +Sun Sep 15 07:27:12 1996 MORIOKA Tomohiko + + * emu.el: Variable `running-xemacs-20' was abolished. + +Sun Sep 15 06:53:44 1996 MORIOKA Tomohiko + + * emu.el (running-mule-merged-emacs, running-xemacs-with-mule): + New variable. + +Sat Sep 14 07:57:51 1996 MORIOKA Tomohiko + + * emu-e20.el (string-to-char-list): New function. + +Sat Sep 14 07:44:35 1996 MORIOKA Tomohiko + + * TL-ELS (tl-modules): Add emu-e20 for mule merged EMACS. + + * emu.el: Use emu-e20 for mule merged EMACS. + + * emu-e20.el: New module for mule merged EMACS. + +Sat Sep 14 05:07:00 1996 MORIOKA Tomohiko + + * smiley-mule.el (smiley-face-bitmap-list): Use "(T_T" instead of + "(T_T)". + +Fri Sep 13 04:50:13 1996 MORIOKA Tomohiko + + * smiley-mule.el (smiley-face-bitmap-list): Use "(T_T)" instead of + "T_T". + +Wed Sep 11 03:47:49 1996 MORIOKA Tomohiko + + * smiley-mule.el (smiley-buffer): Don't ignore case. + + Sat Sep 7 17:22:15 1996 MORIOKA Tomohiko * tl: Version 7.61.3 was released. diff --git a/emu-18.el b/emu-18.el index aee6ede..4f40bfa 100644 --- a/emu-18.el +++ b/emu-18.el @@ -1,9 +1,9 @@ -;;; emu-18.el --- Emacs 19.* emulation module for Emacs 18.* +;;; emu-18.el --- EMACS 19.* emulation module for EMACS 18.* ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; Version: $Id: emu-18.el,v 7.22 1996/09/02 14:34:00 morioka Exp $ +;; Version: $Id: emu-18.el,v 7.24 1996/09/15 07:50:56 morioka Exp $ ;; Keywords: emulation, compatibility ;; This file is part of tl (Tiny Library). @@ -34,7 +34,7 @@ ;;; @ hook ;;; -;; These function are imported from Emacs 19.28. +;; These function are imported from EMACS 19.28. (defun add-hook (hook function &optional append) "Add to the value of HOOK the function FUNCTION. FUNCTION is not added if already present. @@ -45,7 +45,7 @@ FUNCTION is added at the end. HOOK should be a symbol, and FUNCTION may be any valid function. If HOOK is void, it is first set to nil. If HOOK's value is a single function, it is changed to a list of functions. -\[emu-18.el; Emacs 19 emulating function]" +\[emu-18.el; EMACS 19 emulating function]" (or (boundp hook) (set hook nil) ) @@ -75,7 +75,7 @@ function, it is changed to a list of functions. HOOK should be a symbol, and FUNCTION may be any valid function. If FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the list of hooks to run in HOOK, then nothing is done. See `add-hook'. -\[emu-18.el; Emacs 19 emulating function]" +\[emu-18.el; EMACS 19 emulating function]" (if (or (not (boundp hook)) ;unbound symbol, or (null (symbol-value hook)) ;value is nil, or (null function)) ;function is nil, then @@ -96,7 +96,7 @@ list of hooks to run in HOOK, then nothing is done. See `add-hook'. (defun member (elt list) "Return non-nil if ELT is an element of LIST. Comparison done with EQUAL. The value is actually the tail of LIST whose car is ELT. -\[emu-18.el; Emacs 19 emulating function]" +\[emu-18.el; EMACS 19 emulating function]" (while (and list (not (equal elt (car list)))) (setq list (cdr list))) list) @@ -108,7 +108,7 @@ If the first member of LIST is ELT, deleting it is not a side effect; it is simply using a different list. Therefore, write `(setq foo (delete element foo))' to be sure of changing the value of `foo'. -\[emu-18.el; Emacs 19 emulating function]" +\[emu-18.el; EMACS 19 emulating function]" (if (equal elt (car list)) (cdr list) (let ((rest list) @@ -128,13 +128,13 @@ to be sure of changing the value of `foo'. (defun defalias (sym newdef) "Set SYMBOL's function definition to NEWVAL, and return NEWVAL. Associates the function with the current load file, if any. -\[emu-18.el; Emacs 19 emulating function]" +\[emu-18.el; EMACS 19 emulating function]" (fset sym newdef) ) (defun byte-code-function-p (exp) "T if OBJECT is a byte-compiled function object. -\[emu-18.el; Emacs 19 emulating function]" +\[emu-18.el; EMACS 19 emulating function]" (and (consp exp) (let* ((rest (cdr (cdr exp))) elt) (if (stringp (car rest)) @@ -156,7 +156,7 @@ Associates the function with the current load file, if any. (defun make-directory-internal (dirname) "Create a directory. One argument, a file name string. -\[emu-18.el; Emacs 19 emulating function]" +\[emu-18.el; EMACS 19 emulating function]" (if (file-exists-p dirname) (error "Creating directory: %s is already exist" dirname) (if (not (= (call-process "mkdir" nil nil nil dirname) 0)) @@ -167,7 +167,7 @@ Associates the function with the current load file, if any. "Create the directory DIR and any nonexistent parent dirs. The second (optional) argument PARENTS says whether to create parent directories if they don't exist. -\[emu-18.el; Emacs 19 emulating function]" +\[emu-18.el; EMACS 19 emulating function]" (let ((len (length dir)) (p 0) p1 path) (catch 'tag @@ -205,7 +205,20 @@ to create parent directories if they don't exist. ancestor (concat "../" ancestor))) (concat ancestor (substring filename (match-end 0))))) +(or (fboundp 'si:directory-files) + (fset 'si:directory-files (symbol-function 'directory-files))) +(defun directory-files (directory &optional full match nosort) + "Return a list of names of files in DIRECTORY. +There are three optional arguments: +If FULL is non-nil, return absolute file names. Otherwise return names + that are relative to the specified directory. +If MATCH is non-nil, mention only file names that match the regexp MATCH. +If NOSORT is dummy for compatibility. +\[emu-18.el; EMACS 19 emulating function]" + (si:directory-files directory full match) + ) + ;;; @ mark ;;; diff --git a/emu-e20.el b/emu-e20.el new file mode 100644 index 0000000..4eb9f2d --- /dev/null +++ b/emu-e20.el @@ -0,0 +1,267 @@ +;;; emu-e20.el --- emu API implementation for mule merged EMACS + +;; Copyright (C) 1996 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Version: $Id: emu-e20.el,v 1.2 1996/09/14 07:57:51 morioka Exp $ +;; Keywords: emulation, compatibility, MULE + +;; This file is part of tl (Tiny Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with This program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +;;; @ version specific features +;;; + +(require 'emu-19) + + +;;; @ character set +;;; + +(defalias 'charset-columns 'charset-width) + + +;;; @ coding system +;;; + +(defconst *noconv* 'no-conversion) + +(defmacro as-binary-process (&rest body) + (` (let (selective-display ; Disable ^M to nl translation. + ;; Mule merged EMACS + default-process-coding-system + program-coding-system-alist) + (,@ body) + ))) + +(defalias 'set-process-input-coding-system 'set-process-coding-system) + + +;;; @ MIME charset +;;; + +(defvar charsets-mime-charset-alist + (list + (cons (list charset-ascii) 'us-ascii) + (cons (list charset-ascii charset-latin-1) 'iso-8859-1) + (cons (list charset-ascii charset-latin-2) 'iso-8859-2) + (cons (list charset-ascii charset-latin-3) 'iso-8859-3) + (cons (list charset-ascii charset-latin-4) 'iso-8859-4) +;;;(cons (list charset-ascii charset-cyrillic) 'iso-8859-5) + (cons (list charset-ascii charset-cyrillic) 'koi8-r) + (cons (list charset-ascii charset-arabic) 'iso-8859-6) + (cons (list charset-ascii charset-greek) 'iso-8859-7) + (cons (list charset-ascii charset-hebrew) 'iso-8859-8) + (cons (list charset-ascii charset-latin-5) 'iso-8859-9) + (cons (list charset-ascii + charset-japanese-jisx0201-roman + charset-japanese-jisx0208-1978 + charset-japanese-jisx0208) 'iso-2022-jp) + (cons (list charset-ascii charset-korean-ksc5601) 'euc-kr) + (cons (list charset-ascii charset-chinese-gb2312) 'gb2312) + (cons (list charset-ascii + charset-chinese-big5-1 + charset-chinese-big5-2) 'big5) + (cons (list charset-ascii + charset-latin-1 charset-greek + charset-japanese-jisx0201-roman + charset-japanese-jisx0208-1978 + charset-chinese-gb2312 + charset-japanese-jisx0208 + charset-korean-ksc5601 + charset-japanese-jisx0212) 'iso-2022-jp-2) + (cons (list charset-ascii + charset-latin-1 charset-greek + charset-japanese-jisx0201-roman + charset-japanese-jisx0208-1978 + charset-chinese-gb2312 + charset-japanese-jisx0208 + charset-korean-ksc5601 + charset-japanese-jisx0212 + charset-chinese-cns11643-1 + charset-chinese-cns11643-2) 'iso-2022-int-1) + (cons (list charset-ascii + charset-latin-1 charset-latin-2 + charset-cyrillic charset-greek + charset-japanese-jisx0201-roman + charset-japanese-jisx0208-1978 + charset-chinese-gb2312 + charset-japanese-jisx0208 + charset-korean-ksc5601 + charset-japanese-jisx0212 + charset-chinese-cns11643-1 + charset-chinese-cns11643-2 + charset-chinese-cns11643-3 + charset-chinese-cns11643-4 + charset-chinese-cns11643-5 + charset-chinese-cns11643-6 + charset-chinese-cns11643-7) 'iso-2022-int-1) + )) + +(defvar default-mime-charset 'x-ctext) + +(defvar mime-charset-coding-system-alist + '((x-ctext . coding-system-ctext) + (gb2312 . coding-system-euc-china) + (iso-2022-jp-2 . coding-system-iso-2022-ss2-7) + (shift_jis . coding-system-sjis) + )) + +(defun mime-charset-to-coding-system (charset) + (if (stringp charset) + (setq charset (intern (downcase charset))) + ) + (or (cdr (assq charset mime-charset-coding-system-alist)) + (let ((cs (intern (concat "coding-system-" (symbol-name charset))))) + (and (coding-system-p cs) cs) + ))) + +(defun detect-mime-charset-region (start end) + "Return MIME charset for region between START and END. [emu-e20.el]" + (charsets-to-mime-charset + (find-charset-in-string (buffer-substring start end)) + )) + +(defun encode-mime-charset-region (start end charset) + "Encode the text between START and END as MIME CHARSET. [emu-e20.el]" + (let ((cs (mime-charset-to-coding-system charset))) + (if cs + (encode-coding-region start end cs) + ))) + +(defun decode-mime-charset-region (start end charset) + "Decode the text between START and END as MIME CHARSET. [emu-e20.el]" + (let ((cs (mime-charset-to-coding-system charset))) + (if cs + (decode-coding-region start end cs) + ))) + +(defun encode-mime-charset-string (string charset) + "Encode the STRING as MIME CHARSET. [emu-e20.el]" + (let ((cs (mime-charset-to-coding-system charset))) + (if cs + (encode-coding-string string cs) + string))) + +(defun decode-mime-charset-string (string charset) + "Decode the STRING as MIME CHARSET. [emu-e20.el]" + (let ((cs (mime-charset-to-coding-system charset))) + (if cs + (decode-coding-string string cs) + string))) + + +;;; @ character +;;; + +(defalias 'char-length 'char-bytes) + +(defalias 'char-columns 'char-width) + + +;;; @ string +;;; + +(defalias 'string-columns 'string-width) + +(defun string-to-char-list (string) + "Return a list of which elements are characters in the STRING. +\[emu-e20.el; MULE 2.3 emulating function]" + (let* ((len (length string)) + (i 0) + l chr) + (while (< i len) + (setq chr (sref string i)) + (setq l (cons chr l)) + (setq i (+ i (char-bytes chr))) + ) + (nreverse l) + )) + +(defalias 'string-to-int-list 'string-to-char-list) + +(or (fboundp 'truncate-string) +;;; Imported from Mule-2.3 +(defun truncate-string (str width &optional start-column) + "Truncate STR to fit in WIDTH columns. +Optional non-nil arg START-COLUMN specifies the starting column. +\[emu-e20.el; MULE 2.3 emulating function]" + (or start-column + (setq start-column 0)) + (let ((max-width (string-width str)) + (len (length str)) + (from 0) + (column 0) + to-prev to ch) + (if (>= width max-width) + (setq width max-width)) + (if (>= start-column width) + "" + (while (< column start-column) + (setq ch (aref str from) + column (+ column (char-width ch)) + from (+ from (char-bytes ch)))) + (if (< width max-width) + (progn + (setq to from) + (while (<= column width) + (setq ch (aref str to) + column (+ column (char-width ch)) + to-prev to + to (+ to (char-bytes ch)))) + (setq to to-prev))) + (substring str from to)))) +;;; + ) + + +;;; @ regulation +;;; + +(defun regulate-latin-char (chr) + (cond ((and (<= ?Ａ chr)(<= chr ?Ｚ)) + (+ (- chr ?Ａ) ?A) + ) + ((and (<= ?ａ chr)(<= chr ?ｚ)) + (+ (- chr ?ａ) ?a) + ) + ((eq chr ?．) ?.) + ((eq chr ?，) ?,) + (t chr) + )) + +(defun regulate-latin-string (str) + (let ((len (length str)) + (i 0) + chr (dest "")) + (while (< i len) + (setq chr (sref str i)) + (setq dest (concat dest + (char-to-string (regulate-latin-char chr)))) + (setq i (+ i (char-bytes chr))) + ) + dest)) + + +;;; @ end +;;; + +(provide 'emu-e20) + +;;; emu-e20.el ends here diff --git a/emu-x20.el b/emu-x20.el index f60d3e3..cd31b15 100644 --- a/emu-x20.el +++ b/emu-x20.el @@ -1,30 +1,29 @@ -;;; ;;; emu-x20.el --- emu API implementation for XEmacs 20 with mule -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; Version: -;;; $Id: emu-x20.el,v 7.34 1996/07/22 17:48:45 morioka Exp $ -;;; Keywords: emulation, compatibility, Mule, XEmacs -;;; -;;; This file is part of tl (Tiny Library). -;;; -;;; This program is free software; you can redistribute it and/or -;;; modify it under the terms of the GNU General Public License as -;;; published by the Free Software Foundation; either version 2, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1995 Free Software Foundation, Inc. +;; Copyright (C) 1994,1995,1996 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko +;; Version: $Id: emu-x20.el,v 7.35 1996/09/15 08:04:02 morioka Exp $ +;; Keywords: emulation, compatibility, Mule, XEmacs + +;; This file is part of tl (Tiny Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with This program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + ;;; Code: (require 'cyrillic) @@ -93,42 +92,6 @@ in the region between START and END. (defconst *euc-kr* 'euc-kr) (defconst *koi8* 'koi8) -(defvar code-converter-is-broken - (and xemacs-beta-version (<= xemacs-beta-version 26))) - -(if code-converter-is-broken -(progn -;;; -(defun decode-coding-region (start end coding-system &optional buffer) - "Decode the text between START and END which is encoded in CODING-SYSTEM. -\[emu-x20.el; XEmacs 20 emulating function]" - (save-excursion - (if buffer - (set-buffer buffer) - ) - (save-restriction - (narrow-to-region start end) - (let ((process-output-coding-system 'noconv) - (process-input-coding-system coding-system)) - (call-process-region start end "cat" t t nil) - )))) - -(defun encode-coding-region (start end coding-system &optional buffer) - "Encode the text between START and END which is encoded in CODING-SYSTEM. -\[emu-x20.el; XEmacs 20 emulating function]" - (save-excursion - (if buffer - (set-buffer buffer) - ) - (save-restriction - (narrow-to-region start end) - (let ((process-output-coding-system coding-system) - (process-input-coding-system 'noconv)) - (call-process-region start end "cat" t t nil) - )))) -;;; -)) - (defmacro as-binary-process (&rest body) `(let (selective-display ; Disable ^M to nl translation. process-input-coding-system diff --git a/emu.el b/emu.el index 929655d..7f641a8 100644 --- a/emu.el +++ b/emu.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; Version: $Id: emu.el,v 7.26 1996/09/05 16:31:02 morioka Exp $ +;; Version: $Id: emu.el,v 7.30 1996/09/15 07:27:12 morioka Exp $ ;; Keywords: emulation, compatibility, NEmacs, MULE, XEmacs ;; This file is part of tl (Tiny Library). @@ -37,31 +37,42 @@ (defvar running-emacs-18 (<= emacs-major-version 18)) (defvar running-xemacs (string-match "XEmacs" emacs-version)) + +(defvar running-mule-merged-emacs (and (not (boundp 'MULE)) + (not running-xemacs) (featurep 'mule))) +(defvar running-xemacs-with-mule (and running-xemacs (featurep 'mule))) + +(defvar running-emacs-19 (and (not running-xemacs) (= emacs-major-version 19))) +(defvar running-emacs-19_29-or-later + (or (and running-emacs-19 (>= emacs-minor-version 29)) + (and (not running-xemacs)(>= emacs-major-version 20)))) + (defvar running-xemacs-19 (and running-xemacs (= emacs-major-version 19))) -(defvar running-xemacs-20 (and running-xemacs - (= emacs-major-version 20))) (defvar running-xemacs-20-or-later (and running-xemacs (>= emacs-major-version 20))) (defvar running-xemacs-19_14-or-later (or (and running-xemacs-19 (>= emacs-minor-version 14)) running-xemacs-20-or-later)) -(defvar running-emacs-19 (and (not running-xemacs) - (= emacs-major-version 19))) -(defvar running-emacs-19_29-or-later - (or (and running-emacs-19 (>= emacs-minor-version 29)) - (and (not running-xemacs)(>= emacs-major-version 20)))) -(cond ((boundp 'MULE) - (require 'emu-mule) +(cond (running-mule-merged-emacs + ;; for mule merged EMACS + (require 'emu-e20) ) - ((and running-xemacs-20 (featurep 'mule)) + (running-xemacs-with-mule + ;; for XEmacs/mule (require 'emu-x20) ) + ((boundp 'MULE) + ;; for MULE 1.* and 2.* + (require 'emu-mule) + ) ((boundp 'NEMACS) + ;; for NEmacs and NEpoch (require 'emu-nemacs) ) (t + ;; for EMACS 19 and XEmacs 19 (without mule) (require 'emu-e19) ))