Mercurial > emacs
comparison lisp/cedet/semantic/sort.el @ 105260:bbd7017a25d9
CEDET (development tools) package merged.
* cedet/*.el:
* cedet/ede/*.el:
* cedet/semantic/*.el:
* cedet/srecode/*.el: New files.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 28 Sep 2009 15:15:00 +0000 |
parents | 1da44e87bf90 |
children | 7f4c7f5c0eba |
comparison
equal
deleted
inserted
replaced
105259:5707f7454ab5 | 105260:bbd7017a25d9 |
---|---|
1 ;;; sort.el --- Utilities for sorting and re-arranging tag tables. | |
2 | |
3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, | |
4 ;;; 2008, 2009 Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 ;; Keywords: syntax | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation, either version 3 of the License, or | |
14 ;; (at your option) any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | |
24 ;;; Commentary: | |
25 ;; | |
26 ;; Tag tables originate in the order they appear in a buffer, or source file. | |
27 ;; It is often useful to re-arrange them is some predictable way for browsing | |
28 ;; purposes. Re-organization may be alphabetical, or even a complete | |
29 ;; reorganization of parents and children. | |
30 ;; | |
31 ;; Originally written in semantic-util.el | |
32 ;; | |
33 | |
34 (require 'semantic) | |
35 (eval-when-compile | |
36 (require 'semantic/find)) | |
37 | |
38 (declare-function semanticdb-find-tags-external-children-of-type | |
39 "semantic/db-find") | |
40 | |
41 ;;; Alphanumeric sorting | |
42 ;; | |
43 ;; Takes a list of tags, and sorts them in a case-insensitive way | |
44 ;; at a single level. | |
45 | |
46 ;;; Code: | |
47 (defun semantic-string-lessp-ci (s1 s2) | |
48 "Case insensitive version of `string-lessp'. | |
49 Argument S1 and S2 are the strings to compare." | |
50 ;; Use downcase instead of upcase because an average name | |
51 ;; has more lower case characters. | |
52 (if (fboundp 'compare-strings) | |
53 (eq (compare-strings s1 0 nil s2 0 nil t) -1) | |
54 (string-lessp (downcase s1) (downcase s2)))) | |
55 | |
56 (defun semantic-sort-tag-type (tag) | |
57 "Return a type string for TAG guaranteed to be a string." | |
58 (let ((ty (semantic-tag-type tag))) | |
59 (cond ((stringp ty) | |
60 ty) | |
61 ((listp ty) | |
62 (or (car ty) "")) | |
63 (t "")))) | |
64 | |
65 (defun semantic-tag-lessp-name-then-type (A B) | |
66 "Return t if tag A is < tag B. | |
67 First sorts on name, then sorts on the name of the :type of | |
68 each tag." | |
69 (let ((na (semantic-tag-name A)) | |
70 (nb (semantic-tag-name B)) | |
71 ) | |
72 (if (string-lessp na nb) | |
73 t ; a sure thing. | |
74 (if (string= na nb) | |
75 ;; If equal, test the :type which might be different. | |
76 (let* ((ta (semantic-tag-type A)) | |
77 (tb (semantic-tag-type B)) | |
78 (tas (cond ((stringp ta) | |
79 ta) | |
80 ((semantic-tag-p ta) | |
81 (semantic-tag-name ta)) | |
82 (t nil))) | |
83 (tbs (cond ((stringp tb) | |
84 tb) | |
85 ((semantic-tag-p tb) | |
86 (semantic-tag-name tb)) | |
87 (t nil)))) | |
88 (if (and (stringp tas) (stringp tbs)) | |
89 (string< tas tbs) | |
90 ;; This is if A == B, and no types in A or B | |
91 nil)) | |
92 ;; This nil is if A > B, but not = | |
93 nil)))) | |
94 | |
95 (defun semantic-sort-tags-by-name-increasing (tags) | |
96 "Sort TAGS by name in increasing order with side effects. | |
97 Return the sorted list." | |
98 (sort tags (lambda (a b) | |
99 (string-lessp (semantic-tag-name a) | |
100 (semantic-tag-name b))))) | |
101 | |
102 (defun semantic-sort-tags-by-name-decreasing (tags) | |
103 "Sort TAGS by name in decreasing order with side effects. | |
104 Return the sorted list." | |
105 (sort tags (lambda (a b) | |
106 (string-lessp (semantic-tag-name b) | |
107 (semantic-tag-name a))))) | |
108 | |
109 (defun semantic-sort-tags-by-type-increasing (tags) | |
110 "Sort TAGS by type in increasing order with side effects. | |
111 Return the sorted list." | |
112 (sort tags (lambda (a b) | |
113 (string-lessp (semantic-sort-tag-type a) | |
114 (semantic-sort-tag-type b))))) | |
115 | |
116 (defun semantic-sort-tags-by-type-decreasing (tags) | |
117 "Sort TAGS by type in decreasing order with side effects. | |
118 Return the sorted list." | |
119 (sort tags (lambda (a b) | |
120 (string-lessp (semantic-sort-tag-type b) | |
121 (semantic-sort-tag-type a))))) | |
122 | |
123 (defun semantic-sort-tags-by-name-increasing-ci (tags) | |
124 "Sort TAGS by name in increasing order with side effects. | |
125 Return the sorted list." | |
126 (sort tags (lambda (a b) | |
127 (semantic-string-lessp-ci (semantic-tag-name a) | |
128 (semantic-tag-name b))))) | |
129 | |
130 (defun semantic-sort-tags-by-name-decreasing-ci (tags) | |
131 "Sort TAGS by name in decreasing order with side effects. | |
132 Return the sorted list." | |
133 (sort tags (lambda (a b) | |
134 (semantic-string-lessp-ci (semantic-tag-name b) | |
135 (semantic-tag-name a))))) | |
136 | |
137 (defun semantic-sort-tags-by-type-increasing-ci (tags) | |
138 "Sort TAGS by type in increasing order with side effects. | |
139 Return the sorted list." | |
140 (sort tags (lambda (a b) | |
141 (semantic-string-lessp-ci (semantic-sort-tag-type a) | |
142 (semantic-sort-tag-type b))))) | |
143 | |
144 (defun semantic-sort-tags-by-type-decreasing-ci (tags) | |
145 "Sort TAGS by type in decreasing order with side effects. | |
146 Return the sorted list." | |
147 (sort tags (lambda (a b) | |
148 (semantic-string-lessp-ci (semantic-sort-tag-type b) | |
149 (semantic-sort-tag-type a))))) | |
150 | |
151 (defun semantic-sort-tags-by-name-then-type-increasing (tags) | |
152 "Sort TAGS by name, then type in increasing order with side effects. | |
153 Return the sorted list." | |
154 (sort tags (lambda (a b) (semantic-tag-lessp-name-then-type a b)))) | |
155 | |
156 (defun semantic-sort-tags-by-name-then-type-decreasing (tags) | |
157 "Sort TAGS by name, then type in increasing order with side effects. | |
158 Return the sorted list." | |
159 (sort tags (lambda (a b) (semantic-tag-lessp-name-then-type b a)))) | |
160 | |
161 ;;; Unique | |
162 ;; | |
163 ;; Scan a list of tags, removing duplicates. | |
164 ;; This must first sort the tags by name alphabetically ascending. | |
165 ;; | |
166 ;; Useful for completion lists, or other situations where the | |
167 ;; other data isn't as useful. | |
168 | |
169 (defun semantic-unique-tag-table-by-name (tags) | |
170 "Scan a list of TAGS, removing duplicate names. | |
171 This must first sort the tags by name alphabetically ascending. | |
172 For more complex uniqueness testing used by the semanticdb | |
173 typecaching system, see `semanticdb-typecache-merge-streams'." | |
174 (let ((sorted (semantic-sort-tags-by-name-increasing | |
175 (copy-sequence tags))) | |
176 (uniq nil)) | |
177 (while sorted | |
178 (if (or (not uniq) | |
179 (not (string= (semantic-tag-name (car sorted)) | |
180 (semantic-tag-name (car uniq))))) | |
181 (setq uniq (cons (car sorted) uniq))) | |
182 (setq sorted (cdr sorted)) | |
183 ) | |
184 (nreverse uniq))) | |
185 | |
186 (defun semantic-unique-tag-table (tags) | |
187 "Scan a list of TAGS, removing duplicates. | |
188 This must first sort the tags by position ascending. | |
189 TAGS are removed only if they are equivalent, as can happen when | |
190 multiple tag sources are scanned. | |
191 For more complex uniqueness testing used by the semanticdb | |
192 typecaching system, see `semanticdb-typecache-merge-streams'." | |
193 (let ((sorted (sort (copy-sequence tags) | |
194 (lambda (a b) | |
195 (cond ((not (semantic-tag-with-position-p a)) | |
196 t) | |
197 ((not (semantic-tag-with-position-p b)) | |
198 nil) | |
199 (t | |
200 (< (semantic-tag-start a) | |
201 (semantic-tag-start b))))))) | |
202 (uniq nil)) | |
203 (while sorted | |
204 (if (or (not uniq) | |
205 (not (semantic-equivalent-tag-p (car sorted) (car uniq)))) | |
206 (setq uniq (cons (car sorted) uniq))) | |
207 (setq sorted (cdr sorted)) | |
208 ) | |
209 (nreverse uniq))) | |
210 | |
211 | |
212 ;;; Tag Table Flattening | |
213 ;; | |
214 ;; In the 1.4 search API, there was a parameter "search-parts" which | |
215 ;; was used to find tags inside other tags. This was used | |
216 ;; infrequently, mostly for completion/jump routines. These types | |
217 ;; of commands would be better off with a flattened list, where all | |
218 ;; tags appear at the top level. | |
219 | |
220 ;;;###autoload | |
221 (defun semantic-flatten-tags-table (&optional table) | |
222 "Flatten the tags table TABLE. | |
223 All tags in TABLE, and all components of top level tags | |
224 in TABLE will appear at the top level of list. | |
225 Tags promoted to the top of the list will still appear | |
226 unmodified as components of their parent tags." | |
227 (let* ((table (semantic-something-to-tag-table table)) | |
228 ;; Initialize the starting list with our table. | |
229 (lists (list table))) | |
230 (mapc (lambda (tag) | |
231 (let ((components (semantic-tag-components tag))) | |
232 (if (and components | |
233 ;; unpositined tags can be hazardous to | |
234 ;; completion. Do we need any type of tag | |
235 ;; here? - EL | |
236 (semantic-tag-with-position-p (car components))) | |
237 (setq lists (cons | |
238 (semantic-flatten-tags-table components) | |
239 lists))))) | |
240 table) | |
241 (apply 'append (nreverse lists)) | |
242 )) | |
243 | |
244 | |
245 ;;; Buckets: | |
246 ;; | |
247 ;; A list of tags can be grouped into buckets based on the tag class. | |
248 ;; Bucketize means to take a list of tags at a given level in a tag | |
249 ;; table, and reorganize them into buckets based on class. | |
250 ;; | |
251 (defvar semantic-bucketize-tag-class | |
252 ;; Must use lambda because `semantic-tag-class' is a macro. | |
253 (lambda (tok) (semantic-tag-class tok)) | |
254 "Function used to get a symbol describing the class of a tag. | |
255 This function must take one argument of a semantic tag. | |
256 It should return a symbol found in `semantic-symbol->name-assoc-list' | |
257 which `semantic-bucketize' uses to bin up tokens. | |
258 To create new bins for an application augment | |
259 `semantic-symbol->name-assoc-list', and | |
260 `semantic-symbol->name-assoc-list-for-type-parts' in addition | |
261 to setting this variable (locally in your function).") | |
262 | |
263 (defun semantic-bucketize (tags &optional parent filter) | |
264 "Sort TAGS into a group of buckets based on tag class. | |
265 Unknown classes are placed in a Misc bucket. | |
266 Type bucket names are defined by either `semantic-symbol->name-assoc-list'. | |
267 If PARENT is specified, then TAGS belong to this PARENT in some way. | |
268 This will use `semantic-symbol->name-assoc-list-for-type-parts' to | |
269 generate bucket names. | |
270 Optional argument FILTER is a filter function to be applied to each bucket. | |
271 The filter function will take one argument, which is a list of tokens, and | |
272 may re-organize the list with side-effects." | |
273 (let* ((name-list (if parent | |
274 semantic-symbol->name-assoc-list-for-type-parts | |
275 semantic-symbol->name-assoc-list)) | |
276 (sn name-list) | |
277 (bins (make-vector (1+ (length sn)) nil)) | |
278 ask tagtype | |
279 (nsn nil) | |
280 (num 1) | |
281 (out nil)) | |
282 ;; Build up the bucket vector | |
283 (while sn | |
284 (setq nsn (cons (cons (car (car sn)) num) nsn) | |
285 sn (cdr sn) | |
286 num (1+ num))) | |
287 ;; Place into buckets | |
288 (while tags | |
289 (setq tagtype (funcall semantic-bucketize-tag-class (car tags)) | |
290 ask (assq tagtype nsn) | |
291 num (or (cdr ask) 0)) | |
292 (aset bins num (cons (car tags) (aref bins num))) | |
293 (setq tags (cdr tags))) | |
294 ;; Remove from buckets into a list. | |
295 (setq num 1) | |
296 (while (< num (length bins)) | |
297 (when (aref bins num) | |
298 (setq out | |
299 (cons (cons | |
300 (cdr (nth (1- num) name-list)) | |
301 ;; Filtering, First hacked by David Ponce david@dponce.com | |
302 (funcall (or filter 'nreverse) (aref bins num))) | |
303 out))) | |
304 (setq num (1+ num))) | |
305 (if (aref bins 0) | |
306 (setq out (cons (cons "Misc" | |
307 (funcall (or filter 'nreverse) (aref bins 0))) | |
308 out))) | |
309 (nreverse out))) | |
310 | |
311 ;;; Adoption | |
312 ;; | |
313 ;; Some languages allow children of a type to be defined outside | |
314 ;; the syntactic scope of that class. These routines will find those | |
315 ;; external members, and bring them together in a cloned copy of the | |
316 ;; class tag. | |
317 ;; | |
318 (defvar semantic-orphaned-member-metaparent-type "class" | |
319 "In `semantic-adopt-external-members', the type of 'type for metaparents. | |
320 A metaparent is a made-up type semantic token used to hold the child list | |
321 of orphaned members of a named type.") | |
322 (make-variable-buffer-local 'semantic-orphaned-member-metaparent-type) | |
323 | |
324 (defvar semantic-mark-external-member-function nil | |
325 "Function called when an externally defined orphan is found. | |
326 By default, the token is always marked with the `adopted' property. | |
327 This function should be locally bound by a program that needs | |
328 to add additional behaviors into the token list. | |
329 This function is called with two arguments. The first is TOKEN which is | |
330 a shallow copy of the token to be modified. The second is the PARENT | |
331 which is adopting TOKEN. This function should return TOKEN (or a copy of it) | |
332 which is then integrated into the revised token list.") | |
333 | |
334 (defun semantic-adopt-external-members (tags) | |
335 "Rebuild TAGS so that externally defined members are regrouped. | |
336 Some languages such as C++ and CLOS permit the declaration of member | |
337 functions outside the definition of the class. It is easier to study | |
338 the structure of a program when such methods are grouped together | |
339 more logically. | |
340 | |
341 This function uses `semantic-tag-external-member-p' to | |
342 determine when a potential child is an externally defined member. | |
343 | |
344 Note: Applications which use this function must account for token | |
345 types which do not have a position, but have children which *do* | |
346 have positions. | |
347 | |
348 Applications should use `semantic-mark-external-member-function' | |
349 to modify all tags which are found as externally defined to some | |
350 type. For example, changing the token type for generating extra | |
351 buckets with the bucket function." | |
352 (let ((parent-buckets nil) | |
353 (decent-list nil) | |
354 (out nil) | |
355 (tmp nil) | |
356 ) | |
357 ;; Rebuild the output list, stripping out all parented | |
358 ;; external entries | |
359 (while tags | |
360 (cond | |
361 ((setq tmp (semantic-tag-external-member-parent (car tags))) | |
362 (let ((tagcopy (semantic-tag-clone (car tags))) | |
363 (a (assoc tmp parent-buckets))) | |
364 (semantic--tag-put-property-no-side-effect tagcopy 'adopted t) | |
365 (if a | |
366 ;; If this parent is already in the list, append. | |
367 (setcdr (nthcdr (1- (length a)) a) (list tagcopy)) | |
368 ;; If not, prepend this new parent bucket into our list | |
369 (setq parent-buckets | |
370 (cons (cons tmp (list tagcopy)) parent-buckets))) | |
371 )) | |
372 ((eq (semantic-tag-class (car tags)) 'type) | |
373 ;; Types need to be rebuilt from scratch so we can add in new | |
374 ;; children to the child list. Only the top-level cons | |
375 ;; cells need to be duplicated so we can hack out the | |
376 ;; child list later. | |
377 (setq out (cons (semantic-tag-clone (car tags)) out)) | |
378 (setq decent-list (cons (car out) decent-list)) | |
379 ) | |
380 (t | |
381 ;; Otherwise, append this tag to our new output list. | |
382 (setq out (cons (car tags) out))) | |
383 ) | |
384 (setq tags (cdr tags))) | |
385 ;; Rescan out, by descending into all types and finding parents | |
386 ;; for all entries moved into the parent-buckets. | |
387 (while decent-list | |
388 (let* ((bucket (assoc (semantic-tag-name (car decent-list)) | |
389 parent-buckets)) | |
390 (bucketkids (cdr bucket))) | |
391 (when bucket | |
392 ;; Run our secondary marking function on the children | |
393 (if semantic-mark-external-member-function | |
394 (setq bucketkids | |
395 (mapcar (lambda (tok) | |
396 (funcall semantic-mark-external-member-function | |
397 tok (car decent-list))) | |
398 bucketkids))) | |
399 ;; We have some extra kids. Merge. | |
400 (semantic-tag-put-attribute | |
401 (car decent-list) :members | |
402 (append (semantic-tag-type-members (car decent-list)) | |
403 bucketkids)) | |
404 ;; Nuke the bucket label so it is not found again. | |
405 (setcar bucket nil)) | |
406 (setq decent-list | |
407 (append (cdr decent-list) | |
408 ;; get embedded types to scan and make copies | |
409 ;; of them. | |
410 (mapcar | |
411 (lambda (tok) (semantic-tag-clone tok)) | |
412 (semantic-find-tags-by-class 'type | |
413 (semantic-tag-type-members (car decent-list))))) | |
414 ))) | |
415 ;; Scan over all remaining lost external methods, and tack them | |
416 ;; onto the end. | |
417 (while parent-buckets | |
418 (if (car (car parent-buckets)) | |
419 (let* ((tmp (car parent-buckets)) | |
420 (fauxtag (semantic-tag-new-type | |
421 (car tmp) | |
422 semantic-orphaned-member-metaparent-type | |
423 nil ;; Part list | |
424 nil ;; parents (unknown) | |
425 )) | |
426 (bucketkids (cdr tmp))) | |
427 (semantic-tag-set-faux fauxtag) ;; properties | |
428 (if semantic-mark-external-member-function | |
429 (setq bucketkids | |
430 (mapcar (lambda (tok) | |
431 (funcall semantic-mark-external-member-function | |
432 tok fauxtag)) | |
433 bucketkids))) | |
434 (semantic-tag-put-attribute fauxtag :members bucketkids) | |
435 ;; We have a bunch of methods with no parent in this file. | |
436 ;; Create a meta-type to hold it. | |
437 (setq out (cons fauxtag out)) | |
438 )) | |
439 (setq parent-buckets (cdr parent-buckets))) | |
440 ;; Return the new list. | |
441 (nreverse out))) | |
442 | |
443 | |
444 ;;; External children | |
445 ;; | |
446 ;; In order to adopt external children, we need a few overload methods | |
447 ;; to enable the feature. | |
448 | |
449 ;;;###autoload | |
450 (define-overloadable-function semantic-tag-external-member-parent (tag) | |
451 "Return a parent for TAG when TAG is an external member. | |
452 TAG is an external member if it is defined at a toplevel and | |
453 has some sort of label defining a parent. The parent return will | |
454 be a string. | |
455 | |
456 The default behavior, if not overridden with | |
457 `tag-member-parent' gets the 'parent extra | |
458 specifier of TAG. | |
459 | |
460 If this function is overridden, use | |
461 `semantic-tag-external-member-parent-default' to also | |
462 include the default behavior, and merely extend your own." | |
463 ) | |
464 | |
465 (defun semantic-tag-external-member-parent-default (tag) | |
466 "Return the name of TAGs parent only if TAG is not defined in it's parent." | |
467 ;; Use only the extra spec because a type has a parent which | |
468 ;; means something completely different. | |
469 (let ((tp (semantic-tag-get-attribute tag :parent))) | |
470 (when (stringp tp) | |
471 tp))) | |
472 | |
473 (define-overloadable-function semantic-tag-external-member-p (parent tag) | |
474 "Return non-nil if PARENT is the parent of TAG. | |
475 TAG is an external member of PARENT when it is somehow tagged | |
476 as having PARENT as it's parent. | |
477 PARENT and TAG must both be semantic tags. | |
478 | |
479 The default behavior, if not overridden with | |
480 `tag-external-member-p' is to match :parent attribute in | |
481 the name of TAG. | |
482 | |
483 If this function is overridden, use | |
484 `semantic-tag-external-member-children-p-default' to also | |
485 include the default behavior, and merely extend your own." | |
486 ) | |
487 | |
488 (defun semantic-tag-external-member-p-default (parent tag) | |
489 "Return non-nil if PARENT is the parent of TAG." | |
490 ;; Use only the extra spec because a type has a parent which | |
491 ;; means something completely different. | |
492 (let ((tp (semantic-tag-external-member-parent tag))) | |
493 (and (stringp tp) | |
494 (string= (semantic-tag-name parent) tp)))) | |
495 | |
496 (define-overloadable-function semantic-tag-external-member-children (tag &optional usedb) | |
497 "Return the list of children which are not *in* TAG. | |
498 If optional argument USEDB is non-nil, then also search files in | |
499 the Semantic Database. If USEDB is a list of databases, search those | |
500 databases. | |
501 | |
502 Children in this case are functions or types which are members of | |
503 TAG, such as the parts of a type, but which are not defined inside | |
504 the class. C++ and CLOS both permit methods of a class to be defined | |
505 outside the bounds of the class' definition. | |
506 | |
507 The default behavior, if not overridden with | |
508 `tag-external-member-children' is to search using | |
509 `semantic-tag-external-member-p' in all top level definitions | |
510 with a parent of TAG. | |
511 | |
512 If this function is overridden, use | |
513 `semantic-tag-external-member-children-default' to also | |
514 include the default behavior, and merely extend your own." | |
515 ) | |
516 | |
517 (defun semantic-tag-external-member-children-default (tag &optional usedb) | |
518 "Return list of external children for TAG. | |
519 Optional argument USEDB specifies if the semantic database is used. | |
520 See `semantic-tag-external-member-children' for details." | |
521 (if (and usedb | |
522 (require 'semantic/db-mode) | |
523 (semanticdb-minor-mode-p) | |
524 (require 'semantic/db-find)) | |
525 (let ((m (semanticdb-find-tags-external-children-of-type | |
526 (semantic-tag-name tag)))) | |
527 (if m (apply #'append (mapcar #'cdr m)))) | |
528 (semantic--find-tags-by-function | |
529 `(lambda (tok) | |
530 ;; This bit of annoying backquote forces the contents of | |
531 ;; tag into the generated lambda. | |
532 (semantic-tag-external-member-p ',tag tok)) | |
533 (current-buffer)) | |
534 )) | |
535 | |
536 (define-overloadable-function semantic-tag-external-class (tag) | |
537 "Return a list of real tags that faux TAG might represent. | |
538 | |
539 In some languages, a method can be defined on an object which is | |
540 not in the same file. In this case, | |
541 `semantic-adopt-external-members' will create a faux-tag. If it | |
542 is necessary to get the tag from which for faux TAG was most | |
543 likely derived, then this function is needed." | |
544 (unless (semantic-tag-faux-p tag) | |
545 (signal 'wrong-type-argument (list tag 'semantic-tag-faux-p))) | |
546 (:override) | |
547 ) | |
548 | |
549 (defun semantic-tag-external-class-default (tag) | |
550 "Return a list of real tags that faux TAG might represent. | |
551 See `semantic-tag-external-class' for details." | |
552 (if (and (require 'semantic/db-mode) | |
553 (semanticdb-minor-mode-p)) | |
554 (let* ((semanticdb-search-system-databases nil) | |
555 (m (semanticdb-find-tags-by-class | |
556 (semantic-tag-class tag) | |
557 (semanticdb-find-tags-by-name (semantic-tag-name tag))))) | |
558 (semanticdb-strip-find-results m 'name)) | |
559 ;; Presumably, if the tag is faux, it is not local. | |
560 nil)) | |
561 | |
562 (provide 'semantic/sort) | |
563 | |
564 ;; Local variables: | |
565 ;; generated-autoload-file: "loaddefs.el" | |
566 ;; generated-autoload-feature: semantic/loaddefs | |
567 ;; generated-autoload-load-name: "semantic/sort" | |
568 ;; End: | |
569 | |
570 ;;; semantic-sort.el ends here |