diff lisp/gutter-items.el @ 438:84b14dcb0985 r21-2-27

Import from CVS: tag r21-2-27
author cvs
date Mon, 13 Aug 2007 11:32:25 +0200
parents a5df635868b2
children 8de8e3f6228a
line wrap: on
line diff
--- a/lisp/gutter-items.el	Mon Aug 13 11:31:26 2007 +0200
+++ b/lisp/gutter-items.el	Mon Aug 13 11:32:25 2007 +0200
@@ -40,6 +40,11 @@
 	   (set-specifier default-gutter-visible-p val)
 	   (setq gutter-visible-p val)))
 
+(defvar gutter-buffers-tab nil
+  "A tab widget in the gutter for displaying buffers.
+Do not set this. Use `glyph-image-instance' and
+`set-image-instance-property' to change the properties of the tab.")
+
 (defcustom default-gutter-position
   (default-gutter-position)
   "The location of the default gutter. It can be 'top, 'bottom, 'left or
@@ -51,7 +56,8 @@
 		 (const :tag "right" 'right))
   :set #'(lambda (var val)
 	   (set-default-gutter-position val)
-	   (setq default-gutter-position val)))
+	   (setq default-gutter-position val)
+	   (when gutter-buffers-tab (update-tab-in-gutter))))
 
 ;;; The Buffers tab
 
@@ -59,10 +65,10 @@
   "Customization of `Buffers' tab."
   :group 'gutter)
 
-(defvar gutter-buffers-tab nil
-  "A tab widget in the gutter for displaying buffers.
-Do not set this. Use `glyph-image-instance' and
-`set-image-instance-property' to change the properties of the tab.")
+(defvar gutter-buffers-tab-orientation 'top
+  "Where the buffers tab currently is. Do not set this.")
+
+(defvar gutter-buffers-tab-extent nil)
 
 (defcustom buffers-tab-max-size 6
   "*Maximum number of entries which may appear on the \"Buffers\" tab.
@@ -102,7 +108,10 @@
 		 function)
   :group 'buffers-tab)
 
-(defcustom buffers-tab-face 'default
+(make-face 'buffers-tab "Face for displaying the buffers tab.")
+(set-face-parent 'buffers-tab 'default)
+
+(defcustom buffers-tab-face 'buffers-tab
   "*Face to use for displaying the buffers tab."
   :type 'face
   :group 'buffers-tab)
@@ -227,25 +236,51 @@
 
 (defun add-tab-to-gutter ()
   "Put a tab control in the gutter area to hold the most recent buffers."
+  (setq gutter-buffers-tab-orientation (default-gutter-position))
   (let ((gutter-string ""))
+    (unless gutter-buffers-tab-extent
+      (setq gutter-buffers-tab-extent (make-extent 0 0 gutter-string)))
     (set-extent-begin-glyph 
-     (make-extent 0 0 gutter-string)
+     gutter-buffers-tab-extent
      (setq gutter-buffers-tab 
 	   (make-glyph 
 	    (vector 'tab-control :descriptor "Buffers" :face buffers-tab-face
+		    :orientation gutter-buffers-tab-orientation
 		    :properties (list :items (buffers-tab-items))))))
     ;; This looks better than a 3d border
     (mapcar '(lambda (x)
 	       (when (valid-image-instantiator-format-p 'tab-control x)
 		 (set-specifier default-gutter-border-width 0 'global x)
-		 (set-specifier default-gutter gutter-string 'global x)))
+		 (set-specifier top-gutter nil 'global x)
+		 (set-specifier bottom-gutter nil 'global x)
+		 (set-specifier left-gutter nil 'global x)
+		 (set-specifier right-gutter nil 'global x)
+		 (set-specifier left-gutter-width 0 'global x)
+		 (set-specifier right-gutter-width 0 'global x)
+		 (cond ((eq gutter-buffers-tab-orientation 'top)
+			(set-specifier top-gutter gutter-string 'global x))
+		       ((eq gutter-buffers-tab-orientation 'bottom)
+			(set-specifier bottom-gutter gutter-string 'global x))
+		       ((eq gutter-buffers-tab-orientation 'left)
+			(set-specifier left-gutter gutter-string 'global x)
+			(set-specifier left-gutter-width
+				       (glyph-width gutter-buffers-tab)
+				       'global x))
+		       ((eq gutter-buffers-tab-orientation 'right)
+			(set-specifier right-gutter gutter-string 'global x)
+			(set-specifier right-gutter-width
+				       (glyph-width gutter-buffers-tab)
+				       'global x))
+		       )))
 	    (console-type-list))))
 
 (defun update-tab-in-gutter (&optional frame-or-buffer)
   "Update the tab control in the gutter area."
   (let ((locale (if (framep frame-or-buffer) frame-or-buffer)))
     (when (specifier-instance default-gutter-visible-p locale)
-      (unless gutter-buffers-tab 
+      (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)
 	(let ((inst (glyph-image-instance 
@@ -254,9 +289,7 @@
 		       (last-nonminibuf-window frame-or-buffer)))))
 	  (set-image-instance-property inst :items 
 				       (buffers-tab-items 
-					nil locale))
-	  (resize-subwindow inst (gutter-pixel-width) nil))
-	))))
+					nil locale)))))))
 
 (defun remove-buffer-from-gutter-tab ()
   "Remove the current buffer from the tab control in the gutter area."
@@ -268,9 +301,7 @@
 	(setq buffers (build-buffers-tab-internal 
 		       (list 
 			(get-buffer-create "*scratch*")))))
-      (set-image-instance-property inst :items buffers)
-      (resize-subwindow inst (gutter-pixel-width) nil)
-      )))
+      (set-image-instance-property inst :items buffers))))
 
 (add-hook 'kill-buffer-hook 'remove-buffer-from-gutter-tab)
 (add-hook 'create-frame-hook 'update-tab-in-gutter)