1011 lines
48 KiB
EmacsLisp
1011 lines
48 KiB
EmacsLisp
;;; highlight-indent-guides.el --- Minor mode to highlight indentation
|
|
;;
|
|
;; Copyright (c) 2015 DarthFennec
|
|
;;
|
|
;; Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
;; of this software and associated documentation files (the "Software"), to deal
|
|
;; in the Software without restriction, including without limitation the rights
|
|
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
|
;; copies of the Software, and to permit persons to whom the Software is
|
|
;; furnished to do so, subject to the following conditions:
|
|
;;
|
|
;; The above copyright notice and this permission notice shall be included in
|
|
;; all copies or substantial portions of the Software.
|
|
;;
|
|
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
|
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
|
;; SOFTWARE.
|
|
;;
|
|
;; Author: DarthFennec <darthfennec@derpymail.org>
|
|
;; Version: 0.9.1
|
|
;; Package-Version: 20200528.2128
|
|
;; Package-Commit: a4f771418e4eed1f3f7879a43af28cf97747d41c
|
|
;; Package-Requires: ((emacs "24"))
|
|
;; URL: https://github.com/DarthFennec/highlight-indent-guides
|
|
|
|
;;; Commentary:
|
|
;; This minor mode highlights indentation levels via font-lock. Indent widths
|
|
;; are dynamically discovered, which means this correctly highlights in any
|
|
;; mode, regardless of indent width, even in languages with non-uniform
|
|
;; indentation such as Haskell. This mode works properly around hard tabs and
|
|
;; mixed indentation, and it behaves well in large buffers.
|
|
;;
|
|
;; To install, put this file in your load-path, and do
|
|
;; M-x highlight-indent-guides-mode to enable it. To enable it automatically in
|
|
;; most programming modes, use the following:
|
|
;;
|
|
;; (add-hook 'prog-mode-hook 'highlight-indent-guides-mode)
|
|
;;
|
|
;; To set the display method, use:
|
|
;;
|
|
;; (setq highlight-indent-guides-method METHOD)
|
|
;;
|
|
;; Where METHOD is either 'fill, 'column, 'character, or 'bitmap.
|
|
;;
|
|
;; To change the character used for drawing guide lines with the 'character
|
|
;; method, use:
|
|
;;
|
|
;; (setq highlight-indent-guides-character ?ch)
|
|
;;
|
|
;; By default, this mode automatically inspects your theme and chooses
|
|
;; appropriate colors for highlighting. To tweak the subtlety of these colors,
|
|
;; use the following (all values are percentages):
|
|
;;
|
|
;; (setq highlight-indent-guides-auto-odd-face-perc 15)
|
|
;; (setq highlight-indent-guides-auto-even-face-perc 15)
|
|
;; (setq highlight-indent-guides-auto-character-face-perc 20)
|
|
;;
|
|
;; Or, to manually set the colors used for highlighting, use:
|
|
;;
|
|
;; (setq highlight-indent-guides-auto-enabled nil)
|
|
;;
|
|
;; (set-face-background 'highlight-indent-guides-odd-face "color")
|
|
;; (set-face-background 'highlight-indent-guides-even-face "color")
|
|
;; (set-face-foreground 'highlight-indent-guides-character-face "color")
|
|
|
|
;;; Code:
|
|
|
|
(require 'color)
|
|
|
|
(defgroup highlight-indent-guides nil
|
|
"Indentation highlighting."
|
|
:group 'faces)
|
|
|
|
(defface highlight-indent-guides-odd-face '((t nil))
|
|
"Face to highlight odd indent levels."
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defface highlight-indent-guides-even-face '((t nil))
|
|
"Face to highlight even indent levels."
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defface highlight-indent-guides-character-face '((t nil))
|
|
"Face to highlight guide line characters and bitmaps."
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defface highlight-indent-guides-top-odd-face '((t nil))
|
|
"Face to highlight odd indent levels."
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defface highlight-indent-guides-top-even-face '((t nil))
|
|
"Face to highlight even indent levels."
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defface highlight-indent-guides-top-character-face '((t nil))
|
|
"Face to highlight guide line characters and bitmaps."
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defface highlight-indent-guides-stack-odd-face '((t nil))
|
|
"Face to highlight odd indent levels."
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defface highlight-indent-guides-stack-even-face '((t nil))
|
|
"Face to highlight even indent levels."
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defface highlight-indent-guides-stack-character-face '((t nil))
|
|
"Face to highlight guide line characters and bitmaps."
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-character ?\x2502
|
|
"Character to use to display guide lines."
|
|
:type 'character
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-method 'fill
|
|
"Method to use when displaying indent guides.
|
|
This can be `fill', `column', `character', or `bitmap'."
|
|
:type '(choice (const fill) (const column) (const character) (const bitmap))
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-responsive nil
|
|
"Whether responsive highlights should be used.
|
|
This allows different highlight colors to be used in response to the location of
|
|
the point. If this is nil, no responsive highlighting is used. If this is
|
|
`top', the indent level of the current line is colored distinctly. If this is
|
|
`stack', three colorations are used: one for the current indent level (as with
|
|
`top'), one for all parent levels of the current indent level, and one for all
|
|
other levels."
|
|
:type '(choice (const nil) (const top) (const stack))
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-enabled t
|
|
"Whether to automatically calculate faces.
|
|
If this is enabled, highlight-indent-guides will use the current theme's
|
|
background color to automatically calculate reasonable indent guide colors."
|
|
:type 'boolean
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-suppress-auto-error nil
|
|
"Whether to suppress the error that sometimes prints when calculating faces.
|
|
When automatically calculating faces, sometimes there will be an error that
|
|
\"`default' face is not set properly\". If this flag is enabled,
|
|
highlight-indent-guides will not print this error. This can be helpful in
|
|
situations where faces are calculated correctly, but the error is printed
|
|
anyway, which can be annoying."
|
|
:type 'boolean
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-highlighter-function
|
|
'highlight-indent-guides--highlighter-default
|
|
"Determine the correct face to use for a given indentation level.
|
|
Customizable function which applies faces to indentation. The function is
|
|
called once per indentation character, and takes three parameters: LEVEL is the
|
|
indentation level of the character, with 0 being the outermost level.
|
|
RESPONSIVE is either nil, `top', or `stack', depending on which responsive class
|
|
the character falls into. DISPLAY is the current display method setting, which
|
|
can be `fill', `column', or `character'. The return value is either the face to
|
|
apply to the guide character, or nil if the guide should not be displayed at
|
|
all. The results of this function are cached per indentation character, so the
|
|
function should consistently return the same output given the same input."
|
|
:type 'function
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-bitmap-function
|
|
'highlight-indent-guides--bitmap-dots
|
|
"Determine the shape of the indent guide bitmap.
|
|
Customizable function which 'draws' the indent guide bitmap. The function is
|
|
called once per indentation character, and takes three parameters: WIDTH and
|
|
HEIGHT are the pixel width and height of the character, and CREP is the
|
|
character that should be used to represent a colored pixel. The return value is
|
|
a list of strings, with each string representing a row of pixels. The list
|
|
should be HEIGHT in size, and each string in the list should be WIDTH in size.
|
|
Each character represents a pixel, and should be CREP if the pixel is colored,
|
|
and ?0 if it isn't colored."
|
|
:type 'function
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-odd-face-perc 5
|
|
"Color adjustment percentage for highlight-indent-guides-odd-face.
|
|
This is used to automatically calculate the indent guide faces from the
|
|
background color."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-even-face-perc 10
|
|
"Color adjustment percentage for highlight-indent-guides-even-face.
|
|
This is used to automatically calculate the indent guide faces from the
|
|
background color."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-character-face-perc 10
|
|
"Color adjustment percentage for highlight-indent-guides-character-face.
|
|
This is used to automatically calculate the indent guide faces from the
|
|
background color."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-top-odd-face-perc 25
|
|
"Color adjustment percentage for highlight-indent-guides-odd-face.
|
|
This is used to automatically calculate the indent guide faces from the
|
|
background color."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-top-even-face-perc 30
|
|
"Color adjustment percentage for highlight-indent-guides-even-face.
|
|
This is used to automatically calculate the indent guide faces from the
|
|
background color."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-top-character-face-perc 30
|
|
"Color adjustment percentage for highlight-indent-guides-character-face.
|
|
This is used to automatically calculate the indent guide faces from the
|
|
background color."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-stack-odd-face-perc 15
|
|
"Color adjustment percentage for highlight-indent-guides-odd-face.
|
|
This is used to automatically calculate the indent guide faces from the
|
|
background color."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-stack-even-face-perc 20
|
|
"Color adjustment percentage for highlight-indent-guides-even-face.
|
|
This is used to automatically calculate the indent guide faces from the
|
|
background color."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-auto-stack-character-face-perc 20
|
|
"Color adjustment percentage for highlight-indent-guides-character-face.
|
|
This is used to automatically calculate the indent guide faces from the
|
|
background color."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defcustom highlight-indent-guides-delay 0.1
|
|
"The number of seconds to wait for an idle state before redrawing.
|
|
This is only useful if `highlight-indent-guides-responsive' is not nil."
|
|
:type 'number
|
|
:group 'highlight-indent-guides)
|
|
|
|
(defvar highlight-indent-guides--idle-timer nil
|
|
"The idle timer object for responsive mode.")
|
|
|
|
(defvar highlight-indent-guides--line-cache '(nil nil nil)
|
|
"The line cache for responsive mode.")
|
|
(make-variable-buffer-local 'highlight-indent-guides--line-cache)
|
|
|
|
(defun highlight-indent-guides--try-merge-ranges (&rest args)
|
|
"Given multiple character position ranges (ARGS), merge where possible.
|
|
When ranges are calculated separately, there is a possibility of overlap, which
|
|
can cause unnecessary redraws. This function merges overlapping ranges to
|
|
minimize redraws."
|
|
(let ((ranges (sort (delq nil args) (lambda (x y) (> (car x) (car y)))))
|
|
curr next results)
|
|
(unless (null ranges)
|
|
(setq curr (pop ranges))
|
|
(while ranges
|
|
(setq next (pop ranges))
|
|
(if (<= (car curr) (+ 2 (cdr next)))
|
|
(setq curr (cons (car next) (max (cdr curr) (cdr next))))
|
|
(setq results (cons curr results))
|
|
(setq curr next)))
|
|
(setq results (cons curr results))
|
|
results)))
|
|
|
|
(defun highlight-indent-guides--discover-ranges (sect1 sect2)
|
|
"Given two sections SECT1 and SECT2, discover the ranges where they differ.
|
|
Gives a list of two ranges that should be redrawn when the point moves between
|
|
SECT1 and SECT2. This is the shallowest indent level that is not shared."
|
|
(if (not (eq highlight-indent-guides-responsive 'stack))
|
|
(list (car sect1) (car sect2))
|
|
(let ((rsect1 (reverse sect1))
|
|
(rsect2 (reverse sect2)))
|
|
(catch 'return
|
|
(while t
|
|
(if (and (cdr rsect1) (cdr rsect2) (eq (car rsect1) (car rsect2)))
|
|
(setq rsect1 (cdr rsect1) rsect2 (cdr rsect2))
|
|
(throw 'return (list (car rsect1) (car rsect2)))))))))
|
|
|
|
(defun highlight-indent-guides--update-line-cache ()
|
|
"Update the line cache.
|
|
The line cache tracks the current line data to make it easy for the drawing
|
|
functions to quickly access the needed context data for responsive mode. This
|
|
function is called whenever the current line data changes."
|
|
(let ((higp 'highlight-indent-guides-prop))
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(while (and (not (eobp))
|
|
(or (let ((s (syntax-ppss))) (or (nth 3 s) (nth 4 s)))
|
|
(looking-at "[[:space:]]*$")))
|
|
(forward-line))
|
|
(back-to-indentation)
|
|
(unless (bolp) (nth 5 (get-text-property (1- (point)) higp))))))
|
|
|
|
(defun highlight-indent-guides--try-update-line-cache ()
|
|
"Update the line cache, if necessary.
|
|
This function is called whenever the point moves in a way that might change the
|
|
line cache. It only updates the cache when absolutely necessary."
|
|
(when (and highlight-indent-guides-responsive
|
|
highlight-indent-guides-mode)
|
|
(let ((cached-pt (car highlight-indent-guides--line-cache))
|
|
(cached-ln (nth 1 highlight-indent-guides--line-cache))
|
|
(cached-dt (nth 2 highlight-indent-guides--line-cache))
|
|
(pt (point))
|
|
ln dt rng)
|
|
(catch 'nochange
|
|
(when (eq pt cached-pt) (throw 'nochange nil))
|
|
(setcar highlight-indent-guides--line-cache pt)
|
|
(setq ln (line-number-at-pos))
|
|
(when (eq ln cached-ln) (throw 'nochange nil))
|
|
(setcar (cdr highlight-indent-guides--line-cache) ln)
|
|
(setq dt (highlight-indent-guides--update-line-cache))
|
|
(when (equal dt cached-dt) (throw 'nochange nil))
|
|
(setcar (cddr highlight-indent-guides--line-cache) dt)
|
|
(setq rng (highlight-indent-guides--discover-ranges dt cached-dt))
|
|
(dolist (range (apply 'highlight-indent-guides--try-merge-ranges rng))
|
|
(highlight-indent-guides--overdraw (car range) (cdr range)))))))
|
|
|
|
(defun highlight-indent-guides--iscdr (sub sup)
|
|
"Calculate whether SUB is a cdr of SUP."
|
|
(if (null sub) t
|
|
(while (and sup (not (eq sub sup))) (setq sup (cdr sup)))
|
|
(eq sub sup)))
|
|
|
|
(defun highlight-indent-guides--calc-guides (prev-guides)
|
|
"Calculate the indent guides for a line.
|
|
PREV-GUIDES are the previous line's indent guides, and INDENT is this line's
|
|
indent width."
|
|
(let ((indent (current-indentation))
|
|
(guides (car prev-guides))
|
|
(sections (cdr prev-guides))
|
|
oldsections)
|
|
(while (and guides (< indent (car guides)))
|
|
(set-marker (cdar sections) (line-end-position 0))
|
|
(setq oldsections sections)
|
|
(setq sections (cdr sections))
|
|
(setq guides (cdr guides)))
|
|
(when (and (< 0 indent) (or (null guides) (> indent (car guides))))
|
|
(if oldsections (setq sections oldsections)
|
|
(let* ((lbp (line-beginning-position))
|
|
(begmark (copy-marker lbp)) (endmark (copy-marker lbp)))
|
|
(setq sections (cons (cons begmark endmark) sections))))
|
|
(setq guides (cons indent guides)))
|
|
(cons guides sections)))
|
|
|
|
(defun highlight-indent-guides--get-guides ()
|
|
"Extract the indent guides from a line, by reading the text properties."
|
|
(save-excursion
|
|
(catch 'invalid
|
|
(let (prop face seg sect nface nseg nsect guides fst)
|
|
(while (looking-at "[[:space:]]")
|
|
(setq prop (get-text-property (point) 'highlight-indent-guides-prop))
|
|
(setq nface (car prop) nseg (nth 1 prop) nsect (nth 5 prop))
|
|
(setq fst (nth 2 prop))
|
|
(unless (natnump nface) (throw 'invalid t))
|
|
(unless (or seg nseg)
|
|
(when (and fst (eq face nface)) (throw 'invalid t))
|
|
(when (not (or fst (eq face nface))) (throw 'invalid t)))
|
|
(unless (highlight-indent-guides--iscdr sect nsect)
|
|
(throw 'invalid t))
|
|
(let ((l (- (length nsect) (length sect) (length nseg))))
|
|
(when fst (setq l (1- l)))
|
|
(when nseg (setq l (1+ l)))
|
|
(when (not (zerop l)) (throw 'invalid t)))
|
|
(unless (and (eq face nface) (equal seg nseg))
|
|
(let ((col (current-column)))
|
|
(when (and face (not (eq face nface)))
|
|
(setq guides (cons col guides)))
|
|
(dolist (segment nseg)
|
|
(setq guides (cons (+ segment col) guides))
|
|
(setq nface (1+ nface))))
|
|
(setq face nface seg nseg))
|
|
(setq sect nsect)
|
|
(forward-char))
|
|
(dolist (section sect)
|
|
(unless (and (eq (marker-buffer (car section)) (current-buffer))
|
|
(eq (marker-buffer (cdr section)) (current-buffer))
|
|
(<= (car section) (point) (cdr section)))
|
|
(throw 'invalid t)))
|
|
(let ((col (current-column)))
|
|
(when (< 0 col) (setq guides (cons col guides))))
|
|
(cons guides sect)))))
|
|
|
|
(defun highlight-indent-guides--get-prev-guides ()
|
|
"Scan up the buffer to find a starting point to calculate guides from."
|
|
(let ((guides t))
|
|
(while (and (nlistp guides) (let ((p (point)))
|
|
(or (/= -1 (forward-line -1))
|
|
(not (goto-char p)))))
|
|
(unless (or (let ((s (syntax-ppss))) (or (nth 3 s) (nth 4 s)))
|
|
(looking-at "[[:space:]]*$"))
|
|
(setq guides (highlight-indent-guides--get-guides))))
|
|
(if (listp guides) guides nil)))
|
|
|
|
(defun highlight-indent-guides--guide-line (guides)
|
|
"Draw the indent guides specified by GUIDES on the current line."
|
|
(let ((guides (reverse (car guides)))
|
|
(sections (cdr guides))
|
|
(column (current-column))
|
|
(currpt (point))
|
|
(starter t)
|
|
(face 0) currcol currface props oldprop newprop subsect)
|
|
(while guides
|
|
(setq props nil)
|
|
(setq currcol column)
|
|
(setq currface face)
|
|
(setq currpt (point))
|
|
(forward-char)
|
|
(setq column (current-column))
|
|
(while (and guides (< (car guides) column))
|
|
(setq props (cons (- (car guides) currcol) props))
|
|
(setq guides (cdr guides))
|
|
(setq face (1+ face)))
|
|
(setq props (reverse props))
|
|
(when (and props (zerop (car props)))
|
|
(setq props (cdr props))
|
|
(setq currface (1+ currface))
|
|
(setq starter t))
|
|
(setq subsect (nthcdr (1- (length guides)) sections))
|
|
(setq oldprop (get-text-property currpt 'highlight-indent-guides-prop))
|
|
(setq newprop
|
|
(list currface props starter (- column currcol) nil subsect))
|
|
(when (and oldprop
|
|
(eq (car newprop) (car oldprop))
|
|
(equal (nth 1 newprop) (nth 1 oldprop))
|
|
(eq (nth 2 newprop) (nth 2 oldprop))
|
|
(eq (nth 3 newprop) (nth 3 oldprop)))
|
|
(setcar (nthcdr 4 newprop) (nth 4 oldprop)))
|
|
(when guides
|
|
(add-text-properties
|
|
currpt (1+ currpt) `(highlight-indent-guides-prop ,newprop)))
|
|
(setq starter nil))))
|
|
|
|
(defun highlight-indent-guides--replace-section (old search replace)
|
|
"Replace in a list OLD section prefixes SEARCH with REPLACE.
|
|
All lines in the same section should have the same (eq) section prefixes. If
|
|
the prefix changes on some lines, all other lines in the section need to be
|
|
updated to match."
|
|
(let* ((oldlen (length old))
|
|
(replen (length replace))
|
|
(minlen (min oldlen replen))
|
|
(cparent (nthcdr (- oldlen minlen) (cons nil old)))
|
|
(cold (nthcdr (- oldlen minlen) old))
|
|
(csearch (nthcdr (- replen minlen) search))
|
|
(crepl (nthcdr (- replen minlen) replace)))
|
|
(while (and cold (not (eq cold csearch)))
|
|
(setq cparent (cdr cparent))
|
|
(setq cold (cdr cold))
|
|
(setq csearch (cdr csearch))
|
|
(setq crepl (cdr crepl)))
|
|
(if (null cold) old
|
|
(setcdr cparent crepl)
|
|
(if (car cparent) old (cdr cparent)))))
|
|
|
|
(defun highlight-indent-guides--guide-region (start end)
|
|
"Add or update indent guides in the buffer region from START to END."
|
|
(with-silent-modifications
|
|
(save-excursion
|
|
(goto-char start)
|
|
(beginning-of-line)
|
|
(let ((prop 'highlight-indent-guides-prop)
|
|
(guides (highlight-indent-guides--get-prev-guides))
|
|
(eof (< 0 (forward-line)))
|
|
(startl (point)) (endl end)
|
|
chunk oldguides oldsect newsect lf le rng)
|
|
;; for the given region, extract old guides and calculate new guides
|
|
(while (not (or eof (and (>= (point) endl)
|
|
(not (eq oldguides t))
|
|
(equal (car guides) (car oldguides))
|
|
(eq (cdr guides) (cdr oldguides)))))
|
|
(if (or (let ((s (syntax-ppss))) (or (nth 3 s) (nth 4 s)))
|
|
(looking-at "[[:space:]]*$"))
|
|
(setq chunk (cons (list (point)) chunk))
|
|
(let ((tmpguides (cdr guides)) ends currend)
|
|
(while tmpguides
|
|
(when (car tmpguides)
|
|
(setq ends (cons (marker-position (cdar tmpguides)) ends)))
|
|
(setq tmpguides (cdr tmpguides)))
|
|
(setq guides (highlight-indent-guides--calc-guides guides))
|
|
(setq endl (max endl (or (nth (length (cdr guides)) ends) 0))))
|
|
(setq oldguides (highlight-indent-guides--get-guides))
|
|
(setq chunk (cons (list (point) guides oldguides) chunk)))
|
|
(setq eof (< 0 (forward-line)))
|
|
;; expand sections if necessary
|
|
(when (or eof (and (>= (point) endl)
|
|
(not (eq oldguides t))
|
|
(equal (car guides) (car oldguides))))
|
|
(let ((lep (line-end-position 0)))
|
|
(dolist (guide (cdr guides))
|
|
(when (and (cdr guide) (> lep (cdr guide)))
|
|
(set-marker (cdr guide) lep)))))
|
|
;; ensure chunk is flush with surrounding sections
|
|
(when (and (>= (point) endl)
|
|
(not (eq oldguides t))
|
|
(equal (car guides) (car oldguides))
|
|
(not (eq (cdr guides) (cdr oldguides))))
|
|
(setq guides (cons (car guides) (cdr guides)))
|
|
(let ((ng (cdr guides)) (og (cdr oldguides)) (badguide t)
|
|
abovestart aboveend belowstart belowend above below)
|
|
(while (and og ng (nlistp badguide))
|
|
(when (eq (cdr og) (cdr ng)) (setq badguide (cons og ng)))
|
|
(setq ng (cdr ng) og (cdr og)))
|
|
(setq abovestart (caar (cdr badguide)) aboveend startl)
|
|
(setq belowstart (point) belowend (cdar (car badguide)))
|
|
(setq above (- aboveend abovestart) below (- belowend belowstart))
|
|
(if (>= (- belowstart abovestart) below) (setq endl belowend)
|
|
(if (>= 0 above)
|
|
(let ((ng (cdr guides)) (og (cdr oldguides)))
|
|
;; transform existing lines in chunk to use new sections
|
|
(while (and og ng)
|
|
(set-marker (caar og) (caar ng))
|
|
(setq ng (cdr ng) og (cdr og)))
|
|
(dolist (line chunk)
|
|
(when (cdr line)
|
|
(setcdr (nth 1 line)
|
|
(highlight-indent-guides--replace-section
|
|
(cdr (nth 1 line))
|
|
(cdr guides) (cdr oldguides))))))
|
|
(goto-char abovestart)
|
|
(setq guides (highlight-indent-guides--get-prev-guides))
|
|
(setq eof (< 0 (forward-line)))
|
|
(setq startl (point) oldguides nil chunk nil))))))
|
|
;; rewrite text properties for all lines in chunk
|
|
(dolist (line chunk)
|
|
(goto-char (car line))
|
|
(if (cdr line)
|
|
(setq lf (save-excursion (back-to-indentation) (point)))
|
|
(setq lf (car line)))
|
|
(setq le (line-end-position))
|
|
(unless (and (null (get-text-property lf prop))
|
|
(eq le (next-single-property-change lf prop nil le)))
|
|
(remove-text-properties lf le (list prop nil)))
|
|
(when (or (eq t (nth 2 line))
|
|
(not (equal (car (nth 1 line)) (car (nth 2 line))))
|
|
(not (eq (cdr (nth 1 line)) (cdr (nth 2 line)))))
|
|
(highlight-indent-guides--guide-line (nth 1 line))))
|
|
;; update the line cache if necessary
|
|
(when (car highlight-indent-guides--line-cache)
|
|
(goto-char (car highlight-indent-guides--line-cache))
|
|
(setq oldsect (nth 2 highlight-indent-guides--line-cache))
|
|
(setq newsect (highlight-indent-guides--update-line-cache))
|
|
(setcar (cddr highlight-indent-guides--line-cache) newsect))
|
|
;; refontify updated regions
|
|
(if (equal oldsect newsect)
|
|
(font-lock-fontify-region startl endl)
|
|
(setq rng (highlight-indent-guides--discover-ranges oldsect newsect))
|
|
(dolist (range (highlight-indent-guides--try-merge-ranges
|
|
(cons startl endl) (car rng) (cadr rng)))
|
|
(font-lock-fontify-region (car range) (cdr range))))))))
|
|
|
|
(defun highlight-indent-guides--unguide-region (start end)
|
|
"Remove all indent guides in the buffer region from START to END."
|
|
(with-silent-modifications
|
|
(remove-text-properties start end '(highlight-indent-guides-prop nil))))
|
|
|
|
(defun highlight-indent-guides--fill-keyword-matcher (limit)
|
|
"Search for indent guides between the point and LIMIT.
|
|
Find the next character that is part of any indentation. This is meant to be
|
|
used as a `font-lock-keywords' matcher."
|
|
(let* ((pos (point))
|
|
(prop 'highlight-indent-guides-prop)
|
|
(face (car (get-text-property pos prop))))
|
|
(while (and (not (natnump face)) (< pos limit))
|
|
(setq pos (next-single-property-change pos prop nil limit))
|
|
(setq face (car (get-text-property pos prop))))
|
|
(when (< pos limit)
|
|
(set-match-data (list (copy-marker pos) (copy-marker (1+ pos))))
|
|
(goto-char (1+ pos)))))
|
|
|
|
(defun highlight-indent-guides--column-keyword-matcher (limit)
|
|
"Search for indent guides between the point and LIMIT.
|
|
Find the next character that contains the first column of an indentation level.
|
|
This is meant to be used as a `font-lock-keywords' matcher."
|
|
(let* ((pos (point))
|
|
(prop 'highlight-indent-guides-prop)
|
|
(propval (get-text-property pos prop)))
|
|
(while (and (not (and (natnump (car propval))
|
|
(or (nth 2 propval) (nth 1 propval)))) (< pos limit))
|
|
(setq pos (1+ pos))
|
|
(setq propval (get-text-property pos prop))
|
|
(while (and (< pos limit) (not (natnump (car propval))))
|
|
(setq pos (next-single-property-change pos prop nil limit))
|
|
(setq propval (get-text-property pos prop))))
|
|
(when (< pos limit)
|
|
(set-match-data (list (copy-marker pos) (copy-marker (1+ pos))))
|
|
(goto-char (1+ pos)))))
|
|
|
|
(defun highlight-indent-guides--highlighter-default (level responsive display)
|
|
"Determine the correct face to use for a given indentation level.
|
|
Uses the LEVEL, RESPONSIVE context, and DISPLAY method to decide on a correct
|
|
face for any given indentation. This is the default implementation of
|
|
`highlight-indent-guides-highlighter-function'."
|
|
(cond ((null responsive)
|
|
(cond ((or (eq display 'character) (eq display 'bitmap))
|
|
'highlight-indent-guides-character-face)
|
|
((zerop (mod level 2))
|
|
'highlight-indent-guides-even-face)
|
|
(t 'highlight-indent-guides-odd-face)))
|
|
((eq responsive 'top)
|
|
(cond ((or (eq display 'character) (eq display 'bitmap))
|
|
'highlight-indent-guides-top-character-face)
|
|
((zerop (mod level 2))
|
|
'highlight-indent-guides-top-even-face)
|
|
(t 'highlight-indent-guides-top-odd-face)))
|
|
((eq responsive 'stack)
|
|
(cond ((or (eq display 'character) (eq display 'bitmap))
|
|
'highlight-indent-guides-stack-character-face)
|
|
((zerop (mod level 2))
|
|
'highlight-indent-guides-stack-even-face)
|
|
(t 'highlight-indent-guides-stack-odd-face)))
|
|
(t nil)))
|
|
|
|
(defmacro highlight-indent-guides--cache-highlight (type prop hlkey &rest body)
|
|
"Memoize the highlighter results in the character's properties.
|
|
If a cached result with the right TYPE (`fill', `column', or `character') is
|
|
contained in PROP with a responsive context matching HLKEY, return that result
|
|
instead of calculating a new one. Otherwise, calculate a new result by running
|
|
BODY, cache it in PROP, and return it."
|
|
`(let ((cache (nth 4 ,prop)) plist result)
|
|
(if (and (eq ,type (car cache))
|
|
(setq result (lax-plist-get (cdr cache) ,hlkey)))
|
|
result
|
|
(setq result (progn ,@body))
|
|
(setq plist (lax-plist-put (cdr cache) ,hlkey result))
|
|
(setcar (nthcdr 4 ,prop) (cons ,type plist))
|
|
result)))
|
|
|
|
(defun highlight-indent-guides--should-highlight (prop)
|
|
"Determine how a guide should be highlighted in responsive mode.
|
|
The guide's data is given as PROP."
|
|
(if (null highlight-indent-guides-responsive) nil
|
|
(let ((currseg (nth 5 prop))
|
|
(segct (max 1 (+ (length (nth 1 prop)) (if (nth 2 prop) 1 0))))
|
|
(cacheseg (nth 2 highlight-indent-guides--line-cache))
|
|
(isstack (eq highlight-indent-guides-responsive 'stack))
|
|
result)
|
|
(dotimes (segnum segct result)
|
|
(cond ((equal cacheseg currseg)
|
|
(setq result (cons 'top result)))
|
|
((and isstack (highlight-indent-guides--iscdr currseg cacheseg))
|
|
(setq result (cons 'stack result)))
|
|
(t (setq result (cons nil result))))
|
|
(setq currseg (cdr currseg))))))
|
|
|
|
(defun highlight-indent-guides--fill-highlighter ()
|
|
"Apply highlighting to the indentation.
|
|
Return highlighting information for the matched character. Highlights all
|
|
indentation characters in alternating colors. This is meant to be used as a
|
|
`font-lock-keywords' face definition."
|
|
(let* ((prop (get-text-property (match-beginning 0) 'highlight-indent-guides-prop))
|
|
(shouldhl (highlight-indent-guides--should-highlight prop)))
|
|
(highlight-indent-guides--cache-highlight
|
|
'fill prop shouldhl
|
|
(let ((highlighter highlight-indent-guides-highlighter-function)
|
|
(facep (car prop)) (segs (nth 1 prop)) (cwidth (nth 3 prop))
|
|
(pseg 0) face showstr)
|
|
(if (null segs) (funcall highlighter facep (car shouldhl) 'fill)
|
|
(setq showstr (make-string cwidth ?\s))
|
|
(dolist (seg segs)
|
|
(setq face (funcall highlighter facep (pop shouldhl) 'fill))
|
|
(when face (add-text-properties pseg seg `(face ,face) showstr))
|
|
(setq pseg seg)
|
|
(setq facep (1+ facep)))
|
|
(setq face (funcall highlighter facep (pop shouldhl) 'fill))
|
|
(when face (add-text-properties pseg cwidth `(face ,face) showstr))
|
|
`(face nil display ,showstr))))))
|
|
|
|
(defun highlight-indent-guides--column-highlighter ()
|
|
"Apply highlighting to the indentation.
|
|
Return highlighting information for the matched character. Highlights the
|
|
first column of each indentation level in alternating colors. This is meant to
|
|
be used as a `font-lock-keywords' face definition."
|
|
(let* ((prop (get-text-property (match-beginning 0) 'highlight-indent-guides-prop))
|
|
(shouldhl (highlight-indent-guides--should-highlight prop)))
|
|
(highlight-indent-guides--cache-highlight
|
|
'column prop shouldhl
|
|
(let ((highlighter highlight-indent-guides-highlighter-function)
|
|
(facep (car prop)) (segs (nth 1 prop))
|
|
(starter (nth 2 prop)) (cwidth (nth 3 prop))
|
|
face showstr)
|
|
(if (and (null segs) (eq cwidth 1))
|
|
(funcall highlighter facep (car shouldhl) 'column)
|
|
(setq showstr (make-string cwidth ?\s))
|
|
(when starter
|
|
(setq face (funcall highlighter facep (pop shouldhl) 'column))
|
|
(when face (add-text-properties 0 1 `(face ,face) showstr)))
|
|
(dolist (seg segs)
|
|
(setq face (funcall highlighter facep (pop shouldhl) 'column))
|
|
(when face (add-text-properties seg (1+ seg) `(face ,face) showstr))
|
|
(setq facep (1+ facep)))
|
|
`(face nil display ,showstr))))))
|
|
|
|
(defun highlight-indent-guides--character-highlighter ()
|
|
"Apply highlighting to the indentation.
|
|
Return highlighting information for the matched character. Displays a character
|
|
in place of the first column of each indentation level. This is meant to be
|
|
used as a `font-lock-keywords' face definition."
|
|
(let* ((prop (get-text-property (match-beginning 0) 'highlight-indent-guides-prop))
|
|
(shouldhl (highlight-indent-guides--should-highlight prop)))
|
|
(highlight-indent-guides--cache-highlight
|
|
'character prop shouldhl
|
|
(let ((highlighter highlight-indent-guides-highlighter-function)
|
|
(facep (car prop)) (segs (nth 1 prop))
|
|
(starter (nth 2 prop)) (cwidth (nth 3 prop))
|
|
face showstr)
|
|
(if (and (null segs) (eq cwidth 1))
|
|
(progn
|
|
(setq face (funcall highlighter facep (car shouldhl) 'character))
|
|
(when face
|
|
(setq showstr
|
|
(char-to-string highlight-indent-guides-character)))
|
|
`(face ,face display ,showstr))
|
|
(setq showstr (make-string cwidth ?\s))
|
|
(when starter
|
|
(setq face (funcall highlighter facep (pop shouldhl) 'character))
|
|
(when face
|
|
(aset showstr 0 highlight-indent-guides-character)
|
|
(add-text-properties 0 1 `(face ,face) showstr)))
|
|
(dolist (seg segs)
|
|
(setq face (funcall highlighter facep (pop shouldhl) 'character))
|
|
(when face
|
|
(aset showstr seg highlight-indent-guides-character)
|
|
(add-text-properties seg (1+ seg) `(face ,face) showstr))
|
|
(setq facep (1+ facep)))
|
|
`(face nil display ,showstr))))))
|
|
|
|
(defun highlight-indent-guides--bitmap-highlighter ()
|
|
"Apply highlighting to the indentation.
|
|
Return highlighting information for the matched character. Displays a bitmap in
|
|
place of the first column of each indentation level. This is meant to be used
|
|
as a `font-lock-keywords' face definition."
|
|
(let* ((prop (get-text-property (match-beginning 0) 'highlight-indent-guides-prop))
|
|
(shouldhl (highlight-indent-guides--should-highlight prop)))
|
|
(highlight-indent-guides--cache-highlight
|
|
'bitmap prop shouldhl
|
|
(let ((highlighter highlight-indent-guides-highlighter-function)
|
|
(facep (car prop)) (segs (nth 1 prop))
|
|
(starter (nth 2 prop)) (cwidth (nth 3 prop))
|
|
face facelist showbmp)
|
|
(if (and (null segs) (eq cwidth 1))
|
|
(progn
|
|
(setq face (funcall highlighter facep (car shouldhl) 'bitmap))
|
|
(when face
|
|
(setq showbmp (highlight-indent-guides--draw-bitmap
|
|
(funcall
|
|
highlight-indent-guides-bitmap-function
|
|
(default-font-width) (default-font-height) ?1)
|
|
(list (cons "1" (face-foreground face))))))
|
|
`(face nil display ,showbmp))
|
|
(setq facelist (make-list cwidth nil))
|
|
(when starter
|
|
(setq face (funcall highlighter facep (pop shouldhl) 'bitmap))
|
|
(when face (setcar facelist (face-foreground face))))
|
|
(dolist (seg segs)
|
|
(setq face (funcall highlighter facep (pop shouldhl) 'bitmap))
|
|
(when face (setcar (nthcdr seg facelist) (face-foreground face)))
|
|
(setq facep (1+ facep)))
|
|
(setq showbmp (highlight-indent-guides--concat-bitmap
|
|
(default-font-width) (default-font-height) facelist))
|
|
`(face nil display ,showbmp))))))
|
|
|
|
(defun highlight-indent-guides--concat-bitmap (width height facelist)
|
|
"Build a concatenated XPM image based on FACELIST.
|
|
FACELIST represents characters in the guide block (nil for no guide, and a color
|
|
string for a guide with that color). WIDTH and HEIGHT are the width and height
|
|
of each character in the block."
|
|
(let ((res (make-list height ""))
|
|
(crep 0)
|
|
colors nextbmp)
|
|
(while (not (null facelist))
|
|
(if (null (car facelist))
|
|
(let ((zlen 0))
|
|
(while (and (not (null facelist)) (null (car facelist)))
|
|
(setq zlen (+ zlen width))
|
|
(setq facelist (cdr facelist)))
|
|
(dotimes (i height)
|
|
(setcar (nthcdr i res) (concat (nth i res) (make-string zlen ?0)))))
|
|
(setq crep (1+ crep))
|
|
(setq nextbmp (funcall
|
|
highlight-indent-guides-bitmap-function
|
|
width height (string-to-char (number-to-string crep))))
|
|
(setq colors (cons (cons (number-to-string crep) (car facelist)) colors))
|
|
(setq facelist (cdr facelist))
|
|
(dotimes (i height)
|
|
(setcar (nthcdr i res) (concat (nth i res) (nth i nextbmp))))))
|
|
(highlight-indent-guides--draw-bitmap res colors)))
|
|
|
|
(defun highlight-indent-guides--draw-bitmap (lines colorset)
|
|
"Using pixel data LINES and color data COLORSET, build an XPM image."
|
|
(let* ((width (length (car lines)))
|
|
(height (length lines))
|
|
(start "/* XPM */\nstatic char *guide[] = {")
|
|
(size (concat "\"" (number-to-string width) " "
|
|
(number-to-string height) " "
|
|
(number-to-string (1+ (length colorset))) " 1\","))
|
|
(colors "\"0 c None\",")
|
|
(pixels (concat "\"" (mapconcat 'identity lines "\",\"") "\""))
|
|
(end "};")
|
|
data csym)
|
|
(dolist (color colorset)
|
|
(setq colors (concat colors "\"" (car color) " c color" (car color) "\","))
|
|
(setq csym (cons (cons (concat "color" (car color)) (cdr color)) csym)))
|
|
(setq data (concat start size colors pixels end))
|
|
`(image :type xpm :data ,data :mask heuristic :ascent center
|
|
:color-symbols ,csym)))
|
|
|
|
(defun highlight-indent-guides--bitmap-line (width height crep)
|
|
"Defines a solid guide line, two pixels wide."
|
|
(let* ((left (/ (- width 2) 2))
|
|
(right (- width left 2))
|
|
(row (concat (make-string left ?0) (make-string 2 crep) (make-string right ?0)))
|
|
rows)
|
|
(dotimes (i height rows)
|
|
(setq rows (cons row rows)))))
|
|
|
|
(defun highlight-indent-guides--bitmap-dots (width height crep)
|
|
"Defines a dotted guide line, with 2x2 pixel dots, and four dots per row."
|
|
(let* ((left (/ (- width 2) 2))
|
|
(right (- width left 2))
|
|
(space (/ height 4))
|
|
(space1 (/ (- space 2) 2))
|
|
(row1 (concat (make-string left ?0) (make-string 2 crep) (make-string right ?0)))
|
|
(row2 (make-string width ?0))
|
|
rows)
|
|
(dotimes (i height rows)
|
|
(if (let ((x (mod (- i space1) space))) (or (eq x 0) (eq x 1)))
|
|
(setq rows (cons row1 rows))
|
|
(setq rows (cons row2 rows))))))
|
|
|
|
(defun highlight-indent-guides--overdraw (start end)
|
|
"Overdraw the guides in the region from START to END.
|
|
This function is like `font-lock-fontify-region' or `font-lock-ensure', except
|
|
it only draws indent guides. This function is called to update the display
|
|
whenever the active indent level changes, as long as responsive guides are
|
|
enabled. This function is used because it avoids doing extra work like clearing
|
|
existing fontification, redrawing syntax and other keywords, or calling jit-lock
|
|
recursively."
|
|
(with-silent-modifications
|
|
(save-excursion
|
|
(save-restriction
|
|
(let ((matcher
|
|
(pcase highlight-indent-guides-method
|
|
(`fill 'highlight-indent-guides--fill-keyword-matcher)
|
|
(`column 'highlight-indent-guides--column-keyword-matcher)
|
|
(`character 'highlight-indent-guides--column-keyword-matcher)
|
|
(`bitmap 'highlight-indent-guides--column-keyword-matcher)))
|
|
(highlight
|
|
(pcase highlight-indent-guides-method
|
|
(`fill 'highlight-indent-guides--fill-highlighter)
|
|
(`column 'highlight-indent-guides--column-highlighter)
|
|
(`character 'highlight-indent-guides--character-highlighter)
|
|
(`bitmap 'highlight-indent-guides--bitmap-highlighter)))
|
|
(inhibit-point-motion-hooks t))
|
|
(unless font-lock-dont-widen (widen))
|
|
(goto-char start)
|
|
(while (and (< (point) end) (funcall matcher end))
|
|
(unless (> (point) (match-beginning 0)) (forward-char 1))
|
|
(font-lock-apply-highlight (list 0 (list highlight) t))))))))
|
|
|
|
;;;###autoload
|
|
(defun highlight-indent-guides-auto-set-faces ()
|
|
"Automatically calculate indent guide faces.
|
|
If this feature is enabled, calculate reasonable values for the indent guide
|
|
colors based on the current theme's colorscheme, and set them appropriately.
|
|
This runs whenever a theme is loaded, but it can also be run interactively."
|
|
(interactive)
|
|
(when highlight-indent-guides-auto-enabled
|
|
(let* ((bk (face-background 'default nil 'default))
|
|
(fg (color-name-to-rgb (face-foreground 'default nil 'default)))
|
|
(bg (color-name-to-rgb bk))
|
|
(oddf 'highlight-indent-guides-odd-face)
|
|
(evenf 'highlight-indent-guides-even-face)
|
|
(charf 'highlight-indent-guides-character-face)
|
|
(toddf 'highlight-indent-guides-top-odd-face)
|
|
(tevenf 'highlight-indent-guides-top-even-face)
|
|
(tcharf 'highlight-indent-guides-top-character-face)
|
|
(soddf 'highlight-indent-guides-stack-odd-face)
|
|
(sevenf 'highlight-indent-guides-stack-even-face)
|
|
(scharf 'highlight-indent-guides-stack-character-face)
|
|
(oddp highlight-indent-guides-auto-odd-face-perc)
|
|
(evenp highlight-indent-guides-auto-even-face-perc)
|
|
(charp highlight-indent-guides-auto-character-face-perc)
|
|
(toddp highlight-indent-guides-auto-top-odd-face-perc)
|
|
(tevenp highlight-indent-guides-auto-top-even-face-perc)
|
|
(tcharp highlight-indent-guides-auto-top-character-face-perc)
|
|
(soddp highlight-indent-guides-auto-stack-odd-face-perc)
|
|
(sevenp highlight-indent-guides-auto-stack-even-face-perc)
|
|
(scharp highlight-indent-guides-auto-stack-character-face-perc)
|
|
mod fl bl)
|
|
(if (not (and fg bg))
|
|
(unless highlight-indent-guides-suppress-auto-error
|
|
(message "Error: %s: %s"
|
|
"highlight-indent-guides cannot auto set faces"
|
|
"`default' face is not set properly"))
|
|
(setq fl (nth 2 (apply 'color-rgb-to-hsl fg)))
|
|
(setq bl (nth 2 (apply 'color-rgb-to-hsl bg)))
|
|
(setq mod (cond ((< fl bl) -1) ((> fl bl) 1) ((< 0.5 bl) -1) (t 1)))
|
|
(set-face-background oddf (color-lighten-name bk (* mod oddp)))
|
|
(set-face-background evenf (color-lighten-name bk (* mod evenp)))
|
|
(set-face-foreground charf (color-lighten-name bk (* mod charp)))
|
|
(set-face-background toddf (color-lighten-name bk (* mod toddp)))
|
|
(set-face-background tevenf (color-lighten-name bk (* mod tevenp)))
|
|
(set-face-foreground tcharf (color-lighten-name bk (* mod tcharp)))
|
|
(set-face-background soddf (color-lighten-name bk (* mod soddp)))
|
|
(set-face-background sevenf (color-lighten-name bk (* mod sevenp)))
|
|
(set-face-foreground scharf (color-lighten-name bk (* mod scharp)))))))
|
|
|
|
(defadvice load-theme (after highlight-indent-guides-auto-set-faces disable)
|
|
"Automatically calculate indent guide faces.
|
|
If this feature is enabled, calculate reasonable values for the indent guide
|
|
colors based on the current theme's colorscheme, and set them appropriately.
|
|
This runs whenever a theme is loaded."
|
|
(highlight-indent-guides-auto-set-faces))
|
|
|
|
(defadvice disable-theme (after highlight-indent-guides-auto-set-faces disable)
|
|
"Automatically calculate indent guide faces.
|
|
If this feature is enabled, calculate reasonable values for the indent guide
|
|
colors based on the current theme's colorscheme, and set them appropriately.
|
|
This runs whenever a theme is disabled."
|
|
(highlight-indent-guides-auto-set-faces))
|
|
|
|
(defun highlight-indent-guides--auto-set-faces-with-frame (frame)
|
|
"Run `highlight-indent-guides-auto-set-faces' in frame FRAME.
|
|
This function is designed to run from the `after-make-frame-functions' hook."
|
|
(with-selected-frame frame
|
|
(highlight-indent-guides-auto-set-faces)))
|
|
|
|
(make-variable-buffer-local 'font-lock-extra-managed-props)
|
|
(make-variable-buffer-local 'text-property-default-nonsticky)
|
|
|
|
;;;###autoload
|
|
(define-minor-mode highlight-indent-guides-mode
|
|
"Display indent guides in a buffer."
|
|
nil " h-i-g" nil
|
|
(let ((fill-method-keywords
|
|
'((highlight-indent-guides--fill-keyword-matcher
|
|
0 (highlight-indent-guides--fill-highlighter) t)))
|
|
(column-method-keywords
|
|
'((highlight-indent-guides--column-keyword-matcher
|
|
0 (highlight-indent-guides--column-highlighter) t)))
|
|
(character-method-keywords
|
|
'((highlight-indent-guides--column-keyword-matcher
|
|
0 (highlight-indent-guides--character-highlighter) t)))
|
|
(bitmap-method-keywords
|
|
'((highlight-indent-guides--column-keyword-matcher
|
|
0 (highlight-indent-guides--bitmap-highlighter) t))))
|
|
(when highlight-indent-guides--idle-timer
|
|
(cancel-timer highlight-indent-guides--idle-timer)
|
|
(setq highlight-indent-guides--idle-timer nil))
|
|
(if highlight-indent-guides-mode
|
|
(progn
|
|
;; set highlight-indent-guides--line-cache so it becomes buffer-local
|
|
;; After this, we can destructively modify it just fine, as every
|
|
;; buffer has a unique object.
|
|
(setq highlight-indent-guides--line-cache (list nil nil nil))
|
|
(unless (daemonp) (highlight-indent-guides-auto-set-faces))
|
|
(add-to-list 'after-make-frame-functions
|
|
'highlight-indent-guides--auto-set-faces-with-frame)
|
|
(ad-enable-advice 'load-theme 'after
|
|
'highlight-indent-guides-auto-set-faces)
|
|
(ad-activate 'load-theme)
|
|
(ad-enable-advice 'disable-theme 'after
|
|
'highlight-indent-guides-auto-set-faces)
|
|
(ad-activate 'disable-theme)
|
|
(add-to-list 'font-lock-extra-managed-props 'display)
|
|
(add-to-list 'text-property-default-nonsticky
|
|
(cons 'highlight-indent-guides-prop t))
|
|
(setq highlight-indent-guides--idle-timer
|
|
(run-with-idle-timer
|
|
highlight-indent-guides-delay t
|
|
'highlight-indent-guides--try-update-line-cache))
|
|
(font-lock-add-keywords
|
|
nil
|
|
(pcase highlight-indent-guides-method
|
|
(`fill fill-method-keywords)
|
|
(`column column-method-keywords)
|
|
(`character character-method-keywords)
|
|
(`bitmap bitmap-method-keywords))
|
|
t)
|
|
(jit-lock-register 'highlight-indent-guides--guide-region))
|
|
(setq after-make-frame-functions
|
|
(delete 'highlight-indent-guides--auto-set-faces-with-frame
|
|
after-make-frame-functions))
|
|
(ad-disable-advice 'load-theme 'after
|
|
'highlight-indent-guides-auto-set-faces)
|
|
(ad-activate 'load-theme)
|
|
(ad-disable-advice 'disable-theme 'after
|
|
'highlight-indent-guides-auto-set-faces)
|
|
(ad-activate 'disable-theme)
|
|
(font-lock-remove-keywords nil fill-method-keywords)
|
|
(font-lock-remove-keywords nil column-method-keywords)
|
|
(font-lock-remove-keywords nil character-method-keywords)
|
|
(jit-lock-unregister 'highlight-indent-guides--guide-region)
|
|
(highlight-indent-guides--unguide-region (point-min) (point-max))
|
|
(if (fboundp 'font-lock-flush) (font-lock-flush)
|
|
(font-lock-fontify-buffer)))))
|
|
|
|
(provide 'highlight-indent-guides)
|
|
|
|
;;; highlight-indent-guides.el ends here
|