(require 'cl)
(require 'smtp)
(defvar gnus-message-group-art)
- (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+ (defvar gnus-list-identifiers) ; gnus-sum is required where necessary
+ (require 'hashcash))
(require 'canlock)
(require 'mailheader)
(require 'nnheader)
the article has been posted to will be inserted there.
If this variable is nil, no such courtesy message will be added."
:group 'message-sending
- :type '(radio (string :format "%t: %v\n" :size 0) (const nil)))
+ :type '(radio string (const nil)))
(defcustom message-ignored-bounced-headers
"^\\(Received\\|Return-Path\\|Delivered-To\\):"
"Note to insert why you wouldn't want this posting archived.
If nil, don't insert any text in the body."
:version "21.4"
- :type '(radio (string :format "%t: %v\n" :size 0)
- (const nil))
+ :type '(radio string (const nil))
:link '(custom-manual "(message)Header Commands")
:group 'message-various)
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
- :type 'regexp)
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
(defcustom message-ignored-mail-headers
"^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
any confusion."
:group 'message-interface
:link '(custom-manual "(message)Superseding")
- :type 'regexp)
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
(defcustom message-supersede-setup-function
'message-supersede-setup-for-mime-edit
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:link '(custom-manual "(message)Resending")
- :type 'regexp)
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"*All headers that match this regexp will be deleted when forwarding a message."
:version "21.1"
:group 'message-forwarding
- :type '(choice (const :tag "None" nil)
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
regexp))
(defcustom message-ignored-cited-headers "."
non-word-constituents
"]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
"*Regexp matching the longest possible citation prefix on a line."
+ :version "21.4"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
:type 'regexp)
:link '(custom-manual "(message)Followup")
:type '(choice function (const nil)))
+(defcustom message-extra-wide-headers nil
+ "If non-nil, a list of additional address headers.
+These are used when composing a wide reply."
+ :group 'message-sending
+ :type '(repeat string))
+
(defcustom message-use-followup-to 'ask
"*Specifies what to do with Followup-To header.
If nil, always ignore the header. If it is t, use its value, but
:version "21.4"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
- :type '(radio (file :format "%t: %v\n" :size 0)
- (const nil)))
+ :type '(radio file (const nil)))
(defcustom message-subscribed-addresses nil
"*Specifies a list of addresses the user is subscribed to.
"*Envelope-from when sending mail with sendmail.
If this is nil, use `user-mail-address'. If it is the symbol
`header', use the From: header of the message."
+ :version "21.4"
:type '(choice (string :tag "From name")
(const :tag "Use From: header from message" header)
(const :tag "Use `user-mail-address'" nil))
(let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
(set-keymap-parent map minibuffer-local-map)
map)
- "Keymap for `message-read-from-minibuffer'.")
+ "Keymap for `message-read-from-minibuffer'."
+ :version "21.4")
;;;###autoload
(defcustom message-citation-line-function 'message-insert-citation-line
(or (not (listp message-shoot-gnksa-feet))
(memq feature message-shoot-gnksa-feet)))
-(defcustom message-hidden-headers nil
+(defcustom message-hidden-headers "^References:"
"Regexp of headers to be hidden when composing new messages.
This can also be a list of regexps to match headers. Or a list
starting with `not' and followed by regexps."
:version "21.4"
:group 'message
:link '(custom-manual "(message)Message Headers")
- :type '(repeat regexp))
+ :type '(choice
+ :format "%{%t%}: %[Value Type%] %v"
+ (regexp :menu-tag "regexp" :format "regexp\n%t: %v")
+ (repeat :menu-tag "(regexp ...)" :format "(regexp ...)\n%v%i"
+ (regexp :format "%t: %v"))
+ (cons :menu-tag "(not regexp ...)" :format "(not regexp ...)\n%v"
+ (const not)
+ (repeat :format "%v%i"
+ (regexp :format "%t: %v")))))
(defcustom message-cite-articles-with-x-no-archive t
"If non-nil, cite text from articles that has X-No-Archive set."
(defcustom message-user-fqdn nil
"*Domain part of Messsage-Ids."
+ :version "21.4"
:group 'message-headers
:link '(custom-manual "(message)News Headers")
:type '(radio (const :format "%v " nil)
- (string :format "FQDN: %v\n" :size 0)))
+ (string :format "FQDN: %v")))
(defcustom message-use-idna (and (condition-case nil (require 'idna)
(file-error))
(const :tag "Never" nil)
(const :tag "Always" t)))
+(defcustom message-generate-hashcash nil
+ "*Whether to generate X-Hashcash: headers.
+You must have the \"hashcash\" binary installed, see `hashcash-path'."
+ :group 'message-headers
+ :link '(custom-manual "(message)Mail Headers")
+ :type 'boolean)
+
;;; Internal variables.
(defvar message-sending-message "Sending...")
"Alist of header names/filler functions.")
(defvar message-header-format-alist
- `((Newsgroups)
+ `((From)
+ (Newsgroups)
(To)
(Cc)
(Subject)
(if (not header)
nil
(let ((regexp (format "[%s]+" (or separator ",")))
- (beg (point-min))
(first t)
- quoted elems paren)
+ beg quoted elems paren)
(with-temp-buffer
(set-buffer-multibyte t)
+ (setq beg (point-min))
(insert header)
(goto-char (point-min))
(while (not (eobp))
;; 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.
+ "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)
(message-tamago-not-in-use-p begin)
;; Check whether the invisible MIME part is not inserted.
(not (text-property-any begin end 'mime-edit-invisible t)))
- (dolist (from-to (message-text-with-property 'message-hidden
- begin end t))
- (remove-text-properties (car from-to) (cdr from-to)
- message-forbidden-properties))))
+ (let ((buffer-read-only nil)
+ (inhibit-read-only t))
+ (remove-text-properties begin end message-forbidden-properties))))
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
(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" ""))))
+ (progn
+ ;; If the message buffer has lived in a dedicated window,
+ ;; `kill-buffer' has killed the frame. Thus the
+ ;; `yes-or-no-p' may show up in a lowered frame. Make sure
+ ;; that the user can see the question by raising the
+ ;; current frame:
+ (raise-frame)
+ (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))
"Bury this mail BUFFER."
(let ((newbuf (other-buffer buffer)))
(bury-buffer buffer)
- (if (and (fboundp 'frame-parameters)
- (cdr (assq 'dedicated (frame-parameters)))
+ (if (and (window-dedicated-p (selected-window))
(not (null (delq (selected-frame) (visible-frame-list)))))
(delete-frame (selected-frame))
(switch-to-buffer newbuf))))
(unless (bolp)
(insert "\n"))
;; Make the hidden headers visible.
- (dolist (from-to (message-text-with-property 'message-hidden))
- (add-text-properties (car from-to) (cdr from-to)
- '(invisible nil intangible nil)))
+ (widen)
+ ;; Sort headers before sending the message.
+ (message-sort-headers)
;; Make invisible text visible except for mime parts which may be
;; inserted by the MIME-Edit.
;; It doesn't seem as if this is useful, since the invisible property
(message-this-is-mail t)
(headers message-required-mail-headers)
failure)
+ (when message-generate-hashcash
+ (message "Generating hashcash...")
+ ;; Wait for calculations already started to finish...
+ (hashcash-wait-async)
+ ;; ...and do calculations not already done. mail-add-payment
+ ;; will leave existing X-Hashcash headers alone.
+ (mail-add-payment)
+ (message "Generating hashcash...done"))
(save-restriction
(message-narrow-to-headers)
;; Generate the Mail-Followup-To header if the header is not there...
nil))))
;; Check for control characters.
(message-check 'control-chars
- (if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t)
+ (if (re-search-forward
+ (string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
+ nil t)
(y-or-n-p
"The article contains control characters. Really post? ")
t))
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
+ (when message-generate-hashcash
+ ;; Generate hashcash headers for recipients already known
+ (mail-add-payment-async))
(run-hooks 'message-setup-hook)
(message-position-point)
(undo-boundary))
(Subject . ,(or subject ""))))))
(defun message-get-reply-headers (wide &optional to-address address-headers)
- (let (follow-to mct never-mct to cc author mft recipients)
+ (let (follow-to mct never-mct to cc author mft recipients extra)
;; Find all relevant headers we need.
(save-restriction
(message-narrow-to-headers-or-head)
;; message-header-synonyms.
(setq to (or (message-fetch-field "to")
(and (loop for synonym in message-header-synonyms
- when (memq 'Original-To synonym)
- return t)
+ when (memq 'Original-To synonym)
+ return t)
(message-fetch-field "original-to")))
cc (message-fetch-field "cc")
+ extra (when message-extra-wide-headers
+ (mapconcat 'identity
+ (mapcar 'message-fetch-field
+ message-extra-wide-headers)
+ ", "))
mct (when message-use-mail-copies-to
(message-fetch-field "mail-copies-to"))
author (or mrt
(if mct (setq recipients (concat recipients ", " mct))))
(t
(setq recipients (if never-mct "" (concat ", " author)))
- (if to (setq recipients (concat recipients ", " to)))
- (if cc (setq recipients (concat recipients ", " cc)))
+ (if to (setq recipients (concat recipients ", " to)))
+ (if cc (setq recipients (concat recipients ", " cc)))
+ (if extra (setq recipients (concat recipients ", " extra)))
(if mct (setq recipients (concat recipients ", " mct)))))
(if (>= (length recipients) 2)
;; Strip the leading ", ".
(setq e (point))
(insert
"\n-------------------- End of forwarded message --------------------\n")
- (when (and (not current-prefix-arg)
- message-forward-ignored-headers)
+ (when message-forward-ignored-headers
(save-restriction
(narrow-to-region b e)
(goto-char b)
(goto-char (point-max))))
(setq e (point))
(insert "<#/mml>\n")
- (when (and (not current-prefix-arg)
+ (when (and (not message-forward-decoded-p)
message-forward-ignored-headers)
(save-restriction
(narrow-to-region b e)
'("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
. message-expand-name))
"Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
+ :version "21.4"
:group 'message
:type '(alist :key-type regexp :value-type function))
(function-item :format "eudc: %v\n" eudc-expand-inline)
(function-item :format "bbdb: %v\n" bbdb-complete-name)
(function-item :format "lsdb: %v\n" lsdb-complete-name)
- (function :size 0 :value expand-abbrev)))
+ (function :value expand-abbrev)))
(defcustom message-tab-body-function nil
"*Function to execute when `message-tab' (TAB) is executed in the body.
(defun message-use-alternative-email-as-from ()
(require 'mail-utils)
- (let* ((fields '("To" "Cc"))
+ (let* ((fields '("To" "Cc" "From"))
(emails
(split-string
(mail-strip-quoted-names
(pop emails))
(unless (or (not email) (equal email user-mail-address))
(goto-char (point-max))
- (insert "From: " email "\n"))))
+ (insert "From: " (let ((user-mail-address email)) (message-make-from))
+ "\n"))))
(defun message-options-get (symbol)
(cdr (assq symbol message-options)))
(list message-hidden-headers)
message-hidden-headers))
(inhibit-point-motion-hooks t)
- (after-change-functions nil))
+ (after-change-functions nil)
+ (end-of-headers 0))
(when regexps
(save-excursion
(save-restriction
(while (not (eobp))
(if (not (message-hide-header-p regexps))
(message-next-header)
- (let ((begin (point)))
+ (let ((begin (point))
+ header header-len)
(message-next-header)
- (add-text-properties
- begin (point)
- '(invisible t message-hidden t))))))))))
+ (setq header (buffer-substring begin (point))
+ header-len (- (point) begin))
+ (delete-region begin (point))
+ (goto-char (1+ end-of-headers))
+ (insert header)
+ (setq end-of-headers
+ (+ end-of-headers header-len))))))))
+ (narrow-to-region (1+ end-of-headers) (point-max))))
(defun message-hide-header-p (regexps)
(let ((result nil)
projects / elisp / gnus.git- / blobdiff