prism.el (62560B)
1 ;;; prism.el --- Customizable, depth-based syntax coloring -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2019 Adam Porter 4 5 ;; Author: Adam Porter <adam@alphapapa.net> 6 ;; URL: https://github.com/alphapapa/prism.el 7 ;; Version: 0.3.2 8 ;; Package-Requires: ((emacs "26.1") (dash "2.14.1")) 9 ;; Keywords: faces lisp 10 11 ;;; License: 12 13 ;; This program is free software; you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation, either version 3 of the License, or 16 ;; (at your option) any later version. 17 18 ;; This program is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 25 26 ;;; Commentary: 27 28 ;; `prism' disperses Lisp forms (and other syntax bounded by 29 ;; parentheses, brackets, and braces) into a spectrum of color by 30 ;; depth. It's similar to `rainbow-blocks', but it respects existing 31 ;; non-color face properties, and allows flexible configuration of 32 ;; faces and colors. It also optionally colorizes strings and/or 33 ;; comments by code depth in a similar, customizable way. 34 35 ;; Usage: 36 37 ;; 1. Run the appropriate command for the current buffer: 38 39 ;; - For Lisp and C-like languages, use `prism-mode'. 40 41 ;; - For significant-whitespace languages like Python, or ones whose 42 ;; depth is not always indicated by parenthetical characters, like 43 ;; shell, use `prism-whitespace-mode' instead. 44 45 ;; 2. Enjoy. 46 47 ;; When a theme is loaded or disabled, colors are automatically 48 ;; updated. 49 50 ;; To customize, see the `prism' customization group, e.g. by using 51 ;; "M-x customize-group RET prism RET". For example, by default, 52 ;; comments and strings are colorized according to depth, similarly to 53 ;; code, but this can be disabled. 54 55 ;; Advanced: 56 57 ;; More advanced customization of faces is done by calling 58 ;; `prism-set-colors', which can override the default settings and 59 ;; perform additional color manipulations. The primary argument is 60 ;; COLORS, which should be a list of colors, each of which may be a 61 ;; name, a hex RGB string, or a face name (of which the foreground 62 ;; color is used). Note that the list of colors need not be as long 63 ;; as the number of faces that's actually set (e.g. the default is 16 64 ;; faces), because the colors are automatically repeated and adjusted 65 ;; as necessary. 66 67 ;; If `prism-set-colors' is called with the SAVE argument, the results 68 ;; are saved to customization options so that `prism-mode' will use 69 ;; those colors by default. 70 71 ;; Here's an example that the author finds pleasant: 72 73 ;; (prism-set-colors :num 16 74 ;; :desaturations (cl-loop for i from 0 below 16 75 ;; collect (* i 2.5)) 76 ;; :lightens (cl-loop for i from 0 below 16 77 ;; collect (* i 2.5)) 78 ;; :colors (list "sandy brown" "dodgerblue" "medium sea green") 79 ;; 80 ;; :comments-fn 81 ;; (lambda (color) 82 ;; (prism-blend color 83 ;; (face-attribute 'font-lock-comment-face :foreground) 0.25)) 84 ;; 85 ;; :strings-fn 86 ;; (lambda (color) 87 ;; (prism-blend color "white" 0.5))) 88 89 ;;; Code: 90 91 ;;;; Requirements 92 93 (require 'cl-lib) 94 (require 'color) 95 (require 'face-remap) 96 (require 'thingatpt) 97 (require 'subr-x) 98 99 (require 'dash) 100 101 ;;;; Variables 102 103 (defvar prism-faces nil 104 "Alist mapping depth levels to faces.") 105 106 (defvar prism-faces-comments nil 107 "Alist mapping depth levels to string faces.") 108 109 (defvar prism-faces-strings nil 110 "Alist mapping depth levels to string faces.") 111 112 (defvar prism-faces-parens nil 113 "Alist mapping depth levels to parens faces.") 114 115 (defvar prism-face nil 116 "Set by `prism-match' during fontification.") 117 118 (defvar-local prism-syntax-table nil 119 "Syntax table used by `prism-mode'. 120 Set automatically.") 121 122 (defvar-local prism-whitespace-indent-offset 4 123 "Number of spaces which represents a semantic level of indentation. 124 Set automatically by `prism-whitespace-mode'. Should be set 125 appropriately for the current mode, e.g. `python-indent-offset' 126 for `python-mode'.") 127 128 ;; Defined as custom variables later in the file, but declared here to 129 ;; silence the byte-compiler, because they're used in `prism-set-colors', 130 ;; which is defined before their defcustoms. It's circular, but this 131 ;; breaks the loop. 132 (defvar prism-colors) 133 (defvar prism-color-attribute) 134 (defvar prism-color-distance) 135 (defvar prism-desaturations) 136 (defvar prism-lightens) 137 (defvar prism-num-faces) 138 (defvar prism-comments-fn) 139 (defvar prism-comments) 140 (defvar prism-parens) 141 (defvar prism-parens-fn) 142 (defvar prism-strings-fn) 143 (defvar prism-strings) 144 (defvar prism-whitespace-mode-indents) 145 146 ;;;; Macros 147 148 (defmacro prism-extrapolate (start times length form) 149 "Return list of numbers extrapolated from FORM. 150 Starting from number START, repeating below TIMES, collect the 151 value of FORM. Each iteration, `i' is bound to the iteration 152 number (the incremented value of START), and `c' is bound to the 153 number of the current cycle through LENGTH, starting at 1. 154 155 For example, this form: 156 157 (prism-extrapolate 0 24 3 (* c 3)) 158 159 Evaluates to: 160 161 (3 3 3 6 6 6 9 9 9 12 12 12 15 15 15 18 18 18 21 21 21 24 24 24) 162 163 Intended for use as the DESATURATIONS and LIGHTENS arguments to 164 `prism-set-colors'." 165 `(cl-loop with c = 1 with reset = 1 166 for i from ,start below ,times 167 collect ,form 168 do (if (= reset ,length) 169 (setf reset 1 170 c (1+ c)) 171 (cl-incf reset)))) 172 173 ;; NOTE: Since this will likely be useful in the future, I'm leaving it in, commented. 174 175 ;; (cl-defmacro prism-debug (&rest args) 176 ;; "Display a debug warning showing the runtime value of ARGS. 177 ;; The warning automatically includes the name of the containing 178 ;; function, and it is only displayed if `warning-minimum-log-level' 179 ;; is `:debug' at runtime (which avoids formatting messages that 180 ;; won't be shown). 181 ;; 182 ;; Each of ARGS may be a string, which is displayed as-is, or a 183 ;; symbol, the value of which is displayed prefixed by its name, or 184 ;; a Lisp form, which is displayed prefixed by its first symbol. 185 ;; 186 ;; Before the actual ARGS arguments, you can write keyword 187 ;; arguments, i.e. alternating keywords and values. The following 188 ;; keywords are supported: 189 ;; 190 ;; :buffer BUFFER Name of buffer to pass to `display-warning'. 191 ;; :level LEVEL Level passed to `display-warning', which see. 192 ;; Default is :debug." 193 ;; (pcase-let* ((fn-name (with-current-buffer 194 ;; (or byte-compile-current-buffer (current-buffer)) 195 ;; ;; This is a hack, but a nifty one. 196 ;; (save-excursion 197 ;; (beginning-of-defun) 198 ;; (cl-second (read (current-buffer)))))) 199 ;; (plist-args (cl-loop while (keywordp (car args)) 200 ;; collect (pop args) 201 ;; collect (pop args))) 202 ;; ((map (:buffer buffer) (:level level)) plist-args) 203 ;; (level (or level :debug)) 204 ;; (string (cl-loop for arg in args 205 ;; concat (pcase arg 206 ;; ((pred stringp) "%s ") 207 ;; ((pred symbolp) 208 ;; (concat (upcase (symbol-name arg)) ":%s ")) 209 ;; ((pred listp) 210 ;; (concat "(" (upcase (symbol-name (car arg))) 211 ;; (pcase (length arg) 212 ;; (1 ")") 213 ;; (_ "...)")) 214 ;; ":%s ")))))) 215 ;; `(when (eq :debug warning-minimum-log-level) 216 ;; (display-warning ',fn-name (format ,string ,@args) ,level ,buffer)))) 217 218 ;;;; Minor mode 219 220 (defun prism-active-mode () 221 "Return any already-active `prism' modes in this buffer. 222 There should only ever be one, but the return value is a list of 223 modes." 224 (cl-loop for mode in '(prism-mode prism-whitespace-mode) 225 when (symbol-value mode) 226 collect mode)) 227 228 ;;;###autoload 229 (define-minor-mode prism-mode 230 "Disperse code into a spectrum of colors according to depth. 231 Depth is determined by list nesting. Suitable for Lisp, C-like 232 languages, etc." 233 :global nil 234 (let ((keywords '((prism-match 0 prism-face prepend)))) 235 (if prism-mode 236 (progn 237 (dolist (mode (cl-remove 'prism-mode (prism-active-mode))) 238 ;; Deactivate alternative mode so this one can be enabled. 239 (funcall mode -1)) 240 (unless prism-faces 241 (prism-set-colors)) 242 (setq prism-syntax-table (prism-syntax-table (syntax-table))) 243 (font-lock-add-keywords nil keywords 'append) 244 (font-lock-flush) 245 (add-hook 'font-lock-extend-region-functions #'prism-extend-region nil 'local) 246 (unless (advice-member-p #'prism-after-theme #'load-theme) 247 ;; Don't add the advice again, because this mode is 248 ;; buffer-local, but the advice is global. 249 (advice-add #'load-theme :after #'prism-after-theme) 250 (advice-add #'disable-theme :after #'prism-after-theme))) 251 (font-lock-remove-keywords nil keywords) 252 (prism-remove-faces) 253 (unless (--any (or (buffer-local-value 'prism-mode it) 254 (buffer-local-value 'prism-whitespace-mode it)) 255 (buffer-list)) 256 ;; Don't remove advice if `prism' is still active in any buffers. 257 (advice-remove #'load-theme #'prism-after-theme) 258 (advice-remove #'disable-theme #'prism-after-theme)) 259 (remove-hook 'font-lock-extend-region-functions #'prism-extend-region 'local) 260 (font-lock-flush)))) 261 262 ;;;###autoload 263 (define-minor-mode prism-whitespace-mode 264 "Disperse code into a spectrum of colors according to depth. 265 Depth is determined by indentation and list nesting. Suitable 266 for whitespace-sensitive languages like Python, Haskell, shell, 267 etc." 268 :global nil 269 (let ((keywords '((prism-match-whitespace 0 prism-face prepend)))) 270 (if prism-whitespace-mode 271 (progn 272 (dolist (mode (cl-remove 'prism-whitespace-mode (prism-active-mode))) 273 ;; Deactivate alternative mode so this one can be enabled. 274 (funcall mode -1)) 275 (unless prism-faces 276 (prism-set-colors)) 277 (setf prism-syntax-table (prism-syntax-table (syntax-table)) 278 prism-whitespace-indent-offset (let ((indent (or (alist-get major-mode prism-whitespace-mode-indents) 279 (alist-get t prism-whitespace-mode-indents)))) 280 (cl-etypecase indent 281 (symbol (symbol-value indent)) 282 (integer indent)))) 283 (font-lock-add-keywords nil keywords 'append) 284 (font-lock-flush) 285 (add-hook 'font-lock-extend-region-functions #'prism-extend-region nil 'local) 286 (unless (advice-member-p #'prism-after-theme #'load-theme) 287 ;; Don't add the advice again, because this mode is 288 ;; buffer-local, but the advice is global. 289 (advice-add #'load-theme :after #'prism-after-theme) 290 (advice-add #'disable-theme :after #'prism-after-theme))) 291 (font-lock-remove-keywords nil keywords) 292 (prism-remove-faces) 293 (unless (--any (or (buffer-local-value 'prism-mode it) 294 (buffer-local-value 'prism-whitespace-mode it)) 295 (buffer-list)) 296 ;; Don't remove advice if `prism' is still active in any buffers. 297 (advice-remove #'load-theme #'prism-after-theme) 298 (advice-remove #'disable-theme #'prism-after-theme)) 299 (remove-hook 'font-lock-extend-region-functions #'prism-extend-region 'local) 300 (font-lock-flush)))) 301 302 ;;;; Functions 303 304 (defun prism-after-theme (&rest args) 305 "For `load-theme' advice. 306 ARGS may be what `load-theme' and `disable-theme' expect. Unless 307 NO-ENABLE (optional third argument, like `load-theme') is 308 non-nil, call `prism-set-colors' to update `prism' faces." 309 (unless (cl-third args) 310 (prism-set-colors))) 311 312 ;; Silence byte-compiler for these special variables that are bound 313 ;; around `font-lock-extend-region-functions'. 314 (defvar font-lock-beg) 315 (defvar font-lock-end) 316 317 (defun prism-extend-region () 318 "Extend region to the current sexp. 319 For `font-lock-extend-region-functions'." 320 ;; (prism-debug (current-buffer) (point) font-lock-beg font-lock-end) 321 (let (changed-p) 322 ;; NOTE: It doesn't seem to be necessary to extend the region backward/up, but I'm 323 ;; not completely sure that this is never needed, so I'm leaving it in, commented. 324 ;; (unless (= 0 (nth 0 (syntax-ppss))) 325 ;; ;; Not at top level: extend region backward/up. 326 ;; (let ((orig-pos (point))) 327 ;; (save-excursion 328 ;; (when (ignore-errors 329 ;; (backward-up-list 1 t t)) 330 ;; (setf font-lock-beg (point)) 331 ;; (unless (= font-lock-beg orig-pos) 332 ;; (setf changed-p t)))))) 333 (save-excursion 334 (goto-char font-lock-end) 335 (unless (= 0 (nth 0 (syntax-ppss))) 336 ;; Not at top level: extend region forward. 337 (let ((end (save-excursion 338 (when (ignore-errors 339 (backward-up-list -1 t t)) 340 (point))))) 341 (when (and end (> end font-lock-end)) 342 (setf font-lock-end (1- end) 343 changed-p t) 344 changed-p)))))) 345 346 (defun prism-syntax-table (syntax-table) 347 "Return SYNTAX-TABLE modified for `prism'." 348 ;; Copied from `rainbow-blocks-make-syntax-table'. 349 (let ((table (copy-syntax-table syntax-table))) 350 (modify-syntax-entry ?\( "() " table) 351 (modify-syntax-entry ?\) ")( " table) 352 (modify-syntax-entry ?\[ "(]" table) 353 (modify-syntax-entry ?\] ")[" table) 354 (modify-syntax-entry ?\{ "(}" table) 355 (modify-syntax-entry ?\} "){" table) 356 table)) 357 358 (defun prism-match (limit) 359 "Matcher function for `font-lock-keywords'. 360 Matches up to LIMIT." 361 ;; (prism-debug (current-buffer) (point) limit) 362 (cl-macrolet ((parse-syntax () 363 `(-setq (depth _ _ in-string-p comment-level-p _ _ _ comment-or-string-start) 364 (syntax-ppss))) 365 (comment-p () 366 ;; This macro should only be used after `parse-syntax'. 367 `(or comment-level-p (looking-at-p (rx (syntax comment-start))) 368 ;; Not all language modes' syntax tables seem to allow searching 369 ;; for comment-start, comment-end, or comment-delimiter 370 ;; characters, so we must use ppss to determine whether we're 371 ;; looking at a comment start. And since some languages use 372 ;; multiples of a character to mark a comment start (e.g. "//"), 373 ;; we must also test at 2 characters past the point. And since 374 ;; that position could be past the end of the buffer, we must 375 ;; ignore such an error. 376 (condition-case nil 377 (or (save-excursion 378 (ppss-comment-depth (syntax-ppss (1+ (point))))) 379 (save-excursion 380 (ppss-comment-depth (syntax-ppss (+ 2 (point)))))) 381 (args-out-of-range nil)))) 382 (looking-at-paren-p 383 () `(looking-at-p (rx (or (syntax open-parenthesis) 384 (syntax close-parenthesis))))) 385 (face-at () 386 ;; Return face to apply. Should be called with point at `start'. 387 `(cond ((and prism-parens (looking-at-paren-p)) 388 (alist-get depth prism-faces-parens)) 389 ((comment-p) 390 (pcase depth 391 (0 'font-lock-comment-face) 392 (_ (if prism-faces-comments 393 (alist-get depth prism-faces-comments) 394 (alist-get depth prism-faces))))) 395 ((or in-string-p (looking-at-p (rx (syntax string-quote)))) 396 (pcase depth 397 (0 'font-lock-string-face) 398 (_ (if prism-faces-strings 399 (alist-get depth prism-faces-strings) 400 (alist-get depth prism-faces))))) 401 (t (alist-get depth prism-faces))))) 402 (with-syntax-table prism-syntax-table 403 (catch 'eobp 404 (let ((parse-sexp-ignore-comments t) 405 (starting-pos (point)) 406 depth in-string-p comment-level-p comment-or-string-start start end 407 found-comment-p found-string-p) 408 (while ;; Skip to start of where we should match. 409 (cond ((eobp) 410 ;; Stop matching and return nil if at end-of-buffer. 411 (throw 'eobp nil)) 412 ((eolp) 413 (forward-line 1)) 414 ((looking-at-p (rx blank)) 415 (forward-whitespace 1)) 416 ((unless prism-strings 417 (when (looking-at-p (rx (syntax string-quote))) 418 ;; At a string: skip it. 419 (forward-sexp)))) 420 ((unless prism-comments 421 (forward-comment (buffer-size)))))) 422 (parse-syntax) 423 (when in-string-p 424 ;; In a string: go back to its beginning (before its delimiter). 425 ;; It would be nice to leave this out and rely on the check in 426 ;; the `while' above, but if partial fontification starts inside 427 ;; a string, we have to handle that. 428 ;; NOTE: If a string contains a Lisp comment (e.g. in 429 ;; `custom-save-variables'), `in-string-p' will be non-nil, but 430 ;; `comment-or-string-start' will be nil. I don't know if this 431 ;; is a bug in `parse-partial-sexp', but we have to handle it. 432 (when comment-or-string-start 433 (goto-char comment-or-string-start) 434 (unless prism-strings 435 (forward-sexp)) 436 (parse-syntax))) 437 ;; Set start and end positions. 438 (setf start (point) 439 ;; I don't know if `ignore-errors' is going to be slow, but since 440 ;; `scan-lists' and `scan-sexps' signal errors, it seems necessary if we want 441 ;; to use them (and they seem to be cleaner to use than regexp searches). 442 end (min limit 443 (save-excursion 444 (or (when (looking-at-p (rx (syntax close-parenthesis))) 445 ;; I'd like to just use `scan-lists', but I can't find a way 446 ;; around this initial check. The code (scan-lists start 1 447 ;; 1), when called just inside a list, scans past the end of 448 ;; it, to just outside it, which is not what we want, because 449 ;; we want to highlight the closing paren with the shallower 450 ;; depth. But if we just back up one character, we never 451 ;; exit the list. So we have to check whether we're looking 452 ;; at the close of a list, and if so, move just past it. 453 (cl-decf depth) 454 (1+ start)) 455 (when (and prism-comments (comment-p)) 456 (when comment-or-string-start 457 (goto-char comment-or-string-start)) 458 (forward-comment (buffer-size)) 459 (setf found-comment-p t) 460 (point)) 461 (when (looking-at-p (rx (syntax string-quote))) 462 (if in-string-p 463 ;; At end of string: break out of it. 464 (forward-char 1) 465 ;; At beginning of string: skip it. 466 (condition-case err 467 (forward-sexp 1) 468 (scan-error 469 ;; An unclosed string: move past it. 470 (goto-char (cadddr err))))) 471 ;; TODO: Is it right to set found-string-p in 472 ;; the case of finding an unclosed string? 473 (setf found-string-p t) 474 (point)) 475 (ignore-errors 476 ;; Scan to the past the delimiter of the next deeper list. 477 (scan-lists start 1 -1)) 478 (ignore-errors 479 ;; Scan to the end of the current list delimiter. 480 (1- (scan-lists start 1 1))) 481 ;; If we can't find anything, return `limit'. I'm not sure if 482 ;; this is the correct thing to do, but it avoids an error (and 483 ;; possibly hanging Emacs) in the event of an undiscovered bug. 484 ;; Although, signaling an error might be better, because I have 485 ;; seen "redisplay" errors related to font-lock in the messages 486 ;; buffer before, which might mean that Emacs can handle that. 487 ;; I think the important thing is not to hang Emacs, to always 488 ;; either return nil or advance point to `limit'. 489 limit)) 490 (or (unless (or found-string-p found-comment-p) 491 ;; This additional form is regrettable, but it seems necessary 492 ;; to fix <https://github.com/alphapapa/prism.el/issues/18>. 493 ;; However, there might be a better way to refactor this whole 494 ;; calculation of the END position, so someday that should be 495 ;; tried. (Or maybe just use tree-sitter in Emacs 29+.) 496 (save-excursion 497 (when (re-search-forward (rx (or (syntax string-quote) 498 (syntax comment-start))) 499 (or (ignore-errors 500 (scan-lists (point) 1 1)) 501 limit) 502 t) 503 ;; Found string or comment in current list: stop at beginning of it. 504 (pcase (syntax-after (match-beginning 0)) 505 ('(11) 506 (setf found-comment-p t) 507 (match-beginning 0)) 508 (`(7 . ,_) 509 (setf found-string-p t) 510 (match-beginning 0)))))) 511 limit))) 512 (when (< end start) 513 ;; Set search bound properly when `start' is greater than 514 ;; `end' (i.e. when `start' is moved past `limit', I think). 515 (setf end start)) 516 (when end 517 ;; End found: Try to fontify. 518 (save-excursion 519 (or (unless (or in-string-p found-string-p found-comment-p) 520 ;; Neither in a string nor looking at nor in a 521 ;; comment: set `end' to any comment found before it. 522 (when (re-search-forward (rx (or (seq (not (syntax escape)) (syntax string-quote)) 523 (syntax comment-start))) 524 end t) 525 (unless (equal '(7) (syntax-after (match-beginning 0))) 526 ;; Not in a string: set end to the beginning 527 ;; of the comment (this avoids stopping at 528 ;; comment-starts inside strings). 529 (setf end (match-beginning 0))))) 530 (unless (or found-comment-p found-string-p) 531 ;; Neither in nor looking at a comment: set `end' 532 ;; to any string or comment found before it. 533 (when (re-search-forward (rx (syntax string-quote)) end t) 534 (setf end (match-beginning 0)))))) 535 (when prism-parens 536 (unless (= 1 (- end start)) 537 ;; Not fontifying a single open paren (i.e. we are trying to fontify more 538 ;; than just an open paren): so if we are looking at one, fontify only it. 539 (when (eq 4 (syntax-class (syntax-after (1- end)))) 540 ;; End is past an open paren: back up one character. 541 (cl-decf end)))) 542 (if (and (comment-p) (= 0 depth)) 543 (setf prism-face nil) 544 (setf prism-face (face-at))) 545 (goto-char end) 546 (unless (> (point) start) 547 ;; Prevent end-of-buffer error in `font-lock-fontify-keywords-region'. 548 (cl-decf start)) 549 (set-match-data (list start end (current-buffer))) 550 ;; (prism-debug (current-buffer) "END" start end) 551 ;; Be sure to return non-nil! 552 (unless (> (point) starting-pos) 553 (prism-mode -1) 554 (error "prism: Infinite loop detected in `prism-match' (buffer:%S point:%S). Please report this bug" 555 (current-buffer) (point))) 556 t)))))) 557 558 (defun prism-match-whitespace (limit) 559 "Matcher function for `font-lock-keywords' in whitespace-sensitive buffers. 560 Matches up to LIMIT. Requires `prism-whitespace-indent-offset' be set 561 appropriately, e.g. to `python-indent-offset' for `python-mode'." 562 (cl-macrolet ((parse-syntax () 563 `(-setq (list-depth _ _ in-string-p comment-level-p _ _ _ comment-or-string-start) 564 (syntax-ppss))) 565 (indent-depth () 566 `(or (save-excursion 567 (forward-line -1) 568 (when (looking-at-p (rx (1+ nonl) "\\" eol)) 569 ;; Found backslask-continued line: move 570 ;; to where the continued line starts. 571 (cl-loop do (forward-line -1) 572 while (looking-at-p (rx (1+ nonl) "\\" eol))) 573 (forward-line 1) ; Yes, go back down a line. 574 (/ (current-indentation) prism-whitespace-indent-offset))) 575 (/ (current-indentation) prism-whitespace-indent-offset))) 576 (depth-at () 577 ;; Yes, this is entirely too complicated--just like Python's syntax in 578 ;; comparison to Lisp. But, "Eww, all those parentheses!" they say. 579 ;; Well, all those parentheses avoid lots of special cases like these. 580 `(pcase list-depth 581 (0 (cond ((looking-at-p (rx (syntax close-parenthesis) eol)) 582 (save-excursion 583 (forward-char 1) 584 (backward-sexp 1) 585 (+ (nth 0 (syntax-ppss)) (indent-depth)))) 586 ((looking-back (rx (syntax close-parenthesis)) (1- (point))) 587 (save-excursion 588 (backward-sexp 1) 589 (+ (nth 0 (syntax-ppss)) (indent-depth)))) 590 (t (indent-depth)))) 591 ;; This handles the case of code that is both enclosed in a 592 ;; character-delimited list and indented on a new line within that 593 ;; list to match the list's opening indentation (e.g. in Python, 594 ;; when an if's condition is parenthesized and split across lines). 595 (_ (let* ((current-depth (car (syntax-ppss))) ;; This `syntax-ppss' call *is* necessary! 596 (enclosing-list-depth 597 (pcase current-depth 598 (0 0) 599 (_ (save-excursion 600 ;; Escape current list and return the level of 601 ;; the enclosing list plus its indent depth. 602 603 ;; FIXME: When a preceding comment contains an apostrophe, this 604 ;; call to `scan-lists' interprets the apostrophe as delimiting a 605 ;; list, and it skips back to another preceding apostrophe, even 606 ;; inside a different top-level form, which causes the wrong 607 ;; depth to be calculated. ... Well, good news, I guess: this 608 ;; happens on Emacs 26.3 but not on Emacs 27.1. I guess 609 ;; something was fixed, which means that it's not a bug in Prism. 610 (goto-char (scan-lists (point) -1 current-depth)) 611 (+ (indent-depth) (car (syntax-ppss)))))))) 612 (pcase enclosing-list-depth 613 (0 (+ list-depth (1- (indent-depth)))) 614 (_ (+ enclosing-list-depth list-depth))))))) 615 (comment-p () 616 ;; This macro should only be used after `parse-syntax'. 617 `(or comment-level-p (looking-at-p (rx (or (syntax comment-start) 618 (syntax comment-delimiter)))) 619 ;; Not all language modes' syntax tables seem to allow searching 620 ;; for comment-start, comment-end, or comment-delimiter 621 ;; characters, so we must use ppss to determine whether we're 622 ;; looking at a comment start. And since some languages use 623 ;; multiples of a character to mark a comment start (e.g. "//"), 624 ;; we must also test at 2 characters past the point. And since 625 ;; that position could be past the end of the buffer, we must 626 ;; ignore such an error. 627 (condition-case nil 628 (or (save-excursion 629 (ppss-comment-depth (syntax-ppss (1+ (point))))) 630 (save-excursion 631 (ppss-comment-depth (syntax-ppss (+ 2 (point)))))) 632 (args-out-of-range nil)))) 633 (face-at () 634 ;; Return face to apply. Should be called with point at `start'. 635 `(let ((depth (depth-at))) 636 (cond ((comment-p) 637 (pcase depth 638 (0 'font-lock-comment-face) 639 (_ (if prism-faces-comments 640 (alist-get depth prism-faces-comments) 641 (alist-get depth prism-faces))))) 642 ((or in-string-p (looking-at-p (rx (or (syntax string-quote) 643 (syntax string-delimiter))))) 644 (pcase depth 645 (0 'font-lock-string-face) 646 (_ (if prism-faces-strings 647 (alist-get depth prism-faces-strings) 648 (alist-get depth prism-faces))))) 649 (t (alist-get depth prism-faces)))))) 650 (with-syntax-table prism-syntax-table 651 (unless (eobp) 652 ;; Not at end-of-buffer: start matching. 653 (let ((parse-sexp-ignore-comments t) 654 (starting-pos (point)) 655 list-depth in-string-p comment-level-p comment-or-string-start start end 656 found-comment-p found-string-p) 657 (while ;; Skip to start of where we should match. 658 (and (not (eobp)) 659 (cond ((eolp) 660 (forward-line 1)) 661 ((looking-at-p (rx blank)) 662 (forward-whitespace 1)) 663 ((unless prism-strings 664 (when (looking-at-p (rx (syntax string-quote))) 665 ;; At a string: skip it. 666 (forward-sexp)))) 667 ((unless prism-comments 668 (forward-comment (buffer-size))))))) 669 (parse-syntax) 670 (when in-string-p 671 ;; In a string: go back to its beginning (before its delimiter). 672 ;; It would be nice to leave this out and rely on the check in 673 ;; the `while' above, but if partial fontification starts inside 674 ;; a string, we have to handle that. 675 ;; NOTE: If a string contains a Lisp comment (e.g. in 676 ;; `custom-save-variables'), `in-string-p' will be non-nil, but 677 ;; `comment-or-string-start' will be nil. I don't know if this 678 ;; is a bug in `parse-partial-sexp', but we have to handle it. 679 (when comment-or-string-start 680 (goto-char comment-or-string-start) 681 (unless prism-strings 682 (forward-sexp)) 683 (parse-syntax))) 684 ;; Set start and end positions. 685 (setf start (point) 686 ;; I don't know if `ignore-errors' is going to be slow, but since 687 ;; `scan-lists' and `scan-sexps' signal errors, it seems necessary if we want 688 ;; to use them (and they seem to be cleaner to use than regexp searches). 689 end (min limit 690 (save-excursion 691 (or (when (and prism-comments (comment-p)) 692 (setf found-comment-p t) 693 (when comment-or-string-start 694 (goto-char comment-or-string-start)) 695 ;; We must only skip one comment, because before there is 696 ;; non-comment, non-whitespace text, the indent depth might change. 697 (forward-comment 1) 698 (point)) 699 (when (looking-at-p (rx (syntax close-parenthesis))) 700 ;; I'd like to just use `scan-lists', but I can't find a way around this initial check. 701 ;; The code (scan-lists start 1 1), when called just inside a list, scans past the end 702 ;; of it, to just outside it, which is not what we want, because we want to highlight 703 ;; the closing paren with the shallower depth. But if we just back up one character, 704 ;; we never exit the list. So we have to check whether we're looking at the close of a 705 ;; list, and if so, move just past it. 706 (cl-decf list-depth) 707 (1+ start)) 708 (when (looking-at-p (rx (or (syntax string-quote) 709 (syntax string-delimiter)))) 710 (forward-sexp 1) 711 (setf found-string-p t) 712 (point)) 713 ;; Don't go past the end of the line. 714 (apply #'min 715 (-non-nil 716 (list 717 (or (ignore-errors 718 ;; Scan to the past the delimiter of the next deeper list. 719 (scan-lists start 1 -1)) 720 (ignore-errors 721 ;; Scan to the end of the current list delimiter. 722 (1- (scan-lists start 1 1)))) 723 (line-end-position)))) 724 ;; If we can't find anything, return `limit'. I'm not sure if this is the correct 725 ;; thing to do, but it avoids an error (and possibly hanging Emacs) in the event of 726 ;; an undiscovered bug. Although, signaling an error might be better, because I 727 ;; have seen "redisplay" errors related to font-lock in the messages buffer before, 728 ;; which might mean that Emacs can handle that. I think the important thing is not 729 ;; to hang Emacs, to always either return nil or advance point to `limit'. 730 limit)))) 731 (when (< end start) 732 ;; Set search bound properly when `start' is greater than 733 ;; `end' (i.e. when `start' is moved past `limit', I think). 734 (setf end start)) 735 (when end 736 ;; End found: Try to fontify. 737 (unless (or in-string-p found-string-p found-comment-p) 738 ;; Neither in a string nor looking at nor in a comment. 739 (save-excursion 740 (or (when (re-search-forward (rx (syntax comment-start)) end t) 741 ;; Set `end' to any comment found before it. 742 (setf end (match-beginning 0))) 743 (when (re-search-forward (rx (or (syntax string-quote) 744 (syntax string-delimiter))) 745 end t) 746 ;; Set `end' to any string found before it. 747 (unless (nth 4 (syntax-ppss)) 748 ;; Not in a comment. 749 (setf end (match-beginning 0))))))) 750 (if (and (comment-p) (= 0 (depth-at))) 751 (setf prism-face nil) 752 (setf prism-face (face-at))) 753 (goto-char end) 754 (unless (> (point) start) 755 ;; Prevent end-of-buffer error in `font-lock-fontify-keywords-region'. 756 (cl-decf start)) 757 (set-match-data (list start end (current-buffer))) 758 (unless (> (point) starting-pos) 759 (prism-mode -1) 760 (error "prism: Infinite loop detected in `prism-match-whitespace' (buffer:%S point:%S). Please report this bug" 761 (current-buffer) (point))) 762 ;; Be sure to return non-nil! 763 t)))))) 764 765 (cl-defun prism-remove-faces (&optional (beg (point-min))) 766 "Remove `prism' faces from buffer. 767 Note a minor bug at the moment: anonymous faces are also 768 removed." 769 (cl-macrolet ((without-prism-faces (faces) 770 `(cl-loop for face in ,faces 771 ;; FIXME: This removes anonymous faces. 772 unless (or (not (facep face)) 773 (string-prefix-p "prism-level-" (symbol-name face))) 774 collect face))) 775 (with-silent-modifications 776 (save-excursion 777 (goto-char beg) 778 (cl-loop for end = (or (next-single-property-change (point) 'face) (point-max)) 779 for faces = (get-text-property (point) 'face) 780 when faces 781 do (put-text-property (point) end 'face (without-prism-faces faces)) 782 for next-change = (next-single-property-change (point) 'face) 783 while (and next-change 784 (/= next-change (point-max))) 785 do (goto-char next-change)))))) 786 787 ;;;;; Colors 788 789 (cl-defun prism-set-colors 790 (&key shuffle save local 791 (num prism-num-faces) (colors prism-colors) 792 (attribute prism-color-attribute) 793 (desaturations prism-desaturations) (lightens prism-lightens) 794 (comments-fn (lambda (color) 795 (--> color 796 (color-desaturate-name it 30) 797 (color-lighten-name it -10)))) 798 (strings-fn (lambda (color) 799 (--> color 800 (color-desaturate-name it 20) 801 (color-lighten-name it 10)))) 802 (parens-fn (lambda (color) 803 (prism-blend color (face-attribute 'default :background) 0.5)))) 804 "Set `prism' faces. Call after loading a new theme. 805 Call also when COLORS has been set to a list of faces and those 806 faces have been modified. 807 808 NUM is the number of faces to set, i.e. the depth to make faces 809 for. 810 811 When SAVE is non-nil, save attributes to `prism-' customization 812 options for future use by default. 813 814 When LOCAL is t (interactively, with one universal prefix), remap 815 faces buffer-locally; when `reset' (interactively, with two 816 prefixes), clear local remapping and don't set any faces; when 817 nil (the default), set faces globally. 818 819 COLORS is a list of one or more color name strings (like 820 \"green\" or \"#ff0000\") or face symbols (of which the 821 foreground color is used). 822 823 DESATURATIONS and LIGHTENS are lists of integer percentages 824 applied to colors as depth increases; they need not be as long as 825 NUM, because they are extrapolated automatically. 826 827 COMMENTS-FN, PARENS-FN, and STRINGS-FN are functions of one 828 argument, a color name or hex RGB string, which return the color 829 having been modified as desired for comments, parens, or strings, 830 respectively." 831 (declare (indent defun)) 832 (interactive) 833 (when (called-interactively-p 'any) 834 (setf local (pcase current-prefix-arg 835 ('(16) 'reset) 836 ('(4) t)))) 837 (when shuffle 838 (setf colors (prism-shuffle colors))) 839 ;; MAYBE: Extrapolate desaturations and lightens cleverly, instead 840 ;; of requiring the user to call `prism-extrapolate'. 841 (cl-labels ((faces (colors &optional suffix (fn #'identity)) 842 (setf suffix (if suffix 843 (concat "-" suffix) 844 "")) 845 (cl-loop for i from 0 below num 846 for face = (intern (format "prism-level-%d%s" i suffix)) 847 for color = (funcall fn (nth i colors)) 848 for description = (format "`prism' face%s #%d" suffix i) 849 do (set-face face attribute color description) 850 collect (cons i face))) 851 (set-face (face attribute color description) 852 (pcase local 853 ('nil 854 (when (internal-lisp-face-p face) 855 ;; Delete existing face, important if e.g. changing :foreground to :background. 856 (face-spec-set face nil 'customized-face)) 857 (custom-declare-face face '((t)) description :group 'prism-faces) 858 (set-face-attribute face nil attribute color)) 859 ('reset (reset-face face)) 860 (_ (face-remap-add-relative face (list attribute color))))) 861 (reset-face (face) 862 (--when-let (alist-get face face-remapping-alist) 863 (face-remap-remove-relative (cons (-last-item it) (car (butlast it))))))) 864 (let* ((colors (->> colors 865 (--map (pcase-exhaustive it 866 ((pred facep) (face-attribute it :foreground nil 'default)) 867 ((pred stringp) it) 868 ((pred functionp) (funcall it)) 869 (`(themed ,color) (prism-theme-color color)))) 870 (--remove (string-prefix-p "unspecified-" it)) 871 -cycle 872 (prism-modify-colors :num num 873 :desaturations desaturations 874 :lightens lightens 875 :colors) 876 ;; Use only two digits per component. HTML export of code (e.g. with Org 877 ;; Export, htmlize, etc.) doesn't work well with colors like "#01234567890a", 878 ;; even if Emacs can handle them internally. Maybe it's Web browsers that 879 ;; can't handle them. Anyway, we shouldn't use them if it breaks that. 880 (--map (--> (color-name-to-rgb it) 881 (-let (((r g b) it)) 882 (color-rgb-to-hex r g b 2))))))) 883 (cl-macrolet ((set-vars (&rest pairs) 884 `(progn 885 ,@(cl-loop for (var val) on pairs by #'cddr 886 collect `(pcase local 887 ('nil ;; Set global faces. 888 (set ',var ,val)) 889 ('reset ;; Clear local remappings. 890 ,val) 891 (_ ;; Remap locally. 892 (set (make-local-variable ',var) ,val))))))) 893 (set-vars prism-faces (faces colors) 894 prism-faces-strings (faces colors "strings" strings-fn) 895 prism-faces-comments (faces colors "comments" comments-fn) 896 prism-faces-parens (faces colors "parens" parens-fn))) 897 (when (and save (not local)) 898 ;; Save arguments for later saving as customized variables, 899 ;; including the unmodified (but shuffled) colors. 900 (setf prism-colors colors 901 prism-desaturations desaturations 902 prism-lightens lightens 903 prism-num-faces num 904 prism-comments-fn comments-fn 905 prism-strings-fn strings-fn 906 prism-parens-fn parens-fn) 907 (prism-save-colors))))) 908 909 (defun prism-randomize-colors (&optional arg) 910 "Randomize `prism' colors using themed `font-lock' faces. 911 ARG may be a number (which limits the number of colors used), or 912 a universal prefix (to use all `font-lock' faces), or nil (to use 913 unique colors from `font-lock' faces)." 914 (interactive "P") 915 (cl-labels ((colorize ;; Return color NAME propertized with its foreground as its color. 916 (name) (propertize name 'face (list :foreground name))) 917 (faces ;; Return list of used colors with foreground color face applied. 918 () (->> (face-list) 919 (--select (and (string-prefix-p "prism-level" (symbol-name it)) 920 (string-match-p (rx digit eos) (symbol-name it)))) 921 nreverse (-map #'face-foreground) (-map #'colorize))) 922 (select-colors (colors threshold) 923 ;; Return shuffled list of COLORS ensuring that the 924 ;; distance between each one meets THRESHOLD. 925 (cl-loop with selected = (list (pop colors)) 926 while colors 927 do (setf colors (prism-shuffle colors)) 928 for index = (--find-index 929 (>= (color-distance (car selected) it) 930 threshold) 931 colors) 932 while index 933 do (progn 934 (push (nth index colors) selected) 935 (setf colors (-remove-at index colors))) 936 finally return selected)) 937 (background-contrast-p (color &optional (min-distance 32768)) 938 (>= (color-distance color (face-attribute 'default :background)) 939 min-distance)) 940 (option-customized-p 941 (option) (not (equal (pcase-exhaustive (get option 'standard-value) 942 (`((funcall (function ,fn))) (funcall fn))) 943 (symbol-value option))))) 944 (let* ((faces (--select (string-prefix-p "font-lock-" (symbol-name it)) 945 (face-list))) 946 (colors (->> faces 947 (--map (face-attribute it :foreground)) 948 (--remove (eq 'unspecified it)) 949 (-remove #'color-gray-p) 950 (-select #'background-contrast-p))) 951 (colors (pcase arg 952 ((pred integerp) (-take arg (prism-shuffle (-uniq colors)))) 953 ('(4) colors) 954 (_ (-uniq colors)))) 955 (colors (select-colors colors prism-color-distance)) 956 (colors (-rotate (random (length colors)) colors)) 957 (desaturations (if (option-customized-p 'prism-desaturations) 958 prism-desaturations 959 (prism-extrapolate 0 prism-num-faces (length colors) 960 (* c (+ 2 (length colors)))))) 961 (lightens (if (option-customized-p 'prism-lightens) 962 prism-lightens 963 (prism-extrapolate 0 prism-num-faces (length colors) 964 (* c (+ 2 (length colors))))))) 965 (prism-set-colors :colors colors 966 :desaturations desaturations 967 :lightens lightens 968 :comments-fn (if (option-customized-p 'prism-comments-fn) 969 prism-comments-fn 970 (lambda (color) 971 (--> color 972 ;; The default function desaturates by 30%, but 40% 973 ;; seems to help a bit when using random colors. 974 (color-desaturate-name it 40) 975 (color-lighten-name it -10))))) 976 (message "Randomized%s colors: %s\nFaces: %s" 977 (pcase arg 978 ('(4) "") 979 (_ ", unique")) 980 (string-join (-map #'colorize colors) " ") 981 (string-join (faces) " "))))) 982 983 (defun prism-save-colors () 984 "Save current `prism' colors. 985 Function `prism-set-colors' does not save its argument values 986 permanently. This command saves them using the customization 987 system so that `prism-set-colors' can then be called without 988 arguments to set the same faces." 989 ;; FIXME: Make this interactive. 990 (cl-letf (((symbol-function 'custom-save-all) 991 (symbol-function 'ignore))) 992 ;; Avoid saving the file for each variable, which is very slow. 993 ;; Save it once at the end. 994 (dolist (var (list 'prism-desaturations 'prism-lightens 'prism-num-faces 995 'prism-comments-fn 'prism-strings-fn)) 996 (customize-save-variable var (symbol-value var)))) 997 (customize-save-variable 'prism-colors prism-colors)) 998 999 (cl-defun prism-modify-colors (&key num colors desaturations lightens &allow-other-keys) 1000 "Return list of NUM colors modified according to DESATURATIONS and LIGHTENS." 1001 (cl-flet ((modify-color (color desaturate lighten) 1002 (--> color 1003 (if (> desaturate 0) 1004 (color-desaturate-name it desaturate) 1005 it) 1006 (if (> lighten 0) 1007 (color-lighten-name it lighten) 1008 it) 1009 ;; FIXME: It seems that these two functions called in sequence 1010 ;; always modify the color, e.g. #ff2afc becomes #fe29fb. 1011 (color-name-to-rgb it) 1012 (-let (((r g b) it)) 1013 (color-rgb-to-hex r g b 2))))) 1014 (when (< (length desaturations) num) 1015 (setf desaturations (prism-expand-list num desaturations))) 1016 (when (< (length lightens) num) 1017 (setf lightens (prism-expand-list num lightens))) 1018 (cl-loop for i from 0 below num 1019 for desaturate = (nth i desaturations) 1020 for lighten = (nth i lightens) 1021 collect (modify-color (nth i colors) desaturate lighten)))) 1022 1023 (defun prism-blend (a b alpha) 1024 "Return color A blended with color B by amount ALPHA." 1025 (cl-flet ((blend (a b alpha) 1026 (+ (* alpha a) (* b (- 1 alpha))))) 1027 (-let* (((ar ag ab) (color-name-to-rgb a)) 1028 ((br bg bb) (color-name-to-rgb b))) 1029 (color-rgb-to-hex (blend ar br alpha) 1030 (blend ag bg alpha) 1031 (blend ab bb alpha))))) 1032 1033 (defun prism-shuffle (seq) 1034 "Destructively shuffle SEQ. 1035 Copied from `elfeed-shuffle'." 1036 (let ((n (length seq))) 1037 (prog1 seq ; don't use dotimes result (bug#16206) 1038 (dotimes (i n) 1039 (cl-rotatef (elt seq i) (elt seq (+ i (cl-random (- n i))))))))) 1040 1041 (defun prism-expand-list (new-length list) 1042 "Return LIST expanded to NEW-LENGTH. 1043 Each element of LIST is repeated an equal number of times, except 1044 that the last element may be repeated an extra time when 1045 necessary." 1046 (let* ((length (length list)) 1047 (_longer-p (or (> new-length length) 1048 (user-error "NEW-LENGTH must be longer than LIST"))) 1049 (repeat-n (/ new-length (if (zerop (mod new-length length)) 1050 length 1051 (1- length)))) 1052 (final-element-p (not (zerop (mod new-length length)))) 1053 (new-list (->> list 1054 (--map (-repeat repeat-n it)) 1055 (-flatten)))) 1056 (if final-element-p 1057 (-snoc new-list (-last-item list)) 1058 new-list))) 1059 1060 (defun prism-customize-set (option value) 1061 "Set OPTION to VALUE, and call `prism-set-colors' when possible." 1062 (set-default option value) 1063 (when (--all? (and (boundp it) (symbol-value it)) 1064 '(prism-num-faces prism-color-attribute prism-desaturations 1065 prism-lightens prism-comments-fn prism-strings-fn prism-colors)) 1066 ;; We can't call `prism-set-colors' until *all* relevant options 1067 ;; have been set. 1068 (prism-set-colors))) 1069 1070 (declare-function doom-color "ext:doom-themes" t) 1071 1072 (defun prism-theme-color (color) 1073 "Return COLOR (a string) from current `doom' or `solarized' theme. 1074 If no `doom' or `solarized' theme is active, return COLOR. 1075 Assumes the first `doom' or `solarized' theme found in 1076 `custom-enabled-themes' is the active one." 1077 (if (string-empty-p color) 1078 color 1079 (if-let* ((active-theme (--first (or (string-match (rx bos "doom-" (group (1+ anything))) 1080 (symbol-name it)) 1081 (string-match (rx bos "solarized-" (group (1+ anything))) 1082 (symbol-name it))) 1083 custom-enabled-themes)) 1084 (theme-name (symbol-name active-theme))) 1085 (pcase theme-name 1086 ((rx bos "solarized-") 1087 (let ((variant (intern (string-trim theme-name (rx "solarized-")))) 1088 (color (intern color))) 1089 ;; Yes, `eval' is evil, but for some reason I can't figure out, 1090 ;; it's the only way this works here. In a test function, 1091 ;; `symbol-value' worked fine, but not here. Go figure. 1092 (eval `(solarized-with-color-variables ',variant 1093 ,color)))) 1094 ((rx bos "doom-") 1095 (or (doom-color (intern color)) 1096 color))) 1097 color))) 1098 1099 ;;;; Customization 1100 1101 ;; These are at the bottom because the setters call `prism-set-faces', 1102 ;; which is defined above. 1103 1104 (defgroup prism nil 1105 "Disperse lisp forms into a spectrum of colors according to depth." 1106 :group 'font-lock 1107 :link '(url-link "https://github.com/alphapapa/prism.el")) 1108 1109 (defcustom prism-num-faces 16 1110 "Number of `prism' faces." 1111 :type 'integer 1112 :set #'prism-customize-set) 1113 1114 (defcustom prism-color-attribute :foreground 1115 "Face attribute set in `prism' faces." 1116 :type '(choice (const :tag "Foreground" :foreground) 1117 (const :tag "Background" :background)) 1118 :set #'prism-customize-set) 1119 1120 (defcustom prism-desaturations '(40 50 60) 1121 "Default desaturation percentages applied to colors as depth increases. 1122 This need not be as long as the number of faces used, because 1123 it's extrapolated to the length of `prism-faces'." 1124 :type '(repeat number) 1125 :set #'prism-customize-set) 1126 1127 (defcustom prism-lightens '(0 5 10) 1128 "Default lightening percentages applied to colors as depth increases. 1129 This need not be as long as the number of faces used, because 1130 it's extrapolated to the length of `prism-faces'." 1131 :type '(repeat number) 1132 :set #'prism-customize-set) 1133 1134 (defcustom prism-comments t 1135 "Whether to colorize comments. 1136 Note that comments at depth 0 are not colorized, which preserves 1137 the appearance of e.g. commented Lisp headings." 1138 :type 'boolean) 1139 1140 (defcustom prism-comments-fn 1141 (lambda (color) 1142 (prism-blend color (face-attribute 'font-lock-comment-face :foreground) 0.25)) 1143 "Function which adjusts colors for comments. 1144 Receives one argument, a color name or hex RGB string." 1145 :type 'function 1146 :set #'prism-customize-set) 1147 1148 (defcustom prism-strings t 1149 "Whether to fontify strings." 1150 :type 'boolean) 1151 1152 (defcustom prism-strings-fn 1153 (lambda (color) 1154 (prism-blend color "white" 0.5)) 1155 "Function which adjusts colors for strings. 1156 Receives one argument, a color name or hex RGB string." 1157 :type 'function 1158 :set #'prism-customize-set) 1159 1160 (defcustom prism-parens nil 1161 "Whether to colorize parens separately. 1162 When disabled, parens are colorized with the same face as the 1163 other elements at their depth. When enabled, parens may be 1164 colorized distinctly, e.g. to make them fade away or stand out. 1165 See the PARENS-FN argument to the `prism-set-colors' function." 1166 :type 'boolean 1167 :set #'prism-customize-set) 1168 1169 (defcustom prism-colors 1170 (list 'font-lock-type-face 'font-lock-function-name-face 1171 'font-lock-keyword-face 'font-lock-doc-face) 1172 "List of colors used by default." 1173 :type '(repeat (choice (face :tag "Face (using its foreground color)") 1174 color 1175 (list :tag "Doom/Solarized theme color (requires active theme)" 1176 (const themed) 1177 (string :tag "Color name")) 1178 (function :tag "Function which returns a color"))) 1179 :set #'prism-customize-set) 1180 1181 (defcustom prism-color-distance 32768 1182 "Minimum distance between randomized colors. 1183 See `color-distance'." 1184 :type 'integer) 1185 1186 (defgroup prism-faces nil 1187 "Faces for `prism'. Set automatically with `prism-set-colors'. Do not set manually." 1188 ;; Define a group for the faces to keep them out of the main 1189 ;; customization group, otherwise users might customize them there 1190 ;; and get confused. Define this group after all other `defcustom's 1191 ;; so the "current group" isn't changed before they're all defined. 1192 :group 'prism) 1193 1194 (defcustom prism-whitespace-mode-indents 1195 (list (cons 'python-mode 'python-indent-offset) 1196 (cons 'haskell-mode 'haskell-indentation-left-offset) 1197 (cons t 4)) 1198 "Alist mapping major modes to indentation offsets for `prism-whitespace-mode'. 1199 Each key should be a major mode function symbol, and the value 1200 either a variable whose value to use or an integer number of 1201 spaces. The last cell is the default, and its key should be t." 1202 :type '(alist :key-type (choice (const :tag "Default" t) 1203 (symbol :tag "Major mode")) 1204 :value-type (choice (variable :tag "Value of variable") 1205 (integer :tag "Number of spaces")))) 1206 1207 ;;;; Footer 1208 1209 (provide 'prism) 1210 1211 ;;; prism.el ends here