| 1 | ;;; fringe.el --- fringe setup and control -*- coding: utf-8 -*- |
| 2 | |
| 3 | ;; Copyright (C) 2002-2014 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 | (defmacro fringe-bitmap-p (symbol) |
| 87 | "Return non-nil if SYMBOL is a fringe bitmap." |
| 88 | `(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 | (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 | (fringe--check-style value) |
| 109 | (setq fringe-mode value) |
| 110 | (when fringe-mode-explicit |
| 111 | (modify-all-frames-parameters |
| 112 | (list (cons 'left-fringe (if (consp fringe-mode) |
| 113 | (car fringe-mode) |
| 114 | fringe-mode)) |
| 115 | (cons 'right-fringe (if (consp fringe-mode) |
| 116 | (cdr fringe-mode) |
| 117 | fringe-mode)))))) |
| 118 | |
| 119 | (defun fringe--check-style (style) |
| 120 | (or (null style) |
| 121 | (integerp style) |
| 122 | (and (consp style) |
| 123 | (or (null (car style)) (integerp (car style))) |
| 124 | (or (null (cdr style)) (integerp (cdr style)))) |
| 125 | (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 | (let* ((left-pair (assq 'left-fringe default-frame-alist)) |
| 131 | (right-pair (assq 'right-fringe default-frame-alist)) |
| 132 | (left (cdr left-pair)) |
| 133 | (right (cdr right-pair))) |
| 134 | (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 | (progn |
| 138 | (setq fringe-mode (cons left right)) |
| 139 | (if (equal fringe-mode '(nil . nil)) |
| 140 | (setq fringe-mode nil)) |
| 141 | (if (equal fringe-mode '(0 . 0)) |
| 142 | (setq fringe-mode 0))) |
| 143 | ;; Otherwise impose the user-specified value of fringe-mode. |
| 144 | (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 | (let* ((mode (completing-read |
| 215 | (concat |
| 216 | "Select fringe mode for " |
| 217 | (if all-frames "all frames" "selected frame") |
| 218 | ": ") |
| 219 | fringe-styles nil t)) |
| 220 | (style (assoc (downcase mode) fringe-styles))) |
| 221 | (cond |
| 222 | (style |
| 223 | (cdr style)) |
| 224 | ((not (eq 0 (cdr (assq 'left-fringe |
| 225 | (if all-frames |
| 226 | default-frame-alist |
| 227 | (frame-parameters)))))) |
| 228 | 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 | (interactive (list (fringe-query-style 'all-frames))) |
| 253 | (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 | (interactive (list (fringe-query-style))) |
| 277 | (fringe--check-style mode) |
| 278 | (modify-frame-parameters |
| 279 | (selected-frame) |
| 280 | (list (cons 'left-fringe (if (consp mode) (car mode) mode)) |
| 281 | (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 | (funcall (if real '/ 'ceiling) |
| 289 | (or (funcall (if (eq side 'left) 'car 'cadr) |
| 290 | (window-fringes)) |
| 291 | 0) |
| 292 | (float (frame-char-width)))) |
| 293 | |
| 294 | (provide 'fringe) |
| 295 | |
| 296 | ;;; fringe.el ends here |