format.el 27 KB

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