blob: d2dd9b50be73e4f280095e8a640d50c5962b79ca (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
;;;; -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*-
;;;;
;;;; Copyright © 2018 Amirouche Boubekki <amirouche@hypermove.net>
;;;;
;;;; 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 <http://www.gnu.org/licenses/>.
;;
;; Comment:
;;
;; Command line interface subcommands parsing
;;
(define-module (gnunet subcommand))
(use-modules ((srfi srfi-1)))
(define (path-display path)
(display " ")
(let loop ((path path))
(unless (null? path)
(display (car path))
(display " ")
(loop (cdr path))))
(display #\newline))
(define (%spec-help path)
(lambda (spec)
(if (procedure? (cadr spec))
(path-display (append path (list (car spec))))
(for-each (%spec-help (append path (list (car spec)))) (cdr spec)))))
(define (spec-help name spec)
"Display the usage message for this SPEC for the program named NAME"
(display "Usage:\n\n")
(for-each (%spec-help (list name)) spec))
(define (%lookup spec args)
(if (string=? (symbol->string (car spec)) (car args))
(values (cdr spec) (cdr args))
(values #f #f)))
(define (lookup spec args)
(let loop ((spec spec))
(if (null? spec)
(values #f #f)
(call-with-values (lambda () (%lookup (car spec) args))
(lambda (procedure-or-spec args)
(cond
((and (not procedure-or-spec) (not args))
(loop (cdr spec)))
((procedure? (car procedure-or-spec))
(values (car procedure-or-spec) args))
(else (lookup procedure-or-spec args))))))))
(define-public (subcommand name spec args)
"Execute the subcommand of SPEC based on ARGS for the command NAME"
(if (or (null? args) (equal? args '("--help")) (equal? args '("-h")))
(spec-help name spec)
(call-with-values (lambda () (lookup spec args))
(lambda (procedure args)
(cond
((and procedure args)
(procedure args))
(else (spec-help name spec)))))))
|
