;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar tool-bar-map))
(require 'gnus)
(require 'gnus-sum)
(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")
: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
(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)
"Function used for converting HTML into text.")
(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
- (fboundp 'coding-system-p)
- (coding-system-p 'utf-8))
+ (mm-coding-system-p 'utf-8))
"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
(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
- 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"))))
+ (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")))))
((eq elem 'date)
(let ((date (message-fetch-field "date")))
(when (and date
(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))
+ (gnus-point-at-bol))
(let ((goback (point-marker)))
(fill-paragraph nil)
(goto-char (marker-position goback)))
;; 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)
+ (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
(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")
buffer-read-only)
(article-narrow-to-head)
(goto-char (point-min))
- (while (re-search-forward "\\(xn--.*\\)[ \t\n\r,>]" nil t)
+ (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))
(when entry
(setq func (cdr entry)))
(cond
- ((gnus-functionp func)
+ ((functionp func)
(funcall func))
(t
(apply (car func) (cdr func))))))))))
(< (- (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))))
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.
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)
;; 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")
(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)))
+ (vector (caddr c) (car c) :enable t))
+ gnus-mime-button-commands)))
(eval-when-compile
(define-compiler-macro popup-menu (&whole form
(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
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?
- (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))))
+ (unless (and gnus-novice-user
+ (not (gnus-yes-or-no-p
+ "Really delete attachment forever? ")))
+ (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?
+ (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))
+ (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
+ ',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)))))
;; Not in `gnus-mime-save-part-and-strip':
(gnus-article-edit-done)
(gnus-summary-expand-window)
(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
(save-excursion
(save-restriction
(widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
- t ;Nothing more.
+ (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."
(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)
:type '(choice (const "^/?tex-archive/\\|/")
(regexp :tag "Other")))
+(defcustom gnus-button-ctan-directory-regexp
+ (concat
+ "\\("; Cannot use `\(?: ... \)' (compatibility with Emacs 20).
+ "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\\(<?[a-z0-9][^<>\")!;:,{}\n\t ]*@"
gnus-button-valid-fqdn-regexp
(-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]")
;;
(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)")
+;; 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
(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
(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
: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)
- ("\\(<URL: *\\)mailto: *\\([^> \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)
+ ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
+ 2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
+ ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
+ 0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
+ ("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)
;; CTAN
- ("\\bCTAN:[ \t\n]*\\([^>)!;:,\n\t ]*\\)" 0 (>= gnus-button-tex-level 1)
- gnus-button-handle-ctan 1)
+ ("\\bCTAN:[ \t\n]*\\([^>)!;:,'\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
- ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0
- (>= gnus-button-emacs-level 1) gnus-button-handle-info 2)
+ ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)"
+ 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
+ ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0
+ (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
+ ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \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
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-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+ 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
+ ("`\\([a-z]+-[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)
("\\b\\(C-h\\|<?[Ff]1>?\\)[ \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\\|<?[Ff]1>?\\)[ \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\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" 1
+ ("`\\(\\b\\(C-h\\|<?[Ff]1>?\\)[ \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...
- ("<URL: *\\([^<>]*\\)>" 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)...
+ ("<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
(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)
+ 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
"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)
- (gnus-info-find-node
- (concat "(" (or (gnus-url-unhex-string (match-string 1 url))
- "Gnus")
- ")"
- (gnus-url-unhex-string (match-string 2 url))))
- (error "Can't parse %s" 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-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."
projects / gnus / blobdiff