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