doomemacs/core/core-lib.el

310 lines
12 KiB
EmacsLisp

;;; core-lib.el
(require 'dash)
(require 's)
(require 'f)
(defvar __DIR__ nil "The directory of the currently loaded file (set by `@load')")
(defvar __FILE__ nil "The full path of the currently loaded file (set by `@load')")
(defun __DIR__ ()
"Get the full path to the current file's parent folder."
(or __DIR__
(and load-file-name (f-dirname load-file-name))
(and buffer-file-name (f-dirname buffer-file-name))
default-directory
(and (bound-and-true-p byte-compile-current-file)
(f-dirname byte-compile-current-file))
(error "__DIR__ is unset")))
(defun __FILE__ ()
"Get the full path to the current file."
(or __FILE__
load-file-name
buffer-file-name
(and (bound-and-true-p byte-compile-current-file)
byte-compile-current-file)
(error "__FILE__ is unset")))
(@package anaphora
:commands (awhen aif acond awhile))
(@package async
:commands (async-start
async-start-process
async-byte-recompile-directory))
(@package persistent-soft
:preface (defvar pcache-directory (concat doom-cache-dir "pcache/"))
:commands (persistent-soft-exists-p
persistent-soft-fetch
persistent-soft-flush
persistent-soft-store))
;;
;; Library
;;
(defmacro (&rest body)
"A shortcut for inline interactive lambdas."
(declare (doc-string 1))
`(lambda () (interactive) ,@body))
(defmacro @after (feature &rest forms)
"A smart wrapper around `with-eval-after-load'. Supresses warnings during
compilation."
(declare (indent defun) (debug t))
`(,(if (or (not (boundp 'byte-compile-current-file))
(not byte-compile-current-file)
(if (symbolp feature)
(require feature nil :no-error)
(load feature :no-message :no-error)))
'progn
'with-no-warnings)
(with-eval-after-load ',feature ,@forms)))
(defmacro @quiet (&rest forms)
"Run FORMS without making any noise."
`(progn
(fset 'doom--old-write-region-fn (symbol-function 'write-region))
(cl-letf ((standard-output (lambda (&rest _)))
((symbol-function 'load-file) (lambda (file) (load file nil t)))
((symbol-function 'message) (lambda (&rest _)))
((symbol-function 'write-region)
(lambda (start end filename &optional append visit lockname mustbenew)
(unless visit (setq visit 'no-message))
(doom--old-write-region-fn start end filename append visit lockname mustbenew)))
(inhibit-message t)
(save-silently t))
,@forms)))
(defmacro @add-hook (hook &rest func-or-forms)
"A convenience macro for `add-hook'.
HOOK can be one hook or a list of hooks. If the hook(s) are not quoted, -hook is
appended to them automatically. If they are quoted, they are used verbatim.
FUNC-OR-FORMS can be a quoted symbol, a list of quoted symbols, or forms. Forms
will be wrapped in a lambda. A list of symbols will expand into a series of
add-hook calls.
Examples:
(@add-hook 'some-mode-hook 'enable-something)
(@add-hook some-mode '(enable-something and-another))
(@add-hook '(one-mode-hook second-mode-hook) 'enable-something)
(@add-hook (one-mode second-mode) 'enable-something)
(@add-hook (one-mode second-mode) (setq v 5) (setq a 2))"
(declare (indent defun) (debug t))
(unless func-or-forms
(error "@add-hook: FUNC-OR-FORMS is empty"))
(let* ((val (car func-or-forms))
(quoted-p (eq (car-safe hook) 'quote))
(hook (if quoted-p (cadr hook) hook))
(funcs (if (eq (car-safe val) 'quote)
(if (cdr-safe (cadr val))
(cadr val)
(list (cadr val)))
(list func-or-forms))))
(macroexp-progn
(mapcar (lambda (f)
(let ((func (if (symbolp f) `(quote ,f) `(lambda (&rest _) ,@func-or-forms))))
(macroexp-progn
(mapcar (lambda (h)
`(add-hook ',(if quoted-p h (intern (format "%s-hook" h))) ,func))
(-list hook)))))
funcs))))
(defmacro @associate (mode &rest plist)
"Associate a major or minor mode to certain patterns and project files."
(declare (indent 1))
(unless noninteractive
(let* ((minor (plist-get plist :minor))
(in (plist-get plist :in))
(match (plist-get plist :match))
(files (plist-get plist :files))
(pred (plist-get plist :when)))
(cond ((or files in pred)
(when (and files (not (or (listp files) (stringp files))))
(user-error "@associate :files expects a string or list of strings"))
(let ((hook-name (intern (format "doom--init-mode-%s" mode))))
(macroexp-progn
(list `(defun ,hook-name ()
(when (and ,(if match `(if buffer-file-name (string-match-p ,match buffer-file-name)) t)
(or ,(not files)
(and (boundp ',mode)
(not ,mode)
(doom-project-has-files ,@(-list files))))
(or (not ,pred)
(funcall ,pred buffer-file-name)))
(,mode 1)))
(if (and in (listp in))
(macroexp-progn
(mapcar (lambda (h) `(add-hook ',h ',hook-name))
(mapcar (lambda (m) (intern (format "%s-hook" m))) in)))
`(add-hook 'find-file-hook ',hook-name))))))
(match
`(add-to-list ',(if minor 'doom-auto-minor-mode-alist 'auto-mode-alist)
(cons ,match ',mode)))
(t (user-error "@associate invalid rules for mode [%s] (in %s) (match %s) (files %s)"
mode in match files))))))
;; Register keywords for proper indentation (see `@map')
(put ':prefix 'lisp-indent-function 'defun)
(put ':map 'lisp-indent-function 'defun)
(put ':after 'lisp-indent-function 'defun)
(put ':when 'lisp-indent-function 'defun)
(put ':unless 'lisp-indent-function 'defun)
(put ':leader 'lisp-indent-function 'defun)
(put ':localleader 'lisp-indent-function 'defun)
(defmacro @map (&rest rest)
"A nightmare of a key-binding macro that will use `evil-define-key*',
`define-key', `local-set-key' and `global-set-key' depending on context and
plist key flags. It was designed to make binding multiple keys more concise,
like in vim.
If evil isn't loaded, it will ignore evil-specific bindings.
Yes, it tries to do too much. Yes, I only did it to make the \"frontend\" config
that little bit more concise. Yes, I could simply have used the above functions.
But it takes a little insanity to custom write your own emacs.d, so what else
were you expecting?
States
:n normal
:v visual
:i insert
:e emacs
:o operator
:m motion
:r replace
:L local
These can be combined (order doesn't matter), e.g. :nvi will apply to
normal, visual and insert mode. The state resets after the following
key=>def pair.
Capitalize the state flag to make it a local binding.
If omitted, the keybind will be defined globally.
Flags
(:map [KEYMAP] [...]) ; inner keybinds are applied to KEYMAP
(:prefix [PREFIX] [...]) ; assign prefix to all inner keybindings
(:after [FEATURE] [...]) ; apply keybinds when [FEATURE] loads
Conditional keybinds
(:when [CONDITION] [...])
(:unless [CONDITION] [...])
Example
(@map :map magit-mode-map
:m \"C-r\" 'do-something ; assign C-r in motion state
:nv \"q\" 'magit-mode-quit-window ; assign to 'q' in normal and visual states
\"C-x C-r\" 'a-global-keybind
(:when IS-MAC
:n \"M-s\" 'some-fn
:i \"M-o\" (lambda (interactive) (message \"Hi\"))))"
(unless noninteractive
(let ((keymaps (if (boundp 'keymaps) keymaps))
(prefix (if (boundp 'prefix) prefix))
(state-map '(("n" . normal)
("v" . visual)
("i" . insert)
("e" . emacs)
("o" . operator)
("m" . motion)
("r" . replace)))
local key def states forms)
(while rest
(setq key (pop rest))
(cond
;; it's a sub expr
((listp key)
(push `(@map ,@key) forms))
;; it's a flag
((keywordp key)
(when (memq key '(:leader :localleader))
(if (not (featurep '+evil))
(setq rest nil
key :ignore)
(cond ((eq key :leader)
(push '+evil-leader rest))
((eq key :localleader)
(push '+evil-localleader rest)))
(setq key :prefix)))
(pcase key
(:ignore)
(:prefix
(let ((def (pop rest)))
(setq prefix
(if (or (symbolp def) (listp def))
`(vconcat ,prefix (if (stringp ,def) (kbd ,def) ,def))
`(vconcat ,prefix ,(if (stringp def) (kbd def) def))))))
(:map (setq keymaps (-list (pop rest))))
(:after (prog1 `((@after ,(pop rest) (@map ,@rest))) (setq rest '())))
(:when (prog1 `((if ,(pop rest) (@map ,@rest))) (setq rest '())))
(:unless (prog1 `((if (not ,(pop rest)) (@map ,@rest))) (setq rest '())))
(otherwise ; might be a state prefix
(mapc (lambda (letter)
(cond ((assoc letter state-map)
(push (cdr (assoc letter state-map)) states))
((string= letter "L")
(setq local t))
(t (user-error "Invalid mode prefix %s in key %s" letter key))))
(split-string (substring (symbol-name key) 1) "" t))
(unless states
(user-error "Unrecognized keyword %s" key))
(when (assoc "L" states)
(cond ((= (length states) 1)
(user-error "local keybinding for %s must accompany another state" key))
((> (length keymaps) 0)
(user-error "local keybinding for %s cannot accompany a keymap" key)))))))
;; It's a key-def pair
((or (stringp key)
(characterp key)
(vectorp key))
(unwind-protect
(catch 'skip
(when (stringp key)
(setq key (kbd key)))
(when prefix
(setq key (append prefix (list key))))
(unless (> (length rest) 0)
(user-error "Map has no definition for %s" key))
(setq def (pop rest))
(push (cond ((and keymaps states)
(unless (featurep 'evil)
(throw 'skip 'evil))
(macroexp-progn
(mapcar (lambda (keymap) `(evil-define-key* ',states ,keymap ,key ,def))
keymaps)))
(keymaps
(macroexp-progn
(mapcar (lambda (keymap) `(define-key ,keymap ,key ,def))
keymaps)))
(states
(unless (featurep 'evil)
(throw 'skip 'evil))
(macroexp-progn
(mapcar (lambda (state)
`(define-key
,(intern (format "evil-%s-state-%smap" state (if local "local-" "")))
,key ,def))
states)))
(t `(,(if local 'local-set-key 'global-set-key)
,key ,def)))
forms))
(setq states '()
local nil)))
(t (user-error "Invalid key %s" key))))
(macroexp-progn (reverse forms)))))
(provide 'core-lib)
;;; core-lib.el ends here