1 files changed, 0 insertions, 216 deletions

@@ -1,216 +0,0 @@
-;;; +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)
-(require 'cl-lib)
-
-(defun +setup-warn (message &rest args)
-  "Warn the user that something bad happened in `setup'."
-  (display-warning 'setup (format message args)))
-
-(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)))
-
-
-;;; New forms
-
-(setup-define :quit
-  'setup-quit
-  :documentation "Quit the current `setup' form.
-Good for commenting.")
-
-(setup-define :face
-  (lambda (face spec)
-    `(custom-set-faces (list ,face ,spec 'now "Customized by `setup'.")))
-  :documentation "Customize FACE with SPEC using `custom-set-faces'."
-  :repeatable t)
-
-(setup-define :load-after
-  (lambda (&rest features)
-    (let ((body `(require ',(setup-get 'feature))))
-      (dolist (feature (nreverse features))
-        (setq body `(with-eval-after-load ',feature ,body)))
-      body))
-  :documentation "Load the current feature after FEATURES.")
-
-(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))))))
-
-(setup-define :needs
-  (lambda (executable)
-    `(unless (executable-find ,executable)
-       ,(setup-quit)))
-  :documentation "If EXECUTABLE is not in the path, stop here."
-  :repeatable 1)
-
-
-;;; Package integrations
-
-;;; Straight.el
-
-(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)))
-
-(with-eval-after-load 'straight
-  (setup-define :straight
-    (lambda (recipe &rest predicates)
-      (let* ((skp (make-symbol "straight-keyword-p"))
-             (straight-use-p
-              (cl-mapcar
-                 (lambda (f) (setup--straight-handle-arg f skp))
-                 predicates))
-             (form `(unless (and ,@straight-use-p
-                                 (condition-case e
-                                     (straight-use-package ',recipe)
-                                   (error
-                                    (+setup-warn ":straight error: %S"
-                                                 ',recipe)
-                                    ,(setup-quit))
-                                   (:success t)))
-                      ,(setup-quit))))
-        ;; 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
-    :indent 1
-    :shorthand (lambda (sexp)
-                 (let ((recipe (cadr sexp)))
-                   (or (car-safe recipe) recipe)))))
-
-;;; 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.")
-
-
-;;; 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)
-
-(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)
-
-(provide '+setup)
-;;; +setup.el ends here