;;;
;;; tm-vm.el --- tm-MUA for VM
;;;
-;;; Copyright (C) 1995 Free Software Foundation, Inc.
-;;;
-;;; Author: MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
-;;; Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
-;;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;; Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>
-;;; Oscar Figueiredo <figueire@lspsun2.epfl.ch>
+;;; Copyright (C) 1994 MASUTANI Yasuhiro
+;;; Copyright (C) 1995 WAKAMIYA Kenji
+;;; Copyright (C) 1995,1996 KOBAYASHI Shuhei
+;;; Copyright (C) 1996 Oscar Figueiredo
+;;;
+;;; Author: MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
+;;; Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
+;;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
+;;; Oscar Figueiredo <figueire@lspsun2.epfl.ch>
;;; modified by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
-;;; and ISHIHARA Akito <aki@bpel.tutics.tut.ac.jp>
-;;; Maintainer: Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>
+;;; ISHIHARA Akito <aki@bpel.tutics.tut.ac.jp>
+;;; Rob Kooper <kooper@cc.gatech.edu>
+;;; Maintainer: KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
;;; Created: 1994/10/29
-;;; Version: $Revision: 7.39 $
+;;; Version: $Revision: 7.52 $
;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
;;;
;;; This file is part of tm (Tools for MIME).
;;;
-;;; Plese insert (require 'tm-vm) in your ~/.vm or ~/.emacs file.
-;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 2, or
;;; along with This program. If not, write to the Free Software
;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
+;;; Commentary:
+;;;
+;;; Plese insert `(require 'tm-vm)' in your ~/.vm file.
+;;;
;;; Code:
(require 'tm-view)
(require 'vm)
(defconst tm-vm/RCS-ID
- "$Id: tm-vm.el,v 7.39 1996/01/23 04:46:54 morioka Exp $")
+ "$Id: tm-vm.el,v 7.52 1996/04/19 18:49:19 shuhei-k 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)
(define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode)
+(defvar tm-vm/use-original-url-button nil
+ "*If it is t, use original URL button instead of tm's.")
+
(defvar tm-vm-load-hook nil
"*List of functions called after tm-vm is loaded.")
(progn
(set (make-local-variable 'tm-vm/system-state) 'previewing)
(save-window-excursion
- (mime/viewer-mode)
- (goto-char (point-min))
- (narrow-to-region (point)
- (search-forward "\n\n" nil t))
+ (vm-widen-page)
+ (goto-char (point-max))
+ (widen)
+ (narrow-to-region (point)
+ (save-excursion
+ (goto-char
+ (vm-start-of (car vm-message-pointer))
+ )
+ (forward-line)
+ (point)
+ ))
+ (mime/viewer-mode)
+ (if (and tm-vm/use-original-url-button
+ vm-use-menus (vm-menu-support-possible-p))
+ (vm-energize-urls))
+ ;; 1996/2/16, fixed by
+ ;; Oscar Figueiredo <figueire@lspsun2.epfl.ch>
+ ;; Highlight message (and display XFace if supported)
+ (if (or vm-highlighted-header-regexp
+ (and (vm-xemacs-p) vm-use-lucid-highlighting))
+ (vm-highlight-headers))
+ ;;
+ (goto-char (point-min))
+ (narrow-to-region (point) (search-forward "\n\n" nil t))
))
;; don't do MIME processing. decode header only.
(let (buffer-read-only)
(setq mwin (vm-get-buffer-window mbuf)
pwin (and pbuf (vm-get-buffer-window pbuf)))
(cond
- (was-invisible
+ ((or mp-changed was-invisible)
nil
)
((null pbuf)
"Moves to the beginning of the current message."
(interactive)
(if (not (tm-vm/system-state))
- (vm-beginning-of-message)
+ (progn
+ (setq this-command 'vm-beginning-of-message)
+ (vm-beginning-of-message))
(vm-follow-summary-cursor)
(vm-select-folder-buffer)
(vm-check-for-killed-summary)
"Moves to the end of the current message."
(interactive)
(if (not (tm-vm/system-state))
- (vm-end-of-message)
+ (progn
+ (setq this-command 'vm-end-of-message)
+ (vm-end-of-message))
(vm-follow-summary-cursor)
(vm-select-folder-buffer)
(vm-check-for-killed-summary)
(set-alist 'mime-viewer/over-to-next-method-alist
'vm-virtual-mode 'tm-vm/next-message)
+;;; @@ vm-yank-message
+;;;
+;; 1996/3/28 by Oscar Figueiredo <figueire@lspsun16.epfl.ch>
+
+(require 'vm-reply)
+
+(defun vm-yank-message (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
+message struct.
+
+This function originally provided by vm-reply has been patched for TM in
+order to provide better citation of MIME messages : if a MIME Preview
+buffer is displayed for the message then its contents are inserted
+instead of the raw message.
+
+This command is meant to be used in VM created Mail mode buffers; the
+yanked message comes from the mail buffer containing the message you
+are replying to, forwarding, or invoked VM's mail command from.
+
+All message headers are yanked along with the text. Point is
+left before the inserted text, the mark after. Any hook
+functions bound to mail-citation-hook are run, after inserting
+the text and setting point and mark. For backward compatibility,
+if mail-citation-hook is set to nil, `mail-yank-hooks' is run
+instead.
+
+If mail-citation-hook and mail-yank-hooks are both nil, this
+default action is taken: the yanked headers are trimmed as
+specified by vm-included-text-headers and
+vm-included-text-discard-header-regexp, and the value of
+vm-included-text-prefix is prepended to every yanked line."
+ (interactive
+ (list
+ ;; What we really want for the first argument is a message struct,
+ ;; but if called interactively, we let the user type in a message
+ ;; number instead.
+ (let (mp default
+ (result 0)
+ 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))))))
+
\f
;;; @ for tm-view
;;;
(save-excursion
(set-buffer mime::preview/article-buffer)
vm-summary-buffer))
- (switch-to-buffer mime::preview/mother-buffer)
+ (switch-to-buffer mime::preview/article-buffer)
(mime-viewer/kill-buffer)
(vm-select-folder-buffer)
(setq tm-vm/system-state nil))
If `vm-digest-send-type' is \"rfc1521\", tm-vm runs this hook
instead of `vm-send-digest-hook'.")
-(defun tm-vm/enclose-messages (mlist)
+(defun tm-vm/enclose-messages (mlist &optional preamble)
"Enclose the messages in MLIST as multipart/digest.
The resulting digest is inserted at point in the current buffer.
These are the messages that will be enclosed."
(if mlist
(let ((digest (consp (cdr mlist)))
+ (mp mlist)
m)
(save-restriction
(narrow-to-region (point) (point))
(tm-mail/insert-message m)
(goto-char (point-max))
(setq mlist (cdr mlist)))
+ (if preamble
+ (progn
+ (goto-char (point-min))
+ (mime-editor/insert-tag "text" "plain")
+ (vm-unsaved-message "Building digest preamble...")
+ (while mp
+ (let ((vm-summary-uninteresting-senders nil))
+ (insert
+ (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
+ (if vm-digest-center-preamble
+ (progn
+ (forward-char -1)
+ (center-line)
+ (forward-char 1)))
+ (setq mp (cdr mp)))))
(if digest
(mime-editor/enclose-digest-region (point-min) (point-max)))
))))
(run-hooks 'tm-vm/forward-message-hook)
(run-hooks 'vm-mail-mode-hook)))))
-(defun tm-vm/send-digest (&optional prefix)
+(defun tm-vm/send-digest (&optional arg)
"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
only marked messages will be put into the digest."
(interactive "P")
(if (not (equal vm-digest-send-type "rfc1521"))
- (vm-send-digest prefix)
+ (vm-send-digest arg)
(vm-select-folder-buffer)
(vm-check-for-killed-summary)
(vm-error-if-folder-empty)
(let ((dir default-directory)
- (mp vm-message-pointer)
- (mlist (if (eq last-command 'vm-next-command-uses-marks)
- (vm-select-marked-or-prefixed-messages 0)
- vm-message-list))
+ (vm-forward-list (if (eq last-command 'vm-next-command-uses-marks)
+ (vm-select-marked-or-prefixed-messages 0)
+ vm-message-list))
start)
(save-restriction
(widen)
(vm-mail-internal (format "digest from %s" (buffer-name)))
(setq vm-system-state 'forwarding
- vm-forward-list mlist
default-directory dir)
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator)
"\n"))
(goto-char (match-end 0))
- (setq start (point)
- mp mlist)
(vm-unsaved-message "Building %s digest..." vm-digest-send-type)
- (tm-vm/enclose-messages mlist)
- (goto-char start)
- (setq mp mlist)
- (if prefix
- (progn
- (mime-editor/insert-tag "text" "plain")
- (vm-unsaved-message "Building digest preamble...")
- (while mp
- (let ((vm-summary-uninteresting-senders nil))
- (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
- (if vm-digest-center-preamble
- (progn
- (forward-char -1)
- (center-line)
- (forward-char 1)))
- (setq mp (cdr mp)))))
+ (tm-vm/enclose-messages vm-forward-list arg)
(mail-position-on-field "To")
(message "Building %s digest... done" vm-digest-send-type)))
(run-hooks 'tm-vm/send-digest-hook)
'tm-vm/forward-message vm-mode-map)
(substitute-key-definition 'vm-send-digest
'tm-vm/send-digest vm-mode-map)
-
-;;; @@ for message/rfc822
-;;;
\f
;;; @@ setting
projects / elisp / tm.git / blobdiff