Reimplement +emacs-lisp--module-at-point

This commit is contained in:
Jan Felix Langenbach 2021-04-26 00:24:39 +02:00
parent f621ff8047
commit acb0399424

View file

@ -29,35 +29,54 @@ to a pop up buffer."
;;; Handlers ;;; Handlers
(defun +emacs-lisp--module-at-point () (defun +emacs-lisp--module-at-point ()
(let ((origin (point))) "Return (CATEGORY MODULE FLAG) at point inside a `doom!' block."
(save-excursion (let ((origin (point))
(goto-char (point-min)) (syntax (syntax-ppss)))
(when (re-search-forward "(doom! " nil 'noerror) (when (and (> (ppss-depth syntax) 0) (not (ppss-string-terminator syntax)))
(goto-char (match-beginning 0)) (save-excursion
(cl-destructuring-bind (beg . end) (let ((parens (ppss-open-parens syntax))
(bounds-of-thing-at-point 'sexp) (doom-depth 1))
(when (and (>= origin beg) (while (and parens (progn (goto-char (car parens))
(<= origin end)) (not (looking-at "(doom!\\_>"))))
(setq parens (cdr parens)
doom-depth (1+ doom-depth)))
(when parens ;; Are we inside a `doom!' block?
(goto-char origin) (goto-char origin)
(while (not (sexp-at-point)) (let* ((doom-start (car parens))
(forward-symbol -1)) (bare-symbol
(let (category module flag) (if (ppss-comment-depth syntax)
(cond ((keywordp (setq category (sexp-at-point))) (= (save-excursion (beginning-of-thing 'list)) doom-start)
(while (keywordp (sexp-at-point)) (null (cdr parens))))
(forward-sexp 1)) (sexp-start (if bare-symbol
(setq module (car (doom-enlist (sexp-at-point))))) (beginning-of-thing 'symbol)
((and (symbolp (setq module (sexp-at-point))) (or (cadr parens) (beginning-of-thing 'list))))
(string-prefix-p "+" (symbol-name module))) (match-start nil))
(while (symbolp (sexp-at-point)) (goto-char sexp-start)
(thing-at-point--beginning-of-sexp)) (while (and (not match-start)
(setq flag module (re-search-backward
module (car (sexp-at-point))) "\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" ;; Find a keyword.
(when (re-search-backward "\\_<:\\w+\\_>" nil t) doom-start 'noerror))
(setq category (sexp-at-point)))) (unless (looking-back "(")
((symbolp module) (let ((kw-syntax (syntax-ppss)))
(when (re-search-backward "\\_<:\\w+\\_>" nil t) (when (and (= (ppss-depth kw-syntax) doom-depth)
(setq category (sexp-at-point))))) (not (ppss-string-terminator kw-syntax))
(list category module flag)))))))) (not (ppss-comment-depth kw-syntax)))
(setq match-start (point))))))
(when match-start
(let (category module flag)
;; `point' is already at `match-start'.
(setq category (symbol-at-point))
(goto-char origin)
(if bare-symbol
(setq module (symbol-at-point))
(let ((symbol (symbol-at-point))
(head (car (list-at-point))))
(if (and (symbolp head) (not (keywordp head))
(not (eq head symbol)))
(setq module head
flag symbol)
(setq module symbol))))
(list category module flag))))))))))
;;;###autoload ;;;###autoload
(defun +emacs-lisp-lookup-definition (_thing) (defun +emacs-lisp-lookup-definition (_thing)