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

comparison lisp/gnus/message.el @ 136:b980b6286996 r20-2b2

Import from CVS: tag r20-2b2

author	cvs
date	Mon, 13 Aug 2007 09:31:12 +0200
parents	9b50b4588a93
children	585fb297b004

comparison

equal deleted inserted replaced

-:4636a6841cd6
+:b980b6286996
 'message-kill-buffer 'message-send-hook))
 (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
 "If non-nil, delete the deletable headers before feeding to mh.")
+(defvar message-send-method-alist
+'((news message-news-p message-send-via-news)
+(mail message-mail-p message-send-via-mail))
+"Alist of ways to send outgoing messages.
+Each element has the form
+\(TYPE PREDICATE FUNCTION)
+where TYPE is a symbol that names the method; PREDICATE is a function
+called without any parameters to determine whether the message is
+a message of type TYPE; and FUNCTION is a function to be called if
+PREDICATE returns non-nil.  FUNCTION is called with one parameter --
+the prefix.")
+(defvar message-mail-alias-type 'abbrev
+"*What alias expansion type to use in Message buffers.
+The default is `abbrev', which uses mailabbrev.  nil switches
+mail aliases off.")
 ;;; Internal variables.
 ;;; Well, not really internal.
 (defvar message-mode-syntax-table
 (let ((table (copy-syntax-table text-mode-syntax-table)))
 (defvar message-font-lock-keywords
 (let* ((cite-prefix "A-Za-z")
 	 (cite-suffix (concat cite-prefix "0-9_.@-"))
 	 (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
-`((,(concat "^\\(To:\\)" content)
+`((,(concat "^\\([Tt]o:\\)" content)
 (1 'message-header-name-face)
 (2 'message-header-to-face nil t))
-(,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^Reply-To:\\)" content)
+(,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
 (1 'message-header-name-face)
 (2 'message-header-cc-face nil t))
-(,(concat "^\\(Subject:\\)" content)
+(,(concat "^\\([Ss]ubject:\\)" content)
 (1 'message-header-name-face)
 (2 'message-header-subject-face nil t))
-(,(concat "^\\(Newsgroups:\\|Followup-to:\\)" content)
+(,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
 (1 'message-header-name-face)
 (2 'message-header-newsgroups-face nil t))
 (,(concat "^\\([^: \n\t]+:\\)" content)
 (1 'message-header-name-face)
 (2 'message-header-other-face nil t))
 (when (string-match "XEmacs\\|Lucid" emacs-version)
 (message-setup-toolbar))
 (easy-menu-add message-mode-menu message-mode-map)
 (easy-menu-add message-mode-field-menu message-mode-map)
 ;; Allow mail alias things.
-(if (fboundp 'mail-abbrevs-setup)
+(when (eq message-mail-alias-type 'abbrev)
-(mail-abbrevs-setup)
+(if (fboundp 'mail-abbrevs-setup)
-(funcall (intern "mail-aliases-setup")))
+	(mail-abbrevs-setup)
+(funcall (intern "mail-aliases-setup"))))
 (run-hooks 'text-mode-hook 'message-mode-hook))
 ;;;
 (forward-line 1)
 (goto-char (point-max))))
-(defun message-insert-to ()
+(defun message-insert-to (&optional force)
-"Insert a To header that points to the author of the article being replied to."
+"Insert a To header that points to the author of the article being replied to.
-(interactive)
+If the original author requested not to be sent mail, the function signals
+an error.
+With the prefix argument FORCE, insert the header anyway."
+(interactive "P")
 (let ((co (message-fetch-reply-field "mail-copies-to")))
-(when (and co
+(when (and (null force)
+	       co
 	       (equal (downcase co) "never"))
 (error "The user has requested not to have copies sent via mail")))
 (when (and (message-position-on-field "To")
 	     (mail-fetch-field "to")
 	     (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
 (let ((inhibit-read-only t))
 (put-text-property (point-min) (point-max) 'read-only nil))
 (message-fix-before-sending)
 (run-hooks 'message-send-hook)
 (message "Sending...")
-(when (and (or (not (message-news-p))
+(let ((alist message-send-method-alist)
-		   (and (or (not (memq 'news message-sent-message-via))
+	  elem sent)
-			    (y-or-n-p
+(while (setq elem (pop alist))
-			     "Already sent message via news; resend? "))
+	(when (and (or (not (funcall (cadr elem)))
-			(funcall message-send-news-function arg)))
+		       (and (or (not (memq (car elem)
-	       (or (not (message-mail-p))
+					   message-sent-message-via))
-		   (and (or (not (memq 'mail message-sent-message-via))
+				(y-or-n-p
-			    (y-or-n-p
+				 (format
-			     "Already sent message via mail; resend? "))
+				  "Already sent message via %s; resend? "
-			(message-send-mail arg))))
+				  (car elem))))
-(message-do-fcc)
+			    (funcall (caddr elem) arg))))
-;;(when (fboundp 'mail-hist-put-headers-into-history)
+	  (setq sent t)))
-;; (mail-hist-put-headers-into-history))
+(when sent
-(run-hooks 'message-sent-hook)
+	(message-do-fcc)
-(message "Sending...done")
+	;;(when (fboundp 'mail-hist-put-headers-into-history)
-;; If buffer has no file, mark it as unmodified and delete autosave.
+	;; (mail-hist-put-headers-into-history))
-(unless buffer-file-name
+	(run-hooks 'message-sent-hook)
-	(set-buffer-modified-p nil)
+	(message "Sending...done")
-	(delete-auto-save-file-if-necessary t))
+	;; If buffer has no file, mark it as unmodified and delete autosave.
-;; Delete other mail buffers and stuff.
+	(unless buffer-file-name
-(message-do-send-housekeeping)
+	  (set-buffer-modified-p nil)
-(message-do-actions message-send-actions)
+	  (delete-auto-save-file-if-necessary t))
-;; Return success.
+	;; Delete other mail buffers and stuff.
-t)))
+	(message-do-send-housekeeping)
+	(message-do-actions message-send-actions)
+	;; Return success.
+	t))))
+(defun message-send-via-mail (arg)
+"Send the current message via mail."
+(message-send-mail arg))
+(defun message-send-via-news (arg)
+"Send the current message via news."
+(funcall message-send-news-function arg))
 (defun message-fix-before-sending ()
 "Do various things to make the message nice before sending it."
 ;; Make sure there's a newline at the end of the message.
 (goto-char (point-max))
 (message-set-auto-save-file-name)
 (save-restriction
 (message-narrow-to-headers)
 (run-hooks 'message-header-setup-hook))
 (set-buffer-modified-p nil)
+(setq buffer-undo-list nil)
 (run-hooks 'message-setup-hook)
 (message-position-point)
 (undo-boundary))
 (defun message-set-auto-save-file-name ()
 		    (concat "Distribution: " distribution "\n")
 		  "")
 		mail-header-separator "\n"
 		message-cancel-message)
 	(message "Canceling your article...")
-	(let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
+	(if (let ((message-syntax-checks
-	  (funcall message-send-news-function))
+		   'dont-check-for-anything-just-trust-me))
-	(message "Canceling your article...done")
+	      (funcall message-send-news-function))
+	    (message "Canceling your article...done"))
 	(kill-buffer buf)))))
 ;;;###autoload
 (defun message-supersede ()
 "Start composing a message to supersede the current message.

Mercurial > hg > xemacs-beta

comparison lisp/gnus/message.el @ 136:b980b6286996 r20-2b2