summaryrefslogtreecommitdiff
path: root/lisp/fringe.el
blob: b8bf659620eb483d1098ae154aa6eb11e773b44b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
;;; fringe.el --- fringe setup and control  -*- coding: utf-8 -*-

;; Copyright (C) 2002-2014 Free Software Foundation, Inc.

;; Author: Simon Josefsson <simon@josefsson.org>
;; Maintainer: FSF
;; Keywords: frames
;; Package: emacs

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file contains code to initialize the built-in fringe bitmaps
;; as well as helpful functions for customizing the appearance of the
;; fringe.

;; The code is influenced by scroll-bar.el and avoid.el.  The author
;; gratefully acknowledge comments and suggestions made by Miles
;; Bader, Eli Zaretskii, Richard Stallman, Pavel Janík and others which
;; improved this package.

;;; Code:

(defgroup fringe nil
  "Window fringes."
  :version "22.1"
  :group 'frames)

;; Define the built-in fringe bitmaps and setup default mappings

(when (boundp 'fringe-bitmaps)
  (let ((bitmaps '(question-mark exclamation-mark
		   left-arrow right-arrow up-arrow down-arrow
		   left-curly-arrow right-curly-arrow
		   left-triangle right-triangle
		   top-left-angle top-right-angle
		   bottom-left-angle bottom-right-angle
		   left-bracket right-bracket
		   filled-rectangle hollow-rectangle
		   filled-square hollow-square
		   vertical-bar horizontal-bar
		   empty-line))
	(bn 1))
    (while bitmaps
      (push (car bitmaps) fringe-bitmaps)
      (put (car bitmaps) 'fringe bn)
      (setq bitmaps (cdr bitmaps)
	    bn (1+ bn))))

  (setq-default fringe-indicator-alist
		'((truncation . (left-arrow right-arrow))
		  (continuation . (left-curly-arrow right-curly-arrow))
		  (overlay-arrow . right-triangle)
		  (up . up-arrow)
		  (down . down-arrow)
		  (top . (top-left-angle top-right-angle))
		  (bottom . (bottom-left-angle bottom-right-angle
			     top-right-angle top-left-angle))
		  (top-bottom . (left-bracket right-bracket
				 top-right-angle top-left-angle))
		  (empty-line . empty-line)
		  (unknown . question-mark)))

  (setq-default fringe-cursor-alist
		'((box . filled-rectangle)
		  (hollow . hollow-rectangle)
		  (bar . vertical-bar)
		  (hbar . horizontal-bar)
		  (hollow-small . hollow-square))))


(defmacro fringe-bitmap-p (symbol)
  "Return non-nil if SYMBOL is a fringe bitmap."
  `(get ,symbol 'fringe))


;; Control presence of fringes

(defvar fringe-mode)

(defvar fringe-mode-explicit nil
  "Non-nil means `set-fringe-mode' should really do something.
This is nil while loading `fringe.el', and t afterward.")

(defun set-fringe-mode-1 (_ignore value)
  "Call `set-fringe-mode' with VALUE.
See `fringe-mode' for valid values and their effect.
This is usually invoked when setting `fringe-mode' via customize."
  (set-fringe-mode value))

