From ded42dd3086a05416075ceae91972898ec889425 Mon Sep 17 00:00:00 2001 From: Miles Bader Date: Tue, 9 Oct 2001 05:57:35 +0000 Subject: [PATCH] (define-button-type): Respect any `supertype' property. (button-type-subtype-p, button-has-type-p): New functions. --- lisp/ChangeLog | 3 +++ lisp/button.el | 51 ++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 40 insertions(+), 14 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d60a1b91181..1842f047e5f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2001-10-09 Miles Bader + * button.el (define-button-type): Respect any `supertype' property. + (button-type-subtype-p, button-has-type-p): New functions. + * rfn-eshadow.el (rfn-eshadow-regexp): Deal correctly with escaped dollar-signs. diff --git a/lisp/button.el b/lisp/button.el index f18a4bfffc3..cedeab70299 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -89,22 +89,41 @@ Mode-specific keymaps may want to use this as their parent keymap.") ;; Button types (which can be used to hold default properties for buttons) +;; Because button-type properties are inherited by buttons using the +;; special `category' property (implemented by both overlays and +;; text-properties), we need to store them on a symbol to which the +;; `category' properties can point. Instead of using the symbol that's +;; the name of each button-type, however, we use a separate symbol (with +;; `-button' appended, and uninterned) to store the properties. This is +;; to avoid name clashes. + +;; [this is an internal function] +(defsubst button-category-symbol (type) + "Return the symbol used by button-type TYPE to store properties. +Buttons inherit them by setting their `category' property to that symbol." + (or (get type 'button-category-symbol) + (error "Unknown button type `%s'" type))) + ;;;###autoload (defun define-button-type (name &rest properties) "Define a `button type' called NAME. The remaining arguments form a sequence of PROPERTY VALUE pairs, specifying properties to use as defaults for buttons with this type \(a button's type may be set by giving it a `type' property when -creating the button)." - ;; We use a different symbol than NAME (with `-button' appended, and - ;; uninterned) to store the properties. This is to avoid name - ;; clashes, since many very general properties may be include in - ;; PROPERTIES. - (let ((catsym (make-symbol (concat (symbol-name name) "-button")))) +creating the button). + +The property `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 (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 'default-button))) + (let ((default-props (symbol-plist super-catsym))) (while default-props (put catsym (pop default-props) (pop default-props)))) ;; Add NAME as the `type' property, which will then be returned as @@ -115,13 +134,6 @@ creating the button)." (put catsym (pop properties) (pop properties))) name)) -;; [this is an internal function] -(defsubst button-category-symbol (type) - "Return the symbol used by button-type TYPE to store properties. -Buttons inherit them by setting their `category' property to that symbol." - (or (get type 'button-category-symbol) - (error "Unknown button type `%s'" type))) - (defun button-type-put (type prop val) "Set the button-type TYPE's PROP property to VAL." (put (button-category-symbol type) prop val)) @@ -130,6 +142,13 @@ Buttons inherit them by setting their `category' property to that symbol." "Get the property of button-type TYPE named PROP." (get (button-category-symbol type) prop)) +(defun button-type-subtype-p (type supertype) + "Return t if button-type TYPE is a subtype of SUPERTYPE." + (or (eq type supertype) + (and type + (button-type-subtype-p (button-type-get type 'supertype) + supertype)))) + ;; Button properties and other attributes @@ -192,6 +211,10 @@ the normal action is used instead." "Return BUTTON's text label." (buffer-substring-no-properties (button-start button) (button-end button))) +(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)) + ;; Creating overlay buttons -- 2.39.2