Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-menu.el @ 54:05472e90ae02 r19-16-pre2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-16-pre2
author cvs
date Mon, 13 Aug 2007 08:57:55 +0200
parents ec9a17fef872
children 131b0175ea99
comparison
equal deleted inserted replaced
53:875393c1a535 54:05472e90ae02
42 ;;; along with this program; if not, write to the Free Software 42 ;;; along with this program; if not, write to the Free Software
43 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 43 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
44 44
45 (provide 'vm-menu) 45 (provide 'vm-menu)
46 46
47 ;; copied from vm-vars.el because vm-xemacs-p, vm-xemacs-mule-p
48 ;; and vm-fsfemacs-19-p are needed below at load time and
49 ;; vm-note-emacs-version may not be autoloadable.
50 (or (fboundp 'vm-note-emacs-version)
51 (defun vm-note-emacs-version ()
52 (setq vm-xemacs-p (string-match "XEmacs" emacs-version)
53 vm-xemacs-mule-p (and vm-xemacs-p (featurep 'mule)
54 ;; paranoia
55 (fboundp 'set-file-coding-system))
56 vm-fsfemacs-19-p (not vm-xemacs-p))))
57
58 ;; make sure the emacs/xemacs version variables are set, as they
59 ;; are needed below at load time.
60 (vm-note-emacs-version)
61
47 (defun vm-menu-fsfemacs-menus-p () 62 (defun vm-menu-fsfemacs-menus-p ()
48 (and (vm-fsfemacs-19-p) 63 (and vm-fsfemacs-19-p
49 (fboundp 'menu-bar-mode))) 64 (fboundp 'menu-bar-mode)))
50 65
51 (defun vm-menu-xemacs-menus-p () 66 (defun vm-menu-xemacs-menus-p ()
52 (and (vm-xemacs-p) 67 (and vm-xemacs-p
53 (fboundp 'set-buffer-menubar))) 68 (fboundp 'set-buffer-menubar)))
54 69
55 ;; defined again in vm-misc.el but we need it here for some
56 ;; initializations. The "noautoload" vm.elc won't work without
57 ;; this.
58 (defun vm-fsfemacs-19-p () 70 (defun vm-fsfemacs-19-p ()
59 (and (string-match "^19" emacs-version) 71 (and (string-match "^19" emacs-version)
60 (not (string-match "XEmacs\\|Lucid" emacs-version)))) 72 (not (string-match "XEmacs\\|Lucid" emacs-version))))
61 73
62 (defvar vm-menu-folders-menu 74 (defvar vm-menu-folders-menu
65 "VM folder menu list.") 77 "VM folder menu list.")
66 78
67 (defconst vm-menu-folder-menu 79 (defconst vm-menu-folder-menu
68 (list 80 (list
69 "Folder" 81 "Folder"
70 (if (vm-fsfemacs-19-p) 82 (if vm-fsfemacs-19-p
71 ["Manipulate Folders" ignore (ignore)] 83 ["Manipulate Folders" ignore (ignore)]
72 vm-menu-folders-menu) 84 vm-menu-folders-menu)
73 "---" 85 "---"
74 ["Display Summary" vm-summarize t] 86 ["Display Summary" vm-summarize t]
75 ["Toggle Threading" vm-toggle-threads-display t] 87 ["Toggle Threading" vm-toggle-threads-display t]
366 :active vm-send-using-mime 378 :active vm-send-using-mime
367 :style radio 379 :style radio
368 :selected (eq vm-mime-8bit-text-transfer-encoding 'base64)])) 380 :selected (eq vm-mime-8bit-text-transfer-encoding 'base64)]))
369 "----" 381 "----"
370 ["Attach File..." vm-mime-attach-file vm-send-using-mime] 382 ["Attach File..." vm-mime-attach-file vm-send-using-mime]
371 ["Attach MIME File..." vm-mime-attach-mime-file vm-send-using-mime] 383 ;; ["Attach MIME Message..." vm-mime-attach-mime-file
384 ;; vm-send-using-mime]
372 ["Encode MIME, But Don't Send" vm-mime-encode-composition 385 ["Encode MIME, But Don't Send" vm-mime-encode-composition
373 (and vm-send-using-mime 386 (and vm-send-using-mime
374 (null (vm-mail-mode-get-header-contents "MIME-Version:")))] 387 (null (vm-mail-mode-get-header-contents "MIME-Version:")))]
375 ["Preview MIME Before Sending" vm-mime-preview-composition 388 ["Preview MIME Before Sending" vm-mime-preview-composition
376 vm-send-using-mime] 389 vm-send-using-mime]
429 ["Netscape" 442 ["Netscape"
430 (vm-mouse-send-url-at-position (point) 443 (vm-mouse-send-url-at-position (point)
431 'vm-mouse-send-url-to-netscape) 444 'vm-mouse-send-url-to-netscape)
432 t])))) 445 t]))))
433 446
447 (defconst vm-menu-mailto-url-browser-menu
448 (let ((title (if (vm-menu-fsfemacs-menus-p)
449 (list "Send Mail using ..."
450 "Send Mail using ..."
451 "---"
452 "---")
453 (list "Send Mail using ..."))))
454 (append
455 title
456 (list ["VM" (vm-mouse-send-url-at-position (point) 'ignore) t]))))
457
434 (defconst vm-menu-subject-menu 458 (defconst vm-menu-subject-menu
435 (let ((title (if (vm-menu-fsfemacs-menus-p) 459 (let ((title (if (vm-menu-fsfemacs-menus-p)
436 (list "Take Action on Subject..." 460 (list "Take Action on Subject..."
437 "Take Action on Subject..." 461 "Take Action on Subject..."
438 "---" 462 "---"
530 set to the command name so that window configuration will be done." 554 set to the command name so that window configuration will be done."
531 (setq this-command command) 555 (setq this-command command)
532 (apply command args)) 556 (apply command args))
533 557
534 (defun vm-menu-can-revert-p () 558 (defun vm-menu-can-revert-p ()
535 (save-excursion 559 (condition-case nil
536 (vm-check-for-killed-folder) 560 (save-excursion
537 (vm-select-folder-buffer) 561 (vm-select-folder-buffer)
538 (and (buffer-modified-p) buffer-file-name))) 562 (and (buffer-modified-p) buffer-file-name))
563 (error nil)))
539 564
540 (defun vm-menu-can-recover-p () 565 (defun vm-menu-can-recover-p ()
541 (save-excursion 566 (condition-case nil
542 (vm-check-for-killed-folder) 567 (save-excursion
543 (vm-select-folder-buffer) 568 (vm-select-folder-buffer)
544 (and buffer-file-name 569 (and buffer-file-name
545 buffer-auto-save-file-name 570 buffer-auto-save-file-name
546 (file-newer-than-file-p 571 (file-newer-than-file-p
547 buffer-auto-save-file-name 572 buffer-auto-save-file-name
548 buffer-file-name)))) 573 buffer-file-name)))
574 (error nil)))
549 575
550 (defun vm-menu-can-save-p () 576 (defun vm-menu-can-save-p ()
551 (save-excursion 577 (condition-case nil
552 (vm-check-for-killed-folder) 578 (save-excursion
553 (vm-select-folder-buffer) 579 (vm-select-folder-buffer)
554 (or (eq major-mode 'vm-virtual-mode) 580 (or (eq major-mode 'vm-virtual-mode)
555 (buffer-modified-p)))) 581 (buffer-modified-p)))
582 (error nil)))
556 583
557 (defun vm-menu-can-get-new-mail-p () 584 (defun vm-menu-can-get-new-mail-p ()
558 (save-excursion 585 (condition-case nil
559 (vm-check-for-killed-folder) 586 (save-excursion
560 (vm-select-folder-buffer) 587 (vm-select-folder-buffer)
561 (or (eq major-mode 'vm-virtual-mode) 588 (or (eq major-mode 'vm-virtual-mode)
562 (and (not vm-block-new-mail) (not vm-folder-read-only))))) 589 (and (not vm-block-new-mail) (not vm-folder-read-only))))
590 (error nil)))
563 591
564 (defun vm-menu-can-undo-p () 592 (defun vm-menu-can-undo-p ()
565 (save-excursion 593 (condition-case nil
566 (vm-check-for-killed-folder) 594 (save-excursion
567 (vm-select-folder-buffer) 595 (vm-select-folder-buffer)
568 vm-undo-record-list)) 596 vm-undo-record-list)
597 (error nil)))
569 598
570 (defun vm-menu-can-decode-mime-p () 599 (defun vm-menu-can-decode-mime-p ()
571 (save-excursion 600 (condition-case nil
572 (vm-check-for-killed-folder) 601 (save-excursion
573 (vm-select-folder-buffer) 602 (vm-select-folder-buffer)
574 (and vm-display-using-mime 603 (and vm-display-using-mime
575 vm-message-pointer 604 vm-message-pointer
576 vm-presentation-buffer 605 vm-presentation-buffer
577 (not vm-mime-decoded) 606 (not vm-mime-decoded)
578 (not (vm-mime-plain-message-p (car vm-message-pointer)))))) 607 (not (vm-mime-plain-message-p (car vm-message-pointer)))))
608 (error nil)))
579 609
580 (defun vm-menu-yank-original () 610 (defun vm-menu-yank-original ()
581 (interactive) 611 (interactive)
582 (save-excursion 612 (save-excursion
583 (let ((mlist vm-reply-list)) 613 (let ((mlist vm-reply-list))
662 ;; author menu 692 ;; author menu
663 (vm-easy-menu-define vm-menu-fsfemacs-author-menu (list dummy) nil 693 (vm-easy-menu-define vm-menu-fsfemacs-author-menu (list dummy) nil
664 vm-menu-author-menu) 694 vm-menu-author-menu)
665 ;; url browser menu 695 ;; url browser menu
666 (vm-easy-menu-define vm-menu-fsfemacs-url-browser-menu (list dummy) nil 696 (vm-easy-menu-define vm-menu-fsfemacs-url-browser-menu (list dummy) nil
697 vm-menu-url-browser-menu)
698 ;; mailto url browser menu
699 (vm-easy-menu-define vm-menu-fsfemacs-mailto-url-browser-menu
700 (list dummy) nil
667 vm-menu-url-browser-menu) 701 vm-menu-url-browser-menu)
668 ;; mime dispose menu 702 ;; mime dispose menu
669 (vm-easy-menu-define vm-menu-fsfemacs-mime-dispose-menu 703 (vm-easy-menu-define vm-menu-fsfemacs-mime-dispose-menu
670 (list dummy) nil 704 (list dummy) nil
671 vm-menu-mime-dispose-menu) 705 vm-menu-mime-dispose-menu)
800 (setq o-list (cdr o-list))) 834 (setq o-list (cdr o-list)))
801 (and (not found) (vm-menu-popup-fsfemacs-menu event))))))) 835 (and (not found) (vm-menu-popup-fsfemacs-menu event)))))))
802 836
803 ;; to quiet the byte-compiler 837 ;; to quiet the byte-compiler
804 (defvar vm-menu-fsfemacs-url-browser-menu) 838 (defvar vm-menu-fsfemacs-url-browser-menu)
839 (defvar vm-menu-fsfemacs-mailto-url-browser-menu)
805 (defvar vm-menu-fsfemacs-mime-dispose-menu) 840 (defvar vm-menu-fsfemacs-mime-dispose-menu)
806 841
807 (defun vm-menu-goto-event (event) 842 (defun vm-menu-goto-event (event)
808 (cond ((vm-menu-xemacs-menus-p) 843 (cond ((vm-menu-xemacs-menus-p)
809 ;; Must select window instead of just set-buffer because 844 ;; Must select window instead of just set-buffer because
810 ;; popup-menu returns before the user has made a 845 ;; popup-menu returns before the user has made a
811 ;; selection. This will cause the command loop to 846 ;; selection. This will cause the command loop to
812 ;; resume which might undo what set-buffer does. 847 ;; resume which might undo what set-buffer does.
813 (select-window (event-window event)) 848 (select-window (event-window event))
814 (and (event-point event) (goto-char (event-point event)))) 849 (and (event-closest-point event)
850 (goto-char (event-closest-point event))))
815 ((vm-menu-fsfemacs-menus-p) 851 ((vm-menu-fsfemacs-menus-p)
816 (set-buffer (window-buffer (posn-window (event-start event)))) 852 (set-buffer (window-buffer (posn-window (event-start event))))
817 (goto-char (posn-point (event-start event)))))) 853 (goto-char (posn-point (event-start event))))))
818 854
819 (defun vm-menu-popup-url-browser-menu (event) 855 (defun vm-menu-popup-url-browser-menu (event)
822 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) 858 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
823 (popup-menu vm-menu-url-browser-menu)) 859 (popup-menu vm-menu-url-browser-menu))
824 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) 860 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
825 (vm-menu-popup-fsfemacs-menu 861 (vm-menu-popup-fsfemacs-menu
826 event vm-menu-fsfemacs-url-browser-menu)))) 862 event vm-menu-fsfemacs-url-browser-menu))))
863
864 (defun vm-menu-popup-mailto-url-browser-menu (event)
865 (interactive "e")
866 (vm-menu-goto-event event)
867 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
868 (popup-menu vm-menu-mailto-url-browser-menu))
869 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
870 (vm-menu-popup-fsfemacs-menu
871 event vm-menu-fsfemacs-mailto-url-browser-menu))))
827 872
828 (defun vm-menu-popup-mime-dispose-menu (event) 873 (defun vm-menu-popup-mime-dispose-menu (event)
829 (interactive "e") 874 (interactive "e")
830 (vm-menu-goto-event event) 875 (vm-menu-goto-event event)
831 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) 876 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)