123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723 |
- ;;; semantic/format.el --- Routines for formatting tags
- ;; Copyright (C) 1999-2005, 2007-2012 Free Software Foundation, Inc.
- ;; Author: Eric M. Ludlam <zappo@gnu.org>
- ;; Keywords: syntax
- ;; This file is part of GNU Emacs.
- ;; GNU Emacs is free software: you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
- ;;; Commentary:
- ;;
- ;; Once a language file has been parsed into a TAG, it is often useful
- ;; then display that tag information in browsers, completion engines, or
- ;; help routines. The functions and setup in this file provide ways
- ;; to reformat a tag into different standard output types.
- ;;
- ;; In addition, macros for setting up customizable variables that let
- ;; the user choose their default format type are also provided.
- ;;
- ;;; Code:
- (eval-when-compile (require 'font-lock))
- (require 'semantic)
- (require 'semantic/tag-ls)
- (require 'ezimage)
- (eval-when-compile (require 'semantic/find))
- ;;; Tag to text overload functions
- ;;
- ;; abbreviations, prototypes, and coloring support.
- (defvar semantic-format-tag-functions
- '(semantic-format-tag-name
- semantic-format-tag-canonical-name
- semantic-format-tag-abbreviate
- semantic-format-tag-summarize
- semantic-format-tag-summarize-with-file
- semantic-format-tag-short-doc
- semantic-format-tag-prototype
- semantic-format-tag-concise-prototype
- semantic-format-tag-uml-abbreviate
- semantic-format-tag-uml-prototype
- semantic-format-tag-uml-concise-prototype
- semantic-format-tag-prin1
- )
- "List of functions which convert a tag to text.
- Each function must take the parameters TAG &optional PARENT COLOR.
- TAG is the tag to convert.
- PARENT is a parent tag or name which refers to the structure
- or class which contains TAG. PARENT is NOT a class which a TAG
- would claim as a parent.
- COLOR indicates that the generated text should be colored using
- `font-lock'.")
- (defvar semantic-format-tag-custom-list
- (append '(radio)
- (mapcar (lambda (f) (list 'const f))
- semantic-format-tag-functions)
- '(function))
- "A List used by customizable variables to choose a tag to text function.
- Use this variable in the :type field of a customizable variable.")
- (defcustom semantic-format-use-images-flag ezimage-use-images
- "Non-nil means semantic format functions use images.
- Images can be used as icons instead of some types of text strings."
- :group 'semantic
- :type 'boolean)
- (defvar semantic-function-argument-separator ","
- "Text used to separate arguments when creating text from tags.")
- (make-variable-buffer-local 'semantic-function-argument-separator)
- (defvar semantic-format-parent-separator "::"
- "Text used to separate names when between namespaces/classes and functions.")
- (make-variable-buffer-local 'semantic-format-parent-separator)
- (defvar semantic-format-face-alist
- `( (function . font-lock-function-name-face)
- (variable . font-lock-variable-name-face)
- (type . font-lock-type-face)
- ;; These are different between Emacsen.
- (include . ,(if (featurep 'xemacs)
- 'font-lock-preprocessor-face
- 'font-lock-constant-face))
- (package . ,(if (featurep 'xemacs)
- 'font-lock-preprocessor-face
- 'font-lock-constant-face))
- ;; Not a tag, but instead a feature of output
- (label . font-lock-string-face)
- (comment . font-lock-comment-face)
- (keyword . font-lock-keyword-face)
- (abstract . italic)
- (static . underline)
- (documentation . font-lock-doc-face)
- )
- "Face used to colorize tags of different types.
- Override the value locally if a language supports other tag types.
- When adding new elements, try to use symbols also returned by the parser.
- The form of an entry in this list is of the form:
- ( SYMBOL . FACE )
- where SYMBOL is a tag type symbol used with semantic. FACE
- is a symbol representing a face.
- Faces used are generated in `font-lock' for consistency, and will not
- be used unless font lock is a feature.")
- ;;; Coloring Functions
- ;;
- (defun semantic--format-colorize-text (text face-class)
- "Apply onto TEXT a color associated with FACE-CLASS.
- FACE-CLASS is a tag type found in `semantic-format-face-alist'.
- See that variable for details on adding new types."
- (if (featurep 'font-lock)
- (let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
- (newtext (concat text)))
- (put-text-property 0 (length text) 'face face newtext)
- newtext)
- text))
- (defun semantic--format-colorize-merge-text (precoloredtext face-class)
- "Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS.
- FACE-CLASS is a tag type found in `semantic-formatface-alist'.
- See that variable for details on adding new types."
- (let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
- (newtext (concat precoloredtext))
- )
- (if (featurep 'xemacs)
- (add-text-properties 0 (length newtext) (list 'face face) newtext)
- (alter-text-property 0 (length newtext) 'face
- (lambda (current-face)
- (let ((cf
- (cond ((facep current-face)
- (list current-face))
- ((listp current-face)
- current-face)
- (t nil)))
- (nf
- (cond ((facep face)
- (list face))
- ((listp face)
- face)
- (t nil))))
- (append cf nf)))
- newtext))
- newtext))
- ;;; Function Arguments
- ;;
- (defun semantic--format-tag-arguments (args formatter color)
- "Format the argument list ARGS with FORMATTER.
- FORMATTER is a function used to format a tag.
- COLOR specifies if color should be used."
- (let ((out nil))
- (while args
- (push (if (and formatter
- (semantic-tag-p (car args))
- (not (string= (semantic-tag-name (car args)) ""))
- )
- (funcall formatter (car args) nil color)
- (semantic-format-tag-name-from-anything
- (car args) nil color 'variable))
- out)
- (setq args (cdr args)))
- (mapconcat 'identity (nreverse out) semantic-function-argument-separator)
- ))
- ;;; Data Type
- (define-overloadable-function semantic-format-tag-type (tag color)
- "Convert the data type of TAG to a string usable in tag formatting.
- It is presumed that TYPE is a string or semantic tag.")
- (defun semantic-format-tag-type-default (tag color)
- "Convert the data type of TAG to a string usable in tag formatting.
- Argument COLOR specifies to colorize the text."
- (let* ((type (semantic-tag-type tag))
- (out (cond ((semantic-tag-p type)
- (let* ((typetype (semantic-tag-type type))
- (name (semantic-tag-name type))
- (str (if typetype
- (concat typetype " " name)
- name)))
- (if color
- (semantic--format-colorize-text
- str
- 'type)
- str)))
- ((and (listp type)
- (stringp (car type)))
- (car type))
- ((stringp type)
- type)
- (t nil))))
- (if (and color out)
- (setq out (semantic--format-colorize-text out 'type))
- out)
- ))
- ;;; Abstract formatting functions
- ;;
- (defun semantic-format-tag-prin1 (tag &optional parent color)
- "Convert TAG to a string that is the print name for TAG.
- PARENT and COLOR are ignored."
- (format "%S" tag))
- (defun semantic-format-tag-name-from-anything (anything &optional
- parent color
- colorhint)
- "Convert just about anything into a name like string.
- Argument ANYTHING is the thing to be converted.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.
- Optional COLORHINT is the type of color to use if ANYTHING is not a tag
- with a tag class. See `semantic--format-colorize-text' for a definition
- of FACE-CLASS for which this is used."
- (cond ((stringp anything)
- (semantic--format-colorize-text anything colorhint))
- ((semantic-tag-p anything)
- (let ((ans (semantic-format-tag-name anything parent color)))
- ;; If ANS is empty string or nil, then the name wasn't
- ;; supplied. The implication is as in C where there is a data
- ;; type but no name for a prototype from an include file, or
- ;; an argument just wasn't used in the body of the fcn.
- (if (or (null ans) (string= ans ""))
- (setq ans (semantic-format-tag-type anything color)))
- ans))
- ((and (listp anything)
- (stringp (car anything)))
- (semantic--format-colorize-text (car anything) colorhint))))
- ;;;###autoload
- (define-overloadable-function semantic-format-tag-name (tag &optional parent color)
- "Return the name string describing TAG.
- The name is the shortest possible representation.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-name-default (tag &optional parent color)
- "Return an abbreviated string describing TAG.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let ((name (semantic-tag-name tag))
- (destructor
- (if (eq (semantic-tag-class tag) 'function)
- (semantic-tag-function-destructor-p tag))))
- (when destructor
- (setq name (concat "~" name)))
- (if color
- (setq name (semantic--format-colorize-text name (semantic-tag-class tag))))
- name))
- (declare-function semantic-go-to-tag "semantic/tag-file")
- (defun semantic--format-tag-parent-tree (tag parent)
- "Under Consideration.
- Return a list of parents for TAG.
- PARENT is the first parent, or nil. If nil, then an attempt to
- determine PARENT is made.
- Once PARENT is identified, additional parents are looked for.
- The return list first element is the nearest parent, and the last
- item is the first parent which may be a string. The root parent may
- not be the actual first parent as there may just be a failure to find
- local definitions."
- ;; First, validate the PARENT argument.
- (unless parent
- ;; All mechanisms here must be fast as often parent
- ;; is nil because there isn't one.
- (setq parent (or (semantic-tag-function-parent tag)
- (save-excursion
- (require 'semantic/tag-file)
- (semantic-go-to-tag tag)
- (semantic-current-tag-parent)))))
- (when (stringp parent)
- (setq parent (semantic-find-first-tag-by-name
- parent (current-buffer))))
- ;; Try and find a trail of parents from PARENT
- (let ((rlist (list parent))
- )
- ;; IMPLEMENT ME!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- (reverse rlist)))
- (define-overloadable-function semantic-format-tag-canonical-name (tag &optional parent color)
- "Return a canonical name for TAG.
- A canonical name includes the names of any parents or namespaces preceding
- the tag.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-canonical-name-default (tag &optional parent color)
- "Return a canonical name for TAG.
- A canonical name includes the names of any parents or namespaces preceding
- the tag with colons separating them.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let ((parent-input-str
- (if (and parent
- (semantic-tag-p parent)
- (semantic-tag-of-class-p parent 'type))
- (concat
- ;; Choose a class of 'type as the default parent for something.
- ;; Just a guess though.
- (semantic-format-tag-name-from-anything parent nil color 'type)
- ;; Default separator between class/namespace and others.
- semantic-format-parent-separator)
- ""))
- (tag-parent-str
- (or (when (and (semantic-tag-of-class-p tag 'function)
- (semantic-tag-function-parent tag))
- (concat (semantic-tag-function-parent tag)
- semantic-format-parent-separator))
- ""))
- )
- (concat parent-input-str
- tag-parent-str
- (semantic-format-tag-name tag parent color))
- ))
- (define-overloadable-function semantic-format-tag-abbreviate (tag &optional parent color)
- "Return an abbreviated string describing TAG.
- The abbreviation is to be short, with possible symbols indicating
- the type of tag, or other information.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-abbreviate-default (tag &optional parent color)
- "Return an abbreviated string describing TAG.
- Optional argument PARENT is a parent tag in the tag hierarchy.
- In this case PARENT refers to containment, not inheritance.
- Optional argument COLOR means highlight the prototype with font-lock colors.
- This is a simple C like default."
- ;; Do lots of complex stuff here.
- (let ((class (semantic-tag-class tag))
- (name (semantic-format-tag-canonical-name tag parent color))
- (suffix "")
- (prefix "")
- str)
- (cond ((eq class 'function)
- (setq suffix "()"))
- ((eq class 'include)
- (setq suffix "<>"))
- ((eq class 'variable)
- (setq suffix (if (semantic-tag-variable-default tag)
- "=" "")))
- ((eq class 'label)
- (setq suffix ":"))
- ((eq class 'code)
- (setq prefix "{"
- suffix "}"))
- ((eq class 'type)
- (setq suffix "{}"))
- )
- (setq str (concat prefix name suffix))
- str))
- ;;;###autoload
- (define-overloadable-function semantic-format-tag-summarize (tag &optional parent color)
- "Summarize TAG in a reasonable way.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-summarize-default (tag &optional parent color)
- "Summarize TAG in a reasonable way.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let* ((proto (semantic-format-tag-prototype tag nil color))
- (names (if parent
- semantic-symbol->name-assoc-list-for-type-parts
- semantic-symbol->name-assoc-list))
- (tsymb (semantic-tag-class tag))
- (label (capitalize (or (cdr-safe (assoc tsymb names))
- (symbol-name tsymb)))))
- (if color
- (setq label (semantic--format-colorize-text label 'label)))
- (concat label ": " proto)))
- (define-overloadable-function semantic-format-tag-summarize-with-file (tag &optional parent color)
- "Like `semantic-format-tag-summarize', but with the file name.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-summarize-with-file-default (tag &optional parent color)
- "Summarize TAG in a reasonable way.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let* ((proto (semantic-format-tag-prototype tag nil color))
- (file (semantic-tag-file-name tag))
- )
- ;; Nothing for tag? Try parent.
- (when (and (not file) (and parent))
- (setq file (semantic-tag-file-name parent)))
- ;; Don't include the file name if we can't find one, or it is the
- ;; same as the current buffer.
- (if (or (not file)
- (string= file (buffer-file-name (current-buffer))))
- proto
- (setq file (file-name-nondirectory file))
- (when color
- (setq file (semantic--format-colorize-text file 'label)))
- (concat file ": " proto))))
- (define-overloadable-function semantic-format-tag-short-doc (tag &optional parent color)
- "Display a short form of TAG's documentation. (Comments, or docstring.)
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (declare-function semantic-documentation-for-tag "semantic/doc")
- (defun semantic-format-tag-short-doc-default (tag &optional parent color)
- "Display a short form of TAG's documentation. (Comments, or docstring.)
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let* ((fname (or (semantic-tag-file-name tag)
- (when parent (semantic-tag-file-name parent))))
- (buf (or (semantic-tag-buffer tag)
- (when parent (semantic-tag-buffer parent))))
- (doc (semantic-tag-docstring tag buf)))
- (when (and (not doc) (not buf) fname)
- ;; If there is no doc, and no buffer, but we have a filename,
- ;; let's try again.
- (save-match-data
- (setq buf (find-file-noselect fname)))
- (setq doc (semantic-tag-docstring tag buf)))
- (when (not doc)
- (require 'semantic/doc)
- (setq doc (semantic-documentation-for-tag tag))
- )
- (setq doc
- (if (not doc)
- ;; No doc, use summarize.
- (semantic-format-tag-summarize tag parent color)
- ;; We have doc. Can we devise a single line?
- (if (string-match "$" doc)
- (substring doc 0 (match-beginning 0))
- doc)
- ))
- (when color
- (setq doc (semantic--format-colorize-text doc 'documentation)))
- doc
- ))
- ;;; Prototype generation
- ;;
- ;;;###autoload
- (define-overloadable-function semantic-format-tag-prototype (tag &optional parent color)
- "Return a prototype for TAG.
- This function should be overloaded, though it need not be used.
- This is because it can be used to create code by language independent
- tools.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-prototype-default (tag &optional parent color)
- "Default method for returning a prototype for TAG.
- This will work for C like languages.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let* ((class (semantic-tag-class tag))
- (name (semantic-format-tag-name tag parent color))
- (type (if (member class '(function variable type))
- (semantic-format-tag-type tag color)))
- (args (if (member class '(function type))
- (semantic--format-tag-arguments
- (if (eq class 'function)
- (semantic-tag-function-arguments tag)
- (list "")
- ;;(semantic-tag-type-members tag)
- )
- #'semantic-format-tag-prototype
- color)))
- (const (semantic-tag-get-attribute tag :constant-flag))
- (tm (semantic-tag-get-attribute tag :typemodifiers))
- (mods (append
- (if const '("const") nil)
- (cond ((stringp tm) (list tm))
- ((consp tm) tm)
- (t nil))
- ))
- (array (if (eq class 'variable)
- (let ((deref
- (semantic-tag-get-attribute
- tag :dereference))
- (r ""))
- (while (and deref (/= deref 0))
- (setq r (concat r "[]")
- deref (1- deref)))
- r)))
- )
- (if args
- (setq args
- (concat " "
- (if (eq class 'type) "{" "(")
- args
- (if (eq class 'type) "}" ")"))))
- (when mods
- (setq mods (concat (mapconcat 'identity mods " ") " ")))
- (concat (or mods "")
- (if type (concat type " "))
- name
- (or args "")
- (or array ""))))
- ;;;###autoload
- (define-overloadable-function semantic-format-tag-concise-prototype (tag &optional parent color)
- "Return a concise prototype for TAG.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-concise-prototype-default (tag &optional parent color)
- "Return a concise prototype for TAG.
- This default function will make a cheap concise prototype using C like syntax.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let ((class (semantic-tag-class tag)))
- (cond
- ((eq class 'type)
- (concat (semantic-format-tag-name tag parent color) "{}"))
- ((eq class 'function)
- (concat (semantic-format-tag-name tag parent color)
- " ("
- (semantic--format-tag-arguments
- (semantic-tag-function-arguments tag)
- 'semantic-format-tag-concise-prototype
- color)
- ")"))
- ((eq class 'variable)
- (let* ((deref (semantic-tag-get-attribute
- tag :dereference))
- (array "")
- )
- (while (and deref (/= deref 0))
- (setq array (concat array "[]")
- deref (1- deref)))
- (concat (semantic-format-tag-name tag parent color)
- array)))
- (t
- (semantic-format-tag-abbreviate tag parent color)))))
- ;;; UML display styles
- ;;
- (defcustom semantic-uml-colon-string " : "
- "*String used as a color separator between parts of a UML string.
- In UML, a variable may appear as `varname : type'.
- Change this variable to change the output separator."
- :group 'semantic
- :type 'string)
- (defcustom semantic-uml-no-protection-string ""
- "*String used to describe when no protection is specified.
- Used by `semantic-format-tag-uml-protection-to-string'."
- :group 'semantic
- :type 'string)
- (defun semantic--format-uml-post-colorize (text tag parent)
- "Add color to TEXT created from TAG and PARENT.
- Adds augmentation for `abstract' and `static' entries."
- (if (semantic-tag-abstract-p tag parent)
- (setq text (semantic--format-colorize-merge-text text 'abstract)))
- (if (semantic-tag-static-p tag parent)
- (setq text (semantic--format-colorize-merge-text text 'static)))
- text
- )
- (defun semantic-uml-attribute-string (tag &optional parent)
- "Return a string for TAG, a child of PARENT representing a UML attribute.
- UML attribute strings are things like {abstract} or {leaf}."
- (cond ((semantic-tag-abstract-p tag parent)
- "{abstract}")
- ((semantic-tag-leaf-p tag parent)
- "{leaf}")
- ))
- (defvar semantic-format-tag-protection-image-alist
- '(("+" . ezimage-unlock)
- ("#" . ezimage-key)
- ("-" . ezimage-lock)
- )
- "Association of protection strings, and images to use.")
- (defvar semantic-format-tag-protection-symbol-to-string-assoc-list
- '((public . "+")
- (protected . "#")
- (private . "-")
- )
- "Association list of the form (SYMBOL . \"STRING\") for protection symbols.
- This associates a symbol, such as 'public with the st ring \"+\".")
- (define-overloadable-function semantic-format-tag-uml-protection-to-string (protection-symbol color)
- "Convert PROTECTION-SYMBOL to a string for UML.
- By default, uses `semantic-format-tag-protection-symbol-to-string-assoc-list'
- to convert.
- By default character returns are:
- public -- +
- private -- -
- protected -- #.
- If PROTECTION-SYMBOL is unknown, then the return value is
- `semantic-uml-no-protection-string'.
- COLOR indicates if we should use an image on the text.")
- (defun semantic-format-tag-uml-protection-to-string-default (protection-symbol color)
- "Convert PROTECTION-SYMBOL to a string for UML.
- Uses `semantic-format-tag-protection-symbol-to-string-assoc-list' to convert.
- If PROTECTION-SYMBOL is unknown, then the return value is
- `semantic-uml-no-protection-string'.
- COLOR indicates if we should use an image on the text."
- (let* ((ezimage-use-images (and semantic-format-use-images-flag color))
- (key (assoc protection-symbol
- semantic-format-tag-protection-symbol-to-string-assoc-list))
- (str (or (cdr-safe key) semantic-uml-no-protection-string)))
- (ezimage-image-over-string
- (copy-sequence str) ; make a copy to keep the original pristine.
- semantic-format-tag-protection-image-alist)))
- (defsubst semantic-format-tag-uml-protection (tag parent color)
- "Retrieve the protection string for TAG with PARENT.
- Argument COLOR specifies that color should be added to the string as
- needed."
- (semantic-format-tag-uml-protection-to-string
- (semantic-tag-protection tag parent)
- color))
- (defun semantic--format-tag-uml-type (tag color)
- "Format the data type of TAG to a string usable for formatting.
- COLOR indicates if it should be colorized."
- (let ((str (semantic-format-tag-type tag color)))
- (if str
- (concat semantic-uml-colon-string str))))
- (define-overloadable-function semantic-format-tag-uml-abbreviate (tag &optional parent color)
- "Return a UML style abbreviation for TAG.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-uml-abbreviate-default (tag &optional parent color)
- "Return a UML style abbreviation for TAG.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let* ((name (semantic-format-tag-name tag parent color))
- (type (semantic--format-tag-uml-type tag color))
- (protstr (semantic-format-tag-uml-protection tag parent color))
- (text nil))
- (setq text
- (concat
- protstr
- (if type (concat name type)
- name)))
- (if color
- (setq text (semantic--format-uml-post-colorize text tag parent)))
- text))
- (define-overloadable-function semantic-format-tag-uml-prototype (tag &optional parent color)
- "Return a UML style prototype for TAG.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-uml-prototype-default (tag &optional parent color)
- "Return a UML style prototype for TAG.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let* ((class (semantic-tag-class tag))
- (cp (semantic-format-tag-name tag parent color))
- (type (semantic--format-tag-uml-type tag color))
- (prot (semantic-format-tag-uml-protection tag parent color))
- (argtext
- (cond ((eq class 'function)
- (concat
- " ("
- (semantic--format-tag-arguments
- (semantic-tag-function-arguments tag)
- #'semantic-format-tag-uml-prototype
- color)
- ")"))
- ((eq class 'type)
- "{}")))
- (text nil))
- (setq text (concat prot cp argtext type))
- (if color
- (setq text (semantic--format-uml-post-colorize text tag parent)))
- text
- ))
- (define-overloadable-function semantic-format-tag-uml-concise-prototype (tag &optional parent color)
- "Return a UML style concise prototype for TAG.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors.")
- (defun semantic-format-tag-uml-concise-prototype-default (tag &optional parent color)
- "Return a UML style concise prototype for TAG.
- Optional argument PARENT is the parent type if TAG is a detail.
- Optional argument COLOR means highlight the prototype with font-lock colors."
- (let* ((cp (semantic-format-tag-concise-prototype tag parent color))
- (type (semantic--format-tag-uml-type tag color))
- (prot (semantic-format-tag-uml-protection tag parent color))
- (text nil)
- )
- (setq text (concat prot cp type))
- (if color
- (setq text (semantic--format-uml-post-colorize text tag parent)))
- text))
- (provide 'semantic/format)
- ;; Local variables:
- ;; generated-autoload-file: "loaddefs.el"
- ;; generated-autoload-load-name: "semantic/format"
- ;; End:
- ;;; semantic/format.el ends here
|