|
0
|
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: 31-Oct-95 at 18:45:24 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 ["Mail-to-Address" (id-tool-invoke 'rolo-mail-to) t]
|
|
|
41 ["Search-for-Regexp" (id-tool-invoke 'rolo-grep) t]
|
|
|
42 ["Search-for-String" (id-tool-invoke 'rolo-fgrep) t]
|
|
|
43 ["Search-for-Word" (id-tool-invoke 'rolo-word) t]
|
|
|
44 ["Sort-Entries" (id-tool-invoke 'rolo-sort) t]
|
|
|
45 ))
|
|
|
46
|
|
|
47 ;;; This definition is used by InfoDock only.
|
|
|
48 (defconst id-menubar-wrolo
|
|
|
49 (list
|
|
|
50 '("Wrolo"
|
|
|
51 ["Help" describe-mode t]
|
|
|
52 ["Manual" (id-info "(hyperbole.info)Rolo Keys") t]
|
|
|
53 "----"
|
|
|
54 ["Toggle-Read-Only" toggle-read-only t]
|
|
|
55 ["Write (Save as)" write-file t]
|
|
|
56 "----"
|
|
|
57 ["Quit" (id-tool-quit '(kill-buffer nil)) t]
|
|
|
58 )
|
|
|
59 '["Edit-Entry-at-Point" rolo-edit-entry t]
|
|
|
60 ["Mail-to-Address" (id-tool-invoke 'rolo-mail-to) t]
|
|
|
61 '("Move"
|
|
|
62 ["Scroll-Backward" scroll-down t]
|
|
|
63 ["Scroll-Forward" scroll-up t]
|
|
|
64 ["To-Beginning" beginning-of-buffer t]
|
|
|
65 ["To-End" end-of-buffer t]
|
|
|
66 "----"
|
|
|
67 ["To-Next-Entry" outline-next-visible-heading t]
|
|
|
68 ["To-Next-Same-Level" outline-forward-same-level t]
|
|
|
69 ["To-Previous-Entry" outline-previous-visible-heading t]
|
|
|
70 ["To-Previous-Same-Level" outline-backward-same-level t]
|
|
|
71 ["Up-a-Level" outline-up-heading t]
|
|
|
72 )
|
|
|
73 '("Outline"
|
|
|
74 ["Hide (Collapse)" hide-subtree t]
|
|
|
75 ["Show (Expand)" show-subtree t]
|
|
|
76 ["Show-All" show-all t]
|
|
|
77 ["Show-Only-First-Line" hide-body t]
|
|
|
78 )
|
|
|
79 '["Next-Match" rolo-next-match t]
|
|
|
80 '["Previous-Match" rolo-previous-match t]
|
|
|
81 infodock-wrolo-menu
|
|
|
82 ))
|
|
|
83
|
|
|
84 ;;; This definition is used by InfoDock and XEmacs.
|
|
|
85 (defconst id-popup-wrolo-menu
|
|
|
86 (list
|
|
|
87 "Wrolo"
|
|
|
88 '["Help" describe-mode t]
|
|
|
89 '["Manual" (id-info "(hyperbole.info)Rolo Keys") t]
|
|
|
90 "----"
|
|
|
91 '["Edit-Entry-at-Point" rolo-edit-entry t]
|
|
|
92 "----"
|
|
|
93 '["Next-Match" rolo-next-match t]
|
|
|
94 '["Previous-Match" rolo-previous-match t]
|
|
|
95 "----"
|
|
|
96 '("Move"
|
|
|
97 ["Scroll-Backward" scroll-down t]
|
|
|
98 ["Scroll-Forward" scroll-up t]
|
|
|
99 ["To-Beginning" beginning-of-buffer t]
|
|
|
100 ["To-End" end-of-buffer t]
|
|
|
101 "----"
|
|
|
102 ["To-Next-Entry" outline-next-visible-heading t]
|
|
|
103 ["To-Next-Same-Level" outline-forward-same-level t]
|
|
|
104 ["To-Previous-Entry" outline-previous-visible-heading t]
|
|
|
105 ["To-Previous-Same-Level" outline-backward-same-level t]
|
|
|
106 ["Up-a-Level" outline-up-heading t]
|
|
|
107 )
|
|
|
108 '("Outline"
|
|
|
109 ["Hide (Collapse)" hide-subtree t]
|
|
|
110 ["Show (Expand)" show-subtree t]
|
|
|
111 ["Show-All" show-all t]
|
|
|
112 ["Show-Only-First-Line" hide-body t]
|
|
|
113 )
|
|
|
114 infodock-wrolo-menu
|
|
|
115 "----"
|
|
|
116 '["Quit" (id-tool-quit 'rolo-quit) t]
|
|
|
117 ))
|
|
|
118
|
|
|
119 ;;; ************************************************************************
|
|
|
120 ;;; Public functions
|
|
|
121 ;;; ************************************************************************
|
|
|
122
|
|
|
123 ;;; This definition is used only by XEmacs and Emacs19.
|
|
|
124 (defun wrolo-menubar-menu ()
|
|
|
125 "Add a Hyperbole Rolodex menu to the rolodex match buffer menubar."
|
|
|
126 (cond ((fboundp 'popup-mode-menu)
|
|
|
127 (setq mode-popup-menu id-popup-wrolo-menu))
|
|
|
128 (hyperb:lemacs-p
|
|
|
129 (define-key wrolo-mode-map 'button3 'wrolo-popup-menu))
|
|
|
130 (t ;; hyperb:emacs19-p
|
|
|
131 (define-key wrolo-mode-map [down-mouse-3] 'wrolo-popup-menu)
|
|
|
132 (define-key wrolo-mode-map [mouse-3] nil)))
|
|
|
133 (if (and (boundp 'current-menubar)
|
|
|
134 (or hyperb:emacs19-p current-menubar)
|
|
|
135 (not (car (find-menu-item current-menubar '("Wrolo")))))
|
|
|
136 (progn
|
|
|
137 (set-buffer-menubar (copy-sequence current-menubar))
|
|
|
138 (if (fboundp 'add-submenu)
|
|
|
139 (add-submenu nil id-popup-wrolo-menu)
|
|
|
140 (add-menu nil (car id-popup-wrolo-menu)
|
|
|
141 (cdr id-popup-wrolo-menu))))))
|
|
|
142
|
|
|
143 ;;; This definition is used only by XEmacs and Emacs19.
|
|
|
144 (defun wrolo-popup-menu (event)
|
|
|
145 "Popup the Hyperbole Rolodex match buffer menu."
|
|
|
146 (interactive "@e")
|
|
|
147 (mouse-set-point event)
|
|
|
148 (if (fboundp 'popup-mode-menu)
|
|
|
149 (popup-mode-menu)
|
|
|
150 (popup-menu id-popup-wrolo-menu)))
|
|
|
151
|
|
|
152 (cond ((null hyperb:window-system))
|
|
|
153 ((fboundp 'id-menubar-set)
|
|
|
154 ;; InfoDock under a window system
|
|
|
155 (require 'id-menubars)
|
|
|
156 (id-menubar-set 'wrolo-mode 'id-menubar-wrolo))
|
|
|
157 (hyperb:lemacs-p
|
|
|
158 ;; XEmacs under a window system
|
|
|
159 (add-hook 'wrolo-mode-hook 'wrolo-menubar-menu))
|
|
|
160 (hyperb:emacs19-p
|
|
|
161 ;; Emacs 19 under a window system
|
|
|
162 (require 'lmenu)
|
|
|
163 (add-hook 'wrolo-mode-hook 'wrolo-menubar-menu)))
|
|
|
164
|
|
|
165 (provide 'wrolo-menu)
|
