(uncompface-use-external): Default to undecided.

[gnus] / lisp / gnus-util.el

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index acbf843..510b77e 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -34,7 +34,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(require 'custom)

 (eval-when-compile
   (require 'cl)
   ;; Fixme: this should be a gnus variable, not nnmail-.
 (eval-when-compile
   (require 'cl)
   ;; Fixme: this should be a gnus variable, not nnmail-.


@@ -57,15 +56,7 @@
     (defalias 'gnus-replace-in-string 'replace-in-string))
    ((fboundp 'replace-regexp-in-string)
     (defun gnus-replace-in-string  (string regexp newtext &optional literal)
     (defalias 'gnus-replace-in-string 'replace-in-string))
    ((fboundp 'replace-regexp-in-string)
     (defun gnus-replace-in-string  (string regexp newtext &optional literal)

-      (replace-regexp-in-string regexp newtext string nil literal)))
-   (t
-    (defun gnus-replace-in-string (string regexp newtext &optional literal)
-      (let ((start 0) tail)
-       (while (string-match regexp string start)
-         (setq tail (- (length string) (match-end 0)))
-         (setq string (replace-match newtext nil literal string))
-         (setq start (- (length string) tail))))
-      string))))
+      (replace-regexp-in-string regexp newtext string nil literal)))))

 
 ;;; bring in the netrc functions as aliases
 (defalias 'gnus-netrc-get 'netrc-get)
 
 ;;; bring in the netrc functions as aliases
 (defalias 'gnus-netrc-get 'netrc-get)


@@ -123,22 +114,12 @@
        (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
                buffer))))
 
        (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
                buffer))))
 

