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