Mercurial > emacs
changeset 39916:5827976776b9
*** empty log message ***
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Sun, 14 Oct 2001 14:34:44 +0000 |
| parents | 206186afb551 |
| children | eb6a85173992 |
| files | lisp/ChangeLog lisp/button.el |
| diffstat | 2 files changed, 24 insertions(+), 4 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Oct 14 10:36:32 2001 +0000 +++ b/lisp/ChangeLog Sun Oct 14 14:34:44 2001 +0000 @@ -1,3 +1,12 @@ +2001-10-14 Miles Bader <miles@gnu.org> + + * button.el (define-button-type): Allow supertype property to be + specified with a keyword `:supertype' too. + (button-put, make-text-button): Allow button type property to be + specified using the keyword `:type' too. + (button-type): New function. + (button): Add `button-category-symbol' property. + 2001-10-13 Stefan Monnier <monnier@cs.yale.edu> * textmodes/refill.el (refill-mode):
--- a/lisp/button.el Sun Oct 14 10:36:32 2001 +0000 +++ b/lisp/button.el Sun Oct 14 14:34:44 2001 +0000 @@ -86,6 +86,9 @@ ;; they inherit this. (put 'default-button 'button t) +;; A `category-symbol' property for the default button type +(put 'button 'button-category-symbol 'default-button) + ;; Button types (which can be used to hold default properties for buttons) @@ -117,7 +120,9 @@ 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 (plist-get properties 'supertype)) + (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. @@ -131,7 +136,10 @@ (put catsym 'type name) ;; Add the properties in PROPERTIES to the real symbol. (while properties - (put catsym (pop properties) (pop 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) @@ -178,7 +186,7 @@ (defun button-put (button prop val) "Set BUTTON's PROP property to VAL." ;; Treat some properties specially. - (cond ((eq prop 'type) + (cond ((memq prop '(type :type)) ;; We translate a `type' property a `category' property, since ;; that's what's actually used by overlays/text-properties for ;; inheriting properties. @@ -211,6 +219,9 @@ "Return BUTTON's text label." (buffer-substring-no-properties (button-start button) (button-end button))) +(defsubst button-type (button) + (button-get button 'type)) + (defun button-has-type-p (button type) "Return t if BUTTON has button-type TYPE, or one of TYPE's subtypes." (button-type-subtype-p (button-get button 'type) type)) @@ -277,7 +288,7 @@ ;; Note that all the following code is basically equivalent to ;; `button-put', but we can do it much more efficiently since we ;; already have BEG and END. - (cond ((eq prop 'type) + (cond ((memq prop '(type :type)) ;; We translate a `type' property into a `category' ;; property, since that's what's actually used by ;; text-properties for inheritance.