(defun set-fringe-mode (value)
  "Set `fringe-mode' to VALUE and put the new value into effect.
See `fringe-mode' for possible values and their effect."
  (fringe--check-style value)
  (setq fringe-mode value)
  (when fringe-mode-explicit
    (modify-all-frames-parameters
     (list (cons 'left-fringe (if (consp fringe-mode)
				  (car fringe-mode)
				fringe-mode))
	   (cons 'right-fringe (if (consp fringe-mode)
				   (cdr fringe-mode)
				 fringe-mode))))))

(defun fringe--check-style (style)
  (or (null style)
      (integerp style)
      (and (consp style)
	   (or (null (car style)) (integerp (car style)))
	   (or (null (cdr style)) (integerp (cdr style))))
      (error "Invalid fringe style `%s'" style)))

;; For initialization of fringe-mode, take account of changes
;; made explicitly to default-frame-alist.
(defun fringe-mode-initialize (symbol value)
  (let* ((left-pair (assq 'left-fringe default-frame-alist))
	 (right-pair (assq 'right-fringe default-frame-alist))
	 (left (cdr left-pair))
	 (right (cdr right-pair)))
    (if (or left-pair right-pair)
	;; If there's something in default-frame-alist for fringes,
	;; don't change it, but reflect that into the value of fringe-mode.
	(progn
	  (setq fringe-mode (cons left right))
	  (if (equal fringe-mode '(nil . nil))
	      (setq fringe-mode nil))
	  (if (equal fringe-mode '(0 . 0))
	      (setq fringe-mode 0)))
      ;; Otherwise impose the user-specified value of fringe-mode.
      (custom-initialize-reset symbol value))))

(defconst fringe-styles
  '(("default" . nil)
    ("no-fringes" . 0)
    ("right-only" . (0 . nil))
    ("left-only" . (nil . 0))
    ("half-width" . (4 . 4))
    ("minimal" . (1 . 1)))
  "Alist mapping fringe mode names to fringe widths.
Each list element has the form (NAME . WIDTH), where NAME is a
mnemonic fringe mode name and WIDTH is one of the following:
- nil, which means the default width (8 pixels).
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
  respectively the left and right fringe widths in pixels, or
  nil (meaning the default width).
- a single integer, which specifies the pixel widths of both
  fringes.")

(defcustom fringe-mode nil
  "Default appearance of fringes on all frames.
The Lisp value should be one of the following:
- nil, which means the default width (8 pixels).
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
  respectively the left and right fringe widths in pixels, or
  nil (meaning the default width).
- a single integer, which specifies the pixel widths of both
  fringes.
Note that the actual width may be rounded up to ensure that the
sum of the width of the left and right fringes is a multiple of
the frame's character width.  However, a fringe width of 0 is
never rounded.

When setting this variable from Customize, the user can choose
from the mnemonic fringe mode names defined in `fringe-styles'.

When setting this variable in a Lisp program, call
`set-fringe-mode' afterward to make it take real effect.

To modify the appearance of the fringe in a specific frame, use
the interactive function `set-fringe-style'."
  :type `(choice
          ,@ (mapcar (lambda (style)
                      (let ((name
                             (replace-regexp-in-string "-" " " (car style))))
                        `(const :tag
                                ,(concat (capitalize (substring name 0 1))
                                         (substring name 1))
                                ,(cdr style))))
                    fringe-styles)
          (integer :tag "Specific width")
          (cons :tag "Different left/right sizes"
                (integer :tag "Left width")
                (integer :tag "Right width")))
  :group 'fringe
  :require 'fringe
  :initialize 'fringe-mode-initialize
  :set 'set-fringe-mode-1)

;; We just set fringe-mode, but that was the default.
;; If it is set again, that is for real.
(setq fringe-mode-explicit t)

(defun fringe-query-style (&optional all-frames)
  "Query user for fringe style.
Returns values suitable for left-fringe and right-fringe frame parameters.
If ALL-FRAMES, the negation of the fringe values in
`default-frame-alist' is used when user enters the empty string.
Otherwise the negation of the fringe value in the currently selected
frame parameter is used."
  (let* ((mode (completing-read
                (concat
                 "Select fringe mode for "
                 (if all-frames "all frames" "selected frame")
                 ": ")
                fringe-styles nil t))
         (style (assoc (downcase mode) fringe-styles)))
    (cond
     (style
      (cdr style))
     ((not (eq 0 (cdr (assq 'left-fringe
			    (if all-frames
				default-frame-alist
			      (frame-parameters))))))
      0))))

(defun fringe-mode (&optional mode)
  "Set the default appearance of fringes on all frames.
When called interactively, query the user for MODE; valid values
are `no-fringes', `default', `left-only', `right-only', `minimal'
and `half-width'.  See `fringe-styles'.

When used in a Lisp program, MODE should be one of these:
- nil, which means the default width (8 pixels).
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
  respectively the left and right fringe widths in pixels, or
  nil (meaning the default width).
- a single integer, which specifies the pixel widths of both
  fringes.
This command may round up the left and right width specifications
to ensure that their sum is a multiple of the character width of
a frame.  It never rounds up a fringe width of 0.

Fringe widths set by `set-window-fringes' override the default
fringe widths set by this command.  This command applies to all
frames that exist and frames to be created in the future.  If you
want to set the default appearance of fringes on the selected
frame only, see the command `set-fringe-style'."
  (interactive (list (fringe-query-style 'all-frames)))
  (set-fringe-mode mode))

(defun set-fringe-style (&optional mode)
  "Set the default appearance of fringes on the selected frame.
When called interactively, query the user for MODE; valid values
are `no-fringes', `default', `left-only', `right-only', `minimal'
and `half-width'.  See `fringe-styles'.

When used in a Lisp program, MODE should be one of these:
- nil, which means the default width (8 pixels).
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
  respectively the left and right fringe widths in pixels, or
  nil (meaning the default width).
- a single integer, which specifies the pixel widths of both
  fringes.
This command may round up the left and right width specifications
to ensure that their sum is a multiple of the character width of
a frame.  It never rounds up a fringe width of 0.

Fringe widths set by `set-window-fringes' override the default
fringe widths set by this command.  If you want to set the
default appearance of fringes on all frames, see the command
`fringe-mode'."
  (interactive (list (fringe-query-style)))
  (fringe--check-style mode)
  (modify-frame-parameters
   (selected-frame)
   (list (cons 'left-fringe (if (consp mode) (car mode) mode))
	 (cons 'right-fringe (if (consp mode) (cdr mode) mode)))))

(defsubst fringe-columns (side &optional real)
  "Return the width, measured in columns, of the fringe area on SIDE.
If optional argument REAL is non-nil, return a real floating point
number instead of a rounded integer value.
SIDE must be the symbol `left' or `right'."
  (funcall (if real '/ 'ceiling)
	   (or (funcall (if (eq side 'left) 'car 'cadr)
			(window-fringes))
	       0)
           (float (frame-char-width))))

(provide 'fringe)

;;; fringe.el ends here