update.
[elisp/apel.git] / poe.el
diff --git a/poe.el b/poe.el
index 27f53ee..5224803 100644 (file)
--- a/poe.el
+++ b/poe.el
@@ -75,7 +75,6 @@
    (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.
@@ -90,7 +89,10 @@ Normally the return value is FEATURE."
               (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)
@@ -290,7 +292,7 @@ Completion ignores case if the ambient value of
         (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)
@@ -702,38 +704,97 @@ Elements of LIST that are not conses are ignored."
             (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.
 
@@ -836,6 +897,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.")
 
+;; 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)
@@ -1257,13 +1323,13 @@ Not fully compatible especially when invalid format is specified."
                  "")
                 ;; 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)
@@ -1544,6 +1610,19 @@ The extension, in a file name, is the part that follows the last `.'."
        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.
 ;;;