lisp/cedet/semantic/format.el

   1 ;;; semantic/format.el --- Routines for formatting tags
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008,
   4 ;;   2009, 2010, 2011  Free Software Foundation, Inc.
   5
   6 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   7 ;; Keywords: syntax
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25 ;;
  26 ;; 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:
  36 (eval-when-compile (require 'font-lock))
  37 (require 'semantic)
  38 (require 'semantic/tag-ls)
  39 (require 'ezimage)
  40
  41 (eval-when-compile (require 'semantic/find))
  42
  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
  69 (defvar semantic-format-tag-custom-list
  70   (append '(radio)
  71           (mapcar (lambda (f) (list 'const f))
  72                   semantic-format-tag-functions)
  73           '(function))
  74   "A List used by customizable variables to choose a tag to text function.
  75 Use this variable in the :type field of a customizable variable.")
  76
  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
  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
 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.
 125 FACE-CLASS is a tag type found in `semantic-format-face-alist'.
 126 See that variable for details on adding new types."
 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
 134 (defun semantic--format-colorize-merge-text (precoloredtext face-class)
 135   "Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS.
 136 FACE-CLASS is a tag type found in `semantic-formatface-alist'.
 137 See that variable for details on adding new types."
 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
 214 ;;
 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
 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
 267 (declare-function semantic-go-to-tag "semantic/tag-file")
 268
 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
 286                        (require 'semantic/tag-file)
 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.
 307 A canonical name includes the names of any parents or namespaces preceding
 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
 371 ;;;###autoload
 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))
 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)))))
 388     (if color
 389         (setq label (semantic--format-colorize-text label 'label)))
 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))
 402          (file (semantic-tag-file-name tag))
 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
 422 (declare-function semantic-documentation-for-tag "semantic/doc")
 423
 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.
 436       (save-match-data
 437         (setq buf (find-file-noselect fname)))
 438       (setq doc (semantic-tag-docstring tag buf)))
 439     (when (not doc)
 440       (require 'semantic/doc)
 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
 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.")
 467
 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))
 478                    (semantic--format-tag-arguments
 479                     (if (eq class 'function)
 480                         (semantic-tag-function-arguments tag)
 481                       (list "")
 482                       ;;(semantic-tag-type-members tag)
 483                       )
 484                     #'semantic-format-tag-prototype
 485                     color)))
 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
 518 ;;;###autoload
 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
 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)))
 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)))
 714     text))
 715
 716 (provide 'semantic/format)
 717
 718 ;; Local variables:
 719 ;; generated-autoload-file: "loaddefs.el"
 720 ;; generated-autoload-load-name: "semantic/format"
 721 ;; End:
 722
 723 ;;; semantic/format.el ends here