Function: define-button-type
define-button-type is a byte-compiled function defined in
button.el.gz.
Signature
(define-button-type NAME &rest PROPERTIES)
Documentation
Define a button type called NAME (a symbol).
The remaining PROPERTIES arguments form a plist of PROPERTY VALUE
pairs, specifying properties to use as defaults for buttons with
this type (a button's type may be set by giving it a type
property when creating the button, using the :type keyword
argument).
In addition, the keyword argument :supertype may be used to specify a
button-type from which NAME inherits its default property values
(however, the inheritance happens only when NAME is defined; subsequent
changes to a supertype are not reflected in its subtypes).
Source Code
;; Defined in /usr/src/emacs/lisp/button.el.gz
(defun define-button-type (name &rest properties)
"Define a `button type' called NAME (a symbol).
The remaining PROPERTIES arguments form a plist of PROPERTY VALUE
pairs, specifying properties to use as defaults for buttons with
this type (a button's type may be set by giving it a `type'
property when creating the button, using the :type keyword
argument).
In addition, the keyword argument :supertype may be used to specify a
`button-type' from which NAME inherits its default property values
(however, the inheritance happens only when NAME is defined; subsequent
changes to a supertype are not reflected in its subtypes)."
(declare (indent defun))
(let ((catsym (make-symbol (concat (symbol-name name) "-button")))
(super-catsym
(button-category-symbol
(or (plist-get properties 'supertype)
(plist-get properties :supertype)
'button))))
;; Provide a link so that it's easy to find the real symbol.
(put name 'button-category-symbol catsym)
;; Initialize NAME's properties using the global defaults.
(let ((default-props (symbol-plist super-catsym)))
(while default-props
(put catsym (pop default-props) (pop default-props))))
;; Add NAME as the `type' property, which will then be returned as
;; the type property of individual buttons.
(put catsym 'type name)
;; Add the properties in PROPERTIES to the real symbol.
(while properties
(let ((prop (pop properties)))
(when (eq prop :supertype)
(setq prop 'supertype))
(put catsym prop (pop properties))))
;; Make sure there's a `supertype' property.
(unless (get catsym 'supertype)
(put catsym 'supertype 'button))
name))