diff options
Diffstat (limited to 'lisp/gnus/gnus-group.el')
| -rw-r--r-- | lisp/gnus/gnus-group.el | 158 |
1 files changed, 86 insertions, 72 deletions
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index ff792c57065..3661b6376df 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1,4 +1,4 @@ -;;; gnus-group.el --- group mode commands for Gnus +;;; gnus-group.el --- group mode commands for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -39,10 +39,11 @@ (eval-when-compile (require 'mm-url) (require 'subr-x) - (let ((features (cons 'gnus-group features))) - (require 'gnus-sum)) - (unless (boundp 'gnus-cache-active-hashtb) - (defvar gnus-cache-active-hashtb nil))) + (with-suppressed-warnings ((lexical features)) + (dlet ((features (cons 'gnus-group features))) + (require 'gnus-sum)))) + +(defvar gnus-cache-active-hashtb) (defvar tool-bar-mode) @@ -476,20 +477,31 @@ simple manner." (defvar gnus-group-edit-buffer nil) -(defvar gnus-tmp-news-method) +(defvar gnus-tmp-active) (defvar gnus-tmp-colon) -(defvar gnus-tmp-news-server) -(defvar gnus-tmp-header) -(defvar gnus-tmp-process-marked) -(defvar gnus-tmp-summary-live) -(defvar gnus-tmp-news-method-string) +(defvar gnus-tmp-comment) +(defvar gnus-tmp-group) (defvar gnus-tmp-group-icon) +(defvar gnus-tmp-header) +(defvar gnus-tmp-level) +(defvar gnus-tmp-marked) +(defvar gnus-tmp-marked-mark) +(defvar gnus-tmp-method) +(defvar gnus-tmp-moderated) (defvar gnus-tmp-moderated-string) (defvar gnus-tmp-newsgroup-description) -(defvar gnus-tmp-comment) +(defvar gnus-tmp-news-method) +(defvar gnus-tmp-news-method-string) +(defvar gnus-tmp-news-server) +(defvar gnus-tmp-number-of-read) +(defvar gnus-tmp-number-of-unread) +(defvar gnus-tmp-number-total) +(defvar gnus-tmp-process-marked) (defvar gnus-tmp-qualified-group) (defvar gnus-tmp-subscribed) -(defvar gnus-tmp-number-of-read) +(defvar gnus-tmp-summary-live) +(defvar gnus-tmp-user-defined) + (defvar gnus-inhibit-demon) (defvar gnus-pick-mode) (defvar gnus-tmp-marked-mark) @@ -505,7 +517,8 @@ simple manner." (+ number (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) - (t number)) ?s) + (t number)) + ?s) (?R gnus-tmp-number-of-read ?s) (?U (if (gnus-active gnus-tmp-group) (gnus-number-of-unseen-articles-in-group gnus-tmp-group) @@ -516,7 +529,8 @@ simple manner." (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) + (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) + ?d) (?g gnus-tmp-group ?s) (?G gnus-tmp-qualified-group ?s) (?c (gnus-short-group-name gnus-tmp-group) @@ -1361,7 +1375,7 @@ if it is a string, only list groups matching REGEXP." (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))) (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) + (setq gnus-zombie-list (sort gnus-zombie-list #'string<)) gnus-level-zombie ?Z regexp)) (when not-in-list @@ -1372,7 +1386,7 @@ if it is a string, only list groups matching REGEXP." (gnus-group-prepare-flat-list-dead (cl-union not-in-list - (setq gnus-killed-list (sort gnus-killed-list 'string<)) + (setq gnus-killed-list (sort gnus-killed-list #'string<)) :test 'equal) gnus-level-killed ?K regexp)) @@ -1497,12 +1511,16 @@ if it is a string, only list groups matching REGEXP." (gnus-group-get-new-news 0)))) :type 'boolean) -(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level - gnus-tmp-marked number - gnus-tmp-method) +(defun gnus-group-insert-group-line (group level marked number method) "Insert a group line in the group buffer." - (let* ((gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) + (with-suppressed-warnings ((lexical number)) + (defvar number)) ;FIXME: Used in `gnus-group-line-format-alist'. + (let* ((number number) + (gnus-tmp-level level) + (gnus-tmp-marked marked) + (gnus-tmp-group group) + (gnus-tmp-method + (gnus-server-get-method gnus-tmp-group method)) (gnus-tmp-active (gnus-active gnus-tmp-group)) (gnus-tmp-number-total (if gnus-tmp-active @@ -1541,7 +1559,8 @@ if it is a string, only list groups matching REGEXP." (gnus-tmp-news-method-string (if gnus-tmp-method (format "(%s:%s)" (car gnus-tmp-method) - (cadr gnus-tmp-method)) "")) + (cadr gnus-tmp-method)) + "")) (gnus-tmp-marked-mark (if (and (numberp number) (zerop number) @@ -1564,7 +1583,7 @@ if it is a string, only list groups matching REGEXP." (point) (prog1 (1+ (point)) ;; Insert the text. - (eval gnus-group-line-format-spec)) + (eval gnus-group-line-format-spec t)) `(gnus-group ,gnus-tmp-group gnus-unread ,(if (numberp number) (string-to-number gnus-tmp-number-of-unread) @@ -1608,7 +1627,7 @@ Some value are bound so the form can use them." (cons 'unread (if (numberp (car entry)) (car entry) 0)) (cons 'total (if active (1+ (- (cdr active) (car active))) 0)) (cons 'mailp (apply - 'append + #'append (mapcar (lambda (x) (memq x (assoc @@ -1735,7 +1754,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." (buffer-modified-p gnus-dribble-buffer) (with-current-buffer gnus-dribble-buffer (not (zerop (buffer-size)))))) - (mode-string (eval gformat))) + (mode-string (eval gformat t))) ;; Say whether the dribble buffer has been modified. (setq mode-line-modified (if modified "**" "--")) @@ -1883,7 +1902,7 @@ If FIRST-TOO, the current line is also eligible as a target." "Unmark all groups." (interactive) (save-excursion - (mapc 'gnus-group-remove-mark gnus-group-marked)) + (mapc #'gnus-group-remove-mark gnus-group-marked)) (gnus-group-position-point)) (defun gnus-group-mark-region (unmark beg end) @@ -1931,7 +1950,7 @@ Return nil if the group isn't displayed." (gnus-group-mark-group 1 nil t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) -(defun gnus-group-universal-argument (arg &optional groups func) +(defun gnus-group-universal-argument (arg &optional _groups func) "Perform any command on all groups according to the process/prefix convention." (interactive "P") (if (eq (setq func (or func @@ -1942,7 +1961,7 @@ Return nil if the group isn't displayed." 'undefined) (gnus-error 1 "Undefined key") (gnus-group-iterate arg - (lambda (group) + (lambda (_group) (command-execute func)))) (gnus-group-position-point)) @@ -1985,31 +2004,18 @@ Take into consideration N (the prefix) and the list of marked groups." (let ((group (gnus-group-group-name))) (and group (list group)))))) -;;; !!!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. +(defun gnus-group-iterate (arg function) + "Iterate FUNCTION over all process/prefixed groups. FUNCTION will be called with the group name as the parameter and with point over the group in question." - (let ((,groups (gnus-group-process-prefix arg)) - (,window (selected-window)) - ,group) - (while ,groups - (setq ,group (car ,groups) - ,groups (cdr ,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) + (declare (indent 1)) + (let ((window (selected-window))) + (dolist (group (gnus-group-process-prefix arg)) + (select-window window) + (gnus-group-remove-mark group) + (save-selected-window + (save-excursion + (funcall function group)))))) ;; Selecting groups. @@ -2064,6 +2070,12 @@ articles in the group." (forward-line -1)) (gnus-group-read-group all t)) +(defvar gnus-visual) +(defvar gnus-score-find-score-files-function) +(defvar gnus-home-score-file) +(defvar gnus-apply-kill-hook) +(defvar gnus-summary-expunge-below) + (defun gnus-group-quick-select-group (&optional all group) "Select the GROUP \"quickly\". This means that no highlighting or scoring will be performed. If @@ -2521,7 +2533,7 @@ The arguments have the same meaning as those of (if (stringp id) (setq id (string-to-number id))) (setq-local debbugs-gnu-bug-number id))))) -(defun gnus-group-jump-to-group (group &optional prompt) +(defun gnus-group-jump-to-group (group &optional _prompt) "Jump to newsgroup GROUP. If PROMPT (the prefix) is a number, use the prompt specified in @@ -2807,7 +2819,7 @@ not-expirable articles, too." (format "Do you really want to delete these %d articles forever? " (length articles))) (gnus-request-expire-articles articles group - (if current-prefix-arg + (if oldp nil 'force))))) @@ -2926,8 +2938,8 @@ and NEW-NAME will be prompted for." ((eq part 'params) "group parameters") (t "group info")) group) - `(lambda (form) - (gnus-group-edit-group-done ',part ,group form))) + (lambda (form) + (gnus-group-edit-group-done part group form))) (local-set-key "\C-c\C-i" (gnus-create-info-command @@ -2985,7 +2997,7 @@ and NEW-NAME will be prompted for." "Create one of the groups described in `gnus-useful-groups'." (interactive (let ((entry (assoc (gnus-completing-read "Create group" - (mapcar 'car gnus-useful-groups) + (mapcar #'car gnus-useful-groups) t) gnus-useful-groups))) (list (cadr entry) @@ -2995,7 +3007,7 @@ and NEW-NAME will be prompted for." (setq method (copy-tree method)) (let (entry) (while (setq entry (memq (assq 'eval method) method)) - (setcar entry (eval (cadar entry))))) + (setcar entry (eval (cadar entry) t)))) (gnus-group-make-group group method)) (defun gnus-group-make-help-group (&optional noerror) @@ -3118,7 +3130,7 @@ If there is, use Gnus to create an nnrss group" (read-from-minibuffer "Title: " (gnus-newsgroup-savable-name (mapconcat - 'identity + #'identity (split-string (or (cdr (assoc 'title feedinfo)) @@ -3126,7 +3138,7 @@ If there is, use Gnus to create an nnrss group" " "))))) (desc (read-from-minibuffer "Description: " (mapconcat - 'identity + #'identity (split-string (or (cdr (assoc 'description feedinfo)) @@ -3374,9 +3386,9 @@ Editing the access control list for `%s'. implementation-defined hierarchy, RENAME or DELETE mailbox) d - delete messages (STORE \\DELETED flag, perform EXPUNGE) a - administer (perform SETACL)" group) - `(lambda (form) - (nnimap-acl-edit - ,mailbox ',method ',acl form))))) + (lambda (form) + (nnimap-acl-edit + mailbox method acl form))))) ;; Group sorting commands ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>. @@ -4268,7 +4280,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (pop-to-buffer "*Gnus Help*") (buffer-disable-undo) (erase-buffer) - (setq groups (sort groups 'string<)) + (setq groups (sort groups #'string<)) (while groups ;; Groups may be entered twice into the list of groups. (when (not (string= (car groups) prev)) @@ -4327,9 +4339,9 @@ If FORCE, force saving whether it is necessary or not." (interactive "P") (gnus-save-newsrc-file force)) -(defun gnus-group-restart (&optional arg) +(defun gnus-group-restart (&optional _arg) "Force Gnus to read the .newsrc file." - (interactive "P") + (interactive) (when (gnus-yes-or-no-p (format "Are you sure you want to restart Gnus? ")) (gnus-save-newsrc-file) @@ -4494,7 +4506,7 @@ and the second element is the address." (interactive (list (let ((how (gnus-completing-read "Which back end" - (mapcar 'car (append gnus-valid-select-methods + (mapcar #'car (append gnus-valid-select-methods gnus-server-alist)) t (cons "nntp" 0) 'gnus-method-history))) ;; We either got a back end name or a virtual server name. @@ -4616,7 +4628,9 @@ and the second element is the address." (setcdr m (gnus-compress-sequence articles t))) (setcdr m (gnus-compress-sequence (sort (nconc (gnus-uncompress-range (cdr m)) - (copy-sequence articles)) '<) t)))))) + (copy-sequence articles)) + #'<) + t)))))) (declare-function gnus-summary-add-mark "gnus-sum" (article type)) @@ -4684,7 +4698,7 @@ This command may read the active file." ;; Cache active file might use "." ;; instead of ":". (gethash - (mapconcat 'identity + (mapconcat #'identity (split-string group ":") ".") gnus-cache-active-hashtb)))) @@ -4746,9 +4760,9 @@ This command may read the active file." (forward-char 1)) groups)) -(defun gnus-group-list-plus (&optional args) +(defun gnus-group-list-plus (&optional _args) "List groups plus the current selection." - (interactive "P") + (interactive) (let ((gnus-group-listed-groups (gnus-group-listed-groups)) (gnus-group-list-mode gnus-group-list-mode) ;; Save it. func) @@ -4808,7 +4822,7 @@ you the groups that have both dormant articles and cached articles." (push n gnus-newsgroup-unselected)) (setq n (1+ n))) (setq gnus-newsgroup-unselected - (sort gnus-newsgroup-unselected '<))))) + (sort gnus-newsgroup-unselected #'<))))) (gnus-activate-group group) (gnus-group-make-articles-read group (list article)) (when (and (gnus-group-auto-expirable-p group) |