[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r114334: * lisp/gnus/gnus-agent.el (gnus-category-mo
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] trunk r114334: * lisp/gnus/gnus-agent.el (gnus-category-mode): Use define-derived-mode. |
|
Date: |
Tue, 17 Sep 2013 17:22:37 +0000 |
|
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 114334
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2013-09-17 13:22:32 -0400
message:
* 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.
modified:
lisp/gnus/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1433
lisp/gnus/gnus-agent.el
gnusagent.el-20091113204419-o5vbwnq5f7feedwu-1311
lisp/gnus/gnus-eform.el
gnuseform.el-20091113204419-o5vbwnq5f7feedwu-1117
lisp/gnus/gnus-salt.el
gnussalt.el-20091113204419-o5vbwnq5f7feedwu-1130
lisp/gnus/gnus-sum.el gnussum.el-20091113204419-o5vbwnq5f7feedwu-1137
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2013-09-17 14:08:24 +0000
+++ b/lisp/gnus/ChangeLog 2013-09-17 17:22:32 +0000
@@ -1,3 +1,54 @@
+2013-09-17 Stefan Monnier <address@hidden>
+
+ * 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 <address@hidden>
* gnus-int.el (gnus-open-server): Silence compiler.
=== modified file 'lisp/gnus/gnus-agent.el'
--- a/lisp/gnus/gnus-agent.el 2013-01-02 16:13:04 +0000
+++ b/lisp/gnus/gnus-agent.el 2013-09-17 17:22:32 +0000
@@ -492,7 +492,7 @@
(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 @@
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 @@
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 @@
(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 @@
(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 @@
. 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 @@
;; 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 @@
(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 @@
(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 @@
(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 @@
(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 @@
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 @@
;; 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 @@
(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 @@
(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 @@
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 @@
"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 @@
(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 @@
(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 @@
(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 @@
;; 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 @@
(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 @@
(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 @@
(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 @@
(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 @@
;; 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 @@
(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 @@
(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 @@
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))
=== modified file 'lisp/gnus/gnus-eform.el'
--- a/lisp/gnus/gnus-eform.el 2013-01-01 09:11:05 +0000
+++ b/lisp/gnus/gnus-eform.el 2013-09-17 17:22:32 +0000
@@ -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.
=== modified file 'lisp/gnus/gnus-salt.el'
--- a/lisp/gnus/gnus-salt.el 2013-05-09 01:40:20 +0000
+++ b/lisp/gnus/gnus-salt.el 2013-09-17 17:22:32 +0000
@@ -292,22 +292,25 @@
(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 @@
(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 @@
;;; 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 @@
(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 @@
'("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 @@
(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 @@
(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 @@
(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 @@
(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 ()
=== modified file 'lisp/gnus/gnus-sum.el'
--- a/lisp/gnus/gnus-sum.el 2013-07-30 22:09:37 +0000
+++ b/lisp/gnus/gnus-sum.el 2013-09-17 17:22:32 +0000
@@ -1140,7 +1140,6 @@
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 @@
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 @@
"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 @@
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 @@
;; 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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
"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 @@
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 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 @@
(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 @@
(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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r114334: * lisp/gnus/gnus-agent.el (gnus-category-mode): Use define-derived-mode.,
Stefan Monnier <=