Convert consecutive FSF copyright years to ranges.
[bpt/emacs.git] / lisp / cedet / semantic / format.el
CommitLineData
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.
60Each function must take the parameters TAG &optional PARENT COLOR.
61TAG is the tag to convert.
62PARENT is a parent tag or name which refers to the structure
63or class which contains TAG. PARENT is NOT a class which a TAG
64would claim as a parent.
65COLOR 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
74Use 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.
78Images 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.
110Override the value locally if a language supports other tag types.
111When adding new elements, try to use symbols also returned by the parser.
112The form of an entry in this list is of the form:
113 ( SYMBOL . FACE )
114where SYMBOL is a tag type symbol used with semantic. FACE
115is a symbol representing a face.
116Faces used are generated in `font-lock' for consistency, and will not
117be 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
124FACE-CLASS is a tag type found in `semantic-format-face-alist'.
125See 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
135FACE-CLASS is a tag type found in `semantic-formatface-alist'.
136See 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.
164FORMATTER is a function used to format a tag.
165COLOR 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.
183It 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.
187Argument 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.
217PARENT 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.
224Argument ANYTHING is the thing to be converted.
225Optional argument PARENT is the parent type if TAG is a detail.
226Optional argument COLOR means highlight the prototype with font-lock colors.
227Optional COLORHINT is the type of color to use if ANYTHING is not a tag
228with a tag class. See `semantic--format-colorize-text' for a definition
229of 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.
248The name is the shortest possible representation.
249Optional argument PARENT is the parent type if TAG is a detail.
250Optional 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.
254Optional argument PARENT is the parent type if TAG is a detail.
255Optional 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
271Return a list of parents for TAG.
272PARENT is the first parent, or nil. If nil, then an attempt to
273determine PARENT is made.
274Once PARENT is identified, additional parents are looked for.
275The return list first element is the nearest parent, and the last
276item is the first parent which may be a string. The root parent may
277not be the actual first parent as there may just be a failure to find
278local 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.
299A canonical name includes the names of any parents or namespaces preceeding
300the tag.
301Optional argument PARENT is the parent type if TAG is a detail.
302Optional 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 306A canonical name includes the names of any parents or namespaces preceding
1bd95535
CY
307the tag with colons separating them.
308Optional argument PARENT is the parent type if TAG is a detail.
309Optional 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.
335The abbreviation is to be short, with possible symbols indicating
336the type of tag, or other information.
337Optional argument PARENT is the parent type if TAG is a detail.
338Optional 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.
342Optional argument PARENT is a parent tag in the tag hierarchy.
343In this case PARENT refers to containment, not inheritance.
344Optional argument COLOR means highlight the prototype with font-lock colors.
345This 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.
373Optional argument PARENT is the parent type if TAG is a detail.
374Optional 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.
378Optional argument PARENT is the parent type if TAG is a detail.
379Optional 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.
393Optional argument PARENT is the parent type if TAG is a detail.
394Optional 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.
398Optional argument PARENT is the parent type if TAG is a detail.
399Optional 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.)
418Optional argument PARENT is the parent type if TAG is a detail.
419Optional 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.)
425Optional argument PARENT is the parent type if TAG is a detail.
426Optional 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.
461This function should be overloaded, though it need not be used.
462This is because it can be used to create code by language independent
463tools.
464Optional argument PARENT is the parent type if TAG is a detail.
465Optional 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.
469This will work for C like languages.
470Optional argument PARENT is the parent type if TAG is a detail.
471Optional 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.
520Optional argument PARENT is the parent type if TAG is a detail.
521Optional 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.
525This default function will make a cheap concise prototype using C like syntax.
526Optional argument PARENT is the parent type if TAG is a detail.
527Optional 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.
557In UML, a variable may appear as `varname : type'.
558Change 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.
564Used 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.
570Adds 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.
580UML 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.
600This 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.
604By default, uses `semantic-format-tag-protection-symbol-to-string-assoc-list'
605to convert.
606By defaul character returns are:
607 public -- +
608 private -- -
609 protected -- #.
610If PROTECTION-SYMBOL is unknown, then the return value is
611`semantic-uml-no-protection-string'.
612COLOR 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.
616Uses `semantic-format-tag-protection-symbol-to-string-assoc-list' to convert.
617If PROTECTION-SYMBOL is unknown, then the return value is
618`semantic-uml-no-protection-string'.
619COLOR 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.
630Argument COLOR specifies that color should be added to the string as
631needed."
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.
638COLOR 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.
645Optional argument PARENT is the parent type if TAG is a detail.
646Optional 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.
650Optional argument PARENT is the parent type if TAG is a detail.
651Optional 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.
667Optional argument PARENT is the parent type if TAG is a detail.
668Optional 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.
672Optional argument PARENT is the parent type if TAG is a detail.
673Optional 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.
698Optional argument PARENT is the parent type if TAG is a detail.
699Optional 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.
703Optional argument PARENT is the parent type if TAG is a detail.
704Optional 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