diff options
| author | Basil L. Contovounesios | 2019-10-01 02:22:31 +0100 |
|---|---|---|
| committer | Basil L. Contovounesios | 2019-10-03 23:04:56 +0100 |
| commit | 660d509acd9da23d9795b5aaa12a5453e6c61bbd (patch) | |
| tree | 4fd424981445285c7d55894aef5cb7ebee7599f8 | |
| parent | f12fcdf4cd878b7b3f1221c5818fe221cb339724 (diff) | |
| download | emacs-660d509acd9da23d9795b5aaa12a5453e6c61bbd.tar.gz emacs-660d509acd9da23d9795b5aaa12a5453e6c61bbd.zip | |
Use lexical-binding in button.el
* lisp/button.el: Use lexical-binding. Expand Keywords header.
Quote function symbols as such. Use ;;;-comments where appropriate.
(button): Remove outdated commentary of defface.
(define-button-type, make-button, insert-button, make-text-button)
(insert-text-button): Clarify in docstring that PROPERTIES argument
is a plist.
(button-type-subtype-p, button-has-type-p): Do not overspecify
return value in docstring.
(button-put): Fix typo in commentary.
| -rw-r--r-- | lisp/button.el | 62 |
1 files changed, 29 insertions, 33 deletions
diff --git a/lisp/button.el b/lisp/button.el index 9112e518b0d..32efc2f95be 100644 --- a/lisp/button.el +++ b/lisp/button.el | |||
| @@ -1,9 +1,9 @@ | |||
| 1 | ;;; button.el --- clickable buttons | 1 | ;;; button.el --- clickable buttons -*- lexical-binding: t -*- |
| 2 | ;; | 2 | ;; |
| 3 | ;; Copyright (C) 2001-2019 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001-2019 Free Software Foundation, Inc. |
| 4 | ;; | 4 | ;; |
| 5 | ;; Author: Miles Bader <miles@gnu.org> | 5 | ;; Author: Miles Bader <miles@gnu.org> |
| 6 | ;; Keywords: extensions | 6 | ;; Keywords: extensions, hypermedia |
| 7 | ;; Package: emacs | 7 | ;; Package: emacs |
| 8 | ;; | 8 | ;; |
| 9 | ;; This file is part of GNU Emacs. | 9 | ;; This file is part of GNU Emacs. |
| @@ -49,11 +49,8 @@ | |||
| 49 | ;;; Code: | 49 | ;;; Code: |
| 50 | 50 | ||
| 51 | 51 | ||
| 52 | ;; Globals | 52 | ;;; Globals |
| 53 | 53 | ||
| 54 | ;; Use color for the MS-DOS port because it doesn't support underline. | ||
| 55 | ;; FIXME if MS-DOS correctly answers the (supports) question, it need | ||
| 56 | ;; no longer be a special case. | ||
| 57 | (defface button '((t :inherit link)) | 54 | (defface button '((t :inherit link)) |
| 58 | "Default face used for buttons." | 55 | "Default face used for buttons." |
| 59 | :group 'basic-faces) | 56 | :group 'basic-faces) |
| @@ -81,25 +78,25 @@ | |||
| 81 | "Keymap useful for buffers containing buttons. | 78 | "Keymap useful for buffers containing buttons. |
| 82 | Mode-specific keymaps may want to use this as their parent keymap.") | 79 | Mode-specific keymaps may want to use this as their parent keymap.") |
| 83 | 80 | ||
| 84 | ;; Default properties for buttons | 81 | ;; Default properties for buttons. |
| 85 | (put 'default-button 'face 'button) | 82 | (put 'default-button 'face 'button) |
| 86 | (put 'default-button 'mouse-face 'highlight) | 83 | (put 'default-button 'mouse-face 'highlight) |
| 87 | (put 'default-button 'keymap button-map) | 84 | (put 'default-button 'keymap button-map) |
| 88 | (put 'default-button 'type 'button) | 85 | (put 'default-button 'type 'button) |
| 89 | ;; action may be either a function to call, or a marker to go to | 86 | ;; `action' may be either a function to call, or a marker to go to. |
| 90 | (put 'default-button 'action 'ignore) | 87 | (put 'default-button 'action #'ignore) |
| 91 | (put 'default-button 'help-echo (purecopy "mouse-2, RET: Push this button")) | 88 | (put 'default-button 'help-echo (purecopy "mouse-2, RET: Push this button")) |
| 92 | ;; Make overlay buttons go away if their underlying text is deleted. | 89 | ;; Make overlay buttons go away if their underlying text is deleted. |
| 93 | (put 'default-button 'evaporate t) | 90 | (put 'default-button 'evaporate t) |
| 94 | ;; Prevent insertions adjacent to the text-property buttons from | 91 | ;; Prevent insertions adjacent to text-property buttons from |
| 95 | ;; inheriting its properties. | 92 | ;; inheriting their properties. |
| 96 | (put 'default-button 'rear-nonsticky t) | 93 | (put 'default-button 'rear-nonsticky t) |
| 97 | 94 | ||
| 98 | ;; A `category-symbol' property for the default button type | 95 | ;; A `category-symbol' property for the default button type. |
| 99 | (put 'button 'button-category-symbol 'default-button) | 96 | (put 'button 'button-category-symbol 'default-button) |
| 100 | 97 | ||
| 101 | 98 | ||
| 102 | ;; Button types (which can be used to hold default properties for buttons) | 99 | ;;; Button types (which can be used to hold default properties for buttons) |
| 103 | 100 | ||
| 104 | ;; Because button-type properties are inherited by buttons using the | 101 | ;; Because button-type properties are inherited by buttons using the |
| 105 | ;; special `category' property (implemented by both overlays and | 102 | ;; special `category' property (implemented by both overlays and |
| @@ -118,7 +115,7 @@ Buttons inherit them by setting their `category' property to that symbol." | |||
| 118 | 115 | ||
| 119 | (defun define-button-type (name &rest properties) | 116 | (defun define-button-type (name &rest properties) |
| 120 | "Define a `button type' called NAME (a symbol). | 117 | "Define a `button type' called NAME (a symbol). |
| 121 | The remaining arguments form a sequence of PROPERTY VALUE pairs, | 118 | The remaining arguments form a plist of PROPERTY VALUE pairs, |
| 122 | specifying properties to use as defaults for buttons with this type | 119 | specifying properties to use as defaults for buttons with this type |
| 123 | \(a button's type may be set by giving it a `type' property when | 120 | \(a button's type may be set by giving it a `type' property when |
| 124 | creating the button, using the :type keyword argument). | 121 | creating the button, using the :type keyword argument). |
| @@ -148,7 +145,7 @@ changes to a supertype are not reflected in its subtypes)." | |||
| 148 | (when (eq prop :supertype) | 145 | (when (eq prop :supertype) |
| 149 | (setq prop 'supertype)) | 146 | (setq prop 'supertype)) |
| 150 | (put catsym prop (pop properties)))) | 147 | (put catsym prop (pop properties)))) |
| 151 | ;; Make sure there's a `supertype' property | 148 | ;; Make sure there's a `supertype' property. |
| 152 | (unless (get catsym 'supertype) | 149 | (unless (get catsym 'supertype) |
| 153 | (put catsym 'supertype 'button)) | 150 | (put catsym 'supertype 'button)) |
| 154 | name)) | 151 | name)) |
| @@ -162,14 +159,14 @@ changes to a supertype are not reflected in its subtypes)." | |||
| 162 | (get (button-category-symbol type) prop)) | 159 | (get (button-category-symbol type) prop)) |
| 163 | 160 | ||
| 164 | (defun button-type-subtype-p (type supertype) | 161 | (defun button-type-subtype-p (type supertype) |
| 165 | "Return t if button-type TYPE is a subtype of SUPERTYPE." | 162 | "Return non-nil if button-type TYPE is a subtype of SUPERTYPE." |
| 166 | (or (eq type supertype) | 163 | (or (eq type supertype) |
| 167 | (and type | 164 | (and type |
| 168 | (button-type-subtype-p (button-type-get type 'supertype) | 165 | (button-type-subtype-p (button-type-get type 'supertype) |
| 169 | supertype)))) | 166 | supertype)))) |
| 170 | 167 | ||
| 171 | 168 | ||
| 172 | ;; Button properties and other attributes | 169 | ;;; Button properties and other attributes |
| 173 | 170 | ||
| 174 | (defun button-start (button) | 171 | (defun button-start (button) |
| 175 | "Return the position at which BUTTON starts." | 172 | "Return the position at which BUTTON starts." |
| @@ -203,9 +200,9 @@ changes to a supertype are not reflected in its subtypes)." | |||
| 203 | "Set BUTTON's PROP property to VAL." | 200 | "Set BUTTON's PROP property to VAL." |
| 204 | ;; Treat some properties specially. | 201 | ;; Treat some properties specially. |
| 205 | (cond ((memq prop '(type :type)) | 202 | (cond ((memq prop '(type :type)) |
| 206 | ;; We translate a `type' property a `category' property, since | 203 | ;; We translate a `type' property to a `category' property, |
| 207 | ;; that's what's actually used by overlays/text-properties for | 204 | ;; since that's what's actually used by overlay and |
| 208 | ;; inheriting properties. | 205 | ;; text-property buttons for inheriting properties. |
| 209 | (setq prop 'category) | 206 | (setq prop 'category) |
| 210 | (setq val (button-category-symbol val))) | 207 | (setq val (button-category-symbol val))) |
| 211 | ((eq prop 'category) | 208 | ((eq prop 'category) |
| @@ -261,7 +258,7 @@ value instad of BUTTON." | |||
| 261 | (button-get button 'type)) | 258 | (button-get button 'type)) |
| 262 | 259 | ||
| 263 | (defun button-has-type-p (button type) | 260 | (defun button-has-type-p (button type) |
| 264 | "Return t if BUTTON has button-type TYPE, or one of TYPE's subtypes." | 261 | "Return non-nil if BUTTON has button-type TYPE, or one of its subtypes." |
| 265 | (button-type-subtype-p (button-get button 'type) type)) | 262 | (button-type-subtype-p (button-get button 'type) type)) |
| 266 | 263 | ||
| 267 | (defun button--area-button-p (b) | 264 | (defun button--area-button-p (b) |
| @@ -272,11 +269,11 @@ Such area buttons are used for buttons in the mode-line and header-line." | |||
| 272 | (defalias 'button--area-button-string #'car | 269 | (defalias 'button--area-button-string #'car |
| 273 | "Return area button BUTTON's button-string.") | 270 | "Return area button BUTTON's button-string.") |
| 274 | 271 | ||
| 275 | ;; Creating overlay buttons | 272 | ;;; Creating overlay buttons |
| 276 | 273 | ||
| 277 | (defun make-button (beg end &rest properties) | 274 | (defun make-button (beg end &rest properties) |
| 278 | "Make a button from BEG to END in the current buffer. | 275 | "Make a button from BEG to END in the current buffer. |
| 279 | The remaining arguments form a sequence of PROPERTY VALUE pairs, | 276 | The remaining arguments form a plist of PROPERTY VALUE pairs, |
| 280 | specifying properties to add to the button. | 277 | specifying properties to add to the button. |
| 281 | In addition, the keyword argument :type may be used to specify a | 278 | In addition, the keyword argument :type may be used to specify a |
| 282 | button-type from which to inherit other properties; see | 279 | button-type from which to inherit other properties; see |
| @@ -292,12 +289,12 @@ Also see `make-text-button', `insert-button'." | |||
| 292 | ;; If the user didn't specify a type, use the default. | 289 | ;; If the user didn't specify a type, use the default. |
| 293 | (unless (overlay-get overlay 'category) | 290 | (unless (overlay-get overlay 'category) |
| 294 | (overlay-put overlay 'category 'default-button)) | 291 | (overlay-put overlay 'category 'default-button)) |
| 295 | ;; OVERLAY is the button, so return it | 292 | ;; OVERLAY is the button, so return it. |
| 296 | overlay)) | 293 | overlay)) |
| 297 | 294 | ||
| 298 | (defun insert-button (label &rest properties) | 295 | (defun insert-button (label &rest properties) |
| 299 | "Insert a button with the label LABEL. | 296 | "Insert a button with the label LABEL. |
| 300 | The remaining arguments form a sequence of PROPERTY VALUE pairs, | 297 | The remaining arguments form a plist of PROPERTY VALUE pairs, |
| 301 | specifying properties to add to the button. | 298 | specifying properties to add to the button. |
| 302 | In addition, the keyword argument :type may be used to specify a | 299 | In addition, the keyword argument :type may be used to specify a |
| 303 | button-type from which to inherit other properties; see | 300 | button-type from which to inherit other properties; see |
| @@ -310,11 +307,11 @@ Also see `insert-text-button', `make-button'." | |||
| 310 | properties)) | 307 | properties)) |
| 311 | 308 | ||
| 312 | 309 | ||
| 313 | ;; Creating text-property buttons | 310 | ;;; Creating text-property buttons |
| 314 | 311 | ||
| 315 | (defun make-text-button (beg end &rest properties) | 312 | (defun make-text-button (beg end &rest properties) |
| 316 | "Make a button from BEG to END in the current buffer. | 313 | "Make a button from BEG to END in the current buffer. |
| 317 | The remaining arguments form a sequence of PROPERTY VALUE pairs, | 314 | The remaining arguments form a plist of PROPERTY VALUE pairs, |
| 318 | specifying properties to add to the button. | 315 | specifying properties to add to the button. |
| 319 | In addition, the keyword argument :type may be used to specify a | 316 | In addition, the keyword argument :type may be used to specify a |
| 320 | button-type from which to inherit other properties; see | 317 | button-type from which to inherit other properties; see |
| @@ -352,8 +349,8 @@ Also see `insert-text-button'." | |||
| 352 | ;; text-properties for inheritance. | 349 | ;; text-properties for inheritance. |
| 353 | (setcar type-entry 'category) | 350 | (setcar type-entry 'category) |
| 354 | (setcar (cdr type-entry) | 351 | (setcar (cdr type-entry) |
| 355 | (button-category-symbol (car (cdr type-entry))))) | 352 | (button-category-symbol (cadr type-entry)))) |
| 356 | ;; Now add all the text properties at once | 353 | ;; Now add all the text properties at once. |
| 357 | (add-text-properties beg end | 354 | (add-text-properties beg end |
| 358 | ;; Each button should have a non-eq `button' | 355 | ;; Each button should have a non-eq `button' |
| 359 | ;; property so that next-single-property-change can | 356 | ;; property so that next-single-property-change can |
| @@ -365,7 +362,7 @@ Also see `insert-text-button'." | |||
| 365 | 362 | ||
| 366 | (defun insert-text-button (label &rest properties) | 363 | (defun insert-text-button (label &rest properties) |
| 367 | "Insert a button with the label LABEL. | 364 | "Insert a button with the label LABEL. |
| 368 | The remaining arguments form a sequence of PROPERTY VALUE pairs, | 365 | The remaining arguments form a plist of PROPERTY VALUE pairs, |
| 369 | specifying properties to add to the button. | 366 | specifying properties to add to the button. |
| 370 | In addition, the keyword argument :type may be used to specify a | 367 | In addition, the keyword argument :type may be used to specify a |
| 371 | button-type from which to inherit other properties; see | 368 | button-type from which to inherit other properties; see |
| @@ -383,7 +380,7 @@ Also see `make-text-button'." | |||
| 383 | properties)) | 380 | properties)) |
| 384 | 381 | ||
| 385 | 382 | ||
| 386 | ;; Finding buttons in a buffer | 383 | ;;; Finding buttons in a buffer |
| 387 | 384 | ||
| 388 | (defun button-at (pos) | 385 | (defun button-at (pos) |
| 389 | "Return the button at position POS in the current buffer, or nil. | 386 | "Return the button at position POS in the current buffer, or nil. |
| @@ -436,7 +433,7 @@ instead of starting at the next button." | |||
| 436 | (button-at (1- pos))))))) | 433 | (button-at (1- pos))))))) |
| 437 | 434 | ||
| 438 | 435 | ||
| 439 | ;; User commands | 436 | ;;; User commands |
| 440 | 437 | ||
| 441 | (defun push-button (&optional pos use-mouse-action) | 438 | (defun push-button (&optional pos use-mouse-action) |
| 442 | "Perform the action specified by a button at location POS. | 439 | "Perform the action specified by a button at location POS. |
| @@ -535,7 +532,6 @@ Returns the button found." | |||
| 535 | (interactive "p\nd\nd") | 532 | (interactive "p\nd\nd") |
| 536 | (forward-button (- n) wrap display-message no-error)) | 533 | (forward-button (- n) wrap display-message no-error)) |
| 537 | 534 | ||
| 538 | |||
| 539 | (provide 'button) | 535 | (provide 'button) |
| 540 | 536 | ||
| 541 | ;;; button.el ends here | 537 | ;;; button.el ends here |