xemacs-beta: lisp/gnus/message.el comparison

comparison 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

comparison

equal deleted inserted replaced

-:c0c6a60d29db
+:ac2d302a0011
 (require 'easymenu)
 (if (string-match "XEmacs\\|Lucid" emacs-version)
 (require 'mail-abbrevs)
 (require 'mailabbrev))
-;;;###autoload
 (defvar message-directory "~/Mail/"
 "*Directory from which all other mail file variables are derived.")
 (defvar message-max-buffers 10
 "*How many buffers to keep before starting to kill them off.")
 ;;;###autoload
 (defvar message-user-organization-file "/usr/lib/news/organization"
 "*Local news organization file.")
-;;;###autoload
+(defvar message-autosave-directory "~/"
-(defvar message-autosave-directory
+; (concat (file-name-as-directory message-directory) "drafts/")
-(concat (file-name-as-directory message-directory) "drafts/")
 "*Directory where message autosaves buffers.
 If nil, message won't autosave.")
 (defvar message-forward-start-separator
 "------- Start of forwarded message -------\n"
 (let ((table (copy-syntax-table text-mode-syntax-table)))
 (modify-syntax-entry ?% ". " table)
 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)
 '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face)
 	  '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
 (defun message-tokenize-header (header &optional separator)
 "Split HEADER into a list of header elements.
 \",\" 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)
 			     (not quoted))))
 	       (push (buffer-substring beg (point)) elems)
 (make-local-variable 'message-exit-actions)
 (make-local-variable 'message-kill-actions)
 (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)
 (make-local-variable 'font-lock-defaults)
 (setq font-lock-defaults '(message-font-lock-keywords t))
 (make-local-variable 'message-post-method)
 (make-local-variable 'message-sent-message-via)
 (setq message-sent-message-via nil)
 (make-local-variable 'message-checksum)
 (setq message-checksum nil)
-(when (fboundp 'mail-hist-define-keys)
+;;(when (fboundp 'mail-hist-define-keys)
-(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)
 ;; Allow mail alias things.
 (if (fboundp 'mail-abbrevs-setup)
 		((and (eq t signature)
 		      message-signature-file
 		      (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")
 (if (eq signature t)
 	  (insert-file-contents message-signature-file)
 		mail-to))
 	     (name-default (concat "*message* " mail-trimmed-to))
 	     (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.
 Numeric argument means justify as well."
 (interactive "P")
 (defun message-yank-original (&optional arg)
 "Insert the message being replied to, if any.
 Puts point before the text and mark after.
 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")
 (let ((modified (buffer-modified-p)))
 		   (and (or (not (memq 'mail message-sent-message-via))
 			    (y-or-n-p
 			     "Already sent message via mail; resend? "))
 			(message-send-mail arg))))
 (message-do-fcc)
-(when (fboundp 'mail-hist-put-headers-into-history)
+;;(when (fboundp 'mail-hist-put-headers-into-history)
-	(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.
 (unless buffer-file-name
 	(set-buffer-modified-p nil)
 (run-hooks 'message-header-hook))
 (unwind-protect
 	(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)
 	    ;; Remove some headers.
 	    (message-remove-header message-ignored-mail-headers t))
 	(case-fold-search nil)
 	(method (if (message-functionp message-post-method)
 		    (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)
 ;; Insert some headers.
 (message-generate-headers message-required-news-headers)
 (unwind-protect
 	  (save-excursion
 	    (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)
 	      ;; Remove some headers.
 	      (message-remove-header message-ignored-news-headers t))
 		(insert "Followup-To: " to "\n"))
 	      t))
 	;; Check "Shoot me".
 	(or (message-check-element 'shoot)
 	    (save-excursion
-	      (if (search-forward
+	      (if (re-search-forward
-		   ".i-have-a-misconfigured-system-so-shoot-me" nil t)
+		   "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)))
 	;; Check for Approved.
 	(or (message-check-element 'approved)
 	 (goto-char (point-min))
 	 (re-search-forward
 	  (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? ")))))
 ;; Check for control characters.
 (or (message-check-element 'control-chars)
 ;; Check the length of the signature.
 (or
 (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)
 	    (y-or-n-p
 	     (format
 	    (make-directory (file-name-directory file) t))
 	  (if (and message-fcc-handler-function
 		   (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)))))
 (defun message-cleanup-headers ()
 (defun message-do-send-housekeeping ()
 "Kill old message buffers."
 ;; 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
+(while (and message-max-buffers
-	     (>= (length message-buffer-list) 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)
 		 (not (buffer-modified-p buffer)))
 	(kill-buffer buffer))))
 "Start editing a reply to the article in the current buffer."
 (interactive)
 (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
 (goto-char (point-min))
 (if (search-forward "\n\n" nil t)
 	  (let (ccalist)
 	    (save-excursion
 	      (message-set-work-buffer)
 	      (unless never-mct
 		(insert (or reply-to from "")))
-	      (insert
+	      (insert (if (bolp) "" ", ") (or to ""))
-	       (if (bolp) "" ", ") (or to "")
+	      (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
-	       (if mct (concat (if (bolp) "" ", ") mct) "")
+	      (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
-	       (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)))
 	      (goto-char (point-min))
 	      (setq ccalist
 		    (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)))))
 	    (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
 	    (when ccalist
 	      (push (cons 'Cc
 			  (mapconcat (lambda (addr) (cdr addr)) ccalist ", "))
 		    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 ""))
 (message-setup
 (defun message-followup ()
 (interactive)
 (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
 (goto-char (point-min))
 (if (search-forward "\n\n" nil t)
 (goto-char (min start end))
 (while (re-search-forward "\b" end1 t)
 (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)
 (require 'messagexmas))
 	  (pop-to-buffer cur)))))))
 ;;; 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)
 "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.
 The following arguments may contain lists of values."

Mercurial > hg > xemacs-beta

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