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