X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgutter-items.el;h=8ac62f6c26b51692ac63a5c5ac4e315fb898b0b8;hb=1532bc4f9d544bee853b875b78703699bee95fdc;hp=b63504a6e4e04bd66abebb2911af4f883972efb2;hpb=0c693dc08f0794304711787b2eb47c144ea4bef1;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/gutter-items.el b/lisp/gutter-items.el index b63504a..8ac62f6 100644 --- a/lisp/gutter-items.el +++ b/lisp/gutter-items.el @@ -39,7 +39,8 @@ Do not set this. Use `set-glyph-image' to change the properties of the tab.") (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) @@ -75,7 +76,7 @@ a large number or nil will slow down tab responsiveness." :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 @@ -84,27 +85,31 @@ begins with a space)." 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 @@ -118,7 +123,7 @@ list in `buffer-list' order (usual most-recently-selected-first)." :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." @@ -348,10 +353,7 @@ redefining the function `format-buffers-menu-line'." :items items) frame) ;; set-glyph-image will not make the gutter dirty - (set-specifier-dirty-flag - (eval (intern (concat - (symbol-name gutter-buffers-tab-orientation) - "-gutter")))))))))) + (set-gutter-dirty-p gutter-buffers-tab-orientation))))))) ;; A myriad of different update hooks all doing slightly different things (add-one-shot-hook @@ -418,21 +420,22 @@ side-by-side." (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 @@ -442,7 +445,21 @@ side-by-side." :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. @@ -450,15 +467,6 @@ The first element in the list is currently displayed in the gutter area. 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, @@ -570,8 +578,8 @@ you should just use (progress 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) @@ -662,8 +670,10 @@ If the only argument is nil, clear any existing progress gauge." (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