-;;; format.el --- Routines for formatting tags
+;;; semantic/format.el --- Routines for formatting tags
-;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007,
-;;; 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2016 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
;;; Code:
(eval-when-compile (require 'font-lock))
-(require 'semantic/tag)
+(require 'semantic)
+(require 'semantic/tag-ls)
(require 'ezimage)
+(eval-when-compile (require 'semantic/find))
+
;;; Tag to text overload functions
;;
;; abbreviations, prototypes, and coloring support.
COLOR indicates that the generated text should be colored using
`font-lock'.")
-(semantic-varalias-obsolete 'semantic-token->text-functions
- 'semantic-format-tag-functions)
(defvar semantic-format-tag-custom-list
(append '(radio)
(mapcar (lambda (f) (list 'const f))
semantic-format-tag-functions)
'(function))
- "A List used by customizeable variables to choose a tag to text 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.")
-(semantic-varalias-obsolete 'semantic-token->text-custom-list
- 'semantic-format-tag-custom-list)
-
(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."
"Text used to separate names when between namespaces/classes and functions.")
(make-variable-buffer-local 'semantic-format-parent-separator)
-(defun semantic-test-all-format-tag-functions (&optional arg)
- "Test all outputs from `semantic-format-tag-functions'.
-Output is generated from the function under `point'.
-Optional argument ARG specifies not to use color."
- (interactive "P")
- (semantic-fetch-tags)
- (let* ((tag (semantic-current-tag))
- (par (semantic-current-tag-parent))
- (fns semantic-format-tag-functions))
- (with-output-to-temp-buffer "*format-tag*"
- (princ "Tag->format function tests:")
- (while fns
- (princ "\n")
- (princ (car fns))
- (princ ":\n ")
- (let ((s (funcall (car fns) tag par (not arg))))
- (save-excursion
- (set-buffer "*format-tag*")
- (goto-char (point-max))
- (insert s)))
- (setq fns (cdr fns))))
- ))
-
(defvar semantic-format-face-alist
`( (function . font-lock-function-name-face)
(variable . font-lock-variable-name-face)
Faces used are generated in `font-lock' for consistency, and will not
be used unless font lock is a feature.")
-(semantic-varalias-obsolete 'semantic-face-alist
- 'semantic-format-face-alist)
-
-
\f
;;; 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-face-alist'. See this variable
-for details on adding new types."
+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)))
newtext)
text))
-(make-obsolete 'semantic-colorize-text
- 'semantic--format-colorize-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-face-alist'. See this
-variable for details on adding new types."
+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))
)
\f
;;; Abstract formatting functions
+;;
(defun semantic-format-tag-prin1 (tag &optional parent color)
"Convert TAG to a string that is the print name for TAG.
(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.
(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.
;; 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)
;; Try and find a trail of parents from PARENT
(let ((rlist (list parent))
)
- ;; IMPLELEMENT ME!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ;; 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 preceeding
+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 preceeding
+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."
(setq str (concat prefix name suffix))
str))
-;; Semantic 1.2.x had this misspelling. Keep it for backwards compatibiity.
-(semantic-alias-obsolete
- 'semantic-summerize-nonterminal 'semantic-format-tag-summarize)
-
+;;;###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 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)))))
+ (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)))
+ (setq label (semantic--format-colorize-text label 'label)))
(concat label ": " proto)))
(define-overloadable-function semantic-format-tag-summarize-with-file (tag &optional parent color)
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))
+ (file (semantic-tag-file-name tag))
)
;; Nothing for tag? Try parent.
(when (and (not file) (and parent))
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.
(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,
- ;; lets try again.
- (setq buf (find-file-noselect fname))
+ ;; 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
;;; 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.
(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)
+ (semantic--format-tag-arguments
+ (if (eq class 'function)
+ (semantic-tag-function-arguments tag)
(list "")
- ;;(semantic-tag-type-members tag)
+ ;;(semantic-tag-type-members tag)
)
- #'semantic-format-tag-prototype
- color)))
+ #'semantic-format-tag-prototype
+ color)))
(const (semantic-tag-get-attribute tag :constant-flag))
(tm (semantic-tag-get-attribute tag :typemodifiers))
(mods (append
(setq r (concat r "[]")
deref (1- deref)))
r)))
- )
+ (default (when (eq class 'variable)
+ (let ((defval
+ (semantic-tag-get-attribute tag :default-value)))
+ (when (and defval (stringp defval))
+ (concat "[=" defval "]")))))
+ )
(if args
(setq args
(concat " "
(if type (concat type " "))
name
(or args "")
- (or array ""))))
+ (or array "")
+ (or default ""))))
+;;;###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.
")"))
((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)))
+ 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)))))
"Convert PROTECTION-SYMBOL to a string for UML.
By default, uses `semantic-format-tag-protection-symbol-to-string-assoc-list'
to convert.
-By defaul character returns are:
+By default character returns are:
public -- +
private -- -
protected -- #.
(setq text (concat prot cp type))
(if color
(setq text (semantic--format-uml-post-colorize text tag parent)))
- text
- ))
-
-\f
-;;; Compatibility and aliases
-;;
-(semantic-alias-obsolete 'semantic-prin1-nonterminal
- 'semantic-format-tag-prin1)
-
-(semantic-alias-obsolete 'semantic-name-nonterminal
- 'semantic-format-tag-name)
-
-(semantic-alias-obsolete 'semantic-abbreviate-nonterminal
- 'semantic-format-tag-abbreviate)
-
-(semantic-alias-obsolete 'semantic-summarize-nonterminal
- 'semantic-format-tag-summarize)
-
-(semantic-alias-obsolete 'semantic-prototype-nonterminal
- 'semantic-format-tag-prototype)
-
-(semantic-alias-obsolete 'semantic-concise-prototype-nonterminal
- 'semantic-format-tag-concise-prototype)
-
-(semantic-alias-obsolete 'semantic-uml-abbreviate-nonterminal
- 'semantic-format-tag-uml-abbreviate)
-
-(semantic-alias-obsolete 'semantic-uml-prototype-nonterminal
- 'semantic-format-tag-uml-prototype)
-
-(semantic-alias-obsolete 'semantic-uml-concise-prototype-nonterminal
- 'semantic-format-tag-uml-concise-prototype)
-
+ text))
(provide 'semantic/format)
-;;; semantic-format.el ends here
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; generated-autoload-load-name: "semantic/format"
+;; End:
+
+;;; semantic/format.el ends here