;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
signatures, but will never scroll down to show you a page consisting
only of boring text. Boring text is controlled by
`gnus-article-boring-faces'."
+ :version "22.1"
:type 'boolean
:group 'gnus-article-hiding)
(symbol :tag "Item in `gnus-article-banner-alist'" none)
regexp
(const :tag "None" nil))))
+ :version "22.1"
:group 'gnus-article-washing)
+(defmacro gnus-emphasis-custom-with-format (&rest body)
+ `(let ((format "\
+\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\
+\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)"))
+ ,@body))
+
+(defun gnus-emphasis-custom-value-to-external (value)
+ (gnus-emphasis-custom-with-format
+ (if (consp (car value))
+ (list (format format (car (car value)) (cdr (car value)))
+ 2
+ (if (nth 1 value) 2 3)
+ (nth 2 value))
+ value)))
+
+(defun gnus-emphasis-custom-value-to-internal (value)
+ (gnus-emphasis-custom-with-format
+ (let ((regexp (concat "\\`"
+ (format (regexp-quote format)
+ "\\([^()]+\\)" "\\([^()]+\\)")
+ "\\'"))
+ pattern)
+ (if (string-match regexp (setq pattern (car value)))
+ (list (cons (match-string 1 pattern) (match-string 2 pattern))
+ (= (nth 2 value) 2)
+ (nth 3 value))
+ value))))
+
(defcustom gnus-emphasis-alist
- (let ((format
- "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
- (types
- '(("\\*" "\\*" bold)
+ (let ((types
+ '(("\\*" "\\*" bold nil 2)
("_" "_" underline)
("/" "/" italic)
("_/" "/_" underline-italic)
("_\\*" "\\*_" underline-bold)
("\\*/" "/\\*" bold-italic)
("_\\*/" "/\\*_" underline-bold-italic))))
- `(,@(mapcar
- (lambda (spec)
- (list
- (format format (car spec) (cadr spec))
- 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
- types)
- ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
- 2 3 gnus-emphasis-underline)))
+ (nconc
+ (gnus-emphasis-custom-with-format
+ (mapcar (lambda (spec)
+ (list (format format (car spec) (cadr spec))
+ (or (nth 3 spec) 2)
+ (or (nth 4 spec) 3)
+ (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
+ types))
+ '(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+ 2 3 gnus-emphasis-underline))))
"*Alist that says how to fontify certain phrases.
Each item looks like this:
the entire emphasized word. The third is a number that says what
regexp grouping should be displayed and highlighted. The fourth
is the face used for highlighting."
- :type '(repeat (list :value ("" 0 0 default)
- regexp
- (integer :tag "Match group")
- (integer :tag "Emphasize group")
- face))
+ :type
+ '(repeat
+ (menu-choice
+ :format "%[Customizing Style%]\n%v"
+ :indent 2
+ (group :tag "Default"
+ :value ("" 0 0 default)
+ :value-create
+ (lambda (widget)
+ (let ((value (widget-get
+ (cadr (widget-get (widget-get widget :parent)
+ :args))
+ :value)))
+ (if (not (eq (nth 2 value) 'default))
+ (widget-put
+ widget
+ :value
+ (gnus-emphasis-custom-value-to-external value))))
+ (widget-group-value-create widget))
+ regexp
+ (integer :format "Match group: %v")
+ (integer :format "Emphasize group: %v")
+ face)
+ (group :tag "Simple"
+ :value (("_" . "_") nil default)
+ (cons :format "%v"
+ (regexp :format "Start regexp: %v")
+ (regexp :format "End regexp: %v"))
+ (boolean :format "Show start and end patterns: %[%v%]\n"
+ :on " On " :off " Off ")
+ face)))
+ :get (lambda (symbol)
+ (mapcar 'gnus-emphasis-custom-value-to-internal
+ (default-value symbol)))
+ :set (lambda (symbol value)
+ (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external
+ value)))
:group 'gnus-article-emphasis)
(defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
'((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
(\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
-This variable is an alist where the where the key is the match and the
-value is a list of possible files to save in if the match is non-nil.
+This variable is an alist where the key is the match and the
+value is a list of possible files to save in if the match is
+non-nil.
If the match is a string, it is used as a regexp match on the
article. If the match is a symbol, that symbol will be funcalled
-from the buffer of the article to be saved with the newsgroup as the
-parameter. If it is a list, it will be evaled in the same buffer.
+from the buffer of the article to be saved with the newsgroup as
+the parameter. If it is a list, it will be evaled in the same
+buffer.
-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."
+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 'gnus-article-saving
:type '(repeat (choice (list :value (fun) function)
(cons :value ("" "") regexp (repeat string))
:type 'hook
:group 'gnus-article-various)
+(defcustom gnus-copy-article-ignored-headers nil
+ "List of headers to be removed when copying an article.
+Each element is a regular expression."
+ :version "22.0" ;; No Gnus
+ :type '(repeat regexp)
+ :group 'gnus-article-various)
+
(make-obsolete-variable 'gnus-article-hide-pgp-hook
"This variable is obsolete in Gnus 5.10.")
To see e.g. security buttons you could set this to
`(\"multipart/signed\")'.
This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
- :version "21.1"
+ :version "22.1"
:group 'gnus-article-mime
:type '(repeat regexp))
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"
+ :version "22.1"
:group 'gnus-article-mime
:type 'boolean)
"String used to delimit header and body.
This variable is used by `gnus-article-treat-body-boundary' which can
be controlled by `gnus-treat-body-boundary'."
+ :version "22.1"
:group 'gnus-article-various
:type '(choice (item :tag "None" :value nil)
string))
"Defines the location of the faces database.
For information on obtaining this database of pretty pictures, please
see http://www.cs.indiana.edu/picons/ftp/index.html"
+ :version "22.1"
:type '(repeat directory)
:link '(url-link :tag "download"
"http://www.cs.indiana.edu/picons/ftp/index.html")
"Remove carriage returns.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
+ :version "22.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
"Remove newlines from within URLs.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
+ :version "22.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
"Remove leading whitespace in headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
+ :version "22.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
"Display the Date in a format that can be read aloud in English.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
+ :version "22.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
"Unfold folded header lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
+ :version "22.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
"Fold headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
+ :version "22.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
"Fold the Newsgroups and Followup-To headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
+ :version "22.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)X-Face' for details."
:group 'gnus-article-treat
- :version "21.1"
+ :version "22.1"
:link '(custom-manual "(gnus)Customizing Articles")
:link '(custom-manual "(gnus)X-Face")
:type gnus-article-treat-head-custom)
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
+ :version "22.1"
:group 'gnus-article-treat
:group 'gnus-picon
:link '(custom-manual "(gnus)Customizing Articles")
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
+ :version "22.1"
:group 'gnus-article-treat
:group 'gnus-picon
:link '(custom-manual "(gnus)Customizing Articles")
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
+ :version "22.1"
:group 'gnus-article-treat
:group 'gnus-picon
:link '(custom-manual "(gnus)Customizing Articles")
(put 'gnus-treat-newsgroups-picon 'highlight t)
(defcustom gnus-treat-body-boundary
- (if (or gnus-treat-newsgroups-picon
- gnus-treat-mail-picon
- gnus-treat-from-picon)
+ (if (and (eq window-system 'x)
+ (or gnus-treat-newsgroups-picon
+ gnus-treat-mail-picon
+ gnus-treat-from-picon))
'head nil)
"Draw a boundary at the end of the headers.
Valid values are nil and `head'.
See Info node `(gnus)Customizing Articles' for details."
- :version "21.1"
+ :version "22.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-head-custom)
"Format as HTML.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
+ :version "22.1"
:group 'gnus-article-treat
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
To automatically treat X-PGP-Sig, set it to head.
Valid values are nil, t, `head', `last', an integer or a predicate.
See Info node `(gnus)Customizing Articles' for details."
+ :version "22.1"
:group 'gnus-article-treat
:group 'mime-security
:link '(custom-manual "(gnus)Customizing Articles")
(defcustom gnus-article-encrypt-protocol "PGP"
"The protocol used for encrypt articles.
It is a string, such as \"PGP\". If nil, ask user."
+ :version "22.1"
:type 'string
:group 'mime-security)
(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."
+ :version "22.1"
: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."
+ :version "22.1"
:group 'gnus-article
:type 'boolean)
(save-excursion
(save-restriction
(let ((inhibit-read-only t)
- (list gnus-boring-article-headers)
- (inhibit-point-motion-hooks t)
- elem)
+ (inhibit-point-motion-hooks t))
(article-narrow-to-head)
- (while list
- (setq elem (pop list))
+ (dolist (elem gnus-boring-article-headers)
(goto-char (point-min))
(cond
;; Hide empty headers.
MAP is an alist where the elements are on the form (\"from\" \"to\")."
(save-excursion
(when (article-goto-body)
- (let ((inhibit-read-only t)
- elem)
- (while (setq elem (pop map))
+ (let ((inhibit-read-only t))
+ (dolist (elem map)
(save-excursion
(while (search-forward (car elem) nil t)
(replace-match (cadr elem)))))))))
(mail-narrow-to-head)
(while (gnus-article-goto-header "Face")
(setq faces (nconc faces (list (mail-header-field-value)))))))
- (while (setq face (pop faces))
+ (dolist (face faces)
(let ((png (gnus-convert-face-to-png face))
image)
(when png
(let ((inhibit-read-only t))
(goto-char (point-min))
(while (re-search-forward
- "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
+ "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
(replace-match "\\1\\3" t)))
(when (interactive-p)
(gnus-treat-article nil))))
(make-local-variable 'gnus-article-image-alist)
(make-local-variable 'gnus-article-charset)
(make-local-variable 'gnus-article-ignored-charsets)
+ ;; Prevent recent Emacsen from displaying non-break space as "\ ".
+ (set (make-local-variable 'show-nonbreak-escape) nil)
(gnus-set-default-directory)
(buffer-disable-undo)
(setq buffer-read-only t
(mm-enable-multibyte)
(setq major-mode 'gnus-original-article-mode)
(make-local-variable 'gnus-original-article))
- (if (get-buffer name)
+ (if (and (get-buffer name)
+ (with-current-buffer name
+ (if gnus-article-edit-mode
+ (if (y-or-n-p "Article mode edit in progress; discard? ")
+ (progn
+ (set-buffer-modified-p nil)
+ (gnus-kill-buffer name)
+ (message "")
+ nil)
+ (error "Action aborted"))
+ t)))
(save-excursion
(set-buffer name)
- (when (and gnus-article-edit-mode
- (buffer-modified-p)
- (not
- (y-or-n-p "Article mode edit in progress; discard? ")))
- (error "Action aborted"))
(set (make-local-variable 'gnus-article-edit-mode) nil)
(when gnus-article-mime-handles
(mm-destroy-parts gnus-article-mime-handles)
(mm-merge-handles gnus-article-mime-handles handle))
(gnus-mm-display-part handle))))
-(eval-when-compile
- (require 'jka-compr))
-
-;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days
-;; emacs can do that itself.
-;;
-(defun gnus-mime-jka-compr-maybe-uncompress ()
- "Uncompress the current buffer if `auto-compression-mode' is enabled.
-The uncompress method used is derived from `buffer-file-name'."
- (when (and (fboundp 'jka-compr-installed-p)
- (jka-compr-installed-p))
- (let ((info (jka-compr-get-compression-info buffer-file-name)))
- (when info
- (let ((basename (file-name-nondirectory buffer-file-name))
- (args (jka-compr-info-uncompress-args info))
- (prog (jka-compr-info-uncompress-program info))
- (message (jka-compr-info-uncompress-message info))
- (err-file (jka-compr-make-temp-name)))
- (if message
- (message "%s %s..." message basename))
- (unwind-protect
- (unless (memq (apply 'call-process-region
- (point-min) (point-max)
- prog
- t (list t err-file) nil
- args)
- jka-compr-acceptable-retval-list)
- (jka-compr-error prog args basename message err-file))
- (jka-compr-delete-temp-file err-file)))))))
-
-(defun gnus-mime-copy-part (&optional handle)
+(defun gnus-mime-copy-part (&optional handle arg)
"Put the MIME part under point into a new buffer.
If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
are decompressed."
- (interactive)
+ (interactive (list nil current-prefix-arg))
(gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (contents (and handle (mm-get-part handle)))
- (base (and handle
- (file-name-nondirectory
- (or
- (mail-content-type-get (mm-handle-type handle) 'name)
- (mail-content-type-get (mm-handle-disposition handle)
- 'filename)
- "*decoded*"))))
- (buffer (and base (generate-new-buffer base))))
- (when contents
- (switch-to-buffer buffer)
- (insert contents)
+ (unless handle
+ (setq handle (get-text-property (point) 'gnus-data)))
+ (when handle
+ (let ((filename (or (mail-content-type-get (mm-handle-disposition handle)
+ 'name)
+ (mail-content-type-get (mm-handle-disposition handle)
+ 'filename)))
+ contents dont-decode charset coding-system)
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (setq contents (or (condition-case nil
+ (mm-decompress-buffer filename nil 'sig)
+ (error
+ (setq dont-decode t)
+ nil))
+ (buffer-string))))
+ (setq filename (cond (filename (file-name-nondirectory filename))
+ (dont-decode "*raw data*")
+ (t "*decoded*")))
+ (cond
+ (dont-decode)
+ ((not arg)
+ (unless (setq charset (mail-content-type-get
+ (mm-handle-type handle) 'charset))
+ (unless (setq coding-system (mm-with-unibyte-buffer
+ (insert contents)
+ (mm-find-buffer-file-coding-system)))
+ (setq charset gnus-newsgroup-charset))))
+ ((numberp arg)
+ (setq charset (or (cdr (assq arg
+ gnus-summary-show-article-charset-alist))
+ (mm-read-coding-system "Charset: ")))))
+ (switch-to-buffer (generate-new-buffer filename))
+ (if (or coding-system
+ (and charset
+ (setq coding-system (mm-charset-to-coding-system charset))
+ (not (eq charset 'ascii))))
+ (progn
+ (mm-enable-multibyte)
+ (insert (mm-decode-coding-string contents coding-system))
+ (setq buffer-file-coding-system
+ (if (boundp 'last-coding-system-used)
+ (symbol-value 'last-coding-system-used)
+ coding-system)))
+ (mm-disable-multibyte)
+ (insert contents)
+ (setq buffer-file-coding-system mm-binary-coding-system))
;; We do it this way to make `normal-mode' set the appropriate mode.
(unwind-protect
(progn
- (setq buffer-file-name (expand-file-name base))
- (gnus-mime-jka-compr-maybe-uncompress)
+ (setq buffer-file-name (expand-file-name filename))
(normal-mode))
(setq buffer-file-name nil))
(goto-char (point-min)))))
(ps-despool filename)))))
(defun gnus-mime-inline-part (&optional handle arg)
- "Insert the MIME part under point into the current buffer."
+ "Insert the MIME part under point into the current buffer.
+Compressed files like .gz and .bz2 are decompressed."
(interactive (list nil current-prefix-arg))
(gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- contents charset
- (b (point))
- (inhibit-read-only t))
- (when handle
+ (unless handle
+ (setq handle (get-text-property (point) 'gnus-data)))
+ (when handle
+ (let ((b (point))
+ (inhibit-read-only t)
+ contents charset coding-system)
(if (and (not arg) (mm-handle-undisplayer handle))
(mm-remove-part handle)
- (setq contents (mm-get-part handle))
+ (mm-with-unibyte-buffer
+ (mm-insert-part handle)
+ (setq contents
+ (or (mm-decompress-buffer
+ (or (mail-content-type-get (mm-handle-disposition handle)
+ 'name)
+ (mail-content-type-get (mm-handle-disposition handle)
+ 'filename))
+ nil t)
+ (buffer-string))))
(cond
((not arg)
- (setq charset (or (mail-content-type-get
- (mm-handle-type handle) 'charset)
- gnus-newsgroup-charset)))
+ (unless (setq charset (mail-content-type-get
+ (mm-handle-type handle) 'charset))
+ (unless (setq coding-system
+ (mm-with-unibyte-buffer
+ (insert contents)
+ (mm-find-buffer-file-coding-system)))
+ (setq charset gnus-newsgroup-charset))))
((numberp arg)
(if (mm-handle-undisplayer handle)
(mm-remove-part handle))
(setq charset
(or (cdr (assq arg
gnus-summary-show-article-charset-alist))
- (mm-read-coding-system "Charset: ")))))
+ (mm-read-coding-system "Charset: "))))
+ (t
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle))))
(forward-line 2)
- (mm-insert-inline handle
- (if (and charset
- (setq charset (mm-charset-to-coding-system
- charset))
- (not (eq charset 'ascii)))
- (mm-decode-coding-string contents charset)
- contents))
+ (mm-insert-inline
+ handle
+ (if (or coding-system
+ (and charset
+ (setq coding-system
+ (mm-charset-to-coding-system charset))
+ (not (eq charset 'ascii))))
+ (mm-decode-coding-string contents coding-system)
+ (mm-string-to-multibyte contents)))
(goto-char b)))))
(defun gnus-mime-view-part-as-charset (&optional handle arg)
(defun gnus-article-mime-match-handle-first (condition)
(if condition
- (let ((alist gnus-article-mime-handle-alist) ihandle n)
- (while (setq ihandle (pop alist))
+ (let (n)
+ (dolist (ihandle gnus-article-mime-handle-alist)
(if (and (cond
((functionp condition)
(funcall condition (cdr ihandle)))
;; We have to do this since selecting the window
;; may change the point. So we set the window point.
(set-window-point window point)))
- (let* ((handles (or ihandles
- (mm-dissect-buffer nil gnus-article-loose-mime)
- (and gnus-article-emulate-mime
- (mm-uu-dissect))))
- (inhibit-read-only t) handle name type b e display)
+ (let ((handles ihandles)
+ (inhibit-read-only t)
+ handle name type b e display)
+ (cond (handles)
+ ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
+ (when gnus-article-emulate-mime
+ (mm-uu-dissect-text-parts handles)))
+ (gnus-article-emulate-mime
+ (setq handles (mm-uu-dissect))))
(when (and (not ihandles)
(not gnus-displaying-mime))
;; Top-level call; we clean up.
(defcustom gnus-mime-display-multipart-alternative-as-mixed nil
"Display \"multipart/alternative\" parts as \"multipart/mixed\"."
+ :version "22.1"
:group 'gnus-article-mime
:type 'boolean)
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."
+ :version "22.1"
:group 'gnus-article-mime
:type 'boolean)
(forward-line -1)
(setq beg (point)))
(gnus-article-insert-newline)
- (mm-insert-inline handle (mm-get-part handle))
+ (mm-display-inline handle)
(goto-char (point-max))))
;; Do highlighting.
(save-excursion
(goto-char (point-min))
(gnus-insert-prev-page-button)))
(when (and (gnus-visual-p 'page-marker)
- (< (+ (point-max) 2) (buffer-size)))
+ (< (point-max) (save-restriction (widen) (point-max))))
(save-excursion
(goto-char (point-max))
(gnus-insert-next-page-button))))))
"Start editing the contents of the current article buffer."
(let ((winconf (current-window-configuration)))
(set-buffer gnus-article-buffer)
- (gnus-article-edit-mode)
+ (let ((message-auto-save-directory
+ ;; Don't associate the article buffer with a draft file.
+ nil))
+ (gnus-article-edit-mode))
(funcall start-func)
(set-buffer-modified-p nil)
(gnus-configure-windows 'edit-article)
(defcustom gnus-button-valid-fqdn-regexp
message-valid-fqdn-regexp
"Regular expression that matches a valid FQDN."
+ :version "22.1"
:group 'gnus-article-buttons
:type 'regexp)
"Function to use for displaying man pages.
The function must take at least one argument with a string naming the
man page."
+ :version "22.1"
:type '(choice (function-item :tag "Man" manual-entry)
(function-item :tag "Woman" woman)
(function :tag "Other"))
If the default site is too slow, try to find a CTAN mirror, see
<URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. See also
the variable `gnus-button-handle-ctan'."
+ :version "22.1"
:group 'gnus-article-buttons
:link '(custom-manual "(gnus)Group Parameters")
:type '(choice (const "http://www.tex.ac.uk/tex-archive/")
(defcustom gnus-button-ctan-handler 'browse-url
"Function to use for displaying CTAN links.
The function must take one argument, the string naming the URL."
+ :version "22.1"
:type '(choice (function-item :tag "Browse Url" browse-url)
(function :tag "Other"))
:group 'gnus-article-buttons)
(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
"Bogus strings removed from CTAN URLs."
+ :version "22.1"
:group 'gnus-article-buttons
:type '(choice (const "^/?tex-archive/\\|/")
(regexp :tag "Other")))
"\\)")
"Regular expression for ctan directories.
It should match all directories in the top level of `gnus-ctan-url'."
+ :version "22.1"
:group 'gnus-article-buttons
:type 'regexp)
gnus-button-valid-fqdn-regexp
">?\\)\\b")
"Regular expression that matches a message ID or a mail address."
+ :version "22.1"
:group 'gnus-article-buttons
:type 'regexp)
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'."
+ :version "22.1"
:group 'gnus-article-buttons
:type '(choice (function-item :tag "Heuristic function"
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."
+ :version "22.1"
:group 'gnus-article-buttons
:type '(repeat (cons (number :tag "Rate")
(regexp :tag "Regexp"))))
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."
+ :version "22.1"
:group 'gnus-article-buttons
:link '(custom-manual "(gnus)Group Parameters")
:type 'integer)
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."
+ :version "22.1"
:group 'gnus-article-buttons
:link '(custom-manual "(gnus)Group Parameters")
:type 'integer)
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."
+ :version "22.1"
:group 'gnus-article-buttons
:link '(custom-manual "(gnus)Group Parameters")
:type 'integer)
The higher the number, the more buttons will appear and the more false
positives are possible."
;; mail addresses, MIDs, URLs for news, ...
+ :version "22.1"
:group 'gnus-article-buttons
:type 'integer)
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'
+ :version "22.1"
:group 'gnus-article-buttons
:type 'integer)
0 (>= gnus-button-browse-level 0) browse-url 0)
("^[^:]+:" gnus-button-url-regexp
0 (>= gnus-button-browse-level 0) browse-url 0)
+ ("^OpenPGP:.*url=" gnus-button-url-regexp
+ 0 (>= gnus-button-browse-level 0) gnus-button-openpgp 0)
("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"
0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
"Highlight article headers as specified by `gnus-header-face-alist'."
(interactive)
(gnus-with-article-headers
- (let ((alist gnus-header-face-alist)
- entry regexp header-face field-face from hpoints fpoints)
- (while (setq entry (pop alist))
+ (let (regexp header-face field-face from hpoints fpoints)
+ (dolist (entry gnus-header-face-alist)
(goto-char (point-min))
(setq regexp (concat "^\\("
(if (string-equal "" (nth 0 entry))
"Add buttons to the head of the article."
(interactive)
(gnus-with-article-headers
- (let ((alist gnus-header-button-alist)
- entry beg end)
- (while alist
+ (let (beg end)
+ (dolist (entry gnus-header-button-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.
(if (string-match "\\([^#]+\\)#?\\(.*\\)" url)
(gnus-info-find-node
(concat "("
- (gnus-url-unhex-string
+ (gnus-url-unhex-string
(match-string 1 url))
")"
- (or (gnus-url-unhex-string
+ (or (gnus-url-unhex-string
(match-string 2 url))
"Top")))
(error "Can't parse %s" url)))
(Info-directory)
(Info-menu url))
+(defun gnus-button-openpgp (url)
+ "Retrieve and add an OpenPGP key given URL from an OpenPGP header."
+ (with-temp-buffer
+ (mm-url-insert-file-contents-external url)
+ (pgg-snarf-keys-region (point-min) (point-max))
+ (pgg-display-output-buffer nil nil nil)))
+
(defun gnus-button-message-id (message-id)
"Fetch MESSAGE-ID."
(with-current-buffer gnus-summary-buffer
projects / gnus / blobdiff