Line data Source code
1 : ;;; fringe.el --- fringe setup and control
2 :
3 : ;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Simon Josefsson <simon@josefsson.org>
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Keywords: frames
8 : ;; Package: emacs
9 :
10 : ;; This file is part of GNU Emacs.
11 :
12 : ;; GNU Emacs is free software: you can redistribute it and/or modify
13 : ;; it under the terms of the GNU General Public License as published by
14 : ;; the Free Software Foundation, either version 3 of the License, or
15 : ;; (at your option) any later version.
16 :
17 : ;; GNU Emacs is distributed in the hope that it will be useful,
18 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 : ;; GNU General Public License for more details.
21 :
22 : ;; You should have received a copy of the GNU General Public License
23 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 :
25 : ;;; Commentary:
26 :
27 : ;; This file contains code to initialize the built-in fringe bitmaps
28 : ;; as well as helpful functions for customizing the appearance of the
29 : ;; fringe.
30 :
31 : ;; The code is influenced by scroll-bar.el and avoid.el. The author
32 : ;; gratefully acknowledge comments and suggestions made by Miles
33 : ;; Bader, Eli Zaretskii, Richard Stallman, Pavel JanÃk and others which
34 : ;; improved this package.
35 :
36 : ;;; Code:
37 :
38 : (defgroup fringe nil
39 : "Window fringes."
40 : :version "22.1"
41 : :group 'frames)
42 :
43 : ;; Define the built-in fringe bitmaps and setup default mappings
44 :
45 : (when (boundp 'fringe-bitmaps)
46 : (let ((bitmaps '(question-mark exclamation-mark
47 : left-arrow right-arrow up-arrow down-arrow
48 : left-curly-arrow right-curly-arrow
49 : left-triangle right-triangle
50 : top-left-angle top-right-angle
51 : bottom-left-angle bottom-right-angle
52 : left-bracket right-bracket
53 : filled-rectangle hollow-rectangle
54 : filled-square hollow-square
55 : vertical-bar horizontal-bar
56 : empty-line))
57 : (bn 1))
58 : (while bitmaps
59 : (push (car bitmaps) fringe-bitmaps)
60 : (put (car bitmaps) 'fringe bn)
61 : (setq bitmaps (cdr bitmaps)
62 : bn (1+ bn))))
63 :
64 : (setq-default fringe-indicator-alist
65 : '((truncation . (left-arrow right-arrow))
66 : (continuation . (left-curly-arrow right-curly-arrow))
67 : (overlay-arrow . right-triangle)
68 : (up . up-arrow)
69 : (down . down-arrow)
70 : (top . (top-left-angle top-right-angle))
71 : (bottom . (bottom-left-angle bottom-right-angle
72 : top-right-angle top-left-angle))
73 : (top-bottom . (left-bracket right-bracket
74 : top-right-angle top-left-angle))
75 : (empty-line . empty-line)
76 : (unknown . question-mark)))
77 :
78 : (setq-default fringe-cursor-alist
79 : '((box . filled-rectangle)
80 : (hollow . hollow-rectangle)
81 : (bar . vertical-bar)
82 : (hbar . horizontal-bar)
83 : (hollow-small . hollow-square))))
84 :
85 :
86 : (defun fringe-bitmap-p (symbol)
87 : "Return non-nil if SYMBOL is a fringe bitmap."
88 0 : (get symbol 'fringe))
89 :
90 :
91 : ;; Control presence of fringes
92 :
93 : (defvar fringe-mode)
94 :
95 : (defvar fringe-mode-explicit nil
96 : "Non-nil means `set-fringe-mode' should really do something.
97 : This is nil while loading `fringe.el', and t afterward.")
98 :
99 : (defun set-fringe-mode-1 (_ignore value)
100 : "Call `set-fringe-mode' with VALUE.
101 : See `fringe-mode' for valid values and their effect.
102 : This is usually invoked when setting `fringe-mode' via customize."
103 1 : (set-fringe-mode value))
104 :
105 : (defun set-fringe-mode (value)
106 : "Set `fringe-mode' to VALUE and put the new value into effect.
107 : See `fringe-mode' for possible values and their effect."
108 1 : (fringe--check-style value)
109 1 : (setq fringe-mode value)
110 1 : (when fringe-mode-explicit
111 1 : (modify-all-frames-parameters
112 1 : (list (cons 'left-fringe (if (consp fringe-mode)
113 0 : (car fringe-mode)
114 1 : fringe-mode))
115 1 : (cons 'right-fringe (if (consp fringe-mode)
116 0 : (cdr fringe-mode)
117 1 : fringe-mode))))))
118 :
119 : (defun fringe--check-style (style)
120 1 : (or (null style)
121 0 : (integerp style)
122 0 : (and (consp style)
123 0 : (or (null (car style)) (integerp (car style)))
124 0 : (or (null (cdr style)) (integerp (cdr style))))
125 1 : (error "Invalid fringe style `%s'" style)))
126 :
127 : ;; For initialization of fringe-mode, take account of changes
128 : ;; made explicitly to default-frame-alist.
129 : (defun fringe-mode-initialize (symbol value)
130 1 : (let* ((left-pair (assq 'left-fringe default-frame-alist))
131 1 : (right-pair (assq 'right-fringe default-frame-alist))
132 1 : (left (cdr left-pair))
133 1 : (right (cdr right-pair)))
134 1 : (if (or left-pair right-pair)
135 : ;; If there's something in default-frame-alist for fringes,
136 : ;; don't change it, but reflect that into the value of fringe-mode.
137 0 : (progn
138 0 : (setq fringe-mode (cons left right))
139 0 : (if (equal fringe-mode '(nil . nil))
140 0 : (setq fringe-mode nil))
141 0 : (if (equal fringe-mode '(0 . 0))
142 0 : (setq fringe-mode 0)))
143 : ;; Otherwise impose the user-specified value of fringe-mode.
144 1 : (custom-initialize-reset symbol value))))
145 :
146 : (defconst fringe-styles
147 : '(("default" . nil)
148 : ("no-fringes" . 0)
149 : ("right-only" . (0 . nil))
150 : ("left-only" . (nil . 0))
151 : ("half-width" . (4 . 4))
152 : ("minimal" . (1 . 1)))
153 : "Alist mapping fringe mode names to fringe widths.
154 : Each list element has the form (NAME . WIDTH), where NAME is a
155 : mnemonic fringe mode name and WIDTH is one of the following:
156 : - nil, which means the default width (8 pixels).
157 : - a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
158 : respectively the left and right fringe widths in pixels, or
159 : nil (meaning the default width).
160 : - a single integer, which specifies the pixel widths of both
161 : fringes.")
162 :
163 : (defcustom fringe-mode nil
164 : "Default appearance of fringes on all frames.
165 : The Lisp value should be one of the following:
166 : - nil, which means the default width (8 pixels).
167 : - a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
168 : respectively the left and right fringe widths in pixels, or
169 : nil (meaning the default width).
170 : - a single integer, which specifies the pixel widths of both
171 : fringes.
172 : Note that the actual width may be rounded up to ensure that the
173 : sum of the width of the left and right fringes is a multiple of
174 : the frame's character width. However, a fringe width of 0 is
175 : never rounded.
176 :
177 : When setting this variable from Customize, the user can choose
178 : from the mnemonic fringe mode names defined in `fringe-styles'.
179 :
180 : When setting this variable in a Lisp program, call
181 : `set-fringe-mode' afterward to make it take real effect.
182 :
183 : To modify the appearance of the fringe in a specific frame, use
184 : the interactive function `set-fringe-style'."
185 : :type `(choice
186 : ,@ (mapcar (lambda (style)
187 : (let ((name
188 : (replace-regexp-in-string "-" " " (car style))))
189 : `(const :tag
190 : ,(concat (capitalize (substring name 0 1))
191 : (substring name 1))
192 : ,(cdr style))))
193 : fringe-styles)
194 : (integer :tag "Specific width")
195 : (cons :tag "Different left/right sizes"
196 : (integer :tag "Left width")
197 : (integer :tag "Right width")))
198 : :group 'fringe
199 : :require 'fringe
200 : :initialize 'fringe-mode-initialize
201 : :set 'set-fringe-mode-1)
202 :
203 : ;; We just set fringe-mode, but that was the default.
204 : ;; If it is set again, that is for real.
205 : (setq fringe-mode-explicit t)
206 :
207 : (defun fringe-query-style (&optional all-frames)
208 : "Query user for fringe style.
209 : Returns values suitable for left-fringe and right-fringe frame parameters.
210 : If ALL-FRAMES, the negation of the fringe values in
211 : `default-frame-alist' is used when user enters the empty string.
212 : Otherwise the negation of the fringe value in the currently selected
213 : frame parameter is used."
214 0 : (let* ((mode (completing-read
215 0 : (concat
216 : "Select fringe mode for "
217 0 : (if all-frames "all frames" "selected frame")
218 0 : ": ")
219 0 : fringe-styles nil t))
220 0 : (style (assoc (downcase mode) fringe-styles)))
221 0 : (cond
222 0 : (style
223 0 : (cdr style))
224 0 : ((not (eq 0 (cdr (assq 'left-fringe
225 0 : (if all-frames
226 0 : default-frame-alist
227 0 : (frame-parameters))))))
228 0 : 0))))
229 :
230 : (defun fringe-mode (&optional mode)
231 : "Set the default appearance of fringes on all frames.
232 : When called interactively, query the user for MODE; valid values
233 : are `no-fringes', `default', `left-only', `right-only', `minimal'
234 : and `half-width'. See `fringe-styles'.
235 :
236 : When used in a Lisp program, MODE should be one of these:
237 : - nil, which means the default width (8 pixels).
238 : - a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
239 : respectively the left and right fringe widths in pixels, or
240 : nil (meaning the default width).
241 : - a single integer, which specifies the pixel widths of both
242 : fringes.
243 : This command may round up the left and right width specifications
244 : to ensure that their sum is a multiple of the character width of
245 : a frame. It never rounds up a fringe width of 0.
246 :
247 : Fringe widths set by `set-window-fringes' override the default
248 : fringe widths set by this command. This command applies to all
249 : frames that exist and frames to be created in the future. If you
250 : want to set the default appearance of fringes on the selected
251 : frame only, see the command `set-fringe-style'."
252 0 : (interactive (list (fringe-query-style 'all-frames)))
253 0 : (set-fringe-mode mode))
254 :
255 : (defun set-fringe-style (&optional mode)
256 : "Set the default appearance of fringes on the selected frame.
257 : When called interactively, query the user for MODE; valid values
258 : are `no-fringes', `default', `left-only', `right-only', `minimal'
259 : and `half-width'. See `fringe-styles'.
260 :
261 : When used in a Lisp program, MODE should be one of these:
262 : - nil, which means the default width (8 pixels).
263 : - a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
264 : respectively the left and right fringe widths in pixels, or
265 : nil (meaning the default width).
266 : - a single integer, which specifies the pixel widths of both
267 : fringes.
268 : This command may round up the left and right width specifications
269 : to ensure that their sum is a multiple of the character width of
270 : a frame. It never rounds up a fringe width of 0.
271 :
272 : Fringe widths set by `set-window-fringes' override the default
273 : fringe widths set by this command. If you want to set the
274 : default appearance of fringes on all frames, see the command
275 : `fringe-mode'."
276 0 : (interactive (list (fringe-query-style)))
277 0 : (fringe--check-style mode)
278 0 : (modify-frame-parameters
279 0 : (selected-frame)
280 0 : (list (cons 'left-fringe (if (consp mode) (car mode) mode))
281 0 : (cons 'right-fringe (if (consp mode) (cdr mode) mode)))))
282 :
283 : (defsubst fringe-columns (side &optional real)
284 : "Return the width, measured in columns, of the fringe area on SIDE.
285 : If optional argument REAL is non-nil, return a real floating point
286 : number instead of a rounded integer value.
287 : SIDE must be the symbol `left' or `right'."
288 0 : (funcall (if real '/ 'ceiling)
289 0 : (or (funcall (if (eq side 'left) 'car 'cadr)
290 0 : (window-fringes))
291 0 : 0)
292 0 : (float (frame-char-width))))
293 :
294 : (provide 'fringe)
295 :
296 : ;;; fringe.el ends here
|