X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=5e41816062c7f73e670fc20c9e69577b602039e9;hb=d0498ec691ac9cc3f6bdd9f4ba3ac26457cc3d8a;hp=855ca969f7f2bb65f65a9fc89e6ed8edcc27f7d4;hpb=4b41275525751899e167289322e192b3c0db35b9;p=gnus

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 855ca969f..5e4181606 100644
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -28,19 +28,98 @@
 
 (eval '(run-hooks 'gnus-load-hook))
 
-(defconst gnus-version-number "0.11"
+(require 'custom)
+
+(defgroup gnus nil
+  "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
+  :group 'emacs)
+
+(defgroup gnus-start nil
+  "Starting your favorite newsreader."
+  :group 'gnus)
+
+(defgroup gnus-score nil
+  "Score and kill file handling."
+  :group 'gnus )
+
+(defconst gnus-version-number "0.43"
   "Version number for this version of Gnus.")
 
 (defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
   "Version string for this version of Gnus.")
 
-(defvar gnus-inhibit-startup-message nil
-  "*If non-nil, the startup message will not be displayed.")
+(defcustom gnus-inhibit-startup-message nil
+  "*If non-nil, the startup message will not be displayed."
+  :group 'gnus-start
+  :type 'boolean)
+
+(defcustom gnus-play-startup-jingle nil
+  "If non-nil, play the Gnus jingle at startup."
+  :group 'gnus-start
+  :type 'boolean)
+
+;;; Kludges to help the transition from the old `custom.el'.
+
+;; XEmacs and Emacs 19.29 facep does different things.
+(defalias 'custom-facep
+  (cond ((fboundp 'find-face)
+	 'find-face)
+	((fboundp 'facep)
+	 'facep)
+	(t
+	 'ignore)))
+
+;; The XEmacs people think this is evil, so it must go.
+(defun custom-face-lookup (&optional fg bg stipple bold italic underline)
+  "Lookup or create a face with specified attributes."
+  (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
+			      (or fg "default")
+			      (or bg "default")
+			      (or stipple "default")
+			      bold italic underline))))
+    (if (and (custom-facep name)
+	     (fboundp 'make-face))
+	()
+      (copy-face 'default name)
+      (when (and fg
+		 (not (string-equal fg "default")))
+	(condition-case ()
+	    (set-face-foreground name fg)
+	  (error nil)))
+      (when (and bg
+		 (not (string-equal bg "default")))
+	(condition-case ()
+	    (set-face-background name bg)
+	  (error nil)))
+      (when (and stipple
+		 (not (string-equal stipple "default"))
+		 (not (eq stipple 'custom:asis))
+		 (fboundp 'set-face-stipple))
+	(set-face-stipple name stipple))
+      (when (and bold
+		 (not (eq bold 'custom:asis)))
+	(condition-case ()
+	    (make-face-bold name)
+	  (error nil)))
+      (when (and italic
+		 (not (eq italic 'custom:asis)))
+	(condition-case ()
+	    (make-face-italic name)
+	  (error nil)))
+      (when (and underline
+		 (not (eq underline 'custom:asis)))
+	(condition-case ()
+	    (set-face-underline-p name t)
+	  (error nil))))
+    name))
 
 ;;; Internal variables
 
 (defvar gnus-group-buffer "*Group*")
 
+(eval-and-compile
+  (autoload 'gnus-play-jingle "gnus-audio"))
+
 ;;; Splash screen.
 
 (defun gnus-splash ()
@@ -50,7 +129,9 @@
       (erase-buffer)
       (unless gnus-inhibit-startup-message
 	(gnus-group-startup-message)
-	(sit-for 0)))))
+	(sit-for 0)
+	(when gnus-play-startup-jingle
+	  (gnus-play-jingle))))))
 
 (defun gnus-indent-rigidly (start end arg)
   "Indent rigidly using only spaces and no tabs."
@@ -108,7 +189,10 @@
   (set-buffer-modified-p t))
 
 (eval-when (load)
-  (gnus-splash))
+  (let ((command (format "%s" this-command)))
+    (when (and (string-match "gnus" command)
+	       (not (string-match "gnus-other-frame" command)))
+      (gnus-splash))))
 
 ;;; Do the rest.
 
@@ -134,6 +218,7 @@
 (defmacro gnus-sethash (string value hashtable)
   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
   `(set (intern ,string ,hashtable) ,value))
+(put 'nnheader-temp-write 'edebug-form-spec '(form form form))
 
 (defmacro gnus-group-unread (group)
   "Get the currently computed number of unread articles in GROUP."
@@ -237,7 +322,6 @@
 
 ;;; Load the compatability functions.
 
-(require 'gnus-cus)
 (require 'gnus-ems)
 
 
@@ -333,19 +417,27 @@ that that variable is buffer-local to the summary buffers."
 
 (defun gnus-group-total-expirable-p (group)
   "Check whether GROUP is total-expirable or not."
-  (let ((params (gnus-group-find-parameter group)))
-    (or (memq 'total-expire params)
-	(cdr (assq 'total-expire params)) ; (total-expire . t)
-	(and gnus-total-expirable-newsgroups ; Check var.
-	     (string-match gnus-total-expirable-newsgroups group)))))
+  (let ((params (gnus-group-find-parameter group))
+	val)
+    (cond
+     ((memq 'total-expire params)
+      t)
+     ((setq val (assq 'total-expire params)) ; (auto-expire . t)
+      (cdr val))
+     (gnus-total-expirable-newsgroups	; Check var.
+      (string-match gnus-total-expirable-newsgroups group)))))
 
 (defun gnus-group-auto-expirable-p (group)
   "Check whether GROUP is total-expirable or not."
-  (let ((params (gnus-group-find-parameter group)))
-    (or (memq 'auto-expire params)
-	(cdr (assq 'auto-expire params)) ; (auto-expire . t)
-	(and gnus-auto-expirable-newsgroups ; Check var.
-	     (string-match gnus-auto-expirable-newsgroups group)))))
+  (let ((params (gnus-group-find-parameter group))
+	val)
+    (cond
+     ((memq 'auto-expire params)
+      t)
+     ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
+      (cdr val))
+     (gnus-auto-expirable-newsgroups	; Check var.
+      (string-match gnus-auto-expirable-newsgroups group)))))
 
 (defun gnus-virtual-group-p (group)
   "Say whether GROUP is virtual or not."
@@ -393,6 +485,10 @@ that that variable is buffer-local to the summary buffers."
   "Return the quit-config of GROUP."
   (gnus-group-get-parameter group 'quit-config))
 
+(defun gnus-kill-ephemeral-group (group)
+  "Remove ephemeral GROUP from relevant structures."
+  (gnus-sethash group nil gnus-newsrc-hashtb))
+
 (defun gnus-simplify-mode-line ()
   "Make mode lines a bit simpler."
   (setq mode-line-modified "-- ")
@@ -436,6 +532,8 @@ that that variable is buffer-local to the summary buffers."
    (and (equal server "native") gnus-select-method)
    ;; It should be in the server alist.
    (cdr (assoc server gnus-server-alist))
+   ;; It could be in the predefined server alist.
+   (cdr (assoc server gnus-predefined-server-alist))
    ;; If not, we look through all the opened server
    ;; to see whether we can find it there.
    (let ((opened gnus-opened-servers))
@@ -585,7 +683,7 @@ If SYMBOL, return the value of that symbol in the group parameters."
   "Add parameter PARAM to GROUP."
   (let ((info (gnus-get-info group)))
     (if (not info)
-	() ; This is a dead group.  We just ignore it.
+	()				; This is a dead group.  We just ignore it.
       ;; Cons the new param to the old one and update.
       (gnus-group-set-info (cons param (gnus-info-params info))
 			   group 'params))))
@@ -594,7 +692,7 @@ If SYMBOL, return the value of that symbol in the group parameters."
   "Set parameter NAME to VALUE in GROUP."
   (let ((info (gnus-get-info group)))
     (if (not info)
-	() ; This is a dead group.  We just ignore it.
+	()				; This is a dead group.  We just ignore it.
       (let ((old-params (gnus-info-params info))
 	    (new-params (list (cons name value))))
 	(while old-params
@@ -676,8 +774,10 @@ Returns the number of articles marked as read."
 	(and (buffer-modified-p) (save-buffer))
 	(kill-buffer (current-buffer))))))
 
-(defvar gnus-kill-file-name "KILL"
-  "Suffix of the kill files.")
+(defcustom gnus-kill-file-name "KILL"
+  "Suffix of the kill files."
+  :group 'gnus-score
+  :type 'string)
 
 (defun gnus-newsgroup-kill-file (newsgroup)
   "Return the name of a kill file name for NEWSGROUP.
@@ -788,7 +888,8 @@ If NEWSGROUP is nil, return the global kill file name instead."
 Allow completion over sensible values."
   (let ((method
 	 (completing-read
-	  prompt (append gnus-valid-select-methods gnus-server-alist)
+	  prompt (append gnus-valid-select-methods gnus-predefined-server-alist
+			 gnus-server-alist)
 	  nil t nil 'gnus-method-history)))
     (cond 
      ((equal method "")
@@ -800,7 +901,7 @@ Allow completion over sensible values."
 		(read-string "Address: ")
 	      "")))
      ((assoc method gnus-server-alist)
-      (cdr (assoc method gnus-server-alist)))
+      method)
      (t
       (list (intern method) "")))))
 
@@ -833,7 +934,7 @@ As opposed to `gnus', this command will not connect to the local server."
 (defun gnus-other-frame (&optional arg)
   "Pop up a frame to read news."
   (interactive "P")
-  (if (get-buffer gnus-group-buffer)
+  (if (gnus-alive-p)
       (let ((pop-up-frames t))
 	(gnus arg))
     (select-frame (make-frame))