Merge pull request #4926 from Janfel/fix-emacs-lisp-module-at-point

Reimplement +emacs-lisp--module-at-point to fix #4896
This commit is contained in:
Henrik Lissner 2021-05-01 01:42:38 -04:00 committed by GitHub
commit 4ad1c6a494
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23

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