2021-11-22 05:57:41 +00:00
|
|
|
|
;;; +setup.el -- my `setup' commands -*- lexical-binding: t -*-
|
|
|
|
|
|
|
|
|
|
;; Author: Case Duckworth <acdw@acdw.net>
|
|
|
|
|
|
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
|
|
|
|
|
|
;;; License:
|
|
|
|
|
;; Everyone is permitted to do whatever with this software, without
|
|
|
|
|
;; limitation. This software comes without any warranty whatsoever,
|
|
|
|
|
;; but with two pieces of advice:
|
|
|
|
|
;; - Don't hurt yourself.
|
|
|
|
|
;; - Make good choices.
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
|
|
;; `setup', by Philip Kaludercic, is a wonderful package that works
|
|
|
|
|
;; sort of like `use-package', but to my mind it's cleaner and easier
|
|
|
|
|
;; to extend. These are my additions to the local macros provided by
|
|
|
|
|
;; the package.
|
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
(require 'el-patch)
|
|
|
|
|
(require 'setup)
|
|
|
|
|
(require 'straight)
|
2022-04-20 03:27:03 +00:00
|
|
|
|
(require 'cl-lib)
|
2021-11-22 05:57:41 +00:00
|
|
|
|
|
2022-01-06 00:41:41 +00:00
|
|
|
|
(defun +setup-warn (message &rest args)
|
|
|
|
|
"Warn the user that something bad happened in `setup'."
|
|
|
|
|
(display-warning 'setup (format message args)))
|
|
|
|
|
|
2022-05-06 15:20:46 +00:00
|
|
|
|
(defun +setup-wrap-to-demote-errors (body name)
|
|
|
|
|
"Wrap BODY in a `with-demoted-errors' block.
|
|
|
|
|
This behavior is prevented if `setup-attributes' contains the
|
|
|
|
|
symbol `without-error-demotion'.
|
|
|
|
|
|
|
|
|
|
This function differs from `setup-wrap-to-demote-errors' in that
|
|
|
|
|
it includes the NAME of the setup form in the warning output."
|
|
|
|
|
(if (memq 'without-error-demotion setup-attributes)
|
|
|
|
|
body
|
|
|
|
|
`(with-demoted-errors ,(format "Error in setup form on line %d (%s): %%S"
|
|
|
|
|
(line-number-at-pos)
|
|
|
|
|
name)
|
|
|
|
|
,body)))
|
|
|
|
|
|
2022-06-09 14:16:50 +00:00
|
|
|
|
|
|
|
|
|
;;; New forms
|
|
|
|
|
|
2022-02-19 00:20:38 +00:00
|
|
|
|
(setup-define :quit
|
|
|
|
|
'setup-quit
|
|
|
|
|
:documentation "Quit the current `setup' form.
|
|
|
|
|
Good for commenting.")
|
|
|
|
|
|
2021-11-22 05:57:41 +00:00
|
|
|
|
(setup-define :face
|
2022-05-06 15:20:46 +00:00
|
|
|
|
(lambda (face spec)
|
|
|
|
|
`(custom-set-faces (list ,face ,spec 'now "Customized by `setup'.")))
|
2021-11-22 05:57:41 +00:00
|
|
|
|
:documentation "Customize FACE with SPEC using `custom-set-faces'."
|
|
|
|
|
:repeatable t)
|
|
|
|
|
|
|
|
|
|
(setup-define :load-after
|
2022-05-06 15:20:46 +00:00
|
|
|
|
(lambda (&rest features)
|
|
|
|
|
(let ((body `(require ',(setup-get 'feature))))
|
|
|
|
|
(dolist (feature (nreverse features))
|
|
|
|
|
(setq body `(with-eval-after-load ',feature ,body)))
|
|
|
|
|
body))
|
2021-11-22 05:57:41 +00:00
|
|
|
|
:documentation "Load the current feature after FEATURES.")
|
|
|
|
|
|
2022-02-07 19:16:04 +00:00
|
|
|
|
(setup-define :load-from
|
|
|
|
|
(lambda (path)
|
|
|
|
|
`(let ((path* (expand-file-name ,path)))
|
|
|
|
|
(if (file-exists-p path*)
|
|
|
|
|
(add-to-list 'load-path path*)
|
|
|
|
|
,(setup-quit))))
|
|
|
|
|
:documentation "Add PATH to load path.
|
|
|
|
|
This macro can be used as NAME, and it will replace itself with
|
|
|
|
|
the nondirectory part of PATH.
|
|
|
|
|
If PATH does not exist, abort the evaluation."
|
|
|
|
|
:shorthand (lambda (args)
|
|
|
|
|
(intern
|
|
|
|
|
(file-name-nondirectory
|
|
|
|
|
(directory-file-name (cadr args))))))
|
|
|
|
|
|
2022-06-09 14:16:50 +00:00
|
|
|
|
(setup-define :needs
|
|
|
|
|
(lambda (executable)
|
|
|
|
|
`(unless (executable-find ,executable)
|
|
|
|
|
,(setup-quit)))
|
|
|
|
|
:documentation "If EXECUTABLE is not in the path, stop here."
|
|
|
|
|
:repeatable 1)
|
|
|
|
|
|
2022-02-07 19:16:04 +00:00
|
|
|
|
|
2022-06-09 14:16:50 +00:00
|
|
|
|
;;; Package integrations
|
|
|
|
|
|
2022-02-07 19:16:04 +00:00
|
|
|
|
;;; Straight.el
|
|
|
|
|
|
2022-05-27 18:26:19 +00:00
|
|
|
|
(defun setup--straight-handle-arg (arg var)
|
|
|
|
|
(cond
|
|
|
|
|
((and (boundp var) (symbol-value var)) t)
|
|
|
|
|
((keywordp arg) (set var t))
|
|
|
|
|
((functionp arg) (set var nil) (funcall arg))
|
|
|
|
|
((listp arg) (set var nil) arg)))
|
2022-01-17 05:13:11 +00:00
|
|
|
|
|
2022-05-27 18:26:19 +00:00
|
|
|
|
(with-eval-after-load 'straight
|
2022-02-07 19:16:04 +00:00
|
|
|
|
(setup-define :straight
|
2022-04-20 03:27:03 +00:00
|
|
|
|
(lambda (recipe &rest predicates)
|
|
|
|
|
(let* ((skp (make-symbol "straight-keyword-p"))
|
|
|
|
|
(straight-use-p
|
2022-05-27 18:26:19 +00:00
|
|
|
|
(cl-mapcar
|
|
|
|
|
(lambda (f) (setup--straight-handle-arg f skp))
|
|
|
|
|
predicates))
|
|
|
|
|
(form `(unless (and ,@straight-use-p
|
2022-04-20 03:27:03 +00:00
|
|
|
|
(condition-case e
|
|
|
|
|
(straight-use-package ',recipe)
|
|
|
|
|
(error
|
|
|
|
|
(+setup-warn ":straight error: %S"
|
|
|
|
|
',recipe)
|
|
|
|
|
,(setup-quit))
|
|
|
|
|
(:success t)))
|
2022-05-06 15:20:36 +00:00
|
|
|
|
,(setup-quit))))
|
2022-04-20 03:27:03 +00:00
|
|
|
|
;; Keyword arguments --- :quit is special and should short-circuit
|
|
|
|
|
(if (memq :quit predicates)
|
|
|
|
|
(setq form `,(setup-quit))
|
|
|
|
|
;; Otherwise, handle the rest of them ...
|
|
|
|
|
(when-let ((after (cadr (memq :after predicates))))
|
|
|
|
|
(setq form `(with-eval-after-load ,(if (eq after t)
|
|
|
|
|
(setup-get 'feature)
|
|
|
|
|
after)
|
|
|
|
|
,form))))
|
|
|
|
|
;; Finally ...
|
|
|
|
|
form))
|
|
|
|
|
:documentation "Install RECIPE with `straight-use-package'.
|
|
|
|
|
If PREDICATES are given, only install RECIPE if all of them return non-nil.
|
|
|
|
|
The following keyword arguments are also recognized:
|
|
|
|
|
- :quit --- immediately stop evaluating. Good for commenting.
|
|
|
|
|
- :after FEATURE --- only install RECIPE after FEATURE is loaded.
|
|
|
|
|
If FEATURE is t, install RECIPE after the current feature."
|
|
|
|
|
:repeatable nil
|
2022-02-07 19:16:04 +00:00
|
|
|
|
:indent 1
|
2022-04-20 03:27:03 +00:00
|
|
|
|
:shorthand (lambda (sexp)
|
|
|
|
|
(let ((recipe (cadr sexp)))
|
|
|
|
|
(or (car-safe recipe) recipe)))))
|
2021-11-22 05:57:41 +00:00
|
|
|
|
|
2022-06-09 14:16:50 +00:00
|
|
|
|
;;; Apheleia
|
|
|
|
|
|
|
|
|
|
(setup-define :apheleia
|
|
|
|
|
(lambda (name formatter &optional mode -pend)
|
|
|
|
|
(let* ((mode (or mode (setup-get 'mode)))
|
|
|
|
|
(current-formatters (and -pend
|
|
|
|
|
(alist-get mode apheleia-formatters))))
|
|
|
|
|
`(with-eval-after-load 'apheleia
|
|
|
|
|
(setf (alist-get ',name apheleia-formatters)
|
|
|
|
|
,formatter)
|
|
|
|
|
(setf (alist-get ',mode apheleia-mode-alist)
|
|
|
|
|
',(pcase -pend
|
|
|
|
|
(:append (append (ensure-list current-formatters)
|
|
|
|
|
(list name)))
|
|
|
|
|
(:prepend (cons name (ensure-list current-formatters)))
|
|
|
|
|
('nil name)
|
|
|
|
|
(_ (error "Improper `:apheleia' -PEND argument")))))))
|
|
|
|
|
:documentation
|
|
|
|
|
"Register a formatter to `apheleia''s lists.
|
|
|
|
|
NAME is the name given to the formatter in `apheleia-formatters'
|
|
|
|
|
and `apheleia-mode-alist'. FORMATTER is the command paired with
|
|
|
|
|
NAME in `apheleia-formatters'. MODE is the mode or modes to add
|
|
|
|
|
NAME to in `apheleia-mode-alist'. If MODE is not given or nil,
|
|
|
|
|
use the setup form's MODE. Optional argument -PEND can be one of
|
|
|
|
|
`:append' or `:prepend', and if given will append or prepend the
|
|
|
|
|
given NAME to the current formatters for the MODE in
|
|
|
|
|
`apheleia-mode-alist', rather than replace them (the default).
|
|
|
|
|
|
|
|
|
|
Example:
|
|
|
|
|
(setup
|
|
|
|
|
(:apheleia isort (\"isort\" \"--stdout\" \"-\")
|
|
|
|
|
python-mode))
|
|
|
|
|
; =>
|
|
|
|
|
(progn
|
|
|
|
|
(setf (alist-get 'isort apheleia-formatters)
|
|
|
|
|
'(\"isort\" \"--stdout\" \"-\"))
|
|
|
|
|
(setf (alist-get 'python-mode apheleia-mode-alist)
|
|
|
|
|
'isort))
|
|
|
|
|
|
|
|
|
|
This form cannot be repeated, and it cannot be used as HEAD.")
|
2022-05-06 15:21:02 +00:00
|
|
|
|
|
2022-01-31 06:54:53 +00:00
|
|
|
|
|
|
|
|
|
;;; Redefines of `setup' forms
|
|
|
|
|
|
|
|
|
|
(setup-define :bind-into
|
|
|
|
|
(lambda (feature-or-map &rest rest)
|
|
|
|
|
(cl-loop for f/m in (ensure-list feature-or-map)
|
|
|
|
|
collect (if (string-match-p "-map\\'" (symbol-name f/m))
|
|
|
|
|
`(:with-map ,f/m (:bind ,@rest))
|
|
|
|
|
`(:with-feature ,f/m (:bind ,@rest)))
|
|
|
|
|
into forms
|
|
|
|
|
finally return `(progn ,@forms)))
|
|
|
|
|
:documentation "Bind into keys into the map(s) of FEATURE-OR-MAP.
|
|
|
|
|
FEATURE-OR-MAP can be a feature or map name or a list of them.
|
|
|
|
|
The arguments REST are handled as by `:bind'."
|
|
|
|
|
:debug '(sexp &rest form sexp)
|
|
|
|
|
:indent 1)
|
|
|
|
|
|
2022-02-19 00:20:45 +00:00
|
|
|
|
(setup-define :require
|
|
|
|
|
(lambda (&rest features)
|
|
|
|
|
(require 'cl-lib)
|
|
|
|
|
(if features
|
|
|
|
|
`(progn ,@(cl-loop for feature in features collect
|
|
|
|
|
`(unless (require ',feature nil t)
|
|
|
|
|
,(setup-quit))))
|
|
|
|
|
`(unless (require ',(setup-get 'feature) nil t)
|
|
|
|
|
,(setup-quit))))
|
|
|
|
|
:documentation "Try to require FEATURE, or stop evaluating body.
|
|
|
|
|
This macro can be used as NAME, and it will replace itself with
|
|
|
|
|
the first FEATURE."
|
|
|
|
|
:repeatable nil
|
|
|
|
|
:shorthand #'cadr)
|
|
|
|
|
|
2021-11-22 05:57:41 +00:00
|
|
|
|
(provide '+setup)
|
|
|
|
|
;;; +setup.el ends here
|