(require 'gnus-range)
(require 'gnus-int)
(require 'gnus-undo)
+(require 'gnus-util)
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(defcustom gnus-kill-summary-on-exit t
"c" gnus-summary-copy-article
"B" gnus-summary-crosspost-article
"q" gnus-summary-respool-query
+ "t" gnus-summary-respool-trace
"i" gnus-summary-import-article
"p" gnus-summary-article-posted-p)
(gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name)]
["Query respool" gnus-summary-respool-query t]
+ ["Trace respool" gnus-summary-respool-trace t]
["Delete expirable articles" gnus-summary-expire-articles-now
(gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name)])
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
(setq gnus-tmp-lines 0))
- (gnus-put-text-property
+ (gnus-put-text-property-excluding-characters-with-faces
(point)
(progn (eval gnus-summary-line-format-spec) (point))
'gnus-number gnus-tmp-number)
;; Yuk! This is a reference loop. Make the article be a
;; root article.
(progn
- (debug)
(mail-header-set-references (car (symbol-value id-dep)) "none")
(setq ref nil))
(setq ref (gnus-parent-id (mail-header-references ref-header)))))
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
+ (gnus-summary-ignore-duplicates t)
header references generation relations
cthread subject child end pthread relation new-child date)
;; First we create an alist of generations/relations, where
generation 0)
(while (search-backward ">" nil t)
(setq end (1+ (point)))
- (if (search-backward "<" nil t)
- (push (list (incf generation)
- child (setq child new-child)
- subject date)
- relations)))
- (push (list (1+ generation) child nil subject) relations)
+ (when (search-backward "<" nil t)
+ (setq new-child (buffer-substring (point) end))
+ (push (list (incf generation)
+ child (setq child new-child)
+ subject date)
+ relations)))
+ (when child
+ (push (list (1+ generation) child nil subject) relations))
(erase-buffer)))
(kill-buffer (current-buffer)))
;; Sort over trustworthiness.
(when (gnus-dependencies-add-header
(make-full-mail-header
gnus-reffed-article-number
- (nth 3 relation) "" (nth 4 relation)
+ (nth 3 relation) "" (or (nth 4 relation) "")
(nth 1 relation)
(or (nth 2 relation) "") 0 0 "")
gnus-newsgroup-dependencies nil)
(headers in-headers)
references)
(while (and parent
- headers
(not (zerop generation))
(setq references (mail-header-references headers)))
- (when (and references
- (setq parent (gnus-parent-id references))
- (setq headers (car (gnus-id-to-thread parent))))
- (decf generation)))
+ (setq headers (if (and references
+ (setq parent (gnus-parent-id references)))
+ (car (gnus-id-to-thread parent))
+ nil))
+ (decf generation))
(and (not (eq headers in-headers))
headers)))
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
(setq gnus-tmp-lines 0))
- (gnus-put-text-property
+ (gnus-put-text-property-excluding-characters-with-faces
(point)
(progn (eval gnus-summary-line-format-spec) (point))
'gnus-number number)
(defun gnus-update-marks ()
"Enter the various lists of marked articles into the newsgroup info list."
- (let ((types (gnus-delete-alist 'cached
- (copy-sequence gnus-article-mark-lists)))
+ (let ((types gnus-article-mark-lists)
(info (gnus-get-info gnus-newsgroup-name))
(uncompressed '(score bookmark killed))
type list newmarked symbol)
;; Just return the current article.
(list (gnus-summary-article-number))))))
+(defmacro gnus-summary-iterate (arg &rest forms)
+ "Iterate over the process/prefixed articles and do FORMS.
+ARG is the interactive prefix given to the command. FORMS will be
+executed with point over the summary line of the articles."
+ (let ((articles (make-symbol "gnus-summary-iterate-articles")))
+ `(let ((,articles (gnus-summary-work-articles ,arg)))
+ (while ,articles
+ (gnus-summary-goto-subject (car ,articles))
+ ,@forms))))
+
+(put 'gnus-summary-iterate 'lisp-indent-function 1)
+(put 'gnus-summary-iterate 'edebug-form-spec '(form body))
+
(defun gnus-summary-save-process-mark ()
"Push the current set of process marked articles on the stack."
(interactive)
(gnus-message 3 "Can't find article %d" article))
nil)
(goto-char (gnus-data-pos data))
+ (gnus-summary-position-point)
article)))
;; Walking around summary lines with displaying articles.
'<)
(sort gnus-newsgroup-limit '<)))
article)
- (setq gnus-newsgroup-unreads gnus-newsgroup-limit)
+ (setq gnus-newsgroup-unreads
+ (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-limit))
(if all
(setq gnus-newsgroup-dormant nil
gnus-newsgroup-marked nil
"Make edits to the current article permanent."
(interactive)
;; Replace the article.
- (if (and (not read-only)
- (not (gnus-request-replace-article
- (cdr gnus-article-current) (car gnus-article-current)
- (current-buffer))))
- (error "Couldn't replace article")
- ;; Update the summary buffer.
- (if (and references
- (equal (message-tokenize-header references " ")
- (message-tokenize-header
- (or (message-fetch-field "references") "") " ")))
- ;; We only have to update this line.
- (save-excursion
- (save-restriction
- (message-narrow-to-head)
- (let ((head (buffer-string))
- header)
- (nnheader-temp-write nil
- (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
- (save-excursion
- (set-buffer gnus-summary-buffer)
- gnus-newsgroup-dependencies)
- t))))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-data-set-header
- (gnus-data-find (cdr gnus-article-current))
- header)
- (gnus-summary-update-article-line
- (cdr gnus-article-current) header))))))
- ;; Update threads.
- (set-buffer (or buffer gnus-summary-buffer))
- (gnus-summary-update-article (cdr gnus-article-current)))
- ;; Prettify the article buffer again.
- (unless no-highlight
- (save-excursion
- (set-buffer gnus-article-buffer)
- (gnus-run-hooks 'gnus-article-display-hook)
- (set-buffer gnus-original-article-buffer)
- (gnus-request-article
- (cdr gnus-article-current)
- (car gnus-article-current) (current-buffer))))
- ;; Prettify the summary buffer line.
- (when (gnus-visual-p 'summary-highlight 'highlight)
- (gnus-run-hooks 'gnus-visual-mark-article-hook))))
+ (let ((buf (current-buffer)))
+ (nnheader-temp-write nil
+ (insert-buffer buf)
+ (if (and (not read-only)
+ (not (gnus-request-replace-article
+ (cdr gnus-article-current) (car gnus-article-current)
+ (current-buffer))))
+ (error "Couldn't replace article")
+ ;; Update the summary buffer.
+ (if (and references
+ (equal (message-tokenize-header references " ")
+ (message-tokenize-header
+ (or (message-fetch-field "references") "") " ")))
+ ;; We only have to update this line.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((head (buffer-string))
+ header)
+ (nnheader-temp-write nil
+ (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
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-dependencies)
+ t))))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-data-set-header
+ (gnus-data-find (cdr gnus-article-current))
+ header)
+ (gnus-summary-update-article-line
+ (cdr gnus-article-current) header))))))
+ ;; Update threads.
+ (set-buffer (or buffer gnus-summary-buffer))
+ (gnus-summary-update-article (cdr gnus-article-current)))
+ ;; Prettify the article buffer again.
+ (unless no-highlight
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (gnus-run-hooks 'gnus-article-display-hook)
+ (set-buffer gnus-original-article-buffer)
+ (gnus-request-article
+ (cdr gnus-article-current)
+ (car gnus-article-current) (current-buffer))))
+ ;; Prettify the summary buffer line.
+ (when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-run-hooks 'gnus-visual-mark-article-hook))))))
(defun gnus-summary-edit-wash (key)
"Perform editing command KEY in the article buffer."
;;; Respooling
-(defun gnus-summary-respool-query (&optional silent)
+(defun gnus-summary-respool-query (&optional silent trace)
"Query where the respool algorithm would put this article."
(interactive)
(let (gnus-mark-article-hook)
(set-buffer gnus-original-article-buffer)
(save-restriction
(message-narrow-to-head)
- (let ((groups (nnmail-article-group 'identity)))
+ (let ((groups (nnmail-article-group 'identity trace)))
(unless silent
(if groups
(message "This message would go to %s"
(message "This message would go to no groups"))
groups))))))
+(defun gnus-summary-respool-trace ()
+ "Trace where the respool algorithm would put this article.
+Display a buffer showing all fancy splitting patterns which matched."
+ (interactive)
+ (gnus-summary-respool-query nil t))
+
;; Summary marking commands.
(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
(setq list (cdr list))))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property
+ (gnus-put-text-property-excluding-characters-with-faces
beg end 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
projects / elisp / gnus.git- / blobdiff