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., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, 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 `toggle-fringe'"
 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                        "Select fringe mode for all frames (type ? for list): "
 178                        '(("none") ("default") ("left-only")
 179                          ("right-only") ("half") ("minimal"))
 180                        nil t))))
 181     (cond ((eq mode 'none) 0)
 182           ((eq mode 'default) nil)
 183           ((eq mode 'left-only) '(nil . 0))
 184           ((eq mode 'right-only) '(0 . nil))
 185           ((eq mode 'half) '(5 . 5))
 186           ((eq mode 'minimal) '(1 . 1))
 187           ((eq mode (intern ""))
 188            (if (eq 0 (cdr (assq 'left-fringe
 189                                 (if all-frames
 190                                     default-frame-alist
 191                                   (frame-parameters (selected-frame))))))
 192                nil
 193              0)))))
 194
 195 ;;;###autoload
 196 (defun fringe-mode (&optional mode)
 197   "Set the default appearance of fringes on all frames.
 198
 199 When called interactively, query the user for MODE.  Valid values
 200 for MODE include `none', `default', `left-only', `right-only',
 201 `minimal' and `half'.
 202
 203 When used in a Lisp program, MODE can be a cons cell where the
 204 integer in car specifies the left fringe width and the integer in
 205 cdr specifies the right fringe width.  MODE can also be a single
 206 integer that specifies both the left and the right fringe width.
 207 If a fringe width specification is nil, that means to use the
 208 default width (8 pixels).  This command may round up the left and
 209 right width specifications to ensure that their sum is a multiple
 210 of the character width of a frame.  It never rounds up a fringe
 211 width of 0.
 212
 213 Fringe widths set by `set-window-fringes' override the default
 214 fringe widths set by this command.  This command applies to all
 215 frames that exist and frames to be created in the future.  If you
 216 want to set the default appearance of fringes on the selected
 217 frame only, see the command `set-fringe-style'."
 218   (interactive (list (fringe-query-style 'all-frames)))
 219   (set-fringe-mode mode))
 220
 221 ;;;###autoload
 222 (defun set-fringe-style (&optional mode)
 223   "Set the default appearance of fringes on the selected frame.
 224
 225 When called interactively, query the user for MODE.  Valid values
 226 for MODE include `none', `default', `left-only', `right-only',
 227 `minimal' and `half'.
 228
 229 When used in a Lisp program, MODE can be a cons cell where the
 230 integer in car specifies the left fringe width and the integer in
 231 cdr specifies the right fringe width.  MODE can also be a single
 232 integer that specifies both the left and the right fringe width.
 233 If a fringe width specification is nil, that means to use the
 234 default width (8 pixels).  This command may round up the left and
 235 right width specifications to ensure that their sum is a multiple
 236 of the character width of a frame.  It never rounds up a fringe
 237 width of 0.
 238
 239 Fringe widths set by `set-window-fringes' override the default
 240 fringe widths set by this command.  If you want to set the
 241 default appearance of fringes on all frames, see the command
 242 `fringe-mode'."
 243   (interactive (list (fringe-query-style)))
 244   (modify-frame-parameters
 245    (selected-frame)
 246    (list (cons 'left-fringe (if (consp mode) (car mode) mode))
 247          (cons 'right-fringe (if (consp mode) (cdr mode) mode)))))
 248
 249 (defsubst fringe-columns (side &optional real)
 250   "Return the width, measured in columns, of the fringe area on SIDE.
 251 If optional argument REAL is non-nil, return a real floating point
 252 number instead of a rounded integer value.
 253 SIDE must be the symbol `left' or `right'."
 254   (funcall (if real '/ 'ceiling)
 255            (or (funcall (if (eq side 'left) 'car 'cadr)
 256                         (window-fringes))
 257                0)
 258            (float (frame-char-width))))
 259
 260 ;; Fake defvar.  Real definition using defcustom is below.  The fake
 261 ;; defvar is necessary because `fringe-indicators' and
 262 ;; `set-fringe-indicators-1' mutually use each other.
 263 (defvar fringe-indicators)
 264
 265 (defun set-fringe-indicators-1 (ignore value)
 266   "Set fringe indicators according to VALUE.
 267 This is usually invoked when setting `fringe-indicators' via customize."
 268   (setq fringe-indicators value)
 269   (setq default-indicate-empty-lines nil)
 270   (setq default-indicate-buffer-boundaries
 271         (cond
 272          ((memq value '(left right t))
 273           value)
 274          ((eq value 'box)
 275           '((top . left) (bottom . right)))
 276          ((eq value 'mixed)
 277           '((top . left) (t . right)))
 278          ((eq value 'empty)
 279           (setq default-indicate-empty-lines t)
 280           nil)
 281          (t nil))))
 282
 283 ;;;###autoload
 284 (defcustom fringe-indicators nil
 285   "Visually indicate buffer boundaries and scrolling.
 286 Setting this variable, changes `default-indicate-buffer-boundaries'."
 287   :type '(choice (const :tag "No indicators" nil)
 288                  (const :tag "On left" left)
 289                  (const :tag "On right" right)
 290                  (const :tag "Opposite, no arrows" box)
 291                  (const :tag "Opposite, arrows right" mixed)
 292                  (const :tag "Empty lines" empty))
 293   :group 'fringe
 294   :require 'fringe
 295   :set 'set-fringe-indicators-1)
 296
 297 (provide 'fringe)
 298
 299 ;;; arch-tag: 6611ef60-0869-47ed-8b93-587ee7d3ff5d
 300 ;;; fringe.el ends here