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