;;; gnus-sum.el --- summary mode commands for Semi-gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(eval-when-compile
(require 'mime-play)
- ;; Avoid byte-compile warnings.
- (defvar gnus-article-decoded-p)
- (defvar gnus-decode-encoded-word-function)
- )
+ (require 'static))
(eval-and-compile
- (autoload 'gnus-cache-articles-in-group "gnus-cache"))
+ (autoload 'gnus-cache-articles-in-group "gnus-cache")
+ (autoload 'pgg-decrypt-region "pgg" nil t)
+ (autoload 'pgg-verify-region "pgg" nil t))
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
+(autoload 'gnus-cache-write-active "gnus-cache")
(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t)
(defcustom gnus-kill-summary-on-exit t
:type 'string)
(defcustom gnus-summary-goto-unread t
- "*If t, marking commands will go to the next unread article.
-If `never', commands that usually go to the next unread article, will
-go to the next article, whether it is read or not.
-If nil, only the marking commands will go to the next (un)read article."
+ "*If t, many commands will go to the next unread article.
+This applies to marking commands as well as other commands that
+\"naturally\" select the next article, like, for instance, `SPC' at
+the end of an article.
+
+If nil, the marking commands do NOT go to the next unread article
+(they go to the next article instead). If `never', commands that
+usually go to the next unread article, will go to the next article,
+whether it is read or not."
:group 'gnus-summary-marks
:link '(custom-manual "(gnus)Setting Marks")
:type '(choice (const :tag "off" nil)
(function-item gnus-summary-first-unread-article)
(function-item gnus-summary-best-unread-article)))
+(defcustom gnus-dont-select-after-jump-to-other-group nil
+ "If non-nil, don't select the first unread article after entering the
+other group by the command `gnus-summary-jump-to-other-group'. If nil,
+it is depend on the value of `gnus-auto-select-first' whether to select
+or not."
+ :group 'gnus-group-select
+ :type 'boolean)
+
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
If the value is t and the next newsgroup is empty, Gnus will exit
(cons :value ("" "") regexp (repeat string))
(sexp :value nil))))
-(defcustom gnus-unread-mark ? ;Whitespace
+(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-empty-thread-mark ? ;Whitespace
+(defcustom gnus-empty-thread-mark ? ;Whitespace
"*There is no thread under the article."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-summary-format
:type 'string)
+(defcustom gnus-list-identifiers nil
+ "Regexp that matches list identifiers to be removed from subject.
+This can also be a list of regexps."
+ :group 'gnus-summary-format
+ :group 'gnus-article-hiding
+ :type '(choice (const :tag "none" nil)
+ (regexp :value ".*")
+ (repeat :value (".*") regexp)))
+
(defcustom gnus-summary-mark-below 0
"*Mark all articles with a score below this variable as read.
This variable is local to each summary buffer and usually set by the
:type 'hook)
(defcustom gnus-exit-group-hook nil
- "*A hook called when exiting (not quitting) summary mode."
+ "*A hook called when exiting summary mode.
+This hook is not called from the non-updating exit commands like `Q'."
:group 'gnus-various
:type 'hook)
. gnus-summary-high-unread-face)
((and (< score default) (= mark gnus-unread-mark))
. gnus-summary-low-unread-face)
+ ((and (memq article gnus-newsgroup-incorporated)
+ (= mark gnus-unread-mark))
+ . gnus-summary-incorporated-face)
((= mark gnus-unread-mark)
. gnus-summary-normal-unread-face)
((and (> score default) (memq mark (list gnus-downloadable-mark
The function is called with one parameter, the article header vector,
which it may alter in any way.")
+(defvar gnus-decode-encoded-word-function
+ (mime-find-field-decoder 'From 'nov)
+ "Variable that says which function should be used to decode a string with encoded words.")
+
(defcustom gnus-extra-headers nil
"*Extra headers to parse."
:group 'gnus-summary
'(("^hk\\>\\|^tw\\>\\|\\<big5\\>" cn-big5)
("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
("^fj\\>\\|^japan\\>" iso-2022-jp-2)
+ ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit)
("^relcom\\>" koi8-r)
+ ("^fido7\\>" koi8-r)
("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
("^israel\\>" iso-8859-1)
("^han\\>" euc-kr)
+ ("^alt.chinese.text.big5\\>" chinese-big5)
+ ("^soc.culture.vietnamese\\>" vietnamese-viqr)
("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
(".*" iso-8859-1))
"Alist of regexps (to match group names) and default charsets to be used when reading."
(symbol :tag "Charset")))
:group 'gnus-charset)
-(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit)
+(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
"List of charsets that should be ignored.
When these charsets are used in the \"charset\" parameter, the
default charset will be used instead."
:type '(repeat symbol)
:group 'gnus-charset)
+(defcustom gnus-group-ignored-charsets-alist
+ '(("alt\\.chinese\\.text" iso-8859-1))
+ "Alist of regexps (to match group names) and charsets that should be ignored.
+When these charsets are used in the \"charset\" parameter, the
+default charset will be used instead."
+ :type '(repeat (cons (regexp :tag "Group")
+ (repeat symbol)))
+ :group 'gnus-charset)
+
(defcustom gnus-group-highlight-words-alist nil
"Alist of group regexps and highlight regexps.
This variable uses the same syntax as `gnus-emphasis-alist'."
(repeat (list (regexp :tag "Highlight regexp")
(number :tag "Group for entire word" 0)
(number :tag "Group for displayed part" 0)
- (symbol :tag "Face"
+ (symbol :tag "Face"
gnus-emphasis-highlight-words)))))
:group 'gnus-summary-visual)
+(defcustom gnus-use-wheel nil
+ "Use Intelli-mouse on summary movement"
+ :type 'boolean
+ :group 'gnus-summary-maneuvering)
+
+(defcustom gnus-wheel-scroll-amount '(5 . 1)
+ "Amount to scroll messages by spinning the mouse wheel.
+This is actually a cons cell, where the first item is the amount to scroll
+on a normal wheel event, and the second is the amount to scroll when the
+wheel is moved with the shift key depressed."
+ :type '(cons (integer :tag "Shift") integer)
+ :group 'gnus-summary-maneuvering)
+
+(defcustom gnus-wheel-edge-resistance 2
+ "How hard it should be to change the current article
+by moving the mouse over the edge of the article window."
+ :type 'integer
+ :group 'gnus-summary-maneuvering)
+
+(defcustom gnus-summary-show-article-charset-alist
+ nil
+ "Alist of number and charset.
+The article will be shown with the charset corresponding to the
+numbered argument.
+For example: ((1 . cn-gb-2312) (2 . big5))."
+ :type '(repeat (cons (number :tag "Argument" 1)
+ (symbol :tag "Charset")))
+ :group 'gnus-charset)
+
+(defcustom gnus-preserve-marks t
+ "Whether marks are preserved when moving, copying and respooling messages."
+ :type 'boolean
+ :group 'gnus-summary-marks)
+
+(defcustom gnus-alter-articles-to-read-function nil
+ "Function to be called to alter the list of articles to be selected."
+ :type 'function
+ :group 'gnus-summary)
+
+(defcustom gnus-orphan-score nil
+ "*All orphans get this score added. Set in the score file."
+ :group 'gnus-score-default
+ :type '(choice (const nil)
+ integer))
+
+(defcustom gnus-summary-save-parts-default-mime "image/.*"
+ "*A regexp to match MIME parts when saving multiple parts of a message
+with gnus-summary-save-parts (X m). This regexp will be used by default
+when prompting the user for which type of files to save."
+ :group 'gnus-summary
+ :type 'regexp)
+
+
;;; Internal variables
+(defvar gnus-article-mime-handles nil)
+(defvar gnus-article-decoded-p nil)
(defvar gnus-scores-exclude-files nil)
(defvar gnus-page-broken nil)
(defvar gnus-inhibit-mime-unbuttonizing nil)
(defvar gnus-thread-indent-array nil)
(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
+(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
+ "Function called to sort the articles within a thread after it has been gathered together.")
+
+(defvar gnus-summary-save-parts-type-history nil)
+(defvar gnus-summary-save-parts-last-directory nil)
;; Avoid highlighting in kill files.
(defvar gnus-summary-inhibit-highlight nil)
(?s gnus-tmp-subject-or-nil ?s)
(?n gnus-tmp-name ?s)
(?A (std11-address-string
- (car (mime-read-field 'From gnus-tmp-header))) ?s)
+ (car (mime-entity-read-field gnus-tmp-header 'From))) ?s)
(?a (or (std11-full-name-string
- (car (mime-read-field 'From gnus-tmp-header)))
+ (car (mime-entity-read-field gnus-tmp-header 'From)))
gnus-tmp-from) ?s)
(?F gnus-tmp-from ?s)
(?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
?c)
(?u gnus-tmp-user-defined ?s)
(?P (gnus-pick-line-number) ?d))
- "An alist of format specifications that can appear in summary lines,
-and what variables they correspond with, along with the type of the
-variable (string, integer, character, etc).")
+ "An alist of format specifications that can appear in summary lines.
+These are paired with what variables they correspond with, along with
+the type of the variable (string, integer, character, etc).")
(defvar gnus-summary-dummy-line-format-alist
`((?S gnus-tmp-subject ?s)
(defvar gnus-last-search-regexp nil
"Default regexp for article search command.")
+(defvar gnus-summary-search-article-matched-data nil
+ "Last matched data of article search command. It is the local variable
+in `gnus-article-buffer' which consists of the list of start position,
+end position and text.")
+
(defvar gnus-last-shell-command nil
"Default shell command on article.")
(defvar gnus-newsgroup-scored nil
"List of scored articles in the current newsgroup.")
+(defvar gnus-newsgroup-incorporated nil
+ "List of incorporated articles in the current newsgroup.")
+
(defvar gnus-newsgroup-headers nil
"List of article headers in the current newsgroup.")
(defvar gnus-last-article nil)
(defvar gnus-newsgroup-history nil)
(defvar gnus-newsgroup-charset nil)
-(defvar gnus-newsgroup-emphasis-alist nil)
+(defvar gnus-newsgroup-ephemeral-charset nil)
+(defvar gnus-newsgroup-ephemeral-ignored-charsets nil)
(defconst gnus-summary-local-variables
'(gnus-newsgroup-name
gnus-score-alist gnus-current-score-file
(gnus-summary-expunge-below . global)
(gnus-summary-mark-below . global)
+ (gnus-orphan-score . global)
gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
gnus-newsgroup-sparse gnus-newsgroup-process-stack
gnus-cache-removable-articles gnus-newsgroup-cached
gnus-newsgroup-data gnus-newsgroup-data-reverse
gnus-newsgroup-limit gnus-newsgroup-limits
- gnus-newsgroup-charset gnus-newsgroup-emphasis-alist)
+ gnus-newsgroup-charset
+ gnus-newsgroup-incorporated)
"Variables that are buffer-local to the summary buffers.")
;; Byte-compiler warning.
;; Subject simplification.
(defun gnus-simplify-whitespace (str)
- "Remove excessive whitespace."
+ "Remove excessive whitespace from STR."
(let ((mystr str))
;; Multiple spaces.
(while (string-match "[ \t][ \t]+" mystr)
(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
- (replace-match (or newtext ""))))
+ (replace-match (or newtext ""))))
(defun gnus-simplify-buffer-fuzzy ()
"Simplify string in the buffer fuzzily.
It is assumed to be a single-line subject.
Whitespace is generally cleaned up, and miscellaneous leading/trailing
matter is removed. Additional things can be deleted by setting
-gnus-simplify-subject-fuzzy-regexp."
+`gnus-simplify-subject-fuzzy-regexp'."
(let ((case-fold-search t)
(modified-tick))
(gnus-simplify-buffer-fuzzy-step "\t" " ")
"\M-\C-h" gnus-summary-hide-thread
"\M-\C-f" gnus-summary-next-thread
"\M-\C-b" gnus-summary-prev-thread
+ [(meta down)] gnus-summary-next-thread
+ [(meta up)] gnus-summary-prev-thread
"\M-\C-u" gnus-summary-up-thread
"\M-\C-d" gnus-summary-down-thread
"&" gnus-summary-execute-command
"\C-d" gnus-summary-enter-digest-group
"\M-\C-d" gnus-summary-read-document
"\M-\C-e" gnus-summary-edit-parameters
- "\M-\C-g" gnus-summary-customize-parameters
+ "\M-\C-a" gnus-summary-customize-parameters
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"T" gnus-summary-limit-include-thread
"d" gnus-summary-limit-exclude-dormant
"t" gnus-summary-limit-to-age
- "x" gnus-summary-limit-to-extra
+ "x" gnus-summary-limit-to-extra
"E" gnus-summary-limit-include-expunged
"c" gnus-summary-limit-exclude-childless-dormant
"C" gnus-summary-limit-mark-excluded-as-read)
"c" gnus-summary-catchup-and-exit
"C" gnus-summary-catchup-all-and-exit
"E" gnus-summary-exit-no-update
+ "J" gnus-summary-jump-to-other-group
"Q" gnus-summary-exit
"Z" gnus-summary-exit
"n" gnus-summary-catchup-and-goto-next-group
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
"P" gnus-summary-print-article
- "t" gnus-article-babel)
+ "t" gnus-article-babel
+ "d" gnus-summary-decrypt-article
+ "v" gnus-summary-verify-article)
(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
"b" gnus-article-add-buttons
"Q" gnus-article-fill-long-lines
"C" gnus-article-capitalize-sentences
"c" gnus-article-remove-cr
+ "Z" gnus-article-decode-HZ
"f" gnus-article-display-x-face
"l" gnus-summary-stop-page-breaking
"r" gnus-summary-caesar-message
"t" gnus-article-toggle-headers
"v" gnus-summary-verbose-headers
"m" gnus-summary-toggle-mime
- "h" gnus-article-treat-html
"H" gnus-article-strip-headers-in-body
- "d" gnus-article-treat-dumbquotes)
+ "d" gnus-article-treat-dumbquotes
+ "s" gnus-smiley-display)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"a" gnus-article-hide
"s" gnus-article-hide-signature
"c" gnus-article-hide-citation
"C" gnus-article-hide-citation-in-followups
+ "l" gnus-article-hide-list-identifiers
"p" gnus-article-hide-pgp
"B" gnus-article-strip-banner
"P" gnus-article-hide-pem
"\M-\C-e" gnus-summary-expire-articles-now
"\177" gnus-summary-delete-article
[delete] gnus-summary-delete-article
+ [backspace] gnus-summary-delete-article
"m" gnus-summary-move-article
"r" gnus-summary-respool-article
"w" gnus-summary-edit-article
"c" gnus-article-copy-part
"e" gnus-article-externalize-part
"i" gnus-article-inline-part
- "|" gnus-article-pipe-part)
- )
+ "|" gnus-article-pipe-part))
(defun gnus-summary-make-menu-bar ()
(gnus-turn-off-edit-menu 'summary)
["Headers" gnus-article-toggle-headers t]
["Signature" gnus-article-hide-signature t]
["Citation" gnus-article-hide-citation t]
+ ["List identifiers" gnus-article-hide-list-identifiers t]
["PGP" gnus-article-hide-pgp t]
["Banner" gnus-article-strip-banner t]
["Boring headers" gnus-article-hide-boring-headers t])
["Capitalize sentences" gnus-article-capitalize-sentences t]
["CR" gnus-article-remove-cr t]
["Show X-Face" gnus-article-display-x-face t]
- ["UnHTMLize" gnus-article-treat-html t]
["Rot 13" gnus-summary-caesar-message t]
["Unix pipe" gnus-summary-pipe-message t]
["Add buttons" gnus-article-add-buttons t]
["Stop page breaking" gnus-summary-stop-page-breaking t]
["Toggle MIME" gnus-summary-toggle-mime t]
["Verbose header" gnus-summary-verbose-headers t]
- ["Toggle header" gnus-summary-toggle-header t])
+ ["Toggle header" gnus-summary-toggle-header t]
+ ["Toggle smileys" gnus-smiley-display t]
+ ["HZ" gnus-article-decode-HZ t])
("Output"
["Save in default format" gnus-summary-save-article t]
["Save in file" gnus-summary-save-article-file t]
["Mark thread as read" gnus-summary-kill-thread t]
["Lower thread score" gnus-summary-lower-thread t]
["Raise thread score" gnus-summary-raise-thread t]
- ["Rethread current" gnus-summary-rethread-current t]
- ))
+ ["Rethread current" gnus-summary-rethread-current t]))
(easy-menu-define
gnus-summary-post-menu gnus-summary-mode-map ""
["Wide reply and yank" gnus-summary-wide-reply-with-original t]
["Mail forward" gnus-summary-mail-forward t]
["Post forward" gnus-summary-post-forward t]
- ["Digest and mail" gnus-summary-mail-digest t]
- ["Digest and post" gnus-summary-post-digest t]
+ ["Digest and mail" gnus-uu-digest-mail-forward t]
+ ["Digest and post" gnus-uu-digest-post-forward t]
["Resend message" gnus-summary-resend-message t]
["Send bounced mail" gnus-summary-resend-bounced-mail t]
["Send a mail" gnus-summary-mail-other-window t]
(list 'gnus-summary-header
(nth 1 header)))
(list 'quote (nth 1 (car ts)))
- (list 'gnus-score-default nil)
+ (list 'gnus-score-delta-default
+ nil)
(nth 1 (car ps))
t)
t)
(gnus-summary-set-display-table)
(gnus-set-default-directory)
(setq gnus-newsgroup-name group)
+ (unless (gnus-news-group-p group)
+ (setq gnus-newsgroup-incorporated
+ (nnmail-new-mail-numbers (gnus-group-real-name group))))
(make-local-variable 'gnus-summary-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
(make-local-variable 'gnus-summary-dummy-line-format)
`(nth 3 ,data))
(defmacro gnus-data-set-header (data header)
- `(setf (nth 3 ,data) ,header))
+ `(setcar (nthcdr 3 ,data) ,header))
(defmacro gnus-data-level (data)
`(nth 4 ,data))
(defun gnus-restore-hidden-threads-configuration (config)
"Restore hidden threads configuration from CONFIG."
- (let (point buffer-read-only)
- (while (setq point (pop config))
- (when (and (< point (point-max))
- (goto-char point)
- (eq (char-after) ?\n))
- (subst-char-in-region point (1+ point) ?\n ?\r)))))
+ (save-excursion
+ (let (point buffer-read-only)
+ (while (setq point (pop config))
+ (when (and (< point (point-max))
+ (goto-char point)
+ (eq (char-after) ?\n))
+ (subst-char-in-region point (1+ point) ?\n ?\r))))))
;; Various summary mode internalish functions.
(gnus-summary-next-page nil t))
(defun gnus-summary-set-display-table ()
- ;; Change the display table. Odd characters have a tendency to mess
- ;; up nicely formatted displays - we make all possible glyphs
- ;; display only a single character.
+ "Change the display table.
+Odd characters have a tendency to mess
+up nicely formatted displays - we make all possible glyphs
+display only a single character."
;; We start from the standard display table, if any.
(let ((table (or (copy-sequence standard-display-table)
t)))
(defun gnus-set-global-variables ()
- ;; Set the global equivalents of the summary buffer-local variables
- ;; to the latest values they had. These reflect the summary buffer
- ;; that was in action when the last article was fetched.
+ "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)
(setq gnus-summary-buffer (current-buffer))
(let ((name gnus-newsgroup-name)
(gac gnus-article-current)
(reffed gnus-reffed-article-number)
(score-file gnus-current-score-file)
- (default-charset gnus-newsgroup-charset)
- (emphasis-alist gnus-newsgroup-emphasis-alist))
+ (default-charset gnus-newsgroup-charset))
(save-excursion
(set-buffer gnus-group-buffer)
(setq gnus-newsgroup-name name
gnus-original-article-buffer original
gnus-reffed-article-number reffed
gnus-current-score-file score-file
- gnus-newsgroup-charset default-charset
- gnus-newsgroup-emphasis-alist emphasis-alist)
+ gnus-newsgroup-charset default-charset)
;; The article buffer also has local variables.
(when (gnus-buffer-live-p gnus-article-buffer)
(set-buffer gnus-article-buffer)
(let ((gnus-summary-line-format-spec spec)
(gnus-newsgroup-downloadable '((0 . t))))
(gnus-summary-insert-line
- (make-full-mail-header 0 "" "" "" "" "" 0 0 "" nil)
+ (make-full-mail-header 0 "" "nobody" "" "" "" 0 0 "" nil)
0 nil 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
(defun gnus-summary-from-or-to-or-newsgroups (header)
(let ((to (cdr (assq 'To (mail-header-extra header))))
(newsgroups (cdr (assq 'Newsgroups (mail-header-extra header))))
- (mail-parse-charset gnus-newsgroup-charset))
+ (default-mime-charset (with-current-buffer gnus-summary-buffer
+ default-mime-charset)))
(cond
((and to
gnus-ignored-from-addresses
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark)))
(gnus-tmp-replied
(cond
((string-match "<[^>]+> *$" gnus-tmp-from)
(let ((beg (match-beginning 0)))
- (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
- (substring gnus-tmp-from (1+ (match-beginning 0))
- (1- (match-end 0))))
+ (or (and (string-match "^\".+\"" gnus-tmp-from)
+ (substring gnus-tmp-from 1 (1- (match-end 0))))
(substring gnus-tmp-from 0 beg))))
((string-match "(.+)" gnus-tmp-from)
(substring gnus-tmp-from
(forward-line 1))))
(defun gnus-summary-update-line (&optional dont-update)
- ;; Update summary line after change.
+ "Update summary line after change."
(when (and gnus-summary-default-score
(not gnus-summary-inhibit-highlight))
(let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
(if (or (null gnus-summary-default-score)
(<= (abs (- score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
'score))
(setq group nil)))
result))
+(defun gnus-summary-jump-to-other-group (group &optional show-all)
+ "Directly jump to the other GROUP from summary buffer.
+If SHOW-ALL is non-nil, already read articles are also listed."
+ (interactive
+ (if (eq gnus-summary-buffer (current-buffer))
+ (list (completing-read
+ "Group: " gnus-active-hashtb nil t
+ (when (and gnus-newsgroup-name
+ (string-match "[.:][^.:]+$" gnus-newsgroup-name))
+ (substring gnus-newsgroup-name 0 (1+ (match-beginning 0))))
+ 'gnus-group-history)
+ current-prefix-arg)
+ (error "%s must be invoked from a gnus summary buffer." this-command)))
+ (unless (or (zerop (length group))
+ (and gnus-newsgroup-name
+ (string-equal gnus-newsgroup-name group)))
+ (gnus-summary-exit)
+ (gnus-summary-read-group group show-all
+ gnus-dont-select-after-jump-to-other-group)))
+
(defun gnus-summary-read-group-1 (group show-all no-article
kill-buffer no-display
&optional select-articles)
(gnus-summary-set-local-parameters gnus-newsgroup-name)
(gnus-update-format-specifications
nil 'summary 'summary-mode 'summary-dummy)
+ (gnus-update-summary-mark-positions)
;; Do score processing.
(when gnus-use-scoring
(gnus-possibly-score-headers))
(let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
+ ;; When untreaded, all articles are always shown.
(setq gnus-newsgroup-limit
(mapcar
(lambda (header) (mail-header-number header))
"Query where the respool algorithm would put this article."
(interactive)
(gnus-summary-select-article)
- (message (gnus-general-simplify-subject (gnus-summary-article-subject))))
+ (message "%s"
+ (gnus-general-simplify-subject (gnus-summary-article-subject))))
(defun gnus-gather-threads-by-subject (threads)
"Gather threads by looking at Subject headers."
result))
(defun gnus-sort-gathered-threads (threads)
- "Sort subtreads inside each gathered thread by article number."
+ "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
(let ((result threads))
(while threads
(when (stringp (caar threads))
(setcdr (car threads)
- (sort (cdar threads) 'gnus-thread-sort-by-number)))
+ (sort (cdar threads) gnus-sort-gathered-threads-function)))
(setq threads (cdr threads)))
result))
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
+ (mail-parse-charset gnus-newsgroup-charset)
(gnus-summary-ignore-duplicates t)
header references generation relations
subject child end new-child date)
(mapcar
(lambda (relation)
(when (gnus-dependencies-add-header
- (make-full-mail-header
+ (make-full-mail-header-from-decoded-header
gnus-reffed-article-number
(nth 3 relation) "" (or (nth 4 relation) "")
(nth 1 relation)
;; fetch the headers for the articles that aren't there. This will
;; build complete threads - if the roots haven't been expired by the
;; server, that is.
- (let (id heads)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ id heads)
(mapatoms
(lambda (refs)
(when (not (car (symbol-value refs)))
header)
;; overview: [num subject from date id refs chars lines misc]
- (unless (eobp)
- (forward-char))
-
- (setq header
- (make-full-mail-header
- number ; number
- (nnheader-nov-field) ; subject
- (nnheader-nov-field) ; from
- (nnheader-nov-field) ; date
- (nnheader-nov-read-message-id) ; id
- (nnheader-nov-field) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
- (unless (eobp)
- (nnheader-nov-field)) ; misc
- (nnheader-nov-parse-extra))) ; extra
+ (unwind-protect
+ (progn
+ (narrow-to-region (point) eol)
+ (unless (eobp)
+ (forward-char))
+
+ (setq header
+ (make-full-mail-header
+ number ; number
+ (nnheader-nov-field) ; subject
+ (nnheader-nov-field) ; from
+ (nnheader-nov-field) ; date
+ (nnheader-nov-read-message-id) ; id
+ (nnheader-nov-field) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
+ (unless (eobp)
+ (if (looking-at "Xref: ")
+ (goto-char (match-end 0)))
+ (nnheader-nov-field)) ; Xref
+ (nnheader-nov-parse-extra)))) ; extra
+
+ (widen))
(when gnus-alter-header-function
(funcall gnus-alter-header-function header))
(gnus-dependencies-add-header header dependencies force-new)))
(defun gnus-build-get-header (id)
- ;; Look through the buffer of NOV lines and find the header to
- ;; ID. Enter this line into the dependencies hash table, and return
- ;; the id of the parent article (if any).
+ "Look through the buffer of NOV lines and find the header to ID.
+Enter this line into the dependencies hash table, and return
+the id of the parent article (if any)."
(let ((deps gnus-newsgroup-dependencies)
found header)
(prog1
(defun gnus-build-all-threads ()
"Read all the headers."
(let ((gnus-summary-ignore-duplicates t)
+ (mail-parse-charset gnus-newsgroup-charset)
(dependencies gnus-newsgroup-dependencies)
header article)
(save-excursion
(while (not (eobp))
(ignore-errors
(setq article (read (current-buffer))
- header (gnus-nov-parse-line
- article dependencies)))
+ header (gnus-nov-parse-line article dependencies)))
(when header
(save-excursion
(set-buffer gnus-summary-buffer)
(memq article gnus-newsgroup-expirable)
;; Only insert the Subject string when it's different
;; from the previous Subject string.
- (if (gnus-subject-equal
- (condition-case ()
- (mail-header-subject
- (gnus-data-header
- (cadr
- (gnus-data-find-list
- article
- (gnus-data-list t)))))
- ;; Error on the side of excessive subjects.
- (error ""))
- (mail-header-subject header))
+ (if (and
+ gnus-show-threads
+ (gnus-subject-equal
+ (condition-case ()
+ (mail-header-subject
+ (gnus-data-header
+ (cadr
+ (gnus-data-find-list
+ article
+ (gnus-data-list t)))))
+ ;; Error on the side of excessive subjects.
+ (error ""))
+ (mail-header-subject header)))
""
(mail-header-subject header))
nil (cdr (assq article gnus-newsgroup-scored))
(while thread
(gnus-remove-thread-1 (car thread))
(setq thread (cdr thread))))
- (gnus-summary-show-all-threads)
(gnus-remove-thread-1 thread))))))))
(defun gnus-remove-thread-1 (thread)
(gnus-remove-thread-1 (pop thread)))
(when (setq d (gnus-data-find number))
(goto-char (gnus-data-pos d))
+ (gnus-summary-show-thread)
(gnus-data-remove
number
(- (gnus-point-at-bol)
(1+ (gnus-point-at-eol))
(gnus-delete-line)))))))
+(defun gnus-sort-threads-1 (threads func)
+ (sort (mapcar (lambda (thread)
+ (cons (car thread)
+ (and (cdr thread)
+ (gnus-sort-threads-1 (cdr thread) func))))
+ threads) func))
+
(defun gnus-sort-threads (threads)
"Sort THREADS."
(if (not gnus-thread-sort-functions)
threads
(gnus-message 8 "Sorting threads...")
(prog1
- (sort threads (gnus-make-sort-function gnus-thread-sort-functions))
+ (gnus-sort-threads-1
+ threads
+ (gnus-make-sort-function gnus-thread-sort-functions))
(gnus-message 8 "Sorting threads...done"))))
(defun gnus-sort-articles (articles)
;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
(defmacro gnus-thread-header (thread)
- ;; Return header of first article in THREAD.
- ;; Note that THREAD must never, ever be anything else than a variable -
- ;; using some other form will lead to serious barfage.
+ "Return header of first article in THREAD.
+Note that THREAD must never, ever be anything else than a variable -
+using some other form will lead to serious barfage."
(or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
;; (8% speedup to gnus-summary-prepare, just for fun :-)
- (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
+ (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
(vector thread) 2))
(defsubst gnus-article-sort-by-number (h1 h2)
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
(string-lessp
- (let ((addr (car (mime-read-field 'From h1))))
+ (let ((addr (car (mime-entity-read-field h1 'From))))
(or (std11-full-name-string addr)
(std11-address-string addr)
""))
- (let ((addr (car (mime-read-field 'From h2))))
+ (let ((addr (car (mime-entity-read-field h2 'From))))
(or (std11-full-name-string addr)
(std11-address-string addr)
""))
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
gnus-tmp-replied
(cond
((string-match "<[^>]+> *$" gnus-tmp-from)
(setq beg-match (match-beginning 0))
- (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
- (substring gnus-tmp-from (1+ (match-beginning 0))
- (1- (match-end 0))))
+ (or (and (string-match "^\".+\"" gnus-tmp-from)
+ (substring gnus-tmp-from 1 (1- (match-end 0))))
(substring gnus-tmp-from 0 beg-match)))
((string-match "(.+)" gnus-tmp-from)
(substring gnus-tmp-from
(cdr (assq number gnus-newsgroup-scored))
(memq number gnus-newsgroup-processable))))))
+(defun gnus-summary-remove-list-identifiers ()
+ "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
+ (let ((regexp (if (stringp gnus-list-identifiers)
+ gnus-list-identifiers
+ (mapconcat 'identity gnus-list-identifiers " *\\|"))))
+ (dolist (header gnus-newsgroup-headers)
+ (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
+ " *\\)\\)+\\(Re: +\\)?\\)")
+ (mail-header-subject header))
+ (mail-header-set-subject
+ header (concat (substring (mail-header-subject header)
+ 0 (match-beginning 1))
+ (or
+ (match-string 3 (mail-header-subject header))
+ (match-string 5 (mail-header-subject header)))
+ (substring (mail-header-subject header)
+ (match-end 1))))))))
+
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
If READ-ALL is non-nil, all articles in the group are selected.
(setq gnus-newsgroup-unselected nil)
(setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
(gnus-summary-setup-default-charset)
- (gnus-summary-setup-highlight-words)
;; Adjust and set lists of article marks.
(when info
;; Let the Gnus agent mark articles as read.
(when gnus-agent
(gnus-agent-get-undownloaded-list))
+ ;; Remove list identifiers from subject
+ (when gnus-list-identifiers
+ (gnus-summary-remove-list-identifiers))
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
(gnus-group-auto-expirable-p group))
(or gnus-newsgroup-headers t)))))
(defun gnus-articles-to-read (group &optional read-all)
- ;; Find out what articles the user wants to read.
+ "Find out what articles the user wants to read."
(let* ((articles
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(zerop (length gnus-newsgroup-unreads)))
(eq (gnus-group-find-parameter group 'display)
'all))
- (gnus-uncompress-range (gnus-active group))
+ (or
+ (gnus-uncompress-range (gnus-active group))
+ (gnus-cache-articles-in-group group))
(sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
(copy-sequence gnus-newsgroup-unreads))
'<)))
((and (or (<= scored marked) (= scored number))
(natnump gnus-large-newsgroup)
(> number gnus-large-newsgroup))
- (let* ((minibuffer-setup-hook (append
- minibuffer-setup-hook
- '(beginning-of-line)))
- (input (read-string
+ (let* ((cursor-in-echo-area nil)
+ (input (read-from-minibuffer
(format
"How many articles from %s (max %d): "
(gnus-limit-string gnus-newsgroup-name 35)
number)
- (number-to-string gnus-large-newsgroup))))
+ (cons (number-to-string gnus-large-newsgroup)
+ 0))))
(if (string-match "^[ \t]*$" input)
number
input)))
(if (string-match "^[ \t]*$" input)
number input)))
(t number))
- (quit nil))))))
+ (quit
+ (message "Quit getting the articles to read")
+ nil))))))
(setq select (if (stringp select) (string-to-number select) select))
(if (or (null select) (zerop select))
select
(gnus-sorted-intersection
gnus-newsgroup-unreads
(gnus-sorted-complement gnus-newsgroup-unreads articles)))
+ (when gnus-alter-articles-to-read-function
+ (setq gnus-newsgroup-unreads
+ (sort
+ (funcall gnus-alter-articles-to-read-function
+ gnus-newsgroup-name gnus-newsgroup-unreads)
+ '<)))
articles)))
(defun gnus-killed-articles (killed articles)
;; Add all marks lists to the list of marks lists.
(while (setq type (pop types))
(setq list (symbol-value
- (setq symbol
- (intern (format "gnus-newsgroup-%s"
- (car type))))))
+ (setq symbol
+ (intern (format "gnus-newsgroup-%s"
+ (car type))))))
(when list
;; Get rid of the entries of the articles that have the
(setq arts (cdr arts)))
(setq list (cdr all)))))
- (or (memq (cdr type) uncompressed)
- (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
-
- (when (gnus-check-backend-function 'request-set-mark
- gnus-newsgroup-name)
- ;; uncompressed:s are not proper flags (they are cons cells)
- ;; cache is a internal gnus flag
- (unless (memq (cdr type) (cons 'cache uncompressed))
- (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
- (del (gnus-remove-from-range (gnus-copy-sequence old) list))
- (add (gnus-remove-from-range (gnus-copy-sequence list) old)))
- (if add
- (push (list add 'add (list (cdr type))) delta-marks))
- (if del
- (push (list del 'del (list (cdr type))) delta-marks)))))
-
+ (unless (memq (cdr type) uncompressed)
+ (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
+
+ (when (gnus-check-backend-function
+ 'request-set-mark gnus-newsgroup-name)
+ ;; propagate flags to server, with the following exceptions:
+ ;; uncompressed:s are not proper flags (they are cons cells)
+ ;; cache is a internal gnus flag
+ ;; download are local to one gnus installation (well)
+ ;; unsend are for nndraft groups only
+ ;; xxx: generality of this? this suits nnimap anyway
+ (unless (memq (cdr type) (append '(cache download unsend)
+ uncompressed))
+ (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
+ (del (gnus-remove-from-range (gnus-copy-sequence old) list))
+ (add (gnus-remove-from-range
+ (gnus-copy-sequence list) old)))
+ (when add
+ (push (list add 'add (list (cdr type))) delta-marks))
+ (when del
+ (push (list del 'del (list (cdr type))) delta-marks)))))
+
(when list
- (push (cons (cdr type) list) newmarked)))
+ (push (cons (cdr type) list) newmarked)))
(when delta-marks
(unless (gnus-check-group gnus-newsgroup-name)
(error "Can't open server for %s" gnus-newsgroup-name))
(gnus-request-set-mark gnus-newsgroup-name delta-marks))
-
+
;; Enter these new marks into the info of the group.
(if (nthcdr 3 info)
(setcar (nthcdr 3 info) newmarked)
(setcdr (nthcdr i info) nil)))))))
(defun gnus-set-mode-line (where)
- "This function sets the mode line of the article or summary buffers.
+ "Set the mode line of the article or summary buffers.
If WHERE is `summary', the summary mode line format will be used."
;; Is this mode line one we keep updated?
(when (and (memq where gnus-updated-mode-lines)
(let* ((mformat (symbol-value
(intern
(format "gnus-%s-mode-line-format-spec" where))))
- (gnus-tmp-group-name gnus-newsgroup-name)
+ (gnus-tmp-group-name (gnus-group-name-decode
+ gnus-newsgroup-name
+ (gnus-group-name-charset
+ nil
+ gnus-newsgroup-name)))
(gnus-tmp-article-number (or gnus-current-article 0))
(gnus-tmp-unread gnus-newsgroup-unreads)
(gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-dependencies)))
headers id end ref
- (mail-parse-charset gnus-newsgroup-charset))
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (condition-case nil
+ (set-buffer gnus-summary-buffer)
+ (error))
+ gnus-newsgroup-ignored-charsets)))
(save-excursion
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (buffer-substring (match-end 0) (std11-field-end))
+ (nnheader-header-value)
"(none)"))
;; From.
(progn
(goto-char p)
- (if (search-forward "\nfrom: " nil t)
- (buffer-substring (match-end 0) (std11-field-end))
+ (if (or (search-forward "\nfrom: " nil t)
+ (search-forward "\nfrom:" nil t))
+ (nnheader-header-value)
"(nobody)"))
;; Date.
(progn
(goto-char p)
(if (search-forward "\ndate: " nil t)
- (buffer-substring (match-end 0) (std11-field-end))
+ (nnheader-header-value)
""))
;; Message-ID.
(progn
(progn
(setq end (point))
(prog1
- (buffer-substring (match-end 0) (std11-field-end))
+ (nnheader-header-value)
(setq ref
(buffer-substring
(progn
;; were no references and the in-reply-to header looks
;; promising.
(if (and (search-forward "\nin-reply-to: " nil t)
- (setq in-reply-to
- (buffer-substring (match-end 0)
- (std11-field-end)))
+ (setq in-reply-to (nnheader-header-value))
(string-match "<[^>]+>" in-reply-to))
(let (ref2)
(setq ref (substring in-reply-to (match-beginning 0)
(progn
(goto-char p)
(and (search-forward "\nxref: " nil t)
- (buffer-substring (match-end 0) (std11-field-end))))
+ (nnheader-header-value)))
;; Extra.
(when gnus-extra-headers
(let ((extra gnus-extra-headers)
(goto-char p)
(when (search-forward
(concat "\n" (symbol-name (car extra)) ": ") nil t)
- (push (cons (car extra)
- (buffer-substring (match-end 0)
- (std11-field-end)))
- out))
+ (push (cons (car extra) (nnheader-header-value)) out))
(pop extra))
out))))
(goto-char p)
(if (and (search-forward "\ncontent-type: " nil t)
- (setq ctype
- (buffer-substring (match-end 0) (std11-field-end))))
+ (setq ctype (nnheader-header-value)))
(mime-entity-set-content-type-internal
header (mime-parse-Content-Type ctype)))
(when (equal id ref)
(defun gnus-get-newsgroup-headers-xover (sequence &optional
force-new dependencies
group also-fetch-heads)
- "Parse the news overview data in the server buffer, and return a
-list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
+ "Parse the news overview data in the server buffer.
+Return a list of headers that match SEQUENCE (see
+`nntp-retrieve-headers')."
;; Get the Xref when the users reads the articles since most/some
;; NNTP servers do not include Xrefs when using XOVER.
(setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
(let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
(cur nntp-server-buffer)
(dependencies (or dependencies gnus-newsgroup-dependencies))
number headers header)
(save-restriction
(nnheader-narrow-to-headers)
(goto-char (point-min))
- (when (or (and (eq (downcase (char-after)) ?x)
+ (when (or (and (not (eobp))
+ (eq (downcase (char-after)) ?x)
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
+ (interactive)
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
(t (if (numberp gnus-auto-center-summary)
;; whichever is the least.
(set-window-start
window (min bottom (save-excursion
- (forward-line (- top)) (point)))))
+ (forward-line (- top)) (point)))
+ t))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(not (eq gnus-auto-center-summary 'vertical)))
;; If the range of read articles is a single range, then the
;; first unread article is the article after the last read
;; article. Sounds logical, doesn't it?
- (if (not (listp (cdr read)))
+ (if (and (not (listp (cdr read)))
+ (or (< (car read) (car active))
+ (progn (setq read (list read))
+ nil)))
(setq first (max (car active) (1+ (cdr read))))
;; `read' is a list of ranges.
(when (/= (setq nlast (or (and (numberp (car read)) (car read))
(key-binding
(read-key-sequence
(substitute-command-keys
- "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
- ))))
+ "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"))))
'undefined)
(gnus-error 1 "Undefined key")
(save-excursion
(gnus-summary-jump-to-group group)
(when rescan
(save-excursion
- (gnus-group-get-new-news-this-group 1)))
+ (save-window-excursion
+ ;; Don't show group contents.
+ (set-window-start (selected-window) (point-max))
+ (gnus-group-get-new-news-this-group 1))))
(gnus-group-read-group all t)
(gnus-summary-goto-subject current-subject nil t)))
(defun gnus-summary-exit (&optional temporary)
"Exit reading current newsgroup, and then return to group selection mode.
-gnus-exit-group-hook is called with no arguments if that value is non-nil."
+`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
(interactive)
(gnus-set-global-variables)
(gnus-kill-save-kill-buffer)
(gnus-dup-enter-articles))
(when gnus-use-trees
(gnus-tree-close group))
+ (when gnus-use-cache
+ (gnus-cache-write-active))
;; Remove entries for this group.
(nnmail-purge-split-history (gnus-group-real-name group))
;; Make all changes in this group permanent.
(if (not quit-config)
(progn
(goto-char group-point)
- (gnus-configure-windows 'group 'force))
+ (gnus-configure-windows 'group 'force)
+ (unless (pos-visible-in-window-p)
+ (forward-line (/ (static-if (featurep 'xemacs)
+ (window-displayed-height)
+ (1- (window-height)))
+ -2))
+ (set-window-start (selected-window) (point))
+ (goto-char group-point)))
(gnus-handle-ephemeral-exit quit-config))
;; Clear the current group name.
(unless quit-config
(gnus-async-halt-prefetch)
(mapcar 'funcall
(delq 'gnus-summary-expire-articles
- (copy-list gnus-summary-prepare-exit-hook)))
+ (copy-sequence gnus-summary-prepare-exit-hook)))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(rename-buffer
(concat (substring name 0 (match-beginning 0)) "Dead "
(substring name (match-beginning 0)))
- t))))
+ t)
+ (bury-buffer))))
(defun gnus-kill-or-deaden-summary (buffer)
"Kill or deaden the summary BUFFER."
(if backward
(gnus-summary-find-prev unread)
(gnus-summary-find-next unread)))
- (gnus-summary-show-thread)
- (setq n (1- n)))
+ (unless (zerop (setq n (1- n)))
+ (gnus-summary-show-thread)))
(when (/= 0 n)
(gnus-message 7 "No more%s articles"
(if unread " unread" "")))
(if gnus-summary-display-article-function
(funcall gnus-summary-display-article-function article all-header)
(gnus-article-prepare article all-header))
+ (with-current-buffer gnus-article-buffer
+ (set (make-local-variable 'gnus-summary-search-article-matched-data)
+ nil))
(gnus-run-hooks 'gnus-select-article-hook)
(when (and gnus-current-article
(not (zerop gnus-current-article)))
(set-buffer gnus-summary-buffer))
(let ((article (or article (gnus-summary-article-number)))
(all-headers (not (not all-headers))) ;Must be T or NIL.
- gnus-summary-display-article-function
- did)
+ gnus-summary-display-article-function)
(and (not pseudo)
(gnus-summary-article-pseudo-p article)
(error "This is a pseudo-article"))
- (prog1
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (if (or (and gnus-single-article-buffer
- (or (null gnus-current-article)
- (null gnus-article-current)
- (null (get-buffer gnus-article-buffer))
- (not (eq article (cdr gnus-article-current)))
- (not (equal (car gnus-article-current)
- gnus-newsgroup-name))))
- (and (not gnus-single-article-buffer)
- (or (null gnus-current-article)
- (not (eq gnus-current-article article))))
- force)
- ;; The requested article is different from the current article.
- (prog1
- (gnus-summary-display-article article all-headers)
- (setq did article)
- (when (or all-headers gnus-show-all-headers)
- (gnus-article-show-all-headers)))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (if (or (and gnus-single-article-buffer
+ (or (null gnus-current-article)
+ (null gnus-article-current)
+ (null (get-buffer gnus-article-buffer))
+ (not (eq article (cdr gnus-article-current)))
+ (not (equal (car gnus-article-current)
+ gnus-newsgroup-name))))
+ (and (not gnus-single-article-buffer)
+ (or (null gnus-current-article)
+ (not (eq gnus-current-article article))))
+ force)
+ ;; The requested article is different from the current article.
+ (progn
+ (gnus-summary-display-article article all-headers)
(when (or all-headers gnus-show-all-headers)
(gnus-article-show-all-headers))
- 'old))
- (when did
- (gnus-article-set-window-start
- (cdr (assq article gnus-newsgroup-bookmarks)))))))
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks)))
+ article)
+ (when (or all-headers gnus-show-all-headers)
+ (gnus-article-show-all-headers))
+ 'old))))
(defun gnus-summary-set-current-mark (&optional current-mark)
"Obsolete function."
"Limit the summary buffer to articles that are older than (or equal) AGE days.
If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
articles that are younger than AGE days."
- (interactive "nLimit to articles older than (in days): \nP")
+ (interactive
+ (let ((younger current-prefix-arg)
+ (days-got nil)
+ days)
+ (while (not days-got)
+ (setq days (if younger
+ (read-string "Limit to articles within (in days): ")
+ (read-string "Limit to articles old than (in days): ")))
+ (when (> (length days) 0)
+ (setq days (read days)))
+ (if (numberp days)
+ (setq days-got t)
+ (message "Please enter a number.")
+ (sleep-for 1)))
+ (list days younger)))
(prog1
(let ((data gnus-newsgroup-data)
(cutoff (days-to-time age))
(when (and (vectorp (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
(setq is-younger (time-less-p
- (time-since (date-to-time date))
+ (time-since (condition-case ()
+ (date-to-time date)
+ (error '(0 0))))
cutoff))
(when (if younger-p
is-younger
(let ((header
(intern
(gnus-completing-read
- (symbol-name (car gnus-extra-headers))
- "Score extra header:"
- (mapcar (lambda (x)
+ (symbol-name (car gnus-extra-headers))
+ "Limit extra header:"
+ (mapcar (lambda (x)
(cons (symbol-name x) x))
gnus-extra-headers)
- nil
+ nil
t))))
(list header
(read-string (format "Limit to header %s (regexp): " header)))))
"Go forwards in the thread until we find an article that we want to display."
(when (or (eq gnus-fetch-old-headers 'some)
(eq gnus-fetch-old-headers 'invisible)
+ (numberp gnus-fetch-old-headers)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
;; Deal with old-fetched headers and sparse threads.
"Cut off all uninteresting articles from the beginning of threads."
(when (or (eq gnus-fetch-old-headers 'some)
(eq gnus-fetch-old-headers 'invisible)
+ (numberp gnus-fetch-old-headers)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
(let ((th threads))
(if (or gnus-inhibit-limiting
(and (null gnus-newsgroup-dormant)
(not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers))
(not (eq gnus-fetch-old-headers 'invisible))
(null gnus-summary-expunge-below)
(not (eq gnus-build-sparse-threads 'some))
(zerop children))
;; If this is "fetch-old-headered" and there is no
;; visible children, then we don't want this article.
- (and (eq gnus-fetch-old-headers 'some)
+ (and (or (eq gnus-fetch-old-headers 'some)
+ (numberp gnus-fetch-old-headers))
(gnus-summary-article-ancient-p number)
(zerop children))
;; If this is "fetch-old-headered" and `invisible', then
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
(gnus-summary-limit-include-thread id)))
-(defun gnus-summary-refer-article (message-id &optional arg)
- "Fetch an article specified by MESSAGE-ID.
-If ARG (the prefix), fetch the article using `gnus-refer-article-method'
-or `gnus-select-method', no matter what backend the article comes from."
- (interactive "sMessage-ID: \nP")
+(defun gnus-summary-refer-article (message-id)
+ "Fetch an article specified by MESSAGE-ID."
+ (interactive "sMessage-ID: ")
(when (and (stringp message-id)
(not (zerop (length message-id))))
;; Construct the correct Message-ID if necessary.
(gnus-summary-article-sparse-p
(mail-header-number header))
(memq (mail-header-number header)
- gnus-newsgroup-limit))))
+ gnus-newsgroup-limit)))
+ number)
(cond
;; If the article is present in the buffer we just go to it.
((and header
(when sparse
(gnus-summary-update-article (mail-header-number header)))))
(t
- ;; We fetch the article
- (let ((gnus-override-method
- (cond ((gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method)
- (arg
- (or gnus-refer-article-method gnus-select-method))
- (t nil)))
- number)
- ;; Start the special refer-article method, if necessary.
- (when (and gnus-refer-article-method
- (gnus-news-group-p gnus-newsgroup-name))
- (gnus-check-server gnus-refer-article-method))
- ;; Fetch the header, and display the article.
- (if (setq number (gnus-summary-insert-subject message-id))
+ ;; We fetch the article.
+ (catch 'found
+ (dolist (gnus-override-method (gnus-refer-article-methods))
+ (gnus-check-server gnus-override-method)
+ ;; Fetch the header, and display the article.
+ (when (setq number (gnus-summary-insert-subject message-id))
(gnus-summary-select-article nil nil nil number)
- (gnus-message 3 "Couldn't fetch article %s" message-id))))))))
+ (throw 'found t)))
+ (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
+
+(defun gnus-refer-article-methods ()
+ "Return a list of referrable methods."
+ (cond
+ ;; No method, so we default to current and native.
+ ((null gnus-refer-article-method)
+ (list gnus-current-select-method gnus-select-method))
+ ;; Current.
+ ((eq 'current gnus-refer-article-method)
+ (list gnus-current-select-method))
+ ;; List of select methods.
+ ((not (and (symbolp (car gnus-refer-article-method))
+ (assq (car gnus-refer-article-method) nnoo-definition-alist)))
+ (let (out)
+ (dolist (method gnus-refer-article-method)
+ (push (if (eq 'current method)
+ gnus-current-select-method
+ method)
+ out))
+ (nreverse out)))
+ ;; One single select method.
+ (t
+ (list gnus-refer-article-method))))
(defun gnus-summary-edit-parameters ()
"Edit the group parameters of the current group."
(list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
- dig)
+ dig to-address)
(save-excursion
+ (set-buffer gnus-original-article-buffer)
+ ;; Have the digest group inherit the main mail address of
+ ;; the parent article.
+ (when (setq to-address (or (message-fetch-field "reply-to")
+ (message-fetch-field "from")))
+ (setq params (append
+ (list (cons 'to-address
+ (funcall gnus-decode-encoded-word-function
+ to-address))))))
(setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
(insert-buffer-substring gnus-original-article-buffer)
;; Remove lines that may lead nndoc to misinterpret the
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (point)))
(goto-char (point-min))
- (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (delete-matching-lines "^Path:\\|^From ")
(widen))
(unwind-protect
- (if (gnus-group-read-ephemeral-group
- name `(nndoc ,name (nndoc-address ,(get-buffer dig))
- (nndoc-article-type
- ,(if force 'digest 'guess))) t)
- ;; Make all postings to this group go to the parent group.
+ (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
+ (gnus-newsgroup-ephemeral-ignored-charsets
+ gnus-newsgroup-ignored-charsets))
+ (gnus-group-read-ephemeral-group
+ name `(nndoc ,name (nndoc-address ,(get-buffer dig))
+ (nndoc-article-type
+ ,(if force 'mbox 'guess))) t))
+ ;; Make all postings to this group go to the parent group.
(nconc (gnus-info-params (gnus-get-info name))
params)
;; Couldn't select this doc group.
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
(interactive "P")
- (gnus-summary-select-article)
- (gnus-configure-windows 'article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (save-restriction
- (widen)
- (isearch-forward regexp-p))))
+ (let* ((gnus-inhibit-treatment t)
+ (old (gnus-summary-select-article)))
+ (gnus-configure-windows 'article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (when (eq 'old old)
+ (gnus-article-show-all-headers))
+ (goto-char (point-min))
+ (isearch-forward regexp-p)))))
(defun gnus-summary-search-article-forward (regexp &optional backward)
"Search for an article containing REGEXP forward.
"")))))
(gnus-summary-search-article-forward regexp 'backward))
+(eval-when-compile
+ (defmacro gnus-summary-search-article-position-point (regexp backward)
+ "Dehighlight the last matched text and goto the beginning position."
+ (` (if (and gnus-summary-search-article-matched-data
+ (let ((text (caddr gnus-summary-search-article-matched-data))
+ (inhibit-read-only t)
+ buffer-read-only)
+ (delete-region
+ (goto-char (car gnus-summary-search-article-matched-data))
+ (cadr gnus-summary-search-article-matched-data))
+ (insert text)
+ (string-match (, regexp) text)))
+ (if (, backward) (beginning-of-line) (end-of-line))
+ (goto-char (if (, backward) (point-max) (point-min))))))
+
+ (defmacro gnus-summary-search-article-highlight-goto-x-face (opoint)
+ "Place point where X-Face image is displayed."
+ (if (featurep 'xemacs)
+ (` (let ((end (if (search-forward "\n\n" nil t)
+ (goto-char (1- (point)))
+ (point-min)))
+ extent)
+ (or (search-backward "\n\n" nil t) (goto-char (point-min)))
+ (unless (and (re-search-forward "^From:" end t)
+ (setq extent (extent-at (point)))
+ (extent-begin-glyph extent))
+ (goto-char (, opoint)))))
+ (` (let ((end (if (search-forward "\n\n" nil t)
+ (goto-char (1- (point)))
+ (point-min))))
+ (goto-char
+ (or (text-property-any (or (search-backward "\n\n" nil t)
+ (point-min))
+ end 'x-face-mule-bitmap-image t)
+ (, opoint)))))))
+
+ (defmacro gnus-summary-search-article-highlight-matched-text
+ (backward treated x-face)
+ "Highlight matched text in the function `gnus-summary-search-article'."
+ (` (let ((start (set-marker (make-marker) (match-beginning 0)))
+ (end (set-marker (make-marker) (match-end 0)))
+ (inhibit-read-only t)
+ buffer-read-only)
+ (unless treated
+ (let ((,@
+ (let ((items (mapcar 'car gnus-treatment-function-alist)))
+ (mapcar
+ (lambda (item) (setq items (delq item items)))
+ '(gnus-treat-buttonize
+ gnus-treat-fill-article
+ gnus-treat-fill-long-lines
+ gnus-treat-emphasize
+ gnus-treat-highlight-headers
+ gnus-treat-highlight-citation
+ gnus-treat-highlight-signature
+ gnus-treat-overstrike
+ gnus-treat-display-xface
+ gnus-treat-buttonize-head
+ gnus-treat-decode-article-as-default-mime-charset))
+ (static-if (featurep 'xemacs)
+ items
+ (cons '(x-face-mule-delete-x-face-field
+ (quote never))
+ items))))
+ (gnus-treat-display-xface
+ (when (, x-face) gnus-treat-display-xface)))
+ (gnus-article-prepare-mime-display)))
+ (goto-char (if (, backward) start end))
+ (when (, x-face)
+ (gnus-summary-search-article-highlight-goto-x-face (point)))
+ (setq gnus-summary-search-article-matched-data
+ (list start end (buffer-substring start end)))
+ (unless (eq start end);; matched text has been deleted. :-<
+ (put-text-property start end 'face
+ (or (find-face 'isearch)
+ 'secondary-selection))))))
+ )
+
(defun gnus-summary-search-article (regexp &optional backward)
"Search for an article containing REGEXP.
Optional argument BACKWARD means do search for backward.
(require 'gnus-art)
(let ((gnus-select-article-hook nil) ;Disable hook.
(gnus-article-display-hook nil)
+ (gnus-article-prepare-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(gnus-use-article-prefetch nil)
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
(gnus-use-trees nil) ;Inhibit updating tree buffer.
(sum (current-buffer))
(found nil)
- point)
+ point treated)
(gnus-save-hidden-threads
- (gnus-summary-select-article)
+ (static-if (featurep 'xemacs)
+ (let ((gnus-inhibit-treatment t))
+ (setq treated (eq 'old (gnus-summary-select-article)))
+ (when (and treated
+ (not (and (gnus-buffer-live-p gnus-article-buffer)
+ (window-live-p (get-buffer-window
+ gnus-article-buffer t)))))
+ (gnus-summary-select-article nil t)
+ (setq treated nil)))
+ (let ((gnus-inhibit-treatment t)
+ (x-face-mule-delete-x-face-field 'never))
+ (setq treated (eq 'old (gnus-summary-select-article)))
+ (when (and treated
+ (not
+ (and (gnus-buffer-live-p gnus-article-buffer)
+ (window-live-p (get-buffer-window
+ gnus-article-buffer t))
+ (or (not (string-match "^\\^X-Face:" regexp))
+ (with-current-buffer gnus-article-buffer
+ gnus-summary-search-article-matched-data)))))
+ (gnus-summary-select-article nil t)
+ (setq treated nil))))
(set-buffer gnus-article-buffer)
- (when backward
- (forward-line -1))
+ (widen)
+ (if treated
+ (progn
+ (gnus-article-show-all-headers)
+ (gnus-summary-search-article-position-point regexp backward))
+ (goto-char (if backward (point-max) (point-min))))
(while (not found)
(gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
(if (if backward
(re-search-forward regexp nil t))
;; We found the regexp.
(progn
+ (gnus-summary-search-article-highlight-matched-text
+ backward treated (string-match "^\\^X-Face:" regexp))
(setq found 'found)
- (beginning-of-line)
+ (forward-line
+ (/ (- 2 (window-height
+ (get-buffer-window gnus-article-buffer t)))
+ 2))
(set-window-start
(get-buffer-window (current-buffer))
(point))
- (forward-line 1)
(set-buffer sum)
(setq point (point)))
;; We didn't find it, so we go to the next article.
(unless (gnus-summary-article-sparse-p
(gnus-summary-article-number))
(setq found nil)
- (gnus-summary-select-article)
+ (let ((gnus-inhibit-treatment t))
+ (gnus-summary-select-article))
+ (setq treated nil)
(set-buffer gnus-article-buffer)
(widen)
(goto-char (if backward (point-max) (point-min))))))))
(defun gnus-summary-show-article (&optional arg)
"Force re-fetching of the current article.
-If ARG (the prefix) is non-nil, show the raw article without any
-article massaging functions being run."
+If ARG (the prefix) is a number, show the article with the charset
+defined in `gnus-summary-show-article-charset-alist', or the charset
+inputed.
+If ARG (the prefix) is non-nil and not a number, show the raw article
+without any article massaging functions being run."
(interactive "P")
- (if (not arg)
- ;; Select the article the normal way.
+ (cond
+ ((numberp arg)
+ (let ((gnus-newsgroup-charset
+ (or (cdr (assq arg gnus-summary-show-article-charset-alist))
+ (read-coding-system "Charset: ")))
+ (gnus-newsgroup-ignored-charsets 'gnus-all))
(gnus-summary-select-article nil 'force)
+ (let ((deps gnus-newsgroup-dependencies)
+ head header)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (message-narrow-to-head)
+ (setq head (buffer-string)))
+ (with-temp-buffer
+ (insert (format "211 %d Article retrieved.\n"
+ (cdr gnus-article-current)))
+ (insert head)
+ (insert ".\n")
+ (let ((nntp-server-buffer (current-buffer)))
+ (setq header (car (gnus-get-newsgroup-headers deps t))))))
+ (gnus-data-set-header
+ (gnus-data-find (cdr gnus-article-current))
+ header)
+ (gnus-summary-update-article-line
+ (cdr gnus-article-current) header))))
+ ((not arg)
+ ;; Select the article the normal way.
+ (gnus-summary-select-article nil 'force))
+ (t
;; We have to require this here to make sure that the following
;; dynamic binding isn't shadowed by autoloading.
(require 'gnus-async)
gnus-article-prepare-hook
gnus-article-decode-hook
gnus-break-pages
- gnus-show-mime
- gnus-visual)
- (gnus-summary-select-article nil 'force)))
+ gnus-show-mime)
+ (gnus-summary-select-article nil 'force))))
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-position-point))
(let* ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
hidden e)
- (save-restriction
- (article-narrow-to-head)
- (setq hidden (gnus-article-hidden-text-p 'headers)))
+ (setq hidden
+ (if (numberp arg)
+ (>= arg 0)
+ (save-restriction
+ (article-narrow-to-head)
+ (gnus-article-hidden-text-p 'headers))))
(goto-char (point-min))
(when (search-forward "\n\n" nil t)
(delete-region (point-min) (1- (point))))
(save-restriction
(narrow-to-region (point-min) (point))
(article-decode-encoded-words)
- (if (or hidden
- (and (numberp arg) (< arg 0)))
+ (if hidden
(let ((gnus-treat-hide-headers nil)
(gnus-treat-hide-boring-headers nil))
+ (setq gnus-article-wash-types
+ (delq 'headers gnus-article-wash-types))
(gnus-treat-article 'head))
- (gnus-treat-article 'head)))))))
+ (gnus-treat-article 'head)))
+ (gnus-set-mode-line 'article)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
For this function to work, both the current newsgroup and the
newsgroup that you want to move to have to support the `request-move'
-and `request-accept' functions."
+and `request-accept' functions.
+
+ACTION can be either `move' (the default), `crosspost' or `copy'."
(interactive "P")
(unless action
(setq action 'move))
'request-replace-article gnus-newsgroup-name)))
(error "The current group does not support article editing")))
(let ((articles (gnus-summary-work-articles n))
- (prefix (gnus-group-real-prefix gnus-newsgroup-name))
+ (prefix (if (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name)
+ (gnus-group-real-prefix gnus-newsgroup-name)
+ ""))
(names '((move "Move" "Moving")
(copy "Copy" "Copying")
(crosspost "Crosspost" "Crossposting")))
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(setq to-method (or select-method
- (gnus-group-name-to-method to-newsgroup)))
+ (gnus-server-to-method
+ (gnus-group-method to-newsgroup))))
;; Check the method we are to move this article to...
(unless (gnus-check-backend-function
'request-accept-article (car to-method))
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
to-newsgroup (list 'quote select-method)
- (not articles) t) ; Accept form
+ (not articles) t) ; Accept form
(not articles))) ; Only save nov last time
;; Copy the article.
((eq action 'copy)
art-group))))))
(cond
((not art-group)
- (gnus-message 1 "Couldn't %s article %s"
- (cadr (assq action names)) article))
- ((and (eq art-group 'junk)
- (eq action 'move))
- (gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article))
+ (gnus-message 1 "Couldn't %s article %s: %s"
+ (cadr (assq action names)) article
+ (nnheader-get-report (car to-method))))
+ ((eq art-group 'junk)
+ (when (eq action 'move)
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article)))
(t
(let* ((pto-group (gnus-group-prefixed-name
(car art-group) to-method))
(entry
(gnus-gethash pto-group gnus-newsrc-hashtb))
(info (nth 2 entry))
- (to-group (gnus-info-group info)))
+ (to-group (gnus-info-group info))
+ to-marks)
;; Update the group that has been moved to.
(when (and info
(memq action '(move copy)))
(push to-group to-groups))
(unless (memq article gnus-newsgroup-unreads)
+ (push 'read to-marks)
(gnus-info-set-read
info (gnus-add-to-range (gnus-info-read info)
(list (cdr art-group)))))
- ;; Copy any marks over to the new group.
+ ;; See whether the article is to be put in the cache.
(let ((marks (if (gnus-group-auto-expirable-p to-group)
default-marks
no-expire-marks))
(to-article (cdr art-group)))
- ;; See whether the article is to be put in the cache.
+ ;; Enter the article into the cache in the new group,
+ ;; if that is required.
(when gnus-use-cache
(gnus-cache-possibly-enter-article
to-group to-article
+ (let ((header (copy-sequence
+ (gnus-summary-article-header article))))
+ (mail-header-set-number header to-article)
+ header)
(memq article gnus-newsgroup-marked)
(memq article gnus-newsgroup-dormant)
(memq article gnus-newsgroup-unreads)))
- (when (and (equal to-group gnus-newsgroup-name)
- (not (memq article gnus-newsgroup-unreads)))
- ;; Mark this article as read in this group.
- (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
- (setcdr (gnus-active to-group) to-article)
- (setcdr gnus-newsgroup-active to-article))
-
- (while marks
- (when (memq article (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))
- ;; If the other group is the same as this group,
- ;; then we have to add the mark to the list.
- (when (equal to-group gnus-newsgroup-name)
- (set (intern (format "gnus-newsgroup-%s" (caar marks)))
- (cons to-article
- (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))))
- ;; Copy the marks to other group.
- (gnus-add-marked-articles
- to-group (cdar marks) (list to-article) info))
- (setq marks (cdr marks)))
+ (when gnus-preserve-marks
+ ;; Copy any marks over to the new group.
+ (when (and (equal to-group gnus-newsgroup-name)
+ (not (memq article gnus-newsgroup-unreads)))
+ ;; Mark this article as read in this group.
+ (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
+ (setcdr (gnus-active to-group) to-article)
+ (setcdr gnus-newsgroup-active to-article))
+
+ (while marks
+ (when (memq article (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))
+ (push (cdar marks) to-marks)
+ ;; If the other group is the same as this group,
+ ;; then we have to add the mark to the list.
+ (when (equal to-group gnus-newsgroup-name)
+ (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+ (cons to-article
+ (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))))
+ ;; Copy the marks to other group.
+ (gnus-add-marked-articles
+ to-group (cdar marks) (list to-article) info))
+ (setq marks (cdr marks)))
+
+ (gnus-request-set-mark to-group (list (list (list to-article)
+ 'set
+ to-marks))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(kill-buffer (current-buffer)))))
(defun gnus-summary-article-posted-p ()
- "Say whether the current (mail) article is available from `gnus-select-method' as well.
+ "Say whether the current (mail) article is available from news as well.
This will be the case if the article has both been mailed and posted."
(interactive)
(let ((id (mail-header-references (gnus-summary-article-header)))
- (gnus-override-method
- (or gnus-refer-article-method gnus-select-method)))
+ (gnus-override-method (car (gnus-refer-article-methods))))
(if (gnus-request-head id "")
(gnus-message 2 "The current message was found on %s"
gnus-override-method)
(expiry-wait (if now 'immediate
(gnus-group-find-parameter
gnus-newsgroup-name 'expiry-wait)))
+ (nnmail-expiry-target
+ (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target)
+ nnmail-expiry-target))
es)
(when expirable
;; There are expirable articles in this group, so we run them
(setq es (gnus-request-expire-articles
expirable gnus-newsgroup-name)))
(setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name))))
- (unless total
- (setq gnus-newsgroup-expirable es))
- ;; We go through the old list of expirable, and mark all
- ;; really expired articles as nonexistent.
- (unless (eq es expirable) ;If nothing was expired, we don't mark.
- (let ((gnus-use-cache nil))
- (while expirable
- (unless (memq (car expirable) es)
- (when (gnus-data-find (car expirable))
- (gnus-summary-mark-article
- (car expirable) gnus-canceled-mark)))
- (setq expirable (cdr expirable)))))
+ expirable gnus-newsgroup-name)))
+ (unless total
+ (setq gnus-newsgroup-expirable es))
+ ;; We go through the old list of expirable, and mark all
+ ;; really expired articles as nonexistent.
+ (unless (eq es expirable) ;If nothing was expired, we don't mark.
+ (let ((gnus-use-cache nil))
+ (while expirable
+ (unless (memq (car expirable) es)
+ (when (gnus-data-find (car expirable))
+ (gnus-summary-mark-article
+ (car expirable) gnus-canceled-mark)))
+ (setq expirable (cdr expirable))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
(error "The current newsgroup does not support article deletion"))
+ (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
+ (error "Couldn't open server"))
;; Compute the list of articles to delete.
(let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
not-deleted)
If FORCE is non-nil, allow editing of articles even in read-only
groups."
(interactive "P")
- (let ((mail-parse-charset gnus-newsgroup-charset))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
(gnus-set-global-variables)
(when (and (not force)
(gnus-group-read-only-p))
(gnus-article-edit-article
'ignore
`(lambda (no-highlight)
- (let ((mail-parse-charset ',gnus-newsgroup-charset))
+ (let ((mail-parse-charset ',gnus-newsgroup-charset)
+ (message-options message-options)
+ (message-options-set-recipient)
+ (mail-parse-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets))
(gnus-summary-edit-article-done
,(or (mail-header-references gnus-current-headers) "")
,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))))
"Mark N articles as read forwards.
If N is negative, mark backwards instead. Mark with MARK, ?r by default.
The difference between N and the actual number of articles marked is
-returned."
+returned.
+Iff NO-EXPIRE, auto-expiry will be inhibited."
(interactive "p")
(gnus-summary-show-thread)
(let ((backward (< n 0))
(save-excursion
(gnus-cache-possibly-enter-article
gnus-newsgroup-name article
+ (gnus-summary-article-header article)
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
`??' (dormant) and `?E' (expirable).
If MARK is nil, then the default character `?r' is used.
If ARTICLE is nil, then the article on the current line will be
-marked."
+marked.
+Iff NO-EXPIRE, auto-expiry will be inhibited."
;; The mark might be a string.
(when (stringp mark)
(setq mark (aref mark 0)))
(save-excursion
(gnus-cache-possibly-enter-article
gnus-newsgroup-name article
+ (gnus-summary-article-header article)
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
(gnus-summary-catchup t quietly))
(defun gnus-summary-catchup-and-exit (&optional all quietly)
- "Mark all articles not marked as unread in this newsgroup as read, then exit.
+ "Mark all unread articles in this group as read, then exit.
If prefix argument ALL is non-nil, all articles are marked as read."
(interactive "P")
(when (gnus-summary-catchup all quietly nil 'fast)
(interactive "P")
(gnus-summary-catchup-and-exit t quietly))
-;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
(defun gnus-summary-catchup-and-goto-next-group (&optional all)
"Mark all articles in this group as read and select the next group.
If given a prefix, mark all articles, unread as well as ticked, as
(interactive "P")
(save-excursion
(gnus-summary-catchup all))
- (gnus-summary-next-article t nil nil t))
+ (gnus-summary-next-group))
+
+;;;
+;;; with article
+;;;
+
+(defmacro gnus-with-article (article &rest forms)
+ "Select ARTICLE and perform FORMS in the original article buffer.
+Then replace the article with the result."
+ `(progn
+ ;; We don't want the article to be marked as read.
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil ,article))
+ (set-buffer gnus-original-article-buffer)
+ ,@forms
+ (if (not (gnus-check-backend-function
+ 'request-replace-article (car gnus-article-current)))
+ (gnus-message 5 "Read-only group; not replacing")
+ (unless (gnus-request-replace-article
+ ,article (car gnus-article-current)
+ (current-buffer) t)
+ (error "Couldn't replace article")))
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))))
+
+(put 'gnus-with-article 'lisp-indent-function 1)
+(put 'gnus-with-article 'edebug-form-spec '(form body))
;; Thread-based commands.
(unless (and message-id (not (equal message-id "")))
(error "No message-id in desired parent"))
(gnus-with-article current-article
- (goto-char (point-min))
- (if (re-search-forward "^References: " nil t)
- (progn
- (re-search-forward "^[^ \t]" nil t)
- (forward-line -1)
- (end-of-line)
- (insert " " message-id))
- (insert "References: " message-id "\n")))
+ (save-restriction
+ (goto-char (point-min))
+ (message-narrow-to-head)
+ (if (re-search-forward "^References: " nil t)
+ (progn
+ (re-search-forward "^[^ \t]" nil t)
+ (forward-line -1)
+ (end-of-line)
+ (insert " " message-id))
+ (insert "References: " message-id "\n"))))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-update-article current-article)
(subst-char-in-region start (point) ?\n ?\^M)
(gnus-summary-goto-subject article))
(goto-char start)
- nil)
- ;;(gnus-summary-position-point)
- ))))
+ nil)))))
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
(defun gnus-summary-sort-by-author (&optional reverse)
"Sort the summary buffer by author name alphabetically.
-If case-fold-search is non-nil, case of letters is ignored.
+If `case-fold-search' is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'author reverse))
(defun gnus-summary-sort-by-subject (&optional reverse)
"Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
-If case-fold-search is non-nil, case of letters is ignored.
+If `case-fold-search' is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'subject reverse))
"Sort the summary buffer by article length.
Argument REVERSE means reverse order."
(interactive "P")
- (gnus-summary-sort 'chars reverse))
+ (gnus-summary-sort 'chars reverse))
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
thread
`(lambda (t1 t2)
(,thread t2 t1))))
+ (gnus-sort-gathered-threads-function
+ gnus-thread-sort-functions)
(gnus-article-sort-functions
(if (not reverse)
article
(set-buffer gnus-original-article-buffer)
(save-restriction
(nnheader-narrow-to-headers)
- (while methods
+ (while (and methods (not split-name))
(goto-char (point-min))
(setq method (pop methods))
(setq match (car method))
(save-restriction
(widen)
(setq result (eval match)))))
- (setq split-name (append (cdr method) split-name))
+ (setq split-name (cdr method))
(cond ((stringp result)
(push (expand-file-name
result gnus-article-save-directory)
(mapcar (lambda (el) (list el))
(nreverse split-name))
nil nil nil
- 'gnus-group-history)))))
+ 'gnus-group-history))))
+ (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
(unless to-newsgroup
(error "No group name entered"))
(or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup)
+ (gnus-activate-group to-newsgroup nil nil to-method)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (and (gnus-request-create-group
- to-newsgroup (gnus-group-name-to-method to-newsgroup))
- (gnus-activate-group to-newsgroup nil nil
- (gnus-group-name-to-method
- to-newsgroup)))
+ (or (and (gnus-request-create-group to-newsgroup to-method)
+ (gnus-activate-group
+ to-newsgroup nil nil to-method)
+ (gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
-(defun gnus-summary-save-parts (type dir n reverse)
+(defun gnus-summary-save-parts (type dir n &optional reverse)
"Save parts matching TYPE to DIR.
If REVERSE, save parts that do not match TYPE."
(interactive
- (list (read-string "Save parts of type: " "image/.*")
- (read-file-name "Save to directory: " t nil t)
+ (list (read-string "Save parts of type: "
+ (or (car gnus-summary-save-parts-type-history)
+ gnus-summary-save-parts-default-mime)
+ 'gnus-summary-save-parts-type-history)
+ (setq gnus-summary-save-parts-last-directory
+ (read-file-name "Save to directory: "
+ gnus-summary-save-parts-last-directory
+ nil t))
current-prefix-arg))
(gnus-summary-iterate n
(let ((gnus-display-mime-function nil)
(gnus-summary-select-article))
(save-excursion
(set-buffer gnus-article-buffer)
- (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect))))
+ (let ((handles (or gnus-article-mime-handles
+ (mm-dissect-buffer) (mm-uu-dissect))))
(when handles
- (gnus-summary-save-parts-1 type dir handles reverse))))))
+ (gnus-summary-save-parts-1 type dir handles reverse)
+ (unless gnus-article-mime-handles ;; Don't destroy this case.
+ (mm-destroy-parts handles)))))))
(defun gnus-summary-save-parts-1 (type dir handle reverse)
(if (stringp (car handle))
(mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse))
(cdr handle))
(when (if reverse
- (not (string-match type (car (mm-handle-type handle))))
- (string-match type (car (mm-handle-type handle))))
+ (not (string-match type (mm-handle-media-type handle)))
+ (string-match type (mm-handle-media-type handle)))
(let ((file (expand-file-name
(file-name-nondirectory
(or
(mail-content-type-get
(mm-handle-disposition handle) 'filename)
- (concat gnus-newsgroup-name "." gnus-current-article)))
+ (concat gnus-newsgroup-name
+ "." (number-to-string
+ (cdr gnus-article-current)))))
dir)))
(unless (file-exists-p file)
(mm-save-part-to-file handle file))))))
"Read the headers of article ID and enter them into the Gnus system."
(let ((group gnus-newsgroup-name)
(gnus-override-method
- (and (gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method))
+ (or
+ gnus-override-method
+ (and (gnus-news-group-p gnus-newsgroup-name)
+ (car (gnus-refer-article-methods)))))
where)
;; First we check to see whether the header in question is already
;; fetched.
;;;
(defun gnus-highlight-selected-summary ()
+ "Highlight selected article in summary buffer."
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
- ;; Highlight selected article in summary buffer
(when gnus-summary-selected-face
(save-excursion
(let* ((beg (progn (beginning-of-line) (point)))
(if compute
read
(save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
- (gnus-group-update-group ,group t))))
- ;; Propagate the read marks to the backend.
- (if (gnus-check-backend-function 'request-set-mark group)
- (let ((del (gnus-remove-from-range (gnus-info-read info) read))
- (add (gnus-remove-from-range read (gnus-info-read info))))
- (when (or add del)
- (unless (gnus-check-group group)
- (error "Can't open server for %s" group))
- (gnus-request-set-mark
- group (delq nil (list (if add (list add 'add '(read)))
- (if del (list del 'del '(read)))))))))
+ (let (setmarkundo)
+ ;; Propagate the read marks to the backend.
+ (when (gnus-check-backend-function 'request-set-mark group)
+ (let ((del (gnus-remove-from-range (gnus-info-read info) read))
+ (add (gnus-remove-from-range read (gnus-info-read info))))
+ (when (or add del)
+ (unless (gnus-check-group group)
+ (error "Can't open server for %s" group))
+ (gnus-request-set-mark
+ group (delq nil (list (if add (list add 'add '(read)))
+ (if del (list del 'del '(read))))))
+ (setq setmarkundo
+ `(gnus-request-set-mark
+ ,group
+ ',(delq nil (list
+ (if del (list del 'add '(read)))
+ (if add (list add 'del '(read))))))))))
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info
+ (gnus-active ,group))
+ (gnus-group-update-group ,group t)
+ ,setmarkundo))))
;; Enter this list into the group info.
(gnus-info-set-read info read)
;; Set the number of unread articles in gnus-newsrc-hashtb.
(defun gnus-mime-extract-message/rfc822 (entity situation)
(let (group article num cwin swin cur)
- (with-current-buffer (mime-entity-buffer entity)
- (save-restriction
- (narrow-to-region (mime-entity-body-start entity)
- (mime-entity-body-end entity))
- (setq group (or (cdr (assq 'group situation))
- (completing-read "Group: "
- gnus-active-hashtb
- nil
- (gnus-read-active-file-p)
- gnus-newsgroup-name))
- article (gnus-request-accept-article group)
- )
- ))
+ (with-temp-buffer
+ (mime-insert-entity-content entity)
+ (setq group (or (cdr (assq 'group situation))
+ (completing-read "Group: "
+ gnus-active-hashtb
+ nil
+ (gnus-read-active-file-p)
+ gnus-newsgroup-name))
+ article (gnus-request-accept-article group)))
(when (and (consp article)
(numberp (setq article (cdr article))))
(setq num (1+ (or (cdr (assq 'number situation)) 0))
- cwin (get-buffer-window (current-buffer) t)
- )
+ cwin (get-buffer-window (current-buffer) t))
(save-window-excursion
(if (setq swin (get-buffer-window gnus-summary-buffer t))
(select-window swin)
- (set-buffer gnus-summary-buffer)
- )
+ (set-buffer gnus-summary-buffer))
(setq cur gnus-current-article)
(forward-line num)
(let (gnus-show-threads)
- (gnus-summary-goto-subject article t)
- )
+ (gnus-summary-goto-subject article t))
(gnus-summary-clear-mark-forward 1)
- (gnus-summary-goto-subject cur)
- )
+ (gnus-summary-goto-subject cur))
(when (and cwin (window-frame cwin))
- (select-frame (window-frame cwin))
- )
+ (select-frame (window-frame cwin)))
(when (boundp 'mime-acting-situation-to-override)
(set-alist 'mime-acting-situation-to-override
'group
`(progn
(save-current-buffer
(set-buffer gnus-group-buffer)
- (gnus-activate-group ,group)
- )
+ (gnus-activate-group ,group))
(gnus-summary-goto-article ,cur
- gnus-show-all-headers)
- ))
+ gnus-show-all-headers)))
(set-alist 'mime-acting-situation-to-override
- 'number num)
- )
- )))
+ 'number num)))))
(mime-add-condition
'action '((type . message)(subtype . rfc822)
(if (setq f (cdr (assq 'after-method
mime-acting-situation-to-override)))
(eval f)
- )))
+ )))
(mime-add-condition
'action '((type . multipart)
(defun gnus-summary-setup-default-charset ()
"Setup newsgroup default charset."
- (let ((name (and gnus-newsgroup-name
- (gnus-group-real-name gnus-newsgroup-name))))
- (setq gnus-newsgroup-charset
- (or (and gnus-newsgroup-name
- (or (gnus-group-find-parameter gnus-newsgroup-name
- 'charset)
- (let ((alist gnus-group-charset-alist)
- elem (charset nil))
- (while (setq elem (pop alist))
- (when (and name
- (string-match (car elem) name))
- (setq alist nil
- charset (cadr elem))))
- charset)))
- gnus-default-charset))))
+ (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (setq gnus-newsgroup-charset nil)
+ (let* ((name (and gnus-newsgroup-name
+ (gnus-group-real-name gnus-newsgroup-name)))
+ (ignored-charsets
+ (or gnus-newsgroup-ephemeral-ignored-charsets
+ (append
+ (and gnus-newsgroup-name
+ (or (gnus-group-find-parameter gnus-newsgroup-name
+ 'ignored-charsets t)
+ (let ((alist gnus-group-ignored-charsets-alist)
+ elem (charsets nil))
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ charsets (cdr elem))))
+ charsets)))
+ gnus-newsgroup-ignored-charsets))))
+ (setq gnus-newsgroup-charset
+ (or gnus-newsgroup-ephemeral-charset
+ (and gnus-newsgroup-name
+ (or (gnus-group-find-parameter gnus-newsgroup-name 'charset)
+ (let ((alist gnus-group-charset-alist)
+ elem charset)
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ charset (cadr elem))))
+ charset)))
+ gnus-default-charset))
+ (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
+ ignored-charsets))))
;;;
;;; Mime Commands
(gnus-summary-show-article)))
;;;
-;;; with article
+;;; Intelli-mouse commmands
;;;
-(defmacro gnus-with-article (article &rest forms)
- "Select ARTICLE and perform FORMS in the original article buffer.
-Then replace the article with the result."
- `(progn
- ;; We don't want the article to be marked as read.
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article t t nil ,article))
- (set-buffer gnus-original-article-buffer)
- ,@forms
- (if (not (gnus-check-backend-function
- 'request-replace-article (car gnus-article-current)))
- (gnus-message 5 "Read-only group; not replacing")
- (unless (gnus-request-replace-article
- ,article (car gnus-article-current)
- (current-buffer) t)
- (error "Couldn't replace article")))
- ;; The cache and backlog have to be flushed somewhat.
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current)))))
+(defun gnus-wheel-summary-scroll (event)
+ (interactive "e")
+ (let ((amount (if (memq 'shift (event-modifiers event))
+ (car gnus-wheel-scroll-amount)
+ (cdr gnus-wheel-scroll-amount)))
+ (direction (- (* (static-if (featurep 'xemacs)
+ (event-button event)
+ (cond ((eq 'mouse-4 (event-basic-type event))
+ 4)
+ ((eq 'mouse-5 (event-basic-type event))
+ 5)))
+ 2) 9))
+ edge)
+ (gnus-summary-scroll-up (* amount direction))
+ (when (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (and (if (< 0 direction)
+ (gnus-article-next-page 0)
+ (gnus-article-prev-page 0)
+ (bobp))
+ (if (setq edge (get-text-property
+ (point-min) 'gnus-wheel-edge))
+ (setq edge (* edge direction))
+ (setq edge -1))
+ (or (plusp edge)
+ (let ((buffer-read-only nil)
+ (inhibit-read-only t))
+ (put-text-property (point-min) (point-max)
+ 'gnus-wheel-edge direction)
+ nil))
+ (or (> edge gnus-wheel-edge-resistance)
+ (let ((buffer-read-only nil)
+ (inhibit-read-only t))
+ (put-text-property (point-min) (point-max)
+ 'gnus-wheel-edge
+ (* (1+ edge) direction))
+ nil))
+ (eq last-command 'gnus-wheel-summary-scroll))))
+ (gnus-summary-next-article nil nil (minusp direction)))))
+
+(defun gnus-wheel-install ()
+ "Enable mouse wheel support on summary window."
+ (when gnus-use-wheel
+ (let ((keys
+ '([(mouse-4)] [(shift mouse-4)] [(mouse-5)] [(shift mouse-5)])))
+ (dolist (key keys)
+ (define-key gnus-summary-mode-map key
+ 'gnus-wheel-summary-scroll)))))
+
+(add-hook 'gnus-summary-mode-hook 'gnus-wheel-install)
-(put 'gnus-with-article 'lisp-indent-function 1)
-(put 'gnus-with-article 'edebug-form-spec '(form body))
+;;;
+;;; Traditional PGP commmands
+;;;
+
+(defun gnus-summary-decrypt-article (&optional force)
+ "Decrypt the current article in traditional PGP way.
+This will have permanent effect only in mail groups.
+If FORCE is non-nil, allow editing of articles even in read-only
+groups."
+ (interactive "P")
+ (gnus-summary-select-article t)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (unless (re-search-forward (car pgg-armor-header-lines) nil t)
+ (error "Not a traditional PGP message!"))
+ (let ((armor-start (match-beginning 0)))
+ (if (and (pgg-decrypt-region armor-start (point-max))
+ (or force (not (gnus-group-read-only-p))))
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (delete-region armor-start
+ (progn
+ (re-search-forward "^-+END PGP" nil t)
+ (beginning-of-line 2)
+ (point)))
+ (insert-buffer-substring pgg-output-buffer))))))))
+
+(defun gnus-summary-verify-article ()
+ "Verify the current article in traditional PGP way."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (unless (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE" nil t)
+ (error "Not a traditional PGP message!"))
+ (re-search-forward "^-+END PGP" nil t)
+ (beginning-of-line 2)
+ (call-interactively (function pgg-verify-region))))
;;;
;;; Generic summary marking commands
mark (car lway) lway name)))
(setq func (eval func))
(define-key map (nth 4 lway) func)))))
-
-(defun gnus-summary-make-marking-command-1 (mark way lway name)
+
+(defun gnus-summary-make-marking-command-1 (mark way lway name)
`(defun ,(intern
(format "gnus-summary-put-mark-as-%s%s"
name (if (eq way 'nomove)
If N is negative, move in reverse order.
The difference between N and the actual number of articles marked is
returned."
- name (cadr lway))
+ name (car (cdr lway)))
(interactive "p")
(gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
-
+
(defun gnus-summary-generic-mark (n mark move unread)
"Mark N articles with MARK."
(unless (eq major-mode 'gnus-summary-mode)
(gnus-set-mode-line 'summary)
n))
-;; Added by Shenghuo Zhu <zsh@cs.rochester.edu>
-(defun gnus-summary-setup-highlight-words (&optional highlight-words)
- "Setup newsgroup emphasis alist."
- (let ((name (and gnus-newsgroup-name
- (gnus-group-real-name gnus-newsgroup-name))))
- (setq gnus-newsgroup-emphasis-alist
- (nconc
- (let ((alist gnus-group-highlight-words-alist) elem highlight)
- (while (setq elem (pop alist))
- (when (and name (string-match (car elem) name))
- (setq alist nil
- highlight (copy-list (cdr elem)))))
- highlight)
- (copy-list highlight-words)
- (if gnus-newsgroup-name
- (copy-list (gnus-group-find-parameter
- gnus-newsgroup-name 'highlight-words t)))
- gnus-emphasis-alist))))
-
(gnus-summary-make-all-marking-commands)
(gnus-ems-redefine)
projects / elisp / gnus.git- / blobdiff