--- /dev/null
+* tl
+
+ Version 7.01.5 \e$B$rE:IU$7$?!#\e(B
+
+
+* tm
+
+tm/tm-def.el
+----------------------------
+revision 7.2
+date: 1995/11/14 04:56:15; author: morioka; state: Exp; lines: +50 -1
+*-field-list \e$B$H\e(B *-field-regexp \e$B$rA`:n$9$k$?$a$N4X?t\e(B tm:add-fields \e$B$H4X\e(B
+\e$B?t\e(B tm:delete-fields \e$B$rDI2C$7$?!#\e(B
+----------------------------
+
+tm/tm-edit.el
+----------------------------
+revision 7.24
+date: 1995/11/14 05:04:22; author: morioka; state: Exp; lines: +21 -11
+(1) message/external-body \e$B$N\e(B access-type = ftp, anon-ftp \e$B$N;~$N\e(B mode
+ \e$B$r=$@5$7$?!#\e(B
+(2) \e$BJQ?t\e(B mime-editor/yank-ignored-field-list \e$B$r@_$1$?!#\e(B
+(3) \e$BJQ?t\e(B mime-editor/yank-ignored-fields-regexp \e$B$r\e(B
+ `mime-editor/yank-ignored-field-regexp' \e$B$K2~L>$7$?!#$J$*!"$3$NJQ?t\e(B
+ \e$B$OD>@\A`:n$;$:$K!"\e(Btm:add-fields \e$B$+\e(B tm:delete-fields \e$B$r;H$C$FA`:n$9\e(B
+ \e$B$k$3$H$K$9$k!#\e(B
+(4) \e$BDj?t\e(B mime-editor/split-ignored-fields-regexp \e$B$r\e(B
+ `mime-editor/split-ignored-field-regexp' \e$B$K2~L>$7$?!#\e(B
+(5) \e$BJQ?t\e(B mime-editor/split-blind-fields-regexp \e$B$r\e(B
+ `mime-editor/split-blind-field-regexp' \e$B$K2~L>$7$?!#\e(B
+----------------------------
+
+tm/tm-view.el
+----------------------------
+revision 7.24
+date: 1995/11/14 06:14:37; author: morioka; state: Exp; lines: +7 -8
+(1) \e$BJQ?t\e(B mime-viewer/ignored-field-list \e$B$NMWAG$r@55,I=8=$H$7$?!#\e(B
+(2) \e$B4X?t\e(B mime/viewer-mode \e$B$GJQ?t\e(B mime-viewer/ignored-field-regexp \e$B$r@_\e(B
+ \e$BDj$7D>$9$N$O$d$a$?!#!JJQ?t\e(B mime-viewer/ignored-field-list \e$B$HJQ?t\e(B
+ mime-viewer/ignored-field-regexp \e$B$OD>@\@_Dj$;$:!"4X?t\e(B
+ tm:add-fields \e$B$H4X?t\e(B tm:delete-fields \e$B$r;H$&$3$H!K\e(B
+----------------------------
+
+tm/tm-vm.el
+----------------------------
+revision 7.4
+date: 1995/11/14 04:52:30; author: morioka; state: Exp; lines: +324 -53
+(1) \e$BJQ?t\e(B tm-vm/use-tm-patch \e$B$r@_$1!"$3$l$,\e(B nil \e$B$N>l9g$O<+NO$G\e(B
+ encoded-word \e$B$r\e(B decode \e$B$9$k@_Dj$r9T$&$h$&$K$7$?!#\e(B
+(2) \e$BJQ?t\e(B tm-vm/automatic-mime-preview \e$B$r@_$1!"$3$l$,\e(B t \e$B$N;~\e(B automatic
+ MIME preview \e$B$r9T$&$h$&$K$7$?!#$^$?!"\e(BM-t \e$B$K4X?t\e(B
+ tm-vm/toggle-preview-mode \e$B$r3d$jEv$F$?!#\e(B
+(3) \e$B4X?t\e(B tm-vm/forward-message, \e$B4X?t\e(B tm-vm/send-digest \e$B$r@_$1!"\e(B
+ \e$B4X?t\e(B vm-forward-message, \e$B4X?t\e(B vm-send-digest \e$B$HCV$-49$($?!#$^$?!"\e(B
+ mime-setup.el \e$B$,\e(B load \e$B$5$l$?>l9g$O!"JQ?t\e(B
+ vm-forwarding-digest-type, \e$BJQ?t\e(B vm-digest-send-type \e$B$NCM$r\e(B
+ "rfc1522" \e$B$K$9$k$h$&$K$7$?!#\e(B
+----------------------------
+
+
+* tm/mh-e
+
+ Version 7.17 \e$B$rE:IU$7$?!#\e(B
+
+tm/mh-e/tm-mh-e.el
+----------------------------
+revision 7.17
+date: 1995/11/14 06:29:27; author: morioka; state: Exp; lines: +14 -13
+\e$BJQ?t\e(B tm-mh-e/decode-all \e$B$r\e(B `tm-mh-e/automatic-mime-preview' \e$B$K2~L>$7$?!#\e(B
+----------------------------
;;;
(defconst tm-mh-e/RCS-ID
- "$Id: tm-mh-e.el,v 7.16 1995/11/11 13:02:40 morioka Exp $")
+ "$Id: tm-mh-e.el,v 7.17 1995/11/14 06:29:27 morioka Exp $")
(defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID))
;;; @ variable
;;;
-(defvar tm-mh-e/decode-all t
- "*If t, decode all of the message. Otherwise decode header only.")
+(defvar tm-mh-e/automatic-mime-preview t
+ "If non-nil, show MIME processed message.")
-(defvar tm-mh-e/decode-encoded-word t)
+(defvar tm-mh-e/decode-encoded-word t
+ "If non-nil, decode encoded-word when it is not MIME preview mode.")
;;; @ functions
(defun mh-display-msg (msg-num folder &optional show-buffer mode)
(or mode
- (setq mode tm-mh-e/decode-all)
+ (setq mode tm-mh-e/automatic-mime-preview)
)
;; Display message NUMBER of FOLDER.
;; Sets the current buffer to the show buffer.
(defun tm-mh-e/view-message (&optional msg)
"MIME decode and play this message."
(interactive)
- (if (or (null tm-mh-e/decode-all)
+ (if (or (null tm-mh-e/automatic-mime-preview)
(null (get-buffer mh-show-buffer))
(save-excursion
(set-buffer mh-show-buffer)
(not (eq major-mode 'mime/viewer-mode))
))
- (let ((tm-mh-e/decode-all t))
+ (let ((tm-mh-e/automatic-mime-preview t))
(mh-invalidate-show-buffer)
(mh-show-msg msg)
))
"Toggle MIME processing mode.
With arg, turn MIME processing on if arg is positive."
(interactive "P")
- (setq tm-mh-e/decode-all
+ (setq tm-mh-e/automatic-mime-preview
(if (null arg)
- (not tm-mh-e/decode-all)
+ (not tm-mh-e/automatic-mime-preview)
arg))
(save-excursion
(set-buffer mh-show-buffer)
- (if (null tm-mh-e/decode-all)
+ (if (null tm-mh-e/automatic-mime-preview)
(if (and mime::preview/article-buffer
(get-buffer mime::preview/article-buffer))
(kill-buffer mime::preview/article-buffer)
(defun tm-mh-e/raw-display ()
(interactive)
(mh-invalidate-show-buffer)
- (let (tm-mh-e/decode-all
+ (let (tm-mh-e/automatic-mime-preview
tm-mh-e/decode-encoded-word)
(mh-header-display)
))
(let ((name (buffer-name buf)))
(substring name 5)
))
- (if (not tm-mh-e/decode-all)
+ (if (not tm-mh-e/automatic-mime-preview)
(mh-invalidate-show-buffer)
)
(mh-show (mh-get-msg-num t))
'mh-show-mode
(function
(lambda ()
- (let ((tm-mh-e/decode-all t))
+ (let ((tm-mh-e/automatic-mime-preview t))
(tm-mh-e/show)
))))
)))
;; LCD Archive Entry:
;; mime|Masanobu UMEDA|umerin@mse.kyutech.ac.jp|
;; Simple MIME Composer|
-;; $Date: 1995/11/11 12:48:30 $|$Revision: 7.23 $|~/misc/mime.el.Z|
+;; $Date: 1995/11/14 05:04:22 $|$Revision: 7.24 $|~/misc/mime.el.Z|
;;; Code:
;;;
(defconst mime-editor/RCS-ID
- "$Id: tm-edit.el,v 7.23 1995/11/11 12:48:30 morioka Exp $")
+ "$Id: tm-edit.el,v 7.24 1995/11/14 05:04:22 morioka Exp $")
(defconst mime-editor/version (get-version-string mime-editor/RCS-ID))
("site" "ftp.jaist.ac.jp" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp")
("directory" "/pub/GNU/elisp/mime")
("name")
- ("mode" "binary" "ascii"))
- ("ftp" ("site") ("directory") ("name") ("mode" "binary" "ascii"))
+ ("mode" "image" "ascii" "local8"))
+ ("ftp"
+ ("site")
+ ("directory")
+ ("name")
+ ("mode" "image" "ascii" "local8"))
("tftp" ("site") ("name"))
("afs" ("site") ("name"))
("local-file" ("site") ("name"))
;;; @@ about message inserting
;;;
-(defvar mime-editor/yank-ignored-fields-regexp
- "^\\(Received\\|X-UIDL\\|Sender\\|Approved\\|Path\\):")
+(defvar mime-editor/yank-ignored-field-list
+ '("Received" "Sender" "Approved" "Path" "Status" "X-VM-.*" "X-UIDL")
+ "Delete these fields from original message when it is inserted
+as message/rfc822 part.
+Each elements are regexp of field-name. [tm-edit.el]")
+
+(defvar mime-editor/yank-ignored-field-regexp
+ (apply (function regexp-or) mime-editor/yank-ignored-field-list))
(defvar mime-editor/message-inserter-alist nil)
(defvar mime-editor/mail-inserter-alist nil)
(defvar mime-editor/message-max-length-alist
'((news-reply-mode . 500)))
-(defconst mime-editor/split-ignored-fields-regexp
+(defconst mime-editor/split-ignored-field-regexp
"\\(^Content-\\|^Subject:\\|^Mime-Version:\\)")
-(defvar mime-editor/split-blind-fields-regexp
+(defvar mime-editor/split-blind-field-regexp
"\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)")
(defvar mime-editor/message-default-sender-alist
)
(goto-char header-start)
(while (and (re-search-forward
- mime-editor/yank-ignored-fields-regexp nil t)
+ mime-editor/yank-ignored-field-regexp nil t)
(setq beg (match-beginning 0))
(setq end (1+ (rfc822/field-end)))
)
"@" (system-name) "\"")))
(run-hooks 'mime-editor/before-split-hook)
(let* ((header (rfc822/get-header-string-except
- mime-editor/split-ignored-fields-regexp separator))
+ mime-editor/split-ignored-field-regexp separator))
(subject (mail-fetch-field "subject"))
(total (+ (/ lines mime-editor/message-max-length)
(if (> (mod lines mime-editor/message-max-length) 0)
))
(goto-char (point-min))
(while (re-search-forward
- mime-editor/split-blind-fields-regexp nil t)
+ mime-editor/split-blind-field-regexp nil t)
(delete-region (match-beginning 0)
(let ((e (rfc822/field-end)))
(if (< e (point-max))
;;;
;;; Author: MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
;;; and Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
-;;; modified by SHIONO <jun@p5.nm.fujitsu.co.jp>,
+;;; modified by SHIONO Jun'ichi <jun@p5.nm.fujitsu.co.jp>,
;;; Steinar Bang <steinarb@falch.no>,
;;; Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>,
;;; and MORIOKA Tomohiko <morioka@jaist.ac.jp>
;;;
;;; This file is part of tm (Tools for MIME).
;;;
-;;; This version is tested under VM-5.76 with tm-6.20.
-;;;
;;; Plese insert (require 'tm-vm) in your .vm or .emacs.
;;;
(require 'vm)
(defconst tm-vm/RCS-ID
- "$Id: tm-vm.el,v 7.3 1995/10/28 06:00:09 morioka Exp $")
+ "$Id: tm-vm.el,v 7.4 1995/11/14 04:52:30 morioka Exp $")
(defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
(define-key vm-mode-map "Z" 'tm-vm/view-message)
(define-key vm-mode-map "T" 'tm-vm/decode-message-header)
-
-(set-alist 'mime-viewer/quitting-method-alist
- 'vm-mode
- 'tm-vm/quit-view-message)
-
-(set-alist 'mime-viewer/quitting-method-alist
- 'vm-virtual-mode
- 'tm-vm/quit-view-message)
+(define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode)
;;; @ for MIME encoded-words
;;;
-;; If you don't use tiny-mime patch for VM (by RIKITAKE Kenji
-;; <kenji@reseau.toyonaka.osaka.jp>), please use following definition:
-
-;; (setq vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c, %I\"%UA\"\n")
-;; (defun vm-summary-function-A (m)
-;; (mime-ewords/decode-string (vm-su-subject m)))
+(defvar tm-vm/use-tm-patch nil
+ "Does not decode encoded-words in summary buffer if it is t.
+If you use tiny-mime patch for VM (by RIKITAKE Kenji
+<kenji@reseau.toyonaka.osaka.jp>), please set it t [tm-vm.el]")
-;;; @ functions
+(or tm-vm/use-tm-patch
+ (progn
;;;
+;; by Steinar Bang <steinarb@falch.no>
+(setq vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c, %I\"%UA\"\n")
-(defun tm-vm/quit-view-message ()
- "Quit MIME-viewer and go back to VM.
-This function is called by `mime-viewer/quit' command via
-`mime-viewer/quitting-method-alist'."
- (mime-viewer/kill-buffer)
- (if (get-buffer mime/output-buffer-name)
- (bury-buffer mime/output-buffer-name))
- (vm-select-folder-buffer)
- (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content)
- '(mime-viewer/quit reading-message)))
+(defvar tm-vm/chop-full-name-function 'tm-vm/default-chop-full-name)
+(setq vm-chop-full-name-function tm-vm/chop-full-name-function)
-(defun tm-vm/view-message ()
- "Decode and view MIME encoded message, under VM."
- (interactive)
- (vm-follow-summary-cursor)
- (vm-select-folder-buffer)
- (vm-check-for-killed-summary)
- (vm-error-if-folder-empty)
- (vm-display (current-buffer) t '(tm-vm/view-message)
- '(tm-vm/view-mesage reading-message))
- (let* ((mp (car vm-message-pointer))
- (ct (vm-get-header-contents mp "Content-Type:"))
- (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
- (exposed (= (point-min) (vm-start-of mp))))
- (save-restriction
- (vm-widen-page)
- ;; vm-widen-page hides exposed header if pages are delimited.
- ;; So, here we expose it again.
- (if exposed
- (narrow-to-region (vm-start-of mp) (point-max)))
- (select-window (vm-get-buffer-window (current-buffer)))
- (mime/viewer-mode nil
- (mime/parse-Content-Type (or ct ""))
- cte)
- )))
+(defun tm-vm/default-chop-full-name (address)
+ (let* ((ret (vm-default-chop-full-name address))
+ (full-name (car ret))
+ )
+ (if (stringp full-name)
+ (cons (mime-eword/decode-string full-name)
+ (cdr ret))
+ ret)))
+
+;; by Steinar Bang <steinarb@falch.no>
+(defun vm-summary-function-A (m)
+ (mime-eword/decode-string (vm-su-subject m))
+ )
+;;;
+))
(defun tm-vm/decode-message-header (&optional count)
"Decode MIME header of current message through tiny-mime.
(setq vbufs (cdr vbufs))))))
+;;; @ automatic MIME preview
+;;;
+
+(defvar tm-vm/automatic-mime-preview t
+ "If non-nil, show MIME processed article.")
+
+(defun tm-vm/preview-current-message ()
+ (if tm-vm/automatic-mime-preview
+ (let ((win (selected-window)))
+ (vm-display (current-buffer) t
+ '(tm-vm/preview-current-message
+ vm-preview-current-message)
+ '(tm-vm/preview-current-message reading-message))
+ (mime/viewer-mode)
+ (select-window win)
+ )
+ ))
+
+(add-hook 'vm-select-message-hook 'tm-vm/preview-current-message)
+(add-hook 'vm-visit-folder-hook 'tm-vm/preview-current-message)
+
+(defun tm-vm/scroll-forward ()
+ (interactive)
+ (if tm-vm/automatic-mime-preview
+ (let ((win (get-buffer-window
+ (save-excursion
+ (set-buffer vm-mail-buffer)
+ mime::article/preview-buffer)))
+ (the-win (selected-window))
+ np)
+ (if win
+ (progn
+ (select-window win)
+ (setq np (save-excursion
+ (forward-line (window-height))
+ (point)
+ ))
+ )
+ (vm-scroll-forward)
+ (switch-to-buffer mime::article/preview-buffer)
+ (setq win (selected-window))
+ (setq np (point-min))
+ )
+ (if (eq np (point-max))
+ (progn
+ (select-window the-win)
+ (vm-next-message)
+ )
+ (set-window-start (selected-window) np)
+ (select-window the-win)
+ ))
+ (vm-scroll-forward)
+ ))
+
+(defun tm-vm/scroll-backward ()
+ (interactive)
+ (if tm-vm/automatic-mime-preview
+ (let ((win (get-buffer-window
+ (save-excursion
+ (set-buffer vm-mail-buffer)
+ mime::article/preview-buffer)))
+ (the-win (selected-window))
+ np)
+ (if win
+ (progn
+ (select-window win)
+ (setq np (save-excursion
+ (forward-line (- (window-height)))
+ (point)
+ ))
+ (if (eq np (window-start))
+ (progn
+ (select-window the-win)
+ (vm-previous-message)
+ )
+ (set-window-start (selected-window) np)
+ (select-window the-win)
+ ))
+ (vm-scroll-forward)
+ (switch-to-buffer mime::article/preview-buffer)
+ (setq win (selected-window))
+ (select-window the-win)
+ ))
+ (vm-scroll-backward)
+ ))
+
+(substitute-key-definition 'vm-scroll-forward
+ 'tm-vm/scroll-forward vm-mode-map)
+(substitute-key-definition 'vm-scroll-backward
+ 'tm-vm/scroll-backward vm-mode-map)
+
+(defun tm-vm/toggle-preview-mode ()
+ (interactive)
+ (if tm-vm/automatic-mime-preview
+ (progn
+ (setq tm-vm/automatic-mime-preview nil)
+ (vm-select-folder-buffer)
+ (vm-display (current-buffer) t
+ '(tm-vm/toggle-preview-mode)
+ '(tm-vm/toggle-preview-mode reading-message))
+ )
+ (setq tm-vm/automatic-mime-preview t)
+ (let ((win (selected-window)))
+ (vm-select-folder-buffer)
+ (save-window-excursion
+ (let* ((mp (car vm-message-pointer))
+ (ct (vm-get-header-contents mp "Content-Type:"))
+ (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
+ )
+ (mime/viewer-mode nil (mime/parse-Content-Type (or ct "")) cte)
+ ))
+ (vm-display mime::article/preview-buffer t
+ '(tm-vm/toggle-preview-mode)
+ '(tm-vm/toggle-preview-mode reading-message))
+ (select-window win)
+ )
+ ))
+
+
+;;; @ for tm-view
+;;;
+
+(defun tm-vm/quit-view-message ()
+ "Quit MIME-viewer and go back to VM.
+This function is called by `mime-viewer/quit' command via
+`mime-viewer/quitting-method-alist'."
+ (mime-viewer/kill-buffer)
+ (if (get-buffer mime/output-buffer-name)
+ (bury-buffer mime/output-buffer-name))
+ (vm-select-folder-buffer)
+ (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content)
+ '(mime-viewer/quit reading-message)))
+
+(defun tm-vm/view-message ()
+ "Decode and view MIME encoded message, under VM."
+ (interactive)
+ (vm-follow-summary-cursor)
+ (vm-select-folder-buffer)
+ (vm-check-for-killed-summary)
+ (vm-error-if-folder-empty)
+ (vm-display (current-buffer) t '(tm-vm/view-message)
+ '(tm-vm/view-mesage reading-message))
+ (let* ((mp (car vm-message-pointer))
+ (ct (vm-get-header-contents mp "Content-Type:"))
+ (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
+ (exposed (= (point-min) (vm-start-of mp))))
+ (save-restriction
+ (vm-widen-page)
+ ;; vm-widen-page hides exposed header if pages are delimited.
+ ;; So, here we expose it again.
+ (if exposed
+ (narrow-to-region (vm-start-of mp) (point-max)))
+ (select-window (vm-get-buffer-window (current-buffer)))
+ (mime/viewer-mode nil
+ (mime/parse-Content-Type (or ct ""))
+ cte)
+ )))
+
+(set-alist 'mime-viewer/quitting-method-alist
+ 'vm-mode
+ 'tm-vm/quit-view-message)
+
+(set-alist 'mime-viewer/quitting-method-alist
+ 'vm-virtual-mode
+ 'tm-vm/quit-view-message)
+
+
;;; @ for tm-partial
;;;
;;; @ for tm-edit
;;;
+;; 1995/11/9 by Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>
+;; (c.f. [tm ML:1075])
+(defun tm-vm/insert-message (&optional message)
+ (interactive)
+ (let* (mail-yank-hooks
+ (mail-citation-hook '(mime-editor/inserted-message-filter))
+ (mail-reply-buffer vm-mail-buffer)
+ )
+ (if (null message)
+ (call-interactively 'vm-yank-message)
+ (vm-yank-message message))
+ ))
+
+
+;;; @@ for multipart/digest
+;;;
+
+(defun tm-vm/enclose-messages (mlist)
+ "Enclose the messages in MLIST as multipart/digest.
+The resulting digest is inserted at point in the current buffer.
+
+MLIST should be a list of message structs (real or virtual).
+These are the messages that will be enclosed."
+ (if mlist
+ (let (m)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (while mlist
+ (setq m (vm-real-message-of (car mlist)))
+ (mime-editor/insert-tag "message" "rfc822")
+ (tm-vm/insert-message m)
+ (goto-char (point-max))
+ (setq mlist (cdr mlist)))
+ (mime-editor/enclose-digest-region (point-min) (point-max))
+ ))))
+
+(defun tm-vm/forward-message ()
+ "Forward the current message to one or more recipients.
+You will be placed in a Mail mode buffer as you would with a
+reply, but you must fill in the To: header and perhaps the
+Subject: header manually."
+ (interactive)
+ (if (not (equal vm-forwarding-digest-type "rfc1521"))
+ (vm-forward-message)
+ (vm-follow-summary-cursor)
+ (vm-select-folder-buffer)
+ (vm-check-for-killed-summary)
+ (vm-error-if-folder-empty)
+ (if (eq last-command 'vm-next-command-uses-marks)
+ (let ((vm-digest-send-type vm-forwarding-digest-type))
+ (setq this-command 'vm-next-command-uses-marks)
+ (command-execute 'tm-vm/send-digest))
+ (let ((dir default-directory)
+ (mp vm-message-pointer))
+ (save-restriction
+ (widen)
+ (vm-mail-internal
+ (format "forward of %s's note re: %s"
+ (vm-su-full-name (car vm-message-pointer))
+ (vm-su-subject (car vm-message-pointer)))
+ nil
+ (and vm-forwarding-subject-format
+ (let ((vm-summary-uninteresting-senders nil))
+ (vm-sprintf 'vm-forwarding-subject-format (car mp)))))
+ (make-local-variable 'vm-forward-list)
+ (setq vm-system-state 'forwarding
+ vm-forward-list (list (car mp))
+ default-directory dir)
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil 0)
+ (tm-vm/enclose-messages vm-forward-list)
+ (mail-position-on-field "To"))
+ ;; (run-hooks 'tm-vm/forward-message-hook) ; Is it necessary?
+ (run-hooks 'vm-mail-mode-hook)))))
+
+(defun tm-vm/send-digest (&optional prefix)
+ "Send a digest of all messages in the current folder to recipients.
+The type of the digest is specified by the variable vm-digest-send-type.
+You will be placed in a Mail mode buffer as is usual with replies, but you
+must fill in the To: and Subject: headers manually.
+
+If invoked on marked messages (via vm-next-command-uses-marks),
+only marked messages will be put into the digest."
+ (interactive "P")
+ (if (not (equal vm-digest-send-type "rfc1521"))
+ (vm-send-digest prefix)
+ (vm-select-folder-buffer)
+ (vm-check-for-killed-summary)
+ (vm-error-if-folder-empty)
+ (let ((dir default-directory)
+ (mlist (if (eq last-command 'vm-next-command-uses-marks)
+ (vm-select-marked-or-prefixed-messages 0)
+ vm-message-list)))
+ (save-restriction
+ (widen)
+ (vm-mail-internal (format "digest from %s" (buffer-name)))
+ (setq vm-system-state 'forwarding
+ default-directory dir)
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator)
+ "\n"))
+ (goto-char (match-end 0))
+ (vm-unsaved-message "Building %s digest..." vm-digest-send-type)
+ (tm-vm/enclose-messages mlist)
+ (mail-position-on-field "To")
+ (message "Building %s digest... done" vm-digest-send-type)))
+ ;; (run-hooks 'tm-vm/send-digest-hook) ; Is it necessary?
+ (run-hooks 'vm-mail-mode-hook)))
+
+
+;;; @@ setting
+;;;
+
+(substitute-key-definition 'vm-forward-message
+ 'tm-vm/forward-message vm-mode-map)
+(substitute-key-definition 'vm-send-digest
+ 'tm-vm/send-digest vm-mode-map)
+
+(call-after-loaded
+ 'tm-edit
+ (function
+ (lambda ()
+ (set-alist 'mime-editor/message-inserter-alist
+ 'mail-mode (function tm-vm/insert-message))
+ )))
+
(call-after-loaded
'mime-setup
(function
(lambda ()
(remove-hook 'mail-mode-hook 'mime/editor-mode)
(add-hook 'vm-mail-mode-hook 'mime/editor-mode)
+ (setq vm-forwarding-digest-type "rfc1521")
+ (setq vm-digest-send-type "rfc1521")
)))
projects / elisp / tm.git / commitdiff