X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=poe.el;h=03c4b09dac9609105d8f93dae2881135a20a9c65;hb=589e43b3abf40ddb3d60c0ac573a1cf9a69120f8;hp=aea989c6331a96d2546d4957ad77997658e40a8d;hpb=6b9a03eeeb2573ae2dedc66dddc5cbac9e5c906c;p=elisp%2Fapel.git

diff --git a/poe.el b/poe.el
index aea989c..03c4b09 100644
--- a/poe.el
+++ b/poe.el
@@ -1,8 +1,8 @@
 ;;; poe.el --- Portable Outfit for Emacsen; -*-byte-compile-dynamic: t;-*-
 
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
 
 ;; This file is part of APEL (A Portable Emacs Library).
@@ -24,107 +24,121 @@
 
 ;;; Commentary:
 
-;; This modules does not includes MULE related features.  MULE related
-;; features are supported by `poem'.
+;; This modules does not includes MULE related features.
+;; MULE related features are supported by `poem'.
 
 ;;; Code:
 
 (provide 'poe)
 
+(put 'defun-maybe 'lisp-indent-function 'defun)
+(put 'defun-maybe 'edebug-form-spec '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)))
-	     (progn
-	       (defun (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defun-maybe t)
-	       ))
-	 )))
+	     (prog1
+		 (defun (, name) (,@ everything-else))
+	       (put (quote (, name)) 'defun-maybe t))))))
 
+(put 'defmacro-maybe 'lisp-indent-function 'defun)
+(put 'defmacro-maybe 'edebug-form-spec '(&define name lambda-list def-body))
 (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)))
-	     (progn
-	       (defmacro (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defmacro-maybe t)
-	       ))
-	 )))
-
-(defmacro-maybe defsubst (name arglist &rest body)
-  "Define an inline function.  The syntax is just like that of `defun'."
-  (cons 'defun (cons name (cons arglist body)))
-  )
+	     (prog1
+		 (defmacro (, name) (,@ everything-else))
+	       (put (quote (, name)) 'defmacro-maybe t))))))
 
+(put 'defsubst-maybe 'lisp-indent-function 'defun)
+(put 'defsubst-maybe 'edebug-form-spec '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)))
-	     (progn
-	       (defsubst (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defsubst-maybe t)
-	       ))
-	 )))
+	     (prog1
+		 (defsubst (, name) (,@ everything-else))
+	       (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)))
-	     (progn
-	       (defalias (quote (, symbol)) (, definition))
-	       (put (quote (, symbol)) 'defalias-maybe t)
-	       ))
-	 )))
-
-(put 'defun-maybe 'lisp-indent-function 'defun)
-(put 'defsubst-maybe 'lisp-indent-function 'defun)
-(put 'defmacro-maybe 'lisp-indent-function 'defun)
+	     (prog1
+		 (defalias (quote (, symbol)) (, definition))
+	       (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)))
-	     (progn
-	       (defvar (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defvar-maybe t)
-	       ))
-	 )))
+	     (prog1
+		 (defvar (, name) (,@ everything-else))
+	       (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))
-	   )
+	   (not (get name 'defconst-maybe)))
       (` (or (boundp (quote (, name)))
-	     (progn
-	       (defconst (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defconst-maybe t)
-	       ))
-	 )))
+	     (prog1
+		 (defconst (, name) (,@ everything-else))
+	       (put (quote (, name)) 'defconst-maybe t))))))
 
 (defmacro defun-maybe-cond (name args &optional doc &rest everything-else)
-  (unless (stringp doc)
-    (setq everything-else (cons doc everything-else)
-	  doc nil)
-    )
+  (or (stringp doc)
+      (setq everything-else (cons doc everything-else)
+	    doc nil))
   (or (and (fboundp name)
 	   (not (get name 'defun-maybe)))
-      (` (unless (fboundp (quote (, name)))
-	   (cond (,@ (mapcar (function
-			      (lambda (case)
-				(list (car case)
-				      (if doc
-					  (` (defun (, name) (, args)
-					       (, doc)
-					       (,@ (cdr case))))
-					(` (defun (, name) (, args)
-					     (,@ (cdr case))))
-					))))
-			     everything-else)))
-	   (put (quote (, name)) 'defun-maybe t)
-	   ))))
-
-(defsubst subr-fboundp (symbol)
+      (` (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)))
+	       (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)))
+	       (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))))
@@ -153,9 +167,18 @@
 	      (defalias 'string 'concat-chars)
 	      ))
        )
-      ((= emacs-major-version 19))
+      ((= 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)
        ))
 
 ;;; @ Emacs 19.23 emulation
@@ -167,21 +190,22 @@
     (set-buffer (window-buffer (minibuffer-window)))
     (current-column)))
 
-
 ;;; @ Emacs 19.29 emulation
 ;;;
 
 (defvar-maybe path-separator ":"
-  "Character used to separate concatenated paths.")
+  "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]"
+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.
@@ -200,7 +224,7 @@ STRING should be given if the last search was by `string-match' on STRING.
 	 (>= emacs-minor-version 29))
     ;; for Emacs 19.28 or earlier
     (fboundp 'si:read-string)
-    (eval-and-compile
+    (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.
@@ -212,18 +236,19 @@ See `read-from-minibuffer' for details of HISTORY argument."
 
 (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."
+The value is actually the element of LIST whose cdr equals KEY.
+\[Emacs 19.29 emulating function]"
   (catch 'found
     (while list
       (if (equal (cdr (car list)) key)
-	  (throw 'found (car list))
-	)
-      (setq list (cdr list)))
-    ))
+	  (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 `.'."
+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)
@@ -234,32 +259,18 @@ The extension, in a file name, is the part that follows the last `.'."
 	    (substring file 0 (match-beginning 0)))
 	filename))))
 
-(defmacro-maybe make-local-hook (hook))
-
-;; They are not Emacs features
-
-(defmacro-maybe add-local-hook (hook function &optional append)
-  (if (fboundp 'make-local-hook)
-      (list 'add-hook hook function append t)
-    (list 'add-hook hook function append)
-    ))
-
-(defmacro-maybe remove-local-hook (hook function)
-  (if (fboundp 'make-local-hook)
-      (list 'remove-hook hook function t)
-    (list 'remove-hook hook function)
-    ))
-
-
 ;;; @ Emacs 19.30 emulation
 ;;;
 
-;; imported from Emacs 19.30.
+;; 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)))))
@@ -291,9 +302,10 @@ 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))))
+       (buffer-name (get-buffer object))
+       t))
 
-;; imported from Emacs 19.33.
+;; 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]"
@@ -307,17 +319,37 @@ Value is nil if OBJECT is not a buffer or if it has been killed.
 ;;; @ Emacs 20.1 emulation
 ;;;
 
-;; imported from Emacs 20.2.
+;; imported from emacs-20.3/lisp/subr.el.
 (defmacro-maybe when (cond &rest body)
-  "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
+  "If COND yields non-nil, do BODY, else return nil."
   (list 'if cond (cons 'progn body)))
 
-;; imported from Emacs 20.3.
+;; imported from emacs-20.3/lisp/subr.el.
 (defmacro-maybe unless (cond &rest body)
-  "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
+  "If COND yields nil, do BODY, else return nil."
   (cons 'if (cons cond (cons nil body))))
 
-;; imported from Emacs 20.3.
+;; 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.
@@ -333,15 +365,17 @@ If N is bigger than the length of X, return 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))
-	 (set-buffer orig-buffer)))))
+	 (if (buffer-live-p orig-buffer)
+	     (set-buffer orig-buffer))))))
 
-;; imported from Emacs 20.2.
+;; 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.
@@ -350,7 +384,7 @@ See also `with-temp-buffer'."
        (set-buffer (, buffer))
        (,@ body))))
 
-;; imported from Emacs 20.2.
+;; 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'.
@@ -370,7 +404,7 @@ See also `with-temp-buffer'."
 	   (and (buffer-name (, temp-buffer))
 		(kill-buffer (, temp-buffer))))))))
 
-;; imported from Emacs 20.2.
+;; 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'."
@@ -387,13 +421,20 @@ See also `with-temp-file' and `with-output-to-string'."
   "Execute BODY."
   (cons 'progn body))
 
-;; imported from Emacs 20.3. (cl function)
+;; 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. (cl function)
+;; 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)))
@@ -421,7 +462,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
 ;;; @ Emacs 20.3 emulation
 ;;;
 
