Commit | Line | Data |
---|---|---|
55b522b2 | 1 | ;;; semantic/tag-ls.el --- Language Specific override functions for tags |
f273dfc6 | 2 | |
ab422c4d | 3 | ;; Copyright (C) 1999-2004, 2006-2013 Free Software Foundation, Inc. |
f273dfc6 CY |
4 | |
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
e2309735 | 24 | ;; There are some features of tags that are too language dependent to |
f273dfc6 CY |
25 | ;; put in the core `semantic-tag' functionality. For instance, the |
26 | ;; protection of a tag (as specified by UML) could be almost anything. | |
27 | ;; In Java, it is a type specifier. In C, there is a label. This | |
e2309735 | 28 | ;; information can be derived, and thus should not be stored in the tag |
f273dfc6 CY |
29 | ;; itself. These are the functions that languages can use to derive |
30 | ;; the information. | |
31 | ||
55b522b2 | 32 | (require 'semantic) |
62a81506 | 33 | (require 'semantic/find) |
f273dfc6 CY |
34 | |
35 | ;;; Code: | |
36 | ||
62a81506 CY |
37 | ;;; TAG SIMILARITY: |
38 | ;; | |
39 | ;; Two tags that represent the same thing are "similar", but not the "same". | |
40 | ;; Similar tags might have the same name, but one is a :prototype, while | |
41 | ;; the other is an implementation. | |
42 | ;; | |
43 | ;; Each language will have different things that can be ignored | |
44 | ;; between two "similar" tags, so similarity checks involve a series | |
45 | ;; of mode overridable features. Some are "internal" features. | |
46 | (defvar semantic-tag-similar-ignorable-attributes '(:prototype-flag) | |
47 | "The tag attributes that can be ignored during a similarity test.") | |
48 | ||
49 | (define-overloadable-function semantic--tag-similar-names-p (tag1 tag2 blankok) | |
50 | "Compare the names of TAG1 and TAG2. | |
51 | If BLANKOK is false, then the names must exactly match. | |
52 | If BLANKOK is true, then if either of TAG1 or TAG2 has blank | |
53 | names, then that is ok, and this returns true, but if they both | |
54 | have values, they must still match.") | |
55 | ||
56 | (defun semantic--tag-similar-names-p-default (tag1 tag2 blankok) | |
57 | "Compare the names of TAG1 and TAG2. | |
58 | If BLANKOK is false, then the names must exactly match. | |
59 | If BLANKOK is true, then if either of TAG1 or TAG2 has blank | |
60 | names, then that is ok, and this returns true, but if they both | |
61 | have values, they must still match." | |
62 | (let ((n1 (semantic-tag-name tag1)) | |
63 | (n2 (semantic-tag-name tag2))) | |
64 | (or (and blankok (or (null n1) (null n2) (string= n1 "") (string= n2 ""))) | |
65 | (string= n1 n2)))) | |
66 | ||
67 | (define-overloadable-function semantic--tag-similar-types-p (tag1 tag2) | |
68 | "Compare the types of TAG1 and TAG2. | |
735135f9 | 69 | This function can be overridden, for example to compare a fully |
62a81506 CY |
70 | qualified with an unqualified type." |
71 | (cond | |
72 | ((and (null (semantic-tag-type tag1)) | |
73 | (null (semantic-tag-type tag2))) | |
74 | t) | |
75 | ((or (null (semantic-tag-type tag1)) | |
76 | (null (semantic-tag-type tag2))) | |
77 | nil) | |
78 | (t | |
79 | (:override)))) | |
80 | ||
81 | (defun semantic--tag-similar-types-p-default (tag1 tag2) | |
82 | "Compare the types of TAG1 and TAG2. | |
735135f9 | 83 | This function can be overridden, for example to compare a fully |
62a81506 CY |
84 | qualified with an unqualified type." |
85 | (semantic-tag-of-type-p tag1 (semantic-tag-type tag2))) | |
86 | ||
87 | (define-overloadable-function semantic--tag-attribute-similar-p (attr value1 value2 ignorable-attributes) | |
88 | "Test to see if attribute ATTR is similar for VALUE1 and VALUE2. | |
89 | IGNORABLE-ATTRIBUTES is described in `semantic-tag-similar-p'. | |
90 | This function is internal, but allows customization of `semantic-tag-similar-p' | |
91 | for a given mode at a more granular level. | |
92 | ||
93 | Note that :type, :name, and anything in IGNORABLE-ATTRIBUTES will | |
94 | not be passed to this function. | |
95 | ||
96 | Modes that override this function can call `semantic--tag-attribute-similar-p-default' | |
97 | to do the default equality tests if ATTR is not special for that mode.") | |
98 | ||
99 | (defun semantic--tag-attribute-similar-p-default (attr value1 value2 ignorable-attributes) | |
735135f9 | 100 | "For ATTR, VALUE1, VALUE2 and IGNORABLE-ATTRIBUTES, test for similarity." |
62a81506 CY |
101 | (cond |
102 | ;; Tag sublists require special testing. | |
103 | ((and (listp value1) (semantic-tag-p (car value1)) | |
104 | (listp value2) (semantic-tag-p (car value2))) | |
105 | (let ((ans t) | |
106 | (taglist1 value1) | |
107 | (taglist2 value2)) | |
108 | (when (not (eq (length taglist1) (length taglist2))) | |
109 | (setq ans nil)) | |
110 | (while (and ans taglist1 taglist2) | |
111 | (setq ans (apply 'semantic-tag-similar-p | |
112 | (car taglist1) (car taglist2) | |
113 | ignorable-attributes) | |
114 | taglist1 (cdr taglist1) | |
115 | taglist2 (cdr taglist2))) | |
116 | ans)) | |
117 | ||
118 | ;; The attributes are not the same? | |
119 | ((not (equal value1 value2)) | |
120 | nil) | |
121 | ||
122 | (t t)) | |
123 | ) | |
124 | ||
125 | (define-overloadable-function semantic-tag-similar-p (tag1 tag2 &rest ignorable-attributes) | |
126 | "Test to see if TAG1 and TAG2 are similar. | |
127 | Two tags are similar if their name, datatype, and various attributes | |
128 | are the same. | |
129 | ||
130 | Similar tags that have sub-tags such as arg lists or type members, | |
131 | are similar w/out checking the sub-list of tags. | |
132 | Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity. | |
133 | By default, `semantic-tag-similar-ignorable-attributes' is referenced for | |
735135f9 | 134 | attributes, and IGNORABLE-ATTRIBUTES will augment this list. |
62a81506 CY |
135 | |
136 | Note that even though :name is not an attribute, it can be used to | |
137 | to indicate lax comparison of names via `semantic--tag-similar-names-p'") | |
138 | ||
139 | ;; Note: optional thing is because overloadable fcns don't handle this | |
140 | ;; quite right. | |
141 | (defun semantic-tag-similar-p-default (tag1 tag2 &optional ignorable-attributes) | |
142 | "Test to see if TAG1 and TAG2 are similar. | |
143 | Two tags are similar if their name, datatype, and various attributes | |
144 | are the same. | |
145 | ||
146 | IGNORABLE-ATTRIBUTES are tag attributes that can be ignored. | |
147 | ||
148 | See `semantic-tag-similar-p' for details." | |
e8cc7880 DE |
149 | (or |
150 | ;; Tags are similar if they have the exact same lisp object | |
151 | ;; Added for performance when testing a relatively common case in some uses | |
152 | ;; of this code. | |
153 | (eq tag1 tag2) | |
b9edfa5c | 154 | ;; More complex similarity test. |
e8cc7880 DE |
155 | (let* ((ignore (append ignorable-attributes semantic-tag-similar-ignorable-attributes)) |
156 | (A1 (and (semantic--tag-similar-names-p tag1 tag2 (memq :name ignore)) | |
157 | (semantic--tag-similar-types-p tag1 tag2) | |
158 | (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)))) | |
159 | (attr1 (semantic-tag-attributes tag1)) | |
160 | (attr2 (semantic-tag-attributes tag2)) | |
161 | (A2 t) | |
162 | (A3 t) | |
163 | ) | |
164 | ;; Test if there are non-ignorable attributes in A2 which are not present in A1 | |
165 | (while (and A2 attr2) | |
166 | (let ((a (car attr2))) | |
167 | (unless (or (eq a :type) (memq a ignore)) | |
168 | (setq A2 (semantic-tag-get-attribute tag1 a))) | |
169 | (setq attr2 (cdr (cdr attr2))))) | |
170 | (while (and A2 attr1 A3) | |
171 | (let ((a (car attr1))) | |
172 | ||
173 | (cond ((or (eq a :type) ;; already tested above. | |
174 | (memq a ignore)) ;; Ignore them... | |
175 | nil) | |
176 | ||
177 | (t | |
178 | (setq A3 | |
179 | (semantic--tag-attribute-similar-p | |
180 | a (car (cdr attr1)) (semantic-tag-get-attribute tag2 a) | |
181 | ignorable-attributes))) | |
182 | )) | |
183 | (setq attr1 (cdr (cdr attr1)))) | |
184 | (and A1 A2 A3)))) | |
62a81506 CY |
185 | |
186 | ;;; FULL NAMES | |
187 | ;; | |
188 | ;; For programmer convenience, a full name is not specified in source | |
189 | ;; code. Instead some abbreviation is made, and the local environment | |
190 | ;; will contain the info needed to determine the full name. | |
191 | (define-overloadable-function semantic-tag-full-package (tag &optional stream-or-buffer) | |
192 | "Return the fully qualified package name of TAG in a package hierarchy. | |
193 | STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream', | |
194 | but must be a toplevel semantic tag stream that contains TAG. | |
195 | A Package Hierarchy is defined in UML by the way classes and methods | |
196 | are organized on disk. Some languages use this concept such that a | |
197 | class can be accessed via it's fully qualified name, (such as Java.) | |
198 | Other languages qualify names within a Namespace (such as C++) which | |
199 | result in a different package like structure. | |
200 | ||
201 | Languages which do not override this function will just search the | |
202 | stream for a tag of class 'package, and return that." | |
203 | (let ((stream (semantic-something-to-tag-table | |
204 | (or stream-or-buffer tag)))) | |
205 | (:override-with-args (tag stream)))) | |
206 | ||
207 | (defun semantic-tag-full-package-default (tag stream) | |
208 | "Default method for `semantic-tag-full-package' for TAG. | |
209 | Return the name of the first tag of class `package' in STREAM." | |
210 | (let ((pack (car-safe (semantic-find-tags-by-class 'package stream)))) | |
211 | (when (and pack (semantic-tag-p pack)) | |
212 | (semantic-tag-name pack)))) | |
213 | ||
214 | (define-overloadable-function semantic-tag-full-name (tag &optional stream-or-buffer) | |
215 | "Return the fully qualified name of TAG in the package hierarchy. | |
735135f9 | 216 | STREAM-OR-BUFFER can be anything convertible by `semantic-something-to-stream', |
62a81506 CY |
217 | but must be a toplevel semantic tag stream that contains TAG. |
218 | A Package Hierarchy is defined in UML by the way classes and methods | |
219 | are organized on disk. Some languages use this concept such that a | |
220 | class can be accessed via it's fully qualified name, (such as Java.) | |
221 | Other languages qualify names within a Namespace (such as C++) which | |
222 | result in a different package like structure. | |
223 | ||
224 | Languages which do not override this function with | |
225 | `tag-full-name' will combine `semantic-tag-full-package' and | |
226 | `semantic-tag-name', separated with language separator character. | |
227 | Override functions only need to handle STREAM-OR-BUFFER with a | |
228 | tag stream value, or nil. | |
229 | ||
230 | TODO - this function should probably also take a PARENT to TAG to | |
231 | resolve issues where a method in a class in a package is present." | |
232 | (let ((stream (semantic-something-to-tag-table | |
233 | (or stream-or-buffer tag)))) | |
234 | (:override-with-args (tag stream)))) | |
235 | ||
236 | (make-obsolete-overload 'semantic-nonterminal-full-name | |
237 | 'semantic-tag-full-name "23.2") | |
238 | ||
239 | (defun semantic-tag-full-name-default (tag stream) | |
240 | "Default method for `semantic-tag-full-name'. | |
241 | Return the name of TAG found in the toplevel STREAM." | |
242 | (let ((pack (semantic-tag-full-package tag stream)) | |
243 | (name (semantic-tag-name tag))) | |
244 | (if pack | |
245 | (concat pack | |
246 | (car semantic-type-relation-separator-character) | |
247 | name) | |
248 | name))) | |
249 | ||
f273dfc6 CY |
250 | ;;; UML features: |
251 | ;; | |
252 | ;; UML can represent several types of features of a tag | |
253 | ;; such as the `protection' of a symbol, or if it is abstract, | |
254 | ;; leaf, etc. Learn about UML to catch onto the lingo. | |
255 | ||
256 | (define-overloadable-function semantic-tag-calculate-parent (tag) | |
257 | "Attempt to calculate the parent of TAG. | |
0b381c7e | 258 | The default behavior (if not overridden with `tag-calculate-parent') |
f273dfc6 CY |
259 | is to search a buffer found with TAG, and if externally defined, |
260 | search locally, then semanticdb for that tag (when enabled.)") | |
261 | ||
262 | (defun semantic-tag-calculate-parent-default (tag) | |
263 | "Attempt to calculate the parent of TAG." | |
264 | (when (semantic-tag-in-buffer-p tag) | |
0816d744 | 265 | (with-current-buffer (semantic-tag-buffer tag) |
f273dfc6 CY |
266 | (save-excursion |
267 | (goto-char (semantic-tag-start tag)) | |
268 | (semantic-current-tag-parent)) | |
269 | ))) | |
270 | ||
271 | (define-overloadable-function semantic-tag-protection (tag &optional parent) | |
272 | "Return protection information about TAG with optional PARENT. | |
273 | This function returns on of the following symbols: | |
274 | nil - No special protection. Language dependent. | |
275 | 'public - Anyone can access this TAG. | |
276 | 'private - Only methods in the local scope can access TAG. | |
277 | 'protected - Like private for outside scopes, like public for child | |
278 | classes. | |
279 | Some languages may choose to provide additional return symbols specific | |
280 | to themselves. Use of this function should allow for this. | |
281 | ||
282 | The default behavior (if not overridden with `tag-protection' | |
283 | is to return a symbol based on type modifiers." | |
284 | (and (not parent) | |
285 | (semantic-tag-overlay tag) | |
286 | (semantic-tag-in-buffer-p tag) | |
287 | (setq parent (semantic-tag-calculate-parent tag))) | |
288 | (:override)) | |
289 | ||
290 | (make-obsolete-overload 'semantic-nonterminal-protection | |
5a916e35 | 291 | 'semantic-tag-protection "23.2") |
f273dfc6 CY |
292 | |
293 | (defun semantic-tag-protection-default (tag &optional parent) | |
294 | "Return the protection of TAG as a child of PARENT default action. | |
295 | See `semantic-tag-protection'." | |
296 | (let ((mods (semantic-tag-modifiers tag)) | |
297 | (prot nil)) | |
298 | (while (and (not prot) mods) | |
299 | (if (stringp (car mods)) | |
300 | (let ((s (car mods))) | |
301 | (setq prot | |
302 | ;; A few silly defaults to get things started. | |
303 | (cond ((or (string= s "public") | |
304 | (string= s "extern") | |
305 | (string= s "export")) | |
306 | 'public) | |
307 | ((string= s "private") | |
308 | 'private) | |
309 | ((string= s "protected") | |
62a81506 CY |
310 | 'protected) |
311 | ((string= s "package") | |
312 | 'package) | |
313 | )))) | |
f273dfc6 CY |
314 | (setq mods (cdr mods))) |
315 | prot)) | |
316 | ||
62a81506 CY |
317 | (defun semantic-tag-package-protected-p (tag &optional parent currentpackage) |
318 | "Non-nil if TAG is not available via package access control. | |
319 | For languages (such as Java) where a method is package protected, | |
320 | this method will return nil if TAG, as found in PARENT is available | |
321 | for access from a file in CURRENTPACKAGE. | |
322 | If TAG is not protected by PACKAGE, also return t. Use | |
323 | `semantic-tag-protected-p' instead. | |
324 | If PARENT is not provided, it will be derived when passed to | |
325 | `semantic-tag-protection'. | |
326 | If CURRENTPACKAGE is not provided, it will be derived from the current | |
327 | buffer." | |
328 | (let ((tagpro (semantic-tag-protection tag parent))) | |
329 | (if (not (eq tagpro 'package)) | |
330 | t ;; protected | |
331 | ||
332 | ;; package protection, so check currentpackage. | |
333 | ;; Deriving the package is better from the parent, as TAG is | |
334 | ;; probably a field or method. | |
335 | (if (not currentpackage) | |
336 | (setq currentpackage (semantic-tag-full-package nil (current-buffer)))) | |
337 | (let ((tagpack (semantic-tag-full-package (or parent tag)))) | |
338 | (if (string= currentpackage tagpack) | |
339 | nil | |
340 | t)) ))) | |
341 | ||
f273dfc6 | 342 | (defun semantic-tag-protected-p (tag protection &optional parent) |
58179cce | 343 | "Non-nil if TAG is protected. |
f273dfc6 CY |
344 | PROTECTION is a symbol which can be returned by the method |
345 | `semantic-tag-protection'. | |
346 | PARENT is the parent data type which contains TAG. | |
347 | ||
348 | For these PROTECTIONs, true is returned if TAG is: | |
349 | @table @asis | |
350 | @item nil | |
58179cce | 351 | Always true. |
f273dfc6 CY |
352 | @item private |
353 | True if nil. | |
354 | @item protected | |
355 | True if private or nil. | |
356 | @item public | |
357 | True if private, protected, or nil. | |
358 | @end table" | |
359 | (if (null protection) | |
360 | t | |
361 | (let ((tagpro (semantic-tag-protection tag parent))) | |
362 | (or (and (eq protection 'private) | |
363 | (null tagpro)) | |
364 | (and (eq protection 'protected) | |
365 | (or (null tagpro) | |
366 | (eq tagpro 'private))) | |
367 | (and (eq protection 'public) | |
368 | (not (eq tagpro 'public))))) | |
369 | )) | |
370 | ||
371 | (define-overloadable-function semantic-tag-abstract-p (tag &optional parent) | |
372 | "Return non nil if TAG is abstract. | |
373 | Optional PARENT is the parent tag of TAG. | |
374 | In UML, abstract methods and classes have special meaning and behavior | |
375 | in how methods are overridden. In UML, abstract methods are italicized. | |
376 | ||
377 | The default behavior (if not overridden with `tag-abstract-p' | |
378 | is to return true if `abstract' is in the type modifiers.") | |
379 | ||
380 | (make-obsolete-overload 'semantic-nonterminal-abstract | |
5a916e35 | 381 | 'semantic-tag-abstract-p "23.2") |
f273dfc6 CY |
382 | |
383 | (defun semantic-tag-abstract-p-default (tag &optional parent) | |
384 | "Return non-nil if TAG is abstract as a child of PARENT default action. | |
385 | See `semantic-tag-abstract-p'." | |
386 | (let ((mods (semantic-tag-modifiers tag)) | |
387 | (abs nil)) | |
388 | (while (and (not abs) mods) | |
389 | (if (stringp (car mods)) | |
390 | (setq abs (or (string= (car mods) "abstract") | |
391 | (string= (car mods) "virtual")))) | |
392 | (setq mods (cdr mods))) | |
393 | abs)) | |
394 | ||
395 | (define-overloadable-function semantic-tag-leaf-p (tag &optional parent) | |
396 | "Return non nil if TAG is leaf. | |
397 | Optional PARENT is the parent tag of TAG. | |
398 | In UML, leaf methods and classes have special meaning and behavior. | |
399 | ||
400 | The default behavior (if not overridden with `tag-leaf-p' | |
401 | is to return true if `leaf' is in the type modifiers.") | |
402 | ||
403 | (make-obsolete-overload 'semantic-nonterminal-leaf | |
5a916e35 | 404 | 'semantic-tag-leaf-p "23.2") |
f273dfc6 CY |
405 | |
406 | (defun semantic-tag-leaf-p-default (tag &optional parent) | |
407 | "Return non-nil if TAG is leaf as a child of PARENT default action. | |
408 | See `semantic-tag-leaf-p'." | |
409 | (let ((mods (semantic-tag-modifiers tag)) | |
410 | (leaf nil)) | |
411 | (while (and (not leaf) mods) | |
412 | (if (stringp (car mods)) | |
413 | ;; Use java FINAL as example default. There is none | |
414 | ;; for C/C++ | |
415 | (setq leaf (string= (car mods) "final"))) | |
416 | (setq mods (cdr mods))) | |
417 | leaf)) | |
418 | ||
419 | (define-overloadable-function semantic-tag-static-p (tag &optional parent) | |
420 | "Return non nil if TAG is static. | |
421 | Optional PARENT is the parent tag of TAG. | |
422 | In UML, static methods and attributes mean that they are allocated | |
423 | in the parent class, and are not instance specific. | |
424 | UML notation specifies that STATIC entries are underlined.") | |
425 | ||
426 | (defun semantic-tag-static-p-default (tag &optional parent) | |
427 | "Return non-nil if TAG is static as a child of PARENT default action. | |
428 | See `semantic-tag-static-p'." | |
429 | (let ((mods (semantic-tag-modifiers tag)) | |
430 | (static nil)) | |
431 | (while (and (not static) mods) | |
432 | (if (stringp (car mods)) | |
433 | (setq static (string= (car mods) "static"))) | |
434 | (setq mods (cdr mods))) | |
435 | static)) | |
436 | ||
3d9d8486 | 437 | ;;;###autoload |
f273dfc6 CY |
438 | (define-overloadable-function semantic-tag-prototype-p (tag) |
439 | "Return non nil if TAG is a prototype. | |
c80e3b4a | 440 | For some languages, such as C, a prototype is a declaration of |
f273dfc6 CY |
441 | something without an implementation." |
442 | ) | |
443 | ||
444 | (defun semantic-tag-prototype-p-default (tag) | |
445 | "Non-nil if TAG is a prototype." | |
446 | (let ((p (semantic-tag-get-attribute tag :prototype-flag))) | |
447 | (cond | |
448 | ;; Trust the parser author. | |
449 | (p p) | |
450 | ;; Empty types might be a prototype. | |
451 | ;; @todo - make this better. | |
452 | ((eq (semantic-tag-class tag) 'type) | |
453 | (not (semantic-tag-type-members tag))) | |
454 | ;; No other heuristics. | |
455 | (t nil)) | |
456 | )) | |
457 | ||
f273dfc6 CY |
458 | (provide 'semantic/tag-ls) |
459 | ||
3d9d8486 CY |
460 | ;; Local variables: |
461 | ;; generated-autoload-file: "loaddefs.el" | |
996bc9bf | 462 | ;; generated-autoload-load-name: "semantic/tag-ls" |
3d9d8486 CY |
463 | ;; End: |
464 | ||
55b522b2 | 465 | ;;; semantic/tag-ls.el ends here |