--- /dev/null
+;;; -*-Emacs-Lisp-*-
+
+;; APEL-CFG: installation setting about APEL.
+
+;;; Code:
+
+(defvar default-load-path load-path)
+(setq load-path (cons (expand-file-name ".") load-path))
+(require 'install)
+
+
+;;; @ Please specify prefix of install directory.
+;;;
+
+;; Please specify install path prefix.
+;; If it is omitted, shared directory (maybe /usr/local is used).
+(defvar PREFIX install-prefix)
+;;(setq PREFIX "~/")
+
+;; Please specify emu prefix [optional]
+(setq EMU_PREFIX
+ (if (or (featurep 'xemacs)
+ (and (fboundp 'set-buffer-multibyte)
+ (subrp (symbol-function 'set-buffer-multibyte))))
+ "emu"
+ ""))
+
+;; Please specify prefix for ``apel'' [optional]
+(setq APEL_PREFIX "apel")
+
+\f
+
+;;; @ optional settings
+;;;
+
+(defvar VERSION_SPECIFIC_LISPDIR
+ (install-detect-elisp-directory PREFIX nil 'version-specific))
+
+(setq EMU_DIR (expand-file-name EMU_PREFIX VERSION_SPECIFIC_LISPDIR))
+
+;; It is generated by automatically. Please set variable `PREFIX'.
+;; If you don't like default directory tree, please set it.
+(defvar LISPDIR (install-detect-elisp-directory PREFIX))
+;; (setq install-default-elisp-directory "~/lib/emacs/lisp")
+
+(setq APEL_DIR (expand-file-name APEL_PREFIX LISPDIR))
+
+(defvar PACKAGEDIR
+ (if (boundp 'early-packages)
+ (let ((dirs (append (if early-package-load-path
+ early-packages)
+ (if late-package-load-path
+ late-packages)
+ (if last-package-load-path
+ last-packages)))
+ dir)
+ (while (not (file-exists-p
+ (setq dir (car dirs))))
+ (setq dirs (cdr dirs)))
+ dir)))
+
+;;; APEL-CFG ends here
--- /dev/null
+;;; -*-Emacs-Lisp-*-
+
+;; APEL-ELS: list of APEL modules to install
+
+;;; Code:
+
+(setq apel-modules '(alist calist
+ path-util filename install
+ mule-caesar
+
+ ;; [obsoleted modules] If you would like to
+ ;; install following, please activate them.
+
+ ;; atype file-detect
+ ))
+
+;;; APEL-ELS ends here
--- /dev/null
+;;; -*-Emacs-Lisp-*-
+
+;; APEL-MK: installer for APEL.
+
+;;; Code:
+
+(defun config-apel ()
+ (let (prefix lisp-dir version-specific-lisp-dir)
+ (and (setq prefix (car command-line-args-left))
+ (or (string-equal "NONE" prefix)
+ (defvar PREFIX prefix)
+ ))
+ (setq command-line-args-left (cdr command-line-args-left))
+ (and (setq lisp-dir (car command-line-args-left))
+ (or (string-equal "NONE" lisp-dir)
+ (defvar LISPDIR lisp-dir)
+ ))
+ (setq command-line-args-left (cdr command-line-args-left))
+ (and (setq version-specific-lisp-dir (car command-line-args-left))
+ (or (string-equal "NONE" version-specific-lisp-dir)
+ (progn
+ (defvar VERSION_SPECIFIC_LISPDIR version-specific-lisp-dir)
+ (princ (format "VERSION_SPECIFIC_LISPDIR=%s\n"
+ VERSION_SPECIFIC_LISPDIR)))
+ ))
+ (setq command-line-args-left (cdr command-line-args-left))
+ (load-file "APEL-CFG")
+ (or (boundp 'apel-modules)
+ (load-file "APEL-ELS")
+ )
+ (princ (format "PREFIX=%s\n" PREFIX))
+ ))
+
+(defun compile-apel ()
+ (config-apel)
+ (load "EMU-ELS")
+ (load-file "APEL-ELS")
+ (compile-elisp-modules emu-modules ".")
+ (compile-elisp-modules apel-modules ".")
+ )
+
+(defun install-apel ()
+ (compile-apel)
+ (install-elisp-modules emu-modules "." EMU_DIR)
+ (install-elisp-modules apel-modules "." APEL_DIR)
+ )
+
+(defun config-apel-package ()
+ (let (package-dir)
+ (and (setq package-dir (car command-line-args-left))
+ (or (string= "NONE" package-dir)
+ (defvar PACKAGEDIR package-dir)
+ ))
+ (setq command-line-args-left (cdr command-line-args-left))
+ (load-file "APEL-CFG")
+ (load-file "APEL-ELS")
+
+ (princ (format "PACKAGEDIR=%s\n" PACKAGEDIR))
+ ))
+
+(defun install-apel-package ()
+ (config-apel-package)
+ (load "EMU-ELS")
+
+ (compile-elisp-modules emu-modules ".")
+ (compile-elisp-modules apel-modules ".")
+
+ (let ((dir (expand-file-name APEL_PREFIX
+ (expand-file-name "lisp"
+ PACKAGEDIR))))
+ (install-elisp-modules emu-modules "." dir)
+ (install-elisp-modules apel-modules "." dir)
+
+ (setq autoload-package-name "apel")
+ (add-to-list 'command-line-args-left dir)
+ (batch-update-directory)
+
+ (add-to-list 'command-line-args-left dir)
+ (Custom-make-dependencies)
+
+ (byte-compile-file (expand-file-name "auto-autoloads.el" dir))
+ (byte-compile-file (expand-file-name "custom-load.el" dir))
+ ))
+
+(defun what-where-apel ()
+ (config-apel)
+ (load "EMU-ELS")
+ (princ (format "
+The files that belong to the EMU modules:
+ %s
+ -> %s
+
+The files that belong to the APEL modules:
+ %s
+ -> %s
+"
+ (mapconcat 'symbol-name emu-modules ", ")
+ EMU_DIR
+ (mapconcat 'symbol-name apel-modules ", ")
+ APEL_DIR)))
+
+;;; APEL-MK ends here
+1998-10-12 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 9.3 was released.
+
+1998-10-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * README.en: Add explanations about
+ `LISPDIR', `VERSION_SPECIFIC_LISPDIR' and `what-where'.
+
+ * Makefile (what-where): New target.
+ (install): Add new arg `VERSION_SPECIFIC_LISPDIR'.
+
+ * APEL-MK (what-where-apel): New function.
+ (config-apel): Refer to `VERSION_SPECIFIC_LISPDIR'.
+
+ * APEL-CFG (VERSION_SPECIFIC_LISPDIR): New variable.
+
+1998-10-12 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * README.en (load-path): Modify for Emacs 20.3.
+
+1998-10-11 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL-CFG (EMU_PREFIX): Use "emu" for Emacs 20.3 or later.
+
+ * EMU-ELS: Don't install pccl in anything older than XEmacs 21
+ with MULE.
+
+\f
+1998-10-10 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 9.2 was released.
+
+ * poem-xm.el (insert-file-contents-as-binary): New function.
+
+ * poem-20.el (write-region-as-binary): bind
+ `jka-compr-compression-info-list' with nil.
+ (insert-file-contents-as-binary): Change to alias of
+ `insert-file-contents-literally' for Emacs 20.
+
+\f
+1998-10-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 9.1 was released.
+
+1998-10-06 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mcs-e20.el, mcs-xm.el (coding-system-to-mime-charset): New
+ function.
+ (mime-charset-list): New implementation.
+
+ * Move `mime-charset-list' from mcs-20.el to mcs-e20.el and
+ mcs-xm.el.
+
+1998-10-01 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mcs-e20.el (charsets-mime-charset-alist): Use `gb2312' and
+ `big5' instead of `cn-gb-2312' and `cn-big5'.
+
+ * mcs-xm.el (charsets-mime-charset-alist): Use `gb2312' and `big5'
+ instead of `cn-gb-2312' and `cn-big5'.
+
+ * mcs-20.el (mime-charset-coding-system-alist): Add `cn-gb' to
+ default value.
+
+\f
+1998-09-22 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 9.0 was released.
+
+ * Delete EMU-CFG and EMU-MK because they have not been used.
+
+1998-09-22 Tanaka Akira <akr@jaist.ac.jp>
+
+ * README.en (What's APEL?): Add notice for broken.el.
+
+1998-09-22 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * README.en (What's APEL?): Modify for latest structure.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mcs-xm.el (charsets-mime-charset-alist): Comment out invalid
+ definition for iso-2022-int-1.
+
+1998-09-19 Tanaka Akira <akr@jaist.ac.jp>
+
+ * broken.el: New file.
+
+ * pccl.el (apel-broken-facility): Abolished
+ (apel-broken-p): Abolished
+
+ * EMU-ELS (emu-modules): Add 'broken.
+
+ * Makefile (elc): Do not remove emu*.elc.
+
+ * pccl-20.el: require 'broken.
+ (ccl-use-symbol-as-program): Abolished.
+ (ccl-accept-symbol-as-program): New facility.
+ (make-ccl-coding-system): Use `when-broken' to define.
+ (ccl-encoder-eof-block-is-broken): Abolished.
+ (ccl-decoder-eof-block-is-broken): Abolished.
+ (ccl-eof-block-is-broken): Abolished
+ (ccl-execute-eof-block-on-encoding-null): New facility.
+ (ccl-execute-eof-block-on-encoding-some): Ditto.
+ (ccl-execute-eof-block-on-decoding-null): Ditto.
+ (ccl-execute-eof-block-on-decoding-some): Ditto.
+ (ccl-execute-eof-block-on-encoding): Ditto.
+ (ccl-execute-eof-block-on-decoding): Ditto.
+ (ccl-execute-eof-block): Ditto.
+
+ * pccl-om.el: require 'broken.
+ (ccl-use-symbol-as-program): Abolished.
+ (ccl-accept-symbol-as-program): New facility.
+ (ccl-encoder-eof-block-is-broken): Abolished.
+ (ccl-decoder-eof-block-is-broken): Abolished.
+ (ccl-eof-block-is-broken): Abolished
+ (ccl-execute-eof-block-on-encoding-null): New facility.
+ (ccl-execute-eof-block-on-encoding-some): Ditto.
+ (ccl-execute-eof-block-on-decoding-null): Ditto.
+ (ccl-execute-eof-block-on-decoding-some): Ditto.
+ (ccl-execute-eof-block-on-encoding): Ditto.
+ (ccl-execute-eof-block-on-decoding): Ditto.
+ (ccl-execute-eof-block): Ditto.
+ (ccl-execute-on-string-ignore-contin): New facility.
+
+1998-09-18 Tanaka Akira <akr@jaist.ac.jp>
+
+ * pccl.el (apel-broken-facility): New function.
+ (apel-broken-p): New function.
+
+1998-09-18 Tanaka Akira <akr@jaist.ac.jp>
+
+ * pccl.el: Fix author.
+
+1998-09-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * pccl-om.el (make-ccl-coding-system): Enclose with
+ `eval-and-compile'.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poe.el (unless): New macro.
+
+ * emu.el: Define tl:overlay obsolete aliases for all emacsen.
+
+ * poem-nemacs.el (decode-coding-string): Regard integer as
+ coding-system.
+ (encode-coding-string): Likewise.
+ (decode-coding-region): Likewise.
+ (encode-coding-region): Likewise.
+
+ * poe-18.el (set-text-properties): New function.
+
+ * install.el (install-detect-elisp-directory): Fix problem on
+ Nemacs.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poem-ltn1.el (set-buffer-multibyte): Use `defun-maybe' instead
+ of `defmacro-maybe'.
+
+ * poem-e20_2.el (set-buffer-multibyte): Use `defun-maybe' instead
+ of `defsubst-maybe'.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * EMU-ELS: New implementation.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el, emu-mule.el, EMU-ELS: Move code about CCL from
+ emu-mule.el to pccl-om.el.
+
+ * pccl.el: New file.
+
+ * pccl.el: - Rename emu-e20.el to pccl-20.el.
+ - Move definition of emu-x20.el to pccl-20.el.
+ - Move code about CCL from emu-mule.el to pccl-om.el.
+
+ * pccl-om.el: New file (move code about CCL from emu-mule.el).
+
+ * pccl-20.el: New file (renamed from emu-e20.el; move definition
+ of emu-x20.el to pccl-20.el; abolish emu-x20.el).
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el, emu-x20.el, emu-e20.el: Move function `char-category'
+ from emu-e20.el and emu-x20.el to emu.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el, emu-nemacs.el, emu-latin1.el, EMU-ELS: Move definitions
+ of emu-nemacs.el and emu-latin1.el to emu.el; abolish
+ emu-nemacs.el and emu-latin1.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el: Modify conditions to load sub-modules.
+
+ * emu.el, emu-e20.el: Move alias
+ `insert-binary-file-contents-literally' from emu-e20.el to emu.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poem.el, emu.el: Move `string-as-unibyte',
+ `string-as-multibyte', `char-int', `int-char' and
+ `char-or-char-int-p' from emu.el to poem.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mcharset.el, emu.el: Move function `charsets-to-mime-charset'
+ from emu.el to mcharset.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el, emu-x20.el, emu-nemacs.el, emu-mule.el, emu-latin1.el,
+ emu-e20.el:
+ - Move `insert-binary-file-contents' from emu-e20.el,
+ emu-latin1.el, emu-mule.el, emu-nemacs.el and emu-x20.el to
+ emu.el.
+ - Move `insert-binary-file-contents-literally' from
+ emu-latin1.el, emu-mule.el, emu-nemacs.el and emu-x20.el to
+ emu.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poe-18.el (make-obsolete): New function.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el, EMU-ELS: Split code about MIME charset from emu to
+ mcharset.
+
+ * mcharset.el: New file.
+
+ * mcs-xm.el: New file (split code about MIME charset from
+ emu-x20.el).
+
+ * emu-x20.el: Split code about MIME charset to mcs-xm.el.
+
+ * mcs-om.el: New file (split code about MIME charset from
+ emu-mule.el).
+
+ * emu-mule.el: Split code about MIME charset to mcs-om.el.
+
+ * mcs-nemacs.el: New file (split code about MIME charset from
+ emu-nemacs.el).
+
+ * emu-nemacs.el: Split code about MIME charset to mcs-nemacs.el.
+
+ * mcs-ltn1.el: New file (split code about MIME charset from
+ emu-latin1.el).
+
+ * emu-latin1.el: Split code about MIME charset to mcs-latin1.el.
+
+ * mcs-e20.el: New file (split code about MIME charset from
+ emu-e20.el).
+
+ * emu-e20.el: Split code about MIME charset to mcs-e20.el.
+
+ * mcs-20.el: New file (renamed from emu-20.el).
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el, emu-20.el: Move constant `*noconv*' from emu-20.el to
+ emu.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el, EMU-ELS: Split core part about MULE from emu to poem.
+
+ * poem.el: New file.
+
+ * poem-e20_3.el: New file (renamed from emu-e20_3.el).
+
+ * poem-e20_2.el: New file (renamed from poem-e20_2.el).
+
+ * poem-xm.el: New file (split core part of MULE from emu-x20.el).
+
+ * emu-x20.el: Split core part of MULE to poem-xm.el.
+
+ * poem-om.el: New file (split core part of MULE from emu-mule.el).
+
+ * emu-mule.el: Split core part of MULE to poem-om.el.
+
+ * poem-ltn1.el: New file (split core part of MULE from
+ emu-latin1.el).
+
+ * emu-latin1.el: Split core part of MULE to poem-ltn1.el.
+
+ * poem-e20.el: New file (split core part of MULE from emu-e20.el).
+
+ * emu-e20.el: Split core part of MULE to poem-e20.el.
+
+ * poem-20.el: New file (split core part of MULE from emu-20.el).
+
+ * emu-20.el: Split core part of MULE to poem-20.el.
+
+ * poem-nemacs.el: New file (split core part of MULE from
+ emu-nemacs.el).
+
+ * emu-nemacs.el: Split core part of MULE to poem-nemacs.el; move
+ overlay emulation code of Nemacs to poe-18.el.
+
+ * poe-18.el: Move overlay emulation code of Nemacs from
+ emu-nemacs.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poe.el, emu.el: Move function `point-at-bol' and `point-at-eol'
+ from emu.el to poe.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el (point-at-bol): New function.
+ (point-at-eol): Use `line-end-position'.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poe.el (line-beginning-position): New function.
+ (line-end-position): New function.
+
+ * poe-xemacs.el (line-beginning-position): New alias.
+ (line-end-position): New alias.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poe.el, emu.el: Move function `functionp' from emu.el to poe.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poe.el, emu.el: Move Emacs 19.30 emulating definitions, Emacs
+ 19.31 emulating definitions and Emacs 20.1 emulating definitions
+ from emu.el to poe.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poe.el, emu.el: Move constant `emacs-minor-version', Emacs 19
+ emulating definitions and Emacs 19.29 emulating definitions from
+ emu.el to poe.el.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * poe.el: New file (split core part from emu.el).
+
+ * poe-xemacs.el: New file (renamed from emu-xemacs.el).
+
+ * poe-19.el: New file (renamed from emu-e19.el).
+
+ * poe-18.el: New file (renamed from emu-18.el).
+
+ * emu.el, emu-nemacs.el, emu-mule.el, emu-e20.el, EMU-ELS: modify
+ for new structure.
+
+1998-09-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el (make-ccl-coding-system): New function.
+
+1998-09-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emu-mule.el: Require `cyrillic' (suggested by MORIOKA-san).
+
+ * emu-mule.el (decode-mime-charset-region): Cope with non existent
+ coding systems if the third arg `lbt' has specified.
+ (decode-mime-charset-string): Likewise.
+
+\f
+1998-09-14 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.18 was released.
+
+ * Makefile (install-package): Don't depend on target `elc'.
+
+ * APEL-MK (install-apel-package): Compile emu-modules and
+ apel-modules.
+
+1998-09-13 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * Makefile: Abolish target `package'.
+ (install-package): Use `elc' instead of `package'.
+
+ * APEL-MK: Abolish function `compile-apel-package'.
+ (install-apel-package): Update auto-autoloads.el and
+ custom-load.el at target directory.
+
+1998-09-13 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * README.en (run in expanded place): fixed.
+ (install as a XEmacs package): New description.
+
+ * Makefile (XEMACS): New variable.
+ (PACKAGEDIR): New variable.
+ (package): New target.
+ (install-package): New target.
+
+ * APEL-MK (config-apel-package): New function.
+ (compile-apel-package): New function.
+ (install-apel-package): New function.
+
+ * APEL-CFG (PACKAGEDIR): New variable.
+
+1998-09-07 Tanaka Akira <akr@jaist.ac.jp>
+
+ * Makefile (elc): Ignore errors when removing emu*.elc.
+
+1998-09-01 Tanaka Akira <akr@jaist.ac.jp>
+
+ * emu-mule.el (ccl-execute-on-string): Fix arguments
+ order `status' and `string'.
+
+\f
+1998-08-31 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.17 was released.
+
+ * emu.el (with-temp-file): Must use old forms.
+
+1998-08-31 Katsumi Yamoaka <yamaoka@jpl.org>
+
+ * emu.el (with-temp-file): New macro (Emacs 20/XEmacs 20
+ emulating macro).
+
+1998-08-29 Tanaka Akira <akr@jaist.ac.jp>
+
+ * emu-e20.el: require 'ccl only for byte-compile time.
+
+1998-08-29 Tanaka Akira <akr@jaist.ac.jp>
+
+ * Makefile (elc): Remove emu*.elc to use newest emu by
+ intall.el.
+
+1998-08-29 Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+
+ * emu-e20.el (ccl-execute-on-string): Too few args.
+ (test-ccl-eof-block-cs): Revert existence checking.
+
+ * emu-e20_2.el (insert-file-contents-as-binary): Return value.
+ (insert-file-contents-as-raw-text): Ditto.
+
+ * emu-mule.el (insert-file-contents-as-raw-text): Return value.
+ (encode-coding-string): Check `coding-system' is non-nil.
+ (decode-coding-string): Ditto.
+ (insert-file-contents-as-binary): Use `as-binary-input-file'.
+ (insert-binary-file-contents-literally): Ditto.
+ (write-region-as-binary): Use `as-binary-output-file'.
+ (write-region-as-raw-text-CRLF): Definition for Emacs 19.28.
+ (write-region-as-mime-charset): Ditto.
+ (mime-charset-to-coding-system): New implementation.
+
+ (ccl-use-symbol-as-program): New constant.
+ (ccl-encoder-eof-block-is-broken): New constant.
+ (ccl-decoder-eof-block-is-broken): New constant.
+ (ccl-eof-block-is-broken): New constant.
+ (make-ccl-coding-system): New function.
+ (ccl-execute): Emacs 20.3 emulating function.
+ (ccl-execute-on-string): Emacs 20.3 emulating function.
+
+ * emu-nemacs.el (write-region-as-binary): Use
+ `as-binary-output-file'
+ (write-region-as-raw-text-CRLF): Ditto.
+ (insert-file-contents-as-binary): Use `as-binary-input-file'.
+ (insert-binary-file-contents-literally): Ditto.
+ (insert-file-contents-as-raw-text): Ditto.
+
+ * emu.el (last): Emacs 20 emulation function.
+ (butlast), (nbutlast): CL emulation functions.
+
+1998-08-27 Tanaka Akira <akr@jaist.ac.jp>
+
+ * emu-e20.el (ccl-use-symbol-as-program): Reduce
+ `eval-and-compile' and `eval-when-compile' nesting.
+ (test-ccl-eof-block-cs): Remove existence checking.
+
+1998-08-27 Tanaka Akira <akr@jaist.ac.jp>
+
+ * emu-e20.el (ccl-use-symbol-as-program): Use
+ `ccl-vector-program-execute-on-string' if it is defined.
+
+1998-08-27 Tanaka Akira <akr@jaist.ac.jp>
+
+ * emu-e20.el (ccl-use-symbol-as-program): Use
+ `ccl-execute-on-string' instead of `make-coding-system' for
+ avoiding the error "Coding system already exists".
+
+1998-08-27 Tanaka Akira <akr@jaist.ac.jp>
+
+ * emu-e20.el (test-ccl-eof-block-cs): Check if it is already
+ defined.
+
+1998-08-27 Tanaka Akira <akr@jaist.ac.jp>
+
+ * emu-e20.el (ccl-use-symbol-as-program): New constant.
+ (make-ccl-coding-system): New function.
+ (ccl-encoder-eof-block-is-broken): New constant.
+ (ccl-decoder-eof-block-is-broken): New constant.
+ (ccl-eof-block-is-broken): New constant.
+ (ccl-execute): Redefine if `ccl-use-symbol-as-program' is nil.
+ (ccl-execute-on-string): Ditto.
+
+1998-08-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-20.el (mime-charset-coding-system-alist): Add `unknown' and
+ `x-unknown'.
+
+1998-08-12 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el: Redefine coding-system `ctext' if `ctext-dos' is not
+ found.
+
+1998-08-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emu-nemacs.el, emu-mule.el (decode-mime-charset-region): Add new
+ argument `lbt'.
+ (decode-mime-charset-string): Likewise.
+
+ * emu-mule.el (mime-charset-to-coding-system): Regard `CRLF',
+ `LF', `CR' as line break code type.
+
+1998-08-11 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-latin1.el, emu-nemacs.el (write-region-as-raw-text-CRLF):
+ Fix regexp to canonicalize line break code.
+
+ * emu-mule.el (write-region-as-raw-text-CRLF): Use
+ `write-region-as-binary' to specify `lockname' in MULE 2.3 based
+ on 19.34.
+
+1998-08-11 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el: Redefine coding-system `iso-2022-jp-2' if
+ `iso-2022-jp-2-dos' is not found.
+
+1998-08-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emu-mule.el (write-region-as-raw-text-CRLF): New function.
+
+ * emu-18.el (generate-new-buffer-name): New function (Emacs 19
+ emulating function).
+
+1998-08-10 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-nemacs.el, emu-latin1.el (write-region-as-raw-text-CRLF):
+ New function.
+
+ * emu-20.el (write-region-as-raw-text-CRLF): Renamed from
+ `write-region-as-CRLF'.
+
+1998-08-10 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-latin1.el, emu-e20.el (decode-mime-charset-region): Add new
+ argument `lbt'.
+ (decode-mime-charset-string): Likewise.
+
+ * emu-x20.el: Define coding-system `raw-text-unix' and
+ `raw-text-mac' if they are not found.
+ Redefine coding-system `euc-kr' if `euc-kr-dos' is not found.
+ (decode-mime-charset-region-default): Add new argument `lbt'.
+ (decode-mime-charset-region-with-iso646-unification): Likewise.
+ (decode-mime-charset-region-for-hz): Likewise.
+ (decode-mime-charset-region): Likewise.
+ (decode-mime-charset-string): Likewise.
+
+ * emu-20.el (mime-charset-to-coding-system): Regard `CRLF', `LF',
+ `CR' as line break code type.
+
+1998-08-07 MORIOKA Tomohiko <morioka@yo.rim.or.jp>
+
+ * emu-x20.el: Define coding-system `raw-text-dos' if it is not
+ found.
+
+ * emu-20.el (write-region-as-CRLF): New function.
+
+1998-07-21 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * install.el (install-detect-elisp-directory): Modify for anything
+ older than Emacs 19.28.
+
+\f
+1998-06-22 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.16 was released.
+
+ * emu.el, emu-x20.el: Require `emu-20' in emu-x20.el.
+
+1998-06-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el (set-buffer-multibyte): Use `defsubst-maybe' instead
+ of `defmacro-maybe'.
+
+1998-06-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-20.el, emu-x20.el: Move `insert-file-contents-as-binary' and
+ `insert-file-contents-as-raw-text' from emu-x20.el to emu-20.el.
+
+ * emu-e20_2.el, emu-e20.el: Move `insert-file-contents-as-binary'
+ and `insert-file-contents-as-raw-text' from emu-e20.el to
+ emu-e20_2.el.
+
+\f
+1998-06-09 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.15 was released.
+
+ * emu-xemacs.el: Use nil as variable of `condition-case' to avoid
+ byte-compiler warning.
+
+1998-06-09 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el (when): New macro.
+
+1998-06-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emu.el (split-string): New function (Emacs 20/XEmacs 20
+ emulating function).
+
+ * emu.el (with-temp-buffer): New macro (Emacs 20/XEmacs 20
+ emulating macro).
+
+ * emu.el (with-current-buffer): New macro (Emacs 20/XEmacs 20
+ emulating macro).
+
+ * emu.el (save-current-buffer): New macro (Emacs 20/XEmacs 20
+ emulating macro).
+
+1998-06-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mule-caesar.el (mule-caesar-region): Don't compare charset with
+ 'us-ascii.
+
+1998-06-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-mule.el (split-char): fixed.
+
+1998-06-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emu-mule.el (insert-file-contents-as-binary): Use
+ file-coding-system-for-read instead of file-coding-system.
+
+\f
+1998-06-06 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.14 was released.
+
+1998-06-05 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-mule.el, emu-latin1.el (split-char): New function.
+
+1998-06-05 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-mule.el, emu-nemacs.el (insert-file-contents-as-raw-text):
+ New function.
+
+ * emu-latin1.el (insert-file-contents-as-raw-text): New alias.
+
+ * emu-e20.el, emu-x20.el (insert-file-contents-as-raw-text): New
+ function.
+
+1998-06-05 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el: Move `split-char' check and repair code from
+ mule-caesar.el.
+
+ * mule-caesar.el: Move `split-char' check and repair code to
+ emu-x20.el; require 'emu.
+
+1998-06-05 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-nemacs.el, emu-mule.el (set-buffer-multibyte): New function.
+
+ * emu-latin1.el, emu-x20.el (set-buffer-multibyte): New macro.
+
+ * mule-caesar.el (mule-caesar-region): Use '(cdr (split-char ...))
+ instead of `char-to-octet-list'; abolish function
+ `char-to-octet-list'.
+
+1998-06-05 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-mule.el (charset-chars): New function.
+
+ * mule-caesar.el (split-char): Redefine if it has bug.
+ (char-to-octet-list): Use `split-char'.
+
+\f
+1998-06-01 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.13 was released.
+
+ * emu-x20.el (mime-character-unification-limit-size): Change
+ default value to 2048.
+
+1998-05-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el (string-as-unibyte): New macro.
+
+\f
+1998-05-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.12 was released.
+
+1998-05-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el (mime-character-unification-limit-size): New
+ variable.
+ (decode-mime-charset-region-with-iso646-unification): Don't unify
+ if size of region is larger than
+ 'mime-character-unification-limit-size.
+
+1998-05-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el, emu-nemacs.el, emu-mule.el, emu-latin1.el,
+ emu-e20_3.el (looking-at-as-unibyte): New alias.
+
+ * emu-e20_2.el (looking-at-as-unibyte): New function.
+
+1998-05-14 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el: Delete definition of 'detect-mime-charset-region
+ because it is defined in emu-20.el.
+
+ * emu-20.el (write-region-as-binary): fixed.
+
+ * emu-20.el (write-region-as-mime-charset): New function.
+
+ * emu-latin1.el (write-region-as-mime-charset): New alias.
+
+ * emu-nemacs.el, emu-mule.el (write-region-as-mime-charset): New
+ function.
+
+\f
+1998-05-09 MORIOKA Tomohiko <morioka@mousai.jaist.ac.jp>
+
+ * APEL: Version 8.11 was released.
+
+1998-05-09 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el (string-as-multibyte): New macro (Emacs 20.3 emulating
+ macro).
+
+\f
+1998-05-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.10 was released.
+
+ * README.en (What's APEL?): Delete description about atype.el; add
+ description about calist.el.
+
+1998-05-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * calist.el (ctree-add-calist-with-default): fixed.
+
+\f
+1998-05-06 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.9 was released.
+
+1998-05-06 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * calist.el (ctree-find-calist): fixed duplicated result.
+
+\f
+1998-05-05 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.8 was released.
+
+1998-05-03 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * calist.el (ctree-find-calist): Delete duplicated result.
+
+\f
+1998-04-30 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.7 was released.
+
+1998-04-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * calist.el (ctree-match-calist-partially): New function.
+
+\f
+1998-04-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.6 was released.
+
+1998-04-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-20.el (mime-charset-coding-system-alist): Use 'raw-text for
+ us-ascii in default setting.
+
+1998-04-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * calist.el (ctree-find-calist): Add optional argument 'all.
+
+1998-04-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * calist.el (ctree-find-calist): Renamed from
+ 'ctree-match-calist-all.
+
+\f
+1998-04-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.5 was released.
+
+1998-04-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * calist.el (ctree-match-calist-all): New function.
+
+1998-04-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL-ELS: Comment out 'atype and 'file-detect.
+
+1998-04-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el (decode-mime-charset-string): Use
+ 'decode-mime-charset-region.
+
+1998-04-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el (mime-charset-decoder-alist): Add
+ 'decode-mime-charset-region-for-hz for 'hz-gb-2312.
+ (decode-mime-charset-region-for-hz): New function.
+
+1998-03-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el (mime-charset-decoder-alist): New variable.
+ (decode-mime-charset-region-default): New function.
+ (mime-iso646-character-unification-alist): New variable.
+ (mime-unified-character-face): New variable.
+ (decode-mime-charset-region-with-iso646-unification): New
+ function.
+ (decode-mime-charset-region): Use 'mime-charset-decoder-alist.
+
+\f
+1998-04-22 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.4 was released.
+
+ * EMU-ELS: Don't use HIRAGANA LETTER A (\e$(B$"\e(B) to detect character
+ indexing (Emacs 20.3 or later).
+
+1998-04-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el, emu-e20.el (charsets-mime-charset-alist): Add
+ 'shift_jis.
+
+ * EMU-ELS (emu-modules): fixed.
+
+\f
+1998-04-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.3 was released.
+
+ * README.en (What's APEL?): Modify for latest emu.
+
+1998-04-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-nemacs.el, emu-mule.el, emu-latin1.el, emu-e20_2.el,
+ emu-e20_3.el, emu-x20.el (char-next-index): Fixed.
+
+1998-04-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * EMU-ELS (emu-modules): Add 'emu-e20_3 for Emacs 20.3.
+
+ * emu-e20_3.el: New module.
+
+ * emu-e20.el: Select to require 'emu-e20_2 or 'emu-e20_3.
+
+ * emu-e20_2.el (set-buffer-multibyte): New function.
+
+ * emu-e20.el (insert-file-contents-as-binary): Use
+ 'set-buffer-multibyte.
+
+1998-04-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-e20_2.el, emu-e20.el, EMU-ELS: Separate Emacs 20.1 and 20.2
+ depended definitions from emu-e20.el to emu-e20_2.el.
+
+1998-04-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu.el: emu-x20.el doesn't require 'emu-xemacs and 'emu-20.
+
+1998-04-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el: Don't require 'emu-xemacs and 'emu-20.
+
+ * emu.el: emu-latin1.el does not require 'emu-xemacs or 'emu-e19.
+
+ * emu-latin1.el: Don't require 'emu-xemacs or 'emu-e19.
+
+1998-04-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-mule.el, emu-latin1.el, emu-e20.el, emu-e19.el, emu-19.el,
+ EMU-ELS: Rename emu-19.el -> emu-e19.el.
+
+ * emu.el, emu-latin1.el, emu-e19.el, EMU-ELS: Rename emu-e19.el ->
+ emu-latin1.el.
+
+\f
+1998-04-13 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.2 was released.
+
+ * README.en (What's APEL?): Remove description about std11.el and
+ std11-parse.el.
+
+ * install.el (install-detect-elisp-directory): Modify regexp to
+ allow trailing `/'.
+
+\f
+1998-04-13 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.1 was released.
+
+1998-04-11 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el (encode-mime-charset-region): Use 'defun instead of
+ 'defsubst.
+ (decode-mime-charset-region): Use 'defun instead of 'defsubst.
+
+1998-04-10 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL-ELS (apel-modules): Delete 'std11 and 'std11-parse.
+
+ * std11.el, std11-parse.el: Abolish std11-parse.el and std11.el
+ (moved to RIME).
+
+\f
+1998-04-09 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 8.0 was released.
+
+1998-04-09 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-e19.el, emu-e20.el: Use 'make-obsolete for 'string-columns.
+
+ * emu-e19.el, emu-nemacs.el, emu-x20.el: Abolish obsolete alias
+ `char-leading-char'.
+
+1998-04-09 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-e20.el, emu-mule.el, emu-nemacs.el, emu-e19.el: Abolish
+ obsolete alias `char-columns'.
+
+ * emu-e19.el: Abolish constant `charset-ascii' and
+ `charset-iso8859-1'.
+ (charset-description): New implementation.
+ (charset-registry): New implementation.
+ (charset-width): Renamed from `charset-columns'; new
+ implementation.
+ (find-charset-string): New implementation.
+ (find-charset-region): New implementation.
+ (charsets-mime-charset-alist): New initial value.
+ (detect-mime-charset-region): New implementation.
+ (char-charset): New implementation.
+
+ * emu-nemacs.el: Rename `charset-columns' -> `charset-width'.
+
+ * emu-nemacs.el: Abolish constant `charset-ascii' and
+ `charset-jisx0208'.
+ Abolish constant `lc-ascii' and `lc-jp'.
+ (charset-description): New implementation.
+ (charset-registry): New implementation.
+ (charset-columns): New implementation.
+ (find-charset-string): New implementation.
+ (find-charset-region): New implementation.
+ (charsets-mime-charset-alist): New initial value.
+ (char-charset): New implementation.
+
+1998-04-09 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-e20.el, emu-x20.el, emu-e19.el, emu-mule.el, emu-nemacs.el
+ (char-next-index): New macro.
+
+\f
+1998-03-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 7.6 was released.
+
+ * std11.el: Require 'std11-parse when compile.
+
+1998-03-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * calist.el (ctree-match-calist): Prefer normal choice than
+ default choice.
+
+1998-03-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-20.el (mime-charset-coding-system-alist): Use 'defcustom.
+
+1998-03-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-20.el: Require 'wid-edit when compile.
+
+\f
+1998-03-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 7.5 was released.
+
+1998-03-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * calist.el (calist-field-match-method-obarray): New variable.
+ (define-calist-field-match-method): New function.
+ (calist-default-field-match-method): New function.
+ (calist-field-match-method): New function.
+ (calist-field-match): New function.
+ (ctree-match-calist): Use `calist-field-match'.
+
+\f
+1998-03-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 7.4 was released.
+
+1998-03-21 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-nemacs.el, emu-mule.el, emu-e19.el, emu-x20.el, emu-e20.el
+ (insert-file-contents-as-binary): Renamed from
+ `insert-binary-file-contents'; add `insert-binary-file-contents'
+ as obsolete alias.
+
+1998-03-21 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-e20.el (insert-binary-file-contents-literally): New alias
+ for `insert-file-contents-literally'.
+
+ * emu-x20.el (insert-binary-file-contents-literally): Moved from
+ emu-20.el.
+
+ * emu-20.el: Move `insert-binary-file-contents-literally' to
+ emu-x20.el.
+
+1998-03-21 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-e20.el (insert-binary-file-contents): Must save
+ `enable-multibyte-characters'.
+
+ * emu-x20.el (insert-binary-file-contents): Moved from emu-20.el.
+
+ * emu-20.el: Move `insert-binary-file-contents' to emu-x20.el.
+
+ * calist.el (ctree-match-calist): Rename local variables.
+
+\f
+1998-03-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 7.3 was released.
+
+1998-03-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL-ELS: Add calist.el.
+
+ * calist.el: New module.
+
+1998-03-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emu-mule.el (charsets-mime-charset-alist) fixed.
+
+\f
+1998-03-13 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 7.2 was released.
+
+1998-03-11 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-nemacs.el, emu-mule.el, emu-e19.el, emu-20.el
+ (write-region-as-binary): New function.
+
+1998-03-11 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-nemacs.el, emu-mule.el, emu-e19.el, emu-20.el
+ (insert-binary-file-contents): New function.
+
+1998-03-08 Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+
+ * README.en (Bug reports): Modify description of tm mailing list.
+
+\f
+1998-02-12 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * APEL: Version 7.1.1 was released.
+
+ * README.en (Bug reports): Modify for APEL.
+
+1998-02-04 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * std11.el (std11-msg-id-string): New function.
+ (std11-fill-msg-id-list-string): New function.
+
+ * std11-parse.el (std11-parse-msg-id): New function.
+
+1998-01-10 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * emu-x20.el: If coding-system `iso-2022-jp' unifies JIS X
+ 0201-Latin to ASCII and JIS X 0208-1978 to JIS X 0208-1983 by
+ code-point, copy coding-system `iso-2022-7bit' to `iso-2022-jp' to
+ avoid this problem.
+
+\f
1997-11-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* APEL: Version 7.1 was released.
--- /dev/null
+;;; -*-Emacs-Lisp-*-
+
+;; EMU-ELS: list of EMU modules to install
+
+;;; Code:
+
+(setq emu-modules (cons 'emu
+ (if (or running-emacs-19_29-or-later
+ running-xemacs-19_14-or-later)
+ '(richtext)
+ '(tinyrich)
+ )))
+
+(let ((poe-modules '(poe))
+ (poem-modules '(poem))
+ (mcs-modules '(mcharset))
+ pccl-modules)
+ (setq poe-modules (cons (cond ((featurep 'xemacs)
+ 'poe-xemacs)
+ ((>= emacs-major-version 19)
+ 'poe-19)
+ (t
+ 'poe-18))
+ poe-modules))
+
+ (cond ((featurep 'mule)
+ (cond ((featurep 'xemacs)
+ (setq poem-modules (cons 'poem-xm (cons 'poem-20
+ poem-modules))
+ mcs-modules (cons 'mcs-xm (cons 'mcs-20 mcs-modules)))
+ (if (>= emacs-major-version 21)
+ (setq pccl-modules '(pccl-20 pccl))
+ )
+ )
+ ((>= emacs-major-version 20)
+ (setq poem-modules (cons 'poem-e20 (cons 'poem-20
+ poem-modules))
+ mcs-modules (cons 'mcs-e20 (cons 'mcs-20
+ mcs-modules))
+ pccl-modules '(pccl-20 pccl))
+ (setq poem-modules
+ (cons
+ (if (and
+ (fboundp 'set-buffer-multibyte)
+ (subrp (symbol-function 'set-buffer-multibyte)))
+ 'poem-e20_3
+ 'poem-e20_2)
+ poem-modules))
+ )
+ (t
+ (setq poem-modules (cons 'poem-om poem-modules)
+ mcs-modules (cons 'mcs-om mcs-modules)
+ pccl-modules '(pccl-om pccl)
+ emu-modules (cons 'emu-mule emu-modules))
+ ))
+ )
+ ((boundp 'NEMACS)
+ (setq poem-modules (cons 'poem-nemacs poem-modules)
+ mcs-modules (cons 'mcs-nemacs mcs-modules))
+ )
+ (t
+ (setq poem-modules (cons 'poem-ltn1 poem-modules)
+ mcs-modules (cons 'mcs-ltn1 mcs-modules))
+ ))
+
+ (setq emu-modules (append poe-modules poem-modules
+ mcs-modules pccl-modules
+ emu-modules))
+ (setq emu-modules (cons 'broken emu-modules))
+ )
+
+;;; EMU-ELS ends here
#
-# $Id: Makefile,v 4.1 1997/11/08 07:44:29 morioka Exp $
+# Makefile for APEL.
#
-VERSION = 7.1
+VERSION = 9.3
TAR = tar
RM = /bin/rm -f
CP = /bin/cp -p
EMACS = emacs
+XEMACS = xemacs
FLAGS = -batch -q -no-site-file -l APEL-MK
PREFIX = NONE
LISPDIR = NONE
+PACKAGEDIR = NONE
+VERSION_SPECIFIC_LISPDIR = NONE
elc:
$(EMACS) $(FLAGS) -f compile-apel
install:
- $(EMACS) $(FLAGS) -f install-apel $(PREFIX) $(LISPDIR)
+ $(EMACS) $(FLAGS) -f install-apel $(PREFIX) $(LISPDIR) \
+ $(VERSION_SPECIFIC_LISPDIR)
+
+
+install-package:
+ $(XEMACS) $(FLAGS) -f install-apel-package $(PACKAGEDIR)
+
+
+what-where:
+ $(EMACS) $(FLAGS) -f what-where-apel $(PREFIX) $(LISPDIR) \
+ $(VERSION_SPECIFIC_LISPDIR)
clean:
cvs commit
sh -c 'cvs tag -RF apel-`echo $(VERSION) \
| sed s/\\\\./_/ | sed s/\\\\./_/`; \
- cd /tmp; cvs export -d apel-$(VERSION) \
- -r apel-`echo $(VERSION) \
- | sed s/\\\\./_/ | sed s/\\\\./_/` APEL'
+ cd /tmp; \
+ cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \
+ export -d apel-$(VERSION) \
+ -r apel-`echo $(VERSION) | sed s/\\\\./_/ | sed s/\\\\./_/` \
+ apel'
cd /tmp; $(RM) apel-$(VERSION)/ftp.in ; \
$(TAR) cvzf apel-$(VERSION).tar.gz apel-$(VERSION)
cd /tmp; $(RM) -r apel-$(VERSION)
release:
-$(RM) /pub/GNU/elisp/apel/apel-$(VERSION).tar.gz
mv /tmp/apel-$(VERSION).tar.gz /pub/GNU/elisp/apel/
- cd /pub/GNU/elisp/mime/alpha/ ; \
- ln -s ../../apel/apel-$(VERSION).tar.gz .
+ cd /pub/GNU/elisp/semi/ ; ln -s ../apel/apel-$(VERSION).tar.gz .
--- /dev/null
+[README for APEL (English Version)]
+
+What's APEL?
+============
+
+ APEL stands for "A Portable Emacs Library". It consists of
+ following modules:
+
+ poe.el --- emulation module mainly for basic functions and special
+ forms/macros of latest emacsen
+ poe-xemacs.el --- for XEmacs
+ poe-19.el --- for Emacs 19
+ poe-18.el --- for Emacs 18/Nemacs
+ env.el --- env.el for Emacs 18
+
+ poem.el --- provide basic functions to write portable MULE
+ programs
+ poem-nemacs.el --- for Nemacs
+ poem-ltn1.el --- for Emacs 19/XEmacs without MULE
+ poem-om.el --- for MULE 1.*, 2.*
+ poem-20.el --- shared module between Emacs 20 and XEmacs-MULE
+ poem-e20_2.el --- for Emacs 20.1/20.2
+ poem-e20_3.el --- for Emacs 20.3
+ poem-xm.el --- for XEmacs-MULE
+
+ mcharset.el --- provide MIME charset related features
+ mcs-nemacs.el --- for Nemacs
+ mcs-ltn1.el --- for Emacs 19/XEmacs without MULE
+ mcs-om.el --- for MULE 1.*, 2.*
+ mcs-20.el --- shared module between Emacs 20 and XEmacs-MULE
+ mcs-e20.el --- for Emacs 20
+ mcs-xm.el --- for XEmacs-MULE
+
+ broken.el --- provide information of broken facilities of Emacs.
+
+ pccl.el --- utility to write portable CCL program
+ pccl-om.el --- for MULE 1.*, 2.*
+ pccl-20.el --- for Emacs 20/XEmacs-MULE
+
+ alist.el: utility for Association-list
+
+ calist.el: utility for condition tree and
+ condition/situation-alist
+
+ path-util.el: utility for path management or file detection
+
+ filename.el: utility to make file-name
+
+ install.el: utility to install emacs-lisp package
+
+ mule-caesar.el: ROT 13-47-48 Caesar rotation utility
+
+ emu.el --- (emu bundled in tm-7.106 compatibility module; it
+ required poe, poem and mcharset)
+ emu-mule: for MULE 1.*, 2.*
+ richtext.el --- text/richtext module
+ for Emacs 19.29 or later,
+ XEmacs 19.14 or later
+ tinyrich.el --- text/richtext module for old emacsen
+
+
+Installation
+============
+
+(a) run in expanded place
+
+ If you don't want to install other directories, please do only
+ following:
+
+ % make
+
+ You can specify the emacs command name, for example
+
+ % make EMACS=xemacs
+
+ If `EMACS=...' is omitted, EMACS=emacs is used.
+
+(b) make install
+
+ If you want to install other directories, please do following:
+
+ % make install
+
+ You can specify the emacs command name, for example
+
+ % make install EMACS=xemacs
+
+ If `EMACS=...' is omitted, EMACS=emacs is used.
+
+ You can specify the prefix of the directory tree for Emacs Lisp
+ programs and shell scripts, for example:
+
+ % make install PREFIX=~/
+
+ If `PREFIX=...' is omitted, the prefix of the directory tree of the
+ specified emacs command is used (perhaps /usr/local).
+
+ For example, if PREFIX=/usr/local and Emacs 20.2 is specified, it
+ will create the following directory tree:
+
+ /usr/local/share/emacs/20.2/site-lisp/ --- emu
+ /usr/local/share/emacs/site-lisp/apel/ --- APEL
+
+ You can specify the lisp directory for Emacs Lisp programs,
+ for example:
+
+ % make install LISPDIR=~/elisp
+
+ You can also specify the version specific lisp directory where the
+ emu modules will be installed in, for example:
+
+ % make install VERSION_SPECIFIC_LISPDIR=~/elisp
+
+ If you would like to know what files belong to the emu modules or
+ the apel modules, or where they will be installed in, for example,
+ please type the following command.
+
+ % make what-where LISPDIR=~/elisp VERSION_SPECIFIC_LISPDIR=~/elisp
+
+ You can specify other optional settings by editing the file
+ APEL-CFG. Please read comments in it.
+
+(c) install as a XEmacs package
+
+ If you want to install to XEmacs package directory, please do
+ following:
+
+ % make install-package
+
+ You can specify the emacs command name, for example
+
+ % make install-package XEMACS=xemacs-21
+
+ If `XEMACS=...' is omitted, XEMACS=xemacs is used.
+
+ You can specify the package directory, for example:
+
+ % make install PACKAGEDIR=~/.xemacs
+
+ If `PACKAGEDIR=...' is omitted, the first existing package
+ directory is used.
+
+ Notice that XEmacs package system requires XEmacs 21.0 or later.
+
+
+load-path (for Emacs or MULE)
+=============================
+
+ If you are using Emacs or Mule, please add directory of apel to
+ load-path. If you install by default setting with Emacs 20.1/20.2,
+ you can write subdirs.el for example:
+
+ --------------------------------------------------------------------
+ (normal-top-level-add-to-load-path '("apel"))
+ --------------------------------------------------------------------
+
+ If you are using Emacs 20.3 or later or XEmacs, there are no need to
+ set up load-path with normal installation.
+
+
+How to use
+==========
+
+alist
+-----
+
+Function put-alist (ITEM VALUE ALIST)
+
+ Modify ALIST to set VALUE to ITEM. If there is a pair whose car is
+ ITEM, replace its cdr by VALUE. If there is not such pair, create
+ new pair (ITEM . VALUE) and return new alist whose car is the new
+ pair and cdr is ALIST.
+
+Function del-alist (ITEM ALIST)
+
+ If there is a pair whose key is ITEM, delete it from ALIST.
+
+Function set-alist (SYMBOL ITEM VALUE)
+
+ Modify a alist indicated by SYMBOL to set VALUE to ITEM.
+
+ Ex. (set-alist 'auto-mode-alist "\\.pln$" 'text-mode)
+
+Function modify-alist (MODIFIER DEFAULT)
+
+ Modify alist DEFAULT into alist MODIFIER.
+
+Function set-modified-alist (SYMBOL MODIFIER)
+
+ Modify a value of a SYMBOL into alist MODIFIER. The SYMBOL should
+ be alist. If it is not bound, its value regard as nil.
+
+path-util
+---------
+
+Function add-path (PATH &rest OPTIONS)
+
+ Add PATH to `load-path' if it exists under `default-load-path'
+ directories and it does not exist in `load-path'.
+
+ You can use following PATH styles:
+
+ load-path relative: "PATH" (it is searched from
+ `defaul-load-path')
+
+ home directory relative: "~/PATH" "~USER/PATH"
+
+ absolute path: "/FOO/BAR/BAZ"
+
+ You can specify following OPTIONS:
+
+ 'all-paths --- search from `load-path' instead of
+ `default-load-path'
+
+ 'append --- add PATH to the last of `load-path'
+
+Function add-latest-path (PATTERN &optional ALL-PATHS)
+
+ Add latest path matched by regexp PATTERN to `load-path' if it
+ exists under `default-load-path' directories and it does not exist
+ in `load-path'.
+
+ For example, if there is bbdb-1.50 and bbdb-1.51 under site-lisp,
+ and if bbdb-1.51 is newer than bbdb-1.50, and site-lisp is
+ /usr/local/share/emacs/site-lisp,
+
+ (add-path "bbdb")
+
+ it adds "/usr/local/share/emacs/site-lisp/bbdb-1.51" to top of
+ `load-path'.
+
+ If optional argument ALL-PATHS is specified, it is searched from all
+ of `load-path' instead of `default-load-path'.
+
+Function get-latest-path (PATTERN &optional ALL-PATHS)
+
+ Return latest directory in default-load-path which is matched to
+ regexp PATTERN. If optional argument ALL-PATHS is specified, it is
+ searched from all of load-path instead of default-load-path.
+
+ Ex. (let ((gnus-path (get-latest-path "gnus")))
+ (add-path (expand-file-name "lisp" gnus-path))
+ (add-to-list 'Info-default-directory-list
+ (expand-file-name "texi" gnus-path))
+ )
+
+Function file-installed-p (FILE &optional PATHS)
+
+ Return absolute-path of FILE if FILE exists in PATHS. If PATHS is
+ omitted, `load-path' is used.
+
+Function exec-installed-p (FILE &optional PATHS SUFFIXES)
+
+ Return absolute-path of FILE if FILE exists in PATHS. If PATHS is
+ omitted, `exec-path' is used. If suffixes is omitted,
+ `exec-suffix-list' is used.
+
+Function module-installed-p (MODULE &optional PATHS)
+
+ Return non-nil if module is provided or exists in PATHS. If PATHS
+ is omitted, `load-path' is used.
+
+filename
+--------
+
+Function replace-as-filename (string)
+
+ Return safety file-name from STRING.
+
+ It refers variable `filename-filters'. It is list of functions for
+ file-name filter. Default filter refers following variables:
+
+ Variable filename-limit-length
+
+ Limit size of file-name.
+
+ Variable filename-replacement-alist
+
+ Alist list of characters vs. string as replacement. List of
+ characters represents characters not allowed as file-name.
+
+
+Bug reports
+===========
+
+ If you write bug-reports and/or suggestions for improvement, please
+ send them to the tm Mailing List:
+
+ bug-tm-en@chamonix.jaist.ac.jp (English)
+ bug-tm-ja@chamonix.jaist.ac.jp (Japanese)
+
+ Via the tm ML, you can report APEL bugs, obtain the latest release
+ of APEL, and discuss future enhancements to APEL. To join the tm
+ ML, send an empty e-mail to
+
+ tm-en-help@chamonix.jaist.ac.jp (English)
+ tm-ja-help@chamonix.jaist.ac.jp (Japanese)
--- /dev/null
+;;; broken.el --- Emacs broken facility infomation registry.
+
+;; Copyright (C) 1998 Tanaka Akira <akr@jaist.ac.jp>
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Keywords: emulation, compatibility, incompatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-and-compile
+
+(defvar notice-non-obvious-broken-facility t
+ "If the value is t, non-obvious broken facility is noticed when
+`broken-facility' macro is expanded.")
+
+(defun broken-facility-internal (facility &optional docstring assertion)
+ "Declare that FACILITY emulation is broken if ASSERTION is nil."
+ (when docstring
+ (put facility 'broken-docstring docstring))
+ (put facility 'broken (not assertion)))
+
+(defun broken-p (facility)
+ "t if FACILITY emulation is broken."
+ (get facility 'broken))
+
+(defun broken-facility-description (facility)
+ "Return description for FACILITY."
+ (get facility 'broken-docstring))
+
+)
+
+(put 'broken-facility 'lisp-indent-function 1)
+(defmacro broken-facility (facility &optional docstring assertion no-notice)
+ "Declare that FACILITY emulation is broken if ASSERTION is nil.
+ASSERTION is evaluated statically.
+
+FACILITY must be symbol.
+
+If ASSERTION is not ommited and evaluated to nil and NO-NOTICE is nil, it is noticed."
+ (let ((assertion-value (eval assertion)))
+ (eval `(broken-facility-internal ',facility ,docstring ',assertion-value))
+ (when (and assertion (not assertion-value) (not no-notice)
+ notice-non-obvious-broken-facility)
+ (message "BROKEN FACILITY DETECTED: %s" docstring))
+ `(broken-facility-internal ',facility ,docstring ',assertion-value)))
+
+(put 'if-broken 'lisp-indent-function 2)
+(defmacro if-broken (facility then &rest else)
+ "If FACILITY is broken, expand to THEN, otherwise (progn . ELSE)."
+ (if (broken-p facility)
+ then
+ `(progn . ,else)))
+
+(put 'when-broken 'lisp-indent-function 1)
+(defmacro when-broken (facility &rest body)
+ "If FACILITY is broken, expand to (progn . BODY), otherwise nil."
+ (when (broken-p facility)
+ `(progn . ,body)))
+
+(put 'unless-broken 'lisp-indent-function 1)
+(defmacro unless-broken (facility &rest body)
+ "If FACILITY is not broken, expand to (progn . BODY), otherwise nil."
+ (unless (broken-p facility)
+ `(progn . ,body)))
+
+
+;;; @ end
+;;;
+
+(provide 'broken)
+
+;;; broken.el ends here
--- /dev/null
+;;; calist.el --- Condition functions
+
+;; Copyright (C) 1998 MORIOKA Tomohiko.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: condition, alist, tree
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defvar calist-field-match-method-obarray [nil])
+
+(defun define-calist-field-match-method (field-type function)
+ "Set field-match-method for FIELD-TYPE to FUNCTION."
+ (fset (intern (symbol-name field-type) calist-field-match-method-obarray)
+ function))
+
+(defun calist-default-field-match-method (calist field-type field-value)
+ (let ((s-field (assoc field-type calist)))
+ (cond ((null s-field)
+ (cons (cons field-type field-value) calist)
+ )
+ ((eq field-value t)
+ calist)
+ ((equal (cdr s-field) field-value)
+ calist))))
+
+(defsubst calist-field-match-method (field-type)
+ (condition-case nil
+ (symbol-function
+ (intern-soft
+ (symbol-name field-type) calist-field-match-method-obarray))
+ (error (symbol-function 'calist-default-field-match-method))
+ ))
+
+(defsubst calist-field-match (calist field-type field-value)
+ (funcall (calist-field-match-method field-type)
+ calist field-type field-value))
+
+(defun ctree-match-calist (rule-tree alist)
+ "Return matched condition-alist if ALIST matches RULE-TREE."
+ (if (null rule-tree)
+ alist
+ (let ((type (car rule-tree))
+ (choices (cdr rule-tree))
+ default)
+ (catch 'tag
+ (while choices
+ (let* ((choice (car choices))
+ (choice-value (car choice)))
+ (if (eq choice-value t)
+ (setq default choice)
+ (let ((ret-alist (calist-field-match alist type (car choice))))
+ (if ret-alist
+ (throw 'tag
+ (if (cdr choice)
+ (ctree-match-calist (cdr choice) ret-alist)
+ ret-alist))
+ ))))
+ (setq choices (cdr choices)))
+ (if default
+ (let ((ret-alist (calist-field-match alist type t)))
+ (if ret-alist
+ (if (cdr default)
+ (ctree-match-calist (cdr default) ret-alist)
+ ret-alist))))
+ ))))
+
+(defun ctree-match-calist-partially (rule-tree alist)
+ "Return matched condition-alist if ALIST matches RULE-TREE."
+ (if (null rule-tree)
+ alist
+ (let ((type (car rule-tree))
+ (choices (cdr rule-tree))
+ default)
+ (catch 'tag
+ (while choices
+ (let* ((choice (car choices))
+ (choice-value (car choice)))
+ (if (eq choice-value t)
+ (setq default choice)
+ (let ((ret-alist (calist-field-match alist type (car choice))))
+ (if ret-alist
+ (throw 'tag
+ (if (cdr choice)
+ (ctree-match-calist-partially
+ (cdr choice) ret-alist)
+ ret-alist))
+ ))))
+ (setq choices (cdr choices)))
+ (if default
+ (let ((ret-alist (calist-field-match alist type t)))
+ (if ret-alist
+ (if (cdr default)
+ (ctree-match-calist-partially (cdr default) ret-alist)
+ ret-alist)))
+ (calist-field-match alist type t))
+ ))))
+
+(defun ctree-find-calist (rule-tree alist &optional all)
+ "Return list of condition-alist which matches ALIST in RULE-TREE.
+If optional argument ALL is specified, default rules are not ignored
+even if other rules are matched for ALIST."
+ (if (null rule-tree)
+ (list alist)
+ (let ((type (car rule-tree))
+ (choices (cdr rule-tree))
+ default dest)
+ (while choices
+ (let* ((choice (car choices))
+ (choice-value (car choice)))
+ (if (eq choice-value t)
+ (setq default choice)
+ (let ((ret-alist (calist-field-match alist type (car choice))))
+ (if ret-alist
+ (if (cdr choice)
+ (let ((ret (ctree-find-calist
+ (cdr choice) ret-alist all)))
+ (while ret
+ (let ((elt (car ret)))
+ (or (member elt dest)
+ (setq dest (cons elt dest))
+ ))
+ (setq ret (cdr ret))
+ ))
+ (or (member ret-alist dest)
+ (setq dest (cons ret-alist dest)))
+ )))))
+ (setq choices (cdr choices)))
+ (or (and (not all) dest)
+ (if default
+ (let ((ret-alist (calist-field-match alist type t)))
+ (if ret-alist
+ (if (cdr default)
+ (let ((ret (ctree-find-calist
+ (cdr default) ret-alist all)))
+ (while ret
+ (let ((elt (car ret)))
+ (or (member elt dest)
+ (setq dest (cons elt dest))
+ ))
+ (setq ret (cdr ret))
+ ))
+ (or (member ret-alist dest)
+ (setq dest (cons ret-alist dest)))
+ ))))
+ )
+ dest)))
+
+(defun calist-to-ctree (calist)
+ "Convert condition-alist CALIST to condition-tree."
+ (if calist
+ (let* ((cell (car calist)))
+ (cons (car cell)
+ (list (cons (cdr cell)
+ (calist-to-ctree (cdr calist))
+ ))))))
+
+(defun ctree-add-calist-strictly (ctree calist)
+ "Add condition CALIST to condition-tree CTREE without default clause."
+ (cond ((null calist) ctree)
+ ((null ctree)
+ (calist-to-ctree calist)
+ )
+ (t
+ (let* ((type (car ctree))
+ (values (cdr ctree))
+ (ret (assoc type calist)))
+ (if ret
+ (catch 'tag
+ (while values
+ (let ((cell (car values)))
+ (if (equal (car cell)(cdr ret))
+ (throw 'tag
+ (setcdr cell
+ (ctree-add-calist-strictly
+ (cdr cell)
+ (delete ret (copy-alist calist)))
+ ))))
+ (setq values (cdr values)))
+ (setcdr ctree (cons (cons (cdr ret)
+ (calist-to-ctree
+ (delete ret (copy-alist calist))))
+ (cdr ctree)))
+ )
+ (catch 'tag
+ (while values
+ (let ((cell (car values)))
+ (setcdr cell
+ (ctree-add-calist-strictly (cdr cell) calist))
+ )
+ (setq values (cdr values))))
+ )
+ ctree))))
+
+(defun ctree-add-calist-with-default (ctree calist)
+ "Add condition CALIST to condition-tree CTREE with default clause."
+ (cond ((null calist) ctree)
+ ((null ctree)
+ (let* ((cell (car calist))
+ (type (car cell))
+ (value (cdr cell)))
+ (cons type
+ (list (list t)
+ (cons value (calist-to-ctree (cdr calist)))))
+ ))
+ (t
+ (let* ((type (car ctree))
+ (values (cdr ctree))
+ (ret (assoc type calist)))
+ (if ret
+ (catch 'tag
+ (while values
+ (let ((cell (car values)))
+ (if (equal (car cell)(cdr ret))
+ (throw 'tag
+ (setcdr cell
+ (ctree-add-calist-with-default
+ (cdr cell)
+ (delete ret (copy-alist calist)))
+ ))))
+ (setq values (cdr values)))
+ (if (assq t (cdr ctree))
+ (setcdr ctree
+ (cons (cons (cdr ret)
+ (calist-to-ctree
+ (delete ret (copy-alist calist))))
+ (cdr ctree)))
+ (setcdr ctree
+ (list* (list t)
+ (cons (cdr ret)
+ (calist-to-ctree
+ (delete ret (copy-alist calist))))
+ (cdr ctree)))
+ ))
+ (catch 'tag
+ (while values
+ (let ((cell (car values)))
+ (setcdr cell
+ (ctree-add-calist-with-default (cdr cell) calist))
+ )
+ (setq values (cdr values)))
+ (let ((cell (assq t (cdr ctree))))
+ (if cell
+ (setcdr cell
+ (ctree-add-calist-with-default (cdr cell)
+ calist))
+ (let ((elt (cons t (calist-to-ctree calist))))
+ (or (member elt (cdr ctree))
+ (setcdr ctree (cons elt (cdr ctree)))
+ ))
+ )))
+ )
+ ctree))))
+
+(defun ctree-set-calist-strictly (ctree-var calist)
+ "Set condition CALIST in CTREE-VAR without default clause."
+ (set ctree-var
+ (ctree-add-calist-strictly (symbol-value ctree-var) calist)))
+
+(defun ctree-set-calist-with-default (ctree-var calist)
+ "Set condition CALIST to CTREE-VAR with default clause."
+ (set ctree-var
+ (ctree-add-calist-with-default (symbol-value ctree-var) calist)))
+
+
+;;; @ end
+;;;
+
+(provide 'calist)
+
+;;; calist.el ends here
+++ /dev/null
-;;; emu-18.el --- emu API implementation for Emacs 18.*
-
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-18.el,v 7.33 1997/04/05 06:44:01 morioka Exp $
-;; Keywords: emulation, compatibility
-
-;; This file is part of emu.
-
-;; 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(autoload 'setenv "env"
- "Set the value of the environment variable named VARIABLE to VALUE.
-VARIABLE should be a string. VALUE is optional; if not provided or is
-`nil', the environment variable VARIABLE will be removed.
-This function works by modifying `process-environment'."
- t)
-
-(defvar data-directory exec-directory)
-
-
-;;; @ for EMACS 18.55
-;;;
-
-(defvar buffer-undo-list nil)
-
-
-;;; @ hook
-;;;
-
-;; 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.
-FUNCTION is added (if necessary) at the beginning of the hook list
-unless the optional argument APPEND is non-nil, in which case
-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]"
- (or (boundp hook)
- (set hook nil)
- )
- ;; If the hook value is a single function, turn it into a list.
- (let ((old (symbol-value hook)))
- (if (or (not (listp old))
- (eq (car old) 'lambda))
- (set hook (list old))
- ))
- (or (if (consp function)
- ;; Clever way to tell whether a given lambda-expression
- ;; is equal to anything in the hook.
- (let ((tail (assoc (cdr function) (symbol-value hook))))
- (equal function tail)
- )
- (memq function (symbol-value hook))
- )
- (set hook
- (if append
- (nconc (symbol-value hook) (list function))
- (cons function (symbol-value hook))
- ))
- ))
-
-(defun remove-hook (hook function)
- "Remove from the value of HOOK the function FUNCTION.
-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]"
- (if (or (not (boundp hook)) ;unbound symbol, or
- (null (symbol-value hook)) ;value is nil, or
- (null function)) ;function is nil, then
- nil ;Do nothing.
- (let ((hook-value (symbol-value hook)))
- (if (consp hook-value)
- (setq hook-value (delete function hook-value))
- (if (equal hook-value function)
- (setq hook-value nil)
- ))
- (set hook hook-value)
- )))
-
-
-;;; @ list
-;;;
-
-(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]"
- (while (and list (not (equal elt (car list))))
- (setq list (cdr list)))
- list)
-
-(defun delete (elt list)
- "Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `equal'.
-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]"
- (if (equal elt (car list))
- (cdr list)
- (let ((rest list)
- (rrest (cdr list))
- )
- (while (and rrest (not (equal elt (car rrest))))
- (setq rest rrest
- rrest (cdr rrest))
- )
- (rplacd rest (cdr rrest))
- list)))
-
-
-;;; @ function
-;;;
-
-(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]"
- (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]"
- (and (consp exp)
- (let* ((rest (cdr (cdr exp))) elt)
- (if (stringp (car rest))
- (setq rest (cdr rest))
- )
- (catch 'tag
- (while rest
- (setq elt (car rest))
- (if (and (consp elt)(eq (car elt) 'byte-code))
- (throw 'tag t)
- )
- (setq rest (cdr rest))
- ))
- )))
-
-(defmacro-maybe defsubst (name arglist &rest body)
- "Define an inline function. The syntax is just like that of `defun'."
- (cons 'defun (cons name (cons arglist body)))
- )
-
-
-;;; @ file
-;;;
-
-(defun make-directory-internal (dirname)
- "Create a directory. One argument, a file name string.
-\[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))
- (error "Creating directory: no such file or directory, %s" dirname)
- )))
-
-(defun make-directory (dir &optional parents)
- "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]"
- (let ((len (length dir))
- (p 0) p1 path)
- (catch 'tag
- (while (and (< p len) (string-match "[^/]*/?" dir p))
- (setq p1 (match-end 0))
- (if (= p1 len)
- (throw 'tag nil)
- )
- (setq path (substring dir 0 p1))
- (if (not (file-directory-p path))
- (cond ((file-exists-p path)
- (error "Creating directory: %s is not directory" path)
- )
- ((null parents)
- (error "Creating directory: %s is not exist" path)
- )
- (t
- (make-directory-internal path)
- ))
- )
- (setq p p1)
- ))
- (make-directory-internal dir)
- ))
-
-;; Imported from files.el of EMACS 19.33.
-(defun parse-colon-path (cd-path)
- "Explode a colon-separated list of paths into a string list."
- (and cd-path
- (let (cd-prefix cd-list (cd-start 0) cd-colon)
- (setq cd-path (concat cd-path path-separator))
- (while (setq cd-colon (string-match path-separator cd-path cd-start))
- (setq cd-list
- (nconc cd-list
- (list (if (= cd-start cd-colon)
- nil
- (substitute-in-file-name
- (file-name-as-directory
- (substring cd-path cd-start cd-colon)))))))
- (setq cd-start (+ cd-colon 1)))
- cd-list)))
-
-;; Imported from files.el of EMACS 19.33.
-(defun file-relative-name (filename &optional directory)
- "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
- (setq filename (expand-file-name filename)
- directory (file-name-as-directory (expand-file-name
- (or directory default-directory))))
- (let ((ancestor ""))
- (while (not (string-match (concat "^" (regexp-quote directory)) filename))
- (setq directory (file-name-directory (substring directory 0 -1))
- 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
-;;;
-
-(or (fboundp 'si:mark)
- (fset 'si:mark (symbol-function 'mark)))
-(defun mark (&optional force)
- (si:mark)
- )
-
-
-;;; @ mode-line
-;;;
-
-;;; Imported from Emacs 19.30.
-(defun force-mode-line-update (&optional all)
- "Force the mode-line of the current buffer to be redisplayed.
-With optional non-nil ALL, force redisplay of all mode-lines.
-\[emu-18.el; Emacs 19 emulating function]"
- (if all (save-excursion (set-buffer (other-buffer))))
- (set-buffer-modified-p (buffer-modified-p)))
-
-
-;;; @ overlay
-;;;
-
-(defun overlay-buffer (overlay))
-
-
-;;; @ text property
-;;;
-
-(defun remove-text-properties (start end properties &optional object))
-
-
-;;; @@ visible/invisible
-;;;
-
-(defmacro enable-invisible ()
- (`
- (progn
- (make-local-variable 'original-selective-display)
- (setq original-selective-display selective-display)
- (setq selective-display t)
- )))
-
-(defmacro end-of-invisible ()
- (` (setq selective-display
- (if (boundp 'original-selective-display)
- original-selective-display))
- ))
-
-(defun invisible-region (start end)
- (let ((buffer-read-only nil) ;Okay even if write protected.
- (modp (buffer-modified-p)))
- (if (save-excursion
- (goto-char (1- end))
- (eq (following-char) ?\n)
- )
- (setq end (1- end))
- )
- (unwind-protect
- (subst-char-in-region start end ?\n ?\^M t)
- (set-buffer-modified-p modp)
- )))
-
-(defun visible-region (start end)
- (let ((buffer-read-only nil) ;Okay even if write protected.
- (modp (buffer-modified-p)))
- (unwind-protect
- (subst-char-in-region start end ?\^M ?\n t)
- (set-buffer-modified-p modp)
- )))
-
-(defun invisible-p (pos)
- (save-excursion
- (goto-char pos)
- (eq (following-char) ?\^M)
- ))
-
-(defun next-visible-point (pos)
- (save-excursion
- (goto-char pos)
- (end-of-line)
- (if (eq (following-char) ?\n)
- (forward-char)
- )
- (point)
- ))
-
-
-;;; @ mouse
-;;;
-
-(defvar mouse-button-1 nil)
-(defvar mouse-button-2 nil)
-(defvar mouse-button-3 nil)
-
-
-;;; @ string
-;;;
-
-(defun char-list-to-string (char-list)
- "Convert list of character CHAR-LIST to string. [emu-18.el]"
- (mapconcat (function char-to-string) char-list "")
- )
-
-
-;;; @ end
-;;;
-
-(provide 'emu-18)
-
-;;; emu-18.el ends here
+++ /dev/null
-;;; emu-19.el --- emu API implementation for Emacs 19.*
-
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-19.el,v 7.18 1997/11/06 10:38:03 morioka Exp $
-;; Keywords: emulation, compatibility
-
-;; This file is part of emu.
-
-;; 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-;;; @ face
-;;;
-
-(defun-maybe find-face (face)
- (car (memq face (face-list)))
- )
-
-
-;;; @ for tm-7.106
-;;;
-
-(defalias 'tl:make-overlay 'make-overlay)
-(defalias 'tl:overlay-put 'overlay-put)
-(defalias 'tl:overlay-buffer 'overlay-buffer)
-
-(make-obsolete 'tl:make-overlay 'make-overlay)
-(make-obsolete 'tl:overlay-put 'overlay-put)
-(make-obsolete 'tl:overlay-buffer 'overlay-buffer)
-
-
-;;; @ visible/invisible
-;;;
-
-(defmacro enable-invisible ())
-
-(defmacro end-of-invisible ())
-
-(defun invisible-region (start end)
- (if (save-excursion
- (goto-char (1- end))
- (eq (following-char) ?\n)
- )
- (setq end (1- end))
- )
- (put-text-property start end 'invisible t)
- )
-
-(defun visible-region (start end)
- (put-text-property start end 'invisible nil)
- )
-
-(defun invisible-p (pos)
- (get-text-property pos 'invisible)
- )
-
-(defun next-visible-point (pos)
- (save-excursion
- (goto-char (next-single-property-change pos 'invisible))
- (if (eq (following-char) ?\n)
- (forward-char)
- )
- (point)
- ))
-
-
-;;; @ mouse
-;;;
-
-(defvar mouse-button-1 [mouse-1])
-(defvar mouse-button-2 [mouse-2])
-(defvar mouse-button-3 [down-mouse-3])
-
-
-;;; @ string
-;;;
-
-(defmacro char-list-to-string (char-list)
- "Convert list of character CHAR-LIST to string. [emu-19.el]"
- (` (mapconcat (function char-to-string)
- (, char-list)
- "")
- ))
-
-
-;;; @ end
-;;;
-
-(provide 'emu-19)
-
-;;; emu-19.el ends here
+++ /dev/null
-;;; emu-20.el --- emu API implementation for Emacs 20 and XEmacs/mule
-
-;; Copyright (C) 1997 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-20.el,v 7.18 1997/11/04 08:36:40 morioka Exp $
-;; Keywords: emulation, compatibility, Mule
-
-;; This file is part of emu.
-
-;; 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule)
-;; or later.
-
-;;; Code:
-
-(require 'custom)
-
-
-;;; @ binary access
-;;;
-
-(defmacro as-binary-process (&rest body)
- `(let (selective-display ; Disable ^M to nl translation.
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- ,@body))
-
-(defmacro as-binary-input-file (&rest body)
- `(let ((coding-system-for-read 'binary))
- ,@body))
-
-(defmacro as-binary-output-file (&rest body)
- `(let ((coding-system-for-write 'binary))
- ,@body))
-
-(defun insert-binary-file-contents-literally
- (filename &optional visit beg end replace)
- "Like `insert-file-contents-literally', q.v., but don't code conversion.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
- This function ensures that none of these modifications will take place."
- (let ((coding-system-for-read 'binary))
- (insert-file-contents-literally filename visit beg end replace)
- ))
-
-;;; @@ Mule emulating aliases
-;;;
-;;; You should not use it.
-
-(defconst *noconv* 'binary
- "Coding-system for binary.
-This constant is defined to emulate old MULE anything older than MULE
-2.3. It is obsolete, so don't use it.")
-
-
-;;; @ MIME charset
-;;;
-
-(defvar mime-charset-coding-system-alist
- `,(let ((rest
- '((us-ascii . iso-8859-1)
- (gb2312 . cn-gb-2312)
- (iso-2022-jp-2 . iso-2022-7bit-ss2)
- (x-ctext . ctext)
- ))
- dest)
- (while rest
- (let ((pair (car rest)))
- (or (find-coding-system (car pair))
- (setq dest (cons pair dest))
- ))
- (setq rest (cdr rest))
- )
- dest)
- "Alist MIME CHARSET vs CODING-SYSTEM.
-MIME CHARSET and CODING-SYSTEM must be symbol.")
-
-(defsubst mime-charset-to-coding-system (charset &optional lbt)
- "Return coding-system corresponding with CHARSET.
-CHARSET is a symbol whose name is MIME charset.
-If optional argument LBT (`unix', `dos' or `mac') is specified, it is
-used as line break code type of coding-system."
- (if (stringp charset)
- (setq charset (intern (downcase charset)))
- )
- (let ((ret (assq charset mime-charset-coding-system-alist)))
- (if ret
- (setq charset (cdr ret))
- ))
- (if lbt
- (setq charset (intern (format "%s-%s" charset lbt)))
- )
- (if (find-coding-system charset)
- charset))
-
-(defsubst mime-charset-list ()
- "Return a list of all existing MIME-charset."
- (nconc (mapcar (function car) mime-charset-coding-system-alist)
- (coding-system-list)))
-
-
-(defvar widget-mime-charset-prompt-value-history nil
- "History of input to `widget-mime-charset-prompt-value'.")
-
-(define-widget 'mime-charset 'coding-system
- "A mime-charset."
- :format "%{%t%}: %v"
- :tag "MIME-charset"
- :prompt-history 'widget-mime-charset-prompt-value-history
- :prompt-value 'widget-mime-charset-prompt-value
- :action 'widget-mime-charset-action)
-
-(defun widget-mime-charset-prompt-value (widget prompt value unbound)
- ;; Read mime-charset from minibuffer.
- (intern
- (completing-read (format "%s (default %s) " prompt value)
- (mapcar (function
- (lambda (sym)
- (list (symbol-name sym))
- ))
- (mime-charset-list)))))
-
-(defun widget-mime-charset-action (widget &optional event)
- ;; Read a mime-charset from the minibuffer.
- (let ((answer
- (widget-mime-charset-prompt-value
- widget
- (widget-apply widget :menu-tag-get)
- (widget-value widget)
- t)))
- (widget-value-set widget answer)
- (widget-apply widget :notify widget event)
- (widget-setup)))
-
-(defcustom default-mime-charset 'x-ctext
- "Default value of MIME-charset.
-It is used when MIME-charset is not specified.
-It must be symbol."
- :group 'i18n
- :type 'mime-charset)
-
-(defsubst detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END."
- (charsets-to-mime-charset (find-charset-region start end)))
-
-
-;;; @ end
-;;;
-
-(provide 'emu-20)
-
-;;; emu-20.el ends here
+++ /dev/null
-;;; emu-e19.el --- emu module for Emacs 19 and XEmacs 19
-
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-e19.el,v 7.44 1997/02/13 08:15:39 morioka Exp $
-;; Keywords: emulation, compatibility, mule, Latin-1
-
-;; This file is part of emu.
-
-;; 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 GNU Emacs; 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 and variant specific features
-;;;
-
-(cond (running-xemacs
- (require 'emu-xemacs))
- (running-emacs-19
- (require 'emu-19)
- ))
-
-
-;;; @ character set
-;;;
-
-(defconst charset-ascii 0 "Character set of ASCII")
-(defconst charset-latin-iso8859-1 129 "Character set of ISO-8859-1")
-
-(defun charset-description (charset)
- "Return description of CHARSET. [emu-e19.el]"
- (if (< charset 128)
- (documentation-property 'charset-ascii 'variable-documentation)
- (documentation-property 'charset-latin-iso8859-1 'variable-documentation)
- ))
-
-(defun charset-registry (charset)
- "Return registry name of CHARSET. [emu-e19.el]"
- (if (< charset 128)
- "ASCII"
- "ISO8859-1"))
-
-(defun charset-columns (charset)
- "Return number of columns a CHARSET occupies when displayed.
-\[emu-e19.el]"
- 1)
-
-(defun charset-direction (charset)
- "Return the direction of a character of CHARSET by
- 0 (left-to-right) or 1 (right-to-left). [emu-e19.el]"
- 0)
-
-(defun find-charset-string (str)
- "Return a list of charsets in the string.
-\[emu-e19.el; Mule emulating function]"
- (if (string-match "[\200-\377]" str)
- (list charset-latin-iso8859-1)
- ))
-
-(defalias 'find-non-ascii-charset-string 'find-charset-string)
-
-(defun find-charset-region (start end)
- "Return a list of charsets in the region between START and END.
-\[emu-e19.el; Mule emulating function]"
- (if (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (re-search-forward "[\200-\377]" nil t)
- ))
- (list charset-latin-iso8859-1)
- ))
-
-(defalias 'find-non-ascii-charset-region 'find-charset-region)
-
-
-;;; @ coding-system
-;;;
-
-(defconst *internal* nil)
-(defconst *ctext* nil)
-(defconst *noconv* nil)
-
-(defun decode-coding-string (string coding-system)
- "Decode the STRING which is encoded in CODING-SYSTEM.
-\[emu-e19.el; Emacs 20 emulating function]"
- string)
-
-(defun encode-coding-string (string coding-system)
- "Encode the STRING as CODING-SYSTEM.
-\[emu-e19.el; Emacs 20 emulating function]"
- string)
-
-(defun decode-coding-region (start end coding-system)
- "Decode the text between START and END which is encoded in CODING-SYSTEM.
-\[emu-e19.el; Emacs 20 emulating function]"
- 0)
-
-(defun encode-coding-region (start end coding-system)
- "Encode the text between START and END to CODING-SYSTEM.
-\[emu-e19.el; Emacs 20 emulating function]"
- 0)
-
-(defun detect-coding-region (start end)
- "Detect coding-system of the text in the region between START and END.
-\[emu-e19.el; Emacs 20 emulating function]"
- )
-
-(defun set-buffer-file-coding-system (coding-system &optional force)
- "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM.
-\[emu-e19.el; Emacs 20 emulating function]"
- )
-
-(defmacro as-binary-process (&rest body)
- (` (let (selective-display) ; Disable ^M to nl translation.
- (,@ body)
- )))
-
-(defmacro as-binary-input-file (&rest body)
- (` (let ((emx-binary-mode t)) ; Stop CRLF to LF conversion in OS/2
- (,@ body)
- )))
-
-(defmacro as-binary-output-file (&rest body)
- (` (let ((emx-binary-mode t)) ; Stop CRLF to LF conversion in OS/2
- (,@ body)
- )))
-
-
-;;; @@ for old MULE emulation
-;;;
-
-(defun code-convert-string (str ic oc)
- "Convert code in STRING from SOURCE code to TARGET code,
-On successful converion, returns the result string,
-else returns nil. [emu-e19.el; old MULE emulating function]"
- str)
-
-(defun code-convert-region (beg end ic oc)
- "Convert code of the text between BEGIN and END from SOURCE
-to TARGET. On successful conversion returns t,
-else returns nil. [emu-e19.el; old MULE emulating function]"
- t)
-
-
-;;; @ binary access
-;;;
-
-(defun insert-binary-file-contents-literally
- (filename &optional visit beg end replace)
- "Like `insert-file-contents-literally', q.v., but don't code conversion.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
- This function ensures that none of these modifications will take place."
- (let ((emx-binary-mode t))
- (insert-file-contents-literally filename visit beg end replace)
- ))
-
-
-;;; @ MIME charset
-;;;
-
-(defvar charsets-mime-charset-alist
- (list (cons (list charset-ascii) 'us-ascii)))
-
-(defvar default-mime-charset 'iso-8859-1)
-
-(defun mime-charset-to-coding-system (charset)
- (if (stringp charset)
- (setq charset (intern (downcase charset)))
- )
- (and (memq charset (list 'us-ascii default-mime-charset))
- charset)
- )
-
-(defun detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END.
-\[emu-e19.el]"
- (if (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (re-search-forward "[\200-\377]" nil t)
- ))
- default-mime-charset
- 'us-ascii))
-
-(defun encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET.
-\[emu-e19.el]"
- )
-
-(defun decode-mime-charset-region (start end charset)
- "Decode the text between START and END as MIME CHARSET.
-\[emu-e19.el]"
- )
-
-(defun encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET. [emu-e19.el]"
- string)
-
-(defun decode-mime-charset-string (string charset)
- "Decode the STRING as MIME CHARSET. [emu-e19.el]"
- string)
-
-
-;;; @ character
-;;;
-
-(defun char-charset (chr)
- "Return the character set of char CHR.
-\[emu-e19.el; XEmacs 20 emulating function]"
- (if (< chr 128)
- charset-ascii
- charset-latin-iso8859-1))
-
-(defun char-bytes (char)
- "Return number of bytes a character in CHAR occupies in a buffer.
-\[emu-e19.el; MULE emulating function]"
- 1)
-
-(defalias 'char-length 'char-bytes)
-
-(defun char-columns (character)
- "Return number of columns a CHARACTER occupies when displayed.
-\[emu-e19.el]"
- 1)
-
-;;; @@ for old MULE emulation
-;;;
-
-(defalias 'char-width 'char-columns)
-
-(defalias 'char-leading-char 'char-charset)
-
-
-;;; @ string
-;;;
-
-(defalias 'string-columns 'length)
-
-(defun string-to-char-list (str)
- (mapcar (function identity) str)
- )
-
-(defalias 'string-to-int-list 'string-to-char-list)
-
-(defalias 'sref 'aref)
-
-(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-e19.el; MULE 2.3 emulating function]"
- (or start-column
- (setq start-column 0))
- (substring str start-column width)
- )
-
-;;; @@ for old MULE emulation
-;;;
-
-(defalias 'string-width 'length)
-
-
-;;; @ end
-;;;
-
-(provide 'emu-e19)
-
-;;; emu-e19.el ends here
+++ /dev/null
-;;; emu-e20.el --- emu API implementation for Emacs 20
-
-;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-e20.el,v 7.26 1997/11/04 09:10:31 morioka Exp $
-;; Keywords: emulation, compatibility, Mule
-
-;; This file is part of emu.
-
-;; 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This module requires Emacs 20.1 or later.
-
-;;; Code:
-
-(require 'emu-19)
-
-(defun fontset-pixel-size (fontset)
- (let* ((info (fontset-info fontset))
- (height (aref info 1))
- )
- (cond ((> height 0) height)
- ((string-match "-\\([0-9]+\\)-" fontset)
- (string-to-number
- (substring fontset (match-beginning 1)(match-end 1))
- )
- )
- (t 0)
- )))
-
-
-;;; @ character set
-;;;
-
-;; (defalias 'charset-columns 'charset-width)
-
-(defun find-non-ascii-charset-string (string)
- "Return a list of charsets in the STRING except ascii."
- (delq 'ascii (find-charset-string string))
- )
-
-(defun find-non-ascii-charset-region (start end)
- "Return a list of charsets except ascii
-in the region between START and END."
- (delq 'ascii (find-charset-string (buffer-substring start end)))
- )
-
-
-;;; @ coding system
-;;;
-
-(defsubst-maybe find-coding-system (obj)
- "Return OBJ if it is a coding-system."
- (if (coding-system-p obj)
- obj))
-
-(defalias 'set-process-input-coding-system 'set-process-coding-system)
-
-
-;;; @ MIME charset
-;;;
-
-(defsubst encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET."
- (let (cs)
- (if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset)))
- (encode-coding-region start end cs)
- )))
-
-(defsubst decode-mime-charset-region (start end charset)
- "Decode the text between START and END as MIME CHARSET."
- (let (cs)
- (if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset)))
- (decode-coding-region start end cs)
- )))
-
-(defsubst encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET."
- (let (cs)
- (if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset)))
- (encode-coding-string string cs)
- string)))
-
-(defsubst decode-mime-charset-string (string charset)
- "Decode the STRING as MIME CHARSET."
- (let (cs)
- (if (and enable-multibyte-characters
- (setq cs (mime-charset-to-coding-system charset)))
- (decode-coding-string string cs)
- string)))
-
-
-(defvar charsets-mime-charset-alist
- '(((ascii) . us-ascii)
- ((ascii latin-iso8859-1) . iso-8859-1)
- ((ascii latin-iso8859-2) . iso-8859-2)
- ((ascii latin-iso8859-3) . iso-8859-3)
- ((ascii latin-iso8859-4) . iso-8859-4)
-;;; ((ascii cyrillic-iso8859-5) . iso-8859-5)
- ((ascii cyrillic-iso8859-5) . koi8-r)
- ((ascii arabic-iso8859-6) . iso-8859-6)
- ((ascii greek-iso8859-7) . iso-8859-7)
- ((ascii hebrew-iso8859-8) . iso-8859-8)
- ((ascii latin-iso8859-9) . iso-8859-9)
- ((ascii latin-jisx0201
- japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
- ((ascii korean-ksc5601) . euc-kr)
- ((ascii chinese-gb2312) . cn-gb-2312)
- ((ascii chinese-big5-1 chinese-big5-2) . cn-big5)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
- ((ascii latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7) . iso-2022-int-1)
- ))
-
-
-;;; @ character
-;;;
-
-(defalias 'char-length 'char-bytes)
-
-(defalias 'char-columns 'char-width)
-
-
-;;; @@ Mule emulating aliases
-;;;
-;;; You should not use them.
-
-(defun char-category (character)
- "Return string of category mnemonics for CHAR in TABLE.
-CHAR can be any multilingual character
-TABLE defaults to the current buffer's category table."
- (category-set-mnemonics (char-category-set character))
- )
-
-
-;;; @ string
-;;;
-
-(defalias 'string-columns 'string-width)
-
-(defalias 'sset 'store-substring)
-
-(defun string-to-char-list (string)
- "Return a list of which elements are characters in the STRING."
- (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)
-
-
-;;; @ end
-;;;
-
-(require 'emu-20)
-
-(provide 'emu-e20)
-
-;;; emu-e20.el ends here
;;; emu-mule.el --- emu module for Mule 1.* and Mule 2.*
-;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
+;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-mule.el,v 7.65 1997/11/04 08:01:11 morioka Exp $
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: emulation, compatibility, Mule
;; This file is part of emu.
;;; Code:
-;;; @ version specific features
-;;;
-
-(cond (running-emacs-19
- (require 'emu-19)
-
- ;; Suggested by SASAKI Osamu <osamu@shuugr.bekkoame.or.jp>
- ;; (cf. [os2-emacs-ja:78])
- (defun fontset-pixel-size (fontset)
- (let* ((font (get-font-info
- (aref (cdr (get-fontset-info fontset)) 0)))
- (open (aref font 4)))
- (if (= open 1)
- (aref font 5)
- (if (= open 0)
- (let ((pat (aref font 1)))
- (if (string-match "-[0-9]+-" pat)
- (string-to-number
- (substring
- pat (1+ (match-beginning 0)) (1- (match-end 0))))
- 0)))
- )))
- )
- (running-emacs-18
- (require 'emu-18)
- (defun make-overlay (beg end &optional buffer type))
- (defun overlay-put (overlay prop value))
- ))
-
-
-;;; @ character set
-;;;
-
-(defalias 'make-char 'make-character)
-
-(defalias 'find-non-ascii-charset-string 'find-charset-string)
-(defalias 'find-non-ascii-charset-region 'find-charset-region)
-
-(defalias 'charset-bytes 'char-bytes)
-(defalias 'charset-description 'char-description)
-(defalias 'charset-registry 'char-registry)
-(defalias 'charset-columns 'char-width)
-(defalias 'charset-direction 'char-direction)
-
-
-;;; @ coding system
-;;;
-
-(defun encode-coding-region (start end coding-system)
- "Encode the text between START and END to CODING-SYSTEM.
-\[EMACS 20 emulating function]"
- (code-convert-region start end *internal* coding-system)
- )
-
-(defun decode-coding-region (start end coding-system)
- "Decode the text between START and END which is encoded in CODING-SYSTEM.
-\[EMACS 20 emulating function]"
- (code-convert-region start end coding-system *internal*)
- )
-
-(defun encode-coding-string (str coding-system)
- "Encode the STRING to CODING-SYSTEM.
-\[EMACS 20 emulating function]"
- (code-convert-string str *internal* coding-system)
- )
-
-(defun decode-coding-string (str coding-system)
- "Decode the string STR which is encoded in CODING-SYSTEM.
-\[EMACS 20 emulating function]"
- (let ((len (length str))
- ret)
- (while (and
- (< 0 len)
- (null
- (setq ret
- (code-convert-string (substring str 0 len)
- coding-system *internal*))
- ))
- (setq len (1- len))
- )
- (concat ret (substring str len))
- ))
-
-(defalias 'detect-coding-region 'code-detect-region)
-
-(defalias 'set-buffer-file-coding-system 'set-file-coding-system)
-
-(defmacro as-binary-process (&rest body)
- (` (let (selective-display ; Disable ^M to nl translation.
- ;; Mule
- mc-flag
- (default-process-coding-system (cons *noconv* *noconv*))
- program-coding-system-alist)
- (,@ body)
- )))
-
-(defmacro as-binary-input-file (&rest body)
- (` (let (mc-flag
- (file-coding-system-for-read *noconv*)
- )
- (,@ body)
- )))
-
-(defmacro as-binary-output-file (&rest body)
- (` (let (mc-flag
- (file-coding-system *noconv*)
- )
- (,@ body)
- )))
-
-(defalias 'set-process-input-coding-system 'set-process-coding-system)
-
-
-;;; @ binary access
-;;;
-
-(defun insert-binary-file-contents-literally
- (filename &optional visit beg end replace)
- "Like `insert-file-contents-literally', q.v., but don't code conversion.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
- This function ensures that none of these modifications will take place."
- (let (mc-flag
- (file-coding-system *noconv*)
- )
- (insert-file-contents-literally filename visit beg end replace)
- ))
-
-
-;;; @ MIME charset
-;;;
-
-(defun encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (code-convert start end *internal* cs)
- )))
-
-(defun decode-mime-charset-region (start end charset)
- "Decode the text between START and END as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (code-convert start end cs *internal*)
- )))
-
-(defun encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (code-convert-string string *internal* cs)
- string)))
-
-(defun decode-mime-charset-string (string charset)
- "Decode the STRING which is encoded in MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (decode-coding-string string cs)
- string)))
-
-
-;;; @@ to coding-system
-;;;
-
-(defvar mime-charset-coding-system-alist
- '((iso-8859-1 . *ctext*)
- (x-ctext . *ctext*)
- (gb2312 . *euc-china*)
- (koi8-r . *koi8*)
- (iso-2022-jp-2 . *iso-2022-ss2-7*)
- (x-iso-2022-jp-2 . *iso-2022-ss2-7*)
- (shift_jis . *sjis*)
- (x-shiftjis . *sjis*)
- ))
-
-(defun mime-charset-to-coding-system (charset &optional lbt)
- (if (stringp charset)
- (setq charset (intern (downcase charset)))
- )
- (let ((cs
- (or (cdr (assq charset mime-charset-coding-system-alist))
- (let ((cs (intern (concat "*" (symbol-name charset) "*"))))
- (and (coding-system-p cs) cs)
- ))))
- (if (or (null lbt)
- (null cs))
- cs
- (intern (concat (symbol-name cs) (symbol-name lbt)))
- )))
-
-
-;;; @@ detection
-;;;
-
-(defvar charsets-mime-charset-alist
- (let ((alist
- '(((lc-ascii) . 'us-ascii)
- ((lc-ascii lc-ltn1) . 'iso-8859-1)
- ((lc-ascii lc-ltn2) . 'iso-8859-2)
- ((lc-ascii lc-ltn3) . 'iso-8859-3)
- ((lc-ascii lc-ltn4) . 'iso-8859-4)
-;;; ((lc-ascii lc-crl) . 'iso-8859-5)
- ((lc-ascii lc-crl) . 'koi8-r)
- ((lc-ascii lc-arb) . 'iso-8859-6)
- ((lc-ascii lc-grk) . 'iso-8859-7)
- ((lc-ascii lc-hbw) . 'iso-8859-8)
- ((lc-ascii lc-ltn5) . 'iso-8859-9)
- ((lc-ascii lc-roman lc-jpold lc-jp) . 'iso-2022-jp)
- ((lc-ascii lc-kr) . 'euc-kr)
- ((lc-ascii lc-cn) . 'gb2312)
- ((lc-ascii lc-big5-1 lc-big5-2) . 'big5)
- ((lc-ascii lc-roman lc-ltn1 lc-grk
- lc-jpold lc-cn lc-jp lc-kr
- lc-jp2) . 'iso-2022-jp-2)
- ((lc-ascii lc-roman lc-ltn1 lc-grk
- lc-jpold lc-cn lc-jp lc-kr lc-jp2
- lc-cns1 lc-cns2) . 'iso-2022-int-1)
- ((lc-ascii lc-roman
- lc-ltn1 lc-ltn2 lc-crl lc-grk
- lc-jpold lc-cn lc-jp lc-kr lc-jp2
- lc-cns1 lc-cns2 lc-cns3 lc-cns4
- lc-cns5 lc-cns6 lc-cns7) . 'iso-2022-int-1)
- ))
- dest)
- (while alist
- (catch 'not-found
- (let ((pair (car alist)))
- (setq dest
- (cons (mapcar (function
- (lambda (cs)
- (if (boundp cs)
- (symbol-value cs)
- (throw 'not-found nil)
- )))
- (car pair))
- (cdr pair)))))
- (setq alist (cdr alist))))
- )
-
-(defvar default-mime-charset 'x-ctext
- "Default value of MIME-charset.
-It is used when MIME-charset is not specified.
-It must be symbol.")
-
-(defun detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END."
- (charsets-to-mime-charset
- (cons lc-ascii (find-charset-region start end))))
-
-
-;;; @ character
-;;;
-
-(defalias 'char-charset 'char-leading-char)
-
-(defalias 'char-length 'char-bytes)
-
-(defalias 'char-columns 'char-width)
-
-
-;;; @ string
-;;;
-
-(defalias 'string-columns 'string-width)
-
-(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-mule.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))))
-;;;
- )
+(require 'poem)
;;; @ regulation
(defun regulate-latin-char (chr)
(cond ((and (<= ?\e$B#A\e(B chr)(<= chr ?\e$B#Z\e(B))
- (+ (- chr ?\e$B#A\e(B) ?A)
- )
+ (+ (- chr ?\e$B#A\e(B) ?A))
((and (<= ?\e$B#a\e(B chr)(<= chr ?\e$B#z\e(B))
- (+ (- chr ?\e$B#a\e(B) ?a)
- )
+ (+ (- chr ?\e$B#a\e(B) ?a))
((eq chr ?\e$B!%\e(B) ?.)
((eq chr ?\e$B!$\e(B) ?,)
- (t chr)
- ))
+ (t chr)))
(defun regulate-latin-string (str)
(let ((len (length str))
(setq chr (sref str i))
(setq dest (concat dest
(char-to-string (regulate-latin-char chr))))
- (setq i (+ i (char-bytes chr)))
- )
+ (setq i (+ i (char-bytes chr))))
dest))
+++ /dev/null
-;;; emu-nemacs.el --- emu API implementation for NEmacs
-
-;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-nemacs.el,v 7.53 1997/04/05 16:23:23 morioka Exp $
-;; Keywords: emulation, compatibility, NEmacs, mule
-
-;; This file is part of emu.
-
-;; 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 GNU Emacs; 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 'emu-18)
-
-
-;;; @ character set
-;;;
-
-(defconst charset-ascii 0 "Character set of ASCII")
-(defconst charset-jisx0208 146 "Character set of JIS X0208-1983")
-
-(defun charset-description (charset)
- "Return description of CHARSET. [emu-nemacs.el]"
- (if (< charset 128)
- (documentation-property 'charset-ascii 'variable-documentation)
- (documentation-property 'charset-jisx0208 'variable-documentation)
- ))
-
-(defun charset-registry (charset)
- "Return registry name of CHARSET. [emu-nemacs.el]"
- (if (< charset 128)
- "ASCII"
- "JISX0208.1983"))
-
-(defun charset-columns (charset)
- "Return number of columns a CHARSET occupies when displayed.
-\[emu-nemacs.el]"
- (if (< charset 128)
- 1
- 2))
-
-(defun charset-direction (charset)
- "Return the direction of a character of CHARSET by
- 0 (left-to-right) or 1 (right-to-left). [emu-nemacs.el]"
- 0)
-
-(defun find-charset-string (str)
- "Return a list of charsets in the string.
-\[emu-nemacs.el; Mule emulating function]"
- (if (string-match "[\200-\377]" str)
- (list lc-jp)
- ))
-
-(defalias 'find-non-ascii-charset-string 'find-charset-string)
-
-(defun find-charset-region (start end)
- "Return a list of charsets in the region between START and END.
-\[emu-nemacs.el; Mule emulating function]"
- (if (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (re-search-forward "[\200-\377]" nil t)
- ))
- (list lc-jp)
- ))
-
-(defalias 'find-non-ascii-charset-region 'find-charset-region)
-
-(defun check-ASCII-string (str)
- (let ((i 0)
- len)
- (setq len (length str))
- (catch 'label
- (while (< i len)
- (if (>= (elt str i) 128)
- (throw 'label nil))
- (setq i (+ i 1))
- )
- str)))
-
-;;; @@ for old MULE emulation
-;;;
-
-(defconst lc-ascii 0)
-(defconst lc-jp 146)
-
-
-;;; @ coding system
-;;;
-
-(defconst *noconv* 0)
-(defconst *sjis* 1)
-(defconst *junet* 2)
-(defconst *ctext* 2)
-(defconst *internal* 3)
-(defconst *euc-japan* 3)
-
-(defun decode-coding-string (string coding-system)
- "Decode the STRING which is encoded in CODING-SYSTEM.
-\[emu-nemacs.el; EMACS 20 emulating function]"
- (if (eq coding-system 3)
- string
- (convert-string-kanji-code string coding-system 3)
- ))
-
-(defun encode-coding-string (string coding-system)
- "Encode the STRING to CODING-SYSTEM.
-\[emu-nemacs.el; EMACS 20 emulating function]"
- (if (eq coding-system 3)
- string
- (convert-string-kanji-code string 3 coding-system)
- ))
-
-(defun decode-coding-region (start end coding-system)
- "Decode the text between START and END which is encoded in CODING-SYSTEM.
-\[emu-nemacs.el; EMACS 20 emulating function]"
- (if (/= ic oc)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (convert-region-kanji-code start end coding-system 3)
- ))))
-
-(defun encode-coding-region (start end coding-system)
- "Encode the text between START and END to CODING-SYSTEM.
-\[emu-nemacs.el; EMACS 20 emulating function]"
- (if (/= ic oc)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (convert-region-kanji-code start end 3 coding-system)
- ))))
-
-(defun detect-coding-region (start end)
- "Detect coding-system of the text in the region between START and END.
-\[emu-nemacs.el; Emacs 20 emulating function]"
- (if (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (re-search-forward "[\200-\377]" nil t)
- ))
- *euc-japan*
- ))
-
-(defalias 'set-buffer-file-coding-system 'set-kanji-fileio-code)
-
-(defmacro as-binary-process (&rest body)
- (` (let (selective-display ; Disable ^M to nl translation.
- ;; NEmacs
- kanji-flag
- (default-kanji-process-code 0)
- program-kanji-code-alist)
- (,@ body)
- )))
-
-(defmacro as-binary-input-file (&rest body)
- (` (let (kanji-flag)
- (,@ body)
- )))
-
-(defmacro as-binary-output-file (&rest body)
- (` (let (kanji-flag)
- (,@ body)
- )))
-
-
-;;; @@ for old MULE emulation
-;;;
-
-(defun code-convert-string (str ic oc)
- "Convert code in STRING from SOURCE code to TARGET code,
-On successful converion, returns the result string,
-else returns nil. [emu-nemacs.el; Mule emulating function]"
- (if (not (eq ic oc))
- (convert-string-kanji-code str ic oc)
- str))
-
-(defun code-convert-region (beg end ic oc)
- "Convert code of the text between BEGIN and END from SOURCE
-to TARGET. On successful conversion returns t,
-else returns nil. [emu-nemacs.el; Mule emulating function]"
- (if (/= ic oc)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (convert-region-kanji-code beg end ic oc)
- ))))
-
-
-;;; @ binary access
-;;;
-
-(defun insert-binary-file-contents-literally
- (filename &optional visit beg end replace)
- "Like `insert-file-contents-literally', q.v., but don't code conversion.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
- This function ensures that none of these modifications will take place.
-\[emu.el]"
- (let (kanji-flag)
- (insert-file-contents-literally filename visit beg end replace)
- ))
-
-
-;;; @ MIME charset
-;;;
-
-(defvar charsets-mime-charset-alist
- (list (cons (list charset-ascii) 'us-ascii)))
-
-(defvar default-mime-charset 'iso-2022-jp)
-
-(defvar mime-charset-coding-system-alist
- '((iso-2022-jp . 2)
- (shift_jis . 1)
- ))
-
-(defun mime-charset-to-coding-system (charset)
- (if (stringp charset)
- (setq charset (intern (downcase charset)))
- )
- (cdr (assq charset mime-charset-coding-system-alist))
- )
-
-(defun detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END.
-\[emu-nemacs.el]"
- (if (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char start)
- (re-search-forward "[\200-\377]" nil t)
- ))
- default-mime-charset
- 'us-ascii))
-
-(defun encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET.
-\[emu-nemacs.el]"
- (let ((cs (mime-charset-to-coding-system charset)))
- (and (numberp cs)
- (or (= cs 3)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (convert-region-kanji-code start end 3 cs)
- ))
- ))))
-
-(defun decode-mime-charset-region (start end charset)
- "Decode the text between START and END as MIME CHARSET.
-\[emu-nemacs.el]"
- (let ((cs (mime-charset-to-coding-system charset)))
- (and (numberp cs)
- (or (= cs 3)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (convert-region-kanji-code start end cs 3)
- ))
- ))))
-
-(defun encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET. [emu-nemacs.el]"
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (convert-string-kanji-code string 3 cs)
- string)))
-
-(defun decode-mime-charset-string (string charset)
- "Decode the STRING as MIME CHARSET. [emu-nemacs.el]"
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (convert-string-kanji-code string cs 3)
- string)))
-
-
-;;; @ character
-;;;
-
-(defun char-charset (chr)
- "Return the character set of char CHR.
-\[emu-nemacs.el; XEmacs 20 emulating function]"
- (if (< chr 128)
- charset-ascii
- charset-jisx0208))
-
-(defun char-bytes (chr)
- "Return number of bytes CHAR will occupy in a buffer.
-\[emu-nemacs.el; Mule emulating function]"
- (if (< chr 128) 1 2))
-
-(defalias 'char-length 'char-bytes)
-
-(defun char-columns (character)
- "Return number of columns a CHARACTER occupies when displayed.
-\[emu-nemacs.el]"
- (if (< character 128)
- 1
- 2))
-
-;;; @@ for Mule emulation
-;;;
-
-(defalias 'char-leading-char 'char-charset)
-
-(defalias 'char-width 'char-columns)
-
-
-;;; @ string
-;;;
-
-(defalias 'string-columns 'length)
-
-(defun sref (str idx)
- "Return the character in STR at index IDX.
-\[emu-nemacs.el; Mule emulating function]"
- (let ((chr (aref str idx)))
- (if (< chr 128)
- chr
- (logior (lsh (aref str (1+ idx)) 8) chr)
- )))
-
-(defun string-to-char-list (str)
- (let ((i 0)(len (length str)) dest chr)
- (while (< i len)
- (setq chr (aref str i))
- (if (>= chr 128)
- (setq i (1+ i)
- chr (+ (lsh chr 8) (aref str i))
- ))
- (setq dest (cons chr dest))
- (setq i (1+ i))
- )
- (reverse dest)
- ))
-
-(fset 'string-to-int-list (symbol-function 'string-to-char-list))
-
-;;; 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-mule.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-columns 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-columns ch))
- to-prev to
- to (+ to (char-bytes ch))))
- (setq to to-prev)))
- (substring str from to))))
-
-;;; @@ for Mule emulation
-;;;
-
-(defalias 'string-width 'length)
-
-
-;;; @ text property emulation
-;;;
-
-(defvar emu:available-face-attribute-alist
- '(
- ;;(bold . inversed-region)
- (italic . underlined-region)
- (underline . underlined-region)
- ))
-
-;; by YAMATE Keiichirou 1994/10/28
-(defun attribute-add-narrow-attribute (attr from to)
- (or (consp (symbol-value attr))
- (set attr (list 1)))
- (let* ((attr-value (symbol-value attr))
- (len (car attr-value))
- (posfrom 1)
- posto)
- (while (and (< posfrom len)
- (> from (nth posfrom attr-value)))
- (setq posfrom (1+ posfrom)))
- (setq posto posfrom)
- (while (and (< posto len)
- (> to (nth posto attr-value)))
- (setq posto (1+ posto)))
- (if (= posto posfrom)
- (if (= (% posto 2) 1)
- (if (and (< to len)
- (= to (nth posto attr-value)))
- (set-marker (nth posto attr-value) from)
- (setcdr (nthcdr (1- posfrom) attr-value)
- (cons (set-marker-type (set-marker (make-marker)
- from)
- 'point-type)
- (cons (set-marker-type (set-marker (make-marker)
- to)
- nil)
- (nthcdr posto attr-value))))
- (setcar attr-value (+ len 2))))
- (if (= (% posfrom 2) 0)
- (setq posfrom (1- posfrom))
- (set-marker (nth posfrom attr-value) from))
- (if (= (% posto 2) 0)
- nil
- (setq posto (1- posto))
- (set-marker (nth posto attr-value) to))
- (setcdr (nthcdr posfrom attr-value)
- (nthcdr posto attr-value)))))
-
-(defalias 'make-overlay 'cons)
-
-(defun overlay-put (overlay prop value)
- (let ((ret (and (eq prop 'face)
- (assq value emu:available-face-attribute-alist)
- )))
- (if ret
- (attribute-add-narrow-attribute (cdr ret)
- (car overlay)(cdr overlay))
- )))
-
-
-;;; @ end
-;;;
-
-(provide 'emu-nemacs)
-
-;;; emu-nemacs.el ends here
+++ /dev/null
-;;; emu-x20.el --- emu API implementation for XEmacs with mule
-
-;; Copyright (C) 1994,1995,1996,1997 MORIOKA Tomohiko
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-x20.el,v 7.68 1997/11/04 07:41:28 morioka Exp $
-;; Keywords: emulation, compatibility, Mule, XEmacs
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Commentary:
-
-;; This module requires XEmacs 20.3-b5 or later with mule.
-
-;;; Code:
-
-(require 'emu-xemacs)
-(require 'emu-20)
-
-
-;;; @ MIME charset
-;;;
-
-(defsubst encode-mime-charset-region (start end charset)
- "Encode the text between START and END as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (encode-coding-region start end cs)
- )))
-
-(defsubst decode-mime-charset-region (start end charset)
- "Decode the text between START and END as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (decode-coding-region start end cs)
- )))
-
-(defsubst encode-mime-charset-string (string charset)
- "Encode the STRING as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (encode-coding-string string cs)
- string)))
-
-(defsubst decode-mime-charset-string (string charset)
- "Decode the STRING as MIME CHARSET."
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (decode-coding-string string cs)
- string)))
-
-
-(defvar charsets-mime-charset-alist
- '(((ascii) . us-ascii)
- ((ascii latin-iso8859-1) . iso-8859-1)
- ((ascii latin-iso8859-2) . iso-8859-2)
- ((ascii latin-iso8859-3) . iso-8859-3)
- ((ascii latin-iso8859-4) . iso-8859-4)
- ((ascii cyrillic-iso8859-5) . iso-8859-5)
-;;; ((ascii cyrillic-iso8859-5) . koi8-r)
- ((ascii arabic-iso8859-6) . iso-8859-6)
- ((ascii greek-iso8859-7) . iso-8859-7)
- ((ascii hebrew-iso8859-8) . iso-8859-8)
- ((ascii latin-iso8859-9) . iso-8859-9)
- ((ascii latin-jisx0201
- japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
- ((ascii korean-ksc5601) . euc-kr)
- ((ascii chinese-gb2312) . cn-gb-2312)
- ((ascii chinese-big5-1 chinese-big5-2) . cn-big5)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
- ((ascii latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
- ((ascii latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7) . iso-2022-int-1)
- ))
-
-(defun detect-mime-charset-region (start end)
- "Return MIME charset for region between START and END."
- (charsets-to-mime-charset (charsets-in-region start end)))
-
-
-;;; @ character
-;;;
-
-;;; @@ Mule emulating aliases
-;;;
-;;; You should not use them.
-
-(defalias 'char-leading-char 'char-charset)
-
-(defun char-category (character)
- "Return string of category mnemonics for CHAR in TABLE.
-CHAR can be any multilingual character
-TABLE defaults to the current buffer's category table."
- (mapconcat (lambda (chr)
- (char-to-string (int-char chr))
- )
- (char-category-list character)
- ""))
-
-
-;;; @ string
-;;;
-
-(defun string-to-int-list (str)
- (mapcar #'char-int str)
- )
-
-
-;;; @ end
-;;;
-
-(provide 'emu-x20)
-
-;;; emu-x20.el ends here
+++ /dev/null
-;;; emu-xemacs.el --- emu API implementation for XEmacs
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version:
-;; $Id: emu-xemacs.el,v 7.19 1997/04/05 06:50:48 morioka Exp $
-;; Keywords: emulation, compatibility, XEmacs
-
-;; This file is part of XEmacs.
-
-;; 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 XEmacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Code:
-
-;;; @ face
-;;;
-
-(or (fboundp 'face-list)
- (defalias 'face-list 'list-faces)
- )
-
-(or (memq 'underline (face-list))
- (and (fboundp 'make-face)
- (make-face 'underline)
- ))
-
-(or (face-differs-from-default-p 'underline)
- (set-face-underline-p 'underline t))
-
-
-;;; @ overlay
-;;;
-
-(condition-case err
- (require 'overlay)
- (error (defalias 'make-overlay 'make-extent)
- (defalias 'overlay-put 'set-extent-property)
- (defalias 'overlay-buffer 'extent-buffer)
- (defun move-overlay (extent start end &optional buffer)
- (set-extent-endpoints extent start end)
- )
- ))
-
-
-;;; @ visible/invisible
-;;;
-
-(defmacro enable-invisible ())
-
-(defmacro end-of-invisible ())
-
-(defun invisible-region (start end)
- (if (save-excursion
- (goto-char start)
- (eq (following-char) ?\n)
- )
- (setq start (1+ start))
- )
- (put-text-property start end 'invisible t)
- )
-
-(defun visible-region (start end)
- (put-text-property start end 'invisible nil)
- )
-
-(defun invisible-p (pos)
- (if (save-excursion
- (goto-char pos)
- (eq (following-char) ?\n)
- )
- (setq pos (1+ pos))
- )
- (get-text-property pos 'invisible)
- )
-
-(defun next-visible-point (pos)
- (save-excursion
- (if (save-excursion
- (goto-char pos)
- (eq (following-char) ?\n)
- )
- (setq pos (1+ pos))
- )
- (or (next-single-property-change pos 'invisible)
- (point-max))
- ))
-
-
-;;; @ mouse
-;;;
-
-(defvar mouse-button-1 'button1)
-(defvar mouse-button-2 'button2)
-(defvar mouse-button-3 'button3)
-
-
-;;; @ dired
-;;;
-
-(or (fboundp 'dired-other-frame)
- (defun dired-other-frame (dirname &optional switches)
- "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
- (interactive (dired-read-dir-and-switches "in other frame "))
- (switch-to-buffer-other-frame (dired-noselect dirname switches))
- )
- )
-
-
-;;; @ string
-;;;
-
-(defmacro char-list-to-string (char-list)
- "Convert list of character CHAR-LIST to string. [emu-xemacs.el]"
- `(mapconcat #'char-to-string ,char-list ""))
-
-
-;;; @@ to avoid bug of XEmacs 19.14
-;;;
-
-(or (string-match "^../"
- (file-relative-name "/usr/local/share" "/usr/local/lib"))
- ;; This function was imported from Emacs 19.33.
- (defun file-relative-name (filename &optional directory)
- "Convert FILENAME to be relative to DIRECTORY
-(default: default-directory). [emu-xemacs.el]"
- (setq filename (expand-file-name filename)
- directory (file-name-as-directory
- (expand-file-name
- (or directory default-directory))))
- (let ((ancestor ""))
- (while (not (string-match (concat "^" (regexp-quote directory))
- filename))
- (setq directory (file-name-directory (substring directory 0 -1))
- ancestor (concat "../" ancestor)))
- (concat ancestor (substring filename (match-end 0)))
- ))
- )
-
-
-;;; @ end
-;;;
-
-(provide 'emu-xemacs)
-
-;;; emu-xemacs.el ends here
;;; emu.el --- Emulation module for each Emacs variants
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu.el,v 7.48 1997/09/07 02:37:40 morioka Exp $
;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
;; This file is part of emu.
;;; Code:
-(defmacro defun-maybe (name &rest everything-else)
- (or (and (fboundp name)
- (not (get name 'defun-maybe))
- )
- (` (or (fboundp (quote (, name)))
- (progn
- (defun (, name) (,@ everything-else))
- (put (quote (, name)) 'defun-maybe t)
- ))
- )))
-
-(defmacro defsubst-maybe (name &rest everything-else)
- (or (and (fboundp name)
- (not (get name 'defsubst-maybe))
- )
- (` (or (fboundp (quote (, name)))
- (progn
- (defsubst (, name) (,@ everything-else))
- (put (quote (, name)) 'defsubst-maybe t)
- ))
- )))
-
-(defmacro defmacro-maybe (name &rest everything-else)
- (or (and (fboundp name)
- (not (get name 'defmacro-maybe))
- )
- (` (or (fboundp (quote (, name)))
- (progn
- (defmacro (, name) (,@ everything-else))
- (put (quote (, name)) 'defmacro-maybe t)
- ))
- )))
-
-(put 'defun-maybe 'lisp-indent-function 'defun)
-(put 'defsubst-maybe 'lisp-indent-function 'defun)
-(put 'defmacro-maybe 'lisp-indent-function 'defun)
-
-(defmacro defconst-maybe (name &rest everything-else)
- (or (and (boundp name)
- (not (get name 'defconst-maybe))
- )
- (` (or (boundp (quote (, name)))
- (progn
- (defconst (, name) (,@ everything-else))
- (put (quote (, name)) 'defconst-maybe t)
- ))
- )))
-
-
-(defconst-maybe emacs-major-version (string-to-int emacs-version))
-(defconst-maybe emacs-minor-version
- (string-to-int
- (substring emacs-version
- (string-match (format "%d\\." emacs-major-version)
- emacs-version))))
+(require 'poe)
(defvar running-emacs-18 (<= emacs-major-version 18))
-(defvar running-xemacs (string-match "XEmacs" emacs-version))
+(defvar running-xemacs (featurep 'xemacs))
(defvar running-mule-merged-emacs (and (not (boundp 'MULE))
(not running-xemacs) (featurep 'mule)))
(or (and running-xemacs-19 (>= emacs-minor-version 14))
running-xemacs-20-or-later))
-(cond (running-mule-merged-emacs
- ;; for mule merged EMACS
- (require 'emu-e20)
+(cond (running-xemacs
+ ;; for XEmacs
+ (defvar mouse-button-1 'button1)
+ (defvar mouse-button-2 'button2)
+ (defvar mouse-button-3 'button3)
)
- (running-xemacs-with-mule
- ;; for XEmacs/mule
- (require 'emu-x20)
+ ((>= emacs-major-version 19)
+ ;; mouse
+ (defvar mouse-button-1 [mouse-1])
+ (defvar mouse-button-2 [mouse-2])
+ (defvar mouse-button-3 [down-mouse-3])
)
- ((boundp 'MULE)
- ;; for MULE 1.* and 2.*
- (require 'emu-mule)
+ (t
+ ;; mouse
+ (defvar mouse-button-1 nil)
+ (defvar mouse-button-2 nil)
+ (defvar mouse-button-3 nil)
+ ))
+
+;; for tm-7.106
+(unless (fboundp 'tl:make-overlay)
+ (defalias 'tl:make-overlay 'make-overlay)
+ (make-obsolete 'tl:make-overlay 'make-overlay)
+ )
+(unless (fboundp 'tl:overlay-put)
+ (defalias 'tl:overlay-put 'overlay-put)
+ (make-obsolete 'tl:overlay-put 'overlay-put)
+ )
+(unless (fboundp 'tl:overlay-put)
+ (defalias 'tl:overlay-buffer 'overlay-buffer)
+ (make-obsolete 'tl:overlay-buffer 'overlay-buffer)
+ )
+
+(require 'poem)
+(require 'mcharset)
+
+(cond ((featurep 'mule)
+ (cond ((featurep 'xemacs) ; for XEmacs with MULE
+ ;; old Mule emulating aliases
+
+ ;;(defalias 'char-leading-char 'char-charset)
+
+ (defun char-category (character)
+ "Return string of category mnemonics for CHAR in TABLE.
+CHAR can be any multilingual character
+TABLE defaults to the current buffer's category table."
+ (mapconcat (lambda (chr)
+ (char-to-string (int-char chr)))
+ (char-category-list character)
+ ""))
+ )
+ ((>= emacs-major-version 20) ; for Emacs 20
+ (defalias 'insert-binary-file-contents-literally
+ 'insert-file-contents-literally)
+
+ ;; old Mule emulating aliases
+ (defun char-category (character)
+ "Return string of category mnemonics for CHAR in TABLE.
+CHAR can be any multilingual character
+TABLE defaults to the current buffer's category table."
+ (category-set-mnemonics (char-category-set character)))
+ )
+ (t ; for MULE 1.* and 2.*
+ (require 'emu-mule)
+ ))
)
((boundp 'NEMACS)
;; for NEmacs and NEpoch
- (require 'emu-nemacs)
+
+ ;; old MULE emulation
+ (defconst *noconv* 0)
+ (defconst *sjis* 1)
+ (defconst *junet* 2)
+ (defconst *ctext* 2)
+ (defconst *internal* 3)
+ (defconst *euc-japan* 3)
+
+ (defun code-convert-string (str ic oc)
+ "Convert code in STRING from SOURCE code to TARGET code,
+On successful converion, returns the result string,
+else returns nil. [emu-nemacs.el; Mule emulating function]"
+ (if (not (eq ic oc))
+ (convert-string-kanji-code str ic oc)
+ str))
+
+ (defun code-convert-region (beg end ic oc)
+ "Convert code of the text between BEGIN and END from SOURCE
+to TARGET. On successful conversion returns t,
+else returns nil. [emu-nemacs.el; Mule emulating function]"
+ (if (/= ic oc)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (convert-region-kanji-code beg end ic oc)))
+ ))
)
(t
- ;; for EMACS 19 and XEmacs 19 (without mule)
- (require 'emu-e19)
+ ;; for Emacs 19 and XEmacs without MULE
+
+ ;; old MULE emulation
+ (defconst *internal* nil)
+ (defconst *ctext* nil)
+ (defconst *noconv* nil)
+
+ (defun code-convert-string (str ic oc)
+ "Convert code in STRING from SOURCE code to TARGET code,
+On successful converion, returns the result string,
+else returns nil. [emu-latin1.el; old MULE emulating function]"
+ str)
+
+ (defun code-convert-region (beg end ic oc)
+ "Convert code of the text between BEGIN and END from SOURCE
+to TARGET. On successful conversion returns t,
+else returns nil. [emu-latin1.el; old MULE emulating function]"
+ t)
))
-;;; @ MIME charset
-;;;
-
-(defun charsets-to-mime-charset (charsets)
- "Return MIME charset from list of charset CHARSETS.
-This function refers variable `charsets-mime-charset-alist'
-and `default-mime-charset'."
- (if charsets
- (or (catch 'tag
- (let ((rest charsets-mime-charset-alist)
- cell)
- (while (setq cell (car rest))
- (if (catch 'not-subset
- (let ((set1 charsets)
- (set2 (car cell))
- obj)
- (while set1
- (setq obj (car set1))
- (or (memq obj set2)
- (throw 'not-subset nil)
- )
- (setq set1 (cdr set1))
- )
- t))
- (throw 'tag (cdr cell))
- )
- (setq rest (cdr rest))
- )))
- default-mime-charset)))
-
-
-;;; @ Emacs 19 emulation
+;;; @ Mule emulating aliases
;;;
+;;; You should not use it.
-(defun-maybe minibuffer-prompt-width ()
- "Return the display width of the minibuffer prompt."
- (save-excursion
- (set-buffer (window-buffer (minibuffer-window)))
- (current-column)
- ))
+(or (boundp '*noconv*)
+ (defconst *noconv* 'binary
+ "Coding-system for binary.
+This constant is defined to emulate old MULE anything older than MULE 2.3.
+It is obsolete, so don't use it."))
-;;; @ Emacs 19.29 emulation
+;;; @ without code-conversion
;;;
-(defvar path-separator ":"
- "Character used to separate concatenated paths.")
-
-(defun-maybe buffer-substring-no-properties (start end)
- "Return the characters of part of the buffer, without the text properties.
-The two arguments START and END are character positions;
-they can be in either order. [Emacs 19.29 emulating function]"
- (let ((string (buffer-substring start end)))
- (set-text-properties 0 (length string) nil string)
- string))
-
-(defun-maybe match-string (num &optional string)
- "Return string of text matched by last search.
-NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
-Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING.
-\[Emacs 19.29 emulating function]"
- (if (match-beginning num)
- (if string
- (substring string (match-beginning num) (match-end num))
- (buffer-substring (match-beginning num) (match-end num)))))
-
-(or running-emacs-19_29-or-later
- running-xemacs
- ;; for Emacs 19.28 or earlier
- (fboundp 'si:read-string)
- (progn
- (fset 'si:read-string (symbol-function 'read-string))
-
- (defun read-string (prompt &optional initial-input history)
- "Read a string from the minibuffer, prompting with string PROMPT.
-If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
-The third arg HISTORY, is dummy for compatibility. [emu.el]
-See `read-from-minibuffer' for details of HISTORY argument."
- (si:read-string prompt initial-input)
- )
- ))
-
-
-;;; @ Emacs 19.30 emulation
-;;;
+(defalias 'insert-binary-file-contents 'insert-file-contents-as-binary)
+(make-obsolete 'insert-binary-file-contents 'insert-file-contents-as-binary)
-;; This function was imported Emacs 19.30.
-(defun-maybe add-to-list (list-var element)
- "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
-If you want to use `add-to-list' on a variable that is not defined
-until a certain package is loaded, you should put the call to `add-to-list'
-into a hook function that will be run only after loading the package.
-\[Emacs 19.30 emulating function]"
- (or (member element (symbol-value list-var))
- (set list-var (cons element (symbol-value list-var)))
- ))
-
-(cond ((fboundp 'insert-file-contents-literally)
- )
- ((boundp 'file-name-handler-alist)
- (defun insert-file-contents-literally
- (filename &optional visit beg end replace)
- "Like `insert-file-contents', q.v., but only reads in the file.
+(defun-maybe insert-binary-file-contents-literally (filename
+ &optional visit
+ beg end replace)
+ "Like `insert-file-contents-literally', q.v., but don't code conversion.
A buffer may be modified in several ways after reading into the buffer due
to advanced Emacs features, such as file-name-handlers, format decoding,
find-file-hooks, etc.
This function ensures that none of these modifications will take place.
-\[Emacs 19.30 emulating function]"
- (let (file-name-handler-alist)
- (insert-file-contents filename visit beg end replace)
- ))
- )
- (t
- (defalias 'insert-file-contents-literally 'insert-file-contents)
- ))
-
-
-;;; @ Emacs 19.31 emulation
-;;;
-
-(defun-maybe buffer-live-p (object)
- "Return non-nil if OBJECT is a buffer which has not been killed.
-Value is nil if OBJECT is not a buffer or if it has been killed.
-\[Emacs 19.31 emulating function]"
- (and object
- (get-buffer object)
- (buffer-name (get-buffer object))
- ))
-
-;; This macro was imported Emacs 19.33.
-(defmacro-maybe save-selected-window (&rest body)
- "Execute BODY, then select the window that was selected before BODY.
-\[Emacs 19.31 emulating function]"
- (list 'let
- '((save-selected-window-window (selected-window)))
- (list 'unwind-protect
- (cons 'progn body)
- (list 'select-window 'save-selected-window-window))))
-
-
-;;; @ XEmacs emulation
-;;;
-
-(defun-maybe functionp (obj)
- "Returns t if OBJ is a function, nil otherwise.
-\[XEmacs emulating function]"
- (or (subrp obj)
- (byte-code-function-p obj)
- (and (symbolp obj)(fboundp obj))
- (and (consp obj)(eq (car obj) 'lambda))
- ))
-
-(defun-maybe point-at-eol (&optional arg buffer)
- "Return the character position of the last character on the current line.
-With argument N not nil or 1, move forward N - 1 lines first.
-If scan reaches end of buffer, return that position.
-This function does not move point. [XEmacs emulating function]"
- (save-excursion
- (if buffer
- (set-buffer buffer)
- )
- (if arg
- (forward-line (1- arg))
- )
- (end-of-line)
- (point)
- ))
-
-
-;;; @ for XEmacs 20
-;;;
-
-(or (fboundp 'char-int)
- (fset 'char-int (symbol-function 'identity))
- )
-(or (fboundp 'int-char)
- (fset 'int-char (symbol-function 'identity))
- )
-(or (fboundp 'char-or-char-int-p)
- (fset 'char-or-char-int-p (symbol-function 'integerp))
- )
+\[emu-nemacs.el]"
+ (as-binary-input-file
+ ;; Returns list absolute file name and length of data inserted.
+ (insert-file-contents-literally filename visit beg end replace)))
;;; @ for text/richtext and text/enriched
--- /dev/null
+;;; env.el --- functions to manipulate environment variables.
+
+;; Copyright (C) 1991, 1994 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: processes, unix
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; UNIX processes inherit a list of name-to-string associations from their
+;; parents called their `environment'; these are commonly used to control
+;; program options. This package permits you to set environment variables
+;; to be passed to any sub-process run under Emacs.
+
+;;; Code:
+
+;; History list for environment variable names.
+(defvar read-envvar-name-history nil)
+
+(defun read-envvar-name (prompt &optional mustmatch)
+ "Read environment variable name, prompting with PROMPT.
+Optional second arg MUSTMATCH, if non-nil, means require existing envvar name.
+If it is also not t, RET does not exit if it does non-null completion."
+ (completing-read prompt
+ (mapcar (function
+ (lambda (enventry)
+ (list (substring enventry 0
+ (string-match "=" enventry)))))
+ process-environment)
+ nil mustmatch nil 'read-envvar-name-history))
+
+;; History list for VALUE argument to setenv.
+(defvar setenv-history nil)
+
+;;;###autoload
+(defun setenv (variable &optional value unset)
+ "Set the value of the environment variable named VARIABLE to VALUE.
+VARIABLE should be a string. VALUE is optional; if not provided or is
+`nil', the environment variable VARIABLE will be removed.
+
+Interactively, a prefix argument means to unset the variable.
+Interactively, the current value (if any) of the variable
+appears at the front of the history list when you type in the new value.
+
+This function works by modifying `process-environment'."
+ (interactive
+ (if current-prefix-arg
+ (list (read-envvar-name "Clear environment variable: " 'exact) nil t)
+ (let* ((var (read-envvar-name "Set environment variable: " nil))
+ (oldval (getenv var))
+ newval
+ oldhist)
+ ;; Don't put the current value on the history
+ ;; if it is already there.
+ (if (equal oldval (car setenv-history))
+ (setq oldval nil))
+ ;; Now if OLDVAL is non-nil, we should add it to the history.
+ (if oldval
+ (setq setenv-history (cons oldval setenv-history)))
+ (setq oldhist setenv-history)
+ (setq newval (read-from-minibuffer (format "Set %s to value: " var)
+ nil nil nil 'setenv-history))
+ ;; If we added the current value to the history, remove it.
+ ;; Note that read-from-minibuffer may have added the new value.
+ ;; Don't remove that!
+ (if oldval
+ (if (eq oldhist setenv-history)
+ (setq setenv-history (cdr setenv-history))
+ (setcdr setenv-history (cdr (cdr setenv-history)))))
+ ;; Here finally we specify the args to give call setenv with.
+ (list var newval))))
+ (if unset (setq value nil))
+ (if (string-match "=" variable)
+ (error "Environment variable name `%s' contains `='" variable)
+ (let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
+ (case-fold-search nil)
+ (scan process-environment)
+ found)
+ (if (string-equal "TZ" variable)
+ (set-time-zone-rule value))
+ (while scan
+ (cond ((string-match pattern (car scan))
+ (setq found t)
+ (if (eq nil value)
+ (setq process-environment (delq (car scan) process-environment))
+ (setcar scan (concat variable "=" value)))
+ (setq scan nil)))
+ (setq scan (cdr scan)))
+ (or found
+ (if value
+ (setq process-environment
+ (cons (concat variable "=" value)
+ process-environment)))))))
+
+(provide 'env)
+
+;;; env.el ends here
--- /dev/null
+--<<alternative>>-{
+
+ It is available from
+
+ ftp://ftp.jaist.ac.jp/pub/GNU/elisp/apel/
+
+--[[message/external-body;
+ access-type=anon-ftp;
+ site="ftp.jaist.ac.jp";
+ directory="/pub/GNU/elisp/apel";
+ name="apel-VERSION.tar.gz";
+ mode=image]]
+Content-Type: application/octet-stream;
+ name="apel-VERSION.tar.gz";
+ type=tar;
+ conversions=gzip
+--}-<<alternative>>
(or
(catch 'tag
(let ((rest default-load-path)
+ (pat (concat "^"
+ (expand-file-name (concat ".*/" elisp-prefix) prefix)
+ "/?$"))
dir)
(while (setq dir (car rest))
- (if (string-match
- (concat "^"
- (expand-file-name (concat ".*/" elisp-prefix) prefix)
- "$")
- dir)
+ (if (string-match pat dir)
(if (or allow-version-specific
(not (string-match (format "%d\\.%d"
emacs-major-version
--- /dev/null
+;;; mcharset.el --- MIME charset API
+
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; 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 'poe)
+
+(cond ((featurep 'mule)
+ (cond ((featurep 'xemacs)
+ (require 'mcs-xm)
+ )
+ ((>= emacs-major-version 20)
+ (require 'mcs-e20)
+ )
+ (t
+ ;; for MULE 1.* and 2.*
+ (require 'mcs-om)
+ ))
+ )
+ ((boundp 'NEMACS)
+ ;; for Nemacs and Nepoch
+ (require 'mcs-nemacs)
+ )
+ (t
+ (require 'mcs-ltn1)
+ ))
+
+
+(defun charsets-to-mime-charset (charsets)
+ "Return MIME charset from list of charset CHARSETS.
+This function refers variable `charsets-mime-charset-alist'
+and `default-mime-charset'."
+ (if charsets
+ (or (catch 'tag
+ (let ((rest charsets-mime-charset-alist)
+ cell)
+ (while (setq cell (car rest))
+ (if (catch 'not-subset
+ (let ((set1 charsets)
+ (set2 (car cell))
+ obj)
+ (while set1
+ (setq obj (car set1))
+ (or (memq obj set2)
+ (throw 'not-subset nil))
+ (setq set1 (cdr set1)))
+ t))
+ (throw 'tag (cdr cell)))
+ (setq rest (cdr rest)))))
+ default-mime-charset)))
+
+
+;;; @ end
+;;;
+
+(provide 'mcharset)
+
+;;; mcharset.el ends here
--- /dev/null
+;;; mcs-20.el --- MIME charset implementation for Emacs 20 and XEmacs/mule
+
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule)
+;; or later.
+
+;;; Code:
+
+(require 'poem)
+(require 'custom)
+(eval-when-compile (require 'wid-edit))
+
+
+;;; @ MIME charset
+;;;
+
+(defcustom mime-charset-coding-system-alist
+ (let ((rest
+ '((us-ascii . raw-text)
+ (gb2312 . cn-gb-2312)
+ (cn-gb . cn-gb-2312)
+ (iso-2022-jp-2 . iso-2022-7bit-ss2)
+ (x-ctext . ctext)
+ (unknown . undecided)
+ (x-unknown . undecided)
+ ))
+ dest)
+ (while rest
+ (let ((pair (car rest)))
+ (or (find-coding-system (car pair))
+ (setq dest (cons pair dest))
+ ))
+ (setq rest (cdr rest))
+ )
+ dest)
+ "Alist MIME CHARSET vs CODING-SYSTEM.
+MIME CHARSET and CODING-SYSTEM must be symbol."
+ :group 'i18n
+ :type '(repeat (cons symbol coding-system)))
+
+(defsubst mime-charset-to-coding-system (charset &optional lbt)
+ "Return coding-system corresponding with CHARSET.
+CHARSET is a symbol whose name is MIME charset.
+If optional argument LBT (`CRLF', `LF', `CR', `unix', `dos' or `mac')
+is specified, it is used as line break code type of coding-system."
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (let ((ret (assq charset mime-charset-coding-system-alist)))
+ (if ret
+ (setq charset (cdr ret))
+ ))
+ (if lbt
+ (setq charset (intern (format "%s-%s" charset
+ (cond ((eq lbt 'CRLF) 'dos)
+ ((eq lbt 'LF) 'unix)
+ ((eq lbt 'CR) 'mac)
+ (t lbt)))))
+ )
+ (if (find-coding-system charset)
+ charset
+ ))
+
+(defvar widget-mime-charset-prompt-value-history nil
+ "History of input to `widget-mime-charset-prompt-value'.")
+
+(define-widget 'mime-charset 'coding-system
+ "A mime-charset."
+ :format "%{%t%}: %v"
+ :tag "MIME-charset"
+ :prompt-history 'widget-mime-charset-prompt-value-history
+ :prompt-value 'widget-mime-charset-prompt-value
+ :action 'widget-mime-charset-action)
+
+(defun widget-mime-charset-prompt-value (widget prompt value unbound)
+ ;; Read mime-charset from minibuffer.
+ (intern
+ (completing-read (format "%s (default %s) " prompt value)
+ (mapcar (function
+ (lambda (sym)
+ (list (symbol-name sym))))
+ (mime-charset-list)))))
+
+(defun widget-mime-charset-action (widget &optional event)
+ ;; Read a mime-charset from the minibuffer.
+ (let ((answer
+ (widget-mime-charset-prompt-value
+ widget
+ (widget-apply widget :menu-tag-get)
+ (widget-value widget)
+ t)))
+ (widget-value-set widget answer)
+ (widget-apply widget :notify widget event)
+ (widget-setup)))
+
+(defcustom default-mime-charset 'x-ctext
+ "Default value of MIME-charset.
+It is used when MIME-charset is not specified.
+It must be symbol."
+ :group 'i18n
+ :type 'mime-charset)
+
+(defsubst detect-mime-charset-region (start end)
+ "Return MIME charset for region between START and END."
+ (charsets-to-mime-charset (find-charset-region start end)))
+
+(defun write-region-as-mime-charset (charset start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but encode by MIME CHARSET."
+ (let ((coding-system-for-write
+ (or (mime-charset-to-coding-system charset)
+ 'binary)))
+ (write-region start end filename append visit lockname)))
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-20)
+
+;;; mcs-20.el ends here
--- /dev/null
+;;; mcs-e20.el --- MIME charset implementation for Emacs 20.1 and 20.2
+
+;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module requires Emacs 20.1 and 20.2.
+
+;;; Code:
+
+(defsubst encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET."
+ (let (cs)
+ (if (and enable-multibyte-characters
+ (setq cs (mime-charset-to-coding-system charset)))
+ (encode-coding-region start end cs)
+ )))
+
+(defsubst decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET."
+ (let (cs)
+ (if (and enable-multibyte-characters
+ (setq cs (mime-charset-to-coding-system charset lbt)))
+ (decode-coding-region start end cs)
+ )))
+
+
+(defsubst encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET."
+ (let (cs)
+ (if (and enable-multibyte-characters
+ (setq cs (mime-charset-to-coding-system charset)))
+ (encode-coding-string string cs)
+ string)))
+
+(defsubst decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING as MIME CHARSET."
+ (let (cs)
+ (if (and enable-multibyte-characters
+ (setq cs (mime-charset-to-coding-system charset lbt)))
+ (decode-coding-string string cs)
+ string)))
+
+
+(defvar charsets-mime-charset-alist
+ '(((ascii) . us-ascii)
+ ((ascii latin-iso8859-1) . iso-8859-1)
+ ((ascii latin-iso8859-2) . iso-8859-2)
+ ((ascii latin-iso8859-3) . iso-8859-3)
+ ((ascii latin-iso8859-4) . iso-8859-4)
+;;; ((ascii cyrillic-iso8859-5) . iso-8859-5)
+ ((ascii cyrillic-iso8859-5) . koi8-r)
+ ((ascii arabic-iso8859-6) . iso-8859-6)
+ ((ascii greek-iso8859-7) . iso-8859-7)
+ ((ascii hebrew-iso8859-8) . iso-8859-8)
+ ((ascii latin-iso8859-9) . iso-8859-9)
+ ((ascii latin-jisx0201
+ japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
+ ((ascii latin-jisx0201
+ katakana-jisx0201 japanese-jisx0208) . shift_jis)
+ ((ascii korean-ksc5601) . euc-kr)
+ ((ascii chinese-gb2312) . gb2312)
+ ((ascii chinese-big5-1 chinese-big5-2) . big5)
+ ((ascii latin-iso8859-1 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
+ ((ascii latin-iso8859-1 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212
+ chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
+ ((ascii latin-iso8859-1 latin-iso8859-2
+ cyrillic-iso8859-5 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212
+ chinese-cns11643-1 chinese-cns11643-2
+ chinese-cns11643-3 chinese-cns11643-4
+ chinese-cns11643-5 chinese-cns11643-6
+ chinese-cns11643-7) . iso-2022-int-1)
+ ))
+
+
+(defun coding-system-to-mime-charset (coding-system)
+ "Convert CODING-SYSTEM to a MIME-charset.
+Return nil if corresponding MIME-charset is not found."
+ (or (car (rassq coding-system mime-charset-coding-system-alist))
+ (coding-system-get coding-system 'mime-charset)))
+
+(defun mime-charset-list ()
+ "Return a list of all existing MIME-charset."
+ (let ((dest (mapcar (function car) mime-charset-coding-system-alist))
+ (rest coding-system-list)
+ cs)
+ (while rest
+ (setq cs (car rest))
+ (unless (rassq cs mime-charset-coding-system-alist)
+ (if (setq cs (coding-system-get cs 'mime-charset))
+ (or (rassq cs mime-charset-coding-system-alist)
+ (memq cs dest)
+ (setq dest (cons cs dest))
+ )))
+ (setq rest (cdr rest)))
+ dest))
+
+
+;;; @ end
+;;;
+
+(require 'mcs-20)
+
+(provide 'mcs-e20)
+
+;;; mcs-e20.el ends here
--- /dev/null
+;;; mcs-ltn1.el --- MIME charset implementation for Emacs 19
+;;; and XEmacs without MULE
+
+;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defvar charsets-mime-charset-alist
+ '(((ascii) . us-ascii)))
+
+(defvar default-mime-charset 'iso-8859-1)
+
+(defun mime-charset-to-coding-system (charset)
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (if (memq charset (list 'us-ascii default-mime-charset))
+ charset
+ ))
+
+(defun detect-mime-charset-region (start end)
+ "Return MIME charset for region between START and END."
+ (if (save-excursion
+ (goto-char start)
+ (re-search-forward "[\200-\377]" end t))
+ default-mime-charset
+ 'us-ascii))
+
+(defun encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET."
+ )
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET."
+ (cond ((eq lbt 'CRLF)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ ))
+ )))
+
+(defun encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET."
+ string)
+
+(defun decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING as MIME CHARSET."
+ (if lbt
+ (with-temp-buffer
+ (insert string)
+ (decode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string))
+ string))
+
+(defalias 'write-region-as-mime-charset 'write-region)
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-ltn1)
+
+;;; mcs-ltn1.el ends here
--- /dev/null
+;;; mcs-nemacs.el --- MIME charset implementation for Nemacs
+
+;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defvar charsets-mime-charset-alist
+ '(((ascii) . us-ascii)))
+
+(defvar default-mime-charset 'iso-2022-jp)
+
+(defvar mime-charset-coding-system-alist
+ '((iso-2022-jp . 2)
+ (shift_jis . 1)
+ ))
+
+(defun mime-charset-to-coding-system (charset)
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (cdr (assq charset mime-charset-coding-system-alist)))
+
+(defun detect-mime-charset-region (start end)
+ "Return MIME charset for region between START and END.
+\[emu-nemacs.el]"
+ (if (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (re-search-forward "[\200-\377]" nil t)))
+ default-mime-charset
+ 'us-ascii))
+
+(defun encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET.
+\[emu-nemacs.el]"
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (and (numberp cs)
+ (or (= cs 3)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (convert-region-kanji-code start end 3 cs))))
+ )))
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET.
+\[emu-nemacs.el]"
+ (let ((cs (mime-charset-to-coding-system charset))
+ (nl (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")
+ (dos . "\r\n") (mac . "\r"))))))
+ (and (numberp cs)
+ (or (= cs 3)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (convert-region-kanji-code start end cs 3)
+ (if nl
+ (progn
+ (goto-char (point-min))
+ (while (search-forward nl nil t)
+ (replace-match "\n")))
+ )))
+ ))))
+
+(defun encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET. [emu-nemacs.el]"
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (convert-string-kanji-code string 3 cs)
+ string)))
+
+(defun decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING as MIME CHARSET. [emu-nemacs.el]"
+ (with-temp-buffer
+ (insert string)
+ (decode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string)))
+
+(defun write-region-as-mime-charset (charset start end filename)
+ "Like `write-region', q.v., but code-convert by MIME CHARSET.
+\[emu-nemacs.el]"
+ (let ((kanji-fileio-code
+ (or (mime-charset-to-coding-system charset) 0)))
+ (write-region start end filename)))
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-nemacs)
+
+;;; mcs-nemacs.el ends here
--- /dev/null
+;;; mcs-om.el --- MIME charset implementation for Mule 1.* and Mule 2.*
+
+;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; 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 'poem)
+
+(defun encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (code-convert start end *internal* cs)
+ )))
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset lbt))
+ newline)
+ (if cs
+ (code-convert start end cs *internal*)
+ (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
+ (progn
+ (if (setq newline (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward newline nil t)
+ (replace-match "\n")))
+ (code-convert (point-min) (point-max) cs *internal*))
+ (code-convert start end cs *internal*)))))))
+
+(defun encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (code-convert-string string *internal* cs)
+ string)))
+
+(defun decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING which is encoded in MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset lbt))
+ newline)
+ (if cs
+ (decode-coding-string string cs)
+ (if (and lbt (setq cs (mime-charset-to-coding-system charset)))
+ (progn
+ (if (setq newline (cdr (assq lbt '((CRLF . "\r\n") (CR . "\r")))))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (search-forward newline nil t)
+ (replace-match "\n"))
+ (code-convert (point-min) (point-max) cs *internal*)
+ (buffer-string))
+ (decode-coding-string string cs)))
+ string))))
+
+(cond
+ (running-emacs-19_29-or-later
+ ;; for MULE 2.3 based on Emacs 19.34.
+ (defun write-region-as-mime-charset (charset start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but code-convert by MIME CHARSET."
+ (let ((file-coding-system
+ (or (mime-charset-to-coding-system charset)
+ *noconv*)))
+ (write-region start end filename append visit lockname)))
+ )
+ (t
+ ;; for MULE 2.3 based on Emacs 19.28.
+ (defun write-region-as-mime-charset (charset start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but code-convert by MIME CHARSET."
+ (let ((file-coding-system
+ (or (mime-charset-to-coding-system charset)
+ *noconv*)))
+ (write-region start end filename append visit)))
+ ))
+
+
+;;; @ to coding-system
+;;;
+
+(require 'cyrillic)
+
+(defvar mime-charset-coding-system-alist
+ '((iso-8859-1 . *ctext*)
+ (x-ctext . *ctext*)
+ (gb2312 . *euc-china*)
+ (koi8-r . *koi8*)
+ (iso-2022-jp-2 . *iso-2022-ss2-7*)
+ (x-iso-2022-jp-2 . *iso-2022-ss2-7*)
+ (shift_jis . *sjis*)
+ (x-shiftjis . *sjis*)
+ ))
+
+(defsubst mime-charset-to-coding-system (charset &optional lbt)
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (setq charset (or (cdr (assq charset mime-charset-coding-system-alist))
+ (intern (concat "*" (symbol-name charset) "*"))))
+ (if lbt
+ (setq charset (intern (format "%s%s" charset
+ (cond ((eq lbt 'CRLF) 'dos)
+ ((eq lbt 'LF) 'unix)
+ ((eq lbt 'CR) 'mac)
+ (t lbt)))))
+ )
+ (if (coding-system-p charset)
+ charset
+ ))
+
+
+;;; @ detection
+;;;
+
+(defvar charsets-mime-charset-alist
+ (let ((alist
+ '(((lc-ascii) . us-ascii)
+ ((lc-ascii lc-ltn1) . iso-8859-1)
+ ((lc-ascii lc-ltn2) . iso-8859-2)
+ ((lc-ascii lc-ltn3) . iso-8859-3)
+ ((lc-ascii lc-ltn4) . iso-8859-4)
+;;; ((lc-ascii lc-crl) . iso-8859-5)
+ ((lc-ascii lc-crl) . koi8-r)
+ ((lc-ascii lc-arb) . iso-8859-6)
+ ((lc-ascii lc-grk) . iso-8859-7)
+ ((lc-ascii lc-hbw) . iso-8859-8)
+ ((lc-ascii lc-ltn5) . iso-8859-9)
+ ((lc-ascii lc-roman lc-jpold lc-jp) . iso-2022-jp)
+ ((lc-ascii lc-kr) . euc-kr)
+ ((lc-ascii lc-cn) . gb2312)
+ ((lc-ascii lc-big5-1 lc-big5-2) . big5)
+ ((lc-ascii lc-roman lc-ltn1 lc-grk
+ lc-jpold lc-cn lc-jp lc-kr
+ lc-jp2) . iso-2022-jp-2)
+ ((lc-ascii lc-roman lc-ltn1 lc-grk
+ lc-jpold lc-cn lc-jp lc-kr lc-jp2
+ lc-cns1 lc-cns2) . iso-2022-int-1)
+ ((lc-ascii lc-roman
+ lc-ltn1 lc-ltn2 lc-crl lc-grk
+ lc-jpold lc-cn lc-jp lc-kr lc-jp2
+ lc-cns1 lc-cns2 lc-cns3 lc-cns4
+ lc-cns5 lc-cns6 lc-cns7) . iso-2022-int-1)
+ ))
+ dest)
+ (while alist
+ (catch 'not-found
+ (let ((pair (car alist)))
+ (setq dest
+ (append dest
+ (list
+ (cons (mapcar (function
+ (lambda (cs)
+ (if (boundp cs)
+ (symbol-value cs)
+ (throw 'not-found nil)
+ )))
+ (car pair))
+ (cdr pair)))))))
+ (setq alist (cdr alist)))
+ dest))
+
+(defvar default-mime-charset 'x-ctext
+ "Default value of MIME-charset.
+It is used when MIME-charset is not specified.
+It must be symbol.")
+
+(defun detect-mime-charset-region (start end)
+ "Return MIME charset for region between START and END."
+ (charsets-to-mime-charset
+ (cons lc-ascii (find-charset-region start end))))
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-om)
+
+;;; mcs-om.el ends here
--- /dev/null
+;;; mcs-xm.el --- MIME charset implementation for XEmacs-mule
+
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule)
+;; or later.
+
+;;; Code:
+
+(require 'mcs-20)
+
+
+(defun encode-mime-charset-region (start end charset)
+ "Encode the text between START and END as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (encode-coding-region start end cs)
+ )))
+
+
+(defcustom mime-charset-decoder-alist
+ '((iso-2022-jp . decode-mime-charset-region-with-iso646-unification)
+ (iso-2022-jp-2 . decode-mime-charset-region-with-iso646-unification)
+ (x-ctext . decode-mime-charset-region-with-iso646-unification)
+ (hz-gb-2312 . decode-mime-charset-region-for-hz)
+ (t . decode-mime-charset-region-default))
+ "Alist MIME-charset vs. decoder function."
+ :group 'i18n
+ :type '(repeat (cons mime-charset function)))
+
+(defsubst decode-mime-charset-region-default (start end charset lbt)
+ (let ((cs (mime-charset-to-coding-system charset lbt)))
+ (if cs
+ (decode-coding-region start end cs)
+ )))
+
+(defcustom mime-iso646-character-unification-alist
+ (eval-when-compile
+ (let (dest
+ (i 33))
+ (while (< i 92)
+ (setq dest
+ (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
+ (format "%c" i))
+ dest))
+ (setq i (1+ i)))
+ (setq i 93)
+ (while (< i 126)
+ (setq dest
+ (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
+ (format "%c" i))
+ dest))
+ (setq i (1+ i)))
+ (nreverse dest)))
+ "Alist unified string vs. canonical string."
+ :group 'i18n
+ :type '(repeat (cons string string)))
+
+(defcustom mime-unified-character-face nil
+ "*Face of unified character."
+ :group 'i18n
+ :type 'face)
+
+(defcustom mime-character-unification-limit-size 2048
+ "*Limit size to unify characters."
+ :group 'i18n
+ :type 'integer)
+
+(defun decode-mime-charset-region-with-iso646-unification (start end charset
+ lbt)
+ (decode-mime-charset-region-default start end charset lbt)
+ (if (<= (- end start) mime-character-unification-limit-size)
+ (save-excursion
+ (let ((rest mime-iso646-character-unification-alist))
+ (while rest
+ (let ((pair (car rest)))
+ (goto-char (point-min))
+ (while (search-forward (car pair) nil t)
+ (let ((str (cdr pair)))
+ (put-text-property 0 (length str)
+ 'face mime-unified-character-face str)
+ (replace-match str 'fixed-case 'literal)
+ )
+ ))
+ (setq rest (cdr rest)))))
+ ))
+
+(defun decode-mime-charset-region-for-hz (start end charset lbt)
+ (if lbt
+ (save-restriction
+ (narrow-to-region start end)
+ (decode-coding-region (point-min)(point-max)
+ (mime-charset-to-coding-system 'raw-text lbt))
+ (decode-hz-region (point-min)(point-max)))
+ (decode-hz-region start end)))
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET."
+ (if (stringp charset)
+ (setq charset (intern (downcase charset)))
+ )
+ (let ((func (cdr (or (assq charset mime-charset-decoder-alist)
+ (assq t mime-charset-decoder-alist)))))
+ (funcall func start end charset lbt)))
+
+(defsubst encode-mime-charset-string (string charset)
+ "Encode the STRING as MIME CHARSET."
+ (let ((cs (mime-charset-to-coding-system charset)))
+ (if cs
+ (encode-coding-string string cs)
+ string)))
+
+;; (defsubst decode-mime-charset-string (string charset)
+;; "Decode the STRING as MIME CHARSET."
+;; (let ((cs (mime-charset-to-coding-system charset)))
+;; (if cs
+;; (decode-coding-string string cs)
+;; string)))
+(defun decode-mime-charset-string (string charset &optional lbt)
+ "Decode the STRING as MIME CHARSET."
+ (with-temp-buffer
+ (insert string)
+ (decode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string)))
+
+
+(defvar charsets-mime-charset-alist
+ '(((ascii) . us-ascii)
+ ((ascii latin-iso8859-1) . iso-8859-1)
+ ((ascii latin-iso8859-2) . iso-8859-2)
+ ((ascii latin-iso8859-3) . iso-8859-3)
+ ((ascii latin-iso8859-4) . iso-8859-4)
+ ((ascii cyrillic-iso8859-5) . iso-8859-5)
+;;; ((ascii cyrillic-iso8859-5) . koi8-r)
+ ((ascii arabic-iso8859-6) . iso-8859-6)
+ ((ascii greek-iso8859-7) . iso-8859-7)
+ ((ascii hebrew-iso8859-8) . iso-8859-8)
+ ((ascii latin-iso8859-9) . iso-8859-9)
+ ((ascii latin-jisx0201
+ japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp)
+ ((ascii latin-jisx0201
+ katakana-jisx0201 japanese-jisx0208) . shift_jis)
+ ((ascii korean-ksc5601) . euc-kr)
+ ((ascii chinese-gb2312) . gb2312)
+ ((ascii chinese-big5-1 chinese-big5-2) . big5)
+ ((ascii latin-iso8859-1 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212) . iso-2022-jp-2)
+ ((ascii latin-iso8859-1 greek-iso8859-7
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 japanese-jisx0208
+ korean-ksc5601 japanese-jisx0212
+ chinese-cns11643-1 chinese-cns11643-2) . iso-2022-int-1)
+ ))
+
+
+(defun coding-system-to-mime-charset (coding-system)
+ "Convert CODING-SYSTEM to a MIME-charset.
+Return nil if corresponding MIME-charset is not found."
+ (setq coding-system
+ (coding-system-name (coding-system-base coding-system)))
+ (or (car (rassq coding-system mime-charset-coding-system-alist))
+ coding-system))
+
+(defun mime-charset-list ()
+ "Return a list of all existing MIME-charset."
+ (let ((dest (mapcar (function car) mime-charset-coding-system-alist))
+ (rest (coding-system-list))
+ cs)
+ (while rest
+ (setq cs (coding-system-name (coding-system-base (car rest))))
+ (or (rassq cs mime-charset-coding-system-alist)
+ (memq cs dest)
+ (setq dest (cons cs dest)))
+ (setq rest (cdr rest)))
+ dest))
+
+
+;;; @ end
+;;;
+
+(provide 'mcs-xm)
+
+;;; mcs-xm.el ends here
;;; mule-caesar.el --- ROT 13-47 Caesar rotation utility
-;; Copyright (C) 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: mule-caesar.el,v 1.3 1997-05-09 02:47:55 morioka Exp $
;; Keywords: ROT 13-47, caesar, mail, news, text/x-rot13-47
;; This file is part of APEL (A Portable Emacs Library).
;;; Code:
-(defun char-to-octet-list (character)
- "Return list of octets in code table of graphic character set."
- (let* ((code (char-int character))
- (dim (charset-dimension (char-charset code)))
- dest)
- (while (> dim 0)
- (setq dest (cons (logand code 127) dest)
- dim (1- dim)
- code (lsh code -7))
- )
- dest))
+(require 'emu)
(defun mule-caesar-region (start end &optional stride-ascii)
"Caesar rotation of current region.
(narrow-to-region start end)
(goto-char start)
(while (< (point)(point-max))
- (let* ((chr (char-after (point)))
- (charset (char-charset chr))
- )
- (if (eq charset 'ascii)
- (cond ((and (<= ?A chr) (<= chr ?Z))
- (setq chr (+ chr stride-ascii))
- (if (> chr ?Z)
- (setq chr (- chr 26))
- )
- (delete-char 1)
- (insert chr)
- )
- ((and (<= ?a chr) (<= chr ?z))
- (setq chr (+ chr stride-ascii))
- (if (> chr ?z)
- (setq chr (- chr 26))
- )
- (delete-char 1)
- (insert chr)
- )
- (t
- (forward-char)
- ))
- (let* ((stride (lsh (charset-chars charset) -1))
- (ret (mapcar (function
- (lambda (octet)
- (if (< octet 80)
- (+ octet stride)
- (- octet stride)
- )))
- (char-to-octet-list chr))))
- (delete-char 1)
- (insert (make-char (char-charset chr)
- (car ret)(car (cdr ret))))
- )))))))
-
+ (let* ((chr (char-after (point))))
+ (cond ((and (<= ?A chr) (<= chr ?Z))
+ (setq chr (+ chr stride-ascii))
+ (if (> chr ?Z)
+ (setq chr (- chr 26))
+ )
+ (delete-char 1)
+ (insert chr)
+ )
+ ((and (<= ?a chr) (<= chr ?z))
+ (setq chr (+ chr stride-ascii))
+ (if (> chr ?z)
+ (setq chr (- chr 26))
+ )
+ (delete-char 1)
+ (insert chr)
+ )
+ ((<= chr ?\x9f)
+ (forward-char)
+ )
+ (t
+ (let* ((stride (lsh (charset-chars (char-charset chr)) -1))
+ (ret (mapcar (function
+ (lambda (octet)
+ (if (< octet 80)
+ (+ octet stride)
+ (- octet stride)
+ )))
+ (cdr (split-char chr)))))
+ (delete-char 1)
+ (insert (make-char (char-charset chr)
+ (car ret)(car (cdr ret))))
+ )))
+ )))))
+
(provide 'mule-caesar)
--- /dev/null
+;;; path-util.el --- Emacs Lisp file detection utility
+
+;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Version: $Id: path-util.el,v 1.1 1997-11-06 15:47:23 morioka Exp $
+;; Keywords: file detection, install, module
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defvar default-load-path load-path
+ "*Base of `load-path'.
+It is used as default value of target path to search file or
+subdirectory under load-path.")
+
+;;;###autoload
+(defun add-path (path &rest options)
+ "Add PATH to `load-path' if it exists under `default-load-path'
+directories and it does not exist in `load-path'.
+
+You can use following PATH styles:
+ load-path relative: \"PATH/\"
+ (it is searched from `defaul-load-path')
+ home directory relative: \"~/PATH/\" \"~USER/PATH/\"
+ absolute path: \"/HOO/BAR/BAZ/\"
+
+You can specify following OPTIONS:
+ 'all-paths search from `load-path'
+ instead of `default-load-path'
+ 'append add PATH to the last of `load-path'"
+ (let ((rest (if (memq 'all-paths options)
+ load-path
+ default-load-path))
+ p)
+ (if (and (catch 'tag
+ (while rest
+ (setq p (expand-file-name path (car rest)))
+ (if (file-directory-p p)
+ (throw 'tag p)
+ )
+ (setq rest (cdr rest))
+ ))
+ (not (member p load-path))
+ )
+ (setq load-path
+ (if (memq 'append options)
+ (append load-path (list p))
+ (cons p load-path)
+ ))
+ )))
+
+;;;###autoload
+(defun add-latest-path (pattern &optional all-paths)
+ "Add latest path matched by PATTERN to `load-path'
+if it exists under `default-load-path' directories
+and it does not exist in `load-path'.
+
+If optional argument ALL-PATHS is specified, it is searched from all
+of load-path instead of default-load-path."
+ (let ((path (get-latest-path pattern all-paths)))
+ (if path
+ (add-to-list 'load-path path)
+ )))
+
+;;;###autoload
+(defun get-latest-path (pattern &optional all-paths)
+ "Return latest directory in default-load-path
+which is matched to regexp PATTERN.
+If optional argument ALL-PATHS is specified,
+it is searched from all of load-path instead of default-load-path."
+ (catch 'tag
+ (let ((paths (if all-paths
+ load-path
+ default-load-path))
+ dir)
+ (while (setq dir (car paths))
+ (if (and (file-exists-p dir)
+ (file-directory-p dir)
+ )
+ (let ((files (sort (directory-files dir t pattern t)
+ (function file-newer-than-file-p)))
+ file)
+ (while (setq file (car files))
+ (if (file-directory-p file)
+ (throw 'tag file)
+ )
+ (setq files (cdr files))
+ )))
+ (setq paths (cdr paths))
+ ))))
+
+;;;###autoload
+(defun file-installed-p (file &optional paths)
+ "Return absolute-path of FILE if FILE exists in PATHS.
+If PATHS is omitted, `load-path' is used."
+ (if (null paths)
+ (setq paths load-path)
+ )
+ (catch 'tag
+ (let (path)
+ (while paths
+ (setq path (expand-file-name file (car paths)))
+ (if (file-exists-p path)
+ (throw 'tag path)
+ )
+ (setq paths (cdr paths))
+ ))))
+
+;;;###autoload
+(defvar exec-suffix-list '("")
+ "*List of suffixes for executable.")
+
+;;;###autoload
+(defun exec-installed-p (file &optional paths suffixes)
+ "Return absolute-path of FILE if FILE exists in PATHS.
+If PATHS is omitted, `exec-path' is used.
+If suffixes is omitted, `exec-suffix-list' is used."
+ (or paths
+ (setq paths exec-path)
+ )
+ (or suffixes
+ (setq suffixes exec-suffix-list)
+ )
+ (catch 'tag
+ (while paths
+ (let ((stem (expand-file-name file (car paths)))
+ (sufs suffixes)
+ )
+ (while sufs
+ (let ((file (concat stem (car sufs))))
+ (if (file-exists-p file)
+ (throw 'tag file)
+ ))
+ (setq sufs (cdr sufs))
+ ))
+ (setq paths (cdr paths))
+ )))
+
+;;;###autoload
+(defun module-installed-p (module &optional paths)
+ "Return t if module is provided or exists in PATHS.
+If PATHS is omitted, `load-path' is used."
+ (or (featurep module)
+ (exec-installed-p (symbol-name module) load-path '(".elc" ".el"))
+ ))
+
+
+;;; @ end
+;;;
+
+(provide 'path-util)
+
+;;; path-util.el ends here
--- /dev/null
+;;; pccl-20.el --- Portable CCL utility for Emacs 20 and XEmacs-mule
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998 Tanaka Akira
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; 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 'poem)
+
+(eval-when-compile (require 'ccl))
+(require 'broken)
+
+(broken-facility ccl-accept-symbol-as-program
+ "Emacs does not accept symbol as CCL program."
+ (progn
+ (define-ccl-program test-ccl-identity
+ '(1 ((read r0) (loop (write-read-repeat r0)))))
+ (condition-case nil
+ (progn
+ (funcall
+ (if (fboundp 'ccl-vector-execute-on-string)
+ 'ccl-vector-execute-on-string
+ 'ccl-execute-on-string)
+ 'test-ccl-identity
+ (make-vector 9 nil)
+ "")
+ t)
+ (error nil)))
+ t)
+
+(eval-and-compile
+
+ (if (featurep 'xemacs)
+ (defun make-ccl-coding-system (name mnemonic docstring decoder encoder)
+ "\
+Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER.
+
+CODING-SYSTEM, DECODER and ENCODER must be symbol."
+ (make-coding-system
+ name 'ccl docstring
+ (list 'mnemonic (char-to-string mnemonic)
+ 'decode (symbol-value decoder)
+ 'encode (symbol-value encoder))))
+ (defun make-ccl-coding-system
+ (coding-system mnemonic docstring decoder encoder)
+ "\
+Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER.
+
+CODING-SYSTEM, DECODER and ENCODER must be symbol."
+ (when-broken ccl-accept-symbol-as-program
+ (setq decoder (symbol-value decoder))
+ (setq encoder (symbol-value encoder)))
+ (make-coding-system coding-system 4 mnemonic docstring
+ (cons decoder encoder)))
+ )
+
+ (when-broken ccl-accept-symbol-as-program
+
+ (when (subrp (symbol-function 'ccl-execute))
+ (fset 'ccl-vector-program-execute
+ (symbol-function 'ccl-execute))
+ (defun ccl-execute (ccl-prog reg)
+ "\
+Execute CCL-PROG with registers initialized by REGISTERS.
+If CCL-PROG is symbol, it is dereferenced.
+\[Emacs 20.3 emulating function]"
+ (ccl-vector-program-execute
+ (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
+ reg)))
+
+ (when (subrp (symbol-function 'ccl-execute-on-string))
+ (fset 'ccl-vector-program-execute-on-string
+ (symbol-function 'ccl-execute-on-string))
+ (defun ccl-execute-on-string (ccl-prog status string &optional contin)
+ "\
+Execute CCL-PROG with initial STATUS on STRING.
+If CCL-PROG is symbol, it is dereferenced.
+\[Emacs 20.3 emulating function]"
+ (ccl-vector-program-execute-on-string
+ (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
+ status string contin)))
+ )
+ )
+
+(eval-when-compile
+ (define-ccl-program test-ccl-eof-block
+ '(1
+ ((read r0)
+ (write r0)
+ (read r0))
+ (write "[EOF]")))
+
+ (make-ccl-coding-system
+ 'test-ccl-eof-block-cs ?T "CCL_EOF_BLOCK tester"
+ 'test-ccl-eof-block 'test-ccl-eof-block)
+ )
+
+(broken-facility ccl-execute-eof-block-on-encoding-null
+ "Emacs forgets executing CCL_EOF_BLOCK with encoding on empty input."
+ (equal (encode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
+
+(broken-facility ccl-execute-eof-block-on-encoding-some
+ "Emacs forgets executing CCL_EOF_BLOCK with encoding on non-empty input."
+ (equal (encode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
+
+(broken-facility ccl-execute-eof-block-on-decoding-null
+ "Emacs forgets executing CCL_EOF_BLOCK with decoding on empty input."
+ (equal (decode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
+
+(broken-facility ccl-execute-eof-block-on-decoding-some
+ "Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input."
+ (equal (decode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
+
+(broken-facility ccl-execute-eof-block-on-encoding
+ "Emacs may forget executing CCL_EOF_BLOCK with encoding."
+ (not (or (broken-p 'ccl-execute-eof-block-on-encoding-null)
+ (broken-p 'ccl-execute-eof-block-on-encoding-some)))
+ t)
+
+(broken-facility ccl-execute-eof-block-on-decoding
+ "Emacs may forget executing CCL_EOF_BLOCK with decoding."
+ (not (or (broken-p 'ccl-execute-eof-block-on-decoding-null)
+ (broken-p 'ccl-execute-eof-block-on-decoding-some)))
+ t)
+
+(broken-facility ccl-execute-eof-block
+ "Emacs may forget executing CCL_EOF_BLOCK."
+ (not (or (broken-p 'ccl-execute-eof-block-on-encoding)
+ (broken-p 'ccl-execute-eof-block-on-decoding)))
+ t)
+
+
+;;; @ end
+;;;
+
+(provide 'pccl-20)
+
+;;; pccl-20.el ends here
--- /dev/null
+;;; pccl-om.el --- Portable CCL utility for Mule 1.* and Mule 2.*
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998 Tanaka Akira
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; 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 'poem)
+
+(eval-when-compile (require 'ccl))
+(require 'broken)
+
+(broken-facility ccl-accept-symbol-as-program
+ "Emacs does not accept symbol as CCL program.")
+
+(eval-and-compile
+ (defun make-ccl-coding-system
+ (coding-system mnemonic doc-string decoder encoder)
+ "\
+Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER.
+
+CODING-SYSTEM, DECODER and ENCODER must be symbol."
+ (setq decoder (symbol-value decoder)
+ encoder (symbol-value encoder))
+ (make-coding-system coding-system 4 mnemonic doc-string
+ nil ; Mule takes one more optional argument: EOL-TYPE.
+ (cons decoder encoder)))
+ )
+
+(defun ccl-execute (ccl-prog reg)
+ "Execute CCL-PROG with registers initialized by REGISTERS.
+If CCL-PROG is symbol, it is dereferenced.
+\[Emacs 20.3 emulating function]"
+ (exec-ccl
+ (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
+ reg))
+
+(defun ccl-execute-on-string (ccl-prog status string &optional contin)
+ "Execute CCL-PROG with initial STATUS on STRING.
+If CCL-PROG is symbol, it is dereferenced.
+\[Emacs 20.3 emulating function]"
+ (exec-ccl-string
+ (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
+ status string))
+
+(broken-facility ccl-execute-on-string-ignore-contin
+ "CONTIN argument for ccl-execute-on-string is ignored.")
+
+(eval-when-compile
+ (define-ccl-program test-ccl-eof-block
+ '(1
+ ((read r0)
+ (write r0)
+ (read r0))
+ (write "[EOF]")))
+
+ (make-ccl-coding-system
+ 'test-ccl-eof-block-cs ?T "CCL_EOF_BLOCK tester"
+ 'test-ccl-eof-block 'test-ccl-eof-block)
+ )
+
+(broken-facility ccl-execute-eof-block-on-encoding-null
+ "Emacs forgets executing CCL_EOF_BLOCK with encoding on empty input."
+ (equal (encode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
+
+(broken-facility ccl-execute-eof-block-on-encoding-some
+ "Emacs forgets executing CCL_EOF_BLOCK with encoding on non-empty input."
+ (equal (encode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
+
+(broken-facility ccl-execute-eof-block-on-decoding-null
+ "Emacs forgets executing CCL_EOF_BLOCK with decoding on empty input."
+ (equal (decode-coding-string "" 'test-ccl-eof-block-cs) "[EOF]"))
+
+(broken-facility ccl-execute-eof-block-on-decoding-some
+ "Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input."
+ (equal (decode-coding-string "a" 'test-ccl-eof-block-cs) "a[EOF]"))
+
+(broken-facility ccl-execute-eof-block-on-encoding
+ "Emacs may forget executing CCL_EOF_BLOCK with encoding."
+ (not (or (broken-p 'ccl-execute-eof-block-on-encoding-null)
+ (broken-p 'ccl-execute-eof-block-on-encoding-some)))
+ t)
+
+(broken-facility ccl-execute-eof-block-on-decoding
+ "Emacs may forget executing CCL_EOF_BLOCK with decoding."
+ (not (or (broken-p 'ccl-execute-eof-block-on-decoding-null)
+ (broken-p 'ccl-execute-eof-block-on-decoding-some)))
+ t)
+
+(broken-facility ccl-execute-eof-block
+ "Emacs may forget executing CCL_EOF_BLOCK."
+ (not (or (broken-p 'ccl-execute-eof-block-on-encoding)
+ (broken-p 'ccl-execute-eof-block-on-decoding)))
+ t)
+
+
+;;; @ end
+;;;
+
+(provide 'pccl-om)
+
+;;; pccl-om.el ends here
--- /dev/null
+;;; pccl.el --- Portable CCL utility for Mule 1.* and Mule 2.*
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(if (featurep 'mule)
+ (if (>= emacs-major-version 20)
+ ;; for Emacs 20 and XEmacs-mule
+ (require 'pccl-20)
+ ;; for MULE 1.* and 2.*
+ (require 'pccl-om)
+ ))
+
+
+;;; @ end
+;;;
+
+(provide 'pccl)
+
+;;; pccl.el ends here
--- /dev/null
+;;; poe-18.el --- poe API implementation for Emacs 18.*
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(autoload 'setenv "env"
+ "Set the value of the environment variable named VARIABLE to VALUE.
+VARIABLE should be a string. VALUE is optional; if not provided or is
+`nil', the environment variable VARIABLE will be removed.
+This function works by modifying `process-environment'."
+ t)
+
+(defvar data-directory exec-directory)
+
+
+;;; @ for EMACS 18.55
+;;;
+
+(defvar buffer-undo-list nil)
+
+
+;;; @ hook
+;;;
+
+;; 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.
+FUNCTION is added (if necessary) at the beginning of the hook list
+unless the optional argument APPEND is non-nil, in which case
+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.
+\[poe-18.el; EMACS 19 emulating function]"
+ (or (boundp hook)
+ (set hook nil)
+ )
+ ;; If the hook value is a single function, turn it into a list.
+ (let ((old (symbol-value hook)))
+ (if (or (not (listp old))
+ (eq (car old) 'lambda))
+ (set hook (list old))
+ ))
+ (or (if (consp function)
+ ;; Clever way to tell whether a given lambda-expression
+ ;; is equal to anything in the hook.
+ (let ((tail (assoc (cdr function) (symbol-value hook))))
+ (equal function tail)
+ )
+ (memq function (symbol-value hook))
+ )
+ (set hook
+ (if append
+ (nconc (symbol-value hook) (list function))
+ (cons function (symbol-value hook))
+ ))
+ ))
+
+(defun remove-hook (hook function)
+ "Remove from the value of HOOK the function FUNCTION.
+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'.
+\[poe-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
+ nil ;Do nothing.
+ (let ((hook-value (symbol-value hook)))
+ (if (consp hook-value)
+ (setq hook-value (delete function hook-value))
+ (if (equal hook-value function)
+ (setq hook-value nil)
+ ))
+ (set hook hook-value)
+ )))
+
+
+;;; @ list
+;;;
+
+(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.
+\[poe-18.el; EMACS 19 emulating function]"
+ (while (and list (not (equal elt (car list))))
+ (setq list (cdr list)))
+ list)
+
+(defun delete (elt list)
+ "Delete by side effect any occurrences of ELT as a member of LIST.
+The modified LIST is returned. Comparison is done with `equal'.
+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'.
+\[poe-18.el; EMACS 19 emulating function]"
+ (if (equal elt (car list))
+ (cdr list)
+ (let ((rest list)
+ (rrest (cdr list))
+ )
+ (while (and rrest (not (equal elt (car rrest))))
+ (setq rest rrest
+ rrest (cdr rrest))
+ )
+ (rplacd rest (cdr rrest))
+ list)))
+
+
+;;; @ function
+;;;
+
+(defun defalias (sym newdef)
+ "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.
+Associates the function with the current load file, if any.
+\[poe-18.el; EMACS 19 emulating function]"
+ (fset sym newdef)
+ )
+
+(defun byte-code-function-p (exp)
+ "T if OBJECT is a byte-compiled function object.
+\[poe-18.el; EMACS 19 emulating function]"
+ (and (consp exp)
+ (let* ((rest (cdr (cdr exp))) elt)
+ (if (stringp (car rest))
+ (setq rest (cdr rest))
+ )
+ (catch 'tag
+ (while rest
+ (setq elt (car rest))
+ (if (and (consp elt)(eq (car elt) 'byte-code))
+ (throw 'tag t)
+ )
+ (setq rest (cdr rest))
+ ))
+ )))
+
+(defmacro-maybe defsubst (name arglist &rest body)
+ "Define an inline function. The syntax is just like that of `defun'."
+ (cons 'defun (cons name (cons arglist body)))
+ )
+
+(defun-maybe make-obsolete (fn new)
+ "Make the byte-compiler warn that FUNCTION is obsolete.
+The warning will say that NEW should be used instead.
+If NEW is a string, that is the `use instead' message."
+ (interactive "aMake function obsolete: \nxObsoletion replacement: ")
+ (let ((handler (get fn 'byte-compile)))
+ (if (eq 'byte-compile-obsolete handler)
+ (setcar (get fn 'byte-obsolete-info) new)
+ (put fn 'byte-obsolete-info (cons new handler))
+ (put fn 'byte-compile 'byte-compile-obsolete)))
+ fn)
+
+
+;;; @ file
+;;;
+
+(defun make-directory-internal (dirname)
+ "Create a directory. One argument, a file name string.
+\[poe-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))
+ (error "Creating directory: no such file or directory, %s" dirname)
+ )))
+
+(defun make-directory (dir &optional parents)
+ "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.
+\[poe-18.el; EMACS 19 emulating function]"
+ (let ((len (length dir))
+ (p 0) p1 path)
+ (catch 'tag
+ (while (and (< p len) (string-match "[^/]*/?" dir p))
+ (setq p1 (match-end 0))
+ (if (= p1 len)
+ (throw 'tag nil)
+ )
+ (setq path (substring dir 0 p1))
+ (if (not (file-directory-p path))
+ (cond ((file-exists-p path)
+ (error "Creating directory: %s is not directory" path)
+ )
+ ((null parents)
+ (error "Creating directory: %s is not exist" path)
+ )
+ (t
+ (make-directory-internal path)
+ ))
+ )
+ (setq p p1)
+ ))
+ (make-directory-internal dir)
+ ))
+
+;; Imported from files.el of EMACS 19.33.
+(defun parse-colon-path (cd-path)
+ "Explode a colon-separated list of paths into a string list."
+ (and cd-path
+ (let (cd-prefix cd-list (cd-start 0) cd-colon)
+ (setq cd-path (concat cd-path path-separator))
+ (while (setq cd-colon (string-match path-separator cd-path cd-start))
+ (setq cd-list
+ (nconc cd-list
+ (list (if (= cd-start cd-colon)
+ nil
+ (substitute-in-file-name
+ (file-name-as-directory
+ (substring cd-path cd-start cd-colon)))))))
+ (setq cd-start (+ cd-colon 1)))
+ cd-list)))
+
+;; Imported from files.el of EMACS 19.33.
+(defun file-relative-name (filename &optional directory)
+ "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
+ (setq filename (expand-file-name filename)
+ directory (file-name-as-directory (expand-file-name
+ (or directory default-directory))))
+ (let ((ancestor ""))
+ (while (not (string-match (concat "^" (regexp-quote directory)) filename))
+ (setq directory (file-name-directory (substring directory 0 -1))
+ 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.
+\[poe-18.el; EMACS 19 emulating function]"
+ (si:directory-files directory full match)
+ )
+
+
+;;; @ mark
+;;;
+
+(or (fboundp 'si:mark)
+ (fset 'si:mark (symbol-function 'mark)))
+(defun mark (&optional force)
+ (si:mark)
+ )
+
+
+;;; @ mode-line
+;;;
+
+;;; Imported from Emacs 19.30.
+(defun force-mode-line-update (&optional all)
+ "Force the mode-line of the current buffer to be redisplayed.
+With optional non-nil ALL, force redisplay of all mode-lines.
+\[poe-18.el; Emacs 19 emulating function]"
+ (if all (save-excursion (set-buffer (other-buffer))))
+ (set-buffer-modified-p (buffer-modified-p)))
+
+
+;;; @ overlay
+;;;
+
+(cond ((boundp 'NEMACS)
+ (defvar emu:available-face-attribute-alist
+ '(
+ ;;(bold . inversed-region)
+ (italic . underlined-region)
+ (underline . underlined-region)
+ ))
+
+ ;; by YAMATE Keiichirou 1994/10/28
+ (defun attribute-add-narrow-attribute (attr from to)
+ (or (consp (symbol-value attr))
+ (set attr (list 1)))
+ (let* ((attr-value (symbol-value attr))
+ (len (car attr-value))
+ (posfrom 1)
+ posto)
+ (while (and (< posfrom len)
+ (> from (nth posfrom attr-value)))
+ (setq posfrom (1+ posfrom)))
+ (setq posto posfrom)
+ (while (and (< posto len)
+ (> to (nth posto attr-value)))
+ (setq posto (1+ posto)))
+ (if (= posto posfrom)
+ (if (= (% posto 2) 1)
+ (if (and (< to len)
+ (= to (nth posto attr-value)))
+ (set-marker (nth posto attr-value) from)
+ (setcdr (nthcdr (1- posfrom) attr-value)
+ (cons (set-marker-type (set-marker (make-marker)
+ from)
+ 'point-type)
+ (cons (set-marker-type
+ (set-marker (make-marker)
+ to)
+ nil)
+ (nthcdr posto attr-value))))
+ (setcar attr-value (+ len 2))))
+ (if (= (% posfrom 2) 0)
+ (setq posfrom (1- posfrom))
+ (set-marker (nth posfrom attr-value) from))
+ (if (= (% posto 2) 0)
+ nil
+ (setq posto (1- posto))
+ (set-marker (nth posto attr-value) to))
+ (setcdr (nthcdr posfrom attr-value)
+ (nthcdr posto attr-value)))))
+
+ (defalias 'make-overlay 'cons)
+
+ (defun overlay-put (overlay prop value)
+ (let ((ret (and (eq prop 'face)
+ (assq value emu:available-face-attribute-alist)
+ )))
+ (if ret
+ (attribute-add-narrow-attribute (cdr ret)
+ (car overlay)(cdr overlay))
+ )))
+ )
+ (t
+ (defun make-overlay (beg end &optional buffer type))
+ (defun overlay-put (overlay prop value))
+ ))
+
+(defun overlay-buffer (overlay))
+
+
+;;; @ text property
+;;;
+
+(defun set-text-properties (start end properties &optional object))
+
+(defun remove-text-properties (start end properties &optional object))
+
+
+;;; @@ visible/invisible
+;;;
+
+(defmacro enable-invisible ()
+ (`
+ (progn
+ (make-local-variable 'original-selective-display)
+ (setq original-selective-display selective-display)
+ (setq selective-display t)
+ )))
+
+(defmacro end-of-invisible ()
+ (` (setq selective-display
+ (if (boundp 'original-selective-display)
+ original-selective-display))
+ ))
+
+(defun invisible-region (start end)
+ (let ((buffer-read-only nil) ;Okay even if write protected.
+ (modp (buffer-modified-p)))
+ (if (save-excursion
+ (goto-char (1- end))
+ (eq (following-char) ?\n)
+ )
+ (setq end (1- end))
+ )
+ (unwind-protect
+ (subst-char-in-region start end ?\n ?\^M t)
+ (set-buffer-modified-p modp)
+ )))
+
+(defun visible-region (start end)
+ (let ((buffer-read-only nil) ;Okay even if write protected.
+ (modp (buffer-modified-p)))
+ (unwind-protect
+ (subst-char-in-region start end ?\^M ?\n t)
+ (set-buffer-modified-p modp)
+ )))
+
+(defun invisible-p (pos)
+ (save-excursion
+ (goto-char pos)
+ (eq (following-char) ?\^M)
+ ))
+
+(defun next-visible-point (pos)
+ (save-excursion
+ (goto-char pos)
+ (end-of-line)
+ (if (eq (following-char) ?\n)
+ (forward-char)
+ )
+ (point)
+ ))
+
+
+;;; @ string
+;;;
+
+(defun char-list-to-string (char-list)
+ "Convert list of character CHAR-LIST to string. [poe-18.el]"
+ (mapconcat (function char-to-string) char-list "")
+ )
+
+
+;;; @ buffer
+;;;
+
+(defun-maybe generate-new-buffer-name (name &optional ignore)
+ "Return a string that is the name of no existing buffer based on NAME.
+If there is no live buffer named NAME, then return NAME.
+Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
+until an unused name is found, and then return that name.
+Optional second argument IGNORE specifies a name that is okay to use
+\(if it is in the sequence to be tried)
+even if a buffer with that name exists."
+ (if (get-buffer name)
+ (let ((n 2) new)
+ (while (get-buffer (setq new (format "%s<%d>" name n)))
+ (setq n (1+ n)))
+ new)
+ name))
+
+
+;;; @ end
+;;;
+
+(provide 'poe-18)
+
+;;; poe-18.el ends here
--- /dev/null
+;;; poe-19.el --- poe API implementation for Emacs 19.*
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+;;; @ face
+;;;
+
+(defun-maybe find-face (face)
+ (car (memq face (face-list)))
+ )
+
+
+;;; @ visible/invisible
+;;;
+
+(defmacro enable-invisible ())
+
+(defmacro end-of-invisible ())
+
+(defun invisible-region (start end)
+ (if (save-excursion
+ (goto-char (1- end))
+ (eq (following-char) ?\n)
+ )
+ (setq end (1- end))
+ )
+ (put-text-property start end 'invisible t)
+ )
+
+(defun visible-region (start end)
+ (put-text-property start end 'invisible nil)
+ )
+
+(defun invisible-p (pos)
+ (get-text-property pos 'invisible)
+ )
+
+(defun next-visible-point (pos)
+ (save-excursion
+ (goto-char (next-single-property-change pos 'invisible))
+ (if (eq (following-char) ?\n)
+ (forward-char)
+ )
+ (point)))
+
+
+;;; @ string
+;;;
+
+(defmacro char-list-to-string (char-list)
+ "Convert list of character CHAR-LIST to string."
+ (` (mapconcat (function char-to-string)
+ (, char-list)
+ "")))
+
+
+;;; @ end
+;;;
+
+(provide 'poe-19)
+
+;;; poe-19.el ends here
--- /dev/null
+;;; poe-xemacs.el --- poe API implementation for XEmacs
+
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, XEmacs
+
+;; This file is part of APEL (A Portable Emacs 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 XEmacs; see the file COPYING. If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Code:
+
+;;; @ face
+;;;
+
+(or (fboundp 'face-list)
+ (defalias 'face-list 'list-faces))
+
+(or (memq 'underline (face-list))
+ (and (fboundp 'make-face)
+ (make-face 'underline)))
+
+(or (face-differs-from-default-p 'underline)
+ (set-face-underline-p 'underline t))
+
+
+;;; @ overlay
+;;;
+
+(condition-case nil
+ (require 'overlay)
+ (error (defalias 'make-overlay 'make-extent)
+ (defalias 'overlay-put 'set-extent-property)
+ (defalias 'overlay-buffer 'extent-buffer)
+ (defun move-overlay (extent start end &optional buffer)
+ (set-extent-endpoints extent start end)
+ )
+ ))
+
+
+;;; @ visible/invisible
+;;;
+
+(defmacro enable-invisible ())
+
+(defmacro end-of-invisible ())
+
+(defun invisible-region (start end)
+ (if (save-excursion
+ (goto-char start)
+ (eq (following-char) ?\n))
+ (setq start (1+ start))
+ )
+ (put-text-property start end 'invisible t)
+ )
+
+(defun visible-region (start end)
+ (put-text-property start end 'invisible nil)
+ )
+
+(defun invisible-p (pos)
+ (if (save-excursion
+ (goto-char pos)
+ (eq (following-char) ?\n))
+ (setq pos (1+ pos))
+ )
+ (get-text-property pos 'invisible)
+ )
+
+(defun next-visible-point (pos)
+ (save-excursion
+ (if (save-excursion
+ (goto-char pos)
+ (eq (following-char) ?\n))
+ (setq pos (1+ pos))
+ )
+ (or (next-single-property-change pos 'invisible)
+ (point-max))))
+
+
+;;; @ dired
+;;;
+
+(or (fboundp 'dired-other-frame)
+ (defun dired-other-frame (dirname &optional switches)
+ "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
+ (interactive (dired-read-dir-and-switches "in other frame "))
+ (switch-to-buffer-other-frame (dired-noselect dirname switches)))
+ )
+
+
+;;; @ string
+;;;
+
+(defmacro char-list-to-string (char-list)
+ "Convert list of character CHAR-LIST to string. [poe-xemacs.el]"
+ `(mapconcat #'char-to-string ,char-list ""))
+
+
+;;; @@ to avoid bug of XEmacs 19.14
+;;;
+
+(or (string-match "^../"
+ (file-relative-name "/usr/local/share" "/usr/local/lib"))
+ ;; This function was imported from Emacs 19.33.
+ (defun file-relative-name (filename &optional directory)
+ "Convert FILENAME to be relative to DIRECTORY
+(default: default-directory). [poe-xemacs.el]"
+ (setq filename (expand-file-name filename)
+ directory (file-name-as-directory
+ (expand-file-name
+ (or directory default-directory))))
+ (let ((ancestor ""))
+ (while (not (string-match (concat "^" (regexp-quote directory))
+ filename))
+ (setq directory (file-name-directory (substring directory 0 -1))
+ ancestor (concat "../" ancestor)))
+ (concat ancestor (substring filename (match-end 0)))))
+ )
+
+
+;;; @ Emacs 20.3 emulation
+;;;
+
+(or (fboundp 'line-beginning-position)
+ (defalias 'line-beginning-position 'point-at-bol))
+
+(or (fboundp 'line-end-position)
+ (defalias 'line-end-position 'point-at-eol))
+
+
+;;; @ end
+;;;
+
+(provide 'poe-xemacs)
+
+;;; poe-xemacs.el ends here
--- /dev/null
+;;; poe.el --- Emulation module for each Emacs variants
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defmacro defun-maybe (name &rest everything-else)
+ (or (and (fboundp name)
+ (not (get name 'defun-maybe))
+ )
+ (` (or (fboundp (quote (, name)))
+ (progn
+ (defun (, name) (,@ everything-else))
+ (put (quote (, name)) 'defun-maybe t)
+ ))
+ )))
+
+(defmacro defsubst-maybe (name &rest everything-else)
+ (or (and (fboundp name)
+ (not (get name 'defsubst-maybe))
+ )
+ (` (or (fboundp (quote (, name)))
+ (progn
+ (defsubst (, name) (,@ everything-else))
+ (put (quote (, name)) 'defsubst-maybe t)
+ ))
+ )))
+
+(defmacro defmacro-maybe (name &rest everything-else)
+ (or (and (fboundp name)
+ (not (get name 'defmacro-maybe))
+ )
+ (` (or (fboundp (quote (, name)))
+ (progn
+ (defmacro (, name) (,@ everything-else))
+ (put (quote (, name)) 'defmacro-maybe t)
+ ))
+ )))
+
+(put 'defun-maybe 'lisp-indent-function 'defun)
+(put 'defsubst-maybe 'lisp-indent-function 'defun)
+(put 'defmacro-maybe 'lisp-indent-function 'defun)
+
+(defmacro defconst-maybe (name &rest everything-else)
+ (or (and (boundp name)
+ (not (get name 'defconst-maybe))
+ )
+ (` (or (boundp (quote (, name)))
+ (progn
+ (defconst (, name) (,@ everything-else))
+ (put (quote (, name)) 'defconst-maybe t)
+ ))
+ )))
+
+(defconst-maybe emacs-major-version (string-to-int emacs-version))
+(defconst-maybe emacs-minor-version
+ (string-to-int
+ (substring emacs-version
+ (string-match (format "%d\\." emacs-major-version)
+ emacs-version))))
+
+(cond ((featurep 'xemacs)
+ (require 'poe-xemacs)
+ )
+ ((string-match "XEmacs" emacs-version)
+ (provide 'xemacs)
+ (require 'poe-xemacs)
+ )
+ ((>= emacs-major-version 19)
+ (require 'poe-19)
+ )
+ (t
+ (require 'poe-18)
+ ))
+
+
+;;; @ Emacs 19 emulation
+;;;
+
+(defun-maybe minibuffer-prompt-width ()
+ "Return the display width of the minibuffer prompt."
+ (save-excursion
+ (set-buffer (window-buffer (minibuffer-window)))
+ (current-column)))
+
+
+;;; @ Emacs 19.29 emulation
+;;;
+
+(defvar path-separator ":"
+ "Character used to separate concatenated paths.")
+
+(defun-maybe buffer-substring-no-properties (start end)
+ "Return the characters of part of the buffer, without the text properties.
+The two arguments START and END are character positions;
+they can be in either order. [Emacs 19.29 emulating function]"
+ (let ((string (buffer-substring start end)))
+ (set-text-properties 0 (length string) nil string)
+ string))
+
+(defun-maybe match-string (num &optional string)
+ "Return string of text matched by last search.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING.
+\[Emacs 19.29 emulating function]"
+ (if (match-beginning num)
+ (if string
+ (substring string (match-beginning num) (match-end num))
+ (buffer-substring (match-beginning num) (match-end num)))))
+
+(or (featurep 'xemacs)
+ (>= emacs-major-version 20)
+ (and (= emacs-major-version 19)
+ (>= emacs-minor-version 29))
+ ;; for Emacs 19.28 or earlier
+ (fboundp 'si:read-string)
+ (progn
+ (fset 'si:read-string (symbol-function 'read-string))
+
+ (defun read-string (prompt &optional initial-input history)
+ "Read a string from the minibuffer, prompting with string PROMPT.
+If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
+The third arg HISTORY, is dummy for compatibility. [emu.el]
+See `read-from-minibuffer' for details of HISTORY argument."
+ (si:read-string prompt initial-input))
+ ))
+
+
+;;; @ Emacs 19.30 emulation
+;;;
+
+;; This function was imported Emacs 19.30.
+(defun-maybe add-to-list (list-var element)
+ "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
+If you want to use `add-to-list' on a variable that is not defined
+until a certain package is loaded, you should put the call to `add-to-list'
+into a hook function that will be run only after loading the package.
+\[Emacs 19.30 emulating function]"
+ (or (member element (symbol-value list-var))
+ (set list-var (cons element (symbol-value list-var)))))
+
+(cond ((fboundp 'insert-file-contents-literally))
+ ((boundp 'file-name-handler-alist)
+ (defun insert-file-contents-literally
+ (filename &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+ This function ensures that none of these modifications will take place.
+\[Emacs 19.30 emulating function]"
+ (let (file-name-handler-alist)
+ (insert-file-contents filename visit beg end replace)))
+ )
+ (t
+ (defalias 'insert-file-contents-literally 'insert-file-contents)
+ ))
+
+
+;;; @ Emacs 19.31 emulation
+;;;
+
+(defun-maybe buffer-live-p (object)
+ "Return non-nil if OBJECT is a buffer which has not been killed.
+Value is nil if OBJECT is not a buffer or if it has been killed.
+\[Emacs 19.31 emulating function]"
+ (and object
+ (get-buffer object)
+ (buffer-name (get-buffer object))))
+
+;; This macro was imported Emacs 19.33.
+(defmacro-maybe save-selected-window (&rest body)
+ "Execute BODY, then select the window that was selected before BODY.
+\[Emacs 19.31 emulating function]"
+ (list 'let
+ '((save-selected-window-window (selected-window)))
+ (list 'unwind-protect
+ (cons 'progn body)
+ (list 'select-window 'save-selected-window-window))))
+
+
+;;; @ Emacs 20.1 emulation
+;;;
+
+;; This macro was imported Emacs 20.2.
+(defmacro-maybe when (cond &rest body)
+ "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
+ (list 'if cond (cons 'progn body)))
+
+;; This macro was imported Emacs 20.3.
+(defmacro-maybe unless (cond &rest body)
+ "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
+ (cons 'if (cons cond (cons nil body))))
+
+(defmacro-maybe save-current-buffer (&rest body)
+ "Save the current buffer; execute BODY; restore the current buffer.
+Executes BODY just like `progn'."
+ (` (let ((orig-buffer (current-buffer)))
+ (unwind-protect
+ (progn (,@ body))
+ (set-buffer orig-buffer)))))
+
+;; This macro was imported Emacs 20.2.
+(defmacro-maybe with-current-buffer (buffer &rest body)
+ "Execute the forms in BODY with BUFFER as the current buffer.
+The value returned is the value of the last form in BODY.
+See also `with-temp-buffer'."
+ (` (save-current-buffer
+ (set-buffer (, buffer))
+ (,@ body))))
+
+;; This macro was imported Emacs 20.2.
+(defmacro-maybe with-temp-file (file &rest forms)
+ "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
+The value of the last form in FORMS is returned, like `progn'.
+See also `with-temp-buffer'."
+ (let ((temp-file (make-symbol "temp-file"))
+ (temp-buffer (make-symbol "temp-buffer")))
+ (` (let (((, temp-file) (, file))
+ ((, temp-buffer)
+ (get-buffer-create (generate-new-buffer-name " *temp file*"))))
+ (unwind-protect
+ (prog1
+ (with-current-buffer (, temp-buffer)
+ (,@ forms))
+ (with-current-buffer (, temp-buffer)
+ (widen)
+ (write-region (point-min) (point-max) (, temp-file) nil 0)))
+ (and (buffer-name (, temp-buffer))
+ (kill-buffer (, temp-buffer))))))))
+
+;; This macro was imported Emacs 20.2.
+(defmacro-maybe with-temp-buffer (&rest forms)
+ "Create a temporary buffer, and evaluate FORMS there like `progn'.
+See also `with-temp-file' and `with-output-to-string'."
+ (let ((temp-buffer (make-symbol "temp-buffer")))
+ (` (let (((, temp-buffer)
+ (get-buffer-create (generate-new-buffer-name " *temp*"))))
+ (unwind-protect
+ (with-current-buffer (, temp-buffer)
+ (,@ forms))
+ (and (buffer-name (, temp-buffer))
+ (kill-buffer (, temp-buffer))))))))
+
+;; This function was imported Emacs 20.3.
+(defun-maybe last (x &optional n)
+ "Return the last link of the list X. Its car is the last element.
+If X is nil, return nil.
+If N is non-nil, return the Nth-to-last link of X.
+If N is bigger than the length of X, return X."
+ (if n
+ (let ((m 0) (p x))
+ (while (consp p)
+ (setq m (1+ m) p (cdr p)))
+ (if (<= n 0) p
+ (if (< n m) (nthcdr (- m n) x) x)))
+ (while (cdr x)
+ (setq x (cdr x)))
+ x))
+
+;; This function was imported Emacs 20.3. (cl function)
+(defun-maybe butlast (x &optional n)
+ "Returns a copy of LIST with the last N elements removed."
+ (if (and n (<= n 0)) x
+ (nbutlast (copy-sequence x) n)))
+
+;; This function was imported Emacs 20.3. (cl function)
+(defun-maybe nbutlast (x &optional n)
+ "Modifies LIST to remove the last N elements."
+ (let ((m (length x)))
+ (or n (setq n 1))
+ (and (< n m)
+ (progn
+ (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
+ x))))
+
+;; This function was imported from XEmacs 21.
+(defun-maybe split-string (string &optional pattern)
+ "Return a list of substrings of STRING which are separated by PATTERN.
+If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
+ (or pattern
+ (setq pattern "[ \f\t\n\r\v]+"))
+ ;; The FSF version of this function takes care not to cons in case
+ ;; of infloop. Maybe we should synch?
+ (let (parts (start 0))
+ (while (string-match pattern string start)
+ (setq parts (cons (substring string start (match-beginning 0)) parts)
+ start (match-end 0)))
+ (nreverse (cons (substring string start) parts))))
+
+
+;;; @ Emacs 20.3 emulation
+;;;
+
+(defun-maybe line-beginning-position (&optional n)
+ "Return the character position of the first character on the current line.
+With argument N not nil or 1, move forward N - 1 lines first.
+If scan reaches end of buffer, return that position.
+This function does not move point."
+ (save-excursion
+ (if n
+ (forward-line (1- n))
+ )
+ (beginning-of-line)
+ (point)))
+
+(defun-maybe line-end-position (&optional n)
+ "Return the character position of the last character on the current line.
+With argument N not nil or 1, move forward N - 1 lines first.
+If scan reaches end of buffer, return that position.
+This function does not move point."
+ (save-excursion
+ (if n
+ (forward-line (1- n))
+ )
+ (end-of-line)
+ (point)))
+
+
+;;; @ XEmacs emulation
+;;;
+
+(defun-maybe point-at-bol (&optional n buffer)
+ "Return the character position of the first character on the current line.
+With argument N not nil or 1, move forward N - 1 lines first.
+If scan reaches end of buffer, return that position.
+This function does not move point. [XEmacs emulating function]"
+ (save-excursion
+ (if buffer
+ (set-buffer buffer)
+ )
+ (line-beginning-position n)
+ ))
+
+(defun-maybe point-at-eol (&optional n buffer)
+ "Return the character position of the last character on the current line.
+With argument N not nil or 1, move forward N - 1 lines first.
+If scan reaches end of buffer, return that position.
+This function does not move point. [XEmacs emulating function]"
+ (save-excursion
+ (if buffer
+ (set-buffer buffer)
+ )
+ (line-end-position n)
+ ))
+
+(defun-maybe functionp (obj)
+ "Returns t if OBJ is a function, nil otherwise.
+\[XEmacs emulating function]"
+ (or (subrp obj)
+ (byte-code-function-p obj)
+ (and (symbolp obj)(fboundp obj))
+ (and (consp obj)(eq (car obj) 'lambda))
+ ))
+
+
+;;; @ end
+;;;
+
+(provide 'poe)
+
+;;; poe.el ends here
--- /dev/null
+;;; poem-20.el --- poem implementation for Emacs 20 and XEmacs-mule
+
+;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule)
+;; or later.
+
+;;; Code:
+
+;;; @ without code-conversion
+;;;
+
+(defmacro as-binary-process (&rest body)
+ `(let (selective-display ; Disable ^M to nl translation.
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ ,@body))
+
+(defmacro as-binary-input-file (&rest body)
+ `(let ((coding-system-for-read 'binary))
+ ,@body))
+
+(defmacro as-binary-output-file (&rest body)
+ `(let ((coding-system-for-write 'binary))
+ ,@body))
+
+(defun write-region-as-binary (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but don't encode."
+ (let ((coding-system-for-write 'binary)
+ jka-compr-compression-info-list)
+ (write-region start end filename append visit lockname)))
+
+;; `insert-file-contents-literally' of Emacs 20 supports
+;; `file-name-handler-alist'.
+(defalias 'insert-file-contents-as-binary 'insert-file-contents-literally)
+
+(defun insert-file-contents-as-raw-text (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but don't code and format conversion.
+Like `insert-file-contents-literary', but it allows find-file-hooks,
+automatic uncompression, etc.
+Like `insert-file-contents-as-binary', but it converts line-break
+code."
+ (let ((coding-system-for-read 'raw-text)
+ format-alist)
+ ;; Returns list of absolute file name and length of data inserted.
+ (insert-file-contents filename visit beg end replace)))
+
+(defun write-region-as-raw-text-CRLF (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but write as network representation."
+ (let ((coding-system-for-write 'raw-text-dos))
+ (write-region start end filename append visit lockname)))
+
+
+;;; @ end
+;;;
+
+(provide 'poem-20)
+
+;;; poem-20.el ends here
--- /dev/null
+;;; poem-e20.el --- poem implementation for XEmacs-mule
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defun fontset-pixel-size (fontset)
+ (let* ((info (fontset-info fontset))
+ (height (aref info 1))
+ )
+ (cond ((> height 0) height)
+ ((string-match "-\\([0-9]+\\)-" fontset)
+ (string-to-number
+ (substring fontset (match-beginning 1)(match-end 1))))
+ (t 0))))
+
+
+;;; @ character set
+;;;
+
+;; (defalias 'charset-columns 'charset-width)
+
+(defun find-non-ascii-charset-string (string)
+ "Return a list of charsets in the STRING except ascii."
+ (delq 'ascii (find-charset-string string)))
+
+(defun find-non-ascii-charset-region (start end)
+ "Return a list of charsets except ascii
+in the region between START and END."
+ (delq 'ascii (find-charset-string (buffer-substring start end))))
+
+
+;;; @ coding system
+;;;
+
+(defsubst-maybe find-coding-system (obj)
+ "Return OBJ if it is a coding-system."
+ (if (coding-system-p obj)
+ obj))
+
+(defalias 'set-process-input-coding-system 'set-process-coding-system)
+
+
+;;; @ end
+;;;
+
+(require 'poem-20)
+
+(if (and (fboundp 'set-buffer-multibyte)
+ (subrp (symbol-function 'set-buffer-multibyte)))
+ (require 'poem-e20_3) ; for Emacs 20.3
+ (require 'poem-e20_2) ; for Emacs 20.1 and 20.2
+ )
+
+(provide 'poem-e20)
+
+;;; poem-e20.el ends here
--- /dev/null
+;;; poem-e20_2.el --- poem implementation for Emacs 20.1 and 20.2
+
+;; Copyright (C) 1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module requires Emacs 20.1 and 20.2.
+
+;;; Code:
+
+;;; @ buffer representation
+;;;
+
+(defun-maybe set-buffer-multibyte (flag)
+ "Set the multibyte flag of the current buffer to FLAG.
+If FLAG is t, this makes the buffer a multibyte buffer.
+If FLAG is nil, this makes the buffer a single-byte buffer.
+The buffer contents remain unchanged as a sequence of bytes
+but the contents viewed as characters do change.
+\[Emacs 20.3 emulating function]"
+ (setq enable-multibyte-characters flag)
+ )
+
+
+;;; @ character
+;;;
+
+(defalias 'char-length 'char-bytes)
+
+(defmacro char-next-index (char index)
+ "Return index of character succeeding CHAR whose index is INDEX."
+ `(+ ,index (char-bytes ,char)))
+
+
+;;; @ string
+;;;
+
+(defalias 'sset 'store-substring)
+
+(defun string-to-char-list (string)
+ "Return a list of which elements are characters in the STRING."
+ (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)
+
+(defun looking-at-as-unibyte (regexp)
+ "Like `looking-at', but string is regarded as unibyte sequence."
+ (let (enable-multibyte-characters)
+ (looking-at regexp)))
+
+;;; @@ obsoleted aliases
+;;;
+;;; You should not use them.
+
+(defalias 'string-columns 'string-width)
+(make-obsolete 'string-columns 'string-width)
+
+
+;;; @ without code-conversion
+;;;
+
+(defun insert-file-contents-as-binary (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but don't code and format conversion.
+Like `insert-file-contents-literary', but it allows find-file-hooks,
+automatic uncompression, etc.
+
+Namely this function ensures that only format decoding and character
+code conversion will not take place."
+ (let ((flag enable-multibyte-characters)
+ (coding-system-for-read 'binary)
+ format-alist)
+ (prog1
+ ;; Returns list absolute file name and length of data inserted.
+ (insert-file-contents filename visit beg end replace)
+ ;; This operation does not change the length.
+ (set-buffer-multibyte flag))))
+
+(defun insert-file-contents-as-raw-text (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but don't code and format conversion.
+Like `insert-file-contents-literary', but it allows find-file-hooks,
+automatic uncompression, etc.
+Like `insert-file-contents-as-binary', but it converts line-break
+code."
+ (let ((flag enable-multibyte-characters)
+ (coding-system-for-read 'raw-text)
+ format-alist)
+ (prog1
+ ;; Returns list absolute file name and length of data inserted.
+ (insert-file-contents filename visit beg end replace)
+ ;; This operation does not change the length.
+ (set-buffer-multibyte flag))))
+
+
+;;; @ end
+;;;
+
+(provide 'poem-e20_2)
+
+;;; poem-e20_2.el ends here
--- /dev/null
+;;; poem-e20_3.el --- poem implementation for Emacs 20.3.
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module requires Emacs 20.2.91 or later.
+
+;;; Code:
+
+;;; @ character
+;;;
+
+(defsubst char-length (char)
+ "Return indexing length of multi-byte form of CHAR."
+ 1)
+
+(defmacro char-next-index (char index)
+ "Return index of character succeeding CHAR whose index is INDEX."
+ `(1+ ,index))
+
+
+;;; @ string
+;;;
+
+(defalias 'sset 'store-substring)
+
+(defun string-to-char-list (string)
+ "Return a list of which elements are characters in the STRING."
+ (mapcar #'identity string))
+
+(defalias 'string-to-int-list 'string-to-char-list)
+
+(defalias 'looking-at-as-unibyte 'looking-at)
+
+
+;;; @ end
+;;;
+
+(provide 'poem-e20_3)
+
+;;; poem-e20_3.el ends here
--- /dev/null
+;;; poem-ltn1.el --- poem implementation for Emacs 19 and XEmacs without MULE
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+;;; @ buffer representation
+;;;
+
+(defun-maybe set-buffer-multibyte (flag)
+ "Set the multibyte flag of the current buffer to FLAG.
+If FLAG is t, this makes the buffer a multibyte buffer.
+If FLAG is nil, this makes the buffer a single-byte buffer.
+The buffer contents remain unchanged as a sequence of bytes
+but the contents viewed as characters do change.
+\[Emacs 20.3 emulating macro]"
+ )
+
+
+;;; @ character set
+;;;
+
+(put 'ascii 'charset-description "Character set of ASCII")
+(put 'ascii 'charset-registry "ASCII")
+
+(put 'latin-iso8859-1 'charset-description "Character set of ISO-8859-1")
+(put 'latin-iso8859-1 'charset-registry "ISO8859-1")
+
+(defun charset-description (charset)
+ "Return description of CHARSET."
+ (get charset 'charset-description))
+
+(defun charset-registry (charset)
+ "Return registry name of CHARSET."
+ (get charset 'charset-registry))
+
+(defun charset-width (charset)
+ "Return number of columns a CHARSET occupies when displayed."
+ 1)
+
+(defun charset-direction (charset)
+ "Return the direction of a character of CHARSET by
+ 0 (left-to-right) or 1 (right-to-left)."
+ 0)
+
+(defun find-charset-string (str)
+ "Return a list of charsets in the string."
+ (if (string-match "[\200-\377]" str)
+ '(latin-iso8859-1)
+ ))
+
+(defalias 'find-non-ascii-charset-string 'find-charset-string)
+
+(defun find-charset-region (start end)
+ "Return a list of charsets in the region between START and END."
+ (if (save-excursion
+ (goto-char start)
+ (re-search-forward "[\200-\377]" end t))
+ '(latin-iso8859-1)
+ ))
+
+(defalias 'find-non-ascii-charset-region 'find-charset-region)
+
+
+;;; @ coding-system
+;;;
+
+(defun decode-coding-string (string coding-system)
+ "Decode the STRING which is encoded in CODING-SYSTEM."
+ string)
+
+(defun encode-coding-string (string coding-system)
+ "Encode the STRING as CODING-SYSTEM."
+ string)
+
+(defun decode-coding-region (start end coding-system)
+ "Decode the text between START and END which is encoded in CODING-SYSTEM."
+ 0)
+
+(defun encode-coding-region (start end coding-system)
+ "Encode the text between START and END to CODING-SYSTEM."
+ 0)
+
+(defun detect-coding-region (start end)
+ "Detect coding-system of the text in the region between START and END."
+ )
+
+(defun set-buffer-file-coding-system (coding-system &optional force)
+ "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM."
+ )
+
+
+;;; @ without code-conversion
+;;;
+
+(defmacro as-binary-process (&rest body)
+ (` (let (selective-display) ; Disable ^M to nl translation.
+ (,@ body))))
+
+(defmacro as-binary-input-file (&rest body)
+ (` (let ((emx-binary-mode t)) ; Stop CRLF to LF conversion in OS/2
+ (,@ body))))
+
+(defmacro as-binary-output-file (&rest body)
+ (` (let ((emx-binary-mode t)) ; Stop CRLF to LF conversion in OS/2
+ (,@ body))))
+
+(defun write-region-as-binary (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but don't code conversion."
+ (let ((emx-binary-mode t))
+ (write-region start end filename append visit lockname)))
+
+(defun insert-file-contents-as-binary (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but don't code and format conversion.
+Like `insert-file-contents-literary', but it allows find-file-hooks,
+automatic uncompression, etc.
+
+Namely this function ensures that only format decoding and character
+code conversion will not take place."
+ (let ((emx-binary-mode t))
+ ;; Returns list of absolute file name and length of data inserted.
+ (insert-file-contents filename visit beg end replace)))
+
+(defun write-region-as-raw-text-CRLF (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but write as network representation."
+ (let ((the-buf (current-buffer)))
+ (with-temp-buffer
+ (insert-buffer-substring the-buf start end)
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t)
+ (replace-match "\\1\r\n"))
+ (write-region (point-min)(point-max) filename append visit lockname))))
+
+(defalias 'insert-file-contents-as-raw-text 'insert-file-contents)
+
+
+;;; @ character
+;;;
+
+(defun char-charset (char)
+ "Return the character set of char CHAR."
+ (if (< chr 128)
+ 'ascii
+ 'latin-iso8859-1))
+
+(defun char-bytes (char)
+ "Return number of bytes a character in CHAR occupies in a buffer."
+ 1)
+
+(defun char-width (char)
+ "Return number of columns a CHAR occupies when displayed."
+ 1)
+
+(defun split-char (character)
+ "Return list of charset and one or two position-codes of CHARACTER."
+ (cons (char-charset character) character))
+
+(defalias 'char-length 'char-bytes)
+
+(defmacro char-next-index (char index)
+ "Return index of character succeeding CHAR whose index is INDEX."
+ (` (1+ (, index))))
+
+
+;;; @ string
+;;;
+
+(defalias 'string-width 'length)
+
+(defun string-to-char-list (str)
+ (mapcar (function identity) str))
+
+(defalias 'string-to-int-list 'string-to-char-list)
+
+(defalias 'sref 'aref)
+
+(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-latin1.el; MULE 2.3 emulating function]"
+ (or start-column
+ (setq start-column 0))
+ (substring str start-column width))
+
+(defalias 'looking-at-as-unibyte 'looking-at)
+
+;;; @@ obsoleted aliases
+;;;
+;;; You should not use them.
+
+(defalias 'string-columns 'length)
+(make-obsolete 'string-columns 'string-width)
+
+
+;;; @ end
+;;;
+
+(provide 'poem-ltn1)
+
+;;; poem-ltn1.el ends here
--- /dev/null
+;;; poem-nemacs.el --- poem implementation for Nemacs
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+;;; @ character set
+;;;
+
+(put 'ascii
+ 'charset-description "Character set of ASCII")
+(put 'ascii
+ 'charset-registry "ASCII")
+
+(put 'japanese-jisx0208
+ 'charset-description "Character set of JIS X0208-1983")
+(put 'japanese-jisx0208
+ 'charset-registry "JISX0208.1983")
+
+(defun charset-description (charset)
+ "Return description of CHARSET. [emu-nemacs.el]"
+ (get charset 'charset-description))
+
+(defun charset-registry (charset)
+ "Return registry name of CHARSET. [emu-nemacs.el]"
+ (get charset 'charset-registry))
+
+(defun charset-width (charset)
+ "Return number of columns a CHARSET occupies when displayed.
+\[emu-nemacs.el]"
+ (if (eq charset 'ascii)
+ 1
+ 2))
+
+(defun charset-direction (charset)
+ "Return the direction of a character of CHARSET by
+ 0 (left-to-right) or 1 (right-to-left). [emu-nemacs.el]"
+ 0)
+
+(defun find-charset-string (str)
+ "Return a list of charsets in the string.
+\[emu-nemacs.el; Mule emulating function]"
+ (if (string-match "[\200-\377]" str)
+ '(japanese-jisx0208)
+ ))
+
+(defalias 'find-non-ascii-charset-string 'find-charset-string)
+
+(defun find-charset-region (start end)
+ "Return a list of charsets in the region between START and END.
+\[emu-nemacs.el; Mule emulating function]"
+ (if (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (re-search-forward "[\200-\377]" nil t)))
+ '(japanese-jisx0208)
+ ))
+
+(defalias 'find-non-ascii-charset-region 'find-charset-region)
+
+(defun check-ASCII-string (str)
+ (let ((i 0)
+ len)
+ (setq len (length str))
+ (catch 'label
+ (while (< i len)
+ (if (>= (elt str i) 128)
+ (throw 'label nil))
+ (setq i (+ i 1)))
+ str)))
+
+;;; @@ for old MULE emulation
+;;;
+
+;;(defconst lc-ascii 0)
+;;(defconst lc-jp 146)
+
+
+;;; @ coding system
+;;;
+
+(defvar coding-system-kanji-code-alist
+ '((binary . 0)
+ (raw-text . 0)
+ (shift_jis . 1)
+ (iso-2022-jp . 2)
+ (ctext . 2)
+ (euc-jp . 3)
+ ))
+
+(defun decode-coding-string (string coding-system)
+ "Decode the STRING which is encoded in CODING-SYSTEM.
+\[emu-nemacs.el; EMACS 20 emulating function]"
+ (let ((code (if (integerp coding-system)
+ coding-system
+ (cdr (assq coding-system coding-system-kanji-code-alist)))))
+ (if (eq code 3)
+ string
+ (convert-string-kanji-code string code 3)
+ )))
+
+(defun encode-coding-string (string coding-system)
+ "Encode the STRING to CODING-SYSTEM.
+\[emu-nemacs.el; EMACS 20 emulating function]"
+ (let ((code (if (integerp coding-system)
+ coding-system
+ (cdr (assq coding-system coding-system-kanji-code-alist)))))
+ (if (eq code 3)
+ string
+ (convert-string-kanji-code string 3 code)
+ )))
+
+(defun decode-coding-region (start end coding-system)
+ "Decode the text between START and END which is encoded in CODING-SYSTEM.
+\[emu-nemacs.el; EMACS 20 emulating function]"
+ (let ((code (if (integerp coding-system)
+ coding-system
+ (cdr (assq coding-system coding-system-kanji-code-alist)))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (convert-region-kanji-code start end code 3)
+ ))))
+
+(defun encode-coding-region (start end coding-system)
+ "Encode the text between START and END to CODING-SYSTEM.
+\[emu-nemacs.el; EMACS 20 emulating function]"
+ (let ((code (if (integerp coding-system)
+ coding-system
+ (cdr (assq coding-system coding-system-kanji-code-alist)))))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (convert-region-kanji-code start end 3 code)
+ ))))
+
+(defun detect-coding-region (start end)
+ "Detect coding-system of the text in the region between START and END.
+\[emu-nemacs.el; Emacs 20 emulating function]"
+ (if (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (re-search-forward "[\200-\377]" nil t)))
+ 'euc-jp
+ ))
+
+(defalias 'set-buffer-file-coding-system 'set-kanji-fileio-code)
+
+
+;;; @ without code-conversion
+;;;
+
+(defmacro as-binary-process (&rest body)
+ (` (let (selective-display ; Disable ^M to nl translation.
+ ;; NEmacs
+ kanji-flag
+ (default-kanji-process-code 0)
+ program-kanji-code-alist)
+ (,@ body))))
+
+(defmacro as-binary-input-file (&rest body)
+ (` (let (kanji-flag)
+ (,@ body))))
+
+(defmacro as-binary-output-file (&rest body)
+ (` (let (kanji-flag)
+ (,@ body))))
+
+(defun write-region-as-binary (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but don't code conversion. [emu-nemacs.el]"
+ (as-binary-output-file
+ (write-region start end filename append visit)))
+
+(defun insert-file-contents-as-binary (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but don't character code conversion.
+\[emu-nemacs.el]"
+ (as-binary-input-file
+ ;; Returns list absolute file name and length of data inserted.
+ (insert-file-contents filename visit beg end replace)))
+
+(defun insert-file-contents-as-raw-text (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but don't character code conversion.
+\[emu-nemacs.el]"
+ (as-binary-input-file
+ ;; Returns list absolute file name and length of data inserted.
+ (insert-file-contents filename visit beg end replace)))
+
+(defun write-region-as-raw-text-CRLF (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but don't code conversion. [emu-nemacs.el]"
+ (let ((the-buf (current-buffer)))
+ (with-temp-buffer
+ (insert-buffer-substring the-buf start end)
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t)
+ (replace-match "\\1\r\n"))
+ (write-region-as-binary (point-min)(point-max)
+ filename append visit))))
+
+
+;;; @ buffer representation
+;;;
+
+(defsubst-maybe set-buffer-multibyte (flag)
+ "Set the multibyte flag of the current buffer to FLAG.
+If FLAG is t, this makes the buffer a multibyte buffer.
+If FLAG is nil, this makes the buffer a single-byte buffer.
+The buffer contents remain unchanged as a sequence of bytes
+but the contents viewed as characters do change.
+\[Emacs 20.3 emulating function]"
+ (setq kanji-flag flag)
+ )
+
+
+;;; @ character
+;;;
+
+(defun char-charset (chr)
+ "Return the character set of char CHR.
+\[emu-nemacs.el; MULE emulating function]"
+ (if (< chr 128)
+ 'ascii
+ 'japanese-jisx0208))
+
+(defun char-bytes (chr)
+ "Return number of bytes CHAR will occupy in a buffer.
+\[emu-nemacs.el; Mule emulating function]"
+ (if (< chr 128)
+ 1
+ 2))
+
+(defun char-width (char)
+ "Return number of columns a CHAR occupies when displayed.
+\[emu-nemacs.el]"
+ (if (< char 128)
+ 1
+ 2))
+
+(defalias 'char-length 'char-bytes)
+
+(defmacro char-next-index (char index)
+ "Return index of character succeeding CHAR whose index is INDEX."
+ (` (+ (, index) (char-bytes (, char)))))
+
+
+;;; @ string
+;;;
+
+(defalias 'string-width 'length)
+
+(defun sref (str idx)
+ "Return the character in STR at index IDX.
+\[emu-nemacs.el; Mule emulating function]"
+ (let ((chr (aref str idx)))
+ (if (< chr 128)
+ chr
+ (logior (lsh (aref str (1+ idx)) 8) chr))))
+
+(defun string-to-char-list (str)
+ (let ((i 0)(len (length str)) dest chr)
+ (while (< i len)
+ (setq chr (aref str i))
+ (if (>= chr 128)
+ (setq i (1+ i)
+ chr (+ (lsh chr 8) (aref str i)))
+ )
+ (setq dest (cons chr dest))
+ (setq i (1+ i)))
+ (reverse dest)))
+
+(fset 'string-to-int-list (symbol-function 'string-to-char-list))
+
+;;; 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-mule.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-columns 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-columns ch))
+ to-prev to
+ to (+ to (char-bytes ch))))
+ (setq to to-prev)))
+ (substring str from to))))
+
+(defalias 'looking-at-as-unibyte 'looking-at)
+
+;;; @@ obsoleted aliases
+;;;
+;;; You should not use them.
+
+(defalias 'string-columns 'length)
+
+
+;;; @ end
+;;;
+
+(provide 'poem-nemacs)
+
+;;; poem-nemacs.el ends here
--- /dev/null
+;;; poem-om.el --- poem implementation for Mule 1.* and Mule 2.*
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; 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 'poe)
+
+
+;;; @ version specific features
+;;;
+
+(cond ((= emacs-major-version 19)
+ ;; Suggested by SASAKI Osamu <osamu@shuugr.bekkoame.or.jp>
+ ;; (cf. [os2-emacs-ja:78])
+ (defun fontset-pixel-size (fontset)
+ (let* ((font (get-font-info
+ (aref (cdr (get-fontset-info fontset)) 0)))
+ (open (aref font 4)))
+ (if (= open 1)
+ (aref font 5)
+ (if (= open 0)
+ (let ((pat (aref font 1)))
+ (if (string-match "-[0-9]+-" pat)
+ (string-to-number
+ (substring
+ pat (1+ (match-beginning 0)) (1- (match-end 0))))
+ 0))
+ ))))
+ ))
+
+
+;;; @ character set
+;;;
+
+(defalias 'make-char 'make-character)
+
+(defalias 'find-non-ascii-charset-string 'find-charset-string)
+(defalias 'find-non-ascii-charset-region 'find-charset-region)
+
+(defalias 'charset-bytes 'char-bytes)
+(defalias 'charset-description 'char-description)
+(defalias 'charset-registry 'char-registry)
+(defalias 'charset-columns 'char-width)
+(defalias 'charset-direction 'char-direction)
+
+(defun charset-chars (charset)
+ "Return the number of characters per dimension of CHARSET."
+ (if (= (logand (nth 2 (character-set charset)) 1) 1)
+ 96
+ 94))
+
+
+;;; @ coding system
+;;;
+
+(defun encode-coding-region (start end coding-system)
+ "Encode the text between START and END to CODING-SYSTEM.
+\[EMACS 20 emulating function]"
+ ;; If `coding-system' is nil, do nothing.
+ (code-convert-region start end *internal* coding-system))
+
+(defun decode-coding-region (start end coding-system)
+ "Decode the text between START and END which is encoded in CODING-SYSTEM.
+\[EMACS 20 emulating function]"
+ ;; If `coding-system' is nil, do nothing.
+ (code-convert-region start end coding-system *internal*))
+
+;; XXX: Should we support optional NOCOPY argument? (only in Emacs 20.x)
+(defun encode-coding-string (str coding-system)
+ "Encode the STRING to CODING-SYSTEM.
+\[EMACS 20 emulating function]"
+ (if coding-system
+ (code-convert-string str *internal* coding-system)
+ ;;(code-convert-string str *internal* nil) returns nil instead of str.
+ str))
+
+;; XXX: Should we support optional NOCOPY argument? (only in Emacs 20.x)
+(defun decode-coding-string (str coding-system)
+ "Decode the string STR which is encoded in CODING-SYSTEM.
+\[EMACS 20 emulating function]"
+ (if coding-system
+ (let ((len (length str))
+ ret)
+ (while (and (< 0 len)
+ (null (setq ret
+ (code-convert-string
+ (substring str 0 len)
+ coding-system *internal*))))
+ (setq len (1- len)))
+ (concat ret (substring str len)))
+ str))
+
+(defalias 'detect-coding-region 'code-detect-region)
+
+(defalias 'set-buffer-file-coding-system 'set-file-coding-system)
+
+
+;;; @ without code-conversion
+;;;
+
+(defmacro as-binary-process (&rest body)
+ (` (let (selective-display ; Disable ^M to nl translation.
+ ;; Mule
+ mc-flag
+ (default-process-coding-system (cons *noconv* *noconv*))
+ program-coding-system-alist)
+ (,@ body))))
+
+(defmacro as-binary-input-file (&rest body)
+ (` (let (mc-flag
+ (file-coding-system-for-read *noconv*)
+ )
+ (,@ body))))
+
+(defmacro as-binary-output-file (&rest body)
+ (` (let (mc-flag
+ (file-coding-system *noconv*)
+ )
+ (,@ body))))
+
+(defalias 'set-process-input-coding-system 'set-process-coding-system)
+
+(defun insert-file-contents-as-binary (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but don't code and format conversion.
+Like `insert-file-contents-literary', but it allows find-file-hooks,
+automatic uncompression, etc.
+
+Namely this function ensures that only format decoding and character
+code conversion will not take place."
+ (as-binary-input-file
+ ;; Returns list absolute file name and length of data inserted.
+ (insert-file-contents filename visit beg end replace)))
+
+(defun insert-file-contents-as-raw-text (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but don't code and format conversion.
+Like `insert-file-contents-literary', but it allows find-file-hooks,
+automatic uncompression, etc.
+Like `insert-file-contents-as-binary', but it converts line-break
+code."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point)(point))
+ (let ((return-val
+ ;; Returns list absolute file name and length of data inserted.
+ (insert-file-contents-as-binary filename visit beg end replace)))
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" nil t)
+ (replace-match ""))
+ (list (car return-val) (buffer-size))))))
+
+(defun insert-binary-file-contents-literally (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents-literally', q.v., but don't code conversion.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+ This function ensures that none of these modifications will take place."
+ (as-binary-input-file
+ ;; Returns list absolute file name and length of data inserted.
+ (insert-file-contents-literally filename visit beg end replace)))
+
+(cond
+ (running-emacs-19_29-or-later
+ ;; for MULE 2.3 based on Emacs 19.34.
+ (defun write-region-as-binary (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but don't code conversion."
+ (as-binary-output-file
+ (write-region start end filename append visit lockname)))
+
+ (defun write-region-as-raw-text-CRLF (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but don't code conversion."
+ (let ((the-buf (current-buffer)))
+ (with-temp-buffer
+ (insert-buffer-substring the-buf start end)
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t)
+ (replace-match "\\1\r\n"))
+ (write-region-as-binary (point-min)(point-max)
+ filename append visit lockname))))
+ )
+ (t
+ ;; for MULE 2.3 based on Emacs 19.28.
+ (defun write-region-as-binary (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but don't code conversion."
+ (as-binary-output-file
+ (write-region start end filename append visit)))
+
+ (defun write-region-as-raw-text-CRLF (start end filename
+ &optional append visit lockname)
+ "Like `write-region', q.v., but don't code conversion."
+ (let ((the-buf (current-buffer)))
+ (with-temp-buffer
+ (insert-buffer-substring the-buf start end)
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t)
+ (replace-match "\\1\r\n"))
+ (write-region-as-binary (point-min)(point-max)
+ filename append visit))))
+ ))
+
+
+;;; @ buffer representation
+;;;
+
+(defsubst-maybe set-buffer-multibyte (flag)
+ "Set the multibyte flag of the current buffer to FLAG.
+If FLAG is t, this makes the buffer a multibyte buffer.
+If FLAG is nil, this makes the buffer a single-byte buffer.
+The buffer contents remain unchanged as a sequence of bytes
+but the contents viewed as characters do change.
+\[Emacs 20.3 emulating function]"
+ (setq mc-flag flag)
+ )
+
+
+;;; @ character
+;;;
+
+(defalias 'char-charset 'char-leading-char)
+
+(defun split-char (character)
+ "Return list of charset and one or two position-codes of CHARACTER."
+ (let ((p (1- (char-bytes character)))
+ dest)
+ (while (>= p 1)
+ (setq dest (cons (- (char-component character p) 128) dest)
+ p (1- p)))
+ (cons (char-charset character) dest)))
+
+(defmacro char-next-index (char index)
+ "Return index of character succeeding CHAR whose index is INDEX."
+ (` (+ (, index) (char-bytes (, char)))))
+
+;;; @@ obsoleted aliases
+;;;
+;;; You should not use them.
+
+(defalias 'char-length 'char-bytes)
+;;(defalias 'char-columns 'char-width)
+
+
+;;; @ string
+;;;
+
+(defalias 'string-columns 'string-width)
+
+(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-mule.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))))
+ )
+
+(defalias 'looking-at-as-unibyte 'looking-at)
+
+
+;;; @ end
+;;;
+
+(provide 'poem-om)
+
+;;; poem-om.el ends here
--- /dev/null
+;;; poem-xm.el --- poem implementation for XEmacs-mule
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; 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 'poem-20)
+
+
+;;; @ fix coding-system definition
+;;;
+
+;; It seems not bug, but I can not permit it...
+(and (coding-system-property 'iso-2022-jp 'input-charset-conversion)
+ (copy-coding-system 'iso-2022-7bit 'iso-2022-jp))
+
+;; Redefine if -{dos|mac|unix} is not found.
+(or (find-coding-system 'raw-text-dos)
+ (copy-coding-system 'no-conversion-dos 'raw-text-dos))
+(or (find-coding-system 'raw-text-mac)
+ (copy-coding-system 'no-conversion-mac 'raw-text-mac))
+(or (find-coding-system 'raw-text-unix)
+ (copy-coding-system 'no-conversion-unix 'raw-text-unix))
+
+(or (find-coding-system 'ctext-dos)
+ (make-coding-system
+ 'ctext 'iso2022
+ "Coding-system used in X as Compound Text Encoding."
+ '(charset-g0 ascii charset-g1 latin-iso8859-1
+ eol-type nil
+ mnemonic "CText")))
+
+(or (find-coding-system 'iso-2022-jp-2-dos)
+ (make-coding-system
+ 'iso-2022-jp-2 'iso2022
+ "ISO-2022 coding system using SS2 for 96-charset in 7-bit code."
+ '(charset-g0 ascii
+ charset-g2 t ;; unspecified but can be used later.
+ seven t
+ short t
+ mnemonic "ISO7/SS2"
+ eol-type nil)))
+
+(or (find-coding-system 'euc-kr-dos)
+ (make-coding-system
+ 'euc-kr 'iso2022
+ "Coding-system of Korean EUC (Extended Unix Code)."
+ '(charset-g0 ascii charset-g1 korean-ksc5601
+ mnemonic "ko/EUC"
+ eol-type nil)))
+
+;; (when (= (function-max-args 'coding-system-list) 0)
+;; (or (fboundp 'coding-system-list-internal)
+;; (fset 'coding-system-list-internal
+;; (symbol-function 'coding-system-list)))
+;; (defun coding-system-list (&optional base-only)
+;; "Return a list of all existing coding systems.
+;; If optional arg BASE-ONLY is non-nil, only base coding systems are listed."
+;; (if base-only
+;; (let (dest
+;; (rest (coding-system-list-internal))
+;; cs)
+;; (while rest
+;; (setq cs (coding-system-name (coding-system-base (pop rest))))
+;; (or (memq cs dest)
+;; (push cs dest))
+;; )
+;; dest)
+;; (coding-system-list-internal)))
+;; )
+
+
+;;; @ without code-conversion
+;;;
+
+(defun insert-file-contents-as-binary (filename
+ &optional visit beg end replace)
+ "Like `insert-file-contents', but only reads in the file literally.
+A buffer may be modified in several ways after reading into the buffer,
+to Emacs features such as format decoding, character code
+conversion, find-file-hooks, automatic uncompression, etc.
+
+This function ensures that none of these modifications will take place."
+ (let ((format-alist nil)
+ (after-insert-file-functions nil)
+ (coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (jka-compr-compression-info-list nil)
+ (find-buffer-file-type-function
+ (if (fboundp 'find-buffer-file-type)
+ (symbol-function 'find-buffer-file-type)
+ nil)))
+ (unwind-protect
+ (progn
+ (fset 'find-buffer-file-type (lambda (filename) t))
+ (insert-file-contents filename visit beg end replace))
+ (if find-buffer-file-type-function
+ (fset 'find-buffer-file-type find-buffer-file-type-function)
+ (fmakunbound 'find-buffer-file-type)))))
+
+
+;;; @ buffer representation
+;;;
+
+(defsubst-maybe set-buffer-multibyte (flag)
+ "Set the multibyte flag of the current buffer to FLAG.
+If FLAG is t, this makes the buffer a multibyte buffer.
+If FLAG is nil, this makes the buffer a single-byte buffer.
+The buffer contents remain unchanged as a sequence of bytes
+but the contents viewed as characters do change.
+\[Emacs 20.3 emulating function]"
+ flag)
+
+
+;;; @ character
+;;;
+
+;; avoid bug of XEmacs
+(or (integerp (cdr (split-char ?a)))
+ (defun split-char (char)
+ "Return list of charset and one or two position-codes of CHAR."
+ (let ((charset (char-charset char)))
+ (if (eq charset 'ascii)
+ (list charset (char-int char))
+ (let ((i 0)
+ (len (charset-dimension charset))
+ (code (if (integerp char)
+ char
+ (char-int char)))
+ dest)
+ (while (< i len)
+ (setq dest (cons (logand code 127) dest)
+ code (lsh code -7)
+ i (1+ i)))
+ (cons charset dest)))))
+ )
+
+(defmacro char-next-index (char index)
+ "Return index of character succeeding CHAR whose index is INDEX."
+ `(1+ ,index))
+
+
+;;; @ string
+;;;
+
+(defun string-to-int-list (str)
+ (mapcar #'char-int str))
+
+(defalias 'looking-at-as-unibyte 'looking-at)
+
+
+;;; @ end
+;;;
+
+(provide 'poem-xm)
+
+;;; poem-xm.el ends here
--- /dev/null
+;;; poem.el --- Portable Outfit for Emacsen: about MULE API
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, Mule
+
+;; This file is part of APEL (A Portable Emacs 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 GNU Emacs; 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 'poe)
+
+(cond ((featurep 'mule)
+ (cond ((featurep 'xemacs)
+ (require 'poem-xm)
+ )
+ ((>= emacs-major-version 20)
+ (require 'poem-e20)
+ )
+ (t
+ ;; for MULE 1.* and 2.*
+ (require 'poem-om)
+ ))
+ )
+ ((boundp 'NEMACS)
+ ;; for Nemacs and Nepoch
+ (require 'poem-nemacs)
+ )
+ (t
+ (require 'poem-ltn1)
+ ))
+
+
+;;; @ Emacs 20.3 emulation
+;;;
+
+(defmacro-maybe string-as-unibyte (string)
+ "Return a unibyte string with the same individual bytes as STRING.
+If STRING is unibyte, the result is STRING itself.
+\[Emacs 20.3 emulating macro]"
+ string)
+
+(defmacro-maybe string-as-multibyte (string)
+ "Return a multibyte string with the same individual bytes as STRING.
+If STRING is multibyte, the result is STRING itself.
+\[Emacs 20.3 emulating macro]"
+ string)
+
+
+;;; @ XEmacs 20 emulation
+;;;
+
+(or (fboundp 'char-int)
+ (fset 'char-int (symbol-function 'identity)))
+
+(or (fboundp 'int-char)
+ (fset 'int-char (symbol-function 'identity)))
+
+(or (fboundp 'char-or-char-int-p)
+ (fset 'char-or-char-int-p (symbol-function 'integerp)))
+
+
+;;; @ end
+;;;
+
+(provide 'poem)
+
+;;; poem.el ends here
+++ /dev/null
-;;; std11-parse.el --- STD 11 parser for GNU Emacs
-
-;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Keywords: mail, news, RFC 822, STD 11
-;; Version:
-;; $Id: std11-parse.el,v 0.15 1996-11-28 19:38:27 morioka Exp $
-
-;; This file is part of MU (Message Utilities).
-
-;; 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 GNU Emacs; 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 'std11)
-(require 'emu)
-
-
-;;; @ lexical analyze
-;;;
-
-(defconst std11-space-chars " \t\n")
-(defconst std11-spaces-regexp (concat "[" std11-space-chars "]+"))
-(defconst std11-special-chars "][()<>@,;:\\<>.\"")
-(defconst std11-atom-regexp
- (concat "^[^" std11-special-chars std11-space-chars "]+"))
-
-(defun std11-analyze-spaces (string)
- (if (and (string-match std11-spaces-regexp string)
- (= (match-beginning 0) 0))
- (let ((end (match-end 0)))
- (cons (cons 'spaces (substring string 0 end))
- (substring string end)
- ))))
-
-(defun std11-analyze-special (str)
- (if (and (> (length str) 0)
- (find (aref str 0) std11-special-chars)
- )
- (cons (cons 'specials (substring str 0 1))
- (substring str 1)
- )))
-
-(defun std11-analyze-atom (str)
- (if (string-match std11-atom-regexp str)
- (let ((end (match-end 0)))
- (cons (cons 'atom (substring str 0 end))
- (substring str end)
- ))))
-
-(defun std11-check-enclosure (str open close &optional recursive from)
- (let ((len (length str))
- (i (or from 0))
- )
- (if (and (> len i)
- (eq (aref str i) open))
- (let (p chr)
- (setq i (1+ i))
- (catch 'tag
- (while (< i len)
- (setq chr (aref str i))
- (cond ((eq chr ?\\)
- (setq i (1+ i))
- (if (>= i len)
- (throw 'tag nil)
- )
- (setq i (1+ i))
- )
- ((eq chr close)
- (throw 'tag (1+ i))
- )
- ((eq chr open)
- (if (and recursive
- (setq p (std11-check-enclosure
- str open close recursive i))
- )
- (setq i p)
- (throw 'tag nil)
- ))
- (t
- (setq i (1+ i))
- ))
- ))))))
-
-(defun std11-analyze-quoted-string (str)
- (let ((p (std11-check-enclosure str ?\" ?\")))
- (if p
- (cons (cons 'quoted-string (substring str 1 (1- p)))
- (substring str p))
- )))
-
-(defun std11-analyze-domain-literal (str)
- (let ((p (std11-check-enclosure str ?\[ ?\])))
- (if p
- (cons (cons 'domain-literal (substring str 1 (1- p)))
- (substring str p))
- )))
-
-(defun std11-analyze-comment (str)
- (let ((p (std11-check-enclosure str ?\( ?\) t)))
- (if p
- (cons (cons 'comment (substring str 1 (1- p)))
- (substring str p))
- )))
-
-(defun std11-lexical-analyze (str)
- (let (dest ret)
- (while (not (string-equal str ""))
- (setq ret
- (or (std11-analyze-quoted-string str)
- (std11-analyze-domain-literal str)
- (std11-analyze-comment str)
- (std11-analyze-spaces str)
- (std11-analyze-special str)
- (std11-analyze-atom str)
- '((error) . "")
- ))
- (setq dest (cons (car ret) dest))
- (setq str (cdr ret))
- )
- (nreverse dest)
- ))
-
-
-;;; @ parser
-;;;
-
-(defun std11-ignored-token-p (token)
- (let ((type (car token)))
- (or (eq type 'spaces)(eq type 'comment))
- ))
-
-(defun std11-parse-token (lal)
- (let (token itl)
- (while (and lal
- (progn
- (setq token (car lal))
- (std11-ignored-token-p token)
- ))
- (setq lal (cdr lal))
- (setq itl (cons token itl))
- )
- (cons (nreverse (cons token itl))
- (cdr lal))
- ))
-
-(defun std11-parse-ascii-token (lal)
- (let (token itl parsed token-value)
- (while (and lal
- (setq token (car lal))
- (if (and (setq token-value (cdr token))
- (find-non-ascii-charset-string token-value)
- )
- (setq token nil)
- (std11-ignored-token-p token)
- ))
- (setq lal (cdr lal))
- (setq itl (cons token itl))
- )
- (if (and token
- (setq parsed (nreverse (cons token itl)))
- )
- (cons parsed (cdr lal))
- )))
-
-(defun std11-parse-token-or-comment (lal)
- (let (token itl)
- (while (and lal
- (progn
- (setq token (car lal))
- (eq (car token) 'spaces)
- ))
- (setq lal (cdr lal))
- (setq itl (cons token itl))
- )
- (cons (nreverse (cons token itl))
- (cdr lal))
- ))
-
-(defun std11-parse-word (lal)
- (let ((ret (std11-parse-ascii-token lal)))
- (if ret
- (let ((elt (car ret))
- (rest (cdr ret))
- )
- (if (or (assq 'atom elt)
- (assq 'quoted-string elt))
- (cons (cons 'word elt) rest)
- )))))
-
-(defun std11-parse-word-or-comment (lal)
- (let ((ret (std11-parse-token-or-comment lal)))
- (if ret
- (let ((elt (car ret))
- (rest (cdr ret))
- )
- (cond ((or (assq 'atom elt)
- (assq 'quoted-string elt))
- (cons (cons 'word elt) rest)
- )
- ((assq 'comment elt)
- (cons (cons 'comment-word elt) rest)
- ))
- ))))
-
-(defun std11-parse-phrase (lal)
- (let (ret phrase)
- (while (setq ret (std11-parse-word-or-comment lal))
- (setq phrase (append phrase (cdr (car ret))))
- (setq lal (cdr ret))
- )
- (if phrase
- (cons (cons 'phrase phrase) lal)
- )))
-
-(defun std11-parse-local-part (lal)
- (let ((ret (std11-parse-word lal)))
- (if ret
- (let ((local-part (cdr (car ret))) dot)
- (setq lal (cdr ret))
- (while (and (setq ret (std11-parse-ascii-token lal))
- (setq dot (car ret))
- (string-equal (cdr (assq 'specials dot)) ".")
- (setq ret (std11-parse-word (cdr ret)))
- (setq local-part
- (append local-part dot (cdr (car ret)))
- )
- (setq lal (cdr ret))
- ))
- (cons (cons 'local-part local-part) lal)
- ))))
-
-(defun std11-parse-sub-domain (lal)
- (let ((ret (std11-parse-ascii-token lal)))
- (if ret
- (let ((sub-domain (car ret)))
- (if (or (assq 'atom sub-domain)
- (assq 'domain-literal sub-domain)
- )
- (cons (cons 'sub-domain sub-domain)
- (cdr ret)
- )
- )))))
-
-(defun std11-parse-domain (lal)
- (let ((ret (std11-parse-sub-domain lal)))
- (if ret
- (let ((domain (cdr (car ret))) dot)
- (setq lal (cdr ret))
- (while (and (setq ret (std11-parse-ascii-token lal))
- (setq dot (car ret))
- (string-equal (cdr (assq 'specials dot)) ".")
- (setq ret (std11-parse-sub-domain (cdr ret)))
- (setq domain
- (append domain dot (cdr (car ret)))
- )
- (setq lal (cdr ret))
- ))
- (cons (cons 'domain domain) lal)
- ))))
-
-(defun std11-parse-at-domain (lal)
- (let ((ret (std11-parse-ascii-token lal)) at-sign)
- (if (and ret
- (setq at-sign (car ret))
- (string-equal (cdr (assq 'specials at-sign)) "@")
- (setq ret (std11-parse-domain (cdr ret)))
- )
- (cons (cons 'at-domain (append at-sign (cdr (car ret))))
- (cdr ret))
- )))
-
-(defun std11-parse-addr-spec (lal)
- (let ((ret (std11-parse-local-part lal))
- addr)
- (if (and ret
- (prog1
- (setq addr (cdr (car ret)))
- (setq lal (cdr ret))
- (and (setq ret (std11-parse-at-domain lal))
- (setq addr (append addr (cdr (car ret))))
- (setq lal (cdr ret))
- )))
- (cons (cons 'addr-spec addr) lal)
- )))
-
-(defun std11-parse-route (lal)
- (let ((ret (std11-parse-at-domain lal))
- route comma colon)
- (if (and ret
- (progn
- (setq route (cdr (car ret)))
- (setq lal (cdr ret))
- (while (and (setq ret (std11-parse-ascii-token lal))
- (setq comma (car ret))
- (string-equal (cdr (assq 'specials comma)) ",")
- (setq ret (std11-parse-at-domain (cdr ret)))
- )
- (setq route (append route comma (cdr (car ret))))
- (setq lal (cdr ret))
- )
- (and (setq ret (std11-parse-ascii-token lal))
- (setq colon (car ret))
- (string-equal (cdr (assq 'specials colon)) ":")
- (setq route (append route colon))
- )
- ))
- (cons (cons 'route route)
- (cdr ret)
- )
- )))
-
-(defun std11-parse-route-addr (lal)
- (let ((ret (std11-parse-ascii-token lal))
- < route addr-spec >)
- (if (and ret
- (setq < (car ret))
- (string-equal (cdr (assq 'specials <)) "<")
- (setq lal (cdr ret))
- (progn (and (setq ret (std11-parse-route lal))
- (setq route (cdr (car ret)))
- (setq lal (cdr ret))
- )
- (setq ret (std11-parse-addr-spec lal))
- )
- (setq addr-spec (cdr (car ret)))
- (setq lal (cdr ret))
- (setq ret (std11-parse-ascii-token lal))
- (setq > (car ret))
- (string-equal (cdr (assq 'specials >)) ">")
- )
- (cons (cons 'route-addr (append route addr-spec))
- (cdr ret)
- )
- )))
-
-(defun std11-parse-phrase-route-addr (lal)
- (let ((ret (std11-parse-phrase lal)) phrase)
- (if ret
- (progn
- (setq phrase (cdr (car ret)))
- (setq lal (cdr ret))
- ))
- (if (setq ret (std11-parse-route-addr lal))
- (cons (list 'phrase-route-addr
- phrase
- (cdr (car ret)))
- (cdr ret))
- )))
-
-(defun std11-parse-mailbox (lal)
- (let ((ret (or (std11-parse-phrase-route-addr lal)
- (std11-parse-addr-spec lal)))
- mbox comment)
- (if (and ret
- (prog1
- (setq mbox (car ret))
- (setq lal (cdr ret))
- (if (and (setq ret (std11-parse-token-or-comment lal))
- (setq comment (cdr (assq 'comment (car ret))))
- )
- (setq lal (cdr ret))
- )))
- (cons (list 'mailbox mbox comment)
- lal)
- )))
-
-(defun std11-parse-group (lal)
- (let ((ret (std11-parse-phrase lal))
- phrase colon comma mbox semicolon)
- (if (and ret
- (setq phrase (cdr (car ret)))
- (setq lal (cdr ret))
- (setq ret (std11-parse-ascii-token lal))
- (setq colon (car ret))
- (string-equal (cdr (assq 'specials colon)) ":")
- (setq lal (cdr ret))
- (progn
- (and (setq ret (std11-parse-mailbox lal))
- (setq mbox (list (car ret)))
- (setq lal (cdr ret))
- (progn
- (while (and (setq ret (std11-parse-ascii-token lal))
- (setq comma (car ret))
- (string-equal
- (cdr (assq 'specials comma)) ",")
- (setq lal (cdr ret))
- (setq ret (std11-parse-mailbox lal))
- (setq mbox (cons (car ret) mbox))
- (setq lal (cdr ret))
- )
- )))
- (and (setq ret (std11-parse-ascii-token lal))
- (setq semicolon (car ret))
- (string-equal (cdr (assq 'specials semicolon)) ";")
- )))
- (cons (list 'group phrase (nreverse mbox))
- (cdr ret)
- )
- )))
-
-(defun std11-parse-address (lal)
- (or (std11-parse-group lal)
- (std11-parse-mailbox lal)
- ))
-
-(defun std11-parse-addresses (lal)
- (let ((ret (std11-parse-address lal)))
- (if ret
- (let ((dest (list (car ret))))
- (setq lal (cdr ret))
- (while (and (setq ret (std11-parse-ascii-token lal))
- (string-equal (cdr (assq 'specials (car ret))) ",")
- (setq ret (std11-parse-address (cdr ret)))
- )
- (setq dest (cons (car ret) dest))
- (setq lal (cdr ret))
- )
- (nreverse dest)
- ))))
-
-
-;;; @ end
-;;;
-
-(provide 'std11-parse)
-
-;;; std11-parse.el ends here
+++ /dev/null
-;;; std11.el --- STD 11 functions for GNU Emacs
-
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Keywords: mail, news, RFC 822, STD 11
-;; Version: $Id: std11.el,v 0.40 1997-03-03 08:03:06 shuhei-k Exp $
-
-;; This file is part of MU (Message Utilities).
-
-;; 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 GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(autoload 'buffer-substring-no-properties "emu")
-(autoload 'member "emu")
-
-
-;;; @ field
-;;;
-
-(defconst std11-field-name-regexp "[!-9;-~]+")
-(defconst std11-field-head-regexp
- (concat "^" std11-field-name-regexp ":"))
-(defconst std11-next-field-head-regexp
- (concat "\n" std11-field-name-regexp ":"))
-
-(defun std11-field-end ()
- "Move to end of field and return this point. [std11.el]"
- (if (re-search-forward std11-next-field-head-regexp nil t)
- (goto-char (match-beginning 0))
- (if (re-search-forward "^$" nil t)
- (goto-char (1- (match-beginning 0)))
- (end-of-line)
- ))
- (point)
- )
-
-(defun std11-field-body (name &optional boundary)
- "Return body of field NAME.
-If BOUNDARY is not nil, it is used as message header separator.
-\[std11.el]"
- (save-excursion
- (save-restriction
- (std11-narrow-to-header boundary)
- (goto-char (point-min))
- (let ((case-fold-search t))
- (if (re-search-forward (concat "^" name ":[ \t]*") nil t)
- (buffer-substring-no-properties (match-end 0) (std11-field-end))
- )))))
-
-(defun std11-find-field-body (field-names &optional boundary)
- "Return the first found field-body specified by FIELD-NAMES
-of the message header in current buffer. If BOUNDARY is not nil, it is
-used as message header separator. [std11.el]"
- (save-excursion
- (save-restriction
- (std11-narrow-to-header boundary)
- (let ((case-fold-search t)
- field-name)
- (catch 'tag
- (while (setq field-name (car field-names))
- (goto-char (point-min))
- (if (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
- (throw 'tag
- (buffer-substring-no-properties
- (match-end 0) (std11-field-end)))
- )
- (setq field-names (cdr field-names))
- ))))))
-
-(defun std11-field-bodies (field-names &optional default-value boundary)
- "Return list of each field-bodies of FIELD-NAMES of the message header
-in current buffer. If BOUNDARY is not nil, it is used as message
-header separator. [std11.el]"
- (save-excursion
- (save-restriction
- (std11-narrow-to-header boundary)
- (let* ((case-fold-search t)
- (dest (make-list (length field-names) default-value))
- (s-rest field-names)
- (d-rest dest)
- field-name)
- (while (setq field-name (car s-rest))
- (goto-char (point-min))
- (if (re-search-forward (concat "^" field-name ":[ \t]*") nil t)
- (setcar d-rest
- (buffer-substring-no-properties
- (match-end 0) (std11-field-end)))
- )
- (setq s-rest (cdr s-rest)
- d-rest (cdr d-rest))
- )
- dest))))
-
-
-;;; @ unfolding
-;;;
-
-(defun std11-unfold-string (string)
- "Unfold STRING as message header field. [std11.el]"
- (let ((dest ""))
- (while (string-match "\n\\([ \t]\\)" string)
- (setq dest (concat dest
- (substring string 0 (match-beginning 0))
- (match-string 1 string)
- ))
- (setq string (substring string (match-end 0)))
- )
- (concat dest string)
- ))
-
-
-;;; @ header
-;;;
-
-(defun std11-narrow-to-header (&optional boundary)
- "Narrow to the message header.
-If BOUNDARY is not nil, it is used as message header separator.
-\[std11.el]"
- (narrow-to-region
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^\\(" (regexp-quote (or boundary "")) "\\)?$")
- nil t)
- (match-beginning 0)
- (point-max)
- )))
-
-(defun std11-header-string (regexp &optional boundary)
- "Return string of message header fields matched by REGEXP.
-If BOUNDARY is not nil, it is used as message header separator.
-\[std11.el]"
- (let ((case-fold-search t))
- (save-excursion
- (save-restriction
- (std11-narrow-to-header boundary)
- (goto-char (point-min))
- (let (field header)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq field
- (buffer-substring (match-beginning 0) (std11-field-end)))
- (if (string-match regexp field)
- (setq header (concat header field "\n"))
- ))
- header)
- ))))
-
-(defun std11-header-string-except (regexp &optional boundary)
- "Return string of message header fields not matched by REGEXP.
-If BOUNDARY is not nil, it is used as message header separator.
-\[std11.el]"
- (let ((case-fold-search t))
- (save-excursion
- (save-restriction
- (std11-narrow-to-header boundary)
- (goto-char (point-min))
- (let (field header)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq field
- (buffer-substring (match-beginning 0) (std11-field-end)))
- (if (not (string-match regexp field))
- (setq header (concat header field "\n"))
- ))
- header)
- ))))
-
-(defun std11-collect-field-names (&optional boundary)
- "Return list of all field-names of the message header in current buffer.
-If BOUNDARY is not nil, it is used as message header separator.
-\[std11.el]"
- (save-excursion
- (save-restriction
- (std11-narrow-to-header boundary)
- (goto-char (point-min))
- (let (dest name)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq name (buffer-substring-no-properties
- (match-beginning 0)(1- (match-end 0))))
- (or (member name dest)
- (setq dest (cons name dest))
- )
- )
- dest))))
-
-
-;;; @ quoted-string
-;;;
-
-(defun std11-wrap-as-quoted-pairs (string specials)
- (let (dest
- (i 0)
- (b 0)
- (len (length string))
- )
- (while (< i len)
- (let ((chr (aref string i)))
- (if (memq chr specials)
- (setq dest (concat dest (substring string b i) "\\")
- b i)
- ))
- (setq i (1+ i))
- )
- (concat dest (substring string b))
- ))
-
-(defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
-
-(defun std11-wrap-as-quoted-string (string)
- "Wrap STRING as RFC 822 quoted-string. [std11.el]"
- (concat "\""
- (std11-wrap-as-quoted-pairs string std11-non-qtext-char-list)
- "\""))
-
-(defun std11-strip-quoted-pair (string)
- "Strip quoted-pairs in STRING. [std11.el]"
- (let (dest
- (b 0)
- (i 0)
- (len (length string))
- )
- (while (< i len)
- (let ((chr (aref string i)))
- (if (eq chr ?\\)
- (setq dest (concat dest (substring string b i))
- b (1+ i)
- i (+ i 2))
- (setq i (1+ i))
- )))
- (concat dest (substring string b))
- ))
-
-(defun std11-strip-quoted-string (string)
- "Strip quoted-string STRING. [std11.el]"
- (let ((len (length string)))
- (or (and (>= len 2)
- (let ((max (1- len)))
- (and (eq (aref string 0) ?\")
- (eq (aref string max) ?\")
- (std11-strip-quoted-pair (substring string 1 max))
- )))
- string)))
-
-
-;;; @ composer
-;;;
-
-(defun std11-addr-to-string (seq)
- "Return string from lexical analyzed list SEQ
-represents addr-spec of RFC 822. [std11.el]"
- (mapconcat (function
- (lambda (token)
- (let ((name (car token)))
- (cond
- ((eq name 'spaces) "")
- ((eq name 'comment) "")
- ((eq name 'quoted-string)
- (concat "\"" (cdr token) "\""))
- (t (cdr token)))
- )))
- seq "")
- )
-
-(defun std11-address-string (address)
- "Return string of address part from parsed ADDRESS of RFC 822.
-\[std11.el]"
- (cond ((eq (car address) 'group)
- (mapconcat (function std11-address-string)
- (car (cdr address))
- ", ")
- )
- ((eq (car address) 'mailbox)
- (let ((addr (nth 1 address)))
- (std11-addr-to-string
- (if (eq (car addr) 'phrase-route-addr)
- (nth 2 addr)
- (cdr addr)
- )
- )))))
-
-(defun std11-full-name-string (address)
- "Return string of full-name part from parsed ADDRESS of RFC 822.
-\[std11.el]"
- (cond ((eq (car address) 'group)
- (mapconcat (function
- (lambda (token)
- (cdr token)
- ))
- (nth 1 address) "")
- )
- ((eq (car address) 'mailbox)
- (let ((addr (nth 1 address))
- (comment (nth 2 address))
- phrase)
- (if (eq (car addr) 'phrase-route-addr)
- (setq phrase
- (mapconcat
- (function
- (lambda (token)
- (let ((type (car token)))
- (cond ((eq type 'quoted-string)
- (std11-strip-quoted-pair (cdr token))
- )
- ((eq type 'comment)
- (concat
- "("
- (std11-strip-quoted-pair (cdr token))
- ")")
- )
- (t
- (cdr token)
- )))))
- (nth 1 addr) ""))
- )
- (cond ((> (length phrase) 0) phrase)
- (comment (std11-strip-quoted-pair comment))
- )
- ))))
-
-
-;;; @ parser
-;;;
-
-(defun std11-parse-address-string (string)
- "Parse STRING as mail address. [std11.el]"
- (std11-parse-address (std11-lexical-analyze string))
- )
-
-(defun std11-parse-addresses-string (string)
- "Parse STRING as mail address list. [std11.el]"
- (std11-parse-addresses (std11-lexical-analyze string))
- )
-
-(defun std11-extract-address-components (string)
- "Extract full name and canonical address from STRING.
-Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
-If no name can be extracted, FULL-NAME will be nil. [std11.el]"
- (let* ((structure (car (std11-parse-address-string
- (std11-unfold-string string))))
- (phrase (std11-full-name-string structure))
- (address (std11-address-string structure))
- )
- (list phrase address)
- ))
-
-(provide 'std11)
-
-(mapcar (function
- (lambda (func)
- (autoload func "std11-parse")
- ))
- '(std11-lexical-analyze
- std11-parse-address std11-parse-addresses
- std11-parse-address-string))
-
-
-;;; @ end
-;;;
-
-;;; std11.el ends here
projects / elisp / apel.git / commitdiff