[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/dash 9c6b979 309/316: Unify dev/examples-to-*.el files
From: |
ELPA Syncer |
Subject: |
[elpa] externals/dash 9c6b979 309/316: Unify dev/examples-to-*.el files |
Date: |
Mon, 15 Feb 2021 15:58:23 -0500 (EST) |
branch: externals/dash
commit 9c6b9798ce9a7e2b237b65d8b8bc9f19e07a675b
Author: Basil L. Contovounesios <contovob@tcd.ie>
Commit: Basil L. Contovounesios <contovob@tcd.ie>
Unify dev/examples-to-*.el files
* dev/examples-to-docs.el:
* dev/examples-to-info.el:
* dev/examples-to-tests.el: Delete files. Combine features into...
* dev/dash-defs.el: ...this new file.
* Makefile:
* dev/examples.el: Simplify accordingly.
(approx-equal): Move definition to dev/dash-defs.el, where it's
generated.
(Predicates, Indexing, Threading macros, Binding)
(Destructive operations, Function combinators): Add missing or fix
existing docstrings.
* dash-template.texi (Functions):
* readme-template.md (Functions): Remove gratuitous newlines.
* README.md:
* dash.texi: Regenerate docs.
---
Makefile | 14 +-
README.md | 34 +++--
dash-template.texi | 2 +-
dash.texi | 16 ++-
dev/dash-defs.el | 341 +++++++++++++++++++++++++++++++++++++++++++++++
dev/examples-to-docs.el | 190 --------------------------
dev/examples-to-info.el | 165 -----------------------
dev/examples-to-tests.el | 50 -------
dev/examples.el | 41 +++---
readme-template.md | 2 -
10 files changed, 407 insertions(+), 448 deletions(-)
diff --git a/Makefile b/Makefile
index e8538e3..f518b63 100644
--- a/Makefile
+++ b/Makefile
@@ -19,9 +19,10 @@
EMACS ?= emacs
BATCH := $(EMACS) -Q -batch -L .
-ELS := dash.el dash-functional.el
+ELS := dash.el dash-functional.el dev/dash-defs.el
ELCS := $(addsuffix c,$(ELS))
DOCS := README.md dash.texi
+TMPLS := readme-template.md dash-template.texi $(wildcard doc/*.texi)
# Targets.
@@ -41,7 +42,7 @@ force-docs: maintainer-clean docs
check: ERT_SELECTOR ?= t
check: RUN := '(ert-run-tests-batch-and-exit (quote $(ERT_SELECTOR)))'
check: lisp
- $(BATCH) -l dev/examples-to-tests.el -l dev/examples.el -eval $(RUN)
+ $(BATCH) -l dev/examples.el -eval $(RUN)
.PHONY: check
all: lisp docs check
@@ -67,10 +68,7 @@ maintainer-clean: clean
%.elc: %.el
$(BATCH) -eval $(WERROR) -f batch-byte-compile $<
-dash-functional.elc: dash.elc
+dash-functional.elc dev/dash-defs.elc: dash.elc
-README.md: $(ELS) dev/examples-to-docs.el dev/examples.el readme-template.md
- $(BATCH) $(addprefix -l ,$(filter %.el,$^)) -f create-docs-file
-
-dash.texi: $(ELS) dev/examples-to-info.el dev/examples.el dash-template.texi
- $(BATCH) $(addprefix -l ,$(filter %.el,$^)) -f create-info-file
+$(DOCS) &: dev/examples.el $(ELCS) $(TMPLS)
+ $(BATCH) -l $< -f dash-make-docs
diff --git a/README.md b/README.md
index 018b123..8d47295 100644
--- a/README.md
+++ b/README.md
@@ -119,7 +119,6 @@ The normal version can of course also be written as follows:
This demonstrates the utility of both versions.
-
### Maps
Functions in this category take a transforming function, which
@@ -212,6 +211,8 @@ value rather than consuming a list to produce a single
value.
### Predicates
+Reductions of one or more lists to a boolean value.
+
* [`-any?`](#-any-pred-list) `(pred list)`
* [`-all?`](#-all-pred-list) `(pred list)`
* [`-none?`](#-none-pred-list) `(pred list)`
@@ -246,7 +247,8 @@ Functions partitioning the input list into a list of lists.
### Indexing
-Return indices of elements based on predicates, sort elements by indices etc.
+Functions retrieving or sorting based on list indices and
+related predicates.
* [`-elem-index`](#-elem-index-elem-list) `(elem list)`
* [`-elem-indices`](#-elem-indices-elem-list) `(elem list)`
@@ -316,6 +318,9 @@ Functions pretending lists are trees.
### Threading macros
+Macros that conditionally combine sequential forms for brevity
+or readability.
+
* [`->`](#--x-optional-form-rest-more) `(x &optional form &rest more)`
* [`->>`](#--x-optional-form-rest-more) `(x &optional form &rest more)`
* [`-->`](#---x-rest-forms) `(x &rest forms)`
@@ -327,7 +332,7 @@ Functions pretending lists are trees.
### Binding
-Convenient versions of `let` and `let*` constructs combined with flow control.
+Macros that combine `let` and `let*` with destructuring and flow control.
* [`-when-let`](#-when-let-var-val-rest-body) `((var val) &rest body)`
* [`-when-let*`](#-when-let-vars-vals-rest-body) `(vars-vals &rest body)`
@@ -351,12 +356,16 @@ Functions iterating over lists for side effect only.
### Destructive operations
+Macros that modify variables holding lists.
+
* [`!cons`](#cons-car-cdr) `(car cdr)`
* [`!cdr`](#cdr-list) `(list)`
### Function combinators
-These combinators require Emacs 24 for its lexical scope. So they are offered
in a separate package: `dash-functional`.
+Functions that manipulate and compose other functions. They
+are currently offered in the separate package `dash-functional`
+for historical reasons, and will soon be absorbed by `dash`.
* [`-partial`](#-partial-fn-rest-args) `(fn &rest args)`
* [`-rpartial`](#-rpartial-fn-rest-args) `(fn &rest args)`
@@ -1257,6 +1266,8 @@ the new seed.
## Predicates
+Reductions of one or more lists to a boolean value.
+
#### -any? `(pred list)`
Return t if (`pred` x) is non-nil for any x in `list`, else nil.
@@ -1580,7 +1591,8 @@ elements of `list`. Keys are compared by `equal`.
## Indexing
-Return indices of elements based on predicates, sort elements by indices etc.
+Functions retrieving or sorting based on list indices and
+related predicates.
#### -elem-index `(elem list)`
@@ -2264,6 +2276,9 @@ structure such as plist or alist.
## Threading macros
+Macros that conditionally combine sequential forms for brevity
+or readability.
+
#### -> `(x &optional form &rest more)`
Thread the expr through the forms. Insert `x` as the second item
@@ -2367,7 +2382,7 @@ which `forms` may have modified by side effect.
## Binding
-Convenient versions of `let` and `let*` constructs combined with flow control.
+Macros that combine `let` and `let*` with destructuring and flow control.
#### -when-let `((var val) &rest body)`
@@ -2756,6 +2771,8 @@ This function's anaphoric counterpart is `--dotimes`.
## Destructive operations
+Macros that modify variables holding lists.
+
#### !cons `(car cdr)`
Destructive: Set `cdr` to the cons of `car` and `cdr`.
@@ -2776,7 +2793,9 @@ Destructive: Set `list` to the cdr of `list`.
## Function combinators
-These combinators require Emacs 24 for its lexical scope. So they are offered
in a separate package: `dash-functional`.
+Functions that manipulate and compose other functions. They
+are currently offered in the separate package `dash-functional`
+for historical reasons, and will soon be absorbed by `dash`.
#### -partial `(fn &rest args)`
@@ -3004,7 +3023,6 @@ This function satisfies the following laws:
(apply '+ (funcall (-prodfn 'length 'string-to-number) '((1 2 3) "15"))) ;; =>
18
```
-
## Contribute
Yes, please do. Pure functions in the list manipulation realm only,
diff --git a/dash-template.texi b/dash-template.texi
index 755fc56..9fc19cf 100644
--- a/dash-template.texi
+++ b/dash-template.texi
@@ -206,8 +206,8 @@ example, which demonstrates the utility of both versions.
@menu
@c [[ function-list ]]
@end menu
-@c [[ function-docs ]]
+@c [[ function-docs ]]
@node Development
@chapter Development
diff --git a/dash.texi b/dash.texi
index a45412a..c0e457f 100644
--- a/dash.texi
+++ b/dash.texi
@@ -1721,6 +1721,8 @@ the new seed.
@node Predicates
@section Predicates
+Reductions of one or more lists to a boolean value.
+
@anchor{-any?}
@defun -any? (pred list)
Return t if (@var{pred} x) is non-nil for any x in @var{list}, else nil.
@@ -2306,7 +2308,8 @@ elements of @var{list}. Keys are compared by
@code{equal}.
@node Indexing
@section Indexing
-Return indices of elements based on predicates, sort elements by indices etc.
+Functions retrieving or sorting based on list indices and
+related predicates.
@anchor{-elem-index}
@defun -elem-index (elem list)
@@ -3455,6 +3458,9 @@ structure such as plist or alist.
@node Threading macros
@section Threading macros
+Macros that conditionally combine sequential forms for brevity
+or readability.
+
@anchor{->}
@defmac -> (x &optional form &rest more)
Thread the expr through the forms. Insert @var{x} as the second item
@@ -3639,7 +3645,7 @@ which @var{forms} may have modified by side effect.
@node Binding
@section Binding
-Convenient versions of `let` and `let*` constructs combined with flow control.
+Macros that combine @code{let} and @code{let*} with destructuring and flow
control.
@anchor{-when-let}
@defmac -when-let ((var val) &rest body)
@@ -4164,6 +4170,8 @@ This function's anaphoric counterpart is @code{--dotimes}.
@node Destructive operations
@section Destructive operations
+Macros that modify variables holding lists.
+
@anchor{!cons}
@defmac !cons (car cdr)
Destructive: Set @var{cdr} to the cons of @var{car} and @var{cdr}.
@@ -4199,7 +4207,9 @@ Destructive: Set @var{list} to the cdr of @var{list}.
@node Function combinators
@section Function combinators
-These combinators require Emacs 24 for its lexical scope. So they are offered
in a separate package: `dash-functional`.
+Functions that manipulate and compose other functions. They
+are currently offered in the separate package @code{dash-functional}
+for historical reasons, and will soon be absorbed by @code{dash}.
@anchor{-partial}
@defun -partial (fn &rest args)
diff --git a/dev/dash-defs.el b/dev/dash-defs.el
new file mode 100644
index 0000000..af73bb9
--- /dev/null
+++ b/dev/dash-defs.el
@@ -0,0 +1,341 @@
+;;; dash-defs.el --- Definitions for Dash examples -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'dash)
+
+;; Added in Emacs 24.4; wrap in `eval-when-compile' when support is dropped.
+(require 'subr-x nil t)
+(declare-function string-remove-prefix "subr-x" (prefix string))
+(declare-function string-remove-suffix "subr-x" (suffix string))
+
+(defvar dash--groups ()
+ "Alist of grouped examples.
+
+Each element is of the form (NAME . DOC) or (FN . EXAMPLES)
+corresponding to the eponymous arguments of `def-example-group'
+and `defexamples', respectively. The only difference is that
+EXAMPLES are partitioned into triples (ACTUAL OP EXPECTED), where
+EXPECTED should be the result of evaluating ACTUAL, and OP is one
+of the following comparison operators:
+
+- `=>' ACTUAL should be `equal' to EXPECTED.
+- `~>' ACTUAL should be `approx-equal' to EXPECTED.
+- `!!>' ACTUAL should signal the EXPECTED error,
+ either an error symbol or an error object.")
+
+(defvar dash--epsilon 1e-15
+ "Epsilon used in `approx-equal'.")
+
+(defun approx-equal (u v)
+ "Like `=', but compares floats within `dash--epsilon'.
+This allows approximate comparison of floats to work around
+differences in implementation between systems. Used in place of
+`equal' when testing actual and expected values with `~>'."
+ (or (= u v)
+ (< (/ (abs (- u v))
+ (max (abs u) (abs v)))
+ dash--epsilon)))
+
+(defun dash--example-to-test (example)
+ "Return an ERT assertion form based on EXAMPLE."
+ (pcase example
+ (`(,actual => ,expected) `(should (equal ,actual ,expected)))
+ (`(,actual ~> ,expected) `(should (approx-equal ,actual ,expected)))
+ (`(,actual !!> ,(and (pred symbolp) expected))
+ ;; FIXME: Tests fail on Emacs 24-25 without `eval' for some reason.
+ `(should-error (eval ',actual ,lexical-binding) :type ',expected))
+ (`(,actual !!> ,expected)
+ `(should (equal (should-error ,actual) ',expected)))
+ (_ (error "Invalid test case: %S" example))))
+
+(defmacro def-example-group (name doc &rest examples)
+ "Define a group with NAME and DOC of EXAMPLES of several functions.
+See `dash--groups'."
+ `(progn
+ (push (cons ,name ,doc) dash--groups)
+ ,@examples))
+
+(defmacro defexamples (fn &rest examples)
+ "Define a set of EXAMPLES and corresponding ERT tests for FN.
+See `dash--groups'."
+ (setq examples (-partition 3 examples))
+ `(progn
+ (push (cons ',fn ',examples) dash--groups)
+ (ert-deftest ,fn () ,@(mapcar #'dash--example-to-test examples))))
+
+(autoload 'help-fns--analyze-function "help-fns")
+
+(defun dash--describe (fn)
+ "Return the (ARGLIST . DOCSTRING) of FN symbol.
+Based on `describe-function-1'."
+ ;; Added in Emacs 25.1.
+ (defvar text-quoting-style)
+ ;; Gained last arg in Emacs 25.1.
+ (declare-function help-fns--signature "help-fns"
+ (function doc real-def real-function buffer))
+ (or (get fn 'dash-doc)
+ (with-temp-buffer
+ (pcase-let* ((text-quoting-style 'grave)
+ (`(,real-fn ,_def ,_alias ,real-def)
+ (help-fns--analyze-function fn))
+ (buf (current-buffer))
+ (doc-raw (documentation fn t))
+ (doc (help-fns--signature
+ fn doc-raw real-def real-fn buf)))
+ (goto-char (1+ (point-min)))
+ (delete-region (point) (progn (forward-sexp) (1+ (point))))
+ (downcase-region (point) (point-max))
+ (backward-char)
+ ;; Memoize.
+ (put fn 'dash-doc (cons (read buf) doc))))))
+
+(defun dash--replace-all (old new)
+ "Replace occurrences of OLD with NEW in current buffer."
+ (goto-char (point-min))
+ (while (search-forward old nil t)
+ (replace-match new t t)))
+
+(defun dash--github-link (fn)
+ "Return a GitHub Flavored Markdown link to FN."
+ (or (get fn 'dash-link)
+ (let* ((sig (car (dash--describe fn)))
+ (id (string-remove-prefix "!" (format "%s%s" fn sig)))
+ (id (replace-regexp-in-string (rx (+ (not (in alnum ?-))))
+ "-" id t t))
+ (id (string-remove-suffix "-" id)))
+ ;; Memoize.
+ (put fn 'dash-link (format "[`%s`](#%s)" fn id)))))
+
+(defun dash--argnames-to-md ()
+ "Downcase and quote arg names in current buffer for Markdown."
+ (let ((beg (point-min)))
+ (while (setq beg (text-property-any beg (point-max)
+ 'face 'help-argument-name))
+ (goto-char beg)
+ (insert ?`)
+ (goto-char (or (next-single-property-change (point) 'face)
+ (point-max)))
+ (downcase-region (1+ beg) (point))
+ (insert ?`)
+ (setq beg (point)))))
+
+(defun dash--metavars-to-md ()
+ "Downcase and quote metavariables in current buffer for Markdown."
+ (goto-char (point-min))
+ (while (re-search-forward (rx bow (group (in upper) (* (in upper ?-)) (*
num))
+ (| (group ?\() (: (group (? "th")) eow)))
+ nil t)
+ (unless (match-beginning 2)
+ (let* ((suf (match-string 3))
+ (var (format "`%s`%s" (downcase (match-string 1)) suf)))
+ (replace-match var t t)))))
+
+(defun dash--hyperlinks-to-md ()
+ "Convert hyperlinks in current buffer from Elisp to Markdown."
+ (goto-char (point-min))
+ (while (re-search-forward (rx ?` (+? (not (in " `"))) ?\') nil t)
+ (let ((fn (intern (substring (match-string 0) 1 -1))))
+ (replace-match (if (assq fn dash--groups)
+ (save-match-data (dash--github-link fn))
+ (format "`%s`" fn))
+ t t))))
+
+(defun dash--indent-md-blocks ()
+ "Indent example blocks in current buffer for Markdown."
+ (goto-char (point-min))
+ (while (re-search-forward (rx bol " ") nil t)
+ (replace-match " " t t)))
+
+(defun dash--docstring-to-md (doc)
+ "Transcribe DOC to Markdown syntax."
+ (with-temp-buffer
+ (insert doc)
+ (dash--argnames-to-md)
+ (dash--metavars-to-md)
+ (dash--hyperlinks-to-md)
+ (dash--indent-md-blocks)
+ (buffer-string)))
+
+(defun dash--docstring-to-texi (doc)
+ "Transcribe DOC to Texinfo syntax."
+ (with-temp-buffer
+ (insert doc)
+ ;; Escape literal ?@.
+ (dash--replace-all "@" "@@")
+ (goto-char (point-min))
+ ;; TODO: Use `help-argument-name' like in `dash--argnames-to-md'?
+ (while (re-search-forward
+ (rx (| (group bow (in "A-Z") (* (in "A-Z" ?-)) (* num) eow)
+ (: ?` (group (+ (not (in ?\s)))) ?\')
+ (: "..." (? (group eol)))))
+ nil t)
+ (cond ((match-beginning 1)
+ ;; Downcase metavariable reference.
+ (downcase-region (match-beginning 1) (match-end 1))
+ (replace-match "@var{\\1}" t))
+ ((match-beginning 2)
+ ;; `quoted' symbol.
+ (replace-match (if (assq (intern (match-string 2)) dash--groups)
+ "@code{\\2} (@pxref{\\2})"
+ "@code{\\2}")
+ t))
+ ;; Ellipses.
+ ((match-beginning 3) (replace-match "@enddots{}" t t))
+ ((replace-match "@dots{}" t t))))
+ (buffer-string)))
+
+(defun dash--lisp-to-md (obj)
+ "Print Lisp OBJ suitably for Markdown."
+ ;; Added in Emacs 26.1.
+ (defvar print-escape-control-characters)
+ (let ((print-quoted t)
+ (print-escape-control-characters t))
+ (save-excursion (prin1 obj)))
+ (while (re-search-forward (rx (| (group ?\' symbol-start "nil" symbol-end)
+ (group "\\00") "\\?"))
+ nil 'move)
+ (replace-match (cond ((match-beginning 1) "()") ; 'nil -> ().
+ ((match-beginning 2) "\\") ; \00N -> \N.
+ ("?")) ; `-any\?' -> `-any?'.
+ t t)))
+
+(defun dash--lisp-to-texi (obj)
+ "Print Lisp OBJ suitably for Texinfo."
+ (save-excursion (dash--lisp-to-md obj))
+ (while (re-search-forward (rx (in "{}")) nil 'move)
+ (replace-match "@\\&" t))) ;; { -> @{.
+
+(defun dash--expected (obj err)
+ "Prepare OBJ for printing as an expected evaluation result.
+ERR non-nil means OBJ is either an error symbol or error object."
+ (cond ((and (eq (car-safe obj) 'quote)
+ (not (equal obj ''())))
+ ;; Unquote expected result.
+ (cadr obj))
+ ;; Print actual error message.
+ (err (error-message-string (-list obj)))
+ (obj)))
+
+(defun dash--example-to-md (example)
+ "Return a Markdown string documenting EXAMPLE."
+ (pcase-let* ((`(,actual ,op ,expected) example)
+ (err (eq op '!!>)))
+ (setq expected (dash--expected expected err))
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (dash--lisp-to-md actual)
+ (insert " ;; ")
+ (cond ((memq op '(=> ~>))
+ (princ op)
+ (insert ?\s)
+ (dash--lisp-to-md expected))
+ (err (princ expected))
+ ((error "Invalid test case: %S" example)))))))
+
+(defun dash--example-to-texi (example)
+ "Return a Texinfo string documenting EXAMPLE."
+ (pcase-let* ((`(,actual ,op ,expected) example)
+ (err (eq op '!!>)))
+ (setq expected (dash--expected expected err))
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (insert "@group\n")
+ (dash--lisp-to-texi actual)
+ (insert "\n " (if err "@error{}" "@result{}") ?\s)
+ (funcall (if err #'princ #'dash--lisp-to-texi) expected)
+ (insert "\n@end group")))))
+
+(defun dash--group-to-md (group)
+ "Return a Markdown string documenting GROUP."
+ (pcase group
+ (`(,(and (pred stringp) name) . ,doc)
+ (concat "## " name "\n\n" (dash--docstring-to-md doc) "\n"))
+ ((and `(,fn . ,examples)
+ (let `(,sig . ,doc) (dash--describe fn)))
+ (format "#### %s `%s`\n\n%s\n\n```el\n%s\n```\n"
+ fn sig (dash--docstring-to-md doc)
+ (mapconcat #'dash--example-to-md (-take 3 examples) "\n")))))
+
+(defun dash--group-to-texi (group)
+ "Return a Texinfo string documenting GROUP."
+ ;; Added in Emacs 24.4.
+ (declare-function macrop "subr" (object))
+ (pcase group
+ (`(,(and (pred stringp) name) . ,doc)
+ (concat "@node " name "\n@section " name "\n\n"
+ (dash--docstring-to-texi doc) "\n"))
+ ((and `(,fn . ,examples)
+ (let `(,sig . ,doc) (dash--describe fn))
+ (let type (if (macrop fn) "defmac" "defun")))
+ (format (concat "@anchor{%s}\n"
+ "@%s %s %s\n"
+ "%s\n\n"
+ "@example\n%s\n@end example\n"
+ "@end %s\n")
+ fn type fn sig (dash--docstring-to-texi doc)
+ (mapconcat #'dash--example-to-texi (-take 3 examples) "\n")
+ type))))
+
+(defun dash--summary-to-md (group)
+ "Return a Markdown string summarizing GROUP."
+ (pcase group
+ (`(,(and (pred stringp) name) . ,doc)
+ (concat "\n### " name "\n\n" (dash--docstring-to-md doc) "\n"))
+ ((and `(,fn . ,_) (let sig (car (dash--describe fn))))
+ (format "* %s `%s`" (dash--github-link fn) sig))))
+
+(autoload 'lm-version "lisp-mnt")
+
+(defun dash--make-md ()
+ "Generate Markdown README."
+ (with-temp-file "README.md"
+ (insert-file-contents "readme-template.md")
+ (dolist (pkg '(dash dash-functional))
+ (dash--replace-all (format "[[ %s-version ]]" pkg)
+ (lm-version (format "%s.el" pkg))))
+ (dash--replace-all "[[ function-list ]]"
+ (mapconcat #'dash--summary-to-md dash--groups "\n"))
+ (dash--replace-all "[[ function-docs ]]"
+ (mapconcat #'dash--group-to-md dash--groups "\n"))))
+
+(defun dash--make-texi ()
+ "Generate Texinfo manual."
+ (with-temp-file "dash.texi"
+ (insert-file-contents "dash-template.texi")
+ (dolist (pkg '(dash dash-functional))
+ (dash--replace-all (format "@c [[ %s-version ]]" pkg)
+ (lm-version (format "%s.el" pkg))))
+ (dash--replace-all
+ "@c [[ function-list ]]"
+ (mapconcat (lambda (group) (concat "* " (car group) "::"))
+ (--filter (stringp (car it)) dash--groups)
+ "\n"))
+ (dash--replace-all "@c [[ function-docs ]]"
+ (mapconcat #'dash--group-to-texi dash--groups "\n"))))
+
+(defun dash-make-docs ()
+ "Generate Dash Markdown README and Texinfo manual."
+ (let ((dash--groups (reverse dash--groups))
+ (case-fold-search nil))
+ (dash--make-md)
+ (dash--make-texi)))
+
+(provide 'dash-defs)
+
+;;; dash-defs.el ends here
diff --git a/dev/examples-to-docs.el b/dev/examples-to-docs.el
deleted file mode 100644
index b2a073e..0000000
--- a/dev/examples-to-docs.el
+++ /dev/null
@@ -1,190 +0,0 @@
-;;; examples-to-docs.el --- Extract dash.el's doc from examples.el -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
-
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; FIXME: Lots of duplication with examples-to-info.el.
-
-;;; Code:
-
-(require 'dash)
-
-(require 'help-fns)
-(require 'lisp-mnt)
-
-(eval-when-compile
- (require 'subr-x))
-
-(defvar functions ())
-
-(defun dash--print-lisp-as-md (obj)
- "Print Lisp OBJ suitably for Markdown."
- (let ((print-quoted t)
- (print-escape-control-characters t))
- (save-excursion (prin1 obj)))
- (while (re-search-forward (rx (| (group ?\' symbol-start "nil" symbol-end)
- (group "\\00") "\\?"))
- nil 'move)
- (replace-match (cond ((match-beginning 1) "()") ; 'nil -> ().
- ((match-beginning 2) "\\") ; \00N -> \N.
- ("?")) ; `-any\?' -> `-any?'.
- t t)))
-
-(defun example-to-string (example)
- (pcase-let ((`(,actual ,sym ,expected) example))
- (cond ((eq sym '!!>)
- ;; Print actual error message.
- (setq expected (error-message-string (-list expected))))
- ((and (eq (car-safe expected) 'quote)
- (not (equal expected ''())))
- ;; Unquote expected result.
- (setq expected (cadr expected))))
- (with-output-to-string
- (with-current-buffer standard-output
- (dash--print-lisp-as-md actual)
- (insert " ;; ")
- (cond ((memq sym '(=> ~>))
- (princ sym)
- (insert ?\s)
- (dash--print-lisp-as-md expected))
- ((eq sym '!!>) (princ expected))
- ((error "Invalid test case: %S" example)))))))
-
-(defun dash--describe (fn)
- "Return the (ARGLIST DOCSTRING) of FN symbol.
-Based on `describe-function-1'."
- (with-temp-buffer
- (pcase-let* ((text-quoting-style 'grave)
- (`(,real-fn ,def ,_alias ,real-def)
- (help-fns--analyze-function fn))
- (buf (current-buffer))
- (doc-raw (documentation fn t))
- (doc (help-fns--signature fn doc-raw real-def real-fn buf)))
- (goto-char (1+ (point-min)))
- (delete-region (point) (progn (forward-sexp) (1+ (point))))
- (downcase-region (point) (point-max))
- (backward-char)
- (list (read buf) doc))))
-
-(defmacro defexamples (cmd &rest examples)
- `(push (cons ',cmd
- (nconc (dash--describe ',cmd)
- (list (-partition 3 ',examples))))
- functions))
-
-(defmacro def-example-group (group desc &rest examples)
- `(progn
- (push ,(propertize group 'dash-group t) functions)
- (when ,desc
- (push ,desc functions))
- ,@examples))
-
-(defun format-link (name)
- (pcase (assq (intern name) functions)
- (`(,_ ,signature . ,_) (dash--github-link name signature))
- (_ (format "`%s`" name))))
-
-(defun dash--quote-argnames ()
- "Downcase and quote arg names in current buffer for Markdown."
- (let ((beg (point-min)))
- (while (setq beg (text-property-any beg (point-max)
- 'face 'help-argument-name))
- (goto-char beg)
- (insert ?`)
- (goto-char (or (next-single-property-change (point) 'face)
- (point-max)))
- (downcase-region (1+ beg) (point))
- (insert ?`)
- (setq beg (point)))))
-
-(defun dash--quote-metavars ()
- "Downcase and quote metavariables in current buffer for Markdown."
- (goto-char (point-min))
- (while (re-search-forward (rx bow (group (in upper) (* (in upper ?-)) (*
num))
- (| (group ?\() (: (group (? "th")) eow)))
- nil t)
- (unless (match-beginning 2)
- (let* ((suf (match-string 3))
- (var (format "`%s`%s" (downcase (match-string 1)) suf)))
- (replace-match var t t)))))
-
-(defun dash--quote-hyperlinks ()
- "Convert hyperlinks in current buffer from Elisp to Markdown."
- (goto-char (point-min))
- (while (re-search-forward (rx ?` (+? (not (in " `"))) ?\') nil t)
- (replace-match (format-link (substring (match-string 0) 1 -1)) t t)))
-
-(defun dash--indent-blocks ()
- "Indent example blocks in current buffer for Markdown."
- (goto-char (point-min))
- (while (re-search-forward (rx bol " ") nil t)
- (replace-match " " t t)))
-
-(defun dash--format-docstring (docstring)
- (with-temp-buffer
- (let ((case-fold-search nil))
- (insert docstring)
- (dash--quote-argnames)
- (dash--quote-metavars)
- (dash--quote-hyperlinks)
- (dash--indent-blocks)
- (buffer-string))))
-
-(defun function-to-md (function)
- (pcase function
- (`(,command-name ,signature ,docstring ,examples)
- (format "#### %s `%s`\n\n%s\n\n```el\n%s\n```\n"
- command-name
- signature
- (dash--format-docstring docstring)
- (mapconcat #'example-to-string (-take 3 examples) "\n")))
- ((pred (get-text-property 0 'dash-group))
- (concat "## " function "\n"))
- (_ (concat function "\n"))))
-
-(defun dash--github-link (fn signature)
- (--> (string-remove-prefix "!" (format "%s%s" fn signature))
- (replace-regexp-in-string (rx (+ (not (in alnum ?-)))) "-" it t t)
- (format "[`%s`](#%s)" fn (string-remove-suffix "-" it))))
-
-(defun function-summary (function)
- (pcase function
- (`(,fn ,signature . ,_)
- (format "* %s `%s`" (dash--github-link fn signature) signature))
- ((pred (get-text-property 0 'dash-group))
- (concat "\n### " function "\n"))
- (_ (concat function "\n"))))
-
-(defun dash--replace-all (old new)
- "Replace occurrences of OLD with NEW in current buffer."
- (goto-char (point-min))
- (while (search-forward old nil t)
- (replace-match new t t)))
-
-(defun create-docs-file ()
- (let ((functions (reverse functions)))
- (with-temp-file "README.md"
- (insert-file-contents "readme-template.md")
- (dolist (pkg '(dash dash-functional))
- (dash--replace-all (format "[[ %s-version ]]" pkg)
- (lm-version (format "%s.el" pkg))))
- (dash--replace-all "[[ function-list ]]"
- (mapconcat #'function-summary functions "\n"))
- (dash--replace-all "[[ function-docs ]]"
- (mapconcat #'function-to-md functions "\n")))))
-
-;;; examples-to-docs.el ends here
diff --git a/dev/examples-to-info.el b/dev/examples-to-info.el
deleted file mode 100644
index 60c6c56..0000000
--- a/dev/examples-to-info.el
+++ /dev/null
@@ -1,165 +0,0 @@
-;;; examples-to-info.el --- Extract dash.el's Info from examples.el -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
-
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; FIXME: Lots of duplication with examples-to-docs.el.
-
-;;; Code:
-
-(require 'dash)
-
-(require 'help-fns)
-(require 'lisp-mnt)
-
-(defvar functions ())
-
-(defun dash--print-lisp-as-texi (obj)
- "Print Lisp OBJ suitably for Texinfo."
- (let ((print-quoted t)
- (print-escape-control-characters t)
- (case-fold-search nil))
- (save-excursion (prin1 obj))
- (while (re-search-forward (rx (| (group ?\' symbol-start "nil" symbol-end)
- (group "\\?") (group "\\00") (in "{}")))
- nil 'move)
- (replace-match (cond ((match-beginning 1) "()") ; 'nil -> ().
- ((match-beginning 2) "?") ; `-any\?' -> `-any?'.
- ((match-beginning 3) "\\\\") ; \00N -> \N.
- ("@\\&")) ; { -> @{.
- t))))
-
-(defun example-to-string (example)
- (pcase-let* ((`(,actual ,err ,expected) example)
- (err (eq err '!!>)))
- (cond (err
- ;; Print actual error message.
- (setq expected (error-message-string (-list expected))))
- ((and (eq (car-safe expected) 'quote)
- (not (equal expected ''())))
- ;; Unquote expected result.
- (setq expected (cadr expected))))
- (with-output-to-string
- (with-current-buffer standard-output
- (insert "@group\n")
- (dash--print-lisp-as-texi actual)
- (insert "\n " (if err "@error{}" "@result{}") ?\s)
- (funcall (if err #'princ #'dash--print-lisp-as-texi) expected)
- (insert "\n@end group")))))
-
-(defun dash--describe (fn)
- "Return the (ARGLIST DOCSTRING) of FN symbol.
-Based on `describe-function-1'."
- (with-temp-buffer
- (pcase-let* ((text-quoting-style 'grave)
- (`(,real-fn ,def ,_alias ,real-def)
- (help-fns--analyze-function fn))
- (buf (current-buffer))
- (doc-raw (documentation fn t))
- (doc (help-fns--signature fn doc-raw real-def real-fn buf)))
- (goto-char (1+ (point-min)))
- (delete-region (point) (progn (forward-sexp) (1+ (point))))
- (downcase-region (point) (point-max))
- (backward-char)
- (list (read buf) doc))))
-
-(defmacro defexamples (cmd &rest examples)
- `(push (cons ',cmd
- (nconc (dash--describe ',cmd)
- (list (-partition 3 ',examples))))
- functions))
-
-(defmacro def-example-group (group desc &rest examples)
- `(progn
- (push ,(propertize group 'dash-group t) functions)
- (when ,desc
- (push ,desc functions))
- ,@examples))
-
-(defun format-docstring (docstring)
- (let ((case-fold-search nil))
- (with-temp-buffer
- (insert docstring)
- ;; Escape literal ?@.
- (dash--replace-all "@" "@@")
- (goto-char (point-min))
- (while (re-search-forward
- (rx (| (group bow (in "A-Z") (* (in "A-Z" ?-)) (* num) eow)
- (: ?` (group (+ (not (in ?\s)))) ?\')
- (: "..." (? (group eol)))))
- nil t)
- (cond ((match-beginning 1)
- ;; Downcase metavariable reference.
- (downcase-region (match-beginning 1) (match-end 1))
- (replace-match "@var{\\1}" t))
- ((match-beginning 2)
- ;; `quoted' symbol.
- (replace-match (if (assq (intern (match-string 2)) functions)
- "@code{\\2} (@pxref{\\2})"
- "@code{\\2}")
- t))
- ;; Ellipses.
- ((match-beginning 3) (replace-match "@enddots{}" t t))
- ((replace-match "@dots{}" t t))))
- (buffer-string))))
-
-(defun function-to-info (function)
- (pcase function
- (`(,command-name ,signature ,docstring ,examples)
- (let ((type (if (macrop command-name) "defmac" "defun")))
- (format (concat "\n@anchor{%s}\n"
- "@" type " %s %s\n"
- "%s\n\n"
- "@example\n%s\n@end example\n"
- "@end " type)
- command-name
- command-name
- signature
- (format-docstring docstring)
- (mapconcat #'example-to-string (-take 3 examples) "\n"))))
- ((pred (get-text-property 0 'dash-group))
- (concat "\n@node " function "\n@section " function))
- (_ (concat "\n" function))))
-
-(defun dash--replace-all (old new)
- "Replace occurrences of OLD with NEW in current buffer."
- (goto-char (point-min))
- (while (search-forward old nil t)
- (replace-match new t t)))
-
-(defun create-info-file ()
- (let ((functions (reverse functions)))
- (with-temp-file "dash.texi"
- (insert-file-contents "dash-template.texi")
-
- (dolist (pkg '(dash dash-functional))
- (dash--replace-all (format "@c [[ %s-version ]]" pkg)
- (lm-version (format "%s.el" pkg))))
-
- (dash--replace-all
- "@c [[ function-list ]]"
- (mapconcat (lambda (s) (concat "* " s "::"))
- (-filter (lambda (s)
- (and (stringp s)
- (get-text-property 0 'dash-group s)))
- functions)
- "\n"))
-
- (dash--replace-all "@c [[ function-docs ]]"
- (mapconcat #'function-to-info functions "\n")))))
-
-;;; examples-to-info.el ends here
diff --git a/dev/examples-to-tests.el b/dev/examples-to-tests.el
deleted file mode 100644
index 8fe6c02..0000000
--- a/dev/examples-to-tests.el
+++ /dev/null
@@ -1,50 +0,0 @@
-;;; examples-to-tests.el --- Extract dash.el's tests from examples.el -*-
lexical-binding: t -*-
-
-;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
-
-;; This program is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; FIXME: Lots of duplication with examples-to-info.el.
-
-;;; Code:
-
-(require 'ert)
-
-(defun example-to-should (actual sym expected)
- (cond ((eq sym '=>)
- `(should (equal ,actual ,expected)))
- ((eq sym '~>)
- `(should (approx-equal ,actual ,expected)))
- ((not (eq sym '!!>))
- (error "Invalid test case: %S" `(,actual ,sym ,expected)))
- ((symbolp expected)
- ;; FIXME: Tests fail on Emacs 24-25 without `eval' for some reason.
- `(should-error (eval ',actual ,lexical-binding) :type ',expected))
- (`(should (equal (should-error ,actual) ',expected)))))
-
-(defmacro defexamples (cmd &rest examples)
- (let (tests)
- (while examples
- (push (example-to-should (pop examples)
- (pop examples)
- (pop examples))
- tests))
- `(ert-deftest ,cmd () ,@(nreverse tests))))
-
-(defalias 'def-example-group #'ignore)
-
-(provide 'examples-to-tests)
-;;; examples-to-tests.el ends here
diff --git a/dev/examples.el b/dev/examples.el
index 391d16d..307f761 100644
--- a/dev/examples.el
+++ b/dev/examples.el
@@ -19,14 +19,15 @@
;; Only the first three examples per function are shown in the docs,
;; so make those good.
+;;
+;; Use the `~>' symbol instead of `=>' to test the expected and actual
+;; values with `approx-equal'.
;;; Code:
(require 'dash)
(require 'dash-functional)
-(eval-when-compile
- (unless (fboundp 'def-example-group)
- (require 'examples-to-tests "dev/examples-to-tests")))
+(require 'dash-defs "dev/dash-defs")
;; TODO: `setf' was introduced in Emacs 24.3, so remove this when
;; support for earlier versions is dropped.
@@ -44,17 +45,6 @@
`(if (hash-table-p ,source) (gethash ,key ,source)
(plist-get ,source ,key)))
-;; Allow approximate comparison of floating-point results, to work
-;; around differences in implementation between systems. Use the `~>'
-;; symbol instead of `=>' to test the expected and actual values with
-;; `approx-equal'
-(defvar dash--epsilon 1e-15)
-(defun approx-equal (u v)
- (or (= u v)
- (< (/ (abs (- u v))
- (max (abs u) (abs v)))
- dash--epsilon)))
-
(def-example-group "Maps"
"Functions in this category take a transforming function, which
is then applied sequentially to each or selected elements of the
@@ -624,7 +614,9 @@ value rather than consuming a list to produce a single
value."
(--unfold (when it (cons it (cdr it))) '(1 2 3 4)) => '((1 2 3 4) (2 3 4)
(3 4) (4))
(--unfold (when it (cons it (butlast it))) '(1 2 3 4)) => '((1 2 3 4) (1 2
3) (1 2) (1))))
-(def-example-group "Predicates" nil
+(def-example-group "Predicates"
+ "Reductions of one or more lists to a boolean value."
+
(defexamples -any?
(-any? 'even? '(1 2 3)) => t
(-any? 'even? '(1 3 5)) => nil
@@ -839,7 +831,8 @@ value rather than consuming a list to produce a single
value."
(--group-by (car (split-string it "/")) '("a/b" "c/d" "a/e")) => '(("a" .
("a/b" "a/e")) ("c" . ("c/d")))))
(def-example-group "Indexing"
- "Return indices of elements based on predicates, sort elements by indices
etc."
+ "Functions retrieving or sorting based on list indices and
+related predicates."
(defexamples -elem-index
(-elem-index 2 '(6 7 8 2 3 4)) => 3
@@ -1221,7 +1214,10 @@ value rather than consuming a list to produce a single
value."
(defexamples -clone
(let* ((a '(1 2 3)) (b (-clone a))) (nreverse a) b) => '(1 2 3)))
-(def-example-group "Threading macros" nil
+(def-example-group "Threading macros"
+ "Macros that conditionally combine sequential forms for brevity
+or readability."
+
(defexamples ->
(-> '(2 3 5)) => '(2 3 5)
(-> '(2 3 5) (append '(8 13))) => '(2 3 5 8 13)
@@ -1298,7 +1294,7 @@ value rather than consuming a list to produce a single
value."
(-doto (cons 1 2)) => '(1 . 2)))
(def-example-group "Binding"
- "Convenient versions of `let` and `let*` constructs combined with flow
control."
+ "Macros that combine `let' and `let*' with destructuring and flow control."
(defexamples -when-let
(-when-let (match-index (string-match "d" "abcd")) (+ match-index 2)) => 5
@@ -1615,7 +1611,9 @@ value rather than consuming a list to produce a single
value."
(let (s) (--dotimes 3 (push it s) (setq it -1)) s) => '(2 1 0)
(--dotimes 3 t) => nil))
-(def-example-group "Destructive operations" nil
+(def-example-group "Destructive operations"
+ "Macros that modify variables holding lists."
+
(defexamples !cons
(let (l) (!cons 5 l) l) => '(5)
(let ((l '(3))) (!cons 5 l) l) => '(5 3))
@@ -1625,8 +1623,9 @@ value rather than consuming a list to produce a single
value."
(let ((l '(3 5))) (!cdr l) l) => '(5)))
(def-example-group "Function combinators"
- "These combinators require Emacs 24 for its lexical scope. So they are
offered in a separate package: `dash-functional`."
-
+ "Functions that manipulate and compose other functions. They
+are currently offered in the separate package `dash-functional'
+for historical reasons, and will soon be absorbed by `dash'."
(defexamples -partial
(funcall (-partial '- 5) 3) => 2
(funcall (-partial '+ 5 2) 3) => 10)
diff --git a/readme-template.md b/readme-template.md
index 25edfa8..efd862c 100644
--- a/readme-template.md
+++ b/readme-template.md
@@ -118,11 +118,9 @@ The normal version can of course also be written as
follows:
```
This demonstrates the utility of both versions.
-
[[ function-list ]]
[[ function-docs ]]
-
## Contribute
Yes, please do. Pure functions in the list manipulation realm only,
- [elpa] externals/dash 999cae9 253/316: Fix short-circuiting of --first, (continued)
- [elpa] externals/dash 999cae9 253/316: Fix short-circuiting of --first, ELPA Syncer, 2021/02/15
- [elpa] externals/dash 3726eb1 254/316: Improve the examples of -some, ELPA Syncer, 2021/02/15
- [elpa] externals/dash b0bef0f 276/316: Don't set text-quoting-style globally, ELPA Syncer, 2021/02/15
- [elpa] externals/dash bedc804 282/316: Improve function-to-info, ELPA Syncer, 2021/02/15
- [elpa] externals/dash 9727f7c 288/316: Simplify Lisp -> Texinfo printing, ELPA Syncer, 2021/02/15
- [elpa] externals/dash 7b2584c 294/316: Simplify GitHub link creation, ELPA Syncer, 2021/02/15
- [elpa] externals/dash 7048e68 296/316: Restore some newlines in docstrings, ELPA Syncer, 2021/02/15
- [elpa] externals/dash f6554c3 298/316: Unquote results in README examples, ELPA Syncer, 2021/02/15
- [elpa] externals/dash 39e5b12 306/316: Merge pull request #370 from blc/news, ELPA Syncer, 2021/02/15
- [elpa] externals/dash af21da3 307/316: * dash-functional.el: Fix Author header., ELPA Syncer, 2021/02/15
- [elpa] externals/dash 9c6b979 309/316: Unify dev/examples-to-*.el files,
ELPA Syncer <=