LCOV - code coverage report
Current view: top level - lisp - fringe.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 17 57 29.8 %
Date: 2017-08-27 09:44:50 Functions: 4 9 44.4 %

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

Generated by: LCOV version 1.12