From c2e9e9ef6fdd6be93ebc5a143aea6a7716fe8ed7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 17 Sep 2013 13:22:32 -0400 Subject: [PATCH] * lisp/gnus/gnus-agent.el (gnus-category-mode): Use define-derived-mode. (gnus-agent-mode): Use derived-mode-p. (gnus-agent-rename-group, gnus-agent-delete-group): Don't bind gnus-command-method and *-command-method to nil, but bind gnus-command-method to *-command-method instead! (gnus-agent-fetch-articles): Remove unused var `id'. (gnus-agent-fetch-headers): Remove unused arg `force'. (gnus-agent-braid-nov): Remove unused arg `group'. Adjust callers. (gnus-agent-save-alist, gnus-agent-save-local): Remove unused `item'. (gnus-agent-short-article, gnus-agent-long-article) (gnus-agent-low-score, gnus-agent-high-score): Move declaration before first use. (gnus-agent-fetch-group-1): Remove unused vars `arts', `category', `score-param'. (gnus-tmp-name, gnus-tmp-groups): Defvar them. (gnus-get-predicate): Push in front of the cache, rather than end. (gnus-agent-expire-current-dirs, gnus-agent-expire-stats): Defvar them. (gnus-agent-expire-group-1): Use push. Don't abuse dyn-binding. (gnus-agent-expire-unagentized-dirs): Don't rebind gnus-agent-expire-current-dirs since the defvar silences the warning. (gnus-agent-retrieve-headers): Remove unused var `cached-articles'. (gnus-agent-regenerate-group): Remove unused vars `point' and `dl'. (gnus-agent-regenerate): Simplify interactive spec and doc. * lisp/gnus/gnus-eform.el (gnus-edit-form-mode): Use define-derived-mode. * lisp/gnus/gnus-salt.el (gnus-tree-mode): Use define-derived-mode. Use save-current-buffer. (gnus-tree-mode-map): Initialize in the declaration. (gnus-pick-mouse-pick-region): Remove unused var `fun'. (scroll-in-place): Defvar it. (gnus-tmp-*): Defvar them. (gnus-get-tree-buffer): Use derived-mode-p. (gnus--let-eval): New macro. (gnus-tree-highlight-node): Use it to avoid dynamic binding of non-prefixed variables. (gnus-tree-open, gnus-tree-close): Remove unused arg `group'. * lisp/gnus/gnus-sum.el (gnus-summary-highlight): Remove `below' from the list of vars since it doesn't seem to be available. (gnus-set-global-variables, gnus-summary-read-group-1) (gnus-select-newsgroup, gnus-handle-ephemeral-exit) (gnus-summary-display-article, gnus-summary-select-article) (gnus-summary-next-article, gnus-offer-save-summaries) (gnus-summary-generic-mark): Use derived-mode-p. (gnus-summary-read-group-1, gnus-summary-exit) (gnus-summary-exit-no-update, gnus-kill-or-deaden-summary): Adjust calls to gnus-tree-close and gnus-tree-open. --- lisp/gnus/ChangeLog | 51 +++++++++++++ lisp/gnus/gnus-agent.el | 160 ++++++++++++++++++---------------------- lisp/gnus/gnus-eform.el | 10 +-- lisp/gnus/gnus-salt.el | 100 +++++++++++++++---------- lisp/gnus/gnus-sum.el | 36 ++++----- 5 files changed, 202 insertions(+), 155 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index f9c0c7b287..d673a18cb1 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,54 @@ +2013-09-17 Stefan Monnier + + * gnus-salt.el (gnus-tree-mode): Use define-derived-mode. + Use save-current-buffer. + (gnus-tree-mode-map): Initialize in the declaration. + (gnus-pick-mouse-pick-region): Remove unused var `fun'. + (scroll-in-place): Defvar it. + (gnus-tmp-*): Defvar them. + (gnus-get-tree-buffer): Use derived-mode-p. + (gnus--let-eval): New macro. + (gnus-tree-highlight-node): Use it to avoid dynamic binding of + non-prefixed variables. + (gnus-tree-open, gnus-tree-close): Remove unused arg `group'. + + * gnus-sum.el (gnus-summary-highlight): Remove `below' from the list of + vars since it doesn't seem to be available. + (gnus-set-global-variables, gnus-summary-read-group-1) + (gnus-select-newsgroup, gnus-handle-ephemeral-exit) + (gnus-summary-display-article, gnus-summary-select-article) + (gnus-summary-next-article, gnus-offer-save-summaries) + (gnus-summary-generic-mark): Use derived-mode-p. + (gnus-summary-read-group-1, gnus-summary-exit) + (gnus-summary-exit-no-update, gnus-kill-or-deaden-summary): + Adjust calls to gnus-tree-close and gnus-tree-open. + + * gnus-eform.el (gnus-edit-form-mode): Use define-derived-mode. + + * gnus-agent.el (gnus-category-mode): Use define-derived-mode. + (gnus-agent-mode): Use derived-mode-p. + (gnus-agent-rename-group, gnus-agent-delete-group): Don't bind + gnus-command-method and *-command-method to nil, but bind + gnus-command-method to *-command-method instead! + (gnus-agent-fetch-articles): Remove unused var `id'. + (gnus-agent-fetch-headers): Remove unused arg `force'. + (gnus-agent-braid-nov): Remove unused arg `group'. Adjust callers. + (gnus-agent-save-alist, gnus-agent-save-local): Remove unused `item'. + (gnus-agent-short-article, gnus-agent-long-article) + (gnus-agent-low-score, gnus-agent-high-score): Move declaration before + first use. + (gnus-agent-fetch-group-1): Remove unused vars `arts', `category', + `score-param'. + (gnus-tmp-name, gnus-tmp-groups): Defvar them. + (gnus-get-predicate): Push in front of the cache, rather than end. + (gnus-agent-expire-current-dirs, gnus-agent-expire-stats): Defvar them. + (gnus-agent-expire-group-1): Use push. Don't abuse dyn-binding. + (gnus-agent-expire-unagentized-dirs): Don't rebind + gnus-agent-expire-current-dirs since the defvar silences the warning. + (gnus-agent-retrieve-headers): Remove unused var `cached-articles'. + (gnus-agent-regenerate-group): Remove unused vars `point' and `dl'. + (gnus-agent-regenerate): Simplify interactive spec and doc. + 2013-09-17 Katsumi Yamaoka * gnus-int.el (gnus-open-server): Silence compiler. diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 1d0f346e10..10ee230a81 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -492,7 +492,7 @@ manipulated as follows: (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map" buffer)))) minor-mode-map-alist)) - (when (eq major-mode 'gnus-group-mode) + (when (derived-mode-p 'gnus-group-mode) (let ((init-plugged gnus-plugged) (gnus-agent-go-online nil)) ;; g-a-t-p does nothing when gnus-plugged isn't changed. @@ -881,11 +881,11 @@ Depends upon the caller to determine whether group renaming is supported." (let* ((old-command-method (gnus-find-method-for-group old-group)) (old-path (directory-file-name - (let (gnus-command-method old-command-method) + (let ((gnus-command-method old-command-method)) (gnus-agent-group-pathname old-group)))) (new-command-method (gnus-find-method-for-group new-group)) (new-path (directory-file-name - (let (gnus-command-method new-command-method) + (let ((gnus-command-method new-command-method)) (gnus-agent-group-pathname new-group)))) (file-name-coding-system nnmail-pathname-coding-system)) (gnus-rename-file old-path new-path t) @@ -914,19 +914,18 @@ Depends upon the caller to determine whether group deletion is supported." (let* ((command-method (gnus-find-method-for-group group)) (path (directory-file-name - (let (gnus-command-method command-method) + (let ((gnus-command-method command-method)) (gnus-agent-group-pathname group)))) (file-name-coding-system nnmail-pathname-coding-system)) (gnus-delete-directory path) (let* ((real-group (gnus-group-real-name group))) (gnus-agent-save-group-info command-method real-group nil) - - (let ((local (gnus-agent-get-local group - real-group command-method))) - (gnus-agent-set-local group - nil nil - real-group command-method))))) + ;; FIXME: Does gnus-agent-get-local have any useful side-effect? + (gnus-agent-get-local group real-group command-method) + (gnus-agent-set-local group + nil nil + real-group command-method)))) ;;; ;;; Server mode commands @@ -1549,7 +1548,7 @@ downloaded into the agent." (dir (gnus-agent-group-pathname group)) (date (time-to-days (current-time))) (case-fold-search t) - pos crosses id + pos crosses (file-name-coding-system nnmail-pathname-coding-system)) (setcar selected-sets (nreverse (car selected-sets))) @@ -1603,11 +1602,6 @@ downloaded into the agent." (goto-char (match-end 0))) (gnus-agent-crosspost crosses (caar pos) date))) (goto-char (point-min)) - (if (not (re-search-forward - "^Message-ID: *<\\([^>\n]+\\)>" nil t)) - (setq id "No-Message-ID-in-article") - (setq id (buffer-substring - (match-beginning 1) (match-end 1)))) (let ((coding-system-for-write gnus-agent-file-coding-system)) (write-region (point-min) (point-max) @@ -1832,7 +1826,7 @@ variables. Returns the first non-nil value found." . gnus-agent-enable-expiration) (agent-predicate . gnus-agent-predicate))))))) -(defun gnus-agent-fetch-headers (group &optional force) +(defun gnus-agent-fetch-headers (group) "Fetch interesting headers into the agent. The group's overview file will be updated to include the headers while a list of available article numbers will be returned." @@ -1931,7 +1925,7 @@ article numbers will be returned." ;; NOTE: Call g-a-brand-nov even when the file does not ;; exist. As a minimum, it will validate the article ;; numbers already in the buffer. - (gnus-agent-braid-nov group articles file) + (gnus-agent-braid-nov articles file) (let ((coding-system-for-write gnus-agent-file-coding-system)) (gnus-agent-check-overview-buffer) @@ -1980,7 +1974,7 @@ article numbers will be returned." (set-buffer nntp-server-buffer) (insert-buffer-substring gnus-agent-overview-buffer b e)))) -(defun gnus-agent-braid-nov (group articles file) +(defun gnus-agent-braid-nov (articles file) "Merge agent overview data with given file. Takes unvalidated headers for ARTICLES from `gnus-agent-overview-buffer' and validated headers from the given @@ -2154,7 +2148,7 @@ doesn't exist, to valid the overview buffer." (let* ((file-name-coding-system nnmail-pathname-coding-system) (prev (cons nil gnus-agent-article-alist)) (all prev) - print-level print-length item article) + print-level print-length article) (while (setq article (pop articles)) (while (and (cdr prev) (< (caadr prev) article)) @@ -2288,7 +2282,7 @@ modified) original contents, they are first saved to their own file." (file-name-coding-system nnmail-pathname-coding-system)) (with-temp-file dest (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) - print-level print-length item article + print-level print-length (standard-output (current-buffer))) (mapatoms (lambda (symbol) (cond ((not (boundp symbol)) @@ -2411,6 +2405,18 @@ modified) original contents, they are first saved to their own file." (gnus-run-hooks 'gnus-agent-fetched-hook) (gnus-message 6 "Finished fetching articles into the Gnus agent")))) +(defvar gnus-agent-short-article 500 + "Articles that have fewer lines than this are short.") + +(defvar gnus-agent-long-article 1000 + "Articles that have more lines than this are long.") + +(defvar gnus-agent-low-score 0 + "Articles that have a score lower than this have a low score.") + +(defvar gnus-agent-high-score 0 + "Articles that have a score higher than this have a high score.") + (defun gnus-agent-fetch-group-1 (group method) "Fetch GROUP." (let ((gnus-command-method method) @@ -2427,8 +2433,8 @@ modified) original contents, they are first saved to their own file." gnus-headers gnus-score - articles arts - category predicate info marks score-param + articles + predicate info marks ) (unless (gnus-check-group group) (error "Can't open server for %s" group)) @@ -2471,9 +2477,6 @@ modified) original contents, they are first saved to their own file." ;; timeout reason. If so, recreate it. (gnus-agent-create-buffer) - ;; Figure out how to select articles in this group - (setq category (gnus-group-category group)) - (setq predicate (gnus-get-predicate (gnus-agent-find-parameter group 'agent-predicate))) @@ -2624,23 +2627,14 @@ General format specifiers can also be used. See Info node (defvar gnus-agent-predicate 'false "The selection predicate used when no other source is available.") -(defvar gnus-agent-short-article 500 - "Articles that have fewer lines than this are short.") - -(defvar gnus-agent-long-article 1000 - "Articles that have more lines than this are long.") - -(defvar gnus-agent-low-score 0 - "Articles that have a score lower than this have a low score.") - -(defvar gnus-agent-high-score 0 - "Articles that have a score higher than this have a high score.") - ;;; Internal variables. (defvar gnus-category-buffer "*Agent Category*") +(defvar gnus-tmp-name) +(defvar gnus-tmp-groups) + (defvar gnus-category-line-format-alist `((?c gnus-tmp-name ?s) (?g gnus-tmp-groups ?d))) @@ -2692,7 +2686,7 @@ General format specifiers can also be used. See Info node (gnus-run-hooks 'gnus-category-menu-hook))) -(defun gnus-category-mode () +(define-derived-mode gnus-category-mode fundamental-mode "Category" "Major mode for listing and editing agent categories. All normal editing commands are switched off. @@ -2703,20 +2697,14 @@ For more in-depth information on this mode, read the manual The following commands are available: \\{gnus-category-mode-map}" - (interactive) (when (gnus-visual-p 'category-menu 'menu) (gnus-category-make-menu-bar)) - (kill-all-local-variables) (gnus-simplify-mode-line) - (setq major-mode 'gnus-category-mode) - (setq mode-name "Category") (gnus-set-default-directory) (setq mode-line-process nil) - (use-local-map gnus-category-mode-map) (buffer-disable-undo) (setq truncate-lines t) - (setq buffer-read-only t) - (gnus-run-mode-hooks 'gnus-category-mode-hook)) + (setq buffer-read-only t)) (defalias 'gnus-category-position-point 'gnus-goto-colon) @@ -2992,9 +2980,7 @@ The following commands are available: "Return the function implementing PREDICATE." (or (cdr (assoc predicate gnus-category-predicate-cache)) (let ((func (gnus-category-make-function predicate))) - (setq gnus-category-predicate-cache - (nconc gnus-category-predicate-cache - (list (cons predicate func)))) + (push (cons predicate func) gnus-category-predicate-cache) func))) (defun gnus-predicate-implies-unread (predicate) @@ -3066,6 +3052,9 @@ articles." (or (gnus-gethash group gnus-category-group-cache) (assq 'default gnus-category-alist))) +(defvar gnus-agent-expire-current-dirs) +(defvar gnus-agent-expire-stats) + (defun gnus-agent-expire-group (group &optional articles force) "Expire all old articles in GROUP. If you want to force expiring of certain articles, this function can @@ -3080,7 +3069,7 @@ FORCE is equivalent to setting the expiration predicates to true." (if (not group) (gnus-agent-expire articles group force) - (let ( ;; Bind gnus-agent-expire-stats to enable tracking of + (let (;; Bind gnus-agent-expire-stats to enable tracking of ;; expiration statistics of this single group (gnus-agent-expire-stats (list 0 0 0.0))) (if (or (not (eq articles t)) @@ -3117,9 +3106,7 @@ FORCE is equivalent to setting the expiration predicates to true." (gnus-agent-with-refreshed-group group (when (boundp 'gnus-agent-expire-current-dirs) - (set 'gnus-agent-expire-current-dirs - (cons dir - (symbol-value 'gnus-agent-expire-current-dirs)))) + (push dir gnus-agent-expire-current-dirs)) (if (and (not force) (eq 'DISABLE (gnus-agent-find-parameter group @@ -3263,24 +3250,24 @@ line." (point) nov-file))) ;; only problem is that much of it is spread across multiple ;; entries. Sort then MERGE!! (gnus-message 7 "gnus-agent-expire: Sorting entries... ") - ;; If two entries have the same article-number then sort by - ;; ascending keep_flag. - (let ((special 0) - (marked 1) - (unread 2)) - (setq dlist - (sort dlist - (lambda (a b) - (cond ((< (nth 0 a) (nth 0 b)) - t) - ((> (nth 0 a) (nth 0 b)) - nil) - (t - (let ((a (or (symbol-value (nth 2 a)) - 3)) - (b (or (symbol-value (nth 2 b)) - 3))) - (<= a b)))))))) + (setq dlist + (sort dlist + (lambda (a b) + (cond ((< (nth 0 a) (nth 0 b)) + t) + ((> (nth 0 a) (nth 0 b)) + nil) + (t + ;; If two entries have the same article-number + ;; then sort by ascending keep_flag. + (let* ((kf-score '((special . 0) + (marked . 1) + (unread . 2))) + (a (or (cdr (assq (nth 2 a) kf-score)) + 3)) + (b (or (cdr (assq (nth 2 b) kf-score)) + 3))) + (<= a b))))))) (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") (gnus-message 7 "gnus-agent-expire: Merging entries... ") (let ((dlist dlist)) @@ -3474,7 +3461,7 @@ expiration tests failed." decoded article-number) (gnus-summary-update-info)))) (when (boundp 'gnus-agent-expire-stats) - (let ((stats (symbol-value 'gnus-agent-expire-stats))) + (let ((stats gnus-agent-expire-stats)) (incf (nth 2 stats) bytes-freed) (incf (nth 1 stats) files-deleted) (incf (nth 0 stats) nov-entries-deleted))) @@ -3534,7 +3521,7 @@ articles in every agentized group? ")) (defun gnus-agent-expire-done-message () (if (and (> gnus-verbose 4) (boundp 'gnus-agent-expire-stats)) - (let* ((stats (symbol-value 'gnus-agent-expire-stats)) + (let* ((stats gnus-agent-expire-stats) (size (nth 2 stats)) (units '(B KB MB GB))) (while (and (> size 1024.0) @@ -3553,16 +3540,10 @@ articles in every agentized group? ")) (when (and gnus-agent-expire-unagentized-dirs (boundp 'gnus-agent-expire-current-dirs)) (let* ((keep (gnus-make-hashtable)) - ;; Formally bind gnus-agent-expire-current-dirs so that the - ;; compiler will not complain about free references. - (gnus-agent-expire-current-dirs - (symbol-value 'gnus-agent-expire-current-dirs)) - dir (file-name-coding-system nnmail-pathname-coding-system)) (gnus-sethash gnus-agent-directory t keep) - (while gnus-agent-expire-current-dirs - (setq dir (pop gnus-agent-expire-current-dirs)) + (dolist (dir gnus-agent-expire-current-dirs) (when (and (stringp dir) (file-directory-p dir)) (while (not (gnus-gethash dir keep)) @@ -3715,7 +3696,7 @@ has been fetched." (let ((gnus-decode-encoded-word-function 'identity) (gnus-decode-encoded-address-function 'identity) (file (gnus-agent-article-name ".overview" group)) - cached-articles uncached-articles + uncached-articles (file-name-coding-system nnmail-pathname-coding-system)) (gnus-make-directory (nnheader-translate-file-chars (file-name-directory file) t)) @@ -3812,7 +3793,7 @@ has been fetched." ;; Merge the temp buffer with the known headers (found on ;; disk in FILE) into the nntp-server-buffer (when uncached-articles - (gnus-agent-braid-nov group uncached-articles file)) + (gnus-agent-braid-nov uncached-articles file)) ;; Save the new set of known headers to FILE (set-buffer nntp-server-buffer) @@ -3907,7 +3888,6 @@ If REREAD is not nil, downloaded articles are marked as unread." (gnus-find-method-for-group group))) (file (gnus-agent-article-name ".overview" group)) (dir (file-name-directory file)) - point (file-name-coding-system nnmail-pathname-coding-system) (downloaded (if (file-exists-p dir) (sort (delq nil (mapcar (lambda (name) @@ -3916,7 +3896,7 @@ If REREAD is not nil, downloaded articles are marked as unread." (directory-files dir nil "^[0-9]+$" t))) '>) (progn (gnus-make-directory dir) nil))) - dl nov-arts + nov-arts alist header regenerated) @@ -4099,16 +4079,16 @@ If REREAD is not nil, downloaded articles are marked as unread." regenerated))) ;;;###autoload -(defun gnus-agent-regenerate (&optional clean reread) +(defun gnus-agent-regenerate (&optional _clean reread) "Regenerate all agent covered files. -If CLEAN, obsolete (ignore)." - (interactive "P") +CLEAN is obsolete and ignored." + (interactive) (let (regenerated) (gnus-message 4 "Regenerating Gnus agent files...") (dolist (gnus-command-method (gnus-agent-covered-methods)) - (dolist (group (gnus-groups-from-server gnus-command-method)) - (setq regenerated (or (gnus-agent-regenerate-group group reread) - regenerated)))) + (dolist (group (gnus-groups-from-server gnus-command-method)) + (setq regenerated (or (gnus-agent-regenerate-group group reread) + regenerated)))) (gnus-message 4 "Regenerating Gnus agent files...done") regenerated)) diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index 6790803305..00e2787608 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -67,21 +67,15 @@ ["Exit" gnus-edit-form-exit t])) (gnus-run-hooks 'gnus-edit-form-menu-hook))) -(defun gnus-edit-form-mode () +(define-derived-mode gnus-edit-form-mode fundamental-mode "Edit Form" "Major mode for editing forms. It is a slightly enhanced emacs-lisp-mode. \\{gnus-edit-form-mode-map}" - (interactive) (when (gnus-visual-p 'group-menu 'menu) (gnus-edit-form-make-menu-bar)) - (kill-all-local-variables) - (setq major-mode 'gnus-edit-form-mode) - (setq mode-name "Edit Form") - (use-local-map gnus-edit-form-mode-map) (make-local-variable 'gnus-edit-form-done-function) - (make-local-variable 'gnus-prev-winconf) - (gnus-run-mode-hooks 'gnus-edit-form-mode-hook)) + (make-local-variable 'gnus-prev-winconf)) (defun gnus-edit-form (form documentation exit-func &optional layout) "Edit FORM in a new buffer. diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 6b8e105e6b..77fe0d3bb1 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -292,22 +292,25 @@ This must be bound to a button-down mouse event." (mouse-scroll-subr start-window (1+ (- mouse-row bottom))))))))))) (when (consp event) - (let ((fun (key-binding (vector (car event))))) + (let (;; (fun (key-binding (vector (car event)))) + ) ;; Run the binding of the terminating up-event, if possible. - ;; In the case of a multiple click, it gives the wrong results, + ;; In the case of a multiple click, it gives the wrong results, ;; because it would fail to set up a region. (when nil - ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun)) - ;; In this case, we can just let the up-event execute normally. + ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun)) + ;; In this case, we can just let the up-event execute normally. (let ((end (event-end event))) ;; Set the position in the event before we replay it, ;; because otherwise it may have a position in the wrong ;; buffer. (setcar (cdr end) end-of-range) ;; Delete the overlay before calling the function, - ;; because delete-overlay increases buffer-modified-tick. + ;; because delete-overlay increases buffer-modified-tick. (push event unread-command-events)))))))) +(defvar scroll-in-place) + (defun gnus-pick-next-page () "Go to the next page. If at the end of the buffer, start reading articles." (interactive) @@ -356,7 +359,7 @@ This must be bound to a button-down mouse event." (when (gnus-visual-p 'binary-menu 'menu) (gnus-binary-make-menu-bar))))) -(defun gnus-binary-display-article (article &optional all-header) +(defun gnus-binary-display-article (article &optional _all-header) "Run ARTICLE through the binary decode functions." (when (gnus-summary-goto-subject article) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) @@ -423,6 +426,13 @@ Two predefined functions are available: ;;; Internal variables. +(defvar gnus-tmp-name) +(defvar gnus-tmp-from) +(defvar gnus-tmp-number) +(defvar gnus-tmp-open-bracket) +(defvar gnus-tmp-close-bracket) +(defvar gnus-tmp-subject) + (defvar gnus-tree-line-format-alist `((?n gnus-tmp-name ?s) (?f gnus-tmp-from ?s) @@ -442,23 +452,23 @@ Two predefined functions are available: (defvar gnus-tree-displayed-thread nil) (defvar gnus-tree-inhibit nil) -(defvar gnus-tree-mode-map nil) -(put 'gnus-tree-mode 'mode-class 'special) +(defvar gnus-tree-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (gnus-define-keys + map + "\r" gnus-tree-select-article + gnus-mouse-2 gnus-tree-pick-article + "\C-?" gnus-tree-read-summary-keys + "h" gnus-tree-show-summary -(unless gnus-tree-mode-map - (setq gnus-tree-mode-map (make-keymap)) - (suppress-keymap gnus-tree-mode-map) - (gnus-define-keys - gnus-tree-mode-map - "\r" gnus-tree-select-article - gnus-mouse-2 gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - "h" gnus-tree-show-summary + "\C-c\C-i" gnus-info-find-node) - "\C-c\C-i" gnus-info-find-node) + (substitute-key-definition + 'undefined 'gnus-tree-read-summary-keys map) + map)) - (substitute-key-definition - 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map)) +(put 'gnus-tree-mode 'mode-class 'special) (defun gnus-tree-make-menu-bar () (unless (boundp 'gnus-tree-menu) @@ -467,26 +477,20 @@ Two predefined functions are available: '("Tree" ["Select article" gnus-tree-select-article t])))) -(defun gnus-tree-mode () +(define-derived-mode gnus-tree-mode fundamental-mode "Tree" "Major mode for displaying thread trees." - (interactive) (gnus-set-format 'tree-mode) (gnus-set-format 'tree t) (when (gnus-visual-p 'tree-menu 'menu) (gnus-tree-make-menu-bar)) - (kill-all-local-variables) (gnus-simplify-mode-line) - (setq mode-name "Tree") - (setq major-mode 'gnus-tree-mode) - (use-local-map gnus-tree-mode-map) (buffer-disable-undo) (setq buffer-read-only t) (setq truncate-lines t) - (save-excursion + (save-current-buffer (gnus-set-work-buffer) (gnus-tree-node-insert (make-mail-header "") nil) - (setq gnus-tree-node-length (1- (point)))) - (gnus-run-mode-hooks 'gnus-tree-mode-hook)) + (setq gnus-tree-node-length (1- (point))))) (defun gnus-tree-read-summary-keys (&optional arg) "Read a summary buffer key sequence and execute it." @@ -562,7 +566,7 @@ Two predefined functions are available: (defun gnus-get-tree-buffer () "Return the tree buffer properly initialized." (with-current-buffer (gnus-get-buffer-create gnus-tree-buffer) - (unless (eq major-mode 'gnus-tree-mode) + (unless (derived-mode-p 'gnus-tree-mode) (gnus-tree-mode)) (current-buffer))) @@ -571,7 +575,7 @@ Two predefined functions are available: (not (one-window-p))) (let ((windows 0) tot-win-height) - (walk-windows (lambda (window) (incf windows))) + (walk-windows (lambda (_window) (incf windows))) (setq tot-win-height (- (frame-height) (* window-min-height (1- windows)) @@ -642,23 +646,41 @@ Two predefined functions are available: (when (or t (gnus-visual-p 'tree-highlight 'highlight)) (gnus-tree-highlight-node gnus-tmp-number beg end)))) +(defmacro gnus--let-eval (bindings evalsym &rest body) + "Build an environment in which to evaluate expressions. +BINDINGS is a `let'-style list of bindings to use for the environment. +EVALSYM is then bound in BODY to a function that takes a sexp and evaluates +it in the environment specified by BINDINGS." + (declare (indent 2) (debug ((&rest (sym form)) sym body))) + (if (ignore-errors (let ((x 3)) (eq (eval '(- x 1) '((x . 4))) x))) + ;; Use lexical vars if possible. + `(let* ((env (list ,@(mapcar (lambda (binding) + `(cons ',(car binding) ,(cadr binding))) + bindings))) + (,evalsym (lambda (exp) (eval exp env)))) + ,@body) + `(let (,@bindings (,evalsym #'eval)) ,@body))) + (defun gnus-tree-highlight-node (article beg end) "Highlight current line according to `gnus-summary-highlight'." (let ((list gnus-summary-highlight) face) (with-current-buffer gnus-summary-buffer - (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) + (let ((uncached (memq article gnus-newsgroup-undownloaded))) + (gnus--let-eval + ((score (or (cdr (assq article gnus-newsgroup-scored)) gnus-summary-default-score 0)) (default gnus-summary-default-score) (default-high gnus-summary-default-high-score) (default-low gnus-summary-default-low-score) - (uncached (memq article gnus-newsgroup-undownloaded)) + (uncached uncached) (downloaded (not uncached)) (mark (or (gnus-summary-article-mark article) gnus-unread-mark))) - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))))) + evalfun + ;; Eval the cars of the lists until we find a match. + (while (and list + (not (funcall evalfun (caar list)))) + (setq list (cdr list)))))) (unless (eq (setq face (cdar list)) (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (gnus-put-text-property-excluding-characters-with-faces beg end 'face @@ -814,10 +836,10 @@ Two predefined functions are available: (gnus-generate-tree top) (setq gnus-tree-displayed-thread top)))))) -(defun gnus-tree-open (group) +(defun gnus-tree-open () (gnus-get-tree-buffer)) -(defun gnus-tree-close (group) +(defun gnus-tree-close () (gnus-kill-buffer gnus-tree-buffer)) (defun gnus-tree-perhaps-minimize () diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 94f4e70318..61cf7ec5b6 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1140,7 +1140,6 @@ score: The article's score. default: The default article score. default-high: The default score for high scored articles. default-low: The default score for low scored articles. -below: The score below which articles are automatically marked as read. mark: The article's mark. uncached: Non-nil if the article is uncached." :group 'gnus-summary-visual @@ -3104,6 +3103,7 @@ buffer; read the info pages for more information (`\\[gnus-info-find-node]'). The following commands are available: \\{gnus-summary-mode-map}" + ;; FIXME: Use define-derived-mode. (interactive) (kill-all-local-variables) (let ((gnus-summary-local-variables gnus-newsgroup-variables)) @@ -3542,7 +3542,7 @@ If the setup was successful, non-nil is returned." "Set the global equivalents of the buffer-local variables. They are set to the latest values they had. These reflect the summary buffer that was in action when the last article was fetched." - (when (eq major-mode 'gnus-summary-mode) + (when (derived-mode-p 'gnus-summary-mode) (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) (marked gnus-newsgroup-marked) @@ -3990,7 +3990,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." t) ;; We couldn't select this group. ((null did-select) - (when (and (eq major-mode 'gnus-summary-mode) + (when (and (derived-mode-p 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer))) (kill-buffer (current-buffer)) (if (not quit-config) @@ -4009,7 +4009,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; The user did a `C-g' while prompting for number of articles, ;; so we exit this group. ((eq did-select 'quit) - (and (eq major-mode 'gnus-summary-mode) + (and (derived-mode-p 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) (when kill-buffer @@ -4052,7 +4052,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (unless no-display (gnus-summary-prepare)) (when gnus-use-trees - (gnus-tree-open group) + (gnus-tree-open) (setq gnus-summary-highlight-line-function 'gnus-tree-highlight-article)) ;; If the summary buffer is empty, but there are some low-scored @@ -5612,7 +5612,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (or (and entry (not (eq (car entry) t))) ; Either it's active... (gnus-activate-group group) ; Or we can activate it... (progn ; Or we bug out. - (when (equal major-mode 'gnus-summary-mode) + (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (error "Couldn't activate group %s: %s" @@ -5620,7 +5620,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (mm-decode-coding-string (gnus-status-message group) charset)))) (unless (gnus-request-group group t) - (when (equal major-mode 'gnus-summary-mode) + (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" (mm-decode-coding-string group charset) @@ -7257,7 +7257,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (when gnus-suppress-duplicates (gnus-dup-enter-articles)) (when gnus-use-trees - (gnus-tree-close group)) + (gnus-tree-close)) (when gnus-use-cache (gnus-cache-write-active)) ;; Remove entries for this group. @@ -7360,7 +7360,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (unless gnus-single-article-buffer (setq gnus-article-current nil)) (when gnus-use-trees - (gnus-tree-close group)) + (gnus-tree-close)) (gnus-async-prefetch-remove-group group) (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) @@ -7383,9 +7383,9 @@ The state which existed when entering the ephemeral is reset." (unless (eq (cdr quit-config) 'group) (setq gnus-current-select-method (gnus-find-method-for-group gnus-newsgroup-name))) - (cond ((eq major-mode 'gnus-summary-mode) + (cond ((derived-mode-p 'gnus-summary-mode) (gnus-set-global-variables)) - ((eq major-mode 'gnus-article-mode) + ((derived-mode-p 'gnus-article-mode) (save-current-buffer ;; The `gnus-summary-buffer' variable may point ;; to the old summary buffer when using a single @@ -7400,7 +7400,7 @@ The state which existed when entering the ephemeral is reset." (gnus-configure-windows 'pick 'force) (gnus-configure-windows (cdr quit-config) 'force)) (gnus-configure-windows (cdr quit-config) 'force)) - (when (eq major-mode 'gnus-summary-mode) + (when (derived-mode-p 'gnus-summary-mode) (if (memq gnus-auto-select-on-ephemeral-exit '(next-noselect next-unread-noselect)) (when (zerop (cond ((eq gnus-auto-select-on-ephemeral-exit @@ -7470,7 +7470,7 @@ The state which existed when entering the ephemeral is reset." (when (and gnus-use-trees (gnus-buffer-exists-p buffer)) (with-current-buffer buffer - (gnus-tree-close gnus-newsgroup-name))) + (gnus-tree-close))) (gnus-kill-buffer buffer)) ;; Deaden the buffer. ((gnus-buffer-exists-p buffer) @@ -7699,7 +7699,7 @@ Given a prefix, will force an `article' buffer configuration." "Display ARTICLE in article buffer." (unless (and (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer - (eq major-mode 'gnus-article-mode))) + (derived-mode-p 'gnus-article-mode))) (gnus-article-setup-buffer)) (gnus-set-global-variables) (with-current-buffer gnus-article-buffer @@ -7731,7 +7731,7 @@ non-nil, the article will be re-fetched even if it already present in the article buffer. If PSEUDO is non-nil, pseudo-articles will also be displayed." ;; Make sure we are in the summary buffer to work around bbdb bug. - (unless (eq major-mode 'gnus-summary-mode) + (unless (derived-mode-p 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be t or nil. @@ -7783,7 +7783,7 @@ If SUBJECT, only articles with SUBJECT are selected. If BACKWARD, the previous article is selected instead of the next." (interactive "P") ;; Make sure we are in the summary buffer. - (unless (eq major-mode 'gnus-summary-mode) + (unless (derived-mode-p 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (cond ;; Is there such an article? @@ -12680,7 +12680,7 @@ UNREAD is a sorted list." (string-match "Summary" buffer) (with-current-buffer buffer ;; We check that this is, indeed, a summary buffer. - (and (eq major-mode 'gnus-summary-mode) + (and (derived-mode-p 'gnus-summary-mode) ;; Also make sure this isn't bogus. gnus-newsgroup-prepared ;; Also make sure that this isn't a @@ -12815,7 +12815,7 @@ returned." (defun gnus-summary-generic-mark (n mark move unread) "Mark N articles with MARK." - (unless (eq major-mode 'gnus-summary-mode) + (unless (derived-mode-p 'gnus-summary-mode) (error "This command can only be used in the summary buffer")) (gnus-summary-show-thread) (let ((nummove -- 2.39.2