aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2020-03-27 12:24:19 -0400
committerStefan Monnier2020-03-27 12:24:19 -0400
commit4710f28010e47e613d08ff46b788b6b0c8eb317f (patch)
treef1127a2a13de079f1364a0285837aa20a0dd1127
parentf98ee21c0e3d4e00569fdd9f2671fd8394ab8a65 (diff)
downloademacs-4710f28010e47e613d08ff46b788b6b0c8eb317f.tar.gz
emacs-4710f28010e47e613d08ff46b788b6b0c8eb317f.zip
* lisp/progmodes/ebrowse.el: Prefer hash-tables to obarrays
Remove redundant :group args. Use `defvar-local` and `setq-local` where possible. (ebrowse-some): Use seq-some instead. (ebrowse-every): Use seq-every-p instead. (ebrowse-position): Use seq-position. (ebrowse--tree-table): Rename from `ebrowse--tree-obarray`. Change all users to use a hash-table rather than an obarray. (ebrowse-for-all-trees): Adjust to the table being a hash-table. (ebrowse-tree-table-as-alist): Rename from `ebrowse-tree-obarray-as-alist`. (ebrowse-build-tree-obarray): Rename from `ebrowse-build-tree-obarray`. (ebrowse-tree-mode): Remove redundant setting of `ebrowse--tree-obarray`. (ebrowse-set-tree-indentation, ebrowse-view-file-other-frame) (ebrowse-last-completion-table): Rename from ebrowse-last-completion-obarray. (ebrowse-position): Make it a proper struct.
-rw-r--r--lisp/progmodes/ebrowse.el412
1 files changed, 167 insertions, 245 deletions
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index bb780259333..c02703fc59f 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -34,6 +34,7 @@
34;;; Code: 34;;; Code:
35 35
36(require 'cl-lib) 36(require 'cl-lib)
37(require 'seq)
37(require 'easymenu) 38(require 'easymenu)
38(require 'view) 39(require 'view)
39(require 'ebuff-menu) 40(require 'ebuff-menu)
@@ -52,32 +53,27 @@
52 "List of directories to search for source files in a class tree. 53 "List of directories to search for source files in a class tree.
53Elements should be directory names; nil as an element means to try 54Elements should be directory names; nil as an element means to try
54to find source files relative to the location of the BROWSE file loaded." 55to find source files relative to the location of the BROWSE file loaded."
55 :group 'ebrowse
56 :type '(repeat (choice (const :tag "Default" nil) 56 :type '(repeat (choice (const :tag "Default" nil)
57 (string :tag "Directory")))) 57 (string :tag "Directory"))))
58 58
59 59
60(defcustom ebrowse-view/find-hook nil 60(defcustom ebrowse-view/find-hook nil
61 "Hooks run after finding or viewing a member or class." 61 "Hooks run after finding or viewing a member or class."
62 :group 'ebrowse
63 :type 'hook) 62 :type 'hook)
64 63
65 64
66(defcustom ebrowse-not-found-hook nil 65(defcustom ebrowse-not-found-hook nil
67 "Hooks run when finding or viewing a member or class was not successful." 66 "Hooks run when finding or viewing a member or class was not successful."
68 :group 'ebrowse
69 :type 'hook) 67 :type 'hook)
70 68
71 69
72(defcustom ebrowse-electric-list-mode-hook nil 70(defcustom ebrowse-electric-list-mode-hook nil
73 "Hook called by `ebrowse-electric-position-mode'." 71 "Hook called by `ebrowse-electric-position-mode'."
74 :group 'ebrowse
75 :type 'hook) 72 :type 'hook)
76 73
77 74
78(defcustom ebrowse-max-positions 50 75(defcustom ebrowse-max-positions 50
79 "Number of markers saved on electric position stack." 76 "Number of markers saved on electric position stack."
80 :group 'ebrowse
81 :type 'integer) 77 :type 'integer)
82 78
83 79
@@ -89,32 +85,27 @@ to find source files relative to the location of the BROWSE file loaded."
89 85
90(defcustom ebrowse-tree-mode-hook nil 86(defcustom ebrowse-tree-mode-hook nil
91 "Hook run in each new tree buffer." 87 "Hook run in each new tree buffer."
92 :group 'ebrowse-tree
93 :type 'hook) 88 :type 'hook)
94 89
95 90
96(defcustom ebrowse-tree-buffer-name "*Tree*" 91(defcustom ebrowse-tree-buffer-name "*Tree*"
97 "The default name of class tree buffers." 92 "The default name of class tree buffers."
98 :group 'ebrowse-tree
99 :type 'string) 93 :type 'string)
100 94
101 95
102(defcustom ebrowse--indentation 4 96(defcustom ebrowse--indentation 4
103 "The amount by which subclasses are indented in the tree." 97 "The amount by which subclasses are indented in the tree."
104 :group 'ebrowse-tree
105 :type 'integer) 98 :type 'integer)
106 99
107 100
108(defcustom ebrowse-source-file-column 40 101(defcustom ebrowse-source-file-column 40
109 "The column in which source file names are displayed in the tree." 102 "The column in which source file names are displayed in the tree."
110 :group 'ebrowse-tree
111 :type 'integer) 103 :type 'integer)
112 104
113 105
114(defcustom ebrowse-tree-left-margin 2 106(defcustom ebrowse-tree-left-margin 2
115 "Amount of space left at the left side of the tree display. 107 "Amount of space left at the left side of the tree display.
116This space is used to display markers." 108This space is used to display markers."
117 :group 'ebrowse-tree
118 :type 'integer) 109 :type 'integer)
119 110
120 111
@@ -126,25 +117,21 @@ This space is used to display markers."
126 117
127(defcustom ebrowse-default-declaration-column 25 118(defcustom ebrowse-default-declaration-column 25
128 "The column in which member declarations are displayed in member buffers." 119 "The column in which member declarations are displayed in member buffers."
129 :group 'ebrowse-member
130 :type 'integer) 120 :type 'integer)
131 121
132 122
133(defcustom ebrowse-default-column-width 25 123(defcustom ebrowse-default-column-width 25
134 "The width of the columns in member buffers (short display form)." 124 "The width of the columns in member buffers (short display form)."
135 :group 'ebrowse-member
136 :type 'integer) 125 :type 'integer)
137 126
138 127
139(defcustom ebrowse-member-buffer-name "*Members*" 128(defcustom ebrowse-member-buffer-name "*Members*"
140 "The name of the buffer for member display." 129 "The name of the buffer for member display."
141 :group 'ebrowse-member
142 :type 'string) 130 :type 'string)
143 131
144 132
145(defcustom ebrowse-member-mode-hook nil 133(defcustom ebrowse-member-mode-hook nil
146 "Run in each new member buffer." 134 "Run in each new member buffer."
147 :group 'ebrowse-member
148 :type 'hook) 135 :type 'hook)
149 136
150 137
@@ -156,81 +143,47 @@ This space is used to display markers."
156(defface ebrowse-tree-mark 143(defface ebrowse-tree-mark
157 '((((min-colors 88)) :foreground "red1") 144 '((((min-colors 88)) :foreground "red1")
158 (t :foreground "red")) 145 (t :foreground "red"))
159 "Face for the mark character in the Ebrowse tree." 146 "Face for the mark character in the Ebrowse tree.")
160 :group 'ebrowse-faces)
161 147
162(defface ebrowse-root-class 148(defface ebrowse-root-class
163 '((((min-colors 88)) :weight bold :foreground "blue1") 149 '((((min-colors 88)) :weight bold :foreground "blue1")
164 (t :weight bold :foreground "blue")) 150 (t :weight bold :foreground "blue"))
165 "Face for root classes in the Ebrowse tree." 151 "Face for root classes in the Ebrowse tree.")
166 :group 'ebrowse-faces)
167 152
168(defface ebrowse-file-name '((t :slant italic)) 153(defface ebrowse-file-name '((t :slant italic))
169 "Face for filenames in the Ebrowse tree." 154 "Face for filenames in the Ebrowse tree.")
170 :group 'ebrowse-faces)
171 155
172(defface ebrowse-default '((t)) 156(defface ebrowse-default '((t))
173 "Face for items in the Ebrowse tree which do not have other faces." 157 "Face for items in the Ebrowse tree which do not have other faces.")
174 :group 'ebrowse-faces)
175 158
176(defface ebrowse-member-attribute 159(defface ebrowse-member-attribute
177 '((((min-colors 88)) :foreground "red1") 160 '((((min-colors 88)) :foreground "red1")
178 (t :foreground "red")) 161 (t :foreground "red"))
179 "Face for member attributes." 162 "Face for member attributes.")
180 :group 'ebrowse-faces)
181 163
182(defface ebrowse-member-class 164(defface ebrowse-member-class
183 '((t :foreground "purple")) 165 '((t :foreground "purple"))
184 "Face used to display the class title in member buffers." 166 "Face used to display the class title in member buffers.")
185 :group 'ebrowse-faces)
186 167
187(defface ebrowse-progress 168(defface ebrowse-progress
188 '((((min-colors 88)) :background "blue1") 169 '((((min-colors 88)) :background "blue1")
189 (t :background "blue")) 170 (t :background "blue"))
190 "Face for progress indicator." 171 "Face for progress indicator.")
191 :group 'ebrowse-faces)
192 172
193 173
194;;; Utilities. 174;;; Utilities.
195 175
196(defun ebrowse-some (predicate vector) 176(define-obsolete-function-alias 'ebrowse-some #'seq-some "28.1")
197 "Return true if PREDICATE is true of some element of VECTOR.
198If so, return the value returned by PREDICATE."
199 (let ((length (length vector))
200 (i 0)
201 result)
202 (while (and (< i length) (not result))
203 (setq result (funcall predicate (aref vector i))
204 i (1+ i)))
205 result))
206 177
207 178
208(defun ebrowse-every (predicate vector) 179(define-obsolete-function-alias 'ebrowse-every #'seq-every-p "28.1")
209 "Return true if PREDICATE is true of every element of VECTOR."
210 (let ((length (length vector))
211 (i 0)
212 (result t))
213 (while (and (< i length) result)
214 (setq result (funcall predicate (aref vector i))
215 i (1+ i)))
216 result))
217 180
218 181
219(defun ebrowse-position (item list &optional test) 182(defun ebrowse-position (item list &optional test)
220 "Return the position of ITEM in LIST or nil if not found. 183 "Return the position of ITEM in LIST or nil if not found.
221Compare items with `eq' or TEST if specified." 184Compare items with `eq' or TEST if specified."
222 (let ((i 0) found) 185 (declare (obsolete seq-position "28.1"))
223 (cond (test 186 (seq-position list item (or test #'eql)))
224 (while list
225 (when (funcall test item (car list))
226 (setq found i list nil))
227 (setq list (cdr list) i (1+ i))))
228 (t
229 (while list
230 (when (eq item (car list))
231 (setq found i list nil))
232 (setq list (cdr list) i (1+ i)))))
233 found))
234 187
235 188
236(defmacro ebrowse-ignoring-completion-case (&rest body) 189(defmacro ebrowse-ignoring-completion-case (&rest body)
@@ -242,17 +195,13 @@ Compare items with `eq' or TEST if specified."
242(defmacro ebrowse-for-all-trees (spec &rest body) 195(defmacro ebrowse-for-all-trees (spec &rest body)
243 "For all trees in SPEC, eval BODY." 196 "For all trees in SPEC, eval BODY."
244 (declare (indent 1) (debug ((sexp form) body))) 197 (declare (indent 1) (debug ((sexp form) body)))
245 (let ((var (make-symbol "var")) 198 (let ((spec-var (car spec))
246 (spec-var (car spec))
247 (array (cadr spec))) 199 (array (cadr spec)))
248 `(cl-loop for ,var being the symbols of ,array 200 `(maphash (lambda (_k ,spec-var)
249 as ,spec-var = (get ,var 'ebrowse-root) do 201 (when ,spec-var
250 (when (vectorp ,spec-var) 202 (cl-assert (cl-typep ,spec-var 'ebrowse-ts))
251 ,@body)))) 203 ,@body))
252 204 ,array)))
253;;; Set indentation for macros above.
254
255
256 205
257(defsubst ebrowse-set-face (start end face) 206(defsubst ebrowse-set-face (start end face)
258 "Set face of a region START END to FACE." 207 "Set face of a region START END to FACE."
@@ -264,8 +213,7 @@ Compare items with `eq' or TEST if specified."
264Case is ignored in completions. 213Case is ignored in completions.
265 214
266PROMPT is a string to prompt with; normally it ends in a colon and a space. 215PROMPT is a string to prompt with; normally it ends in a colon and a space.
267TABLE is an alist whose elements' cars are strings, or an obarray. 216TABLE is a completion table.
268TABLE can also be a function to do the completion itself.
269If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. 217If INITIAL-INPUT is non-nil, insert it in the minibuffer initially.
270If it is (STRING . POSITION), the initial input 218If it is (STRING . POSITION), the initial input
271is STRING, but point is placed POSITION characters into the string." 219is STRING, but point is placed POSITION characters into the string."
@@ -304,6 +252,9 @@ otherwise use the current frame's width."
304 252
305;;; Structure definitions 253;;; Structure definitions
306 254
255;; Note: These use `(:type vector) :named' in order to match the
256;; format used in src/BROWSE.
257
307(cl-defstruct (ebrowse-hs (:type vector) :named) 258(cl-defstruct (ebrowse-hs (:type vector) :named)
308 "Header structure found at the head of BROWSE files." 259 "Header structure found at the head of BROWSE files."
309 ;; A version string that is compared against the version number of 260 ;; A version string that is compared against the version number of
@@ -457,19 +408,17 @@ members."
457This must be the same that `ebrowse' uses.") 408This must be the same that `ebrowse' uses.")
458 409
459 410
460(defvar ebrowse--last-regexp nil 411(defvar-local ebrowse--last-regexp nil
461 "Last regular expression searched for in tree and member buffers. 412 "Last regular expression searched for in tree and member buffers.
462Each tree and member buffer maintains its own search history.") 413Each tree and member buffer maintains its own search history.")
463(make-variable-buffer-local 'ebrowse--last-regexp)
464
465 414
466(defconst ebrowse-member-list-accessors 415(defconst ebrowse-member-list-accessors
467 '(ebrowse-ts-member-variables 416 (list #'ebrowse-ts-member-variables
468 ebrowse-ts-member-functions 417 #'ebrowse-ts-member-functions
469 ebrowse-ts-static-variables 418 #'ebrowse-ts-static-variables
470 ebrowse-ts-static-functions 419 #'ebrowse-ts-static-functions
471 ebrowse-ts-friends 420 #'ebrowse-ts-friends
472 ebrowse-ts-types) 421 #'ebrowse-ts-types)
473 "List of accessors for member lists. 422 "List of accessors for member lists.
474Each element is the symbol of an accessor function. 423Each element is the symbol of an accessor function.
475The nth element must be the accessor for the nth member list 424The nth element must be the accessor for the nth member list
@@ -478,8 +427,8 @@ in an `ebrowse-ts' structure.")
478 427
479;;; FIXME: Add more doc strings for the buffer-local variables below. 428;;; FIXME: Add more doc strings for the buffer-local variables below.
480 429
481(defvar ebrowse--tree-obarray nil 430(defvar ebrowse--tree-table nil
482 "Obarray holding all `ebrowse-ts' structures of a class tree. 431 "Hash-table holding all `ebrowse-ts' structures of a class tree.
483Buffer-local in Ebrowse buffers.") 432Buffer-local in Ebrowse buffers.")
484 433
485 434
@@ -637,12 +586,12 @@ Buffer-local in Ebrowse buffers.")
637;;; Operations on `ebrowse-ts' structures 586;;; Operations on `ebrowse-ts' structures
638 587
639(defun ebrowse-files-table (&optional marked-only) 588(defun ebrowse-files-table (&optional marked-only)
640 "Return an obarray containing all files mentioned in the current tree. 589 "Return a hash table containing all files mentioned in the current tree.
641The tree is expected in the buffer-local variable `ebrowse--tree-obarray'. 590The tree is expected in the buffer-local variable `ebrowse--tree-table'.
642MARKED-ONLY non-nil means include marked classes only." 591MARKED-ONLY non-nil means include marked classes only."
643 (let ((files (make-hash-table :test 'equal)) 592 (let ((files (make-hash-table :test 'equal))
644 (i -1)) 593 (i -1))
645 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 594 (ebrowse-for-all-trees (tree ebrowse--tree-table)
646 (when (or (not marked-only) (ebrowse-ts-mark tree)) 595 (when (or (not marked-only) (ebrowse-ts-mark tree))
647 (let ((class (ebrowse-ts-class tree))) 596 (let ((class (ebrowse-ts-class tree)))
648 (when (zerop (% (cl-incf i) 20)) 597 (when (zerop (% (cl-incf i) 20))
@@ -677,7 +626,7 @@ MARKED-ONLY non-nil means include marked classes only."
677 626
678(cl-defun ebrowse-marked-classes-p () 627(cl-defun ebrowse-marked-classes-p ()
679 "Value is non-nil if any class in the current class tree is marked." 628 "Value is non-nil if any class in the current class tree is marked."
680 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 629 (ebrowse-for-all-trees (tree ebrowse--tree-table)
681 (when (ebrowse-ts-mark tree) 630 (when (ebrowse-ts-mark tree)
682 (cl-return-from ebrowse-marked-classes-p tree)))) 631 (cl-return-from ebrowse-marked-classes-p tree))))
683 632
@@ -695,21 +644,21 @@ MARKED-ONLY non-nil means include marked classes only."
695 (ebrowse-cs-name class))) 644 (ebrowse-cs-name class)))
696 645
697 646
698(defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p) 647(defun ebrowse-tree-table-as-alist (&optional qualified-names-p)
699 "Return an alist describing all classes in a tree. 648 "Return an alist describing all classes in a tree.
700Each elements in the list has the form (CLASS-NAME . TREE). 649Each elements in the list has the form (CLASS-NAME . TREE).
701CLASS-NAME is the name of the class. TREE is the 650CLASS-NAME is the name of the class. TREE is the
702class tree whose root is QUALIFIED-CLASS-NAME. 651class tree whose root is QUALIFIED-CLASS-NAME.
703QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME. 652QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME.
704The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." 653The class tree is found in the buffer-local variable `ebrowse--tree-table'."
705 (let (alist) 654 (let (alist)
706 (if qualified-names-p 655 (if qualified-names-p
707 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 656 (ebrowse-for-all-trees (tree ebrowse--tree-table)
708 (setq alist 657 (setq alist
709 (cl-acons (ebrowse-qualified-class-name 658 (cl-acons (ebrowse-qualified-class-name
710 (ebrowse-ts-class tree)) 659 (ebrowse-ts-class tree))
711 tree alist))) 660 tree alist)))
712 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 661 (ebrowse-for-all-trees (tree ebrowse--tree-table)
713 (setq alist 662 (setq alist
714 (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree)) 663 (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree))
715 tree alist)))) 664 tree alist))))
@@ -751,7 +700,7 @@ computes this information lazily."
751 with result = nil 700 with result = nil
752 as search = (pop to-search) 701 as search = (pop to-search)
753 while search finally return result 702 while search finally return result
754 do (ebrowse-for-all-trees (ti ebrowse--tree-obarray) 703 do (ebrowse-for-all-trees (ti ebrowse--tree-table)
755 (when (memq search (ebrowse-ts-subclasses ti)) 704 (when (memq search (ebrowse-ts-subclasses ti))
756 (unless (memq ti result) 705 (unless (memq ti result)
757 (setq result (nconc result (list ti)))) 706 (setq result (nconc result (list ti))))
@@ -875,7 +824,7 @@ NOCONFIRM."
875 "Create a new tree buffer for tree TREE. 824 "Create a new tree buffer for tree TREE.
876The tree was loaded from file TAGS-FILE. 825The tree was loaded from file TAGS-FILE.
877HEADER is the header structure of the file. 826HEADER is the header structure of the file.
878CLASSES is an obarray with a symbol for each class in the tree. 827CLASSES is a hash-table with an entry for each class in the tree.
879POP non-nil means popup the buffer up at the end. 828POP non-nil means popup the buffer up at the end.
880Return the buffer created." 829Return the buffer created."
881 (let ((name ebrowse-tree-buffer-name)) 830 (let ((name ebrowse-tree-buffer-name))
@@ -883,7 +832,7 @@ Return the buffer created."
883 (ebrowse-tree-mode) 832 (ebrowse-tree-mode)
884 (setq ebrowse--tree tree 833 (setq ebrowse--tree tree
885 ebrowse--tags-file-name tags-file 834 ebrowse--tags-file-name tags-file
886 ebrowse--tree-obarray classes 835 ebrowse--tree-table classes
887 ebrowse--header header 836 ebrowse--header header
888 ebrowse--frozen-flag nil) 837 ebrowse--frozen-flag nil)
889 (ebrowse-redraw-tree) 838 (ebrowse-redraw-tree)
@@ -895,13 +844,13 @@ Return the buffer created."
895 844
896 845
897 846
898;;; Operations for member obarrays 847;;; Operations for member tables
899 848
900(defun ebrowse-fill-member-table () 849(defun ebrowse-fill-member-table ()
901 "Return an obarray holding all members of all classes in the current tree. 850 "Return a hash table holding all members of all classes in the current tree.
902 851
903For each member, a symbol is added to the obarray. Members are 852For each member, a symbol is added to the table. Members are
904extracted from the buffer-local tree `ebrowse--tree-obarray'. 853extracted from the buffer-local tree `ebrowse--tree-table'.
905 854
906Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST 855Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST
907MEMBER) where TREE is the tree in which the member is defined, 856MEMBER) where TREE is the tree in which the member is defined,
@@ -909,26 +858,23 @@ MEMBER-LIST is a symbol describing the member list in which the member
909is found, and MEMBER is a MEMBER structure describing the member. 858is found, and MEMBER is a MEMBER structure describing the member.
910 859
911The slot `member-table' of the buffer-local header structure of 860The slot `member-table' of the buffer-local header structure of
912type `ebrowse-hs' is set to the resulting obarray." 861type `ebrowse-hs' is set to the resulting table."
913 (let ((members (make-hash-table :test 'equal)) 862 (let ((members (make-hash-table :test 'equal))
914 (i -1)) 863 (i -1))
915 (setf (ebrowse-hs-member-table ebrowse--header) nil) 864 (setf (ebrowse-hs-member-table ebrowse--header) nil)
916 (garbage-collect) 865 (garbage-collect)
917 ;; For all classes... 866 ;; For all classes...
918 (ebrowse-for-all-trees (c ebrowse--tree-obarray) 867 (ebrowse-for-all-trees (c ebrowse--tree-table)
919 (when (zerop (% (cl-incf i) 10)) 868 (when (zerop (% (cl-incf i) 10))
920 (ebrowse-show-progress "Preparing member lookup" (zerop i))) 869 (ebrowse-show-progress "Preparing member lookup" (zerop i)))
921 (dolist (f ebrowse-member-list-accessors) 870 (dolist (f ebrowse-member-list-accessors)
922 (dolist (m (funcall f c)) 871 (dolist (m (funcall f c))
923 (let* ((member-name (ebrowse-ms-name m)) 872 (push (list c f m) (gethash (ebrowse-ms-name m) members)))))
924 (value (gethash member-name members)))
925 (push (list c f m) value)
926 (puthash member-name value members)))))
927 (setf (ebrowse-hs-member-table ebrowse--header) members))) 873 (setf (ebrowse-hs-member-table ebrowse--header) members)))
928 874
929 875
930(defun ebrowse-member-table (header) 876(defun ebrowse-member-table (header)
931 "Return the member obarray. Build it if it hasn't been set up yet. 877 "Return the member table. Build it if it hasn't been set up yet.
932HEADER is the tree header structure of the class tree." 878HEADER is the tree header structure of the class tree."
933 (when (null (ebrowse-hs-member-table header)) 879 (when (null (ebrowse-hs-member-table header))
934 (cl-loop for buffer in (ebrowse-browser-buffer-list) 880 (cl-loop for buffer in (ebrowse-browser-buffer-list)
@@ -940,19 +886,18 @@ HEADER is the tree header structure of the class tree."
940 886
941 887
942 888
943;;; Operations on TREE obarrays 889;;; Operations on TREE tables
944 890
945(defun ebrowse-build-tree-obarray (tree) 891(defun ebrowse-build-tree-table (tree)
946 "Make sure every class in TREE is represented by a unique object. 892 "Make sure every class in TREE is represented by a unique object.
947Build obarray of all classes in TREE." 893Build hash table of all classes in TREE."
948 (let ((classes (make-vector 127 0))) 894 (let ((classes (make-hash-table :test #'equal)))
949 ;; Add root classes... 895 ;; Add root classes...
950 (cl-loop for root in tree 896 (cl-loop for root in tree
951 as sym = 897 do (let ((name (ebrowse-qualified-class-name
952 (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) 898 (ebrowse-ts-class root))))
953 classes) 899 (unless (gethash name classes)
954 do (unless (get sym 'ebrowse-root) 900 (setf (gethash name classes) root))))
955 (setf (get sym 'ebrowse-root) root)))
956 ;; Process subclasses 901 ;; Process subclasses
957 (ebrowse-insert-supers tree classes) 902 (ebrowse-insert-supers tree classes)
958 classes)) 903 classes))
@@ -962,7 +907,7 @@ Build obarray of all classes in TREE."
962 "Build base class lists in class tree TREE. 907 "Build base class lists in class tree TREE.
963CLASSES is an obarray used to collect classes. 908CLASSES is an obarray used to collect classes.
964 909
965Helper function for `ebrowse-build-tree-obarray'. Base classes should 910Helper function for `ebrowse-build-tree-table'. Base classes should
966be ordered so that immediate base classes come first, then the base 911be ordered so that immediate base classes come first, then the base
967class of the immediate base class and so on. This means that we must 912class of the immediate base class and so on. This means that we must
968construct the base-class list top down with adding each level at the 913construct the base-class list top down with adding each level at the
@@ -974,23 +919,21 @@ if for some reason a circle is in the inheritance graph."
974 as subclasses = (ebrowse-ts-subclasses class) do 919 as subclasses = (ebrowse-ts-subclasses class) do
975 ;; Make sure every class is represented by a unique object 920 ;; Make sure every class is represented by a unique object
976 (cl-loop for subclass on subclasses 921 (cl-loop for subclass on subclasses
977 as sym = (intern
978 (ebrowse-qualified-class-name
979 (ebrowse-ts-class (car subclass)))
980 classes)
981 do 922 do
982 ;; Replace the subclass tree with the one found in 923 (let ((name (ebrowse-qualified-class-name
983 ;; CLASSES if there is already an entry for that class 924 (ebrowse-ts-class (car subclass)))))
984 ;; in it. Otherwise make a new entry. 925 ;; Replace the subclass tree with the one found in
985 ;; 926 ;; CLASSES if there is already an entry for that class
986 ;; CAVEAT: If by some means (e.g., use of the 927 ;; in it. Otherwise make a new entry.
987 ;; preprocessor in class declarations, a name is marked 928 ;;
988 ;; as a subclass of itself on some path, we would end up 929 ;; CAVEAT: If by some means (e.g., use of the
989 ;; in an endless loop. We have to omit subclasses from 930 ;; preprocessor in class declarations, a name is marked
990 ;; the recursion that already have been processed. 931 ;; as a subclass of itself on some path, we would end up
991 (if (get sym 'ebrowse-root) 932 ;; in an endless loop. We have to omit subclasses from
992 (setf (car subclass) (get sym 'ebrowse-root)) 933 ;; the recursion that already have been processed.
993 (setf (get sym 'ebrowse-root) (car subclass)))) 934 (if (gethash name classes)
935 (setf (car subclass) (gethash name classes))
936 (setf (gethash name classes) (car subclass)))))
994 ;; Process subclasses 937 ;; Process subclasses
995 (ebrowse-insert-supers subclasses classes))) 938 (ebrowse-insert-supers subclasses classes)))
996 939
@@ -1072,20 +1015,17 @@ Tree mode key bindings:
1072 (erase-buffer) 1015 (erase-buffer)
1073 (message nil)) 1016 (message nil))
1074 1017
1075 (set (make-local-variable 'ebrowse--show-file-names-flag) nil) 1018 (setq-local ebrowse--show-file-names-flag nil)
1076 (set (make-local-variable 'ebrowse--tree-obarray) (make-vector 127 0)) 1019 (setq-local ebrowse--frozen-flag nil)
1077 (set (make-local-variable 'ebrowse--frozen-flag) nil)
1078 (setq mode-line-buffer-identification ident) 1020 (setq mode-line-buffer-identification ident)
1079 (setq buffer-read-only t) 1021 (setq buffer-read-only t)
1080 (add-to-invisibility-spec '(ebrowse . t)) 1022 (add-to-invisibility-spec '(ebrowse . t))
1081 (set (make-local-variable 'revert-buffer-function) 1023 (setq-local revert-buffer-function #'ebrowse-revert-tree-buffer-from-file)
1082 #'ebrowse-revert-tree-buffer-from-file) 1024 (setq-local ebrowse--header header)
1083 (set (make-local-variable 'ebrowse--header) header) 1025 (setq-local ebrowse--tree tree)
1084 (set (make-local-variable 'ebrowse--tree) tree) 1026 (setq-local ebrowse--tags-file-name buffer-file-name)
1085 (set (make-local-variable 'ebrowse--tags-file-name) buffer-file-name) 1027 (setq-local ebrowse--tree-table (and tree (ebrowse-build-tree-table tree)))
1086 (set (make-local-variable 'ebrowse--tree-obarray) 1028 (setq-local ebrowse--frozen-flag nil)
1087 (and tree (ebrowse-build-tree-obarray tree)))
1088 (set (make-local-variable 'ebrowse--frozen-flag) nil)
1089 1029
1090 (add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t) 1030 (add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t)
1091 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) 1031 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))
@@ -1110,18 +1050,18 @@ Tree mode key bindings:
1110(defun ebrowse-remove-class-and-kill-member-buffers (tree class) 1050(defun ebrowse-remove-class-and-kill-member-buffers (tree class)
1111 "Remove from TREE class CLASS. 1051 "Remove from TREE class CLASS.
1112Kill all member buffers still containing a reference to the class." 1052Kill all member buffers still containing a reference to the class."
1113 (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class)) 1053 (setf tree (delq class tree)
1114 ebrowse--tree-obarray))) 1054 (gethash (ebrowse-cs-name (ebrowse-ts-class class))
1115 (setf tree (delq class tree) 1055 ebrowse--tree-table)
1116 (get sym 'ebrowse-root) nil) 1056 nil)
1117 (dolist (root tree) 1057 (dolist (root tree)
1118 (setf (ebrowse-ts-subclasses root) 1058 (setf (ebrowse-ts-subclasses root)
1119 (delq class (ebrowse-ts-subclasses root)) 1059 (delq class (ebrowse-ts-subclasses root))
1120 (ebrowse-ts-base-classes root) nil) 1060 (ebrowse-ts-base-classes root) nil)
1121 (ebrowse-remove-class-and-kill-member-buffers 1061 (ebrowse-remove-class-and-kill-member-buffers
1122 (ebrowse-ts-subclasses root) class)) 1062 (ebrowse-ts-subclasses root) class))
1123 (ebrowse-kill-member-buffers-displaying class) 1063 (ebrowse-kill-member-buffers-displaying class)
1124 tree)) 1064 tree)
1125 1065
1126 1066
1127(defun ebrowse-remove-class-at-point (forced) 1067(defun ebrowse-remove-class-at-point (forced)
@@ -1184,7 +1124,7 @@ If given a numeric N-TIMES argument, mark that many classes."
1184(defun ebrowse-mark-all-classes (prefix) 1124(defun ebrowse-mark-all-classes (prefix)
1185 "Unmark, with PREFIX mark, all classes in the tree." 1125 "Unmark, with PREFIX mark, all classes in the tree."
1186 (interactive "P") 1126 (interactive "P")
1187 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 1127 (ebrowse-for-all-trees (tree ebrowse--tree-table)
1188 (setf (ebrowse-ts-mark tree) prefix)) 1128 (setf (ebrowse-ts-mark tree) prefix))
1189 (ebrowse-redraw-marks (point-min) (point-max))) 1129 (ebrowse-redraw-marks (point-min) (point-max)))
1190 1130
@@ -1277,17 +1217,17 @@ With PREFIX, insert that many filenames."
1277 1217
1278(defun ebrowse-browser-buffer-list () 1218(defun ebrowse-browser-buffer-list ()
1279 "Return a list of all tree or member buffers." 1219 "Return a list of all tree or member buffers."
1280 (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) 1220 (cl-delete-if-not #'ebrowse-buffer-p (buffer-list)))
1281 1221
1282 1222
1283(defun ebrowse-member-buffer-list () 1223(defun ebrowse-member-buffer-list ()
1284 "Return a list of all member buffers." 1224 "Return a list of all member buffers."
1285 (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) 1225 (cl-delete-if-not #'ebrowse-member-buffer-p (buffer-list)))
1286 1226
1287 1227
1288(defun ebrowse-tree-buffer-list () 1228(defun ebrowse-tree-buffer-list ()
1289 "Return a list of all tree buffers." 1229 "Return a list of all tree buffers."
1290 (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) 1230 (cl-delete-if-not #'ebrowse-tree-buffer-p (buffer-list)))
1291 1231
1292 1232
1293(defun ebrowse-known-class-trees-buffer-list () 1233(defun ebrowse-known-class-trees-buffer-list ()
@@ -1396,7 +1336,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise."
1396 "): ") 1336 "): ")
1397 nil nil ebrowse--indentation)))) 1337 nil nil ebrowse--indentation))))
1398 (when (cl-plusp width) 1338 (when (cl-plusp width)
1399 (set (make-local-variable 'ebrowse--indentation) width) 1339 (setq-local ebrowse--indentation width)
1400 (ebrowse-redraw-tree)))) 1340 (ebrowse-redraw-tree))))
1401 1341
1402 1342
@@ -1409,7 +1349,7 @@ Read a class name from the minibuffer if CLASS is nil."
1409 (unless class 1349 (unless class
1410 (setf class 1350 (setf class
1411 (completing-read "Goto class: " 1351 (completing-read "Goto class: "
1412 (ebrowse-tree-obarray-as-alist) nil t))) 1352 (ebrowse-tree-table-as-alist) nil t)))
1413 (goto-char (point-min)) 1353 (goto-char (point-min))
1414 (widen) 1354 (widen)
1415 (setq ebrowse--last-regexp (concat "\\b" class "\\b")) 1355 (setq ebrowse--last-regexp (concat "\\b" class "\\b"))
@@ -1426,37 +1366,37 @@ Read a class name from the minibuffer if CLASS is nil."
1426(defun ebrowse-tree-command:show-member-variables (arg) 1366(defun ebrowse-tree-command:show-member-variables (arg)
1427 "Display member variables; with prefix ARG in frozen member buffer." 1367 "Display member variables; with prefix ARG in frozen member buffer."
1428 (interactive "P") 1368 (interactive "P")
1429 (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg)) 1369 (ebrowse-display-member-buffer #'ebrowse-ts-member-variables arg))
1430 1370
1431 1371
1432(defun ebrowse-tree-command:show-member-functions (&optional arg) 1372(defun ebrowse-tree-command:show-member-functions (&optional arg)
1433 "Display member functions; with prefix ARG in frozen member buffer." 1373 "Display member functions; with prefix ARG in frozen member buffer."
1434 (interactive "P") 1374 (interactive "P")
1435 (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg)) 1375 (ebrowse-display-member-buffer #'ebrowse-ts-member-functions arg))
1436 1376
1437 1377
1438(defun ebrowse-tree-command:show-static-member-variables (arg) 1378(defun ebrowse-tree-command:show-static-member-variables (arg)
1439 "Display static member variables; with prefix ARG in frozen member buffer." 1379 "Display static member variables; with prefix ARG in frozen member buffer."
1440 (interactive "P") 1380 (interactive "P")
1441 (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg)) 1381 (ebrowse-display-member-buffer #'ebrowse-ts-static-variables arg))
1442 1382
1443 1383
1444(defun ebrowse-tree-command:show-static-member-functions (arg) 1384(defun ebrowse-tree-command:show-static-member-functions (arg)
1445 "Display static member functions; with prefix ARG in frozen member buffer." 1385 "Display static member functions; with prefix ARG in frozen member buffer."
1446 (interactive "P") 1386 (interactive "P")
1447 (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg)) 1387 (ebrowse-display-member-buffer #'ebrowse-ts-static-functions arg))
1448 1388
1449 1389
1450(defun ebrowse-tree-command:show-friends (arg) 1390(defun ebrowse-tree-command:show-friends (arg)
1451 "Display friend functions; with prefix ARG in frozen member buffer." 1391 "Display friend functions; with prefix ARG in frozen member buffer."
1452 (interactive "P") 1392 (interactive "P")
1453 (ebrowse-display-member-buffer 'ebrowse-ts-friends arg)) 1393 (ebrowse-display-member-buffer #'ebrowse-ts-friends arg))
1454 1394
1455 1395
1456(defun ebrowse-tree-command:show-types (arg) 1396(defun ebrowse-tree-command:show-types (arg)
1457 "Display types defined in a class; with prefix ARG in frozen member buffer." 1397 "Display types defined in a class; with prefix ARG in frozen member buffer."
1458 (interactive "P") 1398 (interactive "P")
1459 (ebrowse-display-member-buffer 'ebrowse-ts-types arg)) 1399 (ebrowse-display-member-buffer #'ebrowse-ts-types arg))
1460 1400
1461 1401
1462 1402
@@ -1562,12 +1502,12 @@ The new frame is deleted when you quit viewing the file in that frame."
1562 (had-a-buf (get-file-buffer file)) 1502 (had-a-buf (get-file-buffer file))
1563 (buf-to-view (find-file-noselect file))) 1503 (buf-to-view (find-file-noselect file)))
1564 (switch-to-buffer-other-frame buf-to-view) 1504 (switch-to-buffer-other-frame buf-to-view)
1565 (set (make-local-variable 'ebrowse--frame-configuration) 1505 (setq-local ebrowse--frame-configuration
1566 old-frame-configuration) 1506 old-frame-configuration)
1567 (set (make-local-variable 'ebrowse--view-exit-action) 1507 (setq-local ebrowse--view-exit-action
1568 (and (not had-a-buf) 1508 (and (not had-a-buf)
1569 (not (buffer-modified-p buf-to-view)) 1509 (not (buffer-modified-p buf-to-view))
1570 'kill-buffer)) 1510 #'kill-buffer))
1571 (view-mode-enter (cons (selected-window) (cons (selected-window) t)) 1511 (view-mode-enter (cons (selected-window) (cons (selected-window) t))
1572 'ebrowse-view-exit-fn))) 1512 'ebrowse-view-exit-fn)))
1573 1513
@@ -1934,7 +1874,7 @@ COLLAPSE non-nil means collapse the branch."
1934 (when (memq 'mode-name mode-line-format) 1874 (when (memq 'mode-name mode-line-format)
1935 (setq mode-line-format (copy-sequence mode-line-format)) 1875 (setq mode-line-format (copy-sequence mode-line-format))
1936 (setcar (memq 'mode-name mode-line-format) "Tree Buffers")) 1876 (setcar (memq 'mode-name mode-line-format) "Tree Buffers"))
1937 (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") 1877 (setq-local Helper-return-blurb "return to buffer editing")
1938 (setq truncate-lines t 1878 (setq truncate-lines t
1939 buffer-read-only t)) 1879 buffer-read-only t))
1940 1880
@@ -2145,41 +2085,31 @@ See `Electric-command-loop' for a description of STATE and CONDITION."
2145(define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members" 2085(define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members"
2146 "Major mode for Ebrowse member buffers." 2086 "Major mode for Ebrowse member buffers."
2147 (mapc #'make-local-variable 2087 (mapc #'make-local-variable
2148 '(ebrowse--decl-column ;display column 2088 '(ebrowse--n-columns ;number of short columns
2149 ebrowse--n-columns ;number of short columns
2150 ebrowse--column-width ;width of columns above
2151 ebrowse--show-inherited-flag ;include inherited members?
2152 ebrowse--filters ;public, protected, private
2153 ebrowse--accessor ;vars, functions, friends 2089 ebrowse--accessor ;vars, functions, friends
2154 ebrowse--displayed-class ;class displayed 2090 ebrowse--displayed-class ;class displayed
2155 ebrowse--long-display-flag ;display with regexps?
2156 ebrowse--source-regexp-flag ;show source regexp?
2157 ebrowse--attributes-flag ;show `virtual' and `inline'
2158 ebrowse--member-list ;list of members displayed 2091 ebrowse--member-list ;list of members displayed
2159 ebrowse--tree ;the class tree 2092 ebrowse--tree ;the class tree
2160 ebrowse--member-mode-strings ;part of mode line 2093 ebrowse--member-mode-strings ;part of mode line
2161 ebrowse--tags-file-name ; 2094 ebrowse--tags-file-name ;
2162 ebrowse--header 2095 ebrowse--header
2163 ebrowse--tree-obarray 2096 ebrowse--tree-table
2164 ebrowse--virtual-display-flag
2165 ebrowse--inline-display-flag
2166 ebrowse--const-display-flag
2167 ebrowse--pure-display-flag
2168 ebrowse--frozen-flag)) ;buffer not automagically reused 2097 ebrowse--frozen-flag)) ;buffer not automagically reused
2169 (setq mode-line-buffer-identification 2098 (setq-local
2170 (propertized-buffer-identification "C++ Members") 2099 mode-line-buffer-identification
2171 buffer-read-only t 2100 (propertized-buffer-identification "C++ Members")
2172 ebrowse--long-display-flag nil 2101 buffer-read-only t
2173 ebrowse--attributes-flag t 2102 ebrowse--long-display-flag nil ;display with regexps?
2174 ebrowse--show-inherited-flag t 2103 ebrowse--attributes-flag t ;show `virtual' and `inline'
2175 ebrowse--source-regexp-flag nil 2104 ebrowse--show-inherited-flag t ;include inherited members?
2176 ebrowse--filters [0 1 2] 2105 ebrowse--source-regexp-flag nil ;show source regexp?
2177 ebrowse--decl-column ebrowse-default-declaration-column 2106 ebrowse--filters [0 1 2] ;public, protected, private
2178 ebrowse--column-width ebrowse-default-column-width 2107 ebrowse--decl-column ebrowse-default-declaration-column ;display column
2179 ebrowse--virtual-display-flag nil 2108 ebrowse--column-width ebrowse-default-column-width ;width of columns above
2180 ebrowse--inline-display-flag nil 2109 ebrowse--virtual-display-flag nil
2181 ebrowse--const-display-flag nil 2110 ebrowse--inline-display-flag nil
2182 ebrowse--pure-display-flag nil) 2111 ebrowse--const-display-flag nil
2112 ebrowse--pure-display-flag nil)
2183 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))) 2113 (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))))
2184 2114
2185 2115
@@ -2257,10 +2187,10 @@ make one."
2257 (ebrowse-create-tree-buffer ebrowse--tree 2187 (ebrowse-create-tree-buffer ebrowse--tree
2258 ebrowse--tags-file-name 2188 ebrowse--tags-file-name
2259 ebrowse--header 2189 ebrowse--header
2260 ebrowse--tree-obarray 2190 ebrowse--tree-table
2261 'pop)))) 2191 'pop))))
2262 (and buf 2192 (and buf
2263 (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf)) 2193 (funcall (if arg #'switch-to-buffer #'pop-to-buffer) buf))
2264 buf)) 2194 buf))
2265 2195
2266 2196
@@ -2276,8 +2206,9 @@ make one."
2276 2206
2277(defun ebrowse-cyclic-display-next/previous-member-list (incr) 2207(defun ebrowse-cyclic-display-next/previous-member-list (incr)
2278 "Switch buffer to INCR'th next/previous list of members." 2208 "Switch buffer to INCR'th next/previous list of members."
2279 (let ((index (ebrowse-position ebrowse--accessor 2209 (let ((index (seq-position ebrowse-member-list-accessors
2280 ebrowse-member-list-accessors))) 2210 ebrowse--accessor
2211 #'eql)))
2281 (setf ebrowse--accessor 2212 (setf ebrowse--accessor
2282 (cond ((cl-plusp incr) 2213 (cond ((cl-plusp incr)
2283 (or (nth (1+ index) 2214 (or (nth (1+ index)
@@ -2306,37 +2237,37 @@ make one."
2306(defun ebrowse-display-function-member-list () 2237(defun ebrowse-display-function-member-list ()
2307 "Display the list of member functions." 2238 "Display the list of member functions."
2308 (interactive) 2239 (interactive)
2309 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions)) 2240 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-functions))
2310 2241
2311 2242
2312(defun ebrowse-display-variables-member-list () 2243(defun ebrowse-display-variables-member-list ()
2313 "Display the list of member variables." 2244 "Display the list of member variables."
2314 (interactive) 2245 (interactive)
2315 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables)) 2246 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-member-variables))
2316 2247
2317 2248
2318(defun ebrowse-display-static-variables-member-list () 2249(defun ebrowse-display-static-variables-member-list ()
2319 "Display the list of static member variables." 2250 "Display the list of static member variables."
2320 (interactive) 2251 (interactive)
2321 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables)) 2252 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-variables))
2322 2253
2323 2254
2324(defun ebrowse-display-static-functions-member-list () 2255(defun ebrowse-display-static-functions-member-list ()
2325 "Display the list of static member functions." 2256 "Display the list of static member functions."
2326 (interactive) 2257 (interactive)
2327 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions)) 2258 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-static-functions))
2328 2259
2329 2260
2330(defun ebrowse-display-friends-member-list () 2261(defun ebrowse-display-friends-member-list ()
2331 "Display the list of friends." 2262 "Display the list of friends."
2332 (interactive) 2263 (interactive)
2333 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends)) 2264 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-friends))
2334 2265
2335 2266
2336(defun ebrowse-display-types-member-list () 2267(defun ebrowse-display-types-member-list ()
2337 "Display the list of types." 2268 "Display the list of types."
2338 (interactive) 2269 (interactive)
2339 (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types)) 2270 (ebrowse-display-member-list-for-accessor #'ebrowse-ts-types))
2340 2271
2341 2272
2342 2273
@@ -2565,8 +2496,8 @@ TAGS-FILE is the file name of the BROWSE file."
2565 "Force buffer redisplay." 2496 "Force buffer redisplay."
2566 (interactive) 2497 (interactive)
2567 (let ((display-fn (if ebrowse--long-display-flag 2498 (let ((display-fn (if ebrowse--long-display-flag
2568 'ebrowse-draw-member-long-fn 2499 #'ebrowse-draw-member-long-fn
2569 'ebrowse-draw-member-short-fn))) 2500 #'ebrowse-draw-member-short-fn)))
2570 (with-silent-modifications 2501 (with-silent-modifications
2571 (erase-buffer) 2502 (erase-buffer)
2572 ;; Show this class 2503 ;; Show this class
@@ -2610,7 +2541,7 @@ the class cursor is on."
2610 "Start point for member buffer creation. 2541 "Start point for member buffer creation.
2611LIST is the member list to display. STAND-ALONE non-nil 2542LIST is the member list to display. STAND-ALONE non-nil
2612means the member buffer is standalone. CLASS is its class." 2543means the member buffer is standalone. CLASS is its class."
2613 (let* ((classes ebrowse--tree-obarray) 2544 (let* ((classes ebrowse--tree-table)
2614 (tree ebrowse--tree) 2545 (tree ebrowse--tree)
2615 (tags-file ebrowse--tags-file-name) 2546 (tags-file ebrowse--tags-file-name)
2616 (header ebrowse--header) 2547 (header ebrowse--header)
@@ -2630,7 +2561,7 @@ means the member buffer is standalone. CLASS is its class."
2630 (setq ebrowse--member-list (funcall list class) 2561 (setq ebrowse--member-list (funcall list class)
2631 ebrowse--displayed-class class 2562 ebrowse--displayed-class class
2632 ebrowse--accessor list 2563 ebrowse--accessor list
2633 ebrowse--tree-obarray classes 2564 ebrowse--tree-table classes
2634 ebrowse--frozen-flag stand-alone 2565 ebrowse--frozen-flag stand-alone
2635 ebrowse--tags-file-name tags-file 2566 ebrowse--tags-file-name tags-file
2636 ebrowse--header header 2567 ebrowse--header header
@@ -2842,7 +2773,7 @@ REPEAT, if specified, says repeat the search REPEAT times."
2842 2773
2843 2774
2844(cl-defun ebrowse-move-point-to-member (name &optional count &aux member) 2775(cl-defun ebrowse-move-point-to-member (name &optional count &aux member)
2845 "Set point on member NAME in the member buffer 2776 "Set point on member NAME in the member buffer.
2846COUNT, if specified, says search the COUNT'th member with the same name." 2777COUNT, if specified, says search the COUNT'th member with the same name."
2847 (goto-char (point-min)) 2778 (goto-char (point-min))
2848 (widen) 2779 (widen)
@@ -2867,7 +2798,8 @@ COMPL-LIST is a completion list to use."
2867 (class (or (ebrowse-completing-read-value title compl-list initial) 2798 (class (or (ebrowse-completing-read-value title compl-list initial)
2868 (error "Not found")))) 2799 (error "Not found"))))
2869 (setf ebrowse--displayed-class class 2800 (setf ebrowse--displayed-class class
2870 ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) 2801 ebrowse--member-list (funcall ebrowse--accessor
2802 ebrowse--displayed-class))
2871 (ebrowse-redisplay-member-buffer))) 2803 (ebrowse-redisplay-member-buffer)))
2872 2804
2873 2805
@@ -2875,7 +2807,9 @@ COMPL-LIST is a completion list to use."
2875 "Switch member buffer to a class read from the minibuffer." 2807 "Switch member buffer to a class read from the minibuffer."
2876 (interactive) 2808 (interactive)
2877 (ebrowse-switch-member-buffer-to-other-class 2809 (ebrowse-switch-member-buffer-to-other-class
2878 "Goto class: " (ebrowse-tree-obarray-as-alist))) 2810 "Goto class: "
2811 ;; FIXME: Why not use the hash-table as-is?
2812 (ebrowse-tree-table-as-alist)))
2879 2813
2880 2814
2881(defun ebrowse-switch-member-buffer-to-base-class (arg) 2815(defun ebrowse-switch-member-buffer-to-base-class (arg)
@@ -2927,8 +2861,9 @@ Prefix arg INC specifies which one."
2927 (cl-first supers)))) 2861 (cl-first supers))))
2928 (unless tree (error "Not found")) 2862 (unless tree (error "Not found"))
2929 (setq containing-list (ebrowse-ts-subclasses tree))))) 2863 (setq containing-list (ebrowse-ts-subclasses tree)))))
2930 (setq index (+ inc (ebrowse-position ebrowse--displayed-class 2864 (setq index (+ inc (seq-position containing-list
2931 containing-list))) 2865 ebrowse--displayed-class
2866 #'eql)))
2932 (cond ((cl-minusp index) (message "No previous class")) 2867 (cond ((cl-minusp index) (message "No previous class"))
2933 ((null (nth index containing-list)) (message "No next class"))) 2868 ((null (nth index containing-list)) (message "No next class")))
2934 (setq index (max 0 (min index (1- (length containing-list))))) 2869 (setq index (max 0 (min index (1- (length containing-list)))))
@@ -2943,16 +2878,16 @@ Prefix arg INC specifies which one."
2943Prefix arg ARG says which class should be displayed. Default is 2878Prefix arg ARG says which class should be displayed. Default is
2944the first derived class." 2879the first derived class."
2945 (interactive "P") 2880 (interactive "P")
2946 (cl-flet ((ebrowse-tree-obarray-as-alist () 2881 (cl-flet ((ebrowse-tree-table-as-alist ()
2947 (cl-loop for s in (ebrowse-ts-subclasses 2882 (cl-loop for s in (ebrowse-ts-subclasses
2948 ebrowse--displayed-class) 2883 ebrowse--displayed-class)
2949 collect (cons (ebrowse-cs-name 2884 collect (cons (ebrowse-cs-name (ebrowse-ts-class s))
2950 (ebrowse-ts-class s)) s)))) 2885 s))))
2951 (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class) 2886 (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
2952 (error "No derived classes")))) 2887 (error "No derived classes"))))
2953 (if (and arg (cl-second subs)) 2888 (if (and arg (cl-second subs))
2954 (ebrowse-switch-member-buffer-to-other-class 2889 (ebrowse-switch-member-buffer-to-other-class
2955 "Goto derived class: " (ebrowse-tree-obarray-as-alist)) 2890 "Goto derived class: " (ebrowse-tree-table-as-alist))
2956 (setq ebrowse--displayed-class (cl-first subs) 2891 (setq ebrowse--displayed-class (cl-first subs)
2957 ebrowse--member-list 2892 ebrowse--member-list
2958 (funcall ebrowse--accessor ebrowse--displayed-class)) 2893 (funcall ebrowse--accessor ebrowse--displayed-class))
@@ -3403,7 +3338,8 @@ It is a list (TREE ACCESSOR MEMBER)."
3403 (switch-to-buffer buffer) 3338 (switch-to-buffer buffer)
3404 (setq ebrowse--displayed-class (cl-first info) 3339 (setq ebrowse--displayed-class (cl-first info)
3405 ebrowse--accessor (cl-second info) 3340 ebrowse--accessor (cl-second info)
3406 ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) 3341 ebrowse--member-list (funcall ebrowse--accessor
3342 ebrowse--displayed-class))
3407 (ebrowse-redisplay-member-buffer))) 3343 (ebrowse-redisplay-member-buffer)))
3408 (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info))))) 3344 (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info)))))
3409 3345
@@ -3513,28 +3449,20 @@ KIND is an additional string printed in the buffer."
3513 (_ "unknown")) 3449 (_ "unknown"))
3514 "\n"))) 3450 "\n")))
3515 3451
3516(defvar ebrowse-last-completion nil 3452(defvar-local ebrowse-last-completion nil
3517 "Text inserted by the last completion operation.") 3453 "Text inserted by the last completion operation.")
3518 3454
3519 3455
3520(defvar ebrowse-last-completion-start nil 3456(defvar-local ebrowse-last-completion-start nil
3521 "String which was the basis for the last completion operation.") 3457 "String which was the basis for the last completion operation.")
3522 3458
3523 3459
3524(defvar ebrowse-last-completion-location nil 3460(defvar-local ebrowse-last-completion-location nil
3525 "Buffer position at which the last completion operation was initiated.") 3461 "Buffer position at which the last completion operation was initiated.")
3526 3462
3527 3463
3528(defvar ebrowse-last-completion-obarray nil 3464(defvar-local ebrowse-last-completion-table nil
3529 "Member used in last completion operation.") 3465 "Member used in last completion operation.")
3530
3531
3532(make-variable-buffer-local 'ebrowse-last-completion-obarray)
3533(make-variable-buffer-local 'ebrowse-last-completion-location)
3534(make-variable-buffer-local 'ebrowse-last-completion)
3535(make-variable-buffer-local 'ebrowse-last-completion-start)
3536
3537
3538 3466
3539(defun ebrowse-some-member-table () 3467(defun ebrowse-some-member-table ()
3540 "Return a hash table containing all members of a tree. 3468 "Return a hash table containing all members of a tree.
@@ -3552,7 +3480,7 @@ use choose a tree."
3552(defun ebrowse-cyclic-successor-in-string-list (string list) 3480(defun ebrowse-cyclic-successor-in-string-list (string list)
3553 "Return the item following STRING in LIST. 3481 "Return the item following STRING in LIST.
3554If STRING is the last element, return the first element as successor." 3482If STRING is the last element, return the first element as successor."
3555 (or (nth (1+ (ebrowse-position string list 'string=)) list) 3483 (or (nth (1+ (seq-position list string #'string=)) list)
3556 (cl-first list))) 3484 (cl-first list)))
3557 3485
3558 3486
@@ -3583,7 +3511,7 @@ completion."
3583 ;; expansion ended, insert the next expansion. 3511 ;; expansion ended, insert the next expansion.
3584 ((eq (point) ebrowse-last-completion-location) 3512 ((eq (point) ebrowse-last-completion-location)
3585 (setf list (all-completions ebrowse-last-completion-start 3513 (setf list (all-completions ebrowse-last-completion-start
3586 ebrowse-last-completion-obarray) 3514 ebrowse-last-completion-table)
3587 completion (ebrowse-cyclic-successor-in-string-list 3515 completion (ebrowse-cyclic-successor-in-string-list
3588 ebrowse-last-completion list)) 3516 ebrowse-last-completion list))
3589 (cond ((null completion) 3517 (cond ((null completion)
@@ -3599,7 +3527,7 @@ completion."
3599 ;; buffer: Start new completion. 3527 ;; buffer: Start new completion.
3600 (t 3528 (t
3601 (let* ((members (ebrowse-some-member-table)) 3529 (let* ((members (ebrowse-some-member-table))
3602 (completion (cl-first (all-completions pattern members nil)))) 3530 (completion (cl-first (all-completions pattern members))))
3603 (cond ((eq completion t)) 3531 (cond ((eq completion t))
3604 ((null completion) 3532 ((null completion)
3605 (error "Can't find completion for `%s'" pattern)) 3533 (error "Can't find completion for `%s'" pattern))
@@ -3610,7 +3538,7 @@ completion."
3610 (setf ebrowse-last-completion-location (point) 3538 (setf ebrowse-last-completion-location (point)
3611 ebrowse-last-completion-start pattern 3539 ebrowse-last-completion-start pattern
3612 ebrowse-last-completion completion 3540 ebrowse-last-completion completion
3613 ebrowse-last-completion-obarray members)))))))) 3541 ebrowse-last-completion-table members))))))))
3614 3542
3615 3543
3616;;; Tags query replace & search 3544;;; Tags query replace & search
@@ -3746,7 +3674,7 @@ looks like a function call to the member."
3746 3674
3747;;; Structures of this kind are the elements of the position stack. 3675;;; Structures of this kind are the elements of the position stack.
3748 3676
3749(cl-defstruct (ebrowse-position (:type vector) :named) 3677(cl-defstruct (ebrowse-position)
3750 file-name ; in which file 3678 file-name ; in which file
3751 point ; point in file 3679 point ; point in file
3752 target ; t if target of a jump 3680 target ; t if target of a jump
@@ -3888,7 +3816,7 @@ Runs the hook `ebrowse-electric-position-mode-hook'."
3888 (setq mode-line-format (copy-sequence mode-line-format)) 3816 (setq mode-line-format (copy-sequence mode-line-format))
3889 ;; FIXME: Why not set `mode-name' to "Positions"? 3817 ;; FIXME: Why not set `mode-name' to "Positions"?
3890 (setcar (memq 'mode-name mode-line-format) "Positions")) 3818 (setcar (memq 'mode-name mode-line-format) "Positions"))
3891 (set (make-local-variable 'Helper-return-blurb) "return to buffer editing") 3819 (setq-local Helper-return-blurb "return to buffer editing")
3892 (setq truncate-lines t 3820 (setq truncate-lines t
3893 buffer-read-only t)) 3821 buffer-read-only t))
3894 3822
@@ -4101,7 +4029,7 @@ NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS
4101NUMBER-OF-STATIC-VARIABLES:" 4029NUMBER-OF-STATIC-VARIABLES:"
4102 (let ((classes 0) (member-functions 0) (member-variables 0) 4030 (let ((classes 0) (member-functions 0) (member-variables 0)
4103 (static-functions 0) (static-variables 0)) 4031 (static-functions 0) (static-variables 0))
4104 (ebrowse-for-all-trees (tree ebrowse--tree-obarray) 4032 (ebrowse-for-all-trees (tree ebrowse--tree-table)
4105 (cl-incf classes) 4033 (cl-incf classes)
4106 (cl-incf member-functions (length (ebrowse-ts-member-functions tree))) 4034 (cl-incf member-functions (length (ebrowse-ts-member-functions tree)))
4107 (cl-incf member-variables (length (ebrowse-ts-member-variables tree))) 4035 (cl-incf member-variables (length (ebrowse-ts-member-variables tree)))
@@ -4391,10 +4319,4 @@ EVENT is the mouse event."
4391 4319
4392 4320
4393(provide 'ebrowse) 4321(provide 'ebrowse)
4394
4395;; Local variables:
4396;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
4397;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
4398;; End:
4399
4400;;; ebrowse.el ends here 4322;;; ebrowse.el ends here