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
king@grassland.com (Elvis Parsley)
If `angles', they look like:
Elvis Parsley <king@grassland.com>
-Otherwise, most addresses look like `angles', but they look like `parens'
- if `angles' would need quoting and `parens' would not.")
+
+Otherwise, most addresses look like `angles', but they look like
+`parens' if `angles' would need quoting and `parens' would not.")
;;;###autoload
-(defvar message-syntax-checks
- '(subject-cmsg multiple-headers sendsys message-id from
- long-lines control-chars size new-text
- redirected-followup signature approved sender
- empty empty-headers message-id from subject)
- "In non-nil, message will attempt to run some checks on outgoing posts.
-If this variable is t, message will check everything it can. If it is
-a list, then those elements in that list will be checked.")
+(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 . disabled)' to this list.
+
+Don't touch this variable unless you really know what you're doing.
+
+Checks include subject-cmsg multiple-headers sendsys message-id from
+long-lines control-chars size new-text redirected-followup signature
+approved sender empty empty-headers message-id from subject.")
;;;###autoload
(defvar message-required-news-headers
- '(From Date Newsgroups Subject Message-ID
+ '(From Newsgroups Subject Date Message-ID
(optional . Organization) Lines
(optional . X-Newsreader))
"*Headers to be generated or prompted for when posting an article.
;;;###autoload
(defvar message-required-mail-headers
- '(From Date Subject (optional . In-Reply-To) Message-ID Lines
+ '(From Subject Date (optional . In-Reply-To) Message-ID Lines
(optional . X-Mailer))
"*Headers to be generated or prompted for when mailing a message.
RFC822 required that From, Date, To, Subject and Message-ID be
;;;###autoload
(defvar message-signature-separator "^-- *$"
- "Regexp matching signature separator.")
+ "Regexp matching the signature separator.")
;;;###autoload
(defvar message-interactive nil
"Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors.")
+;;;###autoload
+(defvar message-generate-new-buffers nil
+ "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.")
+
+;;;###autoload
+(defvar message-kill-buffer-on-exit nil
+ "*Non-nil means that the message buffer will be killed after sending a message.")
+
(defvar gnus-local-organization)
;;;###autoload
(defvar message-user-organization
;;;###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
"*Specifies what to do with Followup-To header.
-If nil, ignore the header. If it is t, use its value, but ignore
-\"poster\". If it is the symbol `ask', query the user whether to
-ignore the \"poster\" value. If it is the symbol `use', always use
-the value.")
+If nil, ignore the header. If it is t, use its value, but query before
+using the \"poster\" value. If it is the symbol `ask', query the user
+whether to ignore the \"poster\" value. If it is the symbol `use',
+always use the value.")
(defvar gnus-post-method)
(defvar gnus-select-method)
;;;###autoload
(defvar message-post-method
- (cond ((boundp 'gnus-post-method)
+ (cond ((and (boundp 'gnus-post-method)
+ gnus-post-method)
gnus-post-method)
((boundp 'gnus-select-method)
gnus-select-method)
(defvar message-header-separator "--text follows this line--"
"*Line used to separate headers from text in messages being composed.")
-;;;###autoload
-(defvar message-alias-file nil
- "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
-This file defines aliases to be expanded by the mailer; this is a different
-feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
-This variable has no effect unless your system uses sendmail as its mailer.")
-
-;;;###autoload
-(defvar message-personal-alias-file "~/.mailrc"
- "*If non-nil, the name of the user's personal mail alias file.
-This file typically should be in same format as the `.mailrc' file used by
-the `Mail' or `mailx' program.
-This file need not actually exist.")
-
(defvar message-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook.")
(defvar message-citation-line-function 'message-insert-citation-line
"*Function called to insert the \"Whomever writes:\" line.")
-(defvar message-aliases t
- "Alist of mail address aliases.
-If t, initialized from your mail aliases file.
-\(The file's name is normally `~/.mailrc', but your MAILRC environment
-variable can override that name.)
-The alias definitions in the file have this form:
- alias ALIAS MEANING")
-
-(defvar message-alias-modtime nil
- "The modification time of your mail alias file when it was last examined.")
-
;;;###autoload
(defvar message-yank-prefix "> "
"*Prefix inserted on the lines of yanked messages.
(defvar message-abbrevs-loaded nil)
-(autoload 'expand-mail-aliases "mailalias"
- "Expand all mail aliases in suitable header fields found between BEG and END.
-Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants.
-Optional second arg EXCLUDE may be a regular expression defining text to be
-removed from alias expansions."
- nil)
-
;;;###autoload
(defvar message-signature t
- "*String to be inserted at the and the the message buffer.
+ "*String to be inserted at the end of the message buffer.
If t, the `message-signature-file' file will be inserted instead.
If a function, the result from the function will be used instead.
If a form, the result from the form will be used instead.")
;;;###autoload
(defvar message-signature-file "~/.signature"
- "*File containing the text inserted at end of mail buffer.")
+ "*File containing the text inserted at end of message. buffer.")
(defvar message-distribution-function nil
"*Function called to return a Distribution header.")
(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) "\\)$")
(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)
(X-Newsreader))
"Alist used for formatting headers.")
+(eval-and-compile
+ (autoload 'message-setup-toolbar "message-xmas"))
+
\f
;;;
(or (mail-fetch-field "to")
(mail-fetch-field "cc")
(mail-fetch-field "bcc")))))
+
+(defun message-next-header ()
+ "Go to the beginning of the next header."
+ (beginning-of-line)
+ (or (eobp) (forward-char 1))
+ (not (if (re-search-forward "^[^ \t]" nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))))
+(defun message-sort-headers-1 ()
+ "Sort the buffer as headers using `message-rank' text props."
+ (goto-char (point-min))
+ (sort-subr
+ nil 'message-next-header
+ (lambda ()
+ (message-next-header)
+ (unless (bobp)
+ (forward-char -1)))
+ (lambda ()
+ (or (get-text-property (point) 'message-rank)
+ 0))))
+
+(defun message-sort-headers ()
+ "Sort the headers of the current message according to `message-header-format-alist'."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (let ((max (1+ (length message-header-format-alist)))
+ rank)
+ (message-narrow-to-headers)
+ (while (re-search-forward "^[^ ]+:" nil t)
+ (put-text-property
+ (match-beginning 0) (1+ (match-beginning 0))
+ 'message-rank
+ (if (setq rank (length (memq (assq (intern (buffer-substring
+ (match-beginning 0)
+ (1- (match-end 0))))
+ message-header-format-alist)
+ message-header-format-alist)))
+ (- max rank)
+ (1+ max)))))
+ (message-sort-headers-1))))
+
\f
;;;
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
(define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
- (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-fcc)
+ (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
(define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
(define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
(define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
(define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
(define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
- (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-followup-to)
+ (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
(define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
(define-key message-mode-map "\C-c\C-b" 'message-goto-body)
(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-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-s" 'message-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)
(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 (string-match "XEmacs\\|Lucid" emacs-version)
+ (message-setup-toolbar))
(run-hooks 'text-mode-hook 'message-mode-hook))
\f
(defun message-insert-to ()
"Insert a To header that points to the author of the article being replied to."
(interactive)
- (message-position-on-field "To")
+ (when (message-position-on-field "To")
+ (insert ", "))
(insert (or (message-fetch-reply-field "reply-to")
(message-fetch-reply-field "from") "")))
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
(interactive)
- (message-position-on-field "Newsgroups")
+ (when (message-position-on-field "Newsgroups")
+ (insert ","))
(insert (or (message-fetch-reply-field "newsgroups") "")))
\f
(save-excursion
(goto-char (point-min))
(search-forward (concat "\n" mail-header-separator "\n") nil t)
- (fill-individual-paragraphs (point)
- (point-max)
- justifyp
- t)))
+ (let ((fill-prefix message-yank-prefix))
+ (fill-individual-paragraphs (point) (point-max) justifyp t))))
(defun message-indent-citation ()
"Modify text just inserted from a message to be cited.
;;; Sending messages
;;;
-(defun message-send-and-exit ()
+(defun message-send-and-exit (&optional arg)
"Send message like `message-send', then, if no errors, exit from mail buffer."
- (interactive)
+ (interactive "P")
(let ((buf (current-buffer)))
- (when (message-send)
- (bury-buffer buf)
- (when (eq buf (current-buffer))
- (message-bury buf)))))
+ (when (and (message-send arg)
+ (buffer-name buf))
+ (if message-kill-buffer-on-exit
+ (kill-buffer buf)
+ (bury-buffer buf)
+ (when (eq buf (current-buffer))
+ (message-bury buf))))))
(defun message-dont-send ()
"Don't send the message you have been editing."
"Already sent message via mail; resend? "))
(funcall message-send-mail-function arg))))
(message-do-fcc)
+ (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.
(tembuf (generate-new-buffer " message temp"))
(case-fold-search nil)
(news (message-news-p))
- (resend-to-addresses (mail-fetch-field "resent-to"))
- delimline
+ resend-to-addresses delimline
(mailbuf (current-buffer)))
(save-restriction
(message-narrow-to-headers)
+ (setq resend-to-addresses (mail-fetch-field "resent-to"))
;; Insert some headers.
(message-generate-headers message-required-mail-headers)
;; Let the user do all of the above.
;; Always specify who from,
;; since some systems have broken sendmails.
(list "-f" (user-login-name))
- (and message-alias-file
- (list (concat "-oA" message-alias-file)))
;; These mean "report errors by mail"
;; and "deliver in background".
(if (null message-interactive) '("-oem" "-odb"))
;; We must not do that for a resend
;; because we would find the original addresses.
;; For a resend, include the specific addresses.
- (or resend-to-addresses
- '("-t")))))
+ (if resend-to-addresses
+ (list resend-to-addresses)
+ '("-t")))))
(when message-interactive
(save-excursion
(set-buffer errbuf)
(defun message-check-news-syntax ()
"Check the syntax of the message."
- (or
- (not message-syntax-checks)
- (and
- ;; We narrow to the headers and check them first.
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (and
- ;; Check for commands in Subject.
- (or
- (message-check-element 'subject-cmsg)
- (save-excursion
- (if (string-match "^cmsg " (mail-fetch-field "subject"))
- (y-or-n-p
- "The control code \"cmsg \" is in the subject. Really post? ")
- t)))
- ;; Check for multiple identical headers.
- (or (message-check-element 'multiple-headers)
- (save-excursion
- (let (found)
- (while (and (not found)
- (re-search-forward "^[^ \t:]+: " nil t))
- (save-excursion
- (or (re-search-forward
- (concat "^" (setq found
- (buffer-substring
- (match-beginning 0)
- (- (match-end 0) 2))))
- nil t)
- (setq found nil))))
- (if found
- (y-or-n-p
- (format "Multiple %s headers. Really post? " found))
- t))))
- ;; Check for Version and Sendsys.
- (or (message-check-element 'sendsys)
- (save-excursion
- (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
- (y-or-n-p
- (format "The article contains a %s command. Really post? "
- (buffer-substring (match-beginning 0)
- (1- (match-end 0)))))
- t)))
- ;; See whether we can shorten Followup-To.
- (or (message-check-element 'shorten-followup-to)
- (let ((newsgroups (mail-fetch-field "newsgroups"))
- (followup-to (mail-fetch-field "followup-to"))
- to)
- (when (and newsgroups (string-match "," newsgroups)
- (not followup-to)
- (not
- (zerop
- (length
- (setq to (completing-read
- "Followups to: (default all groups) "
- (mapcar (lambda (g) (list g))
- (cons "poster"
- (message-tokenize-header
- newsgroups)))))))))
- (goto-char (point-min))
- (insert "Followup-To: " to "\n"))))
-
- ;; Check for Approved.
- (or (message-check-element 'approved)
- (save-excursion
- (if (re-search-forward "^Approved:" nil t)
- (y-or-n-p
- "The article contains an Approved header. Really post? ")
- t)))
- ;; Check the Message-Id header.
- (or (message-check-element 'message-id)
- (save-excursion
- (let* ((case-fold-search t)
- (message-id (mail-fetch-field "message-id")))
- (or (not message-id)
- (and (string-match "@" message-id)
- (string-match "@[^\\.]*\\." message-id))
- (y-or-n-p
- (format
- "The Message-ID looks strange: \"%s\". Really post? "
- message-id))))))
- ;; Check the Subject header.
- (or
- (message-check-element 'subject)
- (save-excursion
- (let* ((case-fold-search t)
- (subject (mail-fetch-field "subject")))
- (or
- (and subject
- (not (string-match "\\`[ \t]*\\'" subject)))
- (progn
- (message
- "The subject field is empty or missing. Posting is denied.")
- nil)))))
- ;; Check the From header.
- (or (message-check-element 'from)
- (save-excursion
- (let* ((case-fold-search t)
- (from (mail-fetch-field "from")))
- (cond
- ((not from)
- (message "There is no From line. Posting is denied.")
- nil)
- ((not (string-match "@[^\\.]*\\." from))
- (message
- "Denied posting -- the From looks strange: \"%s\"." from)
- nil)
- ((string-match "@[^@]*@" from)
- (message
- "Denied posting -- two \"@\"'s in the From header: %s."
- from)
- nil)
- ((string-match "(.*).*(.*)" from)
- (message
- "Denied posting -- the From header looks strange: \"%s\"."
- from)
- nil)
- (t t))))))))
- ;; Check for long lines.
- (or (message-check-element 'long-lines)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (while (and
- (progn
- (end-of-line)
- (< (current-column) 80))
- (zerop (forward-line 1))))
- (or (bolp)
- (eobp)
- (y-or-n-p
- "You have lines longer than 79 characters. Really post? "))))
- ;; Check whether the article is empty.
- (or (message-check-element 'empty)
- (save-excursion
- (goto-char (point-min))
- (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?"))))
- ;; Check for control characters.
- (or (message-check-element 'control-chars)
- (save-excursion
- (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
- (y-or-n-p
- "The article contains control characters. Really post? ")
- t)))
- ;; Check excessive size.
- (or (message-check-element 'size)
- (if (> (buffer-size) 60000)
- (y-or-n-p
- (format "The article is %d octets long. Really post? "
- (buffer-size)))
- t))
- ;; Check whether any new text has been added.
- (or (message-check-element 'new-text)
- (not message-checksum)
- (not (eq (message-checksum) message-checksum))
- (y-or-n-p
- "It looks like no new text has been added. Really post? "))
- ;; Check the length of the signature.
- (or (message-check-element 'signature)
- (progn
- (goto-char (point-max))
- (if (not (re-search-backward "^-- $" nil t))
- t
- (if (> (count-lines (point) (point-max)) 5)
- (y-or-n-p
- (format
- "Your .sig is %d lines; it should be max 4. Really post? "
- (count-lines (point) (point-max))))
- t)))))))
-
-;; Returns non-nil if this type is not to be checked.
+ (and
+ ;; We narrow to the headers and check them first.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (and
+ ;; Check for commands in Subject.
+ (or
+ (message-check-element 'subject-cmsg)
+ (save-excursion
+ (if (string-match "^cmsg " (mail-fetch-field "subject"))
+ (y-or-n-p
+ "The control code \"cmsg \" is in the subject. Really post? ")
+ t)))
+ ;; Check for multiple identical headers.
+ (or (message-check-element 'multiple-headers)
+ (save-excursion
+ (let (found)
+ (while (and (not found)
+ (re-search-forward "^[^ \t:]+: " nil t))
+ (save-excursion
+ (or (re-search-forward
+ (concat "^" (setq found
+ (buffer-substring
+ (match-beginning 0)
+ (- (match-end 0) 2))))
+ nil t)
+ (setq found nil))))
+ (if found
+ (y-or-n-p
+ (format "Multiple %s headers. Really post? " found))
+ t))))
+ ;; Check for Version and Sendsys.
+ (or (message-check-element 'sendsys)
+ (save-excursion
+ (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
+ (y-or-n-p
+ (format "The article contains a %s command. Really post? "
+ (buffer-substring (match-beginning 0)
+ (1- (match-end 0)))))
+ t)))
+ ;; See whether we can shorten Followup-To.
+ (or (message-check-element 'shorten-followup-to)
+ (let ((newsgroups (mail-fetch-field "newsgroups"))
+ (followup-to (mail-fetch-field "followup-to"))
+ to)
+ (when (and newsgroups (string-match "," newsgroups)
+ (not followup-to)
+ (not
+ (zerop
+ (length
+ (setq to (completing-read
+ "Followups to: (default all groups) "
+ (mapcar (lambda (g) (list g))
+ (cons "poster"
+ (message-tokenize-header
+ newsgroups)))))))))
+ (goto-char (point-min))
+ (insert "Followup-To: " to "\n"))
+ t))
+
+ ;; Check for Approved.
+ (or (message-check-element 'approved)
+ (save-excursion
+ (if (re-search-forward "^Approved:" nil t)
+ (y-or-n-p
+ "The article contains an Approved header. Really post? ")
+ t)))
+ ;; Check the Message-Id header.
+ (or (message-check-element 'message-id)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (message-id (mail-fetch-field "message-id")))
+ (or (not message-id)
+ (and (string-match "@" message-id)
+ (string-match "@[^\\.]*\\." message-id))
+ (y-or-n-p
+ (format
+ "The Message-ID looks strange: \"%s\". Really post? "
+ message-id))))))
+ ;; Check the Subject header.
+ (or
+ (message-check-element 'subject)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (subject (mail-fetch-field "subject")))
+ (or
+ (and subject
+ (not (string-match "\\`[ \t]*\\'" subject)))
+ (progn
+ (message
+ "The subject field is empty or missing. Posting is denied.")
+ nil)))))
+ ;; Check the From header.
+ (or (message-check-element 'from)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (from (mail-fetch-field "from")))
+ (cond
+ ((not from)
+ (message "There is no From line. Posting is denied.")
+ nil)
+ ((not (string-match "@[^\\.]*\\." from))
+ (message
+ "Denied posting -- the From looks strange: \"%s\"." from)
+ nil)
+ ((string-match "@[^@]*@" from)
+ (message
+ "Denied posting -- two \"@\"'s in the From header: %s."
+ from)
+ nil)
+ ((string-match "(.*).*(.*)" from)
+ (message
+ "Denied posting -- the From header looks strange: \"%s\"."
+ from)
+ nil)
+ (t t))))))))
+ ;; Check for long lines.
+ (or (message-check-element 'long-lines)
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (while (and
+ (progn
+ (end-of-line)
+ (< (current-column) 80))
+ (zerop (forward-line 1))))
+ (or (bolp)
+ (eobp)
+ (y-or-n-p
+ "You have lines longer than 79 characters. Really post? "))))
+ ;; Check whether the article is empty.
+ (or (message-check-element 'empty)
+ (save-excursion
+ (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)))
+ (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
+ (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
+ (y-or-n-p
+ "The article contains control characters. Really post? ")
+ t)))
+ ;; Check excessive size.
+ (or (message-check-element 'size)
+ (if (> (buffer-size) 60000)
+ (y-or-n-p
+ (format "The article is %d octets long. Really post? "
+ (buffer-size)))
+ t))
+ ;; Check whether any new text has been added.
+ (or (message-check-element 'new-text)
+ (not message-checksum)
+ (not (eq (message-checksum) message-checksum))
+ (y-or-n-p
+ "It looks like no new text has been added. Really post? "))
+ ;; Check the length of the signature.
+ (or (message-check-element 'signature)
+ (progn
+ (goto-char (point-max))
+ (if (not (re-search-backward "^-- $" nil t))
+ t
+ (if (> (count-lines (point) (point-max)) 5)
+ (y-or-n-p
+ (format
+ "Your .sig is %d lines; it should be max 4. Really post? "
+ (count-lines (point) (point-max))))
+ t))))))
+
(defun message-check-element (type)
- (not
- (or (not message-syntax-checks)
- (if (listp message-syntax-checks)
- (memq type message-syntax-checks)
- t))))
+ "Returns non-nil if this type is not to be checked."
+ (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)))
(defun message-do-fcc ()
"Process Fcc headers in the current buffer."
(let ((case-fold-search t)
+ (buf (current-buffer))
list file)
(save-excursion
+ (set-buffer (get-buffer-create " *message temp*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-buffer-substring buf)
(save-restriction
(message-narrow-to-headers)
(while (setq file (mail-fetch-field "fcc"))
(push file list)
- (message-remove-header "fcc" nil t))
- ;; Process FCC operations.
- (widen)
- (while list
- (setq file (pop list))
- (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
- ;; Pipe the article to the program in question.
- (call-process-region (point-min) (point-max) shell-file-name
- nil nil nil "-c" (match-string 1 file))
- ;; Save the article.
- (setq file (expand-file-name file))
- (unless (file-exists-p (file-name-directory file))
- (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)
- (let ((mail-use-rfc822 t))
- (rmail-output file 1 t t))))))))))
+ (message-remove-header "fcc" nil t)))
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+ (replace-match "" t t)
+ ;; Process FCC operations.
+ (while list
+ (setq file (pop list))
+ (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
+ ;; Pipe the article to the program in question.
+ (call-process-region (point-min) (point-max) shell-file-name
+ nil nil nil "-c" (match-string 1 file))
+ ;; Save the article.
+ (setq file (expand-file-name file))
+ (unless (file-exists-p (file-name-directory file))
+ (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)
+ (let ((mail-use-rfc822 t))
+ (rmail-output file 1 t t))))))
+ (kill-buffer (current-buffer)))))
(defun message-cleanup-headers ()
"Do various automatic cleanups of the headers."
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)))
(goto-char (point-min))
- (when (re-search-forward "[ \t\n]*" nil t)
+ (while (re-search-forward "[\t\n]+" nil t)
(replace-match "" t t))
(unless (zerop (buffer-size))
(buffer-string)))))
(defun message-make-address ()
"Make the address of the user."
- (or user-mail-address
+ (or (message-user-mail-address)
(concat (user-login-name) "@" (message-make-domain))))
+(defun message-user-mail-address ()
+ "Return the pertinent part of `user-mail-address'."
+ (when user-mail-address
+ (nth 1 (mail-extract-address-components user-mail-address))))
+
(defun message-make-fqdm ()
"Return user's fully qualified domain name."
(let ((system-name (system-name)))
;; `system-name' returned the right result.
system-name)
;; We try `user-mail-address' as a backup.
- ((string-match "@\\(\\W+\\)\\(\\'\\|\\W\\)" user-mail-address)
+ ((string-match "@\\(.*\\)\\'" (message-user-mail-address))
(match-string 1 user-mail-address))
+ ;; Try `mail-host-address'.
+ ((and (boundp 'mail-host-address)
+ mail-host-address)
+ mail-host-address)
+ ;; Default to this bogus thing.
(t
(concat system-name ".i-have-a-misconfigured-system-so-shoot-me")))))
(Distribution (message-make-distribution))
(Lines (message-make-lines))
(X-Newsreader message-newsreader)
- (X-Mailer message-mailer)
+ (X-Mailer (and (not (mail-fetch-field "X-Newsreader"))
+ message-mailer))
(Expires (message-make-expires))
(case-fold-search t)
header value elem)
(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)
(fill-region-as-paragraph begin (point))
;; Tapdance around looong Message-IDs.
(forward-line -1)
- (when (eolp)
+ (when (looking-at "[ \t]*$")
(message-delete-line))
(goto-char begin)
(re-search-forward ":" nil t)
(replace-match " " t t))
(goto-char (point-max)))))
-(defun sendmail-synch-aliases ()
- (let ((modtime (nth 5 (file-attributes message-personal-alias-file))))
- (or (equal message-alias-modtime modtime)
- (setq message-alias-modtime modtime
- message-aliases t))))
-
(defun message-position-point ()
"Move point to where the user probably wants to find it."
(message-narrow-to-headers)
(defun message-pop-to-buffer (name)
"Pop to buffer NAME, and warn if it already exists and is modified."
- (let ((buffer (get-buffer name)))
- (if (and buffer
- (buffer-name buffer))
- (progn
- (set-buffer (pop-to-buffer buffer))
- (when (and (buffer-modified-p)
- (not (y-or-n-p
- "Message already being composed; erase? ")))
- (error "Message being composed")))
- (set-buffer (pop-to-buffer name)))
- (erase-buffer)
- (message-mode)))
+ (if message-generate-new-buffers
+ (set-buffer (pop-to-buffer (generate-new-buffer name)))
+ (let ((buffer (get-buffer name)))
+ (if (and buffer
+ (buffer-name buffer))
+ (progn
+ (set-buffer (pop-to-buffer buffer))
+ (when (and (buffer-modified-p)
+ (not (y-or-n-p
+ "Message already being composed; erase? ")))
+ (error "Message being composed")))
+ (set-buffer (pop-to-buffer name)))))
+ (erase-buffer)
+ (message-mode))
(defun message-setup (headers &optional replybuffer actions)
(setq message-send-actions actions)
(insert message-default-headers))
(insert mail-header-separator "\n")
(forward-line -1)
- (when (and (message-news-p)
- message-default-news-headers)
+ (when (message-news-p)
+ (when message-default-news-headers
+ (insert message-default-news-headers))
(when message-generate-headers-first
- (message-generate-headers message-required-news-headers))
- (insert message-default-news-headers))
- (when (and (message-mail-p)
- message-default-mail-headers)
+ (message-generate-headers
+ (delq 'Lines
+ (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 message-required-mail-headers))
- (insert message-default-mail-headers))
+ (message-generate-headers
+ (delq 'Lines
+ (delq 'Subject
+ (copy-sequence message-required-mail-headers))))))
(message-insert-signature)
(message-set-auto-save-file-name)
(save-restriction
(message-narrow-to-headers)
(run-hooks 'message-header-setup-hook))
+ ;; Allow mail alias things.
+ (if (fboundp 'mail-abbrevs-setup)
+ (mail-abbrevs-setup)
+ (funcall (intern "mail-aliases-setup")))
(set-buffer-modified-p nil)
(run-hooks 'message-setup-hook)
(message-position-point)
(Subject . ,(or subject "")))))
;;;###autoload
-(defun message-reply (&optional to-address wide)
+(defun message-reply (&optional to-address wide ignore-reply-to)
"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
;; 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")
mct (mail-fetch-field "mail-copies-to")
- reply-to (mail-fetch-field "reply-to")
+ reply-to (unless ignore-reply-to (mail-fetch-field "reply-to"))
references (mail-fetch-field "references")
message-id (mail-fetch-field "message-id"))
;; Remove any (buggy) Re:'s that are present and make a
(message-setup
`((Subject . ,subject)
,@follow-to
- (References . ,(concat (or references "") (and references " ")
- (or message-id ""))))
+ ,@(if (or references message-id)
+ `((References . ,(concat (or references "") (and references " ")
+ (or message-id ""))))
+ nil))
cur)))
;;;###autoload
(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
(t
(if (or (equal followup-to newsgroups)
(not (eq message-use-followup-to 'ask))
- (y-or-n-p (format "Use Followup-To %s? " followup-to)))
+ (y-or-n-p
+ (format "Use Followup-To %s? " followup-to)))
(cons 'Newsgroups followup-to)
(cons 'Newsgroups newsgroups))))))
(t
(list (cons 'Cc (if (equal (downcase mct) "always")
(or reply-to from "")
mct)))))
- cur)))
+
+ cur)
+
+ (setq message-reply-headers
+ (vector 0 subject from date message-id references 0 0 ""))))
+
;;;###autoload
(defun message-cancel-news ()
mail-header-separator "\n"
"This is a cancel message from " from ".\n")
(message "Canceling your article...")
- (funcall message-send-news-function)
+ (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
+ (funcall message-send-news-function))
(message "Canceling your article...done")
(kill-buffer buf))))
(let ((cur (current-buffer))
beg)
;; We first set up a normal mail buffer.
- (message-set-work-buffer)
+ (set-buffer (get-buffer-create " *message resend*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
(message-setup `((To . ,address)))
;; Insert our usual headers.
- (message-narrow-to-headers)
(message-generate-headers '(From Date To))
- (goto-char (point-min))
+ (message-narrow-to-headers)
;; Rename them all to "Resent-*".
(while (re-search-forward "^[A-Za-z]" nil t)
(forward-char -1)
(beginning-of-line)
(insert "Also-"))
;; Send it.
- (funcall message-send-mail-function))))
+ (funcall message-send-mail-function)
+ (kill-buffer (current-buffer)))))
;;;###autoload
(defun message-bounce ()
This only makes sense if the current message is a bounce message than
contains some mail you have written which has been bounced back to
you."
- (interactive "P")
- (let ((cur (current-buffer)))
+ (interactive)
+ (let ((cur (current-buffer))
+ boundary)
(message-pop-to-buffer "*mail message*")
(insert-buffer-substring cur)
+ (undo-boundary)
+ (message-narrow-to-head)
+ (if (and (mail-fetch-field "Mime-Version")
+ (setq boundary (mail-fetch-field "Content-Type")))
+ (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary)
+ (setq boundary (concat (match-string 1 boundary) " *\n"
+ "Content-Type: message/rfc822"))
+ (setq boundary nil)))
+ (widen)
(goto-char (point-min))
- (or (and (re-search-forward mail-unsent-separator nil t)
+ (search-forward "\n\n" nil t)
+ (or (and boundary
+ (re-search-forward boundary nil t)
+ (forward-line 2))
+ (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)))
(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
projects / gnus / blobdiff