Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-menu.el @ 30:ec9a17fef872 r19-15b98

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b98
author cvs
date Mon, 13 Aug 2007 08:52:29 +0200
parents 441bb1e64a06
children 05472e90ae02
comparison
equal deleted inserted replaced
29:7976500f47f9 30:ec9a17fef872
191 "----" 191 "----"
192 ["Mark" vm-mark-message vm-message-list] 192 ["Mark" vm-mark-message vm-message-list]
193 ["Unmark" vm-unmark-message vm-message-list] 193 ["Unmark" vm-unmark-message vm-message-list]
194 ["Mark All" vm-mark-all-messages vm-message-list] 194 ["Mark All" vm-mark-all-messages vm-message-list]
195 ["Clear All Marks" vm-clear-all-marks vm-message-list] 195 ["Clear All Marks" vm-clear-all-marks vm-message-list]
196 ["Mark Region in Summary" vm-mark-summary-region vm-message-list]
197 ["Unmark Region in Summary" vm-unmark-summary-region vm-message-list]
196 "----" 198 "----"
197 ["Mark Same Subject" vm-mark-messages-same-subject vm-message-list] 199 ["Mark Same Subject" vm-mark-messages-same-subject vm-message-list]
198 ["Unmark Same Subject" vm-unmark-messages-same-subject vm-message-list] 200 ["Unmark Same Subject" vm-unmark-messages-same-subject vm-message-list]
199 ["Mark Same Author" vm-mark-messages-same-author vm-message-list] 201 ["Mark Same Author" vm-mark-messages-same-author vm-message-list]
200 ["Unmark Same Author" vm-unmark-messages-same-author vm-message-list] 202 ["Unmark Same Author" vm-unmark-messages-same-author vm-message-list]
374 vm-send-using-mime] 376 vm-send-using-mime]
375 )))) 377 ))))
376 378
377 (defconst vm-menu-mime-dispose-menu 379 (defconst vm-menu-mime-dispose-menu
378 (let ((title (if (vm-menu-fsfemacs-menus-p) 380 (let ((title (if (vm-menu-fsfemacs-menus-p)
379 (list "Send MIME body to ..." 381 (list "Take Action on MIME body ..."
380 "Send MIME body to ..." 382 "Take Action on MIME body ..."
381 "---" 383 "---"
382 "---") 384 "---")
383 (list "Send MIME body to ...")))) 385 (list "Take Action on MIME body ..."))))
384 (append 386 (append
385 title 387 title
386 (list ["File" (vm-mime-run-display-function-at-point 388 (list ["Display as US-ASCII Text"
387 'vm-mime-send-body-to-file) t]
388 ["Shell Pipeline (display output)"
389 (vm-mime-run-display-function-at-point 389 (vm-mime-run-display-function-at-point
390 'vm-mime-pipe-body-to-command) t] 390 'vm-mime-display-body-as-text) t]
391 ["Shell Pipeline (discard output)" 391 ["Display using External Viewer"
392 (vm-mime-run-display-function-at-point 392 (vm-mime-run-display-function-at-point
393 'vm-mime-pipe-body-to-command-discard-output) t])))) 393 'vm-mime-display-body-using-external-viewer) t]
394 "---"
395 ["Save to File" (vm-mime-run-display-function-at-point
396 'vm-mime-send-body-to-file) t]
397 ["Send to Printer" (vm-mime-run-display-function-at-point
398 'vm-mime-send-body-to-printer) t]
399 ["Feed to Shell Pipeline (display output)"
400 (vm-mime-run-display-function-at-point
401 'vm-mime-pipe-body-to-queried-command) t]
402 ["Feed to Shell Pipeline (discard output)"
403 (vm-mime-run-display-function-at-point
404 'vm-mime-pipe-body-to-queried-command-discard-output) t]))))
394 405
395 (defconst vm-menu-url-browser-menu 406 (defconst vm-menu-url-browser-menu
396 (let ((title (if (vm-menu-fsfemacs-menus-p) 407 (let ((title (if (vm-menu-fsfemacs-menus-p)
397 (list "Send URL to ..." 408 (list "Send URL to ..."
398 "Send URL to ..." 409 "Send URL to ..."
458 ["Unmark Messages, Same Author" vm-unmark-messages-same-author 469 ["Unmark Messages, Same Author" vm-unmark-messages-same-author
459 vm-message-list] 470 vm-message-list]
460 ["Virtual Folder, Matching Author" vm-menu-create-author-virtual-folder 471 ["Virtual Folder, Matching Author" vm-menu-create-author-virtual-folder
461 vm-message-list] 472 vm-message-list]
462 )))) 473 ))))
474
475 (defconst vm-menu-content-disposition-menu
476 (let ((title (if (vm-menu-fsfemacs-menus-p)
477 (list "Set Content Disposition"
478 "Set Content Disposition"
479 "---"
480 "---")
481 (list "Set Content Disposition"))))
482 (append
483 title
484 (list ["Unspecified"
485 (vm-mime-set-attachment-disposition-at-point 'unspecified)
486 :active vm-send-using-mime
487 :style radio
488 :selected (eq (vm-mime-attachment-disposition-at-point)
489 'unspecified)]
490 ["Inline"
491 (vm-mime-set-attachment-disposition-at-point 'inline)
492 :active vm-send-using-mime
493 :style radio
494 :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)]
495 ["Attachment"
496 (vm-mime-set-attachment-disposition-at-point 'attachment)
497 :active vm-send-using-mime
498 :style radio
499 :selected (eq (vm-mime-attachment-disposition-at-point)
500 'attachment)]))))
463 501
464 (defvar vm-menu-vm-menubar nil) 502 (defvar vm-menu-vm-menubar nil)
465 503
466 (defconst vm-menu-vm-menu 504 (defconst vm-menu-vm-menu
467 (let ((title (if (vm-menu-fsfemacs-menus-p) 505 (let ((title (if (vm-menu-fsfemacs-menus-p)
629 vm-menu-url-browser-menu) 667 vm-menu-url-browser-menu)
630 ;; mime dispose menu 668 ;; mime dispose menu
631 (vm-easy-menu-define vm-menu-fsfemacs-mime-dispose-menu 669 (vm-easy-menu-define vm-menu-fsfemacs-mime-dispose-menu
632 (list dummy) nil 670 (list dummy) nil
633 vm-menu-mime-dispose-menu) 671 vm-menu-mime-dispose-menu)
672 ;; content disposition menu
673 (vm-easy-menu-define vm-menu-fsfemacs-content-disposition-menu
674 (list dummy) nil
675 vm-menu-content-disposition-menu)
634 ;; block the global menubar entries in the map so that VM 676 ;; block the global menubar entries in the map so that VM
635 ;; can take over the menubar if necessary. 677 ;; can take over the menubar if necessary.
636 (define-key map [rootmenu] (make-sparse-keymap)) 678 (define-key map [rootmenu] (make-sparse-keymap))
637 (define-key map [rootmenu vm] (cons "VM" (make-sparse-keymap "VM"))) 679 (define-key map [rootmenu vm] (cons "VM" (make-sparse-keymap "VM")))
638 (define-key map [rootmenu vm file] 'undefined) 680 (define-key map [rootmenu vm file] 'undefined)
725 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) 767 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
726 (set-buffer (window-buffer (posn-window (event-start event)))) 768 (set-buffer (window-buffer (posn-window (event-start event))))
727 (goto-char (posn-point (event-start event))) 769 (goto-char (posn-point (event-start event)))
728 (vm-menu-popup-fsfemacs-menu event)))) 770 (vm-menu-popup-fsfemacs-menu event))))
729 771
772 (defvar vm-menu-fsfemacs-content-disposition-menu)
730 (defun vm-menu-popup-context-menu (event) 773 (defun vm-menu-popup-context-menu (event)
731 (interactive "e") 774 (interactive "e")
732 ;; We should not need to do anything here for XEmacs. The 775 ;; We should not need to do anything here for XEmacs. The
733 ;; default binding of mouse-3 is popup-mode-menu which does 776 ;; default binding of mouse-3 is popup-mode-menu which does
734 ;; what we want for the normal case. For special contexts, 777 ;; what we want for the normal case. For special contexts,
737 ;; contained in an extent with a keymap that has mouse-3 bound 780 ;; contained in an extent with a keymap that has mouse-3 bound
738 ;; to a function that will pop up a context sensitive menu. 781 ;; to a function that will pop up a context sensitive menu.
739 (cond ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) 782 (cond ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
740 (set-buffer (window-buffer (posn-window (event-start event)))) 783 (set-buffer (window-buffer (posn-window (event-start event))))
741 (goto-char (posn-point (event-start event))) 784 (goto-char (posn-point (event-start event)))
742 (let (o-list o menu (found nil)) 785 (if (get-text-property (point) 'vm-mime-object)
743 (setq o-list (overlays-at (point))) 786 (vm-menu-popup-fsfemacs-menu
744 (while (and o-list (not found)) 787 event vm-menu-fsfemacs-content-disposition-menu)
745 (cond ((overlay-get (car o-list) 'vm-url) 788 (let (o-list o menu (found nil))
746 (setq found t) 789 (setq o-list (overlays-at (point)))
747 (vm-menu-popup-url-browser-menu event)) 790 (while (and o-list (not found))
748 ((setq menu (overlay-get (car o-list) 'vm-header)) 791 (cond ((overlay-get (car o-list) 'vm-url)
749 (setq found t) 792 (setq found t)
750 (vm-menu-popup-fsfemacs-menu event menu)) 793 (vm-menu-popup-url-browser-menu event))
751 ((overlay-get (car o-list) 'vm-mime-layout) 794 ((setq menu (overlay-get (car o-list) 'vm-header))
752 (setq found t) 795 (setq found t)
753 (vm-menu-popup-mime-dispose-menu event))) 796 (vm-menu-popup-fsfemacs-menu event menu))
754 (setq o-list (cdr o-list))) 797 ((overlay-get (car o-list) 'vm-mime-layout)
755 (and (not found) (vm-menu-popup-fsfemacs-menu event)))))) 798 (setq found t)
799 (vm-menu-popup-mime-dispose-menu event)))
800 (setq o-list (cdr o-list)))
801 (and (not found) (vm-menu-popup-fsfemacs-menu event)))))))
756 802
757 ;; to quiet the byte-compiler 803 ;; to quiet the byte-compiler
758 (defvar vm-menu-fsfemacs-url-browser-menu) 804 (defvar vm-menu-fsfemacs-url-browser-menu)
759 (defvar vm-menu-fsfemacs-mime-dispose-menu) 805 (defvar vm-menu-fsfemacs-mime-dispose-menu)
760 806
761 (defun vm-menu-popup-url-browser-menu (event) 807 (defun vm-menu-goto-event (event)
762 (interactive "e") 808 (cond ((vm-menu-xemacs-menus-p)
763 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
764 ;; Must select window instead of just set-buffer because 809 ;; Must select window instead of just set-buffer because
765 ;; popup-menu returns before the user has made a 810 ;; popup-menu returns before the user has made a
766 ;; selection. This will cause the command loop to 811 ;; selection. This will cause the command loop to
767 ;; resume which might undo what set-buffer does. 812 ;; resume which might undo what set-buffer does.
768 (select-window (event-window event)) 813 (select-window (event-window event))
769 (and (event-point event) (goto-char (event-point event))) 814 (and (event-point event) (goto-char (event-point event))))
815 ((vm-menu-fsfemacs-menus-p)
816 (set-buffer (window-buffer (posn-window (event-start event))))
817 (goto-char (posn-point (event-start event))))))
818
819 (defun vm-menu-popup-url-browser-menu (event)
820 (interactive "e")
821 (vm-menu-goto-event event)
822 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
770 (popup-menu vm-menu-url-browser-menu)) 823 (popup-menu vm-menu-url-browser-menu))
771 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) 824 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
772 (set-buffer (window-buffer (posn-window (event-start event))))
773 (goto-char (posn-point (event-start event)))
774 (vm-menu-popup-fsfemacs-menu 825 (vm-menu-popup-fsfemacs-menu
775 event vm-menu-fsfemacs-url-browser-menu)))) 826 event vm-menu-fsfemacs-url-browser-menu))))
776 827
777 (defun vm-menu-popup-mime-dispose-menu (event) 828 (defun vm-menu-popup-mime-dispose-menu (event)
778 (interactive "e") 829 (interactive "e")
830 (vm-menu-goto-event event)
779 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) 831 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
780 ;; Must select window instead of just set-buffer because
781 ;; popup-menu returns before the user has made a
782 ;; selection. This will cause the command loop to
783 ;; resume which might undo what set-buffer does.
784 (select-window (event-window event))
785 (and (event-point event) (goto-char (event-point event)))
786 (popup-menu vm-menu-mime-dispose-menu)) 832 (popup-menu vm-menu-mime-dispose-menu))
787 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) 833 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
788 (set-buffer (window-buffer (posn-window (event-start event))))
789 (goto-char (posn-point (event-start event)))
790 (vm-menu-popup-fsfemacs-menu 834 (vm-menu-popup-fsfemacs-menu
791 event vm-menu-fsfemacs-mime-dispose-menu)))) 835 event vm-menu-fsfemacs-mime-dispose-menu))))
836
837 (defun vm-menu-popup-content-disposition-menu (event)
838 (interactive "e")
839 (vm-menu-goto-event event)
840 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
841 (popup-menu vm-menu-content-disposition-menu))
842 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
843 (vm-menu-popup-fsfemacs-menu
844 event vm-menu-fsfemacs-content-disposition-menu))))
792 845
793 ;; to quiet the byte-compiler 846 ;; to quiet the byte-compiler
794 (defvar vm-menu-fsfemacs-mail-menu) 847 (defvar vm-menu-fsfemacs-mail-menu)
795 (defvar vm-menu-fsfemacs-dispose-popup-menu) 848 (defvar vm-menu-fsfemacs-dispose-popup-menu)
796 (defvar vm-menu-fsfemacs-vm-menu) 849 (defvar vm-menu-fsfemacs-vm-menu)
814 867
815 (defun vm-menu-mode-menu () 868 (defun vm-menu-mode-menu ()
816 (if (vm-menu-xemacs-menus-p) 869 (if (vm-menu-xemacs-menus-p)
817 (cond ((eq major-mode 'mail-mode) 870 (cond ((eq major-mode 'mail-mode)
818 vm-menu-mail-menu) 871 vm-menu-mail-menu)
819 ((memq major-mode '(vm-mode vm-summary-mode vm-virtual-mode)) 872 ((memq major-mode '(vm-mode vm-presentation-mode
873 vm-summary-mode vm-virtual-mode))
820 vm-menu-dispose-menu) 874 vm-menu-dispose-menu)
821 (t vm-menu-vm-menu)) 875 (t vm-menu-vm-menu))
822 (cond ((eq major-mode 'mail-mode) 876 (cond ((eq major-mode 'mail-mode)
823 vm-menu-fsfemacs-mail-menu) 877 vm-menu-fsfemacs-mail-menu)
824 ((memq major-mode '(vm-mode vm-summary-mode vm-virtual-mode)) 878 ((memq major-mode '(vm-mode vm-summary-mode vm-virtual-mode))
921 (defvar mail-mode-map) 975 (defvar mail-mode-map)
922 (define-key mail-mode-map [menu-bar mail] 976 (define-key mail-mode-map [menu-bar mail]
923 (cons "Mail" vm-menu-fsfemacs-mail-menu)) 977 (cons "Mail" vm-menu-fsfemacs-mail-menu))
924 (if vm-popup-menu-on-mouse-3 978 (if vm-popup-menu-on-mouse-3
925 (define-key vm-mail-mode-map [down-mouse-3] 979 (define-key vm-mail-mode-map [down-mouse-3]
926 'vm-menu-popup-mode-menu))))) 980 'vm-menu-popup-context-menu)))))
927 981
928 (defun vm-menu-install-menus () 982 (defun vm-menu-install-menus ()
929 (cond ((consp vm-use-menus) 983 (cond ((consp vm-use-menus)
930 (vm-menu-install-vm-mode-menu) 984 (vm-menu-install-vm-mode-menu)
931 (vm-menu-install-menubar) 985 (vm-menu-install-menubar)