« back to all changes in this revision
Viewing changes to ecb-method-browser.el
- browse files at revision 3
- compare with another revision
- download diff
- download tarball
- view history from revision 3
- Committer: Bazaar Package Importer
- Author(s): Joerg Jaspert
- Date: 2004-09-01 22:15:18 UTC
- mfrom: (1.1.1 upstream)
- Revision ID: james.westby@ubuntu.com-20040901221518-0jfdt2apb2rj69ey
Tags: 2.27-1
And include latest Upstream too...
- files added:
- ecb-images/default/height-14
- ecb-images/directories/height-14
- ecb-images/methods
- ecb-images/methods/height-14_to_21
- files modified:
- Makefile
added
removed
ecb-method-browser.el
24
24
;; GNU Emacs; see the file COPYING. If not, write to the Free Software
25
25
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26
26
27
;; $Id: ecb-method-browser.el,v 1.15 2004/02/16 08:56:25 berndl Exp $
27
;; $Id: ecb-method-browser.el,v 1.50 2004/08/13 13:56:21 berndl Exp $
28
28
29
29
;;; Commentary:
30
30
31
31
;; This file contains the code for the method-browser of ECB
32
32
33
33
34
(require 'tree-buffer)
34
35
(require 'ecb-util)
35
36
(require 'ecb-layout)
72
73
(defun ecb-method-browser-initialize ()
73
74
(setq ecb-selected-tag nil)
74
75
(setq ecb-methods-root-node nil)
75
(setq ecb-methods-user-filter-alist nil))
76
(setq ecb-methods-user-filter-alist nil)
77
(setq ecb-current-post-processed-tag-table nil))
76
78
77
79
;;====================================================
78
80
;; Customization
124
126
(const :tag "Expand all" :value all)))
125
127
126
128
129
(defcustom ecb-auto-expand-tag-tree-collapse-other nil
130
"*Auto. expanding the tag-tree collapses all not related nodes.
131
There are several choices:
132
- Only if on tag: This means collapsing all nodes which have no relevance for
133
the currently highlighted node will be collapsed, because they are not
134
necessary to make the highlighted node visible. But do this only if point
135
stays onto a tag in the selected edit-window.
136
- Always: Same as before but collapse also when point doesn't stays on a tag
137
\(e.g. between two defuns in elisp) in the selected edit-window. This means
138
in such a situation a full collapsing of the methods-buffer.
139
- Never: Do not automatically collapse the methods-buffer."
140
:group 'ecb-methods
141
:type '(radio (const :tag "Collapse only when point stays on a tag"
142
:value only-if-on-tag)
143
(const :tag "Collapse always" :value always)
144
(const :tag "Never" :value nil)))
145
127
146
(defcustom ecb-expand-methods-switch-off-auto-expand t
128
147
"*Switch off auto expanding in the ECB-method buffer.
129
148
If on then auto expanding is switched off after explicit expanding or
252
271
(list '(function :tag "Function"))))))
253
272
:initialize 'custom-initialize-default)
254
273
274
(defun ecb-get-tag-display-function ()
275
(let ((mode-display-fkt (cdr (assoc major-mode ecb-tag-display-function)))
276
(default-fkt (cdr (assoc 'default ecb-tag-display-function))))
277
(or (and (fboundp mode-display-fkt) mode-display-fkt)
278
(and (fboundp default-fkt) default-fkt)
279
'ecb--semantic-format-tag-prototype)))
280
255
281
256
282
(defcustom ecb-type-tag-display nil
257
283
"*How to display semantic type-tags in the methods buffer.
360
386
(nth 1 (assoc type-specifier default-display))))))
361
387
362
388
(defcustom ecb-type-tag-expansion
363
'((default . ("class" "interface" "group"))
389
'((default . ("class" "interface" "group" "namespace"))
364
390
(c-mode . ("struct")))
365
391
"*Default expansion of semantic type-tags.
366
392
Semantic groups type-tags into different type-specifiers. Current available
508
534
col-type-spec))))
509
535
;; now we add some own colorizing if necessary
510
536
(if face
511
(setq text (ecb-merge-face-into-text text face)))
537
(ecb-merge-face-into-text text face))
512
538
text)
513
539
(funcall (quote ,(cdr elem)) tag parent-tag colorize)))))
514
540
541
(defcustom ecb-display-image-icons-for-semantic-tags ecb-images-can-be-used
542
"*Display nice and pretty icons for semantic-tags in the Methods-buffer.
543
This option takes only effect if Emacs can display images and if
544
`ecb-tree-buffer-style' is set to 'image."
545
:group 'ecb-methods
546
:type 'boolean)
547
548
(defsubst ecb-use-images-for-semantic-tags ()
549
(and ecb-display-image-icons-for-semantic-tags
550
ecb-images-can-be-used
551
(equal ecb-tree-buffer-style 'image)))
552
515
553
(defcustom ecb-post-process-semantic-taglist
516
554
'((c++-mode . (ecb-group-function-tags-with-parents))
517
555
(emacs-lisp-mode . (ecb-group-function-tags-with-parents))
519
557
"*Define mode-dependent post-processing for the semantic-taglist.
520
558
This is an alist where the car is a major-mode symbol and the cdr is a list of
521
559
function-symbols of functions which should be used for post-processing the
522
taglist \(returned by `ecb--semantic-bovinate-toplevel') for a buffer in this
560
taglist \(returned by `ecb--semantic-fetch-tags') for a buffer in this
523
561
major-mode. The first function in the list is called with current semantic
524
562
taglist of current buffer and must return a valid taglist again. All other
525
563
functions are called with the result-taglist of its preceding function and
540
578
:type '(repeat (cons (symbol :tag "Major-mode")
541
579
(repeat (function :tag "Post-process function")))))
542
580
581
(defcustom ecb-default-tag-filter nil
582
"*Default tag-filters for certain files.
583
This option allow to define default tag-filters for certain files which are
584
applied automatically after loading such a file into a buffer. The possible
585
filters are the same as offered by the command `ecb-methods-filter' and they
586
are applied in the same manner - the only difference is they are applied
587
automatically. Please be aware that symbol-filters \(e.g. protection-symbols
588
like public or private) must not be inserted with quotes whereas a
589
filter-regexp has to be inserted with surrounding double-quotes! In addition
590
backslashes in a regexp have to be doubled!
591
592
For each file-spec \(a major-mode plus a file-regexp which both specify a
593
file for which filters should be applied) there can be as much filters as
594
needed - they are layered like with `ecb-methods-filter' too.
595
596
Tag-classes which are completely hidden or excluded by the option
597
`ecb-show-tags' will never being displayed in the Methods-buffer regardless of
598
the filters of this option!"
599
:group 'ecb-methods
600
:type '(repeat (cons :tag "Default tag filter"
601
(cons :tag "Filespec"
602
(symbol :tag "Major-mode")
603
(regexp :tag "Filename-regexp"))
604
(repeat :tag "Default filters"
605
(list :tag "Filterspec"
606
(choice :tag "Filter-type"
607
:menu-tag "Filtertype"
608
(const :tag "Regexp" :value regexp)
609
(const :tag "Protection" :value protection)
610
(const :tag "Tag-class" :value tag-class)
611
(const :tag "Funtion" :value function))
612
(sexp :tag "Filter-value")
613
(boolean :tag "inverse"))))))
614
615
543
616
(defcustom ecb-show-only-positioned-tags t
544
617
"*Show only nodes in the method-buffer which are \"jump-able\".
545
618
If not nil then ECB displays in the method-buffer only nodes which are
556
629
:type 'boolean)
557
630
558
631
559
(defcustom ecb-show-tags '((include collapsed nil)
560
(parent collapsed nil)
561
(type flattened nil)
562
(variable collapsed access)
563
(function flattened access)
564
(rule flattened name)
565
(section flattened nil)
566
(def collapsed name)
567
(t collapsed name))
632
(defcustom ecb-show-tags
633
'((default . ((include collapsed nil)
634
(parent collapsed nil)
635
(type flattened nil)
636
(variable collapsed access)
637
(function flattened access)
638
(label hidden nil)
639
(t collapsed nil)))
640
(c++-mode . ((include collapsed nil)
641
(parent collapsed nil)
642
(type flattened nil)
643
(variable collapsed access)
644
(function flattened access) ;; for Methods
645
(function collapsed access) ;; for Method-prototypes
646
(label hidden nil)
647
(t collapsed nil)))
648
(c-mode . ((include collapsed nil)
649
(parent collapsed nil)
650
(type flattened nil)
651
(variable collapsed access)
652
(function flattened access) ;; for Functions
653
(function collapsed access) ;; for Function-prototypes
654
(label hidden nil)
655
(t collapsed nil)))
656
(bovine-grammar-mode . ((keyword collapsed name)
657
(token collapsed name)
658
(nonterminal flattened name)
659
(rule flattened name)
660
(t collapsed nil)))
661
(wisent-grammar-mode . ((keyword collapsed name)
662
(token collapsed name)
663
(nonterminal flattened name)
664
(rule flattened name)
665
(t collapsed nil)))
666
(texinfo-mode . ((section flattened nil)
667
(def collapsed name)
668
(t collapsed nil))))
568
669
"*How to show tags in the methods buffer first time after find-file.
569
This variable is a list where each element represents a type of tags:
670
This functionality is set on a major-mode base, i.e. for every major-mode a
671
different setting can be used. The value of this option is a list of
672
cons-cells:
673
674
The car is either a major-mode symbol or the special symbol 'default which
675
means if no setting for a certain major-mode is defined then the cdr of
676
the 'default cons-cell is used. This option should always contain a
677
default-setting!
678
679
The cdr is a list where each element represents a type of tags:
570
680
571
681
\(<tag type> <display type> <sort method>)
572
682
683
There can be more than 1 element for a certain <tag type>. This is for example
684
useful for C++ and C because these languages distinct between a
685
method-prototype \(rsp. function-prototype for C) and the method \(rsp.
686
function for C) itself. The default value of these option contains two entries
687
for <tag type> is 'function whereas the first one is responsible for the
688
\"real\" methods \(rsp. functions) and the second one for the prototypes. So
689
if the methods should be flattened and the prototypes collapsed the
690
show-tags-list for C++ and C must contain two entries for <tag type>
691
'function, the first one defined as 'flattened and the second one defined as
692
'collapsed. See also `ecb-methods-separate-prototypes'.
693
573
694
The tags in the methods buffer are displayed in the order as they appear in
574
695
this list.
575
696
618
739
:set (function (lambda (symbol value)
619
740
(set symbol value)
620
741
(ecb-clear-tag-tree-cache)))
621
:type '(repeat (list (symbol :tag "Tag symbol")
622
(choice :tag "Display type" :value collapsed
623
(const :tag "Expanded" expanded)
624
(const :tag "Collapsed" collapsed)
625
(const :tag "Flattened" flattened)
626
(const :tag "Hidden" hidden))
627
(choice :tag "Sort by" :value nil
628
(const :tag "Name" name)
629
(const :tag "Access then name" access)
630
(const :tag "No sort" nil))))
742
:type '(repeat (cons (symbol :tag "Major-mode")
743
(repeat (list (symbol :tag "Tag symbol")
744
(choice :tag "Display type" :value collapsed
745
(const :tag "Expanded" expanded)
746
(const :tag "Collapsed" collapsed)
747
(const :tag "Flattened" flattened)
748
(const :tag "Hidden" hidden))
749
(choice :tag "Sort by" :value nil
750
(const :tag "Name" name)
751
(const :tag "Access then name" access)
752
(const :tag "No sort" nil))))))
631
753
:initialize 'custom-initialize-default)
632
754
633
634
(defcustom ecb-methods-nodes-expand-spec '(type variable function section)
755
(defun ecb-get-show-tags-list ()
756
"Return the show-tags-list of `ecb-show-tags' for current major-mode."
757
(let ((mode-show-tag-list (cdr (assoc major-mode ecb-show-tags)))
758
(default-show-tag-list (cdr (assoc 'default ecb-show-tags))))
759
(or mode-show-tag-list
760
(and (null mode-show-tag-list)
761
default-show-tag-list))))
762
763
(defcustom ecb-methods-separate-prototypes t
764
"*Separate function-prototypes from the real functions.
765
This is for example useful for C++ and C because these languages distinct
766
between a method-prototype \(rsp. function-prototype for C) and the method
767
\(rsp. function for C) itself. If this option is not nil then ECB separates
768
the prototypes from the real function/methods. Then with `ecb-show-tags' the
769
user can define different display-settings for each of them. If this option is
770
nil then the prototypes and the real functions are filled in the same bucket
771
and displayed plain and there is no sorting between prototypes and functions
772
possible. If this option is switched on then it is senseful that
773
`ecb-show-tags' contains for all modes which distinct between prototypes and
774
real functions/methods two entries for the tag-type 'function - see the
775
documentation of this option."
776
:group 'ecb-methods
777
:type 'boolean)
778
779
(defcustom ecb-methods-filter-replace-existing 'never
780
"*How the methods-filter should be applied to existing filters.
781
There are three different choices:
782
- 'never: This is the default and means that calling `ecb-methods-filter'
783
always adds the new filter on top of already existing filters. So you can
784
combine several filter to one combined like this example: 'Display only all
785
public methods having the string \"test\" in its name.' With this setting
786
the filters can only be cleared by calling `ecb-methods-filter' and then
787
choosing \"nothing\".
788
- 'always: This means that `ecb-methods-filter' always clears a previous
789
filter before applying the new one.
790
- 'ask: ECB asks if the new filter should replace the existing ones."
791
:group 'ecb-methods
792
:type '(radio (const :tag "Do not replace" :value never)
793
(const :tag "Always replace" :value always)
794
(const :tag "Ask if to replace" :value ask)))
795
796
(defcustom ecb-methods-nodes-expand-spec '(type variable function section
797
nonterminal keyword token)
635
798
"*Semantic tag-types expanded by `ecb-expand-methods-nodes'.
636
799
The value of this option is either the symbol 'all \(all tags are expanded
637
800
regardless of their type) or a list of symbols where each symbol is a valid
669
832
(symbol :tag "Node-type"))))
670
833
671
834
672
(defcustom ecb-exclude-parents-regexp nil
673
"*Regexp which parent classes should not be shown in the methods buffer.
835
(defcustom ecb-exclude-parents-regexps nil
836
"*Regexps which parent classes should not be shown in the methods buffer.
674
837
If nil then all parents will be shown if `ecb-show-parents' is not nil.
675
838
676
839
This options takes only effect for semantic-sources - means sources supported
679
842
:set (function (lambda (symbol value)
680
843
(set symbol value)
681
844
(ecb-clear-tag-tree-cache)))
682
:type '(radio (const :tag "Do not exclude any parents"
683
:value nil)
684
(regexp :tag "Parents-regexp to exclude"))
845
:type '(repeat (regexp :tag "Parents-regexp to exclude"))
685
846
:initialize 'custom-initialize-default)
686
847
848
(defsubst ecb-check-parent-for-exclude (parent-name)
849
(ecb-match-regexp-list parent-name ecb-exclude-parents-regexps))
687
850
688
851
(defcustom ecb-highlight-tag-with-point 'highlight-scroll
689
852
"*How to highlight the method or variable under the cursor.
724
887
:set (function (lambda (symbol value)
725
888
(set symbol value)
726
889
(if ecb-minor-mode
727
(ecb-activate-ecb-sync-functions value 'ecb-tag-sync))))
890
(ecb-activate-ecb-autocontrol-functions value
891
'ecb-tag-sync))))
728
892
:initialize 'custom-initialize-default)
729
893
730
894
762
926
But you can add any arbitrary function if the following conditions are
763
927
fulfilled:
764
928
- The function gets the semantic tag as argument and
765
- the function returns the \(new) point after finishing its job."
929
- the function returns the \(new) point after finishing its job.
930
- The function must not put the point outside the tag-boundaries of the
931
tag-argument."
766
932
:group 'ecb-methods
767
933
:type '(repeat (cons :value (nil . (ecb-tag-visit-recenter))
768
934
(symbol :tag "Major-mode or default")
797
963
built-in menu-entries of `ecb-methods-menu' but the whole menu can be
798
964
re-arranged with `ecb-methods-menu-sorter'."
799
965
:group 'ecb-methods
800
:type '(repeat (choice :tag "Menu-entry" :menu-tag "Menu-entry"
801
:value (ignore "")
802
(const :tag "Separator" :value ("---"))
803
(list :tag "Menu-command"
804
(function :tag "Function" :value ignore)
805
(string :tag "Entry-name"))
806
(cons :tag "Submenu"
807
(string :tag "Submenu-title")
808
(repeat (choice :tag "Submenu-entry" :menu-tag "Submenu-entry"
809
:value (ignore "")
810
(const :tag "Separator" :value ("---"))
811
(list :tag "Submenu-command"
812
(function :tag "Function"
813
:value ignore)
814
(string :tag "Entry-name"))))))))
966
:type (ecb-create-menu-user-ext-type 1 ecb-max-submenu-depth))
815
967
816
968
817
969
(defcustom ecb-methods-menu-user-extension-function nil
1083
1235
1084
1236
1085
1237
(defun ecb-get-tag-type-display (tag-type)
1086
(let ((display (ecb-find-assoc tag-type ecb-show-tags)))
1238
(let* ((show-tags-list (ecb-get-show-tags-list))
1239
(display (ecb-find-assoc tag-type show-tags-list)))
1087
1240
(if display
1088
1241
display
1089
(setq display (ecb-find-assoc t ecb-show-tags))
1242
(setq display (ecb-find-assoc t show-tags-list))
1090
1243
(if display
1091
1244
display
1092
1245
'(t hidden nil)))))
1101
1254
((stringp parent)
1102
1255
(ecb--semantic--format-colorize-text parent 'type)))))
1103
1256
(if name
1104
(if (and ecb-exclude-parents-regexp
1105
(string-match ecb-exclude-parents-regexp name))
1257
(if (ecb-check-parent-for-exclude name)
1106
1258
(ecb-get-tag-parent-names (cdr parents))
1107
1259
(cons name (ecb-get-tag-parent-names (cdr parents))))
1108
1260
(if (listp parent)
1118
1270
;; (ecb--semantic-tag-type-parent tag)))
1119
1271
1120
1272
1121
1122
1273
(defun ecb-get-tag-name (tag &optional parent-tag)
1123
1274
"Get the name of TAG with the appropriate fcn from
1124
1275
`ecb-tag-display-function'."
1125
1276
(condition-case nil
1126
(let* ((mode-display-fkt (cdr (assoc major-mode ecb-tag-display-function)))
1127
(default-fkt (cdr (assoc 'default ecb-tag-display-function)))
1128
(display-fkt (or (and (fboundp mode-display-fkt) mode-display-fkt)
1129
(and (fboundp default-fkt) default-fkt)
1130
'ecb--semantic-format-tag-prototype)))
1131
(funcall display-fkt tag parent-tag ecb-font-lock-tags))
1277
(funcall (ecb-get-tag-display-function)
1278
tag parent-tag ecb-font-lock-tags)
1132
1279
(error (ecb--semantic-format-tag-prototype tag parent-tag
1133
1280
ecb-font-lock-tags))))
1134
1281
1153
1300
(let ((formatted-name (concat (nth 0 ecb-bucket-node-display)
1154
1301
name
1155
1302
(nth 1 ecb-bucket-node-display))))
1156
(setq formatted-name (ecb-merge-face-into-text formatted-name (nth 2 ecb-bucket-node-display)))
1303
(ecb-merge-face-into-text formatted-name (nth 2 ecb-bucket-node-display))
1157
1304
formatted-name))
1158
1305
1159
1306
(defsubst ecb-forbid-tag-display (tag)
1307
(ecb--semantic--tag-put-property tag 'hide-tag t))
1308
1309
(defsubst ecb-allow-tag-display (tag)
1310
(ecb--semantic--tag-put-property tag 'hide-tag nil))
1311
1312
(defsubst ecb-tag-forbidden-display-p (tag)
1313
(ecb--semantic--tag-get-property tag 'hide-tag))
1314
1315
(defsubst ecb-show-at-least-one-tag-p (taglist)
1316
"Not nil if at least one of the tags in TAGLIST should be displayed in the
1317
Methods-buffer."
1318
(catch 'found
1319
(dolist (tag taglist)
1320
(if (not (ecb-tag-forbidden-display-p tag))
1321
(throw 'found t)))
1322
nil))
1323
1324
1325
;; The function requires that TAGLIST is a subset of the tag-table returned by
1326
;; semantic for the current-buffer.
1327
(defun ecb-apply-user-filter-to-tags (taglist)
1328
"Applies to the tags of TAGLIST the related filter of
1329
`ecb-methods-user-filter-alist' - if there is any."
1330
(save-match-data
1331
(let ((filters (cdr (assoc (current-buffer) ecb-methods-user-filter-alist)))
1332
(filter-type nil)
1333
(filter nil)
1334
(inverse nil))
1335
(when filters
1336
(dolist (tag taglist)
1337
(dolist (filter-spec filters)
1338
(setq filter-type (nth 0 filter-spec))
1339
(setq filter (car (nth 1 filter-spec))) ;; ignore the attached fcn
1340
(setq inverse (nth 2 filter-spec))
1341
;; we forbid some tags to be displayed when they do not match the
1342
;; filter. Currently we do not apply a filter to tags of class 'type
1343
(unless (equal (ecb--semantic-tag-class tag) 'type)
1344
(cond ((equal filter-type 'regexp)
1345
(if (funcall inverse
1346
(not (string-match filter
1347
(ecb--semantic-tag-name tag))))
1348
(ecb-forbid-tag-display tag)))
1349
((and (member filter '(private protected public))
1350
(equal filter-type 'protection))
1351
(if (funcall inverse
1352
(not (or (null (ecb--semantic-tag-protection tag))
1353
(equal (ecb--semantic-tag-protection tag)
1354
filter))))
1355
(ecb-forbid-tag-display tag)))
1356
((and (symbolp filter)
1357
(equal filter-type 'tag-class))
1358
(if (funcall inverse
1359
(not (equal (ecb--semantic-tag-class tag) filter)))
1360
(ecb-forbid-tag-display tag)))
1361
((and (functionp filter)
1362
(equal filter-type 'function))
1363
(if (funcall inverse
1364
(not (funcall filter tag (current-buffer))))
1365
(ecb-forbid-tag-display tag)))
1366
(t nil)))))))))
1367
1368
1369
(defun ecb-generate-node-name (text-name first-chars icon-name)
1370
"Generate a new name from TEXT-NAME by adding an appropriate image according
1371
to ICON-NAME to the first FIRST-CHARS of TEXT-NAME. If FIRST-CHARS is < 0 then
1372
a string with length abs\(FIRST-CHARS) is created, the image is applied to
1373
this new string and this \"image\"-string is added to the front of TEXT-NAME.
1374
If no image can be found for ICON-NAME then the original TEXT-NAME is
1375
returned."
1376
(let ((image nil))
1377
(save-excursion
1378
(set-buffer ecb-methods-buffer-name)
1379
(setq image (and icon-name
1380
(ecb-use-images-for-semantic-tags)
1381
(tree-buffer-find-image icon-name)))
1382
(if image
1383
(if (> first-chars 0)
1384
(tree-buffer-add-image-icon-maybe
1385
0 first-chars text-name image)
1386
(concat (tree-buffer-add-image-icon-maybe
1387
0 1 (make-string (- first-chars) ? ) image)
1388
text-name))
1389
text-name))))
1390
1391
1160
1392
(defun ecb-add-tag-bucket (node bucket display sort-method
1161
&optional parent-tag no-bucketize)
1393
&optional parent-tag no-bucketize)
1162
1394
"Adds a tag bucket to a node unless DISPLAY equals 'hidden."
1163
1395
(when bucket
1164
(let ((name (ecb-format-bucket-name (car bucket)))
1165
;;(type (ecb--semantic-tag-class (cadr bucket)))
1166
(bucket-node node))
1396
(let* ((name-bucket (ecb-format-bucket-name (car bucket)))
1397
(image-name (format "%s-bucket" (ecb--semantic-tag-class (cadr bucket))))
1398
(name (ecb-generate-node-name name-bucket -1 image-name))
1399
;;(type (ecb--semantic-tag-class (cadr bucket)))
1400
(bucket-node node))
1167
1401
(unless (eq 'hidden display)
1168
(unless (eq 'flattened display)
1169
(setq bucket-node (tree-node-new name 1 nil nil node
1170
(if ecb-truncate-long-names 'end)))
1402
(ecb-apply-user-filter-to-tags (cdr bucket))
1403
(unless (or (eq 'flattened display)
1404
;; we must not create a bucket-node when each tag in the
1405
;; bucket is forbidden to be displayed
1406
(not (ecb-show-at-least-one-tag-p (cdr bucket))))
1407
(setq bucket-node
1408
(tree-node-new name 1
1409
(list 'ecb-bucket-node
1410
(car bucket)
1411
(ecb--semantic-tag-class (car (cdr bucket))))
1412
nil node
1413
(if ecb-truncate-long-names 'end)))
1171
1414
(tree-node-set-expanded bucket-node (eq 'expanded display)))
1172
1415
(dolist (tag (ecb-sort-tags sort-method (cdr bucket)))
1173
;; (ecb--semantic--tag-put-property tag 'parent-tag parent-tag)
1174
(ecb-update-tag-node tag
1175
(tree-node-new "" 0 tag t bucket-node
1176
(if ecb-truncate-long-names 'end))
1177
parent-tag no-bucketize))))))
1178
1179
1416
;; we create only a new node for a tag of the bucket when the tag is
1417
;; not forbidden to be displayed.
1418
(if (not (ecb-tag-forbidden-display-p tag))
1419
(ecb-update-tag-node tag
1420
(tree-node-new "" 0 tag t bucket-node
1421
(if ecb-truncate-long-names 'end))
1422
parent-tag no-bucketize))
1423
;; now we allow each tag to be displayed. This can be done because
1424
;; here we already excluded the tag from being added as a node to
1425
;; the tree-buffer and therefore from being displayed. So we can
1426
;; reset all tags to be shown by default. So we can apply a complete
1427
;; new filter (or no filter) without resetting the old filter before.
1428
(ecb-allow-tag-display tag))))))
1429
1430
1431
1432
(defconst ecb-tag-image-name-alias-alist
1433
'((abstract . ((static . ((struct . ((nil . "abstract-class-unknown")
1434
(unknown . "abstract-class-unknown")
1435
(private . "abstract-class-private")
1436
(protected . "abstract-class-protected")
1437
(public . "abstract-class-public")))
1438
(class . ((nil . "abstract-class-unknown")
1439
(unknown . "abstract-class-unknown")
1440
(private . "abstract-class-private")
1441
(protected . "abstract-class-protected")
1442
(public . "abstract-class-public")))
1443
;; currently we have no special icon for
1444
;; interfaces - we use the icon for abstract classes
1445
(interface . ((nil . "abstract-class-unknown")
1446
(unknown . "abstract-class-unknown")
1447
(private . "abstract-class-private")
1448
(protected . "abstract-class-protected")
1449
(public . "abstract-class-public")))
1450
;; we have no static and no abstract enum-icon
1451
(enum . ((nil . "enum-unknown")
1452
(unknown . "enum-unknown")
1453
(private . "enum-private")
1454
(protected . "enum-protected")
1455
(public . "enum-public")))
1456
;; we have no icon for static constructors
1457
(constructor . ((nil . "abstract-constructor-unknown")
1458
(unknown . "abstract-constructor-unknown")
1459
(private . "abstract-constructor-private")
1460
(protected . "abstract-constructor-protected")
1461
(public . "abstract-constructor-public")))
1462
(function . ((nil . "abstract-function-unknown-static")
1463
(unknown . "abstract-function-unknown-static")
1464
(private . "abstract-function-private-static")
1465
(protected . "abstract-function-protected-static")
1466
(public . "abstract-function-public-static")))
1467
(variable . ((nil . "abstract-variable-unknown-static")
1468
(unknown . "abstract-variable-unknown-static")
1469
(private . "abstract-variable-private-static")
1470
(protected . "abstract-variable-protected-static")
1471
(public . "abstract-variable-public-static")))))
1472
(not-static . ((struct . ((nil . "abstract-class-unknown")
1473
(unknown . "abstract-class-unknown")
1474
(private . "abstract-class-private")
1475
(protected . "abstract-class-protected")
1476
(public . "abstract-class-public")))
1477
(class . ((nil . "abstract-class-unknown")
1478
(unknown . "abstract-class-unknown")
1479
(private . "abstract-class-private")
1480
(protected . "abstract-class-protected")
1481
(public . "abstract-class-public")))
1482
;; we have currently no special icon for interfaces
1483
(interface . ((nil . "abstract-class-unknown")
1484
(unknown . "abstract-class-unknown")
1485
(private . "abstract-class-private")
1486
(protected . "abstract-class-protected")
1487
(public . "abstract-class-public")))
1488
;; we have no abstract enum-icon
1489
(enum . ((nil . "enum-unknown")
1490
(unknown . "enum-unknown")
1491
(private . "enum-private")
1492
(protected . "enum-protected")
1493
(public . "enum-public")))
1494
(constructor . ((nil . "abstract-constructor-unknown")
1495
(unknown . "abstract-constructor-unknown")
1496
(private . "abstract-constructor-private")
1497
(protected . "abstract-constructor-protected")
1498
(public . "abstract-constructor-public")))
1499
(function . ((nil . "abstract-function-unknown")
1500
(unknown . "abstract-function-unknown")
1501
(private . "abstract-function-private")
1502
(protected . "abstract-function-protected")
1503
(public . "abstract-function-public")))
1504
(variable . ((nil . "abstract-variable-unknown")
1505
(unknown . "abstract-variable-unknown")
1506
(private . "abstract-variable-private")
1507
(protected . "abstract-variable-protected")
1508
(public . "abstract-variable-public")))))))
1509
(not-abstract . ((static . ((struct . ((nil . "class-unknown")
1510
(unknown . "class-unknown")
1511
(private . "class-private")
1512
(protected . "class-protected")
1513
(public . "class-public")))
1514
(class . ((nil . "class-unknown")
1515
(unknown . "class-unknown")
1516
(private . "class-private")
1517
(protected . "class-protected")
1518
(public . "class-public")))
1519
;; we use the icon for abstract classes for interfaces
1520
(interface . ((nil . "abstract-class-unknown")
1521
(unknown . "abstract-class-unknown")
1522
(private . "abstract-class-private")
1523
(protected . "abstract-class-protected")
1524
(public . "abstract-class-public")))
1525
;; we have no static enum-icon
1526
(enum . ((nil . "enum-unknown")
1527
(unknown . "enum-unknown")
1528
(private . "enum-private")
1529
(protected . "enum-protected")
1530
(public . "enum-public")))
1531
(constructor . ((nil . "constructor-unknown")
1532
(unknown . "constructor-unknown")
1533
(private . "constructor-private")
1534
(protected . "constructor-protected")
1535
(public . "constructor-public")))
1536
(function . ((nil . "function-unknown-static")
1537
(unknown . "function-unknown-static")
1538
(private . "function-private-static")
1539
(protected . "function-protected-static")
1540
(public . "function-public-static")))
1541
(variable . ((nil . "variable-unknown-static")
1542
(unknown . "variable-unknown-static")
1543
(private . "variable-private-static")
1544
(protected . "variable-protected-static")
1545
(public . "variable-public-static")))))
1546
(not-static . ((struct . ((nil . "class-unknown")
1547
(unknown . "class-unknown")
1548
(private . "class-private")
1549
(protected . "class-protected")
1550
(public . "class-public")))
1551
(class . ((nil . "class-unknown")
1552
(unknown . "class-unknown")
1553
(private . "class-private")
1554
(protected . "class-protected")
1555
(public . "class-public")))
1556
(interface . ((nil . "abstract-class-unknown")
1557
(unknown . "abstract-class-unknown")
1558
(private . "abstract-class-private")
1559
(protected . "abstract-class-protected")
1560
(public . "abstract-class-public")))
1561
(enum . ((nil . "enum-unknown")
1562
(unknown . "enum-unknown")
1563
(private . "enum-private")
1564
(protected . "enum-protected")
1565
(public . "enum-public")))
1566
(constructor . ((nil . "constructor-unknown")
1567
(unknown . "constructor-unknown")
1568
(private . "constructor-private")
1569
(protected . "constructor-protected")
1570
(public . "constructor-public")))
1571
(function . ((nil . "function-unknown")
1572
(unknown . "function-unknown")
1573
(private . "function-private")
1574
(protected . "function-protected")
1575
(public . "function-public")))
1576
(variable . ((nil . "variable-unknown")
1577
(unknown . "variable-unknown")
1578
(private . "variable-private")
1579
(protected . "variable-protected")
1580
(public . "variable-public"))))))))
1581
"This alist defines the mapping from the combination
1582
abstract-static-tag-protection to an existing icon-file-name.")
1583
1584
1585
(defsubst ecb-get-icon-for-tag (abstract-p static-p type protection)
1586
(cdr (assq protection
1587
(cdr (assq type
1588
(cdr (assq static-p
1589
(cdr (assq abstract-p
1590
ecb-tag-image-name-alias-alist)))))))))
1591
1592
1593
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: All this tag-icon-display-stuff
1594
;; should be done by semantic - but for now we let do it by ECB because so we
1595
;; can test the whole stuff. If Eric has added such icon-display to semantic
1596
;; then we can throw away all this stuff and just using plain-tag-name as
1597
;; node-name without any modification.
1180
1598
(defun ecb-update-tag-node (tag node &optional parent-tag no-bucketize)
1181
1599
"Updates a node containing a tag."
1182
1600
(let* ((children (ecb--semantic-tag-children-compatibility
1183
tag ecb-show-only-positioned-tags)))
1184
(tree-node-set-name node (ecb-get-tag-name tag parent-tag))
1601
tag ecb-show-only-positioned-tags))
1602
(plain-tag-name (ecb-get-tag-name tag parent-tag))
1603
(has-protection (member (ecb-first plain-tag-name)
1604
'(?- ?# ?+)))
1605
(icon-name (ecb-get-icon-for-tag
1606
(if (ecb--semantic-tag-abstract-p tag parent-tag)
1607
'abstract
1608
'not-abstract)
1609
(if (ecb--semantic-tag-static-p tag parent-tag)
1610
'static
1611
'not-static)
1612
(or (and (equal (ecb--semantic-tag-class tag)
1613
'type)
1614
(intern (ecb--semantic-tag-type tag)))
1615
(and (ecb--semantic-tag-function-constructor-p tag)
1616
'constructor)
1617
(ecb--semantic-tag-class tag))
1618
(or (and (ecb--semantic--tag-get-property tag 'adopted)
1619
'unknown)
1620
(and (not (member (ecb--semantic-tag-class tag)
1621
'(type function variable)))
1622
'unknown)
1623
(ecb--semantic-tag-protection tag parent-tag))))
1624
(tag-name (ecb-generate-node-name plain-tag-name
1625
(if has-protection 1 -1)
1626
icon-name)))
1627
(tree-node-set-name node tag-name)
1185
1628
(unless (eq 'function (ecb--semantic-tag-class tag))
1186
1629
(ecb-add-tags node children tag no-bucketize)
1187
1630
(tree-node-set-expandable
1195
1638
node
1196
1639
(and (tree-node-is-expandable node)
1197
1640
(ecb-type-tag-expansion type-specifier))))))))
1198
1199
1641
1200
1642
(defun ecb-post-process-taglist (taglist)
1201
"If for current major-mode a post-process function is found in
1202
`ecb-post-process-semantic-taglist' then this function is called with
1643
"If for current major-mode post-process functions are found in
1644
`ecb-post-process-semantic-taglist' then these functions are called with
1203
1645
TAGLIST otherwise TAGLIST is returned."
1204
1646
(let ((fcn-list (cdr (assoc major-mode ecb-post-process-semantic-taglist))))
1205
1647
(dolist (fcn fcn-list)
1206
1648
(if (fboundp fcn)
1207
(setq taglist (funcall fcn taglist))))
1208
;; at the end we apply the user-filter if there is any.
1209
(ecb-apply-user-filter-to-tags taglist)))
1649
(setq taglist (funcall fcn taglist)))))
1650
(ecb-set-current-tag-table taglist)
1651
;; now we apply that tag-filters which must operate onto the whole
1652
;; tag-table of
1653
(ecb-apply-tag-table-filters taglist))
1654
1655
(defun ecb-apply-tag-table-filters (taglist)
1656
"Perform all tag-filters which must be applied to the whole tag-table."
1657
(let ((filters (cdr (assoc (current-buffer) ecb-methods-user-filter-alist)))
1658
(filter nil))
1659
(dolist (filter-type '(current-type))
1660
(setq filter (car (cdr (assoc filter-type filters))))
1661
(if filter
1662
(setq taglist (funcall (cdr filter) (car filter) taglist)))))
1663
taglist)
1664
1665
1666
(defun ecb-methods-filter-perform-current-type (filter taglist)
1667
"Perform a current-type filter on TAGLIST. FILTER is a type-name-hierarchy
1668
for a certain type. If this hierarchy can be found in TAGLIST a new tag-list
1669
is returned which contains only the leaf-type in the hierarchy."
1670
(let ((curr-type-filter (reverse filter))
1671
(new-tag-list taglist)
1672
(found-type-tag nil))
1673
(if (null curr-type-filter)
1674
taglist
1675
(catch 'not-found
1676
(dolist (type-name curr-type-filter)
1677
(setq found-type-tag
1678
(car (ecb--semantic-find-tags-by-name
1679
type-name
1680
(ecb--semantic-find-tags-by-class 'type new-tag-list))))
1681
(if (null found-type-tag)
1682
(progn
1683
;; remove here the filters for current source because the
1684
;; current-type filter is no longer useable! TODO: Klaus
1685
;; Berndl <klaus.berndl@sdm.de>: Maybe we should be smarter
1686
;; and only remove the current-type-filter instead of all
1687
;; filters. This could be done with
1688
;; `ecb-replace-first-occurence' (replace the curr filter with
1689
;; nil and then do (delq nil filters)
1690
(ecb-methods-filter-apply nil nil nil "" "" (current-buffer))
1691
(message "ECB has removed all filters cause of changes in the type-hierarchy for the current-type!")
1692
;; whenever we can not found any type in our filter type-hierarchy
1693
;; then we can not apply this current-type filter so we have to
1694
;; return the original tag-list
1695
(throw 'not-found taglist))
1696
(setq new-tag-list
1697
(ecb--semantic-tag-children-compatibility found-type-tag))))
1698
;; when we reach this point we can be sure that the whole type-hierarchy
1699
;; has been found and so we return just our current-type as new taglist.
1700
(list found-type-tag)))))
1210
1701
1211
1702
(defun ecb-group-function-tags-with-parents (taglist)
1212
1703
"Return a new taglist based on TAGLIST where all function-tags in
1220
1711
1221
1712
(defun ecb-filter-c-prototype-tags (taglist)
1222
1713
"Filter out all prototypes.
1714
Beginning with version 2.24 of ECB this function does nothing when
1715
`ecb-methods-separate-prototypes' is set to not nil \(default).
1716
1223
1717
For example this is useful for editing C files which have the function
1224
1718
prototypes defined at the top of the file and the implementations at the
1225
1719
bottom. This means that everything appears twice in the methods buffer, but
1226
1720
probably nobody wants to jump to the prototypes, they are only wasting space
1227
1721
in the methods buffer.
1228
1722
For C-header-files prototypes are never filtered out!"
1229
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Is there a better way to
1230
;; recognize a C-Header-file?
1231
(let ((header-extensions '("\\.h\\'" "\\.H\\'" "\\.HH\\'" "\\.hxx\\'" "\\.hh\\'")))
1232
(or (and (catch 'found
1233
(dolist (ext header-extensions)
1234
(if (save-match-data
1235
(string-match ext (buffer-file-name (current-buffer))))
1236
(throw 'found t)))
1237
nil)
1238
taglist)
1239
(ecb-filter taglist
1240
(function (lambda (x)
1241
(not (ecb--semantic-tag-get-attribute x 'prototype))))))))
1723
;; ;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Is there a better way to
1724
;; ;; recognize a C-Header-file?
1725
(if ecb-methods-separate-prototypes
1726
taglist
1727
(let ((header-extensions '("\\.h\\'" "\\.H\\'" "\\.HH\\'" "\\.hxx\\'" "\\.hh\\'")))
1728
(or (and (catch 'found
1729
(dolist (ext header-extensions)
1730
(if (save-match-data
1731
(string-match ext (buffer-file-name (current-buffer))))
1732
(throw 'found t)))
1733
nil)
1734
taglist)
1735
(ecb-filter taglist
1736
(function (lambda (x)
1737
(not (ecb--semantic-tag-prototype-p x)))))))))
1738
1739
;; Filtering the Methods-buffer by the user ----------------
1242
1740
1243
1741
(defvar ecb-methods-user-filter-alist nil
1244
"The filter currently applied to the methods-buffer by the user. It can be a
1245
regexp-string, or one of the symbols 'private, 'protected or 'public or one of
1246
the tag-type-symbols mentioned in the the option `ecb-tag-display-function'.
1247
This cache is an alist where the key is the buffer-object of that buffer the
1248
filter belongs and the value is the applied filter to that buffer.")
1249
1250
1251
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>:
1252
;; - Fuer jede der 4 Funktionen unten ein tree-buffer-defpopup-command
1253
;; schreiben (diese m�ssen tree-buffer-get-data-store verwenden!). Dabei
1254
;; auch `ecb-sources-filter und ecb-history-filter fixen!
1255
;; - Filteranzeige in der Modeline des methods-buffers
1256
;; - Smartere und besser customizable Filterung:
1257
;; + Ev. recursive absteigen - children von tags auch filtern
1258
;; + Start-level bestimmbar (z.B. erst ab dem ersten children-level beginnen
1259
;; + Oder Exclude-tag-classes customizable, z.B. Filterung bezieht sich nie
1260
;; auf types: damit w�rden in Sprachen wie C++ oder Java die Klassen immer
1261
;; angezeigt, nur ihre children w�rden gefiltert.
1262
;; Ohne solche Mechanismen ist die Filterung bei OO-Sprachen fast nutzlos!
1263
1264
(defun ecb-methods-filter-by-prot (source-buffer)
1742
"The filter currently applied to the methods-buffer by the user. This cache
1743
is an alist where the key is the buffer-object of that buffer the filter
1744
belongs and the value is the applied filter to that buffer.
1745
1746
Filters which can work onto single tags are applied by
1747
`ecb-apply-user-filter-to-tags' whereas tag-filters which have to be applied
1748
onto the whole tag-table are performed by `ecb-apply-tag-table-filters'.")
1749
1750
1751
(defun ecb-methods-filter-by-prot (inverse source-buffer &optional prot)
1265
1752
"Filter the Methods-buffer by protection."
1266
(let ((choice (ecb-query-string "Protection filter: "
1267
'("private" "protected" "public"))))
1268
(ecb-methods-filter-apply (intern choice) source-buffer)))
1753
(let ((choice (or prot
1754
(ecb-query-string "Protection filter:"
1755
'("private" "protected" "public")))))
1756
(ecb-methods-filter-apply 'protection
1757
(cons (intern choice) nil)
1758
inverse
1759
(concat (and inverse "^") "Prot")
1760
choice
1761
source-buffer)))
1269
1762
1270
(defun ecb-methods-filter-by-tag-class (source-buffer)
1763
(defun ecb-methods-filter-by-tag-class (inverse source-buffer
1764
&optional tag-class)
1271
1765
"Filter the Methods-buffer by a tag-class."
1272
(let ((choice (ecb-query-string "Tag-class filter: "
1273
'("function" "variable" "type"
1274
"include" "rule" "section" "def"))))
1275
(ecb-methods-filter-apply (intern choice) source-buffer)))
1276
1277
(defun ecb-methods-filter-by-regexp (source-buffer)
1766
(let* ((curr-semantic-symbol->name-assoc-list
1767
(save-excursion
1768
(set-buffer source-buffer)
1769
(ecb--semantic-symbol->name-assoc-list)))
1770
(choice (or tag-class
1771
(ecb-query-string "Tag-class filter:"
1772
(mapcar 'cdr
1773
curr-semantic-symbol->name-assoc-list))))
1774
(class (or tag-class
1775
(symbol-name
1776
(car (delq nil (mapcar (function (lambda (e)
1777
(if (ecb-string= (cdr e) choice)
1778
(car e))))
1779
curr-semantic-symbol->name-assoc-list)))))))
1780
(ecb-methods-filter-apply 'tag-class
1781
(cons (intern class) nil)
1782
inverse
1783
(concat (and inverse "^") "Tagclass")
1784
(cdr (assoc (intern class)
1785
curr-semantic-symbol->name-assoc-list))
1786
source-buffer)))
1787
1788
1789
;; The popup-menu commands for protection- and tag-class-filters are generated
1790
;; dynamically - see `ecb-methods-menu-tagfilter-entries'.
1791
1792
(defun ecb-methods-filter-by-regexp (inverse source-buffer &optional regexp)
1278
1793
"Filter the Methods-buffer by a regular expression."
1279
(let ((regexp-str (read-string "Insert the filter-regexp: ")))
1280
(if (> (length regexp-str) 0)
1281
(ecb-methods-filter-apply regexp-str source-buffer)
1282
(ecb-methods-filter-apply nil source-buffer))))
1283
1284
(defun ecb-methods-filter-none (source-buffer)
1285
"Remove any filter from the Methods-buffer."
1286
(ecb-methods-filter-apply nil source-buffer))
1287
1288
(defun ecb-apply-user-filter-to-tags (taglist)
1289
(save-match-data
1290
(let ((filter (cdr (assoc (current-buffer) ecb-methods-user-filter-alist))))
1291
(if (null filter)
1292
taglist
1293
(ecb-filter taglist
1294
(function
1295
(lambda (tag)
1296
(cond ((stringp filter)
1297
(if (string-match filter
1298
(ecb--semantic-tag-name tag))
1299
tag))
1300
((member filter '(private protected public))
1301
(if (or (null (ecb--semantic-tag-protection tag))
1302
(equal (ecb--semantic-tag-protection tag) filter))
1303
tag))
1304
((symbolp filter)
1305
(if (equal (ecb--semantic-tag-class tag) filter)
1306
tag))
1307
(t tag)))))))))
1308
1309
(defun ecb-methods-filter ()
1794
(let ((regexp-str (or regexp (read-string "Filter-regexp: "))))
1795
(ecb-methods-filter-apply 'regexp
1796
(if (> (length regexp-str) 0)
1797
(cons regexp-str nil)
1798
nil)
1799
inverse
1800
(concat (and inverse "^") "Regexp")
1801
(if (> (length regexp-str) 0) regexp-str nil)
1802
source-buffer)))
1803
1804
(tree-buffer-defpopup-command ecb-methods-filter-by-regexp-popup
1805
"Filter the Methods-buffer by regexp from popup."
1806
(ecb-methods-filter-by-regexp nil (ecb-methods-get-data-store 'source-buffer)))
1807
1808
(tree-buffer-defpopup-command ecb-methods-filter-by-regexp-popup-inverse
1809
"Filter the Methods-buffer by inverse regexp from popup."
1810
(ecb-methods-filter-by-regexp t (ecb-methods-get-data-store 'source-buffer)))
1811
1812
(defun ecb-methods-filter-by-function (inverse source-buffer &optional fcn-name)
1813
"Filter the Methods-buffer by a filter-function."
1814
(let ((filter-fcn-name (or fcn-name
1815
(completing-read "Tag-filter-function: "
1816
obarray 'fboundp t))))
1817
(ecb-methods-filter-apply 'function
1818
(cons (intern filter-fcn-name)
1819
nil)
1820
inverse
1821
(concat (and inverse "^") "Function")
1822
filter-fcn-name
1823
source-buffer)))
1824
1825
(tree-buffer-defpopup-command ecb-methods-filter-by-function-popup
1826
"Filter the Methods-buffer by function-filter from popup."
1827
(ecb-methods-filter-by-function nil (ecb-methods-get-data-store 'source-buffer)))
1828
1829
(tree-buffer-defpopup-command ecb-methods-filter-by-function-popup-inverse
1830
"Filter the Methods-buffer by inverse function-filter from popup."
1831
(ecb-methods-filter-by-function t (ecb-methods-get-data-store 'source-buffer)))
1832
1833
(tree-buffer-defpopup-command ecb-methods-filter-by-nothing-popup
1834
"Remove any filter from the Methods-buffer from popup."
1835
(ecb-methods-filter-apply nil nil nil "" "" (ecb-methods-get-data-store 'source-buffer)))
1836
1837
(tree-buffer-defpopup-command ecb-methods-filter-delete-last-popup
1838
"Remove the last added filter from the Methods-buffer from popup."
1839
(ecb-methods-filter-apply nil nil nil "" "" (ecb-methods-get-data-store 'source-buffer) t))
1840
1841
1842
(defun ecb-get-type-node-of-node (node)
1843
"Returns that node which data-tag is of class 'type the tag of the node NODE
1844
of the Methods-buffer belongs to. If the tag of NODE do not belong to a type
1845
then nil is returned."
1846
(let ((parent (tree-node-get-parent node)))
1847
(catch 'found
1848
(while (not (eq (tree-buffer-get-root) parent))
1849
(if (equal (and (= (tree-node-get-type parent) 0)
1850
(ecb--semantic-tag-class (tree-node-get-data parent)))
1851
'type)
1852
(throw 'found parent)
1853
(setq parent (tree-node-get-parent parent))))
1854
nil)))
1855
1856
1857
(defun ecb-get-type-name-hierarchy-of-current-node ()
1858
"Return the type-name-hierarchy of current node in form of a list whereas the
1859
first element is the name of the tag of the current node itself, the second
1860
element is the name of the type the current node belongs to, the third element
1861
is the name of the parent-type of that type and so on. The last element in
1862
this list is the topmost type-parent of the tag of the current node. If the
1863
current node has no tag as data then nil is returned. If the tag of the
1864
current node does not belong to a type-tag \(e.g. a toplevel function) then
1865
the returned list contains just the name of the tag of the current node."
1866
(let ((type-hierarchy nil)
1867
(curr-node (tree-buffer-get-node-at-point)))
1868
(when (and curr-node
1869
(= (tree-node-get-type curr-node) 0))
1870
(while (progn
1871
(setq type-hierarchy (cons (ecb--semantic-tag-name
1872
(tree-node-get-data curr-node))
1873
type-hierarchy))
1874
(setq curr-node (ecb-get-type-node-of-node curr-node)))))
1875
(nreverse type-hierarchy)))
1876
1877
1878
(defun ecb-get-type-tag-of-tag (&optional tag table always-parent-type)
1879
"Returns that tag of class 'type the tag TAG belongs to. If TAG does not
1880
belong to a type then nil is returned. If TAG is already of class 'type then
1881
the behavior depends on the optional argument ALWAYS-PARENT-TYPE: If nil then
1882
the current tag is returned otherwise the next parent-tag of class 'type is
1883
returned.
1884
1885
If TAG is nil the tag returned by `ecb-get-real-curr-tag' is used. If TABLE is
1886
nil then the tag-table of the current buffer is used; otherwise the tag-table
1887
TABLE is used."
1888
(let* ((table (or table (ecb-get-current-tag-table)))
1889
(curr-tag (or tag (ecb-get-real-curr-tag)))
1890
(function-parent (ecb--semantic-tag-function-parent curr-tag)))
1891
(cond ((ecb-faux-group-tag-p curr-tag)
1892
(and (not always-parent-type) curr-tag))
1893
((and (not always-parent-type)
1894
(equal (ecb--semantic-tag-class curr-tag) 'type))
1895
curr-tag)
1896
(t (if function-parent
1897
;; we have an external member and we search the type this
1898
;; external member belongs to. This can either be a type-tag
1899
;; in the current file (which is then contained in table) or
1900
;; a faux-tag (created by semantic-adopt-external-members)
1901
;; when the parent-type of this external member is defined
1902
;; outside the current source - but this faux-type is
1903
;; contained in table too.
1904
(catch 'found
1905
(dolist (tag (ecb--semantic-flatten-tags-table table))
1906
(if (and (equal (ecb--semantic-tag-class tag) 'type)
1907
(ecb-string= (ecb--semantic-tag-name tag)
1908
function-parent)
1909
(delq nil
1910
(mapcar (lambda (child)
1911
(if (ecb--semantic-equivalent-tag-p
1912
child curr-tag)
1913
curr-tag))
1914
(ecb--semantic-tag-children-compatibility tag t))))
1915
(throw 'found tag)))
1916
nil)
1917
;; we are already inside the parent-type - if there is any, so
1918
;; we simply search the nearest tag of class 'type in the
1919
;; reversed overlay-stack
1920
(catch 'found
1921
(dolist (tag (cdr (reverse
1922
(ecb--semantic-find-tag-by-overlay
1923
(ecb--semantic-tag-start curr-tag)
1924
(ecb--semantic-tag-buffer curr-tag)))))
1925
(if (equal (ecb--semantic-tag-class tag) 'type)
1926
(throw 'found tag)))
1927
nil))))))
1928
1929
1930
(defun ecb-get-type-name-hierarchy-of-current-tag (&optional tag)
1931
"Return the type-name-hierarchy of TAG in form of a list whereas the
1932
first element is the name of the TAG itself, the second element is the name of
1933
the type the TAG belongs to, the third element is the name of the parent-type
1934
of that type and so on. The last element in this list is the topmost
1935
type-parent of the TAG. If the TAG does not belong to a type-tag \(e.g. a
1936
toplevel function) then the returned list contains just the name of the
1937
TAG. If TAG is nil then the current tag returned by `ecb-get-real-curr-tag' is
1938
used; if point does not stay on a tag then nil is returned."
1939
(let ((type-hierarchy nil)
1940
(curr-tag (or tag (ecb-get-real-curr-tag))))
1941
(when curr-tag
1942
(while (progn
1943
(setq type-hierarchy (cons (ecb--semantic-tag-name curr-tag)
1944
type-hierarchy))
1945
(setq curr-tag (ecb-get-type-tag-of-tag curr-tag nil t)))))
1946
(nreverse type-hierarchy)))
1947
1948
(defun ecb-methods-filter-by-current-type (inverse source-buffer &optional
1949
tag)
1950
"Display only the current-type and its contents in the methods-buffer. The
1951
argument INVERSE is ignored here."
1952
(let* ((curr-type-tag (or (and (ecb--semantic-tag-p tag)
1953
(save-excursion
1954
(set-buffer source-buffer)
1955
(ecb-get-type-tag-of-tag tag)))
1956
(cond ((ecb-point-in-edit-window)
1957
(if (ecb--semantic-active-p)
1958
(save-excursion
1959
(set-buffer source-buffer)
1960
(ecb-get-type-tag-of-tag (ecb-get-real-curr-tag)))))
1961
((equal (current-buffer)
1962
(get-buffer ecb-methods-buffer-name))
1963
(let ((node (tree-buffer-get-node-at-point)))
1964
(and node
1965
(tree-node-get-data (ecb-get-type-node-of-node node)))))
1966
(t (ecb-error "ECB can not identify the current-type-tag!")))))
1967
(curr-tag-type-name-hierachy (and curr-type-tag
1968
(save-excursion
1969
(set-buffer source-buffer)
1970
(ecb-get-type-name-hierarchy-of-current-tag
1971
curr-type-tag)))))
1972
(if (and curr-type-tag curr-tag-type-name-hierachy)
1973
(ecb-methods-filter-apply 'current-type
1974
(cons curr-tag-type-name-hierachy
1975
'ecb-methods-filter-perform-current-type)
1976
nil
1977
"Type"
1978
(ecb--semantic-tag-name curr-type-tag)
1979
source-buffer)
1980
(ecb-error "ECB can not identify the current-type!"))))
1981
1982
(tree-buffer-defpopup-command ecb-methods-filter-by-current-type-popup
1983
"Display only the current-type from popup."
1984
(ecb-methods-filter-by-current-type nil
1985
(ecb-methods-get-data-store 'source-buffer)
1986
(tree-node-get-data node)))
1987
1988
1989
(defun ecb-get-source-buffer-for-tag-filter ()
1990
"Return the source-buffer of the tag-list which should be filtered."
1991
(cond ((ecb-point-in-edit-window)
1992
(current-buffer))
1993
((equal (current-buffer)
1994
(get-buffer ecb-methods-buffer-name))
1995
(ecb-methods-get-data-store 'source-buffer))
1996
(t (or (and ecb-last-source-buffer
1997
(buffer-live-p ecb-last-source-buffer)
1998
ecb-last-source-buffer)
1999
(ecb-error "There is no source-file to filter!")))))
2000
2001
(defun ecb-methods-filter-inverse ()
2002
"Apply an inverse filter to the Methods-buffer. This is the same as calling
2003
`ecb-methods-filter' with a prefix arg."
2004
(interactive)
2005
(ecb-methods-filter-internal t))
2006
2007
(defun ecb-methods-filter-protection (&optional inverse)
2008
"Filter the methods-buffer by protection. If INVERSE is not nil \(called
2009
with a prefix arg) then an inverse filter is applied. For further details see
2010
`ecb-methods-filter'."
2011
(interactive "P")
2012
(ecb-methods-filter-internal inverse "protection"))
2013
2014
(defun ecb-methods-filter-tagclass (&optional inverse)
2015
"Filter the methods-buffer by tag-class. If INVERSE is not nil \(called
2016
with a prefix arg) then an inverse filter is applied. For further details see
2017
`ecb-methods-filter'."
2018
(interactive "P")
2019
(ecb-methods-filter-internal inverse "tag-class"))
2020
2021
(defun ecb-methods-filter-current-type ()
2022
"Display in the Methods-buffer only the current type and its members. For
2023
further details see `ecb-methods-filter'."
2024
(interactive)
2025
(ecb-methods-filter-internal nil "curr-type"))
2026
2027
(defun ecb-methods-filter-regexp (&optional inverse)
2028
"Filter the methods-buffer by a regexp. If INVERSE is not nil \(called
2029
with a prefix arg) then an inverse filter is applied. For further details see
2030
`ecb-methods-filter'."
2031
(interactive "P")
2032
(ecb-methods-filter-internal inverse "regexp"))
2033
2034
(defun ecb-methods-filter-function (&optional inverse)
2035
"Filter the methods-buffer by a function. If INVERSE is not nil \(called
2036
with a prefix arg) then an inverse filter is applied. For further details see
2037
`ecb-methods-filter'."
2038
(interactive "P")
2039
(ecb-methods-filter-internal inverse "function"))
2040
2041
(defun ecb-methods-filter-nofilter ()
2042
"Remove any filter from the Methods-buffer. For further details see
2043
`ecb-methods-filter'."
2044
(interactive)
2045
(ecb-methods-filter-internal nil "no filter"))
2046
2047
(defun ecb-methods-filter-delete-last ()
2048
"Remove the most recent filter from the Methods-buffer. For further details see
2049
`ecb-methods-filter'."
2050
(interactive)
2051
(ecb-methods-filter-internal nil "delete last"))
2052
2053
(defun ecb-methods-filter (&optional inverse)
1310
2054
"Apply a filter to the Methods-buffer to reduce the number of entries.
1311
So you get a better overlooking. There are four choices:
2055
So you get a better overlooking. There are six choices:
1312
2056
- Filter by protection: Just insert the protection you want the Methods-buffer
1313
2057
being filtered: private, protected or public!
1314
2058
- Filter by regexp: Insert the filter as regular expression.
1315
- Filter by tag-class: You can filter by the tag-classes include, type,
1316
variable, function, rule, section \(chapters and sections in `info-mode'),
1317
def \(definitions in `info-mode').
1318
- No filter: This means to display all tags specified with the option
1319
`ecb-show-tokens'.
2059
- Filter by tag-class: You can filter by the tag-classes of current
2060
major-mode. The available tag-classes come from the variable
2061
`semantic--symbol->name-assoc-list'. The are normally methods, variables
2062
etc.
2063
- Filter by current type: In languages which have types like Java or C++ this
2064
filter displays only the current type and all its members \(e.g. attributes
2065
and methods). If ECB can not identify the current type in the source-buffer
2066
or in the methods-window then nothing will be done.
2067
- Filter by a filter-function: Such a function gets two arguments: a tag and
2068
the source-buffer of this tag. If the tag should be displayed \(i.e. not
2069
being filtered out) then the function has to return not nil otherwise nil.
2070
- No special filter: This means to display all tags specified with the option
2071
`ecb-show-tokens'. If currently some of the above filters are applied they
2072
will be all removed.
2073
- Delete the last added: This removes only the topmost filter-layer, means
2074
that filter added last.
2075
2076
The protection-, the current-type and the tag-class-filter are only available
2077
for semantic-supported sources.
1320
2078
1321
2079
Be aware that the tag-list specified by the option `ecb-show-tags' is the
1322
2080
basis of all filters, i.e. tags which are excluded by that option will never
1323
2081
be shown regardless of the filter type here!
1324
2082
2083
All tags which match the applied filter\(s) will be displayed in the
2084
Methods-buffer.
2085
2086
If called with a prefix-argument or when optional arg INVERSE is not nil then
2087
an inverse filter is applied to the Methods-buffer, i.e. all tags which
2088
do NOT match the choosen filter will be displayed in the Methods-buffer!
2089
2090
Per default the choosen filter will be applied on top of already existing
2091
filters. This means that filters applied before are combined with the new
2092
filter. This behavior can changed via the option
2093
`ecb-methods-filter-replace-existing'. But regardless of the setting in
2094
`ecb-methods-filter-replace-existing' applying one of the not-inverse filters
2095
protection, tag-class or current-type always replaces exactly already existing
2096
filters of that type. On the other hand applying more than one inverse
2097
tag-class- or protection-filter can make sense.
2098
1325
2099
Such a filter is only applied to the current source-buffer, i.e. each
1326
source-buffer can have its own tag-filter."
1327
(interactive)
1328
(ecb-error "This command will be offered first in future-versions of ECB!")
1329
(let ((source-buffer (if (ecb-point-in-edit-window)
1330
(current-buffer)
1331
(or ecb-last-source-buffer
1332
(ecb-error "There is no source-file to filter!"))))
1333
(choice (ecb-query-string "Filter Methods-buffer by:"
1334
'("regexp" "protection" "tag-class" "nothing"))))
1335
(cond ((string= choice "protection")
1336
(ecb-methods-filter-by-prot source-buffer))
1337
((string= choice "tag-class")
1338
(ecb-methods-filter-by-tag-class source-buffer))
1339
((string= choice "regexp")
1340
(ecb-methods-filter-by-regexp source-buffer))
1341
(t (ecb-methods-filter-none source-buffer)))))
1342
1343
1344
(defun ecb-methods-filter-apply (filter source-buffer)
1345
(let ((filter-elem (assoc source-buffer ecb-methods-user-filter-alist)))
2100
source-buffer can have its own tag-filters.
2101
2102
The current active filter will be displayed in the modeline of the
2103
Methods-buffer \[regexp, prot \(= protection), tag-class, function \(=
2104
filter-function)]. If an inverse filter has been applied then this is
2105
signalized by a preceding caret ^. If currently more than 1 filter is applied
2106
then always the top-most filter is displayed in the modeline but the fact of
2107
more than 1 filter is visualized by the number of the filters - included in
2108
parens. You can see all currently applied filters by moving the mouse over the
2109
filter-string in modeline of the Methods-buffer: They will displayed as
2110
help-echo.
2111
2112
See the option `ecb-default-tag-filter' if you search for automatically
2113
applied default-tag-filters."
2114
(interactive "P")
2115
(ecb-methods-filter-internal inverse))
2116
2117
(defun ecb-methods-filter-internal (inverse &optional filter-type)
2118
"FILTER-TYPE has to be one of the strings \"regexp\", \"protection\",
2119
\"tag-class\", \"curr-type\", \"function\", \"no filter\" or \"delete last\"."
2120
(if (save-excursion
2121
(set-buffer ecb-methods-buffer-name)
2122
(tree-buffer-empty-p))
2123
(message "There is nothing to filter in an empty Methods-buffer!")
2124
(let* ((source-buffer (ecb-get-source-buffer-for-tag-filter))
2125
(semantic-source-p (save-excursion
2126
(set-buffer source-buffer)
2127
(ecb--semantic-active-p)))
2128
(choice (or filter-type
2129
(ecb-query-string
2130
(format "Apply %sfilter:"
2131
(if inverse "inverse " ""))
2132
(delq nil (list "regexp"
2133
(if semantic-source-p "protection")
2134
(if semantic-source-p "tag-class")
2135
(if semantic-source-p "curr-type")
2136
"function" "no filter" "delete last"))))))
2137
(cond ((ecb-string= choice "protection")
2138
(ecb-methods-filter-by-prot inverse source-buffer))
2139
((ecb-string= choice "tag-class")
2140
(ecb-methods-filter-by-tag-class inverse source-buffer))
2141
((ecb-string= choice "regexp")
2142
(ecb-methods-filter-by-regexp inverse source-buffer))
2143
((ecb-string= choice "curr-type")
2144
(ecb-methods-filter-by-current-type inverse source-buffer))
2145
((ecb-string= choice "function")
2146
(ecb-methods-filter-by-function inverse source-buffer))
2147
((ecb-string= choice "delete last")
2148
(ecb-methods-filter-apply nil nil nil "" "" source-buffer t))
2149
((ecb-string= choice "no filter")
2150
(ecb-methods-filter-apply nil nil nil "" "" source-buffer))
2151
(t (ecb-methods-filter-apply nil nil nil "" "" source-buffer))))))
2152
2153
(defun ecb-methods-filter-apply (filtertype filter inverse filter-type-display
2154
filter-display
2155
source-buffer &optional remove-last)
2156
"Apply the FILTER of type FILTERTYPE to the buffer SOURCEBUFFER. If INVERSE
2157
is not nil then this filter will be applied inverse. FILTER-TYPE-DISPLAY and
2158
FILTER-DISPLAY are strings and specify how the FILTER of type FILTERTYPE
2159
should be displayed in the modeline of the methods-buffer. If REMOVE-LAST is
2160
not nil then the topmost filter will be removed and all other arguments unless
2161
SOURCE-BUFFER arguments are ignored."
2162
(save-excursion
2163
(set-buffer source-buffer)
2164
(if (and (not remove-last)
2165
(member filtertype '(protection tag-class curr-type))
2166
(not (ecb--semantic-active-p)))
2167
(ecb-error "A %s-filter '%s' can only applied to semantic-supported sources!"
2168
filtertype filter)))
2169
(let* ((filter-elem (assoc source-buffer ecb-methods-user-filter-alist))
2170
(new-filter-spec (and filtertype
2171
(list filtertype filter (if inverse 'not 'identity)
2172
filter-type-display filter-display)))
2173
(replace-all (and (not remove-last)
2174
(not (equal ecb-methods-filter-replace-existing 'never))
2175
(or (equal ecb-methods-filter-replace-existing 'always)
2176
(y-or-n-p "Should the new filter replace existing ones? "))))
2177
(replace-filter-type (and (not inverse)
2178
(not replace-all)
2179
(not remove-last)
2180
(assoc filtertype (cdr filter-elem))
2181
(member filtertype '(protection tag-class current-type))))
2182
(filters (or (and replace-filter-type
2183
(progn
2184
(setcdr filter-elem
2185
(ecb-remove-assoc filtertype (cdr filter-elem)))
2186
(append (cdr filter-elem) (list new-filter-spec))))
2187
(and remove-last
2188
(nreverse (cdr (reverse (cdr filter-elem)))))
2189
(and new-filter-spec ;; if nil there should be no filter anymore
2190
(if replace-all
2191
new-filter-spec ;; just the new filter-spec
2192
(append (cdr filter-elem) (list new-filter-spec)))))))
1346
2193
(if filter-elem
1347
(setcdr filter-elem filter)
1348
(if filter
2194
(setcdr filter-elem filters)
2195
(if filters
1349
2196
(setq ecb-methods-user-filter-alist
1350
(cons (cons source-buffer filter)
1351
ecb-methods-user-filter-alist)))))
1352
(if (get-buffer-window source-buffer ecb-frame)
1353
(save-selected-window
1354
(select-window (get-buffer-window source-buffer ecb-frame))
1355
(ecb-rebuild-methods-buffer))))
2197
(cons (cons source-buffer filters) ecb-methods-user-filter-alist)))))
2198
(when (buffer-live-p source-buffer)
2199
(save-excursion
2200
(set-buffer source-buffer)
2201
(if (ecb--semantic-active-p)
2202
;; For semantic-sources we do not use `ecb-rebuild-methods-buffer)'
2203
;; because this would always reparse the source-buffer even if not
2204
;; necessary.
2205
(save-restriction
2206
(widen)
2207
(ecb-rebuild-methods-buffer-with-tagcache
2208
(ecb--semantic-fetch-tags t)))
2209
(ecb-rebuild-methods-buffer)))
2210
(when (save-excursion
2211
(set-buffer ecb-methods-buffer-name)
2212
(tree-buffer-empty-p))
2213
(ecb-methods-filter-apply nil nil nil "" "" source-buffer t)
2214
(message "ECB has not applied this filter because it would filter out all nodes!"))))
2215
1356
2216
2217
(defun ecb-methods-filter-modeline-prefix (buffer-name sel-dir sel-source)
2218
"Compute a mode-line prefix for the Methods-buffer so the current filter
2219
applied to the displayed tags is displayed. This function is only for using by
2220
the option `ecb-mode-line-prefixes'."
2221
(let* ((filters (and sel-source
2222
(cdr (assoc (get-file-buffer sel-source)
2223
ecb-methods-user-filter-alist))))
2224
(top-filter-spec (ecb-last filters))
2225
(filter-type-str (nth 3 top-filter-spec))
2226
(filter-str (nth 4 top-filter-spec)))
2227
(if (null top-filter-spec)
2228
nil ;; no prefix if no filter
2229
(let ((str (format "[%s%s: %s]"
2230
filter-type-str
2231
(if (> (length filters) 1)
2232
(format "(%d)" (length filters))
2233
"")
2234
filter-str)))
2235
(put-text-property 0 (length str) 'help-echo
2236
(mapconcat (function
2237
(lambda (f-elem)
2238
(let ((f-type-str (nth 3 f-elem) )
2239
(f-str (nth 4 f-elem)))
2240
(format "[%s: %s]"
2241
f-type-str f-str))))
2242
filters
2243
", ")
2244
str)
2245
str))))
2246
2247
(defun ecb-default-tag-filter-for-current-file ()
2248
"Check if for the file of the current buffer a default-tag-filter should be
2249
applied. If yes, then the filters-list of `ecb-default-tag-filter' is returned
2250
otherwise nil."
2251
(catch 'found
2252
(dolist (spec ecb-default-tag-filter)
2253
(let ((m-mode (caar spec))
2254
(regexp (cdar spec)))
2255
(if (and (equal major-mode m-mode)
2256
(save-match-data
2257
(string-match regexp (buffer-file-name (current-buffer)))))
2258
(throw 'found (cdr spec)))))
2259
nil))
2260
2261
(defun ecb-apply-default-tag-filter ()
2262
"Applies all default-tag-filters specified in `ecb-default-tag-filter' for
2263
the current file."
2264
(remove-hook 'post-command-hook 'ecb-apply-default-tag-filter)
2265
(ignore-errors
2266
(let ((tag-filter-list (ecb-default-tag-filter-for-current-file)))
2267
(dolist (filter-spec tag-filter-list)
2268
(let ((filter-apply-fcn
2269
(cond ((equal (nth 0 filter-spec) 'protection)
2270
'ecb-methods-filter-by-prot)
2271
((equal (nth 0 filter-spec) 'tag-class)
2272
'ecb-methods-filter-by-tag-class)
2273
((equal (nth 0 filter-spec) 'regexp)
2274
'ecb-methods-filter-by-regexp)
2275
((equal (nth 0 filter-spec) 'function)
2276
'ecb-methods-filter-by-function)))
2277
(filter
2278
(cond ((equal (nth 0 filter-spec) 'protection)
2279
(cond ((symbolp (nth 1 filter-spec))
2280
(symbol-name (nth 1 filter-spec)))
2281
((stringp (nth 1 filter-spec))
2282
(nth 1 filter-spec))
2283
(t (ecb-error "Not a valid tag-filter: %s"
2284
(nth 1 filter-spec)))))
2285
((equal (nth 0 filter-spec) 'tag-class)
2286
(cond ((symbolp (nth 1 filter-spec))
2287
(symbol-name (nth 1 filter-spec)))
2288
((stringp (nth 1 filter-spec))
2289
(nth 1 filter-spec))
2290
(t (ecb-error "Not a valid tag-filter: %s"
2291
(nth 1 filter-spec)))))
2292
((equal (nth 0 filter-spec) 'regexp)
2293
(if (stringp (nth 1 filter-spec))
2294
(nth 1 filter-spec)
2295
(ecb-error "Not a valid tag-filter: %s"
2296
(nth 1 filter-spec))))
2297
((equal (nth 0 filter-spec) 'function)
2298
(cond ((symbolp (nth 1 filter-spec))
2299
(symbol-name (nth 1 filter-spec)))
2300
((stringp (nth 1 filter-spec))
2301
(nth 1 filter-spec))
2302
(t (ecb-error "Not a valid tag-filter: %s"
2303
(nth 1 filter-spec))))))))
2304
(funcall filter-apply-fcn
2305
(nth 2 filter-spec) (current-buffer) filter))))))
2306
2307
(defun ecb-find-file-hook ()
2308
"Adds `ecb-apply-default-tag-filter' to `post-command-hook'. This function
2309
removes itself from the `post-command-hook'."
2310
(add-hook 'post-command-hook 'ecb-apply-default-tag-filter))
2311
2312
;; adding tags to the Methods-buffer
1357
2313
1358
2314
(defun ecb-add-tags (node tags &optional parent-tag no-bucketize)
1359
2315
"If NO-BUCKETIZE is not nil then TAGS will not bucketized by
1360
2316
`ecb--semantic-bucketize' but must already been bucketized!"
1361
(ecb-add-tag-buckets node parent-tag
1362
(if no-bucketize
1363
tags
1364
(ecb--semantic-bucketize tags))
1365
no-bucketize))
2317
(ecb-add-tag-buckets
2318
node parent-tag
2319
(if no-bucketize
2320
tags
2321
(ecb--semantic-bucketize tags
2322
(and parent-tag
2323
(ecb--semantic-symbol->name-assoc-list-for-type-parts)
2324
(equal (ecb--semantic-tag-class parent-tag)
2325
'type))))
2326
no-bucketize))
1366
2327
1367
2328
1368
2329
(defun ecb-access-order (access)
1377
2338
(if sort-method
1378
2339
(let ((tags-by-name
1379
2340
(sort tags (function (lambda (a b)
1380
(string< (ecb--semantic-tag-name a)
1381
(ecb--semantic-tag-name b)))))))
2341
(ecb-string< (ecb--semantic-tag-name a)
2342
(ecb--semantic-tag-name b)))))))
1382
2343
(if (eq 'access sort-method)
1383
2344
(sort tags-by-name
1384
2345
(function
1394
2355
The PARENT-TAG is propagated to the functions `ecb-add-tag-bucket' and
1395
2356
`ecb-find-add-tag-bucket'."
1396
2357
(setq buckets (cons nil buckets))
1397
(dolist (tag-display ecb-show-tags)
2358
(dolist (tag-display (ecb-get-show-tags-list))
1398
2359
(let* ((type (car tag-display))
1399
2360
(display (cadr tag-display))
1400
2361
(sort-method (caddr tag-display)))
1404
2365
(eq 'type (ecb--semantic-tag-class parent-tag)))
1405
2366
(let ((parents (ecb-get-tag-parents parent-tag)))
1406
2367
(when parents
1407
(let ((node (ecb-create-node node display (ecb-format-bucket-name "Parents") nil 1)))
1408
(when node
2368
(let* ((name-bucket (ecb-format-bucket-name "Parents"))
2369
(name (ecb-generate-node-name name-bucket -1 "parent-bucket"))
2370
(parent-node nil))
2371
(setq parent-node (ecb-create-node node display
2372
name
2373
(list 'ecb-bucket-node
2374
"Parents"
2375
'parent)
2376
1))
2377
(when node
1409
2378
(dolist (parent (if sort-method
1410
(sort parents 'string<) parents))
1411
(tree-node-new (if ecb-font-lock-tags
1412
(ecb--semantic--format-colorize-text parent 'type)
1413
parent)
1414
2 parent t node
1415
(if ecb-truncate-long-names 'end)))))))))
2379
(sort parents 'ecb-string<) parents))
2380
(let* ((plain-parent-name
2381
(if ecb-font-lock-tags
2382
(ecb--semantic--format-colorize-text parent 'type)
2383
parent))
2384
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: When
2385
;; the next version of the semantic-parsers offer
2386
;; the protection of the inheritance (like possible
2387
;; in C++) then we have to adjust this code and
2388
;; compute the correct icon-name.
2389
(parent-name (ecb-generate-node-name plain-parent-name
2390
-1
2391
"parent-unknown")))
2392
(tree-node-new parent-name
2393
2 parent t parent-node
2394
(if ecb-truncate-long-names 'end))))))))))
1416
2395
(t (ecb-find-add-tag-bucket node type display sort-method buckets
1417
parent-tag no-bucketize)))))
2396
parent-tag no-bucketize)))))
1418
2397
(let ((type-display (ecb-get-tag-type-display t)))
1419
2398
(dolist (bucket buckets)
1420
2399
(ecb-add-tag-bucket node bucket (cadr type-display)
1431
2410
;; a mechanism where only the UPDATED-TAGS are used and only this ones are
1432
2411
;; updated. But for this we need also a tree-buffer-update which can update
1433
2412
;; single nodes without refreshing the whole tree-buffer like now.
1434
(ecb-rebuild-methods-buffer-with-tagcache (ecb--semantic-bovinate-toplevel t)))
2413
(ecb-rebuild-methods-buffer-with-tagcache (ecb--semantic-fetch-tags t)))
1435
2414
1436
2415
1437
2416
(defun ecb-semantic-active-for-file (filename)
1483
2462
(get-buffer-window ecb-methods-buffer-name))
1484
2463
;; Set here `ecb-method-buffer-needs-rebuild' to t so we can see below if
1485
2464
;; `ecb-rebuild-methods-buffer-with-tagcache' was called auto. after
1486
;; `ecb--semantic-bovinate-toplevel'.
2465
;; `ecb--semantic-fetch-tags'.
1487
2466
(setq ecb-method-buffer-needs-rebuild t)
1488
2467
1489
2468
(let ((current-tagcache (and (ecb--semantic-active-p)
1490
2469
;; if we manually bovinate the buffer we
1491
2470
;; must widen the source to get all tags.
1492
;; But here we must not use the adviced
1493
;; version of widen!
1494
2471
(save-excursion
1495
2472
(save-restriction
1496
(ecb-with-original-basic-functions
1497
(widen))
1498
(ecb--semantic-bovinate-toplevel t))))))
1499
;; If the `ecb--semantic-bovinate-toplevel' has done no reparsing but only
2473
(widen)
2474
(ecb--semantic-fetch-tags t))))))
2475
;; If the `ecb--semantic-fetch-tags' has done no reparsing but only
1500
2476
;; used it�s still valid `semantic-toplevel-bovine-cache' then neither
1501
2477
;; the hooks of `semantic-after-toplevel-cache-change-hook' nor the
1502
2478
;; hooks in `semantic-after-partial-cache-change-hook' are evaluated and
1534
2510
for a certain source.")
1535
2511
(setq ecb-tag-tree-cache nil)
1536
2512
1537
1538
2513
(defun ecb-clear-tag-tree-cache (&optional source-file-name)
1539
2514
"Clears wither the whole tag-tree-cache \(SOURCE-FILE-NAME is nil) or
1540
2515
removes only the tag-tree for SOURCE-FILE-NAME from the cache."
1543
2518
(setq ecb-tag-tree-cache
1544
2519
(adelete 'ecb-tag-tree-cache source-file-name))))
1545
2520
1546
2521
(defvar ecb-current-post-processed-tag-table nil
2522
"This is the current tag-table of the current source-buffer returned by
2523
`ecb-post-process-taglist'. Do not set this variable, only the function
2524
`ecb-rebuild-methods-buffer-with-tagcache' is allowed to do this.")
2525
(make-variable-buffer-local 'ecb-current-post-processed-tag-table)
2526
2527
(defun ecb-get-current-tag-table ()
2528
"Return the current tag-table of the current source-buffer returned by
2529
`ecb-post-process-taglist'. Use always this function if you just need the
2530
current post-processed tag-table of the current buffer and you do not need or
2531
want rebuilding the Methods-buffer."
2532
ecb-current-post-processed-tag-table)
2533
2534
(defun ecb-set-current-tag-table (table)
2535
"Set the current tag-table of the current source-buffer to TABLE. Return
2536
TABLE."
2537
(setq ecb-current-post-processed-tag-table table))
2538
2539
2540
(defun ecb-methods-get-data-store (key)
2541
"Get the value for KEY from the tree-buffer-data-store of the Methods-buffer."
2542
(save-excursion
2543
(ecb-buffer-select ecb-methods-buffer-name)
2544
(cdr (assoc key (tree-buffer-get-data-store)))))
2545
1547
2546
1548
2547
(defun ecb-rebuild-methods-buffer-with-tagcache (updated-cache
1549
&optional no-update-semantic
1550
force-nil-cache
1551
non-semantic-rebuild)
2548
&optional no-update-semantic
2549
force-nil-cache
2550
non-semantic-rebuild)
1552
2551
"Rebuilds the ECB-method buffer after toplevel-parsing by semantic. This
1553
2552
function is added to the hook `semantic-after-toplevel-cache-change-hook'.
1554
2553
1603
2602
;; update this cache-element instead of always adding a new one to the
1604
2603
;; cache. Otherwise we would get more than one cache-element for the same
1605
2604
;; source!.
1606
1607
2605
(let* ((norm-buffer-file-name (ecb-fix-filename
1608
2606
(buffer-file-name (current-buffer))))
1609
2607
(cache (assoc norm-buffer-file-name ecb-tag-tree-cache))
1610
2608
(curr-buff (current-buffer))
1611
2609
(curr-major-mode major-mode)
2610
(ezimage-use-images (if (ecb-use-images-for-semantic-tags)
2611
nil
2612
(ecb--ezimage-use-images)))
2613
(semantic-format-use-images-flag (if (ecb-use-images-for-semantic-tags)
2614
nil
2615
(ecb--semantic-format-use-images-flag)))
2616
(my-format-face-alist (if (ecb-use-images-for-semantic-tags)
2617
(ecb-remove-assoc 'abstract
2618
(ecb-remove-assoc 'static
2619
(ecb--semantic-format-face-alist)))
2620
(ecb--semantic-format-face-alist)))
2621
(semantic-format-face-alist my-format-face-alist)
2622
;; the semantic 1.4 compatibility needs this
2623
(semantic-face-alist my-format-face-alist)
2624
(semantic-bucketize-tag-class
2625
(if ecb-methods-separate-prototypes
2626
(function (lambda (tag)
2627
(if (ecb--semantic-tag-prototype-p tag)
2628
'prototype
2629
(ecb--semantic-tag-class tag))))
2630
semantic-bucketize-tag-class))
2631
(semantic-symbol->name-assoc-list-for-type-parts
2632
(and (ecb--semantic-active-p)
2633
(ecb--semantic-symbol->name-assoc-list-for-type-parts)
2634
(or (and (null (cdr (assoc 'function
2635
(ecb--semantic-symbol->name-assoc-list-for-type-parts))))
2636
(ecb--semantic-symbol->name-assoc-list-for-type-parts))
2637
(append (ecb--semantic-symbol->name-assoc-list-for-type-parts)
2638
(list (cons 'prototype
2639
(format "%s-prototypes"
2640
(ecb-string-make-singular
2641
(cdr (assoc 'function
2642
(ecb--semantic-symbol->name-assoc-list-for-type-parts)))))))))))
2643
(semantic-symbol->name-assoc-list
2644
(and (ecb--semantic-active-p)
2645
(ecb--semantic-symbol->name-assoc-list)
2646
(or (and (null (cdr (assoc 'function
2647
(ecb--semantic-symbol->name-assoc-list))))
2648
(ecb--semantic-symbol->name-assoc-list))
2649
(append (ecb--semantic-symbol->name-assoc-list)
2650
(list (cons 'prototype
2651
(format "%s-prototypes"
2652
(ecb-string-make-singular
2653
(cdr (assoc 'function
2654
(ecb--semantic-symbol->name-assoc-list)))))))))))
2655
(curr-semantic-symbol->name-assoc-list semantic-symbol->name-assoc-list)
1612
2656
new-tree non-semantic-handling)
1613
2657
1614
2658
(if ecb-debug-mode
1651
2695
(if non-semantic-handling
1652
2696
(if (equal non-semantic-handling 'parsed)
1653
2697
(ecb-create-non-semantic-tree new-tree updated-cache))
1654
(ecb-add-tags new-tree (ecb-post-process-taglist updated-cache)))
2698
(ecb-add-tags new-tree
2699
(ecb-post-process-taglist updated-cache)))
1655
2700
(if cache
1656
2701
(setcdr cache new-tree)
1657
2702
(setq cache (cons norm-buffer-file-name new-tree))
1669
2714
(save-excursion
1670
2715
(ecb-buffer-select ecb-methods-buffer-name)
1671
2716
;; we store in the tree-buffer the buffer and the major-mode for which
1672
;; the tree-buffer has been build
1673
(tree-buffer-set-data-store (cons curr-buff curr-major-mode))
2717
;; the tree-buffer has been build. In no other place the data-store
2718
;; will be set!
2719
(tree-buffer-set-data-store (list (cons 'source-buffer curr-buff)
2720
(cons 'source-major-mode curr-major-mode)
2721
(cons 'semantic-symbol->name-assoc-list
2722
curr-semantic-symbol->name-assoc-list)))
1674
2723
(tree-buffer-set-root (cdr cache))
1675
2724
(setq ecb-methods-root-node (cdr cache))
1676
2725
(tree-buffer-update)))
1808
2857
(if new-value "on" "off")
1809
2858
new-value)))
1810
2859
1811
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Hier auch was m�glich mit
1812
;; (ecb-exec-in-methods-window
1813
;; (tree-buffer-find-node-data curr-tag))
2860
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Define this with define-overload
2861
;; when the cedet 1.0 is stable - then we can remove the semantic 1.4 support
2862
;; - but first when cedet 1.0 is also available as XEmacs-package!
2863
(defun ecb-get-real-curr-tag ()
2864
"Get the \"real\" current tag. This will be in most cases the tag returned
2865
by `ecb--semantic-current-tag' but there are exceptions:
1814
2866
1815
(defun ecb-tag-sync-test (&optional force)
1816
(when (and ecb-minor-mode
1817
;; we do not use here `ecb-point-in-ecb-window' because this
1818
;; would slow down Emacs dramatically when tag-synchronization is
1819
;; done via post-command-hook and not via an idle-timer.
1820
(not (ecb-point-in-tree-buffer))
1821
(not (ecb-point-in-compile-window)))
1822
(when ecb-highlight-tag-with-point
1823
(let* ((tagstack (reverse (ecb--semantic-find-tag-by-overlay)))
1824
(curr-tag (car tagstack))
1825
(next-tag (car (cdr tagstack)))
1826
)
1827
(if (and (equal (ecb--semantic-tag-class curr-tag) 'variable)
2867
- If the current-tag is an argument-tag of a function-tag then we are not
2868
interested in this argument-tag but in its parent-tag which is the
2869
function-tag the argument belongs.
2870
- If the current-tag is a label-tag then we are interested in the type-tag
2871
which contains this label \(e.g. usefull in c++ and the labels public,
2872
protected and private)."
2873
(let* ((tagstack (reverse (ecb--semantic-find-tag-by-overlay)))
2874
(curr-tag (car tagstack))
2875
(next-tag (car (cdr tagstack)))
2876
)
2877
(if (or (and (equal (ecb--semantic-tag-class curr-tag) 'variable)
1828
2878
(equal (ecb--semantic-tag-class next-tag) 'function)
1829
(member curr-tag (ecb--semantic-tag-function-arguments next-tag)))
1830
(setq curr-tag next-tag))
1831
(when (or force (not (equal ecb-selected-tag curr-tag)))
1832
(setq ecb-selected-tag curr-tag)
1833
(save-selected-window
1834
(ecb-exec-in-methods-window
1835
(or (tree-buffer-highlight-node-data
1836
curr-tag nil (equal ecb-highlight-tag-with-point 'highlight))
1837
;; The node representing CURR-TAG could not be highlighted be
1838
;; `tree-buffer-highlight-node-data' - probably it is
1839
;; invisible. Let's try to make visible and then highlighting
1840
;; again.
1841
(when (and curr-tag ecb-auto-expand-tag-tree
1842
(or (equal ecb-auto-expand-tag-tree 'all)
1843
(member (ecb--semantic-tag-class curr-tag)
1844
(ecb-normalize-expand-spec
1845
ecb-methods-nodes-expand-spec))))
1846
(ecb-expand-methods-nodes-internal
1847
100
1848
(equal ecb-auto-expand-tag-tree 'all))
1849
(tree-buffer-highlight-node-data
1850
curr-tag nil (equal ecb-highlight-tag-with-point 'highlight))
1851
)))))))))
1852
2879
(member curr-tag
2880
(ecb--semantic-tag-function-arguments next-tag)))
2881
(equal (ecb--semantic-tag-class curr-tag) 'label))
2882
(setq curr-tag next-tag))
2883
curr-tag))
2884
2885
(defun ecb-try-highlight-tag (highlight-tag curr-tag table)
2886
"First we try to expand only the absolute needed parts of the tree-buffer to
2887
highlight the tag HIGHLIGHT-TAG - this means we recursively go upstairs the
2888
ladder of types the current tag belongs to. If this has still no success then
2889
we return nil otherwise true \(the HIGHLIGHT-TAG is highlighted).
2890
2891
If called from program: HIGHLIGHT-TAG is the tag to highlight, CURR-TAG has to
2892
be equal to HIGHLIGHT-TAG and TABLE must be the current tag-table of the
2893
current buffer."
2894
(let* ((type-tag (and curr-tag
2895
(ecb-get-type-tag-of-tag curr-tag table t)))
2896
(bucket-data
2897
(and (not type-tag)
2898
(list 'ecb-bucket-node
2899
(cdr (assoc (or (and (ecb--semantic-tag-prototype-p highlight-tag)
2900
'prototype)
2901
(ecb--semantic-tag-class highlight-tag))
2902
(ecb-methods-get-data-store
2903
'semantic-symbol->name-assoc-list)))
2904
(ecb--semantic-tag-class highlight-tag))))
2905
(type-node nil))
2906
(or (and curr-tag
2907
(save-selected-window
2908
(ecb-exec-in-methods-window
2909
(or (tree-buffer-highlight-node-data
2910
highlight-tag nil
2911
(equal ecb-highlight-tag-with-point 'highlight))
2912
;; If the tag could not be highlighted and if there is no
2913
;; containing type for this tag then this tag is probably
2914
;; contained in a toplevel bucket. Then we search the
2915
;; bucket-node for the tag if this tag-class is specified
2916
;; as expanded or collapsed (ie not flattened or hidden
2917
;; because in these cases no bucket would exist). If we
2918
;; find the bucket-node then we expand only this
2919
;; bucket-node and try highlighting again.
2920
(when (and highlight-tag
2921
bucket-data ;; tag has no containing type
2922
;; (member (car (cdr (assoc (ecb--semantic-tag-class highlight-tag)
2923
;; (ecb-get-show-tags-list))))
2924
;; '(expanded collapsed))
2925
(or (equal ecb-auto-expand-tag-tree 'all)
2926
(member (ecb--semantic-tag-class highlight-tag)
2927
(ecb-normalize-expand-spec
2928
ecb-methods-nodes-expand-spec))))
2929
(let ((bucket-node
2930
(tree-buffer-search-node-list
2931
(function (lambda (node)
2932
(if (and (tree-buffer-node-data-equal-p
2933
(tree-node-get-data node)
2934
bucket-data)
2935
(eq (tree-buffer-get-root)
2936
(tree-node-get-parent node)))
2937
node))))))
2938
(when bucket-node
2939
(ecb-expand-methods-node-internal
2940
bucket-node
2941
100
2942
(equal ecb-auto-expand-tag-tree 'all)
2943
nil t)
2944
(tree-buffer-highlight-node-data
2945
highlight-tag nil
2946
(equal ecb-highlight-tag-with-point 'highlight)))))
2947
;; The node representing HIGHLIGHT-TAG could not be
2948
;; highlighted by `tree-buffer-highlight-node-data' -
2949
;; probably it is invisible. Let's try to make expand its
2950
;; containing type (if there is any) and then highlighting
2951
;; again.
2952
(when (and highlight-tag
2953
type-tag
2954
(or (equal ecb-auto-expand-tag-tree 'all)
2955
(member (ecb--semantic-tag-class highlight-tag)
2956
(ecb-normalize-expand-spec
2957
ecb-methods-nodes-expand-spec))))
2958
(setq type-node
2959
(cdr (tree-buffer-find-name-node-data type-tag)))
2960
(when type-node
2961
(ecb-expand-methods-node-internal
2962
type-node
2963
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: Maybe we
2964
;; should not immediately fully expand the type but
2965
;; in two steps:
2966
;; 1. We expand only the first level of the type and
2967
;; check if the tag is contained in a flattended
2968
;; bucket. If yes we will have success and are
2969
;; finished because the tag must be contained in
2970
;; the type-tag. If no we go to step 2.
2971
;; 2. because the tag MUST be contained in that
2972
;; type-node we now know that it must be contained
2973
;; in a collapsed bucket-subnode of this
2974
;; type-node. So we have to expand this
2975
;; bucket-subnode (similar to the mechanism above)
2976
;; and then try again...
2977
100
2978
(equal ecb-auto-expand-tag-tree 'all)
2979
nil t)
2980
(tree-buffer-highlight-node-data
2981
highlight-tag nil
2982
(equal ecb-highlight-tag-with-point 'highlight))
2983
))))))
2984
(if curr-tag
2985
(ecb-try-highlight-tag highlight-tag type-tag table)))))
2986
2987
(defvar ecb-tag-sync-do-nothing nil
2988
"Only set by `ecb-jump-to-tag' and only evaluated by `ecb-tag-sync'")
2989
2990
;; This approach only expands the needed parts of the tree-buffer when
2991
;; the current-tag is not visible as node and not the whole tree-buffer.
1853
2992
(defun ecb-tag-sync (&optional force)
1854
2993
(when (and ecb-minor-mode
1855
2994
;; we do not use here `ecb-point-in-ecb-window' because this
1856
2995
;; would slow down Emacs dramatically when tag-synchronization is
1857
2996
;; done via post-command-hook and not via an idle-timer.
1858
(not (ecb-point-in-tree-buffer))
2997
(not (ecb-point-in-dedicated-special-buffer))
1859
2998
(not (ecb-point-in-compile-window)))
1860
(when ecb-highlight-tag-with-point
1861
(let* ((tagstack (reverse (ecb--semantic-find-tag-by-overlay)))
1862
(curr-tag (car tagstack))
1863
(next-tag (car (cdr tagstack)))
1864
)
1865
(if (and (equal (ecb--semantic-tag-class curr-tag) 'variable)
1866
(equal (ecb--semantic-tag-class next-tag) 'function)
1867
(member curr-tag (ecb--semantic-tag-function-arguments next-tag)))
1868
(setq curr-tag next-tag))
1869
(when (or force (not (equal ecb-selected-tag curr-tag)))
1870
(setq ecb-selected-tag curr-tag)
1871
(save-selected-window
1872
(ecb-exec-in-methods-window
1873
(or (tree-buffer-highlight-node-data
1874
curr-tag nil (equal ecb-highlight-tag-with-point 'highlight))
1875
;; The node representing CURR-TAG could not be highlighted be
1876
;; `tree-buffer-highlight-node-data' - probably it is
1877
;; invisible. Let's try to make visible and then highlighting
1878
;; again.
1879
(when (and curr-tag ecb-auto-expand-tag-tree
1880
(or (equal ecb-auto-expand-tag-tree 'all)
1881
(member (ecb--semantic-tag-class curr-tag)
1882
(ecb-normalize-expand-spec
1883
ecb-methods-nodes-expand-spec))))
1884
(ecb-expand-methods-nodes-internal
1885
100
1886
(equal ecb-auto-expand-tag-tree 'all))
1887
(tree-buffer-highlight-node-data
1888
curr-tag nil (equal ecb-highlight-tag-with-point 'highlight))
1889
)))))))))
2999
(if nil ;; ecb-tag-sync-do-nothing
3000
;; user has selected a tag via the Methods-window so there is nothing
3001
;; to sync - we must prevent from syncing here because in some modes
3002
;; the point stays after a click outside of the selected tag (see
3003
;; `ecb-tag-visit-post-actions') and if we would sync then in the
3004
;; methods-buffer the selected tag will be unhighlighted and the
3005
;; surrounding one will be highlighted (e.g. java the class of the
3006
;; tag). But we must reset this flag so the resync-mechanism runs
3007
;; next time...
3008
;; Klaus Berndl <klaus.berndl@sdm.de>: Now all functions of
3009
;; ecb-tag-visit-post-actions are forbidden to put the point outside
3010
;; of the tag-boundaries. Therefore we can now remove this mechanism
3011
;; so now synching can take place also after a click. But i let the
3012
;; code in because im not at 100% sure if there are other needs in ECB
3013
;; which need this mechanism - but for now we can disable it.... ;-)
3014
(setq ecb-tag-sync-do-nothing nil)
3015
(when ecb-highlight-tag-with-point
3016
(let ((curr-tag (ecb-get-real-curr-tag)))
3017
(when (or force (not (equal ecb-selected-tag curr-tag)))
3018
(setq ecb-selected-tag curr-tag)
3019
(if (null curr-tag)
3020
(save-selected-window
3021
(ecb-exec-in-methods-window
3022
;; If there is no tag to highlight then we remove the
3023
;; highlighting
3024
(tree-buffer-highlight-node-data nil)
3025
(if (equal ecb-auto-expand-tag-tree-collapse-other 'always)
3026
;; If this option is t (means always) we collapse also
3027
;; when point is not on a tag!
3028
(ecb-expand-methods-node-internal
3029
(tree-buffer-get-root)
3030
-1
3031
(equal ecb-auto-expand-tag-tree 'all)
3032
nil t))))
3033
;; Maybe we must first collapse all so only the needed parts are
3034
;; expanded afterwards. Klaus Berndl <klaus.berndl@sdm.de>: Is it
3035
;; necessary to update the tree-buffer after collapsing? IMO yes,
3036
;; because otherwise we set the expansion-state of the tree-buffer
3037
;; to all collapsed and if we find really nothing to highlight and
3038
;; do also no node-expanding (which would update the tree-buffer)
3039
;; then we have an inconsistent state - would be probably very
3040
;; seldom but could be - so let us be somehow paranoid ;-)
3041
(if ecb-auto-expand-tag-tree-collapse-other
3042
(save-selected-window
3043
(ecb-exec-in-methods-window
3044
(when (and curr-tag
3045
(or (equal ecb-auto-expand-tag-tree 'all)
3046
(member (ecb--semantic-tag-class curr-tag)
3047
(ecb-normalize-expand-spec
3048
ecb-methods-nodes-expand-spec))))
3049
(ecb-expand-methods-node-internal
3050
(tree-buffer-get-root)
3051
-1
3052
(equal ecb-auto-expand-tag-tree 'all)
3053
nil t)))))
3054
;; First we try to expand only the absolute needed parts - this
3055
;; means we go upstairs the ladder of types the current tag
3056
;; belongs to. If there is no containing type then we try to
3057
;; expand only the containing toplevel bucket. If this has no
3058
;; success then we expand the full tree-buffer and try it again.
3059
(if (not (ecb-try-highlight-tag curr-tag curr-tag
3060
(ecb-get-current-tag-table)))
3061
;; The node representing CURR-TAG could not be highlighted by
3062
;; `tree-buffer-highlight-node-data' - probably it is still
3063
;; invisible. Let's try to make visible all nodes and then
3064
;; highlighting again.
3065
(save-selected-window
3066
(ecb-exec-in-methods-window
3067
(when (and curr-tag
3068
(or (equal ecb-auto-expand-tag-tree 'all)
3069
(member (ecb--semantic-tag-class curr-tag)
3070
(ecb-normalize-expand-spec
3071
ecb-methods-nodes-expand-spec))))
3072
(ecb-expand-methods-node-internal
3073
(tree-buffer-get-root)
3074
100 ;; this should be enough levels ;-)
3075
(equal ecb-auto-expand-tag-tree 'all)
3076
nil t)
3077
(tree-buffer-highlight-node-data
3078
curr-tag nil (equal ecb-highlight-tag-with-point 'highlight)))
3079
))))))))))
3080
1890
3081
1891
3082
(defun ecb-find-file-and-display (filename other-edit-window)
1892
3083
"Finds the file in the correct window. What the correct window is depends on
1905
3096
string))
1906
3097
1907
3098
1908
(defun ecb-methods-node-get-semantic-type (node symbol->name-assoc-list)
3099
(defun ecb-methods-node-get-semantic-type (node)
1909
3100
(cond ((= 1 (tree-node-get-type node))
1910
(let ((bucket-name
1911
(save-match-data
1912
(if (string-match (concat (regexp-quote (nth 0 ecb-bucket-node-display))
1913
"\\(.+\\)"
1914
(regexp-quote (nth 1 ecb-bucket-node-display)))
1915
(tree-node-get-name node))
1916
(match-string 1 (tree-node-get-name node))))))
1917
(if (stringp bucket-name)
1918
(or (car (delete nil (mapcar (function (lambda (elem)
1919
(if (string= (cdr elem)
1920
bucket-name)
1921
(car elem))))
1922
symbol->name-assoc-list)))
1923
;; This is a little hack for bucket-names not defined in
1924
;; symbol->name-assoc-list: First we strip a trailing 's'
1925
;; if there is any to be consistent with the singular names
1926
;; of the cars of symbol->name-assoc-list. Then we downcase
1927
;; the bucket-name and convert it to a symbol. This is done
1928
;; for example for the ECB created bucket-name "Parents"!
1929
(intern (downcase (ecb-string-make-singular bucket-name)))))))
3101
(nth 2 (tree-node-get-data node)))
1930
3102
((= 0 (tree-node-get-type node))
1931
3103
(ignore-errors (ecb--semantic-tag-class (tree-node-get-data node))))
1932
3104
(t nil)))
1933
3105
1934
1935
3106
(defun ecb-expand-methods-nodes (&optional force-all)
1936
3107
"Set the expand level of the nodes in the ECB-methods-buffer.
1937
3108
This command asks in the minibuffer for an indentation level LEVEL. With this
1981
3152
;; expanded to max level...
1982
3153
(when ecb-expand-methods-switch-off-auto-expand
1983
3154
(ecb-toggle-auto-expand-tag-tree -1))
1984
(ecb-expand-methods-nodes-internal level force-all t)))
1985
1986
1987
(defun ecb-expand-methods-nodes-internal (level &optional force-all resync-tag)
1988
"Set the expand level of the nodes in the ECB-methods-buffer.
3155
(ecb-expand-methods-node-internal (save-excursion
3156
(set-buffer ecb-methods-buffer-name)
3157
(tree-buffer-get-root))
3158
level force-all t t)))
3159
3160
(defun ecb-expand-methods-node-internal (node level
3161
&optional force-all
3162
resync-tag update-tree-buffer)
3163
"Set the expand level of NODE and its subnodes in the ECB-methods-buffer.
3164
3165
If NODE is equal to the root-node of the methods-tree-buffer then this
3166
function will be called for each of the root-children. Otherwise it will only
3167
expand/collaps NODE.
1989
3168
1990
3169
For description of LEVEL and FORCE-ALL see `ecb-expand-methods-nodes'.
1991
3170
1992
3171
If RESYNC-TAG is not nil then after expanding/collapsing the methods-buffer
1993
3172
is resynced to the current tag of the edit-window.
1994
3173
3174
If UPDATE-TREE-BUFFER is not nil then the methods-tree-buffer will be updated
3175
after the expansion.
3176
1995
3177
Note: All this is only valid for file-types parsed by semantic. For other file
1996
3178
types which are parsed by imenu or etags \(see
1997
3179
`ecb-process-non-semantic-files') FORCE-ALL is always true!"
1998
(let ((symbol->name-assoc-list
1999
;; if possible we get the local semantic-symbol->name-assoc-list of
2000
;; the source-buffer.
2001
(or (save-excursion
2002
(ignore-errors
2003
(set-buffer (get-file-buffer ecb-path-selected-source))
2004
;; for non-semantic buffers we set force-all always to t
2005
(setq force-all (not (ecb--semantic-active-p)))
2006
(ecb--semantic-symbol->name-assoc-list)))
2007
(ecb--semantic-symbol->name-assoc-list))))
2008
(save-selected-window
2009
(ecb-exec-in-methods-window
2010
(let ( ;; normalizing the elements of `ecb-methods-nodes-expand-spec'
2011
;; and `ecb-methods-nodes-collapse-spec'.
2012
(norm-expand-types (ecb-normalize-expand-spec
2013
ecb-methods-nodes-expand-spec))
2014
(norm-collapse-types (ecb-normalize-expand-spec
2015
ecb-methods-nodes-collapse-spec)))
2016
(tree-buffer-expand-nodes
3180
(save-selected-window
3181
;; for buffers which are not parsed by semantic we always set force-all to
3182
;; t! We "misuse" (ecb-methods-get-data-store
3183
;; 'semantic-symbol->name-assoc-list) to decide if a buffer is parsed by
3184
;; semantic or not because only semantic-parsed buffers can have a value
3185
;; not nil!
3186
(setq force-all
3187
(if (not (ecb-methods-get-data-store 'semantic-symbol->name-assoc-list))
3188
t
3189
force-all))
3190
(ecb-exec-in-methods-window
3191
(let ( ;; normalizing the elements of `ecb-methods-nodes-expand-spec'
3192
;; and `ecb-methods-nodes-collapse-spec'.
3193
(norm-expand-types (ecb-normalize-expand-spec
3194
ecb-methods-nodes-expand-spec))
3195
(norm-collapse-types (ecb-normalize-expand-spec
3196
ecb-methods-nodes-collapse-spec))
3197
(node-list (if (equal node (tree-buffer-get-root))
3198
(tree-node-get-children (tree-buffer-get-root))
3199
(list node))))
3200
(dolist (node node-list)
3201
(tree-buffer-expand-node
3202
node
2017
3203
level
2018
3204
(and (not force-all)
2019
3205
(function (lambda (node current-level)
2020
3206
(or (equal norm-expand-types 'all)
2021
(member (ecb-methods-node-get-semantic-type
2022
node symbol->name-assoc-list)
3207
(member (ecb-methods-node-get-semantic-type node)
2023
3208
norm-expand-types)))))
2024
3209
(and (not force-all)
2025
3210
(function (lambda (node current-level)
2026
3211
(or (equal norm-collapse-types 'all)
2027
(member (ecb-methods-node-get-semantic-type
2028
node symbol->name-assoc-list)
2029
norm-collapse-types))))))
2030
(tree-buffer-scroll (point-min) (point-min)))))
2031
2032
;; we want resync the new method-buffer to the current tag in the
2033
;; edit-window.
2034
(if resync-tag (ecb-tag-sync 'force))))
3212
(member (ecb-methods-node-get-semantic-type node)
3213
norm-collapse-types)))))))
3214
(if update-tree-buffer
3215
(tree-buffer-update)
3216
(tree-buffer-scroll (point-min) (point-min))))))
3217
3218
;; we want resync the new method-buffer to the current tag in the
3219
;; edit-window.
3220
(if resync-tag (ecb-tag-sync 'force)))
3221
2035
3222
2036
3223
2037
3224
(defun ecb-normalize-expand-spec (spec)
2092
3279
;; package/library.
2093
3280
(delq nil
2094
3281
(mapcar (function (lambda (n)
2095
(let ((r (ecb--semanticdb-find-result-nth
3282
(let ((r (ecb--semanticdb-find-result-nth-with-file
2096
3283
search-result n)))
2097
3284
(if (and (cdr r)
2098
3285
(stringp (cdr r))
2116
3303
type-definition-alist)
2117
3304
(car type-definition-alist)))))
2118
3305
2119
(defun ecb-method-clicked (node ecb-button edit-window-nr shift-mode
2120
&optional no-post-action additional-post-action-list)
3306
(defun ecb-method-clicked (node ecb-button edit-window-nr shift-mode meta-mode
3307
&optional no-post-action
3308
additional-post-action-list)
2121
3309
"Handle clicking onto NODE in the methods-buffer. ECB-BUTTON can be 1, 2 or
2122
3310
3. If 3 then EDIT-WINDOW-NR contains the number of the edit-window the NODE
2123
3311
should be displayed. For 1 and 2 the value of EDIT-WINDOW-NR is ignored."
2148
3336
(tree-node-toggle-expanded node)
2149
3337
;; Update the tree-buffer with optimized display of NODE
2150
3338
(tree-buffer-update node))
3339
2151
3340
;; Type 2 = a tag name for a tag not defined in current buffer; e.g.
2152
3341
;; parent or include tags can be such tags!
2153
3342
;; Try to find the tag
2182
3371
additional-post-action-list)))
2183
3372
(cons 'ecb-tag-visit-narrow-tag
2184
3373
additional-post-action-list)
2185
additional-post-action-list))))))
3374
additional-post-action-list)))
3375
;; TODO: Klaus Berndl <klaus.berndl@sdm.de>: I really have no clue why
3376
;; calling here directly ecb-hide-ecb-windows fails and why even going
3377
;; the way via post-command-hooks fails too...running with an idle-times
3378
;; seems to work so for the moment we can do this.......
3379
(if (and meta-mode
3380
t) ;;(ecb-buffer-is-the-only-visible-ecb-buffer-p ecb-methods-buffer-name))
3381
(ecb-run-with-idle-timer 0.001 nil 'ecb-hide-ecb-windows)))))
3382
;; (ecb-hide-ecb-windows)))))
2186
3383
2187
3384
2188
3385
(defun ecb-tag-visit-smart-tag-start (tag)
2229
3426
(ecb--semantic-lex-token-start comment))))
2230
3427
2231
3428
2232
(defun ecb-tag-visit-goto-doc-start (tag)
2233
"Go to the beginning of the documentation of TAG if defined outside.
3429
(defun ecb-tag-visit-display-doc-start (tag)
3430
"Display the beginning of the documentation of TAG if defined outside.
3431
This means move the window-start of current edit-window so the whole
3432
documentation is visible. But points still stays onto the tag-start!
2234
3433
This is useful especially for languages like Java where the documentation
2235
3434
resides direct before the TAG in Javadoc format.
2236
3435
If the documentation is located within TAG then nothing is done.
2237
3436
2238
3437
If this function is set in `ecb-tag-visit-post-actions' then it's strongly
2239
recommended to add `ecb-tag-visit-recenter' or
2240
`ecb-tag-visit-recenter-top' at the end too!
3438
recommended not to add `ecb-tag-visit-recenter' or
3439
`ecb-tag-visit-recenter-top' after this this function!
2241
3440
2242
3441
This action is not recommended for sources of type TeX, texinfo etc. So you
2243
3442
should not add this action to the 'default element of
2245
3444
2246
3445
Returns current point."
2247
3446
(let ((tag-doc-start (ecb-start-of-tag-doc tag)))
2248
(when tag-doc-start
2249
(goto-char tag-doc-start))
3447
(when (and tag-doc-start
3448
(not (pos-visible-in-window-p tag-doc-start)))
3449
;; tag-doc-start must be above the current window-start so we must must
3450
;; reset the window-start
3451
(set-window-start (selected-window) tag-doc-start))
3452
;; (goto-char tag-doc-start))
2250
3453
(point)))
2251
3454
3455
;; for backward-compatibility
3456
(defalias 'ecb-tag-visit-goto-doc-start 'ecb-tag-visit-display-doc-start)
2252
3457
2253
3458
(defvar ecb-unhighlight-hook-called nil
2254
3459
"This mechanism is necessary because tree-buffer creates for mouse releasing a
2305
3510
;; let us set the mark so the user can easily jump back.
2306
3511
(if ecb-tag-jump-sets-mark
2307
3512
(push-mark nil t))
2308
(ecb-with-original-basic-functions
2309
(widen))
3513
(widen)
2310
3514
(goto-char (ecb-semantic-tag-start tag))
3515
;; the following 2 lines prevent the autom. tag-sync-mechanism from
3516
;; starting.
3517
(setq ecb-tag-sync-do-nothing t)
3518
;; Klaus Berndl <klaus.berndl@sdm.de>: See the comment in
3519
;; `ecb-tag-sync' for an explanation why this is now commented out.
3520
;; (setq ecb-selected-tag tag)
2311
3521
;; process post action
2312
3522
(unless no-tag-visit-post-actions
2313
3523
;; first the default post actions
2314
3524
(dolist (f (cdr (assoc 'default ecb-tag-visit-post-actions)))
2315
(funcall f tag))
3525
(ecb-call-tag-visit-function tag f))
2316
3526
;; now the mode specific actions
2317
3527
(dolist (f (cdr (assoc major-mode ecb-tag-visit-post-actions)))
2318
(funcall f tag)))
3528
(ecb-call-tag-visit-function tag f)))
2319
3529
;; now we perform the additional-post-action-list
2320
3530
(dolist (f additional-post-action-list)
2321
(funcall f tag))
3531
(ecb-call-tag-visit-function tag f))
2322
3532
;; Klaus Berndl <klaus.berndl@sdm.de>: Now we use a different
2323
3533
;; implementation of ecb-nav-tag-history-item. Not longer storing
2324
3534
;; the whole tag but the tag-buffer and markers of tag-start
2336
3546
tag-buf
2337
3547
tag-start
2338
3548
tag-end
2339
ecb-buffer-narrowed-by-ecb))))))
3549
(member 'ecb-tag-visit-narrow-tag
3550
additional-post-action-list)))))))
2340
3551
2341
3552
2342
3553
(defun ecb-mouse-over-method-node (node &optional window no-message click-force)
2350
3561
ecb-methods-buffer-name))
2351
3562
(concat
2352
3563
(tree-node-get-name node)
2353
(if (and (= 0 (tree-node-get-type node)) (tree-node-get-data
2354
node)
3564
(if (and (= 0 (tree-node-get-type node)) (tree-node-get-data node)
2355
3565
(equal (ecb-show-node-info-what ecb-methods-buffer-name)
2356
3566
'name+type))
2357
3567
(concat ", "
2358
(symbol-name (ecb--semantic-tag-class (tree-node-get-data node))))
3568
(symbol-name (ecb--semantic-tag-class
3569
(tree-node-get-data node))))
2359
3570
"")))))
2360
3571
(prog1 str
2361
3572
(unless no-message
2363
3574
2364
3575
;;; popup-menu stuff for the methods-buffer
2365
3576
2366
(defvar ecb-buffer-narrowed-by-ecb nil
2367
"If not nil then current buffer is narrowed to a tag by ECB. Otherwise
2368
the buffer is not narrowed or it is narrowed by ECB but one of the
2369
interactive commands `narrow-to-*' or function/commands which use in turn one
2370
of these `narrow-to-*'-functions.")
2371
(make-variable-buffer-local 'ecb-buffer-narrowed-by-ecb)
2372
2373
(defadvice narrow-to-region (before ecb)
2374
"Set an internal ECB-state. This does not influence the behavior."
2375
(setq ecb-buffer-narrowed-by-ecb nil))
2376
2377
(defadvice narrow-to-defun (before ecb)
2378
"Set an internal ECB-state. This does not influence the behavior."
2379
(setq ecb-buffer-narrowed-by-ecb nil))
2380
2381
(defadvice narrow-to-page (before ecb)
2382
"Set an internal ECB-state. This does not influence the behavior."
2383
(setq ecb-buffer-narrowed-by-ecb nil))
2384
2385
(defadvice widen (before ecb)
2386
"Set an internal ECB-state. This does not influence the behavior."
2387
(setq ecb-buffer-narrowed-by-ecb nil))
3577
(defun ecb-call-tag-visit-function (tag fcn)
3578
"Call FCN with TAG as argument and check if the resulting point is between
3579
the tag-boundaries of TAG. If yes, then go to this point if no point stays at
3580
the location before calling FCN."
3581
(when (fboundp fcn)
3582
(let* ((start (ecb--semantic-tag-start tag))
3583
(end (ecb--semantic-tag-end tag))
3584
(result-point (save-excursion
3585
(funcall fcn tag))))
3586
(if (and (>= result-point start)
3587
(<= result-point end))
3588
(goto-char result-point)
3589
(ecb-warning "The tag-visit-function `%s' moves point outside of tag - ignored!"
3590
fcn)))))
2388
3591
2389
3592
(defun ecb-tag-visit-narrow-tag (tag)
2390
3593
"Narrow the source buffer to TAG.
2396
3599
(when (not (ecb-speedbar-sb-tag-p tag))
2397
3600
(narrow-to-region (or (ecb-start-of-tag-doc tag)
2398
3601
(ecb-semantic-tag-start tag))
2399
(ecb-semantic-tag-end tag))
2400
;; This is the only location where this variable is set to not nil!
2401
;; before every call to `narrow-to-*' or `widen' this variable is reset to
2402
;; nil!
2403
(setq ecb-buffer-narrowed-by-ecb t))
3602
(ecb-semantic-tag-end tag)))
2404
3603
(point))
2405
3604
2406
3605
2417
3616
(ecb-line-beginning-pos (- (/ (ecb-window-full-height) 2))))
2418
3617
(point))
2419
3618
2420
2421
3619
(defun ecb-tag-visit-recenter-top (tag)
2422
3620
"Recenter the source-buffer, so current line is in the middle of the window.
2423
3621
If this function is added to `ecb-tag-visit-post-actions' then it's
2426
3624
2427
3625
Returns current point."
2428
3626
(set-window-start (selected-window)
2429
(ecb-line-beginning-pos)))
3627
(ecb-line-beginning-pos))
3628
(point))
2430
3629
2431
3630
(tree-buffer-defpopup-command ecb-methods-menu-jump-and-narrow
2432
3631
"Jump to the token related to the node under point an narrow to this token."
2433
(ecb-method-clicked node 1 nil nil t '(ecb-tag-visit-narrow-tag
2434
ecb-tag-visit-highlight-tag-header)))
3632
(ecb-method-clicked node 1 nil nil nil t '(ecb-tag-visit-narrow-tag
3633
ecb-tag-visit-highlight-tag-header)))
2435
3634
2436
3635
2437
3636
(tree-buffer-defpopup-command ecb-methods-menu-widen
2438
3637
"Widen the current buffer in the current edit-window."
2439
3638
(ecb-select-edit-window)
2440
(widen)
2441
(setq ecb-buffer-narrowed-by-ecb nil))
3639
(widen))
2442
3640
2443
3641
2444
3642
(if (not ecb-running-xemacs)
2467
3665
(if (not (ecb-methods-menu-activate-hs))
2468
3666
(ecb-error "hs-minor-mode can not be activated!")
2469
3667
;; point must be at beginning of tag-name
2470
(ecb-method-clicked node 1 nil nil t '(ecb-tag-visit-smart-tag-start))
3668
(ecb-method-clicked node 1 nil nil nil t '(ecb-tag-visit-smart-tag-start))
2471
3669
(save-excursion
2472
3670
(or (looking-at hs-block-start-regexp)
2473
3671
(re-search-forward hs-block-start-regexp nil t))
2482
3680
(if (not (ecb-methods-menu-activate-hs))
2483
3681
(ecb-error "hs-minor-mode can not be activated!")
2484
3682
;; point must be at beginning of tag-name
2485
(ecb-method-clicked node 1 nil nil t '(ecb-tag-visit-smart-tag-start))
3683
(ecb-method-clicked node 1 nil nil nil t '(ecb-tag-visit-smart-tag-start))
2486
3684
(save-excursion
2487
3685
(or (looking-at hs-block-start-regexp)
2488
3686
(re-search-forward hs-block-start-regexp nil t))
2492
3690
2493
3691
(tree-buffer-defpopup-command ecb-methods-menu-collapse-all
2494
3692
"Collapse all expandable and expanded nodes"
2495
(ecb-expand-methods-nodes-internal -1 nil t))
3693
(ecb-expand-methods-node-internal (tree-buffer-get-root) -1 nil t t))
2496
3694
2497
3695
2498
3696
(tree-buffer-defpopup-command ecb-methods-menu-expand-0
2499
3697
"Expand all nodes with level 0."
2500
(ecb-expand-methods-nodes-internal 0 nil t))
3698
(ecb-expand-methods-node-internal (tree-buffer-get-root) 0 nil t t))
2501
3699
2502
3700
2503
3701
(tree-buffer-defpopup-command ecb-methods-menu-expand-1
2504
3702
"Expand all nodes with level 1."
2505
(ecb-expand-methods-nodes-internal 1 nil t))
3703
(ecb-expand-methods-node-internal (tree-buffer-get-root) 1 nil t t))
2506
3704
2507
3705
2508
3706
(tree-buffer-defpopup-command ecb-methods-menu-expand-2
2509
3707
"Expand all nodes with level 2."
2510
(ecb-expand-methods-nodes-internal 2 nil t))
3708
(ecb-expand-methods-node-internal (tree-buffer-get-root) 2 nil t t))
2511
3709
2512
3710
2513
3711
(tree-buffer-defpopup-command ecb-methods-menu-expand-all
2514
3712
"Expand all expandable nodes recursively."
2515
(ecb-expand-methods-nodes-internal 100 nil t))
3713
(ecb-expand-methods-node-internal (tree-buffer-get-root) 100 nil t t))
2516
3714
2517
3715
2518
3716
(defvar ecb-common-methods-menu nil
2545
3743
(defvar ecb-methods-menu-title-creator
2546
3744
(function (lambda (node)
2547
3745
(let ((data (tree-node-get-data node)))
2548
(if data
3746
(if (and data (/= 1 (tree-node-get-type node)))
2549
3747
(cond ((ecb--semantic-tag-p data)
2550
3748
(ecb--semantic-tag-name data))
2551
3749
((stringp data)
2555
3753
"The menu-title for the methods menu. See
2556
3754
`ecb-directories-menu-title-creator'.")
2557
3755
2558
(tree-buffer-defpopup-command ecb-jump-to-token-in-editwin1
2559
"Jump to current token in the 1. edit-window."
2560
(ecb-method-clicked node 3 1 nil))
2561
(tree-buffer-defpopup-command ecb-jump-to-token-in-editwin2
2562
"Jump to current token in the 2. edit-window."
2563
(ecb-method-clicked node 3 2 nil))
2564
(tree-buffer-defpopup-command ecb-jump-to-token-in-editwin3
2565
"Jump to current token in the 3. edit-window."
2566
(ecb-method-clicked node 3 3 nil))
2567
(tree-buffer-defpopup-command ecb-jump-to-token-in-editwin4
2568
"Jump to current token in the 4. edit-window."
2569
(ecb-method-clicked node 3 4 nil))
2570
(tree-buffer-defpopup-command ecb-jump-to-token-in-editwin5
2571
"Jump to current token in the 5. edit-window."
2572
(ecb-method-clicked node 3 5 nil))
2573
(tree-buffer-defpopup-command ecb-jump-to-token-in-editwin6
2574
"Jump to current token in the 6. edit-window."
2575
(ecb-method-clicked node 3 6 nil))
2576
(tree-buffer-defpopup-command ecb-jump-to-token-in-editwin7
2577
"Jump to current token in the 7. edit-window."
2578
(ecb-method-clicked node 3 7 nil))
2579
(tree-buffer-defpopup-command ecb-jump-to-token-in-editwin8
2580
"Jump to current token in the 8. edit-window."
2581
(ecb-method-clicked node 3 8 nil))
3756
(dotimes (i 8)
3757
(eval `(tree-buffer-defpopup-command
3758
,(intern (format "ecb-jump-to-tag-in-editwin%d" (1+ i)))
3759
,(format "Jump to current tag in the %d. edit-window." (1+ i))
3760
(ecb-method-clicked node 3 ,(1+ i) nil nil))))
2582
3761
2583
3762
(defun ecb-methods-menu-editwin-entries ()
2584
3763
"Generate popup-menu-entries for each edit-window if there are at least 2
2589
3768
(dotimes (i (min 8 (length edit-win-list)))
2590
3769
(setq result
2591
3770
(append result
2592
(list (list (intern (format "ecb-jump-to-token-in-editwin%d" (1+ i)))
3771
(list (list (intern (format "ecb-jump-to-tag-in-editwin%d" (1+ i)))
2593
3772
(format "edit-window %d" (1+ i)))))))
2594
3773
(append (list (list "---")) ;; we want a separator
2595
(list (append (list "Jump to token in ...")
3774
(list (append (list "Jump to tag in ...")
2596
3775
result))))))
2597
3776
3777
3778
(defun ecb-methods-menu-tagfilter-entries ()
3779
"Generate popup-menu-entries for the tag-filtering"
3780
(let* ((curr-semantic-symbol->name-assoc-list
3781
;; we must not use here (ecb-methods-get-data-store
3782
;; 'semantic-symbol->name-assoc-list) because we do not want the
3783
;; function-prototypes...
3784
(save-excursion
3785
(set-buffer (ecb-methods-get-data-store 'source-buffer))
3786
(ecb--semantic-symbol->name-assoc-list)))
3787
(prot-list '("private" "protected" "public"))
3788
(prot-menu-elems nil)
3789
(prot-menu-elems-inverse nil)
3790
(prot-menu-entries nil)
3791
(prot-menu-entries-inverse)
3792
(tag-menu-class-elems nil)
3793
(tag-menu-class-elems-inverse nil)
3794
(tag-menu-class-entries nil)
3795
(tag-menu-class-entries-inverse nil))
3796
;; First we have to define all the needed tree-buffer-commands for
3797
;; protection- and tagclass-filtering. But this is only done for
3798
;; semantic-sources and also the first time.
3799
(when curr-semantic-symbol->name-assoc-list
3800
(dolist (tag-class curr-semantic-symbol->name-assoc-list)
3801
(let ((fcn-sym (intern (format "ecb-methods-filter-by-%s-tagclass"
3802
(car tag-class)))))
3803
(setq tag-menu-class-elems (cons (cons fcn-sym (cdr tag-class))
3804
tag-menu-class-elems))
3805
(when (not (fboundp fcn-sym))
3806
(eval `(tree-buffer-defpopup-command ,fcn-sym
3807
,(format "Filter all tags with tag-class '%s." (car tag-class))
3808
(ecb-methods-filter-by-tag-class nil
3809
(ecb-methods-get-data-store 'source-buffer)
3810
,(symbol-name (car tag-class))))))))
3811
(dolist (tag-class curr-semantic-symbol->name-assoc-list)
3812
(let ((fcn-sym (intern (format "ecb-methods-filter-by-%s-tagclass-inverse"
3813
(car tag-class)))))
3814
(setq tag-menu-class-elems-inverse
3815
(cons (cons fcn-sym (concat "not " (cdr tag-class)))
3816
tag-menu-class-elems-inverse))
3817
(when (not (fboundp fcn-sym))
3818
(eval `(tree-buffer-defpopup-command ,fcn-sym
3819
,(format "Filter all tags with tag-class unequal '%s."
3820
(car tag-class))
3821
(ecb-methods-filter-by-tag-class t
3822
(ecb-methods-get-data-store 'source-buffer)
3823
,(symbol-name (car tag-class))))))))
3824
(dolist (prot prot-list)
3825
(let ((fcn-sym (intern (format "ecb-methods-filter-by-%s-prot" prot))))
3826
(setq prot-menu-elems (cons (cons fcn-sym prot)
3827
prot-menu-elems))
3828
(when (not (fboundp fcn-sym))
3829
(eval `(tree-buffer-defpopup-command ,fcn-sym
3830
,(format "Filter all tags with %s protection." prot)
3831
(ecb-methods-filter-by-prot nil
3832
(ecb-methods-get-data-store 'source-buffer)
3833
,prot))))))
3834
(dolist (prot prot-list)
3835
(let ((fcn-sym (intern (format "ecb-methods-filter-by-%s-prot-inverse" prot))))
3836
(setq prot-menu-elems-inverse
3837
(cons (cons fcn-sym (concat "not " prot))
3838
prot-menu-elems-inverse))
3839
(when (not (fboundp fcn-sym))
3840
(eval `(tree-buffer-defpopup-command ,fcn-sym
3841
,(format "Filter all tags with not %s protection." prot)
3842
(ecb-methods-filter-by-prot t
3843
(ecb-methods-get-data-store 'source-buffer)
3844
,prot)))))))
3845
;; building the menu-entries-list for tag-classes and protections.
3846
(dolist (elem tag-menu-class-elems)
3847
(setq tag-menu-class-entries
3848
(append tag-menu-class-entries
3849
(list (list (car elem) (cdr elem))))))
3850
(dolist (elem tag-menu-class-elems-inverse)
3851
(setq tag-menu-class-entries-inverse
3852
(append tag-menu-class-entries-inverse
3853
(list (list (car elem) (cdr elem))))))
3854
(dolist (elem prot-menu-elems)
3855
(setq prot-menu-entries
3856
(append prot-menu-entries
3857
(list (list (car elem) (cdr elem))))))
3858
(dolist (elem prot-menu-elems-inverse)
3859
(setq prot-menu-entries-inverse
3860
(append prot-menu-entries-inverse
3861
(list (list (car elem) (cdr elem))))))
3862
;; building the complete filter-menu
3863
(append nil ;; (list (list "---")) ;; we want a separator
3864
(list (append (list "Filter tags")
3865
(list '(ecb-methods-filter-by-nothing-popup
3866
"No tag filter")
3867
'(ecb-methods-filter-delete-last-popup
3868
"Remove last added")
3869
'("---")
3870
'(ecb-methods-filter-by-regexp-popup
3871
"By regexp"))
3872
(when prot-menu-entries
3873
(list (append (list "By protection")
3874
prot-menu-entries)))
3875
(when tag-menu-class-entries
3876
(list (append (list "By tag-class")
3877
tag-menu-class-entries)))
3878
(when curr-semantic-symbol->name-assoc-list
3879
(list '(ecb-methods-filter-by-current-type-popup
3880
"By current type")))
3881
(list '(ecb-methods-filter-by-function-popup
3882
"By a filter-function")
3883
'("---")
3884
'(ecb-methods-filter-by-regexp-popup-inverse
3885
"By inverse regexp"))
3886
(when prot-menu-entries-inverse
3887
(list (append (list "By inverse protection")
3888
prot-menu-entries-inverse)))
3889
(when tag-menu-class-entries-inverse
3890
(list (append (list "By inverse tag-class")
3891
tag-menu-class-entries-inverse)))
3892
(list '(ecb-methods-filter-by-function-popup-inverse
3893
"By a inverse filter-function")))))))
3894
2598
3895
(defun ecb-methods-menu-creator (tree-buffer-name)
2599
3896
"Creates the popup-menus for the methods-buffer."
2600
3897
(setq ecb-layout-prevent-handle-ecb-window-selection t)
2601
3898
(let ((dyn-user-extension
2602
3899
(and (functionp ecb-methods-menu-user-extension-function)
2603
3900
(funcall ecb-methods-menu-user-extension-function)))
2604
(dyn-builtin-extension (ecb-methods-menu-editwin-entries)))
3901
(dyn-builtin-extension-edit-win (ecb-methods-menu-editwin-entries))
3902
(dyn-builtin-extension-tagfilter (ecb-methods-menu-tagfilter-entries)))
2605
3903
(list (cons 0 (funcall (or ecb-methods-menu-sorter
2606
3904
'identity)
2607
3905
(append dyn-user-extension
2608
3906
ecb-methods-menu-user-extension
3907
dyn-builtin-extension-tagfilter
2609
3908
ecb-methods-tag-menu
2610
dyn-builtin-extension)))
3909
dyn-builtin-extension-edit-win)))
2611
3910
(cons 1 (funcall (or ecb-methods-menu-sorter
2612
3911
'identity)
2613
3912
(append dyn-user-extension
2614
3913
ecb-methods-menu-user-extension
3914
dyn-builtin-extension-tagfilter
2615
3915
ecb-common-methods-menu)))
2616
3916
(cons 2 (funcall (or ecb-methods-menu-sorter
2617
3917
'identity)
2618
3918
(append dyn-user-extension
2619
3919
ecb-methods-menu-user-extension
3920
dyn-builtin-extension-tagfilter
2620
3921
ecb-common-methods-menu))))))
2621
3922
2622
3923
(defconst ecb-methods-incr-searchpattern-node-prefix
3924
'("\\([-+#(]\\|[^-+#(][^ \n]+ \\)?" . 1)
3925
"Prefix-pattern which ignores all not interesting stuff of a node-name at
3926
incr. search. The following contents of a node-name are ignored by this
3927
pattern:
3928
- types of a variable or return-types of a method
3929
- const specifier of variables
3930
- protection sign of a variable/method: +, - or #
3931
3932
Format: cons with car is the pattern and cdr is the number of subexpr in this
3933
pattern.")
3934
3935
;; Function which compares the node-data of a tree-buffer-node in the
3936
;; method-buffer for equality. We must compare semantic-tags but we must not
3937
;; compare the tags with eq or equal because they can be re-grouped by
3938
;; ecb--semantic-adopt-external-members. the following function is a save
3939
;; "equal"-condition for ECB because currently the method buffer always
3940
;; displays only tags from exactly the buffer of the current edit-window. If
3941
;; `ecb--semantic-equivalent-tag-p' fails we return the result of an
3942
;; eq-comparison.
3943
(defun ecb-compare-methods-buffer-node-data (l r)
3944
(cond ((or (stringp l) (stringp r))
3945
(equal l r))
3946
((or (equal 'ecb-bucket-node (car l))
3947
(equal 'ecb-bucket-node (car r)))
3948
(equal l r))
3949
(t ;; tags
3950
(condition-case nil
3951
(ecb--semantic-equivalent-tag-p l r)
3952
(error (eq l r))))))
3953
3954
(defun ecb-create-methods-tree-buffer ()
3955
"Create the tree-buffer for methods."
3956
(tree-buffer-create
3957
ecb-methods-buffer-name
3958
ecb-frame
3959
ecb-tree-mouse-action-trigger
3960
'ecb-interpret-mouse-click
3961
'ecb-tree-buffer-node-select-callback
3962
'ecb-tree-buffer-node-expand-callback
3963
'ecb-tree-buffer-node-collapsed-callback
3964
'ecb-mouse-over-method-node
3965
'ecb-compare-methods-buffer-node-data
3966
(list 1)
3967
nil
3968
'ecb-methods-menu-creator
3969
(list (cons 0 ecb-methods-menu-title-creator)
3970
(cons 1 ecb-methods-menu-title-creator)
3971
(cons 2 ecb-methods-menu-title-creator))
3972
(nth 2 ecb-truncate-lines)
3973
t
3974
ecb-tree-indent
3975
ecb-tree-incremental-search
3976
ecb-methods-incr-searchpattern-node-prefix
3977
ecb-tree-navigation-by-arrow
3978
ecb-tree-easy-hor-scroll
3979
(nth 0 ecb-tree-image-icons-directories)
3980
(nth 3 ecb-tree-image-icons-directories)
3981
ecb-tree-buffer-style
3982
ecb-tree-guide-line-face
3983
nil
3984
ecb-tree-expand-symbol-before
3985
ecb-method-face
3986
ecb-methods-general-face
3987
(append
3988
(list (function (lambda ()
3989
(local-set-key (kbd "C-t")
3990
'ecb-toggle-RET-selects-edit-window)
3991
(if (not ecb-running-xemacs)
3992
(define-key tree-buffer-key-map
3993
[mode-line mouse-2]
3994
'ecb-toggle-maximize-ecb-window-with-mouse))
3995
(setq ecb-methods-root-node (tree-buffer-get-root)))))
3996
ecb-common-tree-buffer-after-create-hook
3997
ecb-directories-buffer-after-create-hook)))
3998
2623
3999
(defun ecb-dump-semantic-toplevel ()
2624
4000
"Dump the current semantic-tags in special buffer and display them."
2625
4001
(interactive)
2626
(let ((tags (ecb-post-process-taglist (ecb--semantic-bovinate-toplevel t))))
4002
(let ((tags (ecb--semantic-fetch-tags))
4003
(source-buf (current-buffer)))
2627
4004
(save-selected-window
2628
(set-buffer (get-buffer-create "ecb-dump"))
4005
(set-buffer (get-buffer-create "*ecb-tag-dump*"))
2629
4006
(erase-buffer)
2630
(ecb-dump-tags tags "")
2631
(switch-to-buffer-other-window (get-buffer-create "ecb-dump"))
4007
(ecb-dump-semantic-tags-internal tags nil source-buf 1)
4008
(switch-to-buffer-other-window (get-buffer-create "*ecb-tag-dump*"))
2632
4009
(goto-char (point-min)))))
2633
2634
2635
(defun ecb-dump-type (a-tag prefix)
2636
(dolist (parent (ecb-get-tag-parents a-tag))
2637
(insert prefix " " parent)))
2638
2639
2640
(defun ecb-dump-tags (tags prefix)
2641
(dolist (a-tag tags)
2642
(if (stringp a-tag)
2643
(princ (concat prefix a-tag))
2644
(insert prefix
2645
(ecb--semantic-format-tag-name a-tag nil ecb-font-lock-tags)
2646
", "
2647
(symbol-name (ecb--semantic-tag-class a-tag))
2648
", "
2649
(if (stringp (ecb--semantic-tag-type a-tag))
2650
(ecb--semantic-tag-type a-tag)
2651
"<unknown type>")
2652
"\n")
2653
(if (eq 'type (ecb--semantic-tag-class a-tag))
2654
(ecb-dump-type a-tag prefix))
2655
(ecb-dump-tags (ecb--semantic-tag-children-compatibility
2656
a-tag ecb-show-only-positioned-tags)
2657
(concat prefix " ")))))
4010
4011
4012
(defun ecb-dump-semantic-tags-internal (table parent source-buffer indent)
4013
(dolist (tag table)
4014
(insert (format "%s%s, tag-class: %s\n" (make-string indent ? )
4015
(save-excursion
4016
(set-buffer source-buffer)
4017
(ecb--semantic-format-tag-uml-prototype tag parent t))
4018
(ecb--semantic-tag-class tag)))
4019
(ecb-dump-semantic-tags-internal (ecb--semantic-tag-children-compatibility tag t)
4020
(if (equal (ecb--semantic-tag-class tag)
4021
'type)
4022
tag)
4023
source-buffer
4024
(+ 2 indent))))
2658
4025
2659
4026
(silentcomp-provide 'ecb-method-browser)
2660
4027
2661
4028
;;; ecb-method-browser.el end here
4029
Loggerhead is a web-based interface for Breezy
Version: 2.0.1