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