(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.
(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)
(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)
(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))
- (delete 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
+;; 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'."
- (if (setq key (assoc key list))
- (delete key 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
+ (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'."
- (if (setq value (rassoc value list))
- (delete value list)
- list))
+ (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.
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)
"")
;; the day of month, zero-padded
((eq cur-char ?d)
- (substring time-string 8 10))
+ (format "%02d" (string-to-int (substring time-string 8 10))))
;; a synonym for `%m/%d/%y'
((eq cur-char ?D)
- (format "%02d/%s/%s"
+ (format "%02d/%02d/%s"
(cddr (assoc (substring time-string 4 7)
format-time-month-list))
- (substring time-string 8 10)
+ (string-to-int (substring time-string 8 10))
(substring time-string -2)))
;; the day of month, blank-padded
((eq cur-char ?e)
((eq cur-char ?Z)
(setq change-case (not change-case))
(downcase (cadr (current-time-zone))))
+ ((eq cur-char ?z)
+ (let ((tz (car (current-time-zone))))
+ (if (< tz 0)
+ (format "-%02d%02d" (/ (- tz) 3600) (/ (% (- tz) 3600) 60))
+ (format "+%02d%02d" (/ tz 3600) (/ (% tz 3600) 60)))))
(t
(concat
"%"
(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))))))))
+
;; 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)
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.
;;;