:type 'boolean)
(defcustom message-included-forward-headers
- "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^MIME-Version:"
+ "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^\\(Mail-\\)?Followup-To:\\|^\\(Mail-\\)?Reply-To:\\|^Mail-Copies-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-\\|^MIME-Version:"
"*Regexp matching headers to be included in forwarded messages."
:group 'message-forwarding
:type 'regexp)
:group 'message-forwarding
:type 'boolean)
-(defcustom message-ignored-resent-headers "^Return-receipt"
+(defcustom message-ignored-resent-headers "^Return-Receipt"
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:type 'regexp)
"*Specifies what to do with Mail-Reply-To/Reply-To header.
If nil, always ignore the header. If it is t or the symbol `use', use
its value. If it is the symbol `ask', always query the user whether to
-use the value. Not that if \"Reply-To\" is marked as \"broken\", its value
+use the value. Note that if \"Reply-To\" is marked as \"broken\", its value
is never used."
:group 'message-interface
:type '(choice (const :tag "ignore" nil)
(Lines)
(Expires)
(Message-ID)
- ;; (References . message-shorten-references)
- ;; (References . message-fill-header)
(References . message-fill-references)
(User-Agent))
"Alist used for formatting headers.")
;; Also peel off any blank lines before the signature.
(forward-line -1)
(while (looking-at "^[ \t]*$")
- (forward-line -1))
+ (forward-line -1))
(forward-line 1)
(delete-region (point) end))
(goto-char start)
(message-do-actions actions)
(message-delete-frame frame org-frame))))
-(defun message-delete-frame (frame org-frame)
- "Delete frame for editing message."
- (when (and (or (and (featurep 'xemacs)
- (not (eq 'tty (device-type))))
- window-system)
- (or (and (eq message-delete-frame-on-exit t)
- (select-frame frame)
- (or (eq frame org-frame)
- (prog1
- (y-or-n-p "Delete this frame?")
- (message ""))))
- (and (eq message-delete-frame-on-exit 'ask)
- (select-frame frame)
- (prog1
- (y-or-n-p "Delete this frame?")
- (message "")))))
- (delete-frame frame)))
-
(defun message-dont-send ()
"Don't send the message you have been editing."
(interactive)
(message-do-actions actions)
(message-delete-frame frame org-frame))))
+(defun message-delete-frame (frame org-frame)
+ "Delete frame for editing message."
+ (when (and (or (and (featurep 'xemacs)
+ (not (eq 'tty (device-type))))
+ window-system
+ (>= emacs-major-version 20))
+ (or (and (eq message-delete-frame-on-exit t)
+ (select-frame frame)
+ (or (eq frame org-frame)
+ (prog1
+ (y-or-n-p "Delete this frame?")
+ (message ""))))
+ (and (eq message-delete-frame-on-exit 'ask)
+ (select-frame frame)
+ (prog1
+ (y-or-n-p "Delete this frame?")
+ (message "")))))
+ (delete-frame frame)))
+
(defun message-bury (buffer)
"Bury this mail buffer."
(let ((newbuf (other-buffer buffer)))
(message-check 'from
(let* ((case-fold-search t)
(from (message-fetch-field "from"))
- (ad (nth 1 (funcall gnus-extract-address-components from))))
+ (ad (nth 1 (std11-extract-address-components from))))
(cond
((not from)
(message "There is no From line. Posting is denied.")
(when mid
(concat mid
(when from
- (let ((stop-pos
- (string-match " *at \\| *@ \\| *(\\| *<" from)))
+ (let ((pair (std11-extract-address-components from)))
(concat "\n ("
- (if stop-pos (substring from 0 stop-pos) from)
+ (or (car pair) (cadr pair))
"'s message of "
(if (or (not date) (string= date ""))
"(unknown date)" date)
"Return the pertinent part of `user-mail-address'."
(when user-mail-address
(if (string-match " " user-mail-address)
- (nth 1 (funcall gnus-extract-address-components user-mail-address))
+ (nth 1 (std11-extract-address-components user-mail-address))
user-mail-address)))
(defun message-make-fqdn ()
(or mail-host-address
(message-make-fqdn)))
+;; Dummy to avoid byte-compile warning.
+(defvar mule-version)
+(defvar emacs-beta-version)
+(defvar xemacs-codename)
+
+(defun message-make-user-agent ()
+ "Return user-agent info."
+ (let ((user-agent
+ (concat
+ ;; EMACS/VERSION
+ (if (featurep 'xemacs)
+ ;; XEmacs
+ (concat
+ (format "XEmacs/%d.%d" emacs-major-version emacs-minor-version)
+ (if (and (boundp 'emacs-beta-version) emacs-beta-version)
+ (format "beta%d" emacs-beta-version)
+ "")
+ (if (and (boundp 'xemacs-codename) xemacs-codename)
+ (concat " (" xemacs-codename ")")
+ "")
+ )
+ ;; not XEmacs
+ (concat
+ (format "Emacs/%d.%d" emacs-major-version emacs-minor-version)
+ (if (>= emacs-major-version 20)
+ (if (and (boundp 'enable-multibyte-characters)
+ enable-multibyte-characters)
+ "" ; Should return " (multibyte)"?
+ " (unibyte)"))
+ ))
+ ;; MULE[/VERSION]
+ (if (featurep 'mule)
+ (if (and (boundp 'mule-version) mule-version)
+ (concat " MULE/" mule-version)
+ " MULE") ; no mule-version
+ "") ; not Mule
+ ;; Meadow/VERSION
+ (if (featurep 'meadow)
+ (let ((version (Meadow-version)))
+ (if (string-match "\\`Meadow.\\([^ ]*\\)\\( (.*)\\)\\'" version)
+ (concat " Meadow/"
+ (match-string 1 version)
+ (match-string 2 version)
+ )
+ "Meadow")) ; unknown format
+ "") ; not Meadow
+ )))
+ (if message-user-agent
+ (concat message-user-agent " " user-agent)
+ user-agent)))
+
(defun message-generate-headers (headers)
"Prepare article HEADERS.
Headers already prepared in the buffer are not modified."
(To nil)
(Distribution (message-make-distribution))
(Lines (message-make-lines))
- (User-Agent message-user-agent)
+ (User-Agent (message-make-user-agent))
(Expires (message-make-expires))
(case-fold-search t)
header value elem)
(setq header (car elem)))
(setq header elem))
(when (or (not (re-search-forward
- (concat "^" (downcase (symbol-name header)) ":")
+ (concat "^"
+ (regexp-quote
+ (downcase
+ (if (stringp header)
+ header
+ (symbol-name header))))
+ ":")
nil t))
(progn
;; The header was found. We insert a space after the
(progn
;; This header didn't exist, so we insert it.
(goto-char (point-max))
- (insert (symbol-name header) ": " value "\n")
+ (insert (if (stringp header) header (symbol-name header))
+ ": " value "\n")
(forward-line -1))
;; The value of this header was empty, so we clear
;; totally and insert the new value.
(not (message-check-element 'sender))
(not (string=
(downcase
- (cadr (funcall gnus-extract-address-components
- from)))
+ (cadr (std11-extract-address-components from)))
(downcase secure-sender)))
(or (null sender)
(not
(string=
(downcase
- (cadr (funcall gnus-extract-address-components
- sender)))
+ (cadr (std11-extract-address-components sender)))
(downcase secure-sender)))))
(goto-char (point-min))
;; Rename any old Sender headers to Original-Sender.
(concat "*" type
(if to
(concat " to "
- (or (car (funcall gnus-extract-address-components to))
+ (or (car (std11-extract-address-components to))
to) "")
"")
(if (and group (not (string= group ""))) (concat " on " group) "")
(defun message-pop-to-buffer (name)
"Pop to buffer NAME, and warn if it already exists and is modified."
- (let ((buffer (get-buffer name)))
+ (let ((pop-up-frames pop-up-frames)
+ (special-display-buffer-names special-display-buffer-names)
+ (special-display-regexps special-display-regexps)
+ (same-window-buffer-names same-window-buffer-names)
+ (same-window-regexps same-window-regexps)
+ (buffer (get-buffer name)))
+ (if (or (and (featurep 'xemacs)
+ (not (eq 'tty (device-type))))
+ window-system)
+ (when message-use-multi-frames
+ (setq pop-up-frames t
+ special-display-buffer-names nil
+ special-display-regexps nil
+ same-window-buffer-names nil
+ same-window-regexps nil))
+ (setq pop-up-frames nil))
(if (and buffer
(buffer-name buffer))
(progn
(downcase sender)
(downcase (message-make-sender))))
(string-equal
- (downcase (cadr (funcall gnus-extract-address-components
- from)))
- (downcase (cadr (funcall gnus-extract-address-components
- (message-make-from))))))
+ (downcase (cadr (std11-extract-address-components
+ from)))
+ (downcase (cadr (std11-extract-address-components
+ (message-make-from))))))
(error "This article is not yours"))
;; Make control message.
(setq buf (set-buffer (get-buffer-create " *message cancel*")))
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
(interactive)
- (let ((cur (current-buffer))
- (sender (message-fetch-field "sender"))
- (from (message-fetch-field "from")))
+ (let ((cur (current-buffer)))
;; Check whether the user owns the article that is to be superseded.
- (unless (or (and sender
- (string-equal
- (downcase sender)
- (downcase (message-make-sender))))
- (string-equal
- (downcase (cadr (mail-extract-address-components from)))
- (downcase (cadr (mail-extract-address-components
- (message-make-from))))))
+ (unless (string-equal
+ (downcase (or (message-fetch-field "sender")
+ (cadr (std11-extract-address-components
+ (message-fetch-field "from")))))
+ (downcase (message-make-sender)))
(error "This article is not yours"))
;; Get a normal message buffer.
(message-pop-to-buffer (message-buffer-name "supersede"))
(let ((locals (save-excursion
(set-buffer buffer)
(buffer-local-variables)))
- (regexp "^\\(gnus\\|nn\\|message\\|user-\\(mail-address\\|full-name\\)\\)"))
+ (regexp "^gnus\\|^nn\\|^message"))
(mapcar
(lambda (local)
(when (and (consp local)
projects / elisp / gnus.git- / commitdiff