UP | HOME

Emacs: Improved clojure-mode highlighting.
이맥스: clojure-mode의 문법강조를 향상 시켰습니다.

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: