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 219ace0..8e49234 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1,5 +1,5 @@
 ;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -65,25 +65,7 @@ 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)))
-   (t
-    (defun gnus-replace-in-string (string regexp newtext &optional literal)
-      "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."
-      (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-regexp-in-string regexp newtext string nil literal)))))
 
 (defun gnus-boundp (variable)
   "Return non-nil if VARIABLE is bound and non-nil."
@@ -719,6 +701,23 @@ Bind `print-quoted' and `print-readably' to t, and `print-length' and
   (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)
@@ -1119,7 +1118,7 @@ Return the modified alist."
             (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
@@ -1188,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
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-various)
 
 (defun gnus-byte-compile (form)
@@ -1480,41 +1479,48 @@ predicate on the elements."
       (nconc (nreverse res) list1 list2))))
 
 (eval-when-compile
-  (defvar xemacs-codename))
+  (defvar xemacs-codename)
+  (defvar sxemacs-codename)
+  (defvar emacs-program-version))
 
 (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))))
+  (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
-     ((eq gnus-user-agent 'gnus)
+     ((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 ")")
                "")))
-     ((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 ")")
+     ((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)
@@ -1534,8 +1540,8 @@ empty directories from OLD-PATH."
                        (setq temp (cdr temp)))
                      (= (length temp) 0))
          (delete-directory old-dir)
-         (setq old-dir (file-name-as-directory 
-                        (file-truename 
+         (setq old-dir (file-name-as-directory
+                        (file-truename
                          (concat old-dir "..")))))))))
 
 (defun gnus-set-file-modes (filename mode)