Function: define-semantic-decoration-style

define-semantic-decoration-style is a macro defined in mode.el.gz.

Signature

(define-semantic-decoration-style NAME DOC &rest FLAGS)

Documentation

Define a new decoration style with NAME.

DOC is a documentation string describing the decoration style NAME. It is appended to auto-generated doc strings. An optional list of FLAGS can also be specified. Flags are:
  :enabled <value> - specify the default enabled value for NAME.
  :load <value> - specify a feature (as a string) with the rest of
                      the definition for decoration mode NAME.

This defines two new overload functions respectively called NAME-p and NAME-highlight, for which you must provide a default implementation in respectively the functions NAME-p-default and NAME-highlight-default. Those functions are passed a tag. NAME-p must return non-nil to indicate that the tag should be decorated by NAME-highlight.

To put primary decorations on a tag NAME-highlight must use functions like semantic-set-tag-face, semantic-set-tag-read-only, etc., found in the semantic-decorate library.

To add other kind of decorations on a tag, NAME-highlight must use semantic-decorate-tag, and other functions of the semantic decoration API found in this library.

Source Code

;; Defined in /usr/src/emacs/lisp/cedet/semantic/decorate/mode.el.gz
;;; Defining decoration styles
;;
(defmacro define-semantic-decoration-style (name doc &rest flags)
  "Define a new decoration style with NAME.
DOC is a documentation string describing the decoration style NAME.
It is appended to auto-generated doc strings.
An optional list of FLAGS can also be specified.  Flags are:
  :enabled <value>  - specify the default enabled value for NAME.
  :load <value>     - specify a feature (as a string) with the rest of
                      the definition for decoration mode NAME.

This defines two new overload functions respectively called `NAME-p'
and `NAME-highlight', for which you must provide a default
implementation in respectively the functions `NAME-p-default' and
`NAME-highlight-default'.  Those functions are passed a tag.  `NAME-p'
must return non-nil to indicate that the tag should be decorated by
`NAME-highlight'.

To put primary decorations on a tag `NAME-highlight' must use
functions like `semantic-set-tag-face', `semantic-set-tag-read-only',
etc., found in the semantic-decorate library.

To add other kind of decorations on a tag, `NAME-highlight' must use
`semantic-decorate-tag', and other functions of the semantic
decoration API found in this library."
  (let ((predicate   (semantic-decorate-style-predicate   name))
        (highlighter (semantic-decorate-style-highlighter name))
	(predicatedef   (semantic-decorate-style-predicate-default   name))
	(highlighterdef (semantic-decorate-style-highlighter-default name))
	(defaultenable (if (plist-member flags :enabled)
			   (plist-get flags :enabled)
			 t))
	(loadfile (if (plist-member flags :load)
		      (plist-get flags :load)
		    nil))
	)
    `(progn
       ;; Clear the menu cache so that new items are added when
       ;; needed.
       (setq semantic-decoration-menu-cache nil)
       ;; Create an override method to specify if a given tag belongs
       ;; to this type of decoration
       (define-overloadable-function ,predicate (tag)
         ,(concat
           (internal--format-docstring-line
            "Return non-nil to decorate TAG with `%s' style."
            name)
           "\n" doc))
       ;; Create an override method that will perform the highlight
       ;; operation if the -p method returns non-nil.
       (define-overloadable-function ,highlighter (tag)
         ,(format "Decorate TAG with `%s' style.\n%s"
                  name doc))
       ;; Add this to the list of primary decoration modes.
       (add-to-list 'semantic-decoration-styles
                    (cons ',(symbol-name name)
			  ,defaultenable))
       ;; If there is a load file, then create the autoload tokens for
       ;; those functions to load the token, but only if the fsym
       ;; doesn't exist yet.
       (when (stringp ,loadfile)
	 (unless (fboundp ',predicatedef)
	   (autoload ',predicatedef ',loadfile "Return non-nil to decorate TAG."
	     ))

	 (unless (fboundp ',highlighterdef)
	   (autoload ',highlighterdef ',loadfile "Decorate TAG."))
	 ))
    ))