;;; 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
;;; Code:
+(require 'custom)
(require 'gnus)
(require 'gnus-sum)
-(require 'article)
(require 'gnus-spec)
(require 'gnus-int)
(require 'browse-url)
+(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:"
+ "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:"
+ "^Approved:" "^Sender:" "^Received:" "^Mail-from:")
+ "All headers that match 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."
+ :type '(choice :custom-show nil
+ regexp
+ (repeat regexp))
+ :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"
+ "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."
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp)
+ :group 'gnus-article-hiding)
+
+(defcustom gnus-sorted-header-list
+ '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
+ "^Cc:" "^Date:" "^Organization:")
+ "This variable is a list of regular expressions.
+If it is non-nil, headers that match the regular expressions will
+be placed first in the article buffer in the sequence specified by
+this list."
+ :type '(repeat regexp)
+ :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.
+Possible values in this list are `empty', `newsgroups', `followup-to',
+`reply-to', and `date'."
+ :type '(set (const :tag "Headers with no content." empty)
+ (const :tag "Newsgroups with only one group." newsgroups)
+ (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 'gnus-article-hiding)
+
+(defcustom gnus-signature-separator '("^-- $" "^-- *$")
+ "Regexp matching signature separator.
+This can also be a list of regexps. In that case, it will be checked
+from head to tail looking for a separator. Searches will be done from
+the end of the buffer."
+ :type '(repeat string)
+ :group 'gnus-article-signature)
+
+(defcustom gnus-signature-limit nil
+ "Provide a limit to what is considered a signature.
+If it is a number, no signature may not be longer (in characters) than
+that number. If it is a floating point number, no signature may be
+longer (in lines) than that number. If it is a function, the function
+will be called without any parameters, and if it returns nil, there is
+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 'gnus-article-signature)
+
+(defcustom gnus-hidden-properties '(invisible t intangible t)
+ "Property list to use for hiding text."
+ :type 'sexp
+ :group 'gnus-article-hiding)
+
+(defcustom gnus-article-x-face-command
+ "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
+ "String or function to be executed to display an X-Face header.
+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 'gnus-article-washing)
+
+(defcustom gnus-article-x-face-too-ugly nil
+ "Regexp matching posters whose face shouldn't be shown automatically."
+ :type 'regexp
+ :group 'gnus-article-washing)
+
+(defcustom gnus-emphasis-alist
+ (let ((format
+ "\\(\\s-\\|^\\|[-\"\(]\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"\)]\\)")
+ (types
+ '(("_" "_" underline)
+ ("/" "/" italic)
+ ("\\*" "\\*" bold)
+ ("_/" "/_" underline-italic)
+ ("_\\*" "\\*_" underline-bold)
+ ("\\*/" "/\\*" bold-italic)
+ ("_\\*/" "/\\*_" underline-bold-italic))))
+ `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
+ 2 3 gnus-emphasis-underline)
+ ,@(mapcar
+ (lambda (spec)
+ (list
+ (format format (car spec) (cadr spec))
+ 2 3 (intern (format "gnus-emphasis-%s" (caddr spec)))))
+ types)))
+ "Alist that says how to fontify certain phrases.
+Each item looks like this:
+
+ (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
+
+The first element is a regular expression to be matched. The second
+is a number that says what regular expression grouping used to find
+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))
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-bold '((t (:bold t)))
+ "Face used for displaying strong emphasized text (*word*)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-italic '((t (:italic t)))
+ "Face used for displaying italic emphasized text (/word/)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-underline '((t (:underline t)))
+ "Face used for displaying underlined emphasized text (_word_)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
+ "Face used for displaying underlined bold emphasized text (_*word*_)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
+ "Face used for displaying underlined italic emphasized text (_*word*_)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
+ "Face used for displaying bold italic emphasized text (/*word*/)."
+ :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.
+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")
+ (autoload 'timezone-make-date-arpa-standard "timezone")
+ (autoload 'mail-extract-address-components "mail-extr"))
+
(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)
(defvar gnus-number-of-articles-to-be-saved nil)
-;;; Provide a mapping from `gnus-*' commands to Article commands.
+(defvar gnus-inhibit-hiding nil)
+(defvar gnus-newsgroup-name)
+
+(defsubst gnus-article-hide-text (b e props)
+ "Set text PROPS on the B to E region, extending `intangible' 1 past B."
+ (add-text-properties b e props)
+ (when (memq 'intangible props)
projects / gnus / blobdiff