:group 'message-buffers
:type 'boolean)
+(defcustom message-kill-buffer-query-function 'yes-or-no-p
+ "*A function called to query the user whether to kill buffer anyway or not.
+If it is t, the buffer will be killed peremptorily."
+ :type '(radio (function-item yes-or-no-p)
+ (function-item y-or-n-p)
+ (function-item nnheader-Y-or-n-p)
+ (function :tag "Other" t))
+ :group 'message-buffers)
+
(defvar gnus-local-organization)
(defcustom message-user-organization
(or (and (boundp 'gnus-local-organization)
:group 'message-headers
:type 'boolean)
-(defcustom message-setup-hook
- '(message-maybe-setup-default-charset turn-on-mime-edit)
+(defcustom message-setup-hook '(turn-on-mime-edit)
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook."
:group 'message-various
(defvar message-postpone-actions nil
"A list of actions to be performed after postponing a message.")
(defvar message-original-frame nil)
+(defvar message-parameter-alist nil)
+(defvar message-startup-parameter-alist nil)
(define-widget 'message-header-lines 'text
"All header lines must be LFD terminated."
(let* ((inhibit-point-motion-hooks t)
(value (mail-fetch-field header nil (not not-all))))
(when value
- (nnheader-replace-chars-in-string value ?\n ? ))))
+ (while (string-match "\n[\t ]+" value)
+ (setq value (replace-match " " t t value)))
+ value)))
(defun message-narrow-to-field ()
"Narrow the buffer to the header on the current line."
(defun message-fetch-reply-field (header)
"Fetch FIELD from the message we're replying to."
- (when (and message-reply-buffer
- (buffer-name message-reply-buffer))
- (save-excursion
- (set-buffer message-reply-buffer)
- (message-fetch-field header))))
+ (let ((buffer (message-get-reply-buffer)))
+ (when (and buffer
+ (buffer-name buffer))
+ (save-excursion
+ (set-buffer buffer)
+ (message-fetch-field header)))))
(defun message-set-work-buffer ()
(if (get-buffer " *message work*")
(1+ max)))))
(message-sort-headers-1))))
+(defun message-eval-parameter (parameter)
+ (condition-case ()
+ (if (symbolp parameter)
+ (if (functionp parameter)
+ (funcall parameter)
+ (eval parameter))
+ parameter)
+ (error nil)))
+
+(defun message-get-reply-buffer ()
+ (message-eval-parameter message-reply-buffer))
+
+(defun message-get-original-reply-buffer ()
+ (message-eval-parameter
+ (cdr (assq 'original-buffer message-parameter-alist))))
+
\f
;;;
(define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
(define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
- (define-key message-mode-map "\t" 'message-tab))
+ (define-key message-mode-map "\t" 'message-tab)
+
+ (define-key message-mode-map "\C-xk" 'message-kill-buffer))
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
(setq message-sent-message-via nil)
(make-local-variable 'message-checksum)
(setq message-checksum nil)
+ (make-local-variable 'message-parameter-alist)
+ (setq message-parameter-alist
+ (copy-sequence message-startup-parameter-alist))
;;(when (fboundp 'mail-hist-define-keys)
;; (mail-hist-define-keys))
(when (string-match "XEmacs\\|Lucid" emacs-version)
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
(interactive "P")
- (let ((modified (buffer-modified-p)))
- (when (and message-reply-buffer
+ (let ((modified (buffer-modified-p))
+ (buffer (message-get-reply-buffer)))
+ (when (and buffer
message-cite-function)
- (gnus-copy-article-buffer)
- (setq message-reply-buffer gnus-article-copy)
- (delete-windows-on message-reply-buffer t)
- (insert-buffer message-reply-buffer)
+ (delete-windows-on buffer t)
+ (insert-buffer buffer)
(funcall message-cite-function)
(message-exchange-point-and-mark)
(unless (bolp)
"Kill the current buffer."
(interactive)
(when (or (not (buffer-modified-p))
- (yes-or-no-p "Message modified; kill anyway? "))
+ (eq t message-kill-buffer-query-function)
+ (funcall message-kill-buffer-query-function
+ "The buffer modified; kill anyway? "))
(let ((actions message-kill-actions)
(frame (selected-frame))
(org-frame message-original-frame))
(setq buffer-file-name nil)
(kill-buffer (current-buffer))
(message-do-actions actions)
- (message-delete-frame frame org-frame))))
+ (message-delete-frame frame org-frame)))
+ (message ""))
(defun message-delete-frame (frame org-frame)
"Delete frame for editing message."
(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?")
+ (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)
(delete-region (match-end 0)(std11-field-end))
(insert (concat " " (message-make-message-id)))
))
- (interactive)
(funcall message-send-mail-function))))
(funcall message-send-mail-function))
(kill-buffer tembuf))
(defvar mule-version)
(defvar emacs-beta-version)
(defvar xemacs-codename)
+(defvar gnus-inviolable-extended-version)
(defun message-make-user-agent ()
- "Return user-agent info."
- (let ((user-agent
- (or
- (if (eq message-encoding-buffer (current-buffer))
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (let ((case-fold-search t)
- (inhibit-read-only t)
- buffer-read-only start value)
- (when (and (not (re-search-forward
- "^Resent-User-Agent" nil t))
- (re-search-forward "^User-Agent:" nil t))
- (setq start (match-beginning 0)
- value (buffer-substring-no-properties
- (match-end 0) (std11-field-end)))
- (when (string-match "^[\n\t ]+" value)
- (setq value (substring value (match-end 0))))
- (when (string-match "[\n\t ]+$" value)
- (setq value
- (substring value 0 (match-beginning 0))))
- (unless (string-match
- (concat
- "^" (regexp-quote
- gnus-inviolable-extended-version))
- value)
- (delete-region start (1+ (point))))
- (if (string-equal "" value)
- nil
- value))))))
- (concat
- ;; SEMI: '("SEMI" "CODENAME" V1 V2 V3)
- (format "%s/%s (%s)"
- (nth 0 mime-user-interface-version)
- (mapconcat #'number-to-string
- (cdr (cdr mime-user-interface-version))
- ".")
- (nth 1 mime-user-interface-version))
- ;; FLIM: "FLIM VERSION - \"CODENAME\"[...]"
- (if (string-match
- "\\`\\([^ ]+\\) \\([^ ]+\\) - \"\\([^\"]+\\)\"\\(.*\\)\\'"
- mime-library-version-string)
- (format " %s/%s (%s%s)"
- (match-string 1 mime-library-version-string)
- (match-string 2 mime-library-version-string)
- (match-string 3 mime-library-version-string)
- (match-string 4 mime-library-version-string))
- " FLIM")
- "\n "
- ;; 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
- "Emacs/"
- (let ((versions (split-string emacs-version "\\.")))
- (mapconcat 'identity
- (if (> (length versions) 2)
- (nreverse (cdr (nreverse versions)))
- versions)
- "."))
- (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
- ))))
- (concat (or message-user-agent gnus-inviolable-extended-version)
- "\n " user-agent)))
+ "Return user-agent info if the value `message-user-agent' is non-nil. If the
+\"User-Agent\" field has already exist, it's value will be added in the return
+string."
+ (when message-user-agent
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ user-agent start p end)
+ (if (re-search-forward "^User-Agent:[\t ]*" nil t)
+ (progn
+ (setq start (match-beginning 0)
+ p (match-end 0)
+ end (std11-field-end)
+ user-agent (buffer-substring-no-properties p end))
+ (delete-region start (1+ end))
+ (concat message-user-agent " " user-agent))
+ message-user-agent)))))
(defun message-generate-headers (headers)
"Prepare article HEADERS.
(nconc message-buffer-list (list (current-buffer))))))
(defvar mc-modes-alist)
+(defvar message-get-reply-buffer-function nil)
(defun message-setup (headers &optional replybuffer actions)
(when (and (boundp 'mc-modes-alist)
(not (assq 'message-mode mc-modes-alist)))
mc-modes-alist))
(when actions
(setq message-send-actions actions))
- (setq message-reply-buffer replybuffer)
+ (setq message-reply-buffer
+ (or (cdr (assq 'reply-buffer message-parameter-alist))
+ replybuffer))
(goto-char (point-min))
;; Insert all the headers.
(mail-header-format
(run-hooks 'mime-edit-exit-hook)
))
-;;; XXX: currently broken; message-yank-original resets message-reply-buffer.
-(defun message-mime-insert-article (&optional message)
- (interactive)
+(defun message-mime-insert-article (&optional full-headers)
+ (interactive "P")
(let ((message-cite-function 'mime-edit-inserted-message-filter)
- (message-reply-buffer gnus-original-article-buffer)
- )
+ (message-reply-buffer (message-get-original-reply-buffer))
+ (start (point)))
(message-yank-original nil)
- ))
+ (save-excursion
+ (narrow-to-region (goto-char start)
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point-max)))
+ (goto-char (point-min))
+ (let ((message-included-forward-headers
+ (if full-headers "" message-included-forward-headers)))
+ (message-remove-header message-included-forward-headers t nil t))
+ (widen))))
(set-alist 'mime-edit-message-inserter-alist
'message-mode (function message-mime-insert-article))
projects / elisp / gnus.git- / blobdiff