Mercurial > hg > xemacs-beta

comparison lisp/gutter-items.el @ 422:95016f13131a r21-2-19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-19
author cvs
date Mon, 13 Aug 2007 11:25:01 +0200
parents
children 11054d720c21
comparison
equal deleted inserted replaced
421:fff06e11db74 422:95016f13131a
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.