Mercurial > emacs
annotate lisp/button.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
parents | 280c8ae2476d |
children | 417b1e4d63cd |
rev | line source |
---|---|
42497 | 1 ;;; button.el --- clickable buttons |
39643 | 2 ;; |
68651
3bd95f4f2941
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
67836
diff
changeset
|
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, |
106815 | 4 ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
39643 | 5 ;; |
6 ;; Author: Miles Bader <miles@gnu.org> | |
7 ;; Keywords: extensions | |
110015
280c8ae2476d
Add "Package:" file headers to denote built-in packages.
Chong Yidong <cyd@stupidchicken.com>
parents:
106815
diff
changeset
|
8 ;; Package: emacs |
39643 | 9 ;; |
10 ;; This file is part of GNU Emacs. | |
11 ;; | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92948
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
39643 | 13 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92948
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92948
diff
changeset
|
15 ;; (at your option) any later version. |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92948
diff
changeset
|
16 |
39643 | 17 ;; GNU Emacs is distributed in the hope that it will be useful, |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92948
diff
changeset
|
21 |
39643 | 22 ;; You should have received a copy of the GNU General Public License |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
92948
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
39643 | 24 |
25 ;;; Commentary: | |
26 ;; | |
27 ;; This package defines functions for inserting and manipulating | |
28 ;; clickable buttons in Emacs buffers, such as might be used for help | |
29 ;; hyperlinks, etc. | |
30 ;; | |
31 ;; In some ways it duplicates functionality also offered by the | |
32 ;; `widget' package, but the button package has the advantage that it | |
33 ;; is (1) much faster, (2) much smaller, and (3) much, much, simpler | |
34 ;; (the code, that is, not the interface). | |
35 ;; | |
36 ;; Buttons can either use overlays, in which case the button is | |
37 ;; represented by the overlay itself, or text-properties, in which case | |
38 ;; the button is represented by a marker or buffer-position pointing | |
39 ;; somewhere in the button. In the latter case, no markers into the | |
40 ;; buffer are retained, which is important for speed if there are are | |
41 ;; extremely large numbers of buttons. | |
42 ;; | |
43 ;; Using `define-button-type' to define default properties for buttons | |
44 ;; is not necessary, but it is is encouraged, since doing so makes the | |
45 ;; resulting code clearer and more efficient. | |
46 ;; | |
47 | |
48 ;;; Code: | |
49 | |
50 | |
51 ;; Globals | |
52 | |
60162
82eaf594d12a
(escape-glyph, minibuffer-prompt, button): Add commentary for
Eli Zaretskii <eliz@gnu.org>
parents:
57483
diff
changeset
|
53 ;; Use color for the MS-DOS port because it doesn't support underline. |
77498
9db4aaa87823
(button): Use underline if supported, else fall back to color.
Glenn Morris <rgm@gnu.org>
parents:
77437
diff
changeset
|
54 ;; FIXME if MS-DOS correctly answers the (supports) question, it need |
9db4aaa87823
(button): Use underline if supported, else fall back to color.
Glenn Morris <rgm@gnu.org>
parents:
77437
diff
changeset
|
55 ;; no longer be a special case. |
77437
fa273fd354c2
(button): Inherit from link face on a tty.
Nick Roberts <nickrob@snap.net.nz>
parents:
77431
diff
changeset
|
56 (defface button '((((type pc) (class color)) |
40337
57f029917c77
(button): Special face definition for MS-DOS terminals.
Eli Zaretskii <eliz@gnu.org>
parents:
39917
diff
changeset
|
57 (:foreground "lightblue")) |
77498
9db4aaa87823
(button): Use underline if supported, else fall back to color.
Glenn Morris <rgm@gnu.org>
parents:
77437
diff
changeset
|
58 (((supports :underline t)) :underline t) |
9db4aaa87823
(button): Use underline if supported, else fall back to color.
Glenn Morris <rgm@gnu.org>
parents:
77437
diff
changeset
|
59 (t (:foreground "lightblue"))) |
49001
85b083d06a17
(defface button): Add group.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
42497
diff
changeset
|
60 "Default face used for buttons." |
67836
68ab7e53d86a
(button): Put into group `basic-faces'.
Richard M. Stallman <rms@gnu.org>
parents:
67375
diff
changeset
|
61 :group 'basic-faces) |
39643 | 62 |
63 (defvar button-map | |
64 (let ((map (make-sparse-keymap))) | |
91704 | 65 ;; The following definition needs to avoid using escape sequences that |
66 ;; might get converted to ^M when building loaddefs.el | |
67 (define-key map [(control ?m)] 'push-button) | |
39643 | 68 (define-key map [mouse-2] 'push-button) |
69 map) | |
70 "Keymap used by buttons.") | |
71 | |
72 (defvar button-buffer-map | |
73 (let ((map (make-sparse-keymap))) | |
74 (define-key map [?\t] 'forward-button) | |
67375
77493abd2418
(button-buffer-map): Bind M-TAB to `backward-button'.
Juri Linkov <juri@jurta.org>
parents:
64762
diff
changeset
|
75 (define-key map "\e\t" 'backward-button) |
39643 | 76 (define-key map [backtab] 'backward-button) |
77 map) | |
78 "Keymap useful for buffers containing buttons. | |
79 Mode-specific keymaps may want to use this as their parent keymap.") | |
80 | |
81 ;; Default properties for buttons | |
82 (put 'default-button 'face 'button) | |
83 (put 'default-button 'mouse-face 'highlight) | |
84 (put 'default-button 'keymap button-map) | |
85 (put 'default-button 'type 'button) | |
57483
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
86 ;; action may be either a function to call, or a marker to go to |
39703
a093c43d935c
(button-nop): Function removed.
Miles Bader <miles@gnu.org>
parents:
39676
diff
changeset
|
87 (put 'default-button 'action 'ignore) |
105870
26baacb565b0
* textmodes/tex-mode.el (tex-alt-dvi-print-command)
Dan Nicolaescu <dann@ics.uci.edu>
parents:
100908
diff
changeset
|
88 (put 'default-button 'help-echo (purecopy "mouse-2, RET: Push this button")) |
39643 | 89 ;; Make overlay buttons go away if their underlying text is deleted. |
90 (put 'default-button 'evaporate t) | |
91 ;; Prevent insertions adjacent to the text-property buttons from | |
92 ;; inheriting its properties. | |
93 (put 'default-button 'rear-nonsticky t) | |
94 | |
39916 | 95 ;; A `category-symbol' property for the default button type |
96 (put 'button 'button-category-symbol 'default-button) | |
97 | |
39643 | 98 |
99 ;; Button types (which can be used to hold default properties for buttons) | |
100 | |
39716
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
101 ;; Because button-type properties are inherited by buttons using the |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
102 ;; special `category' property (implemented by both overlays and |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
103 ;; text-properties), we need to store them on a symbol to which the |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
104 ;; `category' properties can point. Instead of using the symbol that's |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
105 ;; the name of each button-type, however, we use a separate symbol (with |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
106 ;; `-button' appended, and uninterned) to store the properties. This is |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
107 ;; to avoid name clashes. |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
108 |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
109 ;; [this is an internal function] |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
110 (defsubst button-category-symbol (type) |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
111 "Return the symbol used by button-type TYPE to store properties. |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
112 Buttons inherit them by setting their `category' property to that symbol." |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
113 (or (get type 'button-category-symbol) |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
114 (error "Unknown button type `%s'" type))) |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
115 |
39643 | 116 (defun define-button-type (name &rest properties) |
88017
ad6ec43b41bc
(define-button-type): Clarify type of NAME in docstring.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
87649
diff
changeset
|
117 "Define a `button type' called NAME (a symbol). |
39643 | 118 The remaining arguments form a sequence of PROPERTY VALUE pairs, |
119 specifying properties to use as defaults for buttons with this type | |
120 \(a button's type may be set by giving it a `type' property when | |
39917 | 121 creating the button, using the :type keyword argument). |
39716
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
122 |
39917 | 123 In addition, the keyword argument :supertype may be used to specify a |
124 button-type from which NAME inherits its default property values | |
125 \(however, the inheritance happens only when NAME is defined; subsequent | |
126 changes to a supertype are not reflected in its subtypes)." | |
40595
3ba2b666d7e1
(define-button-type): Make sure every user-defined button type has a supertype.
Miles Bader <miles@gnu.org>
parents:
40337
diff
changeset
|
127 (let ((catsym (make-symbol (concat (symbol-name name) "-button"))) |
3ba2b666d7e1
(define-button-type): Make sure every user-defined button type has a supertype.
Miles Bader <miles@gnu.org>
parents:
40337
diff
changeset
|
128 (super-catsym |
3ba2b666d7e1
(define-button-type): Make sure every user-defined button type has a supertype.
Miles Bader <miles@gnu.org>
parents:
40337
diff
changeset
|
129 (button-category-symbol |
39916 | 130 (or (plist-get properties 'supertype) |
40595
3ba2b666d7e1
(define-button-type): Make sure every user-defined button type has a supertype.
Miles Bader <miles@gnu.org>
parents:
40337
diff
changeset
|
131 (plist-get properties :supertype) |
3ba2b666d7e1
(define-button-type): Make sure every user-defined button type has a supertype.
Miles Bader <miles@gnu.org>
parents:
40337
diff
changeset
|
132 'button)))) |
39643 | 133 ;; Provide a link so that it's easy to find the real symbol. |
134 (put name 'button-category-symbol catsym) | |
135 ;; Initialize NAME's properties using the global defaults. | |
39716
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
136 (let ((default-props (symbol-plist super-catsym))) |
39643 | 137 (while default-props |
138 (put catsym (pop default-props) (pop default-props)))) | |
139 ;; Add NAME as the `type' property, which will then be returned as | |
140 ;; the type property of individual buttons. | |
141 (put catsym 'type name) | |
142 ;; Add the properties in PROPERTIES to the real symbol. | |
143 (while properties | |
39916 | 144 (let ((prop (pop properties))) |
145 (when (eq prop :supertype) | |
146 (setq prop 'supertype)) | |
147 (put catsym prop (pop properties)))) | |
40595
3ba2b666d7e1
(define-button-type): Make sure every user-defined button type has a supertype.
Miles Bader <miles@gnu.org>
parents:
40337
diff
changeset
|
148 ;; Make sure there's a `supertype' property |
3ba2b666d7e1
(define-button-type): Make sure every user-defined button type has a supertype.
Miles Bader <miles@gnu.org>
parents:
40337
diff
changeset
|
149 (unless (get catsym 'supertype) |
3ba2b666d7e1
(define-button-type): Make sure every user-defined button type has a supertype.
Miles Bader <miles@gnu.org>
parents:
40337
diff
changeset
|
150 (put catsym 'supertype 'button)) |
39643 | 151 name)) |
152 | |
153 (defun button-type-put (type prop val) | |
154 "Set the button-type TYPE's PROP property to VAL." | |
155 (put (button-category-symbol type) prop val)) | |
156 | |
157 (defun button-type-get (type prop) | |
158 "Get the property of button-type TYPE named PROP." | |
159 (get (button-category-symbol type) prop)) | |
160 | |
39716
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
161 (defun button-type-subtype-p (type supertype) |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
162 "Return t if button-type TYPE is a subtype of SUPERTYPE." |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
163 (or (eq type supertype) |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
164 (and type |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
165 (button-type-subtype-p (button-type-get type 'supertype) |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
166 supertype)))) |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
167 |
39643 | 168 |
169 ;; Button properties and other attributes | |
170 | |
171 (defun button-start (button) | |
172 "Return the position at which BUTTON starts." | |
173 (if (overlayp button) | |
174 (overlay-start button) | |
175 ;; Must be a text-property button. | |
176 (or (previous-single-property-change (1+ button) 'button) | |
177 (point-min)))) | |
178 | |
179 (defun button-end (button) | |
180 "Return the position at which BUTTON ends." | |
181 (if (overlayp button) | |
182 (overlay-end button) | |
183 ;; Must be a text-property button. | |
184 (or (next-single-property-change button 'button) | |
185 (point-max)))) | |
186 | |
187 (defun button-get (button prop) | |
188 "Get the property of button BUTTON named PROP." | |
189 (if (overlayp button) | |
190 (overlay-get button prop) | |
191 ;; Must be a text-property button. | |
192 (get-text-property button prop))) | |
193 | |
194 (defun button-put (button prop val) | |
195 "Set BUTTON's PROP property to VAL." | |
196 ;; Treat some properties specially. | |
39916 | 197 (cond ((memq prop '(type :type)) |
39643 | 198 ;; We translate a `type' property a `category' property, since |
199 ;; that's what's actually used by overlays/text-properties for | |
200 ;; inheriting properties. | |
201 (setq prop 'category) | |
202 (setq val (button-category-symbol val))) | |
203 ((eq prop 'category) | |
204 ;; Disallow updating the `category' property directly. | |
205 (error "Button `category' property may not be set directly"))) | |
206 ;; Add the property. | |
207 (if (overlayp button) | |
208 (overlay-put button prop val) | |
209 ;; Must be a text-property button. | |
210 (put-text-property | |
211 (or (previous-single-property-change (1+ button) 'button) | |
212 (point-min)) | |
213 (or (next-single-property-change button 'button) | |
214 (point-max)) | |
215 prop val))) | |
216 | |
39676
9e8365caa0ee
(button-activate): USE-MOUSE-ACTION is optional.
Miles Bader <miles@gnu.org>
parents:
39668
diff
changeset
|
217 (defsubst button-activate (button &optional use-mouse-action) |
39655
6aeeb8a310af
(next-button, previous-button): Respect `skip' property.
Miles Bader <miles@gnu.org>
parents:
39643
diff
changeset
|
218 "Call BUTTON's action property. |
6aeeb8a310af
(next-button, previous-button): Respect `skip' property.
Miles Bader <miles@gnu.org>
parents:
39643
diff
changeset
|
219 If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action |
6aeeb8a310af
(next-button, previous-button): Respect `skip' property.
Miles Bader <miles@gnu.org>
parents:
39643
diff
changeset
|
220 instead of its normal action; if the button has no mouse-action, |
6aeeb8a310af
(next-button, previous-button): Respect `skip' property.
Miles Bader <miles@gnu.org>
parents:
39643
diff
changeset
|
221 the normal action is used instead." |
57483
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
222 (let ((action (or (and use-mouse-action (button-get button 'mouse-action)) |
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
223 (button-get button 'action)))) |
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
224 (if (markerp action) |
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
225 (save-selected-window |
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
226 (select-window (display-buffer (marker-buffer action))) |
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
227 (goto-char action) |
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
228 (recenter 0)) |
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
229 (funcall action button)))) |
39643 | 230 |
231 (defun button-label (button) | |
232 "Return BUTTON's text label." | |
233 (buffer-substring-no-properties (button-start button) (button-end button))) | |
234 | |
39916 | 235 (defsubst button-type (button) |
39917 | 236 "Return BUTTON's button-type." |
39916 | 237 (button-get button 'type)) |
238 | |
39716
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
239 (defun button-has-type-p (button type) |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
240 "Return t if BUTTON has button-type TYPE, or one of TYPE's subtypes." |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
241 (button-type-subtype-p (button-get button 'type) type)) |
66d3b28583a0
(define-button-type): Respect any `supertype' property.
Miles Bader <miles@gnu.org>
parents:
39703
diff
changeset
|
242 |
39643 | 243 |
244 ;; Creating overlay buttons | |
245 | |
246 (defun make-button (beg end &rest properties) | |
247 "Make a button from BEG to END in the current buffer. | |
248 The remaining arguments form a sequence of PROPERTY VALUE pairs, | |
39917 | 249 specifying properties to add to the button. |
250 In addition, the keyword argument :type may be used to specify a | |
251 button-type from which to inherit other properties; see | |
252 `define-button-type'. | |
39643 | 253 |
254 Also see `make-text-button', `insert-button'." | |
255 (let ((overlay (make-overlay beg end nil t nil))) | |
256 (while properties | |
257 (button-put overlay (pop properties) (pop properties))) | |
258 ;; Put a pointer to the button in the overlay, so it's easy to get | |
259 ;; when we don't actually have a reference to the overlay. | |
260 (overlay-put overlay 'button overlay) | |
261 ;; If the user didn't specify a type, use the default. | |
262 (unless (overlay-get overlay 'category) | |
263 (overlay-put overlay 'category 'default-button)) | |
264 ;; OVERLAY is the button, so return it | |
265 overlay)) | |
266 | |
267 (defun insert-button (label &rest properties) | |
268 "Insert a button with the label LABEL. | |
269 The remaining arguments form a sequence of PROPERTY VALUE pairs, | |
39917 | 270 specifying properties to add to the button. |
271 In addition, the keyword argument :type may be used to specify a | |
272 button-type from which to inherit other properties; see | |
273 `define-button-type'. | |
39643 | 274 |
275 Also see `insert-text-button', `make-button'." | |
276 (apply #'make-button | |
277 (prog1 (point) (insert label)) | |
278 (point) | |
279 properties)) | |
280 | |
281 | |
282 ;; Creating text-property buttons | |
283 | |
284 (defun make-text-button (beg end &rest properties) | |
285 "Make a button from BEG to END in the current buffer. | |
286 The remaining arguments form a sequence of PROPERTY VALUE pairs, | |
39917 | 287 specifying properties to add to the button. |
288 In addition, the keyword argument :type may be used to specify a | |
289 button-type from which to inherit other properties; see | |
290 `define-button-type'. | |
39643 | 291 |
292 This function is like `make-button', except that the button is actually | |
293 part of the text instead of being a property of the buffer. Creating | |
294 large numbers of buttons can also be somewhat faster using | |
295 `make-text-button'. | |
296 | |
95776
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
297 BEG can also be a string, in which case it is made into a button. |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
298 |
39643 | 299 Also see `insert-text-button'." |
95776
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
300 (let ((object nil) |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
301 (type-entry |
60339
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
302 (or (plist-member properties 'type) |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
303 (plist-member properties :type)))) |
95776
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
304 (when (stringp beg) |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
305 (setq object beg beg 0 end (length object))) |
60339
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
306 ;; Disallow setting the `category' property directly. |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
307 (when (plist-get properties 'category) |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
308 (error "Button `category' property may not be set directly")) |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
309 (if (null type-entry) |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
310 ;; The user didn't specify a `type' property, use the default. |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
311 (setq properties (cons 'category (cons 'default-button properties))) |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
312 ;; The user did specify a `type' property. Translate it into a |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
313 ;; `category' property, which is what's actually used by |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
314 ;; text-properties for inheritance. |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
315 (setcar type-entry 'category) |
3cd3e3cf3529
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-145
Miles Bader <miles@gnu.org>
parents:
60162
diff
changeset
|
316 (setcar (cdr type-entry) |
95776
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
317 (button-category-symbol (car (cdr type-entry))))) |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
318 ;; Now add all the text properties at once |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
319 (add-text-properties beg end |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
320 ;; Each button should have a non-eq `button' |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
321 ;; property so that next-single-property-change can |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
322 ;; detect boundaries reliably. |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
323 (cons 'button (cons (list t) properties)) |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
324 object) |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
325 ;; Return something that can be used to get at the button. |
dc7fbbea402e
(make-text-button): Allow `start' to be a string.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
326 beg)) |
39643 | 327 |
328 (defun insert-text-button (label &rest properties) | |
329 "Insert a button with the label LABEL. | |
330 The remaining arguments form a sequence of PROPERTY VALUE pairs, | |
39917 | 331 specifying properties to add to the button. |
332 In addition, the keyword argument :type may be used to specify a | |
333 button-type from which to inherit other properties; see | |
334 `define-button-type'. | |
39643 | 335 |
336 This function is like `insert-button', except that the button is | |
337 actually part of the text instead of being a property of the buffer. | |
338 Creating large numbers of buttons can also be somewhat faster using | |
339 `insert-text-button'. | |
340 | |
341 Also see `make-text-button'." | |
342 (apply #'make-text-button | |
343 (prog1 (point) (insert label)) | |
344 (point) | |
345 properties)) | |
346 | |
347 | |
348 ;; Finding buttons in a buffer | |
349 | |
350 (defun button-at (pos) | |
351 "Return the button at position POS in the current buffer, or nil." | |
352 (let ((button (get-char-property pos 'button))) | |
353 (if (or (overlayp button) (null button)) | |
354 button | |
355 ;; Must be a text-property button; return a marker pointing to it. | |
356 (copy-marker pos t)))) | |
357 | |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
358 (defun next-button (pos &optional count-current) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
359 "Return the next button after position POS in the current buffer. |
39643 | 360 If COUNT-CURRENT is non-nil, count any button at POS in the search, |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
361 instead of starting at the next button." |
39643 | 362 (unless count-current |
363 ;; Search for the next button boundary. | |
364 (setq pos (next-single-char-property-change pos 'button))) | |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
365 (and (< pos (point-max)) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
366 (or (button-at pos) |
39643 | 367 ;; We must have originally been on a button, and are now in |
368 ;; the inter-button space. Recurse to find a button. | |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
369 (next-button pos)))) |
39643 | 370 |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
371 (defun previous-button (pos &optional count-current) |
76869
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
372 "Return the previous button before position POS in the current buffer. |
39643 | 373 If COUNT-CURRENT is non-nil, count any button at POS in the search, |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
374 instead of starting at the next button." |
76869
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
375 (let ((button (button-at pos))) |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
376 (if button |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
377 (if count-current |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
378 button |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
379 ;; We started out on a button, so move to its start and look |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
380 ;; for the previous button boundary. |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
381 (setq pos (previous-single-char-property-change |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
382 (button-start button) 'button)) |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
383 (let ((new-button (button-at pos))) |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
384 (if new-button |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
385 ;; We are in a button again; this can happen if there |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
386 ;; are adjacent buttons (or at bob). |
76870 | 387 (unless (= pos (button-start button)) new-button) |
76869
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
388 ;; We are now in the space between buttons. |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
389 (previous-button pos)))) |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
390 ;; We started out in the space between buttons. |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
391 (setq pos (previous-single-char-property-change pos 'button)) |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
392 (or (button-at pos) |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
393 (and (> pos (point-min)) |
c93f4d8744d5
(previous-button): Rewrite to account for adjacent buttons.
Chong Yidong <cyd@stupidchicken.com>
parents:
76771
diff
changeset
|
394 (button-at (1- pos))))))) |
39643 | 395 |
396 | |
397 ;; User commands | |
398 | |
39655
6aeeb8a310af
(next-button, previous-button): Respect `skip' property.
Miles Bader <miles@gnu.org>
parents:
39643
diff
changeset
|
399 (defun push-button (&optional pos use-mouse-action) |
39643 | 400 "Perform the action specified by a button at location POS. |
57483
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
401 POS may be either a buffer position or a mouse-event. If |
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
402 USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action |
39655
6aeeb8a310af
(next-button, previous-button): Respect `skip' property.
Miles Bader <miles@gnu.org>
parents:
39643
diff
changeset
|
403 instead of its normal action; if the button has no mouse-action, |
57483
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
404 the normal action is used instead. The action may be either a |
12ad045f7911
(button-activate): Allow a marker to display as an action.
Daniel Pfeiffer <occitan@esperanto.org>
parents:
52401
diff
changeset
|
405 function to call or a marker to display. |
39643 | 406 POS defaults to point, except when `push-button' is invoked |
407 interactively as the result of a mouse-event, in which case, the | |
408 mouse event is used. | |
409 If there's no button at POS, do nothing and return nil, otherwise | |
410 return t." | |
411 (interactive | |
412 (list (if (integerp last-command-event) (point) last-command-event))) | |
413 (if (and (not (integerp pos)) (eventp pos)) | |
414 ;; POS is a mouse event; switch to the proper window/buffer | |
415 (let ((posn (event-start pos))) | |
416 (with-current-buffer (window-buffer (posn-window posn)) | |
39655
6aeeb8a310af
(next-button, previous-button): Respect `skip' property.
Miles Bader <miles@gnu.org>
parents:
39643
diff
changeset
|
417 (push-button (posn-point posn) t))) |
39643 | 418 ;; POS is just normal position |
419 (let ((button (button-at (or pos (point))))) | |
420 (if (not button) | |
421 nil | |
39655
6aeeb8a310af
(next-button, previous-button): Respect `skip' property.
Miles Bader <miles@gnu.org>
parents:
39643
diff
changeset
|
422 (button-activate button use-mouse-action) |
39643 | 423 t)))) |
424 | |
425 (defun forward-button (n &optional wrap display-message) | |
426 "Move to the Nth next button, or Nth previous button if N is negative. | |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
427 If N is 0, move to the start of any button at point. |
39643 | 428 If WRAP is non-nil, moving past either end of the buffer continues from the |
429 other end. | |
430 If DISPLAY-MESSAGE is non-nil, the button's help-echo string is displayed. | |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
431 Any button with a non-nil `skip' property is skipped over. |
39643 | 432 Returns the button found." |
433 (interactive "p\nd\nd") | |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
434 (let (button) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
435 (if (zerop n) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
436 ;; Move to start of current button |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
437 (if (setq button (button-at (point))) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
438 (goto-char (button-start button))) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
439 ;; Move to Nth next button |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
440 (let ((iterator (if (> n 0) #'next-button #'previous-button)) |
97184
a9fd3177343b
(forward-button): Avoid infloop.
Chong Yidong <cyd@stupidchicken.com>
parents:
95776
diff
changeset
|
441 (wrap-start (if (> n 0) (point-min) (point-max))) |
a9fd3177343b
(forward-button): Avoid infloop.
Chong Yidong <cyd@stupidchicken.com>
parents:
95776
diff
changeset
|
442 opoint fail) |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
443 (setq n (abs n)) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
444 (setq button t) ; just to start the loop |
97184
a9fd3177343b
(forward-button): Avoid infloop.
Chong Yidong <cyd@stupidchicken.com>
parents:
95776
diff
changeset
|
445 (while (and (null fail) (> n 0) button) |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
446 (setq button (funcall iterator (point))) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
447 (when (and (not button) wrap) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
448 (setq button (funcall iterator wrap-start t))) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
449 (when button |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
450 (goto-char (button-start button)) |
97184
a9fd3177343b
(forward-button): Avoid infloop.
Chong Yidong <cyd@stupidchicken.com>
parents:
95776
diff
changeset
|
451 ;; Avoid looping forever (e.g., if all the buttons have |
a9fd3177343b
(forward-button): Avoid infloop.
Chong Yidong <cyd@stupidchicken.com>
parents:
95776
diff
changeset
|
452 ;; the `skip' property). |
a9fd3177343b
(forward-button): Avoid infloop.
Chong Yidong <cyd@stupidchicken.com>
parents:
95776
diff
changeset
|
453 (cond ((null opoint) |
a9fd3177343b
(forward-button): Avoid infloop.
Chong Yidong <cyd@stupidchicken.com>
parents:
95776
diff
changeset
|
454 (setq opoint (point))) |
a9fd3177343b
(forward-button): Avoid infloop.
Chong Yidong <cyd@stupidchicken.com>
parents:
95776
diff
changeset
|
455 ((= opoint (point)) |
a9fd3177343b
(forward-button): Avoid infloop.
Chong Yidong <cyd@stupidchicken.com>
parents:
95776
diff
changeset
|
456 (setq fail t))) |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
457 (unless (button-get button 'skip) |
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
458 (setq n (1- n))))))) |
39643 | 459 (if (null button) |
460 (error (if wrap "No buttons!" "No more buttons")) | |
461 (let ((msg (and display-message (button-get button 'help-echo)))) | |
462 (when msg | |
463 (message "%s" msg))) | |
464 button))) | |
465 | |
466 (defun backward-button (n &optional wrap display-message) | |
467 "Move to the Nth previous button, or Nth next button if N is negative. | |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
468 If N is 0, move to the start of any button at point. |
39643 | 469 If WRAP is non-nil, moving past either end of the buffer continues from the |
470 other end. | |
471 If DISPLAY-MESSAGE is non-nil, the button's help-echo string is displayed. | |
39668
1666965880cc
(next-button, previous-button): Remove N and WRAP parameters.
Miles Bader <miles@gnu.org>
parents:
39655
diff
changeset
|
472 Any button with a non-nil `skip' property is skipped over. |
39643 | 473 Returns the button found." |
474 (interactive "p\nd\nd") | |
475 (forward-button (- n) wrap display-message)) | |
476 | |
477 | |
478 (provide 'button) | |
479 | |
83768
4bdc932ccd9a
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
78236
diff
changeset
|
480 ;; arch-tag: 5f2c7627-413b-4097-b282-630f89d9c5e9 |
39643 | 481 ;;; button.el ends here |