bug#41127: [PATCH 1/2] Introduce (ice-9 command-line-processor) module.

[Dale Mellor <guile-qf1qmg@rdmp.org>]

* modules/ice-9/command-line-processor.scm:  new file
* modules/Makefile.am:  build command-line-processor.scm
* test-suite/tests/command-line-processor.test:  new file
* test-suite/Makefile.am:  run command-line-processor tests
---
 module/Makefile.am                           |   1 +
 module/ice-9/command-line-processor.scm      | 646 +++++++++++++++++++
 test-suite/Makefile.am                       |   1 +
 test-suite/tests/command-line-processor.test | 155 +++++
 4 files changed, 803 insertions(+)
 create mode 100644 module/ice-9/command-line-processor.scm
 create mode 100644 test-suite/tests/command-line-processor.test

diff --git a/module/Makefile.am b/module/Makefile.am
index 7d3f3280a..48e8faca2 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -65,6 +65,7 @@ SOURCES =					\
   ice-9/futures.scm				\
   ice-9/gap-buffer.scm				\
   ice-9/getopt-long.scm				\
+  ice-9/command-line-processor.scm		\
   ice-9/hash-table.scm				\
   ice-9/hcons.scm				\
   ice-9/history.scm				\
diff --git a/module/ice-9/command-line-processor.scm b/module/ice-9/command-line-processor.scm
new file mode 100644
index 000000000..8bd5690cc
--- /dev/null
+++ b/module/ice-9/command-line-processor.scm
@@ -0,0 +1,646 @@
+;;;; command-line-processor.scm --- command-line options processing
+;;;;                                                            -*- scheme -*-
+;;;;
+;;;; Copyright (C) 1998, 2001, 2006, 2009, 2011, 2020
+;;;;                                            Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;;;; 02110-1301 USA
+
+;;; Author: Dale Mellor <guile-qf1qmg@rdmp.org>   May, 2020
+
+;;; Commentary:
+
+;;; Where the Guile (ice-9 getopt-long) module, modelled after the GNU C
+;;; libraryʼs ‘getopt_long’ function, allows an application to construct
+;;; a grammar prescribing the decomposition of the command-line options,
+;;; this module, inspired by the C libraryʼs ‘argp’ parser, gives the
+;;; application a higher-level paradigm in which the command-line
+;;; processing is specified declaratively.  This includes enough of the
+;;; application meta-data and some fragmentary help strings for the
+;;; completely automatic generation of responses to GNU-standard
+;;; ‘--help’, ‘--version’ and ‘--usage’ options, thus alleviating the
+;;; need of the application itself to deal with these things.
+;;;
+;;; The module has three specific aims.
+;;;
+;;;    1) Provide higher-level declarative interface, easier to use.
+;;;
+;;;    2) Automatically respond to --help, --version and --usage
+;;;       options.
+;;;
+;;;    3) Allow amalgamation of specifications, so that an application
+;;;       can mix in requirements from modules into its own option
+;;;       specification--THIS IS NOT CURRENTLY IMPLEMENTED.
+;;;
+;;; There is just one function which needs to be called to get all of
+;;; this functionality: it is ‘process-command-line’, and has the side
+;;; effect that new variable bindings appear in the current module
+;;; corresponding to all the options.  For example, if a declared option
+;;; is ‘--do-this’, then a variable called, literally, ‘--do-this’ will
+;;; be injected in the current namespace and will have the value
+;;; provided on the command-line, or simply #t or #f to indicate whether
+;;; or not that option was present on the command line.
+;;;
+;;; Alternatively, it is possible to create and compose the
+;;; specification in separate steps, and then call the above method with
+;;; the results.  The functions ‘command-line-specification’ and
+;;; ‘merge-command-line-specifications’ are provided to this end.
+
+;;; (process-command-line  COMMAND-LINE  SPECIFICATION)
+;;; Process the COMMAND-LINE according to the application SPECIFICATION.
+;;;
+;;; COMMAND-LINE is a list of strings, such as that returned from the
+;;; core ‘command-line’ function.
+;;;
+;;; SPECIFICATION is a form holding a space-separated mix of selection
+;;; words followed by their respective declarations.  The selection
+;;; words are ‘application’, ‘author’, ‘bug-address’, ‘copyright’,
+;;; ‘help-preamble’, ‘help-postamble’, ‘license’, ‘option’, ‘usage’ and
+;;; ‘version’, and can appear in any order.
+;;;
+;;;    ‘application’ should be followed by a string: the name of the
+;;;           application with possibly the package name in
+;;;           parentheses afterwards
+;;;    ‘author’ should be followed by a string giving the name of one of
+;;;           the packageʼs authors.  This selection word can be
+;;;           repeated as many times as necessary to provide the names
+;;;           of all authors.
+;;;    ‘bug-address’ should be followed by a string giving the URL of a
+;;;           contact-point for sending bug reports, such as an
+;;;           e-mail address or web address of bug-tracking system
+;;;           interface
+;;;    ‘copyright’ should be followed by a string containing a list of
+;;;           years and an entity to whom the copyright is assigned.
+;;;           This may be repeated to list other assignees
+;;;    ‘help-preamble’ should be followed by a number of strings which
+;;;           make up a short paragraph of text displayed before
+;;;           a full list of the available program options
+;;;    ‘help-postamble’, like the preamble, is followed by strings which
+;;;           make up a paragraph of text, shown after the list
+;;;           of options
+;;;    ‘license’ can be followed by one of the words ‘GPLv3’ [this is
+;;;           currently the only standard choice implemented], or else
+;;;           a string which briefly gives out the terms of the license
+;;;    ‘option’ is followed by an option declaration, described below
+;;;    ‘usage’ is followed by a string describing the usage of the
+;;;           application on one line
+;;;    ‘version’ is followed by a string providing the current version
+;;;           number of this program
+;;;
+;;; The ‘option’ declaration is followed by another form bracketed by
+;;; parentheses and holding a space-separated mix of declarations (order
+;;; irrelevant).
+;;;
+;;;    A word beginning with two hyphens, an optional exclamation point,
+;;;    alphabetic letters, an optional equals sign, and an optional
+;;;    further word.  There must be exactly one of these, and they
+;;;    determine the long name of the option.  An exclamation point
+;;;    indicates that the option MUST appear on the command line, an
+;;;    equals indicates that the option MUST have a value unless it is
+;;;    followed in the specification by a value, in which case the value
+;;;    on the command-line is optional and the one in the specification
+;;;    will be taken as the default when not given on the command line.
+;;;
+;;;    A word comprised of one hyphen and one letter.  There can be
+;;;    exactly zero or one of these, and it declares that the option has
+;;;    this short form available on the command-line.  As a very special
+;;;    exception: if you want to use ‘-i’ as an option, it must be
+;;;    specified with the identifier ‘short-i’ (a naked /-i/ is read as
+;;;    a complex number); ditto ‘short-I’ for ‘-I’.
+;;;
+;;;    A number of strings which are catenated together to provide a
+;;;    short, succinct description of the option.  These strings should
+;;;    be approximately half the width of a page, i.e. about 40
+;;;    characters.
+;;;
+;;;    A function which will be used as a predicate to decide if a value
+;;;    is allowable for this option.  There should be zero or one of
+;;;    these.
+;;;
+;;; For the precise presentation of options on the command-line, the
+;;; reader should refer to the description of the ‘getopt-long’ module,
+;;; which underlies the present one.
+;;;
+;;; At this point a short example is in order.  The main entry point for
+;;; the GNU Mcron program has as its first clause
+;;;
+;;; (process-command-line  (command-line)
+;;;       application   "mcron"
+;;;       version       "1.4"
+;;;       usage         "[OPTIONS]... [FILES]..."
+;;;       help-preamble
+;;;  "Run an mcron process according to the specifications in the FILE... "
+;;;  "(`-' for standard input), or use all the files in ~/.config/cron "
+;;;  "(or the deprecated ~/.cron) with .guile or .vixie extensions.\n"
+;;;  "Note that --daemon and --schedule are mutually exclusive."
+;;;       option  (--daemon  -d
+;;;                      "run as a daemon process")
+;;;       option  (--stdin=guile  -i  (λ (in) (or (string=? in "guile")
+;;;                                               (string=? in "vixie")))
+;;;                      "format of data passed as standard input or file "
+;;;                      "arguments, 'guile' or 'vixie' (default guile)")
+;;;       option  (--schedule=8  -s  string->number
+;;;                      "display the next N (or 8) jobs that will be run")
+;;;       help-postamble
+;;;  "Mandatory or optional arguments to long options are also mandatory or "
+;;;  "optional for any corresponding short options."
+;;;       bug-address "bug-mcron@gnu.org"
+;;;       copyright   "2003, 2006, 2014, 2020  Free Software Foundation, Inc."
+;;;       license     GPLv3)
+;;;
+;;; after which there are four new variable bindings in the present
+;;; namespace: --daemon, --stdin, --schedule and --! (the latter holds
+;;; all the command-line arguments that did not partake in option
+;;; processing) whose values depend on the specific command-line options
+;;; the end user furnished.
+
+;;; (command-line-specification  SPECIFICATION)
+;;; Compiles an object which encapsulates the given SPECIFICATION.
+;;;
+;;; For details of how to give a SPECIFICATION, see the description of
+;;; the full ‘process-command-line’ function above.  The return from
+;;; this method can be used in the partial version of
+;;; ‘process-command-line’ described below, and in the following
+;;; ‘merge-command-line-specifications’ function.
+
+;;; (merge-command-line-specifications SPECIFICATION_OBJECT ...)  Make a
+;;; single specification object which embodies the amalgamation of all
+;;; of the specification objects given as arguments.
+;;;
+;;; Order is important: if two option items specify the same short form
+;;; for the option (a single letter), then only the first option will
+;;; actually have that short form available at the command-line.
+;;; Similarly, if two options have exactly the same name, the second (or
+;;; later) ones will have a numerical digit appended to their name.
+
+;;; (process-command-line COMMAND-LINE SPECIFICATION-OBJECT) Perform
+;;; exactly the same function as the full ‘process-command-line’
+;;; function described above, but takes a pre-made specification object
+;;; produced using the two functions above.
+
+;;; Bugs/To do
+;;;
+;;; 1) This stuff currently only works in the top-level module.
+;;;
+;;; 2) Want to be able to amalgamate command-line specifications from
+;;; different modules.  Will need to get to the bottom of the first
+;;; issue before we can tackle this one (somehow need to put the
+;;; --option variable bindings into the right places, or at least
+;;; replicate them all in all modules which want to do some processing
+;;; of the command line).
+;;;
+;;; 3) Want more license boilerplate text; currently we only have GPLv3.
+
+;;; Code:
+
+(define-module  (ice-9  command-line-processor)
+  #:use-module (srfi srfi-1)       ;; fold
+  #:use-module (srfi srfi-9)       ;; Records
+  #:use-module (srfi srfi-9 gnu)   ;; set/get-fields
+  #:use-module (ice-9 getopt-long)
+  #:use-module (ice-9 regex)
+  #:export (specific   option   item
+            obtain-getopt-long-results
+            process-getopt-long-results
+            
+            ;; These are the real public exports.
+            process-command-line
+            command-line-specification
+            merge-command-line-specifications))
+
+
+
+(define-record-type  <<specification>>
+       (make-specification- preamble postamble copyright authors options)
+       specification?
+          (name        spec:name      spec:set-name!)
+          (version     spec:version   spec:set-version!)
+          (usage       spec:usage     spec:set-usage!)
+          (preamble    spec:preamble  spec:set-preamble!)
+          (postamble   spec:postamble spec:set-postamble!)
+          (bug-address spec:bugs      spec:set-bugs!)
+          (copyright   spec:copyright spec:set-copyright!)
+          (license     spec:license   spec:set-license!)
+          (authors     spec:authors   spec:set-authors!)
+          (options     spec:options   spec:set-all-options!))
+
+(define (make-specification) (make-specification- '() '() '() '() '()))
+
+
+
+(define-record-type  <<option>>
+       (make-option- description)
+       option?
+          (name         option:name         option:set-name!)
+          (required?    option:required?)
+          (short-letter option:short        option:set-short!)
+          (value?       option:value?)
+          (default      option:default)
+          (description  option:description  option:set-description!)
+          (predicate    option:predicate    option:set-predicate!))
+
+(define (make-option) (make-option- '()))
+
+
+
+            (define  (has-option-short-form  spec  letter)
+              (if (not letter)
+                  #f
+                  (let loop ((o (spec:options spec)))
+                       (cond  ((null? o)  #f)
+                              ((eq? letter (option:short (car o)))   #t)
+                              (else (loop (cdr o)))))))
+
+            (define  (has-option-name  spec  name)
+              (let loop ((o (spec:options spec)))
+                   (cond  ((null? o)  #f)
+                          ((string=? (option:name (car o)) name)  #t)
+                          (else  (loop (cdr o))))))
+
+(define  (merge-command-line-specifications  A  .  B)
+  "- Scheme Procedure: merge-command-line-specifications A B Append the
+list of options in A with those in B, but drop any short-forms in B
+which clash with existing ones, and if a long option name clashes then
+append a number to make it unique.  A and B will be mutilated in the
+process, a new specification object will be returned."
+  (for-each (λ (b-spec)
+    (for-each (λ (b-option)
+               (when (has-option-short-form A (option:short b-option))
+                 (option:set-short!  b-option  #f))
+               (when (has-option-name A (option:name b-option))
+                 (let ((base-name (option:name b-option)))
+                   (let loop ((count 1))
+                        (let ((new-name (string-append base-name "-"
+                                                       (number->string count))))
+                          (if (has-option-name A new-name)
+                              (loop (1+ count))
+                              (option:set-name!  b-option  new-name))))))
+               (spec:set-all-options!  A  (append (spec:options A)
+                                                  (list b-option))))
+           (spec:options b-spec)))
+       B)
+  A)
+
+
+
+(define  long-re   (make-regexp "^--(!)?([a-zA-Z][-_0-9a-zA-Z]*)(=(.+)?)?$"))
+(define  short-re  (make-regexp  "^-[a-zA-Z]$"))
+
+
+(define-syntax  item   ;; As in, an option item (long name, short form...).
+  (λ (x) (syntax-case x (short-i short-I)
+
+    ;; No more work to do.
+    ((item O) #'#t)
+
+    ;; Next option is a string: take as description.
+    ((item O desc args ...)
+     (string? (syntax->datum #'desc))
+            #'(begin (option:set-description! O (append  (option:description O)
+                                                         (list desc)))
+                     (item O args ...)))
+
+    ;; Next option is short-form.
+    ((item O short-i args ...)
+     #`(begin (option:set-short! O #\i)
+              (item O args ...)))
+
+    ((item O short-I args ...)
+     #`(begin (option:set-short! O #\I)
+              (item O args ...)))
+
+    ((item O short args ...)
+     (and (identifier? #'short)
+          (regexp-exec short-re (symbol->string (syntax->datum #'short))))
+     #`(begin (option:set-short! O (string-ref (symbol->string 'short) 1))
+              (item O args ...)))
+
+    ;; Next option is long-form.
+    ((item O long args ...)
+     (and (identifier? #'long)
+          (regexp-exec long-re (symbol->string (syntax->datum #'long))))
+     #`(begin (let ((match (regexp-exec long-re
+                                (symbol->string (syntax->datum #'long)))))
+                (set! O
+                   (set-fields O
+                     ((option:name)       (match:substring match 2))
+                     ((option:required?)  (if (match:substring match 1) #t #f))
+                     ((option:value?)
+                                 (cond ((not (match:substring match 3)) #f)
+                                       ((match:substring match 4)  'optional)
+                                       (else #t)))
+                     ((option:default)    (match:substring match 4)))))
+              (item O args ...)))
+
+    ;; Next option is a procedure: take as predicate.
+
+    ((item O (lambda args ...) Args ...)
+           #'(begin (option:set-predicate! O (lambda args ...))
+                    (item O Args ...)))
+
+    ((item O pred args ...)
+     (and (identifier? #'pred)
+          ;; (procedure? (primitive-eval (syntax->datum #'pred)))
+          )
+     #'(begin (option:set-predicate! O pred)
+              (item O args ...))))))
+
+
+
+(define-syntax-rule  (option args ...)
+    (let ((O (make-option))) (item O args ...) O))
+
+
+
+(define-syntax  specific
+  (λ (x)  (syntax-case  x  (application  author         bug-address
+                            copyright    help-preamble  help-postamble
+                            license      option         usage
+                            version)
+     ((specific spec application A args ...)
+      (string? (syntax->datum #'A))
+            #'(begin (spec:set-name! spec A)
+                     (specific spec args ...)))
+     ((specific spec author A args ...)
+      (string? (syntax->datum #'A))
+            #'(begin (spec:set-author! spec (append (spec:authors spec)
+                                                    (list A)))
+                     (specific spec args ...)))
+     ((specific spec bug-address B args ...)
+      (string? (syntax->datum #'B))
+            #'(begin (spec:set-bugs! spec B)
+                     (specific spec args ...)))
+     ((specific spec copyright C args ...)
+      (string? (syntax->datum #'C))
+            #'(begin (spec:set-copyright! spec (append (spec:copyright spec)
+                                                       (list C)))
+                      (specific spec args ...)))
+     ((specific spec help-preamble id args ...)
+      (identifier? #'id)
+            #'(specific spec id args ...))
+     ((specific spec help-preamble quotation args ...)
+      (string? (syntax->datum #'quotation))
+            #'(begin (spec:set-preamble! spec (append (spec:preamble spec)
+                                                      (list quotation)))
+                     (specific spec help-preamble args ...)))
+     ((specific spec help-postamble id args ...)
+      (identifier? #'id)
+            #'(specific spec id args ...))
+     ((specific spec help-postamble quotation args ...)
+      (string? (syntax->datum #'quotation))
+            #'(begin (spec:set-postamble! spec (append (spec:postamble spec)
+                                                       (list quotation)))
+                     (specific spec help-postamble args ...)))
+     ((specific spec license L args ...)
+      (identifier? #'L)
+            #'(begin (spec:set-license! spec 'L)
+                     (specific spec args ...)))
+     ((specific spec license L args ...)
+      (string? (syntax->datum #'L))
+            #'(begin (spec:set-license! spec L)
+                     (specific spec args ...)))
+     ((specific spec option (args ...) Args ...)
+            #'(begin (spec:set-all-options! spec
+                                            (append (spec:options spec)
+                                                    (list (option args ...))))
+                     (specific spec Args ...)))
+     ((specific spec usage U args ...)
+      (string? (syntax->datum #'U))
+            #'(begin (spec:set-usage! spec U)
+                     (specific spec args ...)))
+     ((specific spec version V args ...)
+      (string? (syntax->datum #'V))
+            #'(begin (spec:set-version! spec V)
+                     (specific spec args ...)))
+     ((specific spec)  #'#t))))
+
+
+
+(define-syntax-rule  (command-line-specification args ...)
+;;   " - Scheme Procedure: command-line-specification ARGS ...
+
+;; Furnish an application specification object with attributes specified in
+;; ARGS followed by a number of values for the attribute.  Please refer to
+;; full documentation for a proper description of a specification object.
+
+;; The attributes are
+
+;;  application: string: the formal name of this application.  Must appear
+;;          exactly once.
+;;  author: string: the name of an author.  May appear any number of times.
+;;  bug-address: string: The URI to which bug reports should be addressed.
+;;          May appear zero or one times.
+;;  copyright: string: list of years and owning entity.  May appear any
+;;          number of times.
+;;  help-preamble: string: text to precede the list of options in a
+;;          response to the --help option.  This attribute may appear any
+;;          number of times, and each occurrence can be followed by one or
+;;          more strings which will be assembled together into paragraphs.
+;;  help-postamble: string: text to succeed the list of options in a help
+;;          message.  Same considerations apply as to ‘help-preamble’.
+;;  license: identifier or string: either the identifier ‘GPLv3’ or a
+;;          string describing the terms of the license.
+;;  option: (sub-form): the sub-form must contain one identifier composed
+;;          of two hyphens, an optional exclamation point, a token of
+;;          letters, numbers, underscore and hyphen, an optional equals
+;;          sign, and an optional word; the sub-form may have zero or one
+;;          identifiers composed of a hyphen and a single letter; any
+;;          number of strings which will be composed into a paragraph of
+;;          help for the option (these should be sized to half-line
+;;          lengths); and zero or one procedures which will be applied as a
+;;          predicate on allowable option values.  Any number of these
+;;          option attributes may appear in the specification.
+;;  usage: string: a single line of text prototyping the command line.
+;;          Zero or one of these may appear.
+;;  version: string: the version number of this application.  Zero or one
+;;          of these attributes may appear."
+
+  (let ((spec (make-specification)))
+          (specific spec args ...)
+          spec))
+
+
+
+(define (version-string spec)
+  (with-output-to-string (λ ()
+    (display (if (string? (spec:name spec))
+                 (spec:name spec)
+                 (car (command-line))))
+    (when (string? (spec:version spec))
+      (display " ") (display (spec:version spec)) (newline))
+    (unless (null? (spec:copyright spec))
+      (display "Copyright © ")
+      (display (string-join (spec:copyright spec) "\n            "))
+      (newline))
+    (cond ((eq? (spec:license spec) 'GPLv3)
+                (display (string-append
+                          "License GPLv3+: GNU GPL version 3 or later "
+                          "<https://gnu.org/licenses/gpl.html>.\nThis is "
+                          "free software: you are free to change and "
+                          "redistribute it.\nThere is NO WARRANTY, to the "
+                          "extent permitted by law.\n")))
+          ((string? (spec:license spec))
+                (display (spec:license spec)) (newline)))
+    (unless (null? (spec:authors spec))
+      (display (string-append "Written by "
+                        (case (length (spec:authors spec))
+                          ((1 2)  (string-join (spec:authors spec) " and "))
+                          (else
+                           (let loop ((a (cdr (spec:authors spec)))
+                                      (ret (car (spec:authors spec))))
+                                (if (null? (cdr a))
+                                    (string-append ret " and " (car a))
+                                  (loop (cdr a) (string-append ret ", "
+                                                               (car a)))))))
+                        ".\n"))))))
+
+
+
+(define (usage-string spec)
+  (string-append "Usage: " (spec:name spec) " " (spec:usage spec) "\n"))
+
+
+
+(define  (help-string spec)
+  (with-output-to-string (λ ()
+     (display (usage-string spec))
+     (display (string-join (spec:preamble spec) "\n"))
+     (display "\n\n")
+     (let ((max-length (fold (λ (o r) (max r (string-length (option:name o))))
+                             0
+                             (spec:options spec))))
+       (for-each (λ (o)
+              (display "  ")
+              (cond ((option:short o)
+                     (display "-") (display (option:short o))
+                     (case (option:value? o)  ((#t)        (display "N,   "))
+                                              ((optional)  (display "[N], "))
+                                              (else        (display ",    "))))
+                    (else (display "       ")))
+              (display "--")
+              (display (option:name o))
+              (case (option:value? o)  ((#t)       (display "=N  "))
+                                       ((optional) (display "[=N]"))
+                                       (else       (display "    ")))
+              (display (make-string (- max-length
+                                       (string-length (option:name o)))
+                                    #\space))
+              (display "  ")
+              (when  (option:required? o)  (display "*REQUIRED*: "))
+              (display (string-join (option:description o)
+                                    (string-append "\n"
+                                                   (make-string max-length
+                                                                #\space)
+                                                   "                   ")))
+              (newline))
+           (spec:options spec)))
+     (newline)
+     (display (string-join (spec:postamble spec) "\n"))
+     (when (spec:bugs spec)
+       (display "\nSend bug reports to ")
+       (display (spec:bugs spec))
+       (display ".\n")))))
+
+
+
+(define (make-getopt-long-input spec)
+  (map (λ (o)
+         (append (list (string->symbol (option:name o)))
+                 (cond ((option:short o)
+                                => (λ (x) (list (list 'single-char x))))
+                       (else '()))
+                 (list (list 'required? (option:required? o)))
+                 (list (list 'value   (if (option:default o)
+                                          'optional
+                                          (option:value? o))))
+                 (cond ((option:predicate o)
+                                =>  (λ (x) (list (list 'predicate x))))
+                       (else '()))))
+       (spec:options spec)))
+
+
+
+(define (obtain-getopt-long-results args spec)
+  (getopt-long args (make-getopt-long-input spec)))
+
+
+
+(define  (distill-getopt-long-results  go-l  spec)
+  (cons (cons "!" (option-ref go-l '() '()))
+        (map (λ (o)
+          (let ((g (option-ref go-l
+                               (string->symbol (option:name o))
+                               #f)))
+            (when (eq? g #t)
+              (case (string->symbol (option:name o))
+                    ((help)     (display (help-string spec))    (exit 0))
+                    ((version)  (display (version-string spec)) (exit 0))
+                    ((usage)    (display (usage-string spec))   (exit 0))))
+            (cons (option:name o)
+                  (if (and (eq? #t g)
+                           (not (eq? #f (option:default o))))
+                      (option:default o)
+                    g))))
+       (spec:options spec))))
+
+
+
+(define  (process-getopt-long-results go-l spec)
+  (for-each (λ (option)
+               (module-define!
+                        (current-module)
+                        (string->symbol (string-append "--" (car option)))
+                        (cdr option)))
+            (distill-getopt-long-results go-l spec)))
+
+
+
+(define-syntax  process-command-line
+;;   "- Scheme Procedure: process-command-line COMMAND-LINE SPECS [...]
+
+;; Process the COMMAND-LINE according to the SPECS, extracting options and
+;; their values, dealing with --help, --version and --usage requests.  The
+;; procedure has no return values, but has the side effect of creating
+;; variable bindings in the current module corresponding to the long form
+;; of the options, plus a variable called ‘--!’ which gets a list of all
+;; the arguments on the command-line which did not participate in option
+;; processing.
+
+;; The COMMAND-LINE is a list of strings, starting with the name of the
+;; program and containing all the tokens passed to the program on the
+;; command line, such as returned from the core ‘command-line’ procedure.
+
+;; The SPECS should have been obtained with the
+;; ‘command-line-specification’ procedure, or, as a short-cut, can be
+;; supplied directly as arguments to this procedure."
+
+  (syntax-rules (GO)
+    ((_ command-line specs GO)
+         (let ((S (merge-command-line-specifications
+                   specs
+                   (command-line-specification
+                     option (-h --help    "display this help and exit")
+                     option (-V --version "output version information and exit")
+                     option (-u --usage   "show brief usage summary")))))
+           (process-getopt-long-results
+            (obtain-getopt-long-results command-line S)
+            S)))
+    ((_ command-line specs)
+         (process-command-line command-line specs GO))
+    ((_ command-line item ...)
+         (process-command-line
+              command-line
+              (command-line-specification item ...)))))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 8158aaf44..c25ede6ad 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -34,6 +34,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/c-api.test			\
 	    tests/chars.test			\
 	    tests/coding.test			\
+	    tests/command-line-processor.test	\
 	    tests/common-list.test		\
 	    tests/compiler.test			\
 	    tests/control.test			\
diff --git a/test-suite/tests/command-line-processor.test b/test-suite/tests/command-line-processor.test
new file mode 100644
index 000000000..7560ad102
--- /dev/null
+++ b/test-suite/tests/command-line-processor.test
@@ -0,0 +1,155 @@
+;;;; command-line-processor.test --- long options processing -*- scheme -*-
+;;;;
+;;;;	Copyright (C) 2001, 2006, 2011 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+;;;; MA 02110-1301 USA
+
+;;; Author:  Dale Mellor <guile-qf1qmg@rdmp.org> --- May 2020
+
+
+(use-modules (test-suite lib)
+             (ice-9 command-line-processor)
+             (ice-9 regex))
+
+(define-syntax-rule (pass-if-fatal-exception name exn exp)
+     (let ((port (open-output-string)))
+       (with-error-to-port port
+         (λ ()
+           (run-test
+            name #t
+            (λ ()
+              (catch (car exn)
+                (λ () exp #f)
+                (λ (k . args)
+                  (let ((output (get-output-string port)))
+                    (close-port port)
+                    (if (string-match (cdr exn) output)
+                        #t
+                        (error "Unexpected output" output)))))))))))
+
+(defmacro deferr (name-frag re)
+  (let ((name (symbol-append 'exception: name-frag)))
+    `(define ,name (cons 'quit ,re))))
+
+(deferr no-such-option              "no such option")
+(deferr option-predicate-failed     "option predicate failed")
+(deferr option-does-not-support-arg "option does not support argument")
+(deferr option-must-be-specified    "option must be specified")
+(deferr option-must-have-arg        "option must be specified with argument")
+
+
+
+(with-test-prefix "exported procs"
+  (pass-if "‘option’ defined"  (defined? 'process-command-line)))
+
+
+(with-test-prefix "extended mcron options"
+
+  (define  stdin-predicate  (λ (in) (or (string=? in "guile")
+                                        (string=? in "vixie"))))
+    
+  (define  app  (command-line-specification
+       application   "mcron"
+       version       "1.4"
+       usage         "[OPTIONS]... [FILES]..."
+       help-preamble
+  "Run an mcron process according to the specifications in the FILE... "
+  "(`-' for standard input), or use all the files in ~/.config/cron "
+  "(or the deprecated ~/.cron) with .guile or .vixie extensions.\n"
+  "Note that --daemon and --schedule are mutually exclusive."
+       option  (--daemon  -d
+                      "run as a daemon process")
+       option  (--stdin=guile  -j  (λ (in) (or (string=? in "guile")
+                                               (string=? in "vixie")))
+                      "format of data passed as standard input or file "
+                      "arguments, 'guile' or 'vixie' (default guile)")
+       option  (--stdin-2=guile  -k  (lambda (in) (or (string=? in "guile")
+                                                      (string=? in "vixie")))
+                      "format of data passed as standard input or file "
+                      "arguments, 'guile' or 'vixie' (default guile)")
+       option  (--stdin-3=guile  -l  stdin-predicate
+                      "format of data passed as standard input or file "
+                      "arguments, 'guile' or 'vixie' (default guile)")
+       option  (--schedule=8  -s  string->number
+                              "display the next N (or 8) jobs that will be run")
+       option  (--not-complex short-i "this should just work")
+       help-postamble
+  "Mandatory or optional arguments to long options are also mandatory or "
+  "optional for any corresponding short options."
+       bug-address "bug-mcron@gnu.org"
+       copyright   "2003, 2006, 2014, 2020  Free Software Foundation, Inc."
+       license     GPLv3))
+
+  (pass-if "specification transformed" #t)
+
+  (process-command-line '("test" "-d" "leftover0" "--schedule=3" "leftover1"
+                          "--stdin=vixie" "--stdin-2=guile" "--stdin-3" "vixie"
+                          "-i")
+                        app)
+  (pass-if "process-command-line completed" #t)
+
+  (pass-if "-d" (eq? --daemon #t))
+  (pass-if "--schedule=3" (string=? --schedule "3"))
+  (pass-if "--!" (equal? --! '("leftover0" "leftover1")))
+  (pass-if "-j" (string=? --stdin "vixie"))
+  (pass-if "-k" (string=? --stdin-2 "guile"))
+  (pass-if "-l" (string=? --stdin-3 "vixie"))
+  (pass-if "-i" (eq? --not-complex #t))
+
+  (process-command-line  '("test" "-s9")  app)
+
+  (pass-if "! -d" (eq? --daemon #f))
+  (pass-if "-s9" (string=? --schedule "9"))
+
+  )
+
+
+
+(with-test-prefix "option merging"
+
+   (process-command-line  (string-split "prog -a -b -d -h" #\space)
+     (merge-command-line-specifications
+       (command-line-specification
+           application "test-1"
+           option (-a --alpha "option alpha")
+           option (-b --beta  "option beta")
+           option (-h --eta   "option eta"))
+       (command-line-specification
+           application "test-2"
+           option (-b --beta  "option beta")
+           option (-d --delta "option delta"))))
+
+   (pass-if "--alpha" (eq? #t --alpha))
+   (pass-if "--beta"  (eq? #t --beta))
+   (pass-if "--delta" (eq? #t --delta))
+   (pass-if "--eta"   (eq? #t --eta))
+   (pass-if "--beta-1" (eq? #f --beta-1))
+   (pass-if "--help"  (eq? #f --help))
+
+ )
+
+
+
+(with-test-prefix "all option combinations"
+
+   (define app (command-line-specification option (--alpha -a)))
+
+   (pass-if "specification transformed" #t)
+
+ )
+
+                 
+;;; command-line-processor.test ends here
-- 
2.20.1