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