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