mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

(fill-message): check first whether args is null.

Browse source
This commit is contained in:
Gary Houston 1996-09-07 21:34:09 +00:00
parent 7cb1d4d305
commit 9561554c13
2 changed files with 20 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

1
ice-9/ChangeLog
View file

@ -2,6 +2,7 @@ Sat Sep 7 06:44:47 1996 Gary Houston <ghouston@actrix.gen.nz>
* boot-9.scm (%%handle-system-error): recognise errors thrown * boot-9.scm (%%handle-system-error): recognise errors thrown
by lgh-error (fill-message etc.) by lgh-error (fill-message etc.)
(fill-message): check first whether args is null.
Thu Sep 5 11:33:41 1996 Jim Blandy <jimb@floss.cyclic.com> Thu Sep 5 11:33:41 1996 Jim Blandy <jimb@floss.cyclic.com>

35
ice-9/boot-9.scm
View file

@ -677,22 +677,25 @@
(args (caddr arg-list)) (args (caddr arg-list))
(rest (cadddr arg-list)) (rest (cadddr arg-list))
(cep (current-error-port)) (cep (current-error-port))
(fill-message (lambda (message args) (fill-message
(let ((len (string-length message))) (lambda (message args)
(cond ((< len 2) (if (null? args)
(display message cep)) (display message cep)
((string=? (substring message 0 2) (let ((len (string-length message)))
"%S") (cond ((< len 2)
(display (car args) cep) (display message cep))
(fill-message ((string=? (substring message 0 2)
(substring message 2 len) "%S")
(cdr args))) (display (car args) cep)
(else (fill-message
(display (substring message 0 2) (substring message 2 len)
cep) (cdr args)))
(fill-message (else
(substring message 2 len) (display (substring message 0 2)
args))))))) cep)
(fill-message
(substring message 2 len)
args))))))))
(display "ERROR: " cep) (display "ERROR: " cep)
(display subr cep) (display subr cep)
(display ": " cep) (display ": " cep)