Commit 530893b2 authored by Miles Bader's avatar Miles Bader
Browse files

*** empty log message ***

parent 228299fa
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):
......
......@@ -86,6 +86,9 @@ Mode-specific keymaps may want to use this as their parent keymap.")
;; 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 @@ 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 (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 @@ not reflected in its subtypes)."
(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 @@ not reflected in its subtypes)."
(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 @@ the normal action is used instead."
"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 @@ Also see `insert-text-button'."
;; 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.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment