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