--- /dev/null
+;;; gutter-items.el --- Gutter content for XEmacs.
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1999 Andy Piper.
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: frames, extensions, internal, dumped
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with Xmacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; Some of this is taken from the buffer-menu stuff in menubar-items.el
+;; and the custom specs in toolbar.el.
+
+(defgroup gutter nil
+ "Input from the gutters."
+ :group 'environment)
+
+(defcustom gutter-visible-p
+ (specifier-instance default-gutter-visible-p)
+ "Whether the default gutter is globally visible. This option can be
+customized through the options menu."
+ :group 'display
+ :type 'boolean
+ :set #'(lambda (var val)
+ (set-specifier default-gutter-visible-p val)
+ (setq gutter-visible-p val)))
+
+(defcustom default-gutter-position
+ (default-gutter-position)
+ "The location of the default gutter. It can be 'top, 'bottom, 'left or
+'right. This option can be customized through the options menu."
+ :group 'display
+ :type '(choice (const :tag "top" 'top)
+ (const :tag "bottom" 'bottom)
+ (const :tag "left" 'left)
+ (const :tag "right" 'right))
+ :set #'(lambda (var val)
+ (set-default-gutter-position val)
+ (setq default-gutter-position val)))
+
+;;; The Buffers tab
+
+(defgroup buffers-tab nil
+ "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.")
+
+(defcustom buffers-tab-max-size 6
+ "*Maximum number of entries which may appear on the \"Buffers\" tab.
+If this is 10, then only the ten most-recently-selected buffers will be
+shown. If this is nil, then all buffers will be shown. Setting this to
+a large number or nil will slow down tab responsiveness."
+ :type '(choice (const :tag "Show all" nil)
+ (integer 10))
+ :group 'buffers-tab)
+
+(defcustom buffers-tab-switch-to-buffer-function 'buffers-tab-switch-to-buffer
+ "*The function to call to select a buffer from the buffers tab.
+`switch-to-buffer' is a good choice, as is `pop-to-buffer'."
+ :type '(radio (function-item switch-to-buffer)
+ (function-item pop-to-buffer)
+ (function :tag "Other"))
+ :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.
+This is passed a buffer and should return non-nil if the buffer should be
+omitted. The default value `buffers-tab-omit-invisible-buffers' omits
+buffers that are normally considered \"invisible\" (those whose name
+begins with a space)."
+ :type '(choice (const :tag "None" nil)
+ function)
+ :group 'buffers-tab)
+
+(defcustom buffers-tab-format-buffer-line-function 'format-buffers-menu-line
+ "*The function to call to return a string to represent a buffer in the
+buffers tab. The function is passed a buffer and should return a string.
+The default value `format-buffers-menu-line' just returns the name of
+the buffer. Also check out `slow-format-buffers-menu-line' which
+returns a whole bunch of info about a buffer."
+ :type 'function
+ :group 'buffers-tab)
+
+(defun buffers-tab-switch-to-buffer (buffer)
+ "For use as a value for `buffers-tab-switch-to-buffer-function'."
+ (switch-to-buffer buffer t))
+
+(defsubst build-buffers-tab-internal (buffers)
+ (let (line)
+ (mapcar
+ #'(lambda (buffer)
+ (setq line (funcall buffers-tab-format-buffer-line-function
+ buffer))
+ (vector line (list buffers-tab-switch-to-buffer-function
+ (buffer-name buffer))))
+ buffers)))
+
+(defun buffers-tab-items ()
+ "This is the tab filter for the top-level buffers \"Buffers\" tab.
+It dynamically creates a list of buffers to use as the contents of the tab.
+Only the most-recently-used few buffers will be listed on the tab, for
+efficiency reasons. You can control how many buffers will be shown by
+setting `buffers-tab-max-size'. You can control the text of the tab
+items by redefining the function `format-buffers-menu-line'."
+ (let ((buffers (delete-if buffers-tab-omit-function (buffer-list))))
+ (and (integerp buffers-tab-max-size)
+ (> buffers-tab-max-size 1)
+ (> (length buffers) buffers-tab-max-size)
+ ;; shorten list of buffers
+ (setcdr (nthcdr buffers-tab-max-size buffers) nil))
+ (setq buffers (build-buffers-tab-internal buffers))
+ buffers))
+
+(defun add-tab-to-gutter ()
+ "Put a tab control in the gutter area to hold the most recent buffers."
+ (let ((gutter-string ""))
+ (set-extent-begin-glyph
+ (make-extent 0 0 gutter-string)
+ (setq gutter-buffers-tab
+ (make-glyph
+ (vector 'tab-control :descriptor "Buffers"
+ :properties (list :items (buffers-tab-items))))))
+ ;; This looks better than a 3d border
+ (set-specifier default-gutter-border-width 0 'global 'mswindows)
+ (set-specifier default-gutter gutter-string 'global 'mswindows)))
+
+(defun update-tab-in-gutter (&optional notused)
+ "Update the tab control in the gutter area."
+ (when (valid-image-instantiator-format-p 'tab-control)
+ (set-image-instance-property (glyph-image-instance gutter-buffers-tab)
+ :items
+ (buffers-tab-items))
+ (resize-subwindow (glyph-image-instance gutter-buffers-tab)
+ (gutter-pixel-width) nil)))
+
+(add-tab-to-gutter)
+(add-hook 'switch-to-buffer-hooks 'update-tab-in-gutter)
+(add-hook 'create-frame-hook 'update-tab-in-gutter)
+
+(provide 'gutter-items)
+;;; gutter-items.el ends here.