X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=poe.el;h=9812800d4c6a6cd79cbb45f4884ec6f9dc4f3961;hb=32c6ccb8bd45131c41dae0fe59e2720b1ad74498;hp=c7831c2ab1b23045bd4ce5fd304271305df615c3;hpb=3ddb0316d87760c1305afd2ab7e8450398616f2c;p=elisp%2Fapel.git

diff --git a/poe.el b/poe.el
index c7831c2..9812800 100644
--- a/poe.el
+++ b/poe.el
@@ -1,8 +1,8 @@
-;;; poe.el --- Emulate latest non-mule features; -*-byte-compile-dynamic: t;-*-
+;;; 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).
@@ -22,73 +22,148 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; 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))
+
+(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)))
-	     (progn
-	       (defun (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defun-maybe t)
-	       ))
-	 )))
+	     (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))))))
 
-(defmacro defsubst-maybe (name &rest everything-else)
+(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 'defsubst-maybe)))
+	   (not (get name 'defmacro-maybe)))
       (` (or (fboundp (quote (, name)))
-	     (progn
-	       (defsubst (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defsubst-maybe t)
-	       ))
-	 )))
+	     (prog1
+		 (defmacro (, name) (,@ everything-else))
+	       (setq current-load-list
+		     (cons (quote (, name)) current-load-list))
+	       (put (quote (, name)) 'defmacro-maybe t))))))
 
-(defmacro defmacro-maybe (name &rest everything-else)
+(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 'defmacro-maybe)))
+	   (not (get name 'defsubst-maybe)))
       (` (or (fboundp (quote (, name)))
-	     (progn
-	       (defmacro (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defmacro-maybe t)
-	       ))
-	 )))
+	     (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)))
-	     (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))
+	       (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)))
-	     (progn
-	       (defvar (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defvar-maybe t)
-	       ))
-	 )))
+	     (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))
-	   )
+	   (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))
+	       ;; 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
@@ -106,27 +181,76 @@
        )
       ((> emacs-major-version 20))
       ((= emacs-major-version 20)
-       (cond ((fboundp 'string)
+       (cond ((subr-fboundp 'string)
 	      ;; Emacs 20.3 or later
 	      )
-	     ((fboundp 'concat-chars)
+	     ((subr-fboundp 'concat-chars)
 	      ;; Emacs 20.1 or later
 	      (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)))
+
+;;; `eval-when-compile' is defined in "poe-18" under v18 with old compiler.
+(eval-when-compile (require 'static))
+
+;; `file-coding' was appeared in the spring of 1998, just before XEmacs
+;; 21.0.  Therefore it is not provided in XEmacs with MULE versions 20.4
+;; or earlier.
+(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 ([&not eval] [&rest sexp])]
+	   [&optional (eval [&optional ("interactive" interactive)] def-body)]
+	   &rest (&rest sexp)))
+(def-edebug-spec defmacro-maybe-cond
+  (&define name lambda-list
+	   [&rest ([&not 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))
 
+;; 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))
 
-;;; @ Emacs 19 emulation
-;;;
 
-(defmacro-maybe eval-and-compile (&rest body)
-  "Like `progn', but evaluates the body at compile time and at load time."
-  ;; Remember, it's magic.
-  (cons 'progn body))
+;;; @ Emacs 19.23 emulation
+;;;
 
 (defun-maybe minibuffer-prompt-width ()
   "Return the display width of the minibuffer prompt."
@@ -138,17 +262,19 @@
 ;;; @ Emacs 19.29 emulation
 ;;;
 
-(defvar path-separator ":"
-  "Character used to separate concatenated paths.")
+(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]"
+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.
@@ -161,32 +287,61 @@ STRING should be given if the last search was by `string-match' on STRING.
 	  (substring string (match-beginning num) (match-end num))
 	(buffer-substring (match-beginning num) (match-end num)))))
 
-(or (featurep 'xemacs)
-    (>= emacs-major-version 20)
-    (and (= emacs-major-version 19)
-	 (>= emacs-minor-version 29))
-    ;; for Emacs 19.28 or earlier
-    (fboundp 'si:read-string)
-    (eval-and-compile
-      (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.
+(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.
 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
-The third arg HISTORY, is dummy for compatibility. [emu.el]
+The third arg HISTORY, is dummy for compatibility.
 See `read-from-minibuffer' for details of HISTORY argument."
-	(si:read-string prompt initial-input))
-      ))
+      (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.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)))))
@@ -218,9 +373,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]"
@@ -230,29 +386,79 @@ Value is nil if OBJECT is not a buffer or if it has been killed.
 	      (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.2.
-(defmacro-maybe when (cond &rest body)
-  "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
-  (list 'if cond (cons 'progn body)))
+;; 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.
-(defmacro-maybe unless (cond &rest body)
-  "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
-  (cons 'if (cons cond (cons nil body))))
+;; 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))
-	 (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.
@@ -261,7 +467,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'.
@@ -281,7 +487,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'."
@@ -294,29 +500,24 @@ See also `with-temp-file' and `with-output-to-string'."
 	   (and (buffer-name (, temp-buffer))
 		(kill-buffer (, temp-buffer))))))))
 
