X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=b13450124205732cc7b29c82282980d50c0be1ed;hb=a77dd35f2d1dc13eb88e5b153d4c03b83f7eb2c7;hp=308d75edb881f24181aca90a8432581afc2945bb;hpb=4ebe4323747adb0d4802c2673fcdc073ef22cadc;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 308d75edb..b13450124 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -149,7 +149,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." @@ -396,7 +396,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) @@ -1145,7 +1147,10 @@ See Info node `(gnus)Customizing Articles' for details." :type gnus-article-treat-custom) (put 'gnus-treat-overstrike 'highlight t) -(defcustom gnus-treat-display-xface +(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) @@ -1162,8 +1167,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) @@ -1181,7 +1203,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) @@ -1251,12 +1273,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. @@ -1367,7 +1389,7 @@ This requires GNU Libidn, and by default only enabled if it is found." (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) @@ -1607,7 +1629,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) @@ -1673,12 +1695,19 @@ always hide." (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))))) + (when + (and + from reply-to + (ignore-errors + (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"))) @@ -1726,7 +1755,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) @@ -1747,7 +1776,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 @@ -1758,7 +1787,7 @@ always hide." (progn (forward-char gnus-article-normalized-header-length) (point)) - (gnus-point-at-eol) + (point-at-eol) 'invisible t)) (t ;; Do nothing. @@ -1766,14 +1795,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)) @@ -1928,7 +1958,7 @@ unfolded." (end-of-line) (when (>= (current-column) (min fill-column width)) (narrow-to-region (min (1+ (point)) (point-max)) - (gnus-point-at-bol)) + (point-at-bol)) (let ((goback (point-marker))) (fill-paragraph nil) (goto-char (marker-position goback))) @@ -1970,7 +2000,7 @@ 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)))))) @@ -2057,23 +2087,25 @@ 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 (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." @@ -2729,11 +2761,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)) @@ -2915,9 +2947,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) @@ -3383,8 +3418,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) @@ -3576,7 +3611,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) @@ -3760,10 +3795,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)) @@ -3860,22 +3893,6 @@ General format specifiers can also be used. See Info node (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)))))))) - (defun gnus-mime-button-menu (event prefix) "Construct a context-sensitive menu of MIME commands." (interactive "e\nP") @@ -3992,8 +4009,6 @@ Replace it with some information about the removed part." (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" @@ -4001,10 +4016,12 @@ Replace it with some information about the removed part." "| Filename: " filename "\n" "| Size (encoded): " bsize " Byte\n" "| Description: " description "\n" - "`----\n" - "<#/part>")) + "`----\n")) (setcdr data - (cdr (mm-make-handle nil `("text/plain")))))) + (cdr (mm-make-handle + nil `("text/plain") nil nil + (list "attachment") + (format "Deleted attachment (%s bytes)" bsize)))))) (set-buffer gnus-summary-buffer) ;; FIXME: maybe some of the following code (borrowed from ;; `gnus-mime-save-part-and-strip') isn't necessary? @@ -4317,7 +4334,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)) @@ -4908,27 +4926,32 @@ 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 @@ -4941,7 +4964,7 @@ If given a numerical ARG, move forward ARG pages." (defun gnus-article-goto-prev-page () - "Show the next page of the article." + "Show the previous page of the article." (interactive) (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) @@ -4975,7 +4998,8 @@ 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? + (widen) + (eobp)))) ;Real end-of-buffer? (progn (when gnus-article-over-scroll (gnus-article-next-page-1 lines)) @@ -5036,9 +5060,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)) @@ -5702,7 +5726,8 @@ It should match all directories in the top level of `gnus-ctan-url'." :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." @@ -5797,13 +5822,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) @@ -5845,8 +5871,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)))) @@ -6012,11 +6040,15 @@ positives are possible." 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) - ("mailto:\\([-a-z.@_+0-9%=?]+\\)" + ;; RFC 2368 (The mailto URL scheme) + ("mailto:\\([-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) @@ -6034,9 +6066,15 @@ positives are possible." 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 - ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" - 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2) + ;; 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" @@ -6069,6 +6107,8 @@ positives are possible." 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" @@ -6077,9 +6117,15 @@ positives are possible." ;; Unlike the other regexps we really have to require quoting ;; here to determine where it ends. 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) - ;; This is how URLs _should_ be embedded in text (RFC 1738)... + ;; 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 (>= gnus-button-browse-level 0) browse-url 0) @@ -6116,7 +6162,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") @@ -6137,7 +6183,7 @@ variable it the real callback function." 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%=?]+\\)" + ("^[^:]+:" "\\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)) @@ -6153,7 +6199,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") @@ -6486,6 +6532,7 @@ specified by `gnus-button-alist'." (defun gnus-button-handle-info-url (url) "Fetch an info URL." + (setq url (mm-subst-char-in-string ?+ ?\ url)) (cond ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url) (gnus-info-find-node @@ -6499,6 +6546,24 @@ specified by `gnus-button-alist'." (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 "(" + (gnus-url-unhex-string + (match-string 1 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'. @@ -6555,12 +6620,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 @@ -6568,7 +6635,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)