lisp/fringe.el

   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