Mercurial > emacs

changeset 15557:2867ce9fc2e2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Synched with Gnus 5.2.31.
author Lars Magne Ingebrigtsen <larsi@gnus.org>
date Sat, 29 Jun 1996 00:09:34 +0000
parents bb72fd0a69b7
children 18364c2808f7
files lisp/gnus.el
diffstat 1 files changed, 110 insertions(+), 45 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus.el	Fri Jun 28 20:03:15 1996 +0000
+++ b/lisp/gnus.el	Sat Jun 29 00:09:34 1996 +0000
@@ -31,9 +31,9 @@
 (require 'mail-utils)
 (require 'timezone)
 (require 'nnheader)
-(require 'message)
 (require 'nnmail)
 (require 'backquote)
+(require 'nnoo)
 
 (eval-when-compile (require 'cl))
 
@@ -149,6 +149,19 @@
 run Gnus once.  After doing that, you must edit this server from the
 server buffer.")
 
+(defvar gnus-message-archive-group nil
+  "*Name of the group in which to save the messages you've written.
+This can either be a string, a list of strings; or an alist
+of regexps/functions/forms to be evaluated to return a string (or a list
+of strings).  The functions are called with the name of the current
+group (or nil) as a parameter.
+
+Normally the group names returned by this variable should be
+unprefixed -- which implictly means \"store on the archive server\".
+However, you may wish to store the message on some other server.  In
+that case, just return a fully prefixed name of the group --
+\"nnml+private:mail.misc\", for instance.")
+
 (defvar gnus-refer-article-method nil
   "*Preferred method for fetching an article by Message-ID.
 If you are reading news from the local spool (with nnspool), fetching
@@ -204,8 +217,8 @@
 fetched by ange-ftp.
 
 This variable can also be a list of directories.  In that case, the
-first element in the list will be used by default, and the others will
-be used as backup sites.
+first element in the list will be used by default.  The others can
+be used when being prompted for a site.
 
 Note that Gnus uses an aol machine as the default directory.  If this
 feels fundamentally unclean, just think of it as a way to finally get
@@ -864,7 +877,6 @@
        '(vertical 1.0
 		 (summary 0.25 point)
 		 (if gnus-carpal '(summary-carpal 4))
-		 (if gnus-use-trees '(tree 0.25))
 		 (article 1.0)))))
     (server
      (vertical 1.0
@@ -1314,12 +1326,20 @@
   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
   "*All new groups that match this regexp will be subscribed automatically.
 Note that this variable only deals with new groups.  It has no effect
-whatsoever on old groups.")
+whatsoever on old groups.
+
+New groups that match this regexp will not be handled by
+`gnus-subscribe-newsgroup-method'.  Instead, they will
+be subscribed using `gnus-subscribe-options-newsgroup-method'.")
 
 (defvar gnus-options-subscribe nil
   "*All new groups matching this regexp will be subscribed unconditionally.
 Note that this variable deals only with new newsgroups.	 This variable
-does not affect old newsgroups.")
+does not affect old newsgroups.
+
+New groups that match this regexp will not be handled by
+`gnus-subscribe-newsgroup-method'.  Instead, they will
+be subscribed using `gnus-subscribe-options-newsgroup-method'.")
 
 (defvar gnus-options-not-subscribe nil
   "*All new groups matching this regexp will be ignored.
@@ -1730,7 +1750,7 @@
   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
   "The mail address of the Gnus maintainers.")
 
-(defconst gnus-version-number "5.3"
+(defconst gnus-version-number "5.2.31"
   "Version number for this version of Gnus.")
 
 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
@@ -2096,7 +2116,8 @@
       gnus-summary-mail-forward gnus-summary-mail-other-window
       gnus-bug)
      ("gnus-picon" :interactive t gnus-article-display-picons
-      gnus-group-display-picons gnus-picons-article-display-x-face)
+      gnus-group-display-picons gnus-picons-article-display-x-face
+      gnus-picons-display-x-face)
      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 
       gnus-grouplens-mode)
      ("smiley" :interactive t gnus-smiley-display)
@@ -3013,7 +3034,8 @@
 	(setq groupkey
 	      (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
 		  (substring groupkey (match-beginning 1) (match-end 1)))))
-      (gnus-subscribe-newsgroup newgroup before))))
+      (gnus-subscribe-newsgroup newgroup before))
+    (kill-buffer (current-buffer))))
 
 (defun gnus-subscribe-interactively (group)
   "Subscribe the new GROUP interactively.
@@ -3215,6 +3237,7 @@
 	gnus-group-mark-positions nil
 	gnus-newsgroup-data nil
 	gnus-newsgroup-unreads nil
+	nnoo-state-alist nil
 	gnus-current-select-method nil)
   (gnus-shutdown 'gnus)
   ;; Kill the startup file.
@@ -3804,7 +3827,7 @@
     (apply 'format args)))
 
 (defun gnus-error (level &rest args)
-  "Beep an error if `gnus-verbose' is on LEVEL or less."
+  "Beep an error if LEVEL is equal to or less than `gnus-verbose'."
   (when (<= (floor level) gnus-verbose)
     (apply 'message args)
     (ding)
@@ -4754,6 +4777,20 @@
       (pop opened))
     out))
 
+(defun gnus-archive-server-wanted-p ()
+  "Say whether the user wants to use the archive server."
+  (cond 
+   ((or (not gnus-message-archive-method)
+	(not gnus-message-archive-group))
+    nil)
+   ((and gnus-message-archive-method gnus-message-archive-group)
+    t)
+   (t
+    (let ((active (cadr (assq 'nnfolder-active-file
+			      gnus-message-archive-method))))
+      (and active
+	   (file-exists-p active))))))
+
 (defun gnus-group-prefixed-name (group method)
   "Return the whole name from GROUP and METHOD."
   (and (stringp method) (setq method (gnus-server-to-method method)))
@@ -6407,8 +6444,10 @@
     (let* ((prev gnus-newsrc-alist)
 	   (alist (cdr prev)))
       (while alist
-	(if (= (gnus-info-level level) level)
-	    (setcdr prev (cdr alist))
+	(if (= (gnus-info-level (car alist)) level)
+	    (progn
+	      (push (gnus-info-group (car alist)) gnus-killed-list)
+	      (setcdr prev (cdr alist)))
 	  (setq prev alist))
 	(setq alist (cdr alist)))
       (gnus-make-hashtable-from-newsrc-alist)
@@ -6529,7 +6568,10 @@
 	    (unless (gnus-virtual-group-p group)
 	      (gnus-close-group group))
 	    (gnus-group-update-group group))
-	(gnus-error 3 "%s error: %s" group (gnus-status-message group))))
+	(if (eq (gnus-server-status (gnus-find-method-for-group group))
+		'denied)
+	    (gnus-error "Server denied access")
+	  (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
     (when beg (goto-char beg))
     (when gnus-goto-next-group-when-activating
       (gnus-group-next-unread-group 1 t))
@@ -6561,18 +6603,17 @@
 (defun gnus-group-describe-group (force &optional group)
   "Display a description of the current newsgroup."
   (interactive (list current-prefix-arg (gnus-group-group-name)))
-  (when (and force
-	     gnus-description-hashtb)
-    (gnus-sethash group nil gnus-description-hashtb))
-  (let ((method (gnus-find-method-for-group group))
-	desc)
+  (let* ((method (gnus-find-method-for-group group))
+	 (mname (gnus-group-prefixed-name "" method))
+	 desc)
+    (when (and force
+	       gnus-description-hashtb)
+      (gnus-sethash mname nil gnus-description-hashtb))
     (or group (error "No group name given"))
     (and (or (and gnus-description-hashtb
 		  ;; We check whether this group's method has been
 		  ;; queried for a description file.
-		  (gnus-gethash
-		   (gnus-group-prefixed-name "" method)
-		   gnus-description-hashtb))
+		  (gnus-gethash mname gnus-description-hashtb))
 	     (setq desc (gnus-group-get-description group))
 	     (gnus-read-descriptions-file method))
 	 (gnus-message 1
@@ -7202,6 +7243,8 @@
   (make-local-variable 'gnus-summary-line-format)
   (make-local-variable 'gnus-summary-line-format-spec)
   (make-local-variable 'gnus-summary-mark-positions)
+  (gnus-make-local-hook 'post-command-hook)
+  (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
   (run-hooks 'gnus-summary-mode-hook))
 
 (defun gnus-summary-make-local-variables ()
@@ -8429,11 +8472,16 @@
   ;; This function find the total score of the thread below ROOT.
   (setq root (car root))
   (apply gnus-thread-score-function
-	 (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
-	     gnus-summary-default-score 0)
-	 (mapcar 'gnus-thread-total-score
-		 (cdr (gnus-gethash (mail-header-id root)
-				    gnus-newsgroup-dependencies)))))
+	 (or (append
+	      (mapcar 'gnus-thread-total-score
+		      (cdr (gnus-gethash (mail-header-id root)
+					 gnus-newsgroup-dependencies)))
+		 (if (> (mail-header-number root) 0)
+		     (list (or (cdr (assq (mail-header-number root) 
+					  gnus-newsgroup-scored))
+			       gnus-summary-default-score 0))))
+	     (list gnus-summary-default-score)
+	     '(0))))
 
 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
 (defvar gnus-tmp-prev-subject nil)
@@ -8558,7 +8606,8 @@
 	   ;; If the article lies outside the current limit,
 	   ;; then we do not display it.
 	   ((and (not (memq number gnus-newsgroup-limit))
-		 (not gnus-tmp-dummy-line))
+		 ;(not gnus-tmp-dummy-line)
+		 )
 	    (setq gnus-tmp-gathered
 		  (nconc (mapcar
 			  (lambda (h) (mail-header-number (car h)))
@@ -8939,7 +8988,7 @@
 	 (min (car active))
 	 (max (cdr active))
 	 (types gnus-article-mark-lists)
-	 (uncompressed '(score bookmark))
+	 (uncompressed '(score bookmark killed))
 	 marks var articles article mark)
 
     (while marked-lists
@@ -8955,12 +9004,12 @@
       ;; All articles have to be subsets of the active articles.
       (cond
        ;; Adjust "simple" lists.
-       ((memq mark '(tick dormant expirable reply killed save))
+       ((memq mark '(tick dormant expirable reply save))
 	(while articles
 	  (when (or (< (setq article (pop articles)) min) (> article max))
 	    (set var (delq article (symbol-value var))))))
        ;; Adjust assocs.
-       ((memq mark '(score bookmark))
+       ((memq mark uncompressed)
 	(while articles
 	  (when (or (not (consp (setq article (pop articles))))
 		    (< (car article) min)
@@ -10403,8 +10452,7 @@
    ;; If not, we try the first unread, if that is wanted.
    ((and subject
 	 gnus-auto-select-same
-	 (or (gnus-summary-first-unread-article)
-	     (eq (gnus-summary-article-mark) gnus-canceled-mark)))
+	 (gnus-summary-first-unread-article))
     (gnus-summary-position-point)
     (gnus-message 6 "Wrapped"))
    ;; Try to get next/previous article not displayed in this group.
@@ -10875,6 +10923,7 @@
   (setq gnus-newsgroup-limit articles)
   (let ((total (length gnus-newsgroup-data))
 	(data (gnus-data-find-list (gnus-summary-article-number)))
+	(gnus-summary-mark-below nil)	; Inhibit this.
 	found)
     ;; This will do all the work of generating the new summary buffer
     ;; according to the new limit.
@@ -11843,9 +11892,11 @@
   (interactive)
   (if (gnus-group-read-only-p)
       (progn
-	(gnus-summary-edit-article-postpone)
-	(gnus-error
-	 1 "The current newsgroup does not support article editing."))
+	(let ((beep (not (eq major-mode 'text-mode))))
+	  (gnus-summary-edit-article-postpone)
+	  (when beep
+	    (gnus-error
+	     3 "The current newsgroup does not support article editing."))))
     (let ((buf (format "%s" (buffer-string))))
       (erase-buffer)
       (insert buf)
@@ -13484,6 +13535,7 @@
     "\M-\t" gnus-article-prev-button
     "<" beginning-of-buffer
     ">" end-of-buffer
+    "\C-c\C-i" gnus-info-find-node
     "\C-c\C-b" gnus-bug)
 
   (substitute-key-definition
@@ -14732,7 +14784,7 @@
   "Describe article mode commands briefly."
   (interactive)
   (gnus-message 6
-		(substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-next-page]:Next page	 \\[gnus-article-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
+		(substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page	 \\[gnus-article-goto-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
 
 (defun gnus-article-summary-command ()
   "Execute the last keystroke in the summary buffer."
@@ -14762,6 +14814,8 @@
 	 '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"	"a" "f" "F"
 	   "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
 	   "=" "^" "\M-^" "|"))
+	(nosave-but-article
+	 '("A\r"))
 	keys)
     (save-excursion
       (set-buffer gnus-summary-buffer)
@@ -14769,12 +14823,18 @@
       (setq keys (read-key-sequence nil)))
     (message "")
 
-    (if (member keys nosaves)
+    (if (or (member keys nosaves)
+	    (member keys nosave-but-article))
 	(let (func)
-	  (pop-to-buffer gnus-summary-buffer 'norecord)
-	  (if (setq func (lookup-key (current-local-map) keys))
-	      (call-interactively func)
-	    (ding)))
+	  (save-window-excursion
+	    (pop-to-buffer gnus-summary-buffer 'norecord)
+	    (setq func (lookup-key (current-local-map) keys)))
+	  (if (not func)
+	      (ding)
+	    (set-buffer gnus-summary-buffer)
+	    (call-interactively func))
+	  (when (member keys nosave-but-article)
+	    (pop-to-buffer gnus-article-buffer 'norecord)))
       (let ((obuf (current-buffer))
 	    (owin (current-window-configuration))
 	    (opoint (point))
@@ -14909,6 +14969,7 @@
 	(set-buffer gnus-dribble-buffer)
 	(insert string "\n")
 	(set-window-point (get-buffer-window (current-buffer)) (point-max))
+	(bury-buffer gnus-dribble-buffer)
 	(set-buffer obuf))))
 
 (defun gnus-dribble-read-file ()
@@ -15368,6 +15429,10 @@
     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
     (nconc entry (cdr method))))
 
+(defun gnus-server-status (method)
+  "Return the status of METHOD."
+  (nth 1 (assoc method gnus-opened-servers)))
+
 (defun gnus-group-name-to-method (group)
   "Return a select method suitable for GROUP."
   (if (string-match ":" group)
@@ -15438,7 +15503,7 @@
       (gnus-read-newsrc-file rawfile))
 
     (when (and (not (assoc "archive" gnus-server-alist))
-	       gnus-message-archive-method)
+	       (gnus-archive-server-wanted-p))
       (push (cons "archive" gnus-message-archive-method)
 	    gnus-server-alist))
 
@@ -15588,7 +15653,7 @@
   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
 	 (methods (cons gnus-select-method
 			(nconc
-			 (when gnus-message-archive-method
+			 (when (gnus-archive-server-wanted-p)
 			   (list "archive"))
 			 (append
 			  (and (consp gnus-check-new-newsgroups)
@@ -16187,7 +16252,7 @@
 	    ;; secondary ones.
 	    gnus-secondary-select-methods)
 	  ;; Also read from the archive server.
-	  (when gnus-message-archive-method
+	  (when (gnus-archive-server-wanted-p)
 	    (list "archive"))))
 	list-type)
     (setq gnus-have-read-active-file nil)
@@ -16999,7 +17064,7 @@
 (defun gnus-read-all-descriptions-files ()
   (let ((methods (cons gnus-select-method 
 		       (nconc
-			(when gnus-message-archive-method
+			(when (gnus-archive-server-wanted-p)
 			  (list "archive"))
 			gnus-secondary-select-methods))))
     (while methods