-;; imported from Emacs 20.3.91.
+;; 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))
@@ -438,10 +479,7 @@ With argument N not nil or 1, move forward N - 1 lines first.
 If scan reaches end of buffer, return that position.
 This function does not move point."
   (save-excursion
-    (if n
-	(forward-line (1- n))
-      )
-    (beginning-of-line)
+    (forward-line (1- (or n 1)))
     (point)))
 
 (defun-maybe line-end-position (&optional n)
@@ -450,16 +488,12 @@ With argument N not nil or 1, move forward N - 1 lines first.
 If scan reaches end of buffer, return that position.
 This function does not move point."
   (save-excursion
-    (if n
-	(forward-line (1- n))
-      )
-    (end-of-line)
+    (end-of-line (or n 1))
     (point)))
 
 (defun-maybe string (&rest chars)
   "Concatenate all the argument characters and make the result a string."
-  (mapconcat (function char-to-string) chars "")
-  )
+  (mapconcat (function char-to-string) chars ""))
 
     
 ;;; @ XEmacs emulation
@@ -471,49 +505,37 @@ 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]"
-  (car (memq face-or-name (face-list)))
-  )
+  (car (memq face-or-name (face-list))))
 
 (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.
+\[XEmacs emulating function]"
   (save-excursion
-    (if buffer
-	(set-buffer buffer)
-      )
-    (line-beginning-position n)
-    ))
+    (if buffer (set-buffer buffer))
+    (forward-line (1- (or n 1)))
+    (point)))
 
 (defun-maybe point-at-eol (&optional n buffer)
   "Return the character position of the last character on the current line.
 With argument N not nil or 1, move forward N - 1 lines first.
 If scan reaches end of buffer, return that position.
-This function does not move point. [XEmacs emulating function]"
-  (save-excursion
-    (if buffer
-	(set-buffer buffer)
-      )
-    (line-end-position n)
-    ))
-
-(defun-maybe functionp (obj)
-  "Returns t if OBJ is a function, nil otherwise.
+This function does not move point.
 \[XEmacs emulating function]"
-  (or (subrp obj)
-      (byte-code-function-p obj)
-      (and (symbolp obj)(fboundp obj))
-      (and (consp obj)(eq (car obj) 'lambda))
-      ))
+  (save-excursion
+    (if buffer (set-buffer buffer))
+    (end-of-line (or n 1))
+    (point)))
 
 (defsubst-maybe define-obsolete-function-alias (oldfun newfun)
   "Define OLDFUN as an obsolete alias for function NEWFUN.
 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
-as obsolete. [XEmacs emulating function]"
+as obsolete.
+\[XEmacs emulating function]"
   (defalias oldfun newfun)
-  (make-obsolete oldfun newfun)
-  )
+  (make-obsolete oldfun newfun))
 
 (when (subr-fboundp 'read-event)
   ;; for Emacs 19 or later