diff options
Diffstat (limited to 'lisp/gnus/gnus-sum.el')
-rw-r--r-- | lisp/gnus/gnus-sum.el | 160 |
1 files changed, 68 insertions, 92 deletions
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 5bd58b690af..456e7b0f8c4 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3186,7 +3186,7 @@ The following commands are available: ;; Copy the global value of the variable. (symbol-value (car local)) ;; Use the value from the list. - (eval (cdr local))))) + (eval (cdr local) t)))) (set (make-local-variable (car local)) global)) ;; Simple nil-valued local variable. (set (make-local-variable local) nil)))) @@ -3339,18 +3339,18 @@ article number." ,(or number (inline-quote (gnus-summary-article-number))))))) -(defmacro gnus-summary-thread-level (&optional number) +(defsubst gnus-summary-thread-level (&optional number) "Return the level of thread that starts with article NUMBER." - `(if (and (eq gnus-summary-make-false-root 'dummy) - (get-text-property (point) 'gnus-intangible)) - 0 - (gnus-data-level (gnus-data-find - ,(or number '(gnus-summary-article-number)))))) + (if (and (eq gnus-summary-make-false-root 'dummy) + (get-text-property (point) 'gnus-intangible)) + 0 + (gnus-data-level (gnus-data-find + (or number (gnus-summary-article-number)))))) -(defmacro gnus-summary-article-mark (&optional number) +(defsubst gnus-summary-article-mark (&optional number) "Return the mark of article NUMBER." - `(gnus-data-mark (gnus-data-find - ,(or number '(gnus-summary-article-number))))) + (gnus-data-mark (gnus-data-find + (or number (gnus-summary-article-number))))) (defmacro gnus-summary-article-pos (&optional number) "Return the position of the line of article NUMBER." @@ -3850,7 +3850,7 @@ buffer that was in action when the last article was fetched." (condition-case () (put-text-property (point) - (progn (eval gnus-summary-line-format-spec) (point)) + (progn (eval gnus-summary-line-format-spec t) (point)) 'gnus-number gnus-tmp-number) (error (gnus-message 5 "Error updating the summary line"))) (when (gnus-visual-p 'summary-highlight 'highlight) @@ -3971,14 +3971,14 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (my-format "%b %d '%y")) (let* ((difference (time-subtract now messy-date)) (templist gnus-user-date-format-alist) - (top (eval (caar templist)))) + (top (eval (caar templist) t))) (while (if (numberp top) (time-less-p top difference) (not top)) (progn (setq templist (cdr templist)) - (setq top (eval (caar templist))))) + (setq top (eval (caar templist) t)))) (if (stringp (cdr (car templist))) (setq my-format (cdr (car templist))))) - (format-time-string (eval my-format) messy-date)) + (format-time-string (eval my-format t) messy-date)) (error " ? "))) (defun gnus-summary-set-local-parameters (group) @@ -3997,8 +3997,8 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." ;; buffer-local, whereas just parameters like `gcc-self', ;; `timestamp', etc. should not be bound as variables. (if (boundp (car elem)) - (set (make-local-variable (car elem)) (eval (nth 1 elem))) - (eval (nth 1 elem)))))))) + (set (make-local-variable (car elem)) (eval (nth 1 elem) t)) + (eval (nth 1 elem) t))))))) (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer no-display backward @@ -5557,7 +5557,7 @@ or a straight list of headers." (setq gnus-tmp-thread thread) (put-text-property (point) - (progn (eval gnus-summary-line-format-spec) (point)) + (progn (eval gnus-summary-line-format-spec t) (point)) 'gnus-number number) (when gnus-visual-p (forward-line -1) @@ -5658,21 +5658,10 @@ or a straight list of headers." (setf (mail-header-subject header) subject)))))) (defun gnus-fetch-headers (articles &optional limit force-new dependencies) - "Fetch headers of ARTICLES. -This calls the `gnus-retrieve-headers' function of the current -group's backend server. The server can do one of two things: - -1. Write the headers for ARTICLES into the - `nntp-server-buffer' (the current buffer) in a parseable format, or -2. Return the headers directly as a list of vectors. - -In the first case, `gnus-retrieve-headers' returns a symbol -value, either `nov' or `headers'. This value determines which -parsing function is used to read the headers. It is also stored -into the variable `gnus-headers-retrieved-by', which is consulted -later when possibly building full threads." + "Fetch headers of ARTICLES." (gnus-message 7 "Fetching headers for %s..." gnus-newsgroup-name) - (let ((res (setq gnus-headers-retrieved-by + (prog1 + (pcase (setq gnus-headers-retrieved-by (gnus-retrieve-headers articles gnus-newsgroup-name (or limit @@ -5682,34 +5671,22 @@ later when possibly building full threads." (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) (> (length articles) 1)) - gnus-fetch-old-headers)))))) - (prog1 - (pcase res - ('nov - (gnus-get-newsgroup-headers-xover - articles force-new dependencies gnus-newsgroup-name t)) - ;; For now, assume that any backend returning its own - ;; headers takes some effort to do so, so return `headers'. - ((pred listp) - (setq gnus-headers-retrieved-by 'headers) - (let ((dependencies - (or dependencies - (buffer-local-value - 'gnus-newsgroup-dependencies gnus-summary-buffer)))) - (when (functionp gnus-alter-header-function) - (mapc gnus-alter-header-function res)) - (mapc (lambda (header) - ;; The agent or the cache may have already - ;; registered this header in the dependency - ;; table. - (unless (gethash (mail-header-id header) dependencies) - (gnus-dependencies-add-header - header dependencies force-new))) - res) - res)) - (_ (gnus-get-newsgroup-headers dependencies force-new))) - (gnus-message 7 "Fetching headers for %s...done" - gnus-newsgroup-name)))) + gnus-fetch-old-headers)))) + ('nov + (gnus-get-newsgroup-headers-xover + articles force-new dependencies gnus-newsgroup-name t)) + ('headers + (gnus-get-newsgroup-headers dependencies force-new)) + ((pred listp) + (let ((dependencies + (or dependencies + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-dependencies)))) + (delq nil (mapcar #'(lambda (header) + (gnus-dependencies-add-header + header dependencies force-new)) + gnus-headers-retrieved-by))))) + (gnus-message 7 "Fetching headers for %s...done" gnus-newsgroup-name))) (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. @@ -6288,7 +6265,7 @@ If WHERE is `summary', the summary mode line format will be used." "")) bufname-length max-len gnus-tmp-header) ;; passed as argument to any user-format-funcs - (setq mode-string (eval mformat)) + (setq mode-string (eval mformat t)) (setq bufname-length (if (string-match "%b" mode-string) (- (length (buffer-name @@ -6466,10 +6443,6 @@ The resulting hash table is returned, or nil if no Xrefs were found." (unless (gnus-ephemeral-group-p group) (gnus-group-update-group group t)))))) -;; FIXME: Refactor this with `gnus-get-newsgroup-headers-xover' and -;; extract the necessary bits for the direct-header-return case. Also -;; look at this and see how similar it is to -;; `nnheader-parse-naked-head'. (defun gnus-get-newsgroup-headers (&optional dependencies force-new) (let ((dependencies (or dependencies @@ -7890,7 +7863,7 @@ If BACKWARD, the previous article is selected instead of the next." (switch-to-buffer gnus-group-buffer) (when group (gnus-group-jump-to-group group)) - (eval (cadr (assq key keystrokes))) + (eval (cadr (assq key keystrokes)) t) (setq group (gnus-group-group-name)) (switch-to-buffer obuf)) (setq ended nil)) @@ -10644,6 +10617,8 @@ confirmation before the articles are deleted." (gnus-set-mode-line 'summary) not-deleted)) +(defvar message-options-set-recipient) + (defun gnus-summary-edit-article (&optional arg) "Edit the current article. This will have permanent effect only in mail groups. @@ -10701,31 +10676,32 @@ groups." (setq mml-buffer-list mbl) (setq-local mml-buffer-list mbl1)) (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)))) - `(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) - (rfc2047-header-encoding-alist - ',(let ((charset (gnus-group-name-charset - (gnus-find-method-for-group - gnus-newsgroup-name) - gnus-newsgroup-name))) - (append (list (cons "Newsgroups" charset) - (cons "Followup-To" charset) - (cons "Xref" charset)) - rfc2047-header-encoding-alist)))) - ,(if (not raw) '(progn - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - #'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list))) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight)))))))) + (let ((charset gnus-newsgroup-charset) + (ign-cs gnus-newsgroup-ignored-charsets) + (hea (let ((charset (gnus-group-name-charset + (gnus-find-method-for-group + gnus-newsgroup-name) + gnus-newsgroup-name))) + (append (list (cons "Newsgroups" charset) + (cons "Followup-To" charset) + (cons "Xref" charset)) + rfc2047-header-encoding-alist))) + (gch (or (mail-header-references gnus-current-headers) "")) + (ro (gnus-group-read-only-p)) + (buf gnus-summary-buffer)) + (lambda (no-highlight) + (let ((mail-parse-charset charset) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets ign-cs) + (rfc2047-header-encoding-alist hea)) + (unless raw + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + #'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list)) + (gnus-summary-edit-article-done gch ro buf no-highlight))))))))) (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) @@ -12393,7 +12369,7 @@ save those articles instead." ;; Form. (save-restriction (widen) - (setq result (eval match))))) + (setq result (eval match t))))) (setq split-name (cdr method)) (cond ((stringp result) (push (expand-file-name @@ -12983,7 +12959,7 @@ treated as multipart/mixed." (nomove "" nil nil ,keystroke))) (let ((func (gnus-summary-make-marking-command-1 mark (car lway) lway name))) - (setq func (eval func)) + (setq func (eval func t)) (define-key map (nth 4 lway) func))))) (defun gnus-summary-make-marking-command-1 (mark way lway name) |