;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
(require 'gnus-int)
(require 'browse-url)
-(defgroup article nil
+(defgroup gnus-article nil
"Article display."
+ :link '(custom-manual "(gnus)The Article Buffer")
:group 'gnus)
+(defgroup gnus-article-hiding nil
+ "Hiding article parts."
+ :link '(custom-manual "(gnus)Article Hiding")
+ :group 'gnus-article)
+
+(defgroup gnus-article-highlight nil
+ "Article highlighting."
+ :link '(custom-manual "(gnus)Article Highlighting")
+ :group 'gnus-article
+ :group 'gnus-visual)
+
+(defgroup gnus-article-signature nil
+ "Article signatures."
+ :link '(custom-manual "(gnus)Article Signature")
+ :group 'gnus-article)
+
+(defgroup gnus-article-headers nil
+ "Article headers."
+ :link '(custom-manual "(gnus)Hiding Headers")
+ :group 'gnus-article)
+
+(defgroup gnus-article-washing nil
+ "Special commands on articles."
+ :link '(custom-manual "(gnus)Article Washing")
+ :group 'gnus-article)
+
+(defgroup gnus-article-emphasis nil
+ "Fontisizing articles."
+ :link '(custom-manual "(gnus)Article Fontisizing")
+ :group 'gnus-article)
+
+(defgroup gnus-article-saving nil
+ "Saving articles."
+ :link '(custom-manual "(gnus)Saving Articles")
+ :group 'gnus-article)
+
+(defgroup gnus-article-mime nil
+ "Worshiping the MIME wonder."
+ :link '(custom-manual "(gnus)Using MIME")
+ :group 'gnus-article)
+
+(defgroup gnus-article-buttons nil
+ "Pushable buttons in the article buffer."
+ :link '(custom-manual "(gnus)Article Buttons")
+ :group 'gnus-article)
+
+(defgroup gnus-article-various nil
+ "Other article options."
+ :link '(custom-manual "(gnus)Misc Article")
+ :group 'gnus-article)
+
(defcustom gnus-ignored-headers
'("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:"
"^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:"
:type '(choice :custom-show nil
regexp
(repeat regexp))
- :group 'article)
+ :group 'gnus-article-hiding)
(defcustom gnus-visible-headers
- "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
+ "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From"
"All headers that do not match this regexp will be hidden.
This variable can also be a list of regexp of headers to remain visible.
If this variable is non-nil, `gnus-ignored-headers' will be ignored."
(or (stringp value)
(widget-editable-list-match widget value)))
regexp)
- :group 'article)
+ :group 'gnus-article-hiding)
(defcustom gnus-sorted-header-list
'("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
be placed first in the article buffer in the sequence specified by
this list."
:type '(repeat regexp)
- :group 'article)
+ :group 'gnus-article-hiding)
(defcustom gnus-boring-article-headers '(empty followup-to reply-to)
"Headers that are only to be displayed if they have interesting data.
(const :tag "Followup-to identical to newsgroups." followup-to)
(const :tag "Reply-to identical to from." reply-to)
(const :tag "Date less than four days old." date))
- :group 'article)
+ :group 'gnus-article-hiding)
(defcustom gnus-signature-separator '("^-- $" "^-- *$")
"Regexp matching signature separator.
from head to tail looking for a separator. Searches will be done from
the end of the buffer."
:type '(repeat string)
- :group 'article)
+ :group 'gnus-article-signature)
(defcustom gnus-signature-limit nil
"Provide a limit to what is considered a signature.
no signature in the buffer. If it is a string, it will be used as a
regexp. If it matches, the text in question is not a signature."
:type '(choice integer number function regexp)
- :group 'article)
+ :group 'gnus-article-signature)
(defcustom gnus-hidden-properties '(invisible t intangible t)
"Property list to use for hiding text."
:type 'sexp
- :group 'article)
+ :group 'gnus-article-hiding)
(defcustom gnus-article-x-face-command
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
:type 'string ;Leave function case to Lisp.
- :group 'article)
+ :group 'gnus-article-washing)
(defcustom gnus-article-x-face-too-ugly nil
"Regexp matching posters whose face shouldn't be shown automatically."
:type 'regexp
- :group 'article)
+ :group 'gnus-article-washing)
(defcustom gnus-emphasis-alist
(let ((format
- "\\(\\s-\\|^\\|[-\"\(]\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*\\)%s\\)\\(\\s-\\|[-?!.,;:\"\)]\\)")
+ "\\(\\s-\\|^\\|[-\"\(]\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"\)]\\)")
(types
'(("_" "_" underline)
("/" "/" italic)
("_\\*" "\\*_" underline-bold)
("\\*/" "/\\*" bold-italic)
("_\\*/" "/\\*_" underline-bold-italic))))
- `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+ `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
2 3 gnus-emphasis-underline)
,@(mapcar
(lambda (spec)
(integer :tag "Match group")
(integer :tag "Emphasize group")
face))
- :group 'article)
+ :group 'gnus-article-emphasis)
(defface gnus-emphasis-bold '((t (:bold t)))
"Face used for displaying strong emphasized text (*word*)."
- :group 'article)
+ :group 'gnus-article-emphasis)
(defface gnus-emphasis-italic '((t (:italic t)))
"Face used for displaying italic emphasized text (/word/)."
- :group 'article)
+ :group 'gnus-article-emphasis)
(defface gnus-emphasis-underline '((t (:underline t)))
"Face used for displaying underlined emphasized text (_word_)."
- :group 'article)
+ :group 'gnus-article-emphasis)
(defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
"Face used for displaying underlined bold emphasized text (_*word*_)."
- :group 'article)
+ :group 'gnus-article-emphasis)
(defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
"Face used for displaying underlined italic emphasized text (_*word*_)."
- :group 'article)
+ :group 'gnus-article-emphasis)
(defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
"Face used for displaying bold italic emphasized text (/*word*/)."
- :group 'article)
+ :group 'gnus-article-emphasis)
(defface gnus-emphasis-underline-bold-italic
'((t (:bold t :italic t :underline t)))
- "Face used for displaying underlined bold italic emphasized text (_/*word*/_)."
- :group 'article)
+ "Face used for displaying underlined bold italic emphasized text.
+Esample: (_/*word*/_)."
+ :group 'gnus-article-emphasis)
+
+(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
+ "Format for display of Date headers in article bodies.
+See `format-time-zone' for the possible values."
+ :type 'string
+ :link '(custom-manual "(gnus)Article Date")
+ :group 'gnus-article-washing)
(eval-and-compile
(autoload 'hexl-hex-string-to-integer "hexl")
(defcustom gnus-article-save-directory gnus-directory
"*Name of the directory articles will be saved in (default \"~/News\")."
- :group 'article
+ :group 'gnus-article-saving
:type 'directory)
(defcustom gnus-save-all-headers t
"*If non-nil, don't remove any headers before saving."
- :group 'article
+ :group 'gnus-article-saving
:type 'boolean)
(defcustom gnus-prompt-before-saving 'always
saving large batches of articles. If this variable is neither nil not
`always', there the user will be prompted once for a file name for
each invocation of the saving commands."
- :group 'article
+ :group 'gnus-article-saving
:type '(choice (item always)
(item :tag "never" nil)
(sexp :tag "once" :format "%t")))
If `gnus-save-all-headers' is non-nil, this variable will be ignored.
If that variable is nil, however, all headers that match this regexp
will be kept while the rest will be deleted before saving."
- :group 'article
+ :group 'gnus-article-saving
:type '(repeat string))
(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
* gnus-summary-save-in-file (article format)
* gnus-summary-save-in-vm (use VM's folder format)
* gnus-summary-write-to-file (article format -- overwrite)."
- :group 'article
+ :group 'gnus-article-saving
:type '(radio (function-item gnus-summary-save-in-rmail)
(function-item gnus-summary-save-in-mail)
(function-item gnus-summary-save-in-folder)
(defcustom gnus-rmail-save-name 'gnus-plain-save-name
"A function generating a file name to save articles in Rmail format.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
- :group 'article
+ :group 'gnus-article-saving
:type 'function)
(defcustom gnus-mail-save-name 'gnus-plain-save-name
"A function generating a file name to save articles in Unix mail format.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
- :group 'article
+ :group 'gnus-article-saving
:type 'function)
(defcustom gnus-folder-save-name 'gnus-folder-save-name
"A function generating a file name to save articles in MH folder.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
- :group 'article
+ :group 'gnus-article-saving
:type 'function)
(defcustom gnus-file-save-name 'gnus-numeric-save-name
"A function generating a file name to save articles in article format.
The function is called with NEWSGROUP, HEADERS, and optional
LAST-FILE."
- :group 'article
+ :group 'gnus-article-saving
:type 'function)
(defcustom gnus-split-methods
If this form or function returns a string, this string will be used as
a possible file name; and if it returns a non-nil list, that list will
be used as possible file names."
- :group 'article
+ :group 'gnus-article-saving
:type '(repeat (choice (list function)
(cons regexp (repeat string))
sexp)))
(defcustom gnus-strict-mime t
"*If nil, MIME-decode even if there is no Mime-Version header."
- :group 'article
+ :group 'gnus-article-mime
:type 'boolean)
(defcustom gnus-show-mime-method 'metamail-buffer
"Function to process a MIME message.
The function is called from the article buffer."
- :group 'article
+ :group 'gnus-article-mime
:type 'function)
(defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable
"*Function to decode MIME encoded words.
The function is called from the article buffer."
- :group 'article
+ :group 'gnus-article-mime
:type 'function)
(defcustom gnus-page-delimiter "^\^L"
The default value is \"^\^L\", which is a form linefeed at the
beginning of a line."
:type 'regexp
- :group 'article)
+ :group 'gnus-article-various)
(defcustom gnus-article-mode-line-format "Gnus: %%b %S"
"*The format specification for the article mode line.
See `gnus-summary-mode-line-format' for a closer description."
:type 'string
- :group 'article)
+ :group 'gnus-article-various)
(defcustom gnus-article-mode-hook nil
"*A hook for Gnus article mode."
:type 'hook
- :group 'article)
+ :group 'gnus-article-various)
(defcustom gnus-article-menu-hook nil
"*Hook run after the creation of the article mode menu."
:type 'hook
- :group 'article)
+ :group 'gnus-article-various)
(defcustom gnus-article-prepare-hook nil
"*A hook called after an article has been prepared in the article buffer.
If you want to run a special decoding program like nkf, use this hook."
:type 'hook
- :group 'article)
+ :group 'gnus-article-various)
(defcustom gnus-article-button-face 'bold
"Face used for highlighting buttons in the article buffer.
An article button is a piece of text that you can activate by pressing
`RET' or `mouse-2' above it."
:type 'face
- :group 'article)
+ :group 'gnus-article-buttons)
(defcustom gnus-article-mouse-face 'highlight
"Face used for mouse highlighting in the article buffer.
Article buttons will be displayed in this face when the cursor is
above them."
:type 'face
- :group 'article)
+ :group 'gnus-article-buttons)
(defcustom gnus-signature-face 'italic
"Face used for highlighting a signature in the article buffer."
:type 'face
- :group 'article)
+ :group 'gnus-article-highlight
+ :group 'gnus-article-signature)
(defface gnus-header-from-face
'((((class color)
(t
(:bold t :italic t)))
"Face used for displaying from headers."
- :group 'article)
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
(defface gnus-header-subject-face
'((((class color)
(t
(:bold t :italic t)))
"Face used for displaying subject headers."
- :group 'article)
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
(defface gnus-header-newsgroups-face
'((((class color)
(t
(:bold t :italic t)))
"Face used for displaying newsgroups headers."
- :group 'article)
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
(defface gnus-header-name-face
'((((class color)
(t
(:bold t)))
"Face used for displaying header names."
- :group 'article)
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
(defface gnus-header-content-face
'((((class color)
(:foreground "DarkGreen" :italic t))
(t
(:italic t))) "Face used for displaying header content."
- :group 'article)
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight)
(defcustom gnus-header-face-alist
'(("From" nil gnus-header-from-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."
- :group 'article
+ :group 'gnus-article-headers
+ :group 'gnus-article-highlight
:type '(repeat (list (regexp :tag "Header")
(choice :tag "Name"
(item :tag "skip" nil)
(reply-to (message-fetch-field "reply-to")))
(when (and
from reply-to
- (equal
- (nth 1 (mail-extract-address-components from))
- (nth 1 (mail-extract-address-components reply-to))))
+ (ignore-errors
+ (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")))
(interactive (gnus-article-hidden-arg))
(unless (gnus-article-check-hidden-text 'pgp arg)
(save-excursion
- (let (buffer-read-only beg end)
+ (let ((inhibit-point-motion-hooks t)
+ buffer-read-only beg end)
(widen)
(goto-char (point-min))
;; Hide the "header".
- (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
- (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp))
+ (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
+ (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp))
(setq beg (point))
;; Hide the actual signature.
(and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "^- " nil t)
- (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp))
+ (gnus-article-hide-text-type
+ (match-beginning 0) (match-end 0) 'pgp))
(widen))))))
(defun article-hide-pem (&optional arg)
(save-restriction
(let ((buffer-read-only nil))
(when (gnus-article-narrow-to-signature)
- (gnus-article-hide-text-type (point-min) (point-max) 'signature)))))))
+ (gnus-article-hide-text-type
+ (point-min) (point-max) 'signature)))))))
(defun article-strip-leading-blank-lines ()
"Remove all blank lines from the beginning of the article."
Arg can be nil or a number. Nil and positive means hide, negative
means show, 0 means toggle."
(save-excursion
- (let ((hide (gnus-article-hidden-text-p type)))
- (cond
- ((or (null arg)
- (> arg 0))
- nil)
- ((< arg 0)
- (gnus-article-show-hidden-text type))
- (t
- (if (eq hide 'hidden)
- (gnus-article-show-hidden-text type)
- nil))))))
+ (save-restriction
+ (widen)
+ (let ((hide (gnus-article-hidden-text-p type)))
+ (cond
+ ((or (null arg)
+ (> arg 0))
+ nil)
+ ((< arg 0)
+ (gnus-article-show-hidden-text type))
+ (t
+ (if (eq hide 'hidden)
+ (gnus-article-show-hidden-text type)
+ nil)))))))
(defun gnus-article-hidden-text-p (type)
"Say whether the current buffer contains hidden text of type TYPE."
beg)
(while (setq beg (text-property-any end (point-max) 'article-type type))
(goto-char beg)
- (setq end (text-property-not-all beg (point-max) 'article-type type))
+ (setq end (or
+ (text-property-not-all beg (point-max) 'article-type type)
+ (point-max)))
(if hide
(gnus-article-hide-text beg end gnus-hidden-properties)
(gnus-article-unhide-text beg end))
;; Get the original date from the article.
((eq type 'original)
(concat "Date: " date "\n"))
+ ;; Let the user define the format.
+ ((eq type 'user)
+ (concat
+ (format-time-string gnus-article-time-format
+ (ignore-errors
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT"))))
+ "\n"))
;; Do an X-Sent lapsed format.
((eq type 'lapsed)
;; If the date is seriously mangled, the timezone functions are
(interactive (list t))
(article-date-ut 'lapsed highlight))
+(defun article-date-user (&optional highlight)
+ "Convert the current article date to the user-defined format."
+ (interactive (list t))
+ (article-date-ut 'user highlight))
+
(defun article-show-all ()
"Show all hidden text in the article buffer."
(interactive)
(save-excursion
(let ((alist gnus-emphasis-alist)
(buffer-read-only nil)
- (props (append '(gnus-article-type emphasis)
+ (props (append '(article-type emphasis)
gnus-hidden-properties))
regexp elem beg invisible visible face)
(goto-char (point-min))
(save-excursion
(save-restriction
(widen)
- (if (and (file-readable-p filename) (mail-file-babyl-p filename))
- (gnus-output-to-rmail filename)
- (let ((mail-use-rfc822 t))
- (rmail-output filename 1 t t))))))
+ (if (and (file-readable-p filename)
+ (mail-file-babyl-p filename))
+ (gnus-output-to-rmail filename t)
+ (gnus-output-to-mail filename t)))))
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-mail filename)))
(defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
+If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num.
Otherwise, it is like ~/News/news/group/num."
(let ((default
(expand-file-name
article-strip-blank-lines
article-date-local
article-date-original
+ article-date-ut
+ article-date-user
article-date-lapsed
article-emphasize
(article-show-all . gnus-article-show-all-headers))))
"\C-d" gnus-article-read-summary-keys
"\M-*" gnus-article-read-summary-keys
+ "\M-#" gnus-article-read-summary-keys
+ "\M-^" gnus-article-read-summary-keys
"\M-g" gnus-article-read-summary-keys)
(substitute-key-definition
["Remove carriage return" gnus-article-remove-cr t]
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]))
- (when (boundp 'gnus-summary-article-menu)
- (define-key gnus-article-mode-map [menu-bar commands]
- (cons "Commands" gnus-summary-article-menu)))
+ (when nil
+ (when (boundp 'gnus-summary-article-menu)
+ (define-key gnus-article-mode-map [menu-bar commands]
+ (cons "Commands" gnus-summary-article-menu))))
(when (boundp 'gnus-summary-post-menu)
(define-key gnus-article-mode-map [menu-bar post]
;;; Article savers.
-(defun gnus-output-to-rmail (file-name)
- "Append the current article to an Rmail file named FILE-NAME."
- (require 'rmail)
- ;; Most of these codes are borrowed from rmailout.el.
- (setq file-name (expand-file-name file-name))
- (setq rmail-default-rmail-file file-name)
- (let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-output*")))
- (save-excursion
- (or (get-file-buffer file-name)
- (file-exists-p file-name)
- (if (gnus-yes-or-no-p
- (concat "\"" file-name "\" does not exist, create it? "))
- (let ((file-buffer (create-file-buffer file-name)))
- (save-excursion
- (set-buffer file-buffer)
- (rmail-insert-rmail-file-header)
- (let ((require-final-newline nil))
- (gnus-write-buffer file-name)))
- (kill-buffer file-buffer))
- (error "Output file does not exist")))
- (set-buffer tmpbuf)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert-buffer-substring artbuf)
- (gnus-convert-article-to-rmail)
- ;; Decide whether to append to a file or to an Emacs buffer.
- (let ((outbuf (get-file-buffer file-name)))
- (if (not outbuf)
- (append-to-file (point-min) (point-max) file-name)
- ;; File has been visited, in buffer OUTBUF.
- (set-buffer outbuf)
- (let ((buffer-read-only nil)
- (msg (and (boundp 'rmail-current-message)
- (symbol-value 'rmail-current-message))))
- ;; If MSG is non-nil, buffer is in RMAIL mode.
- (when msg
- (widen)
- (narrow-to-region (point-max) (point-max)))
- (insert-buffer-substring tmpbuf)
- (when msg
- (goto-char (point-min))
- (widen)
- (search-backward "\^_")
- (narrow-to-region (point) (point-max))
- (goto-char (1+ (point-min)))
- (rmail-count-new-messages t)
- (rmail-show-message msg))))))
- (kill-buffer tmpbuf)))
-
(defun gnus-output-to-file (file-name)
"Append the current article to a file named FILE-NAME."
(let ((artbuf (current-buffer)))
(insert "\n")
(append-to-file (point-min) (point-max) file-name))))
-(defun gnus-convert-article-to-rmail ()
- "Convert article in current buffer to Rmail message format."
- (let ((buffer-read-only nil))
- ;; Convert article directly into Babyl format.
- ;; Suggested by Rob Austein <sra@lcs.mit.edu>
- (goto-char (point-min))
- (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
- (while (search-forward "\n\^_" nil t) ;single char
- (replace-match "\n^_" t t)) ;2 chars: "^" and "_"
- (goto-char (point-max))
- (insert "\^_")))
-
(defun gnus-narrow-to-page (&optional arg)
"Narrow the article buffer to a page.
If given a numerical ARG, move forward ARG pages."
(defun gnus-article-goto-prev-page ()
"Show the next page of the article."
(interactive)
- (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))
+ (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
(gnus-article-prev-page nil)))
(defun gnus-article-next-page (&optional lines)
keys)
(save-excursion
(set-buffer gnus-summary-buffer)
- (push (or key last-command-event) unread-command-events)
- (setq keys (read-key-sequence nil)))
+ (let (gnus-pick-mode)
+ (push (or key last-command-event) unread-command-events)
+ (setq keys (read-key-sequence nil))))
(message "")
(if (or (member keys nosaves)
(let (func)
(save-window-excursion
(pop-to-buffer gnus-summary-buffer 'norecord)
- (setq func (lookup-key (current-local-map) keys)))
+ ;; We disable the pick minor mode commands.
+ (let (gnus-pick-mode)
+ (setq func (lookup-key (current-local-map) keys))))
(if (not func)
(ding)
(unless (member keys nosave-in-article)
(pop-to-buffer gnus-summary-buffer 'norecord)
(switch-to-buffer gnus-summary-buffer 'norecord))
(setq in-buffer (current-buffer))
- (if (setq func (lookup-key (current-local-map) keys))
+ ;; We disable the pick minor mode commands.
+ (if (setq func (let (gnus-pick-mode)
+ (lookup-key (current-local-map) keys)))
(call-interactively func)
(ding))
(when (eq in-buffer (current-buffer))
(defcustom gnus-article-edit-mode-hook nil
"Hook run in article edit mode buffers."
- :group 'article
+ :group 'gnus-article-various
:type 'hook)
(defvar gnus-article-edit-done-function nil)
;;; Internal Variables:
-(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)*\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)"
+(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)"
"Regular expression that matches URLs."
- :group 'article
+ :group 'gnus-article-buttons
:type 'regexp)
(defcustom gnus-button-alist
- `(("\\(<?\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>?\\)" 1 t
+ `(("\\(\\b<\\(url: ?\\)?news:\\([^>\n\t ]*\\)>\\)" 1 t
+ gnus-button-message-id 3)
+ ("\\bnews:\\([^\n\t ]+\\)" 0 t gnus-button-message-id 1)
+ ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t
gnus-button-fetch-group 4)
+ ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2)
("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
- ("\\(<?\\(url: ?\\)?news:\\([^>\n\t ]*\\)>?\\)" 1 t
- gnus-button-message-id 3)
- ("\\(<URL: *\\)?mailto: *\\([^> \n\t]+\\)>?" 0 t gnus-url-mailto 2)
+ ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 1)
+ ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 2)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^>]*\\)>" 0 t gnus-button-embedded-url 1)
;; Raw URLs.
CALLBACK can also be a variable, in that case the value of that
variable it the real callback function."
- :group 'article
+ :group 'gnus-article-buttons
:type '(repeat (list regexp
(integer :tag "Button")
(sexp :tag "Form")
HEADER is a regexp to match a header. For a fuller explanation, see
`gnus-button-alist'."
- :group 'article
+ :group 'gnus-article-buttons
+ :group 'gnus-article-headers
:type '(repeat (list (regexp :tag "Header")
regexp
(integer :tag "Button")
(defun gnus-url-mailto (url)
;; Send mail to someone
- (if (not (string-match "mailto:/*\\(.*\\)" url))
- (error "Malformed mailto link: %s" url))
- (setq url (substring url (match-beginning 1) nil))
+ (when (string-match "mailto:/*\\(.*\\)" url)
+ (setq url (substring url (match-beginning 1) nil)))
(let (to args source-url subject func)
(if (string-match (regexp-quote "?") url)
(setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0)))
(gnus-article-prev-page)
(select-window win)))
+(gnus-ems-redefine)
+
(provide 'gnus-art)
(run-hooks 'gnus-art-load-hook)
projects / gnus / blobdiff