Add some files from site-lisp

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