(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 '(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-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)
(defvar gnus-newsgroup-selected-overlay nil)
(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.
(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
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))
(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)
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))
(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)
(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
(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
(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)
((eq 'current gnus-refer-article-method)
(list gnus-current-select-method))
;; List of select methods.
- ((not (stringp (cadr gnus-refer-article-method)))
+ ((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)
;; the parent article.
(when (setq to-address (or (message-fetch-field "reply-to")
(message-fetch-field "from")))
- (setq params (append (list (cons 'to-address to-address)))))
+ (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
(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)))
+ (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))
(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)
'ignore
`(lambda (no-highlight)
(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
(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)
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)
"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: " nil 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)
- (mm-destroy-parts handles))))))
+ (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))
(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.
projects / elisp / gnus.git- / blobdiff