1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 22:31:12 +02:00

* boot-9.scm (set-batch-mode?!, batch-mode?): initialize more

usefully so they will work from a script.
This commit is contained in:
Gary Houston 1997-11-09 23:36:17 +00:00
parent 03ca35af55
commit 28d8ab3c69
3 changed files with 25 additions and 10 deletions

View file

@ -1,3 +1,8 @@
Sun Nov 9 06:10:59 1997 Gary Houston <ghouston@actrix.gen.nz>
* boot-9.scm (set-batch-mode?!, batch-mode?): initialize more
usefully so they will work from a script.
1997-10-31 Marius Vollmer <mvo@zagadka.ping.de>
* boot-9.scm (inherit-print-state): Moved definition to the

View file

@ -2283,9 +2283,10 @@
(define abort-hook '())
;; defined in error-catching-loop as a closures.
(define set-batch-mode?! #f)
(define batch-mode? #f)
;; these definitions are used if running a script.
;; otherwise redefined in error-catching-loop.
(define (set-batch-mode?! arg) #t)
(define (batch-mode?) #t)
(define (error-catching-loop thunk)
(let ((status #f)

View file

@ -19,7 +19,7 @@
;;;;
(define-module (ice-9 expect))
(define-module (ice-9 expect) :use-module (ice-9 regex))
;;; Expect: a macro for selecting actions based on what it reads from a port.
;;; The idea is from Don Libes' expect based on Tcl.
@ -69,7 +69,7 @@
(cond
,@(let next-expr ((tests (map car clauses))
(exprs (map cdr clauses))
(body ()))
(body '()))
(cond
((null? tests)
(reverse body))
@ -80,7 +80,7 @@
(cons
`((,(car tests) ,s)
,@(cond ((null? (car exprs))
())
'())
((eq? (caar exprs) '=>)
(if (not (= (length (car exprs))
2))
@ -101,8 +101,8 @@
(defmacro-public expect-strings clauses
`(let ,@(let next-test ((tests (map car clauses))
(exprs (map cdr clauses))
(defs ())
(body ()))
(defs '())
(body '()))
(cond ((null? tests)
(list (reverse defs) `(expect ,@(reverse body))))
(else
@ -113,7 +113,7 @@
regexp/newline))
defs)
(cons `((lambda (s)
(regexp-exec ,rxname s))
(expect-regexec ,rxname s))
,@(car exprs))
body))))))))
@ -126,5 +126,14 @@
(/ (cdr secs-usecs)
1000000)))) ; one million.
(and (> relative 0)
(pair? (car (select (list port) () ()
(pair? (car (select (list port) '() '()
relative))))))
;;; convert a match object to a list of strings, for the => syntax.
(define-public (expect-regexec rx s)
(let ((match (regexp-exec rx s)))
(if match
(do ((i (- (match:count match) 1) (- i 1))
(result '() (cons (match:substring match i) result)))
((< i 0) result))
#f)))