emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

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

Browse source 
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
1 changed files with 47 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

71
modules/lang/emacs-lisp/autoload.el
View file

@ -29,35 +29,54 @@ to a pop up buffer."
;;; Handlers
(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
(goto-char (point-min))
(when (re-search-forward "(doom! " nil 'noerror)
(goto-char (match-beginning 0))
(cl-destructuring-bind (beg . end)
(bounds-of-thing-at-point 'sexp)
(when (and (>= origin beg)
(<= origin end))
(let ((parens (ppss-open-parens syntax))
(doom-depth 1))
(while (and parens (progn (goto-char (car parens))
(not (looking-at "(doom!\\_>"))))
(setq parens (cdr parens)
doom-depth (1+ doom-depth)))
(when parens ;; Are we inside a `doom!' block?
(goto-char origin)
(while (not (sexp-at-point))
(forward-symbol -1))
(let* ((doom-start (car parens))
(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)
(cond ((keywordp (setq category (sexp-at-point)))
(while (keywordp (sexp-at-point))
(forward-sexp 1))
(setq module (car (doom-enlist (sexp-at-point)))))
((and (symbolp (setq module (sexp-at-point)))
(string-prefix-p "+" (symbol-name module)))
(while (symbolp (sexp-at-point))
(thing-at-point--beginning-of-sexp))
(setq flag module
module (car (sexp-at-point)))
(when (re-search-backward "\\_<:\\w+\\_>" nil t)
(setq category (sexp-at-point))))
((symbolp module)
(when (re-search-backward "\\_<:\\w+\\_>" nil t)
(setq category (sexp-at-point)))))
(list 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
(defun +emacs-lisp-lookup-definition (_thing)