diff options
Diffstat (limited to 'emacs/site-lisp/elastic-indent.el')
| -rw-r--r-- | emacs/site-lisp/elastic-indent.el | 291 |
1 files changed, 291 insertions, 0 deletions
diff --git a/emacs/site-lisp/elastic-indent.el b/emacs/site-lisp/elastic-indent.el new file mode 100644 index 0000000..a37bacb --- /dev/null +++ b/emacs/site-lisp/elastic-indent.el @@ -0,0 +1,291 @@ +;; elastic-indent-mode --- fix indentation with variable-pitch fonts. -*- lexical-binding: t; -*- +;; Copyright (C) 2023 Jean-Philippe Bernardy +;; Copyright (C) 2021 Scott Messick (tenbillionwords) + +;; This program 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. + +;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; General terminological note: elastic-indent-mode is concerned with +;;; adjusting the width of only spaces and tabs which occur before a +;;; printing character (not space or tab) on a line. We use the word +;;; “indentation” to refer to these tabs or spaces. It is ambiguous +;;; whether Unicode space characters other than space and (horizontal) +;;; tab should be considered part of the leading space or not, but in +;;; the code we assume it is only spaces and tabs. Thus +;;; elastic-indent-mode treats other space characters as printing +;;; characters. +;;; The support for tabs is currently limited. Tabs can only be first +;;; in the indentation (they cannot follows spaces). Editting code +;;; with tabs isn't fully supported either. + +;;; Code: + +(require 'cl-lib) +(require 'dash) +(require 'elastic-tools) + +(defgroup elastic-indent nil "Customization of elastic indentation." + :group 'elastic) + +(defcustom elastic-indent-lvl-cycle-size 1 "Size of the cycle used for faces. +If N is the cycle size, then faces 0 to N-1 will be used. See +also `elastic-indent-fst-col-faces' and `elastic-indent-rest-faces'." + :type 'int :group 'elastic-indent) + +(defcustom elastic-indent-fontify t + "If t, fontify indent levels. +Fontification can only happen on a per-character basis. +Therefore, if indentation is implemented by a mix of space and +tabulation characters, as typical in Emacs source code, the +results will not be pretty." + :type 'bool :group 'elastic-indent) + +(defface elastic-indent '((t (:inherit lazy-highlight))) "Face for indentation highlighting.") +(defface elastic-indent-2 '((t (:inherit highlight))) "Second face for indentation highlighting.") + +(defcustom elastic-indent-fst-col-faces '(elastic-indent) + "Faces for various levels (First column)." :type '(list face) :group 'elastic-indent) + +(defcustom elastic-indent-rest-faces '(nil) + "Faces for various levels (First column)." + :type '(list face) + :group 'elastic-indent) + +(defface elastic-indent-vertical-lines '((t ())) "Face for indentation lines.") + +(defun elastic-indent-fontify-alternate () + "Highlight indentation by columns of alternating background color." + (interactive) + (setq elastic-indent-lvl-cycle-size 2) + (setq elastic-indent-rest-faces '(elastic-indent elastic-indent-2)) + (setq elastic-indent-fst-col-faces '(elastic-indent elastic-indent-2))) + +(defun elastic-indent-fontify-with-lines () + "Experimental way to fontify indentation." + (interactive) + (setq elastic-indent-lvl-cycle-size 2) + (setq elastic-indent-rest-faces '(elastic-indent-vertical-lines default)) + (setq elastic-indent-fst-col-faces '(elastic-indent-vertical-lines default))) + +(define-minor-mode elastic-indent-mode + "Improves indentation with in variable-pitch face. +Adjust the width of indentation characters to align the indented +code to the correct position. The correct position is defined as +the same relative position to the previous line as it were if a +fixed-pitch face was used. + +More precisely, any space character on a line with no printing +characters before it will be matched up with a corresponding +character on the previous line, if there is one. That character +may itself be a width-adjusted space, meaning the width +ultimately comes from some other kind of character higher up. + +Due to technical limitations, this mode does not try to detect +situations where the font has changed but the text hasn't, which +will mess up the alignment. You can put +‘elastic-indent-do-buffer-if-enabled’ in appropriate hooks to +mitigate the problem." + :init-value nil :lighter nil :global nil + (if elastic-indent-mode + (elastic-tools-add-handler 'elastic-indent-do-region 50) + (elastic-tools-remove-handler 'elastic-indent-do-region) + (elastic-indent-clear-buffer))) + +(defun elastic-indent-char-lvl (pos l-pos) + "Return the indentation level at POS. +An indentation level is not the colum, but rather defined as the +number of times an indentation occured. Level is negative for the +spaces which aren't in the first column of any given level. If +this cannot be determined locally by what happens at POS, then +look at L-POS, which is a position just to the left of the +position for which we want the level." + (or (get-text-property pos 'elastic-indent-lvl) + (if (or (eq pos (point-min)) (eq (char-after (1- pos)) ?\n)) + 1 ;; first char in the line. creates an indentation level by default. + (let ((lvl-before (get-text-property (1- pos) 'elastic-indent-lvl))) + (if (and lvl-before (<= lvl-before 0)) + ;; it's a space before this position. Thus this character creates a new indentation level. + (1+ (abs lvl-before)) + (- (abs (or (get-text-property l-pos 'elastic-indent-lvl) 0)))))))) ; in case of tabs we have to come up with some number. Use 0. + +(defun elastic-indent-set-char-pixel-width (pos w) + "Set the width of character at POS to be W. +This only works if the character in question is a space or a tab. +Also add text properties to remember that we did this change and +by what." + (if w (add-text-properties pos (1+ pos) + (list 'display (list 'space :width (list w)) + 'elastic-indent-adjusted t + 'elastic-indent-width w)) + (remove-text-properties pos (1+ pos) '(display elastic-indent-width elastic-indent-adjusted)))) + +(defun elastic-indent-combine-info (std-width lst) + "Return the combination of infos in LST. +STD-WIDTH is the width of a `tab-width' fraction of a tab." + (cons (-sum (--map (or (car it) std-width) lst)) + (-some 'cdr lst))) + +(defun elastic-indent-set-char-info (pos i) + "Set width and face I for space at POS. +The car of I is the width, and the cdr of I is the level." + (when i + (elastic-indent-set-char-pixel-width pos (car i)) + (let* ((lvl (or (cdr i))) + (face-set (if (> lvl 0) elastic-indent-fst-col-faces elastic-indent-rest-faces)) + (face (nth (mod lvl elastic-indent-lvl-cycle-size) face-set))) + (put-text-property pos (1+ pos) 'elastic-indent-lvl lvl) + (when (and elastic-indent-fontify lvl) + (if face (put-text-property pos (1+ pos) 'font-lock-face face) + (remove-text-properties pos (1+ pos) '(font-lock-face))))))) + +(defun elastic-indent-column-leaves-indent (target) + "Return t if by advancing TARGET columns one reaches the end of the indentation." + (let ((col 0)) + (while (and (not (eobp)) (< col target)) + (pcase (char-after) + (?\s (setq col (1+ col))) + (?\t (setq col (+ 8 col))) + (_ (setq target -1))) + (when (<= 0 target) (forward-char))) + (not (looking-at (rx (any "\s\t")))))) + +(defun elastic-indent-in-indent () + "Return t iff all characters to the left are indentation chars." + (save-excursion + (while (and (not (bolp)) + (pcase (char-before) + ((or ?\s ?\t) (or (backward-char 1) t))))) + (bolp))) + +(defun elastic-indent-do-1 (force-propagate start-col change-end) + "Adjust width of indentations. +This is in response to a change starting at point and ending at +CHANGE-END. START-COL is the minimum column where a change +occured. Start at point and continue until line which cannot be +impacted by the change is found. Such a line occurs if its +indentation level is less than START-COL and starts after +CHANGE-END. + +Thus a large value of START-COL means that little work needs to +be done by this function. This optimisation is important, +because otherwise one needs to find a line with zero indentation, +which can be much further down the buffer. + +If a change spans several lines, then START-COL is ignored, and +changes are propagated until indentation level reaches 0. +FORCE-PROPAGATE forces even single-line changes to be treated +this way." + (let (prev-widths ; the list of widths of each *column* of indentation of the previous line + (reference-pos 0) ; the buffer position in the previous line of 1st printable char + (std-width (window-font-width)) + space-widths) ; accumulated widths of columns for current line + ;; (message "elastic-indent-do: %s [%s, %s]" start-col (point) change-end) + (cl-flet* + ((get-next-column-width () ; find reference width in the previous line. (effectful) + (let* ((l-pos (1- (point))) + (w (if prev-widths (pop prev-widths) ; we have a cached width: use it. + (if (eql (char-after reference-pos) ?\n) ; we're at the end of the reference line. + (cons nil (if (bolp) + (- 1) ; we're at a space on the 1st column with an empty line above. No indentation here. + (- (abs (elastic-indent-char-lvl l-pos nil))))) ; leave width as is. Level is the same as char on the left; but not 1st column. + (prog1 + (cons (elastic-tools-char-pixel-width reference-pos) (elastic-indent-char-lvl reference-pos l-pos)) + (setq reference-pos (1+ reference-pos))))))) + (push w space-widths) ; cache width for next line + ;; (message "char copy: %s->%s (w=%s) %s" (1- reference-pos) (point) w prev-widths) + w)) + (char-loop () ; take care of one line. + ;; copy width from prev-widths, then reference-pos to (point). Loop to end of indentation. + ;; Preconditions: cur col = start-col. prev-widths=nil or contains cached widths + ;; (message "@%s %s=>%s %s" (line-number-at-pos) (- reference-pos (length prev-widths)) (point) prev-widths) + (while-let ((cur-line-not-ended-c (not (eolp))) + (char (char-after)) + (char-is-indent-c (or (eql char ?\s) (eql char ?\t)))) + (pcase char + (?\s (elastic-indent-set-char-info (point) (get-next-column-width))) + (?\t (elastic-indent-set-char-info (point) + (elastic-indent-combine-info std-width + (--map (get-next-column-width) (-repeat tab-width ())))))) + (forward-char))) + (next-line () ; advance to next line, maintaining state. + (setq prev-widths (nreverse space-widths)) + (setq space-widths nil) + (setq reference-pos (point)) ; we go to next line exactly after we reached the last space + (forward-line))) + (save-excursion + (when (eq (forward-line -1) 0) + (setq reference-pos (progn (move-to-column start-col) (point))))) + ;; (message "%s: first line. update from startcol=%s curcol=%s" (line-number-at-pos) start-col (current-column)) + (when (elastic-indent-in-indent) ; if not characters are not to be changed. + (char-loop)) + (next-line) + (when (or force-propagate (<= (point) change-end)) + ;; this is a multiline change. It influences column 0. + ;; (message "%s: main phase; update lines from col 0" (line-number-at-pos)) + (when (> start-col 0) ; reference is wrong now + (setq start-col 0) + (setq prev-widths nil) + (setq reference-pos (save-excursion (forward-line -1) (point)))) + (while (<= (point) change-end) + (char-loop) + (next-line))) + ;; (message "%s: propagate changes and stop if indentation is too small" (line-number-at-pos)) + (while (not (elastic-indent-column-leaves-indent start-col)) + (char-loop) + (next-line)) + ;; (message "%s: propagation complete" (line-number-at-pos)) + (beginning-of-line)))) ; we did not in fact propagate on this line yet. + +(defun elastic-indent-change-extend (end) + "Return the first position after END which does not contain a space." + (max (point) + (save-excursion + (goto-char end) + ;; if we are changing something then the spaces just after the changes are + ;; invalid and must be updated. + (search-forward-regexp "[^\t\s]" nil t) + (1- (point))))) + +(defun elastic-indent-do-region (force-propagate start end) + "Adjust width of indentation characters in given region and propagate. +The region is between START and END in current +buffer. Propagation means to also fix the indentation of the +lines which follow, if their indentation widths might be impacted +by changes in given region. See `elastic-indent-do' for the +explanation of FORCE-PROPAGATE." + ;; (message "edr: (%s) %s-%s" force-propagate start end) + (let ((e (elastic-indent-change-extend end))) + (elastic-indent-clear-region start e) + (goto-char start) + (elastic-indent-do-1 force-propagate (current-column) e))) + +(defun elastic-indent-clear-region (start end) + "Remove all `elastic-indent-mode' properties between START and END." + (interactive "r") + (elastic-tools-clear-region-properties + start end 'elastic-indent-adjusted '(elastic-indent-adjusted + elastic-indent-width + elastic-indent-lvl + display + font-lock-face + mouse-face))) + +(defun elastic-indent-clear-buffer () + "Remove all `elastic-indent-mode' properties in buffer." + (interactive) + (elastic-indent-clear-region (point-min) (point-max))) + +(provide 'elastic-indent) +;;; elastic-indent.el ends here |