Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Synch up to APEL 10.0.

  • Loading branch information...
commit 5a345376ab50b9fcb406dc3c9b8f013b46bba294 1 parent 56739d9
shuhei authored
Showing with 5,950 additions and 727 deletions.
  1. +107 −2 ChangeLog
  2. +23 −4 EMU-ELS
  3. +1 −1  Makefile
  4. +11 −6 alist.el
  5. +57 −0 apel-ver.el
  6. +4 −2 atype.el
  7. +114 −0 broken.el
  8. +331 −0 calist.el
  9. +9 −312 emu-mule.el
  10. +136 −244 emu.el
  11. +2 −1  env.el
  12. +2 −1  file-detect.el
  13. +33 −42 filename.el
  14. +2 −1  install.el
  15. +2 −1  inv-18.el
  16. +2 −1  inv-19.el
  17. +2 −1  inv-xemacs.el
  18. +2 −1  invisible.el
  19. +4 −1 localhook.el
  20. +119 −0 mcharset.el
  21. +161 −0 mcs-20.el
  22. +185 −0 mcs-e20.el
  23. +110 −0 mcs-ltn1.el
  24. +128 −0 mcs-nemacs.el
  25. +243 −0 mcs-om.el
  26. +165 −0 mcs-xm.el
  27. +101 −0 mcs-xmu.el
  28. +42 −50 mule-caesar.el
  29. +51 −18 path-util.el
  30. +2 −1  pccl-20.el
  31. +2 −1  pccl-om.el
  32. +77 −0 pccl.el
  33. +239 −0 pces-20.el
  34. +48 −0 pces-e20.el
  35. +150 −0 pces-e20_2.el
  36. +276 −0 pces-nemacs.el
  37. +313 −0 pces-om.el
  38. +172 −0 pces-raw.el
  39. +48 −0 pces-xfc.el
  40. +78 −0 pces-xm.el
  41. +59 −0 pces.el
  42. +2 −1  pcustom.el
  43. +66 −5 poe-18.el
  44. +2 −1  poe-xemacs.el
  45. +9 −25 poe.el
  46. +65 −0 poem-e20.el
  47. +93 −0 poem-e20_2.el
  48. +66 −0 poem-e20_3.el
  49. +152 −0 poem-ltn1.el
  50. +219 −0 poem-nemacs.el
  51. +164 −0 poem-om.el
  52. +87 −0 poem-xm.el
  53. +100 −0 poem.el
  54. +424 −0 product.el
  55. +2 −1  pym.el
  56. +2 −1  richtext.el
  57. +89 −0 static.el
  58. +281 −0 time-stamp.el
  59. +507 −0 timezone.el
  60. +3 −1 tinycustom.el
  61. +4 −1 tinyrich.el
