2017-06-08 11:47:56 +02:00
|
|
|
;;; lang/emacs-lisp/autoload.el -*- lexical-binding: t; -*-
|
2017-01-16 23:30:11 -05:00
|
|
|
|
2018-05-25 00:46:11 +02:00
|
|
|
;;
|
2019-05-01 19:12:52 -04:00
|
|
|
;;; Library
|
2018-05-25 00:46:11 +02:00
|
|
|
|
2017-05-07 02:27:54 +02:00
|
|
|
;;;###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."
|
2019-10-26 01:37:36 -04:00
|
|
|
(+eval-display-results
|
2019-11-24 19:40:00 -05:00
|
|
|
(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))))
|
2019-10-26 01:37:36 -04:00
|
|
|
(current-buffer)))
|
2018-08-21 00:04:48 +02:00
|
|
|
|
|
|
|
|
(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
|
2019-05-20 20:17:05 -04:00
|
|
|
(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)
|
2019-07-18 12:16:44 +02:00
|
|
|
(eq (char-before (match-beginning 0)) ?\()
|
|
|
|
|
(not (memq (char-before (1- (match-beginning 0)))
|
|
|
|
|
(list ?\' ?\`))))
|
2019-05-20 20:17:05 -04:00
|
|
|
(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)))))))
|
2018-08-21 00:04:48 +02:00
|
|
|
nil))
|
|
|
|
|
|
2019-07-21 23:31:42 +02:00
|
|
|
;; `+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)))
|
|
|
|
|
|
2019-12-25 22:54:15 -05:00
|
|
|
|
|
|
|
|
(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))
|
2020-02-06 15:30:50 -05:00
|
|
|
(thing-at-point--beginning-of-sexp))
|
2019-12-25 22:54:15 -05:00
|
|
|
(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
|
2020-02-06 15:30:50 -05:00
|
|
|
(defun +emacs-lisp-lookup-definition (_thing)
|
2019-12-25 22:54:15 -05:00
|
|
|
"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)))
|
|
|
|
|
|
2019-05-01 19:14:43 -04:00
|
|
|
;;;###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."
|
2019-12-27 04:44:20 -05:00
|
|
|
(cond ((when-let (module (+emacs-lisp--module-at-point))
|
2019-12-25 22:54:15 -05:00
|
|
|
(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))))
|
2020-01-12 22:35:03 -05:00
|
|
|
'deferred))
|
2020-01-11 17:21:35 -05:00
|
|
|
(thing (helpful-symbol (intern thing)))
|
|
|
|
|
((call-interactively #'helpful-at-point))))
|
2019-12-25 22:54:15 -05:00
|
|
|
|
|
|
|
|
;; 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))
|
2019-05-01 19:14:43 -04:00
|
|
|
|
2018-08-21 00:04:48 +02:00
|
|
|
|
|
|
|
|
;;
|
2019-05-01 19:12:52 -04:00
|
|
|
;;; Commands
|
2018-08-21 00:04:48 +02:00
|
|
|
|
|
|
|
|
;;;###autoload
|
2019-02-18 01:56:38 -05:00
|
|
|
(defun +emacs-lisp/open-repl ()
|
2018-08-21 00:04:48 +02:00
|
|
|
"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)))))
|
2019-07-25 12:56:34 +02:00
|
|
|
|
|
|
|
|
;;;###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")))
|
2019-07-27 11:33:41 +02:00
|
|
|
|
|
|
|
|
;;;###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)))
|
2018-08-21 00:04:48 +02:00
|
|
|
|
|
|
|
|
|
|
|
|
|
;;
|
2019-05-01 19:12:52 -04:00
|
|
|
;;; Hooks
|
2018-08-21 00:04:48 +02:00
|
|
|
|
|
|
|
|
;;;###autoload
|
2019-07-18 15:27:20 +02:00
|
|
|
(defun +emacs-lisp-extend-imenu-h ()
|
2019-05-01 19:13:44 -04:00
|
|
|
"Improve imenu support in `emacs-lisp-mode', including recognition for Doom's API."
|
2018-08-21 00:04:48 +02:00
|
|
|
(setq imenu-generic-expression
|
2019-06-16 14:36:10 +02:00
|
|
|
`(("Section" "^[ \t]*;;;;*[ \t]+\\([^\n]+\\)" 1)
|
2019-05-01 19:13:44 -04:00
|
|
|
("Evil commands" "^\\s-*(evil-define-\\(?:command\\|operator\\|motion\\) +\\(\\_<[^ ()\n]+\\_>\\)" 1)
|
2018-08-21 00:04:48 +02:00
|
|
|
("Unit tests" "^\\s-*(\\(?:ert-deftest\\|describe\\) +\"\\([^\")]+\\)\"" 1)
|
2019-09-13 13:58:43 -04:00
|
|
|
("Package" "^\\s-*(\\(?:;;;###package\\|package!\\|use-package!?\\|after!\\) +\\(\\_<[^ ()\n]+\\_>\\)" 1)
|
2018-08-21 00:04:48 +02:00
|
|
|
("Major modes" "^\\s-*(define-derived-mode +\\([^ ()\n]+\\)" 1)
|
2019-05-01 19:13:44 -04:00
|
|
|
("Minor modes" "^\\s-*(define-\\(?:global\\(?:ized\\)?-minor\\|generic\\|minor\\)-mode +\\([^ ()\n]+\\)" 1)
|
2018-08-21 00:04:48 +02:00
|
|
|
("Modelines" "^\\s-*(def-modeline! +\\([^ ()\n]+\\)" 1)
|
2019-03-09 02:42:03 -05:00
|
|
|
("Modeline segments" "^\\s-*(def-modeline-segment! +\\([^ ()\n]+\\)" 1)
|
2020-02-21 10:41:45 -05:00
|
|
|
("Advice" "^\\s-*(\\(?:def\\(?:\\(?:ine-\\)?advice!?\\)\\) +\\([^ )\n]+\\)" 1)
|
2018-08-21 00:04:48 +02:00
|
|
|
("Macros" "^\\s-*(\\(?:cl-\\)?def\\(?:ine-compile-macro\\|macro\\) +\\([^ )\n]+\\)" 1)
|
2019-03-09 02:42:03 -05:00
|
|
|
("Inline functions" "\\s-*(\\(?:cl-\\)?defsubst +\\([^ )\n]+\\)" 1)
|
2018-08-21 00:04:48 +02:00
|
|
|
("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
|
2019-07-18 15:27:20 +02:00
|
|
|
(defun +emacs-lisp-reduce-flycheck-errors-in-emacs-config-h ()
|
2019-05-02 20:42:43 -04:00
|
|
|
"Remove `emacs-lisp-checkdoc' checker and reduce `emacs-lisp' checker
|
|
|
|
|
verbosity when editing a file in `doom-private-dir' or `doom-emacs-dir'."
|
2018-08-21 00:04:48 +02:00
|
|
|
(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)))
|
2019-05-02 20:42:43 -04:00
|
|
|
(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
|
2019-05-03 13:39:00 -04:00
|
|
|
(setq doom-modules ',doom-modules
|
2019-05-21 17:29:29 -04:00
|
|
|
doom-disabled-packages ',doom-disabled-packages)
|
|
|
|
|
(ignore-errors (load ,user-init-file t t))
|
|
|
|
|
(setq byte-compile-warnings
|
2019-05-02 20:42:43 -04:00
|
|
|
'(obsolete cl-functions
|
|
|
|
|
interactive-only make-local mapcar
|
2019-05-21 17:29:29 -04:00
|
|
|
suspicious constants))
|
|
|
|
|
(defmacro map! (&rest _))))
|
2019-05-02 20:42:43 -04:00
|
|
|
" "
|
|
|
|
|
(default-value 'flycheck-emacs-lisp-check-form)
|
|
|
|
|
")"))))
|
2019-09-19 13:56:38 +09:00
|
|
|
|
2020-04-29 23:09:46 -04:00
|
|
|
;;;###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)
|
2020-04-30 02:31:51 -04:00
|
|
|
(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 "...")))))
|
2020-04-29 23:09:46 -04:00
|
|
|
nil)
|
|
|
|
|
|
2020-04-30 15:54:36 -04:00
|
|
|
;;;###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))
|
2020-05-01 02:14:57 -04:00
|
|
|
(orig-point (point))
|
|
|
|
|
;; TODO Refactor `target' usage (ew!)
|
|
|
|
|
target)
|
2020-04-30 15:54:36 -04:00
|
|
|
(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)
|
2020-05-01 02:14:57 -04:00
|
|
|
(and (eq (char-after) ?:)
|
2020-05-05 03:31:43 -04:00
|
|
|
(eq (char-before) ?\()
|
2020-05-01 02:14:57 -04:00
|
|
|
(setq target (current-column)))))
|
2020-04-30 15:54:36 -04:00
|
|
|
(save-excursion
|
2020-05-01 02:14:57 -04:00
|
|
|
(move-to-column target t)
|
|
|
|
|
target))
|
2020-04-30 15:54:36 -04:00
|
|
|
((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)
|
2020-05-01 02:14:57 -04:00
|
|
|
(lisp-indent-specform method state indent-point normal-indent))
|
2020-04-30 15:54:36 -04:00
|
|
|
(method
|
|
|
|
|
(funcall method indent-point state))))))))
|
|
|
|
|
|
2019-09-19 13:56:38 +09:00
|
|
|
;;;###autoload
|
2019-09-19 23:01:08 +09:00
|
|
|
(defun +emacs-lisp/edebug-instrument-defun-on ()
|
2019-09-19 13:56:38 +09:00
|
|
|
"Toggle on instrumentalisation for the function under `defun'."
|
|
|
|
|
(interactive)
|
|
|
|
|
(eval-defun 'edebugit))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
2019-09-19 23:01:08 +09:00
|
|
|
(defun +emacs-lisp/edebug-instrument-defun-off ()
|
2019-09-19 13:56:38 +09:00
|
|
|
"Toggle off instrumentalisation for the function under `defun'."
|
|
|
|
|
(interactive)
|
|
|
|
|
(eval-defun nil))
|
