X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=69f61f486accc22732195bdf2764e13c8a3ca513;hb=7d3cebb22d43e3ae26e7b1ab3b40c12ec80be154;hp=e6efd24919d4bef442c213e4144da23af413abf8;hpb=078f9697cf29ddf6c5c0f4e5952d13fec3b18852;p=elisp%2Fgnus.git- diff --git a/lisp/message.el b/lisp/message.el index e6efd24..69f61f4 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -40,7 +40,8 @@ (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) @@ -418,7 +419,12 @@ included. Organization and User-Agent are optional." :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:" @@ -434,7 +440,12 @@ It's best to delete old Path and Date headers before posting to avoid 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 @@ -651,13 +662,22 @@ Done before generating the new subject of a forward." "*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 "." @@ -683,6 +703,7 @@ Done before generating the new subject of a forward." 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) @@ -869,6 +890,7 @@ Doing so would be even more evil than leaving it out." "*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)) @@ -988,7 +1010,8 @@ The function `message-supersede' runs this hook." (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 @@ -1618,6 +1641,7 @@ no, only reply back to the author." (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) @@ -1636,6 +1660,13 @@ no, only reply back to the author." (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...") @@ -1844,11 +1875,11 @@ is used by default." (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)) @@ -3760,8 +3791,15 @@ Instead, just auto-save the buffer and then bury it." (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)) @@ -3804,8 +3842,7 @@ Instead, just auto-save the buffer and then bury it." "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)))) @@ -4212,6 +4249,13 @@ This sub function is for exclusive use of `message-send-mail'." (message-this-is-mail t) (headers message-required-mail-headers) failure) + (when message-generate-hashcash + (save-restriction + (message-narrow-to-headers) + (message-remove-header "X-Hashcash")) + (message "Generating hashcash...") + (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... @@ -4956,7 +5000,9 @@ Otherwise, generate and save a value for `canlock-password' first." 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)) @@ -7319,6 +7365,7 @@ which specify the range to operate on." '("^\\(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)) @@ -7587,7 +7634,7 @@ regexp VARSTR." (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 @@ -7601,7 +7648,8 @@ regexp VARSTR." (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)))