(defcustom gutter-buffers-tab-visible-p
(gutter-element-visible-p default-gutter-visible-p 'buffers-tab)
"Whether the buffers tab is globally visible.
-This option should be set through the options menu."
+
+There are side-effects, so don't setq it; use Customize or the options menu."
:group 'buffers-tab
:type 'boolean
:set #'(lambda (var val)
:group 'buffers-tab)
(defcustom buffers-tab-omit-function 'buffers-menu-omit-invisible-buffers
- "*If non-nil, a function specifying the buffers to omit from the buffers tab.
+ "*A function specifying the buffers to omit from the buffers tab, or nil.
This is passed a buffer and should return non-nil if the buffer should be
omitted. The default value `buffers-menu-omit-invisible-buffers' omits
buffers that are normally considered \"invisible\" (those whose name
function)
:group 'buffers-tab)
-(defcustom buffers-tab-selection-function 'select-buffers-tab-buffers-by-mode
- "*If non-nil, a function specifying the buffers to select from the
-buffers tab. This is passed two buffers and should return non-nil if
-the second buffer should be selected. The default value
-`select-buffers-tab-buffers-by-mode' groups buffers by major mode and
-by `buffers-tab-grouping-regexp'."
-
- :type '(choice (const :tag "None" nil)
- function)
+(make-obsolete-variable 'buffers-tab-selection-function
+ 'buffers-tab-filter-functions)
+(defcustom buffers-tab-selection-function nil
+ "*A function specifying buffers to display in the buffers tab, or nil.
+Don't use this---it is never consulted. Use `buffers-tab-filter-functions'
+instead.
+
+The function must take arguments (BUF1 BUF2). BUF1 is a candidate for
+display in the buffers tab control. BUF2 is current (first in the buffers
+list). Return non-nil if BUF1 should be added to the tab control."
+ :type '(choice function (const :tag "None" nil))
:group 'buffers-tab)
-(defcustom buffers-tab-filter-functions (list buffers-tab-selection-function)
- "*If non-nil, a list of functions specifying the buffers to select
-from the buffers tab.
-Each function in the list is passed two buffers, the buffer to
-potentially select and the context buffer, and should return non-nil
-if the first buffer should be selected. The default value groups
-buffers by major mode and by `buffers-tab-grouping-regexp'."
+(defcustom buffers-tab-filter-functions '(select-buffers-tab-buffers-by-mode)
+ "*A list of functions specifying buffers to display in the buffers tab.
- :type '(choice (const :tag "None" nil)
- sexp)
+If nil, all buffers are kept, up to `buffers-tab-max-size', in usual order.
+Otherwise, each function in the list must take arguments (BUF1 BUF2).
+BUF1 is the candidate, and BUF2 is the current buffer (first in the buffers
+list). The function should return non-nil if BUF1 should be added to the
+buffers tab. BUF1 will be omitted if any of the functions returns nil.
+
+Defaults to `select-buffers-tab-buffers-by-mode', which adds BUF1 if BUF1 and
+BUF2 have the same major mode, or both match `buffers-tab-grouping-regexp'."
+ :type '(repeat function)
:group 'buffers-tab)
(defcustom buffers-tab-sort-function nil
:group 'buffers-tab)
(make-face 'buffers-tab "Face for displaying the buffers tab.")
-(set-face-parent 'buffers-tab 'default)
+(set-face-parent 'buffers-tab 'modeline)
(defcustom buffers-tab-face 'buffers-tab
"*Face to use for displaying the buffers tab."
(and (integerp buffers-tab-max-size)
(> buffers-tab-max-size 1)
(> (length buffers) buffers-tab-max-size)
- (setcdr (nthcdr buffers-tab-max-size buffers) nil))
+ (setcdr (nthcdr (1- buffers-tab-max-size) buffers) nil))
;; sort buffers in group (default is most-recently-selected)
(when buffers-tab-sort-function
(setq buffers (funcall buffers-tab-sort-function buffers)))
(defun update-tab-in-gutter (frame &optional force-selection)
"Update the tab control in the gutter area."
;; dedicated frames don't get tabs
- (unless (window-dedicated-p (frame-selected-window frame))
+ (unless (or (window-dedicated-p (frame-selected-window frame))
+ (frame-property frame 'popup))
(when (specifier-instance default-gutter-visible-p frame)
(unless (and gutter-buffers-tab
(eq (default-gutter-position)
gutter-buffers-tab-orientation))
(add-tab-to-gutter))
(when (valid-image-instantiator-format-p 'tab-control frame)
- (set-glyph-image
- gutter-buffers-tab
- (vector 'tab-control :descriptor "Buffers" :face buffers-tab-face
- :orientation gutter-buffers-tab-orientation
- (if (or (eq gutter-buffers-tab-orientation 'top)
- (eq gutter-buffers-tab-orientation 'bottom))
- :pixel-width :pixel-height)
- (if (or (eq gutter-buffers-tab-orientation 'top)
- (eq gutter-buffers-tab-orientation 'bottom))
- '(gutter-pixel-width) '(gutter-pixel-height))
- :items (buffers-tab-items nil frame force-selection))
- frame)
- ;; set-glyph-image will not make the gutter dirty
- (set-specifier-dirty-flag
- (eval (intern (concat
- (symbol-name gutter-buffers-tab-orientation)
- "-gutter"))))))))
+ (let ((items (buffers-tab-items nil frame force-selection)))
+ (when items
+ (set-glyph-image
+ gutter-buffers-tab
+ (vector 'tab-control :descriptor "Buffers" :face buffers-tab-face
+ :orientation gutter-buffers-tab-orientation
+ (if (or (eq gutter-buffers-tab-orientation 'top)
+ (eq gutter-buffers-tab-orientation 'bottom))
+ :pixel-width :pixel-height)
+ (if (or (eq gutter-buffers-tab-orientation 'top)
+ (eq gutter-buffers-tab-orientation 'bottom))
+ '(gutter-pixel-width) '(gutter-pixel-height))
+ :items items)
+ frame)
+ ;; set-glyph-image will not make the gutter dirty
+ (set-gutter-dirty-p gutter-buffers-tab-orientation)))))))
;; A myriad of different update hooks all doing slightly different things
(add-one-shot-hook
(setq progress-glyph-height 16)
(setq progress-layout-instantiator
`[layout
- :orientation horizontal
- :margin-width 4
+ :orientation vertical :margin-width 4
+ :horizontally-justify left :vertically-justify center
:items (,progress-gauge-instantiator
[button
:pixel-height (eval progress-glyph-height)
;; 'quit is special and acts "asynchronously".
:descriptor "Stop" :callback 'quit]
,progress-text-instantiator)])
- (set-glyph-image progress-layout-glyph progress-layout-instantiator locale))
+ (set-glyph-image progress-layout-glyph progress-layout-instantiator
+ locale))
(t
(setq progress-glyph-height 24)
(setq progress-layout-instantiator
`[layout
- :orientation vertical :justify left
- :margin-width 4
+ :orientation vertical :margin-width 4
+ :horizontally-justify left :vertically-justify center
:items (,progress-text-instantiator
[layout
:orientation horizontal
:descriptor " Stop "
;; 'quit is special and acts "asynchronously".
:callback 'quit])])])
- (set-glyph-image progress-layout-glyph progress-layout-instantiator locale))))
+ (set-glyph-image progress-layout-glyph progress-layout-instantiator
+ locale))))
+
+(defvar progress-abort-glyph (make-glyph))
+
+(defun set-progress-abort-instantiator (&optional locale)
+ (set-glyph-image progress-abort-glyph
+ `[layout :orientation vertical
+ :horizontally-justify left :vertically-justify center
+ :items (,progress-text-instantiator
+ [layout
+ :margin-width 4
+ :pixel-height progress-glyph-height
+ :orientation horizontal])]
+ locale))
(defvar progress-stack nil
"An alist of label/string pairs representing active progress gauges.
Do not modify this directly--use the `progress-feedback' or
`display-progress-feedback'/`clear-progress-feedback' functions.")
-(defvar progress-abort-glyph
- (make-glyph
- `[layout :orientation vertical :justify left
- :items (,progress-text-instantiator
- [layout
- :margin-width 4
- :pixel-height progress-glyph-height
- :orientation horizontal])]))
-
(defun progress-feedback-displayed-p (&optional return-string frame)
"Return a non-nil value if a progress gauge is presently displayed in the
gutter area. If optional argument RETURN-STRING is non-nil,
;; fixup the gutter specifiers
(set-gutter-element bottom-gutter 'progress gutter-string frame)
(set-specifier bottom-gutter-border-width 2 frame)
- (set-instantiator-property progress-text-instantiator :datat message)
- (set-progress-feedback-instantiator (frame-selected-window frame))
+ (set-instantiator-property progress-text-instantiator :data message)
+ (set-progress-abort-instantiator (frame-selected-window frame))
(set-specifier bottom-gutter-height 'autodetect frame)
(set-gutter-element-visible-p bottom-gutter-visible-p
'progress t frame)
(defun progress-feedback-with-label (label fmt &optional value &rest args)
"Print a progress gauge and message in the bottom gutter area of the frame.
-First argument LABEL is an identifier for this progress gauge. The rest of the
-arguments are the same as to `format'."
+LABEL is an identifier for this progress gauge.
+FMT is a format string to be passed to `format' along with ARGS.
+Optional VALUE is the current degree of progress, an integer 0-100.
+The remaining ARGS are passed with FMT `(apply #'format FMT ARGS)'."
;; #### sometimes the buffer gets changed temporarily. I don't know
;; why this is, so protect against it.
(save-excursion
projects / chise / xemacs-chise.git.1 / blobdiff