Commit | Line | Data |
---|---|---|
1bd95535 CY |
1 | ;;; sort.el --- Utilities for sorting and re-arranging tag tables. |
2 | ||
3 | ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, | |
49f70d46 | 4 | ;;; 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
1bd95535 CY |
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 | ||
1bd95535 | 34 | (require 'semantic) |
1bd95535 | 35 | (eval-when-compile |
55b522b2 CY |
36 | (require 'semantic/find)) |
37 | ||
38 | (declare-function semanticdb-find-tags-external-children-of-type | |
39 | "semantic/db-find") | |
1bd95535 CY |
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)))) | |
1bd95535 CY |
160 | \f |
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 | \f | |
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 | ||
3d9d8486 | 220 | ;;;###autoload |
1bd95535 CY |
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 | \f | |
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 | \f | |
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 | \f | |
444 | ;;; External children | |
445 | ;; | |
446 | ;; In order to adopt external children, we need a few overload methods | |
447 | ;; to enable the feature. | |
3d9d8486 CY |
448 | |
449 | ;;;###autoload | |
1bd95535 CY |
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) | |
dd9af436 | 466 | "Return the name of TAGs parent only if TAG is not defined in its parent." |
1bd95535 CY |
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) | |
b90caf50 | 471 | tp))) |
1bd95535 CY |
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 | |
dd9af436 | 476 | as having PARENT as its parent. |
1bd95535 CY |
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) | |
b90caf50 | 494 | (string= (semantic-tag-name parent) tp)))) |
1bd95535 CY |
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 | |
bb631f17 | 522 | (require 'semantic/db-mode) |
55b522b2 CY |
523 | (semanticdb-minor-mode-p) |
524 | (require 'semantic/db-find)) | |
1bd95535 CY |
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." | |
bb631f17 | 552 | (if (and (require 'semantic/db-mode) |
1bd95535 CY |
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. | |
b90caf50 | 560 | nil)) |
1bd95535 CY |
561 | |
562 | (provide 'semantic/sort) | |
563 | ||
3d9d8486 CY |
564 | ;; Local variables: |
565 | ;; generated-autoload-file: "loaddefs.el" | |
996bc9bf | 566 | ;; generated-autoload-load-name: "semantic/sort" |
3d9d8486 CY |
567 | ;; End: |
568 | ||
3999968a | 569 | ;; arch-tag: 9231c8e7-ac7f-4b35-9302-651a02e5fef0 |
1bd95535 | 570 | ;;; semantic-sort.el ends here |