summaryrefslogtreecommitdiff
path: root/lisp/gnus
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/gnus')
-rw-r--r--lisp/gnus/ChangeLog160
-rw-r--r--lisp/gnus/gnus-agent.el160
-rw-r--r--lisp/gnus/gnus-art.el39
-rw-r--r--lisp/gnus/gnus-bookmark.el11
-rw-r--r--lisp/gnus/gnus-cus.el8
-rw-r--r--lisp/gnus/gnus-eform.el10
-rw-r--r--lisp/gnus/gnus-group.el20
-rw-r--r--lisp/gnus/gnus-html.el7
-rw-r--r--lisp/gnus/gnus-icalendar.el25
-rw-r--r--lisp/gnus/gnus-int.el2
-rw-r--r--lisp/gnus/gnus-kill.el46
-rw-r--r--lisp/gnus/gnus-salt.el100
-rw-r--r--lisp/gnus/gnus-spec.el3
-rw-r--r--lisp/gnus/gnus-srvr.el13
-rw-r--r--lisp/gnus/gnus-sum.el36
-rw-r--r--lisp/gnus/gnus-util.el13
-rw-r--r--lisp/gnus/message.el18
-rw-r--r--lisp/gnus/mm-decode.el2
-rw-r--r--lisp/gnus/mm-util.el35
-rw-r--r--lisp/gnus/mml2015.el2
-rw-r--r--lisp/gnus/score-mode.el26
21 files changed, 412 insertions, 324 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index c75588536a4..6d718e7c8f9 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,129 @@
+2013-09-18 Glenn Morris <rgm@gnu.org>
+
+ * gnus-util.el (image-size): Declare.
+
+2013-09-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-icalendar.el (gnus-icalendar-event--find-attendee)
+ (gnus-icalendar-event-from-ical)
+ (gnus-icalendar-event--build-reply-event-body)
+ (gnus-icalendar-event-reply-from-buffer)
+ (gnus-icalendar-find-org-event-file)
+ (gnus-icalendar-event->gnus-calendar, gnus-icalendar-reply)
+ (gnus-icalendar-mm-inline): Use gmm-labels instead of labels or flet.
+
+ * mm-util.el (mm-special-display-p): Isolate XEmacs stuff.
+
+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.
+
+ * mm-decode.el (mm-add-meta-html-tag): Fix regexp matching meta tag.
+
+ * message.el (message-display-completion-list): Abolish.
+ (message-completion-in-region): Use display-completion-list.
+
+2013-09-17 Glenn Morris <rgm@gnu.org>
+
+ * gnus-util.el (gnus-message-with-timestamp-1):
+ Use `messages-buffer' function if available. Ignore read-only.
+
+2013-09-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-expand-group, message-completion-in-region):
+ Correct the order of start and end of a region.
+
+2013-09-13 Glenn Morris <rgm@gnu.org>
+
+ * mml2015.el (gnus-create-image): Autoload it.
+
+ * gnus-spec.el (gnus-xmas-format): Fix weird error call.
+
+ * gnus-html.el (declare-function): Add compat stub for ancient Emacs.
+ (image-size): Declare.
+
+2013-09-12 Glenn Morris <rgm@gnu.org>
+
+ * gnus-icalendar.el (gnus-icalendar-event--build-reply-event-body):
+ Avoid using `find', which i) might not be defined at runtime;
+ ii) does not work, since its default test is eql, not equal.
+ (gnus-mime-action-alist): Declare.
+
+2013-09-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * score-mode.el (gnus-score-mode-map): Move initialization
+ into declaration.
+ (gnus-score-mode): Use define-derived-mode.
+ * gnus-srvr.el (gnus-browse-mode): Use define-derived-mode.
+ * gnus-kill.el (gnus-kill-file-mode-map): Move initialization
+ into declaration.
+ (gnus-kill-file-mode): Use define-derived-mode.
+ (gnus-kill-file-edit-file, gnus-kill-file-enter-kill, gnus-kill):
+ Use derived-mode-p.
+ * gnus-group.el (gnus-group-mode): Use define-derived-mode.
+ (gnus-group-setup-buffer, gnus-group-name-at-point)
+ (gnus-group-make-web-group, gnus-group-enter-directory)
+ (gnus-group-suspend): Use derived-mode-p.
+ * gnus-cus.el (gnus-custom-mode): Use define-derived-mode.
+ * gnus-bookmark.el (gnus-bookmark-bmenu-mode): Use define-derived-mode.
+ * gnus-art.el (gnus-article-mode): Use define-derived-mode.
+ (gnus-article-setup-buffer, gnus-article-prepare)
+ (gnus-article-prepare-display, gnus-sticky-article)
+ (gnus-kill-sticky-article-buffer, gnus-kill-sticky-article-buffers)
+ (gnus-bind-safe-url-regexp, gnus-article-check-buffer)
+ (gnus-article-read-summary-keys): Use derived-mode-p.
+
2013-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-decode.el (mm-temp-files-delete): Fix file deletion logic.
@@ -177,15 +303,15 @@
2013-07-10 David Engster <deng@randomsample.de>
* gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks
- if `gnus-newsrc-file-version' does not match `gnus-version'. This
- fixes a bug in Emacs trunk where the 'unexist' marks were always
+ if `gnus-newsrc-file-version' does not match `gnus-version'.
+ This fixes a bug in Emacs trunk where the 'unexist' marks were always
removed at startup because "Gnus v5.13" was considered smaller than "Ma
Gnus v0.03".
2013-07-10 Tassilo Horn <tsdh@gnu.org>
- * gnus.el (gnus-summary-line-format): Reference
- `gnus-user-date-format-alist' for the &user-date; format, not
+ * gnus.el (gnus-summary-line-format):
+ Reference `gnus-user-date-format-alist' for the &user-date; format, not
`gnus-summary-user-date-format-alist'.
2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -467,7 +593,7 @@
* shr.el (shr-render-td): Support horizontal alignment.
- * eww.el (eww-put-color): Removed.
+ * eww.el (eww-put-color): Remove.
(eww-colorize-region): Use `add-face-text-property'.
* shr.el (shr-add-font): Append face data, so that we get the correct
@@ -522,7 +648,7 @@
2013-06-16 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
- * shr.el (shr-dom-to-xml): Fixed function call.
+ * shr.el (shr-dom-to-xml): Fix function call.
* eww.el (eww): New group.
(eww-header-line-format): New custom variable.
@@ -558,8 +684,8 @@
(auth-source-netrc-parse): Refactor and improve netrc parser to support
single-quoted strings and multiline entries.
(auth-source-netrc-parse-next-interesting)
- (auth-source-netrc-parse-one, auth-source-netrc-parse-entries): New
- functions to support parser.
+ (auth-source-netrc-parse-one, auth-source-netrc-parse-entries):
+ New functions to support parser.
2013-06-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -707,8 +833,8 @@
* registry.el (initialize-instance, registry-lookup)
(registry-lookup-breaks-before-lexbind, registry-lookup-secondary)
(registry-lookup-secondary-value, registry-search, registry-delete)
- (registry-insert, registry-reindex, registry-size, registry-prune): Do
- not wrap methods in `eval-and-compile'. This breaks due to latest
+ (registry-insert, registry-reindex, registry-size, registry-prune):
+ Do not wrap methods in `eval-and-compile'. This breaks due to latest
changes in EIEIO (introduction of eieio-core.el).
2013-05-30 Glenn Morris <rgm@gnu.org>
@@ -988,8 +1114,8 @@
2013-03-26 Andrew Cohen <cohen@bu.edu>
* nnir.el: Major rewrite. Cleaner separation between searches and group
- management. Marks are now shown in nnir summary buffers. Rudimentary
- support for real (i.e. not ephemeral) nnir groups.
+ management. Marks are now shown in nnir summary buffers.
+ Rudimentary support for real (i.e. not ephemeral) nnir groups.
(gnus-summary-make-nnir-group): New function for initiating searches
from a summary buffer.
@@ -1018,8 +1144,8 @@
2013-02-22 David Engster <deng@randomsample.de>
* gnus-registry.el (gnus-registry-save): Provide class name when
- calling `eieio-persistent-read' to avoid "unsafe call" warning. Use
- `condition-case' to stay compatible with older EIEIO versions which
+ calling `eieio-persistent-read' to avoid "unsafe call" warning.
+ Use `condition-case' to stay compatible with older EIEIO versions which
only accept one argument.
2013-02-17 Daiki Ueno <ueno@gnu.org>
@@ -5295,7 +5421,7 @@
a creation default, pass the whole port list down. It will be
completed.
- * auth-source.el (auth-source-search): Updated docs to talk about
+ * auth-source.el (auth-source-search): Update docs to talk about
multiple creation choices.
(auth-source-netrc-create): Accept a list as a value (from the search
parameters) and do completion on that list. Keep a separate netrc line
@@ -5362,7 +5488,7 @@
(gnus-summary-exit): Kill the correct article buffer on exit from a
`C-d' group.
- * gnus-start.el (gnus-use-backend-marks): Removed, since it duplicates
+ * gnus-start.el (gnus-use-backend-marks): Remove, since it duplicates
gnus-propagate-marks.
* gnus-sum.el (gnus-summary-exit-no-update): Restore the group conf
@@ -18399,7 +18525,7 @@
2005-11-19 Kevin Greiner <kevin.greiner@compsol.cc>
- * gnus-sum.el (gnus-fetch-old-headers): Updated docs to warn that
+ * gnus-sum.el (gnus-fetch-old-headers): Update docs to warn that
it can seriously impact performance as it bypasses the agent's
local caches.
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 1d0f346e10f..10ee230a814 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-art.el b/lisp/gnus/gnus-art.el
index e65b9fb99e4..b80aa3a24e9 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3683,7 +3683,7 @@ function and want to see what the date was before converting."
(walk-windows
(lambda (w)
(set-buffer (window-buffer w))
- (when (eq major-mode 'gnus-article-mode)
+ (when (derived-mode-p 'gnus-article-mode)
(let ((old-line (count-lines (point-min) (point)))
(old-column (- (point) (line-beginning-position)))
(window-start (window-start w))
@@ -4455,7 +4455,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(defvar bookmark-make-record-function)
(defvar shr-put-image-function)
-(defun gnus-article-mode ()
+(define-derived-mode gnus-article-mode fundamental-mode "Article"
"Major mode for displaying an article.
All normal editing commands are switched off.
@@ -4470,13 +4470,8 @@ commands:
\\[gnus-article-mail]\t Send a reply to the address near point
\\[gnus-article-describe-briefly]\t Describe the current mode briefly
\\[gnus-info-find-node]\t Go to the Gnus info node"
- (interactive)
- (kill-all-local-variables)
(gnus-simplify-mode-line)
- (setq mode-name "Article")
- (setq major-mode 'gnus-article-mode)
(make-local-variable 'minor-mode-alist)
- (use-local-map gnus-article-mode-map)
(when (gnus-visual-p 'article-menu 'menu)
(gnus-article-make-menu-bar)
(when gnus-summary-tool-bar-map
@@ -4504,9 +4499,7 @@ commands:
(buffer-disable-undo)
(setq buffer-read-only t
show-trailing-whitespace nil)
- (set-syntax-table gnus-article-mode-syntax-table)
- (mm-enable-multibyte)
- (gnus-run-mode-hooks 'gnus-article-mode-hook))
+ (mm-enable-multibyte))
(defun gnus-article-setup-buffer ()
"Initialize the article buffer."
@@ -4554,7 +4547,7 @@ commands:
(setq gnus-article-mime-handle-alist nil)
(buffer-disable-undo)
(setq buffer-read-only t)
- (unless (eq major-mode 'gnus-article-mode)
+ (unless (derived-mode-p 'gnus-article-mode)
(gnus-article-mode))
(setq truncate-lines gnus-article-truncate-lines)
(current-buffer))
@@ -4603,7 +4596,7 @@ If ARTICLE is an id, HEADER should be the article headers.
If ALL-HEADERS is non-nil, no headers are hidden."
(save-excursion
;; Make sure we start in a summary buffer.
- (unless (eq major-mode 'gnus-summary-mode)
+ (unless (derived-mode-p 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
(setq gnus-summary-buffer (current-buffer))
(let* ((gnus-article (if header (mail-header-number header) article))
@@ -4714,7 +4707,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(let ((gnus-article-buffer (current-buffer))
buffer-read-only
(inhibit-read-only t))
- (unless (eq major-mode 'gnus-article-mode)
+ (unless (derived-mode-p 'gnus-article-mode)
(gnus-article-mode))
(setq buffer-read-only nil
gnus-article-wash-types nil
@@ -4776,7 +4769,7 @@ If a prefix ARG is given, ask for a name for this sticky article buffer."
"*"))
(if (and (gnus-buffer-live-p new-art-buf-name)
(with-current-buffer new-art-buf-name
- (eq major-mode 'gnus-sticky-article-mode)))
+ (derived-mode-p 'gnus-sticky-article-mode)))
(switch-to-buffer new-art-buf-name)
(setq new-art-buf-name (rename-buffer new-art-buf-name t)))
(gnus-sticky-article-mode))
@@ -4792,7 +4785,7 @@ If none is given, assume the current buffer and kill it if it has
(unless buffer
(setq buffer (current-buffer)))
(with-current-buffer buffer
- (when (eq major-mode 'gnus-sticky-article-mode)
+ (when (derived-mode-p 'gnus-sticky-article-mode)
(gnus-kill-buffer buffer))))
(defun gnus-kill-sticky-article-buffers (arg)
@@ -4801,11 +4794,11 @@ If a prefix ARG is given, ask for confirmation."
(interactive "P")
(dolist (buf (gnus-buffers))
(with-current-buffer buf
- (when (eq major-mode 'gnus-sticky-article-mode)
- (if (not arg)
- (gnus-kill-buffer buf)
- (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
- (gnus-kill-buffer buf)))))))
+ (when (derived-mode-p 'gnus-sticky-article-mode)
+ (if (not arg)
+ (gnus-kill-buffer buf)
+ (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
+ (gnus-kill-buffer buf)))))))
;;;
;;; Gnus MIME viewing functions
@@ -4893,7 +4886,7 @@ General format specifiers can also be used. See Info node
(defmacro gnus-bind-safe-url-regexp (&rest body)
"Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
`(let ((mm-w3m-safe-url-regexp
- (let ((group (if (and (eq major-mode 'gnus-article-mode)
+ (let ((group (if (and (derived-mode-p 'gnus-article-mode)
(gnus-buffer-live-p
gnus-article-current-summary))
(with-current-buffer gnus-article-current-summary
@@ -6477,7 +6470,7 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-check-buffer ()
"Beep if not in an article buffer."
- (unless (equal major-mode 'gnus-article-mode)
+ (unless (derived-mode-p 'gnus-article-mode)
(error "Command invoked outside of a Gnus article buffer")))
(defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
@@ -6592,7 +6585,7 @@ not have a face in `gnus-article-boring-faces'."
new-sum-point
(window-live-p win)
(with-current-buffer (window-buffer win)
- (eq major-mode 'gnus-summary-mode)))
+ (derived-mode-p 'gnus-summary-mode)))
(set-window-point win new-sum-point)
(set-window-start win new-sum-start)
(set-window-hscroll win new-sum-hscroll))))
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 7a3d273622a..c31cb1aef36 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -190,7 +190,7 @@ So the cdr of each bookmark is an alist too.")
"Set a bookmark for this article."
(interactive)
(gnus-bookmark-maybe-load-default-file)
- (if (or (not (eq major-mode 'gnus-summary-mode))
+ (if (or (not (derived-mode-p 'gnus-summary-mode))
(not gnus-article-current))
(error "Please select an article in the Gnus summary buffer")
(let* ((group (car gnus-article-current))
@@ -473,7 +473,7 @@ That is, all information but the name."
;; Been to lazy to use gnus-bookmark-save...
(defalias 'gnus-bookmark-bmenu-save 'gnus-bookmark-write-file)
-(defun gnus-bookmark-bmenu-mode ()
+(define-derived-mode gnus-bookmark-bmenu-mode fundamental-mode "Bookmark Menu"
"Major mode for editing a list of Gnus bookmarks.
Each line describes one of the bookmarks in Gnus.
Letters do not insert themselves; instead, they are commands.
@@ -497,13 +497,8 @@ Gnus bookmarks names preceded by a \"*\" have annotations.
in another buffer.
\\[gnus-bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
\\[gnus-bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
- (kill-all-local-variables)
- (use-local-map gnus-bookmark-bmenu-mode-map)
(setq truncate-lines t)
- (setq buffer-read-only t)
- (setq major-mode 'gnus-bookmark-bmenu-mode)
- (setq mode-name "Bookmark Menu")
- (gnus-run-mode-hooks 'gnus-bookmark-bmenu-mode-hook))
+ (setq buffer-read-only t))
;; avoid compilation warnings
(defvar gnus-bookmark-bmenu-toggle-infos nil)
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index c8fb5b5dc73..247c081a20f 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -33,7 +33,7 @@
;;; Widgets:
-(defun gnus-custom-mode ()
+(define-derived-mode gnus-custom-mode fundamental-mode "Gnus Customize"
"Major mode for editing Gnus customization buffers.
The following commands are available:
@@ -45,9 +45,6 @@ The following commands are available:
Entry to this mode calls the value of `gnus-custom-mode-hook'
if that value is non-nil."
- (kill-all-local-variables)
- (setq major-mode 'gnus-custom-mode
- mode-name "Gnus Customize")
(use-local-map widget-keymap)
;; Emacs stuff:
(when (and (facep 'custom-button-face)
@@ -63,8 +60,7 @@ if that value is non-nil."
(set (make-local-variable 'widget-push-button-prefix) "")
(set (make-local-variable 'widget-push-button-suffix) "")
(set (make-local-variable 'widget-link-prefix) "")
- (set (make-local-variable 'widget-link-suffix) ""))
- (gnus-run-mode-hooks 'gnus-custom-mode-hook))
+ (set (make-local-variable 'widget-link-suffix) "")))
;;; Group Customization:
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 6790803305a..00e27876088 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-group.el b/lisp/gnus/gnus-group.el
index 9533f5819a4..c8945e57531 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1105,7 +1105,7 @@ When FORCE, rebuild the tool bar."
(set (make-local-variable 'tool-bar-map) map))))
gnus-group-tool-bar-map)
-(defun gnus-group-mode ()
+(define-derived-mode gnus-group-mode fundamental-mode "Group"
"Major mode for reading news.
All normal editing commands are switched off.
@@ -1122,17 +1122,12 @@ For more in-depth information on this mode, read the manual (`\\[gnus-info-find-
The following commands are available:
\\{gnus-group-mode-map}"
- (interactive)
- (kill-all-local-variables)
(when (gnus-visual-p 'group-menu 'menu)
(gnus-group-make-menu-bar)
(gnus-group-make-tool-bar))
(gnus-simplify-mode-line)
- (setq major-mode 'gnus-group-mode)
- (setq mode-name "Group")
(gnus-group-set-mode-line)
(setq mode-line-process nil)
- (use-local-map gnus-group-mode-map)
(buffer-disable-undo)
(setq truncate-lines t)
(setq buffer-read-only t
@@ -1143,8 +1138,7 @@ The following commands are available:
(when gnus-use-undo
(gnus-undo-mode 1))
(when gnus-slave
- (gnus-slave-mode))
- (gnus-run-mode-hooks 'gnus-group-mode-hook))
+ (gnus-slave-mode)))
(defun gnus-update-group-mark-positions ()
(save-excursion
@@ -1193,7 +1187,7 @@ The following commands are available:
(defun gnus-group-setup-buffer ()
(set-buffer (gnus-get-buffer-create gnus-group-buffer))
- (unless (eq major-mode 'gnus-group-mode)
+ (unless (derived-mode-p 'gnus-group-mode)
(gnus-group-mode)))
(defun gnus-group-name-charset (method group)
@@ -2147,7 +2141,7 @@ be permanent."
(defun gnus-group-name-at-point ()
"Return a group name from around point if it exists, or nil."
- (if (eq major-mode 'gnus-group-mode)
+ (if (derived-mode-p 'gnus-group-mode)
(let ((group (gnus-group-group-name)))
(when group
(gnus-group-decoded-name group)))
@@ -3114,7 +3108,7 @@ If SOLID (the prefix), create a solid group."
(gnus-group-read-ephemeral-group
group method t
(cons (current-buffer)
- (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+ (if (derived-mode-p 'gnus-summary-mode) 'summary 'group))))))
(defvar nnrss-group-alist)
(eval-when-compile
@@ -3229,7 +3223,7 @@ mail messages or news articles in files that have numeric names."
(unless (gnus-group-read-ephemeral-group
name method t
(cons (current-buffer)
- (if (eq major-mode 'gnus-summary-mode)
+ (if (derived-mode-p 'gnus-summary-mode)
'summary 'group)))
(error "Couldn't enter %s" dir))))
@@ -4319,7 +4313,7 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending."
(unless (or (eq buf group-buf)
(eq buf gnus-dribble-buffer)
(with-current-buffer buf
- (eq major-mode 'message-mode)))
+ (derived-mode-p 'message-mode)))
(gnus-kill-buffer buf)))
(setq gnus-backlog-articles nil)
(gnus-kill-gnus-frames)
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index a5625dfed80..2700af3d009 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -28,6 +28,10 @@
;;; Code:
+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(eval-when-compile (require 'cl))
(require 'gnus-art)
@@ -438,6 +442,9 @@ Return a string with image data."
(truncate (* gnus-max-image-proportion
(- (nth 3 edges) (nth 1 edges)))))))
+;; Behind display-graphic-p test.
+(declare-function image-size "image.c" (spec &optional pixels frame))
+
(defun gnus-html-put-image (data url &optional alt-text)
"Put an image with DATA from URL and optional ALT-TEXT."
(when (gnus-graphic-display-p)
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index a946a586033..969c868b564 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -35,6 +35,7 @@
(require 'icalendar)
(require 'eieio)
+(require 'gmm-utils)
(require 'mm-decode)
(require 'gnus-sum)
@@ -149,7 +150,7 @@
(defun gnus-icalendar-event--find-attendee (ical name-or-email)
(let* ((event (car (icalendar--all-events ical)))
(event-props (caddr event)))
- (labels ((attendee-name (att) (plist-get (cadr att) 'CN))
+ (gmm-labels ((attendee-name (att) (plist-get (cadr att) 'CN))
(attendee-email (att)
(replace-regexp-in-string "^.*MAILTO:" "" (caddr att)))
(attendee-prop-matches-p (prop)
@@ -189,7 +190,7 @@
((string= method "REPLY") 'gnus-icalendar-event-reply)
(t 'gnus-icalendar-event))))
- (labels ((map-property (prop)
+ (gmm-labels ((map-property (prop)
(let ((value (icalendar--get-event-property event prop)))
(when value
;; ugly, but cannot get
@@ -233,7 +234,7 @@ status will be retrieved from the first matching attendee record."
(let ((summary-status (capitalize (symbol-name status)))
(attendee-status (upcase (symbol-name status)))
reply-event-lines)
- (labels ((update-summary (line)
+ (gmm-labels ((update-summary (line)
(if (string-match "^[^:]+:" line)
(replace-match (format "\\&%s: " summary-status) t nil line)
line))
@@ -257,9 +258,9 @@ status will be retrieved from the first matching attendee record."
((string= key "ATTENDEE") (update-attendee-status line))
((string= key "SUMMARY") (update-summary line))
((string= key "DTSTAMP") (update-dtstamp))
- ((find key '("ORGANIZER" "DTSTART" "DTEND"
- "LOCATION" "DURATION" "SEQUENCE"
- "RECURRENCE-ID" "UID")) line)
+ ((member key '("ORGANIZER" "DTSTART" "DTEND"
+ "LOCATION" "DURATION" "SEQUENCE"
+ "RECURRENCE-ID" "UID")) line)
(t nil))))
(when new-line
(push new-line reply-event-lines))))))
@@ -280,7 +281,7 @@ status will be retrieved from the first matching attendee record."
The reply will have STATUS (`accepted', `tentative' or `declined').
The reply will be composed for attendees matching any entry
on the IDENTITIES list."
- (flet ((extract-block (blockname)
+ (gmm-labels ((extract-block (blockname)
(save-excursion
(let ((block-start-re (format "^BEGIN:%s" blockname))
(block-end-re (format "^END:%s" blockname))
@@ -419,7 +420,7 @@ the optional ORG-FILE argument is specified, only that one file
is searched."
(let ((uid (gnus-icalendar-event:uid event))
(files (or org-file (org-agenda-files t 'ifmode))))
- (flet
+ (gmm-labels
((find-event-in (file)
(org-check-agenda-file file)
(with-current-buffer (find-file-noselect file)
@@ -596,7 +597,7 @@ is searched."
;; TODO: make the template customizable
(defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status)
"Format an overview of EVENT details."
- (flet ((format-header (x)
+ (gmm-labels ((format-header (x)
(format "%-12s%s"
(propertize (concat (car x) ":") 'face 'bold)
(cadr x))))
@@ -673,7 +674,7 @@ is searched."
(current-buffer) status gnus-icalendar-identities))))
(when reply
- (flet ((fold-icalendar-buffer ()
+ (gmm-labels ((fold-icalendar-buffer ()
(goto-char (point-min))
(while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t)
(replace-match "\\1\n \\2")
@@ -735,7 +736,7 @@ is searched."
(setq gnus-icalendar-reply-status nil)
(when event
- (flet ((insert-button-group (buttons)
+ (gmm-labels ((insert-button-group (buttons)
(when buttons
(mapc (lambda (x)
(apply 'gnus-icalendar-insert-button x)
@@ -816,6 +817,8 @@ is searched."
(gnus-icalendar-show-org-agenda
(with-current-buffer gnus-article-buffer gnus-icalendar-event)))
+(defvar gnus-mime-action-alist) ; gnus-art
+
(defun gnus-icalendar-setup ()
(add-to-list 'mm-inlined-types "text/calendar")
(add-to-list 'mm-automatic-display "text/calendar")
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index f0cf0daed01..2de6ce0fce1 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -302,7 +302,7 @@ If it is down, start it up (again)."
(setcar
(cdr elem)
(cond (result
- (if (eq open-server-function #'nnagent-open-server)
+ (if (eq open-server-function 'nnagent-open-server)
;; The agent's backend has a "special" status
'offline
'ok))
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index b3f06de0868..011288e280b 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -75,20 +75,20 @@ of time."
;;; Gnus Kill File Mode
;;;
-(defvar gnus-kill-file-mode-map nil)
-
-(unless gnus-kill-file-mode-map
- (gnus-define-keymap (setq gnus-kill-file-mode-map
- (copy-keymap emacs-lisp-mode-map))
- "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
- "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
- "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
- "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
- "\C-c\C-a" gnus-kill-file-apply-buffer
- "\C-c\C-e" gnus-kill-file-apply-last-sexp
- "\C-c\C-c" gnus-kill-file-exit))
-
-(defun gnus-kill-file-mode ()
+(defvar gnus-kill-file-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map emacs-lisp-mode-map)
+ (gnus-define-keymap map
+ "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
+ "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
+ "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
+ "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
+ "\C-c\C-a" gnus-kill-file-apply-buffer
+ "\C-c\C-e" gnus-kill-file-apply-last-sexp
+ "\C-c\C-c" gnus-kill-file-exit)
+ map))
+
+(define-derived-mode gnus-kill-file-mode emacs-lisp-mode "Kill"
"Major mode for editing kill files.
If you are using this mode - you probably shouldn't. Kill files
@@ -151,15 +151,7 @@ which are marked as read in the previous Gnus sessions. Marks other
than `D' should be used for articles which should really be deleted.
Entry to this mode calls emacs-lisp-mode-hook and
-gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
- (interactive)
- (kill-all-local-variables)
- (use-local-map gnus-kill-file-mode-map)
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (setq major-mode 'gnus-kill-file-mode)
- (setq mode-name "Kill")
- (lisp-mode-variables nil)
- (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
+gnus-kill-file-mode-hook with no arguments, if that value is non-nil.")
(defun gnus-kill-file-edit-file (newsgroup)
"Begin editing a kill file for NEWSGROUP.
@@ -175,10 +167,10 @@ If NEWSGROUP is nil, the global kill file is selected."
(let ((buffer (find-file-noselect file)))
(cond ((get-buffer-window buffer)
(pop-to-buffer buffer))
- ((eq major-mode 'gnus-group-mode)
+ ((derived-mode-p 'gnus-group-mode)
(gnus-configure-windows 'group) ;Take all windows.
(pop-to-buffer buffer))
- ((eq major-mode 'gnus-summary-mode)
+ ((derived-mode-p 'gnus-summary-mode)
(gnus-configure-windows 'article)
(pop-to-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer)
@@ -201,7 +193,7 @@ If NEWSGROUP is nil, the global kill file is selected."
;; REGEXP: The string to kill.
(save-excursion
(let (string)
- (unless (eq major-mode 'gnus-kill-file-mode)
+ (unless (derived-mode-p 'gnus-kill-file-mode)
(gnus-kill-set-kill-buffer))
(unless dont-move
(goto-char (point-max)))
@@ -520,7 +512,7 @@ COMMAND must be a Lisp expression or a string representing a key sequence."
(setq kill-list (cdr kill-list))))
(gnus-execute field kill-list command nil (not all))))))
(switch-to-buffer old-buffer)
- (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
+ (when (and (derived-mode-p 'gnus-kill-file-mode) regexp (not silent))
(gnus-pp-gnus-kill
(nconc (list 'gnus-kill field
(if (consp regexp) (list 'quote regexp) regexp))
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index 6b8e105e6b8..77fe0d3bb14 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-spec.el b/lisp/gnus/gnus-spec.el
index 0ff8ec89ac1..a39f185b56d 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -512,7 +512,8 @@ are supported for %s."
(delete-char -1))
(t
(if (null args)
- (error 'wrong-number-of-arguments #'my-format n fstring))
+ (signal 'wrong-number-of-arguments
+ (list #'gnus-xmas-format n fstring)))
(let* ((minlen (string-to-number (or (match-string 2) "")))
(arg (car args))
(str (if (stringp arg) arg (format "%s" arg)))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 69774587d80..2f151e570d7 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -244,6 +244,7 @@ For more in-depth information on this mode, read the manual
The following commands are available:
\\{gnus-server-mode-map}"
+ ;; FIXME: Use define-derived-mode.
(interactive)
(when (gnus-visual-p 'server-menu 'menu)
(gnus-server-make-menu-bar))
@@ -869,7 +870,7 @@ claim them."
(gnus-message 5 "Connecting to %s...done" (nth 1 method))
t))))
-(defun gnus-browse-mode ()
+(define-derived-mode gnus-browse-mode fundamental-mode "Browse Server"
"Major mode for browsing a foreign server.
All normal editing commands are switched off.
@@ -884,20 +885,14 @@ buffer.
2) `\\[gnus-browse-read-group]' to read a group ephemerally.
3) `\\[gnus-browse-exit]' to return to the group buffer."
- (interactive)
- (kill-all-local-variables)
(when (gnus-visual-p 'browse-menu 'menu)
(gnus-browse-make-menu-bar))
(gnus-simplify-mode-line)
- (setq major-mode 'gnus-browse-mode)
- (setq mode-name "Browse Server")
(setq mode-line-process nil)
- (use-local-map gnus-browse-mode-map)
(buffer-disable-undo)
(setq truncate-lines t)
(gnus-set-default-directory)
- (setq buffer-read-only t)
- (gnus-run-mode-hooks 'gnus-browse-mode-hook))
+ (setq buffer-read-only t))
(defun gnus-browse-read-group (&optional no-article number)
"Enter the group at the current line.
@@ -1022,7 +1017,7 @@ doing the deletion."
(defun gnus-browse-exit ()
"Quit browsing and return to the group buffer."
(interactive)
- (when (eq major-mode 'gnus-browse-mode)
+ (when (derived-mode-p 'gnus-browse-mode)
(gnus-kill-buffer (current-buffer)))
;; Insert the newly subscribed groups in the group buffer.
(with-current-buffer gnus-group-buffer
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 94f4e703180..61cf7ec5b61 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
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 1d2ab2da248..b682e64716f 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -514,11 +514,14 @@ but also to the ones displayed in the echo area."
(> message-log-max 0)
(/= (length str) 0))
(setq time (current-time))
- (with-current-buffer (get-buffer-create "*Messages*")
+ (with-current-buffer (if (fboundp 'messages-buffer)
+ (messages-buffer)
+ (get-buffer-create "*Messages*"))
(goto-char (point-max))
- (insert ,timestamp str "\n")
- (forward-line (- message-log-max))
- (delete-region (point-min) (point))
+ (let ((inhibit-read-only t))
+ (insert ,timestamp str "\n")
+ (forward-line (- message-log-max))
+ (delete-region (point-min) (point)))
(goto-char (point-max))))
str)
(gnus-add-timestamp-to-message
@@ -1888,6 +1891,8 @@ empty directories from OLD-PATH."
(get-char-table ,character ,display-table)))
`(aref ,display-table ,character)))
+(declare-function image-size "image.c" (spec &optional pixels frame))
+
(defun gnus-rescale-image (image size)
"Rescale IMAGE to SIZE if possible.
SIZE is in format (WIDTH . HEIGHT). Return a new image.
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index d6d6b3f8bed..a458b3fc25b 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -7947,17 +7947,6 @@ those headers."
;; falling back to message-tab-body-function.
(lambda () (funcall fun) 'completion-attempted)))))
-(eval-and-compile
- (condition-case nil
- (with-temp-buffer
- (let ((standard-output (current-buffer)))
- (eval '(display-completion-list nil "")))
- (defalias 'message-display-completion-list 'display-completion-list))
- (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs.
- (defun message-display-completion-list (completions &optional ignore)
- "Display the list of completions, COMPLETIONS, using `standard-output'."
- (display-completion-list completions)))))
-
(defun message-expand-group ()
"Expand the group name under point."
(let ((b (save-excursion
@@ -7982,12 +7971,12 @@ those headers."
group)
collection))
gnus-active-hashtb))
- (message-completion-in-region e b collection)))
+ (message-completion-in-region b e collection)))
(defalias 'message-completion-in-region
(if (fboundp 'completion-in-region)
'completion-in-region
- (lambda (e b hashtb)
+ (lambda (b e hashtb)
(let* ((string (buffer-substring b e))
(completions (all-completions string hashtb))
comp)
@@ -8012,8 +8001,7 @@ those headers."
(let ((buffer-read-only nil))
(erase-buffer)
(let ((standard-output (current-buffer)))
- (message-display-completion-list (sort completions 'string<)
- string))
+ (display-completion-list (sort completions 'string<)))
(setq buffer-read-only nil)
(goto-char (point-min))
(delete-region (point)
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 28d930b55f7..941849da183 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1415,7 +1415,7 @@ Return t if meta tag is added or replaced."
(goto-char (point-min))
(if (re-search-forward "\
<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\
-text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+\\)\\)?[\"'][^>]*>" nil t)
+text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\([^\"'>]+\\)\\)?[^>]*>" nil t)
(if (and (not force-charset)
(match-beginning 2)
(string-match "\\`html\\'" (match-string 1)))
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 9c2f0df5f59..5b0fd6860a0 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -129,22 +129,6 @@
(multibyte-char-to-unibyte . identity)
;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs.
(set-buffer-multibyte . ignore)
- ;; `special-display-p' is an Emacs function, not available in XEmacs.
- (special-display-p
- . ,(lambda (buffer-name)
- "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
- (and special-display-function
- (or (and (member buffer-name special-display-buffer-names) t)
- (cdr (assoc buffer-name special-display-buffer-names))
- (catch 'return
- (dolist (elem special-display-regexps)
- (and (stringp elem)
- (string-match elem buffer-name)
- (throw 'return t))
- (and (consp elem)
- (stringp (car elem))
- (string-match (car elem) buffer-name)
- (throw 'return (cdr elem)))))))))
;; `substring-no-properties' is available only in Emacs 22.1 or greater.
(substring-no-properties
. ,(lambda (string &optional from to)
@@ -174,6 +158,25 @@ to the contents of the accessible portion of the buffer."
(forward-line 0)
(1+ (count-lines start (point))))))))))
+;; `special-display-p' is an Emacs function, not available in XEmacs.
+(defalias 'mm-special-display-p
+ (if (featurep 'emacs)
+ 'special-display-p
+ (lambda (buffer-name)
+ "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
+ (and special-display-function
+ (or (and (member buffer-name special-display-buffer-names) t)
+ (cdr (assoc buffer-name special-display-buffer-names))
+ (catch 'return
+ (dolist (elem special-display-regexps)
+ (and (stringp elem)
+ (string-match elem buffer-name)
+ (throw 'return t))
+ (and (consp elem)
+ (stringp (car elem))
+ (string-match (car elem) buffer-name)
+ (throw 'return (cdr elem))))))))))
+
;; `decode-coding-string', `encode-coding-string', `decode-coding-region'
;; and `encode-coding-region' are available in Emacs and XEmacs built with
;; the `file-coding' feature, but the XEmacs versions treat nil, that is
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 3efa5c23bb3..a2fa1a1c532 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -866,6 +866,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(setq secret-keys (cdr secret-keys))))
secret-key))
+(autoload 'gnus-create-image "gnus-ems")
+
(defun mml2015-epg-key-image (key-id)
"Return the image of a key, if any"
(with-temp-buffer
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index ec24f1f9670..58767cfcc7a 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -40,13 +40,13 @@
(defvar gnus-score-edit-exit-function nil
"Function run on exit from the score buffer.")
-(defvar gnus-score-mode-map nil)
-(unless gnus-score-mode-map
- (setq gnus-score-mode-map (make-sparse-keymap))
- (set-keymap-parent gnus-score-mode-map emacs-lisp-mode-map)
- (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit)
- (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)
- (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print))
+(defvar gnus-score-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map emacs-lisp-mode-map)
+ (define-key map "\C-c\C-c" 'gnus-score-edit-exit)
+ (define-key map "\C-c\C-d" 'gnus-score-edit-insert-date)
+ (define-key map "\C-c\C-p" 'gnus-score-pretty-print)
+ map))
(defvar score-mode-syntax-table
(let ((table (copy-syntax-table lisp-mode-syntax-table)))
@@ -58,21 +58,13 @@
(defvar score-mode-coding-system mm-universal-coding-system)
;;;###autoload
-(defun gnus-score-mode ()
+(define-derived-mode gnus-score-mode emacs-lisp-mode "Score"
"Mode for editing Gnus score files.
This mode is an extended emacs-lisp mode.
\\{gnus-score-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map gnus-score-mode-map)
(gnus-score-make-menu-bar)
- (set-syntax-table score-mode-syntax-table)
- (setq major-mode 'gnus-score-mode)
- (setq mode-name "Score")
- (lisp-mode-variables nil)
- (make-local-variable 'gnus-score-edit-exit-function)
- (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
+ (make-local-variable 'gnus-score-edit-exit-function))
(defun gnus-score-make-menu-bar ()
(unless (boundp 'gnus-score-menu)
View Lorry Controller Status