-;; imported from Emacs 20.3.
-(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))
+(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. (cl function)
+;; 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)))
@@ -340,11 +541,145 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
 	    start (match-end 0)))
     (nreverse (cons (substring string start) parts))))
 
+;; emulating char-before of Emacs 20.
+(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.*.
+   ;; load-time check.
+   (or (fboundp 'si:char-before)
+       (progn
+         (fset 'si:char-before (symbol-function 'char-before))
+         (put 'char-before 'defun-maybe t)
+         ;; takes IGNORED for backward compatibility.
+         (defun char-before (&optional pos ignored)
+           "\
+Return character in current buffer preceding position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+           (si:char-before (or pos (point)))))))
+  (void-function                        ; non-Mule.
+   ;; load-time check.
+   (defun-maybe char-before (&optional pos)
+     "\
+Return character in current buffer preceding position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+     (if pos
+         (save-excursion
+           (and (= (goto-char pos) (point))
+                (not (bobp))
+                (preceding-char)))
+       (and (not (bobp))
+            (preceding-char)))))
+  (error                                ; found our definition at compile-time.
+   ;; load-time check.
+   (condition-case nil
+       (char-before)
+     (wrong-number-of-arguments         ; Mule 1.*, 2.*.
+      (or (fboundp 'si:char-before)
+          (progn
+            (fset 'si:char-before (symbol-function 'char-before))
+            (put 'char-before 'defun-maybe t)
+            ;; takes IGNORED for backward compatibility.
+            (defun char-before (&optional pos ignored)
+              "\
+Return character in current buffer preceding position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+              (si:char-before (or pos (point)))))))
+     (void-function                     ; non-Mule.
+      (defun-maybe char-before (&optional pos)
+        "\
+Return character in current buffer preceding position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+        (if pos
+            (save-excursion
+              (and (= (goto-char pos) (point))
+                   (not (bobp))
+                   (preceding-char)))
+          (and (not (bobp))
+               (preceding-char))))))))
+
+;; emulating char-after of Emacs 20.
+(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 "")))
+  (wrong-number-of-arguments		; v18, v19
+   ;; load-time check.
+   (or (fboundp 'si:char-after)
+       (progn
+         (fset 'si:char-after (symbol-function 'char-after))
+         (put 'char-after 'defun-maybe t)
+         (defun char-after (&optional pos)
+           "\
+Return character in current buffer at position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+           (si:char-after (or pos (point)))))))
+  (void-function			; NEVER happen?
+   ;; load-time check.
+   (defun-maybe char-after (&optional pos)
+     "\
+Return character in current buffer at position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+     (if pos
+         (save-excursion
+           (and (= (goto-char pos) (point))
+                (not (eobp))
+                (following-char)))
+       (and (not (eobp))
+            (following-char)))))
+  (error                                ; found our definition at compile-time.
+   ;; load-time check.
+   (condition-case nil
+       (char-after)
+     (wrong-number-of-arguments         ; v18, v19
+      (or (fboundp 'si:char-after)
+          (progn
+            (fset 'si:char-after (symbol-function 'char-after))
+            (put 'char-after 'defun-maybe t)
+	    (defun char-after (&optional pos)
+	      "\
+Return character in current buffer at position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+	      (si:char-after (or pos (point)))))))
+     (void-function                     ; NEVER happen?
+      (defun-maybe char-after (&optional pos)
+	"\
+Return character in current buffer at position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+	(if pos
+	    (save-excursion
+	      (and (= (goto-char pos) (point))
+		   (not (eobp))
+		   (following-char)))
+	  (and (not (eobp))
+	       (following-char))))))))
+
 
 ;;; @ Emacs 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))
@@ -361,10 +696,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)
@@ -373,16 +705,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
@@ -394,54 +722,98 @@ 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
+
+  (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)))
   )
 
 
-;;; @ end
+;;; @ MULE 2 emulation
 ;;;
 
-(provide 'poe)
+(defun-maybe-cond cancel-undo-boundary ()
+  "Cancel undo boundary. [MULE 2.3 emulating function]"
+  ((boundp 'buffer-undo-list)
+   ;; for Emacs 19.7 or 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.    
+   ))
+
+
+;;; @ end
+;;;
 
 ;;; poe.el ends here