;;; Rob Kooper <kooper@cc.gatech.edu>
;;; Maintainer: KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
;;; Created: 1994/10/29
-;;; Version: $Revision: 7.52 $
+;;; Version: $Revision: 7.54 $
;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
;;;
;;; This file is part of tm (Tools for MIME).
(require 'vm)
(defconst tm-vm/RCS-ID
- "$Id: tm-vm.el,v 7.52 1996/04/19 18:49:19 shuhei-k Exp $")
+ "$Id: tm-vm.el,v 7.54 1996/06/12 23:46:24 shuhei-k Exp $")
(defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
(define-key vm-mode-map "Z" 'tm-vm/view-message)
))
(defun tm-vm/decode-message-header (&optional count)
- "Decode MIME header of current message through tiny-mime.
+ "Decode MIME header of current message.
Numeric prefix argument COUNT means to decode the current message plus
the next COUNT-1 messages. A negative COUNT means decode the current
message and the previous COUNT-1 messages.
(require 'vm-reply)
-(defun vm-yank-message (message)
+(defun vm-yank-message (&optional message)
"Yank message number N into the current buffer at point.
When called interactively N is always read from the minibuffer. When
called non-interactively the first argument is expected to be a
prompt
(last-command last-command)
(this-command this-command))
- (save-excursion
- (vm-select-folder-buffer)
- (setq default (and vm-message-pointer
- (vm-number-of (car vm-message-pointer)))
- prompt (if default
- (format "Yank message number: (default %s) "
- default)
- "Yank message number: "))
- (while (zerop result)
- (setq result (read-string prompt))
- (and (string= result "") default (setq result default))
- (setq result (string-to-int result)))
- (if (null (setq mp (nthcdr (1- result) vm-message-list)))
- (error "No such message.")))
- (car mp))))
- (if (not (bufferp vm-mail-buffer))
- (error "This is not a VM Mail mode buffer."))
- (if (null (buffer-name vm-mail-buffer))
- (error "The folder buffer containing message %d has been killed."
- (vm-number-of message)))
- (vm-display nil nil '(vm-yank-message) '(vm-yank-message composing-message))
- (setq message (vm-real-message-of message))
- (let ((b (current-buffer)) (start (point)) end)
- (save-restriction
- (widen)
- (save-excursion
- (set-buffer (vm-buffer-of message))
- (let* ((mbuf (current-buffer))
- (pbuf (and mime::article/preview-buffer
- (get-buffer mime::article/preview-buffer)))
- (pwin (and pbuf (vm-get-visible-buffer-window pbuf))))
- (if pwin
- (if running-xemacs
- (let ((tmp (generate-new-buffer "tm-vm/tmp")))
- (set-buffer pbuf)
- (append-to-buffer tmp (point-min) (point-max))
- (set-buffer tmp)
- (map-extents
- '(lambda (ext maparg)
- (set-extent-property ext 'begin-glyph nil)))
- (append-to-buffer b (point-min) (point-max))
- (setq end (vm-marker (+ start (length (buffer-string))) b))
- (kill-buffer tmp))
- (set-buffer pbuf)
- (append-to-buffer b (point-min) (point-max))
- (setq end (vm-marker (+ start (length (buffer-string))) b)))
- (save-restriction
- (widen)
- (append-to-buffer
- b (vm-headers-of message) (vm-text-end-of message))
- (setq end
- (vm-marker (+ start (- (vm-text-end-of message)
- (vm-headers-of message))) b))))))
- (push-mark end)
- (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
- (mail-yank-hooks (run-hooks 'mail-yank-hooks))
- (t (vm-mail-yank-default message))))))
+ (if (bufferp vm-mail-buffer)
+ (save-excursion
+ (vm-select-folder-buffer)
+ (setq default (and vm-message-pointer
+ (vm-number-of (car vm-message-pointer)))
+ prompt (if default
+ (format "Yank message number: (default %s) "
+ default)
+ "Yank message number: "))
+ (while (zerop result)
+ (setq result (read-string prompt))
+ (and (string= result "") default (setq result default))
+ (setq result (string-to-int result)))
+ (if (null (setq mp (nthcdr (1- result) vm-message-list)))
+ (error "No such message."))
+ (car mp))
+ nil))))
+ (if (null message)
+ (if mail-reply-buffer
+ (tm-vm/yank-content)
+ (error "This is not a VM Mail mode buffer."))
+ (if (null (buffer-name vm-mail-buffer))
+ (error "The folder buffer containing message %d has been killed."
+ (vm-number-of message)))
+ (vm-display nil nil '(vm-yank-message)
+ '(vm-yank-message composing-message))
+ (setq message (vm-real-message-of message))
+ (let ((b (current-buffer)) (start (point)) end)
+ (save-restriction
+ (widen)
+ (save-excursion
+ (set-buffer (vm-buffer-of message))
+ (let* ((mbuf (current-buffer))
+ (pbuf (and mime::article/preview-buffer
+ (get-buffer mime::article/preview-buffer)))
+ (pwin (and pbuf (vm-get-visible-buffer-window pbuf))))
+ (if pwin
+ (if running-xemacs
+ (let ((tmp (generate-new-buffer "tm-vm/tmp")))
+ (set-buffer pbuf)
+ (append-to-buffer tmp (point-min) (point-max))
+ (set-buffer tmp)
+ (map-extents
+ '(lambda (ext maparg)
+ (set-extent-property ext 'begin-glyph nil)))
+ (append-to-buffer b (point-min) (point-max))
+ (setq end (vm-marker
+ (+ start (length (buffer-string))) b))
+ (kill-buffer tmp))
+ (set-buffer pbuf)
+ (append-to-buffer b (point-min) (point-max))
+ (setq end (vm-marker
+ (+ start (length (buffer-string))) b)))
+ (save-restriction
+ (widen)
+ (append-to-buffer
+ b (vm-headers-of message) (vm-text-end-of message))
+ (setq end
+ (vm-marker (+ start (- (vm-text-end-of message)
+ (vm-headers-of message))) b))))))
+ (push-mark end)
+ (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
+ (mail-yank-hooks (run-hooks 'mail-yank-hooks))
+ (t (vm-mail-yank-default message)))
+ ))
+ ))
\f
;;; @ for tm-view
;;;
+;;; based on vm-do-reply [vm-reply.el]
+(defun tm-vm/do-reply (buf to-all include-text)
+ (save-excursion
+ (set-buffer buf)
+ (let ((dir default-directory)
+ to cc subject mp in-reply-to references newsgroups)
+ (cond ((setq to
+ (let ((reply-to (rfc822/get-field-body "Reply-To")))
+ (if (vm-ignored-reply-to reply-to)
+ nil
+ reply-to))))
+ ((setq to (rfc822/get-field-body "From")))
+ ;; (t (error "No From: or Reply-To: header in message"))
+ )
+ (if to-all
+ (setq cc (delq nil (cons cc (rfc822/get-field-bodies '("To" "Cc"))))
+ cc (mapconcat 'identity cc ","))
+ )
+ (setq subject (rfc822/get-field-body "Subject"))
+ (and subject vm-reply-subject-prefix
+ (let ((case-fold-search t))
+ (not
+ (equal
+ (string-match (regexp-quote vm-reply-subject-prefix)
+ subject)
+ 0)))
+ (setq subject (concat vm-reply-subject-prefix subject)))
+ (setq in-reply-to (rfc822/get-field-body "Message-Id")
+ references (nconc
+ (rfc822/get-field-bodies '("References" "In-Reply-To"))
+ (list in-reply-to))
+ newsgroups (list (or (and to-all
+ (rfc822/get-field-body "Followup-To"))
+ (rfc822/get-field-body "Newsgroups"))))
+ (setq to (vm-parse-addresses to)
+ cc (vm-parse-addresses cc))
+ (if vm-reply-ignored-addresses
+ (setq to (vm-strip-ignored-addresses to)
+ cc (vm-strip-ignored-addresses cc)))
+ (setq to (vm-delete-duplicates to nil t))
+ (setq cc (vm-delete-duplicates
+ (append (vm-delete-duplicates cc nil t)
+ to (copy-sequence to))
+ t t))
+ (and to (setq to (mapconcat 'identity to ",\n ")))
+ (and cc (setq cc (mapconcat 'identity cc ",\n ")))
+ (and (null to) (setq to cc cc nil))
+ (setq references (delq nil references)
+ references (mapconcat 'identity references " ")
+ references (vm-parse references "[^<]*\\(<[^>]+>\\)")
+ references (vm-delete-duplicates references)
+ references (if references (mapconcat 'identity references "\n\t")))
+ (setq newsgroups (delq nil newsgroups)
+ newsgroups (mapconcat 'identity newsgroups ",")
+ newsgroups (vm-parse newsgroups "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
+ newsgroups (vm-delete-duplicates newsgroups)
+ newsgroups (if newsgroups (mapconcat 'identity newsgroups ",")))
+ (vm-mail-internal
+ (if to
+ (format "reply to %s%s"
+ (rfc822/full-name-string
+ (car (rfc822/parse-address
+ (rfc822/lexical-analyze to))))
+ (if cc ", ..." "")))
+ to subject in-reply-to cc references newsgroups)
+ (setq mail-reply-buffer buf
+ ;; vm-system-state 'replying
+ default-directory dir))
+ (if include-text
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil 0))
+ (forward-char 1)
+ (tm-vm/yank-content)))
+ (run-hooks 'vm-reply-hook)
+ (run-hooks 'vm-mail-mode-hook)
+ ))
+
+(defun tm-vm/following-method (buf)
+ (tm-vm/do-reply buf 'to-all 'include-text)
+ )
+
+(defun tm-vm/yank-content ()
+ (interactive)
+ (let ((this-command 'vm-yank-message))
+ (vm-display nil nil '(vm-yank-message)
+ '(vm-yank-message composing-message))
+ (save-restriction
+ (narrow-to-region (point)(point))
+ (insert-buffer mail-reply-buffer)
+ (goto-char (point-max))
+ (push-mark)
+ (goto-char (point-min)))
+ (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
+ (mail-yank-hooks (run-hooks 'mail-yank-hooks))
+ (t (mail-indent-citation)))
+ ))
+
+(set-alist 'mime-viewer/following-method-alist
+ 'vm-mode
+ (function tm-vm/following-method))
+(set-alist 'mime-viewer/following-method-alist
+ 'vm-virtual-mode
+ (function tm-vm/following-method))
+
+
(defun tm-vm/quit-view-message ()
"Quit MIME-viewer and go back to VM.
This function is called by `mime-viewer/quit' command via
(autoload 'tm-mail/insert-message "tm-mail")
(set-alist 'mime-editor/message-inserter-alist
'mail-mode (function tm-mail/insert-message))
+ (set-alist 'mime-editor/split-message-sender-alist
+ 'mail-mode (function
+ (lambda ()
+ (interactive)
+ (sendmail-send-it)
+ )))
(if (and (string-match "XEmacs\\|Lucid" emacs-version)
tm-vm/use-xemacs-popup-menu)
(add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
projects / elisp / tm.git / blobdiff