;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(require 'gnus-util)
(require 'mime-view)
-;; Avoid byte-compile warnings.
(eval-when-compile
- (defvar gnus-article-decoded-p)
- (defvar gnus-decode-encoded-word-function)
- )
+ (require 'mime-play)
+ (require 'static))
+
+(eval-and-compile
+ (autoload 'gnus-cache-articles-in-group "gnus-cache"))
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t)
(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
: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
\"thread score\" is.
This variable is local to the summary buffers."
- :group 'gnus-treading
+ :group 'gnus-threading
:group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
. 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
("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
("^fj\\>\\|^japan\\>" iso-2022-jp-2)
("^relcom\\>" koi8-r)
+ ("^fido7\\>" koi8-r)
+ ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
+ ("^israel\\>" iso-8859-1)
+ ("^han\\>" euc-kr)
+ ("^\\(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."
+ "Alist of regexps (to match group names) and default charsets to be used when reading."
:type '(repeat (list (regexp :tag "Group")
(symbol :tag "Charset")))
:group 'gnus-charset)
+(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit)
+ "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'."
+ :type '(repeat (cons (regexp :tag "Group")
+ (repeat (list (regexp :tag "Highlight regexp")
+ (number :tag "Group for entire word" 0)
+ (number :tag "Group for displayed part" 0)
+ (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)
+
;;; Internal variables
(defvar gnus-scores-exclude-files 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.")
;; Avoid highlighting in kill files.
(defvar gnus-summary-inhibit-highlight nil)
(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-ephemeral-charset nil)
+(defvar gnus-newsgroup-ephemeral-ignored-charsets nil)
(defconst gnus-summary-local-variables
'(gnus-newsgroup-name
gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
gnus-newsgroup-scored gnus-newsgroup-kill-headers
gnus-thread-expunge-below
- gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
+ gnus-score-alist gnus-current-score-file
+ (gnus-summary-expunge-below . global)
(gnus-summary-mark-below . global)
gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
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-charset
+ gnus-newsgroup-incorporated)
"Variables that are buffer-local to the summary buffers.")
;; Byte-compiler warning.
"\C-c\M-\C-s" gnus-summary-limit-include-expunged
"\C-c\C-s\C-n" gnus-summary-sort-by-number
"\C-c\C-s\C-l" gnus-summary-sort-by-lines
+ "\C-c\C-s\C-c" gnus-summary-sort-by-chars
"\C-c\C-s\C-a" gnus-summary-sort-by-author
"\C-c\C-s\C-s" gnus-summary-sort-by-subject
"\C-c\C-s\C-d" gnus-summary-sort-by-date
"a" gnus-summary-post-news
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
- "t" gnus-article-hide-headers
+ "t" gnus-article-toggle-headers
"g" gnus-summary-show-article
"l" gnus-summary-goto-last-article
"v" gnus-summary-preview-mime-message
"a" gnus-summary-limit-to-author
"u" gnus-summary-limit-to-unread
"m" gnus-summary-limit-to-marks
+ "M" gnus-summary-limit-exclude-marks
"v" gnus-summary-limit-to-score
"*" gnus-summary-limit-include-cached
"D" gnus-summary-limit-include-dormant
"T" gnus-summary-limit-include-thread
"d" gnus-summary-limit-exclude-dormant
"t" gnus-summary-limit-to-age
+ "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
"e" gnus-summary-end-of-article
"^" gnus-summary-refer-parent-article
"r" gnus-summary-refer-parent-article
+ "D" gnus-summary-enter-digest-group
"R" gnus-summary-refer-references
"T" gnus-summary-refer-thread
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
- "P" gnus-summary-print-article)
+ "P" gnus-summary-print-article
+ "t" gnus-article-babel)
(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
"b" gnus-article-add-buttons
"f" gnus-article-display-x-face
"l" gnus-summary-stop-page-breaking
"r" gnus-summary-caesar-message
- "t" gnus-article-hide-headers
+ "t" gnus-article-toggle-headers
"v" gnus-summary-verbose-headers
"m" gnus-summary-toggle-mime
- "h" gnus-article-treat-html
- "d" gnus-article-treat-dumbquotes)
+ "H" gnus-article-strip-headers-in-body
+ "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
- "h" gnus-article-hide-headers
+ "h" gnus-article-toggle-headers
"b" gnus-article-hide-boring-headers
"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
"o" gnus-article-save-part
"c" gnus-article-copy-part
"e" gnus-article-externalize-part
+ "i" gnus-article-inline-part
"|" gnus-article-pipe-part)
)
(let ((innards
'(("Hide"
["All" gnus-article-hide t]
- ["Headers" gnus-article-hide-headers t]
+ ["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])
("Output"
["Save in default format" gnus-summary-save-article t]
["Save in file" gnus-summary-save-article-file t]
("Cache"
["Enter article" gnus-cache-enter-article t]
["Remove article" gnus-cache-remove-article t])
+ ["Translate" gnus-article-babel t]
["Select article buffer" gnus-summary-select-article-buffer t]
["Enter digest buffer" gnus-summary-enter-digest-group t]
["Isearch article..." gnus-summary-isearch-article t]
["Subject..." gnus-summary-limit-to-subject t]
["Author..." gnus-summary-limit-to-author t]
["Age..." gnus-summary-limit-to-age t]
+ ["Extra..." gnus-summary-limit-to-extra t]
["Score" gnus-summary-limit-to-score t]
["Unread" gnus-summary-limit-to-unread t]
["Non-dormant" gnus-summary-limit-exclude-dormant t]
["Hide childless dormant"
gnus-summary-limit-exclude-childless-dormant t]
;;["Hide thread" gnus-summary-limit-exclude-thread t]
+ ["Hide marked" gnus-summary-limit-exclude-marks t]
["Show expunged" gnus-summary-show-all-expunged t])
("Process Mark"
["Set mark" gnus-summary-mark-as-processable t]
["Sort by subject" gnus-summary-sort-by-subject t]
["Sort by date" gnus-summary-sort-by-date t]
["Sort by score" gnus-summary-sort-by-score t]
- ["Sort by lines" gnus-summary-sort-by-lines t])
+ ["Sort by lines" gnus-summary-sort-by-lines t]
+ ["Sort by characters" gnus-summary-sort-by-chars t])
("Help"
["Fetch group FAQ" gnus-summary-fetch-faq t]
["Describe group" gnus-summary-describe-group 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)
(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
(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))
(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))
(nnheader-nov-field) ; subject
(nnheader-nov-field) ; from
(nnheader-nov-field) ; date
- (or (nnheader-nov-field) ; id
- (nnheader-generate-fake-message-id))
+ (nnheader-nov-read-message-id) ; id
(nnheader-nov-field) ; refs
(nnheader-nov-read-integer) ; chars
(nnheader-nov-read-integer) ; lines
- (unless (eq (char-after) ?\n)
+ (unless (eobp)
(nnheader-nov-field)) ; misc
(nnheader-nov-parse-extra))) ; extra
(gnus-article-sort-by-lines
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-chars (h1 h2)
+ "Sort articles by octet length."
+ (< (mail-header-chars h1)
+ (mail-header-chars h2)))
+
+(defun gnus-thread-sort-by-chars (h1 h2)
+ "Sort threads by root article octet length."
+ (gnus-article-sort-by-chars
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
(string-lessp
- (let ((addr (mime-read-field 'From h1)))
+ (let ((addr (car (mime-read-field 'From h1))))
(or (std11-full-name-string addr)
(std11-address-string addr)
""))
- (let ((addr (mime-read-field 'From h2)))
+ (let ((addr (car (mime-read-field 'From h2))))
(or (std11-full-name-string addr)
(std11-address-string addr)
""))
(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 " *\\|"))))
+ (when regexp
+ (dolist (header gnus-newsgroup-headers)
+ (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)")
+ (mail-header-subject header))
+ (mail-header-set-subject
+ header (concat (substring (mail-header-subject header)
+ 0 (match-beginning 2))
+ (substring (mail-header-subject header)
+ (match-end 2)))))))))
+
(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.
(gnus-adjust-marked-articles info))
;; Kludge to avoid having cached articles nixed out in virtual groups.
- (when (gnus-virtual-group-p group)
- (setq cached gnus-newsgroup-cached))
+ (setq cached
+ (if (gnus-virtual-group-p group)
+ gnus-newsgroup-cached
+ (gnus-cache-articles-in-group group)))
(setq gnus-newsgroup-unreads
(gnus-set-difference
gnus-fetch-old-headers)))
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
- ;; Kludge to avoid having cached articles nixed out in virtual groups.
- (when cached
- (setq gnus-newsgroup-cached cached))
-
;; Suppress duplicates?
(when gnus-suppress-duplicates
(gnus-dup-suppress-articles))
;; Removed marked articles that do not exist.
(gnus-update-missing-marks
(gnus-sorted-complement fetched-articles articles))
+
+ ;; Kludge to avoid having cached articles nixed out in virtual groups.
+ (when cached
+ (setq gnus-newsgroup-cached cached))
+
;; We might want to build some more threads first.
(when (and gnus-fetch-old-headers
(eq gnus-headers-retrieved-by 'nov))
;; 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))
(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
- (format
- "How many articles from %s (max %d): "
- (gnus-limit-string gnus-newsgroup-name 35)
- number)
- (number-to-string gnus-large-newsgroup))))
+ (let ((input (read-from-minibuffer
+ (format
+ "How many articles from %s (max %d): "
+ (gnus-limit-string gnus-newsgroup-name 35)
+ number)
+ (static-if (< emacs-major-version 20)
+ (number-to-string gnus-large-newsgroup)
+ (cons
+ (number-to-string gnus-large-newsgroup)
+ 0)))))
(if (string-match "^[ \t]*$" input)
- gnus-large-newsgroup
+ number
input)))
((and (> scored marked) (< scored number)
(> (- scored number) 20))
(uncompressed '(score bookmark killed))
type list newmarked symbol delta-marks)
(when info
- ;; Add all marks lists that are non-nil to the list of marks lists.
+ ;; Add all marks lists to the list of marks lists.
(while (setq type (pop types))
- (when (setq list (symbol-value
+ (setq list (symbol-value
(setq symbol
(intern (format "gnus-newsgroup-%s"
(car type))))))
+ (when list
;; Get rid of the entries of the articles that have the
;; default score.
(when (and (eq (cdr type) 'score)
(setcdr prev (cdr arts))
(setq prev arts))
(setq arts (cdr arts)))
- (setq list (cdr all))))
-
- (when (gnus-check-backend-function 'request-set-mark
- gnus-newsgroup-name)
- ;; score & bookmark are not proper flags (they are cons cells)
- ;; cache is a internal gnus flag
- (unless (memq (cdr type) '(cache score bookmark))
- (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
- (del (gnus-remove-from-range old list))
- (add (gnus-remove-from-range list old)))
- (if add
- (push (list add 'add (list (cdr type))) delta-marks))
- (if del
- (push (list del 'del (list (cdr type))) delta-marks)))))
-
- (push (cons (cdr type)
- (if (memq (cdr type) uncompressed) list
- (gnus-compress-sequence
- (set symbol (sort list '<)) t)))
- newmarked)))
-
- (if delta-marks
- (gnus-request-set-mark gnus-newsgroup-name delta-marks))
-
+ (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)))))
+
+ (when list
+ (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)
;; Update the group buffer.
(gnus-group-update-group group t)))))
-(defun gnus-methods-equal-p (m1 m2)
- (let ((m1 (or m1 gnus-select-method))
- (m2 (or m2 gnus-select-method)))
- (or (equal m1 m2)
- (and (eq (car m1) (car m2))
- (or (not (memq 'address (assoc (symbol-name (car m1))
- gnus-valid-select-methods)))
- (equal (nth 1 m1) (nth 1 m2)))))))
-
(defvar gnus-newsgroup-none-id 0)
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
(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.
;; 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)
`(let ((,articles (gnus-summary-work-articles ,arg)))
(while ,articles
(gnus-summary-goto-subject (car ,articles))
- ,@forms))))
+ ,@forms
+ (pop ,articles)))))
(put 'gnus-summary-iterate 'lisp-indent-function 1)
(put 'gnus-summary-iterate 'edebug-form-spec '(form body))
(redraw-display))
(defun gnus-summary-reselect-current-group (&optional all rescan)
- "Exit and then reselect the current newsgroup.
+ "Rescan the current newsgroup, exit and then reselect it.
The prefix argument ALL means to select all articles."
(interactive "P")
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
(let ((current-subject (gnus-summary-article-number))
(group gnus-newsgroup-name))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ ;; We have to adjust the point of group mode buffer because
+ ;; point was moved to the next unread newsgroup by exiting.
+ (gnus-summary-jump-to-group group)
+ (when rescan
+ (save-excursion
+ (gnus-group-get-new-news-this-group 1))))
(setq gnus-newsgroup-begin nil)
(gnus-summary-exit)
- ;; We have to adjust the point of group mode buffer because
- ;; point was moved to the next unread newsgroup by exiting.
- (gnus-summary-jump-to-group group)
- (when rescan
- (save-excursion
- (gnus-group-get-new-news-this-group 1)))
- (gnus-group-read-group all t)
+ (gnus-group-read-group all t group)
(gnus-summary-goto-subject current-subject nil t)))
(defun gnus-summary-rescan-group (&optional all)
(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)))
(gnus-summary-display-article article all-headers)
(setq did article)
(when (or all-headers gnus-show-all-headers)
- (gnus-article-show-all-headers)))
+ (if (eq 'gnus-summary-toggle-mime this-command)
+ (gnus-article-show-all)
+ (gnus-article-show-all-headers))))
(when (or all-headers gnus-show-all-headers)
(gnus-article-show-all-headers))
'old))
"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 "nTime 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))
(gnus-summary-limit (nreverse articles)))
(gnus-summary-position-point)))
+(defun gnus-summary-limit-to-extra (header regexp)
+ "Limit the summary buffer to articles that match an 'extra' header."
+ (interactive
+ (let ((header
+ (intern
+ (gnus-completing-read
+ (symbol-name (car gnus-extra-headers))
+ "Limit extra header:"
+ (mapcar (lambda (x)
+ (cons (symbol-name x) x))
+ gnus-extra-headers)
+ nil
+ t))))
+ (list header
+ (read-string (format "Limit to header %s (regexp): " header)))))
+ (when (not (equal "" regexp))
+ (prog1
+ (let ((articles (gnus-summary-find-matching
+ (cons 'extra header) regexp 'all)))
+ (unless articles
+ (error "Found no matches for \"%s\"" regexp))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point))))
+
(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
(make-obsolete
'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
(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.
(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))))))))
(let ((data (if (eq backward 'all) gnus-newsgroup-data
(gnus-data-find-list
(gnus-summary-article-number) (gnus-data-list backward))))
- (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
(case-fold-search (not not-case-fold))
- articles d)
- (unless (fboundp (intern (concat "mail-header-" header)))
- (error "%s is not a valid header" header))
+ articles d func)
+ (if (consp header)
+ (if (eq (car header) 'extra)
+ (setq func
+ `(lambda (h)
+ (or (cdr (assq ',(cdr header) (mail-header-extra h)))
+ "")))
+ (error "%s is an invalid header" header))
+ (unless (fboundp (intern (concat "mail-header-" header)))
+ (error "%s is not a valid header" header))
+ (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
(while data
(setq d (car data))
(and (or (not unread) ; We want all articles...
(interactive "P")
(save-excursion
(set-buffer gnus-article-buffer)
- (let* ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (hidden (text-property-any
- (goto-char (point-min)) (search-forward "\n\n")
- 'invisible t))
- e)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (delete-region (point-min) (1- (point))))
- (goto-char (point-min))
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (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)))
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (point-min) (1- (point))))
(goto-char (point-min))
- (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
- (insert-buffer-substring gnus-original-article-buffer 1 e)
- (let ((article-inhibit-hiding t))
- (gnus-run-hooks 'gnus-article-display-hook))
- (if (or (not hidden) (and (numberp arg) (< arg 0)))
- (let ((gnus-treat-hide-headers nil)
- (gnus-treat-hide-boring-headers nil))
- (gnus-treat-article 'head))
- (gnus-treat-article 'head)))))
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
+ (insert-buffer-substring gnus-original-article-buffer 1 e)
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (article-decode-encoded-words)
+ (if (or hidden
+ (and (numberp arg) (< arg 0)))
+ (let ((gnus-treat-hide-headers nil)
+ (gnus-treat-hide-boring-headers nil))
+ (gnus-treat-article 'head))
+ (gnus-treat-article 'head)))))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
(crosspost "Crosspost" "Crossposting")))
(copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*")))
+ (default-marks gnus-article-mark-lists)
+ (no-expire-marks (delete '(expirable . expire)
+ (copy-sequence gnus-article-mark-lists)))
art-group to-method new-xref article to-groups)
(unless (assq action names)
(error "Unknown action %s" action))
art-group))))))
(cond
((not art-group)
- (gnus-message 1 "Couldn't %s article %s"
- (cadr (assq action names)) article))
+ (gnus-message 1 "Couldn't %s article %s: %s"
+ (cadr (assq action names)) article
+ (nnheader-get-report (car to-method))))
((and (eq art-group 'junk)
(eq action 'move))
(gnus-summary-mark-article article gnus-canceled-mark)
(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.
- (let ((marks gnus-article-mark-lists)
+ (let ((marks (if (gnus-group-auto-expirable-p to-group)
+ default-marks
+ no-expire-marks))
(to-article (cdr art-group)))
- (unless (gnus-group-auto-expirable-p to-group)
- (setq marks (delete '(expirable . expire) marks)))
;; See whether the article is to be put in the cache.
(when gnus-use-cache
(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)
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 '"
(gnus-prin1-to-string (gnus-get-info to-group))
;; There are expirable articles in this group, so we run them
;; through the expiry process.
(gnus-message 6 "Expiring articles...")
+ (unless (gnus-check-group gnus-newsgroup-name)
+ (error "Can't open server for %s" gnus-newsgroup-name))
;; The list of articles that weren't expired is returned.
(save-excursion
(if expiry-wait
(interactive "P")
(save-excursion
(set-buffer gnus-summary-buffer)
- (gnus-set-global-variables)
- (when (and (not force)
- (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing"))
- ;; Select article if needed.
- (unless (eq (gnus-summary-article-number)
- gnus-current-article)
- (gnus-summary-select-article t))
- (gnus-article-date-original)
- (gnus-article-edit-article
- `(lambda (no-highlight)
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))
+ (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))
+ (error "The current newsgroup does not support article editing"))
+ (gnus-summary-show-article t)
+ (gnus-article-edit-article
+ 'ignore
+ `(lambda (no-highlight)
+ (let ((mail-parse-charset ',gnus-newsgroup-charset)
+ (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)))))))
(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
(if (and (not read-only)
(not (gnus-request-replace-article
(cdr gnus-article-current) (car gnus-article-current)
- (current-buffer))))
+ (current-buffer) t)))
(error "Couldn't replace article")
;; Update the summary buffer.
(if (and references
(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")
(save-excursion
(gnus-summary-catchup all))
- (gnus-summary-next-article t nil nil t))
+ (gnus-summary-next-group t nil nil))
;; Thread-based commands.
(gnus-summary-sort 'score reverse))
(defun gnus-summary-sort-by-lines (&optional reverse)
- "Sort the summary buffer by article length.
+ "Sort the summary buffer by the number of lines.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'lines reverse))
+(defun gnus-summary-sort-by-chars (&optional reverse)
+ "Sort the summary buffer by article length.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'chars reverse))
+
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
(let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
split-name))
((consp result)
(setq split-name (append result split-name)))))))))
- split-name))
+ (nreverse split-name)))
(defun gnus-valid-move-group-p (group)
(and (boundp group)
(symbol-name group)
(symbol-value group)
- (memq 'respool
- (assoc (symbol-name
- (car (gnus-find-method-for-group
- (symbol-name group))))
- gnus-valid-select-methods))))
+ (gnus-get-function (gnus-find-method-for-group
+ (symbol-name group)) 'request-accept-article t)))
(defun gnus-read-move-group-name (prompt default articles prefix)
"Read a group name."
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
+(defun gnus-summary-save-parts (type dir n 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)
+ current-prefix-arg))
+ (gnus-summary-iterate n
+ (let ((gnus-display-mime-function nil)
+ (gnus-inhibit-treatment t))
+ (gnus-summary-select-article))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect))))
+ (when handles
+ (gnus-summary-save-parts-1 type dir handles reverse)
+ (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 (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)))
+ dir)))
+ (unless (file-exists-p file)
+ (mm-save-part-to-file handle file))))))
+
;; Summary extract commands
(defun gnus-summary-insert-pseudos (pslist &optional not-view)
(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)))))))))
;;;
(defun gnus-mime-extract-message/rfc822 (entity situation)
- (with-current-buffer (mime-entity-buffer entity)
- (save-restriction
- (narrow-to-region (mime-entity-body-start entity)
- (mime-entity-body-end entity))
- (let* ((group (or (cdr (assq 'group 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)))
- cur
- (article (gnus-request-accept-article group))
- (num (or (cdr (assq 'number situation))
- 0)))
- (when (and (consp article)
- (numberp (setq article (cdr article))))
- (incf num)
- (with-current-buffer gnus-summary-buffer
- (setq cur gnus-current-article)
- (forward-line num)
- (let (gnus-show-threads)
- (gnus-summary-goto-subject article t)
+ gnus-newsgroup-name))
+ article (gnus-request-accept-article group)
)
- (gnus-summary-clear-mark-forward 1)
+ ))
+ (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)
)
- (if (boundp 'mime-acting-situation-to-override)
- (progn
- (set-alist 'mime-acting-situation-to-override
- 'group
- group)
- (set-alist 'mime-acting-situation-to-override
- 'after-method
- `(progn
- (save-current-buffer
- (set-buffer gnus-group-buffer)
- (gnus-activate-group ,group)
- )
- (gnus-summary-goto-article ,cur
- gnus-show-all-headers)
- ))
- (set-alist 'mime-acting-situation-to-override
- 'number num)
- )
- (save-current-buffer
- (set-buffer gnus-group-buffer)
- (gnus-activate-group group)
- (set-buffer gnus-summary-buffer)
- (gnus-summary-goto-article cur gnus-show-all-headers)
- )
- ))))))
+ (save-window-excursion
+ (if (setq swin (get-buffer-window gnus-summary-buffer t))
+ (select-window swin)
+ (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-clear-mark-forward 1)
+ (gnus-summary-goto-subject cur)
+ )
+ (when (and cwin (window-frame cwin))
+ (select-frame (window-frame cwin))
+ )
+ (when (boundp 'mime-acting-situation-to-override)
+ (set-alist 'mime-acting-situation-to-override
+ 'group
+ group)
+ (set-alist 'mime-acting-situation-to-override
+ 'after-method
+ `(progn
+ (save-current-buffer
+ (set-buffer gnus-group-buffer)
+ (gnus-activate-group ,group)
+ )
+ (gnus-summary-goto-article ,cur
+ gnus-show-all-headers)
+ ))
+ (set-alist 'mime-acting-situation-to-override
+ 'number num)
+ )
+ )))
(mime-add-condition
'action '((type . message)(subtype . rfc822)
(defun gnus-summary-setup-default-charset ()
"Setup newsgroup default charset."
- (let ((name (and gnus-newsgroup-name
- (gnus-group-real-name gnus-newsgroup-name))))
+ (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 (and gnus-newsgroup-name
- (or (gnus-group-find-parameter gnus-newsgroup-name '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 nil))
(while (setq elem (pop alist))
(setq alist nil
charset (cadr elem))))
charset)))
- gnus-default-charset))))
+ gnus-default-charset))
+ (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
+ ignored-charsets))))
;;;
;;; Mime Commands
(gnus-summary-show-article))
(gnus-summary-show-article)))
+;;;
+;;; Intelli-mouse commmands
+;;;
+
+(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)
+
+;;;
+;;; 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))
+
+;;;
+;;; Generic summary marking commands
+;;;
+
+(defvar gnus-summary-marking-alist
+ '((read gnus-del-mark "d")
+ (unread gnus-unread-mark "u")
+ (ticked gnus-ticked-mark "!")
+ (dormant gnus-dormant-mark "?")
+ (expirable gnus-expirable-mark "e"))
+ "An alist of names/marks/keystrokes.")
+
+(defvar gnus-summary-generic-mark-map (make-sparse-keymap))
+(defvar gnus-summary-mark-map)
+
+(defun gnus-summary-make-all-marking-commands ()
+ (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map)
+ (dolist (elem gnus-summary-marking-alist)
+ (apply 'gnus-summary-make-marking-command elem)))
+
+(defun gnus-summary-make-marking-command (name mark keystroke)
+ (let ((map (make-sparse-keymap)))
+ (define-key gnus-summary-generic-mark-map keystroke map)
+ (dolist (lway `((next "next" next nil "n")
+ (next-unread "next unread" next t "N")
+ (prev "previous" prev nil "p")
+ (prev-unread "previous unread" prev t "P")
+ (nomove "" nil nil ,keystroke)))
+ (let ((func (gnus-summary-make-marking-command-1
+ 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 ,(intern
+ (format "gnus-summary-put-mark-as-%s%s"
+ name (if (eq way 'nomove)
+ ""
+ (concat "-" (symbol-name way)))))
+ (n)
+ ,(format
+ "Mark the current article as %s%s.
+If N, the prefix, then repeat N times.
+If N is negative, move in reverse order.
+The difference between N and the actual number of articles marked is
+returned."
+ name (cadr 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)
+ (error "This command can only be used in the summary buffer"))
+ (gnus-summary-show-thread)
+ (let ((nummove
+ (cond
+ ((eq move 'next) 1)
+ ((eq move 'prev) -1)
+ (t 0))))
+ (if (zerop nummove)
+ (setq n 1)
+ (when (< n 0)
+ (setq n (abs n)
+ nummove (* -1 nummove))))
+ (while (and (> n 0)
+ (gnus-summary-mark-article nil mark)
+ (zerop (gnus-summary-next-subject nummove unread t)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ n))
+
+(gnus-summary-make-all-marking-commands)
+
(gnus-ems-redefine)
(provide 'gnus-sum)
projects / elisp / gnus.git- / blobdiff