andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/gnus/gnus-agent.el (gnus-category-mode): Use define-derived-mode.

Browse source 
(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.
This commit is contained in:
Stefan Monnier 2013-09-17 13:22:32 -04:00
parent 0791d107ed
commit c2e9e9ef6f
5 changed files with 204 additions and 157 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
lisp/gnus/ChangeLog
View file

@ -1,3 +1,54 @@
2013-09-17 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <yamaoka@jpl.org>
* gnus-int.el (gnus-open-server): Silence compiler.

160
lisp/gnus/gnus-agent.el
View file

@ -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))

10
lisp/gnus/gnus-eform.el
View file

@ -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.

104
lisp/gnus/gnus-salt.el
View file

@ -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,24 +452,24 @@ Two predefined functions are available:
(defvar gnus-tree-displayed-thread nil)
(defvar gnus-tree-inhibit nil)
(defvar gnus-tree-mode-map nil)
(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
"\C-c\C-i" gnus-info-find-node)
(substitute-key-definition
'undefined 'gnus-tree-read-summary-keys map)
map))
(put 'gnus-tree-mode 'mode-class 'special)
(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)
(substitute-key-definition
'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
(defun gnus-tree-make-menu-bar ()
(unless (boundp 'gnus-tree-menu)
(easy-menu-define
@ -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 ()

36
lisp/gnus/gnus-sum.el
View file

@ -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