diff lisp/gnus/message.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 0293115a14e9
line wrap: on
line diff
--- a/lisp/gnus/message.el	Mon Aug 13 08:45:53 2007 +0200
+++ b/lisp/gnus/message.el	Mon Aug 13 08:46:35 2007 +0200
@@ -40,7 +40,6 @@
     (require 'mail-abbrevs)
   (require 'mailabbrev))
 
-;;;###autoload
 (defvar message-directory "~/Mail/"
   "*Directory from which all other mail file variables are derived.")
 
@@ -164,9 +163,8 @@
 (defvar message-user-organization-file "/usr/lib/news/organization"
   "*Local news organization file.")
 
-;;;###autoload
-(defvar message-autosave-directory
-  (concat (file-name-as-directory message-directory) "drafts/")
+(defvar message-autosave-directory "~/"
+  ; (concat (file-name-as-directory message-directory) "drafts/")
   "*Directory where message autosaves buffers.
 If nil, message won't autosave.")
 
@@ -378,6 +376,10 @@
     table)
   "Syntax table used while in Message mode.")
 
+(defvar message-mode-abbrev-table text-mode-abbrev-table
+  "Abbrev table used in Message mode buffers.
+Defaults to `text-mode-abbrev-table'.")
+
 (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)
@@ -517,13 +519,16 @@
 \",\" is used as the separator."
   (let ((regexp (format "[%s]+" (or separator ",")))
 	(beg 1)
+	(first t)
 	quoted elems)
     (save-excursion
       (message-set-work-buffer)
       (insert header)
       (goto-char (point-min))
       (while (not (eobp))
-	(forward-char 1)
+	(if first
+	    (setq first nil)
+	  (forward-char 1))
 	(cond ((and (> (point) beg)
 		    (or (eobp)
 			(and (looking-at regexp)
@@ -789,7 +794,7 @@
   (make-local-variable 'message-postpone-actions)
   (set-syntax-table message-mode-syntax-table)
   (use-local-map message-mode-map)
-  (setq local-abbrev-table text-mode-abbrev-table)
+  (setq local-abbrev-table message-mode-abbrev-table)
   (setq major-mode 'message-mode)
   (setq mode-name "Message")
   (setq buffer-offer-save t)
@@ -824,8 +829,8 @@
   (setq message-sent-message-via nil)
   (make-local-variable 'message-checksum)
   (setq message-checksum nil)
-  (when (fboundp 'mail-hist-define-keys)
-    (mail-hist-define-keys))
+  ;;(when (fboundp 'mail-hist-define-keys)
+  ;;  (mail-hist-define-keys))
   (when (string-match "XEmacs\\|Lucid" emacs-version)
     (message-setup-toolbar))
   (easy-menu-add message-mode-menu message-mode-map)
@@ -963,11 +968,8 @@
 		      (file-exists-p message-signature-file))
 		 signature))))
     (when signature
-;      ;; Remove blank lines at the end of the message.
+      ;; Insert the signature.
       (goto-char (point-max))
-;      (skip-chars-backward " \t\n")
-;      (delete-region (point) (point-max))
-      ;; Insert the signature.
       (unless (bolp)
 	(insert "\n"))
       (insert "\n-- \n")
@@ -1050,7 +1052,11 @@
 	     (name (if enter-string
 		       (read-string "New buffer name: " name-default)
 		     name-default)))
-	(rename-buffer name t)))))
+	(rename-buffer name t)
+	(setq buffer-auto-save-file-name
+	      (format "%s%s"
+		      (file-name-as-directory message-autosave-directory)
+		      (file-name-nondirectory buffer-auto-save-file-name)))))))
 
 (defun message-fill-yanked-message (&optional justifyp)
   "Fill the paragraphs of a message yanked into this one.
@@ -1095,6 +1101,8 @@
 Normally indents each nonblank line ARG spaces (default 3).  However,
 if `message-yank-prefix' is non-nil, insert that prefix on each line.
 
+This function uses `message-cite-function' to do the actual citing.
+
 Just \\[universal-argument] as argument means don't indent, insert no
 prefix, and don't delete any headers."
   (interactive "P")
@@ -1255,8 +1263,8 @@
 			     "Already sent message via mail; resend? "))
 			(message-send-mail arg))))
       (message-do-fcc)
-      (when (fboundp 'mail-hist-put-headers-into-history)
-	(mail-hist-put-headers-into-history))
+      ;;(when (fboundp 'mail-hist-put-headers-into-history)
+      ;; (mail-hist-put-headers-into-history))
       (run-hooks 'message-sent-hook)
       (message "Sending...done")
       ;; If buffer has no file, mark it as unmodified and delete autosave.
@@ -1316,7 +1324,11 @@
 	(save-excursion
 	  (set-buffer tembuf)
 	  (erase-buffer)
-	  (insert-buffer-substring mailbuf)
+	  ;; Avoid copying text props.
+	  (insert (format 
+		   "%s" (save-excursion
+			  (set-buffer mailbuf)
+			  (buffer-string))))
 	  ;; Remove some headers.
 	  (save-restriction
 	    (message-narrow-to-headers)
@@ -1413,6 +1425,11 @@
 		    (funcall message-post-method arg)
 		  message-post-method))
 	(messbuf (current-buffer))
+	(message-syntax-checks
+	 (if arg
+	     (cons '(existing-newsgroups . disabled)
+		   message-syntax-checks)
+	   message-syntax-checks))
 	result)
     (save-restriction
       (message-narrow-to-headers)
@@ -1427,7 +1444,11 @@
 	    (set-buffer tembuf)
 	    (buffer-disable-undo (current-buffer))
 	    (erase-buffer) 
-	    (insert-buffer-substring messbuf)
+	    ;; Avoid copying text props.
+	  (insert (format 
+		   "%s" (save-excursion
+			  (set-buffer messbuf)
+			  (buffer-string))))
 	    ;; Remove some headers.
 	    (save-restriction
 	      (message-narrow-to-headers)
@@ -1526,8 +1547,9 @@
 	;; Check "Shoot me".
 	(or (message-check-element 'shoot)
 	    (save-excursion
-	      (if (search-forward
-		   ".i-have-a-misconfigured-system-so-shoot-me" nil t)
+	      (if (re-search-forward
+		   "Message-ID.*.i-have-a-misconfigured-system-so-shoot-me"
+		   nil t)
 		  (y-or-n-p
 		   "You appear to have a misconfigured system.  Really post? ")
 		t)))
@@ -1663,8 +1685,8 @@
 	  (concat "^" (regexp-quote mail-header-separator) "$"))
 	 (forward-line 1)
 	 (let ((b (point)))
-	   (or (re-search-forward message-signature-separator nil t)
-	       (goto-char (point-max)))
+	   (goto-char (point-max))
+	   (re-search-backward message-signature-separator nil t)
 	   (beginning-of-line)
 	   (or (re-search-backward "[^ \n\t]" b t)
 	       (y-or-n-p "Empty article.  Really post? ")))))
@@ -1694,7 +1716,7 @@
     (message-check-element 'signature)
     (progn
       (goto-char (point-max))
-      (if (or (not (re-search-backward "^-- $" nil t))
+      (if (or (not (re-search-backward message-signature-separator nil t))
 	      (search-forward message-forward-end-separator nil t))
 	  t
 	(if (> (count-lines (point) (point-max)) 5)
@@ -1759,7 +1781,7 @@
 		   (not (eq message-fcc-handler-function 'rmail-output)))
 	      (funcall message-fcc-handler-function file)
 	    (if (and (file-readable-p file) (mail-file-babyl-p file))
-		(rmail-output file 1)
+		(rmail-output file 1 nil t)
 	      (let ((mail-use-rfc822 t))
 		(rmail-output file 1 t t))))))
       (kill-buffer (current-buffer)))))
@@ -2285,8 +2307,8 @@
   ;; We might have sent this buffer already.  Delete it from the
   ;; list of buffers.
   (setq message-buffer-list (delq (current-buffer) message-buffer-list))
-  (when (and message-max-buffers
-	     (>= (length message-buffer-list) message-max-buffers))
+  (while (and message-max-buffers
+	      (>= (length message-buffer-list) message-max-buffers))
     ;; Kill the oldest buffer -- unless it has been changed.
     (let ((buffer (pop message-buffer-list)))
       (when (and (buffer-name buffer)
@@ -2407,6 +2429,7 @@
   (let ((cur (current-buffer))
 	from subject date reply-to to cc
 	references message-id follow-to 
+	(inhibit-point-motion-hooks t)
 	mct never-mct gnus-warning)
     (save-restriction
       (narrow-to-region
@@ -2461,10 +2484,9 @@
 	      (message-set-work-buffer)
 	      (unless never-mct
 		(insert (or reply-to from "")))
-	      (insert 
-	       (if (bolp) "" ", ") (or to "")
-	       (if mct (concat (if (bolp) "" ", ") mct) "")
-	       (if cc (concat (if (bolp) "" ", ") cc) ""))
+	      (insert (if (bolp) "" ", ") (or to ""))
+	      (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
+	      (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
 	      ;; Remove addresses that match `rmail-dont-reply-to-names'. 
 	      (insert (prog1 (rmail-dont-reply-to (buffer-string))
 			(erase-buffer)))
@@ -2473,7 +2495,7 @@
 		    (mapcar
 		     (lambda (addr)
 		       (cons (mail-strip-quoted-names addr) addr))
-		     (nreverse (mail-parse-comma-list))))
+		     (message-tokenize-header (buffer-string))))
 	      (let ((s ccalist))
 		(while s
 		  (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
@@ -2484,7 +2506,9 @@
 		    follow-to)))))
       (widen))
 
-    (message-pop-to-buffer (message-buffer-name "reply" from))
+    (message-pop-to-buffer (message-buffer-name
+			    (if wide "wide reply" "reply") from
+			    (if wide to-address nil)))
 
     (setq message-reply-headers
 	  (vector 0 subject from date message-id references 0 0 ""))
@@ -2509,6 +2533,7 @@
   (let ((cur (current-buffer))
 	from subject date reply-to mct
 	references message-id follow-to 
+	(inhibit-point-motion-hooks t)
 	followup-to distribution newsgroups gnus-warning)
     (save-restriction
       (narrow-to-region
@@ -2902,7 +2927,7 @@
        (if (eq (following-char) (char-after (- (point) 2)))
 	   (delete-char -2))))))
 
-(fset 'message-exchange-point-and-mark 'exchange-point-and-mark)
+(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
 
 ;; Support for toolbar
 (when (string-match "XEmacs\\|Lucid" emacs-version)
@@ -2959,7 +2984,7 @@
 ;;; Help stuff.
 
 (defmacro message-y-or-n-p (question show &rest text)
-  "Ask QUESTION, displaying the rest of the arguments in a temporary buffer."
+  "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
   `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
 
 (defun message-talkative-question (ask question show &rest text)