|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: br.el
|
|
|
4 ;; SUMMARY: Browse object-oriented code.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: matching, oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
24
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 12-Dec-89
|
|
24
|
12 ;; LAST-MOD: 21-Feb-97 at 16:45:11 by Bob Weiner
|
|
0
|
13 ;;
|
|
24
|
14 ;; Copyright (C) 1989-1996 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 ;;; Other required Elisp libraries
|
|
|
24 ;;; ************************************************************************
|
|
|
25
|
|
|
26 (require 'br-lib)
|
|
|
27
|
|
|
28 ;;; ************************************************************************
|
|
|
29 ;;; Public variables
|
|
|
30 ;;; ************************************************************************
|
|
|
31
|
|
|
32 (defvar br-c-tags-flag t
|
|
|
33 "*Non-nil means add C constructs when building C-based language Environments.")
|
|
|
34
|
|
|
35 (defvar br-directory nil
|
|
|
36 "Directory in which OO-Browser executable and help files are kept.")
|
|
|
37
|
|
|
38 (defconst br-feature-signature-regexp "[:|,]"
|
|
|
39 "Regular expression that matches a feature signature but not a class name.")
|
|
|
40
|
|
|
41 (defvar br-inherited-features-flag t
|
|
|
42 "*If non-nil (the default), feature/element listings include all inherited features.
|
|
|
43 If nil, only those features lexically included within a class are shown.")
|
|
|
44
|
|
|
45 (defvar br-inhibit-version nil
|
|
|
46 "*Personal setting which if non-nil, skips version/credit information upon startup.
|
|
|
47 The default should be left as nil, since new users may find this helpful.")
|
|
|
48
|
|
|
49 (defvar br-invert-ancestors nil
|
|
|
50 "*Personal setting which if non-nil makes ancestors appear as do other inheritance listings.
|
|
|
51 That is, parents appear above children, rather than the default, which is the
|
|
|
52 reverse.")
|
|
|
53
|
|
|
54 (defvar br-keep-viewed-classes nil
|
|
|
55 "*Personal setting which if non-nil means leave all viewed classes around for later selection.
|
|
|
56 Non-nil deletes last viewed class when a new one is displayed. Note this
|
|
|
57 does not affect classes displayed for editing, all such classes are left
|
|
|
58 around.")
|
|
|
59
|
|
|
60 (defconst br-min-width-window 25
|
|
|
61 "*Minimum width of a browser class list window.
|
|
|
62 This together with the frame width determines the number of such windows.")
|
|
|
63
|
|
24
|
64 ;; -f treats upper and lower case the same in sorting, also makes `a' sort
|
|
|
65 ;; list before `[a]', so default classes appear at the end of the list,
|
|
0
|
66 ;; typically.
|
|
|
67 ;; -u leaves only unique elements in the sorted list
|
|
|
68 (defvar br-sort-options "-fu"
|
|
|
69 "*String of options to send to the operating system `sort' command.
|
|
|
70 Use nil for none. This is used by the OO-Browser (br-order) command only
|
|
|
71 under Emacs 18.")
|
|
|
72
|
|
|
73 ;;; ************************************************************************
|
|
|
74 ;;; Public macros
|
|
|
75 ;;; ************************************************************************
|
|
|
76
|
|
|
77 (if (fboundp 'window-highest-p)
|
|
|
78 (defun br-non-listing-window-p ()
|
|
|
79 "Is the selected window a non-OO-Browser listing window?"
|
|
|
80 ;; Top of window is not at top of frame.
|
|
|
81 (not (window-highest-p (selected-window))))
|
|
|
82 (defun br-non-listing-window-p ()
|
|
|
83 "Is the selected window a non-OO-Browser listing window?"
|
|
|
84 ;; Top of window is not at top of frame.
|
|
|
85 (/= (nth 1 (window-edges)) br-top-of-frame)))
|
|
|
86
|
|
|
87 (if (fboundp 'window-highest-p)
|
|
|
88 (defun br-listing-window-p ()
|
|
|
89 "Is the selected window an OO-Browser listing window?"
|
|
|
90 (window-highest-p (selected-window)))
|
|
|
91 (defun br-listing-window-p ()
|
|
|
92 "Is the selected window an OO-Browser listing window?"
|
|
|
93 ;; Top of window is at top of frame.
|
|
|
94 (= (nth 1 (window-edges)) br-top-of-frame)))
|
|
|
95
|
|
|
96 ;;; ************************************************************************
|
|
|
97 ;;; Public functions
|
|
|
98 ;;; ************************************************************************
|
|
|
99
|
|
|
100 (defun br-browse ()
|
|
|
101 "Internally invoke the OO-Browser, for browsing class hierarchies.
|
|
|
102 Use \\[br-help] and \\[br-help-ms] for help on browser usage."
|
|
|
103 (interactive)
|
|
|
104 ;; If not already in the browser, save window config.
|
|
|
105 (if (br-in-browser)
|
|
|
106 nil
|
|
|
107 (setq *br-prev-wconfig* (current-window-configuration)
|
|
|
108 br-in-browser (selected-frame))
|
|
|
109 ;; If were previously in the browser, restore its saved window config,
|
|
|
110 ;; otherwise, set up from scratch.
|
|
|
111 (if *br-save-wconfig*
|
|
|
112 (set-window-configuration *br-save-wconfig*)
|
|
|
113 (br-window-setup)
|
|
|
114 (if br-inhibit-version
|
|
|
115 (br-top-classes t)
|
|
|
116 (br-version)
|
|
24
|
117 (message "Press {h} for help; use {C-c #} to see version and credits again.")
|
|
0
|
118 ;; Display all classes.
|
|
|
119 (br-top-classes t)
|
|
24
|
120 (message "Press {h} for help; use {C-c #} to see version and credits again.")
|
|
0
|
121 ;; Wait for 60 seconds or until a single key sequence is given.
|
|
|
122 (sit-for 60)
|
|
|
123 (message ""))
|
|
|
124 (br-help))
|
|
|
125 (run-hooks 'br-mode-hook
|
|
|
126 (intern (concat "br-" br-lang-prefix "mode-hook")))))
|
|
|
127
|
|
|
128 ;;;###autoload
|
|
|
129 (defun br-add-class-file (&optional class-path lib-table-p save-file)
|
|
|
130 "Add a file of classes to the current Environment.
|
|
|
131 Interactively or when optional CLASS-PATH is nil, CLASS-PATH defaults to the
|
|
|
132 current buffer file pathname. If optional LIB-TABLE-P is non-nil, add to
|
|
|
133 Library Environment, otherwise add to System Environment. If optional
|
|
|
134 SAVE-FILE is t, the Environment is then stored to the filename given by
|
|
24
|
135 `br-env-file'. If SAVE-FILE is non-nil and not t, its string value is used
|
|
0
|
136 as the file to which to save the Environment."
|
|
|
137 (interactive
|
|
|
138 (list (read-file-name (concat "Class file name to add"
|
|
|
139 (if buffer-file-name
|
|
|
140 (concat " (default \""
|
|
|
141 (file-name-nondirectory
|
|
|
142 buffer-file-name)
|
|
|
143 "\")"))
|
|
|
144 ": ")
|
|
|
145 nil buffer-file-name t)
|
|
|
146 (y-or-n-p "Add to Library, rather than System tables? ")
|
|
|
147 (y-or-n-p
|
|
|
148 (concat "Save tables after addition to " br-env-file "? "))))
|
|
|
149 (or class-path (setq class-path buffer-file-name))
|
|
|
150 (if (not (if class-path (file-readable-p class-path)))
|
|
|
151 (error "(br-add-class-file): %s is not readable" class-path))
|
|
|
152 (let* ((paths-parents-cons
|
|
|
153 (let ((br-view-file-function 'br-insert-file-contents))
|
|
|
154 (br-get-classes-from-source class-path)))
|
|
|
155 (classes (car paths-parents-cons))
|
|
|
156 (parents (cdr paths-parents-cons))
|
|
|
157 (paths-key class-path)
|
|
|
158 (path-htable (br-get-htable (if lib-table-p "lib-paths" "sys-paths")))
|
|
|
159 (par-htable (br-get-htable
|
|
|
160 (if lib-table-p "lib-parents" "sys-parents")))
|
|
|
161 (child-htable (br-get-children-htable)))
|
|
|
162 (mapcar
|
|
|
163 (function
|
|
|
164 (lambda (class)
|
|
|
165 (br-add-to-paths-htable class paths-key path-htable)))
|
|
|
166 classes)
|
|
|
167 (mapcar
|
|
|
168 (function
|
|
|
169 (lambda (parent-cons)
|
|
|
170 (hash-add (car parent-cons) (cdr parent-cons) par-htable)))
|
|
|
171 parents)
|
|
|
172 (br-env-set-htables)
|
|
|
173 (let ((child) (par-list) children)
|
|
|
174 (mapcar
|
|
|
175 (function
|
|
|
176 (lambda (parent-cons)
|
|
|
177 (setq child (cdr parent-cons)
|
|
|
178 par-list (car parent-cons))
|
|
|
179 (mapcar
|
|
|
180 (function
|
|
|
181 (lambda (parent)
|
|
|
182 (setq children (hash-get parent child-htable))
|
|
|
183 (or (br-member child children)
|
|
|
184 (hash-add (cons child children) parent child-htable))))
|
|
|
185 par-list)))
|
|
|
186 parents)))
|
|
|
187 (cond ((eq save-file nil))
|
|
|
188 ((eq save-file t) (br-env-save))
|
|
|
189 ((br-env-save save-file))))
|
|
|
190
|
|
|
191 (defun br-ancestors (&optional arg features-flag)
|
|
|
192 "Display ancestor tree whose root is the current class.
|
|
|
193 With optional prefix ARG, display all ancestor trees whose roots are in the
|
|
24
|
194 current listing. If ARG = -1 or `br-invert-ancestors' is t, the current
|
|
0
|
195 class ancestry tree is inverted. That is, it shows branches going down
|
|
|
196 towards the root class, so that parents appear above children. If ARG < -1 or
|
|
24
|
197 `br-invert-ancestors' is t and ARG > 1, then the ancestry trees of all
|
|
0
|
198 classes in the current listing are inverted.
|
|
|
199
|
|
|
200 Optional second argument, FEATURES-FLAG non-nil means display features under
|
|
|
201 each ancestor class."
|
|
|
202 (interactive "p")
|
|
|
203 (or arg (setq arg 1))
|
|
|
204 (if br-invert-ancestors (setq arg (- arg)))
|
|
|
205 (let* ((class-list
|
|
|
206 (if (and (/= arg 1) (/= arg -1))
|
|
|
207 (br-this-level-classes)
|
|
|
208 (list (br-find-class-name))))
|
|
|
209 (parents (delq nil (mapcar (function
|
|
|
210 (lambda (c) (br-get-parents c)))
|
|
|
211 class-list))))
|
|
|
212 (cond ((or parents
|
|
|
213 (and features-flag
|
|
|
214 (if (/= 1 (length class-list))
|
|
|
215 t ;; Assume some class will have features.
|
|
|
216 ;; This class must have features.
|
|
|
217 (br-list-features (car class-list)))))
|
|
|
218 (if (and (/= arg 1) (/= arg -1))
|
|
|
219 (message "Computing %s..."
|
|
|
220 (if features-flag "features" "ancestors")))
|
|
|
221 (if features-flag
|
|
|
222 (progn
|
|
|
223 (br-add-level-hist)
|
|
|
224 (br-next-buffer))
|
|
|
225 (let ((child-level (br-buffer-level)))
|
|
|
226 (br-add-level-hist)
|
|
|
227 (br-next-listing-window -1)
|
|
|
228 (br-next-buffer (concat "p" child-level))))
|
|
|
229 (let (buffer-read-only)
|
|
|
230 (cond ((>= arg 0)
|
|
|
231 (br-ancestor-trees-inverted class-list))
|
|
|
232 (t
|
|
|
233 (br-ancestor-trees class-list))))
|
|
|
234 (goto-char (point-min))
|
|
|
235 (if (and (/= arg 1) (/= arg -1))
|
|
|
236 (message "Computing %s...Done"
|
|
|
237 (if features-flag "features" "ancestors")))
|
|
|
238 t)
|
|
|
239 (t
|
|
|
240 (message "No %s." (if features-flag "features" "ancestors"))
|
|
|
241 (beep)))))
|
|
|
242
|
|
|
243 (defun br-at (&optional arg)
|
|
|
244 "Display current class location in the inheritance graph.
|
|
|
245 The class is displayed among both its ancestors and descendants.
|
|
|
246 With optional prefix ARG, display location for all classes in the current
|
|
|
247 listing."
|
|
|
248 (interactive "P")
|
|
|
249 (let* ((parent)
|
|
|
250 (parent-list
|
|
|
251 (if arg
|
|
|
252 (br-this-level-classes)
|
|
|
253 (list (setq parent (br-find-class-name))))))
|
|
|
254 (if arg
|
|
|
255 (message "Computing class locations...")
|
|
|
256 (br-narrow-to-class))
|
|
|
257 (br-add-level-hist)
|
|
|
258 (br-next-buffer)
|
|
|
259 (let (buffer-read-only)
|
|
|
260 (br-descendant-trees (br-ancestor-roots parent-list))
|
|
|
261 (goto-char (point-min))
|
|
|
262 (if arg
|
|
|
263 (message "Computing class locations...Done")
|
|
|
264 (re-search-forward (concat "\\(^\\|[ \t]+\\)" parent "$"))
|
|
|
265 (goto-char (match-end 1))
|
|
|
266 (recenter '(4))))))
|
|
|
267
|
|
|
268 (defun br-categories (&optional arg)
|
|
|
269 "Display categories directly associated with the current class.
|
|
|
270 This does not include any categories which the class inherits.
|
|
|
271 With optional prefix ARG, display categories of all classes in the current
|
|
|
272 listing."
|
|
|
273 (interactive "P")
|
|
|
274 (let ((has-categories)
|
|
|
275 class-list categories class-and-categories)
|
|
|
276 (setq class-list (cond (arg
|
|
|
277 (message "Computing class categories...")
|
|
|
278 (br-this-level-classes))
|
|
|
279 (t
|
|
|
280 (list (br-find-class-name))))
|
|
|
281 categories
|
|
|
282 (delq nil (mapcar
|
|
|
283 (function
|
|
|
284 (lambda (class)
|
|
|
285 (setq class-and-categories (br-list-categories class)
|
|
|
286 has-categories (or has-categories
|
|
|
287 class-and-categories))
|
|
|
288 (cons class class-and-categories)))
|
|
|
289 class-list)))
|
|
|
290 (cond ((not class-list)
|
|
24
|
291 (message "(OO-Browser): Apply `br-categories' to a class.") (beep))
|
|
0
|
292 ((not has-categories)
|
|
|
293 (message "No class categories.") (beep))
|
|
|
294 (t
|
|
|
295 (br-add-level-hist)
|
|
|
296 (br-next-buffer nil)
|
|
|
297 (let (buffer-read-only done-set class)
|
|
|
298 (mapcar
|
|
|
299 (function
|
|
|
300 (lambda (class-and-categories)
|
|
|
301 (setq class (car class-and-categories))
|
|
|
302 (if (not (br-set-cons done-set class))
|
|
|
303 (insert class " ...\n")
|
|
|
304 ;; Class successfully added to set, so it has not been
|
|
|
305 ;; listed before.
|
|
|
306 (insert class "\n")
|
|
|
307 (br-insert-features (cdr class-and-categories) 2))))
|
|
|
308 categories))
|
|
|
309 (message "Computing class categories...Done")
|
|
|
310 (goto-char (point-min))
|
|
|
311 t))))
|
|
|
312
|
|
|
313 (defun br-children (&optional arg)
|
|
|
314 "Display children of current class.
|
|
|
315 With optional prefix ARG, display children of all the classes in the current
|
|
|
316 listing."
|
|
|
317 (interactive "P")
|
|
|
318 (let ((class-list (cond (arg
|
|
|
319 (message "Computing children...")
|
|
|
320 (br-this-level-classes))
|
|
|
321 (t
|
|
|
322 (list (br-find-class-name)))))
|
|
|
323 (has-children)
|
|
|
324 children children-list)
|
|
|
325 (setq children-list (delq nil (mapcar
|
|
|
326 (function
|
|
|
327 (lambda (parent)
|
|
|
328 (setq children
|
|
|
329 (br-get-children parent)
|
|
|
330 has-children
|
|
|
331 (or has-children children))
|
|
|
332 (cons parent children)))
|
|
|
333 class-list)))
|
|
|
334 (cond ((not children-list)
|
|
24
|
335 (message "(OO-Browser): Apply `br-children' to a class.")
|
|
0
|
336 (beep))
|
|
|
337 ((not has-children)
|
|
|
338 (message "No children.") (beep))
|
|
|
339 (t
|
|
|
340 (br-add-level-hist)
|
|
|
341 (br-next-buffer nil)
|
|
|
342 (let (buffer-read-only done-set parent)
|
|
|
343 (mapcar
|
|
|
344 (function
|
|
|
345 (lambda (parent-children-cons)
|
|
|
346 (setq parent (car parent-children-cons))
|
|
|
347 (if (not (br-set-cons done-set parent))
|
|
|
348 (insert parent " ...\n")
|
|
|
349 ;; Class successfully added to set, so it has not been
|
|
|
350 ;; listed before.
|
|
|
351 (insert parent "\n")
|
|
|
352 (br-insert-classes (cdr parent-children-cons) 2))))
|
|
|
353 children-list))
|
|
|
354 (if arg (message "Computing children...Done"))
|
|
|
355 (goto-char (point-min))
|
|
|
356 t))))
|
|
|
357
|
|
|
358 (defun br-class-stats (&optional prompt)
|
|
|
359 "Display statistics summary for current class.
|
|
|
360 Optional prefix arg PROMPT means prompt for class name."
|
|
|
361 (interactive "P")
|
|
|
362 (let ((class-name (if prompt (br-complete-class-name) (br-find-class-name))))
|
|
|
363 (if class-name
|
|
|
364 (message "Class %s: Parents: %d; Children: %d"
|
|
|
365 class-name (length (br-get-parents class-name))
|
|
|
366 (length (br-get-children class-name)))
|
|
|
367 (error "No class name at point."))))
|
|
|
368
|
|
|
369 (defun br-cmd-help (key &optional full)
|
|
|
370 "Show first line of doc for OO-Browser KEY in minibuffer.
|
|
|
371 With optional FULL, display full documentation for command."
|
|
|
372 (interactive "kOO-Browser key binding: \nP")
|
|
|
373 (let* ((cmd (let ((cmd (if (eq major-mode 'br-mode)
|
|
|
374 (lookup-key br-mode-map key)
|
|
|
375 (key-binding key))))
|
|
|
376 (if (not (integerp cmd)) cmd)))
|
|
|
377 (doc (and cmd (documentation cmd)))
|
|
|
378 (end-line))
|
|
|
379 (if doc
|
|
|
380 (or full
|
|
|
381 (setq end-line (string-match "[\n]" doc)
|
|
|
382 doc (substitute-command-keys (substring doc 0 end-line))))
|
|
|
383 (setq doc (format "No documentation for {%s} %s" key (or cmd ""))))
|
|
|
384 (if (and cmd doc)
|
|
|
385 (if full
|
|
|
386 (progn (br-to-view-window)
|
|
|
387 (other-window -1)
|
|
|
388 (describe-function cmd))
|
|
|
389 (message doc)))))
|
|
|
390
|
|
|
391 (defun br-count ()
|
|
|
392 "Count number of entries visible in current listing buffer.
|
|
|
393 Print text result in minibuffer when called interactively."
|
|
|
394 (interactive)
|
|
|
395 (let ((cnt (count-lines (point-min) (point-max))))
|
|
|
396 (if (interactive-p)
|
|
|
397 (message "%s contains %d entries." (buffer-name) cnt)
|
|
|
398 cnt)))
|
|
|
399
|
|
|
400 (defun br-copyright ()
|
|
|
401 "Display browser copyright information in viewer window."
|
|
|
402 (interactive)
|
|
|
403 (br-file-to-viewer "BR-COPY"))
|
|
|
404
|
|
|
405 (defun br-delete (&optional prompt)
|
|
|
406 "Delete class from current Environment.
|
|
|
407 Does not alter descendency relations.
|
|
|
408 Optional prefix arg PROMPT means prompt for class name."
|
|
|
409 (interactive "P")
|
|
|
410 (let ((class (if prompt (br-complete-class-name) (br-find-class-name))))
|
|
|
411 (and class
|
|
|
412 (if (interactive-p)
|
|
|
413 (y-or-n-p (concat "Delete class " class " from Environment? "))
|
|
|
414 t)
|
|
|
415 (progn (br-real-delete-class class)
|
|
|
416 ;; Delete class name at point in listing window
|
|
|
417 (or prompt (let (buffer-read-only)
|
|
|
418 (progn (beginning-of-line)
|
|
|
419 (delete-region
|
|
|
420 (point) (progn (forward-line 1)
|
|
|
421 (point))))))
|
|
|
422 (message "Class " class " deleted.")))))
|
|
|
423
|
|
|
424 (defun br-descendants (&optional arg)
|
|
|
425 "Display descendant tree whose root is the current class.
|
|
|
426 With optional prefix ARG, display all descendant trees whose roots are
|
|
|
427 the classes in the current listing."
|
|
|
428 (interactive "P")
|
|
|
429 (let ((parent-list
|
|
|
430 (if arg
|
|
|
431 (br-this-level-classes)
|
|
|
432 (list (br-find-class-name)))))
|
|
|
433 (cond ((delq nil (mapcar
|
|
|
434 (function (lambda (parent)
|
|
|
435 (br-get-children parent)))
|
|
|
436 parent-list))
|
|
|
437 (if arg (message "Computing descendants..."))
|
|
|
438 (br-add-level-hist)
|
|
|
439 (br-next-buffer)
|
|
|
440 (let (buffer-read-only)
|
|
|
441 (br-descendant-trees parent-list))
|
|
|
442 (goto-char (point-min))
|
|
|
443 (if arg (message "Computing descendants...Done"))
|
|
|
444 t)
|
|
|
445 (t
|
|
|
446 (message "No descendants.") (beep)))))
|
|
|
447
|
|
|
448 (defun br-edit-entry (&optional prompt)
|
|
|
449 "Edits source for any browser listing entry, such as a class or a feature.
|
|
|
450 Optional prefix arg PROMPT means prompt for entry name."
|
|
|
451 (interactive "P")
|
|
|
452 (let ((entry) (sig))
|
|
|
453 (if prompt
|
|
|
454 (cond ((and (setq entry (br-complete-entry))
|
|
|
455 (string-match br-feature-signature-regexp entry))
|
|
|
456 (if (setq sig (car (br-feature-signature-and-file entry)))
|
|
|
457 (br-feature nil nil sig)
|
|
|
458 (error "(br-feature-signature-and-file): Couldn't find match for: '%s'" entry)))
|
|
|
459 (entry ;; class name
|
|
|
460 (br-edit nil entry))
|
|
|
461 (t (error "(br-complete-entry): Exited without selecting a match")))
|
|
|
462 (cond ((br-find-feature-entry)
|
|
|
463 (br-feature))
|
|
|
464 ((and (setq entry (br-find-class-name))
|
|
|
465 (br-class-in-table-p entry))
|
|
|
466 (br-edit nil entry))
|
|
|
467 (t (error "(OO-Browser): No entry for current line in current Environment"))))))
|
|
|
468
|
|
|
469 (defun br-edit (&optional prompt class)
|
|
|
470 "Edit a class in the viewer window.
|
|
|
471 Select viewer window. With optional prefix arg PROMPT, prompt for class
|
|
24
|
472 name. Optional CLASS is the one to edit. Return t if class is displayed or
|
|
|
473 sent to an external viewer, else nil."
|
|
0
|
474 (interactive "P")
|
|
|
475 (or br-editor-cmd
|
|
|
476 (br-in-view-window-p)
|
|
|
477 (setq *br-prev-listing-window* (selected-window)))
|
|
|
478 (br-view prompt t class))
|
|
|
479
|
|
|
480 (defun br-edit-ext (editor-cmd file)
|
|
|
481 "Invoke a non-standard EDITOR-CMD on FILE.
|
|
24
|
482 See also `br-editor-cmd'."
|
|
0
|
483 (interactive "fFile to edit: ")
|
|
|
484 (or editor-cmd (setq editor-cmd br-editor-cmd))
|
|
|
485 (if (not (stringp editor-cmd)) ;; must be a Lisp function that takes a
|
|
|
486 ;; single, file arg
|
|
|
487 (funcall editor-cmd file)
|
|
|
488 (setq delete-exited-processes t)
|
|
|
489 (let ((proc)
|
|
|
490 (name (concat br-ed-name br-ed-num))
|
|
|
491 )
|
|
|
492 (setq br-ed-num (1+ br-ed-num)
|
|
|
493 proc (br-edit-ext-start editor-cmd name file))
|
|
|
494 (if proc
|
|
|
495 (process-kill-without-query proc)
|
|
|
496 (beep)
|
|
|
497 (message "(OO-Browser): Could not start external edit process: %s"
|
|
|
498 editor-cmd)))))
|
|
|
499
|
|
|
500 (defun br-editor-kill ()
|
|
|
501 "Kill all current external editor sub-processes."
|
|
|
502 (interactive)
|
|
|
503 (if (br-kill-process-group br-ed-name br-ed-num "external editors")
|
|
|
504 (setq br-ed-num 0)))
|
|
|
505
|
|
|
506 (defun br-entry-info ()
|
|
|
507 "Display attributes of the current entry in the viewer window."
|
|
|
508 (interactive)
|
|
|
509 (if (fboundp 'br-insert-class-info)
|
|
|
510 (let ((class-name (br-find-class-name)))
|
|
|
511 (if class-name
|
|
|
512 (progn
|
|
24
|
513 (message "Building `%s' class info..." class-name)
|
|
|
514 (sit-for 2)
|
|
0
|
515 (br-store-class-info class-name)
|
|
24
|
516 (message "Building `%s' class info...Done" class-name)
|
|
0
|
517 (br-funcall-in-view-window
|
|
24
|
518 (concat br-buffer-prefix-info "Info*")
|
|
0
|
519 'br-insert-class-info))
|
|
|
520 (error "Move point to a class name line.")))
|
|
|
521 (beep)
|
|
|
522 (message "No class information function for this language.")))
|
|
|
523
|
|
|
524 (defun br-exit-level (arg)
|
|
|
525 "Return to prefix ARGth previous inheritance level listing.
|
|
|
526 The command is ignored with ARG < 1."
|
|
|
527 (interactive "p")
|
|
|
528 (setq arg (or arg 1))
|
|
|
529 (let ((prev-wind-buf-line))
|
|
|
530 (if (null *br-level-hist*)
|
|
|
531 (and (> arg 0)
|
|
|
532 (message "No previous level to which to exit.")
|
|
|
533 (beep))
|
|
|
534 (while (and (> arg 0) *br-level-hist*)
|
|
|
535 (br-next-buffer (br-listing-window-num) br-buffer-prefix-blank)
|
|
|
536 (setq prev-wind-buf-line (car *br-level-hist*)
|
|
|
537 *br-level-hist* (cdr *br-level-hist*)
|
|
|
538 arg (1- arg))
|
|
|
539 (select-window (car prev-wind-buf-line))
|
|
|
540 (switch-to-buffer (car (cdr prev-wind-buf-line))))
|
|
|
541 (widen)
|
|
|
542 ;; Position window lines exactly as before.
|
|
|
543 (recenter (car (cdr (cdr prev-wind-buf-line)))))))
|
|
|
544
|
|
|
545 (defun br-feature (&optional arg view-only ftr-sig)
|
|
|
546 "Edit a feature in the viewer window. Select viewer window.
|
|
|
547 With optional prefix ARG, prompt for feature name.
|
|
|
548 Optional VIEW-ONLY non-nil means view rather than edit feature.
|
|
|
549 Optional FTR-SIG is signature of feature to edit."
|
|
|
550 (interactive "P")
|
|
|
551 (or ftr-sig
|
|
|
552 (setq ftr-sig (if arg
|
|
|
553 (br-feature-complete 'must-match)
|
|
|
554 ;; Get current feature signature
|
|
|
555 (br-feature-get-signature))))
|
|
|
556 (if (null ftr-sig)
|
|
|
557 (error "(br-feature): No definition for this entry")
|
|
|
558 (br-to-view-window)
|
|
|
559 (if (br-feature-found-p (br-feature-file ftr-sig) ftr-sig)
|
|
|
560 (if view-only
|
|
|
561 (progn (setq buffer-read-only t)
|
|
|
562 (br-to-from-viewer))
|
|
|
563 (if (file-writable-p (buffer-file-name))
|
|
|
564 (setq buffer-read-only nil)))
|
|
|
565 ;; Feature not found. Return to original window and signal an error.
|
|
|
566 (br-to-from-viewer)
|
|
|
567 (error "(br-feature): Can't find definition of: '%s'" ftr-sig))))
|
|
|
568
|
|
|
569 (defun br-features (arg)
|
|
|
570 "Display features/elements of the current class (prefix ARG = 1) or of the current listing if ARG is other than 0 or 1.
|
|
|
571
|
|
24
|
572 With ARG = 0, the value of the variable, `br-inherited-features-flag', is
|
|
0
|
573 toggled and no other action is taken.
|
|
|
574
|
|
24
|
575 If `br-inherited-features-flag' is t, all features of each class are shown.
|
|
0
|
576 If nil, only lexically included features are shown and if the features of a
|
|
|
577 single class are requested and none are defined, the class definition is
|
|
|
578 displayed so that its feature declarations may be browsed."
|
|
|
579 (interactive "p")
|
|
|
580 (cond ((and (integerp arg) (= arg 0))
|
|
|
581 (setq br-inherited-features-flag
|
|
|
582 (not br-inherited-features-flag))
|
|
|
583 (message "Inherited features/elements will %sbe shown."
|
|
|
584 (if br-inherited-features-flag "" "not ")))
|
|
|
585 (br-inherited-features-flag
|
|
|
586 (br-inherited-features arg))
|
|
|
587 (t (br-lexical-features arg))))
|
|
|
588
|
|
|
589 (defun br-find (element)
|
|
|
590 "Interactively complete class or ELEMENT name and jump to its definition.
|
|
|
591 Return ELEMENT or signal an error."
|
|
|
592 (interactive (list (br-complete-entry)))
|
|
|
593 (if (and element
|
|
|
594 (progn
|
|
|
595 (if (not (br-in-view-window-p)) (br-to-from-viewer))
|
|
|
596 (if (string-match br-feature-signature-regexp element)
|
|
|
597 (br-find-feature element)
|
|
|
598 (br-find-class element))))
|
|
|
599 element
|
|
24
|
600 (error "(OO-Browser): `%s' definition not found." element)))
|
|
0
|
601
|
|
|
602 (defun br-help (&optional file)
|
|
|
603 "Display browser operation help information in viewer window."
|
|
|
604 (interactive)
|
|
|
605 (or file (setq file "br-help"))
|
|
|
606 (br-file-to-viewer file)
|
|
|
607 (save-window-excursion
|
|
|
608 (br-to-view-window)
|
|
|
609 (br-mode)
|
|
|
610 (use-local-map nil))
|
|
|
611 (message ""))
|
|
|
612
|
|
|
613 (defun br-help-ms ()
|
|
|
614 "Display browser mouse usage help information in viewer window."
|
|
|
615 (interactive)
|
|
|
616 (br-help "br-help-ms"))
|
|
|
617
|
|
|
618 (defun br-implementors (&optional arg)
|
|
|
619 "Display hierarchy of classes that define current element.
|
|
|
620 Ignore inherited elements. With optional prefix ARG, display implementors of
|
|
|
621 all elements in the current listing."
|
|
|
622 (interactive "P")
|
|
|
623 (let
|
|
|
624 ((child-level (br-buffer-level))
|
|
|
625 (ftr-list (if arg (br-set-of-strings
|
|
|
626 (sort (br-this-level-features) 'string-lessp))
|
|
|
627 ;; Need this check to avoid trying to find implementors of
|
|
|
628 ;; a class which happens to have an attached element tag,
|
|
|
629 ;; e.g. in an implementors listing buffer.
|
|
|
630 (save-excursion
|
|
|
631 (beginning-of-line)
|
|
|
632 (skip-chars-forward " \t")
|
|
|
633 (if (looking-at br-feature-entry)
|
|
|
634 (list (br-find-feature-entry)))))))
|
|
|
635 (if (or (null ftr-list) (null (car ftr-list)))
|
|
|
636 (error
|
|
24
|
637 "(OO-Browser): `br-implementors' must be applied to a feature.")
|
|
0
|
638 (message "Computing implementors...")
|
|
|
639 (br-add-level-hist)
|
|
|
640 (br-next-listing-window -1)
|
|
|
641 (br-next-buffer (concat "p" child-level))
|
|
|
642 (let ((buffer-read-only) (implementor-tags) (classes)
|
|
|
643 start)
|
|
|
644 (widen)
|
|
|
645 (erase-buffer)
|
|
|
646 (mapcar (function
|
|
|
647 (lambda (ftr-entry)
|
|
|
648 (setq implementor-tags
|
|
|
649 (sort
|
|
|
650 (br-feature-implementors
|
|
|
651 (br-feature-name ftr-entry))
|
|
|
652 'string-lessp)
|
|
|
653 classes (mapcar 'br-feature-tag-class
|
|
|
654 implementor-tags))
|
|
|
655 (insert ftr-entry "\n")
|
|
|
656 (setq start (point))
|
|
|
657 (br-insert-classes classes 4)
|
|
|
658 (save-excursion
|
|
|
659 (goto-char start)
|
|
|
660 (br-feature-put-signatures implementor-tags))))
|
|
|
661 ftr-list))
|
|
|
662 (goto-char 1)
|
|
|
663 (message "Computing implementors...Done"))))
|
|
|
664
|
|
|
665 (defun br-inherited-features (arg)
|
|
|
666 "Display class features, including those from ancestors.
|
|
|
667 With optional prefix ARG, display features of all classes in the current
|
|
|
668 listing."
|
|
|
669 (interactive "p")
|
|
|
670 (let ((br-ancestor-function
|
|
|
671 (function
|
|
|
672 (lambda (class repeated-class indent)
|
|
|
673 (if repeated-class
|
|
|
674 nil
|
|
|
675 (br-insert-features (br-list-features class indent) indent))))))
|
|
|
676 (br-ancestors arg t)))
|
|
|
677
|
|
|
678 (defun br-kill ()
|
|
|
679 "Kill buffer in viewer window and redisplay help text."
|
|
|
680 (interactive)
|
|
|
681 (br-do-in-view-window '(progn (kill-buffer nil) (br-help))))
|
|
|
682
|
|
|
683 (defun br-lexical-features (arg)
|
|
|
684 "Display class features lexically defined within current class.
|
|
|
685 With numeric prefix ARG, display features of all classes in the current
|
|
|
686 listing.
|
|
|
687
|
|
|
688 If the features of a single class are requested and there are no feature
|
|
|
689 definitions for the class, display the class definition so that its feature
|
|
|
690 declarations may be browsed."
|
|
|
691 (interactive "p")
|
|
|
692 (let ((has-features)
|
|
|
693 class-list features class-and-features)
|
|
|
694 (setq class-list (cond ((and (integerp arg) (/= arg 1))
|
|
|
695 (message "Computing class features...")
|
|
|
696 (br-this-level-classes))
|
|
|
697 (t
|
|
|
698 (list (br-find-class-name))))
|
|
|
699 features
|
|
|
700 (delq nil (mapcar
|
|
|
701 (function
|
|
|
702 (lambda (class)
|
|
|
703 (setq class-and-features (br-list-features class)
|
|
|
704 has-features (or has-features
|
|
|
705 class-and-features))
|
|
|
706 (cons class class-and-features)))
|
|
|
707 class-list)))
|
|
|
708 (cond ((not class-list)
|
|
|
709 (beep)
|
|
24
|
710 (message "(OO-Browser): Apply `br-features' to a class."))
|
|
0
|
711 ((not has-features)
|
|
|
712 (if (and (= (length class-list) 1)
|
|
|
713 (br-class-path (car class-list)))
|
|
|
714 (if (br-view nil nil (car class-list))
|
|
|
715 (message
|
|
|
716 "No feature definitions, browse declarations instead."))
|
|
|
717 (message "No class features.") (beep)))
|
|
|
718 (t
|
|
|
719 (br-add-level-hist)
|
|
|
720 (br-next-buffer nil)
|
|
|
721 (let (buffer-read-only done-set class)
|
|
|
722 (mapcar
|
|
|
723 (function
|
|
|
724 (lambda (class-and-features)
|
|
|
725 (setq class (car class-and-features))
|
|
|
726 (if (not (br-set-cons done-set class))
|
|
|
727 (insert class " ...\n")
|
|
|
728 ;; Class successfully added to set, so it has not been
|
|
|
729 ;; listed before.
|
|
|
730 (insert class "\n")
|
|
|
731 (br-insert-features (cdr class-and-features) 2))))
|
|
|
732 features)
|
|
|
733 (message "Computing class features...Done")
|
|
|
734 (goto-char (point-min)))))))
|
|
|
735
|
|
|
736 (defun br-lib-rebuild ()
|
|
|
737 "Rescan Library components of the current Environment."
|
|
|
738 (interactive)
|
|
|
739 (if (call-interactively 'br-build-lib-htable)
|
|
|
740 (br-top-classes t)))
|
|
|
741
|
|
|
742 (defun br-lib-top-classes (&optional arg)
|
|
|
743 "Display list of top level Library classes.
|
|
|
744 With prefix ARG, display all Library classes."
|
|
|
745 (interactive "P")
|
|
|
746 (and (or (not (interactive-p))
|
|
|
747 (br-in-top-buffer-p)
|
|
|
748 (y-or-n-p "Exit to top-level class listing buffer? "))
|
|
|
749 (cond (arg
|
|
|
750 (br-show-top-classes
|
|
|
751 (function (lambda () (br-all-classes "lib")))
|
|
|
752 'uniq)
|
|
|
753 (message "Listing of all Library classes"))
|
|
|
754 (t
|
|
|
755 (br-show-top-classes 'br-get-lib-top-classes 'uniq)
|
|
|
756 (message "Listing of top-level Library classes")))
|
|
|
757 (setq *br-level-hist* nil)))
|
|
|
758
|
|
|
759 (defun br-match (&optional expr arg again matched)
|
|
|
760 "Show all class names in current Environment that contain optional EXPR.
|
|
|
761 Nil value of EXPR means prompt for a value. With optional prefix ARG, EXPR
|
|
|
762 is treated as a string. By default, it is treated as a regular expresion.
|
|
|
763 AGAIN non-nil shows the number of classes MATCHED from the last search,
|
|
|
764 allowing repeated narrowing of the search set. Empty EXPR when AGAIN is nil
|
|
|
765 matches to all classes in the Environment."
|
|
|
766 (interactive (list nil current-prefix-arg))
|
|
|
767 (or expr (setq expr (read-string
|
|
|
768 (concat (if again (format "(%s matches) " matched))
|
|
|
769 (if arg
|
|
|
770 "Find Environment class string matches"
|
|
|
771 "Find Environment class regular expression matches")
|
|
24
|
772 (if again " (RET to end): " ": ")))))
|
|
0
|
773 (if (and again (equal expr ""))
|
|
|
774 nil
|
|
|
775 (let* ((match-expr (if arg (regexp-quote expr) expr))
|
|
|
776 (classes
|
|
|
777 (delq nil (mapcar
|
|
|
778 (function
|
|
|
779 (lambda (cl)
|
|
|
780 (if (string-match match-expr cl) cl)))
|
|
|
781 (if again
|
|
|
782 (sort (br-this-level-classes) 'string-lessp)
|
|
|
783 (br-all-classes))))))
|
|
|
784 (setq classes (br-class-list-filter classes))
|
|
|
785 (if classes
|
|
|
786 (progn (let (buffer-read-only)
|
|
|
787 (br-feature-clear-signatures)
|
|
|
788 (erase-buffer)
|
|
|
789 (br-insert-classes classes 0))
|
|
|
790 (goto-char (point-min))
|
|
|
791 (br-match nil arg t (br-count)))
|
|
|
792 (beep)
|
|
|
793 (message "No matches for \"%s\"." expr)))))
|
|
|
794
|
|
|
795 (defun br-match-entries (&optional expr arg again matched)
|
|
|
796 "Show all entries in current listing that contain optional EXPR.
|
|
|
797 Nil value of EXPR means prompt for a value. With optional prefix ARG, EXPR
|
|
|
798 is treated as a string. By default, it is treated as a regular expresion.
|
|
|
799 AGAIN non-nil means show the number of entries MATCHED from last search,
|
|
|
800 allowing repeated narrowing of the search set. Empty EXPR when AGAIN is nil
|
|
|
801 matches to all entries in the listing."
|
|
|
802 (interactive (list nil current-prefix-arg))
|
|
|
803 (or expr (setq expr (read-string
|
|
|
804 (concat (if again (format "(%s matches) " matched))
|
|
|
805 (if arg
|
|
|
806 "Find string matches in listing"
|
|
|
807 "Find regular expression matches in listing")
|
|
24
|
808 (if again " (RET to end): " ": ")))))
|
|
0
|
809 (if (and again (equal expr ""))
|
|
|
810 nil
|
|
|
811 (let* ((match-expr (if arg (regexp-quote expr) expr))
|
|
|
812 (buffer-read-only))
|
|
|
813 (goto-char (point-min))
|
|
|
814 (if (not (re-search-forward match-expr nil t))
|
|
|
815 (progn (beep)
|
|
|
816 (message "No matches for \"%s\"." expr))
|
|
|
817 (goto-char (point-min))
|
|
|
818 (delete-non-matching-lines match-expr)
|
|
|
819 (goto-char (point-min))
|
|
|
820 (br-match-entries nil arg t (br-count))))))
|
|
|
821
|
|
|
822 (defun br-next-entry (arg)
|
|
|
823 "Move point vertically down prefix ARG number of lines in listing buffer."
|
|
|
824 (interactive "p")
|
|
|
825 (let ((end))
|
|
|
826 (setq end (= (forward-line arg) arg))
|
|
|
827 (and (looking-at "^$") (forward-line -1) (setq end t))
|
|
|
828 (and end (message "No next entry.") (beep))))
|
|
|
829
|
|
|
830 (defun br-order (arg)
|
|
|
831 "Order current browser listing window entries.
|
|
|
832 With prefix ARG other than 1 (the default), don't remove leading space from
|
|
|
833 entry lines before ordering. Negative ARG means order in descending Ascii
|
|
|
834 sequence, otherwise order in ascending sequence."
|
|
|
835 (interactive "p")
|
|
|
836 (setq arg (or arg 1))
|
|
|
837 (message "Ordering entries...")
|
|
|
838 (let ((buffer-read-only)
|
|
|
839 sort-args)
|
|
|
840 (and (= arg 1) (progn (goto-char (point-min))
|
|
|
841 (while (re-search-forward "^[ \t]+" nil t)
|
|
|
842 (replace-match ""))))
|
|
|
843 (if (string-match "^19\\." emacs-version)
|
|
|
844 (progn
|
|
|
845 ;; Emacs 19: This slower than calling an external sort but it
|
|
|
846 ;; maintains the element tags in a listing, allowing further browsing
|
|
|
847 ;; from this buffer.
|
|
|
848 (sort-lines (< arg 0) (point-min) (point-max))
|
|
|
849 ;; Move [default] classes to the end of the sorted list.
|
|
|
850 (goto-char (point-min))
|
|
|
851 (if (re-search-forward "^[ \t]*\\[" nil t)
|
|
|
852 (let (start end)
|
|
|
853 (beginning-of-line)
|
|
|
854 (setq start (point))
|
|
|
855 (goto-char (point-max))
|
|
|
856 (re-search-backward "^[ \t]*\\[" nil t)
|
|
|
857 (forward-line 1)
|
|
|
858 (setq end (point))
|
|
|
859 (goto-char (point-max))
|
|
|
860 (append-to-buffer (current-buffer) start end)
|
|
|
861 (delete-region start end))))
|
|
|
862 ;;
|
|
|
863 ;; Emacs 18: We can't maintain the buffer tags, so we just use a fast
|
|
|
864 ;; external sort.
|
|
|
865 (setq sort-args (list (point-min) (point-max) "sort" t t nil)
|
|
|
866 sort-args (if (< arg 0)
|
|
|
867 (if (stringp br-sort-options)
|
|
|
868 (nconc sort-args (list "-r" br-sort-options))
|
|
|
869 (nconc sort-args (list "-r")))
|
|
|
870 (if (stringp br-sort-options)
|
|
|
871 (nconc sort-args (list br-sort-options))
|
|
|
872 sort-args)))
|
|
|
873 (apply 'call-process-region sort-args)))
|
|
|
874 (goto-char (point-min))
|
|
|
875 (message "Ordering entries...Done"))
|
|
|
876
|
|
|
877 (defun br-parents (&optional arg)
|
|
|
878 "Display parents of current class.
|
|
|
879 With optional prefix ARG, display parents of all the classes in the current
|
|
|
880 listing."
|
|
|
881 (interactive "P")
|
|
|
882 (let ((class-list (cond (arg
|
|
|
883 (message "Computing parents...")
|
|
|
884 (br-this-level-classes))
|
|
|
885 (t
|
|
|
886 (list (br-find-class-name)))))
|
|
|
887 (has-parents)
|
|
|
888 parents parents-list)
|
|
|
889 (setq parents-list
|
|
|
890 (delq nil (mapcar (function
|
|
|
891 (lambda (class)
|
|
|
892 (setq parents (br-get-parents class)
|
|
|
893 has-parents (or has-parents parents))
|
|
|
894 (cons class parents)))
|
|
|
895 class-list)))
|
|
|
896 (cond ((not parents-list)
|
|
24
|
897 (message "(OO-Browser): Apply `br-parents' to a class.") (beep))
|
|
0
|
898 ((not has-parents)
|
|
|
899 (message "No parents.") (beep))
|
|
|
900 (t
|
|
|
901 (let ((child-level (br-buffer-level)))
|
|
|
902 (br-add-level-hist)
|
|
|
903 (br-next-listing-window -1)
|
|
|
904 (br-next-buffer (concat "p" child-level)))
|
|
|
905 (let (buffer-read-only done-set class)
|
|
|
906 (mapcar
|
|
|
907 (function
|
|
|
908 (lambda (class-parents-cons)
|
|
|
909 (setq class (car class-parents-cons))
|
|
|
910 (if (not (br-set-cons done-set class))
|
|
|
911 (insert class " ...\n")
|
|
|
912 ;; Class successfully added to set, so it has not been
|
|
|
913 ;; listed before.
|
|
|
914 (insert class "\n")
|
|
|
915 (br-insert-classes (cdr class-parents-cons) 2))))
|
|
|
916 parents-list))
|
|
|
917 (if arg (message "Computing parents...Done"))
|
|
|
918 (goto-char (point-min))
|
|
|
919 t))))
|
|
|
920
|
|
|
921 (defun br-prev-entry (arg)
|
|
|
922 "Move point vertically up prefix ARG number of lines in listing buffer."
|
|
|
923 (interactive "p")
|
|
|
924 (setq arg (- arg))
|
|
|
925 (and (= (forward-line arg) arg)
|
|
|
926 (message "No previous entry.")
|
|
|
927 (beep)))
|
|
|
928
|
|
|
929 (defun br-protocols (&optional arg)
|
|
|
930 "Display protocols to which the current class conforms.
|
|
|
931 This does not include any protocols which the class inherits from its
|
|
|
932 ancestors but it does include protocols which conform to other protocols.
|
|
|
933 With optional prefix ARG, display protocols of all classes in the current
|
|
|
934 listing."
|
|
|
935 (interactive "P")
|
|
|
936 (let ((has-protocols)
|
|
|
937 class-list protocols class-and-protocols)
|
|
|
938 (setq class-list (cond (arg
|
|
|
939 (message "Computing class protocols...")
|
|
|
940 (br-this-level-classes))
|
|
|
941 (t
|
|
|
942 (list (br-find-class-name)))))
|
|
|
943 (if (and (= (length class-list) 1)
|
|
|
944 (br-protocol-entry-p))
|
|
|
945 ;; If on a protocol entry, display its definition.
|
|
|
946 (br-view-protocol (car class-list))
|
|
|
947 ;; Otherwise, list protocols for all elements of class-list.
|
|
|
948 (setq protocols
|
|
|
949 (delq nil (mapcar
|
|
|
950 (function
|
|
|
951 (lambda (class)
|
|
|
952 (setq class-and-protocols (br-list-protocols class)
|
|
|
953 has-protocols (or has-protocols
|
|
|
954 class-and-protocols))
|
|
|
955 (cons class class-and-protocols)))
|
|
|
956 class-list)))
|
|
|
957 (cond ((not class-list)
|
|
|
958 (beep)
|
|
24
|
959 (message "(OO-Browser): Apply `br-protocols' to a class."))
|
|
0
|
960 ((not has-protocols)
|
|
|
961 (message "No class protocols.") (beep))
|
|
|
962 (t
|
|
|
963 (br-add-level-hist)
|
|
|
964 (br-next-buffer nil)
|
|
|
965 (let (buffer-read-only done-set class)
|
|
|
966 (mapcar
|
|
|
967 (function
|
|
|
968 (lambda (class-and-protocols)
|
|
|
969 (setq class (car class-and-protocols))
|
|
|
970 (if (not (br-set-cons done-set class))
|
|
|
971 (insert class " ...\n")
|
|
|
972 ;; Class successfully added to set, so it has not been
|
|
|
973 ;; listed before.
|
|
|
974 (insert class "\n")
|
|
|
975 (br-insert-features (cdr class-and-protocols) 2))))
|
|
|
976 protocols))
|
|
|
977 (message "Computing class protocols...Done")
|
|
|
978 (goto-char (point-min)))))))
|
|
|
979
|
|
|
980 (defun br-quit (&optional arg)
|
|
|
981 "Quit browser.
|
|
|
982 With optional prefix ARG, delete window configurations and listing
|
|
|
983 buffers associated with the browser."
|
|
|
984 (interactive "P")
|
|
|
985 (if (not (br-in-browser))
|
|
|
986 (br-interrupt arg)
|
|
|
987 (if (null arg)
|
|
|
988 (setq *br-save-wconfig* (current-window-configuration))
|
|
|
989 (if (featurep 'br-tree) (br-tree-kill))
|
|
|
990 (br-viewer-kill)
|
|
|
991 ;; Too dangerous to include (br-editor-kill) here.
|
|
|
992 ;; The user can invoke it manually if desired.
|
|
|
993 )
|
|
|
994 (and *br-prev-wconfig* (set-window-configuration *br-prev-wconfig*))
|
|
|
995 (br-interrupt arg)))
|
|
|
996
|
|
|
997 (defun br-refresh ()
|
|
|
998 "Restore OO-Browser to its state upon startup."
|
|
|
999 (interactive)
|
|
|
1000 (br-window-setup)
|
|
|
1001 (br-top-classes t)
|
|
|
1002 (br-help)
|
|
|
1003 (setq br-in-browser (selected-frame)))
|
|
|
1004
|
|
|
1005 (defun br-report-bug ()
|
|
|
1006 "Send a message to the OO-Browser discussion list."
|
|
|
1007 (interactive)
|
|
|
1008 (if (br-in-browser) (br-to-view-window))
|
|
24
|
1009 (hmail:compose "oo-browser@infodock.com" '(hypb:configuration)))
|
|
0
|
1010
|
|
|
1011 (defun br-sys-rebuild ()
|
|
|
1012 "Rescan System components of the current Environment."
|
|
|
1013 (interactive)
|
|
|
1014 (if (call-interactively 'br-build-sys-htable)
|
|
|
1015 (br-top-classes t)))
|
|
|
1016
|
|
|
1017 (defun br-sys-top-classes (&optional arg)
|
|
|
1018 "Display list of top level System classes.
|
|
|
1019 With prefix ARG, display all System classes."
|
|
|
1020 (interactive "P")
|
|
|
1021 (and (or (not (interactive-p))
|
|
|
1022 (br-in-top-buffer-p)
|
|
|
1023 (y-or-n-p "Exit to top-level class listing buffer? "))
|
|
|
1024 (cond (arg
|
|
|
1025 (br-show-top-classes
|
|
|
1026 (function (lambda () (br-all-classes "sys")))
|
|
|
1027 'uniq)
|
|
|
1028 (message "Listing of all System classes"))
|
|
|
1029 (t
|
|
|
1030 (br-show-top-classes 'br-get-sys-top-classes 'uniq)
|
|
|
1031 (message "Listing of top-level System classes")))
|
|
|
1032 (setq *br-level-hist* nil)))
|
|
|
1033
|
|
|
1034 ;;;###autoload
|
|
|
1035 (defun br-to-from-viewer ()
|
|
|
1036 "Move point to viewer window or back to last recorded listing window."
|
|
|
1037 (interactive)
|
|
|
1038 (if (br-in-view-window-p)
|
|
|
1039 (progn (if *br-prev-listing-window*
|
|
|
1040 (select-window *br-prev-listing-window*)
|
|
|
1041 (other-window 1))
|
|
|
1042 (setq *br-prev-listing-window* nil))
|
|
|
1043 (br-to-view-window)))
|
|
|
1044
|
|
|
1045 (defun br-toggle-c-tags ()
|
|
24
|
1046 "Toggle the value of the `br-c-tags-flag' flag."
|
|
0
|
1047 (interactive)
|
|
|
1048 (setq br-c-tags-flag (not br-c-tags-flag))
|
|
|
1049 (message "C constructs will %sbe added to C-based language Environments."
|
|
|
1050 (if br-c-tags-flag "" "not ")))
|
|
|
1051
|
|
|
1052 (defun br-toggle-keep-viewed ()
|
|
24
|
1053 "Toggle the value of the `br-keep-viewed-classes' flag."
|
|
0
|
1054 (interactive)
|
|
|
1055 (setq br-keep-viewed-classes (not br-keep-viewed-classes))
|
|
|
1056 (message "Viewed classes will no%s be kept after use."
|
|
|
1057 (if br-keep-viewed-classes "w" "t")))
|
|
|
1058
|
|
|
1059 (defun br-top-classes (&optional arg)
|
|
|
1060 "Display list of top level classes.
|
|
|
1061 With prefix ARG, display all Environment classes."
|
|
|
1062 (interactive "P")
|
|
|
1063 (and (or (not (interactive-p))
|
|
|
1064 (br-in-top-buffer-p)
|
|
|
1065 (y-or-n-p "Exit to top-level class listing buffer? "))
|
|
|
1066 (cond (arg
|
|
|
1067 (br-show-top-classes 'br-all-classes 'uniq)
|
|
|
1068 (message "Listing of all Environment classes"))
|
|
|
1069 (t
|
|
|
1070 (br-show-top-classes 'br-get-top-classes 'uniq)
|
|
|
1071 (message "Listing of top-level classes")))
|
|
|
1072 (setq *br-level-hist* nil)))
|
|
|
1073
|
|
|
1074 (defun br-unique ()
|
|
|
1075 "Eliminate adjacent duplicate entry names from the current listing window.
|
|
|
1076 If two adjacent entries look the same one is eliminated, even if they refer
|
|
|
1077 to different class elements."
|
|
|
1078 (interactive)
|
|
|
1079 (let ((buffer-read-only)
|
|
|
1080 (again t)
|
|
|
1081 first second)
|
|
|
1082 (goto-char (point-min))
|
|
|
1083 (setq first (br-feature-current))
|
|
|
1084 (while again
|
|
|
1085 (setq again (= (forward-line 1) 0)
|
|
|
1086 second (br-feature-current))
|
|
|
1087 (if (not (string-equal first second))
|
|
|
1088 (setq first second)
|
|
|
1089 (beginning-of-line)
|
|
|
1090 (delete-region (point) (progn (forward-line 1) (point)))
|
|
|
1091 ;; back up to first line again
|
|
|
1092 (forward-line -1)))
|
|
|
1093 (goto-char (point-min))))
|
|
|
1094
|
|
|
1095 (defun br-version ()
|
|
|
1096 "Display browser version number and credits."
|
|
|
1097 (interactive)
|
|
|
1098 (br-funcall-in-view-window
|
|
24
|
1099 (concat br-buffer-prefix-info "Help*")
|
|
0
|
1100 (function (lambda ()
|
|
24
|
1101 (insert-file-contents (br-pathname "BR-VERSION"))
|
|
|
1102 (hypb:display-file-with-logo)
|
|
0
|
1103 (if (re-search-forward "<VERSION>" nil t)
|
|
|
1104 (replace-match br-version t t))
|
|
|
1105 (center-line)
|
|
24
|
1106 (set-buffer-modified-p nil)))))
|
|
0
|
1107
|
|
|
1108 (defun br-view-entry (&optional prompt)
|
|
|
1109 "Displays source for any browser listing entry.
|
|
|
1110 Optional prefix arg PROMPT means prompt for entry name."
|
|
|
1111 (interactive "P")
|
|
|
1112 (let ((entry) (sig))
|
|
|
1113 (if prompt
|
|
|
1114 (cond ((and (setq entry (br-complete-entry))
|
|
|
1115 (string-match br-feature-signature-regexp entry))
|
|
|
1116 (if (setq sig (car (br-feature-signature-and-file entry)))
|
|
|
1117 (br-feature nil 'view sig)
|
|
|
1118 (error "(br-feature-signature-and-file): Couldn't find match for: '%s'" entry)))
|
|
|
1119 (entry ;; class name
|
|
|
1120 (br-view nil nil entry))
|
|
|
1121 (t (error "(br-complete-entry): Exited without selecting a match")))
|
|
|
1122 (cond ((br-find-feature-entry)
|
|
|
1123 (br-feature nil 'view))
|
|
|
1124 ((and (setq entry (br-find-class-name))
|
|
|
1125 (br-class-in-table-p entry))
|
|
|
1126 (br-view nil nil entry))
|
|
|
1127 (t (error "(OO-Browser): Entry may be referenced but not defined in the Environment."))))))
|
|
|
1128
|
|
|
1129 (defun br-view (&optional prompt writable class)
|
|
|
1130 "Displays class file in viewer window.
|
|
|
1131 Optional prefix arg PROMPT means prompt for class name. Non-nil WRITABLE means
|
|
|
1132 allow editing, otherwise display in read-only mode. Non-nil CLASS is class to
|
|
24
|
1133 display. Return t if class is displayed or sent to an external viewer, else nil."
|
|
0
|
1134 (interactive "P")
|
|
|
1135 (or class (setq class (if prompt (br-complete-class-name)
|
|
|
1136 (br-find-class-name))))
|
|
|
1137 (cond ((null class)
|
|
|
1138 (beep)
|
|
|
1139 (message "(OO-Browser): Select a class to view.")
|
|
|
1140 nil)
|
|
|
1141 ((not (br-class-defined-p class)) nil)
|
|
|
1142 ((and hyperb:window-system
|
|
|
1143 (cond ((and br-editor-cmd writable)
|
|
|
1144 (br-edit-ext br-editor-cmd (br-class-path class))
|
|
|
1145 t)
|
|
|
1146 (br-viewer-cmd
|
|
|
1147 (br-view-ext br-viewer-cmd (br-class-path class))
|
|
|
1148 t))))
|
|
|
1149 ;; Support custom Lisp-based edit/view cmds on any display type
|
|
|
1150 ((and br-editor-cmd writable (not (stringp br-editor-cmd)))
|
|
|
1151 (br-edit-ext br-editor-cmd (br-class-path class))
|
|
|
1152 t)
|
|
|
1153 ((and br-viewer-cmd (not (stringp br-viewer-cmd)))
|
|
|
1154 (br-view-ext br-viewer-cmd (br-class-path class))
|
|
|
1155 t)
|
|
|
1156 (t (let ((owind (selected-window)))
|
|
|
1157 (unwind-protect
|
|
|
1158 (progn (br-to-view-window)
|
|
|
1159 (if (and (not br-keep-viewed-classes) buffer-read-only
|
|
|
1160 (null (buffer-modified-p)))
|
|
|
1161 (kill-buffer (current-buffer)))
|
|
|
1162 (if (br-find-class class (not writable))
|
|
|
1163 (progn (br-major-mode)
|
|
|
1164 (if writable
|
|
|
1165 (if (file-writable-p (buffer-file-name))
|
|
|
1166 (setq buffer-read-only nil))
|
|
|
1167 (setq buffer-read-only t)
|
|
|
1168 (select-window owind))
|
|
|
1169 t)))
|
|
|
1170 (or writable (select-window owind)))))))
|
|
|
1171
|
|
|
1172 (defun br-view-ext (viewer-cmd file)
|
|
|
1173 "Invoke a non-standard VIEWER-CMD on FILE.
|
|
24
|
1174 See also `br-viewer-cmd'."
|
|
0
|
1175 (interactive "fFile to view: ")
|
|
|
1176 (or viewer-cmd (setq viewer-cmd br-viewer-cmd))
|
|
|
1177 (if (not (stringp viewer-cmd)) ;; must be a Lisp function that takes a
|
|
|
1178 ;; single, file arg
|
|
|
1179 (funcall viewer-cmd file)
|
|
|
1180 (setq delete-exited-processes t)
|
|
|
1181 (let ((proc)
|
|
|
1182 (name (concat br-vw-name br-vw-num))
|
|
|
1183 )
|
|
|
1184 (setq br-vw-num (1+ br-vw-num)
|
|
|
1185 proc (br-view-ext-start viewer-cmd name file))
|
|
|
1186 (if proc
|
|
|
1187 (process-kill-without-query proc)
|
|
|
1188 (beep)
|
|
|
1189 (message "(OO-Browser): Could not start external view process: %s"
|
|
|
1190 viewer-cmd)))))
|
|
|
1191
|
|
|
1192 (defun br-view-full-frame ()
|
|
|
1193 "Delete all windows in the selected frame except for the viewer window."
|
|
|
1194 (interactive)
|
|
|
1195 (setq *br-save-wconfig* (current-window-configuration))
|
|
|
1196 (br-to-view-window)
|
|
|
1197 (let ((buf (current-buffer)))
|
|
|
1198 (br-interrupt)
|
|
|
1199 (delete-other-windows)
|
|
|
1200 (switch-to-buffer buf))
|
|
|
1201 (let* ((cmd (concat br-lang-prefix "browse"))
|
|
|
1202 (key (car (where-is-internal (intern-soft cmd)))))
|
|
|
1203 (message "Recall OO-Browser with: {%s}"
|
|
|
1204 (if key
|
|
|
1205 (key-description key)
|
|
|
1206 (concat (key-description
|
|
|
1207 (or (car (where-is-internal
|
|
|
1208 'execute-extended-command))
|
|
|
1209 "\M-x"))
|
|
|
1210 " " cmd)))))
|
|
|
1211
|
|
|
1212 (defun br-viewer-kill ()
|
|
|
1213 "Kill all current external viewer sub-processes."
|
|
|
1214 (interactive)
|
|
|
1215 (if (br-kill-process-group br-vw-name br-vw-num "external viewers")
|
|
|
1216 (setq br-vw-num 0)))
|
|
|
1217
|
|
|
1218 (defun br-viewer-scroll-down (&optional arg)
|
|
|
1219 "Scroll viewer window downward ARG lines or a windowful if no ARG."
|
|
|
1220 (interactive "P")
|
|
|
1221 (let ((owind (selected-window)))
|
|
|
1222 (unwind-protect
|
|
|
1223 (progn (br-to-view-window)
|
|
|
1224 (scroll-down arg))
|
|
|
1225 (select-window owind))))
|
|
|
1226
|
|
|
1227 (defun br-viewer-scroll-up (&optional arg)
|
|
|
1228 "Scroll viewer window upward ARG lines or a windowful if no ARG."
|
|
|
1229 (interactive "P")
|
|
|
1230 (let ((owind (selected-window)))
|
|
|
1231 (unwind-protect
|
|
|
1232 (progn (br-to-view-window)
|
|
|
1233 (scroll-up arg))
|
|
|
1234 (select-window owind))))
|
|
|
1235
|
|
|
1236 (defun br-where (&optional prompt)
|
|
|
1237 "Display in minibuffer and return full path of a browser listing entry.
|
|
|
1238 Optional prefix arg PROMPT means prompt for entry name."
|
|
|
1239 (interactive "P")
|
|
|
1240 (let ((entry) (path))
|
|
|
1241 (if prompt
|
|
|
1242 (cond ((and (setq entry (br-complete-entry))
|
|
|
1243 (string-match br-feature-signature-regexp entry))
|
|
|
1244 (setq path (cdr (br-feature-signature-and-file entry))))
|
|
|
1245 (entry ;; class name
|
|
|
1246 (setq path (br-class-defined-p entry)))
|
|
|
1247 (t (error "(br-complete-entry): Exited without selecting a match")))
|
|
|
1248 (cond ((setq entry (br-find-feature-entry))
|
|
|
1249 (setq path (cdr (br-feature-signature-and-file entry))))
|
|
|
1250 ((setq entry (br-find-class-name))
|
|
|
1251 (or (setq path (br-class-path entry))
|
|
|
1252 (error "(OO-Browser): No path for this class in current Environment")))
|
|
|
1253 (t (error "(OO-Browser): No entry for current line in current Environment"))))
|
|
|
1254 (and path (message (concat entry ": " "\"" path "\""))
|
|
|
1255 path)))
|
|
|
1256
|
|
|
1257 (defun br-write-buffer (file)
|
|
|
1258 "Write narrowed portion of current browser buffer to a file."
|
|
|
1259 (interactive "FFile to write buffer to: ")
|
|
|
1260 (write-region (point-min) (point-max) file))
|
|
|
1261
|
|
|
1262 ;;; ************************************************************************
|
|
|
1263 ;;; Private functions
|
|
|
1264 ;;; ************************************************************************
|
|
|
1265
|
|
|
1266 (defun br-add-level-hist ()
|
|
|
1267 ;; Even though this next line looks useless, it cures a problem with
|
|
|
1268 ;; window buffer correspondences when the OO-Browser is started, so don't
|
|
|
1269 ;; remove it.
|
|
|
1270 (set-buffer (window-buffer (selected-window)))
|
|
|
1271 (setq *br-level-hist*
|
|
|
1272 (cons (list (selected-window) (buffer-name) (br-wind-line-at-point))
|
|
|
1273 *br-level-hist*)))
|
|
|
1274
|
|
|
1275 (defun br-ancestor-roots (class-list)
|
|
|
1276 "Return list of CLASS-LIST's unique ancestors which do not inherit from any other class.
|
|
|
1277 This list may include elements from CLASS-LIST itself."
|
|
|
1278 (let ((rtn) (parents) func)
|
|
|
1279 (setq func (function
|
|
|
1280 (lambda (class-list)
|
|
|
1281 (mapcar
|
|
|
1282 (function
|
|
|
1283 (lambda (class)
|
|
|
1284 (if (not (setq parents (br-get-parents class)))
|
|
|
1285 (setq rtn (cons class rtn))
|
|
|
1286 (funcall func parents))))
|
|
|
1287 class-list))))
|
|
|
1288 (funcall func class-list)
|
|
|
1289 (br-set-of-strings (sort rtn 'string-lessp))))
|
|
|
1290
|
|
|
1291 (defun br-ancestor-trees-inverted (class-list &optional depth offset)
|
|
|
1292 "Insert ancestor trees starting with classes from CLASS-LIST.
|
|
|
1293 Ancestor trees are inverted, i.e. parents appear below children, not above.
|
|
|
1294 Indent each class in CLASS-LIST by optional DEPTH spaces (default is 0 in
|
|
|
1295 order to ensure proper initialization). Offset each child level by optional
|
|
|
1296 OFFSET spaces from its parent (which must be greater than zero, default 2)."
|
|
|
1297 (or offset (setq offset 2))
|
|
|
1298 (or depth (setq depth 0))
|
|
|
1299 (if (= depth 0) (setq br-tmp-class-set nil))
|
|
|
1300 (let ((prev-expansion-str " ...")
|
|
|
1301 parents expand-subtree)
|
|
|
1302 (mapcar
|
|
|
1303 (function
|
|
|
1304 (lambda (class)
|
|
|
1305 (setq expand-subtree (br-set-cons br-tmp-class-set class)
|
|
|
1306 parents (if expand-subtree (br-get-parents class)))
|
|
|
1307 (indent-to depth)
|
|
|
1308 (insert class)
|
|
|
1309 (and (not expand-subtree) (br-has-children-p class)
|
|
|
1310 (insert prev-expansion-str))
|
|
|
1311 (insert "\n")
|
|
|
1312 (if br-ancestor-function
|
|
|
1313 (funcall br-ancestor-function
|
|
|
1314 class (not expand-subtree) (+ depth offset)))
|
|
|
1315 (if parents
|
|
|
1316 (br-ancestor-trees-inverted parents (+ depth offset) offset))))
|
|
|
1317 class-list))
|
|
|
1318 (if (= depth 0) (setq br-tmp-class-set nil)))
|
|
|
1319
|
|
|
1320 (defun br-ancestor-trees (class-list &optional depth offset)
|
|
|
1321 "Insert ancestor trees starting with classes from CLASS-LIST.
|
|
|
1322 Ancestor trees are not inverted, parents appear above children as in other
|
|
|
1323 browser listing windows. Indent each class in CLASS-LIST by optional DEPTH
|
|
|
1324 spaces (default is 0 in order to ensure proper initialization). Offset each
|
|
|
1325 child level by optional OFFSET spaces from its parent (which must be greater
|
|
|
1326 than zero, default 2)."
|
|
|
1327 (or offset (setq offset 2))
|
|
|
1328 (or depth (setq depth 0 br-tmp-depth 0))
|
|
|
1329 (if (= depth 0) (setq br-tmp-class-set nil))
|
|
|
1330 (let ((prev-expansion-str " ...")
|
|
|
1331 parents expand-subtree)
|
|
|
1332 (mapcar (function
|
|
|
1333 (lambda (class)
|
|
|
1334 (setq expand-subtree (br-set-cons br-tmp-class-set class)
|
|
|
1335 parents (if expand-subtree (br-get-parents class)))
|
|
|
1336 (if parents
|
|
|
1337 (progn (setq br-tmp-depth
|
|
|
1338 (max (+ depth offset) br-tmp-depth))
|
|
|
1339 (br-ancestor-trees
|
|
|
1340 parents (+ depth offset) offset)))
|
|
|
1341 (indent-to (- br-tmp-depth depth))
|
|
|
1342 (insert class)
|
|
|
1343 (and (not expand-subtree) (br-has-parents-p class)
|
|
|
1344 (insert prev-expansion-str))
|
|
|
1345 (insert "\n")
|
|
|
1346 (if br-ancestor-function
|
|
|
1347 (funcall br-ancestor-function
|
|
|
1348 class (not expand-subtree) (+ depth offset)))
|
|
|
1349 (if (= depth 0) (setq br-tmp-depth 0))))
|
|
|
1350 class-list))
|
|
|
1351 (if (= depth 0) (setq br-tmp-class-set nil)))
|
|
|
1352
|
|
|
1353 (defun br-browser-buffer-p (&optional buffer)
|
|
|
1354 "Returns t iff optional BUFFER or current buffer is an OO-Browser specific buffer."
|
|
|
1355 (equal 0 (string-match (concat br-buffer-prefix-inher
|
|
|
1356 "\\|" br-buffer-prefix-categ
|
|
|
1357 "\\|" br-buffer-prefix-blank
|
|
24
|
1358 "\\|" (regexp-quote br-buffer-prefix-info))
|
|
0
|
1359 (buffer-name buffer))))
|
|
|
1360
|
|
|
1361 (defun br-buffer-level ()
|
|
|
1362 "Returns current listing buffer level as a string."
|
|
|
1363 (let* ((name (buffer-name))
|
|
|
1364 (pos (string-match "-[p]*[0-9]+$" name)))
|
|
|
1365 (and pos (substring name (1+ pos)))))
|
|
|
1366
|
|
|
1367 (defun br-class-level ()
|
|
|
1368 "Returns current class hierarchy level as an integer.
|
|
|
1369 1 is the top level."
|
|
|
1370 (let* ((name (buffer-name))
|
|
|
1371 (pos (string-match "[0-9]" name)))
|
|
|
1372 (and pos (string-to-int (substring name pos)))))
|
|
|
1373
|
|
|
1374 (defun br-listing-window-num ()
|
|
|
1375 "Return listing window number, lefmost is 1, non-listing window = 0."
|
|
|
1376 (let ((wind (selected-window))
|
|
|
1377 (ctr 0))
|
|
|
1378 (br-to-view-window)
|
|
|
1379 (while (not (eq wind (selected-window)))
|
|
|
1380 (other-window 1)
|
|
|
1381 (setq ctr (1+ ctr)))
|
|
|
1382 ctr))
|
|
|
1383
|
|
|
1384 (defun br-cleanup ()
|
|
|
1385 "Cleanup and free browser Environment data structures."
|
|
|
1386 (setq br-lang-prefix nil
|
|
|
1387 br-sys-paths-htable nil
|
|
|
1388 br-lib-paths-htable nil
|
|
|
1389 br-paths-htable nil
|
|
|
1390 br-sys-parents-htable nil
|
|
|
1391 br-lib-parents-htable nil
|
|
|
1392 br-parents-htable nil
|
|
|
1393 br-children-htable nil
|
|
|
1394 br-lib-prev-search-dirs nil
|
|
|
1395 br-sys-prev-search-dirs nil
|
|
|
1396 ))
|
|
|
1397
|
|
|
1398 (defun br-clear ()
|
|
|
1399 "Re-initialize all browser listing buffer displays.
|
|
|
1400 Leave point in browser top-level class listing buffer."
|
|
|
1401 (let ((n (max 1 (/ (frame-width) br-min-width-window))))
|
|
|
1402 (br-to-view-window)
|
|
|
1403 (other-window 1)
|
|
|
1404 (br-next-buffer 1)
|
|
|
1405 (while (> n 1)
|
|
|
1406 (setq n (1- n))
|
|
|
1407 (br-next-buffer nil br-buffer-prefix-blank))
|
|
|
1408 (br-to-view-window)
|
|
|
1409 (other-window 1)))
|
|
|
1410
|
|
|
1411 (defun br-descendant-trees (class-list &optional indent offset)
|
|
|
1412 "Insert descendant trees starting with classes from CLASS-LIST.
|
|
|
1413 Indent each class in CLASS-LIST by optional INDENT spaces (default is 0 in
|
|
|
1414 order to ensure proper initialization). Offset each child level by optional
|
|
|
1415 OFFSET spaces from its parent (which must be greater than zero, default 2)."
|
|
|
1416 (or indent (setq indent 0))
|
|
|
1417 (or offset (setq offset 2))
|
|
|
1418 (if (= indent 0) (setq br-tmp-class-set nil))
|
|
|
1419 (let ((prev-expansion-str " ...")
|
|
|
1420 children expand-subtree)
|
|
|
1421 (mapcar (function
|
|
|
1422 (lambda (class)
|
|
|
1423 (setq expand-subtree (br-set-cons br-tmp-class-set class)
|
|
|
1424 children (if expand-subtree (br-get-children class)))
|
|
|
1425 (indent-to indent)
|
|
|
1426 (insert class)
|
|
|
1427 (and (not expand-subtree) (br-has-children-p class)
|
|
|
1428 (insert prev-expansion-str))
|
|
|
1429 (insert "\n")
|
|
|
1430 (if children
|
|
|
1431 (br-descendant-trees children (+ indent offset) offset))))
|
|
|
1432 class-list))
|
|
|
1433 (if (= indent 0) (setq br-tmp-class-set nil)))
|
|
|
1434
|
|
|
1435 (defun br-display-buffer (suffix)
|
|
|
1436 "Displays browser buffer ending in SUFFIX in current window."
|
|
|
1437 (let ((buf (get-buffer (concat br-buffer-prefix suffix))))
|
|
|
1438 (if buf (progn (set-window-buffer (selected-window) buf)))
|
|
|
1439 buf))
|
|
|
1440
|
|
|
1441 (defun br-do-in-view-window (form)
|
|
|
1442 "Evaluate FORM in viewer window and then return to current window."
|
|
|
1443 (interactive)
|
|
|
1444 (let ((wind (selected-window)))
|
|
|
1445 (unwind-protect
|
|
|
1446 (progn (br-to-view-window)
|
|
|
1447 (eval form))
|
|
|
1448 (select-window wind))))
|
|
|
1449
|
|
|
1450 (defun br-edit-ext-start (editor-cmd name file)
|
|
|
1451 "Start an external viewer given by EDITOR-CMD using NAME applied to FILE."
|
|
|
1452 ;; Conditionalized code is necessary because of silly (start-process) calling
|
|
|
1453 ;; protocol.
|
|
|
1454 (cond (br-ed9
|
|
|
1455 (start-process name name editor-cmd br-ed1 br-ed2 br-ed3 br-ed4
|
|
|
1456 br-ed5 br-ed6 br-ed7 br-ed8 br-ed9 file))
|
|
|
1457 (br-ed8
|
|
|
1458 (start-process name name editor-cmd br-ed1 br-ed2 br-ed3 br-ed4
|
|
|
1459 br-ed5 br-ed6 br-ed7 br-ed8 file))
|
|
|
1460 (br-ed7
|
|
|
1461 (start-process name name editor-cmd br-ed1 br-ed2 br-ed3 br-ed4
|
|
|
1462 br-ed5 br-ed6 br-ed7 file))
|
|
|
1463 (br-ed6
|
|
|
1464 (start-process name name editor-cmd br-ed1 br-ed2 br-ed3 br-ed4
|
|
|
1465 br-ed5 br-ed6 file))
|
|
|
1466 (br-ed5
|
|
|
1467 (start-process name name editor-cmd br-ed1 br-ed2 br-ed3 br-ed4
|
|
|
1468 br-ed5 file))
|
|
|
1469 (br-ed4
|
|
|
1470 (start-process name name editor-cmd br-ed1 br-ed2 br-ed3 br-ed4
|
|
|
1471 file))
|
|
|
1472 (br-ed3
|
|
|
1473 (start-process name name editor-cmd br-ed1 br-ed2 br-ed3 file))
|
|
|
1474 (br-ed2
|
|
|
1475 (start-process name name editor-cmd br-ed1 br-ed2 file))
|
|
|
1476 (br-ed1
|
|
|
1477 (start-process name name editor-cmd br-ed1 file))
|
|
|
1478 (t
|
|
|
1479 (start-process name name editor-cmd file))
|
|
|
1480 ))
|
|
|
1481
|
|
|
1482 (defun br-funcall-in-view-window (buffer function &optional no-erase)
|
|
|
1483 "Clear out BUFFER and display return value from invocation of FUNCTION in viewer window.
|
|
|
1484 Move point to beginning of buffer and then return to current window. BUFFER
|
|
|
1485 may be a buffer name.
|
|
|
1486 With optional NO-ERASE, buffer is not erased before function is called."
|
|
|
1487 (interactive)
|
|
|
1488 (let ((wind (selected-window)))
|
|
|
1489 (unwind-protect
|
|
|
1490 (progn (br-to-view-window)
|
|
|
1491 (set-window-buffer (selected-window) (get-buffer-create buffer))
|
|
|
1492 (let (buffer-read-only)
|
|
|
1493 (if no-erase
|
|
|
1494 (goto-char (point-min))
|
|
|
1495 (erase-buffer))
|
|
|
1496 (funcall function))
|
|
|
1497 (goto-char (point-min)))
|
|
|
1498 (select-window wind))))
|
|
|
1499
|
|
|
1500 (defun br-file-to-viewer (filename)
|
|
|
1501 "Display FILENAME from OO-Browser source directory in browser viewer window.
|
|
|
1502 FILENAME should not contain any path information."
|
|
|
1503 (br-funcall-in-view-window
|
|
24
|
1504 (concat br-buffer-prefix-info "Help*")
|
|
0
|
1505 (function (lambda ()
|
|
|
1506 (insert-file-contents (br-pathname filename))
|
|
|
1507 (set-buffer-modified-p nil)))))
|
|
|
1508
|
|
|
1509 (defun br-in-browser ()
|
|
|
1510 "Return selected frame if the OO-Browser is active in it, else return nil."
|
|
|
1511 (cond ((not (eq br-in-browser (selected-frame))) nil)
|
|
24
|
1512 ((or (one-window-p 'nomini)
|
|
|
1513 (and (fboundp 'window-list)
|
|
|
1514 (< (length (window-list)) 3)))
|
|
0
|
1515 (setq br-in-browser nil))
|
|
|
1516 (t br-in-browser)))
|
|
|
1517
|
|
|
1518
|
|
|
1519 (defun br-in-top-buffer-p ()
|
|
|
1520 "Return t if point is in the top class listing buffer, else nil."
|
|
|
1521 (string-equal (br-buffer-level) "1"))
|
|
|
1522
|
|
|
1523 (defun br-in-view-window-p ()
|
|
|
1524 "Is point in a viewer window?"
|
|
|
1525 (br-non-listing-window-p))
|
|
|
1526
|
|
|
1527 (defun br-init ()
|
|
|
1528 "Initialization common to all OO-Browser invocations."
|
|
|
1529 (br-feature-tags-init))
|
|
|
1530
|
|
|
1531 (defun br-insert-classes (class-list &optional indent)
|
|
|
1532 "Insert CLASS-LIST in current buffer indented INDENT columns."
|
|
|
1533 (mapcar (function
|
|
|
1534 (lambda (class-name)
|
|
|
1535 (and indent (indent-to indent))
|
|
|
1536 (and class-name (insert class-name "\n"))))
|
|
|
1537 class-list))
|
|
|
1538
|
|
|
1539 (defun br-interrupt (&optional arg)
|
|
|
1540 (if (null arg)
|
|
|
1541 (mapcar
|
|
|
1542 (function
|
|
|
1543 (lambda (buf)
|
|
|
1544 (set-buffer buf)
|
|
|
1545 (if (or (eq major-mode 'br-mode) (br-browser-buffer-p))
|
|
|
1546 (bury-buffer nil))))
|
|
|
1547 (buffer-list))
|
|
|
1548 (setq *br-save-wconfig* nil
|
|
|
1549 *br-prev-wconfig* nil
|
|
|
1550 *br-prev-listing-window* nil)
|
|
|
1551 (mapcar
|
|
|
1552 (function
|
|
|
1553 (lambda (buf)
|
|
|
1554 (set-buffer buf)
|
|
|
1555 (if (or (eq major-mode 'br-mode)
|
|
|
1556 (br-browser-buffer-p))
|
|
|
1557 (progn (br-feature-clear-signatures)
|
|
|
1558 (set-buffer-modified-p nil)
|
|
|
1559 (kill-buffer (current-buffer))))))
|
|
|
1560 (buffer-list))
|
|
|
1561 (br-cleanup))
|
|
|
1562 (setq br-in-browser nil))
|
|
|
1563
|
|
|
1564 (defun br-mode ()
|
|
|
1565 "The major mode used by OO-Browser listing windows.
|
|
|
1566 See the file \"br-help\" for browser usage information.
|
|
|
1567 It provides the following keys: \\{br-mode-map}"
|
|
|
1568 (interactive)
|
|
|
1569 (use-local-map br-mode-map)
|
|
|
1570 (setq major-mode 'br-mode)
|
|
|
1571 (setq mode-name "OO-Browse")
|
|
|
1572 (set-syntax-table text-mode-syntax-table)
|
|
|
1573 (setq local-abbrev-table text-mode-abbrev-table)
|
|
|
1574 (setq case-fold-search t)
|
|
|
1575 (setq buffer-read-only t)
|
|
|
1576 (run-hooks 'br-class-list-hook)
|
|
|
1577 (run-hooks 'br-mode-hook))
|
|
|
1578
|
|
|
1579 (defun br-narrow-to-class ()
|
|
|
1580 (cond ((= (point-min) (point-max)) nil)
|
|
|
1581 ((br-find-class-name)
|
|
|
1582 (narrow-to-region (match-beginning 0) (match-end 0)))
|
|
|
1583 (t (error
|
|
24
|
1584 "(OO-Browser): `br-narrow-to-class', current entry is not a class"))))
|
|
0
|
1585
|
|
|
1586 (defun br-narrow-to-feature ()
|
|
|
1587 "Narrow buffer to current feature entry."
|
|
|
1588 (if (br-feature-at-p)
|
|
|
1589 (narrow-to-region (match-beginning 0) (match-end 0))
|
|
|
1590 (error
|
|
24
|
1591 "(OO-Browser): `br-narrow-to-feature' no current feature.")))
|
|
0
|
1592
|
|
|
1593 (defun br-feature-at-p ()
|
|
|
1594 "Returns t iff point is on a feature listing line."
|
|
|
1595 (save-excursion
|
|
|
1596 (beginning-of-line)
|
|
|
1597 (looking-at (concat "[ \t]*" br-feature-entry))))
|
|
|
1598
|
|
|
1599 (defun br-next-buffer (&optional special alt-prefix)
|
|
|
1600 "Returns next sequential browser buffer or special one if optional SPECIAL is non-nil.
|
|
|
1601 Non-nil ALT-PREFIX is used as prefix in buffer name."
|
|
|
1602 (let* ((suffix (or special (1+ (or (br-class-level) 0))))
|
|
|
1603 (buf (get-buffer-create
|
|
|
1604 (concat (or alt-prefix br-buffer-prefix)
|
|
|
1605 (if (integerp suffix)
|
|
|
1606 (int-to-string suffix)
|
|
|
1607 suffix)))))
|
|
|
1608 (if buf (progn
|
|
|
1609 (or special (br-next-listing-window))
|
|
|
1610 (set-window-buffer (selected-window) buf)
|
|
|
1611 (let (buffer-read-only)
|
|
|
1612 (erase-buffer)
|
|
|
1613 (kill-all-local-variables)
|
|
|
1614 ;; Clear out any feature tags that may have been associated
|
|
|
1615 ;; with this buffer, so we don't mistakenly reference them.
|
|
|
1616 (br-feature-clear-signatures))
|
|
|
1617 (setq mode-line-format (list " %17b --" '(-3 . "%p") "-%-"))
|
|
|
1618 (br-mode)
|
|
|
1619 (br-set-mode-line)
|
|
|
1620 (set-buffer-modified-p nil)))
|
|
|
1621 buf))
|
|
|
1622
|
|
|
1623 (defun br-next-listing-window (&optional prev)
|
|
|
1624 "Move to next browser listing window (non-viewer window).
|
|
|
1625 Optional PREV means to previous window."
|
|
|
1626 (let ((owind (selected-window)))
|
|
|
1627 (while (progn (other-window (if prev -1 1))
|
|
|
1628 (if (br-non-listing-window-p)
|
|
|
1629 (not (eq (selected-window) owind)))))))
|
|
|
1630
|
|
|
1631 (defun br-pathname (filename)
|
|
|
1632 "Return full pathname for FILENAME in browser Elisp directory."
|
|
|
1633 (if br-directory
|
|
|
1634 (expand-file-name filename br-directory)
|
|
24
|
1635 (error "The `br-directory' variable must be set to a string value.")))
|
|
0
|
1636
|
|
|
1637 (defun br-protocol-entry-p ()
|
|
|
1638 "Return non-nil if point is within a protocol listing entry line."
|
|
|
1639 (and (string-equal br-lang-prefix "objc-")
|
|
|
1640 (save-excursion
|
|
|
1641 (beginning-of-line)
|
|
|
1642 (looking-at "[ \t]*@ <[^\>]*>"))))
|
|
|
1643
|
|
|
1644 (defun br-resize (min-width)
|
|
|
1645 "Resize browser listing windows to have MIN-WIDTH."
|
|
|
1646 (interactive)
|
|
|
1647 (let* ((window-min-width 3)
|
|
|
1648 (oldn (1- (length (br-window-list))))
|
|
|
1649 (n (max 1 (/ (frame-width) min-width)))
|
|
|
1650 (numw n)
|
|
|
1651 (diff (- numw oldn))
|
|
|
1652 (width (/ (frame-width) numw))
|
|
|
1653 (obuf (current-buffer)))
|
|
|
1654 (br-to-first-list-window)
|
|
|
1655 (cond ((= diff 0)
|
|
|
1656 (br-resize-windows numw width))
|
|
|
1657 ((> diff 0)
|
|
|
1658 (setq n oldn)
|
|
|
1659 (while (> n 1)
|
|
|
1660 (setq n (1- n))
|
|
|
1661 (shrink-window-horizontally (max 0 (- (window-width)
|
|
|
1662 min-width)))
|
|
|
1663 (br-next-listing-window))
|
|
|
1664 (setq n diff)
|
|
|
1665 (while (> n 0)
|
|
|
1666 (setq n (1- n))
|
|
|
1667 (split-window-horizontally (max window-min-width
|
|
|
1668 (- (window-width)
|
|
|
1669 min-width))))
|
|
|
1670 (setq n oldn)
|
|
|
1671 (while (< n numw)
|
|
|
1672 (setq n (1+ n))
|
|
|
1673 (br-next-listing-window)
|
|
|
1674 (br-next-buffer n br-buffer-prefix-blank))
|
|
|
1675 (br-to-first-list-window)
|
|
|
1676 (br-resize-windows numw width)
|
|
|
1677 )
|
|
|
1678 (t ;; (< diff 0)
|
|
|
1679 (while (> n 0)
|
|
|
1680 (setq n (1- n))
|
|
|
1681 (br-next-listing-window))
|
|
|
1682 (setq n (- diff))
|
|
|
1683 (while (> n 0)
|
|
|
1684 (setq n (1- n))
|
|
|
1685 (delete-window))
|
|
|
1686 (br-to-first-list-window)
|
|
|
1687 (br-resize-windows numw width)
|
|
|
1688 ))
|
|
|
1689 (setq br-min-width-window min-width)
|
|
|
1690 (let ((owind (get-buffer-window obuf)))
|
|
|
1691 (if owind
|
|
|
1692 (select-window owind)
|
|
|
1693 (br-to-view-window)
|
|
|
1694 (br-next-listing-window)))))
|
|
|
1695
|
|
|
1696 (defun br-resize-narrow ()
|
|
|
1697 "Resize listing windows so are narrower by 10 characters."
|
|
|
1698 (interactive)
|
|
|
1699 (if (<= window-min-width (- br-min-width-window 10))
|
|
|
1700 (br-resize (max window-min-width (- br-min-width-window 10)))
|
|
|
1701 (beep)))
|
|
|
1702
|
|
|
1703 (defun br-resize-widen ()
|
|
|
1704 "Resize listing windows so are wider by 10 characters."
|
|
|
1705 (interactive)
|
|
|
1706 (if (and (>= (frame-width) (+ br-min-width-window 10))
|
|
|
1707 (> (length (br-window-list)) 2))
|
|
|
1708 (br-resize (min (frame-width) (+ br-min-width-window 10)))
|
|
|
1709 (beep)))
|
|
|
1710
|
|
|
1711 (defun br-resize-windows (n width)
|
|
|
1712 (while (> n 1)
|
|
|
1713 (setq n (1- n))
|
|
|
1714 (shrink-window-horizontally (- (window-width) width))
|
|
|
1715 (br-next-listing-window)))
|
|
|
1716
|
|
|
1717 (defun br-set-mode-line ()
|
|
|
1718 "Set mode line string."
|
|
|
1719 (setq mode-line-buffer-identification (list (buffer-name)))
|
|
|
1720 (set-buffer-modified-p t))
|
|
|
1721
|
|
|
1722 (defun br-show-top-classes (func &optional uniq)
|
|
|
1723 "Display list of top level classes generated by calling FUNC.
|
|
|
1724 Optional UNIQ means sort and eliminate duplicates."
|
|
|
1725 (message "Ordering classes...")
|
|
|
1726 (let ((classes (funcall func)))
|
|
|
1727 (setq classes (br-class-list-filter classes))
|
|
|
1728 (br-clear)
|
|
|
1729 (let (buffer-read-only)
|
|
|
1730 (erase-buffer)
|
|
|
1731 (br-insert-classes classes)
|
|
|
1732 (if uniq
|
|
|
1733 (progn
|
|
|
1734 (if (stringp br-sort-options)
|
|
|
1735 (call-process-region (point-min) (point-max) "sort" t t nil
|
|
|
1736 br-sort-options)
|
|
|
1737 (call-process-region (point-min) (point-max) "sort" t t nil))
|
|
|
1738 (if (and (stringp br-sort-options)
|
|
|
1739 (string-match "u" br-sort-options))
|
|
|
1740 ;; Then sort made the list of elements unique, so do nothing.
|
|
|
1741 nil
|
|
|
1742 (call-process-region (point-min) (point-max) "uniq" t t))))))
|
|
|
1743 (goto-char (point-min))
|
|
|
1744 (message "Ordering classes...Done"))
|
|
|
1745
|
|
|
1746 (defun br-this-level-classes (&optional keep-indent)
|
|
|
1747 "Return list of the classes in the current listing.
|
|
|
1748 Optional KEEP-INDENT non-nil means keep indentation preceding class name."
|
|
|
1749 (let ((classes))
|
|
|
1750 (save-excursion
|
|
|
1751 (goto-char (point-min))
|
|
|
1752 (while (and (not (looking-at "^[ \t]*$"))
|
|
|
1753 (if (looking-at (format "^[ \t]*%s "
|
|
|
1754 br-feature-type-regexp)) ;; a feature
|
|
|
1755 t ;; skip this entry
|
|
|
1756 ;; assume is a class
|
|
|
1757 (setq classes (cons (br-find-class-name keep-indent)
|
|
|
1758 classes)))
|
|
|
1759 (= (forward-line 1) 0))))
|
|
|
1760 (nreverse (delq nil classes))))
|
|
|
1761
|
|
|
1762 (defun br-this-level-entries ()
|
|
|
1763 "Return list of all entries in the current listing."
|
|
|
1764 (let ((entries))
|
|
|
1765 (save-excursion
|
|
|
1766 (goto-char (point-min))
|
|
|
1767 (while (and (not (looking-at "^[ \t]*$"))
|
|
|
1768 (if (looking-at (format "^[ \t]*%s "
|
|
|
1769 br-feature-type-regexp)) ;; a feature
|
|
|
1770 (setq entries
|
|
|
1771 (cons (br-find-feature-entry) entries))
|
|
|
1772 ;; assume is a class
|
|
|
1773 (setq entries (cons (br-find-class-name) entries)))
|
|
|
1774 (= (forward-line 1) 0))))
|
|
|
1775 (nreverse (delq nil entries))))
|
|
|
1776
|
|
|
1777 (defun br-this-level-features ()
|
|
|
1778 "Return list of features in the current listing."
|
|
|
1779 (let ((feature-regexp (concat "[ \t]*" br-feature-entry))
|
|
|
1780 (features))
|
|
|
1781 (save-excursion
|
|
|
1782 (goto-char (point-min))
|
|
|
1783 (while (progn (if (looking-at feature-regexp)
|
|
|
1784 (setq features
|
|
|
1785 (cons (br-find-feature-entry) features)))
|
|
|
1786 (= (forward-line 1) 0))))
|
|
|
1787 (nreverse (delq nil features))))
|
|
|
1788
|
|
|
1789 (defun br-to-first-list-window ()
|
|
|
1790 (br-to-view-window)
|
|
|
1791 (br-next-listing-window))
|
|
|
1792
|
|
|
1793 (defun br-to-tree ()
|
|
|
1794 "If point is within ... move to inher/ancestry expansion for the current class."
|
|
|
1795 (if (save-excursion
|
|
|
1796 (skip-chars-backward ".")
|
|
|
1797 (looking-at "\\.\\.\\."))
|
|
|
1798 (progn (beginning-of-line)
|
|
|
1799 (let ((class-expr (concat "^[ \t]*"
|
|
|
1800 (br-find-class-name)
|
|
|
1801 "$")))
|
|
|
1802 (if (re-search-backward class-expr nil t)
|
|
|
1803 (progn (skip-chars-forward " \t")
|
|
|
1804 (recenter '(4))
|
|
|
1805 t))))))
|
|
|
1806
|
|
|
1807 (defun br-to-view-window ()
|
|
|
1808 "Move to viewer window."
|
|
|
1809 (if (br-in-view-window-p)
|
|
|
1810 nil
|
|
|
1811 (setq *br-prev-listing-window* (selected-window))
|
|
|
1812 (while (and (not (br-in-view-window-p))
|
|
|
1813 (progn (other-window 1)
|
|
|
1814 (not (eq (selected-window)
|
|
|
1815 *br-prev-listing-window*)))))))
|
|
|
1816
|
|
|
1817 (defun br-window-setup ()
|
|
|
1818 (and (fboundp 'modify-frame-parameters)
|
|
|
1819 (cdr (assq 'unsplittable (frame-parameters)))
|
|
|
1820 (modify-frame-parameters (selected-frame) '((unsplittable))))
|
|
|
1821 (delete-other-windows)
|
|
|
1822 ;; Set top of frame line in case it is not 0.
|
|
|
1823 (or (fboundp 'window-highest-p)
|
|
|
1824 (setq br-top-of-frame (nth 1 (window-edges))))
|
|
|
1825 (split-window-vertically nil)
|
|
|
1826 (let* ((n (max 1 (/ (frame-width) br-min-width-window)))
|
|
|
1827 (width (/ (frame-width) n)))
|
|
|
1828 (br-next-buffer 1)
|
|
|
1829 (while (> n 1)
|
|
|
1830 (setq n (1- n))
|
|
|
1831 (split-window-horizontally width)
|
|
|
1832 (br-next-buffer nil br-buffer-prefix-blank))))
|
|
|
1833
|
|
|
1834 (defun br-view-ext-start (viewer-cmd name file)
|
|
|
1835 "Start an external viewer given by VIEWER-CMD using NAME applied to FILE."
|
|
|
1836 ;; Conditionalized code is necessary because of silly (start-process) calling
|
|
|
1837 ;; protocol.
|
|
|
1838 (cond (br-vw9
|
|
|
1839 (start-process name name viewer-cmd br-vw1 br-vw2 br-vw3 br-vw4
|
|
|
1840 br-vw5 br-vw6 br-vw7 br-vw8 br-vw9 file))
|
|
|
1841 (br-vw8
|
|
|
1842 (start-process name name viewer-cmd br-vw1 br-vw2 br-vw3 br-vw4
|
|
|
1843 br-vw5 br-vw6 br-vw7 br-vw8 file))
|
|
|
1844 (br-vw7
|
|
|
1845 (start-process name name viewer-cmd br-vw1 br-vw2 br-vw3 br-vw4
|
|
|
1846 br-vw5 br-vw6 br-vw7 file))
|
|
|
1847 (br-vw6
|
|
|
1848 (start-process name name viewer-cmd br-vw1 br-vw2 br-vw3 br-vw4
|
|
|
1849 br-vw5 br-vw6 file))
|
|
|
1850 (br-vw5
|
|
|
1851 (start-process name name viewer-cmd br-vw1 br-vw2 br-vw3 br-vw4
|
|
|
1852 br-vw5 file))
|
|
|
1853 (br-vw4
|
|
|
1854 (start-process name name viewer-cmd br-vw1 br-vw2 br-vw3 br-vw4
|
|
|
1855 file))
|
|
|
1856 (br-vw3
|
|
|
1857 (start-process name name viewer-cmd br-vw1 br-vw2 br-vw3 file))
|
|
|
1858 (br-vw2
|
|
|
1859 (start-process name name viewer-cmd br-vw1 br-vw2 file))
|
|
|
1860 (br-vw1
|
|
|
1861 (start-process name name viewer-cmd br-vw1 file))
|
|
|
1862 (t
|
|
|
1863 (start-process name name viewer-cmd file))
|
|
|
1864 ))
|
|
|
1865
|
|
|
1866 ;;; ************************************************************************
|
|
|
1867 ;;; Private variables
|
|
|
1868 ;;; ************************************************************************
|
|
|
1869
|
|
|
1870 (defvar br-ancestor-function nil
|
|
|
1871 "If non-nil, a function of 3 arguments called after each ancestor class is inserted into an ancestry listing.
|
|
|
1872 First argument is the class just inserted, second argument is a flag
|
|
|
1873 indicating whether class has previously been displayed within the listing and
|
|
|
1874 third argument is the number of spaces to indent each feature entry for this
|
|
|
1875 class.")
|
|
|
1876
|
|
|
1877 (defvar br-top-of-frame 0
|
|
|
1878 "Frame line number of windows at top of the OO-Browser frame.")
|
|
|
1879
|
|
|
1880 (defvar br-ed-num 0)
|
|
|
1881 (defvar br-ed-name "extEd")
|
|
|
1882 (defvar br-vw-num 0)
|
|
|
1883 (defvar br-vw-name "extVw")
|
|
|
1884
|
|
|
1885 (defvar br-in-browser nil
|
|
|
1886 "Equal to the frame displaying the OO-Browser when in use, else nil.")
|
|
|
1887
|
|
|
1888 (defvar br-lib-search-dirs nil
|
|
|
1889 "List of directories below which OO source files and other library
|
|
|
1890 directories are found. A library is a stable group of OO classes. Do not
|
|
|
1891 set this variable directly. Each OO language library which invokes
|
|
24
|
1892 `br-browse' should set it.")
|
|
0
|
1893
|
|
|
1894 (defvar br-sys-search-dirs nil
|
|
|
1895 "List of directories below which OO source files and other system
|
|
|
1896 directories are found. A system is a group of OO classes that are likely to
|
|
|
1897 change. Do not set this variable directly. Each OO language library which
|
|
24
|
1898 invokes `br-browse' should set it.")
|
|
0
|
1899
|
|
|
1900 (defvar *br-level-hist* nil
|
|
|
1901 "Internal history of visited listing windows and buffers.")
|
|
|
1902
|
|
|
1903 (defvar *br-prev-listing-window* nil
|
|
|
1904 "Saves listing window used prior to viewer window entry.
|
|
|
1905 Allows return to previous listing window when done with the viewer.")
|
|
|
1906
|
|
|
1907 (defvar *br-prev-wconfig* nil
|
|
|
1908 "Saves window configuration prior to browser entry.")
|
|
|
1909
|
|
|
1910 (defvar *br-save-wconfig* nil
|
|
|
1911 "Saves window configuration between invocations of the browser.")
|
|
|
1912
|
|
|
1913 (defconst br-buffer-prefix-categ "Categ-Lvl-")
|
|
|
1914 (defconst br-buffer-prefix-inher "Inher-Lvl-")
|
|
|
1915 (defconst br-buffer-prefix-blank "Blank-")
|
|
24
|
1916 (defconst br-buffer-prefix-info "*OO-Browser ")
|
|
0
|
1917 (defvar br-buffer-prefix br-buffer-prefix-inher
|
|
|
1918 "Browser buffer name prefix.")
|
|
|
1919
|
|
|
1920
|
|
|
1921 (defvar br-mode-map nil
|
|
|
1922 "Keymap containing OO-Browser commands.")
|
|
|
1923 (if br-mode-map
|
|
|
1924 nil
|
|
|
1925 (setq br-mode-map (make-keymap))
|
|
|
1926 (suppress-keymap br-mode-map)
|
|
|
1927 (define-key br-mode-map "@" 'br-at)
|
|
|
1928 (define-key br-mode-map "1" 'br-view-full-frame)
|
|
|
1929 (define-key br-mode-map "\C-c^" 'br-add-class-file)
|
|
|
1930 (define-key br-mode-map "a" 'br-ancestors)
|
|
|
1931 (define-key br-mode-map "b" 'br-buffer-menu)
|
|
|
1932 (define-key br-mode-map "\C-c\C-b" 'br-report-bug)
|
|
|
1933 (define-key br-mode-map "c" 'br-children)
|
|
|
1934 (define-key br-mode-map "C" 'br-categories)
|
|
|
1935 (define-key br-mode-map "\M-c" 'br-class-stats)
|
|
|
1936 (define-key br-mode-map "\C-c\C-c" 'br-env-create)
|
|
|
1937 (define-key br-mode-map "d" 'br-descendants)
|
|
|
1938 (define-key br-mode-map "\C-c\C-d" 'br-delete)
|
|
24
|
1939 ;; {M-d} is used down below for `br-tree'
|
|
0
|
1940 (define-key br-mode-map "e" 'br-edit-entry)
|
|
|
1941 (define-key br-mode-map "\M-e" 'br-env-stats)
|
|
|
1942 (define-key br-mode-map "\C-c\C-e" 'br-env-rebuild)
|
|
|
1943 (define-key br-mode-map "f" 'br-features)
|
|
|
1944 (define-key br-mode-map "F" 'br-feature-signature)
|
|
24
|
1945 ;; {M-f} is used down below for `br-tree-features-toggle'
|
|
|
1946 ;; {M-g} is used down below for `br-tree-graph'
|
|
0
|
1947 (define-key br-mode-map "?" 'br-help)
|
|
|
1948 (define-key br-mode-map "h" 'br-help)
|
|
|
1949 (define-key br-mode-map "H" 'br-help-ms) ;; mouse help
|
|
|
1950 (define-key br-mode-map "i" 'br-entry-info)
|
|
|
1951 (define-key br-mode-map "I" 'br-implementors)
|
|
|
1952 (define-key br-mode-map "\C-c\C-k" 'br-kill)
|
|
24
|
1953 ;; {M-k} is used down below for `br-tree-kill'
|
|
0
|
1954 (define-key br-mode-map "l" 'br-lib-top-classes)
|
|
|
1955 (define-key br-mode-map "L" 'br-lib-rebuild)
|
|
|
1956 (define-key br-mode-map "\C-c\C-l" 'br-env-load)
|
|
|
1957 (define-key br-mode-map "m" 'br-match)
|
|
|
1958 (define-key br-mode-map "M" 'br-match-entries)
|
|
|
1959 ;; "\C-c\C-m" is reserved for future use.
|
|
|
1960 (define-key br-mode-map "\C-n" 'br-next-entry)
|
|
|
1961 (define-key br-mode-map "o" 'br-order)
|
|
|
1962 (define-key br-mode-map "p" 'br-parents)
|
|
|
1963 (define-key br-mode-map "P" 'br-protocols)
|
|
|
1964 (define-key br-mode-map "\C-p" 'br-prev-entry)
|
|
|
1965 (define-key br-mode-map "q" 'br-quit)
|
|
|
1966 ;; {r} does the same thing as {f} and is for backward compatibility
|
|
|
1967 ;; with prior OO-Browser releases. It may be rebound in the future, so
|
|
|
1968 ;; learn to use {f} instead.
|
|
|
1969 (define-key br-mode-map "r" 'br-features)
|
|
|
1970 (define-key br-mode-map "\C-c\C-r" 'br-refresh)
|
|
|
1971 (define-key br-mode-map "s" 'br-sys-top-classes)
|
|
|
1972 (define-key br-mode-map "S" 'br-sys-rebuild)
|
|
|
1973 (define-key br-mode-map "\C-c\C-s" 'br-env-save)
|
|
|
1974 (define-key br-mode-map "t" 'br-top-classes)
|
|
|
1975 (define-key br-mode-map "u" 'br-unique)
|
|
|
1976 (define-key br-mode-map "v" 'br-view-entry)
|
|
|
1977 (define-key br-mode-map "V" 'br-view-friend)
|
|
|
1978 (define-key br-mode-map "\C-c\C-v" 'br-to-from-viewer)
|
|
|
1979 (define-key br-mode-map "\C-c\C-w" 'br-write-buffer)
|
|
|
1980 (define-key br-mode-map "w" 'br-where)
|
|
|
1981 (define-key br-mode-map "x" 'br-exit-level)
|
|
|
1982 (define-key br-mode-map "\C-x-" 'br-resize-narrow)
|
|
|
1983 (define-key br-mode-map "\C-x+" 'br-resize-widen)
|
|
|
1984 (define-key br-mode-map "#" 'br-count)
|
|
|
1985 (define-key br-mode-map "\C-c#" 'br-version)
|
|
|
1986 (define-key br-mode-map " " 'br-viewer-scroll-up)
|
|
|
1987 (define-key br-mode-map "\177" 'br-viewer-scroll-down)
|
|
|
1988 ;;
|
|
|
1989 ;; Define graphical browser keys if a window system is available.
|
|
|
1990 (if hyperb:window-system
|
|
|
1991 (progn (require 'br-tree)
|
|
|
1992 (define-key br-mode-map "\M-d" 'br-tree)
|
|
|
1993 (define-key br-mode-map "\M-f" 'br-tree-features-toggle)
|
|
|
1994 (define-key br-mode-map "\M-g" 'br-tree-graph)
|
|
|
1995 (define-key br-mode-map "\M-k" 'br-tree-kill))))
|
|
|
1996
|
|
|
1997 (defvar br-tmp-class-set nil
|
|
|
1998 "Set of classes created for temporary use by br-*-trees functions.")
|
|
|
1999 (defvar br-tmp-depth 0
|
|
24
|
2000 "Temporary variable indicating inheritance depth of class in `br-ancestor-trees'.")
|
|
0
|
2001
|
|
|
2002 (provide 'br)
|
