update.

[elisp/apel.git] / poe.el

diff --git a/poe.el b/poe.el
index 70d191a..0c7b4ff 100644 (file)
--- a/poe.el
+++ b/poe.el
@@ -1,6 +1,7 @@
 ;;; poe.el --- Portable Outfit for Emacsen
 
 ;;; poe.el --- Portable Outfit for Emacsen
 

-;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2005,
+;;   2008 Free Software Foundation, Inc.

 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;;     Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;;     Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>

@@ -20,8 +21,8 @@
 
 ;; 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
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

@@ -75,7 +76,6 @@
    (or (fboundp 'si:require)
        (progn
         (fset 'si:require (symbol-function 'require))
    (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.
         (defun require (feature &optional filename noerror)
           "\
 If feature FEATURE is not loaded, load it from FILENAME.

@@ -90,7 +90,10 @@ Normally the return value is FEATURE."
               (condition-case nil
                   (si:require feature filename)
                 (file-error))
               (condition-case nil
                   (si:require feature filename)
                 (file-error))

-            (si:require feature filename)))))))
+            (si:require feature filename)))
+        ;; for `load-history'.
+        (setq current-load-list (cons 'require current-load-list))
+        (put 'require 'defun-maybe t)))))

 
 ;; Emacs 19.29 and later: (plist-get PLIST PROP)
 ;; (defun-maybe plist-get (plist prop)
 
 ;; Emacs 19.29 and later: (plist-get PLIST PROP)
 ;; (defun-maybe plist-get (plist prop)

@@ -178,6 +181,99 @@ The third arg HISTORY, is dummy for compatibility.
 See `read-from-minibuffer' for details of HISTORY argument."
          (si:read-string prompt initial-input)))))
 
 See `read-from-minibuffer' for details of HISTORY argument."
          (si:read-string prompt initial-input)))))
 

+;; (completing-read prompt table &optional
+;; FSF Emacs
+;;      --19.7  : predicate require-match init
+;; 19.7 --19.34 : predicate require-match init hist
+;; 20.1 --      : predicate require-match init hist def inherit-input-method
+;; XEmacs
+;;      --19.(?): predicate require-match init
+;;      --21.2  : predicate require-match init hist
+;; 21.2 --      : predicate require-match init hist def
+;; )
+
+;; We support following API.
+;; (completing-read prompt table
+;;                  &optional predicate require-match init hist def)
+(static-cond
+ ;; add 'hist' and 'def' argument.
+ ((< emacs-major-version 19)
+  (or (fboundp 'si:completing-read)
+      (progn
+       (fset 'si:completing-read (symbol-function 'completing-read))
+       (defun completing-read
+         (prompt table &optional predicate require-match init
+                                 hist def)
+       "Read a string in the minibuffer, with completion.
+PROMPT is a string to prompt with; normally it ends in a colon and a space.
+TABLE is an alist whose elements' cars are strings, or an obarray.
+PREDICATE limits completion to a subset of TABLE.
+See `try-completion' and `all-completions' for more details
+ on completion, TABLE, and PREDICATE.
+
+If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
+ the input is (or completes to) an element of TABLE or is null.
+ If it is also not t, Return does not exit if it does non-null completion.
+If the input is null, `completing-read' returns an empty string,
+ regardless of the value of REQUIRE-MATCH.
+
+If INIT is non-nil, insert it in the minibuffer initially.
+  If it is (STRING . POSITION), the initial input
+  is STRING, but point is placed POSITION characters into the string.
+HIST is ignored in this implementation.
+DEF, if non-nil, is the default value.
+
+Completion ignores case if the ambient value of
+  `completion-ignore-case' is non-nil."
+       (let ((string (si:completing-read prompt table predicate
+                                         require-match init)))
+         (if (and (string= string "") def)
+             def string))))))
+ ;; add 'def' argument.
+ ((or (and (featurep 'xemacs)
+          (or (and (eq emacs-major-version 21)
+                   (< emacs-minor-version 2))
+              (< emacs-major-version 21)))
+      (< emacs-major-version 20))
+  (or (fboundp 'si:completing-read)
+      (progn
+       (fset 'si:completing-read (symbol-function 'completing-read))
+       (defun completing-read
+         (prompt table &optional predicate require-match init
+                                 hist def)
+       "Read a string in the minibuffer, with completion.
+PROMPT is a string to prompt with; normally it ends in a colon and a space.
+TABLE is an alist whose elements' cars are strings, or an obarray.
+PREDICATE limits completion to a subset of TABLE.
+See `try-completion' and `all-completions' for more details
+ on completion, TABLE, and PREDICATE.
+
+If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
+ the input is (or completes to) an element of TABLE or is null.
+ If it is also not t, Return does not exit if it does non-null completion.
+If the input is null, `completing-read' returns an empty string,
+ regardless of the value of REQUIRE-MATCH.
+
+If INIT is non-nil, insert it in the minibuffer initially.
+  If it is (STRING . POSITION), the initial input
+  is STRING, but point is placed POSITION characters into the string.
+HIST, if non-nil, specifies a history list
+  and optionally the initial position in the list.
+  It can be a symbol, which is the history list variable to use,
+  or it can be a cons cell (HISTVAR . HISTPOS).
+  In that case, HISTVAR is the history list variable to use,
+  and HISTPOS is the initial position (the position in the list
+  which INIT corresponds to).
+  Positions are counted starting from 1 at the beginning of the list.
+DEF, if non-nil, is the default value.
+
+Completion ignores case if the ambient value of
+  `completion-ignore-case' is non-nil."
+       (let ((string (si:completing-read prompt table predicate
+                                         require-match init hist)))
+         (if (and (string= string "") def)
+             def string)))))))
+

 ;; v18:        (string-to-int STRING)
 ;; v19:        (string-to-number STRING)
 ;; v20:        (string-to-number STRING &optional BASE)
 ;; v18:        (string-to-int STRING)
 ;; v19:        (string-to-number STRING)
 ;; v20:        (string-to-number STRING &optional BASE)

