home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / rmail / rmail-lucid.el < prev    next >
Encoding:
Text File  |  1993-02-11  |  7.9 KB  |  223 lines
  1. ;; Mouse and font support for RMAIL running in Lucid GNU Emacs
  2. ;; written by Wilson H. Tien (wtien@urbana.mcd.mot.com); modified by jwz.
  3. ;; Copyright (C) 1992-1993 Free Software Foundation, Inc.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;;; Right button pops up a menu of commands in Rmail and Rmail summary buffers.
  22. ;;; Middle button selects indicated mail message in Rmail summary buffer
  23.  
  24. (defvar rmail-summary-mode-menu
  25.   '("Rmail Summary"
  26.     "Rmail Summary Commands:"
  27.     "----"
  28.     ["Select Message" rmail-summary-goto-msg t nil]
  29.     "----"
  30.     ["Previous Page" scroll-down t]
  31.     ["Next Page" scroll-up t]
  32.     "----"
  33.     ["Delete Message" rmail-summary-delete-forward t nil]
  34.     ["Undelete Message" rmail-summary-undelete t nil]
  35.     "----"
  36.     ["Exit rmail Summary" rmail-summary-exit t]
  37.     ["Quit rmail" rmail-summary-quit t]))
  38.  
  39. (defun rmail-summary-update-menubar ()
  40.   ;; if min point is in visible in the window, don't make page-up menu item
  41.   ;; selectable
  42.   (let ((current-menubar rmail-summary-mode-menu)
  43.     (select '("Select Message"))
  44.     (delete '("Delete Message"))
  45.     (undelete '("Undelete Message"))
  46.     (prev-page '("Previous Page"))
  47.     (next-page '("Next Page")))
  48.     (beginning-of-line)
  49.     (let ((curmsg (string-to-int
  50.          (buffer-substring (point)
  51.                    (min (point-max) (+ 5 (point))))))
  52.       deleted-p)
  53.       (if (= 0 curmsg)
  54.       (progn
  55.         (rmail-update-menu-item delete nil)
  56.         (rmail-update-menu-item undelete nil)
  57.         (rmail-update-menu-item select nil))
  58.     (pop-to-buffer rmail-buffer)
  59.     (setq deleted-p (rmail-message-deleted-p curmsg))
  60.     (pop-to-buffer rmail-summary-buffer)
  61.     (let ((delete-menu-item 
  62.            (car (find-menu-item current-menubar delete)))
  63.           (undelete-menu-item 
  64.            (car (find-menu-item current-menubar undelete)))
  65.           (select-menu-item 
  66.            (car (find-menu-item current-menubar select)))
  67.           (msg (format "#%d" curmsg)))
  68.       (aset delete-menu-item 2 (not deleted-p))
  69.       (aset delete-menu-item 3 msg)
  70.       (aset undelete-menu-item 2 deleted-p)
  71.       (aset undelete-menu-item 3 msg)
  72.       (aset select-menu-item 2 t)
  73.       (aset select-menu-item 3 msg))))
  74.     (rmail-update-menu-item prev-page (> (window-start) (point-min)))
  75.     (rmail-update-menu-item next-page (< (window-end) (point-max)))))
  76.   
  77. (defun rmail-summary-mode-menu (event)
  78.   "Pops up a menu of applicable rmail summary commands."
  79.   (interactive "e")
  80.   (mouse-set-point event)
  81.   (beginning-of-line)
  82.   (rmail-summary-update-menubar)
  83.   (popup-menu rmail-summary-mode-menu))
  84.  
  85. ;; The following are for rmail mode 
  86. (defconst rmail-mode-menu
  87.   '("Rmail" 
  88.     "Rmail Commands:"
  89.     "----"
  90.     ["Previous Page" scroll-down t]
  91.     ["Next Page" scroll-up t]
  92.     ["Top Of This Message" rmail-beginning-of-message t]
  93.     "----"
  94.     "Go To Message:"
  95.     "----"
  96.     ["Next Nondeleted Message" rmail-next-undeleted-message t]
  97.     ["Previous Nondeleted Message" rmail-previous-undeleted-message t]
  98.     ["Next Message" rmail-next-message t]
  99.     ["Previous Message" rmail-previous-message t]
  100.     ["First Message" rmail-show-message t]
  101.     ["Last Message" rmail-last-message t]
  102.     "----"
  103.     ["Delete This Message" rmail-delete-forward t]
  104.     ["Undelete This Message" rmail-undelete-previous-message t]
  105.     ["Save This Message" rmail-output-to-rmail-file t]
  106.     "----"
  107.     ["Reply This Message" rmail-reply t]
  108.     ["Forward This Message" rmail-forward t]
  109. ;    ["Continue This Message" rmail-continue t]
  110.     "----"
  111.     ["Add Label" rmail-add-label t]
  112.     ["Kill Label" rmail-kill-label t]
  113.     ["Next Labeled Message" rmail-next-labeled-message t]
  114.     ["Previous Labeled Message" rmail-previous-labeled-message t]
  115.     ["Summary by Label" rmail-summary-by-labels t]
  116.     "----"
  117.     ["Summary" rmail-summary t]
  118.     ["Get New Mail" rmail-get-new-mail t]
  119.     ["rmail Input From" rmail-input t]
  120.     ["Expunge rmail" rmail-expunge t]
  121.     ["Expunge and Save" rmail-expunge-and-save t]
  122.     ["Quit rmail" rmail-quit t]))
  123.  
  124. (defun rmail-update-menu-item (item p)
  125.   "If P is true, enable the menu item. O/w disable it."
  126.   (aset (car (or (find-menu-item current-menubar item)
  127.          (error "couldn't find rmail menu item %S" item)))
  128.     2 p))
  129.  
  130. (defun rmail-update-menubar ()
  131.   (let ((current-menubar rmail-mode-menu)
  132.     (prev-page '("Previous Page"))
  133.     (next-page '("Next Page"))
  134.     (top-page '("Top Of This Message"))
  135.     (real-next '("Next Message"))
  136.     (real-prev '("Previous Message"))
  137.     (undel-next '("Next Nondeleted Message"))
  138.     (undel-prev '("Previous Nondeleted Message"))
  139.     (delete '("Delete This Message"))
  140.     (undelete '("Undelete This Message"))
  141.     i)
  142.     ;; Disable/enable page-up/page-down menu items
  143.     (rmail-update-menu-item prev-page (> (window-start) (point-min)))
  144.     (rmail-update-menu-item next-page (< (window-end) (point-max)))
  145.     (rmail-update-menu-item top-page (> (window-start) (point-min)))
  146.     (rmail-update-menu-item real-next
  147.               (/= rmail-current-message rmail-total-messages))
  148.     (rmail-update-menu-item real-prev (/= rmail-current-message 1))
  149.     (setq i (1+ rmail-current-message))
  150.     (while (and (<= i rmail-total-messages) (rmail-message-deleted-p i))
  151.       (setq i (1+ i)))
  152.     (rmail-update-menu-item undel-next (<= i rmail-total-messages))
  153.     (setq i (1- rmail-current-message))
  154.     (while (and (>= i 1) (rmail-message-deleted-p i))
  155.       (setq i (1- i)))
  156.     (rmail-update-menu-item undel-prev (>= i 1))
  157.     (rmail-update-menu-item delete 
  158.               (not (rmail-message-deleted-p rmail-current-message)))
  159.     (rmail-update-menu-item undelete 
  160.               (rmail-message-deleted-p rmail-current-message))
  161.     t))
  162.   
  163. (defun rmail-mode-menu (event)
  164.   "Pops up a menu of applicable rmail commands."
  165.   (interactive "e")
  166.   (select-window (event-window event))
  167.   (rmail-update-menubar)
  168.   (popup-menu rmail-mode-menu))
  169.  
  170. (defun rmail-activate-menubar-hook ()
  171.   (cond ((eq major-mode 'rmail-mode)
  172.      (rmail-update-menubar))
  173.     ((eq major-mode 'rmail-summary-mode)
  174.      (rmail-summary-update-menubar))))
  175.  
  176. (add-hook 'activate-menubar-hook 'rmail-activate-menubar-hook)
  177.  
  178. ;;; Put message headers in boldface, etc...
  179.  
  180. (require 'highlight-headers)
  181.  
  182. (defun rmail-fontify-headers ()
  183.   (highlight-headers (point-min) (point-max) t))
  184.  
  185. (add-hook 'rmail-show-message-hook 'rmail-fontify-headers)
  186.  
  187. ;; MENU and MENUBAR setup for both Rmail and Rmail summary buffers
  188. (defun rmail-install-menubar ()
  189.   (if (and current-menubar (not (assoc (car rmail-mode-menu) current-menubar)))
  190.       (let ((menu (cond ((eq major-mode 'rmail-mode) rmail-mode-menu)
  191.             ((eq major-mode 'rmail-summary-mode)
  192.              rmail-summary-mode-menu)
  193.             (t (error "not rmail or rmail summary mode")))))
  194.     (set-buffer-menubar (copy-sequence current-menubar))
  195.     (add-menu nil (car rmail-mode-menu) (cdr menu)))))
  196.  
  197. (defun rmail-mode-menu-setup ()
  198.   (rmail-install-menubar)
  199.   (define-key rmail-mode-map 'button3 'rmail-mode-menu))
  200.  
  201. (add-hook 'rmail-mode-hook 'rmail-mode-menu-setup)
  202.  
  203. (defun rmail-summary-mode-menu-setup ()
  204.   (rmail-install-menubar)
  205.   (define-key rmail-summary-mode-map 'button2 'rmail-summary-mouse-goto-msg)
  206.   (define-key rmail-summary-mode-map 'button3 'rmail-summary-mode-menu))
  207.  
  208. (defun rmail-summary-mouse-goto-msg (e)
  209.   (interactive "e")
  210.   (mouse-set-point e)
  211.   (beginning-of-line)
  212.   (rmail-summary-goto-msg))
  213.  
  214. (defun rmail-install-mouse-tracker ()
  215.   (require 'mode-motion)
  216.   (setq mode-motion-hook 'mode-motion-highlight-line))
  217.  
  218. (add-hook 'rmail-summary-mode-hook 'rmail-install-mouse-tracker)
  219. (add-hook 'rmail-summary-mode-hook 'rmail-summary-mode-menu-setup)
  220.  
  221.  
  222. (provide 'rmail-lucid)
  223.