X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=9ddb19fab09917e6ac0d0be459e28229215d27bc;hb=653e762433a2166fdb1481b0ad71b7a4ad867586;hp=2c6a98fe190770bb3b5d27b9faec30f3cdfd7542;hpb=febc3406e33b59d0f3b90bc0a2b452f0f8b83e7a;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 2c6a98fe1..9ddb19fab 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,5 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -26,7 +26,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (defvar tool-bar-map)) (require 'gnus) (require 'gnus-sum) @@ -39,14 +41,16 @@ (require 'mm-view) (require 'wid-edit) (require 'mm-uu) +(require 'message) (autoload 'gnus-msg-mail "gnus-msg" nil t) (autoload 'gnus-button-mailto "gnus-msg") (autoload 'gnus-button-reply "gnus-msg" nil t) +(autoload 'ansi-color-apply-on-region "ansi-color") (defgroup gnus-article nil "Article display." - :link '(custom-manual "(gnus)The Article Buffer") + :link '(custom-manual "(gnus)Article Buffer") :group 'gnus) (defgroup gnus-article-treat nil @@ -146,7 +150,7 @@ "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway" "X-Local-Origin" "X-Local-Destination" "X-UserInfo1" "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications" - "X-Abuse-and-DMCA-Info" "X-Postfilter")) + "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer")) "*All headers that start with this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." @@ -240,8 +244,8 @@ regexp. If it matches, the text in question is not a signature." :type 'sexp :group 'gnus-article-hiding) -;; Fixme: This isn't the right thing for mixed graphical and and -;; non-graphical frames in a session. +;; Fixme: This isn't the right thing for mixed graphical and non-graphical +;; frames in a session. (defcustom gnus-article-x-face-command (if (featurep 'xemacs) (if (or (gnus-image-type-available-p 'xface) @@ -393,7 +397,9 @@ and the latter avoids underlining any whitespace at all." Example: (_/*word*/_)." :group 'gnus-article-emphasis) -(defface gnus-emphasis-strikethru '((t (:strikethru t))) +(defface gnus-emphasis-strikethru (if (featurep 'xemacs) + '((t (:strikethru t))) + '((t (:strike-through t)))) "Face used for displaying strike-through text (-word-)." :group 'gnus-article-emphasis) @@ -557,8 +563,7 @@ The following additional specs are available: :type 'hook :group 'gnus-article-various) -(defvar gnus-article-hide-pgp-hook nil) -(make-obsolete-variable 'gnus-article-hide-pgp-hook +(make-obsolete-variable 'gnus-article-hide-pgp-hook "This variable is obsolete in Gnus 5.10.") (defcustom gnus-article-button-face 'bold @@ -626,7 +631,9 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (:foreground "MidnightBlue" :italic t)) (t (:italic t))) - "Face used for displaying newsgroups headers." + "Face used for displaying newsgroups headers. +In the default setup this face is only used for crossposted +articles." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -660,17 +667,17 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." ("Subject" nil gnus-header-subject-face) ("Newsgroups:.*," nil gnus-header-newsgroups-face) ("" gnus-header-name-face gnus-header-content-face)) - "*Controls highlighting of article header. + "*Controls highlighting of article headers. An alist of the form (HEADER NAME CONTENT). -HEADER is a regular expression which should match the name of an -header header and NAME and CONTENT are either face names or nil. +HEADER is a regular expression which should match the name of a +header and NAME and CONTENT are either face names or nil. The name of each header field will be displayed using the face -specified by the first element in the list where HEADER match the -header name and NAME is non-nil. Similarly, the content will be -displayed by the first non-nil matching CONTENT face." +specified by the first element in the list where HEADER matches +the header name and NAME is non-nil. Similarly, the content will +be displayed by the first non-nil matching CONTENT face." :group 'gnus-article-headers :group 'gnus-article-highlight :type '(repeat (list (regexp :tag "Header") @@ -683,7 +690,7 @@ displayed by the first non-nil matching CONTENT face." (defcustom gnus-article-decode-hook '(article-decode-charset article-decode-encoded-words - article-decode-group-name) + article-decode-group-name article-decode-idna-rhs) "*Hook run to decode charsets in articles." :group 'gnus-article-headers :type 'hook) @@ -748,6 +755,7 @@ When nil (the default value), then some MIME parts do not get buttons, as described by the variables `gnus-buttonized-mime-types' and `gnus-unbuttonized-mime-types'." :version "21.3" + :group 'gnus-article-mime :type 'boolean) (defcustom gnus-body-boundary-delimiter "_" @@ -787,7 +795,7 @@ on parts -- for instance, adding Vcard info to a database." "An alist of MIME types to functions to display them." :version "21.1" :group 'gnus-article-mime - :type 'alist) + :type '(repeat (cons :format "%v" (string :tag "MIME type") function))) (defcustom gnus-article-date-lapsed-new-header nil "Whether the X-Sent and Date headers can coexist. @@ -858,7 +866,7 @@ used." (defvar gnus-inhibit-treatment nil "Whether to inhibit treatment.") -(defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard")) +(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard")) "Highlight the signature. Valid values are nil, t, `head', `last', an integer or a predicate. See Info node `(gnus)Customizing Articles'." @@ -887,8 +895,7 @@ See Info node `(gnus)Customizing Articles' for details." (defcustom gnus-treat-emphasize (and (or window-system - (featurep 'xemacs) - (>= (string-to-number emacs-version) 21)) + (featurep 'xemacs)) 50000) "Emphasize text. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -979,7 +986,7 @@ See Info node `(gnus)Customizing Articles' for details." :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(make-obsolete-variable 'gnus-treat-strip-pgp +(make-obsolete-variable 'gnus-treat-strip-pgp "This option is obsolete in Gnus 5.10.") (defcustom gnus-treat-strip-pem nil @@ -1141,11 +1148,23 @@ See Info node `(gnus)Customizing Articles' for details." :type gnus-article-treat-custom) (put 'gnus-treat-overstrike 'highlight t) -(defcustom gnus-treat-display-xface +(defcustom gnus-treat-ansi-sequences (if (locate-library "ansi-color") t) + "Treat ANSI SGR control sequences. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + +(make-obsolete-variable 'gnus-treat-display-xface + 'gnus-treat-display-x-face) + +(defcustom gnus-treat-display-x-face (and (not noninteractive) (or (and (fboundp 'image-type-available-p) (image-type-available-p 'xbm) - (string-match "^0x" (shell-command-to-string "uncompface"))) + (string-match "^0x" (shell-command-to-string "uncompface")) + (executable-find "icontopbm")) (and (featurep 'xemacs) (featurep 'xface))) 'head) @@ -1157,8 +1176,25 @@ See Info node `(gnus)Customizing Articles' and Info node :version "21.1" :link '(custom-manual "(gnus)Customizing Articles") :link '(custom-manual "(gnus)X-Face") - :type gnus-article-treat-head-custom) -(put 'gnus-treat-display-xface 'highlight t) + :type gnus-article-treat-head-custom + :set (lambda (symbol value) + (set-default + symbol + (cond ((or (boundp symbol) (get symbol 'saved-value)) + value) + ((boundp 'gnus-treat-display-xface) + (message "\ +** gnus-treat-display-xface is an obsolete variable;\ + use gnus-treat-display-x-face instead") + (default-value 'gnus-treat-display-xface)) + ((get 'gnus-treat-display-xface 'saved-value) + (message "\ +** gnus-treat-display-xface is an obsolete variable;\ + use gnus-treat-display-x-face instead") + (eval (car (get 'gnus-treat-display-xface 'saved-value)))) + (t + value))))) +(put 'gnus-treat-display-x-face 'highlight t) (defcustom gnus-treat-display-face (and (not noninteractive) @@ -1176,7 +1212,7 @@ See Info node `(gnus)Customizing Articles' and Info node :link '(custom-manual "(gnus)Customizing Articles") :link '(custom-manual "(gnus)X-Face") :type gnus-article-treat-head-custom) -(put 'gnus-treat-display-xface 'highlight t) +(put 'gnus-treat-display-face 'highlight t) (defcustom gnus-treat-display-smileys (if (or (and (featurep 'xemacs) @@ -1246,12 +1282,12 @@ See Info node `(gnus)Customizing Articles' and Info node gnus-treat-from-picon) 'head nil) "Draw a boundary at the end of the headers. -Valid values are nil, t, `head', `last', an integer or a predicate. +Valid values are nil and `head'. See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) + :type gnus-article-treat-head-custom) (defcustom gnus-treat-capitalize-sentences nil "Capitalize sentence-starting words. @@ -1320,12 +1356,32 @@ It is a string, such as \"PGP\". If nil, ask user." (defvar gnus-article-wash-function nil "Function used for converting HTML into text.") +(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error)) + (mm-coding-system-p 'utf-8) + (executable-find idna-program)) + "Whether IDNA decoding of headers is used when viewing messages. +This requires GNU Libidn, and by default only enabled if it is found." + :group 'gnus-article-headers + :type 'boolean) + +(defcustom gnus-article-over-scroll nil + "If non-nil, allow scrolling the article buffer even when there no more text." + :group 'gnus-article + :type 'boolean) + ;;; Internal variables (defvar gnus-english-month-names '("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December")) +(defvar gnus-button-regexp nil) +(defvar gnus-button-marker-list nil) +;; Regexp matching any of the regexps from `gnus-button-alist'. + +(defvar gnus-button-last nil) +;; The value of `gnus-button-alist' when `gnus-button-regexp' was build. + (defvar article-goto-body-goes-to-point-min-p nil) (defvar gnus-article-wash-types nil) (defvar gnus-article-emphasis-alist nil) @@ -1349,7 +1405,7 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-date-original gnus-article-date-original) (gnus-treat-date-user-defined gnus-article-date-user) (gnus-treat-date-iso8601 gnus-article-date-iso8601) - (gnus-treat-display-xface gnus-article-display-x-face) + (gnus-treat-display-x-face gnus-article-display-x-face) (gnus-treat-display-face gnus-article-display-face) (gnus-treat-hide-headers gnus-article-maybe-hide-headers) (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) @@ -1369,6 +1425,7 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-strip-multiple-blank-lines gnus-article-strip-multiple-blank-lines) (gnus-treat-overstrike gnus-article-treat-overstrike) + (gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences) (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) (gnus-treat-fold-headers gnus-article-treat-fold-headers) (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) @@ -1411,6 +1468,8 @@ Initialized from `text-mode-syntax-table.") (defvar gnus-inhibit-hiding nil) +(defvar gnus-article-edit-mode nil) + ;;; Macros for dealing with the article buffer. (defmacro gnus-with-article-headers (&rest forms) @@ -1589,7 +1648,7 @@ always hide." (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) (forward-line -1) (gnus-article-hide-text-type - (gnus-point-at-bol) + (point-at-bol) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -1650,15 +1709,25 @@ always hide." (message-fetch-field "newsgroups")) (gnus-article-hide-header "followup-to"))) ((eq elem 'reply-to) - (let ((from (message-fetch-field "from")) - (reply-to (message-fetch-field "reply-to"))) - (when (and + (if (gnus-group-find-parameter + gnus-newsgroup-name 'broken-reply-to) + (gnus-article-hide-header "reply-to") + (let ((from (message-fetch-field "from")) + (reply-to (message-fetch-field "reply-to"))) + (when + (and from reply-to (ignore-errors - (gnus-string-equal - (nth 1 (mail-extract-address-components from)) - (nth 1 (mail-extract-address-components reply-to))))) - (gnus-article-hide-header "reply-to")))) + (equal + (sort (mapcar + (lambda (x) (downcase (cadr x))) + (mail-extract-address-components from t)) + 'string<) + (sort (mapcar + (lambda (x) (downcase (cadr x))) + (mail-extract-address-components reply-to t)) + 'string<)))) + (gnus-article-hide-header "reply-to"))))) ((eq elem 'date) (let ((date (message-fetch-field "date"))) (when (and date @@ -1705,7 +1774,7 @@ always hide." (goto-char (point-min)) (when (re-search-forward (concat "^" header ":") nil t) (gnus-article-hide-text-type - (gnus-point-at-bol) + (point-at-bol) (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) @@ -1726,7 +1795,7 @@ always hide." (article-narrow-to-head) (while (not (eobp)) (cond - ((< (setq column (- (gnus-point-at-eol) (point))) + ((< (setq column (- (point-at-eol) (point))) gnus-article-normalized-header-length) (end-of-line) (insert (make-string @@ -1737,7 +1806,7 @@ always hide." (progn (forward-char gnus-article-normalized-header-length) (point)) - (gnus-point-at-eol) + (point-at-eol) 'invisible t)) (t ;; Do nothing. @@ -1745,14 +1814,15 @@ always hide." (forward-line 1)))))) (defun article-treat-dumbquotes () - "Translate M****s*** sm*rtq**t*s into proper text. + "Translate M****s*** sm*rtq**t*s and other symbols into proper text. Note that this function guesses whether a character is a sm*rtq**t* or not, so it should only be used interactively. -Sm*rtq**t*s are M****s***'s unilateral extension to the character map -in an attempt to provide more quoting characters. If you see -something like \\222 or \\264 where you're expecting some kind of -apostrophe or quotation mark, then try this wash." +Sm*rtq**t*s are M****s***'s unilateral extension to the +iso-8859-1 character map in an attempt to provide more quoting +characters. If you see something like \\222 or \\264 where +you're expecting some kind of apostrophe or quotation mark, then +try this wash." (interactive) (article-translate-strings gnus-article-dumbquotes-map)) @@ -1811,6 +1881,14 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (put-text-property (point) (1+ (point)) 'face 'underline))))))))) +(defun article-treat-ansi-sequences () + "Translate ANSI SGR control sequences into overlays or extents." + (interactive) + (save-excursion + (when (article-goto-body) + (let ((buffer-read-only nil)) + (ansi-color-apply-on-region (point) (point-max)))))) + (defun gnus-article-treat-unfold-headers () "Unfold folded message headers. Only the headers that fit into the current window width will be @@ -1906,7 +1984,8 @@ unfolded." (while (not (eobp)) (end-of-line) (when (>= (current-column) (min fill-column width)) - (narrow-to-region (min (1+ (point)) (point-max)) (gnus-point-at-bol)) + (narrow-to-region (min (1+ (point)) (point-max)) + (point-at-bol)) (let ((goback (point-marker))) (fill-paragraph nil) (goto-char (marker-position goback))) @@ -1948,28 +2027,53 @@ unfolded." (while (and (not (bobp)) (looking-at "^[ \t]*$") (not (gnus-annotation-in-region-p - (point) (gnus-point-at-eol)))) + (point) (point-at-eol)))) (forward-line -1)) (forward-line 1) (point)))))) +(eval-when-compile + (defvar gnus-face-properties-alist)) + (defun article-display-face () "Display any Face headers in the header." (interactive) - (gnus-with-article-headers - (let ((face (message-fetch-field "face"))) - (when face - (let ((png (gnus-convert-face-to-png face)) - image) - (when png - (setq image (gnus-create-image png 'png t)) - (gnus-article-goto-header "from") - (when (bobp) - (insert "From: [no `from' set]\n") - (forward-char -17)) - (gnus-add-wash-type 'face) - (gnus-add-image 'face image) - (gnus-put-image image))))))) + (let ((wash-face-p buffer-read-only)) + (gnus-with-article-headers + ;; When displaying parts, this function can be called several times on + ;; the same article, without any intended toggle semantic (as typing `W + ;; D d' would have). So face deletion must occur only when we come from + ;; an interactive command, that is when the *Article* buffer is + ;; read-only. + (if (and wash-face-p (memq 'face gnus-article-wash-types)) + (gnus-delete-images 'face) + (let (face faces) + (save-excursion + (when (and wash-face-p + (progn + (goto-char (point-min)) + (not (re-search-forward "^Face:[\t ]*" nil t))) + (gnus-buffer-live-p gnus-original-article-buffer)) + (set-buffer gnus-original-article-buffer)) + (save-restriction + (mail-narrow-to-head) + (while (gnus-article-goto-header "Face") + (setq faces (nconc faces (list (mail-header-field-value))))))) + (while (setq face (pop faces)) + (let ((png (gnus-convert-face-to-png face)) + image) + (when png + (setq image + (apply 'gnus-create-image png 'png t + (cdr (assq 'png gnus-face-properties-alist)))) + (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) + (gnus-add-wash-type 'face) + (gnus-add-image 'face image) + (gnus-put-image image nil 'face)))))) + ))) (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." @@ -1979,7 +2083,8 @@ unfolded." ;; Delete the old process, if any. (when (process-status "article-x-face") (delete-process "article-x-face")) - (if (memq 'xface gnus-article-wash-types) + ;; See the comment in `article-display-face'. + (if (and wash-face-p (memq 'xface gnus-article-wash-types)) ;; We have already displayed X-Faces, so we remove them ;; instead. (gnus-delete-images 'xface) @@ -2014,35 +2119,35 @@ unfolded." (not (string-match gnus-article-x-face-too-ugly from))))) ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (gnus-functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command face) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (with-temp-buffer - (insert face) - (process-send-region "article-x-face" - (point-min) (point-max))) - (process-send-eof "article-x-face"))))))))) + (cond ((stringp gnus-article-x-face-command) + ;; The command is a string, so we interpret the command + ;; as a, well, command, and fork it off. + (let ((process-connection-type nil)) + (process-kill-without-query + (start-process + "article-x-face" nil shell-file-name + shell-command-switch gnus-article-x-face-command)) + (with-temp-buffer + (insert face) + (process-send-region "article-x-face" + (point-min) (point-max))) + (process-send-eof "article-x-face"))) + ((functionp gnus-article-x-face-command) + ;; The command is a lisp function, so we call it. + (funcall gnus-article-x-face-command face)) + (t + (error "%s is not a function" + gnus-article-x-face-command))))))))) (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) + (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t) - buffer-read-only (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets))) (mail-decode-encoded-word-region (point-min) (point-max))))) (defun article-decode-charset (&optional prompt) @@ -2089,7 +2194,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte)))) - (car ctl) prompt)))))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -2113,20 +2218,60 @@ If PROMPT (the prefix), prompt for a coding system to use." (when (and (or gnus-group-name-charset-method-alist gnus-group-name-charset-group-alist) (gnus-buffer-live-p gnus-original-article-buffer)) - (when (nnmail-fetch-field "Newsgroups") - (nnheader-replace-header "Newsgroups" - (gnus-decode-newsgroups - (with-current-buffer - gnus-original-article-buffer - (nnmail-fetch-field "Newsgroups")) - gnus-newsgroup-name method))) - (when (nnmail-fetch-field "Followup-To") - (nnheader-replace-header "Followup-To" - (gnus-decode-newsgroups - (with-current-buffer - gnus-original-article-buffer - (nnmail-fetch-field "Followup-To")) - gnus-newsgroup-name method)))))) + (save-restriction + (article-narrow-to-head) + (with-current-buffer gnus-original-article-buffer + (goto-char (point-min))) + (while (re-search-forward + "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) + (replace-match (save-match-data + (gnus-decode-newsgroups + ;; XXX how to use data in article buffer? + (with-current-buffer gnus-original-article-buffer + (re-search-forward + "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" + nil t) + (match-string 1)) + gnus-newsgroup-name method)) + t t nil 1)) + (goto-char (point-min)) + (with-current-buffer gnus-original-article-buffer + (goto-char (point-min))) + (while (re-search-forward + "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) + (replace-match (save-match-data + (gnus-decode-newsgroups + ;; XXX how to use data in article buffer? + (with-current-buffer gnus-original-article-buffer + (re-search-forward + "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" + nil t) + (match-string 1)) + gnus-newsgroup-name method)) + t t nil 1)))))) + +(autoload 'idna-to-unicode "idna") + +(defun article-decode-idna-rhs () + "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer." + (when gnus-use-idna + (save-restriction + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (article-narrow-to-head) + (goto-char (point-min)) + (while (re-search-forward "\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t) + (let (ace unicode) + (when (save-match-data + (and (setq ace (match-string 1)) + (save-excursion + (and (re-search-backward "^[^ \t]" nil t) + (looking-at "From\\|To\\|Cc"))) + (save-excursion (backward-char) + (message-idna-inside-rhs-p)) + (setq unicode (idna-to-unicode ace)))) + (unless (string= ace unicode) + (replace-match unicode nil nil nil 1))))))))) (defun article-de-quoted-unreadable (&optional force read-charset) "Translate a quoted-printable-encoded article. @@ -2212,8 +2357,8 @@ If READ-CHARSET, ask for a coding system." (while (re-search-forward "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) (replace-match "\\1\\3" t))) - (when (and gnus-display-mime-function (interactive-p)) - (funcall gnus-display-mime-function)))) + (when (interactive-p) + (gnus-treat-article nil)))) (defun article-wash-html (&optional read-charset) @@ -2246,7 +2391,7 @@ If READ-CHARSET, ask for a coding system." (when entry (setq func (cdr entry))) (cond - ((gnus-functionp func) + ((functionp func) (funcall func)) (t (apply (car func) (cdr func)))))))))) @@ -2267,17 +2412,17 @@ If READ-CHARSET, ask for a coding system." (mm-setup-w3m) (save-restriction (narrow-to-region (point) (point-max)) - (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images - nil - "\\`cid:")) - (w3m-display-inline-images mm-inline-text-html-with-images) + (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) w3m-force-redisplay) (w3m-region (point-min) (point-max))) - (when mm-inline-text-html-with-w3m-keymap + (when (and mm-inline-text-html-with-w3m-keymap + (boundp 'w3m-minor-mode-map) + w3m-minor-mode-map) (add-text-properties (point-min) (point-max) - (nconc (mm-w3m-local-map-property) - '(mm-inline-text-html-with-w3m t)))))) + (list 'keymap w3m-minor-mode-map + ;; Put the mark meaning this part was rendered by emacs-w3m. + 'mm-inline-text-html-with-w3m t))))) (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. @@ -2340,18 +2485,25 @@ always hide." (article-really-strip-banner (gnus-parameter-banner gnus-newsgroup-name))) (when gnus-article-address-banner-alist - (article-really-strip-banner - (let ((from (save-restriction - (widen) - (article-narrow-to-head) - (mail-fetch-field "from")))) - (when (and from - (setq from - (caar (mail-header-parse-addresses from)))) - (catch 'found - (dolist (pair gnus-article-address-banner-alist) - (when (string-match (car pair) from) - (throw 'found (cdr pair))))))))))))) + ;; It is necessary to encode from fields before checking, + ;; because `mail-header-parse-addresses' does not work + ;; (reliably) on decoded headers. And more, it is + ;; impossible to use `gnus-fetch-original-field' here, + ;; because `article-strip-banner' may be called in draft + ;; buffers to preview them. + (let ((from (save-restriction + (widen) + (article-narrow-to-head) + (mail-fetch-field "from")))) + (when (and from + (setq from + (caar (mail-header-parse-addresses + (mail-encode-encoded-word-string from))))) + (catch 'found + (dolist (pair gnus-article-address-banner-alist) + (when (string-match (car pair) from) + (throw 'found + (article-really-strip-banner (cdr pair))))))))))))) (defun article-really-strip-banner (banner) "Strip the banner specified by the argument." @@ -2379,11 +2531,9 @@ always hide." "Translate article using an online translation service." (interactive) (require 'babel) - (save-excursion - (set-buffer gnus-article-buffer) + (gnus-with-article-buffer (when (article-goto-body) - (let* ((buffer-read-only nil) - (start (point)) + (let* ((start (point)) (end (point-max)) (orig (buffer-substring start end)) (trans (babel-as-string orig))) @@ -2521,7 +2671,7 @@ Point is left at the beginning of the narrowed-to region." (< (- (point-max) (point)) limit)) (and (floatp limit) (< (count-lines (point) (point-max)) limit)) - (and (gnus-functionp limit) + (and (functionp limit) (funcall limit)) (and (stringp limit) (not (re-search-forward limit nil t)))) @@ -2647,11 +2797,11 @@ should replace the \"Date:\" one, or should be added below it." (save-restriction (article-narrow-to-head) (when (re-search-forward tdate-regexp nil t) - (setq bface (get-text-property (gnus-point-at-bol) 'face) - date (or (get-text-property (gnus-point-at-bol) + (setq bface (get-text-property (point-at-bol) 'face) + date (or (get-text-property (point-at-bol) 'original-date) date) - eface (get-text-property (1- (gnus-point-at-eol)) 'face)) + eface (get-text-property (1- (point-at-eol)) 'face)) (forward-line 1)) (when (and date (not (string= date ""))) (goto-char (point-min)) @@ -2659,19 +2809,18 @@ should replace the \"Date:\" one, or should be added below it." ;; Delete any old Date headers. (while (re-search-forward date-regexp nil t) (if pos - (delete-region (progn (beginning-of-line) (point)) - (progn (gnus-article-forward-header) - (point))) - (delete-region (progn (beginning-of-line) (point)) + (delete-region (point-at-bol) (progn (gnus-article-forward-header) - (forward-char -1) (point))) + (delete-region (point-at-bol) + (progn (gnus-article-forward-header) + (forward-char -1) + (point))) (setq pos (point)))) (when (and (not pos) (re-search-forward tdate-regexp nil t)) (forward-line 1)) - (when pos - (goto-char pos)) + (gnus-goto-char pos) (insert (article-make-date-line date (or type 'ut))) (unless pos (insert "\n") @@ -2723,7 +2872,7 @@ should replace the \"Date:\" one, or should be added below it." gnus-article-time-format) (error nil)) gnus-article-time-format))) - (if (gnus-functionp format) + (if (functionp format) (funcall format time) (concat "Date: " (format-time-string format time))))) ;; ISO 8601. @@ -2833,9 +2982,12 @@ function and want to see what the date was before converting." (lambda (w) (set-buffer (window-buffer w)) (when (eq major-mode 'gnus-article-mode) - (goto-char (point-min)) - (when (re-search-forward "^X-Sent:" nil t) - (article-date-lapsed t)))) + (let ((mark (point-marker))) + (goto-char (point-min)) + (when (re-search-forward "^X-Sent:" nil t) + (article-date-lapsed t)) + (goto-char (marker-position mark)) + (move-marker mark nil)))) nil 'visible))))) (defun gnus-start-date-timer (&optional n) @@ -2847,7 +2999,7 @@ is to run." (setq n 1)) (gnus-stop-date-timer) (setq article-lapsed-timer - (nnheader-run-at-time 1 n 'article-update-date-lapsed))) + (run-at-time 1 n 'article-update-date-lapsed))) (defun gnus-stop-date-timer () "Stop the X-Sent timer." @@ -3252,7 +3404,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is mml2015-use (mml2015-clear-verify-function)) (with-temp-buffer - (insert-buffer gnus-original-article-buffer) + (insert-buffer-substring gnus-original-article-buffer) (setq items (split-string sig)) (message-narrow-to-head) (let ((inhibit-point-motion-hooks t) @@ -3260,7 +3412,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is ;; Don't verify multiple headers. (setq headers (mapconcat (lambda (header) (concat header ": " - (mail-fetch-field header) "\n")) + (mail-fetch-field header) + "\n")) (split-string (nth 1 items) ",") ""))) (delete-region (point-min) (point-max)) (insert "-----BEGIN PGP SIGNED MESSAGE-----\n\n") @@ -3292,8 +3445,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (message-narrow-to-head) (goto-char (point-max)) (forward-line -1) - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) 'face)) + (setq bface (get-text-property (point-at-bol) 'face) + eface (get-text-property (1- (point-at-eol)) 'face)) (message-remove-header "X-Gnus-PGP-Verify") (if (re-search-forward "^X-PGP-Sig:" nil t) (forward-line) @@ -3344,6 +3497,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-verify-cancel-lock article-hide-boring-headers article-treat-overstrike + article-treat-ansi-sequences article-fill-long-lines article-capitalize-sentences article-remove-cr @@ -3444,6 +3598,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Hide signature" gnus-article-hide-signature t] ["Hide citation" gnus-article-hide-citation t] ["Treat overstrike" gnus-article-treat-overstrike t] + ["Treat ANSI sequences" gnus-article-treat-ansi-sequences t] ["Remove carriage return" gnus-article-remove-cr t] ["Remove leading whitespace" gnus-article-remove-leading-whitespace t] ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] @@ -3485,7 +3640,7 @@ commands: (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) - (make-local-variable 'gnus-page-broken) + (set (make-local-variable 'gnus-page-broken) nil) (make-local-variable 'gnus-button-marker-list) (make-local-variable 'gnus-article-current-summary) (make-local-variable 'gnus-article-mime-handles) @@ -3669,10 +3824,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-prepare-display) ;; Do page break. (goto-char (point-min)) - (setq gnus-page-broken - (when gnus-break-pages - (gnus-narrow-to-page) - t))) + (when gnus-break-pages + (gnus-narrow-to-page))) (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) (gnus-set-mode-line 'article)) @@ -3753,35 +3906,18 @@ General format specifiers can also be used. See Info node (defvar gnus-mime-button-map (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) (define-key map gnus-mouse-2 'gnus-article-push-button) (define-key map gnus-down-mouse-3 'gnus-mime-button-menu) (dolist (c gnus-mime-button-commands) (define-key map (cadr c) (car c))) map)) -(easy-menu-define gnus-mime-button-menu gnus-mime-button-map "MIME button menu." +(easy-menu-define + gnus-mime-button-menu gnus-mime-button-map "MIME button menu." `("MIME Part" ,@(mapcar (lambda (c) - (vector (caddr c) (car c) :enable t)) gnus-mime-button-commands))) - -(eval-when-compile - (define-compiler-macro popup-menu (&whole form - menu &optional position prefix) - (if (and (fboundp 'popup-menu) - (not (memq 'popup-menu (assoc "lmenu" load-history)))) - form - ;; Gnus is probably running under Emacs 20. - `(let* ((menu (cdr ,menu)) - (response (x-popup-menu - t (list (car menu) - (cons "" (mapcar (lambda (c) - (cons (caddr c) (car c))) - (cdr menu))))))) - (if response - (call-interactively (nth 3 (assq response menu)))))))) + (vector (caddr c) (car c) :enable t)) + gnus-mime-button-commands))) (defun gnus-mime-button-menu (event prefix) "Construct a context-sensitive menu of MIME commands." @@ -3796,8 +3932,7 @@ General format specifiers can also be used. See Info node (defun gnus-mime-view-all-parts (&optional handles) "View all the MIME parts." (interactive) - (save-current-buffer - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (let ((handles (or handles gnus-article-mime-handles)) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets @@ -3811,109 +3946,11 @@ General format specifiers can also be used. See Info node (delete-region (point) (point-max)) (mm-display-parts handles)))))) -(defun gnus-mime-save-part-and-strip () - "Save the MIME part under point then replace it with an external body." - (interactive) - (gnus-article-check-buffer) - (let* ((data (get-text-property (point) 'gnus-data)) - file param - (handles gnus-article-mime-handles)) - (if (mm-multiple-handles gnus-article-mime-handles) - (error "This function is not implemented")) - (setq file (and data (mm-save-part data))) - (when file - (with-current-buffer (mm-handle-buffer data) - (erase-buffer) - (insert "Content-Type: " (mm-handle-media-type data)) - (mml-insert-parameter-string (cdr (mm-handle-type data)) - '(charset)) - (insert "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: binary\n") - (insert "\n")) - (setcdr data - (cdr (mm-make-handle nil - `("message/external-body" - (access-type . "LOCAL-FILE") - (name . ,file))))) - (set-buffer gnus-summary-buffer) - (gnus-article-edit-article - `(lambda () - (erase-buffer) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - (mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (insert-buffer gnus-original-article-buffer) - (mime-to-mml ',handles) - (setq gnus-article-mime-handles nil) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (set (make-local-variable 'mml-buffer-list) mbl1)) - ;; LOCAL argument of add-hook differs between GNU Emacs - ;; and XEmacs. make-local-hook makes sure they are local. - (make-local-hook 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) - `(lambda (no-highlight) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (message-options message-options) - (message-options-set-recipient) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets))) - (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)))))) - -(defun gnus-mime-delete-part () - "Delete the MIME part under point. -Replace it with some information about the removed part." - (interactive) - (gnus-article-check-buffer) - (let* ((data (get-text-property (point) 'gnus-data)) - (handles gnus-article-mime-handles) - (none "(none)") - (description - (or - (mail-decode-encoded-word-string (or (mm-handle-description data) - none)))) - (filename - (or (mail-content-type-get (mm-handle-disposition data) 'filename) - none)) - (type (mm-handle-media-type data))) - (if (mm-multiple-handles gnus-article-mime-handles) - (error "This function is not implemented")) - (with-current-buffer (mm-handle-buffer data) - (let ((bsize (format "%s" (buffer-size)))) - (erase-buffer) - (insert - (concat - "<#part type=text/plain nofile=yes disposition=attachment" - " description=\"Deleted attachment (" bsize " Byte)\">" - ",----\n" - "| The following attachment has been deleted:\n" - "|\n" - "| Type: " type "\n" - "| Filename: " filename "\n" - "| Size (encoded): " bsize " Byte\n" - "| Description: " description "\n" - "`----\n" - "<#/part>")) - (setcdr data - (cdr (mm-make-handle nil `("text/plain")))))) - (set-buffer gnus-summary-buffer) - ;; FIXME: maybe some of the following code (borrowed from - ;; `gnus-mime-save-part-and-strip') isn't necessary? +(eval-when-compile + (defsubst gnus-article-edit-part (handles) + "Edit an article in order to delete a mime part. +This function is exclusively used by `gnus-mime-save-part-and-strip' +and `gnus-mime-delete-part', and not provided at run-time normally." (gnus-article-edit-article `(lambda () (erase-buffer) @@ -3930,9 +3967,7 @@ Replace it with some information about the removed part." (let ((mbl1 mml-buffer-list)) (setq mml-buffer-list mbl) (set (make-local-variable 'mml-buffer-list) mbl1)) - ;; LOCAL argument of add-hook differs between GNU Emacs - ;; and XEmacs. make-local-hook makes sure they are local. - (make-local-hook 'kill-buffer-hook) + (gnus-make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) `(lambda (no-highlight) (let ((mail-parse-charset (or gnus-article-charset @@ -3950,11 +3985,89 @@ Replace it with some information about the removed part." (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight)))) - ;; Not in `gnus-mime-save-part-and-strip': - (gnus-article-edit-done) - (gnus-summary-expand-window) - (gnus-summary-show-article)) + ,gnus-summary-buffer no-highlight))) + (gnus-article-edit-done) + (gnus-summary-expand-window) + (gnus-summary-show-article))) + +(defun gnus-mime-save-part-and-strip () + "Save the MIME part under point then replace it with an external body." + (interactive) + (gnus-article-check-buffer) + (when (gnus-group-read-only-p) + (error "The current group does not support deleting of parts")) + (when (mm-complicated-handles gnus-article-mime-handles) + (error "\ +The current article has a complicated MIME structure, giving up...")) + (when (gnus-yes-or-no-p "\ +Deleting parts may malfunction or destroy the article; continue? ") + (let* ((data (get-text-property (point) 'gnus-data)) + file param + (handles gnus-article-mime-handles)) + (setq file (and data (mm-save-part data))) + (when file + (with-current-buffer (mm-handle-buffer data) + (erase-buffer) + (insert "Content-Type: " (mm-handle-media-type data)) + (mml-insert-parameter-string (cdr (mm-handle-type data)) + '(charset)) + (insert "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: binary\n") + (insert "\n")) + (setcdr data + (cdr (mm-make-handle nil + `("message/external-body" + (access-type . "LOCAL-FILE") + (name . ,file))))) + (set-buffer gnus-summary-buffer) + (gnus-article-edit-part handles))))) + +(defun gnus-mime-delete-part () + "Delete the MIME part under point. +Replace it with some information about the removed part." + (interactive) + (gnus-article-check-buffer) + (when (gnus-group-read-only-p) + (error "The current group does not support deleting of parts")) + (when (mm-complicated-handles gnus-article-mime-handles) + (error "\ +The current article has a complicated MIME structure, giving up...")) + (when (gnus-yes-or-no-p "\ +Deleting parts may malfunction or destroy the article; continue? ") + (let* ((data (get-text-property (point) 'gnus-data)) + (handles gnus-article-mime-handles) + (none "(none)") + (description + (or + (mail-decode-encoded-word-string (or (mm-handle-description data) + none)))) + (filename + (or (mail-content-type-get (mm-handle-disposition data) 'filename) + none)) + (type (mm-handle-media-type data))) + (unless data + (error "No MIME part under point")) + (with-current-buffer (mm-handle-buffer data) + (let ((bsize (format "%s" (buffer-size)))) + (erase-buffer) + (insert + (concat + ",----\n" + "| The following attachment has been deleted:\n" + "|\n" + "| Type: " type "\n" + "| Filename: " filename "\n" + "| Size (encoded): " bsize " Byte\n" + "| Description: " description "\n" + "`----\n")) + (setcdr data + (cdr (mm-make-handle + nil `("text/plain") nil nil + (list "attachment") + (format "Deleted attachment (%s bytes)" bsize)))))) + (set-buffer gnus-summary-buffer) + (gnus-article-edit-part handles)))) (defun gnus-mime-save-part () "Save the MIME part under point." @@ -4038,7 +4151,7 @@ The uncompress method used is derived from `buffer-file-name'." (message "%s %s..." message basename)) (unwind-protect (unless (memq (apply 'call-process-region - (point-min) (point-max) + (point-min) (point-max) prog t (list t err-file) nil args) @@ -4161,8 +4274,8 @@ specified charset." (mm-inlined-types nil) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets))) (when handle (if (mm-handle-undisplayer handle) (mm-remove-part handle) @@ -4178,8 +4291,8 @@ If no internal viewer is available, use an external viewer." (mm-inline-large-images t) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets)) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)) buffer-read-only) (when handle (if (mm-handle-undisplayer handle) @@ -4196,8 +4309,7 @@ If no internal viewer is available, use an external viewer." (funcall (cdr action-pair))))) (defun gnus-article-part-wrapper (n function) - (save-current-buffer - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (when (> n (length gnus-article-mime-handle-alist)) (error "No such part")) (gnus-article-goto-part n) @@ -4225,7 +4337,8 @@ If no internal viewer is available, use an external viewer." (gnus-article-part-wrapper n 'gnus-mime-copy-part)) (defun gnus-article-view-part-as-charset (n) - "Copy MIME part N, which is the numerical prefix." + "View MIME part N using a specified charset. +N is the numerical prefix." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) @@ -4262,8 +4375,7 @@ If no internal viewer is available, use an external viewer." (defun gnus-article-view-part (&optional n) "View MIME part N, which is the numerical prefix." (interactive "P") - (save-current-buffer - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (or (numberp n) (setq n (gnus-article-mime-match-handle-first gnus-article-mime-match-handle-function))) (when (> n (length gnus-article-mime-handle-alist)) @@ -4291,8 +4403,7 @@ If no internal viewer is available, use an external viewer." (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (if (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets) nil))) (save-excursion @@ -4360,11 +4471,11 @@ If no internal viewer is available, use an external viewer." (setq b (point)) (gnus-eval-format gnus-mime-button-line-format gnus-mime-button-line-format-alist - `(,@(gnus-local-map-property gnus-mime-button-map) - gnus-callback gnus-mm-display-part - gnus-part ,gnus-tmp-id - article-type annotation - gnus-data ,handle)) + `(keymap ,gnus-mime-button-map + gnus-callback gnus-mm-display-part + gnus-part ,gnus-tmp-id + article-type annotation + gnus-data ,handle)) (setq e (if (bolp) ;; Exclude a newline. (1- (point)) @@ -4450,9 +4561,28 @@ If no internal viewer is available, use an external viewer." (narrow-to-region (point-min) (point)) (gnus-treat-article 'head)))))))) -(defvar gnus-mime-display-multipart-as-mixed nil) -(defvar gnus-mime-display-multipart-alternative-as-mixed nil) -(defvar gnus-mime-display-multipart-related-as-mixed nil) +(defcustom gnus-mime-display-multipart-as-mixed nil + "Display \"multipart\" parts as \"multipart/mixed\". + +If t, it overrides nil values of +`gnus-mime-display-multipart-alternative-as-mixed' and +`gnus-mime-display-multipart-related-as-mixed'." + :group 'gnus-article-mime + :type 'boolean) + +(defcustom gnus-mime-display-multipart-alternative-as-mixed nil + "Display \"multipart/alternative\" parts as \"multipart/mixed\"." + :group 'gnus-article-mime + :type 'boolean) + +(defcustom gnus-mime-display-multipart-related-as-mixed nil + "Display \"multipart/related\" parts as \"multipart/mixed\". + +If displaying \"text/html\" is discouraged \(see +`mm-discouraged-alternatives'\) images or other material inside a +\"multipart/related\" part might be overlooked when this variable is nil." + :group 'gnus-article-mime + :type 'boolean) (defun gnus-mime-display-part (handle) (cond @@ -4531,11 +4661,9 @@ If no internal viewer is available, use an external viewer." (push (cons id handle) gnus-article-mime-handle-alist) (when (or (not display) (not (gnus-unbuttonized-mime-type-p type))) - ;(gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display (and not-attachment text)))) (gnus-article-insert-newline) - ;(gnus-article-insert-newline) ;; Remember modify the number of forward lines. (setq move t)) (setq beg (point)) @@ -4623,7 +4751,7 @@ If no internal viewer is available, use an external viewer." ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',not-pref ',begend ,id)) - ,@(gnus-local-map-property gnus-mime-button-map) + keymap ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id @@ -4647,7 +4775,7 @@ If no internal viewer is available, use an external viewer." ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',handle ',begend ,id)) - ,@(gnus-local-map-property gnus-mime-button-map) + keymap ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face gnus-part ,id @@ -4662,8 +4790,8 @@ If no internal viewer is available, use an external viewer." (gnus-display-mime preferred) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets))) (mm-display-part preferred) ;; Do highlighting. (save-excursion @@ -4713,8 +4841,7 @@ is the string to use when it is inactive.") (defun gnus-article-wash-status () "Return a string which display status of article washing." - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (let ((cite (memq 'cite gnus-article-wash-types)) (headers (memq 'headers gnus-article-wash-types)) (boring (memq 'boring-headers gnus-article-wash-types)) @@ -4753,7 +4880,7 @@ is the string to use when it is inactive.") "Delete all images in CATEGORY." (let ((entry (assq category gnus-article-image-alist))) (dolist (image (cdr entry)) - (gnus-remove-image image)) + (gnus-remove-image image category)) (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) (gnus-delete-wash-type category))) @@ -4763,8 +4890,8 @@ is the string to use when it is inactive.") "Hide unwanted headers if `gnus-have-all-headers' is nil. Provided for backwards compatibility." (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer)) - (not (save-excursion (set-buffer gnus-summary-buffer) - gnus-have-all-headers))) + (not (with-current-buffer gnus-summary-buffer + gnus-have-all-headers))) (not gnus-inhibit-hiding)) (gnus-article-hide-headers))) @@ -4797,41 +4924,63 @@ If given a numerical ARG, move forward ARG pages." (let ((buffer-read-only nil)) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next))) - (when + (if (cond ((< arg 0) (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) ((> arg 0) (re-search-forward page-delimiter nil 'move arg))) - (goto-char (match-end 0))) - (narrow-to-region - (point) - (if (re-search-forward page-delimiter nil 'move) - (match-beginning 0) - (point))) - (when (and (gnus-visual-p 'page-marker) - (not (= (point-min) 1))) + (goto-char (match-end 0)) (save-excursion (goto-char (point-min)) - (gnus-insert-prev-page-button))) - (when (and (gnus-visual-p 'page-marker) - (< (+ (point-max) 2) (buffer-size))) - (save-excursion - (goto-char (point-max)) - (gnus-insert-next-page-button))))) + (setq gnus-page-broken + (and (re-search-forward page-delimiter nil t) t)))) + (when gnus-page-broken + (narrow-to-region + (point) + (if (re-search-forward page-delimiter nil 'move) + (match-beginning 0) + (point))) + (when (and (gnus-visual-p 'page-marker) + (not (= (point-min) 1))) + (save-excursion + (goto-char (point-min)) + (gnus-insert-prev-page-button))) + (when (and (gnus-visual-p 'page-marker) + (< (+ (point-max) 2) (buffer-size))) + (save-excursion + (goto-char (point-max)) + (gnus-insert-next-page-button)))))) ;; Article mode commands (defun gnus-article-goto-next-page () "Show the next page of the article." (interactive) - (gnus-eval-in-buffer-window gnus-summary-buffer - (gnus-summary-next-page))) + (when (gnus-article-next-page) + (goto-char (point-min)) + (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) + (defun gnus-article-goto-prev-page () - "Show the next page of the article." + "Show the previous page of the article." (interactive) - (gnus-eval-in-buffer-window gnus-summary-buffer - (gnus-summary-prev-page))) + (if (bobp) + (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) + (gnus-article-prev-page nil))) + +;; This is cleaner but currently breaks `gnus-pick-mode': +;; +;; (defun gnus-article-goto-next-page () +;; "Show the next page of the article." +;; (interactive) +;; (gnus-eval-in-buffer-window gnus-summary-buffer +;; (gnus-summary-next-page))) +;; +;; (defun gnus-article-goto-prev-page () +;; "Show the next page of the article." +;; (interactive) +;; (gnus-eval-in-buffer-window gnus-summary-buffer +;; (gnus-summary-prev-page))) (defun gnus-article-next-page (&optional lines) "Show the next page of the current article. @@ -4847,20 +4996,27 @@ Argument LINES specifies lines to be scrolled up." (if (or (not gnus-page-broken) (save-excursion (save-restriction - (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? - t ;Nothing more. + (widen) + (eobp)))) ;Real end-of-buffer? + (progn + (when gnus-article-over-scroll + (gnus-article-next-page-1 lines)) + t) ;Nothing more. (gnus-narrow-to-page 1) ;Go to next page. nil) ;; More in this page. - (let ((scroll-in-place nil)) - (condition-case () - (scroll-up lines) - (end-of-buffer - ;; Long lines may cause an end-of-buffer error. - (goto-char (point-max))))) - (move-to-window-line 0) + (gnus-article-next-page-1 lines) nil)) +(defun gnus-article-next-page-1 (lines) + (let ((scroll-in-place nil)) + (condition-case () + (scroll-up lines) + (end-of-buffer + ;; Long lines may cause an end-of-buffer error. + (goto-char (point-max))))) + (move-to-window-line 0)) + (defun gnus-article-prev-page (&optional lines) "Show previous page of current article. Argument LINES specifies lines to be scrolled down." @@ -4902,9 +5058,9 @@ not have a face in `gnus-article-boring-faces'." "Read article specified by message-id around point." (interactive) (save-excursion - (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t) - (re-search-forward "]+" (gnus-point-at-eol) t) + (re-search-backward "[ \t]\\|^" (point-at-bol) t) + (re-search-forward "]+" (point-at-eol) t) (let ((msg-id (concat "<" (match-string 0) ">"))) (set-buffer gnus-summary-buffer) (gnus-summary-refer-article msg-id)) @@ -4998,11 +5154,13 @@ not have a face in `gnus-article-boring-faces'." (let ((obuf (current-buffer)) (owin (current-window-configuration)) (opoint (point)) - (summary gnus-article-current-summary) - func in-buffer selected) - (if not-restore-window - (pop-to-buffer summary 'norecord) - (switch-to-buffer summary 'norecord)) + win func in-buffer selected new-sum-start new-sum-hscroll) + (cond (not-restore-window + (pop-to-buffer gnus-article-current-summary 'norecord)) + ((setq win (get-buffer-window gnus-article-current-summary)) + (select-window win)) + (t + (switch-to-buffer gnus-article-current-summary 'norecord))) (setq in-buffer (current-buffer)) ;; We disable the pick minor mode commands. (if (and (setq func (let (gnus-pick-mode) @@ -5010,7 +5168,10 @@ not have a face in `gnus-article-boring-faces'." (functionp func)) (progn (call-interactively func) - (setq new-sum-point (point)) + (when (eq win (selected-window)) + (setq new-sum-point (point) + new-sum-start (window-start win) + new-sum-hscroll (window-hscroll win)) (when (eq in-buffer (current-buffer)) (setq selected (gnus-summary-select-article)) (set-buffer obuf) @@ -5022,10 +5183,12 @@ not have a face in `gnus-article-boring-faces'." 1) (set-window-point (get-buffer-window (current-buffer)) (point))) - (let ((win (get-buffer-window gnus-article-current-summary))) - (when win - (set-window-point win new-sum-point)))) ) - (switch-to-buffer gnus-article-buffer) + (when (and (not not-restore-window) + new-sum-point) + (set-window-point win new-sum-point) + (set-window-start win new-sum-start) + (set-window-hscroll win new-sum-hscroll))))) + (set-window-configuration owin) (ding)))))) (defun gnus-article-describe-key (key) @@ -5196,16 +5359,14 @@ If given a prefix, show the hidden text instead." gnus-summary-buffer (get-buffer gnus-summary-buffer) (gnus-buffer-exists-p gnus-summary-buffer) - (eq (cdr (save-excursion - (set-buffer gnus-summary-buffer) + (eq (cdr (with-current-buffer gnus-summary-buffer (assq article gnus-newsgroup-reads))) gnus-canceled-mark)) nil) ;; We first check `gnus-original-article-buffer'. ((and (get-buffer gnus-original-article-buffer) (numberp article) - (save-excursion - (set-buffer gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer (and (equal (car gnus-original-article) group) (eq (cdr gnus-original-article) article)))) (insert-buffer-substring gnus-original-article-buffer) @@ -5323,7 +5484,6 @@ If given a prefix, show the hidden text instead." (defvar gnus-article-edit-done-function nil) (defvar gnus-article-edit-mode-map nil) -(defvar gnus-article-edit-mode nil) ;; Should we be using derived.el for this? (unless gnus-article-edit-mode-map @@ -5460,12 +5620,13 @@ groups." (car gnus-article-current) (cdr gnus-article-current))) ;; We remove all text props from the article buffer. (kill-all-local-variables) - (gnus-set-text-properties (point-min) (point-max) nil) + (set-text-properties (point-min) (point-max) nil) (gnus-article-mode) (set-window-configuration winconf) (set-buffer buf) (set-window-start (get-buffer-window buf) start) - (set-window-point (get-buffer-window buf) (point)))) + (set-window-point (get-buffer-window buf) (point))) + (gnus-summary-show-article)) (defun gnus-article-edit-exit () "Exit the article editing without updating." @@ -5486,7 +5647,8 @@ groups." (save-current-buffer (set-buffer curbuf) (set-window-start (get-buffer-window (current-buffer)) window-start) - (goto-char p)))))) + (goto-char p)))) + (gnus-summary-show-article))) (defun gnus-article-edit-full-stops () "Interactively repair spacing at end of sentences." @@ -5507,20 +5669,14 @@ groups." (defcustom gnus-button-url-regexp (if (string-match "[[:digit:]]" "1") ;; support POSIX? - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)" - "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)") + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)" + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)") "Regular expression that matches URLs." :group 'gnus-article-buttons :type 'regexp) (defcustom gnus-button-valid-fqdn-regexp - (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain. - ;; valid TLDs: - "\\([a-z][a-z]" ;; two letter country TDLs - "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org" - "\\|aero\\|coop\\|info\\|name\\|museum" - "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style? - "\\)") + message-valid-fqdn-regexp "Regular expression that matches a valid FQDN." :group 'gnus-article-buttons :type 'regexp) @@ -5559,8 +5715,21 @@ The function must take one argument, the string naming the URL." :type '(choice (const "^/?tex-archive/\\|/") (regexp :tag "Other"))) +(defcustom gnus-button-ctan-directory-regexp + (concat + "\\(?:" + "biblio\\|digests\\|dviware\\|fonts\\|graphics\\|help\\|" + "indexing\\|info\\|language\\|macros\\|support\\|systems\\|" + "tds\\|tools\\|usergrps\\|web\\|nonfree\\|obsolete" + "\\)") + "Regular expression for ctan directories. +It should match all directories in the top level of `gnus-ctan-url'." + :group 'gnus-article-buttons + :type 'regexp) + (defcustom gnus-button-mid-or-mail-regexp - (concat "\\b\\(\")!;:,{}\n\t ]*@" + (concat "\\b\\(\")!;:,{}\n\t ]*@" + ;; Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de> gnus-button-valid-fqdn-regexp ">?\\)\\b") "Regular expression that matches a message ID or a mail address." @@ -5571,7 +5740,7 @@ The function must take one argument, the string naming the URL." "What to do when the button on a string as \"foo123@bar.invalid\" is pushed. Strings like this can be either a message ID or a mail address. If it is one of the symbols `mid' or `mail', Gnus will always assume that the string is a -message ID or a mail address, respectivly. If this variable is set to the +message ID or a mail address, respectively. If this variable is set to the symbol `ask', always query the user what do do. If it is a function, this function will be called with the string as it's only argument. The function must return `mid', `mail', `invalid' or `ask'." @@ -5590,12 +5759,12 @@ must return `mid', `mail', `invalid' or `ask'." (-5.0 . "@[Nn][Ee][Ww][Ss]") ;; /\@news/i (-5.0 . "@.*[Dd][Ii][Aa][Ll][Uu][Pp]") ;; /\@.*dialup/i; (-1.0 . "^[^a-z]+@") - + ;; (-5.0 . "\\.[0-9][0-9]+.*@") ;; "\.[0-9]{2,}.*\@" (-5.0 . "[a-z].*[A-Z].*[a-z].*[A-Z].*@") ;; "([a-z].*[A-Z].*){2,}\@" (-3.0 . "[A-Z][A-Z][a-z][a-z].*@") (-5.0 . "\\...?.?@") ;; (-5.0 . "\..{1,3}\@") - + ;; (-2.0 . "^[0-9]") (-1.0 . "^[0-9][0-9]") ;; @@ -5637,7 +5806,7 @@ must return `mid', `mail', `invalid' or `ask'." "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'. A negative RATE indicates a message IDs, whereas a positive indicates a mail -address. The REGEXP is processed with `case-fold-search' set to `nil'." +address. The REGEXP is processed with `case-fold-search' set to nil." :group 'gnus-article-buttons :type '(repeat (cons (number :tag "Rate") (regexp :tag "Regexp")))) @@ -5655,13 +5824,14 @@ address, `ask' if unsure and `invalid' if the string is invalid." ;; Certain special cases... (when (string-match (concat - "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$" "\\|" - "^[0-9]+\.[0-9]+\@compuserve") + "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$\\|" + "^[0-9]+\\.[0-9]+@compuserve\\|" + "@public\\.gmane\\.org") mid-or-mail) - (gnus-message 8 "`%s' is a known mail address.") + (gnus-message 8 "`%s' is a known mail address." mid-or-mail) (setq result 'mail)) (when (string-match "@.*@\\| " mid-or-mail) - (gnus-message 8 "`%s' is invalid.") + (gnus-message 8 "`%s' is invalid." mid-or-mail) (setq result 'invalid)) ;; Nothing more to do, if result is not a number here... (when (numberp result) @@ -5703,8 +5873,10 @@ address, `ask' if unsure and `invalid' if the string is invalid." (gnus-message 9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result))))) (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result) + ;; Maybe we should make this a customizable alist: (condition . 'result) (cond - ;; Maybe we should make this a customizable alist: (condition . 'result) + ((symbolp result) result) + ;; Now convert number into proper results: ((< result -10.0) 'mid) ((> result 10.0) 'mail) (t 'ask)))) @@ -5741,6 +5913,9 @@ address, `ask' if unsure and `invalid' if the string is invalid." (defvar gnus-button-handle-describe-prefix "^\\(C-h\\|?\\)") +;; FIXME: Maybe we should merge some of the functions that do quite similar +;; stuff? + (defun gnus-button-handle-describe-function (url) "Call `describe-function' when pushing the corresponding URL button." (describe-function @@ -5753,6 +5928,15 @@ address, `ask' if unsure and `invalid' if the string is invalid." (intern (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) +(defun gnus-button-handle-symbol (url) +"Display help on variable or function. +Calls `describe-variable' or `describe-function'." + (let ((sym (intern url))) + (cond + ((fboundp sym) (describe-function sym)) + ((boundp sym) (describe-variable sym)) + (t (gnus-message 3 "`%s' is not a known function of variable." url))))) + (defun gnus-button-handle-describe-key (url) "Call `describe-key' when pushing the corresponding URL button." (let* ((key-string @@ -5783,6 +5967,15 @@ address, `ask' if unsure and `invalid' if the string is invalid." (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos) (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) +(defun gnus-button-handle-library (url) + "Call `locate-library' when pushing the corresponding URL button." + (gnus-message 9 "url=`%s'" url) + (let* ((lib (locate-library url)) + (file (gnus-replace-in-string (or lib "") "\.elc" ".el"))) + (if (not lib) + (gnus-message 1 "Cannot locale library `%s'." url) + (find-file-read-only file)))) + (defun gnus-button-handle-ctan (url) "Call `browse-url' when pushing a CTAN URL button." (funcall @@ -5795,7 +5988,7 @@ address, `ask' if unsure and `invalid' if the string is invalid." "*Integer that says how many TeX-related buttons Gnus will show. The higher the number, the more buttons will appear and the more false positives are possible. Note that you can set this variable local to -specifific groups. Setting it higher in TeX groups is probably a good idea. +specific groups. Setting it higher in TeX groups is probably a good idea. See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on how to set variables in specific groups." :group 'gnus-article-buttons @@ -5806,7 +5999,7 @@ how to set variables in specific groups." "*Integer that says how many man-related buttons Gnus will show. The higher the number, the more buttons will appear and the more false positives are possible. Note that you can set this variable local to -specifific groups. Setting it higher in Unix groups is probably a good idea. +specific groups. Setting it higher in Unix groups is probably a good idea. See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on how to set variables in specific groups." :group 'gnus-article-buttons @@ -5817,43 +6010,81 @@ how to set variables in specific groups." "*Integer that says how many emacs-related buttons Gnus will show. The higher the number, the more buttons will appear and the more false positives are possible. Note that you can set this variable local to -specifific groups. Setting it higher in Emacs or Gnus related groups is +specific groups. Setting it higher in Emacs or Gnus related groups is probably a good idea. See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on how to set variables in specific groups." :group 'gnus-article-buttons :link '(custom-manual "(gnus)Group Parameters") :type 'integer) -(defcustom gnus-button-mail-level 5 - "*Integer that says how many buttons for message IDs or mail addresses will appear. +(defcustom gnus-button-message-level 5 + "*Integer that says how many buttons for news or mail messages will appear. +The higher the number, the more buttons will appear and the more false +positives are possible." + ;; mail addresses, MIDs, URLs for news, ... + :group 'gnus-article-buttons + :type 'integer) + +(defcustom gnus-button-browse-level 5 + "*Integer that says how many buttons for browsing will appear. The higher the number, the more buttons will appear and the more false positives are possible." + ;; stuff handled by `browse-url' or `gnus-button-embedded-url' :group 'gnus-article-buttons :type 'integer) (defcustom gnus-button-alist '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" - 0 t gnus-button-handle-news 3) + 0 (>= gnus-button-message-level 0) gnus-button-handle-news 3) ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-handle-news 2) - ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" - 1 t - gnus-button-fetch-group 4) - ("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2) - ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 - t gnus-button-message-id 3) - ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 2) - ("mailto:\\([-a-z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1) - ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) + ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" + 1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5) + ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)" + 0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3) + ;; RFC 2392 (Don't allow `/' in domain part --> CID) + ("\\bmid:\\(//\\)?\\([^'\">\n\t ]+@[^'\">\n\t /]+\\)" + 0 (>= gnus-button-message-level 0) gnus-button-message-id 2) + ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" + 2 (>= gnus-button-message-level 0) gnus-button-message-id 3) + ("\\( \n\t]+\\)>" + 0 (>= gnus-button-message-level 0) gnus-url-mailto 2) + ;; RFC 2368 (The mailto URL scheme) + ("\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)" + 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) + ("\\bmailto:\\([^ \n\t]+\\)" + 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ;; CTAN - ("\\bCTAN:[ \t\n]*\\([^>)!;:,\n\t ]*\\)" 0 (>= gnus-button-tex-level 1) - gnus-button-handle-ctan 1) - ;; This is info - ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 - (>= gnus-button-emacs-level 1) gnus-button-handle-info 2) + ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\(" + gnus-button-ctan-directory-regexp + "[^][>)!;:,'\n\t ]+\\)") + 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1) + ((concat "\\btex-archive/\\(" + gnus-button-ctan-directory-regexp + "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)") + 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1) + ((concat + "\\b\\(" + gnus-button-ctan-directory-regexp + "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)") + 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1) + ;; This is info (home-grown style) + ("\\binfo://\\([^'\">\n\t ]+\\)" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1) + ;; Info GNOME style + ("\\binfo:\\([^('\n\t\r \"><][^'\n\t\r \"><]*\\)" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1) + ;; Info KDE style + ("<\\(info:\\(([^)]+)[^>\n\r]*\\)\\)>" + 1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2) + ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0 + (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2) + ("\\b\\(C-h\\|?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" + ;; Info links like `C-h i d m CC Mode RET' + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2) ;; This is custom - ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 - (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2) + ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)" + 0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2) ("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1) ;; Emacs help commands @@ -5866,44 +6097,66 @@ positives are possible." 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1) ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) + ;; The following entries may lead to many false positives so don't enable + ;; them by default (use a high button level): + ("/\\([a-z][-a-z0-9]+\\.el\\)\\>" + 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) + ("`\\([a-z][-a-z0-9]+\\.el\\)'" + 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) + ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'" + 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1) + ("`\\([a-z][a-z0-9]+-[a-z]+\\)'" + 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1) + ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)" + 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1) + ("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1) ("\\b\\(C-h\\|?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2) ("\\b\\(C-h\\|?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2) - ("`\\(\\b\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" 1 + ("`\\(\\b\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" ;; Unlike the other regexps we really have to require quoting ;; here to determine where it ends. - (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) - ;; This is how URLs _should_ be embedded in text... - ("]*\\)>" 1 t gnus-button-embedded-url 1) + 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) + ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)... + ("]*\\)>" + 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) + ;; RFC 2396 (2.4.3., delims) ... + ("\"URL: *\\([^\"]*\\)\"" + 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) + ;; RFC 2396 (2.4.3., delims) ... + ("\"URL: *\\([^\"]*\\)\"" + 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) ;; Raw URLs. - (gnus-button-url-regexp 0 t browse-url 0) + (gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) browse-url 0) ;; man pages - ("\\b\\([a-z][a-z]+\\)([1-9])\\W" 0 - (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) + ("\\b\\([a-z][a-z]+\\)([1-9])\\W" + 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) gnus-button-handle-man 1) ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x) - ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W" 0 - (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5)) + ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W" + 0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5)) gnus-button-handle-man 1) ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm), - ;; SoWWWAnchor(3iv), XSelectInput(3X11) - ("\\b\\([a-z][-_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W" 0 - (>= gnus-button-man-level 5) gnus-button-handle-man 1) + ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) + ("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W" + 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) ;; MID or mail: To avoid too many false positives we don't try to catch ;; all kind of allowed MIDs or mail addresses. Domain part must contain ;; at least one dot. TLD must contain two or three chars or be a know TLD ;; (info|name|...). Put this entry near the _end_ of `gnus-button-alist' ;; so that non-ambiguous entries (see above) match first. (gnus-button-mid-or-mail-regexp - 0 (>= gnus-button-mail-level 5) gnus-button-handle-mid-or-mail 1)) + 0 (>= gnus-button-message-level 5) gnus-button-handle-mid-or-mail 1)) "*Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where REGEXP: is the string (case insensitive) matching text around the button (can -also be lisp expression evaluating to a string), +also be Lisp expression evaluating to a string), BUTTON: is the number of the regexp grouping actually matching the button, -FORM: is a lisp expression which must eval to true for the button to +FORM: is a Lisp expression which must eval to true for the button to be added, CALLBACK: is the function to call when the user push this button, and each PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. @@ -5911,7 +6164,7 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function." :group 'gnus-article-buttons - :type '(repeat (list (choice regexp variable) + :type '(repeat (list (choice regexp variable sexp) (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") @@ -5920,17 +6173,22 @@ variable it the real callback function." (integer :tag "Regexp group"))))) (defcustom gnus-header-button-alist - '(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>" - 0 t gnus-button-message-id 0) - ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1) + '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>" + 0 (>= gnus-button-message-level 0) gnus-button-message-id 0) + ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" + 1 (>= gnus-button-message-level 0) gnus-button-reply 1) ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" - 0 t gnus-button-mailto 0) - ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp 0 t browse-url 0) - ("^Subject:" gnus-button-url-regexp 0 t browse-url 0) - ("^[^:]+:" gnus-button-url-regexp 0 t browse-url 0) - ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1) - ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t - gnus-button-message-id 3)) + 0 (>= gnus-button-message-level 0) gnus-button-mailto 0) + ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) browse-url 0) + ("^Subject:" gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) browse-url 0) + ("^[^:]+:" gnus-button-url-regexp + 0 (>= gnus-button-browse-level 0) browse-url 0) + ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)" + 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) + ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" + 1 (>= gnus-button-message-level 0) gnus-button-message-id 4)) "*Alist of headers and regexps to match buttons in article heads. This alist is very similar to `gnus-button-alist', except that each @@ -5943,7 +6201,7 @@ HEADER is a regexp to match a header. For a fuller explanation, see :group 'gnus-article-buttons :group 'gnus-article-headers :type '(repeat (list (regexp :tag "Header") - regexp + (choice regexp variable) (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") @@ -5951,13 +6209,6 @@ HEADER is a regexp to match a header. For a fuller explanation, see :inline t (integer :tag "Regexp group"))))) -(defvar gnus-button-regexp nil) -(defvar gnus-button-marker-list nil) -;; Regexp matching any of the regexps from `gnus-button-alist'. - -(defvar gnus-button-last nil) -;; The value of `gnus-button-alist' when `gnus-button-regexp' was build. - ;;; Commands: (defun gnus-article-push-button (event) @@ -6009,51 +6260,43 @@ do the highlighting. See the documentation for those functions." (defun gnus-article-highlight-headers () "Highlight article headers as specified by `gnus-header-face-alist'." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((alist gnus-header-face-alist) - (buffer-read-only nil) - (case-fold-search t) - (inhibit-point-motion-hooks t) - entry regexp header-face field-face from hpoints fpoints) - (article-narrow-to-head) - (while (setq entry (pop alist)) - (goto-char (point-min)) - (setq regexp (concat "^\\(" - (if (string-equal "" (nth 0 entry)) - "[^\t ]" - (nth 0 entry)) - "\\)") - header-face (nth 1 entry) - field-face (nth 2 entry)) - (while (and (re-search-forward regexp nil t) - (not (eobp))) - (beginning-of-line) - (setq from (point)) - (unless (search-forward ":" nil t) - (forward-char 1)) - (when (and header-face - (not (memq (point) hpoints))) - (push (point) hpoints) - (gnus-put-text-property from (point) 'face header-face)) - (when (and field-face - (not (memq (setq from (point)) fpoints))) - (push from fpoints) - (if (re-search-forward "^[^ \t]" nil t) - (forward-char -2) - (goto-char (point-max))) - (gnus-put-text-property from (point) 'face field-face)))))))) + (gnus-with-article-headers + (let ((alist gnus-header-face-alist) + entry regexp header-face field-face from hpoints fpoints) + (while (setq entry (pop alist)) + (goto-char (point-min)) + (setq regexp (concat "^\\(" + (if (string-equal "" (nth 0 entry)) + "[^\t ]" + (nth 0 entry)) + "\\)") + header-face (nth 1 entry) + field-face (nth 2 entry)) + (while (and (re-search-forward regexp nil t) + (not (eobp))) + (beginning-of-line) + (setq from (point)) + (unless (search-forward ":" nil t) + (forward-char 1)) + (when (and header-face + (not (memq (point) hpoints))) + (push (point) hpoints) + (gnus-put-text-property from (point) 'face header-face)) + (when (and field-face + (not (memq (setq from (point)) fpoints))) + (push from fpoints) + (if (re-search-forward "^[^ \t]" nil t) + (forward-char -2) + (goto-char (point-max))) + (gnus-put-text-property from (point) 'face field-face))))))) (defun gnus-article-highlight-signature () "Highlight the signature in an article. It does this by highlighting everything after `gnus-signature-separator' using `gnus-signature-face'." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t)) + (gnus-with-article-buffer + (let ((inhibit-point-motion-hooks t)) (save-restriction (when (and gnus-signature-face (gnus-article-narrow-to-signature)) @@ -6075,10 +6318,8 @@ It does this by highlighting everything after \"External references\" are things like Message-IDs and URLs, as specified by `gnus-button-alist'." (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) + (gnus-with-article-buffer + (let ((inhibit-point-motion-hooks t) (case-fold-search t) (alist gnus-button-alist) beg entry regexp) @@ -6119,40 +6360,33 @@ specified by `gnus-button-alist'." (defun gnus-article-add-buttons-to-head () "Add buttons to the head of the article." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-header-button-alist) - entry beg end) - (article-narrow-to-head) - (while alist - ;; Each alist entry. - (setq entry (car alist) - alist (cdr alist)) - (goto-char (point-min)) - (while (re-search-forward (car entry) nil t) - ;; Each header matching the entry. - (setq beg (match-beginning 0)) - (setq end (or (and (re-search-forward "^[^ \t]" nil t) - (match-beginning 0)) - (point-max))) - (goto-char beg) - (while (re-search-forward (eval (nth 1 entry)) end t) - ;; Each match within a header. - (let* ((entry (cdr entry)) - (start (match-beginning (nth 1 entry))) - (end (match-end (nth 1 entry))) - (form (nth 2 entry))) - (goto-char (match-end 0)) - (when (eval form) - (gnus-article-add-button - start end (nth 3 entry) - (buffer-substring (match-beginning (nth 4 entry)) - (match-end (nth 4 entry))))))) - (goto-char end))))))) + (gnus-with-article-headers + (let ((alist gnus-header-button-alist) + entry beg end) + (while alist + ;; Each alist entry. + (setq entry (pop alist)) + (goto-char (point-min)) + (while (re-search-forward (car entry) nil t) + ;; Each header matching the entry. + (setq beg (match-beginning 0)) + (setq end (or (and (re-search-forward "^[^ \t]" nil t) + (match-beginning 0)) + (point-max))) + (goto-char beg) + (while (re-search-forward (eval (nth 1 entry)) end t) + ;; Each match within a header. + (let* ((entry (cdr entry)) + (start (match-beginning (nth 1 entry))) + (end (match-end (nth 1 entry))) + (form (nth 2 entry))) + (goto-char (match-end 0)) + (when (eval form) + (gnus-article-add-button + start end (nth 3 entry) + (buffer-substring (match-beginning (nth 4 entry)) + (match-end (nth 4 entry))))))) + (goto-char end)))))) ;;; External functions: @@ -6173,15 +6407,12 @@ specified by `gnus-button-alist'." ;;; Internal functions: (defun gnus-article-set-globals () - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-set-global-variables))) (defun gnus-signature-toggle (end) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t)) + (gnus-with-article-buffer + (let ((inhibit-point-motion-hooks t)) (if (text-property-any end (point-max) 'article-type 'signature) (progn (gnus-delete-wash-type 'signature) @@ -6217,7 +6448,7 @@ specified by `gnus-button-alist'." (fun (nth 3 entry)) (args (mapcar (lambda (group) (let ((string (match-string group))) - (gnus-set-text-properties + (set-text-properties 0 (length string) nil string) string)) (nthcdr 4 entry)))) @@ -6274,22 +6505,50 @@ specified by `gnus-button-alist'." "Fetch a man page." (funcall gnus-button-man-handler url)) -(defun gnus-button-handle-info (url) +(defun gnus-button-handle-info-url (url) "Fetch an info URL." - (if (string-match - "^\\([^:/]+\\)?/\\(.*\\)" - url) + (setq url (mm-subst-char-in-string ?+ ?\ url)) + (cond + ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url) + (gnus-info-find-node + (concat "(" (or (gnus-url-unhex-string (match-string 1 url)) + "Gnus") + ")" (gnus-url-unhex-string (match-string 2 url))))) + ((string-match "([^)\"]+)[^\"]+" url) + (setq url + (gnus-replace-in-string + (gnus-replace-in-string url "[\n\t ]+" " ") "\"" "")) + (gnus-info-find-node url)) + (t (error "Can't parse %s" url)))) + +(defun gnus-button-handle-info-url-gnome (url) + "Fetch GNOME style info URL." + (setq url (mm-subst-char-in-string ?_ ?\ url)) + (if (string-match "\\([^#]+\\)#?\\(.*\\)" url) (gnus-info-find-node - (concat "(" (or (gnus-url-unhex-string (match-string 1 url)) - "Gnus") + (concat "(" + (gnus-url-unhex-string + (match-string 1 url)) ")" - (gnus-url-unhex-string (match-string 2 url)))) + (or (gnus-url-unhex-string + (match-string 2 url)) + "Top"))) (error "Can't parse %s" url))) +(defun gnus-button-handle-info-url-kde (url) + "Fetch KDE style info URL." + (gnus-info-find-node (gnus-url-unhex-string url))) + +(defun gnus-button-handle-info-keystrokes (url) + "Call `info' when pushing the corresponding URL button." + ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'. + (info) + (Info-directory) + (Info-menu url)) + (defun gnus-button-message-id (message-id) "Fetch MESSAGE-ID." - (save-excursion - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-summary-refer-article message-id))) (defun gnus-button-fetch-group (address) @@ -6335,12 +6594,14 @@ specified by `gnus-button-alist'." (when (string-match "mailto:/*\\(.*\\)" url) (setq url (substring url (match-beginning 1) nil))) (let (to args subject func) - (if (string-match (regexp-quote "?") url) - (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) - args (gnus-url-parse-query-string - (substring url (match-end 0) nil) t)) - (setq to (gnus-url-unhex-string url))) - (setq args (cons (list "to" to) args) + (setq args (gnus-url-parse-query-string + (if (string-match "^\\?" url) + (substring url 1) + (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) + (concat "to=" (match-string 1 url) "&" + (match-string 2 url)) + (concat "to=" url))) + t) subject (cdr-safe (assoc "subject" args))) (gnus-msg-mail) (while args @@ -6348,7 +6609,9 @@ specified by `gnus-button-alist'." (if (fboundp func) (funcall func) (message-position-on-field (caar args))) - (insert (mapconcat 'identity (cdar args) ", ")) + (insert (gnus-replace-in-string + (mapconcat 'identity (reverse (cdar args)) ", ") + "\r\n" "\n" t)) (setq args (cdr args))) (if subject (message-goto-body) @@ -6365,19 +6628,22 @@ specified by `gnus-button-alist'." (defvar gnus-prev-page-map (let ((map (make-sparse-keymap))) - (unless (>= emacs-major-version 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) (define-key map gnus-mouse-2 'gnus-button-prev-page) (define-key map "\r" 'gnus-button-prev-page) map)) +(defvar gnus-next-page-map + (let ((map (make-sparse-keymap))) + (define-key map gnus-mouse-2 'gnus-button-next-page) + (define-key map "\r" 'gnus-button-next-page) + map)) + (defun gnus-insert-prev-page-button () (let ((b (point)) (buffer-read-only nil)) (gnus-eval-format gnus-prev-page-line-format nil - `(,@(gnus-local-map-property gnus-prev-page-map) + `(keymap ,gnus-prev-page-map gnus-prev t gnus-callback gnus-article-button-prev-page article-type annotation)) @@ -6389,24 +6655,6 @@ specified by `gnus-button-alist'." :action 'gnus-button-prev-page :button-keymap gnus-prev-page-map))) -(defvar gnus-prev-page-map - (let ((map (make-sparse-keymap))) - (unless (>= emacs-major-version 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) - (define-key map gnus-mouse-2 'gnus-button-prev-page) - (define-key map "\r" 'gnus-button-prev-page) - map)) - -(defvar gnus-next-page-map - (let ((map (make-sparse-keymap))) - (unless (>= emacs-major-version 21) - ;; XEmacs doesn't care. - (set-keymap-parent map gnus-article-mode-map)) - (define-key map gnus-mouse-2 'gnus-button-next-page) - (define-key map "\r" 'gnus-button-next-page) - map)) - (defun gnus-button-next-page (&optional args more-args) "Go to the next page." (interactive) @@ -6427,7 +6675,7 @@ specified by `gnus-button-alist'." (let ((b (point)) (buffer-read-only nil)) (gnus-eval-format gnus-next-page-line-format nil - `(,@(gnus-local-map-property gnus-next-page-map) + `(keymap ,gnus-next-page-map gnus-next t gnus-callback gnus-article-button-next-page article-type annotation)) @@ -6461,7 +6709,7 @@ specified by `gnus-button-alist'." This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a -\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups +\(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups whose names match REGEXP. For example: @@ -6663,8 +6911,6 @@ For example: (defvar gnus-mime-security-button-map (let ((map (make-sparse-keymap))) - (unless (>= (string-to-number emacs-version) 21) - (set-keymap-parent map gnus-article-mode-map)) (define-key map gnus-mouse-2 'gnus-article-push-button) (define-key map "\r" 'gnus-article-press-button) map)) @@ -6771,7 +7017,7 @@ For example: (gnus-eval-format gnus-mime-security-button-line-format gnus-mime-security-button-line-format-alist - `(,@(gnus-local-map-property gnus-mime-security-button-map) + `(keymap ,gnus-mime-security-button-map gnus-callback gnus-mime-security-press-button gnus-line-format ,gnus-mime-security-button-line-format gnus-mime-details ,gnus-mime-security-button-pressed