Mercurial > emacs
comparison lisp/button.el @ 40595:3ba2b666d7e1
(define-button-type): Make sure every user-defined button type has a supertype.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Thu, 01 Nov 2001 06:59:32 +0000 |
parents | 57f029917c77 |
children | 4c6b45c79a59 |
comparison
equal
deleted
inserted
replaced
40594:171532c543b3 | 40595:3ba2b666d7e1 |
---|---|
119 | 119 |
120 In addition, the keyword argument :supertype may be used to specify a | 120 In addition, the keyword argument :supertype may be used to specify a |
121 button-type from which NAME inherits its default property values | 121 button-type from which NAME inherits its default property values |
122 \(however, the inheritance happens only when NAME is defined; subsequent | 122 \(however, the inheritance happens only when NAME is defined; subsequent |
123 changes to a supertype are not reflected in its subtypes)." | 123 changes to a supertype are not reflected in its subtypes)." |
124 (let* ((catsym (make-symbol (concat (symbol-name name) "-button"))) | 124 (let ((catsym (make-symbol (concat (symbol-name name) "-button"))) |
125 (supertype | 125 (super-catsym |
126 (button-category-symbol | |
126 (or (plist-get properties 'supertype) | 127 (or (plist-get properties 'supertype) |
127 (plist-get properties :supertype))) | 128 (plist-get properties :supertype) |
128 (super-catsym | 129 'button)))) |
129 (if supertype (button-category-symbol supertype) 'default-button))) | |
130 ;; Provide a link so that it's easy to find the real symbol. | 130 ;; Provide a link so that it's easy to find the real symbol. |
131 (put name 'button-category-symbol catsym) | 131 (put name 'button-category-symbol catsym) |
132 ;; Initialize NAME's properties using the global defaults. | 132 ;; Initialize NAME's properties using the global defaults. |
133 (let ((default-props (symbol-plist super-catsym))) | 133 (let ((default-props (symbol-plist super-catsym))) |
134 (while default-props | 134 (while default-props |
140 (while properties | 140 (while properties |
141 (let ((prop (pop properties))) | 141 (let ((prop (pop properties))) |
142 (when (eq prop :supertype) | 142 (when (eq prop :supertype) |
143 (setq prop 'supertype)) | 143 (setq prop 'supertype)) |
144 (put catsym prop (pop properties)))) | 144 (put catsym prop (pop properties)))) |
145 ;; Make sure there's a `supertype' property | |
146 (unless (get catsym 'supertype) | |
147 (put catsym 'supertype 'button)) | |
145 name)) | 148 name)) |
146 | 149 |
147 (defun button-type-put (type prop val) | 150 (defun button-type-put (type prop val) |
148 "Set the button-type TYPE's PROP property to VAL." | 151 "Set the button-type TYPE's PROP property to VAL." |
149 (put (button-category-symbol type) prop val)) | 152 (put (button-category-symbol type) prop val)) |