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