1 ;;; ebrowse.el --- Emacs C++ class browser & tags facility
3 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
4 ;; 2002, 2003, 2004, 2005, 2006, 2007
5 ;; Free Software Foundation Inc.
7 ;; Author: Gerd Moellmann <gerd@gnu.org>
9 ;; Keywords: C++ tags tools
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to
25 ;; the Free Software Foundation, 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
30 ;; This package implements
32 ;; - A class browser for C++
33 ;; - A complete set of tags-like functions working on class trees
34 ;; - An electric buffer list showing class browser buffers only
36 ;; Documentation is found in a separate Info file.
52 "Settings for the C++ class browser."
56 (defcustom ebrowse-search-path nil
57 "*List of directories to search for source files in a class tree.
58 Elements should be directory names; nil as an element means to try
59 to find source files relative to the location of the BROWSE file loaded."
61 :type
'(repeat (choice (const :tag
"Default" nil
)
62 (string :tag
"Directory"))))
65 (defcustom ebrowse-view
/find-hook nil
66 "*Hooks run after finding or viewing a member or class."
71 (defcustom ebrowse-not-found-hook nil
72 "*Hooks run when finding or viewing a member or class was not successful."
77 (defcustom ebrowse-electric-list-mode-hook nil
78 "*Hook called by `ebrowse-electric-position-mode'."
83 (defcustom ebrowse-max-positions
50
84 "*Number of markers saved on electric position stack."
90 (defgroup ebrowse-tree nil
91 "Settings for class tree buffers."
95 (defcustom ebrowse-tree-mode-hook nil
96 "*Hook run in each new tree buffer."
101 (defcustom ebrowse-tree-buffer-name
"*Tree*"
102 "*The default name of class tree buffers."
107 (defcustom ebrowse--indentation
4
108 "*The amount by which subclasses are indented in the tree."
113 (defcustom ebrowse-source-file-column
40
114 "*The column in which source file names are displayed in the tree."
119 (defcustom ebrowse-tree-left-margin
2
120 "*Amount of space left at the left side of the tree display.
121 This space is used to display markers."
127 (defgroup ebrowse-member nil
128 "Settings for member buffers."
132 (defcustom ebrowse-default-declaration-column
25
133 "*The column in which member declarations are displayed in member buffers."
134 :group
'ebrowse-member
138 (defcustom ebrowse-default-column-width
25
139 "*The width of the columns in member buffers (short display form)."
140 :group
'ebrowse-member
144 (defcustom ebrowse-member-buffer-name
"*Members*"
145 "*The name of the buffer for member display."
146 :group
'ebrowse-member
150 (defcustom ebrowse-member-mode-hook nil
151 "*Run in each new member buffer."
152 :group
'ebrowse-member
157 (defgroup ebrowse-faces nil
158 "Faces used by Ebrowse."
162 (defface ebrowse-tree-mark
163 '((((min-colors 88)) (:foreground
"red1"))
164 (t (:foreground
"red")))
165 "*The face used for the mark character in the tree."
166 :group
'ebrowse-faces
)
167 ;; backward-compatibility alias
168 (put 'ebrowse-tree-mark-face
'face-alias
'ebrowse-tree-mark
)
171 (defface ebrowse-root-class
172 '((((min-colors 88)) (:weight bold
:foreground
"blue1"))
173 (t (:weight bold
:foreground
"blue")))
174 "*The face used for root classes in the tree."
175 :group
'ebrowse-faces
)
176 ;; backward-compatibility alias
177 (put 'ebrowse-root-class-face
'face-alias
'ebrowse-root-class
)
180 (defface ebrowse-file-name
182 "*The face for filenames displayed in the tree."
183 :group
'ebrowse-faces
)
184 ;; backward-compatibility alias
185 (put 'ebrowse-file-name-face
'face-alias
'ebrowse-file-name
)
188 (defface ebrowse-default
190 "*Face for everything else in the tree not having other faces."
191 :group
'ebrowse-faces
)
192 ;; backward-compatibility alias
193 (put 'ebrowse-default-face
'face-alias
'ebrowse-default
)
196 (defface ebrowse-member-attribute
197 '((((min-colors 88)) (:foreground
"red1"))
198 (t (:foreground
"red")))
199 "*Face used to display member attributes."
200 :group
'ebrowse-faces
)
201 ;; backward-compatibility alias
202 (put 'ebrowse-member-attribute-face
'face-alias
'ebrowse-member-attribute
)
205 (defface ebrowse-member-class
206 '((t (:foreground
"purple")))
207 "*Face used to display the class title in member buffers."
208 :group
'ebrowse-faces
)
209 ;; backward-compatibility alias
210 (put 'ebrowse-member-class-face
'face-alias
'ebrowse-member-class
)
213 (defface ebrowse-progress
214 '((((min-colors 88)) (:background
"blue1"))
215 (t (:background
"blue")))
216 "*Face for progress indicator."
217 :group
'ebrowse-faces
)
218 ;; backward-compatibility alias
219 (put 'ebrowse-progress-face
'face-alias
'ebrowse-progress
)
225 (defun ebrowse-some (predicate vector
)
226 "Return true if PREDICATE is true of some element of VECTOR.
227 If so, return the value returned by PREDICATE."
228 (let ((length (length vector
))
231 (while (and (< i length
) (not result
))
232 (setq result
(funcall predicate
(aref vector i
))
237 (defun ebrowse-every (predicate vector
)
238 "Return true if PREDICATE is true of every element of VECTOR."
239 (let ((length (length vector
))
242 (while (and (< i length
) result
)
243 (setq result
(funcall predicate
(aref vector i
))
248 (defun ebrowse-position (item list
&optional test
)
249 "Return the position of ITEM in LIST or nil if not found.
250 Compare items with `eq' or TEST if specified."
254 (when (funcall test item
(car list
))
255 (setq found i list nil
))
256 (setq list
(cdr list
) i
(1+ i
))))
259 (when (eq item
(car list
))
260 (setq found i list nil
))
261 (setq list
(cdr list
) i
(1+ i
)))))
265 (defun ebrowse-delete-if-not (predicate list
)
266 "Remove elements not satisfying PREDICATE from LIST and return the result.
267 This is a destructive operation."
270 (let ((next (cdr list
)))
271 (when (funcall predicate
(car list
))
272 (setq result
(nconc result list
))
273 (setf (cdr list
) nil
))
278 (defmacro ebrowse-output
(&rest body
)
279 "Eval BODY with a writable current buffer.
280 Preserve buffer's modified state."
281 (let ((modified (make-symbol "--ebrowse-output--")))
282 `(let (buffer-read-only (,modified
(buffer-modified-p)))
285 (set-buffer-modified-p ,modified
)))))
288 (defmacro ebrowse-ignoring-completion-case
(&rest body
)
289 "Eval BODY with `completion-ignore-case' bound to t."
290 `(let ((completion-ignore-case t
))
294 (defmacro ebrowse-save-selective
(&rest body
)
295 "Eval BODY with `selective-display' restored at the end."
296 (let ((var (make-symbol "var")))
297 `(let ((,var selective-display
))
300 (setq selective-display
,var
)))))
303 (defmacro ebrowse-for-all-trees
(spec &rest body
)
304 "For all trees in SPEC, eval BODY."
305 (let ((var (make-symbol "var"))
306 (spec-var (car spec
))
308 `(loop for
,var being the symbols of
,array
309 as
,spec-var
= (get ,var
'ebrowse-root
) do
310 (when (vectorp ,spec-var
)
313 ;;; Set indentation for macros above.
315 (put 'ebrowse-output
'lisp-indent-hook
0)
316 (put 'ebrowse-ignoring-completion-case
'lisp-indent-hook
0)
317 (put 'ebrowse-save-selective
'lisp-indent-hook
0)
318 (put 'ebrowse-for-all-trees
'lisp-indent-hook
1)
321 (defsubst ebrowse-set-face
(start end face
)
322 "Set face of a region START END to FACE."
323 (overlay-put (make-overlay start end
) 'face face
))
326 (defun ebrowse-completing-read-value (prompt table initial-input
)
327 "Read a string in the minibuffer, with completion.
328 Case is ignored in completions.
330 PROMPT is a string to prompt with; normally it ends in a colon and a space.
331 TABLE is an alist whose elements' cars are strings, or an obarray.
332 TABLE can also be a function to do the completion itself.
333 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
334 If it is (STRING . POSITION), the initial input
335 is STRING, but point is placed POSITION characters into the string."
336 (ebrowse-ignoring-completion-case
337 (completing-read prompt table nil t initial-input
)))
340 (defun ebrowse-value-in-buffer (sym buffer
)
341 "Return the value of SYM in BUFFER."
342 (let ((old-buffer (current-buffer)))
347 (set-buffer old-buffer
))))
350 (defun ebrowse-rename-buffer (new-name)
351 "Rename current buffer to NEW-NAME.
352 If a buffer with name NEW-NAME already exists, delete it first."
353 (let ((old-buffer (get-buffer new-name
)))
354 (unless (eq old-buffer
(current-buffer))
356 (save-excursion (kill-buffer old-buffer
)))
357 (rename-buffer new-name
))))
360 (defun ebrowse-trim-string (string)
361 "Return a copy of STRING with leading white space removed.
362 Replace sequences of newlines with a single space."
363 (when (string-match "^[ \t\n\r]+" string
)
364 (setq string
(substring string
(match-end 0))))
365 (loop while
(string-match "[\n]+" string
)
366 finally return string do
367 (setq string
(replace-match " " nil t string
))))
370 (defun ebrowse-width-of-drawable-area ()
371 "Return the width of the display area for the current buffer.
372 If buffer is displayed in a window, use that window's width,
373 otherwise use the current frame's width."
374 (let ((window (get-buffer-window (current-buffer))))
376 (window-width window
)
380 ;;; Structure definitions
382 (defstruct (ebrowse-hs (:type vector
) :named
)
383 "Header structure found at the head of BROWSE files."
384 ;; A version string that is compared against the version number of
385 ;; the Lisp package when the file is loaded. This is done to
386 ;; detect file format changes.
388 ;; Command line options used for producing the BROWSE file.
390 ;; The following slot is currently not used. It's kept to keep
391 ;; the file format compatible.
393 ;; A slot that is filled out after the tree is loaded. This slot is
394 ;; set to a hash table mapping members to lists of classes in which
399 (defstruct (ebrowse-ts (:type vector
) :named
)
401 Following the header structure, a BROWSE file contains a number
402 of `ebrowse-ts' structures, each one describing one root class of
403 the class hierarchy with all its subclasses."
404 ;; A `ebrowse-cs' structure describing the root class.
406 ;; A list of `ebrowse-ts' structures for all subclasses.
408 ;; Lists of `ebrowse-ms' structures for each member in a group of
410 member-variables member-functions static-variables static-functions
412 ;; List of `ebrowse-ts' structures for base classes. This slot is
413 ;; filled at load time.
415 ;; A marker slot used in the tree buffer (can be saved back to disk.
419 (defstruct (ebrowse-bs (:type vector
) :named
)
420 "Common sub-structure.
421 A common structure defining an occurrence of some name in the
423 ;; The class or member name as a string constant
425 ;; An optional string for the scope of nested classes or for
428 ;; Various flags describing properties of classes/members, e.g. is
429 ;; template, is const etc.
431 ;; File in which the entity is found. If this is part of a
432 ;; `ebrowse-ms' member description structure, and FILE is nil, then
433 ;; search for the name in the SOURCE-FILE of the members class.
435 ;; Regular expression to search for. This slot can be a number in
436 ;; which case the number is the file position at which the regular
437 ;; expression is found in a separate regexp file (see the header
438 ;; structure). This slot can be nil in which case the regular
439 ;; expression will be generated from the class/member name.
441 ;; The buffer position at which the search for the class or member
446 (defstruct (ebrowse-cs (:include ebrowse-bs
) (:type vector
) :named
)
448 This is the structure stored in the CLASS slot of a `ebrowse-ts'
449 structure. It describes the location of the class declaration."
453 (defstruct (ebrowse-ms (:include ebrowse-bs
) (:type vector
) :named
)
455 This is the structure describing a single member. The `ebrowse-ts'
456 structure contains various lists for the different types of
458 ;; Public, protected, private
460 ;; The file in which the member's definition can be found.
462 ;; Same as PATTERN above, but for the member definition.
464 ;; Same as POINT above but for member definition.
469 ;;; Some macros to access the FLAGS slot of a MEMBER.
471 (defsubst ebrowse-member-bit-set-p
(member bit
)
472 "Value is non-nil if MEMBER's bit BIT is set."
473 (/= 0 (logand (ebrowse-bs-flags member
) bit
)))
476 (defsubst ebrowse-virtual-p
(member)
477 "Value is non-nil if MEMBER is virtual."
478 (ebrowse-member-bit-set-p member
1))
481 (defsubst ebrowse-inline-p
(member)
482 "Value is non-nil if MEMBER is inline."
483 (ebrowse-member-bit-set-p member
2))
486 (defsubst ebrowse-const-p
(member)
487 "Value is non-nil if MEMBER is const."
488 (ebrowse-member-bit-set-p member
4))
491 (defsubst ebrowse-pure-virtual-p
(member)
492 "Value is non-nil if MEMBER is a pure virtual function."
493 (ebrowse-member-bit-set-p member
8))
496 (defsubst ebrowse-mutable-p
(member)
497 "Value is non-nil if MEMBER is mutable."
498 (ebrowse-member-bit-set-p member
16))
501 (defsubst ebrowse-template-p
(member)
502 "Value is non-nil if MEMBER is a template."
503 (ebrowse-member-bit-set-p member
32))
506 (defsubst ebrowse-explicit-p
(member)
507 "Value is non-nil if MEMBER is explicit."
508 (ebrowse-member-bit-set-p member
64))
511 (defsubst ebrowse-throw-list-p
(member)
512 "Value is non-nil if MEMBER has a throw specification."
513 (ebrowse-member-bit-set-p member
128))
516 (defsubst ebrowse-extern-c-p
(member)
517 "Value is non-nil if MEMBER.is `extern \"C\"'."
518 (ebrowse-member-bit-set-p member
256))
521 (defsubst ebrowse-define-p
(member)
522 "Value is non-nil if MEMBER is a define."
523 (ebrowse-member-bit-set-p member
512))
526 (defconst ebrowse-version-string
"ebrowse 5.0"
527 "Version string expected in BROWSE files.")
530 (defconst ebrowse-globals-name
"*Globals*"
531 "The name used for the surrogate class.containing global entities.
532 This must be the same that `ebrowse' uses.")
535 (defvar ebrowse--last-regexp nil
536 "Last regular expression searched for in tree and member buffers.
537 Each tree and member buffer maintains its own search history.")
538 (make-variable-buffer-local 'ebrowse--last-regexp
)
541 (defconst ebrowse-member-list-accessors
542 '(ebrowse-ts-member-variables
543 ebrowse-ts-member-functions
544 ebrowse-ts-static-variables
545 ebrowse-ts-static-functions
548 "List of accessors for member lists.
549 Each element is the symbol of an accessor function.
550 The nth element must be the accessor for the nth member list
551 in an `ebrowse-ts' structure.")
554 ;;; FIXME: Add more doc strings for the buffer-local variables below.
556 (defvar ebrowse--tree-obarray nil
557 "Obarray holding all `ebrowse-ts' structures of a class tree.
558 Buffer-local in Ebrowse buffers.")
561 (defvar ebrowse--tags-file-name nil
562 "File from which BROWSE file was loaded.
563 Buffer-local in Ebrowse buffers.")
566 (defvar ebrowse--header nil
567 "Header structure of type `ebrowse-hs' of a class tree.
568 Buffer-local in Ebrowse buffers.")
571 (defvar ebrowse--frozen-flag nil
572 "Non-nil means an Ebrowse buffer won't be reused.
573 Buffer-local in Ebrowse buffers.")
576 (defvar ebrowse--show-file-names-flag nil
577 "Non-nil means show file names in a tree buffer.
578 Buffer-local in Ebrowse tree buffers.")
581 (defvar ebrowse--long-display-flag nil
582 "Non-nil means show members in long display form.
583 Buffer-local in Ebrowse member buffers.")
586 (defvar ebrowse--n-columns nil
587 "Number of columns to display for short member display form.
588 Buffer-local in Ebrowse member buffers.")
591 (defvar ebrowse--column-width nil
592 "Width of a columns to display for short member display form.
593 Buffer-local in Ebrowse member buffers.")
596 (defvar ebrowse--virtual-display-flag nil
597 "Non-nil means display virtual members in a member buffer.
598 Buffer-local in Ebrowse member buffers.")
601 (defvar ebrowse--inline-display-flag nil
602 "Non-nil means display inline members in a member buffer.
603 Buffer-local in Ebrowse member buffers.")
606 (defvar ebrowse--const-display-flag nil
607 "Non-nil means display const members in a member buffer.
608 Buffer-local in Ebrowse member buffers.")
611 (defvar ebrowse--pure-display-flag nil
612 "Non-nil means display pure virtual members in a member buffer.
613 Buffer-local in Ebrowse member buffers.")
616 (defvar ebrowse--filters nil
617 "Filter for display of public, protected, and private members.
618 This is a vector of three elements. An element nil means the
619 corresponding members are not shown.
620 Buffer-local in Ebrowse member buffers.")
623 (defvar ebrowse--show-inherited-flag nil
624 "Non-nil means display inherited members in a member buffer.
625 Buffer-local in Ebrowse member buffers.")
628 (defvar ebrowse--attributes-flag nil
629 "Non-nil means display member attributes in a member buffer.
630 Buffer-local in Ebrowse member buffers.")
633 (defvar ebrowse--source-regexp-flag nil
634 "Non-nil means display member regexps in a member buffer.
635 Buffer-local in Ebrowse member buffers.")
638 (defvar ebrowse--displayed-class nil
639 "Class displayed in a member buffer, a `ebrowse-ts' structure.
640 Buffer-local in Ebrowse member buffers.")
643 (defvar ebrowse--accessor nil
644 "Member list displayed in a member buffer.
645 This is a symbol whose function definition is an accessor for the
646 member list in `ebrowse-cs' structures.
647 Buffer-local in Ebrowse member buffers.")
650 (defvar ebrowse--member-list nil
651 "The list of `ebrowse-ms' structures displayed in a member buffer.
652 Buffer-local in Ebrowse member buffers.")
655 (defvar ebrowse--decl-column nil
656 "Column in which declarations are displayed in member buffers.
657 Buffer-local in Ebrowse member buffers.")
660 (defvar ebrowse--frame-configuration nil
661 "Frame configuration saved when viewing a class/member in another frame.
662 Buffer-local in Ebrowse buffers.")
665 (defvar ebrowse--view-exit-action nil
666 "Action to perform after viewing a class/member.
667 Either `kill-buffer' or nil.
668 Buffer-local in Ebrowse buffers.")
671 (defvar ebrowse--tree nil
673 Buffer-local in Ebrowse buffers.")
676 ;;; Temporaries used to communicate with `ebrowse-find-pattern'.
678 (defvar ebrowse-temp-position-to-view nil
)
679 (defvar ebrowse-temp-info-to-view nil
)
682 (defvar ebrowse-tree-mode-map
()
683 "The keymap used in tree mode buffers.")
686 (defvar ebrowse--member-mode-strings nil
687 "Strings displayed in the mode line of member buffers.")
690 (defvar ebrowse-member-mode-map
()
691 "The keymap used in the member buffers.")
694 ;;; Define mode line titles for each member list.
696 (put 'ebrowse-ts-member-variables
'ebrowse-title
"Member Variables")
697 (put 'ebrowse-ts-member-functions
'ebrowse-title
"Member Functions")
698 (put 'ebrowse-ts-static-variables
'ebrowse-title
"Static Variables")
699 (put 'ebrowse-ts-static-functions
'ebrowse-title
"Static Functions")
700 (put 'ebrowse-ts-friends
'ebrowse-title
"Friends")
701 (put 'ebrowse-ts-types
'ebrowse-title
"Types")
703 (put 'ebrowse-ts-member-variables
'ebrowse-global-title
"Global Variables")
704 (put 'ebrowse-ts-member-functions
'ebrowse-global-title
"Global Functions")
705 (put 'ebrowse-ts-static-variables
'ebrowse-global-title
"Static Variables")
706 (put 'ebrowse-ts-static-functions
'ebrowse-global-title
"Static Functions")
707 (put 'ebrowse-ts-friends
'ebrowse-global-title
"Defines")
708 (put 'ebrowse-ts-types
'ebrowse-global-title
"Types")
712 ;;; Operations on `ebrowse-ts' structures
714 (defun ebrowse-files-table (&optional marked-only
)
715 "Return an obarray containing all files mentioned in the current tree.
716 The tree is expected in the buffer-local variable `ebrowse--tree-obarray'.
717 MARKED-ONLY non-nil means include marked classes only."
718 (let ((files (make-hash-table :test
'equal
))
720 (ebrowse-for-all-trees (tree ebrowse--tree-obarray
)
721 (when (or (not marked-only
) (ebrowse-ts-mark tree
))
722 (let ((class (ebrowse-ts-class tree
)))
723 (when (zerop (%
(incf i
) 20))
724 (ebrowse-show-progress "Preparing file list" (zerop i
)))
725 ;; Add files mentioned in class description
726 (let ((source-file (ebrowse-cs-source-file class
))
727 (file (ebrowse-cs-file class
)))
729 (puthash source-file source-file files
))
731 (puthash file file files
))
732 ;; For all member lists in this class
733 (loop for accessor in ebrowse-member-list-accessors do
734 (loop for m in
(funcall accessor tree
)
735 for file
= (ebrowse-ms-file m
)
736 for def-file
= (ebrowse-ms-definition-file m
) do
738 (puthash file file files
))
740 (puthash def-file def-file files
))))))))
744 (defun ebrowse-files-list (&optional marked-only
)
745 "Return a list containing all files mentioned in a tree.
746 MARKED-ONLY non-nil means include marked classes only."
748 (maphash #'(lambda (file dummy
) (setq list
(cons file list
)))
749 (ebrowse-files-table marked-only
))
753 (defun* ebrowse-marked-classes-p
()
754 "Value is non-nil if any class in the current class tree is marked."
755 (ebrowse-for-all-trees (tree ebrowse--tree-obarray
)
756 (when (ebrowse-ts-mark tree
)
757 (return-from ebrowse-marked-classes-p tree
))))
760 (defsubst ebrowse-globals-tree-p
(tree)
761 "Return t if TREE is the one for global entities."
762 (string= (ebrowse-bs-name (ebrowse-ts-class tree
))
763 ebrowse-globals-name
))
766 (defsubst ebrowse-qualified-class-name
(class)
767 "Return the name of CLASS with scope prepended, if any."
768 (if (ebrowse-cs-scope class
)
769 (concat (ebrowse-cs-scope class
) "::" (ebrowse-cs-name class
))
770 (ebrowse-cs-name class
)))
773 (defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p
)
774 "Return an alist describing all classes in a tree.
775 Each elements in the list has the form (CLASS-NAME . TREE).
776 CLASS-NAME is the name of the class. TREE is the
777 class tree whose root is QUALIFIED-CLASS-NAME.
778 QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME.
779 The class tree is found in the buffer-local variable `ebrowse--tree-obarray'."
781 (if qualified-names-p
782 (ebrowse-for-all-trees (tree ebrowse--tree-obarray
)
784 (acons (ebrowse-qualified-class-name (ebrowse-ts-class tree
))
786 (ebrowse-for-all-trees (tree ebrowse--tree-obarray
)
788 (acons (ebrowse-cs-name (ebrowse-ts-class tree
))
793 (defun ebrowse-sort-tree-list (list)
794 "Sort a LIST of `ebrowse-ts' structures by qualified class names."
797 (string< (ebrowse-qualified-class-name (ebrowse-ts-class a
))
798 (ebrowse-qualified-class-name (ebrowse-ts-class b
))))))
801 (defun ebrowse-class-in-tree (class tree
)
802 "Search for a class with name CLASS in TREE.
803 If CLASS is found, return the tail of TREE starting at CLASS. This function
804 is used during the load phase where classes appended to a file replace older
806 (let ((tclass (ebrowse-ts-class class
))
808 (while (and tree
(not found
))
809 (let ((root-ptr tree
))
810 (when (string= (ebrowse-qualified-class-name (ebrowse-ts-class (car root-ptr
)))
811 (ebrowse-qualified-class-name tclass
))
812 (setq found root-ptr
))
813 (setq tree
(cdr tree
))))
817 (defun ebrowse-base-classes (tree)
818 "Return list of base-classes of TREE by searching subclass lists.
819 This function must be used instead of the struct slot
820 `base-classes' to access the base-class list directly because it
821 computes this information lazily."
822 (or (ebrowse-ts-base-classes tree
)
823 (setf (ebrowse-ts-base-classes tree
)
824 (loop with to-search
= (list tree
)
826 as search
= (pop to-search
)
827 while search finally return result
828 do
(ebrowse-for-all-trees (ti ebrowse--tree-obarray
)
829 (when (memq search
(ebrowse-ts-subclasses ti
))
830 (unless (memq ti result
)
831 (setq result
(nconc result
(list ti
))))
832 (push ti to-search
)))))))
835 (defun ebrowse-direct-base-classes (tree)
836 "Return the list of direct super classes of TREE."
838 (dolist (s (ebrowse-base-classes tree
))
839 (when (memq tree
(ebrowse-ts-subclasses s
))
840 (setq result
(cons s result
))))
845 ;;; Operations on MEMBER structures/lists
847 (defun ebrowse-name/accessor-alist
(tree accessor
)
848 "Return an alist containing all members of TREE in group ACCESSOR.
849 ACCESSOR is the accessor function for the member list.
850 Elements of the result have the form (NAME . ACCESSOR), where NAME
852 (loop for member in
(funcall accessor tree
)
853 collect
(cons (ebrowse-ms-name member
) accessor
)))
856 (defun ebrowse-name/accessor-alist-for-visible-members
()
857 "Return an alist describing all members visible in the current buffer.
858 Each element of the list has the form (MEMBER-NAME . ACCESSOR),
859 where MEMBER-NAME is the member's name, and ACCESSOR is the struct
860 accessor with which the member's list can be accessed in an `ebrowse-ts'
861 structure. The list includes inherited members if these are visible."
862 (let* ((list (ebrowse-name/accessor-alist ebrowse--displayed-class
864 (if ebrowse--show-inherited-flag
866 (loop for tree in
(ebrowse-base-classes
867 ebrowse--displayed-class
)
868 nconc
(ebrowse-name/accessor-alist
869 tree ebrowse--accessor
)))
873 (defun ebrowse-name/accessor-alist-for-class-members
()
874 "Like `ebrowse-name/accessor-alist-for-visible-members'.
875 This function includes members of base classes if base class members
876 are visible in the buffer."
878 (dolist (func ebrowse-member-list-accessors list
)
879 (setq list
(nconc list
(ebrowse-name/accessor-alist
880 ebrowse--displayed-class func
)))
881 (when ebrowse--show-inherited-flag
882 (dolist (class (ebrowse-base-classes ebrowse--displayed-class
))
884 (nconc list
(ebrowse-name/accessor-alist class func
))))))))
887 ;;; Progress indication
889 (defvar ebrowse-n-boxes
0)
890 (defconst ebrowse-max-boxes
60)
892 (defun ebrowse-show-progress (title &optional start
)
893 "Display a progress indicator.
894 TITLE is the title of the progress message. START non-nil means
895 this is the first progress message displayed."
896 (let (message-log-max)
897 (when start
(setq ebrowse-n-boxes
0))
898 (setq ebrowse-n-boxes
(mod (1+ ebrowse-n-boxes
) ebrowse-max-boxes
))
899 (message (concat title
": "
900 (propertize (make-string ebrowse-n-boxes
901 (if (display-color-p) ?\ ?
+))
902 'face
'ebrowse-progress
)))))
905 ;;; Reading a tree from disk
907 (defun ebrowse-read ()
908 "Read `ebrowse-hs' and `ebrowse-ts' structures in the current buffer.
909 Return a list (HEADER TREE) where HEADER is the file header read
910 and TREE is a list of `ebrowse-ts' structures forming the class tree."
911 (let ((header (condition-case nil
912 (read (current-buffer))
913 (error (error "No Ebrowse file header found"))))
915 ;; Check file format.
916 (unless (ebrowse-hs-p header
)
917 (error "No Ebrowse file header found"))
918 (unless (string= (ebrowse-hs-version header
) ebrowse-version-string
)
919 (error "File has wrong version `%s' (`%s' expected)"
920 (ebrowse-hs-version header
) ebrowse-version-string
))
921 ;; Read Lisp objects. Temporarily increase `gc-cons-threshold' to
922 ;; prevent a GC that would not free any memory.
923 (let ((gc-cons-threshold 2000000))
924 (while (not (progn (skip-chars-forward " \t\n\r") (eobp)))
925 (let* ((root (read (current-buffer)))
926 (old-root-ptr (ebrowse-class-in-tree root tree
)))
927 (ebrowse-show-progress "Reading data" (null tree
))
929 (setcar old-root-ptr root
)
935 (defun ebrowse-revert-tree-buffer-from-file (ignore-auto-save noconfirm
)
936 "Function installed as `revert-buffer-function' in tree buffers.
937 See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and
939 (when (or noconfirm
(yes-or-no-p "Revert tree from disk? "))
940 (loop for member-buffer in
(ebrowse-same-tree-member-buffer-list)
941 do
(kill-buffer member-buffer
))
944 (insert-file (or buffer-file-name ebrowse--tags-file-name
)))
949 (defun ebrowse-create-tree-buffer (tree tags-file header obarray pop
)
950 "Create a new tree buffer for tree TREE.
951 The tree was loaded from file TAGS-FILE.
952 HEADER is the header structure of the file.
953 OBARRAY is an obarray with a symbol for each class in the tree.
954 POP non-nil means popup the buffer up at the end.
955 Return the buffer created."
956 (let ((name ebrowse-tree-buffer-name
))
957 (set-buffer (get-buffer-create name
))
959 (setq ebrowse--tree tree
960 ebrowse--tags-file-name tags-file
961 ebrowse--tree-obarray obarray
962 ebrowse--header header
963 ebrowse--frozen-flag nil
)
964 (ebrowse-redraw-tree)
965 (set-buffer-modified-p nil
)
967 (switch (switch-to-buffer name
))
968 (pop (pop-to-buffer name
)))
973 ;;; Operations for member obarrays
975 (defun ebrowse-fill-member-table ()
976 "Return an obarray holding all members of all classes in the current tree.
978 For each member, a symbol is added to the obarray. Members are
979 extracted from the buffer-local tree `ebrowse--tree-obarray'.
981 Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST
982 MEMBER) where TREE is the tree in which the member is defined,
983 MEMBER-LIST is a symbol describing the member list in which the member
984 is found, and MEMBER is a MEMBER structure describing the member.
986 The slot `member-table' of the buffer-local header structure of
987 type `ebrowse-hs' is set to the resulting obarray."
988 (let ((members (make-hash-table :test
'equal
))
990 (setf (ebrowse-hs-member-table ebrowse--header
) nil
)
992 ;; For all classes...
993 (ebrowse-for-all-trees (c ebrowse--tree-obarray
)
994 (when (zerop (%
(incf i
) 10))
995 (ebrowse-show-progress "Preparing member lookup" (zerop i
)))
996 (loop for f in ebrowse-member-list-accessors do
997 (loop for m in
(funcall f c
) do
998 (let* ((member-name (ebrowse-ms-name m
))
999 (value (gethash member-name members
)))
1000 (push (list c f m
) value
)
1001 (puthash member-name value members
)))))
1002 (setf (ebrowse-hs-member-table ebrowse--header
) members
)))
1005 (defun ebrowse-member-table (header)
1006 "Return the member obarray. Build it it hasn't been set up yet.
1007 HEADER is the tree header structure of the class tree."
1008 (when (null (ebrowse-hs-member-table header
))
1009 (loop for buffer in
(ebrowse-browser-buffer-list)
1010 until
(eq header
(ebrowse-value-in-buffer 'ebrowse--header buffer
))
1014 (ebrowse-fill-member-table))))
1015 (ebrowse-hs-member-table header
))
1019 ;;; Operations on TREE obarrays
1021 (defun ebrowse-build-tree-obarray (tree)
1022 "Make sure every class in TREE is represented by a unique object.
1023 Build obarray of all classes in TREE."
1024 (let ((classes (make-vector 127 0)))
1025 ;; Add root classes...
1026 (loop for root in tree
1028 (intern (ebrowse-qualified-class-name (ebrowse-ts-class root
)) classes
)
1029 do
(unless (get sym
'ebrowse-root
)
1030 (setf (get sym
'ebrowse-root
) root
)))
1031 ;; Process subclasses
1032 (ebrowse-insert-supers tree classes
)
1036 (defun ebrowse-insert-supers (tree classes
)
1037 "Build base class lists in class tree TREE.
1038 CLASSES is an obarray used to collect classes.
1040 Helper function for `ebrowse-build-tree-obarray'. Base classes should
1041 be ordered so that immediate base classes come first, then the base
1042 class of the immediate base class and so on. This means that we must
1043 construct the base-class list top down with adding each level at the
1044 beginning of the base-class list.
1046 We have to be cautious here not to end up in an infinite recursion
1047 if for some reason a circle is in the inheritance graph."
1048 (loop for class in tree
1049 as subclasses
= (ebrowse-ts-subclasses class
) do
1050 ;; Make sure every class is represented by a unique object
1051 (loop for subclass on subclasses
1053 (ebrowse-qualified-class-name (ebrowse-ts-class (car subclass
)))
1057 ;; Replace the subclass tree with the one found in
1058 ;; CLASSES if there is already an entry for that class
1059 ;; in it. Otherwise make a new entry.
1061 ;; CAVEAT: If by some means (e.g., use of the
1062 ;; preprocessor in class declarations, a name is marked
1063 ;; as a subclass of itself on some path, we would end up
1064 ;; in an endless loop. We have to omit subclasses from
1065 ;; the recursion that already have been processed.
1066 (if (get sym
'ebrowse-root
)
1067 (setf (car subclass
) (get sym
'ebrowse-root
))
1068 (setf (get sym
'ebrowse-root
) (car subclass
))))
1069 ;; Process subclasses
1070 (ebrowse-insert-supers subclasses classes
)))
1075 (unless ebrowse-tree-mode-map
1076 (let ((map (make-keymap)))
1077 (setf ebrowse-tree-mode-map map
)
1078 (suppress-keymap map
)
1080 (when (display-mouse-p)
1081 (define-key map
[down-mouse-3
] 'ebrowse-mouse-3-in-tree-buffer
)
1082 (define-key map
[mouse-2
] 'ebrowse-mouse-2-in-tree-buffer
)
1083 (define-key map
[down-mouse-1
] 'ebrowse-mouse-1-in-tree-buffer
))
1085 (let ((map1 (make-sparse-keymap)))
1086 (suppress-keymap map1 t
)
1087 (define-key map
"L" map1
)
1088 (define-key map1
"d" 'ebrowse-tree-command
:show-friends
)
1089 (define-key map1
"f" 'ebrowse-tree-command
:show-member-functions
)
1090 (define-key map1
"F" 'ebrowse-tree-command
:show-static-member-functions
)
1091 (define-key map1
"t" 'ebrowse-tree-command
:show-types
)
1092 (define-key map1
"v" 'ebrowse-tree-command
:show-member-variables
)
1093 (define-key map1
"V" 'ebrowse-tree-command
:show-static-member-variables
))
1095 (let ((map1 (make-sparse-keymap)))
1096 (suppress-keymap map1 t
)
1097 (define-key map
"M" map1
)
1098 (define-key map1
"a" 'ebrowse-mark-all-classes
)
1099 (define-key map1
"t" 'ebrowse-toggle-mark-at-point
))
1101 (let ((map1 (make-sparse-keymap)))
1102 (suppress-keymap map1 t
)
1103 (define-key map
"T" map1
)
1104 (define-key map1
"f" 'ebrowse-toggle-file-name-display
)
1105 (define-key map1
"s" 'ebrowse-show-file-name-at-point
)
1106 (define-key map1
"w" 'ebrowse-set-tree-indentation
)
1107 (define-key map
"x" 'ebrowse-statistics
))
1109 (define-key map
"n" 'ebrowse-repeat-member-search
)
1110 (define-key map
"q" 'bury-buffer
)
1111 (define-key map
"*" 'ebrowse-expand-all
)
1112 (define-key map
"+" 'ebrowse-expand-branch
)
1113 (define-key map
"-" 'ebrowse-collapse-branch
)
1114 (define-key map
"/" 'ebrowse-read-class-name-and-go
)
1115 (define-key map
" " 'ebrowse-view-class-declaration
)
1116 (define-key map
"?" 'describe-mode
)
1117 (define-key map
"\C-i" 'ebrowse-pop
/switch-to-member-buffer-for-same-tree
)
1118 (define-key map
"\C-k" 'ebrowse-remove-class-at-point
)
1119 (define-key map
"\C-l" 'ebrowse-redraw-tree
)
1120 (define-key map
"\C-m" 'ebrowse-find-class-declaration
)))
1124 ;;; Tree-mode - mode for tree buffers
1127 (defun ebrowse-tree-mode ()
1128 "Major mode for Ebrowse class tree buffers.
1129 Each line corresponds to a class in a class tree.
1130 Letters do not insert themselves, they are commands.
1131 File operations in the tree buffer work on class tree data structures.
1132 E.g.\\[save-buffer] writes the tree to the file it was loaded from.
1134 Tree mode key bindings:
1135 \\{ebrowse-tree-mode-map}"
1137 (let* ((ident (propertized-buffer-identification "C++ Tree"))
1138 header tree buffer-read-only
)
1140 (kill-all-local-variables)
1141 (use-local-map ebrowse-tree-mode-map
)
1143 (unless (zerop (buffer-size))
1144 (goto-char (point-min))
1145 (multiple-value-setq (header tree
) (ebrowse-read))
1146 (message "Sorting. Please be patient...")
1147 (setq tree
(ebrowse-sort-tree-list tree
))
1151 (mapcar 'make-local-variable
1152 '(ebrowse--tags-file-name
1153 ebrowse--indentation
1156 ebrowse--show-file-names-flag
1157 ebrowse--frozen-flag
1158 ebrowse--tree-obarray
1159 revert-buffer-function
))
1161 (setf ebrowse--show-file-names-flag nil
1162 ebrowse--tree-obarray
(make-vector 127 0)
1163 ebrowse--frozen-flag nil
1164 major-mode
'ebrowse-tree-mode
1165 mode-name
"Ebrowse-Tree"
1166 mode-line-buffer-identification ident
1169 selective-display-ellipses t
1170 revert-buffer-function
'ebrowse-revert-tree-buffer-from-file
1171 ebrowse--header header
1173 ebrowse--tags-file-name
(buffer-file-name)
1174 ebrowse--tree-obarray
(and tree
(ebrowse-build-tree-obarray tree
))
1175 ebrowse--frozen-flag nil
)
1177 (add-hook 'local-write-file-hooks
'ebrowse-write-file-hook-fn
)
1178 (modify-syntax-entry ?_
(char-to-string (char-syntax ?a
)))
1180 (ebrowse-redraw-tree)
1181 (set-buffer-modified-p nil
))
1182 (run-mode-hooks 'ebrowse-tree-mode-hook
)))
1186 (defun ebrowse-update-tree-buffer-mode-line ()
1187 "Update the tree buffer mode line."
1188 (ebrowse-rename-buffer (if ebrowse--frozen-flag
1189 (ebrowse-frozen-tree-buffer-name
1190 ebrowse--tags-file-name
)
1191 ebrowse-tree-buffer-name
))
1192 (force-mode-line-update))
1196 ;;; Removing classes from trees
1198 (defun ebrowse-remove-class-and-kill-member-buffers (tree class
)
1199 "Remove from TREE class CLASS.
1200 Kill all member buffers still containing a reference to the class."
1201 (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class
))
1202 ebrowse--tree-obarray
)))
1203 (setf tree
(delq class tree
)
1204 (get sym
'ebrowse-root
) nil
)
1206 (setf (ebrowse-ts-subclasses root
)
1207 (delq class
(ebrowse-ts-subclasses root
))
1208 (ebrowse-ts-base-classes root
) nil
)
1209 (ebrowse-remove-class-and-kill-member-buffers
1210 (ebrowse-ts-subclasses root
) class
))
1211 (ebrowse-kill-member-buffers-displaying class
)
1215 (defun ebrowse-remove-class-at-point (forced)
1216 "Remove the class point is on from the class tree.
1217 Do not ask for confirmation if FORCED is non-nil."
1219 (let* ((class (ebrowse-tree-at-point))
1220 (class-name (ebrowse-cs-name (ebrowse-ts-class class
)))
1221 (subclasses (ebrowse-ts-subclasses class
)))
1223 (y-or-n-p (concat "Delete class " class-name
"? ")))
1224 (setf ebrowse--tree
(ebrowse-remove-class-and-kill-member-buffers
1225 ebrowse--tree class
))
1226 (set-buffer-modified-p t
)
1227 (message "%s %sdeleted." class-name
1228 (if subclasses
"and derived classes " ""))
1229 (ebrowse-redraw-tree))
1230 (t (message "Aborted")))))
1234 ;;; Marking classes in the tree buffer
1236 (defun ebrowse-toggle-mark-at-point (&optional n-times
)
1237 "Toggle mark for class cursor is on.
1238 If given a numeric N-TIMES argument, mark that many classes."
1240 (let (to-change pnt
)
1241 ;; Get the classes whose mark must be toggled. Note that
1242 ;; ebrowse-tree-at-point might issue an error.
1243 (condition-case error
1244 (loop repeat
(or n-times
1)
1245 as tree
= (ebrowse-tree-at-point)
1247 (setf (ebrowse-ts-mark tree
) (not (ebrowse-ts-mark tree
)))
1249 (push tree to-change
)))
1252 ;; For all these classes, reverse the mark char in the display
1253 ;; by a regexp replace over the whole buffer. The reason for this
1254 ;; is that classes might have multiple base classes. If this is
1255 ;; the case, they are displayed more than once in the tree.
1257 (loop for tree in to-change
1258 as regexp
= (concat "^.*\\b"
1260 (ebrowse-cs-name (ebrowse-ts-class tree
)))
1263 (goto-char (point-min))
1264 (loop while
(re-search-forward regexp nil t
)
1266 (goto-char (match-beginning 0))
1268 (insert-char (if (ebrowse-ts-mark tree
) ?
> ?
) 1)
1269 (ebrowse-set-mark-props (1- (point)) (point) tree
)
1270 (goto-char (match-end 0)))))))))
1273 (defun ebrowse-mark-all-classes (prefix)
1274 "Unmark, with PREFIX mark, all classes in the tree."
1276 (ebrowse-for-all-trees (tree ebrowse--tree-obarray
)
1277 (setf (ebrowse-ts-mark tree
) prefix
))
1278 (ebrowse-redraw-marks (point-min) (point-max)))
1281 (defun ebrowse-redraw-marks (start end
)
1282 "Display class marker signs in the tree between START and END."
1287 (goto-char (point-min))
1288 (dolist (root ebrowse--tree
)
1289 (ebrowse-draw-marks-fn root start end
))))
1290 (ebrowse-update-tree-buffer-mode-line)))
1293 (defun ebrowse-draw-marks-fn (tree start end
)
1294 "Display class marker signs in TREE between START and END."
1295 (when (>= (point) start
)
1297 (insert (if (ebrowse-ts-mark tree
) ?
> ?
))
1298 (ebrowse-set-mark-props (1- (point)) (point) tree
))
1300 (when (> (point) end
)
1302 (dolist (sub (ebrowse-ts-subclasses tree
))
1303 (ebrowse-draw-marks-fn sub start end
)))
1307 ;;; File name display in tree buffers
1309 (defun ebrowse-show-file-name-at-point (prefix)
1310 "Show filename in the line point is in.
1311 With PREFIX, insert that many filenames."
1313 (unless ebrowse--show-file-names-flag
1316 (let ((tree (ebrowse-tree-at-point))
1320 (skip-chars-forward " \t*a-zA-Z0-9_")
1322 file-name-existing
(looking-at "("))
1323 (delete-region start
(save-excursion (end-of-line) (point)))
1324 (unless file-name-existing
1325 (indent-to ebrowse-source-file-column
)
1326 (insert "(" (or (ebrowse-cs-file
1327 (ebrowse-ts-class tree
))
1330 (ebrowse-set-face start
(point) 'ebrowse-file-name
)
1332 (forward-line 1))))))
1335 (defun ebrowse-toggle-file-name-display ()
1336 "Toggle display of filenames in tree buffer."
1338 (setf ebrowse--show-file-names-flag
(not ebrowse--show-file-names-flag
))
1339 (let ((old-line (count-lines (point-min) (point))))
1340 (ebrowse-redraw-tree)
1341 (goto-line old-line
)))
1345 ;;; General member and tree buffer functions
1347 (defun ebrowse-member-buffer-p (buffer)
1348 "Value is non-nil if BUFFER is a member buffer."
1349 (eq (cdr (assoc 'major-mode
(buffer-local-variables buffer
)))
1350 'ebrowse-member-mode
))
1353 (defun ebrowse-tree-buffer-p (buffer)
1354 "Value is non-nil if BUFFER is a class tree buffer."
1355 (eq (cdr (assoc 'major-mode
(buffer-local-variables buffer
)))
1356 'ebrowse-tree-mode
))
1359 (defun ebrowse-buffer-p (buffer)
1360 "Value is non-nil if BUFFER is a tree or member buffer."
1361 (memq (cdr (assoc 'major-mode
(buffer-local-variables buffer
)))
1362 '(ebrowse-tree-mode ebrowse-member-mode
)))
1365 (defun ebrowse-browser-buffer-list ()
1366 "Return a list of all tree or member buffers."
1367 (ebrowse-delete-if-not 'ebrowse-buffer-p
(buffer-list)))
1370 (defun ebrowse-member-buffer-list ()
1371 "Return a list of all member buffers."
1372 (ebrowse-delete-if-not 'ebrowse-member-buffer-p
(buffer-list)))
1375 (defun ebrowse-tree-buffer-list ()
1376 "Return a list of all tree buffers."
1377 (ebrowse-delete-if-not 'ebrowse-tree-buffer-p
(buffer-list)))
1380 (defun ebrowse-known-class-trees-buffer-list ()
1381 "Return a list of buffers containing class trees.
1382 The list will contain, for each class tree loaded,
1383 one buffer. Prefer tree buffers over member buffers."
1384 (let ((buffers (nconc (ebrowse-tree-buffer-list)
1385 (ebrowse-member-buffer-list)))
1386 (set (make-hash-table))
1388 (dolist (buffer buffers
)
1389 (let ((tree (ebrowse-value-in-buffer 'ebrowse--tree buffer
)))
1390 (unless (gethash tree set
)
1391 (push buffer result
))
1392 (puthash tree t set
)))
1396 (defun ebrowse-same-tree-member-buffer-list ()
1397 "Return a list of members buffers with same tree as current buffer."
1398 (ebrowse-delete-if-not
1400 (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer
)
1402 (ebrowse-member-buffer-list)))
1406 (defun ebrowse-pop/switch-to-member-buffer-for-same-tree
(arg)
1407 "Pop to the buffer displaying members.
1408 Switch to buffer if prefix ARG.
1409 If no member buffer exists, make one."
1411 (let ((buf (or (first (ebrowse-same-tree-member-buffer-list))
1412 (get-buffer ebrowse-member-buffer-name
)
1413 (ebrowse-tree-command:show-member-functions
))))
1416 (switch-to-buffer buf
)
1417 (pop-to-buffer buf
)))
1421 (defun ebrowse-switch-to-next-member-buffer ()
1422 "Switch to next member buffer."
1424 (let* ((list (ebrowse-member-buffer-list))
1425 (next-list (cdr (memq (current-buffer) list
)))
1426 (next-buffer (if next-list
(car next-list
) (car list
))))
1427 (if (eq next-buffer
(current-buffer))
1428 (error "No next buffer")
1430 (switch-to-buffer next-buffer
))))
1433 (defun ebrowse-kill-member-buffers-displaying (tree)
1434 "Kill all member buffers displaying TREE."
1435 (loop for buffer in
(ebrowse-member-buffer-list)
1436 as class
= (ebrowse-value-in-buffer 'ebrowse--displayed-class buffer
)
1437 when
(eq class tree
) do
(kill-buffer buffer
)))
1440 (defun ebrowse-frozen-tree-buffer-name (tags-file-name)
1441 "Return the buffer name of a tree which is associated TAGS-FILE-NAME."
1442 (concat ebrowse-tree-buffer-name
" (" tags-file-name
")"))
1445 (defun ebrowse-pop-to-browser-buffer (arg)
1446 "Pop to a browser buffer from any other buffer.
1447 Pop to member buffer if no prefix ARG, to tree buffer otherwise."
1449 (let ((buffer (get-buffer (if arg
1450 ebrowse-tree-buffer-name
1451 ebrowse-member-buffer-name
))))
1455 ebrowse-member-buffer-name
1456 ebrowse-tree-buffer-name
))))
1458 (error "No browser buffer found"))
1459 (pop-to-buffer buffer
)))
1463 ;;; Misc tree buffer commands
1465 (defun ebrowse-set-tree-indentation ()
1466 "Set the indentation width of the tree display."
1468 (let ((width (string-to-number (read-from-minibuffer
1469 (concat "Indentation ("
1470 (int-to-string ebrowse--indentation
)
1473 (setf ebrowse--indentation width
)
1474 (ebrowse-redraw-tree))))
1477 (defun ebrowse-read-class-name-and-go (&optional class
)
1478 "Position cursor on CLASS.
1479 Read a class name from the minibuffer if CLASS is nil."
1481 (ebrowse-ignoring-completion-case
1482 ;; If no class specified, read the class name from mini-buffer
1485 (completing-read "Goto class: "
1486 (ebrowse-tree-obarray-as-alist) nil t
)))
1487 (ebrowse-save-selective
1488 (goto-char (point-min))
1490 (setf selective-display nil
)
1491 (setq ebrowse--last-regexp
(concat "\\b" class
"\\b"))
1492 (if (re-search-forward ebrowse--last-regexp nil t
)
1494 (goto-char (match-beginning 0))
1495 (ebrowse-unhide-base-classes))
1496 (error "Not found")))))
1500 ;;; Showing various kinds of member buffers
1502 (defun ebrowse-tree-command:show-member-variables
(arg)
1503 "Display member variables; with prefix ARG in frozen member buffer."
1505 (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg
))
1508 (defun ebrowse-tree-command:show-member-functions
(&optional arg
)
1509 "Display member functions; with prefix ARG in frozen member buffer."
1511 (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg
))
1514 (defun ebrowse-tree-command:show-static-member-variables
(arg)
1515 "Display static member variables; with prefix ARG in frozen member buffer."
1517 (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg
))
1520 (defun ebrowse-tree-command:show-static-member-functions
(arg)
1521 "Display static member functions; with prefix ARG in frozen member buffer."
1523 (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg
))
1526 (defun ebrowse-tree-command:show-friends
(arg)
1527 "Display friend functions; with prefix ARG in frozen member buffer."
1529 (ebrowse-display-member-buffer 'ebrowse-ts-friends arg
))
1532 (defun ebrowse-tree-command:show-types
(arg)
1533 "Display types defined in a class; with prefix ARG in frozen member buffer."
1535 (ebrowse-display-member-buffer 'ebrowse-ts-types arg
))
1539 ;;; Viewing or finding a class declaration
1541 (defun ebrowse-tree-at-point ()
1542 "Return the class structure for the class point is on."
1543 (or (get-text-property (point) 'ebrowse-tree
)
1544 (error "Not on a class")))
1547 (defun* ebrowse-view
/find-class-declaration
(&key view where
)
1548 "View or find the declarator of the class point is on.
1549 VIEW non-nil means view it. WHERE is additional position info."
1550 (let* ((class (ebrowse-ts-class (ebrowse-tree-at-point)))
1551 (file (ebrowse-cs-file class
))
1552 (browse-struct (make-ebrowse-bs
1553 :name
(ebrowse-cs-name class
)
1554 :pattern
(ebrowse-cs-pattern class
)
1555 :flags
(ebrowse-cs-flags class
)
1556 :file
(ebrowse-cs-file class
)
1557 :point
(ebrowse-cs-point class
))))
1558 (ebrowse-view/find-file-and-search-pattern
1560 (list ebrowse--header class nil
)
1562 ebrowse--tags-file-name
1567 (defun ebrowse-find-class-declaration (prefix-arg)
1568 "Find a class declaration and position cursor on it.
1569 PREFIX-ARG 4 means find it in another window.
1570 PREFIX-ARG 5 means find it in another frame."
1572 (ebrowse-view/find-class-declaration
1574 :where
(cond ((= prefix-arg
4) 'other-window
)
1575 ((= prefix-arg
5) 'other-frame
)
1579 (defun ebrowse-view-class-declaration (prefix-arg)
1580 "View class declaration and position cursor on it.
1581 PREFIX-ARG 4 means view it in another window.
1582 PREFIX-ARG 5 means view it in another frame."
1584 (ebrowse-view/find-class-declaration
1586 :where
(cond ((= prefix-arg
4) 'other-window
)
1587 ((= prefix-arg
5) 'other-frame
)
1594 (defun ebrowse-find-source-file (file tags-file-name
)
1595 "Find source file FILE.
1596 Source files are searched for (a) relative to TAGS-FILE-NAME
1597 which is the path of the BROWSE file from which the class tree was loaded,
1598 and (b) in the directories named in `ebrowse-search-path'."
1600 (try-file (expand-file-name file
1601 (file-name-directory tags-file-name
))))
1602 (if (file-readable-p try-file
)
1603 (setq file-name try-file
)
1604 (let ((search-in ebrowse-search-path
))
1605 (while (and search-in
1607 (let ((try-file (expand-file-name file
(car search-in
))))
1608 (if (file-readable-p try-file
)
1609 (setq file-name try-file
))
1610 (setq search-in
(cdr search-in
))))))
1612 (error "File `%s' not found" file
))
1616 (defun ebrowse-view-file-other-window (file)
1617 "View a file FILE in another window.
1618 This is a replacement for `view-file-other-window' which does not
1619 seem to work. It should be removed when `view.el' is fixed."
1621 (let ((old-arrangement (current-window-configuration))
1622 (had-a-buf (get-file-buffer file
))
1623 (buf-to-view (find-file-noselect file
)))
1624 (switch-to-buffer-other-window buf-to-view
)
1625 (view-mode-enter old-arrangement
1626 (and (not had-a-buf
)
1627 (not (buffer-modified-p buf-to-view
))
1631 (defun ebrowse-view-exit-fn (buffer)
1632 "Function called when exiting View mode in BUFFER.
1633 Restore frame configuration active before viewing the file,
1634 and possibly kill the viewed buffer."
1635 (let (exit-action original-frame-configuration
)
1638 (setq original-frame-configuration ebrowse--frame-configuration
1639 exit-action ebrowse--view-exit-action
))
1640 ;; Delete the frame in which we viewed.
1641 (mapcar 'delete-frame
1642 (loop for frame in
(frame-list)
1643 when
(not (assq frame original-frame-configuration
))
1646 (funcall exit-action buffer
))))
1649 (defun ebrowse-view-file-other-frame (file)
1650 "View a file FILE in another frame.
1651 The new frame is deleted when it is no longer used."
1653 (let ((old-frame-configuration (current-frame-configuration))
1654 (old-arrangement (current-window-configuration))
1655 (had-a-buf (get-file-buffer file
))
1656 (buf-to-view (find-file-noselect file
)))
1657 (switch-to-buffer-other-frame buf-to-view
)
1658 (make-local-variable 'ebrowse--frame-configuration
)
1659 (setq ebrowse--frame-configuration old-frame-configuration
)
1660 (make-local-variable 'ebrowse--view-exit-action
)
1661 (setq ebrowse--view-exit-action
1662 (and (not had-a-buf
)
1663 (not (buffer-modified-p buf-to-view
))
1665 (view-mode-enter old-arrangement
'ebrowse-view-exit-fn
)))
1668 (defun ebrowse-view/find-file-and-search-pattern
1669 (struc info file tags-file-name
&optional view where
)
1670 "Find or view a member or class.
1671 STRUC is an `ebrowse-bs' structure (or a structure including that)
1672 describing what to search.
1673 INFO is a list (HEADER MEMBER-OR-CLASS ACCESSOR). HEADER is the
1674 header structure of a class tree. MEMBER-OR-CLASS is either an
1675 `ebrowse-ms' or `ebrowse-cs' structure depending on what is searched.
1676 ACCESSOR is an accessor function for the member list of a member
1677 if MEMBER-OR-CLASS is an `ebrowse-ms'.
1678 FILE is the file to search the member in.
1679 FILE is not taken out of STRUC here because the filename in STRUC
1680 may be nil in which case the filename of the class description is used.
1681 TAGS-FILE-NAME is the name of the BROWSE file from which the
1683 If VIEW is non-nil, view file else find the file.
1684 WHERE is either `other-window', `other-frame' or `this-window' and
1685 specifies where to find/view the result."
1687 (error "Sorry, no file information available for %s"
1688 (ebrowse-bs-name struc
)))
1689 ;; Get the source file to view or find.
1690 (setf file
(ebrowse-find-source-file file tags-file-name
))
1691 ;; If current window is dedicated, use another frame.
1692 (when (window-dedicated-p (selected-window))
1693 (setf where
'other-window
))
1695 (setf ebrowse-temp-position-to-view struc
1696 ebrowse-temp-info-to-view info
)
1697 (unless (boundp 'view-mode-hook
)
1698 (setq view-mode-hook nil
))
1699 (push 'ebrowse-find-pattern view-mode-hook
)
1701 (other-window (ebrowse-view-file-other-window file
))
1702 (other-frame (ebrowse-view-file-other-frame file
))
1703 (t (view-file file
))))
1706 (other-window (find-file-other-window file
))
1707 (other-frame (find-file-other-frame file
))
1708 (t (find-file file
)))
1709 (ebrowse-find-pattern struc info
))))
1712 (defun ebrowse-symbol-regexp (name)
1713 "Generate a suitable regular expression for a member or class NAME.
1714 This is `regexp-quote' for most symbols, except for operator names
1715 which may contain whitespace. For these symbols, replace white
1716 space in the symbol name (generated by BROWSE) with a regular
1717 expression matching any number of whitespace characters."
1718 (loop with regexp
= (regexp-quote name
)
1720 finally return regexp
1721 while
(string-match "[ \t]+" regexp start
)
1722 do
(setq regexp
(concat (substring regexp
0 (match-beginning 0))
1724 (substring regexp
(match-end 0)))
1725 start
(+ (match-beginning 0) 5))))
1728 (defun ebrowse-class-declaration-regexp (name)
1729 "Construct a regexp for a declaration of class NAME."
1730 (concat "^[ \t]*\\(template[ \t\n]*<.*>\\)?"
1731 "[ \t\n]*\\(class\\|struct\\|union\\).*\\S_"
1732 (ebrowse-symbol-regexp name
)
1736 (defun ebrowse-variable-declaration-regexp (name)
1737 "Construct a regexp for matching a variable NAME."
1738 (concat "\\S_" (ebrowse-symbol-regexp name
) "\\S_"))
1741 (defun ebrowse-function-declaration/definition-regexp
(name)
1742 "Construct a regexp for matching a function NAME."
1743 (concat "^[a-zA-Z0-9_:*&<>, \t]*\\S_"
1744 (ebrowse-symbol-regexp name
)
1748 (defun ebrowse-pp-define-regexp (name)
1749 "Construct a regexp matching a define of NAME."
1750 (concat "^[ \t]*#[ \t]*define[ \t]+" (regexp-quote name
)))
1753 (defun* ebrowse-find-pattern
(&optional position info
&aux viewing
)
1756 This is a kluge: Ebrowse allows you to find or view a file containing
1757 a pattern. To be able to do a search in a viewed buffer,
1758 `view-mode-hook' is temporarily set to this function;
1759 `ebrowse-temp-position-to-view' holds what to search for.
1761 INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)."
1763 (pop view-mode-hook
)
1765 position ebrowse-temp-position-to-view
1766 info ebrowse-temp-info-to-view
))
1768 (let* ((pattern (ebrowse-bs-pattern position
))
1769 (start (ebrowse-bs-point position
))
1772 (destructuring-bind (header class-or-member member-list
) info
1773 ;; If no pattern is specified, construct one from the member name.
1774 (when (stringp pattern
)
1775 (setq pattern
(concat "^.*" (regexp-quote pattern
))))
1776 ;; Construct a regular expression if none given.
1778 (typecase class-or-member
1781 ((ebrowse-ts-member-variables
1782 ebrowse-ts-static-variables
1784 (setf pattern
(ebrowse-variable-declaration-regexp
1785 (ebrowse-bs-name position
))))
1787 (if (ebrowse-define-p class-or-member
)
1788 (setf pattern
(ebrowse-pp-define-regexp (ebrowse-bs-name position
)))
1789 (setf pattern
(ebrowse-function-declaration/definition-regexp
1790 (ebrowse-bs-name position
)))))))
1792 (setf pattern
(ebrowse-class-declaration-regexp
1793 (ebrowse-bs-name position
))))))
1794 ;; Begin searching some OFFSET from the original point where the
1795 ;; regular expression was found by the parse, and step forward.
1796 ;; When there is no regular expression in the database and a
1797 ;; member definition/declaration was not seen by the parser,
1799 (when (and (boundp 'ebrowse-debug
)
1800 (symbol-value 'ebrowse-debug
))
1801 (y-or-n-p (format "start = %d? " start
))
1804 (loop do
(goto-char (max (point-min) (- start offset
)))
1805 when
(re-search-forward pattern
(+ start offset
) t
) return t
1807 do
(incf offset offset
)))
1810 (run-hooks 'ebrowse-view
/find-hook
))
1811 ((numberp (ebrowse-bs-pattern position
))
1813 (if ebrowse-not-found-hook
1814 (run-hooks 'ebrowse-not-found-hook
)
1815 (message "Not found")
1818 (if ebrowse-not-found-hook
1819 (run-hooks 'ebrowse-not-found-hook
)
1821 (error "Not found"))
1822 (message "Not found")
1826 ;;; Drawing the tree
1828 (defun ebrowse-redraw-tree (&optional quietly
)
1829 "Redisplay the complete tree.
1830 QUIETLY non-nil means don't display progress messages."
1832 (or quietly
(message "Displaying..."))
1836 (ebrowse-draw-tree-fn)))
1837 (ebrowse-update-tree-buffer-mode-line)
1838 (or quietly
(message nil
)))
1841 (defun ebrowse-set-mark-props (start end tree
)
1842 "Set text properties for class marker signs between START and END.
1843 TREE denotes the class shown."
1844 (add-text-properties
1846 `(mouse-face highlight ebrowse-what mark ebrowse-tree
,tree
1847 help-echo
"double-mouse-1: mark/unmark"))
1848 (ebrowse-set-face start end
'ebrowse-tree-mark
))
1851 (defun* ebrowse-draw-tree-fn
(&aux stack1 stack2 start
)
1852 "Display a single class and recursively its subclasses.
1853 This function may look weird, but this is faster than recursion."
1854 (setq stack1
(make-list (length ebrowse--tree
) 0)
1855 stack2
(copy-sequence ebrowse--tree
))
1857 as level
= (pop stack1
)
1858 as tree
= (pop stack2
)
1859 as class
= (ebrowse-ts-class tree
) do
1860 (let ((start-of-line (point))
1861 start-of-class-name end-of-class-name
)
1863 (insert (if (ebrowse-ts-mark tree
) ">" " "))
1865 ;; Indent and insert class name
1866 (indent-to (+ (* level ebrowse--indentation
)
1867 ebrowse-tree-left-margin
))
1868 (setq start
(point))
1869 (insert (ebrowse-qualified-class-name class
))
1871 ;; If template class, add <>
1872 (when (ebrowse-template-p class
)
1874 (ebrowse-set-face start
(point) (if (zerop level
)
1877 (setf start-of-class-name start
1878 end-of-class-name
(point))
1879 ;; If filenames are to be displayed...
1880 (when ebrowse--show-file-names-flag
1881 (indent-to ebrowse-source-file-column
)
1882 (setq start
(point))
1884 (or (ebrowse-cs-file class
)
1887 (ebrowse-set-face start
(point) 'ebrowse-file-name
))
1888 (ebrowse-set-mark-props start-of-line
(1+ start-of-line
) tree
)
1889 (add-text-properties
1890 start-of-class-name end-of-class-name
1891 `(mouse-face highlight ebrowse-what class-name
1893 help-echo
"double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu"))
1895 ;; Push subclasses, if any.
1896 (when (ebrowse-ts-subclasses tree
)
1898 (nconc (copy-sequence (ebrowse-ts-subclasses tree
)) stack2
)
1900 (nconc (make-list (length (ebrowse-ts-subclasses tree
))
1901 (1+ level
)) stack1
)))))
1905 ;;; Expanding/ collapsing tree branches
1907 (defun ebrowse-expand-branch (arg)
1908 "Expand a sub-tree that has been previously collapsed.
1909 With prefix ARG, expand all sub-trees."
1912 (ebrowse-expand-all arg
)
1913 (ebrowse-collapse-fn nil
)))
1916 (defun ebrowse-collapse-branch (arg)
1917 "Fold (do no longer display) the subclasses of the current class.
1918 \(The class cursor is on.) With prefix ARG, fold all trees in the buffer."
1921 (ebrowse-expand-all (not arg
))
1922 (ebrowse-collapse-fn t
)))
1925 (defun ebrowse-expand-all (collapse)
1926 "Expand or fold all trees in the buffer.
1927 COLLAPSE non-nil means fold them."
1929 (let ((line-end (if collapse
"^\n" "^\r"))
1930 (insertion (if collapse
"\r" "\n")))
1933 (goto-char (point-min))
1934 (while (not (progn (skip-chars-forward line-end
) (eobp)))
1935 (when (or (not collapse
)
1940 (skip-chars-forward "\n ")))))))
1943 (defun ebrowse-unhide-base-classes ()
1944 "Unhide the line the cursor is on and all base classes."
1947 (let (indent last-indent
)
1948 (skip-chars-backward "^\r\n")
1949 (when (not (looking-at "[\r\n][^ \t]"))
1950 (skip-chars-forward "\r\n \t")
1951 (while (and (or (null last-indent
) ;first time
1952 (> indent
1)) ;not root class
1953 (re-search-backward "[\r\n][ \t]*" nil t
))
1954 (setf indent
(- (match-end 0)
1955 (match-beginning 0)))
1956 (when (or (null last-indent
)
1957 (< indent last-indent
))
1958 (setf last-indent indent
)
1959 (when (looking-at "\r")
1962 (backward-char 1)))))))
1965 (defun ebrowse-hide-line (collapse)
1966 "Hide/show a single line in the tree.
1967 COLLAPSE non-nil means hide."
1970 (skip-chars-forward "^\r\n")
1972 (insert (if collapse
13 10)))))
1975 (defun ebrowse-collapse-fn (collapse)
1976 "Collapse or expand a branch of the tree.
1977 COLLAPSE non-nil means collapse the branch."
1981 (skip-chars-forward "> \t")
1982 (let ((indentation (current-column)))
1983 (while (and (not (eobp))
1985 (skip-chars-forward "^\r\n")
1986 (goto-char (1+ (point)))
1987 (skip-chars-forward "> \t")
1988 (> (current-column) indentation
)))
1989 (ebrowse-hide-line collapse
)
1990 (skip-chars-forward "^\r\n")
1991 (goto-char (1+ (point))))))))
1994 ;;; Electric tree selection
1996 (defvar ebrowse-electric-list-mode-map
()
1997 "Keymap used in electric Ebrowse buffer list window.")
2000 (unless ebrowse-electric-list-mode-map
2001 (let ((map (make-keymap))
2002 (submap (make-keymap)))
2003 (setq ebrowse-electric-list-mode-map map
)
2004 (fillarray (car (cdr map
)) 'ebrowse-electric-list-undefined
)
2005 (fillarray (car (cdr submap
)) 'ebrowse-electric-list-undefined
)
2006 (define-key map
"\e" submap
)
2007 (define-key map
"\C-z" 'suspend-emacs
)
2008 (define-key map
"\C-h" 'Helper-help
)
2009 (define-key map
"?" 'Helper-describe-bindings
)
2010 (define-key map
"\C-c" nil
)
2011 (define-key map
"\C-c\C-c" 'ebrowse-electric-list-quit
)
2012 (define-key map
"q" 'ebrowse-electric-list-quit
)
2013 (define-key map
" " 'ebrowse-electric-list-select
)
2014 (define-key map
"\C-l" 'recenter
)
2015 (define-key map
"\C-u" 'universal-argument
)
2016 (define-key map
"\C-p" 'previous-line
)
2017 (define-key map
"\C-n" 'next-line
)
2018 (define-key map
"p" 'previous-line
)
2019 (define-key map
"n" 'next-line
)
2020 (define-key map
"v" 'ebrowse-electric-view-buffer
)
2021 (define-key map
"\C-v" 'scroll-up
)
2022 (define-key map
"\ev" 'scroll-down
)
2023 (define-key map
"\e\C-v" 'scroll-other-window
)
2024 (define-key map
"\e>" 'end-of-buffer
)
2025 (define-key map
"\e<" 'beginning-of-buffer
)
2026 (define-key map
"\e>" 'end-of-buffer
)))
2028 (put 'ebrowse-electric-list-mode
'mode-class
'special
)
2029 (put 'ebrowse-electric-list-undefined
'suppress-keymap t
)
2032 (defun ebrowse-electric-list-mode ()
2033 "Mode for electric tree list mode."
2034 (kill-all-local-variables)
2035 (use-local-map ebrowse-electric-list-mode-map
)
2036 (setq mode-name
"Electric Position Menu"
2037 mode-line-buffer-identification
"Electric Tree Menu")
2038 (when (memq 'mode-name mode-line-format
)
2039 (setq mode-line-format
(copy-sequence mode-line-format
))
2040 (setcar (memq 'mode-name mode-line-format
) "Tree Buffers"))
2041 (make-local-variable 'Helper-return-blurb
)
2042 (setq Helper-return-blurb
"return to buffer editing"
2045 major-mode
'ebrowse-electric-list-mode
)
2046 (run-mode-hooks 'ebrowse-electric-list-mode-hook
))
2049 (defun ebrowse-list-tree-buffers ()
2050 "Display a list of all tree buffers."
2051 (set-buffer (get-buffer-create "*Tree Buffers*"))
2052 (setq buffer-read-only nil
)
2054 (insert "Tree\n" "----\n")
2055 (dolist (buffer (ebrowse-known-class-trees-buffer-list))
2056 (insert (buffer-name buffer
) "\n"))
2057 (setq buffer-read-only t
))
2061 (defun ebrowse-electric-choose-tree ()
2062 "Return a buffer containing a tree or nil if no tree found or canceled."
2064 (unless (car (ebrowse-known-class-trees-buffer-list))
2065 (error "No tree buffers"))
2066 (let (select buffer window
)
2067 (save-window-excursion
2068 (save-window-excursion (ebrowse-list-tree-buffers))
2069 (setq window
(Electric-pop-up-window "*Tree Buffers*")
2070 buffer
(window-buffer window
))
2071 (shrink-window-if-larger-than-buffer window
)
2075 (ebrowse-electric-list-mode)
2077 (catch 'ebrowse-electric-list-select
2078 (message "<<< Press Space to bury the list >>>")
2079 (let ((first (progn (goto-char (point-min))
2082 (last (progn (goto-char (point-max))
2087 (Electric-command-loop 'ebrowse-electric-list-select
2090 'ebrowse-electric-list-looper
2091 (cons first last
))))))
2093 (bury-buffer buffer
)
2097 (setq select
(ebrowse-electric-get-buffer select
)))
2098 (kill-buffer buffer
)
2102 (defun ebrowse-electric-list-looper (state condition
)
2103 "Prevent cursor from moving beyond the buffer end.
2104 Don't let it move into the title lines.
2105 See 'Electric-command-loop' for a description of STATE and CONDITION."
2106 (cond ((and condition
2107 (not (memq (car condition
)
2108 '(buffer-read-only end-of-buffer
2109 beginning-of-buffer
))))
2110 (signal (car condition
) (cdr condition
)))
2111 ((< (point) (car state
))
2112 (goto-char (point-min))
2114 ((> (point) (cdr state
))
2115 (goto-char (point-max))
2117 (if (pos-visible-in-window-p (point-max))
2121 (defun ebrowse-electric-list-undefined ()
2122 "Function called for keys that are undefined."
2124 (message "Type C-h for help, ? for commands, q to quit, Space to select.")
2128 (defun ebrowse-electric-list-quit ()
2129 "Discard the buffer list."
2131 (throw 'ebrowse-electric-list-select nil
))
2134 (defun ebrowse-electric-list-select ()
2135 "Select a buffer from the buffer list."
2137 (throw 'ebrowse-electric-list-select
(point)))
2140 (defun ebrowse-electric-get-buffer (point)
2141 "Get a buffer corresponding to the line POINT is in."
2142 (let ((index (- (count-lines (point-min) point
) 2)))
2143 (nth index
(ebrowse-known-class-trees-buffer-list))))
2146 ;;; View a buffer for a tree.
2148 (defun ebrowse-electric-view-buffer ()
2149 "View buffer point is on."
2151 (let ((buffer (ebrowse-electric-get-buffer (point))))
2153 (view-buffer buffer
))
2155 (error "Buffer no longer exists")))))
2158 (defun ebrowse-choose-from-browser-buffers ()
2159 "Read a browser buffer name from the minibuffer and return that buffer."
2160 (let* ((buffers (ebrowse-known-class-trees-buffer-list)))
2162 (if (not (second buffers
))
2164 (or (ebrowse-electric-choose-tree) (error "No tree buffer")))
2165 (let* ((insert-default-directory t
)
2166 (file (read-file-name "Find tree: " nil nil t
)))
2169 (find-buffer-visiting file
)))))
2174 (unless ebrowse-member-mode-map
2175 (let ((map (make-keymap)))
2176 (setf ebrowse-member-mode-map map
)
2177 (suppress-keymap map
)
2179 (when (display-mouse-p)
2180 (define-key map
[down-mouse-3
] 'ebrowse-member-mouse-3
)
2181 (define-key map
[mouse-2
] 'ebrowse-member-mouse-2
))
2183 (let ((map1 (make-sparse-keymap)))
2184 (suppress-keymap map1 t
)
2185 (define-key map
"C" map1
)
2186 (define-key map1
"b" 'ebrowse-switch-member-buffer-to-base-class
)
2187 (define-key map1
"c" 'ebrowse-switch-member-buffer-to-any-class
)
2188 (define-key map1
"d" 'ebrowse-switch-member-buffer-to-derived-class
)
2189 (define-key map1
"n" 'ebrowse-switch-member-buffer-to-next-sibling-class
)
2190 (define-key map1
"p" 'ebrowse-switch-member-buffer-to-previous-sibling-class
))
2192 (let ((map1 (make-sparse-keymap)))
2193 (suppress-keymap map1 t
)
2194 (define-key map
"D" map1
)
2195 (define-key map1
"a" 'ebrowse-toggle-member-attributes-display
)
2196 (define-key map1
"b" 'ebrowse-toggle-base-class-display
)
2197 (define-key map1
"f" 'ebrowse-freeze-member-buffer
)
2198 (define-key map1
"l" 'ebrowse-toggle-long-short-display
)
2199 (define-key map1
"r" 'ebrowse-toggle-regexp-display
)
2200 (define-key map1
"w" 'ebrowse-set-member-buffer-column-width
))
2202 (let ((map1 (make-sparse-keymap)))
2203 (suppress-keymap map1 t
)
2204 (define-key map
"F" map1
)
2205 (let ((map2 (make-sparse-keymap)))
2206 (suppress-keymap map2 t
)
2207 (define-key map1
"a" map2
)
2208 (define-key map2
"i" 'ebrowse-toggle-private-member-filter
)
2209 (define-key map2
"o" 'ebrowse-toggle-protected-member-filter
)
2210 (define-key map2
"u" 'ebrowse-toggle-public-member-filter
))
2211 (define-key map1
"c" 'ebrowse-toggle-const-member-filter
)
2212 (define-key map1
"i" 'ebrowse-toggle-inline-member-filter
)
2213 (define-key map1
"p" 'ebrowse-toggle-pure-member-filter
)
2214 (define-key map1
"r" 'ebrowse-remove-all-member-filters
)
2215 (define-key map1
"v" 'ebrowse-toggle-virtual-member-filter
))
2217 (let ((map1 (make-sparse-keymap)))
2218 (suppress-keymap map1 t
)
2219 (define-key map
"L" map1
)
2220 (define-key map1
"d" 'ebrowse-display-friends-member-list
)
2221 (define-key map1
"f" 'ebrowse-display-function-member-list
)
2222 (define-key map1
"F" 'ebrowse-display-static-functions-member-list
)
2223 (define-key map1
"n" 'ebrowse-display-next-member-list
)
2224 (define-key map1
"p" 'ebrowse-display-previous-member-list
)
2225 (define-key map1
"t" 'ebrowse-display-types-member-list
)
2226 (define-key map1
"v" 'ebrowse-display-variables-member-list
)
2227 (define-key map1
"V" 'ebrowse-display-static-variables-member-list
))
2229 (let ((map1 (make-sparse-keymap)))
2230 (suppress-keymap map1 t
)
2231 (define-key map
"G" map1
)
2232 (define-key map1
"m" 'ebrowse-goto-visible-member
/all-member-lists
)
2233 (define-key map1
"n" 'ebrowse-repeat-member-search
)
2234 (define-key map1
"v" 'ebrowse-goto-visible-member
))
2236 (define-key map
"f" 'ebrowse-find-member-declaration
)
2237 (define-key map
"m" 'ebrowse-switch-to-next-member-buffer
)
2238 (define-key map
"q" 'bury-buffer
)
2239 (define-key map
"t" 'ebrowse-show-displayed-class-in-tree
)
2240 (define-key map
"v" 'ebrowse-view-member-declaration
)
2241 (define-key map
" " 'ebrowse-view-member-definition
)
2242 (define-key map
"?" 'describe-mode
)
2243 (define-key map
"\C-i" 'ebrowse-pop-from-member-to-tree-buffer
)
2244 (define-key map
"\C-l" 'ebrowse-redisplay-member-buffer
)
2245 (define-key map
"\C-m" 'ebrowse-find-member-definition
)))
2252 (defun ebrowse-member-mode ()
2253 "Major mode for Ebrowse member buffers.
2255 \\{ebrowse-member-mode-map}"
2256 (kill-all-local-variables)
2257 (use-local-map ebrowse-member-mode-map
)
2258 (setq major-mode
'ebrowse-member-mode
)
2259 (mapcar 'make-local-variable
2260 '(ebrowse--decl-column ;display column
2261 ebrowse--n-columns
;number of short columns
2262 ebrowse--column-width
;width of columns above
2263 ebrowse--show-inherited-flag
;include inherited members?
2264 ebrowse--filters
;public, protected, private
2265 ebrowse--accessor
;vars, functions, friends
2266 ebrowse--displayed-class
;class displayed
2267 ebrowse--long-display-flag
;display with regexps?
2268 ebrowse--source-regexp-flag
;show source regexp?
2269 ebrowse--attributes-flag
;show `virtual' and `inline'
2270 ebrowse--member-list
;list of members displayed
2271 ebrowse--tree
;the class tree
2272 ebrowse--member-mode-strings
;part of mode line
2273 ebrowse--tags-file-name
;
2275 ebrowse--tree-obarray
2276 ebrowse--virtual-display-flag
2277 ebrowse--inline-display-flag
2278 ebrowse--const-display-flag
2279 ebrowse--pure-display-flag
2280 ebrowse--frozen-flag
)) ;buffer not automagically reused
2281 (setq mode-name
"Ebrowse-Members"
2282 mode-line-buffer-identification
2283 (propertized-buffer-identification "C++ Members")
2285 ebrowse--long-display-flag nil
2286 ebrowse--attributes-flag t
2287 ebrowse--show-inherited-flag t
2288 ebrowse--source-regexp-flag nil
2289 ebrowse--filters
[0 1 2]
2290 ebrowse--decl-column ebrowse-default-declaration-column
2291 ebrowse--column-width ebrowse-default-column-width
2292 ebrowse--virtual-display-flag nil
2293 ebrowse--inline-display-flag nil
2294 ebrowse--const-display-flag nil
2295 ebrowse--pure-display-flag nil
)
2296 (modify-syntax-entry ?_
(char-to-string (char-syntax ?a
)))
2297 (run-mode-hooks 'ebrowse-member-mode-hook
))
2301 ;;; Member mode mode line
2303 (defsubst ebrowse-class-name-displayed-in-member-buffer
()
2304 "Return the name of the class displayed in the member buffer."
2305 (ebrowse-cs-name (ebrowse-ts-class ebrowse--displayed-class
)))
2308 (defsubst ebrowse-member-list-name
()
2309 "Return a string describing what is displayed in the member buffer."
2310 (get ebrowse--accessor
(if (ebrowse-globals-tree-p ebrowse--displayed-class
)
2311 'ebrowse-global-title
2315 (defun ebrowse-update-member-buffer-mode-line ()
2316 "Update the mode line of member buffers."
2317 (let* ((name (when ebrowse--frozen-flag
2318 (concat (ebrowse-class-name-displayed-in-member-buffer)
2320 (ident (concat name
(ebrowse-member-list-name))))
2321 (setq mode-line-buffer-identification
2322 (propertized-buffer-identification ident
))
2323 (ebrowse-rename-buffer (if name ident ebrowse-member-buffer-name
))
2324 (force-mode-line-update)))
2327 ;;; Misc member buffer commands
2329 (defun ebrowse-freeze-member-buffer ()
2330 "Toggle frozen status of current buffer."
2332 (setq ebrowse--frozen-flag
(not ebrowse--frozen-flag
))
2333 (ebrowse-redisplay-member-buffer))
2336 (defun ebrowse-show-displayed-class-in-tree (arg)
2337 "Show the currently displayed class in the tree window.
2338 With prefix ARG, switch to the tree buffer else pop to it."
2340 (let ((class-name (ebrowse-class-name-displayed-in-member-buffer)))
2341 (when (ebrowse-pop-from-member-to-tree-buffer arg
)
2342 (ebrowse-read-class-name-and-go class-name
))))
2345 (defun ebrowse-set-member-buffer-column-width ()
2346 "Set the column width of the member display.
2347 The new width is read from the minibuffer."
2349 (let ((width (string-to-number
2350 (read-from-minibuffer
2351 (concat "Column width ("
2352 (int-to-string (if ebrowse--long-display-flag
2353 ebrowse--decl-column
2354 ebrowse--column-width
))
2357 (if ebrowse--long-display-flag
2358 (setq ebrowse--decl-column width
)
2359 (setq ebrowse--column-width width
))
2360 (ebrowse-redisplay-member-buffer))))
2363 (defun ebrowse-pop-from-member-to-tree-buffer (arg)
2364 "Pop from a member buffer to the matching tree buffer.
2365 Switch to the buffer if prefix ARG. If no tree buffer exists,
2368 (let ((buf (or (get-buffer (ebrowse-frozen-tree-buffer-name
2369 ebrowse--tags-file-name
))
2370 (get-buffer ebrowse-tree-buffer-name
)
2371 (ebrowse-create-tree-buffer ebrowse--tree
2372 ebrowse--tags-file-name
2374 ebrowse--tree-obarray
2377 (funcall (if arg
'switch-to-buffer
'pop-to-buffer
) buf
))
2382 ;;; Switching between member lists
2384 (defun ebrowse-display-member-list-for-accessor (accessor)
2385 "Switch the member buffer to display the member list for ACCESSOR."
2386 (setf ebrowse--accessor accessor
2387 ebrowse--member-list
(funcall accessor ebrowse--displayed-class
))
2388 (ebrowse-redisplay-member-buffer))
2391 (defun ebrowse-cyclic-display-next/previous-member-list
(incr)
2392 "Switch buffer to INCR'th next/previous list of members."
2393 (let ((index (ebrowse-position ebrowse--accessor
2394 ebrowse-member-list-accessors
)))
2395 (setf ebrowse--accessor
2398 ebrowse-member-list-accessors
)
2399 (first ebrowse-member-list-accessors
)))
2401 (or (and (>= (decf index
) 0)
2403 ebrowse-member-list-accessors
))
2404 (first (last ebrowse-member-list-accessors
))))))
2405 (ebrowse-display-member-list-for-accessor ebrowse--accessor
)))
2408 (defun ebrowse-display-next-member-list ()
2409 "Switch buffer to next member list."
2411 (ebrowse-cyclic-display-next/previous-member-list
1))
2414 (defun ebrowse-display-previous-member-list ()
2415 "Switch buffer to previous member list."
2417 (ebrowse-cyclic-display-next/previous-member-list -
1))
2420 (defun ebrowse-display-function-member-list ()
2421 "Display the list of member functions."
2423 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions
))
2426 (defun ebrowse-display-variables-member-list ()
2427 "Display the list of member variables."
2429 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables
))
2432 (defun ebrowse-display-static-variables-member-list ()
2433 "Display the list of static member variables."
2435 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables
))
2438 (defun ebrowse-display-static-functions-member-list ()
2439 "Display the list of static member functions."
2441 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions
))
2444 (defun ebrowse-display-friends-member-list ()
2445 "Display the list of friends."
2447 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends
))
2450 (defun ebrowse-display-types-member-list ()
2451 "Display the list of types."
2453 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types
))
2457 ;;; Filters and other display attributes
2459 (defun ebrowse-toggle-member-attributes-display ()
2460 "Toggle display of `virtual', `inline', `const' etc."
2462 (setq ebrowse--attributes-flag
(not ebrowse--attributes-flag
))
2463 (ebrowse-redisplay-member-buffer))
2466 (defun ebrowse-toggle-base-class-display ()
2467 "Toggle the display of members inherited from base classes."
2469 (setf ebrowse--show-inherited-flag
(not ebrowse--show-inherited-flag
))
2470 (ebrowse-redisplay-member-buffer))
2473 (defun ebrowse-toggle-pure-member-filter ()
2474 "Toggle display of pure virtual members."
2476 (setf ebrowse--pure-display-flag
(not ebrowse--pure-display-flag
))
2477 (ebrowse-redisplay-member-buffer))
2480 (defun ebrowse-toggle-const-member-filter ()
2481 "Toggle display of const members."
2483 (setf ebrowse--const-display-flag
(not ebrowse--const-display-flag
))
2484 (ebrowse-redisplay-member-buffer))
2487 (defun ebrowse-toggle-inline-member-filter ()
2488 "Toggle display of inline members."
2490 (setf ebrowse--inline-display-flag
(not ebrowse--inline-display-flag
))
2491 (ebrowse-redisplay-member-buffer))
2494 (defun ebrowse-toggle-virtual-member-filter ()
2495 "Toggle display of virtual members."
2497 (setf ebrowse--virtual-display-flag
(not ebrowse--virtual-display-flag
))
2498 (ebrowse-redisplay-member-buffer))
2501 (defun ebrowse-remove-all-member-filters ()
2502 "Remove all filters."
2505 (aset ebrowse--filters i i
))
2506 (setq ebrowse--pure-display-flag nil
2507 ebrowse--const-display-flag nil
2508 ebrowse--virtual-display-flag nil
2509 ebrowse--inline-display-flag nil
)
2510 (ebrowse-redisplay-member-buffer))
2513 (defun ebrowse-toggle-public-member-filter ()
2514 "Toggle visibility of public members."
2516 (ebrowse-set-member-access-visibility 0)
2517 (ebrowse-redisplay-member-buffer))
2520 (defun ebrowse-toggle-protected-member-filter ()
2521 "Toggle visibility of protected members."
2523 (ebrowse-set-member-access-visibility 1)
2524 (ebrowse-redisplay-member-buffer))
2527 (defun ebrowse-toggle-private-member-filter ()
2528 "Toggle visibility of private members."
2530 (ebrowse-set-member-access-visibility 2)
2531 (ebrowse-redisplay-member-buffer))
2534 (defun ebrowse-set-member-access-visibility (vis)
2535 (setf (aref ebrowse--filters vis
)
2536 (if (aref ebrowse--filters vis
) nil vis
)))
2539 (defun ebrowse-toggle-long-short-display ()
2540 "Toggle between long and short display form of member buffers."
2542 (setf ebrowse--long-display-flag
(not ebrowse--long-display-flag
))
2543 (ebrowse-redisplay-member-buffer))
2546 (defun ebrowse-toggle-regexp-display ()
2547 "Toggle declaration/definition regular expression display.
2548 Used in member buffers showing the long display form."
2550 (setf ebrowse--source-regexp-flag
(not ebrowse--source-regexp-flag
))
2551 (ebrowse-redisplay-member-buffer))
2555 ;;; Viewing/finding members
2557 (defun ebrowse-find-member-definition (&optional prefix
)
2558 "Find the file containing a member definition.
2559 With PREFIX 4. find file in another window, with prefix 5
2560 find file in another frame."
2562 (ebrowse-view/find-member-declaration
/definition prefix nil t
))
2565 (defun ebrowse-view-member-definition (prefix)
2566 "View the file containing a member definition.
2567 With PREFIX 4. find file in another window, with prefix 5
2568 find file in another frame."
2570 (ebrowse-view/find-member-declaration
/definition prefix t t
))
2573 (defun ebrowse-find-member-declaration (prefix)
2574 "Find the file containing a member's declaration.
2575 With PREFIX 4. find file in another window, with prefix 5
2576 find file in another frame."
2578 (ebrowse-view/find-member-declaration
/definition prefix nil
))
2581 (defun ebrowse-view-member-declaration (prefix)
2582 "View the file containing a member's declaration.
2583 With PREFIX 4. find file in another window, with prefix 5
2584 find file in another frame."
2586 (ebrowse-view/find-member-declaration
/definition prefix t
))
2589 (defun* ebrowse-view
/find-member-declaration
/definition
2590 (prefix view
&optional definition info header tags-file-name
)
2591 "Find or view a member declaration or definition.
2592 With PREFIX 4. find file in another window, with prefix 5
2593 find file in another frame.
2594 DEFINITION non-nil means find the definition, otherwise find the
2596 INFO is a list (TREE ACCESSOR MEMBER) describing the member to
2598 TAGS-FILE-NAME is the file name of the BROWSE file."
2600 (setq header ebrowse--header
))
2601 (unless tags-file-name
2602 (setq tags-file-name ebrowse--tags-file-name
))
2603 (let (tree member accessor file on-class
2604 (where (if (= prefix
4) 'other-window
2605 (if (= prefix
5) 'other-frame
'this-window
))))
2606 ;; If not given as parameters, get the necessary information
2607 ;; out of the member buffer.
2609 (setq tree
(first info
)
2610 accessor
(second info
)
2611 member
(third info
))
2612 (multiple-value-setq (tree member on-class
)
2613 (ebrowse-member-info-from-point))
2614 (setq accessor ebrowse--accessor
))
2615 ;; View/find class if on a line containing a class name.
2617 (return-from ebrowse-view
/find-member-declaration
/definition
2618 (ebrowse-view/find-file-and-search-pattern
2619 (ebrowse-ts-class tree
)
2620 (list ebrowse--header
(ebrowse-ts-class tree
) nil
)
2621 (ebrowse-cs-file (ebrowse-ts-class tree
))
2622 tags-file-name view where
)))
2623 ;; For some member lists, it doesn't make sense to search for
2624 ;; a definition. If this is requested, silently search for the
2626 (when (and definition
2627 (eq accessor
'ebrowse-ts-member-variables
))
2628 (setq definition nil
))
2629 ;; Construct a suitable `browse' struct for definitions.
2631 (setf member
(make-ebrowse-ms
2632 :name
(ebrowse-ms-name member
)
2633 :file
(ebrowse-ms-definition-file member
)
2634 :pattern
(ebrowse-ms-definition-pattern
2636 :flags
(ebrowse-ms-flags member
)
2637 :point
(ebrowse-ms-definition-point
2639 ;; When no file information in member, use that of the class
2640 (setf file
(or (ebrowse-ms-file member
)
2642 (ebrowse-cs-source-file (ebrowse-ts-class tree
))
2643 (ebrowse-cs-file (ebrowse-ts-class tree
)))))
2644 ;; When we have no regular expressions in the database the only
2645 ;; indication that the parser hasn't seen a definition/declaration
2646 ;; is that the search start point will be zero.
2647 (if (or (null file
) (zerop (ebrowse-ms-point member
)))
2648 (if (y-or-n-p (concat "No information about "
2649 (if definition
"definition" "declaration")
2651 (if definition
"declaration" "definition")
2653 (ebrowse-ms-name member
)
2657 ;; Recurse with new info.
2658 (ebrowse-view/find-member-declaration
/definition
2659 prefix view
(not definition
) info header tags-file-name
))
2660 (error "Search canceled"))
2662 (ebrowse-view/find-file-and-search-pattern
2663 (make-ebrowse-bs :name
(ebrowse-ms-name member
)
2664 :pattern
(ebrowse-ms-pattern member
)
2665 :file
(ebrowse-ms-file member
)
2666 :flags
(ebrowse-ms-flags member
)
2667 :point
(ebrowse-ms-point member
))
2668 (list header member accessor
)
2676 ;;; Drawing the member buffer
2678 (defun ebrowse-redisplay-member-buffer ()
2679 "Force buffer redisplay."
2681 (let ((display-fn (if ebrowse--long-display-flag
2682 'ebrowse-draw-member-long-fn
2683 'ebrowse-draw-member-short-fn
)))
2687 (ebrowse-draw-member-buffer-class-line)
2688 (funcall display-fn ebrowse--member-list ebrowse--displayed-class
)
2689 ;; Show inherited members if corresponding switch is on
2690 (when ebrowse--show-inherited-flag
2691 (dolist (super (ebrowse-base-classes ebrowse--displayed-class
))
2692 (goto-char (point-max))
2693 (insert (if (bolp) "\n\n" "\n"))
2694 (ebrowse-draw-member-buffer-class-line super
)
2695 (funcall display-fn
(funcall ebrowse--accessor super
) super
)))
2696 (ebrowse-update-member-buffer-mode-line))))
2699 (defun ebrowse-draw-member-buffer-class-line (&optional class
)
2700 "Display the title line for a class section in the member buffer.
2701 CLASS non-nil means display that class' title. Otherwise use
2702 the class cursor is on."
2703 (let ((start (point))
2704 (tree (or class ebrowse--displayed-class
))
2708 (setq class-name-start
(point))
2709 (insert (ebrowse-qualified-class-name (ebrowse-ts-class tree
)))
2710 (when (ebrowse-template-p (ebrowse-ts-class tree
))
2712 (setq class-name-end
(point))
2714 (ebrowse-set-face start
(point) 'ebrowse-member-class
)
2715 (add-text-properties
2716 class-name-start class-name-end
2717 '(ebrowse-what class-name
2718 mouse-face highlight
2719 help-echo
"mouse-3: menu"))
2720 (put-text-property start class-name-end
'ebrowse-tree tree
)))
2723 (defun ebrowse-display-member-buffer (list &optional stand-alone class
)
2724 "Start point for member buffer creation.
2725 LIST is the member list to display. STAND-ALONE non-nil
2726 means the member buffer is standalone. CLASS is its class."
2727 (let* ((classes ebrowse--tree-obarray
)
2728 (tree ebrowse--tree
)
2729 (tags-file-name ebrowse--tags-file-name
)
2730 (header ebrowse--header
)
2731 temp-buffer-setup-hook
2732 (temp-buffer (get-buffer ebrowse-member-buffer-name
)))
2733 ;; Get the class description from the name the cursor
2734 ;; is on if not specified as an argument.
2736 (setq class
(ebrowse-tree-at-point)))
2737 (save-selected-window
2739 (pop-to-buffer temp-buffer
)
2740 (pop-to-buffer (get-buffer-create ebrowse-member-buffer-name
))
2741 ;; If new buffer, set the mode and initial values of locals
2742 (ebrowse-member-mode))
2743 ;; Set local variables
2744 (setq ebrowse--member-list
(funcall list class
)
2745 ebrowse--displayed-class class
2746 ebrowse--accessor list
2747 ebrowse--tree-obarray classes
2748 ebrowse--frozen-flag stand-alone
2749 ebrowse--tags-file-name tags-file-name
2750 ebrowse--header header
2753 (ebrowse-redisplay-member-buffer)
2757 (defun ebrowse-member-display-p (member)
2758 "Return t if MEMBER must be displayed under the current filter settings."
2759 (if (and (aref ebrowse--filters
(ebrowse-ms-visibility member
))
2760 (or (null ebrowse--const-display-flag
)
2761 (ebrowse-const-p member
))
2762 (or (null ebrowse--inline-display-flag
)
2763 (ebrowse-inline-p member
))
2764 (or (null ebrowse--pure-display-flag
)
2765 (ebrowse-bs-p member
))
2766 (or (null ebrowse--virtual-display-flag
)
2767 (ebrowse-virtual-p member
)))
2771 (defun ebrowse-draw-member-attributes (member)
2772 "Insert a string for the attributes of MEMBER."
2773 (insert (if (ebrowse-template-p member
) "T" "-")
2774 (if (ebrowse-extern-c-p member
) "C" "-")
2775 (if (ebrowse-virtual-p member
) "v" "-")
2776 (if (ebrowse-inline-p member
) "i" "-")
2777 (if (ebrowse-const-p member
) "c" "-")
2778 (if (ebrowse-pure-virtual-p member
) "0" "-")
2779 (if (ebrowse-mutable-p member
) "m" "-")
2780 (if (ebrowse-explicit-p member
) "e" "-")
2781 (if (ebrowse-throw-list-p member
) "t" "-")))
2784 (defun ebrowse-draw-member-regexp (member-struc)
2785 "Insert a string for the regular expression matching MEMBER-STRUC."
2786 (let ((pattern (if ebrowse--source-regexp-flag
2787 (ebrowse-ms-definition-pattern
2789 (ebrowse-ms-pattern member-struc
))))
2790 (cond ((stringp pattern
)
2791 (insert (ebrowse-trim-string pattern
) "...\n")
2792 (beginning-of-line 0)
2793 (move-to-column (+ 4 ebrowse--decl-column
))
2794 (while (re-search-forward "[ \t]+" nil t
)
2795 (delete-region (match-beginning 0) (match-end 0))
2797 (beginning-of-line 2))
2799 (insert "[not recorded or unknown]\n")))))
2802 (defun ebrowse-draw-member-long-fn (member-list tree
)
2803 "Display member buffer for MEMBER-LIST in long form.
2804 TREE is the class tree of MEMBER-LIST."
2805 (dolist (member-struc (mapcar 'ebrowse-member-display-p member-list
))
2807 (let ((name (ebrowse-ms-name member-struc
))
2809 ;; Insert member name truncated to the right length
2810 (insert (substring name
2813 (1- ebrowse--decl-column
))))
2814 (add-text-properties
2816 `(mouse-face highlight ebrowse-what member-name
2817 ebrowse-member
,member-struc
2819 help-echo
"mouse-2: view definition; mouse-3: menu"))
2820 ;; Display virtual, inline, and const status
2821 (setf start
(point))
2822 (indent-to ebrowse--decl-column
)
2823 (put-text-property start
(point) 'mouse-face nil
)
2824 (when ebrowse--attributes-flag
2825 (let ((start (point)))
2827 (ebrowse-draw-member-attributes member-struc
)
2829 (ebrowse-set-face start
(point)
2830 'ebrowse-member-attribute
)))
2832 (ebrowse-draw-member-regexp member-struc
))))
2834 (goto-char (point-min)))
2837 (defun ebrowse-draw-member-short-fn (member-list tree
)
2838 "Display MEMBER-LIST in short form.
2839 TREE is the class tree in which the members are found."
2841 (column-width (+ ebrowse--column-width
2842 (if ebrowse--attributes-flag
12 0))))
2843 ;; Get the number of columns to draw.
2844 (setq ebrowse--n-columns
2845 (max 1 (/ (ebrowse-width-of-drawable-area) column-width
)))
2846 (dolist (member (mapcar #'ebrowse-member-display-p member-list
))
2848 (let ((name (ebrowse-ms-name member
))
2850 (start-of-column (point))
2852 (indent-to (* i column-width
))
2853 (put-text-property start-of-column
(point) 'mouse-face nil
)
2854 (setq start-of-entry
(point))
2855 ;; Show various attributes
2856 (when ebrowse--attributes-flag
2858 (ebrowse-draw-member-attributes member
)
2860 (ebrowse-set-face start-of-entry
(point)
2861 'ebrowse-member-attribute
))
2862 ;; insert member name truncated to column width
2863 (setq start-of-name
(point))
2864 (insert (substring name
0
2866 (1- ebrowse--column-width
))))
2867 ;; set text properties
2868 (add-text-properties
2869 start-of-name
(point)
2870 `(ebrowse-what member-name
2871 ebrowse-member
,member
2872 mouse-face highlight
2874 help-echo
"mouse-2: view definition; mouse-3: menu"))
2876 (when (>= i ebrowse--n-columns
)
2881 (goto-char (point-min))))
2885 ;;; Killing members from tree
2887 (defun ebrowse-member-info-from-point ()
2888 "Ger information about the member at point.
2889 The result has the form (TREE MEMBER NULL-P). TREE is the tree
2890 we're in, MEMBER is the member we're on. NULL-P is t if MEMBER
2892 (let ((tree (or (get-text-property (point) 'ebrowse-tree
)
2893 (error "No information at point")))
2894 (member (get-text-property (point) 'ebrowse-member
)))
2895 (list tree member
(null member
))))
2899 ;;; Switching member buffer to display a selected member
2901 (defun ebrowse-goto-visible-member/all-member-lists
(prefix)
2902 "Position cursor on a member read from the minibuffer.
2903 With PREFIX, search all members in the tree. Otherwise consider
2904 only members visible in the buffer."
2906 (ebrowse-ignoring-completion-case
2907 (let* ((completion-list (ebrowse-name/accessor-alist-for-class-members
))
2908 (member (completing-read "Goto member: " completion-list nil t
))
2909 (accessor (cdr (assoc member completion-list
))))
2911 (error "`%s' not found" member
))
2912 (unless (eq accessor ebrowse--accessor
)
2913 (setf ebrowse--accessor accessor
2914 ebrowse--member-list
(funcall accessor ebrowse--displayed-class
))
2915 (ebrowse-redisplay-member-buffer))
2916 (ebrowse-move-point-to-member member
))))
2919 (defun ebrowse-goto-visible-member (repeat)
2920 "Position point on a member.
2921 Read the member's name from the minibuffer. Consider only members
2922 visible in the member buffer.
2923 REPEAT non-nil means repeat the search that number of times."
2925 (ebrowse-ignoring-completion-case
2927 (let* ((completion-list (ebrowse-name/accessor-alist-for-visible-members
))
2928 (member (completing-read "Goto member: " completion-list nil t
)))
2929 (ebrowse-move-point-to-member member repeat
))))
2933 ;;; Searching a member in the member buffer
2935 (defun ebrowse-repeat-member-search (repeat)
2936 "Repeat the last regular expression search.
2937 REPEAT, if specified, says repeat the search REPEAT times."
2939 (unless ebrowse--last-regexp
2940 (error "No regular expression remembered"))
2941 ;; Skip over word the point is on
2942 (skip-chars-forward "^ \t\n")
2943 ;; Search for regexp from point
2944 (if (re-search-forward ebrowse--last-regexp nil t repeat
)
2946 (goto-char (match-beginning 0))
2947 (skip-chars-forward " \t\n"))
2948 ;; If not found above, repeat search from buffer start
2949 (goto-char (point-min))
2950 (if (re-search-forward ebrowse--last-regexp nil t
)
2952 (goto-char (match-beginning 0))
2953 (skip-chars-forward " \t\n"))
2954 (error "Not found"))))
2957 (defun* ebrowse-move-point-to-member
(name &optional count
&aux member
)
2958 "Set point on member NAME in the member buffer
2959 COUNT, if specified, says search the COUNT'th member with the same name."
2960 (goto-char (point-min))
2963 (substring name
0 (min (length name
) (1- ebrowse--column-width
)))
2964 ebrowse--last-regexp
2965 (concat "[ \t\n]" (regexp-quote member
) "[ \n\t]"))
2966 (if (re-search-forward ebrowse--last-regexp nil t count
)
2967 (goto-char (1+ (match-beginning 0)))
2968 (error "Not found")))
2972 ;;; Switching member buffer to another class.
2974 (defun ebrowse-switch-member-buffer-to-other-class (title compl-list
)
2975 "Switch member buffer to a class read from the minibuffer.
2976 Use TITLE as minibuffer prompt.
2977 COMPL-LIST is a completion list to use."
2978 (let* ((initial (unless (second compl-list
)
2979 (first (first compl-list
))))
2980 (class (or (ebrowse-completing-read-value title compl-list initial
)
2981 (error "Not found"))))
2982 (setf ebrowse--displayed-class class
2983 ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class
))
2984 (ebrowse-redisplay-member-buffer)))
2987 (defun ebrowse-switch-member-buffer-to-any-class ()
2988 "Switch member buffer to a class read from the minibuffer."
2990 (ebrowse-switch-member-buffer-to-other-class
2991 "Goto class: " (ebrowse-tree-obarray-as-alist)))
2994 (defun ebrowse-switch-member-buffer-to-base-class (arg)
2995 "Switch buffer to ARG'th base class."
2997 (let ((supers (or (ebrowse-direct-base-classes ebrowse--displayed-class
)
2998 (error "No base classes"))))
2999 (if (and arg
(second supers
))
3000 (let ((alist (loop for s in supers
3001 collect
(cons (ebrowse-qualified-class-name
3002 (ebrowse-ts-class s
))
3004 (ebrowse-switch-member-buffer-to-other-class
3005 "Goto base class: " alist
))
3006 (setq ebrowse--displayed-class
(first supers
)
3007 ebrowse--member-list
3008 (funcall ebrowse--accessor ebrowse--displayed-class
))
3009 (ebrowse-redisplay-member-buffer))))
3011 (defun ebrowse-switch-member-buffer-to-next-sibling-class (arg)
3012 "Move to ARG'th next sibling."
3014 (ebrowse-switch-member-buffer-to-sibling-class arg
))
3017 (defun ebrowse-switch-member-buffer-to-previous-sibling-class (arg)
3018 "Move to ARG'th previous sibling."
3020 (ebrowse-switch-member-buffer-to-sibling-class (- arg
)))
3023 (defun ebrowse-switch-member-buffer-to-sibling-class (inc)
3024 "Switch member display to nth sibling class.
3025 Prefix arg INC specifies which one."
3027 (let ((containing-list ebrowse--tree
)
3029 (supers (ebrowse-direct-base-classes ebrowse--displayed-class
)))
3030 (flet ((trees-alist (trees)
3031 (loop for tr in trees
3032 collect
(cons (ebrowse-cs-name
3033 (ebrowse-ts-class tr
)) tr
))))
3035 (let ((tree (if (second supers
)
3036 (ebrowse-completing-read-value
3037 "Relative to base class: "
3038 (trees-alist supers
) nil
)
3040 (unless tree
(error "Not found"))
3041 (setq containing-list
(ebrowse-ts-subclasses tree
)))))
3042 (setq index
(+ inc
(ebrowse-position ebrowse--displayed-class
3044 (cond ((minusp index
) (message "No previous class"))
3045 ((null (nth index containing-list
)) (message "No next class")))
3046 (setq index
(max 0 (min index
(1- (length containing-list
)))))
3047 (setq cls
(nth index containing-list
))
3048 (setf ebrowse--displayed-class cls
3049 ebrowse--member-list
(funcall ebrowse--accessor cls
))
3050 (ebrowse-redisplay-member-buffer)))
3053 (defun ebrowse-switch-member-buffer-to-derived-class (arg)
3054 "Switch member display to nth derived class.
3055 Prefix arg ARG says which class should be displayed. Default is
3056 the first derived class."
3058 (flet ((ebrowse-tree-obarray-as-alist ()
3059 (loop for s in
(ebrowse-ts-subclasses
3060 ebrowse--displayed-class
)
3061 collect
(cons (ebrowse-cs-name
3062 (ebrowse-ts-class s
)) s
))))
3063 (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class
)
3064 (error "No derived classes"))))
3065 (if (and arg
(second subs
))
3066 (ebrowse-switch-member-buffer-to-other-class
3067 "Goto derived class: " (ebrowse-tree-obarray-as-alist))
3068 (setq ebrowse--displayed-class
(first subs
)
3069 ebrowse--member-list
3070 (funcall ebrowse--accessor ebrowse--displayed-class
))
3071 (ebrowse-redisplay-member-buffer)))))
3075 ;;; Member buffer mouse functions
3077 (defun ebrowse-displaying-functions ()
3078 (eq ebrowse--accessor
'ebrowse-ts-member-functions
))
3079 (defun ebrowse-displaying-variables ()
3080 (eq ebrowse--accessor
'ebrowse-ts-member-variables
))
3081 (defun ebrowse-displaying-static-functions ()
3083 (defun ebrowse-displaying-static-variables ()
3085 (defun ebrowse-displaying-types ()
3086 (eq ebrowse--accessor
'ebrowse-ts-types
))
3087 (defun ebrowse-displaying-friends ()
3088 (eq ebrowse--accessor
'ebrowse-ts-friends
))
3091 ebrowse-member-buffer-object-menu ebrowse-member-mode-map
3092 "Object menu for the member buffer itself."
3095 ["Functions" ebrowse-display-function-member-list
3096 :help
"Show the list of member functions"
3098 :selected
(eq ebrowse--accessor
'ebrowse-ts-member-functions
)
3100 ["Variables" ebrowse-display-variables-member-list
3101 :help
"Show the list of member variables"
3103 :selected
(eq ebrowse--accessor
'ebrowse-ts-member-variables
)
3105 ["Static Functions" ebrowse-display-static-functions-member-list
3106 :help
"Show the list of static member functions"
3108 :selected
(eq ebrowse--accessor
'ebrowse-ts-static-functions
)
3110 ["Static Variables" ebrowse-display-static-variables-member-list
3111 :help
"Show the list of static member variables"
3113 :selected
(eq ebrowse--accessor
'ebrowse-ts-static-variables
)
3115 ["Types" ebrowse-display-types-member-list
3116 :help
"Show the list of nested types"
3118 :selected
(eq ebrowse--accessor
'ebrowse-ts-types
)
3120 ["Friends/Defines" ebrowse-display-friends-member-list
3121 :help
"Show the list of friends or defines"
3123 :selected
(eq ebrowse--accessor
'ebrowse-ts-friends
)
3126 ["Up" ebrowse-switch-member-buffer-to-base-class
3127 :help
"Show the base class of this class"
3129 ["Down" ebrowse-switch-member-buffer-to-derived-class
3130 :help
"Show a derived class class of this class"
3132 ["Next Sibling" ebrowse-switch-member-buffer-to-next-sibling-class
3133 :help
"Show the next sibling class"
3135 ["Previous Sibling" ebrowse-switch-member-buffer-to-previous-sibling-class
3136 :help
"Show the previous sibling class"
3139 ["Show in Tree" ebrowse-show-displayed-class-in-tree
3140 :help
"Show this class in the class tree"
3142 ["Find in this Class" ebrowse-goto-visible-member
3143 :help
"Search for a member of this class"
3145 ["Find in Tree" ebrowse-goto-visible-member
/all-member-lists
3146 :help
"Search for a member in any class"
3149 ["Inherited" ebrowse-toggle-base-class-display
3150 :help
"Toggle display of inherited members"
3152 :selected ebrowse--show-inherited-flag
3154 ["Attributes" ebrowse-toggle-member-attributes-display
3155 :help
"Show member attributes"
3157 :selected ebrowse--attributes-flag
3159 ["Long Display" ebrowse-toggle-long-short-display
3160 :help
"Toggle the member display format"
3162 :selected ebrowse--long-display-flag
3164 ["Column Width" ebrowse-set-member-buffer-column-width
3165 :help
"Set the display's column width"
3168 ["Public" ebrowse-toggle-public-member-filter
3169 :help
"Toggle the visibility of public members"
3171 :selected
(not (aref ebrowse--filters
0))
3173 ["Protected" ebrowse-toggle-protected-member-filter
3174 :help
"Toggle the visibility of protected members"
3176 :selected
(not (aref ebrowse--filters
1))
3178 ["Private" ebrowse-toggle-private-member-filter
3179 :help
"Toggle the visibility of private members"
3181 :selected
(not (aref ebrowse--filters
2))
3183 ["Virtual" ebrowse-toggle-virtual-member-filter
3184 :help
"Toggle the visibility of virtual members"
3186 :selected ebrowse--virtual-display-flag
3188 ["Inline" ebrowse-toggle-inline-member-filter
3189 :help
"Toggle the visibility of inline members"
3191 :selected ebrowse--inline-display-flag
3193 ["Const" ebrowse-toggle-const-member-filter
3194 :help
"Toggle the visibility of const members"
3196 :selected ebrowse--const-display-flag
3198 ["Pure" ebrowse-toggle-pure-member-filter
3199 :help
"Toggle the visibility of pure virtual members"
3201 :selected ebrowse--pure-display-flag
3204 ["Show all" ebrowse-remove-all-member-filters
3205 :help
"Remove any display filters"
3208 ["Tree" ebrowse-pop-from-member-to-tree-buffer
3209 :help
"Pop to the class tree buffer"
3211 ["Next Member Buffer" ebrowse-switch-to-next-member-buffer
3212 :help
"Switch to the next member buffer of this class tree"
3214 ["Freeze" ebrowse-freeze-member-buffer
3215 :help
"Freeze (do not reuse) this member buffer"
3219 (defun ebrowse-on-class-name ()
3220 "Value is non-nil if point is on a class name."
3221 (eq (get-text-property (point) 'ebrowse-what
) 'class-name
))
3224 (defun ebrowse-on-member-name ()
3225 "Value is non-nil if point is on a member name."
3226 (eq (get-text-property (point) 'ebrowse-what
) 'member-name
))
3230 ebrowse-member-class-name-object-menu ebrowse-member-mode-map
3231 "Object menu for class names in member buffer."
3233 ["Find" ebrowse-find-member-definition
3234 :help
"Find this class in the source files"
3235 :active
(eq (get-text-property (point) 'ebrowse-what
) 'class-name
)]
3236 ["View" ebrowse-view-member-definition
3237 :help
"View this class in the source files"
3238 :active
(eq (get-text-property (point) 'ebrowse-what
) 'class-name
)]))
3242 ebrowse-member-name-object-menu ebrowse-member-mode-map
3243 "Object menu for member names"
3245 ["Find Definition" ebrowse-find-member-definition
3246 :help
"Find this member's definition in the source files"
3247 :active
(ebrowse-on-member-name)]
3248 ["Find Declaration" ebrowse-find-member-declaration
3249 :help
"Find this member's declaration in the source files"
3250 :active
(ebrowse-on-member-name)]
3251 ["View Definition" ebrowse-view-member-definition
3252 :help
"View this member's definition in the source files"
3253 :active
(ebrowse-on-member-name)]
3254 ["View Declaration" ebrowse-view-member-declaration
3255 :help
"View this member's declaration in the source files"
3256 :active
(ebrowse-on-member-name)]))
3259 (defun ebrowse-member-mouse-3 (event)
3260 "Handle `mouse-3' events in member buffers.
3261 EVENT is the mouse event."
3263 (mouse-set-point event
)
3264 (case (event-click-count event
)
3265 (2 (ebrowse-find-member-definition))
3266 (1 (case (get-text-property (posn-point (event-start event
))
3269 (ebrowse-popup-menu ebrowse-member-name-object-menu event
))
3271 (ebrowse-popup-menu ebrowse-member-class-name-object-menu event
))
3273 (ebrowse-popup-menu ebrowse-member-buffer-object-menu event
))))))
3276 (defun ebrowse-member-mouse-2 (event)
3277 "Handle `mouse-2' events in member buffers.
3278 EVENT is the mouse event."
3280 (mouse-set-point event
)
3281 (case (event-click-count event
)
3282 (2 (ebrowse-find-member-definition))
3283 (1 (case (get-text-property (posn-point (event-start event
))
3286 (ebrowse-view-member-definition 0))))))
3292 (defun ebrowse-class-alist-for-member (tree-header name
)
3293 "Return information about a member in a class tree.
3294 TREE-HEADER is the header structure of the class tree.
3295 NAME is the name of the member.
3296 Value is an alist of elements (CLASS-NAME . (CLASS LIST NAME)),
3297 where each element describes one occurrence of member NAME in the tree.
3298 CLASS-NAME is the qualified name of the class in which the
3299 member was found. The CDR of the acons is described in function
3300 `ebrowse-class/index/member-for-member'."
3301 (let ((table (ebrowse-member-table tree-header
))
3305 (dolist (info (gethash name table
) alist
)
3306 (unless (memq (first info
) known-classes
)
3307 (setf alist
(acons (ebrowse-qualified-class-name
3308 (ebrowse-ts-class (first info
)))
3310 known-classes
(cons (first info
) known-classes
)))))))
3313 (defun ebrowse-choose-tree ()
3314 "Choose a class tree to use.
3315 If there's more than one class tree loaded, let the user choose
3316 the one he wants. Value is (TREE HEADER BUFFER), with TREE being
3317 the class tree, HEADER the header structure of the tree, and BUFFER
3318 being the tree or member buffer containing the tree."
3319 (let* ((buffer (ebrowse-choose-from-browser-buffers)))
3320 (if buffer
(list (ebrowse-value-in-buffer 'ebrowse--tree buffer
)
3321 (ebrowse-value-in-buffer 'ebrowse--header buffer
)
3325 (defun ebrowse-tags-read-name (header prompt
)
3326 "Read a C++ identifier from the minibuffer.
3327 HEADER is the `ebrowse-hs' structure of the class tree.
3328 Prompt with PROMPT. Insert into the minibuffer a C++ identifier read
3329 from point as default. Value is a list (CLASS-NAME MEMBER-NAME)."
3331 (let* (start member-info
(members (ebrowse-member-table header
)))
3332 (multiple-value-bind (class-name member-name
)
3333 (ebrowse-tags-read-member+class-name
)
3335 (error "No member name at point"))
3337 (let* ((name (ebrowse-ignoring-completion-case
3338 (completing-read prompt members nil nil member-name
)))
3339 (completion-result (try-completion name members
)))
3340 ;; Cannot rely on `try-completion' returning t for exact
3341 ;; matches! It returns the name as a string.
3342 (unless (setq member-info
(gethash name members
))
3343 (if (y-or-n-p "No exact match found. Try substrings? ")
3345 (or (first (ebrowse-list-of-matching-members
3346 members
(regexp-quote name
) name
))
3347 (error "Sorry, nothing found")))
3348 (error "Canceled")))
3349 (list class-name name
))
3350 (list class-name
(read-from-minibuffer prompt member-name
)))))))
3353 (defun ebrowse-tags-read-member+class-name
()
3354 "Read a C++ identifier from point.
3355 Value is (CLASS-NAME MEMBER-NAME).
3356 CLASS-NAME is the name of the class if the identifier was qualified.
3357 It is nil otherwise.
3358 MEMBER-NAME is the name of the member found."
3360 (skip-chars-backward "a-zA-Z0-9_")
3361 (let* ((start (point))
3362 (name (progn (skip-chars-forward "a-zA-Z0-9_")
3363 (buffer-substring start
(point))))
3365 (list class name
))))
3368 (defun ebrowse-tags-choose-class (tree header name initial-class-name
)
3369 "Read a class name for a member from the minibuffer.
3370 TREE is the class tree we operate on.
3371 HEADER is its header structure.
3372 NAME is the name of the member.
3373 INITIAL-CLASS-NAME is an initial class name to insert in the minibuffer.
3374 Value is a list (TREE ACCESSOR MEMBER) for the member."
3375 (let ((alist (or (ebrowse-class-alist-for-member header name
)
3376 (error "No classes with member `%s' found" name
))))
3377 (ebrowse-ignoring-completion-case
3378 (if (null (second alist
))
3380 (push ?
\? unread-command-events
)
3381 (cdr (assoc (completing-read "In class: "
3382 alist nil t initial-class-name
)
3386 (defun* ebrowse-tags-view
/find-member-decl
/defn
3387 (prefix &key view definition member-name
)
3388 "If VIEW is t, view, else find an occurrence of MEMBER-NAME.
3390 If DEFINITION is t, find or view the member definition else its
3391 declaration. This function reads the member's name from the
3392 current buffer like FIND-TAG. It then prepares a completion list
3393 of all classes containing a member with the given name and lets
3394 the user choose the class to use. As a last step, a tags search
3395 is performed that positions point on the member declaration or
3397 (multiple-value-bind
3398 (tree header tree-buffer
) (ebrowse-choose-tree)
3399 (unless tree
(error "No class tree"))
3400 (let* ((marker (point-marker))
3405 (multiple-value-setq (class-name name
)
3406 (ebrowse-tags-read-name
3408 (concat (if view
"View" "Find") " member "
3409 (if definition
"definition" "declaration") ": "))))
3410 (setq info
(ebrowse-tags-choose-class tree header name class-name
))
3411 (ebrowse-push-position marker info
)
3412 ;; Goto the occurrence of the member
3413 (ebrowse-view/find-member-declaration
/definition
3414 prefix view definition info
3416 (ebrowse-value-in-buffer 'ebrowse--tags-file-name tree-buffer
))
3417 ;; Record position jumped to
3418 (ebrowse-push-position (point-marker) info t
))))
3422 (defun ebrowse-tags-view-declaration ()
3423 "View declaration of member at point."
3425 (ebrowse-tags-view/find-member-decl
/defn
0 :view t
:definition nil
))
3429 (defun ebrowse-tags-find-declaration ()
3430 "Find declaration of member at point."
3432 (ebrowse-tags-view/find-member-decl
/defn
0 :view nil
:definition nil
))
3436 (defun ebrowse-tags-view-definition ()
3437 "View definition of member at point."
3439 (ebrowse-tags-view/find-member-decl
/defn
0 :view t
:definition t
))
3443 (defun ebrowse-tags-find-definition ()
3444 "Find definition of member at point."
3446 (ebrowse-tags-view/find-member-decl
/defn
0 :view nil
:definition t
))
3449 (defun ebrowse-tags-view-declaration-other-window ()
3450 "View declaration of member at point in other window."
3452 (ebrowse-tags-view/find-member-decl
/defn
4 :view t
:definition nil
))
3456 (defun ebrowse-tags-find-declaration-other-window ()
3457 "Find declaration of member at point in other window."
3459 (ebrowse-tags-view/find-member-decl
/defn
4 :view nil
:definition nil
))
3463 (defun ebrowse-tags-view-definition-other-window ()
3464 "View definition of member at point in other window."
3466 (ebrowse-tags-view/find-member-decl
/defn
4 :view t
:definition t
))
3470 (defun ebrowse-tags-find-definition-other-window ()
3471 "Find definition of member at point in other window."
3473 (ebrowse-tags-view/find-member-decl
/defn
4 :view nil
:definition t
))
3476 (defun ebrowse-tags-view-declaration-other-frame ()
3477 "View definition of member at point in other frame."
3479 (ebrowse-tags-view/find-member-decl
/defn
5 :view t
:definition nil
))
3483 (defun ebrowse-tags-find-declaration-other-frame ()
3484 "Find definition of member at point in other frame."
3486 (ebrowse-tags-view/find-member-decl
/defn
5 :view nil
:definition nil
))
3490 (defun ebrowse-tags-view-definition-other-frame ()
3491 "View definition of member at point in other frame."
3493 (ebrowse-tags-view/find-member-decl
/defn
5 :view t
:definition t
))
3497 (defun ebrowse-tags-find-definition-other-frame ()
3498 "Find definition of member at point in other frame."
3500 (ebrowse-tags-view/find-member-decl
/defn
5 :view nil
:definition t
))
3503 (defun ebrowse-tags-select/create-member-buffer
(tree-buffer info
)
3504 "Select or create member buffer.
3505 TREE-BUFFER specifies the tree to use. INFO describes the member.
3506 It is a list (TREE ACCESSOR MEMBER)."
3507 (let ((buffer (get-buffer ebrowse-member-buffer-name
)))
3508 (cond ((null buffer
)
3509 (set-buffer tree-buffer
)
3510 (switch-to-buffer (ebrowse-display-member-buffer
3511 (second info
) nil
(first info
))))
3513 (switch-to-buffer buffer
)
3514 (setq ebrowse--displayed-class
(first info
)
3515 ebrowse--accessor
(second info
)
3516 ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class
))
3517 (ebrowse-redisplay-member-buffer)))
3518 (ebrowse-move-point-to-member (ebrowse-ms-name (third info
)))))
3521 (defun ebrowse-tags-display-member-buffer (&optional fix-name
)
3522 "Display a member buffer for a member.
3523 FIX-NAME non-nil means display the buffer for that member.
3524 Otherwise read a member name from point."
3526 (multiple-value-bind
3527 (tree header tree-buffer
) (ebrowse-choose-tree)
3528 (unless tree
(error "No class tree"))
3529 (let* ((marker (point-marker)) class-name
(name fix-name
) info
)
3531 (multiple-value-setq (class-name name
)
3532 (ebrowse-tags-read-name header
3533 (concat "Find member list of: "))))
3534 (setq info
(ebrowse-tags-choose-class tree header name class-name
))
3535 (ebrowse-push-position marker info
)
3536 (ebrowse-tags-select/create-member-buffer tree-buffer info
))))
3539 (defun ebrowse-list-of-matching-members (members regexp
&optional name
)
3540 "Return a list of members in table MEMBERS matching REGEXP or NAME.
3541 Both NAME and REGEXP may be nil in which case exact or regexp matches
3544 (when (or name regexp
)
3545 (maphash #'(lambda (member-name info
)
3546 (when (or (and name
(string= name member-name
))
3547 (and regexp
(string-match regexp member-name
)))
3548 (setq list
(cons member-name list
))))
3553 (defun ebrowse-tags-apropos ()
3554 "Display a list of members matching a regexp read from the minibuffer."
3556 (let* ((buffer (or (ebrowse-choose-from-browser-buffers)
3557 (error "No tree buffer")))
3558 (header (ebrowse-value-in-buffer 'ebrowse--header buffer
))
3559 (members (ebrowse-member-table header
))
3560 temp-buffer-setup-hook
3561 (regexp (read-from-minibuffer "List members matching regexp: ")))
3562 (with-output-to-temp-buffer (concat "*Apropos Members*")
3563 (set-buffer standard-output
)
3565 (insert "Members matching `" regexp
"'\n\n")
3566 (loop for s in
(ebrowse-list-of-matching-members members regexp
) do
3567 (loop for info in
(gethash s members
) do
3568 (ebrowse-draw-file-member-info info
))))))
3571 (defun ebrowse-tags-list-members-in-file ()
3572 "Display a list of members found in a file.
3573 The file name is read from the minibuffer."
3575 (let* ((buffer (or (ebrowse-choose-from-browser-buffers)
3576 (error "No tree buffer")))
3577 (files (save-excursion (set-buffer buffer
) (ebrowse-files-table)))
3578 (file (completing-read "List members in file: " files nil t
))
3579 (header (ebrowse-value-in-buffer 'ebrowse--header buffer
))
3580 temp-buffer-setup-hook
3581 (members (ebrowse-member-table header
)))
3582 (with-output-to-temp-buffer (concat "*Members in file " file
"*")
3583 (set-buffer standard-output
)
3585 #'(lambda (member-name list
)
3586 (loop for info in list
3587 as member
= (third info
)
3588 as class
= (ebrowse-ts-class (first info
))
3589 when
(or (and (null (ebrowse-ms-file member
))
3590 (string= (ebrowse-cs-file class
) file
))
3591 (string= file
(ebrowse-ms-file member
)))
3592 do
(ebrowse-draw-file-member-info info
"decl.")
3593 when
(or (and (null (ebrowse-ms-definition-file member
))
3594 (string= (ebrowse-cs-source-file class
) file
))
3595 (string= file
(ebrowse-ms-definition-file member
)))
3596 do
(ebrowse-draw-file-member-info info
"defn.")))
3600 (defun* ebrowse-draw-file-member-info
(info &optional
(kind ""))
3601 "Display a line in an the members per file info buffer.
3602 INFO describes the member. It has the form (TREE ACCESSOR MEMBER).
3603 TREE is the class of the member to display.
3604 ACCESSOR is the accessor symbol of its member list.
3605 MEMBER is the member structure.
3606 KIND is an additional string printed in the buffer."
3607 (let* ((tree (first info
))
3608 (globals-p (ebrowse-globals-tree-p tree
)))
3610 (insert (ebrowse-cs-name (ebrowse-ts-class tree
))))
3611 (insert "::" (ebrowse-ms-name (third info
)))
3615 (insert (case (second info
)
3616 ('ebrowse-ts-member-functions
"member function")
3617 ('ebrowse-ts-member-variables
"member variable")
3618 ('ebrowse-ts-static-functions
"static function")
3619 ('ebrowse-ts-static-variables
"static variable")
3620 ('ebrowse-ts-friends
(if globals-p
"define" "friend"))
3621 ('ebrowse-ts-types
"type")
3625 (defvar ebrowse-last-completion nil
3626 "Text inserted by the last completion operation.")
3629 (defvar ebrowse-last-completion-start nil
3630 "String which was the basis for the last completion operation.")
3633 (defvar ebrowse-last-completion-location nil
3634 "Buffer position at which the last completion operation was initiated.")
3637 (defvar ebrowse-last-completion-obarray nil
3638 "Member used in last completion operation.")
3641 (make-variable-buffer-local 'ebrowse-last-completion-obarray
)
3642 (make-variable-buffer-local 'ebrowse-last-completion-location
)
3643 (make-variable-buffer-local 'ebrowse-last-completion
)
3644 (make-variable-buffer-local 'ebrowse-last-completion-start
)
3648 (defun ebrowse-some-member-table ()
3649 "Return a hash table containing all members of a tree.
3650 If there's only one tree loaded, use that. Otherwise let the
3652 (let* ((buffers (ebrowse-known-class-trees-buffer-list))
3653 (buffer (cond ((and (first buffers
) (not (second buffers
)))
3655 (t (or (ebrowse-electric-choose-tree)
3656 (error "No tree buffer")))))
3657 (header (ebrowse-value-in-buffer 'ebrowse--header buffer
)))
3658 (ebrowse-member-table header
)))
3661 (defun ebrowse-cyclic-successor-in-string-list (string list
)
3662 "Return the item following STRING in LIST.
3663 If STRING is the last element, return the first element as successor."
3664 (or (nth (1+ (ebrowse-position string list
'string
=)) list
)
3668 ;;; Symbol completion
3671 (defun* ebrowse-tags-complete-symbol
(prefix)
3672 "Perform completion on the C++ symbol preceding point.
3673 A second call of this function without changing point inserts the next match.
3674 A call with prefix PREFIX reads the symbol to insert from the minibuffer with
3677 (let* ((end (point))
3678 (begin (save-excursion (skip-chars-backward "a-zA-Z_0-9") (point)))
3679 (pattern (buffer-substring begin end
))
3682 ;; With prefix, read name from minibuffer with completion.
3684 (let* ((members (ebrowse-some-member-table))
3685 (completion (completing-read "Insert member: "
3686 members nil t pattern
)))
3688 (setf ebrowse-last-completion-location nil
)
3689 (delete-region begin end
)
3690 (insert completion
))))
3691 ;; If this function is called at the same point the last
3692 ;; expansion ended, insert the next expansion.
3693 ((eq (point) ebrowse-last-completion-location
)
3694 (setf list
(all-completions ebrowse-last-completion-start
3695 ebrowse-last-completion-obarray
)
3696 completion
(ebrowse-cyclic-successor-in-string-list
3697 ebrowse-last-completion list
))
3698 (cond ((null completion
)
3699 (error "No completion"))
3700 ((string= completion pattern
)
3701 (error "No further completion"))
3703 (delete-region begin end
)
3705 (setf ebrowse-last-completion completion
3706 ebrowse-last-completion-location
(point)))))
3707 ;; First time the function is called at some position in the
3708 ;; buffer: Start new completion.
3710 (let* ((members (ebrowse-some-member-table))
3711 (completion (first (all-completions pattern members nil
))))
3712 (cond ((eq completion t
))
3714 (error "Can't find completion for `%s'" pattern
))
3716 (delete-region begin end
)
3719 (setf ebrowse-last-completion-location
(point)
3720 ebrowse-last-completion-start pattern
3721 ebrowse-last-completion completion
3722 ebrowse-last-completion-obarray members
))))))))
3725 ;;; Tags query replace & search
3727 (defvar ebrowse-tags-loop-form
()
3728 "Form for `ebrowse-loop-continue'.
3729 Evaluated for each file in the tree. If it returns nil, proceed
3730 with the next file.")
3732 (defvar ebrowse-tags-next-file-list
()
3733 "A list of files to be processed.")
3736 (defvar ebrowse-tags-next-file-path nil
3737 "The path relative to which files have to be searched.")
3740 (defvar ebrowse-tags-loop-last-file nil
3741 "The last file visited via `ebrowse-tags-loop'.")
3744 (defun ebrowse-tags-next-file (&optional initialize tree-buffer
)
3745 "Select next file among files in current tag table.
3746 Non-nil argument INITIALIZE (prefix arg, if interactive) initializes
3747 to the beginning of the list of files in the tag table.
3748 TREE-BUFFER specifies the class tree we operate on."
3750 ;; Call with INITIALIZE non-nil initializes the files list.
3751 ;; If more than one tree buffer is loaded, let the user choose
3752 ;; on which tree (s)he wants to operate.
3754 (let ((buffer (or tree-buffer
(ebrowse-choose-from-browser-buffers))))
3757 (setq ebrowse-tags-next-file-list
3758 (ebrowse-files-list (ebrowse-marked-classes-p))
3759 ebrowse-tags-loop-last-file
3761 ebrowse-tags-next-file-path
3762 (file-name-directory ebrowse--tags-file-name
)))))
3763 ;; End of the loop if the stack of files is empty.
3764 (unless ebrowse-tags-next-file-list
3765 (error "All files processed"))
3766 ;; ebrowse-tags-loop-last-file is the last file that was visited due
3767 ;; to a call to BROWSE-LOOP (see below). If that file is still
3768 ;; in memory, and it wasn't modified, throw its buffer away to
3769 ;; prevent cluttering up the buffer list.
3770 (when ebrowse-tags-loop-last-file
3771 (let ((buffer (get-file-buffer ebrowse-tags-loop-last-file
)))
3773 (not (buffer-modified-p buffer
)))
3774 (kill-buffer buffer
))))
3775 ;; Remember this buffer file name for later deletion, if it
3776 ;; wasn't visited by other means.
3777 (let ((file (expand-file-name (car ebrowse-tags-next-file-list
)
3778 ebrowse-tags-next-file-path
)))
3779 (setq ebrowse-tags-loop-last-file
(if (get-file-buffer file
) nil file
))
3780 ;; Find the file and pop the file list. Pop has to be done
3781 ;; before the file is loaded because FIND-FILE might encounter
3782 ;; an error, and we want to be able to proceed with the next
3783 ;; file in this case.
3784 (pop ebrowse-tags-next-file-list
)
3789 (defun ebrowse-tags-loop-continue (&optional first-time tree-buffer
)
3790 "Repeat last operation on files in tree.
3791 FIRST-TIME non-nil means this is not a repetition, but the first time.
3792 TREE-BUFFER if indirectly specifies which files to loop over."
3795 (ebrowse-tags-next-file first-time tree-buffer
)
3796 (goto-char (point-min)))
3797 (while (not (eval ebrowse-tags-loop-form
))
3798 (ebrowse-tags-next-file)
3799 (message "Scanning file `%s'..." buffer-file-name
)
3800 (goto-char (point-min))))
3804 (defun ebrowse-tags-search (regexp)
3805 "Search for REGEXP in all files in a tree.
3806 If marked classes exist, process marked classes, only.
3807 If regular expression is nil, repeat last search."
3808 (interactive "sTree search (regexp): ")
3809 (if (and (string= regexp
"")
3810 (eq (car ebrowse-tags-loop-form
) 're-search-forward
))
3811 (ebrowse-tags-loop-continue)
3812 (setq ebrowse-tags-loop-form
(list 're-search-forward regexp nil t
))
3813 (ebrowse-tags-loop-continue 'first-time
)))
3817 (defun ebrowse-tags-query-replace (from to
)
3818 "Query replace FROM with TO in all files of a class tree.
3819 With prefix arg, process files of marked classes only."
3821 "sTree query replace (regexp): \nsTree query replace %s by: ")
3822 (setq ebrowse-tags-loop-form
3823 (list 'and
(list 'save-excursion
3824 (list 're-search-forward from nil t
))
3825 (list 'not
(list 'perform-replace from to t t nil
))))
3826 (ebrowse-tags-loop-continue 'first-time
))
3830 (defun ebrowse-tags-search-member-use (&optional fix-name
)
3831 "Search for call sites of a member.
3832 If FIX-NAME is specified, search uses of that member.
3833 Otherwise, read a member name from the minibuffer.
3834 Searches in all files mentioned in a class tree for something that
3835 looks like a function call to the member."
3837 ;; Choose the tree to use if there is more than one.
3838 (multiple-value-bind (tree header tree-buffer
)
3839 (ebrowse-choose-tree)
3841 (error "No class tree"))
3842 ;; Get the member name NAME (class-name is ignored).
3843 (let ((name fix-name
) class-name regexp
)
3845 (multiple-value-setq (class-name name
)
3846 (ebrowse-tags-read-name header
"Find calls of: ")))
3847 ;; Set tags loop form to search for member and begin loop.
3848 (setq regexp
(concat "\\<" name
"[ \t]*(")
3849 ebrowse-tags-loop-form
(list 're-search-forward regexp nil t
))
3850 (ebrowse-tags-loop-continue 'first-time tree-buffer
))))
3854 ;;; Tags position management
3856 ;;; Structures of this kind are the elements of the position stack.
3858 (defstruct (ebrowse-position (:type vector
) :named
)
3859 file-name
; in which file
3860 point
; point in file
3861 target
; t if target of a jump
3862 info
) ; (CLASS FUNC MEMBER) jumped to
3865 (defvar ebrowse-position-stack
()
3866 "Stack of `ebrowse-position' structured.")
3869 (defvar ebrowse-position-index
0
3870 "Current position in position stack.")
3873 (defun ebrowse-position-name (position)
3874 "Return an identifying string for POSITION.
3875 The string is printed in the electric position list buffer."
3876 (let ((info (ebrowse-position-info position
)))
3877 (concat (if (ebrowse-position-target position
) "at " "to ")
3878 (ebrowse-cs-name (ebrowse-ts-class (first info
)))
3879 "::" (ebrowse-ms-name (third info
)))))
3882 (defun ebrowse-view/find-position
(position &optional view
)
3883 "Position point on POSITION.
3884 If VIEW is non-nil, view the position, otherwise find it."
3886 (find-file (ebrowse-position-file-name position
))
3887 (goto-char (ebrowse-position-point position
)))
3893 (goto-char (ebrowse-position-point position
))))
3895 (view-file (ebrowse-position-file-name position
)))
3896 (pop view-mode-hook
)))))
3899 (defun ebrowse-push-position (marker info
&optional target
)
3900 "Push current position on position stack.
3901 MARKER is the marker to remember as position.
3902 INFO is a list (CLASS FUNC MEMBER) specifying what we jumped to.
3903 TARGET non-nil means we performed a jump.
3904 Positions in buffers that have no file names are not saved."
3905 (when (buffer-file-name (marker-buffer marker
))
3906 (let ((too-much (- (length ebrowse-position-stack
)
3907 ebrowse-max-positions
)))
3908 ;; Do not let the stack grow to infinity.
3909 (when (plusp too-much
)
3910 (setq ebrowse-position-stack
3911 (butlast ebrowse-position-stack too-much
)))
3912 ;; Push the position.
3913 (push (make-ebrowse-position
3914 :file-name
(buffer-file-name (marker-buffer marker
))
3915 :point
(marker-position marker
)
3918 ebrowse-position-stack
))))
3921 (defun ebrowse-move-in-position-stack (increment)
3922 "Move by INCREMENT in the position stack."
3923 (let ((length (length ebrowse-position-stack
)))
3924 (when (zerop length
)
3925 (error "No positions remembered"))
3926 (setq ebrowse-position-index
3927 (mod (+ increment ebrowse-position-index
) length
))
3928 (message "Position %d of %d " ebrowse-position-index length
)
3929 (ebrowse-view/find-position
(nth ebrowse-position-index
3930 ebrowse-position-stack
))))
3934 (defun ebrowse-back-in-position-stack (arg)
3935 "Move backward in the position stack.
3936 Prefix arg ARG says how much."
3938 (ebrowse-move-in-position-stack (max 1 arg
)))
3942 (defun ebrowse-forward-in-position-stack (arg)
3943 "Move forward in the position stack.
3944 Prefix arg ARG says how much."
3946 (ebrowse-move-in-position-stack (min -
1 (- arg
))))
3950 ;;; Electric position list
3952 (defvar ebrowse-electric-position-mode-map
()
3953 "Keymap used in electric position stack window.")
3956 (defvar ebrowse-electric-position-mode-hook nil
3957 "If non-nil, its value is called by `ebrowse-electric-position-mode'.")
3960 (unless ebrowse-electric-position-mode-map
3961 (let ((map (make-keymap))
3962 (submap (make-keymap)))
3963 (setq ebrowse-electric-position-mode-map map
)
3964 (fillarray (car (cdr map
)) 'ebrowse-electric-position-undefined
)
3965 (fillarray (car (cdr submap
)) 'ebrowse-electric-position-undefined
)
3966 (define-key map
"\e" submap
)
3967 (define-key map
"\C-z" 'suspend-emacs
)
3968 (define-key map
"\C-h" 'Helper-help
)
3969 (define-key map
"?" 'Helper-describe-bindings
)
3970 (define-key map
"\C-c" nil
)
3971 (define-key map
"\C-c\C-c" 'ebrowse-electric-position-quit
)
3972 (define-key map
"q" 'ebrowse-electric-position-quit
)
3973 (define-key map
" " 'ebrowse-electric-select-position
)
3974 (define-key map
"\C-l" 'recenter
)
3975 (define-key map
"\C-u" 'universal-argument
)
3976 (define-key map
"\C-p" 'previous-line
)
3977 (define-key map
"\C-n" 'next-line
)
3978 (define-key map
"p" 'previous-line
)
3979 (define-key map
"n" 'next-line
)
3980 (define-key map
"v" 'ebrowse-electric-view-position
)
3981 (define-key map
"\C-v" 'scroll-up
)
3982 (define-key map
"\ev" 'scroll-down
)
3983 (define-key map
"\e\C-v" 'scroll-other-window
)
3984 (define-key map
"\e>" 'end-of-buffer
)
3985 (define-key map
"\e<" 'beginning-of-buffer
)
3986 (define-key map
"\e>" 'end-of-buffer
)))
3988 (put 'ebrowse-electric-position-mode
'mode-class
'special
)
3989 (put 'ebrowse-electric-position-undefined
'suppress-keymap t
)
3992 (defun ebrowse-electric-position-mode ()
3993 "Mode for electric position buffers.
3994 Runs the hook `ebrowse-electric-position-mode-hook'."
3995 (kill-all-local-variables)
3996 (use-local-map ebrowse-electric-position-mode-map
)
3997 (setq mode-name
"Electric Position Menu"
3998 mode-line-buffer-identification
"Electric Position Menu")
3999 (when (memq 'mode-name mode-line-format
)
4000 (setq mode-line-format
(copy-sequence mode-line-format
))
4001 (setcar (memq 'mode-name mode-line-format
) "Positions"))
4002 (make-local-variable 'Helper-return-blurb
)
4003 (setq Helper-return-blurb
"return to buffer editing"
4006 major-mode
'ebrowse-electric-position-mode
)
4007 (run-mode-hooks 'ebrowse-electric-position-mode-hook
))
4010 (defun ebrowse-draw-position-buffer ()
4011 "Display positions in buffer *Positions*."
4012 (set-buffer (get-buffer-create "*Positions*"))
4013 (setq buffer-read-only nil
)
4015 (insert "File Point Description\n"
4016 "---- ----- -----------\n")
4017 (dolist (position ebrowse-position-stack
)
4018 (insert (file-name-nondirectory (ebrowse-position-file-name position
)))
4020 (insert (int-to-string (ebrowse-position-point position
)))
4022 (insert (ebrowse-position-name position
) "\n"))
4023 (setq buffer-read-only t
))
4027 (defun ebrowse-electric-position-menu ()
4028 "List positions in the position stack in an electric buffer."
4030 (unless ebrowse-position-stack
4031 (error "No positions remembered"))
4032 (let (select buffer window
)
4033 (save-window-excursion
4034 (save-window-excursion (ebrowse-draw-position-buffer))
4035 (setq window
(Electric-pop-up-window "*Positions*")
4036 buffer
(window-buffer window
))
4037 (shrink-window-if-larger-than-buffer window
)
4041 (ebrowse-electric-position-mode)
4043 (catch 'ebrowse-electric-select-position
4044 (message "<<< Press Space to bury the list >>>")
4045 (let ((first (progn (goto-char (point-min))
4048 (last (progn (goto-char (point-max))
4053 (Electric-command-loop 'ebrowse-electric-select-position
4055 'ebrowse-electric-position-looper
4056 (cons first last
))))))
4058 (bury-buffer buffer
)
4062 (ebrowse-electric-find-position select
))
4063 (kill-buffer buffer
)))
4066 (defun ebrowse-electric-position-looper (state condition
)
4067 "Prevent moving point on invalid lines.
4068 Called from `Electric-command-loop'. See there for the meaning
4069 of STATE and CONDITION."
4070 (cond ((and condition
4071 (not (memq (car condition
) '(buffer-read-only
4073 beginning-of-buffer
))))
4074 (signal (car condition
) (cdr condition
)))
4075 ((< (point) (car state
))
4076 (goto-char (point-min))
4078 ((> (point) (cdr state
))
4079 (goto-char (point-max))
4081 (if (pos-visible-in-window-p (point-max))
4085 (defun ebrowse-electric-position-undefined ()
4086 "Function called for undefined keys."
4088 (message "Type C-h for help, ? for commands, q to quit, Space to execute")
4092 (defun ebrowse-electric-position-quit ()
4093 "Leave the electric position list."
4095 (throw 'ebrowse-electric-select-position nil
))
4098 (defun ebrowse-electric-select-position ()
4099 "Select a position from the list."
4101 (throw 'ebrowse-electric-select-position
(point)))
4104 (defun ebrowse-electric-find-position (point &optional view
)
4105 "View/find what is described by the line at POINT.
4106 If VIEW is non-nil, view else find source files."
4107 (let ((index (- (count-lines (point-min) point
) 2)))
4108 (ebrowse-view/find-position
(nth index
4109 ebrowse-position-stack
) view
)))
4112 (defun ebrowse-electric-view-position ()
4113 "View the position described by the line point is in."
4115 (ebrowse-electric-find-position (point) t
))
4119 ;;; Saving trees to disk
4121 (defun ebrowse-write-file-hook-fn ()
4122 "Write current buffer as a class tree.
4123 Installed on `local-write-file-hooks'."
4129 (defun ebrowse-save-tree ()
4130 "Save current tree in same file it was loaded from."
4132 (ebrowse-save-tree-as (or buffer-file-name ebrowse--tags-file-name
)))
4136 (defun ebrowse-save-tree-as (&optional file-name
)
4137 "Write the current tree data structure to a file.
4138 Read the file name from the minibuffer if interactive.
4139 Otherwise, FILE-NAME specifies the file to save the tree in."
4140 (interactive "FSave tree as: ")
4141 (let ((temp-buffer (get-buffer-create "*Tree Output"))
4142 (old-standard-output standard-output
)
4143 (header (copy-ebrowse-hs ebrowse--header
))
4144 (tree ebrowse--tree
))
4147 (set-buffer (setq standard-output temp-buffer
))
4149 (setf (ebrowse-hs-member-table header
) nil
)
4150 (insert (prin1-to-string header
) " ")
4151 (mapcar 'ebrowse-save-class tree
)
4152 (write-file file-name
)
4153 (message "Tree written to file `%s'" file-name
))
4154 (kill-buffer temp-buffer
)
4155 (set-buffer-modified-p nil
)
4156 (ebrowse-update-tree-buffer-mode-line)
4157 (setq standard-output old-standard-output
))))
4160 (defun ebrowse-save-class (class)
4161 "Write single class CLASS to current buffer."
4162 (message "%s..." (ebrowse-cs-name (ebrowse-ts-class class
)))
4163 (insert "[ebrowse-ts ")
4164 (prin1 (ebrowse-ts-class class
)) ;class name
4165 (insert "(") ;list of subclasses
4166 (mapcar 'ebrowse-save-class
(ebrowse-ts-subclasses class
))
4168 (dolist (func ebrowse-member-list-accessors
)
4169 (prin1 (funcall func class
))
4171 (insert "()") ;base-classes slot
4172 (prin1 (ebrowse-ts-mark class
))
4180 (defun ebrowse-statistics ()
4181 "Display statistics for a class tree."
4183 (let ((tree-file (buffer-file-name))
4184 temp-buffer-setup-hook
)
4185 (with-output-to-temp-buffer "*Tree Statistics*"
4186 (multiple-value-bind (classes member-functions member-variables
4187 static-functions static-variables
)
4188 (ebrowse-gather-statistics)
4189 (set-buffer standard-output
)
4191 (insert "STATISTICS FOR TREE " (or tree-file
"unknown") ":\n\n")
4192 (ebrowse-print-statistics-line "Number of classes:" classes
)
4193 (ebrowse-print-statistics-line "Number of member functions:"
4195 (ebrowse-print-statistics-line "Number of member variables:"
4197 (ebrowse-print-statistics-line "Number of static functions:"
4199 (ebrowse-print-statistics-line "Number of static variables:"
4200 static-variables
)))))
4203 (defun ebrowse-print-statistics-line (title value
)
4204 "Print a line in the statistics buffer.
4205 TITLE is the title of the line, VALUE is a number to be printed
4209 (insert (format "%d\n" value
)))
4212 (defun ebrowse-gather-statistics ()
4213 "Return statistics for a class tree.
4214 The result is a list (NUMBER-OF-CLASSES NUMBER-OF-MEMBER-FUNCTIONS
4215 NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS
4216 NUMBER-OF-STATIC-VARIABLES:"
4217 (let ((classes 0) (member-functions 0) (member-variables 0)
4218 (static-functions 0) (static-variables 0))
4219 (ebrowse-for-all-trees (tree ebrowse--tree-obarray
)
4221 (incf member-functions
(length (ebrowse-ts-member-functions tree
)))
4222 (incf member-variables
(length (ebrowse-ts-member-variables tree
)))
4223 (incf static-functions
(length (ebrowse-ts-static-functions tree
)))
4224 (incf static-variables
(length (ebrowse-ts-static-variables tree
))))
4225 (list classes member-functions member-variables
4226 static-functions static-variables
)))
4230 ;;; Global key bindings
4232 ;;; The following can be used to bind key sequences starting with
4233 ;;; prefix `\C-c\C-m' to browse commands.
4235 (defvar ebrowse-global-map nil
4236 "*Keymap for Ebrowse commands.")
4239 (defvar ebrowse-global-prefix-key
"\C-c\C-m"
4240 "Prefix key for Ebrowse commands.")
4243 (defvar ebrowse-global-submap-4 nil
4244 "Keymap used for `ebrowse-global-prefix' followed by `4'.")
4247 (defvar ebrowse-global-submap-5 nil
4248 "Keymap used for `ebrowse-global-prefix' followed by `5'.")
4251 (unless ebrowse-global-map
4252 (setq ebrowse-global-map
(make-sparse-keymap))
4253 (setq ebrowse-global-submap-4
(make-sparse-keymap))
4254 (setq ebrowse-global-submap-5
(make-sparse-keymap))
4255 (define-key ebrowse-global-map
"a" 'ebrowse-tags-apropos
)
4256 (define-key ebrowse-global-map
"b" 'ebrowse-pop-to-browser-buffer
)
4257 (define-key ebrowse-global-map
"-" 'ebrowse-back-in-position-stack
)
4258 (define-key ebrowse-global-map
"+" 'ebrowse-forward-in-position-stack
)
4259 (define-key ebrowse-global-map
"l" 'ebrowse-tags-list-members-in-file
)
4260 (define-key ebrowse-global-map
"m" 'ebrowse-tags-display-member-buffer
)
4261 (define-key ebrowse-global-map
"n" 'ebrowse-tags-next-file
)
4262 (define-key ebrowse-global-map
"p" 'ebrowse-electric-position-menu
)
4263 (define-key ebrowse-global-map
"s" 'ebrowse-tags-search
)
4264 (define-key ebrowse-global-map
"u" 'ebrowse-tags-search-member-use
)
4265 (define-key ebrowse-global-map
"v" 'ebrowse-tags-view-definition
)
4266 (define-key ebrowse-global-map
"V" 'ebrowse-tags-view-declaration
)
4267 (define-key ebrowse-global-map
"%" 'ebrowse-tags-query-replace
)
4268 (define-key ebrowse-global-map
"." 'ebrowse-tags-find-definition
)
4269 (define-key ebrowse-global-map
"f" 'ebrowse-tags-find-definition
)
4270 (define-key ebrowse-global-map
"F" 'ebrowse-tags-find-declaration
)
4271 (define-key ebrowse-global-map
"," 'ebrowse-tags-loop-continue
)
4272 (define-key ebrowse-global-map
" " 'ebrowse-electric-buffer-list
)
4273 (define-key ebrowse-global-map
"\t" 'ebrowse-tags-complete-symbol
)
4274 (define-key ebrowse-global-map
"4" ebrowse-global-submap-4
)
4275 (define-key ebrowse-global-submap-4
"." 'ebrowse-tags-find-definition-other-window
)
4276 (define-key ebrowse-global-submap-4
"f" 'ebrowse-tags-find-definition-other-window
)
4277 (define-key ebrowse-global-submap-4
"v" 'ebrowse-tags-find-declaration-other-window
)
4278 (define-key ebrowse-global-submap-4
"F" 'ebrowse-tags-view-definition-other-window
)
4279 (define-key ebrowse-global-submap-4
"V" 'ebrowse-tags-view-declaration-other-window
)
4280 (define-key ebrowse-global-map
"5" ebrowse-global-submap-5
)
4281 (define-key ebrowse-global-submap-5
"." 'ebrowse-tags-find-definition-other-frame
)
4282 (define-key ebrowse-global-submap-5
"f" 'ebrowse-tags-find-definition-other-frame
)
4283 (define-key ebrowse-global-submap-5
"v" 'ebrowse-tags-find-declaration-other-frame
)
4284 (define-key ebrowse-global-submap-5
"F" 'ebrowse-tags-view-definition-other-frame
)
4285 (define-key ebrowse-global-submap-5
"V" 'ebrowse-tags-view-declaration-other-frame
)
4286 (define-key global-map ebrowse-global-prefix-key ebrowse-global-map
))
4290 ;;; Electric C++ browser buffer menu
4292 ;;; Electric buffer menu customization to display only some buffers
4293 ;;; (in this case Tree buffers). There is only one problem with this:
4294 ;;; If the very first character typed in the buffer menu is a space,
4295 ;;; this will select the buffer from which the buffer menu was
4296 ;;; invoked. But this buffer is not displayed in the buffer list if
4297 ;;; it isn't a tree buffer. I therefore let the buffer menu command
4298 ;;; loop read the command `p' via `unread-command-char'. This command
4299 ;;; has no effect since we are on the first line of the buffer.
4301 (defvar electric-buffer-menu-mode-hook nil
)
4304 (defun ebrowse-hack-electric-buffer-menu ()
4305 "Hack the electric buffer menu to display browser buffers."
4309 (setq buffer-read-only nil
)
4313 (let ((b (Buffer-menu-buffer nil
)))
4314 (if (or (ebrowse-buffer-p b
)
4315 (string= (buffer-name b
) "*Apropos Members*"))
4316 (progn (forward-line 1)
4318 (delete-region (point)
4319 (save-excursion (end-of-line)
4323 (error "No tree buffers"))
4324 (setf unread-command-events
(listify-key-sequence "p"))
4325 (shrink-window-if-larger-than-buffer (selected-window))
4326 (setq buffer-read-only t
))))
4329 (defun ebrowse-select-1st-to-9nth ()
4330 "Select the nth entry in the list by the keys 1..9."
4332 (let* ((maxlin (count-lines (point-min) (point-max)))
4333 (n (min maxlin
(+ 2 (string-to-number (this-command-keys))))))
4335 (throw 'electric-buffer-menu-select
(point))))
4338 (defun ebrowse-install-1-to-9-keys ()
4339 "Define keys 1..9 to select the 1st to 9nth entry in the list."
4341 (define-key (current-local-map) (char-to-string (+ i ?
1))
4342 'ebrowse-select-1st-to-9nth
)))
4345 (defun ebrowse-electric-buffer-list ()
4346 "Display an electric list of Ebrowse buffers."
4350 (add-hook 'electric-buffer-menu-mode-hook
4351 'ebrowse-hack-electric-buffer-menu
)
4352 (add-hook 'electric-buffer-menu-mode-hook
4353 'ebrowse-install-1-to-9-keys
)
4354 (call-interactively 'electric-buffer-list
))
4355 (remove-hook 'electric-buffer-menu-mode-hook
4356 'ebrowse-hack-electric-buffer-menu
)))
4361 (defun ebrowse-mouse-find-member (event)
4362 "Find the member clicked on in another frame.
4363 EVENT is a mouse button event."
4365 (mouse-set-point event
)
4368 (skip-chars-backward "a-zA-Z0-9_")
4369 (setq start
(point))
4370 (skip-chars-forward "a-zA-Z0-9_")
4371 (setq name
(buffer-substring start
(point))))
4372 (ebrowse-tags-view/find-member-decl
/defn
4373 5 :view nil
:definition t
:member-name name
)))
4376 (defun ebrowse-popup-menu (menu event
)
4377 "Pop up MENU and perform an action if something was selected.
4378 EVENT is the mouse event."
4379 (save-selected-window
4380 (select-window (posn-window (event-start event
)))
4381 (let ((selection (x-popup-menu event menu
)) binding
)
4383 (setq binding
(lookup-key (or binding menu
) (vector (car selection
)))
4384 selection
(cdr selection
)))
4386 (call-interactively binding
)))))
4390 ebrowse-tree-buffer-class-object-menu ebrowse-tree-mode-map
4391 "Object menu for classes in the tree buffer"
4393 ["Functions" ebrowse-tree-command
:show-member-functions
4394 :help
"Display a list of member functions"
4396 ["Variables" ebrowse-tree-command
:show-member-variables
4397 :help
"Display a list of member variables"
4399 ["Static Functions" ebrowse-tree-command
:show-static-member-functions
4400 :help
"Display a list of static member functions"
4402 ["Static Variables" ebrowse-tree-command
:show-static-member-variables
4403 :help
"Display a list of static member variables"
4405 ["Friends/ Defines" ebrowse-tree-command
:show-friends
4406 :help
"Display a list of friends of a class"
4408 ["Types" ebrowse-tree-command
:show-types
4409 :help
"Display a list of types defined in a class"
4412 ["View" ebrowse-view-class-declaration
4413 :help
"View class declaration"
4414 :active
(eq (get-text-property (point) 'ebrowse-what
) 'class-name
)]
4415 ["Find" ebrowse-find-class-declaration
4416 :help
"Find class declaration in file"
4417 :active
(eq (get-text-property (point) 'ebrowse-what
) 'class-name
)]
4419 ["Mark" ebrowse-toggle-mark-at-point
4420 :help
"Mark class point is on"
4421 :active
(eq (get-text-property (point) 'ebrowse-what
) 'class-name
)]
4423 ["Collapse" ebrowse-collapse-branch
4424 :help
"Collapse subtree under class point is on"
4425 :active
(eq (get-text-property (point) 'ebrowse-what
) 'class-name
)]
4426 ["Expand" ebrowse-expand-branch
4427 :help
"Expand subtree under class point is on"
4428 :active
(eq (get-text-property (point) 'ebrowse-what
) 'class-name
)]))
4432 ebrowse-tree-buffer-object-menu ebrowse-tree-mode-map
4433 "Object menu for tree buffers"
4435 ["Filename Display" ebrowse-toggle-file-name-display
4436 :help
"Toggle display of source files names"
4438 :selected ebrowse--show-file-names-flag
4440 ["Tree Indentation" ebrowse-set-tree-indentation
4441 :help
"Set the tree's indentation"
4443 ["Unmark All Classes" ebrowse-mark-all-classes
4444 :help
"Unmark all classes in the class tree"
4446 ["Expand All" ebrowse-expand-all
4447 :help
"Expand all subtrees in the class tree"
4449 ["Statistics" ebrowse-statistics
4450 :help
"Show a buffer with class hierarchy statistics"
4452 ["Find Class" ebrowse-read-class-name-and-go
4453 :help
"Find a class in the tree"
4455 ["Member Buffer" ebrowse-pop
/switch-to-member-buffer-for-same-tree
4456 :help
"Show a member buffer for this class tree"
4460 (defun ebrowse-mouse-3-in-tree-buffer (event)
4461 "Perform mouse actions in tree buffers.
4462 EVENT is the mouse event."
4464 (mouse-set-point event
)
4465 (let* ((where (posn-point (event-start event
)))
4466 (property (get-text-property where
'ebrowse-what
)))
4467 (case (event-click-count event
)
4471 (ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event
))
4473 (ebrowse-popup-menu ebrowse-tree-buffer-object-menu event
)))))))
4476 (defun ebrowse-mouse-2-in-tree-buffer (event)
4477 "Perform mouse actions in tree buffers.
4478 EVENT is the mouse event."
4480 (mouse-set-point event
)
4481 (let* ((where (posn-point (event-start event
)))
4482 (property (get-text-property where
'ebrowse-what
)))
4483 (case (event-click-count event
)
4486 (ebrowse-tree-command:show-member-functions
)))))))
4489 (defun ebrowse-mouse-1-in-tree-buffer (event)
4490 "Perform mouse actions in tree buffers.
4491 EVENT is the mouse event."
4493 (mouse-set-point event
)
4494 (let* ((where (posn-point (event-start event
)))
4495 (property (get-text-property where
'ebrowse-what
)))
4496 (case (event-click-count event
)
4499 (let ((collapsed (save-excursion (skip-chars-forward "^\r\n")
4500 (looking-at "\r"))))
4501 (ebrowse-collapse-fn (not collapsed
))))
4503 (ebrowse-toggle-mark-at-point 1)))))))
4509 ;;; Local variables:
4510 ;;; eval:(put 'ebrowse-output 'lisp-indent-hook 0)
4511 ;;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
4512 ;;; eval:(put 'ebrowse-save-selective 'lisp-indent-hook 0)
4513 ;;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
4516 ;;; arch-tag: 4fa3c8bf-1771-479b-bcd7-b029c7c9677b
4517 ;;; ebrowse.el ends here