lisp/fringe.el

   1 ;;; fringe.el --- change fringes appearance in various ways
   2
   3 ;; Copyright (C) 2002, 2003, 2004 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 helpful functions for customizing the appearance
  29 ;; of the 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 Zaretski, 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 ;; Standard fringe bitmaps
  44
  45 (defmacro fringe-bitmap-p (symbol)
  46   "Return non-nil if SYMBOL is a fringe bitmap."
  47   `(get ,symbol 'fringe))
  48
  49 (defvar fringe-bitmaps)
  50
  51 (unless (or (not (boundp 'fringe-bitmaps))
  52             (get 'left-truncation 'fringe))
  53   (let ((bitmaps '(left-truncation right-truncation
  54                    up-arrow down-arrow
  55                    continued-line continuation-line
  56                    overlay-arrow
  57                    top-left-angle top-right-angle
  58                    bottom-left-angle bottom-right-angle
  59                    left-bracket right-bracket
  60                    filled-box-cursor hollow-box-cursor hollow-square
  61                    bar-cursor hbar-cursor
  62                    empty-line))
  63         (bn 2))
  64     (while bitmaps
  65       (push (car bitmaps) fringe-bitmaps)
  66       (put (car bitmaps) 'fringe bn)
  67       (setq bitmaps (cdr bitmaps)
  68             bn (1+ bn)))))
  69
  70
  71 ;; Control presence of fringes
  72
  73 (defvar fringe-mode)
  74
  75 (defun set-fringe-mode-1 (ignore value)
  76   "Call `set-fringe-mode' with VALUE.
  77 See `fringe-mode' for valid values and their effect.
  78 This is usually invoked when setting `fringe-mode' via customize."
  79   (set-fringe-mode value))
  80
  81 (defun set-fringe-mode (value)
  82   "Set `fringe-mode' to VALUE and put the new value into effect.
  83 See `fringe-mode' for possible values and their effect."
  84   (setq fringe-mode value)
  85
  86   ;; Apply it to default-frame-alist.
  87   (let ((parameter (assq 'left-fringe default-frame-alist)))
  88     (if (consp parameter)
  89         (setcdr parameter (if (consp fringe-mode)
  90                               (car fringe-mode)
  91                             fringe-mode))
  92       (setq default-frame-alist
  93             (cons (cons 'left-fringe (if (consp fringe-mode)
  94                                          (car fringe-mode)
  95                                        fringe-mode))
  96                   default-frame-alist))))
  97   (let ((parameter (assq 'right-fringe default-frame-alist)))
  98     (if (consp parameter)
  99         (setcdr parameter (if (consp fringe-mode)
 100                               (cdr fringe-mode)
 101                             fringe-mode))
 102       (setq default-frame-alist
 103             (cons (cons 'right-fringe (if (consp fringe-mode)
 104                                           (cdr fringe-mode)
 105                                         fringe-mode))
 106                   default-frame-alist))))
 107
 108   ;; Apply it to existing frames.
 109   (let ((frames (frame-list)))
 110     (while frames
 111       (modify-frame-parameters
 112        (car frames)
 113        (list (cons 'left-fringe (if (consp fringe-mode)
 114                                     (car fringe-mode)
 115                                   fringe-mode))
 116              (cons 'right-fringe (if (consp fringe-mode)
 117                                      (cdr fringe-mode)
 118                                    fringe-mode))))
 119       (setq frames (cdr frames)))))
 120
 121 ;; For initialization of fringe-mode, take account of changes
 122 ;; made explicitly to default-frame-alist.
 123 (defun fringe-mode-initialize (symbol value)
 124   (let* ((left-pair (assq 'left-fringe default-frame-alist))
 125          (right-pair (assq 'right-fringe default-frame-alist))
 126          (left (cdr left-pair))
 127          (right (cdr right-pair)))
 128     (if (or left-pair right-pair)
 129         ;; If there's something in default-frame-alist for fringes,
 130         ;; don't change it, but reflect that into the value of fringe-mode.
 131         (progn
 132           (setq fringe-mode (cons left right))
 133           (if (equal fringe-mode '(nil . nil))
 134               (setq fringe-mode nil))
 135           (if (equal fringe-mode '(0 . 0))
 136               (setq fringe-mode 0)))
 137       ;; Otherwise impose the user-specified value of fringe-mode.
 138       (custom-initialize-reset symbol value))))
 139
 140 ;;;###autoload
 141 (defcustom fringe-mode nil
 142   "*Specify appearance of fringes on all frames.
 143 This variable can be nil (the default) meaning the fringes should have
 144 the default width (8 pixels), it can be an integer value specifying
 145 the width of both left and right fringe (where 0 means no fringe), or
 146 a cons cell where car indicates width of left fringe and cdr indicates
 147 width of right fringe (where again 0 can be used to indicate no
 148 fringe).
 149 To set this variable in a Lisp program, use `set-fringe-mode' to make
 150 it take real effect.
 151 Setting the variable with a customization buffer also takes effect.
 152 If you only want to modify the appearance of the fringe in one frame,
 153 you can use the interactive function `set-fringe-style'."
 154   :type '(choice (const :tag "Default width" nil)
 155                  (const :tag "No fringes" 0)
 156                  (const :tag "Only right" (0 . nil))
 157                  (const :tag "Only left" (nil . 0))
 158                  (const :tag "Half width" (5 . 5))
 159                  (const :tag "Minimal" (1 . 1))
 160                  (integer :tag "Specific width")
 161                  (cons :tag "Different left/right sizes"
 162                        (integer :tag "Left width")
 163                        (integer :tag "Right width")))
 164   :group 'fringe
 165   :require 'fringe
 166   :initialize 'fringe-mode-initialize
 167   :set 'set-fringe-mode-1)
 168
 169 (defun fringe-query-style (&optional all-frames)
 170   "Query user for fringe style.
 171 Returns values suitable for left-fringe and right-fringe frame parameters.
 172 If ALL-FRAMES, the negation of the fringe values in
 173 `default-frame-alist' is used when user enters the empty string.
 174 Otherwise the negation of the fringe value in the currently selected
 175 frame parameter is used."
 176   (let ((mode (intern (completing-read
 177                        (concat
 178                         "Select fringe mode for "
 179                         (if all-frames "all frames" "selected frame")
 180                         " (type ? for list): ")
 181                        '(("none") ("default") ("left-only")
 182                          ("right-only") ("half") ("minimal"))
 183                        nil t))))
 184     (cond ((eq mode 'none) 0)
 185           ((eq mode 'default) nil)
 186           ((eq mode 'left-only) '(nil . 0))
 187           ((eq mode 'right-only) '(0 . nil))
 188           ((eq mode 'half) '(5 . 5))
 189           ((eq mode 'minimal) '(1 . 1))
 190           ((eq mode (intern ""))
 191            (if (eq 0 (cdr (assq 'left-fringe
 192                                 (if all-frames
 193                                     default-frame-alist
 194                                   (frame-parameters (selected-frame))))))
 195                nil
 196              0)))))
 197
 198 ;;;###autoload
 199 (defun fringe-mode (&optional mode)
 200   "Set the default appearance of fringes on all frames.
 201
 202 When called interactively, query the user for MODE.  Valid values
 203 for MODE include `none', `default', `left-only', `right-only',
 204 `minimal' and `half'.
 205
 206 When used in a Lisp program, MODE can be a cons cell where the
 207 integer in car specifies the left fringe width and the integer in
 208 cdr specifies the right fringe width.  MODE can also be a single
 209 integer that specifies both the left and the right fringe width.
 210 If a fringe width specification is nil, that means to use the
 211 default width (8 pixels).  This command may round up the left and
 212 right width specifications to ensure that their sum is a multiple
 213 of the character width of a frame.  It never rounds up a fringe
 214 width of 0.
 215
 216 Fringe widths set by `set-window-fringes' override the default
 217 fringe widths set by this command.  This command applies to all
 218 frames that exist and frames to be created in the future.  If you
 219 want to set the default appearance of fringes on the selected
 220 frame only, see the command `set-fringe-style'."
 221   (interactive (list (fringe-query-style 'all-frames)))
 222   (set-fringe-mode mode))
 223
 224 ;;;###autoload
 225 (defun set-fringe-style (&optional mode)
 226   "Set the default appearance of fringes on the selected frame.
 227
 228 When called interactively, query the user for MODE.  Valid values
 229 for MODE include `none', `default', `left-only', `right-only',
 230 `minimal' and `half'.
 231
 232 When used in a Lisp program, MODE can be a cons cell where the
 233 integer in car specifies the left fringe width and the integer in
 234 cdr specifies the right fringe width.  MODE can also be a single
 235 integer that specifies both the left and the right fringe width.
 236 If a fringe width specification is nil, that means to use the
 237 default width (8 pixels).  This command may round up the left and
 238 right width specifications to ensure that their sum is a multiple
 239 of the character width of a frame.  It never rounds up a fringe
 240 width of 0.
 241
 242 Fringe widths set by `set-window-fringes' override the default
 243 fringe widths set by this command.  If you want to set the
 244 default appearance of fringes on all frames, see the command
 245 `fringe-mode'."
 246   (interactive (list (fringe-query-style)))
 247   (modify-frame-parameters
 248    (selected-frame)
 249    (list (cons 'left-fringe (if (consp mode) (car mode) mode))
 250          (cons 'right-fringe (if (consp mode) (cdr mode) mode)))))
 251
 252 (defsubst fringe-columns (side &optional real)
 253   "Return the width, measured in columns, of the fringe area on SIDE.
 254 If optional argument REAL is non-nil, return a real floating point
 255 number instead of a rounded integer value.
 256 SIDE must be the symbol `left' or `right'."
 257   (funcall (if real '/ 'ceiling)
 258            (or (funcall (if (eq side 'left) 'car 'cadr)
 259                         (window-fringes))
 260                0)
 261            (float (frame-char-width))))
 262
 263 ;; Fake defvar.  Real definition using defcustom is below.  The fake
 264 ;; defvar is necessary because `fringe-indicators' and
 265 ;; `set-fringe-indicators-1' mutually use each other.
 266 (defvar fringe-indicators)
 267
 268 (defun set-fringe-indicators-1 (ignore value)
 269   "Set fringe indicators according to VALUE.
 270 This is usually invoked when setting `fringe-indicators' via customize."
 271   (setq fringe-indicators value)
 272   (setq default-indicate-empty-lines nil)
 273   (setq default-indicate-buffer-boundaries
 274         (cond
 275          ((memq value '(left right t))
 276           value)
 277          ((eq value 'box)
 278           '((top . left) (bottom . right)))
 279          ((eq value 'mixed)
 280           '((top . left) (t . right)))
 281          ((eq value 'empty)
 282           (setq default-indicate-empty-lines t)
 283           nil)
 284          (t nil))))
 285
 286 ;;;###autoload
 287 (defcustom fringe-indicators nil
 288   "Visually indicate buffer boundaries and scrolling.
 289 Setting this variable, changes `default-indicate-buffer-boundaries'."
 290   :type '(choice (const :tag "No indicators" nil)
 291                  (const :tag "On left" left)
 292                  (const :tag "On right" right)
 293                  (const :tag "Opposite, no arrows" box)
 294                  (const :tag "Opposite, arrows right" mixed)
 295                  (const :tag "Empty lines" empty))
 296   :group 'fringe
 297   :require 'fringe
 298   :set 'set-fringe-indicators-1)
 299
 300 (provide 'fringe)
 301
 302 ;;; arch-tag: 6611ef60-0869-47ed-8b93-587ee7d3ff5d
 303 ;;; fringe.el ends here