diff options
Diffstat (limited to 'emacs')
| -rw-r--r-- | emacs/site-lisp/elastic-indent.el | 291 | ||||
| -rw-r--r-- | emacs/site-lisp/elastic-pkg.el | 6 | ||||
| -rw-r--r-- | emacs/site-lisp/elastic-table.el | 227 | ||||
| -rw-r--r-- | emacs/site-lisp/elastic-tools.el | 223 | ||||
| -rw-r--r-- | emacs/site-lisp/fixed-pitch.el | 53 | ||||
| -rw-r--r-- | emacs/site-lisp/tubthumping-theme.el | 310 |
6 files changed, 1110 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 diff --git a/emacs/site-lisp/elastic-pkg.el b/emacs/site-lisp/elastic-pkg.el new file mode 100644 index 0000000..3ba8b7b --- /dev/null +++ b/emacs/site-lisp/elastic-pkg.el @@ -0,0 +1,6 @@ +(define-package + "elastic" + "1.0.0" + "Elastic Spaces and Tabs for Programming With Proportional Fonts." + '((emacs "29.1") + (dash "2.19.1"))) diff --git a/emacs/site-lisp/elastic-table.el b/emacs/site-lisp/elastic-table.el new file mode 100644 index 0000000..da68f42 --- /dev/null +++ b/emacs/site-lisp/elastic-table.el @@ -0,0 +1,227 @@ +;; elastic-table --- alignment using tabs with variable pitch fonts. -*- lexical-binding: t; -*- +;; Copyright (C) 2023 JP 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/>. + +;;; Terminology: a tab after a printing char on a line is a “elastic tab” and a +;;; line which has one is a “elastic table line”. A sequence of one or more +;;; consecutive lines which have elastic tabs is a single “elastic table”. + +;;; Code: +(require 'cl-lib) +(require 'elastic-tools) + +(defcustom elastic-table-column-minimum-margin nil + "Minimum size of the space that replaces a tab. Expressed in pixels. +By default, `frame-char-width` will be used." + :type 'int :group 'elastic-table) + +(define-minor-mode elastic-table-mode + "Mode for alignment of using tabs, with variable pitch fonts. +When `elastic-table-mode' is enabled, tabstops in consecutive +lines are the same. + +This is implemented by automatically adjusting the width of tab +characters which occur after the first printing char on a +line (henceforth: “elastic tabs”) so to allow forming a kind of +table (“elastic tables”) is adjusted for alignment. An elastic +table is formed by a sequence of consecutive lines which each +have elastic tabs and all have the same leading-space, and +the corresponding elastic tabs are adjusted so that the +following text has the same horizontal position on each line. + +One consequence of these rules is that every elastic table cell +in the first column must have an entry, to avoid ending the +table. Other columns can be empty (which happens when there are +consecutive elastic tabs)." + :init-value nil :lighter nil :global nil + (if elastic-table-mode + (elastic-tools-add-handler 'elastic-table-do-region 90) + (progn + (elastic-tools-remove-handler 'elastic-table-do-region)) + (elastic-table-clear-buffer))) + +(cl-defstruct elastic-table rows (num-cols 0) (max-widths [])) +(cl-defstruct elastic-table-cell start end width) + +;; WARNING: under certain circumstances, these rules imply that line-trailing +;; whitespace is significant. To some extent, this is unavoidable, because you +;; want the elastic table to look right *as you're typing it*, including having the +;; cursor show up in the right place right after you enter a tab char. But +;; another case is where an elastic table is held together by a line whose only elastic tab +;; is at the end of the line. It's probably bad style to do that, but we don't +;; want to forbid it either, because it would require an ad hoc exception to the +;; above rules making this code harder to implement correctly and maintain. + +;; The rows of a elastic table are its lines, and the cells of each row are the strings +;; separated by tabs, with enough implicit empty cells in each row to make the +;; number of columns consistent for the whole elastic table. + +(defconst non-elastic-table-line-regexp + (rx bol + (* blank) + (? (group (not (any blank "\n")) ; after first printing char... + (* (not (any "\t\n"))))) ; any tab would be a elastic-table tab + eol)) + +(defconst elastic-table-line-regexp + (rx bol + (* blank) + (not (any blank "\n")) + (* (not (any "\t\n"))) + "\t")) + +(defconst elastic-table-leading-space-regexp + ;; this always matches + (rx (* "\t") (* (group (+ "\s") (+ "\t"))))) + +(defun elastic-table-leading-space-string (pos) + (save-excursion + (goto-char pos) + (looking-at elastic-table-leading-space-regexp) + (match-string-no-properties 0))) + +(defun elastic-table-do (start) + "Update alignment of the elastic table starting at START. +Do this by parsing and propertizing the elastic table. We assume START +is correct." + (save-excursion + (goto-char start) + (let* ((leading-space (elastic-table-leading-space-string (point))) + (leading-space-len (length leading-space)) + (the-table (make-elastic-table))) + (while (and (not (eobp)) + (equal leading-space (elastic-table-leading-space-string (point))) + (looking-at elastic-table-line-regexp)) + (forward-char leading-space-len) + (elastic-table-add-row the-table (point)) + (forward-line)) + ;; note that rows are in reverse order, currently this shouldn't matter + (elastic-table-propertize the-table) + (point)))) + +(defun elastic-table-add-row (the-table pos) + "Scan a row and add it to THE-TABLE. +Assuming POS is at end of leading-space." + (save-excursion + (goto-char pos) + (let ((line-end (line-end-position)) + (old-num-cols (elastic-table-num-cols the-table)) + cells len) + (while (< (point) line-end) + (looking-at "[^\t\n]*") + (push (make-elastic-table-cell + :start (point) + :end (match-end 0) + :width (elastic-tools-text-pixel-width (point) (match-end 0))) + cells) + (goto-char (match-end 0)) + (unless (eobp) (forward-char))) + (setq len (length cells)) + (setq cells (nreverse cells)) + ;; add more columns to the elastic-table if needed + (when (< old-num-cols len) + (setf (elastic-table-max-widths the-table) + (cl-concatenate 'vector + (elastic-table-max-widths the-table) + (make-vector (- len old-num-cols) 0))) + (setf (elastic-table-num-cols the-table) len)) + ;; update the column widths + (cl-loop for i below (elastic-table-num-cols the-table) + for cell in cells + when (< (aref (elastic-table-max-widths the-table) i) + (elastic-table-cell-width cell)) + do (setf (aref (elastic-table-max-widths the-table) i) + (elastic-table-cell-width cell))) + ;; add the row + (push cells (elastic-table-rows the-table))))) + +(defface elastic-table-column-separator-face '((t)) + "Face of column separators in an elastic-table.") + +(defun elastic-table-cursor-sensor (_window _pos action) + "Cursor sensor function for `elastic-table-mode'. +This defun is added to the cursor-sensor-functions properties of +elastic-table separators. Depending on ACTION an elastic-table +separator, show or hide the separator boundaries by changing face +attributes." + (if (eq action 'entered) + (face-spec-set 'elastic-table-column-separator-face '((t (:box (:line-width (-1 . 0)))))) + (face-spec-set 'elastic-table-column-separator-face '((t ))))) + +(defun elastic-table-propertize (the-table) + (let ((min-col-sep (or elastic-table-column-minimum-margin + (frame-char-width)))) + (dolist (row (elastic-table-rows the-table)) + (cl-loop + for cell in row + for col from 0 + for pos = (elastic-table-cell-end cell) + ;; avoid propertizing newline after last cell + when (equal (char-after pos) ?\t) + do (progn + (add-text-properties + pos (1+ pos) + (list 'display + (list 'space :width + (list (- (+ (aref (elastic-table-max-widths the-table) col) + min-col-sep) + (elastic-table-cell-width cell)))) + 'font-lock-face 'elastic-table-column-separator-face + 'cursor-sensor-functions (list 'elastic-table-cursor-sensor) + 'elastic-table-adjusted t))))))) + +;; return start of a non-elastic-table line entirely before pos, if possible, or +;; beginning of buffer otherwise. we need to see a non-elastic-table line to be safe in +;; case of changes on a line that affect a elastic-table which began earlier and used to +;; include this line but now doesn't. +(defun elastic-table-find-safe-start (pos) + "Return start of a non-elastic-table line entirely before POS. +If such a like does not exist, return the beginning of the +buffer." + (save-excursion + (goto-char pos) + (beginning-of-line) + (or (re-search-backward non-elastic-table-line-regexp nil t) + (point-min)))) + +(defun elastic-table-find-safe-end (pos) + "Return end of a non-elastic-table line entirely after POS, or end of buffer." + (save-excursion + (goto-char pos) + (forward-line) + (or (re-search-forward non-elastic-table-line-regexp nil t) + (point-max)))) + +(defun elastic-table-do-region (_ start end) + "Update alignment of all elastic-tables intersecting in the given region. +The region is between START and END in current buffer." + (let ((start (elastic-table-find-safe-start start)) + (end (elastic-table-find-safe-end end))) + (elastic-table-clear-region start end) + (goto-char start) + (while (re-search-forward elastic-table-line-regexp end :move-to-end) + (beginning-of-line) + (goto-char (elastic-table-do (point)))))) + +(defun elastic-table-clear-region (start end) + (elastic-tools-clear-region-properties + start end 'elastic-table-adjusted '(elastic-table-adjusted display))) + +(defun elastic-table-clear-buffer () + (elastic-table-clear-region (point-min) (point-max))) + +(provide 'elastic-table) +;;; elastic-table.el ends here diff --git a/emacs/site-lisp/elastic-tools.el b/emacs/site-lisp/elastic-tools.el new file mode 100644 index 0000000..c010766 --- /dev/null +++ b/emacs/site-lisp/elastic-tools.el @@ -0,0 +1,223 @@ +;; elastic-tools --- tools for variable-pitch fonts. -*- lexical-binding: t; -*- +;; Copyright (C) 2023 Jean-Philippe Bernardy + +;; 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: + +;;; This file provides tools for elastic-indent and elastic-table + +(require 'dash) +(require 'cl-lib) + +;;; Code: + +(defgroup elastic nil "Customization of elastic spacing (helps alignment in presence of proportional fonts)." + :group 'programming :group 'convenience) + +(defvar-local elastic-tools-handlers nil + "Alist mapping handler function symbols to a depth.") + +(defvar-local elastic-tools-deleted-newline nil + "Have we just deleted a newline character?") + +(defun elastic-tools-add-handler (handler depth) + "Register HANDLER at given DEPTH. +Lower DEPTH means executed first." + (setf (alist-get handler elastic-tools-handlers) depth) + (setq elastic-tools-handlers (-sort (-on #'< #'cdr) elastic-tools-handlers)) + (add-hook 'text-scale-mode-hook #'elastic-tools-queue-buffer t) + (add-hook 'post-command-hook #'elastic-tools-handle-queue nil t) + (add-hook 'before-change-functions #'elastic-tools-before-change-function nil t) + (add-hook 'after-change-functions #'elastic-tools-after-change-function nil t) + ;; Queue handling the buffer so it's taken care of by the new + ;; handler. Note that when activating the modes (e.g. upon buffer + ;; creation, with this method, the buffer will be handled just + ;; once, and zero times if the buffer is not active at the end of + ;; the command. For instance, org-babel native fontification will + ;; create a temporary buffer that is never active, and therefore + ;; will not be handled. This is a good thing, because org-babel + ;; creates such a buffer at each keystroke, and handling it all + ;; every time is very slow. + (elastic-tools-queue-buffer)) + +(defun elastic-tools-remove-handler (handler) + "Unregister HANDLER." + (setq elastic-tools-handlers (assq-delete-all handler elastic-tools-handlers)) + (unless elastic-tools-handlers + (remove-hook 'text-scale-mode-hook #'elastic-tools-queue-buffer) + (remove-hook 'post-command-hook #'elastic-tools-handle-queue) + (remove-hook 'before-change-functions #'elastic-tools-before-change-function t) + (remove-hook 'after-change-functions #'elastic-tools-after-change-function t))) + +(defmacro elastic-tools-with-suitable-window (&rest body) + "Execute BODY in a context where current buffer as a window." + (declare (indent 0)) + (let ((temp-frame-symb (make-symbol "temp-frame")) + (window-symb (make-symbol "window"))) + `(let* ((,window-symb (get-buffer-window nil t)) + (,temp-frame-symb + (if ,window-symb + nil + ;; the new frame will display the current buffer by default + (make-frame '((visibility . nil)))))) + (unwind-protect + ;; using ‘with-selected-window’ is probably inefficient for + ;; our purposes, could rewrite to say explicitly exactly + ;; what really needs restoration + (with-selected-window + (or ,window-symb + (frame-selected-window ,temp-frame-symb)) + (progn ,@body)) + (when ,temp-frame-symb + (delete-frame ,temp-frame-symb)))))) + +(defun elastic-tools-before-change-function (start end) + "Queue a call to `elastic-tools-do-region' for START and END." + (setq elastic-tools-deleted-newline + (save-excursion + (goto-char start) + (and (search-forward "\n" end t) + t))) ; forget the actual position (for tidyness) + ;; (message "etbcf: %s %s-%s" elastic-tools-deleted-newline start end) + ) + +(defvar-local elastic-tools-queue nil + "Queue of changes to handle. +We need queueing because some commands (for instance +`fill-paragraph') will cause many changes, which may individually +propagate down the buffer. Doing all this work many times can +cause visible slowdowns.") + +(defun elastic-tools-push (task hook) + "Push TASK in the queue for HOOK." + (push task (alist-get hook elastic-tools-queue))) + +(defun elastic-tools-after-change-function (start end _len) + "Queue a change between START and END to be handled by `elastic-tools-handlers'." + ;; (message "etacf: %s %s-%s" elastic-tools-deleted-newline start end) + (elastic-tools-push (list elastic-tools-deleted-newline (copy-marker start) (copy-marker end t)) + (car (car elastic-tools-handlers)))) + +(defmacro elastic-tools-with-context (&rest body) + "Run BODY in a context which is suitable for applying our adjustments." + (declare (indent 0)) + `(save-match-data ; just in case + (elastic-tools-with-suitable-window ; we need a window to compute the character widths. + (save-excursion + (without-restriction ; because changes may propagate beyond the restriction. + (with-silent-modifications + ,@body)))))) + + +(defun elastic-tools-do-buffer () + "Call each `elastic-tools-handlers' on the whole buffer." + (interactive) + (elastic-tools-with-context + (dolist (hook (-map #'car elastic-tools-handlers)) + (funcall hook t (point-min) (point-max))))) + + +(defun elastic-tools-queue-buffer () + "Queue handling the whole buffer." + (elastic-tools-after-change-function (point-min) (point-max) nil)) + +(defun elastic-tools-handle-queue () + "Take care of intervals in queue. +If input comes before the work can be finished, then stop and +continue the work later, when idle." + (let ((hooks (-map #'car elastic-tools-handlers))) + (while hooks + (let ((hook (pop hooks))) + ;; (message "elastic-tools: dealing with %s q=%s" hook (alist-get hook elastic-tools-queue)) + (setf (alist-get hook elastic-tools-queue) + (--sort (or (< (cadr it) (cadr other)) (car it)) (alist-get hook elastic-tools-queue))) + (elastic-tools-with-context + (goto-char (point-min)) + (while-no-input ; see post-command-hook documentation. + (while (alist-get hook elastic-tools-queue) + (pcase (car (alist-get hook elastic-tools-queue)) + (`(,force-propagate ,start ,end) + (when (> end (point)) ; otherwise the change has already been taken care of. + (let ((actual-start (max (point) start))) ; portion before point was already done. + (funcall hook force-propagate actual-start end) + ;; (message "elastic-tools: running %s %s %s %s" hook force-propagate actual-start end) + (when hooks + ;; next layer needs to deal with the change. + (elastic-tools-push (list t actual-start (copy-marker (max end (point)))) + (car hooks))))))) + ;; pop only when we're done so we don't forget something + (pop (alist-get hook elastic-tools-queue)))) + (when (alist-get hook elastic-tools-queue) + ;; input came: we continue later. + (setq hooks nil) ; stop the outer loop + (run-with-idle-timer 0.2 nil #'elastic-tools-handle-queue))))))) + +(defun elastic-tools-clear-region-properties (start end cue-prop props-to-remove) + "Clear PROPS-TO-REMOVE text properties in given region. +The region is the part between START and END which also has the +text property CUE-PROP be t." + (with-silent-modifications + (cl-do ((pos1 start) pos2) (nil) + (setq pos1 (text-property-any pos1 end cue-prop t)) + (unless pos1 (cl-return)) + (setq pos2 (or (next-single-property-change pos1 cue-prop nil end) + end)) + (remove-list-of-text-properties pos1 pos2 props-to-remove) + (setq pos1 pos2)))) + + +(defun elastic-tools-on-col-2 (pos) + "Is POS on 2nd column?" + (save-excursion + (goto-char pos) + (and (not (bolp)) + (progn (forward-char -1) + (bolp))))) + +(defun elastic-tools-text-pixel-width (start end) + "Return the pixel width of text between START and END in current buffer." + (let ((c (car (window-text-pixel-size nil start end)))) + (if (> c 2) c ;; Emacs bug: sometimes the returned window-text-pixel-size is negative. In this case computing it indirectly like below seems to fix the issue. + (- (car (window-text-pixel-size nil (1- start) end)) + (car (window-text-pixel-size nil (1- start) start)))))) + +(defun elastic-tools-char-pixel-width (pos) + "Return the pixel width of char at POS." + (if-let (p (get-text-property pos 'elastindent-width)) + p + ;; Emacs bug: sometimes the returned window-text-pixel-size is + ;; wrong. In this case computing it indirectly like below + ;; seems to fix the issue. + (let ((c (car (window-text-pixel-size nil pos (1+ pos))))) + (if (or (<= c 1) ; suspicious + (elastic-tools-on-col-2 pos)) ; emacs is often wrong on that column, for some reason. + (- (car (window-text-pixel-size nil (1- pos) (1+ pos))) + (car (window-text-pixel-size nil (1- pos) pos))) + c)))) + + +(defun elastic-tools-show-char-pixel-width (pos) + "Display pixel width of region char at POS. +This is a debug utility for `elastindent-mode'" + (interactive "d") + (message "pixel width of region: %s, raw=%s, disp=%s, prop=%s" + (elastic-tools-char-pixel-width pos) + (car (window-text-pixel-size nil pos (1+ pos))) + (get-char-property pos 'elastindent-width) + (get-char-property pos 'display))) + + +(provide 'elastic-tools) +;;; elastic-tools.el ends here diff --git a/emacs/site-lisp/fixed-pitch.el b/emacs/site-lisp/fixed-pitch.el new file mode 100644 index 0000000..411a547 --- /dev/null +++ b/emacs/site-lisp/fixed-pitch.el @@ -0,0 +1,53 @@ +;;; fixed-pitch.el --- Use fixed-pitch only in sensible buffers -*- lexical-binding: t; -*- + +;; Copyright (C) 2020, Carl Steib +;; Author: Carl Steib +;; URL: https://github.com/cstby/fixed-pitch +;; Version: 0.0.0 +;; Package-Requires: ((emacs "27.1")) + +;; 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/>. + +;; This file is not part of Emacs. + +;;; Commentary: + +;; Provides a minor mode for using the fixed-pitch face. Allows users to use a +;; variable-pitch font as the default while still using fixed-pitch for code. + +;;; Code: + +(defun fixed-pitch-update-hooks (list) + "Adds `fixed-pitch-mode' to every hook in LIST." + (dolist (hook list) + (add-hook hook 'fixed-pitch-mode))) + +(defcustom fixed-pitch-whitelist-hooks '() + "List of hooks that should activate `fixed-pitch-mode'." + :type '(repeat symbol) + :group 'fixed-pitch + :set (lambda (var val) + (set-default var val) + (fixed-pitch-update-hooks val))) + +;;;###autoload +(define-minor-mode fixed-pitch-mode + "Use monospace typeface in the appropriate context." + :lighter " fxd" + (if fixed-pitch-mode + (progn (buffer-face-set 'fixed-pitch)) + (buffer-face-set))) + +(provide 'fixed-pitch) +;;; fixed-pitch.el ends here diff --git a/emacs/site-lisp/tubthumping-theme.el b/emacs/site-lisp/tubthumping-theme.el new file mode 100644 index 0000000..6ad0ecd --- /dev/null +++ b/emacs/site-lisp/tubthumping-theme.el @@ -0,0 +1,310 @@ +;;; tubthumping-theme.el --- Monochrome theme -*- lexical-binding: t; -*- + +;; By noa, <noa@gaiwan.org> +;; +;; Version: 1.0.2 +;; Author: noa, <noa@gaiwan.org> +;; URL: https://noa.pub/404 + +;; This file is not part of Emacs. + +;;; Commentary: + +;; This is a monochrome theme for emacs. I've only themed packages i've used as i've come across colours in them. + +;; The name is an homage to the classic song, as well as to the monochrome emacs tao theme. + +;;; Code: + +(deftheme tubthumping) + +(defgroup tubthumping-theme nil + "Customization options for the tubthumping theme family." + :group 'tubthumping + :group 'faces) + +(defcustom tubthumping-bg "#ffffff" + "The background colour for the tubthumping theme." + :type 'color + :group 'tubthumping-theme) + +(defcustom tubthumping-fg "#000000" + "The foreground colour for the tubthumping theme." + :type 'color + :group 'tubthumping-theme) + +(defcustom tubthumping-hl "#cdcdcd" + "The alternative background colour for highlighted elements in the tubthumping theme." + :type 'color + :group 'tubthumping-theme) + +(custom-theme-set-faces + 'tubthumping + `(default ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(fringe ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(region ((t (:background ,tubthumping-hl :foreground ,tubthumping-fg)))) + `(cursor ((t (:background ,tubthumping-fg)))) + `(highlight ((t (:background "#ff0000" :foreground ,tubthumping-fg)))) + + ;; default font lock. make comments and strings italic and everything else look the same + `(font-lock-bracket-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-builtin-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-comment-delimiter-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(font-lock-comment-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(font-lock-constant-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-delimiter-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-doc-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(font-lock-doc-markup-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-escape-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-function-call-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-function-name-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-keyword-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-misc-punctuation-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-negation-char-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-number-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-operator-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-preprocessor-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-property-name-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-property-use-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-punctuation-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-regexp-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-regexp-grouping-backslash ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-regexp-grouping-construct ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-string-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(font-lock-type-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-variable-name-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-variable-use-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(font-lock-warning-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + `(show-paren-match ((t (:background ,tubthumping-hl :foreground ,tubthumping-fg)))) + `(show-paren-mismatch ((t (:background ,tubthumping-fg :foreground ,tubthumping-bg)))) + + + `(isearch ((t (:background ,tubthumping-fg :foreground ,tubthumping-bg)))) + `(lazy-highlight ((t (:background ,tubthumping-hl :foreground ,tubthumping-fg)))) + + ;; replace + `(match ((t (:background ,tubthumping-hl :foreground ,tubthumping-fg)))) + + ;; faces + `(shadow ((t (:strikethrough t)))) + + ;; minibuffer + `(minibuffer-prompt ((t (:weight bold :background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(minibuffer-depth-indicator ((t (:weight bold :background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; link + `(link ((t (:underline t)))) + + ;; `(header-line ((t (:underline (:position t))))) + ;; `(header-line ((t (:box (:line-width (0 . 1)))))) + + ;; MODES + + ;; calendar + ;; `(holiday ((t (:box t)))) + `(holiday ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(calendar-today ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + + ;; compile + `(compilation-line-number ((t (:underline t :background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(compilation-column-number ((t (:underline t :background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(compilation-info ((t (:underline t :background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; completions + `(completions-common-part ((t ( :weight bold)))) + `(completions-annotations ((t ( :slant italic)))) + + ;; consult + `(consult-line-number-prefix ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + + ;; custom + `(custom-group-tag ((t (:weight bold :height 1.2)))) + `(custom-variable-tag ((t (:weight bold)))) + `(custom-state ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(custom-visibility ((t (:underline t)))) + `(custom-button ((t (:inherit link)))) + `(custom-button ((t (:box t)))) + + ;; diary + `(diary ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + + ;; dired + `(dired-flagged ((t (:strikethrough t)))) + `(dired-mark ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(dired-marked ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(dired-header ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(dired-set-id ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(dired-ignored ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(dired-special ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(dired-symlink ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(dired-warning ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(dired-directory ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(dired-perm-write ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(dired-broken-symlink ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; elastic indent + `(elastic-indent ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; embark + `(embark-keybinding ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + + ;; eshell + `(eshell-prompt ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-backup ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-archive ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-clutter ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-missing ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-product ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-special ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-symlink ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-readonly ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-directory ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-executable ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eshell-ls-unreadable ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; eww + `(eww-valid-certificate ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(eww-invalid-certificate ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(eww-form-submit ((t (:underline t :background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(eww-form-text ((t (:box t)))) + + ;; dictionary + `(dictionary-reference-face ((t (:underline t :background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(dictionary-word-definition-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; gnus + `(gnus-header-name ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(gnus-header-content ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(gnus-header-from ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(gnus-header-subject ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; howm + `(howm-mode-keyword-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(howm-mode-title-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(howm-reminder-schedule-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(howm-view-empty-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(howm-view-hilit-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(howm-view-name-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + + ;; deft + `(deft-summary-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; help + `(help-argument-name ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(help-key-binding ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + + ;; info + `(info-header-node ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(info-menu-star ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(info-node ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(Info-quoted ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(info-xref-visited ((t (:underline t :background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; jabber + `(jabber-activity-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(jabber-activity-personal-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(jabber-chat-prompt-local ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(jabber-chat-prompt-foreign ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(jabber-chat-prompt-system ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(jabber-rare-time-face ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(jabber-roster-user-online ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(jabber-roster-user-away ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; line number + `(line-number ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + + ;; marginalia + `(marginalia-archive ((t (:foreground ,tubthumping-fg)))) + `(marginalia-char ((t (:foreground ,tubthumping-fg)))) + `(marginalia-date ((t (:foreground ,tubthumping-fg)))) + `(marginalia-documentation ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-name ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-owner ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-priv-dir ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-priv-exec ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-priv-link ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-priv-no ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-priv-other ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-priv-rare ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-priv-read ((t (:foreground ,tubthumping-fg)))) + `(marginalia-file-priv-write ((t (:foreground ,tubthumping-fg)))) + `(marginalia-function ((t (:foreground ,tubthumping-fg)))) + `(marginalia-installed ((t (:foreground ,tubthumping-fg)))) + `(marginalia-key ((t (:foreground ,tubthumping-fg)))) + `(marginalia-lighter ((t (:foreground ,tubthumping-fg)))) + `(marginalia-list ((t (:foreground ,tubthumping-fg)))) + `(marginalia-mode ((t (:foreground ,tubthumping-fg)))) + `(marginalia-modified ((t (:foreground ,tubthumping-fg)))) + `(marginalia-null ((t (:foreground ,tubthumping-fg)))) + `(marginalia-number ((t (:foreground ,tubthumping-fg)))) + `(marginalia-off ((t (:foreground ,tubthumping-fg)))) + `(marginalia-on ((t (:foreground ,tubthumping-fg)))) + `(marginalia-size ((t (:foreground ,tubthumping-fg)))) + `(marginalia-string ((t (:foreground ,tubthumping-fg)))) + `(marginalia-symbol ((t (:foreground ,tubthumping-fg)))) + `(marginalia-true ((t (:foreground ,tubthumping-fg)))) + `(marginalia-type ((t (:foreground ,tubthumping-fg)))) + `(marginalia-version ((t (:foreground ,tubthumping-fg)))) + + ;; message + `(message-cited-text-1 ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-cited-text-2 ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-cited-text-3 ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-cited-text-4 ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-header-name ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-header-to ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-header-cc ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-header-other ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-header-subject ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-header-xheader ((t (:underline t :background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(message-separator ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; orderless + `(orderless-match-face-0 ((t (:background ,tubthumping-hl :foreground ,tubthumping-fg)))) + `(orderless-match-face-1 ((t (:background ,tubthumping-hl :foreground ,tubthumping-fg)))) + `(orderless-match-face-2 ((t (:background ,tubthumping-hl :foreground ,tubthumping-fg)))) + `(orderless-match-face-3 ((t (:background ,tubthumping-hl :foreground ,tubthumping-fg)))) + + ;; markdown + `(markdown-markup-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; rmail + `(rmail-highlight ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; tab bar + ;; `(tab-bar ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + ;; `(tab-bar ((t (:underline (:position t))))) + + ;; variable pitch + `(variable-pitch ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(variable-pitch-text ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; vertico + `(vertico-current ((t (:background ,tubthumping-hl :foreground ,tubthumping-fg)))) + `(vertico-group-title ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + + ;; widgets + `(widget-field ((t ( :box t)))) + `(widget-inactive ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; window divider + ;; `(window-divider ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + + ;; `(ffap ((t (:foreground ,tubthumping-foreground-colour)))) + + `(warning ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(ac-completion-face ((t (:underline t )))) + `(info-quoted-name ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(info-string ((t (:weight bold :foreground ,tubthumping-fg :background ,tubthumping-bg)))) + `(icompletep-determined ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(slime-repl-inputed-output-face ((t (:background ,tubthumping-bg :foreground ,tubthumping-fg)))) + `(trailing-whitespace ((t (:inherit highlight))))) + +;;;###autoload +(when load-file-name + (add-to-list 'custom-theme-load-path + (file-name-as-directory (file-name-directory load-file-name)))) + +(provide-theme 'tubthumping) +;;; tubthumping-theme.el ends here |