comparison lisp/button.el @ 40595:3ba2b666d7e1

(define-button-type): Make sure every user-defined button type has a supertype.

40594:171532c543b3

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)."
  (let* ((catsym (make-symbol (concat (symbol-name name) "-button")))
	 (supertype
	  (or (plist-get properties 'supertype)
	      (plist-get properties :supertype)))
	 (super-catsym
	  (if supertype (button-category-symbol supertype) 'default-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

    (while properties
      (let ((prop (pop properties)))
	(when (eq prop :supertype)
	  (setq prop 'supertype))
	(put catsym prop (pop properties))))
    name))

(defun button-type-put (type prop val)
  "Set the button-type TYPE's PROP property to VAL."
  (put (button-category-symbol type) prop val))

40595:3ba2b666d7e1

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)."
  (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

    (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))

(defun button-type-put (type prop val)
  "Set the button-type TYPE's PROP property to VAL."
  (put (button-category-symbol type) prop val))