-;;; message.el --- composing mail and news messages -*- coding: iso-latin-1 -*-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;;; message.el --- composing mail and news messages
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;;; Code:
(eval-when-compile
- (require 'canlock)
(require 'cl)
(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+(require 'canlock)
(require 'mailheader)
(require 'nnheader)
;; This is apparently necessary even though things are autoloaded:
(require 'mail-parse)
(require 'mml)
(require 'rfc822)
+(eval-and-compile
+ (autoload 'sha1 "sha1-el"))
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
(function :tag "Other"))
:group 'message-sending)
+(defcustom message-fcc-externalize-attachments nil
+ "If non-nil, attachments are included as external parts in Fcc copies."
+ :type 'boolean
+ :group 'message-sending)
+
(defcustom message-courtesy-message
"The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
"*This is inserted at the start of a mailed copy of a posted message.
:type 'sexp)
(defcustom message-ignored-news-headers
- "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:"
+ "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
"*Regexp of headers to be removed unconditionally before posting."
:group 'message-news
:group 'message-headers
:type 'regexp)
(defcustom message-ignored-mail-headers
- "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:"
+ "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
"*Regexp of headers to be removed unconditionally before mailing."
:group 'message-mail
:group 'message-headers
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
:group 'message-interface
:type '(repeat sexp))
+(defcustom message-subscribed-address-file nil
+ "*A file containing addresses the user is subscribed to.
+If nil, do not look at any files to determine list subscriptions. If
+non-nil, each line of this file should be a mailing list address."
+ :group 'message-interface
+ :type 'string)
+
(defcustom message-subscribed-addresses nil
"*Specifies a list of addresses the user is subscribed to.
If nil, do not use any predefined list subscriptions. This list of
:group 'message-interface
:type '(repeat regexp))
+(defcustom message-allow-no-recipients 'ask
+ "Specifies what to do when there are no recipients other than Gcc/Fcc.
+If it is the symbol `always', the posting is allowed. If it is the
+symbol `never', the posting is not allowed. If it is the symbol
+`ask', you are prompted."
+ :group 'message-interface
+ :type '(choice (const always)
+ (const never)
+ (const ask)))
+
(defcustom message-sendmail-f-is-evil nil
"*Non-nil means don't add \"-f username\" to the sendmail command line.
Doing so would be even more evil than leaving it out."
nil)
(,(concat "^\\(" message-cite-prefix-regexp "\\).*")
(0 'message-cited-text-face))
- ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"
+ ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\).*>"
(0 'message-mml-face))))
"Additional expressions to highlight in Message mode.")
(define-key message-mode-map "\C-c?" 'describe-mode)
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
+ (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from)
(define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
(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-m" 'message-goto-mail-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-f\C-i" 'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\C-b" 'message-goto-body)
(define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
+ (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
+ (define-key message-mode-map "\C-c\M-n" 'message-insert-disposition-notification-to)
+
(define-key message-mode-map "\C-c\C-y" 'message-yank-original)
(define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
-
+
+ (define-key message-mode-map "\C-a" 'message-beginning-of-line)
(define-key message-mode-map "\t" 'message-tab)
(define-key message-mode-map "\M-;" 'comment-region))
["Kill To Signature" message-kill-to-signature t]
["Newline and Reformat" message-newline-and-reformat t]
["Rename buffer" message-rename-buffer t]
+ ["Flag As Important" message-insert-importance-high
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark this message as important"))]
+ ["Flag As Unimportant" message-insert-importance-low
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Mark this message as unimportant"))]
+ ["Request Receipt"
+ message-insert-disposition-notification-to
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Request a Disposition Notification of this article"))]
["Spellcheck" ispell-message
,@(if (featurep 'xemacs) '(t)
'(:help "Spellcheck this message"))]
["Fetch Newsgroups" message-insert-newsgroups t]
"----"
["To" message-goto-to t]
+ ["From" message-goto-from t]
["Subject" message-goto-subject t]
["Cc" message-goto-cc t]
["Reply-To" message-goto-reply-to t]
(defvar facemenu-add-face-function)
(defvar facemenu-remove-face-function))
+;;; Forbidden properties
+;;
+;; We use `after-change-functions' to keep special text properties
+;; that interfer with the normal function of message mode out of the
+;; buffer.
+
+(defcustom message-strip-special-text-properties t
+ "Strip special properties from the message buffer.
+
+Emacs has a number of special text properties which can break message
+composing in various ways. If this option is set, message will strip
+these properties from the message composition buffer. However, some
+packages requires these properties to be present in order to work.
+If you use one of these packages, turn this option off, and hope the
+message composition doesn't break too bad."
+ :group 'message-various
+ :type 'boolean)
+
+(defconst message-forbidden-properties
+ ;; No reason this should be clutter up customize. We make it a
+ ;; property list (rather than a list of property symbols), to be
+ ;; directly useful for `remove-text-properties'.
+ '(field nil read-only nil intangible nil invisible nil
+ mouse-face nil modification-hooks nil insert-in-front-hooks nil
+ insert-behind-hooks nil point-entered nil point-left nil)
+ ;; Other special properties:
+ ;; category, face, display: probably doesn't do any harm.
+ ;; fontified: is used by font-lock.
+ ;; syntax-table, local-map: I dunno.
+ ;; We need to add XEmacs names to the list.
+ "Property list of with properties.forbidden in message buffers.
+The values of the properties are ignored, only the property names are used.")
+
+(defun message-tamago-not-in-use-p (pos)
+ "Return t when tamago version 4 is not in use at the cursor position.
+Tamago version 4 is a popular input method for writing Japanese text.
+It uses the properties `intangible', `invisible', `modification-hooks'
+and `read-only' when translating ascii or kana text to kanji text.
+These properties are essential to work, so we should never strip them."
+ (not (and (boundp 'egg-modefull-mode)
+ (symbol-value 'egg-modefull-mode)
+ (or (memq (get-text-property pos 'intangible)
+ '(its-part-1 its-part-2))
+ (get-text-property pos 'egg-end)
+ (get-text-property pos 'egg-lang)
+ (get-text-property pos 'egg-start)))))
+
+(defun message-strip-forbidden-properties (begin end &optional old-length)
+ "Strip forbidden properties between BEGIN and END, ignoring the third arg.
+This function is intended to be called from `after-change-functions'.
+See also `message-forbidden-properties'."
+ (when (and message-strip-special-text-properties
+ (message-tamago-not-in-use-p begin))
+ (remove-text-properties begin end message-forbidden-properties)))
+
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
"Major mode for editing mail and news to be sent.
C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution
C-c C-f C-f move to Followup-To
C-c C-f C-m move to Mail-Followup-To
+ C-c C-f C-i cycle through Importance values
C-c C-t `message-insert-to' (add a To header to a news followup)
C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply)
C-c C-b `message-goto-body' (move to beginning of message text).
C-c C-z `message-kill-to-signature' (kill the text up to the signature).
C-c C-r `message-caesar-buffer-body' (rot13 the message body).
C-c C-a `mml-attach-file' (attach a file as MIME).
+C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance).
+C-c M-n `message-insert-disposition-notification-to' (request receipt).
M-RET `message-newline-and-reformat' (break the line and reformat)."
(set (make-local-variable 'message-reply-buffer) nil)
(make-local-variable 'message-send-actions)
(set (make-local-variable 'tool-bar-map) (message-tool-bar-map))))
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
+ ;; make-local-hook is harmless though obsolete in Emacs 21.
+ ;; Emacs 20 and XEmacs need make-local-hook.
+ (make-local-hook 'after-change-functions)
+ ;; Mmmm... Forbidden properties...
+ (add-hook 'after-change-functions 'message-strip-forbidden-properties
+ nil 'local)
;; Allow mail alias things.
(when (eq message-mail-alias-type 'abbrev)
(if (fboundp 'mail-abbrevs-setup)
(interactive)
(message-position-on-field "To"))
+(defun message-goto-from ()
+ "Move point to the From header."
+ (interactive)
+ (message-position-on-field "From"))
+
(defun message-goto-subject ()
"Move point to the Subject header."
(interactive)
(if not-break
(setq point nil)
(if bolp
- (insert "\n")
- (insert "\n\n"))
+ (newline)
+ (newline)
+ (newline))
(setq point (point))
- (insert "\n\n")
+ ;; (newline 2) doesn't mark both newline's as hard, so call
+ ;; newline twice. -jas
+ (newline)
+ (newline)
(delete-region (point) (re-search-forward "[ \t]*"))
(when (and quoted (not bolp))
(insert quoted leading-space)))
(message-newline-and-reformat arg t)
t))
+;; Is it better to use `mail-header-end'?
+(defun message-point-in-header-p ()
+ "Return t if point is in the header."
+ (save-excursion
+ (let ((p (point)))
+ (goto-char (point-min))
+ (not (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n")
+ p t)))))
+
(defun message-do-auto-fill ()
"Like `do-auto-fill', but don't fill in message header."
- (when (> (point) (save-excursion
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator)
- "\n") nil t)
- (match-beginning 0)
- (point-max))))
+ (unless (message-point-in-header-p)
(do-auto-fill)))
(defun message-insert-signature (&optional force)
(goto-char (point-max))
(or (bolp) (insert "\n")))))
+(defun message-insert-importance-high ()
+ "Insert header to mark message as important."
+ (interactive)
+ (save-excursion
+ (message-remove-header "Importance")
+ (message-goto-eoh)
+ (insert "Importance: high\n")))
+
+(defun message-insert-importance-low ()
+ "Insert header to mark message as unimportant."
+ (interactive)
+ (save-excursion
+ (message-remove-header "Importance")
+ (message-goto-eoh)
+ (insert "Importance: low\n")))
+
+(defun message-insert-or-toggle-importance ()
+ "Insert a \"Importance: high\" header, or cycle through the header values.
+The three allowed values according to RFC 1327 are `high', `normal'
+and `low'."
+ (interactive)
+ (save-excursion
+ (let ((valid '("high" "normal" "low"))
+ (new "high")
+ cur)
+ (when (setq cur (message-fetch-field "Importance"))
+ (message-remove-header "Importance")
+ (setq new (cond ((string= cur "high")
+ "low")
+ ((string= cur "low")
+ "normal")
+ (t
+ "high"))))
+ (message-goto-eoh)
+ (insert (format "Importance: %s\n" new)))))
+
+(defun message-insert-disposition-notification-to ()
+ "Request a disposition notification (return receipt) to this message.
+Note that this should not be used in newsgroups."
+ (interactive)
+ (save-excursion
+ (message-remove-header "Disposition-Notification-To")
+ (message-goto-eoh)
+ (insert (format "Disposition-Notification-To: %s\n"
+ (or (message-fetch-field "From") (message-make-from))))))
+
(defun message-elide-region (b e)
"Elide the text in the region.
An ellipsis (from `message-elide-ellipsis') will be inserted where the
t)))
(defun message-dont-send ()
- "Don't send the message you have been editing."
+ "Don't send the message you have been editing.
+Instead, just auto-save the buffer and then bury it."
(interactive)
(set-buffer-modified-p t)
(save-buffer)
(interactive)
(when (or (not (buffer-modified-p))
(yes-or-no-p "Message modified; kill anyway? "))
- (let ((actions message-kill-actions))
+ (let ((actions message-kill-actions)
+ (draft-article message-draft-article)
+ (auto-save-file-name buffer-auto-save-file-name)
+ (file-name buffer-file-name)
+ (modified (buffer-modified-p)))
(setq buffer-file-name nil)
(kill-buffer (current-buffer))
+ (when (and (or (and auto-save-file-name
+ (file-exists-p auto-save-file-name))
+ (and file-name
+ (file-exists-p file-name)))
+ (yes-or-no-p (format "Remove the backup file%s? "
+ (if modified " too" ""))))
+ (ignore-errors
+ (delete-file auto-save-file-name))
+ (let ((message-draft-article draft-article))
+ (message-disassociate-draft)))
(message-do-actions actions))))
(defun message-bury (buffer)
(message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
- elem sent
+ elem sent dont-barf-on-no-method
(message-options message-options))
(message-options-set-recipient)
(while (and success
(error "Denied posting -- multiple copies")))
(setq success (funcall (caddr elem) arg)))
(setq sent t))))
- (unless (or sent (not success))
+ (unless (or sent
+ (not success)
+ (let ((fcc (message-fetch-field "Fcc"))
+ (gcc (message-fetch-field "Gcc")))
+ (when (or fcc gcc)
+ (or (eq message-allow-no-recipients 'always)
+ (and (not (eq message-allow-no-recipients 'never))
+ (setq dont-barf-on-no-method
+ (gnus-y-or-n-p
+ (format "No receiver, perform %s anyway? "
+ (cond ((and fcc gcc) "Fcc and Gcc")
+ (fcc "Fcc")
+ (t "Gcc"))))))))))
(error "No methods specified to send by"))
- (when (and success sent)
+ (when (or dont-barf-on-no-method
+ (and success sent))
(message-do-fcc)
(save-excursion
(run-hooks 'message-sent-hook))
(put 'message-check 'lisp-indent-function 1)
(put 'message-check 'edebug-form-spec '(form body))
+(defun message-text-with-property (prop)
+ "Return a list of all points where the text has PROP."
+ (let ((points nil)
+ (point (point-min)))
+ (save-excursion
+ (while (< point (point-max))
+ (when (get-text-property point prop)
+ (push point points))
+ (incf point)))
+ (nreverse points)))
+
(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.
(insert "\n"))
;; Delete all invisible text.
(message-check 'invisible-text
- (when (text-property-any (point-min) (point-max) 'invisible t)
- (put-text-property (point-min) (point-max) 'invisible nil)
- (unless (yes-or-no-p
- "Invisible text found and made visible; continue posting? ")
- (error "Invisible text found and made visible")))))
+ (let ((points (message-text-with-property 'invisible)))
+ (when points
+ (goto-char (car points))
+ (dolist (point points)
+ (add-text-properties point (1+ point)
+ '(invisible nil highlight t)))
+ (unless (yes-or-no-p
+ "Invisible text found and made visible; continue posting? ")
+ (error "Invisible text found and made visible"))))))
(defun message-add-action (action &rest types)
"Add ACTION to be performed when doing an exit of type TYPES."
(message-posting-charset
(if (fboundp 'gnus-setup-posting-charset)
(gnus-setup-posting-charset nil)
- message-posting-charset)))
+ message-posting-charset))
+ (headers message-required-mail-headers))
(save-restriction
(message-narrow-to-headers)
- ;; Insert some headers.
- (let ((message-deletable-headers
- (if news nil message-deletable-headers)))
- (message-generate-headers message-required-mail-headers))
;; Generate the Mail-Followup-To header if the header is not there...
(if (and (or message-subscribed-regexps
message-subscribed-addresses
+ message-subscribed-address-file
message-subscribed-address-functions)
(not (mail-fetch-field "mail-followup-to")))
- (message-generate-headers
- `(("Mail-Followup-To" . ,(message-make-mft))))
+ (setq headers
+ (cons
+ (cons "Mail-Followup-To" (message-make-mft))
+ message-required-mail-headers))
;; otherwise, delete the MFT header if the field is empty
(when (equal "" (mail-fetch-field "mail-followup-to"))
- (message-remove-header "Mail-Followup-To")))
+ (message-remove-header "^Mail-Followup-To:")))
+ ;; Insert some headers.
+ (let ((message-deletable-headers
+ (if news nil message-deletable-headers)))
+ (message-generate-headers headers))
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(unwind-protect
(save-excursion
(set-buffer tembuf)
(erase-buffer)
- ;; Avoid copying text props.
+ ;; Avoid copying text props (except hard newlines).
(insert (with-current-buffer mailbuf
- (buffer-substring-no-properties (point-min) (point-max))))
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ (point-min) (point-max))))
;; Remove some headers.
(message-encode-message-body)
(save-restriction
(defun message-canlock-generate ()
"Return a string that is non-trival to guess.
Do not use this for anything important, it is cryptographically weak."
- (md5 (concat (message-unique-id)
- (format "%x%x%x" (random) (random t) (random))
- (prin1-to-string (recent-keys))
- (prin1-to-string (garbage-collect)))))
+ (sha1 (concat (message-unique-id)
+ (format "%x%x%x" (random) (random t) (random))
+ (prin1-to-string (recent-keys))
+ (prin1-to-string (garbage-collect)))))
(defun message-canlock-password ()
"The password used by message for cancel locks.
(defun message-insert-canlock ()
(when message-insert-canlock
- (require 'canlock)
(message-canlock-password)
(canlock-insert-header)))
(set-buffer tembuf)
(buffer-disable-undo)
(erase-buffer)
- ;; Avoid copying text props.
- (insert (with-current-buffer messbuf
- (buffer-substring-no-properties
- (point-min) (point-max))))
+ ;; Avoid copying text props (except hard newlines).
+ (insert
+ (with-current-buffer messbuf
+ (mml-buffer-substring-no-properties-except-hard-newlines
+ (point-min) (point-max))))
(message-encode-message-body)
;; Remove some headers.
(save-restriction
(zerop
(length
(setq to (completing-read
- "Followups to: (default all groups) "
+ "Followups to (default: no Followup-To header) "
(mapcar (lambda (g) (list g))
(cons "poster"
(message-tokenize-header
"Process Fcc headers in the current buffer."
(let ((case-fold-search t)
(buf (current-buffer))
- list file)
+ list file
+ (mml-externalize-attachments message-fcc-externalize-attachments))
(save-excursion
(save-restriction
(message-narrow-to-headers)
(aset user (match-beginning 0) ?_))
user)
(message-number-base36 (user-uid) -1))
- (message-number-base36 (+ (car tm)
+ (message-number-base36 (+ (car tm)
(lsh (% message-unique-id-char 25) 16)) 4)
(message-number-base36 (+ (nth 1 tm)
(lsh (/ message-unique-id-char 25) 16)) 4)
(aset tmp (1- (match-end 0)) ?-))
(string-match "[\\()]" tmp)))))
(insert fullname)
- (goto-char (point-min))
- ;; Look for a character that cannot appear unquoted
- ;; according to RFC 822.
- (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
- ;; Quote fullname, escaping specials.
- (goto-char (point-min))
- (insert "\"")
- (while (re-search-forward "[\"\\]" nil 1)
- (replace-match "\\\\\\&" t))
- (insert "\""))
(insert " <" login ">"))
(t ; 'parens or default
(insert login " (")
(match-string 1 user-mail))
;; Default to this bogus thing.
(t
- (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me")))))
+ (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me")))))
(defun message-make-host-name ()
"Return the name of the host."
(recipients
(mapcar 'mail-strip-quoted-names
(message-tokenize-header msg-recipients)))
+ (file-regexps
+ (if message-subscribed-address-file
+ (let (begin end item re)
+ (save-excursion
+ (with-temp-buffer
+ (insert-file-contents message-subscribed-address-file)
+ (while (not (eobp))
+ (setq begin (point))
+ (forward-line 1)
+ (setq end (point))
+ (if (bolp) (setq end (1- end)))
+ (setq item (regexp-quote (buffer-substring begin end)))
+ (if re (setq re (concat re "\\|" item))
+ (setq re (concat "\\`\\(" item))))
+ (and re (list (concat re "\\)\\'"))))))))
(mft-regexps (apply 'append message-subscribed-regexps
(mapcar 'regexp-quote
message-subscribed-addresses)
+ file-regexps
(mapcar 'funcall
message-subscribed-address-functions))))
(save-match-data
;; This header didn't exist, so we insert it.
(goto-char (point-max))
(insert (if (stringp header) header (symbol-name header))
- ": " value "\n")
+ ": " value)
+ ;; We check whether the value was ended by a
+ ;; newline. If now, we insert one.
+ (unless (bolp)
+ (insert "\n"))
(forward-line -1))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
(forward-line 2)))
(sit-for 0)))
+(defun message-beginning-of-line (&optional n)
+ "Move point to beginning of header value or to beginning of line."
+ (interactive "p")
+ (if (message-point-in-header-p)
+ (let* ((here (point))
+ (bol (progn (beginning-of-line n) (point)))
+ (eol (gnus-point-at-eol))
+ (eoh (re-search-forward ": *" eol t)))
+ (if (or (not eoh) (equal here eoh))
+ (goto-char bol)
+ (goto-char eoh)))
+ (beginning-of-line n)))
+
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
(cond
to group)
(if (not (or (null name)
(string-equal name "mail")
- (string-equal name "news")))
+ (string-equal name "posting")))
(setq name (concat "*sent " name "*"))
(message-narrow-to-headers)
(setq to (message-fetch-field "to"))
(or (car (mail-extract-address-components to))
to) "*"))
((and group (not (string= group "")))
- (concat "*sent news on " group "*"))
+ (concat "*sent posting on " group "*"))
(t "*sent mail*"))))
(unless (string-equal name (buffer-name))
(rename-buffer name t)))))
headers)
nil switch-function yank-action actions)))))
-;;;(defvar mc-modes-alist)
(defun message-setup-1 (headers &optional replybuffer actions)
-;;; (when (and (boundp 'mc-modes-alist)
-;;; (not (assq 'message-mode mc-modes-alist)))
-;;; (push '(message-mode (encrypt . mc-encrypt-message)
-;;; (sign . mc-sign-message))
-;;; mc-modes-alist))
(dolist (action actions)
(condition-case nil
(add-to-list 'message-send-actions
"Start editing a news article to be sent."
(interactive)
(let ((message-this-is-news t))
- (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
;; <abraham@dina.kvl.dk>
;;
;; IF article has cancel-lock THEN
- ;; IF we can load canlock THEN
- ;; IF we can verify it THEN
- ;; issue cancel
- ;; ELSE
- ;; error: cancellock: article is not yours
+ ;; IF we can verify it THEN
+ ;; issue cancel
;; ELSE
- ;; error: message is cancel locked
+ ;; error: cancellock: article is not yours
;; ELSE
;; Use old rules, comparing sender...
(if (message-fetch-field "Cancel-Lock")
- (if (ignore-errors (require 'canlock))
- (if (null (canlock-verify))
- t
- (error "Failed to verify Cancel-lock: This article is not yours"))
- (error "This article is cancel locked, the `canlock.el' library is required."))
+ (if (null (canlock-verify))
+ t
+ (error "Failed to verify Cancel-lock: This article is not yours"))
nil)
(message-gnksa-enable-p 'cancel-messages)
(and sender
(sender (message-fetch-field "sender"))
(from (message-fetch-field "from")))
;; Check whether the user owns the article that is to be superseded.
- (unless (or (message-gnksa-enable-p 'cancel-messages)
+ (unless (or
+ ;; Canlock-logic as suggested by Per Abrahamsen
+ ;; <abraham@dina.kvl.dk>
+ ;;
+ ;; IF article has cancel-lock THEN
+ ;; IF we can verify it THEN
+ ;; issue cancel
+ ;; ELSE
+ ;; error: cancellock: article is not yours
+ ;; ELSE
+ ;; Use old rules, comparing sender...
+ (if (message-fetch-field "Cancel-Lock")
+ (if (null (canlock-verify))
+ t
+ (error "Failed to verify Cancel-lock: This article is not yours"))
+ nil)
+ (message-gnksa-enable-p 'cancel-messages)
(and sender
(string-equal
(downcase sender)
"Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT.
Previous forwarders, replyers, etc. may add it."
(with-temp-buffer
- (insert-string subject)
+ (insert subject)
(goto-char (point-min))
;; strip Re/Fwd stuff off the beginning
(while (re-search-forward
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
(let ((message-this-is-news t))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
(special-display-regexps nil)
(same-window-buffer-names nil)
(same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
+ (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
(let ((message-this-is-news t))
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
(tool-bar-add-item-from-menu
'message-dont-send "cancel" message-mode-map)
(tool-bar-add-item-from-menu
- 'mml-attach-file "attach" message-mode-map)
+ 'mml-attach-file "attach" mml-mode-map)
(tool-bar-add-item-from-menu
'ispell-message "spell" message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-insert-importance-high "important"
+ message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-insert-importance-low "unimportant"
+ message-mode-map)
+ (tool-bar-add-item-from-menu
+ 'message-insert-disposition-notification-to "receipt"
+ message-mode-map)
tool-bar-map)))))
;;; Group name completion.
-(defvar message-newgroups-header-regexp
+(defcustom message-newgroups-header-regexp
"^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
- "Regexp that match headers that lists groups.")
+ "Regexp that match headers that lists groups."
+ :group 'message
+ :type 'regexp)
-(defvar message-completion-alist
+(defcustom message-completion-alist
(list (cons message-newgroups-header-regexp 'message-expand-group)
'("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name))
- "Alist of (RE . FUN). Use FUN for completion on header lines matching RE.")
+ "Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
+ :group 'message
+ :type '(alist :key-type regexp :value-type function))
-(defvar message-tab-body-function 'indent-relative
- "*Function to execute when `message-tab' (TAB) is executed in the body.")
+(defcustom message-tab-body-function nil
+ "*Function to execute when `message-tab' (TAB) is executed in the body.
+If nil, the function bound in `text-mode-map' or `global-map' is executed."
+ :group 'message
+ :type 'function)
(defun message-tab ()
"Complete names according to `message-completion-alist'.
-Do an `indent-relative' if not in those headers."
+Execute function specified by `message-tab-body-function' when not in
+those headers."
(interactive)
(let ((alist message-completion-alist))
(while (and alist
(let ((mail-abbrev-mode-regexp (caar alist)))
(not (mail-abbrev-in-expansion-header-p))))
(setq alist (cdr alist)))
- (funcall (or (cdar alist) message-tab-body-function))))
+ (funcall (or (cdar alist) message-tab-body-function
+ (lookup-key text-mode-map "\t")
+ (lookup-key global-map "\t")
+ 'indent-relative))))
(defun message-expand-group ()
"Expand the group name under point."
(message-narrow-to-headers-or-head)
(message-remove-first-header "Content-Type")
(message-remove-first-header "Content-Transfer-Encoding"))
- ;; We always make sure that the message has a Content-Type header.
- ;; This is because some broken MTAs and MUAs get awfully confused
- ;; when confronted with a message with a MIME-Version header and
- ;; without a Content-Type header. For instance, Solaris'
- ;; /usr/bin/mail.
+ ;; We always make sure that the message has a Content-Type
+ ;; header. This is because some broken MTAs and MUAs get
+ ;; awfully confused when confronted with a message with a
+ ;; MIME-Version header and without a Content-Type header. For
+ ;; instance, Solaris' /usr/bin/mail.
(unless content-type-p
(goto-char (point-min))
;; For unknown reason, MIME-Version doesn't exist.
(forward-line 1)
(insert "Content-Type: text/plain; charset=us-ascii\n"))))))
-(defun message-read-from-minibuffer (prompt)
+(defun message-read-from-minibuffer (prompt &optional initial-contents)
"Read from the minibuffer while providing abbrev expansion."
(if (fboundp 'mail-abbrevs-setup)
(let ((mail-abbrev-mode-regexp "")
(minibuffer-setup-hook 'mail-abbrevs-setup)
(minibuffer-local-map message-minibuffer-local-map))
- (read-from-minibuffer prompt))
+ (read-from-minibuffer prompt initial-contents))
(let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
(minibuffer-local-map message-minibuffer-local-map))
- (read-string prompt))))
+ (read-string prompt initial-contents))))
(defun message-use-alternative-email-as-from ()
(require 'mail-utils)
projects / gnus / blobdiff