|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: br-menu.el
|
|
|
4 ;; SUMMARY: Pulldown and popup menus for the OO-Browser.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: mouse, oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
100
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 27-Oct-93 at 21:13:36
|
|
100
|
12 ;; LAST-MOD: 21-Feb-97 at 16:58:26 by Bob Weiner
|
|
0
|
13 ;;
|
|
100
|
14 ;; Copyright (C) 1994, 1995, 1997 Free Software Foundation, Inc.
|
|
0
|
15 ;; See the file BR-COPY for license information.
|
|
|
16 ;;
|
|
|
17 ;; This file is part of the OO-Browser.
|
|
|
18 ;;
|
|
|
19 ;; DESCRIPTION:
|
|
|
20 ;; DESCRIP-END.
|
|
|
21
|
|
|
22 ;;; ************************************************************************
|
|
|
23 ;;; Public variables
|
|
|
24 ;;; ************************************************************************
|
|
|
25
|
|
|
26 ;;; This definition is used by InfoDock only.
|
|
|
27 (defconst id-menubar-br
|
|
|
28 '(
|
|
|
29 ("OO-Browser"
|
|
|
30 ["Copyright" br-copyright t]
|
|
|
31 ["Help-Commands" br-help t]
|
|
|
32 ["Help-Mode" describe-mode t]
|
|
|
33 ["Help-Mouse" br-help-ms t]
|
|
|
34 ["Manual" (id-info "(oo-browser.info)Top") t]
|
|
|
35 ["Version" br-version t]
|
|
|
36 "----"
|
|
|
37 ["Compose-Mail-to-List"
|
|
|
38 (progn (br-quit)
|
|
100
|
39 (mail nil "oo-browser@infodock.com"
|
|
0
|
40 "Replace this line with a descriptive sentence.")
|
|
|
41 (goto-char (point-min))
|
|
|
42 (search-forward "Subject: " nil t)) t]
|
|
|
43 ["Mail-List-Request"
|
|
|
44 (progn (br-quit)
|
|
100
|
45 (mail nil "oo-browser-request@infodock.com")
|
|
|
46 (insert "The subject line of this message will not be used.\n"
|
|
|
47 "Remove everything in the body of this message except one\n"
|
|
|
48 "or more lines of the following form:\n\n"
|
|
|
49 " subscribe oo-browser [<your-email-address>]\n"
|
|
|
50 " or\n"
|
|
|
51 " unsubscribe oo-browser [<your-email-address>]\n\n"
|
|
|
52 "For example: subscribe oo-browser joe@nowhere.gov\n"))
|
|
|
53 t]
|
|
0
|
54 "----"
|
|
|
55 ["Reinitialize" br-refresh t]
|
|
|
56 ["Exit-Temporarily" (id-tool-quit '(br-quit)) t]
|
|
|
57 ["Quit" (id-tool-quit '(br-quit t)) t]
|
|
|
58 )
|
|
|
59 ("Class"
|
|
|
60 ["Edit-Current" br-edit-entry t]
|
|
|
61 ["Edit-Named" br-find t]
|
|
|
62 ["View-Current" br-view-entry t]
|
|
|
63 "----"
|
|
|
64 ["Match-from-Listing" br-match t]
|
|
|
65 ["Where-is-Any" (br-where t) t]
|
|
|
66 ["Where-is-Current" br-where t]
|
|
|
67 "----"
|
|
|
68 ["Graphical-Descendants" br-tree t]
|
|
|
69 "----"
|
|
|
70 ["Ancestors" (br-ancestors -1) t]
|
|
|
71 ["Children" br-children t]
|
|
|
72 ["Descendants" br-descendants t]
|
|
|
73 ["Features" br-features t]
|
|
|
74 ["Info" br-class-info t]
|
|
|
75 ["Level" br-at t]
|
|
|
76 ["Parents" br-parents t]
|
|
|
77 ["Class-Statistics" br-class-stats t]
|
|
|
78 )
|
|
|
79 ("Environment"
|
|
|
80 ["Create" (id-tool-invoke id-tool-oo-browser) t]
|
|
|
81 ["Load" (id-tool-invoke id-tool-oo-browser) t]
|
|
|
82 ["Rebuild" br-env-rebuild t]
|
|
|
83 ["Rebuild-Lib-Part" br-lib-rebuild t]
|
|
|
84 ["Rebuild-Sys-Part" br-sys-rebuild t]
|
|
|
85 ["Save" br-env-save t]
|
|
|
86 ["Statistics" br-env-stats t]
|
|
|
87 "----"
|
|
|
88 ["Add-File" br-add-class-file t]
|
|
|
89 ["Delete-Class" br-delete t]
|
|
|
90 )
|
|
|
91 ("Feature"
|
|
|
92 ["Edit-Current" br-edit-entry t]
|
|
|
93 ["Edit-Named" br-find t]
|
|
|
94 ["View-Current" br-view-entry t]
|
|
|
95 ["View-Friend-Def" br-view-friend t]
|
|
|
96 "----"
|
|
|
97 ["Implementors" br-implementors t]
|
|
|
98 ["Signature" br-ftr-signature t]
|
|
|
99 )
|
|
|
100 ("List-Window"
|
|
|
101 ["Graphical-View" br-tree-graph t]
|
|
|
102 ["Graphical-Descendants" (br-tree t) t]
|
|
|
103 ["Kill-Graphical-Views" br-tree-kill t]
|
|
|
104 "----"
|
|
|
105 ["Write (Save as)" br-write-buffer t]
|
|
|
106 "----"
|
|
|
107 ["Count-Entries" br-count t]
|
|
|
108 ["Order-Entries" (progn (br-order 1)
|
|
|
109 (br-unique)) t]
|
|
|
110 "----"
|
|
|
111 ["Ancestors" (br-ancestors -2) t]
|
|
|
112 ["Children" (br-children t) t]
|
|
|
113 ["Descendants" (br-descendants t) t]
|
|
|
114 ["Features" (br-features 1) t]
|
|
|
115 ["Files" br-buffer-menu t]
|
|
|
116 ["Level" (br-at t) t]
|
|
|
117 ["Parents" (br-parents t) t]
|
|
|
118 "----"
|
|
|
119 ["Show-All-Classes" (br-top-classes t) t]
|
|
|
120 ["Show-All-Lib-Classes" (br-lib-top-classes t) t]
|
|
|
121 ["Show-All-Sys-Classes" (br-sys-top-classes t) t]
|
|
|
122 ["Show-Top-Classes" br-top-classes t]
|
|
|
123 ["Show-Top-Lib-Classes" br-lib-top-classes t]
|
|
|
124 ["Show-Top-Sys-Classes" br-sys-top-classes t]
|
|
|
125 "----"
|
|
|
126 ["Exit-This-Level" br-exit-level t]
|
|
|
127 ["Narrow-by-10" br-resize-narrow t]
|
|
|
128 ["Widen-by-10" br-resize-widen t]
|
|
|
129 )
|
|
|
130 ("Options"
|
|
|
131 ["Keep-Viewed-Classes" br-toggle-keep-viewed
|
|
|
132 :style toggle :selected br-keep-viewed-classes]
|
|
100
|
133 ["Graphical-Add-Features" br-tree-features-toggle
|
|
0
|
134 :style toggle :selected br-show-features]
|
|
100
|
135 ["Show-Inherited-Features"
|
|
|
136 (setq br-inherited-features-flag
|
|
|
137 (not br-inherited-features-flag))
|
|
|
138 :style toggle :selected br-inherited-features-flag]
|
|
0
|
139 )
|
|
|
140 ("View-Window"
|
|
|
141 ["Full-Frame" br-view-full-frame t]
|
|
|
142 ["Kill-Buffer" br-kill t]
|
|
|
143 ["Move-To-or-From" br-to-from-viewer t]
|
|
|
144 )
|
|
|
145 ))
|
|
|
146
|
|
|
147 ;;; This definition is used by InfoDock and XEmacs.
|
|
|
148 (defconst id-popup-br-menu
|
|
|
149 '("OO-Browser"
|
|
|
150 ["Copyright" br-copyright t]
|
|
|
151 ["Help-Commands" br-help t]
|
|
|
152 ["Help-Mode" describe-mode t]
|
|
|
153 ["Help-Mouse" br-help-ms t]
|
|
|
154 ["Manual" (id-info "(oo-browser.info)Top") t]
|
|
|
155 ["Version" br-version t]
|
|
|
156 "----"
|
|
|
157 ["Compose-Mail-to-List"
|
|
|
158 (progn (br-quit)
|
|
100
|
159 (mail nil "oo-browser@infodock.com"
|
|
0
|
160 "Replace this line with a descriptive sentence.")
|
|
|
161 (goto-char (point-min))
|
|
|
162 (search-forward "Subject: " nil t)) t]
|
|
|
163 ["Mail-List-Request"
|
|
|
164 (progn (br-quit)
|
|
100
|
165 (mail nil "oo-browser-request@infodock.com")
|
|
|
166 (insert "The subject line of this message will not be used.\n"
|
|
|
167 "Remove everything in the body of this message except one\n"
|
|
|
168 "or more lines of the following form:\n\n"
|
|
|
169 " subscribe oo-browser [<your-email-address>]\n"
|
|
|
170 " or\n"
|
|
|
171 " unsubscribe oo-browser [<your-email-address>]\n\n"
|
|
|
172 "For example: subscribe oo-browser joe@nowhere.gov\n"))
|
|
|
173 t]
|
|
0
|
174 "----"
|
|
|
175 ("Class"
|
|
|
176 ["Edit-Current" br-edit-entry t]
|
|
|
177 ["Edit-Named" br-find t]
|
|
|
178 ["View-Current" br-view-entry t]
|
|
|
179 "----"
|
|
|
180 ["Match-from-Listing" br-match t]
|
|
|
181 ["Where-is-Any" (br-where t) t]
|
|
|
182 ["Where-is-Current" br-where t]
|
|
|
183 "----"
|
|
|
184 ["Graphical-View" br-tree-graph t]
|
|
|
185 ["Graphical-Descendants" (br-tree t) t]
|
|
|
186 ["Kill-Graphical-Views" br-tree-kill t]
|
|
|
187 "----"
|
|
|
188 ["Ancestors" (br-ancestors -1) t]
|
|
|
189 ["Children" br-children t]
|
|
|
190 ["Descendants" br-descendants t]
|
|
|
191 ["Features" br-features t]
|
|
|
192 ["Info" br-class-info t]
|
|
|
193 ["Level" br-at t]
|
|
|
194 ["Parents" br-parents t]
|
|
|
195 ["Class-Statistics" br-class-stats t]
|
|
|
196 )
|
|
|
197 ("Environment"
|
|
|
198 ["Create" (id-tool-invoke id-tool-oo-browser) t]
|
|
|
199 ["Load" (id-tool-invoke id-tool-oo-browser) t]
|
|
|
200 ["Rebuild" br-env-rebuild t]
|
|
|
201 ["Rebuild-Lib-Part" br-lib-rebuild t]
|
|
|
202 ["Rebuild-Sys-Part" br-sys-rebuild t]
|
|
|
203 ["Save" br-env-save t]
|
|
|
204 ["Statistics" br-env-stats t]
|
|
|
205 "----"
|
|
|
206 ["Add-File" br-add-class-file t]
|
|
|
207 ["Delete-Class" br-delete t]
|
|
|
208 )
|
|
|
209 ("Feature"
|
|
|
210 ["Edit-Current" br-edit-entry t]
|
|
|
211 ["Edit-Named" br-find t]
|
|
|
212 ["View-Current" br-view-entry t]
|
|
|
213 ["View-Friend-Def" br-view-friend t]
|
|
|
214 "----"
|
|
|
215 ["Implementors" br-implementors t]
|
|
|
216 ["Signature" br-feature-signature t]
|
|
|
217 )
|
|
|
218 ("List-Window"
|
|
|
219 ["Write (Save as)" br-write-buffer t]
|
|
|
220 "----"
|
|
|
221 ["Count-Entries" br-count t]
|
|
|
222 ["Order-Entries" (progn (br-order 1)
|
|
|
223 (br-unique)) t]
|
|
|
224 "----"
|
|
|
225 ["Ancestors" (br-ancestors -2) t]
|
|
|
226 ["Children" (br-children t) t]
|
|
|
227 ["Descendants" (br-descendants t) t]
|
|
|
228 ["Features" (br-features 1) t]
|
|
|
229 ["Files" br-buffer-menu t]
|
|
|
230 ["Level" (br-at t) t]
|
|
|
231 ["Parents" (br-parents t) t]
|
|
|
232 "----"
|
|
|
233 ["Show-All-Classes" (br-top-classes t) t]
|
|
|
234 ["Show-All-Lib-Classes" (br-lib-top-classes t) t]
|
|
|
235 ["Show-All-Sys-Classes" (br-sys-top-classes t) t]
|
|
|
236 ["Show-Top-Classes" br-top-classes t]
|
|
|
237 ["Show-Top-Lib-Classes" br-lib-top-classes t]
|
|
|
238 ["Show-Top-Sys-Classes" br-sys-top-classes t]
|
|
|
239 "----"
|
|
|
240 ["Exit-This-Level" br-exit-level t]
|
|
|
241 ["Narrow-by-10" br-resize-narrow t]
|
|
|
242 ["Widen-by-10" br-resize-widen t]
|
|
|
243 )
|
|
|
244 ("Options"
|
|
|
245 ["Keep-Viewed-Classes" br-toggle-keep-viewed
|
|
|
246 :style toggle :selected br-keep-viewed-classes]
|
|
100
|
247 ["Graphical-Add-Features" br-tree-features-toggle
|
|
0
|
248 :style toggle :selected br-show-features]
|
|
100
|
249 ["Show-Inherited-Features"
|
|
|
250 (setq br-inherited-features-flag
|
|
|
251 (not br-inherited-features-flag))
|
|
|
252 :style toggle :selected br-inherited-features-flag]
|
|
0
|
253 )
|
|
|
254 ("View-Window"
|
|
|
255 ["Full-Frame" br-view-full-frame t]
|
|
|
256 ["Kill-Buffer" br-kill t]
|
|
|
257 ["Move-To-or-From" br-to-from-viewer t]
|
|
|
258 )
|
|
|
259 "----"
|
|
|
260 ["Reinitialize" br-refresh t]
|
|
|
261 ["Exit-Temporarily" (id-tool-quit '(br-quit)) t]
|
|
|
262 ["Quit" (id-tool-quit '(br-quit t)) t]
|
|
|
263 ))
|
|
|
264
|
|
|
265 ;;; ************************************************************************
|
|
|
266 ;;; Public functions
|
|
|
267 ;;; ************************************************************************
|
|
|
268
|
|
|
269 ;;; This definition is used only by XEmacs and Emacs19.
|
|
|
270 (defun br-menubar-menu ()
|
|
|
271 "Add an OO-Browser menu to the menubar for each listing buffer."
|
|
|
272 (cond ((fboundp 'popup-mode-menu)
|
|
|
273 (setq mode-popup-menu id-popup-br-menu))
|
|
|
274 (hyperb:lemacs-p
|
|
|
275 (define-key br-mode-map 'button3 'br-popup-menu))
|
|
|
276 (t ;; hyperb:emacs19-p
|
|
|
277 (define-key br-mode-map [down-mouse-3] 'br-popup-menu)
|
|
|
278 (define-key br-mode-map [mouse-3] nil)))
|
|
|
279 (if (and (boundp 'current-menubar)
|
|
|
280 (or hyperb:emacs19-p current-menubar)
|
|
|
281 (not (car (find-menu-item current-menubar '("OO-Browser")))))
|
|
|
282 (progn
|
|
|
283 (set-buffer-menubar (copy-sequence current-menubar))
|
|
|
284 (if (fboundp 'add-submenu)
|
|
|
285 (add-submenu nil id-popup-br-menu)
|
|
|
286 (add-menu nil (car id-popup-br-menu) (cdr id-popup-br-menu))))))
|
|
|
287
|
|
|
288 ;;; This definition is used only by XEmacs and Emacs19.
|
|
|
289 (defun br-popup-menu (event)
|
|
|
290 "Popup the OO-Browser listing buffer menu."
|
|
|
291 (interactive "@e")
|
|
|
292 (mouse-set-point event)
|
|
|
293 (if (fboundp 'popup-mode-menu)
|
|
|
294 (popup-mode-menu)
|
|
|
295 (popup-menu id-popup-br-menu)))
|
|
|
296
|
|
|
297 (cond ((null hyperb:window-system))
|
|
|
298 ((fboundp 'id-menubar-set)
|
|
|
299 ;; InfoDock under a window system
|
|
|
300 (require 'id-menubars)
|
|
|
301 (id-menubar-set 'br-mode 'id-menubar-br))
|
|
|
302 (hyperb:lemacs-p
|
|
|
303 ;; XEmacs under a window system
|
|
|
304 (add-hook 'br-mode-hook 'br-menubar-menu))
|
|
|
305 (hyperb:emacs19-p
|
|
|
306 ;; Emacs 19 under a window system
|
|
|
307 (require 'lmenu)
|
|
|
308 (add-hook 'br-mode-hook 'br-menubar-menu)))
|
|
|
309
|
|
|
310 (provide 'br-menu)
|
