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