From a17f629d616ed103d94ab47c85f96ca2dfca908e Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 13 Jul 2024 21:10:04 +0200 Subject: [PATCH] * lisp/rainbow-delimiters.el: New file. From https://github.com/Fanael/rainbow-delimiters --- lisp/rainbow-delimiters.el | 223 +++++++++++++++++++++++++++++++++++++ 1 file changed, 223 insertions(+) create mode 100644 lisp/rainbow-delimiters.el diff --git a/lisp/rainbow-delimiters.el b/lisp/rainbow-delimiters.el new file mode 100644 index 00000000000..37018560734 --- /dev/null +++ b/lisp/rainbow-delimiters.el @@ -0,0 +1,223 @@ +;;; rainbow-delimiters.el --- Highlight brackets according to their depth -*- lexical-binding: t -*- + +;; Copyright (C) 2024 Free Software Foundation, Inc + +;; Keywords: faces convenience lisp tools + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Rainbow-Delimiters mode which highlights parentheses, brackets, and +;; braces according to their depth. Each successive level is +;; highlighted in a different color. This makes it easy to spot +;; matching delimiters, orient yourself in the code, and tell which +;; statements are at a given level. +;; +;; Great care has been taken to make this mode fast, it should work +;; seamlessly even in delimiter-rich languages like Lisp. +;; +;; Customization: +;; +;; To customize various options, including the color theme: +;; M-x customize-group rainbow-delimiters +;; +;; You can specify custom colors by customizing following faces: +;; - Faces take the form `rainbow-delimiters-depth-N', with N being the +;; depth. Depth begins at 1, the outermost color. Faces exist for depths 1-9. +;; - The unmatched delimiter face: `rainbow-delimiters-unmatched'. +;; - The mismatched delimiter face: `rainbow-delimiters-mismatched'. + +;;; Code: + +(defgroup rainbow-delimiters nil + "Highlight nested parentheses, brackets, and braces according to their depth." + :group 'applications) + +(defcustom rainbow-delimiters-pick-face-function + #'rainbow-delimiters-default-pick-face + "The function used to pick a face used to highlight a delimiter. +The function should take three arguments (DEPTH MATCH LOC), where: + - DEPTH is the delimiter depth; when zero or negative, it's an unmatched + delimiter. + - MATCH is nil iff the delimiter is a mismatched closing delimiter. + - LOC is the location of the delimiter. +The function should return a value suitable to use as a value of the `face' text +property, or nil, in which case the delimiter is not highlighted. +The function should not move the point or mark or change the match data." + :tag "Pick face function" + :type 'function) + +(defface rainbow-delimiters-base + '((default (:inherit unspecified))) + "Face inherited by all other rainbow-delimiter faces.") + +(defface rainbow-delimiters-base-error + '((default (:inherit rainbow-delimiters-base)) + (t (:foreground "#88090B"))) + "Face inherited by all other rainbow-delimiter error faces.") + +(defface rainbow-delimiters-unmatched + '((default (:inherit rainbow-delimiters-base-error))) + "Face to highlight unmatched closing delimiters in.") + +(defface rainbow-delimiters-mismatched + '((default (:inherit rainbow-delimiters-unmatched))) + "Face to highlight mismatched closing delimiters in.") + +(eval-when-compile + (defmacro rainbow-delimiters--define-depth-faces () + (let ((faces '()) + (light-colors ["#707183" "#7388d6" "#909183" "#709870" "#907373" + "#6276ba" "#858580" "#80a880" "#887070"]) + (dark-colors ["grey55" "#93a8c6" "#b0b1a3" "#97b098" "#aebed8" + "#b0b0b3" "#90a890" "#a2b6da" "#9cb6ad"])) + (dotimes (i 9) + (push `(defface ,(intern (format "rainbow-delimiters-depth-%d" (1+ i))) + '((default (:inherit rainbow-delimiters-base)) + (((class color) (background light)) :foreground ,(aref light-colors i)) + (((class color) (background dark)) :foreground ,(aref dark-colors i))) + ,(format "Nested delimiter face, depth %d." (1+ i))) + faces)) + `(progn ,@faces)))) +(rainbow-delimiters--define-depth-faces) + +(defcustom rainbow-delimiters-max-face-count 9 + "Number of faces defined for highlighting delimiter levels. + +Determines depth at which to cycle through faces again. + +It's safe to change this variable provided that for all integers from 1 to the +new value inclusive, a face `rainbow-delimiters-depth-N' is defined." + :type 'integer) + +(defcustom rainbow-delimiters-outermost-only-face-count 0 + "Number of faces to be used only for N outermost delimiter levels. + +This should be smaller than `rainbow-delimiters-max-face-count'." + :type 'integer) + +(defun rainbow-delimiters-default-pick-face (depth match _loc) + "Return a face name appropriate for nesting depth DEPTH. +DEPTH and MATCH are as in `rainbow-delimiters-pick-face-function'. + +The returned value is either `rainbow-delimiters-unmatched', +`rainbow-delimiters-mismatched', or one of the +`rainbow-delimiters-depth-N' faces, obeying +`rainbow-delimiters-max-face-count' and +`rainbow-delimiters-outermost-only-face-count'." + (cond + ((<= depth 0) + 'rainbow-delimiters-unmatched) + ((not match) + 'rainbow-delimiters-mismatched) + (t + (intern-soft + (concat "rainbow-delimiters-depth-" + (number-to-string + (if (<= depth rainbow-delimiters-max-face-count) + ;; Our nesting depth has a face defined for it. + depth + ;; Deeper than # of defined faces; cycle back through to + ;; `rainbow-delimiters-outermost-only-face-count' + 1. + ;; Return face # that corresponds to current nesting level. + (+ 1 rainbow-delimiters-outermost-only-face-count + (mod (- depth rainbow-delimiters-max-face-count 1) + (- rainbow-delimiters-max-face-count + rainbow-delimiters-outermost-only-face-count)))))))))) + +(defun rainbow-delimiters--apply-color (loc depth match) + "Highlight a single delimiter at LOC according to DEPTH. + +LOC is the location of the character to add text properties to. +DEPTH is the nested depth at LOC, which determines the face to use. +MATCH is nil iff it's a mismatched closing delimiter." + (let ((face (funcall rainbow-delimiters-pick-face-function depth match loc))) + (when face + (font-lock-prepend-text-property loc (1+ loc) 'face face)))) + +(defun rainbow-delimiters--char-ineligible-p (loc ppss delim-syntax-code) + "Return t if char at LOC should not be highlighted. +PPSS is the `parse-partial-sexp' state at LOC. +DELIM-SYNTAX-CODE is the `car' of a raw syntax descriptor at LOC. + +Returns t if char at loc meets one of the following conditions: +- Inside a string. +- Inside a comment. +- Is an escaped char, e.g. ?\)" + (or + (nth 3 ppss) ; inside string? + (nth 4 ppss) ; inside comment? + (nth 5 ppss) ; escaped according to the syntax table? + ;; Note: no need to consider single-char openers, they're already handled + ;; by looking at ppss. + (cond + ;; Two character opener, LOC at the first character? + ((/= 0 (logand #x10000 delim-syntax-code)) + (/= 0 (logand #x20000 (or (car (syntax-after (1+ loc))) 0)))) + ;; Two character opener, LOC at the second character? + ((/= 0 (logand #x20000 delim-syntax-code)) + (/= 0 (logand #x10000 (or (car (syntax-after (1- loc))) 0)))) + (t + nil)))) + +;; Main function called by font-lock. +(defun rainbow-delimiters--propertize (end) + "Highlight delimiters in region between point and END. + +Used by font-lock for dynamic highlighting." + (let* ((last-ppss-pos (point)) + (ppss (syntax-ppss))) + (while (> end (progn (skip-syntax-forward "^()" end) + (point))) + (let* ((delim-pos (point)) + (delim-syntax (syntax-after delim-pos))) + (setq ppss (parse-partial-sexp last-ppss-pos delim-pos nil nil ppss)) + (setq last-ppss-pos delim-pos) + ;; `skip-syntax-forward' leaves the point at the delimiter, move past + ;; it. + (forward-char) + (let ((delim-syntax-code (car delim-syntax))) + (cond + ((rainbow-delimiters--char-ineligible-p delim-pos ppss delim-syntax-code) + nil) + ((= 4 (logand #xFFFF delim-syntax-code)) + ;; The (1+ ...) is needed because `parse-partial-sexp' returns the + ;; depth at the opening delimiter, not in the block being started. + (rainbow-delimiters--apply-color delim-pos (1+ (nth 0 ppss)) t)) + (t + ;; Not an opening delimiter, so it's a closing delimiter. + (let ((matches-p (eq (cdr delim-syntax) (char-after (nth 1 ppss))))) + (rainbow-delimiters--apply-color delim-pos (nth 0 ppss) matches-p)))))))) + ;; We already fontified the delimiters, tell font-lock there's nothing more + ;; to do. + nil) + +;; NB: no face defined here because we apply the faces ourselves instead of +;; leaving that to font-lock. +(defconst rainbow-delimiters--font-lock-keywords + '(rainbow-delimiters--propertize)) + +;;;###autoload +(define-minor-mode rainbow-delimiters-mode + "Highlight nested parentheses, brackets, and braces according to their depth." + :lighter nil + (font-lock-remove-keywords nil rainbow-delimiters--font-lock-keywords) + (when rainbow-delimiters-mode + (font-lock-add-keywords nil rainbow-delimiters--font-lock-keywords 'append) + (setq-local jit-lock-contextually t)) + (when font-lock-mode (font-lock-flush))) + +(provide 'rainbow-delimiters) +;;; rainbow-delimiters.el ends here -- 2.39.2