diff options
Diffstat (limited to 'lisp/gnus/gnus-art.el')
| -rw-r--r-- | lisp/gnus/gnus-art.el | 79 |
1 files changed, 35 insertions, 44 deletions
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 15e88a34227..1b0dde94551 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -24,8 +24,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defvar tool-bar-map) (defvar w3m-minor-mode-map) @@ -199,9 +198,9 @@ Possible values in this list are: `newsgroups' Newsgroup identical to Gnus group. `to-address' To identical to To-address. `to-list' To identical to To-list. - `cc-list' CC identical to To-list. - `followup-to' Followup-to identical to Newsgroups. - `reply-to' Reply-to identical to From. + `cc-list' Cc identical to To-list. + `followup-to' Followup-To identical to Newsgroups. + `reply-to' Reply-To identical to From. `date' Date less than four days old. `long-to' To and/or Cc longer than 1024 characters. `many-to' Multiple To and/or Cc." @@ -209,9 +208,9 @@ Possible values in this list are: (const :tag "Newsgroups identical to Gnus group." newsgroups) (const :tag "To identical to To-address." to-address) (const :tag "To identical to To-list." to-list) - (const :tag "CC identical to To-list." cc-list) - (const :tag "Followup-to identical to Newsgroups." followup-to) - (const :tag "Reply-to identical to From." reply-to) + (const :tag "Cc identical to To-list." cc-list) + (const :tag "Followup-To identical to Newsgroups." followup-to) + (const :tag "Reply-To identical to From." reply-to) (const :tag "Date less than four days old." date) (const :tag "To and/or Cc longer than 1024 characters." long-to) (const :tag "Multiple To and/or Cc headers." many-to)) @@ -761,9 +760,6 @@ Obsolete; use the face `gnus-signature' for customizations instead." "Face used for highlighting a signature in the article buffer." :group 'gnus-article-highlight :group 'gnus-article-signature) -;; backward-compatibility alias -(put 'gnus-signature-face 'face-alias 'gnus-signature) -(put 'gnus-signature-face 'obsolete-face "22.1") (defface gnus-header-from '((((class color) @@ -777,9 +773,6 @@ Obsolete; use the face `gnus-signature' for customizations instead." "Face used for displaying from headers." :group 'gnus-article-headers :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-from-face 'face-alias 'gnus-header-from) -(put 'gnus-header-from-face 'obsolete-face "22.1") (defface gnus-header-subject '((((class color) @@ -793,9 +786,6 @@ Obsolete; use the face `gnus-signature' for customizations instead." "Face used for displaying subject headers." :group 'gnus-article-headers :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-subject-face 'face-alias 'gnus-header-subject) -(put 'gnus-header-subject-face 'obsolete-face "22.1") (defface gnus-header-newsgroups '((((class color) @@ -811,9 +801,6 @@ In the default setup this face is only used for crossposted articles." :group 'gnus-article-headers :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups) -(put 'gnus-header-newsgroups-face 'obsolete-face "22.1") (defface gnus-header-name '((((class color) @@ -827,9 +814,6 @@ articles." "Face used for displaying header names." :group 'gnus-article-headers :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-name-face 'face-alias 'gnus-header-name) -(put 'gnus-header-name-face 'obsolete-face "22.1") (defface gnus-header-content '((((class color) @@ -842,9 +826,6 @@ articles." (:italic t))) "Face used for displaying header content." :group 'gnus-article-headers :group 'gnus-article-highlight) -;; backward-compatibility alias -(put 'gnus-header-content-face 'face-alias 'gnus-header-content) -(put 'gnus-header-content-face 'obsolete-face "22.1") (defcustom gnus-header-face-alist '(("From" nil gnus-header-from) @@ -1645,6 +1626,12 @@ resources when reading email groups (and therefore stops tracking), but allows loading external resources when reading from NNTP newsgroups and the like. +People controlling these external resources won't be able to tell +that any one person in particular has read the message (since +it's in a public venue, many people will end up loading that +resource), but they'll be able to tell that somebody from your IP +address has accessed the resource. + This can also be a function to be evaluated. If so, it will be called with the group name as the parameter, and should return a regexp." @@ -1826,7 +1813,7 @@ Initialized from `text-mode-syntax-table'.") (if (looking-at (car list)) (setq list nil) (setq list (cdr list)) - (incf i))) + (cl-incf i))) i)) (defun article-hide-headers (&optional _arg _delete) @@ -1966,7 +1953,7 @@ always hide." (when (and cc to-list (ignore-errors (gnus-string-equal - ;; only one address in CC + ;; only one address in Cc (nth 1 (mail-extract-address-components cc)) to-list))) (gnus-article-hide-header "cc")))) @@ -2236,7 +2223,7 @@ unfolded." (dolist (elem gnus-article-image-alist) (gnus-delete-images (car elem)))))) -(autoload 'w3m-toggle-inline-images "w3m") +(declare-function w3m-toggle-inline-images "w3m") (defun gnus-article-show-images () "Show any images that are in the HTML-rendered article buffer. @@ -2246,10 +2233,12 @@ This only works if the article in question is HTML." (save-restriction (widen) (if (eq mm-text-html-renderer 'w3m) - (w3m-toggle-inline-images) + (progn + (require 'w3m) + (w3m-toggle-inline-images)) (dolist (region (gnus-find-text-property-region (point-min) (point-max) 'image-displayer)) - (destructuring-bind (start end function) region + (cl-destructuring-bind (start end function) region (funcall function (get-text-property start 'image-url) start end))))))) @@ -2948,7 +2937,8 @@ message header will be added to the bodies of the \"text/html\" parts." (encode-coding-string title coding)) body content)) - (setq eheader (string-as-unibyte (buffer-string)) + (setq eheader (encode-coding-string + (buffer-string) 'utf-8) body content))) (erase-buffer) (mm-disable-multibyte) @@ -3031,9 +3021,6 @@ articles to verify whether you have read the message. As browser without eliminating these \"web bugs\" you should only use it for mails from trusted senders. -If you always want to display HTML parts in the browser, set -`mm-text-html-renderer' to nil. - This command creates temporary files to pass HTML contents including images if any to the browser, and deletes them when exiting the group \(if you want)." @@ -3638,8 +3625,7 @@ possible values." (defun article-lapsed-string (time &optional max-segments) ;; If the date is seriously mangled, the timezone functions are ;; liable to bug out, so we ignore all errors. - (let* ((now (current-time)) - (real-time (time-subtract now time)) + (let* ((real-time (time-subtract nil time)) (real-sec (and real-time (+ (* (float (car real-time)) 65536) (cadr real-time)))) @@ -4727,6 +4713,11 @@ If ALL-HEADERS is non-nil, no headers are hidden." (forward-line -1)) (set-window-point (get-buffer-window (current-buffer)) (point)) (gnus-configure-windows 'article) + ;; Make sure the article begins with the top of the header. + (let ((window (get-buffer-window gnus-article-buffer))) + (when window + (with-current-buffer (window-buffer window) + (set-window-point window (point-min))))) (gnus-run-hooks 'gnus-article-prepare-hook) t)))))) @@ -5230,7 +5221,7 @@ available media-types." (gnus-completing-read "View as MIME type" (if pred - (gnus-remove-if-not pred (mailcap-mime-types)) + (seq-filter pred (mailcap-mime-types)) (mailcap-mime-types)) nil nil nil (car default))))) @@ -6698,7 +6689,7 @@ not have a face in `gnus-article-boring-faces'." (interactive "P") (gnus-article-check-buffer) (let ((nosaves - '("q" "Q" "c" "r" "\C-c\C-f" "m" "a" "f" "WDD" "WDW" + '("q" "Q" "r" "\C-c\C-f" "m" "a" "f" "WDD" "WDW" "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "^" "\M-^" "|")) (nosave-but-article @@ -6764,7 +6755,8 @@ not have a face in `gnus-article-boring-faces'." ;; We disable the pick minor mode commands. (setq func (let (gnus-pick-mode) (key-binding keys t))) - (when (get func 'disabled) + (when (and (symbolp func) + (get func 'disabled)) (error "Function %s disabled" func)) (if (and func (functionp func) @@ -7062,9 +7054,8 @@ If given a prefix, show the hidden text instead." ;; equivalent of string-make-multibyte which amount to decoding ;; with locale-coding-system, causing failure of ;; subsequent decoding. - (insert (string-to-multibyte - (with-current-buffer gnus-original-article-buffer - (buffer-substring (point-min) (point-max))))) + (insert (with-current-buffer gnus-original-article-buffer + (buffer-substring (point-min) (point-max)))) 'article) ;; Check the backlog. ((and gnus-keep-backlog @@ -8240,7 +8231,7 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-button-handle-news (url) "Fetch a news URL." - (destructuring-bind (_scheme server port group message-id _articles) + (cl-destructuring-bind (_scheme server port group message-id _articles) (gnus-parse-news-url url) (cond (message-id |