X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ded42dd3086a05416075ceae91972898ec889425..e1d290e2118242327ddc892b3f7e61cd165bf10b:/lisp/button.el diff --git a/lisp/button.el b/lisp/button.el index cedeab7029..d6f089327a 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -1,4 +1,4 @@ -;;; button.el --- Clickable buttons +;;; button.el --- clickable buttons ;; ;; Copyright (C) 2001 Free Software Foundation, Inc. ;; @@ -50,8 +50,11 @@ ;; Globals -(defface button '((t :underline t)) - "Default face used for buttons.") +(defface button '((((type pc) (class color)) + (:foreground "lightblue")) + (t :underline t)) + "Default face used for buttons." + :group 'faces) ;;;###autoload (defvar button-map @@ -86,6 +89,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) @@ -110,16 +116,18 @@ Buttons inherit them by setting their `category' property to that symbol." 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). - -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))) +creating the button, using the :type keyword argument). + +In addition, the keyword argument :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"))) + (super-catsym + (button-category-symbol + (or (plist-get properties 'supertype) + (plist-get properties :supertype) + '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. @@ -131,7 +139,13 @@ 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)))) + ;; Make sure there's a `supertype' property + (unless (get catsym 'supertype) + (put catsym 'supertype 'button)) name)) (defun button-type-put (type prop val) @@ -178,7 +192,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 +225,10 @@ 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) + "Return BUTTON's button-type." + (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)) @@ -222,9 +240,10 @@ the normal action is used instead." (defun make-button (beg end &rest properties) "Make a button from BEG to END in the current buffer. The remaining arguments form a sequence of PROPERTY VALUE pairs, -specifying properties to add to the button. In particular, the `type' -property may be used to specify a button-type from which to inherit -other properties; see `define-button-type'. +specifying properties to add to the button. +In addition, the keyword argument :type may be used to specify a +button-type from which to inherit other properties; see +`define-button-type'. Also see `make-text-button', `insert-button'." (let ((overlay (make-overlay beg end nil t nil))) @@ -243,9 +262,10 @@ Also see `make-text-button', `insert-button'." (defun insert-button (label &rest properties) "Insert a button with the label LABEL. The remaining arguments form a sequence of PROPERTY VALUE pairs, -specifying properties to add to the button. In particular, the `type' -property may be used to specify a button-type from which to inherit -other properties; see `define-button-type'. +specifying properties to add to the button. +In addition, the keyword argument :type may be used to specify a +button-type from which to inherit other properties; see +`define-button-type'. Also see `insert-text-button', `make-button'." (apply #'make-button @@ -260,9 +280,10 @@ Also see `insert-text-button', `make-button'." (defun make-text-button (beg end &rest properties) "Make a button from BEG to END in the current buffer. The remaining arguments form a sequence of PROPERTY VALUE pairs, -specifying properties to add to the button. In particular, the `type' -property may be used to specify a button-type from which to inherit -other properties; see `define-button-type'. +specifying properties to add to the button. +In addition, the keyword argument :type may be used to specify a +button-type from which to inherit other properties; see +`define-button-type'. This function is like `make-button', except that the button is actually part of the text instead of being a property of the buffer. Creating @@ -277,7 +298,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. @@ -295,9 +316,10 @@ Also see `insert-text-button'." (defun insert-text-button (label &rest properties) "Insert a button with the label LABEL. The remaining arguments form a sequence of PROPERTY VALUE pairs, -specifying properties to add to the button. In particular, the `type' -property may be used to specify a button-type from which to inherit -other properties; see `define-button-type'. +specifying properties to add to the button. +In addition, the keyword argument :type may be used to specify a +button-type from which to inherit other properties; see +`define-button-type'. This function is like `insert-button', except that the button is actually part of the text instead of being a property of the buffer.