Mercurial > hg > xemacs-beta
diff lisp/tm/tm-vm.el @ 20:859a2309aef8 r19-15b93
Import from CVS: tag r19-15b93
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:50:05 +0200 |
parents | 0293115a14e9 |
children | 8fc7fe29b841 |
line wrap: on
line diff
--- a/lisp/tm/tm-vm.el Mon Aug 13 08:49:44 2007 +0200 +++ b/lisp/tm/tm-vm.el Mon Aug 13 08:50:05 2007 +0200 @@ -9,7 +9,7 @@ ;; Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> ;; Created: 1994/10/29 -;; Version: $Revision: 1.3 $ +;; Version: $Revision: 1.4 $ ;; Keywords: mail, MIME, multimedia, multilingual, encoded-word ;; This file is part of tm (Tools for MIME). @@ -36,13 +36,16 @@ ;;; Code: (eval-when-compile - (require 'tm-edit) (require 'tm-mail) (require 'vm) (require 'vm-window)) +(require 'tm-edit) (require 'tm-view) +(require 'vm-reply) +(require 'vm-summary) (require 'vm-menu) +(require 'vm-toolbar) ;;; @ Variables @@ -60,7 +63,9 @@ (defvar tm-vm/use-original-url-button nil "*If it is t, use original URL button instead of tm's.") -(defvar tm-vm/automatic-mime-preview t +(defvar tm-vm/automatic-mime-preview (or (and (boundp 'vm-display-using-mime) + vm-display-using-mime) + t) "*If non-nil, automatically process and show MIME messages.") (defvar tm-vm/strict-mime t @@ -91,13 +96,55 @@ If `vm-digest-send-type' is \"rfc1521\", tm-vm runs this hook instead of `vm-send-digest-hook'.") +(defvar tm-vm/build-mime-preview-buffer-hook nil + "*List of functions called each time a MIME Preview buffer is built. +These hooks are run in the MIME-Preview buffer.") ;;; @@ System/Information variables (defconst tm-vm/RCS-ID - "$Id: tm-vm.el,v 1.3 1997/02/02 05:06:20 steve Exp $") + "$Id: tm-vm.el,v 1.4 1997/02/09 23:51:48 steve Exp $") (defconst tm-vm/version (get-version-string tm-vm/RCS-ID)) +; Ensure vm-menu-mail-menu gets properly defined *before* tm-vm/vm-emulation-map +; since it contains a call to vm-menu-initialize-vm-mode-menu-map +(setq vm-menu-mail-menu + (let ((title (if (vm-menu-fsfemacs-menus-p) + (list "Mail Commands" + "Mail Commands" + "---" + "---") + (list "Mail Commands")))) + (append + title + (list ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)] + ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)] + ["Cancel" kill-buffer t] + "----" + "Go to Field:" + "----" + [" To:" mail-to t] + [" Subject:" mail-subject t] + [" CC:" mail-cc t] + [" BCC:" mail-bcc t] + [" Reply-To:" mail-replyto t] + [" Text" mail-text t] + "----" + ["Yank Original" vm-menu-yank-original vm-reply-list] + ["Fill Yanked Message" mail-fill-yanked-message t] + ["Insert Signature" mail-signature t] + ["Insert File..." insert-file t] + ["Insert Buffer..." insert-buffer t]) + (if tm-vm/attach-to-popup-menus + (list "----" + (cons "MIME Commands" + (mapcar (function (lambda (item) + (vector (nth 1 item) + (nth 2 item) + t))) + mime-editor/menu-list)))) + ))) + (defvar tm-vm/vm-emulation-map (let ((map (make-sparse-keymap))) (define-key map "h" 'vm-summarize) @@ -111,16 +158,16 @@ ;(define-key map "\C-\M-p" 'vm-move-message-backward) ;(define-key map "\t" 'vm-goto-message-last-seen) ;(define-key map "\r" 'vm-goto-message) - ;(define-key map "^" 'vm-goto-parent-message) + (define-key map "^" 'vm-goto-parent-message) (define-key map "t" 'vm-expose-hidden-headers) (define-key map " " 'vm-scroll-forward) (define-key map "b" 'vm-scroll-backward) (define-key map "\C-?" 'vm-scroll-backward) - ;(define-key map "d" 'vm-delete-message) - ;(define-key map "\C-d" 'vm-delete-message-backward) - ;(define-key map "u" 'vm-undelete-message) - ;(define-key map "U" 'vm-unread-message) - ;(define-key map "e" 'vm-edit-message) + (define-key map "d" 'vm-delete-message) + (define-key map "\C-d" 'vm-delete-message-backward) + (define-key map "u" 'vm-undelete-message) + (define-key map "U" 'vm-unread-message) + (define-key map "e" 'vm-edit-message) ;(define-key map "a" 'vm-set-message-attributes) ;(define-key map "j" 'vm-discard-cached-data) ;(define-key map "k" 'vm-kill-subject) @@ -138,12 +185,12 @@ (define-key map "g" 'vm-get-new-mail) ;(define-key map "G" 'vm-sort-messages) (define-key map "v" 'vm-visit-folder) - ;(define-key map "s" 'vm-save-message) + (define-key map "s" 'vm-save-message) ;(define-key map "w" 'vm-save-message-sans-headers) ;(define-key map "A" 'vm-auto-archive-messages) - ;(define-key map "S" 'vm-save-folder) + (define-key map "S" 'vm-save-folder) ;(define-key map "|" 'vm-pipe-message-to-command) - ;(define-key map "#" 'vm-expunge-folder) + (define-key map "#" 'vm-expunge-folder) (define-key map "q" 'vm-quit) (define-key map "x" 'vm-quit-no-change) (define-key map "i" 'vm-iconify-frame) @@ -155,7 +202,7 @@ (define-key map ">" 'vm-end-of-message) ;(define-key map "\M-s" 'vm-isearch-forward) (define-key map "=" 'vm-summarize) - ;(define-key map "L" 'vm-load-init-file) + (define-key map "L" 'vm-load-init-file) ;(define-key map "l" (make-sparse-keymap)) ;(define-key map "la" 'vm-add-message-labels) ;(define-key map "ld" 'vm-delete-message-labels) @@ -186,13 +233,13 @@ ;(define-key map "WS" 'vm-save-window-configuration) ;(define-key map "WD" 'vm-delete-window-configuration) ;(define-key map "W?" 'vm-window-help) - ;(define-key map "\C-t" 'vm-toggle-threads-display) - ;(define-key map "\C-x\C-s" 'vm-save-buffer) - ;(define-key map "\C-x\C-w" 'vm-write-file) - ;(define-key map "\C-x\C-q" 'vm-toggle-read-only) + (define-key map "\C-t" 'vm-toggle-threads-display) + (define-key map "\C-x\C-s" 'vm-save-buffer) + (define-key map "\C-x\C-w" 'vm-write-file) + (define-key map "\C-x\C-q" 'vm-toggle-read-only) ;(define-key map "%" 'vm-change-folder-type) - ;(define-key map "\M-C" 'vm-show-copying-restrictions) - ;(define-key map "\M-W" 'vm-show-no-warranty) + (define-key map "\M-C" 'vm-show-copying-restrictions) + (define-key map "\M-W" 'vm-show-no-warranty) ;; suppress-keymap provides these, but now that we don't use ;; suppress-keymap anymore... (define-key map "0" 'digit-argument) @@ -232,10 +279,15 @@ fsfmenu)) "VM's popup menu + MIME specific commands") + + (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) +; Disable VM 6 built-in MIME handling +(setq vm-display-using-mime nil) +(setq vm-send-using-mime nil) ;;; @ MIME encoded-words @@ -259,7 +311,6 @@ (cdr ret)) ret))) -(require 'vm-summary) (or (fboundp 'tm:vm-su-subject) (fset 'tm:vm-su-subject (symbol-function 'vm-su-subject)) ) @@ -413,7 +464,9 @@ vm-use-menus (vm-menu-support-possible-p)) (progn (vm-energize-urls) - (vm-energize-headers))))))) + (vm-energize-headers))) + (run-hooks 'tm-vm/build-mime-preview-buffer-hook) + )))) (defun tm-vm/sync-preview-buffer () "Ensure that the MIME preview buffer, if it exists, actually corresponds to the current message. @@ -968,7 +1021,6 @@ ;;; @@ vm-yank-message -(require 'vm-reply) (defvar tm-vm/yank:message-to-restore nil "For internal use by tm-vm only.") @@ -1237,19 +1289,6 @@ ;;; @@@ Menus -;;; modified by Steven L. Baur <steve@miranova.com> -;;; 1995/12/6 (c.f. [tm-en:209]) -(defun mime-editor/attach-to-vm-mode-menu () - "Arrange to attach MIME editor's popup menu to VM's" - (if (boundp 'vm-menu-mail-menu) - (progn - (setq vm-menu-mail-menu - (append vm-menu-mail-menu - (list "----" - mime-editor/popup-menu-for-xemacs))) - (remove-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu) - )) -) (call-after-loaded 'tm-edit @@ -1264,10 +1303,6 @@ (interactive) (funcall send-mail-function) ))) - (if (and (string-match "XEmacs\\|Lucid" emacs-version) - tm-vm/attach-to-popup-menus) - (add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu) - ) ))) @@ -1312,11 +1347,91 @@ (vm-menu-popup-mode-menu event)))) ) +(defadvice vm-save-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) +(defadvice vm-expunge-folder (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-save-folder (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-goto-parent-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-delete-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (interactive "p") + (if (interactive-p) + (vm-follow-summary-cursor)) + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-delete-message-backward (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (interactive "p") + (if (interactive-p) + (vm-follow-summary-cursor)) + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-undelete-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (interactive "p") + (if (interactive-p) + (vm-follow-summary-cursor)) + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-unread-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + +(defadvice vm-edit-message (around tm-aware activate) + "Made TM aware. Callable from the MIME Preview buffer." + (if mime::preview/article-buffer + (save-excursion + (set-buffer mime::preview/article-buffer) + ad-do-it) + ad-do-it)) + + + ;;; @@ VM Toolbar Integration -(require 'vm-toolbar) - ;;; based on vm-toolbar-any-messages-p [vm-toolbar.el] (defun tm-vm/check-for-toolbar () "Install VM toolbar if necessary."