diff options
| author | Gerd Moellmann <gerd@gnu.org> | 2000-04-09 11:15:57 +0000 |
|---|---|---|
| committer | Gerd Moellmann <gerd@gnu.org> | 2000-04-09 11:15:57 +0000 |
| commit | be0dbdab007cf09a2cac30c89ad4d530b08abeae (patch) | |
| tree | 67292bea88bc5bb6a5a997cd1b40461af29f75e4 /lisp | |
| parent | 25112054fe5d863c409dd9779cb5e7ed3530e9e7 (diff) | |
| download | emacs-be0dbdab007cf09a2cac30c89ad4d530b08abeae.tar.gz | |
*** empty log message ***
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 17 | ||||
| -rw-r--r-- | lisp/cus-load.el | 20 | ||||
| -rw-r--r-- | lisp/loaddefs.el | 180 | ||||
| -rw-r--r-- | lisp/progmodes/ebrowse.el | 4573 |
4 files changed, 4738 insertions, 52 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a2fd5c2ead2..36aa9eefa6f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,20 @@ +2000-04-09 Gerd Moellmann <gerd@gnu.org> + + * mail/rfc2368.el: Correct author's email address. + + * progmodes/ebrowse.el: New file. + + * emacs-lisp/easymenu.el (easy-menu-create-menu): Process menu + item help string. + (easy-menu-do-add-item): Ditto. + (easy-menu-define): Extend doc string. + + * jit-lock.el (with-buffer-unmodified): Use + restore-buffer-modified-p. + (with-buffer-prepared-for-font-lock): Use with-buffer-unmodified. + (jit-lock-function, jit-lock-stealth-fontify): Don't use + with-buffer-unmodified. + 2000-04-08 Dave Love <fx@gnu.org> * emacs-lisp/edebug.el: Fix specs for dolist, dotimes, push, pop, diff --git a/lisp/cus-load.el b/lisp/cus-load.el index cf0c724f6e6..df9b657c8a2 100644 --- a/lisp/cus-load.el +++ b/lisp/cus-load.el @@ -38,6 +38,7 @@ (put 'nnmail-procmail 'custom-loads '("nnmail")) (put 'desktop 'custom-loads '("desktop")) (put 'cperl-help-system 'custom-loads '("cperl-mode")) +(put 'ps-print-miscellany 'custom-loads '("ps-print")) (put 'comint-completion 'custom-loads '("comint")) (put 'gnus-score-kill 'custom-loads '("gnus-kill" "gnus")) (put 'ldap 'custom-loads '("ldap")) @@ -84,6 +85,7 @@ (put 'gnus-various 'custom-loads '("gnus-sum" "gnus")) (put 'elide-head 'custom-loads '("elide-head")) (put 'vhdl-compile 'custom-loads '("vhdl-mode")) +(put 'ebrowse-tree 'custom-loads '("ebrowse")) (put 'font-lock-highlighting-faces 'custom-loads '("font-lock" "vhdl-mode")) (put 'flyspell 'custom-loads '("flyspell")) (put 'ange-ftp 'custom-loads '("ange-ftp")) @@ -267,7 +269,7 @@ (put 'ebnf-optimization 'custom-loads '("ebnf2ps")) (put 'apropos 'custom-loads '("apropos")) (put 'gomoku 'custom-loads '("gomoku")) -(put 'tools 'custom-loads '("add-log" "calculator" "compare-w" "diff-mode" "diff" "ediff" "elide-head" "emerge" "gud" "pcvs-defs" "smerge-mode" "speedbar" "tempo" "tooltip" "vc" "which-func" "copyright" "compile" "etags" "glasses" "make-mode" "rcompile")) +(put 'tools 'custom-loads '("add-log" "calculator" "compare-w" "diff-mode" "diff" "ediff" "elide-head" "emerge" "gud" "pcvs-defs" "smerge-mode" "speedbar" "tempo" "tooltip" "vc" "which-func" "copyright" "compile" "ebrowse" "etags" "glasses" "make-mode" "rcompile")) (put 'gnus-topic 'custom-loads '("gnus-topic")) (put 'sgml 'custom-loads '("sgml-mode")) (put 'keyboard 'custom-loads '("simple" "chistory" "type-break")) @@ -278,6 +280,7 @@ (put 'rmail-summary 'custom-loads '("rmail" "rmailsum")) (put 'metamail 'custom-loads '("metamail")) (put 'winner 'custom-loads '("winner")) +(put 'ebrowse-faces 'custom-loads '("ebrowse")) (put 'wp 'custom-loads '("cus-edit" "enriched" "lpr" "ps-print" "view" "ebnf2ps" "bib-mode" "nroff-mode" "refbib" "refer" "scribe" "tildify")) (put 'reftex-citation-support 'custom-loads '("reftex-vars")) (put 'gnus-summary-choose 'custom-loads '("gnus-sum")) @@ -385,6 +388,7 @@ (put 'ebnf-repeat 'custom-loads '("ebnf2ps")) (put 'supercite 'custom-loads '("supercite")) (put 'font-selection 'custom-loads '("faces")) +(put 'ps-print-headers 'custom-loads '("ps-print")) (put 'gnus-summary-marks 'custom-loads '("gnus-sum" "gnus")) (put 'bibtex-autokey 'custom-loads '("bibtex")) (put 'eudc 'custom-loads '("eudc-vars")) @@ -409,6 +413,7 @@ (put 'fill-comments 'custom-loads '("simple")) (put 'gnus-summary-various 'custom-loads '("gnus-sum")) (put 'applications 'custom-loads '("calendar" "cus-edit" "uniquify" "spell")) +(put 'ebrowse-member 'custom-loads '("ebrowse")) (put 'terminal 'custom-loads '("terminal")) (put 'shadow 'custom-loads '("shadowfile" "shadow")) (put 'hl-line 'custom-loads '("hl-line")) @@ -439,7 +444,7 @@ (put 'hanoi 'custom-loads '("hanoi")) (put 'reftex-index-support 'custom-loads '("reftex-vars")) (put 'pascal 'custom-loads '("pascal")) -(put 'rmail-retrieve 'custom-loads '("rmail")) +(put 'rmail-retrieve 'custom-loads '("rmail" "rmailsum")) (put 'data 'custom-loads '("text-mode" "arc-mode" "forms" "hexl" "jka-compr" "saveplace" "sort" "tar-mode" "time-stamp" "snmp-mode")) (put 'mail 'custom-loads '("simple" "startup" "time" "gnus" "message" "emacsbug" "feedmail" "mail-extr" "mail-hist" "mail-utils" "mailalias" "metamail" "mh-e" "mspools" "rmail" "sendmail" "smtpmail" "supercite" "uce" "fortune" "eudc-vars")) (put 'paren-blinking 'custom-loads '("simple")) @@ -451,9 +456,9 @@ (put 'dired 'custom-loads '("files" "dired-aux" "dired-x" "dired" "find-dired")) (put 'recentf 'custom-loads '("recentf")) (put 'fill 'custom-loads '("simple" "fill" "align")) -(put 'ps-print-header 'custom-loads '("ps-print")) (put 'outlines 'custom-loads '("allout" "outline")) (put 'paragraphs 'custom-loads '("paragraphs")) +(put 'ebrowse 'custom-loads '("ebrowse")) (put 'nnmail-split 'custom-loads '("nnmail")) (put 'makefile 'custom-loads '("make-mode")) (put 'supercite-attr 'custom-loads '("supercite")) @@ -502,12 +507,11 @@ (put 'ps-print-zebra 'custom-loads '("ps-print")) (put 'hideshow 'custom-loads '("hideshow")) (put 'viper-search 'custom-loads '("viper-init")) -(put 'C 'custom-loads '("cpp")) (put 'mule 'custom-loads '("mule-cmds")) (put 'glasses 'custom-loads '("glasses")) (put 'vhdl-style 'custom-loads '("vhdl-mode")) (put 'tempo 'custom-loads '("tempo")) -(put 'c 'custom-loads '("tooltip" "cc-vars" "cmacexp" "hideif")) +(put 'c 'custom-loads '("tooltip" "cc-vars" "cmacexp" "cpp" "hideif")) (put 'nnmail-prepare 'custom-loads '("nnmail")) (put 'processes 'custom-loads '("comint" "cus-edit" "shell" "term" "metamail" "compile" "executable" "sql" "flyspell" "rcompile" "rlogin")) (put 'ebnf2ps 'custom-loads '("ebnf2ps")) @@ -693,6 +697,8 @@ (custom-put-if-not 'border 'group-documentation nil) (custom-put-if-not 'hl-line 'custom-version "21.1") (custom-put-if-not 'hl-line 'group-documentation "Highliight the current line.") +(custom-put-if-not 'find-file-wildcards 'custom-version "20.4") +(custom-put-if-not 'find-file-wildcards 'standard-value t) (custom-put-if-not 'custom-comment-face 'custom-version "21.1") (custom-put-if-not 'custom-comment-face 'group-documentation nil) (custom-put-if-not 'custom-raised-buttons 'custom-version "21.1") @@ -727,6 +733,8 @@ (custom-put-if-not 'hscroll-global-mode 'standard-value t) (custom-put-if-not 'tags-apropos-verbose 'custom-version "21.1") (custom-put-if-not 'tags-apropos-verbose 'standard-value t) +(custom-put-if-not 'dabbrev-ignored-regexps 'custom-version "21.1") +(custom-put-if-not 'dabbrev-ignored-regexps 'standard-value t) (custom-put-if-not 'find-variable-regexp 'custom-version "20.3") (custom-put-if-not 'find-variable-regexp 'standard-value t) (custom-put-if-not 'header-line 'custom-version "21.1") @@ -744,7 +752,7 @@ (custom-put-if-not 'eval-expression-print-level 'custom-version "21.1") (custom-put-if-not 'eval-expression-print-level 'standard-value t) -(defvar custom-versions-load-alist '(("20.3.3" "dos-vars") (21.1 "ange-ftp") ("20.4" "sh-script" "help" "compile") ("21.1" "debug" "paths" "sgml-mode" "fortran" "etags" "cus-edit" "add-log" "find-func" "simple") ("20.3" "desktop" "easymenu" "hscroll" "dabbrev" "ffap" "rmail" "paren" "mailabbrev" "frame" "uce" "mouse" "diary-lib" "sendmail" "debug" "hexl" "vcursor" "vc" "compile" "etags" "help" "browse-url" "add-log" "find-func" "vc-hooks" "cus-edit" "replace")) +(defvar custom-versions-load-alist '(("20.3.3" "dos-vars") (21.1 "ange-ftp") ("20.4" "files" "sh-script" "help" "compile") ("21.1" "debug" "dabbrev" "paths" "sgml-mode" "fortran" "etags" "cus-edit" "add-log" "find-func" "simple") ("20.3" "desktop" "easymenu" "hscroll" "dabbrev" "ffap" "rmail" "paren" "mailabbrev" "frame" "uce" "mouse" "diary-lib" "sendmail" "debug" "hexl" "vcursor" "vc" "compile" "etags" "help" "browse-url" "add-log" "find-func" "vc-hooks" "cus-edit" "replace")) "For internal use by custom.") (provide 'cus-load) diff --git a/lisp/loaddefs.el b/lisp/loaddefs.el index 20127ec416c..a78d0906866 100644 --- a/lisp/loaddefs.el +++ b/lisp/loaddefs.el @@ -119,7 +119,7 @@ Insert a descriptive header at the top of the file." t nil) ;;;### (autoloads (change-log-merge add-log-current-defun change-log-mode ;;;;;; add-change-log-entry-other-window add-change-log-entry find-change-log ;;;;;; prompt-for-change-log-name add-log-mailing-address add-log-full-name) -;;;;;; "add-log" "add-log.el" (14525 5303)) +;;;;;; "add-log" "add-log.el" (14565 55609)) ;;; Generated autoloads from add-log.el (defvar add-log-full-name nil "\ @@ -192,11 +192,11 @@ Runs `change-log-mode-hook'." t nil) Return name of function definition point is in, or nil. Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...), -Texinfo (@node titles), Perl, and Fortran. +Texinfo (@node titles) and Perl. Other modes are handled by a heuristic that looks in the 10K before point for uppercase headings starting in the first column or -identifiers followed by `:' or `=', see variables +identifiers followed by `:' or `='. See variables `add-log-current-defun-header-regexp' and `add-log-current-defun-function' @@ -417,7 +417,7 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'." nil nil) ;;;### (autoloads (appt-make-list appt-delete appt-add appt-display-diary ;;;;;; appt-display-duration appt-msg-window appt-display-mode-line ;;;;;; appt-visible appt-audible appt-message-warning-time appt-issue-message) -;;;;;; "appt" "calendar/appt.el" (14517 9487)) +;;;;;; "appt" "calendar/appt.el" (14563 8413)) ;;; Generated autoloads from calendar/appt.el (defvar appt-issue-message t "\ @@ -448,13 +448,23 @@ as the first thing on a line.") This will occur at midnight when the appointment list is updated.") (autoload (quote appt-add) "appt" "\ -Add an appointment for the day at TIME and issue MESSAGE. +Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG. The time should be in either 24 hour format or am/pm format." t nil) (autoload (quote appt-delete) "appt" "\ Delete an appointment from the list of appointments." t nil) -(autoload (quote appt-make-list) "appt" nil nil nil) +(autoload (quote appt-make-list) "appt" "\ +Create the appointments list from todays diary buffer. +The time must be at the beginning of a line for it to be +put in the appointments list. + 02/23/89 + 12:00pm lunch + Wednesday + 10:00am group meeting +We assume that the variables DATE and NUMBER +hold the arguments that `list-diary-entries' received. +They specify the range of dates that the diary is being processed for." nil nil) ;;;*** @@ -665,7 +675,7 @@ insert a template for the file depending on the mode of the buffer." t nil) ;;;### (autoloads (batch-update-autoloads update-autoloads-from-directories ;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el" -;;;;;; (14398 37513)) +;;;;;; (14563 8438)) ;;; Generated autoloads from emacs-lisp/autoload.el (autoload (quote update-file-autoloads) "autoload" "\ @@ -1310,7 +1320,7 @@ corresponding bookmark function from Lisp (the one without the ;;;;;; browse-url-of-buffer browse-url-of-file browse-url-generic-program ;;;;;; browse-url-save-file browse-url-netscape-display browse-url-new-window-p ;;;;;; browse-url-browser-function) "browse-url" "net/browse-url.el" -;;;;;; (14554 2050)) +;;;;;; (14558 23455)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function (if (eq system-type (quote windows-nt)) (quote browse-url-default-windows-browser) (quote browse-url-netscape)) "\ @@ -1546,7 +1556,7 @@ name of buffer configuration." t nil) ;;;### (autoloads (batch-byte-recompile-directory batch-byte-compile ;;;;;; display-call-tree byte-compile compile-defun byte-compile-file ;;;;;; byte-recompile-directory byte-force-recompile) "bytecomp" -;;;;;; "emacs-lisp/bytecomp.el" (14547 29523)) +;;;;;; "emacs-lisp/bytecomp.el" (14564 35790)) ;;; Generated autoloads from emacs-lisp/bytecomp.el (autoload (quote byte-force-recompile) "bytecomp" "\ @@ -2718,7 +2728,7 @@ If `compare-ignore-case' is non-nil, changes in case are also ignored." t nil) ;;;### (autoloads (next-error compilation-minor-mode compilation-shell-minor-mode ;;;;;; compilation-mode grep-find grep compile compilation-search-path ;;;;;; compilation-ask-about-save compilation-window-height compilation-mode-hook) -;;;;;; "compile" "progmodes/compile.el" (14440 46010)) +;;;;;; "compile" "progmodes/compile.el" (14569 2479)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -3289,7 +3299,7 @@ or as help on variables `cperl-tips', `cperl-problems', ;;;*** ;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el" -;;;;;; (13826 9529)) +;;;;;; (14568 36509)) ;;; Generated autoloads from progmodes/cpp.el (autoload (quote cpp-highlight-buffer) "cpp" "\ @@ -3333,7 +3343,7 @@ With ARG, turn CRiSP mode on if ARG is positive, off otherwise." t nil) ;;;;;; customize-option-other-window customize-changed-options customize-option ;;;;;; customize-group-other-window customize-group customize customize-save-variable ;;;;;; customize-set-variable customize-set-value) "cus-edit" "cus-edit.el" -;;;;;; (14552 48684)) +;;;;;; (14558 7062)) ;;; Generated autoloads from cus-edit.el (add-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'") @@ -3582,7 +3592,7 @@ If the argument is nil, we return the display table to its standard state." t ni ;;;*** ;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el" -;;;;;; (14385 24830)) +;;;;;; (14568 46430)) ;;; Generated autoloads from dabbrev.el (define-key esc-map "/" (quote dabbrev-expand)) @@ -4066,7 +4076,7 @@ Minor mode for viewing/editing context diffs. ;;;;;; dired dired-copy-preserve-time dired-dwim-target dired-keep-marker-symlink ;;;;;; dired-keep-marker-hardlink dired-keep-marker-copy dired-keep-marker-rename ;;;;;; dired-trivial-filenames dired-ls-F-marks-symlinks dired-listing-switches) -;;;;;; "dired" "dired.el" (14522 27392)) +;;;;;; "dired" "dired.el" (14563 8348)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches "-al" "\ @@ -4625,8 +4635,8 @@ been generated automatically, with a reference to the keymap." nil (quote macro) ;;;*** ;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define -;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (14385 -;;;;;; 24854)) +;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (14574 +;;;;;; 18612)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload (quote easy-menu-define) "easymenu" "\ @@ -4717,6 +4727,10 @@ anything else means an ordinary menu item. SELECTED is an expression; the checkbox or radio button is selected whenever this expression's value is non-nil. + :help HELP + +HELP is a string, the help to display for the menu item. + A menu item can be a string. Then that string appears in the menu as unselectable text. A string consisting solely of hyphens is displayed as a solid horizontal line. @@ -4860,6 +4874,43 @@ It returns the old style symbol." t nil) ;;;*** +;;;### (autoloads (ebrowse-save-tree-as ebrowse-tags-query-replace +;;;;;; ebrowse-tags-loop-continue ebrowse-tags-complete-symbol ebrowse-electric-choose-tree +;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (14575 +;;;;;; 54558)) +;;; Generated autoloads from progmodes/ebrowse.el + +(autoload (quote ebrowse-tree-mode) "ebrowse" "\ +Major mode for Ebrowse class tree buffers. +Each line corresponds to a class in a class tree. +Letters do not insert themselves, they are commands. +File operations in the tree buffer work on class tree data structures. +E.g.\\[save-buffer] writes the tree to the file it was loaded from. + +Tree mode key bindings: +\\{ebrowse-tree-mode-map}" nil nil) + +(autoload (quote ebrowse-electric-choose-tree) "ebrowse" "\ +Return a buffer containing a tree or nil if no tree found or canceled." t nil) + +(autoload (quote ebrowse-tags-complete-symbol) "ebrowse" "Perform completion on the C++ symbol preceding point.\nA second call of this function without changing point inserts the next match. \nA call with prefix PREFIX reads the symbol to insert from the minibuffer with\ncompletion." t nil) + +(autoload (quote ebrowse-tags-loop-continue) "ebrowse" "\ +Repeat last operation on files in tree. +FIRST-TIME non-nil means this is not a repetition, but the first time. +TREE-BUFFER if indirectly specifies which files to loop over." t nil) + +(autoload (quote ebrowse-tags-query-replace) "ebrowse" "\ +Query replace FROM with TO in all files of a class tree. +With prefix arg, process files of marked classes only." t nil) + +(autoload (quote ebrowse-save-tree-as) "ebrowse" "\ +Write the current tree data structure to a file. +Read the file name from the minibuffer if interactive. +Otherwise, FILE-NAME specifies the file to save the tree in." t nil) + +;;;*** + ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el" ;;;;;; (13778 5499)) ;;; Generated autoloads from ebuff-menu.el @@ -4894,7 +4945,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing." t nil) ;;;*** ;;;### (autoloads (edebug-eval-top-level-form def-edebug-spec edebug-all-forms -;;;;;; edebug-all-defs) "edebug" "emacs-lisp/edebug.el" (14482 54435)) +;;;;;; edebug-all-defs) "edebug" "emacs-lisp/edebug.el" (14576 25687)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -6957,7 +7008,7 @@ Some generic modes are defined in `generic-x.el'." t nil) ;;;*** ;;;### (autoloads (glasses-mode) "glasses" "progmodes/glasses.el" -;;;;;; (14480 59906)) +;;;;;; (14568 44804)) ;;; Generated autoloads from progmodes/glasses.el (autoload (quote glasses-mode) "glasses" "\ @@ -8350,9 +8401,9 @@ and a negative argument disables it." t nil) ;;;*** ;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only -;;;;;; iso-iso2duden iso-iso2gtex iso-gtex2iso iso-tex2iso iso-iso2tex -;;;;;; iso-german iso-spanish) "iso-cvt" "international/iso-cvt.el" -;;;;;; (13768 42838)) +;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso +;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt" +;;;;;; "international/iso-cvt.el" (14564 29908)) ;;; Generated autoloads from international/iso-cvt.el (autoload (quote iso-spanish) "iso-cvt" "\ @@ -8397,6 +8448,18 @@ The region between FROM and TO is translated using the table TRANS-TAB. Optional arg BUFFER is ignored (so that the function can can be used in `format-alist')." t nil) +(autoload (quote iso-iso2sgml) "iso-cvt" "\ +Translate ISO 8859-1 characters in the region to SGML entities. +The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". +Optional arg BUFFER is ignored (so that the function can can be used in +`format-alist')." t nil) + +(autoload (quote iso-sgml2iso) "iso-cvt" "\ +Translate SGML entities in the region to ISO 8859-1 characters. +The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". +Optional arg BUFFER is ignored (so that the function can can be used in +`format-alist')." t nil) + (autoload (quote iso-cvt-read-only) "iso-cvt" "\ Warn that format is read-only." t nil) @@ -8765,7 +8828,7 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading." nil ;;;*** ;;;### (autoloads (turn-on-jit-lock jit-lock-mode) "jit-lock" "jit-lock.el" -;;;;;; (14550 5866)) +;;;;;; (14571 7073)) ;;; Generated autoloads from jit-lock.el (autoload (quote jit-lock-mode) "jit-lock" "\ @@ -8806,7 +8869,7 @@ Unconditionally turn on Just-in-time Lock mode." nil nil) ;;;*** ;;;### (autoloads (auto-compression-mode) "jka-compr" "jka-compr.el" -;;;;;; (14495 17985)) +;;;;;; (14568 39747)) ;;; Generated autoloads from jka-compr.el (defvar auto-compression-mode nil "\ @@ -9057,7 +9120,7 @@ is nil, raise an error." t nil) ;;;*** ;;;### (autoloads (locate-with-filter locate) "locate" "locate.el" -;;;;;; (14396 4034)) +;;;;;; (14563 8348)) ;;; Generated autoloads from locate.el (autoload (quote locate) "locate" "\ @@ -9072,7 +9135,7 @@ shown; this is often useful to constrain a big search." t nil) ;;;*** -;;;### (autoloads (log-edit) "log-edit" "log-edit.el" (14537 49316)) +;;;### (autoloads (log-edit) "log-edit" "log-edit.el" (14559 17354)) ;;; Generated autoloads from log-edit.el (autoload (quote log-edit) "log-edit" "\ @@ -9096,8 +9159,8 @@ Major mode for browsing CVS log output." t nil) ;;;*** ;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer -;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (14440 -;;;;;; 46009)) +;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (14563 +;;;;;; 22518)) ;;; Generated autoloads from lpr.el (defvar printer-name (if (memq system-type (quote (ms-dos windows-nt))) "PRN") "\ @@ -9428,7 +9491,7 @@ current header, calls `mail-complete-function' and passes prefix arg if any." t ;;;*** ;;;### (autoloads (makefile-mode) "make-mode" "progmodes/make-mode.el" -;;;;;; (14554 2005)) +;;;;;; (14570 19448)) ;;; Generated autoloads from progmodes/make-mode.el (autoload (quote makefile-mode) "make-mode" "\ @@ -9517,7 +9580,7 @@ Previous contents of that buffer are killed first." t nil) ;;;*** -;;;### (autoloads (man-follow man) "man" "man.el" (14539 53667)) +;;;### (autoloads (man-follow man) "man" "man.el" (14570 21850)) ;;; Generated autoloads from man.el (defalias (quote manual-entry) (quote man)) @@ -9955,7 +10018,7 @@ Multiplication puzzle with GNU Emacs." t nil) ;;;*** -;;;### (autoloads (msb-mode msb-mode) "msb" "msb.el" (14263 63030)) +;;;### (autoloads (msb-mode msb-mode) "msb" "msb.el" (14555 52300)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ @@ -10111,16 +10174,18 @@ The file is saved in the directory `data-directory'." nil nil) ;;;;;; coding-system-post-read-conversion coding-system-eol-type-mnemonic ;;;;;; lookup-nested-alist set-nested-alist truncate-string-to-width ;;;;;; store-substring string-to-sequence) "mule-util" "international/mule-util.el" -;;;;;; (14423 50997)) +;;;;;; (14568 36382)) ;;; Generated autoloads from international/mule-util.el (autoload (quote string-to-sequence) "mule-util" "\ Convert STRING to a sequence of TYPE which contains characters in STRING. TYPE should be `list' or `vector'." nil nil) -(defsubst string-to-list (string) "Return a list of characters in STRING." (string-to-sequence string (quote list))) +(defsubst string-to-list (string) "\ +Return a list of characters in STRING." (string-to-sequence string (quote list))) -(defsubst string-to-vector (string) "Return a vector of characters in STRING." (string-to-sequence string (quote vector))) +(defsubst string-to-vector (string) "\ +Return a vector of characters in STRING." (string-to-sequence string (quote vector))) (autoload (quote store-substring) "mule-util" "\ Embed OBJ (string or character) at index IDX of STRING." nil nil) @@ -10142,7 +10207,16 @@ the resulting string may be narrower than END-COLUMN." nil nil) (defalias (quote truncate-string) (quote truncate-string-to-width)) -(defsubst nested-alist-p (obj) "Return t if OBJ is a nested alist.\n\nNested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is\nany Lisp object, and BRANCHES is a list of cons cells of the form\n(KEY-ELEMENT . NESTED-ALIST).\n\nYou can use a nested alist to store any Lisp object (ENTRY) for a key\nsequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ\ncan be a string, a vector, or a list." (and obj (listp obj) (listp (cdr obj)))) +(defsubst nested-alist-p (obj) "\ +Return t if OBJ is a nested alist. + +Nested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is +any Lisp object, and BRANCHES is a list of cons cells of the form +\(KEY-ELEMENT . NESTED-ALIST). + +You can use a nested alist to store any Lisp object (ENTRY) for a key +sequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ +can be a string, a vector, or a list." (and obj (listp obj) (listp (cdr obj)))) (autoload (quote set-nested-alist) "mule-util" "\ Set ENTRY for KEYSEQ in a nested alist ALIST. @@ -10207,7 +10281,7 @@ Enable mouse wheel support." nil nil) ;;;### (autoloads (network-connection network-connection-to-service ;;;;;; whois-reverse-lookup whois finger ftp dig nslookup nslookup-host ;;;;;; route arp netstat ipconfig ping traceroute) "net-utils" "net/net-utils.el" -;;;;;; (14385 24830)) +;;;;;; (14564 29931)) ;;; Generated autoloads from net/net-utils.el (autoload (quote traceroute) "net-utils" "\ @@ -11097,7 +11171,7 @@ This checks if all multi-byte characters in the region are printable or not." ni ;;;;;; ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ;;;;;; ps-print-buffer ps-print-customize ps-paper-type) "ps-print" -;;;;;; "ps-print.el" (14554 7425)) +;;;;;; "ps-print.el" (14563 18761)) ;;; Generated autoloads from ps-print.el (defvar ps-paper-type (quote letter) "\ @@ -11679,7 +11753,7 @@ Here are all local bindings. ;;;*** ;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "emacs-lisp/regexp-opt.el" -;;;;;; (14535 45202)) +;;;;;; (14564 29908)) ;;; Generated autoloads from emacs-lisp/regexp-opt.el (autoload (quote regexp-opt) "regexp-opt" "\ @@ -12157,11 +12231,11 @@ KEYWORDS is a comma-separated list of labels." t nil) ;;;*** -;;;### (autoloads (rmail-summary-line-decoder rmail-summary-by-senders -;;;;;; rmail-summary-by-topic rmail-summary-by-regexp rmail-summary-by-recipients -;;;;;; rmail-summary-by-labels rmail-summary rmail-summary-line-count-flag -;;;;;; rmail-summary-scroll-between-messages) "rmailsum" "mail/rmailsum.el" -;;;;;; (14547 28270)) +;;;### (autoloads (rmail-user-mail-address-regexp rmail-summary-line-decoder +;;;;;; rmail-summary-by-senders rmail-summary-by-topic rmail-summary-by-regexp +;;;;;; rmail-summary-by-recipients rmail-summary-by-labels rmail-summary +;;;;;; rmail-summary-line-count-flag rmail-summary-scroll-between-messages) +;;;;;; "rmailsum" "mail/rmailsum.el" (14568 47126)) ;;; Generated autoloads from mail/rmailsum.el (defvar rmail-summary-scroll-between-messages t "\ @@ -12206,6 +12280,20 @@ SENDERS is a string of names separated by commas." t nil) By default, `identity' is set.") +(defvar rmail-user-mail-address-regexp nil "\ +*Regexp matching user mail addresses. +If non-nil, this variable is used to identify the correspondent +when receiving new mail. If it matches the address of the sender, +the recipient is taken as correspondent of a mail. +If nil (default value), your `user-login-name' and `user-mail-address' +are used to exclude yourself as correspondent. + +Usually you don't have to set this variable, except if you collect mails +sent by you under different user names. +Then it should be a regexp matching your mail adresses. + +Setting this variable has an effect only before reading a mail.") + ;;;*** ;;;### (autoloads (news-post-news) "rnewspost" "mail/rnewspost.el" @@ -13450,7 +13538,7 @@ strokes with ;;;*** ;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el" -;;;;;; (14385 23097)) +;;;;;; (14565 55801)) ;;; Generated autoloads from mail/supercite.el (autoload (quote sc-cite-original) "supercite" "\ @@ -14160,7 +14248,7 @@ a symbol as a valid THING." nil nil) ;;;;;; tibetan-compose-buffer tibetan-decompose-buffer tibetan-composition-function ;;;;;; tibetan-compose-region tibetan-compose-string tibetan-transcription-to-tibetan ;;;;;; tibetan-tibetan-to-transcription tibetan-char-p setup-tibetan-environment) -;;;;;; "tibet-util" "language/tibet-util.el" (14423 51008)) +;;;;;; "tibet-util" "language/tibet-util.el" (14568 36412)) ;;; Generated autoloads from language/tibet-util.el (autoload (quote setup-tibetan-environment) "tibet-util" nil t nil) @@ -14747,8 +14835,8 @@ The buffer in question is current when this function is called." nil nil) ;;;;;; vc-create-snapshot vc-directory vc-resolve-conflicts vc-merge ;;;;;; vc-insert-headers vc-version-other-window vc-diff vc-register ;;;;;; vc-next-action edit-vc-file with-vc-file vc-annotate-mode-hook -;;;;;; vc-before-checkin-hook vc-checkin-hook) "vc" "vc.el" (14478 -;;;;;; 52465)) +;;;;;; vc-before-checkin-hook vc-checkin-hook) "vc" "vc.el" (14565 +;;;;;; 59735)) ;;; Generated autoloads from vc.el (defvar vc-checkin-hook nil "\ diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el new file mode 100644 index 00000000000..0bacb36da4a --- /dev/null +++ b/lisp/progmodes/ebrowse.el @@ -0,0 +1,4573 @@ +;;; ebrowse.el --- Emacs C++ class browser & tags facility + +;; Copyright (C) 1992-1999, 2000 Free Software Foundation Inc. + +;; Author: Gerd Moellmann <gerd@gnu.org> +;; Maintainer: FSF +;; Keywords: C++ tags tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; This package implements + +;; - A class browser for C++ +;; - A complete set of tags-like functions working on class trees +;; - An electric buffer list showing class browser buffers only + +;; Documentation is found in a separate Info file. + +;;; Code: + +(require 'easymenu) +(require 'view) +(require 'ebuff-menu) + +(eval-when-compile + (require 'cl) + (require 'helper)) + + +;;; User-options + +(defgroup ebrowse nil + "Settings for the C++ class browser." + :group 'tools) + + +(defcustom ebrowse-search-path nil + "*List of directories to search for source files in a class tree. +Elements should be directory names; nil as an element means to try +to find source files relative to the location of the EBROWSE file loaded." + :group 'ebrowse + :type '(repeat (choice (const :tag "Default" nil) + (string :tag "Directory")))) + + +(defcustom ebrowse-view/find-hook nil + "*Hooks run after finding or viewing a member or class." + :group 'ebrowse + :type 'hook) + + +(defcustom ebrowse-not-found-hook nil + "*Hooks run when finding or viewing a member or class was not successful." + :group 'ebrowse + :type 'hook) + + +(defcustom ebrowse-electric-list-mode-hook nil + "*Hook called by `ebrowse-electric-position-mode'." + :group 'ebrowse + :type 'hook) + + +(defcustom ebrowse-max-positions 50 + "*Number of markers saved on electric position stack." + :group 'ebrowse + :type 'integer) + + + +(defgroup ebrowse-tree nil + "Settings for class tree buffers." + :group 'ebrowse) + + +(defcustom ebrowse-tree-mode-hook nil + "*Hook run in each new tree buffer." + :group 'ebrowse-tree + :type 'hook) + + +(defcustom ebrowse-tree-buffer-name "*Tree*" + "*The default name of class tree buffers." + :group 'ebrowse-tree + :type 'string) + + +(defcustom ebrowse--indentation 4 + "*The amount by which subclasses are indented in the tree." + :group 'ebrowse-tree + :type 'integer) + + +(defcustom ebrowse-source-file-column 40 + "*The column in which source file names are displayed in the tree." + :group 'ebrowse-tree + :type 'integer) + + +(defcustom ebrowse-tree-left-margin 2 + "*Amount of space left at the left side of the tree display. +This space is used to display markers." + :group 'ebrowse-tree + :type 'integer) + + + +(defgroup ebrowse-member nil + "Settings for member buffers." + :group 'ebrowse) + + +(defcustom ebrowse-default-declaration-column 25 + "*The column in which member declarations are displayed in member buffers." + :group 'ebrowse-member + :type 'integer) + + +(defcustom ebrowse-default-column-width 25 + "*The width of the columns in member buffers (short display form)." + :group 'ebrowse-member + :type 'integer) + + +(defcustom ebrowse-member-buffer-name "*Members*" + "*The name of the buffer for member display." + :group 'ebrowse-member + :type 'string) + + +(defcustom ebrowse-member-mode-hook nil + "*Run in each new member buffer." + :group 'ebrowse-member + :type 'hook) + + + +(defgroup ebrowse-faces nil + "Faces used by Ebrowse." + :group 'ebrowse) + + +(defface ebrowse-tree-mark-face + '((t (:foreground "red"))) + "*The face used for the mark character in the tree." + :group 'ebrowse-faces) + + +(defface ebrowse-root-class-face + '((t (:weight bold :foreground "blue"))) + "*The face used for root classes in the tree." + :group 'ebrowse-faces) + + +(defface ebrowse-file-name-face + '((t (:italic t))) + "*The face for filenames displayed in the tree." + :group 'ebrowse-faces) + + +(defface ebrowse-default-face + '((t nil)) + "*Face for everything else in the tree not having other faces." + :group 'ebrowse-faces) + + +(defface ebrowse-member-attribute-face + '((t (:foreground "red"))) + "*Face used to display member attributes." + :group 'ebrowse-faces) + + +(defface ebrowse-member-class-face + '((t (:foreground "purple"))) + "*Face used to display the class title in member buffers." + :group 'ebrowse-faces) + + +(defface ebrowse-progress-face + '((t (:background "blue"))) + "*Face for progress indicator." + :group 'ebrowse-faces) + + + +;;; Utilities. + +(defun ebrowse-some (predicate vector) + "Return true if PREDICATE is true of some element of VECTOR. +If so, return the value returned by PREDICATE." + (let ((length (length vector)) + (i 0) + result) + (while (and (< i length) (not result)) + (setq result (funcall predicate (aref vector i)) + i (1+ i))) + result)) + + +(defun ebrowse-every (predicate vector) + "Return true if PREDICATE is true of every element of VECTOR." + (let ((length (length vector)) + (i 0) + (result t)) + (while (and (< i length) result) + (setq result (funcall predicate (aref vector i)) + i (1+ i))) + result)) + + +(defun ebrowse-position (item list &optional test) + "Return the position of ITEM in LIST or nil if not found. +Compare items with `eq' or TEST if specified." + (let ((i 0) found) + (cond (test + (while list + (when (funcall test item (car list)) + (setq found i list nil)) + (setq list (cdr list) i (1+ i)))) + (t + (while list + (when (eq item (car list)) + (setq found i list nil)) + (setq list (cdr list) i (1+ i))))) + found)) + + +(defun ebrowse-delete-if-not (predicate list) + "Remove elements not satisfying PREDICATE from LIST and return the result. +This is a destructive operation." + (let (result) + (while list + (let ((next (cdr list))) + (when (funcall predicate (car list)) + (setq result (nconc result list)) + (setf (cdr list) nil)) + (setq list next))) + result)) + + +(defun ebrowse-copy-list (list) + "Return a shallow copy of LIST." + (apply #'list list)) + + +(defmacro ebrowse-output (&rest body) + "Eval BODY with a writable current buffer. +Preserve buffer's modified state." + (let ((modified (gensym "--ebrowse-output--"))) + `(let (buffer-read-only (,modified (buffer-modified-p))) + (unwind-protect + (progn ,@body) + (set-buffer-modified-p ,modified))))) + + +(defmacro ebrowse-ignoring-completion-case (&rest body) + "Eval BODY with `completion-ignore-case' bound to t." + `(let ((completion-ignore-case t)) + ,@body)) + + +(defmacro ebrowse-save-selective (&rest body) + "Eval BODY with `selective-display' restored at the end." + (let ((var (make-symbol "var"))) + `(let ((,var selective-display)) + (unwind-protect + (progn ,@body) + (setq selective-display ,var))))) + + +(defmacro ebrowse-for-all-trees (spec &rest body) + "For all trees in SPEC, eval BODY." + (let ((var (make-symbol "var")) + (spec-var (car spec)) + (array (cadr spec))) + `(loop for ,var being the symbols of ,array + as ,spec-var = (get ,var 'ebrowse-root) do + (when (vectorp ,spec-var) + ,@body)))) + +;;; Set indentation for macros above. + +(put 'ebrowse-output 'lisp-indent-hook 0) +(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0) +(put 'ebrowse-save-selective 'lisp-indent-hook 0) +(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) + + +(defsubst ebrowse-set-face (start end face) + "Set face of a region START END to FACE." + (overlay-put (make-overlay start end) 'face face)) + + +(defun ebrowse-completing-read-value (prompt table initial-input) + "Read a string in the minibuffer, with completion. +Case is ignored in completions. + +PROMPT is a string to prompt with; normally it ends in a colon and a space. +TABLE is an alist whose elements' cars are strings, or an obarray. +TABLE can also be a function to do the completion itself. +If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. +If it is (STRING . POSITION), the initial input +is STRING, but point is placed POSITION characters into the string." + (ebrowse-ignoring-completion-case + (completing-read prompt table nil t initial-input))) + + +(defun ebrowse-value-in-buffer (sym buffer) + "Return the value of SYM in BUFFER." + (let ((old-buffer (current-buffer))) + (unwind-protect + (progn + (set-buffer buffer) + (symbol-value sym)) + (set-buffer old-buffer)))) + + +(defun ebrowse-rename-buffer (new-name) + "Rename current buffer to NEW-NAME. +If a buffer with name NEW-NAME already exists, delete it first." + (let ((old-buffer (get-buffer new-name))) + (unless (eq old-buffer (current-buffer)) + (when old-buffer + (save-excursion (kill-buffer old-buffer))) + (rename-buffer new-name)))) + + +(defun ebrowse-trim-string (string) + "Return a copy of STRING with leading white space removed. +Replace sequences of newlines with a single space." + (when (string-match "^[ \t\n\r]+" string) + (setq string (substring string (match-end 0)))) + (loop while (string-match "[\n]+" string) + finally return string do + (setq string (replace-match " " nil t string)))) + + +(defun ebrowse-width-of-drawable-area () + "Return the width of the display area for the current buffer. +If buffer is displayed in a window, use that window's width, +otherwise use the current frame's width." + (let ((window (get-buffer-window (current-buffer)))) + (if window + (window-width window) + (frame-width)))) + + +;;; Structure definitions + +(defstruct (ebrowse-hs (:type vector) :named) + "Header structure found at the head of EBROWSE files." + ;; A version string that is compared against the version number of + ;; the Lisp package when the file is loaded. This is done to + ;; detect file format changes. + version + ;; Command line options used for producing the EBROWSE file. + command-line-options + ;; The following slot is currently not used. It's kept to keep + ;; the file format compatible. + unused + ;; A slot that is filled out after the tree is loaded. This slot is + ;; set to a hash table mapping members to lists of classes in which + ;; they are defined. + member-table) + + +(defstruct (ebrowse-ts (:type vector) :named) + "Tree structure. +Following the header structure, an EBROWSE file contains a number +of `ebrowse-ts' structures, each one describing one root class of +the class hierarchy with all its subclasses." + ;; A `ebrowse-cs' structure describing the root class. + class + ;; A list of `ebrowse-ts' structures for all subclasses. + subclasses + ;; Lists of `ebrowse-ms' structures for each member in a group of + ;; members. + member-variables member-functions static-variables static-functions + friends types + ;; List of `ebrowse-ts' structures for base classes. This slot is + ;; filled at load time. + base-classes + ;; A marker slot used in the tree buffer (can be saved back to disk. + mark) + + +(defstruct (ebrowse-bs (:type vector) :named) + "Common sub-structure. +A common structure defining an occurrence of some name in the +source files." + ;; The class or member name as a string constant + name + ;; An optional string for the scope of nested classes or for + ;; namespaces. + scope + ;; Various flags describing properties of classes/members, e.g. is + ;; template, is const etc. + flags + ;; File in which the entity is found. If this is part of a + ;; `ebrowse-ms' member description structure, and FILE is nil, then + ;; search for the name in the SOURCE-FILE of the members class. + file + ;; Regular expression to search for. This slot can be a number in + ;; which case the number is the file position at which the regular + ;; expression is found in a separate regexp file (see the header + ;; structure). This slot can be nil in which case the regular + ;; expression will be generated from the class/member name. + pattern + ;; The buffer position at which the search for the class or member + ;; will start. + point) + + +(defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named) + "Class structure. +This is the structure stored in the CLASS slot of a `ebrowse-ts' +structure. It describes the location of the class declaration." + source-file) + + +(defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named) + "Member structure. +This is the structure describing a single member. The `ebrowse-ts' +structure contains various lists for the different types of +members." + ;; Public, protected, private + visibility + ;; The file in which the member's definition can be found. + definition-file + ;; Same as PATTERN above, but for the member definition. + definition-pattern + ;; Same as POINT above but for member definition. + definition-point) + + + +;;; Some macros to access the FLAGS slot of a MEMBER. + +(defsubst ebrowse-member-bit-set-p (member bit) + "Value is non-nil if MEMBER's bit BIT is set." + (/= 0 (logand (ebrowse-bs-flags member) bit))) + + +(defsubst ebrowse-virtual-p (member) + "Value is non-nil if MEMBER is virtual." + (ebrowse-member-bit-set-p member 1)) + + +(defsubst ebrowse-inline-p (member) + "Value is non-nil if MEMBER is inline." + (ebrowse-member-bit-set-p member 2)) + + +(defsubst ebrowse-const-p (member) + "Value is non-nil if MEMBER is const." + (ebrowse-member-bit-set-p member 4)) + + +(defsubst ebrowse-pure-virtual-p (member) + "Value is non-nil if MEMBER is a pure virtual function." + (ebrowse-member-bit-set-p member 8)) + + +(defsubst ebrowse-mutable-p (member) + "Value is non-nil if MEMBER is mutable." + (ebrowse-member-bit-set-p member 16)) + + +(defsubst ebrowse-template-p (member) + "Value is non-nil if MEMBER is a template." + (ebrowse-member-bit-set-p member 32)) + + +(defsubst ebrowse-explicit-p (member) + "Value is non-nil if MEMBER is explicit." + (ebrowse-member-bit-set-p member 64)) + + +(defsubst ebrowse-throw-list-p (member) + "Value is non-nil if MEMBER has a throw specification." + (ebrowse-member-bit-set-p member 128)) + + +(defsubst ebrowse-extern-c-p (member) + "Value is non-nil if MEMBER.is `extern \"C\"'." + (ebrowse-member-bit-set-p member 256)) + + +(defsubst ebrowse-define-p (member) + "Value is non-nil if MEMBER is a define." + (ebrowse-member-bit-set-p member 512)) + + +(defconst ebrowse-version-string "ebrowse 5.0" + "Version string expected in EBROWSE files.") + + +(defconst ebrowse-globals-name "*Globals*" + "The name used for the surrogate class.containing global entities. +This must be the same that `ebrowse' uses.") + + +(defvar ebrowse--last-regexp nil + "Last regular expression searched for in tree and member buffers. +Automatically buffer-local so that each tree and member buffer +maintains its own search history.") +(make-variable-buffer-local 'ebrowse--last-regexp) + + +(defconst ebrowse-member-list-accessors + '(ebrowse-ts-member-variables + ebrowse-ts-member-functions + ebrowse-ts-static-variables + ebrowse-ts-static-functions + ebrowse-ts-friends + ebrowse-ts-types) + "List of accessors for member lists. +Each element is the symbol of an accessor function. +The nth element must be the accessor for the nth member list +in an `ebrowse-ts' structure.") + + +;;; FIXME: Add more doc strings for the buffer-local variables below. + +(defvar ebrowse--tree-obarray nil + "Obarray holding all `ebrowse-ts' structures of a class tree. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--tags-file-name nil + "File from which EBROWSE file was loaded. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--header nil + "Header structure of type `ebrowse-hs' of a class tree. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--frozen-flag nil + "Non-nil means an Ebrowse buffer won't be reused. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--show-file-names-flag nil + "Non-nil means show file names in a tree buffer. +Buffer-local in Ebrowse tree buffers.") + + +(defvar ebrowse--long-display-flag nil + "Non-nil means show members in long display form. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--n-columns nil + "Number of columns to display for short member display form. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--column-width nil + "Width of a columns to display for short member display form. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--virtual-display-flag nil + "Non-nil means display virtual members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--inline-display-flag nil + "Non-nil means display inline members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--const-display-flag nil + "Non-nil means display const members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--pure-display-flag nil + "Non-nil means display pure virtual members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--filters nil + "Filter for display of public, protected, and private members. +This is a vector of three elements. An element nil means the +corresponding members are not shown. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--show-inherited-flag nil + "Non-nil means display inherited members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--attributes-flag nil + "Non-nil means display member attributes in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--source-regexp-flag nil + "Non-nil means display member regexps in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--displayed-class nil + "Class displayed in a member buffer, a `ebrowse-ts' structure. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--accessor nil + "Member list displayed in a member buffer. +This is a symbol whose function definition is an accessor for the +member list in `ebrowse-cs' structures. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--member-list nil + "The list of `ebrowse-ms' structures displayed in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--decl-column nil + "Column in which declarations are displayed in member buffers. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--mode-strings nil + "Strings displayed in the mode line. +Buffer-local in Ebrowse tree buffers.") + + +(defvar ebrowse--frame-configuration nil + "Frame configuration saved when viewing a class/member in another frame. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--view-exit-action nil + "Action to perform after viewing a class/member. +Either `kill-buffer' or nil. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--tree nil + "Class tree. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--mode-line-props nil + "Text properties of mode line strings in member buffers. +Buffer-local in Ebrowse member buffers.") + + +;;; Temporaries used to communicate with `ebrowse-find-pattern'. + +(defvar ebrowse-temp-position-to-view nil) +(defvar ebrowse-temp-info-to-view nil) + + +(defvar ebrowse-tree-mode-map () + "The keymap used in tree mode buffers.") + + +(defvar ebrowse--member-mode-strings nil + "Strings displayed in the mode line of member buffers.") + + +(defvar ebrowse-member-mode-map () + "The keymap used in the member buffers.") + + +;;; Define mode line titles for each member list. + +(put 'ebrowse-ts-member-variables 'ebrowse-title "Member Variables") +(put 'ebrowse-ts-member-functions 'ebrowse-title "Member Functions") +(put 'ebrowse-ts-static-variables 'ebrowse-title "Static Variables") +(put 'ebrowse-ts-static-functions 'ebrowse-title "Static Functions") +(put 'ebrowse-ts-friends 'ebrowse-title "Friends") +(put 'ebrowse-ts-types 'ebrowse-title "Types") + +(put 'ebrowse-ts-member-variables 'ebrowse-global-title "Global Variables") +(put 'ebrowse-ts-member-functions 'ebrowse-global-title "Global Functions") +(put 'ebrowse-ts-static-variables 'ebrowse-global-title "Static Variables") +(put 'ebrowse-ts-static-functions 'ebrowse-global-title "Static Functions") +(put 'ebrowse-ts-friends 'ebrowse-global-title "Defines") +(put 'ebrowse-ts-types 'ebrowse-global-title "Types") + + + +;;; Operations on `ebrowse-ts' structures + +(defun ebrowse-files-table (&optional marked-only) + "Return an obarray containing all files mentioned in the current tree. +The tree is expected in the buffer-local variable `ebrowse--tree-obarray'. +MARKED-ONLY non-nil means include marked classes only." + (let ((files (make-hash-table :test 'equal)) + (i -1)) + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (when (or (not marked-only) (ebrowse-ts-mark tree)) + (let ((class (ebrowse-ts-class tree))) + (when (zerop (% (incf i) 20)) + (ebrowse-show-progress "Preparing file list" (zerop i))) + ;; Add files mentioned in class description + (let ((source-file (ebrowse-cs-source-file class)) + (file (ebrowse-cs-file class))) + (when source-file + (puthash source-file source-file files)) + (when file + (puthash file file files)) + ;; For all member lists in this class + (loop for accessor in ebrowse-member-list-accessors do + (loop for m in (funcall accessor tree) + for file = (ebrowse-ms-file m) + for def-file = (ebrowse-ms-definition-file m) do + (when file + (puthash file file files)) + (when def-file + (puthash def-file def-file files)))))))) + files)) + + +(defun ebrowse-files-list (&optional marked-only) + "Return a list containing all files mentioned in a tree. +MARKED-ONLY non-nil means include marked classes only." + (let (list) + (maphash #'(lambda (file dummy) (setq list (cons file list))) + (ebrowse-files-table marked-only)) + list)) + + +(defun* ebrowse-marked-classes-p () + "Value is non-nil if any class in the current class tree is marked." + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (when (ebrowse-ts-mark tree) + (return-from ebrowse-marked-classes-p tree)))) + + +(defsubst ebrowse-globals-tree-p (tree) + "Return t if TREE is the one for global entities." + (string= (ebrowse-bs-name (ebrowse-ts-class tree)) + ebrowse-globals-name)) + + +(defsubst ebrowse-qualified-class-name (class) + "Return the name of CLASS with scope prepended, if any." + (if (ebrowse-cs-scope class) + (concat (ebrowse-cs-scope class) "::" (ebrowse-cs-name class)) + (ebrowse-cs-name class))) + + +(defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p) + "Return an alist describing all classes in a tree. +Each elements in the list has the form (CLASS-NAME . TREE). +CLASS-NAME is the name of the class. TREE is the +class tree whose root is QUALIFIED-CLASS-NAME. +QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME. +The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." + (let (alist) + (if qualified-names-p + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (setq alist + (acons (ebrowse-qualified-class-name (ebrowse-ts-class tree)) + tree alist))) + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (setq alist + (acons (ebrowse-cs-name (ebrowse-ts-class tree)) + tree alist)))) + alist)) + + +(defun ebrowse-sort-tree-list (list) + "Sort a LIST of `ebrowse-ts' structures by qualified class names." + (sort list + #'(lambda (a b) + (string< (ebrowse-qualified-class-name (ebrowse-ts-class a)) + (ebrowse-qualified-class-name (ebrowse-ts-class b)))))) + + +(defun ebrowse-class-in-tree (class tree) + "Search for a class with name CLASS in TREE. +Return the class found, if any. This function is used during the load +phase where classes appended to a file replace older class +information." + (let ((tclass (ebrowse-ts-class class)) + found) + (while (and tree (not found)) + (let ((root (car tree))) + (when (string= (ebrowse-qualified-class-name (ebrowse-ts-class root)) + (ebrowse-qualified-class-name tclass)) + (setq found root)) + (setq tree (cdr tree)))) + found)) + + +(defun ebrowse-base-classes (tree) + "Return list of base-classes of TREE by searching subclass lists. +This function must be used instead of the struct slot +`base-classes' to access the base-class list directly because it +computes this information lazily." + (or (ebrowse-ts-base-classes tree) + (setf (ebrowse-ts-base-classes tree) + (loop with to-search = (list tree) + with result = nil + as search = (pop to-search) + while search finally return result + do (ebrowse-for-all-trees (ti ebrowse--tree-obarray) + (when (memq search (ebrowse-ts-subclasses ti)) + (unless (memq ti result) + (setq result (nconc result (list ti)))) + (push ti to-search))))))) + + +(defun ebrowse-direct-base-classes (tree) + "Return the list of direct super classes of TREE." + (let (result) + (dolist (s (ebrowse-base-classes tree)) + (when (memq tree (ebrowse-ts-subclasses s)) + (setq result (cons s result)))) + result)) + + + +;;; Operations on MEMBER structures/lists + +(defun ebrowse-name/accessor-alist (tree accessor) + "Return an alist containing all members of TREE in group ACCESSOR. +ACCESSOR is the accessor function for the member list. +Elements of the result have the form (NAME . ACCESSOR), where NAME +is the member name." + (loop for member in (funcall accessor tree) + collect (cons (ebrowse-ms-name member) accessor))) + + +(defun ebrowse-name/accessor-alist-for-visible-members () + "Return an alist describing all members visible in the current buffer. +Each element of the list has the form (MEMBER-NAME . ACCESSOR), +where MEMBER-NAME is the member's name, and ACCESSOR is the struct +accessor with which the member's list can be accessed in an `ebrowse-ts' +structure. The list includes inherited members if these are visible." + (let* ((list (ebrowse-name/accessor-alist ebrowse--displayed-class + ebrowse--accessor))) + (if ebrowse--show-inherited-flag + (nconc list + (loop for tree in (ebrowse-base-classes + ebrowse--displayed-class) + nconc (ebrowse-name/accessor-alist + tree ebrowse--accessor))) + list))) + + +(defun ebrowse-name/accessor-alist-for-class-members () + "Like `ebrowse-name/accessor-alist-for-visible-members'. +This function includes members of base classes if base class members +are visible in the buffer." + (let (list) + (dolist (func ebrowse-member-list-accessors list) + (setq list (nconc list (ebrowse-name/accessor-alist + ebrowse--displayed-class func))) + (when ebrowse--show-inherited-flag + (dolist (class (ebrowse-base-classes ebrowse--displayed-class)) + (setq list + (nconc list (ebrowse-name/accessor-alist class func)))))))) + + +;;; Progress indication + +(defvar ebrowse-n-boxes 0) +(defconst ebrowse-max-boxes 60) + +(defun ebrowse-show-progress (title &optional start) + "Display a progress indicator. +TITLE is the title of the progress message. START non-nil means +this is the first progress message displayed." + (let (message-log-max) + (when start (setq ebrowse-n-boxes 0)) + (setq ebrowse-n-boxes (mod (1+ ebrowse-n-boxes) ebrowse-max-boxes)) + (message (concat title ": " + (propertize (make-string ebrowse-n-boxes + (if (display-color-p) ?\ ?+)) + 'face 'ebrowse-progress-face))))) + + +;;; Reading a tree from disk + +(defun ebrowse-find-file () + "Function installed as `find-file hook'. +This loads a tree when it sees a special signature at the beginning of +the file loaded." + (when (looking-at "\\[ebrowse-hs") + (ebrowse-load buffer-file-name 'switch))) + + +(defun ebrowse-read () + "Read `ebrowse-hs' and `ebrowse-ts' structures in the current buffer. +Return a list (HEADER TREE) where HEADER is the file header read +and TREE is a list of `ebrowse-ts' structures forming the class tree." + (let ((header (condition-case nil + (read (current-buffer)) + (error (error "No Ebrowse file header found")))) + tree) + ;; Check file format. + (unless (ebrowse-hs-p header) + (error "No Ebrowse file header found")) + (unless (string= (ebrowse-hs-version header) ebrowse-version-string) + (error "File has wrong version `%s' (`%s' expected)" + (ebrowse-hs-version header) ebrowse-version-string)) + ;; Read Lisp objects. Temporarily increase `gc-cons-threshold' to + ;; prevent a GC that would not free any memory. + (let ((gc-cons-threshold 2000000)) + (while (not (eobp)) + (let* ((root (read (current-buffer))) + (old-root (ebrowse-class-in-tree root tree))) + (ebrowse-show-progress "Reading data" (null tree)) + (if old-root + (setf (car old-root) root) + (push root tree))))) + (garbage-collect) + (list header tree))) + + +(defun ebrowse-load (file &optional switch) + "Load an Ebrowse file FILE into memory and make a tree buffer. +Optional SWITCH non-nil means switch to the tree buffer afterwards. +This function is normally called from a `find-file-hook'. +Value is the tree buffer created." + (let (tree + header + (buffer (get-file-buffer file)) + tree-buffer) + (if buffer + (multiple-value-setq (header tree) + (ebrowse-read)) + (save-excursion + ;; Since find-file hooks may be involved, we must visit the + ;; file in a way that these hooks are not called. + (set-buffer (create-file-buffer file)) + (erase-buffer) + (insert-file file) + (set-buffer-modified-p nil) + (unwind-protect + (multiple-value-setq (header tree) + (ebrowse-read)) + (kill-buffer (current-buffer))))) + (when tree + (message "Sorting. Please be patient...") + (setf tree (ebrowse-sort-tree-list tree)) + ;; Create tree buffer + (setf tree-buffer + (ebrowse-create-tree-buffer tree file header + (ebrowse-build-tree-obarray tree) + switch buffer)) + (message nil) + tree-buffer))) + + +(defun ebrowse-revert-tree-buffer-from-file (ignore-auto-save noconfirm) + "Function installed as `revert-buffer-function' in tree buffers. +See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and +NOCONFIRM." + (interactive) + (when (or noconfirm + (yes-or-no-p "Revert tree from disk? ")) + (let ((ebrowse-file (or buffer-file-name ebrowse--tags-file-name))) + (loop for member-buffer in (ebrowse-same-tree-member-buffer-list) + do (kill-buffer member-buffer)) + (kill-buffer (current-buffer)) + (switch-to-buffer (ebrowse-load ebrowse-file))))) + + +(defun ebrowse-create-tree-buffer (tree tags-file header obarray pop + &optional find-file-buffer) + "Create a new tree buffer for tree TREE. +The tree was loaded from file TAGS-FILE. +HEADER is the header structure of the file. +OBARRAY is an obarray with a symbol for each class in the tree. +POP non-nil means popup the buffer up at the end. +FIND-FILE-BUFFER, if non-nil, is the buffer from which the Lisp data +was read. +Return the buffer created." + (let (name) + (cond (find-file-buffer + (set-buffer find-file-buffer) + (erase-buffer) + (setq name (ebrowse-frozen-tree-buffer-name tags-file)) + (ebrowse-rename-buffer name)) + (t + (setq name ebrowse-tree-buffer-name) + (set-buffer (get-buffer-create name)))) + ;; Switch to tree mode and initialize buffer local variables. + (ebrowse-tree-mode) + (setf ebrowse--tree tree + ebrowse--tags-file-name tags-file + ebrowse--tree-obarray obarray + ebrowse--header header + ebrowse--frozen-flag (not (null find-file-buffer))) + ;; Switch or pop to the tree buffer; display the tree and return the + ;; buffer. + (case pop + (switch (switch-to-buffer name)) + (pop (pop-to-buffer name))) + (ebrowse-redraw-tree) + (set-buffer-modified-p nil) + (current-buffer))) + + + +;;; Operations for member obarrays + +(defun ebrowse-fill-member-table () + "Return an obarray holding all members of all classes in the current tree. + +For each member, a symbol is added to the obarray. Members are +extracted from the buffer-local tree `ebrowse--tree-obarray'. + +Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST +MEMBER) where TREE is the tree in which the member is defined, +MEMBER-LIST is a symbol describing the member list in which the member +is found, and MEMBER is a MEMBER structure describing the member. + +The slot `member-table' of the buffer-local header structure of +type `ebrowse-hs' is set to the resulting obarray." + (let ((members (make-hash-table :test 'equal)) + (i -1)) + (setf (ebrowse-hs-member-table ebrowse--header) nil) + (garbage-collect) + ;; For all classes... + (ebrowse-for-all-trees (c ebrowse--tree-obarray) + (when (zerop (% (incf i) 10)) + (ebrowse-show-progress "Preparing member lookup" (zerop i))) + (loop for f in ebrowse-member-list-accessors do + (loop for m in (funcall f c) do + (let* ((member-name (ebrowse-ms-name m)) + (value (gethash member-name members))) + (push (list c f m) value) + (puthash member-name value members))))) + (setf (ebrowse-hs-member-table ebrowse--header) members))) + + +(defun ebrowse-member-table (header) + "Return the member obarray. Build it it hasn't been set up yet. +HEADER is the tree header structure of the class tree." + (when (null (ebrowse-hs-member-table header)) + (loop for buffer in (ebrowse-browser-buffer-list) + until (eq header (ebrowse-value-in-buffer 'ebrowse--header buffer)) + finally do + (save-excursion + (set-buffer buffer) + (ebrowse-fill-member-table)))) + (ebrowse-hs-member-table header)) + + + +;;; Operations on TREE obarrays + +(defun ebrowse-build-tree-obarray (tree) + "Make sure every class in TREE is represented by a unique object. +Build obarray of all classes in TREE." + (let ((classes (make-vector 127 0))) + ;; Add root classes... + (loop for root in tree + as sym = + (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) classes) + do (unless (get sym 'ebrowse-root) + (setf (get sym 'ebrowse-root) root))) + ;; Process subclasses + (ebrowse-insert-supers tree classes) + classes)) + + +(defun ebrowse-insert-supers (tree classes) + "Build base class lists in class tree TREE. +CLASSES is an obarray used to collect classes. + +Helper function for `ebrowse-build-tree-obarray'. Base classes should +be ordered so that immediate base classes come first, then the base +class of the immediate base class and so on. This means that we must +construct the base-class list top down with adding each level at the +beginning of the base-class list. + +We have to be cautious here not to end up in an infinite recursion +if for some reason a circle is in the inheritance graph." + (loop for class in tree + as subclasses = (ebrowse-ts-subclasses class) do + ;; Make sure every class is represented by a unique object + (loop for subclass on subclasses + as sym = (intern + (ebrowse-qualified-class-name (ebrowse-ts-class (car subclass))) + classes) + as next = nil + do + ;; Replace the subclass tree with the one found in + ;; CLASSES if there is already an entry for that class + ;; in it. Otherwise make a new entry. + ;; + ;; CAVEAT: If by some means (e.g., use of the + ;; preprocessor in class declarations, a name is marked + ;; as a subclass of itself on some path, we would end up + ;; in an endless loop. We have to omit subclasses from + ;; the recursion that already have been processed. + (if (get sym 'ebrowse-root) + (setf (car subclass) (get sym 'ebrowse-root)) + (setf (get sym 'ebrowse-root) (car subclass)))) + ;; Process subclasses + (ebrowse-insert-supers subclasses classes))) + + +;;; Tree buffers + +(unless ebrowse-tree-mode-map + (let ((map (make-keymap))) + (setf ebrowse-tree-mode-map map) + (suppress-keymap map) + + (when window-system + (define-key map [down-mouse-3] 'ebrowse-mouse-3-in-tree-buffer) + (define-key map [mouse-2] 'ebrowse-mouse-2-in-tree-buffer) + (define-key map [down-mouse-1] 'ebrowse-mouse-1-in-tree-buffer)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "L" map1) + (define-key map1 "d" 'ebrowse-tree-command:show-friends) + (define-key map1 "f" 'ebrowse-tree-command:show-member-functions) + (define-key map1 "F" 'ebrowse-tree-command:show-static-member-functions) + (define-key map1 "t" 'ebrowse-tree-command:show-types) + (define-key map1 "v" 'ebrowse-tree-command:show-member-variables) + (define-key map1 "V" 'ebrowse-tree-command:show-static-member-variables)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "M" map1) + (define-key map1 "a" 'ebrowse-mark-all-classes) + (define-key map1 "t" 'ebrowse-toggle-mark-at-point)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "T" map1) + (define-key map1 "f" 'ebrowse-toggle-file-name-display) + (define-key map1 "s" 'ebrowse-show-file-name-at-point) + (define-key map1 "w" 'ebrowse-set-tree-indentation) + (define-key map "x" 'ebrowse-statistics)) + + (define-key map "n" 'ebrowse-repeat-member-search) + (define-key map "q" 'bury-buffer) + (define-key map "*" 'ebrowse-expand-all) + (define-key map "+" 'ebrowse-expand-branch) + (define-key map "-" 'ebrowse-collapse-branch) + (define-key map "/" 'ebrowse-read-class-name-and-go) + (define-key map " " 'ebrowse-view-class-declaration) + (define-key map "?" 'describe-mode) + (define-key map "\C-i" 'ebrowse-pop/switch-to-member-buffer-for-same-tree) + (define-key map "\C-k" 'ebrowse-remove-class-at-point) + (define-key map "\C-l" 'ebrowse-redraw-tree) + (define-key map "\C-m" 'ebrowse-find-class-declaration))) + + + +;;; Tree-mode - mode for tree buffers + +;;;###autoload +(defun ebrowse-tree-mode () + "Major mode for Ebrowse class tree buffers. +Each line corresponds to a class in a class tree. +Letters do not insert themselves, they are commands. +File operations in the tree buffer work on class tree data structures. +E.g.\\[save-buffer] writes the tree to the file it was loaded from. + +Tree mode key bindings: +\\{ebrowse-tree-mode-map}" + (kill-all-local-variables) + (mapcar 'make-local-variable + '(ebrowse--tags-file-name + ebrowse--indentation + ebrowse--tree + ebrowse--header + ebrowse--show-file-names-flag + ebrowse--frozen-flag + ebrowse--tree-obarray + ebrowse--mode-strings + revert-buffer-function)) + (use-local-map ebrowse-tree-mode-map) + (let* ((props (text-properties-at + 0 + (car (default-value 'mode-line-buffer-identification)))) + (ident (apply #'propertize "C++ Tree" props))) + (setf ebrowse--show-file-names-flag nil + ebrowse--tree-obarray (make-vector 127 0) + ebrowse--frozen-flag nil + major-mode 'ebrowse-tree-mode + mode-name "Ebrowse-Tree" + mode-line-buffer-identification (list ident) + buffer-read-only t + selective-display t + selective-display-ellipses t + revert-buffer-function 'ebrowse-revert-tree-buffer-from-file)) + (add-hook 'local-write-file-hooks 'ebrowse-write-file-hook-fn) + (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) + (run-hooks 'ebrowse-tree-mode-hook)) + + +(defun ebrowse-update-tree-buffer-mode-line () + "Update the tree buffer mode line." + (setf ebrowse--mode-strings + (concat (if ebrowse--frozen-flag (or buffer-file-name + ebrowse--tags-file-name)) + (if (buffer-modified-p) "-**"))) + (ebrowse-rename-buffer (if ebrowse--frozen-flag + (ebrowse-frozen-tree-buffer-name + ebrowse--tags-file-name) + ebrowse-tree-buffer-name)) + (force-mode-line-update)) + + + +;;; Removing classes from trees + +(defun ebrowse-remove-class-and-kill-member-buffers (tree class) + "Remove from TREE class CLASS. +Kill all member buffers still containing a reference to the class." + (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class)) + ebrowse--tree-obarray))) + (setf tree (delq class tree) + (get sym 'ebrowse-root) nil) + (dolist (root tree) + (setf (ebrowse-ts-subclasses root) + (delq class (ebrowse-ts-subclasses root)) + (ebrowse-ts-base-classes root) nil) + (ebrowse-remove-class-and-kill-member-buffers + (ebrowse-ts-subclasses root) class)) + (ebrowse-kill-member-buffers-displaying class) + tree)) + + +(defun ebrowse-remove-class-at-point (forced) + "Remove the class point is on from the class tree. +Do not ask for confirmation if FORCED is non-nil." + (interactive "P") + (let* ((class (ebrowse-tree-at-point)) + (class-name (ebrowse-cs-name (ebrowse-ts-class class))) + (subclasses (ebrowse-ts-subclasses class))) + (cond ((or forced + (y-or-n-p (concat "Delete class " class-name "? "))) + (setf ebrowse--tree (ebrowse-remove-class-and-kill-member-buffers + ebrowse--tree class)) + (set-buffer-modified-p t) + (message "%s %sdeleted." class-name + (if subclasses "and derived classes " "")) + (ebrowse-redraw-tree)) + (t (message "Aborted"))))) + + + +;;; Marking classes in the tree buffer + +(defun ebrowse-toggle-mark-at-point (&optional n-times) + "Toggle mark for class cursor is on. +If given a numeric N-TIMES argument, mark that many classes." + (interactive "p") + (let (to-change pnt) + ;; Get the classes whose mark must be toggled. Note that + ;; ebrowse-tree-at-point might issue an error. + (condition-case error + (loop repeat (or n-times 1) + as tree = (ebrowse-tree-at-point) + do (progn + (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree))) + (forward-line 1) + (push tree to-change))) + (error nil)) + (save-excursion + ;; For all these classes, reverse the mark char in the display + ;; by a regexp replace over the whole buffer. The reason for this + ;; is that classes might have multiple base classes. If this is + ;; the case, they are displayed more than once in the tree. + (ebrowse-output + (loop for tree in to-change + as regexp = (concat "^.*\\b" + (regexp-quote + (ebrowse-cs-name (ebrowse-ts-class tree))) + "\\b") + do + (goto-char (point-min)) + (loop while (re-search-forward regexp nil t) + do (progn + (goto-char (match-beginning 0)) + (delete-char 1) + (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1) + (ebrowse-set-mark-props (1- (point)) (point) tree) + (goto-char (match-end 0))))))))) + + +(defun ebrowse-mark-all-classes (prefix) + "Unmark, with PREFIX mark, all classes in the tree." + (interactive "P") + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (setf (ebrowse-ts-mark tree) prefix)) + (ebrowse-redraw-marks (point-min) (point-max))) + + +(defun ebrowse-redraw-marks (start end) + "Display class marker signs in the tree between START and END." + (interactive) + (save-excursion + (ebrowse-output + (catch 'end + (goto-char (point-min)) + (dolist (root ebrowse--tree) + (ebrowse-draw-marks-fn root start end)))) + (ebrowse-update-tree-buffer-mode-line))) + + +(defun ebrowse-draw-marks-fn (tree start end) + "Display class marker signs in TREE between START and END." + (when (>= (point) start) + (delete-char 1) + (insert (if (ebrowse-ts-mark tree) ?> ? )) + (ebrowse-set-mark-props (1- (point)) (point) tree)) + (forward-line 1) + (when (> (point) end) + (throw 'end nil)) + (dolist (sub (ebrowse-ts-subclasses tree)) + (ebrowse-draw-marks-fn sub start end))) + + + +;;; File name display in tree buffers + +(defun ebrowse-show-file-name-at-point (prefix) + "Show filename in the line point is in. +With PREFIX, insert that many filenames." + (interactive "p") + (unless ebrowse--show-file-names-flag + (ebrowse-output + (dotimes (i prefix) + (let ((tree (ebrowse-tree-at-point)) + start + file-name-existing) + (unless tree return) + (beginning-of-line) + (skip-chars-forward " \t*a-zA-Z0-9_") + (setq start (point) + file-name-existing (looking-at "(")) + (delete-region start (save-excursion (end-of-line) (point))) + (unless file-name-existing + (indent-to ebrowse-source-file-column) + (insert "(" (or (ebrowse-cs-file + (ebrowse-ts-class tree)) + "unknown") + ")")) + (ebrowse-set-face start (point) 'ebrowse-file-name-face) + (beginning-of-line) + (forward-line 1)))))) + + +(defun ebrowse-toggle-file-name-display () + "Toggle display of filenames in tree buffer." + (interactive) + (setf ebrowse--show-file-names-flag (not ebrowse--show-file-names-flag)) + (let ((old-line (count-lines (point-min) (point)))) + (ebrowse-redraw-tree) + (goto-line old-line))) + + + +;;; General member and tree buffer functions + +(defun ebrowse-member-buffer-p (buffer) + "Value is non-nil if BUFFER is a member buffer." + (eq (cdr (assoc 'major-mode (buffer-local-variables buffer))) + 'ebrowse-member-mode)) + + +(defun ebrowse-tree-buffer-p (buffer) + "Value is non-nil if BUFFER is a class tree buffer." + (eq (cdr (assoc 'major-mode (buffer-local-variables buffer))) + 'ebrowse-tree-mode)) + + +(defun ebrowse-buffer-p (buffer) + "Value is non-nil if BUFFER is a tree or member buffer." + (memq (cdr (assoc 'major-mode (buffer-local-variables buffer))) + '(ebrowse-tree-mode ebrowse-member-mode))) + + +(defun ebrowse-browser-buffer-list () + "Return a list of all tree or member buffers." + (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list))) + + +(defun ebrowse-member-buffer-list () + "Return a list of all member buffers." + (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) + + +(defun ebrowse-tree-buffer-list () + "Return a list of all tree buffers." + (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) + + +(defun ebrowse-known-class-trees-buffer-list () + "Return a list of buffers containing class trees. +The list will contain, for each class tree loaded, +one buffer. Prefer tree buffers over member buffers." + (let ((buffers (nconc (ebrowse-tree-buffer-list) + (ebrowse-member-buffer-list))) + (set (make-hash-table)) + result) + (dolist (buffer buffers) + (let ((tree (ebrowse-value-in-buffer 'ebrowse--tree buffer))) + (unless (gethash tree set) + (push buffer result)) + (puthash tree t set))) + result)) + + +(defun ebrowse-same-tree-member-buffer-list () + "Return a list of members buffers with same tree as current buffer." + (ebrowse-delete-if-not + #'(lambda (buffer) + (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer) + ebrowse--tree)) + (ebrowse-member-buffer-list))) + + + +(defun ebrowse-pop/switch-to-member-buffer-for-same-tree (arg) + "Pop to the buffer displaying members. +Switch to buffer if prefix ARG. +If no member buffer exists, make one." + (interactive "P") + (let ((buf (or (first (ebrowse-same-tree-member-buffer-list)) + (get-buffer ebrowse-member-buffer-name) + (ebrowse-tree-command:show-member-functions)))) + (when buf + (if arg + (switch-to-buffer buf) + (pop-to-buffer buf))) + buf)) + + +(defun ebrowse-switch-to-next-member-buffer () + "Switch to next member buffer." + (interactive) + (let* ((list (ebrowse-member-buffer-list)) + (next-list (cdr (memq (current-buffer) list))) + (next-buffer (if next-list (car next-list) (car list)))) + (if (eq next-buffer (current-buffer)) + (error "No next buffer") + (bury-buffer) + (switch-to-buffer next-buffer)))) + + +(defun ebrowse-kill-member-buffers-displaying (tree) + "Kill all member buffers displaying TREE." + (loop for buffer in (ebrowse-member-buffer-list) + as class = (ebrowse-value-in-buffer 'ebrowse--displayed-class buffer) + when (eq class tree) do (kill-buffer buffer))) + + +(defun ebrowse-frozen-tree-buffer-name (tags-file-name) + "Return the buffer name of a tree which is associated TAGS-FILE-NAME." + (concat ebrowse-tree-buffer-name " (" tags-file-name ")")) + + +(defun ebrowse-pop-to-browser-buffer (arg) + "Pop to a browser buffer from any other buffer. +Pop to member buffer if no prefix ARG, to tree buffer otherwise." + (interactive "P") + (let ((buffer (get-buffer (if arg + ebrowse-tree-buffer-name + ebrowse-member-buffer-name)))) + (unless buffer + (setq buffer + (get-buffer (if arg + ebrowse-member-buffer-name + ebrowse-tree-buffer-name)))) + (unless buffer + (error "No browser buffer found")) + (pop-to-buffer buffer))) + + + +;;; Misc tree buffer commands + +(defun ebrowse-set-tree-indentation () + "Set the indentation width of the tree display." + (interactive) + (let ((width (string-to-int (read-from-minibuffer + (concat "Indentation (" + (int-to-string ebrowse--indentation) + "): "))))) + (when (plusp width) + (setf ebrowse--indentation width) + (ebrowse-redraw-tree)))) + + +(defun ebrowse-read-class-name-and-go (&optional class) + "Position cursor on CLASS. +Read a class name from the minibuffer if CLASS is nil." + (interactive) + (ebrowse-ignoring-completion-case + ;; If no class specified, read the class name from mini-buffer + (unless class + (setf class + (completing-read "Goto class: " + (ebrowse-tree-obarray-as-alist) nil t))) + (ebrowse-save-selective + (goto-char (point-min)) + (widen) + (setf selective-display nil) + (setq ebrowse--last-regexp (concat "\\b" class "\\b")) + (if (re-search-forward ebrowse--last-regexp nil t) + (progn + (goto-char (match-beginning 0)) + (ebrowse-unhide-base-classes)) + (error "Not found"))))) + + + +;;; Showing various kinds of member buffers + +(defun ebrowse-tree-command:show-member-variables (arg) + "Display member variables; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg)) + + +(defun ebrowse-tree-command:show-member-functions (&optional arg) + "Display member functions; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg)) + + +(defun ebrowse-tree-command:show-static-member-variables (arg) + "Display static member variables; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg)) + + +(defun ebrowse-tree-command:show-static-member-functions (arg) + "Display static member functions; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg)) + + +(defun ebrowse-tree-command:show-friends (arg) + "Display friend functions; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-friends arg)) + + +(defun ebrowse-tree-command:show-types (arg) + "Display types defined in a class; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-types arg)) + + + +;;; Viewing or finding a class declaration + +(defun ebrowse-tree-at-point () + "Return the class structure for the class point is on." + (or (get-text-property (point) 'ebrowse-tree) + (error "Not on a class"))) + + +(defun* ebrowse-view/find-class-declaration (&key view where) + "View or find the declarator of the class point is on. +VIEW non-nil means view it. WHERE is additional position info." + (let* ((class (ebrowse-ts-class (ebrowse-tree-at-point))) + (file (ebrowse-cs-file class)) + (browse-struct (make-ebrowse-bs + :name (ebrowse-cs-name class) + :pattern (ebrowse-cs-pattern class) + :flags (ebrowse-cs-flags class) + :file (ebrowse-cs-file class) + :point (ebrowse-cs-point class)))) + (ebrowse-view/find-file-and-search-pattern + browse-struct + (list ebrowse--header class nil) + file + ebrowse--tags-file-name + view + where))) + + +(defun ebrowse-find-class-declaration (prefix-arg) + "Find a class declaration and position cursor on it. +PREFIX-ARG 4 means find it in another window. +PREFIX-ARG 5 means find it in another frame." + (interactive "p") + (ebrowse-view/find-class-declaration + :view nil + :where (cond ((= prefix-arg 4) 'other-window) + ((= prefix-arg 5) 'other-frame) + (t 'this-window)))) + + +(defun ebrowse-view-class-declaration (prefix-arg) + "View class declaration and position cursor on it. +PREFIX-ARG 4 means view it in another window. +PREFIX-ARG 5 means view it in another frame." + (interactive "p") + (ebrowse-view/find-class-declaration + :view 'view + :where (cond ((= prefix-arg 4) 'other-window) + ((= prefix-arg 5) 'other-frame) + (t 'this-window)))) + + + +;;; The FIND engine + +(defun ebrowse-find-source-file (file tags-file-name) + "Find source file FILE. +Source files are searched for (a) relative to TAGS-FILE-NAME +which is the path of the BROWSE file from which the class tree was loaded, +and (b) in the directories named in `ebrowse-search-path'." + (let (file-name + (try-file (expand-file-name file + (file-name-directory tags-file-name)))) + (if (file-readable-p try-file) + (setq file-name try-file) + (let ((search-in ebrowse-search-path)) + (while (and search-in + (null file-name)) + (let ((try-file (expand-file-name file (car search-in)))) + (if (file-readable-p try-file) + (setq file-name try-file)) + (setq search-in (cdr search-in)))))) + (unless file-name + (error "File `%s' not found" file)) + file-name)) + + +(defun ebrowse-view-file-other-window (file) + "View a file FILE in another window. +This is a replacement for `view-file-other-window' which does not +seem to work. It should be removed when `view.el' is fixed." + (interactive) + (let ((old-arrangement (current-window-configuration)) + (had-a-buf (get-file-buffer file)) + (buf-to-view (find-file-noselect file))) + (switch-to-buffer-other-window buf-to-view) + (view-mode-enter old-arrangement + (and (not had-a-buf) + (not (buffer-modified-p buf-to-view)) + 'kill-buffer)))) + + +(defun ebrowse-view-exit-fn (buffer) + "Function called when exiting View mode in BUFFER. +Restore frame configuration active before viewing the file, +and possibly kill the viewed buffer." + (let (exit-action original-frame-configuration) + (save-excursion + (set-buffer buffer) + (setq original-frame-configuration ebrowse--frame-configuration + exit-action ebrowse--view-exit-action)) + ;; Delete the frame in which we viewed. + (mapcar 'delete-frame + (loop for frame in (frame-list) + when (not (assq frame original-frame-configuration)) + collect frame)) + (when exit-action + (funcall exit-action buffer)))) + + +(defun ebrowse-view-file-other-frame (file) + "View a file FILE in another frame. +The new frame is deleted when it is no longer used." + (interactive) + (let ((old-frame-configuration (current-frame-configuration)) + (old-arrangement (current-window-configuration)) + (had-a-buf (get-file-buffer file)) + (buf-to-view (find-file-noselect file))) + (switch-to-buffer-other-frame buf-to-view) + (make-local-variable 'ebrowse--frame-configuration) + (setq ebrowse--frame-configuration old-frame-configuration) + (make-local-variable 'ebrowse--view-exit-action) + (setq ebrowse--view-exit-action + (and (not had-a-buf) + (not (buffer-modified-p buf-to-view)) + 'kill-buffer)) + (view-mode-enter old-arrangement 'ebrowse-view-exit-fn))) + + +(defun ebrowse-view/find-file-and-search-pattern + (struc info file tags-file-name &optional view where) + "Find or view a member or class. +STRUC is an `ebrowse-bs' structure (or a structure including that) +describing what to search. +INFO is a list (HEADER MEMBER-OR-CLASS ACCESSOR). HEADER is the +header structure of a class tree. MEMBER-OR-CLASS is either an +`ebrowse-ms' or `ebrowse-cs' structure depending on what is searched. +ACCESSOR is an accessor function for the member list of an member +if MEMBER-OR-CLASS is an `ebrowse-ms'. +FILE is the file to search the member in. +FILE is not taken out of STRUC here because the filename in STRUC +may be nil in which case the filename of the class description is used. +TAGS-FILE-NAME is the name of the EBROWSE file from which the +tree was loaded. +If VIEW is non-nil, view file else find the file. +WHERE is either `other-window', `other-frame' or `this-window' and +specifies where to find/view the result." + (unless file + (error "Sorry, no file information available for %s" + (ebrowse-bs-name struc))) + ;; Get the source file to view or find. + (setf file (ebrowse-find-source-file file tags-file-name)) + ;; If current window is dedicated, use another frame. + (when (window-dedicated-p (selected-window)) + (setf where 'other-frame)) + (cond (view + (setf ebrowse-temp-position-to-view struc + ebrowse-temp-info-to-view info) + (unless (boundp 'view-mode-hook) + (setq view-mode-hook nil)) + (push 'ebrowse-find-pattern view-mode-hook) + (case where + (other-window (ebrowse-view-file-other-window file)) + (other-frame (ebrowse-view-file-other-frame file)) + (t (view-file file)))) + (t + (case where + (other-window (find-file-other-window file)) + (other-frame (find-file-other-frame file)) + (t (find-file file))) + (ebrowse-find-pattern struc info)))) + + +(defun ebrowse-symbol-regexp (name) + "Generate a suitable regular expression for a member or class NAME. +This is `regexp-quote' for most symbols, except for operator names +which may contain whitespace. For these symbols, replace white +space in the symbol name (generated by EBROWSE) with a regular +expression matching any number of whitespace characters." + (loop with regexp = (regexp-quote name) + with start = 0 + finally return regexp + while (string-match "[ \t]+" regexp start) + do (setf (substring regexp (match-beginning 0) (match-end 0)) + "[ \t]*" + start (+ (match-beginning 0) 5)))) + + +(defun ebrowse-class-declaration-regexp (name) + "Construct a regexp for a declaration of class NAME." + (concat "^[ \t]*\\(template[ \t\n]*<.*>\\)?" + "[ \t\n]*\\(class\\|struct\\|union\\).*\\S_" + (ebrowse-symbol-regexp name) + "\\S_")) + + +(defun ebrowse-variable-declaration-regexp (name) + "Construct a regexp for matching a variable NAME." + (concat "\\S_" (ebrowse-symbol-regexp name) "\\S_")) + + +(defun ebrowse-function-declaration/definition-regexp (name) + "Construct a regexp for matching a function NAME." + (concat "^[a-zA-Z0-9_:*&<>, \t]*\\S_" + (ebrowse-symbol-regexp name) + "[ \t\n]*(")) + + +(defun ebrowse-pp-define-regexp (name) + "Construct a regexp matching a define of NAME." + (concat "^[ \t]*#[ \t]*define[ \t]+" (regexp-quote name))) + + +(defun* ebrowse-find-pattern (&optional position info &aux viewing) + "Find a pattern. + +This is a kluge: Ebrowse allows you to find or view a file containing +a pattern. To be able to do a search in a viewed buffer, +`view-mode-hook' is temporarily set to this function; +`ebrowse-temp-position-to-view' holds what to search for. + +INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)." + (unless position + (pop view-mode-hook) + (setf viewing t + position ebrowse-temp-position-to-view + info ebrowse-temp-info-to-view)) + (widen) + (let* ((pattern (ebrowse-bs-pattern position)) + (start (ebrowse-bs-point position)) + (offset 100) + found) + (destructuring-bind (header class-or-member member-list) info + ;; If no pattern is specified, construct one from the member name. + (when (stringp pattern) + (setq pattern (concat "^.*" (regexp-quote pattern)))) + ;; Construct a regular expression if none given. + (unless pattern + (typecase class-or-member + (ebrowse-ms + (case member-list + ((ebrowse-ts-member-variables + ebrowse-ts-static-variables + ebrowse-ts-types) + (setf pattern (ebrowse-variable-declaration-regexp + (ebrowse-bs-name position)))) + (otherwise + (if (ebrowse-define-p class-or-member) + (setf pattern (ebrowse-pp-define-regexp (ebrowse-bs-name position))) + (setf pattern (ebrowse-function-declaration/definition-regexp + (ebrowse-bs-name position))))))) + (ebrowse-cs + (setf pattern (ebrowse-class-declaration-regexp + (ebrowse-bs-name position)))))) + ;; Begin searching some OFFSET from the original point where the + ;; regular expression was found by the parse, and step forward. + ;; When there is no regular expression in the database and a + ;; member definition/declaration was not seen by the parser, + ;; START will be 0. + (when (and (boundp 'ebrowse-debug) + (symbol-value 'ebrowse-debug)) + (y-or-n-p (format "start = %d" start)) + (y-or-n-p pattern)) + (setf found + (loop do (goto-char (max (point-min) (- start offset))) + when (re-search-forward pattern (+ start offset) t) return t + never (bobp) + do (incf offset offset))) + (cond (found + (beginning-of-line) + (run-hooks 'ebrowse-view/find-hook)) + ((numberp (ebrowse-bs-pattern position)) + (goto-char start) + (if ebrowse-not-found-hook + (run-hooks 'ebrowse-not-found-hook) + (message "Not found") + (sit-for 2))) + (t + (if ebrowse-not-found-hook + (run-hooks 'ebrowse-not-found-hook) + (unless viewing + (error "Not found")) + (message "Not found") + (sit-for 2))))))) + + +;;; Drawing the tree + +(defun ebrowse-redraw-tree (&optional quietly) + "Redisplay the complete tree. +QUIETLY non-nil means don't display progress messages." + (interactive) + (or quietly (message "Displaying...")) + (save-excursion + (ebrowse-output + (erase-buffer) + (ebrowse-draw-tree-fn))) + (ebrowse-update-tree-buffer-mode-line) + (or quietly (message nil))) + + +(defun ebrowse-set-mark-props (start end tree) + "Set text properties for class marker signs between START and END. +TREE denotes the class shown." + (add-text-properties + start end + `(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree + help-echo "double-mouse-1: mark/unmark")) + (ebrowse-set-face start end 'ebrowse-tree-mark-face)) + + +(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start) + "Display a single class and recursively it's subclasses. +This function may look weird, but this is faster than recursion." + (setq stack1 (make-list (length ebrowse--tree) 0) + stack2 (ebrowse-copy-list ebrowse--tree)) + (loop while stack2 + as level = (pop stack1) + as tree = (pop stack2) + as class = (ebrowse-ts-class tree) do + (let ((start-of-line (point)) + start-of-class-name end-of-class-name) + ;; Insert mark + (insert (if (ebrowse-ts-mark tree) ">" " ")) + + ;; Indent and insert class name + (indent-to (+ (* level ebrowse--indentation) + ebrowse-tree-left-margin)) + (setq start (point)) + (insert (ebrowse-qualified-class-name class)) + + ;; If template class, add <> + (when (ebrowse-template-p class) + (insert "<>")) + (ebrowse-set-face start (point) (if (zerop level) + 'ebrowse-root-class-face + 'ebrowse-default-face)) + (setf start-of-class-name start + end-of-class-name (point)) + ;; If filenames are to be displayed... + (when ebrowse--show-file-names-flag + (indent-to ebrowse-source-file-column) + (setq start (point)) + (insert "(" + (or (ebrowse-cs-file class) + "unknown") + ")") + (ebrowse-set-face start (point) 'ebrowse-file-name-face)) + (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree) + (add-text-properties + start-of-class-name end-of-class-name + `(mouse-face highlight ebrowse-what class-name + ebrowse-tree ,tree + help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu")) + (insert "\n")) + ;; Push subclasses, if any. + (when (ebrowse-ts-subclasses tree) + (setq stack2 + (nconc (ebrowse-copy-list (ebrowse-ts-subclasses tree)) stack2) + stack1 + (nconc (make-list (length (ebrowse-ts-subclasses tree)) + (1+ level)) stack1))))) + + + +;;; Expanding/ collapsing tree branches + +(defun ebrowse-expand-branch (arg) + "Expand a sub-tree that has been previously collapsed. +With prefix ARG, expand all sub-trees." + (interactive "P") + (if arg + (ebrowse-expand-all arg) + (ebrowse-collapse-fn nil))) + + +(defun ebrowse-collapse-branch (arg) + "Fold (do no longer display) the subclasses of the current class. +\(The class cursor is on.) With prefix ARG, fold all trees in the buffer." + (interactive "P") + (if arg + (ebrowse-expand-all (not arg)) + (ebrowse-collapse-fn t))) + + +(defun ebrowse-expand-all (collapse) + "Expand or fold all trees in the buffer. +COLLAPSE non-nil means fold them." + (interactive "P") + (let ((line-end (if collapse "^\n" "^\r")) + (insertion (if collapse "\r" "\n"))) + (ebrowse-output + (save-excursion + (goto-char (point-min)) + (while (not (progn (skip-chars-forward line-end) (eobp))) + (when (or (not collapse) + (looking-at "\n ")) + (delete-char 1) + (insert insertion)) + (when collapse + (skip-chars-forward "\n "))))))) + + +(defun ebrowse-unhide-base-classes () + "Unhide the line the cursor is on and all base classes." + (ebrowse-output + (save-excursion + (let (indent last-indent) + (skip-chars-backward "^\r\n") + (when (not (looking-at "[\r\n][^ \t]")) + (skip-chars-forward "\r\n \t") + (while (and (or (null last-indent) ;first time + (> indent 1)) ;not root class + (re-search-backward "[\r\n][ \t]*" nil t)) + (setf indent (- (match-end 0) + (match-beginning 0))) + (when (or (null last-indent) + (< indent last-indent)) + (setf last-indent indent) + (when (looking-at "\r") + (delete-char 1) + (insert 10))) + (backward-char 1))))))) + + +(defun ebrowse-hide-line (collapse) + "Hide/show a single line in the tree. +COLLAPSE non-nil means hide." + (save-excursion + (ebrowse-output + (skip-chars-forward "^\r\n") + (delete-char 1) + (insert (if collapse 13 10))))) + + +(defun ebrowse-collapse-fn (collapse) + "Collapse or expand a branch of the tree. +COLLAPSE non-nil means collapse the branch." + (ebrowse-output + (save-excursion + (beginning-of-line) + (skip-chars-forward "> \t") + (let ((indentation (current-column))) + (while (and (not (eobp)) + (save-excursion + (skip-chars-forward "^\r\n") + (goto-char (1+ (point))) + (skip-chars-forward "> \t") + (> (current-column) indentation))) + (ebrowse-hide-line collapse) + (skip-chars-forward "^\r\n") + (goto-char (1+ (point)))))))) + + +;;; Electric tree selection + +(defvar ebrowse-electric-list-mode-map () + "Keymap used in electric Ebrowse buffer list window.") + + +(unless ebrowse-electric-list-mode-map + (let ((map (make-keymap)) + (submap (make-keymap))) + (setq ebrowse-electric-list-mode-map map) + (fillarray (car (cdr map)) 'ebrowse-electric-list-undefined) + (fillarray (car (cdr submap)) 'ebrowse-electric-list-undefined) + (define-key map "\e" submap) + (define-key map "\C-z" 'suspend-emacs) + (define-key map "\C-h" 'Helper-help) + (define-key map "?" 'Helper-describe-bindings) + (define-key map "\C-c" nil) + (define-key map "\C-c\C-c" 'ebrowse-electric-list-quit) + (define-key map "q" 'ebrowse-electric-list-quit) + (define-key map " " 'ebrowse-electric-list-select) + (define-key map "\C-l" 'recenter) + (define-key map "\C-u" 'universal-argument) + (define-key map "\C-p" 'previous-line) + (define-key map "\C-n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "n" 'next-line) + (define-key map "v" 'ebrowse-electric-view-buffer) + (define-key map "\C-v" 'scroll-up) + (define-key map "\ev" 'scroll-down) + (define-key map "\e\C-v" 'scroll-other-window) + (define-key map "\e>" 'end-of-buffer) + (define-key map "\e<" 'beginning-of-buffer) + (define-key map "\e>" 'end-of-buffer))) + +(put 'ebrowse-electric-list-mode 'mode-class 'special) +(put 'ebrowse-electric-list-undefined 'suppress-keymap t) + + +(defun ebrowse-electric-list-mode () + "Mode for electric tree list mode." + (kill-all-local-variables) + (use-local-map ebrowse-electric-list-mode-map) + (setq mode-name "Electric Position Menu" + mode-line-buffer-identification "Electric Tree Menu") + (when (memq 'mode-name mode-line-format) + (setq mode-line-format (copy-sequence mode-line-format)) + (setcar (memq 'mode-name mode-line-format) "Tree Buffers")) + (make-local-variable 'Helper-return-blurb) + (setq Helper-return-blurb "return to buffer editing" + truncate-lines t + buffer-read-only t + major-mode 'ebrowse-electric-list-mode) + (run-hooks 'ebrowse-electric-list-mode-hook)) + + +(defun ebrowse-list-tree-buffers () + "Display a list of all tree buffers." + (set-buffer (get-buffer-create "*Tree Buffers*")) + (setq buffer-read-only nil) + (erase-buffer) + (insert "Tree\n" "----\n") + (dolist (buffer (ebrowse-known-class-trees-buffer-list)) + (insert (buffer-name buffer) "\n")) + (setq buffer-read-only t)) + + +;;;###autoload +(defun ebrowse-electric-choose-tree () + "Return a buffer containing a tree or nil if no tree found or canceled." + (interactive) + (unless (car (ebrowse-known-class-trees-buffer-list)) + (error "No tree buffers")) + (let (select buffer window) + (save-window-excursion + (save-window-excursion (ebrowse-list-tree-buffers)) + (setq window (Electric-pop-up-window "*Tree Buffers*") + buffer (window-buffer window)) + (shrink-window-if-larger-than-buffer window) + (unwind-protect + (progn + (set-buffer buffer) + (ebrowse-electric-list-mode) + (setq select + (catch 'ebrowse-electric-list-select + (message "<<< Press Space to bury the list >>>") + (let ((first (progn (goto-char (point-min)) + (forward-line 2) + (point))) + (last (progn (goto-char (point-max)) + (forward-line -1) + (point))) + (goal-column 0)) + (goto-char first) + (Electric-command-loop 'ebrowse-electric-list-select + nil + t + 'ebrowse-electric-list-looper + (cons first last)))))) + (set-buffer buffer) + (bury-buffer buffer) + (message nil))) + (when select + (set-buffer buffer) + (setq select (ebrowse-electric-get-buffer select))) + (kill-buffer buffer) + select)) + + +(defun ebrowse-electric-list-looper (state condition) + "Prevent cursor from moving beyond the buffer end. +Don't let it move into the title lines. +See 'Electric-command-loop' for a description of STATE and CONDITION." + (cond ((and condition + (not (memq (car condition) + '(buffer-read-only end-of-buffer + beginning-of-buffer)))) + (signal (car condition) (cdr condition))) + ((< (point) (car state)) + (goto-char (point-min)) + (forward-line 2)) + ((> (point) (cdr state)) + (goto-char (point-max)) + (forward-line -1) + (if (pos-visible-in-window-p (point-max)) + (recenter -1))))) + + +(defun ebrowse-electric-list-undefined () + "Function called for keys that are undefined." + (interactive) + (message "Type C-h for help, ? for commands, q to quit, Space to select.") + (sit-for 4)) + + +(defun ebrowse-electric-list-quit () + "Discard the buffer list." + (interactive) + (throw 'ebrowse-electric-list-select nil)) + + +(defun ebrowse-electric-list-select () + "Select a buffer from the buffer list." + (interactive) + (throw 'ebrowse-electric-list-select (point))) + + +(defun ebrowse-electric-get-buffer (point) + "Get a buffer corresponding to the line POINT is in." + (let ((index (- (count-lines (point-min) point) 2))) + (nth index (ebrowse-known-class-trees-buffer-list)))) + + +;;; View a buffer for a tree. + +(defun ebrowse-electric-view-buffer () + "View buffer point is on." + (interactive) + (let ((buffer (ebrowse-electric-get-buffer (point)))) + (cond (buffer + (view-buffer buffer)) + (t + (error "Buffer no longer exists"))))) + + +(defun ebrowse-choose-from-browser-buffers () + "Read a browser buffer name from the minibuffer and return that buffer." + (let* ((buffers (ebrowse-known-class-trees-buffer-list))) + (if buffers + (if (not (second buffers)) + (first buffers) + (or (ebrowse-electric-choose-tree) (error "No tree buffer"))) + (let* ((insert-default-directory t) + (file (read-file-name "Find tree: " nil nil t))) + (save-excursion + (find-file file)) + (find-buffer-visiting file))))) + + +;;; Member buffers + +(unless ebrowse-member-mode-map + (let ((map (make-keymap))) + (setf ebrowse-member-mode-map map) + (suppress-keymap map) + + (when window-system + (define-key map [down-mouse-3] 'ebrowse-member-mouse-3) + (define-key map [mouse-2] 'ebrowse-member-mouse-2)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "C" map1) + (define-key map1 "b" 'ebrowse-switch-member-buffer-to-base-class) + (define-key map1 "c" 'ebrowse-switch-member-buffer-to-any-class) + (define-key map1 "d" 'ebrowse-switch-member-buffer-to-derived-class) + (define-key map1 "n" 'ebrowse-switch-member-buffer-to-next-sibling-class) + (define-key map1 "p" 'ebrowse-switch-member-buffer-to-previous-sibling-class)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "D" map1) + (define-key map1 "a" 'ebrowse-toggle-member-attributes-display) + (define-key map1 "b" 'ebrowse-toggle-base-class-display) + (define-key map1 "f" 'ebrowse-freeze-member-buffer) + (define-key map1 "l" 'ebrowse-toggle-long-short-display) + (define-key map1 "r" 'ebrowse-toggle-regexp-display) + (define-key map1 "w" 'ebrowse-set-member-buffer-column-width)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "F" map1) + (let ((map2 (make-sparse-keymap))) + (suppress-keymap map2 t) + (define-key map1 "a" map2) + (define-key map2 "i" 'ebrowse-toggle-private-member-filter) + (define-key map2 "o" 'ebrowse-toggle-protected-member-filter) + (define-key map2 "u" 'ebrowse-toggle-public-member-filter)) + (define-key map1 "c" 'ebrowse-toggle-const-member-filter) + (define-key map1 "i" 'ebrowse-toggle-inline-member-filter) + (define-key map1 "p" 'ebrowse-toggle-pure-member-filter) + (define-key map1 "r" 'ebrowse-remove-all-member-filters) + (define-key map1 "v" 'ebrowse-toggle-virtual-member-filter)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "L" map1) + (define-key map1 "d" 'ebrowse-display-friends-member-list) + (define-key map1 "f" 'ebrowse-display-function-member-list) + (define-key map1 "F" 'ebrowse-display-static-functions-member-list) + (define-key map1 "n" 'ebrowse-display-next-member-list) + (define-key map1 "p" 'ebrowse-display-previous-member-list) + (define-key map1 "t" 'ebrowse-display-types-member-list) + (define-key map1 "v" 'ebrowse-display-variables-member-list) + (define-key map1 "V" 'ebrowse-display-static-variables-member-list)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "G" map1) + (define-key map1 "m" 'ebrowse-goto-visible-member/all-member-lists) + (define-key map1 "n" 'ebrowse-repeat-member-search) + (define-key map1 "v" 'ebrowse-goto-visible-member)) + + (define-key map "f" 'ebrowse-find-member-declaration) + (define-key map "m" 'ebrowse-switch-to-next-member-buffer) + (define-key map "q" 'bury-buffer) + (define-key map "t" 'ebrowse-show-displayed-class-in-tree) + (define-key map "v" 'ebrowse-view-member-declaration) + (define-key map " " 'ebrowse-view-member-definition) + (define-key map "?" 'describe-mode) + (define-key map "\C-i" 'ebrowse-pop-from-member-to-tree-buffer) + (define-key map "\C-l" 'ebrowse-redisplay-member-buffer) + (define-key map "\C-m" 'ebrowse-find-member-definition))) + + + +;;; Member mode + +;;###autoload +(defun ebrowse-member-mode () + "Major mode for Ebrowse member buffers. + +\\{ebrowse-member-mode-map}" + (kill-all-local-variables) + (use-local-map ebrowse-member-mode-map) + (setq major-mode 'ebrowse-member-mode) + (mapcar 'make-local-variable + '(ebrowse--decl-column ;display column + ebrowse--n-columns ;number of short columns + ebrowse--column-width ;width of columns above + ebrowse--show-inherited-flag ;include inherited members? + ebrowse--filters ;public, protected, private + ebrowse--accessor ;vars, functions, friends + ebrowse--displayed-class ;class displayed + ebrowse--long-display-flag ;display with regexps? + ebrowse--source-regexp-flag ;show source regexp? + ebrowse--attributes-flag ;show `virtual' and `inline' + ebrowse--member-list ;list of members displayed + ebrowse--tree ;the class tree + ebrowse--member-mode-strings ;part of mode line + ebrowse--tags-file-name ; + ebrowse--header + ebrowse--tree-obarray + ebrowse--virtual-display-flag + ebrowse--inline-display-flag + ebrowse--const-display-flag + ebrowse--pure-display-flag + ebrowse--mode-line-props + ebrowse--frozen-flag)) ;buffer not automagically reused + (setq ebrowse--mode-line-props (text-properties-at + 0 (car (default-value + 'mode-line-buffer-identification))) + mode-name "Ebrowse-Members" + mode-line-buffer-identification 'ebrowse--member-mode-strings + buffer-read-only t + ebrowse--long-display-flag nil + ebrowse--attributes-flag t + ebrowse--show-inherited-flag t + ebrowse--source-regexp-flag nil + ebrowse--filters [0 1 2] + ebrowse--decl-column ebrowse-default-declaration-column + ebrowse--column-width ebrowse-default-column-width + ebrowse--virtual-display-flag nil + ebrowse--inline-display-flag nil + ebrowse--const-display-flag nil + ebrowse--pure-display-flag nil) + (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) + (run-hooks 'ebrowse-member-mode-hook)) + + + +;;; Member mode mode line + +(defsubst ebrowse-class-name-displayed-in-member-buffer () + "Return the name of the class displayed in the member buffer." + (ebrowse-cs-name (ebrowse-ts-class ebrowse--displayed-class))) + + +(defsubst ebrowse-member-list-name () + "Return a string describing what is displayed in the member buffer." + (get ebrowse--accessor (if (ebrowse-globals-tree-p ebrowse--displayed-class) + 'ebrowse-global-title + 'ebrowse-title))) + + +(defun ebrowse-update-member-buffer-mode-line () + "Update the mode line of member buffers." + (let* ((name (when ebrowse--frozen-flag + (concat (ebrowse-class-name-displayed-in-member-buffer) + " "))) + (ident (concat name (ebrowse-member-list-name)))) + (setq ebrowse--member-mode-strings + (apply #'propertize ident ebrowse--mode-line-props)) + (ebrowse-rename-buffer (if name ident ebrowse-member-buffer-name)) + (force-mode-line-update))) + + +;;; Misc member buffer commands + +(defun ebrowse-freeze-member-buffer () + "Toggle frozen status of current buffer." + (interactive) + (setq ebrowse--frozen-flag (not ebrowse--frozen-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-show-displayed-class-in-tree (arg) + "Show the currently displayed class in the tree window. +With prefix ARG, switch to the tree buffer else pop to it." + (interactive "P") + (let ((class-name (ebrowse-class-name-displayed-in-member-buffer))) + (when (ebrowse-pop-from-member-to-tree-buffer arg) + (ebrowse-read-class-name-and-go class-name)))) + + +(defun ebrowse-set-member-buffer-column-width () + "Set the column width of the member display. +The new width is read from the minibuffer." + (interactive) + (let ((width (string-to-int + (read-from-minibuffer + (concat "Column width (" + (int-to-string (if ebrowse--long-display-flag + ebrowse--decl-column + ebrowse--column-width)) + "): "))))) + (when (plusp width) + (if ebrowse--long-display-flag + (setq ebrowse--decl-column width) + (setq ebrowse--column-width width)) + (ebrowse-redisplay-member-buffer)))) + + +(defun ebrowse-pop-from-member-to-tree-buffer (arg) + "Pop from a member buffer to the matching tree buffer. +Switch to the buffer if prefix ARG. If no tree buffer exists, +make one." + (interactive "P") + (let ((buf (or (get-buffer (ebrowse-frozen-tree-buffer-name + ebrowse--tags-file-name)) + (get-buffer ebrowse-tree-buffer-name) + (ebrowse-create-tree-buffer ebrowse--tree + ebrowse--tags-file-name + ebrowse--header + ebrowse--tree-obarray + 'pop)))) + (and buf + (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf)) + buf)) + + + +;;; Switching between member lists + +(defun ebrowse-display-member-list-for-accessor (accessor) + "Switch the member buffer to display the member list for ACCESSOR." + (setf ebrowse--accessor accessor + ebrowse--member-list (funcall accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-cyclic-display-next/previous-member-list (incr) + "Switch buffer to INCR'th next/previous list of members." + (let ((index (ebrowse-position ebrowse--accessor + ebrowse-member-list-accessors))) + (setf ebrowse--accessor + (cond ((plusp incr) + (or (nth (1+ index) + ebrowse-member-list-accessors) + (first ebrowse-member-list-accessors))) + ((minusp incr) + (or (and (>= (decf index) 0) + (nth index + ebrowse-member-list-accessors)) + (first (last ebrowse-member-list-accessors)))))) + (ebrowse-display-member-list-for-accessor ebrowse--accessor))) + + +(defun ebrowse-display-next-member-list () + "Switch buffer to next member list." + (interactive) + (ebrowse-cyclic-display-next/previous-member-list 1)) + + +(defun ebrowse-display-previous-member-list () + "Switch buffer to previous member list." + (interactive) + (ebrowse-cyclic-display-next/previous-member-list -1)) + + +(defun ebrowse-display-function-member-list () + "Display the list of member functions." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions)) + + +(defun ebrowse-display-variables-member-list () + "Display the list of member variables." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables)) + + +(defun ebrowse-display-static-variables-member-list () + "Display the list of static member variables." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables)) + + +(defun ebrowse-display-static-functions-member-list () + "Display the list of static member functions." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions)) + + +(defun ebrowse-display-friends-member-list () + "Display the list of friends." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends)) + + +(defun ebrowse-display-types-member-list () + "Display the list of types." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types)) + + + +;;; Filters and other display attributes + +(defun ebrowse-toggle-member-attributes-display () + "Toggle display of `virtual', `inline', `const' etc." + (interactive) + (setq ebrowse--attributes-flag (not ebrowse--attributes-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-base-class-display () + "Toggle the display of members inherited from base classes." + (interactive) + (setf ebrowse--show-inherited-flag (not ebrowse--show-inherited-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-pure-member-filter () + "Toggle display of pure virtual members." + (interactive) + (setf ebrowse--pure-display-flag (not ebrowse--pure-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-const-member-filter () + "Toggle display of const members." + (interactive) + (setf ebrowse--const-display-flag (not ebrowse--const-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-inline-member-filter () + "Toggle display of inline members." + (interactive) + (setf ebrowse--inline-display-flag (not ebrowse--inline-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-virtual-member-filter () + "Toggle display of virtual members." + (interactive) + (setf ebrowse--virtual-display-flag (not ebrowse--virtual-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-remove-all-member-filters () + "Remove all filters." + (interactive) + (dotimes (i 3) + (aset ebrowse--filters i i)) + (setq ebrowse--pure-display-flag nil + ebrowse--const-display-flag nil + ebrowse--virtual-display-flag nil + ebrowse--inline-display-flag nil) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-public-member-filter () + "Toggle visibility of public members." + (interactive) + (ebrowse-set-member-access-visibility 0) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-protected-member-filter () + "Toggle visibility of protected members." + (interactive) + (ebrowse-set-member-access-visibility 1) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-private-member-filter () + "Toggle visibility of private members." + (interactive) + (ebrowse-set-member-access-visibility 2) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-set-member-access-visibility (vis) + (setf (aref ebrowse--filters vis) + (if (aref ebrowse--filters vis) nil vis))) + + +(defun ebrowse-toggle-long-short-display () + "Toggle between long and short display form of member buffers." + (interactive) + (setf ebrowse--long-display-flag (not ebrowse--long-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-regexp-display () + "Toggle declaration/definition regular expression display. +Used in member buffers showing the long display form." + (interactive) + (setf ebrowse--source-regexp-flag (not ebrowse--source-regexp-flag)) + (ebrowse-redisplay-member-buffer)) + + + +;;; Viewing/finding members + +(defun ebrowse-find-member-definition (&optional prefix) + "Find the file containing a member definition. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame." + (interactive "p") + (ebrowse-view/find-member-declaration/definition prefix nil t)) + + +(defun ebrowse-view-member-definition (prefix) + "View the file containing a member definition. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame." + (interactive "p") + (ebrowse-view/find-member-declaration/definition prefix t t)) + + +(defun ebrowse-find-member-declaration (prefix) + "Find the file containing a member's declaration. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame." + (interactive "p") + (ebrowse-view/find-member-declaration/definition prefix nil)) + + +(defun ebrowse-view-member-declaration (prefix) + "View the file containing a member's declaration. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame." + (interactive "p") + (ebrowse-view/find-member-declaration/definition prefix t)) + + +(defun* ebrowse-view/find-member-declaration/definition + (prefix view &optional definition info header tags-file-name) + "Find or view a member declaration or definition. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame. +DEFINITION non-nil means find the definition, otherwise find the +declaration. +INFO is a list (TREE ACCESSOR MEMBER) describing the member to +search. +TAGS-FILE-NAME is the file name of the EBROWSE file." + (unless header + (setq header ebrowse--header)) + (unless tags-file-name + (setq tags-file-name ebrowse--tags-file-name)) + (let (tree member accessor file on-class + (where (if (= prefix 4) 'other-window + (if (= prefix 5) 'other-frame 'this-window)))) + ;; If not given as parameters, get the necessary information + ;; out of the member buffer. + (if info + (setq tree (first info) + accessor (second info) + member (third info)) + (multiple-value-setq (tree member on-class) + (ebrowse-member-info-from-point)) + (setq accessor ebrowse--accessor)) + ;; View/find class if on a line containing a class name. + (when on-class + (return-from ebrowse-view/find-member-declaration/definition + (ebrowse-view/find-file-and-search-pattern + (ebrowse-ts-class tree) + (list ebrowse--header (ebrowse-ts-class tree) nil) + (ebrowse-cs-file (ebrowse-ts-class tree)) + tags-file-name view where))) + ;; For some member lists, it doesn't make sense to search for + ;; a definition. If this is requested, silently search for the + ;; declaration. + (when (and definition + (eq accessor 'ebrowse-ts-member-variables)) + (setq definition nil)) + ;; Construct a suitable `browse' struct for definitions. + (when definition + (setf member (make-ebrowse-ms + :name (ebrowse-ms-name member) + :file (ebrowse-ms-definition-file member) + :pattern (ebrowse-ms-definition-pattern + member) + :flags (ebrowse-ms-flags member) + :point (ebrowse-ms-definition-point + member)))) + ;; When no file information in member, use that of the class + (setf file (or (ebrowse-ms-file member) + (if definition + (ebrowse-cs-source-file (ebrowse-ts-class tree)) + (ebrowse-cs-file (ebrowse-ts-class tree))))) + ;; When we have no regular expressions in the database the only + ;; indication that the parser hasn't seen a definition/declaration + ;; is that the search start point will be zero. + (if (or (null file) (zerop (ebrowse-ms-point member))) + (if (y-or-n-p (concat "No information about " + (if definition "definition" "declaration") + ". Search for " + (if definition "declaration" "definition") + " of `" + (ebrowse-ms-name member) + "'? ")) + (progn + (message nil) + ;; Recurse with new info. + (ebrowse-view/find-member-declaration/definition + prefix view (not definition) info header tags-file-name)) + (error "Search canceled")) + ;; Find that thing. + (ebrowse-view/find-file-and-search-pattern + (make-ebrowse-bs :name (ebrowse-ms-name member) + :pattern (ebrowse-ms-pattern member) + :file (ebrowse-ms-file member) + :flags (ebrowse-ms-flags member) + :point (ebrowse-ms-point member)) + (list header member accessor) + file + tags-file-name + view + where)))) + + + +;;; Drawing the member buffer + +(defun ebrowse-redisplay-member-buffer () + "Force buffer redisplay." + (interactive) + (let ((display-fn (if ebrowse--long-display-flag + 'ebrowse-draw-member-long-fn + 'ebrowse-draw-member-short-fn))) + (ebrowse-output + (erase-buffer) + ;; Show this class + (ebrowse-draw-member-buffer-class-line) + (funcall display-fn ebrowse--member-list ebrowse--displayed-class) + ;; Show inherited members if corresponding switch is on + (when ebrowse--show-inherited-flag + (dolist (super (ebrowse-base-classes ebrowse--displayed-class)) + (goto-char (point-max)) + (insert (if (bolp) "\n\n" "\n")) + (ebrowse-draw-member-buffer-class-line super) + (funcall display-fn (funcall ebrowse--accessor super) super))) + (ebrowse-update-member-buffer-mode-line)))) + + +(defun ebrowse-draw-member-buffer-class-line (&optional class) + "Display the title line for a class section in the member buffer. +CLASS non-nil means display that class' title. Otherwise use +the class cursor is on." + (let ((start (point)) + (tree (or class ebrowse--displayed-class)) + class-name-start + class-name-end) + (insert "class ") + (setq class-name-start (point)) + (insert (ebrowse-qualified-class-name (ebrowse-ts-class tree))) + (when (ebrowse-template-p (ebrowse-ts-class tree)) + (insert "<>")) + (setq class-name-end (point)) + (insert ":\n\n") + (ebrowse-set-face start (point) 'ebrowse-member-class-face) + (add-text-properties + class-name-start class-name-end + '(ebrowse-what class-name + mouse-face highlight + help-echo "mouse-3: menu")) + (put-text-property start class-name-end 'ebrowse-tree tree))) + + +(defun ebrowse-display-member-buffer (list &optional stand-alone class) + "Start point for member buffer creation. +LIST is the member list to display. STAND-ALONE non-nil +means the member buffer is standalone. CLASS is its class." + (let* ((classes ebrowse--tree-obarray) + (tree ebrowse--tree) + (tags-file-name ebrowse--tags-file-name) + (header ebrowse--header) + temp-buffer-setup-hook + (temp-buffer (get-buffer ebrowse-member-buffer-name))) + ;; Get the class description from the name the cursor + ;; is on if not specified as an argument. + (unless class + (setq class (ebrowse-tree-at-point))) + (with-output-to-temp-buffer ebrowse-member-buffer-name + (save-excursion + (set-buffer standard-output) + ;; If new buffer, set the mode and initial values of locals + (unless temp-buffer + (ebrowse-member-mode)) + ;; Set local variables + (setq ebrowse--member-list (funcall list class) + ebrowse--displayed-class class + ebrowse--accessor list + ebrowse--tree-obarray classes + ebrowse--frozen-flag stand-alone + ebrowse--tags-file-name tags-file-name + ebrowse--header header + ebrowse--tree tree + buffer-read-only t) + (ebrowse-redisplay-member-buffer) + (current-buffer))))) + + +(defun ebrowse-member-display-p (member) + "Return t if MEMBER must be displayed under the current filter settings." + (if (and (aref ebrowse--filters (ebrowse-ms-visibility member)) + (or (null ebrowse--const-display-flag) + (ebrowse-const-p member)) + (or (null ebrowse--inline-display-flag) + (ebrowse-inline-p member)) + (or (null ebrowse--pure-display-flag) + (ebrowse-bs-p member)) + (or (null ebrowse--virtual-display-flag) + (ebrowse-virtual-p member))) + member)) + + +(defun ebrowse-draw-member-attributes (member) + "Insert a string for the attributes of MEMBER." + (insert (if (ebrowse-template-p member) "T" "-") + (if (ebrowse-extern-c-p member) "C" "-") + (if (ebrowse-virtual-p member) "v" "-") + (if (ebrowse-inline-p member) "i" "-") + (if (ebrowse-const-p member) "c" "-") + (if (ebrowse-pure-virtual-p member) "0" "-") + (if (ebrowse-mutable-p member) "m" "-") + (if (ebrowse-explicit-p member) "e" "-") + (if (ebrowse-throw-list-p member) "t" "-"))) + + +(defun ebrowse-draw-member-regexp (member-struc) + "Insert a string for the regular expression matching MEMBER-STRUC." + (let ((pattern (if ebrowse--source-regexp-flag + (ebrowse-ms-definition-pattern + member-struc) + (ebrowse-ms-pattern member-struc)))) + (cond ((stringp pattern) + (insert (ebrowse-trim-string pattern) "...\n") + (beginning-of-line 0) + (move-to-column (+ 4 ebrowse--decl-column)) + (while (re-search-forward "[ \t]+" nil t) + (delete-region (match-beginning 0) (match-end 0)) + (insert " ")) + (beginning-of-line 2)) + (t + (insert "[not recorded or unknown]\n"))))) + + +(defun ebrowse-draw-member-long-fn (member-list tree) + "Display member buffer for MEMBER-LIST in long form. +TREE is the class tree of MEMBER-LIST." + (dolist (member-struc (mapcar 'ebrowse-member-display-p member-list)) + (when member-struc + (let ((name (ebrowse-ms-name member-struc)) + (start (point))) + ;; Insert member name truncated to the right length + (insert (substring name + 0 + (min (length name) + (1- ebrowse--decl-column)))) + (add-text-properties + start (point) + `(mouse-face highlight ebrowse-what member-name + ebrowse-member ,member-struc + ebrowse-tree ,tree + help-echo "mouse-2: view definition; mouse-3: menu")) + ;; Display virtual, inline, and const status + (setf start (point)) + (indent-to ebrowse--decl-column) + (put-text-property start (point) 'mouse-face nil) + (when ebrowse--attributes-flag + (let ((start (point))) + (insert "<") + (ebrowse-draw-member-attributes member-struc) + (insert ">") + (ebrowse-set-face start (point) + 'ebrowse-member-attribute-face))) + (insert " ") + (ebrowse-draw-member-regexp member-struc)))) + (insert "\n") + (goto-char (point-min))) + + +(defun ebrowse-draw-member-short-fn (member-list tree) + "Display MEMBER-LIST in short form. +TREE is the class tree in which the members are found." + (let ((i 0) + (column-width (+ ebrowse--column-width + (if ebrowse--attributes-flag 12 0)))) + ;; Get the number of columns to draw. + (setq ebrowse--n-columns + (max 1 (/ (ebrowse-width-of-drawable-area) column-width))) + (dolist (member (mapcar #'ebrowse-member-display-p member-list)) + (when member + (let ((name (ebrowse-ms-name member)) + start-of-entry + (start-of-column (point)) + start-of-name) + (indent-to (* i column-width)) + (put-text-property start-of-column (point) 'mouse-face nil) + (setq start-of-entry (point)) + ;; Show various attributes + (when ebrowse--attributes-flag + (insert "<") + (ebrowse-draw-member-attributes member) + (insert "> ") + (ebrowse-set-face start-of-entry (point) + 'ebrowse-member-attribute-face)) + ;; insert member name truncated to column width + (setq start-of-name (point)) + (insert (substring name 0 + (min (length name) + (1- ebrowse--column-width)))) + ;; set text properties + (add-text-properties + start-of-name (point) + `(ebrowse-what member-name + ebrowse-member ,member + mouse-face highlight + ebrowse-tree ,tree + help-echo "mouse-2: view definition; mouse-3: menu")) + (incf i) + (when (>= i ebrowse--n-columns) + (setf i 0) + (insert "\n"))))) + (when (plusp i) + (insert "\n")) + (goto-char (point-min)))) + + + +;;; Killing members from tree + +(defun ebrowse-member-info-from-point () + "Ger information about the member at point. +The result has the form (TREE MEMBER NULL-P). TREE is the tree +we're in, MEMBER is the member we're on. NULL-P is t if MEMBER +is nil." + (let ((tree (or (get-text-property (point) 'ebrowse-tree) + (error "No information at point"))) + (member (get-text-property (point) 'ebrowse-member))) + (list tree member (null member)))) + + + +;;; Switching member buffer to display a selected member + +(defun ebrowse-goto-visible-member/all-member-lists (prefix) + "Position cursor on a member read from the minibuffer. +With PREFIX, search all members in the tree. Otherwise consider +only members visible in the buffer." + (interactive "p") + (ebrowse-ignoring-completion-case + (let* ((completion-list (ebrowse-name/accessor-alist-for-class-members)) + (member (completing-read "Goto member: " completion-list nil t)) + (accessor (cdr (assoc member completion-list)))) + (unless accessor + (error "`%s' not found" member)) + (unless (eq accessor ebrowse--accessor) + (setf ebrowse--accessor accessor + ebrowse--member-list (funcall accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer)) + (ebrowse-move-point-to-member member)))) + + +(defun ebrowse-goto-visible-member (repeat) + "Position point on a member. +Read the member's name from the minibuffer. Consider only members +visible in the member buffer. +REPEAT non-nil means repeat the search that number of times." + (interactive "p") + (ebrowse-ignoring-completion-case + ;; Read member name + (let* ((completion-list (ebrowse-name/accessor-alist-for-visible-members)) + (member (completing-read "Goto member: " completion-list nil t))) + (ebrowse-move-point-to-member member repeat)))) + + + +;;; Searching a member in the member buffer + +(defun ebrowse-repeat-member-search (repeat) + "Repeat the last regular expression search. +REPEAT, if specified, says repeat the search REPEAT times." + (interactive "p") + (unless ebrowse--last-regexp + (error "No regular expression remembered")) + ;; Skip over word the point is on + (skip-chars-forward "^ \t\n") + ;; Search for regexp from point + (if (re-search-forward ebrowse--last-regexp nil t repeat) + (progn + (goto-char (match-beginning 0)) + (skip-chars-forward " \t\n")) + ;; If not found above, repeat search from buffer start + (goto-char (point-min)) + (if (re-search-forward ebrowse--last-regexp nil t) + (progn + (goto-char (match-beginning 0)) + (skip-chars-forward " \t\n")) + (error "Not found")))) + + +(defun* ebrowse-move-point-to-member (name &optional count &aux member) + "Set point on member NAME in the member buffer +COUNT, if specified, says search the COUNT'th member with the same name." + (goto-char (point-min)) + (widen) + (setq member + (substring name 0 (min (length name) (1- ebrowse--column-width))) + ebrowse--last-regexp + (concat "[ \t\n]" (regexp-quote member) "[ \n\t]")) + (if (re-search-forward ebrowse--last-regexp nil t count) + (goto-char (1+ (match-beginning 0))) + (error "Not found"))) + + + +;;; Switching member buffer to another class. + +(defun ebrowse-switch-member-buffer-to-other-class (title compl-list) + "Switch member buffer to a class read from the minibuffer. +Use TITLE as minibuffer prompt. +COMPL-LIST is a completion list to use." + (let* ((initial (unless (second compl-list) + (first (first compl-list)))) + (class (or (ebrowse-completing-read-value title compl-list initial) + (error "Not found")))) + (setf ebrowse--displayed-class class + ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer))) + + +(defun ebrowse-switch-member-buffer-to-any-class () + "Switch member buffer to a class read from the minibuffer." + (interactive) + (ebrowse-switch-member-buffer-to-other-class + "Goto class: " (ebrowse-tree-obarray-as-alist))) + + +(defun ebrowse-switch-member-buffer-to-base-class (arg) + "Switch buffer to ARG'th base class." + (interactive "P") + (let ((supers (or (ebrowse-direct-base-classes ebrowse--displayed-class) + (error "No base classes")))) + (if (and arg (second supers)) + (let ((alist (loop for s in supers + collect (cons (ebrowse-qualified-class-name + (ebrowse-ts-class s)) + s)))) + (ebrowse-switch-member-buffer-to-other-class + "Goto base class: " alist)) + (setq ebrowse--displayed-class (first supers) + ebrowse--member-list + (funcall ebrowse--accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer)))) + +(defun ebrowse-switch-member-buffer-to-next-sibling-class (arg) + "Move to ARG'th next sibling." + (interactive "p") + (ebrowse-switch-member-buffer-to-sibling-class arg)) + + +(defun ebrowse-switch-member-buffer-to-previous-sibling-class (arg) + "Move to ARG'th previous sibling." + (interactive "p") + (ebrowse-switch-member-buffer-to-sibling-class (- arg))) + + +(defun ebrowse-switch-member-buffer-to-sibling-class (inc) + "Switch member display to nth sibling class. +Prefix arg INC specifies which one." + (interactive "p") + (let ((containing-list ebrowse--tree) + index cls + (supers (ebrowse-direct-base-classes ebrowse--displayed-class))) + (flet ((trees-alist (trees) + (loop for tr in trees + collect (cons (ebrowse-cs-name + (ebrowse-ts-class tr)) tr)))) + (when supers + (let ((tree (if (second supers) + (ebrowse-completing-read-value + "Relative to base class: " + (trees-alist supers) nil) + (first supers)))) + (unless tree (error "Not found")) + (setq containing-list (ebrowse-ts-subclasses tree))))) + (setq index (+ inc (ebrowse-position ebrowse--displayed-class + containing-list))) + (cond ((minusp index) (message "No previous class")) + ((null (nth index containing-list)) (message "No next class"))) + (setq index (max 0 (min index (1- (length containing-list))))) + (setq cls (nth index containing-list)) + (setf ebrowse--displayed-class cls + ebrowse--member-list (funcall ebrowse--accessor cls)) + (ebrowse-redisplay-member-buffer))) + + +(defun ebrowse-switch-member-buffer-to-derived-class (arg) + "Switch member display to nth derived class. +Prefix arg ARG says which class should be displayed. Default is +the first derived class." + (interactive "P") + (flet ((ebrowse-tree-obarray-as-alist () + (loop for s in (ebrowse-ts-subclasses + ebrowse--displayed-class) + collect (cons (ebrowse-cs-name + (ebrowse-ts-class s)) s)))) + (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class) + (error "No derived classes")))) + (if (and arg (second subs)) + (ebrowse-switch-member-buffer-to-other-class + "Goto derived class: " (ebrowse-tree-obarray-as-alist)) + (setq ebrowse--displayed-class (first subs) + ebrowse--member-list + (funcall ebrowse--accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer))))) + + + +;;; Member buffer mouse functions + +(defun ebrowse-displaying-functions () + (eq ebrowse--accessor 'ebrowse-ts-member-functions)) +(defun ebrowse-displaying-variables () + (eq ebrowse--accessor 'ebrowse-ts-member-variables)) +(defun ebrowse-displaying-static-functions () + ) +(defun ebrowse-displaying-static-variables () + ) +(defun ebrowse-displaying-types () + (eq ebrowse--accessor 'ebrowse-ts-types)) +(defun ebrowse-displaying-friends () + (eq ebrowse--accessor 'ebrowse-ts-friends)) + +(easy-menu-define + ebrowse-member-buffer-object-menu ebrowse-member-mode-map + "Object menu for the member buffer itself." + '("Members" + ("Members List" + ["Functions" ebrowse-display-function-member-list + :help "Show the list of member functions" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-member-functions) + :active t] + ["Variables" ebrowse-display-variables-member-list + :help "Show the list of member variables" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-member-variables) + :active t] + ["Static Functions" ebrowse-display-static-functions-member-list + :help "Show the list of static member functions" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-static-functions) + :active t] + ["Static Variables" ebrowse-display-static-variables-member-list + :help "Show the list of static member variables" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-static-variables) + :active t] + ["Types" ebrowse-display-types-member-list + :help "Show the list of nested types" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-types) + :active t] + ["Friends/Defines" ebrowse-display-friends-member-list + :help "Show the list of friends or defines" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-friends) + :active t]) + ("Class" + ["Up" ebrowse-switch-member-buffer-to-base-class + :help "Show the base class of this class" + :active t] + ["Down" ebrowse-switch-member-buffer-to-derived-class + :help "Show a derived class class of this class" + :active t] + ["Next Sibling" ebrowse-switch-member-buffer-to-next-sibling-class + :help "Show the next sibling class" + :active t] + ["Previous Sibling" ebrowse-switch-member-buffer-to-previous-sibling-class + :help "Show the previous sibling class" + :active t]) + ("Member" + ["Show in Tree" ebrowse-show-displayed-class-in-tree + :help "Show this class in the class tree" + :active t] + ["Find in this Class" ebrowse-goto-visible-member + :help "Search for a member of this class" + :active t] + ["Find in Tree" ebrowse-goto-visible-member/all-member-lists + :help "Search for a member in any class" + :active t]) + ("Display" + ["Inherited" ebrowse-toggle-base-class-display + :help "Toggle display of inherited members" + :style toggle + :selected ebrowse--show-inherited-flag + :active t] + ["Attributes" ebrowse-toggle-member-attributes-display + :help "Show member attributes" + :style toggle + :selected ebrowse--attributes-flag + :active t] + ["Long Display" ebrowse-toggle-long-short-display + :help "Toggle the member display format" + :style toggle + :selected ebrowse--long-display-flag + :active t] + ["Column Width" ebrowse-set-member-buffer-column-width + :help "Set the display's column width" + :active t]) + ("Filter" + ["Public" ebrowse-toggle-public-member-filter + :help "Toggle the visibility of public members" + :style toggle + :selected (not (aref ebrowse--filters 0)) + :active t] + ["Protected" ebrowse-toggle-protected-member-filter + :help "Toggle the visibility of protected members" + :style toggle + :selected (not (aref ebrowse--filters 1)) + :active t] + ["Private" ebrowse-toggle-private-member-filter + :help "Toggle the visibility of private members" + :style toggle + :selected (not (aref ebrowse--filters 2)) + :active t] + ["Virtual" ebrowse-toggle-virtual-member-filter + :help "Toggle the visibility of virtual members" + :style toggle + :selected ebrowse--virtual-display-flag + :active t] + ["Inline" ebrowse-toggle-inline-member-filter + :help "Toggle the visibility of inline members" + :style toggle + :selected ebrowse--inline-display-flag + :active t] + ["Const" ebrowse-toggle-const-member-filter + :help "Toggle the visibility of const members" + :style toggle + :selected ebrowse--const-display-flag + :active t] + ["Pure" ebrowse-toggle-pure-member-filter + :help "Toggle the visibility of pure virtual members" + :style toggle + :selected ebrowse--pure-display-flag + :active t] + "-----------------" + ["Show all" ebrowse-remove-all-member-filters + :help "Remove any display filters" + :active t]) + ("Buffer" + ["Tree" ebrowse-pop-from-member-to-tree-buffer + :help "Pop to the class tree buffer" + :active t] + ["Next Member Buffer" ebrowse-switch-to-next-member-buffer + :help "Switch to the next member buffer of this class tree" + :active t] + ["Freeze" ebrowse-freeze-member-buffer + :help "Freeze (do not reuse) this member buffer" + :active t]))) + + +(defun ebrowse-on-class-name () + "Value is non-nil if point is on a class name." + (eq (get-text-property (point) 'ebrowse-what) 'class-name)) + + +(defun ebrowse-on-member-name () + "Value is non-nil if point is on a member name." + (eq (get-text-property (point) 'ebrowse-what) 'member-name)) + + +(easy-menu-define + ebrowse-member-class-name-object-menu ebrowse-member-mode-map + "Object menu for class names in member buffer." + '("Class" + ["Find" ebrowse-find-member-definition + :help "Find this class in the source files" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + ["View" ebrowse-view-member-definition + :help "View this class in the source files" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)])) + + +(easy-menu-define + ebrowse-member-name-object-menu ebrowse-member-mode-map + "Object menu for member names" + '("Ebrowse" + ["Find Definition" ebrowse-find-member-definition + :help "Find this member's definition in the source files" + :active (ebrowse-on-member-name)] + ["Find Declaration" ebrowse-find-member-declaration + :help "Find this member's declaration in the source files" + :active (ebrowse-on-member-name)] + ["View Definition" ebrowse-view-member-definition + :help "View this member's definition in the source files" + :active (ebrowse-on-member-name)] + ["View Declaration" ebrowse-view-member-declaration + :help "View this member's declaration in the source files" + :active (ebrowse-on-member-name)])) + + +(defun ebrowse-member-mouse-3 (event) + "Handle `mouse-3' events in member buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (case (event-click-count event) + (2 (ebrowse-find-member-definition)) + (1 (case (get-text-property (posn-point (event-start event)) + 'ebrowse-what) + (member-name + (ebrowse-popup-menu ebrowse-member-name-object-menu event)) + (class-name + (ebrowse-popup-menu ebrowse-member-class-name-object-menu event)) + (t + (ebrowse-popup-menu ebrowse-member-buffer-object-menu event)))))) + + +(defun ebrowse-member-mouse-2 (event) + "Handle `mouse-2' events in member buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (case (event-click-count event) + (2 (ebrowse-find-member-definition)) + (1 (case (get-text-property (posn-point (event-start event)) + 'ebrowse-what) + (member-name + (ebrowse-view-member-definition 0)))))) + + + +;;; Tags view/find + +(defun ebrowse-class-alist-for-member (tree-header name) + "Return information about a member in a class tree. +TREE-HEADER is the header structure of the class tree. +NAME is the name of the member. +Value is an alist of elements (CLASS-NAME . (CLASS LIST NAME)), +where each element describes one occurrence of member NAME in the tree. +CLASS-NAME is the qualified name of the class in which the +member was found. The CDR of the acons is described in function +`ebrowse-class/index/member-for-member'." + (let ((table (ebrowse-member-table tree-header)) + known-classes + alist) + (when name + (dolist (info (gethash name table) alist) + (unless (memq (first info) known-classes) + (setf alist (acons (ebrowse-qualified-class-name + (ebrowse-ts-class (first info))) + info alist) + known-classes (cons (first info) known-classes))))))) + + +(defun ebrowse-choose-tree () + "Choose a class tree to use. +If there's more than one class tree loaded, let the user choose +the one he wants. Value is (TREE HEADER BUFFER), with TREE being +the class tree, HEADER the header structure of the tree, and BUFFER +being the tree or member buffer containing the tree." + (let* ((buffer (ebrowse-choose-from-browser-buffers))) + (if buffer (list (ebrowse-value-in-buffer 'ebrowse--tree buffer) + (ebrowse-value-in-buffer 'ebrowse--header buffer) + buffer)))) + + +(defun ebrowse-tags-read-name (header prompt) + "Read a C++ identifier from the minibuffer. +HEADER is the `ebrowse-hs' structure of the class tree. +Prompt with PROMPT. Insert into the minibuffer a C++ identifier read +from point as default. Value is a list (CLASS-NAME MEMBER-NAME)." + (save-excursion + (let* (start member-info (members (ebrowse-member-table header))) + (multiple-value-bind (class-name member-name) + (ebrowse-tags-read-member+class-name) + (unless member-name + (error "No member name at point")) + (if members + (let* ((alist (ebrowse-hash-table-to-alist members)) + (name (ebrowse-ignoring-completion-case + (completing-read prompt alist nil nil member-name))) + (completion-result (try-completion name alist))) + ;; Cannot rely on `try-completion' returning T for exact + ;; matches! it returns the the name as a string. + (unless (setq member-info (gethash name members)) + (if (y-or-n-p "No exact match found. Try substrings? ") + (setq name + (or (first (ebrowse-list-of-matching-members + members (regexp-quote name) name)) + (error "Sorry, nothing found"))) + (error "Canceled"))) + (list class-name name)) + (list class-name (read-from-minibuffer prompt member-name))))))) + + +(defun ebrowse-tags-read-member+class-name () + "Read a C++ identifier from point. +Value is (CLASS-NAME MEMBER-NAME). +CLASS-NAME is the name of the class if the identifier was qualified. +It is nil otherwise. +MEMBER-NAME is the name of the member found." + (save-excursion + (skip-chars-backward "a-zA-Z0-9_") + (let* ((start (point)) + (name (progn (skip-chars-forward "a-zA-Z0-9_") + (buffer-substring start (point)))) + class) + (list class name)))) + + +(defun ebrowse-tags-choose-class (tree header name initial-class-name) + "Read a class name for a member from the minibuffer. +TREE is the class tree we operate on. +HEADER is its header structure. +NAME is the name of the member. +INITIAL-CLASS-NAME is an initial class name to insert in the minibuffer. +Value is a list (TREE ACCESSOR MEMBER) for the member." + (let ((alist (or (ebrowse-class-alist-for-member header name) + (error "No classes with member `%s' found" name)))) + (ebrowse-ignoring-completion-case + (if (null (second alist)) + (cdr (first alist)) + (push ?\? unread-command-events) + (cdr (assoc (completing-read "In class: " + alist nil t initial-class-name) + alist)))))) + + +(defun* ebrowse-tags-view/find-member-decl/defn + (prefix &key view definition member-name) + "If VIEW is t, view, else find an occurrence of MEMBER-NAME. + +If DEFINITION is t, find or view the member definition else its +declaration. This function reads the member's name from the +current buffer like FIND-TAG. It then prepares a completion list +of all classes containing a member with the given name and lets +the user choose the class to use. As a last step, a tags search +is performed that positions point on the member declaration or +definition." + (multiple-value-bind + (tree header tree-buffer) (ebrowse-choose-tree) + (unless tree (error "No class tree")) + (let* ((marker (point-marker)) + class-name + (name member-name) + info) + (unless name + (multiple-value-setq (class-name name) + (ebrowse-tags-read-name + header + (concat (if view "View" "Find") " member " + (if definition "definition" "declaration") ": ")))) + (setq info (ebrowse-tags-choose-class tree header name class-name)) + (ebrowse-push-position marker info) + ;; Goto the occurrence of the member + (ebrowse-view/find-member-declaration/definition + prefix view definition info + header + (ebrowse-value-in-buffer 'ebrowse--tags-file-name tree-buffer)) + ;; Record position jumped to + (ebrowse-push-position (point-marker) info t)))) + + +;;###autoload +(defun ebrowse-tags-view-declaration () + "View declaration of member at point." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 0 :view t :definition nil)) + + +;;###autoload +(defun ebrowse-tags-find-declaration () + "Find declaration of member at point." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 0 :view nil :definition nil)) + + +;;###autoload +(defun ebrowse-tags-view-definition () + "View definition of member at point." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 0 :view t :definition t)) + + +;;###autoload +(defun ebrowse-tags-find-definition () + "Find definition of member at point." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 0 :view nil :definition t)) + + +(defun ebrowse-tags-view-declaration-other-window () + "View declaration of member at point in other window." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 4 :view t :definition nil)) + + +;;###autoload +(defun ebrowse-tags-find-declaration-other-window () + "Find declaration of member at point in other window." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 4 :view nil :definition nil)) + + +;;###autoload +(defun ebrowse-tags-view-definition-other-window () + "View definition of member at point in other window." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 4 :view t :definition t)) + + +;;###autoload +(defun ebrowse-tags-find-definition-other-window () + "Find definition of member at point in other window." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 4 :view nil :definition t)) + + +(defun ebrowse-tags-view-declaration-other-frame () + "View definition of member at point in other frame." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 5 :view t :definition nil)) + + +;;###autoload +(defun ebrowse-tags-find-declaration-other-frame () + "Find definition of member at point in other frame." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 5 :view nil :definition nil)) + + +;;###autoload +(defun ebrowse-tags-view-definition-other-frame () + "View definition of member at point in other frame." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 5 :view t :definition t)) + + +;;###autoload +(defun ebrowse-tags-find-definition-other-frame () + "Find definition of member at point in other frame." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 5 :view nil :definition t)) + + +(defun ebrowse-tags-select/create-member-buffer (tree-buffer info) + "Select or create member buffer. +TREE-BUFFER specifies the tree to use. INFO describes the member. +It is a list (TREE ACCESSOR MEMBER)." + (let ((buffer (get-buffer ebrowse-member-buffer-name))) + (cond ((null buffer) + (set-buffer tree-buffer) + (switch-to-buffer (ebrowse-display-member-buffer + (second info) nil (first info)))) + (t + (switch-to-buffer buffer) + (setq ebrowse--displayed-class (first info) + ebrowse--accessor (second info) + ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer))) + (ebrowse-move-point-to-member (ebrowse-ms-name (third info))))) + + +(defun ebrowse-tags-display-member-buffer (&optional fix-name) + "Display a member buffer for a member. +FIX-NAME non-nil means display the buffer for that member. +Otherwise read a member name from point." + (interactive) + (multiple-value-bind + (tree header tree-buffer) (ebrowse-choose-tree) + (unless tree (error "No class tree")) + (let* ((marker (point-marker)) class-name (name fix-name) info) + (unless name + (multiple-value-setq (class-name name) + (ebrowse-tags-read-name header + (concat "Find member list of: ")))) + (setq info (ebrowse-tags-choose-class tree header name class-name)) + (ebrowse-push-position marker info) + (ebrowse-tags-select/create-member-buffer tree-buffer info)))) + + +(defun ebrowse-list-of-matching-members (members regexp &optional name) + "Return a list of members in table MEMBERS matching REGEXP or NAME. +Both NAME and REGEXP may be nil in which case exact or regexp matches +are not performed." + (let (list) + (when (or name regexp) + (maphash #'(lambda (member-name info) + (when (or (and name (string= name member-name)) + (and regexp (string-match regexp member-name))) + (setq list (cons member-name list)))) + members)) + list)) + + +(defun ebrowse-tags-apropos () + "Display a list of members matching a regexp read from the minibuffer." + (interactive) + (let* ((buffer (or (ebrowse-choose-from-browser-buffers) + (error "No tree buffer"))) + (header (ebrowse-value-in-buffer 'ebrowse--header buffer)) + (members (ebrowse-member-table header)) + temp-buffer-setup-hook + (regexp (read-from-minibuffer "List members matching regexp: "))) + (with-output-to-temp-buffer (concat "*Apropos Members*") + (set-buffer standard-output) + (erase-buffer) + (insert "Members matching `" regexp "'\n\n") + (loop for s in (ebrowse-list-of-matching-members members regexp) do + (loop for info in (gethash s members) do + (ebrowse-draw-file-member-info info)))))) + + +(defun ebrowse-tags-list-members-in-file () + "Display a list of members found in a file. +The file name is read from the minibuffer." + (interactive) + (let* ((buffer (or (ebrowse-choose-from-browser-buffers) + (error "No tree buffer"))) + (files (save-excursion (set-buffer buffer) (ebrowse-files-table))) + (alist (ebrowse-hash-table-to-alist files)) + (file (completing-read "List members in file: " alist nil t)) + (header (ebrowse-value-in-buffer 'ebrowse--header buffer)) + temp-buffer-setup-hook + (members (ebrowse-member-table header))) + (with-output-to-temp-buffer (concat "*Members in file " file "*") + (set-buffer standard-output) + (maphash + #'(lambda (member-name list) + (loop for info in list + as member = (third info) + as class = (ebrowse-ts-class (first info)) + when (or (and (null (ebrowse-ms-file member)) + (string= (ebrowse-cs-file class) file)) + (string= file (ebrowse-ms-file member))) + do (ebrowse-draw-file-member-info info "decl.") + when (or (and (null (ebrowse-ms-definition-file member)) + (string= (ebrowse-cs-source-file class) file)) + (string= file (ebrowse-ms-definition-file member))) + do (ebrowse-draw-file-member-info info "defn."))) + members)))) + + +(defun* ebrowse-draw-file-member-info (info &optional (kind "")) + "Display a line in an the members per file info buffer. +INFO describes the member. It has the form (TREE ACCESSOR MEMBER). +TREE is the class of the member to display. +ACCESSOR is the accessor symbol of its member list. +MEMBER is the member structure. +KIND is a an additional string printed in the buffer." + (let* ((tree (first info)) + (globals-p (ebrowse-globals-tree-p tree))) + (unless globals-p + (insert (ebrowse-cs-name (ebrowse-ts-class tree)))) + (insert "::" (ebrowse-ms-name (third info))) + (indent-to 40) + (insert kind) + (indent-to 50) + (insert (case (second info) + ('ebrowse-ts-member-functions "member function") + ('ebrowse-ts-member-variables "member variable") + ('ebrowse-ts-static-functions "static function") + ('ebrowse-ts-static-variables "static variable") + ('ebrowse-ts-friends (if globals-p "define" "friend")) + ('ebrowse-ts-types "type") + (t "unknown")) + "\n"))) + +(defvar ebrowse-last-completion nil + "Text inserted by the last completion operation.") + + +(defvar ebrowse-last-completion-start nil + "String which was the basis for the last completion operation.") + + +(defvar ebrowse-last-completion-location nil + "Buffer position at which the last completion operation was initiated.") + + +(defvar ebrowse-last-completion-obarray nil + "Member used in last completion operation.") + + +(make-variable-buffer-local 'ebrowse-last-completion-obarray) +(make-variable-buffer-local 'ebrowse-last-completion-location) +(make-variable-buffer-local 'ebrowse-last-completion) +(make-variable-buffer-local 'ebrowse-last-completion-start) + + + +(defun ebrowse-some-member-table () + "Return a hash table containing all member of a tree. +If there's only one tree loaded, use that. Otherwise let the +use choose a tree." + (let* ((buffers (ebrowse-known-class-trees-buffer-list)) + (buffer (cond ((and (first buffers) (not (second buffers))) + (first buffers)) + (t (or (ebrowse-electric-choose-tree) + (error "No tree buffer"))))) + (header (ebrowse-value-in-buffer 'ebrowse--header buffer))) + (ebrowse-member-table header))) + + +(defun ebrowse-hash-table-to-alist (table) + "Return an alist holding all key/value pairs of hash table TABLE." + (let ((list)) + (maphash #'(lambda (key value) + (setq list (cons (cons key value) list))) + table) + list)) + + +(defun ebrowse-cyclic-successor-in-string-list (string list) + "Return the item following STRING in LIST. +If STRING is the last element, return the first element as successor." + (or (nth (1+ (ebrowse-position string list 'string=)) list) + (first list))) + + +;;; Symbol completion + +;;;###autoload +(defun* ebrowse-tags-complete-symbol (prefix) + "Perform completion on the C++ symbol preceding point. +A second call of this function without changing point inserts the next match. +A call with prefix PREFIX reads the symbol to insert from the minibuffer with +completion." + (interactive "P") + (let* ((end (point)) + (begin (save-excursion (skip-chars-backward "a-zA-Z_0-9") (point))) + (pattern (buffer-substring begin end)) + list completion) + (cond + ;; With prefix, read name from minibuffer with completion. + (prefix + (let* ((members (ebrowse-some-member-table)) + (alist (ebrowse-hash-table-to-alist members)) + (completion (completing-read "Insert member: " + alist nil t pattern))) + (when completion + (setf ebrowse-last-completion-location nil) + (delete-region begin end) + (insert completion)))) + ;; If this function is called at the same point the last + ;; expansion ended, insert the next expansion. + ((eq (point) ebrowse-last-completion-location) + (setf list (all-completions ebrowse-last-completion-start + ebrowse-last-completion-obarray) + completion (ebrowse-cyclic-successor-in-string-list + ebrowse-last-completion list)) + (cond ((null completion) + (error "No completion")) + ((string= completion pattern) + (error "No further completion")) + (t + (delete-region begin end) + (insert completion) + (setf ebrowse-last-completion completion + ebrowse-last-completion-location (point))))) + ;; First time the function is called at some position in the + ;; buffer: Start new completion. + (t + (let* ((members (ebrowse-some-member-table)) + (completion (first (all-completions pattern members nil)))) + (cond ((eq completion t)) + ((null completion) + (error "Can't find completion for `%s'" pattern)) + (t + (delete-region begin end) + (insert completion) + + (setf ebrowse-last-completion-location (point) + ebrowse-last-completion-start pattern + ebrowse-last-completion completion + ebrowse-last-completion-obarray members)))))))) + + +;;; Tags query replace & search + +(defvar ebrowse-tags-loop-form () + "Form for `ebrowse-loop-continue'. +Evaluated for each file in the tree. If it returns nil, proceed +with the next file.") + +(defvar ebrowse-tags-next-file-list () + "A list of files to be processed.") + + +(defvar ebrowse-tags-next-file-path nil + "The path relative to which files have to be searched.") + + +(defvar ebrowse-tags-loop-last-file nil + "The last file visited via `ebrowse-tags-loop'.") + + +(defun ebrowse-tags-next-file (&optional initialize tree-buffer) + "Select next file among files in current tag table. +Non-nil argument INITIALIZE (prefix arg, if interactive) initializes +to the beginning of the list of files in the tag table. +TREE-BUFFER specifies the class tree we operate on." + (interactive "P") + ;; Call with INITIALIZE non-nil initializes the files list. + ;; If more than one tree buffer is loaded, let the user choose + ;; on which tree (s)he wants to operate. + (when initialize + (let ((buffer (or tree-buffer (ebrowse-choose-from-browser-buffers)))) + (save-excursion + (set-buffer buffer) + (setq ebrowse-tags-next-file-list + (ebrowse-files-list (ebrowse-marked-classes-p)) + ebrowse-tags-loop-last-file + nil + ebrowse-tags-next-file-path + (file-name-directory ebrowse--tags-file-name))))) + ;; End of the loop if the stack of files is empty. + (unless ebrowse-tags-next-file-list + (error "All files processed")) + ;; ebrowse-tags-loop-last-file is the last file that was visited due + ;; to a call to BROWSE-LOOP (see below). If that file is still + ;; in memory, and it wasn't modified, throw its buffer away to + ;; prevent cluttering up the buffer list. + (when ebrowse-tags-loop-last-file + (let ((buffer (get-file-buffer ebrowse-tags-loop-last-file))) + (when (and buffer + (not (buffer-modified-p buffer))) + (kill-buffer buffer)))) + ;; Remember this buffer file name for later deletion, if it + ;; wasn't visited by other means. + (let ((file (expand-file-name (car ebrowse-tags-next-file-list) + ebrowse-tags-next-file-path))) + (setq ebrowse-tags-loop-last-file (if (get-file-buffer file) nil file)) + ;; Find the file and pop the file list. Pop has to be done + ;; before the file is loaded because FIND-FILE might encounter + ;; an error, and we want to be able to proceed with the next + ;; file in this case. + (pop ebrowse-tags-next-file-list) + (find-file file))) + + +;;;###autoload +(defun ebrowse-tags-loop-continue (&optional first-time tree-buffer) + "Repeat last operation on files in tree. +FIRST-TIME non-nil means this is not a repetition, but the first time. +TREE-BUFFER if indirectly specifies which files to loop over." + (interactive) + (when first-time + (ebrowse-tags-next-file first-time tree-buffer) + (goto-char (point-min))) + (while (not (eval ebrowse-tags-loop-form)) + (ebrowse-tags-next-file) + (message "Scanning file `%s'..." buffer-file-name) + (goto-char (point-min)))) + + +;;###autoload +(defun ebrowse-tags-search (regexp) + "Search for REGEXP in all files in a tree. +If marked classes exist, process marked classes, only. +If regular expression is nil, repeat last search." + (interactive "sTree search (regexp): ") + (if (and (string= regexp "") + (eq (car ebrowse-tags-loop-form) 're-search-forward)) + (ebrowse-tags-loop-continue) + (setq ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) + (ebrowse-tags-loop-continue 'first-time))) + + +;;;###autoload +(defun ebrowse-tags-query-replace (from to) + "Query replace FROM with TO in all files of a class tree. +With prefix arg, process files of marked classes only." + (interactive + "sTree query replace (regexp): \nsTree query replace %s by: ") + (setq ebrowse-tags-loop-form + (list 'and (list 'save-excursion + (list 're-search-forward from nil t)) + (list 'not (list 'perform-replace from to t t nil)))) + (ebrowse-tags-loop-continue 'first-time)) + + +;;; ###autoload +(defun ebrowse-tags-search-member-use (&optional fix-name) + "Search for call sites of a member. +If FIX-NAME is specified, search uses of that member. +Otherwise, read a member name from the minibuffer. +Searches in all files mentioned in a class tree for something that +looks like a function call to the member." + (interactive) + ;; Choose the tree to use if there is more than one. + (multiple-value-bind (tree header tree-buffer) + (ebrowse-choose-tree) + (unless tree + (error "No class tree")) + ;; Get the member name NAME (class-name is ignored). + (let ((name fix-name) class-name regexp) + (unless name + (multiple-value-setq (class-name name) + (ebrowse-tags-read-name header "Find calls of: "))) + ;; Set tags loop form to search for member and begin loop. + (setq regexp (concat "\\<" name "[ \t]*(") + ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) + (ebrowse-tags-loop-continue 'first-time tree-buffer)))) + + + +;;; Tags position management + +;;; Structures of this kind are the elements of the position stack. + +(defstruct (ebrowse-position (:type vector) :named) + file-name ; in which file + point ; point in file + target ; t if target of a jump + info) ; (CLASS FUNC MEMBER) jumped to + + +(defvar ebrowse-position-stack () + "Stack of `ebrowse-position' structured.") + + +(defvar ebrowse-position-index 0 + "Current position in position stack.") + + +(defun ebrowse-position-name (position) + "Return an identifying string for POSITION. +The string is printed in the electric position list buffer." + (let ((info (ebrowse-position-info position))) + (concat (if (ebrowse-position-target position) "at " "to ") + (ebrowse-cs-name (ebrowse-ts-class (first info))) + "::" (ebrowse-ms-name (third info))))) + + +(defun ebrowse-view/find-position (position &optional view) + "Position point on POSITION. +If VIEW is non-nil, view the position, otherwise find it." + (cond ((not view) + (find-file (ebrowse-position-file-name position)) + (goto-char (ebrowse-position-point position))) + (t + (unwind-protect + (progn + (push (function + (lambda () + (goto-char (ebrowse-position-point position)))) + view-mode-hook) + (view-file (ebrowse-position-file-name position))) + (pop view-mode-hook))))) + + +(defun ebrowse-push-position (marker info &optional target) + "Push current position on position stack. +MARKER is the marker to remember as position. +INFO is a list (CLASS FUNC MEMBER) specifying what we jumped to. +TARGET non-nil means we performed a jump. +Positions in buffers that have no file names are not saved." + (when (buffer-file-name (marker-buffer marker)) + (let ((too-much (- (length ebrowse-position-stack) + ebrowse-max-positions))) + ;; Do not let the stack grow to infinity. + (when (plusp too-much) + (setq ebrowse-position-stack + (butlast ebrowse-position-stack too-much))) + ;; Push the position. + (push (make-ebrowse-position + :file-name (buffer-file-name (marker-buffer marker)) + :point (marker-position marker) + :target target + :info info) + ebrowse-position-stack)))) + + +(defun ebrowse-move-in-position-stack (increment) + "Move by INCREMENT in the position stack." + (let ((length (length ebrowse-position-stack))) + (when (zerop length) + (error "No positions remembered")) + (setq ebrowse-position-index + (mod (+ increment ebrowse-position-index) length)) + (message "Position %d of %d " ebrowse-position-index length) + (ebrowse-view/find-position (nth ebrowse-position-index + ebrowse-position-stack)))) + + +;;; ###autoload +(defun ebrowse-back-in-position-stack (arg) + "Move backward in the position stack. +Prefix arg ARG says how much." + (interactive "p") + (ebrowse-move-in-position-stack (max 1 arg))) + + +;;; ###autoload +(defun ebrowse-forward-in-position-stack (arg) + "Move forward in the position stack. +Prefix arg ARG says how much." + (interactive "p") + (ebrowse-move-in-position-stack (min -1 (- arg)))) + + + +;;; Electric position list + +(defvar ebrowse-electric-position-mode-map () + "Keymap used in electric position stack window.") + + +(defvar ebrowse-electric-position-mode-hook nil + "If non-nil, its value is called by ebrowse-electric-position-mode.") + + +(unless ebrowse-electric-position-mode-map + (let ((map (make-keymap)) + (submap (make-keymap))) + (setq ebrowse-electric-position-mode-map map) + (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined) + (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined) + (define-key map "\e" submap) + (define-key map "\C-z" 'suspend-emacs) + (define-key map "\C-h" 'Helper-help) + (define-key map "?" 'Helper-describe-bindings) + (define-key map "\C-c" nil) + (define-key map "\C-c\C-c" 'ebrowse-electric-position-quit) + (define-key map "q" 'ebrowse-electric-position-quit) + (define-key map " " 'ebrowse-electric-select-position) + (define-key map "\C-l" 'recenter) + (define-key map "\C-u" 'universal-argument) + (define-key map "\C-p" 'previous-line) + (define-key map "\C-n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "n" 'next-line) + (define-key map "v" 'ebrowse-electric-view-position) + (define-key map "\C-v" 'scroll-up) + (define-key map "\ev" 'scroll-down) + (define-key map "\e\C-v" 'scroll-other-window) + (define-key map "\e>" 'end-of-buffer) + (define-key map "\e<" 'beginning-of-buffer) + (define-key map "\e>" 'end-of-buffer))) + +(put 'ebrowse-electric-position-mode 'mode-class 'special) +(put 'ebrowse-electric-position-undefined 'suppress-keymap t) + + +(defun ebrowse-electric-position-mode () + "Mode for electric position buffers. +Runs the hook `ebrowse-electric-position-mode-hook'." + (kill-all-local-variables) + (use-local-map ebrowse-electric-position-mode-map) + (setq mode-name "Electric Position Menu" + mode-line-buffer-identification "Electric Position Menu") + (when (memq 'mode-name mode-line-format) + (setq mode-line-format (copy-sequence mode-line-format)) + (setcar (memq 'mode-name mode-line-format) "Positions")) + (make-local-variable 'Helper-return-blurb) + (setq Helper-return-blurb "return to buffer editing" + truncate-lines t + buffer-read-only t + major-mode 'ebrowse-electric-position-mode) + (run-hooks 'ebrowse-electric-position-mode-hook)) + + +(defun ebrowse-draw-position-buffer () + "Display positions in buffer *Positions*." + (set-buffer (get-buffer-create "*Positions*")) + (setq buffer-read-only nil) + (erase-buffer) + (insert "File Point Description\n" + "---- ----- -----------\n") + (dolist (position ebrowse-position-stack) + (insert (file-name-nondirectory (ebrowse-position-file-name position))) + (indent-to 15) + (insert (int-to-string (ebrowse-position-point position))) + (indent-to 22) + (insert (ebrowse-position-name position) "\n")) + (setq buffer-read-only t)) + + +;;; ###autoload +(defun ebrowse-electric-position-menu () + "List positions in the position stack in an electric buffer." + (interactive) + (unless ebrowse-position-stack + (error "No positions remembered")) + (let (select buffer window) + (save-window-excursion + (save-window-excursion (ebrowse-draw-position-buffer)) + (setq window (Electric-pop-up-window "*Positions*") + buffer (window-buffer window)) + (shrink-window-if-larger-than-buffer window) + (unwind-protect + (progn + (set-buffer buffer) + (ebrowse-electric-position-mode) + (setq select + (catch 'ebrowse-electric-select-position + (message "<<< Press Space to bury the list >>>") + (let ((first (progn (goto-char (point-min)) + (forward-line 2) + (point))) + (last (progn (goto-char (point-max)) + (forward-line -1) + (point))) + (goal-column 0)) + (goto-char first) + (Electric-command-loop 'ebrowse-electric-select-position + nil t + 'ebrowse-electric-position-looper + (cons first last)))))) + (set-buffer buffer) + (bury-buffer buffer) + (message nil))) + (when select + (set-buffer buffer) + (ebrowse-electric-find-position select)) + (kill-buffer buffer))) + + +(defun ebrowse-electric-position-looper (state condition) + "Prevent moving point on invalid lines. +Called from `Electric-command-loop'. See there for the meaning +of STATE and CONDITION." + (cond ((and condition + (not (memq (car condition) '(buffer-read-only + end-of-buffer + beginning-of-buffer)))) + (signal (car condition) (cdr condition))) + ((< (point) (car state)) + (goto-char (point-min)) + (forward-line 2)) + ((> (point) (cdr state)) + (goto-char (point-max)) + (forward-line -1) + (if (pos-visible-in-window-p (point-max)) + (recenter -1))))) + + +(defun ebrowse-electric-position-undefined () + "Function called for undefined keys." + (interactive) + (message "Type C-h for help, ? for commands, q to quit, Space to execute") + (sit-for 4)) + + +(defun ebrowse-electric-position-quit () + "Leave the electric position list." + (interactive) + (throw 'ebrowse-electric-select-position nil)) + + +(defun ebrowse-electric-select-position () + "Select a position from the list." + (interactive) + (throw 'ebrowse-electric-select-position (point))) + + +(defun ebrowse-electric-find-position (point &optional view) + "View/find what is described by the line at POINT. +If VIEW is non-nil, view else find source files." + (let ((index (- (count-lines (point-min) point) 2))) + (ebrowse-view/find-position (nth index + ebrowse-position-stack) view))) + + +(defun ebrowse-electric-view-position () + "View the position described by the line point is in." + (interactive) + (ebrowse-electric-find-position (point) t)) + + + +;;; Saving trees to disk + +(defun ebrowse-write-file-hook-fn () + "Write current buffer as a class tree. +Installed on `local-write-file-hooks'." + (ebrowse-save-tree) + t) + + +;;; ###autoload +(defun ebrowse-save-tree () + "Save current tree in same file it was loaded from." + (interactive) + (ebrowse-save-tree-as (or buffer-file-name ebrowse--tags-file-name))) + + +;;;###autoload +(defun ebrowse-save-tree-as (&optional file-name) + "Write the current tree data structure to a file. +Read the file name from the minibuffer if interactive. +Otherwise, FILE-NAME specifies the file to save the tree in." + (interactive "FSave tree as: ") + (let ((temp-buffer (get-buffer-create "*Tree Output")) + (old-standard-output standard-output) + (header (copy-ebrowse-hs ebrowse--header)) + (tree ebrowse--tree)) + (unwind-protect + (save-excursion + (set-buffer (setq standard-output temp-buffer)) + (erase-buffer) + (setf (ebrowse-hs-member-table header) nil) + (insert (prin1-to-string header) " ") + (mapcar 'ebrowse-save-class tree) + (write-file file-name) + (message "Tree written to file `%s'" file-name)) + (kill-buffer temp-buffer) + (set-buffer-modified-p nil) + (ebrowse-update-tree-buffer-mode-line) + (setq standard-output old-standard-output)))) + + +(defun ebrowse-save-class (class) + "Write single class CLASS to current buffer." + (message "%s..." (ebrowse-cs-name (ebrowse-ts-class class))) + (insert "[ebrowse-ts ") + (prin1 (ebrowse-ts-class class)) ;class name + (insert "(") ;list of subclasses + (mapcar 'ebrowse-save-class (ebrowse-ts-subclasses class)) + (insert ")") + (dolist (func ebrowse-member-list-accessors) + (prin1 (funcall func class)) + (insert "\n")) + (insert "()") ;base-classes slot + (prin1 (ebrowse-ts-mark class)) + (insert "]\n")) + + + +;;; Statistics + +;;; ###autoload +(defun ebrowse-statistics () + "Display statistics for a class tree." + (interactive) + (let ((tree-file (buffer-file-name)) + temp-buffer-setup-hook) + (with-output-to-temp-buffer "*Tree Statistics*" + (multiple-value-bind (classes member-functions member-variables + static-functions static-variables) + (ebrowse-gather-statistics) + (set-buffer standard-output) + (erase-buffer) + (insert "STATISTICS FOR TREE " (or tree-file "unknown") ":\n\n") + (ebrowse-print-statistics-line "Number of classes:" classes) + (ebrowse-print-statistics-line "Number of member functions:" + member-functions) + (ebrowse-print-statistics-line "Number of member variables:" + member-variables) + (ebrowse-print-statistics-line "Number of static functions:" + static-functions) + (ebrowse-print-statistics-line "Number of static variables:" + static-variables))))) + + +(defun ebrowse-print-statistics-line (title value) + "Print a line in the statistics buffer. +TITLE is the title of the line, VALUE is number to be printed +after that." + (insert title) + (indent-to 40) + (insert (format "%d\n" value))) + + +(defun ebrowse-gather-statistics () + "Return statistics for a class tree. +The result is a list (NUMBER-OF-CLASSES NUMBER-OF-MEMBER-FUNCTIONS +NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS +NUMBER-OF-STATIC-VARIABLES:" + (let ((classes 0) (member-functions 0) (member-variables 0) + (static-functions 0) (static-variables 0)) + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (incf classes) + (incf member-functions (length (ebrowse-ts-member-functions tree))) + (incf member-variables (length (ebrowse-ts-member-variables tree))) + (incf static-functions (length (ebrowse-ts-static-functions tree))) + (incf static-variables (length (ebrowse-ts-static-variables tree)))) + (list classes member-functions member-variables + static-functions static-variables))) + + + +;;; Global key bindings + +;;; The following can be used to bind key sequences starting with +;;; prefix `\C-cb' to browse commands. + +(defvar ebrowse-global-map nil + "*Keymap for Ebrowse commands.") + + +(defvar ebrowse-global-prefix-key "\C-cb" + "Prefix key for Ebrowse commands.") + + +(defvar ebrowse-global-submap-4 nil + "Keymap used for `ebrowse-global-prefix' followed by `4'.") + + +(defvar ebrowse-global-submap-5 nil + "Keymap used for `ebrowse-global-prefix' followed by `5'.") + + +(unless ebrowse-global-map + (setq ebrowse-global-map (make-sparse-keymap)) + (setq ebrowse-global-submap-4 (make-sparse-keymap)) + (setq ebrowse-global-submap-5 (make-sparse-keymap)) + (define-key ebrowse-global-map "a" 'ebrowse-tags-apropos) + (define-key ebrowse-global-map "b" 'ebrowse-pop-to-browser-buffer) + (define-key ebrowse-global-map "-" 'ebrowse-back-in-position-stack) + (define-key ebrowse-global-map "+" 'ebrowse-forward-in-position-stack) + (define-key ebrowse-global-map "l" 'ebrowse-tags-list-members-in-file) + (define-key ebrowse-global-map "m" 'ebrowse-tags-display-member-buffer) + (define-key ebrowse-global-map "n" 'ebrowse-tags-next-file) + (define-key ebrowse-global-map "p" 'ebrowse-electric-position-menu) + (define-key ebrowse-global-map "s" 'ebrowse-tags-search) + (define-key ebrowse-global-map "u" 'ebrowse-tags-search-member-use) + (define-key ebrowse-global-map "v" 'ebrowse-tags-view-definition) + (define-key ebrowse-global-map "V" 'ebrowse-tags-view-declaration) + (define-key ebrowse-global-map "%" 'ebrowse-tags-query-replace) + (define-key ebrowse-global-map "." 'ebrowse-tags-find-definition) + (define-key ebrowse-global-map "f" 'ebrowse-tags-find-definition) + (define-key ebrowse-global-map "F" 'ebrowse-tags-find-declaration) + (define-key ebrowse-global-map "," 'ebrowse-tags-loop-continue) + (define-key ebrowse-global-map " " 'ebrowse-electric-buffer-list) + (define-key ebrowse-global-map "\t" 'ebrowse-tags-complete-symbol) + (define-key ebrowse-global-map "4" ebrowse-global-submap-4) + (define-key ebrowse-global-submap-4 "." 'ebrowse-tags-find-definition-other-window) + (define-key ebrowse-global-submap-4 "f" 'ebrowse-tags-find-definition-other-window) + (define-key ebrowse-global-submap-4 "v" 'ebrowse-tags-find-declaration-other-window) + (define-key ebrowse-global-submap-4 "F" 'ebrowse-tags-view-definition-other-window) + (define-key ebrowse-global-submap-4 "V" 'ebrowse-tags-view-declaration-other-window) + (define-key ebrowse-global-map "5" ebrowse-global-submap-5) + (define-key ebrowse-global-submap-5 "." 'ebrowse-tags-find-definition-other-frame) + (define-key ebrowse-global-submap-5 "f" 'ebrowse-tags-find-definition-other-frame) + (define-key ebrowse-global-submap-5 "v" 'ebrowse-tags-find-declaration-other-frame) + (define-key ebrowse-global-submap-5 "F" 'ebrowse-tags-view-definition-other-frame) + (define-key ebrowse-global-submap-5 "V" 'ebrowse-tags-view-declaration-other-frame) + (define-key global-map ebrowse-global-prefix-key ebrowse-global-map)) + + + +;;; Electric C++ browser buffer menu + +;;; Electric buffer menu customization to display only some buffers +;;; (in this case Tree buffers). There is only one problem with this: +;;; If the very first character typed in the buffer menu is a space, +;;; this will select the buffer from which the buffer menu was +;;; invoked. But this buffer is not displayed in the buffer list if +;;; it isn't a tree buffer. I therefore let the buffer menu command +;;; loop read the command `p' via `unread-command-char'. This command +;;; has no effect since we are on the first line of the buffer. + +(defvar electric-buffer-menu-mode-hook nil) + + +(defun ebrowse-hack-electric-buffer-menu () + "Hack the electric buffer menu to display browser buffers." + (let (non-empty) + (unwind-protect + (save-excursion + (setq buffer-read-only nil) + (goto-char 1) + (forward-line 2) + (while (not (eobp)) + (let ((b (Buffer-menu-buffer nil))) + (if (or (ebrowse-buffer-p b) + (string= (buffer-name b) "*Apropos Members*")) + (progn (forward-line 1) + (setq non-empty t)) + (delete-region (point) + (save-excursion (end-of-line) + (min (point-max) + (1+ (point))))))))) + (unless non-empty + (error "No tree buffers")) + (setf unread-command-events (listify-key-sequence "p")) + (shrink-window-if-larger-than-buffer (selected-window)) + (setq buffer-read-only t)))) + + +(defun ebrowse-select-1st-to-9nth () + "Select the nth entry in the list by the keys 1..9." + (interactive) + (let* ((maxlin (count-lines (point-min) (point-max))) + (n (min maxlin (+ 2 (string-to-int (this-command-keys)))))) + (goto-line n) + (throw 'electric-buffer-menu-select (point)))) + + +(defun ebrowse-install-1-to-9-keys () + "Define keys 1..9 to select the 1st to 0nth entry in the list." + (dotimes (i 9) + (define-key (current-local-map) (char-to-string (+ i ?1)) + 'ebrowse-select-1st-to-9nth))) + + +(defun ebrowse-electric-buffer-list () + "Display an electric list of Ebrowse buffers." + (interactive) + (unwind-protect + (progn + (add-hook 'electric-buffer-menu-mode-hook + 'ebrowse-hack-electric-buffer-menu) + (add-hook 'electric-buffer-menu-mode-hook + 'ebrowse-install-1-to-9-keys) + (call-interactively 'electric-buffer-list)) + (remove-hook 'electric-buffer-menu-mode-hook + 'ebrowse-hack-electric-buffer-menu))) + + +;;; Mouse support + +(defun ebrowse-mouse-find-member (event) + "Find the member clicked on in another frame. +EVENT is a mouse button event." + (interactive "e") + (mouse-set-point event) + (let (start name) + (save-excursion + (skip-chars-backward "a-zA-Z0-9_") + (setq start (point)) + (skip-chars-forward "a-zA-Z0-9_") + (setq name (buffer-substring start (point)))) + (ebrowse-tags-view/find-member-decl/defn + 5 :view nil :definition t :member-name name))) + + +(defun ebrowse-popup-menu (menu event) + "Pop up MENU and perform an action if something was selected. +EVENT is the mouse event." + (save-selected-window + (select-window (posn-window (event-start event))) + (let ((selection (x-popup-menu event menu)) binding) + (while selection + (setq binding (lookup-key (or binding menu) (vector (car selection))) + selection (cdr selection))) + (when binding + (call-interactively binding))))) + + +(easy-menu-define + ebrowse-tree-buffer-class-object-menu ebrowse-tree-mode-map + "Object menu for classes in the tree buffer" + '("Class" + ["Functions" ebrowse-tree-command:show-member-functions + :help "Display a list of member functions" + :active t] + ["Variables" ebrowse-tree-command:show-member-variables + :help "Display a list of member variables" + :active t] + ["Static Functions" ebrowse-tree-command:show-static-member-functions + :help "Display a list of static member functions" + :active t] + ["Static Variables" ebrowse-tree-command:show-static-member-variables + :help "Display a list of static member variables" + :active t] + ["Friends/ Defines" ebrowse-tree-command:show-friends + :help "Display a list of friends of a class" + :active t] + ["Types" ebrowse-tree-command:show-types + :help "Display a list of types defined in a class" + :active t] + "-----------------" + ["View" ebrowse-view-class-declaration + :help "View class declaration" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + ["Find" ebrowse-find-class-declaration + :help "Find class declaration in file" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + "-----------------" + ["Mark" ebrowse-toggle-mark-at-point + :help "Mark class point is on" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + "-----------------" + ["Collapse" ebrowse-collapse-branch + :help "Collapse subtree under class point is on" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + ["Expand" ebrowse-expand-branch + :help "Expand subtree under class point is on" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)])) + + +(easy-menu-define + ebrowse-tree-buffer-object-menu ebrowse-tree-mode-map + "Object menu for tree buffers" + '("Ebrowse" + ["Filename Display" ebrowse-toggle-file-name-display + :help "Toggle display of source files names" + :style toggle + :selected ebrowse--show-file-names-flag + :active t] + ["Tree Indentation" ebrowse-set-tree-indentation + :help "Set the tree's indentation" + :active t] + ["Unmark All Classes" ebrowse-mark-all-classes + :help "Unmark all classes in the class tree" + :active t] + ["Expand All" ebrowse-expand-all + :help "Expand all subtrees in the class tree" + :active t] + ["Statistics" ebrowse-statistics + :help "Show a buffer with class hierarchy statistics" + :active t] + ["Find Class" ebrowse-read-class-name-and-go + :help "Find a class in the tree" + :active t] + ["Member Buffer" ebrowse-pop/switch-to-member-buffer-for-same-tree + :help "Show a member buffer for this class tree" + :active t])) + + +(defun ebrowse-mouse-3-in-tree-buffer (event) + "Perform mouse actions in tree buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (let* ((where (posn-point (event-start event))) + (property (get-text-property where 'ebrowse-what))) + (case (event-click-count event) + (1 + (case property + (class-name + (ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event)) + (t + (ebrowse-popup-menu ebrowse-tree-buffer-object-menu event))))))) + + +(defun ebrowse-mouse-2-in-tree-buffer (event) + "Perform mouse actions in tree buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (let* ((where (posn-point (event-start event))) + (property (get-text-property where 'ebrowse-what))) + (case (event-click-count event) + (1 (case property + (class-name + (ebrowse-tree-command:show-member-functions))))))) + + +(defun ebrowse-mouse-1-in-tree-buffer (event) + "Perform mouse actions in tree buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (let* ((where (posn-point (event-start event))) + (property (get-text-property where 'ebrowse-what))) + (case (event-click-count event) + (2 (case property + (class-name + (let ((collapsed (save-excursion (skip-chars-forward "^\r\n") + (looking-at "\r")))) + (ebrowse-collapse-fn (not collapsed)))) + (mark + (ebrowse-toggle-mark-at-point 1))))))) + + + +;;; Hooks installed + +(add-hook 'find-file-hooks 'ebrowse-find-file) + + +(provide 'ebrowse) + +;;; Local variables: +;;; eval:(put 'ebrowse-output 'lisp-indent-hook 0) +;;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0) +;;; eval:(put 'ebrowse-save-selective 'lisp-indent-hook 0) +;;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) +;;; End: + +;;; ebrowse.el ends here. + |