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