home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / hyperbole / wrolo-menu.el < prev    next >
Encoding:
Text File  |  1995-08-22  |  5.9 KB  |  164 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         wrolo-menu.el
  4. ;; SUMMARY:      Pulldown and popup menus of Hyperbole rolodex commands.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     hypermedia, matching, mouse
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola, Inc., PPG
  10. ;;
  11. ;; ORIG-DATE:    28-Oct-94 at 10:59:44
  12. ;; LAST-MOD:     22-Aug-95 at 12:08:14 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1994-1995 Free Software Foundation, Inc.
  15. ;;
  16. ;; This file is part of Hyperbole.
  17. ;;
  18. ;; DESCRIPTION:  
  19. ;; DESCRIP-END.
  20.  
  21. ;;; ************************************************************************
  22. ;;; Public variables
  23. ;;; ************************************************************************
  24.  
  25. ;;; This definition is used by InfoDock and XEmacs.
  26. (defconst infodock-wrolo-menu
  27.   '("Rolodex"
  28.     ["Manual"            (id-tool-invoke id-man-rolodex) t]
  29.     "----"
  30.     ["Add-Entry"         (id-tool-invoke 'rolo-add) t]
  31.     ["Delete-Entry"      (id-tool-invoke 'rolo-kill) t]
  32.     ["Display-Prior-Matches" (id-tool-invoke 'rolo-display-matches) t]
  33.     ["Edit-Entry"        (id-tool-invoke 'rolo-edit) t]
  34.     ["Edit-Rolodex"      (id-tool-invoke
  35.               '(progn (require 'wrolo)
  36.                   (find-file (car rolo-file-list))
  37.                   (setq buffer-read-only nil)))
  38.      t]
  39.     ["Insert-Entry-at-Point" (id-tool-invoke 'rolo-yank) t]
  40.     ["Search-for-Regexp" (id-tool-invoke 'rolo-grep)  t]
  41.     ["Search-for-String" (id-tool-invoke 'rolo-fgrep) t]
  42.     ["Search-for-Word"   (id-tool-invoke 'rolo-word)  t]
  43.     ["Sort-Entries"      (id-tool-invoke 'rolo-sort)  t]
  44.     ))
  45.  
  46. ;;; This definition is used by InfoDock only.
  47. (defconst id-menubar-wrolo
  48.   (list
  49.    '("Wrolo"
  50.      ["Help"                describe-mode                  t]
  51.      ["Manual"              (id-info "(hyperbole.info)Rolo Keys") t]
  52.      "----"
  53.      ["Toggle-Read-Only"    toggle-read-only               t]
  54.      ["Write (Save as)"     write-file                     t]
  55.      "----"
  56.      ["Quit"                (id-tool-quit '(kill-buffer nil))  t]
  57.      )
  58.    '["Edit-Entry-at-Point"  rolo-edit-entry         t]
  59.    '("Move"
  60.      ["Scroll-Backward"     scroll-down             t]
  61.      ["Scroll-Forward"      scroll-up               t]
  62.      ["To-Beginning"        beginning-of-buffer     t]
  63.      ["To-End"              end-of-buffer           t]
  64.      "----"
  65.      ["To-Next-Entry"          outline-next-visible-heading t]
  66.      ["To-Next-Same-Level"     outline-forward-same-level t]
  67.      ["To-Previous-Entry"      outline-previous-visible-heading t]
  68.      ["To-Previous-Same-Level" outline-backward-same-level t]
  69.      ["Up-a-Level"             outline-up-heading t]
  70.      )
  71.    '("Outline"
  72.      ["Hide (Collapse)"      hide-subtree           t]
  73.      ["Show (Expand)"        show-subtree           t]
  74.      ["Show-All"             show-all               t]
  75.      ["Show-Only-First-Line" hide-body              t]
  76.      )
  77.    '["Next-Match"          rolo-next-match         t]
  78.    '["Previous-Match"      rolo-previous-match     t]
  79.    infodock-wrolo-menu
  80.    ))
  81.  
  82. ;;; This definition is used by InfoDock and XEmacs.
  83. (defconst id-popup-wrolo-menu
  84.   (list
  85.     "Wrolo"
  86.     '["Help"                describe-mode           t]
  87.     '["Manual"              (id-info "(hyperbole.info)Rolo Keys") t]
  88.     "----"
  89.     '["Edit-Entry-at-Point" rolo-edit-entry         t]
  90.     "----"
  91.     '["Next-Match"          rolo-next-match         t]
  92.     '["Previous-Match"      rolo-previous-match     t]
  93.     "----"
  94.     '("Move"
  95.       ["Scroll-Backward"     scroll-down             t]
  96.       ["Scroll-Forward"      scroll-up               t]
  97.       ["To-Beginning"        beginning-of-buffer     t]
  98.       ["To-End"              end-of-buffer           t]
  99.       "----"
  100.       ["To-Next-Entry"          outline-next-visible-heading t]
  101.       ["To-Next-Same-Level"     outline-forward-same-level t]
  102.       ["To-Previous-Entry"      outline-previous-visible-heading t]
  103.       ["To-Previous-Same-Level" outline-backward-same-level t]
  104.       ["Up-a-Level"             outline-up-heading t]
  105.       )
  106.     '("Outline"
  107.       ["Hide (Collapse)"      hide-subtree           t]
  108.       ["Show (Expand)"        show-subtree           t]
  109.       ["Show-All"             show-all               t]
  110.       ["Show-Only-First-Line" hide-body              t]
  111.       )
  112.     infodock-wrolo-menu
  113.     "----"
  114.     '["Quit"                (id-tool-quit 'rolo-quit) t]
  115.     ))
  116.  
  117. ;;; ************************************************************************
  118. ;;; Public functions
  119. ;;; ************************************************************************
  120.  
  121. ;;; This definition is used only by XEmacs and Emacs19.
  122. (defun wrolo-menubar-menu ()
  123.   "Add a Hyperbole Rolodex menu to the rolodex match buffer menubar."
  124.   (cond ((fboundp 'popup-mode-menu)
  125.      (setq mode-popup-menu id-popup-wrolo-menu))
  126.     (hyperb:lemacs-p
  127.      (define-key wrolo-mode-map 'button3 'wrolo-popup-menu))
  128.     (t ;; hyperb:emacs19-p
  129.      (define-key wrolo-mode-map [down-mouse-3] 'wrolo-popup-menu)
  130.      (define-key wrolo-mode-map [mouse-3] nil)))
  131.   (if (and (boundp 'current-menubar)
  132.        current-menubar
  133.        (not (car (find-menu-item current-menubar '("Wrolo")))))
  134.       (progn
  135.     (set-buffer-menubar (copy-sequence current-menubar))
  136.     (if (fboundp 'add-submenu)
  137.         (add-submenu nil id-popup-wrolo-menu)
  138.       (add-menu nil (car id-popup-wrolo-menu)
  139.             (cdr id-popup-wrolo-menu))))))
  140.  
  141. ;;; This definition is used only by XEmacs and Emacs19.
  142. (defun wrolo-popup-menu (event)
  143.   "Popup the Hyperbole Rolodex match buffer menu."
  144.   (interactive "@e")
  145.   (mouse-set-point event)
  146.   (if (fboundp 'popup-mode-menu)
  147.       (popup-mode-menu)
  148.     (popup-menu id-popup-wrolo-menu)))
  149.  
  150. (cond ((null hyperb:window-system))
  151.       ((fboundp 'id-menubar-set)
  152.        ;; InfoDock under a window system
  153.        (require 'id-menubars)
  154.        (id-menubar-set 'wrolo-mode 'id-menubar-wrolo))
  155.       (hyperb:lemacs-p
  156.        ;; XEmacs under a window system
  157.        (add-hook 'wrolo-mode-hook 'wrolo-menubar-menu))
  158.       (hyperb:emacs19-p
  159.        ;; Emacs 19 under a window system
  160.        (require 'lmenu)
  161.        (add-hook 'wrolo-mode-hook 'wrolo-menubar-menu)))
  162.  
  163. (provide 'wrolo-menu)
  164.