Mercurial > hg > xemacs-beta

comparison lisp/oobr/br-menu.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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
9 ;; ORG: Motorola Inc.
10 ;;
11 ;; ORIG-DATE: 27-Oct-93 at 21:13:36
12 ;; LAST-MOD: 22-Oct-95 at 00:41:44 by Bob Weiner
13 ;;
14 ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
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)
39 (mail nil "oo-browser@hub.ucsb.edu"
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)
45 (mail nil "oo-browser-request@hub.ucsb.edu")
46 (insert "Use a subject line like one of the following:\n"
47 " Subject: Subscribe <joe@any.com> (Joe Williams).\n"
48 " Subject: Unsubscribe <joe@any.com>.\n")
49 (goto-char (point-min))
50 (search-forward "Subject: " nil t)) t]
51 "----"
52 ["Reinitialize" br-refresh t]
53 ["Exit-Temporarily" (id-tool-quit '(br-quit)) t]
54 ["Quit" (id-tool-quit '(br-quit t)) t]
55 )
56 ("Class"
57 ["Edit-Current" br-edit-entry t]
58 ["Edit-Named" br-find t]
59 ["View-Current" br-view-entry t]
60 "----"
61 ["Match-from-Listing" br-match t]
62 ["Where-is-Any" (br-where t) t]
63 ["Where-is-Current" br-where t]
64 "----"
65 ["Graphical-Descendants" br-tree t]
66 "----"
67 ["Ancestors" (br-ancestors -1) t]
68 ["Children" br-children t]
69 ["Descendants" br-descendants t]
70 ["Features" br-features t]
71 ["Info" br-class-info t]
72 ["Level" br-at t]
73 ["Parents" br-parents t]
74 ["Class-Statistics" br-class-stats t]
75 )
76 ("Environment"
77 ["Create" (id-tool-invoke id-tool-oo-browser) t]
78 ["Load" (id-tool-invoke id-tool-oo-browser) t]
79 ["Rebuild" br-env-rebuild t]
80 ["Rebuild-Lib-Part" br-lib-rebuild t]
81 ["Rebuild-Sys-Part" br-sys-rebuild t]
82 ["Save" br-env-save t]
83 ["Statistics" br-env-stats t]
84 "----"
85 ["Add-File" br-add-class-file t]
86 ["Delete-Class" br-delete t]
87 )
88 ("Feature"
89 ["Edit-Current" br-edit-entry t]
90 ["Edit-Named" br-find t]
91 ["View-Current" br-view-entry t]
92 ["View-Friend-Def" br-view-friend t]
93 "----"
94 ["Implementors" br-implementors t]
95 ["Signature" br-ftr-signature t]
96 )
97 ("List-Window"
98 ["Graphical-View" br-tree-graph t]
99 ["Graphical-Descendants" (br-tree t) t]
100 ["Kill-Graphical-Views" br-tree-kill t]
101 "----"
102 ["Write (Save as)" br-write-buffer t]
103 "----"
104 ["Count-Entries" br-count t]
105 ["Order-Entries" (progn (br-order 1)
106 (br-unique)) t]
107 "----"
108 ["Ancestors" (br-ancestors -2) t]
109 ["Children" (br-children t) t]
110 ["Descendants" (br-descendants t) t]
111 ["Features" (br-features 1) t]
112 ["Files" br-buffer-menu t]
113 ["Level" (br-at t) t]
114 ["Parents" (br-parents t) t]
115 "----"
116 ["Show-All-Classes" (br-top-classes t) t]
117 ["Show-All-Lib-Classes" (br-lib-top-classes t) t]
118 ["Show-All-Sys-Classes" (br-sys-top-classes t) t]
119 ["Show-Top-Classes" br-top-classes t]
120 ["Show-Top-Lib-Classes" br-lib-top-classes t]
121 ["Show-Top-Sys-Classes" br-sys-top-classes t]
122 "----"
123 ["Exit-This-Level" br-exit-level t]
124 ["Narrow-by-10" br-resize-narrow t]
125 ["Widen-by-10" br-resize-widen t]
126 )
127 ("Options"
128 ["Keep-Viewed-Classes" br-toggle-keep-viewed
129 :style toggle :selected br-keep-viewed-classes]
130 ["Graphical-Show-Features" br-tree-features-toggle
131 :style toggle :selected br-show-features]
132 )
133 ("View-Window"
134 ["Full-Frame" br-view-full-frame t]
135 ["Kill-Buffer" br-kill t]
136 ["Move-To-or-From" br-to-from-viewer t]
137 )
138 ))
139
140 ;;; This definition is used by InfoDock and XEmacs.
141 (defconst id-popup-br-menu
142 '("OO-Browser"
143 ["Copyright" br-copyright t]
144 ["Help-Commands" br-help t]
145 ["Help-Mode" describe-mode t]
146 ["Help-Mouse" br-help-ms t]
147 ["Manual" (id-info "(oo-browser.info)Top") t]
148 ["Version" br-version t]
149 "----"
150 ["Compose-Mail-to-List"
151 (progn (br-quit)
152 (mail nil "oo-browser@hub.ucsb.edu"
153 "Replace this line with a descriptive sentence.")
154 (goto-char (point-min))
155 (search-forward "Subject: " nil t)) t]
156 ["Mail-List-Request"
157 (progn (br-quit)
158 (mail nil "oo-browser-request@hub.ucsb.edu")
159 (insert "Use a subject line like one of the following:\n"
160 " Subject: Subscribe <joe@any.com> (Joe Williams).\n"
161 " Subject: Unsubscribe <joe@any.com>.\n")
162 (goto-char (point-min))
163 (search-forward "Subject: " nil t)) t]
164 "----"
165 ("Class"
166 ["Edit-Current" br-edit-entry t]
167 ["Edit-Named" br-find t]
168 ["View-Current" br-view-entry t]
169 "----"
170 ["Match-from-Listing" br-match t]
171 ["Where-is-Any" (br-where t) t]
172 ["Where-is-Current" br-where t]
173 "----"
174 ["Graphical-View" br-tree-graph t]
175 ["Graphical-Descendants" (br-tree t) t]
176 ["Kill-Graphical-Views" br-tree-kill t]
177 "----"
178 ["Ancestors" (br-ancestors -1) t]
179 ["Children" br-children t]
180 ["Descendants" br-descendants t]
181 ["Features" br-features t]
182 ["Info" br-class-info t]
183 ["Level" br-at t]
184 ["Parents" br-parents t]
185 ["Class-Statistics" br-class-stats t]
186 )
187 ("Environment"
188 ["Create" (id-tool-invoke id-tool-oo-browser) t]
189 ["Load" (id-tool-invoke id-tool-oo-browser) t]
190 ["Rebuild" br-env-rebuild t]
191 ["Rebuild-Lib-Part" br-lib-rebuild t]
192 ["Rebuild-Sys-Part" br-sys-rebuild t]
193 ["Save" br-env-save t]
194 ["Statistics" br-env-stats t]
195 "----"
196 ["Add-File" br-add-class-file t]
197 ["Delete-Class" br-delete t]
198 )
199 ("Feature"
200 ["Edit-Current" br-edit-entry t]
201 ["Edit-Named" br-find t]
202 ["View-Current" br-view-entry t]
203 ["View-Friend-Def" br-view-friend t]
204 "----"
205 ["Implementors" br-implementors t]
206 ["Signature" br-feature-signature t]
207 )
208 ("List-Window"
209 ["Write (Save as)" br-write-buffer t]
210 "----"
211 ["Count-Entries" br-count t]
212 ["Order-Entries" (progn (br-order 1)
213 (br-unique)) t]
214 "----"
215 ["Ancestors" (br-ancestors -2) t]
216 ["Children" (br-children t) t]
217 ["Descendants" (br-descendants t) t]
218 ["Features" (br-features 1) t]
219 ["Files" br-buffer-menu t]
220 ["Level" (br-at t) t]
221 ["Parents" (br-parents t) t]
222 "----"
223 ["Show-All-Classes" (br-top-classes t) t]
224 ["Show-All-Lib-Classes" (br-lib-top-classes t) t]
225 ["Show-All-Sys-Classes" (br-sys-top-classes t) t]
226 ["Show-Top-Classes" br-top-classes t]
227 ["Show-Top-Lib-Classes" br-lib-top-classes t]
228 ["Show-Top-Sys-Classes" br-sys-top-classes t]
229 "----"
230 ["Exit-This-Level" br-exit-level t]
231 ["Narrow-by-10" br-resize-narrow t]
232 ["Widen-by-10" br-resize-widen t]
233 )
234 ("Options"
235 ["Keep-Viewed-Classes" br-toggle-keep-viewed
236 :style toggle :selected br-keep-viewed-classes]
237 ["Graphical-Show-Features" br-tree-features-toggle
238 :style toggle :selected br-show-features]
239 )
240 ("View-Window"
241 ["Full-Frame" br-view-full-frame t]
242 ["Kill-Buffer" br-kill t]
243 ["Move-To-or-From" br-to-from-viewer t]
244 )
245 "----"
246 ["Reinitialize" br-refresh t]
247 ["Exit-Temporarily" (id-tool-quit '(br-quit)) t]
248 ["Quit" (id-tool-quit '(br-quit t)) t]
249 ))
250
251 ;;; ************************************************************************
252 ;;; Public functions
253 ;;; ************************************************************************
254
255 ;;; This definition is used only by XEmacs and Emacs19.
256 (defun br-menubar-menu ()
257 "Add an OO-Browser menu to the menubar for each listing buffer."
258 (cond ((fboundp 'popup-mode-menu)
259 (setq mode-popup-menu id-popup-br-menu))
260 (hyperb:lemacs-p
261 (define-key br-mode-map 'button3 'br-popup-menu))
262 (t ;; hyperb:emacs19-p
263 (define-key br-mode-map [down-mouse-3] 'br-popup-menu)
264 (define-key br-mode-map [mouse-3] nil)))
265 (if (and (boundp 'current-menubar)
266 (or hyperb:emacs19-p current-menubar)
267 (not (car (find-menu-item current-menubar '("OO-Browser")))))
268 (progn
269 (set-buffer-menubar (copy-sequence current-menubar))
270 (if (fboundp 'add-submenu)
271 (add-submenu nil id-popup-br-menu)
272 (add-menu nil (car id-popup-br-menu) (cdr id-popup-br-menu))))))
273
274 ;;; This definition is used only by XEmacs and Emacs19.
275 (defun br-popup-menu (event)
276 "Popup the OO-Browser listing buffer menu."
277 (interactive "@e")
278 (mouse-set-point event)
279 (if (fboundp 'popup-mode-menu)
280 (popup-mode-menu)
281 (popup-menu id-popup-br-menu)))
282
283 (cond ((null hyperb:window-system))
284 ((fboundp 'id-menubar-set)
285 ;; InfoDock under a window system
286 (require 'id-menubars)
287 (id-menubar-set 'br-mode 'id-menubar-br))
288 (hyperb:lemacs-p
289 ;; XEmacs under a window system
290 (add-hook 'br-mode-hook 'br-menubar-menu))
291 (hyperb:emacs19-p
292 ;; Emacs 19 under a window system
293 (require 'lmenu)
294 (add-hook 'br-mode-hook 'br-menubar-menu)))
295
296 (provide 'br-menu)