mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-14 21:32:49 -08:00
Code Issues Projects Releases Packages Wiki Activity

Simplify WITH-STANDARD-IO-SYNTAX

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-06-19 11:30:14 +02:00
parent 27dfba57f1
commit a5ff565d68
1 changed files with 27 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

48
src/lsp/iolib.lsp
View file

@ -231,32 +231,38 @@ is not given, ends the recording."
;(provide 'iolib)
(defconstant +io-syntax-progv-list+
(let ((a (append '((*print-array* . t)
(*print-base* . 10)
(*print-case* . :upcase)
(*print-circle* . nil)
(*print-escape* . t)
(*print-gensym* . t)
(*print-length* . nil)
(*print-level* . nil)
(*print-lines* . nil)
(*print-miser-width* . nil)
(*print-pretty* . nil)
(*print-radix* . nil)
(*print-readably* . t)
(*print-right-margin* . nil)
(*read-base* . 10)
(*read-default-float-format* . 'single-float)
(*read-eval* . t)
(*read-suppress* . nil))
(cons *package* #.(find-package :cl-user))
(cons *readtable* #.(si::standard-readtable)))))
(cons (mapcar #'car a)
(mapcar #'cdr a))))
(defmacro with-standard-io-syntax (&body body)
"Syntax: ({forms}*)
The forms of the body are executed in a print environment that corresponds to
the one defined in the ANSI standard. *print-base* is 10, *print-array* is t,
*package* is \"CL-USER\", etc."
`(let*((*package* (find-package :cl-user))
(*print-array* t)
(*print-base* 10)
(*print-case* :upcase)
(*print-circle* nil)
(*print-escape* t)
(*print-gensym* t)
(*print-length* nil)
(*print-level* nil)
(*print-lines* nil)
(*print-miser-width* nil)
(*print-pretty* nil)
(*print-radix* nil)
(*print-readably* t)
(*print-right-margin* nil)
(*read-base* 10)
(*read-default-float-format* 'single-float)
(*read-eval* t)
(*read-suppress* nil)
(*readtable* (si::standard-readtable)))
,@body))
`(progv (car +io-syntax-progv-list+)
(cdr +io-syntax-progv-list+)
,@body))
#-formatter
(defmacro formatter (control-string)