View
109 ChangeLog
@@ -1,3 +1,36 @@
+1999-12-24 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * APEL: Version 10.0 released.
+
+1999-12-24 Keiichi Suzuki <keiichi@nanap.org>
+
+ * apel-ver.el: Fix file header.
+
+1999-12-23 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * timezone.el (timezone-abs): Eliminated.
+ (timezone-zone-to-minute): Use `abs' instead of `timezone-abs'.
+
+ * poe-18.el (current-time-zone): Use `abs'.
+
+1999-12-23 Keiichi Suzuki <keiichi@nanap.org>
+
+ * product.el: Fix file header. `checkdoc' fix.
+
+ * apel-ver.el: Fix file header.
+
+1999-12-22 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * APEL-ELS, EMU-ELS: product.el, apel-ver.el, time-stamp.el,
+ and timezone.el are version-dependent.
+
+ * product.el (emacs-major-version, emacs-minor-version): Moved
+ from poe.el.
+
+ * poe.el (emacs-major-version, emacs-minor-version): Removed.
+
+ * pym.el: Add product information.
+
1999-12-22 Yuuichi Teranishi <teranisi@gohome.org>
* poe.el (string-to-int): Commented out an alias for
@@ -143,6 +176,78 @@
Modified some comments.
+1999-12-22 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * timezone.el: Modified comments.
+ (toplevel): Require 'product.
+
+1999-12-21 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * apel-ver.el: Footer fix.
+
+1999-12-21 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * poe-18.el (current-time-zone): New function.
+ (current-time-world-timezones, current-time-local-timezone):
+ New variables.
+ (current-time-string): Use `current-time-zone' to get local timezone.
+ (current-time): Ditto.
+
+ * timezone.el: New file.
+
+ * APEL-ELS (apel-modules): Add `timezone' if existing timezone.el
+ has y2k problem.
+
+ * product.el (product-string-1): Use `int-to-string' instead of
+ `number-to-string'.
+
+1999-12-20 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * apel-ver.el, product.el: Header fix.
+
+1999-12-20 Keiichi Suzuki <keiichi@nanap.org>
+
+ * alist.el, atype.el, broken.el, calist.el, emu-mule.el, emu.el,
+ env.el, file-detect.el, filename.el, install.el, inv-18.el,
+ inv-19.el, inv-xemacs.el, invisible.el, localhook.el,
+ mcharset.el, mcs-20.el, mcs-e20.el, mcs-ltn1.el, mcs-nemacs.el,
+ mcs-om.el, mcs-xm.el, mcs-xmu.el, mule-caesar.el, path-util.el,
+ pccl-20.el, pccl-om.el, pccl.el, pces-20.el, pces-e20.el,
+ pces-e20_2.el, pces-nemacs.el, pces-om.el, pces-raw.el,
+ pces-xfc.el, pces-xm.el, pces.el, pcustom.el, poe-18.el,
+ poe-xemacs.el, poe.el, poem-e20.el, poem-e20_2.el,
+ poem-e20_3.el, poem-ltn1.el, poem-nemacs.el, poem-om.el,
+ poem-xm.el, poem.el, richtext.el, static.el, time-stamp.el,
+ tinycustom.el, tinyrich.el (TopLevel): Add product information.
+
+ * Sync up with apel-product.
+
+* 1999-11-12 Keiichi Suzuki <keiichi@nanap.org>
+
+ * product.el (product-define): Add new slot `version-string'.
+ (product-provide): Likewise.
+ (product-version-string): New function.
+ (product-set-version-string): New function.
+ (product-string-1): Use `version-string'.
+ (product-for-each): New function.
+ (product-string): Separate `product-string' and
+ `product-string-verbose'.
+ (product-string-verbose): Likewise.
+ (product-parse-version-string): New function.
+
+* 1999-11-12 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * product.el: Some `checkdoc' fixes.
+ (product-version>=): Eliminate local variable.
+
+* 1999-11-12 Keiichi Suzuki <keiichi@nanap.org>
+
+ * product.el: New file.
+
+ * apel-ver.el: New file.
+
+ * APEL-ELS (apel-modules): Add `apel-ver' and `product'.
+
1999-11-25 Yuuichi Teranishi <teranisi@gohome.org>
* poe-18.el (current-time-string, current-time): New functions.
@@ -163,7 +268,7 @@
1999-11-08 Yuuichi Teranishi <teranisi@gohome.org>
- * poe-18.el (put-text-property, next-property-change,
+ * poe-18.el (put-text-property, next-property-change,
text-properties-at): Define as null function.
1999-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -2341,7 +2446,7 @@
* APEL: Version 8.4 was released.
- * EMU-ELS: Don't use HIRAGANA LETTER A ($B$"(B) to detect character
+ * EMU-ELS: Don't use HIRAGANA LETTER A ($(B$"(B) to detect character
indexing (Emacs 20.3 or later).
1998-04-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
View
27 EMU-ELS
@@ -16,8 +16,9 @@
(nconc
;; modules are sorted by compilation order.
'(static broken)
- ;; coming soon.
- ;; '(product)
+
+ ;; product information.
+ '(product apel-ver)
;; poe modules; poe modules depend on static.
'(pym)
@@ -148,10 +149,28 @@
(or (< emacs-major-version 19)
(and (= emacs-major-version 19)
(< emacs-minor-version 16))))
- '(time-stamp))
+ '(time-stamp)
+ ;; no problem.
+ '())
;; timezone.el; Some versions have Y2K problem.
- ;; coming soon.
+ (condition-case nil
+ (let ((load-path (delete (expand-file-name ".")
+ (copy-sequence load-path))))
+ ;; v18 does not have timezone.el.
+ (require 'timezone)
+ ;; Is timezone.el APEL version?
+ (if (product-find 'timezone)
+ (error "timezone.el is APEL version. Install newer version."))
+ ;; Y2K test.
+ (or (string= (aref (timezone-parse-date "Sat, 1 Jan 00 00:00:00 GMT")
+ 0)
+ "2000")
+ (error "timezone.el has Y2K problem. Install fixed version."))
+ ;; no problem.
+ '())
+ (error
+ '(timezone)))
;; invisible modules; provided for backward compatibility with old "tm".
(cond
View
2  Makefile
@@ -2,7 +2,7 @@
# Makefile for APEL.
#
-VERSION = 9.23
+VERSION = 10.0
TAR = tar
RM = /bin/rm -f
View
17 alist.el
@@ -1,13 +1,11 @@
-;;; alist.el --- utility functions about assoc-list
+;;; alist.el --- utility functions about association-list
-;; Copyright (C) 1993,1994,1995,1996 Free Software Foundation, Inc.
+;; Copyright (C) 1993,1994,1995,1996,1998 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version:
-;; $Id$
;; Keywords: alist
-;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
+;; 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
@@ -26,6 +24,7 @@
;;; Code:
+;;;###autoload
(defun 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.
@@ -40,6 +39,7 @@ return new alist whose car is the new pair and cdr is ALIST.
(cons (cons item value) alist)
)))
+;;;###autoload
(defun del-alist (item alist)
"If there is a pair whose key is ITEM, delete it from ALIST.
\[tomo's ELIS emulating function]"
@@ -59,6 +59,7 @@ return new alist whose car is the new pair and cdr is ALIST.
)
alist))))
+;;;###autoload
(defun set-alist (symbol item value)
"Modify a alist indicated by SYMBOL to set VALUE to ITEM."
(or (boundp symbol)
@@ -67,12 +68,14 @@ return new alist whose car is the new pair and cdr is ALIST.
(set symbol (put-alist item value (symbol-value symbol)))
)
+;;;###autoload
(defun remove-alist (symbol item)
"Remove ITEM from the alist indicated by SYMBOL."
(and (boundp symbol)
(set symbol (del-alist item (symbol-value symbol)))
))
+;;;###autoload
(defun modify-alist (modifier default)
"Modify alist DEFAULT into alist MODIFIER."
(mapcar (function
@@ -82,6 +85,7 @@ return new alist whose car is the new pair and cdr is ALIST.
modifier)
default)
+;;;###autoload
(defun set-modified-alist (sym modifier)
"Modify a value of a symbol SYM into alist MODIFIER.
The symbol SYM should be alist. If it is not bound,
@@ -96,6 +100,7 @@ its value regard as nil."
;;; @ end
;;;
-(provide 'alist)
+(require 'product)
+(product-provide (provide 'alist) (require 'apel-ver))
;;; alist.el ends here
View
57 apel-ver.el
@@ -0,0 +1,57 @@
+;;; apel-ver.el --- Declare APEL version.
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keiichi Suzuki <keiichi@nanap.org>
+;; Keywords: 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 this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Put the following lines to each file of APEL package.
+;;
+;; (require 'product)
+;; (product-provide (provide FEATURE) (require 'apel-ver))
+
+;;; Code:
+
+(require 'product) ; beware of circular dependency.
+(provide 'apel-ver) ; these two files depend on each other.
+
+(product-provide 'apel-ver
+ ;; (product-define "APEL" nil '(9 23)) ; comment.
+ (product-define "APEL" nil '(10 0)) ; Released 24 December 1999
+ ;; (product-define "APEL" nil '(10 1)) ;
+ ;; (product-define "APEL" nil '(10 2)) ;
+ )
+
+(defun apel-version ()
+ "Print APEL version."
+ (interactive)
+ (let ((product-info (product-string-1 'apel-ver t)))
+ (if (interactive-p)
+ (message "%s" product-info)
+ product-info)))
+
+
+;;; @ End.
+;;;
+
+;;; apel-ver.el ends here
View
6 atype.el
@@ -25,7 +25,8 @@
;;; Code:
-(require 'emu)
+(require 'emu) ; for backward compatibility.
+(require 'poe) ; delete.
(require 'alist)
@@ -184,6 +185,7 @@
;;; @ end
;;;
-(provide 'atype)
+(require 'product)
+(product-provide (provide 'atype) (require 'apel-ver))
;;; atype.el ends here
View
114 broken.el
@@ -0,0 +1,114 @@
+;;; broken.el --- Emacs broken facility infomation registry.
+
+;; Copyright (C) 1998, 1999 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:
+
+(require 'static)
+(require 'poe)
+
+(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."
+ (` (static-if (, assertion)
+ (eval-and-compile
+ (broken-facility-internal '(, facility) (, docstring) t))
+ (eval-when-compile
+ (when (and '(, assertion) (not '(, no-notice))
+ notice-non-obvious-broken-facility)
+ (message "BROKEN FACILITY DETECTED: %s" (, docstring)))
+ nil)
+ (eval-and-compile
+ (broken-facility-internal '(, facility) (, docstring) nil)))))
+
+(put 'if-broken 'lisp-indent-function 2)
+(defmacro if-broken (facility then &rest else)
+ "If FACILITY is broken, expand to THEN, otherwise (progn . ELSE)."
+ (` (static-if (broken-p '(, facility))
+ (, then)
+ (,@ else))))
+
+
+(put 'when-broken 'lisp-indent-function 1)
+(defmacro when-broken (facility &rest body)
+ "If FACILITY is broken, expand to (progn . BODY), otherwise nil."
+ (` (static-when (broken-p '(, facility))
+ (,@ 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."
+ (` (static-unless (broken-p '(, facility))
+ (,@ body))))
+
+(defmacro check-broken-facility (facility)
+ "Check FACILITY is broken or not. If the status is different on
+compile(macro expansion) time and run time, warn it."
+ (` (if-broken (, facility)
+ (unless (broken-p '(, facility))
+ (message "COMPILE TIME ONLY BROKEN FACILITY DETECTED: %s"
+ (or
+ '(, (broken-facility-description facility))
+ (broken-facility-description '(, facility)))))
+ (when (broken-p '(, facility))
+ (message "RUN TIME ONLY BROKEN FACILITY DETECTED: %s"
+ (or
+ (broken-facility-description '(, facility))
+ '(, (broken-facility-description facility))))))))
+
+
+;;; @ end
+;;;
+
+(require 'product)
+(product-provide (provide 'broken) (require 'apel-ver))
+
+;;; broken.el ends here
View
331 calist.el
@@ -0,0 +1,331 @@
+;;; calist.el --- Condition functions
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; 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))
+
+(require 'alist)
+
+(defvar calist-package-alist nil)
+(defvar calist-field-match-method-obarray nil)
+
+(defun find-calist-package (name)
+ "Return a calist-package by NAME."
+ (cdr (assq name calist-package-alist)))
+
+(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 use-calist-package (name)
+ "Make the symbols of package NAME accessible in the current package."
+ (mapatoms (lambda (sym)
+ (if (intern-soft (symbol-name sym)
+ calist-field-match-method-obarray)
+ (signal 'conflict-of-calist-symbol
+ (list (format "Conflict of symbol %s")))
+ (if (fboundp sym)
+ (define-calist-field-match-method
+ sym (symbol-function sym))
+ )))
+ (find-calist-package name)))
+
+(defun make-calist-package (name &optional use)
+ "Create a new calist-package."
+ (let ((calist-field-match-method-obarray (make-vector 7 0)))
+ (set-alist 'calist-package-alist name
+ calist-field-match-method-obarray)
+ (use-calist-package (or use 'standard))
+ calist-field-match-method-obarray))
+
+(defun in-calist-package (name)
+ "Set the current calist-package to a new or existing calist-package."
+ (setq calist-field-match-method-obarray
+ (or (find-calist-package name)
+ (make-calist-package name))))
+
+(in-calist-package 'standard)
+
+(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))))
+
+(define-calist-field-match-method t (function calist-default-field-match-method))
+
+(defsubst calist-field-match-method (field-type)
+ (symbol-function
+ (or (intern-soft (if (symbolp field-type)
+ (symbol-name field-type)
+ field-type)
+ calist-field-match-method-obarray)
+ (intern-soft "t" calist-field-match-method-obarray))))
+
+(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
+;;;
+
+(require 'product)
+(product-provide (provide 'calist) (require 'apel-ver))
+
+;;; calist.el ends here
View
321 emu-mule.el
@@ -1,9 +1,9 @@
;;; 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$
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: emulation, compatibility, Mule
;; This file is part of emu.
@@ -25,307 +25,7 @@
;;; 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
@@ -333,15 +33,12 @@ Optional non-nil arg START-COLUMN specifies the starting column.
(defun regulate-latin-char (chr)
(cond ((and (<= ?$B#A(B chr)(<= chr ?$B#Z(B))
- (+ (- chr ?$B#A(B) ?A)
- )
+ (+ (- chr ?$B#A(B) ?A))
((and (<= ?$B#a(B chr)(<= chr ?$B#z(B))
- (+ (- chr ?$B#a(B) ?a)
- )
+ (+ (- chr ?$B#a(B) ?a))
((eq chr ?$B!%(B) ?.)
((eq chr ?$B!$(B) ?,)
- (t chr)
- ))
+ (t chr)))
(defun regulate-latin-string (str)
(let ((len (length str))
@@ -351,14 +48,14 @@ Optional non-nil arg START-COLUMN specifies the starting column.
(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))
;;; @ end
;;;
-(provide 'emu-mule)
+(require 'product)
+(product-provide (provide 'emu-mule) (require 'apel-ver))
;;; emu-mule.el ends here
View
380 emu.el
@@ -1,9 +1,8 @@
;;; 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$
;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
;; This file is part of emu.
@@ -25,64 +24,10 @@
;;; 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)))
@@ -101,211 +46,157 @@
(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)
+(require 'invisible)
+
+(defsubst char-list-to-string (char-list)
+ "Convert list of character CHAR-LIST to string."
+ (apply (function string) char-list))
+
+(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."
+ (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."
+ (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))
- )
+ 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)))
;;; @ for text/richtext and text/enriched
@@ -336,6 +227,7 @@ This function does not move point. [XEmacs emulating function]"
;;; @ end
;;;
-(provide 'emu)
+(require 'product)
+(product-provide (provide 'emu) (require 'apel-ver))
;;; emu.el ends here
View
3  env.el
@@ -109,6 +109,7 @@ This function works by modifying `process-environment'."
(cons (concat variable "=" value)
process-environment)))))))
-(provide 'env)
+(require 'product)
+(product-provide (provide 'env) (require 'apel-ver))
;;; env.el ends here
View
3  file-detect.el
@@ -33,6 +33,7 @@
(require 'path-util)
-(provide 'file-detect)
+(require 'product)
+(product-provide (provide 'file-detect) (require 'apel-ver))
;;; file-detect.el ends here
View
75 filename.el
@@ -25,8 +25,10 @@
;;; Code:
-(require 'emu)
-(require 'cl)
+(require 'emu) ; for backward compatibility.
+(require 'poe) ; functionp.
+(require 'poem) ; char-int, and char-length.
+(require 'path-util)
(defsubst poly-funcall (functions argument)
"Apply initial ARGUMENT to sequence of FUNCTIONS.
@@ -39,8 +41,7 @@ For example, (poly-funcall '(car number-to-string) '(100)) returns
\"100\"."
(while functions
(setq argument (funcall (car functions) argument)
- functions (cdr functions))
- )
+ functions (cdr functions)))
argument)
@@ -53,8 +54,7 @@ For example, (poly-funcall '(car number-to-string) '(100)) returns
'(((?\ ?\t) . "_")
((?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?/
?: ?\; ?< ?> ?? ?\[ ?\\ ?\] ?` ?{ ?| ?}) . "_")
- (filename-control-p . "")
- )
+ (filename-control-p . ""))
"Alist list of characters vs. string as replacement.
List of characters represents characters not allowed as file-name.")
@@ -65,7 +65,6 @@ List of characters represents characters not allowed as file-name.")
filename-maybe-truncate-by-size
filename-eliminate-bottom-low-lines
)))
- (require 'path-util)
(if (exec-installed-p "kakasi")
(cons 'filename-japanese-to-roman-string filters)
filters))
@@ -80,40 +79,35 @@ List of characters represents characters not allowed as file-name.")
(set-buffer (get-buffer-create " *temp kakasi*"))
(erase-buffer)
(insert str)
- (call-process-region (point-min)(point-max) "kakasi" t t t
- "-Ha" "-Ka" "-Ja" "-Ea" "-ka")
- (buffer-string)
- ))
+ (call-process-region
+ (point-min)(point-max)
+ "kakasi" t t t "-Ha" "-Ka" "-Ja" "-Ea" "-ka")
+ (buffer-string)))
(defun filename-control-p (character)
(let ((code (char-int character)))
- (or (< code 32)(= code 127))
- ))
+ (or (< code 32)(= code 127))))
(defun filename-special-filter (string)
- (let (dest
- (i 0)
- (len (length string))
- (b 0)
- )
+ (let ((len (length string))
+ (b 0)(i 0)
+ (dest ""))
(while (< i len)
- (let* ((chr (sref string i))
- (ret (assoc-if (function
- (lambda (key)
- (if (functionp key)
- (funcall key chr)
- (memq chr key)
- )))
- filename-replacement-alist))
- )
+ (let ((chr (sref string i))
+ (lst filename-replacement-alist)
+ ret)
+ (while (and lst (not ret))
+ (if (if (functionp (car (car lst)))
+ (setq ret (funcall (car (car lst)) chr))
+ (setq ret (memq chr (car (car lst)))))
+ t ; quit this loop.
+ (setq lst (cdr lst))))
(if ret
- (setq dest (concat dest (substring string b i)(cdr ret))
+ (setq dest (concat dest (substring string b i)(cdr (car lst)))
i (+ i (char-length chr))
b i)
- (setq i (+ i (char-length chr)))
- )))
- (concat dest (substring string b))
- ))
+ (setq i (+ i (char-length chr))))))
+ (concat dest (substring string b))))
(defun filename-eliminate-top-low-lines (string)
(if (string-match "^_+" string)
@@ -121,18 +115,15 @@ List of characters represents characters not allowed as file-name.")
string))
(defun filename-canonicalize-low-lines (string)
- (let (dest)
+ (let ((dest ""))
(while (string-match "__+" string)
(setq dest (concat dest (substring string 0 (1+ (match-beginning 0)))))
- (setq string (substring string (match-end 0)))
- )
- (concat dest string)
- ))
+ (setq string (substring string (match-end 0))))
+ (concat dest string)))
(defun filename-maybe-truncate-by-size (string)
(if (and (> (length string) filename-limit-length)
- (string-match "_" string filename-limit-length)
- )
+ (string-match "_" string filename-limit-length))
(substring string 0 (match-beginning 0))
string))
@@ -150,13 +141,13 @@ List of characters represents characters not allowed as file-name.")
It refers variable `filename-filters' and default filters refers
`filename-limit-length', `filename-replacement-alist'."
(and string
- (poly-funcall filename-filters string)
- ))
+ (poly-funcall filename-filters string)))
;;; @ end
;;;
-(provide 'filename)
+(require 'product)
+(product-provide (provide 'filename) (require 'apel-ver))
;;; filename.el ends here
View
3  install.el
@@ -194,6 +194,7 @@
;;; @ end
;;;
-(provide 'install)
+(require 'product)
+(product-provide (provide 'install) (require 'apel-ver))
;;; install.el ends here
View
3  inv-18.el
@@ -73,6 +73,7 @@
;;; @ end
;;;
-(provide 'inv-18)
+(require 'product)
+(product-provide (provide 'inv-18) (require 'apel-ver))
;;; inv-18.el ends here
View
3  inv-19.el
@@ -55,6 +55,7 @@
;;; @ end
;;;
-(provide 'inv-19)
+(require 'product)
+(product-provide (provide 'inv-19) (require 'apel-ver))
;;; inv-19.el ends here
View
3  inv-xemacs.el
@@ -62,6 +62,7 @@
;;; @ end
;;;
-(provide 'inv-xemacs)
+(require 'product)
+(product-provide (provide 'inv-xemacs) (require 'apel-ver))
;;; inv-xemacs.el ends here
View
3  invisible.el
@@ -36,6 +36,7 @@
;;; @ end
;;;
-(provide 'invisible)
+(require 'product)
+(product-provide (provide 'invisible) (require 'apel-ver))
;;; invisible.el ends here
View
5 localhook.el
@@ -58,7 +58,10 @@
;;; Code:
-(provide 'localhook) ; beware of circular dependency.
+;; beware of circular dependency.
+(require 'product)
+(product-provide (provide 'localhook) (require 'apel-ver))
+
(require 'poe) ; this file is loaded from poe.el.
;; These two functions are not complete, but work enough for our purpose.
View
119 mcharset.el
@@ -0,0 +1,119 @@
+;;; mcharset.el --- MIME charset API
+
+;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; 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)
+(require 'pcustom)
+
+(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)
+ ))
+
+(defcustom default-mime-charset-for-write
+ (if (and (fboundp 'find-coding-system)
+ (find-coding-system 'utf-8))
+ 'utf-8
+ default-mime-charset)
+ "Default value of MIME-charset for encoding.
+It may be used when suitable MIME-charset is not found.
+It must be symbol."
+ :group 'i18n
+ :type 'mime-charset)
+
+(defcustom default-mime-charset-detect-method-for-write
+ nil
+ "Function called when suitable MIME-charset is not found to encode.
+It must be nil or function.
+If it is nil, variable `default-mime-charset-for-write' is used.
+If it is a function, interface must be (TYPE CHARSETS &rest ARGS).
+CHARSETS is list of charset.
+If TYPE is 'region, ARGS has START and END."
+ :group 'i18n
+ :type '(choice function (const nil)))
+
+(defun charsets-to-mime-charset (charsets)
+ "Return MIME charset from list of charset CHARSETS.
+Return nil if suitable mime-charset is not found."
+ (if charsets
+ (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)))
+ ))))
+
+(defun find-mime-charset-by-charsets (charsets &optional mode &rest args)
+ "Like `charsets-to-mime-charset', but it does not return nil.
+
+When suitable mime-charset is not found and variable
+`default-mime-charset-detect-method-for-write' is not nil,
+`find-mime-charset-by-charsets' calls the variable as function and
+return the return value of the function.
+Interface of the function is (MODE CHARSETS &rest ARGS).
+
+When suitable mime-charset is not found and variable
+`default-mime-charset-detect-method-for-write' is nil,
+variable `default-mime-charset-for-write' is returned."
+ (or (charsets-to-mime-charset charsets)
+ (if default-mime-charset-detect-method-for-write
+ (apply default-mime-charset-detect-method-for-write
+ mode charsets args)
+ default-mime-charset-for-write)))
+
+
+;;; @ end
+;;;
+
+(require 'product)
+(product-provide (provide 'mcharset) (require 'apel-ver))
+
+;;; mcharset.el ends here
View
161 mcs-20.el
@@ -0,0 +1,161 @@
+;;; mcs-20.el --- MIME charset implementation for Emacs 20 and XEmacs/mule
+
+;; Copyright (C) 1997,1998,1999 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 'pcustom)
+(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)
+ (tis-620 . tis620)
+ (windows-874 . tis-620)
+ (cp874 . tis-620)
+ (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)))
+
+(defcustom mime-charset-to-coding-system-default-method
+ nil
+ "Function called when suitable coding-system is not found from MIME-charset.
+It must be nil or function.
+If it is a function, interface must be (CHARSET LBT CODING-SYSTEM)."
+ :group 'i18n
+ :type '(choice function (const nil)))
+
+(defun 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 ((cs (assq charset mime-charset-coding-system-alist)))
+ (setq cs
+ (if cs
+ (cdr cs)
+ charset))
+ (if lbt
+ (setq cs (intern (format "%s-%s" cs
+ (cond ((eq lbt 'CRLF) 'dos)
+ ((eq lbt 'LF) 'unix)
+ ((eq lbt 'CR) 'mac)
+ (t lbt)))))
+ )
+ (if (find-coding-system cs)
+ cs
+ (if mime-charset-to-coding-system-default-method
+ (funcall mime-charset-to-coding-system-default-method
+ charset lbt cs)
+ ))))
+
+(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)
+
+(defun detect-mime-charset-region (start end)
+ "Return MIME charset for region between START and END."
+ (find-mime-charset-by-charsets (find-charset-region start end)
+ '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
+;;;
+
+(require 'product)
+(product-provide (provide 'mcs-20) (require 'apel-ver))
+
+;;; mcs-20.el ends here
View
185 mcs-e20.el
@@ -0,0 +1,185 @@
+;;; mcs-e20.el --- MIME charset implementation for Emacs 20.1 and 20.2
+
+;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; 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:
+
+(eval-when-compile
+ (require 'static)
+ (require 'poem)
+ )
+
+(defsubst encode-mime-charset-region (start end charset &optional lbt)
+ "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 lbt)))
+ (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 &optional lbt)
+ "Encode the STRING as MIME CHARSET."
+ (let (cs)
+ (if (and enable-multibyte-characters
+ (setq cs (mime-charset-to-coding-system charset lbt)))
+ (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 thai-tis620 composition) . tis-620)
+ ((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-maybe coding-system-get (coding-system prop)
+ "Extract a value from CODING-SYSTEM's property list for property PROP."
+ (plist-get (coding-system-plist coding-system) prop)
+ )
+
+(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-maybe-cond mime-charset-list ()
+ "Return a list of all existing MIME-charset."
+ ((boundp 'coding-system-list)
+ (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))
+ (t
+ (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)
+ (when (setq cs (or (coding-system-get cs 'mime-charset)
+ (and
+ (setq cs (aref
+ (coding-system-get cs 'coding-spec)
+ 2))
+ (string-match "(MIME:[ \t]*\\([^,)]+\\)" cs)
+ (match-string 1 cs))))
+ (setq cs (intern (downcase cs)))
+ (or (rassq cs mime-charset-coding-system-alist)
+ (memq cs dest)
+ (setq dest (cons cs dest))
+ )))
+ (setq rest (cdr rest)))
+ dest)
+ ))
+
+(static-when (and (string= (decode-coding-string "\e.A\eN!" 'ctext) "\eN!")
+ (or (not (find-coding-system 'x-ctext))
+ (coding-system-get 'x-ctext 'apel)))
+ (unless (find-coding-system 'x-ctext)
+ (make-coding-system
+ 'x-ctext 2 ?x
+ "Compound text based generic encoding for decoding unknown messages."
+ '((ascii t) (latin-iso8859-1 t) t t
+ nil ascii-eol ascii-cntl nil locking-shift single-shift nil nil nil
+ init-bol nil nil)
+ '((safe-charsets . t)
+ (mime-charset . x-ctext)))
+ (coding-system-put 'x-ctext 'apel t)
+ ))
+
+
+;;; @ end
+;;;
+
+(require 'mcs-20)
+
+(require 'product)
+(product-provide (provide 'mcs-e20) (require 'apel-ver))
+
+;;; mcs-e20.el ends here
View
110 mcs-ltn1.el
@@ -0,0 +1,110 @@
+;;; 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)
+
+(defsubst lbt-to-string (lbt)
+ (cdr (assq lbt '((nil . nil)
+ (CRLF . "\r\n")
+ (CR . "\r")
+ (dos . "\r\n")
+ (mac . "\r"))))
+ )
+
+(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 &optional lbt)
+ "Encode the text between START and END as MIME CHARSET."
+ (let ((newline (lbt-to-string lbt)))
+ (if newline
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward "\n" nil t)
+ (replace-match newline))
+ )))
+ ))
+
+(defun decode-mime-charset-region (start end charset &optional lbt)
+ "Decode the text between START and END as MIME CHARSET."
+ (let ((newline (lbt-to-string lbt)))
+ (if newline
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward newline nil t)
+ (replace-match "\n"))
+ )))
+ ))
+
+(defun encode-mime-charset-string (string charset &optional lbt)
+ "Encode the STRING as MIME CHARSET."
+ (if lbt
+ (with-temp-buffer
+ (insert string)
+ (encode-mime-charset-region (point-min)(point-max) charset lbt)
+ (buffer-string))
+ 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
+;;;
+
+(require 'product)
+(product-provide (provide 'mcs-ltn1) (require 'apel-ver))
+
+;;; mcs-ltn1.el ends here
View
128 mcs-nemacs.el
@@ -0,0 +1,128 @@