;;; Mouse, menu, and font support for VM running in Lucid Emacs
;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs 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 (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Right button pops up a menu of commands in all VM buffers.
;;; Middle button selects indicated article in VM Summary buffers.
;;; Right button in a vm-mail buffer pops up a variant of the usual
;;; send-mail menu.
(define-key vm-mode-map 'button3 'vm-menu)
(define-key vm-summary-mode-map 'button2 'vm-mouse-select)
(define-key vm-mail-mode-map 'button3 'vm-mail-mode-menu)
(defconst vm-menu
'("VM Commands"
["Next Nondeleted Message" vm-next-message t]
["Previous Nondeleted Message" vm-previous-message t]
; ["Scroll Message Forward" vm-scroll-forward t]
; ["Scroll Message Backward" vm-scroll-backward t]
; ["Beginning Of Message" vm-beginning-of-message t]
; ["End Of Message" vm-end-of-message t]
; "----"
["Display Summary" vm-summarize t]
["Get New Mail" vm-get-new-mail t]
"----"
("Motion..."
["Goto Last Seen Message" vm-goto-message-last-seen t]
["Goto Message" vm-goto-message t]
["Next Message" vm-Next-message t]
["Next Unread Message" vm-next-unread-message t]
["Next Message, Same Subject" vm-next-message-same-subject t]
["Parent Message" vm-goto-parent-message t]
["Previous Message" vm-Previous-message t]
["Previous Unread Message" vm-previous-unread-message t]
["Previous Message, Same Subject" vm-previous-message-same-subject t]
)
("Folders..."
["Save Message" vm-save-message t]
["Save Message sans Headers" vm-save-message-sans-headers t]
["Auto-archive Messages" vm-auto-archive-messages t]
["Delete Message" vm-delete-message t]
["Undelete Message" vm-undelete-message t]
["Mark Message as Unread" vm-unread-message t]
["Expunge Folder" vm-expunge-folder t]
"----"
["Visit Folder" vm-visit-folder t]
["Visit Virtual Folder" vm-visit-virtual-folder t]
["Save Buffer" vm-save-buffer t]
["Save Folder" vm-save-folder t]
["Save Folder As..." vm-write-file t]
["Change Folder Type..." vm-change-folder-type t]
)
("Sending Messages..."
["Send Mail" vm-mail t]
["Reply to Sender" vm-reply t]
["Reply to Sender (Citing Original)" vm-reply-include-text t]
["Reply to All" vm-followup t]
["Reply to All (Citing Original)" vm-followup-include-text t]
["Forward Message" vm-forward-message t]
["Resend Message" vm-resend-message t]
["Retry Bounced Message" vm-resend-bounced-message t]
["Continue Composing Message" vm-continue-composing-message t]
)
("Marking Messages..."
["Mark Message" vm-mark-message t]
["Unmark Message" vm-unmark-message t]
["Mark All Messages" vm-mark-all-messages t]
["Unmark All Messages" vm-clear-all-marks t]
["Next Command Uses Marks..." vm-next-command-uses-marks t]
"----"
["Mark Same Subject" vm-mark-messages-same-subject t]
["Unmark Same Subject" vm-unmark-messages-same-subject t]
["Mark Same Author" vm-mark-messages-same-author t]
["Unmark Same Author" vm-unmark-messages-same-author t]
["Mark Messages Matching..." vm-mark-matching-messages t]
["Unmark Messages Matching..." vm-unmark-matching-messages t]
["Mark Thread Subtree" vm-mark-thread-subtree t]
["Unmark Thread Subtree" vm-unmark-thread-subtree t]
"----"
["Add Label to Message..." vm-add-message-labels t]
["Remove Label from Message..." vm-delete-message-labels t]
["Set Message Attributes..." vm-set-message-attributes t]
)
("Sorting..."
["Toggle Threading" vm-toggle-threads-display t]
["Sort by Date" (vm-sort-messages "date" t) t]
["Sort by Subject" (vm-sort-messages "subject" t) t]
["Sort by Author" (vm-sort-messages "author" t) t]
["Sort by Recipients" (vm-sort-messages "recipients" t) t]
["Sort by Lines" (vm-sort-messages "line-count" t) t]
["Sort by Bytes" (vm-sort-messages "byte-count" t) t]
"---"
["Sort by Date (backward)" (vm-sort-messages "reversed-date" t) t]
["Sort by Subject (backward)" (vm-sort-messages "reversed-subject" t) t]
["Sort by Author (backward)" (vm-sort-messages "reversed-author" t) t]
["Sort by Recipients (backward)" (vm-sort-messages
"reversed-recipients" t) t]
["Sort by Lines (backwards)" (vm-sort-messages
"reversed-line-count" t) t]
["Sort by Bytes (backward)" (vm-sort-messages
"reversed-byte-count" t) t]
"---"
["Move Message Backward" vm-move-message-backward t]
["Move Message Forward" vm-move-message-forward t]
;; ["Sort by Date" vm-sort-by-date t]
;; ["Sort by Subject" vm-sort-by-subject t]
;; ["Sort by Author" vm-sort-by-author t]
;; ["Sort by Author/Recipient" vm-sort-by-author-dwim t]
;; ["Sort by Size" vm-sort-by-lines t]
;; ["Group Messages..." vm-group-messages t]
)
("Digests..."
["Send Folder as Digest" vm-send-digest t]
["Burst Message as Digest" vm-burst-digest t]
)
("Window Configurations..."
["Apply Window Configuration" vm-apply-window-configuration t]
["Delete Window Configuration" vm-delete-window-configuration t]
["Save Window Configuration" vm-save-window-configuration t]
)
("Miscellaneous..."
["Edit Message" vm-edit-message t]
["Toggle Hidden Headers" vm-expose-hidden-headers t]
["Isearch Folder..." vm-isearch-forward t]
; ["Discard Cached Data" vm-discard-cached-data t]
["Kill Subject..." vm-kill-subject t]
["Reload ~/.vm" vm-load-init-file t]
["Pipe Message To Command..." vm-pipe-message-to-command t]
["Shell Command..." shell-command t]
["Show Copying Restrictions" vm-show-copying-restrictions t]
["Show No Warranty" vm-show-no-warranty t]
("BBDB"
["Show Sender" bbdb/vm-show-sender t]
["Edit Notes" bbdb/vm-edit-notes t])
)
"----"
; ["Help" vm-help t]
["Help" describe-mode t]
["Undo" vm-undo t]
["Quit" vm-quit t]
["Quit Without Saving" vm-quit-no-change t]
))
(defun vm-menu (e)
(interactive "e")
(let ((marks-p (eq last-command 'vm-next-command-uses-marks)))
(mouse-set-point e)
(beginning-of-line)
(popup-menu vm-menu)
(if marks-p (setq this-command 'vm-next-command-uses-marks))))
(defun vm-mouse-select (e)
(interactive "e")
(mouse-set-point e)
(beginning-of-line)
(or (eq major-mode 'vm-summary-mode) (error ""))
(let ((vm-follow-summary-cursor t))
(vm-scroll-forward)))
;;; Highlight the line under the mouse in the folder and summary buffers.
(defun vm-install-mouse-tracker ()
(require 'mode-motion)
(setq mode-motion-hook 'mode-motion-highlight-line))
(add-hook 'vm-summary-mode-hook 'vm-install-mouse-tracker)
;;; Put the VM menu in the menubar
(defun vm-install-menubar ()
(if (and current-menubar (not (assoc "VM" current-menubar)))
(progn
(set-buffer-menubar (copy-sequence current-menubar))
(add-menu nil "VM" (cdr vm-menu)))))
(add-hook 'vm-mode-hook 'vm-install-menubar)
(add-hook 'vm-summary-mode-hook 'vm-install-menubar)
;;; `vm-mail' versus `mail'...
(require 'sendmail)
(defvar vm-mail-mode-menu ; derived from mail-mode-menu in sendmail.el
(let* ((menu (copy-sequence mail-mode-menu))
(rest menu)
item)
(while rest
(setq item (car rest))
(cond ((not (vectorp item)) nil)
((eq (aref item 1) 'mail-send-and-exit)
(aset (setq item (copy-sequence item)) 1 'vm-mail-send-and-exit))
((eq (aref item 1) 'mail-send)
(aset (setq item (copy-sequence item)) 1 'vm-mail-send))
((eq (aref item 1) 'mail-yank-original)
(aset (setq item (copy-sequence item)) 1 'vm-yank-message)
(setcdr rest (cons '["Yank Message (Other Folder)"
vm-yank-message-other-folder t]
(cdr rest))))
)
(setcar rest item)
(setq rest (cdr rest)))
menu))
(defun vm-mail-mode-menu (event)
"Pop up the VM mail mode menu, defined by the variable `vm-mail-mode-menu'."
(interactive "e")
(let ((mail-mode-menu vm-mail-mode-menu))
;; This does some tricky stuff to sensitize items appropriately.
(mail-mode-menu event)))
(provide 'vm-lucid)