code.delx.au - gnu-emacs/blob - lisp/progmodes/ebrowse.el

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