* mcs-om.el (mime-charset-coding-system-alist): Move forward.

[elisp/apel.git] / poe.el

diff --git a/poe.el b/poe.el
index e118c91..e3c5231 100644 (file)
--- a/poe.el
+++ b/poe.el
@@ -267,7 +267,7 @@ HIST, if non-nil, specifies a history list
 DEF, if non-nil, is the default value.
 
 Completion ignores case if the ambient value of
 DEF, if non-nil, is the default value.
 
 Completion ignores case if the ambient value of

-  `completion-ignore-case' is non-nil."  
+  `completion-ignore-case' is non-nil."

        (let ((string (si:completing-read prompt table predicate
                                          require-match init hist)))
          (if (and (string= string "") def)
        (let ((string (si:completing-read prompt table predicate
                                          require-match init hist)))
          (if (and (string= string "") def)

@@ -292,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))
         (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)

@@ -704,49 +704,97 @@ 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: (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
+;; 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'."
 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
+  (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'."
 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
+  (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'."
 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))
+  (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.
 
 
 ;;; Define `functionp' here because "localhook" uses it.
 

@@ -849,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.")
 
 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)
 ;; 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)

@@ -1107,8 +1160,7 @@ which is made by replacing the part of STRING that was matched."
                    (buffer-string)))
               (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.
+;; 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.
 ;; Those format constructs are yet to be implemented.
 ;;   %c, %C, %j, %U, %W, %x, %X
 ;; Not fully compatible especially when invalid format is specified.

@@ -1182,7 +1234,6 @@ For example, to produce full ISO 8601 format, use \"%Y-%m-%dT%T%z\".
 
 Compatibility Note.
 
 
 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."
 Those format constructs are yet to be implemented.
   %c, %C, %j, %U, %W, %x, %X
 Not fully compatible especially when invalid format is specified."

@@ -1197,9 +1248,24 @@ Not fully compatible especially when invalid format is specified."
          field-result
          pad-left change-case
          (paren-level 0)
          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)))
+         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
       (while (< ind fmt-len)
        (setq cur-char (aref format ind))
        (setq

@@ -1248,7 +1314,7 @@ Not fully compatible especially when invalid format is specified."
                (cond
                 ((eq cur-char ?%)
                  "%")
                (cond
                 ((eq cur-char ?%)
                  "%")

-                ;; the abbreviated name of the day of week.             
+                ;; 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)
                  (substring time-string 0 3))
                 ;; the full name of the day of week

@@ -1269,7 +1335,7 @@ Not fully compatible especially when invalid format is specified."
                 ((eq cur-char ?C)
                  "")
                 ;; the day of month, zero-padded
                 ((eq cur-char ?C)
                  "")
                 ;; the day of month, zero-padded

-                ((eq cur-char ?d)      
+                ((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" (string-to-int (substring time-string 8 10))))
                 ;; a synonym for `%m/%d/%y'
                 ((eq cur-char ?D)

@@ -1337,7 +1403,7 @@ Not fully compatible especially when invalid format is specified."
                          (substring time-string 11 13)
                          (substring time-string 14 16)
                          (substring time-string 17 19)))
                          (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 
+                ;; the week of the year (01-52), assuming that weeks

                 ;; start on Sunday (yet to come)
                 ((eq cur-char ?U)
                  "")
                 ;; start on Sunday (yet to come)
                 ((eq cur-char ?U)
                  "")

@@ -1363,8 +1429,18 @@ Not fully compatible especially when invalid format is specified."
                  (substring time-string -4))
                 ;; the time zone abbreviation
                 ((eq cur-char ?Z)
                  (substring time-string -4))
                 ;; the time zone abbreviation
                 ((eq cur-char ?Z)

-                 (setq change-case (not change-case))
-                 (downcase (cadr (current-time-zone))))
+                 (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
                   "%"
                 (t
                  (concat
                   "%"

@@ -1406,6 +1482,47 @@ Not fully compatible especially when invalid format is specified."
   (setq current-load-list (cons 'format-time-string current-load-list))
   (put 'format-time-string 'defun-maybe t))))
 
   (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)
 ;; 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)

@@ -1557,6 +1674,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.
 ;;;