]> code.delx.au - gnu-emacs/commitdiff
*** empty log message ***
authorMiles Bader <miles@gnu.org>
Sun, 14 Oct 2001 14:34:44 +0000 (14:34 +0000)
committerMiles Bader <miles@gnu.org>
Sun, 14 Oct 2001 14:34:44 +0000 (14:34 +0000)
lisp/ChangeLog
lisp/button.el

index 21b03dc709866197b98b695adf0e89c1993e7554..8106bba371027e8c91bfde5e4c55897fdba7734c 100644 (file)
@@ -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):
index cedeab70299f367fd98ac88056cb6a1bfe1c88ff..c9f2cc4ad1769ba1c881391c599024432016a49f 100644 (file)
@@ -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)
+
 \f
 ;; 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.