cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/wrolo-menu.el

   1 ;;; wrolo-menu.el --- Pulldown and popup menus of Hyperbole rolodex commands.
   2
   3 ;; Copyright (C) 1994-1995, 2006 Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: hypermedia, matching, mouse
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 ;;;
  32 ;;; Public variables
  33 ;;;
  34
  35 (require 'wrolo)
  36
  37 ;;; This definition is used by InfoDock and XEmacs.
  38 (defconst infodock-wrolo-menu
  39   '("Rolodex"
  40     ["Add-Entry"         (id-tool-invoke 'rolo-add) t]
  41     ["Delete-Entry"      (id-tool-invoke 'rolo-kill) t]
  42     ["Display-Prior-Matches" (id-tool-invoke 'rolo-display-matches) t]
  43     ["Edit-Entry"        (id-tool-invoke 'rolo-edit) t]
  44     ["Edit-Rolodex"      (id-tool-invoke
  45                           '(progn (require 'wrolo)
  46                                   (find-file (car rolo-file-list))
  47                                   (setq buffer-read-only nil)))
  48      t]
  49     ["Insert-Entry-at-Point" (id-tool-invoke 'rolo-yank) t]
  50     ["Mail-to-Address"   (id-tool-invoke 'rolo-mail-to) t]
  51     ["Search-for-Regexp" (id-tool-invoke 'rolo-grep)  t]
  52     ["Search-for-String" (id-tool-invoke 'rolo-fgrep) t]
  53     ["Search-for-Word"   (id-tool-invoke 'rolo-word)  t]
  54     ["Sort-Entries"      (id-tool-invoke 'rolo-sort)  t]
  55     "----"
  56     ["Manual"            (id-tool-invoke id-man-rolodex) t]
  57     ))
  58
  59 ;;; This definition is used by InfoDock only.
  60 (defconst id-menubar-wrolo
  61   (list
  62    '("Wrolo"
  63      ["Help"                describe-mode                  t]
  64      ["Manual"              (id-info "(hyperbole.info)Rolo Keys") t]
  65      "----"
  66      ["Toggle-Read-Only"    toggle-read-only               t]
  67      ["Write (Save as)"     write-file                     t]
  68      "----"
  69      ["Quit"                (id-tool-quit '(kill-buffer nil))  t]
  70      )
  71    '["Edit-Entry-at-Point"  rolo-edit-entry         t]
  72     ["Mail-to-Address"      (id-tool-invoke 'rolo-mail-to) t]
  73    '("Move"
  74      ["Scroll-Backward"     scroll-down             t]
  75      ["Scroll-Forward"      scroll-up               t]
  76      ["To-Beginning"        beginning-of-buffer     t]
  77      ["To-End"              end-of-buffer           t]
  78      "----"
  79      ["To-Next-Entry"          outline-next-visible-heading t]
  80      ["To-Next-Same-Level"     outline-forward-same-level t]
  81      ["To-Previous-Entry"      outline-previous-visible-heading t]
  82      ["To-Previous-Same-Level" outline-backward-same-level t]
  83      ["Up-a-Level"             outline-up-heading t]
  84      )
  85    '("Outline"
  86      ["Hide (Collapse)"      hide-subtree           t]
  87      ["Show (Expand)"        show-subtree           t]
  88      ["Show-All"             show-all               t]
  89      ["Show-Only-First-Line" hide-body              t]
  90      )
  91    '["Next-Match"          rolo-next-match         t]
  92    '["Previous-Match"      rolo-previous-match     t]
  93    infodock-wrolo-menu
  94    ))
  95
  96 ;;; This definition is used by InfoDock and XEmacs.
  97 (defconst id-popup-wrolo-menu
  98   (list
  99     "Wrolo"
 100     '["Edit-Entry-at-Point" rolo-edit-entry         t]
 101     "----"
 102     '["Next-Match"          rolo-next-match         t]
 103     '["Previous-Match"      rolo-previous-match     t]
 104     "----"
 105     '("Move"
 106       ["Scroll-Backward"     scroll-down             t]
 107       ["Scroll-Forward"      scroll-up               t]
 108       ["To-Beginning"        beginning-of-buffer     t]
 109       ["To-End"              end-of-buffer           t]
 110       "----"
 111       ["To-Next-Entry"          outline-next-visible-heading t]
 112       ["To-Next-Same-Level"     outline-forward-same-level t]
 113       ["To-Previous-Entry"      outline-previous-visible-heading t]
 114       ["To-Previous-Same-Level" outline-backward-same-level t]
 115       ["Up-a-Level"             outline-up-heading t]
 116       )
 117     '("Outline"
 118       ["Hide (Collapse)"      hide-subtree           t]
 119       ["Show (Expand)"        show-subtree           t]
 120       ["Show-All"             show-all               t]
 121       ["Show-Only-First-Line" hide-body              t]
 122       )
 123     infodock-wrolo-menu
 124     "----"
 125     '["Help"                describe-mode           t]
 126     '["Manual"              (id-info "(hyperbole.info)Rolo Keys") t]
 127     "----"
 128     '["Quit"                (id-tool-invoke 'rolo-quit) t]
 129     ))
 130
 131 ;;;
 132 ;;; Public functions
 133 ;;;
 134
 135 ;;; This definition is used only by XEmacs and Emacs19.
 136 (defun wrolo-menubar-menu ()
 137   "Add a Hyperbole Rolodex menu to the rolodex match buffer menubar."
 138   (cond ((fboundp 'popup-mode-menu)
 139          (setq mode-popup-menu id-popup-wrolo-menu))
 140         (hyperb:xemacs-p
 141          (define-key wrolo-mode-map 'button3 'wrolo-popup-menu))
 142         (t ;; hyperb:emacs19-p
 143          (define-key wrolo-mode-map [down-mouse-3] 'wrolo-popup-menu)
 144          (define-key wrolo-mode-map [mouse-3] nil)))
 145   (if (and (boundp 'current-menubar)
 146            (or hyperb:emacs19-p current-menubar)
 147            (not (car (find-menu-item current-menubar '("Wrolo")))))
 148       (progn
 149         (set-buffer-menubar (copy-sequence current-menubar))
 150         (if (fboundp 'add-submenu)
 151             (add-submenu nil id-popup-wrolo-menu)
 152           (add-menu nil (car id-popup-wrolo-menu)
 153                     (cdr id-popup-wrolo-menu))))))
 154
 155 ;;; This definition is used only by XEmacs and Emacs19.
 156 (defun wrolo-popup-menu (event)
 157   "Popup the Hyperbole Rolodex match buffer menu."
 158   (interactive "@e")
 159   (mouse-set-point event)
 160   (if (fboundp 'popup-mode-menu)
 161       (popup-mode-menu)
 162     (popup-menu id-popup-wrolo-menu)))
 163
 164 (cond ((null hyperb:window-system))
 165       ((fboundp 'id-menubar-set)
 166        ;; InfoDock under a window system
 167        (require 'id-menubars)
 168        (id-menubar-set 'wrolo-mode 'id-menubar-wrolo))
 169       (hyperb:xemacs-p
 170        ;; XEmacs under a window system
 171        (add-hook 'wrolo-mode-hook 'wrolo-menubar-menu))
 172       (hyperb:emacs19-p
 173        ;; Emacs 19 under a window system
 174        t))
 175
 176 (require 'easymenu)
 177 (easy-menu-define wrolo-mode-menubar-menu wrolo-mode-map "Wrolo-mode menu" id-popup-wrolo-menu)
 178
 179 (provide 'wrolo-menu)
 180
 181 ;;; wrolo-menu.el ends here