-;;; -*-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")
-
-\f
-
-;;; @ optional settings
-;;;
-
-(defvar VERSION_SPECIFIC_LISPDIR
- (install-detect-elisp-directory PREFIX nil 'version-specific))
-
-(setq EMU_DIR (expand-file-name EMU_PREFIX VERSION_SPECIFIC_LISPDIR))
-
-;; It is generated by automatically. Please set variable `PREFIX'.
-;; If you don't like default directory tree, please set it.
-(defvar LISPDIR (install-detect-elisp-directory PREFIX))
-;; (setq install-default-elisp-directory "~/lib/emacs/lisp")
-
-(setq APEL_DIR (expand-file-name APEL_PREFIX LISPDIR))
-;; (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
-;;; -*-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)))
-;;; -*-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)
(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
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
1999-12-22 Yuuichi Teranishi <teranisi@gohome.org>
- * timezone.el: Modified comments.
- (toplevel): Require 'product.
-
-1999-12-21 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-
- * apel-ver.el: Footer fix.
+ * poe.el (string-to-int): Commented out an alias for
+ `string-to-number'.
1999-12-13 Katsumi Yamaoka <yamaoka@jpl.org>
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * pym.el (subr-fboundp): Reverted; but considered as obsolete.
+
+1999-12-05 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * poe.el, poe-18.el, poe-xemacs.el, pym.el: Modified comments.
+
+1999-11-25 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * poe-18.el: Modified comments.
+ (buffer-undo-list, data-directory): Use `defvar'.
+ (generate-new-buffer-name): Use `defun'.
+
+1999-11-22 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * APEL-MK, APEL-CFG, APEL-ELS, EMU-ELS, Makefile: Revised.
+
+1999-11-12 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * 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 <shuhei@aqua.ocn.ne.jp>
+
+ * APEL-MK: Require 'path-util explicitly.
+
+1999-11-12 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * APEL-MK, APEL-CFG, APEL-ELS, EMU-ELS: Rewritten.
+
+ * install.el: Removed v18 stuff; now we require 'poe.
+ Modified some comments.
+
+\f
+1999-12-22 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * timezone.el: Modified comments.
+ (toplevel): Require 'product.
+
+1999-12-21 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * apel-ver.el: Footer fix.
+
1999-12-21 Yuuichi Teranishi <teranisi@gohome.org>
* poe-18.el (current-time-zone): New function.
* poe-18.el (current-time-string, current-time): New functions.
-1999-11-12 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
-
- * 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 <shuhei@aqua.ocn.ne.jp>
* localhook.el, pcustom.el: checkdoc.
-;;; -*-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
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:
;;; 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
(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
(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
(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
;; 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)
(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
(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))
;;; 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
;;; 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)))
;;; 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))))
;;; 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
(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)))
(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)))
;; Copyright (C) 1998 Tanaka Akira
;; Author: Tanaka Akira <akr@jaist.ac.jp>
-;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: emulation, compatibility, Mule
;; This file is part of APEL (A Portable Emacs Library).
(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))
;;; 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 <tomo@m17n.org>
+;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: emulation, compatibility
;; This file is part of APEL (A Portable Emacs Library).
;;; 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)
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)))
(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)
"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)
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)
`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)
"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)
"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 `<NUMBER>', incrementing NUMBER
-until an unused name is found, and then return that name.
-Optional second argument IGNORE specifies a name that is okay to use
-\(if it is in the sequence to be tried)
-even if a buffer with that name exists."
- (if (get-buffer name)
- (let ((n 2) new)
- (while (get-buffer (setq new (format "%s<%d>" name n)))
- (setq n (1+ n)))
- new)
- name))
+(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.
;;;
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 `<NUMBER>', incrementing NUMBER
+until an unused name is found, and then return that name.
+Optional second argument IGNORE specifies a name that is okay to use
+\(if it is in the sequence to be tried\)
+even if a buffer with that name exists."
+ (if (get-buffer name)
+ (let ((n 2) new)
+ (while (get-buffer (setq new (format "%s<%d>" name n)))
+ (setq n (1+ n)))
+ new)
+ name))
+
+(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
-;;; 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
;;; 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.
(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
(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
;; 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
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)
-;;; 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 <tomo@m17n.org>
-;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
+;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Keywords: emulation, compatibility, Nemacs, MULE, Emacs/mule, XEmacs
;; This file is part of APEL (A Portable Emacs Library).
;;; 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))
+\f
-;;; @ 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
;; 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))
(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)
(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.
(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.
(save-excursion
(end-of-line (or n 1))
(point)))
+\f
+
+;;; @ 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))))
+\f
-(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))))
+\f
+
+;;; @ Basic editing commands emulation. (lisp/simple.el)
+;;;
+\f
+
+;;; @ 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))))
+\f
-
-;;; @ 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))
(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)))
+\f
-;;; @ 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)))))
+\f
-;;; @ end
+;;; @ End.
;;;
;;; poe.el ends here
--- /dev/null
+;;; pym.el --- Macros for Your Poe.
+
+;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; 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
projects / elisp / apel.git / commitdiff