+(defsubst-maybe cddr (x)
+ "Return the cdr of the cdr of X."
+ (cdr (cdr x)))
+
+(defun-maybe last (x &optional n)
+ "Return the last link of the list X. Its car is the last element.
+If X is nil, return nil.
+If N is non-nil, return the Nth-to-last link of X.
+If N is bigger than the length of X, return X."
+ (if n
+ (let ((m 0) (p x))
+ (while (consp p)
+ (setq m (1+ m) p (cdr p)))
+ (if (<= n 0) p
+ (if (< n m) (nthcdr (- m n) x) x)))
+ (while (cdr x)
+ (setq x (cdr x)))
+ x))
+
+;; Actually, `butlast' and `nbutlast' are defined in lisp/cl.el.
+(defun-maybe butlast (x &optional n)
+ "Returns a copy of LIST with the last N elements removed."
+ (if (and n (<= n 0)) x
+ (nbutlast (copy-sequence x) n)))
+
+(defun-maybe nbutlast (x &optional n)
+ "Modifies LIST to remove the last N elements."
+ (let ((m (length x)))
+ (or n (setq n 1))
+ (and (< n m)
+ (progn
+ (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
+ x))))
+
+;; Emacs 20.3 and later: (assoc-default KEY ALIST &optional TEST DEFAULT)
+(defun-maybe assoc-default (key alist &optional test default)
+ "Find object KEY in a pseudo-alist ALIST.
+ALIST is a list of conses or objects. Each element (or the element's car,
+if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY).
+If that is non-nil, the element matches;
+then `assoc-default' returns the element's cdr, if it is a cons,
+or DEFAULT if the element is not a cons.
+
+If no element matches, the value is nil.
+If TEST is omitted or nil, `equal' is used."
+ (let (found (tail alist) value)
+ (while (and tail (not found))
+ (let ((elt (car tail)))
+ (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
+ (setq found t value (if (consp elt) (cdr elt) default))))
+ (setq tail (cdr tail)))
+ value))
+
+;; The following two function use `compare-strings', which we don't
+;; support yet.
+;; (defun assoc-ignore-case (key alist))
+;; (defun assoc-ignore-representation (key alist))
+
+;; Emacs 19.29/XEmacs 19.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.
+The value is actually the element of LIST whose cdr equals KEY.
+Elements of LIST that are not conses are ignored."
+ (catch 'found
+ (while list
+ (cond ((not (consp (car list))))
+ ((equal (cdr (car list)) key)
+ (throw 'found (car list))))
+ (setq list (cdr list)))))
+
+;; XEmacs 19.13 and later: (remassq KEY LIST)
+(defun-maybe remassq (key list)
+ "Delete by side effect any elements of LIST whose car is `eq' to KEY.
+The modified LIST is returned. If the first member of LIST 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'."
+ (if (setq key (assq key list))
+ (delq key list)
+ list))
+
+;; XEmacs 19.13 and later: (remassoc KEY LIST)
+(defun-maybe remassoc (key list)
+ "Delete by side effect any elements of LIST whose car is `equal' to KEY.
+The modified LIST is returned. If the first member of LIST 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'."
+ (if (setq key (assoc key list))
+ (delq key list)
+ list))
+
+;; XEmacs 19.13 and later: (remrassq VALUE LIST)
+(defun-maybe remrassq (value list)
+ "Delete by side effect any elements of LIST whose cdr is `eq' to VALUE.
+The modified LIST is returned. If the first member of LIST 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'."
+ (if (setq value (rassq value list))
+ (delq value list)
+ list))
+
+;; XEmacs 19.13 and later: (remrassoc VALUE LIST)
+(defun-maybe remrassoc (value list)
+ "Delete by side effect any elements of LIST whose cdr is `equal' to VALUE.
+The modified LIST is returned. If the first member of LIST 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'."
+ (if (setq value (rassoc value list))
+ (delq value list)
+ list))
+
+;;; Define `functionp' here because "localhook" uses it.
+
+;; Emacs 20.1/XEmacs 20.3 (but first appeared in Epoch?): (functionp OBJECT)
+(defun-maybe functionp (object)
+ "Non-nil if OBJECT is a type of object that can be called as a function."
+ (or (subrp object) (byte-code-function-p object)
+ (eq (car-safe object) 'lambda)
+ (and (symbolp object) (fboundp object))))
+
+;;; @@ Hook manipulation functions.
+
+;; "localhook" package is written for Emacs 19.28 and earlier.
+;; `run-hooks' was a lisp function in Emacs 19.29 and earlier.
+;; So, in Emacs 19.29, `run-hooks' and others will be overrided.
+;; But, who cares it?
+(static-unless (subrp (symbol-function 'run-hooks))
+ (require 'localhook))
+
+;; Emacs 19.29/XEmacs 19.14(?) and later: (add-to-list LIST-VAR ELEMENT)
+(defun-maybe add-to-list (list-var element)
+ "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
+The test for presence of ELEMENT is done with `equal'.
+If you want to use `add-to-list' on a variable that is not defined
+until a certain package is loaded, you should put the call to `add-to-list'
+into a hook function that will be run only after loading the package.
+`eval-after-load' provides one way to do this. In some cases
+other hooks, such as major mode hooks, can do the job."
+ (or (member element (symbol-value list-var))
+ (set list-var (cons element (symbol-value list-var)))))
+
+;; (eval-after-load FILE FORM)
+;; Emacs 19.28 and earlier do not evaluate FORM if FILE is already loaded.
+;; XEmacs 20.2 and earlier have `after-load-alist', but refuse to support
+;; `eval-after-load'. (see comments in XEmacs/lisp/subr.el.)
+(static-cond
+ ((featurep 'xemacs)
+ ;; for XEmacs 20.2 and earlier.
+ (defun-maybe eval-after-load (file form)
+ "Arrange that, if FILE is ever loaded, FORM will be run at that time.
+This makes or adds to an entry on `after-load-alist'.
+If FILE is already loaded, evaluate FORM right now.
+It does nothing if FORM is already on the list for FILE.
+FILE should be the name of a library, with no directory name."
+ ;; Make sure there is an element for FILE.
+ (or (assoc file after-load-alist)
+ (setq after-load-alist (cons (list file) after-load-alist)))
+ ;; Add FORM to the element if it isn't there.
+ (let ((elt (assoc file after-load-alist)))
+ (or (member form (cdr elt))
+ (progn
+ (nconc elt (list form))
+ ;; If the file has been loaded already, run FORM right away.
+ (and (assoc file load-history)
+ (eval form)))))
+ form))
+ ((>= emacs-major-version 20))
+ ((and (= emacs-major-version 19)
+ (< emacs-minor-version 29))
+ ;; for Emacs 19.28 and earlier.
+ (defun eval-after-load (file form)
+ "Arrange that, if FILE is ever loaded, FORM will be run at that time.
+This makes or adds to an entry on `after-load-alist'.
+If FILE is already loaded, evaluate FORM right now.
+It does nothing if FORM is already on the list for FILE.
+FILE should be the name of a library, with no directory name."
+ ;; Make sure there is an element for FILE.
+ (or (assoc file after-load-alist)
+ (setq after-load-alist (cons (list file) after-load-alist)))
+ ;; Add FORM to the element if it isn't there.
+ (let ((elt (assoc file after-load-alist)))
+ (or (member form (cdr elt))
+ (progn
+ (nconc elt (list form))
+ ;; If the file has been loaded already, run FORM right away.
+ (and (assoc file load-history)
+ (eval form)))))
+ form))
+ (t
+ ;; should emulate for v18?
+ ))
+
+(defun-maybe eval-next-after-load (file)
+ "Read the following input sexp, and run it whenever FILE is loaded.
+This makes or adds to an entry on `after-load-alist'.
+FILE should be the name of a library, with no directory name."
+ (eval-after-load file (read)))
+
+;;; @@ Input and display facilities.
+
+;; XXX: (defun read-passwd (prompt &optional confirm default))
+
+;;; @@ Miscellanea.
+
+;; Avoid compiler warnings about this variable,
+;; which has a special meaning on certain system types.
+(defvar-maybe buffer-file-type nil
+ "Non-nil if the visited file is a binary file.
+This variable is meaningful on MS-DOG and Windows NT.
+On those systems, it is automatically local in every buffer.
+On other systems, this variable is normally always nil.")
+
+;; Emacs 20.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 a 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)
+;; and introduces a new bytecode Bsave_current_buffer(_1), replacing an
+;; obsolete bytecode Bread_char. To make things worse, Emacs 20.1 and
+;; 20.2 have a bug that it will restore the current buffer without
+;; confirming that it is alive.
+;;
+;; This is a source of incompatibility of .elc between v18/v19 and v20.
+;; (XEmacs compiler takes care of it if compatibility mode is enabled.)
+(defmacro-maybe save-current-buffer (&rest body)
+ "Save the current buffer; execute BODY; restore the current buffer.
+Executes BODY just like `progn'."
+ (` (let ((orig-buffer (current-buffer)))
+ (unwind-protect
+ (progn (,@ body))
+ (if (buffer-live-p orig-buffer)
+ (set-buffer orig-buffer))))))
+
+;; Emacs 20.1/XEmacs 20.3(?) and later: (with-current-buffer BUFFER &rest BODY)
+(defmacro-maybe with-current-buffer (buffer &rest body)
+ "Execute the forms in BODY with BUFFER as the current buffer.
+The value returned is the value of the last form in BODY.
+See also `with-temp-buffer'."
+ (` (save-current-buffer
+ (set-buffer (, buffer))
+ (,@ body))))
+
+;; Emacs 20.1/XEmacs 20.3(?) and later: (with-temp-file FILE &rest FORMS)
+(defmacro-maybe with-temp-file (file &rest forms)
+ "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
+The value of the last form in FORMS is returned, like `progn'.
+See also `with-temp-buffer'."
+ (let ((temp-file (make-symbol "temp-file"))
+ (temp-buffer (make-symbol "temp-buffer")))
+ (` (let (((, temp-file) (, file))
+ ((, temp-buffer)
+ (get-buffer-create (generate-new-buffer-name " *temp file*"))))
+ (unwind-protect
+ (prog1
+ (with-current-buffer (, temp-buffer)
+ (,@ forms))
+ (with-current-buffer (, temp-buffer)
+ (widen)
+ (write-region (point-min) (point-max) (, temp-file) nil 0)))
+ (and (buffer-name (, temp-buffer))
+ (kill-buffer (, temp-buffer))))))))
+
+;; Emacs 20.4 and later: (with-temp-message MESSAGE &rest BODY)
+;; This macro uses `current-message', which appears in v20.
+(static-when (and (fboundp 'current-message)
+ (subrp (symbol-function 'current-message)))
+ (defmacro-maybe with-temp-message (message &rest body)
+ "\
+Display MESSAGE temporarily if non-nil while BODY is evaluated.
+The original message is restored to the echo area after BODY has finished.
+The value returned is the value of the last form in BODY.
+MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
+If MESSAGE is nil, the echo area and message log buffer are unchanged.
+Use a MESSAGE of \"\" to temporarily clear the echo area."
+ (let ((current-message (make-symbol "current-message"))
+ (temp-message (make-symbol "with-temp-message")))
+ (` (let (((, temp-message) (, message))
+ ((, current-message)))
+ (unwind-protect
+ (progn
+ (when (, temp-message)
+ (setq (, current-message) (current-message))
+ (message "%s" (, temp-message))
+ (,@ body))
+ (and (, temp-message) (, current-message)
+ (message "%s" (, current-message))))))))))
+
+;; Emacs 20.1/XEmacs 20.3(?) and later: (with-temp-buffer &rest FORMS)
+(defmacro-maybe with-temp-buffer (&rest forms)
+ "Create a temporary buffer, and evaluate FORMS there like `progn'.
+See also `with-temp-file' and `with-output-to-string'."
+ (let ((temp-buffer (make-symbol "temp-buffer")))
+ (` (let (((, temp-buffer)
+ (get-buffer-create (generate-new-buffer-name " *temp*"))))
+ (unwind-protect
+ (with-current-buffer (, temp-buffer)
+ (,@ forms))
+ (and (buffer-name (, temp-buffer))
+ (kill-buffer (, temp-buffer))))))))
+
+;; Emacs 20.1/XEmacs 20.3(?) and later: (with-output-to-string &rest BODY)
+(defmacro-maybe with-output-to-string (&rest body)
+ "Execute BODY, return the text it sent to `standard-output', as a string."
+ (` (let ((standard-output
+ (get-buffer-create (generate-new-buffer-name " *string-output*"))))
+ (let ((standard-output standard-output))
+ (,@ body))
+ (with-current-buffer standard-output
+ (prog1
+ (buffer-string)
+ (kill-buffer nil))))))
+
+;; Emacs 20.1 and later: (combine-after-change-calls &rest BODY)
+(defmacro-maybe combine-after-change-calls (&rest body)
+ "Execute BODY, but don't call the after-change functions till the end.
+If BODY makes changes in the buffer, they are recorded
+and the functions on `after-change-functions' are called several times
+when BODY is finished.
+The return value is the value of the last form in BODY.
+
+If `before-change-functions' is non-nil, then calls to the after-change
+functions can't be deferred, so in that case this macro has no effect.
+
+Do not alter `after-change-functions' or `before-change-functions'
+in BODY.
+
+This emulating macro does not support after-change functions at all,
+just execute BODY."
+ (cons 'progn body))
+
+;; Emacs 19.29/XEmacs 19.14(?) and later: (match-string NUM &optional STRING)
+(defun-maybe match-string (num &optional string)
+ "Return string of text matched by last search.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING."
+ (if (match-beginning num)
+ (if string
+ (substring string (match-beginning num) (match-end num))
+ (buffer-substring (match-beginning num) (match-end num)))))
+
+;; Emacs 20.3 and later: (match-string-no-properties NUM &optional STRING)
+(defun-maybe match-string-no-properties (num &optional string)
+ "Return string of text matched by last search, without text properties.
+NUM specifies which parenthesized expression in the last regexp.
+ Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
+Zero means the entire text matched by the whole regexp or whole string.
+STRING should be given if the last search was by `string-match' on STRING."
+ (if (match-beginning num)
+ (if string
+ (let ((result
+ (substring string (match-beginning num) (match-end num))))
+ (set-text-properties 0 (length result) nil result)
+ result)
+ (buffer-substring-no-properties (match-beginning num)
+ (match-end num)))))
+
+;; Emacs 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)
+;; The the third optional argument universal is yet to be implemented.
+;; 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.
+
+The the third optional argument universal is yet to be implemented.
+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
+ (time-string (current-time-string time)))
+ (setq 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)
+ (setq change-case (not change-case))
+ (downcase (cadr (current-time-zone))))
+ (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 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))))
+\f
+
+;;; @ Window commands emulation. (lisp/window.el)
+;;;
+
+(defmacro-maybe save-selected-window (&rest body)
+ "Execute BODY, then select the window that was selected before BODY."
+ (list 'let
+ '((save-selected-window-window (selected-window)))
+ (list 'unwind-protect
+ (cons 'progn body)
+ (list 'select-window 'save-selected-window-window))))
+
+;; 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
+
+;;; @ File input and output commands emulation. (lisp/files.el)
+;;;
+
+(defvar-maybe temporary-file-directory
+ (file-name-as-directory
+ (cond ((memq system-type '(ms-dos windows-nt))
+ (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
+ ((memq system-type '(vax-vms axp-vms))
+ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
+ (t
+ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
+ "The directory for writing temporary files.")
+
+;; Actually, `path-separator' is defined in src/emacs.c and overrided
+;; in dos-w32.el.
+(defvar-maybe path-separator ":"
+ "The directory separator in search paths, as a string.")
+
+;; `convert-standard-filename' is defined in lisp/files.el and overrided
+;; in lisp/dos-fns.el and lisp/w32-fns.el for each environment.
+(cond
+ ;; must be load-time check to share .elc between different systems.
+ ((fboundp 'convert-standard-filename))
+ ((memq system-type '(windows-nt ms-dos))
+ ;; should we do (require 'filename) at load-time ?
+ ;; (require 'filename)
+ ;; filename.el requires many modules, so we do not want to load it
+ ;; at compile-time. Instead, suppress warnings by these autoloads.
+ (eval-when-compile
+ (autoload 'filename-maybe-truncate-by-size "filename")
+ (autoload 'filename-special-filter "filename"))
+ (defun convert-standard-filename (filename)
+ "Convert a standard file's name to something suitable for the current OS.
+This function's standard definition is trivial; it just returns the argument.
+However, on some systems, the function is redefined
+with a definition that really does change some file names.
+Under `windows-nt' or `ms-dos', it refers `filename-replacement-alist' and
+`filename-limit-length' for the basic filename and each parent directory name."
+ (require 'filename)
+ (let* ((names (split-string filename "/"))
+ (drive-name (car names))
+ (filter (function
+ (lambda (string)
+ (filename-maybe-truncate-by-size
+ (filename-special-filter string))))))
+ (cond
+ ((eq 1 (length names))
+ (funcall filter drive-name))
+ ((string-match "^[^/]:$" drive-name)
+ (concat drive-name "/" (mapconcat filter (cdr names) "/")))
+ (t
+ (mapconcat filter names "/"))))))
+ (t
+ (defun convert-standard-filename (filename)
+ "Convert a standard file's name to something suitable for the current OS.
+This function's standard definition is trivial; it just returns the argument.
+However, on some systems, the function is redefined
+with a definition that really does change some file names.
+Under `windows-nt' or `ms-dos', it refers `filename-replacement-alist' and
+`filename-limit-length' for the basic filename and each parent directory name."
+ filename)))
+
+(static-cond
+ ((fboundp 'insert-file-contents-literally))
+ ((boundp 'file-name-handler-alist)
+ ;; Use `defun-maybe' to update `load-history'.
+ (defun-maybe insert-file-contents-literally (filename &optional visit
+ beg end replace)
+ "Like `insert-file-contents', q.v., but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+ This function ensures that none of these modifications will take place."
+ (let (file-name-handler-alist)
+ (insert-file-contents filename visit beg end replace))))
+ (t
+ (defalias 'insert-file-contents-literally 'insert-file-contents)))
+
+(defun-maybe file-name-sans-extension (filename)
+ "Return FILENAME sans final \"extension\".
+The extension, in a file name, is the part that follows the last `.'."
+ (save-match-data
+ (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
+ directory)
+ (if (string-match "\\.[^.]*\\'" file)
+ (if (setq directory (file-name-directory filename))
+ (expand-file-name (substring file 0 (match-beginning 0))
+ directory)
+ (substring file 0 (match-beginning 0)))
+ filename))))
+\f
+
+;;; @ 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.