lex-hl.el (6742B)
1 ;;; lex-hl.el --- Highlight lexically bound variables -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2020 Jamie Beardslee 4 5 ;; Author: Jamie Beardslee <jdb@jamzattack.xyz> 6 ;; URL: https://git.jamzattack.xyz/lex-hl 7 ;; Package-Requires: ((emacs "26.1")) 8 ;; Version: 2020.11.17 9 ;; Keywords: lisp 10 11 ;; This program is free software; you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; This program is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 23 24 ;;; Commentary: 25 26 ;; This package defines a few commands to highlight lexically bound 27 ;; variables near point: 28 29 ;; `lex-hl-nearest': Highlight the nearest form before point. 30 ;; `lex-hl-prompt': Prompt from a list of forms to highlight. 31 ;; `lex-hl-top-level': Highlight the top level form at point. 32 ;; `lex-hl-unhighlight': Remove highlighting from the current buffer. 33 34 ;; A minor mode is provided to add keybindings for these commands. 35 ;; To enable it in emacs-lisp-mode: 36 ;; (add-hook 'emacs-lisp-mode-hook #'lex-hl-mode) 37 38 ;; To add a new highlighter, simply define a function takes a single 39 ;; argument (a sexp, e.g. `(let ((a 1) (b 2)) (+ a b))') and 40 ;; highlights the names of the variables bound within that sexp. 41 ;; Then, let `lex-hl' know about it with `lex-hl-add-form'. 42 43 ;;; Code: 44 45 (require 'hi-lock) 46 47 48 ;;; Highlight an arbitrary symbol 49 50 (defun lex-hl-highlight-symbol (symbol) 51 "Highlight SYMBOL within the current buffer. 52 `highlight-symbol-at-point' checks the `current-prefix-arg' in 53 order to determine the face. This just uses an automatically 54 determined face." 55 (let* ((symbol-name 56 (symbol-name symbol)) 57 (regexp (hi-lock-regexp-okay 58 (format "\\_<%s\\_>" 59 (regexp-quote symbol-name)))) 60 (hi-lock-auto-select-face t) 61 (current-prefix-arg nil) 62 (face (hi-lock-read-face-name))) 63 (unless (string-prefix-p "_" symbol-name) 64 (hi-lock-mode t) 65 (hi-lock-set-pattern regexp face nil nil nil)))) 66 67 68 ;;; Define symbol-specific highlighters 69 70 (defvar lex-hl-forms nil 71 "A list of functions/macros that `lex-hl' can highlight.") 72 73 (defun lex-hl-add-form (symbol &optional function) 74 "Declare that FUNCTION highlights the variables bound by SYMBOL. 75 If FUNCTION is omitted or nil, `lex-hl--SYMBOL' will be used." 76 (put symbol 'lex-hl (or function (intern (format "lex-hl--%s" symbol)))) 77 (add-to-list 'lex-hl-forms (symbol-name symbol))) 78 79 80 ;;; Highlight variables for specific forms 81 82 (defun lex-hl--lambda-list (lambda-list) 83 "Highlight the variables bound in LAMBDA-LIST." 84 (dolist (symbol lambda-list) 85 (unless (string-prefix-p "&" (symbol-name symbol)) 86 (lex-hl-highlight-symbol symbol)))) 87 88 (defun lex-hl--defun (form) 89 "Highlight the variables bound by `defun' in FORM." 90 (lex-hl--lambda-list (nth 2 form))) 91 (lex-hl-add-form 'defun) 92 (lex-hl-add-form 'defmacro #'lex-hl--defun) 93 94 (defun lex-hl--lambda (form) 95 "Highlight the variables bound by `lambda' in FORM." 96 (lex-hl--lambda-list (nth 1 form))) 97 (lex-hl-add-form 'lambda) 98 99 (defun lex-hl--let (form) 100 "Highlight the variables bound by `let' in FORM." 101 (dolist (elt (nth 1 form)) 102 (let ((symbol (cond ((consp elt) 103 (car elt)) 104 ((symbolp elt) 105 elt)))) 106 (lex-hl-highlight-symbol symbol)))) 107 (lex-hl-add-form 'let) 108 (lex-hl-add-form 'let* #'lex-hl--let) 109 110 (defun lex-hl--dolist (form) 111 "Highlight the variable bound by `dolist' in FORM." 112 (let ((symbol (car (nth 1 form)))) 113 (lex-hl-highlight-symbol symbol))) 114 (lex-hl-add-form 'dolist) 115 116 (defun lex-hl--cl-labels (form) 117 "Highlight the functions bound by `cl-labels' in FORM. 118 This supports both the definitions and arguments." 119 (dolist (elt (nth 1 form)) 120 (lex-hl-highlight-symbol (nth 0 elt)) 121 (lex-hl--lambda-list (nth 1 elt)))) 122 (lex-hl-add-form 'cl-labels) 123 124 125 ;;; Convenient for defining commands 126 127 (defun lex-hl-generate-regexp () 128 "Generate a regexp based on `lex-hl-forms'." 129 (format "(%s" (regexp-opt lex-hl-forms t))) 130 131 (defun lex-hl-sexp-at-point () 132 "Highlight variables bound in the sexp at point." 133 (let* ((sexp (read (thing-at-point 'sexp))) 134 (symbol (car sexp))) 135 (funcall (or (get symbol 'lex-hl) 136 (error "`%s' not supported by `lex-hl'" symbol)) 137 sexp))) 138 139 140 ;;; User-facing commands 141 142 (defun lex-hl-unhighlight () 143 "Remove all hi-lock faces from the current buffer." 144 (interactive) 145 (hi-lock-unface-buffer t)) 146 147 ;;;###autoload 148 (defun lex-hl-top-level () 149 "Highlight variables bound in the top level form at point. 150 See the variable `lex-hl-forms' for a list of supported forms." 151 (interactive) 152 (save-excursion 153 (beginning-of-defun) 154 (lex-hl-sexp-at-point))) 155 156 ;;;###autoload 157 (defun lex-hl-prompt (bounds) 158 "Highlight variables bound in the form chosen from the minibuffer. 159 This is limited to the region specified by BOUNDS which, 160 interactively, is the top level form (aka defun) at point, or the 161 active region with a prefix argument." 162 (interactive (if current-prefix-arg 163 (region-bounds) 164 (list (bounds-of-thing-at-point 'defun)))) 165 (let ((beg (car bounds)) 166 (end (cdr bounds)) 167 alist) 168 (save-excursion 169 (goto-char beg) 170 (while (re-search-forward (lex-hl-generate-regexp) end :noerror) 171 (let ((match (match-beginning 0))) 172 (push (cons (buffer-substring match (line-end-position)) match) 173 alist))) 174 (setq alist (reverse alist)) 175 (goto-char (cdr (assoc (completing-read "Highlight variables in: " alist) 176 alist))) 177 (lex-hl-sexp-at-point)))) 178 179 ;;;###autoload 180 (defun lex-hl-nearest (n) 181 "Highlight variables bound in the Nth nearest form. 182 See the variable `lex-hl-forms' for a list of supported forms." 183 (interactive "P") 184 (let ((beg (car (bounds-of-thing-at-point 'defun)))) 185 (save-excursion 186 (re-search-backward (lex-hl-generate-regexp) 187 beg :noerror n) 188 (goto-char (match-beginning 0)) 189 (lex-hl-sexp-at-point)))) 190 191 192 ;;; Minor mode 193 194 (defvar lex-hl-mode-map 195 (let ((map (make-sparse-keymap))) 196 (define-key map (kbd "C-c `") #'lex-hl-unhighlight) 197 (define-key map (kbd "C-c '") #'lex-hl-top-level) 198 (define-key map (kbd "C-c ,") #'lex-hl-prompt) 199 (define-key map (kbd "C-c .") #'lex-hl-nearest) 200 map)) 201 202 ;;;###autoload 203 (define-minor-mode lex-hl-mode 204 "Add some keybindings to highlight lexical variables. 205 206 \\{lex-hl-mode-map}" 207 nil "" lex-hl-mode-map) 208 209 (provide 'lex-hl) 210 ;;; lex-hl.el ends here