|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: hui.el
|
|
|
4 ;; SUMMARY: GNU Emacs User Interface to Hyperbole
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: hypermedia
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
24
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 19-Sep-91 at 21:42:03
|
|
24
|
12 ;; LAST-MOD: 10-Nov-96 at 01:51:13 by Bob Weiner
|
|
0
|
13 ;;
|
|
|
14 ;; This file is part of Hyperbole.
|
|
|
15 ;; Available for use and distribution under the same terms as GNU Emacs.
|
|
|
16 ;;
|
|
24
|
17 ;; Copyright (C) 1991-1996, Free Software Foundation, Inc.
|
|
0
|
18 ;; Developed with support from Motorola Inc.
|
|
|
19 ;;
|
|
|
20 ;; DESCRIPTION:
|
|
|
21 ;; DESCRIP-END.
|
|
|
22
|
|
|
23 ;;; ************************************************************************
|
|
|
24 ;;; Other required Elisp libraries
|
|
|
25 ;;; ************************************************************************
|
|
|
26
|
|
|
27 (require 'hargs) (require 'set) (require 'hmail)
|
|
|
28
|
|
|
29 ;;; ************************************************************************
|
|
|
30 ;;; Public variables
|
|
|
31 ;;; ************************************************************************
|
|
|
32
|
|
|
33 (defvar hui:ebut-delete-confirm-p t
|
|
|
34 "*Non-nil means prompt before interactively deleting explicit buttons.")
|
|
|
35
|
|
|
36 ;;; ************************************************************************
|
|
|
37 ;;; Public functions
|
|
|
38 ;;; ************************************************************************
|
|
|
39
|
|
|
40 (defun hui:ebut-create (&optional start end)
|
|
|
41 "Creates an explicit but starting from label between optional START and END.
|
|
|
42 Indicates by delimiting and adding any necessary instance number of the button
|
|
|
43 label."
|
|
|
44 (interactive (list (and (marker-position (hypb:mark-marker t))
|
|
|
45 (region-beginning))
|
|
|
46 (and (marker-position (hypb:mark-marker t))
|
|
|
47 (region-end))))
|
|
|
48 (let ((default-lbl) lbl but-buf actype)
|
|
|
49 (save-excursion
|
|
|
50 (setq default-lbl
|
|
|
51 (hui:hbut-label-default start end (not (interactive-p)))
|
|
|
52 lbl (hui:hbut-label default-lbl "ebut-create"))
|
|
|
53 (if (not (equal lbl default-lbl)) (setq default-lbl nil))
|
|
|
54
|
|
|
55 (setq but-buf (if default-lbl (current-buffer) (hui:ebut-buf)))
|
|
|
56 (hui:buf-writable-err but-buf "ebut-create")
|
|
|
57
|
|
|
58 (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
|
|
|
59 (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
|
|
|
60 (setq actype (hui:actype))
|
|
|
61 (hattr:set 'hbut:current 'actype actype)
|
|
|
62 (hattr:set 'hbut:current 'args (hargs:actype-get actype))
|
|
|
63 (hattr:set 'hbut:current 'action
|
|
|
64 (and (boundp 'hui:ebut-prompt-for-action)
|
|
|
65 hui:ebut-prompt-for-action (hui:action actype)))
|
|
|
66 )
|
|
|
67 (ebut:operate lbl nil)))
|
|
|
68
|
|
|
69 (defun hui:ebut-delete (but-key &optional key-src)
|
|
|
70 "Deletes explicit Hyperbole button given by BUT-KEY in optional KEY-SRC.
|
|
|
71 KEY-SRC may be a buffer or a pathname, when nil the current buffer is used.
|
|
|
72 Returns t if button is deleted, nil if user chooses not to delete or signals
|
|
|
73 an error otherwise. If called interactively, prompts user whether to delete
|
|
|
74 and derives BUT-KEY from the button that point is within.
|
|
|
75 Signals an error if point is not within a button."
|
|
|
76 (interactive (list (if (ebut:at-p)
|
|
|
77 (hattr:get 'hbut:current 'lbl-key)
|
|
|
78 nil)))
|
|
|
79 (cond ((null but-key)
|
|
|
80 (hypb:error
|
|
|
81 "(ebut-delete): Point is not over the label of an existing button."))
|
|
|
82 ((not (stringp but-key))
|
|
|
83 (hypb:error
|
|
|
84 "(ebut-delete): Invalid label key argument: '%s'." but-key)))
|
|
|
85 (let ((interactive (interactive-p)))
|
|
|
86 (if (and hui:ebut-delete-confirm-p interactive)
|
|
|
87 (if (y-or-n-p (format "Delete button %s%s%s? "
|
|
|
88 ebut:start
|
|
|
89 (hbut:key-to-label but-key) ebut:end))
|
|
|
90 (hui:ebut-delete-op interactive but-key key-src)
|
|
|
91 (message ""))
|
|
|
92 (hui:ebut-delete-op interactive but-key key-src))))
|
|
|
93
|
|
|
94 (defun hui:ebut-edit ()
|
|
|
95 "Creates or modifies an explicit Hyperbole button when conditions are met.
|
|
|
96 A region must have been delimited with the action-key and point must now be
|
|
|
97 within it before this function is called or it will do nothing. The region
|
|
|
98 must be no larger than the size given by 'ebut:max-len'. It must be entirely
|
|
|
99 within or entirely outside of an existing explicit button. When region is
|
|
|
100 within the button, the button is interactively modified. Otherwise, a new
|
|
|
101 button is created interactively with the region as the default label."
|
|
|
102 (interactive)
|
|
|
103 (let ((m (marker-position (hypb:mark-marker t)))
|
|
|
104 (op action-key-depress-prev-point) (p (point)) (lbl-key))
|
|
|
105 (if (and m (eq (marker-buffer m) (marker-buffer op))
|
|
|
106 (< op m) (<= (- m op) ebut:max-len)
|
|
|
107 (<= p m) (<= op p))
|
|
|
108 (progn
|
|
|
109 (if (setq lbl-key (ebut:label-p))
|
|
|
110 (hui:ebut-modify lbl-key)
|
|
|
111 (hui:ebut-create op m))
|
|
|
112 t))))
|
|
|
113
|
|
|
114 (defun hui:ebut-modify (lbl-key)
|
|
|
115 "Modifies an explicit Hyperbole button given by LBL-KEY.
|
|
|
116 Signals an error when no such button is found in the current buffer."
|
|
|
117 (interactive (list (save-excursion
|
|
|
118 (hui:buf-writable-err (current-buffer) "ebut-modify")
|
|
|
119 (or (ebut:label-p)
|
|
|
120 (ebut:label-to-key
|
|
|
121 (hargs:read-match "Button to modify: "
|
|
|
122 (ebut:alist) nil t
|
|
|
123 nil 'ebut))))))
|
|
|
124 (let ((lbl (ebut:key-to-label lbl-key))
|
|
|
125 (but-buf (current-buffer))
|
|
|
126 actype but new-lbl)
|
|
|
127 (save-excursion
|
|
|
128 (or (interactive-p)
|
|
|
129 (hui:buf-writable-err but-buf "ebut-modify"))
|
|
|
130
|
|
|
131 (or (setq but (ebut:get lbl-key but-buf))
|
|
|
132 (progn (pop-to-buffer but-buf)
|
|
|
133 (hypb:error "(ebut-modify): Invalid button, no data for '%s'." lbl)))
|
|
|
134
|
|
|
135 (setq new-lbl
|
|
|
136 (hargs:read
|
|
|
137 "Change button label to: "
|
|
|
138 (function
|
|
|
139 (lambda (lbl)
|
|
|
140 (and (not (string= lbl "")) (<= (length lbl) ebut:max-len))))
|
|
|
141 lbl
|
|
|
142 (format "(ebut-modify): Enter a string of at most %s chars."
|
|
|
143 ebut:max-len)
|
|
|
144 'string))
|
|
|
145
|
|
|
146 (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
|
|
|
147 (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
|
|
|
148 (setq actype (hui:actype (hattr:get but 'actype)))
|
|
|
149 (hattr:set 'hbut:current 'actype actype)
|
|
|
150 (hattr:set 'hbut:current 'args (hargs:actype-get actype 'modifying))
|
|
|
151 (hattr:set 'hbut:current 'action
|
|
|
152 (and (boundp 'hui:ebut-prompt-for-action)
|
|
|
153 hui:ebut-prompt-for-action (hui:action actype)))
|
|
|
154 )
|
|
|
155 (ebut:operate lbl new-lbl)))
|
|
|
156
|
|
|
157 (defun hui:ebut-rename (curr-label new-label)
|
|
|
158 "Renames explicit Hyperbole button given by CURR-LABEL to NEW-LABEL.
|
|
|
159 If called interactively when point is not within an explicit button:
|
|
|
160 prompts for old and new button label values and performs rename.
|
|
|
161 If called interactively when point is within an explicit button:
|
|
|
162 saves button label and tells user to edit label, then call again.
|
|
|
163 second call changes the button's name from the stored value to the
|
|
|
164 edited value.
|
|
|
165 Signals an error if any problem occurs."
|
|
|
166 (interactive
|
|
|
167 (save-excursion
|
|
|
168 (let (curr-label new-label)
|
|
|
169 (hui:buf-writable-err (current-buffer) "ebut-rename")
|
|
|
170 (if hui:ebut-label-prev
|
|
|
171 (setq curr-label hui:ebut-label-prev
|
|
|
172 new-label (ebut:label-p 'as-label))
|
|
|
173 (setq new-label nil
|
|
|
174 curr-label
|
|
|
175 (or (ebut:label-p 'as-label)
|
|
|
176 (let ((buts (ebut:alist)))
|
|
|
177 (if (null buts)
|
|
|
178 (hypb:error "(ebut-rename): No explicit buttons in buffer.")
|
|
|
179 (prog1 (hargs:read-match
|
|
|
180 "Button label to rename: "
|
|
|
181 buts nil t nil 'ebut)
|
|
|
182 (setq new-label
|
|
|
183 (hargs:read
|
|
|
184 "Rename button label to: "
|
|
|
185 (function
|
|
|
186 (lambda (lbl)
|
|
|
187 (and (not (string= lbl ""))
|
|
|
188 (<= (length lbl) ebut:max-len))))
|
|
|
189 curr-label
|
|
|
190 (format
|
|
|
191 "(ebut-rename): Use a quoted string of at most %s chars."
|
|
|
192 ebut:max-len)
|
|
|
193 'string))))))))
|
|
|
194 (list curr-label new-label))))
|
|
|
195
|
|
|
196 (save-excursion
|
|
|
197 (if (interactive-p)
|
|
|
198 nil
|
|
|
199 (hui:buf-writable-err (current-buffer) "ebut-rename")
|
|
|
200 (if (or (not (stringp curr-label)) (string= curr-label ""))
|
|
|
201 (hypb:error "(ebut-rename): 'curr-label' must be a non-empty string: %s"
|
|
|
202 curr-label))
|
|
|
203 (and (stringp new-label) (string= new-label "")
|
|
|
204 (hypb:error "(ebut-rename): 'new-label' must be a non-empty string: %s"
|
|
|
205 new-label)))
|
|
|
206 (or (ebut:get (ebut:label-to-key curr-label))
|
|
|
207 (hypb:error "(ebut-rename): Can't rename %s since no button data."
|
|
|
208 curr-label))
|
|
|
209 )
|
|
|
210 (cond (new-label
|
|
|
211 (ebut:operate curr-label new-label)
|
|
|
212 (setq hui:ebut-label-prev nil)
|
|
|
213 (message "Renamed from '%s' to '%s'." curr-label new-label))
|
|
|
214 (curr-label
|
|
|
215 (setq hui:ebut-label-prev curr-label)
|
|
|
216 (message "Edit button label and use same command to finish rename."))
|
|
|
217 (t (hypb:error "(ebut-rename): Move point to within a button label."))))
|
|
|
218
|
|
|
219 (defun hui:ebut-search (string &optional match-part)
|
|
|
220 "Shows lines of files/buffers containing an explicit but match for STRING.
|
|
|
221 Returns number of buttons matched and displayed.
|
|
|
222 By default, only matches for whole button labels are found, optional MATCH-PART
|
|
|
223 enables partial matches. The match lines are shown in a buffer which serves as
|
|
|
224 a menu to find any of the occurrences."
|
|
|
225 (interactive (list (read-string "Search for button string: ")
|
|
|
226 (y-or-n-p "Enable partial matches? ")))
|
|
|
227 (if (not (stringp string))
|
|
|
228 (hypb:error "(ebut-search): String to search for is required."))
|
|
|
229 (let* ((prefix (if (> (length string) 14)
|
|
|
230 (substring string 0 13) string))
|
|
|
231 (out-buf (get-buffer-create (concat "*" prefix " Hypb Search*")))
|
|
|
232 (total (ebut:search string out-buf match-part)))
|
|
|
233 (if (> total 0)
|
|
|
234 (progn
|
|
|
235 (set-buffer out-buf)
|
|
|
236 (moccur-mode)
|
|
|
237 (if (fboundp 'outline-minor-mode)
|
|
|
238 (and (progn (goto-char 1)
|
|
|
239 (search-forward "\C-m" nil t))
|
|
|
240 (outline-minor-mode 1)))
|
|
|
241 (if (fboundp 'hproperty:but-create)
|
|
|
242 (hproperty:but-create nil nil (regexp-quote
|
|
|
243 (if match-part string
|
|
|
244 (concat ebut:start string ebut:end)))))
|
|
|
245 (goto-char (point-min))
|
|
|
246 (pop-to-buffer out-buf)
|
|
|
247 (if (interactive-p) (message "%d match%s." total
|
|
|
248 (if (> total 1) "es" ""))
|
|
|
249 total))
|
|
|
250 (if (interactive-p) (message "No matches.")
|
|
|
251 total))))
|
|
|
252
|
|
|
253 (defun hui:error (&rest args)
|
|
|
254 (hypb:error "(hui:error): Obsolete, use hypb:error instead."))
|
|
|
255
|
|
|
256 (defun hui:gbut-create (lbl)
|
|
|
257 "Creates Hyperbole global button with LBL."
|
|
|
258 (interactive "sCreate global button labeled: ")
|
|
|
259 (let (but-buf actype)
|
|
|
260 (save-excursion
|
|
|
261 (setq actype (hui:actype))
|
|
|
262 (setq but-buf (set-buffer (find-file-noselect gbut:file)))
|
|
|
263 (hui:buf-writable-err but-buf "ebut-create")
|
|
|
264 ;; This prevents movement of point which might be useful to user.
|
|
|
265 (save-excursion
|
|
|
266 (goto-char (point-max))
|
|
|
267 (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
|
|
|
268 (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
|
|
|
269 (hattr:set 'hbut:current 'actype actype)
|
|
|
270 (hattr:set 'hbut:current 'args (hargs:actype-get actype))
|
|
|
271 (hattr:set 'hbut:current 'action
|
|
|
272 (and (boundp 'hui:ebut-prompt-for-action)
|
|
|
273 hui:ebut-prompt-for-action (hui:action actype)))
|
|
|
274 (setq lbl (concat lbl (ebut:operate lbl nil)))
|
|
|
275 (goto-char (point-max))
|
|
|
276 (insert "\n")
|
|
|
277 (save-buffer)
|
|
|
278 )
|
|
|
279 (message "%s created." lbl)
|
|
|
280 )))
|
|
|
281
|
|
|
282 (defun hui:gbut-modify (lbl-key)
|
|
|
283 "Modifies a global Hyperbole button given by LBL-KEY.
|
|
|
284 Signals an error when no such button is found."
|
|
|
285 (interactive (list (save-excursion
|
|
|
286 (hui:buf-writable-err
|
|
|
287 (find-file-noselect gbut:file) "gbut-modify")
|
|
|
288 (hbut:label-to-key
|
|
|
289 (hargs:read-match "Global button to modify: "
|
|
24
|
290 (mapcar 'list (gbut:label-list))
|
|
0
|
291 nil t nil 'ebut)))))
|
|
|
292 (let ((lbl (hbut:key-to-label lbl-key))
|
|
|
293 (but-buf (find-file-noselect gbut:file))
|
|
|
294 actype but new-lbl)
|
|
|
295 (save-excursion
|
|
|
296 (or (interactive-p)
|
|
|
297 (hui:buf-writable-err but-buf "gbut-modify"))
|
|
|
298
|
|
|
299 (or (setq but (ebut:get lbl-key but-buf))
|
|
|
300 (progn (pop-to-buffer but-buf)
|
|
|
301 (hypb:error
|
|
|
302 "(gbut-modify): Invalid button, no data for '%s'." lbl)))
|
|
|
303
|
|
|
304 (setq new-lbl
|
|
|
305 (hargs:read
|
|
|
306 "Change global button label to: "
|
|
|
307 (function
|
|
|
308 (lambda (lbl)
|
|
|
309 (and (not (string= lbl "")) (<= (length lbl) ebut:max-len))))
|
|
|
310 lbl
|
|
|
311 (format "(gbut-modify): Enter a string of at most %s chars."
|
|
|
312 ebut:max-len)
|
|
|
313 'string))
|
|
|
314
|
|
|
315 (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
|
|
|
316 (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
|
|
|
317 (setq actype (hui:actype (hattr:get but 'actype)))
|
|
|
318 (hattr:set 'hbut:current 'actype actype)
|
|
|
319 (hattr:set 'hbut:current 'args (hargs:actype-get actype 'modifying))
|
|
|
320 (hattr:set 'hbut:current 'action
|
|
|
321 (and (boundp 'hui:ebut-prompt-for-action)
|
|
|
322 hui:ebut-prompt-for-action (hui:action actype)))
|
|
|
323 (set-buffer but-buf)
|
|
|
324 (ebut:operate lbl new-lbl))))
|
|
|
325
|
|
|
326 (defun hui:hbut-act (&optional but)
|
|
|
327 "Executes action for optional Hyperbole button symbol BUT in current buffer.
|
|
|
328 Default is the current button."
|
|
|
329 (interactive
|
|
|
330 (let ((but (hbut:at-p)) (lst))
|
|
|
331 (list
|
|
|
332 (cond (but)
|
|
|
333 ((setq lst (ebut:alist))
|
|
|
334 (ebut:get (ebut:label-to-key
|
|
|
335 (hargs:read-match "Button to execute: " lst nil t
|
|
|
336 (ebut:label-p 'as-label) 'ebut))))
|
|
|
337 (t (hypb:error "(hbut-act): No explicit buttons in buffer."))))))
|
|
|
338 (cond ((and (interactive-p) (null but))
|
|
|
339 (hypb:error "(hbut-act): No current button to activate."))
|
|
|
340 ((not (hbut:is-p but))
|
|
|
341 (hypb:error "(hbut-act): Button is invalid; it has no attributes."))
|
|
|
342 (t (or but (setq but 'hbut:current))
|
|
|
343 (hui:but-flash) (hyperb:act but))))
|
|
|
344
|
|
24
|
345 (defun hui:hbut-current-act ()
|
|
|
346 "Activate Hyperbole button at point or signal an error if there is no such button."
|
|
|
347 (interactive)
|
|
|
348 (let ((but (hbut:at-p)))
|
|
|
349 (cond ((null but)
|
|
|
350 (hypb:error "(hbut-act): No current button to activate."))
|
|
|
351 ((not (hbut:is-p but))
|
|
|
352 (hypb:error "(hbut-act): Button is invalid; it has no attributes."))
|
|
|
353 (t (hui:but-flash) (hyperb:act but)))))
|
|
|
354
|
|
0
|
355 (defun hui:hbut-help (&optional but)
|
|
|
356 "Checks for and explains an optional button given by symbol, BUT.
|
|
|
357 BUT defaults to the button whose label point is within."
|
|
|
358 (interactive)
|
|
|
359 (setq but (or but (hbut:at-p)
|
|
|
360 (ebut:get (ebut:label-to-key
|
|
|
361 (hargs:read-match "Help for button: "
|
|
|
362 (ebut:alist) nil t nil 'ebut)))))
|
|
|
363 (or but
|
|
|
364 (hypb:error "(hbut-help): Move point to a valid Hyperbole button."))
|
|
|
365 (if (not (hbut:is-p but))
|
|
|
366 (cond (but (hypb:error "(hbut-help): Invalid button."))
|
|
|
367 (t (hypb:error
|
|
|
368 "(hbut-help): Not on an implicit button and no buffer explicit buttons."))))
|
|
|
369 (let ((type-help-func (intern-soft
|
|
|
370 (concat
|
|
|
371 (htype:names 'ibtypes (hattr:get but 'categ))
|
|
|
372 ":help"))))
|
|
|
373 (or (equal (hypb:indirect-function 'hui:but-flash)
|
|
|
374 (function (lambda nil)))
|
|
|
375 ;; Only flash button if point is on it.
|
|
|
376 (let ((lbl-key (hattr:get but 'lbl-key)))
|
|
|
377 (and lbl-key
|
|
|
378 (or (equal lbl-key (ebut:label-p))
|
|
|
379 (equal lbl-key (ibut:label-p)))
|
|
|
380 (hui:but-flash))))
|
|
|
381 (if type-help-func
|
|
|
382 (funcall type-help-func but)
|
|
|
383 (let ((total (hbut:report but)))
|
|
|
384 (if total (hui:help-ebut-highlight))))))
|
|
|
385
|
|
|
386 (defun hui:hbut-label (default-label func-name)
|
|
|
387 "Reads button label from user using DEFAULT-LABEL and caller's FUNC-NAME."
|
|
|
388 (hargs:read "Button label: "
|
|
|
389 (function
|
|
|
390 (lambda (lbl)
|
|
|
391 (and (not (string= lbl "")) (<= (length lbl) ebut:max-len))))
|
|
|
392 default-label
|
|
|
393 (format "(%s): Enter a string of at most %s chars."
|
|
|
394 func-name ebut:max-len)
|
|
|
395 'string))
|
|
|
396
|
|
|
397 (defun hui:hbut-label-default (start end &optional skip-len-test)
|
|
|
398 "Returns default label based on START and END region markers or points.
|
|
|
399 Optional SKIP-LEN-TEST means don't limit label to 'ebut:max-len' length.
|
|
|
400 Returns nil if START or END are invalid or if region fails length test.
|
|
|
401
|
|
|
402 Also has side effect of moving point to start of default label, if any."
|
|
|
403 (if (markerp start) (setq start (marker-position start)))
|
|
|
404 (if (markerp end) (setq end (marker-position end)))
|
|
|
405 ;; Test whether to use region as default button label.
|
|
|
406 (if (and (integerp start) (integerp end)
|
|
|
407 (or skip-len-test
|
|
|
408 (<= (max (- end start) (- start end)) ebut:max-len)))
|
|
|
409 (progn (goto-char start)
|
|
|
410 (buffer-substring start end))))
|
|
|
411
|
|
|
412 (defun hui:hbut-report (&optional arg)
|
|
|
413 "Pretty prints attributes of current button, using optional prefix ARG.
|
|
|
414 See 'hbut:report'."
|
|
|
415 (interactive "P")
|
|
|
416 (if (and arg (symbolp arg))
|
|
|
417 (hui:hbut-help arg)
|
|
|
418 (let ((total (hbut:report arg)))
|
|
|
419 (if total
|
|
|
420 (progn (hui:help-ebut-highlight)
|
|
|
421 (message "%d button%s." total (if (/= total 1) "s" "")))))))
|
|
|
422
|
|
|
423 (fset 'hui:hbut-summarize 'hui:hbut-report)
|
|
|
424
|
|
|
425 (defun hui:link-directly ()
|
|
|
426 "Creates a Hyperbole link button at depress point, linked to release point.
|
|
|
427 See also documentation for 'hui:link-possible-types'."
|
|
|
428 (let* ((link-types (hui:link-possible-types))
|
|
|
429 (but-window action-key-depress-window)
|
|
|
430 (num-types (length link-types))
|
|
|
431 (release-window (selected-window))
|
|
|
432 (but-modify nil)
|
|
|
433 type-and-args lbl-key but-loc but-dir)
|
|
|
434 (select-window action-key-depress-window)
|
|
|
435 (hui:buf-writable-err (current-buffer) "link-directly")
|
|
|
436 (if (ebut:at-p)
|
|
|
437 (progn
|
|
|
438 (setq but-modify t
|
|
|
439 but-loc (hattr:get 'hbut:current 'loc)
|
|
|
440 but-dir (hattr:get 'hbut:current 'dir)
|
|
|
441 lbl-key (hattr:get 'hbut:current 'lbl-key)))
|
|
|
442 (setq but-loc (hui:key-src (current-buffer))
|
|
|
443 but-dir (hui:key-dir (current-buffer))
|
|
|
444 lbl-key (hbut:label-to-key
|
|
|
445 (hui:hbut-label
|
|
|
446 (if (marker-position (hypb:mark-marker t))
|
|
|
447 (hui:hbut-label-default
|
|
|
448 (region-beginning) (region-end)))
|
|
|
449 "link-directly"))))
|
|
|
450 (select-window release-window)
|
|
|
451
|
|
|
452 (cond ((= num-types 0)
|
|
|
453 (error "(link-directly): No possible link type to create."))
|
|
|
454 ((= num-types 1)
|
|
|
455 (hui:link-create but-modify
|
|
|
456 but-window lbl-key but-loc but-dir
|
|
|
457 (setq type-and-args (car link-types))))
|
|
|
458 (t;; more than 1
|
|
|
459 (let ((item)
|
|
|
460 type)
|
|
|
461 (hui:link-create
|
|
|
462 but-modify but-window
|
|
|
463 lbl-key but-loc but-dir
|
|
|
464 (setq type-and-args
|
|
|
465 (hui:menu-select
|
|
|
466 (cons '("Link to>")
|
|
|
467 (mapcar
|
|
|
468 (function
|
|
|
469 (lambda (type-and-args)
|
|
|
470 (setq type (car type-and-args))
|
|
|
471 (list
|
|
|
472 (capitalize
|
|
|
473 (if (string-match
|
|
|
474 "^\\(link-to\\|eval\\)-"
|
|
|
475 (setq item (symbol-name type)))
|
|
|
476 (setq item (substring
|
|
|
477 item (match-end 0)))
|
|
|
478 item))
|
|
|
479 type-and-args
|
|
|
480 (documentation
|
|
|
481 (intern (concat "actypes::"
|
|
|
482 (symbol-name type)))))))
|
|
|
483 link-types))))))))
|
|
|
484 (message "`%s' button %s type `%s'."
|
|
|
485 (hbut:key-to-label lbl-key)
|
|
|
486 (if but-modify "set to" "created with")
|
|
|
487 (car type-and-args))))
|
|
|
488
|
|
|
489 ;;; ************************************************************************
|
|
|
490 ;;; Private functions
|
|
|
491 ;;; ************************************************************************
|
|
|
492
|
|
|
493 (defun hui:action (actype &optional prompt)
|
|
|
494 "Prompts for and returns an action to override action from ACTYPE."
|
|
|
495 (and actype
|
|
|
496 (let* ((act) (act-str)
|
|
|
497 (params (actype:params actype))
|
|
|
498 (params-str (and params (concat " " (prin1-to-string params))))
|
|
|
499 )
|
|
|
500 (while (progn
|
|
|
501 (while (and (setq act-str
|
|
|
502 (hargs:read
|
|
|
503 (or prompt (concat "Action" params-str
|
|
|
504 ": ")) nil nil
|
|
|
505 nil 'string))
|
|
|
506 (not (string= act-str ""))
|
|
|
507 (condition-case ()
|
|
|
508 (progn (setq act (read act-str)) nil)
|
|
|
509 (error
|
|
|
510 (beep) (message "Invalid action syntax.")
|
|
|
511 (sit-for 3) t))))
|
|
|
512 (and (not (symbolp act))
|
|
|
513 params
|
|
|
514 ;; Use the weak condition that action must
|
|
|
515 ;; involve at least one of actype's parameters
|
|
|
516 ;; or else we assume the action is invalid, tell
|
|
|
517 ;; the user and provide another chance for entry.
|
|
|
518 (not (memq t
|
|
|
519 (mapcar
|
|
|
520 (function
|
|
|
521 (lambda (param)
|
|
|
522 (setq param (symbol-name param))
|
|
|
523 (and (string-match
|
|
|
524 (concat "[\( \t\n,']"
|
|
|
525 (regexp-quote param)
|
|
|
526 "[\(\) \t\n\"]")
|
|
|
527 act-str)
|
|
|
528 t)))
|
|
|
529 params)))
|
|
|
530 ))
|
|
|
531 (beep) (message "Action must use at least one parameter.")
|
|
|
532 (sit-for 3))
|
|
|
533 (let (head)
|
|
|
534 (while (cond ((listp act)
|
|
|
535 (and act (setq head (car act))
|
|
|
536 (not (or (eq head 'lambda)
|
|
|
537 (eq head 'defun)
|
|
|
538 (eq head 'defmacro)))
|
|
|
539 (setq act (list 'lambda params act))
|
|
|
540 nil ;; terminate loop
|
|
|
541 ))
|
|
|
542 ((symbolp act)
|
|
|
543 (setq act (cons act params)))
|
|
|
544 ((stringp act)
|
|
|
545 (setq act (action:kbd-macro act 1)))
|
|
|
546 ;; Unrecognized form
|
|
|
547 (t (setq act nil))
|
|
|
548 )))
|
|
|
549 act)))
|
|
|
550
|
|
|
551 (defun hui:actype (&optional default-actype prompt)
|
|
|
552 "Using optional DEFAULT-ACTYPE, PROMPTs for a button action type.
|
|
|
553 DEFAULT-ACTYPE may be a valid symbol or symbol-name."
|
|
|
554 (and default-actype (symbolp default-actype)
|
|
|
555 (progn
|
|
|
556 (setq default-actype (symbol-name default-actype))
|
|
|
557 (if (string-match "actypes::" default-actype)
|
|
|
558 (setq default-actype (substring default-actype (match-end 0))))))
|
|
|
559 (if (or (null default-actype) (stringp default-actype))
|
|
|
560 (intern-soft
|
|
|
561 (concat "actypes::"
|
|
|
562 (hargs:read-match (or prompt "Button's action type: ")
|
|
|
563 (mapcar 'list (htype:names 'actypes))
|
|
|
564 nil t default-actype 'actype)))
|
|
|
565 (hypb:error "(actype): Invalid default action type received.")
|
|
|
566 ))
|
|
|
567
|
|
|
568 (defun hui:buf-writable-err (but-buf func-name)
|
|
|
569 "If BUT-BUF is read-only or is unwritable, signal an error from FUNC-NAME."
|
|
|
570 (let ((obuf (prog1 (current-buffer) (set-buffer but-buf)))
|
|
|
571 ;; (unwritable (and buffer-file-name
|
|
|
572 ;; (not (file-writable-p buffer-file-name))))
|
|
|
573 (err))
|
|
|
574 ;; (if unwritable
|
|
|
575 ;; Commented error out since some people want to be able to create
|
|
|
576 ;; buttons within files which they have purposely marked read-only.
|
|
|
577 ;; (setq err
|
|
|
578 ;; (format "(ebut-modify): You are not allowed to modify '%s'."
|
|
|
579 ;; (file-name-nondirectory buffer-file-name))))
|
|
|
580 (if buffer-read-only
|
|
|
581 (setq err
|
|
|
582 (format
|
|
|
583 "Button buffer '%s' is read-only. Use %s to change it."
|
|
|
584 (buffer-name but-buf)
|
|
|
585 (hypb:cmd-key-string
|
|
|
586 (if (where-is-internal 'vc-toggle-read-only)
|
|
|
587 'vc-toggle-read-only 'toggle-read-only))
|
|
|
588 )))
|
|
|
589 (set-buffer obuf)
|
|
|
590 (if err (progn (pop-to-buffer but-buf) (hypb:error err)))))
|
|
|
591
|
|
|
592 (defun hui:ebut-buf (&optional prompt)
|
|
|
593 "Prompt for and return a buffer in which to place a button."
|
|
|
594 (let ((buf-name))
|
|
|
595 (while
|
|
|
596 (progn
|
|
|
597 (setq buf-name
|
|
|
598 (hargs:read-match
|
|
|
599 (or prompt "Button's buffer: ")
|
|
|
600 (delq nil
|
|
|
601 (mapcar
|
|
|
602 (function
|
|
|
603 (lambda (buf)
|
|
|
604 (let ((b (buffer-name buf)))
|
|
|
605 (if (and (not (string-match "mail\\*" b))
|
|
|
606 (not (string-match "\\*post-news\\*" b))
|
|
|
607 (string-match "\\`[* ]" b))
|
|
|
608 nil
|
|
|
609 (cons b nil)))))
|
|
|
610 (buffer-list)))
|
|
|
611 nil t (buffer-name) 'buffer))
|
|
|
612 (or (null buf-name) (equal buf-name "")))
|
|
|
613 (beep))
|
|
|
614 (get-buffer buf-name)))
|
|
|
615
|
|
|
616 (defun hui:ebut-delete-op (interactive but-key key-src)
|
|
|
617 "INTERACTIVEly or not deletes explicit Hyperbole button given by BUT-KEY in KEY-SRC.
|
|
|
618 KEY-SRC may be a buffer or a pathname, when nil the current buffer is used.
|
|
|
619 Returns t if button is deleted, signals error otherwise. If called
|
|
|
620 with INTERACTIVE non-nil, derives BUT-KEY from the button that point is
|
|
|
621 within."
|
|
|
622 (let ((buf (current-buffer)) (ebut))
|
|
|
623 (if (if interactive
|
|
|
624 (ebut:delete)
|
|
|
625 (cond ((or (null key-src) (and (bufferp key-src) (setq buf key-src)))
|
|
|
626 (setq ebut (ebut:get but-key key-src)))
|
|
|
627 ((and (stringp key-src)
|
|
|
628 (setq buf (find-file-noselect key-src)))
|
|
|
629 (setq ebut (ebut:get but-key buf)))
|
|
|
630 (t (hypb:error "(ebut-delete): Invalid key-src: '%s'." key-src)))
|
|
|
631 (if ebut
|
|
|
632 (ebut:delete ebut)
|
|
|
633 (hypb:error "(ebut-delete): No valid %s button in %s."
|
|
|
634 (ebut:key-to-label but-key) buf))
|
|
|
635 )
|
|
|
636 (progn (set-buffer buf)
|
|
|
637 (if interactive
|
|
|
638 (progn
|
|
|
639 (call-interactively 'hui:ebut-unmark)
|
|
|
640 (message "Button deleted."))
|
|
|
641 (hui:ebut-unmark but-key key-src))
|
|
|
642 (if (hmail:reader-p) (hmail:msg-narrow))
|
|
|
643 )
|
|
|
644 (hypb:error "(ebut-delete): You may not delete buttons from this buffer."))))
|
|
|
645
|
|
|
646 (defun hui:ebut-delimit (start end instance-str)
|
|
|
647 (hypb:error "(hui:ebut-delimit): Obsolete, use ebut:delimit instead."))
|
|
|
648
|
|
|
649 (defun hui:ebut-operate (curr-label new-label)
|
|
|
650 (hypb:error "(hui:ebut-operate): Obsolete, use ebut:operate instead."))
|
|
|
651
|
|
|
652 (defun hui:ebut-unmark (&optional but-key key-src directory)
|
|
|
653 "Remove delimiters from button given by BUT-KEY in KEY-SRC of DIRECTORY.
|
|
|
654 All args are optional, the current button and buffer file are the defaults."
|
|
|
655 (interactive)
|
|
|
656 (let ((form (function
|
|
|
657 (lambda ()
|
|
|
658 (let ((buffer-read-only) start end)
|
|
|
659 (setq start (match-beginning 0)
|
|
|
660 end (match-end 0))
|
|
|
661 (and (fboundp 'hproperty:but-delete)
|
|
|
662 (hproperty:but-delete start))
|
|
|
663 (skip-chars-backward " \t\n")
|
|
|
664 (skip-chars-backward "0-9")
|
|
|
665 (if (= (preceding-char) (string-to-char ebut:instance-sep))
|
|
|
666 (setq start (1- (point))))
|
|
|
667 (if (search-backward ebut:start (- (point) ebut:max-len) t)
|
|
|
668 (if current-prefix-arg
|
|
|
669 ;; Remove button label, delimiters and preceding
|
|
|
670 ;; space, if any.
|
|
|
671 (delete-region (max (point-min)
|
|
|
672 (1- (match-beginning 0)))
|
|
|
673 end)
|
|
|
674 ;;
|
|
|
675 ;; Remove button delimiters only.
|
|
|
676 ;;
|
|
|
677 ;; Remove button ending delimiter
|
|
|
678 (delete-region start end)
|
|
|
679 ;; Remove button starting delimiter
|
|
|
680 (delete-region (match-beginning 0)
|
|
|
681 (match-end 0)))))))))
|
|
|
682 (if (interactive-p)
|
|
|
683 (save-excursion
|
|
|
684 (if (search-forward ebut:end nil t) (funcall form)))
|
|
|
685 ;; Non-interactive invocation.
|
|
|
686 (let ((cur-p))
|
|
|
687 (if (and (or (null key-src) (eq key-src buffer-file-name))
|
|
|
688 (or (null directory) (eq directory default-directory)))
|
|
|
689 (setq cur-p t)
|
|
|
690 (set-buffer (find-file-noselect
|
|
|
691 (expand-file-name key-src directory))))
|
|
|
692 (save-excursion
|
|
|
693 (goto-char (point-min))
|
|
|
694 (if (re-search-forward (ebut:label-regexp but-key) nil t)
|
|
|
695 (progn (funcall form)
|
|
|
696 ;; If modified a buffer other than the current one,
|
|
|
697 ;; save it.
|
|
|
698 (or cur-p (save-buffer)))))))))
|
|
|
699
|
|
|
700 (defun hui:file-find (file-name)
|
|
|
701 "If FILE-NAME is readable, finds it, else signals an error."
|
|
|
702 (if (and (stringp file-name) (file-readable-p file-name))
|
|
|
703 (find-file file-name)
|
|
|
704 (hypb:error "(file-find): \"%s\" does not exist or is not readable."
|
|
|
705 file-name)))
|
|
|
706
|
|
|
707 (defun hui:hbut-term-highlight (start end)
|
|
|
708 "For terminals only: Emphasize a button spanning from START to END."
|
|
|
709 (save-restriction
|
|
|
710 (save-excursion
|
|
|
711 (goto-char start)
|
|
|
712 (narrow-to-region (point-min) start)
|
|
|
713 (sit-for 0)
|
|
|
714 (setq inverse-video t)
|
|
|
715 (goto-char (point-min))
|
|
|
716 (widen)
|
|
|
717 (narrow-to-region (point) end)
|
|
|
718 (sit-for 0)
|
|
|
719 (setq inverse-video nil)
|
|
|
720 )))
|
|
|
721
|
|
|
722 (defun hui:hbut-term-unhighlight (start end)
|
|
|
723 "For terminals only: Remove any emphasis from hyper-button at START to END."
|
|
|
724 (save-restriction
|
|
|
725 (save-excursion
|
|
|
726 (goto-char start)
|
|
|
727 (narrow-to-region (point-min) start)
|
|
|
728 (sit-for 0)
|
|
|
729 (setq inverse-video nil))))
|
|
|
730
|
|
|
731 (defun hui:help-ebut-highlight ()
|
|
|
732 "Highlight any explicit buttons in help buffer associated with current buffer."
|
|
|
733 (if (fboundp 'hproperty:but-create)
|
|
|
734 (save-excursion
|
|
|
735 (set-buffer
|
|
|
736 (get-buffer (hypb:help-buf-name)))
|
|
|
737 (hproperty:but-create))))
|
|
|
738
|
|
|
739 (defun hui:htype-delete (htype-sym)
|
|
|
740 "Deletes HTYPE-SYM from use in current Hyperbole session.
|
|
|
741 HTYPE-SYM must be redefined for use again."
|
|
|
742 (and htype-sym (symbolp htype-sym)
|
|
|
743 (let ((type
|
|
|
744 (intern (hargs:read-match
|
|
|
745 (concat "Delete from " (symbol-name htype-sym) ": ")
|
|
|
746 (mapcar 'list (htype:names htype-sym))
|
|
|
747 nil t nil htype-sym))))
|
|
|
748 (htype:delete type htype-sym))))
|
|
|
749
|
|
|
750 (defun hui:htype-help (htype-sym &optional no-sort)
|
|
|
751 "Displays documentation for types from HTYPE-SYM which match to a regexp.
|
|
|
752 Optional NO-SORT means display in decreasing priority order (natural order)."
|
|
|
753 (and htype-sym (symbolp htype-sym)
|
|
|
754 (let* ((tstr (symbol-name htype-sym))
|
|
|
755 (tprefix (concat tstr "::"))
|
|
|
756 (buf-name (hypb:help-buf-name (capitalize tstr)))
|
|
|
757 (temp-buffer-show-hook
|
|
|
758 (function
|
|
|
759 (lambda (buf)
|
|
|
760 (set-buffer buf) (goto-char (point-min))
|
|
|
761 (replace-regexp "^" " ") (goto-char (point-min))
|
|
|
762 (replace-string (concat " " tprefix) "")
|
|
|
763 (goto-char (point-min)) (set-buffer-modified-p nil)
|
|
|
764 (display-buffer buf nil))))
|
|
|
765 (temp-buffer-show-function temp-buffer-show-hook)
|
|
|
766 (names (htype:names htype-sym))
|
|
|
767 (term (hargs:read-match
|
|
|
768 (concat (capitalize tstr)
|
|
24
|
769 " to describe (RET for all): ")
|
|
0
|
770 (mapcar 'list (cons "" names))
|
|
|
771 nil t nil htype-sym))
|
|
|
772 nm-list
|
|
|
773 doc-list)
|
|
|
774 (setq nm-list
|
|
|
775 (if (string= term "")
|
|
|
776 (let ((type-names
|
|
|
777 (mapcar (function (lambda (nm) (concat tprefix nm)))
|
|
|
778 names)))
|
|
|
779 (if no-sort type-names
|
|
|
780 (sort type-names 'string<)))
|
|
|
781 (cons (concat tprefix term) nil))
|
|
|
782 doc-list (delq nil (mapcar
|
|
|
783 (function
|
|
|
784 (lambda (name)
|
|
|
785 (let ((doc (documentation
|
|
|
786 (intern-soft name))))
|
|
|
787 (if doc (cons name doc)))))
|
|
|
788 nm-list)))
|
|
|
789 (with-output-to-temp-buffer buf-name
|
|
|
790 (mapcar (function (lambda (nm-doc-cons)
|
|
|
791 (princ (car nm-doc-cons)) (terpri)
|
|
|
792 (princ (cdr nm-doc-cons)) (terpri)))
|
|
|
793 doc-list)))))
|
|
|
794
|
|
|
795 (defun hui:key-dir (but-buf)
|
|
|
796 "Returns button key src directory based on BUT-BUF, a buffer."
|
|
|
797 (if (bufferp but-buf)
|
|
|
798 (let ((file (buffer-file-name but-buf)))
|
|
|
799 (if file
|
|
|
800 (file-name-directory (hpath:symlink-referent file))
|
|
|
801 (cdr (assq 'default-directory (buffer-local-variables but-buf)))))
|
|
|
802 (hypb:error "(hui:key-dir): '%s' is not a valid buffer.")))
|
|
|
803
|
|
|
804 (defun hui:key-src (but-buf)
|
|
|
805 "Returns button key src location based on BUT-BUF, a buffer.
|
|
|
806 This is BUT-BUF when button data is stored in the buffer and the
|
|
|
807 button's source file name when the button data is stored externally."
|
|
|
808 (save-excursion
|
|
|
809 (set-buffer but-buf)
|
|
|
810 (cond ((hmail:mode-is-p) but-buf)
|
|
|
811 ((hpath:symlink-referent (buffer-file-name but-buf)))
|
|
|
812 (t but-buf))))
|
|
|
813
|
|
|
814 (defun hui:link-create (modify but-window lbl-key but-loc but-dir type-and-args)
|
|
|
815 "Creates or modifies a new Hyperbole button.
|
|
|
816 If MODIFY is non-nil, modifies button at point in BUT-WINDOW,
|
|
|
817 otherwise, prompts for button label and creates a button.
|
|
|
818 LBL-KEY is internal form of button label. BUT-LOC is file or buffer
|
|
|
819 in which to create button. BUT-DIR is directory of BUT-LOC.
|
|
|
820 TYPE-AND-ARGS is the action type for the button followed by any arguments it requires."
|
|
|
821 (hattr:set 'hbut:current 'loc but-loc)
|
|
|
822 (hattr:set 'hbut:current 'dir but-dir)
|
|
|
823 (hattr:set 'hbut:current 'actype (intern-soft
|
|
|
824 (concat "actypes::"
|
|
|
825 (symbol-name
|
|
|
826 (car type-and-args)))))
|
|
|
827 (hattr:set 'hbut:current 'args (cdr type-and-args))
|
|
|
828
|
|
|
829 (select-window but-window)
|
|
|
830 (let ((label (ebut:key-to-label lbl-key)))
|
|
|
831 (ebut:operate label (if modify label)))
|
|
|
832 )
|
|
|
833
|
|
|
834 (defun hui:link-possible-types ()
|
|
|
835 "Returns list of possible link types for a Hyperbole button link to point.
|
|
|
836 Each list element is a list of the link type and any arguments it requires.
|
|
|
837
|
|
|
838 The link types considered are fixed. Defining new link types will not alter
|
|
|
839 the possible types. The code must be changed to do that.
|
|
|
840
|
|
|
841 Referent Context Possible Link Type Returned
|
|
|
842 ----------------------------------------------------
|
|
|
843 Explicit Button link-to-ebut
|
|
|
844 or
|
|
|
845 Info Node link-to-Info-node
|
|
|
846 or
|
|
|
847 Mail Reader Msg link-to-mail
|
|
|
848
|
|
|
849 Outline Regexp Prefix link-to-string-match
|
|
|
850 or
|
|
|
851 Directory Name link-to-directory
|
|
|
852 or
|
|
|
853 File Name link-to-file
|
|
|
854 or
|
|
|
855 Koutline Cell link-to-kcell
|
|
|
856 or
|
|
|
857 Buffer attached to File link-to-file
|
|
|
858 or
|
|
|
859 Buffer without File link-to-buffer-tmp
|
|
|
860
|
|
|
861 Elisp Buffer at Start
|
|
|
862 or End of Sexpression eval-elisp
|
|
|
863 "
|
|
|
864 (let (val)
|
|
|
865 (delq nil
|
|
|
866 (list (if (ebut:at-p)
|
|
|
867 (list 'link-to-ebut buffer-file-name (ebut:label-p)))
|
|
|
868 (cond ((eq major-mode 'Info-mode)
|
|
|
869 (let ((hargs:reading-p 'Info-node))
|
|
|
870 (list 'link-to-Info-node (hargs:at-p))))
|
|
|
871 ((hmail:reader-p)
|
|
|
872 (list 'link-to-mail
|
|
|
873 (list (rmail:msg-id-get) buffer-file-name)))
|
|
|
874 )
|
|
|
875 (cond
|
|
|
876 ;; If link is within an outline-regexp prefix, use
|
|
|
877 ;; a link-to-string-match.
|
|
|
878 ((and (boundp 'outline-regexp)
|
|
|
879 (stringp outline-regexp)
|
|
|
880 (save-excursion
|
|
|
881 (<= (point)
|
|
|
882 (progn
|
|
|
883 (beginning-of-line)
|
|
|
884 (if (looking-at outline-regexp)
|
|
|
885 (match-end 0)
|
|
|
886 0)))))
|
|
|
887 (save-excursion
|
|
|
888 (end-of-line)
|
|
|
889 (let ((heading (buffer-substring
|
|
|
890 (point)
|
|
|
891 (progn (beginning-of-line) (point))))
|
|
|
892 (occur 1))
|
|
|
893 (while (search-backward heading nil t)
|
|
|
894 (setq occur (1+ occur)))
|
|
|
895 (list 'link-to-string-match
|
|
|
896 heading occur buffer-file-name))))
|
|
|
897 ((let ((hargs:reading-p 'directory))
|
|
|
898 (setq val (hargs:at-p t)))
|
|
|
899 (list 'link-to-directory val))
|
|
|
900 ((let ((hargs:reading-p 'file))
|
|
|
901 (setq val (hargs:at-p t)))
|
|
|
902 (list 'link-to-file val (point)))
|
|
|
903 ((eq major-mode 'kotl-mode)
|
|
|
904 (list 'link-to-kcell buffer-file-name (kcell-view:idstamp)))
|
|
|
905 (buffer-file-name
|
|
|
906 (list 'link-to-file buffer-file-name (point)))
|
|
|
907 (t (list 'link-to-buffer-tmp (buffer-name)))
|
|
|
908 )
|
|
|
909 (and (fboundp 'smart-emacs-lisp-mode-p)
|
|
|
910 (smart-emacs-lisp-mode-p)
|
|
|
911 (or (= (char-syntax (following-char)) ?\()
|
|
|
912 (= (char-syntax (preceding-char)) ?\)))
|
|
|
913 (setq val (hargs:sexpression-p))
|
|
|
914 (list 'eval-elisp val))
|
|
|
915 ))))
|
|
|
916
|
|
|
917
|
|
|
918 ;;; ************************************************************************
|
|
|
919 ;;; Private variables
|
|
|
920 ;;; ************************************************************************
|
|
|
921
|
|
|
922
|
|
|
923 (defvar hui:ebut-label-prev nil
|
|
|
924 "String value of previous button name during an explicit button rename.
|
|
|
925 At other times, values must be nil.")
|
|
|
926
|
|
|
927 (provide 'hui)
|
