pax_global_header00006660000000000000000000000064117465623430014525gustar00rootroot0000000000000052 comment=5bc105046fa3af4888f575632dfc6160ecf188d8 apel-5bc1050/000077500000000000000000000000001174656234300127675ustar00rootroot00000000000000apel-5bc1050/.cvsignore000066400000000000000000000000111174656234300147570ustar00rootroot00000000000000make.log apel-5bc1050/APEL-CFG000066400000000000000000000061251174656234300140340ustar00rootroot00000000000000;;; APEL-CFG --- user customizations for APEL installation. -*-Emacs-Lisp-*- ;;; Commentary: ;; Use this file to override variables defined in APEL-MK. ;; ;; The following variables are used in APEL-MK. ;; Note that you cannot use them in this file. ;; ;; For Emacs, or XEmacs without package system: ;; ;; PREFIX: Normally, "/usr/local". ;; Installer will try to detect it automatically. ;; LISPDIR: "PREFIX/share/emacs/site-lisp" if Emacs 19.29 and later. ;; "PREFIX/lib/emacs/site-lisp" if Emacs 19.28 and earlier. ;; Installer will try to detect it from PREFIX. ;; VERSION_SPECIFIC_LISPDIR: "PREFIX/share/emacs/VERSION/site-lisp" ;; if Emacs 19.31 and later, otherwise, same as LISPDIR. ;; ;; APEL_PREFIX: subdirectory of LISPDIR where APEL modules will be ;; installed, or "" if you don't want to make subdirectory. ;; EMU_PREFIX: subdirectory of VERSION_SPECIFIC_LISPDIR where EMU ;; modules will be installed, or "" if you don't want to ;; make subdirectory. ;; ;; APEL_DIR: The directory where APEL modules will be installed. ;; Generated from LISPDIR and APEL_PREFIX if it is not set. ;; EMU_DIR: The directory where EMU modules will be installed. ;; Generated from VERSION_SPECIFIC_LISPDIR and EMU_PREFIX ;; if it is not set. ;; ;; For XEmacs with package system: ;; ;; PACKAGEDIR: "/usr/local/lib/xemacs/xemacs-packages" ;; Installer will try to detect it automatically. ;; ;; APEL_PREFIX: subdirectory of PACKAGEDIR where both APEL and EMU ;; modules will be installed. ;;; Code: ;;; "custom" library. ;; If you want to use "new custom" but do not use "subdirs.el" to add ;; "custom" directory to your load-path, uncomment and edit this. ;; (setq load-path ;; (cons "/usr/local/share/emacs/19.34/site-lisp/custom" load-path)) ;;; Install to home directory. ;; If you want to install APEL to your home directory and you already ;; have the standard hierarchy such as "~/share/emacs/site-lisp" and ;; "~/share/emacs/VERSION/site-lisp", uncomment and edit this. ;; (setq PREFIX "~/") ;; Or, you can specify APEL_DIR and EMU_DIR directly. ;; (setq APEL_DIR "~/lib/emacs/lisp/apel") ;; (setq EMU_DIR "~/lib/emacs/lisp/emu") ;;; Install to site-lisp directories. ;; (setq PREFIX "/usr/local") ;; Mule based on Emacs 19.28 and earlier. ;; (setq LISPDIR "/usr/local/share/mule/site-lisp") ;; Mule based on Emacs 19.29 and later. ;; (setq LISPDIR "/usr/local/share/emacs/site-lisp") ;; (setq LISPDIR "/usr/local/share/mule/site-lisp") ;; (setq VERSION_SPECIFIC_LISPDIR "/usr/local/share/emacs/19.34/site-lisp") ;; (setq VERSION_SPECIFIC_LISPDIR "/usr/local/share/mule/19.34/site-lisp") ;; XEmacs 21.0 and later. ;; (setq PACKAGEDIR "/usr/local/lib/xemacs/xemacs-packages") ;; (setq APEL_PREFIX "apel") ;; (setq EMU_PREFIX "emu") ;; If you want to install all of APEL modules to VERSION_SPECIFIC_LISPDIR, ;; uncomment and edit this. ;; (setq APEL_DIR "/usr/local/share/emacs/19.34/site-lisp/apel") ;; You can specify APEL_DIR and EMU_DIR directly. Uncomment and edit this. ;; (setq APEL_DIR "/usr/local/share/emacs/site-lisp/apel") ;; (setq EMU_DIR "/usr/local/share/emacs/19.34/site-lisp/emu") ;;; APEL-CFG ends here apel-5bc1050/APEL-ELS000066400000000000000000000007311174656234300140550ustar00rootroot00000000000000;;; APEL-ELS --- list of APEL modules to install. -*-Emacs-Lisp-*- ;;; Commentary: ;; APEL-MK imports `apel-modules' from here. ;;; Code: (defvar apel-modules '(alist calist path-util filename install ;; "mule-caesar" is version-dependent. ;; moved to EMU-ELS. ;; mule-caesar ;; [obsoleted modules] If you would like to ;; install following, please activate them. ;; atype file-detect )) ;;; APEL-ELS ends here apel-5bc1050/APEL-MK000066400000000000000000000144141174656234300137440ustar00rootroot00000000000000;;; APEL-MK --- installer for APEL. -*-Emacs-Lisp-*- ;;; Commentary: ;; DON'T EDIT THIS FILE; edit APEL-CFG instead. ;;; Code: ;;; Configuration variables. ;; Set these four variables in "APEL-CFG" or in "Makefile". ;; This variable will be detected automatically. (defvar PREFIX nil) ;; This variable will be detected automatically using PREFIX. ;; v18: (no standard site-lisp directory) ;; Emacs 19.28 and earlier: "PREFIX/lib/emacs/site-lisp" ;; Emacs 19.29 and later: "PREFIX/share/emacs/site-lisp" (defvar LISPDIR nil) ;; This variable will be detected automatically using PREFIX. ;; Emacs 19.31 and later: "PREFIX/share/emacs/VERSION/site-lisp" (defvar VERSION_SPECIFIC_LISPDIR nil) ;; This variable will be detected automatically. ;; XEmacs 21.0 and later: "/usr/local/lib/xemacs/xemacs-packages" (defvar PACKAGEDIR nil) ;; Install APEL modules to "apel" subdirectory. (defvar APEL_PREFIX "apel") ;; Install EMU modules to "emu" subdirectory if emacs supports some features. ;; If your emacs does not have `normal-top-level-add-subdirs-to-load-path' ;; but have `normal-top-level-add-to-load-path' and you want to use it in ;; "subdirs.el", put the following line to "APEL-CFG". ;; (setq EMU_PREFIX "emu") (defvar EMU_PREFIX (if (or (featurep 'xemacs) (fboundp 'normal-top-level-add-subdirs-to-load-path)) ;; Make "emu" subdirectory. "emu" ;; Don't make "emu" subdirectory. "")) ;; The directories where APEL and EMU modules will be installed. ;; These two variables will be generated from other variables above. (defvar APEL_DIR nil) ; LISPDIR/APEL_PREFIX (defvar EMU_DIR nil) ; VERSION_SPECIFIC_LISPDIR/EMU_PREFIX ;;; Configure, Compile, and Install. (defun config-apel () ;; Override everything you want. (load-file "APEL-CFG") ;; Override PREFIX, LISPDIR, and VERSION_SPECIFIC_LISPDIR with ;; command-line options. (let (prefix lisp-dir version-specific-lisp-dir) (and (setq prefix ;; Avoid using `pop'. ;; (pop command-line-args-left) (prog1 (car command-line-args-left) (setq command-line-args-left (cdr command-line-args-left)))) (or (string-equal "NONE" prefix) (setq PREFIX prefix))) (and (setq lisp-dir ;; Avoid using `pop'. ;; (pop command-line-args-left) (prog1 (car command-line-args-left) (setq command-line-args-left (cdr command-line-args-left)))) (or (string-equal "NONE" lisp-dir) (setq LISPDIR lisp-dir))) (and (setq version-specific-lisp-dir ;; Avoid using `pop'. ;; (pop command-line-args-left) (prog1 (car command-line-args-left) (setq command-line-args-left (cdr command-line-args-left)))) (or (string-equal "NONE" version-specific-lisp-dir) (setq VERSION_SPECIFIC_LISPDIR version-specific-lisp-dir)))) ;; Load some APEL modules from this directory. (defvar default-load-path load-path) (setq load-path (cons (expand-file-name ".") load-path)) (require 'poe) (require 'path-util) (require 'install) ;; Import `apel-modules'. (load-file "APEL-ELS") ;; Import `emu-modules' and `emu-modules-to-compile'. (load-file "EMU-ELS") ;; Set PREFIX, LISPDIR, and VERSION_SPECIFIC_LISPDIR if not set yet. (or PREFIX (setq PREFIX install-prefix)) (or LISPDIR (setq LISPDIR (install-detect-elisp-directory PREFIX))) (or VERSION_SPECIFIC_LISPDIR (setq VERSION_SPECIFIC_LISPDIR (install-detect-elisp-directory PREFIX nil 'version-specific))) ;; The directories where APEL and EMU will be installed. (or APEL_DIR (setq APEL_DIR (expand-file-name APEL_PREFIX LISPDIR))) (or EMU_DIR (setq EMU_DIR (expand-file-name EMU_PREFIX VERSION_SPECIFIC_LISPDIR))) (princ (format "\nLISPDIR=%s\n" LISPDIR)) (princ (format "VERSION_SPECIFIC_LISPDIR=%s\n" VERSION_SPECIFIC_LISPDIR))) (defun compile-apel () (config-apel) ;; Compile emu modules first. (compile-elisp-modules emu-modules-to-compile ".") (compile-elisp-modules apel-modules ".")) (defun install-apel (&optional just-print) (config-apel) (or just-print (setq just-print (install-just-print-p))) (install-elisp-modules emu-modules "." EMU_DIR just-print) (install-elisp-modules apel-modules "." APEL_DIR just-print)) ;; For XEmacs package system. (defun config-apel-package () ;; Override everything you want. (load-file "APEL-CFG") ;; Override PACKAGEDIR with command-line option. (let (package-dir) (and (setq package-dir ;; Avoid using `pop'. ;; (pop command-line-args-left) (prog1 (car command-line-args-left) (setq command-line-args-left (cdr command-line-args-left)))) (or (string= "NONE" package-dir) (setq PACKAGEDIR package-dir)))) ;; Load some APEL modules from this directory. (defvar default-load-path load-path) (setq load-path (cons (expand-file-name ".") load-path)) (require 'poe) (require 'path-util) (require 'install) ;; Import `apel-modules'. (load-file "APEL-ELS") ;; Import `emu-modules' and `emu-modules-to-compile'. (load-file "EMU-ELS") ;; Set PACKAGEDIR if not set yet. (or PACKAGEDIR (setq PACKAGEDIR (install-get-default-package-directory))) (if PACKAGEDIR (princ (format "\nPACKAGEDIR=%s\n" PACKAGEDIR)) (error "XEmacs package system is not available"))) (defun compile-apel-package () (config-apel-package) ;; Compile emu modules first. (compile-elisp-modules emu-modules-to-compile ".") (compile-elisp-modules apel-modules ".")) (defun install-apel-package () (config-apel-package) (let ((just-print (install-just-print-p)) (dir (expand-file-name APEL_PREFIX (expand-file-name "lisp" PACKAGEDIR)))) (install-elisp-modules emu-modules "." dir just-print) (install-elisp-modules apel-modules "." dir just-print) (install-update-package-files "apel" dir just-print))) (defun what-where-apel () (install-apel 'just-print) ;; (config-apel) ;;; (princ (format " ;;; The files that belong to the EMU modules: ;;; %s ;;; -> %s ;;; The files that belong to the APEL modules: ;;; %s ;;; -> %s ;;; Do `make elc', `make install', `make package', or `make install-package'. ;;; " ;;; (mapconcat (function symbol-name) emu-modules ", ") ;;; EMU_DIR ;;; (mapconcat (function symbol-name) apel-modules ", ") ;;; APEL_DIR)) ) ;;; APEL-MK ends here apel-5bc1050/ChangeLog000066400000000000000000003432651174656234300145560ustar00rootroot000000000000002012-04-27 MORIOKA Tomohiko * README.en, README.ja (Download): Renamed from "Anonymous FTP"; modify for http://git.chise.org/elisp/dist/apel/. 2012-04-27 MORIOKA Tomohiko * README.ja (MAKEIT.BAT): Modify for apel-ja@lists.chise.org. 2012-04-27 MORIOKA Tomohiko * README.ja, README.en: Remove descriptions about CVS and add description about the new Git repository. 2012-04-27 MORIOKA Tomohiko * README.en (make.bat (for MS-DOS family)): Modify for apel-en@lists.chise.org. 2012-04-26 MORIOKA Tomohiko * README.ja, README.en (Bug reports): Modify for apel-{en|ja}@lists.chise.org. 2010-10-06 MORIOKA Tomohiko * mcs-xm.el (charsets-mime-charset-alist): - Don't use `japanese-jisx0208-1990' for `iso-2022-jp' - Don't use `iso-2022-jp-3' - Use `utf-8' instead of `shift_jis' for '(ascii latin-jisx0201 katakana-jisx0201 japanese-jisx0208-1990) - Don't use `iso-2022-jp-2' 2010-06-15 MORIOKA Tomohiko * APEL: Version 10.8 released. * apel-ver.el (apel-ver): Change APEL version to 10.8. 2010-02-13 MORIOKA Tomohiko * EMU-ELS (emu-modules): Add setting for GNU Emacs 23 or later. * invisible.el: In GNU Emacs 23, inv-19.el overrides builtin function `invisible-p'. To fix the bug, require `inv-23' when running with GNU Emacs 23 or later. * inv-23.el: New file [copied from inv-19.el, but `invisible-p' is removed]. [Contributed by David Maus ] 2008-09-06 MORIOKA Tomohiko * poe.el (format-time-string): Fix problem on GNU Emacs 22.2 . 2007-02-14 MORIOKA Tomohiko * APEL: Version 10.7 released. * Makefile (VERSION): Update to 10.7. 2006-12-20 MORIOKA Tomohiko * APEL-MK (config-apel-package): Use `install-get-default-package-directory'. * install.el (install-get-default-package-directory): New function. 2006-12-20 MORIOKA Tomohiko * apel-ver.el (apel-ver): Change APEL version to 10.7. 2005-05-08 MORIOKA Tomohiko * poem-xm.el (char-valid-p): New alias. 2006-12-13 Katsumi Yamaoka * APEL-MK (config-apel-package): Avoid an error concerning PACKAGEDIR with old XEmacs that doesn't use the package system. 2006-12-12 Katsumi Yamaoka * install.el (install-update-package-files): Use batch-update-directory-autoloads if it is available instead of batch-update-directory. 2006-12-11 Katsumi Yamaoka * APEL-MK (config-apel-package): Check for (early|late|last)-package-hierarchies and configure-package-path as well as (early|late|last)-packages. 2006-11-13 Katsumi Yamaoka * time-stamp.el: Remove. Suggested by Stephen Gildea, the maintainer of time-stamp.el. * EMU-ELS (emu-modules): Exclude it. * README.en, README.ja: Remove time-stamp.el entry. 2006-04-24 Katsumi Yamaoka * install.el (install-detect-elisp-directory): Fix 2002-11-29 change; assume default-load-path contains nil; use regexp-quote to compare directories even in Emacs. 2005-12-06 Ville Skyttä * poe.el (minor-mode-overriding-map-alist): Doc fix. * product.el (product-version-as-string): Doc fix. 2002-11-29 Ben Wing * install.el (install-detect-elisp-directory): Fix problems handling backslashes in filenames (Windows). 2005-06-06 Katsumi Yamaoka * filename.el (filename-special-filter-1): New macro defined for filename-special-filter to use aref instead of sref for the recent Emacsen. (filename-special-filter): Use it. 2005-06-05 Tatsuya Kinoshita * poe-xemacs.el: Load `timer' even if `timer-funcs' exists. 2005-05-10 TAKAHASHI Kaoru * poe.el (split-string): Import from Emacs 22. Add omit-nulls argument. 2005-05-03 Tatsuya Kinoshita * poem.el (characterp): Use `char-valid-p' if it exists. * poem.el (char-or-char-int-p): Ditto. 2005-02-23 Katsumi Yamaoka * poe-xemacs.el (run-at-time): Attempt to load `timer-funcs' before `timer'. 2004-09-27 Katsumi Yamaoka * README.en, README.ja (CVS): Remove the description about developers' pserver access. 2004-02-06 Katsumi Yamaoka * calist.el (use-calist-package): Add missing arg to `format'. 2004-01-26 Katsumi Yamaoka * Makefile: Make `elc' into the default entry. 2004-01-07 Katsumi Yamaoka * poe-xemacs.el (run-at-time): Don't use `defadvice' in order to avoid a conflict with the Gnus version. 2003-12-12 Katsumi Yamaoka * poe-xemacs.el (run-at-time): Fully implement it for the recent XEmacsen when the fsf-compat package is not available. (run-at-time-tick-tock): Check closely whether a bug is in `start-itimer'. 2003-12-11 Katsumi Yamaoka * poe-xemacs.el (run-at-time): Redefine it to make it punctual. 2003-09-05 Katsumi Yamaoka * poem-xm.el (char-length): Don't use `defun-maybe' to define it since this module may be installed as the XEmacs package which should be usable by all the XEmacs 21.x series. 2003-07-05 Yuuichi Teranishi * APEL: Version 10.6 released. * apel-ver.el (apel-ver): Change APEL version to 10.6. 2003-07-03 Shuhei KOBAYASHI * poe.el (make-temp-file) [2-args make-temp-file]: Don't use octal number for file modes. * poe.el (toplevel): Fixed the compile-time check for the definition of `make-temp-file' [apel-ja: 00874]. (make-temp-file) [no make-temp-file, single-user system]: Don't use `set-default-file-modes' nor `default-file-modes'. 2003-07-03 Yuuichi Teranishi * poe-18.el (make-directory-internal): Signal an error according to the exit status of mkdir. (delete-directory): New function. (write-region): Ditto. 2003-06-06 Yuuichi Teranishi * APEL: Version 10.5 released. * apel-ver.el (apel-ver): Change APEL version to 10.5. 2003-05-29 Yuuichi Teranishi * poe.el (make-temp-file) [no make-temp-file, single-user system]: Modified for OS/2. 2003-05-22 Yuuichi Teranishi * install.el (install-prefix): Change value for Meadow2 and NTEmacs. 2003-05-20 Shuhei KOBAYASHI * poe.el (make-temp-file) [no make-temp-file, multi-user system]: Modified comments. 2003-05-19 Shuhei KOBAYASHI * poe.el (make-temp-file) [no make-temp-file, multi-user system]: Flatten nested `unwind-protect'. Fixed comments. 2003-05-15 Yuuichi Teranishi * poe.el (make-temp-file): New function. 2002-11-05 MORIOKA Tomohiko * mcs-20.el (mcs-region-repertoire-p): New function for UTF-2000 implementations. (mcs-string-repertoire-p): Likewise. (detect-mime-charset-region): New implementation for UTF-2000 implementations. (detect-mime-charset-string): New function for UTF-2000 implementations. 2002-11-03 Yoichi NAKAYAMA * filename.el (filename-filters): Change default value to nil. 2002-10-04 Katsumi Yamaoka * APEL: Version 10.4 released. 2002-10-03 Takeshi Morishima * install.el (install-elisp-module): Delete an elc file if the optional 5th argument `del-elc' is given. (install-elisp-modules): Allow the optional 5th argument `del-elc' and pass it to `install-elisp-module'. 2002-10-02 Katsumi Yamaoka * mcs-ltn1.el (mime-charset-to-coding-system): Allow the 2nd arg. * mcs-nemacs.el (mime-charset-to-coding-system): Ditto. 2002-07-13 Daiki Ueno * mcs-xm.el (encode-mime-charset-string): Use `defun' instead of `defsubst' 2002-07-10 Adrian Aichner * emu.el: Conditionalise defalias 'tl:overlay-buffer on 'tl:overlay-buffer, not 'tl:overlay-put. 2002-06-26 Katsumi Yamaoka * mcs-e20.el (charsets-mime-charset-alist): Remove nil's from the default value. * mcs-xm.el (charsets-mime-charset-alist): Ditto. 2002-06-21 Katsumi Yamaoka * mcs-e20.el (charsets-mime-charset-alist): Add Latin8 and Latin9 charsets. Suggested by Tatsuya Kinoshita . * mcs-xm.el (charsets-mime-charset-alist): Ditto. 2002-05-14 Katsumi Yamaoka * pccl.el (ccl-usable): Make non-MULE XEmacs don't require `ccl' even if this file is mis-compiled for XEmacs with MULE. 2002-03-23 Nix * poem-ltn1.el (truncate-string): Act like the real `truncate-string': do not fail if the string is shorter than the max length. 2002-04-30 Katsumi Yamaoka * poem-xm.el (string-to-char-list): Revive it again. 2002-04-25 Katsumi Yamaoka * poem-xm.el (string-to-char-list): Remove. It is restored in XEmacs CVS. 2002-04-15 Katsumi Yamaoka * poem-xm.el (char-length): New function. (string-to-char-list): New function. 2002-03-04 Katsumi Yamaoka * pym.el: Add a note that `def*-maybe' might not provide functions or variables at run-time. 2001-12-05 Katsumi Yamaoka * tinycustom.el (custom-declare-face): New function. (defface): Use it. 2001-10-15 Katsumi Yamaoka * poe.el (format-time-string): Support the 3rd arg `universal'. (support-timezone-in-numeric-form-and-3rd-arg): Renamed from `support-timezone-in-numeric-form'; support the 3rd arg `universal'. 2001-10-12 TSUCHIYA Masatoshi * poe.el (format-time-string): Support the construct `%z'. (support-timezone-in-numeric-form): New advice. 2001-09-09 Daiki Ueno * pccl.el (transform-make-coding-system-args): Follow old backquote style. 2001-07-20 NAKAJIMA Mikio * install.el (install-file, install-elisp-module): Set file modes according to `install-overwritten-file-modes'. * poe-18.el (defalias): Remove alias to fset and define it by using `defun'. 2001-06-23 NAKAJIMA Mikio * install.el (install-files): Do not make DEST directory when JUST-PRINT is non-nil. 2001-06-20 Akihiro MOTOKI * install.el (install-elisp-modules): Do not make DEST directory when JUST-PRINT is non-nil. 2001-06-01 Tanaka Akira * pccl.el (ccl-compat): Since mule 2.3 accepts `t' and `nil' as `type' argument, so arguments conversion shouln't applied in such case. 2001-05-24 Tanaka Akira * pccl.el (accept-long-ccl-program): Don't advice for Emacs 21. (transform-make-coding-system-args): New emulating function. (ccl-compat): new advice for `make-coding-system' of Emacs 20 or former to handle XEmacs style CCL coding system definition. 2001-04-29 Shuhei KOBAYASHI * poe.el (remassoc, remassq, remrassoc, remrassq): Fixed. 2001-03-26 Yuuichi Teranishi * EMU-ELS: Add checking whether the native timezone.el has an old date string parser. 2001-03-23 TSUCHIYA Masatoshi * timezone.el (timezone-parse-date): Import from Emacs-20.7. 2001-02-23 Katsumi Yamaoka * emu.el (char-category for XEmacs): Don't use `int-char' when the function `char-category-list' returns a list of characters. 2001-02-01 NAKAJIMA Mikio * README.ja: Updated as to MAKEIT.BAT and MAKE1.BAT. * make1.bat: New file. * makeit.bat: Ditto. * make.bat: Removed. 2001-01-18 Katsumi Yamaoka * inv-19.el (next-visible-point): Return the value of `point-max' when the position of next `invisible' property change is not found. 2001-01-15 Yuuichi Teranishi * poe-18.el (floor): Removed. * timezone.el (timezone-floor): New function. (timezone-fix-time-2): Use `timezone-floor' instead of `floor'. 2000-12-31 NAKAJIMA Mikio * README.ja: Typo fixed. 2000-12-30 NAKAJIMA Mikio * APEL: Version 10.3 released. * apel-ver.el (apel-ver): Change APEL version to 10.3. * Makefile : Apply patch from TAKAHASHI Kaoru of Message-Id: <86vgs2s3cp.wl@tomoko.nantnaq.kaisei.org>. 2000-12-28 Tanaka Akira * pccl-20.el (ccl-compat): new advice for `make-coding-system' of XEmacs to handle Emacs style CCL coding system definition. 2000-12-28 Kenichi Handa * static.el: Doc-string fixed. 2000-12-28 MORIOKA Tomohiko * mcharset.el (default-mime-charset-for-write): Use `mime-charset-p' instead of `find-coding-system'; don't require `pces'. * mcs-nemacs.el, mcs-ltn1.el, mcs-20.el (mime-charset-p): New alias. 2000-12-26 NAKAJIMA Mikio * README.en: Change major mode to outline-mode. (What's APEL?): Add description about pym.el, pces, time-stamp.el, timezone.el, and product.el. (run in expanded place): Add a reference to `make.bat (for MS-DOS family)'. * README.ja: Change major mode to outline-mode. (What's APEL?): Add description about pym.el, pces, time-stamp.el, timezone.el, and product.el. 2000-12-24 NAKAJIMA Mikio * poe.el (minor-mode-overriding-map-alist): Remove the filename poe.el from doc string. * poe-18.el (current-time-world-timezones): Remove the filename poe-18.el from doc string. (current-time-local-timezone): Ditto. (buffer-undo-list): Ditto. (auto-fill-function): Ditto. (unread-command-event): Ditto. (unread-command-events): Ditto. (minor-mode-map-alist): Ditto. * README.en ((d) make.bat (for MS-DOS family)): New section. * README.ja ((d) make.bat $(B$rMxMQ$9$k(B (MS-DOS $(B7O(B OS $(B$N>l9g(B)): Ditto. 2000-12-22 MORIOKA Tomohiko * mcs-e20.el: Require `pces'. 2000-12-22 Yuuichi Teranishi * timezone.el (timezone-time-from-absolute): Use `%' instead of `mod'. 2000-12-21 Katsumi Yamaoka * poe-18.el (numberp, mod): Removed. 2000-12-21 MORIOKA Tomohiko * mcharset.el (default-mime-charset-for-write): Require `pces' for `find-coding-system'. 2000-12-21 NAKAJIMA Mikio * poe-18.el (minor-mode-alist): Removed. (minor-mode-overriding-map-alist): Move to poe.el. 2000-12-20 MORIOKA Tomohiko * APEL-MK (install-apel): Add new optional argument `just-print'. (what-where-apel): New implementation [use `install-apel' with `just-print' mode]. 2000-12-20 MORIOKA Tomohiko * APEL-MK (install-just-print-p): Moved to install.el. (install-update-package-files): Moved to install.el. * install.el (install-update-package-files): New function [moved from APEL-MK]. (install-just-print-p): Likewise. 2000-12-15 MORIOKA Tomohiko * mcs-xm.el: Don't require `poem' instead of `mcs-20'. * mcs-e20.el: Don't require mcs-20. * mcs-20.el: - Don't require `poem'. - Require `custom' instead of `pcustom'. - Require mcs-xm for XEmacs-Mule. - Require mcs-e20 for GNU Emacs 20.1 or later. (default-mime-charset): Change initial value to `x-unknown'. * mcharset.el: Require mcs-20 if running with XEmacs-Mule and GNU Emacs 20.1 or later. 2000-12-19 Katsumi Yamaoka * poe.el (current-fill-column): New emulating function. (current-left-margin): New emulating function. * poe-18.el (numberp): Use `defalias-maybe' instead of `defalias'. (mod): Ditto. 2000-12-20 NAKAJIMA Mikio * poe-18.el (set-frame-height): Typo fixed. (read-from-minibuffer): Do not run `minibuffer-setup-hook' and `minibuffer-exit-hook'. (minibuffer-setup-hook): Comment out. (minibuffer-exit-hook): Ditto. 2000-12-19 NAKAJIMA Mikio * make.bat: Do not echo. * poe-18.el (set-frame-heigth): Bug fixed. 2000-12-16 NAKAJIMA Mikio * poe-18.el (frame-width): New function. (frame-height): Ditto. (set-frame-width): Ditto. (set-frame-heigth): Ditto. (read-from-minibuffer): Run `minibuffer-setup-hook' and `minibuffer-exit-hook'. (buffer-undo-list): Declared with `defvar-maybe' and add doc string. (auto-fill-function): Add doc string. (unread-command-event): Ditto. (unread-command-events): Ditto. (minibuffer-setup-hook): New variable. (minibuffer-exit-hook): Ditto. (minor-mode-map-alist): Ditto. (minor-mode-alist): Ditto. (minor-mode-overriding-map-alist): Ditto. 2000-12-15 NAKAJIMA Mikio * make.bat (listing): Bug fixed. * README.en: Add URL that can be used to getting SKK 10.62a with the new byte compiler for Emacs 18. * README.ja: Ditto. 2000-12-15 TAKAHASHI Kaoru * Makefile (tar): Remove .cvsignore. Use `cvs tag -R' instead of `cvs tag -RF'. 2000-12-15 Katsumi Yamaoka * poe-18.el (buffer-disable-undo): Define it as a function to make an argument optional instead of the use of `defalias' to `buffer-flush-undo'. 2000-12-14 Daiki Ueno * alist.el (del-alist): Simplified. 2000-12-14 Mikio Nakajima * pym.el (static-if): Put t on edebug spec instead of if. 2000-12-13 Kenichi Handa * alist.el: Fix and add DOCs and comments; fix coding style. 2000-04-26 MORIOKA Tomohiko * mcs-xm.el (charsets-mime-charset-alist): Add coded-charset `japanese-jisx0208-1990' to MIME-charset `iso-2022-jp' and `iso-2022-jp-2' in UTF-2000; add new MIME-charset `iso-2022-jp-3'. 2000-11-26 Mikio Nakajima * make.bat: New file. * .cvsignore: Ditto. 2000-11-09 Katsumi Yamaoka * path-util.el (add-path): Check for both "path" and "path/". 2000-10-06 Shuhei KOBAYASHI * poe.el (require): Update `current-load-list'. 2000-10-10 Keiichi Suzuki * product.el (product-version-as-string): New function. (product-string-1): Use `product-version-as-string'. 2000-08-10 MORIOKA Tomohiko * poem-e20_3.el: Require `pym'. 2000-07-12 MORIOKA Tomohiko * alist.el (vassoc): New function [to be compatible with XEmacs 21.2.32 or later]. 2000-05-25 Tanaka Akira * README.en, README.ja: Update for CVS via SSH. 2000-05-24 Katsumi Yamaoka * pces-raw.el (encode-coding-string, decode-coding-string): Return a copy of string. 2000-04-25 Katsumi Yamaoka * EMU-ELS (emu-modules): Don't include `pccl-20' for XEmacs 20 and earlier. 2000-03-25 Mikio Nakajima * pym.el: Define edebug specs for `static-if', `static-when', `static-unless', `static-condition-case', `static-defconst' and `static-cond'. 2000-03-08 Akihiro Arisawa * poe.el (format-time-string): Fix problem when `format' contains "%d" or "%D". 2000-03-04 Daiki Ueno * poe.el (remassq,remassoc,remrassoc): Rewrite. (remrassq): New function. 2000-03-01 Yuuichi Teranishi * APEL: Version 10.2 released. 2000-02-29 Yuuichi Teranishi * poe-18.el (current-time-string): Fixed leap year's day counting bug. 2000-02-28 Katsumi Yamaoka * emu.el (enriched-encode): Do nothing for it if FSF Emacs 19.28 and earlier or XEmacs 19.13 and earlier is used. 2000-02-25 Katsumi Yamaoka * emu.el (enriched-encode): Allow the 3rd argument ORIG-BUF for old Emacsen. 2000-02-21 Makoto Nakagawa * poe.el (format-time-string): New function for Emacs 19.28 and earlier. (format-time-month-list): New constant for `format-time-string'. (format-time-week-list): New constant for `format-time-string'. 2000-02-21 Daiki Ueno * poe-18.el (walk-windows): New function. * poe-xemacs.el (set-extent-properties): New function. (run-at-time): New function. (cancel-timer): New function. (with-timeout-handler): New function. (with-timeout): New function. * poe.el (remassq): New function. (remassoc): New function. (remrassoc): New function. (get-buffer-window-list): New function. (save-selected-frame): New macro. 2000-02-10 Yuuichi Teranishi * poe.el (replace-match): Redefined to add `STRING' optional argument. 2000-02-07 Yuuichi Teranishi * poe-18.el (mod): Define as an alias for `%'. (overlayp, move-overlay, delete-overlay, overlay-start, overlay-end, overlay-buffer, overlay-properties, overlays-at, overlays-in, next-overlay-change, previous-overlay-change, overlay-lists, overlay-recenter, overlay-get): Define as null function. 2000-02-05 MORIOKA Tomohiko * mcs-20.el (mime-charset-coding-system-alist): Add `iso-2022-jp-3'. 2000-02-04 Katsumi Yamaoka * poe.el (read-file-name): Replacement for Emacs 19.28 and earlier (except for Emacs 18) or XEmacs 19.13 and earlier, for compatibility. 2000-02-04 Yuuichi Teranishi * timezone.el (timezone-floor): Eliminated. (timezone-fix-time-2): Use `floor' instead of `timezone-floor'. * poe-18.el (current-time): Fixed leap year count bug. (set-time-zone-rule): New function. (current-time-zone): Use `set-time-zone-rule'. (floor): New function. (window-live-p): New function. (read-from-minibuffer): Redefined to add `HIST' optional argument. (accept-process-output): Redefined to add `TIMEOUT' and `TIMEOUT-MSECS' optional arguments. (get-buffer-window): Redefined to add `FRAME' optional argument. * poe.el (completing-read): Redefined to adjust optional arguments for some emacsen. 2000-01-31 Mikio Nakajima * poe-18.el (defalias): Remove its definition as a function and define it as an alias for `fset'. (auto-fill-function): Declare with defvar-maybe. (unread-command-event): Ditto. (unread-command-events): Ditto. (insert-and-inherit): Defile with defalias. (insert-before-markers-and-inherit): Ditto. (number-to-string): Ditto. 2000-01-30 Mikio Nakajima * poe-18.el (window-minibuffer-p): New function. 2000-01-30 Tsukamoto Tetsuo * pces-om.el (insert-file-contents-as-coding-system): Ignore BEG, END and REPLACE under Emacs 18, or Mule 1.1 or earlier. (insert-file-contents-as-binary): Ditto. 2000-01-27 Shuhei KOBAYASHI * APEL-CFG: Typo. 2000-01-26 Shuhei KOBAYASHI * poe-18.el (set-match-data): New alias for `store-match-data'. (save-match-data-internal): New variable. (save-match-data): New macro; use above. (defalias): Docstring sync. (put-text-property): Typo. 2000-01-23 Tsukamoto Tetsuo * poe-18.el (byte-code-function-p): Check if the CDR of OBJECT is a cons cell. 2000-01-21 Yuuichi Teranishi * APEL: Version 10.1 released. 2000-01-19 Shuhei KOBAYASHI * poe.el (require): Handle `file-error' only. 2000-01-12 OKAZAKI Tetsurou * EMU-ELS (emu-modules): Add `pccl' even if `mule' is not provided. 2000-01-05 Katsumi Yamaoka * Makefile, README.en, README.ja: Update for the new CVS server. 1999-12-24 Shuhei KOBAYASHI * poe.el (functionp): Define it before loading "localhook". 1999-12-24 Yuuichi Teranishi * APEL: Version 10.0 released. 1999-12-24 Keiichi Suzuki * apel-ver.el: Fix file header. 1999-12-23 Yuuichi Teranishi * 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 * product.el: Fix file header. `checkdoc' fix. * apel-ver.el: Fix file header. 1999-12-22 Shuhei KOBAYASHI * 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 * poe.el (string-to-int): Commented out an alias for `string-to-number'. 1999-12-13 Katsumi Yamaoka * poe-18.el: Fix open parenthesis. * README.ja: Sync up with README.en. * README.en: Fix what versions of Emacsen can use `normal-top-level-add-to-load-path'. 1999-12-12 Shuhei KOBAYASHI * APEL-MK: Modified comments. * poe.el: Modified comments. * pym.el: Modified comments. (defalias-maybe): Don't update `current-load-list'. 1999-12-06 Shuhei KOBAYASHI * pym.el (subr-fboundp): Reverted; but considered as obsolete. 1999-12-05 Shuhei KOBAYASHI * poe-18.el (numberp): New function; alias for `integerp'. (abs): New function. * poe-18.el (byte-code-function-p): Docstring sync. (cyclic-function-indirection): New error symbol. (indirect-function): New function; use above symbol. 1999-11-30 Shuhei KOBAYASHI * poe-18.el (current-time-string): New local variable `lyear' for leap year; renamed from `uru' and bind locally. * poe.el (emacs-major-version, emacs-minor-version): Define at compile-time as well as at load-time in order to do compile- time version check. (tcp): Require if `open-network-stream' is not available; moved from "pces.el". * pym.el: Removed comment. 1999-11-28 Shuhei KOBAYASHI * poe.el, poe-18.el, poe-xemacs.el, pym.el: Modified comments. 1999-11-25 Shuhei KOBAYASHI * poe-18.el: Modified comments. (buffer-undo-list, data-directory): Use `defvar'. (generate-new-buffer-name): Use `defun'. 1999-11-22 Shuhei KOBAYASHI * pccl-20.el, pccl-om.el: Removed "[SOURCE INFO]" style comment from docstrings. * pccl-om.el, localhook.el, pcustom.el: Updated header. 1999-11-13 Shuhei KOBAYASHI * Removed "[SOURCE INFO]" style comment from docstrings. Most of them are out of sync, and now there are some other ways to get such information. * poe-18.el: Rearranged. (lambda): New macro. (get-char-property, next-single-property-change, previous-property-change, previous-single-property-change, text-property-any, text-property-not-all, next-char-property-change, previous-char-property-change): Define as null function. * poe-xemacs.el: Rearranged. (eval-after-load): Moved to poe.el. * poe.el: Rearranged; reduce load-time check. Moved many macros to pym.el. (require): New function; emulate optional 3rd arg. (plist-get, plist-put): New functions. (string-to-number): New function. (push, pop): New macros. (assoc-default): New function. (eval-after-load, eval-next-after-load): New functions; moved from poe-xemacs.el and modified for Emacs 19.28. (buffer-file-type): New variable. (with-temp-message, with-output-to-string): New macros. (combine-after-change-calls): Docstring sync. (match-string-no-properties): New function. (convert-standard-filename): Do load-time check. 1999-11-13 Shuhei KOBAYASHI * pym.el (defsubst-maybe-cond): New macro. * pym.el (defun-maybe, defmacro-maybe, defsubst-maybe, defalias-maybe, defvar-maybe, defconst-maybe, defun-maybe-cond, defmacro-maybe-cond, def-edebug-spec): Moved from poe.el. * EMU-ELS (emu-modules): Added 'pym. * pym.el: New file. 1999-11-13 Shuhei KOBAYASHI * APEL-MK, APEL-CFG, APEL-ELS, EMU-ELS, Makefile: Revised. 1999-11-12 Shuhei KOBAYASHI * inv-18.el, inv-19.el, inv-xemacs.el: Require 'poe in each submodule. (enable-invisible): Changed to function. (disable-invisible): Renamed from `end-of-invisible'. Changed to function. (end-of-invisible): Make obsolete. 1999-11-12 Shuhei KOBAYASHI * README.en (Version specific information): New section. (Bug reports): Updated description of APEL mailing-lists. * pcustom.el [old custom]: Refer to it. * tinycustom.el: checkdoc. 1999-11-12 Shuhei KOBAYASHI * APEL-MK: Require 'path-util explicitly. 1999-11-12 Shuhei KOBAYASHI * APEL-MK, APEL-CFG, APEL-ELS, EMU-ELS: Rewritten. * install.el: Removed v18 stuff; now we require 'poe. Modified some comments. 1999-12-22 Yuuichi Teranishi * timezone.el: Modified comments. (toplevel): Require 'product. 1999-12-21 Shuhei KOBAYASHI * apel-ver.el: Footer fix. 1999-12-21 Yuuichi Teranishi * 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 * apel-ver.el, product.el: Header fix. 1999-12-20 Keiichi Suzuki * 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 * 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 * product.el: Some `checkdoc' fixes. (product-version>=): Eliminate local variable. * 1999-11-12 Keiichi Suzuki * product.el: New file. * apel-ver.el: New file. * APEL-ELS (apel-modules): Add `apel-ver' and `product'. 1999-11-25 Yuuichi Teranishi * poe-18.el (current-time-string, current-time): New functions. 1999-11-11 Shuhei KOBAYASHI * localhook.el, pcustom.el: checkdoc. 1999-11-09 Katsumi Yamaoka * pcustom.el: Warn if the new custom library is not found at the compile time. * APEL-CFG: Don't add the path of "custom" to `load-path'. * poe-18.el (file-executable-p): Returns nil if the file does not exist. 1999-11-08 Yuuichi Teranishi * poe-18.el (put-text-property, next-property-change, text-properties-at): Define as null function. 1999-11-02 Katsumi Yamaoka * poe-18.el (add-text-properties, get-text-property): Define as null function. (file-executable-p): New function. 1999-10-22 Katsumi Yamaoka * APEL: Version 9.23 released. 1999-10-22 Katsumi Yamaoka * APEL-MK (compile-apel-package): Compile `emu-modules-to-compile' instead of `emu-modules'. (compile-apel): Likewise. * EMU-ELS (emu-modules-to-compile): New variable which is used for compiling in APEL-MK. If the feature `utf-2000' is provided, `mcs-xmu' is removed from its value even if `emu-modules' contains it. (emu-modules-not-to-compile): New variable. * mcs-xm.el (mime-iso646-character-unification-alist): Move to mcs-xmu.el. (mime-unified-character-face): Move to mcs-xmu.el. (mime-character-unification-limit-size): Move to mcs-xmu.el. (decode-mime-charset-region-with-iso646-unification): Move to mcs-xmu.el. * mcs-xmu.el: New file. 1999-10-22 Katsumi Yamaoka * EMU-ELS (pces-modules): Don't check for the feature `mule' whether `pces-xfc' is required. * pces.el: Likewise. * mcs-xm.el: (decode-mime-charset-region-with-iso646-unification): Narrow to the region while decoding; bind `case-fold-search' to nil. (mime-character-unification-limit-size): Make it can also be nil which means the size is unlimited. 1999-10-14 Mikio Nakajima * mcs-xm.el (decode-mime-charset-region-with-iso646-unification): Don't put `mime-unified-character-face' to unified text if it is nil. (mime-character-unification-limit-size): Fix doc string. 1999-10-13 Katsumi Yamaoka * poe.el (file-coding): Provide it for XEmacs 20.4 or earlier with MULE. 1999-10-13 Daiki Ueno * EMU-ELS (pces-modules): Add `pces-raw' if file-coding feature is not available in a XEmacs-without-MULE. * pces.el: Require `pces-raw' if file-coding feature is not available in a XEmacs-without-MULE. 1999-10-04 Katsumi Yamaoka * path-util.el (exec-installed-p): Add parens. 1999-10-04 Keiichi Suzuki * path-util.el (exec-installed-p): Use `file-executable-p' instead of `file-exists-p'. When FILE already inculdes suffix in `exec-suffix-list', do not expand file name with `exec-suffix-list'. (module-installed-p): Do not use `exec-installed-p'. 1999-09-27 MORIOKA Tomohiko * mcs-xm.el: Use `unless' instead `static-unless' to share *.elc between UTF-2000 and non-UTF-2000. 1999-09-24 Mikio Nakajima * pces-om.el (find-coding-system): New inline function. 1999-09-23 MORIOKA Tomohiko * mcs-20.el (mime-charset-coding-system-alist): Use coding-system `tis-620' instead of `tis620'. * mcs-xm.el (charsets-mime-charset-alist): Add setting for `tis-620'. 1999-09-22 MORIOKA Tomohiko * mcs-20.el (mime-charset-coding-system-alist): Add `cp874'. 1999-09-21 Katsumi Yamaoka * EMU-ELS (pces-modules): Add `pces-xfc' if the feature `mule' is provided even though the feature `file-coding' is not provided. * pces.el: Require `pces-xfc' if the feature `mule' is provided even though the feature `file-coding' is not provided. 1999-09-13 MORIOKA Tomohiko * APEL: Version 9.22 released. 1999-09-12 Mikio Nakajima * poe.el (defmacro-maybe-cond): Add edebug spec. 1999-09-12 Yoshiki Hayashi * poe.el (defun-maybe-cond): Add edebug spec. 1999-09-09 MORIOKA Tomohiko * mcs-xm.el (mime-charset-decoder-alist): Don't use `decode-mime-charset-region-with-iso646-unification' if running XEmacs-UTF-2000. (mime-iso646-character-unification-alist): Don't define if running XEmacs-UTF-2000. (mime-unified-character-face): Likewise. (mime-character-unification-limit-size): Likewise. (decode-mime-charset-region-with-iso646-unification): Likewise. 1999-09-09 Katsumi Yamaoka * tinycustom.el (defface): Allow `type' in SPEC; enrich doc string. 1999-09-08 Katsumi Yamaoka * tinycustom.el (frame-background-mode): New variable. * poe.el (frame-background-mode): Move to tinycustom.el. 1999-09-03 Katsumi Yamaoka * tinycustom.el (defface): Set the face attributes according to SPEC. * poe.el (frame-background-mode): New variable. 1999-09-02 MORIOKA Tomohiko * poe.el: Delete autoload setting for `filename'. (convert-standard-filename): Require `filename'. 1999-09-02 Katsumi Yamaoka * poe.el (convert-standard-filename): Rearrange. 1999-09-01 Katsumi Yamaoka * poe.el (convert-standard-filename): New function. 1999-08-27 MORIOKA Tomohiko * install.el (emacs-major-version): Deleted. (emacs-minor-version): Deleted. * path-util.el: Require `poe'. [cf. ] 1999-08-27 Katsumi Yamaoka * install.el: Require `poe'. * path-util.el (directory-files): Don't redefine. 1999-08-26 Katsumi Yamaoka * path-util.el (directory-files): Emulate as Emacs 19 or later to accept the optional fourth argument for old Emacsen. It is needed here for compiling other packages. * APEL-ELS (apel-modules): Add `time-stamp' if Emacs version is less than 19.16. * time-stamp.el: New file imported from Emacs 19.28. 1999-08-26 Katsumi Yamaoka * tinycustom.el (defface): Quote the argument of `make-face'. 1999-08-25 Katsumi Yamaoka * APEL-CFG: Don't provide `emu'; add the latest path of "custom" to `load-path'. 1999-08-25 MORIOKA Tomohiko * install.el: Don't require `emu'. (emacs-major-version): New variable [for old emacsen]. (emacs-minor-version): New variable [for old emacsen]. 1999-08-25 MORIOKA Tomohiko * poe-18.el (inline): New implementation using `defmacro'. 1999-08-24 MORIOKA Tomohiko * APEL: Version 9.21 released. 1999-08-24 Taiji Can * poem-nemacs.el: Use `char-width' instead of `char-columns'. 1999-08-24 MORIOKA Tomohiko * poe-18.el (inline): Use `defalias' instead of `defalias-maybe'. 1999-08-21 Mikio Nakajima * poe.el (rassoc): Just ignore elements of LIST that are not conse cell and add doc string according to its features. 1999-08-20 Yuuichi Teranishi * poe-18.el (delete): Return nil when argument 'list' is nil. 1999-08-17 Yoshiki Hayashi * README.en, README.ja (Anonymous FTP): New section. * README.ja (CVS): Translate. 1999-07-06 MORIOKA Tomohiko * APEL: Version 9.20 released. 1999-06-27 OKUNISHI Fujikazu * EMU-ELS: Install env.el for v18. 1999-06-25 Katsumi Yamaoka * poem-xm.el (split-char): Don't redefine for the recent XEmacs. 1999-06-23 Shuhei KOBAYASHI * poe.el (defun-maybe, defmacro-maybe, defalias-maybe, defsubst-maybe, defun-maybe-cond, defmacro-maybe-cond): Set `current-load-list' explicitly. 1999-06-22 Shuhei KOBAYASHI * atype.el: Require 'poe. * mule-caesar.el: Require 'poe and 'poem. * filename.el: Require 'poe and 'poem. Don't require 'cl. (filename-special-filter): Eliminate `assoc-if'. 1999-06-22 Shuhei KOBAYASHI * install.el: Require 'emu for backward compatibility. (defun-maybe): New macro; imported from poe.el. (make-directory-internal, make-directory): New functions; imported from poe-18.el. * APEL-CFG: Provide 'emu to prevent install.el from loading emu while compiling APEL itself. 1999-06-20 Shuhei KOBAYASHI * install.el: Require 'poe instead of 'emu. (install-prefix): Don't use `running-emacs-18' or `running-xemacs'. (install-detect-elisp-directory): Eliminate local variable `dir'. Don't use `running-emacs-19_29-or-later' or `running-xemacs'. * mcs-20.el: Require 'pcustom instead of 'custom. * EMU-ELS: Don't use `running-emacs-19_29-or-later' or `running-xemacs-19_14-or-later.' 1999-06-18 Tanaka Akira * static.el (static-condition-case): Wrap lambda expression by `function'. * calist.el (calist-default-field-match-method): Use `function' instead of #'. 1999-06-17 Shuhei KOBAYASHI * pcustom.el: Load "custom" anyway. 1999-06-16 Katsumi Yamaoka * static.el (static-cond): New macro. 1999-06-11 Tanaka Akira * static.el (static-defconst): New macro. 1999-06-04 MORIOKA Tomohiko * pces-xfc.el (insert-file-contents-literally-treats-binary): New facility. (insert-file-contents-literally-treats-file-name-handler): New facility. (insert-file-contents-as-binary): Define as an alias for `insert-file-contents-literally' if it is not broken. 1999-06-04 MORIOKA Tomohiko * EMU-ELS (pces-modules): New variable. * poem.el: Require pces.el. * pces.el: New module. * poem-xfc.el: Deleted. * pces-xfc.el: New module. * pces-nemacs.el: New module. * poem-nemacs.el: Split off features about coding-system to pces-nemacs.el. * pces-om.el: New module. * poem-om.el: Split off features about coding-system to pces-om.el. * pces-raw.el: New module. * poem-ltn1.el: Split off features about coding-system to pces-raw.el. * pces-xm.el: New module. * poem-xm.el: Split off features about coding-system to pces-xm.el. * pces-e20_2.el: New module. * poem-e20_2.el: Split off features about coding-system to pces-e20_2.el. * pces-e20.el: New module. * poem-e20.el (find-coding-system): Moved to pces-e20.el. (set-process-input-coding-system): Likewise. - Don't require `poem-20'. * pces-20.el: New module [renamed from poem-20.el]. 1999-05-31 MORIOKA Tomohiko * calist.el (calist-field-match-method): Fix problem when `field-type' is a string. 1999-05-27 MORIOKA Tomohiko * calist.el (use-calist-package): New function. (make-calist-package): Add new optional argument `use'. 1999-05-27 MORIOKA Tomohiko * calist.el (calist-package-alist): New variable. (make-calist-package): New function. (find-calist-package): New function. (in-calist-package): New function. (standard): New calist package. (calist-field-match-method): Use method for `t' as a default method; set up `calist-default-field-match-method' as method for `t' of `standard' package. 1999-05-26 MORIOKA Tomohiko * APEL: Version 9.19 released. 1999-05-25 Shuhei KOBAYASHI * poe.el: Do not try to require 'edebug; it will be autoloaded. 1999-05-24 Shuhei KOBAYASHI * poem-om.el (char-before, char-after): Moved to poe.el. * poe.el (char-before, char-after): Moved from poem-om.el. Add definition for non-Mule. 1999-05-24 MORIOKA Tomohiko * poe.el (def-edebug-spec): New macro. (defun-maybe): Use `def-edebug-spec'. (defmacro-maybe): Likewise. (defsubst-maybe): Likewise. (read-string): Use `static-unless'. 1999-05-21 Shuhei KOBAYASHI * README.en: Add description of localhook.el. * README.ja: Ditto. * Makefile (GOMI): New variable. (clean): Use `RM' and `GOMI'. 1999-05-21 MORIOKA Tomohiko * mcs-20.el (detect-mime-charset-region): Use `find-mime-charset-by-charsets'. * mcharset.el (find-mime-charset-by-charsets): New function. 1999-05-21 MORIOKA Tomohiko * mcharset.el: Require pcustom. (default-mime-charset-for-write): New variable [moved from mcs-20.el]. (default-mime-charset-detect-method-for-write): Likewise. * mcs-20.el (default-mime-charset-for-write): Abolished [moved to mcharset.el]. (default-mime-charset-detect-method-for-write): Likewise. * EMU-ELS: Don't install `localhook' for XEmacs. 1999-05-19 MORIOKA Tomohiko * mcs-20.el (mime-charset-to-coding-system): Don't use `defsubst' to avoid problem in XEmacs binary distributions. 1999-05-17 Shuhei KOBAYASHI * poe-18.el (eval-when-compile, eval-and-compile): Reverted. 1999-05-16 Shuhei KOBAYASHI * pcustom.el (toplevel): Require 'poe. 1999-05-16 Shuhei KOBAYASHI * localhook.el (toplevel): Move provide to the top to avoid circular dependency. 1999-05-16 Shuhei KOBAYASHI * poe-18.el (inline): New alias for `progn'. (make-obsolete-variable): New function. (dont-compile): New macro. 1999-05-16 Shuhei KOBAYASHI * poe.el (subr-fboundp): Use `defun' instead of `defsubst'. 1999-05-16 Shuhei KOBAYASHI * poem-om.el (insert-binary-file-contents-literally): Removed, since provided by emu.el. (char-before, char-after): Use `fboundp', not `boundp'. Use error-conditions directly. 1999-05-15 Shuhei KOBAYASHI * poe.el (path-separator): Doc sync with 20.3. (add-to-list): Ditto. (buffer-live-p): Return bool value. (cadr, cdar, cddr): New functions. (save-current-buffer): Check whether `orig-buffer' is alive. (functionp): Sync with 20.3; use `car-safe'. (line-beginning-position, line-end-position): Use `forward-line' or `end-of-line' only. (point-at-bol, point-at-eol): Ditto. 1999-05-15 Shuhei KOBAYASHI * localhook.el: New file; local hook variable support. * poe.el (add-hook, remove-hook, make-local-hook): Removed; require 'localhook instead. * poe-18.el: (default-boundp): New function. * EMU-ELS: Added localhook. 1999-05-14 Shuhei KOBAYASHI * pcustom.el: Rewrite using static.el. * tinycustom.el (defface): Use `defmacro-maybe-cond'. * EMU-ELS: Compilation order of tinycustom and pcustom was changed. 1999-05-14 Shuhei KOBAYASHI * poe-18.el: Require 'poe. Move provide to the top to avoid circular dependency. (eval-when-compile, eval-and-compile): Modified for old compiler. (defsubst): Moved from poe.el. (make-obsolete): Do nothing. * poe.el (read-string): Don't use `eval-and-compile'. 1999-05-14 Shuhei KOBAYASHI * poe.el (defmacro-maybe-cond): New macro. (defun-maybe, defmacro-maybe, defsubst-maybe, defalias-maybe, defvar-maybe, defconst-maybe, defun-maybe-cond): Return NAME. (defun-maybe, defmacro-maybe, defsubst-maybe): Put edebug spec. (defsubst): Moved to poe-18.el. 1999-05-13 Tanaka Akira * pccl-om.el: pccl-om.el does not support Mule 1.*. 1999-05-10 Daiki Ueno * tinycustom.el (define-widget): Accept the optional arguments. 1999-05-08 Tanaka Akira * README.en (What's APEL?): Add notice for static.el. * README.ja: Ditto. 1999-05-08 MORIOKA Tomohiko * APEL: Version 9.18 released. 1999-05-08 MORIOKA Tomohiko * mcs-e20.el: Don't require `poem'. * mcs-e20.el: Check coding-system `x-ctext' is not defined by APEL. 1999-05-08 MORIOKA Tomohiko * mcs-e20.el: Fix checking code about coding-system `x-ctext' [cf. by akr] 1999-05-07 MORIOKA Tomohiko * APEL: Version 9.17 released. 1999-05-07 MORIOKA Tomohiko * mcs-e20.el: Check coding-system `x-ctext' is not defined. 1999-05-07 MORIOKA Tomohiko * poe-18.el (eval-when-compile): New macro. * poe.el (make-local-hook): Use `defun-maybe' directly. * poe.el (add-hook): Use `static-condition-case' instead of `condition-case'; use `defun-maybe' instead of `defun'. (remove-hook): Likewise. 1999-04-22 MORIOKA Tomohiko * poe.el (caar): New function. 1999-04-13 Tanaka Akira * mcs-e20.el (x-ctext): Use the definition in Emacs 20.4. 1999-04-11 Tanaka Akira * mcs-e20.el (x-ctext): Define coding system `x-ctext' if `ctext' is not proper for decoding `iso-2022-jp-2'. 1999-04-09 Tanaka Akira * static.el: Add doc-strings. 1999-04-09 Tanaka Akira * EMU-ELS (emu-modules): Add `static'. * static.el: New file. * broken.el: New implementation using `static'. 1999-04-09 MORIOKA Tomohiko * EMU-ELS (poem-modules): Add `poem-xfc' if file-coding feature is available in a XEmacs-without-MULE. 1999-04-09 Andy Piper * poem.el: use poem-xfc when we have XEmacs with file coding. * poem-xfc.el: new file for file coding based XEmacs. 1999-04-08 MORIOKA Tomohiko * APEL: Version 9.16 released. 1999-04-05 Shuhei KOBAYASHI * install.el (install-prefix): Check whether `system-configuration-options' is defined or not before using it. * poe-18.el (add-hook, remove-hook): Moved to poe.el. * poe.el (add-hook, remove-hook): Accept optional `local' arg. (add-local-hook, remove-local-hook): Removed. * tinycustom.el (defface): Make face if 'faces is provided. 1999-03-27 Shuhei KOBAYASHI * pcustom.el: New implementation using broken.el. 1999-03-14 Shuhei KOBAYASHI * APEL-MK (compile-apel, what-where-apel): Use `load-file' to ensure that EMU_ELS in the current directory is loaded. 1999-03-11 Shuhei KOBAYASHI * emu.el (code-convert-string, code-convert-region, insert-binary-file-contents): Doc fix. 1999-03-16 Mikio Nakajima * README.en, README.ja: Add description of pcustom and tinycustom. 1999-03-27 MORIOKA Tomohiko * tinycustom.el: Delete RCS keywords. 1999-03-24 Mikio Nakajima * poe.el (make-local-hook): Move to after defining `add-local-hook' and `remove-local-hook'. 1999-03-20 Mikio Nakajima * tinycustom.el (define-widget): New nop macro. (defface): Makes face FACE. 1999-03-25 Keiichi Suzuki * poem.el (charset-after): New function. 1999-03-16 MORIOKA Tomohiko * APEL: Version 9.15 released. 1999-03-16 MORIOKA Tomohiko * poe.el (defun-maybe-cond): Don't use `unless'. 1999-03-16 MORIOKA Tomohiko * EMU-ELS (pcustom-modules): New variable. (emu-modules): Add `pcustom-modules'. 1999-03-13 Mikio Nakajima * tinycustom.el: New file. * pcustom.el: Likewise. 1999-03-15 MORIOKA Tomohiko * APEL: Version 9.14 released. 1999-03-11 MORIOKA Tomohiko * mcs-e20.el (charsets-mime-charset-alist): Add setting for `tis-620'. * mcs-20.el (mime-charset-coding-system-alist): Add `tis-620' and `windows-874'. 1999-03-08 SL Baur * poem-ltn1.el (find-file-noselect-as-raw-text): Quote. (find-file-noselect-as-raw-text-CRLF): Ditto. 1999-03-08 SL Baur * mcs-xm.el (decode-mime-charset-region-with-iso646-unification): Respect passed in boundaries. From MORIOKA Tomohiko 1999-03-08 SL Baur * poe.el (poe): Move provide to the top to avoid circular dependency. * poe-xemacs.el: Explicitly require poe when bytecompiling. * poem-xm.el: Ditto. * poem-ltn1.el:Ditto. 1999-02-27 MORIOKA Tomohiko * APEL: Version 9.13 released. 1999-02-27 MORIOKA Tomohiko * Makefile (package): New target. (install-package): Depend on `package'. * APEL-MK (install-update-package-files): New function. (config-apel-package): Load "EMU-ELS". (compile-apel-package): New function. (install-apel-package): Don't compile modules; use function `install-update-package-files'. 1999-02-26 MORIOKA Tomohiko * APEL-MK (install-just-print-p): Modify for special option of GNU make. 1999-02-26 MORIOKA Tomohiko * APEL-MK (install-just-print-p): New function. (install-apel): Use `install-just-print-p'. (install-apel-package): Likewise. 1999-02-25 MORIOKA Tomohiko * Makefile (install): Add voodoo comment `# $(MAKE)'. (install-package): Likewise. * APEL-MK (install-apel): Run installer with `just-print' mode if environment variable "MAKEFLAGS" matches "^[^ =]*n" option. (install-apel-package): Likewise. 1999-02-21 Mikio Nakajima * install.el (install-file): New optional argument JUST-PRINT. (install-files): Likewise. (install-elisp-module): Likewise. (install-elisp-modules): Likewise. 1999-02-18 Keiichi Suzuki * mcs-e20.el (coding-system-get): New function. (mime-charset-list): Fix for Emacs 20.2. 1999-02-14 Katsumi Yamaoka * mcs-om.el (default-mime-charset-for-write): Delete the remaining arguments for `defcustom'. 1999-02-13 Tanaka Akira * mcs-e20.el (charsets-mime-charset-alist): Don't set up `iso-2022-int-1' in default. 1999-02-11 Tanaka Akira * README.en, README.ja, pccl.el: pccl does not support Mule 1.x. * pccl-20.el: Update broken facility message with Emacs version it fixes. 1999-02-07 MORIOKA Tomohiko * install.el (install-prefix): Modify for Meadow. 1999-01-26 MORIOKA Tomohiko * mcs-20.el (mime-charset-to-coding-system-default-method): New user option. (mime-charset-to-coding-system): Call `mime-charset-to-coding-system-default-method' if suitable coding-system is not found. 1999-01-21 Keiichi Suzuki * mcs-xm.el (encode-mime-charset-region): Add new optional argument `lbt'. (encode-mime-charset-string): Ditto. * mcs-nemacs.el (lbt-to-string): New inline function. (encode-mime-charset-region): Add new optional argument `lbt'. (encode-mime-charset-string): Ditto. * mcs-ltn1.el (lbt-to-string): New inline function. (encode-mime-charset-region): Add new optional argument `lbt'. (encode-mime-charset-string): Ditto. (decode-mime-charset-region): Use `lbt-to-string'. * mcs-e20.el (encode-mime-charset-region): Add new optional argument `lbt'. (encode-mime-charset-string): Ditto. * mcs-om.el (lbt-to-string): New inline function. (encode-mime-charset-region): Add new optional argument `lbt'. (encode-mime-charset-string): Ditto. (decode-mime-charset-region): Use `lbt-to-string'. (decode-mime-charset-string): Ditto. 1998-12-24 MORIOKA Tomohiko * mcs-om.el (default-mime-charset-for-write): New variable. (detect-mime-charset-region): Return `default-mime-charset-for-write' if suitable mime-charset is not found. * mcs-20.el (detect-mime-charset-region): Don't call `default-mime-charset-detect-method-for-write' if suitable mime-charset is found. * mcharset.el (charsets-to-mime-charset): Return nil if suitable mime-charset is not found; abolish optional argument `default'. 1998-12-23 MORIOKA Tomohiko * mcs-xm.el (charsets-mime-charset-alist): Don't set up `iso-2022-int-1' in default. * mcs-20.el (default-mime-charset-for-write): New user option. (default-mime-charset-detect-method-for-write): New user option. (detect-mime-charset-region): Refer `default-mime-charset-detect-method-for-write' or `default-mime-charset-for-write' if suitable mime-charset is not found. * mcharset.el (charsets-to-mime-charset): Add new optional argument `default'. 1999-02-26 Katsumi Yamaoka * poem-nemacs.el (find-file-noselect-as-coding-system): Bind `default-kanji-fileio-code' to specified coding system instead of the use of `kanji-fileio-code'; bind `kanji-fileio-code' to nil. (find-file-noselect-as-raw-text): Revert buffer if the file is newer than the buffer. (as-binary-input-file): Bind `default-kanji-flag' to nil. * poem-20.el (find-file-noselect-as-binary): Bug fix - use `coding-system-for-read' instead of `coding-system-for-write'. 1999-02-25 Katsumi Yamaoka * poem-om.el (find-file-noselect-as-raw-text-CRLF): New function. It is an alias for `find-file-noselect-as-raw-text'. (insert-file-contents-as-raw-text-CRLF): New function. It is an alias for `insert-file-contents-as-raw-text'. * poem-nemacs.el (find-file-noselect-as-raw-text-CRLF): New function. It is an alias for `find-file-noselect-as-raw-text'. (find-file-noselect-as-raw-text): Convert line-break code from CRLF to LF. (insert-file-contents-as-raw-text-CRLF): New function. It is an alias for `insert-file-contents-as-raw-text'. (insert-file-contents-as-raw-text): Convert line-break code from CRLF to LF. (find-file-noselect-as-binary): Don't specify the optional third argument `rawfile' for `find-file-noselect'. * poem-ltn1.el (find-file-noselect-as-raw-text-CRLF): New function. It is an alias for `find-file-noselect'. (insert-file-contents-as-raw-text-CRLF): New function. It is an alias for `insert-file-contents'. * poem-20.el, poem-e20_2.el (find-file-noselect-as-raw-text-CRLF): New function. (insert-file-contents-as-raw-text-CRLF): New function. 1999-02-25 Katsumi Yamaoka * poem-20.el, poem-e20_2.el, poem-om.el (find-file-noselect-as-raw-text): Undo the last change. (insert-file-contents-as-raw-text): Likewise. 1999-02-25 Katsumi Yamaoka * poem-20.el, poem-e20_2.el, poem-om.el (find-file-noselect-as-raw-text): Use `raw-text-dos' instead of `raw-text'. (insert-file-contents-as-raw-text): Likewise. 1999-02-14 Katsumi Yamaoka * mcs-om.el (TopLevel): Don't refer to `running-emacs-19_29-or-later', use `emacs-major-version' and `emacs-minor-version' instead. 1999-02-14 MORIOKA Tomohiko * poe.el (file-name-sans-extension): New function . 1999-02-04 Katsumi Yamaoka * poem-20.el, poem-ltn1.el, poem-nemacs.el, poem-om.el (save-buffer-as-binary): New function. (save-buffer-as-raw-text-CRLF): New function. (save-buffer-as-coding-system): New function. * poem-om.el (poem-ccl-decode-raw-text): Rewrite again for plural `CR's. 1999-02-04 Katsumi Yamaoka * poem-om.el (poem-ccl-decode-raw-text): Rewrite for fixing a bug that the last datum will be missed if the input data is not ended with `CRLF'. (poem-ccl-encode-raw-text-CRLF): Use `read-if'. 1998-12-24 MORIOKA Tomohiko * install.el (install-detect-elisp-directory): Avoid problem if prefix of an emacs has its version. 1998-12-22 MORIOKA Tomohiko * APEL: Version 9.12 was released. 1998-12-20 MORIOKA Tomohiko * mcs-om.el: Avoid error when cyrillic.el is not found. 1998-12-19 MORIOKA Tomohiko * poem-xm.el: Define coding-system `gb2312-dos', `gb2312-mac' and `gb2312-unix' if it is not found. 1998-12-18 Katsumi Yamaoka * poem-om.el (poem-ccl-decode-raw-text): Renamed from `ccl-decode-raw-text'. (poem-ccl-encode-raw-text): Renamed from `ccl-encode-raw-text'. (poem-ccl-encode-raw-text-CRLF): Renamed from `ccl-encode-raw-text-CRLF`. 1998-12-17 MORIOKA Tomohiko * poem-om.el (poem-decode-raw-text): New function for MULE 1. (poem-encode-raw-text-CRLF): Likewise. (raw-text): New coding-system for MULE 1. (raw-text-dos): Likewise. (insert-file-contents-as-raw-text): Share implementation. (write-region-as-raw-text-CRLF): Likewise. (find-file-noselect-as-raw-text): Likewise. 1998-12-17 MORIOKA Tomohiko * poem-om.el: Share definition of coding-system `binary'. (write-region-as-binary): Share implementation. (find-file-noselect-as-binary): Likewise. 1998-12-16 MORIOKA Tomohiko * poem-om.el (insert-file-contents-as-binary): Share implementation. 1998-12-16 Katsumi Yamaoka * poem-om.el (find-file-noselect-as-raw-text): Use `find-file-noselect-as-coding-system' under Mule 2.*. (find-file-noselect-as-binary): Likewise. (insert-file-contents-as-raw-text): Use `insert-file-contents-as-coding-system' under Mule 2.*. (insert-file-contents-as-binary): Likewise. (write-region-as-raw-text-CRLF): Use `write-region-as-coding-system' under Mule 2.*. (write-region-as-binary): Likewise. (truncate-string): Use `defun-maybe'. (toplevel): Don't refer to `running-emacs-19_29-or-later', use `emacs-major-version' and `emacs-minor-version' instead. 1998-12-16 Katsumi Yamaoka * pccl-om.el (toplevel): Don't require `poem'. Use `code-convert-string' instead of `encode-coding-string' or `decode-coding-string'. * poem-om.el (binary): EMACS 20 emulating coding-system for Mule 2.3 based on Emacs 19.[28-34]. (raw-text): EMACS 20 emulating coding-system based on native CCL for Mule 2.3 based on Emacs 19.[28-34]. (raw-text-dos): Likewise. (find-file-noselect-as-binary): Separate for some Mules. 1998-12-15 Tanaka Akira * pccl-20.el: Do not require 'poem. 1998-12-14 Katsumi Yamaoka * poem-20.el, poem-e20_2.el, poem-ltn1.el, poem-nemacs.el, poem-om.el (find-file-noselect-as-coding-system): Be CODING-SYSTEM the 1st arg. (insert-file-contents-as-coding-system): Likewise. * poem-20.el, poem-ltn1.el, poem-nemacs.el, poem-om.el (write-region-as-coding-system): Likewise. 1998-12-14 Katsumi Yamaoka * poem-20.el, poem-e20_2.el, poem-ltn1.el, poem-nemacs.el, poem-om.el (find-file-noselect-as-coding-system): Renamed from `find-file-noselect-as-specified-coding-system'. * poem-e20_2.el (insert-file-contents-as-coding-system): Renamed from `insert-file-contents-as-specified-coding-system'. * poem-20.el, poem-ltn1.el, poem-nemacs.el, poem-om.el (write-region-as-coding-system): Renamed from `write-region-as-specified-coding-system'. (insert-file-contents-as-coding-system): Renamed from `insert-file-contents-as-specified-coding-system'. 1998-12-09 Katsumi Yamaoka * poem-20.el, poem-e20_2.el, poem-ltn1.el, poem-nemacs.el, poem-om.el (find-file-noselect-as-binary): New function. (find-file-noselect-as-raw-text): New function. (find-file-noselect-as-specified-coding-system): New function. * poem-nemacs.el (insert-file-contents-as-binary): Call `insert-file-contents' with only two args - FILENAME and VISIT. (insert-file-contents-as-raw-text): Likewise. (insert-file-contents-as-specified-coding-system): Likewise. 1998-12-09 Yuuichi Teranishi * poe-18.el (make-directory-internal): Rewrite. 1998-12-08 Katsumi Yamaoka * poem-20.el (write-region-as-binary): Bind `jam-zcat-filename-list' with nil. * poem-xm.el (insert-file-contents-as-binary): Likewise. * poem.el: Require `tcp' if the function `open-network-stream' does not exist. 1998-12-04 Katsumi Yamaoka * poem-20.el, poem-ltn1.el, poem-nemacs.el, poem-om.el (open-network-stream-as-binary): New function. * poem-e20_2.el (insert-file-contents-as-specified-coding-system): New function. * poem-20.el, poem-ltn1.el, poem-nemacs.el, poem-om.el (write-region-as-specified-coding-system): New function. (insert-file-contents-as-specified-coding-system): New function. 1998-12-01 MORIOKA Tomohiko * poem-xm.el: If coding-system `iso-2022-jp-dos' 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-dos' to `iso-2022-jp-dos' to avoid this problem. 1998-11-17 Kazuhiro Ohta * README.en, README.ja (add-latest-path): Fix typo. 1998-11-14 MORIOKA Tomohiko * APEL: Version 9.11 was released. * poem-ltn1.el (char-charset): Fix typo. 1998-11-13 Tanaka Akira * broken.el: require 'poe. 1998-11-13 Tanaka Akira * pccl.el: Enclose mule depended process by `unless-broken'. 1998-11-13 MORIOKA Tomohiko * poe.el (defun-maybe-cond): fixed problem in Emacs 18. * poe.el (defsubst): Moved from poe-18.el. * poe-18.el: Move macro `defsubst' to poe.el. 1998-11-13 MORIOKA Tomohiko * APEL: Version 9.10 was released. 1998-11-13 Tanaka Akira * pccl.el (define-ccl-program): Adviced. 1998-11-12 Tanaka Akira * pccl-om.el (ccl-cascading-read): New facility. 1998-11-10 Tanaka Akira * EMU-ELS (emu-modules): Always install 'pccl. * broken.el: Use 19.28 style quasi-quote. * pccl.el: - require 'broken. - Does not require 'pccl-20 for XEmacs 20. (ccl-usable): New facility. 1998-11-10 Tanaka Akira * README.en, README.ja, pccl-20.el: Note that pccl-20 is not for XEmacs 20. 1998-11-08 MORIOKA Tomohiko * poe-18.el (eval-and-compile): Moved from poe.el. * poe.el: Move `eval-and-compile' to poe-18.el. * poe-xemacs.el (overlayp): New alias. (delete-overlay): New alias. 1998-11-07 MORIOKA Tomohiko * APEL: Version 9.9 was released. 1998-11-06 MORIOKA Tomohiko * poe.el (combine-after-change-calls): fixed. 1998-10-31 Mikio Nakajima * poe.el (combine-after-change-calls): New macro. 1998-10-28 MORIOKA Tomohiko * poe.el (defun-maybe-cond): New macro. (next-command-event): Use `defun-maybe-cond'. (cancel-undo-boundary): Use `defun-maybe-cond'. 1998-10-28 Katsumi Yamaoka * poem-om.el (char-after): Redefine to change `POS' to optional argument. 1998-10-27 MORIOKA Tomohiko * APEL: Version 9.8 was released. * README.ja, README.en (CVS): New section. 1998-10-27 Mikio Nakajima * poem-om.el (char-before): Redefine to change `POS' to optional argument. 1998-10-27 MORIOKA Tomohiko * poe.el (subr-fboundp): New function. (next-command-event): New function. (character-to-event): New function. 1998-10-25 Mikio Nakajima * poe.el (event-to-character): New function. 1998-10-27 MORIOKA Tomohiko * poe.el (cancel-undo-boundary): Switch definition by existence of variable `buffer-undo-list'. * poe-18.el: Move function `cancel-undo-boundary' to poe.el. 1998-10-25 Mikio Nakajima * poe.el (cancel-undo-boundary): New function. 1998-10-27 MORIOKA Tomohiko * poe-18.el (cancel-undo-boundary): New function (moved from poem.el). * poem.el: Move function `cancel-undo-boundary' to poe-18.el. 1998-10-26 MORIOKA Tomohiko * APEL: Version 9.7 was released. 1998-10-26 MORIOKA Tomohiko * poem.el (cancel-undo-boundary): New function. 1998-10-26 MORIOKA Tomohiko * poe-xemacs.el (set-cursor-color): Add interactive spec; add DOC-string. 1998-10-25 Mikio Nakajima * poe-xemacs.el (set-cursor-color): New function. 1998-10-26 MORIOKA Tomohiko * README.ja: Sync up with latest README.en. 1998-10-26 MORIOKA Tomohiko * poe.el (remove-local-hook): Use `defmacro-maybe'. 1998-10-26 Mikio Nakajima * poe.el (add-local-hook): fixed. (remove-local-hook): fixed. 1998-10-26 MORIOKA Tomohiko * APEL: Version 9.6 was released. 1998-10-25 MORIOKA Tomohiko * poe.el (rassoc): New function. 1998-10-25 MORIOKA Tomohiko * poe-xemacs.el (eval-after-load): New function. * poem-e20_3.el (characterp): New alias. * poem.el (characterp): New alias. (char-octet): New function. 1998-10-25 Mikio Nakajima * poe.el (make-local-hook): New macro. (add-local-hook): New macro. (remove-local-hook): New macro. 1998-10-25 MORIOKA Tomohiko * poem.el, poem-20.el, poem-e20_3.el, poem-e20.el, poem-xm.el: Add setting of byte-compile-dynamic. * poem-xm.el (string-to-int-list): Use `defun-maybe'. * poem.el (string-as-unibyte): Use `defsubst-maybe' instead of `defmacro-maybe'. (string-as-multibyte): Likewise. (char-int): Use `defalias-maybe'. (int-char): Likewise. (char-or-char-int-p): Likewise. 1998-10-25 MORIOKA Tomohiko * poe.el, poe-xemacs.el: Add setting of byte-compile-dynamic. 1998-10-25 MORIOKA Tomohiko * poe-18.el (data-directory): Use `defvar-maybe'. (buffer-undo-list): Likewise. * poe-xemacs.el (face-list): Use `defalias-maybe'. (line-beginning-position): Likewise. (line-end-position): Likewise. * poe.el (defalias-maybe): New macro. * poe-xemacs.el (dired-other-frame): Use `defun-maybe'. 1998-10-24 MORIOKA Tomohiko * poe.el (defvar-maybe): New macro. (temporary-file-directory): New variable. 1998-10-23 MORIOKA Tomohiko * APEL: Version 9.5 was released. 1998-10-22 Yoshiki Hayashi * README.ja: New file. 1998-10-20 MORIOKA Tomohiko * alist.el: Add autoload cookies. 1998-10-20 MORIOKA Tomohiko * poe.el, EMU-ELS, README.en: Move `find-face' from poe-19.el to poe.el; abolish poe-19.el. 1998-10-20 MORIOKA Tomohiko * invisible.el, inv-18.el, inv-19.el, inv-xemacs.el, poe-18.el, poe-19.el, poe-xemacs.el, emu.el, EMU-ELS, README.en: Separate invisible features from poe to invisible. 1998-10-20 MORIOKA Tomohiko * poe.el (eval-and-compile): New macro. Enclose redefinition of `read-string' by `eval-and-compile'. 1998-10-20 MORIOKA Tomohiko * poe.el (string): New function. 1998-10-19 MORIOKA Tomohiko * emu.el (char-list-to-string): New function. * poe-xemacs.el, poe-19.el: Abolish macro `char-list-to-string'. * poe-18.el: Abolish function `char-list-to-string'. 1998-10-18 Tanaka Akira * broken.el (check-broken-facility): Also use compile time description. 1998-10-18 MORIOKA Tomohiko * APEL: Version 9.4 was released. 1998-10-17 Tanaka Akira * broken.el (check-broken-facility): New macro. 1998-10-16 MORIOKA Tomohiko * poe.el (define-obsolete-function-alias): New function. 1998-10-12 MORIOKA Tomohiko * APEL: Version 9.3 was released. 1998-10-12 Katsumi Yamaoka * 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 * README.en (load-path): Modify for Emacs 20.3. 1998-10-11 MORIOKA Tomohiko * 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. 1998-10-10 MORIOKA Tomohiko * 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. 1998-10-07 MORIOKA Tomohiko * APEL: Version 9.1 was released. 1998-10-06 MORIOKA Tomohiko * 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 * 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. 1998-09-22 MORIOKA Tomohiko * APEL: Version 9.0 was released. * Delete EMU-CFG and EMU-MK because they have not been used. 1998-09-22 Tanaka Akira * README.en (What's APEL?): Add notice for broken.el. 1998-09-22 MORIOKA Tomohiko * README.en (What's APEL?): Modify for latest structure. 1998-09-20 MORIOKA Tomohiko * mcs-xm.el (charsets-mime-charset-alist): Comment out invalid definition for iso-2022-int-1. 1998-09-19 Tanaka Akira * 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 * pccl.el (apel-broken-facility): New function. (apel-broken-p): New function. 1998-09-18 Tanaka Akira * pccl.el: Fix author. 1998-09-17 Katsumi Yamaoka * pccl-om.el (make-ccl-coding-system): Enclose with `eval-and-compile'. 1998-09-17 MORIOKA Tomohiko * 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 * 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 * EMU-ELS: New implementation. 1998-09-17 MORIOKA Tomohiko * 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 * 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 * 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 * 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 * 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 * mcharset.el, emu.el: Move function `charsets-to-mime-charset' from emu.el to mcharset.el. 1998-09-17 MORIOKA Tomohiko * 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 * poe-18.el (make-obsolete): New function. 1998-09-17 MORIOKA Tomohiko * 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 * emu.el, emu-20.el: Move constant `*noconv*' from emu-20.el to emu.el. 1998-09-17 MORIOKA Tomohiko * 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 * poe.el, emu.el: Move function `point-at-bol' and `point-at-eol' from emu.el to poe.el. 1998-09-17 MORIOKA Tomohiko * emu.el (point-at-bol): New function. (point-at-eol): Use `line-end-position'. 1998-09-17 MORIOKA Tomohiko * 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 * poe.el, emu.el: Move function `functionp' from emu.el to poe.el. 1998-09-17 MORIOKA Tomohiko * 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 * 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 * 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 * emu-x20.el (make-ccl-coding-system): New function. 1998-09-17 Katsumi Yamaoka * 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. 1998-09-14 MORIOKA Tomohiko * 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 * 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 * 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 * Makefile (elc): Ignore errors when removing emu*.elc. 1998-09-01 Tanaka Akira * emu-mule.el (ccl-execute-on-string): Fix arguments order `status' and `string'. 1998-08-31 MORIOKA Tomohiko * APEL: Version 8.17 was released. * emu.el (with-temp-file): Must use old forms. 1998-08-31 Katsumi Yamoaka * emu.el (with-temp-file): New macro (Emacs 20/XEmacs 20 emulating macro). 1998-08-29 Tanaka Akira * emu-e20.el: require 'ccl only for byte-compile time. 1998-08-29 Tanaka Akira * Makefile (elc): Remove emu*.elc to use newest emu by intall.el. 1998-08-29 Shuhei KOBAYASHI * 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 * 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 * emu-e20.el (ccl-use-symbol-as-program): Use `ccl-vector-program-execute-on-string' if it is defined. 1998-08-27 Tanaka Akira * 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 * emu-e20.el (test-ccl-eof-block-cs): Check if it is already defined. 1998-08-27 Tanaka Akira * 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 * emu-20.el (mime-charset-coding-system-alist): Add `unknown' and `x-unknown'. 1998-08-12 MORIOKA Tomohiko * emu-x20.el: Redefine coding-system `ctext' if `ctext-dos' is not found. 1998-08-12 Katsumi Yamaoka * 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 * 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 * emu-x20.el: Redefine coding-system `iso-2022-jp-2' if `iso-2022-jp-2-dos' is not found. 1998-08-11 Katsumi Yamaoka * 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 * 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 * 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 * 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 * install.el (install-detect-elisp-directory): Modify for anything older than Emacs 19.28. 1998-06-22 MORIOKA Tomohiko * APEL: Version 8.16 was released. * emu.el, emu-x20.el: Require `emu-20' in emu-x20.el. 1998-06-20 MORIOKA Tomohiko * emu-x20.el (set-buffer-multibyte): Use `defsubst-maybe' instead of `defmacro-maybe'. 1998-06-20 MORIOKA Tomohiko * 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. 1998-06-09 MORIOKA Tomohiko * 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 * emu.el (when): New macro. 1998-06-09 Katsumi Yamaoka * 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 * mule-caesar.el (mule-caesar-region): Don't compare charset with 'us-ascii. 1998-06-08 MORIOKA Tomohiko * emu-mule.el (split-char): fixed. 1998-06-08 Katsumi Yamaoka * emu-mule.el (insert-file-contents-as-binary): Use file-coding-system-for-read instead of file-coding-system. 1998-06-06 MORIOKA Tomohiko * APEL: Version 8.14 was released. 1998-06-05 MORIOKA Tomohiko * emu-mule.el, emu-latin1.el (split-char): New function. 1998-06-05 MORIOKA Tomohiko * 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 * 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 * 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 * emu-mule.el (charset-chars): New function. * mule-caesar.el (split-char): Redefine if it has bug. (char-to-octet-list): Use `split-char'. 1998-06-01 MORIOKA Tomohiko * APEL: Version 8.13 was released. * emu-x20.el (mime-character-unification-limit-size): Change default value to 2048. 1998-05-28 MORIOKA Tomohiko * emu.el (string-as-unibyte): New macro. 1998-05-17 MORIOKA Tomohiko * APEL: Version 8.12 was released. 1998-05-15 MORIOKA Tomohiko * 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 * 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 * 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. 1998-05-09 MORIOKA Tomohiko * APEL: Version 8.11 was released. 1998-05-09 MORIOKA Tomohiko * emu.el (string-as-multibyte): New macro (Emacs 20.3 emulating macro). 1998-05-07 MORIOKA Tomohiko * 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 * calist.el (ctree-add-calist-with-default): fixed. 1998-05-06 MORIOKA Tomohiko * APEL: Version 8.9 was released. 1998-05-06 MORIOKA Tomohiko * calist.el (ctree-find-calist): fixed duplicated result. 1998-05-05 MORIOKA Tomohiko * APEL: Version 8.8 was released. 1998-05-03 MORIOKA Tomohiko * calist.el (ctree-find-calist): Delete duplicated result. 1998-04-30 MORIOKA Tomohiko * APEL: Version 8.7 was released. 1998-04-29 MORIOKA Tomohiko * calist.el (ctree-match-calist-partially): New function. 1998-04-28 MORIOKA Tomohiko * APEL: Version 8.6 was released. 1998-04-27 MORIOKA Tomohiko * emu-20.el (mime-charset-coding-system-alist): Use 'raw-text for us-ascii in default setting. 1998-04-27 MORIOKA Tomohiko * calist.el (ctree-find-calist): Add optional argument 'all. 1998-04-27 MORIOKA Tomohiko * calist.el (ctree-find-calist): Renamed from 'ctree-match-calist-all. 1998-04-25 MORIOKA Tomohiko * APEL: Version 8.5 was released. 1998-04-25 MORIOKA Tomohiko * calist.el (ctree-match-calist-all): New function. 1998-04-24 MORIOKA Tomohiko * APEL-ELS: Comment out 'atype and 'file-detect. 1998-04-24 MORIOKA Tomohiko * emu-x20.el (decode-mime-charset-string): Use 'decode-mime-charset-region. 1998-04-24 MORIOKA Tomohiko * 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 * 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. 1998-04-22 MORIOKA Tomohiko * APEL: Version 8.4 was released. * EMU-ELS: Don't use HIRAGANA LETTER A ($(B$"(B) to detect character indexing (Emacs 20.3 or later). 1998-04-20 MORIOKA Tomohiko * emu-x20.el, emu-e20.el (charsets-mime-charset-alist): Add 'shift_jis. * EMU-ELS (emu-modules): fixed. 1998-04-17 MORIOKA Tomohiko * APEL: Version 8.3 was released. * README.en (What's APEL?): Modify for latest emu. 1998-04-17 MORIOKA Tomohiko * 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 * 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 * 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 * emu.el: emu-x20.el doesn't require 'emu-xemacs and 'emu-20. 1998-04-16 MORIOKA Tomohiko * 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 * 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. 1998-04-13 MORIOKA Tomohiko * 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 `/'. 1998-04-13 MORIOKA Tomohiko * APEL: Version 8.1 was released. 1998-04-11 MORIOKA Tomohiko * 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 * APEL-ELS (apel-modules): Delete 'std11 and 'std11-parse. * std11.el, std11-parse.el: Abolish std11-parse.el and std11.el (moved to RIME). 1998-04-09 MORIOKA Tomohiko * APEL: Version 8.0 was released. 1998-04-09 MORIOKA Tomohiko * 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 * 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 * emu-e20.el, emu-x20.el, emu-e19.el, emu-mule.el, emu-nemacs.el (char-next-index): New macro. 1998-03-26 MORIOKA Tomohiko * APEL: Version 7.6 was released. * std11.el: Require 'std11-parse when compile. 1998-03-25 MORIOKA Tomohiko * calist.el (ctree-match-calist): Prefer normal choice than default choice. 1998-03-25 MORIOKA Tomohiko * emu-20.el (mime-charset-coding-system-alist): Use 'defcustom. 1998-03-25 MORIOKA Tomohiko * emu-20.el: Require 'wid-edit when compile. 1998-03-25 MORIOKA Tomohiko * APEL: Version 7.5 was released. 1998-03-24 MORIOKA Tomohiko * 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'. 1998-03-23 MORIOKA Tomohiko * APEL: Version 7.4 was released. 1998-03-21 MORIOKA Tomohiko * 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 * 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 * 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. 1998-03-16 MORIOKA Tomohiko * APEL: Version 7.3 was released. 1998-03-15 MORIOKA Tomohiko * APEL-ELS: Add calist.el. * calist.el: New module. 1998-03-13 Katsumi Yamaoka * emu-mule.el (charsets-mime-charset-alist) fixed. 1998-03-13 MORIOKA Tomohiko * APEL: Version 7.2 was released. 1998-03-11 MORIOKA Tomohiko * emu-nemacs.el, emu-mule.el, emu-e19.el, emu-20.el (write-region-as-binary): New function. 1998-03-11 MORIOKA Tomohiko * emu-nemacs.el, emu-mule.el, emu-e19.el, emu-20.el (insert-binary-file-contents): New function. 1998-03-08 Shuhei KOBAYASHI * README.en (Bug reports): Modify description of tm mailing list. 1998-02-12 MORIOKA Tomohiko * APEL: Version 7.1.1 was released. * README.en (Bug reports): Modify for APEL. 1998-02-04 MORIOKA Tomohiko * 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 * 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. 1997-11-08 MORIOKA Tomohiko * APEL: Version 7.1 was released. 1997-11-06 MORIOKA Tomohiko * README.en (What's APEL?): Rename file-detect.el -> path-util.el. 1997-11-06 MORIOKA Tomohiko * install.el, filename.el (filename-filters): Use path-util.el instead of file-detect.el. * path-util.el, file-detect.el, APEL-ELS: Rename file-detect.el -> path-util.el (file name should be less than 13 bytes). 1997-11-06 MORIOKA Tomohiko * emu-19.el (tl:make-overlay): New alias. (tl:overlay-put): New alias. (tl:overlay-buffer): New alias. 1997-11-05 MORIOKA Tomohiko * APEL: Version 4.2 was released. 1997-11-05 MORIOKA Tomohiko * APEL-MK (config-apel): Regard LISPDIR. 1997-11-05 MORIOKA Tomohiko * emu-19.el (tl:make-overlay): New obsolete function (for tm-7.106). (tl:overlay-put): New obsolete function (for tm-7.106). (tl:overlay-buffer): New obsolete function (for tm-7.106). 1997-11-04 MORIOKA Tomohiko * APEL: Version 4.1 was released. * APEL-MK (compile-apel): Use `config-apel'; don't use `add-to-list' for compatibility. (install-apel): Don't call `config-apel' directly. * APEL-CFG: Add load-path setting. 1997-11-04 MORIOKA Tomohiko * emu-20.el (mime-charset-list): New inline-function. (widget-mime-charset-prompt-value-history): New variable. (mime-charset): New widget. (widget-mime-charset-prompt-value): New function. (widget-mime-charset-action): New function. (default-mime-charset): Use `defcustom'. * emu-20.el (default-mime-charset): Modify DOC-string. * emu-mule.el (charsets-mime-charset-alist): New implementation. * emu-e20.el (encode-mime-charset-region, decode-mime-charset-region, encode-mime-charset-string, decode-mime-charset-string): New function (copied from emu-20.el); check `enable-multibyte-characters'. * emu-x20.el (encode-mime-charset-region, decode-mime-charset-region, encode-mime-charset-string, decode-mime-charset-string): New function (copied from emu-20.el). * emu-20.el: Move function `encode-mime-charset-region', `decode-mime-charset-region', `encode-mime-charset-string' and `decode-mime-charset-string' to emu-x20.el and emu-e20.el. 1997-10-04 MORIOKA Tomohiko * emu-x20.el (charsets-mime-charset-alist): Use MIME charset `iso-8859-5' for cyrillic. 1997-09-26 MORIOKA Tomohiko * APEL: Version 3.4.4 was released. 1997-09-25 MORIOKA Tomohiko * std11-parse.el (std11-special-char-list): Fix order for regexp. 1997-09-25 MORIOKA Tomohiko * APEL: Version 3.4.3 was released. * README.en: Modify for Emacs 20. 1997-09-25 MORIOKA Tomohiko * std11-parse.el (std11-special-char-list): New constant; abolish `std11-special-chars'. (std11-atom-regexp): Use it. (std11-analyze-special): Use it; Don't use `find'. 1997-09-09 MORIOKA Tomohiko * APEL: Version 3.4.2 was released. * README.en (What's APEL?): Add emu-20.el. 1997-09-07 MORIOKA Tomohiko * emu-20.el (mime-charset-to-coding-system): Use defsubst again; modify implementation. * emu-20.el (mime-charset-to-coding-system): Use `find-coding-system'. * emu-20.el (mime-charset-coding-system-alist): Use `find-coding-system'. * emu-e20.el (find-coding-system): New inline function. * emu.el (defsubst-maybe): New macro. 1997-09-03 MORIOKA Tomohiko * emu-20.el (mime-charset-to-coding-system): Use `defun' instead of `defsubst'. 1997-09-02 MORIOKA Tomohiko * APEL: Version 3.4.1 was released. 1997-08-30 MAEDA Shugo * emu-mule.el (decode-coding-region, encode-coding-string): New function. (decode-coding-string): Modify DOC-string. (cf. [cmail:3366]) 1997-08-30 MORIOKA Tomohiko * emu.el (defconst-maybe): New macro. (emacs-major-version, emacs-minor-version): Use `defconst-maybe'. * emu.el (charsets-to-mime-charset): Abolish unused local variable `csl'. * emu-e20.el, emu-20.el: Move function `detect-mime-charset-region' from emu-e20.el to emu-20.el. * emu-20.el: Use `defsubst' for `{encode|decode}-mime-charset-{region|string}'. * emu-e20.el (detect-mime-charset-region): Use `find-charset-region'. 1997-08-30 MORIOKA Tomohiko * emu-x20.el, emu-e20.el, emu-20.el: Move function `{encode|decode}-mime-charset-{region|string}' from emu-e20.el and emu-x20.el to emu-20.el. * emu-x20.el, emu-e20.el, emu-20.el: Move `default-mime-charset' from emu-e20.el and emu-x20.el to emu-20.el. 1997-08-30 MORIOKA Tomohiko * emu-20.el (mime-charset-coding-system-alist): Don't use `coding-system-p' for symbol. (mime-charset-to-coding-system): Ditto; modify DOC-string. 1997-08-30 MORIOKA Tomohiko * emu-20.el (mime-charset-coding-system-alist): Check MIME charset is defined as coding-system. * emu-x20.el, emu-e20.el, emu-20.el: Move `mime-charset-coding-system-alist' from emu-e20.el and emu-x20.el to emu-20.el. * emu-20.el (*noconv*): Add DOC-string. 1997-08-30 MORIOKA Tomohiko * emu-20.el (mime-charset-to-coding-system): Check coding-system-p even if CHARSET is found in `mime-charset-coding-system-alist'. * emu-x20.el: Use function `mime-charset-to-coding-system' in emu-20.el. * emu-20.el (mime-charset-to-coding-system): Use `defsubst'. * emu-e20.el, emu-20.el: Move function `mime-charset-to-coding-system' from emu-e20.el to emu-20.el. 1997-08-30 MORIOKA Tomohiko * emu-x20.el, emu-e20.el, emu-20.el: Move features about Binary accessing from emu-e20.el and emu-x20.el to emu-20.el. * EMU-ELS (emu-modules): Add emu-20 for Emacs 20 and XEmacs/mule. 1997-08-30 MORIOKA Tomohiko * emu-x20.el (mime-charset-to-coding-system): Use `defsubst'. * emu-x20.el (default-mime-charset): Add DOC-string. (mime-charset-coding-system-alist): Add `us-ascii'. 1997-08-25 MORIOKA Tomohiko * emu-x20.el (mime-charset-coding-system-alist): iso-2022-jp-2 is defined as coding-system. 1997-07-14 MORIOKA Tomohiko * emu: Version 7.44 was released. * APEL: Version 3.4 was released. 1997-07-13 MORIOKA Tomohiko * emu-e20.el (mime-charset-coding-system-alist): `iso-2022-ss2-7' -> `iso-2022-7bit-ss2'. (for Emacs 20.0.90) 1997-07-13 MORIOKA Tomohiko * std11-parse.el (std11-parse-ascii-token): Allow non-ASCII characters in comments. 1997-06-28 MORIOKA Tomohiko * richtext.el: Add autoload comments for `richtext-encode' and `richtext-decode'. * emu.el: Check richtext.el is bundled. 1997-06-28 MORIOKA Tomohiko * file-detect.el: Add autoload comments for function `add-path', `add-latest-path', `get-latest-path', `file-installed-p', `exec-installed-p', `module-installed-p' and variable `exec-suffix-list'. 1997-06-08 MORIOKA Tomohiko * emu-x20.el (mime-charset-coding-system-alist): iso-8859-1, hz-gb-2312, cn-gb-2312, gb2312, cn-big5 and koi8-r were defined as coding-system. * emu-x20.el: Don't require cyrillic. Thu May 22 04:46:57 1997 MORIOKA Tomohiko * emu-mule.el (make-char): New alias. * emu-e20.el: Alias `make-character' was abolished. Sat May 10 19:39:12 1997 MORIOKA Tomohiko * README.en (What's APEL?): Add std11 and mule-caesar.el. 1997-05-09 MORIOKA Tomohiko * emu: Version 7.43.1 was released. * APEL: Version 3.3.2 was released. Fri May 9 01:23:44 1997 MORIOKA Tomohiko * APEL-ELS: Add mule-caesar.el. * mule-caesar.el: New file. Thu May 8 22:21:36 1997 MORIOKA Tomohiko * emu-x20.el: Use `binary' instead of `no-conversion' temporary. 1997-04-30 MORIOKA Tomohiko * emu: Version 7.43 was released. * APEL: Version 3.3.1 was released. * emu-x20.el: several changes for XEmacs 20.1-b12. Wed Apr 30 12:40:32 1997 MORIOKA Tomohiko * Makefile: add `release'. Mon Apr 28 16:47:30 1997 MORIOKA Tomohiko * Makefile: `TARFILE' was abolished. Tue Apr 8 09:47:40 1997 MORIOKA Tomohiko * emu.el (point-at-eol): New function. Sat Apr 5 16:23:23 1997 MORIOKA Tomohiko * emu-nemacs.el: `tl:available-face-attribute-alist' -> `emu:available-face-attribute-alist'. * emu-nemacs.el, emu-mule.el: `tl:make-overlay' -> `make-overlay'; `tl:overlay-put' -> `overlay-put'. Sat Apr 5 06:50:48 1997 MORIOKA Tomohiko * emu-xemacs.el: Alias `tl:make-overlay', `tl:overlay-put' and `tl:overlay-buffer' were abolished; Function `tl:move-overlay' were abolished. * emu-19.el: Alias `tl:make-overlay', `tl:overlay-put' and `tl:overlay-buffer' were abolished. * emu-18.el: `tl:overlay-buffer' -> `overlay-buffer'. * emu-xemacs.el: Require overlay. * emu.el (char-or-char-int-p): New XEmacs 20 emulating alias. * emu.el (minibuffer-prompt-width): New function for Emacs 18 and XEmacs. Thu Apr 3 17:14:39 1997 MORIOKA Tomohiko * APEL-ELS: std11.el and std11-parse.el were moved from mu/. 1997-03-20 MORIOKA Tomohiko * APEL: Version 3.3 was released. * APEL-CFG (EMU_PREFIX, EMU_DIR): New variables. * APEL-MK: install emu. Thu Mar 20 06:09:03 1997 MORIOKA Tomohiko * Makefile: Add README.en. Thu Mar 20 06:08:29 1997 MORIOKA Tomohiko * file-detect.el: Header and DOC-strings were modified. Thu Mar 20 06:03:51 1997 MORIOKA Tomohiko * README.en: New file. Thu Mar 20 05:48:02 1997 MORIOKA Tomohiko * filename.el: Add DOC-strings. * APEL-MK (install-apel): Use `compile-apel'. * Makefile (install): Don't depend on `elc'. Thu Mar 20 02:04:19 1997 MORIOKA Tomohiko * APEL-MK: Setting for load-path and requiring install were moved from APEL-CFG. (install-apel): Compile apel-modules. * APEL-CFG: Setting for load-path and requiring install were moved to APEL-MK. 1997-03-14 MORIOKA Tomohiko * APEL: Version 3.2 was released. Fri Mar 14 09:54:04 1997 MORIOKA Tomohiko * file-detect.el (get-latest-path): Check directory is exist or not. Fri Mar 14 09:25:15 1997 MORIOKA Tomohiko * APEL-ELS: Add install.el. Fri Mar 14 07:24:37 1997 MORIOKA Tomohiko * Makefile, APEL-MK, APEL-CFG: New file. 1997-03-10 MORIOKA Tomohiko * atype.el (field-unify): fixed. 1997-03-10 MORIOKA Tomohiko * filename.el (filename-filters): Use `exec-installed-p' instead of `file-installed-p' to search "kakasi". 1997-03-10 MORIOKA Tomohiko * file-detect.el (module-installed-p): Use function `exec-installed-p'. * file-detect.el (exec-suffix-list): New variable. (exec-installed-p): New function. 1997-03-04 MORIOKA Tomohiko * APEL-ELS (apel-modules): Add filename.el. * APEL-ELS: Initial revision 1997-03-04 MORIOKA Tomohiko * filename.el (filename-replacement-alist): Don't use function `string-to-char-list' and `expand-char-ranges'; Don't require tl-str. (filename-special-filter): Use function `assoc-if' instead of `ASSOC'; Require cl instead of tl-list. (poly-funcall): New inline-function; copied from tl-list.el. 1997-03-03 MORIOKA Tomohiko * atype.el: Alias `fetch-field', `fetch-field-value', `put-field' and `delete-field' were abolished. Don't require tl-str and tl-list. Require alist. (field-unify): Don't use function `symbol-concat'. (assoc-unify): Use function `assoc' directly; use function `put-alist' directly; use function `del-alist' directly. * atype.el: Function `put-fields' was abolished. * atype.el: tl-atype.el was renamed to atype.el. 1997-03-03 MORIOKA Tomohiko * atype.el: tl-atype.el was renamed to atype.el. 1997-03-03 MORIOKA Tomohiko * file-detect.el (file-installed-p): Fixed DOC-string. 1997-02-28 Tomohiko Morioka * alist.el: New module; separated from tl-list.el. apel-5bc1050/EMU-ELS000066400000000000000000000145031174656234300137640ustar00rootroot00000000000000;;; EMU-ELS --- list of EMU modules to install. -*-Emacs-Lisp-*- ;;; Commentary: ;; APEL-MK imports `emu-modules' and `emu-modules-to-compile' from here. ;;; Code: (defvar emu-modules-not-to-compile nil) (defvar emu-modules-to-compile nil) ;; We use compile-time evaluation heavily. So, order of compilation is ;; very significant. For example, loading some module before compiling ;; it will cause "compile-time" evaluation many times. (defvar emu-modules (nconc ;; modules are sorted by compilation order. '(static broken) ;; product information. '(product apel-ver) ;; poe modules; poe modules depend on static. '(pym) (cond ;; XEmacs. ((featurep 'xemacs) '(poe-xemacs poe)) ;; Emacs 19.29 and earlier. (yes, includes Emacs 19.29.) ((and (= emacs-major-version 19) (<= emacs-minor-version 29)) '(localhook poe)) ;; Emacs 19.30 and later. ((>= emacs-major-version 19) '(poe)) (t ;; v18. '(localhook env poe-18 poe))) ;; pcustom modules; pcustom modules depend on poe. (if (and (module-installed-p 'custom) ;; new custom requires widget. (module-installed-p 'widget)) ;; if both 'custom and 'widget are found, we have new custom. '(pcustom) ;; pcustom does (require 'custom) at compile-time, and tinycustom ;; need to test existence of some custom macros at compile-time! ;; so, we must compile tinycustom first. '(tinycustom pcustom)) ;; pccl modules; pccl modules depend on broken. (cond ((featurep 'xemacs) (cond ;; XEmacs 21 w/ mule. ((and (featurep 'mule) (>= emacs-major-version 21)) '(pccl-20 pccl)) (t '(pccl)))) ((featurep 'mule) (cond ;; Emacs 20. ((>= emacs-major-version 20) '(pccl-20 pccl)) ;; Mule 1.* and 2.*. (t '(pccl-om pccl)))) (t '(pccl))) ;; pces modules; pces modules depend on poe. (cond ((featurep 'xemacs) (cond ((featurep 'mule) ;; XEmacs w/ mule. ;; pces-xfc depends pces-20, so we compile pces-20 first. '(pces-20 pces-xm pces-xfc pces)) ((featurep 'file-coding) ;; XEmacs w/ file-coding. ;; pces-xfc depends pces-20, so we compile pces-20 first. '(pces-20 pces-xfc pces)) (t '(pces-raw pces)))) ((featurep 'mule) (cond ;; Emacs 20.3 and later. ((and (fboundp 'set-buffer-multibyte) (subrp (symbol-function 'set-buffer-multibyte))) ;; pces-e20 depends pces-20, so we compile pces-20 first. '(pces-20 pces-e20 pces)) ;; Emacs 20.1 and 20.2. ((= emacs-major-version 20) ;; pces-e20 depends pces-20, so we compile pces-20 first. '(pces-20 pces-e20_2 pces-e20 pces)) (t ;; Mule 1.* and 2.*. '(pces-om pces)))) ((boundp 'NEMACS) ;; Nemacs. '(pces-nemacs pces)) (t '(pces-raw pces))) ;; poem modules; poem modules depend on pces. (cond ((featurep 'mule) (cond ((featurep 'xemacs) ;; XEmacs w/ mule. '(poem-xm poem)) ((>= emacs-major-version 20) (if (and (fboundp 'set-buffer-multibyte) (subrp (symbol-function 'set-buffer-multibyte))) ;; Emacs 20.3 and later. '(poem-e20_3 poem-e20 poem) ;; Emacs 20.1 and 20.2. '(poem-e20_2 poem-e20 poem))) (t ;; Mule 1.* and 2.*. '(poem-om poem)))) ((boundp 'NEMACS) '(poem-nemacs poem)) (t '(poem-ltn1 poem))) ;; mcharset modules; mcharset modules depend on poem and pcustom. (cond ((featurep 'mule) (cond ((featurep 'xemacs) ;; XEmacs w/ mule. (if (featurep 'utf-2000) ;; XEmacs w/ UTF-2000. (setq emu-modules-not-to-compile (cons 'mcs-xmu emu-modules-not-to-compile))) ;; mcs-xm depends mcs-20, so we compile mcs-20 first. '(mcs-20 mcs-xmu mcs-xm mcharset)) ((>= emacs-major-version 20) ;; Emacs 20 and later. ;; mcs-e20 depends mcs-20, so we compile mcs-20 first. '(mcs-20 mcs-e20 mcharset)) (t ;; Mule 1.* and 2.*. '(mcs-om mcharset)))) ((boundp 'NEMACS) ;; Nemacs. '(mcs-nemacs mcharset)) (t '(mcs-ltn1 mcharset))) ;; timezone.el; Some versions have Y2K problem. (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.")) ;; Old parser test. (if (string= (aref (timezone-parse-date "Wednesday, 31-Jan-01 09:00:00 GMT") 0) "0") (error "timezone.el has old date parser. Install fixed version.")) ;; no problem. '()) (error '(timezone))) ;; invisible modules; provided for backward compatibility with old "tm". (cond ((featurep 'xemacs) ;; XEmacs. '(inv-xemacs invisible)) ((>= emacs-major-version 23) ;; Emacs 23 and later '(inv-23 invisible)) ((>= emacs-major-version 19) ;; Emacs 19 and later. '(inv-19 invisible)) (t ;; v18. '(inv-18 invisible))) ;; emu modules; provided for backward compatibility with old "tm". (if (and (featurep 'mule) (< emacs-major-version 20)) ;; Mule 1.* and 2.*. '(emu-mule emu) '(emu)) ;; emu submodules; text/richtext and text/enriched support. (if (if (featurep 'xemacs) (or (>= emacs-major-version 20) (and (= emacs-major-version 19) (>= emacs-minor-version 14))) (or (>= emacs-major-version 20) (and (= emacs-major-version 19) (>= emacs-minor-version 29)))) ;; XEmacs 19.14 and later, or Emacs 19.29 and later. '(richtext) '(tinyrich)) ;; mule-caesar.el; part of apel-modules, but it is version-dependent. '(mule-caesar))) ;; Generate `emu-modules-to-compile' from `emu-modules-not-to-compile' ;; and `emu-modules'. (let ((modules emu-modules-not-to-compile)) (setq emu-modules-to-compile (copy-sequence emu-modules)) (while modules (setq emu-modules-to-compile (delq (car modules) emu-modules-to-compile) modules (cdr modules)))) ;;; EMU-ELS ends here apel-5bc1050/Makefile000066400000000000000000000027051174656234300144330ustar00rootroot00000000000000# # Makefile for APEL. # VERSION = 10.8 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 GOMI = *.elc ARCHIVE_DIR_PREFIX = /home/kanji/tomo/public_html/lemi/dist default: elc what-where: $(EMACS) $(FLAGS) -f what-where-apel \ $(PREFIX) $(LISPDIR) $(VERSION_SPECIFIC_LISPDIR) elc: $(EMACS) $(FLAGS) -f compile-apel \ $(PREFIX) $(LISPDIR) $(VERSION_SPECIFIC_LISPDIR) install: elc $(EMACS) $(FLAGS) -f install-apel \ $(PREFIX) $(LISPDIR) $(VERSION_SPECIFIC_LISPDIR) # $(MAKE) package: $(XEMACS) $(FLAGS) -f compile-apel-package \ $(PACKAGEDIR) install-package: package $(XEMACS) $(FLAGS) -f install-apel-package \ $(PACKAGEDIR) # $(MAKE) clean: -$(RM) $(GOMI) tar: cvs commit sh -c 'cvs tag -R apel-`echo $(VERSION) \ | sed s/\\\\./_/ | sed s/\\\\./_/`; \ cd /tmp; \ cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root \ export -d apel-$(VERSION) \ -r apel-`echo $(VERSION) | tr . _` apel' cd /tmp; $(RM) apel-$(VERSION)/ftp.in apel-$(VERSION)/.cvsignore ; \ $(TAR) cvzf apel-$(VERSION).tar.gz apel-$(VERSION) cd /tmp; $(RM) -r apel-$(VERSION) sed "s/VERSION/$(VERSION)/" < ftp.in > ftp release: -$(RM) $(ARCHIVE_DIR_PREFIX)/apel/apel-$(VERSION).tar.gz mv /tmp/apel-$(VERSION).tar.gz $(ARCHIVE_DIR_PREFIX)/apel cd $(ARCHIVE_DIR_PREFIX)/semi/ ; ln -s ../apel/apel-$(VERSION).tar.gz . apel-5bc1050/README.en000066400000000000000000000355501174656234300142600ustar00rootroot00000000000000-*- outline -*- [README for APEL (English Version)] * What's APEL? APEL stands for "A Portable Emacs Library". It consists of following modules: ** poe.el This is an emulation module mainly for basic functions and special forms/macros of latest emacsen. poe-xemacs.el --- for XEmacs poe-18.el --- for Emacs 18/Nemacs env.el --- env.el for Emacs 18 localhook.el --- hook functions for Emacs 19.28 and earlier. pym.el --- macros for poe. ** poem.el This module provides 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 ** pces.el This module provides portable character encoding scheme (coding-system) features. pces-20.el --- for Emacs 20 and XEmacs with coding-system. pces-e20.el --- for Emacs 20. pces-e20_2.el --- for Emacs 20.1 and 20.2. pces-nemacs.el --- for Nemacs. pces-om.el --- for Mule 1.* and Mule 2.*. pces-raw.el --- for emacsen without coding-system features. pces-xfc.el --- for XEmacs with file coding. pces-xm.el --- for XEmacs-mule. ** invisible.el This modules provides features about invisible region. inv-18.el --- for Emacs 18 inv-19.el --- for Emacs 19 inv-xemacs.el --- for XEmacs ** mcharset.el This modules provides 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 mcs-xmu.el --- for XEmacs-MULE to unify ISO646 characters ** static.el --- utility for static evaluation ** broken.el --- provide information of broken facilities of Emacs ** pccl.el --- utility to write portable CCL program pccl-om.el --- for MULE 2.* pccl-20.el --- for Emacs 20/XEmacs-21-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 This module provides emu bundled in tm-7.106 compatibility. 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 ** pcustom.el --- provide portable custom environment tinycustom.el --- emulation module of custom.el ** timezone.el This is a utility of time zone. This is a Y2K fixed version. This works with old GNUS 3.14.4 under version 18 of Emacs, too. ** product.el --- Functions for product version information. * Installation ** run in expanded place If you don't want to install other directories, please do only following (You can use make.bat for MS-DOS OS family. If you want to use it, see `make.bat (for MS-DOS family)'): % make You can specify the emacs command name, for example % make EMACS=xemacs If `EMACS=...' is omitted, EMACS=emacs is used. ** 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. ** 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. ** make.bat (for MS-DOS family) make.bat is available for MS-DOS family. You have to edit make.bat if you want to use it. If you use cygwin environment, you can use make.exe and Makefile instead of make.bat. In make.bat, a line which contain `rem' in its beginning is a comment. You have to insert or delete `rem', if necessary. Default setups of make.bat is; set MEADOWVER=1.10 set PREFIX=c:\usr\meadow set EMACS=%PREFIX%\%MEADOWVER%\bin\meadow95.exe set LISPDIR=%PREFIX%\site-lisp set VLISPDIR=%PREFIX%\%MEADOWVER%\site-lisp It assumes that meadow executable binary exists in c:\usr\meadow\1.10\bin\meadow95.exe. On such basis make.bat will try to install meadow version independent modules of APEL to; c:\usr\meadow\site-lisp and meadow version dependent modules to; c:\usr\meadow\1.10\site-lisp Please edit make.bat for your own environment and run make.bat Emacs 19.3x or earlier does not have (e.x. Mule for Windows based on 19.28) an Emacs version dependent site-lisp directory (e.x. c:\usr\meadow\1.10\site-lisp), and its load-path does not refer to such directory by default. If you want install APEL to such an Emacs you may install all APEL modules to an Emacs version independent site-lisp directory such as c:\usr\mule\site-lisp. We cannot provide you with a Demacs example for make.bat. If you install APEL to Demacs, please send us such an example to apel-en@lists.chise.org (you can post a message to the ML, even if you are not a member). If you checkout APEL by using Windows native cvs.exe (not cygwin version), cvs.exe will regularize end of line codes, LF to CRLF. And it also will try to convert CRLF to CRCRLF. make.bat of which eol code is CRCRLF does not work, so if you get such a make.bat, edit it to really regularize eol codes to CRLF. If you need further information, see the following URL (n.b. Japanese only) http://openlab.ring.gr.jp/skk/cvswin-ja.html * 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 19.29 or later or 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. * Version specific information ** For Emacs 18 users: "old byte-compiler" vs "new byte-compiler" In this package, we use compile-time evaluation heavily. Unfortunately, the byte-compiler bundled with Emacs 18 (the "old byte-compiler") does not have features such as `eval-when-compile' and `eval-and-compile', and our emulation version of these macros evaluate "compile-time evaluation" at load-time or at run-time! In addition, the "old byte-compiler" cannot compile top-level use of macros and leaves most of our code uncompiled. Therefore, we recommend you to use the "new" optimizing byte-compiler. It is the origin of byte-compiler bundled with Emacs 19 and later. Optimizing byte-compiler for Emacs 18 is available from the Emacs Lisp Archive and its mirrors. In Mule 1.* days, "contrib" package for Mule 1.* was distributed and it contained the "new byte-compiler" for Mule. But, I think it is difficult to obtain this package now. AFAIK, the "new byte-compiler" for Emacs 18 is also bundled with SKK 9.6 or SKK 10.62a. You can get SKK 10.62a from the following URL; http://openlab.ring.gr.jp/skk/maintrunk They include patch for Mule 1.*. ** For Emacs 19.34 and XEmacs 19.14 users: "old custom" vs "new custom" "custom" library bundled with Emacs 19.32 - 19.34, XEmacs 19.14, and Gnus 5.2/5.3 is "old", its API is incompatible with "new custom" bundled with Emacs 20.1, XEmacs 19.15, or newer, and Gnus 5.4/5.5. "new custom" for Emacs 19.34 and XEmacs 19.15 - 20.2 is available from the following URL. ftp://ftp.dina.kvl.dk/pub/Staff/Per.Abrahamsen/custom/custom-1.9962.tar.gz (Note that "new custom" bundled with XEmacs 19.15 - 20.2, and Gnus 5.4/5.5 is older than this version.) Before installing "new custom", you should check the following points. 1) If you stick to Gnus 5.2/5.3 (or any other applications which use "old custom"), you should not install "new custom". 2) If you use Mule (based on Emacs 19), you must apply this patch to "new custom". ----8<------8<------8<------8<------8<------8<------8<------8<---- --- custom-1.9962/cus-face.el~ Wed Mar 4 19:52:39 1998 +++ custom-1.9962/cus-face.el Mon Mar 9 08:05:33 1998 @@ -96,7 +96,7 @@ "Define a new FACE on all frames, ignoring X resources." (interactive "SMake face: ") (or (internal-find-face name) - (let ((face (make-vector 8 nil))) + (let ((face (make-vector face-vector-length nil))) (aset face 0 'face) (aset face 1 name) (let* ((frames (frame-list)) ----8<------8<------8<------8<------8<------8<------8<------8<---- 3) Applications compiled with "custom" require the same version of "custom" at load-time (and run-time). Therefore, if you use "new custom", you must always include "new custom" in your load-path. The easiest way to achieve this is "subdirs.el"; if you installed "new custom" in "/usr/local/share/emacs/19.34/site-lisp/custom/", put the following line to "/usr/local/share/emacs/19.34/site-lisp/subdirs.el". (normal-top-level-add-to-load-path '("custom")) * 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 `default-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-latest-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 APEL Mailing List: apel-en@lists.chise.org (English) apel-ja@lists.chise.org (Japanese) Via the APEL ML, you can report APEL bugs, obtain the latest release of APEL, and discuss future enhancements to APEL. To join the APEL ML, please see the descriptions of the following pages: http://lists.chise.org/mailman/listinfo/apel-en (English) http://lists.chise.org/mailman/listinfo/apel-ja (Japanese) * Download The latest release of APEL can be obtained from: http://git.chise.org/elisp/dist/apel/ * Git Development of APEL uses Git. So the latest developing version is available at the following Git repository: % git clone http://git.chise.org/git/elisp/apel.git Or you can view the APEL repository via WWW at: http://git.chise.org/gitweb/?p=elisp/apel.git If you would like to join Git based development, please declare it in the APEL mailing list. We hope you will join the open development. apel-5bc1050/README.ja000066400000000000000000000523531174656234300142500ustar00rootroot00000000000000-*- outline -*- [APEL $B$N(B README ($BF|K\8lHG(B)] * APEL $B$H$O!)(B APEL $B$O(B "A Portable Emacs Library." $B$NN,$G$9!#$3$l$O0J2<$N%b%8%e!<%k$G(B $B9=@.$5$l$F$$$^$9(B: ** poe.el $B2A$N$?$a$N%f!<%F%#%j%F%#!<(B ** broken.el --- Emacs $B$N2u$l$F$$$k5!G=$N>pJs$rDs6!$9$k(B ** pccl.el --- $B0\?"2DG=$J(B CCL $B%W%m%0%i%`$r=q$/$?$a$N%f!<%F%#%j%F%#!<(B pccl-om.el --- MULE 2.* $BMQ(B pccl-20.el --- Emacs 20/XEmacs-21-MULE $BMQ(B ** alist.el: $BO"A[%j%9%H$N$?$a$N%f!<%F%#%j%F%#!<(B ** calist.el: $B>uBVLZ$H>uBV(B/$B>u67O"A[%j%9%HMQ$N%f!<%F%#%j%F%#!<(B ** path-util.el: $B%Q%94IM}$H%U%!%$%kC5:w$N$?$a$N%f!<%F%#%j%F%#!<(B ** filename.el:$B%U%!%$%kL>$r:n$k$?$a$N%f!<%F%#%j%F%#(B ** install.el: emacs-lisp $B%Q%C%1!<%8%$%s%9%H!<%k$9$k$?$a$N%f!<%F%#%j%F%#!<(B ** mule-caesar.el: ROT 13-47-48 Caesar $BJQ49$N%f!<%F%#%j%F%#!<(B ** emu.el tm-7.106 $B$KF~$C$F$$$?(B emu $B$H$N8_49@-$rJ]$D$?$a$N%b%8%e!<%k!#(Bpoe, poem, mcharset $B$r(B require $B$9$k!#(B emu-mule: MULE 1.*, 2.* $BMQ(B richtext.el --- Emacs 19.29 $B$+$=$l0J9_(B XEmacs 19.14 $B$+$=$l0J9_$N$?(B $B$a$N(B text/richtext $B%b%8%e!<%k(B tinyrich.el --- $B8E$$(B emacs $B4D6-$N$?$a$N(B text/richtext $B%b%8%e!<%k(B ** pcustom.el --- $B0\?"@-$N9b$$(B custom $B4D6-$rDs6!$9$k(B tinycustom.el --- custom.el $B$N%(%_%e%l!<%7%g%s$r9T$J$&(B ** timezone.el $B%?%$%`%>!<%s%f!<%F%#%j%F%#!#(B2000 $BG/LdBjBP1~HG!#(BEmacs 18 $B$H(B GNUS 3.14.4 $B$G$bF0:n2D!#(B ** product.el --- $B%W%m%@%/%H$N%P!<%8%g%s>pJs$N$?$a$N5!G=$rDs6!$9$k%b%8%e!<%k!#(B * $B%$%s%9%H!<%k(B ** $BE83+$7$?>l=j$G$N%G%#%l%/%H%j!<$K%$%s%9%H!<%k$7$?$/$J$$$J$i!"0J2<$N$3$H$@$1$r$d$C$F(B $B$/$@$5$$(B (MS-DOS $B7O$N(B OS $B$N$?$a$K(B MAKEIT.BAT $B$,MQ0U$5$l$F$$$^$9!#(B MAKEIT.BAT $B$NMxMQ$K$D$$$F$O2<5-!V(BMAKEIT.BAT $B$rMxMQ$9$k(B (MS-DOS $B7O(B OS $B$N>l9g(B)$B!W$r;2>H$7$F2<$5$$(B)$B!#(B: % make emacs $B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"(B % make EMACS=xemacs `EMACS=...' $B$,>JN,$5$l$k$H!"(BEmacs=emacs $B$,;H$o$l$^$9!#(B ** make install $BB>$N%G%#%l%/%H%j!<$K%$%s%9%H!<%k$7$?$$$J$i!"0J2<$N$3$H$r$7$F$/$@$5$$(B: % make install emacs $B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"(B % make install EMACS=xemacs `EMACS=...' $B$,>JN,$5$l$k$H!"(BEmacs=emacs $B$,;H$o$l$^$9!#(B Emacs Lisp $B%W%m%0%i%`$H%7%'%k%9%/%j%W%H$N$?$a$N%G%#%l%/%H%j!JN,$5$l$k$H!";XDj$5$l$?(B emacs $B%3%^%s%I$N%G%#%l%/%H%j!<(B $BLZ$N@\F,<-$,;HMQ$5$l$^$9(B ($B$*$=$i$/(B /usr/local $B$G$9(B)$B!#(B $BNc$($P!"(BPREFIX=/usr/local $B$H(B Emacs 20.2 $B$,;XDj$5$l$l$P!"0J2<$N%G%#%l%/(B $B%H%j!$NA*Br<+M3$J@_Dj$r;XDj$9$k$3$H$,$G(B $B$-$^$9!#$=$NCf$N%3%a%s%H$rFI$s$G$/$@$5$$!#(B ** XEmacs $B$N%Q%C%1!<%8$H$7$F%$%s%9%H!<%k$9$k(B XEmacs $B$N%Q%C%1!<%8%G%#%l%/%H%j!<$K%$%s%9%H!<%k$9$k>l9g$O!"0J2<$N$3$H(B $B$r$7$F$/$@$5$$(B: % make install-package emacs $B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"(B % make install-package XEMACS=xemacs-21 `XEMACS=...' $B$,>JN,$5$l$k$H!"(BXEMACS=xemacs $B$,;HMQ$5$l$^$9!#(B $B%Q%C%1!<%8$N%G%#%l%/%H%j!<$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P(B: % make install PACKAGEDIR=~/.xemacs `PACKAGEDIR=...' $B$,>JN,$5$l$k$H!"B8:_$9$k%Q%C%1!<%8%G%#%l%/%H%j!<$N:G(B $B=i$N$b$N$,;H$o$l$^$9!#(B XEmacs $B$N%Q%C%1!<%8%7%9%F%`$O(B XEmacs 21.0 $B$+$=$l0J9_$rMW5a$9$k$3$H$KCm(B $B0U$7$F$/$@$5$$!#(B ** MAKEIT.BAT $B$rMxMQ$9$k(B (MS-DOS $B7O(B OS $B$N>l9g(B) MS-DOS $B7O$N(B OS $B$N$?$a$K(B MAKEIT.BAT $B$H(B MAKE1.BAT $B$,MQ0U$5$l$F$$$^$9(B (cygwin $B4D6-$rMxMQ$7$F$$$kJ}$O(B make.exe $B$H(B Makefile $B$rMxMQ$9$k$3$H$,$G(B $B$-$^$9(B)$B!#(BMAKEIT.BAT $B$O!"%$%s%9%H!<%k$N4D6-JQ?t$r@_Dj$7$?8e$K(B MAKE1.BAT $B$r8F=P$7$^$9!#(BMAKE1.BAT $B$K$h$C$F(B%' $B$Ol9g$NJQ?t@_Dj$NNc$r5s$2$^$9!#(B set PREFIX=c:\usr\Meadow set EMACS=%PREFIX%\1.10\bin\meadow95.exe set EXEC_PREFIX= set LISPDIR=%PREFIX%\site-lisp set VERSION_SPECIFIC_LISPDIR=%PREFIX%\1.10\site-lisp set DEFAULT_MAKE_ARG=elc $B>e5-$NNc$G$O!"(Bmeadow $B$N%P%$%J%j$,(B c:\usr\Meadow\1.10\bin\meadow95.exe $B$K%$%s%9%H!<%k$5$l$F$$$k$3$H$rA0Ds$K$7$F$$$^$9!#$=$NA0Ds$K4p$E$-!"(BAPEL $B$N%b%8%e!<%k$N$&$A!"(Bmeadow $B$N%P!<%8%g%s$K0MB8$7$J$$%b%8%e!<%k$r(B c:\usr\Meadow\site-lisp $B$K!"%P!<%8%g%s$K0MB8$9$k%b%8%e!<%k$r(B c:\usr\Meadow\1.10\site-lisp $B$K%$%s%9%H!<%k$7$h$&$H$7$^$9!#(B 19.3x $B0JA0$N(B Emacs ($BNc$($P(B 19.28 $B%Y!<%9$N(B Mule for Windows) $B$K$O%P!<%8%g(B $B%s0MB8$N(B site-lisp $B%G%#%l%/%H%j(B ($B>e5-$NNc$G8@$($P(B c:\usr\Meadow\1.10\site-lisp) $B$,B8:_$;$:!"%G%#%U%)%k%H$G$O(B load-path $B$b(B $BDL$C$F$$$^$;$s!#$3$N>l9g$O(B c:\usr\mule\site-lisp $B$J$I$N%P!<%8%g%sHs0MB8(B $B$N(B site-lisp $B%G%#%l%/%H%j$K(B APEL $B$NA4$F$N%b%8%e!<%k$rF~$l$l$PNI$$$G$7$g(B $B$&!#(B Demacs $B$N@_DjNc$r=`Hw$9$k$3$H$,$G$-$^$;$s$G$7$?!#(BDemacs $B$K(B APEL $B$r%$%s(B $B%9%H!<%k$7$?J}$O!"@_DjNc$r(B apel-ja@lists.chise.org $B$KAw$C$F2<$5$$(B ($BHs(B $B9XFIl9g$O!"(BDOSPROMPT $B$N%W%m%Q%F%#$G4D6-JQ?t$N=i4|%5%$%:$,!V<+(B $BF0!W$K$J$C$F$$$k$H!"4D6-JQ?t$,@_Dj$G$-$J$$$H$$$&%(%i!<$,=P$k$N$G!"E,Ev(B $B$JCM(B (2048 $B$J$I(B) $B$rF~$l$F$*$/I,MW$,$"$j$^$9!#(Bnon Windows $B$N(B DOS $B$N>l9g(B $B$O!"(Bconfig.sys $B$K(B SHELL=C:\COMMAND.COM /E:4096 /P $B$J$I$H=q$-!"4D6-JQ?t$K3dEv$F2DG=$J%a%b%j$r3NJ]$7$^$9!#(BDOS $B$N%P!<%8%g%s(B $B$K$h$C$F(B /E:nnn $B$G;XDj$G$-$k4D6-JQ?tNN0h$N%5%$%:$N@)Ls$,0[$J$j!";XDj$N(B $B;EJ}$,0c$C$?$j!"FCDj$NCM$r;XDj$9$k$HIT6q9g$r@8$8$k2DG=@-$,$"$k$N$G>\$7(B $B$/$O$4MxMQ$N(B version $B$N%^%K%e%"%kEy$r$4Mw2<$5$$!#(B *** Windows $B$N(B cvs.exe $B$G%A%'%C%/%"%&%H$7$?(B MAKEIT.BAT $B$rMxMQ$9$k>l9g$NLdBjE@(B $B$J$*!"(BWindows $B%M%$%F%#%V$N(B cvs.exe (not cygwin) $B$rMxMQ$7$F(B APEL $B$r(B checkout $B$7$?>l9g$O!"(Bcvs.exe $B$K$h$j9TKv%3!<%I$,@55,2=$5$l$F(B CRCRLF $B$K(B $B$J$C$F$$$k2DG=@-$,$"$j$^$9!#$3$N$h$&$J>l9g!"(BMAKEIT.BAT, MAKE1.BAT $B$OF0(B $B$-$^$;$s$N$G9TKv%3!<%I$r(B CRLF $B$K=$@5$7$F$*;H$$2<$5$$!#$3$NLdBj$K$D$$$F(B $B>\$7$/$O!"(B http://openlab.ring.gr.jp/skk/cvswin-ja.html $B$r$4;2>H2<$5$$!#(B * load-path$B!J(BEmacs $B$H(B MULE $B$N>l9g!K(B $B$b$7(B Emacs $B$b$7$/$O(B Mule $B$r$*;H$$$J$i!"(BAPEL $B$r(B install $B$7$?>l=j$r(B load-path $B$KDI2C$7$F$/$@$5$$!#$b$7(B Emacs 19.29 $B0J9_$^$?$O(B Emacs 20.1, 20.2 $B$r;H$C$F=i4|@_Dj$G%$%s%9%H!<%k$7$?$N$J$i!"pJs(B ** $B!V8E$$(B byte-compiler$B!W$H!V?7$7$$(B byte-compiler$B!W(B Emacs 18 $B$N%f!<%6$N$_$J$5$s$X(B: $B$3$N%Q%C%1!<%8$G$O%3%s%Q%$%k;~$K$*$1$k>r7oH=CG$r$?$/$5$s9T$J$C$F$$$^(B $B$9!#;DG0$J$,$i(B Emacs 18 $B$KIUB0$7$F$$$k(B byte-compiler $B$K$O!"Nc$($P(B `eval-when-compile' $B$d(B `eval-and-compile' $B$N5!G=$,L5$$$N$GBeMQIJ$N%^(B $B%/%m$rMQ0U$7$F$"$j$^$9$,!"$3$l$i$O%3%s%Q%$%k;~$@$1$G$J$/(B load $B;~$^$?(B $B$O$N!V8E$$(B custom$B!W$r;H$&%"%W(B $B%j%1!<%7%g%s(B) $B$r;H$&$3$H$K8G<9$7$F$$$k$N$J$i$P!V?7$7$$(B custom$B!W(B $B$r%$%s%9%H!<%k$7$F$O$$$1$^$;$s!#(B 2) Emacs 19 $B$r85$K$7$?(B Mule $B$r;H$&$N$J$i$P!"$3$N%Q%C%A$r!V?7$7$$(B custom$B!W$KEv$F$kI,MW$,$"$j$^$9!#(B ----8<------8<------8<------8<------8<------8<------8<------8<---- --- custom-1.9962/cus-face.el~ Wed Mar 4 19:52:39 1998 +++ custom-1.9962/cus-face.el Mon Mar 9 08:05:33 1998 @@ -96,7 +96,7 @@ "Define a new FACE on all frames, ignoring X resources." (interactive "SMake face: ") (or (internal-find-face name) - (let ((face (make-vector 8 nil))) + (let ((face (make-vector face-vector-length nil))) (aset face 0 'face) (aset face 1 name) (let* ((frames (frame-list)) ----8<------8<------8<------8<------8<------8<------8<------8<---- 3) custom $B$r;H$&%3%s%Q%$%k$5$l$?%"%W%j%1!<%7%g%s$O!"$=$l$r(B load $B$9(B $B$k$H$-$dJN,2DG=$J0z?t(B ALL-PATHS $B$,;XDj$5$l$k$H!"(B`default-load-path' $B$N$+$o$j(B $B$K(B `load-path' $B$+$iC5$7$^$9!#(B *** $B4X?t(B get-latest-path (PATTERN &optional ALL-PATHS) $B@55,I=8=(B PATTERN $B$K9gCW$9$k(B default-load-path $B$K$"$k:G?7$N%G%#%l%/%H%j!<(B $B$rJV$7$^$9!#>JN,2DG=$J0z?t(B ALL-PATHS $B$,;XDj$5$l$k$H!"(Bdefault-load-path $B$NBe$o$j$K(B load-path $B$NA4$F$+$iC5$7$^$9!#(B $BNc(B. (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))) *** $B4X?t(B file-installed-p (FILE &optional PATHS) FILE $B$,(B PATHS $B$KB8:_$7$?>l9g!"(BFILE $B$N@dBP%Q%9$rJV$7$^$9!#(BPATHS $B$,>JN,(B $B$5$l$k$H!"(B`load-path' $B$,;H$o$l$^$9!#(B *** $B4X?t(B exec-installed-p (FILE &optional PATHS SUFFIXES) FILE $B$,(B PATHS $B$KB8:_$7$?>l9g$K(B FILE $B$N@dBP%Q%9$rJV$7$^$9!#(BPATHS $B$,>JN,(B $B$5$l$k$H!"(B`exec-path' $B$,;H$o$l$^$9!#(BSUFFIXES $B$,>JN,$5$l$k$H!"(B `exec-suffix-list' $B$,;H$o$l$^$9!#(B *** $B4X?t(B module-installed-p (MODULE &optional PATHS) MODULE $B$,Ds6!$5$l$F$$$k(B (provided) $B$+!"(BPATHS $B$KB8:_$9$k>l9g$K(B nil $B$G(B $B$J$$CM$rJV$7$^$9!#(BPATHS $B$,>JN,$5$l$k$H!"(B`load-path' $B$,;H$o$l$^$9!#(B ** filename *** $B4X?t(B replace-as-filename (string) STRING $B$+$i0BA4$J%U%!%$%kL>$rJV$7$^$9!#(B $B$=$l$OJQ?t(B 'filename-filters' $B$r;2>H$7$^$9!#$=$NJQ?t$O%U%!%$%kL>$NA*(B $BJL4o$N$?$a$N4X?t$N%j%9%H$G$9!#=i4|@_Dj$NA*JL4o$O0J2<$NJQ?t$r;2>H$7$F$$(B $B$^$9!#(B **** $BJQ?t(B filename-limit-length $B%U%!%$%kL>$ND9$5$N@)8B!#(B **** $BJQ?t(B filename-replacement-alist $BJ8;z$HJ8;zNs$,BP$K$J$C$?%j%9%H$NO"A[%j%9%H$G$9!#J8;z$N%j%9%H$O%U%!%$%k(B $BL>$H$7$F5v$5$l$J$$J8;z$r8=$o$7$^$9!#(B * $B%P%0Js9p(B $B%P%0Js9p$d2~A1$NDs0F$r=q$$$?$H$-$O!"@'Hs(B APEL $B%a!<%j%s%0%j%9%H$KAw$C$F(B $B$/$@$5$$(B: apel-ja@lists.chise.org $B!JF|K\8l!K(B apel-en@lists.chise.org $B!J1Q8l!K(B APEL ML $B$rDL$7$F!"(BAPEL $B$N%P%0$rJs9p$7$?$j!"(BAPEL $B$N:G?7$N%j%j!<%9$r-Mh$N3HD%$N5DO@$r$7$?$j$9$k$3$H$,$G$-$^$9!#(BAPEL ML $B$K(B $B;22C$9$k$K$O!"0J2<$NJG$N5-=R$r8+$Fl=j$+$i$s$G$$$^$9!#(B apel-5bc1050/alist.el000066400000000000000000000056551174656234300144400ustar00rootroot00000000000000;;; alist.el --- utility functions for association list ;; Copyright (C) 1993,1994,1995,1996,1998,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: alist ;; This file is part of GNU Emacs. ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: ;;;###autoload (defun put-alist (key value alist) "Set cdr of an element (KEY . ...) in ALIST to VALUE and return ALIST. If there is no such element, create a new pair (KEY . VALUE) and return a new alist whose car is the new pair and cdr is ALIST." (let ((elm (assoc key alist))) (if elm (progn (setcdr elm value) alist) (cons (cons key value) alist)))) ;;;###autoload (defun del-alist (key alist) "Delete an element whose car equals KEY from ALIST. Return the modified ALIST." (let ((pair (assoc key alist))) (if pair (delq pair alist) alist))) ;;;###autoload (defun set-alist (symbol key value) "Set cdr of an element (KEY . ...) in the alist bound to SYMBOL to VALUE." (or (boundp symbol) (set symbol nil)) (set symbol (put-alist key value (symbol-value symbol)))) ;;;###autoload (defun remove-alist (symbol key) "Delete an element whose car equals KEY from the alist bound to SYMBOL." (and (boundp symbol) (set symbol (del-alist key (symbol-value symbol))))) ;;;###autoload (defun modify-alist (modifier default) "Store elements in the alist MODIFIER in the alist DEFAULT. Return the modified alist." (mapcar (function (lambda (as) (setq default (put-alist (car as)(cdr as) default)))) modifier) default) ;;;###autoload (defun set-modified-alist (symbol modifier) "Store elements in the alist MODIFIER in an alist bound to SYMBOL. If SYMBOL is not bound, set it to nil at first." (if (not (boundp symbol)) (set symbol nil)) (set symbol (modify-alist modifier (eval symbol)))) ;;; @ association-vector-list ;;; ;;;###autoload (defun vassoc (key avlist) "Search AVLIST for an element whose first element equals KEY. AVLIST is a list of vectors. See also `assoc'." (while (and avlist (not (equal key (aref (car avlist) 0)))) (setq avlist (cdr avlist))) (and avlist (car avlist))) ;;; @ end ;;; (require 'product) (product-provide (provide 'alist) (require 'apel-ver)) ;;; alist.el ends here apel-5bc1050/apel-ver.el000066400000000000000000000042321174656234300150250ustar00rootroot00000000000000;;; apel-ver.el --- Declare APEL version. ;; Copyright (C) 1999, 2000, 2003, 2006 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keiichi Suzuki ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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)) ; Released 20 January 2000 ;; (product-define "APEL" nil '(10 2)) ; Released 01 March 2000 ;; (product-define "APEL" nil '(10 3)) ; Released 30 December 2000 ;; (product-define "APEL" nil '(10 4)) ; Released 04 October 2002 ;; (product-define "APEL" nil '(10 5)) ; Released 06 June 2003 ;; (product-define "APEL" nil '(10 6)) ; Released 05 July 2003 ;; (product-define "APEL" nil '(10 7)) ; Released 14 February 2007 (product-define "APEL" nil '(10 8)) ) (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 apel-5bc1050/atype.el000066400000000000000000000104611174656234300144350ustar00rootroot00000000000000;;; atype.el --- atype functions ;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Version: $Id: atype.el,v 6.6 1997/03/10 14:11:23 morioka Exp $ ;; Keywords: atype ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'emu) ; for backward compatibility. (require 'poe) ; delete. (require 'alist) ;;; @ field unifier ;;; (defun field-unifier-for-default (a b) (let ((ret (cond ((equal a b) a) ((null (cdr b)) a) ((null (cdr a)) b) ))) (if ret (list nil ret nil) ))) (defun field-unify (a b) (let ((f (let ((type (car a))) (and (symbolp type) (intern (concat "field-unifier-for-" (symbol-name type))) )))) (or (fboundp f) (setq f (function field-unifier-for-default)) ) (funcall f a b) )) ;;; @ type unifier ;;; (defun assoc-unify (class instance) (catch 'tag (let ((cla (copy-alist class)) (ins (copy-alist instance)) (r class) cell aret ret prev rest) (while r (setq cell (car r)) (setq aret (assoc (car cell) ins)) (if aret (if (setq ret (field-unify cell aret)) (progn (if (car ret) (setq prev (put-alist (car (car ret)) (cdr (car ret)) prev)) ) (if (nth 2 ret) (setq rest (put-alist (car (nth 2 ret)) (cdr (nth 2 ret)) rest)) ) (setq cla (put-alist (car cell)(cdr (nth 1 ret)) cla)) (setq ins (del-alist (car cell) ins)) ) (throw 'tag nil) )) (setq r (cdr r)) ) (setq r (copy-alist ins)) (while r (setq cell (car r)) (setq aret (assoc (car cell) cla)) (if aret (if (setq ret (field-unify cell aret)) (progn (if (car ret) (setq prev (put-alist (car (car ret)) (cdr (car ret)) prev)) ) (if (nth 2 ret) (setq rest (put-alist (car (nth 2 ret)) (cdr (nth 2 ret)) rest)) ) (setq cla (del-alist (car cell) cla)) (setq ins (put-alist (car cell)(cdr (nth 1 ret)) ins)) ) (throw 'tag nil) )) (setq r (cdr r)) ) (list prev (append cla ins) rest) ))) (defun get-unified-alist (db al) (let ((r db) ret) (catch 'tag (while r (if (setq ret (nth 1 (assoc-unify (car r) al))) (throw 'tag ret) ) (setq r (cdr r)) )))) ;;; @ utilities ;;; (defun delete-atype (atl al) (let* ((r atl) ret oal) (setq oal (catch 'tag (while r (if (setq ret (nth 1 (assoc-unify (car r) al))) (throw 'tag (car r)) ) (setq r (cdr r)) ))) (delete oal atl) )) (defun remove-atype (sym al) (and (boundp sym) (set sym (delete-atype (eval sym) al)) )) (defun replace-atype (atl old-al new-al) (let* ((r atl) ret oal) (if (catch 'tag (while r (if (setq ret (nth 1 (assoc-unify (car r) old-al))) (throw 'tag (rplaca r new-al)) ) (setq r (cdr r)) )) atl))) (defun set-atype (sym al &rest options) (if (null (boundp sym)) (set sym al) (let* ((replacement (memq 'replacement options)) (ignore-fields (car (cdr (memq 'ignore options)))) (remove (or (car (cdr (memq 'remove options))) (let ((ral (copy-alist al))) (mapcar (function (lambda (type) (setq ral (del-alist type ral)) )) ignore-fields) ral))) ) (set sym (or (if replacement (replace-atype (eval sym) remove al) ) (cons al (delete-atype (eval sym) remove) ) ))))) ;;; @ end ;;; (require 'product) (product-provide (provide 'atype) (require 'apel-ver)) ;;; atype.el ends here apel-5bc1050/broken.el000066400000000000000000000074121174656234300145750ustar00rootroot00000000000000;;; broken.el --- Emacs broken facility information registry. ;; Copyright (C) 1998, 1999 Tanaka Akira ;; Author: Tanaka Akira ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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 omitted 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 apel-5bc1050/calist.el000066400000000000000000000226071174656234300145770ustar00rootroot00000000000000;;; 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 ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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" sym))) (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 apel-5bc1050/emu-mule.el000066400000000000000000000032331174656234300150400ustar00rootroot00000000000000;;; emu-mule.el --- emu module for Mule 1.* and Mule 2.* ;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko ;; Katsumi Yamaoka ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poem) ;;; @ regulation ;;; (defun regulate-latin-char (chr) (cond ((and (<= ?$B#A(B chr)(<= chr ?$B#Z(B)) (+ (- chr ?$B#A(B) ?A)) ((and (<= ?$B#a(B chr)(<= chr ?$B#z(B)) (+ (- chr ?$B#a(B) ?a)) ((eq chr ?$B!%(B) ?.) ((eq chr ?$B!$(B) ?,) (t chr))) (defun regulate-latin-string (str) (let ((len (length str)) (i 0) chr (dest "")) (while (< i len) (setq chr (sref str i)) (setq dest (concat dest (char-to-string (regulate-latin-char chr)))) (setq i (+ i (char-bytes chr)))) dest)) ;;; @ end ;;; (require 'product) (product-provide (provide 'emu-mule) (require 'apel-ver)) ;;; emu-mule.el ends here apel-5bc1050/emu.el000066400000000000000000000205201174656234300140760ustar00rootroot00000000000000;;; emu.el --- Emulation module for each Emacs variants ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: emulation, compatibility, Nemacs, MULE, Emacs/mule, XEmacs ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) (defvar running-emacs-18 (<= emacs-major-version 18)) (defvar running-xemacs (featurep 'xemacs)) (defvar running-mule-merged-emacs (and (not (boundp 'MULE)) (not running-xemacs) (featurep 'mule))) (defvar running-xemacs-with-mule (and running-xemacs (featurep 'mule))) (defvar running-emacs-19 (and (not running-xemacs) (= emacs-major-version 19))) (defvar running-emacs-19_29-or-later (or (and running-emacs-19 (>= emacs-minor-version 29)) (and (not running-xemacs)(>= emacs-major-version 20)))) (defvar running-xemacs-19 (and running-xemacs (= emacs-major-version 19))) (defvar running-xemacs-20-or-later (and running-xemacs (>= emacs-major-version 20))) (defvar running-xemacs-19_14-or-later (or (and running-xemacs-19 (>= emacs-minor-version 14)) running-xemacs-20-or-later)) (cond (running-xemacs ;; for XEmacs (defvar mouse-button-1 'button1) (defvar mouse-button-2 'button2) (defvar mouse-button-3 'button3) ) ((>= emacs-major-version 19) ;; mouse (defvar mouse-button-1 [mouse-1]) (defvar mouse-button-2 [mouse-2]) (defvar mouse-button-3 [down-mouse-3]) ) (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-buffer) (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) (if (integerp chr) (char-to-string (int-char chr)) (char-to-string chr))) ;; `char-category-list' returns a list of ;; characters in XEmacs 21.2.25 and later, ;; otherwise integers. (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 ;; 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 conversion, 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 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 conversion, 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) )) ;;; @ Mule emulating aliases ;;; ;;; You should not use it. (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.")) ;;; @ without code-conversion ;;; (defalias 'insert-binary-file-contents 'insert-file-contents-as-binary) (make-obsolete 'insert-binary-file-contents 'insert-file-contents-as-binary) (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." (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 ;;; (cond ((fboundp 'richtext-decode) ;; have richtext.el ) ((or running-emacs-19_29-or-later running-xemacs-19_14-or-later) ;; have enriched.el (autoload 'richtext-decode "richtext") (or (assq 'text/richtext format-alist) (setq format-alist (cons (cons 'text/richtext '("Extended MIME text/richtext format." "Content-[Tt]ype:[ \t]*text/richtext" richtext-decode richtext-encode t enriched-mode)) format-alist))) ) (t ;; don't have enriched.el (autoload 'richtext-decode "tinyrich") (autoload 'enriched-decode "tinyrich") )) (if (or (and (eq emacs-major-version 19) (>= emacs-minor-version (if (featurep 'xemacs) 14 29))) (and (eq emacs-major-version 20) (< emacs-minor-version (if (featurep 'xemacs) 3 1)))) (eval-after-load "enriched" '(if (fboundp 'si:enriched-encode) nil (fset 'si:enriched-encode (symbol-function 'enriched-encode)) (defun enriched-encode (from to &optional orig-buf) (let* ((si:enriched-initial-annotation enriched-initial-annotation) (enriched-initial-annotation (if (stringp si:enriched-initial-annotation) si:enriched-initial-annotation (function (lambda () (save-excursion ;; Eval this in the buffer we are annotating. This ;; fixes a bug which was saving incorrect File-Width ;; information, since we were looking at local ;; variables in the wrong buffer. (if orig-buf (set-buffer orig-buf)) (funcall si:enriched-initial-annotation))))))) (si::enriched-encode from to)))))) ;;; @ end ;;; (require 'product) (product-provide (provide 'emu) (require 'apel-ver)) ;;; emu.el ends here apel-5bc1050/env.el000066400000000000000000000104211174656234300140770ustar00rootroot00000000000000;;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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))))))) (require 'product) (product-provide (provide 'env) (require 'apel-ver)) ;;; env.el ends here apel-5bc1050/file-detect.el000066400000000000000000000025121174656234300154760ustar00rootroot00000000000000;;; file-detect.el --- Path management or file detection utility ;; Copyright (C) 1996,1997 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Version: $Id: file-detect.el,v 7.1 1997/11/08 07:40:52 morioka Exp $ ;; Keywords: file detection, install, module ;; Status: obsoleted ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This file is existed only for compatibility. Please use ;; path-util.el instead of this file. ;;; Code: (require 'path-util) (require 'product) (product-provide (provide 'file-detect) (require 'apel-ver)) ;;; file-detect.el ends here apel-5bc1050/filename.el000066400000000000000000000117131174656234300150740ustar00rootroot00000000000000;;; filename.el --- file name filter ;; Copyright (C) 1996,1997 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko ;; Version: $Id: filename.el,v 2.1 1997/11/06 15:50:53 morioka Exp $ ;; Keywords: file name, string ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (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. FUNCTIONS is list of functions. \(poly-funcall '(f1 f2 .. fn) arg) is as same as \(fn .. (f2 (f1 arg)) ..). For example, (poly-funcall '(car number-to-string) '(100)) returns \"100\"." (while functions (setq argument (funcall (car functions) argument) functions (cdr functions))) argument) ;;; @ variables ;;; (defvar filename-limit-length 21 "Limit size of file-name.") (defvar filename-replacement-alist '(((?\ ?\t) . "_") ((?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?/ ?: ?\; ?< ?> ?? ?\[ ?\\ ?\] ?` ?{ ?| ?}) . "_") (filename-control-p . "")) "Alist list of characters vs. string as replacement. List of characters represents characters not allowed as file-name.") (defvar filename-filters nil "List of functions for file-name filter. Example: \(setq filename-filters '\(filename-special-filter filename-eliminate-top-low-lines filename-canonicalize-low-lines filename-maybe-truncate-by-size filename-eliminate-bottom-low-lines\)\) Moreover, if you want to convert Japanese filename to roman string by kakasi, \(if \(exec-installed-p \"kakasi\"\) \(setq filename-filters \(append '\(filename-japanese-to-roman-string\) filename-filters\)\)\)") ;;; @ filters ;;; (defun filename-japanese-to-roman-string (str) (save-excursion (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))) (defun filename-control-p (character) (let ((code (char-int character))) (or (< code 32)(= code 127)))) (eval-when-compile (defmacro filename-special-filter-1 (string) (let (sref inc-i) (if (or (not (fboundp 'sref)) (>= emacs-major-version 21) (and (= emacs-major-version 20) (>= emacs-minor-version 3))) (setq sref 'aref inc-i '(1+ i)) (setq sref 'aref inc-i '(+ i (char-length chr)))) (` (let ((len (length (, string))) (b 0)(i 0) (dest "")) (while (< i len) (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 (car lst))) i (, inc-i) b i) (setq i (, inc-i))))) (concat dest (substring (, string) b))))))) (defun filename-special-filter (string) (filename-special-filter-1 string)) (defun filename-eliminate-top-low-lines (string) (if (string-match "^_+" string) (substring string (match-end 0)) string)) (defun filename-canonicalize-low-lines (string) (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))) (defun filename-maybe-truncate-by-size (string) (if (and (> (length string) filename-limit-length) (string-match "_" string filename-limit-length)) (substring string 0 (match-beginning 0)) string)) (defun filename-eliminate-bottom-low-lines (string) (if (string-match "_+$" string) (substring string 0 (match-beginning 0)) string)) ;;; @ interface ;;; (defun replace-as-filename (string) "Return safety filename from STRING. It refers variable `filename-filters' and default filters refers `filename-limit-length', `filename-replacement-alist'." (and string (poly-funcall filename-filters string))) ;;; @ end ;;; (require 'product) (product-provide (provide 'filename) (require 'apel-ver)) ;;; filename.el ends here apel-5bc1050/ftp.in000066400000000000000000000006271174656234300141150ustar00rootroot00000000000000--<>-{ It is available from http://kanji.zinbun.kyoto-u.ac.jp/~tomo/lemi/dist/apel/ --[[message/external-body; access-type=URL; URL*0="http://"; URL*1="www.kanji.zinbun.kyoto-u.ac.jp/~tomo/"; URL*2="lemi/dist/"; URL*3="apel/"; URL*4="apel-VERSION.tar.gz"]] Content-Type: application/octet-stream Content-Disposition: attachment; filename="apel-VERSION.tar.gz" --}-<> apel-5bc1050/install.el000066400000000000000000000222511174656234300147610ustar00rootroot00000000000000;;; install.el --- Emacs Lisp package install utility ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2006 ;; Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Created: 1996/08/18 ;; Keywords: install, byte-compile, directory detection ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) ; make-directory for v18 (require 'path-util) ; default-load-path ;;; @ compile Emacs Lisp files ;;; (defun compile-elisp-module (module &optional path every-time) (setq module (expand-file-name (symbol-name module) path)) (let ((el-file (concat module ".el")) (elc-file (concat module ".elc"))) (if (or every-time (file-newer-than-file-p el-file elc-file)) (byte-compile-file el-file)))) (defun compile-elisp-modules (modules &optional path every-time) (mapcar (function (lambda (module) (compile-elisp-module module path every-time))) modules)) ;;; @ install files ;;; (defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4)) ; 0644 (defun install-file (file src dest &optional move overwrite just-print) (if just-print (princ (format "%s -> %s\n" file dest)) (let ((src-file (expand-file-name file src))) (if (file-exists-p src-file) (let ((full-path (expand-file-name file dest))) (if (and (file-exists-p full-path) overwrite) (delete-file full-path)) (copy-file src-file full-path t t) (set-file-modes full-path install-overwritten-file-modes) (if move (catch 'tag (while (and (file-exists-p src-file) (file-writable-p src-file)) (condition-case err (progn (delete-file src-file) (throw 'tag nil)) (error (princ (format "%s\n" (nth 1 err)))))))) (princ (format "%s -> %s\n" file dest))))))) (defun install-files (files src dest &optional move overwrite just-print) (or just-print (file-exists-p dest) (make-directory dest t)) (mapcar (function (lambda (file) (install-file file src dest move overwrite just-print))) files)) ;;; @@ install Emacs Lisp files ;;; (defun install-elisp-module (module src dest &optional just-print del-elc) (let (el-file elc-file) (let ((name (symbol-name module))) (setq el-file (concat name ".el")) (setq elc-file (concat name ".elc"))) (let ((src-file (expand-file-name el-file src))) (if (not (file-exists-p src-file)) nil (if just-print (princ (format "%s -> %s\n" el-file dest)) (let ((full-path (expand-file-name el-file dest))) (if (file-exists-p full-path) (delete-file full-path)) (copy-file src-file full-path t t) (set-file-modes full-path install-overwritten-file-modes) (princ (format "%s -> %s\n" el-file dest))))) (setq src-file (expand-file-name elc-file src)) (if (not (file-exists-p src-file)) (let ((full-path (expand-file-name elc-file dest))) (if (and del-elc (file-exists-p full-path)) (if just-print (princ (format "%s -> to be deleted\n" full-path)) (delete-file full-path) (princ (format "%s -> deleted\n" full-path))))) (if just-print (princ (format "%s -> %s\n" elc-file dest)) (let ((full-path (expand-file-name elc-file dest))) (if (file-exists-p full-path) (delete-file full-path)) (copy-file src-file full-path t t) (set-file-modes full-path install-overwritten-file-modes) (catch 'tag (while (file-exists-p src-file) (condition-case err (progn (delete-file src-file) (throw 'tag nil)) (error (princ (format "%s\n" (nth 1 err))))))) (princ (format "%s -> %s\n" elc-file dest)))))))) (defun install-elisp-modules (modules src dest &optional just-print del-elc) (or just-print (file-exists-p dest) (make-directory dest t)) (mapcar (function (lambda (module) (install-elisp-module module src dest just-print del-elc))) modules)) ;;; @ detect install path ;;; ;; install to shared directory (maybe "/usr/local") (defvar install-prefix (if (or (<= emacs-major-version 18) (featurep 'xemacs) (featurep 'meadow) ; for Meadow (and (eq system-type 'windows-nt) ; for NTEmacs (>= emacs-major-version 20))) (expand-file-name "../../.." exec-directory) (expand-file-name "../../../.." data-directory))) (defvar install-elisp-prefix (if (>= emacs-major-version 19) "site-lisp" ;; v18 does not have standard site directory. "local.lisp")) ;; Avoid compile warning. (eval-when-compile (autoload 'replace-in-string "subr")) (defun install-detect-elisp-directory (&optional prefix elisp-prefix allow-version-specific) (or prefix (setq prefix install-prefix)) (or elisp-prefix (setq elisp-prefix install-elisp-prefix)) (or (catch 'tag (let ((rest (delq nil (copy-sequence default-load-path))) (regexp (concat "^" (regexp-quote (if (featurep 'xemacs) ;; Handle backslashes (Windows) (replace-in-string (file-name-as-directory (expand-file-name prefix)) "\\\\" "/") (file-name-as-directory (expand-file-name prefix)))) ".*/" (regexp-quote (if (featurep 'xemacs) ;; Handle backslashes (Windows) (replace-in-string elisp-prefix "\\\\" "/") elisp-prefix)) "/?$")) dir) (while rest (setq dir (if (featurep 'xemacs) ;; Handle backslashes (Windows) (replace-in-string (car rest) "\\\\" "/") (car rest))) (if (string-match regexp dir) (if (or allow-version-specific (not (string-match (format "/%d\\.%d" emacs-major-version emacs-minor-version) dir))) (throw 'tag (car rest)))) (setq rest (cdr rest))))) (expand-file-name (concat (if (and (not (featurep 'xemacs)) (or (>= emacs-major-version 20) (and (= emacs-major-version 19) (> emacs-minor-version 28)))) "share/" "lib/") (cond ((featurep 'xemacs) (if (featurep 'mule) "xmule/" "xemacs/")) ;; unfortunately, unofficial mule based on ;; 19.29 and later use "emacs/" by default. ((boundp 'MULE) "mule/") ((boundp 'NEMACS) "nemacs/") (t "emacs/")) elisp-prefix) prefix))) (defvar install-default-elisp-directory (install-detect-elisp-directory)) ;;; @ for XEmacs package system ;;; (defun install-get-default-package-directory () (let ((dirs (append (cond ((boundp 'early-package-hierarchies) (append (if early-package-load-path early-package-hierarchies) (if late-package-load-path late-package-hierarchies) (if last-package-load-path last-package-hierarchies)) ) ((boundp 'early-packages) (append (if early-package-load-path early-packages) (if late-package-load-path late-packages) (if last-package-load-path last-packages)) )) (if (and (boundp 'configure-package-path) (listp configure-package-path)) (delete "" configure-package-path)))) dir) (while (and (setq dir (car dirs)) (not (file-exists-p dir))) (setq dirs (cdr dirs))) dir)) (defun install-update-package-files (package dir &optional just-print) (cond (just-print (princ (format "Updating autoloads in directory %s..\n\n" dir)) (princ (format "Processing %s\n" dir)) (princ "Generating custom-load.el...\n\n") (princ (format "Compiling %s...\n" (expand-file-name "auto-autoloads.el" dir))) (princ (format "Wrote %s\n" (expand-file-name "auto-autoloads.elc" dir))) (princ (format "Compiling %s...\n" (expand-file-name "custom-load.el" dir))) (princ (format "Wrote %s\n" (expand-file-name "custom-load.elc" dir)))) (t (if (fboundp 'batch-update-directory-autoloads) ;; XEmacs 21.5.19 and newer. (let ((command-line-args-left (list package dir))) (batch-update-directory-autoloads)) (setq autoload-package-name package) (let ((command-line-args-left (list dir))) (batch-update-directory))) (let ((command-line-args-left (list dir))) (Custom-make-dependencies)) (byte-compile-file (expand-file-name "auto-autoloads.el" dir)) (byte-compile-file (expand-file-name "custom-load.el" dir))))) ;;; @ Other Utilities ;;; (defun install-just-print-p () (let ((flag (getenv "MAKEFLAGS")) (case-fold-search nil)) (princ (format "%s\n" flag)) (if flag (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag)))) ;;; @ end ;;; (require 'product) (product-provide (provide 'install) (require 'apel-ver)) ;;; install.el ends here apel-5bc1050/inv-18.el000066400000000000000000000044241174656234300143370ustar00rootroot00000000000000;;; inv-18.el --- invisible feature implementation for Emacs 18 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: invisible, text-property, region, Emacs 18 ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) (defun enable-invisible () (make-local-variable 'original-selective-display) (setq original-selective-display selective-display) (setq selective-display t)) (defun disable-invisible () (setq selective-display (and (boundp 'original-selective-display) original-selective-display))) (defalias 'end-of-invisible 'disable-invisible) (make-obsolete 'end-of-invisible 'disable-invisible) (defun invisible-region (start end) (let ((buffer-read-only nil) (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 ?\r t) (set-buffer-modified-p modp)))) (defun visible-region (start end) (let ((buffer-read-only nil) (modp (buffer-modified-p))) (unwind-protect (subst-char-in-region start end ?\r ?\n t) (set-buffer-modified-p modp)))) (defun invisible-p (pos) (save-excursion (goto-char pos) (eq (following-char) ?\r))) (defun next-visible-point (pos) (save-excursion (goto-char pos) (end-of-line) (if (eq (following-char) ?\n) (forward-char)) (point))) ;;; @ end ;;; (require 'product) (product-provide (provide 'inv-18) (require 'apel-ver)) ;;; inv-18.el ends here apel-5bc1050/inv-19.el000066400000000000000000000034451174656234300143420ustar00rootroot00000000000000;;; inv-19.el --- invisible feature implementation for Emacs 19 or later ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: invisible, text-property, region, Emacs 19 ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) (defun enable-invisible ()) (defun disable-invisible ()) (defalias 'end-of-invisible 'disable-invisible) (make-obsolete 'end-of-invisible 'disable-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) (if (setq pos (next-single-property-change pos 'invisible)) (if (eq ?\n (char-after pos)) (1+ pos) pos) (point-max))) ;;; @ end ;;; (require 'product) (product-provide (provide 'inv-19) (require 'apel-ver)) ;;; inv-19.el ends here apel-5bc1050/inv-23.el000066400000000000000000000033711174656234300143330ustar00rootroot00000000000000;;; inv-23.el --- invisible feature implementation for Emacs 23 or later ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2001, 2010 ;; Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: invisible, text-property, region, Emacs 23 ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) (defun enable-invisible ()) (defun disable-invisible ()) (defalias 'end-of-invisible 'disable-invisible) (make-obsolete 'end-of-invisible 'disable-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 next-visible-point (pos) (if (setq pos (next-single-property-change pos 'invisible)) (if (eq ?\n (char-after pos)) (1+ pos) pos) (point-max))) ;;; @ end ;;; (require 'product) (product-provide (provide 'inv-23) (require 'apel-ver)) ;;; inv-23.el ends here apel-5bc1050/inv-xemacs.el000066400000000000000000000037221174656234300153670ustar00rootroot00000000000000;;; inv-xemacs.el --- invisible feature implementation for XEmacs ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko ;; Keywords: invisible, text-property, region, 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., 51 Franklin Street, Fifth Floor, Boston, ;; MA 02110-1301, USA. ;;; Code: (require 'poe) (defun enable-invisible ()) (defun disable-invisible ()) (defalias 'end-of-invisible 'disable-invisible) (make-obsolete 'end-of-invisible 'disable-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)))) ;;; @ end ;;; (require 'product) (product-provide (provide 'inv-xemacs) (require 'apel-ver)) ;;; inv-xemacs.el ends here apel-5bc1050/invisible.el000066400000000000000000000024231174656234300152760ustar00rootroot00000000000000;;; invisible.el --- hide region ;; Copyright (C) 1995,1996,1997,1998,1999,2010 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: invisible, text-property, region ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (cond ((featurep 'xemacs) (require 'inv-xemacs)) ((>= emacs-major-version 23) (require 'inv-23)) ((>= emacs-major-version 19) (require 'inv-19)) (t (require 'inv-18))) ;;; @ end ;;; (require 'product) (product-provide (provide 'invisible) (require 'apel-ver)) ;;; invisible.el ends here apel-5bc1050/localhook.el000066400000000000000000000301441174656234300152660ustar00rootroot00000000000000;;; localhook.el --- local hook variable support in emacs-lisp. ;; Copyright (C) 1985,86,92,94,95,1999 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This file (re)defines the following functions. ;; These functions support local hook feature in emacs-lisp level. ;; ;; add-hook, remove-hook, make-local-hook, ;; run-hooks, run-hook-with-args, ;; run-hook-with-args-until-success, and ;; run-hook-with-args-until-failure. ;; The following functions which do not exist in 19.28 are used in the ;; original definitions of add-hook, remove-hook, and make-local-hook. ;; ;; local-variable-p, and local-variable-if-set-p. ;; ;; In this file, these functions are replaced with mock versions. ;; In addition, the following functions which do not exist in v18 are used. ;; ;; default-boundp, byte-code-function-p, functionp, member, and delete. ;; ;; These functions are provided by poe-18.el. ;; For historians: ;; ;; `add-hook' and `remove-hook' were introduced in v19. ;; ;; Local hook feature and `make-local-hook' were introduced in 19.29. ;; ;; `run-hooks' exists in v17. ;; `run-hook-with-args' was introduced in 19.23 as a lisp function. ;; Two variants of `run-hook-with-args' were introduced in 19.29 as ;; lisp functions. `run-hook' family became C primitives in 19.30. ;;; Code: ;; 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. ;; ;; (defun local-variable-p (variable &optional buffer) ;; "Non-nil if VARIABLE has a local binding in buffer BUFFER. ;; BUFFER defaults to the current buffer." ;; (and (or (assq variable (buffer-local-variables buffer)) ; local and bound. ;; (memq variable (buffer-local-variables buffer))); local but void. ;; ;; docstring is ambiguous; 20.3 returns bool value. ;; t)) ;; ;; (defun local-variable-if-set-p (variable &optional buffer) ;; "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there. ;; BUFFER defaults to the current buffer." ;; (and (or (assq variable (buffer-local-variables buffer)) ; local and bound. ;; (memq variable (buffer-local-variables buffer))); local but void. ;; ;; docstring is ambiguous; 20.3 returns bool value. ;; t)) ;;; Hook manipulation functions. ;; The following three functions are imported from emacs-20.3/lisp/subr.el. ;; (local-variable-p, and local-variable-if-set-p are expanded.) (defun make-local-hook (hook) "Make the hook HOOK local to the current buffer. The return value is HOOK. When a hook is local, its local and global values work in concert: running the hook actually runs all the hook functions listed in *either* the local value *or* the global value of the hook variable. This function works by making `t' a member of the buffer-local value, which acts as a flag to run the hook functions in the default value as well. This works for all normal hooks, but does not work for most non-normal hooks yet. We will be changing the callers of non-normal hooks so that they can handle localness; this has to be done one by one. This function does nothing if HOOK is already local in the current buffer. Do not use `make-local-variable' to make a hook variable buffer-local." (if ;; (local-variable-p hook) (or (assq hook (buffer-local-variables)) ; local and bound. (memq hook (buffer-local-variables))); local but void. nil (or (boundp hook) (set hook nil)) (make-local-variable hook) (set hook (list t))) hook) (defun add-hook (hook function &optional append local) "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. The optional fourth argument, LOCAL, if non-nil, says to modify the hook's buffer-local value rather than its default value. This makes no difference if the hook is not buffer-local. To make a hook variable buffer-local, always use `make-local-hook', not `make-local-variable'. 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." (or (boundp hook) (set hook nil)) (or (default-boundp hook) (set-default 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)))) (if (or local ;; Detect the case where make-local-variable was used on a hook ;; and do what we used to do. (and ;; (local-variable-if-set-p hook) (or (assq hook (buffer-local-variables)) ; local and bound. (memq hook (buffer-local-variables))); local but void. (not (memq t (symbol-value hook))))) ;; Alter the local value only. (or (if (or (consp function) (byte-code-function-p function)) (member function (symbol-value hook)) (memq function (symbol-value hook))) (set hook (if append (append (symbol-value hook) (list function)) (cons function (symbol-value hook))))) ;; Alter the global value (which is also the only value, ;; if the hook doesn't have a local value). (or (if (or (consp function) (byte-code-function-p function)) (member function (default-value hook)) (memq function (default-value hook))) (set-default hook (if append (append (default-value hook) (list function)) (cons function (default-value hook))))))) (defun remove-hook (hook function &optional local) "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'. The optional third argument, LOCAL, if non-nil, says to modify the hook's buffer-local value rather than its default value. This makes no difference if the hook is not buffer-local. To make a hook variable buffer-local, always use `make-local-hook', not `make-local-variable'." (if (or (not (boundp hook)) ;unbound symbol, or (not (default-boundp hook)) (null (symbol-value hook)) ;value is nil, or (null function)) ;function is nil, then nil ;Do nothing. (if (or local ;; Detect the case where make-local-variable was used on a hook ;; and do what we used to do. (and ;; (local-variable-p hook) (or (assq hook (buffer-local-variables)) ; local and bound. (memq hook (buffer-local-variables))); local but void. (consp (symbol-value hook)) (not (memq t (symbol-value hook))))) (let ((hook-value (symbol-value hook))) (if (consp hook-value) (if (member function hook-value) (setq hook-value (delete function (copy-sequence hook-value)))) (if (equal hook-value function) (setq hook-value nil))) (set hook hook-value)) (let ((hook-value (default-value hook))) (if (and (consp hook-value) (not (functionp hook-value))) (if (member function hook-value) (setq hook-value (delete function (copy-sequence hook-value)))) (if (equal hook-value function) (setq hook-value nil))) (set-default hook hook-value))))) ;;; Hook execution functions. (defun run-hook-with-args-internal (hook args cond) "Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. Its value should be a list of functions. We call those functions, one by one, passing arguments ARGS to each of them, until specified COND is satisfied. If COND is nil, we call those functions until one of them returns a non-nil value, and then we return that value. If COND is t, we call those functions until one of them returns nil, and then we return nil. If COND is not nil and not t, we call all the functions." (if (not (boundp hook)) ;; hook is void. (not cond) (let* ((functions (symbol-value hook)) (ret (eq cond t)) (all (and cond (not ret))) function) (if (functionp functions) ;; hook is just a function. (apply functions args) ;; hook is nil or a list of functions. (while (and functions (or all ; to-completion (if cond ret ; until-failure (null ret)))) ; until-success (setq function (car functions) functions(cdr functions)) (if (eq function t) ;; this hook has a local binding. ;; we must run the global binding too. (let ((globals (default-value hook)) global) (if (functionp globals) (setq ret (apply globals args)) (while (and globals (or all (if cond ret (null ret)))) (setq global (car globals) globals(cdr globals)) (or (eq global t) ; t should not occur. (setq ret (apply global args)))))) (setq ret (apply function args)))) ret)))) ;; The following four functions are direct translation of their ;; C definitions in emacs-20.3/src/eval.c. (defun run-hooks (&rest hooks) "Run each hook in HOOKS. Major mode functions use this. Each argument should be a symbol, a hook variable. These symbols are processed in the order specified. If a hook symbol has a non-nil value, that value may be a function or a list of functions to be called to run the hook. If the value is a function, it is called with no arguments. If it is a list, the elements are called, in order, with no arguments. To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'." (while hooks (run-hook-with-args-internal (car hooks) nil 'to-completion) (setq hooks (cdr hooks)))) (defun run-hook-with-args (hook &rest args) "Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. If HOOK has a non-nil value, that value may be a function or a list of functions to be called to run the hook. If the value is a function, it is called with the given arguments and its return value is returned. If it is a list of functions, those functions are called, in order, with the given arguments ARGS. It is best not to depend on the value return by `run-hook-with-args', as that may change. To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'." (run-hook-with-args-internal hook args 'to-completion)) (defun run-hook-with-args-until-success (hook &rest args) "Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. Its value should be a list of functions. We call those functions, one by one, passing arguments ARGS to each of them, until one of them returns a non-nil value. Then we return that value. If all the functions return nil, we return nil. To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'." (run-hook-with-args-internal hook args nil)) (defun run-hook-with-args-until-failure (hook &rest args) "Run HOOK with the specified arguments ARGS. HOOK should be a symbol, a hook variable. Its value should be a list of functions. We call those functions, one by one, passing arguments ARGS to each of them, until one of them returns nil. Then we return nil. If all the functions return non-nil, we return non-nil. To make a hook variable buffer-local, use `make-local-hook', not `make-local-variable'." (run-hook-with-args-internal hook args t)) ;;; localhook.el ends here apel-5bc1050/make1.bat000077500000000000000000000025561174656234300144700ustar00rootroot00000000000000echo off rem MAKE1.BAT for APEL. rem rem Version: $Id: make1.bat,v 1.1 2001-02-01 03:19:36 minakaji Exp $ rem Last Modified: $Date: 2001-02-01 03:19:36 $ rem --- argument rem --- elc : byte compile rem --- all, install : install rem --- clean : cleaning garbage file rem --- what-where : print where to install rem --- rem --- check calling from make.bat if not "%SUBMAKEOK%"=="OK" goto prnusage set SUBMAKEOK= rem argument check set arg1=%1 if "%arg1%"=="elc" goto compile if "%arg1%"=="all" goto install if "%arg1%"=="install" goto install if "%arg1%"=="what-where" goto listing if "%arg1%"=="clean" goto clean echo Unrecognized argument: specify either 'elc', 'all', echo 'install', 'clean' or 'what-where'. goto pauseend :compile %EMACS% -q -batch -no-site-file -l APEL-MK -f compile-apel NONE %LISPDIR% %VLISPDIR% goto end :install %EMACS% -q -batch -no-site-file -l APEL-MK -f install-apel NONE %LISPDIR% %VLISPDIR% goto end :listing %EMACS% -batch -q -no-site-file -l APEL-MK -f what-where-apel goto end :clean del *.elc rem --- This file should not be executed by itself. Use make.bat. :prnusage echo This file should not be executed by itself. Use make.bat. rem --- If error occurs, stay display until any key is typed. :pauseend echo Type any key when you're done reading the error message. pause :end  apel-5bc1050/makeit.bat000077500000000000000000000175131174656234300147430ustar00rootroot00000000000000@echo off rem --- rem --- common install batch file for Meadow & NTEmacs rem --- 1999/07/07, Masaki YATSU mailto:yatsu@aurora.dti.ne.jp rem --- cmail ML member rem --- modified 1999/12/01, Yuh Ohmura, mailto:yutopia@t3.rim.or.jp rem --- modified 2000/12/26, Takeshi Morishima mailto:tm@interaccess.com rem --- date $Date: 2001-02-01 03:19:36 $ rem --- version $Id: makeit.bat,v 1.1 2001-02-01 03:19:36 minakaji Exp $ set ELISPMK_APP=apel rem --- Japanese Comments: rem --- rem --- rem --- ɂ‚Ă make1.bat ̃RgQƂĂD rem --- makeit.bat ́ACXg[̊‹ϐݒ肵 rem --- make1.bat ďoăCXg[s܂B rem --- rem --- ϐݒ rem --- ̃RĝƂɂ PREFIX, EMACS, EXEC_PREFIX, LISPDIR, rem --- INFODIR, VERSION_SPECIFIC_LISPDIR ̊eϐCg̊‹ rem --- KɍĐݒ肵ĂD rem --- ɁCEMACS ̒lC rem --- Windows95/98 𗘗pĂ meadow95.exe rem --- WindowsNT4.0 𗘗pĂ meadownt.exe rem --- NTEmacs 𗘗pĂ emacs.exe rem --- w肷̂YȂ悤ɁD rem --- rem --- KXw肪I makeit.bat ͉̂ꂩ̃t@CƂ rem --- Rs[ĂƂD悵Ďs܂B(AbvO[h rem --- ̍ۂ makeit.bat ĕҏWKv܂.) D揇: rem --- rem --- 1-1. %HOME%\.elispmk.%ELISPMK_APP%.bat rem --- 1-2. %HOME%\elisp\elispmk.%ELISPMK_APP%.bat rem --- 1-3. %HOME%\config\elispmk.%ELISPMK_APP%.bat rem --- 1-4. c:\Program Files\Meadow\elispmk.%ELISPMK_APP%.bat rem --- 1-5. c:\Meadow\elispmk.%ELISPMK_APP%.bat rem --- 1-6. d:\Meadow\elispmk.%ELISPMK_APP%.bat rem --- rem --- 2-1. %HOME%\.elispmk.bat rem --- 2-2. %HOME%\elisp\elispmk.bat rem --- 2-3. %HOME%\config\elispmk.bat rem --- 2-4. c:\Program Files\Meadow\elispmk.bat rem --- 2-5. c:\Meadow\elispmk.bat rem --- 2-6. d:\Meadow\elispmk.bat rem --- rem --- ƂȂ܂B rem --- rem --- English Comments: rem --- rem --- Arguments rem --- Please refer to comment section of make1.bat. Makeit.bat rem --- will perform installation procedure by executing make1.bat. rem --- rem --- Specifying variables rem --- After this comment section, PREFIX, EMACS, EXEC_PREFIX, rem --- LISPDIR, INFODIR, VERSION_SPECIFIC_LISPDIR is defined using rem --- 'set' batch command. Please specify them appropriately rem --- according to your Emacs environment. Especially remember to set rem --- the EMACS variable to meadow95.exe if you use Meadow on rem --- Windows95/98, or to meadownt.exe if you use Meadow on rem --- WindowsNT4.0, or to emacs.exe if you use NTEmacs. rem --- rem --- After modification, you may make a copy of makeit.bat as a pre- rem --- configured file as one of the following name. Any future rem --- execution of makeit.bat will automatically use this pre- rem --- configured batch file instead of makeit.bat itself. (When rem --- upgrading new distribution file for example, you do not have to rem --- make modification to makeit.bat again.) A pre-configured batch rem --- file is searched in order listed below: rem --- rem --- 1-1. %HOME%\.elispmk.%ELISPMK_APP%.bat rem --- 1-2. %HOME%\elisp\elispmk.%ELISPMK_APP%.bat rem --- 1-3. %HOME%\config\elispmk.%ELISPMK_APP%.bat rem --- 1-4. c:\Program Files\Meadow\elispmk.%ELISPMK_APP%.bat rem --- 1-5. c:\Meadow\elispmk.%ELISPMK_APP%.bat rem --- 1-6. d:\Meadow\elispmk.%ELISPMK_APP%.bat rem --- rem --- 2-1. %HOME%\.elispmk.bat rem --- 2-2. %HOME%\elisp\elispmk.bat rem --- 2-3. %HOME%\config\elispmk.bat rem --- 2-4. c:\Program Files\Meadow\elispmk.bat rem --- 2-5. c:\Meadow\elispmk.bat rem --- 2-6. d:\Meadow\elispmk.bat rem --- ϐݒ̗ (Example of variable definition) rem --- c:\usr\Meadow ɃCXg[Ă 1.10 Meadow gp rem --- Ăꍇ̐ݒ. (An example of variable definition. In rem --- this example, Meadow 1.10 installed in c:\usr\Meadow directory rem --- is used.) rem --- set PREFIX=c:\usr\Meadow rem --- set EMACS=%PREFIX%\1.10\bin\meadow95.exe rem --- set EXEC_PREFIX= rem --- set LISPDIR=%PREFIX%\site-lisp rem --- set VERSION_SPECIFIC_LISPDIR=%PREFIX%\1.10\site-lisp rem --- set DEFAULT_MAKE_ARG=elc rem --- Ŝ߃ftHg̒lׂ͂ċ󕶎ɂȂĂ܂Bg rem --- ̃VXeɂ킹Ă̕ϐw肵ĂB(To take a rem --- safe side, default values are all set to null strings. Please rem --- specify these variables accordingly for your system.) rem --- ȂADEFAULT_MAKE_ARG ɉ”\Ȓl make1.bat 䗗B rem --- (Please see make1.bat for possible values of DEFAULT_MAKE_ARG.) set PREFIX= set EMACS= set LISPDIR= set DEFAULT_MAKE_ARG= rem --- makeit.bat Ă΂Ăꍇ͍ċAĂяo make1 s if not "%ELISPMK%"=="" goto execsubmk rem --- set ELISPMK=%HOME%\.elispmk.%ELISPMK_APP%.bat if exist %ELISPMK% goto execelmkb set ELISPMK=%HOME%\elisp\elispmk.%ELISPMK_APP%.bat if exist %ELISPMK% goto execelmkb set ELISPMK=%HOME%\config\elispmk.%ELISPMK_APP%.bat if exist %ELISPMK% goto execelmkb set ELISPMK="c:\Program Files\Meadow\elispmk.%ELISPMK_APP%.bat" if exist %ELISPMK% goto execelmkb set ELISPMK=c:\Meadow\elispmk.%ELISPMK_APP%.bat if exist %ELISPMK% goto execelmkb set ELISPMK=d:\Meadow\elispmk.%ELISPMK_APP%.bat if exist %ELISPMK% goto execelmkb rem --- set ELISPMK=%HOME%\.elispmk.bat if exist %ELISPMK% goto execelmkb set ELISPMK=%HOME%\elisp\elispmk.bat if exist %ELISPMK% goto execelmkb set ELISPMK=%HOME%\config\elispmk.bat if exist %ELISPMK% goto execelmkb set ELISPMK="c:\Program Files\Meadow\elispmk.bat" if exist %ELISPMK% goto execelmkb set ELISPMK=c:\Meadow\elispmk.bat if exist %ELISPMK% goto execelmkb set ELISPMK=d:\Meadow\elispmk.bat if exist %ELISPMK% goto execelmkb echo ---- echo INFORMATIVE: No pre-configured batch (e.g. ~/.elispmk.bat echo INVORMATIVE: or ~/.elispmk.%ELISPMK_APP%.bat) found. echo INFORMATIVE: You may create one for your convenience. echo INFORMATIVE: See comments in makeit.bat. echo ---- :execsubmk set ELISPMK= rem --- %EMACS% ꍇ̓G[I if "%EMACS%"=="" goto errnotspecified if not exist "%EMACS%" goto errnonexistent rem --- MAKE1.BAT Control set SUBMAKEOK=OK echo ---- echo Executing make1.bat in the current directory using the folloiwing env. echo HOME=%HOME% echo PREFIX=%PREFIX% echo EMACS=%EMACS% echo EXEC_PREFIX=%EXEC_PREFIX% echo LISPDIR=%LISPDIR% echo INFODIR=%INFODIR% echo VERSION_SPECIFIC_LISPDIR=%VERSION_SPECIFIC_LISPDIR% echo ---- set ARG=%1 if "%ARG%"=="" set ARG=%DEFAULT_MAKE_ARG% echo Executing .\make1.bat with argument=%ARG% .\make1.bat %ARG% echo Error: for some reason .\make1.bat could not be executed. echo Please check if .\make1.bat exists and correct. goto pauseend :execelmkb echo ---- echo Found %ELISPMK%. Executing it... echo ---- %ELISPMK% %1 echo Error: for some reason %ELISPMK% could not be executed. echo Please check if ELISPMK=%ELISPMK% exists and correct. goto printenv rem --- %EMACS% ݒ肳ĂȂ :errnotspecified echo Error: Environment variable EMACS is not specified. goto printenv rem --- %EMACS% ɐݒ肳Ăt@C݂Ȃ :errnonexistent echo Error: EMACS=%EMACS% does not exist. :printenv echo ---- echo Check correctness of the following environment variables. echo HOME=%HOME% echo PREFIX=%PREFIX% echo EMACS=%EMACS% echo EXEC_PREFIX=%EXEC_PREFIX% echo LISPDIR=%LISPDIR% echo INFODIR=%INFODIR% echo VERSION_SPECIFIC_LISPDIR=%VERSION_SPECIFIC_LISPDIR% echo DEFAULT_MAKE_ARG=%DEFAULT_MAKE_ARG% echo See comments in makeit.bat and make1.bat for setup instruction. echo ---- :pauseend echo Type any key when you're done reading the error message. pause rem --- end of makeit.bat :end apel-5bc1050/mcharset.el000066400000000000000000000065751174656234300151340ustar00rootroot00000000000000;;; mcharset.el --- MIME charset API ;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) (require 'pcustom) (cond ((featurep 'mule) (if (>= emacs-major-version 20) (require 'mcs-20) ;; 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 (mime-charset-p '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 apel-5bc1050/mcs-20.el000066400000000000000000000151401174656234300143130ustar00rootroot00000000000000;;; mcs-20.el --- MIME charset implementation for Emacs 20 and XEmacs/mule ;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule) ;; or later. ;;; Code: (require 'custom) (eval-when-compile (require 'wid-edit)) (if (featurep 'xemacs) (require 'mcs-xm) (require 'mcs-e20)) ;;; @ 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) (iso-2022-jp-3 . 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) )))) (defalias 'mime-charset-p 'mime-charset-to-coding-system) (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-unknown "Default value of MIME-charset. It is used when MIME-charset is not specified. It must be symbol." :group 'i18n :type 'mime-charset) (cond ((featurep 'utf-2000) ;; for CHISE Architecture (defun mcs-region-repertoire-p (start end charsets &optional buffer) (save-excursion (if buffer (set-buffer buffer)) (save-restriction (narrow-to-region start end) (goto-char (point-min)) (catch 'tag (let (ch) (while (not (eobp)) (setq ch (char-after (point))) (unless (some (lambda (ccs) (encode-char ch ccs)) charsets) (throw 'tag nil)) (forward-char))) t)))) (defun mcs-string-repertoire-p (string charsets &optional start end) (let ((i (if start (if (< start 0) (error 'args-out-of-range string start end) start) 0)) ch) (if end (if (> end (length string)) (error 'args-out-of-range string start end)) (setq end (length string))) (catch 'tag (while (< i end) (setq ch (aref string i)) (unless (some (lambda (ccs) (encode-char ch ccs)) charsets) (throw 'tag nil)) (setq i (1+ i))) t))) (defun detect-mime-charset-region (start end) "Return MIME charset for region between START and END." (let ((rest charsets-mime-charset-alist) cell) (catch 'tag (while rest (setq cell (car rest)) (if (mcs-region-repertoire-p start end (car cell)) (throw 'tag (cdr cell))) (setq rest (cdr rest))) default-mime-charset-for-write))) (defun detect-mime-charset-string (string) "Return MIME charset for STRING." (let ((rest charsets-mime-charset-alist) cell) (catch 'tag (while rest (setq cell (car rest)) (if (mcs-string-repertoire-p string (car cell)) (throw 'tag (cdr cell))) (setq rest (cdr rest))) default-mime-charset-for-write))) ) (t ;; for legacy Mule (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 apel-5bc1050/mcs-e20.el000066400000000000000000000147531174656234300144710ustar00rootroot00000000000000;;; mcs-e20.el --- MIME charset implementation for Emacs 20.1 and 20.2 ;; Copyright (C) 1996,1997,1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module requires Emacs 20.1 and 20.2. ;;; Code: (require 'pces) (eval-when-compile (require 'static)) (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 (delq nil `(((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) ,(if (find-coding-system 'iso-8859-14) '((ascii latin-iso8859-14) . iso-8859-14)) ,(if (find-coding-system 'iso-8859-15) '((ascii latin-iso8859-15) . iso-8859-15)) ((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 'product) (product-provide (provide 'mcs-e20) (require 'apel-ver)) ;;; mcs-e20.el ends here apel-5bc1050/mcs-ltn1.el000066400000000000000000000062521174656234300147540ustar00rootroot00000000000000;;; mcs-ltn1.el --- MIME charset implementation for Emacs 19 ;;; and XEmacs without MULE ;; Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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 &optional lbt) (if (stringp charset) (setq charset (intern (downcase charset)))) (if (memq charset (list 'us-ascii default-mime-charset)) charset)) (defalias 'mime-charset-p 'mime-charset-to-coding-system) (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 apel-5bc1050/mcs-nemacs.el000066400000000000000000000074601174656234300153460ustar00rootroot00000000000000;;; mcs-nemacs.el --- MIME charset implementation for Nemacs ;; Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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) )) (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 &optional lbt) (if (stringp charset) (setq charset (intern (downcase charset))) ) (cdr (assq charset mime-charset-coding-system-alist))) (fset 'mime-charset-p 'mime-charset-to-coding-system) (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 &optional lbt) "Encode the text between START and END as MIME CHARSET. \[emu-nemacs.el]" (let ((cs (mime-charset-to-coding-system charset)) (nl (lbt-to-string lbt))) (and (numberp cs) (or (= cs 3) (save-excursion (save-restriction (narrow-to-region start end) (convert-region-kanji-code start end 3 cs) (if nl (progn (goto-char (point-min)) (while (search-forward "\n" nil t) (replace-match nl))) ))) )))) (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 (lbt-to-string lbt))) (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 &optional lbt) "Encode the STRING as MIME CHARSET. [emu-nemacs.el]" (with-temp-buffer (insert string) (encode-mime-charset-region (point-min)(point-max) charset lbt) (buffer-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 ;;; (require 'product) (product-provide (provide 'mcs-nemacs) (require 'apel-ver)) ;;; mcs-nemacs.el ends here apel-5bc1050/mcs-om.el000066400000000000000000000171701174656234300145120ustar00rootroot00000000000000;;; mcs-om.el --- MIME charset implementation for Mule 1.* and Mule 2.* ;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poem) (defsubst lbt-to-string (lbt) (cdr (assq lbt '((nil . nil) (CRLF . "\r\n") (CR . "\r") (dos . "\r\n") (mac . "\r")))) ) (defun encode-mime-charset-region (start end charset &optional lbt) "Encode the text between START and END as MIME CHARSET." (let ((cs (mime-charset-to-coding-system charset lbt))) (if cs (code-convert start end *internal* cs) (if (and lbt (setq cs (mime-charset-to-coding-system charset))) (let ((newline (lbt-to-string lbt))) (save-excursion (save-restriction (narrow-to-region start end) (code-convert (point-min) (point-max) *internal* cs) (if newline (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 ((cs (mime-charset-to-coding-system charset lbt))) (if cs (code-convert start end cs *internal*) (if (and lbt (setq cs (mime-charset-to-coding-system 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"))) (code-convert (point-min) (point-max) cs *internal*)) (code-convert start end cs *internal*))))))) (defun encode-mime-charset-string (string charset &optional lbt) "Encode the STRING as MIME CHARSET." (let ((cs (mime-charset-to-coding-system charset lbt))) (if cs (code-convert-string string *internal* cs) (if (and lbt (setq cs (mime-charset-to-coding-system charset))) (let ((newline (lbt-to-string lbt))) (if newline (with-temp-buffer (insert string) (code-convert (point-min) (point-max) *internal* cs) (goto-char (point-min)) (while (search-forward "\n" nil t) (replace-match newline)) (buffer-string)) (decode-coding-string string 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))) (if cs (decode-coding-string string cs) (if (and lbt (setq cs (mime-charset-to-coding-system charset))) (let ((newline (lbt-to-string lbt))) (if newline (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 ((and (>= emacs-major-version 19) (>= emacs-minor-version 29)) ;; 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 ;;; (condition-case nil (require 'cyrillic) (error nil)) (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) "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))) ) (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.") (defvar default-mime-charset-for-write default-mime-charset "Default value of MIME-charset for encoding. It is used when suitable MIME-charset is not found. It must be symbol.") (defun detect-mime-charset-region (start end) "Return MIME charset for region between START and END." (or (charsets-to-mime-charset (cons lc-ascii (find-charset-region start end))) default-mime-charset-for-write)) ;;; @ end ;;; (require 'product) (product-provide (provide 'mcs-om) (require 'apel-ver)) ;;; mcs-om.el ends here apel-5bc1050/mcs-xm.el000066400000000000000000000163541174656234300145260ustar00rootroot00000000000000;;; mcs-xm.el --- MIME charset implementation for XEmacs-mule ;; Copyright (C) 1997,1998,1999,2000,2002,2010 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME-charset, coding-system, 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule) ;; or later. ;;; Code: (require 'poem) (defun encode-mime-charset-region (start end charset &optional lbt) "Encode the text between START and END as MIME CHARSET." (let ((cs (mime-charset-to-coding-system charset lbt))) (if cs (encode-coding-region start end cs) ))) (defcustom mime-charset-decoder-alist (let ((alist '((hz-gb-2312 . decode-mime-charset-region-for-hz) (t . decode-mime-charset-region-default)))) (if (featurep 'utf-2000) alist (list* '(iso-2022-jp . decode-mime-charset-region-with-iso646-unification) '(iso-2022-jp-2 . decode-mime-charset-region-with-iso646-unification) alist))) "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) ))) (unless (featurep 'utf-2000) (require 'mcs-xmu)) (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))) (defun encode-mime-charset-string (string charset &optional lbt) "Encode the STRING as MIME CHARSET." (let ((cs (mime-charset-to-coding-system charset lbt))) (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 (delq nil `(((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) ,(if (find-coding-system 'iso-8859-14) '((ascii latin-iso8859-14) . iso-8859-14)) ,(if (find-coding-system 'iso-8859-15) '((ascii latin-iso8859-15) . iso-8859-15)) ;; ,(if (featurep 'utf-2000) ;; '((ascii latin-jisx0201 ;; japanese-jisx0208-1978 ;; japanese-jisx0208 ;; japanese-jisx0208-1990) . iso-2022-jp) ;; '((ascii latin-jisx0201 ;; japanese-jisx0208-1978 japanese-jisx0208) ;; . iso-2022-jp)) ((ascii latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208) . iso-2022-jp) ;; ,(if (featurep 'utf-2000) ;; '((ascii latin-jisx0201 ;; japanese-jisx0208-1978 ;; japanese-jisx0208 ;; japanese-jisx0208-1990 ;; japanese-jisx0213-1 ;; japanese-jisx0213-2) . iso-2022-jp-3) ;; '((ascii latin-jisx0201 ;; japanese-jisx0208-1978 japanese-jisx0208 ;; japanese-jisx0213-1 ;; japanese-jisx0213-2) . iso-2022-jp-3)) ,(if (featurep 'utf-2000) '((ascii latin-jisx0201 katakana-jisx0201 japanese-jisx0208-1990) . utf-8) '((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-xtis) . tis-620) ;; ,(if (featurep 'utf-2000) ;; '((ascii latin-jisx0201 latin-iso8859-1 ;; greek-iso8859-7 ;; japanese-jisx0208-1978 japanese-jisx0208 ;; japanese-jisx0208-1990 ;; japanese-jisx0212 ;; chinese-gb2312 ;; korean-ksc5601) . iso-2022-jp-2) ;; '((ascii latin-jisx0201 latin-iso8859-1 ;; greek-iso8859-7 ;; japanese-jisx0208-1978 japanese-jisx0208 ;; japanese-jisx0212 ;; chinese-gb2312 ;; korean-ksc5601) . 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 ;;; (require 'product) (product-provide (provide 'mcs-xm) (require 'apel-ver)) ;;; mcs-xm.el ends here apel-5bc1050/mcs-xmu.el000066400000000000000000000061521174656234300147060ustar00rootroot00000000000000;;; mcs-xmu.el --- Functions to unify ISO646 characters for XEmacs-mule ;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module will be loaded from mcs-xm automatically. ;; There is no guarantee that it will work alone. ;;; Code: (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. It is referred by the function `decode-mime-charset-region-with-iso646-unification'. If the length of the specified region (start end) is larger than its value, the function works for only decoding MIME-CHARSET. If it is nil, size is unlimited." :group 'i18n :type '(radio (integer :tag "Max size") (const :tag "Unlimited" nil))) (defun decode-mime-charset-region-with-iso646-unification (start end charset lbt) (save-excursion (save-restriction (narrow-to-region start end) (if (prog1 (or (null mime-character-unification-limit-size) (<= (- end start) mime-character-unification-limit-size)) (decode-mime-charset-region-default start end charset lbt)) (let ((rest mime-iso646-character-unification-alist)) (while rest (let ((pair (car rest)) case-fold-search) (goto-char (point-min)) (while (search-forward (car pair) nil t) (let ((str (cdr pair))) (if mime-unified-character-face (put-text-property 0 (length str) 'face mime-unified-character-face str)) (replace-match str 'fixed-case 'literal) ) )) (setq rest (cdr rest))))) ))) ;;; @ end ;;; (require 'product) (product-provide (provide 'mcs-xmu) (require 'apel-ver)) ;;; mcs-xmu.el ends here apel-5bc1050/mule-caesar.el000066400000000000000000000051101174656234300155040ustar00rootroot00000000000000;;; mule-caesar.el --- ROT 13-47 Caesar rotation utility ;; Copyright (C) 1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: ROT 13-47, caesar, mail, news, text/x-rot13-47 ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'emu) ; for backward compatibility. (require 'poe) ; char-after. (require 'poem) ; charset-chars, char-charset, ; and split-char. (defun mule-caesar-region (start end &optional stride-ascii) "Caesar rotation of current region. Optional argument STRIDE-ASCII is rotation-size for Latin alphabet \(A-Z and a-z). For non-ASCII text, ROT-N/2 will be performed in any case (N=charset-chars; 94 for 94 or 94x94 graphic character set; 96 for 96 or 96x96 graphic character set)." (interactive "r\nP") (setq stride-ascii (if stride-ascii (mod stride-ascii 26) 13)) (save-excursion (save-restriction (narrow-to-region start end) (goto-char start) (while (< (point)(point-max)) (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)))) ))) ))))) (require 'product) (product-provide (provide 'mule-caesar) (require 'apel-ver)) ;;; mule-caesar.el ends here apel-5bc1050/path-util.el000066400000000000000000000127371174656234300152320ustar00rootroot00000000000000;;; path-util.el --- Emacs Lisp file detection utility ;; Copyright (C) 1996,1997,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) (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 `default-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 (or (member p load-path) (if (string-match "/$" p) (member (substring p 0 (1- (length p))) load-path) (member (file-name-as-directory 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) ) (let (files) (catch 'tag (while suffixes (let ((suf (car suffixes))) (if (and (not (string= suf "")) (string-match (concat (regexp-quote suf) "$") file)) (progn (setq files (list file)) (throw 'tag nil) ) (setq files (cons (concat file suf) files)) ) (setq suffixes (cdr suffixes)) ))) (setq files (nreverse files)) (catch 'tag (while paths (let ((path (car paths)) (files files) ) (while files (setq file (expand-file-name (car files) path)) (if (file-executable-p file) (throw 'tag file) ) (setq files (cdr files)) ) (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) (let ((file (symbol-name module))) (or paths (setq paths load-path) ) (catch 'tag (while paths (let ((stem (expand-file-name file (car paths))) (sufs '(".elc" ".el")) ) (while sufs (let ((file (concat stem (car sufs)))) (if (file-exists-p file) (throw 'tag file) )) (setq sufs (cdr sufs)) )) (setq paths (cdr paths)) ))))) ;;; @ end ;;; (require 'product) (product-provide (provide 'path-util) (require 'apel-ver)) ;;; path-util.el ends here apel-5bc1050/pccl-20.el000066400000000000000000000133521174656234300144550ustar00rootroot00000000000000;;; pccl-20.el --- Portable CCL utility for Emacs 20 and XEmacs-21-mule ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Copyright (C) 1998 Tanaka Akira ;; Author: Tanaka Akira ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (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 (static-if (featurep 'xemacs) (defadvice make-coding-system (before ccl-compat (name type &rest ad-subr-args) activate) (when (and (integerp type) (eq type 4) (characterp (ad-get-arg 2)) (stringp (ad-get-arg 3)) (consp (ad-get-arg 4)) (symbolp (car (ad-get-arg 4))) (symbolp (cdr (ad-get-arg 4)))) (setq type 'ccl) (setq ad-subr-args (list (ad-get-arg 3) (append (list 'mnemonic (char-to-string (ad-get-arg 2)) 'decode (symbol-value (car (ad-get-arg 4))) 'encode (symbol-value (cdr (ad-get-arg 4)))) (ad-get-arg 5))))))) (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." (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." (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. (Fixed on Emacs 20.4)" (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. (Fixed on Emacs 20.3)" (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. (Fixed on Emacs 20.4)" (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. (Fixed on Emacs 20.4)" (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 ;;; (require 'product) (product-provide (provide 'pccl-20) (require 'apel-ver)) ;;; pccl-20.el ends here apel-5bc1050/pccl-om.el000066400000000000000000000105231174656234300146440ustar00rootroot00000000000000;;; pccl-om.el --- Portable CCL utility for Mule 2.* ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Copyright (C) 1998 Tanaka Akira ;; Author: Tanaka Akira ;; Shuhei KOBAYASHI ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (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." (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." (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 (code-convert-string "" *internal* '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 (code-convert-string "a" *internal* '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 (code-convert-string "" 'test-ccl-eof-block-cs *internal*) "[EOF]")) (broken-facility ccl-execute-eof-block-on-decoding-some "Emacs forgets executing CCL_EOF_BLOCK with decoding on non-empty input." (equal (code-convert-string "a" 'test-ccl-eof-block-cs *internal*) "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) (broken-facility ccl-cascading-read "Emacs CCL read command does not accept more than 2 arguments." (condition-case nil (progn (define-ccl-program cascading-read-test '(1 (read r0 r1 r2))) t) (error nil))) ;;; @ end ;;; (require 'product) (product-provide (provide 'pccl-om) (require 'apel-ver)) ;;; pccl-om.el ends here apel-5bc1050/pccl.el000066400000000000000000000135661174656234300142450ustar00rootroot00000000000000;;; pccl.el --- Portable CCL utility for Mule 2.* ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'broken) (broken-facility ccl-usable "Emacs has not CCL." (and (featurep 'mule) (if (featurep 'xemacs) (>= emacs-major-version 21) (>= emacs-major-version 19)))) (unless-broken ccl-usable (require 'advice) (if (featurep 'mule) (progn (require 'ccl) (if (featurep 'xemacs) (if (>= emacs-major-version 21) ;; for XEmacs 21 with mule (require 'pccl-20)) (if (>= emacs-major-version 20) ;; for Emacs 20 (require 'pccl-20) ;; for Mule 2.* (require 'pccl-om))))) (static-if (or (featurep 'xemacs) (< emacs-major-version 21)) (defadvice define-ccl-program (before accept-long-ccl-program activate) "When CCL-PROGRAM is too long, internal buffer is extended automatically." (let ((try-ccl-compile t) (prog (eval (ad-get-arg 1)))) (ad-set-arg 1 (` '(, prog))) (while try-ccl-compile (setq try-ccl-compile nil) (condition-case sig (ccl-compile prog) (args-out-of-range (if (and (eq (car (cdr sig)) ccl-program-vector) (= (car (cdr (cdr sig))) (length ccl-program-vector))) (setq ccl-program-vector (make-vector (* 2 (length ccl-program-vector)) 0) try-ccl-compile t) (signal (car sig) (cdr sig))))))))) (static-when (and (not (featurep 'xemacs)) (< emacs-major-version 21)) (defun-maybe transform-make-coding-system-args (name type &optional doc-string props) "For internal use only. Transform XEmacs style args for `make-coding-system' to Emacs style. Value is a list of transformed arguments." (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?"))) (eol-type (plist-get props 'eol-type)) properties tmp) (cond ((eq eol-type 'lf) (setq eol-type 'unix)) ((eq eol-type 'crlf) (setq eol-type 'dos)) ((eq eol-type 'cr) (setq eol-type 'mac))) (if (setq tmp (plist-get props 'post-read-conversion)) (setq properties (plist-put properties 'post-read-conversion tmp))) (if (setq tmp (plist-get props 'pre-write-conversion)) (setq properties (plist-put properties 'pre-write-conversion tmp))) (cond ((eq type 'shift-jis) (` ((, name) 1 (, mnemonic) (, doc-string) nil (, properties) (, eol-type)))) ((eq type 'iso2022) ; This is not perfect. (if (plist-get props 'escape-quoted) (error "escape-quoted is not supported: %S" (` ((, name) (, type) (, doc-string) (, props))))) (let ((g0 (plist-get props 'charset-g0)) (g1 (plist-get props 'charset-g1)) (g2 (plist-get props 'charset-g2)) (g3 (plist-get props 'charset-g3)) (use-roman (and (eq (cadr (assoc 'latin-jisx0201 (plist-get props 'input-charset-conversion))) 'ascii) (eq (cadr (assoc 'ascii (plist-get props 'output-charset-conversion))) 'latin-jisx0201))) (use-oldjis (and (eq (cadr (assoc 'japanese-jisx0208-1978 (plist-get props 'input-charset-conversion))) 'japanese-jisx0208) (eq (cadr (assoc 'japanese-jisx0208 (plist-get props 'output-charset-conversion))) 'japanese-jisx0208-1978)))) (if (charsetp g0) (if (plist-get props 'force-g0-on-output) (setq g0 (` (nil (, g0)))) (setq g0 (` ((, g0) t))))) (if (charsetp g1) (if (plist-get props 'force-g1-on-output) (setq g1 (` (nil (, g1)))) (setq g1 (` ((, g1) t))))) (if (charsetp g2) (if (plist-get props 'force-g2-on-output) (setq g2 (` (nil (, g2)))) (setq g2 (` ((, g2) t))))) (if (charsetp g3) (if (plist-get props 'force-g3-on-output) (setq g3 (` (nil (, g3)))) (setq g3 (` ((, g3) t))))) (` ((, name) 2 (, mnemonic) (, doc-string) ((, g0) (, g1) (, g2) (, g3) (, (plist-get props 'short)) (, (not (plist-get props 'no-ascii-eol))) (, (not (plist-get props 'no-ascii-cntl))) (, (plist-get props 'seven)) t (, (not (plist-get props 'lock-shift))) (, use-roman) (, use-oldjis) (, (plist-get props 'no-iso6429)) nil nil nil nil) (, properties) (, eol-type))))) ((eq type 'big5) (` ((, name) 3 (, mnemonic) (, doc-string) nil (, properties) (, eol-type)))) ((eq type 'ccl) (` ((, name) 4 (, mnemonic) (, doc-string) ((, (plist-get props 'decode)) . (, (plist-get props 'encode))) (, properties) (, eol-type)))) (t (error "unsupported XEmacs style make-coding-style arguments: %S" (` ((, name) (, type) (, doc-string) (, props)))))))) (defadvice make-coding-system (before ccl-compat (name type &rest ad-subr-args) activate) "Emulate XEmacs style make-coding-system." (when (and (symbolp type) (not (memq type '(t nil)))) (let ((args (apply 'transform-make-coding-system-args name type ad-subr-args))) (setq type (cadr args) ad-subr-args (cddr args))))))) ;;; @ end ;;; (require 'product) (product-provide (provide 'pccl) (require 'apel-ver)) ;;; pccl.el ends here apel-5bc1050/pces-20.el000066400000000000000000000211041174656234300144600ustar00rootroot00000000000000;;; -*-byte-compile-dynamic: t;-*- ;;; pces-20.el --- pces submodule for Emacs 20 and XEmacs with coding-system ;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module requires Emacs 20.0.93, XEmacs 20.3-b5 (with mule) ;; or later. ;;; Code: ;; (defun-maybe-cond multibyte-string-p (object) ;; "Return t if OBJECT is a multibyte string." ;; ((featurep 'mule) (stringp object)) ;; (t nil)) ;;; @ 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 jam-zcat-filename-list) (write-region start end filename append visit lockname))) (require 'broken) (broken-facility insert-file-contents-literally-treats-binary "Function `insert-file-contents-literally' decodes text." (let* ((str "\r\n") (coding-system-for-write 'binary) (coding-system-for-read 'raw-text-dos) ;; (default-enable-multibyte-characters (multibyte-string-p str)) ) (with-temp-buffer (insert str) (write-region (point-min)(point-max) "literal-test-file") ) (string= (with-temp-buffer (let (file-name-handler-alist) (insert-file-contents-literally "literal-test-file") ) (buffer-string) ) str))) (broken-facility insert-file-contents-literally-treats-file-name-handler "Function `insert-file-contents' doesn't call file-name-handler." (let (called) (with-temp-buffer (let ((file-name-handler-alist '(("literal-test-file" . (lambda (operation &rest args) (setq called t) (let (file-name-handler-alist) (apply operation args) )))))) (insert-file-contents-literally "literal-test-file") ) (delete-file "literal-test-file") ) called)) (static-if (or (broken-p 'insert-file-contents-literally-treats-binary) (broken-p 'insert-file-contents-literally-treats-file-name-handler)) (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) (jam-zcat-filename-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))))) (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 insert-file-contents-as-raw-text-CRLF (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 from CRLF to LF." (let ((coding-system-for-read 'raw-text-dos) 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))) (defun find-file-noselect-as-binary (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but don't code and format conversion." (let ((coding-system-for-read 'binary) format-alist) (find-file-noselect filename nowarn rawfile))) (defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but it does not code and format conversion except for line-break code." (let ((coding-system-for-read 'raw-text) format-alist) (find-file-noselect filename nowarn rawfile))) (defun find-file-noselect-as-raw-text-CRLF (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but it does not code and format conversion except for line-break code." (let ((coding-system-for-read 'raw-text-dos) format-alist) (find-file-noselect filename nowarn rawfile))) (defun save-buffer-as-binary (&optional args) "Like `save-buffer', q.v., but don't encode." (let ((coding-system-for-write 'binary)) (save-buffer args))) (defun save-buffer-as-raw-text-CRLF (&optional args) "Like `save-buffer', q.v., but save as network representation." (let ((coding-system-for-write 'raw-text-dos)) (save-buffer args))) (defun open-network-stream-as-binary (name buffer host service) "Like `open-network-stream', q.v., but don't code conversion." (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (open-network-stream name buffer host service))) ;;; @ with code-conversion ;;; (defun insert-file-contents-as-coding-system (coding-system filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will be applied to `coding-system-for-read'." (let ((coding-system-for-read coding-system) format-alist) (insert-file-contents filename visit beg end replace))) (defun write-region-as-coding-system (coding-system start end filename &optional append visit lockname) "Like `write-region', q.v., but CODING-SYSTEM the first arg will be applied to `coding-system-for-write'." (let ((coding-system-for-write coding-system) jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end filename append visit lockname))) (defun find-file-noselect-as-coding-system (coding-system filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will be applied to `coding-system-for-read'." (let ((coding-system-for-read coding-system) format-alist) (find-file-noselect filename nowarn rawfile))) (defun save-buffer-as-coding-system (coding-system &optional args) "Like `save-buffer', q.v., but CODING-SYSTEM the first arg will be applied to `coding-system-for-write'." (let ((coding-system-for-write coding-system)) (save-buffer args))) ;;; @ end ;;; (require 'product) (product-provide (provide 'pces-20) (require 'apel-ver)) ;;; pces-20.el ends here apel-5bc1050/pces-e20.el000066400000000000000000000027071174656234300146350ustar00rootroot00000000000000;;; pces-e20.el --- pces submodule for Emacs 20 ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'pces-20) (unless (and (fboundp 'set-buffer-multibyte) (subrp (symbol-function 'set-buffer-multibyte))) (require 'pces-e20_2) ; for Emacs 20.1 and 20.2 ) (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 'product) (product-provide (provide 'pces-e20) (require 'apel-ver)) ;;; pces-e20.el ends here apel-5bc1050/pces-e20_2.el000066400000000000000000000124211174656234300150500ustar00rootroot00000000000000;;; -*-byte-compile-dynamic: t;-*- ;;; pces-e20_2.el --- pces implementation for Emacs 20.1 and 20.2 ;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module requires Emacs 20.1 and 20.2. ;;; Code: ;;; @ 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)))) (defun insert-file-contents-as-raw-text-CRLF (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 from CRLF to LF." (let ((flag enable-multibyte-characters) (coding-system-for-read 'raw-text-dos) 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 find-file-noselect-as-binary (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but don't code and format conversion." (let ((flag enable-multibyte-characters) (coding-system-for-read 'binary) format-alist) (save-current-buffer (prog1 (set-buffer (find-file-noselect filename nowarn rawfile)) (set-buffer-multibyte flag))))) (defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but it does not code and format conversion except for line-break code." (let ((flag enable-multibyte-characters) (coding-system-for-read 'raw-text) format-alist) (save-current-buffer (prog1 (set-buffer (find-file-noselect filename nowarn rawfile)) (set-buffer-multibyte flag))))) (defun find-file-noselect-as-raw-text-CRLF (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but it does not code and format conversion except for line-break code." (let ((flag enable-multibyte-characters) (coding-system-for-read 'raw-text-dos) format-alist) (save-current-buffer (prog1 (set-buffer (find-file-noselect filename nowarn rawfile)) (set-buffer-multibyte flag))))) ;;; @ with code-conversion ;;; (defun insert-file-contents-as-coding-system (coding-system filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will be applied to `coding-system-for-read'." (let ((flag enable-multibyte-characters) (coding-system-for-read coding-system) format-alist) (prog1 (insert-file-contents filename visit beg end replace) (set-buffer-multibyte flag)))) (defun find-file-noselect-as-coding-system (coding-system filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will be applied to `coding-system-for-read'." (let ((flag enable-multibyte-characters) (coding-system-for-read coding-system) format-alist) (save-current-buffer (prog1 (set-buffer (find-file-noselect filename nowarn rawfile)) (set-buffer-multibyte flag))))) ;;; @ end ;;; (require 'product) (product-provide (provide 'pces-e20_2) (require 'apel-ver)) ;;; pces-e20_2.el ends here apel-5bc1050/pces-nemacs.el000066400000000000000000000221041174656234300155060ustar00rootroot00000000000000;;; pces-nemacs.el --- pces implementation for Nemacs ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: ;;; @ 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 default-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))) (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. It converts line-break code from CRLF to LF. [emu-nemacs.el]" (save-restriction (narrow-to-region (point) (point)) (let ((return (as-binary-input-file (insert-file-contents filename visit)))) (while (search-forward "\r\n" nil t) (replace-match "\n")) (goto-char (point-min)) ;; Returns list absolute file name and length of data inserted. (list (car return) (- (point-max) (point-min)))))) (defalias 'insert-file-contents-as-raw-text-CRLF 'insert-file-contents-as-raw-text) (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)))) (defun find-file-noselect-as-binary (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but don't code conversion. \[emu-nemacs.el]" (as-binary-input-file (find-file-noselect filename nowarn))) (defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but it does not code conversion except for line-break code. [emu-nemacs.el]" (let ((buf (get-file-buffer filename)) cur) (if buf (prog1 buf (or nowarn (verify-visited-file-modtime buf) (cond ((not (file-exists-p filename)) (error "File %s no longer exists!" filename)) ((yes-or-no-p (if (buffer-modified-p buf) "File has changed since last visited or saved. Flush your changes? " "File has changed since last visited or saved. Read from disk? ")) (setq cur (current-buffer)) (set-buffer buf) (revert-buffer t t) (save-excursion (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n"))) (set-buffer-modified-p nil) (set-buffer cur))))) (save-excursion (prog1 (set-buffer (find-file-noselect-as-binary filename nowarn rawfile)) (while (search-forward "\r\n" nil t) (replace-match "\n")) (goto-char (point-min)) (set-buffer-modified-p nil)))))) (defalias 'find-file-noselect-as-raw-text-CRLF 'find-file-noselect-as-raw-text) (defun open-network-stream-as-binary (name buffer host service) "Like `open-network-stream', q.v., but don't code conversion. \[emu-nemacs.el]" (let ((process (open-network-stream name buffer host service))) (set-process-kanji-code process 0) process)) (defun save-buffer-as-binary (&optional args) "Like `save-buffer', q.v., but don't encode. [emu-nemacs.el]" (as-binary-output-file (save-buffer args))) (defun save-buffer-as-raw-text-CRLF (&optional args) "Like `save-buffer', q.v., but save as network representation. \[emu-nemacs.el]" (if (buffer-modified-p) (save-restriction (widen) (let ((the-buf (current-buffer)) (filename (buffer-file-name))) (if filename (prog1 (with-temp-buffer (insert-buffer the-buf) (goto-char (point-min)) (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) (replace-match "\\1\r\n")) (setq buffer-file-name filename) (save-buffer-as-binary args)) (set-buffer-modified-p nil) (clear-visited-file-modtime))))))) ;;; @ with code-conversion ;;; (defun insert-file-contents-as-coding-system (coding-system filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will be applied to `kanji-fileio-code'. [emu-nemacs.el]" (let ((kanji-fileio-code coding-system) kanji-expected-code) (insert-file-contents filename visit))) (defun write-region-as-coding-system (coding-system start end filename &optional append visit lockname) "Like `write-region', q.v., but CODING-SYSTEM the first arg will be applied to `kanji-fileio-code'. [emu-nemacs.el]" (let ((kanji-fileio-code coding-system) jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end filename append visit))) (defun find-file-noselect-as-coding-system (coding-system filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will be applied to `kanji-fileio-code'. [emu-nemacs.el]" (let ((default-kanji-fileio-code coding-system) kanji-fileio-code kanji-expected-code) (find-file-noselect filename nowarn))) (defun save-buffer-as-coding-system (coding-system &optional args) "Like `save-buffer', q.v., but CODING-SYSTEM the first arg will be applied to `kanji-fileio-code'. [emu-nemacs.el]" (let ((kanji-fileio-code coding-system)) (save-buffer args))) ;;; @ end ;;; (require 'product) (product-provide (provide 'pces-nemacs) (require 'apel-ver)) ;;; pces-nemacs.el ends here apel-5bc1050/pces-om.el000066400000000000000000000265431174656234300146660ustar00rootroot00000000000000;;; pces-om.el --- pces implementation for Mule 1.* and Mule 2.* ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Katsumi Yamaoka ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) ;;; @ version specific features ;;; (cond ((= emacs-major-version 19) (define-ccl-program poem-ccl-decode-raw-text '(1 ((r2 = 0) (read r0) (loop (if (r0 == ?\x0d) ((r2 = 1) (read-if (r1 == ?\x0a) ((r0 = ?\x0a) (r2 = 0) (write-read-repeat r0)) ((write r0) (r0 = (r1 + 0)) (repeat)))) ((r2 = 0) (write-read-repeat r0))))) ;; This EOF BLOCK won't work out in practice. So the last datum ;; might be lost if it's value is ?\x0d. (if r2 (write r0)) ) "Convert line-break code from CRLF to LF.") (define-ccl-program poem-ccl-encode-raw-text '(1 ((read r0) (loop (write-read-repeat r0)))) "Pass through without any conversions.") (define-ccl-program poem-ccl-encode-raw-text-CRLF '(2 ((loop (read-if (r0 == ?\x0a) (write "\x0d\x0a") (write r0)) (repeat)))) "Convert line-break code from LF to CRLF.") (make-coding-system 'raw-text 4 ?= "No conversion" nil (cons poem-ccl-decode-raw-text poem-ccl-encode-raw-text)) (make-coding-system 'raw-text-dos 4 ?= "No conversion" nil (cons poem-ccl-decode-raw-text poem-ccl-encode-raw-text-CRLF)) ) (t (defun poem-decode-raw-text (from to) (save-restriction (narrow-to-region from to) (goto-char (point-min)) (while (re-search-forward "\r$" nil t) (replace-match "") ))) (defun poem-encode-raw-text-CRLF (from to) (save-restriction (narrow-to-region from to) (goto-char (point-min)) (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) (replace-match "\\1\r\n") ))) (make-coding-system 'raw-text nil ?= "No conversion") (put 'raw-text 'post-read-conversion 'poem-decode-raw-text) (make-coding-system 'raw-text-dos nil ?= "No conversion") (put 'raw-text-dos 'post-read-conversion 'poem-decode-raw-text) (put 'raw-text-dos 'pre-write-conversion 'poem-encode-raw-text-CRLF) )) ;;; @ coding system ;;; (defun-maybe find-coding-system (obj) "Return OBJ if it is a coding-system." (if (coding-system-p obj) obj)) (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) ;;; @ with code-conversion ;;; (cond ((and (>= emacs-major-version 19) (>= emacs-minor-version 23)) ;; Mule 2.0 or later. (defun insert-file-contents-as-coding-system (coding-system filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will be applied to `file-coding-system-for-read'." (let ((file-coding-system-for-read coding-system)) (insert-file-contents filename visit beg end replace)))) (t ;; Mule 1.1 or earlier. (defun insert-file-contents-as-coding-system (coding-system filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but CODING-SYSTEM the first arg will be applied to `file-coding-system-for-read'." (let ((file-coding-system-for-read coding-system)) (insert-file-contents filename visit))))) (cond ((and (>= emacs-major-version 19) (>= emacs-minor-version 29)) ;; for MULE 2.3 based on Emacs 19.34. (defun write-region-as-coding-system (coding-system start end filename &optional append visit lockname) "Like `write-region', q.v., but CODING-SYSTEM the first arg will be applied to `file-coding-system'." (let ((file-coding-system coding-system) jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end filename append visit lockname))) (defun find-file-noselect-as-coding-system (coding-system filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will be applied to `file-coding-system-for-read'." (let ((file-coding-system-for-read coding-system)) (find-file-noselect filename nowarn rawfile))) ) (t ;; for MULE 2.3 based on Emacs 19.28 or MULE 1.*. (defun write-region-as-coding-system (coding-system start end filename &optional append visit lockname) "Like `write-region', q.v., but CODING-SYSTEM the first arg will be applied to `file-coding-system'." (let ((file-coding-system coding-system) jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end filename append visit))) (defun find-file-noselect-as-coding-system (coding-system filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but CODING-SYSTEM the first arg will be applied to `file-coding-system-for-read'." (let ((file-coding-system-for-read coding-system)) (find-file-noselect filename nowarn))) )) (defun save-buffer-as-coding-system (coding-system &optional args) "Like `save-buffer', q.v., but CODING-SYSTEM the first arg will be applied to `coding-system-for-write'." (let ((file-coding-system coding-system)) (save-buffer args))) ;;; @ without code-conversion ;;; (make-coding-system 'binary nil ?= "No 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) (cond ((and (>= emacs-major-version 19) (>= emacs-minor-version 23)) ;; Mule 2.0 or later. (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)))) (t ;; Mule 1.1 or earlier. (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))))) (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." ;; Returns list absolute file name and length of data inserted. (insert-file-contents-as-coding-system 'raw-text filename visit beg end replace)) (defalias 'insert-file-contents-as-raw-text-CRLF 'insert-file-contents-as-raw-text) (defun write-region-as-binary (start end filename &optional append visit lockname) "Like `write-region', q.v., but don't code conversion." (write-region-as-coding-system 'binary 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." (write-region-as-coding-system 'raw-text-dos start end filename append visit lockname)) (defun find-file-noselect-as-binary (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but don't code and format conversion." (find-file-noselect-as-coding-system 'binary filename nowarn rawfile)) (defun find-file-noselect-as-raw-text (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but it does not code and format conversion except for line-break code." (find-file-noselect-as-coding-system 'raw-text filename nowarn rawfile)) (defalias 'find-file-noselect-as-raw-text-CRLF 'find-file-noselect-as-raw-text) (defun save-buffer-as-binary (&optional args) "Like `save-buffer', q.v., but don't encode." (let ((file-coding-system 'binary)) (save-buffer args))) (defun save-buffer-as-raw-text-CRLF (&optional args) "Like `save-buffer', q.v., but save as network representation." (let ((file-coding-system 'raw-text-dos)) (save-buffer args))) (defun open-network-stream-as-binary (name buffer host service) "Like `open-network-stream', q.v., but don't code conversion." (let ((process (open-network-stream name buffer host service))) (set-process-coding-system process *noconv* *noconv*) process)) ;;; @ end ;;; (require 'product) (product-provide (provide 'pces-om) (require 'apel-ver)) ;;; pces-om.el ends here apel-5bc1050/pces-raw.el000066400000000000000000000136611174656234300150410ustar00rootroot00000000000000;;; pces-raw.el --- pces submodule for emacsen without coding-system features ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: ;;; @ coding-system ;;; (defun decode-coding-string (string coding-system) "Decode the STRING which is encoded in CODING-SYSTEM." (copy-sequence string)) (defun encode-coding-string (string coding-system) "Encode the STRING as CODING-SYSTEM." (copy-sequence 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) (defalias 'insert-file-contents-as-raw-text-CRLF 'insert-file-contents) (defun find-file-noselect-as-binary (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but don't code and format conversion." (let ((emx-binary-mode t)) (find-file-noselect filename nowarn rawfile))) (defalias 'find-file-noselect-as-raw-text 'find-file-noselect) (defalias 'find-file-noselect-as-raw-text-CRLF 'find-file-noselect) (defun save-buffer-as-binary (&optional args) "Like `save-buffer', q.v., but don't encode." (let ((emx-binary-mode t)) (save-buffer args))) (defun save-buffer-as-raw-text-CRLF (&optional args) "Like `save-buffer', q.v., but save as network representation." (if (buffer-modified-p) (save-restriction (widen) (let ((the-buf (current-buffer)) (filename (buffer-file-name))) (if filename (prog1 (with-temp-buffer (insert-buffer the-buf) (goto-char (point-min)) (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) (replace-match "\\1\r\n")) (setq buffer-file-name filename) (save-buffer args)) (set-buffer-modified-p nil) (clear-visited-file-modtime))))))) (defun open-network-stream-as-binary (name buffer host service) "Like `open-network-stream', q.v., but don't code conversion." (let ((emx-binary-mode t)) (open-network-stream name buffer host service))) ;;; @ with code-conversion (but actually it might be not done) ;;; (defun insert-file-contents-as-coding-system (coding-system filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but CODING-SYSTEM is used to decode." (insert-file-contents filename visit beg end replace)) (defun write-region-as-coding-system (coding-system start end filename &optional append visit lockname) "Like `write-region', q.v., but CODING-SYSTEM is used to encode." (let (jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end filename append visit lockname))) (defun find-file-noselect-as-coding-system (coding-system filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., CODING-SYSTEM is used to decode." (find-file-noselect filename nowarn rawfile)) (defun save-buffer-as-coding-system (coding-system &optional args) "Like `save-buffer', q.v., CODING-SYSTEM is used to encode." (save-buffer args)) ;;; @ end ;;; (require 'product) (product-provide (provide 'pces-raw) (require 'apel-ver)) ;;; pces-raw.el ends here apel-5bc1050/pces-xfc.el000066400000000000000000000027751174656234300150340ustar00rootroot00000000000000;;; pces-xfc.el --- pces module for XEmacs with file coding ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: ;; 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)) (if (featurep 'mule) (require 'pces-xm) ) (require 'pces-20) ;;; @ end ;;; (require 'product) (product-provide (provide 'pces-xfc) (require 'apel-ver)) ;;; pces-xfc.el ends here apel-5bc1050/pces-xm.el000066400000000000000000000047401174656234300146720ustar00rootroot00000000000000;;; pces-xm.el --- pces module for XEmacs-mule ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: ;;; @ 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)) (and (coding-system-property 'iso-2022-jp-dos 'input-charset-conversion) (copy-coding-system 'iso-2022-7bit-dos 'iso-2022-jp-dos)) (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 'gb2312-dos) (copy-coding-system 'cn-gb-2312-dos 'gb2312-dos)) (or (find-coding-system 'gb2312-mac) (copy-coding-system 'cn-gb-2312-mac 'gb2312-mac)) (or (find-coding-system 'gb2312-unix) (copy-coding-system 'cn-gb-2312-unix 'gb2312-unix)) (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))) ;;; @ end ;;; (require 'product) (product-provide (provide 'pces-xm) (require 'apel-ver)) ;;; pces-xm.el ends here apel-5bc1050/pces.el000066400000000000000000000031441174656234300142450ustar00rootroot00000000000000;;; pces.el --- Portable Character Encoding Scheme (coding-system) features ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: coding-system, 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) (eval-and-compile (unless (fboundp 'open-network-stream) (require 'tcp))) (cond ((featurep 'xemacs) (if (featurep 'file-coding) (require 'pces-xfc) (require 'pces-raw) )) ((featurep 'mule) (if (>= emacs-major-version 20) (require 'pces-e20) ;; for MULE 1.* and 2.* (require 'pces-om) )) ((boundp 'NEMACS) ;; for Nemacs and Nepoch (require 'pces-nemacs) ) (t (require 'pces-raw) )) ;;; @ end ;;; (require 'product) (product-provide (provide 'pces) (require 'apel-ver)) ;;; pces.el ends here apel-5bc1050/pcustom.el000066400000000000000000000041231174656234300150030ustar00rootroot00000000000000;;; pcustom.el -- a portable custom.el. ;; Copyright (C) 1999 Free Software Foundation, Inc. ;; Copyright (C) 1999 Mikio Nakajima ;; Author: Mikio Nakajima ;; Shuhei KOBAYASHI ;; Keywords: emulating, custom ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: (require 'poe) (eval-when-compile (require 'static)) (static-if (condition-case nil ;; compile-time check. (if (and (require 'custom) (fboundp 'custom-declare-variable)) ;; you have "new custom". t ;; you have custom, but it is "old". (message "\ ** \"old custom\" is loaded. See README if you want to use \"new custom\".") (sleep-for 1) nil) ;; you don't have custom. (error nil)) ;; you have "new custom". no load-time check. (require 'custom) ;; your custom is "old custom", ;; or you don't have custom library at compile-time. (or (condition-case nil ;; load-time check. ;; load "custom" if exists. (and (require 'custom) (fboundp 'custom-declare-variable)) (error nil)) ;; your custom is "old custom", ;; or you don't have custom library. ;; load emulation version of "new custom". (require 'tinycustom))) (require 'product) (product-provide (provide 'pcustom) (require 'apel-ver)) ;;; pcustom.el ends here apel-5bc1050/poe-18.el000066400000000000000000000752461174656234300143400ustar00rootroot00000000000000;;; poe-18.el --- poe API implementation for Emacs 18.* ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Copyright (C) 1999 Yuuichi Teranishi ;; Author: MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Yuuichi Teranishi ;; 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Note to APEL developers and APEL programmers: ;; ;; If old (v18) compiler is used, top-level macros are expanded at ;; *load-time*, not compile-time. Therefore, ;; ;; (1) Definitions with `*-maybe' won't be compiled. ;; ;; (2) you cannot use macros defined with `defmacro-maybe' within function ;; definitions in the same file. ;; (`defmacro-maybe' is evaluated at load-time, therefore byte-compiler ;; treats such use of macros as (unknown) functions and compiles them ;; into function calls, which will cause errors at run-time.) ;; ;; (3) `eval-when-compile' and `eval-and-compile' are evaluated at ;; load-time if used at top-level. ;;; Code: (require 'pym) ;;; @ Compilation. ;;; (defun defalias (sym newdef) "Set SYMBOL's function definition to NEWVAL, and return NEWVAL." (fset sym newdef)) (defun byte-code-function-p (object) "Return t if OBJECT is a byte-compiled function object." (and (consp object) (consp (cdr object)) (let ((rest (cdr (cdr object))) 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))))))) ;; (symbol-plist 'cyclic-function-indirection) (put 'cyclic-function-indirection 'error-conditions '(cyclic-function-indirection error)) (put 'cyclic-function-indirection 'error-message "Symbol's chain of function indirections contains a loop") ;; The following function definition is a direct translation of its ;; C definition in emacs-20.4/src/data.c. (defun indirect-function (object) "Return the function at the end of OBJECT's function chain. If OBJECT is a symbol, follow all function indirections and return the final function binding. If OBJECT is not a symbol, just return it. Signal a void-function error if the final symbol is unbound. Signal a cyclic-function-indirection error if there is a loop in the function chain of symbols." (let* ((hare object) (tortoise hare)) (catch 'found (while t (or (symbolp hare) (throw 'found hare)) (or (fboundp hare) (signal 'void-function (cons object nil))) (setq hare (symbol-function hare)) (or (symbolp hare) (throw 'found hare)) (or (fboundp hare) (signal 'void-function (cons object nil))) (setq hare (symbol-function hare)) (setq tortoise (symbol-function tortoise)) (if (eq hare tortoise) (signal 'cyclic-function-indirection (cons object nil))))) hare)) ;;; Emulate all functions and macros of emacs-20.3/lisp/byte-run.el. ;;; (note: jwz's original compiler and XEmacs compiler have some more ;;; macros; they are "nuked" by rms in FSF version.) ;; Use `*-maybe' here because new byte-compiler may be installed. (put 'inline 'lisp-indent-hook 0) (defmacro-maybe inline (&rest body) "Eval BODY forms sequentially and return value of last one. This emulating macro does not support function inlining because old \(v18\) compiler does not support inlining feature." (cons 'progn body)) (put 'defsubst 'lisp-indent-hook 'defun) (put 'defsubst 'edebug-form-spec 'defun) (defmacro-maybe defsubst (name arglist &rest body) "Define an inline function. The syntax is just like that of `defun'. This emulating macro does not support function inlining because old \(v18\) compiler does not support inlining feature." (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. This emulating function does nothing because old \(v18\) compiler does not support this feature." (interactive "aMake function obsolete: \nxObsoletion replacement: ") fn) (defun-maybe make-obsolete-variable (var new) "Make the byte-compiler warn that VARIABLE is obsolete, and NEW should be used instead. If NEW is a string, then that is the `use instead' message. This emulating function does nothing because old \(v18\) compiler does not support this feature." (interactive "vMake variable obsolete: \nxObsoletion replacement: ") var) (put 'dont-compile 'lisp-indent-hook 0) (defmacro-maybe dont-compile (&rest body) "Like `progn', but the body always runs interpreted \(not compiled\). If you think you need this, you're probably making a mistake somewhere." (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body))))) (put 'eval-when-compile 'lisp-indent-hook 0) (defmacro-maybe eval-when-compile (&rest body) "Like progn, but evaluates the body at compile-time. This emulating macro does not do compile-time evaluation at all because of the limitation of old \(v18\) compiler." (cons 'progn body)) (put 'eval-and-compile 'lisp-indent-hook 0) (defmacro-maybe eval-and-compile (&rest body) "Like progn, but evaluates the body at compile-time as well as at load-time. This emulating macro does not do compile-time evaluation at all because of the limitation of old \(v18\) compiler." (cons 'progn body)) ;;; @ C primitives emulation. ;;; (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." (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'." (if list (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))) (setcdr rest (cdr rrest)) list)))) (defun default-boundp (symbol) "Return t if SYMBOL has a non-void default value. This is the value that is seen in buffers that do not have their own values for this variable." (condition-case error (progn (default-value symbol) t) (void-variable nil))) ;;; @@ current-time. ;;; (defvar current-time-world-timezones '(("PST" . -800)("PDT" . -700)("MST" . -700) ("MDT" . -600)("CST" . -600)("CDT" . -500) ("EST" . -500)("EDT" . -400)("AST" . -400) ("NST" . -330)("UT" . +000)("GMT" . +000) ("BST" . +100)("MET" . +100)("EET" . +200) ("JST" . +900)("GMT+1" . +100)("GMT+2" . +200) ("GMT+3" . +300)("GMT+4" . +400)("GMT+5" . +500) ("GMT+6" . +600)("GMT+7" . +700)("GMT+8" . +800) ("GMT+9" . +900)("GMT+10" . +1000)("GMT+11" . +1100) ("GMT+12" . +1200)("GMT+13" . +1300)("GMT-1" . -100) ("GMT-2" . -200)("GMT-3" . -300)("GMT-4" . -400) ("GMT-5" . -500)("GMT-6" . -600)("GMT-7" . -700) ("GMT-8" . -800)("GMT-9" . -900)("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200)) "Time differentials of timezone from GMT in +-HHMM form. Used in `current-time-zone' (Emacs 19 emulating function by APEL).") (defvar current-time-local-timezone nil "*Local timezone name. Used in `current-time-zone' (Emacs 19 emulating function by APEL).") (defun set-time-zone-rule (tz) "Set the local time zone using TZ, a string specifying a time zone rule. If TZ is nil, use implementation-defined default time zone information. If TZ is t, use Universal Time." (cond ((stringp tz) (setq current-time-local-timezone tz)) (tz (setq current-time-local-timezone "GMT")) (t (setq current-time-local-timezone (with-temp-buffer ;; We use `date' command to get timezone information. (call-process "date" nil (current-buffer) t) (goto-char (point-min)) (if (looking-at "^.*\\([A-Z][A-Z][A-Z]\\([^ \n\t]*\\)\\).*$") (buffer-substring (match-beginning 1) (match-end 1)))))))) (defun current-time-zone (&optional specified-time) "Return the offset and name for the local time zone. This returns a list of the form (OFFSET NAME). OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). A negative value means west of Greenwich. NAME is a string giving the name of the time zone. Optional argument SPECIFIED-TIME is ignored in this implementation. Some operating systems cannot provide all this information to Emacs; in this case, `current-time-zone' returns a list containing nil for the data it can't find." (let ((local-timezone (or current-time-local-timezone (progn (set-time-zone-rule nil) current-time-local-timezone))) timezone abszone seconds) (setq timezone (or (cdr (assoc (upcase local-timezone) current-time-world-timezones)) ;; "+900" style or nil. local-timezone)) (when timezone (if (stringp timezone) (setq timezone (string-to-int timezone))) ;; Taking account of minute in timezone. ;; HHMM -> MM (setq abszone (abs timezone)) (setq seconds (* 60 (+ (* 60 (/ abszone 100)) (% abszone 100)))) (list (if (< timezone 0) (- seconds) seconds) local-timezone)))) (or (fboundp 'si:current-time-string) (fset 'si:current-time-string (symbol-function 'current-time-string))) (defun current-time-string (&optional specified-time) "Return the current time, as a human-readable string. Programs can use this function to decode a time, since the number of columns in each field is fixed. The format is `Sun Sep 16 01:03:52 1973'. If an argument SPECIFIED-TIME is given, it specifies a time to format instead of the current time. The argument should have the form: (HIGH . LOW) or the form: (HIGH LOW . IGNORED). Thus, you can use times obtained from `current-time' and from `file-attributes'." (if (null specified-time) (si:current-time-string) (or (consp specified-time) (error "Wrong type argument %s" specified-time)) (let ((high (car specified-time)) (low (cdr specified-time)) (offset (or (car (current-time-zone)) 0)) (mdays '(31 28 31 30 31 30 31 31 30 31 30 31)) (mnames '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) (wnames '("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat")) days dd yyyy lyear mm HH MM SS) (if (consp low) (setq low (car low))) (or (integerp high) (error "Wrong type argument %s" high)) (or (integerp low) (error "Wrong type argument %s" low)) (setq low (+ low offset)) (while (> low 65535) (setq high (1+ high) low (- low 65536))) (setq yyyy 1970) (while (or (> high 481) (and (= high 481) (>= low 13184))) (if (and (> high 0) (< low 13184)) (setq high (1- high) low (+ 65536 low))) (setq high (- high 481) low (- low 13184)) (if (and (zerop (% yyyy 4)) (or (not (zerop (% yyyy 100))) (zerop (% yyyy 400)))) (progn (if (and (> high 0) (< low 20864)) (setq high (1- high) low (+ 65536 low))) (setq high (- high 1) low (- low 20864)))) (setq yyyy (1+ yyyy))) (setq dd 1) (while (or (> high 1) (and (= high 1) (>= low 20864))) (if (and (> high 0) (< low 20864)) (setq high (1- high) low (+ 65536 low))) (setq high (- high 1) low (- low 20864) dd (1+ dd))) (setq days dd) (if (= high 1) (setq low (+ 65536 low))) (setq mm 0) (setq lyear (and (zerop (% yyyy 4)) (or (not (zerop (% yyyy 100))) (zerop (% yyyy 400))))) (while (> (- dd (if (and lyear (= mm 1)) 29 (nth mm mdays))) 0) (setq dd (- dd (if (and lyear (= mm 1)) 29 (nth mm mdays)))) (setq mm (1+ mm))) (setq HH (/ low 3600) low (% low 3600) MM (/ low 60) SS (% low 60)) (format "%s %s %2d %02d:%02d:%02d %4d" (nth (% (+ days (- (+ (* (1- yyyy) 365) (/ (1- yyyy) 400) (/ (1- yyyy) 4)) (/ (1- yyyy) 100))) 7) wnames) (nth mm mnames) dd HH MM SS yyyy)))) (defun current-time () "Return the current time, as the number of seconds since 1970-01-01 00:00:00. The time is returned as a list of three integers. The first has the most significant 16 bits of the seconds, while the second has the least significant 16 bits. The third integer gives the microsecond count. The microsecond count is zero on systems that do not provide resolution finer than a second." (let* ((str (current-time-string)) (yyyy (string-to-int (substring str 20 24))) (mm (length (member (substring str 4 7) '("Dec" "Nov" "Oct" "Sep" "Aug" "Jul" "Jun" "May" "Apr" "Mar" "Feb" "Jan")))) (dd (string-to-int (substring str 8 10))) (HH (string-to-int (substring str 11 13))) (MM (string-to-int (substring str 14 16))) (SS (string-to-int (substring str 17 19))) (offset (or (car (current-time-zone)) 0)) dn ct1 ct2 i1 i2 year uru) (setq ct1 0 ct2 0 i1 0 i2 0) (setq year (- yyyy 1970)) (while (> year 0) (setq year (1- year) ct1 (+ ct1 481) ct2 (+ ct2 13184)) (while (> ct2 65535) (setq ct1 (1+ ct1) ct2 (- ct2 65536)))) (setq year (- yyyy 1)) (setq uru (- (+ (- (/ year 4) (/ year 100)) (/ year 400)) 477)) (while (> uru 0) (setq uru (1- uru) i1 (1+ i1) i2 (+ i2 20864)) (if (> i2 65535) (setq i1 (1+ i1) i2 (- i2 65536)))) (setq ct1 (+ ct1 i1) ct2 (+ ct2 i2)) (while (> ct2 65535) (setq ct1 (1+ ct1) ct2 (- ct2 65536))) (setq dn (+ dd (* 31 (1- mm)))) (if (> mm 2) (setq dn (+ (- dn (/ (+ 23 (* 4 mm)) 10)) (if (and (zerop (% yyyy 4)) (or (not (zerop (% yyyy 100))) (zerop (% yyyy 400)))) 1 0)))) (setq dn (1- dn) i1 0 i2 0) (while (> dn 0) (setq dn (1- dn) i1 (1+ i1) i2 (+ i2 20864)) (if (> i2 65535) (setq i1 (1+ i1) i2 (- i2 65536)))) (setq ct1 (+ (+ (+ ct1 i1) (/ ct2 65536)) (/ (+ (* HH 3600) (* MM 60) SS) 65536)) ct2 (+ (+ i2 (% ct2 65536)) (% (+ (* HH 3600) (* MM 60) SS) 65536))) (while (< (- ct2 offset) 0) (setq ct1 (1- ct1) ct2 (+ ct2 65536))) (setq ct2 (- ct2 offset)) (while (> ct2 65535) (setq ct1 (1+ ct1) ct2 (- ct2 65536))) (list ct1 ct2 0))) ;;; @@ Floating point numbers. ;;; (defun abs (arg) "Return the absolute value of ARG." (if (< arg 0) (- arg) arg)) ;;; @ Basic lisp subroutines. ;;; (defmacro lambda (&rest cdr) "Return a lambda expression. A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is self-quoting; the result of evaluating the lambda expression is the expression itself. The lambda expression may then be treated as a function, i.e., stored as the function value of a symbol, passed to funcall or mapcar, etc. ARGS should take the same form as an argument list for a `defun'. DOCSTRING is an optional documentation string. If present, it should describe how to call the function. But documentation strings are usually not useful in nameless functions. INTERACTIVE should be a call to the function `interactive', which see. It may also be omitted. BODY should be a list of lisp expressions." ;; Note that this definition should not use backquotes; subr.el should not ;; depend on backquote.el. (list 'function (cons 'lambda cdr))) (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." (if all (save-excursion (set-buffer (other-buffer)))) (set-buffer-modified-p (buffer-modified-p))) (defalias 'set-match-data 'store-match-data) (defvar save-match-data-internal) ;; We use save-match-data-internal as the local variable because ;; that works ok in practice (people should not use that variable elsewhere). (defmacro save-match-data (&rest body) "Execute the BODY forms, restoring the global value of the match data." (` (let ((save-match-data-internal (match-data))) (unwind-protect (progn (,@ body)) (set-match-data save-match-data-internal))))) ;;; @ Basic editing commands. ;;; ;; 18.55 does not have these variables. (defvar-maybe buffer-undo-list nil "List of undo entries in current buffer. APEL provides this as dummy for a compatibility.") (defvar-maybe auto-fill-function nil "Function called (if non-nil) to perform auto-fill. APEL provides this as dummy for a compatibility.") (defvar-maybe unread-command-event nil "APEL provides this as dummy for a compatibility.") (defvar-maybe unread-command-events nil "List of events to be read as the command input. APEL provides this as dummy for a compatibility.") ;; (defvar-maybe minibuffer-setup-hook nil ;; "Normal hook run just after entry to minibuffer.") ;; (defvar-maybe minibuffer-exit-hook nil ;; "Normal hook run just after exit from minibuffer.") (defvar-maybe minor-mode-map-alist nil "Alist of keymaps to use for minor modes. APEL provides this as dummy for a compatibility.") (defalias 'insert-and-inherit 'insert) (defalias 'insert-before-markers-and-inherit 'insert-before-markers) (defalias 'number-to-string 'int-to-string) (defun 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 `', 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)) (or (fboundp 'si:mark) (fset 'si:mark (symbol-function 'mark))) (defun mark (&optional force) (si:mark)) (defun-maybe window-minibuffer-p (&optional window) "Return non-nil if WINDOW is a minibuffer window." (eq (or window (selected-window)) (minibuffer-window))) (defun-maybe window-live-p (obj) "Returns t if OBJECT is a window which is currently visible." (and (windowp obj) (or (eq obj (minibuffer-window)) (eq obj (get-buffer-window (window-buffer obj)))))) ;; Add optinal argument `hist' (or (fboundp 'si:read-from-minibuffer) (progn (fset 'si:read-from-minibuffer (symbol-function 'read-from-minibuffer)) (defun read-from-minibuffer (prompt &optional initial-contents keymap read hist) "Read a string from the minibuffer, prompting with string PROMPT. If optional second arg INITIAL-CONTENTS is non-nil, it is a string to be inserted into the minibuffer before reading input. If INITIAL-CONTENTS is (STRING . POSITION), the initial input is STRING, but point is placed at position POSITION in the minibuffer. Third arg KEYMAP is a keymap to use whilst reading; if omitted or nil, the default is `minibuffer-local-map'. If fourth arg READ is non-nil, then interpret the result as a lisp object and return that object: in other words, do `(car (read-from-string INPUT-STRING))' Fifth arg HIST is ignored in this implementation." (si:read-from-minibuffer prompt initial-contents keymap read)))) ;; Add optional argument `frame'. (or (fboundp 'si:get-buffer-window) (progn (fset 'si:get-buffer-window (symbol-function 'get-buffer-window)) (defun get-buffer-window (buffer &optional frame) "Return a window currently displaying BUFFER, or nil if none. Optional argument FRAME is ignored in this implementation." (si:get-buffer-window buffer)))) (defun-maybe walk-windows (proc &optional minibuf all-frames) "Cycle through all visible windows, calling PROC for each one. PROC is called with a window as argument. Optional second arg MINIBUF t means count the minibuffer window even if not active. MINIBUF nil or omitted means count the minibuffer iff it is active. MINIBUF neither t nor nil means not to count the minibuffer even if it is active. Optional third argument ALL-FRAMES is ignored in this implementation." (if (window-minibuffer-p (selected-window)) (setq minibuf t)) (let* ((walk-windows-start (selected-window)) (walk-windows-current walk-windows-start)) (unwind-protect (while (progn (setq walk-windows-current (next-window walk-windows-current minibuf)) (funcall proc walk-windows-current) (not (eq walk-windows-current walk-windows-start)))) (select-window walk-windows-start)))) (defun buffer-disable-undo (&optional buffer) "Make BUFFER stop keeping undo information. No argument or nil as argument means do this for the current buffer." (buffer-flush-undo (or buffer (current-buffer)))) ;;; @@ Frame (Emacs 18 cannot make frame) ;;; ;; The following four are frequently used for manipulating the current frame. ;; frame.el has `screen-width', `screen-height', `set-screen-width' and ;; `set-screen-height' for backward compatibility and declare them as obsolete. (defun frame-width (&optional frame) "Return number of columns available for display on FRAME. If FRAME is omitted, describe the currently selected frame." (screen-width)) (defun frame-height (&optional frame) "Return number of lines available for display on FRAME. If FRAME is omitted, describe the currently selected frame." (screen-height)) (defun set-frame-width (frame cols &optional pretend) "Specify that the frame FRAME has COLS columns. Optional third arg non-nil means that redisplay should use COLS columns but that the idea of the actual width of the frame should not be changed." (set-screen-width cols pretend)) (defun set-frame-height (frame lines &optional pretend) "Specify that the frame FRAME has LINES lines. Optional third arg non-nil means that redisplay should use LINES lines but that the idea of the actual height of the frame should not be changed." (set-screen-height lines pretend)) ;;; @@ Environment variables. ;;; (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) ;;; @ File input and output commands. ;;; (defvar data-directory exec-directory) ;; In 18.55, `call-process' does not return exit status. (defun file-executable-p (filename) "Return t if FILENAME can be executed by you. For a directory, this means you can access files in that directory." (if (file-exists-p filename) (let ((process (start-process "test" nil "test" "-x" filename))) (while (eq 'run (process-status process))) (zerop (process-exit-status process))))) (defun make-directory-internal (dirname) "Create a directory. One argument, a file name string." (let ((dir (expand-file-name dirname))) (if (file-exists-p dir) (signal 'file-already-exists (list "Creating directory: %s already exists" dir)) (let ((exit-status (call-process "mkdir" nil nil nil dir))) (if (or (and (numberp exit-status) (not (zerop exit-status))) (stringp exit-status)) (error "Create directory %s failed.") ;; `make-directory' of v19 and later returns nil for success. ))))) (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." (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))) (defun delete-directory (directory) "Delete the directory named DIRECTORY. Does not follow symlinks." (let ((exit-status (call-process "rmdir" nil nil nil directory))) (when (or (and (numberp exit-status) (not (zerop exit-status))) (stringp exit-status)) (error "Delete directory %s failed.")))) (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))) (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." (si:directory-files directory full match)) (or (fboundp 'si:write-region) (fset 'si:write-region (symbol-function 'write-region))) (defun write-region (start end filename &optional append visit) "Write current region into specified file. When called from a program, requires three arguments: START, END and FILENAME. START and END are normally buffer positions specifying the part of the buffer to write. If START is nil, that means to use the entire buffer contents. If START is a string, then output that string to the file instead of any buffer contents; END is ignored. Optional fourth argument APPEND if non-nil means append to existing file contents (if any). If it is an integer, seek to that offset in the file before writing. Optional fifth argument VISIT if t means set the last-save-file-modtime of buffer to this file's modtime and mark buffer not modified. If VISIT is a string, it is a second file name; the output goes to FILENAME, but the buffer is marked as visiting VISIT. VISIT is also the file name to lock and unlock for clash detection. If VISIT is neither t nor nil nor a string, that means do not display the \"Wrote file\" message." (cond ((null start) (si:write-region (point-min) (point-max) filename append visit)) ((stringp start) (with-temp-buffer (insert start) (si:write-region (point-min) (point-max) filename append visit))) (t (si:write-region start end filename append visit)))) ;;; @ Process. ;;; (or (fboundp 'si:accept-process-output) (progn (fset 'si:accept-process-output (symbol-function 'accept-process-output)) (defun accept-process-output (&optional process timeout timeout-msecs) "Allow any pending output from subprocesses to be read by Emacs. It is read into the process' buffers or given to their filter functions. Non-nil arg PROCESS means do not return until some output has been received from PROCESS. Nil arg PROCESS means do not return until some output has been received from any process. TIMEOUT and TIMEOUT-MSECS are ignored in this implementation." (si:accept-process-output process)))) ;;; @ Text property. ;;; ;; In Emacs 20.4, these functions are defined in src/textprop.c. (defun text-properties-at (position &optional object)) (defun get-text-property (position prop &optional object)) (defun get-char-property (position prop &optional object)) (defun next-property-change (position &optional object limit)) (defun next-single-property-change (position prop &optional object limit)) (defun previous-property-change (position &optional object limit)) (defun previous-single-property-change (position prop &optional object limit)) (defun add-text-properties (start end properties &optional object)) (defun put-text-property (start end property value &optional object)) (defun set-text-properties (start end properties &optional object)) (defun remove-text-properties (start end properties &optional object)) (defun text-property-any (start end property value &optional object)) (defun text-property-not-all (start end property value &optional object)) ;; the following two functions are new in v20. (defun next-char-property-change (position &optional object)) (defun previous-char-property-change (position &optional object)) ;; the following two functions are obsolete. ;; (defun erase-text-properties (start end &optional object) ;; (defun copy-text-properties (start end src pos dest &optional prop) ;;; @ Overlay. ;;; (defun overlayp (object)) (defun make-overlay (beg end &optional buffer front-advance rear-advance)) (defun move-overlay (overlay beg end &optional buffer)) (defun delete-overlay (overlay)) (defun overlay-start (overlay)) (defun overlay-end (overlay)) (defun overlay-buffer (overlay)) (defun overlay-properties (overlay)) (defun overlays-at (pos)) (defun overlays-in (beg end)) (defun next-overlay-change (pos)) (defun previous-overlay-change (pos)) (defun overlay-lists ()) (defun overlay-recenter (pos)) (defun overlay-get (overlay prop)) (defun overlay-put (overlay prop value)) ;;; @ End. ;;; (require 'product) (product-provide (provide 'poe-18) (require 'apel-ver)) ;;; poe-18.el ends here apel-5bc1050/poe-xemacs.el000066400000000000000000000165761174656234300153710ustar00rootroot00000000000000;;; poe-xemacs.el --- poe submodule for XEmacs ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, Boston, ;; MA 02110-1301, USA. ;;; Code: (require 'pym) ;;; @ color ;;; (defun-maybe set-cursor-color (color-name) "Set the text cursor color of the selected frame to COLOR. When called interactively, prompt for the name of the color to use." (interactive "sColor: ") (set-frame-property (selected-frame) 'cursor-color (if (color-instance-p color-name) color-name (make-color-instance color-name)))) ;;; @ face ;;; (defalias-maybe '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 'overlayp 'extentp) (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)) (defalias 'delete-overlay 'detach-extent))) ;;; @ dired ;;; (defun-maybe 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))) ;;; @ timer ;;; (condition-case nil (require 'timer-funcs) (error nil)) (condition-case nil (require 'timer) (error nil)) (or (or (featurep 'timer-funcs) (featurep 'timer)) (progn (require 'itimer) (if (and (= emacs-major-version 19) (<= emacs-minor-version 14)) (defun-maybe run-at-time (time repeat function &rest args) (start-itimer (make-temp-name "rat") `(lambda () (,function ,@args)) time repeat)) (defun-maybe run-at-time (time repeat function &rest args) "Function emulating the function of the same name of Emacs. TIME should be nil meaning now, or a number of seconds from now. Return an itimer object which can be used in either `delete-itimer' or `cancel-timer'." (apply #'start-itimer "run-at-time" function (if time (max time 1e-9) 1e-9) repeat nil t args))) (defalias 'cancel-timer 'delete-itimer) (defun with-timeout-handler (tag) (throw tag 'timeout)) (defmacro-maybe with-timeout (list &rest body) (let ((seconds (car list)) (timeout-forms (cdr list))) `(let ((with-timeout-tag (cons nil nil)) with-timeout-value with-timeout-timer) (if (catch with-timeout-tag (progn (setq with-timeout-timer (run-at-time ,seconds nil 'with-timeout-handler with-timeout-tag)) (setq with-timeout-value (progn . ,body)) nil)) (progn . ,timeout-forms) (cancel-timer with-timeout-timer) with-timeout-value)))))) (require 'broken) (broken-facility run-at-time-tick-tock "`run-at-time' is not punctual." ;; Note that it doesn't support XEmacsen prior to the version 19.15 ;; since `start-itimer' doesn't pass arguments to a timer function. (or (and (= emacs-major-version 19) (<= emacs-minor-version 14)) (condition-case nil (progn (unless (or itimer-process itimer-timer) (itimer-driver-start)) ;; Check whether there is a bug to which the difference of ;; the present time and the time when the itimer driver was ;; woken up is subtracted from the initial itimer value. (let* ((inhibit-quit t) (ctime (current-time)) (itimer-timer-last-wakeup (prog1 ctime (setcar ctime (1- (car ctime))))) (itimer-list nil) (itimer (start-itimer "run-at-time" 'ignore 5))) (sleep-for 0.1) ;; Accept the timeout interrupt. (prog1 (> (itimer-value itimer) 0) (delete-itimer itimer)))) (error nil)))) (when-broken run-at-time-tick-tock (defalias 'run-at-time (lambda (time repeat function &rest args) "Function emulating the function of the same name of Emacs. It works correctly for TIME even if there is a bug in the XEmacs core. TIME should be nil meaning now, or a number of seconds from now. Return an itimer object which can be used in either `delete-itimer' or `cancel-timer'." (let ((itimers (list nil))) (setcar itimers (apply #'start-itimer "fixed-run-at-time" (lambda (itimers repeat function &rest args) (let ((itimer (car itimers))) (if repeat (progn (set-itimer-function itimer (lambda (itimer repeat function &rest args) (set-itimer-restart itimer repeat) (set-itimer-function itimer function) (set-itimer-function-arguments itimer args) (apply function args))) (set-itimer-function-arguments itimer (append (list itimer repeat function) args))) (set-itimer-function itimer (lambda (itimer function &rest args) (delete-itimer itimer) (apply function args))) (set-itimer-function-arguments itimer (append (list itimer function) args))))) 1e-9 (if time (max time 1e-9) 1e-9) nil t itimers repeat function args)))))) ;;; @ 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)." (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 ;;; (defalias-maybe 'line-beginning-position 'point-at-bol) (defalias-maybe 'line-end-position 'point-at-eol) ;;; @ XEmacs 21 emulation ;;; ;; XEmacs 20.5 and later: (set-extent-properties EXTENT PLIST) (defun-maybe set-extent-properties (extent plist) "Change some properties of EXTENT. PLIST is a property list. For a list of built-in properties, see `set-extent-property'." (while plist (set-extent-property extent (car plist) (cadr plist)) (setq plist (cddr plist)))) ;;; @ end ;;; (require 'product) (product-provide (provide 'poe-xemacs) (require 'apel-ver)) ;;; poe-xemacs.el ends here apel-5bc1050/poe.el000066400000000000000000002273021174656234300141020ustar00rootroot00000000000000;;; poe.el --- Portable Outfit for Emacsen ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2005, ;; 2008 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: (require 'product) (product-provide (provide 'poe) (require 'apel-ver)) (require 'pym) ;;; @ Version information. ;;; (static-when (= emacs-major-version 18) (require 'poe-18)) ;; Some ancient version of XEmacs did not provide 'xemacs. (static-when (string-match "XEmacs" emacs-version) (provide 'xemacs)) ;; `file-coding' was appeared in the spring of 1998, just before XEmacs ;; 21.0. Therefore it is not provided in XEmacs with MULE versions 20.4 ;; or earlier. (static-when (featurep 'xemacs) ;; must be load-time check to share .elc between w/ MULE and w/o MULE. (when (featurep 'mule) (provide 'file-coding))) (static-when (featurep 'xemacs) (require 'poe-xemacs)) ;; must be load-time check to share .elc between different systems. (or (fboundp 'open-network-stream) (require 'tcp)) ;;; @ C primitives emulation. ;;; ;; Emacs 20.3 and earlier: (require FEATURE &optional FILENAME) ;; Emacs 20.4 and later: (require FEATURE &optional FILENAME NOERROR) (static-condition-case nil ;; compile-time check. (progn (require 'nofeature "nofile" 'noerror) (if (get 'require 'defun-maybe) (error "`require' is already redefined"))) (error ;; load-time check. (or (fboundp 'si:require) (progn (fset 'si:require (symbol-function 'require)) (defun require (feature &optional filename noerror) "\ If feature FEATURE is not loaded, load it from FILENAME. If FEATURE is not a member of the list `features', then the feature is not loaded; so load the file FILENAME. If FILENAME is omitted, the printname of FEATURE is used as the file name, but in this case `load' insists on adding the suffix `.el' or `.elc'. If the optional third argument NOERROR is non-nil, then return nil if the file is not found. Normally the return value is FEATURE." (if noerror (condition-case nil (si:require feature filename) (file-error)) (si:require feature filename))) ;; for `load-history'. (setq current-load-list (cons 'require current-load-list)) (put 'require 'defun-maybe t))))) ;; Emacs 19.29 and later: (plist-get PLIST PROP) ;; (defun-maybe plist-get (plist prop) ;; (while (and plist ;; (not (eq (car plist) prop))) ;; (setq plist (cdr (cdr plist)))) ;; (car (cdr plist))) (static-unless (and (fboundp 'plist-get) (not (get 'plist-get 'defun-maybe))) (or (fboundp 'plist-get) (progn (defvar plist-get-internal-symbol) (defun plist-get (plist prop) "\ Extract a value from a property list. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2...\). This function returns the value corresponding to the given PROP, or nil if PROP is not one of the properties on the list." (setplist 'plist-get-internal-symbol plist) (get 'plist-get-internal-symbol prop)) ;; for `load-history'. (setq current-load-list (cons 'plist-get current-load-list)) (put 'plist-get 'defun-maybe t)))) ;; Emacs 19.29 and later: (plist-put PLIST PROP VAL) ;; (defun-maybe plist-put (plist prop val) ;; (catch 'found ;; (let ((tail plist) ;; (prev nil)) ;; (while (and tail (cdr tail)) ;; (if (eq (car tail) prop) ;; (progn ;; (setcar (cdr tail) val) ;; (throw 'found plist)) ;; (setq prev tail ;; tail (cdr (cdr tail))))) ;; (if prev ;; (progn ;; (setcdr (cdr prev) (list prop val)) ;; plist) ;; (list prop val))))) (static-unless (and (fboundp 'plist-put) (not (get 'plist-put 'defun-maybe))) (or (fboundp 'plist-put) (progn (defvar plist-put-internal-symbol) (defun plist-put (plist prop val) "\ Change value in PLIST of PROP to VAL. PLIST is a property list, which is a list of the form \(PROP1 VALUE1 PROP2 VALUE2 ...\). PROP is a symbol and VAL is any object. If PROP is already a property on the list, its value is set to VAL, otherwise the new PROP VAL pair is added. The new plist is returned; use `\(setq x \(plist-put x prop val\)\)' to be sure to use the new value. The PLIST is modified by side effects." (setplist 'plist-put-internal-symbol plist) (put 'plist-put-internal-symbol prop val) (symbol-plist 'plist-put-internal-symbol)) ;; for `load-history'. (setq current-load-list (cons 'plist-put current-load-list)) (put 'plist-put 'defun-maybe t)))) ;; Emacs 19.23 and later: (minibuffer-prompt-width) (defun-maybe minibuffer-prompt-width () "Return the display width of the minibuffer prompt." (save-excursion (set-buffer (window-buffer (minibuffer-window))) (current-column))) ;; (read-string PROMPT &optional INITIAL-INPUT HISTORY) ;; Emacs 19.29/XEmacs 19.14(?) and later takes optional 3rd arg HISTORY. (static-unless (or (featurep 'xemacs) (>= emacs-major-version 20) (and (= emacs-major-version 19) (>= emacs-minor-version 29))) (or (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. See `read-from-minibuffer' for details of HISTORY argument." (si:read-string prompt initial-input))))) ;; (completing-read prompt table &optional ;; FSF Emacs ;; --19.7 : predicate require-match init ;; 19.7 --19.34 : predicate require-match init hist ;; 20.1 -- : predicate require-match init hist def inherit-input-method ;; XEmacs ;; --19.(?): predicate require-match init ;; --21.2 : predicate require-match init hist ;; 21.2 -- : predicate require-match init hist def ;; ) ;; We support following API. ;; (completing-read prompt table ;; &optional predicate require-match init hist def) (static-cond ;; add 'hist' and 'def' argument. ((< emacs-major-version 19) (or (fboundp 'si:completing-read) (progn (fset 'si:completing-read (symbol-function 'completing-read)) (defun completing-read (prompt table &optional predicate require-match init hist def) "Read a string in the minibuffer, with completion. PROMPT is a string to prompt with; normally it ends in a colon and a space. TABLE is an alist whose elements' cars are strings, or an obarray. PREDICATE limits completion to a subset of TABLE. See `try-completion' and `all-completions' for more details on completion, TABLE, and PREDICATE. If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless the input is (or completes to) an element of TABLE or is null. If it is also not t, Return does not exit if it does non-null completion. If the input is null, `completing-read' returns an empty string, regardless of the value of REQUIRE-MATCH. If INIT is non-nil, insert it in the minibuffer initially. If it is (STRING . POSITION), the initial input is STRING, but point is placed POSITION characters into the string. HIST is ignored in this implementation. DEF, if non-nil, is the default value. Completion ignores case if the ambient value of `completion-ignore-case' is non-nil." (let ((string (si:completing-read prompt table predicate require-match init))) (if (and (string= string "") def) def string)))))) ;; add 'def' argument. ((or (and (featurep 'xemacs) (or (and (eq emacs-major-version 21) (< emacs-minor-version 2)) (< emacs-major-version 21))) (< emacs-major-version 20)) (or (fboundp 'si:completing-read) (progn (fset 'si:completing-read (symbol-function 'completing-read)) (defun completing-read (prompt table &optional predicate require-match init hist def) "Read a string in the minibuffer, with completion. PROMPT is a string to prompt with; normally it ends in a colon and a space. TABLE is an alist whose elements' cars are strings, or an obarray. PREDICATE limits completion to a subset of TABLE. See `try-completion' and `all-completions' for more details on completion, TABLE, and PREDICATE. If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless the input is (or completes to) an element of TABLE or is null. If it is also not t, Return does not exit if it does non-null completion. If the input is null, `completing-read' returns an empty string, regardless of the value of REQUIRE-MATCH. If INIT is non-nil, insert it in the minibuffer initially. If it is (STRING . POSITION), the initial input is STRING, but point is placed POSITION characters into the string. HIST, if non-nil, specifies a history list and optionally the initial position in the list. It can be a symbol, which is the history list variable to use, or it can be a cons cell (HISTVAR . HISTPOS). In that case, HISTVAR is the history list variable to use, and HISTPOS is the initial position (the position in the list which INIT corresponds to). Positions are counted starting from 1 at the beginning of the list. DEF, if non-nil, is the default value. Completion ignores case if the ambient value of `completion-ignore-case' is non-nil." (let ((string (si:completing-read prompt table predicate require-match init hist))) (if (and (string= string "") def) def string))))))) ;; v18: (string-to-int STRING) ;; v19: (string-to-number STRING) ;; v20: (string-to-number STRING &optional BASE) ;; ;; XXX: `string-to-number' of Emacs 20.3 and earlier is broken. ;; (string-to-number "1e1" 16) => 10.0, should be 481. (static-condition-case nil ;; compile-time check. (if (= (string-to-number "1e1" 16) 481) (if (get 'string-to-number 'defun-maybe) (error "`string-to-number' is already redefined")) (error "`string-to-number' is broken")) (error ;; load-time check. (or (fboundp 'si:string-to-number) (progn (if (fboundp 'string-to-number) (fset 'si:string-to-number (symbol-function 'string-to-number)) (fset 'si:string-to-number (symbol-function 'string-to-int)) ;; XXX: In v18, this causes infinite loop while byte-compiling. ;; (defalias 'string-to-int 'string-to-number) ) (put 'string-to-number 'defun-maybe t) (defun string-to-number (string &optional base) "\ Convert STRING to a number by parsing it as a decimal number. This parses both integers and floating point numbers. It ignores leading spaces and tabs. If BASE, interpret STRING as a number in that base. If BASE isn't present, base 10 is used. BASE must be between 2 and 16 (inclusive). If the base used is not 10, floating point is not recognized." (if (or (null base) (= base 10)) (si:string-to-number string) (if (or (< base 2)(> base 16)) (signal 'args-out-of-range (cons base nil))) (let ((len (length string)) (pos 0)) ;; skip leading whitespace. (while (and (< pos len) (memq (aref string pos) '(?\ ?\t))) (setq pos (1+ pos))) (if (= pos len) 0 (let ((number 0)(negative 1) chr num) (if (eq (aref string pos) ?-) (setq negative -1 pos (1+ pos)) (if (eq (aref string pos) ?+) (setq pos (1+ pos)))) (while (and (< pos len) (setq chr (aref string pos) num (cond ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0)) ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10)) ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10)) (t nil))) (< num base)) (setq number (+ (* number base) num) pos (1+ pos))) (* negative number)))))))))) ;; Emacs 20.1 and 20.2: (concat-chars &rest CHARS) ;; Emacs 20.3/XEmacs 21.0 and later: (string &rest CHARS) (static-cond ((and (fboundp 'string) (subrp (symbol-function 'string))) ;; Emacs 20.3/XEmacs 21.0 and later. ) ((and (fboundp 'concat-chars) (subrp (symbol-function 'concat-chars))) ;; Emacs 20.1 and 20.2. (defalias 'string 'concat-chars)) (t ;; Use `defun-maybe' to update `load-history'. (defun-maybe string (&rest chars) "Concatenate all the argument characters and make the result a string." ;; We cannot use (apply 'concat chars) here because `concat' does not ;; work with multibyte chars on Mule 1.* and 2.*. (mapconcat (function char-to-string) chars "")))) ;; Mule: (char-before POS) ;; v20: (char-before &optional POS) (static-condition-case nil ;; compile-time check. (progn (char-before) (if (get 'char-before 'defun-maybe) (error "`char-before' is already defined"))) (wrong-number-of-arguments ; Mule. ;; load-time check. (or (fboundp 'si:char-before) (progn (fset 'si:char-before (symbol-function 'char-before)) (put 'char-before 'defun-maybe t) ;; takes IGNORED for backward compatibility. (defun char-before (&optional pos ignored) "\ Return character in current buffer preceding position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil." (si:char-before (or pos (point))))))) (void-function ; non-Mule. ;; load-time check. (defun-maybe char-before (&optional pos) "\ Return character in current buffer preceding position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil." (if pos (save-excursion (and (= (goto-char pos) (point)) (not (bobp)) (preceding-char))) (and (not (bobp)) (preceding-char))))) (error ; found our definition at compile-time. ;; load-time check. (condition-case nil (char-before) (wrong-number-of-arguments ; Mule. (or (fboundp 'si:char-before) (progn (fset 'si:char-before (symbol-function 'char-before)) (put 'char-before 'defun-maybe t) ;; takes IGNORED for backward compatibility. (defun char-before (&optional pos ignored) "\ Return character in current buffer preceding position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil." (si:char-before (or pos (point))))))) (void-function ; non-Mule. (defun-maybe char-before (&optional pos) "\ Return character in current buffer preceding position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil." (if pos (save-excursion (and (= (goto-char pos) (point)) (not (bobp)) (preceding-char))) (and (not (bobp)) (preceding-char)))))))) ;; v18, v19: (char-after POS) ;; v20: (char-after &optional POS) (static-condition-case nil ;; compile-time check. (progn (char-after) (if (get 'char-after 'defun-maybe) (error "`char-after' is already redefined"))) (wrong-number-of-arguments ; v18, v19 ;; load-time check. (or (fboundp 'si:char-after) (progn (fset 'si:char-after (symbol-function 'char-after)) (put 'char-after 'defun-maybe t) (defun char-after (&optional pos) "\ Return character in current buffer at position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil." (si:char-after (or pos (point))))))) (void-function ; NEVER happen? ;; load-time check. (defun-maybe char-after (&optional pos) "\ Return character in current buffer at position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil." (if pos (save-excursion (and (= (goto-char pos) (point)) (not (eobp)) (following-char))) (and (not (eobp)) (following-char))))) (error ; found our definition at compile-time. ;; load-time check. (condition-case nil (char-after) (wrong-number-of-arguments ; v18, v19 (or (fboundp 'si:char-after) (progn (fset 'si:char-after (symbol-function 'char-after)) (put 'char-after 'defun-maybe t) (defun char-after (&optional pos) "\ Return character in current buffer at position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil." (si:char-after (or pos (point))))))) (void-function ; NEVER happen? (defun-maybe char-after (&optional pos) "\ Return character in current buffer at position POS. POS is an integer or a buffer pointer. If POS is out of range, the value is nil." (if pos (save-excursion (and (= (goto-char pos) (point)) (not (eobp)) (following-char))) (and (not (eobp)) (following-char)))))))) ;; Emacs 19.29 and later: (buffer-substring-no-properties START END) (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." (let ((string (buffer-substring start end))) (set-text-properties 0 (length string) nil string) string)) ;; Emacs 19.31 and later: (buffer-live-p OBJECT) (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." (and object (get-buffer object) (buffer-name (get-buffer object)) t)) ;; Emacs 20: (line-beginning-position &optional N) (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 (forward-line (1- (or n 1))) (point))) ;; Emacs 20: (line-end-position &optional N) (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 (end-of-line (or n 1)) (point))) ;; FSF Emacs 19.29 and later ;; (read-file-name PROMPT &optional DIR DEFAULT-FILENAME MUSTMATCH INITIAL) ;; XEmacs 19.14 and later: ;; (read-file-name (PROMPT &optional DIR DEFAULT MUST-MATCH INITIAL-CONTENTS ;; HISTORY) ;; In FSF Emacs 19.28 and earlier (except for v18) or XEmacs 19.13 and ;; earlier, this function is incompatible with the other Emacsen. ;; For instance, if DEFAULT-FILENAME is nil, INITIAL is not and user ;; enters a null string, it returns the visited file name of the current ;; buffer if it is non-nil. ;; It does not assimilate the different numbers of the optional arguments ;; on various Emacsen (yet). (static-cond ((and (not (featurep 'xemacs)) (eq emacs-major-version 19) (< emacs-minor-version 29)) (if (fboundp 'si:read-file-name) nil (fset 'si:read-file-name (symbol-function 'read-file-name)) (defun read-file-name (prompt &optional dir default-filename mustmatch initial) "Read file name, prompting with PROMPT and completing in directory DIR. Value is not expanded---you must call `expand-file-name' yourself. Default name to DEFAULT-FILENAME if user enters a null string. (If DEFAULT-FILENAME is omitted, the visited file name is used, except that if INITIAL is specified, that combined with DIR is used.) Fourth arg MUSTMATCH non-nil means require existing file's name. Non-nil and non-t means also require confirmation after completion. Fifth arg INITIAL specifies text to start with. DIR defaults to current buffer's directory default." (si:read-file-name prompt dir (or default-filename (if initial (expand-file-name initial dir))) mustmatch initial)))) ((and (featurep 'xemacs) (eq emacs-major-version 19) (< emacs-minor-version 14)) (if (fboundp 'si:read-file-name) nil (fset 'si:read-file-name (symbol-function 'read-file-name)) (defun read-file-name (prompt &optional dir default must-match initial-contents history) "Read file name, prompting with PROMPT and completing in directory DIR. This will prompt with a dialog box if appropriate, according to `should-use-dialog-box-p'. Value is not expanded---you must call `expand-file-name' yourself. Value is subject to interpreted by substitute-in-file-name however. Default name to DEFAULT if user enters a null string. (If DEFAULT is omitted, the visited file name is used, except that if INITIAL-CONTENTS is specified, that combined with DIR is used.) Fourth arg MUST-MATCH non-nil means require existing file's name. Non-nil and non-t means also require confirmation after completion. Fifth arg INITIAL-CONTENTS specifies text to start with. Sixth arg HISTORY specifies the history list to use. Default is `file-name-history'. DIR defaults to current buffer's directory default." (si:read-file-name prompt dir (or default (if initial-contents (expand-file-name initial-contents dir))) must-match initial-contents history))))) ;;; @ Basic lisp subroutines emulation. (lisp/subr.el) ;;; ;;; @@ Lisp language features. (defmacro-maybe push (newelt listname) "Add NEWELT to the list stored in the symbol LISTNAME. This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)). LISTNAME must be a symbol." (list 'setq listname (list 'cons newelt listname))) (defmacro-maybe pop (listname) "Return the first element of LISTNAME's value, and remove it from the list. LISTNAME must be a symbol whose value is a list. If the value is nil, `pop' returns nil but does not actually change the list." (list 'prog1 (list 'car listname) (list 'setq listname (list 'cdr listname)))) (defmacro-maybe when (cond &rest body) "If COND yields non-nil, do BODY, else return nil." (list 'if cond (cons 'progn body))) ;; (def-edebug-spec when (&rest form)) (defmacro-maybe unless (cond &rest body) "If COND yields nil, do BODY, else return nil." (cons 'if (cons cond (cons nil body)))) ;; (def-edebug-spec unless (&rest form)) (defsubst-maybe caar (x) "Return the car of the car of X." (car (car x))) (defsubst-maybe cadr (x) "Return the car of the cdr of X." (car (cdr x))) (defsubst-maybe cdar (x) "Return the cdr of the car of X." (cdr (car x))) (defsubst-maybe cddr (x) "Return the cdr of the cdr of X." (cdr (cdr x))) (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)) ;; Actually, `butlast' and `nbutlast' are defined in lisp/cl.el. (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))) (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)))) ;; Emacs 20.3 and later: (assoc-default KEY ALIST &optional TEST DEFAULT) (defun-maybe assoc-default (key alist &optional test default) "Find object KEY in a pseudo-alist ALIST. ALIST is a list of conses or objects. Each element (or the element's car, if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY). If that is non-nil, the element matches; then `assoc-default' returns the element's cdr, if it is a cons, or DEFAULT if the element is not a cons. If no element matches, the value is nil. If TEST is omitted or nil, `equal' is used." (let (found (tail alist) value) (while (and tail (not found)) (let ((elt (car tail))) (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key) (setq found t value (if (consp elt) (cdr elt) default)))) (setq tail (cdr tail))) value)) ;; The following two function use `compare-strings', which we don't ;; support yet. ;; (defun assoc-ignore-case (key alist)) ;; (defun assoc-ignore-representation (key alist)) ;; Emacs 19.29/XEmacs 19.13 and later: (rassoc KEY LIST) ;; Actually, `rassoc' is defined in src/fns.c. (defun-maybe rassoc (key list) "Return non-nil if KEY is `equal' to the cdr of an element of LIST. The value is actually the element of LIST whose cdr equals KEY. Elements of LIST that are not conses are ignored." (catch 'found (while list (cond ((not (consp (car list)))) ((equal (cdr (car list)) key) (throw 'found (car list)))) (setq list (cdr list))))) ;; XEmacs 19.13 and later: (remassoc KEY ALIST) (defun-maybe remassoc (key alist) "Delete by side effect any elements of ALIST whose car is `equal' to KEY. The modified ALIST is returned. If the first member of ALIST has a car that is `equal' to KEY, there is no way to remove it by side effect; therefore, write `(setq foo (remassoc key foo))' to be sure of changing the value of `foo'." (while (and (consp alist) (or (not (consp (car alist))) (equal (car (car alist)) key))) (setq alist (cdr alist))) (if (consp alist) (let ((prev alist) (tail (cdr alist))) (while (consp tail) (if (and (consp (car alist)) (equal (car (car tail)) key)) ;; `(setcdr CELL NEWCDR)' returns NEWCDR. (setq tail (setcdr prev (cdr tail))) (setq prev (cdr prev) tail (cdr tail)))))) alist) ;; XEmacs 19.13 and later: (remassq KEY ALIST) (defun-maybe remassq (key alist) "Delete by side effect any elements of ALIST whose car is `eq' to KEY. The modified ALIST is returned. If the first member of ALIST has a car that is `eq' to KEY, there is no way to remove it by side effect; therefore, write `(setq foo (remassq key foo))' to be sure of changing the value of `foo'." (while (and (consp alist) (or (not (consp (car alist))) (eq (car (car alist)) key))) (setq alist (cdr alist))) (if (consp alist) (let ((prev alist) (tail (cdr alist))) (while (consp tail) (if (and (consp (car tail)) (eq (car (car tail)) key)) ;; `(setcdr CELL NEWCDR)' returns NEWCDR. (setq tail (setcdr prev (cdr tail))) (setq prev (cdr prev) tail (cdr tail)))))) alist) ;; XEmacs 19.13 and later: (remrassoc VALUE ALIST) (defun-maybe remrassoc (value alist) "Delete by side effect any elements of ALIST whose cdr is `equal' to VALUE. The modified ALIST is returned. If the first member of ALIST has a car that is `equal' to VALUE, there is no way to remove it by side effect; therefore, write `(setq foo (remrassoc value foo))' to be sure of changing the value of `foo'." (while (and (consp alist) (or (not (consp (car alist))) (equal (cdr (car alist)) value))) (setq alist (cdr alist))) (if (consp alist) (let ((prev alist) (tail (cdr alist))) (while (consp tail) (if (and (consp (car tail)) (equal (cdr (car tail)) value)) ;; `(setcdr CELL NEWCDR)' returns NEWCDR. (setq tail (setcdr prev (cdr tail))) (setq prev (cdr prev) tail (cdr tail)))))) alist) ;; XEmacs 19.13 and later: (remrassq VALUE ALIST) (defun-maybe remrassq (value alist) "Delete by side effect any elements of ALIST whose cdr is `eq' to VALUE. The modified ALIST is returned. If the first member of ALIST has a car that is `eq' to VALUE, there is no way to remove it by side effect; therefore, write `(setq foo (remrassq value foo))' to be sure of changing the value of `foo'." (while (and (consp alist) (or (not (consp (car alist))) (eq (cdr (car alist)) value))) (setq alist (cdr alist))) (if (consp alist) (let ((prev alist) (tail (cdr alist))) (while (consp tail) (if (and (consp (car tail)) (eq (cdr (car tail)) value)) ;; `(setcdr CELL NEWCDR)' returns NEWCDR. (setq tail (setcdr prev (cdr tail))) (setq prev (cdr prev) tail (cdr tail)))))) alist) ;;; Define `functionp' here because "localhook" uses it. ;; Emacs 20.1/XEmacs 20.3 (but first appeared in Epoch?): (functionp OBJECT) (defun-maybe functionp (object) "Non-nil if OBJECT is a type of object that can be called as a function." (or (subrp object) (byte-code-function-p object) (eq (car-safe object) 'lambda) (and (symbolp object) (fboundp object)))) ;;; @@ Hook manipulation functions. ;; "localhook" package is written for Emacs 19.28 and earlier. ;; `run-hooks' was a lisp function in Emacs 19.29 and earlier. ;; So, in Emacs 19.29, `run-hooks' and others will be overrided. ;; But, who cares it? (static-unless (subrp (symbol-function 'run-hooks)) (require 'localhook)) ;; Emacs 19.29/XEmacs 19.14(?) and later: (add-to-list LIST-VAR ELEMENT) (defun-maybe add-to-list (list-var element) "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. The test for presence of ELEMENT is done with `equal'. 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. `eval-after-load' provides one way to do this. In some cases other hooks, such as major mode hooks, can do the job." (or (member element (symbol-value list-var)) (set list-var (cons element (symbol-value list-var))))) ;; (eval-after-load FILE FORM) ;; Emacs 19.28 and earlier do not evaluate FORM if FILE is already loaded. ;; XEmacs 20.2 and earlier have `after-load-alist', but refuse to support ;; `eval-after-load'. (see comments in XEmacs/lisp/subr.el.) (static-cond ((featurep 'xemacs) ;; for XEmacs 20.2 and earlier. (defun-maybe eval-after-load (file form) "Arrange that, if FILE is ever loaded, FORM will be run at that time. This makes or adds to an entry on `after-load-alist'. If FILE is already loaded, evaluate FORM right now. It does nothing if FORM is already on the list for FILE. FILE should be the name of a library, with no directory name." ;; Make sure there is an element for FILE. (or (assoc file after-load-alist) (setq after-load-alist (cons (list file) after-load-alist))) ;; Add FORM to the element if it isn't there. (let ((elt (assoc file after-load-alist))) (or (member form (cdr elt)) (progn (nconc elt (list form)) ;; If the file has been loaded already, run FORM right away. (and (assoc file load-history) (eval form))))) form)) ((>= emacs-major-version 20)) ((and (= emacs-major-version 19) (< emacs-minor-version 29)) ;; for Emacs 19.28 and earlier. (defun eval-after-load (file form) "Arrange that, if FILE is ever loaded, FORM will be run at that time. This makes or adds to an entry on `after-load-alist'. If FILE is already loaded, evaluate FORM right now. It does nothing if FORM is already on the list for FILE. FILE should be the name of a library, with no directory name." ;; Make sure there is an element for FILE. (or (assoc file after-load-alist) (setq after-load-alist (cons (list file) after-load-alist))) ;; Add FORM to the element if it isn't there. (let ((elt (assoc file after-load-alist))) (or (member form (cdr elt)) (progn (nconc elt (list form)) ;; If the file has been loaded already, run FORM right away. (and (assoc file load-history) (eval form))))) form)) (t ;; should emulate for v18? )) (defun-maybe eval-next-after-load (file) "Read the following input sexp, and run it whenever FILE is loaded. This makes or adds to an entry on `after-load-alist'. FILE should be the name of a library, with no directory name." (eval-after-load file (read))) ;;; @@ Input and display facilities. ;; XXX: (defun read-passwd (prompt &optional confirm default)) ;;; @@ Miscellanea. ;; Avoid compiler warnings about this variable, ;; which has a special meaning on certain system types. (defvar-maybe buffer-file-type nil "Non-nil if the visited file is a binary file. This variable is meaningful on MS-DOG and Windows NT. On those systems, it is automatically local in every buffer. On other systems, this variable is normally always nil.") ;; Emacs 20.3 or later. (defvar-maybe minor-mode-overriding-map-alist nil "Alist of keymaps to use for minor modes, in current major mode. APEL provides this as dummy for compatibility.") ;; Emacs 20.1/XEmacs 20.3(?) and later: (save-current-buffer &rest BODY) ;; ;; v20 defines `save-current-buffer' as a C primitive (in src/editfns.c) ;; and introduces a new bytecode Bsave_current_buffer(_1), replacing an ;; obsolete bytecode Bread_char. To make things worse, Emacs 20.1 and ;; 20.2 have a bug that it will restore the current buffer without ;; confirming that it is alive. ;; ;; This is a source of incompatibility of .elc between v18/v19 and v20. ;; (XEmacs compiler takes care of it if compatibility mode is enabled.) (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)) (if (buffer-live-p orig-buffer) (set-buffer orig-buffer)))))) ;; Emacs 20.1/XEmacs 20.3(?) and later: (with-current-buffer BUFFER &rest BODY) (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)))) ;; Emacs 20.1/XEmacs 20.3(?) and later: (with-temp-file FILE &rest FORMS) (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)))))))) ;; Emacs 20.4 and later: (with-temp-message MESSAGE &rest BODY) ;; This macro uses `current-message', which appears in v20. (static-when (and (fboundp 'current-message) (subrp (symbol-function 'current-message))) (defmacro-maybe with-temp-message (message &rest body) "\ Display MESSAGE temporarily if non-nil while BODY is evaluated. The original message is restored to the echo area after BODY has finished. The value returned is the value of the last form in BODY. MESSAGE is written to the message log buffer if `message-log-max' is non-nil. If MESSAGE is nil, the echo area and message log buffer are unchanged. Use a MESSAGE of \"\" to temporarily clear the echo area." (let ((current-message (make-symbol "current-message")) (temp-message (make-symbol "with-temp-message"))) (` (let (((, temp-message) (, message)) ((, current-message))) (unwind-protect (progn (when (, temp-message) (setq (, current-message) (current-message)) (message "%s" (, temp-message)) (,@ body)) (and (, temp-message) (, current-message) (message "%s" (, current-message)))))))))) ;; Emacs 20.1/XEmacs 20.3(?) and later: (with-temp-buffer &rest FORMS) (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)))))))) ;; Emacs 20.1/XEmacs 20.3(?) and later: (with-output-to-string &rest BODY) (defmacro-maybe with-output-to-string (&rest body) "Execute BODY, return the text it sent to `standard-output', as a string." (` (let ((standard-output (get-buffer-create (generate-new-buffer-name " *string-output*")))) (let ((standard-output standard-output)) (,@ body)) (with-current-buffer standard-output (prog1 (buffer-string) (kill-buffer nil)))))) ;; Emacs 20.1 and later: (combine-after-change-calls &rest BODY) (defmacro-maybe combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. If BODY makes changes in the buffer, they are recorded and the functions on `after-change-functions' are called several times when BODY is finished. The return value is the value of the last form in BODY. If `before-change-functions' is non-nil, then calls to the after-change functions can't be deferred, so in that case this macro has no effect. Do not alter `after-change-functions' or `before-change-functions' in BODY. This emulating macro does not support after-change functions at all, just execute BODY." (cons 'progn body)) ;; Emacs 19.29/XEmacs 19.14(?) and later: (match-string NUM &optional 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." (if (match-beginning num) (if string (substring string (match-beginning num) (match-end num)) (buffer-substring (match-beginning num) (match-end num))))) ;; Emacs 20.3 and later: (match-string-no-properties NUM &optional STRING) (defun-maybe match-string-no-properties (num &optional string) "Return string of text matched by last search, without text properties. 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." (if (match-beginning num) (if string (let ((result (substring string (match-beginning num) (match-end num)))) (set-text-properties 0 (length result) nil result) result) (buffer-substring-no-properties (match-beginning num) (match-end num))))) ;; Emacs 19.28 and earlier ;; (replace-match NEWTEXT &optional FIXEDCASE LITERAL) ;; Emacs 20.x (?) and later ;; (replace-match NEWTEXT &optional FIXEDCASE LITERAL STRING SUBEXP) ;; XEmacs 21: ;; (replace-match NEWTEXT &optional FIXEDCASE LITERAL STRING STRBUFFER) ;; We support following API. ;; (replace-match NEWTEXT &optional FIXEDCASE LITERAL STRING) (static-condition-case nil ;; compile-time check (progn (string-match "" "") (replace-match "" nil nil "") (if (get 'replace-match 'defun-maybe) (error "`replace-match' is already defined"))) (wrong-number-of-arguments ; Emacs 19.28 and earlier ;; load-time check. (or (fboundp 'si:replace-match) (progn (fset 'si:replace-match (symbol-function 'replace-match)) (put 'replace-match 'defun-maybe t) (defun replace-match (newtext &optional fixedcase literal string) "Replace text matched by last search with NEWTEXT. If second arg FIXEDCASE is non-nil, do not alter case of replacement text. Otherwise maybe capitalize the whole text, or maybe just word initials, based on the replaced text. If the replaced text has only capital letters and has at least one multiletter word, convert NEWTEXT to all caps. If the replaced text has at least one word starting with a capital letter, then capitalize each word in NEWTEXT. If third arg LITERAL is non-nil, insert NEWTEXT literally. Otherwise treat `\' as special: `\&' in NEWTEXT means substitute original matched text. `\N' means substitute what matched the Nth `\(...\)'. If Nth parens didn't match, substitute nothing. `\\' means insert one `\'. FIXEDCASE and LITERAL are optional arguments. Leaves point at end of replacement text. The optional fourth argument STRING can be a string to modify. In that case, this function creates and returns a new string which is made by replacing the part of STRING that was matched." (if string (with-temp-buffer (save-match-data (insert string) (let* ((matched (match-data)) (beg (nth 0 matched)) (end (nth 1 matched))) (store-match-data (list (if (markerp beg) (move-marker beg (1+ (match-beginning 0))) (1+ (match-beginning 0))) (if (markerp end) (move-marker end (1+ (match-end 0))) (1+ (match-end 0)))))) (si:replace-match newtext fixedcase literal) (buffer-string))) (si:replace-match newtext fixedcase literal)))))) (error ; found our definition at compile-time. ;; load-time check. (condition-case nil (progn (string-match "" "") (replace-match "" nil nil "")) (wrong-number-of-arguments ; Emacs 19.28 and earlier ;; load-time check. (or (fboundp 'si:replace-match) (progn (fset 'si:replace-match (symbol-function 'replace-match)) (put 'replace-match 'defun-maybe t) (defun replace-match (newtext &optional fixedcase literal string) "Replace text matched by last search with NEWTEXT. If second arg FIXEDCASE is non-nil, do not alter case of replacement text. Otherwise maybe capitalize the whole text, or maybe just word initials, based on the replaced text. If the replaced text has only capital letters and has at least one multiletter word, convert NEWTEXT to all caps. If the replaced text has at least one word starting with a capital letter, then capitalize each word in NEWTEXT. If third arg LITERAL is non-nil, insert NEWTEXT literally. Otherwise treat `\' as special: `\&' in NEWTEXT means substitute original matched text. `\N' means substitute what matched the Nth `\(...\)'. If Nth parens didn't match, substitute nothing. `\\' means insert one `\'. FIXEDCASE and LITERAL are optional arguments. Leaves point at end of replacement text. The optional fourth argument STRING can be a string to modify. In that case, this function creates and returns a new string which is made by replacing the part of STRING that was matched." (if string (with-temp-buffer (save-match-data (insert string) (let* ((matched (match-data)) (beg (nth 0 matched)) (end (nth 1 matched))) (store-match-data (list (if (markerp beg) (move-marker beg (1+ (match-beginning 0))) (1+ (match-beginning 0))) (if (markerp end) (move-marker end (1+ (match-end 0))) (1+ (match-end 0)))))) (si:replace-match newtext fixedcase literal) (buffer-string))) (si:replace-match newtext fixedcase literal))))))))) ;; Emacs 20: (format-time-string FORMAT &optional TIME UNIVERSAL) ;; Those format constructs are yet to be implemented. ;; %c, %C, %j, %U, %W, %x, %X ;; Not fully compatible especially when invalid format is specified. (static-unless (and (fboundp 'format-time-string) (not (get 'format-time-string 'defun-maybe))) (or (fboundp 'format-time-string) (progn (defconst format-time-month-list '(( "Zero" . ("Zero" . 0)) ("Jan" . ("January" . 1)) ("Feb" . ("February" . 2)) ("Mar" . ("March" . 3)) ("Apr" . ("April" . 4)) ("May" . ("May" . 5)) ("Jun" . ("June" . 6))("Jul" . ("July" . 7)) ("Aug" . ("August" . 8)) ("Sep" . ("September" . 9)) ("Oct" . ("October" . 10)) ("Nov" . ("November" . 11)) ("Dec" . ("December" . 12))) "Alist of months and their number.") (defconst format-time-week-list '(("Sun" . ("Sunday" . 0)) ("Mon" . ("Monday" . 1)) ("Tue" . ("Tuesday" . 2)) ("Wed" . ("Wednesday" . 3)) ("Thu" . ("Thursday" . 4)) ("Fri" . ("Friday" . 5)) ("Sat" . ("Saturday" . 6))) "Alist of weeks and their number.") (defun format-time-string (format &optional time universal) "Use FORMAT-STRING to format the time TIME, or now if omitted. TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by `current-time' or `file-attributes'. The third, optional, argument UNIVERSAL, if non-nil, means describe TIME as Universal Time; nil means describe TIME in the local time zone. The value is a copy of FORMAT-STRING, but with certain constructs replaced by text that describes the specified date and time in TIME: %Y is the year, %y within the century, %C the century. %G is the year corresponding to the ISO week, %g within the century. %m is the numeric month. %b and %h are the locale's abbreviated month name, %B the full name. %d is the day of the month, zero-padded, %e is blank-padded. %u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6. %a is the locale's abbreviated name of the day of week, %A the full name. %U is the week number starting on Sunday, %W starting on Monday, %V according to ISO 8601. %j is the day of the year. %H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H only blank-padded, %l is like %I blank-padded. %p is the locale's equivalent of either AM or PM. %M is the minute. %S is the second. %Z is the time zone name, %z is the numeric form. %s is the number of seconds since 1970-01-01 00:00:00 +0000. %c is the locale's date and time format. %x is the locale's \"preferred\" date format. %D is like \"%m/%d/%y\". %R is like \"%H:%M\", %T is like \"%H:%M:%S\", %r is like \"%I:%M:%S %p\". %X is the locale's \"preferred\" time format. Finally, %n is a newline, %t is a tab, %% is a literal %. Certain flags and modifiers are available with some format controls. The flags are `_' and `-'. For certain characters X, %_X is like %X, but padded with blanks; %-X is like %X, but without padding. %NX (where N stands for an integer) is like %X, but takes up at least N (a number) positions. The modifiers are `E' and `O'. For certain characters X, %EX is a locale's alternative version of %X; %OX is like %X, but uses the locale's number symbols. For example, to produce full ISO 8601 format, use \"%Y-%m-%dT%T%z\". Compatibility Note. Those format constructs are yet to be implemented. %c, %C, %j, %U, %W, %x, %X Not fully compatible especially when invalid format is specified." (let ((fmt-len (length format)) (ind 0) prev-ind cur-char (prev-char nil) strings-so-far (result "") field-width field-result pad-left change-case (paren-level 0) hour ms ls (tz (car (current-time-zone))) time-string) (if universal (progn (or time (setq time (current-time))) (setq ms (car time) ls (- (nth 1 time) tz)) (cond ((< ls 0) (setq ms (1- ms) ls (+ ls 65536))) ((>= ls 65536) (setq ms (1+ ms) ls (- ls 65536)))) (setq time (append (list ms ls) (nth 2 time))))) (setq time-string (current-time-string time) hour (string-to-int (substring time-string 11 13))) (while (< ind fmt-len) (setq cur-char (aref format ind)) (setq result (concat result (cond ((eq cur-char ?%) ;; eat any additional args to allow for future expansion, not!! (setq pad-left nil change-case nil field-width "" prev-ind ind strings-so-far "") ; (catch 'invalid (while (progn (setq ind (1+ ind)) (setq cur-char (if (< ind fmt-len) (aref format ind) ?\0)) (or (eq ?- cur-char) ; pad on left (eq ?# cur-char) ; case change (if (and (string-equal field-width "") (<= ?0 cur-char) (>= ?9 cur-char)) ;; get format width (let ((field-index ind)) (while (progn (setq ind (1+ ind)) (setq cur-char (if (< ind fmt-len) (aref format ind) ?\0)) (and (<= ?0 cur-char) (>= ?9 cur-char)))) (setq field-width (substring format field-index ind)) (setq ind (1- ind) cur-char nil) t)))) (setq prev-char cur-char strings-so-far (concat strings-so-far (if cur-char (char-to-string cur-char) field-width))) ;; characters we actually use (cond ((eq cur-char ?-) ;; padding to left must be specified before field-width (setq pad-left (string-equal field-width ""))) ((eq cur-char ?#) (setq change-case t)))) (setq field-result (cond ((eq cur-char ?%) "%") ;; the abbreviated name of the day of week. ((eq cur-char ?a) (substring time-string 0 3)) ;; the full name of the day of week ((eq cur-char ?A) (cadr (assoc (substring time-string 0 3) format-time-week-list))) ;; the abbreviated name of the month ((eq cur-char ?b) (substring time-string 4 7)) ;; the full name of the month ((eq cur-char ?B) (cadr (assoc (substring time-string 4 7) format-time-month-list))) ;; a synonym for `%x %X' (yet to come) ((eq cur-char ?c) "") ;; locale specific (yet to come) ((eq cur-char ?C) "") ;; the day of month, zero-padded ((eq cur-char ?d) (format "%02d" (string-to-int (substring time-string 8 10)))) ;; a synonym for `%m/%d/%y' ((eq cur-char ?D) (format "%02d/%02d/%s" (cddr (assoc (substring time-string 4 7) format-time-month-list)) (string-to-int (substring time-string 8 10)) (substring time-string -2))) ;; the day of month, blank-padded ((eq cur-char ?e) (format "%2d" (string-to-int (substring time-string 8 10)))) ;; a synonym for `%b' ((eq cur-char ?h) (substring time-string 4 7)) ;; the hour (00-23) ((eq cur-char ?H) (substring time-string 11 13)) ;; the hour (00-12) ((eq cur-char ?I) (format "%02d" (if (> hour 12) (- hour 12) hour))) ;; the day of the year (001-366) (yet to come) ((eq cur-char ?j) "") ;; the hour (0-23), blank padded ((eq cur-char ?k) (format "%2d" hour)) ;; the hour (1-12), blank padded ((eq cur-char ?l) (format "%2d" (if (> hour 12) (- hour 12) hour))) ;; the month (01-12) ((eq cur-char ?m) (format "%02d" (cddr (assoc (substring time-string 4 7) format-time-month-list)))) ;; the minute (00-59) ((eq cur-char ?M) (substring time-string 14 16)) ;; a newline ((eq cur-char ?n) "\n") ;; `AM' or `PM', as appropriate ((eq cur-char ?p) (setq change-case (not change-case)) (if (> hour 12) "pm" "am")) ;; a synonym for `%I:%M:%S %p' ((eq cur-char ?r) (format "%02d:%s:%s %s" (if (> hour 12) (- hour 12) hour) (substring time-string 14 16) (substring time-string 17 19) (if (> hour 12) "PM" "AM"))) ;; a synonym for `%H:%M' ((eq cur-char ?R) (format "%s:%s" (substring time-string 11 13) (substring time-string 14 16))) ;; the seconds (00-60) ((eq cur-char ?S) (substring time-string 17 19)) ;; a tab character ((eq cur-char ?t) "\t") ;; a synonym for `%H:%M:%S' ((eq cur-char ?T) (format "%s:%s:%s" (substring time-string 11 13) (substring time-string 14 16) (substring time-string 17 19))) ;; the week of the year (01-52), assuming that weeks ;; start on Sunday (yet to come) ((eq cur-char ?U) "") ;; the numeric day of week (0-6). Sunday is day 0 ((eq cur-char ?w) (format "%d" (cddr (assoc (substring time-string 0 3) format-time-week-list)))) ;; the week of the year (01-52), assuming that weeks ;; start on Monday (yet to come) ((eq cur-char ?W) "") ;; locale specific (yet to come) ((eq cur-char ?x) "") ;; locale specific (yet to come) ((eq cur-char ?X) "") ;; the year without century (00-99) ((eq cur-char ?y) (substring time-string -2)) ;; the year with century ((eq cur-char ?Y) (substring time-string -4)) ;; the time zone abbreviation ((eq cur-char ?Z) (if universal "UTC" (setq change-case (not change-case)) (downcase (cadr (current-time-zone))))) ((eq cur-char ?z) (if universal "+0000" (if (< tz 0) (format "-%02d%02d" (/ (- tz) 3600) (/ (% (- tz) 3600) 60)) (format "+%02d%02d" (/ tz 3600) (/ (% tz 3600) 60))))) (t (concat "%" strings-so-far (char-to-string cur-char))))) ; (setq ind prev-ind) ; (throw 'invalid "%")))) (if (string-equal field-width "") (if change-case (upcase field-result) field-result) (let ((padded-result (format (format "%%%s%s%c" "" ; pad on left is ignored ; (if pad-left "-" "") field-width ?s) (or field-result "")))) (let ((initial-length (length padded-result)) (desired-length (string-to-int field-width))) (when (and (string-match "^0" field-width) (string-match "^ +" padded-result)) (setq padded-result (replace-match (make-string (length (match-string 0 padded-result)) ?0) nil nil padded-result))) (if (> initial-length desired-length) ;; truncate strings on right, years on left (if (stringp field-result) (substring padded-result 0 desired-length) (if (eq cur-char ?y) (substring padded-result (- desired-length)) padded-result))) ;non-year numbers don't truncate (if change-case (upcase padded-result) padded-result))))) ;) (t (char-to-string cur-char))))) (setq ind (1+ ind))) result)) ;; for `load-history'. (setq current-load-list (cons 'format-time-string current-load-list)) (put 'format-time-string 'defun-maybe t)))) ;; Emacs 19.29-19.34/XEmacs: `format-time-string' neither supports the ;; format string "%z" nor the third argument `universal'. (unless (string-match "\\`[---+][0-9]+\\'" (format-time-string "%z" (current-time))) (defadvice format-time-string (before support-timezone-in-numeric-form-and-3rd-arg (format-string &optional time universal) activate compile) "Advice to support the construct `%z' and the third argument `universal'." (let ((tz (car (current-time-zone))) case-fold-search ms ls) (while (string-match "\\(\\(\\`\\|[^%]\\)\\(%%\\)*\\)%z" format-string) (setq format-string (concat (substring format-string 0 (match-end 1)) (if universal "+0000" (if (< tz 0) (format "-%02d%02d" (/ (- tz) 3600) (/ (% (- tz) 3600) 60)) (format "+%02d%02d" (/ tz 3600) (/ (% tz 3600) 60)))) (substring format-string (match-end 0))))) (if universal (progn (while (string-match "\\(\\(\\`\\|[^%]\\)\\(%%\\)*\\)%Z" format-string) (setq format-string (concat (substring format-string 0 (match-end 1)) "UTC" (substring format-string (match-end 0))))) (or time (setq time (current-time))) (setq ms (car time) ls (- (nth 1 time) tz)) (cond ((< ls 0) (setq ms (1- ms) ls (+ ls 65536))) ((>= ls 65536) (setq ms (1+ ms) ls (- ls 65536)))) (setq time (append (list ms ls) (nth 2 time)))))))) (defconst-maybe split-string-default-separators "[ \f\t\n\r\v]+" "The default value of separators for `split-string'. A regexp matching strings of whitespace. May be locale-dependent \(as yet unimplemented). Should not match non-breaking spaces. Warning: binding this to a different value and using it as default is likely to have undesired semantics.") ;; Here is a Emacs 22 version. OMIT-NULLS (defun-maybe split-string (string &optional separators omit-nulls) "Split STRING into substrings bounded by matches for SEPARATORS. The beginning and end of STRING, and each match for SEPARATORS, are splitting points. The substrings matching SEPARATORS are removed, and the substrings between the splitting points are collected as a list, which is returned. If SEPARATORS is non-nil, it should be a regular expression matching text which separates, but is not part of, the substrings. If nil it defaults to `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and OMIT-NULLS is forced to t. If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so that for the default value of SEPARATORS leading and trailing whitespace are effectively trimmed). If nil, all zero-length substrings are retained, which correctly parses CSV format, for example. Note that the effect of `(split-string STRING)' is the same as `(split-string STRING split-string-default-separators t)'). In the rare case that you wish to retain zero-length substrings when splitting on whitespace, use `(split-string STRING split-string-default-separators)'. Modifies the match data; use `save-match-data' if necessary." (let ((keep-nulls (not (if separators omit-nulls t))) (rexp (or separators split-string-default-separators)) (start 0) notfirst (list nil)) (while (and (string-match rexp string (if (and notfirst (= start (match-beginning 0)) (< start (length string))) (1+ start) start)) (< start (length string))) (setq notfirst t) (if (or keep-nulls (< start (match-beginning 0))) (setq list (cons (substring string start (match-beginning 0)) list))) (setq start (match-end 0))) (if (or keep-nulls (< start (length string))) (setq list (cons (substring string start) list))) (nreverse list))) ;;; @ Window commands emulation. (lisp/window.el) ;;; (defmacro-maybe save-selected-window (&rest body) "Execute BODY, then select the window that was selected before BODY." (list 'let '((save-selected-window-window (selected-window))) (list 'unwind-protect (cons 'progn body) (list 'select-window 'save-selected-window-window)))) ;; Emacs 19.31 and later: ;; (get-buffer-window-list &optional BUFFER MINIBUF FRAME) (defun-maybe get-buffer-window-list (buffer &optional minibuf frame) "Return windows currently displaying BUFFER, or nil if none. See `walk-windows' for the meaning of MINIBUF and FRAME." (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows) (walk-windows (function (lambda (window) (if (eq (window-buffer window) buffer) (setq windows (cons window windows))))) minibuf frame) windows)) ;;; @ Frame commands emulation. (lisp/frame.el) ;;; ;; XEmacs 21.0 and later: ;; (save-selected-frame &rest BODY) (defmacro-maybe save-selected-frame (&rest body) "Execute forms in BODY, then restore the selected frame." (list 'let '((save-selected-frame-frame (selected-frame))) (list 'unwind-protect (cons 'progn body) (list 'select-frame 'save-selected-frame-frame)))) ;;; @ Basic editing commands emulation. (lisp/simple.el) ;;; ;;; @ File input and output commands emulation. (lisp/files.el) ;;; (defvar-maybe temporary-file-directory (file-name-as-directory (cond ((memq system-type '(ms-dos windows-nt)) (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp")) ((memq system-type '(vax-vms axp-vms)) (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:")) (t (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp")))) "The directory for writing temporary files.") ;; Emacs 21 CVS ; nothing to do. ;; (make-temp-file PREFIX &optional DIR-FLAG SUFFIX) ;; ;; Emacs 21.1-21.3 ; replace with CVS version of `make-temp-file'. ;; (make-temp-file PREFIX &optional DIR-FLAG) ;; ;; Emacs 20 and earlier ; install our version of `make-temp-file', for ;; or XEmacs ; single-user system or for multi-user system. (eval-when-compile (cond ((get 'make-temp-file 'defun-maybe) ;; this form is already evaluated during compilation. ) ((not (fboundp 'make-temp-file)) ;; Emacs 20 and earlier, or XEmacs. (put 'make-temp-file 'defun-maybe 'none)) (t (let* ((object (symbol-function 'make-temp-file)) (arglist (cond ((byte-code-function-p object) (if (fboundp 'compiled-function-arglist) (compiled-function-arglist object) (aref object 0))) ((eq (car-safe object) 'lambda) (nth 1 object)) ;; `make-temp-file' is a built-in. ))) ;; arglist: (prefix &optional dir-flag suffix) (cond ((not arglist) ;; `make-temp-file' is a built-in; expects 3-args. (put 'make-temp-file 'defun-maybe '3-args)) ((> (length arglist) 3) ;; Emacs 21 CVS. (put 'make-temp-file 'defun-maybe '3-args)) (t ;; Emacs 21.1-21.3 (put 'make-temp-file 'defun-maybe '2-args))))))) (static-cond ((eq (get 'make-temp-file 'defun-maybe) '3-args) (put 'make-temp-file 'defun-maybe '3-args)) ((eq (get 'make-temp-file 'defun-maybe) '2-args) (put 'make-temp-file 'defun-maybe '2-args) (or (fboundp 'si:make-temp-file) (fset 'si:make-temp-file (symbol-function 'make-temp-file))) (setq current-load-list (cons 'make-temp-file current-load-list)) (defun make-temp-file (prefix &optional dir-flag suffix) "\ Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), is guaranteed to point to a newly created empty file. You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." (let ((umask (default-file-modes)) file) (unwind-protect (progn ;; Create temp files with strict access rights. ;; It's easy toloosen them later, whereas it's impossible ;; to close the time-window of loose permissions otherwise. (set-default-file-modes 448) (while (condition-case () (progn (setq file (make-temp-name (expand-file-name prefix temporary-file-directory))) (if suffix (setq file (concat file suffix))) (if dir-flag (make-directory file) (write-region "" nil file nil 'silent nil 'excl)) nil) (file-already-exists t)) ;; the file was somehow created by someone else between ;; `make-temp-name' and `write-region', let's try again. nil) file) ;; Reset the umask. (set-default-file-modes umask))))) ((eq (get 'make-temp-file 'defun-maybe) 'none) (put 'make-temp-file 'defun-maybe 'none) (setq current-load-list (cons 'make-temp-file current-load-list)) ;; must be load-time check to share .elc between different systems. (cond ((memq system-type '(windows-nt ms-dos OS/2 emx)) ;; for single-user systems. (defun make-temp-file (prefix &optional dir-flag suffix) "Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), is guaranteed to point to a newly created empty file. You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." (let ((file (make-temp-name (expand-file-name prefix temporary-file-directory)))) (if suffix (setq file (concat file suffix))) (if dir-flag (make-directory file) (write-region "" nil file nil 'silent)) file))) (t ;; for multi-user systems. (defun make-temp-file (prefix &optional dir-flag suffix) "Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), is guaranteed to point to a newly created empty file. You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." (let ((prefix (expand-file-name prefix temporary-file-directory))) (if dir-flag ;; Create a new empty directory. (let (dir) (while (condition-case () (progn (setq dir (make-temp-name prefix)) (if suffix (setq dir (concat dir suffix))) ;; `make-directory' returns nil for success, ;; otherwise signals an error. (make-directory dir)) ;; the dir was somehow created by someone else ;; between `make-temp-name' and `make-directory', ;; let's try again. (file-already-exists t))) (set-file-modes dir 448) dir) ;; Create a new empty file. (let (tempdir tempfile) (unwind-protect (let (file) ;; First, create a temporary directory. (while (condition-case () (progn (setq tempdir (make-temp-name (concat (file-name-directory prefix) "DIR"))) ;; return nil or signal an error. (make-directory tempdir)) ;; let's try again. (file-already-exists t))) (set-file-modes tempdir 448) ;; Second, create a temporary file in the tempdir. ;; There *is* a race condition between `make-temp-name' ;; and `write-region', but we don't care it since we are ;; in a private directory now. (setq tempfile (make-temp-name (concat tempdir "/EMU"))) (write-region "" nil tempfile nil 'silent) (set-file-modes tempfile 384) ;; Finally, make a hard-link from the tempfile. (while (condition-case () (progn (setq file (make-temp-name prefix)) (if suffix (setq file (concat file suffix))) ;; return nil or signal an error. (add-name-to-file tempfile file)) ;; let's try again. (file-already-exists t))) file) ;; Cleanup the tempfile. (and tempfile (file-exists-p tempfile) (delete-file tempfile)) ;; Cleanup the tempdir. (and tempdir (file-directory-p tempdir) (delete-directory tempdir))))))))))) ;; Actually, `path-separator' is defined in src/emacs.c and overrided ;; in dos-w32.el. (defvar-maybe path-separator ":" "The directory separator in search paths, as a string.") ;; `convert-standard-filename' is defined in lisp/files.el and overrided ;; in lisp/dos-fns.el and lisp/w32-fns.el for each environment. (cond ;; must be load-time check to share .elc between different systems. ((fboundp 'convert-standard-filename)) ((memq system-type '(windows-nt ms-dos)) ;; should we do (require 'filename) at load-time ? ;; (require 'filename) ;; filename.el requires many modules, so we do not want to load it ;; at compile-time. Instead, suppress warnings by these autoloads. (eval-when-compile (autoload 'filename-maybe-truncate-by-size "filename") (autoload 'filename-special-filter "filename")) (defun convert-standard-filename (filename) "Convert a standard file's name to something suitable for the current OS. This function's standard definition is trivial; it just returns the argument. However, on some systems, the function is redefined with a definition that really does change some file names. Under `windows-nt' or `ms-dos', it refers `filename-replacement-alist' and `filename-limit-length' for the basic filename and each parent directory name." (require 'filename) (let* ((names (split-string filename "/")) (drive-name (car names)) (filter (function (lambda (string) (filename-maybe-truncate-by-size (filename-special-filter string)))))) (cond ((eq 1 (length names)) (funcall filter drive-name)) ((string-match "^[^/]:$" drive-name) (concat drive-name "/" (mapconcat filter (cdr names) "/"))) (t (mapconcat filter names "/")))))) (t (defun convert-standard-filename (filename) "Convert a standard file's name to something suitable for the current OS. This function's standard definition is trivial; it just returns the argument. However, on some systems, the function is redefined with a definition that really does change some file names. Under `windows-nt' or `ms-dos', it refers `filename-replacement-alist' and `filename-limit-length' for the basic filename and each parent directory name." filename))) (static-cond ((fboundp 'insert-file-contents-literally)) ((boundp 'file-name-handler-alist) ;; Use `defun-maybe' to update `load-history'. (defun-maybe 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." (let (file-name-handler-alist) (insert-file-contents filename visit beg end replace)))) (t (defalias 'insert-file-contents-literally 'insert-file-contents))) (defun-maybe file-name-sans-extension (filename) "Return FILENAME sans final \"extension\". The extension, in a file name, is the part that follows the last `.'." (save-match-data (let ((file (file-name-sans-versions (file-name-nondirectory filename))) directory) (if (string-match "\\.[^.]*\\'" file) (if (setq directory (file-name-directory filename)) (expand-file-name (substring file 0 (match-beginning 0)) directory) (substring file 0 (match-beginning 0))) filename)))) ;;; @ Miscellanea. ;; Emacs 19.29 and later: (current-fill-column) (defun-maybe current-fill-column () "Return the fill-column to use for this line." fill-column) ;; Emacs 19.29 and later: (current-left-margin) (defun-maybe current-left-margin () "Return the left margin to use for this line." left-margin) ;;; @ XEmacs emulation. ;;; (defun-maybe find-face (face-or-name) "Retrieve the face of the given name. If FACE-OR-NAME is a face object, it is simply returned. Otherwise, FACE-OR-NAME should be a symbol. If there is no such face, nil is returned. Otherwise the associated face object is returned." (car (memq face-or-name (face-list)))) ;; Emacs 21.1 defines this as an alias for `line-beginning-position'. ;; Therefore, optional 2nd arg BUFFER is not portable. (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." (save-excursion (if buffer (set-buffer buffer)) (forward-line (1- (or n 1))) (point))) ;; Emacs 21.1 defines this as an alias for `line-end-position'. ;; Therefore, optional 2nd arg BUFFER is not portable. (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." (save-excursion (if buffer (set-buffer buffer)) (end-of-line (or n 1)) (point))) (defsubst-maybe define-obsolete-function-alias (oldfun newfun) "Define OLDFUN as an obsolete alias for function NEWFUN. This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN as obsolete." (defalias oldfun newfun) (make-obsolete oldfun newfun)) ;; XEmacs 21: (character-to-event CH &optional EVENT DEVICE) (defun-maybe character-to-event (ch) "Convert keystroke CH into an event structure, replete with bucky bits. Note that CH (the keystroke specifier) can be an integer, a character or a symbol such as 'clear." ch) ;; XEmacs 21: (event-to-character EVENT ;; &optional ALLOW-EXTRA-MODIFIERS ALLOW-META ALLOW-NON-ASCII) (defun-maybe-cond event-to-character (event) "Return the character approximation to the given event object. If the event isn't a keypress, this returns nil." ((and (fboundp 'read-event) (subrp (symbol-function 'read-event))) ;; Emacs 19 and later. (cond ((symbolp event) ;; mask is (BASE-TYPE MODIFIER-BITS) or nil. (let ((mask (get event 'event-symbol-element-mask))) (if mask (let ((base (get (car mask) 'ascii-character))) (if base (logior base (car (cdr mask)))))))) ((integerp event) event))) (t ;; v18. Is this correct? event)) ;; v18: no event; (read-char) ;; Emacs 19, 20.1 and 20.2: (read-event) ;; Emacs 20.3: (read-event &optional PROMPT SUPPRESS-INPUT-METHOD) ;; Emacs 20.4: (read-event &optional PROMPT INHERIT-INPUT-METHOD) ;; XEmacs: (next-event &optional EVENT PROMPT), ;; (next-command-event &optional EVENT PROMPT) (defun-maybe-cond next-command-event (&optional event prompt) "Read an event object from the input stream. If EVENT is non-nil, it should be an event object and will be filled in and returned; otherwise a new event object will be created and returned. If PROMPT is non-nil, it should be a string and will be displayed in the echo area while this function is waiting for an event." ((and (>= emacs-major-version 20) (>= emacs-minor-version 4)) ;; Emacs 20.4 and later. (read-event prompt)) ; should specify 2nd arg? ((and (= emacs-major-version 20) (= emacs-minor-version 3)) ;; Emacs 20.3. (read-event prompt)) ; should specify 2nd arg? ((and (fboundp 'read-event) (subrp (symbol-function 'read-event))) ;; Emacs 19, 20.1 and 20.2. (if prompt (message "%s" prompt)) (read-event)) (t (if prompt (message "%s" prompt)) (read-char))) ;;; @ MULE 2 emulation. ;;; (defun-maybe-cond cancel-undo-boundary () "Cancel undo boundary." ((boundp 'buffer-undo-list) ;; for Emacs 19 and later. (if (and (consp buffer-undo-list) (null (car buffer-undo-list))) (setq buffer-undo-list (cdr buffer-undo-list))))) ;;; @ End. ;;; ;;; poe.el ends here apel-5bc1050/poem-e20.el000066400000000000000000000037551174656234300146470ustar00rootroot00000000000000;;; poem-e20.el --- poem submodule for Emacs 20; -*-byte-compile-dynamic: t;-*- ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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)))) ;;; @ end ;;; (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 ) (require 'product) (product-provide (provide 'poem-e20) (require 'apel-ver)) ;;; poem-e20.el ends here apel-5bc1050/poem-e20_2.el000066400000000000000000000050061174656234300150570ustar00rootroot00000000000000;;; poem-e20_2.el --- poem implementation for Emacs 20.1 and 20.2 ;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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) ;;; @ end ;;; (require 'product) (product-provide (provide 'poem-e20_2) (require 'apel-ver)) ;;; poem-e20_2.el ends here apel-5bc1050/poem-e20_3.el000066400000000000000000000034201174656234300150560ustar00rootroot00000000000000;;; -*-byte-compile-dynamic: t;-*- ;;; poem-e20_3.el --- poem submodule for Emacs 20.3 ;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module requires Emacs 20.2.91 or later. ;;; Code: (require 'pym) ;;; @ 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)) (defalias-maybe 'characterp 'char-valid-p) ;;; @ 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 ;;; (require 'product) (product-provide (provide 'poem-e20_3) (require 'apel-ver)) ;;; poem-e20_3.el ends here apel-5bc1050/poem-ltn1.el000066400000000000000000000101211174656234300151200ustar00rootroot00000000000000;;; poem-ltn1.el --- poem implementation for Emacs 19 and XEmacs without MULE ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: ;;; @ buffer representation ;;; (eval-when-compile (require 'poe)) (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) ;;; @ character ;;; (defun char-charset (char) "Return the character set of char CHAR." (if (< char 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)) (if (> (length str) width) (substring str start-column width) str)) (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 ;;; (require 'product) (product-provide (provide 'poem-ltn1) (require 'apel-ver)) ;;; poem-ltn1.el ends here apel-5bc1050/poem-nemacs.el000066400000000000000000000130511174656234300155150ustar00rootroot00000000000000;;; poem-nemacs.el --- poem implementation for Nemacs ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, 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) ;;; @ 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. \[emu-nemacs.el]" (` (+ (, 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-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) ;;; @@ obsoleted aliases ;;; ;;; You should not use them. (defalias 'string-columns 'length) ;;; @ end ;;; (require 'product) (product-provide (provide 'poem-nemacs) (require 'apel-ver)) ;;; poem-nemacs.el ends here apel-5bc1050/poem-om.el000066400000000000000000000105551174656234300146700ustar00rootroot00000000000000;;; poem-om.el --- poem implementation for Mule 1.* and Mule 2.* ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Katsumi Yamaoka ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'poe) ;;; @ version specific features ;;; (if (= emacs-major-version 19) ;; Suggested by SASAKI Osamu ;; (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)) ;;; @ 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) ;; Imported from Mule-2.3 (defun-maybe 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 ;;; (require 'product) (product-provide (provide 'poem-om) (require 'apel-ver)) ;;; poem-om.el ends here apel-5bc1050/poem-xm.el000066400000000000000000000052731174656234300147020ustar00rootroot00000000000000;;; poem-xm.el --- poem module for XEmacs-mule; -*-byte-compile-dynamic: t;-*- ;; Copyright (C) 1998,1999,2002,2003,2005 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (eval-when-compile (require 'poe)) ;;; @ 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 (car (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)) (if (not (fboundp 'char-length)) (defalias 'char-length (lambda (char) "Return number of bytes a CHARACTER occupies in a string or buffer. It always returns 1 in XEmacs. It is for compatibility with MULE 2.3." 1))) (defalias-maybe 'char-valid-p 'characterp) ;;; @ string ;;; (defun-maybe string-to-int-list (str) (mapcar #'char-int str)) (defun-maybe string-to-char-list (str) (mapcar #'identity str)) (defalias 'looking-at-as-unibyte 'looking-at) ;;; @ end ;;; (require 'product) (product-provide (provide 'poem-xm) (require 'apel-ver)) ;;; poem-xm.el ends here apel-5bc1050/poem.el000066400000000000000000000054051174656234300142550ustar00rootroot00000000000000;;; poem.el --- Emulate latest MULE features; -*-byte-compile-dynamic: t;-*- ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'pces) (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 ;;; (defsubst-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) (defsubst-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) (defun-maybe charset-after (&optional pos) "Return charset of a character in current buffer at position POS. If POS is nil, it defaults to the current point. If POS is out of range, the value is nil. \[Emacs 20.3 emulating function]" (char-charset (char-after pos)) ) ;;; @ XEmacs-mule emulation ;;; (defalias-maybe 'char-int 'identity) (defalias-maybe 'int-char 'identity) (defalias-maybe 'characterp (cond ((fboundp 'char-valid-p) 'char-valid-p) (t 'integerp))) (defalias-maybe 'char-or-char-int-p (cond ((fboundp 'char-valid-p) 'char-valid-p) (t 'integerp))) (defun-maybe char-octet (ch &optional n) "Return the octet numbered N (should be 0 or 1) of char CH. N defaults to 0 if omitted. [XEmacs-mule emulating function]" (or (nth (if n (1+ n) 1) (split-char ch)) 0)) ;;; @ end ;;; (require 'product) (product-provide (provide 'poem) (require 'apel-ver)) ;;; poem.el ends here apel-5bc1050/product.el000066400000000000000000000366231174656234300150030ustar00rootroot00000000000000;;; product.el --- Functions for product version information. ;; Copyright (C) 1999,2000 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keiichi Suzuki ;; Keywords: compatibility, User-Agent ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module defines some utility functions for product information, ;; used for User-Agent header field. ;; ;; User-Agent header field first appeared in HTTP [RFC 1945, RFC 2616] ;; and adopted to News Article Format draft [USEFOR]. ;; ;; [RFC 1945] Hypertext Transfer Protocol -- HTTP/1.0. ;; T. Berners-Lee, R. Fielding & H. Frystyk. May 1996. ;; ;; [RFC 2616] Hypertext Transfer Protocol -- HTTP/1.1. ;; R. Fielding, J. Gettys, J. Mogul, H. Frystyk, L. Masinter, P. Leach, ;; T. Berners-Lee. June 1999. ;; ;; [USEFOR] News Article Format, . ;; USEFOR Working Group. March 1999. ;;; Code: (defvar product-obarray (make-vector 13 0)) (defvar product-ignore-checkers nil) (defun product-define (name &optional family version code-name) "Define a product as a set of NAME, FAMILY, VERSION, and CODE-NAME. NAME is a string. Optional 2nd argument FAMILY is a string of family product name. Optional 3rd argument VERSION is a list of numbers. Optional 4th argument CODE-NAME is a string." (and family (product-add-to-family family name)) (set (intern name product-obarray) (vector name family version code-name nil nil nil nil))) (defun product-name (product) "Return the name of PRODUCT, a string." (aref product 0)) (defun product-family (product) "Return the family name of PRODUCT, a string." (aref product 1)) (defun product-version (product) "Return the version of PRODUCT, a list of numbers." (aref product 2)) (defun product-code-name (product) "Return the code-name of PRODUCT, a string." (aref product 3)) (defun product-checkers (product) "Return the checkers of PRODUCT, a list of functions." (aref product 4)) (defun product-family-products (product) "Return the family products of PRODUCT, a list of strings." (aref product 5)) (defun product-features (product) "Return the features of PRODUCT, a list of feature." (aref product 6)) (defun product-version-string (product) "Return the version string of PRODUCT, a string." (aref product 7)) (defun product-set-name (product name) "Set name of PRODUCT to NAME." (aset product 0 name)) (defun product-set-family (product family) "Set family name of PRODUCT to FAMILY." (aset product 1 family)) (defun product-set-version (product version) "Set version of PRODUCT to VERSION." (aset product 2 version)) ;; Some people want to translate code-name. (defun product-set-code-name (product code-name) "Set code-name of PRODUCT to CODE-NAME." (aset product 3 code-name)) (defun product-set-checkers (product checkers) "Set checker functions of PRODUCT to CHECKERS." (aset product 4 checkers)) (defun product-set-family-products (product products) "Set family products of PRODUCT to PRODUCTS." (aset product 5 products)) (defun product-set-features (product features) "Set features of PRODUCT to FEATURES." (aset product 6 features)) (defun product-set-version-string (product version-string) "Set version string of PRODUCT to VERSION-STRING." (aset product 7 version-string)) (defun product-add-to-family (family product-name) "Add a product to a family. FAMILY is a product structure which returned by `product-define'. PRODUCT-NAME is a string of the product's name ." (let ((family-product (product-find-by-name family))) (if family-product (let ((dest (product-family-products family-product))) (or (member product-name dest) (product-set-family-products family-product (cons product-name dest)))) (error "Family product `%s' is not defined" family)))) (defun product-remove-from-family (family product-name) "Remove a product from a family. FAMILY is a product string which returned by `product-define'. PRODUCT-NAME is a string of the product's name." (let ((family-product (product-find-by-name family))) (if family-product (product-set-family-products family-product (delete product-name (product-family-products family-product))) (error "Family product `%s' is not defined" family)))) (defun product-add-checkers (product &rest checkers) "Add checker function(s) to a product. PRODUCT is a product structure which returned by `product-define'. The rest arguments CHECKERS should be functions. These functions are registered to the product's checkers list, and will be called by `product-run-checkers'. If a checker is `ignore' will be ignored all checkers after this." (setq product (product-find product)) (or product-ignore-checkers (let ((dest (product-checkers product)) checker) (while checkers (setq checker (car checkers) checkers (cdr checkers)) (or (memq checker dest) (setq dest (cons checker dest)))) (product-set-checkers product dest)))) (defun product-remove-checkers (product &rest checkers) "Remove checker function(s) from a product. PRODUCT is a product structure which returned by `product-define'. The rest arguments CHECKERS should be functions. These functions removed from the product's checkers list." (setq product (product-find product)) (let ((dest (product-checkers product))) (while checkers (setq checkers (cdr checkers) dest (delq (car checkers) dest))) (product-set-checkers product dest))) (defun product-add-feature (product feature) "Add a feature to the features list of a product. PRODUCT is a product structure which returned by `product-define'. FEATURE is a feature in the PRODUCT's." (setq product (product-find product)) (let ((dest (product-features product))) (or (memq feature dest) (product-set-features product (cons feature dest))))) (defun product-remove-feature (product feature) "Remove a feature from the features list of a product. PRODUCT is a product structure which returned by `product-define'. FEATURE is a feature which registered in the products list of PRODUCT." (setq product (product-find product)) (product-set-features product (delq feature (product-features product)))) (defun product-run-checkers (product version &optional force) "Run checker functions of product. PRODUCT is a product structure which returned by `product-define'. VERSION is target version. If optional 3rd argument FORCE is non-nil then do not ignore all checkers." (let ((checkers (product-checkers product))) (if (or force (not (memq 'ignore checkers))) (let ((version (or version (product-version product)))) (while checkers (funcall (car checkers) version version) (setq checkers (cdr checkers))))))) (defun product-find-by-name (name) "Find product by name and return a product structure. NAME is a string of the product's name." (symbol-value (intern-soft name product-obarray))) (defun product-find-by-feature (feature) "Get a product structure of a feature's product. FEATURE is a symbol of the feature." (get feature 'product)) (defun product-find (product) "Find product information. If PRODUCT is a product structure, then return PRODUCT itself. If PRODUCT is a string, then find product by name and return a product structure. If PRODUCT is symbol of feature, then return the feature's product." (cond ((and (symbolp product) (featurep product)) (product-find-by-feature product)) ((stringp product) (product-find-by-name product)) ((vectorp product) product) (t (error "Invalid product %s" product)))) (put 'product-provide 'lisp-indent-function 1) (defmacro product-provide (feature-def product-def) "Declare a feature as a part of product. FEATURE-DEF is a definition of the feature. PRODUCT-DEF is a definition of the product." (let* ((feature feature-def) (product (product-find (eval product-def))) (product-name (product-name product)) (product-family (product-family product)) (product-version (product-version product)) (product-code-name (product-code-name product)) (product-version-string (product-version-string product))) (` (progn (, product-def) (put (, feature) 'product (let ((product (product-find-by-name (, product-name)))) (product-run-checkers product '(, product-version)) (and (, product-family) (product-add-to-family (, product-family) (, product-name))) (product-add-feature product (, feature)) (if (equal '(, product-version) (product-version product)) product (vector (, product-name) (, product-family) '(, product-version) (, product-code-name) nil nil nil (, product-version-string))))) (, feature-def))))) (defun product-version-as-string (product) "Return version number of product as a string. PRODUCT is a product structure which returned by `product-define'. If optional argument UPDATE is non-nil, then regenerate `product-version-string' from `product-version'." (setq product (product-find product)) (or (product-version-string product) (and (product-version product) (product-set-version-string product (mapconcat (function int-to-string) (product-version product) "."))))) (defun product-string-1 (product &optional verbose) "Return information of product as a string of \"NAME/VERSION\". PRODUCT is a product structure which returned by `product-define'. If optional argument VERBOSE is non-nil, then return string of \"NAME/VERSION (CODE-NAME)\"." (setq product (product-find product)) (concat (product-name product) (let ((version-string (product-version-as-string product))) (and version-string (concat "/" version-string))) (and verbose (product-code-name product) (concat " (" (product-code-name product) ")")))) (defun product-for-each (product all function &rest args) "Apply a function to a product and the product's family with args. PRODUCT is a product structure which returned by `product-define'. If ALL is nil, apply function to only products which provided feature. FUNCTION is a function. The function called with following arguments. The 1st argument is a product structure. The rest arguments are ARGS." (setq product (product-find product)) (let ((family (product-family-products product))) (and (or all (product-features product)) (apply function product args)) (while family (apply 'product-for-each (car family) all function args) (setq family (cdr family))))) (defun product-string (product) "Return information of product as a string of \"NAME/VERSION\". PRODUCT is a product structure which returned by `product-define'." (let (dest) (product-for-each product nil (function (lambda (product) (let ((str (product-string-1 product nil))) (if str (setq dest (if dest (concat dest " " str) str))))))) dest)) (defun product-string-verbose (product) "Return information of product as a string of \"NAME/VERSION (CODE-NAME)\". PRODUCT is a product structure which returned by `product-define'." (let (dest) (product-for-each product nil (function (lambda (product) (let ((str (product-string-1 product t))) (if str (setq dest (if dest (concat dest " " str) str))))))) dest)) (defun product-version-compare (v1 v2) "Compare two versions. Return an integer greater than, equal to, or less than 0, according as the version V1 is greater than, equal to, or less than the version V2. Both V1 and V2 are a list of integer(s) respectively." (while (and v1 v2 (= (car v1) (car v2))) (setq v1 (cdr v1) v2 (cdr v2))) (if v1 (if v2 (- (car v1) (car v2)) 1) (if v2 -1 0))) (defun product-version>= (product require-version) "Compare product version with required version. PRODUCT is a product structure which returned by `product-define'. REQUIRE-VERSION is a list of integer." (>= (product-version-compare (product-version (product-find product)) require-version) 0)) (defun product-list-products () "List all products information." (let (dest) (mapatoms (function (lambda (sym) (setq dest (cons (symbol-value sym) dest)))) product-obarray) dest)) (defun product-parse-version-string (verstr) "Parse version string \".*v1.v2... (CODE-NAME)\". Return list of version, code-name, and version-string. VERSTR is a string." (let (version version-string code-name) (and (string-match "\\(\\([0-9.]+\\)[^ ]*\\)[^(]*\\((\\(.+\\))\\)?" verstr) (let ((temp (substring verstr (match-beginning 2) (match-end 2)))) (setq version-string (substring verstr (match-beginning 1) (match-end 1)) code-name (and (match-beginning 4) (substring verstr (match-beginning 4) (match-end 4)))) (while (string-match "^\\([0-9]+\\)\\.?" temp) (setq version (cons (string-to-number (substring temp (match-beginning 1) (match-end 1))) version) temp (substring temp (match-end 0)))))) (list (nreverse version) code-name version-string))) ;;; @ End. ;;; (provide 'product) ; beware of circular dependency. (require 'apel-ver) ; these two files depend on each other. (product-provide 'product 'apel-ver) ;;; @ Define emacs versions. ;;; (require 'pym) (defconst-maybe emacs-major-version (progn (string-match "^[0-9]+" emacs-version) (string-to-int (substring emacs-version (match-beginning 0)(match-end 0)))) "Major version number of this version of Emacs.") (defconst-maybe emacs-minor-version (progn (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) (string-to-int (substring emacs-version (match-beginning 1)(match-end 1)))) "Minor version number of this version of Emacs.") ;;(or (product-find "emacs") ;; (progn ;; (product-define "emacs") ;; (cond ;; ((featurep 'meadow) ;; (let* ((info (product-parse-version-string (Meadow-version))) ;; (version (nth 0 info)) ;; (code-name (nth 1 info)) ;; (version-string (nth 2 info))) ;; (product-set-version-string ;; (product-define "Meadow" "emacs" version code-name) ;; version-string) ;; (product-provide 'Meadow "Meadow")) ;; (and (featurep 'mule) ;; (let* ((info (product-parse-version-string mule-version)) ;; (version (nth 0 info)) ;; (code-name (nth 1 info)) ;; (version-string (nth 2 info))) ;; (product-set-version-string ;; (product-define "MULE" "Meadow" version code-name) ;; version-string) ;; (product-provide 'mule "MULE"))) ;; (let* ((info (product-parse-version-string emacs-version)) ;; (version (nth 0 info)) ;; (code-name (nth 1 info)) ;; (version-string (nth 2 info))) ;; (product-set-version-string ;; (product-define "Emacs" "Meadow" version code-name) ;; version-string) ;; (product-provide 'emacs "Emacs"))) ;; ))) ;;; product.el ends here apel-5bc1050/pym.el000066400000000000000000000246641174656234300141320ustar00rootroot00000000000000;;; pym.el --- Macros for Your Poe. ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Keywords: byte-compile, evaluation, edebug, internal ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module provides `def*-maybe' macros for conditional definition. ;; ;; Many APEL modules use these macros to provide the emulating version ;; of the Emacs builtins (both C primitives and lisp subroutines) for ;; backward compatibility. While compilation time, if `def*-maybe' ;; find that functions/variables being defined is already provided by ;; Emacs used for compilation, it does not leave the definitions in ;; compiled code and resulting .elc files will be highly specialized ;; for your environment. Lisp programmers should be aware that these ;; macros will never provide functions or variables at run-time if they ;; are defined for some reason (or by accident) at compilation time. ;; For `find-function' lovers, the following definitions may work with ;; `def*-maybe'. ;; ;; (setq find-function-regexp ;; "^\\s-*(def[^cgvW]\\(\\w\\|-\\)+\\*?\\s-+'?%s\\(\\s-\\|$\\)") ;; (setq find-variable-regexp ;; "^\\s-*(def[^umaW]\\(\\w\\|-\\)+\\*?\\s-+%s\\(\\s-\\|$\\)") ;; ;; I'm too lazy to write better regexps, sorry. -- shuhei ;;; Code: ;; for `load-history'. (or (boundp 'current-load-list) (setq current-load-list nil)) (require 'static) ;;; Conditional define. (put 'defun-maybe 'lisp-indent-function 'defun) (defmacro defun-maybe (name &rest everything-else) "Define NAME as a function if NAME is not defined. See also the function `defun'." (or (and (fboundp name) (not (get name 'defun-maybe))) (` (or (fboundp (quote (, name))) (prog1 (defun (, name) (,@ everything-else)) ;; This `defun' will be compiled to `fset', ;; which does not update `load-history'. ;; We must update `current-load-list' explicitly. (setq current-load-list (cons (quote (, name)) current-load-list)) (put (quote (, name)) 'defun-maybe t)))))) (put 'defmacro-maybe 'lisp-indent-function 'defun) (defmacro defmacro-maybe (name &rest everything-else) "Define NAME as a macro if NAME is not defined. See also the function `defmacro'." (or (and (fboundp name) (not (get name 'defmacro-maybe))) (` (or (fboundp (quote (, name))) (prog1 (defmacro (, name) (,@ everything-else)) ;; This `defmacro' will be compiled to `fset', ;; which does not update `load-history'. ;; We must update `current-load-list' explicitly. (setq current-load-list (cons (quote (, name)) current-load-list)) (put (quote (, name)) 'defmacro-maybe t)))))) (put 'defsubst-maybe 'lisp-indent-function 'defun) (defmacro defsubst-maybe (name &rest everything-else) "Define NAME as an inline function if NAME is not defined. See also the macro `defsubst'." (or (and (fboundp name) (not (get name 'defsubst-maybe))) (` (or (fboundp (quote (, name))) (prog1 (defsubst (, name) (,@ everything-else)) ;; This `defsubst' will be compiled to `fset', ;; which does not update `load-history'. ;; We must update `current-load-list' explicitly. (setq current-load-list (cons (quote (, name)) current-load-list)) (put (quote (, name)) 'defsubst-maybe t)))))) (defmacro defalias-maybe (symbol definition) "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined. See also the function `defalias'." (setq symbol (eval symbol)) (or (and (fboundp symbol) (not (get symbol 'defalias-maybe))) (` (or (fboundp (quote (, symbol))) (prog1 (defalias (quote (, symbol)) (, definition)) ;; `defalias' updates `load-history' internally. (put (quote (, symbol)) 'defalias-maybe t)))))) (defmacro defvar-maybe (name &rest everything-else) "Define NAME as a variable if NAME is not defined. See also the function `defvar'." (or (and (boundp name) (not (get name 'defvar-maybe))) (` (or (boundp (quote (, name))) (prog1 (defvar (, name) (,@ everything-else)) ;; byte-compiler will generate code to update ;; `load-history'. (put (quote (, name)) 'defvar-maybe t)))))) (defmacro defconst-maybe (name &rest everything-else) "Define NAME as a constant variable if NAME is not defined. See also the function `defconst'." (or (and (boundp name) (not (get name 'defconst-maybe))) (` (or (boundp (quote (, name))) (prog1 (defconst (, name) (,@ everything-else)) ;; byte-compiler will generate code to update ;; `load-history'. (put (quote (, name)) 'defconst-maybe t)))))) (defmacro defun-maybe-cond (name args &optional doc &rest clauses) "Define NAME as a function if NAME is not defined. CLAUSES are like those of `cond' expression, but each condition is evaluated at compile-time and, if the value is non-nil, the body of the clause is used for function definition of NAME. See also the function `defun'." (or (stringp doc) (setq clauses (cons doc clauses) doc nil)) (or (and (fboundp name) (not (get name 'defun-maybe))) (` (or (fboundp (quote (, name))) (prog1 (static-cond (,@ (mapcar (function (lambda (case) (list (car case) (if doc (` (defun (, name) (, args) (, doc) (,@ (cdr case)))) (` (defun (, name) (, args) (,@ (cdr case)))))))) clauses))) ;; This `defun' will be compiled to `fset', ;; which does not update `load-history'. ;; We must update `current-load-list' explicitly. (setq current-load-list (cons (quote (, name)) current-load-list)) (put (quote (, name)) 'defun-maybe t)))))) (defmacro defmacro-maybe-cond (name args &optional doc &rest clauses) "Define NAME as a macro if NAME is not defined. CLAUSES are like those of `cond' expression, but each condition is evaluated at compile-time and, if the value is non-nil, the body of the clause is used for macro definition of NAME. See also the function `defmacro'." (or (stringp doc) (setq clauses (cons doc clauses) doc nil)) (or (and (fboundp name) (not (get name 'defmacro-maybe))) (` (or (fboundp (quote (, name))) (prog1 (static-cond (,@ (mapcar (function (lambda (case) (list (car case) (if doc (` (defmacro (, name) (, args) (, doc) (,@ (cdr case)))) (` (defmacro (, name) (, args) (,@ (cdr case)))))))) clauses))) ;; This `defmacro' will be compiled to `fset', ;; which does not update `load-history'. ;; We must update `current-load-list' explicitly. (setq current-load-list (cons (quote (, name)) current-load-list)) (put (quote (, name)) 'defmacro-maybe t)))))) (defmacro defsubst-maybe-cond (name args &optional doc &rest clauses) "Define NAME as an inline function if NAME is not defined. CLAUSES are like those of `cond' expression, but each condition is evaluated at compile-time and, if the value is non-nil, the body of the clause is used for function definition of NAME. See also the macro `defsubst'." (or (stringp doc) (setq clauses (cons doc clauses) doc nil)) (or (and (fboundp name) (not (get name 'defsubst-maybe))) (` (or (fboundp (quote (, name))) (prog1 (static-cond (,@ (mapcar (function (lambda (case) (list (car case) (if doc (` (defsubst (, name) (, args) (, doc) (,@ (cdr case)))) (` (defsubst (, name) (, args) (,@ (cdr case)))))))) clauses))) ;; This `defsubst' will be compiled to `fset', ;; which does not update `load-history'. ;; We must update `current-load-list' explicitly. (setq current-load-list (cons (quote (, name)) current-load-list)) (put (quote (, name)) 'defsubst-maybe t)))))) ;;; Edebug spec. ;; `def-edebug-spec' is an autoloaded macro in v19 and later. ;; (Note that recent XEmacs provides "edebug" as a separate package.) (defmacro-maybe def-edebug-spec (symbol spec) "Set the edebug-form-spec property of SYMBOL according to SPEC. Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol \(naming a function\), or a list." (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec))))) ;; edebug-spec for `def*-maybe' macros. (def-edebug-spec defun-maybe defun) (def-edebug-spec defmacro-maybe defmacro) (def-edebug-spec defsubst-maybe defun) (def-edebug-spec defun-maybe-cond (&define name lambda-list [&optional stringp] [&rest ([¬ eval] [&rest sexp])] [&optional (eval [&optional ("interactive" interactive)] def-body)] &rest (&rest sexp))) (def-edebug-spec defmacro-maybe-cond (&define name lambda-list [&rest ([¬ eval] [&rest sexp])] [&optional (eval def-body)] &rest (&rest sexp))) (def-edebug-spec defsubst-maybe-cond (&define name lambda-list [&optional stringp] [&rest ([¬ eval] [&rest sexp])] [&optional (eval [&optional ("interactive" interactive)] def-body)] &rest (&rest sexp))) ;; edebug-spec for `static-*' macros are also defined here. (def-edebug-spec static-if t) (def-edebug-spec static-when when) (def-edebug-spec static-unless unless) (def-edebug-spec static-condition-case condition-case) (def-edebug-spec static-defconst defconst) (def-edebug-spec static-cond cond) ;;; for backward compatibility. (defun subr-fboundp (symbol) "Return t if SYMBOL's function definition is a built-in function." (and (fboundp symbol) (subrp (symbol-function symbol)))) ;; (make-obsolete 'subr-fboundp "don't use it.") ;;; End. (require 'product) (product-provide (provide 'pym) (require 'apel-ver)) ;;; pym.el ends here apel-5bc1050/richtext.el000066400000000000000000000131461174656234300151500ustar00rootroot00000000000000;;; richtext.el -- read and save files in text/richtext format ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Created: 1995/7/15 ;; Version: $Id: richtext.el,v 3.6 1997/06/28 17:58:34 morioka Exp $ ;; Keywords: wp, faces, MIME, multimedia ;; This file is not part of GNU Emacs yet. ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'enriched) ;;; @ variables ;;; (defconst richtext-initial-annotation (lambda () (format "Content-Type: text/richtext\nText-Width: %d\n\n" (enriched-text-width))) "What to insert at the start of a text/richtext file. If this is a string, it is inserted. If it is a list, it should be a lambda expression, which is evaluated to get the string to insert.") (defconst richtext-annotation-regexp "[ \t\n]*\\(<\\(/\\)?\\([-A-za-z0-9]+\\)>\\)[ \t\n]*" "Regular expression matching richtext annotations.") (defconst richtext-translations '((face (bold-italic "bold" "italic") (bold "bold") (italic "italic") (underline "underline") (fixed "fixed") (excerpt "excerpt") (default ) (nil enriched-encode-other-face)) (invisible (t "comment")) (left-margin (4 "indent")) (right-margin (4 "indentright")) (justification (right "flushright") (left "flushleft") (full "flushboth") (center "center")) ;; The following are not part of the standard: (FUNCTION (enriched-decode-foreground "x-color") (enriched-decode-background "x-bg-color")) (read-only (t "x-read-only")) (unknown (nil format-annotate-value)) ; (font-size (2 "bigger") ; unimplemented ; (-2 "smaller")) ) "List of definitions of text/richtext annotations. See `format-annotate-region' and `format-deannotate-region' for the definition of this structure.") ;;; @ encoder ;;; ;;;###autoload (defun richtext-encode (from to) (if enriched-verbose (message "Richtext: encoding document...")) (save-restriction (narrow-to-region from to) (delete-to-left-margin) (unjustify-region) (goto-char from) (format-replace-strings '(("<" . ""))) (format-insert-annotations (format-annotate-region from (point-max) richtext-translations 'enriched-make-annotation enriched-ignore)) (goto-char from) (insert (if (stringp enriched-initial-annotation) richtext-initial-annotation (funcall richtext-initial-annotation))) (enriched-map-property-regions 'hard (lambda (v b e) (goto-char b) (if (eolp) (while (search-forward "\n" nil t) (replace-match "\n") ))) (point) nil) (if enriched-verbose (message nil)) ;; Return new end. (point-max))) ;;; @ decoder ;;; (defun richtext-next-annotation () "Find and return next text/richtext annotation. Return value is \(begin end name positive-p), or nil if none was found." (catch 'tag (while (re-search-forward richtext-annotation-regexp nil t) (let* ((beg0 (match-beginning 0)) (end0 (match-end 0)) (beg (match-beginning 1)) (end (match-end 1)) (name (downcase (buffer-substring (match-beginning 3) (match-end 3)))) (pos (not (match-beginning 2))) ) (cond ((equal name "lt") (delete-region beg end) (goto-char beg) (insert "<") ) ((equal name "comment") (if pos (throw 'tag (list beg0 end name pos)) (throw 'tag (list beg end0 name pos)) ) ) (t (throw 'tag (list beg end name pos)) )) )))) ;;;###autoload (defun richtext-decode (from to) (if enriched-verbose (message "Richtext: decoding document...")) (save-excursion (save-restriction (narrow-to-region from to) (goto-char from) (let ((file-width (enriched-get-file-width)) (use-hard-newlines t)) (enriched-remove-header) (goto-char from) (while (re-search-forward "\n\n+" nil t) (replace-match "\n") ) ;; Deal with newlines (goto-char from) (while (re-search-forward "[ \t\n]*[ \t\n]*" nil t) (replace-match "\n") (put-text-property (match-beginning 0) (point) 'hard t) (put-text-property (match-beginning 0) (point) 'front-sticky nil) ) ;; Translate annotations (format-deannotate-region from (point-max) richtext-translations 'richtext-next-annotation) ;; Fill paragraphs (if (and file-width ; possible reasons not to fill: (= file-width (enriched-text-width))) ; correct wd. ;; Minimally, we have to insert indentation and justification. (enriched-insert-indentation) (if enriched-verbose (message "Filling paragraphs...")) (fill-region (point-min) (point-max)))) (if enriched-verbose (message nil)) (point-max)))) ;;; @ end ;;; (require 'product) (product-provide (provide 'richtext) (require 'apel-ver)) ;;; richtext.el ends here apel-5bc1050/static.el000066400000000000000000000055671174656234300146150ustar00rootroot00000000000000;;; static.el --- tools for static evaluation. ;; Copyright (C) 1999 Tanaka Akira ;; Author: Tanaka Akira ;; Keywords: byte compile, evaluation ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (put 'static-if 'lisp-indent-function 2) (defmacro static-if (cond then &rest else) "Like `if', but evaluate COND at compile time." (if (eval cond) then (` (progn (,@ else))))) (put 'static-when 'lisp-indent-function 1) (defmacro static-when (cond &rest body) "Like `when', but evaluate COND at compile time." (if (eval cond) (` (progn (,@ body))))) (put 'static-unless 'lisp-indent-function 1) (defmacro static-unless (cond &rest body) "Like `unless', but evaluate COND at compile time." (if (eval cond) nil (` (progn (,@ body))))) (put 'static-condition-case 'lisp-indent-function 2) (defmacro static-condition-case (var bodyform &rest handlers) "Like `condition-case', but evaluate BODYFORM at compile time." (eval (` (condition-case (, var) (list (quote quote) (, bodyform)) (,@ (mapcar (if var (function (lambda (h) (` ((, (car h)) (list (quote funcall) (function (lambda ((, var)) (,@ (cdr h)))) (list (quote quote) (, var))))))) (function (lambda (h) (` ((, (car h)) (quote (progn (,@ (cdr h))))))))) handlers)))))) (put 'static-defconst 'lisp-indent-function 'defun) (defmacro static-defconst (symbol initvalue &optional docstring) "Like `defconst', but evaluate INITVALUE at compile time. The variable SYMBOL can be referred at both compile time and run time." (let ((value (eval initvalue))) (eval (` (defconst (, symbol) (quote (, value)) (, docstring)))) (` (defconst (, symbol) (quote (, value)) (, docstring))))) (defmacro static-cond (&rest clauses) "Like `cond', but evaluate CONDITION part of each clause at compile time." (while (and clauses (not (eval (car (car clauses))))) (setq clauses (cdr clauses))) (if clauses (cons 'progn (cdr (car clauses))))) ;;; @ end ;;; (require 'product) (product-provide (provide 'static) (require 'apel-ver)) ;;; static.el ends here apel-5bc1050/timezone.el000066400000000000000000000446451174656234300151600ustar00rootroot00000000000000;;; timezone.el --- time zone package for GNU Emacs ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. ;; Author: Masanobu Umeda ;; Maintainer: umerin@mse.kyutech.ac.jp ;; Keywords: news ;; This file 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 file 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, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; Modified 1 February 1994 by Kyle Jones to fix broken ;; timezone-floor function. ;; Modified 25 January 1994 by Kyle Jones so that it will ;; work under version 18 of Emacs. Provided timezone-floor ;; and timezone-abs functions. ;; Modified 4 October 1999 by Yuuichi Teranishi so that it will ;; work with old GNUS 3.14.4 under version 18 of Emacs. ;;; Code: (defvar timezone-world-timezones '(("PST" . -800) ("PDT" . -700) ("MST" . -700) ("MDT" . -600) ("CST" . -600) ("CDT" . -500) ("EST" . -500) ("EDT" . -400) ("AST" . -400) ;by ("NST" . -330) ;by ("UT" . +000) ("GMT" . +000) ("BST" . +100) ("MET" . +100) ("EET" . +200) ("JST" . +900) ("GMT+1" . +100) ("GMT+2" . +200) ("GMT+3" . +300) ("GMT+4" . +400) ("GMT+5" . +500) ("GMT+6" . +600) ("GMT+7" . +700) ("GMT+8" . +800) ("GMT+9" . +900) ("GMT+10" . +1000) ("GMT+11" . +1100) ("GMT+12" . +1200) ("GMT+13" . +1300) ("GMT-1" . -100) ("GMT-2" . -200) ("GMT-3" . -300) ("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600) ("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900) ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200)) "*Time differentials of timezone from GMT in +-HHMM form. This list is obsolescent, and is present only for backwards compatibility, because time zone names are ambiguous in practice. Use `current-time-zone' instead.") (defvar timezone-months-assoc '(("JAN" . 1)("FEB" . 2)("MAR" . 3) ("APR" . 4)("MAY" . 5)("JUN" . 6) ("JUL" . 7)("AUG" . 8)("SEP" . 9) ("OCT" . 10)("NOV" . 11)("DEC" . 12)) "Alist of first three letters of a month and its numerical representation.") (defun timezone-make-date-arpa-standard (date &optional local timezone) "Convert DATE to an arpanet standard date. Optional 2nd argument LOCAL specifies the default local timezone of the DATE; if nil, GMT is assumed. Optional 3rd argument TIMEZONE specifies a time zone to be represented in; if nil, the local time zone is assumed." (let ((new (timezone-fix-time date local timezone))) (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2) (timezone-make-time-string (aref new 3) (aref new 4) (aref new 5)) (aref new 6)) )) (defun timezone-make-date-sortable (date &optional local timezone) "Convert DATE to a sortable date string. Optional 2nd argument LOCAL specifies the default local timezone of the DATE; if nil, GMT is assumed. Optional 3rd argument TIMEZONE specifies a timezone to be represented in; if nil, the local time zone is assumed." (let ((new (timezone-fix-time date local timezone))) (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2) (timezone-make-time-string (aref new 3) (aref new 4) (aref new 5))) )) ;; ;; Parsers and Constructors of Date and Time ;; (defun timezone-make-arpa-date (year month day time &optional timezone) "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. Optional argument TIMEZONE specifies a time zone." (let ((zone (if (listp timezone) (let* ((m (timezone-zone-to-minute timezone)) (absm (if (< m 0) (- m) m))) (format "%c%02d%02d" (if (< m 0) ?- ?+) (/ absm 60) (% absm 60))) timezone))) (format "%02d %s %04d %s %s" day (capitalize (car (rassq month timezone-months-assoc))) year time zone))) (defun timezone-make-sortable-date (year month day time) "Make sortable date string from YEAR, MONTH, DAY, and TIME." (format "%4d%02d%02d%s" year month day time)) (defun timezone-make-time-string (hour minute second) "Make time string from HOUR, MINUTE, and SECOND." (format "%02d:%02d:%02d" hour minute second)) (defun timezone-parse-date (date) "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE]. 19 is prepended to year if necessary. Timezone may be nil if nothing. Understands the following styles: (1) 14 Apr 89 03:20[:12] [GMT] (2) Fri, 17 Mar 89 4:01[:33] [GMT] (3) Mon Jan 16 16:12[:37] [GMT] 1989 (4) 6 May 1992 1641-JST (Wednesday) (5) 22-AUG-1993 10:59:12.82 (6) Thu, 11 Apr 16:17:12 91 [MET] (7) Mon, 6 Jul 16:47:20 T 1992 [MET] (8) 1996-06-24 21:13:12 [GMT] (9) 1996-06-24 21:13-ZONE" ;; Get rid of any text properties. (and (stringp date) (or (text-properties-at 0 date) (next-property-change 0 date)) (setq date (copy-sequence date)) (set-text-properties 0 (length date) nil date)) (let ((date (or date "")) (year nil) (month nil) (day nil) (time nil) (zone nil)) ;This may be nil. (cond ((string-match "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) ;; Styles: (1) and (2) with timezone and buggy timezone ;; This is most common in mail and news, ;; so it is worth trying first. (setq year 3 month 2 day 1 time 4 zone 5)) ((string-match "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date) ;; Styles: (1) and (2) without timezone (setq year 3 month 2 day 1 time 4 zone nil)) ((string-match "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date) ;; Styles: (6) and (7) without timezone (setq year 6 month 3 day 2 time 4 zone nil)) ((string-match "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) ;; Styles: (6) and (7) with timezone and buggy timezone (setq year 6 month 3 day 2 time 4 zone 7)) ((string-match "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date) ;; Styles: (3) without timezone (setq year 4 month 1 day 2 time 3 zone nil)) ((string-match "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date) ;; Styles: (3) with timezone (setq year 5 month 1 day 2 time 3 zone 4)) ((string-match "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) ;; Styles: (4) with timezone (setq year 3 month 2 day 1 time 4 zone 5)) ((string-match "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?[ \t]+\\([-+a-zA-Z0-9]+\\)" date) ;; Styles: (5) with timezone. (setq year 3 month 2 day 1 time 4 zone 6)) ((string-match "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)?" date) ;; Styles: (5) without timezone. (setq year 3 month 2 day 1 time 4 zone nil)) ((string-match "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) ;; Styles: (8) with timezone. (setq year 1 month 2 day 3 time 4 zone 5)) ((string-match "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+\\)[ \t]*\\([-+a-zA-Z0-9:]+\\)" date) ;; Styles: (8) with timezone with a colon in it. (setq year 1 month 2 day 3 time 4 zone 5)) ((string-match "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)" date) ;; Styles: (8) without timezone. (setq year 1 month 2 day 3 time 4 zone nil)) ) (when year (setq year (match-string year date)) ;; Guess ambiguous years. Assume years < 69 don't predate the ;; Unix Epoch, so are 2000+. Three-digit years are assumed to ;; be relative to 1900. (if (< (length year) 4) (let ((y (string-to-int year))) (if (< y 69) (setq y (+ y 100))) (setq year (int-to-string (+ 1900 y))))) (setq month (if (= (aref date (+ (match-beginning month) 2)) ?-) ;; Handle numeric months, spanning exactly two digits. (substring date (match-beginning month) (+ (match-beginning month) 2)) (let* ((string (substring date (match-beginning month) (+ (match-beginning month) 3))) (monthnum (cdr (assoc (upcase string) timezone-months-assoc)))) (if monthnum (int-to-string monthnum))))) (setq day (match-string day date)) (setq time (match-string time date))) (if zone (setq zone (match-string zone date))) ;; Return a vector. (if (and year month) (vector year month day time zone) (vector "0" "0" "0" "0" nil)))) (defun timezone-parse-time (time) "Parse TIME (HH:MM:SS) and return a vector [hour minute second]. Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." (let ((time (or time "")) (hour nil) (minute nil) (second nil)) (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time) ;; HH:MM:SS (setq hour 1 minute 2 second 3)) ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time) ;; HH:MM (setq hour 1 minute 2 second nil)) ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) ;; HHMMSS (setq hour 1 minute 2 second 3)) ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) ;; HHMM (setq hour 1 minute 2 second nil)) ) ;; Return [hour minute second] (vector (if hour (substring time (match-beginning hour) (match-end hour)) "0") (if minute (substring time (match-beginning minute) (match-end minute)) "0") (if second (substring time (match-beginning second) (match-end second)) "0")) )) ;; Miscellaneous (defun timezone-zone-to-minute (timezone) "Translate TIMEZONE to an integer minute offset from GMT. TIMEZONE can be a cons cell containing the output of `current-time-zone', or an integer of the form +-HHMM, or a time zone name." (cond ((consp timezone) (/ (car timezone) 60)) (timezone (progn (setq timezone (or (and (stringp timezone) (cdr (assoc (upcase timezone) timezone-world-timezones))) ;; +900 timezone)) (if (stringp timezone) (setq timezone (string-to-int timezone))) ;; Taking account of minute in timezone. ;; HHMM -> MM (let* ((abszone (abs timezone)) (minutes (+ (* 60 (/ abszone 100)) (% abszone 100)))) (if (< timezone 0) (- minutes) minutes)))) (t 0))) (defun timezone-floor (arg &optional divisor) "Return the largest integer no grater than ARG. With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR." (if (null divisor) (setq divisor 1)) (if (< arg 0) (- (/ (- divisor 1 arg) divisor)) (/ arg divisor))) (defun timezone-time-from-absolute (date seconds) "Compute the UTC time equivalent to DATE at time SECONDS after midnight. Return a list suitable as an argument to `current-time-zone', or nil if the date cannot be thus represented. DATE is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (let* ((current-time-origin 719163) ;; (timezone-absolute-from-gregorian 1 1 1970) (days (- date current-time-origin)) (days-1 (/ days 65536)) (days-2 (% (/ days 256) 256)) (days-3 (% days 256)) ;; (seconds-per-day (float 86400)) (seconds-per-day-1 1) (seconds-per-day-2 81) (seconds-per-day-3 128) ;; (seconds (+ seconds (* days seconds-per-day))) ;; (current-time-arithmetic-base (float 65536)) ;; (hi (timezone-floor (/ seconds current-time-arithmetic-base))) ;; (hibase (* hi current-time-arithmetic-base)) ;; (lo (timezone-floor (- seconds hibase))) (seconds-1 (/ seconds 65536)) (seconds-2 (% (/ seconds 256) 256)) (seconds-3 (% seconds 256)) hi lo r seconds-per-day*days-1 seconds-per-day*days-2 seconds-per-day*days-3) (setq r (* days-3 seconds-per-day-3) seconds-per-day*days-3 (% r 256)) (setq r (+ (/ r 256) (* days-2 seconds-per-day-3) (* days-3 seconds-per-day-2)) seconds-per-day*days-2 (% r 256)) (setq seconds-per-day*days-1 (+ (/ r 256) (* days-1 seconds-per-day-3) (* (/ days 256) seconds-per-day-2) (* days seconds-per-day-1))) (setq r (+ seconds-2 seconds-per-day*days-2) seconds-2 (% r 256) seconds-1 (+ seconds-1 (/ r 256))) (setq lo (+ (* seconds-2 256) seconds-3 seconds-per-day*days-3)) (setq hi (+ seconds-1 seconds-per-day*days-1)) ;; (and (< (abs (- seconds (+ hibase lo))) 2) ; Check for integer overflow. ;; (cons hi lo)) (cons hi lo) )) (defun timezone-time-zone-from-absolute (date seconds) "Compute the local time zone for DATE at time SECONDS after midnight. Return a list in the same format as current-time-zone's result, or nil if the local time zone could not be computed. DATE is the number of days elapsed since the (imaginary) Gregorian date Sunday, December 31, 1 BC." (and (fboundp 'current-time-zone) (let ((utc-time (timezone-time-from-absolute date seconds))) (and utc-time (let ((zone (current-time-zone utc-time))) (and (car zone) zone)))))) (defsubst timezone-fix-time-1 (year month day hour minute second) "Fix date and time. For old `timezone-fix-time' function. Arguments are YEAR, MONTH, DAY, HOUR, MINUTE and SECOND." ;; MINUTE may be larger than 60 or smaller than -60. (let ((hour-fix (if (< minute 0) ;;(/ (- minute 59) 60) (/ minute 60) ;; ANSI C compliance about truncation of integer division ;; by eggert@twinsun.com (Paul Eggert) (- (/ (- 59 minute) 60)) (/ minute 60)))) (setq hour (+ hour hour-fix)) (setq minute (- minute (* 60 hour-fix)))) ;; HOUR may be larger than 24 or smaller than 0. (cond ((<= 24 hour) ;24 -> 00 (setq hour (- hour 24)) (setq day (1+ day)) (if (< (timezone-last-day-of-month month year) day) (progn (setq month (1+ month)) (setq day 1) (if (< 12 month) (progn (setq month 1) (setq year (1+ year)) )) ))) ((> 0 hour) (setq hour (+ hour 24)) (setq day (1- day)) (if (> 1 day) (progn (setq month (1- month)) (if (> 1 month) (progn (setq month 12) (setq year (1- year)) )) (setq day (timezone-last-day-of-month month year)) ))) ) (vector year month day hour minute second)) (defsubst timezone-fix-time-2 (date local timezone) "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector. If LOCAL is nil, it is assumed to be GMT. If TIMEZONE is nil, use the local time zone." (let* ((date (timezone-parse-date date)) (year (string-to-int (aref date 0))) (year (cond ((< year 50) (+ year 2000)) ((< year 100) (+ year 1900)) (t year))) (month (string-to-int (aref date 1))) (day (string-to-int (aref date 2))) (time (timezone-parse-time (aref date 3))) (hour (string-to-int (aref time 0))) (minute (string-to-int (aref time 1))) (second (string-to-int (aref time 2))) (local (or (aref date 4) local)) ;Use original if defined (timezone (or timezone (timezone-time-zone-from-absolute (timezone-absolute-from-gregorian month day year) (+ second (* 60 (+ minute (* 60 hour))))))) (diff (- (timezone-zone-to-minute timezone) (timezone-zone-to-minute local))) (minute (+ minute diff)) (hour-fix (timezone-floor minute 60))) (setq hour (+ hour hour-fix)) (setq minute (- minute (* 60 hour-fix))) ;; HOUR may be larger than 24 or smaller than 0. (cond ((<= 24 hour) ;24 -> 00 (setq hour (- hour 24)) (setq day (1+ day)) (if (< (timezone-last-day-of-month month year) day) (progn (setq month (1+ month)) (setq day 1) (if (< 12 month) (progn (setq month 1) (setq year (1+ year)) )) ))) ((> 0 hour) (setq hour (+ hour 24)) (setq day (1- day)) (if (> 1 day) (progn (setq month (1- month)) (if (> 1 month) (progn (setq month 12) (setq year (1- year)) )) (setq day (timezone-last-day-of-month month year)) ))) ) (vector year month day hour minute second timezone))) (defun timezone-fix-time (a1 a2 a3 &optional a4 a5 a6) "Fix date and time. (Old API: A1=YEAR A2=MONTH A3=DAY A4=HOUR A5=MINUTE A6=SECOND). Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector. If LOCAL is nil, it is assumed to be GMT. If TIMEZONE is nil, use the local time zone. (New API: A1=DATE A2=LOCAL A3=TIMEZONE)" (if a4 (timezone-fix-time-1 a1 a2 a3 a4 a5 a6) (timezone-fix-time-2 a1 a2 a3))) ;; Partly copied from Calendar program by Edward M. Reingold. ;; Thanks a lot. (defun timezone-last-day-of-month (month year) "The last day in MONTH during YEAR." (if (and (= month 2) (timezone-leap-year-p year)) 29 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) (defun timezone-leap-year-p (year) "Return t if YEAR is a Gregorian leap year." (or (and (zerop (% year 4)) (not (zerop (% year 100)))) (zerop (% year 400)))) (defun timezone-day-number (month day year) "Return the day number within the year of the date MONTH/DAY/YEAR." (let ((day-of-year (+ day (* 31 (1- month))))) (if (> month 2) (progn (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) (if (timezone-leap-year-p year) (setq day-of-year (1+ day-of-year))))) day-of-year)) (defun timezone-absolute-from-gregorian (month day year) "The number of days between the Gregorian date 12/31/1 BC and MONTH/DAY/YEAR. The Gregorian date Sunday, December 31, 1 BC is imaginary." (+ (timezone-day-number month day year);; Days this year (* 365 (1- year));; + Days in prior years (/ (1- year) 4);; + Julian leap years (- (/ (1- year) 100));; - century years (/ (1- year) 400)));; + Gregorian leap years ;;; @ End. ;;; (require 'product) (product-provide (provide 'timezone) (require 'apel-ver)) ;;; timezone.el ends here apel-5bc1050/tinycustom.el000066400000000000000000000137141174656234300155350ustar00rootroot00000000000000;; tinycustom.el -- a tiny custom.el for emulating purpose. ;; Copyright (C) 1999 Mikio Nakajima ;; Author: Mikio Nakajima ;; Katsumi Yamaoka ;; Keywords: emulating, custom ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Purpose of this program is emulating for who does not have "custom". ;; (custom.el bundled with v19 is old; does not have following macros.) ;; ;; DEFCUSTOM below has the same effect as the original DEFVAR has. ;; DEFFACE below interprets almost all arguments. ;; DEFGROUP and DEFINE-WIDGET below are just nop macro. ;;; Code: (require 'poe) (defmacro-maybe defgroup (symbol members doc &rest args) "Declare SYMBOL as a customization group containing MEMBERS. SYMBOL does not need to be quoted. Third arg DOC is the group documentation. This is a nop defgroup only for emulating purpose." nil) (defmacro-maybe defcustom (symbol value doc &rest args) "Declare SYMBOL as a customizable variable that defaults to VALUE. DOC is the variable documentation. This is a defcustom only for emulating purpose. Its effect is just as same as that of defvar." (` (defvar (, symbol) (, value) (, doc)))) (defvar-maybe frame-background-mode nil "*The brightness of the background. Set this to the symbol dark if your background color is dark, light if your background is light, or nil (default) if you want Emacs to examine the brightness for you. However, the old Emacsen might not examine the brightness, so you should set this value definitely.") (defun-maybe-cond custom-declare-face (face spec doc &rest args) "Like `defface', but FACE is evaluated as a normal argument. Note that this function does not have the full specification; DOC or ARGS are ignored and some keywords are ignored in SPEC except for `:foreground', `:background', `:bold', `:italic' and `:underline'. It does nothing if FACE has been defined." ((fboundp 'make-face) (or (find-face face) (let ((colorp (and window-system (x-display-color-p))) display atts req item match done) (make-face face) (while (and spec (not done)) (setq display (car (car spec)) atts (car (cdr (car spec))) spec (cdr spec)) (cond ((consp display) (setq match t) (while (and display match) (setq req (car (car display)) item (car (cdr (car display))) display (cdr display)) (cond ((eq 'type req) (setq match (or (eq window-system item) (and (not window-system) (eq 'tty item))))) ((eq 'class req) (setq match (or (and colorp (eq 'color item)) (and (not colorp) (memq item '(grayscale mono)))))) ((eq 'background req) (setq match (eq (or frame-background-mode 'light) item))))) (setq done match)) ((eq t display) (setq done t)))) (if done (let ((alist '((:foreground . set-face-foreground) (:background . set-face-background) (:bold . set-face-bold-p) (:italic . set-face-italic-p) (:underline . set-face-underline-p))) function) (while atts (if (setq function (cdr (assq (car atts) alist))) (funcall function face (car (cdr atts)))) (setq atts (cdr (cdr atts)))))) face))) (t nil)) (defmacro-maybe defface (face spec doc &rest args) "Declare FACE as a customizable face that defaults to SPEC. FACE does not need to be quoted. Third argument DOC is the face documentation. If FACE has been set with `custom-set-face', set the face attributes as specified by that function, otherwise set the face attributes according to SPEC. The remaining arguments should have the form [KEYWORD VALUE]... The following KEYWORDs are defined: :group VALUE should be a customization group. Add FACE to that group. SPEC should be an alist of the form ((DISPLAY ATTS)...). ATTS is a list of face attributes and their values. The possible attributes are defined in the variable `custom-face-attributes'. The ATTS of the first entry in SPEC where the DISPLAY matches the frame should take effect in that frame. DISPLAY can either be the symbol t, which will match all frames, or an alist of the form \((REQ ITEM...)...) For the DISPLAY to match a FRAME, the REQ property of the frame must match one of the ITEM. The following REQ are defined: `type' (the value of `window-system') Should be one of `x' or `tty'. `class' (the frame's color support) Should be one of `color', `grayscale', or `mono'. `background' (what color is used for the background text) Should be one of `light' or `dark'. Read the section about customization in the Emacs Lisp manual for more information." (nconc (list 'custom-declare-face (list 'quote face) spec doc) ;; Quote colon keywords. (let (rest) (while args (setq rest (cons (list 'quote (car args)) rest) args (cdr args) rest (cons (car args) rest) args (cdr args))) (nreverse rest)))) (defmacro-maybe define-widget (name class doc &rest args) "Define a new widget type named NAME from CLASS. The third argument DOC is a documentation string for the widget. This is a nop define-widget only for emulating purpose." nil) (provide 'custom) (require 'product) (product-provide (provide 'tinycustom) (require 'apel-ver)) ;;; tinycustom.el ends here apel-5bc1050/tinyrich.el000066400000000000000000000101531174656234300151420ustar00rootroot00000000000000;;; ;;; $Id: tinyrich.el,v 5.0 1995/09/20 14:45:56 morioka Exp $ ;;; ;;; by MORIOKA Tomohiko ;;; modified by YAMATE Keiichirou ;;; (defvar mime-viewer/face-list-for-text/enriched (cond ((and (>= emacs-major-version 19) window-system) '(bold italic fixed underline) ) ((and (boundp 'NEMACS) NEMACS) '("bold" "italic" "underline") ))) (defun enriched-decode (beg end) (interactive "*r") (save-excursion (save-restriction (narrow-to-region beg end) (goto-char beg) (while (re-search-forward "[ \t]*\\(\n+\\)[ \t]*" nil t) (let ((str (buffer-substring (match-beginning 1) (match-end 1)))) (if (string= str "\n") (replace-match " ") (replace-match (substring str 1)) ))) (goto-char beg) (let (cmd sym str (fb (point)) fe b e) (while (re-search-forward "<\\(<\\|[^<>\n\r \t]+>\\)" nil t) (setq b (match-beginning 0)) (setq cmd (buffer-substring b (match-end 0))) (if (string= cmd "<<") (replace-match "<") (replace-match "") (setq cmd (downcase (substring cmd 1 (- (length cmd) 1)))) ) (setq sym (intern cmd)) (cond ((eq sym 'param) (setq b (point)) (save-excursion (save-restriction (if (search-forward "" nil t) (progn (replace-match "") (setq e (point)) ) (setq e end) ))) (delete-region b e) ) ((memq sym mime-viewer/face-list-for-text/enriched) (setq b (point)) (save-excursion (save-restriction (if (re-search-forward (concat "") nil t) (progn (replace-match "") (setq e (point)) ) (setq e end) ))) (tm:set-face-region b e sym) ))) (goto-char (point-max)) (if (not (eq (preceding-char) ?\n)) (insert "\n") ) )))) ;;; @ text/richtext <-> text/enriched converter ;;; (defun richtext-to-enriched-region (beg end) "Convert the region of text/richtext style to text/enriched style." (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (let (b e i) (while (re-search-forward "[ \t]*" nil t) (setq b (match-beginning 0)) (delete-region b (if (re-search-forward "[ \t]*" nil t) (match-end 0) (point-max) )) ) (goto-char (point-min)) (while (re-search-forward "\n\n+" nil t) (replace-match "\n") ) (goto-char (point-min)) (while (re-search-forward "[ \t\n]*[ \t\n]*" nil t) (setq b (match-beginning 0)) (setq e (match-end 0)) (setq i 1) (while (looking-at "[ \t\n]*[ \t\n]*") (setq e (match-end 0)) (setq i (1+ i)) (goto-char e) ) (delete-region b e) (while (>= i 0) (insert "\n") (setq i (1- i)) )) (goto-char (point-min)) (while (search-forward "" nil t) (replace-match "<<") ) )))) (defun enriched-to-richtext-region (beg end) "Convert the region of text/enriched style to text/richtext style." (save-excursion (save-restriction (goto-char beg) (and (search-forward "text/enriched") (replace-match "text/richtext")) (search-forward "\n\n") (narrow-to-region (match-end 0) end) (let (str n) (goto-char (point-min)) (while (re-search-forward "\n\n+" nil t) (setq str (buffer-substring (match-beginning 0) (match-end 0))) (setq n (1- (length str))) (setq str "") (while (> n 0) (setq str (concat str "\n")) (setq n (1- n)) ) (replace-match str) ) (goto-char (point-min)) (while (search-forward "<<" nil t) (replace-match "") ) )))) ;;; @ encoder and decoder ;;; (defun richtext-decode (beg end) (save-restriction (narrow-to-region beg end) (richtext-to-enriched-region beg (point-max)) (enriched-decode beg (point-max)) )) ;; (defun richtext-encode (beg end) ;; (save-restriction ;; (narrow-to-region beg end) ;; (enriched-encode beg (point-max)) ;; (enriched-to-richtext-region beg (point-max)) ;; )) ;;; @ end ;;; (require 'product) (product-provide (provide 'tinyrich) (require 'apel-ver)) ;; tinyrich.el ends here.