diff options
Diffstat (limited to 'lisp/gnus/gnus-art.el')
| -rw-r--r-- | lisp/gnus/gnus-art.el | 91 |
1 files changed, 39 insertions, 52 deletions
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index b712cf53efb..28ee174597b 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)) @@ -279,7 +278,7 @@ This can also be a list of the above values." "String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." - :type `(choice string + :type '(choice string (function-item gnus-display-x-face-in-from) function) :version "21.1" @@ -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))))))) @@ -2946,7 +2935,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) @@ -3029,9 +3019,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)." @@ -3636,8 +3623,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)))) @@ -4402,8 +4388,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is ;;; Gnus article mode ;;; -(put 'gnus-article-mode 'mode-class 'special) - (set-keymap-parent gnus-article-mode-map widget-keymap) (gnus-define-keys gnus-article-mode-map @@ -4481,9 +4465,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defvar bookmark-make-record-function) (defvar shr-put-image-function) -(define-derived-mode gnus-article-mode fundamental-mode "Article" +(define-derived-mode gnus-article-mode gnus-mode "Article" "Major mode for displaying an article. - All normal editing commands are switched off. The following commands are available in addition to all summary mode @@ -4524,8 +4507,7 @@ commands: (setq cursor-in-non-selected-windows nil)) (gnus-set-default-directory) (buffer-disable-undo) - (setq buffer-read-only t - show-trailing-whitespace nil) + (setq show-trailing-whitespace nil) (mm-enable-multibyte)) (defun gnus-article-setup-buffer () @@ -4725,6 +4707,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)))))) @@ -5168,7 +5155,7 @@ Deleting parts may malfunction or destroy the article; continue? ")) "`----\n")) (setcdr data (cdr (mm-make-handle - nil `("text/plain" (charset . gnus-decoded)) nil nil + nil '("text/plain" (charset . gnus-decoded)) nil nil (list "attachment") (format "Deleted attachment (%s bytes)" bsize)))))) ;; (set-buffer gnus-summary-buffer) @@ -5228,7 +5215,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))))) @@ -6696,7 +6683,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 @@ -6762,7 +6749,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) @@ -7060,9 +7048,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 @@ -8238,7 +8225,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 |