X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=5d79fa03cf3b805277ac49cd0e5b8d6cfdaebfc5;hb=31bb9d5f19eb2a7d4109f65bac0132597bcc6b83;hp=3b4058715d5331095054589d13bcfe2e83bb28e1;hpb=0c85a7d5fbb3e55fde24900d8d00819830a3e96e;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 3b4058715..5d79fa03c 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -280,23 +280,23 @@ directly.") (defcustom gnus-emphasis-alist (let ((format - "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)") + "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)") (types - '(("_" "_" underline) + '(("\\*" "\\*" bold) + ("_" "_" underline) ("/" "/" italic) - ("\\*" "\\*" bold) ("_/" "/_" underline-italic) ("_\\*" "\\*_" underline-bold) ("\\*/" "/\\*" bold-italic) ("_\\*/" "/\\*_" underline-bold-italic)))) - `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline) - ,@(mapcar + `(,@(mapcar (lambda (spec) (list (format format (car spec) (cadr spec)) 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) - types))) + types) + ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-underline))) "*Alist that says how to fontify certain phrases. Each item looks like this: @@ -704,6 +704,21 @@ be controlled by `gnus-treat-body-boundary'." :type '(choice (item :tag "None" :value nil) string)) +(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") + "*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 + :group 'gnus-picon) + +(defun gnus-picons-installed-p () + "Say whether picons are installed on your machine." + (let ((installed nil)) + (dolist (database gnus-picon-databases) + (when (file-exists-p database) + (setq installed t))) + installed)) + (defcustom gnus-article-mime-part-function nil "Function called with a MIME handle as the argument. This is meant for people who want to do something automatic based @@ -752,28 +767,13 @@ used." ("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 ;;; @@ -843,6 +843,13 @@ See Info node `(gnus)Customizing Articles' for details." :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. @@ -1048,7 +1055,8 @@ See Info node `(gnus)Customizing Articles' for details." (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) @@ -1063,6 +1071,17 @@ See Info node `(gnus)Customizing Articles' and Info node :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)) @@ -1079,7 +1098,8 @@ See Info node `(gnus)Customizing Articles' and Info node (put 'gnus-treat-display-smileys 'highlight t) (defcustom gnus-treat-from-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in the From header. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -1090,7 +1110,8 @@ See Info node `(gnus)Customizing Articles' and Info node (put 'gnus-treat-from-picon 'highlight t) (defcustom gnus-treat-mail-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in To and Cc headers. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -1101,7 +1122,8 @@ See Info node `(gnus)Customizing Articles' and Info node (put 'gnus-treat-mail-picon 'highlight t) (defcustom gnus-treat-newsgroups-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in the Newsgroups and Followup-To headers. Valid values are nil, t, `head', `last', an integer or a predicate. @@ -1174,6 +1196,9 @@ It is a string, such as \"PGP\". If nil, ask user." :type 'string :group 'mime-security) +(defvar gnus-article-wash-function nil + "Function used for converting HTML into text.") + ;;; Internal variables (defvar gnus-english-month-names @@ -1195,6 +1220,7 @@ It is a string, such as \"PGP\". If nil, ask user." (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) @@ -1206,8 +1232,6 @@ It is a string, such as \"PGP\". If nil, ask user." (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) @@ -1216,7 +1240,6 @@ It is a string, such as \"PGP\". If nil, ask user." (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) @@ -1232,6 +1255,9 @@ It is a string, such as \"PGP\". If nil, ask user." (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))) @@ -1648,11 +1674,11 @@ unfolded." (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))))))) @@ -1667,7 +1693,7 @@ unfolded." (goto-char (point-max)))))) (defun gnus-treat-smiley () - "Display textual emoticons (\"smileys\") as small graphical icons." + "Toggle display of textual emoticons (\"smileys\") as small graphical icons." (interactive) (gnus-with-article-buffer (if (memq 'smiley gnus-article-wash-types) @@ -1703,7 +1729,7 @@ unfolded." (defun gnus-article-treat-body-boundary () "Place a boundary line at the end of the headers." (interactive) - (when (and gnus-body-boundary-delimiter + (when (and gnus-body-boundary-delimiter (> (length gnus-body-boundary-delimiter) 0)) (gnus-with-article-headers (goto-char (point-max)) @@ -1714,7 +1740,8 @@ unfolded." (while (>= (1- (window-width)) (length str)) (setq str (concat str gnus-body-boundary-delimiter))) (substring str 0 (1- (window-width)))) - "\n"))))) + "\n") + (gnus-add-text-properties start (point) '(gnus-decoration 'header)))))) (defun article-fill-long-lines () "Fill lines that are wider than the window width." @@ -1792,7 +1819,7 @@ unfolded." (when (and wash-face-p (progn (goto-char (point-min)) - (not (re-search-forward + (not (re-search-forward "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t))) (gnus-buffer-live-p gnus-original-article-buffer)) ;; If type `W f', use gnus-original-article-buffer, @@ -1801,10 +1828,24 @@ unfolded." (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)) @@ -1812,6 +1853,9 @@ unfolded." (when xpm (setq image (gnus-create-image xpm 'xpm t)) (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) (gnus-add-wash-type 'xface) (gnus-add-image 'xface image) (gnus-put-image image))) @@ -2017,6 +2061,16 @@ If READ-CHARSET, ask for a coding system." (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))))) + (defun article-wash-html (&optional read-charset) "Format an html article. If READ-CHARSET, ask for a coding system." @@ -2042,14 +2096,44 @@ If READ-CHARSET, ask for a coding system." (save-window-excursion (save-restriction (narrow-to-region (point) (point-max)) - (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 - (w3-region (point-min) (point-max)) - (error)))))))) + (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) + (url-gateway-unplugged t) + (w3-honor-stylesheets nil) + (w3-delay-image-loads t)) + (condition-case var + (w3-region (point-min) (point-max)) + (error)))) + +(defun gnus-article-wash-html-with-w3m () + "Wash the current buffer with emacs-w3m." + (mm-setup-w3m) + (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. @@ -2635,12 +2719,12 @@ This format is defined by the `gnus-article-time-format' variable." (interactive (list t)) (article-date-ut 'iso8601 highlight)) -(defun article-show-all () - "Show all hidden text in the article buffer." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (gnus-article-unhide-text (point-min) (point-max))))) +;; (defun article-show-all () +;; "Show all hidden text in the article buffer." +;; (interactive) +;; (save-excursion +;; (let ((buffer-read-only nil)) +;; (gnus-article-unhide-text (point-min) (point-max))))) (defun article-remove-leading-whitespace () "Remove excessive whitespace from all headers." @@ -3120,6 +3204,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-de-base64-unreadable article-decode-HZ article-wash-html + article-unsplit-urls article-hide-list-identifiers article-hide-pgp article-strip-banner @@ -3148,7 +3233,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-emphasize article-treat-dumbquotes article-normalize-headers - (article-show-all . gnus-article-show-all-headers)))) +;; (article-show-all . gnus-article-show-all-headers) + ))) ;;; ;;; Gnus article mode @@ -3215,6 +3301,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["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 @@ -3491,8 +3578,8 @@ General format specifiers can also be used. See (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"))) @@ -3698,9 +3785,9 @@ General format specifiers can also be used. See (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))) @@ -3721,7 +3808,8 @@ General format specifiers can also be used. See (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." @@ -3776,7 +3864,7 @@ specified charset." (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) @@ -3792,7 +3880,7 @@ specified charset." (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) @@ -3852,10 +3940,10 @@ If no internal viewer is available, use an external viewer." (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." @@ -3913,8 +4001,11 @@ If no internal viewer is available, use an external viewer." (let ((window (selected-window)) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (if (gnus-buffer-live-p gnus-summary-buffer) + (save-excursion + (set-buffer gnus-summary-buffer) + gnus-newsgroup-ignored-charsets) + nil))) (save-excursion (unwind-protect (let ((win (gnus-get-buffer-window (current-buffer) t)) @@ -4030,7 +4121,9 @@ If no internal viewer is available, use an external viewer." ;; 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)) @@ -4351,7 +4444,7 @@ is the string to use when it is inactive.") (defun gnus-add-wash-type (type) "Add a washing of TYPE to the current status." - (push type gnus-article-wash-types)) + (add-to-list 'gnus-article-wash-types type)) (defun gnus-delete-wash-type (type) "Add a washing of TYPE to the current status." @@ -4676,30 +4769,33 @@ Argument LINES specifies lines to be scrolled down." The text in the region will be yanked. If the region isn't active, the entire article will be yanked." (interactive "P") - (let ((article (cdr gnus-article-current))) - (if (not mark-active) + (let ((article (cdr gnus-article-current)) cont) + (if (not (mark t)) (gnus-summary-reply (list (list article)) wide) + (setq cont (buffer-substring (point) (mark t))) ;; Deactivate active regions. (when (and (boundp 'transient-mark-mode) transient-mark-mode) (setq mark-active nil)) (gnus-summary-reply - (list (list article (buffer-substring (point) (mark)))) wide)))) + (list (list article cont)) wide)))) (defun gnus-article-followup-with-original () "Compose a followup to the current article. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." (interactive) - (let ((article (cdr gnus-article-current))) - (if (not mark-active) + (let ((article (cdr gnus-article-current)) + cont) + (if (not (mark t)) (gnus-summary-followup (list (list article))) + (setq cont (buffer-substring (point) (mark t))) ;; Deactivate active regions. (when (and (boundp 'transient-mark-mode) transient-mark-mode) (setq mark-active nil)) (gnus-summary-followup - (list (list article (buffer-substring (point) (mark)))))))) + (list (list article cont)))))) (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. @@ -4725,6 +4821,9 @@ If given a prefix, show the hidden text instead." (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) +(eval-when-compile + (autoload 'nneething-get-file-name "nneething")) + (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." (let (do-update-line sparse-header) @@ -4774,12 +4873,10 @@ If given a prefix, show the hidden text instead." gnus-newsgroup-name))) (when (and (eq (car method) 'nneething) (vectorp header)) - (let ((dir (expand-file-name - (mail-header-subject header) - (file-name-as-directory - (or (cadr (assq 'nneething-address method)) - (nth 1 method)))))) - (when (file-directory-p dir) + (let ((dir (nneething-get-file-name + (mail-header-id header)))) + (when (and (stringp dir) + (file-directory-p dir)) (setq article 'nneething) (gnus-group-enter-directory dir)))))))) @@ -4818,6 +4915,11 @@ If given a prefix, show the hidden text instead." (numberp article) (gnus-cache-request-article article group)) 'article) + ;; Check the agent cache. + ((and gnus-agent gnus-agent-cache gnus-plugged + (numberp article) + (gnus-agent-request-article article group)) + 'article) ;; Get the article and put into the article buffer. ((or (stringp article) (numberp article)) @@ -4910,17 +5012,68 @@ If given a prefix, show the hidden text instead." ;; 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. @@ -4930,6 +5083,9 @@ 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)) @@ -4969,37 +5125,28 @@ groups." (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)) + (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)))) @@ -5064,7 +5211,7 @@ groups." ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-handle-info 2) ;; This is how URLs _should_ be embedded in text... - ("]*\\)>" 0 t gnus-button-embedded-url 1) + ("]*\\)>" 1 t gnus-button-embedded-url 1) ;; Raw URLs. (,gnus-button-url-regexp 0 t browse-url 0)) "*Alist of regexps matching buttons in article bodies. @@ -5097,6 +5244,7 @@ variable it the real callback function." ("^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)) "*Alist of headers and regexps to match buttons in article heads. @@ -5485,7 +5633,7 @@ specified by `gnus-button-alist'." (if (not (string-match "=" cur)) nil ; Grace (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0))) - val (gnus-url-unhex-string (substring cur (match-end 0) nil))) + val (gnus-url-unhex-string (substring cur (match-end 0) nil) t)) (if downcase (setq key (downcase key))) (setq cur (assoc key retval)) @@ -5542,7 +5690,7 @@ specified by `gnus-button-alist'." (gnus-eval-format gnus-prev-page-line-format nil `(,@(gnus-local-map-property gnus-prev-page-map) - gnus-prev t + gnus-prev t gnus-callback gnus-article-button-prev-page article-type annotation)) (widget-convert-button @@ -5589,7 +5737,7 @@ specified by `gnus-button-alist'." (buffer-read-only nil)) (gnus-eval-format gnus-next-page-line-format nil `(,@(gnus-local-map-property gnus-next-page-map) - gnus-next t + gnus-next t gnus-callback gnus-article-button-next-page article-type annotation)) (widget-convert-button