@@ -197,7 +293,7 @@ See `read-from-minibuffer' for details of HISTORY argument."
         (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))
         (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.
+          ;; XXX: In v18, this causes infinite loop while byte-compiling.

           ;; (defalias 'string-to-int 'string-to-number)
           )
         (put 'string-to-number 'defun-maybe t)
           ;; (defalias 'string-to-int 'string-to-number)
           )
         (put 'string-to-number 'defun-maybe t)

@@ -428,6 +524,72 @@ This function does not move point."
   (save-excursion
     (end-of-line (or n 1))
     (point)))
   (save-excursion
     (end-of-line (or n 1))
     (point)))

+
+;; FSF Emacs 19.29 and later
+;; (read-file-name PROMPT &optional DIR DEFAULT-FILENAME MUSTMATCH INITIAL)
+;; XEmacs 19.14 and later:
+;; (read-file-name (PROMPT &optional DIR DEFAULT MUST-MATCH INITIAL-CONTENTS
+;;                         HISTORY)
+
+;; In FSF Emacs 19.28 and earlier (except for v18) or XEmacs 19.13 and
+;; earlier, this function is incompatible with the other Emacsen.
+;; For instance, if DEFAULT-FILENAME is nil, INITIAL is not and user
+;; enters a null string, it returns the visited file name of the current
+;; buffer if it is non-nil.
+
+;; It does not assimilate the different numbers of the optional arguments
+;; on various Emacsen (yet).
+(static-cond
+ ((and (not (featurep 'xemacs))
+       (eq emacs-major-version 19)
+       (< emacs-minor-version 29))
+  (if (fboundp 'si:read-file-name)
+      nil
+    (fset 'si:read-file-name (symbol-function 'read-file-name))
+    (defun read-file-name (prompt &optional dir default-filename mustmatch
+                                 initial)
+      "Read file name, prompting with PROMPT and completing in directory DIR.
+Value is not expanded---you must call `expand-file-name' yourself.
+Default name to DEFAULT-FILENAME if user enters a null string.
+ (If DEFAULT-FILENAME is omitted, the visited file name is used,
+  except that if INITIAL is specified, that combined with DIR is used.)
+Fourth arg MUSTMATCH non-nil means require existing file's name.
+ Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL specifies text to start with.
+DIR defaults to current buffer's directory default."
+      (si:read-file-name prompt dir
+                        (or default-filename
+                            (if initial
+                                (expand-file-name initial dir)))
+                        mustmatch initial))))
+ ((and (featurep 'xemacs)
+       (eq emacs-major-version 19)
+       (< emacs-minor-version 14))
+  (if (fboundp 'si:read-file-name)
+      nil
+    (fset 'si:read-file-name (symbol-function 'read-file-name))
+    (defun read-file-name (prompt &optional dir default must-match
+                                 initial-contents history)
+      "Read file name, prompting with PROMPT and completing in directory DIR.
+This will prompt with a dialog box if appropriate, according to
+ `should-use-dialog-box-p'.
+Value is not expanded---you must call `expand-file-name' yourself.
+Value is subject to interpreted by substitute-in-file-name however.
+Default name to DEFAULT if user enters a null string.
+ (If DEFAULT is omitted, the visited file name is used,
+  except that if INITIAL-CONTENTS is specified, that combined with DIR is
+  used.)
+Fourth arg MUST-MATCH non-nil means require existing file's name.
+ Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL-CONTENTS specifies text to start with.
+Sixth arg HISTORY specifies the history list to use.  Default is
+ `file-name-history'.
+DIR defaults to current buffer's directory default."
+      (si:read-file-name prompt dir
+                        (or default
+                            (if initial-contents
+                                (expand-file-name initial-contents dir)))
+                        must-match initial-contents history)))))

 \f
 
 ;;; @ Basic lisp subroutines emulation. (lisp/subr.el)
 \f
 
 ;;; @ Basic lisp subroutines emulation. (lisp/subr.el)

@@ -530,7 +692,7 @@ If TEST is omitted or nil, `equal' is used."
 ;; (defun assoc-ignore-case (key alist))
 ;; (defun assoc-ignore-representation (key alist))
 
 ;; (defun assoc-ignore-case (key alist))
 ;; (defun assoc-ignore-representation (key alist))
 

-;; Emacs 19.29/XEmacs 19.14(?) and later: (rassoc KEY LIST)
+;; Emacs 19.29/XEmacs 19.13 and later: (rassoc KEY LIST)

 ;; Actually, `rassoc' is defined in src/fns.c.
 (defun-maybe rassoc (key list)
   "Return non-nil if KEY is `equal' to the cdr of an element of LIST.
 ;; 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.

@@ -543,6 +705,98 @@ Elements of LIST that are not conses are ignored."
             (throw 'found (car list))))
       (setq list (cdr list)))))
 
             (throw 'found (car list))))
       (setq list (cdr list)))))
 

