mirror of
https://gitlab.com/dwt1/dotfiles.git
synced 2026-04-23 03:20:26 +10:00
Updating Doom Emacs.
This commit is contained in:
Derek Taylor
@@ -22,57 +22,115 @@ to a pop up buffer."
|
||||
(error (error-message-string e))))
|
||||
(current-buffer)))
|
||||
|
||||
(defvar +emacs-lisp--face nil)
|
||||
|
||||
;;
|
||||
;;; Handlers
|
||||
|
||||
(defun +emacs-lisp--module-at-point ()
|
||||
(let ((origin (point)))
|
||||
(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))
|
||||
(goto-char origin)
|
||||
(while (not (sexp-at-point))
|
||||
(forward-symbol -1))
|
||||
(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))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp-highlight-vars-and-faces (end)
|
||||
"Match defined variables and functions.
|
||||
|
||||
Functions are differentiated into special forms, built-in functions and
|
||||
library/userland functions"
|
||||
(catch 'matcher
|
||||
(while (re-search-forward "\\(?:\\sw\\|\\s_\\)+" end t)
|
||||
(let ((ppss (save-excursion (syntax-ppss))))
|
||||
(cond ((nth 3 ppss) ; strings
|
||||
(search-forward "\"" end t))
|
||||
((nth 4 ppss) ; comments
|
||||
(forward-line +1))
|
||||
((let ((symbol (intern-soft (match-string-no-properties 0))))
|
||||
(and (cond ((null symbol) nil)
|
||||
((eq symbol t) nil)
|
||||
((special-variable-p symbol)
|
||||
(setq +emacs-lisp--face 'font-lock-variable-name-face))
|
||||
((and (fboundp symbol)
|
||||
(eq (char-before (match-beginning 0)) ?\()
|
||||
(not (memq (char-before (1- (match-beginning 0)))
|
||||
(list ?\' ?\`))))
|
||||
(let ((unaliased (indirect-function symbol)))
|
||||
(unless (or (macrop unaliased)
|
||||
(special-form-p unaliased))
|
||||
(let (unadvised)
|
||||
(while (not (eq (setq unadvised (ad-get-orig-definition unaliased))
|
||||
(setq unaliased (indirect-function unadvised)))))
|
||||
unaliased)
|
||||
(setq +emacs-lisp--face
|
||||
(if (subrp unaliased)
|
||||
'font-lock-constant-face
|
||||
'font-lock-function-name-face))))))
|
||||
(throw 'matcher t)))))))
|
||||
nil))
|
||||
|
||||
;; `+emacs-lisp-highlight-vars-and-faces' is a potentially expensive function
|
||||
;; and should be byte-compiled, no matter what, to ensure it runs as fast as
|
||||
;; possible:
|
||||
(unless (byte-code-function-p (symbol-function '+emacs-lisp-highlight-vars-and-faces))
|
||||
(with-no-warnings
|
||||
(byte-compile #'+emacs-lisp-highlight-vars-and-faces)))
|
||||
(defun +emacs-lisp-lookup-definition (_thing)
|
||||
"Lookup definition of THING."
|
||||
(if-let (module (+emacs-lisp--module-at-point))
|
||||
(doom/help-modules (car module) (cadr module) 'visit-dir)
|
||||
(call-interactively #'elisp-def)))
|
||||
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp-lookup-documentation (thing)
|
||||
"Lookup THING with `helpful-variable' if it's a variable, `helpful-callable'
|
||||
if it's callable, `apropos' otherwise."
|
||||
(if thing
|
||||
(doom/describe-symbol thing)
|
||||
(call-interactively #'doom/describe-symbol)))
|
||||
(cond ((when-let (module (+emacs-lisp--module-at-point))
|
||||
(doom/help-modules (car module) (cadr module))
|
||||
(when (eq major-mode 'org-mode)
|
||||
(with-demoted-errors "%s"
|
||||
(re-search-forward
|
||||
(if (caddr module)
|
||||
"\\* Module Flags$"
|
||||
"\\* Description$"))
|
||||
(when (caddr module)
|
||||
(re-search-forward (format "=\\%s=" (caddr module))
|
||||
nil t))
|
||||
(when (invisible-p (point))
|
||||
(org-show-hidden-entry))))
|
||||
'deferred))
|
||||
(thing (helpful-symbol (intern thing)))
|
||||
((call-interactively #'helpful-at-point))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp-indent-function (indent-point state)
|
||||
"A replacement for `lisp-indent-function'.
|
||||
|
||||
Indents plists more sensibly. Adapted from
|
||||
https://emacs.stackexchange.com/questions/10230/how-to-indent-keywords-aligned"
|
||||
(let ((normal-indent (current-column))
|
||||
(orig-point (point))
|
||||
;; TODO Refactor `target' usage (ew!)
|
||||
target)
|
||||
(goto-char (1+ (elt state 1)))
|
||||
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
|
||||
(cond ((and (elt state 2)
|
||||
(or (not (looking-at-p "\\sw\\|\\s_"))
|
||||
(eq (char-after) ?:)))
|
||||
(unless (> (save-excursion (forward-line 1) (point))
|
||||
calculate-lisp-indent-last-sexp)
|
||||
(goto-char calculate-lisp-indent-last-sexp)
|
||||
(beginning-of-line)
|
||||
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t))
|
||||
(backward-prefix-chars)
|
||||
(current-column))
|
||||
((and (save-excursion
|
||||
(goto-char indent-point)
|
||||
(skip-syntax-forward " ")
|
||||
(not (eq (char-after) ?:)))
|
||||
(save-excursion
|
||||
(goto-char orig-point)
|
||||
(and (eq (char-after) ?:)
|
||||
(eq (char-before) ?\()
|
||||
(setq target (current-column)))))
|
||||
(save-excursion
|
||||
(move-to-column target t)
|
||||
target))
|
||||
((let* ((function (buffer-substring (point) (progn (forward-sexp 1) (point))))
|
||||
(method (or (function-get (intern-soft function) 'lisp-indent-function)
|
||||
(get (intern-soft function) 'lisp-indent-hook))))
|
||||
(cond ((or (eq method 'defun)
|
||||
(and (null method)
|
||||
(> (length function) 3)
|
||||
(string-match-p "\\`def" function)))
|
||||
(lisp-indent-defform state indent-point))
|
||||
((integerp method)
|
||||
(lisp-indent-specform method state indent-point normal-indent))
|
||||
(method
|
||||
(funcall method indent-point state))))))))
|
||||
|
||||
|
||||
;;
|
||||
@@ -112,10 +170,30 @@ if it's callable, `apropos' otherwise."
|
||||
load-path)))
|
||||
(buttercup-run-discover)))
|
||||
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp/edebug-instrument-defun-on ()
|
||||
"Toggle on instrumentalisation for the function under `defun'."
|
||||
(interactive)
|
||||
(eval-defun 'edebugit))
|
||||
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp/edebug-instrument-defun-off ()
|
||||
"Toggle off instrumentalisation for the function under `defun'."
|
||||
(interactive)
|
||||
(eval-defun nil))
|
||||
|
||||
|
||||
;;
|
||||
;;; Hooks
|
||||
|
||||
(autoload 'straight-register-file-modification "straight")
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp-init-straight-maybe-h ()
|
||||
"Make sure straight sees modifications to installed packages."
|
||||
(when (file-in-directory-p (or buffer-file-name default-directory) doom-local-dir)
|
||||
(add-hook 'after-save-hook #'straight-register-file-modification
|
||||
nil 'local)))
|
||||
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp-extend-imenu-h ()
|
||||
"Improve imenu support in `emacs-lisp-mode', including recognition for Doom's API."
|
||||
@@ -128,7 +206,7 @@ if it's callable, `apropos' otherwise."
|
||||
("Minor modes" "^\\s-*(define-\\(?:global\\(?:ized\\)?-minor\\|generic\\|minor\\)-mode +\\([^ ()\n]+\\)" 1)
|
||||
("Modelines" "^\\s-*(def-modeline! +\\([^ ()\n]+\\)" 1)
|
||||
("Modeline segments" "^\\s-*(def-modeline-segment! +\\([^ ()\n]+\\)" 1)
|
||||
("Advice" "^\\s-*(\\(?:def\\(?:\\(?:ine\\)?-advice\\)\\) +\\([^ )\n]+\\)" 1)
|
||||
("Advice" "^\\s-*(\\(?:def\\(?:\\(?:ine-\\)?advice!?\\)\\) +\\([^ )\n]+\\)" 1)
|
||||
("Macros" "^\\s-*(\\(?:cl-\\)?def\\(?:ine-compile-macro\\|macro\\) +\\([^ )\n]+\\)" 1)
|
||||
("Inline functions" "\\s-*(\\(?:cl-\\)?defsubst +\\([^ )\n]+\\)" 1)
|
||||
("Functions" "^\\s-*(\\(?:cl-\\)?def\\(?:un\\|un\\*\\|method\\|generic\\|-memoized!\\) +\\([^ ,)\n]+\\)" 1)
|
||||
@@ -142,9 +220,8 @@ verbosity when editing a file in `doom-private-dir' or `doom-emacs-dir'."
|
||||
(when (and (bound-and-true-p flycheck-mode)
|
||||
(eq major-mode 'emacs-lisp-mode)
|
||||
(or (not buffer-file-name)
|
||||
(cl-loop for dir in (list doom-emacs-dir doom-private-dir)
|
||||
if (file-in-directory-p buffer-file-name dir)
|
||||
return t)))
|
||||
(cl-find-if (doom-partial #'file-in-directory-p buffer-file-name)
|
||||
+emacs-lisp-disable-flycheck-in-dirs)))
|
||||
(add-to-list (make-local-variable 'flycheck-disabled-checkers)
|
||||
'emacs-lisp-checkdoc)
|
||||
(set (make-local-variable 'flycheck-emacs-lisp-check-form)
|
||||
@@ -163,14 +240,64 @@ verbosity when editing a file in `doom-private-dir' or `doom-emacs-dir'."
|
||||
(default-value 'flycheck-emacs-lisp-check-form)
|
||||
")"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp/edebug-instrument-defun-on ()
|
||||
"Toggle on instrumentalisation for the function under `defun'."
|
||||
(interactive)
|
||||
(eval-defun 'edebugit))
|
||||
|
||||
;;
|
||||
;;; Fontification
|
||||
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp/edebug-instrument-defun-off ()
|
||||
"Toggle off instrumentalisation for the function under `defun'."
|
||||
(interactive)
|
||||
(eval-defun nil))
|
||||
(defun +emacs-lisp-truncate-pin ()
|
||||
"Truncates long SHA1 hashes in `package!' :pin's."
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(and (stringp (plist-get (sexp-at-point) :pin))
|
||||
(search-forward ":pin" nil t)
|
||||
(let ((start (re-search-forward "\"[^\"]\\{10\\}" nil t))
|
||||
(finish (and (re-search-forward "\"" (line-end-position) t)
|
||||
(match-beginning 0))))
|
||||
(when (and start finish)
|
||||
(put-text-property start finish 'display "...")))))
|
||||
nil)
|
||||
|
||||
(defvar +emacs-lisp--face nil)
|
||||
;;;###autoload
|
||||
(defun +emacs-lisp-highlight-vars-and-faces (end)
|
||||
"Match defined variables and functions.
|
||||
|
||||
Functions are differentiated into special forms, built-in functions and
|
||||
library/userland functions"
|
||||
(catch 'matcher
|
||||
(while (re-search-forward "\\(?:\\sw\\|\\s_\\)+" end t)
|
||||
(let ((ppss (save-excursion (syntax-ppss))))
|
||||
(cond ((nth 3 ppss) ; strings
|
||||
(search-forward "\"" end t))
|
||||
((nth 4 ppss) ; comments
|
||||
(forward-line +1))
|
||||
((let ((symbol (intern-soft (match-string-no-properties 0))))
|
||||
(and (cond ((null symbol) nil)
|
||||
((eq symbol t) nil)
|
||||
((special-variable-p symbol)
|
||||
(setq +emacs-lisp--face 'font-lock-variable-name-face))
|
||||
((and (fboundp symbol)
|
||||
(eq (char-before (match-beginning 0)) ?\()
|
||||
(not (memq (char-before (1- (match-beginning 0)))
|
||||
(list ?\' ?\`))))
|
||||
(let ((unaliased (indirect-function symbol)))
|
||||
(unless (or (macrop unaliased)
|
||||
(special-form-p unaliased))
|
||||
(let (unadvised)
|
||||
(while (not (eq (setq unadvised (ad-get-orig-definition unaliased))
|
||||
(setq unaliased (indirect-function unadvised)))))
|
||||
unaliased)
|
||||
(setq +emacs-lisp--face
|
||||
(if (subrp unaliased)
|
||||
'font-lock-constant-face
|
||||
'font-lock-function-name-face))))))
|
||||
(throw 'matcher t)))))))
|
||||
nil))
|
||||
|
||||
;; HACK Fontification is already expensive enough. We byte-compile
|
||||
;; `+emacs-lisp-highlight-vars-and-faces' and `+emacs-lisp-truncate-pin' to
|
||||
;; ensure they run as fast as possible:
|
||||
(dolist (fn '(+emacs-lisp-highlight-vars-and-faces +emacs-lisp-truncate-pin))
|
||||
(unless (byte-code-function-p (symbol-function fn))
|
||||
(with-no-warnings (byte-compile fn))))
|
||||
|
||||
Reference in New Issue
Block a user