Mercurial > hg > xemacs-beta

comparison lisp/gutter-items.el @ 440:8de8e3f6228a r21-2-28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 84b14dcb0985
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
27 ;; and the custom specs in toolbar.el. 27 ;; and the custom specs in toolbar.el.
28 28
29 (defgroup gutter nil 29 (defgroup gutter nil
30 "Input from the gutters." 30 "Input from the gutters."
31 :group 'environment) 31 :group 'environment)
32
33 (defvar gutter-buffers-tab nil
34 "A tab widget in the gutter for displaying buffers.
35 Do not set this. Use `glyph-image-instance' and
36 `set-image-instance-property' to change the properties of the tab.")
32 37
33 (defcustom gutter-visible-p 38 (defcustom gutter-visible-p
34 (specifier-instance default-gutter-visible-p) 39 (specifier-instance default-gutter-visible-p)
35 "Whether the default gutter is globally visible. This option can be 40 "Whether the default gutter is globally visible. This option can be
36 customized through the options menu." 41 customized through the options menu."
37 :group 'display 42 :group 'display
38 :type 'boolean 43 :type 'boolean
39 :set #'(lambda (var val) 44 :set #'(lambda (var val)
40 (set-specifier default-gutter-visible-p val) 45 (set-specifier default-gutter-visible-p val)
41 (setq gutter-visible-p val))) 46 (setq gutter-visible-p val)
42 47 (when gutter-buffers-tab (update-tab-in-gutter))))
43 (defvar gutter-buffers-tab nil
44 "A tab widget in the gutter for displaying buffers.
45 Do not set this. Use `glyph-image-instance' and
46 `set-image-instance-property' to change the properties of the tab.")
47 48
48 (defcustom default-gutter-position 49 (defcustom default-gutter-position
49 (default-gutter-position) 50 (default-gutter-position)
50 "The location of the default gutter. It can be 'top, 'bottom, 'left or 51 "The location of the default gutter. It can be 'top, 'bottom, 'left or
51 'right. This option can be customized through the options menu." 52 'right. This option can be customized through the options menu."
191 "For use as a value of `buffers-tab-format-buffer-line-function'. 192 "For use as a value of `buffers-tab-format-buffer-line-function'.
192 This just returns the buffer's name, optionally truncated." 193 This just returns the buffer's name, optionally truncated."
193 (let ((len (specifier-instance buffers-tab-default-buffer-line-length))) 194 (let ((len (specifier-instance buffers-tab-default-buffer-line-length)))
194 (if (and (> len 0) 195 (if (and (> len 0)
195 (> (length (buffer-name buffer)) len)) 196 (> (length (buffer-name buffer)) len))
196 (concat (substring (buffer-name buffer) 197 (if (string-match ".*<.>$" (buffer-name buffer))
197 0 (- len 3)) "...") 198 (concat (substring (buffer-name buffer)
199 0 (- len 6)) "..."
200 (substring (buffer-name buffer) -3))
201 (concat (substring (buffer-name buffer)
202 0 (- len 3)) "..."))
198 (buffer-name buffer)))) 203 (buffer-name buffer))))
199 204
200 (defsubst build-buffers-tab-internal (buffers) 205 (defsubst build-buffers-tab-internal (buffers)
201 (let (line) 206 (let (line)
202 (mapcar 207 (mapcar
280 (when (specifier-instance default-gutter-visible-p locale) 285 (when (specifier-instance default-gutter-visible-p locale)
281 (unless (and gutter-buffers-tab 286 (unless (and gutter-buffers-tab
282 (eq (default-gutter-position) 287 (eq (default-gutter-position)
283 gutter-buffers-tab-orientation)) 288 gutter-buffers-tab-orientation))
284 (add-tab-to-gutter)) 289 (add-tab-to-gutter))
285 (when (valid-image-instantiator-format-p 'tab-control) 290 (when (valid-image-instantiator-format-p 'tab-control locale)
286 (let ((inst (glyph-image-instance 291 (let ((inst (glyph-image-instance
287 gutter-buffers-tab 292 gutter-buffers-tab
288 (when (framep frame-or-buffer) 293 (when (framep frame-or-buffer)
289 (last-nonminibuf-window frame-or-buffer))))) 294 (last-nonminibuf-window frame-or-buffer)))))
290 (set-image-instance-property inst :items 295 (set-image-instance-property inst :items
333 ;; private variables 338 ;; private variables
334 (defvar progress-gauge-glyph 339 (defvar progress-gauge-glyph
335 (make-glyph 340 (make-glyph
336 (vector 'progress-gauge 341 (vector 'progress-gauge
337 :pixel-height (- progress-glyph-height 8) 342 :pixel-height (- progress-glyph-height 8)
338 :pixel-width 250 343 :pixel-width 50
339 :descriptor "Progress"))) 344 :descriptor "Progress")))
340 345
341 (defvar progress-text-glyph 346 (defvar progress-text-glyph
342 (make-glyph [string :data ""])) 347 (make-glyph [string :data ""]))
343 348