Skip to content

Instantly share code, notes, and snippets.

@narendraj9
Last active June 8, 2019 19:27
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save narendraj9/9e98aa5e227f3fbf46a041728cf841b2 to your computer and use it in GitHub Desktop.
Save narendraj9/9e98aa5e227f3fbf46a041728cf841b2 to your computer and use it in GitHub Desktop.
(require 'treepy)
(require 'parseclj)
(defun let-binding-point* (root s-value s-position)
"Return position for let binding in `ROOT' for `S-VALUE' at `S-POSITION'."
(let ((current-zipper (treepy-zipper (lambda (n) (assoc-default :children n))
(lambda (n) (assoc-default :children n))
(lambda (n children) (cons (cons :children children) n))
root)))
(while (and (not (treepy-end-p current-zipper))
(not (= s-position
(assoc-default :position (treepy-node current-zipper)))))
(setq current-zipper (treepy-next current-zipper)))
(catch 'binding-position
(when (treepy-end-p current-zipper)
(throw 'binding-position nil))
(while (and current-zipper
(not (treepy-end-p current-zipper)))
(let ((leftmost-form (treepy-leftmost current-zipper)))
(when (equal 'let (assoc-default :value (treepy-node leftmost-form)))
(when-let ((p (->> leftmost-form
(treepy-right)
(treepy-node)
(assoc-default :children)
(seq-filter (lambda (v)
(equal (assoc-default :value v)
s-value)))
(car)
(assoc-default :position))))
(throw 'binding-position p)))
(setq current-zipper (treepy-up current-zipper)))))))
(defun let-binding-point ()
"Jump to neared enclosing let binding for (`symbol-at-point')."
(interactive)
(if-let ((s-value (symbol-at-point))
(s-position (car (bounds-of-thing-at-point 'symbol))))
(if-let ((b-position (save-excursion
(beginning-of-defun)
(let-binding-point* (parseclj-parse-clojure :read-one t)
s-value
s-position))))
(goto-char b-position)
(message "Couldn't find local binding for %s" s-value))
(message "No symbol at point")))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment