mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-26 07:33:47 +00:00
Code Issues Releases Activity

(define-button-type): Respect any `supertype' property.

Browse Source 
(button-type-subtype-p, button-has-type-p): New functions.
This commit is contained in:
Miles Bader 2001-10-09 05:57:35 +00:00
parent f4be0a12f6
commit ded42dd308
2 changed files with 40 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lisp/ChangeLog
View File

@ -1,5 +1,8 @@
2001-10-09 Miles Bader <miles@gnu.org>
* 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.

51
lisp/button.el
View File

@ -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