*** empty log message ***
[gnus] / lisp / message.el
index bc0d000..92552cc 100644 (file)
@@ -49,7 +49,7 @@ mailbox format.")
 If this variable is nil, no such courtesy message will be added.")
 
 ;;;###autoload
-(defvar message-ignored-bounced-headers "^\\(Received\\):"
+(defvar message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
   "*Regexp that matches headers to be removed in resent bounced mail.")
 
 ;;;###autoload
@@ -70,7 +70,7 @@ Otherwise, most addresses look like `angles', but they look like
 (defvar message-syntax-checks nil
   "Controls what syntax checks should not be performed on outgoing posts.
 To disable checking of long signatures, for instance, add
- `(signature . disable)' to this list.
+ `(signature . disabled)' to this list.
 
 Don't touch this variable unless you really know what you're doing.
 
@@ -193,15 +193,21 @@ variable `message-header-separator'.")
 
 ;;;###autoload
 (defvar message-reply-to-function nil
-  "Function that should return a list of headers.")
+  "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
 
 ;;;###autoload
 (defvar message-wide-reply-to-function nil
-  "Function that should return a list of headers.")
+  "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
 
 ;;;###autoload
 (defvar message-followup-to-function nil
-  "Function that should return a list of headers.")
+  "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
 
 ;;;###autoload
 (defvar message-use-followup-to 'ask
@@ -342,7 +348,7 @@ actually occur.")
 (defvar message-font-lock-keywords
   (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")))
     (list '("^To:" . font-lock-function-name-face)
-         '("^B?CC:\\|^Reply-To:" . font-lock-keyword-face)
+          '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face)
          '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
            (1 font-lock-comment-face) (2 font-lock-type-face nil t))
          (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
@@ -370,8 +376,85 @@ The cdr of ech entry is a function for applying the face to a region.")
 (defvar message-sent-hook nil
   "Hook run after sending messages.")
 
+(if (string-match "XEmacs\\|Lucid" emacs-version)
+    (defvar message-mode-menu
+      '("Send Message"
+       "Go to Field:"
+       "----"
+       ["To:" message-goto-to t]
+       ["Subject:" message-goto-subject t]
+       ["Summary:" message-goto-summary t]
+       ["Keywords:" message-goto-keywords t]
+       ["Newsgroups:" message-goto-newsgroups t]
+       ["Followup-To:" message-goto-followup-to t]
+       ["Distribution:" message-goto-distribution t]
+       ["Body" message-goto-body t]
+       ["Signature" message-goto-signature t]
+       "----"
+       "Miscellaneous Commands:"
+       "----"
+       ["Sort Headers" message-sort-headers t]
+       ["Yank Original" message-yank-original t]
+       ["Fill Yanked Message" message-fill-yanked-message t]
+;;  ["Insert Signature"         news-reply-signature     t]
+       ["Caesar (rot13) Message" message-caesar-buffer-body t]
+       "----"
+       ["Post Message" message-send-and-exit t]
+       ["Abort Message" message-dont-send t]
+       )
+      "Buffer Menu for XEmacs."))
+
 ;;; Internal variables.
 
+;;; Regexp matching the delimiter of messages in UNIX mail format
+;;; (UNIX From lines), minus the initial ^.  
+(defvar message-unix-mail-delimiter
+  (let ((time-zone-regexp
+        (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
+                "\\|[-+]?[0-9][0-9][0-9][0-9]"
+                "\\|"
+                "\\) *")))
+    (concat
+     "From "
+
+     ;; Username, perhaps with a quoted section that can contain spaces.
+     "\\("
+     "[^ \n]*"
+     "\\(\\|\".*\"[^ \n]*\\)"
+     "\\|<[^<>\n]+>"
+     "\\)  ?"
+
+     ;; The time the message was sent.
+     "\\([^ \n]*\\) *"                 ; day of the week
+     "\\([^ ]*\\) *"                   ; month
+     "\\([0-9]*\\) *"                  ; day of month
+     "\\([0-9:]*\\) *"                 ; time of day
+
+     ;; Perhaps a time zone, specified by an abbreviation, or by a
+     ;; numeric offset.
+     time-zone-regexp
+
+     ;; The year.
+     " [0-9][0-9]\\([0-9]*\\) *"
+
+     ;; On some systems the time zone can appear after the year, too.
+     time-zone-regexp
+
+     ;; Old uucp cruft.
+     "\\(remote from .*\\)?"
+
+     "\n")))
+
+(defvar message-unsent-separator
+  (concat "^ *---+ +Unsent message follows +---+ *$\\|"
+         "^ *---+ +Returned message +---+ *$\\|"
+         "^Start of returned message$\\|"
+         "^ *---+ +Original message +---+ *$\\|"
+         "^ *--+ +begin message +--+ *$\\|"
+         "^ *---+ +Original message follows +---+ *$\\|"
+         "^|? *---+ +Message text follows: +---+ *|?$")
+  "A regexp that matches the separator before the text of a failed message.")
+
 (defvar message-header-format-alist 
   `((Newsgroups)
     (To . message-fill-header) 
@@ -391,6 +474,9 @@ The cdr of ech entry is a function for applying the face to a region.")
     (X-Newsreader))
   "Alist used for formatting headers.")
 
+(eval-and-compile
+  (autoload 'message-setup-toolbar "message-xmas"))
+
 \f
 
 ;;; 
@@ -609,11 +695,13 @@ Return the number of headers removed."
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
   (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
   (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
-  (define-key message-mode-map "\C-c\C-h" 'message-sort-headers)
+  (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
 
   (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
   (define-key message-mode-map "\C-c\C-s" 'message-send)
-  (define-key message-mode-map "\C-c\C-k" 'message-dont-send))
+  (define-key message-mode-map "\C-c\C-k" 'message-dont-send)
+  (if (string-match "XEmacs\\|Lucid" emacs-version)
+      (define-key message-mode-map 'button3 'message-mode-menu)))
 
 (defun message-make-menu-bar ()
   (unless (boundp 'message-menu)
@@ -684,6 +772,8 @@ C-c C-r  message-ceasar-buffer-body (rot13 the message body)."
   (setq message-checksum nil)
   (when (fboundp 'mail-hist-define-keys)
     (mail-hist-define-keys))
+  (when (string-match "XEmacs\\|Lucid" emacs-version)
+    (message-setup-toolbar))
   (run-hooks 'text-mode-hook 'message-mode-hook))
 
 \f
@@ -1355,8 +1445,12 @@ the user from the mailer."
         (re-search-forward
          (concat "^" (regexp-quote mail-header-separator) "$"))
         (forward-line 1)
-        (or (re-search-forward "[^ \n\t]" nil t)
-            (y-or-n-p "Empty article.  Really post?"))))
+        (let ((b (point)))
+          (or (re-search-forward message-signature-separator nil t)
+              (goto-char (point-max)))
+          (beginning-of-line)
+          (or (re-search-backward "[^ \n\t]" b t)
+              (y-or-n-p "Empty article.  Really post? ")))))
    ;; Check for control characters.
    (or (message-check-element 'control-chars)
        (save-excursion
@@ -1392,14 +1486,19 @@ the user from the mailer."
 
 (defun message-check-element (type)
   "Returns non-nil if this type is not to be checked."
-  (let ((able (assq type message-syntax-checks)))
-    (and (consp able)
-        (eq (cdr able) 'disabled))))
+  (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
+      nil
+    (let ((able (assq type message-syntax-checks)))
+      (and (consp able)
+          (eq (cdr able) 'disabled)))))
 
 (defun message-checksum ()
   "Return a \"checksum\" for the current buffer."
   (let ((sum 0))
     (save-excursion
+      (goto-char (point-min))
+      (re-search-forward
+       (concat "^" (regexp-quote mail-header-separator) "$"))
       (while (not (eobp))
        (setq sum (logxor sum (following-char)))
        (forward-char 1)))
@@ -1421,7 +1520,7 @@ the user from the mailer."
          (push file list)
          (message-remove-header "fcc" nil t)))
       (goto-char (point-min))
-      (re-search-forward (concat "^" mail-header-separator "$"))
+      (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
       (replace-match "" t t)
       ;; Process FCC operations.
       (while list
@@ -1544,9 +1643,9 @@ the user from the mailer."
                  message-user-organization)))))
     (save-excursion
       (message-set-work-buffer)
-      (cond ((stringp message-user-organization)
-            (insert message-user-organization))
-           ((and (eq t message-user-organization)
+      (cond ((stringp organization)
+            (insert organization))
+           ((and (eq t organization)
                  message-user-organization-file
                  (file-exists-p message-user-organization-file))
             (insert-file-contents message-user-organization-file)))
@@ -1849,8 +1948,7 @@ Headers already prepared in the buffer are not modified."
 (defun message-fill-header (header value)
   (let ((begin (point))
        (fill-column 78)
-       (fill-prefix "\t")
-       end)
+       (fill-prefix "\t"))
     (insert (capitalize (symbol-name header))
            ": "
            (if (consp value) (car value) value)
@@ -1929,14 +2027,16 @@ Headers already prepared in the buffer are not modified."
     (when message-generate-headers-first
       (message-generate-headers
        (delq 'Lines
-            (copy-sequence message-required-news-headers)))))
+            (delq 'Subject
+                  (copy-sequence message-required-news-headers))))))
   (when (message-mail-p)
     (when message-default-mail-headers
       (insert message-default-mail-headers))
     (when message-generate-headers-first
       (message-generate-headers
        (delq 'Lines
-            (copy-sequence message-required-mail-headers)))))
+            (delq 'Subject
+                  (copy-sequence message-required-mail-headers))))))
   (message-insert-signature)
   (message-set-auto-save-file-name)
   (save-restriction
@@ -1945,7 +2045,7 @@ Headers already prepared in the buffer are not modified."
   ;; Allow mail alias things.
   (if (fboundp 'mail-abbrevs-setup)
       (mail-abbrevs-setup)
-    (mail-aliases-setup))
+    (funcall (intern "mail-aliases-setup")))
   (set-buffer-modified-p nil)
   (run-hooks 'message-setup-hook)
   (message-position-point)
@@ -1995,8 +2095,8 @@ Headers already prepared in the buffer are not modified."
   "Start editing a reply to the article in the current buffer."
   (interactive)
   (let ((cur (current-buffer))
-       from subject date reply-to message-of to cc
-       references message-id sender follow-to sendto elt new-cc new-to
+       from subject date reply-to to cc
+       references message-id follow-to 
        mct never-mct gnus-warning)
     (save-restriction
       (narrow-to-region
@@ -2017,7 +2117,6 @@ Headers already prepared in the buffer are not modified."
       ;; Find all relevant headers we need.
       (setq from (mail-fetch-field "from")
            date (mail-fetch-field "date") 
-           sender (mail-fetch-field "sender")
            subject (or (mail-fetch-field "subject") "none")
            to (mail-fetch-field "to")
            cc (mail-fetch-field "cc")
@@ -2098,8 +2197,8 @@ Headers already prepared in the buffer are not modified."
 (defun message-followup ()
   (interactive)
   (let ((cur (current-buffer))
-       from subject date message-of reply-to mct
-       references message-id follow-to sendto elt 
+       from subject date reply-to mct
+       references message-id follow-to 
        followup-to distribution newsgroups gnus-warning)
     (save-restriction
       (narrow-to-region
@@ -2207,7 +2306,7 @@ Headers already prepared in the buffer are not modified."
              mail-header-separator "\n"
              "This is a cancel message from " from ".\n")
       (message "Canceling your article...")
-      (let (message-syntax-checks)
+      (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
        (funcall message-send-news-function))
       (message "Canceling your article...done")
       (kill-buffer buf))))
@@ -2363,7 +2462,7 @@ you."
     (or (and boundary
             (re-search-forward boundary nil t)
             (forward-line 2))
-       (and (re-search-forward mail-unsent-separator nil t)
+       (and (re-search-forward message-unsent-separator nil t)
             (forward-line 1))
        (and (search-forward "\n\n" nil t)
             (re-search-forward "^Return-Path:.*\n" nil t)))
@@ -2468,6 +2567,10 @@ which specify the range to operate on."
        (if (eq (following-char) (char-after (- (point) 2)))
           (delete-char -2))))))
 
+;; Support for Mouse menus
+(when (string-match "XEmacs\\|Lucid" emacs-version)
+  (require 'message-xmas))
+
 (provide 'message)
 
 ;;; message.el ends here