Mercurial > hg > xemacs-beta
annotate lisp/gutter.el @ 5750:66d2f63df75f
Correct some spelling and formatting in behavior.el.
Mentioned in tracker issue 826, the third thing mentioned there (the file
name at the bottom of the file) had already been fixed.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* behavior.el:
(override-behavior):
Correct some spelling and formatting here, thank you Steven
Mitchell in tracker issue 826.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 05 Aug 2013 10:05:32 +0100 |
parents | cc6f0266bc36 |
children |
rev | line source |
---|---|
442 | 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 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
487
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
487
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
487
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
487
diff
changeset
|
14 ;; option) any later version. |
442 | 15 |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
487
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
487
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
487
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
487
diff
changeset
|
19 ;; for more details. |
442 | 20 |
21 ;; You should have received a copy of the GNU General Public License | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
487
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
442 | 23 |
24 ;; Some of this is taken from the buffer-menu stuff in menubar-items.el | |
25 ;; and the custom specs in toolbar.el. | |
26 | |
27 (defgroup gutter nil | |
28 "Input from the gutters." | |
29 :group 'environment) | |
30 | |
31 ;; Although these customizations appear bogus, they are necessary in | |
32 ;; order to be able to save options through the options menu. | |
33 (defcustom default-gutter-position | |
34 (default-gutter-position) | |
35 "The location of the default gutter. It can be 'top, 'bottom, 'left or | |
36 'right. This option should be customized through the options menu. | |
37 To set the gutter position explicitly use `set-default-gutter-position'" | |
38 :group 'gutter | |
39 :type '(choice (const :tag "top" top) | |
40 (const :tag "bottom" bottom) | |
41 (const :tag "left" left) | |
42 (const :tag "right" right)) | |
43 :set #'(lambda (var val) | |
44 (set-default-gutter-position val) | |
45 (setq default-gutter-position val))) | |
46 | |
47 ;;; Gutter helper functions | |
48 | |
49 ;; called by Fset_default_gutter_position() | |
50 (defvar default-gutter-position-changed-hook nil | |
51 "Function or functions to be called when the gutter position is changed. | |
52 The value of this variable may be buffer-local.") | |
53 | |
54 ;; called by set-gutter-element-visible-p | |
55 (defvar gutter-element-visibility-changed-hook nil | |
56 "Function or functions to be called when the visibility of an | |
57 element in the gutter changes. The value of this variable may be | |
58 buffer-local. The gutter element symbol is passed as an argument to | |
59 the hook, as is the visibility flag.") | |
60 | |
444 | 61 (defun set-gutter-element (gutter-specifier prop value &optional locale tag-set) |
62 "Set GUTTER-SPECIFIER gutter element PROP to VALUE in optional LOCALE. | |
442 | 63 This is a convenience function for setting gutter elements. |
444 | 64 VALUE in general must be a string. If VALUE is a glyph then a string |
65 will be created to put the glyph into." | |
66 (let ((spec value)) | |
67 (when (glyphp value) | |
442 | 68 (setq spec (copy-sequence "\n")) |
444 | 69 (set-extent-begin-glyph (make-extent 0 1 spec) value)) |
442 | 70 (map-extents #'(lambda (extent arg) |
71 (set-extent-property extent 'duplicable t)) spec) | |
72 (modify-specifier-instances gutter-specifier #'plist-put (list prop spec) | |
73 'force nil locale tag-set))) | |
74 | |
75 (defun remove-gutter-element (gutter-specifier prop &optional locale tag-set) | |
76 "Remove gutter element PROP from GUTTER-SPECIFIER in optional LOCALE. | |
77 This is a convenience function for removing gutter elements." | |
78 (modify-specifier-instances gutter-specifier #'plist-remprop (list prop) | |
79 'force nil locale tag-set)) | |
80 | |
81 (defun set-gutter-element-visible-p (gutter-visible-specifier-p | |
82 prop &optional visible-p | |
83 locale tag-set) | |
84 "Change the visibility of gutter elements. | |
85 Set the visibility of element PROP to VISIBLE-P for | |
86 GUTTER-SPECIFIER-VISIBLE-P in optional LOCALE. | |
87 This is a convenience function for hiding and showing gutter elements." | |
88 (modify-specifier-instances | |
89 gutter-visible-specifier-p #'(lambda (spec prop visible-p) | |
90 (if (consp spec) | |
91 (if visible-p | |
92 (if (memq prop spec) spec | |
93 (cons prop spec)) | |
5652
cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
Aidan Kehoe <kehoea@parhasard.net>
parents:
5420
diff
changeset
|
94 (delete* prop spec)) |
442 | 95 (if visible-p (list prop)))) |
96 (list prop visible-p) | |
97 'force nil locale tag-set) | |
98 (run-hook-with-args 'gutter-element-visibility-changed-hook prop visible-p)) | |
99 | |
100 (defun gutter-element-visible-p (gutter-visible-specifier-p | |
101 prop &optional domain) | |
102 "Determine whether a gutter element is visible. | |
103 Given GUTTER-VISIBLE-SPECIFIER-P and gutter element PROP, return | |
104 non-nil if it is visible in optional DOMAIN." | |
105 (let ((spec (specifier-instance gutter-visible-specifier-p domain))) | |
106 (or (and (listp spec) (memq 'buffers-tab spec)) | |
107 spec))) | |
108 | |
458 | 109 (defun set-gutter-dirty-p (gutter-or-location) |
110 "Make GUTTER-OR-LOCATION dirty to force redisplay updates." | |
111 ;; set-glyph-image will not make the gutter dirty | |
112 (when (or (gutter-specifier-p gutter-or-location) | |
113 (eq gutter-or-location 'top) | |
114 (eq gutter-or-location 'bottom) | |
115 (eq gutter-or-location 'left) | |
116 (eq gutter-or-location 'right)) | |
117 (or (gutter-specifier-p gutter-or-location) | |
118 (setq gutter-or-location | |
119 (eval (intern (concat | |
120 (symbol-name gutter-or-location) | |
121 "-gutter"))))) | |
122 (set-specifier-dirty-flag gutter-or-location))) | |
123 | |
442 | 124 (defun make-gutter-specifier (spec-list) |
125 "Return a new `gutter' specifier object with the given specification list. | |
126 SPEC-LIST can be a list of specifications (each of which is a cons of a | |
127 locale and a list of instantiators), a single instantiator, or a list | |
128 of instantiators. See `make-specifier' for more information about | |
129 specifiers. | |
130 | |
131 Gutter specifiers are used to specify the format of a gutter. | |
132 The values of the variables `default-gutter', `top-gutter', | |
133 `left-gutter', `right-gutter', and `bottom-gutter' are always | |
134 gutter specifiers. | |
135 | |
136 Valid gutter instantiators are called \"gutter descriptors\" and are | |
137 either strings or property-lists of strings. See `default-gutter' for | |
138 a description of the exact format." | |
139 (make-specifier-and-init 'gutter spec-list)) | |
140 | |
141 (defun make-gutter-size-specifier (spec-list) | |
142 "Return a new `gutter-size' specifier object with the given spec list. | |
143 SPEC-LIST can be a list of specifications (each of which is a cons of a | |
144 locale and a list of instantiators), a single instantiator, or a list | |
145 of instantiators. See `make-specifier' for more information about | |
146 specifiers. | |
147 | |
148 Gutter-size specifiers are used to specify the size of a gutter. The | |
149 values of the variables `default-gutter-size', `top-gutter-size', | |
150 `left-gutter-size', `right-gutter-size', and `bottom-gutter-size' are | |
151 always gutter-size specifiers. | |
152 | |
153 Valid gutter-size instantiators are either integers or the special | |
154 symbol 'autodetect. If a gutter-size is set to 'autodetect them the | |
155 size of the gutter will be adjusted to just accommodate the gutters | |
156 contents. 'autodetect only works for top and bottom gutters." | |
157 (make-specifier-and-init 'gutter-size spec-list)) | |
158 | |
159 (defun make-gutter-visible-specifier (spec-list) | |
160 "Return a new `gutter-visible' specifier object with the given spec list. | |
161 SPEC-LIST can be a list of specifications (each of which is a cons of a | |
162 locale and a list of instantiators), a single instantiator, or a list | |
163 of instantiators. See `make-specifier' for more information about | |
164 specifiers. | |
165 | |
166 Gutter-visible specifiers are used to specify the visibility of a | |
167 gutter. The values of the variables `default-gutter-visible-p', | |
168 `top-gutter-visible-p', `left-gutter-visible-p', | |
169 `right-gutter-visible-p', and `bottom-gutter-visible-p' are always | |
170 gutter-visible specifiers. | |
171 | |
172 Valid gutter-visible instantiators are t, nil or a list of symbols. | |
173 If a gutter-visible instantiator is set to a list of symbols, and the | |
174 corresponding gutter specification is a property-list strings, then | |
175 elements of the gutter specification will only be visible if the | |
176 corresponding symbol occurs in the gutter-visible instantiator." | |
177 (make-specifier-and-init 'gutter-visible spec-list)) | |
178 | |
179 ;;; gutter.el ends here. | |
180 | |
181 |