XEmacs 21.4.5 "Civil Service".

[chise/xemacs-chise.git.1] / lisp / gutter-items.el

diff --git a/lisp/gutter-items.el b/lisp/gutter-items.el
index d5676d3..018b935 100644 (file)
--- a/lisp/gutter-items.el
+++ b/lisp/gutter-items.el
@@ -118,7 +118,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."
@@ -277,7 +277,7 @@ redefining the function `format-buffers-menu-line'."
       (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)))
@@ -325,30 +325,30 @@ redefining the function `format-buffers-menu-line'."
 (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 
@@ -423,7 +423,8 @@ side-by-side."
                     ;; '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
@@ -439,7 +440,20 @@ 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 :justify left
+                           :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.
@@ -447,15 +461,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,
@@ -567,8 +572,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)