Import Oort Gnus v0.18.

[elisp/gnus.git-] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 378b588..71dfef1 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -432,7 +432,7 @@ If t, use `message-user-organization-file'."
   :group 'message-headers)
 
 (defcustom message-make-forward-subject-function
-  'message-forward-subject-author-subject
+  'message-forward-subject-name-subject
   "*List of functions called to generate subject headers for forwarded messages.
 The subject generated by the previous function is passed into each
 successive function.
@@ -441,6 +441,8 @@ The provided functions are:
 
 * `message-forward-subject-author-subject' (Source of article (author or
       newsgroup)), in brackets followed by the subject
+* `message-forward-subject-name-subject' (Source of article (name of author
+      or newsgroup)), in brackets followed by the subject
 * `message-forward-subject-fwd' (Subject of article with 'Fwd:' prepended
       to it."
   :group 'message-forwarding
@@ -982,6 +984,13 @@ candidates:
   (or (not (listp message-shoot-gnksa-feet))
       (memq feature message-shoot-gnksa-feet)))
 
+(defcustom message-hidden-headers nil
+  "Regexp of headers to be hidden when composing new messages.
+This can also be a list of regexps to match headers.  Or a list
+starting with `not' and followed by regexps.."
+  :group 'message
+  :type '(repeat regexp))
+
 ;;; Internal variables.
 ;;; Well, not really internal.
 
@@ -2216,7 +2225,7 @@ message composition doesn't break too bad."
   ;; No reason this should be clutter up customize.  We make it a
   ;; property list (rather than a list of property symbols), to be
   ;; directly useful for `remove-text-properties'.
-  '(field nil read-only nil intangible nil invisible nil
+  '(field nil read-only nil invisible nil intangible nil
          mouse-face nil modification-hooks nil insert-in-front-hooks nil
          insert-behind-hooks nil point-entered nil point-left nil)
   ;; Other special properties:
@@ -2247,7 +2256,11 @@ This function is intended to be called from `after-change-functions'.
 See also `message-forbidden-properties'."
   (when (and message-strip-special-text-properties
             (message-tamago-not-in-use-p begin))
-    (remove-text-properties begin end message-forbidden-properties)))
+    (while (not (= begin end))
+      (when (not (get-text-property begin 'message-hidden))
+       (remove-text-properties begin (1+ begin)
+                               message-forbidden-properties))
+      (incf begin))))
 
 ;;;###autoload
 (define-derived-mode message-mode text-mode "Message"
@@ -2691,6 +2704,7 @@ Prefix arg means justify as well."
        (delete-region (point) (re-search-forward "[ \t]*"))
        (when (and quoted (not bolp))
          (insert quoted leading-space)))
+      (undo-boundary)
       (if quoted
          (let* ((adaptive-fill-regexp
                  (regexp-quote (concat quoted leading-space)))
@@ -3272,7 +3286,14 @@ It should typically alter the sending method in some way or other."
   (goto-char (point-max))
   (unless (bolp)
     (insert "\n"))
-  ;; Delete all invisible text.
+  ;; Make the hidden headers visible.
+  (let ((points (message-text-with-property 'message-hidden)))
+    (when points
+      (goto-char (car points))
+      (dolist (point points)
+       (add-text-properties point (1+ point)
+                            '(invisible nil intangible nil)))))
+  ;; Make invisible text visible.
   (message-check 'invisible-text
     (let ((points (message-text-with-property 'invisible)))
       (when points
@@ -5823,6 +5844,22 @@ the list of newsgroups is was posted to."
              (mail-decode-encoded-word-string prefix)))
          "] " subject))
 
+(defun message-forward-subject-name-subject (subject)
+  "Generate a SUBJECT for a forwarded message.
+The form is: [Source] Subject, where if the original message was mail,
+Source is the name of the sender, and if the original message was
+news, Source is the list of newsgroups is was posted to."
+  (concat "["
+         (let ((prefix
+                (or (message-fetch-field "newsgroups")
+                    (cdr
+                     (mail-header-parse-address (message-fetch-field "from")))
+                    "(nowhere)")))
+           (if message-forward-decoded-p
+               prefix
+             (mail-decode-encoded-word-string prefix)))
+         "] " subject))
+
 (defun message-forward-subject-fwd (subject)
   "Generate a SUBJECT for a forwarded message.
 The form is: Fwd: Subject, where Subject is the original subject of
@@ -6468,6 +6505,39 @@ regexp varstr."
                             (if (and (or to cc) bcc) ", ")
                             (or bcc "")))))))
 
+(defun message-hide-headers ()
+  "Hide headers based on the `message-hidden-headers' variable."
+  (let ((regexps (if (stringp message-hidden-headers)
+                    (list message-hidden-headers)
+                  message-hidden-headers))
+       (inhibit-point-motion-hooks t)
+       (after-change-functions nil))
+    (when regexps
+      (save-excursion
+       (save-restriction
+         (message-narrow-to-headers)
+         (goto-char (point-min))
+         (while (not (eobp))
+           (if (not (message-hide-header-p regexps))
+               (message-next-header)
+             (let ((begin (point)))
+               (message-next-header)
+               (add-text-properties begin (point)
+                                    '(intangible t invisible t
+                                                 message-hidden t))))))))))
+
+(defun message-hide-header-p (regexps)
+  (let ((result nil)
+       (reverse nil))
+    (when (eq (car regexps) 'not)
+      (setq reverse t)
+      (pop regexps))
+    (dolist (regexp regexps)
+      (setq result (or result (looking-at regexp))))
+    (if reverse
+       (not result)
+      result)))
+
 (when (featurep 'xemacs)
   (require 'messagexmas)
   (message-xmas-redefine))