From 4021903e86a4ccbd23ad0adb47b94a2109c8c77a Mon Sep 17 00:00:00 2001 From: Daniel Weschke Date: Sun, 18 Dec 2022 20:08:31 +0100 Subject: [PATCH] clean packages --- lisp/highlight-indent-guides.el | 1010 ------------------------------- lisp/versions | 2 +- 2 files changed, 1 insertion(+), 1011 deletions(-) delete mode 100644 lisp/highlight-indent-guides.el diff --git a/lisp/highlight-indent-guides.el b/lisp/highlight-indent-guides.el deleted file mode 100644 index 1877eb91..00000000 --- a/lisp/highlight-indent-guides.el +++ /dev/null @@ -1,1010 +0,0 @@ -;;; 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 -;; 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 diff --git a/lisp/versions b/lisp/versions index ec3139b9..cbf21264 100644 --- a/lisp/versions +++ b/lisp/versions @@ -21,7 +21,7 @@ | company-quickhelp.el | [[https://melpa.org/#/company-quickhelp][melpa]] | 2.2.0 | 20211115.1335 | 2.2.0 | 20201208.2308 | | | company-web | [[https://melpa.org/#/company-web][melpa]] | 2.1 | 20180402.1155 | | | requires cl-lib company dash web-completion-data | | counsel.el | [[https://melpa.org/#/counsel][melpa]] | 0.13.4 | 20211230.1909 | 0.13.0 | 20201227.1327 | | -| crdt.el | [[https://code.librehq.com/qhong/crdt.el/][librehq]] | 0.2.7 | 2021.12.06 | 0.0.0 | 2020.12.28 | Collaborative editing using Conflict-free Replicated Data Types | +| crdt.el | [[https://elpa.gnu.org/packages/crdt.html][elpa]] | 0.2.7 | 2021.12.06 | 0.0.0 | 2020.12.28 | Collaborative editing using Conflict-free Replicated Data Types | | ctable.el | [[https://melpa.org/#/ctable][melpa]] | 0.1.3 | 20210128.629 | 0.1.2 | 20171006.11 | | | dash | [[https://melpa.org/#/dash][melpa]] | 2.19.1 | 20210826.1149 | 2.17.0 | 20210106.2158 | | | dashboard | [[https://melpa.org/#/dashboard][melpa]] | 1.8.0-SNAPSHOT | 20211221.2005 | 1.8.0-SNAPSHOT | 20210104.1605 | requires page-break-lines, (all-the-icons) |