emacs-elpa-diffs
[Top][All Lists]
Advanced

[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,



reply via email to

[Prev in Thread] Current Thread [Next in Thread]