X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=4c1b32e4ef267dbf65409e8b5caacce8803ac1cd;hb=27688c4fe73986a46e3f2cb9051170f41ef82f4c;hp=c58fa16ceba7a3be0b566c3425fdc950baff4fab;hpb=4bcd16b887f6cc77798fa83d85cb7bfa9633b7fb;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index c58fa16..4c1b32e 100644
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1,5 +1,5 @@
 ;;; gnus-util.el --- utility functions for Semi-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>
@@ -20,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -1033,6 +1033,13 @@ ARG is passed to the first function."
   (save-current-buffer
     (apply 'run-hooks funcs)))
 
+(defun gnus-run-mode-hooks (&rest funcs)
+  "Run `run-mode-hooks' if it is available, otherwise `run-hooks'.
+This function saves the current buffer."
+  (if (fboundp 'run-mode-hooks)
+      (save-current-buffer (apply 'run-mode-hooks funcs))
+    (save-current-buffer (apply 'run-hooks funcs))))
+
 ;;; Various
 
 (defvar gnus-group-buffer)		; Compiler directive
@@ -1143,7 +1150,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
@@ -1212,7 +1219,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)
@@ -1504,42 +1511,64 @@ 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)
+  (unless (featurep 'meadow)
+    (defalias 'Meadow-version 'ignore)))
 
 (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)))
+	 (mule-v (when (and (memq 'mule lst)
+			    (featurep 'mule))
+		   (concat
+		    " MULE"
+		    (when (boundp 'mule-version)
+		      (concat "/" (symbol-value 'mule-version)))
+		    (when (featurep 'meadow)
+		      (let ((mver (Meadow-version)))
+			(if (string-match "^Meadow-" mver)
+			    (concat " Meadow/"
+				    (substring mver (match-end 0)))))))))
+	 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 ")")
-	      ")"))
-	 "")))
-     (t emacs-version))))
+		"")
+	      mule-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)
+	      ")"
+	      mule-v))
+     (t (concat emacs-version mule-v)))))
 
 (defun gnus-rename-file (old-path new-path &optional trim)
   "Rename OLD-PATH as NEW-PATH.  If TRIM, recursively delete
@@ -1558,8 +1587,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)
@@ -1567,6 +1596,12 @@ empty directories from OLD-PATH."
   (ignore-errors
     (set-file-modes filename mode)))
 
+(if (fboundp 'set-process-query-on-exit-flag)
+    (defalias 'gnus-set-process-query-on-exit-flag
+      'set-process-query-on-exit-flag)
+  (defalias 'gnus-set-process-query-on-exit-flag
+    'process-kill-without-query))
+
 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here