;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(defcustom gnus-unbuttonized-mime-types '(".*/.*")
"List of MIME types that should not be given buttons when rendered inline.
-See also `gnus-buttonized-mime-types' which may override this variable."
+See also `gnus-buttonized-mime-types' which may override this variable.
+This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
:version "21.1"
:group 'gnus-article-mime
:type '(repeat regexp))
"List of MIME types that should be given buttons when rendered inline.
If set, this variable overrides `gnus-unbuttonized-mime-types'.
To see e.g. security buttons you could set this to
-`(\"multipart/signed\")'."
+`(\"multipart/signed\")'.
+This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
:version "21.1"
:group 'gnus-article-mime
:type '(repeat regexp))
:link '(custom-manual "(gnus)Customizing Articles")
:type gnus-article-treat-custom)
+(defcustom gnus-treat-wash-html nil
+ "Format as HTML.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :link '(custom-manual "(gnus)Customizing Articles")
+ :type gnus-article-treat-custom)
+
(defcustom gnus-treat-fill-long-lines nil
"Fill long lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
(gnus-treat-display-smileys gnus-treat-smiley)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
+ (gnus-treat-wash-html gnus-article-wash-html)
(gnus-treat-emphasize gnus-article-emphasize)
(gnus-treat-hide-citation gnus-article-hide-citation)
(gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
(defun article-wash-html (&optional read-charset)
- "Format an html article.
+ "Format an HTML article.
If READ-CHARSET, ask for a coding system."
(interactive "P")
(save-excursion
(let ((buffer-read-only nil)
charset)
- (if (gnus-buffer-live-p gnus-original-article-buffer)
- (with-current-buffer gnus-original-article-buffer
- (let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct
- (ignore-errors
- (mail-header-parse-content-type ct)))))
- (setq charset (and ctl
- (mail-content-type-get ctl 'charset)))
- (if (stringp charset)
- (setq charset (intern (downcase charset)))))))
- (if read-charset
- (setq charset (mm-read-coding-system "Charset: " charset)))
+ (when (gnus-buffer-live-p gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
+ (let* ((ct (gnus-fetch-field "content-type"))
+ (ctl (and ct
+ (ignore-errors
+ (mail-header-parse-content-type ct)))))
+ (setq charset (and ctl
+ (mail-content-type-get ctl 'charset)))
+ (when (stringp charset)
+ (setq charset (intern (downcase charset)))))))
+ (when read-charset
+ (setq charset (mm-read-coding-system "Charset: " charset)))
(unless charset
(setq charset gnus-newsgroup-charset))
(article-goto-body)
(narrow-to-region (point) (point-max))
(let* ((func (or gnus-article-wash-function mm-text-html-renderer))
(entry (assq func mm-text-html-washer-alist)))
- (if entry
- (setq func (cdr entry)))
+ (when entry
+ (setq func (cdr entry)))
(cond
((gnus-functionp func)
(funcall func))
(second . 1))
"Mapping from time units to seconds.")
+(defun gnus-article-forward-header ()
+ "Move point to the start of the next header.
+If the current header is a continuation header, this can be several
+lines forward."
+ (let ((ended nil))
+ (while (not ended)
+ (forward-line 1)
+ (if (looking-at "[ \t]+[^ \t]")
+ (forward-line 1)
+ (setq ended t)))))
+
(defun article-date-ut (&optional type highlight header)
"Convert DATE date to universal time in the current article.
If TYPE is `local', convert to local time; if it is `lapsed', output
(while (re-search-forward date-regexp nil t)
(if pos
(delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))
+ (progn (gnus-article-forward-header)
+ (point)))
(delete-region (progn (beginning-of-line) (point))
- (progn (end-of-line) (point)))
+ (progn (gnus-article-forward-header)
+ (forward-char -1)
+ (point)))
(setq pos (point))))
- (when (and (not pos) (re-search-forward tdate-regexp nil t))
+ (when (and (not pos)
+ (re-search-forward tdate-regexp nil t))
(forward-line 1))
- (if pos (goto-char pos))
+ (when pos
+ (goto-char pos))
(insert (article-make-date-line date (or type 'ut)))
- (when (not pos)
+ (unless pos
(insert "\n")
(forward-line -1))
;; Do highlighting.
(format "%02d" (nth 2 dtime))
":"
(format "%02d" (nth 1 dtime)))))))
- (error
- (format "Date: %s (from Gnus)" date))))
+ (error
+ (format "Date: %s (from Gnus)" date))))
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
(car (push result file-name-history)))))))
;; Create the directory.
(gnus-make-directory (file-name-directory file))
- ;; If we have read a directory, we append the default file name.
+ ;; If we have read a directory, we append the default file name.
(when (file-directory-p file)
(setq file (expand-file-name (file-name-nondirectory
default-name)
(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)
"Put the MIME part under point into a new buffer."
(interactive)
(unwind-protect
(progn
(setq buffer-file-name (expand-file-name base))
+ (gnus-mime-jka-compr-maybe-uncompress)
(normal-mode))
(setq buffer-file-name nil))
(goto-char (point-min)))))
(if (save-excursion
(end-of-line)
(and (pos-visible-in-window-p) ;Not continuation line.
- (eobp)))
+ (>= (1+ (point)) (point-max)))) ;Allow for trailing newline.
;; Nothing in this page.
(if (or (not gnus-page-broken)
(save-excursion
"\C-c\C-f\C-k" message-goto-keywords
"\C-c\C-f\C-u" message-goto-summary
"\C-c\C-f\C-i" message-insert-or-toggle-importance
- "\C-c\C-f\C-a" message-gen-unsubscribed-mft
+ "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to
"\C-c\C-b" message-goto-body
"\C-c\C-i" message-goto-signature
(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-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,[:word:]]+[-a-zA-Z0-9_=#$@~`%&*+|\\/[:word:]]\\)"
- "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)")
+ "\\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\\)\\)")
"Regular expression that matches URLs."
:group 'gnus-article-buttons
:type 'regexp)
(regexp :tag "Other")))
(defcustom gnus-button-mid-or-mail-regexp
- (concat "\\b\\(<?[a-zA-Z0-9][^<>\")!;:,{}\n\t ]*@"
+ (concat "\\b\\(<?[a-z0-9][^<>\")!;:,{}\n\t ]*@"
gnus-button-valid-fqdn-regexp
">?\\)\\b")
"Regular expression that matches a message ID or a mail address."
("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
- ("mailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
+ ("mailto:\\([-a-z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
;; CTAN
("\\bCTAN:[ \t\n]*\\([^>)!;:,\n\t ]*\\)" 0 (>= gnus-button-tex-level 1)
(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-zA-Z][-_.a-zA-Z0-9]+\\)([1-9])\\W" 0
+ ("\\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-zA-Z][-_.:a-zA-Z0-9]+\\)([1-9][X1a-z]*)\\W" 0
+ ("\\b\\([a-z][-_.:a-z0-9]+\\)([1-9][X1a-z]*)\\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
"*Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
-REGEXP: is the string matching text around the button (can also be lisp
-expression evaluating to a string),
+REGEXP: is the string (case insensitive) matching text around the button (can
+also be lisp expression evaluating to a string),
BUTTON: is the number of the regexp grouping actually matching the button,
FORM: is a lisp expression which must eval to true for the button to
be added,
("^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-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
+ ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
gnus-button-message-id 3))
"*Alist of headers and regexps to match buttons in article heads.
(highlightp (gnus-visual-p 'article-highlight 'highlight))
val elem)
(gnus-run-hooks 'gnus-part-display-hook)
- (while (setq elem (pop alist))
+ (dolist (elem alist)
(setq val
(save-excursion
- (if (gnus-buffer-live-p gnus-summary-buffer)
- (set-buffer gnus-summary-buffer))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (set-buffer gnus-summary-buffer))
(symbol-value (car elem))))
(when (and (or (consp val)
treated-type)
(cond
((null val)
nil)
+ (condition
+ (eq condition val))
((and (listp val)
(stringp (car val)))
(apply 'gnus-or (mapcar `(lambda (s)
(equal (car val) type))
(t
(error "%S is not a valid predicate" pred)))))
- (condition
- (eq condition val))
((eq val t)
t)
((eq val 'head)
projects / gnus / blobdiff