mirror of
git://git.gnupg.org/gnupg.git
synced 2024-12-22 10:19:57 +01:00
gpgscm: Library improvements.
* tests/gpgscm/repl.scm (prompt-yes-no?): New function. * tests/gpgscm/tests.scm (pathsep-split): Likewise. (pathsep-join): Likewise. (with-path): Use the new function. Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
parent
7a6e6ad288
commit
b4d25082fd
@ -55,3 +55,15 @@
|
|||||||
(define (interactive-repl . environment)
|
(define (interactive-repl . environment)
|
||||||
(repl (lambda (p) (prompt-append-prefix "gpgscm " p))
|
(repl (lambda (p) (prompt-append-prefix "gpgscm " p))
|
||||||
(if (null? environment) (interaction-environment) (car environment))))
|
(if (null? environment) (interaction-environment) (car environment))))
|
||||||
|
|
||||||
|
;; Ask a yes/no question.
|
||||||
|
(define (prompt-yes-no? question default)
|
||||||
|
(let ((answer (prompt (string-append question "? ["
|
||||||
|
(if default "Y/n" "y/N") "] "))))
|
||||||
|
(cond
|
||||||
|
((= 0 (string-length answer))
|
||||||
|
default)
|
||||||
|
((or (equal? "y" answer) (equal? "Y" answer))
|
||||||
|
#t)
|
||||||
|
(else
|
||||||
|
#f))))
|
||||||
|
@ -192,6 +192,16 @@
|
|||||||
(define (in-srcdir . names)
|
(define (in-srcdir . names)
|
||||||
(canonical-path (apply path-join (cons (getenv "abs_top_srcdir") names))))
|
(canonical-path (apply path-join (cons (getenv "abs_top_srcdir") names))))
|
||||||
|
|
||||||
|
;; Split a list of paths.
|
||||||
|
(define (pathsep-split s)
|
||||||
|
(string-split s *pathsep*))
|
||||||
|
|
||||||
|
;; Join a list of paths.
|
||||||
|
(define (pathsep-join paths)
|
||||||
|
(foldr (lambda (a b) (string-append a (string *pathsep*) b))
|
||||||
|
(car paths)
|
||||||
|
(cdr paths)))
|
||||||
|
|
||||||
;; Try to find NAME in PATHS. Returns the full path name on success,
|
;; Try to find NAME in PATHS. Returns the full path name on success,
|
||||||
;; or raises an error.
|
;; or raises an error.
|
||||||
(define (path-expand name paths)
|
(define (path-expand name paths)
|
||||||
@ -209,7 +219,7 @@
|
|||||||
;; (load (with-path "library.scm"))
|
;; (load (with-path "library.scm"))
|
||||||
(define (with-path name)
|
(define (with-path name)
|
||||||
(catch name
|
(catch name
|
||||||
(path-expand name (string-split (getenv "GPGSCM_PATH") *pathsep*))))
|
(path-expand name (pathsep-split (getenv "GPGSCM_PATH")))))
|
||||||
|
|
||||||
(define (basename path)
|
(define (basename path)
|
||||||
(let ((i (string-index path #\/)))
|
(let ((i (string-index path #\/)))
|
||||||
|
Loading…
x
Reference in New Issue
Block a user