+;; XEmacs 19.13 and later: (remassoc KEY ALIST)
+(defun-maybe remassoc (key alist)
+  "Delete by side effect any elements of ALIST whose car is `equal' to KEY.
+The modified ALIST is returned.  If the first member of ALIST has a car
+that is `equal' to KEY, there is no way to remove it by side effect;
+therefore, write `(setq foo (remassoc key foo))' to be sure of changing
+the value of `foo'."
+  (while (and (consp alist)
+              (or (not (consp (car alist)))
+                  (equal (car (car alist)) key)))
+    (setq alist (cdr alist)))
+  (if (consp alist)
+      (let ((prev alist)
+            (tail (cdr alist)))
+        (while (consp tail)
+          (if (and (consp (car alist))
+                   (equal (car (car tail)) key))
+              ;; `(setcdr CELL NEWCDR)' returns NEWCDR.
+              (setq tail (setcdr prev (cdr tail)))
+            (setq prev (cdr prev)
+                  tail (cdr tail))))))
+  alist)
+
+;; XEmacs 19.13 and later: (remassq KEY ALIST)
+(defun-maybe remassq (key alist)
+  "Delete by side effect any elements of ALIST whose car is `eq' to KEY.
+The modified ALIST is returned.  If the first member of ALIST has a car
+that is `eq' to KEY, there is no way to remove it by side effect;
+therefore, write `(setq foo (remassq key foo))' to be sure of changing
+the value of `foo'."
+  (while (and (consp alist)
+              (or (not (consp (car alist)))
+                  (eq (car (car alist)) key)))
+    (setq alist (cdr alist)))
+  (if (consp alist)
+      (let ((prev alist)
+            (tail (cdr alist)))
+        (while (consp tail)
+          (if (and (consp (car tail))
+                   (eq (car (car tail)) key))
+              ;; `(setcdr CELL NEWCDR)' returns NEWCDR.
+              (setq tail (setcdr prev (cdr tail)))
+            (setq prev (cdr prev)
+                  tail (cdr tail))))))
+  alist)
+
+;; XEmacs 19.13 and later: (remrassoc VALUE ALIST)
+(defun-maybe remrassoc (value alist)
+  "Delete by side effect any elements of ALIST whose cdr is `equal' to VALUE.
+The modified ALIST is returned.  If the first member of ALIST has a car
+that is `equal' to VALUE, there is no way to remove it by side effect;
+therefore, write `(setq foo (remrassoc value foo))' to be sure of changing
+the value of `foo'."
+  (while (and (consp alist)
+              (or (not (consp (car alist)))
+                  (equal (cdr (car alist)) value)))
+    (setq alist (cdr alist)))
+  (if (consp alist)
+      (let ((prev alist)
+            (tail (cdr alist)))
+        (while (consp tail)
+          (if (and (consp (car tail))
+                   (equal (cdr (car tail)) value))
+              ;; `(setcdr CELL NEWCDR)' returns NEWCDR.
+              (setq tail (setcdr prev (cdr tail)))
+            (setq prev (cdr prev)
+                  tail (cdr tail))))))
+  alist)
+
+;; XEmacs 19.13 and later: (remrassq VALUE ALIST)
+(defun-maybe remrassq (value alist)
+  "Delete by side effect any elements of ALIST whose cdr is `eq' to VALUE.
+The modified ALIST is returned.  If the first member of ALIST has a car
+that is `eq' to VALUE, there is no way to remove it by side effect;
+therefore, write `(setq foo (remrassq value foo))' to be sure of changing
+the value of `foo'."
+  (while (and (consp alist)
+              (or (not (consp (car alist)))
+                  (eq (cdr (car alist)) value)))
+    (setq alist (cdr alist)))
+  (if (consp alist)
+      (let ((prev alist)
+            (tail (cdr alist)))
+        (while (consp tail)
+          (if (and (consp (car tail))
+                   (eq (cdr (car tail)) value))
+              ;; `(setcdr CELL NEWCDR)' returns NEWCDR.
+              (setq tail (setcdr prev (cdr tail)))
+            (setq prev (cdr prev)
+                  tail (cdr tail))))))
+  alist)
+

 ;;; Define `functionp' here because "localhook" uses it.
 
 ;; Emacs 20.1/XEmacs 20.3 (but first appeared in Epoch?): (functionp OBJECT)
 ;;; Define `functionp' here because "localhook" uses it.
 
 ;; Emacs 20.1/XEmacs 20.3 (but first appeared in Epoch?): (functionp OBJECT)

@@ -644,6 +898,11 @@ 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.")
 
 On those systems, it is automatically local in every buffer.
 On other systems, this variable is normally always nil.")
 

