Mercurial > hg > xemacs-beta

comparison lisp/gutter.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
1 ;;; gutter.el --- Gutter manipulation for XEmacs.
2
3 ;; Copyright (C) 1999 Free Software Foundation, Inc.
4 ;; Copyright (C) 1999, 2000 Andy Piper.
5
6 ;; Maintainer: XEmacs Development Team
7 ;; Keywords: frames, gui, 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 ;; Although these customizations appear bogus, they are necessary in
34 ;; order to be able to save options through the options menu.
35 (defcustom default-gutter-position
36 (default-gutter-position)
37 "The location of the default gutter. It can be 'top, 'bottom, 'left or
38 'right. This option should be customized through the options menu.
39 To set the gutter position explicitly use `set-default-gutter-position'"
40 :group 'gutter
41 :type '(choice (const :tag "top" top)
42 (const :tag "bottom" bottom)
43 (const :tag "left" left)
44 (const :tag "right" right))
45 :set #'(lambda (var val)
46 (set-default-gutter-position val)
47 (setq default-gutter-position val)))
48
49 ;;; Gutter helper functions
50
51 ;; called by Fset_default_gutter_position()
52 (defvar default-gutter-position-changed-hook nil
53 "Function or functions to be called when the gutter position is changed.
54 The value of this variable may be buffer-local.")
55
56 ;; called by set-gutter-element-visible-p
57 (defvar gutter-element-visibility-changed-hook nil
58 "Function or functions to be called when the visibility of an
59 element in the gutter changes. The value of this variable may be
60 buffer-local. The gutter element symbol is passed as an argument to
61 the hook, as is the visibility flag.")
62
63 (defun set-gutter-element (gutter-specifier prop val &optional locale tag-set)
64 "Set GUTTER-SPECIFIER gutter element PROP to VAL in optional LOCALE.
65 This is a convenience function for setting gutter elements.
66 VAL in general must be a string. If VAL is a glyph then a string will be
67 created to put the glyph into."
68 (let ((spec val))
69 (when (glyphp val)
70 (setq spec (copy-sequence "\n"))
71 (set-extent-begin-glyph (make-extent 0 1 spec) val))
72 (map-extents #'(lambda (extent arg)
73 (set-extent-property extent 'duplicable t)) spec)
74 (modify-specifier-instances gutter-specifier #'plist-put (list prop spec)
75 'force nil locale tag-set)))
76
77 (defun remove-gutter-element (gutter-specifier prop &optional locale tag-set)
78 "Remove gutter element PROP from GUTTER-SPECIFIER in optional LOCALE.
79 This is a convenience function for removing gutter elements."
80 (modify-specifier-instances gutter-specifier #'plist-remprop (list prop)
81 'force nil locale tag-set))
82
83 (defun set-gutter-element-visible-p (gutter-visible-specifier-p
84 prop &optional visible-p
85 locale tag-set)
86 "Change the visibility of gutter elements.
87 Set the visibility of element PROP to VISIBLE-P for
88 GUTTER-SPECIFIER-VISIBLE-P in optional LOCALE.
89 This is a convenience function for hiding and showing gutter elements."
90 (modify-specifier-instances
91 gutter-visible-specifier-p #'(lambda (spec prop visible-p)
92 (if (consp spec)
93 (if visible-p
94 (if (memq prop spec) spec
95 (cons prop spec))
96 (delq prop spec))
97 (if visible-p (list prop))))
98 (list prop visible-p)
99 'force nil locale tag-set)
100 (run-hook-with-args 'gutter-element-visibility-changed-hook prop visible-p))
101
102 (defun gutter-element-visible-p (gutter-visible-specifier-p
103 prop &optional domain)
104 "Determine whether a gutter element is visible.
105 Given GUTTER-VISIBLE-SPECIFIER-P and gutter element PROP, return
106 non-nil if it is visible in optional DOMAIN."
107 (let ((spec (specifier-instance gutter-visible-specifier-p domain)))
108 (or (and (listp spec) (memq 'buffers-tab spec))
109 spec)))
110
111 (defun make-gutter-specifier (spec-list)
112 "Return a new `gutter' specifier object with the given specification list.
113 SPEC-LIST can be a list of specifications (each of which is a cons of a
114 locale and a list of instantiators), a single instantiator, or a list
115 of instantiators. See `make-specifier' for more information about
116 specifiers.
117
118 Gutter specifiers are used to specify the format of a gutter.
119 The values of the variables `default-gutter', `top-gutter',
120 `left-gutter', `right-gutter', and `bottom-gutter' are always
121 gutter specifiers.
122
123 Valid gutter instantiators are called \"gutter descriptors\" and are
124 either strings or property-lists of strings. See `default-gutter' for
125 a description of the exact format."
126 (make-specifier-and-init 'gutter spec-list))
127
128 (defun make-gutter-size-specifier (spec-list)
129 "Return a new `gutter-size' specifier object with the given spec list.
130 SPEC-LIST can be a list of specifications (each of which is a cons of a
131 locale and a list of instantiators), a single instantiator, or a list
132 of instantiators. See `make-specifier' for more information about
133 specifiers.
134
135 Gutter-size specifiers are used to specify the size of a gutter. The
136 values of the variables `default-gutter-size', `top-gutter-size',
137 `left-gutter-size', `right-gutter-size', and `bottom-gutter-size' are
138 always gutter-size specifiers.
139
140 Valid gutter-size instantiators are either integers or the special
141 symbol 'autodetect. If a gutter-size is set to 'autodetect them the
142 size of the gutter will be adjusted to just accommodate the gutters
143 contents. 'autodetect only works for top and bottom gutters."
144 (make-specifier-and-init 'gutter-size spec-list))
145
146 (defun make-gutter-visible-specifier (spec-list)
147 "Return a new `gutter-visible' specifier object with the given spec list.
148 SPEC-LIST can be a list of specifications (each of which is a cons of a
149 locale and a list of instantiators), a single instantiator, or a list
150 of instantiators. See `make-specifier' for more information about
151 specifiers.
152
153 Gutter-visible specifiers are used to specify the visibility of a
154 gutter. The values of the variables `default-gutter-visible-p',
155 `top-gutter-visible-p', `left-gutter-visible-p',
156 `right-gutter-visible-p', and `bottom-gutter-visible-p' are always
157 gutter-visible specifiers.
158
159 Valid gutter-visible instantiators are t, nil or a list of symbols.
160 If a gutter-visible instantiator is set to a list of symbols, and the
161 corresponding gutter specification is a property-list strings, then
162 elements of the gutter specification will only be visible if the
163 corresponding symbol occurs in the gutter-visible instantiator."
164 (make-specifier-and-init 'gutter-visible spec-list))
165
166 (defun init-gutter ()
167 "Initialize the gutter."
168 ;; do nothing as yet.
169 )
170
171 ;;; gutter.el ends here.
172
173