Clojure programmer want to improve readability of codes through vertical alignment.1 It’s a good idea, but sometimes it looks ugly. I wanted to highlight local variables in the binding form like let to improve readability.

(let [very-long-long-long-long-name nil
      short-name                    nil])

(let [{:keys [a b c] :or {a 0 b 0 c 0} :as it} nil
      short-name                               nil])

When I have read The absolute awesomeness of anchored font-lock matchers, I thought I could use anchored font-lock matcher to highlight the local variable.

On first try, I could not capture the variable and the s-exp pair using the regular expression. Fortunately, the matcher can use the function instead of the regular expression.

Finally, I wrote the code like this:

(defface clojure-local-binding-variable-name-face
  '((t (:inherit font-lock-variable-name-face :weight normal)))
  "Face used to font-lock Clojure local binding variable name.")

(defface clojure-semi-function-name-face
  '((t (:inherit font-lock-function-name-face :weight normal)))
  "Face used to font-lock Clojure OOP style functions.")

(defface clojure-cond-condtion-face
  '((t (:slant italic)))
  "Face used to font-lock Clojure conditions in `cond' form.")


(defvar clojure--binding-forms
  '("binding" "doseq" "for" "let" "if-let" "when-let" "loop" "with-redefs"))

(defun clojure--binding-regexp ()
  (concat "(" (regexp-opt clojure--binding-forms) "[ \r\t\n]+\\["))

(defun clojure-skip (&rest items)
  (let ((l items))
    (while l
      (skip-chars-forward " \r\t\n")
      (cond
       ((eq (car l) :comment)
        (if (not (looking-at-p ";"))
            (setq l (cdr l))
          (setq l (-remove-item :comment items))
          (comment-forward (point-max))))
       ((eq (car l) :type-hint)
        (if (not (looking-at-p "^"))
            (setq l (cdr l))
          (setq l (-remove-item :type-hint items))
          (forward-sexp)))
       ((eq (car l) :ignored-form)
        (if (not (looking-at-p "#_"))
            (setq l (cdr l))
          (setq l (-remove-item :ignored-form items))
          (while (looking-at-p "#_")
            (forward-sexp (if (looking-at-p "#_\\s(") 2 1))
            (skip-chars-forward " \r\t\n"))))
       ((eq (car l) :destructuring-bind)
        (if (not (looking-at-p "{\\|\\["))
            (setq l (cdr l))
          (while (looking-at-p "{\\|\\[")
            (setq l (-remove-item :destructuring-bind items))
            (forward-sexp)
            (apply #'clojure-skip l)
            (forward-sexp)
            (skip-chars-forward " \r\t\n"))))
       (t (setq l (cdr l)))))))

(defun clojure-forward-sexp (&optional n)
  (or n (setq n 1))
  (while (not (zerop n))
    (clojure-skip :comment :ignored-form)
    (forward-sexp (if (< 0 n) 1 -1))
    (setq n (funcall (if (< 0 n) '1- '1+) n))))


(let* ((whitespace  "[ \r\t\n]")
       (whitespace+ (concat whitespace "+"))
       (whitespace* (concat whitespace "*"))
       (symbol      (concat clojure--sym-regexp "?"))
       (symbol?     (concat "\\(?:" symbol "\\)?"))
       (namespace   (concat "\\(?:" symbol "/\\)"))
       (namespace?  (concat namespace "?"))
       (namespace*  (concat namespace "*"))
       (meta* "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*"))
  (dolist (mode '(clojure-mode clojurescript-mode clojurec-mode))
    ;; append rules
    (font-lock-add-keywords
     mode
     `(;; Highlight condtions in `cond' form.
       ("(cond[ \r\t\n]+"
        (,(lambda (limit)
            (ignore-errors
              (when (> limit (point))
                (clojure-skip :comment :ignored-form)
                (set-match-data (list (point-marker)
                                      (progn (forward-sexp) (point-marker))))
                (clojure-forward-sexp)
                t)))
         (save-excursion
           (setq-local cond-form-point (point))
           (up-list)
           (point))
         (goto-char cond-form-point)
         (0 'clojure-cond-condtion-face prepend))))
     'append)
    ;; prepend rules
    (font-lock-add-keywords
     mode
     `(;; Binding forms
       (,(clojure--binding-regexp)
        ;; Normal bindings
        (,(lexical-let ((symbol symbol) (namespace? namespace?))
            (lambda (limit)
              (ignore-errors
                (clojure-skip :comment :ignored-form :type-hint :destructuring-bind)
                (let ((local-limit (save-excursion (forward-sexp) (point))))
                  (unless (re-search-forward (concat namespace? "\\(" symbol "\\)\\>")
                                             (min local-limit limit) t)
                    (set-match-data (-repeat 4 (make-marker))))
                  (goto-char local-limit))
                (clojure-forward-sexp)
                t)))
         (save-excursion
           (setq-local binding-form-point (point))
           (up-list)
           (point))
         (goto-char binding-form-point)
         (1 'clojure-local-binding-variable-name-face))
        ;; Destructuring bindings
        (,(lexical-let ((symbol symbol))
            (lambda (limit)
              ;; NOTE
              ;; We need to iterate to search symbols in the destructuring form,
              ;; but anchored-matcher does not support recursion.
              (ignore-errors
                (unless binding-form-recursive-point
                  (while (and (> limit (point))
                              (prog1 t (clojure-skip :comment :ignored-form :type-hint))
                              ;; skip normal bind?
                              (not (looking-at-p "[ \r\t\n]*\\(?:{\\|\\[\\)"))
                              (prog1 t (clojure-forward-sexp 2))))
                  (when (looking-at-p "[ \r\t\n]*\\(?:{\\|\\[\\)")
                    (setq-local binding-form-recursive-point (point))
                    (setq-local binding-form-recursive-limit
                                (save-excursion (clojure-forward-sexp) (point)))))
                (when binding-form-recursive-point
                  (clojure-skip :comment :ignored-form :type-hint)
                  (if (re-search-forward (concat "\\<" symbol "\\>")
                                         (min limit binding-form-recursive-limit) t)
                      (progn
                        ;; ignores
                        (when (string-match-p (concat "\\("
                                                      ":as\\|"
                                                      ":or\\|"
                                                      "&"
                                                      "\\)")
                                              (match-string-no-properties 0))
                          (set-match-data (-repeat 2 (make-marker))))
                        ;; for binding map
                        (when (save-excursion
                                (up-list)
                                (and (eq (char-before) ?})
                                     (< (point) binding-form-recursive-limit)))
                          (clojure-forward-sexp)))
                    (goto-char binding-form-recursive-limit)
                    (clojure-forward-sexp)
                    (setq-local binding-form-recursive-point nil)
                    (setq-local binding-form-recursive-limit nil)
                    (set-match-data (-repeat 2 (make-marker))))
                  t))))
         (save-excursion
           (setq-local binding-form-point (point))
           (setq-local binding-form-recursive-point nil)
           (setq-local binding-form-recursive-limit nil)
           (up-list)
           (point))
         (goto-char binding-form-point)
         (0 'clojure-local-binding-variable-name-face)))
       ;; OOP style function forms & letfn
       (,(concat "(\\(?:"
                 (concat (regexp-opt '(;; "definterface"
                                       ;; "defprotocol"
                                       "defrecord"
                                       "deftype"
                                       "extend-protocol"
                                       "extend-type"
                                       "proxy"
                                       "reify"))
                         "[ \r\t\n]")
                 "\\|"
                 "letfn[ \r\t\n]+\\["
                 "\\)")
        (,(lexical-let ((symbol symbol))
            (lambda (limit)
              (ignore-errors
                (while (and (> limit (point))
                            (prog1 t (clojure-skip :comment :ignored-form))
                            (not (looking-at-p "[ \r\t\n]*("))
                            (prog1 t (forward-sexp))))
                (when (looking-at-p "[ \r\t\n]*(")
                  (down-list)
                  (clojure-skip :type-hint :ignored-form)
                  (let ((local-limit (save-excursion (forward-sexp) (point))))
                    (unless (re-search-forward (concat symbol "\\>") (min limit local-limit) t)
                      (set-match-data (-repeat 2 (make-marker)))))
                  (up-list)
                  t))))
         (save-excursion
           (setq-local oop-fn-form-point (point))
           (up-list)
           (point))
         (goto-char oop-fn-form-point)
         (0 'clojure-semi-function-name-face)))))))

<2017-06-12 Mon>: Update.

Footnotes

1 vertically align binding values in `let`