commit e1e2076bf817942a827cf562dd3ca644be8b71b7
Author: Jamie Beardslee <jdb@jamzattack.xyz>
Date: Fri, 11 Sep 2020 18:08:40 +1200
Add lex-hl.el
Diffstat:
| A | lex-hl.el | | | 127 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 127 insertions(+), 0 deletions(-)
diff --git a/lex-hl.el b/lex-hl.el
@@ -0,0 +1,127 @@
+;;; lex-hl.el --- Highlight lexically bound variables -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Jamie Beardslee
+
+;; Author: Jamie Beardslee <jdb@jamzattack.xyz>
+;; Keywords: lisp
+
+;; This program 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.
+
+;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'hi-lock)
+
+
+;;; Highlight an arbitrary symbol
+
+(defun lex-hl-highlight-symbol (symbol)
+ "Highlight SYMBOL within the current buffer.
+`highlight-symbol-at-point' checks the `current-prefix-arg' in
+order to determine the face. This just uses an automatically
+determined face."
+ (let* ((symbol-name
+ (symbol-name symbol))
+ (regexp (hi-lock-regexp-okay
+ (format "\\_<%s\\_>"
+ (regexp-quote symbol-name))))
+ (hi-lock-auto-select-face t)
+ (face (hi-lock-read-face-name)))
+ (unless (string-prefix-p "_" symbol-name)
+ (hi-lock-mode t)
+ (hi-lock-set-pattern regexp face nil nil nil))))
+
+
+;;; Define symbol-specific highlighters
+
+(defvar lex-hl-forms nil
+ "A list of functions/macros that `lex-hl' can highlight.")
+
+(defun lex-hl-add-form (symbol &optional function)
+ "FUNCTION highlights the variables bound by SYMBOl.
+If FUNCTION is omitted or nil, `lex-hl--SYMBOL' will be used."
+ (put symbol 'lex-hl (or function (intern (format "lex-hl--%s" symbol))))
+ (add-to-list 'lex-hl-forms (symbol-name symbol)))
+
+
+;;; Highlight variables for specific forms
+
+(defun lex-hl--lambda-list (lambda-list)
+ "Highlight the variables bound in LAMBDA-LIST."
+ (dolist (symbol lambda-list)
+ (unless (string-prefix-p "&" (symbol-name symbol))
+ (lex-hl-highlight-symbol symbol))))
+
+(defun lex-hl--defun (form)
+ "Highlight the variables bound by `defun' in FORM."
+ (lex-hl--lambda-list (nth 2 form)))
+(lex-hl-add-form 'defun)
+
+(defun lex-hl--lambda (form)
+ "Highlight the variables bound by `lambda' in FORM."
+ (lex-hl--lambda-list (nth 1 form)))
+(lex-hl-add-form 'lambda)
+
+(defun lex-hl--let (form)
+ "Highlight the variables bound by `let' in FORM."
+ (dolist (elt (nth 1 form))
+ (let ((symbol (cond ((consp elt)
+ (car elt))
+ ((symbolp elt)
+ elt))))
+ (lex-hl-highlight-symbol symbol))))
+(lex-hl-add-form 'let)
+
+(defalias 'lex-hl--let* #'lex-hl--let)
+(lex-hl-add-form 'let*)
+
+(defun lex-hl--dolist (form)
+ "Highlight the variable bound by `dolist' in FORM."
+ (let ((symbol (car (nth 1 form))))
+ (lex-hl-highlight-symbol symbol)))
+(lex-hl-add-form 'dolist)
+
+
+;;; User-facing commands
+
+
+;;;###autoload
+(defun lex-hl-highlight-lexical-variables (arg)
+ (interactive "p")
+ (if (<= arg 0)
+ (hi-lock-unface-buffer t)
+ (let* ((bounds (bounds-of-thing-at-point 'defun))
+ (beg (car bounds))
+ (end (cdr bounds)))
+ (save-restriction
+ ;; TODO: figure out a way to highlight only within a region.
+ ;; When narrowed, hi-lock still highlights other occurences when
+ ;; point gets close.
+ (narrow-to-region beg end)
+ (save-excursion
+ (re-search-backward (eval
+ `(rx "(" (group (or ,@lex-hl-forms))))
+ beg :noerror arg)
+ (goto-char (match-beginning 0))
+ (let* ((sexp (read (thing-at-point 'sexp)))
+ (symbol (car sexp)))
+ (funcall (get symbol 'lex-hl) sexp)))))))
+
+;; (define-key emacs-lisp-mode-map (kbd "C-c .") #'lex-hl-highlight-lexical-variables)
+
+(provide 'lex-hl)
+;;; lex-hl.el ends here
