X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmessage.el;h=32cfe3b9abf968391f298151f549de78a4293b34;hb=99648d27eedbdead431411bfa31edd18c4ad5db4;hp=576fb5a5d3927ef8cb9197bf6b7676c9a64aeb33;hpb=3b1cc6277adfb842733aaff1f93bd612dea0a8f7;p=gnus diff --git a/lisp/message.el b/lisp/message.el index 576fb5a5d..32cfe3b9a 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -1,6 +1,6 @@ ;;; message.el --- composing mail and news messages -;; Copyright (C) 1996-2013 Free Software Foundation, Inc. +;; Copyright (C) 1996-2014 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: mail, news @@ -28,9 +28,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) @@ -50,6 +47,7 @@ (require 'mml) (require 'rfc822) (require 'format-spec) +(require 'dired) (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ @@ -268,7 +266,7 @@ This is a list of regexps and regexp matches." :type 'sexp) (defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:" + "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:\\|^X-Gnus-Delayed:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers @@ -614,7 +612,8 @@ Done before generating the new subject of a forward." regexp)) (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" - "*All headers that match this regexp will be deleted when forwarding a message." + "*All headers that match this regexp will be deleted when forwarding a message. +This may also be a list of regexps." :version "21.1" :group 'message-forwarding :type '(repeat :value-to-internal (lambda (widget value) @@ -624,6 +623,19 @@ Done before generating the new subject of a forward." (widget-editable-list-match widget value))) regexp)) +(defcustom message-forward-included-headers nil + "If non-nil, delete non-matching headers when forwarding a message. +Only headers that match this regexp will be included. This +variable should be a regexp or a list of regexps." + :version "24.5" + :group 'message-forwarding + :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 "." "*Delete these headers from the messages you yank." :group 'message-insertion @@ -972,6 +984,8 @@ the signature is inserted." (set-keymap-parent map minibuffer-local-map) map) "Keymap for `message-read-from-minibuffer'." + ;; FIXME improve type. + :type '(restricted-sexp :match-alternatives (symbolp keymapp)) :version "22.1" :group 'message-various) @@ -2493,6 +2507,7 @@ With prefix-argument just set Follow-Up, don't cross-post." "Remove HEADER in the narrowed buffer. If IS-REGEXP, HEADER is a regular expression. If FIRST, only remove the first instance of the header. +If REVERSE, remove headers that doesn't match HEADER. Return the number of headers removed." (goto-char (point-min)) (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":"))) @@ -4141,11 +4156,12 @@ Instead, just auto-save the buffer and then bury it." (defun message-bury (buffer) "Bury this mail BUFFER." + ;; Note that this is not quite the same as (bury-buffer buffer), + ;; since bury-buffer does extra stuff with a nil argument. + ;; Eg http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg00539.html + (with-current-buffer buffer (bury-buffer)) (if message-return-action - (progn - (bury-buffer buffer) - (apply (car message-return-action) (cdr message-return-action))) - (with-current-buffer buffer (bury-buffer)))) + (apply (car message-return-action) (cdr message-return-action)))) (defun message-send (&optional arg) "Send the message in the current buffer. @@ -4783,7 +4799,9 @@ that instead." (list resend-to-addresses) '("-t")))))) (unless (or (null cpr) (and (numberp cpr) (zerop cpr))) - (if errbuf (pop-to-buffer errbuf)) + (when errbuf + (pop-to-buffer errbuf) + (setq errbuf nil)) (error "Sending...failed with exit value %d" cpr))) (when message-interactive (with-current-buffer errbuf @@ -6315,6 +6333,9 @@ they are." :link '(custom-manual "(message)Movement") :type 'boolean) +(defvar visual-line-mode) +(declare-function beginning-of-visual-line "simple" (&optional n)) + (defun message-beginning-of-line (&optional n) "Move point to beginning of header value or to beginning of line. The prefix argument N is passed directly to `beginning-of-line'. @@ -6341,7 +6362,9 @@ between beginning of field and beginning of line." (goto-char (if (and eoh (or (< eoh here) (= bol here))) eoh bol))) - (beginning-of-line n))) + (if (and (boundp 'visual-line-mode) visual-line-mode) + (beginning-of-visual-line n) + (beginning-of-line n)))) (defun message-buffer-name (type &optional to group) "Return a new (unique) buffer name based on TYPE and TO." @@ -7249,7 +7272,7 @@ header line with the old Message-ID." (let ((buffer-read-only nil)) (erase-buffer) (insert-file-contents file-name nil))) - (t (error "message-recover cancelled"))))) + (t (error "message-recover canceled"))))) ;;; Washing Subject: @@ -7408,17 +7431,25 @@ Optional DIGEST will use digest to forward." (message-remove-ignored-headers b e))) (defun message-remove-ignored-headers (b e) - (when message-forward-ignored-headers + (when (or message-forward-ignored-headers + message-forward-included-headers) (save-restriction (narrow-to-region b e) (goto-char b) (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point))) - (let ((ignored (if (stringp message-forward-ignored-headers) - (list message-forward-ignored-headers) - message-forward-ignored-headers))) - (dolist (elem ignored) - (message-remove-header elem t)))))) + (when message-forward-ignored-headers + (let ((ignored (if (stringp message-forward-ignored-headers) + (list message-forward-ignored-headers) + message-forward-ignored-headers))) + (dolist (elem ignored) + (message-remove-header elem t)))) + (when message-forward-included-headers + (message-remove-header + (if (listp message-forward-included-headers) + (regexp-opt message-forward-included-headers) + message-forward-included-headers) + t nil t))))) (defun message-forward-make-body-mime (forward-buffer &optional beg end) (let ((b (point))) @@ -7466,8 +7497,7 @@ Optional DIGEST will use digest to forward." (goto-char (point-max)))) (setq e (point)) (insert "<#/mml>\n") - (when (and (not message-forward-decoded-p) - message-forward-ignored-headers) + (when (not message-forward-decoded-p) (message-remove-ignored-headers b e)))) (defun message-forward-make-body-digest-plain (forward-buffer) @@ -7962,8 +7992,9 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed." (defun message-tab () "Complete names according to `message-completion-alist'. -Execute function specified by `message-tab-body-function' when not in -those headers." +Execute function specified by `message-tab-body-function' when +not in those headers. If that variable is nil, indent with the +regular text mode tabbing command." (interactive) (cond ((if (and (boundp 'completion-fail-discreetly) @@ -7991,17 +8022,6 @@ those headers." ;; falling back to message-tab-body-function. (lambda () (funcall fun) 'completion-attempted))))) -(eval-and-compile - (condition-case nil - (with-temp-buffer - (let ((standard-output (current-buffer))) - (eval '(display-completion-list nil ""))) - (defalias 'message-display-completion-list 'display-completion-list)) - (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs. - (defun message-display-completion-list (completions &optional ignore) - "Display the list of completions, COMPLETIONS, using `standard-output'." - (display-completion-list completions))))) - (defun message-expand-group () "Expand the group name under point." (let ((b (save-excursion @@ -8026,12 +8046,12 @@ those headers." group) collection)) gnus-active-hashtb)) - (message-completion-in-region e b collection))) + (message-completion-in-region b e collection))) (defalias 'message-completion-in-region (if (fboundp 'completion-in-region) 'completion-in-region - (lambda (e b hashtb) + (lambda (b e hashtb) (let* ((string (buffer-substring b e)) (completions (all-completions string hashtb)) comp) @@ -8056,8 +8076,7 @@ those headers." (let ((buffer-read-only nil)) (erase-buffer) (let ((standard-output (current-buffer))) - (message-display-completion-list (sort completions 'string<) - string)) + (display-completion-list (sort completions 'string<))) (setq buffer-read-only nil) (goto-char (point-min)) (delete-region (point) @@ -8467,6 +8486,17 @@ Used in `message-simplify-recipients'." (message-fetch-field hdr) t)) ", ")))) +;;; multipart/related and HTML support. + +(defun message-make-html-message-with-image-files (files) + (interactive (list (dired-get-marked-files nil current-prefix-arg))) + (message-mail) + (message-goto-body) + (insert "<#part type=text/html>\n\n") + (dolist (file files) + (insert (format "\n\n" file))) + (message-goto-to)) + (when (featurep 'xemacs) (require 'messagexmas) (message-xmas-redefine))