Mercurial > emacs
diff lisp/gnus/gnus-group.el @ 24357:15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
| author | Lars Magne Ingebrigtsen <larsi@gnus.org> |
|---|---|
| date | Sat, 20 Feb 1999 14:05:57 +0000 |
| parents | 5f1ab3dd344d |
| children | d0ccf995f1ae |
line wrap: on
line diff
--- a/lisp/gnus/gnus-group.el Sat Feb 20 13:52:45 1999 +0000 +++ b/lisp/gnus/gnus-group.el Sat Feb 20 14:05:57 1999 +0000 @@ -1,7 +1,7 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news ;; This file is part of GNU Emacs. @@ -27,6 +27,8 @@ (eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-start) (require 'nnmail) @@ -37,13 +39,13 @@ (require 'gnus-undo) (defcustom gnus-group-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" + "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives." :group 'gnus-group-foreign :type 'directory) (defcustom gnus-group-recent-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" + "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" "*The address of the most recent (ding) articles." :group 'gnus-group-foreign :type 'directory) @@ -89,7 +91,7 @@ If nil, no groups are permanently visible." :group 'gnus-group-listing - :type '(choice regexp (const nil))) + :type 'regexp) (defcustom gnus-list-groups-with-ticked-articles t "*If non-nil, list groups that have only ticked articles. @@ -261,10 +263,13 @@ :type 'hook) (defcustom gnus-useful-groups - `(("(ding) mailing list mirrored at sunsite.auc.dk" + '(("(ding) mailing list mirrored at sunsite.auc.dk" "emacs.ding" (nntp "sunsite.auc.dk" - (nntp-address "sunsite.auc.dk"))) + (nntp-address "sunsite.auc.dk"))) + ("gnus-bug archive" + "gnus-bug" + (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/")) ("Gnus help group" "gnus-help" (nndoc "gnus-help" @@ -275,7 +280,7 @@ (unless file (error "Couldn't find doc group")) file)))))) - "Alist of useful group-server pairs." + "*Alist of useful group-server pairs." :group 'gnus-group-listing :type '(repeat (list (string :tag "Description") (string :tag "Name") @@ -316,7 +321,7 @@ gnus-group-mail-low-empty-face) (t . gnus-group-mail-low-face)) - "Controls the highlighting of group buffer lines. + "*Controls the highlighting of group buffer lines. Below is a list of `Form'/`Face' pairs. When deciding how a a particular group line should be displayed, each form is @@ -428,6 +433,7 @@ "p" gnus-group-prev-unread-group "\177" gnus-group-prev-unread-group [delete] gnus-group-prev-unread-group + [backspace] gnus-group-prev-unread-group "N" gnus-group-next-group "P" gnus-group-prev-group "\M-n" gnus-group-next-unread-group-same-level @@ -707,7 +713,7 @@ (fboundp 'gnus-soup-pack-packet)] ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] - ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) + ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)]) ["Send a bug report" gnus-bug t] ["Send a mail" gnus-group-mail t] ["Post an article..." gnus-group-post-news t] @@ -726,10 +732,11 @@ ["Read manual" gnus-info-find-node t] ["Flush score cache" gnus-score-flush-cache t] ["Toggle topics" gnus-topic-mode t] + ["Send a bug report" gnus-bug t] ["Exit from Gnus" gnus-group-exit t] ["Exit without saving" gnus-group-quit t])) - (run-hooks 'gnus-group-menu-hook))) + (gnus-run-hooks 'gnus-group-menu-hook))) (defun gnus-group-mode () "Major mode for reading news. @@ -768,13 +775,16 @@ (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) (when gnus-use-undo (gnus-undo-mode 1)) - (run-hooks 'gnus-group-mode-hook)) + (when gnus-slave + (gnus-slave-mode)) + (gnus-run-hooks 'gnus-group-mode-hook)) (defun gnus-update-group-mark-positions () (save-excursion - (let ((gnus-process-mark 128) + (let ((gnus-process-mark ?\200) (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (make-vector 10 0))) + (gnus-active-hashtb (make-vector 10 0)) + (topic "")) (gnus-set-active "dummy.group" '(0 . 0)) (gnus-set-work-buffer) (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) @@ -810,9 +820,8 @@ (or level gnus-group-default-list-level gnus-level-subscribed)))) (defun gnus-group-setup-buffer () - (switch-to-buffer gnus-group-buffer) + (set-buffer (gnus-get-buffer-create gnus-group-buffer)) (unless (eq major-mode 'gnus-group-mode) - (gnus-add-current-to-buffer-list) (gnus-group-mode) (when gnus-carpal (gnus-carpal-setup-buffer 'group)))) @@ -946,7 +955,7 @@ (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) - (run-hooks 'gnus-group-prepare-hook) + (gnus-run-hooks 'gnus-group-prepare-hook) t)) (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) @@ -1052,7 +1061,7 @@ (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) (gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) + (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ; (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) (gnus-tmp-news-method (or (car gnus-tmp-method) "")) (gnus-tmp-news-method-string @@ -1088,7 +1097,7 @@ gnus-level ,gnus-tmp-level)) (when (inline (gnus-visual-p 'group-highlight 'highlight)) (forward-line -1) - (run-hooks 'gnus-group-update-hook) + (gnus-run-hooks 'gnus-group-update-hook) (forward-line)) ;; Allow XEmacs to remove front-sticky text properties. (gnus-group-remove-excess-properties))) @@ -1111,7 +1120,7 @@ (mailp (memq 'mail (assoc (symbol-name (car (or method gnus-select-method))) gnus-valid-select-methods))) - (level (or (gnus-info-level info) 9)) + (level (or (gnus-info-level info) gnus-level-killed)) (score (or (gnus-info-score info) 0)) (ticked (gnus-range-length (cdr (assq 'tick marked)))) (group-age (gnus-group-timestamp-delta group)) @@ -1122,7 +1131,7 @@ (setq list (cdr list))) (let ((face (cdar list))) (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property + (gnus-put-text-property-excluding-characters-with-faces beg end 'face (setq face (if (boundp face) (symbol-value face) face))) (gnus-extent-start-open beg))) @@ -1145,7 +1154,8 @@ found buffer-read-only) ;; Enter the current status into the dribble buffer. (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) - (when (and entry (not (gnus-ephemeral-group-p group))) + (when (and entry + (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter (concat "(gnus-group-set-info '" (gnus-prin1-to-string (nth 2 entry)) @@ -1161,7 +1171,7 @@ (gnus-group-insert-group-line-info group) (save-excursion (forward-line -1) - (run-hooks 'gnus-group-update-group-hook))) + (gnus-run-hooks 'gnus-group-update-group-hook))) (setq loc (1+ loc))) (unless (or found visible-only) ;; No such line in the buffer, find out where it's supposed to @@ -1183,7 +1193,7 @@ (gnus-group-insert-group-line-info group) (save-excursion (forward-line -1) - (run-hooks 'gnus-group-update-group-hook)))) + (gnus-run-hooks 'gnus-group-update-group-hook)))) (when gnus-group-update-group-function (funcall gnus-group-update-group-function group)) (gnus-group-set-mode-line))) @@ -1198,10 +1208,7 @@ (save-excursion (set-buffer gnus-group-buffer) (let* ((gformat (or gnus-group-mode-line-format-spec - (setq gnus-group-mode-line-format-spec - (gnus-parse-format - gnus-group-mode-line-format - gnus-group-mode-line-format-alist)))) + (gnus-set-format 'group-mode))) (gnus-tmp-news-server (cadr gnus-select-method)) (gnus-tmp-news-method (car gnus-select-method)) (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) @@ -1232,7 +1239,8 @@ (defun gnus-group-group-name () "Get the name of the newsgroup on the current line." (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) - (and group (symbol-name group)))) + (when group + (symbol-name group)))) (defun gnus-group-group-level () "Get the level of the newsgroup on the current line." @@ -1257,8 +1265,8 @@ (defun gnus-group-level (group) "Return the estimated level of GROUP." (or (gnus-info-level (gnus-get-info group)) - (and (member group gnus-zombie-list) 8) - 9)) + (and (member group gnus-zombie-list) gnus-level-zombie) + gnus-level-killed)) (defun gnus-group-search-forward (&optional backward all level first-too) "Find the next newsgroup with unread articles. @@ -1420,9 +1428,9 @@ (n (abs n)) group groups) (save-excursion - (while (and (> n 0) - (setq group (gnus-group-group-name))) - (push group groups) + (while (> n 0) + (if (setq group (gnus-group-group-name)) + (push group groups)) (setq n (1- n)) (gnus-group-next-group way))) (nreverse groups))) @@ -1447,25 +1455,33 @@ (let ((group (gnus-group-group-name))) (and group (list group)))))) -(defun gnus-group-iterate (arg function) - "Iterate FUNCTION over all process/prefixed groups. +;;; !!!Surely gnus-group-iterate should be a macro instead? I can't +;;; imagine why I went through these contortions... +(eval-and-compile + (let ((function (make-symbol "gnus-group-iterate-function")) + (window (make-symbol "gnus-group-iterate-window")) + (groups (make-symbol "gnus-group-iterate-groups")) + (group (make-symbol "gnus-group-iterate-group"))) + (eval + `(defun gnus-group-iterate (arg ,function) + "Iterate FUNCTION over all process/prefixed groups. FUNCTION will be called with the group name as the paremeter and with point over the group in question." - (let ((groups (gnus-group-process-prefix arg)) - (window (selected-window)) - group) - (while (setq group (pop groups)) - (select-window window) - (gnus-group-remove-mark group) - (save-selected-window - (save-excursion - (funcall function group)))))) + (let ((,groups (gnus-group-process-prefix arg)) + (,window (selected-window)) + ,group) + (while (setq ,group (pop ,groups)) + (select-window ,window) + (gnus-group-remove-mark ,group) + (save-selected-window + (save-excursion + (funcall ,function ,group))))))))) (put 'gnus-group-iterate 'lisp-indent-function 1) ;; Selecting groups. -(defun gnus-group-read-group (&optional all no-article group) +(defun gnus-group-read-group (&optional all no-article group select-articles) "Read news in this newsgroup. If the prefix argument ALL is non-nil, already read articles become readable. IF ALL is a number, fetch this number of articles. If the @@ -1496,7 +1512,7 @@ (cdr (assq 'tick marked))) (gnus-range-length (cdr (assq 'dormant marked))))))) - no-article nil no-display))) + no-article nil no-display nil select-articles))) (defun gnus-group-select-group (&optional all) "Select this newsgroup. @@ -1510,7 +1526,10 @@ "Select the current group \"quickly\". This means that no highlighting or scoring will be performed. If ALL (the prefix argument) is 0, don't even generate the summary -buffer." +buffer. + +This might be useful if you want to toggle threading +before entering the group." (interactive "P") (require 'gnus-score) (let (gnus-visual @@ -1539,10 +1558,6 @@ gnus-summary-mode-hook gnus-select-group-hook (group (gnus-group-group-name)) (method (gnus-find-method-for-group group))) - (setq method - `(,(car method) ,(concat (cadr method) "-ephemeral") - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method))) (gnus-group-read-ephemeral-group (gnus-group-prefixed-name group method) method))) @@ -1552,31 +1567,44 @@ Returns whether the fetching was successful or not." (interactive "sGroup name: ") (unless (get-buffer gnus-group-buffer) - (gnus)) + (gnus-no-server)) (gnus-group-read-group nil nil group)) +;;;###autoload +(defun gnus-fetch-group-other-frame (group) + "Pop up a frame and enter GROUP." + (interactive "P") + (let ((window (get-buffer-window gnus-group-buffer))) + (cond (window + (select-frame (window-frame window))) + ((= (length (frame-list)) 1) + (select-frame (make-frame))) + (t + (other-frame 1)))) + (gnus-fetch-group group)) + (defvar gnus-ephemeral-group-server 0) ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. (defun gnus-group-read-ephemeral-group (group method &optional activate - quit-config request-only) + quit-config request-only + select-articles) "Read GROUP from METHOD as an ephemeral group. If ACTIVATE, request the group first. If QUIT-CONFIG, use that window configuration when exiting from the ephemeral group. If REQUEST-ONLY, don't actually read the group; just request it. +If SELECT-ARTICLES, only select those articles. Return the name of the group is selection was successful." ;; Transform the select method into a unique server. - (let ((saddr (intern (format "%s-address" (car method))))) - (setq method (gnus-copy-sequence method)) - (require (car method)) - (when (boundp saddr) - (unless (assq saddr method) - (nconc method `((,saddr ,(cadr method)))) - (setf (cadr method) (format "%s-%d" (cadr method) - (incf gnus-ephemeral-group-server)))))) + (when (stringp method) + (setq method (gnus-server-to-method method))) + (setq method + `(,(car method) ,(concat (cadr method) "-ephemeral") + (,(intern (format "%s-address" (car method))) ,(cadr method)) + ,@(cddr method))) (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name group method)))) (gnus-sethash @@ -1588,6 +1616,7 @@ (cons gnus-summary-buffer gnus-current-window-configuration)))))) gnus-newsrc-hashtb) + (push method gnus-ephemeral-servers) (set-buffer gnus-group-buffer) (unless (gnus-check-server method) (error "Unable to contact server: %s" (gnus-status-message method))) @@ -1599,7 +1628,7 @@ (if request-only group (condition-case () - (when (gnus-group-read-group t t group) + (when (gnus-group-read-group t t group select-articles) group) ;;(error nil) (quit nil))))) @@ -1774,6 +1803,8 @@ (gnus-read-group "Group name: ") (gnus-read-method "From method: "))) + (when (stringp method) + (setq method (gnus-server-to-method method))) (let* ((meth (when (and method (not (gnus-server-equal method gnus-select-method))) (if address (list (intern method) address) @@ -1886,6 +1917,9 @@ (gnus-set-active new-name (gnus-active group)) (gnus-message 6 "Renaming group %s to %s...done" group new-name) new-name) + (setq gnus-killed-list (delete group gnus-killed-list)) + (gnus-set-active group nil) + (gnus-dribble-touch) (gnus-group-position-point))) (defun gnus-group-edit-group (group &optional part) @@ -1964,6 +1998,7 @@ (gnus-group-position-point))) (defun gnus-group-make-useful-group (group method) + "Create one of the groups described in `gnus-useful-groups'." (interactive (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups nil t) @@ -1979,8 +2014,7 @@ "Create the Gnus documentation group." (interactive) (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) - (file (nnheader-find-etc-directory "gnus-tut.txt" t)) - dir) + (file (nnheader-find-etc-directory "gnus-tut.txt" t))) (when (gnus-gethash name gnus-newsrc-hashtb) (error "Documentation group already exists")) (if (not file) @@ -2373,7 +2407,7 @@ (when (gnus-group-native-p (gnus-info-group info)) (gnus-info-clear-data info))) (gnus-get-unread-articles) - (gnus-dribble-enter "") + (gnus-dribble-touch) (when (gnus-y-or-n-p "Move the cache away to avoid problems in the future? ") (call-interactively 'gnus-cache-move-cache))))) @@ -2395,16 +2429,15 @@ (defun gnus-group-catchup-current (&optional n all) "Mark all articles not marked as unread in current newsgroup as read. -If prefix argument N is numeric, the ARG next newsgroups will be +If prefix argument N is numeric, the next N newsgroups will be caught up. If ALL is non-nil, marked articles will also be marked as read. Cross references (Xref: header) of articles are ignored. -The difference between N and actual number of newsgroups that were -caught up is returned." +The number of newsgroups that this function was unable to catch +up is returned." (interactive "P") - (unless (gnus-group-group-name) - (error "No group on the current line")) (let ((groups (gnus-group-process-prefix n)) (ret 0)) + (unless groups (error "No groups selected")) (if (not (or (not gnus-interactive-catchup) ;Without confirmation? gnus-expert-user @@ -2468,7 +2501,7 @@ (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) (let ((gnus-newsgroup-name group)) - (run-hooks 'gnus-group-catchup-group-hook)) + (gnus-run-hooks 'gnus-group-catchup-group-hook)) num)))) (defun gnus-group-expire-articles (&optional n) @@ -2592,7 +2625,7 @@ 'gnus-group-history))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond - ((string-match "^[ \t]$" group) + ((string-match "^[ \t]*$" group) (error "Empty group name")) (newsrc ;; Toggle subscription flag. @@ -2701,25 +2734,28 @@ (delq (assoc group gnus-newsrc-alist) gnus-newsrc-alist)) (when gnus-group-change-level-function - (funcall gnus-group-change-level-function group 9 3)) + (funcall gnus-group-change-level-function + group gnus-level-killed 3)) (cond ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) (push (cons (car entry) (nth 2 entry)) gnus-list-of-killed-groups) (setcdr (cdr entry) (cdddr entry))) ((member group gnus-zombie-list) - (setq gnus-zombie-list (delete group gnus-zombie-list))))) + (setq gnus-zombie-list (delete group gnus-zombie-list)))) + ;; There may be more than one instance displayed. + (while (gnus-group-goto-group group) + (gnus-delete-line))) (gnus-make-hashtable-from-newsrc-alist))) (gnus-group-position-point) (if (< (length out) 2) (car out) (nreverse out)))) (defun gnus-group-yank-group (&optional arg) - "Yank the last newsgroups killed with \\[gnus-group-kill-group], -inserting it before the current newsgroup. The numeric ARG specifies -how many newsgroups are to be yanked. The name of the newsgroup yanked -is returned, or (if several groups are yanked) a list of yanked groups -is returned." + "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup. +The numeric ARG specifies how many newsgroups are to be yanked. The +name of the newsgroup yanked is returned, or (if several groups are +yanked) a list of yanked groups is returned." (interactive "p") (setq arg (or arg 1)) (let (info group prev out) @@ -2843,7 +2879,7 @@ (defun gnus-activate-all-groups (level) "Activate absolutely all groups." - (interactive (list 7)) + (interactive (list gnus-level-unsubscribed)) (let ((gnus-activate-level level) (gnus-activate-foreign-newsgroups level)) (gnus-group-get-new-news))) @@ -2855,7 +2891,7 @@ \"hard\" re-reading of the active files from all servers." (interactive "P") (let ((gnus-inhibit-demon t)) - (run-hooks 'gnus-get-new-news-hook) + (gnus-run-hooks 'gnus-get-new-news-hook) ;; Read any slave files. (unless gnus-slave @@ -2882,7 +2918,7 @@ (gnus-get-unread-articles arg)) (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) (gnus-get-unread-articles arg))) - (run-hooks 'gnus-after-getting-new-news-hook) + (gnus-run-hooks 'gnus-after-getting-new-news-hook) (gnus-group-list-groups (and (numberp arg) (max (car gnus-group-list-mode) arg))))) @@ -2895,17 +2931,19 @@ (ret (if (numberp n) (- n (length groups)) 0)) (beg (unless n (point))) - group) + group method) (while (setq group (pop groups)) (gnus-group-remove-mark group) ;; Bypass any previous denials from the server. - (gnus-remove-denial (gnus-find-method-for-group group)) + (gnus-remove-denial (setq method (gnus-find-method-for-group group))) (if (gnus-activate-group group (if dont-scan nil 'scan)) (progn (gnus-get-unread-articles-in-group (gnus-get-info group) (gnus-active group) t) (unless (gnus-virtual-group-p group) (gnus-close-group group)) + (gnus-agent-save-group-info + method (gnus-group-real-name group) (gnus-active group)) (gnus-group-update-group group)) (if (eq (gnus-server-status (gnus-find-method-for-group group)) 'denied) @@ -2938,8 +2976,8 @@ (setq dirs (list dirs))) (while (and (not found) (setq dir (pop dirs))) - (setq file (concat (file-name-as-directory dir) - (gnus-group-real-name group))) + (let ((name (gnus-group-real-name group))) + (setq file (concat (file-name-as-directory dir) name))) (if (not (file-exists-p file)) (gnus-message 1 "No such file: %s" file) (let ((enable-local-variables nil)) @@ -3004,6 +3042,7 @@ (lambda (group) (and (symbol-name group) (string-match regexp (symbol-name group)) + (symbol-value group) (push (symbol-name group) groups))) gnus-active-hashtb) ;; Also go through all descriptions that are known to Gnus. @@ -3011,7 +3050,6 @@ (mapatoms (lambda (group) (and (string-match regexp (symbol-value group)) - (gnus-active (symbol-name group)) (push (symbol-name group) groups))) gnus-description-hashtb)) (if (not groups) @@ -3104,12 +3142,14 @@ (defun gnus-group-find-new-groups (&optional arg) "Search for new groups and add them. Each new group will be treated with `gnus-subscribe-newsgroup-method.' -If ARG (the prefix), use the `ask-server' method to query -the server for new groups." - (interactive "P") - (gnus-find-new-newsgroups arg) +With 1 C-u, use the `ask-server' method to query the server for new +groups. +With 2 C-u's, use most complete method possible to query the server +for new groups, and subscribe the new groups as zombies." + (interactive "p") + (gnus-find-new-newsgroups (or arg 1)) (gnus-group-list-groups)) - + (defun gnus-group-edit-global-kill (&optional article group) "Edit the global kill file. If GROUP, edit that local kill file instead." @@ -3137,18 +3177,15 @@ In fact, cleanup buffers except for group mode buffer. The hook gnus-suspend-gnus-hook is called before actually suspending." (interactive) - (run-hooks 'gnus-suspend-gnus-hook) + (gnus-run-hooks 'gnus-suspend-gnus-hook) ;; Kill Gnus buffers except for group mode buffer. - (let* ((group-buf (get-buffer gnus-group-buffer)) - ;; Do this on a separate list in case the user does a ^G before we finish - (gnus-buffer-list - (delete group-buf (delete gnus-dribble-buffer - (append gnus-buffer-list nil))))) - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) + (let ((group-buf (get-buffer gnus-group-buffer))) + (mapcar (lambda (buf) + (unless (member buf (list group-buf gnus-dribble-buffer)) + (kill-buffer buf))) + (gnus-buffers)) (gnus-kill-gnus-frames) (when group-buf - (setq gnus-buffer-list (list group-buf)) (bury-buffer group-buf) (delete-windows-on group-buf t)))) @@ -3167,7 +3204,7 @@ (not gnus-interactive-exit) ;Without confirmation gnus-expert-user (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) - (run-hooks 'gnus-exit-gnus-hook) + (gnus-run-hooks 'gnus-exit-gnus-hook) ;; Offer to save data from non-quitted summary buffers. (gnus-offer-save-summaries) ;; Save the newsrc file(s). @@ -3177,7 +3214,7 @@ ;; Reset everything. (gnus-clear-system) ;; Allow the user to do things after cleaning up. - (run-hooks 'gnus-after-exiting-gnus-hook))) + (gnus-run-hooks 'gnus-after-exiting-gnus-hook))) (defun gnus-group-quit () "Quit reading news without updating .newsrc.eld or .newsrc. @@ -3191,14 +3228,14 @@ (gnus-yes-or-no-p (format "Quit reading news without saving %s? " (file-name-nondirectory gnus-current-startup-file)))) - (run-hooks 'gnus-exit-gnus-hook) + (gnus-run-hooks 'gnus-exit-gnus-hook) (gnus-configure-windows 'group t) (gnus-dribble-save) (gnus-close-backends) (gnus-clear-system) (gnus-kill-buffer gnus-group-buffer) ;; Allow the user to do things after cleaning up. - (run-hooks 'gnus-after-exiting-gnus-hook))) + (gnus-run-hooks 'gnus-after-exiting-gnus-hook))) (defun gnus-group-describe-briefly () "Give a one line description of the group mode commands." @@ -3295,7 +3332,6 @@ ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. (let ((info (or info (gnus-get-info group))) - (uncompressed '(score bookmark killed)) marked m) (or (not info) (and (not (setq marked (nthcdr 3 info))) @@ -3311,7 +3347,7 @@ (if force (if (null articles) (setcar (nthcdr 3 info) - (delq (assq type (car marked)) (car marked))) + (gnus-delete-alist type (car marked))) (setcdr m (gnus-compress-sequence articles t))) (setcdr m (gnus-compress-sequence (sort (nconc (gnus-uncompress-range (cdr m)) @@ -3332,7 +3368,7 @@ (defsubst gnus-group-timestamp (group) "Return the timestamp for GROUP." - (gnus-group-get-parameter group 'timestamp)) + (gnus-group-get-parameter group 'timestamp t)) (defun gnus-group-timestamp-delta (group) "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."