28523
|
1 ;;; ebrowse.el --- Emacs C++ class browser & tags facility
|
|
2
|
64699
|
3 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
|
100908
|
4 ;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
|
64699
|
5 ;; Free Software Foundation Inc.
|
28523
|
6
|
|
7 ;; Author: Gerd Moellmann <gerd@gnu.org>
|
|
8 ;; Maintainer: FSF
|
|
9 ;; Keywords: C++ tags tools
|
|
10
|
|
11 ;; This file is part of GNU Emacs.
|
|
12
|
94673
|
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
28523
|
14 ;; it under the terms of the GNU General Public License as published by
|
94673
|
15 ;; the Free Software Foundation, either version 3 of the License, or
|
|
16 ;; (at your option) any later version.
|
28523
|
17
|
|
18 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
21 ;; GNU General Public License for more details.
|
|
22
|
|
23 ;; You should have received a copy of the GNU General Public License
|
94673
|
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
28523
|
25
|
|
26 ;;; Commentary:
|
|
27
|
|
28 ;; This package implements
|
|
29
|
|
30 ;; - A class browser for C++
|
|
31 ;; - A complete set of tags-like functions working on class trees
|
|
32 ;; - An electric buffer list showing class browser buffers only
|
|
33
|
47929
|
34 ;; Documentation is found in a separate Info file.
|
28523
|
35
|
|
36 ;;; Code:
|
|
37
|
|
38 (require 'easymenu)
|
|
39 (require 'view)
|
|
40 (require 'ebuff-menu)
|
|
41
|
|
42 (eval-when-compile
|
|
43 (require 'cl)
|
|
44 (require 'helper))
|
|
45
|
|
46
|
|
47 ;;; User-options
|
|
48
|
|
49 (defgroup ebrowse nil
|
|
50 "Settings for the C++ class browser."
|
|
51 :group 'tools)
|
|
52
|
|
53
|
|
54 (defcustom ebrowse-search-path nil
|
|
55 "*List of directories to search for source files in a class tree.
|
|
56 Elements should be directory names; nil as an element means to try
|
28816
|
57 to find source files relative to the location of the BROWSE file loaded."
|
28523
|
58 :group 'ebrowse
|
|
59 :type '(repeat (choice (const :tag "Default" nil)
|
|
60 (string :tag "Directory"))))
|
|
61
|
|
62
|
|
63 (defcustom ebrowse-view/find-hook nil
|
|
64 "*Hooks run after finding or viewing a member or class."
|
|
65 :group 'ebrowse
|
|
66 :type 'hook)
|
|
67
|
|
68
|
|
69 (defcustom ebrowse-not-found-hook nil
|
|
70 "*Hooks run when finding or viewing a member or class was not successful."
|
|
71 :group 'ebrowse
|
|
72 :type 'hook)
|
|
73
|
|
74
|
|
75 (defcustom ebrowse-electric-list-mode-hook nil
|
|
76 "*Hook called by `ebrowse-electric-position-mode'."
|
|
77 :group 'ebrowse
|
|
78 :type 'hook)
|
|
79
|
|
80
|
|
81 (defcustom ebrowse-max-positions 50
|
|
82 "*Number of markers saved on electric position stack."
|
|
83 :group 'ebrowse
|
|
84 :type 'integer)
|
|
85
|
|
86
|
|
87
|
|
88 (defgroup ebrowse-tree nil
|
|
89 "Settings for class tree buffers."
|
|
90 :group 'ebrowse)
|
|
91
|
|
92
|
|
93 (defcustom ebrowse-tree-mode-hook nil
|
|
94 "*Hook run in each new tree buffer."
|
|
95 :group 'ebrowse-tree
|
|
96 :type 'hook)
|
|
97
|
|
98
|
|
99 (defcustom ebrowse-tree-buffer-name "*Tree*"
|
|
100 "*The default name of class tree buffers."
|
|
101 :group 'ebrowse-tree
|
|
102 :type 'string)
|
|
103
|
|
104
|
|
105 (defcustom ebrowse--indentation 4
|
|
106 "*The amount by which subclasses are indented in the tree."
|
|
107 :group 'ebrowse-tree
|
|
108 :type 'integer)
|
|
109
|
|
110
|
|
111 (defcustom ebrowse-source-file-column 40
|
|
112 "*The column in which source file names are displayed in the tree."
|
|
113 :group 'ebrowse-tree
|
|
114 :type 'integer)
|
|
115
|
|
116
|
|
117 (defcustom ebrowse-tree-left-margin 2
|
|
118 "*Amount of space left at the left side of the tree display.
|
|
119 This space is used to display markers."
|
|
120 :group 'ebrowse-tree
|
|
121 :type 'integer)
|
|
122
|
|
123
|
|
124
|
|
125 (defgroup ebrowse-member nil
|
|
126 "Settings for member buffers."
|
|
127 :group 'ebrowse)
|
|
128
|
|
129
|
|
130 (defcustom ebrowse-default-declaration-column 25
|
|
131 "*The column in which member declarations are displayed in member buffers."
|
|
132 :group 'ebrowse-member
|
|
133 :type 'integer)
|
|
134
|
|
135
|
|
136 (defcustom ebrowse-default-column-width 25
|
|
137 "*The width of the columns in member buffers (short display form)."
|
|
138 :group 'ebrowse-member
|
|
139 :type 'integer)
|
|
140
|
|
141
|
|
142 (defcustom ebrowse-member-buffer-name "*Members*"
|
|
143 "*The name of the buffer for member display."
|
|
144 :group 'ebrowse-member
|
|
145 :type 'string)
|
|
146
|
|
147
|
|
148 (defcustom ebrowse-member-mode-hook nil
|
|
149 "*Run in each new member buffer."
|
|
150 :group 'ebrowse-member
|
|
151 :type 'hook)
|
|
152
|
|
153
|
|
154
|
|
155 (defgroup ebrowse-faces nil
|
|
156 "Faces used by Ebrowse."
|
|
157 :group 'ebrowse)
|
|
158
|
|
159
|
63448
|
160 (defface ebrowse-tree-mark
|
61394
31aa9a390538
* mh-customize.el (mh-speedbar-selected-folder-face): Special case
Dan Nicolaescu <dann@ics.uci.edu>
diff
changeset
|
161 '((((min-colors 88)) (:foreground "red1"))
|
31aa9a390538
* mh-customize.el (mh-speedbar-selected-folder-face): Special case
Dan Nicolaescu <dann@ics.uci.edu>
diff
changeset
|
162 (t (:foreground "red")))
|
28523
|
163 "*The face used for the mark character in the tree."
|
|
164 :group 'ebrowse-faces)
|
63448
|
165 ;; backward-compatibility alias
|
|
166 (put 'ebrowse-tree-mark-face 'face-alias 'ebrowse-tree-mark)
|
|
167
|
|
168
|
|
169 (defface ebrowse-root-class
|
61394
31aa9a390538
* mh-customize.el (mh-speedbar-selected-folder-face): Special case
Dan Nicolaescu <dann@ics.uci.edu>
diff
changeset
|
170 '((((min-colors 88)) (:weight bold :foreground "blue1"))
|
31aa9a390538
* mh-customize.el (mh-speedbar-selected-folder-face): Special case
Dan Nicolaescu <dann@ics.uci.edu>
diff
changeset
|
171 (t (:weight bold :foreground "blue")))
|
28523
|
172 "*The face used for root classes in the tree."
|
|
173 :group 'ebrowse-faces)
|
63448
|
174 ;; backward-compatibility alias
|
|
175 (put 'ebrowse-root-class-face 'face-alias 'ebrowse-root-class)
|
|
176
|
|
177
|
|
178 (defface ebrowse-file-name
|
28523
|
179 '((t (:italic t)))
|
|
180 "*The face for filenames displayed in the tree."
|
|
181 :group 'ebrowse-faces)
|
63448
|
182 ;; backward-compatibility alias
|
|
183 (put 'ebrowse-file-name-face 'face-alias 'ebrowse-file-name)
|
|
184
|
|
185
|
|
186 (defface ebrowse-default
|
28523
|
187 '((t nil))
|
|
188 "*Face for everything else in the tree not having other faces."
|
|
189 :group 'ebrowse-faces)
|
63448
|
190 ;; backward-compatibility alias
|
|
191 (put 'ebrowse-default-face 'face-alias 'ebrowse-default)
|
|
192
|
|
193
|
|
194 (defface ebrowse-member-attribute
|
61394
31aa9a390538
* mh-customize.el (mh-speedbar-selected-folder-face): Special case
Dan Nicolaescu <dann@ics.uci.edu>
diff
changeset
|
195 '((((min-colors 88)) (:foreground "red1"))
|
31aa9a390538
* mh-customize.el (mh-speedbar-selected-folder-face): Special case
Dan Nicolaescu <dann@ics.uci.edu>
diff
changeset
|
196 (t (:foreground "red")))
|
28523
|
197 "*Face used to display member attributes."
|
|
198 :group 'ebrowse-faces)
|
63448
|
199 ;; backward-compatibility alias
|
|
200 (put 'ebrowse-member-attribute-face 'face-alias 'ebrowse-member-attribute)
|
|
201
|
|
202
|
|
203 (defface ebrowse-member-class
|
28523
|
204 '((t (:foreground "purple")))
|
|
205 "*Face used to display the class title in member buffers."
|
|
206 :group 'ebrowse-faces)
|
63448
|
207 ;; backward-compatibility alias
|
|
208 (put 'ebrowse-member-class-face 'face-alias 'ebrowse-member-class)
|
|
209
|
|
210
|
|
211 (defface ebrowse-progress
|
61394
31aa9a390538
* mh-customize.el (mh-speedbar-selected-folder-face): Special case
Dan Nicolaescu <dann@ics.uci.edu>
diff
changeset
|
212 '((((min-colors 88)) (:background "blue1"))
|
31aa9a390538
* mh-customize.el (mh-speedbar-selected-folder-face): Special case
Dan Nicolaescu <dann@ics.uci.edu>
diff
changeset
|
213 (t (:background "blue")))
|
28523
|
214 "*Face for progress indicator."
|
|
215 :group 'ebrowse-faces)
|
63448
|
216 ;; backward-compatibility alias
|
|
217 (put 'ebrowse-progress-face 'face-alias 'ebrowse-progress)
|
28523
|
218
|
|
219
|
|
220
|
|
221 ;;; Utilities.
|
|
222
|
|
223 (defun ebrowse-some (predicate vector)
|
|
224 "Return true if PREDICATE is true of some element of VECTOR.
|
|
225 If so, return the value returned by PREDICATE."
|
|
226 (let ((length (length vector))
|
|
227 (i 0)
|
|
228 result)
|
|
229 (while (and (< i length) (not result))
|
|
230 (setq result (funcall predicate (aref vector i))
|
|
231 i (1+ i)))
|
|
232 result))
|
|
233
|
|
234
|
|
235 (defun ebrowse-every (predicate vector)
|
|
236 "Return true if PREDICATE is true of every element of VECTOR."
|
|
237 (let ((length (length vector))
|
|
238 (i 0)
|
|
239 (result t))
|
|
240 (while (and (< i length) result)
|
|
241 (setq result (funcall predicate (aref vector i))
|
|
242 i (1+ i)))
|
|
243 result))
|
|
244
|
|
245
|
|
246 (defun ebrowse-position (item list &optional test)
|
|
247 "Return the position of ITEM in LIST or nil if not found.
|
|
248 Compare items with `eq' or TEST if specified."
|
|
249 (let ((i 0) found)
|
|
250 (cond (test
|
|
251 (while list
|
|
252 (when (funcall test item (car list))
|
|
253 (setq found i list nil))
|
|
254 (setq list (cdr list) i (1+ i))))
|
|
255 (t
|
|
256 (while list
|
|
257 (when (eq item (car list))
|
|
258 (setq found i list nil))
|
|
259 (setq list (cdr list) i (1+ i)))))
|
|
260 found))
|
|
261
|
|
262
|
|
263 (defun ebrowse-delete-if-not (predicate list)
|
|
264 "Remove elements not satisfying PREDICATE from LIST and return the result.
|
|
265 This is a destructive operation."
|
|
266 (let (result)
|
|
267 (while list
|
|
268 (let ((next (cdr list)))
|
|
269 (when (funcall predicate (car list))
|
|
270 (setq result (nconc result list))
|
|
271 (setf (cdr list) nil))
|
|
272 (setq list next)))
|
|
273 result))
|
|
274
|
|
275
|
|
276 (defmacro ebrowse-output (&rest body)
|
|
277 "Eval BODY with a writable current buffer.
|
|
278 Preserve buffer's modified state."
|
49832
|
279 (let ((modified (make-symbol "--ebrowse-output--")))
|
28523
|
280 `(let (buffer-read-only (,modified (buffer-modified-p)))
|
|
281 (unwind-protect
|
|
282 (progn ,@body)
|
|
283 (set-buffer-modified-p ,modified)))))
|
|
284
|
|
285
|
|
286 (defmacro ebrowse-ignoring-completion-case (&rest body)
|
|
287 "Eval BODY with `completion-ignore-case' bound to t."
|
|
288 `(let ((completion-ignore-case t))
|
|
289 ,@body))
|
|
290
|
|
291
|
|
292 (defmacro ebrowse-save-selective (&rest body)
|
|
293 "Eval BODY with `selective-display' restored at the end."
|
|
294 (let ((var (make-symbol "var")))
|
|
295 `(let ((,var selective-display))
|
|
296 (unwind-protect
|
|
297 (progn ,@body)
|
|
298 (setq selective-display ,var)))))
|
|
299
|
|
300
|
|
301 (defmacro ebrowse-for-all-trees (spec &rest body)
|
|
302 "For all trees in SPEC, eval BODY."
|
|
303 (let ((var (make-symbol "var"))
|
|
304 (spec-var (car spec))
|
|
305 (array (cadr spec)))
|
|
306 `(loop for ,var being the symbols of ,array
|
|
307 as ,spec-var = (get ,var 'ebrowse-root) do
|
|
308 (when (vectorp ,spec-var)
|
|
309 ,@body))))
|
|
310
|
|
311 ;;; Set indentation for macros above.
|
|
312
|
|
313 (put 'ebrowse-output 'lisp-indent-hook 0)
|
|
314 (put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
|
|
315 (put 'ebrowse-save-selective 'lisp-indent-hook 0)
|
|
316 (put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
|
|
317
|
|
318
|
|
319 (defsubst ebrowse-set-face (start end face)
|
|
320 "Set face of a region START END to FACE."
|
|
321 (overlay-put (make-overlay start end) 'face face))
|
|
322
|
|
323
|
|
324 (defun ebrowse-completing-read-value (prompt table initial-input)
|
|
325 "Read a string in the minibuffer, with completion.
|
|
326 Case is ignored in completions.
|
|
327
|
|
328 PROMPT is a string to prompt with; normally it ends in a colon and a space.
|
|
329 TABLE is an alist whose elements' cars are strings, or an obarray.
|
|
330 TABLE can also be a function to do the completion itself.
|
|
331 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
|
|
332 If it is (STRING . POSITION), the initial input
|
|
333 is STRING, but point is placed POSITION characters into the string."
|
|
334 (ebrowse-ignoring-completion-case
|
|
335 (completing-read prompt table nil t initial-input)))
|
|
336
|
|
337
|
|
338 (defun ebrowse-value-in-buffer (sym buffer)
|
|
339 "Return the value of SYM in BUFFER."
|
|
340 (let ((old-buffer (current-buffer)))
|
|
341 (unwind-protect
|
|
342 (progn
|
|
343 (set-buffer buffer)
|
|
344 (symbol-value sym))
|
|
345 (set-buffer old-buffer))))
|
|
346
|
|
347
|
|
348 (defun ebrowse-rename-buffer (new-name)
|
|
349 "Rename current buffer to NEW-NAME.
|
|
350 If a buffer with name NEW-NAME already exists, delete it first."
|
|
351 (let ((old-buffer (get-buffer new-name)))
|
|
352 (unless (eq old-buffer (current-buffer))
|
|
353 (when old-buffer
|
|
354 (save-excursion (kill-buffer old-buffer)))
|
|
355 (rename-buffer new-name))))
|
|
356
|
|
357
|
|
358 (defun ebrowse-trim-string (string)
|
|
359 "Return a copy of STRING with leading white space removed.
|
|
360 Replace sequences of newlines with a single space."
|
|
361 (when (string-match "^[ \t\n\r]+" string)
|
|
362 (setq string (substring string (match-end 0))))
|
|
363 (loop while (string-match "[\n]+" string)
|
|
364 finally return string do
|
|
365 (setq string (replace-match " " nil t string))))
|
|
366
|
|
367
|
|
368 (defun ebrowse-width-of-drawable-area ()
|
|
369 "Return the width of the display area for the current buffer.
|
|
370 If buffer is displayed in a window, use that window's width,
|
|
371 otherwise use the current frame's width."
|
|
372 (let ((window (get-buffer-window (current-buffer))))
|
|
373 (if window
|
|
374 (window-width window)
|
|
375 (frame-width))))
|
|
376
|
|
377
|
|
378 ;;; Structure definitions
|
|
379
|
|
380 (defstruct (ebrowse-hs (:type vector) :named)
|
28816
|
381 "Header structure found at the head of BROWSE files."
|
28523
|
382 ;; A version string that is compared against the version number of
|
|
383 ;; the Lisp package when the file is loaded. This is done to
|
|
384 ;; detect file format changes.
|
|
385 version
|
28816
|
386 ;; Command line options used for producing the BROWSE file.
|
28523
|
387 command-line-options
|
|
388 ;; The following slot is currently not used. It's kept to keep
|
|
389 ;; the file format compatible.
|
|
390 unused
|
|
391 ;; A slot that is filled out after the tree is loaded. This slot is
|
|
392 ;; set to a hash table mapping members to lists of classes in which
|
|
393 ;; they are defined.
|
|
394 member-table)
|
|
395
|
47929
|
396
|
28523
|
397 (defstruct (ebrowse-ts (:type vector) :named)
|
|
398 "Tree structure.
|
47929
|
399 Following the header structure, a BROWSE file contains a number
|
28523
|
400 of `ebrowse-ts' structures, each one describing one root class of
|
|
401 the class hierarchy with all its subclasses."
|
|
402 ;; A `ebrowse-cs' structure describing the root class.
|
|
403 class
|
|
404 ;; A list of `ebrowse-ts' structures for all subclasses.
|
|
405 subclasses
|
|
406 ;; Lists of `ebrowse-ms' structures for each member in a group of
|
|
407 ;; members.
|
|
408 member-variables member-functions static-variables static-functions
|
|
409 friends types
|
|
410 ;; List of `ebrowse-ts' structures for base classes. This slot is
|
|
411 ;; filled at load time.
|
|
412 base-classes
|
|
413 ;; A marker slot used in the tree buffer (can be saved back to disk.
|
|
414 mark)
|
|
415
|
|
416
|
|
417 (defstruct (ebrowse-bs (:type vector) :named)
|
|
418 "Common sub-structure.
|
|
419 A common structure defining an occurrence of some name in the
|
|
420 source files."
|
|
421 ;; The class or member name as a string constant
|
|
422 name
|
|
423 ;; An optional string for the scope of nested classes or for
|
|
424 ;; namespaces.
|
|
425 scope
|
|
426 ;; Various flags describing properties of classes/members, e.g. is
|
|
427 ;; template, is const etc.
|
|
428 flags
|
|
429 ;; File in which the entity is found. If this is part of a
|
|
430 ;; `ebrowse-ms' member description structure, and FILE is nil, then
|
|
431 ;; search for the name in the SOURCE-FILE of the members class.
|
|
432 file
|
|
433 ;; Regular expression to search for. This slot can be a number in
|
|
434 ;; which case the number is the file position at which the regular
|
|
435 ;; expression is found in a separate regexp file (see the header
|
|
436 ;; structure). This slot can be nil in which case the regular
|
|
437 ;; expression will be generated from the class/member name.
|
|
438 pattern
|
|
439 ;; The buffer position at which the search for the class or member
|
|
440 ;; will start.
|
|
441 point)
|
|
442
|
|
443
|
|
444 (defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named)
|
|
445 "Class structure.
|
|
446 This is the structure stored in the CLASS slot of a `ebrowse-ts'
|
|
447 structure. It describes the location of the class declaration."
|
|
448 source-file)
|
|
449
|
|
450
|
|
451 (defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named)
|
|
452 "Member structure.
|
|
453 This is the structure describing a single member. The `ebrowse-ts'
|
|
454 structure contains various lists for the different types of
|
|
455 members."
|
|
456 ;; Public, protected, private
|
|
457 visibility
|
|
458 ;; The file in which the member's definition can be found.
|
|
459 definition-file
|
|
460 ;; Same as PATTERN above, but for the member definition.
|
|
461 definition-pattern
|
|
462 ;; Same as POINT above but for member definition.
|
|
463 definition-point)
|
|
464
|
|
465
|
|
466
|
|
467 ;;; Some macros to access the FLAGS slot of a MEMBER.
|
|
468
|
|
469 (defsubst ebrowse-member-bit-set-p (member bit)
|
|
470 "Value is non-nil if MEMBER's bit BIT is set."
|
|
471 (/= 0 (logand (ebrowse-bs-flags member) bit)))
|
|
472
|
|
473
|
|
474 (defsubst ebrowse-virtual-p (member)
|
|
475 "Value is non-nil if MEMBER is virtual."
|
|
476 (ebrowse-member-bit-set-p member 1))
|
|
477
|
|
478
|
|
479 (defsubst ebrowse-inline-p (member)
|
|
480 "Value is non-nil if MEMBER is inline."
|
|
481 (ebrowse-member-bit-set-p member 2))
|
|
482
|
|
483
|
|
484 (defsubst ebrowse-const-p (member)
|
|
485 "Value is non-nil if MEMBER is const."
|
|
486 (ebrowse-member-bit-set-p member 4))
|
|
487
|
|
488
|
|
489 (defsubst ebrowse-pure-virtual-p (member)
|
|
490 "Value is non-nil if MEMBER is a pure virtual function."
|
|
491 (ebrowse-member-bit-set-p member 8))
|
|
492
|
|
493
|
|
494 (defsubst ebrowse-mutable-p (member)
|
|
495 "Value is non-nil if MEMBER is mutable."
|
|
496 (ebrowse-member-bit-set-p member 16))
|
|
497
|
|
498
|
|
499 (defsubst ebrowse-template-p (member)
|
|
500 "Value is non-nil if MEMBER is a template."
|
|
501 (ebrowse-member-bit-set-p member 32))
|
|
502
|
|
503
|
|
504 (defsubst ebrowse-explicit-p (member)
|
|
505 "Value is non-nil if MEMBER is explicit."
|
|
506 (ebrowse-member-bit-set-p member 64))
|
|
507
|
|
508
|
|
509 (defsubst ebrowse-throw-list-p (member)
|
|
510 "Value is non-nil if MEMBER has a throw specification."
|
|
511 (ebrowse-member-bit-set-p member 128))
|
|
512
|
|
513
|
|
514 (defsubst ebrowse-extern-c-p (member)
|
|
515 "Value is non-nil if MEMBER.is `extern \"C\"'."
|
|
516 (ebrowse-member-bit-set-p member 256))
|
|
517
|
|
518
|
|
519 (defsubst ebrowse-define-p (member)
|
|
520 "Value is non-nil if MEMBER is a define."
|
|
521 (ebrowse-member-bit-set-p member 512))
|
|
522
|
|
523
|
|
524 (defconst ebrowse-version-string "ebrowse 5.0"
|
28816
|
525 "Version string expected in BROWSE files.")
|
28523
|
526
|
|
527
|
|
528 (defconst ebrowse-globals-name "*Globals*"
|
|
529 "The name used for the surrogate class.containing global entities.
|
|
530 This must be the same that `ebrowse' uses.")
|
|
531
|
|
532
|
|
533 (defvar ebrowse--last-regexp nil
|
|
534 "Last regular expression searched for in tree and member buffers.
|
41773
|
535 Each tree and member buffer maintains its own search history.")
|
28523
|
536 (make-variable-buffer-local 'ebrowse--last-regexp)
|
|
537
|
|
538
|
|
539 (defconst ebrowse-member-list-accessors
|
|
540 '(ebrowse-ts-member-variables
|
|
541 ebrowse-ts-member-functions
|
|
542 ebrowse-ts-static-variables
|
|
543 ebrowse-ts-static-functions
|
|
544 ebrowse-ts-friends
|
|
545 ebrowse-ts-types)
|
|
546 "List of accessors for member lists.
|
|
547 Each element is the symbol of an accessor function.
|
|
548 The nth element must be the accessor for the nth member list
|
|
549 in an `ebrowse-ts' structure.")
|
|
550
|
|
551
|
|
552 ;;; FIXME: Add more doc strings for the buffer-local variables below.
|
|
553
|
|
554 (defvar ebrowse--tree-obarray nil
|
|
555 "Obarray holding all `ebrowse-ts' structures of a class tree.
|
|
556 Buffer-local in Ebrowse buffers.")
|
|
557
|
|
558
|
|
559 (defvar ebrowse--tags-file-name nil
|
28816
|
560 "File from which BROWSE file was loaded.
|
28523
|
561 Buffer-local in Ebrowse buffers.")
|
|
562
|
|
563
|
|
564 (defvar ebrowse--header nil
|
|
565 "Header structure of type `ebrowse-hs' of a class tree.
|
|
566 Buffer-local in Ebrowse buffers.")
|
|
567
|
|
568
|
|
569 (defvar ebrowse--frozen-flag nil
|
|
570 "Non-nil means an Ebrowse buffer won't be reused.
|
|
571 Buffer-local in Ebrowse buffers.")
|
47929
|
572
|
28523
|
573
|
|
574 (defvar ebrowse--show-file-names-flag nil
|
|
575 "Non-nil means show file names in a tree buffer.
|
|
576 Buffer-local in Ebrowse tree buffers.")
|
|
577
|
|
578
|
|
579 (defvar ebrowse--long-display-flag nil
|
|
580 "Non-nil means show members in long display form.
|
|
581 Buffer-local in Ebrowse member buffers.")
|
|
582
|
|
583
|
|
584 (defvar ebrowse--n-columns nil
|
|
585 "Number of columns to display for short member display form.
|
|
586 Buffer-local in Ebrowse member buffers.")
|
|
587
|
|
588
|
|
589 (defvar ebrowse--column-width nil
|
|
590 "Width of a columns to display for short member display form.
|
|
591 Buffer-local in Ebrowse member buffers.")
|
|
592
|
47929
|
593
|
28523
|
594 (defvar ebrowse--virtual-display-flag nil
|
|
595 "Non-nil means display virtual members in a member buffer.
|
|
596 Buffer-local in Ebrowse member buffers.")
|
|
597
|
|
598
|
|
599 (defvar ebrowse--inline-display-flag nil
|
|
600 "Non-nil means display inline members in a member buffer.
|
|
601 Buffer-local in Ebrowse member buffers.")
|
|
602
|
|
603
|
|
604 (defvar ebrowse--const-display-flag nil
|
|
605 "Non-nil means display const members in a member buffer.
|
|
606 Buffer-local in Ebrowse member buffers.")
|
|
607
|
|
608
|
|
609 (defvar ebrowse--pure-display-flag nil
|
|
610 "Non-nil means display pure virtual members in a member buffer.
|
|
611 Buffer-local in Ebrowse member buffers.")
|
|
612
|
|
613
|
|
614 (defvar ebrowse--filters nil
|
|
615 "Filter for display of public, protected, and private members.
|
|
616 This is a vector of three elements. An element nil means the
|
|
617 corresponding members are not shown.
|
|
618 Buffer-local in Ebrowse member buffers.")
|
|
619
|
|
620
|
|
621 (defvar ebrowse--show-inherited-flag nil
|
|
622 "Non-nil means display inherited members in a member buffer.
|
|
623 Buffer-local in Ebrowse member buffers.")
|
|
624
|
|
625
|
|
626 (defvar ebrowse--attributes-flag nil
|
|
627 "Non-nil means display member attributes in a member buffer.
|
|
628 Buffer-local in Ebrowse member buffers.")
|
|
629
|
|
630
|
|
631 (defvar ebrowse--source-regexp-flag nil
|
|
632 "Non-nil means display member regexps in a member buffer.
|
|
633 Buffer-local in Ebrowse member buffers.")
|
|
634
|
|
635
|
|
636 (defvar ebrowse--displayed-class nil
|
|
637 "Class displayed in a member buffer, a `ebrowse-ts' structure.
|
|
638 Buffer-local in Ebrowse member buffers.")
|
|
639
|
|
640
|
|
641 (defvar ebrowse--accessor nil
|
|
642 "Member list displayed in a member buffer.
|
|
643 This is a symbol whose function definition is an accessor for the
|
|
644 member list in `ebrowse-cs' structures.
|
|
645 Buffer-local in Ebrowse member buffers.")
|
|
646
|
|
647
|
|
648 (defvar ebrowse--member-list nil
|
|
649 "The list of `ebrowse-ms' structures displayed in a member buffer.
|
|
650 Buffer-local in Ebrowse member buffers.")
|
|
651
|
|
652
|
|
653 (defvar ebrowse--decl-column nil
|
|
654 "Column in which declarations are displayed in member buffers.
|
|
655 Buffer-local in Ebrowse member buffers.")
|
|
656
|
|
657
|
|
658 (defvar ebrowse--frame-configuration nil
|
|
659 "Frame configuration saved when viewing a class/member in another frame.
|
|
660 Buffer-local in Ebrowse buffers.")
|
|
661
|
|
662
|
|
663 (defvar ebrowse--view-exit-action nil
|
|
664 "Action to perform after viewing a class/member.
|
|
665 Either `kill-buffer' or nil.
|
|
666 Buffer-local in Ebrowse buffers.")
|
|
667
|
|
668
|
|
669 (defvar ebrowse--tree nil
|
|
670 "Class tree.
|
|
671 Buffer-local in Ebrowse buffers.")
|
|
672
|
|
673
|
|
674 ;;; Temporaries used to communicate with `ebrowse-find-pattern'.
|
|
675
|
|
676 (defvar ebrowse-temp-position-to-view nil)
|
|
677 (defvar ebrowse-temp-info-to-view nil)
|
|
678
|
|
679
|
|
680 (defvar ebrowse-tree-mode-map ()
|
|
681 "The keymap used in tree mode buffers.")
|
|
682
|
|
683
|
|
684 (defvar ebrowse--member-mode-strings nil
|
|
685 "Strings displayed in the mode line of member buffers.")
|
|
686
|
|
687
|
|
688 (defvar ebrowse-member-mode-map ()
|
|
689 "The keymap used in the member buffers.")
|
|
690
|
|
691
|
|
692 ;;; Define mode line titles for each member list.
|
|
693
|
|
694 (put 'ebrowse-ts-member-variables 'ebrowse-title "Member Variables")
|
|
695 (put 'ebrowse-ts-member-functions 'ebrowse-title "Member Functions")
|
|
696 (put 'ebrowse-ts-static-variables 'ebrowse-title "Static Variables")
|
|
697 (put 'ebrowse-ts-static-functions 'ebrowse-title "Static Functions")
|
|
698 (put 'ebrowse-ts-friends 'ebrowse-title "Friends")
|
|
699 (put 'ebrowse-ts-types 'ebrowse-title "Types")
|
|
700
|
|
701 (put 'ebrowse-ts-member-variables 'ebrowse-global-title "Global Variables")
|
|
702 (put 'ebrowse-ts-member-functions 'ebrowse-global-title "Global Functions")
|
|
703 (put 'ebrowse-ts-static-variables 'ebrowse-global-title "Static Variables")
|
|
704 (put 'ebrowse-ts-static-functions 'ebrowse-global-title "Static Functions")
|
|
705 (put 'ebrowse-ts-friends 'ebrowse-global-title "Defines")
|
|
706 (put 'ebrowse-ts-types 'ebrowse-global-title "Types")
|
|
707
|
|
708
|
|
709
|
|
710 ;;; Operations on `ebrowse-ts' structures
|
|
711
|
|
712 (defun ebrowse-files-table (&optional marked-only)
|
|
713 "Return an obarray containing all files mentioned in the current tree.
|
|
714 The tree is expected in the buffer-local variable `ebrowse--tree-obarray'.
|
|
715 MARKED-ONLY non-nil means include marked classes only."
|
|
716 (let ((files (make-hash-table :test 'equal))
|
|
717 (i -1))
|
|
718 (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
|
|
719 (when (or (not marked-only) (ebrowse-ts-mark tree))
|
|
720 (let ((class (ebrowse-ts-class tree)))
|
|
721 (when (zerop (% (incf i) 20))
|
|
722 (ebrowse-show-progress "Preparing file list" (zerop i)))
|
|
723 ;; Add files mentioned in class description
|
|
724 (let ((source-file (ebrowse-cs-source-file class))
|
|
725 (file (ebrowse-cs-file class)))
|
|
726 (when source-file
|
|
727 (puthash source-file source-file files))
|
|
728 (when file
|
|
729 (puthash file file files))
|
|
730 ;; For all member lists in this class
|
|
731 (loop for accessor in ebrowse-member-list-accessors do
|
|
732 (loop for m in (funcall accessor tree)
|
|
733 for file = (ebrowse-ms-file m)
|
|
734 for def-file = (ebrowse-ms-definition-file m) do
|
|
735 (when file
|
|
736 (puthash file file files))
|
|
737 (when def-file
|
|
738 (puthash def-file def-file files))))))))
|
|
739 files))
|
|
740
|
|
741
|
|
742 (defun ebrowse-files-list (&optional marked-only)
|
|
743 "Return a list containing all files mentioned in a tree.
|
|
744 MARKED-ONLY non-nil means include marked classes only."
|
|
745 (let (list)
|
|
746 (maphash #'(lambda (file dummy) (setq list (cons file list)))
|
|
747 (ebrowse-files-table marked-only))
|
|
748 list))
|
|
749
|
|
750
|
|
751 (defun* ebrowse-marked-classes-p ()
|
|
752 "Value is non-nil if any class in the current class tree is marked."
|
|
753 (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
|
|
754 (when (ebrowse-ts-mark tree)
|
|
755 (return-from ebrowse-marked-classes-p tree))))
|
|
756
|
|
757
|
|
758 (defsubst ebrowse-globals-tree-p (tree)
|
|
759 "Return t if TREE is the one for global entities."
|
|
760 (string= (ebrowse-bs-name (ebrowse-ts-class tree))
|
|
761 ebrowse-globals-name))
|
|
762
|
|
763
|
|
764 (defsubst ebrowse-qualified-class-name (class)
|
|
765 "Return the name of CLASS with scope prepended, if any."
|
|
766 (if (ebrowse-cs-scope class)
|
|
767 (concat (ebrowse-cs-scope class) "::" (ebrowse-cs-name class))
|
|
768 (ebrowse-cs-name class)))
|
|
769
|
|
770
|
|
771 (defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p)
|
|
772 "Return an alist describing all classes in a tree.
|
|
773 Each elements in the list has the form (CLASS-NAME . TREE).
|
|
774 CLASS-NAME is the name of the class. TREE is the
|
|
775 class tree whose root is QUALIFIED-CLASS-NAME.
|
|
776 QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME.
|
|
777 The class tree is found in the buffer-local variable `ebrowse--tree-obarray'."
|
|
778 (let (alist)
|
|
779 (if qualified-names-p
|
|
780 (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
|
|
781 (setq alist
|
|
782 (acons (ebrowse-qualified-class-name (ebrowse-ts-class tree))
|
|
783 tree alist)))
|
|
784 (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
|
|
785 (setq alist
|
|
786 (acons (ebrowse-cs-name (ebrowse-ts-class tree))
|
|
787 tree alist))))
|
|
788 alist))
|
|
789
|
|
790
|
|
791 (defun ebrowse-sort-tree-list (list)
|
|
792 "Sort a LIST of `ebrowse-ts' structures by qualified class names."
|
|
793 (sort list
|
|
794 #'(lambda (a b)
|
|
795 (string< (ebrowse-qualified-class-name (ebrowse-ts-class a))
|
|
796 (ebrowse-qualified-class-name (ebrowse-ts-class b))))))
|
|
797
|
|
798
|
|
799 (defun ebrowse-class-in-tree (class tree)
|
|
800 "Search for a class with name CLASS in TREE.
|
59550
|
801 If CLASS is found, return the tail of TREE starting at CLASS. This function
|
|
802 is used during the load phase where classes appended to a file replace older
|
|
803 class information."
|
28523
|
804 (let ((tclass (ebrowse-ts-class class))
|
|
805 found)
|
|
806 (while (and tree (not found))
|
59550
|
807 (let ((root-ptr tree))
|
|
808 (when (string= (ebrowse-qualified-class-name (ebrowse-ts-class (car root-ptr)))
|
28523
|
809 (ebrowse-qualified-class-name tclass))
|
59550
|
810 (setq found root-ptr))
|
28523
|
811 (setq tree (cdr tree))))
|
|
812 found))
|
|
813
|
|
814
|
|
815 (defun ebrowse-base-classes (tree)
|
|
816 "Return list of base-classes of TREE by searching subclass lists.
|
47929
|
817 This function must be used instead of the struct slot
|
28523
|
818 `base-classes' to access the base-class list directly because it
|
|
819 computes this information lazily."
|
|
820 (or (ebrowse-ts-base-classes tree)
|
|
821 (setf (ebrowse-ts-base-classes tree)
|
|
822 (loop with to-search = (list tree)
|
|
823 with result = nil
|
|
824 as search = (pop to-search)
|
|
825 while search finally return result
|
|
826 do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
|
|
827 (when (memq search (ebrowse-ts-subclasses ti))
|
|
828 (unless (memq ti result)
|
|
829 (setq result (nconc result (list ti))))
|
|
830 (push ti to-search)))))))
|
|
831
|
|
832
|
|
833 (defun ebrowse-direct-base-classes (tree)
|
|
834 "Return the list of direct super classes of TREE."
|
|
835 (let (result)
|
|
836 (dolist (s (ebrowse-base-classes tree))
|
|
837 (when (memq tree (ebrowse-ts-subclasses s))
|
|
838 (setq result (cons s result))))
|
|
839 result))
|
|
840
|
|
841
|
|
842
|
|
843 ;;; Operations on MEMBER structures/lists
|
|
844
|
|
845 (defun ebrowse-name/accessor-alist (tree accessor)
|
|
846 "Return an alist containing all members of TREE in group ACCESSOR.
|
|
847 ACCESSOR is the accessor function for the member list.
|
|
848 Elements of the result have the form (NAME . ACCESSOR), where NAME
|
|
849 is the member name."
|
|
850 (loop for member in (funcall accessor tree)
|
|
851 collect (cons (ebrowse-ms-name member) accessor)))
|
|
852
|
|
853
|
|
854 (defun ebrowse-name/accessor-alist-for-visible-members ()
|
|
855 "Return an alist describing all members visible in the current buffer.
|
|
856 Each element of the list has the form (MEMBER-NAME . ACCESSOR),
|
|
857 where MEMBER-NAME is the member's name, and ACCESSOR is the struct
|
|
858 accessor with which the member's list can be accessed in an `ebrowse-ts'
|
|
859 structure. The list includes inherited members if these are visible."
|
|
860 (let* ((list (ebrowse-name/accessor-alist ebrowse--displayed-class
|
|
861 ebrowse--accessor)))
|
|
862 (if ebrowse--show-inherited-flag
|
|
863 (nconc list
|
|
864 (loop for tree in (ebrowse-base-classes
|
|
865 ebrowse--displayed-class)
|
|
866 nconc (ebrowse-name/accessor-alist
|
|
867 tree ebrowse--accessor)))
|
|
868 list)))
|
|
869
|
|
870
|
|
871 (defun ebrowse-name/accessor-alist-for-class-members ()
|
|
872 "Like `ebrowse-name/accessor-alist-for-visible-members'.
|
|
873 This function includes members of base classes if base class members
|
|
874 are visible in the buffer."
|
|
875 (let (list)
|
|
876 (dolist (func ebrowse-member-list-accessors list)
|
|
877 (setq list (nconc list (ebrowse-name/accessor-alist
|
|
878 ebrowse--displayed-class func)))
|
|
879 (when ebrowse--show-inherited-flag
|
|
880 (dolist (class (ebrowse-base-classes ebrowse--displayed-class))
|
|
881 (setq list
|
|
882 (nconc list (ebrowse-name/accessor-alist class func))))))))
|
|
883
|
|
884
|
|
885 ;;; Progress indication
|
|
886
|
|
887 (defvar ebrowse-n-boxes 0)
|
|
888 (defconst ebrowse-max-boxes 60)
|
|
889
|
|
890 (defun ebrowse-show-progress (title &optional start)
|
|
891 "Display a progress indicator.
|
|
892 TITLE is the title of the progress message. START non-nil means
|
|
893 this is the first progress message displayed."
|
|
894 (let (message-log-max)
|
|
895 (when start (setq ebrowse-n-boxes 0))
|
|
896 (setq ebrowse-n-boxes (mod (1+ ebrowse-n-boxes) ebrowse-max-boxes))
|
87170
|
897 (message "%s: %s" title
|
|
898 (propertize (make-string ebrowse-n-boxes
|
|
899 (if (display-color-p) ?\ ?+))
|
|
900 'face 'ebrowse-progress))))
|
28523
|
901
|
|
902
|
|
903 ;;; Reading a tree from disk
|
|
904
|
|
905 (defun ebrowse-read ()
|
47929
|
906 "Read `ebrowse-hs' and `ebrowse-ts' structures in the current buffer.
|
28523
|
907 Return a list (HEADER TREE) where HEADER is the file header read
|
|
908 and TREE is a list of `ebrowse-ts' structures forming the class tree."
|
|
909 (let ((header (condition-case nil
|
|
910 (read (current-buffer))
|
|
911 (error (error "No Ebrowse file header found"))))
|
|
912 tree)
|
|
913 ;; Check file format.
|
|
914 (unless (ebrowse-hs-p header)
|
|
915 (error "No Ebrowse file header found"))
|
|
916 (unless (string= (ebrowse-hs-version header) ebrowse-version-string)
|
|
917 (error "File has wrong version `%s' (`%s' expected)"
|
|
918 (ebrowse-hs-version header) ebrowse-version-string))
|
|
919 ;; Read Lisp objects. Temporarily increase `gc-cons-threshold' to
|
|
920 ;; prevent a GC that would not free any memory.
|
|
921 (let ((gc-cons-threshold 2000000))
|
28541
|
922 (while (not (progn (skip-chars-forward " \t\n\r") (eobp)))
|
28523
|
923 (let* ((root (read (current-buffer)))
|
59550
|
924 (old-root-ptr (ebrowse-class-in-tree root tree)))
|
28523
|
925 (ebrowse-show-progress "Reading data" (null tree))
|
59550
|
926 (if old-root-ptr
|
|
927 (setcar old-root-ptr root)
|
28523
|
928 (push root tree)))))
|
|
929 (garbage-collect)
|
|
930 (list header tree)))
|
|
931
|
|
932
|
|
933 (defun ebrowse-revert-tree-buffer-from-file (ignore-auto-save noconfirm)
|
|
934 "Function installed as `revert-buffer-function' in tree buffers.
|
|
935 See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and
|
|
936 NOCONFIRM."
|
28541
|
937 (when (or noconfirm (yes-or-no-p "Revert tree from disk? "))
|
|
938 (loop for member-buffer in (ebrowse-same-tree-member-buffer-list)
|
|
939 do (kill-buffer member-buffer))
|
|
940 (erase-buffer)
|
63947
|
941 (with-no-warnings
|
|
942 (insert-file (or buffer-file-name ebrowse--tags-file-name)))
|
28541
|
943 (ebrowse-tree-mode)
|
|
944 (current-buffer)))
|
|
945
|
47929
|
946
|
28541
|
947 (defun ebrowse-create-tree-buffer (tree tags-file header obarray pop)
|
28523
|
948 "Create a new tree buffer for tree TREE.
|
|
949 The tree was loaded from file TAGS-FILE.
|
|
950 HEADER is the header structure of the file.
|
|
951 OBARRAY is an obarray with a symbol for each class in the tree.
|
|
952 POP non-nil means popup the buffer up at the end.
|
|
953 Return the buffer created."
|
28541
|
954 (let ((name ebrowse-tree-buffer-name))
|
|
955 (set-buffer (get-buffer-create name))
|
28523
|
956 (ebrowse-tree-mode)
|
28541
|
957 (setq ebrowse--tree tree
|
28523
|
958 ebrowse--tags-file-name tags-file
|
28541
|
959 ebrowse--tree-obarray obarray
|
|
960 ebrowse--header header
|
|
961 ebrowse--frozen-flag nil)
|
28523
|
962 (ebrowse-redraw-tree)
|
|
963 (set-buffer-modified-p nil)
|
28541
|
964 (case pop
|
|
965 (switch (switch-to-buffer name))
|
|
966 (pop (pop-to-buffer name)))
|
28523
|
967 (current-buffer)))
|
|
968
|
|
969
|
|
970
|
|
971 ;;; Operations for member obarrays
|
|
972
|
|
973 (defun ebrowse-fill-member-table ()
|
|
974 "Return an obarray holding all members of all classes in the current tree.
|
|
975
|
|
976 For each member, a symbol is added to the obarray. Members are
|
|
977 extracted from the buffer-local tree `ebrowse--tree-obarray'.
|
|
978
|
|
979 Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST
|
|
980 MEMBER) where TREE is the tree in which the member is defined,
|
|
981 MEMBER-LIST is a symbol describing the member list in which the member
|
|
982 is found, and MEMBER is a MEMBER structure describing the member.
|
|
983
|
|
984 The slot `member-table' of the buffer-local header structure of
|
|
985 type `ebrowse-hs' is set to the resulting obarray."
|
|
986 (let ((members (make-hash-table :test 'equal))
|
|
987 (i -1))
|
|
988 (setf (ebrowse-hs-member-table ebrowse--header) nil)
|
|
989 (garbage-collect)
|
|
990 ;; For all classes...
|
|
991 (ebrowse-for-all-trees (c ebrowse--tree-obarray)
|
|
992 (when (zerop (% (incf i) 10))
|
|
993 (ebrowse-show-progress "Preparing member lookup" (zerop i)))
|
|
994 (loop for f in ebrowse-member-list-accessors do
|
|
995 (loop for m in (funcall f c) do
|
|
996 (let* ((member-name (ebrowse-ms-name m))
|
|
997 (value (gethash member-name members)))
|
|
998 (push (list c f m) value)
|
|
999 (puthash member-name value members)))))
|
|
1000 (setf (ebrowse-hs-member-table ebrowse--header) members)))
|
|
1001
|
|
1002
|
|
1003 (defun ebrowse-member-table (header)
|
77953
|
1004 "Return the member obarray. Build it if it hasn't been set up yet.
|
28523
|
1005 HEADER is the tree header structure of the class tree."
|
|
1006 (when (null (ebrowse-hs-member-table header))
|
|
1007 (loop for buffer in (ebrowse-browser-buffer-list)
|
|
1008 until (eq header (ebrowse-value-in-buffer 'ebrowse--header buffer))
|
|
1009 finally do
|
|
1010 (save-excursion
|
|
1011 (set-buffer buffer)
|
|
1012 (ebrowse-fill-member-table))))
|
|
1013 (ebrowse-hs-member-table header))
|
|
1014
|
|
1015
|
|
1016
|
|
1017 ;;; Operations on TREE obarrays
|
|
1018
|
|
1019 (defun ebrowse-build-tree-obarray (tree)
|
|
1020 "Make sure every class in TREE is represented by a unique object.
|
|
1021 Build obarray of all classes in TREE."
|
|
1022 (let ((classes (make-vector 127 0)))
|
|
1023 ;; Add root classes...
|
|
1024 (loop for root in tree
|
|
1025 as sym =
|
|
1026 (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) classes)
|
|
1027 do (unless (get sym 'ebrowse-root)
|
|
1028 (setf (get sym 'ebrowse-root) root)))
|
|
1029 ;; Process subclasses
|
|
1030 (ebrowse-insert-supers tree classes)
|
|
1031 classes))
|
|
1032
|
|
1033
|
|
1034 (defun ebrowse-insert-supers (tree classes)
|
|
1035 "Build base class lists in class tree TREE.
|
|
1036 CLASSES is an obarray used to collect classes.
|
|
1037
|
|
1038 Helper function for `ebrowse-build-tree-obarray'. Base classes should
|
|
1039 be ordered so that immediate base classes come first, then the base
|
|
1040 class of the immediate base class and so on. This means that we must
|
|
1041 construct the base-class list top down with adding each level at the
|
|
1042 beginning of the base-class list.
|
|
1043
|
|
1044 We have to be cautious here not to end up in an infinite recursion
|
|
1045 if for some reason a circle is in the inheritance graph."
|
|
1046 (loop for class in tree
|
|
1047 as subclasses = (ebrowse-ts-subclasses class) do
|
|
1048 ;; Make sure every class is represented by a unique object
|
|
1049 (loop for subclass on subclasses
|
|
1050 as sym = (intern
|
|
1051 (ebrowse-qualified-class-name (ebrowse-ts-class (car subclass)))
|
|
1052 classes)
|
|
1053 as next = nil
|
|
1054 do
|
|
1055 ;; Replace the subclass tree with the one found in
|
|
1056 ;; CLASSES if there is already an entry for that class
|
|
1057 ;; in it. Otherwise make a new entry.
|
|
1058 ;;
|
|
1059 ;; CAVEAT: If by some means (e.g., use of the
|
|
1060 ;; preprocessor in class declarations, a name is marked
|
|
1061 ;; as a subclass of itself on some path, we would end up
|
|
1062 ;; in an endless loop. We have to omit subclasses from
|
|
1063 ;; the recursion that already have been processed.
|
|
1064 (if (get sym 'ebrowse-root)
|
|
1065 (setf (car subclass) (get sym 'ebrowse-root))
|
|
1066 (setf (get sym 'ebrowse-root) (car subclass))))
|
|
1067 ;; Process subclasses
|
|
1068 (ebrowse-insert-supers subclasses classes)))
|
|
1069
|
|
1070
|
|
1071 ;;; Tree buffers
|
|
1072
|
|
1073 (unless ebrowse-tree-mode-map
|
|
1074 (let ((map (make-keymap)))
|
|
1075 (setf ebrowse-tree-mode-map map)
|
|
1076 (suppress-keymap map)
|
|
1077
|
30554
e56649429a8b
(ebrowse-tree-mode-map): Use display-mouse-p instead of window-system.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
1078 (when (display-mouse-p)
|
28523
|
1079 (define-key map [down-mouse-3] 'ebrowse-mouse-3-in-tree-buffer)
|
|
1080 (define-key map [mouse-2] 'ebrowse-mouse-2-in-tree-buffer)
|
|
1081 (define-key map [down-mouse-1] 'ebrowse-mouse-1-in-tree-buffer))
|
47929
|
1082
|
28523
|
1083 (let ((map1 (make-sparse-keymap)))
|
|
1084 (suppress-keymap map1 t)
|
|
1085 (define-key map "L" map1)
|
|
1086 (define-key map1 "d" 'ebrowse-tree-command:show-friends)
|
|
1087 (define-key map1 "f" 'ebrowse-tree-command:show-member-functions)
|
|
1088 (define-key map1 "F" 'ebrowse-tree-command:show-static-member-functions)
|
|
1089 (define-key map1 "t" 'ebrowse-tree-command:show-types)
|
|
1090 (define-key map1 "v" 'ebrowse-tree-command:show-member-variables)
|
|
1091 (define-key map1 "V" 'ebrowse-tree-command:show-static-member-variables))
|
|
1092
|
|
1093 (let ((map1 (make-sparse-keymap)))
|
|
1094 (suppress-keymap map1 t)
|
|
1095 (define-key map "M" map1)
|
|
1096 (define-key map1 "a" 'ebrowse-mark-all-classes)
|
|
1097 (define-key map1 "t" 'ebrowse-toggle-mark-at-point))
|
|
1098
|
|
1099 (let ((map1 (make-sparse-keymap)))
|
|
1100 (suppress-keymap map1 t)
|
|
1101 (define-key map "T" map1)
|
|
1102 (define-key map1 "f" 'ebrowse-toggle-file-name-display)
|
|
1103 (define-key map1 "s" 'ebrowse-show-file-name-at-point)
|
|
1104 (define-key map1 "w" 'ebrowse-set-tree-indentation)
|
|
1105 (define-key map "x" 'ebrowse-statistics))
|
|
1106
|
|
1107 (define-key map "n" 'ebrowse-repeat-member-search)
|
|
1108 (define-key map "q" 'bury-buffer)
|
|
1109 (define-key map "*" 'ebrowse-expand-all)
|
|
1110 (define-key map "+" 'ebrowse-expand-branch)
|
|
1111 (define-key map "-" 'ebrowse-collapse-branch)
|
|
1112 (define-key map "/" 'ebrowse-read-class-name-and-go)
|
|
1113 (define-key map " " 'ebrowse-view-class-declaration)
|
|
1114 (define-key map "?" 'describe-mode)
|
|
1115 (define-key map "\C-i" 'ebrowse-pop/switch-to-member-buffer-for-same-tree)
|
|
1116 (define-key map "\C-k" 'ebrowse-remove-class-at-point)
|
|
1117 (define-key map "\C-l" 'ebrowse-redraw-tree)
|
|
1118 (define-key map "\C-m" 'ebrowse-find-class-declaration)))
|
|
1119
|
|
1120
|
|
1121
|
|
1122 ;;; Tree-mode - mode for tree buffers
|
|
1123
|
|
1124 ;;;###autoload
|
|
1125 (defun ebrowse-tree-mode ()
|
|
1126 "Major mode for Ebrowse class tree buffers.
|
|
1127 Each line corresponds to a class in a class tree.
|
|
1128 Letters do not insert themselves, they are commands.
|
|
1129 File operations in the tree buffer work on class tree data structures.
|
|
1130 E.g.\\[save-buffer] writes the tree to the file it was loaded from.
|
|
1131
|
|
1132 Tree mode key bindings:
|
|
1133 \\{ebrowse-tree-mode-map}"
|
28541
|
1134 (interactive)
|
28548
|
1135 (let* ((ident (propertized-buffer-identification "C++ Tree"))
|
28541
|
1136 header tree buffer-read-only)
|
47929
|
1137
|
28541
|
1138 (kill-all-local-variables)
|
|
1139 (use-local-map ebrowse-tree-mode-map)
|
85265
|
1140 (buffer-disable-undo)
|
47929
|
1141
|
28541
|
1142 (unless (zerop (buffer-size))
|
|
1143 (goto-char (point-min))
|
102532
|
1144 (multiple-value-setq (header tree) (values-list (ebrowse-read)))
|
28541
|
1145 (message "Sorting. Please be patient...")
|
|
1146 (setq tree (ebrowse-sort-tree-list tree))
|
|
1147 (erase-buffer)
|
|
1148 (message nil))
|
47929
|
1149
|
84920
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1150 (mapc 'make-local-variable
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1151 '(ebrowse--tags-file-name
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1152 ebrowse--indentation
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1153 ebrowse--tree
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1154 ebrowse--header
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1155 ebrowse--show-file-names-flag
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1156 ebrowse--frozen-flag
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1157 ebrowse--tree-obarray
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1158 revert-buffer-function))
|
47929
|
1159
|
28523
|
1160 (setf ebrowse--show-file-names-flag nil
|
|
1161 ebrowse--tree-obarray (make-vector 127 0)
|
|
1162 ebrowse--frozen-flag nil
|
|
1163 major-mode 'ebrowse-tree-mode
|
|
1164 mode-name "Ebrowse-Tree"
|
28548
|
1165 mode-line-buffer-identification ident
|
28523
|
1166 buffer-read-only t
|
|
1167 selective-display t
|
|
1168 selective-display-ellipses t
|
28541
|
1169 revert-buffer-function 'ebrowse-revert-tree-buffer-from-file
|
|
1170 ebrowse--header header
|
|
1171 ebrowse--tree tree
|
|
1172 ebrowse--tags-file-name (buffer-file-name)
|
|
1173 ebrowse--tree-obarray (and tree (ebrowse-build-tree-obarray tree))
|
|
1174 ebrowse--frozen-flag nil)
|
|
1175
|
|
1176 (add-hook 'local-write-file-hooks 'ebrowse-write-file-hook-fn)
|
|
1177 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))
|
|
1178 (when tree
|
|
1179 (ebrowse-redraw-tree)
|
|
1180 (set-buffer-modified-p nil))
|
62772
|
1181 (run-mode-hooks 'ebrowse-tree-mode-hook)))
|
47929
|
1182
|
28523
|
1183
|
|
1184
|
|
1185 (defun ebrowse-update-tree-buffer-mode-line ()
|
|
1186 "Update the tree buffer mode line."
|
|
1187 (ebrowse-rename-buffer (if ebrowse--frozen-flag
|
|
1188 (ebrowse-frozen-tree-buffer-name
|
|
1189 ebrowse--tags-file-name)
|
|
1190 ebrowse-tree-buffer-name))
|
|
1191 (force-mode-line-update))
|
|
1192
|
|
1193
|
|
1194
|
|
1195 ;;; Removing classes from trees
|
|
1196
|
|
1197 (defun ebrowse-remove-class-and-kill-member-buffers (tree class)
|
|
1198 "Remove from TREE class CLASS.
|
|
1199 Kill all member buffers still containing a reference to the class."
|
|
1200 (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class))
|
|
1201 ebrowse--tree-obarray)))
|
|
1202 (setf tree (delq class tree)
|
|
1203 (get sym 'ebrowse-root) nil)
|
|
1204 (dolist (root tree)
|
|
1205 (setf (ebrowse-ts-subclasses root)
|
|
1206 (delq class (ebrowse-ts-subclasses root))
|
|
1207 (ebrowse-ts-base-classes root) nil)
|
|
1208 (ebrowse-remove-class-and-kill-member-buffers
|
|
1209 (ebrowse-ts-subclasses root) class))
|
|
1210 (ebrowse-kill-member-buffers-displaying class)
|
|
1211 tree))
|
|
1212
|
|
1213
|
|
1214 (defun ebrowse-remove-class-at-point (forced)
|
|
1215 "Remove the class point is on from the class tree.
|
|
1216 Do not ask for confirmation if FORCED is non-nil."
|
|
1217 (interactive "P")
|
|
1218 (let* ((class (ebrowse-tree-at-point))
|
|
1219 (class-name (ebrowse-cs-name (ebrowse-ts-class class)))
|
|
1220 (subclasses (ebrowse-ts-subclasses class)))
|
|
1221 (cond ((or forced
|
|
1222 (y-or-n-p (concat "Delete class " class-name "? ")))
|
|
1223 (setf ebrowse--tree (ebrowse-remove-class-and-kill-member-buffers
|
|
1224 ebrowse--tree class))
|
|
1225 (set-buffer-modified-p t)
|
|
1226 (message "%s %sdeleted." class-name
|
|
1227 (if subclasses "and derived classes " ""))
|
|
1228 (ebrowse-redraw-tree))
|
|
1229 (t (message "Aborted")))))
|
|
1230
|
|
1231
|
|
1232
|
|
1233 ;;; Marking classes in the tree buffer
|
|
1234
|
|
1235 (defun ebrowse-toggle-mark-at-point (&optional n-times)
|
|
1236 "Toggle mark for class cursor is on.
|
|
1237 If given a numeric N-TIMES argument, mark that many classes."
|
|
1238 (interactive "p")
|
|
1239 (let (to-change pnt)
|
|
1240 ;; Get the classes whose mark must be toggled. Note that
|
|
1241 ;; ebrowse-tree-at-point might issue an error.
|
|
1242 (condition-case error
|
|
1243 (loop repeat (or n-times 1)
|
|
1244 as tree = (ebrowse-tree-at-point)
|
47929
|
1245 do (progn
|
28523
|
1246 (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree)))
|
|
1247 (forward-line 1)
|
|
1248 (push tree to-change)))
|
|
1249 (error nil))
|
|
1250 (save-excursion
|
|
1251 ;; For all these classes, reverse the mark char in the display
|
|
1252 ;; by a regexp replace over the whole buffer. The reason for this
|
|
1253 ;; is that classes might have multiple base classes. If this is
|
|
1254 ;; the case, they are displayed more than once in the tree.
|
|
1255 (ebrowse-output
|
|
1256 (loop for tree in to-change
|
|
1257 as regexp = (concat "^.*\\b"
|
|
1258 (regexp-quote
|
|
1259 (ebrowse-cs-name (ebrowse-ts-class tree)))
|
|
1260 "\\b")
|
|
1261 do
|
|
1262 (goto-char (point-min))
|
|
1263 (loop while (re-search-forward regexp nil t)
|
|
1264 do (progn
|
|
1265 (goto-char (match-beginning 0))
|
|
1266 (delete-char 1)
|
|
1267 (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1)
|
|
1268 (ebrowse-set-mark-props (1- (point)) (point) tree)
|
|
1269 (goto-char (match-end 0)))))))))
|
|
1270
|
|
1271
|
|
1272 (defun ebrowse-mark-all-classes (prefix)
|
|
1273 "Unmark, with PREFIX mark, all classes in the tree."
|
|
1274 (interactive "P")
|
|
1275 (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
|
|
1276 (setf (ebrowse-ts-mark tree) prefix))
|
|
1277 (ebrowse-redraw-marks (point-min) (point-max)))
|
|
1278
|
|
1279
|
|
1280 (defun ebrowse-redraw-marks (start end)
|
|
1281 "Display class marker signs in the tree between START and END."
|
|
1282 (interactive)
|
|
1283 (save-excursion
|
|
1284 (ebrowse-output
|
|
1285 (catch 'end
|
|
1286 (goto-char (point-min))
|
|
1287 (dolist (root ebrowse--tree)
|
|
1288 (ebrowse-draw-marks-fn root start end))))
|
|
1289 (ebrowse-update-tree-buffer-mode-line)))
|
|
1290
|
|
1291
|
|
1292 (defun ebrowse-draw-marks-fn (tree start end)
|
|
1293 "Display class marker signs in TREE between START and END."
|
|
1294 (when (>= (point) start)
|
|
1295 (delete-char 1)
|
|
1296 (insert (if (ebrowse-ts-mark tree) ?> ? ))
|
|
1297 (ebrowse-set-mark-props (1- (point)) (point) tree))
|
|
1298 (forward-line 1)
|
|
1299 (when (> (point) end)
|
|
1300 (throw 'end nil))
|
|
1301 (dolist (sub (ebrowse-ts-subclasses tree))
|
|
1302 (ebrowse-draw-marks-fn sub start end)))
|
|
1303
|
|
1304
|
|
1305
|
|
1306 ;;; File name display in tree buffers
|
|
1307
|
|
1308 (defun ebrowse-show-file-name-at-point (prefix)
|
|
1309 "Show filename in the line point is in.
|
|
1310 With PREFIX, insert that many filenames."
|
|
1311 (interactive "p")
|
|
1312 (unless ebrowse--show-file-names-flag
|
|
1313 (ebrowse-output
|
|
1314 (dotimes (i prefix)
|
|
1315 (let ((tree (ebrowse-tree-at-point))
|
|
1316 start
|
|
1317 file-name-existing)
|
|
1318 (beginning-of-line)
|
|
1319 (skip-chars-forward " \t*a-zA-Z0-9_")
|
|
1320 (setq start (point)
|
|
1321 file-name-existing (looking-at "("))
|
|
1322 (delete-region start (save-excursion (end-of-line) (point)))
|
|
1323 (unless file-name-existing
|
|
1324 (indent-to ebrowse-source-file-column)
|
|
1325 (insert "(" (or (ebrowse-cs-file
|
|
1326 (ebrowse-ts-class tree))
|
|
1327 "unknown")
|
|
1328 ")"))
|
63448
|
1329 (ebrowse-set-face start (point) 'ebrowse-file-name)
|
28523
|
1330 (beginning-of-line)
|
|
1331 (forward-line 1))))))
|
|
1332
|
|
1333
|
|
1334 (defun ebrowse-toggle-file-name-display ()
|
|
1335 "Toggle display of filenames in tree buffer."
|
|
1336 (interactive)
|
|
1337 (setf ebrowse--show-file-names-flag (not ebrowse--show-file-names-flag))
|
|
1338 (let ((old-line (count-lines (point-min) (point))))
|
|
1339 (ebrowse-redraw-tree)
|
|
1340 (goto-line old-line)))
|
|
1341
|
|
1342
|
|
1343
|
|
1344 ;;; General member and tree buffer functions
|
|
1345
|
|
1346 (defun ebrowse-member-buffer-p (buffer)
|
|
1347 "Value is non-nil if BUFFER is a member buffer."
|
|
1348 (eq (cdr (assoc 'major-mode (buffer-local-variables buffer)))
|
|
1349 'ebrowse-member-mode))
|
|
1350
|
|
1351
|
|
1352 (defun ebrowse-tree-buffer-p (buffer)
|
|
1353 "Value is non-nil if BUFFER is a class tree buffer."
|
|
1354 (eq (cdr (assoc 'major-mode (buffer-local-variables buffer)))
|
|
1355 'ebrowse-tree-mode))
|
|
1356
|
|
1357
|
|
1358 (defun ebrowse-buffer-p (buffer)
|
|
1359 "Value is non-nil if BUFFER is a tree or member buffer."
|
|
1360 (memq (cdr (assoc 'major-mode (buffer-local-variables buffer)))
|
|
1361 '(ebrowse-tree-mode ebrowse-member-mode)))
|
|
1362
|
|
1363
|
|
1364 (defun ebrowse-browser-buffer-list ()
|
|
1365 "Return a list of all tree or member buffers."
|
|
1366 (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list)))
|
|
1367
|
|
1368
|
|
1369 (defun ebrowse-member-buffer-list ()
|
|
1370 "Return a list of all member buffers."
|
|
1371 (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list)))
|
|
1372
|
|
1373
|
|
1374 (defun ebrowse-tree-buffer-list ()
|
|
1375 "Return a list of all tree buffers."
|
|
1376 (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list)))
|
|
1377
|
|
1378
|
|
1379 (defun ebrowse-known-class-trees-buffer-list ()
|
|
1380 "Return a list of buffers containing class trees.
|
|
1381 The list will contain, for each class tree loaded,
|
|
1382 one buffer. Prefer tree buffers over member buffers."
|
|
1383 (let ((buffers (nconc (ebrowse-tree-buffer-list)
|
|
1384 (ebrowse-member-buffer-list)))
|
|
1385 (set (make-hash-table))
|
|
1386 result)
|
|
1387 (dolist (buffer buffers)
|
|
1388 (let ((tree (ebrowse-value-in-buffer 'ebrowse--tree buffer)))
|
|
1389 (unless (gethash tree set)
|
|
1390 (push buffer result))
|
|
1391 (puthash tree t set)))
|
|
1392 result))
|
|
1393
|
|
1394
|
|
1395 (defun ebrowse-same-tree-member-buffer-list ()
|
|
1396 "Return a list of members buffers with same tree as current buffer."
|
|
1397 (ebrowse-delete-if-not
|
|
1398 #'(lambda (buffer)
|
|
1399 (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer)
|
|
1400 ebrowse--tree))
|
|
1401 (ebrowse-member-buffer-list)))
|
|
1402
|
|
1403
|
|
1404
|
|
1405 (defun ebrowse-pop/switch-to-member-buffer-for-same-tree (arg)
|
|
1406 "Pop to the buffer displaying members.
|
|
1407 Switch to buffer if prefix ARG.
|
|
1408 If no member buffer exists, make one."
|
|
1409 (interactive "P")
|
|
1410 (let ((buf (or (first (ebrowse-same-tree-member-buffer-list))
|
|
1411 (get-buffer ebrowse-member-buffer-name)
|
|
1412 (ebrowse-tree-command:show-member-functions))))
|
|
1413 (when buf
|
|
1414 (if arg
|
|
1415 (switch-to-buffer buf)
|
|
1416 (pop-to-buffer buf)))
|
|
1417 buf))
|
|
1418
|
|
1419
|
|
1420 (defun ebrowse-switch-to-next-member-buffer ()
|
|
1421 "Switch to next member buffer."
|
|
1422 (interactive)
|
|
1423 (let* ((list (ebrowse-member-buffer-list))
|
|
1424 (next-list (cdr (memq (current-buffer) list)))
|
|
1425 (next-buffer (if next-list (car next-list) (car list))))
|
|
1426 (if (eq next-buffer (current-buffer))
|
|
1427 (error "No next buffer")
|
|
1428 (bury-buffer)
|
|
1429 (switch-to-buffer next-buffer))))
|
|
1430
|
|
1431
|
|
1432 (defun ebrowse-kill-member-buffers-displaying (tree)
|
|
1433 "Kill all member buffers displaying TREE."
|
|
1434 (loop for buffer in (ebrowse-member-buffer-list)
|
|
1435 as class = (ebrowse-value-in-buffer 'ebrowse--displayed-class buffer)
|
|
1436 when (eq class tree) do (kill-buffer buffer)))
|
|
1437
|
|
1438
|
|
1439 (defun ebrowse-frozen-tree-buffer-name (tags-file-name)
|
|
1440 "Return the buffer name of a tree which is associated TAGS-FILE-NAME."
|
|
1441 (concat ebrowse-tree-buffer-name " (" tags-file-name ")"))
|
|
1442
|
|
1443
|
|
1444 (defun ebrowse-pop-to-browser-buffer (arg)
|
|
1445 "Pop to a browser buffer from any other buffer.
|
|
1446 Pop to member buffer if no prefix ARG, to tree buffer otherwise."
|
|
1447 (interactive "P")
|
47929
|
1448 (let ((buffer (get-buffer (if arg
|
28523
|
1449 ebrowse-tree-buffer-name
|
|
1450 ebrowse-member-buffer-name))))
|
|
1451 (unless buffer
|
47929
|
1452 (setq buffer
|
28523
|
1453 (get-buffer (if arg
|
|
1454 ebrowse-member-buffer-name
|
|
1455 ebrowse-tree-buffer-name))))
|
|
1456 (unless buffer
|
|
1457 (error "No browser buffer found"))
|
|
1458 (pop-to-buffer buffer)))
|
|
1459
|
|
1460
|
|
1461
|
|
1462 ;;; Misc tree buffer commands
|
|
1463
|
|
1464 (defun ebrowse-set-tree-indentation ()
|
|
1465 "Set the indentation width of the tree display."
|
|
1466 (interactive)
|
62402
|
1467 (let ((width (string-to-number (read-from-minibuffer
|
|
1468 (concat "Indentation ("
|
|
1469 (int-to-string ebrowse--indentation)
|
|
1470 "): ")))))
|
28523
|
1471 (when (plusp width)
|
|
1472 (setf ebrowse--indentation width)
|
|
1473 (ebrowse-redraw-tree))))
|
|
1474
|
|
1475
|
|
1476 (defun ebrowse-read-class-name-and-go (&optional class)
|
|
1477 "Position cursor on CLASS.
|
|
1478 Read a class name from the minibuffer if CLASS is nil."
|
|
1479 (interactive)
|
|
1480 (ebrowse-ignoring-completion-case
|
|
1481 ;; If no class specified, read the class name from mini-buffer
|
|
1482 (unless class
|
|
1483 (setf class
|
|
1484 (completing-read "Goto class: "
|
|
1485 (ebrowse-tree-obarray-as-alist) nil t)))
|
|
1486 (ebrowse-save-selective
|
|
1487 (goto-char (point-min))
|
|
1488 (widen)
|
|
1489 (setf selective-display nil)
|
|
1490 (setq ebrowse--last-regexp (concat "\\b" class "\\b"))
|
|
1491 (if (re-search-forward ebrowse--last-regexp nil t)
|
|
1492 (progn
|
|
1493 (goto-char (match-beginning 0))
|
|
1494 (ebrowse-unhide-base-classes))
|
|
1495 (error "Not found")))))
|
|
1496
|
|
1497
|
|
1498
|
|
1499 ;;; Showing various kinds of member buffers
|
|
1500
|
|
1501 (defun ebrowse-tree-command:show-member-variables (arg)
|
|
1502 "Display member variables; with prefix ARG in frozen member buffer."
|
|
1503 (interactive "P")
|
|
1504 (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg))
|
|
1505
|
|
1506
|
|
1507 (defun ebrowse-tree-command:show-member-functions (&optional arg)
|
|
1508 "Display member functions; with prefix ARG in frozen member buffer."
|
|
1509 (interactive "P")
|
|
1510 (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg))
|
|
1511
|
|
1512
|
|
1513 (defun ebrowse-tree-command:show-static-member-variables (arg)
|
|
1514 "Display static member variables; with prefix ARG in frozen member buffer."
|
|
1515 (interactive "P")
|
|
1516 (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg))
|
|
1517
|
|
1518
|
|
1519 (defun ebrowse-tree-command:show-static-member-functions (arg)
|
|
1520 "Display static member functions; with prefix ARG in frozen member buffer."
|
|
1521 (interactive "P")
|
|
1522 (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg))
|
|
1523
|
|
1524
|
|
1525 (defun ebrowse-tree-command:show-friends (arg)
|
|
1526 "Display friend functions; with prefix ARG in frozen member buffer."
|
|
1527 (interactive "P")
|
|
1528 (ebrowse-display-member-buffer 'ebrowse-ts-friends arg))
|
|
1529
|
|
1530
|
|
1531 (defun ebrowse-tree-command:show-types (arg)
|
|
1532 "Display types defined in a class; with prefix ARG in frozen member buffer."
|
|
1533 (interactive "P")
|
|
1534 (ebrowse-display-member-buffer 'ebrowse-ts-types arg))
|
|
1535
|
|
1536
|
|
1537
|
|
1538 ;;; Viewing or finding a class declaration
|
|
1539
|
|
1540 (defun ebrowse-tree-at-point ()
|
|
1541 "Return the class structure for the class point is on."
|
|
1542 (or (get-text-property (point) 'ebrowse-tree)
|
|
1543 (error "Not on a class")))
|
|
1544
|
|
1545
|
|
1546 (defun* ebrowse-view/find-class-declaration (&key view where)
|
|
1547 "View or find the declarator of the class point is on.
|
|
1548 VIEW non-nil means view it. WHERE is additional position info."
|
|
1549 (let* ((class (ebrowse-ts-class (ebrowse-tree-at-point)))
|
|
1550 (file (ebrowse-cs-file class))
|
|
1551 (browse-struct (make-ebrowse-bs
|
|
1552 :name (ebrowse-cs-name class)
|
|
1553 :pattern (ebrowse-cs-pattern class)
|
|
1554 :flags (ebrowse-cs-flags class)
|
|
1555 :file (ebrowse-cs-file class)
|
|
1556 :point (ebrowse-cs-point class))))
|
|
1557 (ebrowse-view/find-file-and-search-pattern
|
47929
|
1558 browse-struct
|
28523
|
1559 (list ebrowse--header class nil)
|
|
1560 file
|
|
1561 ebrowse--tags-file-name
|
|
1562 view
|
|
1563 where)))
|
|
1564
|
|
1565
|
|
1566 (defun ebrowse-find-class-declaration (prefix-arg)
|
|
1567 "Find a class declaration and position cursor on it.
|
|
1568 PREFIX-ARG 4 means find it in another window.
|
|
1569 PREFIX-ARG 5 means find it in another frame."
|
|
1570 (interactive "p")
|
|
1571 (ebrowse-view/find-class-declaration
|
|
1572 :view nil
|
|
1573 :where (cond ((= prefix-arg 4) 'other-window)
|
|
1574 ((= prefix-arg 5) 'other-frame)
|
|
1575 (t 'this-window))))
|
|
1576
|
|
1577
|
|
1578 (defun ebrowse-view-class-declaration (prefix-arg)
|
|
1579 "View class declaration and position cursor on it.
|
|
1580 PREFIX-ARG 4 means view it in another window.
|
|
1581 PREFIX-ARG 5 means view it in another frame."
|
|
1582 (interactive "p")
|
|
1583 (ebrowse-view/find-class-declaration
|
|
1584 :view 'view
|
|
1585 :where (cond ((= prefix-arg 4) 'other-window)
|
|
1586 ((= prefix-arg 5) 'other-frame)
|
|
1587 (t 'this-window))))
|
|
1588
|
|
1589
|
|
1590
|
|
1591 ;;; The FIND engine
|
|
1592
|
|
1593 (defun ebrowse-find-source-file (file tags-file-name)
|
|
1594 "Find source file FILE.
|
|
1595 Source files are searched for (a) relative to TAGS-FILE-NAME
|
|
1596 which is the path of the BROWSE file from which the class tree was loaded,
|
|
1597 and (b) in the directories named in `ebrowse-search-path'."
|
|
1598 (let (file-name
|
|
1599 (try-file (expand-file-name file
|
|
1600 (file-name-directory tags-file-name))))
|
|
1601 (if (file-readable-p try-file)
|
|
1602 (setq file-name try-file)
|
|
1603 (let ((search-in ebrowse-search-path))
|
|
1604 (while (and search-in
|
|
1605 (null file-name))
|
|
1606 (let ((try-file (expand-file-name file (car search-in))))
|
|
1607 (if (file-readable-p try-file)
|
|
1608 (setq file-name try-file))
|
|
1609 (setq search-in (cdr search-in))))))
|
|
1610 (unless file-name
|
|
1611 (error "File `%s' not found" file))
|
|
1612 file-name))
|
|
1613
|
|
1614
|
|
1615 (defun ebrowse-view-exit-fn (buffer)
|
|
1616 "Function called when exiting View mode in BUFFER.
|
|
1617 Restore frame configuration active before viewing the file,
|
|
1618 and possibly kill the viewed buffer."
|
|
1619 (let (exit-action original-frame-configuration)
|
|
1620 (save-excursion
|
|
1621 (set-buffer buffer)
|
|
1622 (setq original-frame-configuration ebrowse--frame-configuration
|
|
1623 exit-action ebrowse--view-exit-action))
|
|
1624 ;; Delete the frame in which we viewed.
|
84920
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1625 (mapc 'delete-frame
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1626 (loop for frame in (frame-list)
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1627 when (not (assq frame original-frame-configuration))
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1628 collect frame))
|
28523
|
1629 (when exit-action
|
|
1630 (funcall exit-action buffer))))
|
|
1631
|
|
1632
|
|
1633 (defun ebrowse-view-file-other-frame (file)
|
|
1634 "View a file FILE in another frame.
|
79827
|
1635 The new frame is deleted when you quit viewing the file in that frame."
|
28523
|
1636 (interactive)
|
|
1637 (let ((old-frame-configuration (current-frame-configuration))
|
|
1638 (had-a-buf (get-file-buffer file))
|
|
1639 (buf-to-view (find-file-noselect file)))
|
|
1640 (switch-to-buffer-other-frame buf-to-view)
|
|
1641 (make-local-variable 'ebrowse--frame-configuration)
|
|
1642 (setq ebrowse--frame-configuration old-frame-configuration)
|
|
1643 (make-local-variable 'ebrowse--view-exit-action)
|
47929
|
1644 (setq ebrowse--view-exit-action
|
28523
|
1645 (and (not had-a-buf)
|
|
1646 (not (buffer-modified-p buf-to-view))
|
|
1647 'kill-buffer))
|
79827
|
1648 (view-mode-enter (cons (selected-window) (cons (selected-window) t))
|
|
1649 'ebrowse-view-exit-fn)))
|
28523
|
1650
|
|
1651 (defun ebrowse-view/find-file-and-search-pattern
|
|
1652 (struc info file tags-file-name &optional view where)
|
|
1653 "Find or view a member or class.
|
|
1654 STRUC is an `ebrowse-bs' structure (or a structure including that)
|
|
1655 describing what to search.
|
|
1656 INFO is a list (HEADER MEMBER-OR-CLASS ACCESSOR). HEADER is the
|
|
1657 header structure of a class tree. MEMBER-OR-CLASS is either an
|
|
1658 `ebrowse-ms' or `ebrowse-cs' structure depending on what is searched.
|
47929
|
1659 ACCESSOR is an accessor function for the member list of a member
|
28523
|
1660 if MEMBER-OR-CLASS is an `ebrowse-ms'.
|
|
1661 FILE is the file to search the member in.
|
|
1662 FILE is not taken out of STRUC here because the filename in STRUC
|
|
1663 may be nil in which case the filename of the class description is used.
|
28816
|
1664 TAGS-FILE-NAME is the name of the BROWSE file from which the
|
28523
|
1665 tree was loaded.
|
|
1666 If VIEW is non-nil, view file else find the file.
|
|
1667 WHERE is either `other-window', `other-frame' or `this-window' and
|
|
1668 specifies where to find/view the result."
|
|
1669 (unless file
|
|
1670 (error "Sorry, no file information available for %s"
|
|
1671 (ebrowse-bs-name struc)))
|
|
1672 ;; Get the source file to view or find.
|
|
1673 (setf file (ebrowse-find-source-file file tags-file-name))
|
|
1674 ;; If current window is dedicated, use another frame.
|
|
1675 (when (window-dedicated-p (selected-window))
|
43763
|
1676 (setf where 'other-window))
|
28523
|
1677 (cond (view
|
|
1678 (setf ebrowse-temp-position-to-view struc
|
|
1679 ebrowse-temp-info-to-view info)
|
|
1680 (unless (boundp 'view-mode-hook)
|
|
1681 (setq view-mode-hook nil))
|
|
1682 (push 'ebrowse-find-pattern view-mode-hook)
|
|
1683 (case where
|
79827
|
1684 (other-window (view-file-other-window file))
|
28523
|
1685 (other-frame (ebrowse-view-file-other-frame file))
|
|
1686 (t (view-file file))))
|
|
1687 (t
|
|
1688 (case where
|
|
1689 (other-window (find-file-other-window file))
|
|
1690 (other-frame (find-file-other-frame file))
|
|
1691 (t (find-file file)))
|
|
1692 (ebrowse-find-pattern struc info))))
|
|
1693
|
|
1694
|
|
1695 (defun ebrowse-symbol-regexp (name)
|
|
1696 "Generate a suitable regular expression for a member or class NAME.
|
|
1697 This is `regexp-quote' for most symbols, except for operator names
|
|
1698 which may contain whitespace. For these symbols, replace white
|
28816
|
1699 space in the symbol name (generated by BROWSE) with a regular
|
28523
|
1700 expression matching any number of whitespace characters."
|
|
1701 (loop with regexp = (regexp-quote name)
|
|
1702 with start = 0
|
|
1703 finally return regexp
|
|
1704 while (string-match "[ \t]+" regexp start)
|
46353
|
1705 do (setq regexp (concat (substring regexp 0 (match-beginning 0))
|
|
1706 "[ \t]*"
|
|
1707 (substring regexp (match-end 0)))
|
28523
|
1708 start (+ (match-beginning 0) 5))))
|
|
1709
|
|
1710
|
|
1711 (defun ebrowse-class-declaration-regexp (name)
|
47929
|
1712 "Construct a regexp for a declaration of class NAME."
|
28523
|
1713 (concat "^[ \t]*\\(template[ \t\n]*<.*>\\)?"
|
|
1714 "[ \t\n]*\\(class\\|struct\\|union\\).*\\S_"
|
|
1715 (ebrowse-symbol-regexp name)
|
|
1716 "\\S_"))
|
|
1717
|
|
1718
|
|
1719 (defun ebrowse-variable-declaration-regexp (name)
|
|
1720 "Construct a regexp for matching a variable NAME."
|
|
1721 (concat "\\S_" (ebrowse-symbol-regexp name) "\\S_"))
|
|
1722
|
|
1723
|
|
1724 (defun ebrowse-function-declaration/definition-regexp (name)
|
|
1725 "Construct a regexp for matching a function NAME."
|
|
1726 (concat "^[a-zA-Z0-9_:*&<>, \t]*\\S_"
|
|
1727 (ebrowse-symbol-regexp name)
|
|
1728 "[ \t\n]*("))
|
|
1729
|
|
1730
|
|
1731 (defun ebrowse-pp-define-regexp (name)
|
|
1732 "Construct a regexp matching a define of NAME."
|
|
1733 (concat "^[ \t]*#[ \t]*define[ \t]+" (regexp-quote name)))
|
|
1734
|
|
1735
|
|
1736 (defun* ebrowse-find-pattern (&optional position info &aux viewing)
|
|
1737 "Find a pattern.
|
|
1738
|
|
1739 This is a kluge: Ebrowse allows you to find or view a file containing
|
|
1740 a pattern. To be able to do a search in a viewed buffer,
|
|
1741 `view-mode-hook' is temporarily set to this function;
|
|
1742 `ebrowse-temp-position-to-view' holds what to search for.
|
|
1743
|
|
1744 INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)."
|
|
1745 (unless position
|
|
1746 (pop view-mode-hook)
|
|
1747 (setf viewing t
|
|
1748 position ebrowse-temp-position-to-view
|
|
1749 info ebrowse-temp-info-to-view))
|
|
1750 (widen)
|
|
1751 (let* ((pattern (ebrowse-bs-pattern position))
|
|
1752 (start (ebrowse-bs-point position))
|
|
1753 (offset 100)
|
|
1754 found)
|
|
1755 (destructuring-bind (header class-or-member member-list) info
|
|
1756 ;; If no pattern is specified, construct one from the member name.
|
|
1757 (when (stringp pattern)
|
|
1758 (setq pattern (concat "^.*" (regexp-quote pattern))))
|
|
1759 ;; Construct a regular expression if none given.
|
|
1760 (unless pattern
|
|
1761 (typecase class-or-member
|
|
1762 (ebrowse-ms
|
|
1763 (case member-list
|
|
1764 ((ebrowse-ts-member-variables
|
|
1765 ebrowse-ts-static-variables
|
|
1766 ebrowse-ts-types)
|
|
1767 (setf pattern (ebrowse-variable-declaration-regexp
|
|
1768 (ebrowse-bs-name position))))
|
|
1769 (otherwise
|
|
1770 (if (ebrowse-define-p class-or-member)
|
|
1771 (setf pattern (ebrowse-pp-define-regexp (ebrowse-bs-name position)))
|
|
1772 (setf pattern (ebrowse-function-declaration/definition-regexp
|
|
1773 (ebrowse-bs-name position)))))))
|
|
1774 (ebrowse-cs
|
|
1775 (setf pattern (ebrowse-class-declaration-regexp
|
|
1776 (ebrowse-bs-name position))))))
|
|
1777 ;; Begin searching some OFFSET from the original point where the
|
|
1778 ;; regular expression was found by the parse, and step forward.
|
|
1779 ;; When there is no regular expression in the database and a
|
|
1780 ;; member definition/declaration was not seen by the parser,
|
|
1781 ;; START will be 0.
|
|
1782 (when (and (boundp 'ebrowse-debug)
|
|
1783 (symbol-value 'ebrowse-debug))
|
65689
|
1784 (y-or-n-p (format "start = %d? " start))
|
28523
|
1785 (y-or-n-p pattern))
|
|
1786 (setf found
|
|
1787 (loop do (goto-char (max (point-min) (- start offset)))
|
|
1788 when (re-search-forward pattern (+ start offset) t) return t
|
|
1789 never (bobp)
|
|
1790 do (incf offset offset)))
|
|
1791 (cond (found
|
|
1792 (beginning-of-line)
|
|
1793 (run-hooks 'ebrowse-view/find-hook))
|
|
1794 ((numberp (ebrowse-bs-pattern position))
|
|
1795 (goto-char start)
|
|
1796 (if ebrowse-not-found-hook
|
|
1797 (run-hooks 'ebrowse-not-found-hook)
|
|
1798 (message "Not found")
|
|
1799 (sit-for 2)))
|
|
1800 (t
|
|
1801 (if ebrowse-not-found-hook
|
|
1802 (run-hooks 'ebrowse-not-found-hook)
|
|
1803 (unless viewing
|
|
1804 (error "Not found"))
|
|
1805 (message "Not found")
|
|
1806 (sit-for 2)))))))
|
|
1807
|
|
1808
|
|
1809 ;;; Drawing the tree
|
|
1810
|
|
1811 (defun ebrowse-redraw-tree (&optional quietly)
|
|
1812 "Redisplay the complete tree.
|
|
1813 QUIETLY non-nil means don't display progress messages."
|
|
1814 (interactive)
|
|
1815 (or quietly (message "Displaying..."))
|
|
1816 (save-excursion
|
|
1817 (ebrowse-output
|
|
1818 (erase-buffer)
|
|
1819 (ebrowse-draw-tree-fn)))
|
|
1820 (ebrowse-update-tree-buffer-mode-line)
|
|
1821 (or quietly (message nil)))
|
|
1822
|
|
1823
|
|
1824 (defun ebrowse-set-mark-props (start end tree)
|
|
1825 "Set text properties for class marker signs between START and END.
|
|
1826 TREE denotes the class shown."
|
|
1827 (add-text-properties
|
|
1828 start end
|
|
1829 `(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree
|
|
1830 help-echo "double-mouse-1: mark/unmark"))
|
63448
|
1831 (ebrowse-set-face start end 'ebrowse-tree-mark))
|
28523
|
1832
|
|
1833
|
|
1834 (defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start)
|
49480
|
1835 "Display a single class and recursively its subclasses.
|
28523
|
1836 This function may look weird, but this is faster than recursion."
|
|
1837 (setq stack1 (make-list (length ebrowse--tree) 0)
|
45742
|
1838 stack2 (copy-sequence ebrowse--tree))
|
28523
|
1839 (loop while stack2
|
|
1840 as level = (pop stack1)
|
|
1841 as tree = (pop stack2)
|
|
1842 as class = (ebrowse-ts-class tree) do
|
|
1843 (let ((start-of-line (point))
|
|
1844 start-of-class-name end-of-class-name)
|
|
1845 ;; Insert mark
|
|
1846 (insert (if (ebrowse-ts-mark tree) ">" " "))
|
47929
|
1847
|
28523
|
1848 ;; Indent and insert class name
|
|
1849 (indent-to (+ (* level ebrowse--indentation)
|
|
1850 ebrowse-tree-left-margin))
|
|
1851 (setq start (point))
|
|
1852 (insert (ebrowse-qualified-class-name class))
|
47929
|
1853
|
28523
|
1854 ;; If template class, add <>
|
|
1855 (when (ebrowse-template-p class)
|
|
1856 (insert "<>"))
|
|
1857 (ebrowse-set-face start (point) (if (zerop level)
|
63448
|
1858 'ebrowse-root-class
|
|
1859 'ebrowse-default))
|
28523
|
1860 (setf start-of-class-name start
|
|
1861 end-of-class-name (point))
|
|
1862 ;; If filenames are to be displayed...
|
|
1863 (when ebrowse--show-file-names-flag
|
|
1864 (indent-to ebrowse-source-file-column)
|
|
1865 (setq start (point))
|
|
1866 (insert "("
|
|
1867 (or (ebrowse-cs-file class)
|
|
1868 "unknown")
|
|
1869 ")")
|
63448
|
1870 (ebrowse-set-face start (point) 'ebrowse-file-name))
|
28523
|
1871 (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
|
|
1872 (add-text-properties
|
|
1873 start-of-class-name end-of-class-name
|
|
1874 `(mouse-face highlight ebrowse-what class-name
|
|
1875 ebrowse-tree ,tree
|
|
1876 help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu"))
|
|
1877 (insert "\n"))
|
|
1878 ;; Push subclasses, if any.
|
|
1879 (when (ebrowse-ts-subclasses tree)
|
|
1880 (setq stack2
|
45742
|
1881 (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2)
|
28523
|
1882 stack1
|
|
1883 (nconc (make-list (length (ebrowse-ts-subclasses tree))
|
|
1884 (1+ level)) stack1)))))
|
|
1885
|
|
1886
|
|
1887
|
|
1888 ;;; Expanding/ collapsing tree branches
|
|
1889
|
|
1890 (defun ebrowse-expand-branch (arg)
|
|
1891 "Expand a sub-tree that has been previously collapsed.
|
|
1892 With prefix ARG, expand all sub-trees."
|
|
1893 (interactive "P")
|
|
1894 (if arg
|
|
1895 (ebrowse-expand-all arg)
|
|
1896 (ebrowse-collapse-fn nil)))
|
|
1897
|
|
1898
|
|
1899 (defun ebrowse-collapse-branch (arg)
|
|
1900 "Fold (do no longer display) the subclasses of the current class.
|
|
1901 \(The class cursor is on.) With prefix ARG, fold all trees in the buffer."
|
|
1902 (interactive "P")
|
|
1903 (if arg
|
|
1904 (ebrowse-expand-all (not arg))
|
|
1905 (ebrowse-collapse-fn t)))
|
|
1906
|
|
1907
|
|
1908 (defun ebrowse-expand-all (collapse)
|
|
1909 "Expand or fold all trees in the buffer.
|
|
1910 COLLAPSE non-nil means fold them."
|
|
1911 (interactive "P")
|
|
1912 (let ((line-end (if collapse "^\n" "^\r"))
|
|
1913 (insertion (if collapse "\r" "\n")))
|
|
1914 (ebrowse-output
|
|
1915 (save-excursion
|
|
1916 (goto-char (point-min))
|
|
1917 (while (not (progn (skip-chars-forward line-end) (eobp)))
|
|
1918 (when (or (not collapse)
|
|
1919 (looking-at "\n "))
|
|
1920 (delete-char 1)
|
|
1921 (insert insertion))
|
|
1922 (when collapse
|
|
1923 (skip-chars-forward "\n ")))))))
|
|
1924
|
|
1925
|
|
1926 (defun ebrowse-unhide-base-classes ()
|
|
1927 "Unhide the line the cursor is on and all base classes."
|
|
1928 (ebrowse-output
|
|
1929 (save-excursion
|
|
1930 (let (indent last-indent)
|
|
1931 (skip-chars-backward "^\r\n")
|
|
1932 (when (not (looking-at "[\r\n][^ \t]"))
|
|
1933 (skip-chars-forward "\r\n \t")
|
|
1934 (while (and (or (null last-indent) ;first time
|
|
1935 (> indent 1)) ;not root class
|
|
1936 (re-search-backward "[\r\n][ \t]*" nil t))
|
|
1937 (setf indent (- (match-end 0)
|
|
1938 (match-beginning 0)))
|
|
1939 (when (or (null last-indent)
|
|
1940 (< indent last-indent))
|
|
1941 (setf last-indent indent)
|
|
1942 (when (looking-at "\r")
|
|
1943 (delete-char 1)
|
|
1944 (insert 10)))
|
|
1945 (backward-char 1)))))))
|
|
1946
|
|
1947
|
|
1948 (defun ebrowse-hide-line (collapse)
|
|
1949 "Hide/show a single line in the tree.
|
|
1950 COLLAPSE non-nil means hide."
|
|
1951 (save-excursion
|
|
1952 (ebrowse-output
|
|
1953 (skip-chars-forward "^\r\n")
|
|
1954 (delete-char 1)
|
|
1955 (insert (if collapse 13 10)))))
|
|
1956
|
|
1957
|
|
1958 (defun ebrowse-collapse-fn (collapse)
|
|
1959 "Collapse or expand a branch of the tree.
|
|
1960 COLLAPSE non-nil means collapse the branch."
|
|
1961 (ebrowse-output
|
|
1962 (save-excursion
|
|
1963 (beginning-of-line)
|
|
1964 (skip-chars-forward "> \t")
|
|
1965 (let ((indentation (current-column)))
|
|
1966 (while (and (not (eobp))
|
|
1967 (save-excursion
|
|
1968 (skip-chars-forward "^\r\n")
|
|
1969 (goto-char (1+ (point)))
|
|
1970 (skip-chars-forward "> \t")
|
|
1971 (> (current-column) indentation)))
|
|
1972 (ebrowse-hide-line collapse)
|
|
1973 (skip-chars-forward "^\r\n")
|
|
1974 (goto-char (1+ (point))))))))
|
|
1975
|
|
1976
|
|
1977 ;;; Electric tree selection
|
|
1978
|
|
1979 (defvar ebrowse-electric-list-mode-map ()
|
|
1980 "Keymap used in electric Ebrowse buffer list window.")
|
|
1981
|
|
1982
|
|
1983 (unless ebrowse-electric-list-mode-map
|
|
1984 (let ((map (make-keymap))
|
|
1985 (submap (make-keymap)))
|
|
1986 (setq ebrowse-electric-list-mode-map map)
|
|
1987 (fillarray (car (cdr map)) 'ebrowse-electric-list-undefined)
|
|
1988 (fillarray (car (cdr submap)) 'ebrowse-electric-list-undefined)
|
|
1989 (define-key map "\e" submap)
|
83416
4513d8dcdfd5
Reimplement and extend support for terminal-local environment variables.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1990 (define-key map "\C-z" 'suspend-frame)
|
28523
|
1991 (define-key map "\C-h" 'Helper-help)
|
|
1992 (define-key map "?" 'Helper-describe-bindings)
|
|
1993 (define-key map "\C-c" nil)
|
|
1994 (define-key map "\C-c\C-c" 'ebrowse-electric-list-quit)
|
|
1995 (define-key map "q" 'ebrowse-electric-list-quit)
|
|
1996 (define-key map " " 'ebrowse-electric-list-select)
|
|
1997 (define-key map "\C-l" 'recenter)
|
|
1998 (define-key map "\C-u" 'universal-argument)
|
|
1999 (define-key map "\C-p" 'previous-line)
|
|
2000 (define-key map "\C-n" 'next-line)
|
|
2001 (define-key map "p" 'previous-line)
|
|
2002 (define-key map "n" 'next-line)
|
|
2003 (define-key map "v" 'ebrowse-electric-view-buffer)
|
|
2004 (define-key map "\C-v" 'scroll-up)
|
|
2005 (define-key map "\ev" 'scroll-down)
|
|
2006 (define-key map "\e\C-v" 'scroll-other-window)
|
|
2007 (define-key map "\e>" 'end-of-buffer)
|
|
2008 (define-key map "\e<" 'beginning-of-buffer)
|
|
2009 (define-key map "\e>" 'end-of-buffer)))
|
|
2010
|
|
2011 (put 'ebrowse-electric-list-mode 'mode-class 'special)
|
|
2012 (put 'ebrowse-electric-list-undefined 'suppress-keymap t)
|
|
2013
|
|
2014
|
|
2015 (defun ebrowse-electric-list-mode ()
|
|
2016 "Mode for electric tree list mode."
|
|
2017 (kill-all-local-variables)
|
|
2018 (use-local-map ebrowse-electric-list-mode-map)
|
|
2019 (setq mode-name "Electric Position Menu"
|
|
2020 mode-line-buffer-identification "Electric Tree Menu")
|
|
2021 (when (memq 'mode-name mode-line-format)
|
|
2022 (setq mode-line-format (copy-sequence mode-line-format))
|
|
2023 (setcar (memq 'mode-name mode-line-format) "Tree Buffers"))
|
|
2024 (make-local-variable 'Helper-return-blurb)
|
|
2025 (setq Helper-return-blurb "return to buffer editing"
|
|
2026 truncate-lines t
|
|
2027 buffer-read-only t
|
|
2028 major-mode 'ebrowse-electric-list-mode)
|
62772
|
2029 (run-mode-hooks 'ebrowse-electric-list-mode-hook))
|
28523
|
2030
|
|
2031
|
|
2032 (defun ebrowse-list-tree-buffers ()
|
|
2033 "Display a list of all tree buffers."
|
|
2034 (set-buffer (get-buffer-create "*Tree Buffers*"))
|
|
2035 (setq buffer-read-only nil)
|
|
2036 (erase-buffer)
|
|
2037 (insert "Tree\n" "----\n")
|
|
2038 (dolist (buffer (ebrowse-known-class-trees-buffer-list))
|
|
2039 (insert (buffer-name buffer) "\n"))
|
|
2040 (setq buffer-read-only t))
|
|
2041
|
|
2042
|
|
2043 ;;;###autoload
|
|
2044 (defun ebrowse-electric-choose-tree ()
|
|
2045 "Return a buffer containing a tree or nil if no tree found or canceled."
|
|
2046 (interactive)
|
|
2047 (unless (car (ebrowse-known-class-trees-buffer-list))
|
|
2048 (error "No tree buffers"))
|
|
2049 (let (select buffer window)
|
|
2050 (save-window-excursion
|
|
2051 (save-window-excursion (ebrowse-list-tree-buffers))
|
|
2052 (setq window (Electric-pop-up-window "*Tree Buffers*")
|
|
2053 buffer (window-buffer window))
|
|
2054 (shrink-window-if-larger-than-buffer window)
|
|
2055 (unwind-protect
|
|
2056 (progn
|
|
2057 (set-buffer buffer)
|
|
2058 (ebrowse-electric-list-mode)
|
|
2059 (setq select
|
|
2060 (catch 'ebrowse-electric-list-select
|
|
2061 (message "<<< Press Space to bury the list >>>")
|
|
2062 (let ((first (progn (goto-char (point-min))
|
|
2063 (forward-line 2)
|
|
2064 (point)))
|
|
2065 (last (progn (goto-char (point-max))
|
|
2066 (forward-line -1)
|
|
2067 (point)))
|
|
2068 (goal-column 0))
|
|
2069 (goto-char first)
|
|
2070 (Electric-command-loop 'ebrowse-electric-list-select
|
|
2071 nil
|
|
2072 t
|
|
2073 'ebrowse-electric-list-looper
|
|
2074 (cons first last))))))
|
|
2075 (set-buffer buffer)
|
|
2076 (bury-buffer buffer)
|
|
2077 (message nil)))
|
|
2078 (when select
|
|
2079 (set-buffer buffer)
|
|
2080 (setq select (ebrowse-electric-get-buffer select)))
|
|
2081 (kill-buffer buffer)
|
|
2082 select))
|
|
2083
|
|
2084
|
|
2085 (defun ebrowse-electric-list-looper (state condition)
|
|
2086 "Prevent cursor from moving beyond the buffer end.
|
|
2087 Don't let it move into the title lines.
|
|
2088 See 'Electric-command-loop' for a description of STATE and CONDITION."
|
|
2089 (cond ((and condition
|
|
2090 (not (memq (car condition)
|
|
2091 '(buffer-read-only end-of-buffer
|
|
2092 beginning-of-buffer))))
|
|
2093 (signal (car condition) (cdr condition)))
|
|
2094 ((< (point) (car state))
|
|
2095 (goto-char (point-min))
|
|
2096 (forward-line 2))
|
|
2097 ((> (point) (cdr state))
|
|
2098 (goto-char (point-max))
|
|
2099 (forward-line -1)
|
|
2100 (if (pos-visible-in-window-p (point-max))
|
|
2101 (recenter -1)))))
|
|
2102
|
|
2103
|
|
2104 (defun ebrowse-electric-list-undefined ()
|
|
2105 "Function called for keys that are undefined."
|
|
2106 (interactive)
|
|
2107 (message "Type C-h for help, ? for commands, q to quit, Space to select.")
|
|
2108 (sit-for 4))
|
|
2109
|
|
2110
|
|
2111 (defun ebrowse-electric-list-quit ()
|
|
2112 "Discard the buffer list."
|
|
2113 (interactive)
|
|
2114 (throw 'ebrowse-electric-list-select nil))
|
|
2115
|
|
2116
|
|
2117 (defun ebrowse-electric-list-select ()
|
|
2118 "Select a buffer from the buffer list."
|
|
2119 (interactive)
|
|
2120 (throw 'ebrowse-electric-list-select (point)))
|
|
2121
|
|
2122
|
|
2123 (defun ebrowse-electric-get-buffer (point)
|
|
2124 "Get a buffer corresponding to the line POINT is in."
|
|
2125 (let ((index (- (count-lines (point-min) point) 2)))
|
|
2126 (nth index (ebrowse-known-class-trees-buffer-list))))
|
|
2127
|
|
2128
|
|
2129 ;;; View a buffer for a tree.
|
|
2130
|
|
2131 (defun ebrowse-electric-view-buffer ()
|
|
2132 "View buffer point is on."
|
|
2133 (interactive)
|
|
2134 (let ((buffer (ebrowse-electric-get-buffer (point))))
|
|
2135 (cond (buffer
|
|
2136 (view-buffer buffer))
|
|
2137 (t
|
|
2138 (error "Buffer no longer exists")))))
|
|
2139
|
|
2140
|
|
2141 (defun ebrowse-choose-from-browser-buffers ()
|
|
2142 "Read a browser buffer name from the minibuffer and return that buffer."
|
|
2143 (let* ((buffers (ebrowse-known-class-trees-buffer-list)))
|
|
2144 (if buffers
|
|
2145 (if (not (second buffers))
|
|
2146 (first buffers)
|
|
2147 (or (ebrowse-electric-choose-tree) (error "No tree buffer")))
|
|
2148 (let* ((insert-default-directory t)
|
|
2149 (file (read-file-name "Find tree: " nil nil t)))
|
|
2150 (save-excursion
|
|
2151 (find-file file))
|
|
2152 (find-buffer-visiting file)))))
|
|
2153
|
|
2154
|
|
2155 ;;; Member buffers
|
|
2156
|
|
2157 (unless ebrowse-member-mode-map
|
|
2158 (let ((map (make-keymap)))
|
|
2159 (setf ebrowse-member-mode-map map)
|
|
2160 (suppress-keymap map)
|
|
2161
|
30554
e56649429a8b
(ebrowse-tree-mode-map): Use display-mouse-p instead of window-system.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
2162 (when (display-mouse-p)
|
28523
|
2163 (define-key map [down-mouse-3] 'ebrowse-member-mouse-3)
|
|
2164 (define-key map [mouse-2] 'ebrowse-member-mouse-2))
|
|
2165
|
|
2166 (let ((map1 (make-sparse-keymap)))
|
|
2167 (suppress-keymap map1 t)
|
|
2168 (define-key map "C" map1)
|
|
2169 (define-key map1 "b" 'ebrowse-switch-member-buffer-to-base-class)
|
|
2170 (define-key map1 "c" 'ebrowse-switch-member-buffer-to-any-class)
|
|
2171 (define-key map1 "d" 'ebrowse-switch-member-buffer-to-derived-class)
|
|
2172 (define-key map1 "n" 'ebrowse-switch-member-buffer-to-next-sibling-class)
|
|
2173 (define-key map1 "p" 'ebrowse-switch-member-buffer-to-previous-sibling-class))
|
47929
|
2174
|
28523
|
2175 (let ((map1 (make-sparse-keymap)))
|
|
2176 (suppress-keymap map1 t)
|
|
2177 (define-key map "D" map1)
|
|
2178 (define-key map1 "a" 'ebrowse-toggle-member-attributes-display)
|
|
2179 (define-key map1 "b" 'ebrowse-toggle-base-class-display)
|
|
2180 (define-key map1 "f" 'ebrowse-freeze-member-buffer)
|
|
2181 (define-key map1 "l" 'ebrowse-toggle-long-short-display)
|
|
2182 (define-key map1 "r" 'ebrowse-toggle-regexp-display)
|
|
2183 (define-key map1 "w" 'ebrowse-set-member-buffer-column-width))
|
47929
|
2184
|
28523
|
2185 (let ((map1 (make-sparse-keymap)))
|
|
2186 (suppress-keymap map1 t)
|
|
2187 (define-key map "F" map1)
|
|
2188 (let ((map2 (make-sparse-keymap)))
|
|
2189 (suppress-keymap map2 t)
|
|
2190 (define-key map1 "a" map2)
|
|
2191 (define-key map2 "i" 'ebrowse-toggle-private-member-filter)
|
|
2192 (define-key map2 "o" 'ebrowse-toggle-protected-member-filter)
|
|
2193 (define-key map2 "u" 'ebrowse-toggle-public-member-filter))
|
|
2194 (define-key map1 "c" 'ebrowse-toggle-const-member-filter)
|
|
2195 (define-key map1 "i" 'ebrowse-toggle-inline-member-filter)
|
|
2196 (define-key map1 "p" 'ebrowse-toggle-pure-member-filter)
|
|
2197 (define-key map1 "r" 'ebrowse-remove-all-member-filters)
|
|
2198 (define-key map1 "v" 'ebrowse-toggle-virtual-member-filter))
|
47929
|
2199
|
28523
|
2200 (let ((map1 (make-sparse-keymap)))
|
|
2201 (suppress-keymap map1 t)
|
|
2202 (define-key map "L" map1)
|
|
2203 (define-key map1 "d" 'ebrowse-display-friends-member-list)
|
|
2204 (define-key map1 "f" 'ebrowse-display-function-member-list)
|
|
2205 (define-key map1 "F" 'ebrowse-display-static-functions-member-list)
|
|
2206 (define-key map1 "n" 'ebrowse-display-next-member-list)
|
|
2207 (define-key map1 "p" 'ebrowse-display-previous-member-list)
|
|
2208 (define-key map1 "t" 'ebrowse-display-types-member-list)
|
|
2209 (define-key map1 "v" 'ebrowse-display-variables-member-list)
|
|
2210 (define-key map1 "V" 'ebrowse-display-static-variables-member-list))
|
47929
|
2211
|
28523
|
2212 (let ((map1 (make-sparse-keymap)))
|
|
2213 (suppress-keymap map1 t)
|
|
2214 (define-key map "G" map1)
|
|
2215 (define-key map1 "m" 'ebrowse-goto-visible-member/all-member-lists)
|
|
2216 (define-key map1 "n" 'ebrowse-repeat-member-search)
|
|
2217 (define-key map1 "v" 'ebrowse-goto-visible-member))
|
47929
|
2218
|
28523
|
2219 (define-key map "f" 'ebrowse-find-member-declaration)
|
|
2220 (define-key map "m" 'ebrowse-switch-to-next-member-buffer)
|
|
2221 (define-key map "q" 'bury-buffer)
|
|
2222 (define-key map "t" 'ebrowse-show-displayed-class-in-tree)
|
|
2223 (define-key map "v" 'ebrowse-view-member-declaration)
|
|
2224 (define-key map " " 'ebrowse-view-member-definition)
|
|
2225 (define-key map "?" 'describe-mode)
|
|
2226 (define-key map "\C-i" 'ebrowse-pop-from-member-to-tree-buffer)
|
|
2227 (define-key map "\C-l" 'ebrowse-redisplay-member-buffer)
|
|
2228 (define-key map "\C-m" 'ebrowse-find-member-definition)))
|
|
2229
|
|
2230
|
|
2231
|
|
2232 ;;; Member mode
|
|
2233
|
52529
|
2234 ;;;###autoload
|
28523
|
2235 (defun ebrowse-member-mode ()
|
|
2236 "Major mode for Ebrowse member buffers.
|
|
2237
|
|
2238 \\{ebrowse-member-mode-map}"
|
|
2239 (kill-all-local-variables)
|
|
2240 (use-local-map ebrowse-member-mode-map)
|
|
2241 (setq major-mode 'ebrowse-member-mode)
|
84920
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2242 (mapc 'make-local-variable
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2243 '(ebrowse--decl-column ;display column
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2244 ebrowse--n-columns ;number of short columns
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2245 ebrowse--column-width ;width of columns above
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2246 ebrowse--show-inherited-flag ;include inherited members?
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2247 ebrowse--filters ;public, protected, private
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2248 ebrowse--accessor ;vars, functions, friends
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2249 ebrowse--displayed-class ;class displayed
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2250 ebrowse--long-display-flag ;display with regexps?
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2251 ebrowse--source-regexp-flag ;show source regexp?
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2252 ebrowse--attributes-flag ;show `virtual' and `inline'
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2253 ebrowse--member-list ;list of members displayed
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2254 ebrowse--tree ;the class tree
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2255 ebrowse--member-mode-strings ;part of mode line
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2256 ebrowse--tags-file-name ;
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2257 ebrowse--header
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2258 ebrowse--tree-obarray
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2259 ebrowse--virtual-display-flag
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2260 ebrowse--inline-display-flag
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2261 ebrowse--const-display-flag
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2262 ebrowse--pure-display-flag
|
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2263 ebrowse--frozen-flag)) ;buffer not automagically reused
|
28548
|
2264 (setq mode-name "Ebrowse-Members"
|
|
2265 mode-line-buffer-identification
|
|
2266 (propertized-buffer-identification "C++ Members")
|
28523
|
2267 buffer-read-only t
|
|
2268 ebrowse--long-display-flag nil
|
|
2269 ebrowse--attributes-flag t
|
|
2270 ebrowse--show-inherited-flag t
|
|
2271 ebrowse--source-regexp-flag nil
|
|
2272 ebrowse--filters [0 1 2]
|
|
2273 ebrowse--decl-column ebrowse-default-declaration-column
|
|
2274 ebrowse--column-width ebrowse-default-column-width
|
|
2275 ebrowse--virtual-display-flag nil
|
|
2276 ebrowse--inline-display-flag nil
|
|
2277 ebrowse--const-display-flag nil
|
|
2278 ebrowse--pure-display-flag nil)
|
|
2279 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))
|
62772
|
2280 (run-mode-hooks 'ebrowse-member-mode-hook))
|
28523
|
2281
|
|
2282
|
|
2283
|
|
2284 ;;; Member mode mode line
|
|
2285
|
|
2286 (defsubst ebrowse-class-name-displayed-in-member-buffer ()
|
|
2287 "Return the name of the class displayed in the member buffer."
|
|
2288 (ebrowse-cs-name (ebrowse-ts-class ebrowse--displayed-class)))
|
|
2289
|
|
2290
|
|
2291 (defsubst ebrowse-member-list-name ()
|
|
2292 "Return a string describing what is displayed in the member buffer."
|
|
2293 (get ebrowse--accessor (if (ebrowse-globals-tree-p ebrowse--displayed-class)
|
|
2294 'ebrowse-global-title
|
|
2295 'ebrowse-title)))
|
|
2296
|
|
2297
|
|
2298 (defun ebrowse-update-member-buffer-mode-line ()
|
|
2299 "Update the mode line of member buffers."
|
|
2300 (let* ((name (when ebrowse--frozen-flag
|
|
2301 (concat (ebrowse-class-name-displayed-in-member-buffer)
|
|
2302 " ")))
|
|
2303 (ident (concat name (ebrowse-member-list-name))))
|
28548
|
2304 (setq mode-line-buffer-identification
|
|
2305 (propertized-buffer-identification ident))
|
28523
|
2306 (ebrowse-rename-buffer (if name ident ebrowse-member-buffer-name))
|
|
2307 (force-mode-line-update)))
|
|
2308
|
|
2309
|
|
2310 ;;; Misc member buffer commands
|
|
2311
|
|
2312 (defun ebrowse-freeze-member-buffer ()
|
|
2313 "Toggle frozen status of current buffer."
|
|
2314 (interactive)
|
|
2315 (setq ebrowse--frozen-flag (not ebrowse--frozen-flag))
|
|
2316 (ebrowse-redisplay-member-buffer))
|
|
2317
|
|
2318
|
|
2319 (defun ebrowse-show-displayed-class-in-tree (arg)
|
|
2320 "Show the currently displayed class in the tree window.
|
|
2321 With prefix ARG, switch to the tree buffer else pop to it."
|
|
2322 (interactive "P")
|
|
2323 (let ((class-name (ebrowse-class-name-displayed-in-member-buffer)))
|
|
2324 (when (ebrowse-pop-from-member-to-tree-buffer arg)
|
|
2325 (ebrowse-read-class-name-and-go class-name))))
|
|
2326
|
|
2327
|
|
2328 (defun ebrowse-set-member-buffer-column-width ()
|
|
2329 "Set the column width of the member display.
|
|
2330 The new width is read from the minibuffer."
|
|
2331 (interactive)
|
62402
|
2332 (let ((width (string-to-number
|
28523
|
2333 (read-from-minibuffer
|
|
2334 (concat "Column width ("
|
|
2335 (int-to-string (if ebrowse--long-display-flag
|
|
2336 ebrowse--decl-column
|
|
2337 ebrowse--column-width))
|
|
2338 "): ")))))
|
|
2339 (when (plusp width)
|
|
2340 (if ebrowse--long-display-flag
|
|
2341 (setq ebrowse--decl-column width)
|
|
2342 (setq ebrowse--column-width width))
|
|
2343 (ebrowse-redisplay-member-buffer))))
|
|
2344
|
|
2345
|
|
2346 (defun ebrowse-pop-from-member-to-tree-buffer (arg)
|
|
2347 "Pop from a member buffer to the matching tree buffer.
|
|
2348 Switch to the buffer if prefix ARG. If no tree buffer exists,
|
|
2349 make one."
|
|
2350 (interactive "P")
|
|
2351 (let ((buf (or (get-buffer (ebrowse-frozen-tree-buffer-name
|
|
2352 ebrowse--tags-file-name))
|
|
2353 (get-buffer ebrowse-tree-buffer-name)
|
|
2354 (ebrowse-create-tree-buffer ebrowse--tree
|
|
2355 ebrowse--tags-file-name
|
|
2356 ebrowse--header
|
|
2357 ebrowse--tree-obarray
|
|
2358 'pop))))
|
|
2359 (and buf
|
|
2360 (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf))
|
|
2361 buf))
|
|
2362
|
|
2363
|
|
2364
|
|
2365 ;;; Switching between member lists
|
|
2366
|
|
2367 (defun ebrowse-display-member-list-for-accessor (accessor)
|
|
2368 "Switch the member buffer to display the member list for ACCESSOR."
|
|
2369 (setf ebrowse--accessor accessor
|
|
2370 ebrowse--member-list (funcall accessor ebrowse--displayed-class))
|
|
2371 (ebrowse-redisplay-member-buffer))
|
|
2372
|
|
2373
|
|
2374 (defun ebrowse-cyclic-display-next/previous-member-list (incr)
|
|
2375 "Switch buffer to INCR'th next/previous list of members."
|
|
2376 (let ((index (ebrowse-position ebrowse--accessor
|
|
2377 ebrowse-member-list-accessors)))
|
|
2378 (setf ebrowse--accessor
|
|
2379 (cond ((plusp incr)
|
|
2380 (or (nth (1+ index)
|
|
2381 ebrowse-member-list-accessors)
|
|
2382 (first ebrowse-member-list-accessors)))
|
|
2383 ((minusp incr)
|
|
2384 (or (and (>= (decf index) 0)
|
|
2385 (nth index
|
|
2386 ebrowse-member-list-accessors))
|
|
2387 (first (last ebrowse-member-list-accessors))))))
|
|
2388 (ebrowse-display-member-list-for-accessor ebrowse--accessor)))
|
|
2389
|
|
2390
|
|
2391 (defun ebrowse-display-next-member-list ()
|
|
2392 "Switch buffer to next member list."
|
|
2393 (interactive)
|
|
2394 (ebrowse-cyclic-display-next/previous-member-list 1))
|
|
2395
|
|
2396
|
|
2397 (defun ebrowse-display-previous-member-list ()
|
|
2398 "Switch buffer to previous member list."
|
|
2399 (interactive)
|
|
2400 (ebrowse-cyclic-display-next/previous-member-list -1))
|
|
2401
|
|
2402
|
|
2403 (defun ebrowse-display-function-member-list ()
|
|
2404 "Display the list of member functions."
|
|
2405 (interactive)
|
|
2406 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions))
|
|
2407
|
|
2408
|
|
2409 (defun ebrowse-display-variables-member-list ()
|
|
2410 "Display the list of member variables."
|
|
2411 (interactive)
|
|
2412 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables))
|
|
2413
|
|
2414
|
|
2415 (defun ebrowse-display-static-variables-member-list ()
|
|
2416 "Display the list of static member variables."
|
|
2417 (interactive)
|
|
2418 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables))
|
|
2419
|
|
2420
|
|
2421 (defun ebrowse-display-static-functions-member-list ()
|
|
2422 "Display the list of static member functions."
|
|
2423 (interactive)
|
|
2424 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions))
|
|
2425
|
|
2426
|
|
2427 (defun ebrowse-display-friends-member-list ()
|
|
2428 "Display the list of friends."
|
|
2429 (interactive)
|
|
2430 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends))
|
|
2431
|
|
2432
|
|
2433 (defun ebrowse-display-types-member-list ()
|
|
2434 "Display the list of types."
|
|
2435 (interactive)
|
|
2436 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types))
|
|
2437
|
|
2438
|
|
2439
|
|
2440 ;;; Filters and other display attributes
|
|
2441
|
|
2442 (defun ebrowse-toggle-member-attributes-display ()
|
|
2443 "Toggle display of `virtual', `inline', `const' etc."
|
|
2444 (interactive)
|
|
2445 (setq ebrowse--attributes-flag (not ebrowse--attributes-flag))
|
|
2446 (ebrowse-redisplay-member-buffer))
|
|
2447
|
|
2448
|
|
2449 (defun ebrowse-toggle-base-class-display ()
|
|
2450 "Toggle the display of members inherited from base classes."
|
|
2451 (interactive)
|
|
2452 (setf ebrowse--show-inherited-flag (not ebrowse--show-inherited-flag))
|
|
2453 (ebrowse-redisplay-member-buffer))
|
|
2454
|
|
2455
|
|
2456 (defun ebrowse-toggle-pure-member-filter ()
|
|
2457 "Toggle display of pure virtual members."
|
|
2458 (interactive)
|
|
2459 (setf ebrowse--pure-display-flag (not ebrowse--pure-display-flag))
|
|
2460 (ebrowse-redisplay-member-buffer))
|
|
2461
|
|
2462
|
|
2463 (defun ebrowse-toggle-const-member-filter ()
|
|
2464 "Toggle display of const members."
|
|
2465 (interactive)
|
|
2466 (setf ebrowse--const-display-flag (not ebrowse--const-display-flag))
|
|
2467 (ebrowse-redisplay-member-buffer))
|
|
2468
|
|
2469
|
|
2470 (defun ebrowse-toggle-inline-member-filter ()
|
|
2471 "Toggle display of inline members."
|
|
2472 (interactive)
|
|
2473 (setf ebrowse--inline-display-flag (not ebrowse--inline-display-flag))
|
|
2474 (ebrowse-redisplay-member-buffer))
|
|
2475
|
|
2476
|
|
2477 (defun ebrowse-toggle-virtual-member-filter ()
|
|
2478 "Toggle display of virtual members."
|
|
2479 (interactive)
|
|
2480 (setf ebrowse--virtual-display-flag (not ebrowse--virtual-display-flag))
|
|
2481 (ebrowse-redisplay-member-buffer))
|
|
2482
|
|
2483
|
|
2484 (defun ebrowse-remove-all-member-filters ()
|
|
2485 "Remove all filters."
|
|
2486 (interactive)
|
|
2487 (dotimes (i 3)
|
|
2488 (aset ebrowse--filters i i))
|
|
2489 (setq ebrowse--pure-display-flag nil
|
|
2490 ebrowse--const-display-flag nil
|
|
2491 ebrowse--virtual-display-flag nil
|
|
2492 ebrowse--inline-display-flag nil)
|
|
2493 (ebrowse-redisplay-member-buffer))
|
|
2494
|
|
2495
|
|
2496 (defun ebrowse-toggle-public-member-filter ()
|
|
2497 "Toggle visibility of public members."
|
|
2498 (interactive)
|
|
2499 (ebrowse-set-member-access-visibility 0)
|
|
2500 (ebrowse-redisplay-member-buffer))
|
|
2501
|
|
2502
|
|
2503 (defun ebrowse-toggle-protected-member-filter ()
|
|
2504 "Toggle visibility of protected members."
|
|
2505 (interactive)
|
|
2506 (ebrowse-set-member-access-visibility 1)
|
|
2507 (ebrowse-redisplay-member-buffer))
|
|
2508
|
|
2509
|
|
2510 (defun ebrowse-toggle-private-member-filter ()
|
|
2511 "Toggle visibility of private members."
|
|
2512 (interactive)
|
|
2513 (ebrowse-set-member-access-visibility 2)
|
|
2514 (ebrowse-redisplay-member-buffer))
|
|
2515
|
|
2516
|
|
2517 (defun ebrowse-set-member-access-visibility (vis)
|
|
2518 (setf (aref ebrowse--filters vis)
|
|
2519 (if (aref ebrowse--filters vis) nil vis)))
|
|
2520
|
|
2521
|
|
2522 (defun ebrowse-toggle-long-short-display ()
|
|
2523 "Toggle between long and short display form of member buffers."
|
|
2524 (interactive)
|
|
2525 (setf ebrowse--long-display-flag (not ebrowse--long-display-flag))
|
|
2526 (ebrowse-redisplay-member-buffer))
|
|
2527
|
|
2528
|
|
2529 (defun ebrowse-toggle-regexp-display ()
|
|
2530 "Toggle declaration/definition regular expression display.
|
|
2531 Used in member buffers showing the long display form."
|
|
2532 (interactive)
|
|
2533 (setf ebrowse--source-regexp-flag (not ebrowse--source-regexp-flag))
|
|
2534 (ebrowse-redisplay-member-buffer))
|
|
2535
|
|
2536
|
|
2537
|
|
2538 ;;; Viewing/finding members
|
|
2539
|
|
2540 (defun ebrowse-find-member-definition (&optional prefix)
|
|
2541 "Find the file containing a member definition.
|
|
2542 With PREFIX 4. find file in another window, with prefix 5
|
|
2543 find file in another frame."
|
|
2544 (interactive "p")
|
|
2545 (ebrowse-view/find-member-declaration/definition prefix nil t))
|
|
2546
|
|
2547
|
|
2548 (defun ebrowse-view-member-definition (prefix)
|
|
2549 "View the file containing a member definition.
|
|
2550 With PREFIX 4. find file in another window, with prefix 5
|
|
2551 find file in another frame."
|
|
2552 (interactive "p")
|
|
2553 (ebrowse-view/find-member-declaration/definition prefix t t))
|
|
2554
|
|
2555
|
|
2556 (defun ebrowse-find-member-declaration (prefix)
|
|
2557 "Find the file containing a member's declaration.
|
|
2558 With PREFIX 4. find file in another window, with prefix 5
|
|
2559 find file in another frame."
|
|
2560 (interactive "p")
|
|
2561 (ebrowse-view/find-member-declaration/definition prefix nil))
|
|
2562
|
|
2563
|
|
2564 (defun ebrowse-view-member-declaration (prefix)
|
|
2565 "View the file containing a member's declaration.
|
|
2566 With PREFIX 4. find file in another window, with prefix 5
|
|
2567 find file in another frame."
|
|
2568 (interactive "p")
|
|
2569 (ebrowse-view/find-member-declaration/definition prefix t))
|
|
2570
|
|
2571
|
|
2572 (defun* ebrowse-view/find-member-declaration/definition
|
|
2573 (prefix view &optional definition info header tags-file-name)
|
|
2574 "Find or view a member declaration or definition.
|
|
2575 With PREFIX 4. find file in another window, with prefix 5
|
|
2576 find file in another frame.
|
|
2577 DEFINITION non-nil means find the definition, otherwise find the
|
|
2578 declaration.
|
|
2579 INFO is a list (TREE ACCESSOR MEMBER) describing the member to
|
|
2580 search.
|
28816
|
2581 TAGS-FILE-NAME is the file name of the BROWSE file."
|
28523
|
2582 (unless header
|
|
2583 (setq header ebrowse--header))
|
|
2584 (unless tags-file-name
|
|
2585 (setq tags-file-name ebrowse--tags-file-name))
|
|
2586 (let (tree member accessor file on-class
|
|
2587 (where (if (= prefix 4) 'other-window
|
|
2588 (if (= prefix 5) 'other-frame 'this-window))))
|
|
2589 ;; If not given as parameters, get the necessary information
|
|
2590 ;; out of the member buffer.
|
|
2591 (if info
|
|
2592 (setq tree (first info)
|
|
2593 accessor (second info)
|
|
2594 member (third info))
|
|
2595 (multiple-value-setq (tree member on-class)
|
102532
|
2596 (values-list (ebrowse-member-info-from-point)))
|
28523
|
2597 (setq accessor ebrowse--accessor))
|
|
2598 ;; View/find class if on a line containing a class name.
|
|
2599 (when on-class
|
|
2600 (return-from ebrowse-view/find-member-declaration/definition
|
|
2601 (ebrowse-view/find-file-and-search-pattern
|
|
2602 (ebrowse-ts-class tree)
|
|
2603 (list ebrowse--header (ebrowse-ts-class tree) nil)
|
|
2604 (ebrowse-cs-file (ebrowse-ts-class tree))
|
|
2605 tags-file-name view where)))
|
|
2606 ;; For some member lists, it doesn't make sense to search for
|
|
2607 ;; a definition. If this is requested, silently search for the
|
|
2608 ;; declaration.
|
|
2609 (when (and definition
|
|
2610 (eq accessor 'ebrowse-ts-member-variables))
|
|
2611 (setq definition nil))
|
|
2612 ;; Construct a suitable `browse' struct for definitions.
|
|
2613 (when definition
|
|
2614 (setf member (make-ebrowse-ms
|
|
2615 :name (ebrowse-ms-name member)
|
|
2616 :file (ebrowse-ms-definition-file member)
|
|
2617 :pattern (ebrowse-ms-definition-pattern
|
|
2618 member)
|
|
2619 :flags (ebrowse-ms-flags member)
|
|
2620 :point (ebrowse-ms-definition-point
|
|
2621 member))))
|
|
2622 ;; When no file information in member, use that of the class
|
|
2623 (setf file (or (ebrowse-ms-file member)
|
|
2624 (if definition
|
|
2625 (ebrowse-cs-source-file (ebrowse-ts-class tree))
|
|
2626 (ebrowse-cs-file (ebrowse-ts-class tree)))))
|
|
2627 ;; When we have no regular expressions in the database the only
|
|
2628 ;; indication that the parser hasn't seen a definition/declaration
|
|
2629 ;; is that the search start point will be zero.
|
|
2630 (if (or (null file) (zerop (ebrowse-ms-point member)))
|
|
2631 (if (y-or-n-p (concat "No information about "
|
|
2632 (if definition "definition" "declaration")
|
|
2633 ". Search for "
|
|
2634 (if definition "declaration" "definition")
|
|
2635 " of `"
|
|
2636 (ebrowse-ms-name member)
|
|
2637 "'? "))
|
|
2638 (progn
|
|
2639 (message nil)
|
|
2640 ;; Recurse with new info.
|
|
2641 (ebrowse-view/find-member-declaration/definition
|
|
2642 prefix view (not definition) info header tags-file-name))
|
|
2643 (error "Search canceled"))
|
|
2644 ;; Find that thing.
|
|
2645 (ebrowse-view/find-file-and-search-pattern
|
|
2646 (make-ebrowse-bs :name (ebrowse-ms-name member)
|
|
2647 :pattern (ebrowse-ms-pattern member)
|
|
2648 :file (ebrowse-ms-file member)
|
|
2649 :flags (ebrowse-ms-flags member)
|
|
2650 :point (ebrowse-ms-point member))
|
|
2651 (list header member accessor)
|
|
2652 file
|
|
2653 tags-file-name
|
|
2654 view
|
|
2655 where))))
|
|
2656
|
|
2657
|
|
2658
|
|
2659 ;;; Drawing the member buffer
|
|
2660
|
|
2661 (defun ebrowse-redisplay-member-buffer ()
|
|
2662 "Force buffer redisplay."
|
|
2663 (interactive)
|
|
2664 (let ((display-fn (if ebrowse--long-display-flag
|
|
2665 'ebrowse-draw-member-long-fn
|
|
2666 'ebrowse-draw-member-short-fn)))
|
|
2667 (ebrowse-output
|
|
2668 (erase-buffer)
|
|
2669 ;; Show this class
|
|
2670 (ebrowse-draw-member-buffer-class-line)
|
|
2671 (funcall display-fn ebrowse--member-list ebrowse--displayed-class)
|
|
2672 ;; Show inherited members if corresponding switch is on
|
|
2673 (when ebrowse--show-inherited-flag
|
|
2674 (dolist (super (ebrowse-base-classes ebrowse--displayed-class))
|
|
2675 (goto-char (point-max))
|
|
2676 (insert (if (bolp) "\n\n" "\n"))
|
|
2677 (ebrowse-draw-member-buffer-class-line super)
|
|
2678 (funcall display-fn (funcall ebrowse--accessor super) super)))
|
|
2679 (ebrowse-update-member-buffer-mode-line))))
|
|
2680
|
|
2681
|
|
2682 (defun ebrowse-draw-member-buffer-class-line (&optional class)
|
|
2683 "Display the title line for a class section in the member buffer.
|
|
2684 CLASS non-nil means display that class' title. Otherwise use
|
|
2685 the class cursor is on."
|
|
2686 (let ((start (point))
|
|
2687 (tree (or class ebrowse--displayed-class))
|
47929
|
2688 class-name-start
|
28523
|
2689 class-name-end)
|
|
2690 (insert "class ")
|
|
2691 (setq class-name-start (point))
|
|
2692 (insert (ebrowse-qualified-class-name (ebrowse-ts-class tree)))
|
|
2693 (when (ebrowse-template-p (ebrowse-ts-class tree))
|
|
2694 (insert "<>"))
|
|
2695 (setq class-name-end (point))
|
|
2696 (insert ":\n\n")
|
63448
|
2697 (ebrowse-set-face start (point) 'ebrowse-member-class)
|
28523
|
2698 (add-text-properties
|
|
2699 class-name-start class-name-end
|
|
2700 '(ebrowse-what class-name
|
|
2701 mouse-face highlight
|
|
2702 help-echo "mouse-3: menu"))
|
|
2703 (put-text-property start class-name-end 'ebrowse-tree tree)))
|
|
2704
|
|
2705
|
|
2706 (defun ebrowse-display-member-buffer (list &optional stand-alone class)
|
|
2707 "Start point for member buffer creation.
|
|
2708 LIST is the member list to display. STAND-ALONE non-nil
|
|
2709 means the member buffer is standalone. CLASS is its class."
|
|
2710 (let* ((classes ebrowse--tree-obarray)
|
|
2711 (tree ebrowse--tree)
|
|
2712 (tags-file-name ebrowse--tags-file-name)
|
|
2713 (header ebrowse--header)
|
|
2714 temp-buffer-setup-hook
|
|
2715 (temp-buffer (get-buffer ebrowse-member-buffer-name)))
|
|
2716 ;; Get the class description from the name the cursor
|
|
2717 ;; is on if not specified as an argument.
|
|
2718 (unless class
|
|
2719 (setq class (ebrowse-tree-at-point)))
|
71790
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2720 (save-selected-window
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2721 (if temp-buffer
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2722 (pop-to-buffer temp-buffer)
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2723 (pop-to-buffer (get-buffer-create ebrowse-member-buffer-name))
|
28523
|
2724 ;; If new buffer, set the mode and initial values of locals
|
71790
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2725 (ebrowse-member-mode))
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2726 ;; Set local variables
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2727 (setq ebrowse--member-list (funcall list class)
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2728 ebrowse--displayed-class class
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2729 ebrowse--accessor list
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2730 ebrowse--tree-obarray classes
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2731 ebrowse--frozen-flag stand-alone
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2732 ebrowse--tags-file-name tags-file-name
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2733 ebrowse--header header
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2734 ebrowse--tree tree
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2735 buffer-read-only t)
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2736 (ebrowse-redisplay-member-buffer)
|
8a30c071b5fb
* progmodes/ebrowse.el (ebrowse-display-member-buffer): Avoid
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2737 (current-buffer))))
|
28523
|
2738
|
|
2739
|
|
2740 (defun ebrowse-member-display-p (member)
|
|
2741 "Return t if MEMBER must be displayed under the current filter settings."
|
|
2742 (if (and (aref ebrowse--filters (ebrowse-ms-visibility member))
|
|
2743 (or (null ebrowse--const-display-flag)
|
|
2744 (ebrowse-const-p member))
|
|
2745 (or (null ebrowse--inline-display-flag)
|
|
2746 (ebrowse-inline-p member))
|
|
2747 (or (null ebrowse--pure-display-flag)
|
|
2748 (ebrowse-bs-p member))
|
|
2749 (or (null ebrowse--virtual-display-flag)
|
|
2750 (ebrowse-virtual-p member)))
|
|
2751 member))
|
|
2752
|
|
2753
|
|
2754 (defun ebrowse-draw-member-attributes (member)
|
|
2755 "Insert a string for the attributes of MEMBER."
|
|
2756 (insert (if (ebrowse-template-p member) "T" "-")
|
|
2757 (if (ebrowse-extern-c-p member) "C" "-")
|
|
2758 (if (ebrowse-virtual-p member) "v" "-")
|
|
2759 (if (ebrowse-inline-p member) "i" "-")
|
|
2760 (if (ebrowse-const-p member) "c" "-")
|
|
2761 (if (ebrowse-pure-virtual-p member) "0" "-")
|
|
2762 (if (ebrowse-mutable-p member) "m" "-")
|
|
2763 (if (ebrowse-explicit-p member) "e" "-")
|
|
2764 (if (ebrowse-throw-list-p member) "t" "-")))
|
|
2765
|
|
2766
|
|
2767 (defun ebrowse-draw-member-regexp (member-struc)
|
|
2768 "Insert a string for the regular expression matching MEMBER-STRUC."
|
|
2769 (let ((pattern (if ebrowse--source-regexp-flag
|
|
2770 (ebrowse-ms-definition-pattern
|
|
2771 member-struc)
|
|
2772 (ebrowse-ms-pattern member-struc))))
|
|
2773 (cond ((stringp pattern)
|
|
2774 (insert (ebrowse-trim-string pattern) "...\n")
|
|
2775 (beginning-of-line 0)
|
|
2776 (move-to-column (+ 4 ebrowse--decl-column))
|
|
2777 (while (re-search-forward "[ \t]+" nil t)
|
|
2778 (delete-region (match-beginning 0) (match-end 0))
|
|
2779 (insert " "))
|
|
2780 (beginning-of-line 2))
|
|
2781 (t
|
|
2782 (insert "[not recorded or unknown]\n")))))
|
|
2783
|
|
2784
|
|
2785 (defun ebrowse-draw-member-long-fn (member-list tree)
|
|
2786 "Display member buffer for MEMBER-LIST in long form.
|
|
2787 TREE is the class tree of MEMBER-LIST."
|
|
2788 (dolist (member-struc (mapcar 'ebrowse-member-display-p member-list))
|
|
2789 (when member-struc
|
|
2790 (let ((name (ebrowse-ms-name member-struc))
|
|
2791 (start (point)))
|
|
2792 ;; Insert member name truncated to the right length
|
|
2793 (insert (substring name
|
|
2794 0
|
|
2795 (min (length name)
|
|
2796 (1- ebrowse--decl-column))))
|
|
2797 (add-text-properties
|
|
2798 start (point)
|
|
2799 `(mouse-face highlight ebrowse-what member-name
|
|
2800 ebrowse-member ,member-struc
|
|
2801 ebrowse-tree ,tree
|
|
2802 help-echo "mouse-2: view definition; mouse-3: menu"))
|
|
2803 ;; Display virtual, inline, and const status
|
|
2804 (setf start (point))
|
|
2805 (indent-to ebrowse--decl-column)
|
|
2806 (put-text-property start (point) 'mouse-face nil)
|
|
2807 (when ebrowse--attributes-flag
|
|
2808 (let ((start (point)))
|
|
2809 (insert "<")
|
|
2810 (ebrowse-draw-member-attributes member-struc)
|
|
2811 (insert ">")
|
|
2812 (ebrowse-set-face start (point)
|
63448
|
2813 'ebrowse-member-attribute)))
|
28523
|
2814 (insert " ")
|
|
2815 (ebrowse-draw-member-regexp member-struc))))
|
|
2816 (insert "\n")
|
|
2817 (goto-char (point-min)))
|
|
2818
|
|
2819
|
|
2820 (defun ebrowse-draw-member-short-fn (member-list tree)
|
|
2821 "Display MEMBER-LIST in short form.
|
|
2822 TREE is the class tree in which the members are found."
|
|
2823 (let ((i 0)
|
|
2824 (column-width (+ ebrowse--column-width
|
|
2825 (if ebrowse--attributes-flag 12 0))))
|
|
2826 ;; Get the number of columns to draw.
|
|
2827 (setq ebrowse--n-columns
|
|
2828 (max 1 (/ (ebrowse-width-of-drawable-area) column-width)))
|
|
2829 (dolist (member (mapcar #'ebrowse-member-display-p member-list))
|
|
2830 (when member
|
|
2831 (let ((name (ebrowse-ms-name member))
|
|
2832 start-of-entry
|
|
2833 (start-of-column (point))
|
|
2834 start-of-name)
|
|
2835 (indent-to (* i column-width))
|
|
2836 (put-text-property start-of-column (point) 'mouse-face nil)
|
|
2837 (setq start-of-entry (point))
|
47929
|
2838 ;; Show various attributes
|
28523
|
2839 (when ebrowse--attributes-flag
|
|
2840 (insert "<")
|
|
2841 (ebrowse-draw-member-attributes member)
|
|
2842 (insert "> ")
|
|
2843 (ebrowse-set-face start-of-entry (point)
|
63448
|
2844 'ebrowse-member-attribute))
|
28523
|
2845 ;; insert member name truncated to column width
|
|
2846 (setq start-of-name (point))
|
|
2847 (insert (substring name 0
|
|
2848 (min (length name)
|
|
2849 (1- ebrowse--column-width))))
|
|
2850 ;; set text properties
|
|
2851 (add-text-properties
|
|
2852 start-of-name (point)
|
|
2853 `(ebrowse-what member-name
|
|
2854 ebrowse-member ,member
|
|
2855 mouse-face highlight
|
|
2856 ebrowse-tree ,tree
|
|
2857 help-echo "mouse-2: view definition; mouse-3: menu"))
|
|
2858 (incf i)
|
|
2859 (when (>= i ebrowse--n-columns)
|
|
2860 (setf i 0)
|
|
2861 (insert "\n")))))
|
|
2862 (when (plusp i)
|
|
2863 (insert "\n"))
|
|
2864 (goto-char (point-min))))
|
|
2865
|
|
2866
|
|
2867
|
|
2868 ;;; Killing members from tree
|
|
2869
|
|
2870 (defun ebrowse-member-info-from-point ()
|
|
2871 "Ger information about the member at point.
|
|
2872 The result has the form (TREE MEMBER NULL-P). TREE is the tree
|
|
2873 we're in, MEMBER is the member we're on. NULL-P is t if MEMBER
|
|
2874 is nil."
|
|
2875 (let ((tree (or (get-text-property (point) 'ebrowse-tree)
|
|
2876 (error "No information at point")))
|
|
2877 (member (get-text-property (point) 'ebrowse-member)))
|
|
2878 (list tree member (null member))))
|
|
2879
|
|
2880
|
|
2881
|
|
2882 ;;; Switching member buffer to display a selected member
|
|
2883
|
|
2884 (defun ebrowse-goto-visible-member/all-member-lists (prefix)
|
|
2885 "Position cursor on a member read from the minibuffer.
|
|
2886 With PREFIX, search all members in the tree. Otherwise consider
|
|
2887 only members visible in the buffer."
|
|
2888 (interactive "p")
|
|
2889 (ebrowse-ignoring-completion-case
|
|
2890 (let* ((completion-list (ebrowse-name/accessor-alist-for-class-members))
|
|
2891 (member (completing-read "Goto member: " completion-list nil t))
|
|
2892 (accessor (cdr (assoc member completion-list))))
|
|
2893 (unless accessor
|
|
2894 (error "`%s' not found" member))
|
|
2895 (unless (eq accessor ebrowse--accessor)
|
|
2896 (setf ebrowse--accessor accessor
|
|
2897 ebrowse--member-list (funcall accessor ebrowse--displayed-class))
|
|
2898 (ebrowse-redisplay-member-buffer))
|
|
2899 (ebrowse-move-point-to-member member))))
|
|
2900
|
|
2901
|
|
2902 (defun ebrowse-goto-visible-member (repeat)
|
|
2903 "Position point on a member.
|
|
2904 Read the member's name from the minibuffer. Consider only members
|
|
2905 visible in the member buffer.
|
|
2906 REPEAT non-nil means repeat the search that number of times."
|
|
2907 (interactive "p")
|
|
2908 (ebrowse-ignoring-completion-case
|
|
2909 ;; Read member name
|
|
2910 (let* ((completion-list (ebrowse-name/accessor-alist-for-visible-members))
|
|
2911 (member (completing-read "Goto member: " completion-list nil t)))
|
|
2912 (ebrowse-move-point-to-member member repeat))))
|
|
2913
|
|
2914
|
|
2915
|
|
2916 ;;; Searching a member in the member buffer
|
|
2917
|
|
2918 (defun ebrowse-repeat-member-search (repeat)
|
|
2919 "Repeat the last regular expression search.
|
|
2920 REPEAT, if specified, says repeat the search REPEAT times."
|
|
2921 (interactive "p")
|
|
2922 (unless ebrowse--last-regexp
|
|
2923 (error "No regular expression remembered"))
|
|
2924 ;; Skip over word the point is on
|
|
2925 (skip-chars-forward "^ \t\n")
|
|
2926 ;; Search for regexp from point
|
|
2927 (if (re-search-forward ebrowse--last-regexp nil t repeat)
|
|
2928 (progn
|
|
2929 (goto-char (match-beginning 0))
|
|
2930 (skip-chars-forward " \t\n"))
|
|
2931 ;; If not found above, repeat search from buffer start
|
|
2932 (goto-char (point-min))
|
|
2933 (if (re-search-forward ebrowse--last-regexp nil t)
|
|
2934 (progn
|
|
2935 (goto-char (match-beginning 0))
|
|
2936 (skip-chars-forward " \t\n"))
|
|
2937 (error "Not found"))))
|
|
2938
|
|
2939
|
|
2940 (defun* ebrowse-move-point-to-member (name &optional count &aux member)
|
|
2941 "Set point on member NAME in the member buffer
|
|
2942 COUNT, if specified, says search the COUNT'th member with the same name."
|
|
2943 (goto-char (point-min))
|
|
2944 (widen)
|
|
2945 (setq member
|
|
2946 (substring name 0 (min (length name) (1- ebrowse--column-width)))
|
|
2947 ebrowse--last-regexp
|
|
2948 (concat "[ \t\n]" (regexp-quote member) "[ \n\t]"))
|
|
2949 (if (re-search-forward ebrowse--last-regexp nil t count)
|
|
2950 (goto-char (1+ (match-beginning 0)))
|
|
2951 (error "Not found")))
|
|
2952
|
|
2953
|
|
2954
|
|
2955 ;;; Switching member buffer to another class.
|
|
2956
|
|
2957 (defun ebrowse-switch-member-buffer-to-other-class (title compl-list)
|
|
2958 "Switch member buffer to a class read from the minibuffer.
|
|
2959 Use TITLE as minibuffer prompt.
|
|
2960 COMPL-LIST is a completion list to use."
|
|
2961 (let* ((initial (unless (second compl-list)
|
|
2962 (first (first compl-list))))
|
|
2963 (class (or (ebrowse-completing-read-value title compl-list initial)
|
|
2964 (error "Not found"))))
|
|
2965 (setf ebrowse--displayed-class class
|
|
2966 ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
|
|
2967 (ebrowse-redisplay-member-buffer)))
|
|
2968
|
|
2969
|
|
2970 (defun ebrowse-switch-member-buffer-to-any-class ()
|
|
2971 "Switch member buffer to a class read from the minibuffer."
|
|
2972 (interactive)
|
|
2973 (ebrowse-switch-member-buffer-to-other-class
|
|
2974 "Goto class: " (ebrowse-tree-obarray-as-alist)))
|
|
2975
|
|
2976
|
|
2977 (defun ebrowse-switch-member-buffer-to-base-class (arg)
|
|
2978 "Switch buffer to ARG'th base class."
|
|
2979 (interactive "P")
|
|
2980 (let ((supers (or (ebrowse-direct-base-classes ebrowse--displayed-class)
|
|
2981 (error "No base classes"))))
|
|
2982 (if (and arg (second supers))
|
|
2983 (let ((alist (loop for s in supers
|
|
2984 collect (cons (ebrowse-qualified-class-name
|
|
2985 (ebrowse-ts-class s))
|
|
2986 s))))
|
|
2987 (ebrowse-switch-member-buffer-to-other-class
|
|
2988 "Goto base class: " alist))
|
|
2989 (setq ebrowse--displayed-class (first supers)
|
|
2990 ebrowse--member-list
|
|
2991 (funcall ebrowse--accessor ebrowse--displayed-class))
|
|
2992 (ebrowse-redisplay-member-buffer))))
|
|
2993
|
|
2994 (defun ebrowse-switch-member-buffer-to-next-sibling-class (arg)
|
|
2995 "Move to ARG'th next sibling."
|
|
2996 (interactive "p")
|
|
2997 (ebrowse-switch-member-buffer-to-sibling-class arg))
|
|
2998
|
|
2999
|
|
3000 (defun ebrowse-switch-member-buffer-to-previous-sibling-class (arg)
|
|
3001 "Move to ARG'th previous sibling."
|
|
3002 (interactive "p")
|
|
3003 (ebrowse-switch-member-buffer-to-sibling-class (- arg)))
|
|
3004
|
|
3005
|
|
3006 (defun ebrowse-switch-member-buffer-to-sibling-class (inc)
|
|
3007 "Switch member display to nth sibling class.
|
|
3008 Prefix arg INC specifies which one."
|
|
3009 (interactive "p")
|
|
3010 (let ((containing-list ebrowse--tree)
|
|
3011 index cls
|
|
3012 (supers (ebrowse-direct-base-classes ebrowse--displayed-class)))
|
|
3013 (flet ((trees-alist (trees)
|
|
3014 (loop for tr in trees
|
|
3015 collect (cons (ebrowse-cs-name
|
|
3016 (ebrowse-ts-class tr)) tr))))
|
|
3017 (when supers
|
|
3018 (let ((tree (if (second supers)
|
|
3019 (ebrowse-completing-read-value
|
|
3020 "Relative to base class: "
|
|
3021 (trees-alist supers) nil)
|
|
3022 (first supers))))
|
|
3023 (unless tree (error "Not found"))
|
|
3024 (setq containing-list (ebrowse-ts-subclasses tree)))))
|
|
3025 (setq index (+ inc (ebrowse-position ebrowse--displayed-class
|
|
3026 containing-list)))
|
|
3027 (cond ((minusp index) (message "No previous class"))
|
|
3028 ((null (nth index containing-list)) (message "No next class")))
|
|
3029 (setq index (max 0 (min index (1- (length containing-list)))))
|
|
3030 (setq cls (nth index containing-list))
|
|
3031 (setf ebrowse--displayed-class cls
|
|
3032 ebrowse--member-list (funcall ebrowse--accessor cls))
|
|
3033 (ebrowse-redisplay-member-buffer)))
|
|
3034
|
|
3035
|
|
3036 (defun ebrowse-switch-member-buffer-to-derived-class (arg)
|
|
3037 "Switch member display to nth derived class.
|
|
3038 Prefix arg ARG says which class should be displayed. Default is
|
|
3039 the first derived class."
|
|
3040 (interactive "P")
|
47929
|
3041 (flet ((ebrowse-tree-obarray-as-alist ()
|
28523
|
3042 (loop for s in (ebrowse-ts-subclasses
|
|
3043 ebrowse--displayed-class)
|
|
3044 collect (cons (ebrowse-cs-name
|
|
3045 (ebrowse-ts-class s)) s))))
|
|
3046 (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
|
|
3047 (error "No derived classes"))))
|
|
3048 (if (and arg (second subs))
|
|
3049 (ebrowse-switch-member-buffer-to-other-class
|
|
3050 "Goto derived class: " (ebrowse-tree-obarray-as-alist))
|
|
3051 (setq ebrowse--displayed-class (first subs)
|
|
3052 ebrowse--member-list
|
|
3053 (funcall ebrowse--accessor ebrowse--displayed-class))
|
|
3054 (ebrowse-redisplay-member-buffer)))))
|
|
3055
|
|
3056
|
|
3057
|
|
3058 ;;; Member buffer mouse functions
|
|
3059
|
|
3060 (defun ebrowse-displaying-functions ()
|
|
3061 (eq ebrowse--accessor 'ebrowse-ts-member-functions))
|
|
3062 (defun ebrowse-displaying-variables ()
|
|
3063 (eq ebrowse--accessor 'ebrowse-ts-member-variables))
|
|
3064 (defun ebrowse-displaying-static-functions ()
|
|
3065 )
|
|
3066 (defun ebrowse-displaying-static-variables ()
|
|
3067 )
|
|
3068 (defun ebrowse-displaying-types ()
|
|
3069 (eq ebrowse--accessor 'ebrowse-ts-types))
|
|
3070 (defun ebrowse-displaying-friends ()
|
|
3071 (eq ebrowse--accessor 'ebrowse-ts-friends))
|
|
3072
|
|
3073 (easy-menu-define
|
|
3074 ebrowse-member-buffer-object-menu ebrowse-member-mode-map
|
|
3075 "Object menu for the member buffer itself."
|
|
3076 '("Members"
|
|
3077 ("Members List"
|
|
3078 ["Functions" ebrowse-display-function-member-list
|
|
3079 :help "Show the list of member functions"
|
|
3080 :style radio
|
|
3081 :selected (eq ebrowse--accessor 'ebrowse-ts-member-functions)
|
|
3082 :active t]
|
|
3083 ["Variables" ebrowse-display-variables-member-list
|
|
3084 :help "Show the list of member variables"
|
|
3085 :style radio
|
|
3086 :selected (eq ebrowse--accessor 'ebrowse-ts-member-variables)
|
|
3087 :active t]
|
|
3088 ["Static Functions" ebrowse-display-static-functions-member-list
|
|
3089 :help "Show the list of static member functions"
|
|
3090 :style radio
|
|
3091 :selected (eq ebrowse--accessor 'ebrowse-ts-static-functions)
|
|
3092 :active t]
|
|
3093 ["Static Variables" ebrowse-display-static-variables-member-list
|
|
3094 :help "Show the list of static member variables"
|
|
3095 :style radio
|
|
3096 :selected (eq ebrowse--accessor 'ebrowse-ts-static-variables)
|
|
3097 :active t]
|
|
3098 ["Types" ebrowse-display-types-member-list
|
|
3099 :help "Show the list of nested types"
|
|
3100 :style radio
|
|
3101 :selected (eq ebrowse--accessor 'ebrowse-ts-types)
|
|
3102 :active t]
|
|
3103 ["Friends/Defines" ebrowse-display-friends-member-list
|
|
3104 :help "Show the list of friends or defines"
|
|
3105 :style radio
|
|
3106 :selected (eq ebrowse--accessor 'ebrowse-ts-friends)
|
|
3107 :active t])
|
|
3108 ("Class"
|
|
3109 ["Up" ebrowse-switch-member-buffer-to-base-class
|
|
3110 :help "Show the base class of this class"
|
|
3111 :active t]
|
|
3112 ["Down" ebrowse-switch-member-buffer-to-derived-class
|
|
3113 :help "Show a derived class class of this class"
|
|
3114 :active t]
|
|
3115 ["Next Sibling" ebrowse-switch-member-buffer-to-next-sibling-class
|
|
3116 :help "Show the next sibling class"
|
|
3117 :active t]
|
|
3118 ["Previous Sibling" ebrowse-switch-member-buffer-to-previous-sibling-class
|
|
3119 :help "Show the previous sibling class"
|
|
3120 :active t])
|
|
3121 ("Member"
|
|
3122 ["Show in Tree" ebrowse-show-displayed-class-in-tree
|
|
3123 :help "Show this class in the class tree"
|
|
3124 :active t]
|
|
3125 ["Find in this Class" ebrowse-goto-visible-member
|
|
3126 :help "Search for a member of this class"
|
|
3127 :active t]
|
|
3128 ["Find in Tree" ebrowse-goto-visible-member/all-member-lists
|
|
3129 :help "Search for a member in any class"
|
|
3130 :active t])
|
47929
|
3131 ("Display"
|
28523
|
3132 ["Inherited" ebrowse-toggle-base-class-display
|
|
3133 :help "Toggle display of inherited members"
|
|
3134 :style toggle
|
|
3135 :selected ebrowse--show-inherited-flag
|
|
3136 :active t]
|
|
3137 ["Attributes" ebrowse-toggle-member-attributes-display
|
|
3138 :help "Show member attributes"
|
|
3139 :style toggle
|
|
3140 :selected ebrowse--attributes-flag
|
|
3141 :active t]
|
|
3142 ["Long Display" ebrowse-toggle-long-short-display
|
|
3143 :help "Toggle the member display format"
|
|
3144 :style toggle
|
|
3145 :selected ebrowse--long-display-flag
|
|
3146 :active t]
|
|
3147 ["Column Width" ebrowse-set-member-buffer-column-width
|
|
3148 :help "Set the display's column width"
|
|
3149 :active t])
|
|
3150 ("Filter"
|
|
3151 ["Public" ebrowse-toggle-public-member-filter
|
|
3152 :help "Toggle the visibility of public members"
|
|
3153 :style toggle
|
|
3154 :selected (not (aref ebrowse--filters 0))
|
|
3155 :active t]
|
|
3156 ["Protected" ebrowse-toggle-protected-member-filter
|
|
3157 :help "Toggle the visibility of protected members"
|
|
3158 :style toggle
|
|
3159 :selected (not (aref ebrowse--filters 1))
|
|
3160 :active t]
|
|
3161 ["Private" ebrowse-toggle-private-member-filter
|
|
3162 :help "Toggle the visibility of private members"
|
|
3163 :style toggle
|
|
3164 :selected (not (aref ebrowse--filters 2))
|
|
3165 :active t]
|
|
3166 ["Virtual" ebrowse-toggle-virtual-member-filter
|
|
3167 :help "Toggle the visibility of virtual members"
|
|
3168 :style toggle
|
|
3169 :selected ebrowse--virtual-display-flag
|
|
3170 :active t]
|
|
3171 ["Inline" ebrowse-toggle-inline-member-filter
|
|
3172 :help "Toggle the visibility of inline members"
|
|
3173 :style toggle
|
|
3174 :selected ebrowse--inline-display-flag
|
|
3175 :active t]
|
|
3176 ["Const" ebrowse-toggle-const-member-filter
|
|
3177 :help "Toggle the visibility of const members"
|
|
3178 :style toggle
|
|
3179 :selected ebrowse--const-display-flag
|
|
3180 :active t]
|
|
3181 ["Pure" ebrowse-toggle-pure-member-filter
|
|
3182 :help "Toggle the visibility of pure virtual members"
|
|
3183 :style toggle
|
|
3184 :selected ebrowse--pure-display-flag
|
|
3185 :active t]
|
|
3186 "-----------------"
|
|
3187 ["Show all" ebrowse-remove-all-member-filters
|
|
3188 :help "Remove any display filters"
|
|
3189 :active t])
|
|
3190 ("Buffer"
|
|
3191 ["Tree" ebrowse-pop-from-member-to-tree-buffer
|
|
3192 :help "Pop to the class tree buffer"
|
|
3193 :active t]
|
|
3194 ["Next Member Buffer" ebrowse-switch-to-next-member-buffer
|
|
3195 :help "Switch to the next member buffer of this class tree"
|
|
3196 :active t]
|
|
3197 ["Freeze" ebrowse-freeze-member-buffer
|
|
3198 :help "Freeze (do not reuse) this member buffer"
|
|
3199 :active t])))
|
|
3200
|
|
3201
|
|
3202 (defun ebrowse-on-class-name ()
|
|
3203 "Value is non-nil if point is on a class name."
|
|
3204 (eq (get-text-property (point) 'ebrowse-what) 'class-name))
|
|
3205
|
|
3206
|
|
3207 (defun ebrowse-on-member-name ()
|
|
3208 "Value is non-nil if point is on a member name."
|
|
3209 (eq (get-text-property (point) 'ebrowse-what) 'member-name))
|
|
3210
|
|
3211
|
|
3212 (easy-menu-define
|
|
3213 ebrowse-member-class-name-object-menu ebrowse-member-mode-map
|
|
3214 "Object menu for class names in member buffer."
|
|
3215 '("Class"
|
|
3216 ["Find" ebrowse-find-member-definition
|
|
3217 :help "Find this class in the source files"
|
|
3218 :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
|
|
3219 ["View" ebrowse-view-member-definition
|
|
3220 :help "View this class in the source files"
|
|
3221 :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]))
|
|
3222
|
|
3223
|
47929
|
3224 (easy-menu-define
|
28523
|
3225 ebrowse-member-name-object-menu ebrowse-member-mode-map
|
|
3226 "Object menu for member names"
|
|
3227 '("Ebrowse"
|
|
3228 ["Find Definition" ebrowse-find-member-definition
|
|
3229 :help "Find this member's definition in the source files"
|
|
3230 :active (ebrowse-on-member-name)]
|
|
3231 ["Find Declaration" ebrowse-find-member-declaration
|
|
3232 :help "Find this member's declaration in the source files"
|
|
3233 :active (ebrowse-on-member-name)]
|
|
3234 ["View Definition" ebrowse-view-member-definition
|
|
3235 :help "View this member's definition in the source files"
|
|
3236 :active (ebrowse-on-member-name)]
|
|
3237 ["View Declaration" ebrowse-view-member-declaration
|
|
3238 :help "View this member's declaration in the source files"
|
|
3239 :active (ebrowse-on-member-name)]))
|
|
3240
|
|
3241
|
|
3242 (defun ebrowse-member-mouse-3 (event)
|
|
3243 "Handle `mouse-3' events in member buffers.
|
|
3244 EVENT is the mouse event."
|
|
3245 (interactive "e")
|
|
3246 (mouse-set-point event)
|
|
3247 (case (event-click-count event)
|
|
3248 (2 (ebrowse-find-member-definition))
|
|
3249 (1 (case (get-text-property (posn-point (event-start event))
|
|
3250 'ebrowse-what)
|
|
3251 (member-name
|
|
3252 (ebrowse-popup-menu ebrowse-member-name-object-menu event))
|
|
3253 (class-name
|
|
3254 (ebrowse-popup-menu ebrowse-member-class-name-object-menu event))
|
|
3255 (t
|
|
3256 (ebrowse-popup-menu ebrowse-member-buffer-object-menu event))))))
|
|
3257
|
|
3258
|
|
3259 (defun ebrowse-member-mouse-2 (event)
|
|
3260 "Handle `mouse-2' events in member buffers.
|
|
3261 EVENT is the mouse event."
|
|
3262 (interactive "e")
|
|
3263 (mouse-set-point event)
|
|
3264 (case (event-click-count event)
|
|
3265 (2 (ebrowse-find-member-definition))
|
|
3266 (1 (case (get-text-property (posn-point (event-start event))
|
|
3267 'ebrowse-what)
|
|
3268 (member-name
|
|
3269 (ebrowse-view-member-definition 0))))))
|
|
3270
|
|
3271
|
|
3272
|
|
3273 ;;; Tags view/find
|
|
3274
|
|
3275 (defun ebrowse-class-alist-for-member (tree-header name)
|
|
3276 "Return information about a member in a class tree.
|
|
3277 TREE-HEADER is the header structure of the class tree.
|
|
3278 NAME is the name of the member.
|
|
3279 Value is an alist of elements (CLASS-NAME . (CLASS LIST NAME)),
|
|
3280 where each element describes one occurrence of member NAME in the tree.
|
47929
|
3281 CLASS-NAME is the qualified name of the class in which the
|
28523
|
3282 member was found. The CDR of the acons is described in function
|
|
3283 `ebrowse-class/index/member-for-member'."
|
|
3284 (let ((table (ebrowse-member-table tree-header))
|
|
3285 known-classes
|
|
3286 alist)
|
|
3287 (when name
|
|
3288 (dolist (info (gethash name table) alist)
|
|
3289 (unless (memq (first info) known-classes)
|
|
3290 (setf alist (acons (ebrowse-qualified-class-name
|
|
3291 (ebrowse-ts-class (first info)))
|
|
3292 info alist)
|
|
3293 known-classes (cons (first info) known-classes)))))))
|
|
3294
|
|
3295
|
|
3296 (defun ebrowse-choose-tree ()
|
|
3297 "Choose a class tree to use.
|
|
3298 If there's more than one class tree loaded, let the user choose
|
|
3299 the one he wants. Value is (TREE HEADER BUFFER), with TREE being
|
|
3300 the class tree, HEADER the header structure of the tree, and BUFFER
|
|
3301 being the tree or member buffer containing the tree."
|
|
3302 (let* ((buffer (ebrowse-choose-from-browser-buffers)))
|
|
3303 (if buffer (list (ebrowse-value-in-buffer 'ebrowse--tree buffer)
|
|
3304 (ebrowse-value-in-buffer 'ebrowse--header buffer)
|
|
3305 buffer))))
|
|
3306
|
|
3307
|
|
3308 (defun ebrowse-tags-read-name (header prompt)
|
|
3309 "Read a C++ identifier from the minibuffer.
|
|
3310 HEADER is the `ebrowse-hs' structure of the class tree.
|
|
3311 Prompt with PROMPT. Insert into the minibuffer a C++ identifier read
|
|
3312 from point as default. Value is a list (CLASS-NAME MEMBER-NAME)."
|
|
3313 (save-excursion
|
|
3314 (let* (start member-info (members (ebrowse-member-table header)))
|
|
3315 (multiple-value-bind (class-name member-name)
|
102532
|
3316 (values-list (ebrowse-tags-read-member+class-name))
|
28523
|
3317 (unless member-name
|
|
3318 (error "No member name at point"))
|
|
3319 (if members
|
46353
|
3320 (let* ((name (ebrowse-ignoring-completion-case
|
|
3321 (completing-read prompt members nil nil member-name)))
|
|
3322 (completion-result (try-completion name members)))
|
42205
|
3323 ;; Cannot rely on `try-completion' returning t for exact
|
42706
|
3324 ;; matches! It returns the name as a string.
|
28523
|
3325 (unless (setq member-info (gethash name members))
|
|
3326 (if (y-or-n-p "No exact match found. Try substrings? ")
|
47929
|
3327 (setq name
|
|
3328 (or (first (ebrowse-list-of-matching-members
|
28523
|
3329 members (regexp-quote name) name))
|
|
3330 (error "Sorry, nothing found")))
|
|
3331 (error "Canceled")))
|
|
3332 (list class-name name))
|
|
3333 (list class-name (read-from-minibuffer prompt member-name)))))))
|
|
3334
|
|
3335
|
|
3336 (defun ebrowse-tags-read-member+class-name ()
|
|
3337 "Read a C++ identifier from point.
|
|
3338 Value is (CLASS-NAME MEMBER-NAME).
|
|
3339 CLASS-NAME is the name of the class if the identifier was qualified.
|
|
3340 It is nil otherwise.
|
|
3341 MEMBER-NAME is the name of the member found."
|
|
3342 (save-excursion
|
|
3343 (skip-chars-backward "a-zA-Z0-9_")
|
|
3344 (let* ((start (point))
|
|
3345 (name (progn (skip-chars-forward "a-zA-Z0-9_")
|
|
3346 (buffer-substring start (point))))
|
|
3347 class)
|
|
3348 (list class name))))
|
|
3349
|
|
3350
|
|
3351 (defun ebrowse-tags-choose-class (tree header name initial-class-name)
|
|
3352 "Read a class name for a member from the minibuffer.
|
|
3353 TREE is the class tree we operate on.
|
|
3354 HEADER is its header structure.
|
|
3355 NAME is the name of the member.
|
|
3356 INITIAL-CLASS-NAME is an initial class name to insert in the minibuffer.
|
|
3357 Value is a list (TREE ACCESSOR MEMBER) for the member."
|
|
3358 (let ((alist (or (ebrowse-class-alist-for-member header name)
|
|
3359 (error "No classes with member `%s' found" name))))
|
|
3360 (ebrowse-ignoring-completion-case
|
|
3361 (if (null (second alist))
|
|
3362 (cdr (first alist))
|
|
3363 (push ?\? unread-command-events)
|
|
3364 (cdr (assoc (completing-read "In class: "
|
|
3365 alist nil t initial-class-name)
|
|
3366 alist))))))
|
|
3367
|
|
3368
|
|
3369 (defun* ebrowse-tags-view/find-member-decl/defn
|
|
3370 (prefix &key view definition member-name)
|
|
3371 "If VIEW is t, view, else find an occurrence of MEMBER-NAME.
|
|
3372
|
|
3373 If DEFINITION is t, find or view the member definition else its
|
|
3374 declaration. This function reads the member's name from the
|
|
3375 current buffer like FIND-TAG. It then prepares a completion list
|
|
3376 of all classes containing a member with the given name and lets
|
|
3377 the user choose the class to use. As a last step, a tags search
|
|
3378 is performed that positions point on the member declaration or
|
|
3379 definition."
|
|
3380 (multiple-value-bind
|
102532
|
3381 (tree header tree-buffer) (values-list (ebrowse-choose-tree))
|
28523
|
3382 (unless tree (error "No class tree"))
|
|
3383 (let* ((marker (point-marker))
|
|
3384 class-name
|
|
3385 (name member-name)
|
|
3386 info)
|
|
3387 (unless name
|
|
3388 (multiple-value-setq (class-name name)
|
102532
|
3389 (values-list
|
|
3390 (ebrowse-tags-read-name
|
|
3391 header
|
|
3392 (concat (if view "View" "Find") " member "
|
|
3393 (if definition "definition" "declaration") ": ")))))
|
28523
|
3394 (setq info (ebrowse-tags-choose-class tree header name class-name))
|
|
3395 (ebrowse-push-position marker info)
|
|
3396 ;; Goto the occurrence of the member
|
|
3397 (ebrowse-view/find-member-declaration/definition
|
|
3398 prefix view definition info
|
|
3399 header
|
|
3400 (ebrowse-value-in-buffer 'ebrowse--tags-file-name tree-buffer))
|
|
3401 ;; Record position jumped to
|
|
3402 (ebrowse-push-position (point-marker) info t))))
|
|
3403
|
|
3404
|
52529
|
3405 ;;;###autoload
|
28523
|
3406 (defun ebrowse-tags-view-declaration ()
|
|
3407 "View declaration of member at point."
|
|
3408 (interactive)
|
|
3409 (ebrowse-tags-view/find-member-decl/defn 0 :view t :definition nil))
|
|
3410
|
|
3411
|
52529
|
3412 ;;;###autoload
|
28523
|
3413 (defun ebrowse-tags-find-declaration ()
|
|
3414 "Find declaration of member at point."
|
|
3415 (interactive)
|
|
3416 (ebrowse-tags-view/find-member-decl/defn 0 :view nil :definition nil))
|
|
3417
|
|
3418
|
52529
|
3419 ;;;###autoload
|
28523
|
3420 (defun ebrowse-tags-view-definition ()
|
|
3421 "View definition of member at point."
|
|
3422 (interactive)
|
|
3423 (ebrowse-tags-view/find-member-decl/defn 0 :view t :definition t))
|
|
3424
|
|
3425
|
52529
|
3426 ;;;###autoload
|
28523
|
3427 (defun ebrowse-tags-find-definition ()
|
|
3428 "Find definition of member at point."
|
|
3429 (interactive)
|
|
3430 (ebrowse-tags-view/find-member-decl/defn 0 :view nil :definition t))
|
|
3431
|
|
3432
|
|
3433 (defun ebrowse-tags-view-declaration-other-window ()
|
|
3434 "View declaration of member at point in other window."
|
|
3435 (interactive)
|
|
3436 (ebrowse-tags-view/find-member-decl/defn 4 :view t :definition nil))
|
|
3437
|
|
3438
|
52529
|
3439 ;;;###autoload
|
28523
|
3440 (defun ebrowse-tags-find-declaration-other-window ()
|
|
3441 "Find declaration of member at point in other window."
|
|
3442 (interactive)
|
|
3443 (ebrowse-tags-view/find-member-decl/defn 4 :view nil :definition nil))
|
|
3444
|
|
3445
|
52529
|
3446 ;;;###autoload
|
28523
|
3447 (defun ebrowse-tags-view-definition-other-window ()
|
|
3448 "View definition of member at point in other window."
|
|
3449 (interactive)
|
|
3450 (ebrowse-tags-view/find-member-decl/defn 4 :view t :definition t))
|
|
3451
|
|
3452
|
52529
|
3453 ;;;###autoload
|
28523
|
3454 (defun ebrowse-tags-find-definition-other-window ()
|
|
3455 "Find definition of member at point in other window."
|
|
3456 (interactive)
|
|
3457 (ebrowse-tags-view/find-member-decl/defn 4 :view nil :definition t))
|
|
3458
|
|
3459
|
|
3460 (defun ebrowse-tags-view-declaration-other-frame ()
|
|
3461 "View definition of member at point in other frame."
|
|
3462 (interactive)
|
|
3463 (ebrowse-tags-view/find-member-decl/defn 5 :view t :definition nil))
|
|
3464
|
|
3465
|
52529
|
3466 ;;;###autoload
|
28523
|
3467 (defun ebrowse-tags-find-declaration-other-frame ()
|
|
3468 "Find definition of member at point in other frame."
|
|
3469 (interactive)
|
|
3470 (ebrowse-tags-view/find-member-decl/defn 5 :view nil :definition nil))
|
|
3471
|
|
3472
|
52529
|
3473 ;;;###autoload
|
28523
|
3474 (defun ebrowse-tags-view-definition-other-frame ()
|
|
3475 "View definition of member at point in other frame."
|
|
3476 (interactive)
|
|
3477 (ebrowse-tags-view/find-member-decl/defn 5 :view t :definition t))
|
|
3478
|
|
3479
|
52529
|
3480 ;;;###autoload
|
28523
|
3481 (defun ebrowse-tags-find-definition-other-frame ()
|
|
3482 "Find definition of member at point in other frame."
|
|
3483 (interactive)
|
|
3484 (ebrowse-tags-view/find-member-decl/defn 5 :view nil :definition t))
|
|
3485
|
|
3486
|
|
3487 (defun ebrowse-tags-select/create-member-buffer (tree-buffer info)
|
|
3488 "Select or create member buffer.
|
|
3489 TREE-BUFFER specifies the tree to use. INFO describes the member.
|
|
3490 It is a list (TREE ACCESSOR MEMBER)."
|
|
3491 (let ((buffer (get-buffer ebrowse-member-buffer-name)))
|
|
3492 (cond ((null buffer)
|
|
3493 (set-buffer tree-buffer)
|
|
3494 (switch-to-buffer (ebrowse-display-member-buffer
|
|
3495 (second info) nil (first info))))
|
|
3496 (t
|
|
3497 (switch-to-buffer buffer)
|
|
3498 (setq ebrowse--displayed-class (first info)
|
|
3499 ebrowse--accessor (second info)
|
|
3500 ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
|
|
3501 (ebrowse-redisplay-member-buffer)))
|
|
3502 (ebrowse-move-point-to-member (ebrowse-ms-name (third info)))))
|
|
3503
|
|
3504
|
|
3505 (defun ebrowse-tags-display-member-buffer (&optional fix-name)
|
|
3506 "Display a member buffer for a member.
|
|
3507 FIX-NAME non-nil means display the buffer for that member.
|
|
3508 Otherwise read a member name from point."
|
|
3509 (interactive)
|
|
3510 (multiple-value-bind
|
102532
|
3511 (tree header tree-buffer) (values-list (ebrowse-choose-tree))
|
28523
|
3512 (unless tree (error "No class tree"))
|
|
3513 (let* ((marker (point-marker)) class-name (name fix-name) info)
|
|
3514 (unless name
|
|
3515 (multiple-value-setq (class-name name)
|
102532
|
3516 (values-list
|
|
3517 (ebrowse-tags-read-name header
|
|
3518 (concat "Find member list of: ")))))
|
28523
|
3519 (setq info (ebrowse-tags-choose-class tree header name class-name))
|
|
3520 (ebrowse-push-position marker info)
|
|
3521 (ebrowse-tags-select/create-member-buffer tree-buffer info))))
|
|
3522
|
|
3523
|
|
3524 (defun ebrowse-list-of-matching-members (members regexp &optional name)
|
|
3525 "Return a list of members in table MEMBERS matching REGEXP or NAME.
|
|
3526 Both NAME and REGEXP may be nil in which case exact or regexp matches
|
|
3527 are not performed."
|
|
3528 (let (list)
|
|
3529 (when (or name regexp)
|
|
3530 (maphash #'(lambda (member-name info)
|
|
3531 (when (or (and name (string= name member-name))
|
|
3532 (and regexp (string-match regexp member-name)))
|
|
3533 (setq list (cons member-name list))))
|
|
3534 members))
|
|
3535 list))
|
|
3536
|
|
3537
|
|
3538 (defun ebrowse-tags-apropos ()
|
|
3539 "Display a list of members matching a regexp read from the minibuffer."
|
|
3540 (interactive)
|
|
3541 (let* ((buffer (or (ebrowse-choose-from-browser-buffers)
|
|
3542 (error "No tree buffer")))
|
|
3543 (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
|
|
3544 (members (ebrowse-member-table header))
|
|
3545 temp-buffer-setup-hook
|
|
3546 (regexp (read-from-minibuffer "List members matching regexp: ")))
|
|
3547 (with-output-to-temp-buffer (concat "*Apropos Members*")
|
|
3548 (set-buffer standard-output)
|
|
3549 (erase-buffer)
|
|
3550 (insert "Members matching `" regexp "'\n\n")
|
|
3551 (loop for s in (ebrowse-list-of-matching-members members regexp) do
|
|
3552 (loop for info in (gethash s members) do
|
|
3553 (ebrowse-draw-file-member-info info))))))
|
|
3554
|
|
3555
|
|
3556 (defun ebrowse-tags-list-members-in-file ()
|
|
3557 "Display a list of members found in a file.
|
|
3558 The file name is read from the minibuffer."
|
|
3559 (interactive)
|
|
3560 (let* ((buffer (or (ebrowse-choose-from-browser-buffers)
|
|
3561 (error "No tree buffer")))
|
|
3562 (files (save-excursion (set-buffer buffer) (ebrowse-files-table)))
|
46353
|
3563 (file (completing-read "List members in file: " files nil t))
|
28523
|
3564 (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
|
|
3565 temp-buffer-setup-hook
|
|
3566 (members (ebrowse-member-table header)))
|
|
3567 (with-output-to-temp-buffer (concat "*Members in file " file "*")
|
|
3568 (set-buffer standard-output)
|
|
3569 (maphash
|
|
3570 #'(lambda (member-name list)
|
|
3571 (loop for info in list
|
|
3572 as member = (third info)
|
|
3573 as class = (ebrowse-ts-class (first info))
|
|
3574 when (or (and (null (ebrowse-ms-file member))
|
|
3575 (string= (ebrowse-cs-file class) file))
|
|
3576 (string= file (ebrowse-ms-file member)))
|
|
3577 do (ebrowse-draw-file-member-info info "decl.")
|
|
3578 when (or (and (null (ebrowse-ms-definition-file member))
|
|
3579 (string= (ebrowse-cs-source-file class) file))
|
|
3580 (string= file (ebrowse-ms-definition-file member)))
|
|
3581 do (ebrowse-draw-file-member-info info "defn.")))
|
|
3582 members))))
|
|
3583
|
|
3584
|
|
3585 (defun* ebrowse-draw-file-member-info (info &optional (kind ""))
|
77973
|
3586 "Display a line in the members info buffer.
|
28523
|
3587 INFO describes the member. It has the form (TREE ACCESSOR MEMBER).
|
|
3588 TREE is the class of the member to display.
|
|
3589 ACCESSOR is the accessor symbol of its member list.
|
|
3590 MEMBER is the member structure.
|
47929
|
3591 KIND is an additional string printed in the buffer."
|
28523
|
3592 (let* ((tree (first info))
|
|
3593 (globals-p (ebrowse-globals-tree-p tree)))
|
|
3594 (unless globals-p
|
|
3595 (insert (ebrowse-cs-name (ebrowse-ts-class tree))))
|
|
3596 (insert "::" (ebrowse-ms-name (third info)))
|
|
3597 (indent-to 40)
|
|
3598 (insert kind)
|
|
3599 (indent-to 50)
|
|
3600 (insert (case (second info)
|
|
3601 ('ebrowse-ts-member-functions "member function")
|
|
3602 ('ebrowse-ts-member-variables "member variable")
|
|
3603 ('ebrowse-ts-static-functions "static function")
|
|
3604 ('ebrowse-ts-static-variables "static variable")
|
|
3605 ('ebrowse-ts-friends (if globals-p "define" "friend"))
|
|
3606 ('ebrowse-ts-types "type")
|
|
3607 (t "unknown"))
|
|
3608 "\n")))
|
|
3609
|
|
3610 (defvar ebrowse-last-completion nil
|
|
3611 "Text inserted by the last completion operation.")
|
|
3612
|
|
3613
|
|
3614 (defvar ebrowse-last-completion-start nil
|
|
3615 "String which was the basis for the last completion operation.")
|
|
3616
|
|
3617
|
|
3618 (defvar ebrowse-last-completion-location nil
|
|
3619 "Buffer position at which the last completion operation was initiated.")
|
|
3620
|
|
3621
|
|
3622 (defvar ebrowse-last-completion-obarray nil
|
|
3623 "Member used in last completion operation.")
|
|
3624
|
|
3625
|
|
3626 (make-variable-buffer-local 'ebrowse-last-completion-obarray)
|
|
3627 (make-variable-buffer-local 'ebrowse-last-completion-location)
|
|
3628 (make-variable-buffer-local 'ebrowse-last-completion)
|
|
3629 (make-variable-buffer-local 'ebrowse-last-completion-start)
|
|
3630
|
|
3631
|
|
3632
|
|
3633 (defun ebrowse-some-member-table ()
|
49735
|
3634 "Return a hash table containing all members of a tree.
|
28523
|
3635 If there's only one tree loaded, use that. Otherwise let the
|
|
3636 use choose a tree."
|
|
3637 (let* ((buffers (ebrowse-known-class-trees-buffer-list))
|
|
3638 (buffer (cond ((and (first buffers) (not (second buffers)))
|
|
3639 (first buffers))
|
|
3640 (t (or (ebrowse-electric-choose-tree)
|
|
3641 (error "No tree buffer")))))
|
|
3642 (header (ebrowse-value-in-buffer 'ebrowse--header buffer)))
|
|
3643 (ebrowse-member-table header)))
|
|
3644
|
|
3645
|
|
3646 (defun ebrowse-cyclic-successor-in-string-list (string list)
|
|
3647 "Return the item following STRING in LIST.
|
|
3648 If STRING is the last element, return the first element as successor."
|
|
3649 (or (nth (1+ (ebrowse-position string list 'string=)) list)
|
|
3650 (first list)))
|
|
3651
|
|
3652
|
|
3653 ;;; Symbol completion
|
|
3654
|
|
3655 ;;;###autoload
|
|
3656 (defun* ebrowse-tags-complete-symbol (prefix)
|
|
3657 "Perform completion on the C++ symbol preceding point.
|
47929
|
3658 A second call of this function without changing point inserts the next match.
|
28523
|
3659 A call with prefix PREFIX reads the symbol to insert from the minibuffer with
|
|
3660 completion."
|
|
3661 (interactive "P")
|
|
3662 (let* ((end (point))
|
|
3663 (begin (save-excursion (skip-chars-backward "a-zA-Z_0-9") (point)))
|
|
3664 (pattern (buffer-substring begin end))
|
|
3665 list completion)
|
|
3666 (cond
|
|
3667 ;; With prefix, read name from minibuffer with completion.
|
|
3668 (prefix
|
|
3669 (let* ((members (ebrowse-some-member-table))
|
|
3670 (completion (completing-read "Insert member: "
|
46353
|
3671 members nil t pattern)))
|
28523
|
3672 (when completion
|
|
3673 (setf ebrowse-last-completion-location nil)
|
|
3674 (delete-region begin end)
|
|
3675 (insert completion))))
|
|
3676 ;; If this function is called at the same point the last
|
|
3677 ;; expansion ended, insert the next expansion.
|
|
3678 ((eq (point) ebrowse-last-completion-location)
|
|
3679 (setf list (all-completions ebrowse-last-completion-start
|
|
3680 ebrowse-last-completion-obarray)
|
|
3681 completion (ebrowse-cyclic-successor-in-string-list
|
|
3682 ebrowse-last-completion list))
|
|
3683 (cond ((null completion)
|
|
3684 (error "No completion"))
|
|
3685 ((string= completion pattern)
|
|
3686 (error "No further completion"))
|
|
3687 (t
|
|
3688 (delete-region begin end)
|
|
3689 (insert completion)
|
|
3690 (setf ebrowse-last-completion completion
|
|
3691 ebrowse-last-completion-location (point)))))
|
|
3692 ;; First time the function is called at some position in the
|
|
3693 ;; buffer: Start new completion.
|
|
3694 (t
|
|
3695 (let* ((members (ebrowse-some-member-table))
|
|
3696 (completion (first (all-completions pattern members nil))))
|
|
3697 (cond ((eq completion t))
|
|
3698 ((null completion)
|
|
3699 (error "Can't find completion for `%s'" pattern))
|
|
3700 (t
|
|
3701 (delete-region begin end)
|
|
3702 (insert completion)
|
47929
|
3703
|
28523
|
3704 (setf ebrowse-last-completion-location (point)
|
|
3705 ebrowse-last-completion-start pattern
|
|
3706 ebrowse-last-completion completion
|
|
3707 ebrowse-last-completion-obarray members))))))))
|
|
3708
|
|
3709
|
|
3710 ;;; Tags query replace & search
|
|
3711
|
|
3712 (defvar ebrowse-tags-loop-form ()
|
|
3713 "Form for `ebrowse-loop-continue'.
|
|
3714 Evaluated for each file in the tree. If it returns nil, proceed
|
|
3715 with the next file.")
|
|
3716
|
|
3717 (defvar ebrowse-tags-next-file-list ()
|
|
3718 "A list of files to be processed.")
|
|
3719
|
|
3720
|
|
3721 (defvar ebrowse-tags-next-file-path nil
|
|
3722 "The path relative to which files have to be searched.")
|
|
3723
|
|
3724
|
|
3725 (defvar ebrowse-tags-loop-last-file nil
|
|
3726 "The last file visited via `ebrowse-tags-loop'.")
|
|
3727
|
|
3728
|
|
3729 (defun ebrowse-tags-next-file (&optional initialize tree-buffer)
|
|
3730 "Select next file among files in current tag table.
|
|
3731 Non-nil argument INITIALIZE (prefix arg, if interactive) initializes
|
|
3732 to the beginning of the list of files in the tag table.
|
|
3733 TREE-BUFFER specifies the class tree we operate on."
|
|
3734 (interactive "P")
|
|
3735 ;; Call with INITIALIZE non-nil initializes the files list.
|
|
3736 ;; If more than one tree buffer is loaded, let the user choose
|
|
3737 ;; on which tree (s)he wants to operate.
|
|
3738 (when initialize
|
|
3739 (let ((buffer (or tree-buffer (ebrowse-choose-from-browser-buffers))))
|
|
3740 (save-excursion
|
|
3741 (set-buffer buffer)
|
|
3742 (setq ebrowse-tags-next-file-list
|
|
3743 (ebrowse-files-list (ebrowse-marked-classes-p))
|
|
3744 ebrowse-tags-loop-last-file
|
|
3745 nil
|
|
3746 ebrowse-tags-next-file-path
|
|
3747 (file-name-directory ebrowse--tags-file-name)))))
|
|
3748 ;; End of the loop if the stack of files is empty.
|
|
3749 (unless ebrowse-tags-next-file-list
|
|
3750 (error "All files processed"))
|
|
3751 ;; ebrowse-tags-loop-last-file is the last file that was visited due
|
|
3752 ;; to a call to BROWSE-LOOP (see below). If that file is still
|
|
3753 ;; in memory, and it wasn't modified, throw its buffer away to
|
|
3754 ;; prevent cluttering up the buffer list.
|
|
3755 (when ebrowse-tags-loop-last-file
|
|
3756 (let ((buffer (get-file-buffer ebrowse-tags-loop-last-file)))
|
|
3757 (when (and buffer
|
|
3758 (not (buffer-modified-p buffer)))
|
|
3759 (kill-buffer buffer))))
|
|
3760 ;; Remember this buffer file name for later deletion, if it
|
|
3761 ;; wasn't visited by other means.
|
|
3762 (let ((file (expand-file-name (car ebrowse-tags-next-file-list)
|
|
3763 ebrowse-tags-next-file-path)))
|
|
3764 (setq ebrowse-tags-loop-last-file (if (get-file-buffer file) nil file))
|
|
3765 ;; Find the file and pop the file list. Pop has to be done
|
|
3766 ;; before the file is loaded because FIND-FILE might encounter
|
|
3767 ;; an error, and we want to be able to proceed with the next
|
|
3768 ;; file in this case.
|
|
3769 (pop ebrowse-tags-next-file-list)
|
|
3770 (find-file file)))
|
|
3771
|
|
3772
|
|
3773 ;;;###autoload
|
|
3774 (defun ebrowse-tags-loop-continue (&optional first-time tree-buffer)
|
|
3775 "Repeat last operation on files in tree.
|
|
3776 FIRST-TIME non-nil means this is not a repetition, but the first time.
|
|
3777 TREE-BUFFER if indirectly specifies which files to loop over."
|
|
3778 (interactive)
|
|
3779 (when first-time
|
|
3780 (ebrowse-tags-next-file first-time tree-buffer)
|
|
3781 (goto-char (point-min)))
|
|
3782 (while (not (eval ebrowse-tags-loop-form))
|
|
3783 (ebrowse-tags-next-file)
|
|
3784 (message "Scanning file `%s'..." buffer-file-name)
|
|
3785 (goto-char (point-min))))
|
|
3786
|
|
3787
|
52529
|
3788 ;;;###autoload
|
28523
|
3789 (defun ebrowse-tags-search (regexp)
|
|
3790 "Search for REGEXP in all files in a tree.
|
|
3791 If marked classes exist, process marked classes, only.
|
|
3792 If regular expression is nil, repeat last search."
|
|
3793 (interactive "sTree search (regexp): ")
|
|
3794 (if (and (string= regexp "")
|
|
3795 (eq (car ebrowse-tags-loop-form) 're-search-forward))
|
|
3796 (ebrowse-tags-loop-continue)
|
|
3797 (setq ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
|
|
3798 (ebrowse-tags-loop-continue 'first-time)))
|
|
3799
|
|
3800
|
|
3801 ;;;###autoload
|
|
3802 (defun ebrowse-tags-query-replace (from to)
|
|
3803 "Query replace FROM with TO in all files of a class tree.
|
|
3804 With prefix arg, process files of marked classes only."
|
47929
|
3805 (interactive
|
28523
|
3806 "sTree query replace (regexp): \nsTree query replace %s by: ")
|
|
3807 (setq ebrowse-tags-loop-form
|
|
3808 (list 'and (list 'save-excursion
|
|
3809 (list 're-search-forward from nil t))
|
40255
|
3810 (list 'not (list 'perform-replace from to t t nil))))
|
28523
|
3811 (ebrowse-tags-loop-continue 'first-time))
|
|
3812
|
|
3813
|
37426
|
3814 ;;;###autoload
|
28523
|
3815 (defun ebrowse-tags-search-member-use (&optional fix-name)
|
|
3816 "Search for call sites of a member.
|
|
3817 If FIX-NAME is specified, search uses of that member.
|
|
3818 Otherwise, read a member name from the minibuffer.
|
|
3819 Searches in all files mentioned in a class tree for something that
|
|
3820 looks like a function call to the member."
|
|
3821 (interactive)
|
|
3822 ;; Choose the tree to use if there is more than one.
|
|
3823 (multiple-value-bind (tree header tree-buffer)
|
102532
|
3824 (values-list (ebrowse-choose-tree))
|
28523
|
3825 (unless tree
|
|
3826 (error "No class tree"))
|
|
3827 ;; Get the member name NAME (class-name is ignored).
|
|
3828 (let ((name fix-name) class-name regexp)
|
|
3829 (unless name
|
|
3830 (multiple-value-setq (class-name name)
|
102532
|
3831 (values-list (ebrowse-tags-read-name header "Find calls of: "))))
|
28523
|
3832 ;; Set tags loop form to search for member and begin loop.
|
|
3833 (setq regexp (concat "\\<" name "[ \t]*(")
|
|
3834 ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
|
|
3835 (ebrowse-tags-loop-continue 'first-time tree-buffer))))
|
|
3836
|
|
3837
|
|
3838
|
|
3839 ;;; Tags position management
|
|
3840
|
|
3841 ;;; Structures of this kind are the elements of the position stack.
|
|
3842
|
|
3843 (defstruct (ebrowse-position (:type vector) :named)
|
|
3844 file-name ; in which file
|
|
3845 point ; point in file
|
|
3846 target ; t if target of a jump
|
|
3847 info) ; (CLASS FUNC MEMBER) jumped to
|
|
3848
|
|
3849
|
|
3850 (defvar ebrowse-position-stack ()
|
|
3851 "Stack of `ebrowse-position' structured.")
|
|
3852
|
|
3853
|
|
3854 (defvar ebrowse-position-index 0
|
|
3855 "Current position in position stack.")
|
|
3856
|
|
3857
|
|
3858 (defun ebrowse-position-name (position)
|
|
3859 "Return an identifying string for POSITION.
|
|
3860 The string is printed in the electric position list buffer."
|
|
3861 (let ((info (ebrowse-position-info position)))
|
|
3862 (concat (if (ebrowse-position-target position) "at " "to ")
|
|
3863 (ebrowse-cs-name (ebrowse-ts-class (first info)))
|
|
3864 "::" (ebrowse-ms-name (third info)))))
|
|
3865
|
|
3866
|
|
3867 (defun ebrowse-view/find-position (position &optional view)
|
|
3868 "Position point on POSITION.
|
|
3869 If VIEW is non-nil, view the position, otherwise find it."
|
|
3870 (cond ((not view)
|
|
3871 (find-file (ebrowse-position-file-name position))
|
|
3872 (goto-char (ebrowse-position-point position)))
|
|
3873 (t
|
|
3874 (unwind-protect
|
|
3875 (progn
|
47929
|
3876 (push (function
|
28523
|
3877 (lambda ()
|
|
3878 (goto-char (ebrowse-position-point position))))
|
|
3879 view-mode-hook)
|
|
3880 (view-file (ebrowse-position-file-name position)))
|
|
3881 (pop view-mode-hook)))))
|
|
3882
|
|
3883
|
|
3884 (defun ebrowse-push-position (marker info &optional target)
|
|
3885 "Push current position on position stack.
|
|
3886 MARKER is the marker to remember as position.
|
|
3887 INFO is a list (CLASS FUNC MEMBER) specifying what we jumped to.
|
|
3888 TARGET non-nil means we performed a jump.
|
|
3889 Positions in buffers that have no file names are not saved."
|
|
3890 (when (buffer-file-name (marker-buffer marker))
|
|
3891 (let ((too-much (- (length ebrowse-position-stack)
|
|
3892 ebrowse-max-positions)))
|
|
3893 ;; Do not let the stack grow to infinity.
|
|
3894 (when (plusp too-much)
|
|
3895 (setq ebrowse-position-stack
|
|
3896 (butlast ebrowse-position-stack too-much)))
|
|
3897 ;; Push the position.
|
|
3898 (push (make-ebrowse-position
|
|
3899 :file-name (buffer-file-name (marker-buffer marker))
|
|
3900 :point (marker-position marker)
|
|
3901 :target target
|
47929
|
3902 :info info)
|
28523
|
3903 ebrowse-position-stack))))
|
|
3904
|
|
3905
|
|
3906 (defun ebrowse-move-in-position-stack (increment)
|
|
3907 "Move by INCREMENT in the position stack."
|
|
3908 (let ((length (length ebrowse-position-stack)))
|
|
3909 (when (zerop length)
|
|
3910 (error "No positions remembered"))
|
|
3911 (setq ebrowse-position-index
|
|
3912 (mod (+ increment ebrowse-position-index) length))
|
|
3913 (message "Position %d of %d " ebrowse-position-index length)
|
|
3914 (ebrowse-view/find-position (nth ebrowse-position-index
|
|
3915 ebrowse-position-stack))))
|
|
3916
|
|
3917
|
37426
|
3918 ;;;###autoload
|
28523
|
3919 (defun ebrowse-back-in-position-stack (arg)
|
|
3920 "Move backward in the position stack.
|
|
3921 Prefix arg ARG says how much."
|
|
3922 (interactive "p")
|
|
3923 (ebrowse-move-in-position-stack (max 1 arg)))
|
|
3924
|
|
3925
|
37426
|
3926 ;;;###autoload
|
28523
|
3927 (defun ebrowse-forward-in-position-stack (arg)
|
|
3928 "Move forward in the position stack.
|
|
3929 Prefix arg ARG says how much."
|
|
3930 (interactive "p")
|
|
3931 (ebrowse-move-in-position-stack (min -1 (- arg))))
|
|
3932
|
|
3933
|
|
3934
|
|
3935 ;;; Electric position list
|
|
3936
|
|
3937 (defvar ebrowse-electric-position-mode-map ()
|
|
3938 "Keymap used in electric position stack window.")
|
|
3939
|
|
3940
|
|
3941 (defvar ebrowse-electric-position-mode-hook nil
|
62074
c0b42702a33a
(ebrowse-install-1-to-9-keys, ebrowse-print-statistics-line,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
3942 "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
|
28523
|
3943
|
|
3944
|
|
3945 (unless ebrowse-electric-position-mode-map
|
|
3946 (let ((map (make-keymap))
|
|
3947 (submap (make-keymap)))
|
|
3948 (setq ebrowse-electric-position-mode-map map)
|
|
3949 (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined)
|
|
3950 (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined)
|
|
3951 (define-key map "\e" submap)
|
83416
4513d8dcdfd5
Reimplement and extend support for terminal-local environment variables.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
3952 (define-key map "\C-z" 'suspend-frame)
|
28523
|
3953 (define-key map "\C-h" 'Helper-help)
|
|
3954 (define-key map "?" 'Helper-describe-bindings)
|
|
3955 (define-key map "\C-c" nil)
|
|
3956 (define-key map "\C-c\C-c" 'ebrowse-electric-position-quit)
|
|
3957 (define-key map "q" 'ebrowse-electric-position-quit)
|
|
3958 (define-key map " " 'ebrowse-electric-select-position)
|
|
3959 (define-key map "\C-l" 'recenter)
|
|
3960 (define-key map "\C-u" 'universal-argument)
|
|
3961 (define-key map "\C-p" 'previous-line)
|
|
3962 (define-key map "\C-n" 'next-line)
|
|
3963 (define-key map "p" 'previous-line)
|
|
3964 (define-key map "n" 'next-line)
|
|
3965 (define-key map "v" 'ebrowse-electric-view-position)
|
|
3966 (define-key map "\C-v" 'scroll-up)
|
|
3967 (define-key map "\ev" 'scroll-down)
|
|
3968 (define-key map "\e\C-v" 'scroll-other-window)
|
|
3969 (define-key map "\e>" 'end-of-buffer)
|
|
3970 (define-key map "\e<" 'beginning-of-buffer)
|
|
3971 (define-key map "\e>" 'end-of-buffer)))
|
|
3972
|
|
3973 (put 'ebrowse-electric-position-mode 'mode-class 'special)
|
|
3974 (put 'ebrowse-electric-position-undefined 'suppress-keymap t)
|
|
3975
|
|
3976
|
|
3977 (defun ebrowse-electric-position-mode ()
|
|
3978 "Mode for electric position buffers.
|
|
3979 Runs the hook `ebrowse-electric-position-mode-hook'."
|
|
3980 (kill-all-local-variables)
|
|
3981 (use-local-map ebrowse-electric-position-mode-map)
|
|
3982 (setq mode-name "Electric Position Menu"
|
|
3983 mode-line-buffer-identification "Electric Position Menu")
|
|
3984 (when (memq 'mode-name mode-line-format)
|
|
3985 (setq mode-line-format (copy-sequence mode-line-format))
|
|
3986 (setcar (memq 'mode-name mode-line-format) "Positions"))
|
|
3987 (make-local-variable 'Helper-return-blurb)
|
|
3988 (setq Helper-return-blurb "return to buffer editing"
|
|
3989 truncate-lines t
|
|
3990 buffer-read-only t
|
|
3991 major-mode 'ebrowse-electric-position-mode)
|
62772
|
3992 (run-mode-hooks 'ebrowse-electric-position-mode-hook))
|
28523
|
3993
|
|
3994
|
|
3995 (defun ebrowse-draw-position-buffer ()
|
|
3996 "Display positions in buffer *Positions*."
|
|
3997 (set-buffer (get-buffer-create "*Positions*"))
|
|
3998 (setq buffer-read-only nil)
|
|
3999 (erase-buffer)
|
|
4000 (insert "File Point Description\n"
|
|
4001 "---- ----- -----------\n")
|
|
4002 (dolist (position ebrowse-position-stack)
|
|
4003 (insert (file-name-nondirectory (ebrowse-position-file-name position)))
|
|
4004 (indent-to 15)
|
|
4005 (insert (int-to-string (ebrowse-position-point position)))
|
|
4006 (indent-to 22)
|
|
4007 (insert (ebrowse-position-name position) "\n"))
|
|
4008 (setq buffer-read-only t))
|
|
4009
|
|
4010
|
37426
|
4011 ;;;###autoload
|
28523
|
4012 (defun ebrowse-electric-position-menu ()
|
|
4013 "List positions in the position stack in an electric buffer."
|
|
4014 (interactive)
|
|
4015 (unless ebrowse-position-stack
|
|
4016 (error "No positions remembered"))
|
|
4017 (let (select buffer window)
|
|
4018 (save-window-excursion
|
|
4019 (save-window-excursion (ebrowse-draw-position-buffer))
|
|
4020 (setq window (Electric-pop-up-window "*Positions*")
|
|
4021 buffer (window-buffer window))
|
|
4022 (shrink-window-if-larger-than-buffer window)
|
|
4023 (unwind-protect
|
|
4024 (progn
|
|
4025 (set-buffer buffer)
|
|
4026 (ebrowse-electric-position-mode)
|
|
4027 (setq select
|
|
4028 (catch 'ebrowse-electric-select-position
|
|
4029 (message "<<< Press Space to bury the list >>>")
|
|
4030 (let ((first (progn (goto-char (point-min))
|
|
4031 (forward-line 2)
|
|
4032 (point)))
|
|
4033 (last (progn (goto-char (point-max))
|
|
4034 (forward-line -1)
|
|
4035 (point)))
|
|
4036 (goal-column 0))
|
|
4037 (goto-char first)
|
|
4038 (Electric-command-loop 'ebrowse-electric-select-position
|
|
4039 nil t
|
|
4040 'ebrowse-electric-position-looper
|
|
4041 (cons first last))))))
|
|
4042 (set-buffer buffer)
|
|
4043 (bury-buffer buffer)
|
|
4044 (message nil)))
|
|
4045 (when select
|
|
4046 (set-buffer buffer)
|
|
4047 (ebrowse-electric-find-position select))
|
|
4048 (kill-buffer buffer)))
|
|
4049
|
|
4050
|
|
4051 (defun ebrowse-electric-position-looper (state condition)
|
|
4052 "Prevent moving point on invalid lines.
|
|
4053 Called from `Electric-command-loop'. See there for the meaning
|
|
4054 of STATE and CONDITION."
|
|
4055 (cond ((and condition
|
|
4056 (not (memq (car condition) '(buffer-read-only
|
|
4057 end-of-buffer
|
|
4058 beginning-of-buffer))))
|
|
4059 (signal (car condition) (cdr condition)))
|
|
4060 ((< (point) (car state))
|
|
4061 (goto-char (point-min))
|
|
4062 (forward-line 2))
|
|
4063 ((> (point) (cdr state))
|
|
4064 (goto-char (point-max))
|
|
4065 (forward-line -1)
|
|
4066 (if (pos-visible-in-window-p (point-max))
|
|
4067 (recenter -1)))))
|
|
4068
|
|
4069
|
|
4070 (defun ebrowse-electric-position-undefined ()
|
|
4071 "Function called for undefined keys."
|
|
4072 (interactive)
|
|
4073 (message "Type C-h for help, ? for commands, q to quit, Space to execute")
|
|
4074 (sit-for 4))
|
|
4075
|
|
4076
|
|
4077 (defun ebrowse-electric-position-quit ()
|
|
4078 "Leave the electric position list."
|
|
4079 (interactive)
|
|
4080 (throw 'ebrowse-electric-select-position nil))
|
|
4081
|
|
4082
|
|
4083 (defun ebrowse-electric-select-position ()
|
|
4084 "Select a position from the list."
|
|
4085 (interactive)
|
|
4086 (throw 'ebrowse-electric-select-position (point)))
|
|
4087
|
|
4088
|
|
4089 (defun ebrowse-electric-find-position (point &optional view)
|
|
4090 "View/find what is described by the line at POINT.
|
|
4091 If VIEW is non-nil, view else find source files."
|
|
4092 (let ((index (- (count-lines (point-min) point) 2)))
|
|
4093 (ebrowse-view/find-position (nth index
|
|
4094 ebrowse-position-stack) view)))
|
|
4095
|
|
4096
|
|
4097 (defun ebrowse-electric-view-position ()
|
|
4098 "View the position described by the line point is in."
|
|
4099 (interactive)
|
|
4100 (ebrowse-electric-find-position (point) t))
|
|
4101
|
|
4102
|
|
4103
|
|
4104 ;;; Saving trees to disk
|
|
4105
|
|
4106 (defun ebrowse-write-file-hook-fn ()
|
|
4107 "Write current buffer as a class tree.
|
|
4108 Installed on `local-write-file-hooks'."
|
|
4109 (ebrowse-save-tree)
|
|
4110 t)
|
|
4111
|
|
4112
|
37426
|
4113 ;;;###autoload
|
28523
|
4114 (defun ebrowse-save-tree ()
|
|
4115 "Save current tree in same file it was loaded from."
|
|
4116 (interactive)
|
|
4117 (ebrowse-save-tree-as (or buffer-file-name ebrowse--tags-file-name)))
|
|
4118
|
|
4119
|
|
4120 ;;;###autoload
|
|
4121 (defun ebrowse-save-tree-as (&optional file-name)
|
|
4122 "Write the current tree data structure to a file.
|
|
4123 Read the file name from the minibuffer if interactive.
|
|
4124 Otherwise, FILE-NAME specifies the file to save the tree in."
|
|
4125 (interactive "FSave tree as: ")
|
|
4126 (let ((temp-buffer (get-buffer-create "*Tree Output"))
|
|
4127 (old-standard-output standard-output)
|
|
4128 (header (copy-ebrowse-hs ebrowse--header))
|
|
4129 (tree ebrowse--tree))
|
|
4130 (unwind-protect
|
|
4131 (save-excursion
|
|
4132 (set-buffer (setq standard-output temp-buffer))
|
|
4133 (erase-buffer)
|
|
4134 (setf (ebrowse-hs-member-table header) nil)
|
|
4135 (insert (prin1-to-string header) " ")
|
84920
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
4136 (mapc 'ebrowse-save-class tree)
|
28523
|
4137 (write-file file-name)
|
|
4138 (message "Tree written to file `%s'" file-name))
|
|
4139 (kill-buffer temp-buffer)
|
|
4140 (set-buffer-modified-p nil)
|
|
4141 (ebrowse-update-tree-buffer-mode-line)
|
|
4142 (setq standard-output old-standard-output))))
|
|
4143
|
|
4144
|
|
4145 (defun ebrowse-save-class (class)
|
|
4146 "Write single class CLASS to current buffer."
|
|
4147 (message "%s..." (ebrowse-cs-name (ebrowse-ts-class class)))
|
|
4148 (insert "[ebrowse-ts ")
|
|
4149 (prin1 (ebrowse-ts-class class)) ;class name
|
|
4150 (insert "(") ;list of subclasses
|
84920
0aa483c9d53e
(ebrowse-tree-mode, ebrowse-view-exit-fn, ebrowse-member-mode,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
4151 (mapc 'ebrowse-save-class (ebrowse-ts-subclasses class))
|
28523
|
4152 (insert ")")
|
|
4153 (dolist (func ebrowse-member-list-accessors)
|
|
4154 (prin1 (funcall func class))
|
|
4155 (insert "\n"))
|
|
4156 (insert "()") ;base-classes slot
|
|
4157 (prin1 (ebrowse-ts-mark class))
|
|
4158 (insert "]\n"))
|
|
4159
|
|
4160
|
|
4161
|
|
4162 ;;; Statistics
|
|
4163
|
37426
|
4164 ;;;###autoload
|
28523
|
4165 (defun ebrowse-statistics ()
|
|
4166 "Display statistics for a class tree."
|
|
4167 (interactive)
|
|
4168 (let ((tree-file (buffer-file-name))
|
|
4169 temp-buffer-setup-hook)
|
|
4170 (with-output-to-temp-buffer "*Tree Statistics*"
|
|
4171 (multiple-value-bind (classes member-functions member-variables
|
|
4172 static-functions static-variables)
|
102532
|
4173 (values-list (ebrowse-gather-statistics))
|
28523
|
4174 (set-buffer standard-output)
|
|
4175 (erase-buffer)
|
|
4176 (insert "STATISTICS FOR TREE " (or tree-file "unknown") ":\n\n")
|
|
4177 (ebrowse-print-statistics-line "Number of classes:" classes)
|
|
4178 (ebrowse-print-statistics-line "Number of member functions:"
|
|
4179 member-functions)
|
|
4180 (ebrowse-print-statistics-line "Number of member variables:"
|
|
4181 member-variables)
|
|
4182 (ebrowse-print-statistics-line "Number of static functions:"
|
|
4183 static-functions)
|
|
4184 (ebrowse-print-statistics-line "Number of static variables:"
|
|
4185 static-variables)))))
|
|
4186
|
|
4187
|
|
4188 (defun ebrowse-print-statistics-line (title value)
|
|
4189 "Print a line in the statistics buffer.
|
62074
c0b42702a33a
(ebrowse-install-1-to-9-keys, ebrowse-print-statistics-line,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
4190 TITLE is the title of the line, VALUE is a number to be printed
|
28523
|
4191 after that."
|
|
4192 (insert title)
|
|
4193 (indent-to 40)
|
|
4194 (insert (format "%d\n" value)))
|
|
4195
|
|
4196
|
|
4197 (defun ebrowse-gather-statistics ()
|
|
4198 "Return statistics for a class tree.
|
|
4199 The result is a list (NUMBER-OF-CLASSES NUMBER-OF-MEMBER-FUNCTIONS
|
|
4200 NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS
|
|
4201 NUMBER-OF-STATIC-VARIABLES:"
|
|
4202 (let ((classes 0) (member-functions 0) (member-variables 0)
|
|
4203 (static-functions 0) (static-variables 0))
|
|
4204 (ebrowse-for-all-trees (tree ebrowse--tree-obarray)
|
|
4205 (incf classes)
|
|
4206 (incf member-functions (length (ebrowse-ts-member-functions tree)))
|
|
4207 (incf member-variables (length (ebrowse-ts-member-variables tree)))
|
|
4208 (incf static-functions (length (ebrowse-ts-static-functions tree)))
|
|
4209 (incf static-variables (length (ebrowse-ts-static-variables tree))))
|
|
4210 (list classes member-functions member-variables
|
|
4211 static-functions static-variables)))
|
|
4212
|
|
4213
|
|
4214
|
|
4215 ;;; Global key bindings
|
|
4216
|
|
4217 ;;; The following can be used to bind key sequences starting with
|
75082
|
4218 ;;; prefix `\C-c\C-m' to browse commands.
|
28523
|
4219
|
|
4220 (defvar ebrowse-global-map nil
|
|
4221 "*Keymap for Ebrowse commands.")
|
|
4222
|
|
4223
|
75082
|
4224 (defvar ebrowse-global-prefix-key "\C-c\C-m"
|
28523
|
4225 "Prefix key for Ebrowse commands.")
|
|
4226
|
|
4227
|
|
4228 (defvar ebrowse-global-submap-4 nil
|
|
4229 "Keymap used for `ebrowse-global-prefix' followed by `4'.")
|
|
4230
|
|
4231
|
|
4232 (defvar ebrowse-global-submap-5 nil
|
|
4233 "Keymap used for `ebrowse-global-prefix' followed by `5'.")
|
|
4234
|
|
4235
|
|
4236 (unless ebrowse-global-map
|
|
4237 (setq ebrowse-global-map (make-sparse-keymap))
|
|
4238 (setq ebrowse-global-submap-4 (make-sparse-keymap))
|
|
4239 (setq ebrowse-global-submap-5 (make-sparse-keymap))
|
|
4240 (define-key ebrowse-global-map "a" 'ebrowse-tags-apropos)
|
|
4241 (define-key ebrowse-global-map "b" 'ebrowse-pop-to-browser-buffer)
|
|
4242 (define-key ebrowse-global-map "-" 'ebrowse-back-in-position-stack)
|
|
4243 (define-key ebrowse-global-map "+" 'ebrowse-forward-in-position-stack)
|
|
4244 (define-key ebrowse-global-map "l" 'ebrowse-tags-list-members-in-file)
|
|
4245 (define-key ebrowse-global-map "m" 'ebrowse-tags-display-member-buffer)
|
|
4246 (define-key ebrowse-global-map "n" 'ebrowse-tags-next-file)
|
|
4247 (define-key ebrowse-global-map "p" 'ebrowse-electric-position-menu)
|
|
4248 (define-key ebrowse-global-map "s" 'ebrowse-tags-search)
|
|
4249 (define-key ebrowse-global-map "u" 'ebrowse-tags-search-member-use)
|
|
4250 (define-key ebrowse-global-map "v" 'ebrowse-tags-view-definition)
|
|
4251 (define-key ebrowse-global-map "V" 'ebrowse-tags-view-declaration)
|
|
4252 (define-key ebrowse-global-map "%" 'ebrowse-tags-query-replace)
|
|
4253 (define-key ebrowse-global-map "." 'ebrowse-tags-find-definition)
|
|
4254 (define-key ebrowse-global-map "f" 'ebrowse-tags-find-definition)
|
|
4255 (define-key ebrowse-global-map "F" 'ebrowse-tags-find-declaration)
|
|
4256 (define-key ebrowse-global-map "," 'ebrowse-tags-loop-continue)
|
|
4257 (define-key ebrowse-global-map " " 'ebrowse-electric-buffer-list)
|
|
4258 (define-key ebrowse-global-map "\t" 'ebrowse-tags-complete-symbol)
|
|
4259 (define-key ebrowse-global-map "4" ebrowse-global-submap-4)
|
|
4260 (define-key ebrowse-global-submap-4 "." 'ebrowse-tags-find-definition-other-window)
|
|
4261 (define-key ebrowse-global-submap-4 "f" 'ebrowse-tags-find-definition-other-window)
|
|
4262 (define-key ebrowse-global-submap-4 "v" 'ebrowse-tags-find-declaration-other-window)
|
|
4263 (define-key ebrowse-global-submap-4 "F" 'ebrowse-tags-view-definition-other-window)
|
|
4264 (define-key ebrowse-global-submap-4 "V" 'ebrowse-tags-view-declaration-other-window)
|
|
4265 (define-key ebrowse-global-map "5" ebrowse-global-submap-5)
|
|
4266 (define-key ebrowse-global-submap-5 "." 'ebrowse-tags-find-definition-other-frame)
|
|
4267 (define-key ebrowse-global-submap-5 "f" 'ebrowse-tags-find-definition-other-frame)
|
|
4268 (define-key ebrowse-global-submap-5 "v" 'ebrowse-tags-find-declaration-other-frame)
|
|
4269 (define-key ebrowse-global-submap-5 "F" 'ebrowse-tags-view-definition-other-frame)
|
|
4270 (define-key ebrowse-global-submap-5 "V" 'ebrowse-tags-view-declaration-other-frame)
|
|
4271 (define-key global-map ebrowse-global-prefix-key ebrowse-global-map))
|
|
4272
|
|
4273
|
|
4274
|
|
4275 ;;; Electric C++ browser buffer menu
|
|
4276
|
|
4277 ;;; Electric buffer menu customization to display only some buffers
|
|
4278 ;;; (in this case Tree buffers). There is only one problem with this:
|
|
4279 ;;; If the very first character typed in the buffer menu is a space,
|
|
4280 ;;; this will select the buffer from which the buffer menu was
|
|
4281 ;;; invoked. But this buffer is not displayed in the buffer list if
|
|
4282 ;;; it isn't a tree buffer. I therefore let the buffer menu command
|
|
4283 ;;; loop read the command `p' via `unread-command-char'. This command
|
|
4284 ;;; has no effect since we are on the first line of the buffer.
|
|
4285
|
|
4286 (defvar electric-buffer-menu-mode-hook nil)
|
|
4287
|
|
4288
|
|
4289 (defun ebrowse-hack-electric-buffer-menu ()
|
|
4290 "Hack the electric buffer menu to display browser buffers."
|
|
4291 (let (non-empty)
|
|
4292 (unwind-protect
|
|
4293 (save-excursion
|
|
4294 (setq buffer-read-only nil)
|
|
4295 (goto-char 1)
|
|
4296 (forward-line 2)
|
|
4297 (while (not (eobp))
|
|
4298 (let ((b (Buffer-menu-buffer nil)))
|
|
4299 (if (or (ebrowse-buffer-p b)
|
|
4300 (string= (buffer-name b) "*Apropos Members*"))
|
|
4301 (progn (forward-line 1)
|
|
4302 (setq non-empty t))
|
|
4303 (delete-region (point)
|
|
4304 (save-excursion (end-of-line)
|
|
4305 (min (point-max)
|
|
4306 (1+ (point)))))))))
|
|
4307 (unless non-empty
|
|
4308 (error "No tree buffers"))
|
|
4309 (setf unread-command-events (listify-key-sequence "p"))
|
|
4310 (shrink-window-if-larger-than-buffer (selected-window))
|
|
4311 (setq buffer-read-only t))))
|
|
4312
|
|
4313
|
|
4314 (defun ebrowse-select-1st-to-9nth ()
|
|
4315 "Select the nth entry in the list by the keys 1..9."
|
|
4316 (interactive)
|
|
4317 (let* ((maxlin (count-lines (point-min) (point-max)))
|
62402
|
4318 (n (min maxlin (+ 2 (string-to-number (this-command-keys))))))
|
28523
|
4319 (goto-line n)
|
|
4320 (throw 'electric-buffer-menu-select (point))))
|
|
4321
|
|
4322
|
|
4323 (defun ebrowse-install-1-to-9-keys ()
|
62074
c0b42702a33a
(ebrowse-install-1-to-9-keys, ebrowse-print-statistics-line,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
4324 "Define keys 1..9 to select the 1st to 9nth entry in the list."
|
28523
|
4325 (dotimes (i 9)
|
|
4326 (define-key (current-local-map) (char-to-string (+ i ?1))
|
|
4327 'ebrowse-select-1st-to-9nth)))
|
|
4328
|
|
4329
|
|
4330 (defun ebrowse-electric-buffer-list ()
|
|
4331 "Display an electric list of Ebrowse buffers."
|
|
4332 (interactive)
|
|
4333 (unwind-protect
|
|
4334 (progn
|
|
4335 (add-hook 'electric-buffer-menu-mode-hook
|
|
4336 'ebrowse-hack-electric-buffer-menu)
|
|
4337 (add-hook 'electric-buffer-menu-mode-hook
|
|
4338 'ebrowse-install-1-to-9-keys)
|
|
4339 (call-interactively 'electric-buffer-list))
|
|
4340 (remove-hook 'electric-buffer-menu-mode-hook
|
|
4341 'ebrowse-hack-electric-buffer-menu)))
|
|
4342
|
|
4343
|
|
4344 ;;; Mouse support
|
|
4345
|
|
4346 (defun ebrowse-mouse-find-member (event)
|
|
4347 "Find the member clicked on in another frame.
|
|
4348 EVENT is a mouse button event."
|
|
4349 (interactive "e")
|
|
4350 (mouse-set-point event)
|
|
4351 (let (start name)
|
|
4352 (save-excursion
|
|
4353 (skip-chars-backward "a-zA-Z0-9_")
|
|
4354 (setq start (point))
|
|
4355 (skip-chars-forward "a-zA-Z0-9_")
|
|
4356 (setq name (buffer-substring start (point))))
|
|
4357 (ebrowse-tags-view/find-member-decl/defn
|
|
4358 5 :view nil :definition t :member-name name)))
|
|
4359
|
|
4360
|
|
4361 (defun ebrowse-popup-menu (menu event)
|
|
4362 "Pop up MENU and perform an action if something was selected.
|
|
4363 EVENT is the mouse event."
|
|
4364 (save-selected-window
|
|
4365 (select-window (posn-window (event-start event)))
|
|
4366 (let ((selection (x-popup-menu event menu)) binding)
|
|
4367 (while selection
|
|
4368 (setq binding (lookup-key (or binding menu) (vector (car selection)))
|
|
4369 selection (cdr selection)))
|
|
4370 (when binding
|
|
4371 (call-interactively binding)))))
|
|
4372
|
|
4373
|
|
4374 (easy-menu-define
|
47929
|
4375 ebrowse-tree-buffer-class-object-menu ebrowse-tree-mode-map
|
28523
|
4376 "Object menu for classes in the tree buffer"
|
|
4377 '("Class"
|
|
4378 ["Functions" ebrowse-tree-command:show-member-functions
|
|
4379 :help "Display a list of member functions"
|
|
4380 :active t]
|
|
4381 ["Variables" ebrowse-tree-command:show-member-variables
|
|
4382 :help "Display a list of member variables"
|
|
4383 :active t]
|
|
4384 ["Static Functions" ebrowse-tree-command:show-static-member-functions
|
|
4385 :help "Display a list of static member functions"
|
|
4386 :active t]
|
|
4387 ["Static Variables" ebrowse-tree-command:show-static-member-variables
|
|
4388 :help "Display a list of static member variables"
|
|
4389 :active t]
|
|
4390 ["Friends/ Defines" ebrowse-tree-command:show-friends
|
|
4391 :help "Display a list of friends of a class"
|
|
4392 :active t]
|
|
4393 ["Types" ebrowse-tree-command:show-types
|
|
4394 :help "Display a list of types defined in a class"
|
|
4395 :active t]
|
|
4396 "-----------------"
|
|
4397 ["View" ebrowse-view-class-declaration
|
|
4398 :help "View class declaration"
|
|
4399 :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
|
|
4400 ["Find" ebrowse-find-class-declaration
|
|
4401 :help "Find class declaration in file"
|
|
4402 :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
|
|
4403 "-----------------"
|
|
4404 ["Mark" ebrowse-toggle-mark-at-point
|
|
4405 :help "Mark class point is on"
|
|
4406 :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
|
|
4407 "-----------------"
|
|
4408 ["Collapse" ebrowse-collapse-branch
|
|
4409 :help "Collapse subtree under class point is on"
|
|
4410 :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]
|
|
4411 ["Expand" ebrowse-expand-branch
|
|
4412 :help "Expand subtree under class point is on"
|
|
4413 :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)]))
|
|
4414
|
|
4415
|
|
4416 (easy-menu-define
|
47929
|
4417 ebrowse-tree-buffer-object-menu ebrowse-tree-mode-map
|
28523
|
4418 "Object menu for tree buffers"
|
|
4419 '("Ebrowse"
|
|
4420 ["Filename Display" ebrowse-toggle-file-name-display
|
|
4421 :help "Toggle display of source files names"
|
|
4422 :style toggle
|
|
4423 :selected ebrowse--show-file-names-flag
|
|
4424 :active t]
|
|
4425 ["Tree Indentation" ebrowse-set-tree-indentation
|
|
4426 :help "Set the tree's indentation"
|
|
4427 :active t]
|
|
4428 ["Unmark All Classes" ebrowse-mark-all-classes
|
|
4429 :help "Unmark all classes in the class tree"
|
|
4430 :active t]
|
|
4431 ["Expand All" ebrowse-expand-all
|
|
4432 :help "Expand all subtrees in the class tree"
|
|
4433 :active t]
|
|
4434 ["Statistics" ebrowse-statistics
|
|
4435 :help "Show a buffer with class hierarchy statistics"
|
|
4436 :active t]
|
|
4437 ["Find Class" ebrowse-read-class-name-and-go
|
|
4438 :help "Find a class in the tree"
|
|
4439 :active t]
|
|
4440 ["Member Buffer" ebrowse-pop/switch-to-member-buffer-for-same-tree
|
|
4441 :help "Show a member buffer for this class tree"
|
|
4442 :active t]))
|
|
4443
|
|
4444
|
|
4445 (defun ebrowse-mouse-3-in-tree-buffer (event)
|
|
4446 "Perform mouse actions in tree buffers.
|
|
4447 EVENT is the mouse event."
|
|
4448 (interactive "e")
|
|
4449 (mouse-set-point event)
|
|
4450 (let* ((where (posn-point (event-start event)))
|
|
4451 (property (get-text-property where 'ebrowse-what)))
|
|
4452 (case (event-click-count event)
|
|
4453 (1
|
|
4454 (case property
|
|
4455 (class-name
|
|
4456 (ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event))
|
|
4457 (t
|
|
4458 (ebrowse-popup-menu ebrowse-tree-buffer-object-menu event)))))))
|
|
4459
|
|
4460
|
|
4461 (defun ebrowse-mouse-2-in-tree-buffer (event)
|
|
4462 "Perform mouse actions in tree buffers.
|
|
4463 EVENT is the mouse event."
|
|
4464 (interactive "e")
|
|
4465 (mouse-set-point event)
|
|
4466 (let* ((where (posn-point (event-start event)))
|
|
4467 (property (get-text-property where 'ebrowse-what)))
|
|
4468 (case (event-click-count event)
|
|
4469 (1 (case property
|
|
4470 (class-name
|
|
4471 (ebrowse-tree-command:show-member-functions)))))))
|
|
4472
|
|
4473
|
|
4474 (defun ebrowse-mouse-1-in-tree-buffer (event)
|
|
4475 "Perform mouse actions in tree buffers.
|
|
4476 EVENT is the mouse event."
|
|
4477 (interactive "e")
|
|
4478 (mouse-set-point event)
|
|
4479 (let* ((where (posn-point (event-start event)))
|
|
4480 (property (get-text-property where 'ebrowse-what)))
|
|
4481 (case (event-click-count event)
|
|
4482 (2 (case property
|
|
4483 (class-name
|
|
4484 (let ((collapsed (save-excursion (skip-chars-forward "^\r\n")
|
|
4485 (looking-at "\r"))))
|
|
4486 (ebrowse-collapse-fn (not collapsed))))
|
|
4487 (mark
|
|
4488 (ebrowse-toggle-mark-at-point 1)))))))
|
|
4489
|
|
4490
|
|
4491
|
|
4492 (provide 'ebrowse)
|
|
4493
|
101721
|
4494 ;; Local variables:
|
|
4495 ;; eval:(put 'ebrowse-output 'lisp-indent-hook 0)
|
|
4496 ;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
|
|
4497 ;; eval:(put 'ebrowse-save-selective 'lisp-indent-hook 0)
|
|
4498 ;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
|
|
4499 ;; End:
|
28523
|
4500
|
93975
|
4501 ;; arch-tag: 4fa3c8bf-1771-479b-bcd7-b029c7c9677b
|
38412
|
4502 ;;; ebrowse.el ends here
|