Mercurial > hg > xemacs-beta
diff lisp/vm/vm-menu.el @ 98:0d2f883870bc r20-1b1
Import from CVS: tag r20-1b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:13:56 +0200 |
parents | 131b0175ea99 |
children | 4be1180a9e89 |
line wrap: on
line diff
--- a/lisp/vm/vm-menu.el Mon Aug 13 09:12:43 2007 +0200 +++ b/lisp/vm/vm-menu.el Mon Aug 13 09:13:56 2007 +0200 @@ -1,5 +1,5 @@ ;;; Menu related functions and commands -;;; Copyright (C) 1995 Kyle E. Jones +;;; Copyright (C) 1995, 1997 Kyle E. Jones ;;; ;;; Folders menu derived from ;;; vm-folder-menu.el @@ -123,6 +123,7 @@ ["Pipe to Command" vm-pipe-message-to-command vm-message-list] "---" ["Burst Message as Digest" (vm-burst-digest "guess") vm-message-list] + ["Decode MIME" vm-decode-mime-message (vm-menu-can-decode-mime-p)] )))) (defconst vm-menu-motion-menu @@ -178,6 +179,7 @@ ["Retry Bounced Message" vm-resend-bounced-message vm-message-list] ["Send Digest (RFC934)" vm-send-rfc934-digest vm-message-list] ["Send Digest (RFC1153)" vm-send-rfc1153-digest vm-message-list] + ["Send MIME Digest" vm-send-mime-digest vm-message-list] )) (defconst vm-menu-mark-menu @@ -281,8 +283,36 @@ ["Insert Signature" mail-signature t] ["Insert File..." insert-file t] ["Insert Buffer..." insert-buffer t] + "----" + "MIME:" + "----" + [" Attach File..." vm-mime-attach-file vm-send-using-mime] + [" Attach MIME File..." vm-mime-attach-mime-file vm-send-using-mime] + [" Encode MIME, But Don't Send" vm-mime-encode-composition + (and vm-send-using-mime + (null (vm-mail-mode-get-header-contents "MIME-Version:")))] + [" Preview MIME Before Sending" vm-mime-preview-composition + vm-send-using-mime] )))) +(defconst vm-menu-mime-dispose-menu + (let ((title (if (vm-menu-fsfemacs-menus-p) + (list "Send MIME body to ..." + "Send MIME body to ..." + "---" + "---") + (list "Send MIME body to ...")))) + (append + title + (list ["File" (vm-mime-run-display-function-at-point + 'vm-mime-send-body-to-file) t] + ["Shell Pipeline (display output)" + (vm-mime-run-display-function-at-point + 'vm-mime-pipe-body-to-command) t] + ["Shell Pipeline (discard output)" + (vm-mime-run-display-function-at-point + 'vm-mime-pipe-body-to-command-discard-output) t])))) + (defconst vm-menu-url-browser-menu (let ((title (if (vm-menu-fsfemacs-menus-p) (list "Send URL to ..." @@ -369,7 +399,7 @@ vm-menu-label-menu vm-menu-sort-menu vm-menu-virtual-menu - vm-menu-undo-menu +;; vm-menu-undo-menu vm-menu-dispose-menu "---" "---" @@ -420,6 +450,16 @@ (vm-select-folder-buffer) vm-undo-record-list)) +(defun vm-menu-can-decode-mime-p () + (save-excursion + (vm-check-for-killed-folder) + (vm-select-folder-buffer) + (and vm-display-using-mime + vm-message-pointer + vm-presentation-buffer + (not vm-mime-decoded) + (not (vm-mime-plain-message-p (car vm-message-pointer)))))) + (defun vm-menu-yank-original () (interactive) (save-excursion @@ -508,6 +548,10 @@ ;; url browser menu (vm-easy-menu-define vm-menu-fsfemacs-url-browser-menu (list dummy) nil vm-menu-url-browser-menu) + ;; mime dispose menu + (vm-easy-menu-define vm-menu-fsfemacs-mime-dispose-menu + (list dummy) nil + vm-menu-mime-dispose-menu) ;; block the global menubar entries in the map so that VM ;; can take over the menubar if necessary. (define-key map [rootmenu] (make-sparse-keymap)) @@ -553,7 +597,7 @@ (menu-list (if (consp vm-use-menus) (reverse vm-use-menus) - (list 'help nil 'dispose 'undo 'virtual 'sort + (list 'help nil 'dispose 'virtual 'sort 'label 'mark 'send 'motion 'folder)))) (while menu-list (if (null (car menu-list)) @@ -624,12 +668,16 @@ (vm-menu-popup-url-browser-menu event)) ((setq menu (overlay-get (car o-list) 'vm-header)) (setq found t) - (vm-menu-popup-fsfemacs-menu event menu))) + (vm-menu-popup-fsfemacs-menu event menu)) + ((overlay-get (car o-list) 'vm-mime-layout) + (setq found t) + (vm-menu-popup-mime-dispose-menu event))) (setq o-list (cdr o-list))) (and (not found) (vm-menu-popup-fsfemacs-menu event)))))) ;; to quiet the byte-compiler (defvar vm-menu-fsfemacs-url-browser-menu) +(defvar vm-menu-fsfemacs-mime-dispose-menu) (defun vm-menu-popup-url-browser-menu (event) (interactive "e") @@ -647,6 +695,22 @@ (vm-menu-popup-fsfemacs-menu event vm-menu-fsfemacs-url-browser-menu)))) +(defun vm-menu-popup-mime-dispose-menu (event) + (interactive "e") + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) + ;; Must select window instead of just set-buffer because + ;; popup-menu returns before the user has made a + ;; selection. This will cause the command loop to + ;; resume which might undo what set-buffer does. + (select-window (event-window event)) + (and (event-point event) (goto-char (event-point event))) + (popup-menu vm-menu-mime-dispose-menu)) + ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-mime-dispose-menu)))) + ;; to quiet the byte-compiler (defvar vm-menu-fsfemacs-mail-menu) (defvar vm-menu-fsfemacs-dispose-popup-menu) @@ -696,6 +760,9 @@ (cond ((vm-menu-xemacs-menus-p) (if (null (car (find-menu-item current-menubar '("XEmacs")))) (set-buffer-menubar vm-menu-vm-menubar) + ;; copy the current menubar in case it has been changed. + (make-local-variable 'vm-menu-vm-menubar) + (setq vm-menu-vm-menubar (copy-sequence current-menubar)) (set-buffer-menubar (copy-sequence (vm-menu-xemacs-global-menubar))) (condition-case nil (add-menu-button nil vm-menu-vm-button nil) @@ -704,7 +771,12 @@ (vm-menu-set-menubar-dirty-flag) (vm-check-for-killed-summary) (and vm-summary-buffer - (vm-menu-toggle-menubar vm-summary-buffer))) + (save-excursion + (vm-menu-toggle-menubar vm-summary-buffer))) + (vm-check-for-killed-presentation) + (and vm-presentation-buffer-handle + (save-excursion + (vm-menu-toggle-menubar vm-presentation-buffer-handle)))) ((vm-menu-fsfemacs-menus-p) (if (not (eq (lookup-key vm-mode-map [menu-bar]) (lookup-key vm-mode-menu-map [rootmenu vm]))) @@ -719,7 +791,9 @@ (defun vm-menu-install-menubar () (cond ((vm-menu-xemacs-menus-p) (setq vm-menu-vm-menubar (vm-menu-make-xemacs-menubar)) - (set-buffer-menubar vm-menu-vm-menubar)) + (set-buffer-menubar vm-menu-vm-menubar) + (run-hooks 'vm-menu-setup-hook) + (setq vm-menu-vm-menubar current-menubar)) ((and (vm-menu-fsfemacs-menus-p) ;; menus only need to be installed once for FSF Emacs (not (fboundp 'vm-menu-undo-menu))) @@ -750,7 +824,8 @@ (cond ((vm-menu-xemacs-menus-p) ;; mail-mode doesn't have mode-popup-menu bound to ;; mouse-3 by default. fix that. - (define-key vm-mail-mode-map 'button3 'popup-mode-menu) + (if vm-popup-menu-on-mouse-3 + (define-key vm-mail-mode-map 'button3 'popup-mode-menu)) ;; put menu on menubar also. (if (vm-menu-xemacs-global-menubar) (progn @@ -764,8 +839,9 @@ ;; Poorly. ;;(define-key vm-mail-mode-map [menu-bar mail] ;; (cons "Mail" vm-menu-fsfemacs-mail-menu)) - (define-key vm-mail-mode-map [down-mouse-3] - 'vm-menu-popup-mode-menu)))) + (if vm-popup-menu-on-mouse-3 + (define-key vm-mail-mode-map [down-mouse-3] + 'vm-menu-popup-mode-menu))))) (defun vm-menu-install-menus () (cond ((consp vm-use-menus)