Skip to content
Snippets Groups Projects
Commit bfca2e78 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Fix implementation of *standard-readtable*.

More documentation for UIOP.
parent 3900a1f0
No related branches found
No related tags found
No related merge requests found
...@@ -16,14 +16,14 @@ The files that constitute UIOP are, in loading order: ...@@ -16,14 +16,14 @@ The files that constitute UIOP are, in loading order:
* package: to deal with packages and their symbols, most notably including * package: to deal with packages and their symbols, most notably including
DEFINE-PACKAGE, a variant of defpackage capable of hot-upgrade. DEFINE-PACKAGE, a variant of defpackage capable of hot-upgrade.
* common-lisp: to let you paper over various sub-standard implementations * common-lisp: to let you paper over various sub-standard implementations.
Corman, GCL, Genera, MCL are the biggest (unmaintained) offenders. Big offenders are Corman, GCL, Genera, MCL, all of them unmaintained.
Supported without much any issues are: Supported without serious issues are:
ABCL, Allegro, CCL, CMUCL, CLISP, ECL, LispWorks, MKCL, SBCL, XCL. ABCL, Allegro, CCL, CMUCL, CLISP, ECL, LispWorks, MKCL, SBCL, XCL.
* utility: to provide macros and functions that do not involve I/O, handling * utility: to provide macros and functions that do not involve I/O, handling
control-flow, (p)lists, character, strings, functions, classes, conditions, control-flow, (p)lists, characters, strings, functions, classes, conditions,
"stamps" (number or boolean for +/- infinity), versions, etc. "stamps" (real number or boolean for +/- infinity), versions, etc.
It also sports uiop-debug, a useful tool to help you debug programs. It also sports uiop-debug, a useful tool to help you debug programs.
* os: to extract information from your environment, including * os: to extract information from your environment, including
......
...@@ -70,6 +70,7 @@ ...@@ -70,6 +70,7 @@
#+sbcl 'sb-sys:*stderr* #+sbcl 'sb-sys:*stderr*
'*error-output*))) '*error-output*)))
;; Run them now. In image.lisp, we'll register them to be run at image restart.
(setup-stdin) (setup-stdout) (setup-stderr)) (setup-stdin) (setup-stdout) (setup-stderr))
...@@ -100,6 +101,8 @@ with non-ASCII code points being read as several CL characters; ...@@ -100,6 +101,8 @@ with non-ASCII code points being read as several CL characters;
hopefully, if done consistently, that won't affect program behavior too much.") hopefully, if done consistently, that won't affect program behavior too much.")
(defun always-default-encoding (pathname) (defun always-default-encoding (pathname)
"Trivial function to use as *encoding-detection-hook*,
always 'detects' the *default-encoding*"
(declare (ignore pathname)) (declare (ignore pathname))
*default-encoding*) *default-encoding*)
...@@ -107,11 +110,15 @@ hopefully, if done consistently, that won't affect program behavior too much.") ...@@ -107,11 +110,15 @@ hopefully, if done consistently, that won't affect program behavior too much.")
"Hook for an extension to define a function to automatically detect a file's encoding") "Hook for an extension to define a function to automatically detect a file's encoding")
(defun detect-encoding (pathname) (defun detect-encoding (pathname)
"Detects the encoding of a specified file, going through user-configurable hooks"
(if (and pathname (not (directory-pathname-p pathname)) (probe-file* pathname)) (if (and pathname (not (directory-pathname-p pathname)) (probe-file* pathname))
(funcall *encoding-detection-hook* pathname) (funcall *encoding-detection-hook* pathname)
*default-encoding*)) *default-encoding*))
(defun default-encoding-external-format (encoding) (defun default-encoding-external-format (encoding)
"Default, ignorant, function to transform a character ENCODING as a
portable keyword to an implementation-dependent EXTERNAL-FORMAT specification.
Load system ASDF-ENCODINGS to hook in a better one."
(case encoding (case encoding
(:default :default) ;; for backward-compatibility only. Explicit usage discouraged. (:default :default) ;; for backward-compatibility only. Explicit usage discouraged.
(:utf-8 *utf-8-external-format*) (:utf-8 *utf-8-external-format*)
...@@ -121,16 +128,20 @@ hopefully, if done consistently, that won't affect program behavior too much.") ...@@ -121,16 +128,20 @@ hopefully, if done consistently, that won't affect program behavior too much.")
(defvar *encoding-external-format-hook* (defvar *encoding-external-format-hook*
#'default-encoding-external-format #'default-encoding-external-format
"Hook for an extension to define a mapping between non-default encodings "Hook for an extension (e.g. ASDF-ENCODINGS) to define a better mapping
and implementation-defined external-format's") from non-default encodings to and implementation-defined external-format's")
(defun encoding-external-format (encoding) (defun encoding-external-format (encoding)
"Transform a portable ENCODING keyword to an implementation-dependent EXTERNAL-FORMAT,
going through all the proper hooks."
(funcall *encoding-external-format-hook* (or encoding *default-encoding*)))) (funcall *encoding-external-format-hook* (or encoding *default-encoding*))))
;;; Safe syntax ;;; Safe syntax
(with-upgradability () (with-upgradability ()
(defvar *standard-readtable* (copy-readtable nil)) (defvar *standard-readtable* (with-standard-io-syntax *readtable*)
"The standard readtable, implementing the syntax specified by the CLHS.
It must never be modified, though only good implementations will even enforce that.")
(defmacro with-safe-io-syntax ((&key (package :cl)) &body body) (defmacro with-safe-io-syntax ((&key (package :cl)) &body body)
"Establish safe CL reader options around the evaluation of BODY" "Establish safe CL reader options around the evaluation of BODY"
...@@ -145,6 +156,7 @@ and implementation-defined external-format's") ...@@ -145,6 +156,7 @@ and implementation-defined external-format's")
(funcall thunk)))) (funcall thunk))))
(defun safe-read-from-string (string &key (package :cl) (eof-error-p t) eof-value (start 0) end preserve-whitespace) (defun safe-read-from-string (string &key (package :cl) (eof-error-p t) eof-value (start 0) end preserve-whitespace)
"Read from STRING using a safe syntax, as per WITH-SAFE-IO-SYNTAX"
(with-safe-io-syntax (:package package) (with-safe-io-syntax (:package package)
(read-from-string string eof-error-p eof-value :start start :end end :preserve-whitespace preserve-whitespace)))) (read-from-string string eof-error-p eof-value :start start :end end :preserve-whitespace preserve-whitespace))))
...@@ -247,6 +259,8 @@ Other keys are accepted but discarded." ...@@ -247,6 +259,8 @@ Other keys are accepted but discarded."
;;; Null device ;;; Null device
(with-upgradability () (with-upgradability ()
(defun null-device-pathname () (defun null-device-pathname ()
"Pathname to a bit bucket device that discards any information written to it
and always returns EOF when read from"
(cond (cond
((os-unix-p) #p"/dev/null") ((os-unix-p) #p"/dev/null")
((os-windows-p) #p"NUL") ;; Q: how many Lisps accept the #p"NUL:" syntax? ((os-windows-p) #p"NUL") ;; Q: how many Lisps accept the #p"NUL:" syntax?
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment