Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-menu.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 05472e90ae02
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; Menu related functions and commands 1 ;;; Menu related functions and commands
2 ;;; Copyright (C) 1995, 1997 Kyle E. Jones 2 ;;; Copyright (C) 1995 Kyle E. Jones
3 ;;; 3 ;;;
4 ;;; Folders menu derived from 4 ;;; Folders menu derived from
5 ;;; vm-folder-menu.el 5 ;;; vm-folder-menu.el
6 ;;; v1.10; 03-May-1994 6 ;;; v1.10; 03-May-1994
7 ;;; Copyright (C) 1994 Heiko Muenkel 7 ;;; Copyright (C) 1994 Heiko Muenkel
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
62 (defun vm-menu-fsfemacs-menus-p () 47 (defun vm-menu-fsfemacs-menus-p ()
63 (and vm-fsfemacs-19-p 48 (and (vm-fsfemacs-19-p)
64 (fboundp 'menu-bar-mode))) 49 (fboundp 'menu-bar-mode)))
65 50
66 (defun vm-menu-xemacs-menus-p () 51 (defun vm-menu-xemacs-menus-p ()
67 (and vm-xemacs-p 52 (and (vm-xemacs-p)
68 (fboundp 'set-buffer-menubar))) 53 (fboundp 'set-buffer-menubar)))
69 54
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.
70 (defun vm-fsfemacs-19-p () 58 (defun vm-fsfemacs-19-p ()
71 (and (string-match "^19" emacs-version) 59 (and (string-match "^19" emacs-version)
72 (not (string-match "XEmacs\\|Lucid" emacs-version)))) 60 (not (string-match "XEmacs\\|Lucid" emacs-version))))
73 61
74 (defvar vm-menu-folders-menu 62 (defvar vm-menu-folders-menu
77 "VM folder menu list.") 65 "VM folder menu list.")
78 66
79 (defconst vm-menu-folder-menu 67 (defconst vm-menu-folder-menu
80 (list 68 (list
81 "Folder" 69 "Folder"
82 (if vm-fsfemacs-19-p 70 (if (vm-fsfemacs-19-p)
83 ["Manipulate Folders" ignore (ignore)] 71 ["Manipulate Folders" ignore (ignore)]
84 vm-menu-folders-menu) 72 vm-menu-folders-menu)
85 "---" 73 "---"
86 ["Display Summary" vm-summarize t] 74 ["Display Summary" vm-summarize t]
87 ["Toggle Threading" vm-toggle-threads-display t] 75 ["Toggle Threading" vm-toggle-threads-display t]
133 ["Edit" vm-edit-message vm-message-list] 121 ["Edit" vm-edit-message vm-message-list]
134 ["Print" vm-print-message vm-message-list] 122 ["Print" vm-print-message vm-message-list]
135 ["Pipe to Command" vm-pipe-message-to-command vm-message-list] 123 ["Pipe to Command" vm-pipe-message-to-command vm-message-list]
136 "---" 124 "---"
137 ["Burst Message as Digest" (vm-burst-digest "guess") vm-message-list] 125 ["Burst Message as Digest" (vm-burst-digest "guess") vm-message-list]
138 ["Decode MIME" vm-decode-mime-message (vm-menu-can-decode-mime-p)]
139 )))) 126 ))))
140 127
141 (defconst vm-menu-motion-menu 128 (defconst vm-menu-motion-menu
142 '("Motion" 129 '("Motion"
143 ["Page Up" vm-scroll-backward vm-message-list] 130 ["Page Up" vm-scroll-backward vm-message-list]
189 ["Forward Message" vm-forward-message vm-message-list] 176 ["Forward Message" vm-forward-message vm-message-list]
190 ["Resend Message" vm-resend-message vm-message-list] 177 ["Resend Message" vm-resend-message vm-message-list]
191 ["Retry Bounced Message" vm-resend-bounced-message vm-message-list] 178 ["Retry Bounced Message" vm-resend-bounced-message vm-message-list]
192 ["Send Digest (RFC934)" vm-send-rfc934-digest vm-message-list] 179 ["Send Digest (RFC934)" vm-send-rfc934-digest vm-message-list]
193 ["Send Digest (RFC1153)" vm-send-rfc1153-digest vm-message-list] 180 ["Send Digest (RFC1153)" vm-send-rfc1153-digest vm-message-list]
194 ["Send MIME Digest" vm-send-mime-digest vm-message-list]
195 )) 181 ))
196 182
197 (defconst vm-menu-mark-menu 183 (defconst vm-menu-mark-menu
198 '("Mark" 184 '("Mark"
199 ["Next Command Uses Marks..." vm-next-command-uses-marks 185 ["Next Command Uses Marks..." vm-next-command-uses-marks
203 "----" 189 "----"
204 ["Mark" vm-mark-message vm-message-list] 190 ["Mark" vm-mark-message vm-message-list]
205 ["Unmark" vm-unmark-message vm-message-list] 191 ["Unmark" vm-unmark-message vm-message-list]
206 ["Mark All" vm-mark-all-messages vm-message-list] 192 ["Mark All" vm-mark-all-messages vm-message-list]
207 ["Clear All Marks" vm-clear-all-marks vm-message-list] 193 ["Clear All Marks" vm-clear-all-marks vm-message-list]
208 ["Mark Region in Summary" vm-mark-summary-region vm-message-list]
209 ["Unmark Region in Summary" vm-unmark-summary-region vm-message-list]
210 "----" 194 "----"
211 ["Mark Same Subject" vm-mark-messages-same-subject vm-message-list] 195 ["Mark Same Subject" vm-mark-messages-same-subject vm-message-list]
212 ["Unmark Same Subject" vm-unmark-messages-same-subject vm-message-list] 196 ["Unmark Same Subject" vm-unmark-messages-same-subject vm-message-list]
213 ["Mark Same Author" vm-mark-messages-same-author vm-message-list] 197 ["Mark Same Author" vm-mark-messages-same-author vm-message-list]
214 ["Unmark Same Author" vm-unmark-messages-same-author vm-message-list] 198 ["Unmark Same Author" vm-unmark-messages-same-author vm-message-list]
281 title 265 title
282 (list ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)] 266 (list ["Send and Exit" vm-mail-send-and-exit (vm-menu-can-send-mail-p)]
283 ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)] 267 ["Send, Keep Composing" vm-mail-send (vm-menu-can-send-mail-p)]
284 ["Cancel" kill-buffer t] 268 ["Cancel" kill-buffer t]
285 "----" 269 "----"
270 "Go to Field:"
271 "----"
272 [" To:" mail-to t]
273 [" Subject:" mail-subject t]
274 [" CC:" mail-cc t]
275 [" BCC:" mail-bcc t]
276 [" Reply-To:" mail-replyto t]
277 [" Text" mail-text t]
278 "----"
286 ["Yank Original" vm-menu-yank-original vm-reply-list] 279 ["Yank Original" vm-menu-yank-original vm-reply-list]
287 "----" 280 ["Fill Yanked Message" mail-fill-yanked-message t]
288 (append 281 ["Insert Signature" mail-signature t]
289 (if (vm-menu-fsfemacs-menus-p) 282 ["Insert File..." insert-file t]
290 (list "Send Using MIME..." 283 ["Insert Buffer..." insert-buffer t]
291 "Send Using MIME..."
292 "---"
293 "---")
294 (list "Send Using MIME..."))
295 (list
296 ["Use MIME"
297 (set (make-local-variable 'vm-send-using-mime) t)
298 :active t
299 :style radio
300 :selected vm-send-using-mime]
301 ["Don't use MIME"
302 (set (make-local-variable 'vm-send-using-mime) nil)
303 :active t
304 :style radio
305 :selected (not vm-send-using-mime)]))
306 (append
307 (if (vm-menu-fsfemacs-menus-p)
308 (list "Fragment Messages Larger Than ..."
309 "Fragment Messages Larger Than ..."
310 "---"
311 "---")
312 (list "Fragment Messages Larger Than ..."))
313 (list ["Infinity, i.e., don't fragment"
314 (set (make-local-variable 'vm-mime-max-message-size) nil)
315 :active vm-send-using-mime
316 :style radio
317 :selected (eq vm-mime-max-message-size nil)]
318 ["50000 bytes"
319 (set (make-local-variable 'vm-mime-max-message-size)
320 50000)
321 :active vm-send-using-mime
322 :style radio
323 :selected (eq vm-mime-max-message-size 50000)]
324 ["100000 bytes"
325 (set (make-local-variable 'vm-mime-max-message-size)
326 100000)
327 :active vm-send-using-mime
328 :style radio
329 :selected (eq vm-mime-max-message-size 100000)]
330 ["200000 bytes"
331 (set (make-local-variable 'vm-mime-max-message-size)
332 200000)
333 :active vm-send-using-mime
334 :style radio
335 :selected (eq vm-mime-max-message-size 200000)]
336 ["500000 bytes"
337 (set (make-local-variable 'vm-mime-max-message-size)
338 500000)
339 :active vm-send-using-mime
340 :style radio
341 :selected (eq vm-mime-max-message-size 500000)]
342 ["1000000 bytes"
343 (set (make-local-variable 'vm-mime-max-message-size)
344 1000000)
345 :active vm-send-using-mime
346 :style radio
347 :selected (eq vm-mime-max-message-size 1000000)]
348 ["2000000 bytes"
349 (set (make-local-variable 'vm-mime-max-message-size)
350 2000000)
351 :active vm-send-using-mime
352 :style radio
353 :selected (eq vm-mime-max-message-size 2000000)]))
354 (append
355 (if (vm-menu-fsfemacs-menus-p)
356 (list "Encode 8-bit Characters Using ..."
357 "Encode 8-bit Characters Using ..."
358 "---"
359 "---")
360 (list "Encode 8-bit Characters Using ..."))
361 (list
362 ["Nothing, i.e., send unencoded"
363 (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
364 '8bit)
365 :active vm-send-using-mime
366 :style radio
367 :selected (eq vm-mime-8bit-text-transfer-encoding '8bit)]
368 ["Quoted-Printable"
369 (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
370 'quoted-printable)
371 :active vm-send-using-mime
372 :style radio
373 :selected (eq vm-mime-8bit-text-transfer-encoding
374 'quoted-printable)]
375 ["BASE64"
376 (set (make-local-variable 'vm-mime-8bit-text-transfer-encoding)
377 'base64)
378 :active vm-send-using-mime
379 :style radio
380 :selected (eq vm-mime-8bit-text-transfer-encoding 'base64)]))
381 "----"
382 ["Attach File..." vm-mime-attach-file vm-send-using-mime]
383 ;; ["Attach MIME Message..." vm-mime-attach-mime-file
384 ;; vm-send-using-mime]
385 ["Encode MIME, But Don't Send" vm-mime-encode-composition
386 (and vm-send-using-mime
387 (null (vm-mail-mode-get-header-contents "MIME-Version:")))]
388 ["Preview MIME Before Sending" vm-mime-preview-composition
389 vm-send-using-mime]
390 )))) 284 ))))
391
392 (defconst vm-menu-mime-dispose-menu
393 (let ((title (if (vm-menu-fsfemacs-menus-p)
394 (list "Take Action on MIME body ..."
395 "Take Action on MIME body ..."
396 "---"
397 "---")
398 (list "Take Action on MIME body ..."))))
399 (append
400 title
401 (list ["Display as US-ASCII Text"
402 (vm-mime-run-display-function-at-point
403 'vm-mime-display-body-as-text) t]
404 ["Display using External Viewer"
405 (vm-mime-run-display-function-at-point
406 'vm-mime-display-body-using-external-viewer) t]
407 "---"
408 ["Save to File" (vm-mime-run-display-function-at-point
409 'vm-mime-send-body-to-file) t]
410 ["Send to Printer" (vm-mime-run-display-function-at-point
411 'vm-mime-send-body-to-printer) t]
412 ["Feed to Shell Pipeline (display output)"
413 (vm-mime-run-display-function-at-point
414 'vm-mime-pipe-body-to-queried-command) t]
415 ["Feed to Shell Pipeline (discard output)"
416 (vm-mime-run-display-function-at-point
417 'vm-mime-pipe-body-to-queried-command-discard-output) t]))))
418 285
419 (defconst vm-menu-url-browser-menu 286 (defconst vm-menu-url-browser-menu
420 (let ((title (if (vm-menu-fsfemacs-menus-p) 287 (let ((title (if (vm-menu-fsfemacs-menus-p)
421 (list "Send URL to ..." 288 (list "Send URL to ..."
422 "Send URL to ..." 289 "Send URL to ..."
442 ["Netscape" 309 ["Netscape"
443 (vm-mouse-send-url-at-position (point) 310 (vm-mouse-send-url-at-position (point)
444 'vm-mouse-send-url-to-netscape) 311 'vm-mouse-send-url-to-netscape)
445 t])))) 312 t]))))
446 313
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
458 (defconst vm-menu-subject-menu 314 (defconst vm-menu-subject-menu
459 (let ((title (if (vm-menu-fsfemacs-menus-p) 315 (let ((title (if (vm-menu-fsfemacs-menus-p)
460 (list "Take Action on Subject..." 316 (list "Take Action on Subject..."
461 "Take Action on Subject..." 317 "Take Action on Subject..."
462 "---" 318 "---"
494 vm-message-list] 350 vm-message-list]
495 ["Virtual Folder, Matching Author" vm-menu-create-author-virtual-folder 351 ["Virtual Folder, Matching Author" vm-menu-create-author-virtual-folder
496 vm-message-list] 352 vm-message-list]
497 )))) 353 ))))
498 354
499 (defconst vm-menu-content-disposition-menu
500 (let ((title (if (vm-menu-fsfemacs-menus-p)
501 (list "Set Content Disposition"
502 "Set Content Disposition"
503 "---"
504 "---")
505 (list "Set Content Disposition"))))
506 (append
507 title
508 (list ["Unspecified"
509 (vm-mime-set-attachment-disposition-at-point 'unspecified)
510 :active vm-send-using-mime
511 :style radio
512 :selected (eq (vm-mime-attachment-disposition-at-point)
513 'unspecified)]
514 ["Inline"
515 (vm-mime-set-attachment-disposition-at-point 'inline)
516 :active vm-send-using-mime
517 :style radio
518 :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)]
519 ["Attachment"
520 (vm-mime-set-attachment-disposition-at-point 'attachment)
521 :active vm-send-using-mime
522 :style radio
523 :selected (eq (vm-mime-attachment-disposition-at-point)
524 'attachment)]))))
525
526 (defvar vm-menu-vm-menubar nil) 355 (defvar vm-menu-vm-menubar nil)
527 356
528 (defconst vm-menu-vm-menu 357 (defconst vm-menu-vm-menu
529 (let ((title (if (vm-menu-fsfemacs-menus-p) 358 (let ((title (if (vm-menu-fsfemacs-menus-p)
530 (list "VM" 359 (list "VM"
538 vm-menu-send-menu 367 vm-menu-send-menu
539 vm-menu-mark-menu 368 vm-menu-mark-menu
540 vm-menu-label-menu 369 vm-menu-label-menu
541 vm-menu-sort-menu 370 vm-menu-sort-menu
542 vm-menu-virtual-menu 371 vm-menu-virtual-menu
543 ;; vm-menu-undo-menu 372 vm-menu-undo-menu
544 vm-menu-dispose-menu 373 vm-menu-dispose-menu
545 "---" 374 "---"
546 "---" 375 "---"
547 vm-menu-help-menu)))) 376 vm-menu-help-menu))))
548 377
554 set to the command name so that window configuration will be done." 383 set to the command name so that window configuration will be done."
555 (setq this-command command) 384 (setq this-command command)
556 (apply command args)) 385 (apply command args))
557 386
558 (defun vm-menu-can-revert-p () 387 (defun vm-menu-can-revert-p ()
559 (condition-case nil 388 (save-excursion
560 (save-excursion 389 (vm-check-for-killed-folder)
561 (vm-select-folder-buffer) 390 (vm-select-folder-buffer)
562 (and (buffer-modified-p) buffer-file-name)) 391 (and (buffer-modified-p) buffer-file-name)))
563 (error nil)))
564 392
565 (defun vm-menu-can-recover-p () 393 (defun vm-menu-can-recover-p ()
566 (condition-case nil 394 (save-excursion
567 (save-excursion 395 (vm-check-for-killed-folder)
568 (vm-select-folder-buffer) 396 (vm-select-folder-buffer)
569 (and buffer-file-name 397 (and buffer-file-name
570 buffer-auto-save-file-name 398 buffer-auto-save-file-name
571 (file-newer-than-file-p 399 (file-newer-than-file-p
572 buffer-auto-save-file-name 400 buffer-auto-save-file-name
573 buffer-file-name))) 401 buffer-file-name))))
574 (error nil)))
575 402
576 (defun vm-menu-can-save-p () 403 (defun vm-menu-can-save-p ()
577 (condition-case nil 404 (save-excursion
578 (save-excursion 405 (vm-check-for-killed-folder)
579 (vm-select-folder-buffer) 406 (vm-select-folder-buffer)
580 (or (eq major-mode 'vm-virtual-mode) 407 (or (eq major-mode 'vm-virtual-mode)
581 (buffer-modified-p))) 408 (buffer-modified-p))))
582 (error nil)))
583 409
584 (defun vm-menu-can-get-new-mail-p () 410 (defun vm-menu-can-get-new-mail-p ()
585 (condition-case nil 411 (save-excursion
586 (save-excursion 412 (vm-check-for-killed-folder)
587 (vm-select-folder-buffer) 413 (vm-select-folder-buffer)
588 (or (eq major-mode 'vm-virtual-mode) 414 (or (eq major-mode 'vm-virtual-mode)
589 (and (not vm-block-new-mail) (not vm-folder-read-only)))) 415 (and (not vm-block-new-mail) (not vm-folder-read-only)))))
590 (error nil)))
591 416
592 (defun vm-menu-can-undo-p () 417 (defun vm-menu-can-undo-p ()
593 (condition-case nil 418 (save-excursion
594 (save-excursion 419 (vm-check-for-killed-folder)
595 (vm-select-folder-buffer) 420 (vm-select-folder-buffer)
596 vm-undo-record-list) 421 vm-undo-record-list))
597 (error nil)))
598
599 (defun vm-menu-can-decode-mime-p ()
600 (condition-case nil
601 (save-excursion
602 (vm-select-folder-buffer)
603 (and vm-display-using-mime
604 vm-message-pointer
605 vm-presentation-buffer
606 (not vm-mime-decoded)
607 (not (vm-mime-plain-message-p (car vm-message-pointer)))))
608 (error nil)))
609 422
610 (defun vm-menu-yank-original () 423 (defun vm-menu-yank-original ()
611 (interactive) 424 (interactive)
612 (save-excursion 425 (save-excursion
613 (let ((mlist vm-reply-list)) 426 (let ((mlist vm-reply-list))
620 (save-match-data 433 (save-match-data
621 (catch 'done 434 (catch 'done
622 (let ((headers '("to" "cc" "bcc" "resent-to" "resent-cc" "resent-bcc")) 435 (let ((headers '("to" "cc" "bcc" "resent-to" "resent-cc" "resent-bcc"))
623 h) 436 h)
624 (while headers 437 (while headers
625 (setq h (vm-mail-mode-get-header-contents (car headers))) 438 (setq h (mail-fetch-field (car headers)))
626 (and (stringp h) (string-match "[^ \t\n,]" h) 439 (and (stringp h) (string-match "[^ \t\n,]" h)
627 (throw 'done t)) 440 (throw 'done t))
628 (setq headers (cdr headers))) 441 (setq headers (cdr headers)))
629 nil )))) 442 nil ))))
630 443
693 (vm-easy-menu-define vm-menu-fsfemacs-author-menu (list dummy) nil 506 (vm-easy-menu-define vm-menu-fsfemacs-author-menu (list dummy) nil
694 vm-menu-author-menu) 507 vm-menu-author-menu)
695 ;; url browser menu 508 ;; url browser menu
696 (vm-easy-menu-define vm-menu-fsfemacs-url-browser-menu (list dummy) nil 509 (vm-easy-menu-define vm-menu-fsfemacs-url-browser-menu (list dummy) nil
697 vm-menu-url-browser-menu) 510 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
701 vm-menu-url-browser-menu)
702 ;; mime dispose menu
703 (vm-easy-menu-define vm-menu-fsfemacs-mime-dispose-menu
704 (list dummy) nil
705 vm-menu-mime-dispose-menu)
706 ;; content disposition menu
707 (vm-easy-menu-define vm-menu-fsfemacs-content-disposition-menu
708 (list dummy) nil
709 vm-menu-content-disposition-menu)
710 ;; block the global menubar entries in the map so that VM 511 ;; block the global menubar entries in the map so that VM
711 ;; can take over the menubar if necessary. 512 ;; can take over the menubar if necessary.
712 (define-key map [rootmenu] (make-sparse-keymap)) 513 (define-key map [rootmenu] (make-sparse-keymap))
713 (define-key map [rootmenu vm] (cons "VM" (make-sparse-keymap "VM"))) 514 (define-key map [rootmenu vm] (cons "VM" (make-sparse-keymap "VM")))
714 (define-key map [rootmenu vm file] 'undefined) 515 (define-key map [rootmenu vm file] 'undefined)
750 ;; menus appear in the opposite order that we 551 ;; menus appear in the opposite order that we
751 ;; define-key them. 552 ;; define-key them.
752 (menu-list 553 (menu-list
753 (if (consp vm-use-menus) 554 (if (consp vm-use-menus)
754 (reverse vm-use-menus) 555 (reverse vm-use-menus)
755 (list 'help nil 'dispose 'virtual 'sort 556 (list 'help nil 'dispose 'undo 'virtual 'sort
756 'label 'mark 'send 'motion 'folder)))) 557 'label 'mark 'send 'motion 'folder))))
757 (while menu-list 558 (while menu-list
758 (if (null (car menu-list)) 559 (if (null (car menu-list))
759 nil;; no flushright support in FSF Emacs 560 nil;; no flushright support in FSF Emacs
760 (aset vec 2 (intern (concat "vm-menubar-" 561 (aset vec 2 (intern (concat "vm-menubar-"
801 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) 602 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
802 (set-buffer (window-buffer (posn-window (event-start event)))) 603 (set-buffer (window-buffer (posn-window (event-start event))))
803 (goto-char (posn-point (event-start event))) 604 (goto-char (posn-point (event-start event)))
804 (vm-menu-popup-fsfemacs-menu event)))) 605 (vm-menu-popup-fsfemacs-menu event))))
805 606
806 (defvar vm-menu-fsfemacs-content-disposition-menu)
807 (defun vm-menu-popup-context-menu (event) 607 (defun vm-menu-popup-context-menu (event)
808 (interactive "e") 608 (interactive "e")
809 ;; We should not need to do anything here for XEmacs. The 609 ;; We should not need to do anything here for XEmacs. The
810 ;; default binding of mouse-3 is popup-mode-menu which does 610 ;; default binding of mouse-3 is popup-mode-menu which does
811 ;; what we want for the normal case. For special contexts, 611 ;; what we want for the normal case. For special contexts,
814 ;; contained in an extent with a keymap that has mouse-3 bound 614 ;; contained in an extent with a keymap that has mouse-3 bound
815 ;; to a function that will pop up a context sensitive menu. 615 ;; to a function that will pop up a context sensitive menu.
816 (cond ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) 616 (cond ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
817 (set-buffer (window-buffer (posn-window (event-start event)))) 617 (set-buffer (window-buffer (posn-window (event-start event))))
818 (goto-char (posn-point (event-start event))) 618 (goto-char (posn-point (event-start event)))
819 (if (get-text-property (point) 'vm-mime-object) 619 (let (o-list o menu (found nil))
820 (vm-menu-popup-fsfemacs-menu 620 (setq o-list (overlays-at (point)))
821 event vm-menu-fsfemacs-content-disposition-menu) 621 (while (and o-list (not found))
822 (let (o-list o menu (found nil)) 622 (cond ((overlay-get (car o-list) 'vm-url)
823 (setq o-list (overlays-at (point))) 623 (setq found t)
824 (while (and o-list (not found)) 624 (vm-menu-popup-url-browser-menu event))
825 (cond ((overlay-get (car o-list) 'vm-url) 625 ((setq menu (overlay-get (car o-list) 'vm-header))
826 (setq found t) 626 (setq found t)
827 (vm-menu-popup-url-browser-menu event)) 627 (vm-menu-popup-fsfemacs-menu event menu)))
828 ((setq menu (overlay-get (car o-list) 'vm-header)) 628 (setq o-list (cdr o-list)))
829 (setq found t) 629 (and (not found) (vm-menu-popup-fsfemacs-menu event))))))
830 (vm-menu-popup-fsfemacs-menu event menu))
831 ((overlay-get (car o-list) 'vm-mime-layout)
832 (setq found t)
833 (vm-menu-popup-mime-dispose-menu event)))
834 (setq o-list (cdr o-list)))
835 (and (not found) (vm-menu-popup-fsfemacs-menu event)))))))
836 630
837 ;; to quiet the byte-compiler 631 ;; to quiet the byte-compiler
838 (defvar vm-menu-fsfemacs-url-browser-menu) 632 (defvar vm-menu-fsfemacs-url-browser-menu)
839 (defvar vm-menu-fsfemacs-mailto-url-browser-menu) 633
840 (defvar vm-menu-fsfemacs-mime-dispose-menu) 634 (defun vm-menu-popup-url-browser-menu (event)
841 635 (interactive "e")
842 (defun vm-menu-goto-event (event) 636 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
843 (cond ((vm-menu-xemacs-menus-p)
844 ;; Must select window instead of just set-buffer because 637 ;; Must select window instead of just set-buffer because
845 ;; popup-menu returns before the user has made a 638 ;; popup-menu returns before the user has made a
846 ;; selection. This will cause the command loop to 639 ;; selection. This will cause the command loop to
847 ;; resume which might undo what set-buffer does. 640 ;; resume which might undo what set-buffer does.
848 (select-window (event-window event)) 641 (select-window (event-window event))
849 (and (event-closest-point event) 642 (and (event-point event) (goto-char (event-point event)))
850 (goto-char (event-closest-point event))))
851 ((vm-menu-fsfemacs-menus-p)
852 (set-buffer (window-buffer (posn-window (event-start event))))
853 (goto-char (posn-point (event-start event))))))
854
855 (defun vm-menu-popup-url-browser-menu (event)
856 (interactive "e")
857 (vm-menu-goto-event event)
858 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
859 (popup-menu vm-menu-url-browser-menu)) 643 (popup-menu vm-menu-url-browser-menu))
860 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) 644 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
645 (set-buffer (window-buffer (posn-window (event-start event))))
646 (goto-char (posn-point (event-start event)))
861 (vm-menu-popup-fsfemacs-menu 647 (vm-menu-popup-fsfemacs-menu
862 event vm-menu-fsfemacs-url-browser-menu)))) 648 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))))
872
873 (defun vm-menu-popup-mime-dispose-menu (event)
874 (interactive "e")
875 (vm-menu-goto-event event)
876 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
877 (popup-menu vm-menu-mime-dispose-menu))
878 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
879 (vm-menu-popup-fsfemacs-menu
880 event vm-menu-fsfemacs-mime-dispose-menu))))
881
882 (defun vm-menu-popup-content-disposition-menu (event)
883 (interactive "e")
884 (vm-menu-goto-event event)
885 (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
886 (popup-menu vm-menu-content-disposition-menu))
887 ((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
888 (vm-menu-popup-fsfemacs-menu
889 event vm-menu-fsfemacs-content-disposition-menu))))
890 649
891 ;; to quiet the byte-compiler 650 ;; to quiet the byte-compiler
892 (defvar vm-menu-fsfemacs-mail-menu) 651 (defvar vm-menu-fsfemacs-mail-menu)
893 (defvar vm-menu-fsfemacs-dispose-popup-menu) 652 (defvar vm-menu-fsfemacs-dispose-popup-menu)
894 (defvar vm-menu-fsfemacs-vm-menu) 653 (defvar vm-menu-fsfemacs-vm-menu)
912 671
913 (defun vm-menu-mode-menu () 672 (defun vm-menu-mode-menu ()
914 (if (vm-menu-xemacs-menus-p) 673 (if (vm-menu-xemacs-menus-p)
915 (cond ((eq major-mode 'mail-mode) 674 (cond ((eq major-mode 'mail-mode)
916 vm-menu-mail-menu) 675 vm-menu-mail-menu)
917 ((memq major-mode '(vm-mode vm-presentation-mode 676 ((memq major-mode '(vm-mode vm-summary-mode vm-virtual-mode))
918 vm-summary-mode vm-virtual-mode))
919 vm-menu-dispose-menu) 677 vm-menu-dispose-menu)
920 (t vm-menu-vm-menu)) 678 (t vm-menu-vm-menu))
921 (cond ((eq major-mode 'mail-mode) 679 (cond ((eq major-mode 'mail-mode)
922 vm-menu-fsfemacs-mail-menu) 680 vm-menu-fsfemacs-mail-menu)
923 ((memq major-mode '(vm-mode vm-summary-mode vm-virtual-mode)) 681 ((memq major-mode '(vm-mode vm-summary-mode vm-virtual-mode))
936 (set-buffer buffer) 694 (set-buffer buffer)
937 (vm-select-folder-buffer)) 695 (vm-select-folder-buffer))
938 (cond ((vm-menu-xemacs-menus-p) 696 (cond ((vm-menu-xemacs-menus-p)
939 (if (null (car (find-menu-item current-menubar '("XEmacs")))) 697 (if (null (car (find-menu-item current-menubar '("XEmacs"))))
940 (set-buffer-menubar vm-menu-vm-menubar) 698 (set-buffer-menubar vm-menu-vm-menubar)
941 ;; copy the current menubar in case it has been changed.
942 (make-local-variable 'vm-menu-vm-menubar)
943 (setq vm-menu-vm-menubar (copy-sequence current-menubar))
944 (set-buffer-menubar (copy-sequence (vm-menu-xemacs-global-menubar))) 699 (set-buffer-menubar (copy-sequence (vm-menu-xemacs-global-menubar)))
945 (condition-case nil 700 (condition-case nil
946 (add-menu-button nil vm-menu-vm-button nil) 701 (add-menu-button nil vm-menu-vm-button nil)
947 (void-function 702 (void-function
948 (add-menu-item nil "VM" 'vm-menu-toggle-menubar t)))) 703 (add-menu-item nil "VM" 'vm-menu-toggle-menubar t))))
949 (vm-menu-set-menubar-dirty-flag) 704 (vm-menu-set-menubar-dirty-flag)
950 (vm-check-for-killed-summary) 705 (vm-check-for-killed-summary)
951 (and vm-summary-buffer 706 (and vm-summary-buffer
952 (save-excursion 707 (vm-menu-toggle-menubar vm-summary-buffer)))
953 (vm-menu-toggle-menubar vm-summary-buffer)))
954 (vm-check-for-killed-presentation)
955 (and vm-presentation-buffer-handle
956 (save-excursion
957 (vm-menu-toggle-menubar vm-presentation-buffer-handle))))
958 ((vm-menu-fsfemacs-menus-p) 708 ((vm-menu-fsfemacs-menus-p)
959 (if (not (eq (lookup-key vm-mode-map [menu-bar]) 709 (if (not (eq (lookup-key vm-mode-map [menu-bar])
960 (lookup-key vm-mode-menu-map [rootmenu vm]))) 710 (lookup-key vm-mode-menu-map [rootmenu vm])))
961 (define-key vm-mode-map [menu-bar] 711 (define-key vm-mode-map [menu-bar]
962 (lookup-key vm-mode-menu-map [rootmenu vm])) 712 (lookup-key vm-mode-menu-map [rootmenu vm]))
967 (vm-menu-set-menubar-dirty-flag)))) 717 (vm-menu-set-menubar-dirty-flag))))
968 718
969 (defun vm-menu-install-menubar () 719 (defun vm-menu-install-menubar ()
970 (cond ((vm-menu-xemacs-menus-p) 720 (cond ((vm-menu-xemacs-menus-p)
971 (setq vm-menu-vm-menubar (vm-menu-make-xemacs-menubar)) 721 (setq vm-menu-vm-menubar (vm-menu-make-xemacs-menubar))
972 (set-buffer-menubar vm-menu-vm-menubar) 722 (set-buffer-menubar vm-menu-vm-menubar))
973 (run-hooks 'vm-menu-setup-hook)
974 (setq vm-menu-vm-menubar current-menubar))
975 ((and (vm-menu-fsfemacs-menus-p) 723 ((and (vm-menu-fsfemacs-menus-p)
976 ;; menus only need to be installed once for FSF Emacs 724 ;; menus only need to be installed once for FSF Emacs
977 (not (fboundp 'vm-menu-undo-menu))) 725 (not (fboundp 'vm-menu-undo-menu)))
978 (vm-menu-initialize-vm-mode-menu-map) 726 (vm-menu-initialize-vm-mode-menu-map)
979 (define-key vm-mode-map [menu-bar] 727 (define-key vm-mode-map [menu-bar]
1000 748
1001 (defun vm-menu-install-mail-mode-menu () 749 (defun vm-menu-install-mail-mode-menu ()
1002 (cond ((vm-menu-xemacs-menus-p) 750 (cond ((vm-menu-xemacs-menus-p)
1003 ;; mail-mode doesn't have mode-popup-menu bound to 751 ;; mail-mode doesn't have mode-popup-menu bound to
1004 ;; mouse-3 by default. fix that. 752 ;; mouse-3 by default. fix that.
1005 (if vm-popup-menu-on-mouse-3 753 (define-key vm-mail-mode-map 'button3 'popup-mode-menu)
1006 (define-key vm-mail-mode-map 'button3 'popup-mode-menu))
1007 ;; put menu on menubar also. 754 ;; put menu on menubar also.
1008 (if (vm-menu-xemacs-global-menubar) 755 (if (vm-menu-xemacs-global-menubar)
1009 (progn 756 (progn
1010 (set-buffer-menubar 757 (set-buffer-menubar
1011 (copy-sequence (vm-menu-xemacs-global-menubar))) 758 (copy-sequence (vm-menu-xemacs-global-menubar)))
1015 ;; I'd like to do this, but the result is a combination 762 ;; I'd like to do this, but the result is a combination
1016 ;; of the Emacs and VM Mail menus glued together. 763 ;; of the Emacs and VM Mail menus glued together.
1017 ;; Poorly. 764 ;; Poorly.
1018 ;;(define-key vm-mail-mode-map [menu-bar mail] 765 ;;(define-key vm-mail-mode-map [menu-bar mail]
1019 ;; (cons "Mail" vm-menu-fsfemacs-mail-menu)) 766 ;; (cons "Mail" vm-menu-fsfemacs-mail-menu))
1020 (defvar mail-mode-map) 767 (define-key vm-mail-mode-map [down-mouse-3]
1021 (define-key mail-mode-map [menu-bar mail] 768 'vm-menu-popup-mode-menu))))
1022 (cons "Mail" vm-menu-fsfemacs-mail-menu))
1023 (if vm-popup-menu-on-mouse-3
1024 (define-key vm-mail-mode-map [down-mouse-3]
1025 'vm-menu-popup-context-menu)))))
1026 769
1027 (defun vm-menu-install-menus () 770 (defun vm-menu-install-menus ()
1028 (cond ((consp vm-use-menus) 771 (cond ((consp vm-use-menus)
1029 (vm-menu-install-vm-mode-menu) 772 (vm-menu-install-vm-mode-menu)
1030 (vm-menu-install-menubar) 773 (vm-menu-install-menubar)
1176 919
1177 920
1178 (defun vm-menu-hm-make-folder-menu () 921 (defun vm-menu-hm-make-folder-menu ()
1179 "Makes a menu with the mail folders of the directory `vm-folder-directory'." 922 "Makes a menu with the mail folders of the directory `vm-folder-directory'."
1180 (interactive) 923 (interactive)
1181 (message "Building folders menu...") 924 (vm-unsaved-message "Building folders menu...")
1182 (let ((folder-list (vm-menu-hm-tree-make-file-list vm-folder-directory)) 925 (let ((folder-list (vm-menu-hm-tree-make-file-list vm-folder-directory))
1183 (inbox-list (if (listp (car vm-spool-files)) 926 (inbox-list (if (listp (car vm-spool-files))
1184 (mapcar 'car vm-spool-files) 927 (mapcar 'car vm-spool-files)
1185 (list vm-primary-inbox)))) 928 (list vm-primary-inbox))))
1186 (setq vm-menu-folders-menu 929 (setq vm-menu-folders-menu
1233 t 976 t
1234 )) 977 ))
1235 "----" 978 "----"
1236 ["Rebuild Folders Menu" vm-menu-hm-make-folder-menu vm-folder-directory] 979 ["Rebuild Folders Menu" vm-menu-hm-make-folder-menu vm-folder-directory]
1237 )))) 980 ))))
1238 (message "Building folders menu... done") 981 (vm-unsaved-message "Building folders menu... done")
1239 (vm-menu-hm-install-menu)) 982 (vm-menu-hm-install-menu))
1240 983
1241 (defun vm-menu-hm-install-menu () 984 (defun vm-menu-hm-install-menu ()
1242 (cond ((vm-menu-xemacs-menus-p) 985 (cond ((vm-menu-xemacs-menus-p)
1243 (cond ((car (find-menu-item current-menubar '("VM"))) 986 (cond ((car (find-menu-item current-menubar '("VM")))