45cdfb1258
spudlyo/clipetty@7ee3f9c -> spudlyo/clipetty@01b3904 bbatsov/projectile@eec569d -> bbatsov/projectile@5cd261d noctuid/general.el@14ad4c8 -> noctuid/general.el@42e3803 We're also transitioning from abbreviated SHA1 hashes to full ones, because underlying git machinery in future updates of straight will require it (e.g. to obtain shallow clones of pinned packages).
247 lines
11 KiB
EmacsLisp
247 lines
11 KiB
EmacsLisp
;;; lang/emacs-lisp/autoload.el -*- lexical-binding: t; -*-
|
|
|
|
;;
|
|
;;; Library
|
|
|
|
;;;###autoload
|
|
(defun +emacs-lisp-eval (beg end)
|
|
"Evaluate a region and print it to the echo area (if one line long), otherwise
|
|
to a pop up buffer."
|
|
(+eval-display-results
|
|
(string-trim-right
|
|
(condition-case-unless-debug e
|
|
(let ((result
|
|
(let ((debug-on-error t))
|
|
(eval (read (format "(progn %s)" (buffer-substring-no-properties beg end)))
|
|
`((buffer-file-name . ,(buffer-file-name (buffer-base-buffer)))
|
|
(doom--current-module
|
|
. ,(ignore-errors
|
|
(doom-module-from-path buffer-file-name))))))))
|
|
(require 'pp)
|
|
(replace-regexp-in-string "\\\\n" "\n" (pp-to-string result)))
|
|
(error (error-message-string e))))
|
|
(current-buffer)))
|
|
|
|
(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))
|
|
|
|
;; `+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--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-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."
|
|
(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))))
|
|
|
|
;; FIXME
|
|
;; (defun +emacs-lisp-lookup-file (thing)
|
|
;; (when-let (module (+emacs-lisp--module-at-point thing))
|
|
;; (doom/help-modules (car module) (cadr module) 'visit-dir)
|
|
;; t))
|
|
|
|
|
|
;;
|
|
;;; Commands
|
|
|
|
;;;###autoload
|
|
(defun +emacs-lisp/open-repl ()
|
|
"Open the Emacs Lisp REPL (`ielm')."
|
|
(interactive)
|
|
(pop-to-buffer
|
|
(or (get-buffer "*ielm*")
|
|
(progn (ielm)
|
|
(let ((buf (get-buffer "*ielm*")))
|
|
(bury-buffer buf)
|
|
buf)))))
|
|
|
|
;;;###autoload
|
|
(defun +emacs-lisp/buttercup-run-file ()
|
|
"Run all buttercup tests in the focused buffer."
|
|
(interactive)
|
|
(let ((load-path (append (list (doom-path (dir!) "..")
|
|
(or (doom-project-root)
|
|
default-directory))
|
|
load-path)))
|
|
(save-selected-window
|
|
(eval-buffer)
|
|
(buttercup-run))
|
|
(message "File executed successfully")))
|
|
|
|
;;;###autoload
|
|
(defun +emacs-lisp/buttercup-run-project ()
|
|
"Run all buttercup tests in the project."
|
|
(interactive)
|
|
(let* ((default-directory (doom-project-root))
|
|
(load-path (append (list (doom-path "test")
|
|
default-directory)
|
|
load-path)))
|
|
(buttercup-run-discover)))
|
|
|
|
|
|
;;
|
|
;;; Hooks
|
|
|
|
;;;###autoload
|
|
(defun +emacs-lisp-extend-imenu-h ()
|
|
"Improve imenu support in `emacs-lisp-mode', including recognition for Doom's API."
|
|
(setq imenu-generic-expression
|
|
`(("Section" "^[ \t]*;;;;*[ \t]+\\([^\n]+\\)" 1)
|
|
("Evil commands" "^\\s-*(evil-define-\\(?:command\\|operator\\|motion\\) +\\(\\_<[^ ()\n]+\\_>\\)" 1)
|
|
("Unit tests" "^\\s-*(\\(?:ert-deftest\\|describe\\) +\"\\([^\")]+\\)\"" 1)
|
|
("Package" "^\\s-*(\\(?:;;;###package\\|package!\\|use-package!?\\|after!\\) +\\(\\_<[^ ()\n]+\\_>\\)" 1)
|
|
("Major modes" "^\\s-*(define-derived-mode +\\([^ ()\n]+\\)" 1)
|
|
("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)
|
|
("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)
|
|
("Variables" "^\\s-*(\\(def\\(?:c\\(?:onst\\(?:ant\\)?\\|ustom\\)\\|ine-symbol-macro\\|parameter\\|var\\(?:-local\\)?\\)\\)\\s-+\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)" 2)
|
|
("Types" "^\\s-*(\\(cl-def\\(?:struct\\|type\\)\\|def\\(?:class\\|face\\|group\\|ine-\\(?:condition\\|error\\|widget\\)\\|package\\|struct\\|t\\(?:\\(?:hem\\|yp\\)e\\)\\)\\)\\s-+'?\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)" 2))))
|
|
|
|
;;;###autoload
|
|
(defun +emacs-lisp-reduce-flycheck-errors-in-emacs-config-h ()
|
|
"Remove `emacs-lisp-checkdoc' checker and reduce `emacs-lisp' checker
|
|
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)))
|
|
(add-to-list (make-local-variable 'flycheck-disabled-checkers)
|
|
'emacs-lisp-checkdoc)
|
|
(set (make-local-variable 'flycheck-emacs-lisp-check-form)
|
|
(concat "(progn "
|
|
(prin1-to-string
|
|
`(progn
|
|
(setq doom-modules ',doom-modules
|
|
doom-disabled-packages ',doom-disabled-packages)
|
|
(ignore-errors (load ,user-init-file t t))
|
|
(setq byte-compile-warnings
|
|
'(obsolete cl-functions
|
|
interactive-only make-local mapcar
|
|
suspicious constants))
|
|
(defmacro map! (&rest _))))
|
|
" "
|
|
(default-value 'flycheck-emacs-lisp-check-form)
|
|
")"))))
|
|
|
|
;;;###autoload
|
|
(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)
|
|
(put-text-property (re-search-forward "\"[^\"]\\{10\\}" nil t)
|
|
(progn (re-search-forward "\"" nil t)
|
|
(match-beginning 0))
|
|
'display "...")))
|
|
nil)
|
|
|
|
;;;###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))
|