From ad3ba73586a7e06f1311726585c1e2c86995bda2 Mon Sep 17 00:00:00 2001 From: teranisi Date: Wed, 22 Dec 1999 04:14:26 +0000 Subject: [PATCH] Merge apel-shubit. --- APEL-CFG | 138 +++--- APEL-ELS | 20 +- APEL-MK | 267 +++++++---- ChangeLog | 159 ++++++- EMU-ELS | 323 ++++++++------ Makefile | 26 +- install.el | 148 +++--- inv-18.el | 55 +-- inv-19.el | 25 +- inv-xemacs.el | 25 +- invisible.el | 18 +- pccl-20.el | 6 +- pccl-om.el | 8 +- poe-18.el | 666 ++++++++++++++------------- poe-xemacs.el | 69 +-- poe.el | 1385 +++++++++++++++++++++++++++++++++------------------------ pym.el | 293 ++++++++++++ 17 files changed, 2214 insertions(+), 1417 deletions(-) create mode 100644 pym.el diff --git a/APEL-CFG b/APEL-CFG index cce20e7..dc56510 100644 --- a/APEL-CFG +++ b/APEL-CFG @@ -1,62 +1,88 @@ -;;; -*-Emacs-Lisp-*- +;;; APEL-CFG --- user customizations for APEL installation. -*-Emacs-Lisp-*- -;; APEL-CFG: installation setting about APEL. +;;; 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_DIR if it is not set. +;; EMU_DIR: The directory where EMU modules will be installed. +;; Generated from VERSION_SPECIFIC_LISPDIR and EMU_DIR 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: -(defvar default-load-path load-path) -(setq load-path (cons (expand-file-name ".") load-path)) -(require 'install) - -;;; @ Please specify prefix of install directory. -;;; - -;; Please specify install path prefix. -;; If it is omitted, shared directory (maybe /usr/local is used). -(defvar PREFIX install-prefix) -;;(setq PREFIX "~/") - -;; Please specify emu prefix [optional] -(setq EMU_PREFIX - (if (or (featurep 'xemacs) - (and (fboundp 'set-buffer-multibyte) - (subrp (symbol-function 'set-buffer-multibyte)))) - "emu" - "")) - -;; Please specify prefix for ``apel'' [optional] -(setq APEL_PREFIX "apel") - - - -;;; @ optional settings -;;; - -(defvar VERSION_SPECIFIC_LISPDIR - (install-detect-elisp-directory PREFIX nil 'version-specific)) - -(setq EMU_DIR (expand-file-name EMU_PREFIX VERSION_SPECIFIC_LISPDIR)) - -;; It is generated by automatically. Please set variable `PREFIX'. -;; If you don't like default directory tree, please set it. -(defvar LISPDIR (install-detect-elisp-directory PREFIX)) -;; (setq install-default-elisp-directory "~/lib/emacs/lisp") - -(setq APEL_DIR (expand-file-name APEL_PREFIX LISPDIR)) -;; (setq APEL_DIR (expand-file-name APEL_PREFIX VERSION_SPECIFIC_LISPDIR)) - -(defvar PACKAGEDIR - (if (boundp 'early-packages) - (let ((dirs (append (if early-package-load-path - early-packages) - (if late-package-load-path - late-packages) - (if last-package-load-path - last-packages))) - dir) - (while (not (file-exists-p - (setq dir (car dirs)))) - (setq dirs (cdr dirs))) - dir))) +;;; "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 eariler. +;; (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 diff --git a/APEL-ELS b/APEL-ELS index 16e6816..4d63740 100644 --- a/APEL-ELS +++ b/APEL-ELS @@ -1,19 +1,21 @@ -;;; -*-Emacs-Lisp-*- +;;; APEL-ELS --- list of APEL modules to install. -*-Emacs-Lisp-*- -;; APEL-ELS: list of APEL modules to install +;;; Commentary: + +;; APEL-MK imports `apel-modules' from here. ;;; Code: -(setq apel-modules '(product apel-ver - alist calist - path-util filename install - mule-caesar - +(defvar apel-modules '(product apel-ver + 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 - )) + )) (if (or (< emacs-major-version 19) (and (eq emacs-major-version 19) (< emacs-minor-version 16))) diff --git a/APEL-MK b/APEL-MK index 5bbc2a3..58e5ddb 100644 --- a/APEL-MK +++ b/APEL-MK @@ -1,107 +1,218 @@ -;;; -*-Emacs-Lisp-*- +;;; APEL-MK --- installer for APEL. -*-Emacs-Lisp-*- -;; APEL-MK: installer for APEL. +;;; 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 + + +;;; Utilities. (XXX: should be moved to install.el ?) + (defun install-just-print-p () (let ((flag (getenv "MAKEFLAGS")) - case-fold-search) + (case-fold-search nil)) (princ (format "%s\n" flag)) (if flag - (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag) - ))) + (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag)))) (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 - (setq autoload-package-name package) - (add-to-list 'command-line-args-left dir) - (batch-update-directory) - - (add-to-list 'command-line-args-left dir) - (Custom-make-dependencies) - - (byte-compile-file (expand-file-name "auto-autoloads.el" dir)) - (byte-compile-file (expand-file-name "custom-load.el" dir)) - ))) + (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 + (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))))) + + +;;; 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 (car command-line-args-left)) + (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) - (defvar PREFIX prefix) - )) - (setq command-line-args-left (cdr command-line-args-left)) - (and (setq lisp-dir (car command-line-args-left)) + (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) - (defvar LISPDIR lisp-dir) - )) - (setq command-line-args-left (cdr command-line-args-left)) - (and (setq version-specific-lisp-dir (car command-line-args-left)) + (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) - (progn - (defvar VERSION_SPECIFIC_LISPDIR version-specific-lisp-dir) - (princ (format "VERSION_SPECIFIC_LISPDIR=%s\n" - VERSION_SPECIFIC_LISPDIR))) - )) - (setq command-line-args-left (cdr command-line-args-left)) - (load-file "APEL-CFG") - (or (boundp 'apel-modules) - (load-file "APEL-ELS") - ) - (princ (format "PREFIX=%s\n" PREFIX)) - )) + (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) - (load-file "EMU-ELS") - (load-file "APEL-ELS") + ;; Compile emu modules first. (compile-elisp-modules emu-modules-to-compile ".") - (compile-elisp-modules apel-modules ".") - ) + (compile-elisp-modules apel-modules ".")) (defun install-apel () - (compile-apel) + (config-apel) (let ((just-print (install-just-print-p))) - (install-elisp-modules emu-modules "." EMU_DIR just-print) - (install-elisp-modules apel-modules "." APEL_DIR just-print) - )) + (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 (car command-line-args-left)) + (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) - (defvar PACKAGEDIR package-dir) - )) - (setq command-line-args-left (cdr command-line-args-left)) - (load-file "APEL-CFG") - (load-file "APEL-ELS") - (load-file "EMU-ELS") - - (princ (format "PACKAGEDIR=%s\n" PACKAGEDIR)) - )) + (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 + (if (boundp 'early-packages) + (let ((dirs (append (if early-package-load-path + early-packages) + (if late-package-load-path + late-packages) + (if last-package-load-path + last-packages))) + dir) + (while (not (file-exists-p (setq dir (car dirs)))) + (setq dirs (cdr dirs))) + dir)))) + (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 ".") - ) + (compile-elisp-modules apel-modules ".")) (defun install-apel-package () (config-apel-package) @@ -110,12 +221,10 @@ (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) - )) + (install-update-package-files "apel" dir just-print))) (defun what-where-apel () (config-apel) - (load-file "EMU-ELS") (princ (format " The files that belong to the EMU modules: %s @@ -124,10 +233,12 @@ The files that belong to the EMU modules: The files that belong to the APEL modules: %s -> %s + +Do `make elc', `make install', `make package', or `make install-package'. " - (mapconcat 'symbol-name emu-modules ", ") + (mapconcat (function symbol-name) emu-modules ", ") EMU_DIR - (mapconcat 'symbol-name apel-modules ", ") + (mapconcat (function symbol-name) apel-modules ", ") APEL_DIR))) ;;; APEL-MK ends here diff --git a/ChangeLog b/ChangeLog index eda4d28..b0b8e7a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,19 +1,157 @@ 1999-12-22 Yuuichi Teranishi - * timezone.el: Modified comments. - (toplevel): Require 'product. - -1999-12-21 Shuhei KOBAYASHI - - * apel-ver.el: Footer fix. + * 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. @@ -81,15 +219,6 @@ * poe-18.el (current-time-string, current-time): New functions. -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-11 Shuhei KOBAYASHI * localhook.el, pcustom.el: checkdoc. diff --git a/EMU-ELS b/EMU-ELS index a6ceb82..6865884 100644 --- a/EMU-ELS +++ b/EMU-ELS @@ -1,139 +1,198 @@ -;;; -*-Emacs-Lisp-*- +;;; EMU-ELS --- list of EMU modules to install. -*-Emacs-Lisp-*- -;; EMU-ELS: list of EMU modules to install +;;; Commentary: + +;; APEL-MK imports `emu-modules' and `emu-modules-to-compile' from here. ;;; Code: -(setq emu-modules (cons 'emu - (if (if (featurep 'xemacs) - ;; running-xemacs-19_14-or-later - (or (>= emacs-major-version 20) - (and (= emacs-major-version 19) - (>= emacs-minor-version 14))) - ;; running-emacs-19_29-or-later - (or (>= emacs-major-version 20) - (and (= emacs-major-version 19) - (>= emacs-minor-version 29)))) - '(richtext) - '(tinyrich)))) - -(setq emu-modules-to-compile nil) - -(setq emu-modules-not-to-compile nil) - -(setq pcustom-modules (if (and (module-installed-p 'custom) - ;; new custom requires widget. - (module-installed-p 'widget)) - '(pcustom) - ;; XXX: order is significant in current make process. - '(tinycustom pcustom))) - -(let ((poe-modules '(poe)) - (pces-modules '(pces)) - (poem-modules '(poem)) - (mcs-modules '(mcharset)) - (invisible-modules '(invisible)) - (pccl-modules '(pccl))) - (cond ((featurep 'xemacs) - (setq poe-modules (cons 'poe-xemacs poe-modules) - invisible-modules (cons 'inv-xemacs invisible-modules)) - ) - ((>= emacs-major-version 19) - (setq invisible-modules (cons 'inv-19 invisible-modules)) - (if (and (= emacs-major-version 19) - (<= emacs-minor-version 28)) - (setq poe-modules (cons 'localhook poe-modules)) - ) - ) - (t - (setq poe-modules (cons 'env (cons 'poe-18 (cons 'localhook poe-modules))) - invisible-modules (cons 'inv-18 invisible-modules)) - )) - (cond ((featurep 'xemacs) - (if (featurep 'file-coding) - (setq pces-modules (cons 'pces-xfc (cons 'pces-20 pces-modules))) - ) - (if (featurep 'mule) - (setq pces-modules (cons 'pces-xm pces-modules)) - (setq pces-modules (cons 'pces-raw pces-modules)) - )) - ((featurep 'mule) - (cond ((>= emacs-major-version 20) - (setq pces-modules - (cons 'pces-e20 (cons 'pces-20 pces-modules))) - (or (and (fboundp 'set-buffer-multibyte) - (subrp (symbol-function 'set-buffer-multibyte))) - (setq pces-modules (cons 'pces-e20_2 pces-modules))) - ) - (t - ;; for MULE 1.* and 2.* - (setq pces-modules (cons 'pces-om pces-modules)) - ))) - ((boundp 'NEMACS) - ;; for Nemacs and Nepoch - (setq pces-modules (cons 'pces-nemacs pces-modules)) - ) - (t - (setq pces-modules (cons 'pces-raw pces-modules)) - )) - (cond ((featurep 'mule) - (cond ((featurep 'xemacs) - (setq poem-modules (cons 'poem-xm poem-modules) - mcs-modules (append '(mcs-xmu mcs-xm mcs-20) - mcs-modules)) - (if (featurep 'utf-2000) - (setq emu-modules-not-to-compile - (cons 'mcs-xmu emu-modules-not-to-compile))) - (if (>= emacs-major-version 21) - (setq pccl-modules (cons 'pccl-20 pccl-modules)) - )) - ((>= emacs-major-version 20) - (setq poem-modules (cons 'poem-e20 poem-modules) - mcs-modules (cons 'mcs-e20 (cons 'mcs-20 mcs-modules)) - pccl-modules (cons 'pccl-20 pccl-modules)) - (setq poem-modules - (cons - (if (and - (fboundp 'set-buffer-multibyte) - (subrp (symbol-function 'set-buffer-multibyte))) - 'poem-e20_3 - 'poem-e20_2) - poem-modules)) - ) - (t - (setq poem-modules (cons 'poem-om poem-modules) - mcs-modules (cons 'mcs-om mcs-modules) - pccl-modules (cons 'pccl-om pccl-modules) - emu-modules (cons 'emu-mule emu-modules)) - )) - ) - ((boundp 'NEMACS) - (setq poem-modules (cons 'poem-nemacs poem-modules) - mcs-modules (cons 'mcs-nemacs mcs-modules)) - ) - (t - (setq poem-modules (cons 'poem-ltn1 poem-modules) - mcs-modules (cons 'mcs-ltn1 mcs-modules)) - )) - - (setq emu-modules (append poe-modules - pces-modules poem-modules - mcs-modules invisible-modules - pccl-modules pcustom-modules - emu-modules)) - - (setq emu-modules (cons 'broken emu-modules)) - (setq emu-modules (cons 'static emu-modules)) - ) - -(let ((modules emu-modules) - module) +(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) + ;; coming soon. + ;; '(product) + + ;; 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 'mule) + (cond + ;; XEmacs 21 w/ mule. + ((and (featurep 'xemacs) + (>= emacs-major-version 21)) + '(pccl-20 pccl)) + ;; Emacs 20. + ((>= emacs-major-version 20) + '(pccl-20 pccl)) + (t + ;; Mule 1.* and 2.*. + '(pccl-om 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))) + + ;; time-stamp.el; First appeared in Emacs 19.16. + (if (and (not (featurep 'xemacs)) + (or (< emacs-major-version 19) + (and (= emacs-major-version 19) + (< emacs-minor-version 16)))) + '(time-stamp)) + + ;; timezone.el; Some versions have Y2K problem. + ;; coming soon. + + ;; invisible modules; provided for backward compatibility with old "tm". + (cond + ((featurep 'xemacs) + ;; XEmacs. + '(inv-xemacs 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 module (car modules) - modules (cdr modules)) - (if (memq module emu-modules-not-to-compile) - nil - (setq emu-modules-to-compile (nconc emu-modules-to-compile - (list module)))))) + (setq emu-modules-to-compile (delq (car modules) emu-modules-to-compile) + modules (cdr modules)))) ;;; EMU-ELS ends here diff --git a/Makefile b/Makefile index 040b05c..350c845 100644 --- a/Makefile +++ b/Makefile @@ -21,25 +21,25 @@ GOMI = *.elc ARCHIVE_DIR_PREFIX = /pub/mule -elc: - $(EMACS) $(FLAGS) -f compile-apel +what-where: + $(EMACS) $(FLAGS) -f what-where-apel \ + $(PREFIX) $(LISPDIR) $(VERSION_SPECIFIC_LISPDIR) -install: - $(EMACS) $(FLAGS) -f install-apel $(PREFIX) $(LISPDIR) \ - $(VERSION_SPECIFIC_LISPDIR) # $(MAKE) +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) + $(XEMACS) $(FLAGS) -f compile-apel-package \ + $(PACKAGEDIR) install-package: package - $(XEMACS) $(FLAGS) -f install-apel-package $(PACKAGEDIR) \ - # $(MAKE) - - -what-where: - $(EMACS) $(FLAGS) -f what-where-apel $(PREFIX) $(LISPDIR) \ - $(VERSION_SPECIFIC_LISPDIR) + $(XEMACS) $(FLAGS) -f install-apel-package \ + $(PACKAGEDIR) # $(MAKE) clean: diff --git a/install.el b/install.el index 1aa56a3..2d9dd41 100644 --- a/install.el +++ b/install.el @@ -25,53 +25,8 @@ ;;; Code: -;; for historical reason, we do (require 'emu) in this file. -;; but you should do (require 'emu) explicitly if you use functions and/or -;; variables defined in emu module. -;;(require 'emu) -(require 'poe) ; emacs-major-version, emacs-minor-version -(require 'path-util) ; default-load-path - -;; verbatim copy of `defun-maybe' from poe.el, and -;; `make-directory-internal' and `make-directory' from poe-18.el -(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)) - (put (quote (, name)) 'defun-maybe t)))))) - -(defun-maybe make-directory-internal (dirname) - "Create a directory. One argument, a file name string." - (let ((dir (expand-file-name dirname))) - (if (file-exists-p dir) - (error "Creating directory: %s is already exist" dir) - (call-process "mkdir" nil nil nil dir)))) - -(defun-maybe 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))) +(require 'poe) ; make-directory for v18 +(require 'path-util) ; default-load-path ;;; @ compile Emacs Lisp files @@ -86,16 +41,17 @@ to create parent directories if they don't exist." (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)) + (mapcar + (function + (lambda (module) + (compile-elisp-module module path every-time))) + modules)) ;;; @ install files ;;; -(defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4)) +(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 @@ -120,10 +76,11 @@ to create parent directories if they don't exist." (defun install-files (files src dest &optional move overwrite just-print) (or (file-exists-p dest) (make-directory dest t)) - (mapcar (function - (lambda (file) - (install-file file src dest move overwrite just-print))) - files)) + (mapcar + (function + (lambda (file) + (install-file file src dest move overwrite just-print))) + files)) ;;; @@ install Emacs Lisp files @@ -165,10 +122,11 @@ to create parent directories if they don't exist." (defun install-elisp-modules (modules src dest &optional just-print) (or (file-exists-p dest) (make-directory dest t)) - (mapcar (function - (lambda (module) - (install-elisp-module module src dest just-print))) - modules)) + (mapcar + (function + (lambda (module) + (install-elisp-module module src dest just-print))) + modules)) ;;; @ detect install path @@ -176,8 +134,8 @@ to create parent directories if they don't exist." ;; install to shared directory (maybe "/usr/local") (defvar install-prefix - (if (or (<= emacs-major-version 18) ; running-emacs-18 - (featurep 'xemacs) ; running-xemacs + (if (or (<= emacs-major-version 18) + (featurep 'xemacs) (and (boundp 'system-configuration-options) ; 19.29 or later (string= system-configuration-options "NT"))) ; for Meadow (expand-file-name "../../.." exec-directory) @@ -186,6 +144,7 @@ to create parent directories if they don't exist." (defvar install-elisp-prefix (if (>= emacs-major-version 19) "site-lisp" + ;; v18 does not have standard site directory. "local.lisp")) (defun install-detect-elisp-directory (&optional prefix elisp-prefix @@ -194,38 +153,39 @@ to create parent directories if they don't exist." (setq prefix install-prefix)) (or elisp-prefix (setq elisp-prefix install-elisp-prefix)) - (or - (catch 'tag - (let ((rest default-load-path) - (pat (concat "^" - (expand-file-name (concat ".*/" elisp-prefix) prefix) - "/?$"))) - (while rest - (if (string-match pat (car rest)) - (if (or allow-version-specific - (not (string-match (format "/%d\\.%d" - emacs-major-version - emacs-minor-version) - (car rest)))) - (throw 'tag (car rest)))) - (setq rest (cdr rest))))) - (expand-file-name (concat - (if (and ; running-emacs-19_29-or-later - (not (featurep 'xemacs)) - (or (>= emacs-major-version 20) - (and (= emacs-major-version 19) - (>= emacs-minor-version 29)))) - "share/" - "lib/") - (cond ((boundp 'NEMACS) "nemacs/") - ((boundp 'MULE) "mule/") - ((featurep 'xemacs) ; running-xemacs - (if (featurep 'mule) - "xmule/" - "xemacs/")) - (t "emacs/")) - elisp-prefix) - prefix))) + (or (catch 'tag + (let ((rest default-load-path) + (regexp (concat "^" + (expand-file-name (concat ".*/" elisp-prefix) + prefix) + "/?$"))) + (while rest + (if (string-match regexp (car rest)) + (if (or allow-version-specific + (not (string-match (format "/%d\\.%d" + emacs-major-version + emacs-minor-version) + (car rest)))) + (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)) diff --git a/inv-18.el b/inv-18.el index dfeb653..f55e9ef 100644 --- a/inv-18.el +++ b/inv-18.el @@ -24,57 +24,50 @@ ;;; Code: -(defmacro enable-invisible () - (` - (progn - (make-local-variable 'original-selective-display) - (setq original-selective-display selective-display) - (setq selective-display t) - ))) - -(defmacro end-of-invisible () - (` (setq selective-display - (if (boundp 'original-selective-display) - original-selective-display)) - )) +(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) ;Okay even if write protected. + (let ((buffer-read-only nil) (modp (buffer-modified-p))) (if (save-excursion (goto-char (1- end)) - (eq (following-char) ?\n) - ) - (setq end (1- end)) - ) + (eq (following-char) ?\n)) + (setq end (1- end))) (unwind-protect - (subst-char-in-region start end ?\n ?\^M t) - (set-buffer-modified-p modp) - ))) + (subst-char-in-region start end ?\n ?\r t) + (set-buffer-modified-p modp)))) (defun visible-region (start end) - (let ((buffer-read-only nil) ;Okay even if write protected. + (let ((buffer-read-only nil) (modp (buffer-modified-p))) (unwind-protect - (subst-char-in-region start end ?\^M ?\n t) - (set-buffer-modified-p modp) - ))) + (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) ?\^M) - )) + (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) - )) + (forward-char)) + (point))) ;;; @ end diff --git a/inv-19.el b/inv-19.el index 2fafbf3..11074bf 100644 --- a/inv-19.el +++ b/inv-19.el @@ -24,34 +24,31 @@ ;;; Code: -(defmacro enable-invisible ()) +(require 'poe) -(defmacro end-of-invisible ()) +(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) - ) + (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) - ) + (put-text-property start end 'invisible nil)) (defun invisible-p (pos) - (get-text-property pos 'invisible) - ) + (get-text-property pos 'invisible)) (defun next-visible-point (pos) (save-excursion (goto-char (next-single-property-change pos 'invisible)) (if (eq (following-char) ?\n) - (forward-char) - ) + (forward-char)) (point))) diff --git a/inv-xemacs.el b/inv-xemacs.el index 128bc89..a1383d1 100644 --- a/inv-xemacs.el +++ b/inv-xemacs.el @@ -25,39 +25,36 @@ ;;; Code: -(defmacro enable-invisible ()) +(require 'poe) -(defmacro end-of-invisible ()) +(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) - ) + (setq start (1+ start))) + (put-text-property start end 'invisible t)) (defun visible-region (start end) - (put-text-property start end 'invisible nil) - ) + (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) - ) + (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)) - ) + (setq pos (1+ pos))) (or (next-single-property-change pos 'invisible) (point-max)))) diff --git a/invisible.el b/invisible.el index 0cab393..d472e15 100644 --- a/invisible.el +++ b/invisible.el @@ -24,17 +24,13 @@ ;;; Code: -(require 'poe) - -(cond ((featurep 'xemacs) - (require 'inv-xemacs) - ) - ((>= emacs-major-version 19) - (require 'inv-19) - ) - (t - (require 'inv-18) - )) +(cond + ((featurep 'xemacs) + (require 'inv-xemacs)) + ((>= emacs-major-version 19) + (require 'inv-19)) + (t + (require 'inv-18))) ;;; @ end diff --git a/pccl-20.el b/pccl-20.el index 62c1c39..b95244a 100644 --- a/pccl-20.el +++ b/pccl-20.el @@ -80,8 +80,7 @@ CODING-SYSTEM, DECODER and ENCODER must be symbol." (defun ccl-execute (ccl-prog reg) "\ Execute CCL-PROG with registers initialized by REGISTERS. -If CCL-PROG is symbol, it is dereferenced. -\[Emacs 20.3 emulating function]" +If CCL-PROG is symbol, it is dereferenced." (ccl-vector-program-execute (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog) reg))) @@ -92,8 +91,7 @@ If CCL-PROG is symbol, it is dereferenced. (defun ccl-execute-on-string (ccl-prog status string &optional contin) "\ Execute CCL-PROG with initial STATUS on STRING. -If CCL-PROG is symbol, it is dereferenced. -\[Emacs 20.3 emulating function]" +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))) diff --git a/pccl-om.el b/pccl-om.el index 3ab0378..6d59923 100644 --- a/pccl-om.el +++ b/pccl-om.el @@ -4,7 +4,7 @@ ;; Copyright (C) 1998 Tanaka Akira ;; Author: Tanaka Akira -;; Shuhei KOBAYASHI +;; Shuhei KOBAYASHI ;; Keywords: emulation, compatibility, Mule ;; This file is part of APEL (A Portable Emacs Library). @@ -48,16 +48,14 @@ CODING-SYSTEM, DECODER and ENCODER must be symbol." (defun ccl-execute (ccl-prog reg) "Execute CCL-PROG with registers initialized by REGISTERS. -If CCL-PROG is symbol, it is dereferenced. -\[Emacs 20.3 emulating function]" +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. -\[Emacs 20.3 emulating function]" +If CCL-PROG is symbol, it is dereferenced." (exec-ccl-string (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog) status string)) diff --git a/poe-18.el b/poe-18.el index 5a97a42..f5597e2 100644 --- a/poe-18.el +++ b/poe-18.el @@ -1,8 +1,11 @@ ;;; 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). @@ -24,95 +27,28 @@ ;;; Commentary: -;; Note to developers: +;; Note to APEL developers and APEL programmers: ;; ;; If old (v18) compiler is used, top-level macros are expanded at -;; *load-time*, not compile-time. So, you cannot use macros defined -;; in this file using `defmacro-maybe'. In addition, due to this -;; limitation, `eval-when-compile' and `eval-and-compile' provided by -;; this file do not do compile-time evaluation at all. +;; *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: -;; beware of circular dependency. -(require 'product) -(product-provide (provide 'poe-18) (require 'apel-ver)) - -(require 'poe) ; load definitions of `*-maybe'. - -;;; @ for EMACS 18.55 -;;; - -(defvar-maybe buffer-undo-list nil) +(require 'pym) -;;; @ Emacs 19 emulation -;;; - -(defvar-maybe data-directory exec-directory) - - -;;; @ Lisp Language -;;; - -;;; @@ list -;;; - -(defun delete (elt list) - "Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `equal'. -If the first member of LIST is ELT, deleting it is not a side effect; -it is simply using a different list. -Therefore, write `(setq foo (delete element foo))' -to be sure of changing the value of `foo'. -\[poe-18.el; EMACS 19 emulating function]" - (if 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 member (elt list) - "Return non-nil if ELT is an element of LIST. Comparison done with EQUAL. -The value is actually the tail of LIST whose car is ELT. -\[poe-18.el; EMACS 19 emulating function]" - (while (and list (not (equal elt (car list)))) - (setq list (cdr list))) - list) - - -;;; @@ buffer-local variable -;;; - -(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. -\[poe-18.el; EMACS 19 emulating function]" - (condition-case error - (progn - (default-value symbol) - t) - (void-variable nil))) - - -;;; @@ environment variable -;;; - -(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) - - -;;; @@ function +;;; @ Compilation. ;;; (defun defalias (sym newdef) @@ -120,11 +56,10 @@ This function works by modifying `process-environment'." Associates the function with the current load file, if any." (fset sym newdef)) -(defun byte-code-function-p (exp) - "T if OBJECT is a byte-compiled function object. -\[poe-18.el; EMACS 19 emulating function]" - (and (consp exp) - (let ((rest (cdr (cdr exp))) +(defun byte-code-function-p (object) + "Return t if OBJECT is a byte-compiled function object." + (and (consp object) + (let ((rest (cdr (cdr object))) elt) (if (stringp (car rest)) (setq rest (cdr rest))) @@ -136,22 +71,53 @@ Associates the function with the current load file, if any." (throw 'tag t)) (setq rest (cdr rest))))))) - -;;; @ Compilation Features -;;; - -;;; emulate all functions and macros of emacs-20.3/lisp/byte-run.el. +;; (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 inline (&rest body) +(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. -\[poe-18.el; EMACS 19 emulating macro]" - (` (progn (,@ body)))) +compiler does not support inlining feature." + (cons 'progn body)) (put 'defsubst 'lisp-indent-hook 'defun) (put 'defsubst 'edebug-form-spec 'defun) @@ -159,8 +125,7 @@ compiler does not support inlining feature. "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. -\[poe-18.el; EMACS 19 emulating macro]" +compiler does not support inlining feature." (cons 'defun (cons name (cons arglist body)))) (defun-maybe make-obsolete (fn new) @@ -169,8 +134,7 @@ 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. -\[poe-18.el; EMACS 19 emulating function]" +support this feature." (interactive "aMake function obsolete: \nxObsoletion replacement: ") fn) @@ -180,16 +144,14 @@ 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. -\[poe-18.el; EMACS 19 emulating function]" +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. -\[poe-18.el; EMACS 19 emulating macro]" +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) @@ -197,8 +159,7 @@ If you think you need this, you're probably making a mistake somewhere. "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. -\[poe-18.el; EMACS 19 emulating macro]" +of the limitation of old \(v18\) compiler." (cons 'progn body)) (put 'eval-and-compile 'lisp-indent-hook 0) @@ -206,213 +167,47 @@ of the limitation of old \(v18\) compiler. "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. -\[poe-18.el; EMACS 19 emulating macro]" +of the limitation of old \(v18\) compiler." (cons 'progn body)) -;;; @ text property -;;; - -(defun set-text-properties (start end properties &optional object)) - -(defun remove-text-properties (start end properties &optional object)) - -(defun get-text-property (position prop &optional object)) - -(defun add-text-properties (start end properties &optional object)) - -(defun put-text-property (start end property value &optional object)) - -(defun next-property-change (position &optional object limit)) - -(defun text-properties-at (position &optional object)) - -;;; @ file -;;; - -(defun make-directory-internal (dirname) - "Create a directory. One argument, a file name string. -\[poe-18.el; EMACS 19 emulating function]" - (let ((dir (expand-file-name dirname))) - (if (file-exists-p dir) - (error "Creating directory: %s is already exist" dir) - (call-process "mkdir" nil nil nil dir)))) - -(defun make-directory (dir &optional parents) - "Create the directory DIR and any nonexistent parent dirs. -The second (optional) argument PARENTS says whether -to create parent directories if they don't exist. -\[poe-18.el; EMACS 19 emulating function]" - (let ((len (length dir)) - (p 0) p1 path) - (catch 'tag - (while (and (< p len) (string-match "[^/]*/?" dir p)) - (setq p1 (match-end 0)) - (if (= p1 len) - (throw 'tag nil)) - (setq path (substring dir 0 p1)) - (if (not (file-directory-p path)) - (cond ((file-exists-p path) - (error "Creating directory: %s is not directory" path)) - ((null parents) - (error "Creating directory: %s is not exist" path)) - (t - (make-directory-internal path)))) - (setq p p1))) - (make-directory-internal dir))) - -;; Imported from files.el of EMACS 19.33. -(defun parse-colon-path (cd-path) - "Explode a colon-separated list of paths into a string list." - (and cd-path - (let (cd-prefix cd-list (cd-start 0) cd-colon) - (setq cd-path (concat cd-path path-separator)) - (while (setq cd-colon (string-match path-separator cd-path cd-start)) - (setq cd-list - (nconc cd-list - (list (if (= cd-start cd-colon) - nil - (substitute-in-file-name - (file-name-as-directory - (substring cd-path cd-start cd-colon))))))) - (setq cd-start (+ cd-colon 1))) - cd-list))) - -;; Imported from files.el of EMACS 19.33. -(defun file-relative-name (filename &optional directory) - "Convert FILENAME to be relative to DIRECTORY (default: default-directory)." - (setq filename (expand-file-name filename) - directory (file-name-as-directory (expand-file-name - (or directory default-directory)))) - (let ((ancestor "")) - (while (not (string-match (concat "^" (regexp-quote directory)) filename)) - (setq directory (file-name-directory (substring directory 0 -1)) - ancestor (concat "../" ancestor))) - (concat ancestor (substring filename (match-end 0))))) - -(or (fboundp 'si:directory-files) - (fset 'si:directory-files (symbol-function 'directory-files))) -(defun directory-files (directory &optional full match nosort) - "Return a list of names of files in DIRECTORY. -There are three optional arguments: -If FULL is non-nil, return absolute file names. Otherwise return names - that are relative to the specified directory. -If MATCH is non-nil, mention only file names that match the regexp MATCH. -If NOSORT is dummy for compatibility. -\[poe-18.el; EMACS 19 emulating function]" - (si:directory-files directory full match)) - -(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. -\[poe-18.el; EMACS 19 emulating function]" - (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))))) - - -;;; @ Display Features +;;; @ C primitives emulation. ;;; -;;; Imported from Emacs 19.30. -(defun force-mode-line-update (&optional all) - "Force the mode-line of the current buffer to be redisplayed. -With optional non-nil ALL, force redisplay of all mode-lines. -\[poe-18.el; Emacs 19 emulating function]" - (if all (save-excursion (set-buffer (other-buffer)))) - (set-buffer-modified-p (buffer-modified-p))) - - -;;; @ overlay -;;; - -(cond ((boundp 'NEMACS) - (defvar emu:available-face-attribute-alist - '( - ;;(bold . inversed-region) - (italic . underlined-region) - (underline . underlined-region) - )) - - ;; by YAMATE Keiichirou 1994/10/28 - (defun attribute-add-narrow-attribute (attr from to) - (or (consp (symbol-value attr)) - (set attr (list 1))) - (let* ((attr-value (symbol-value attr)) - (len (car attr-value)) - (posfrom 1) - posto) - (while (and (< posfrom len) - (> from (nth posfrom attr-value))) - (setq posfrom (1+ posfrom))) - (setq posto posfrom) - (while (and (< posto len) - (> to (nth posto attr-value))) - (setq posto (1+ posto))) - (if (= posto posfrom) - (if (= (% posto 2) 1) - (if (and (< to len) - (= to (nth posto attr-value))) - (set-marker (nth posto attr-value) from) - (setcdr (nthcdr (1- posfrom) attr-value) - (cons (set-marker-type (set-marker (make-marker) - from) - 'point-type) - (cons (set-marker-type - (set-marker (make-marker) - to) - nil) - (nthcdr posto attr-value)))) - (setcar attr-value (+ len 2)))) - (if (= (% posfrom 2) 0) - (setq posfrom (1- posfrom)) - (set-marker (nth posfrom attr-value) from)) - (if (= (% posto 2) 0) - nil - (setq posto (1- posto)) - (set-marker (nth posto attr-value) to)) - (setcdr (nthcdr posfrom attr-value) - (nthcdr posto attr-value))))) - - (defalias 'make-overlay 'cons) - - (defun overlay-put (overlay prop value) - (let ((ret (and (eq prop 'face) - (assq value emu:available-face-attribute-alist)))) - (if ret - (attribute-add-narrow-attribute (cdr ret) - (car overlay)(cdr overlay)))))) - (t - (defun make-overlay (beg end &optional buffer type)) - (defun overlay-put (overlay prop value)))) - -(defun overlay-buffer (overlay)) - - -;;; @ buffer -;;; +(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-maybe generate-new-buffer-name (name &optional ignore) - "Return a string that is the name of no existing buffer based on NAME. -If there is no live buffer named NAME, then return NAME. -Otherwise modify name by appending `', 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)) +(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)))) -(or (fboundp 'si:mark) - (fset 'si:mark (symbol-function 'mark))) -(defun mark (&optional force) - (si:mark)) +(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. ;;; @@ -643,7 +438,264 @@ resolution finer than a second." ct2 (- ct2 65536))) (list ct1 ct2 0))) -;;; @ end +;;; @@ Floating point numbers. +;;; + +(defalias 'numberp 'integerp) + +(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 'save-match-data 'store-match-data) + + +;;; @ Basic editing commands. +;;; + +;; 18.55 does not have this variable. +(defvar buffer-undo-list nil) + +(defalias 'buffer-disable-undo 'buffer-flush-undo) + +(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)) + + +;;; @@ 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) + (error "Creating directory: %s is already exist" dir) + (call-process "mkdir" nil nil nil dir)))) + +(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 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)) + + +;;; @ 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-properties (start end property &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. ;;; +(cond + ((boundp 'NEMACS) + (defvar emu:available-face-attribute-alist + '( + ;;(bold . inversed-region) + (italic . underlined-region) + (underline . underlined-region))) + + ;; by YAMATE Keiichirou 1994/10/28 + (defun attribute-add-narrow-attribute (attr from to) + (or (consp (symbol-value attr)) + (set attr (list 1))) + (let* ((attr-value (symbol-value attr)) + (len (car attr-value)) + (posfrom 1) + posto) + (while (and (< posfrom len) + (> from (nth posfrom attr-value))) + (setq posfrom (1+ posfrom))) + (setq posto posfrom) + (while (and (< posto len) + (> to (nth posto attr-value))) + (setq posto (1+ posto))) + (if (= posto posfrom) + (if (= (% posto 2) 1) + (if (and (< to len) + (= to (nth posto attr-value))) + (set-marker (nth posto attr-value) from) + (setcdr (nthcdr (1- posfrom) attr-value) + (cons (set-marker-type (set-marker (make-marker) + from) + 'point-type) + (cons (set-marker-type + (set-marker (make-marker) + to) + nil) + (nthcdr posto attr-value)))) + (setcar attr-value (+ len 2)))) + (if (= (% posfrom 2) 0) + (setq posfrom (1- posfrom)) + (set-marker (nth posfrom attr-value) from)) + (if (= (% posto 2) 0) + nil + (setq posto (1- posto)) + (set-marker (nth posto attr-value) to)) + (setcdr (nthcdr posfrom attr-value) + (nthcdr posto attr-value))))) + + (defalias 'make-overlay 'cons) + + (defun overlay-put (overlay prop value) + (let ((ret (and (eq prop 'face) + (assq value emu:available-face-attribute-alist)))) + (if ret + (attribute-add-narrow-attribute (cdr ret) + (car overlay)(cdr overlay)))))) + (t + (defun make-overlay (beg end &optional buffer type)) + (defun overlay-put (overlay prop value)))) + +(defun overlay-buffer (overlay)) + + +;;; @ End. +;;; + +(require 'product) +(product-provide (provide 'poe-18) (require 'apel-ver)) + ;;; poe-18.el ends here diff --git a/poe-xemacs.el b/poe-xemacs.el index cfa7761..0ab7128 100644 --- a/poe-xemacs.el +++ b/poe-xemacs.el @@ -1,4 +1,4 @@ -;;; poe-xemacs.el --- poe submodule for XEmacs -*-byte-compile-dynamic: t;-*- +;;; poe-xemacs.el --- poe submodule for XEmacs ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko @@ -25,12 +25,11 @@ ;;; Code: -;;; @ color -;;; +(require 'pym) -(eval-when-compile - (require 'poe)) +;;; @ color +;;; (defun-maybe set-cursor-color (color-name) "Set the text cursor color of the selected frame to COLOR. @@ -60,15 +59,14 @@ When called interactively, prompt for the name of the color to use." (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) - )) + (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 @@ -77,8 +75,7 @@ When called interactively, prompt for the name of the color to use." (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)) - ) + (switch-to-buffer-other-frame (dired-noselect dirname switches))) ;;; @ to avoid bug of XEmacs 19.14 @@ -89,7 +86,7 @@ When called interactively, prompt for the name of the color to use." ;; This function was imported from Emacs 19.33. (defun file-relative-name (filename &optional directory) "Convert FILENAME to be relative to DIRECTORY -(default: default-directory). [poe-xemacs.el]" +(default: default-directory)." (setq filename (expand-file-name filename) directory (file-name-as-directory (expand-file-name @@ -99,49 +96,13 @@ When called interactively, prompt for the name of the color to use." filename)) (setq directory (file-name-directory (substring directory 0 -1)) ancestor (concat "../" ancestor))) - (concat ancestor (substring filename (match-end 0))))) - ) - - -;;; @ for anything older than XEmacs 20.2 -;;; - -;; eval-after-load is not defined in XEmacs but after-load-alist is -;; usable. See subr.el in XEmacs. - -(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) - -;; (defun-maybe eval-after-load (file form) -;; (or (assoc file after-load-alist) -;; (setq after-load-alist (cons (list file) after-load-alist))) -;; (let ((elt (assoc file after-load-alist))) -;; (or (member form (cdr elt)) -;; (nconc elt (list form)))) -;; form) + (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) diff --git a/poe.el b/poe.el index 9812800..d45005e 100644 --- a/poe.el +++ b/poe.el @@ -1,9 +1,10 @@ -;;; poe.el --- Portable Outfit for Emacsen; -*-byte-compile-dynamic: t;-*- +;;; poe.el --- Portable Outfit for Emacsen ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs +;; Shuhei KOBAYASHI +;; Keywords: emulation, compatibility, Nemacs, MULE, Emacs/mule, XEmacs ;; This file is part of APEL (A Portable Emacs Library). @@ -24,535 +25,269 @@ ;;; Commentary: -;; This modules does not includes MULE related features. -;; MULE related features are supported by `poem'. - ;;; Code: (require 'product) (product-provide (provide 'poe) (require 'apel-ver)) -(or (boundp 'current-load-list) (setq current-load-list nil)) +(require 'pym) -(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'. - (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)) - (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)) - (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)) - (setq current-load-list - (cons (quote (, symbol)) current-load-list)) - (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 everything-else) - (or (stringp doc) - (setq everything-else (cons doc everything-else) - doc nil)) - (or (and (fboundp name) - (not (get name 'defun-maybe))) - (` (or (fboundp (quote (, name))) - (prog1 - (cond - (,@ (mapcar - (function - (lambda (case) - (list (car case) - (if doc - (` (defun (, name) (, args) - (, doc) - (,@ (cdr case)))) - (` (defun (, name) (, args) - (,@ (cdr case)))))))) - everything-else))) - (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 everything-else) - (or (stringp doc) - (setq everything-else (cons doc everything-else) - doc nil)) - (or (and (fboundp name) - (not (get name 'defmacro-maybe))) - (` (or (fboundp (quote (, name))) - (prog1 - (cond - (,@ (mapcar - (function - (lambda (case) - (list (car case) - (if doc - (` (defmacro (, name) (, args) - (, doc) - (,@ (cdr case)))) - (` (defmacro (, name) (, args) - (,@ (cdr case)))))))) - everything-else))) - (setq current-load-list - (cons (quote (, name)) current-load-list)) - (put (quote (, name)) 'defmacro-maybe t)))))) - -(defun subr-fboundp (symbol) - "Return t if SYMBOL's function definition is a built-in function." - (and (fboundp symbol) - (subrp (symbol-function symbol)))) - -(defconst-maybe emacs-major-version (string-to-int emacs-version)) -(defconst-maybe emacs-minor-version - (string-to-int - (substring emacs-version - (string-match (format "%d\\." emacs-major-version) - emacs-version)))) - -(cond ((featurep 'xemacs) - (require 'poe-xemacs) - ) - ((string-match "XEmacs" emacs-version) - (provide 'xemacs) - (require 'poe-xemacs) - ) - ((> emacs-major-version 20)) - ((= emacs-major-version 20) - (cond ((subr-fboundp 'string) - ;; Emacs 20.3 or later - ) - ((subr-fboundp 'concat-chars) - ;; Emacs 20.1 or later - (defalias 'string 'concat-chars) - )) - ) - ((= emacs-major-version 19) - ;; XXX: should do compile-time and load-time check before loading - ;; "localhook". But, it is difficult since "localhook" is - ;; already loaded via "install" at compile-time. any idea? - (if (< emacs-minor-version 29) - (require 'localhook))) - (t - (require 'poe-18) - ;; XXX: should do compile-time and load-time check before loading - ;; "localhook". But, it is difficult since "localhook" is - ;; already loaded via "install" at compile-time. any idea? - (require 'localhook))) - -;;; `eval-when-compile' is defined in "poe-18" under v18 with old compiler. -(eval-when-compile (require 'static)) +;;; @ Version information. +;;; + +;; v18 does not have many features we expect, +;; notably `eval-when-compile' and `eval-and-compile'. +(static-when (string= (substring emacs-version 0 2) "18") + (require 'poe-18)) + +;; Now we can use them! +(eval-and-compile + ;; We must define these two constants at compile-time as well as + ;; load-time since they are used for compile-time version checking. + (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.")) + +;; 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 +;; 21.0. Therefore it is not provided in XEmacs with MULE versions 20.4 ;; or earlier. -(if (and (featurep 'xemacs) (featurep 'mule)) - (provide 'file-coding)) - -;; imported from emacs-20.3/lisp/emacs-lisp/edebug.el. -;; `def-edebug-spec' is an autoloaded macro in v19 and later. -(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))))) - -(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))) - -;;; Emacs 20.1 emulation - -;; imported from emacs-20.3/lisp/subr.el. -(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)) +(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))) -;; imported from emacs-20.3/lisp/subr.el. -(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)) +(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)) + -;;; @ Emacs 19.23 emulation +;;; @ 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 ""))) ; already redefined. + (error + ;; load-time check. + (or (fboundp 'si:require) + (progn + (fset 'si:require (symbol-function 'require)) + (put 'require 'defun-maybe t) + (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) + (error)) + (si:require feature filename))))))) + +;; 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))) - -;;; @ Emacs 19.29 emulation -;;; - -(defvar-maybe path-separator ":" - "The directory separator in search paths, as a string.") - -(defun-maybe buffer-substring-no-properties (start end) - "Return the characters of part of the buffer, without the text properties. -The two arguments START and END are character positions; -they can be in either order. -\[Emacs 19.29 emulating function]" - (let ((string (buffer-substring start end))) - (set-text-properties 0 (length string) nil string) - string)) - -;; imported from emacs-19.34/lisp/subr.el. -(defun-maybe match-string (num &optional string) - "Return string of text matched by last search. -NUM specifies which parenthesized expression in the last regexp. - Value is nil if NUMth pair didn't match, or there were less than NUM pairs. -Zero means the entire text matched by the whole regexp or whole string. -STRING should be given if the last search was by `string-match' on STRING. -\[Emacs 19.29 emulating function]" - (if (match-beginning num) - (if string - (substring string (match-beginning num) (match-end num)) - (buffer-substring (match-beginning num) (match-end num))))) - +;; (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))) - ;; for Emacs 19.28 or earlier - (unless (fboundp 'si:read-string) - (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. + (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)) - )) - -(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. -\[Emacs 19.29 emulating function]" - (catch 'found - (while list - (cond ((not (consp (car list)))) - ((equal (cdr (car list)) key) - (throw 'found (car list)) )) - (setq list (cdr list)) ))) - -;; imported from emacs-19.34/lisp/files.el. -(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 `.'. -\[Emacs 19.29 emulating function]" - (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)))) - - -;;; @ Emacs 19.30 emulation -;;; - -;; imported from emacs-19.34/lisp/subr.el. -(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. -\[Emacs 19.30 emulating function]" - (or (member element (symbol-value list-var)) - (set list-var (cons element (symbol-value list-var))))) - -(cond ((fboundp 'insert-file-contents-literally)) - ((boundp 'file-name-handler-alist) - (defun insert-file-contents-literally - (filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but only reads in the file. -A buffer may be modified in several ways after reading into the buffer due -to advanced Emacs features, such as file-name-handlers, format decoding, -find-file-hooks, etc. - This function ensures that none of these modifications will take place. -\[Emacs 19.30 emulating function]" - (let (file-name-handler-alist) - (insert-file-contents filename visit beg end replace))) - ) - (t - (defalias 'insert-file-contents-literally 'insert-file-contents) - )) - - -;;; @ Emacs 19.31 emulation -;;; - -(defun-maybe buffer-live-p (object) - "Return non-nil if OBJECT is a buffer which has not been killed. -Value is nil if OBJECT is not a buffer or if it has been killed. -\[Emacs 19.31 emulating function]" - (and object - (get-buffer object) - (buffer-name (get-buffer object)) - t)) - -;; imported from emacs-19.34/lisp/window.el. -(defmacro-maybe save-selected-window (&rest body) - "Execute BODY, then select the window that was selected before BODY. -\[Emacs 19.31 emulating function]" - (list 'let - '((save-selected-window-window (selected-window))) - (list 'unwind-protect - (cons 'progn body) - (list 'select-window 'save-selected-window-window)))) - -(defun-maybe-cond 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. -\[Emacs 19.31 emulating function]" - ((memq system-type '(windows-nt ms-dos)) - (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 filename)) - - -;;; @ Emacs 20.1 emulation -;;; - -;; imported from emacs-20.3/lisp/subr.el. -(defsubst-maybe caar (x) - "Return the car of the car of X." - (car (car x))) - -;; imported from emacs-20.3/lisp/subr.el. -(defsubst-maybe cadr (x) - "Return the car of the cdr of X." - (car (cdr x))) - -;; imported from emacs-20.3/lisp/subr.el. -(defsubst-maybe cdar (x) - "Return the cdr of the car of X." - (cdr (car x))) - -;; imported from emacs-20.3/lisp/subr.el. -(defsubst-maybe cddr (x) - "Return the cdr of the cdr of X." - (cdr (cdr x))) - -;; imported from emacs-20.3/lisp/subr.el. -(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)) - -;; In Emacs 20.3, save-current-buffer is defined in src/editfns.c. -(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)))))) - -;; imported from emacs-20.3/lisp/subr.el. (with macro style change) -(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)))) - -;; imported from emacs-20.3/lisp/subr.el. (with macro style change) -(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)))))))) - -;; imported from emacs-20.3/lisp/subr.el. (with macro style change) -(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)))))))) - -(defmacro-maybe combine-after-change-calls (&rest body) - "Execute BODY." - (cons 'progn body)) - -;; imported from emacs-20.3/lisp/subr.el. -(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)))) - -;; imported from emacs-20.3/lisp/emacs-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))) - -;; imported from emacs-20.3/lisp/emacs-lisp/cl.el. -(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)))) - -;; imported from XEmacs 21. -(defun-maybe split-string (string &optional pattern) - "Return a list of substrings of STRING which are separated by PATTERN. -If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." - (or pattern - (setq pattern "[ \f\t\n\r\v]+")) - ;; The FSF version of this function takes care not to cons in case - ;; of infloop. Maybe we should synch? - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts)))) - -;; emulating char-before of Emacs 20. + (si:read-string prompt initial-input))))) + +;; 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 "")) ; already redefined. + (error "")) ; Emacs 20.3 and ealier. + (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 bytecompiling. + ;; (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 - ;; XXX: this file is already loaded at compile-time, - ;; so this test will always success. (char-before) - ;; If our definition is found at compile-time, signal an error. - ;; XXX: should signal more specific error. (if (get 'char-before 'defun-maybe) - (error ""))) - (wrong-number-of-arguments ; Mule 1.*, 2.*. + (error ""))) ; already defined. + (wrong-number-of-arguments ; Mule. ;; load-time check. (or (fboundp 'si:char-before) (progn @@ -583,7 +318,7 @@ If POS is out of range, the value is nil." ;; load-time check. (condition-case nil (char-before) - (wrong-number-of-arguments ; Mule 1.*, 2.*. + (wrong-number-of-arguments ; Mule. (or (fboundp 'si:char-before) (progn (fset 'si:char-before (symbol-function 'char-before)) @@ -609,17 +344,14 @@ If POS is out of range, the value is nil." (and (not (bobp)) (preceding-char)))))))) -;; emulating char-after of Emacs 20. +;; v18, v19: (char-after POS) +;; v20: (char-after &optional POS) (static-condition-case nil ;; compile-time check. (progn - ;; XXX: this file is already loaded at compile-time, - ;; so this test will always success. (char-after) - ;; If our definition is found at compile-time, signal an error. - ;; XXX: should signal more specific error. (if (get 'char-after 'defun-maybe) - (error ""))) + (error ""))) ; already defined. (wrong-number-of-arguments ; v18, v19 ;; load-time check. (or (fboundp 'si:char-after) @@ -675,21 +407,25 @@ If POS is out of range, the value is nil." (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 20.3 emulation -;;; - -;; imported from emacs-20.3/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 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. @@ -699,6 +435,7 @@ This function does not move point." (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. @@ -707,40 +444,517 @@ This function does not move point." (save-excursion (end-of-line (or n 1)) (point))) + + +;;; @ 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.14(?) 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))))) + +;;; @@ 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.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 20.1/XEmacs 20.3(?) and later: (split-string STRING &optional PATTERN) +;; Here is a XEmacs version. +(defun-maybe split-string (string &optional pattern) + "Return a list of substrings of STRING which are separated by PATTERN. +If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." + (or pattern + (setq pattern "[ \f\t\n\r\v]+")) + ;; The FSF version of this function takes care not to cons in case + ;; of infloop. Maybe we should synch? + (let (parts (start 0)) + (while (string-match pattern string start) + (setq parts (cons (substring string start (match-beginning 0)) parts) + start (match-end 0))) + (nreverse (cons (substring string start) parts)))) + +;; Emacs 20.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)))) + -(defun-maybe string (&rest chars) - "Concatenate all the argument characters and make the result a string." - (mapconcat (function char-to-string) chars "")) +;;; @ 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)))) + + +;;; @ 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.") + +;; 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)))) + - -;;; @ XEmacs emulation +;;; @ 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. -\[XEmacs emulating function]" +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. -\[XEmacs emulating function]" +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. -\[XEmacs emulating function]" +This function does not move point." (save-excursion (if buffer (set-buffer buffer)) (end-of-line (or n 1)) @@ -749,71 +963,82 @@ This function does not move 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. -\[XEmacs emulating function]" +as obsolete." (defalias oldfun newfun) (make-obsolete oldfun newfun)) -(when (subr-fboundp 'read-event) - ;; for Emacs 19 or later - - (defun-maybe-cond next-command-event (&optional event prompt) - "Read an event object from the input stream. +;; 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. -\[XEmacs emulating function]" - ((subr-fboundp 'string) - ;; for Emacs 20.3 or later - (read-event prompt t) - ) - (t - (if prompt (message prompt)) - (read-event) - )) - - (defsubst-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. [XEmacs emulating function]" - ch) - - (defsubst-maybe event-to-character (event) - "Return the character approximation to the given event object. -If the event isn't a keypress, this returns nil. -\[XEmacs emulating function]" - (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))) - ) - +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 prompt)) + (read-event)) + (t + (if prompt (message prompt)) + (read-char))) + -;;; @ MULE 2 emulation +;;; @ MULE 2 emulation. ;;; (defun-maybe-cond cancel-undo-boundary () - "Cancel undo boundary. [MULE 2.3 emulating function]" + "Cancel undo boundary." ((boundp 'buffer-undo-list) - ;; for Emacs 19.7 or later + ;; for Emacs 19 and later. (if (and (consp buffer-undo-list) - ;; if car is nil. (null (car buffer-undo-list))) - (setq buffer-undo-list (cdr buffer-undo-list)) - )) - (t - ;; for anything older than Emacs 19.7. - )) - + (setq buffer-undo-list (cdr buffer-undo-list))))) + -;;; @ end +;;; @ End. ;;; ;;; poe.el ends here diff --git a/pym.el b/pym.el new file mode 100644 index 0000000..ca6676d --- /dev/null +++ b/pym.el @@ -0,0 +1,293 @@ +;;; 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This module provides `def*-maybe' macros for conditional definition. +;; +;; Many APEL modules use these macros to provide emulation version of +;; 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 will be highly specialized for your environment. + +;; 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. +;; XXX: not defined yet. FIXME! +;; (def-edebug-spec static-if ...) +;; (def-edebug-spec static-when ...) +;; (def-edebug-spec static-unless ...) +;; (def-edebug-spec static-condition-case ...) +;; (def-edebug-spec static-defconst ...) +;; (def-edebug-spec static-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. + +(provide 'pym) + +;;; pym.el ends here -- 1.7.10.4