+;; Emacs 20.3 or later.
+(defvar-maybe minor-mode-overriding-map-alist nil
+  "Alist of keymaps to use for minor modes, in current major mode.
+APEL provides this as dummy for compatibility.")
+

 ;; Emacs 20.1/XEmacs 20.3(?) and later: (save-current-buffer &rest BODY)
 ;;
 ;; v20 defines `save-current-buffer' as a C primitive (in src/editfns.c)
 ;; 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)

@@ -788,20 +1047,539 @@ STRING should be given if the last search was by `string-match' on STRING."
        (buffer-substring-no-properties (match-beginning num)
                                        (match-end num)))))
 
        (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 19.28 and earlier
+;;  (replace-match NEWTEXT &optional FIXEDCASE LITERAL)
+;; Emacs 20.x (?) and later
+;;  (replace-match NEWTEXT &optional FIXEDCASE LITERAL STRING SUBEXP)
+;; XEmacs 21:
+;;  (replace-match NEWTEXT &optional FIXEDCASE LITERAL STRING STRBUFFER)
+;; We support following API.
+;;  (replace-match NEWTEXT &optional FIXEDCASE LITERAL STRING)
+(static-condition-case nil
+    ;; compile-time check
+    (progn
+      (string-match "" "")
+      (replace-match "" nil nil "")
+      (if (get 'replace-match 'defun-maybe)
+         (error "`replace-match' is already defined")))
+  (wrong-number-of-arguments ; Emacs 19.28 and earlier
+   ;; load-time check.
+   (or (fboundp 'si:replace-match)
+       (progn
+        (fset 'si:replace-match (symbol-function 'replace-match))
+        (put 'replace-match 'defun-maybe t)
+        (defun replace-match (newtext &optional fixedcase literal string)
+          "Replace text matched by last search with NEWTEXT.
+If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
+Otherwise maybe capitalize the whole text, or maybe just word initials,
+based on the replaced text.
+If the replaced text has only capital letters
+and has at least one multiletter word, convert NEWTEXT to all caps.
+If the replaced text has at least one word starting with a capital letter,
+then capitalize each word in NEWTEXT.
+
+If third arg LITERAL is non-nil, insert NEWTEXT literally.
+Otherwise treat `\' as special:
+  `\&' in NEWTEXT means substitute original matched text.
+  `\N' means substitute what matched the Nth `\(...\)'.
+       If Nth parens didn't match, substitute nothing.
+  `\\' means insert one `\'.
+FIXEDCASE and LITERAL are optional arguments.
+Leaves point at end of replacement text.
+
+The optional fourth argument STRING can be a string to modify.
+In that case, this function creates and returns a new string
+which is made by replacing the part of STRING that was matched."
+          (if string
+              (with-temp-buffer
+               (save-match-data
+                 (insert string)
+                 (let* ((matched (match-data))
+                        (beg (nth 0 matched))
+                        (end (nth 1 matched)))
+                   (store-match-data
+                    (list
+                     (if (markerp beg)
+                         (move-marker beg (1+ (match-beginning 0)))
+                       (1+ (match-beginning 0)))
+                     (if (markerp end)
+                         (move-marker end (1+ (match-end 0)))
+                       (1+ (match-end 0))))))
+                 (si:replace-match newtext fixedcase literal)
+                 (buffer-string)))
+            (si:replace-match newtext fixedcase literal))))))
+  (error ; found our definition at compile-time.
+   ;; load-time check.
+   (condition-case nil
+    (progn
+      (string-match "" "")
+      (replace-match "" nil nil ""))
+    (wrong-number-of-arguments ; Emacs 19.28 and earlier
+     ;; load-time check.
+     (or (fboundp 'si:replace-match)
+        (progn
+          (fset 'si:replace-match (symbol-function 'replace-match))
+          (put 'replace-match 'defun-maybe t)
+          (defun replace-match (newtext &optional fixedcase literal string)
+            "Replace text matched by last search with NEWTEXT.
+If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
+Otherwise maybe capitalize the whole text, or maybe just word initials,
+based on the replaced text.
+If the replaced text has only capital letters
+and has at least one multiletter word, convert NEWTEXT to all caps.
+If the replaced text has at least one word starting with a capital letter,
+then capitalize each word in NEWTEXT.
+
+If third arg LITERAL is non-nil, insert NEWTEXT literally.
+Otherwise treat `\' as special:
+  `\&' in NEWTEXT means substitute original matched text.
+  `\N' means substitute what matched the Nth `\(...\)'.
+       If Nth parens didn't match, substitute nothing.
+  `\\' means insert one `\'.
+FIXEDCASE and LITERAL are optional arguments.
+Leaves point at end of replacement text.
+
+The optional fourth argument STRING can be a string to modify.
+In that case, this function creates and returns a new string
+which is made by replacing the part of STRING that was matched."
+            (if string
+                (with-temp-buffer
+                 (save-match-data
+                   (insert string)
+                   (let* ((matched (match-data))
+                          (beg (nth 0 matched))
+                          (end (nth 1 matched)))
+                     (store-match-data
+                      (list
+                       (if (markerp beg)
+                           (move-marker beg (1+ (match-beginning 0)))
+                         (1+ (match-beginning 0)))
+                       (if (markerp end)
+                           (move-marker end (1+ (match-end 0)))
+                         (1+ (match-end 0))))))
+                   (si:replace-match newtext fixedcase literal)
+                   (buffer-string)))
+              (si:replace-match newtext fixedcase literal)))))))))
+
+;; Emacs 20: (format-time-string FORMAT &optional TIME UNIVERSAL)
+;; Those format constructs are yet to be implemented.
+;;   %c, %C, %j, %U, %W, %x, %X
+;; Not fully compatible especially when invalid format is specified.
+(static-unless (and (fboundp 'format-time-string)
+                   (not (get 'format-time-string 'defun-maybe)))
+  (or (fboundp 'format-time-string)
+  (progn
+  (defconst format-time-month-list
+    '(( "Zero" . ("Zero" . 0))
+      ("Jan" . ("January" . 1)) ("Feb" . ("February" . 2))
+      ("Mar" . ("March" . 3)) ("Apr" . ("April" . 4)) ("May" . ("May" . 5))
+      ("Jun" . ("June" . 6))("Jul" . ("July" . 7)) ("Aug" . ("August" . 8))
+      ("Sep" . ("September" . 9)) ("Oct" . ("October" . 10))
+      ("Nov" . ("November" . 11)) ("Dec" . ("December" . 12)))
+    "Alist of months and their number.")
+
+  (defconst format-time-week-list
+    '(("Sun" . ("Sunday" . 0)) ("Mon" . ("Monday" . 1))
+      ("Tue" . ("Tuesday" . 2)) ("Wed" . ("Wednesday" . 3))
+      ("Thu" . ("Thursday" . 4)) ("Fri" . ("Friday" . 5))
+      ("Sat" . ("Saturday" . 6)))
+    "Alist of weeks and their number.")
+
+  (defun format-time-string (format &optional time universal)
+    "Use FORMAT-STRING to format the time TIME, or now if omitted.
+TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by
+`current-time' or `file-attributes'.
+The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
+as Universal Time; nil means describe TIME in the local time zone.
+The value is a copy of FORMAT-STRING, but with certain constructs replaced
+by text that describes the specified date and time in TIME:
+
+%Y is the year, %y within the century, %C the century.
+%G is the year corresponding to the ISO week, %g within the century.
+%m is the numeric month.
+%b and %h are the locale's abbreviated month name, %B the full name.
+%d is the day of the month, zero-padded, %e is blank-padded.
+%u is the numeric day of week from 1 (Monday) to 7, %w from 0 (Sunday) to 6.
+%a is the locale's abbreviated name of the day of week, %A the full name.
+%U is the week number starting on Sunday, %W starting on Monday,
+ %V according to ISO 8601.
+%j is the day of the year.
+
+%H is the hour on a 24-hour clock, %I is on a 12-hour clock, %k is like %H
+ only blank-padded, %l is like %I blank-padded.
+%p is the locale's equivalent of either AM or PM.
+%M is the minute.
+%S is the second.
+%Z is the time zone name, %z is the numeric form.
+%s is the number of seconds since 1970-01-01 00:00:00 +0000.
+
+%c is the locale's date and time format.
+%x is the locale's \"preferred\" date format.
+%D is like \"%m/%d/%y\".
+
+%R is like \"%H:%M\", %T is like \"%H:%M:%S\", %r is like \"%I:%M:%S %p\".
+%X is the locale's \"preferred\" time format.
+
+Finally, %n is a newline, %t is a tab, %% is a literal %.
+
+Certain flags and modifiers are available with some format controls.
+The flags are `_' and `-'.  For certain characters X, %_X is like %X,
+but padded with blanks; %-X is like %X, but without padding.
+%NX (where N stands for an integer) is like %X,
+but takes up at least N (a number) positions.
+The modifiers are `E' and `O'.  For certain characters X,
+%EX is a locale's alternative version of %X;
+%OX is like %X, but uses the locale's number symbols.
+
+For example, to produce full ISO 8601 format, use \"%Y-%m-%dT%T%z\".
+
+Compatibility Note.
+
+Those format constructs are yet to be implemented.
+  %c, %C, %j, %U, %W, %x, %X
+Not fully compatible especially when invalid format is specified."
+    (let ((fmt-len (length format))
+         (ind 0)
+         prev-ind
+         cur-char
+         (prev-char nil)
+         strings-so-far
+         (result "")
+         field-width
+         field-result
+         pad-left change-case
+         (paren-level 0)
+         hour ms ls
+         (tz (car (current-time-zone)))
+         time-string)
+      (if universal
+         (progn
+           (or time
+               (setq time (current-time)))
+           (setq ms (car time)
+                 ls (- (nth 1 time) tz))
+           (cond ((< ls 0)
+                  (setq ms (1- ms)
+                        ls (+ ls 65536)))
+                 ((>= ls 65536)
+                  (setq ms (1+ ms)
+                        ls (- ls 65536))))
+           (setq time (append (list ms ls) (nth 2 time)))))
+      (setq time-string (current-time-string time)
+           hour (string-to-int (substring time-string 11 13)))
+      (while (< ind fmt-len)
+       (setq cur-char (aref format ind))
+       (setq
+        result
+        (concat result
+       (cond
+        ((eq cur-char ?%)
+         ;; eat any additional args to allow for future expansion, not!!
+         (setq pad-left nil change-case nil field-width "" prev-ind ind
+               strings-so-far "")
+;        (catch 'invalid
+         (while (progn
+                  (setq ind (1+ ind))
+                  (setq cur-char (if (< ind fmt-len)
+                                     (aref format ind)
+                                   ?\0))
+                  (or (eq ?- cur-char) ; pad on left
+                      (eq ?# cur-char) ; case change
+                      (if (and (string-equal field-width "")
+                               (<= ?0 cur-char) (>= ?9 cur-char))
+                          ;; get format width
+                          (let ((field-index ind))
+                            (while (progn
+                                     (setq ind (1+ ind))
+                                     (setq cur-char (if (< ind fmt-len)
+                                                        (aref format ind)
+                                                      ?\0))
+                                     (and (<= ?0 cur-char) (>= ?9 cur-char))))
+                            (setq field-width
+                                  (substring format field-index ind))
+                            (setq ind (1- ind)
+                                  cur-char nil)
+                            t))))
+           (setq prev-char cur-char
+                 strings-so-far (concat strings-so-far
+                                        (if cur-char
+                                            (char-to-string cur-char)
+                                          field-width)))
+           ;; characters we actually use
+           (cond ((eq cur-char ?-)
+                  ;; padding to left must be specified before field-width
+                  (setq pad-left (string-equal field-width "")))
+                 ((eq cur-char ?#)
+                  (setq change-case t))))
+         (setq field-result
+               (cond
+                ((eq cur-char ?%)
+                 "%")
+                ;; the abbreviated name of the day of week.
+                ((eq cur-char ?a)
+                 (substring time-string 0 3))
+                ;; the full name of the day of week
+                ((eq cur-char ?A)
+                 (cadr (assoc (substring time-string 0 3)
+                              format-time-week-list)))
+                ;; the abbreviated name of the month
+                ((eq cur-char ?b)
+                 (substring time-string 4 7))
+                ;; the full name of the month
+                ((eq cur-char ?B)
+                 (cadr (assoc (substring time-string 4 7)
+                              format-time-month-list)))
+                ;; a synonym for `%x %X' (yet to come)
+                ((eq cur-char ?c)
+                 "")
+                ;; locale specific (yet to come)
+                ((eq cur-char ?C)
+                 "")
+                ;; the day of month, zero-padded
+                ((eq cur-char ?d)
+                 (format "%02d" (string-to-int (substring time-string 8 10))))
+                ;; a synonym for `%m/%d/%y'
+                ((eq cur-char ?D)
+                 (format "%02d/%02d/%s"
+                         (cddr (assoc (substring time-string 4 7)
+                                      format-time-month-list))
+                         (string-to-int (substring time-string 8 10))
+                         (substring time-string -2)))
+                ;; the day of month, blank-padded
+                ((eq cur-char ?e)
+                 (format "%2d" (string-to-int (substring time-string 8 10))))
+                ;; a synonym for `%b'
+                ((eq cur-char ?h)
+                 (substring time-string 4 7))
+                ;; the hour (00-23)
+                ((eq cur-char ?H)
+                 (substring time-string 11 13))
+                ;; the hour (00-12)
+                ((eq cur-char ?I)
+                 (format "%02d" (if (> hour 12) (- hour 12) hour)))
+                ;; the day of the year (001-366) (yet to come)
+                ((eq cur-char ?j)
+                 "")
+                ;; the hour (0-23), blank padded
+                ((eq cur-char ?k)
+                 (format "%2d" hour))
+                ;; the hour (1-12), blank padded
+                ((eq cur-char ?l)
+                 (format "%2d" (if (> hour 12) (- hour 12) hour)))
+                ;; the month (01-12)
+                ((eq cur-char ?m)
+                 (format "%02d" (cddr (assoc (substring time-string 4 7)
+                                             format-time-month-list))))
+                ;; the minute (00-59)
+                ((eq cur-char ?M)
+                 (substring time-string 14 16))
+                ;; a newline
+                ((eq cur-char ?n)
+                 "\n")
+                ;; `AM' or `PM', as appropriate
+                ((eq cur-char ?p)
+                 (setq change-case (not change-case))
+                 (if (> hour 12) "pm" "am"))
+                ;; a synonym for `%I:%M:%S %p'
+                ((eq cur-char ?r)
+                 (format "%02d:%s:%s %s"
+                         (if (> hour 12) (- hour 12) hour)
+                         (substring time-string 14 16)
+                         (substring time-string 17 19)
+                         (if (> hour 12) "PM" "AM")))
+                ;; a synonym for `%H:%M'
+                ((eq cur-char ?R)
+                 (format "%s:%s"
+                         (substring time-string 11 13)
+                         (substring time-string 14 16)))
+                ;; the seconds (00-60)
+                ((eq cur-char ?S)
+                 (substring time-string 17 19))
+                ;; a tab character
+                ((eq cur-char ?t)
+                 "\t")
+                ;; a synonym for `%H:%M:%S'
+                ((eq cur-char ?T)
+                 (format "%s:%s:%s"
+                         (substring time-string 11 13)
+                         (substring time-string 14 16)
+                         (substring time-string 17 19)))
+                ;; the week of the year (01-52), assuming that weeks
+                ;; start on Sunday (yet to come)
+                ((eq cur-char ?U)
+                 "")
+                ;; the numeric day of week (0-6).  Sunday is day 0
+                ((eq cur-char ?w)
+                 (format "%d" (cddr (assoc (substring time-string 0 3)
+                                           format-time-week-list))))
+                ;; the week of the year (01-52), assuming that weeks
+                ;; start on Monday (yet to come)
+                ((eq cur-char ?W)
+                 "")
+                ;; locale specific (yet to come)
+                ((eq cur-char ?x)
+                 "")
+                ;; locale specific (yet to come)
+                ((eq cur-char ?X)
+                 "")
+                ;; the year without century (00-99)
+                ((eq cur-char ?y)
+                 (substring time-string -2))
+                ;; the year with century
+                ((eq cur-char ?Y)
+                 (substring time-string -4))
+                ;; the time zone abbreviation
+                ((eq cur-char ?Z)
+                 (if universal
+                     "UTC"
+                   (setq change-case (not change-case))
+                   (downcase (cadr (current-time-zone)))))
+                ((eq cur-char ?z)
+                 (if universal
+                     "+0000"
+                   (if (< tz 0)
+                       (format "-%02d%02d"
+                               (/ (- tz) 3600) (/ (% (- tz) 3600) 60))
+                     (format "+%02d%02d"
+                             (/ tz 3600) (/ (% tz 3600) 60)))))
+                (t
+                 (concat
+                  "%"
+                  strings-so-far
+                  (char-to-string cur-char)))))
+;                (setq ind prev-ind)
+;                (throw 'invalid "%"))))
+         (if (string-equal field-width "")
+             (if change-case (upcase field-result) field-result)
+           (let ((padded-result
+                  (format (format "%%%s%s%c"
+                                  ""   ; pad on left is ignored
+;                                 (if pad-left "-" "")
+                                  field-width
+                                  ?s)
+                          (or field-result ""))))
+             (let ((initial-length (length padded-result))
+                   (desired-length (string-to-int field-width)))
+               (when (and (string-match "^0" field-width)
+                          (string-match "^ +" padded-result))
+                 (setq padded-result
+                       (replace-match
+                        (make-string
+                         (length (match-string 0 padded-result)) ?0)
+                        nil nil padded-result)))
+               (if (> initial-length desired-length)
+                   ;; truncate strings on right, years on left
+                   (if (stringp field-result)
+                       (substring padded-result 0 desired-length)
+                     (if (eq cur-char ?y)
+                         (substring padded-result (- desired-length))
+                       padded-result))) ;non-year numbers don't truncate
+               (if change-case (upcase padded-result) padded-result))))) ;)
+        (t
+         (char-to-string cur-char)))))
+       (setq ind (1+ ind)))
+      result))
+  ;; for `load-history'.
+  (setq current-load-list (cons 'format-time-string current-load-list))
+  (put 'format-time-string 'defun-maybe t))))
+
+;; Emacs 19.29-19.34/XEmacs: `format-time-string' neither supports the
+;; format string "%z" nor the third argument `universal'.
+(unless (string-match "\\`[---+][0-9]+\\'"
+                     (format-time-string "%z" (current-time)))
+  (defadvice format-time-string
+    (before support-timezone-in-numeric-form-and-3rd-arg
+           (format-string &optional time universal) activate compile)
+    "Advice to support the construct `%z' and the third argument `universal'."
+    (let ((tz (car (current-time-zone)))
+         case-fold-search ms ls)
+      (while (string-match "\\(\\(\\`\\|[^%]\\)\\(%%\\)*\\)%z" format-string)
+       (setq format-string
+             (concat (substring format-string 0 (match-end 1))
+                     (if universal
+                         "+0000"
+                       (if (< tz 0)
+                           (format "-%02d%02d"
+                                   (/ (- tz) 3600) (/ (% (- tz) 3600) 60))
+                         (format "+%02d%02d"
+                                 (/ tz 3600) (/ (% tz 3600) 60))))
+                     (substring format-string (match-end 0)))))
+      (if universal
+         (progn
+           (while (string-match "\\(\\(\\`\\|[^%]\\)\\(%%\\)*\\)%Z"
+                                format-string)
+             (setq format-string
+                   (concat (substring format-string 0 (match-end 1))
+                           "UTC"
+                           (substring format-string (match-end 0)))))
+           (or time
+               (setq time (current-time)))
+           (setq ms (car time)
+                 ls (- (nth 1 time) tz))
+           (cond ((< ls 0)
+                  (setq ms (1- ms)
+                        ls (+ ls 65536)))
+                 ((>= ls 65536)
+                  (setq ms (1+ ms)
+                        ls (- ls 65536))))
+           (setq time (append (list ms ls) (nth 2 time))))))))
+
+(defconst-maybe split-string-default-separators "[ \f\t\n\r\v]+"
+  "The default value of separators for `split-string'.
+
+A regexp matching strings of whitespace.  May be locale-dependent
+\(as yet unimplemented).  Should not match non-breaking spaces.
+
+Warning: binding this to a different value and using it as default is
+likely to have undesired semantics.")
+
+;; Here is a Emacs 22 version. OMIT-NULLS
+(defun-maybe split-string (string &optional separators omit-nulls)
+  "Split STRING into substrings bounded by matches for SEPARATORS.
+
+The beginning and end of STRING, and each match for SEPARATORS, are
+splitting points.  The substrings matching SEPARATORS are removed, and
+the substrings between the splitting points are collected as a list,
+which is returned.
+
+If SEPARATORS is non-nil, it should be a regular expression matching text
+which separates, but is not part of, the substrings.  If nil it defaults to
+`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and
+OMIT-NULLS is forced to t.
+
+If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so
+that for the default value of SEPARATORS leading and trailing whitespace
+are effectively trimmed).  If nil, all zero-length substrings are retained,
+which correctly parses CSV format, for example.
+
+Note that the effect of `(split-string STRING)' is the same as
+`(split-string STRING split-string-default-separators t)').  In the rare
+case that you wish to retain zero-length substrings when splitting on
+whitespace, use `(split-string STRING split-string-default-separators)'.
+
+Modifies the match data; use `save-match-data' if necessary."
+  (let ((keep-nulls (not (if separators omit-nulls t)))
+       (rexp (or separators split-string-default-separators))
+       (start 0)
+       notfirst
+       (list nil))
+    (while (and (string-match rexp string
+                             (if (and notfirst
+                                      (= start (match-beginning 0))
+                                      (< start (length string)))
+                                 (1+ start) start))
+               (< start (length string)))
+      (setq notfirst t)
+      (if (or keep-nulls (< start (match-beginning 0)))
+         (setq list
+               (cons (substring string start (match-beginning 0))
+                     list)))
+      (setq start (match-end 0)))
+    (if (or keep-nulls (< start (length string)))
+       (setq list
+             (cons (substring string start)
+                   list)))
+    (nreverse list)))

 \f
 
 ;;; @ Window commands emulation. (lisp/window.el)
 \f
 
 ;;; @ Window commands emulation. (lisp/window.el)

@@ -814,6 +1592,33 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
        (list 'unwind-protect
              (cons 'progn body)
              (list 'select-window 'save-selected-window-window))))
        (list 'unwind-protect
              (cons 'progn body)
              (list 'select-window 'save-selected-window-window))))

+
+;; Emacs 19.31 and later:
+;;  (get-buffer-window-list &optional BUFFER MINIBUF FRAME)
+(defun-maybe get-buffer-window-list (buffer &optional minibuf frame)
+  "Return windows currently displaying BUFFER, or nil if none.
+See `walk-windows' for the meaning of MINIBUF and FRAME."
+  (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
+    (walk-windows
+     (function (lambda (window)
+                (if (eq (window-buffer window) buffer)
+                    (setq windows (cons window windows)))))
+     minibuf frame)
+    windows))
+\f
+
+;;; @ Frame commands emulation. (lisp/frame.el)
+;;;
+
+;; XEmacs 21.0 and later:
+;;  (save-selected-frame &rest BODY)
+(defmacro-maybe save-selected-frame (&rest body)
+  "Execute forms in BODY, then restore the selected frame."
+  (list 'let
+       '((save-selected-frame-frame (selected-frame)))
+       (list 'unwind-protect
+             (cons 'progn body)
+             (list 'select-frame 'save-selected-frame-frame))))

 \f
 
 ;;; @ Basic editing commands emulation. (lisp/simple.el)
 \f
 
 ;;; @ Basic editing commands emulation. (lisp/simple.el)

@@ -833,6 +1638,190 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
          (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
   "The directory for writing temporary files.")
 
          (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
   "The directory for writing temporary files.")
 

+;; Emacs 21 CVS         ; nothing to do.
+;;  (make-temp-file PREFIX &optional DIR-FLAG SUFFIX)
+;;
+;; Emacs 21.1-21.3      ; replace with CVS version of `make-temp-file'.
+;;  (make-temp-file PREFIX &optional DIR-FLAG)
+;;
+;; Emacs 20 and earlier ; install our version of `make-temp-file', for
+;;  or XEmacs          ; single-user system or for multi-user system.
+(eval-when-compile
+  (cond
+   ((get 'make-temp-file 'defun-maybe)
+    ;; this form is already evaluated during compilation.
+    )
+   ((not (fboundp 'make-temp-file))
+    ;; Emacs 20 and earlier, or XEmacs.
+    (put 'make-temp-file 'defun-maybe 'none))
+   (t
+    (let* ((object (symbol-function 'make-temp-file))
+           (arglist (cond
+                     ((byte-code-function-p object)
+                      (if (fboundp 'compiled-function-arglist)
+                          (compiled-function-arglist object)
+                        (aref object 0)))
+                     ((eq (car-safe object) 'lambda)
+                      (nth 1 object))
+                     ;; `make-temp-file' is a built-in.
+                     )))
+      ;; arglist: (prefix &optional dir-flag suffix)
+      (cond
+       ((not arglist)
+        ;; `make-temp-file' is a built-in; expects 3-args.
+        (put 'make-temp-file 'defun-maybe '3-args))
+       ((> (length arglist) 3)
+        ;; Emacs 21 CVS.
+        (put 'make-temp-file 'defun-maybe '3-args))
+       (t
+        ;; Emacs 21.1-21.3
+        (put 'make-temp-file 'defun-maybe '2-args)))))))
+
+(static-cond
+ ((eq (get 'make-temp-file 'defun-maybe) '3-args)
+  (put 'make-temp-file 'defun-maybe '3-args))
+ ((eq (get 'make-temp-file 'defun-maybe) '2-args)
+  (put 'make-temp-file 'defun-maybe '2-args)
+  (or (fboundp 'si:make-temp-file)
+      (fset 'si:make-temp-file (symbol-function 'make-temp-file)))
+  (setq current-load-list (cons 'make-temp-file current-load-list))
+  (defun make-temp-file (prefix &optional dir-flag suffix)
+    "\
+Create a temporary file.
+The returned file name (created by appending some random characters at the end
+of PREFIX, and expanding against `temporary-file-directory' if necessary),
+is guaranteed to point to a newly created empty file.
+You can then use `write-region' to write new data into the file.
+
+If DIR-FLAG is non-nil, create a new empty directory instead of a file.
+
+If SUFFIX is non-nil, add that at the end of the file name."
+    (let ((umask (default-file-modes))
+          file)
+      (unwind-protect
+          (progn
+            ;; Create temp files with strict access rights.  
+            ;; It's easy toloosen them later, whereas it's impossible
+            ;;  to close the time-window of loose permissions otherwise.
+            (set-default-file-modes 448)
+            (while (condition-case ()
+                       (progn
+                         (setq file
+                               (make-temp-name
+                                (expand-file-name
+                                 prefix temporary-file-directory)))
+                         (if suffix
+                             (setq file (concat file suffix)))
+                         (if dir-flag
+                             (make-directory file)
+                           (write-region "" nil file nil
+                                         'silent nil 'excl))
+                         nil)
+                     (file-already-exists t))
+              ;; the file was somehow created by someone else between
+              ;; `make-temp-name' and `write-region', let's try again.
+              nil)
+            file)
+        ;; Reset the umask.
+        (set-default-file-modes umask)))))
+ ((eq (get 'make-temp-file 'defun-maybe) 'none)
+  (put 'make-temp-file 'defun-maybe 'none)
+  (setq current-load-list (cons 'make-temp-file current-load-list))
+  ;; must be load-time check to share .elc between different systems.
+  (cond
+   ((memq system-type '(windows-nt ms-dos OS/2 emx))
+    ;; for single-user systems.
+    (defun make-temp-file (prefix &optional dir-flag suffix)
+      "Create a temporary file.
+The returned file name (created by appending some random characters at the end
+of PREFIX, and expanding against `temporary-file-directory' if necessary),
+is guaranteed to point to a newly created empty file.
+You can then use `write-region' to write new data into the file.
+
+If DIR-FLAG is non-nil, create a new empty directory instead of a file.
+
+If SUFFIX is non-nil, add that at the end of the file name."
+      (let ((file (make-temp-name
+                   (expand-file-name prefix temporary-file-directory))))
+        (if suffix
+            (setq file (concat file suffix)))
+        (if dir-flag
+            (make-directory file)
+          (write-region "" nil file nil 'silent))
+        file)))
+   (t
+    ;; for multi-user systems.
+    (defun make-temp-file (prefix &optional dir-flag suffix)
+      "Create a temporary file.
+The returned file name (created by appending some random characters at the end
+of PREFIX, and expanding against `temporary-file-directory' if necessary),
+is guaranteed to point to a newly created empty file.
+You can then use `write-region' to write new data into the file.
+
+If DIR-FLAG is non-nil, create a new empty directory instead of a file.
+
+If SUFFIX is non-nil, add that at the end of the file name."
+      (let ((prefix (expand-file-name prefix temporary-file-directory)))
+        (if dir-flag
+            ;; Create a new empty directory.
+            (let (dir)
+              (while (condition-case ()
+                         (progn
+                           (setq dir (make-temp-name prefix))
+                           (if suffix
+                               (setq dir (concat dir suffix)))
+                           ;; `make-directory' returns nil for success,
+                           ;; otherwise signals an error.
+                           (make-directory dir))
+                       ;; the dir was somehow created by someone else
+                       ;; between `make-temp-name' and `make-directory',
+                       ;; let's try again.
+                       (file-already-exists t)))
+              (set-file-modes dir 448)
+              dir)
+          ;; Create a new empty file.
+          (let (tempdir tempfile)
+            (unwind-protect
+                (let (file)
+                  ;; First, create a temporary directory.
+                  (while (condition-case ()
+                             (progn
+                               (setq tempdir (make-temp-name
+                                              (concat
+                                               (file-name-directory prefix)
+                                               "DIR")))
+                               ;; return nil or signal an error.
+                               (make-directory tempdir))
+                           ;; let's try again.
+                           (file-already-exists t)))
+                  (set-file-modes tempdir 448)
+                  ;; Second, create a temporary file in the tempdir.
+                  ;; There *is* a race condition between `make-temp-name'
+                  ;; and `write-region', but we don't care it since we are
+                  ;; in a private directory now.
+                  (setq tempfile (make-temp-name (concat tempdir "/EMU")))
+                  (write-region "" nil tempfile nil 'silent)
+                  (set-file-modes tempfile 384)
+                  ;; Finally, make a hard-link from the tempfile.
+                  (while (condition-case ()
+                             (progn
+                               (setq file (make-temp-name prefix))
+                               (if suffix
+                                   (setq file (concat file suffix)))
+                               ;; return nil or signal an error.
+                               (add-name-to-file tempfile file))
+                           ;; let's try again.
+                           (file-already-exists t)))
+                  file)
+              ;; Cleanup the tempfile.
+              (and tempfile
+                   (file-exists-p tempfile)
+                   (delete-file tempfile))
+              ;; Cleanup the tempdir.
+              (and tempdir
+                   (file-directory-p tempdir)
+                   (delete-directory tempdir)))))))))))
+

 ;; Actually, `path-separator' is defined in src/emacs.c and overrided
 ;; in dos-w32.el.
 (defvar-maybe path-separator ":"
 ;; Actually, `path-separator' is defined in src/emacs.c and overrided
 ;; in dos-w32.el.
 (defvar-maybe path-separator ":"

@@ -912,6 +1901,19 @@ The extension, in a file name, is the part that follows the last `.'."
        filename))))
 \f
 
        filename))))
 \f
 

+;;; @ Miscellanea.
+
+;; Emacs 19.29 and later: (current-fill-column)
+(defun-maybe current-fill-column ()
+  "Return the fill-column to use for this line."
+  fill-column)
+
+;; Emacs 19.29 and later: (current-left-margin)
+(defun-maybe current-left-margin ()
+  "Return the left margin to use for this line."
+  left-margin)
+\f
+

 ;;; @ XEmacs emulation.
 ;;;
 
 ;;; @ XEmacs emulation.
 ;;;
 

@@ -1005,10 +2007,10 @@ the echo area while this function is waiting for an event."
   ((and (fboundp 'read-event)
        (subrp (symbol-function 'read-event)))
    ;; Emacs 19, 20.1 and 20.2.
   ((and (fboundp 'read-event)
        (subrp (symbol-function 'read-event)))
    ;; Emacs 19, 20.1 and 20.2.

-   (if prompt (message prompt))
+   (if prompt (message "%s" prompt))

    (read-event))
   (t
    (read-event))
   (t

-   (if prompt (message prompt))
+   (if prompt (message "%s" prompt))

    (read-char)))
 \f
 
    (read-char)))
 \f