|
428
|
1 ;;; gutter-items.el --- Gutter content for XEmacs.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1999 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Maintainer: XEmacs Development Team
|
|
|
6 ;; Keywords: frames, extensions, internal, dumped
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with Xmacs; see the file COPYING. If not, write to the
|
|
|
22 ;; Free Software Foundation, 59 Temple Place - Suite 330,
|
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
|
24
|
|
771
|
25 ;;; Gutter-specific buffers tab code
|
|
428
|
26
|
|
442
|
27 (defvar gutter-buffers-tab nil
|
|
|
28 "A tab widget in the gutter for displaying buffers.
|
|
|
29 Do not set this. Use `set-glyph-image' to change the properties of the tab.")
|
|
|
30
|
|
|
31 (defcustom gutter-buffers-tab-visible-p
|
|
|
32 (gutter-element-visible-p default-gutter-visible-p 'buffers-tab)
|
|
|
33 "Whether the buffers tab is globally visible.
|
|
|
34 This option should be set through the options menu."
|
|
|
35 :group 'buffers-tab
|
|
|
36 :type 'boolean
|
|
|
37 :set #'(lambda (var val)
|
|
|
38 (set-gutter-element-visible-p default-gutter-visible-p
|
|
|
39 'buffers-tab val)
|
|
|
40 (setq gutter-buffers-tab-visible-p val)))
|
|
|
41
|
|
444
|
42 (defcustom gutter-buffers-tab-enabled t
|
|
|
43 "*Whether to enable support for buffers tab in the gutter.
|
|
|
44 This is different to `gutter-buffers-tab-visible-p' which still runs hooks
|
|
|
45 even when the gutter is invisible."
|
|
|
46 :group 'buffers-tab
|
|
|
47 :type 'boolean)
|
|
|
48
|
|
438
|
49 (defvar gutter-buffers-tab-orientation 'top
|
|
|
50 "Where the buffers tab currently is. Do not set this.")
|
|
|
51
|
|
428
|
52 (defun add-tab-to-gutter ()
|
|
|
53 "Put a tab control in the gutter area to hold the most recent buffers."
|
|
438
|
54 (setq gutter-buffers-tab-orientation (default-gutter-position))
|
|
444
|
55 (let* ((gutter-string (copy-sequence "\n"))
|
|
|
56 (gutter-buffers-tab-extent (make-extent 0 1 gutter-string)))
|
|
|
57 (set-extent-begin-glyph gutter-buffers-tab-extent
|
|
|
58 (setq gutter-buffers-tab
|
|
|
59 (make-glyph)))
|
|
442
|
60 ;; Nuke all existing tabs
|
|
|
61 (remove-gutter-element top-gutter 'buffers-tab)
|
|
|
62 (remove-gutter-element bottom-gutter 'buffers-tab)
|
|
|
63 (remove-gutter-element left-gutter 'buffers-tab)
|
|
|
64 (remove-gutter-element right-gutter 'buffers-tab)
|
|
|
65 ;; Put tabs into all devices that will be able to display them
|
|
|
66 (mapcar
|
|
|
67 #'(lambda (x)
|
|
|
68 (when (valid-image-instantiator-format-p 'tab-control x)
|
|
|
69 (cond ((eq gutter-buffers-tab-orientation 'top)
|
|
|
70 ;; This looks better than a 3d border
|
|
|
71 (set-specifier top-gutter-border-width 0 'global x)
|
|
|
72 (set-gutter-element top-gutter 'buffers-tab
|
|
|
73 gutter-string 'global x))
|
|
|
74 ((eq gutter-buffers-tab-orientation 'bottom)
|
|
|
75 (set-specifier bottom-gutter-border-width 0 'global x)
|
|
|
76 (set-gutter-element bottom-gutter 'buffers-tab
|
|
|
77 gutter-string 'global x))
|
|
|
78 ((eq gutter-buffers-tab-orientation 'left)
|
|
|
79 (set-specifier left-gutter-border-width 0 'global x)
|
|
|
80 (set-gutter-element left-gutter 'buffers-tab
|
|
444
|
81 gutter-string 'global x))
|
|
442
|
82 ((eq gutter-buffers-tab-orientation 'right)
|
|
|
83 (set-specifier right-gutter-border-width 0 'global x)
|
|
|
84 (set-gutter-element right-gutter 'buffers-tab
|
|
444
|
85 gutter-string 'global x))
|
|
442
|
86 )))
|
|
|
87 (console-type-list))))
|
|
|
88
|
|
|
89 (defun update-tab-in-gutter (frame &optional force-selection)
|
|
428
|
90 "Update the tab control in the gutter area."
|
|
442
|
91 ;; dedicated frames don't get tabs
|
|
446
|
92 (unless (or (window-dedicated-p (frame-selected-window frame))
|
|
|
93 (frame-property frame 'popup))
|
|
442
|
94 (when (specifier-instance default-gutter-visible-p frame)
|
|
|
95 (unless (and gutter-buffers-tab
|
|
438
|
96 (eq (default-gutter-position)
|
|
|
97 gutter-buffers-tab-orientation))
|
|
428
|
98 (add-tab-to-gutter))
|
|
442
|
99 (when (valid-image-instantiator-format-p 'tab-control frame)
|
|
446
|
100 (let ((items (buffers-tab-items nil frame force-selection)))
|
|
|
101 (when items
|
|
|
102 (set-glyph-image
|
|
|
103 gutter-buffers-tab
|
|
|
104 (vector 'tab-control :descriptor "Buffers" :face buffers-tab-face
|
|
|
105 :orientation gutter-buffers-tab-orientation
|
|
|
106 (if (or (eq gutter-buffers-tab-orientation 'top)
|
|
|
107 (eq gutter-buffers-tab-orientation 'bottom))
|
|
|
108 :pixel-width :pixel-height)
|
|
|
109 (if (or (eq gutter-buffers-tab-orientation 'top)
|
|
|
110 (eq gutter-buffers-tab-orientation 'bottom))
|
|
|
111 '(gutter-pixel-width) '(gutter-pixel-height))
|
|
|
112 :items items)
|
|
|
113 frame)
|
|
|
114 ;; set-glyph-image will not make the gutter dirty
|
|
458
|
115 (set-gutter-dirty-p gutter-buffers-tab-orientation)))))))
|
|
428
|
116
|
|
442
|
117 ;; A myriad of different update hooks all doing slightly different things
|
|
444
|
118 (add-one-shot-hook
|
|
|
119 'after-init-hook
|
|
|
120 #'(lambda ()
|
|
|
121 ;; don't add the hooks if the user really doesn't want them
|
|
|
122 (when gutter-buffers-tab-enabled
|
|
|
123 (add-hook 'create-frame-hook
|
|
|
124 #'(lambda (frame)
|
|
|
125 (when gutter-buffers-tab (update-tab-in-gutter frame t))))
|
|
|
126 (add-hook 'buffer-list-changed-hook 'update-tab-in-gutter)
|
|
|
127 (add-hook 'default-gutter-position-changed-hook
|
|
|
128 #'(lambda ()
|
|
|
129 (when gutter-buffers-tab
|
|
|
130 (mapc #'update-tab-in-gutter (frame-list)))))
|
|
|
131 (add-hook 'gutter-element-visibility-changed-hook
|
|
|
132 #'(lambda (prop visible-p)
|
|
|
133 (when (and (eq prop 'buffers-tab) visible-p)
|
|
|
134 (mapc #'update-tab-in-gutter (frame-list)))))
|
|
|
135 (update-tab-in-gutter (selected-frame) t))))
|
|
|
136
|
|
428
|
137 ;;
|
|
|
138 ;; progress display
|
|
|
139 ;; ripped off from message display
|
|
|
140 ;;
|
|
442
|
141 (defcustom progress-feedback-use-echo-area nil
|
|
|
142 "*Whether progress gauge display should display in the echo area.
|
|
|
143 If NIL then progress gauges will be displayed with whatever native widgets
|
|
|
144 are available on the current console. If non-NIL then progress display will be
|
|
|
145 textual and displayed in the echo area."
|
|
|
146 :type 'boolean
|
|
|
147 :group 'gutter)
|
|
|
148
|
|
|
149 (defvar progress-glyph-height 24
|
|
|
150 "Height of the progress gauge glyph.")
|
|
|
151
|
|
|
152 (defvar progress-feedback-popup-period 0.5
|
|
|
153 "The time that the progress gauge should remain up after completion")
|
|
|
154
|
|
|
155 (defcustom progress-feedback-style 'large
|
|
|
156 "*Control the appearance of the progress gauge.
|
|
|
157 If 'large, the default, then the progress-feedback text is displayed
|
|
|
158 above the gauge itself. If 'small then the gauge and text are arranged
|
|
|
159 side-by-side."
|
|
|
160 :group 'gutter
|
|
|
161 :type '(choice (const :tag "large" large)
|
|
|
162 (const :tag "small" small)))
|
|
|
163
|
|
|
164 ;; private variables
|
|
|
165 (defvar progress-text-instantiator [string :data ""])
|
|
|
166 (defvar progress-layout-glyph (make-glyph))
|
|
|
167 (defvar progress-layout-instantiator nil)
|
|
|
168
|
|
|
169 (defvar progress-gauge-instantiator
|
|
|
170 [progress-gauge
|
|
|
171 :value 0
|
|
|
172 :pixel-height (eval progress-glyph-height)
|
|
|
173 :pixel-width 250
|
|
|
174 :descriptor "Progress"])
|
|
|
175
|
|
|
176 (defun set-progress-feedback-instantiator (&optional locale)
|
|
|
177 (cond
|
|
|
178 ((eq progress-feedback-style 'small)
|
|
|
179 (setq progress-glyph-height 16)
|
|
|
180 (setq progress-layout-instantiator
|
|
|
181 `[layout
|
|
|
182 :orientation horizontal
|
|
|
183 :margin-width 4
|
|
|
184 :items (,progress-gauge-instantiator
|
|
|
185 [button
|
|
|
186 :pixel-height (eval progress-glyph-height)
|
|
|
187 ;; 'quit is special and acts "asynchronously".
|
|
|
188 :descriptor "Stop" :callback 'quit]
|
|
|
189 ,progress-text-instantiator)])
|
|
458
|
190 (set-glyph-image progress-layout-glyph progress-layout-instantiator
|
|
|
191 locale))
|
|
442
|
192 (t
|
|
|
193 (setq progress-glyph-height 24)
|
|
|
194 (setq progress-layout-instantiator
|
|
|
195 `[layout
|
|
863
|
196 :orientation vertical :margin-width 4
|
|
|
197 :horizontally-justify left :vertically-justify center
|
|
442
|
198 :items (,progress-text-instantiator
|
|
|
199 [layout
|
|
|
200 :orientation horizontal
|
|
|
201 :items (,progress-gauge-instantiator
|
|
|
202 [button
|
|
|
203 :pixel-height (eval progress-glyph-height)
|
|
|
204 :descriptor " Stop "
|
|
|
205 ;; 'quit is special and acts "asynchronously".
|
|
|
206 :callback 'quit])])])
|
|
458
|
207 (set-glyph-image progress-layout-glyph progress-layout-instantiator
|
|
|
208 locale))))
|
|
|
209
|
|
|
210 (defvar progress-abort-glyph (make-glyph))
|
|
|
211
|
|
|
212 (defun set-progress-abort-instantiator (&optional locale)
|
|
|
213 (set-glyph-image progress-abort-glyph
|
|
863
|
214 `[layout :orientation vertical
|
|
|
215 :horizontally-justify left :vertically-justify center
|
|
458
|
216 :items (,progress-text-instantiator
|
|
|
217 [layout
|
|
|
218 :margin-width 4
|
|
|
219 :pixel-height progress-glyph-height
|
|
|
220 :orientation horizontal])]
|
|
|
221 locale))
|
|
442
|
222
|
|
428
|
223 (defvar progress-stack nil
|
|
|
224 "An alist of label/string pairs representing active progress gauges.
|
|
|
225 The first element in the list is currently displayed in the gutter area.
|
|
442
|
226 Do not modify this directly--use the `progress-feedback' or
|
|
|
227 `display-progress-feedback'/`clear-progress-feedback' functions.")
|
|
428
|
228
|
|
442
|
229 (defun progress-feedback-displayed-p (&optional return-string frame)
|
|
428
|
230 "Return a non-nil value if a progress gauge is presently displayed in the
|
|
|
231 gutter area. If optional argument RETURN-STRING is non-nil,
|
|
|
232 return a string containing the message, otherwise just return t."
|
|
|
233 (let ((buffer (get-buffer-create " *Gutter Area*")))
|
|
|
234 (and (< (point-min buffer) (point-max buffer))
|
|
|
235 (if return-string
|
|
|
236 (buffer-substring nil nil buffer)
|
|
|
237 t))))
|
|
|
238
|
|
|
239 ;;; Returns the string which remains in the echo area, or nil if none.
|
|
|
240 ;;; If label is nil, the whole message stack is cleared.
|
|
442
|
241 (defun clear-progress-feedback (&optional label frame no-restore)
|
|
|
242 "Remove any progress gauge with LABEL from the progress gauge-stack,
|
|
428
|
243 erasing it from the gutter area if it's currently displayed there.
|
|
|
244 If a message remains at the head of the progress-stack and NO-RESTORE
|
|
|
245 is nil, it will be displayed. The string which remains in the gutter
|
|
|
246 area will be returned, or nil if the progress-stack is now empty.
|
|
|
247 If LABEL is nil, the entire progress-stack is cleared.
|
|
|
248
|
|
|
249 Unless you need the return value or you need to specify a label,
|
|
|
250 you should just use (progress nil)."
|
|
442
|
251 (if (or (not (valid-image-instantiator-format-p 'progress-gauge frame))
|
|
|
252 progress-feedback-use-echo-area)
|
|
|
253 (clear-message label frame nil no-restore)
|
|
|
254 (or frame (setq frame (selected-frame)))
|
|
|
255 (remove-progress-feedback label frame)
|
|
502
|
256 (let ((inhibit-read-only t))
|
|
442
|
257 (erase-buffer (get-buffer-create " *Gutter Area*")))
|
|
|
258 (if no-restore
|
|
|
259 nil ; just preparing to put another msg up
|
|
|
260 (if progress-stack
|
|
|
261 (let ((oldmsg (cdr (car progress-stack))))
|
|
|
262 (raw-append-progress-feedback oldmsg nil frame)
|
|
|
263 oldmsg)
|
|
|
264 ;; nothing to display so get rid of the gauge
|
|
|
265 (set-specifier bottom-gutter-border-width 0 frame)
|
|
|
266 (set-gutter-element-visible-p bottom-gutter-visible-p
|
|
|
267 'progress nil frame)))))
|
|
428
|
268
|
|
442
|
269 (defun progress-feedback-clear-when-idle (&optional label)
|
|
|
270 (add-one-shot-hook 'pre-idle-hook
|
|
|
271 `(lambda ()
|
|
|
272 (clear-progress-feedback ',label))))
|
|
|
273
|
|
|
274 (defun remove-progress-feedback (&optional label frame)
|
|
428
|
275 ;; If label is nil, we want to remove all matching progress gauges.
|
|
|
276 (while (and progress-stack
|
|
|
277 (or (null label) ; null label means clear whole stack
|
|
|
278 (eq label (car (car progress-stack)))))
|
|
|
279 (setq progress-stack (cdr progress-stack)))
|
|
|
280 (let ((s progress-stack))
|
|
|
281 (while (cdr s)
|
|
|
282 (let ((msg (car (cdr s))))
|
|
|
283 (if (eq label (car msg))
|
|
|
284 (progn
|
|
|
285 (setcdr s (cdr (cdr s))))
|
|
|
286 (setq s (cdr s)))))))
|
|
|
287
|
|
442
|
288 (defun progress-feedback-dispatch-non-command-events ()
|
|
|
289 ;; don't allow errors to hose things
|
|
|
290 (condition-case t
|
|
|
291 ;; (sit-for 0) is too agressive and cause more display than we
|
|
|
292 ;; want.
|
|
|
293 (dispatch-non-command-events)
|
|
|
294 nil))
|
|
|
295
|
|
|
296 (defun append-progress-feedback (label message &optional value frame)
|
|
428
|
297 (or frame (setq frame (selected-frame)))
|
|
|
298 ;; Add a new entry to the message-stack, or modify an existing one
|
|
|
299 (let* ((top (car progress-stack))
|
|
|
300 (tmsg (cdr top)))
|
|
|
301 (if (eq label (car top))
|
|
|
302 (progn
|
|
|
303 (setcdr top message)
|
|
442
|
304 (if (equal tmsg message)
|
|
|
305 (progn
|
|
|
306 (set-instantiator-property progress-gauge-instantiator :value value)
|
|
|
307 (set-progress-feedback-instantiator (frame-selected-window frame)))
|
|
|
308 (raw-append-progress-feedback message value frame))
|
|
|
309 (redisplay-gutter-area))
|
|
428
|
310 (push (cons label message) progress-stack)
|
|
442
|
311 (raw-append-progress-feedback message value frame))
|
|
|
312 (progress-feedback-dispatch-non-command-events)
|
|
|
313 ;; either get command events or sit waiting for them
|
|
|
314 (when (eq value 100)
|
|
|
315 ; (sit-for progress-feedback-popup-period nil)
|
|
|
316 (clear-progress-feedback label))))
|
|
428
|
317
|
|
442
|
318 (defun abort-progress-feedback (label message &optional frame)
|
|
|
319 (if (or (not (valid-image-instantiator-format-p 'progress-gauge frame))
|
|
|
320 progress-feedback-use-echo-area)
|
|
|
321 (display-message label (concat message "aborted.") frame)
|
|
|
322 (or frame (setq frame (selected-frame)))
|
|
|
323 ;; Add a new entry to the message-stack, or modify an existing one
|
|
|
324 (let* ((top (car progress-stack))
|
|
502
|
325 (inhibit-read-only t))
|
|
442
|
326 (if (eq label (car top))
|
|
|
327 (setcdr top message)
|
|
|
328 (push (cons label message) progress-stack))
|
|
|
329 (unless (equal message "")
|
|
|
330 (insert-string message (get-buffer-create " *Gutter Area*"))
|
|
|
331 (let* ((gutter-string (copy-sequence "\n"))
|
|
|
332 (ext (make-extent 0 1 gutter-string)))
|
|
|
333 ;; do some funky display here.
|
|
|
334 (set-extent-begin-glyph ext progress-abort-glyph)
|
|
428
|
335 ;; fixup the gutter specifiers
|
|
442
|
336 (set-gutter-element bottom-gutter 'progress gutter-string frame)
|
|
428
|
337 (set-specifier bottom-gutter-border-width 2 frame)
|
|
458
|
338 (set-instantiator-property progress-text-instantiator :data message)
|
|
|
339 (set-progress-abort-instantiator (frame-selected-window frame))
|
|
428
|
340 (set-specifier bottom-gutter-height 'autodetect frame)
|
|
442
|
341 (set-gutter-element-visible-p bottom-gutter-visible-p
|
|
|
342 'progress t frame)
|
|
428
|
343 ;; we have to do this so redisplay is up-to-date and so
|
|
|
344 ;; redisplay-gutter-area performs optimally.
|
|
|
345 (redisplay-gutter-area)
|
|
442
|
346 (sit-for progress-feedback-popup-period nil)
|
|
|
347 (clear-progress-feedback label frame)
|
|
|
348 (set-extent-begin-glyph ext progress-layout-glyph)
|
|
|
349 (set-gutter-element bottom-gutter 'progress gutter-string frame)
|
|
428
|
350 )))))
|
|
|
351
|
|
442
|
352 (defun raw-append-progress-feedback (message &optional value frame)
|
|
428
|
353 (unless (equal message "")
|
|
442
|
354 (let* ((inhibit-read-only t)
|
|
|
355 (val (or value 0))
|
|
|
356 (gutter-string (copy-sequence "\n"))
|
|
|
357 (ext (make-extent 0 1 gutter-string)))
|
|
428
|
358 (insert-string message (get-buffer-create " *Gutter Area*"))
|
|
442
|
359 ;; do some funky display here.
|
|
|
360 (set-extent-begin-glyph ext progress-layout-glyph)
|
|
|
361 ;; fixup the gutter specifiers
|
|
|
362 (set-gutter-element bottom-gutter 'progress gutter-string frame)
|
|
|
363 (set-specifier bottom-gutter-border-width 2 frame)
|
|
|
364 (set-instantiator-property progress-gauge-instantiator :value val)
|
|
|
365 (set-progress-feedback-instantiator (frame-selected-window frame))
|
|
|
366
|
|
|
367 (set-instantiator-property progress-text-instantiator :data message)
|
|
|
368 (set-progress-feedback-instantiator (frame-selected-window frame))
|
|
|
369 (if (and (eq (specifier-instance bottom-gutter-height frame)
|
|
|
370 'autodetect)
|
|
|
371 (gutter-element-visible-p bottom-gutter-visible-p
|
|
|
372 'progress frame))
|
|
|
373 ;; if the gauge is already visible then just draw the gutter
|
|
|
374 ;; checking for user events
|
|
428
|
375 (progn
|
|
442
|
376 (redisplay-gutter-area)
|
|
|
377 (progress-feedback-dispatch-non-command-events))
|
|
|
378 ;; otherwise make the gutter visible and redraw the frame
|
|
|
379 (set-specifier bottom-gutter-height 'autodetect frame)
|
|
|
380 (set-gutter-element-visible-p bottom-gutter-visible-p
|
|
|
381 'progress t frame)
|
|
|
382 ;; we have to do this so redisplay is up-to-date and so
|
|
|
383 ;; redisplay-gutter-area performs optimally. This may also
|
|
|
384 ;; make sure the frame geometry looks ok.
|
|
|
385 (progress-feedback-dispatch-non-command-events)
|
|
|
386 (redisplay-frame frame)
|
|
|
387 ))))
|
|
428
|
388
|
|
442
|
389 (defun display-progress-feedback (label message &optional value frame)
|
|
428
|
390 "Display a progress gauge and message in the bottom gutter area.
|
|
|
391 First argument LABEL is an identifier for this message. MESSAGE is
|
|
442
|
392 the string to display. Use `clear-progress-feedback' to remove a labelled
|
|
428
|
393 message."
|
|
442
|
394 (cond ((eq value 'abort)
|
|
|
395 (abort-progress-feedback label message frame))
|
|
|
396 ((or (not (valid-image-instantiator-format-p 'progress-gauge frame))
|
|
|
397 progress-feedback-use-echo-area)
|
|
|
398 (display-message label
|
|
|
399 (concat message (if (eq value 100) "done."
|
|
|
400 (make-string (/ value 5) ?.)))
|
|
|
401 frame))
|
|
|
402 (t
|
|
|
403 (append-progress-feedback label message value frame))))
|
|
428
|
404
|
|
442
|
405 (defun current-progress-feedback (&optional frame)
|
|
428
|
406 "Return the current progress gauge in the gutter area, or nil.
|
|
|
407 The FRAME argument is currently unused."
|
|
|
408 (cdr (car progress-stack)))
|
|
|
409
|
|
|
410 ;;; may eventually be frame-dependent
|
|
442
|
411 (defun current-progress-feedback-label (&optional frame)
|
|
428
|
412 (car (car progress-stack)))
|
|
|
413
|
|
442
|
414 (defun progress-feedback (fmt &optional value &rest args)
|
|
428
|
415 "Print a progress gauge and message in the bottom gutter area of the frame.
|
|
|
416 The arguments are the same as to `format'.
|
|
|
417
|
|
|
418 If the only argument is nil, clear any existing progress gauge."
|
|
442
|
419 (save-excursion
|
|
|
420 (if (and (null fmt) (null args))
|
|
|
421 (prog1 nil
|
|
|
422 (clear-progress-feedback nil))
|
|
|
423 (let ((str (apply 'format fmt args)))
|
|
|
424 (display-progress-feedback 'progress str value)
|
|
|
425 str))))
|
|
428
|
426
|
|
442
|
427 (defun progress-feedback-with-label (label fmt &optional value &rest args)
|
|
428
|
428 "Print a progress gauge and message in the bottom gutter area of the frame.
|
|
|
429 First argument LABEL is an identifier for this progress gauge. The rest of the
|
|
|
430 arguments are the same as to `format'."
|
|
442
|
431 ;; #### sometimes the buffer gets changed temporarily. I don't know
|
|
|
432 ;; why this is, so protect against it.
|
|
|
433 (save-excursion
|
|
|
434 (if (and (null fmt) (null args))
|
|
|
435 (prog1 nil
|
|
|
436 (clear-progress-feedback label nil))
|
|
|
437 (let ((str (apply 'format fmt args)))
|
|
|
438 (display-progress-feedback label str value)
|
|
|
439 str))))
|
|
428
|
440
|
|
|
441 (provide 'gutter-items)
|
|
|
442 ;;; gutter-items.el ends here.
|
