[elpa] externals/setup b413502 01/17: Initial import

[Stefan Monnier]

branch: externals/setup
commit b4135024d4c3d108a81f89cffc18360d4255fa3f
Author: Philip K <philipk@posteo.net>
Commit: Philip K <philipk@posteo.net>

    Initial import
---
 .dir-locals.el |   5 +
 .gitignore     |   3 +
 LICENSE        | 121 +++++++++++++++++++++
 README.md      |  52 +++++++++
 setup.el       | 329 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 510 insertions(+)

diff --git a/.dir-locals.el b/.dir-locals.el
new file mode 100644
index 0000000..3bcda92
--- /dev/null
+++ b/.dir-locals.el
@@ -0,0 +1,5 @@
+;;; Directory Local Variables
+;;; For more information see (info "(emacs) Directory Variables")
+
+((emacs-lisp-mode
+  (indent-tabs-mode . nil)))
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..507dafa
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+*.elc
+*~
+\#*\#
\ No newline at end of file
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..0e259d4
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,121 @@
+Creative Commons Legal Code
+
+CC0 1.0 Universal
+
+    CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE
+    LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN
+    ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS
+    INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES
+    REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS
+    PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM
+    THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED
+    HEREUNDER.
+
+Statement of Purpose
+
+The laws of most jurisdictions throughout the world automatically confer
+exclusive Copyright and Related Rights (defined below) upon the creator
+and subsequent owner(s) (each and all, an "owner") of an original work of
+authorship and/or a database (each, a "Work").
+
+Certain owners wish to permanently relinquish those rights to a Work for
+the purpose of contributing to a commons of creative, cultural and
+scientific works ("Commons") that the public can reliably and without fear
+of later claims of infringement build upon, modify, incorporate in other
+works, reuse and redistribute as freely as possible in any form whatsoever
+and for any purposes, including without limitation commercial purposes.
+These owners may contribute to the Commons to promote the ideal of a free
+culture and the further production of creative, cultural and scientific
+works, or to gain reputation or greater distribution for their Work in
+part through the use and efforts of others.
+
+For these and/or other purposes and motivations, and without any
+expectation of additional consideration or compensation, the person
+associating CC0 with a Work (the "Affirmer"), to the extent that he or she
+is an owner of Copyright and Related Rights in the Work, voluntarily
+elects to apply CC0 to the Work and publicly distribute the Work under its
+terms, with knowledge of his or her Copyright and Related Rights in the
+Work and the meaning and intended legal effect of CC0 on those rights.
+
+1. Copyright and Related Rights. A Work made available under CC0 may be
+protected by copyright and related or neighboring rights ("Copyright and
+Related Rights"). Copyright and Related Rights include, but are not
+limited to, the following:
+
+  i. the right to reproduce, adapt, distribute, perform, display,
+     communicate, and translate a Work;
+ ii. moral rights retained by the original author(s) and/or performer(s);
+iii. publicity and privacy rights pertaining to a person's image or
+     likeness depicted in a Work;
+ iv. rights protecting against unfair competition in regards to a Work,
+     subject to the limitations in paragraph 4(a), below;
+  v. rights protecting the extraction, dissemination, use and reuse of data
+     in a Work;
+ vi. database rights (such as those arising under Directive 96/9/EC of the
+     European Parliament and of the Council of 11 March 1996 on the legal
+     protection of databases, and under any national implementation
+     thereof, including any amended or successor version of such
+     directive); and
+vii. other similar, equivalent or corresponding rights throughout the
+     world based on applicable law or treaty, and any national
+     implementations thereof.
+
+2. Waiver. To the greatest extent permitted by, but not in contravention
+of, applicable law, Affirmer hereby overtly, fully, permanently,
+irrevocably and unconditionally waives, abandons, and surrenders all of
+Affirmer's Copyright and Related Rights and associated claims and causes
+of action, whether now known or unknown (including existing as well as
+future claims and causes of action), in the Work (i) in all territories
+worldwide, (ii) for the maximum duration provided by applicable law or
+treaty (including future time extensions), (iii) in any current or future
+medium and for any number of copies, and (iv) for any purpose whatsoever,
+including without limitation commercial, advertising or promotional
+purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each
+member of the public at large and to the detriment of Affirmer's heirs and
+successors, fully intending that such Waiver shall not be subject to
+revocation, rescission, cancellation, termination, or any other legal or
+equitable action to disrupt the quiet enjoyment of the Work by the public
+as contemplated by Affirmer's express Statement of Purpose.
+
+3. Public License Fallback. Should any part of the Waiver for any reason
+be judged legally invalid or ineffective under applicable law, then the
+Waiver shall be preserved to the maximum extent permitted taking into
+account Affirmer's express Statement of Purpose. In addition, to the
+extent the Waiver is so judged Affirmer hereby grants to each affected
+person a royalty-free, non transferable, non sublicensable, non exclusive,
+irrevocable and unconditional license to exercise Affirmer's Copyright and
+Related Rights in the Work (i) in all territories worldwide, (ii) for the
+maximum duration provided by applicable law or treaty (including future
+time extensions), (iii) in any current or future medium and for any number
+of copies, and (iv) for any purpose whatsoever, including without
+limitation commercial, advertising or promotional purposes (the
+"License"). The License shall be deemed effective as of the date CC0 was
+applied by Affirmer to the Work. Should any part of the License for any
+reason be judged legally invalid or ineffective under applicable law, such
+partial invalidity or ineffectiveness shall not invalidate the remainder
+of the License, and in such case Affirmer hereby affirms that he or she
+will not (i) exercise any of his or her remaining Copyright and Related
+Rights in the Work or (ii) assert any associated claims and causes of
+action with respect to the Work, in either case contrary to Affirmer's
+express Statement of Purpose.
+
+4. Limitations and Disclaimers.
+
+ a. No trademark or patent rights held by Affirmer are waived, abandoned,
+    surrendered, licensed or otherwise affected by this document.
+ b. Affirmer offers the Work as-is and makes no representations or
+    warranties of any kind concerning the Work, express, implied,
+    statutory or otherwise, including without limitation warranties of
+    title, merchantability, fitness for a particular purpose, non
+    infringement, or the absence of latent or other defects, accuracy, or
+    the present or absence of errors, whether or not discoverable, all to
+    the greatest extent permissible under applicable law.
+ c. Affirmer disclaims responsibility for clearing rights of other persons
+    that may apply to the Work or any use thereof, including without
+    limitation any person's Copyright and Related Rights in the Work.
+    Further, Affirmer disclaims responsibility for obtaining any necessary
+    consents, permissions or other rights required for any use of the
+    Work.
+ d. Affirmer understands and acknowledges that Creative Commons is not a
+    party to this document and has no duty or obligation with respect to
+    this CC0 or use of the Work.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..0a3e45a
--- /dev/null
+++ b/README.md
@@ -0,0 +1,52 @@
+`setup.el`
+==========
+
+The `setup' macro simplifies repetitive configuration patterns.  For
+example, these macros:
+
+    (setup shell
+      (let ((key "C-c s"))
+        (global (key shell))
+        (bind (key bury-buffer))))
+
+
+    (setup (package paredit)
+      (hide-lighter)
+      (hook-into scheme-mode lisp-mode))
+
+will be replaced with the functional equivalent of
+
+    (global-set-key (kbd "C-c s") #'shell)
+    (with-eval-after-load 'shell
+       (define-key shell-mode-map (kbd "C-c s") #'bury-buffer))
+
+
+    (unless (package-install-p 'paredit)
+      (package-install 'paredit ))
+    (delq (assq 'paredit-mode minor-mode-alist)
+          minor-mode-alist)
+    (add-hook 'scheme-mode-hook #'paredit-mode)
+    (add-hook 'lisp-mode-hook #'paredit-mode)
+
+Additional "keywords" can be defined using `setup-define'. Invoke
+the command `setup-help' to get a list of macros.
+
+**Note:** This package is still being developed, and will probably
+change a lot. See [this thread][thread] from emacs-devel for more
+information.
+
+Bugs
+----
+
+Bugs or comments can be submitted to my [public inbox][mail].
+own.
+
+Copying
+-------
+
+`setup.el` is distributed under the [CC0 1.0 Universal (CC0 1.0)
+Public Domain Dedication][cc0] license. 
+
+[thread]: https://lists.gnu.org/archive/html/emacs-devel/2021-02/msg00188.html
+[mail]: https://lists.sr.ht/~zge/public-inbox
+[cc0]: https://creativecommons.org/publicdomain/zero/1.0/deed
diff --git a/setup.el b/setup.el
new file mode 100644
index 0000000..04323df
--- /dev/null
+++ b/setup.el
@@ -0,0 +1,329 @@
+;;; setup.el --- Helpful Configuration Macro    -*- lexical-binding: t -*-
+
+;; Author: Philip K. <philipk@posteo.net>
+;; Maintainer: Philip K. <philipk@posteo.net>
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "26.1") (cl-lib "0.6.1"))
+;; Keywords: lisp, local
+
+;; This file is NOT part of Emacs.
+;;
+;; This file is in the public domain, to the extent possible under law,
+;; published under the CC0 1.0 Universal license.
+;;
+;; For a full copy of the CC0 license see
+;; https://creativecommons.org/publicdomain/zero/1.0/legalcode
+
+;;; Commentary:
+
+;; The `setup' macro simplifies repetitive configuration patterns.
+;; For example, these macros:
+
+;;     (setup shell
+;;       (let ((key "C-c s"))
+;;         (global key shell)
+;;         (bind key bury-buffer)))
+;;
+;;
+;;     (setup (:package paredit)
+;;       (hide-mode)
+;;       (hook-into scheme-mode lisp-mode))
+
+;; will be replaced with the functional equivalent of
+
+;;     (global-set-key (kbd "C-c s") #'shell)
+;;     (with-eval-after-load 'shell
+;;        (define-key shell-mode-map (kbd "C-c s") #'bury-buffer))
+;;
+;;
+;;     (unless (package-install-p 'paredit)
+;;       (package-install 'paredit ))
+;;     (delq (assq 'paredit-mode minor-mode-alist)
+;;           minor-mode-alist)
+;;     (add-hook 'scheme-mode-hook #'paredit-mode)
+;;     (add-hook 'lisp-mode-hook #'paredit-mode)
+
+;; Additional "keywords" can be defined using `setup-define'.  All
+;; known keywords are documented in the docstring for `setup'.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+
+;;; `setup' macros
+
+(defvar setup-macros nil
+  "Local macro definitions to be bound in `setup' bodies.")
+
+;;;###autoload
+(defun setup-make-docstring ()
+  "Return a docstring for `setup'."
+  (with-temp-buffer
+    (insert (documentation (symbol-function 'setup) 'raw))
+    (dolist (sym (mapcar #'car setup-macros))
+      (let ((sig (if (get sym 'setup-signature)
+                     (cons sym (get sym 'setup-signature))
+                   (list sym))))
+        (insert "- " (prin1-to-string sig)
+                "\n\n"
+                (or (get sym 'setup-documentation)
+                    "No documentation.")
+                "\n\n")))
+    (buffer-string)))
+
+;;;###autoload
+(defmacro setup (name &rest body)
+  "Configure feature or subsystem NAME.
+BODY may contain special forms defined by `setup-define', but
+will otherwise just be evaluated as is.
+
+The following local macros are defined in a `setup' body:\n\n"
+  (declare (debug (name &rest body)))
+  (when (consp name)
+    (let ((shorthand (get (car name) 'setup-shorthand)))
+      (when shorthand
+        (push name body)
+        (setq name (funcall shorthand name)))))
+  (let ((mode (if (string-match-p "-mode\\'" (symbol-name name))
+                  name
+                (intern (format "%s-mode" name)))))
+    `(let ((setup-name ',name))
+       (ignore setup-name)
+       (cl-macrolet ,setup-macros
+         (catch 'setup-exit
+           (:with-mode ,mode ,@body))))))
+
+;;;###autoload
+(put 'setup 'function-documentation '(setup-make-docstring))
+
+(defun setup-define (name fn &rest opts)
+  "Define `setup'-local macro NAME using function FN.
+The plist OPTS may contain the key-value pairs:
+
+  :name
+Specify a function to use, for extracting the feature name of a
+NAME entry, if it is the first element in a setup macro.
+
+  :indent
+Change indentation behaviour.  See symbol `lisp-indent-function'.
+
+  :after-loaded
+Wrap the macro in a `with-eval-after-load' body.
+
+  :signature
+Give an advertised calling convention.
+
+  :documentation
+A documentation string."
+  (declare (indent 1))
+  (cl-assert (symbolp name))
+  (cl-assert (functionp fn))
+  (cl-assert (listp opts))
+  ;; save metadata
+  (put name 'setup-documentation (plist-get opts :documentation))
+  (put name 'setup-signature (plist-get opts :signature))
+  (put name 'setup-shorthand (plist-get opts :shorthand))
+  (put name 'lisp-indent-function (plist-get opts :indent))
+  (put name 'setup-indent (plist-get opts :indent))
+  ;; forget previous definition
+  (setq setup-macros (delq (assq name setup-macros)
+                           setup-macros))
+  ;; define macro for `cl-macrolet'
+  (push (let* ((arity (func-arity fn))
+               (body (if (plist-get opts :repeatable)
+                         `(progn
+                            (unless (zerop (mod (length args) ,(car arity)))
+                              (error "Illegal arguments"))
+                            (let (aggr)
+                              (while args
+                                (let ((rest (nthcdr ,(car arity) args)))
+                                  (setf (nthcdr ,(car arity) args) nil)
+                                  (push (apply #',fn args) aggr)
+                                  (setq args rest)))
+                              `(progn ,@(nreverse aggr))))
+                       `(apply #',fn args))))
+          (if (plist-get opts :after-loaded)
+              `(,name (&rest args)
+                      `(with-eval-after-load setup-name ,,body))
+            `(,name (&rest args) `,,body)))
+        setup-macros)
+  (set-advertised-calling-convention name (plist-get opts :signature) nil))
+
+
+;;; definitions of `setup' keywords
+
+(setup-define 'with-mode
+  (lambda (mode &rest body)
+    `(let ((setup-mode ',mode)
+           (setup-map ',(intern (format "%s-map" mode)))
+           (setup-hook ',(intern (format "%s-hook" mode))))
+       (ignore setup-mode setup-map setup-hook)
+       ,@body))
+  :signature '(MODE &body BODY)
+  :documentation "Change the MODE that BODY is configuring."
+  :indent 1)
+
+(setup-define 'with-map
+  (lambda (map &rest body)
+    `(let ((setup-map ',map))
+       ,@body))
+  :signature '(MAP &body BODY)
+  :documentation "Change the MAP that BODY will bind to"
+  :indent 1)
+
+(setup-define 'with-hook
+  (lambda (hook &rest body)
+    `(let ((setup-hook ',hook))
+       ,@body))
+  :signature '(HOOK &body BODY)
+  :documentation "Change the HOOK that BODY will use."
+  :indent 1)
+
+(setup-define 'package
+  (lambda (package)
+    `(unless (package-installed-p ',package)
+       (package-install ',package)))
+  :signature '(PACKAGE ...)
+  :documentation "Install PACKAGE if it hasn't been installed yet."
+  :shorthand #'cadr
+  :repeatable t)
+
+(setup-define 'require
+  (lambda (feature)
+    `(require ',feature))
+  :signature '(FEATURE ...)
+  :documentation "Eagerly require FEATURE."
+  :shorthand #'cadr
+  :repeatable t)
+
+(setup-define 'global
+  (lambda (key fn)
+    `(global-set-key
+      ,(cond ((stringp key) (kbd key))
+             ((symbolp key) `(kbd ,key))
+             (key))
+      #',fn))
+  :signature '(KEY FUNCTION ...)
+  :documentation "Globally bind KEY to FUNCTION."
+  :repeatable t)
+
+(setup-define 'bind
+  (lambda (key fn)
+    `(define-key (eval setup-map)
+       ,(cond ((stringp key) (kbd key))
+              ((symbolp key) `(kbd ,key))
+              (key))
+       #',fn))
+  :signature '(KEY FUNCTION ...)
+  :documentation "Bind KEY to FUNCTION in current map."
+  :after-loaded t
+  :repeatable t)
+
+(setup-define 'unbind
+  (lambda (key)
+    `(define-key
+       ,(cond ((stringp key) (kbd key))
+              ((symbolp key) `(kbd ,key))
+              (key))
+       nil))
+  :signature '(KEY ...)
+  :documentation "Unbind KEY in current map."
+  :after-loaded t
+  :repeatable t)
+
+(setup-define 'rebind
+  (lambda (key fn)
+    `(progn
+       (dolist (key (where-is-internal ',fn))
+         (define-key (eval setup-map) ,key nil))
+       (define-key
+         ,(cond ((stringp key) (kbd key))
+                ((symbolp key) `(kbd ,key))
+                (key))
+         #',fn)))
+  :signature '(KEY FUNCTION ...)
+  :documentation "Unbind the current key for FUNCTION, and bind it to KEY."
+  :after-loaded t
+  :repeatable t)
+
+(setup-define 'hook
+  (lambda (hook)
+    `(add-hook setup-hook #',hook))
+  :signature '(FUNCTION ...)
+  :documentation "Add FUNCTION to current hook."
+  :repeatable t)
+
+(setup-define 'hook-into
+  (lambda (mode)
+    `(add-hook ',(intern (concat (symbol-name mode) "-hook"))
+               setup-mode))
+  :signature '(HOOK ...)
+  :documentation "Add current mode to HOOK."
+  :repeatable t)
+
+(setup-define 'option
+  (lambda (var val)
+    (cond ((symbolp var)
+           `(customize-set-variable ',var ,val "Modified by `setup'"))
+          ((eq (car-safe var) 'append)
+           `(customize-set-variable
+             ',(cadr var)
+             (append (funcall (or (get ',(cadr var) 'custom-get) 'symbol-value)
+                              ',(cadr var))
+                     (list ,val))
+             "Modified by `setup'"))
+          ((eq (car-safe var) 'prepend)
+           `(customize-set-variable
+             ',(cadr var)
+             (cons ,val (funcall (or (get ',(cadr var) 'custom-get) 
'symbol-value)
+                                ',(cadr var)))
+             "Modified by `setup'"))))
+  :signature '(NAME VAL ...)
+  :documentation "Set the option NAME to VAL.
+
+NAME may be a symbol, or a cons-cell.  If NAME is a cons-cell, it
+will use the car value to modify the behaviour.  If NAME has the
+form (append VAR), "
+  :repeatable t)
+
+(setup-define 'hide-mode
+  (lambda ()
+    `(delq (assq setup-mode minor-mode-alist)
+           minor-mode-alist))
+  :documentation "Hide the mode-line lighter of the current mode."
+  :after-loaded t)
+
+(setup-define 'local-set
+  (lambda (var val)
+    `(add-hook setup-hook (lambda () (setq-local ,var ,val))))
+  :signature '(VAR VAL ...)
+  :documentation "Set the value of VAR to VAL in buffers of the current mode."
+  :repeatable t)
+
+(setup-define 'local-hook
+  (lambda (hook fn)
+    `(add-hook setup-hook
+               (lambda ()
+                 (add-hook ',hook #',fn nil t))))
+  :signature '(HOOK FUNCTION ...)
+  :documentation "Add FUNCTION to HOOK only in buffers of the current mode."
+  :repeatable t)
+
+(setup-define 'needs
+  (lambda (binary)
+    `(unless (executable-find ,binary)
+       (throw 'setup-exit nil)))
+  :signature '(PROGRAM ...)
+  :documentation "If PROGRAM is not in the path, stop here."
+  :repeatable t)
+
+(setup-define 'when-loaded
+  (lambda (&rest body) `(progn ,@body))
+  :signature '(&body BODY)
+  :documentation "Evaluate BODY after the current feature has been loaded."
+  :after-loaded t)
+
+(provide 'setup)
+
+;;; setup.el ends here