-(defalias 'gnus-point-at-bol
-  (if (fboundp 'point-at-bol)
-      'point-at-bol
-    'line-beginning-position))
-
-(defalias 'gnus-point-at-eol
-  (if (fboundp 'point-at-eol)
-      'point-at-eol
-    'line-end-position))
-

 ;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and
 ;; XEmacs.  In Emacs we don't need to call `make-local-hook' first.
 ;; It's harmless, though, so the main purpose of this alias is to shut
 ;; up the byte compiler.
 (defalias 'gnus-make-local-hook
 ;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and
 ;; XEmacs.  In Emacs we don't need to call `make-local-hook' first.
 ;; It's harmless, though, so the main purpose of this alias is to shut
 ;; up the byte compiler.
 (defalias 'gnus-make-local-hook

-  (if (eq (get 'make-local-hook 'byte-compile) 
+  (if (eq (get 'make-local-hook 'byte-compile)

          'byte-compile-obsolete)
       'ignore                          ; Emacs
     'make-local-hook))                 ; XEmacs
          'byte-compile-obsolete)
       'ignore                          ; Emacs
     'make-local-hook))                 ; XEmacs


@@ -157,7 +138,7 @@
 
 ;; Delete the current line (and the next N lines).
 (defmacro gnus-delete-line (&optional n)
 
 ;; Delete the current line (and the next N lines).
 (defmacro gnus-delete-line (&optional n)

-  `(delete-region (gnus-point-at-bol)
+  `(delete-region (point-at-bol)

                  (progn (forward-line ,(or n 1)) (point))))
 
 (defun gnus-byte-code (func)
                  (progn (forward-line ,(or n 1)) (point))))
 
 (defun gnus-byte-code (func)


@@ -170,6 +151,11 @@
       (cons 'progn (cddr fval)))))
 
 (defun gnus-extract-address-components (from)
       (cons 'progn (cddr fval)))))
 
 (defun gnus-extract-address-components (from)

+  "Extract address components from a From header.
+Given an RFC-822 address FROM, extract full name and canonical address.
+Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).  Much more simple
+solution than `mail-extract-address-components', which works much better, but
+is slower."

   (let (name address)
     ;; First find the address - the thing with the @ in it.  This may
     ;; not be accurate in mail addresses, but does the trick most of
   (let (name address)
     ;; First find the address - the thing with the @ in it.  This may
     ;; not be accurate in mail addresses, but does the trick most of


@@ -202,8 +188,7 @@
   "Return the value of the header FIELD of current article."
   (save-excursion
     (save-restriction
   "Return the value of the header FIELD of current article."
   (save-excursion
     (save-restriction

-      (let ((case-fold-search t)
-           (inhibit-point-motion-hooks t))
+      (let ((inhibit-point-motion-hooks t))

        (nnheader-narrow-to-headers)
        (message-fetch-field field)))))
 
        (nnheader-narrow-to-headers)
        (message-fetch-field field)))))
 


@@ -215,7 +200,7 @@
 
 (defun gnus-goto-colon ()
   (beginning-of-line)
 
 (defun gnus-goto-colon ()
   (beginning-of-line)

-  (let ((eol (gnus-point-at-eol)))
+  (let ((eol (point-at-eol)))

     (goto-char (or (text-property-any (point) eol 'gnus-position t)
                   (search-forward ":" eol t)
                   (point)))))
     (goto-char (or (text-property-any (point) eol 'gnus-position t)
                   (search-forward ":" eol t)
                   (point)))))


@@ -337,18 +322,18 @@
 ;; the full date if it's older)
 
 (defun gnus-seconds-today ()
 ;; the full date if it's older)
 
 (defun gnus-seconds-today ()

-  "Returns the number of seconds passed today"
+  "Return the number of seconds passed today."

   (let ((now (decode-time (current-time))))
     (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600))))
 
 (defun gnus-seconds-month ()
   (let ((now (decode-time (current-time))))
     (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600))))
 
 (defun gnus-seconds-month ()

-  "Returns the number of seconds passed this month"
+  "Return the number of seconds passed this month."

   (let ((now (decode-time (current-time))))
     (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
        (* (- (car (nthcdr 3 now)) 1) 3600 24))))
 
 (defun gnus-seconds-year ()
   (let ((now (decode-time (current-time))))
     (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
        (* (- (car (nthcdr 3 now)) 1) 3600 24))))
 
 (defun gnus-seconds-year ()

-  "Returns the number of seconds passed this year"
+  "Return the number of seconds passed this year."

   (let ((now (decode-time (current-time)))
        (days (format-time-string "%j" (current-time))))
     (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
   (let ((now (decode-time (current-time)))
        (days (format-time-string "%j" (current-time))))
     (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)


@@ -379,7 +364,7 @@ seconds passed since the start of today, of this month, of this year,
 respectively.")
 
 (defun gnus-user-date (messy-date)
 respectively.")
 
 (defun gnus-user-date (messy-date)

-  "Format the messy-date acording to gnus-user-date-format-alist.
+  "Format the messy-date according to gnus-user-date-format-alist.

 Returns \"  ?  \" if there's bad input or if an other error occurs.
 Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
   (condition-case ()
 Returns \"  ?  \" if there's bad input or if an other error occurs.
 Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
   (condition-case ()


@@ -579,7 +564,7 @@ If N, return the Nth ancestor instead."
        gname)))
 
 (defun gnus-make-sort-function (funs)
        gname)))
 
 (defun gnus-make-sort-function (funs)

-  "Return a composite sort condition based on the functions in FUNC."
+  "Return a composite sort condition based on the functions in FUNS."

   (cond
    ;; Just a simple function.
    ((functionp funs) funs)
   (cond
    ;; Just a simple function.
    ((functionp funs) funs)


@@ -596,7 +581,7 @@ If N, return the Nth ancestor instead."
     (car funs))))
 
 (defun gnus-make-sort-function-1 (funs)
     (car funs))))
 
 (defun gnus-make-sort-function-1 (funs)

-  "Return a composite sort condition based on the functions in FUNC."
+  "Return a composite sort condition based on the functions in FUNS."

   (let ((function (car funs))
        (first 't1)
        (last 't2))
   (let ((function (car funs))
        (first 't1)
        (last 't2))


@@ -798,6 +783,23 @@ with potentially long computations."
 ;;; Functions for saving to babyl/mail files.
 
 (eval-when-compile
 ;;; Functions for saving to babyl/mail files.
 
 (eval-when-compile

+  (condition-case nil
+      (progn
+       (require 'rmail)
+       (autoload 'rmail-update-summary "rmailsum"))
+    (error
+     (define-compiler-macro rmail-select-summary (&rest body)
+       ;; Rmail of the XEmacs version is supplied by the package, and
+       ;; requires tm and apel packages.  However, there may be those
+       ;; who haven't installed those packages.  This macro helps such
+       ;; people even if they install those packages later.
+       `(eval '(rmail-select-summary ,@body)))
+     ;; If there's rmail but there's no tm (or there's apel of the
+     ;; mainstream, not the XEmacs version), loading rmail of the XEmacs
+     ;; version fails halfway, however it provides the rmail-select-summary
+     ;; macro which uses the following functions:
+     (autoload 'rmail-summary-displayed "rmail")
+     (autoload 'rmail-maybe-display-summary "rmail")))

   (defvar rmail-default-rmail-file)
   (defvar mm-text-coding-system))
 
   (defvar rmail-default-rmail-file)
   (defvar mm-text-coding-system))
 


@@ -926,7 +928,7 @@ with potentially long computations."
     (insert "\^_")))
 
 (defun gnus-map-function (funs arg)
     (insert "\^_")))
 
 (defun gnus-map-function (funs arg)

-  "Applies the result of the first function in FUNS to the second, and so on.
+  "Apply the result of the first function in FUNS to the second, and so on.

 ARG is passed to the first function."
   (while funs
     (setq arg (funcall (pop funs) arg)))
 ARG is passed to the first function."
   (while funs
     (setq arg (funcall (pop funs) arg)))


@@ -983,7 +985,7 @@ Return the modified alist."
     `(setq ,alist (delq (,fun ,key ,alist) ,alist))))
 
 (defun gnus-globalify-regexp (re)
     `(setq ,alist (delq (,fun ,key ,alist) ,alist))))
 
 (defun gnus-globalify-regexp (re)

-  "Returns a regexp that matches a whole line, iff RE matches a part of it."
+  "Return a regexp that matches a whole line, iff RE matches a part of it."

   (concat (unless (string-match "^\\^" re) "^.*")
          re
          (unless (string-match "\\$$" re) ".*$")))
   (concat (unless (string-match "^\\^" re) "^.*")
          re
          (unless (string-match "\\$$" re) ".*$")))


@@ -1182,7 +1184,6 @@ If you find some problem with the directory separator character, try
 If optional second argument ALLOW-NEWLINES is non-nil, then allow the
 decoding of carriage returns and line feeds in the string, which is normally
 forbidden in URL encoding."
 If optional second argument ALLOW-NEWLINES is non-nil, then allow the
 decoding of carriage returns and line feeds in the string, which is normally
 forbidden in URL encoding."

-  (setq str (or (mm-subst-char-in-string ?+ ?  str) "")) ; why `or'?

   (let ((tmp "")
        (case-fold-search t))
     (while (string-match "%[0-9a-f][0-9a-f]" str)
   (let ((tmp "")
        (case-fold-search t))
     (while (string-match "%[0-9a-f][0-9a-f]" str)


@@ -1217,32 +1218,12 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
        `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
       (error "Invalid predicate specifier: %s" spec)))))
 
        `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
       (error "Invalid predicate specifier: %s" spec)))))
 

-(defun gnus-local-map-property (map)
-  "Return a list suitable for a text property list specifying keymap MAP."
-  (cond
-   ((featurep 'xemacs)
-    (list 'keymap map))
-   ((>= emacs-major-version 21)
-    (list 'keymap map))
-   (t
-    (list 'local-map map))))
-
-(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate 
-                                             require-match initial-contents 
-                                             history default)
-  "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen."
-  `(completing-read ,prompt ,table ,predicate ,require-match
-                    ,initial-contents ,history
-                    ,@(if (and (featurep 'xemacs) (< emacs-minor-version 2))
-                          ()
-                        (list default))))
-

 (defun gnus-completing-read (prompt table &optional predicate require-match
                                    history)
   (when (and history
             (not (boundp history)))
     (set history nil))
 (defun gnus-completing-read (prompt table &optional predicate require-match
                                    history)
   (when (and history
             (not (boundp history)))
     (set history nil))

-  (gnus-completing-read-maybe-default
+  (completing-read

    (if (symbol-value history)
        (concat prompt " (" (car (symbol-value history)) "): ")
      (concat prompt ": "))
    (if (symbol-value history)
        (concat prompt " (" (car (symbol-value history)) "): ")
      (concat prompt ": "))


@@ -1428,6 +1409,44 @@ predicate on the elements."
          (push (pop list1) res)))
       (nconc (nreverse res) list1 list2))))
 
          (push (pop list1) res)))
       (nconc (nreverse res) list1 list2))))
 

+(eval-when-compile
+  (defvar xemacs-codename))
+
+(defun gnus-emacs-version ()
+  "Stringified Emacs version."
+  (let ((system-v
+        (cond
+         ((eq gnus-user-agent 'emacs-gnus-config)
+          system-configuration)
+         ((eq gnus-user-agent 'emacs-gnus-type)
+          (symbol-name system-type))
+         (t nil))))
+    (cond
+     ((eq gnus-user-agent 'gnus)
+      nil)
+     ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
+      (concat "Emacs/" (match-string 1 emacs-version)
+             (if system-v
+                 (concat " (" system-v ")")
+               "")))
+     ((string-match
+       "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
+       emacs-version)
+      (concat
+       (match-string 1 emacs-version)
+       (format "/%d.%d" emacs-major-version emacs-minor-version)
+       (if (match-beginning 3)
+          (match-string 3 emacs-version)
+        "")
+       (if (boundp 'xemacs-codename)
+          (concat
+           " (" xemacs-codename
+           (if system-v
+               (concat ", " system-v ")")
+             ")"))
+        "")))
+     (t emacs-version))))
+

 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here
 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here