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