[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Is there a "selective setq locator/highlighter" anywhere? There is n
From: |
Alan Mackenzie |
Subject: |
Re: Is there a "selective setq locator/highlighter" anywhere? There is now! |
Date: |
Fri, 23 Jan 2009 15:58:57 +0000 |
User-agent: |
Mutt/1.5.9i |
Hi, Davis!
On Thu, Jan 22, 2009 at 10:06:28AM -0800, Davis Herring wrote:
> > I would like a tool which would highlight these:
> > (setq foo bar
> > c-state-cache (cdr c-state-cache))
> > (setcar c-state-cache (caar c-state-cache))
> > , but not this:
> > (setq old-cache c-state-cache)
> Not a polished tool, by any means, but can't you just do
[ .... ]
> Wrap in defuns/commands as desired.
Thanks! In the end, I just threw it together, and it rapidly converged
to something functional. It handles setq, setc[ad]r and let\*?,
arbitrarily nested. For some reason, I was thinking of a solution which
would first read (as in read/eval/print loop) a defun and then step
through the structure. This was silly. ;-) Anyhow, here it is for
anybody interested. It uses hi-lock-mode a little bit:
#########################################################################
;; Selective setq highlighting:
;;
;; Given a symbol, locate and/or highlight all places where the symbol's value
;; is changed; currently this means "(setq foo" (including multiple versions
;; of it), "(setcar foo" or "(setcdr foo", or "(let (...(foo ..)" or
;; "(let*...".
(defun sshi-forward-WS ()
(save-match-data
(forward-comment 1048575)
(search-forward-regexp "[[:space:]]*")))
(defun sshi-sym-value ()
"Parse the symbol followed by a sexp at point.
Return the positions of the symbol/sexp as a dotted pair of
dotted pairs like this
((SYM-START . SYM-END) . (SEXP-START . SEXP-END)).
Point is left after any WS/comments at sexp-end.
On error, throw an error."
(let (sym-pos sexp-start)
(if (looking-at "\\(\\(\\w\\|\\s_\\)+\\_>\\)") ; a symbol.
;; 1 2 2 1
(progn
(setq sym-pos (cons (match-beginning 1) (match-end 1)))
(goto-char (match-end 0))
(sshi-forward-WS)
(setq sexp-start (point))
(condition-case nil
(forward-sexp)
(error
(error "sshi-sym-value: invalid sexp at %s" (point)))))
(error "sshi-sym-value: missing symbol at %s" (point)))
(prog1 (cons sym-pos (cons sexp-start (point)))
(sshi-forward-WS))))
(defun sshi-push-sym-sexps (sym places)
" Push the locations of SYM settings onto PLACES, returning PLACES.
This includes any setq's etc. recursively contained in the sexp.
Point should be at a symbol in a \"setq\" type construct. Point
is left after WS/comments after the sexp."
(let ((sym-val (sshi-sym-value)))
(if (string=
(buffer-substring-no-properties (caar sym-val) (cdar sym-val))
sym)
(push (car sym-val) places))
(when (eq (char-after (cadr sym-val)) ?\()
(goto-char (cadr sym-val))
(setq places
(append (save-restriction
(narrow-to-region (cadr sym-val) (cddr sym-val))
(sshi-list sym))
places))
(sshi-forward-WS))
places))
(defun sshi-list (sym)
"Return a list of places within the current restriction where SYM is set.
This is a list of dotted pairs of the form (BEGIN-SYM . END-SYM).
The current restriction should exactly contain a list, and point
should be at (point-min) on entry. Point is left at (point-max)
at exit."
(let (places sym-start)
(forward-char) ; over ?\(
(sshi-forward-WS)
(while (/= (char-after) ?\))
(cond
((looking-at "(\\(setc[ad]r\\_>\\)")
(goto-char (match-end 0)) (sshi-forward-WS)
(setq places (sshi-push-sym-sexps sym places))
(sshi-forward-WS)
(forward-char) ; over ?\)
(sshi-forward-WS))
((looking-at "(\\(setq\\_>\\)")
(goto-char (match-end 0)) (sshi-forward-WS)
(while (/= (char-after) ?\))
(setq places (sshi-push-sym-sexps sym places))
(sshi-forward-WS))
(forward-char) (sshi-forward-WS)) ; over ?\)
((looking-at "(\\(let\\*?\\_>\\)")
(goto-char (match-end 0)) (sshi-forward-WS)
(or (eq (char-after) ?\()
(error "sshi: missing bindings list at %s" (point)))
(forward-char) (sshi-forward-WS) ; over ?\(
(while (/= (char-after) ?\))
(if (eq (char-after) ?\() ; binding with initialisation
(progn
(forward-char) (sshi-forward-WS) ; over ?\( of a single binding.
(setq places (sshi-push-sym-sexps sym places))
(forward-char)) ; over terminating ?\) of the binding
(setq sym-start (point)) ; symbol (initialised implicitly to nil)
(forward-sexp)
(if (string= (buffer-substring sym-start (point)) sym)
(push (cons sym-start (point)) places))
(sshi-forward-WS)))
(forward-char) (sshi-forward-WS)) ; over ?\) enclosing all bindings
((eq (char-after) ?\()
(mark-sexp)
(save-restriction
(narrow-to-region (point) (mark))
(setq places (append (sshi-list sym) places)))
(sshi-forward-WS))
(t (forward-sexp) (sshi-forward-WS))))
(forward-char) ; over ?\)
places))
(defvar sshi-symbol-hist nil
"The symbol history list used by selective-setq")
(defun sshi-defun (arg sym face)
"Highlight SYM each place within the current defun where it is setq'd or
setc[ad]r'd.
With a prefix arg, remove the highlighting for SYM."
(interactive
(list
current-prefix-arg
(let* ((sym (symbol-at-point))
(s (and sym (symbol-name sym))))
(read-string
"Symbol: " ; prompt
s ; initial-input
'sshi-symbol-hist ; history
s))
(unless current-prefix-arg (hi-lock-read-face-name))))
(save-excursion
(save-restriction
(narrow-to-defun)
;(beginning-of-defun)
(goto-char (point-min)) ; beginning-of-defun drops a mark. :-(
(let ((places (sshi-list sym)))
(mapc
(lambda (elt)
(let* (ov ovs)
(setq ovs (overlays-at (car elt)))
(while (and ovs
(setq ov (car ovs))
(not (overlay-get ov 'sshi)))
(setq ovs (cdr ovs)))
(when ovs
(delete-overlay ov))
(unless arg
(setq ov (make-overlay (car elt) (cdr elt) nil nil nil))
(overlay-put ov 'sshi t)
(overlay-put ov 'face face))))
places)))))
(define-key emacs-lisp-mode-map "\C-xwz" 'sshi-defun)
#########################################################################
> Davis
--
Alan Mackenzie (Nuremberg, Germany).