lisp/fringe.el

   1 ;;; fringe.el --- fringe setup and control  -*- coding: utf-8 -*-
   2
   3 ;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
   4
   5 ;; Author: Simon Josefsson <simon@josefsson.org>
   6 ;; Maintainer: FSF
   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 (a symbol) and WIDTH is one of the
 156 following:
 157 - nil, which means the default width (8 pixels).
 158 - a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
 159   respectively the left and right fringe widths in pixels, or
 160   nil (meaning to disable that fringe).
 161 - a single integer, which specifies the pixel widths of both
 162   fringes.")
 163
 164 (defcustom fringe-mode nil
 165   "Default appearance of fringes on all frames.
 166 The Lisp value should be one of the following:
 167 - nil, which means the default width (8 pixels).
 168 - a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
 169   respectively the left and right fringe widths in pixels, or
 170   nil (meaning to disable that fringe).
 171 - a single integer, which specifies the pixel widths of both
 172   fringes.
 173 Note that the actual width may be rounded up to ensure that the
 174 sum of the width of the left and right fringes is a multiple of
 175 the frame's character width.  However, a fringe width of 0 is
 176 never rounded.
 177
 178 When setting this variable from Customize, the user can choose
 179 from the mnemonic fringe mode names defined in `fringe-styles'.
 180
 181 When setting this variable in a Lisp program, call
 182 `set-fringe-mode' afterward to make it take real effect.
 183
 184 To modify the appearance of the fringe in a specific frame, use
 185 the interactive function `set-fringe-style'."
 186   :type `(choice
 187           ,@ (mapcar (lambda (style)
 188                       (let ((name
 189                              (replace-regexp-in-string "-" " " (car style))))
 190                         `(const :tag
 191                                 ,(concat (capitalize (substring name 0 1))
 192                                          (substring name 1))
 193                                 ,(cdr style))))
 194                     fringe-styles)
 195           (integer :tag "Specific width")
 196           (cons :tag "Different left/right sizes"
 197                 (integer :tag "Left width")
 198                 (integer :tag "Right width")))
 199   :group 'fringe
 200   :require 'fringe
 201   :initialize 'fringe-mode-initialize
 202   :set 'set-fringe-mode-1)
 203
 204 ;; We just set fringe-mode, but that was the default.
 205 ;; If it is set again, that is for real.
 206 (setq fringe-mode-explicit t)
 207
 208 (defun fringe-query-style (&optional all-frames)
 209   "Query user for fringe style.
 210 Returns values suitable for left-fringe and right-fringe frame parameters.
 211 If ALL-FRAMES, the negation of the fringe values in
 212 `default-frame-alist' is used when user enters the empty string.
 213 Otherwise the negation of the fringe value in the currently selected
 214 frame parameter is used."
 215   (let* ((mode (completing-read
 216                 (concat
 217                  "Select fringe mode for "
 218                  (if all-frames "all frames" "selected frame")
 219                  ": ")
 220                 fringe-styles nil t))
 221          (style (assoc (downcase mode) fringe-styles)))
 222     (cond
 223      (style
 224       (cdr style))
 225      ((not (eq 0 (cdr (assq 'left-fringe
 226                             (if all-frames
 227                                 default-frame-alist
 228                               (frame-parameters))))))
 229       0))))
 230
 231 (defun fringe-mode (&optional mode)
 232   "Set the default appearance of fringes on all frames.
 233 When called interactively, query the user for MODE; valid values
 234 are `no-fringes', `default', `left-only', `right-only', `minimal'
 235 and `half-width'.  See `fringe-styles'.
 236
 237 When used in a Lisp program, MODE should be one of these:
 238 - nil, which means the default width (8 pixels).
 239 - a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
 240   respectively the left and right fringe widths in pixels, or
 241   nil (meaning to disable that fringe).
 242 - a single integer, which specifies the pixel widths of both
 243   fringes.
 244 This command may round up the left and right width specifications
 245 to ensure that their sum is a multiple of the character width of
 246 a frame.  It never rounds up a fringe width of 0.
 247
 248 Fringe widths set by `set-window-fringes' override the default
 249 fringe widths set by this command.  This command applies to all
 250 frames that exist and frames to be created in the future.  If you
 251 want to set the default appearance of fringes on the selected
 252 frame only, see the command `set-fringe-style'."
 253   (interactive (list (fringe-query-style 'all-frames)))
 254   (set-fringe-mode mode))
 255
 256 (defun set-fringe-style (&optional mode)
 257   "Set the default appearance of fringes on the selected frame.
 258 When called interactively, query the user for MODE; valid values
 259 are `no-fringes', `default', `left-only', `right-only', `minimal'
 260 and `half-width'.  See `fringe-styles'.
 261
 262 When used in a Lisp program, MODE should be one of these:
 263 - nil, which means the default width (8 pixels).
 264 - a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
 265   respectively the left and right fringe widths in pixels, or
 266   nil (meaning to disable that fringe).
 267 - a single integer, which specifies the pixel widths of both
 268   fringes.
 269 This command may round up the left and right width specifications
 270 to ensure that their sum is a multiple of the character width of
 271 a frame.  It never rounds up a fringe width of 0.
 272
 273 Fringe widths set by `set-window-fringes' override the default
 274 fringe widths set by this command.  If you want to set the
 275 default appearance of fringes on all frames, see the command
 276 `fringe-mode'."
 277   (interactive (list (fringe-query-style)))
 278   (fringe--check-style mode)
 279   (modify-frame-parameters
 280    (selected-frame)
 281    (list (cons 'left-fringe (if (consp mode) (car mode) mode))
 282          (cons 'right-fringe (if (consp mode) (cdr mode) mode)))))
 283
 284 (defsubst fringe-columns (side &optional real)
 285   "Return the width, measured in columns, of the fringe area on SIDE.
 286 If optional argument REAL is non-nil, return a real floating point
 287 number instead of a rounded integer value.
 288 SIDE must be the symbol `left' or `right'."
 289   (funcall (if real '/ 'ceiling)
 290            (or (funcall (if (eq side 'left) 'car 'cadr)
 291                         (window-fringes))
 292                0)
 293            (float (frame-char-width))))
 294
 295 (provide 'fringe)
 296
 297 ;;; fringe.el ends here