1 |
;;; button.el --- clickable buttons |
;;; button.el --- clickable buttons |
2 |
;; |
;; |
3 |
;; Copyright (C) 2001 Free Software Foundation, Inc. |
;; Copyright (C) 2001, 2005 Free Software Foundation, Inc. |
4 |
;; |
;; |
5 |
;; Author: Miles Bader <miles@gnu.org> |
;; Author: Miles Bader <miles@gnu.org> |
6 |
;; Keywords: extensions |
;; Keywords: extensions |
298 |
`make-text-button'. |
`make-text-button'. |
299 |
|
|
300 |
Also see `insert-text-button'." |
Also see `insert-text-button'." |
301 |
(let (prop val) |
(let ((type-entry |
302 |
(while properties |
(or (plist-member properties 'type) |
303 |
(setq prop (pop properties)) |
(plist-member properties :type)))) |
304 |
(setq val (pop properties)) |
;; Disallow setting the `category' property directly. |
305 |
;; Note that all the following code is basically equivalent to |
(when (plist-get properties 'category) |
306 |
;; `button-put', but we can do it much more efficiently since we |
(error "Button `category' property may not be set directly")) |
307 |
;; already have BEG and END. |
(if (null type-entry) |
308 |
(cond ((memq prop '(type :type)) |
;; The user didn't specify a `type' property, use the default. |
309 |
;; We translate a `type' property into a `category' |
(setq properties (cons 'category (cons 'default-button properties))) |
310 |
;; property, since that's what's actually used by |
;; The user did specify a `type' property. Translate it into a |
311 |
;; text-properties for inheritance. |
;; `category' property, which is what's actually used by |
312 |
(setq prop 'category) |
;; text-properties for inheritance. |
313 |
(setq val (button-category-symbol val))) |
(setcar type-entry 'category) |
314 |
((eq prop 'category) |
(setcar (cdr type-entry) |
315 |
;; Disallow setting the `category' property directly. |
(button-category-symbol (car (cdr type-entry)))))) |
316 |
(error "Button `category' property may not be set directly"))) |
;; Now add all the text properties at once |
317 |
;; Add the property. |
(add-text-properties beg end properties) |
|
(put-text-property beg end prop val))) |
|
318 |
;; Return something that can be used to get at the button. |
;; Return something that can be used to get at the button. |
319 |
beg) |
beg) |
320 |
|
|