aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBasil L. Contovounesios2019-10-01 02:22:31 +0100
committerBasil L. Contovounesios2019-10-03 23:04:56 +0100
commit660d509acd9da23d9795b5aaa12a5453e6c61bbd (patch)
tree4fd424981445285c7d55894aef5cb7ebee7599f8
parentf12fcdf4cd878b7b3f1221c5818fe221cb339724 (diff)
downloademacs-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.el62
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.
82Mode-specific keymaps may want to use this as their parent keymap.") 79Mode-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).
121The remaining arguments form a sequence of PROPERTY VALUE pairs, 118The remaining arguments form a plist of PROPERTY VALUE pairs,
122specifying properties to use as defaults for buttons with this type 119specifying 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
124creating the button, using the :type keyword argument). 121creating 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.
279The remaining arguments form a sequence of PROPERTY VALUE pairs, 276The remaining arguments form a plist of PROPERTY VALUE pairs,
280specifying properties to add to the button. 277specifying properties to add to the button.
281In addition, the keyword argument :type may be used to specify a 278In addition, the keyword argument :type may be used to specify a
282button-type from which to inherit other properties; see 279button-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.
300The remaining arguments form a sequence of PROPERTY VALUE pairs, 297The remaining arguments form a plist of PROPERTY VALUE pairs,
301specifying properties to add to the button. 298specifying properties to add to the button.
302In addition, the keyword argument :type may be used to specify a 299In addition, the keyword argument :type may be used to specify a
303button-type from which to inherit other properties; see 300button-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.
317The remaining arguments form a sequence of PROPERTY VALUE pairs, 314The remaining arguments form a plist of PROPERTY VALUE pairs,
318specifying properties to add to the button. 315specifying properties to add to the button.
319In addition, the keyword argument :type may be used to specify a 316In addition, the keyword argument :type may be used to specify a
320button-type from which to inherit other properties; see 317button-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.
368The remaining arguments form a sequence of PROPERTY VALUE pairs, 365The remaining arguments form a plist of PROPERTY VALUE pairs,
369specifying properties to add to the button. 366specifying properties to add to the button.
370In addition, the keyword argument :type may be used to specify a 367In addition, the keyword argument :type may be used to specify a
371button-type from which to inherit other properties; see 368button-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