1 ;;; rainbow-delimiters.el --- Color nested parentheses, brackets, and braces according to their depth.

     2 

     3 ;; Copyright (C) 2010-2011 Jeremy L. Rayman.

     4 ;; Author: Jeremy L. Rayman <[email protected]>

     5 ;; Maintainer: Jeremy L. Rayman <[email protected]>

     6 ;; Created: 2010-09-02

     7 ;; Version: 1.2.1

     8 ;; Keywords: faces, convenience, lisp, matching, tools

     9 ;; EmacsWiki: RainbowDelimiters

    10 ;; URL: http://www.emacswiki.org/emacs/rainbow-delimiters.el

    11 

    12 ;; This program is free software; you can redistribute it and/or modify

    13 ;; it under the terms of the GNU General Public License as published by

    14 ;; the Free Software Foundation, either version 3 of the License, or

    15 ;; (at your option) any later version.

    16 

    17 ;; This program is distributed in the hope that it will be useful,

    18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of

    19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    20 ;; GNU General Public License for more details.

    21 

    22 ;; You should have received a copy of the GNU General Public License

    23 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

    24 

    25 

    26 ;;; Commentary:

    27 

    28 ;; This is a "rainbow parentheses" mode which includes support for

    29 ;; parens "()", brackets "[]", and braces "{}". It conveys nesting

    30 ;; depth by using a different face for each level.  It colors all

    31 ;; statements at a given level using the same color - if several

    32 ;; statements are all at the same nested depth, they will all be the

    33 ;; same color.

    34 ;;

    35 ;; Great care has been taken to make this mode FAST. You should see no

    36 ;; discernible change in scrolling or editing speed while using it,

    37 ;; even with delimiter-rich languages like Clojure, Lisp, and Scheme.

    38 ;;

    39 ;; The one exception is with extremely large nested data structures

    40 ;; having hundreds of delimiters; in that case there will be a brief

    41 ;; pause to colorize the structure the very first time it is displayed

    42 ;; on screen; from then on editing this structure will perform at full

    43 ;; speed.

    44 ;;

    45 ;; Default colors have been chosen with the philosophy that it's

    46 ;; better be less intrusive than to be more colorful. Color schemes

    47 ;; are always a matter of taste.  If you do take the time to design a

    48 ;; new color scheme, please post it on the EmacsWiki page!

    49 ;; URL: http://www.emacswiki.org/emacs/RainbowDelimiters

    50 

    51 ;;; Installation:

    52 

    53 ;; 1. Place rainbow-delimiters.el on your emacs load-path.

    54 ;;

    55 ;; 2. Compile the file (necessary for speed):

    56 ;; M-x byte-compile-file <location of rainbow-delimiters.el>

    57 ;;

    58 ;; 3. Add the following to your dot-emacs/init file:

    59 ;; (require 'rainbow-delimiters)

    60 ;;

    61 ;; 4. Add hooks for modes where you want it enabled, for example:

    62 ;; (add-hook 'clojure-mode-hook 'rainbow-delimiters-mode)

    63 ;;

    64 ;; - To activate rainbow-delimiters mode temporarily in a buffer:

    65 ;; M-x rainbow-delimiters-mode

    66 

    67 ;;; Customization:

    68 

    69 ;; To customize various options, including the color scheme:

    70 ;; M-x customize-group rainbow-delimiters

    71 ;;

    72 ;; color-theme.el users:

    73 ;; If you use the color-theme package, you can specify custom colors

    74 ;; by adding the appropriate faces to your theme.

    75 ;; - Faces take the form of:

    76 ;;   'rainbow-delimiters-depth-#-face' with # being the depth.

    77 ;;   Depth begins at 1, the outermost color.

    78 ;;   Faces exist for depths 1-12.

    79 ;; - The unmatched delimiter face is:

    80 ;;   'rainbow-delimiters-unmatched-delimiter-face'

    81 

    82 ;;; Change Log:

    83 

    84 ;; 1.0 - Initial release.

    85 ;; 1.1 - Stop tracking each delimiter's depth independently.

    86 ;;       This had lead to confusing results when viewing clojure

    87 ;;       code. Instead, just color based on current nesting inside

    88 ;;       all delimiters combined.

    89 ;;     - Added 'all-delimiters' faces to apply a color scheme to

    90 ;;       all delimiters at once. Other faces inherit from this group.

    91 ;; 1.1.1 - Change color scheme to a lighter, more subtle style.

    92 ;; 1.1.2: (2011-03-25)

    93 ;;  - Add an unmatched-delimiter face and correct problem with

    94 ;;    coloring of text following unmatched closing delims.

    95 ;; 1.2: (2011-03-28)

    96 ;;  - Unify delimiter faces: all delimiter types now use the same depth

    97 ;;    faces, of form 'rainbow-delimiters-depth-#-face'.

    98 ;; 1.2.1: (2011-03-29)

    99 ;;  - Conform to ELPA conventions.

   100 

   101 ;;; TODO:

   102 

   103 ;; - Add support for nested tags (XML, HTML)

   104 

   105 ;;; Issues:

   106 

   107 ;; - Rainbow-delimiters mode does not appear to change the color of

   108 ;;   delimiters when Org-mode is enabled.

   109 

   110 

   111 ;;; Code:

   112 

   113 (eval-when-compile (require 'cl))

   114 

   115 

   116 ;;; Customize interface:

   117 

   118 (defgroup rainbow-delimiters nil

   119   "Color nested parentheses, brackets, and braces according to their depth."

   120   :prefix "rainbow-delimiters-"

   121   :link '(url-link :tag "Website for rainbow-delimiters (EmacsWiki)"

   122                    "http://www.emacswiki.org/emacs/RainbowDelimiters")

   123   :group 'applications)

   124 

   125 (defgroup rainbow-delimiters-faces nil

   126   "Faces for each nested depth. Used to color delimiter pairs.

   127 

   128 Depths 1-12 are defined. Depth 1 is the outermost delimiter pair."

   129   :group 'rainbow-delimiters

   130   :link '(custom-group-link "rainbow-delimiters")

   131   :prefix 'rainbow-delimiters-faces-)

   132 

   133 

   134 ;;; Faces:

   135 

   136 ;; Unmatched delimiter face:

   137 (defface rainbow-delimiters-unmatched-face

   138   '((t (:foreground "#88090B")))

   139   "Face to color unmatched closing delimiters with."

   140   :group 'rainbow-delimiters

   141   :group 'rainbow-delimiters-faces)

   142 

   143 

   144 ;; NOTE: The use of repetitious definitions for depth faces is temporary.

   145 ;; Once the emacs 24 color theme support comes in, this will be reevaluated.

   146 

   147 ;; Faces for colorizing delimiters at each level:

   148 (defface rainbow-delimiters-depth-1-face

   149   '((t (:foreground "grey55")))

   150   "Rainbow-delimiters nested delimiter face, depth 1 - the outermost pair."

   151   :group 'rainbow-delimiters-faces)

   152 

   153 (defface rainbow-delimiters-depth-2-face

   154   '((t (:foreground "#93a8c6")))

   155   "Rainbow-delimiters nested delimiter face, depth 2."

   156   :group 'rainbow-delimiters-faces)

   157 

   158 (defface rainbow-delimiters-depth-3-face

   159   '((t (:foreground "#b0b1a3")))

   160   "Rainbow-delimiters nested delimiter face, depth 3."

   161   :group 'rainbow-delimiters-faces)

   162 

   163 (defface rainbow-delimiters-depth-4-face

   164   '((t (:foreground "#97b098")))

   165   "Rainbow-delimiters nested delimiter face, depth 4."

   166   :group 'rainbow-delimiters-faces)

   167 

   168 (defface rainbow-delimiters-depth-5-face

   169   '((t (:foreground "#aebed8")))

   170   "Rainbow-delimiters nested delimiter face, depth 5."

   171   :group 'rainbow-delimiters-faces)

   172 

   173 (defface rainbow-delimiters-depth-6-face

   174   '((t (:foreground "#b0b0b3")))

   175   "Rainbow-delimiters nested delimiter face, depth 6."

   176   :group 'rainbow-delimiters-faces)

   177 

   178 (defface rainbow-delimiters-depth-7-face

   179   '((t (:foreground "#90a890")))

   180   "Rainbow-delimiters nested delimiter face, depth 7."

   181   :group 'rainbow-delimiters-faces)

   182 

   183 (defface rainbow-delimiters-depth-8-face

   184   '((t (:foreground "#a2b6da")))

   185   "Rainbow-delimiters nested delimiter face, depth 8."

   186   :group 'rainbow-delimiters-faces)

   187 

   188 (defface rainbow-delimiters-depth-9-face

   189   '((t (:foreground "#9cb6ad")))

   190   "Rainbow-delimiters nested delimiter face, depth 9."

   191   :group 'rainbow-delimiters-faces)

   192 

   193 ;; Emacs doesn't sort face names by number correctly above 1-9; trick it into

   194 ;; proper sorting by prepending a _ before the faces with depths over 10.

   195 (defface rainbow-delimiters-depth-_10-face

   196   '((t (:foreground "#83787e")))

   197   "Rainbow-delimiters nested delimiter face, depth 10."

   198   :group 'rainbow-delimiters-faces)

   199 

   200 (defface rainbow-delimiters-depth-_11-face

   201   '((t (:foreground "#e1ddca")))

   202   "Rainbow-delimiters nested delimiter face, depth 11."

   203   :group 'rainbow-delimiters-faces)

   204 

   205 (defface rainbow-delimiters-depth-_12-face

   206   '((t (:foreground "#e0c7c7")))

   207   "Rainbow-delimiters nested delimiter face, depth 12."

   208   :group 'rainbow-delimiters-faces)

   209 

   210 ;; Variable aliases for faces 10+:

   211 ;; We prepend an underline to numbers 10+ to force customize to sort correctly.

   212 ;; Here we define aliases without the underline for use everywhere else.

   213 (put 'rainbow-delimiters-depth-10-face

   214      'face-alias

   215      'rainbow-delimiters-depth-_10-face)

   216 (put 'rainbow-delimiters-depth-11-face

   217      'face-alias

   218      'rainbow-delimiters-depth-_11-face)

   219 (put 'rainbow-delimiters-depth-12-face

   220      'face-alias

   221      'rainbow-delimiters-depth-_12-face)

   222 

   223 

   224 ;;; Face utility functions

   225 

   226 ;; inlining this function for speed:

   227 ;; see: http://www.gnu.org/s/emacs/manual/html_node/elisp/Compilation-Tips.html

   228 ;; this will cause problems with debugging. To debug, change defsubst -> defun.

   229 (defsubst rainbow-delimiters-depth-face (depth)

   230   "Return face-name 'rainbow-delimiters-depth-DEPTH-face' as a string.

   231 

   232 DEPTH is the number of nested levels deep for the delimiter being colorized.

   233 

   234 Returns a face namestring the of form 'rainbow-delimiters-depth-DEPTH-face',

   235 e.g. 'rainbow-delimiters-depth-1-face'."

   236   (concat "rainbow-delimiters-depth-" (number-to-string depth) "-face"))

   237 

   238 

   239 ;;; Nesting level

   240 

   241 ;; syntax-table: used with parse-partial-sexp for determining current depth.

   242 (defvar rainbow-delimiters-delim-syntax-table

   243   (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))

   244     (modify-syntax-entry ?\( "()  " table)

   245     (modify-syntax-entry ?\) ")(  " table)

   246     (modify-syntax-entry ?\[ "(]" table)

   247     (modify-syntax-entry ?\] ")[" table)

   248     (modify-syntax-entry ?\{ "(}" table)

   249     (modify-syntax-entry ?\} "){" table)

   250     table)

   251   "Syntax table for recognizing all supported delimiter types.")

   252 

   253 (defun rainbow-delimiters-depth (point)

   254   "Return # of nested levels of parens, brackets, braces POINT is inside of."

   255   (save-excursion

   256       (beginning-of-defun)

   257       (let ((depth

   258              (with-syntax-table rainbow-delimiters-delim-syntax-table

   259                (car (parse-partial-sexp (point) point)))))

   260         (if (>= depth 0)

   261             depth

   262           0)))) ; ignore negative depths created by unmatched closing parens.

   263 

   264 

   265 ;;; Text properties

   266 

   267 ;; inlining this function for speed:

   268 ;; see: http://www.gnu.org/s/emacs/manual/html_node/elisp/Compilation-Tips.html

   269 ;; this will cause problems with debugging. To debug, change defsubst -> defun.

   270 (defsubst rainbow-delimiters-propertize-delimiter (point depth)

   271   "Colorize delimiter at POINT according to DEPTH.

   272 

   273 POINT is the point of character to propertize.

   274 DEPTH is the nested delimiter depth at POINT, which determines the face to use.

   275 

   276 Sets text properties:

   277 `font-lock-face' to the corresponding delimiter face.

   278 `rear-nonsticky' to prevent color from bleeding into subsequent characters typed by the user."

   279   (with-silent-modifications

   280     (let ((delim-face (if (<= depth 0)

   281                           "rainbow-delimiters-unmatched-face"

   282                         (rainbow-delimiters-depth-face depth))))

   283       ;; (when (eq depth -1) (message "Unmatched delimiter at char %s." point))

   284       (add-text-properties point (1+ point)

   285                            `(font-lock-face ,delim-face

   286                              rear-nonsticky t)))))

   287 

   288 

   289 (defun rainbow-delimiters-unpropertize-delimiter (point)

   290   "Remove text properties set by rainbow-delimiters mode from char at POINT."

   291   (remove-text-properties point (1+ point)

   292                           '(font-lock-face nil

   293                             rear-nonsticky nil)))

   294 

   295 

   296 (defun rainbow-delimiters-char-ineligible-p (point)

   297   "Return t if char at POINT should be skipped, e.g. if inside a comment.

   298 

   299 Returns t if char at point meets one of the following conditions:

   300 - Inside a string.

   301 - Inside a comment.

   302 - Is an escaped char, e.g. ?\)"

   303   (let ((parse-state (save-excursion

   304                        (beginning-of-defun)

   305                        ;; (point) is at beg-of-defun; point is the char location

   306                        (parse-partial-sexp (point) point))))

   307     (or

   308      (nth 3 parse-state)                ; inside string?

   309      (nth 4 parse-state)                ; inside comment?

   310      (and (eq (char-before point) ?\\)  ; escaped char, e.g. ?\) - not counted

   311           (and (not (eq (char-before (1- point)) ?\\)) ; special-case: ignore ?\\

   312                (eq (char-before (1- point)) ?\?))))))

   313 ;; standard char read syntax '?)' is not tested for because emacs manual states

   314 ;; that punctuation such as delimiters should _always_ use escaped '?\)' form.

   315 

   316 

   317 ;;; JIT-Lock functionality

   318 

   319 ;; Used to skip delimiter-by-delimiter `rainbow-delimiters-propertize-region'.

   320 (defvar rainbow-delimiters-delim-regex "\\(\(\\|\)\\|\\[\\|\\]\\|\{\\|\}\\)"

   321   "Regex matching all opening and closing delimiters we intend to colorize.")

   322 

   323 ;; main function called by jit-lock:

   324 (defun rainbow-delimiters-propertize-region (start end)

   325   "Colorize delimiters in region between START and END.

   326 

   327 Used by jit-lock for dynamic highlighting."

   328   (save-excursion

   329     (goto-char start)

   330     ;; START can be anywhere in buffer; begin depth counts from values at START.

   331     (let ((depth (rainbow-delimiters-depth start)))

   332       (while (and (< (point) end)

   333                   (re-search-forward rainbow-delimiters-delim-regex end t))

   334         (backward-char) ; re-search-forward places point after delim; go back.

   335         (unless (rainbow-delimiters-char-ineligible-p (point))

   336           (let ((delim (char-after (point))))

   337             (cond ((eq ?\( delim)       ; (

   338                    (setq depth (1+ depth))

   339                    (rainbow-delimiters-propertize-delimiter (point)

   340                                                             depth))

   341                   ((eq ?\) delim)       ; )

   342                    (rainbow-delimiters-propertize-delimiter (point)

   343                                                             depth)

   344                    (setq depth (or (and (<= depth 0) 0) ; unmatched paren

   345                                    (1- depth))))

   346                   ((eq ?\[ delim)       ; [

   347                    (setq depth (1+ depth))

   348                    (rainbow-delimiters-propertize-delimiter (point)

   349                                                             depth))

   350                   ((eq ?\] delim)       ; ]

   351                    (rainbow-delimiters-propertize-delimiter (point)

   352                                                             depth)

   353                    (setq depth (or (and (<= depth 0) 0) ; unmatched bracket

   354                                    (1- depth))))

   355                   ((eq ?\{ delim)       ; {

   356                    (setq depth (1+ depth))

   357                    (rainbow-delimiters-propertize-delimiter (point)

   358                                                             depth))

   359                   ((eq ?\} delim)       ; }

   360                    (rainbow-delimiters-propertize-delimiter (point)

   361                                                             depth)

   362                    (setq depth (or (and (<= depth 0) 0) ; unmatched brace

   363                                    (1- depth)))))))

   364         ;; move past delimiter so re-search-forward doesn't pick it up again

   365         (forward-char)))))

   366 

   367 (defun rainbow-delimiters-unpropertize-region (start end)

   368   "Remove mode faces from delimiters in region between START and END."

   369   (save-excursion

   370     (goto-char start)

   371     (while (and (< (point) end)

   372                 (re-search-forward rainbow-delimiters-delim-regex end t))

   373       ;; re-search-forward places point 1 further than the delim matched:

   374       (rainbow-delimiters-unpropertize-delimiter (1- (point))))))

   375 

   376 

   377 ;;; Minor mode:

   378 

   379 ;;;###autoload

   380 (define-minor-mode rainbow-delimiters-mode

   381   "Color nested parentheses, brackets, and braces according to their depth."

   382   nil "" nil ; No modeline lighter - it's already obvious when the mode is on.

   383   (if (not rainbow-delimiters-mode)

   384       (progn

   385         (jit-lock-unregister 'rainbow-delimiters-propertize-region)

   386         (rainbow-delimiters-unpropertize-region (point-min) (1- (point-max))))

   387     (jit-lock-register 'rainbow-delimiters-propertize-region t)))

   388 

   389 

   390 (provide 'rainbow-delimiters)

   391 

   392 ;;; rainbow-delimiters.el ends here.