(function-item gnus-display-x-face-in-from)
function)
:version "21.1"
+ :group 'gnus-picon
:group 'gnus-article-washing)
(defcustom gnus-article-x-face-too-ugly nil
A string is used as a regular expression to match the banner
directly.")
+(defcustom gnus-article-address-banner-alist nil
+ "Alist of mail addresses and banners.
+Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
+to match a mail address in the From: header, BANNER is one of a symbol
+`signature', an item in `gnus-article-banner-alist', a regexp and nil.
+If ADDRESS matches author's mail address, it will remove things like
+advertisements. For example:
+
+\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
+"
+ :type '(repeat
+ (cons
+ (regexp :tag "Address")
+ (choice :tag "Banner" :value nil
+ (const :tag "Remove signature" signature)
+ (symbol :tag "Item in `gnus-article-banner-alist'" none)
+ regexp
+ (const :tag "None" nil))))
+ :group 'gnus-article-washing)
+
(defcustom gnus-emphasis-alist
(let ((format
"\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
(format format (car spec) (cadr spec))
2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
types)
+ ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
+ 2 3 gnus-emphasis-strikethru)
("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
2 3 gnus-emphasis-underline)))
"*Alist that says how to fontify certain phrases.
(defface gnus-emphasis-underline-bold-italic
'((t (:bold t :italic t :underline t)))
"Face used for displaying underlined bold italic emphasized text.
-Esample: (_/*word*/_)."
+Example: (_/*word*/_)."
+ :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-strikethru '((t (:strikethru t)))
+ "Face used for displaying strike-through text (-word-)."
:group 'gnus-article-emphasis)
(defface gnus-emphasis-highlight-words
("\225" "*")
("\226" "-")
("\227" "--")
+ ("\230" "-") ; This might not be correct.
("\231" "(TM)")
("\233" ">")
("\234" "oe")
string))
(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
- "*Defines the location of the faces database.
+ "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"
- :type 'directory
+ :type '(repeat directory)
+ :link '(url-link :tag "download"
+ "http://www.cs.indiana.edu/picons/ftp/index.html")
+ :link '(custom-manual "(gnus)Picons")
:group 'gnus-picon)
(defun gnus-picons-installed-p ()
("toggle display" . gnus-article-press-button)
("toggle display" . gnus-article-view-part-as-charset)
("view as type" . gnus-mime-view-part-as-type)
- ("internalize type" . gnus-mime-internalize-part)
- ("externalize type" . gnus-mime-externalize-part))
+ ("view internally" . gnus-mime-view-part-internally)
+ ("view externally" . gnus-mime-view-part-externally))
"An alist of actions that run on the MIME attachment."
:group 'gnus-article-mime
:type '(repeat (cons (string :tag "name")
(function))))
-(defcustom gnus-mime-action-alist
- '(("save to file" . gnus-mime-save-part)
- ("display as text" . gnus-mime-inline-part)
- ("view the part" . gnus-mime-view-part)
- ("pipe to command" . gnus-mime-pipe-part)
- ("toggle display" . gnus-article-press-button)
- ("view as type" . gnus-mime-view-part-as-type)
- ("internalize type" . gnus-mime-internalize-part)
- ("externalize type" . gnus-mime-externalize-part))
- "An alist of actions that run on the MIME attachment."
- :version "21.1"
- :group 'gnus-article-mime
- :type '(repeat (cons (string :tag "name")
- (function))))
-
;;;
;;; The treatment variables
;;;
:group 'gnus-article-treat
:type gnus-article-treat-custom)
+(defcustom gnus-treat-unsplit-urls nil
+ "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."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-custom)
+
(defcustom gnus-treat-leading-whitespace nil
"Remove leading whitespace in headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
(put 'gnus-treat-overstrike 'highlight t)
(defcustom gnus-treat-display-xface
- (and (or (and (fboundp 'image-type-available-p)
+ (and (not noninteractive)
+ (or (and (fboundp 'image-type-available-p)
(image-type-available-p 'xbm)
(string-match "^0x" (shell-command-to-string "uncompface")))
(and (featurep 'xemacs)
:type gnus-article-treat-head-custom)
(put 'gnus-treat-display-xface 'highlight t)
+(defcustom gnus-treat-display-grey-xface
+ (and (not noninteractive)
+ (string-match "^0x" (shell-command-to-string "uncompface"))
+ t)
+ "Display grey X-Face headers.
+Valid values are nil, t."
+ :group 'gnus-article-treat
+ :version "21.3"
+ :type 'boolean)
+(put 'gnus-treat-display-grey-xface 'highlight t)
+
(defcustom gnus-treat-display-smileys
(if (or (and (featurep 'xemacs)
(featurep 'xpm))
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
:group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(info-link "(gnus)Customizing Articles")
+ :link '(info-link "(gnus)Picons")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-from-picon 'highlight t)
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
:group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(info-link "(gnus)Customizing Articles")
+ :link '(info-link "(gnus)Picons")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-mail-picon 'highlight t)
See Info node `(gnus)Customizing Articles' and Info node
`(gnus)Picons' for details."
:group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(info-link "(gnus)Customizing Articles")
+ :link '(info-link "(gnus)Picons")
:type gnus-article-treat-head-custom)
(put 'gnus-treat-newsgroups-picon 'highlight t)
:type 'string
:group 'mime-security)
-(defcustom gnus-article-wash-function
- (cond ((locate-library "w3")
- 'gnus-article-wash-html-with-w3)
- ((locate-library "w3m")
- 'gnus-article-wash-html-with-w3m))
- "Function used for converting HTML into text."
- :type '(radio (function-item gnus-article-wash-html-with-w3)
- (function-item gnus-article-wash-html-with-w3m))
- :group 'gnus-article)
+(defvar gnus-article-wash-function nil
+ "Function used for converting HTML into text.")
;;; Internal variables
(gnus-treat-fill-article gnus-article-fill-cited-article)
(gnus-treat-fill-long-lines gnus-article-fill-long-lines)
(gnus-treat-strip-cr gnus-article-remove-cr)
+ (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
(gnus-treat-date-ut gnus-article-date-ut)
(gnus-treat-date-local gnus-article-date-local)
(gnus-treat-date-english gnus-article-date-english)
(gnus-treat-hide-headers gnus-article-maybe-hide-headers)
(gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
(gnus-treat-hide-signature gnus-article-hide-signature)
- (gnus-treat-hide-citation gnus-article-hide-citation)
- (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
(gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
(gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
(gnus-treat-strip-pgp gnus-article-hide-pgp)
(gnus-treat-mail-picon gnus-treat-mail-picon)
(gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
(gnus-treat-highlight-headers gnus-article-highlight-headers)
- (gnus-treat-highlight-citation gnus-article-highlight-citation)
(gnus-treat-highlight-signature gnus-article-highlight-signature)
(gnus-treat-strip-trailing-blank-lines
gnus-article-remove-trailing-blank-lines)
(gnus-treat-display-smileys gnus-treat-smiley)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
(gnus-treat-emphasize gnus-article-emphasize)
+ (gnus-treat-hide-citation gnus-article-hide-citation)
+ (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
+ (gnus-treat-highlight-citation gnus-article-highlight-citation)
(gnus-treat-body-boundary gnus-article-treat-body-boundary)
(gnus-treat-play-sounds gnus-earcon-display)))
(let ((table (copy-syntax-table text-mode-syntax-table)))
;; This causes the citation match run O(2^n).
;; (modify-syntax-entry ?- "w" table)
- (modify-syntax-entry ?> ")" table)
- (modify-syntax-entry ?< "(" table)
+ (modify-syntax-entry ?> ")<" table)
+ (modify-syntax-entry ?< "(>" table)
table)
"Syntax table used in article mode buffers.
Initialized from `text-mode-syntax-table.")
(with-temp-buffer
(insert header)
(goto-char (point-min))
- (while (re-search-forward "[\t ]*\n[\t ]+" nil t)
+ (while (re-search-forward "\n[\t ]" nil t)
(replace-match " " t t)))
(setq length (- (point-max) (point-min) 1)))
(when (< length (window-width))
- (while (re-search-forward "[\t ]*\n[\t ]+" nil t)
+ (while (re-search-forward "\n[\t ]" nil t)
(replace-match " " t t)))
(goto-char (point-max)))))))
(while (>= (1- (window-width)) (length str))
(setq str (concat str gnus-body-boundary-delimiter)))
(substring str 0 (1- (window-width))))
- "\n")))))
+ "\n")
+ (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
(defun article-fill-long-lines ()
"Fill lines that are wider than the window width."
(while (not (eobp))
(end-of-line)
(when (>= (current-column) (min fill-column width))
- (narrow-to-region (point) (gnus-point-at-bol))
- (fill-paragraph nil)
- (goto-char (point-max))
+ (narrow-to-region (min (1+ (point)) (point-max)) (gnus-point-at-bol))
+ (let ((goback (point-marker)))
+ (fill-paragraph nil)
+ (goto-char (marker-position goback)))
(widen))
(forward-line 1)))))))
(set-buffer gnus-original-article-buffer))
(save-restriction
(mail-narrow-to-head)
- (while (gnus-article-goto-header "x-face\\(-[0-9]+\\)?")
- (when (match-beginning 2)
- (setq grey t))
- (push (mail-header-field-value) x-faces))
+ (if gnus-treat-display-grey-xface
+ (progn
+ (while (gnus-article-goto-header "X-Face\\(-[0-9]+\\)?")
+ (if (match-beginning 2)
+ (progn
+ (setq grey t)
+ (push (cons (- (string-to-number (match-string 2)))
+ (mail-header-field-value))
+ x-faces))
+ (push (cons 0 (mail-header-field-value)) x-faces)))
+ (dolist (x-face (prog1
+ (if grey
+ (sort x-faces 'car-less-than-car)
+ (nreverse x-faces))
+ (setq x-faces nil)))
+ (push (cdr x-face) x-faces)))
+ (while (gnus-article-goto-header "X-Face")
+ (push (mail-header-field-value) x-faces)))
(setq from (message-fetch-field "from"))))
(if grey
(let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces))
(let ((buffer-read-only nil))
(rfc1843-decode-region (point-min) (point-max)))))
+(defun article-unsplit-urls ()
+ "Remove the newlines that some other mailers insert into URLs."
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
+ (replace-match "\\1\\3" t)))
+ (when (and gnus-display-mime-function (interactive-p))
+ (funcall gnus-display-mime-function))))
+
+
(defun article-wash-html (&optional read-charset)
"Format an html article.
If READ-CHARSET, ask for a coding system."
(save-window-excursion
(save-restriction
(narrow-to-region (point) (point-max))
- (funcall gnus-article-wash-function))))))
+ (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)))
+ (cond
+ ((gnus-functionp func)
+ (funcall func))
+ (t
+ (apply (car func) (cdr func))))))))))
(defun gnus-article-wash-html-with-w3 ()
"Wash the current buffer with w3."
(mm-setup-w3)
(let ((w3-strict-width (window-width))
(url-standalone-mode t)
- (w3-honor-stylesheets nil)
- (w3-delay-image-loads t))
- (condition-case var
+ (url-gateway-unplugged t)
+ (w3-honor-stylesheets nil))
+ (condition-case ()
(w3-region (point-min) (point-max))
(error))))
(defun gnus-article-wash-html-with-w3m ()
"Wash the current buffer with emacs-w3m."
(mm-setup-w3m)
- (let ((w3m-safe-url-regexp "\\`cid:"))
- (w3m-region (point) (point-max)))
- (setq mm-w3m-minor-mode t))
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images
+ nil
+ "\\`cid:"))
+ (w3m-display-inline-images mm-inline-text-html-with-images)
+ w3m-force-redisplay)
+ (w3m-region (point-min) (point-max)))
+ (when mm-inline-text-html-with-w3m-keymap
+ (add-text-properties
+ (point-min) (point-max)
+ (append '(mm-inline-text-html-with-w3m t)
+ (gnus-local-map-property mm-w3m-mode-map))))))
(defun article-hide-list-identifiers ()
"Remove list identifies from the Subject header.
(banner (gnus-parameter-banner gnus-newsgroup-name))
(gnus-signature-limit nil)
buffer-read-only beg end)
+ (when (and gnus-article-address-banner-alist
+ (not banner))
+ (setq banner
+ (let ((from (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ (caar (mail-header-parse-addresses
+ (mail-fetch-field "from"))))))
+ (catch 'found
+ (dolist (pair gnus-article-address-banner-alist)
+ (when (string-match (car pair) from)
+ (throw 'found (cdr pair))))))))
(when banner
(article-goto-body)
(cond
date)))
;; Let the user define the format.
((eq type 'user)
- (if (gnus-functionp gnus-article-time-format)
- (funcall gnus-article-time-format time)
- (concat
- "Date: "
- (format-time-string gnus-article-time-format time))))
+ (let ((format (or (condition-case nil
+ (with-current-buffer gnus-summary-buffer
+ gnus-article-time-format)
+ (error nil))
+ gnus-article-time-format)))
+ (if (gnus-functionp format)
+ (funcall format time)
+ (concat "Date: " (format-time-string format time)))))
;; ISO 8601.
((eq type 'iso8601)
(let ((tz (car (current-time-zone time))))
":"
(format "%02d" (nth 1 dtime)))))))
(error
- (format "Date: %s (from Oort)" date))))
+ (format "Date: %s (from Gnus)" date))))
(defun article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
article-de-base64-unreadable
article-decode-HZ
article-wash-html
+ article-unsplit-urls
article-hide-list-identifiers
article-hide-pgp
article-strip-banner
article-strip-trailing-space
article-strip-blank-lines
article-strip-all-blank-lines
- article-replace-with-quoted-text
article-date-local
article-date-english
article-date-iso8601
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
["Remove base64" gnus-article-de-base64-unreadable t]
["Treat html" gnus-article-wash-html t]
+ ["Remove newlines from within URLs" gnus-article-unsplit-urls t]
["Decode HZ" gnus-article-decode-HZ t]))
;; Note "Commands" menu is defined in gnus-sum.el for consistency
gnus-article-mime-handle-alist))
(gnus-set-mode-line 'article))
(article-goto-body)
+ (unless (bobp)
+ (forward-line -1))
(set-window-point (get-buffer-window (current-buffer)) (point))
(gnus-configure-windows 'article)
t))))))
(gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
(gnus-mime-copy-part "c" "View As Text, In Other Buffer")
(gnus-mime-inline-part "i" "View As Text, In This Buffer")
- (gnus-mime-internalize-part "E" "View Internally")
- (gnus-mime-externalize-part "e" "View Externally")
+ (gnus-mime-view-part-internally "E" "View Internally")
+ (gnus-mime-view-part-externally "e" "View Externally")
(gnus-mime-print-part "p" "Print")
(gnus-mime-pipe-part "|" "Pipe To Command...")
(gnus-mime-action-on-part "." "Take action on the part")))
(setq buffer-file-name nil))
(goto-char (point-min)))))
-(defun gnus-mime-print-part (&optional handle)
+(defun gnus-mime-print-part (&optional handle filename)
"Print the MIME part under point."
- (interactive)
+ (interactive (list nil (ps-print-preprint current-prefix-arg)))
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(contents (and handle (mm-get-part handle)))
- (file (make-temp-name (expand-file-name "mm." mm-tmp-directory)))
+ (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory)))
(printer (mailcap-mime-info (mm-handle-type handle) "print")))
(when contents
(if printer
(delete-file file))
(with-temp-buffer
(insert contents)
- (gnus-print-buffer))))))
+ (gnus-print-buffer))
+ (ps-despool filename)))))
(defun gnus-mime-inline-part (&optional handle arg)
"Insert the MIME part under point into the current buffer."
(gnus-newsgroup-ignored-charsets 'gnus-all))
(gnus-article-press-button)))))
-(defun gnus-mime-externalize-part (&optional handle)
+(defun gnus-mime-view-part-externally (&optional handle)
"View the MIME part under point with an external viewer."
(interactive)
(gnus-article-check-buffer)
(mm-remove-part handle)
(mm-display-part handle)))))
-(defun gnus-mime-internalize-part (&optional handle)
+(defun gnus-mime-view-part-internally (&optional handle)
"View the MIME part under point with an internal viewer.
If no internal viewer is available, use an external viewer."
(interactive)
(interactive "p")
(gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
-(defun gnus-article-externalize-part (n)
+(defun gnus-article-view-part-externally (n)
"View MIME part N externally, which is the numerical prefix."
(interactive "p")
- (gnus-article-part-wrapper n 'gnus-mime-externalize-part))
+ (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
(defun gnus-article-inline-part (n)
"Inline MIME part N, which is the numerical prefix."
;; 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) (mm-uu-dissect)))
+ (let* ((handles (or ihandles (mm-dissect-buffer
+ nil gnus-article-loose-mime)
+ (mm-uu-dissect)))
buffer-read-only handle name type b e display)
(when (and (not ihandles)
(not gnus-displaying-mime))
the entire article will be yanked."
(interactive "P")
(let ((article (cdr gnus-article-current)) cont)
- (if (not (mark))
+ (if (not (mark t))
(gnus-summary-reply (list (list article)) wide)
- (setq cont (buffer-substring (point) (mark)))
+ (setq cont (buffer-substring (point) (mark t)))
;; Deactivate active regions.
(when (and (boundp 'transient-mark-mode)
transient-mark-mode)
(interactive)
(let ((article (cdr gnus-article-current))
cont)
- (if (not (gnus-region-active-p))
+ (if (not (mark t))
(gnus-summary-followup (list (list article)))
- (setq cont (buffer-substring (point) (mark)))
+ (setq cont (buffer-substring (point) (mark t)))
;; Deactivate active regions.
(when (and (boundp 'transient-mark-mode)
transient-mark-mode)
(let ((gnus-override-method gnus-override-method)
(methods (and (stringp article)
gnus-refer-article-method))
+ (backend (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))
result
(buffer-read-only nil))
(if (or (not (listp methods))
(gnus-kill-all-overlays)
(let ((gnus-newsgroup-name group))
(gnus-check-group-server))
- (when (gnus-request-article article group (current-buffer))
+ (cond
+ ((gnus-request-article article group (current-buffer))
(when (numberp article)
(gnus-async-prefetch-next group article
gnus-summary-buffer)
(gnus-backlog-enter-article
group article (current-buffer))))
(setq result 'article))
- (if (not result)
- (if methods
- (setq gnus-override-method (pop methods))
- (setq result 'done))))
+ (methods
+ (setq gnus-override-method (pop methods)))
+ ((not (string-match "^400 "
+ (nnheader-get-report backend)))
+ ;; If we get 400 server disconnect, reconnect and
+ ;; retry; otherwise, assume the article has expired.
+ (setq result 'done))))
(and (eq result 'article) 'article)))
;; It was a pseudo.
(t article)))
;; Should we be using derived.el for this?
(unless gnus-article-edit-mode-map
- (setq gnus-article-edit-mode-map (make-sparse-keymap))
+ (setq gnus-article-edit-mode-map (make-keymap))
(set-keymap-parent gnus-article-edit-mode-map text-mode-map)
+
(gnus-define-keys gnus-article-edit-mode-map
+ "\C-c?" describe-mode
"\C-c\C-c" gnus-article-edit-done
- "\C-c\C-k" gnus-article-edit-exit)
+ "\C-c\C-k" gnus-article-edit-exit
+ "\C-c\C-f\C-t" message-goto-to
+ "\C-c\C-f\C-o" message-goto-from
+ "\C-c\C-f\C-b" message-goto-bcc
+ ;;"\C-c\C-f\C-w" message-goto-fcc
+ "\C-c\C-f\C-c" message-goto-cc
+ "\C-c\C-f\C-s" message-goto-subject
+ "\C-c\C-f\C-r" message-goto-reply-to
+ "\C-c\C-f\C-n" message-goto-newsgroups
+ "\C-c\C-f\C-d" message-goto-distribution
+ "\C-c\C-f\C-f" message-goto-followup-to
+ "\C-c\C-f\C-m" message-goto-mail-followup-to
+ "\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-b" message-goto-body
+ "\C-c\C-i" message-goto-signature
+
+ "\C-c\C-t" message-insert-to
+ "\C-c\C-n" message-insert-newsgroups
+ "\C-c\C-o" message-sort-headers
+ "\C-c\C-e" message-elide-region
+ "\C-c\C-v" message-delete-not-region
+ "\C-c\C-z" message-kill-to-signature
+ "\M-\r" message-newline-and-reformat
+ "\C-c\C-a" mml-attach-file
+ "\C-a" message-beginning-of-line
+ "\t" message-tab
+ "\M-;" comment-region)
(gnus-define-keys (gnus-article-edit-wash-map
"\C-c\C-w" gnus-article-edit-mode-map)
"f" gnus-article-edit-full-stops))
+(easy-menu-define
+ gnus-article-edit-mode-field-menu gnus-article-edit-mode-map ""
+ '("Field"
+ ["Fetch To" message-insert-to t]
+ ["Fetch Newsgroups" message-insert-newsgroups t]
+ "----"
+ ["To" message-goto-to t]
+ ["From" message-goto-from t]
+ ["Subject" message-goto-subject t]
+ ["Cc" message-goto-cc t]
+ ["Reply-To" message-goto-reply-to t]
+ ["Summary" message-goto-summary t]
+ ["Keywords" message-goto-keywords t]
+ ["Newsgroups" message-goto-newsgroups t]
+ ["Followup-To" message-goto-followup-to t]
+ ["Mail-Followup-To" message-goto-mail-followup-to t]
+ ["Distribution" message-goto-distribution t]
+ ["Body" message-goto-body t]
+ ["Signature" message-goto-signature t]))
+
(define-derived-mode gnus-article-edit-mode text-mode "Article Edit"
"Major mode for editing articles.
This is an extended text-mode.
(make-local-variable 'gnus-prev-winconf)
(set (make-local-variable 'font-lock-defaults)
'(message-font-lock-keywords t))
+ (set (make-local-variable 'mail-header-separator) "")
+ (easy-menu-add message-mode-field-menu message-mode-map)
+ (mml-mode)
(setq buffer-read-only nil)
(buffer-enable-undo)
(widen))
(interactive "P")
(let ((func gnus-article-edit-done-function)
(buf (current-buffer))
- (start (window-start)))
- ;; We remove all text props from the article buffer.
- (let ((content
- (buffer-substring-no-properties (point-min) (point-max)))
- (p (point)))
- (erase-buffer)
- (insert content)
- (let ((winconf gnus-prev-winconf))
- (gnus-article-mode)
- (set-window-configuration winconf)
- ;; Tippy-toe some to make sure that point remains where it was.
- (save-current-buffer
- (set-buffer buf)
- (set-window-start (get-buffer-window (current-buffer)) start)
- (goto-char p))))
+ (start (window-start))
+ (p (point))
+ (winconf gnus-prev-winconf))
+ (widen) ;; Widen it in case that users narrowed the buffer.
+ (funcall func arg)
+ (set-buffer buf)
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ ;; Flush original article as well.
(save-excursion
- (set-buffer buf)
- (let ((buffer-read-only nil))
- (funcall func arg))
- ;; The cache and backlog have to be flushed somewhat.
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- ;; Flush original article as well.
- (save-excursion
- (when (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (setq gnus-original-article nil)))
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current))))
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ ;; We remove all text props from the article buffer.
+ (kill-all-local-variables)
+ (gnus-set-text-properties (point-min) (point-max) nil)
+ (gnus-article-mode)
+ (set-window-configuration winconf)
(set-buffer buf)
(set-window-start (get-buffer-window buf) start)
(set-window-point (get-buffer-window buf) (point))))
;;; Internal Variables:
-(defcustom gnus-button-url-regexp "\\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\\)\\)"
+(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\\)\\)")
"Regular expression that matches URLs."
:group 'gnus-article-buttons
:type 'regexp)
+(defcustom gnus-button-man-handler 'man
+ "Function to use for displaying man pages.
+The function must take at least one argument with a string naming the
+man page."
+ :type '(choice (function-item :tag "Man" man)
+ (function-item :tag "Woman" woman)
+ (function :tag "Other"))
+ :group 'gnus-article-buttons)
+
(defcustom gnus-button-alist
- `(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
+ '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
0 t gnus-button-handle-news 3)
("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t
gnus-button-handle-news 2)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^<>]*\\)>" 1 t gnus-button-embedded-url 1)
;; Raw URLs.
- (,gnus-button-url-regexp 0 t browse-url 0))
+ (gnus-button-url-regexp 0 t browse-url 0)
+ ;; man pages
+ ("\\b\\([a-z]+\\)([0-9])\\W" 0 t gnus-button-handle-man 1))
"*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,
+REGEXP: is the string 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,
CALLBACK can also be a variable, in that case the value of that
variable it the real callback function."
:group 'gnus-article-buttons
- :type '(repeat (list regexp
+ :type '(repeat (list (choice regexp variable)
(integer :tag "Button")
(sexp :tag "Form")
(function :tag "Callback")
(integer :tag "Regexp group")))))
(defcustom gnus-header-button-alist
- `(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>"
+ '(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>"
0 t gnus-button-message-id 0)
("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t 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)
+ ("^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)
("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
gnus-button-message-id 3))
(article-goto-body)
(setq beg (point))
(while (setq entry (pop alist))
- (setq regexp (car entry))
+ (setq regexp (eval (car entry)))
(goto-char beg)
(while (re-search-forward regexp nil t)
(let* ((start (and entry (match-beginning (nth 1 entry))))
(match-beginning 0))
(point-max)))
(goto-char beg)
- (while (re-search-forward (nth 1 entry) end t)
+ (while (re-search-forward (eval (nth 1 entry)) end t)
;; Each match within a header.
(let* ((entry (cdr entry))
(start (match-beginning (nth 1 entry)))
(entry nil))
(while alist
(setq entry (pop alist))
- (if (looking-at (car entry))
+ (if (looking-at (eval (car entry)))
(setq alist nil)
(setq entry nil)))
entry))
(group
(gnus-button-fetch-group url)))))
+(defun gnus-button-handle-man (url)
+ "Fetch a man page."
+ (funcall gnus-button-man-handler url))
+
(defun gnus-button-handle-info (url)
"Fetch an info URL."
(if (string-match
This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
-(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
whose names match REGEXP.
For example:
-((\"chinese\" . gnus-decode-encoded-word-region-by-guess)
+\((\"chinese\" . gnus-decode-encoded-word-region-by-guess)
mail-decode-encoded-word-region
(\"chinese\" . rfc1843-decode-region))
")
projects / gnus / blobdiff