Commit | Line | Data |
---|---|---|
978c25c6 | 1 | ;;; semantic/format.el --- Routines for formatting tags |
1bd95535 | 2 | |
9bf6c65c | 3 | ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008, |
114f9c96 | 4 | ;; 2009, 2010 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 | ;; Once a language file has been parsed into a TAG, it is often useful | |
27 | ;; then display that tag information in browsers, completion engines, or | |
28 | ;; help routines. The functions and setup in this file provide ways | |
29 | ;; to reformat a tag into different standard output types. | |
30 | ;; | |
31 | ;; In addition, macros for setting up customizable variables that let | |
32 | ;; the user choose their default format type are also provided. | |
33 | ;; | |
34 | ||
35 | ;;; Code: | |
a964f5e5 | 36 | (eval-when-compile (require 'font-lock)) |
978c25c6 | 37 | (require 'semantic) |
978c25c6 | 38 | (require 'semantic/tag-ls) |
1bd95535 CY |
39 | (require 'ezimage) |
40 | ||
a964f5e5 | 41 | (eval-when-compile (require 'semantic/find)) |
978c25c6 | 42 | |
1bd95535 CY |
43 | ;;; Tag to text overload functions |
44 | ;; | |
45 | ;; abbreviations, prototypes, and coloring support. | |
46 | (defvar semantic-format-tag-functions | |
47 | '(semantic-format-tag-name | |
48 | semantic-format-tag-canonical-name | |
49 | semantic-format-tag-abbreviate | |
50 | semantic-format-tag-summarize | |
51 | semantic-format-tag-summarize-with-file | |
52 | semantic-format-tag-short-doc | |
53 | semantic-format-tag-prototype | |
54 | semantic-format-tag-concise-prototype | |
55 | semantic-format-tag-uml-abbreviate | |
56 | semantic-format-tag-uml-prototype | |
57 | semantic-format-tag-uml-concise-prototype | |
58 | semantic-format-tag-prin1 | |
59 | ) | |
60 | "List of functions which convert a tag to text. | |
61 | Each function must take the parameters TAG &optional PARENT COLOR. | |
62 | TAG is the tag to convert. | |
63 | PARENT is a parent tag or name which refers to the structure | |
64 | or class which contains TAG. PARENT is NOT a class which a TAG | |
65 | would claim as a parent. | |
66 | COLOR indicates that the generated text should be colored using | |
67 | `font-lock'.") | |
68 | ||
1bd95535 CY |
69 | (defvar semantic-format-tag-custom-list |
70 | (append '(radio) | |
71 | (mapcar (lambda (f) (list 'const f)) | |
72 | semantic-format-tag-functions) | |
73 | '(function)) | |
9bf6c65c | 74 | "A List used by customizable variables to choose a tag to text function. |
1bd95535 CY |
75 | Use this variable in the :type field of a customizable variable.") |
76 | ||
1bd95535 CY |
77 | (defcustom semantic-format-use-images-flag ezimage-use-images |
78 | "Non-nil means semantic format functions use images. | |
79 | Images can be used as icons instead of some types of text strings." | |
80 | :group 'semantic | |
81 | :type 'boolean) | |
82 | ||
83 | (defvar semantic-function-argument-separator "," | |
84 | "Text used to separate arguments when creating text from tags.") | |
85 | (make-variable-buffer-local 'semantic-function-argument-separator) | |
86 | ||
87 | (defvar semantic-format-parent-separator "::" | |
88 | "Text used to separate names when between namespaces/classes and functions.") | |
89 | (make-variable-buffer-local 'semantic-format-parent-separator) | |
90 | ||
1bd95535 CY |
91 | (defvar semantic-format-face-alist |
92 | `( (function . font-lock-function-name-face) | |
93 | (variable . font-lock-variable-name-face) | |
94 | (type . font-lock-type-face) | |
95 | ;; These are different between Emacsen. | |
96 | (include . ,(if (featurep 'xemacs) | |
97 | 'font-lock-preprocessor-face | |
98 | 'font-lock-constant-face)) | |
99 | (package . ,(if (featurep 'xemacs) | |
100 | 'font-lock-preprocessor-face | |
101 | 'font-lock-constant-face)) | |
102 | ;; Not a tag, but instead a feature of output | |
103 | (label . font-lock-string-face) | |
104 | (comment . font-lock-comment-face) | |
105 | (keyword . font-lock-keyword-face) | |
106 | (abstract . italic) | |
107 | (static . underline) | |
108 | (documentation . font-lock-doc-face) | |
109 | ) | |
110 | "Face used to colorize tags of different types. | |
111 | Override the value locally if a language supports other tag types. | |
112 | When adding new elements, try to use symbols also returned by the parser. | |
113 | The form of an entry in this list is of the form: | |
114 | ( SYMBOL . FACE ) | |
115 | where SYMBOL is a tag type symbol used with semantic. FACE | |
116 | is a symbol representing a face. | |
117 | Faces used are generated in `font-lock' for consistency, and will not | |
118 | be used unless font lock is a feature.") | |
119 | ||
1bd95535 CY |
120 | \f |
121 | ;;; Coloring Functions | |
122 | ;; | |
123 | (defun semantic--format-colorize-text (text face-class) | |
124 | "Apply onto TEXT a color associated with FACE-CLASS. | |
b90caf50 CY |
125 | FACE-CLASS is a tag type found in `semantic-format-face-alist'. |
126 | See that variable for details on adding new types." | |
1bd95535 CY |
127 | (if (featurep 'font-lock) |
128 | (let ((face (cdr-safe (assoc face-class semantic-format-face-alist))) | |
129 | (newtext (concat text))) | |
130 | (put-text-property 0 (length text) 'face face newtext) | |
131 | newtext) | |
132 | text)) | |
133 | ||
1bd95535 CY |
134 | (defun semantic--format-colorize-merge-text (precoloredtext face-class) |
135 | "Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS. | |
b90caf50 CY |
136 | FACE-CLASS is a tag type found in `semantic-formatface-alist'. |
137 | See that variable for details on adding new types." | |
1bd95535 CY |
138 | (let ((face (cdr-safe (assoc face-class semantic-format-face-alist))) |
139 | (newtext (concat precoloredtext)) | |
140 | ) | |
141 | (if (featurep 'xemacs) | |
142 | (add-text-properties 0 (length newtext) (list 'face face) newtext) | |
143 | (alter-text-property 0 (length newtext) 'face | |
144 | (lambda (current-face) | |
145 | (let ((cf | |
146 | (cond ((facep current-face) | |
147 | (list current-face)) | |
148 | ((listp current-face) | |
149 | current-face) | |
150 | (t nil))) | |
151 | (nf | |
152 | (cond ((facep face) | |
153 | (list face)) | |
154 | ((listp face) | |
155 | face) | |
156 | (t nil)))) | |
157 | (append cf nf))) | |
158 | newtext)) | |
159 | newtext)) | |
160 | ||
161 | ;;; Function Arguments | |
162 | ;; | |
163 | (defun semantic--format-tag-arguments (args formatter color) | |
164 | "Format the argument list ARGS with FORMATTER. | |
165 | FORMATTER is a function used to format a tag. | |
166 | COLOR specifies if color should be used." | |
167 | (let ((out nil)) | |
168 | (while args | |
169 | (push (if (and formatter | |
170 | (semantic-tag-p (car args)) | |
171 | (not (string= (semantic-tag-name (car args)) "")) | |
172 | ) | |
173 | (funcall formatter (car args) nil color) | |
174 | (semantic-format-tag-name-from-anything | |
175 | (car args) nil color 'variable)) | |
176 | out) | |
177 | (setq args (cdr args))) | |
178 | (mapconcat 'identity (nreverse out) semantic-function-argument-separator) | |
179 | )) | |
180 | ||
181 | ;;; Data Type | |
182 | (define-overloadable-function semantic-format-tag-type (tag color) | |
183 | "Convert the data type of TAG to a string usable in tag formatting. | |
184 | It is presumed that TYPE is a string or semantic tag.") | |
185 | ||
186 | (defun semantic-format-tag-type-default (tag color) | |
187 | "Convert the data type of TAG to a string usable in tag formatting. | |
188 | Argument COLOR specifies to colorize the text." | |
189 | (let* ((type (semantic-tag-type tag)) | |
190 | (out (cond ((semantic-tag-p type) | |
191 | (let* ((typetype (semantic-tag-type type)) | |
192 | (name (semantic-tag-name type)) | |
193 | (str (if typetype | |
194 | (concat typetype " " name) | |
195 | name))) | |
196 | (if color | |
197 | (semantic--format-colorize-text | |
198 | str | |
199 | 'type) | |
200 | str))) | |
201 | ((and (listp type) | |
202 | (stringp (car type))) | |
203 | (car type)) | |
204 | ((stringp type) | |
205 | type) | |
206 | (t nil)))) | |
207 | (if (and color out) | |
208 | (setq out (semantic--format-colorize-text out 'type)) | |
209 | out) | |
210 | )) | |
211 | ||
212 | \f | |
213 | ;;; Abstract formatting functions | |
a964f5e5 | 214 | ;; |
1bd95535 CY |
215 | |
216 | (defun semantic-format-tag-prin1 (tag &optional parent color) | |
217 | "Convert TAG to a string that is the print name for TAG. | |
218 | PARENT and COLOR are ignored." | |
219 | (format "%S" tag)) | |
220 | ||
221 | (defun semantic-format-tag-name-from-anything (anything &optional | |
222 | parent color | |
223 | colorhint) | |
224 | "Convert just about anything into a name like string. | |
225 | Argument ANYTHING is the thing to be converted. | |
226 | Optional argument PARENT is the parent type if TAG is a detail. | |
227 | Optional argument COLOR means highlight the prototype with font-lock colors. | |
228 | Optional COLORHINT is the type of color to use if ANYTHING is not a tag | |
229 | with a tag class. See `semantic--format-colorize-text' for a definition | |
230 | of FACE-CLASS for which this is used." | |
231 | (cond ((stringp anything) | |
232 | (semantic--format-colorize-text anything colorhint)) | |
233 | ((semantic-tag-p anything) | |
234 | (let ((ans (semantic-format-tag-name anything parent color))) | |
235 | ;; If ANS is empty string or nil, then the name wasn't | |
236 | ;; supplied. The implication is as in C where there is a data | |
237 | ;; type but no name for a prototype from an include file, or | |
238 | ;; an argument just wasn't used in the body of the fcn. | |
239 | (if (or (null ans) (string= ans "")) | |
240 | (setq ans (semantic-format-tag-type anything color))) | |
241 | ans)) | |
242 | ((and (listp anything) | |
243 | (stringp (car anything))) | |
244 | (semantic--format-colorize-text (car anything) colorhint)))) | |
245 | ||
a964f5e5 CY |
246 | ;;;###autoload |
247 | (define-overloadable-function semantic-format-tag-name (tag &optional parent color) | |
248 | "Return the name string describing TAG. | |
249 | The name is the shortest possible representation. | |
250 | Optional argument PARENT is the parent type if TAG is a detail. | |
251 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
252 | ||
253 | (defun semantic-format-tag-name-default (tag &optional parent color) | |
254 | "Return an abbreviated string describing TAG. | |
255 | Optional argument PARENT is the parent type if TAG is a detail. | |
256 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
257 | (let ((name (semantic-tag-name tag)) | |
258 | (destructor | |
259 | (if (eq (semantic-tag-class tag) 'function) | |
260 | (semantic-tag-function-destructor-p tag)))) | |
261 | (when destructor | |
262 | (setq name (concat "~" name))) | |
263 | (if color | |
264 | (setq name (semantic--format-colorize-text name (semantic-tag-class tag)))) | |
265 | name)) | |
266 | ||
978c25c6 CY |
267 | (declare-function semantic-go-to-tag "semantic/tag-file") |
268 | ||
1bd95535 CY |
269 | (defun semantic--format-tag-parent-tree (tag parent) |
270 | "Under Consideration. | |
271 | ||
272 | Return a list of parents for TAG. | |
273 | PARENT is the first parent, or nil. If nil, then an attempt to | |
274 | determine PARENT is made. | |
275 | Once PARENT is identified, additional parents are looked for. | |
276 | The return list first element is the nearest parent, and the last | |
277 | item is the first parent which may be a string. The root parent may | |
278 | not be the actual first parent as there may just be a failure to find | |
279 | local definitions." | |
280 | ;; First, validate the PARENT argument. | |
281 | (unless parent | |
282 | ;; All mechanisms here must be fast as often parent | |
283 | ;; is nil because there isn't one. | |
284 | (setq parent (or (semantic-tag-function-parent tag) | |
285 | (save-excursion | |
978c25c6 | 286 | (require 'semantic/tag-file) |
1bd95535 CY |
287 | (semantic-go-to-tag tag) |
288 | (semantic-current-tag-parent))))) | |
289 | (when (stringp parent) | |
290 | (setq parent (semantic-find-first-tag-by-name | |
291 | parent (current-buffer)))) | |
292 | ;; Try and find a trail of parents from PARENT | |
293 | (let ((rlist (list parent)) | |
294 | ) | |
295 | ;; IMPLELEMENT ME!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | |
296 | (reverse rlist))) | |
297 | ||
298 | (define-overloadable-function semantic-format-tag-canonical-name (tag &optional parent color) | |
299 | "Return a canonical name for TAG. | |
300 | A canonical name includes the names of any parents or namespaces preceeding | |
301 | the tag. | |
302 | Optional argument PARENT is the parent type if TAG is a detail. | |
303 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
304 | ||
305 | (defun semantic-format-tag-canonical-name-default (tag &optional parent color) | |
306 | "Return a canonical name for TAG. | |
9bf6c65c | 307 | A canonical name includes the names of any parents or namespaces preceding |
1bd95535 CY |
308 | the tag with colons separating them. |
309 | Optional argument PARENT is the parent type if TAG is a detail. | |
310 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
311 | (let ((parent-input-str | |
312 | (if (and parent | |
313 | (semantic-tag-p parent) | |
314 | (semantic-tag-of-class-p parent 'type)) | |
315 | (concat | |
316 | ;; Choose a class of 'type as the default parent for something. | |
317 | ;; Just a guess though. | |
318 | (semantic-format-tag-name-from-anything parent nil color 'type) | |
319 | ;; Default separator between class/namespace and others. | |
320 | semantic-format-parent-separator) | |
321 | "")) | |
322 | (tag-parent-str | |
323 | (or (when (and (semantic-tag-of-class-p tag 'function) | |
324 | (semantic-tag-function-parent tag)) | |
325 | (concat (semantic-tag-function-parent tag) | |
326 | semantic-format-parent-separator)) | |
327 | "")) | |
328 | ) | |
329 | (concat parent-input-str | |
330 | tag-parent-str | |
331 | (semantic-format-tag-name tag parent color)) | |
332 | )) | |
333 | ||
334 | (define-overloadable-function semantic-format-tag-abbreviate (tag &optional parent color) | |
335 | "Return an abbreviated string describing TAG. | |
336 | The abbreviation is to be short, with possible symbols indicating | |
337 | the type of tag, or other information. | |
338 | Optional argument PARENT is the parent type if TAG is a detail. | |
339 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
340 | ||
341 | (defun semantic-format-tag-abbreviate-default (tag &optional parent color) | |
342 | "Return an abbreviated string describing TAG. | |
343 | Optional argument PARENT is a parent tag in the tag hierarchy. | |
344 | In this case PARENT refers to containment, not inheritance. | |
345 | Optional argument COLOR means highlight the prototype with font-lock colors. | |
346 | This is a simple C like default." | |
347 | ;; Do lots of complex stuff here. | |
348 | (let ((class (semantic-tag-class tag)) | |
349 | (name (semantic-format-tag-canonical-name tag parent color)) | |
350 | (suffix "") | |
351 | (prefix "") | |
352 | str) | |
353 | (cond ((eq class 'function) | |
354 | (setq suffix "()")) | |
355 | ((eq class 'include) | |
356 | (setq suffix "<>")) | |
357 | ((eq class 'variable) | |
358 | (setq suffix (if (semantic-tag-variable-default tag) | |
359 | "=" ""))) | |
360 | ((eq class 'label) | |
361 | (setq suffix ":")) | |
362 | ((eq class 'code) | |
363 | (setq prefix "{" | |
364 | suffix "}")) | |
365 | ((eq class 'type) | |
366 | (setq suffix "{}")) | |
367 | ) | |
368 | (setq str (concat prefix name suffix)) | |
369 | str)) | |
370 | ||
55b522b2 | 371 | ;;;###autoload |
1bd95535 CY |
372 | (define-overloadable-function semantic-format-tag-summarize (tag &optional parent color) |
373 | "Summarize TAG in a reasonable way. | |
374 | Optional argument PARENT is the parent type if TAG is a detail. | |
375 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
376 | ||
377 | (defun semantic-format-tag-summarize-default (tag &optional parent color) | |
378 | "Summarize TAG in a reasonable way. | |
379 | Optional argument PARENT is the parent type if TAG is a detail. | |
380 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
381 | (let* ((proto (semantic-format-tag-prototype tag nil color)) | |
a964f5e5 CY |
382 | (names (if parent |
383 | semantic-symbol->name-assoc-list-for-type-parts | |
384 | semantic-symbol->name-assoc-list)) | |
385 | (tsymb (semantic-tag-class tag)) | |
386 | (label (capitalize (or (cdr-safe (assoc tsymb names)) | |
387 | (symbol-name tsymb))))) | |
1bd95535 | 388 | (if color |
a964f5e5 | 389 | (setq label (semantic--format-colorize-text label 'label))) |
1bd95535 CY |
390 | (concat label ": " proto))) |
391 | ||
392 | (define-overloadable-function semantic-format-tag-summarize-with-file (tag &optional parent color) | |
393 | "Like `semantic-format-tag-summarize', but with the file name. | |
394 | Optional argument PARENT is the parent type if TAG is a detail. | |
395 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
396 | ||
397 | (defun semantic-format-tag-summarize-with-file-default (tag &optional parent color) | |
398 | "Summarize TAG in a reasonable way. | |
399 | Optional argument PARENT is the parent type if TAG is a detail. | |
400 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
401 | (let* ((proto (semantic-format-tag-prototype tag nil color)) | |
a964f5e5 | 402 | (file (semantic-tag-file-name tag)) |
1bd95535 CY |
403 | ) |
404 | ;; Nothing for tag? Try parent. | |
405 | (when (and (not file) (and parent)) | |
406 | (setq file (semantic-tag-file-name parent))) | |
407 | ;; Don't include the file name if we can't find one, or it is the | |
408 | ;; same as the current buffer. | |
409 | (if (or (not file) | |
410 | (string= file (buffer-file-name (current-buffer)))) | |
411 | proto | |
412 | (setq file (file-name-nondirectory file)) | |
413 | (when color | |
414 | (setq file (semantic--format-colorize-text file 'label))) | |
415 | (concat file ": " proto)))) | |
416 | ||
417 | (define-overloadable-function semantic-format-tag-short-doc (tag &optional parent color) | |
418 | "Display a short form of TAG's documentation. (Comments, or docstring.) | |
419 | Optional argument PARENT is the parent type if TAG is a detail. | |
420 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
421 | ||
978c25c6 CY |
422 | (declare-function semantic-documentation-for-tag "semantic/doc") |
423 | ||
1bd95535 CY |
424 | (defun semantic-format-tag-short-doc-default (tag &optional parent color) |
425 | "Display a short form of TAG's documentation. (Comments, or docstring.) | |
426 | Optional argument PARENT is the parent type if TAG is a detail. | |
427 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
428 | (let* ((fname (or (semantic-tag-file-name tag) | |
429 | (when parent (semantic-tag-file-name parent)))) | |
430 | (buf (or (semantic-tag-buffer tag) | |
431 | (when parent (semantic-tag-buffer parent)))) | |
432 | (doc (semantic-tag-docstring tag buf))) | |
433 | (when (and (not doc) (not buf) fname) | |
434 | ;; If there is no doc, and no buffer, but we have a filename, | |
435 | ;; lets try again. | |
1eac105a CY |
436 | (save-match-data |
437 | (setq buf (find-file-noselect fname))) | |
1bd95535 CY |
438 | (setq doc (semantic-tag-docstring tag buf))) |
439 | (when (not doc) | |
978c25c6 | 440 | (require 'semantic/doc) |
1bd95535 CY |
441 | (setq doc (semantic-documentation-for-tag tag)) |
442 | ) | |
443 | (setq doc | |
444 | (if (not doc) | |
445 | ;; No doc, use summarize. | |
446 | (semantic-format-tag-summarize tag parent color) | |
447 | ;; We have doc. Can we devise a single line? | |
448 | (if (string-match "$" doc) | |
449 | (substring doc 0 (match-beginning 0)) | |
450 | doc) | |
451 | )) | |
452 | (when color | |
453 | (setq doc (semantic--format-colorize-text doc 'documentation))) | |
454 | doc | |
455 | )) | |
456 | ||
457 | ;;; Prototype generation | |
a964f5e5 CY |
458 | ;; |
459 | ;;;###autoload | |
460 | (define-overloadable-function semantic-format-tag-prototype (tag &optional parent color) | |
461 | "Return a prototype for TAG. | |
462 | This function should be overloaded, though it need not be used. | |
463 | This is because it can be used to create code by language independent | |
464 | tools. | |
465 | Optional argument PARENT is the parent type if TAG is a detail. | |
466 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
a60f2e7b | 467 | |
1bd95535 CY |
468 | (defun semantic-format-tag-prototype-default (tag &optional parent color) |
469 | "Default method for returning a prototype for TAG. | |
470 | This will work for C like languages. | |
471 | Optional argument PARENT is the parent type if TAG is a detail. | |
472 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
473 | (let* ((class (semantic-tag-class tag)) | |
474 | (name (semantic-format-tag-name tag parent color)) | |
475 | (type (if (member class '(function variable type)) | |
476 | (semantic-format-tag-type tag color))) | |
477 | (args (if (member class '(function type)) | |
a964f5e5 CY |
478 | (semantic--format-tag-arguments |
479 | (if (eq class 'function) | |
480 | (semantic-tag-function-arguments tag) | |
1bd95535 | 481 | (list "") |
a964f5e5 | 482 | ;;(semantic-tag-type-members tag) |
1bd95535 | 483 | ) |
a964f5e5 CY |
484 | #'semantic-format-tag-prototype |
485 | color))) | |
1bd95535 CY |
486 | (const (semantic-tag-get-attribute tag :constant-flag)) |
487 | (tm (semantic-tag-get-attribute tag :typemodifiers)) | |
488 | (mods (append | |
489 | (if const '("const") nil) | |
490 | (cond ((stringp tm) (list tm)) | |
491 | ((consp tm) tm) | |
492 | (t nil)) | |
493 | )) | |
494 | (array (if (eq class 'variable) | |
495 | (let ((deref | |
496 | (semantic-tag-get-attribute | |
497 | tag :dereference)) | |
498 | (r "")) | |
499 | (while (and deref (/= deref 0)) | |
500 | (setq r (concat r "[]") | |
501 | deref (1- deref))) | |
502 | r))) | |
503 | ) | |
504 | (if args | |
505 | (setq args | |
506 | (concat " " | |
507 | (if (eq class 'type) "{" "(") | |
508 | args | |
509 | (if (eq class 'type) "}" ")")))) | |
510 | (when mods | |
511 | (setq mods (concat (mapconcat 'identity mods " ") " "))) | |
512 | (concat (or mods "") | |
513 | (if type (concat type " ")) | |
514 | name | |
515 | (or args "") | |
516 | (or array "")))) | |
517 | ||
996bc9bf | 518 | ;;;###autoload |
1bd95535 CY |
519 | (define-overloadable-function semantic-format-tag-concise-prototype (tag &optional parent color) |
520 | "Return a concise prototype for TAG. | |
521 | Optional argument PARENT is the parent type if TAG is a detail. | |
522 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
523 | ||
524 | (defun semantic-format-tag-concise-prototype-default (tag &optional parent color) | |
525 | "Return a concise prototype for TAG. | |
526 | This default function will make a cheap concise prototype using C like syntax. | |
527 | Optional argument PARENT is the parent type if TAG is a detail. | |
528 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
529 | (let ((class (semantic-tag-class tag))) | |
530 | (cond | |
531 | ((eq class 'type) | |
532 | (concat (semantic-format-tag-name tag parent color) "{}")) | |
533 | ((eq class 'function) | |
534 | (concat (semantic-format-tag-name tag parent color) | |
535 | " (" | |
536 | (semantic--format-tag-arguments | |
537 | (semantic-tag-function-arguments tag) | |
538 | 'semantic-format-tag-concise-prototype | |
539 | color) | |
540 | ")")) | |
541 | ((eq class 'variable) | |
542 | (let* ((deref (semantic-tag-get-attribute | |
a964f5e5 CY |
543 | tag :dereference)) |
544 | (array "") | |
545 | ) | |
546 | (while (and deref (/= deref 0)) | |
547 | (setq array (concat array "[]") | |
548 | deref (1- deref))) | |
549 | (concat (semantic-format-tag-name tag parent color) | |
550 | array))) | |
1bd95535 CY |
551 | (t |
552 | (semantic-format-tag-abbreviate tag parent color))))) | |
553 | ||
554 | ;;; UML display styles | |
555 | ;; | |
556 | (defcustom semantic-uml-colon-string " : " | |
557 | "*String used as a color separator between parts of a UML string. | |
558 | In UML, a variable may appear as `varname : type'. | |
559 | Change this variable to change the output separator." | |
560 | :group 'semantic | |
561 | :type 'string) | |
562 | ||
563 | (defcustom semantic-uml-no-protection-string "" | |
564 | "*String used to describe when no protection is specified. | |
565 | Used by `semantic-format-tag-uml-protection-to-string'." | |
566 | :group 'semantic | |
567 | :type 'string) | |
568 | ||
569 | (defun semantic--format-uml-post-colorize (text tag parent) | |
570 | "Add color to TEXT created from TAG and PARENT. | |
571 | Adds augmentation for `abstract' and `static' entries." | |
572 | (if (semantic-tag-abstract-p tag parent) | |
573 | (setq text (semantic--format-colorize-merge-text text 'abstract))) | |
574 | (if (semantic-tag-static-p tag parent) | |
575 | (setq text (semantic--format-colorize-merge-text text 'static))) | |
576 | text | |
577 | ) | |
578 | ||
579 | (defun semantic-uml-attribute-string (tag &optional parent) | |
580 | "Return a string for TAG, a child of PARENT representing a UML attribute. | |
581 | UML attribute strings are things like {abstract} or {leaf}." | |
582 | (cond ((semantic-tag-abstract-p tag parent) | |
583 | "{abstract}") | |
584 | ((semantic-tag-leaf-p tag parent) | |
585 | "{leaf}") | |
586 | )) | |
587 | ||
588 | (defvar semantic-format-tag-protection-image-alist | |
589 | '(("+" . ezimage-unlock) | |
590 | ("#" . ezimage-key) | |
591 | ("-" . ezimage-lock) | |
592 | ) | |
593 | "Association of protection strings, and images to use.") | |
594 | ||
595 | (defvar semantic-format-tag-protection-symbol-to-string-assoc-list | |
596 | '((public . "+") | |
597 | (protected . "#") | |
598 | (private . "-") | |
599 | ) | |
600 | "Association list of the form (SYMBOL . \"STRING\") for protection symbols. | |
601 | This associates a symbol, such as 'public with the st ring \"+\".") | |
602 | ||
603 | (define-overloadable-function semantic-format-tag-uml-protection-to-string (protection-symbol color) | |
604 | "Convert PROTECTION-SYMBOL to a string for UML. | |
605 | By default, uses `semantic-format-tag-protection-symbol-to-string-assoc-list' | |
606 | to convert. | |
607 | By defaul character returns are: | |
608 | public -- + | |
609 | private -- - | |
610 | protected -- #. | |
611 | If PROTECTION-SYMBOL is unknown, then the return value is | |
612 | `semantic-uml-no-protection-string'. | |
613 | COLOR indicates if we should use an image on the text.") | |
614 | ||
615 | (defun semantic-format-tag-uml-protection-to-string-default (protection-symbol color) | |
616 | "Convert PROTECTION-SYMBOL to a string for UML. | |
617 | Uses `semantic-format-tag-protection-symbol-to-string-assoc-list' to convert. | |
618 | If PROTECTION-SYMBOL is unknown, then the return value is | |
619 | `semantic-uml-no-protection-string'. | |
620 | COLOR indicates if we should use an image on the text." | |
621 | (let* ((ezimage-use-images (and semantic-format-use-images-flag color)) | |
622 | (key (assoc protection-symbol | |
623 | semantic-format-tag-protection-symbol-to-string-assoc-list)) | |
624 | (str (or (cdr-safe key) semantic-uml-no-protection-string))) | |
625 | (ezimage-image-over-string | |
626 | (copy-sequence str) ; make a copy to keep the original pristine. | |
627 | semantic-format-tag-protection-image-alist))) | |
628 | ||
629 | (defsubst semantic-format-tag-uml-protection (tag parent color) | |
630 | "Retrieve the protection string for TAG with PARENT. | |
631 | Argument COLOR specifies that color should be added to the string as | |
632 | needed." | |
633 | (semantic-format-tag-uml-protection-to-string | |
634 | (semantic-tag-protection tag parent) | |
635 | color)) | |
636 | ||
637 | (defun semantic--format-tag-uml-type (tag color) | |
638 | "Format the data type of TAG to a string usable for formatting. | |
639 | COLOR indicates if it should be colorized." | |
640 | (let ((str (semantic-format-tag-type tag color))) | |
641 | (if str | |
642 | (concat semantic-uml-colon-string str)))) | |
643 | ||
644 | (define-overloadable-function semantic-format-tag-uml-abbreviate (tag &optional parent color) | |
645 | "Return a UML style abbreviation for TAG. | |
646 | Optional argument PARENT is the parent type if TAG is a detail. | |
647 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
648 | ||
649 | (defun semantic-format-tag-uml-abbreviate-default (tag &optional parent color) | |
650 | "Return a UML style abbreviation for TAG. | |
651 | Optional argument PARENT is the parent type if TAG is a detail. | |
652 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
653 | (let* ((name (semantic-format-tag-name tag parent color)) | |
654 | (type (semantic--format-tag-uml-type tag color)) | |
655 | (protstr (semantic-format-tag-uml-protection tag parent color)) | |
656 | (text nil)) | |
657 | (setq text | |
658 | (concat | |
659 | protstr | |
660 | (if type (concat name type) | |
661 | name))) | |
662 | (if color | |
663 | (setq text (semantic--format-uml-post-colorize text tag parent))) | |
664 | text)) | |
665 | ||
666 | (define-overloadable-function semantic-format-tag-uml-prototype (tag &optional parent color) | |
667 | "Return a UML style prototype for TAG. | |
668 | Optional argument PARENT is the parent type if TAG is a detail. | |
669 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
670 | ||
671 | (defun semantic-format-tag-uml-prototype-default (tag &optional parent color) | |
672 | "Return a UML style prototype for TAG. | |
673 | Optional argument PARENT is the parent type if TAG is a detail. | |
674 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
675 | (let* ((class (semantic-tag-class tag)) | |
676 | (cp (semantic-format-tag-name tag parent color)) | |
677 | (type (semantic--format-tag-uml-type tag color)) | |
678 | (prot (semantic-format-tag-uml-protection tag parent color)) | |
679 | (argtext | |
680 | (cond ((eq class 'function) | |
681 | (concat | |
682 | " (" | |
683 | (semantic--format-tag-arguments | |
684 | (semantic-tag-function-arguments tag) | |
685 | #'semantic-format-tag-uml-prototype | |
686 | color) | |
687 | ")")) | |
688 | ((eq class 'type) | |
689 | "{}"))) | |
690 | (text nil)) | |
691 | (setq text (concat prot cp argtext type)) | |
692 | (if color | |
693 | (setq text (semantic--format-uml-post-colorize text tag parent))) | |
694 | text | |
695 | )) | |
696 | ||
697 | (define-overloadable-function semantic-format-tag-uml-concise-prototype (tag &optional parent color) | |
698 | "Return a UML style concise prototype for TAG. | |
699 | Optional argument PARENT is the parent type if TAG is a detail. | |
700 | Optional argument COLOR means highlight the prototype with font-lock colors.") | |
701 | ||
702 | (defun semantic-format-tag-uml-concise-prototype-default (tag &optional parent color) | |
703 | "Return a UML style concise prototype for TAG. | |
704 | Optional argument PARENT is the parent type if TAG is a detail. | |
705 | Optional argument COLOR means highlight the prototype with font-lock colors." | |
706 | (let* ((cp (semantic-format-tag-concise-prototype tag parent color)) | |
707 | (type (semantic--format-tag-uml-type tag color)) | |
708 | (prot (semantic-format-tag-uml-protection tag parent color)) | |
709 | (text nil) | |
710 | ) | |
711 | (setq text (concat prot cp type)) | |
712 | (if color | |
713 | (setq text (semantic--format-uml-post-colorize text tag parent))) | |
b90caf50 | 714 | text)) |
1bd95535 CY |
715 | |
716 | (provide 'semantic/format) | |
717 | ||
3d9d8486 CY |
718 | ;; Local variables: |
719 | ;; generated-autoload-file: "loaddefs.el" | |
996bc9bf | 720 | ;; generated-autoload-load-name: "semantic/format" |
3d9d8486 CY |
721 | ;; End: |
722 | ||
3999968a | 723 | ;; arch-tag: deae500e-20b6-437e-8856-884f6c46bc3e |
978c25c6 | 724 | ;;; semantic/format.el ends here |