* gnus-art.el (gnus-article-edit-done): Kill-all-local-variables.
[gnus] / lisp / gnus-art.el
index 26991d4..307c9bd 100644 (file)
@@ -858,6 +858,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.
@@ -1063,7 +1070,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)
@@ -1078,6 +1086,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))
@@ -1223,6 +1242,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)
@@ -1234,8 +1254,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)
@@ -1244,7 +1262,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)
@@ -1260,6 +1277,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)))
 
@@ -1676,11 +1696,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)))))))
 
@@ -1742,7 +1762,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."
@@ -1829,10 +1850,14 @@ 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))
+             (let ((regexp
+                    (if gnus-treat-display-grey-xface
+                        "x-face\\(-[0-9]+\\)?"
+                      "x-face")))
+               (while (gnus-article-goto-header regexp)
+                 (when (match-beginning 2)
+                   (setq grey t))
+                 (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))
@@ -2048,6 +2073,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."
@@ -2080,6 +2115,7 @@ If READ-CHARSET, ask for a coding system."
   (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
@@ -2089,9 +2125,19 @@ If READ-CHARSET, ask for a coding system."
 (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.
@@ -3162,6 +3208,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
@@ -3258,6 +3305,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
@@ -3741,9 +3789,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)))
@@ -3764,7 +3812,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."
@@ -4076,7 +4125,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
+                                   gnus-article-no-strict-mime)
+                         (mm-uu-dissect)))
             buffer-read-only handle name type b e display)
        (when (and (not ihandles)
                   (not gnus-displaying-mime))
@@ -4723,9 +4774,9 @@ 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)) 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)
@@ -4740,9 +4791,9 @@ the entire article will be yanked."
   (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)
@@ -4965,17 +5016,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.
@@ -4985,6 +5087,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))
@@ -5024,37 +5129,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))))