|
422
|
1 ;;; gutter-items.el --- Gutter content for XEmacs.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1999 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1999 Andy Piper.
|
|
|
5
|
|
|
6 ;; Maintainer: XEmacs Development Team
|
|
|
7 ;; Keywords: frames, extensions, internal, dumped
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
11 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
12 ;; under the terms of the GNU General Public License as published by
|
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
14 ;; any later version.
|
|
|
15
|
|
|
16 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
19 ;; General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
|
22 ;; along with Xmacs; see the file COPYING. If not, write to the
|
|
|
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
|
|
|
24 ;; Boston, MA 02111-1307, USA.
|
|
|
25
|
|
|
26 ;; Some of this is taken from the buffer-menu stuff in menubar-items.el
|
|
|
27 ;; and the custom specs in toolbar.el.
|
|
|
28
|
|
|
29 (defgroup gutter nil
|
|
|
30 "Input from the gutters."
|
|
|
31 :group 'environment)
|
|
|
32
|
|
|
33 (defcustom gutter-visible-p
|
|
|
34 (specifier-instance default-gutter-visible-p)
|
|
|
35 "Whether the default gutter is globally visible. This option can be
|
|
|
36 customized through the options menu."
|
|
|
37 :group 'display
|
|
|
38 :type 'boolean
|
|
|
39 :set #'(lambda (var val)
|
|
|
40 (set-specifier default-gutter-visible-p val)
|
|
|
41 (setq gutter-visible-p val)))
|
|
|
42
|
|
|
43 (defcustom default-gutter-position
|
|
|
44 (default-gutter-position)
|
|
|
45 "The location of the default gutter. It can be 'top, 'bottom, 'left or
|
|
|
46 'right. This option can be customized through the options menu."
|
|
|
47 :group 'display
|
|
|
48 :type '(choice (const :tag "top" 'top)
|
|
|
49 (const :tag "bottom" 'bottom)
|
|
|
50 (const :tag "left" 'left)
|
|
|
51 (const :tag "right" 'right))
|
|
|
52 :set #'(lambda (var val)
|
|
|
53 (set-default-gutter-position val)
|
|
|
54 (setq default-gutter-position val)))
|
|
|
55
|
|
|
56 ;;; The Buffers tab
|
|
|
57
|
|
|
58 (defgroup buffers-tab nil
|
|
|
59 "Customization of `Buffers' tab."
|
|
|
60 :group 'gutter)
|
|
|
61
|
|
|
62 (defvar gutter-buffers-tab nil
|
|
|
63 "A tab widget in the gutter for displaying buffers.
|
|
|
64 Do not set this. Use `glyph-image-instance' and
|
|
|
65 `set-image-instance-property' to change the properties of the tab.")
|
|
|
66
|
|
|
67 (defcustom buffers-tab-max-size 6
|
|
|
68 "*Maximum number of entries which may appear on the \"Buffers\" tab.
|
|
|
69 If this is 10, then only the ten most-recently-selected buffers will be
|
|
|
70 shown. If this is nil, then all buffers will be shown. Setting this to
|
|
|
71 a large number or nil will slow down tab responsiveness."
|
|
|
72 :type '(choice (const :tag "Show all" nil)
|
|
|
73 (integer 10))
|
|
|
74 :group 'buffers-tab)
|
|
|
75
|
|
|
76 (defcustom buffers-tab-switch-to-buffer-function 'buffers-tab-switch-to-buffer
|
|
|
77 "*The function to call to select a buffer from the buffers tab.
|
|
|
78 `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
|
|
|
79 :type '(radio (function-item switch-to-buffer)
|
|
|
80 (function-item pop-to-buffer)
|
|
|
81 (function :tag "Other"))
|
|
|
82 :group 'buffers-tab)
|
|
|
83
|
|
|
84 (defcustom buffers-tab-omit-function 'buffers-menu-omit-invisible-buffers
|
|
|
85 "*If non-nil, a function specifying the buffers to omit from the buffers tab.
|
|
|
86 This is passed a buffer and should return non-nil if the buffer should be
|
|
|
87 omitted. The default value `buffers-tab-omit-invisible-buffers' omits
|
|
|
88 buffers that are normally considered \"invisible\" (those whose name
|
|
|
89 begins with a space)."
|
|
|
90 :type '(choice (const :tag "None" nil)
|
|
|
91 function)
|
|
|
92 :group 'buffers-tab)
|
|
|
93
|
|
|
94 (defcustom buffers-tab-format-buffer-line-function 'format-buffers-menu-line
|
|
|
95 "*The function to call to return a string to represent a buffer in the
|
|
|
96 buffers tab. The function is passed a buffer and should return a string.
|
|
|
97 The default value `format-buffers-menu-line' just returns the name of
|
|
|
98 the buffer. Also check out `slow-format-buffers-menu-line' which
|
|
|
99 returns a whole bunch of info about a buffer."
|
|
|
100 :type 'function
|
|
|
101 :group 'buffers-tab)
|
|
|
102
|
|
|
103 (defun buffers-tab-switch-to-buffer (buffer)
|
|
|
104 "For use as a value for `buffers-tab-switch-to-buffer-function'."
|
|
|
105 (switch-to-buffer buffer t))
|
|
|
106
|
|
|
107 (defsubst build-buffers-tab-internal (buffers)
|
|
|
108 (let (line)
|
|
|
109 (mapcar
|
|
|
110 #'(lambda (buffer)
|
|
|
111 (setq line (funcall buffers-tab-format-buffer-line-function
|
|
|
112 buffer))
|
|
|
113 (vector line (list buffers-tab-switch-to-buffer-function
|
|
|
114 (buffer-name buffer))))
|
|
|
115 buffers)))
|
|
|
116
|
|
|
117 (defun buffers-tab-items ()
|
|
|
118 "This is the tab filter for the top-level buffers \"Buffers\" tab.
|
|
|
119 It dynamically creates a list of buffers to use as the contents of the tab.
|
|
|
120 Only the most-recently-used few buffers will be listed on the tab, for
|
|
|
121 efficiency reasons. You can control how many buffers will be shown by
|
|
|
122 setting `buffers-tab-max-size'. You can control the text of the tab
|
|
|
123 items by redefining the function `format-buffers-menu-line'."
|
|
|
124 (let ((buffers (delete-if buffers-tab-omit-function (buffer-list))))
|
|
|
125 (and (integerp buffers-tab-max-size)
|
|
|
126 (> buffers-tab-max-size 1)
|
|
|
127 (> (length buffers) buffers-tab-max-size)
|
|
|
128 ;; shorten list of buffers
|
|
|
129 (setcdr (nthcdr buffers-tab-max-size buffers) nil))
|
|
|
130 (setq buffers (build-buffers-tab-internal buffers))
|
|
|
131 buffers))
|
|
|
132
|
|
|
133 (defun add-tab-to-gutter ()
|
|
|
134 "Put a tab control in the gutter area to hold the most recent buffers."
|
|
|
135 (let ((gutter-string ""))
|
|
|
136 (set-extent-begin-glyph
|
|
|
137 (make-extent 0 0 gutter-string)
|
|
|
138 (setq gutter-buffers-tab
|
|
|
139 (make-glyph
|
|
|
140 (vector 'tab-control :descriptor "Buffers"
|
|
|
141 :properties (list :items (buffers-tab-items))))))
|
|
|
142 ;; This looks better than a 3d border
|
|
|
143 (set-specifier default-gutter-border-width 0 'global 'mswindows)
|
|
|
144 (set-specifier default-gutter gutter-string 'global 'mswindows)))
|
|
|
145
|
|
|
146 (defun update-tab-in-gutter (&optional notused)
|
|
|
147 "Update the tab control in the gutter area."
|
|
|
148 (when (valid-image-instantiator-format-p 'tab-control)
|
|
|
149 (set-image-instance-property (glyph-image-instance gutter-buffers-tab)
|
|
|
150 :items
|
|
|
151 (buffers-tab-items))
|
|
|
152 (resize-subwindow (glyph-image-instance gutter-buffers-tab)
|
|
|
153 (gutter-pixel-width) nil)))
|
|
|
154
|
|
|
155 (add-tab-to-gutter)
|
|
|
156 (add-hook 'switch-to-buffer-hooks 'update-tab-in-gutter)
|
|
|
157 (add-hook 'create-frame-hook 'update-tab-in-gutter)
|
|
|
158
|
|
|
159 (provide 'gutter-items)
|
|
|
160 ;;; gutter-items.el ends here.
|
