mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-22 10:26:20 +00:00
bc511a64f6
Most of this change is to boilerplate commentary such as license URLs. This change was prompted by ftp://ftp.gnu.org's going-away party, planned for November. Change these FTP URLs to https://ftp.gnu.org instead. Make similar changes for URLs to other organizations moving away from FTP. Also, change HTTP to HTTPS for URLs to gnu.org and fsf.org when this works, as this will further help defend against man-in-the-middle attacks (for this part I omitted the MS-DOS and MS-Windows sources and the test tarballs to keep the workload down). HTTPS is not fully working to lists.gnu.org so I left those URLs alone for now.
297 lines
11 KiB
EmacsLisp
297 lines
11 KiB
EmacsLisp
;;; fringe.el --- fringe setup and control
|
|
|
|
;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
|
|
|
|
;; Author: Simon Josefsson <simon@josefsson.org>
|
|
;; Maintainer: emacs-devel@gnu.org
|
|
;; Keywords: frames
|
|
;; Package: emacs
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This file contains code to initialize the built-in fringe bitmaps
|
|
;; as well as helpful functions for customizing the appearance of the
|
|
;; fringe.
|
|
|
|
;; The code is influenced by scroll-bar.el and avoid.el. The author
|
|
;; gratefully acknowledge comments and suggestions made by Miles
|
|
;; Bader, Eli Zaretskii, Richard Stallman, Pavel Janík and others which
|
|
;; improved this package.
|
|
|
|
;;; Code:
|
|
|
|
(defgroup fringe nil
|
|
"Window fringes."
|
|
:version "22.1"
|
|
:group 'frames)
|
|
|
|
;; Define the built-in fringe bitmaps and setup default mappings
|
|
|
|
(when (boundp 'fringe-bitmaps)
|
|
(let ((bitmaps '(question-mark exclamation-mark
|
|
left-arrow right-arrow up-arrow down-arrow
|
|
left-curly-arrow right-curly-arrow
|
|
left-triangle right-triangle
|
|
top-left-angle top-right-angle
|
|
bottom-left-angle bottom-right-angle
|
|
left-bracket right-bracket
|
|
filled-rectangle hollow-rectangle
|
|
filled-square hollow-square
|
|
vertical-bar horizontal-bar
|
|
empty-line))
|
|
(bn 1))
|
|
(while bitmaps
|
|
(push (car bitmaps) fringe-bitmaps)
|
|
(put (car bitmaps) 'fringe bn)
|
|
(setq bitmaps (cdr bitmaps)
|
|
bn (1+ bn))))
|
|
|
|
(setq-default fringe-indicator-alist
|
|
'((truncation . (left-arrow right-arrow))
|
|
(continuation . (left-curly-arrow right-curly-arrow))
|
|
(overlay-arrow . right-triangle)
|
|
(up . up-arrow)
|
|
(down . down-arrow)
|
|
(top . (top-left-angle top-right-angle))
|
|
(bottom . (bottom-left-angle bottom-right-angle
|
|
top-right-angle top-left-angle))
|
|
(top-bottom . (left-bracket right-bracket
|
|
top-right-angle top-left-angle))
|
|
(empty-line . empty-line)
|
|
(unknown . question-mark)))
|
|
|
|
(setq-default fringe-cursor-alist
|
|
'((box . filled-rectangle)
|
|
(hollow . hollow-rectangle)
|
|
(bar . vertical-bar)
|
|
(hbar . horizontal-bar)
|
|
(hollow-small . hollow-square))))
|
|
|
|
|
|
(defun fringe-bitmap-p (symbol)
|
|
"Return non-nil if SYMBOL is a fringe bitmap."
|
|
(get symbol 'fringe))
|
|
|
|
|
|
;; Control presence of fringes
|
|
|
|
(defvar fringe-mode)
|
|
|
|
(defvar fringe-mode-explicit nil
|
|
"Non-nil means `set-fringe-mode' should really do something.
|
|
This is nil while loading `fringe.el', and t afterward.")
|
|
|
|
(defun set-fringe-mode-1 (_ignore value)
|
|
"Call `set-fringe-mode' with VALUE.
|
|
See `fringe-mode' for valid values and their effect.
|
|
This is usually invoked when setting `fringe-mode' via customize."
|
|
(set-fringe-mode value))
|
|
|
|
(defun set-fringe-mode (value)
|
|
"Set `fringe-mode' to VALUE and put the new value into effect.
|
|
See `fringe-mode' for possible values and their effect."
|
|
(fringe--check-style value)
|
|
(setq fringe-mode value)
|
|
(when fringe-mode-explicit
|
|
(modify-all-frames-parameters
|
|
(list (cons 'left-fringe (if (consp fringe-mode)
|
|
(car fringe-mode)
|
|
fringe-mode))
|
|
(cons 'right-fringe (if (consp fringe-mode)
|
|
(cdr fringe-mode)
|
|
fringe-mode))))))
|
|
|
|
(defun fringe--check-style (style)
|
|
(or (null style)
|
|
(integerp style)
|
|
(and (consp style)
|
|
(or (null (car style)) (integerp (car style)))
|
|
(or (null (cdr style)) (integerp (cdr style))))
|
|
(error "Invalid fringe style `%s'" style)))
|
|
|
|
;; For initialization of fringe-mode, take account of changes
|
|
;; made explicitly to default-frame-alist.
|
|
(defun fringe-mode-initialize (symbol value)
|
|
(let* ((left-pair (assq 'left-fringe default-frame-alist))
|
|
(right-pair (assq 'right-fringe default-frame-alist))
|
|
(left (cdr left-pair))
|
|
(right (cdr right-pair)))
|
|
(if (or left-pair right-pair)
|
|
;; If there's something in default-frame-alist for fringes,
|
|
;; don't change it, but reflect that into the value of fringe-mode.
|
|
(progn
|
|
(setq fringe-mode (cons left right))
|
|
(if (equal fringe-mode '(nil . nil))
|
|
(setq fringe-mode nil))
|
|
(if (equal fringe-mode '(0 . 0))
|
|
(setq fringe-mode 0)))
|
|
;; Otherwise impose the user-specified value of fringe-mode.
|
|
(custom-initialize-reset symbol value))))
|
|
|
|
(defconst fringe-styles
|
|
'(("default" . nil)
|
|
("no-fringes" . 0)
|
|
("right-only" . (0 . nil))
|
|
("left-only" . (nil . 0))
|
|
("half-width" . (4 . 4))
|
|
("minimal" . (1 . 1)))
|
|
"Alist mapping fringe mode names to fringe widths.
|
|
Each list element has the form (NAME . WIDTH), where NAME is a
|
|
mnemonic fringe mode name and WIDTH is one of the following:
|
|
- nil, which means the default width (8 pixels).
|
|
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
|
|
respectively the left and right fringe widths in pixels, or
|
|
nil (meaning the default width).
|
|
- a single integer, which specifies the pixel widths of both
|
|
fringes.")
|
|
|
|
(defcustom fringe-mode nil
|
|
"Default appearance of fringes on all frames.
|
|
The Lisp value should be one of the following:
|
|
- nil, which means the default width (8 pixels).
|
|
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
|
|
respectively the left and right fringe widths in pixels, or
|
|
nil (meaning the default width).
|
|
- a single integer, which specifies the pixel widths of both
|
|
fringes.
|
|
Note that the actual width may be rounded up to ensure that the
|
|
sum of the width of the left and right fringes is a multiple of
|
|
the frame's character width. However, a fringe width of 0 is
|
|
never rounded.
|
|
|
|
When setting this variable from Customize, the user can choose
|
|
from the mnemonic fringe mode names defined in `fringe-styles'.
|
|
|
|
When setting this variable in a Lisp program, call
|
|
`set-fringe-mode' afterward to make it take real effect.
|
|
|
|
To modify the appearance of the fringe in a specific frame, use
|
|
the interactive function `set-fringe-style'."
|
|
:type `(choice
|
|
,@ (mapcar (lambda (style)
|
|
(let ((name
|
|
(replace-regexp-in-string "-" " " (car style))))
|
|
`(const :tag
|
|
,(concat (capitalize (substring name 0 1))
|
|
(substring name 1))
|
|
,(cdr style))))
|
|
fringe-styles)
|
|
(integer :tag "Specific width")
|
|
(cons :tag "Different left/right sizes"
|
|
(integer :tag "Left width")
|
|
(integer :tag "Right width")))
|
|
:group 'fringe
|
|
:require 'fringe
|
|
:initialize 'fringe-mode-initialize
|
|
:set 'set-fringe-mode-1)
|
|
|
|
;; We just set fringe-mode, but that was the default.
|
|
;; If it is set again, that is for real.
|
|
(setq fringe-mode-explicit t)
|
|
|
|
(defun fringe-query-style (&optional all-frames)
|
|
"Query user for fringe style.
|
|
Returns values suitable for left-fringe and right-fringe frame parameters.
|
|
If ALL-FRAMES, the negation of the fringe values in
|
|
`default-frame-alist' is used when user enters the empty string.
|
|
Otherwise the negation of the fringe value in the currently selected
|
|
frame parameter is used."
|
|
(let* ((mode (completing-read
|
|
(concat
|
|
"Select fringe mode for "
|
|
(if all-frames "all frames" "selected frame")
|
|
": ")
|
|
fringe-styles nil t))
|
|
(style (assoc (downcase mode) fringe-styles)))
|
|
(cond
|
|
(style
|
|
(cdr style))
|
|
((not (eq 0 (cdr (assq 'left-fringe
|
|
(if all-frames
|
|
default-frame-alist
|
|
(frame-parameters))))))
|
|
0))))
|
|
|
|
(defun fringe-mode (&optional mode)
|
|
"Set the default appearance of fringes on all frames.
|
|
When called interactively, query the user for MODE; valid values
|
|
are `no-fringes', `default', `left-only', `right-only', `minimal'
|
|
and `half-width'. See `fringe-styles'.
|
|
|
|
When used in a Lisp program, MODE should be one of these:
|
|
- nil, which means the default width (8 pixels).
|
|
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
|
|
respectively the left and right fringe widths in pixels, or
|
|
nil (meaning the default width).
|
|
- a single integer, which specifies the pixel widths of both
|
|
fringes.
|
|
This command may round up the left and right width specifications
|
|
to ensure that their sum is a multiple of the character width of
|
|
a frame. It never rounds up a fringe width of 0.
|
|
|
|
Fringe widths set by `set-window-fringes' override the default
|
|
fringe widths set by this command. This command applies to all
|
|
frames that exist and frames to be created in the future. If you
|
|
want to set the default appearance of fringes on the selected
|
|
frame only, see the command `set-fringe-style'."
|
|
(interactive (list (fringe-query-style 'all-frames)))
|
|
(set-fringe-mode mode))
|
|
|
|
(defun set-fringe-style (&optional mode)
|
|
"Set the default appearance of fringes on the selected frame.
|
|
When called interactively, query the user for MODE; valid values
|
|
are `no-fringes', `default', `left-only', `right-only', `minimal'
|
|
and `half-width'. See `fringe-styles'.
|
|
|
|
When used in a Lisp program, MODE should be one of these:
|
|
- nil, which means the default width (8 pixels).
|
|
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
|
|
respectively the left and right fringe widths in pixels, or
|
|
nil (meaning the default width).
|
|
- a single integer, which specifies the pixel widths of both
|
|
fringes.
|
|
This command may round up the left and right width specifications
|
|
to ensure that their sum is a multiple of the character width of
|
|
a frame. It never rounds up a fringe width of 0.
|
|
|
|
Fringe widths set by `set-window-fringes' override the default
|
|
fringe widths set by this command. If you want to set the
|
|
default appearance of fringes on all frames, see the command
|
|
`fringe-mode'."
|
|
(interactive (list (fringe-query-style)))
|
|
(fringe--check-style mode)
|
|
(modify-frame-parameters
|
|
(selected-frame)
|
|
(list (cons 'left-fringe (if (consp mode) (car mode) mode))
|
|
(cons 'right-fringe (if (consp mode) (cdr mode) mode)))))
|
|
|
|
(defsubst fringe-columns (side &optional real)
|
|
"Return the width, measured in columns, of the fringe area on SIDE.
|
|
If optional argument REAL is non-nil, return a real floating point
|
|
number instead of a rounded integer value.
|
|
SIDE must be the symbol `left' or `right'."
|
|
(funcall (if real '/ 'ceiling)
|
|
(or (funcall (if (eq side 'left) 'car 'cadr)
|
|
(window-fringes))
|
|
0)
|
|
(float (frame-char-width))))
|
|
|
|
(provide 'fringe)
|
|
|
|
;;; fringe.el ends here
|