lex-hl

Highlight lexically bound variables
git clone https://git.jamzattack.xyz/lex-hl
Log | Files | Refs | LICENSE

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