2005-03-08 Juergen Kreileder <jk@blackdown.de> (tiny change)

[gnus] / lisp / gnus-util.el

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 6997c75..8e49234 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1,5 +1,5 @@
 ;;; gnus-util.el --- utility functions for Gnus
 ;;; gnus-util.el --- utility functions for Gnus

-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005

 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>


@@ -30,15 +30,18 @@
 ;; Gnus first.
 
 ;; [Unfortunately, it does depend on other parts of Gnus, e.g. the
 ;; Gnus first.
 
 ;; [Unfortunately, it does depend on other parts of Gnus, e.g. the

-;; autoloads below...]
+;; autoloads and defvars below...]

 
 ;;; 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-.

-  (defvar nnmail-pathname-coding-system))
+  (defvar nnmail-pathname-coding-system)
+
+  ;; Inappropriate references to other parts of Gnus.
+  (defvar gnus-emphasize-whitespace-regexp)
+  )

 (require 'time-date)
 (require 'netrc)
 
 (require 'time-date)
 (require 'netrc)
 


@@ -57,20 +60,12 @@
     (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))))
-
-;;; bring in the netrc functions as aliases
-(defalias 'gnus-netrc-get 'netrc-get)
-(defalias 'gnus-netrc-machine 'netrc-machine)
-(defalias 'gnus-parse-netrc 'netrc-parse)
+      "Replace all matches for REGEXP with NEWTEXT in STRING.
+If LITERAL is non-nil, insert NEWTEXT literally.  Return a new
+string containing the replacements.
+
+This is a compatibility function for different Emacsen."
+      (replace-regexp-in-string regexp newtext string nil literal)))))

 
 (defun gnus-boundp (variable)
   "Return non-nil if VARIABLE is bound and non-nil."
 
 (defun gnus-boundp (variable)
   "Return non-nil if VARIABLE is bound and non-nil."


@@ -123,22 +118,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 +142,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)


@@ -207,8 +192,7 @@ is slower."
   "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)))))
 


@@ -220,7 +204,7 @@ is slower."
 
 (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)))))


@@ -235,12 +219,15 @@ is slower."
 
 (defun gnus-remove-text-with-property (prop)
   "Delete all text in the current buffer with text property PROP."
 
 (defun gnus-remove-text-with-property (prop)
   "Delete all text in the current buffer with text property PROP."

-  (save-excursion
-    (goto-char (point-min))
-    (while (not (eobp))
-      (while (get-text-property (point) prop)
-       (delete-char 1))
-      (goto-char (next-single-property-change (point) prop nil (point-max))))))
+  (let ((start (point-min))
+       end)
+    (unless (get-text-property start prop)
+      (setq start (next-single-property-change start prop)))
+    (while start
+      (setq end (text-property-any start (point-max) prop nil))
+      (delete-region start (or end (point-max)))
+      (setq start (when end
+                   (next-single-property-change start prop))))))

 
 (defun gnus-newsgroup-directory-form (newsgroup)
   "Make hierarchical directory name from NEWSGROUP name."
 
 (defun gnus-newsgroup-directory-form (newsgroup)
   "Make hierarchical directory name from NEWSGROUP name."


@@ -342,18 +329,18 @@ is slower."
 ;; 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)


@@ -384,7 +371,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 ()


@@ -492,12 +479,23 @@ inside loops."
 (defun gnus-split-references (references)
   "Return a list of Message-IDs in REFERENCES."
   (let ((beg 0)
 (defun gnus-split-references (references)
   "Return a list of Message-IDs in REFERENCES."
   (let ((beg 0)

+       (references (or references ""))

        ids)
     (while (string-match "<[^<]+[^< \t]" references beg)
       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
            ids))
     (nreverse ids)))
 
        ids)
     (while (string-match "<[^<]+[^< \t]" references beg)
       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
            ids))
     (nreverse ids)))
 

+(defun gnus-extract-references (references)
+  "Return a list of Message-IDs in REFERENCES (in In-Reply-To
+  format), trimmed to only contain the Message-IDs."
+  (let ((ids (gnus-split-references references)) 
+       refs)
+    (dolist (id ids)
+      (when (string-match "<[^<>]+>" id)
+       (push (match-string 0 id) refs)))
+    refs))
+

 (defsubst gnus-parent-id (references &optional n)
   "Return the last Message-ID in REFERENCES.
 If N, return the Nth ancestor instead."
 (defsubst gnus-parent-id (references &optional n)
   "Return the last Message-ID in REFERENCES.
 If N, return the Nth ancestor instead."


@@ -583,8 +581,17 @@ If N, return the Nth ancestor instead."
         (substring gname (match-end 0))
        gname)))
 
         (substring gname (match-end 0))
        gname)))
 

