lex-hl

git clone git://jamzattack.xyz/lex-hl.git
Log | Files | Refs

commit e1e2076bf817942a827cf562dd3ca644be8b71b7
Author: Jamie Beardslee <jdb@jamzattack.xyz>
Date:   Fri, 11 Sep 2020 18:08:40 +1200

Add lex-hl.el

Diffstat:
Alex-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