+(defmacro gnus-group-server (group)
+  "Find the server name of a foreign newsgroup.
+For example, (gnus-group-server \"nnimap+yxa:INBOX.foo\") would
+yield \"nnimap:yxa\"."
+  `(let ((gname ,group))
+     (if (string-match "^\\([^+]+\\).\\([^:]+\\):" gname)
+        (format "%s:%s" (match-string 1 gname) (match-string 2 gname))
+       (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method)))))
+

 (defun gnus-make-sort-function (funs)
 (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)


@@ -601,7 +608,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))


@@ -628,24 +635,49 @@ If N, return the Nth ancestor instead."
   (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
     [menu-bar edit] 'undefined))
 
   (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
     [menu-bar edit] 'undefined))
 

+(defmacro gnus-bind-print-variables (&rest forms)
+  "Bind print-* variables and evaluate FORMS.
+This macro is used with `prin1', `pp', etc. in order to ensure printed
+Lisp objects are loadable.  Bind `print-quoted' and `print-readably'
+to t, and `print-escape-multibyte', `print-escape-newlines',
+`print-escape-nonascii', `print-length', `print-level' and
+`print-string-length' to nil."
+  `(let ((print-quoted t)
+        (print-readably t)
+        ;;print-circle
+        ;;print-continuous-numbering
+        print-escape-multibyte
+        print-escape-newlines
+        print-escape-nonascii
+        ;;print-gensym
+        print-length
+        print-level
+        print-string-length)
+     ,@forms))
+

 (defun gnus-prin1 (form)
   "Use `prin1' on FORM in the current buffer.
 (defun gnus-prin1 (form)
   "Use `prin1' on FORM in the current buffer.

-Bind `print-quoted' and `print-readably' to t while printing."
-  (let ((print-quoted t)
-       (print-readably t)
-       (print-escape-multibyte nil)
-       print-level print-length)
-    (prin1 form (current-buffer))))
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil.  See also `gnus-bind-print-variables'."
+  (gnus-bind-print-variables (prin1 form (current-buffer))))

 
 (defun gnus-prin1-to-string (form)
   "The same as `prin1'.
 
 (defun gnus-prin1-to-string (form)
   "The same as `prin1'.

-Bind `print-quoted' and `print-readably' to t, and `print-length'
-and `print-level' to nil."
-  (let ((print-quoted t)
-       (print-readably t)
-       (print-length nil)
-       (print-level nil))
-    (prin1-to-string form)))
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil.  See also `gnus-bind-print-variables'."
+  (gnus-bind-print-variables (prin1-to-string form)))
+
+(defun gnus-pp (form &optional stream)
+  "Use `pp' on FORM in the current buffer.
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil.  See also `gnus-bind-print-variables'."
+  (gnus-bind-print-variables (pp form (or stream (current-buffer)))))
+
+(defun gnus-pp-to-string (form)
+  "The same as `pp-to-string'.
+Bind `print-quoted' and `print-readably' to t, and `print-length' and
+`print-level' to nil.  See also `gnus-bind-print-variables'."
+  (gnus-bind-print-variables (pp-to-string form)))

 
 (defun gnus-make-directory (directory)
   "Make DIRECTORY (and all its parents) if it doesn't exist."
 
 (defun gnus-make-directory (directory)
   "Make DIRECTORY (and all its parents) if it doesn't exist."


@@ -669,6 +701,23 @@ and `print-level' to nil."
   (when (file-exists-p file)
     (delete-file file)))
 
   (when (file-exists-p file)
     (delete-file file)))
 

+(defun gnus-delete-directory (directory)
+  "Delete files in DIRECTORY.  Subdirectories remain.
+If there's no subdirectory, delete DIRECTORY as well."
+  (when (file-directory-p directory)
+    (let ((files (directory-files
+                 directory t "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
+         file dir)
+      (while files
+       (setq file (pop files))
+       (if (eq t (car (file-attributes file)))
+           ;; `file' is a subdirectory.
+           (setq dir t)
+         ;; `file' is a file or a symlink.
+         (delete-file file)))
+      (unless dir
+       (delete-directory directory)))))
+

 (defun gnus-strip-whitespace (string)
   "Return STRING stripped of all whitespace."
   (while (string-match "[\r\n\t ]+" string)
 (defun gnus-strip-whitespace (string)
   "Return STRING stripped of all whitespace."
   (while (string-match "[\r\n\t ]+" string)


@@ -803,6 +852,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))
 


@@ -931,7 +997,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)))


@@ -988,7 +1054,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) ".*$")))


@@ -1052,7 +1118,7 @@ Return the modified alist."
             (standard-output
             (lambda (c)
                (aset ,buffer ,leng c)
             (standard-output
             (lambda (c)
                (aset ,buffer ,leng c)

-                   
+

               (if (= ,size (setq ,leng (1+ ,leng)))
                   (progn (write-region ,buffer nil ,file ,append 'no-msg)
                          (setq ,leng 0
               (if (= ,size (setq ,leng (1+ ,leng)))
                   (progn (write-region ,buffer nil ,file ,append 'no-msg)
                          (setq ,leng 0


@@ -1121,7 +1187,7 @@ Return the modified alist."
 Setting it to nil has no effect after the first time `gnus-byte-compile'
 is run."
   :type 'boolean
 Setting it to nil has no effect after the first time `gnus-byte-compile'
 is run."
   :type 'boolean

-  :version "21.1"
+  :version "22.1"

   :group 'gnus-various)
 
 (defun gnus-byte-compile (form)
   :group 'gnus-various)
 
 (defun gnus-byte-compile (form)


@@ -1144,7 +1210,7 @@ is run."
   "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
   "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
+by side effect; therefore, write `(setq foo (gnus-remassoc key foo))' to be

 sure of changing the value of `foo'."
   (when alist
     (if (equal key (caar alist))
 sure of changing the value of `foo'."
   (when alist
     (if (equal key (caar alist))


@@ -1187,7 +1253,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)


@@ -1222,32 +1287,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 ": "))


@@ -1433,6 +1478,78 @@ 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)
+  (defvar sxemacs-codename)
+  (defvar emacs-program-version))
+
+(defun gnus-emacs-version ()
+  "Stringified Emacs version."
+  (let* ((lst (if (listp gnus-user-agent)
+                 gnus-user-agent
+               '(gnus emacs type)))
+        (system-v (cond ((memq 'config lst)
+                         system-configuration)
+                        ((memq 'type lst)
+                         (symbol-name system-type))
+                        (t nil)))
+        codename emacsname)
+    (cond ((featurep 'sxemacs)
+          (setq emacsname "SXEmacs"
+                codename sxemacs-codename))
+         ((featurep 'xemacs)
+          (setq emacsname "XEmacs"
+                codename xemacs-codename))
+         (t
+          (setq emacsname "Emacs")))
+    (cond
+     ((not (memq 'emacs lst))
+      nil)
+     ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
+      ;; Emacs:
+      (concat "Emacs/" (match-string 1 emacs-version)
+             (if system-v
+                 (concat " (" system-v ")")
+               "")))
+     ((or (featurep 'sxemacs) (featurep 'xemacs))
+      ;; XEmacs or SXEmacs:
+      (concat emacsname "/" emacs-program-version
+             " ("
+             (when (and (memq 'codename lst)
+                        codename)
+               (concat codename
+                       (when system-v ", ")))
+             (when system-v system-v)
+             ")"))
+     (t emacs-version))))
+
+(defun gnus-rename-file (old-path new-path &optional trim)
+  "Rename OLD-PATH as NEW-PATH.  If TRIM, recursively delete
+empty directories from OLD-PATH."
+  (when (file-exists-p old-path)
+    (let* ((old-dir (file-name-directory old-path))
+          (old-name (file-name-nondirectory old-path))
+          (new-dir (file-name-directory new-path))
+          (new-name (file-name-nondirectory new-path))
+          temp)
+      (gnus-make-directory new-dir)
+      (rename-file old-path new-path t)
+      (when trim
+       (while (progn (setq temp (directory-files old-dir))
+                     (while (member (car temp) '("." ".."))
+                       (setq temp (cdr temp)))
+                     (= (length temp) 0))
+         (delete-directory old-dir)
+         (setq old-dir (file-name-as-directory
+                        (file-truename
+                         (concat old-dir "..")))))))))
+
+(defun gnus-set-file-modes (filename mode)
+  "Wrapper for set-file-modes."
+  (ignore-errors
+    (set-file-modes filename mode)))
+

 (provide 'gnus-util)
 
 (provide 'gnus-util)
 

+;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49

 ;;; gnus-util.el ends here
 ;;; gnus-util.el ends here