New Upstream Release - cl-named-readtables
Ready changes
Summary
Merged new upstream version: 20230721.git2c05652 (was: 20201221.gitc5689a4).
Diff
diff --git a/README b/README
index 7125dc0..ddcc471 100644
--- a/README
+++ b/README
@@ -1,11 +1,11 @@
# Named Readtables Manual
###### \[in package EDITOR-HINTS.NAMED-READTABLES with nicknames NAMED-READTABLES\]
-## named-readtables ASDF System Details
+## NAMED-READTABLES ASDF System
- Version: 0.9
-- Description: Library that creates a namespace for named readtable
- akin to the namespace of packages.
+- Description: Library that creates a namespace for readtables akin
+ to the namespace of packages.
- Licence: BSD, see LICENSE
- Author: Tobias C. Rittweiler <trittweiler@common-lisp.net>
- Maintainer: Gábor Melis <mega@retes.hu>
@@ -206,6 +206,10 @@ and the API of packages.
The readtable can be populated using the following OPTIONS:
+ - If the first element of OPTIONS is a string then it is associated
+ with the readtable as in `(SETF (DOCUMENTATION NAME 'READTABLE)
+ DOCSTRING)`.
+
- `(:MERGE READTABLE-DESIGNATORS+)`
Merge the macro character definitions from the readtables
@@ -237,9 +241,9 @@ and the API of packages.
- `(:MACRO-CHAR MACRO-CHAR FUNCTION [NON-TERMINATING-P])`
Define a new macro character in the readtable, per
- SET-MACRO-CHARACTER. If `FUNCTION` is the keyword :DISPATCH,
- `MACRO-CHAR` is made a dispatching macro character, per
- MAKE-DISPATCH-MACRO-CHARACTER.
+ SET-MACRO-CHARACTER. If [FUNCTION][argument] is the keyword
+ :DISPATCH, `MACRO-CHAR` is made a dispatching macro character,
+ per MAKE-DISPATCH-MACRO-CHARACTER.
- `(:SYNTAX-FROM FROM-READTABLE-DESIGNATOR FROM-CHAR TO-CHAR)`
@@ -254,9 +258,9 @@ and the API of packages.
Any number of option clauses may appear. The options are grouped by
their type, but in each group the order the options appeared
textually is preserved. The following groups exist and are executed
- in the following order: :MERGE and :FUSE (one
- group), :CASE, :MACRO-CHAR and :DISPATCH-MACRO-CHAR (one group),
- finally :SYNTAX-FROM.
+ in the following order: :MERGE and :FUSE (one group), :CASE,
+ :MACRO-CHAR and :DISPATCH-MACRO-CHAR (one group), finally
+ :SYNTAX-FROM.
Notes:
@@ -346,7 +350,7 @@ and the API of packages.
Like COPY-READTABLE but takes a NAMED-READTABLE-DESIGNATOR as argument.
-- [function] LIST-ALL-NAMED-READTABLES
+- [function] LIST-ALL-NAMED-READTABLES
Returns a list of all registered readtables. The returned list is
guaranteed to be fresh, but may contain duplicates.
@@ -355,6 +359,8 @@ and the API of packages.
Either a symbol or a readtable itself.
+- [condition] READTABLE-ERROR ERROR
+
- [condition] READER-MACRO-CONFLICT READTABLE-ERROR
Continuable.
diff --git a/README.md b/README.md
index f741bd2..f2bd553 100644
--- a/README.md
+++ b/README.md
@@ -1,28 +1,28 @@
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-MANUAL-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-manual-20mgl-pax-3asection-29"></a>
# Named Readtables Manual
## Table of Contents
-- [1 named-readtables ASDF System Details][9b5b]
-- [2 Introduction][6faf]
- - [2.1 Links][8688]
- - [2.2 Acknowledgements][059d]
-- [3 Overview][0bc2]
- - [3.1 Notes on the API][e4cd]
- - [3.2 Important API idiosyncrasies][62b8]
- - [3.3 Preregistered Readtables][58c6]
- - [3.4 Examples][cf94]
-- [4 Reference][373d]
+- [1 The named-readtables ASDF System][718a]
+- [2 Introduction][480f]
+ - [2.1 Links][a61b]
+ - [2.2 Acknowledgements][ebdc]
+- [3 Overview][c1e9]
+ - [3.1 Notes on the API][f800]
+ - [3.2 Important API idiosyncrasies][398b]
+ - [3.3 Preregistered Readtables][c5dc]
+ - [3.4 Examples][aae8]
+- [4 Reference][4d56]
###### \[in package EDITOR-HINTS.NAMED-READTABLES with nicknames NAMED-READTABLES\]
-<a id='x-28-22named-readtables-22-20ASDF-2FSYSTEM-3ASYSTEM-29'></a>
+<a id="x-28-22named-readtables-22-20asdf-2fsystem-3asystem-29"></a>
-## 1 named-readtables ASDF System Details
+## 1 The named-readtables ASDF System
- Version: 0.9
-- Description: Library that creates a namespace for named readtable
- akin to the namespace of packages.
+- Description: Library that creates a namespace for readtables akin
+ to the namespace of packages.
- Licence: BSD, see LICENSE
- Author: Tobias C. Rittweiler <trittweiler@common-lisp.net>
- Maintainer: Gábor Melis <mega@retes.hu>
@@ -31,7 +31,7 @@
- Bug tracker: [https://github.com/melisgl/named-readtables/issues](https://github.com/melisgl/named-readtables/issues)
- Source control: [GIT](https://github.com/melisgl/named-readtables.git)
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-INTRODUCTION-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-introduction-20mgl-pax-3asection-29"></a>
## 2 Introduction
@@ -63,19 +63,19 @@ readtables in a *modular* way. In particular:
- it makes it possible to use multiple inheritance between readtables.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-LINKS-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-links-20mgl-pax-3asection-29"></a>
### 2.1 Links
Here is the [official repository][named-readtables-repo] and the
[HTML documentation][named-readtables-doc] for the latest version.
-[named-readtables-repo]: https://github.com/melisgl/named-readtables
+[named-readtables-repo]: https://github.com/melisgl/named-readtables
-[named-readtables-doc]: http://melisgl.github.io/mgl-pax-world/named-readtables-manual.html
+[named-readtables-doc]: http://melisgl.github.io/mgl-pax-world/named-readtables-manual.html
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-ACKNOWLEDGEMENTS-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-acknowledgements-20mgl-pax-3asection-29"></a>
### 2.2 Acknowledgements
@@ -85,11 +85,11 @@ Thanks to Stephen Compall, Ariel Badichi, David Lichteblau, Bart
Botta, David Crawford, and Pascal Costanza for being early adopters,
providing comments and bugfixes.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-OVERVIEW-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-overview-20mgl-pax-3asection-29"></a>
## 3 Overview
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-API-NOTES-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-api-notes-20mgl-pax-3asection-29"></a>
### 3.1 Notes on the API
@@ -116,7 +116,7 @@ effort.
LIST-ALL-NAMED-READTABLES - LIST-ALL-PACKAGES
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-API-IDIOSYNCRASIES-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-api-idiosyncrasies-20mgl-pax-3asection-29"></a>
### 3.2 Important API idiosyncrasies
@@ -161,12 +161,12 @@ and the API of packages.
Sbcl, ClozureCL, and AllegroCL at the moment. Patches for your
implementation of choice are welcome, of course.)
-3. [`DEFREADTABLE`][8b94] does not have compile-time effects.
+3. [`DEFREADTABLE`][6a02] does not have compile-time effects.
- If you define a package via `DEFPACKAGE`, you can make that
+ If you define a package via [`DEFPACKAGE`][9b43], you can make that
package the currently active package for the subsequent
- compilation of the same file via `IN-PACKAGE`. The same is,
- however, not true for [`DEFREADTABLE`][8b94] and [`IN-READTABLE`][de3b] for the
+ compilation of the same file via [`IN-PACKAGE`][125e]. The same is,
+ however, not true for `DEFREADTABLE` and [`IN-READTABLE`][ee2d] for the
following reason:
It's unlikely that the need for special reader-macros arises for
@@ -174,18 +174,18 @@ and the API of packages.
you're going to define the reader macro functions, and set up
the corresponding readtable in an extra file.
- If [`DEFREADTABLE`][8b94] had compile-time effects, you'd have to wrap
- each definition of a reader-macro function in an `EVAL-WHEN` to
+ If `DEFREADTABLE` had compile-time effects, you'd have to wrap
+ each definition of a reader-macro function in an [`EVAL-WHEN`][9c9c] to
make its definition available at compile-time. Because that's
- simply not the common case, [`DEFREADTABLE`][8b94] does not have a
+ simply not the common case, `DEFREADTABLE` does not have a
compile-time effect.
If you want to use a readtable within the same file as its
- definition, wrap the [`DEFREADTABLE`][8b94] and the reader-macro function
+ definition, wrap the `DEFREADTABLE` and the reader-macro function
definitions in an explicit `EVAL-WHEN`.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-PREREGISTERED-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-preregistered-20mgl-pax-3asection-29"></a>
### 3.3 Preregistered Readtables
@@ -197,7 +197,7 @@ and the API of packages.
- `:CURRENT` designates the *current readtable*.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-EXAMPLES-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-examples-20mgl-pax-3asection-29"></a>
### 3.4 Examples
@@ -229,11 +229,11 @@ and the API of packages.
```
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-REFERENCE-20MGL-PAX-3ASECTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3a-40named-readtables-reference-20mgl-pax-3asection-29"></a>
## 4 Reference
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3ADEFREADTABLE-20-28MGL-PAX-3AMACRO-29-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3adefreadtable-20mgl-pax-3amacro-29"></a>
- [macro] **DEFREADTABLE** *NAME &BODY OPTIONS*
@@ -243,22 +243,26 @@ and the API of packages.
The readtable can be populated using the following `OPTIONS`:
+ - If the first element of `OPTIONS` is a string then it is associated
+ with the readtable as in `(SETF (DOCUMENTATION NAME 'READTABLE)
+ DOCSTRING)`.
+
- `(:MERGE READTABLE-DESIGNATORS+)`
Merge the macro character definitions from the readtables
designated into the new readtable being defined as per
- [`MERGE-READTABLES-INTO`][77fa]. The copied options are
+ [`MERGE-READTABLES-INTO`][1625]. The copied options are
`:DISPATCH-MACRO-CHAR`, `:MACRO-CHAR` and `:SYNTAX-FROM`, but not
- `READTABLE-CASE`.
+ [`READTABLE-CASE`][48f1].
If no `:MERGE` clause is given, an empty readtable is used. See
- [`MAKE-READTABLE`][958e].
+ [`MAKE-READTABLE`][fd4c].
- `(:FUSE READTABLE-DESIGNATORS+)`
Like `:MERGE` except:
- Error conditions of type [`READER-MACRO-CONFLICT`][acb7] that are signaled
+ Error conditions of type [`READER-MACRO-CONFLICT`][eab7] that are signaled
during the merge operation will be silently *continued*. It
follows that reader macros in earlier entries will be
overwritten by later ones. For backward compatibility, `:FUZE` is
@@ -267,22 +271,22 @@ and the API of packages.
- `(:DISPATCH-MACRO-CHAR MACRO-CHAR SUB-CHAR FUNCTION)`
Define a new sub character `SUB-CHAR` for the dispatching macro
- character `MACRO-CHAR`, per `SET-DISPATCH-MACRO-CHARACTER`. You
+ character `MACRO-CHAR`, per [`SET-DISPATCH-MACRO-CHARACTER`][5b1b]. You
probably have to define `MACRO-CHAR` as a dispatching macro
character by the following option first.
- `(:MACRO-CHAR MACRO-CHAR FUNCTION [NON-TERMINATING-P])`
Define a new macro character in the readtable, per
- `SET-MACRO-CHARACTER`. If `FUNCTION` is the keyword `:DISPATCH`,
- `MACRO-CHAR` is made a dispatching macro character, per
- `MAKE-DISPATCH-MACRO-CHARACTER`.
+ [`SET-MACRO-CHARACTER`][a8c1]. If `FUNCTION` is the keyword
+ `:DISPATCH`, `MACRO-CHAR` is made a dispatching macro character,
+ per [`MAKE-DISPATCH-MACRO-CHARACTER`][1ee4].
- `(:SYNTAX-FROM FROM-READTABLE-DESIGNATOR FROM-CHAR TO-CHAR)`
Set the character syntax of `TO-CHAR` in the readtable being
defined to the same syntax as `FROM-CHAR` as per
- `SET-SYNTAX-FROM-CHAR`.
+ [`SET-SYNTAX-FROM-CHAR`][3867].
- `(:CASE CASE-MODE)`
@@ -291,16 +295,16 @@ and the API of packages.
Any number of option clauses may appear. The options are grouped by
their type, but in each group the order the options appeared
textually is preserved. The following groups exist and are executed
- in the following order: `:MERGE` and `:FUSE` (one
- group), `:CASE`, `:MACRO-CHAR` and `:DISPATCH-MACRO-CHAR` (one group),
- finally `:SYNTAX-FROM`.
+ in the following order: `:MERGE` and `:FUSE` (one group), `:CASE`,
+ `:MACRO-CHAR` and `:DISPATCH-MACRO-CHAR` (one group), finally
+ `:SYNTAX-FROM`.
Notes:
The readtable is defined at load-time. If you want to have it
available at compilation time -- say to use its reader-macros in the
- same file as its definition -- you have to wrap the [`DEFREADTABLE`][8b94]
- form in an explicit `EVAL-WHEN`.
+ same file as its definition -- you have to wrap the `DEFREADTABLE`
+ form in an explicit [`EVAL-WHEN`][9c9c].
On redefinition, the target readtable is made empty first before
it's refilled according to the clauses.
@@ -308,23 +312,23 @@ and the API of packages.
`NIL`, `:STANDARD`, `:COMMON-LISP`, `:MODERN`, and `:CURRENT` are
preregistered readtable names.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AIN-READTABLE-20-28MGL-PAX-3AMACRO-29-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3ain-readtable-20mgl-pax-3amacro-29"></a>
- [macro] **IN-READTABLE** *NAME*
- Set `*READTABLE*` to the readtable referred to by the symbol `NAME`.
+ Set [`*READTABLE*`][b79a] to the readtable referred to by the symbol `NAME`.
Return the readtable.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AMAKE-READTABLE-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3amake-readtable-20function-29"></a>
- [function] **MAKE-READTABLE** *&OPTIONAL (NAME NIL NAME-SUPPLIED-P) &KEY MERGE*
Creates and returns a new readtable under the specified
`NAME`.
- `MERGE` takes a list of [`NAMED-READTABLE-DESIGNATOR`][fa0c]s and specifies the
+ `MERGE` takes a list of [`NAMED-READTABLE-DESIGNATOR`][4e61]s and specifies the
readtables the new readtable is created from. (See the `:MERGE` clause
- of [`DEFREADTABLE`][8b94] for details.)
+ of [`DEFREADTABLE`][6a02] for details.)
If `MERGE` is `NIL`, an empty readtable is used instead.
@@ -337,7 +341,7 @@ and the API of packages.
character has been made a constituent. Basically: whitespace stays
whitespace, everything else is constituent.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AMERGE-READTABLES-INTO-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3amerge-readtables-into-20function-29"></a>
- [function] **MERGE-READTABLES-INTO** *RESULT-READTABLE &REST NAMED-READTABLES*
@@ -346,79 +350,83 @@ and the API of packages.
If a macro character appears in more than one of the readtables,
i.e. if a conflict is discovered during the merge, an error of type
- [`READER-MACRO-CONFLICT`][acb7] is signaled.
+ [`READER-MACRO-CONFLICT`][eab7] is signaled.
The copied options are `:DISPATCH-MACRO-CHAR`, `:MACRO-CHAR` and
- `:SYNTAX-FROM`, but not `READTABLE-CASE`.
+ `:SYNTAX-FROM`, but not [`READTABLE-CASE`][48f1].
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AFIND-READTABLE-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3afind-readtable-20function-29"></a>
- [function] **FIND-READTABLE** *NAME*
Looks for the readtable specified by `NAME` and returns it if it is
found. Returns `NIL` otherwise.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AENSURE-READTABLE-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3aensure-readtable-20function-29"></a>
- [function] **ENSURE-READTABLE** *NAME &OPTIONAL (DEFAULT NIL DEFAULT-P)*
Looks up the readtable specified by `NAME` and returns it if it's found.
If it is not found, it registers the readtable designated by `DEFAULT`
- under the name represented by NAME; or if no default argument is
- given, it signals an error of type [`READTABLE-DOES-NOT-EXIST`][437a]
+ under the name represented by `NAME`; or if no default argument is
+ given, it signals an error of type [`READTABLE-DOES-NOT-EXIST`][02bf]
instead.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3ARENAME-READTABLE-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3arename-readtable-20function-29"></a>
- [function] **RENAME-READTABLE** *OLD-NAME NEW-NAME*
Replaces the associated name of the readtable designated by
`OLD-NAME` with `NEW-NAME`. If a readtable is already registered under
- `NEW-NAME`, an error of type [`READTABLE-DOES-ALREADY-EXIST`][4b51] is
+ `NEW-NAME`, an error of type [`READTABLE-DOES-ALREADY-EXIST`][78ad] is
signaled.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AREADTABLE-NAME-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3areadtable-name-20function-29"></a>
- [function] **READTABLE-NAME** *NAMED-READTABLE*
Returns the name of the readtable designated by `NAMED-READTABLE`,
or `NIL`.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AREGISTER-READTABLE-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3aregister-readtable-20function-29"></a>
- [function] **REGISTER-READTABLE** *NAME READTABLE*
Associate `READTABLE` with `NAME`. Returns the readtable.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AUNREGISTER-READTABLE-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3aunregister-readtable-20function-29"></a>
- [function] **UNREGISTER-READTABLE** *NAMED-READTABLE*
Remove the association of `NAMED-READTABLE`. Returns `T` if successfull,
`NIL` otherwise.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3ACOPY-NAMED-READTABLE-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3acopy-named-readtable-20function-29"></a>
- [function] **COPY-NAMED-READTABLE** *NAMED-READTABLE*
- Like `COPY-READTABLE` but takes a [`NAMED-READTABLE-DESIGNATOR`][fa0c] as argument.
+ Like [`COPY-READTABLE`][6d9f] but takes a [`NAMED-READTABLE-DESIGNATOR`][4e61] as argument.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3ALIST-ALL-NAMED-READTABLES-20FUNCTION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3alist-all-named-readtables-20function-29"></a>
-- [function] **LIST-ALL-NAMED-READTABLES**
+- [function] **LIST-ALL-NAMED-READTABLES**
Returns a list of all registered readtables. The returned list is
guaranteed to be fresh, but may contain duplicates.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3ANAMED-READTABLE-DESIGNATOR-20-28TYPE-29-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3anamed-readtable-designator-20type-29"></a>
- [type] **NAMED-READTABLE-DESIGNATOR**
Either a symbol or a readtable itself.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AREADER-MACRO-CONFLICT-20CONDITION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3areadtable-error-20condition-29"></a>
+
+- [condition] **READTABLE-ERROR** *[ERROR][d162]*
+
+<a id="x-28editor-hints-2enamed-readtables-3areader-macro-conflict-20condition-29"></a>
-- [condition] **READER-MACRO-CONFLICT** *READTABLE-ERROR*
+- [condition] **READER-MACRO-CONFLICT** *[READTABLE-ERROR][371c]*
Continuable.
@@ -427,34 +435,46 @@ and the API of packages.
macro character) is present in the both source and the target
readtable and the two respective reader macro functions differ.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AREADTABLE-DOES-ALREADY-EXIST-20CONDITION-29'></a>
+<a id="x-28editor-hints-2enamed-readtables-3areadtable-does-already-exist-20condition-29"></a>
-- [condition] **READTABLE-DOES-ALREADY-EXIST** *READTABLE-ERROR*
+- [condition] **READTABLE-DOES-ALREADY-EXIST** *[READTABLE-ERROR][371c]*
Continuable.
-<a id='x-28EDITOR-HINTS-2ENAMED-READTABLES-3AREADTABLE-DOES-NOT-EXIST-20CONDITION-29'></a>
-
-- [condition] **READTABLE-DOES-NOT-EXIST** *READTABLE-ERROR*
-
- [059d]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-ACKNOWLEDGEMENTS-20MGL-PAX-3ASECTION-29 "Acknowledgements"
- [0bc2]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-OVERVIEW-20MGL-PAX-3ASECTION-29 "Overview"
- [373d]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-REFERENCE-20MGL-PAX-3ASECTION-29 "Reference"
- [437a]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3AREADTABLE-DOES-NOT-EXIST-20CONDITION-29 "(EDITOR-HINTS.NAMED-READTABLES:READTABLE-DOES-NOT-EXIST CONDITION)"
- [4b51]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3AREADTABLE-DOES-ALREADY-EXIST-20CONDITION-29 "(EDITOR-HINTS.NAMED-READTABLES:READTABLE-DOES-ALREADY-EXIST CONDITION)"
- [58c6]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-PREREGISTERED-20MGL-PAX-3ASECTION-29 "Preregistered Readtables"
- [62b8]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-API-IDIOSYNCRASIES-20MGL-PAX-3ASECTION-29 "Important API idiosyncrasies"
- [6faf]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-INTRODUCTION-20MGL-PAX-3ASECTION-29 "Introduction"
- [77fa]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3AMERGE-READTABLES-INTO-20FUNCTION-29 "(EDITOR-HINTS.NAMED-READTABLES:MERGE-READTABLES-INTO FUNCTION)"
- [8688]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-LINKS-20MGL-PAX-3ASECTION-29 "Links"
- [8b94]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3ADEFREADTABLE-20-28MGL-PAX-3AMACRO-29-29 "(EDITOR-HINTS.NAMED-READTABLES:DEFREADTABLE (MGL-PAX:MACRO))"
- [958e]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3AMAKE-READTABLE-20FUNCTION-29 "(EDITOR-HINTS.NAMED-READTABLES:MAKE-READTABLE FUNCTION)"
- [9b5b]: #x-28-22named-readtables-22-20ASDF-2FSYSTEM-3ASYSTEM-29 "(\"named-readtables\" ASDF/SYSTEM:SYSTEM)"
- [acb7]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3AREADER-MACRO-CONFLICT-20CONDITION-29 "(EDITOR-HINTS.NAMED-READTABLES:READER-MACRO-CONFLICT CONDITION)"
- [cf94]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-EXAMPLES-20MGL-PAX-3ASECTION-29 "Examples"
- [de3b]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3AIN-READTABLE-20-28MGL-PAX-3AMACRO-29-29 "(EDITOR-HINTS.NAMED-READTABLES:IN-READTABLE (MGL-PAX:MACRO))"
- [e4cd]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3A-40NAMED-READTABLES-API-NOTES-20MGL-PAX-3ASECTION-29 "Notes on the API"
- [fa0c]: #x-28EDITOR-HINTS-2ENAMED-READTABLES-3ANAMED-READTABLE-DESIGNATOR-20-28TYPE-29-29 "(EDITOR-HINTS.NAMED-READTABLES:NAMED-READTABLE-DESIGNATOR (TYPE))"
+<a id="x-28editor-hints-2enamed-readtables-3areadtable-does-not-exist-20condition-29"></a>
+
+- [condition] **READTABLE-DOES-NOT-EXIST** *[READTABLE-ERROR][371c]*
+
+ [02bf]: #x-28editor-hints-2enamed-readtables-3areadtable-does-not-exist-20condition-29 "EDITOR-HINTS.NAMED-READTABLES:READTABLE-DOES-NOT-EXIST CONDITION"
+ [125e]: http://www.lispworks.com/documentation/HyperSpec/Body/m_in_pkg.htm "IN-PACKAGE (MGL-PAX:CLHS MGL-PAX:MACRO)"
+ [1625]: #x-28editor-hints-2enamed-readtables-3amerge-readtables-into-20function-29 "EDITOR-HINTS.NAMED-READTABLES:MERGE-READTABLES-INTO FUNCTION"
+ [1ee4]: http://www.lispworks.com/documentation/HyperSpec/Body/f_mk_dis.htm "MAKE-DISPATCH-MACRO-CHARACTER (MGL-PAX:CLHS FUNCTION)"
+ [371c]: #x-28editor-hints-2enamed-readtables-3areadtable-error-20condition-29 "EDITOR-HINTS.NAMED-READTABLES:READTABLE-ERROR CONDITION"
+ [3867]: http://www.lispworks.com/documentation/HyperSpec/Body/f_set_sy.htm "SET-SYNTAX-FROM-CHAR (MGL-PAX:CLHS FUNCTION)"
+ [398b]: #x-28editor-hints-2enamed-readtables-3a-40named-readtables-api-idiosyncrasies-20mgl-pax-3asection-29 "Important API idiosyncrasies"
+ [480f]: #x-28editor-hints-2enamed-readtables-3a-40named-readtables-introduction-20mgl-pax-3asection-29 "Introduction"
+ [48f1]: http://www.lispworks.com/documentation/HyperSpec/Body/f_rdtabl.htm "READTABLE-CASE (MGL-PAX:CLHS FUNCTION)"
+ [4d56]: #x-28editor-hints-2enamed-readtables-3a-40named-readtables-reference-20mgl-pax-3asection-29 "Reference"
+ [4e61]: #x-28editor-hints-2enamed-readtables-3anamed-readtable-designator-20type-29 "EDITOR-HINTS.NAMED-READTABLES:NAMED-READTABLE-DESIGNATOR TYPE"
+ [5b1b]: http://www.lispworks.com/documentation/HyperSpec/Body/f_set__1.htm "SET-DISPATCH-MACRO-CHARACTER (MGL-PAX:CLHS FUNCTION)"
+ [6a02]: #x-28editor-hints-2enamed-readtables-3adefreadtable-20mgl-pax-3amacro-29 "EDITOR-HINTS.NAMED-READTABLES:DEFREADTABLE MGL-PAX:MACRO"
+ [6d9f]: http://www.lispworks.com/documentation/HyperSpec/Body/f_cp_rdt.htm "COPY-READTABLE (MGL-PAX:CLHS FUNCTION)"
+ [718a]: #x-28-22named-readtables-22-20asdf-2fsystem-3asystem-29 '"named-readtables" ASDF/SYSTEM:SYSTEM'
+ [78ad]: #x-28editor-hints-2enamed-readtables-3areadtable-does-already-exist-20condition-29 "EDITOR-HINTS.NAMED-READTABLES:READTABLE-DOES-ALREADY-EXIST CONDITION"
+ [9b43]: http://www.lispworks.com/documentation/HyperSpec/Body/m_defpkg.htm "DEFPACKAGE (MGL-PAX:CLHS MGL-PAX:MACRO)"
+ [9c9c]: http://www.lispworks.com/documentation/HyperSpec/Body/s_eval_w.htm "EVAL-WHEN (MGL-PAX:CLHS MGL-PAX:MACRO)"
+ [a61b]: #x-28editor-hints-2enamed-readtables-3a-40named-readtables-links-20mgl-pax-3asection-29 "Links"
+ [a8c1]: http://www.lispworks.com/documentation/HyperSpec/Body/f_set_ma.htm "SET-MACRO-CHARACTER (MGL-PAX:CLHS FUNCTION)"
+ [aae8]: #x-28editor-hints-2enamed-readtables-3a-40named-readtables-examples-20mgl-pax-3asection-29 "Examples"
+ [b79a]: http://www.lispworks.com/documentation/HyperSpec/Body/v_rdtabl.htm "*READTABLE* (MGL-PAX:CLHS VARIABLE)"
+ [c1e9]: #x-28editor-hints-2enamed-readtables-3a-40named-readtables-overview-20mgl-pax-3asection-29 "Overview"
+ [c5dc]: #x-28editor-hints-2enamed-readtables-3a-40named-readtables-preregistered-20mgl-pax-3asection-29 "Preregistered Readtables"
+ [d162]: http://www.lispworks.com/documentation/HyperSpec/Body/e_error.htm "ERROR (MGL-PAX:CLHS CONDITION)"
+ [eab7]: #x-28editor-hints-2enamed-readtables-3areader-macro-conflict-20condition-29 "EDITOR-HINTS.NAMED-READTABLES:READER-MACRO-CONFLICT CONDITION"
+ [ebdc]: #x-28editor-hints-2enamed-readtables-3a-40named-readtables-acknowledgements-20mgl-pax-3asection-29 "Acknowledgements"
+ [ee2d]: #x-28editor-hints-2enamed-readtables-3ain-readtable-20mgl-pax-3amacro-29 "EDITOR-HINTS.NAMED-READTABLES:IN-READTABLE MGL-PAX:MACRO"
+ [f800]: #x-28editor-hints-2enamed-readtables-3a-40named-readtables-api-notes-20mgl-pax-3asection-29 "Notes on the API"
+ [fd4c]: #x-28editor-hints-2enamed-readtables-3amake-readtable-20function-29 "EDITOR-HINTS.NAMED-READTABLES:MAKE-READTABLE FUNCTION"
* * *
###### \[generated by [MGL-PAX](https://github.com/melisgl/mgl-pax)\]
diff --git a/debian/changelog b/debian/changelog
index 780e3f9..eb0664b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,12 @@
-cl-named-readtables (20201221.gitc5689a4-2) UNRELEASED; urgency=medium
+cl-named-readtables (20230721.git2c05652-1) UNRELEASED; urgency=medium
+ [ Sébastien Villemot ]
* Remove myself from Uploaders
- -- Sébastien Villemot <sebastien@debian.org> Sat, 10 Jun 2023 13:52:07 +0200
+ [ Debian Janitor ]
+ * New upstream release.
+
+ -- Sébastien Villemot <sebastien@debian.org> Wed, 26 Jul 2023 21:47:59 -0000
cl-named-readtables (20201221.gitc5689a4-1) unstable; urgency=medium
diff --git a/named-readtables.asd b/named-readtables.asd
index bf29844..23f2f95 100644
--- a/named-readtables.asd
+++ b/named-readtables.asd
@@ -10,9 +10,11 @@
(let ((sb-ext:*derive-function-types* t))
(call-next-method)))
+;;; See NAMED-READTABLES::@NAMED-READTABLES-MANUAL for the user guide
+;;; (if NAMED-READTABLES/DOC is loaded).
(defsystem "named-readtables"
- :description "Library that creates a namespace for named readtable
- akin to the namespace of packages."
+ :description "Library that creates a namespace for readtables akin
+ to the namespace of packages."
:author "Tobias C. Rittweiler <trittweiler@common-lisp.net>"
:maintainer "Gábor Melis <mega@retes.hu>"
:mailto "mega@retes.hu"
@@ -36,15 +38,14 @@
:author "Tobias C. Rittweiler <trittweiler@common-lisp.net>"
:maintainer "Gábor Melis <mega@retes.hu>"
:mailto "mega@retes.hu"
- :depends-on ("named-readtables")
+ :depends-on ("named-readtables" "try")
:pathname "test"
:serial t
:default-component-class named-readtables-source-file
:components
((:file "package")
- (:file "rt")
(:file "tests"))
- :perform (test-op (o c) (symbol-call :named-readtables-test '#:do-tests)))
+ :perform (test-op (o c) (symbol-call :named-readtables-test '#:test)))
;;; MGL-PAX depends on NAMED-READTABLES so we must put documentation
;;; in a separate system in order to be able to use MGL-PAX.
diff --git a/src/cruft.lisp b/src/cruft.lisp
index cc440aa..4cd89cb 100644
--- a/src/cruft.lisp
+++ b/src/cruft.lisp
@@ -21,7 +21,6 @@
(pushnew :sbcl+safe-standard-readtable *features*)))
-;;;;; Implementation-dependent cruft
;;;; Mapping between a readtable object and its readtable-name.
@@ -45,6 +44,43 @@
#+ :common-lisp (list* :standard :current :modern
(loop for name being each hash-value of *readtable-names*
collect name)))
+
+;;;; Mapping READTABLE objects to docstrings.
+
+(defvar *readtable-to-docstring* (make-hash-table :test 'eq))
+
+(defun %associate-docstring-with-readtable (readtable docstring)
+ (setf (gethash readtable *readtable-to-docstring*) docstring))
+
+(defun %unassociate-docstring-from-readtable (readtable)
+ (prog1 (gethash readtable *readtable-to-docstring*)
+ (remhash readtable *readtable-to-docstring*)))
+
+;;;; Specialized DOCUMENTATION for named readtables.
+
+;;; Lispworks, at least, forbids defining methods on DOCUMENTATION.
+;;; Wrapping these forms with WITHOUT-PACKAGE-LOCK (as for PRINT-OBJECT,
+;;; see below) allows this to compile on Lispworks.
+
+(without-package-lock (:common-lisp #+lispworks :implementation)
+
+ (defmethod documentation ((name symbol) (doc-type (eql 'readtable)))
+ (let ((readtable (find-readtable name)))
+ (and readtable (gethash readtable *readtable-to-docstring*))))
+
+ (defmethod documentation ((readtable readtable) (doc-type (eql 'readtable)))
+ (gethash readtable *readtable-to-docstring*))
+
+ (defmethod (setf documentation) (docstring (name symbol)
+ (doc-type (eql 'readtable)))
+ (let ((readtable (find-readtable name)))
+ (unless readtable
+ (error 'readtable-does-not-exist :readtable-name name))
+ (setf (gethash readtable *readtable-to-docstring*) docstring)))
+
+ (defmethod (setf documentation) (docstring (readtable readtable)
+ (doc-type (eql 'readtable)))
+ (setf (gethash readtable *readtable-to-docstring*) docstring)))
;;;; Mapping between a readtable-name and the actual readtable object.
@@ -161,11 +197,21 @@
(macrolet ((,name () `(funcall ,',it)))
,@body))))
+(defun funcall-or (package-and-name-list &rest args)
+ (loop for (package name) in package-and-name-list
+ do (let ((symbol (find-symbol (string name) package)))
+ (when symbol
+ (return-from funcall-or (apply symbol args))))))
+
#+sbcl
(defun %make-readtable-iterator (readtable)
- (let ((char-macro-array (sb-impl::character-macro-array readtable))
- (char-macro-ht (sb-impl::character-macro-hash-table readtable))
- (dispatch-tables (sb-impl::dispatch-tables readtable))
+ (let ((char-macro-array (funcall-or '((sb-impl base-char-macro-array)
+ (sb-impl character-macro-array))
+ readtable))
+ (char-macro-ht (funcall-or '((sb-impl extended-char-table)
+ (sb-impl character-macro-hash-table))
+ readtable))
+ (dispatch-tables (sb-impl::dispatch-tables readtable))
(char-code 0))
(with-hash-table-iterator (ht-iterator char-macro-ht)
(labels ((grovel-base-chars ()
diff --git a/src/define-api.lisp b/src/define-api.lisp
index 0bcff58..6686073 100644
--- a/src/define-api.lisp
+++ b/src/define-api.lisp
@@ -16,50 +16,49 @@
`(progn
(declaim (ftype (function ,arg-typespec ,value-typespec) ,name))
(locally
- ;;; Muffle the annoying "&OPTIONAL and &KEY found in
- ;;; the same lambda list" style-warning
+ ;; Muffle the annoying "&OPTIONAL and &KEY found in
+ ;; the same lambda list" style-warning
#+sbcl (declare (sb-ext:muffle-conditions style-warning))
(defun ,name ,lambda-list
,docstring
-
- #+sbcl (declare (sb-ext:unmuffle-conditions style-warning))
-
,@decls
+ (locally
+ #+sbcl (declare (sb-ext:unmuffle-conditions style-warning))
- ;; SBCL will interpret the ftype declaration as
- ;; assertion and will insert type checks for us.
- #-sbcl
- (progn
- ;; CHECK-TYPE required parameters
- ,@(loop for req-arg in reqs
- for req-type = (pop type-list)
- do (assert req-type)
- collect `(check-type ,req-arg ,req-type))
+ ;; SBCL will interpret the ftype declaration as
+ ;; assertion and will insert type checks for us.
+ #-sbcl
+ (progn
+ ;; CHECK-TYPE required parameters
+ ,@(loop for req-arg in reqs
+ for req-type = (pop type-list)
+ do (assert req-type)
+ collect `(check-type ,req-arg ,req-type))
- ;; CHECK-TYPE optional parameters
- ,@(progn
- (assert (or (null opts)
- (eq (pop type-list) '&optional)))
- (loop for (opt-arg . nil) in opts
- for opt-type = (pop type-list)
- do (assert opt-type)
- collect `(check-type ,opt-arg ,opt-type)))
+ ;; CHECK-TYPE optional parameters
+ ,@(progn
+ (assert (or (null opts)
+ (eq (pop type-list) '&optional)))
+ (loop for (opt-arg . nil) in opts
+ for opt-type = (pop type-list)
+ do (assert opt-type)
+ collect `(check-type ,opt-arg ,opt-type)))
- ;; CHECK-TYPE rest parameter
- ,@(when rest
- (assert (eq (pop type-list) '&rest))
- (let ((rest-type (pop type-list)))
- (assert rest-type)
- `((dolist (x ,rest)
- (check-type x ,rest-type)))))
+ ;; CHECK-TYPE rest parameter
+ ,@(when rest
+ (assert (eq (pop type-list) '&rest))
+ (let ((rest-type (pop type-list)))
+ (assert rest-type)
+ `((dolist (x ,rest)
+ (check-type x ,rest-type)))))
- ;; CHECK-TYPE key parameters
- ,@(progn
- (assert (or (null keys)
- (eq (pop type-list) '&key)))
- (loop for ((keyword key-arg) . nil) in keys
- for (nil key-type) = (find keyword type-list
- :key #'car)
- collect `(check-type ,key-arg ,key-type))))
+ ;; CHECK-TYPE key parameters
+ ,@(progn
+ (assert (or (null keys)
+ (eq (pop type-list) '&key)))
+ (loop for ((keyword key-arg) . nil) in keys
+ for (nil key-type) = (find keyword type-list
+ :key #'car)
+ collect `(check-type ,key-arg ,key-type))))
- ,@body))))))))
+ ,@body)))))))))
diff --git a/src/doc.lisp b/src/doc.lisp
index c8d7130..9fab7bd 100644
--- a/src/doc.lisp
+++ b/src/doc.lisp
@@ -1,15 +1,12 @@
(in-package :named-readtables)
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (use-package :mgl-pax))
-
-(defsection @named-readtables-manual (:title "Named Readtables Manual")
+(pax:defsection @named-readtables-manual (:title "Named Readtables Manual")
(named-readtables asdf:system)
- (@named-readtables-introduction section)
- (@named-readtables-overview section)
- (@named-readtables-reference section))
+ (@named-readtables-introduction pax:section)
+ (@named-readtables-overview pax:section)
+ (@named-readtables-reference pax:section))
-(defsection @named-readtables-introduction (:title "Introduction")
+(pax:defsection @named-readtables-introduction (:title "Introduction")
"Named-Readtables is a library that provides a namespace for
readtables akin to the already-existing namespace of packages. In
particular:
@@ -36,30 +33,31 @@
glance;
* it makes it possible to use multiple inheritance between readtables."
- (@named-readtables-links section)
- (@named-readtables-acknowledgements section))
+ (@named-readtables-links pax:section)
+ (@named-readtables-acknowledgements pax:section))
-(defsection @named-readtables-links (:title "Links")
+(pax:defsection @named-readtables-links (:title "Links")
"Here is the [official repository][named-readtables-repo] and the
[HTML documentation][named-readtables-doc] for the latest version.
[named-readtables-repo]: https://github.com/melisgl/named-readtables
[named-readtables-doc]: http://melisgl.github.io/mgl-pax-world/named-readtables-manual.html")
-(defsection @named-readtables-acknowledgements (:title "Acknowledgements")
+(pax:defsection @named-readtables-acknowledgements (:title "Acknowledgements")
"Thanks to Robert Goldman for making me want to write this library.
Thanks to Stephen Compall, Ariel Badichi, David Lichteblau, Bart
Botta, David Crawford, and Pascal Costanza for being early adopters,
providing comments and bugfixes.")
-(defsection @named-readtables-overview (:title "Overview")
- (@named-readtables-api-notes section)
- (@named-readtables-api-idiosyncrasies section)
- (@named-readtables-preregistered section)
- (@named-readtables-examples section))
+(pax:defsection @named-readtables-overview (:title "Overview")
+ (@named-readtables-api-notes pax:section)
+ (@named-readtables-api-idiosyncrasies pax:section)
+ (@named-readtables-preregistered pax:section)
+ (@named-readtables-examples pax:section))
-(defsection @named-readtables-api-notes (:title "Notes on the API" :export nil)
+(pax:defsection @named-readtables-api-notes
+ (:title "Notes on the API" :export nil)
"The API heavily imitates the API of packages. This has the nice
property that any experienced Common Lisper will take it up without
effort.
@@ -82,7 +80,7 @@
LIST-ALL-NAMED-READTABLES - LIST-ALL-PACKAGES")
-(defsection @named-readtables-api-idiosyncrasies
+(pax:defsection @named-readtables-api-idiosyncrasies
(:title "Important API idiosyncrasies" :export nil)
"There are three major differences between the API of Named-Readtables,
and the API of packages.
@@ -148,8 +146,8 @@
definition, wrap the DEFREADTABLE and the reader-macro function
definitions in an explicit EVAL-WHEN.")
-(defsection @named-readtables-preregistered (:title "Preregistered Readtables"
- :export nil)
+(pax:defsection @named-readtables-preregistered
+ (:title "Preregistered Readtables" :export nil)
"- NIL, :STANDARD, and :COMMON-LISP designate the
_standard readtable_.
@@ -157,7 +155,7 @@
- :CURRENT designates the _current readtable_.")
-(defsection @named-readtables-examples (:title "Examples" :export nil)
+(pax:defsection @named-readtables-examples (:title "Examples" :export nil)
"```commonlisp
(defreadtable elisp:syntax
(:merge :standard)
@@ -185,9 +183,9 @@
...
```")
-(defsection @named-readtables-reference (:title "Reference")
- (defreadtable macro)
- (in-readtable macro)
+(pax:defsection @named-readtables-reference (:title "Reference")
+ (defreadtable pax:macro)
+ (in-readtable pax:macro)
(make-readtable function)
(merge-readtables-into function)
(find-readtable function)
@@ -199,6 +197,7 @@
(copy-named-readtable function)
(list-all-named-readtables function)
(named-readtable-designator type)
+ (readtable-error condition)
(reader-macro-conflict condition)
(readtable-does-already-exist condition)
(readtable-does-not-exist condition))
@@ -211,13 +210,13 @@
(defun pax-pages ()
`((:objects
(, @named-readtables-manual)
- :source-uri-fn ,(make-github-source-uri-fn
+ :source-uri-fn ,(pax:make-github-source-uri-fn
:named-readtables
"https://github.com/melisgl/named-readtables"))))
-(register-doc-in-pax-world :named-readtables (pax-sections) (pax-pages))
+(pax:register-doc-in-pax-world :named-readtables (pax-sections) (pax-pages))
#+nil
(progn
- (update-asdf-system-readmes @named-readtables-manual :named-readtables)
- (update-asdf-system-html-docs @named-readtables-manual :named-readtables
- :pages (pax-pages)))
+ (pax:update-asdf-system-readmes @named-readtables-manual :named-readtables)
+ (pax:update-asdf-system-html-docs @named-readtables-manual :named-readtables
+ :pages (pax-pages)))
diff --git a/src/named-readtables.lisp b/src/named-readtables.lisp
index e564b01..00ddb6b 100644
--- a/src/named-readtables.lisp
+++ b/src/named-readtables.lisp
@@ -26,6 +26,10 @@
The readtable can be populated using the following OPTIONS:
+ - If the first element of OPTIONS is a string then it is associated
+ with the readtable as in `(SETF (DOCUMENTATION NAME 'READTABLE)
+ DOCSTRING)`.
+
- `(:MERGE READTABLE-DESIGNATORS+)`
Merge the macro character definitions from the readtables
@@ -57,9 +61,9 @@
- `(:MACRO-CHAR MACRO-CHAR FUNCTION [NON-TERMINATING-P])`
Define a new macro character in the readtable, per
- SET-MACRO-CHARACTER. If `FUNCTION` is the keyword :DISPATCH,
- `MACRO-CHAR` is made a dispatching macro character, per
- MAKE-DISPATCH-MACRO-CHARACTER.
+ SET-MACRO-CHARACTER. If [FUNCTION][argument] is the keyword
+ :DISPATCH, `MACRO-CHAR` is made a dispatching macro character,
+ per MAKE-DISPATCH-MACRO-CHARACTER.
- `(:SYNTAX-FROM FROM-READTABLE-DESIGNATOR FROM-CHAR TO-CHAR)`
@@ -74,9 +78,9 @@
Any number of option clauses may appear. The options are grouped by
their type, but in each group the order the options appeared
textually is preserved. The following groups exist and are executed
- in the following order: :MERGE and :FUSE (one
- group), :CASE, :MACRO-CHAR and :DISPATCH-MACRO-CHAR (one group),
- finally :SYNTAX-FROM.
+ in the following order: :MERGE and :FUSE (one group), :CASE,
+ :MACRO-CHAR and :DISPATCH-MACRO-CHAR (one group), finally
+ :SYNTAX-FROM.
Notes:
@@ -125,7 +129,9 @@
(setq clauses (if (listp clauses) clauses (list clauses)))
(remove-if-not #'(lambda (x) (member x clauses))
options :key #'first)))
- (let* ((merge-clauses (remove-clauses '(:merge :fuze :fuse) options))
+ (let* ((docstring (when (stringp (first options))
+ (pop options)))
+ (merge-clauses (remove-clauses '(:merge :fuze :fuse) options))
(case-clauses (remove-clauses :case options))
(macro-clauses (remove-clauses '(:macro-char :dispatch-macro-char)
options))
@@ -139,7 +145,7 @@
(error "Bogus DEFREADTABLE clauses: ~/PPRINT-LINEAR/" other-clauses))
(t
`(eval-when (:load-toplevel :execute)
- ;; The (FIND-READTABLE ...) isqrt important for proper
+ ;; The (FIND-READTABLE ...) is important for proper
;; redefinition semantics, as redefining has to modify the
;; already existing readtable object.
(let ((readtable (find-readtable ',name)))
@@ -150,6 +156,7 @@
(simple-style-warn
"Overwriting already existing readtable ~S."
readtable)))
+ (setf (documentation readtable 'readtable) ,docstring)
,@(loop for option in merge-clauses
collect (process-option option 'readtable))
,@(loop for option in case-clauses
@@ -304,6 +311,8 @@
(%unassociate-readtable-from-name readtable-name readtable)
(%associate-name-with-readtable new-name readtable)
(%associate-readtable-with-name new-name readtable)
+ (%associate-docstring-with-readtable
+ readtable (%unassociate-docstring-from-readtable readtable))
readtable))
(define-api merge-readtables-into
@@ -530,7 +539,8 @@
(check-type readtable-name
(not (satisfies reserved-readtable-name-p)))
(%unassociate-readtable-from-name readtable-name readtable)
- (%unassociate-name-from-readtable readtable-name readtable)))))
+ (%unassociate-name-from-readtable readtable-name readtable)
+ (%unassociate-docstring-from-readtable readtable)))))
(define-api readtable-name
(named-readtable)
diff --git a/src/package.lisp b/src/package.lisp
index 0cfeb9b..e1a8061 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1,8 +1,8 @@
(in-package :common-lisp-user)
-;;; This is is basically MGL-PAX:DEFINE-PACKAGE but we don't have it
+;;; This is is basically MGL-PAX:DEFINE-PACKAGE, but we don't have it
;;; defined yet. The package variance stuff is because we export
-;;; documentation from the NAMED-READTABLES-DOC system.
+;;; documentation from the NAMED-READTABLES/DOC system.
(eval-when (:compile-toplevel :load-toplevel :execute)
(locally
(declare #+sbcl
@@ -28,9 +28,10 @@
;; Types
#:named-readtable-designator
;; Conditions
+ #:readtable-error
#:reader-macro-conflict
#:readtable-does-already-exist
#:readtable-does-not-exist)
- (:documentation "See NAMED-READTABLES:@NAMED-READTABLES-MANUAL.")))))
+ (:documentation "See NAMED-READTABLES::@NAMED-READTABLES-MANUAL.")))))
(pushnew :named-readtables *features*)
diff --git a/test/package.lisp b/test/package.lisp
index c67c29b..b384719 100644
--- a/test/package.lisp
+++ b/test/package.lisp
@@ -1,12 +1,10 @@
;;; -*- Mode:Lisp -*-
-(in-package :cl-user)
-
-(defpackage :named-readtables-test
- (:use :cl :named-readtables)
+(cl:defpackage :named-readtables-test
+ (:use :common-lisp :named-readtables :try)
(:import-from :named-readtables
- #:dispatch-macro-char-p
- #:do-readtable
- #:ensure-function
- #:ensure-dispatch-macro-character
- #:function=))
\ No newline at end of file
+ #:dispatch-macro-char-p
+ #:do-readtable
+ #:ensure-function
+ #:ensure-dispatch-macro-character
+ #:function=))
diff --git a/test/rt.lisp b/test/rt.lisp
deleted file mode 100644
index 45aea70..0000000
--- a/test/rt.lisp
+++ /dev/null
@@ -1,256 +0,0 @@
-#|----------------------------------------------------------------------------|
- | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
- | |
- | Permission to use, copy, modify, and distribute this software and its |
- | documentation for any purpose and without fee is hereby granted, provided |
- | that this copyright and permission notice appear in all copies and |
- | supporting documentation, and that the name of M.I.T. not be used in |
- | advertising or publicity pertaining to distribution of the software |
- | without specific, written prior permission. M.I.T. makes no |
- | representations about the suitability of this software for any purpose. |
- | It is provided "as is" without express or implied warranty. |
- | |
- | M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING |
- | ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL |
- | M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR |
- | ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, |
- | WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, |
- | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS |
- | SOFTWARE. |
- |----------------------------------------------------------------------------|#
-
-;; (defpackage :rt
-;; (:use #:cl)
-;; (:export #:*do-tests-when-defined* #:*test* #:continue-testing
-;; #:deftest #:do-test #:do-tests #:get-test #:pending-tests
-;; #:rem-all-tests #:rem-test)
-;; (:documentation "The MIT regression tester"))
-
-;; (in-package :rt)
-
-(in-package :named-readtables-test)
-
-(defvar *test* nil "Current test name")
-(defvar *do-tests-when-defined* nil)
-(defvar *entries* '(nil) "Test database")
-(defvar *in-test* nil "Used by TEST")
-(defvar *debug* nil "For debugging")
-(defvar *catch-errors* t
- "When true, causes errors in a test to be caught.")
-(defvar *print-circle-on-failure* nil
- "Failure reports are printed with *PRINT-CIRCLE* bound to this value.")
-(defvar *compile-tests* nil
- "When true, compile the tests before running them.")
-(defvar *optimization-settings* '((safety 3)))
-(defvar *expected-failures* nil
- "A list of test names that are expected to fail.")
-
-(defstruct (entry (:conc-name nil)
- (:type list))
- pend name form)
-
-(defmacro vals (entry) `(cdddr ,entry))
-
-(defmacro defn (entry) `(cdr ,entry))
-
-(defun pending-tests ()
- (do ((l (cdr *entries*) (cdr l))
- (r nil))
- ((null l) (nreverse r))
- (when (pend (car l))
- (push (name (car l)) r))))
-
-(defun rem-all-tests ()
- (setq *entries* (list nil))
- nil)
-
-(defun rem-test (&optional (name *test*))
- (do ((l *entries* (cdr l)))
- ((null (cdr l)) nil)
- (when (equal (name (cadr l)) name)
- (setf (cdr l) (cddr l))
- (return name))))
-
-(defun get-test (&optional (name *test*))
- (defn (get-entry name)))
-
-(defun get-entry (name)
- (let ((entry (find name (cdr *entries*)
- :key #'name
- :test #'equal)))
- (when (null entry)
- (report-error t
- "~%No test with name ~:@(~S~)."
- name))
- entry))
-
-(defmacro deftest (name form &rest values)
- `(add-entry '(t ,name ,form .,values)))
-
-(defun add-entry (entry)
- (setq entry (copy-list entry))
- (do ((l *entries* (cdr l))) (nil)
- (when (null (cdr l))
- (setf (cdr l) (list entry))
- (return nil))
- (when (equal (name (cadr l))
- (name entry))
- (setf (cadr l) entry)
- (report-error nil
- "Redefining test ~:@(~S~)"
- (name entry))
- (return nil)))
- (when *do-tests-when-defined*
- (do-entry entry))
- (setq *test* (name entry)))
-
-(defun report-error (error? &rest args)
- (cond (*debug*
- (apply #'format t args)
- (if error? (throw '*debug* nil)))
- (error? (apply #'error args))
- (t (apply #'warn args))))
-
-(defun do-test (&optional (name *test*))
- (do-entry (get-entry name)))
-
-(defun equalp-with-case (x y)
- "Like EQUALP, but doesn't do case conversion of characters."
- (cond
- ((eq x y) t)
- ((consp x)
- (and (consp y)
- (equalp-with-case (car x) (car y))
- (equalp-with-case (cdr x) (cdr y))))
- ((and (typep x 'array)
- (= (array-rank x) 0))
- (equalp-with-case (aref x) (aref y)))
- ((typep x 'vector)
- (and (typep y 'vector)
- (let ((x-len (length x))
- (y-len (length y)))
- (and (eql x-len y-len)
- (loop
- for e1 across x
- for e2 across y
- always (equalp-with-case e1 e2))))))
- ((and (typep x 'array)
- (typep y 'array)
- (not (equal (array-dimensions x)
- (array-dimensions y))))
- nil)
- ((typep x 'array)
- (and (typep y 'array)
- (let ((size (array-total-size x)))
- (loop for i from 0 below size
- always (equalp-with-case (row-major-aref x i)
- (row-major-aref y i))))))
- (t (eql x y))))
-
-(defun do-entry (entry &optional
- (s *standard-output*))
- (catch '*in-test*
- (setq *test* (name entry))
- (setf (pend entry) t)
- (let* ((*in-test* t)
- ;; (*break-on-warnings* t)
- (aborted nil)
- r)
- ;; (declare (special *break-on-warnings*))
-
- (block aborted
- (setf r
- (flet ((%do
- ()
- (if *compile-tests*
- (multiple-value-list
- (funcall (compile
- nil
- `(lambda ()
- (declare
- (optimize ,@*optimization-settings*))
- ,(form entry)))))
- (multiple-value-list
- (eval (form entry))))))
- (if *catch-errors*
- (handler-bind
- ((style-warning #'muffle-warning)
- (error #'(lambda (c)
- (setf aborted t)
- (setf r (list c))
- (return-from aborted nil))))
- (%do))
- (%do)))))
-
- (setf (pend entry)
- (or aborted
- (not (equalp-with-case r (vals entry)))))
-
- (when (pend entry)
- (let ((*print-circle* *print-circle-on-failure*))
- (format s "~&Test ~:@(~S~) failed~
- ~%Form: ~S~
- ~%Expected value~P: ~
- ~{~S~^~%~17t~}~%"
- *test* (form entry)
- (length (vals entry))
- (vals entry))
- (format s "Actual value~P: ~
- ~{~S~^~%~15t~}.~%"
- (length r) r)))))
- (when (not (pend entry)) *test*))
-
-(defun continue-testing ()
- (if *in-test*
- (throw '*in-test* nil)
- (do-entries *standard-output*)))
-
-(defun do-tests (&optional
- (out *standard-output*))
- (dolist (entry (cdr *entries*))
- (setf (pend entry) t))
- (if (streamp out)
- (do-entries out)
- (with-open-file
- (stream out :direction :output)
- (do-entries stream))))
-
-(defun do-entries (s)
- (format s "~&Doing ~A pending test~:P ~
- of ~A tests total.~%"
- (count t (cdr *entries*)
- :key #'pend)
- (length (cdr *entries*)))
- (dolist (entry (cdr *entries*))
- (when (pend entry)
- (format s "~@[~<~%~:; ~:@(~S~)~>~]"
- (do-entry entry s))))
- (let ((pending (pending-tests))
- (expected-table (make-hash-table :test #'equal)))
- (dolist (ex *expected-failures*)
- (setf (gethash ex expected-table) t))
- (let ((new-failures
- (loop for pend in pending
- unless (gethash pend expected-table)
- collect pend)))
- (if (null pending)
- (format s "~&No tests failed.")
- (progn
- (format s "~&~A out of ~A ~
- total tests failed: ~
- ~:@(~{~<~% ~1:;~S~>~
- ~^, ~}~)."
- (length pending)
- (length (cdr *entries*))
- pending)
- (if (null new-failures)
- (format s "~&No unexpected failures.")
- (when *expected-failures*
- (format s "~&~A unexpected failures: ~
- ~:@(~{~<~% ~1:;~S~>~
- ~^, ~}~)."
- (length new-failures)
- new-failures)))
- ))
- (finish-output s)
- (null pending))))
diff --git a/test/tests.lisp b/test/tests.lisp
index 1a84bb1..d69eecf 100644
--- a/test/tests.lisp
+++ b/test/tests.lisp
@@ -11,10 +11,6 @@
(defun length=1 (list)
(and list (null (cdr list))))
-(defmacro signals-condition-p (name &body body)
- `(handler-case (prog1 nil ,@body)
- (,(second name) () t)))
-
(defmacro continue-condition (name &body body)
`(handler-bind ((,(second name) #'continue))
,@body))
@@ -104,252 +100,237 @@
(:dispatch-macro-char #\# #\( #'read-sharp-paren))
-(deftest cruft.1
- (function= (get-macro-character #\" (copy-readtable nil))
- (get-macro-character #\" (copy-readtable nil)))
- t)
-
-(deftest cruft.2
- (dispatch-macro-char-p #\# (find-readtable :standard))
- t)
-
-(deftest cruft.3
- (dispatch-macro-char-p #\# (make-readtable))
- nil)
-
-(deftest cruft.4
- (let ((rt (copy-named-readtable :standard)))
- (ensure-dispatch-macro-character #\# t rt)
- (dispatch-macro-char-p #\# rt))
- t)
-
-(deftest cruft.5
- (let ((rt (make-readtable)))
- (values
- (dispatch-macro-char-p #\$ rt)
- (ensure-dispatch-macro-character #\$ t rt)
- (dispatch-macro-char-p #\$ rt)))
- nil t t)
-
-(deftest cruft.6
- (let ((rt (make-readtable))
- (fn (constantly nil)))
- (ensure-dispatch-macro-character #\$ t rt)
- (set-dispatch-macro-character #\$ #\# fn rt)
- (values
- (eq fn (get-dispatch-macro-character #\$ #\# rt))
- (length=1 (readtable-content rt))))
- t t)
-
-(deftest cruft.7
- (let ((rt (make-readtable))
- (fn (constantly nil)))
- (set-macro-character #\$ fn t rt)
- (values
- (eq fn (get-macro-character #\$ rt))
- (length=1 (readtable-content rt))))
- t t)
-
-
-(deftest standard.1
- (read-with-readtable :standard "ABC")
- ABC)
-
-(deftest standard.2
- (read-with-readtable :standard "(A B C)")
- (A B C))
-
-(deftest standard.3
- (let ((x (find-readtable nil))
- (y (find-readtable :standard))
- (z (find-readtable :common-lisp)))
- (and (eq x y) (eq y z)))
- t)
-
-
-(deftest modern.1
- (read-with-readtable :modern "FooF")
- |FooF|)
-
-
-(deftest empty.1
- (null (readtable-content (make-readtable)))
- t)
-
-(deftest empty.2
- (readtable= (merge-readtables-into (make-readtable) :standard)
- (find-readtable :standard))
- t)
-
-(deftest empty.3
- (let ((rt (copy-named-readtable :standard)))
- (readtable= (merge-readtables-into (make-readtable) rt)
- (merge-readtables-into rt (make-readtable))))
- t)
-
-
-(deftest basics.1
- (read-with-readtable 'A "A")
- :a)
+(deftest cruft.1 ()
+ (is (function= (get-macro-character #\" (copy-readtable nil))
+ (get-macro-character #\" (copy-readtable nil)))))
-(deftest basics.2
- (read-with-readtable 'A-as-X "A")
- :x)
+(deftest cruft.2 ()
+ (is (dispatch-macro-char-p #\# (find-readtable :standard))))
-(deftest basics.3
- (read-with-readtable 'A "B")
- B)
+(deftest cruft.3 ()
+ (is (not (dispatch-macro-char-p #\# (make-readtable)))))
-(deftest basics.4
- (read-with-readtable 'A "(A B C)")
- |(|)
+(deftest cruft.4 ()
+ (let ((rt (copy-named-readtable :standard)))
+ (ensure-dispatch-macro-character #\# t rt)
+ (is (dispatch-macro-char-p #\# rt))))
+(deftest cruft.5 ()
+ (let ((rt (make-readtable)))
+ (is (not (dispatch-macro-char-p #\$ rt)))
+ (is (ensure-dispatch-macro-character #\$ t rt))
+ (is (dispatch-macro-char-p #\$ rt))))
-(deftest unregister.1
- (let ((rt (find-readtable 'A)))
- (register-readtable 'does-not-exist rt)
- (values
- (and (find-readtable 'does-not-exist) t)
- (unregister-readtable 'does-not-exist)
- (and (find-readtable 'does-not-exist) t)))
- t t nil)
+(deftest cruft.6 ()
+ (let ((rt (make-readtable))
+ (fn (constantly nil)))
+ (ensure-dispatch-macro-character #\$ t rt)
+ (set-dispatch-macro-character #\$ #\# fn rt)
+ (is (eq fn (get-dispatch-macro-character #\$ #\# rt)))
+ (is (length=1 (readtable-content rt)))))
+(deftest cruft.7 ()
+ (let ((rt (make-readtable))
+ (fn (constantly nil)))
+ (set-macro-character #\$ fn t rt)
+ (is (eq fn (get-macro-character #\$ rt)))
+ (is (length=1 (readtable-content rt)))))
-(deftest name.1
- (let ((rt (random-named-readtable)))
- (eq rt (find-readtable (readtable-name rt))))
- t)
-(deftest ensure.1
- (unwind-protect
- (let* ((x (ensure-readtable 'does-not-exist (find-readtable 'A)))
- (y (find-readtable 'A))
- (z (find-readtable 'does-not-exist)))
- (and (eq x y) (eq y z)))
- (unregister-readtable 'does-not-exist))
- t)
+(deftest standard.1 ()
+ (is (eq (read-with-readtable :standard "ABC") 'abc)))
+(deftest standard.2 ()
+ (is (equal (read-with-readtable :standard "(A B C)") '(a b c))))
-(deftest merge.1
- (values
- (read-with-readtable 'A+B+C "A")
- (read-with-readtable 'A+B+C "B")
- (read-with-readtable 'A+B+C "C"))
- :a :b :c)
+(deftest standard.3 ()
+ (let ((x (find-readtable nil))
+ (y (find-readtable :standard))
+ (z (find-readtable :common-lisp)))
+ (is (eq x y))
+ (is (eq y z))))
-(deftest merge.2
- (read-with-readtable 'standard+A+B+C "(A B C)")
- (:a :b :c))
-(deftest merge.3
- (read-with-readtable 'standard+A+B+C "#(A B C)")
- #(:a :b :c))
+(deftest modern.1 ()
+ (is (eq (read-with-readtable :modern "FooF") '|FooF|)))
-(deftest merge.4
- (let ((A+B+C+standard (merge-readtables-into (copy-named-readtable 'A+B+C)
- :standard)))
- (readtable= 'standard+A+B+C A+B+C+standard))
- t)
+(deftest empty.1 ()
+ (is (null (readtable-content (make-readtable)))))
-(deftest rename.1
- (unwind-protect
- (progn (make-readtable 'A* :merge '(A))
- (rename-readtable 'A* 'A**)
- (values (and (find-readtable 'A*) t)
- (and (find-readtable 'A**) t)))
- (unregister-readtable 'A*)
- (unregister-readtable 'A**))
- nil
- t)
-
-
-(deftest reader-macro-conflict.1
- (signals-condition-p 'reader-macro-conflict
- (merge-readtables-into (make-readtable) 'A 'A-as-X))
- t)
-
-(deftest reader-macro-conflict.2
- (signals-condition-p 'reader-macro-conflict
- (merge-readtables-into (make-readtable) :standard :standard))
- nil)
-
-(deftest reader-macro-conflict.3
- (signals-condition-p 'reader-macro-conflict
- (merge-readtables-into (make-readtable) 'A+B+C 'A))
- nil)
-
-(deftest reader-macro-conflict.4
- (signals-condition-p 'reader-macro-conflict
- (merge-readtables-into (make-readtable) :standard 'sharp-paren))
- t)
-
-(deftest reader-macro-conflict.5
- (signals-condition-p 'reader-macro-conflict
- (merge-readtables-into (make-readtable) 'A 'A-dispatch))
- t)
-
-(deftest reader-macro-conflict.6
- (signals-condition-p 'reader-macro-conflict
- (merge-readtables-into (make-readtable) 'A-dispatch 'A))
- t)
-
-(deftest reader-macro-conflict.7
- (signals-condition-p 'reader-macro-conflict
- (merge-readtables-into (make-readtable) 'A-dispatch 'A-dispatch-as-X))
- t)
-
-(deftest reader-macro-conflict.8
- (signals-condition-p 'reader-macro-conflict
- (merge-readtables-into (make-readtable) 'A 'A))
- nil)
-
-(deftest reader-macro-conflict.9
- (signals-condition-p 'reader-macro-conflict
- (merge-readtables-into (make-readtable) 'A-dispatch 'A-dispatch))
- nil)
-
-
-(deftest readtable-does-not-exist.1
- (signals-condition-p 'readtable-does-not-exist
- (ensure-readtable 'does-not-exist))
- t)
-
-
-(deftest readtable-does-already-exist.1
- (signals-condition-p 'readtable-does-already-exist
- (make-readtable 'A))
- t)
-
-(deftest readtable-does-already-exist.2
- (signals-condition-p 'readtable-does-already-exist
- (make-readtable 'A))
- t)
-
-(deftest readtable-does-already-exist.3
- (let ((rt (make-readtable 'does-not-exist :merge '(:standard A B))))
- (declare (ignore rt))
- (unwind-protect
- (read-with-readtable (continue-condition 'readtable-does-already-exist
- (make-readtable 'does-not-exist
- :merge '(:standard A C)))
-
- "(A B C)")
- (unregister-readtable 'does-not-exist)))
- (:a B :c))
-
-
-(deftest defreadtable.1
- (unwind-protect
- (signals-condition-p 'reader-macro-conflict
- (eval `(defreadtable does-not-exist (:merge A A-as-X))))
- (unregister-readtable 'does-not-exist))
- t)
+(deftest empty.2 ()
+ (is (readtable= (merge-readtables-into (make-readtable) :standard)
+ (find-readtable :standard))))
-(deftest defreadtable.2
- (unwind-protect
- (signals-condition-p 't
- (eval `(defreadtable does-not-exist (:fuse A A-as-X))))
- (unregister-readtable 'does-not-exist))
- nil)
+(deftest empty.3 ()
+ (let ((rt (copy-named-readtable :standard)))
+ (is (readtable= (merge-readtables-into (make-readtable) rt)
+ (merge-readtables-into rt (make-readtable))))))
+
+
+(deftest basics.1 ()
+ (is (eq (read-with-readtable 'A "A") :a)))
+
+(deftest basics.2 ()
+ (is (eq (read-with-readtable 'A-as-X "A") :x)))
+
+(deftest basics.3 ()
+ (is (eq (read-with-readtable 'A "B") 'b)))
+
+(deftest basics.4 ()
+ (is (eq (read-with-readtable 'A "(A B C)") '|(|)))
+
+
+(deftest unregister.1 ()
+ (let ((rt (find-readtable 'A)))
+ (register-readtable 'does-not-exist rt)
+ (is (find-readtable 'does-not-exist))
+ (is (unregister-readtable 'does-not-exist))
+ (is (not (find-readtable 'does-not-exist)))))
+
+
+(deftest name.1 ()
+ (let ((rt (random-named-readtable)))
+ (is (eq rt (find-readtable (readtable-name rt))))))
+
+(deftest ensure.1 ()
+ (unwind-protect
+ (let* ((x (ensure-readtable 'does-not-exist (find-readtable 'A)))
+ (y (find-readtable 'A))
+ (z (find-readtable 'does-not-exist)))
+ (is (eq x y))
+ (is (eq y z)))
+ (unregister-readtable 'does-not-exist)))
+
+
+(deftest merge.1 ()
+ (is (eq (read-with-readtable 'A+B+C "A") :a))
+ (is (eq (read-with-readtable 'A+B+C "B") :b))
+ (is (eq (read-with-readtable 'A+B+C "C") :c)))
+
+(deftest merge.2 ()
+ (is (equal (read-with-readtable 'standard+A+B+C "(A B C)") '(:a :b :c))))
+(deftest merge.3 ()
+ (is (equalp (read-with-readtable 'standard+A+B+C "#(A B C)") #(:a :b :c))))
+
+(deftest merge.4 ()
+ (let ((A+B+C+standard (merge-readtables-into (copy-named-readtable 'A+B+C)
+ :standard)))
+ (is (readtable= 'standard+A+B+C A+B+C+standard))))
+
+
+(deftest rename.1 ()
+ (unwind-protect
+ (progn (make-readtable 'A* :merge '(A))
+ (rename-readtable 'A* 'A**)
+ (is (not (and (find-readtable 'A*) t)))
+ (is (find-readtable 'A**)))
+ (unregister-readtable 'A*)
+ (unregister-readtable 'A**)))
+
+
+(deftest reader-macro-conflict.1 ()
+ (signals (reader-macro-conflict)
+ (merge-readtables-into (make-readtable) 'A 'A-as-X)))
+
+(deftest reader-macro-conflict.2 ()
+ (signals-not (reader-macro-conflict)
+ (merge-readtables-into (make-readtable) :standard :standard)))
+
+(deftest reader-macro-conflict.3 ()
+ (signals-not (reader-macro-conflict)
+ (merge-readtables-into (make-readtable) 'A+B+C 'A)))
+
+(deftest reader-macro-conflict.4 ()
+ (signals (reader-macro-conflict)
+ (merge-readtables-into (make-readtable) :standard 'sharp-paren)))
+
+(deftest reader-macro-conflict.5 ()
+ (signals (reader-macro-conflict)
+ (merge-readtables-into (make-readtable) 'A 'A-dispatch)))
+
+(deftest reader-macro-conflict.6 ()
+ (signals (reader-macro-conflict)
+ (merge-readtables-into (make-readtable) 'A-dispatch 'A)))
+
+(deftest reader-macro-conflict.7 ()
+ (signals (reader-macro-conflict)
+ (merge-readtables-into (make-readtable) 'A-dispatch 'A-dispatch-as-X)))
+
+(deftest reader-macro-conflict.8 ()
+ (signals-not (reader-macro-conflict)
+ (merge-readtables-into (make-readtable) 'A 'A)))
+
+(deftest reader-macro-conflict.9 ()
+ (signals-not (reader-macro-conflict)
+ (merge-readtables-into (make-readtable) 'A-dispatch 'A-dispatch)))
+
+
+(deftest readtable-does-not-exist.1 ()
+ (signals (readtable-does-not-exist)
+ (ensure-readtable 'does-not-exist)))
+
+
+(deftest readtable-does-already-exist.1 ()
+ (signals (readtable-does-already-exist)
+ (make-readtable 'A)))
+
+(deftest readtable-does-already-exist.2 ()
+ (signals (readtable-does-already-exist)
+ (make-readtable 'A)))
+
+(deftest readtable-does-already-exist.3 ()
+ (let ((rt (make-readtable 'does-not-exist :merge '(:standard A B))))
+ (declare (ignore rt))
+ (unwind-protect
+ (is (equal (read-with-readtable
+ (continue-condition 'readtable-does-already-exist
+ (make-readtable 'does-not-exist
+ :merge '(:standard A C)))
+ "(A B C)")
+ '(:a b :c)))
+ (unregister-readtable 'does-not-exist))))
+
+(deftest defreadtable.1 ()
+ (unwind-protect
+ (signals (reader-macro-conflict)
+ (eval `(defreadtable does-not-exist
+ (:merge A A-as-X))))
+ (unregister-readtable 'does-not-exist)))
+
+(deftest defreadtable.2 ()
+ (unwind-protect
+ (signals-not (t)
+ (eval `(defreadtable does-not-exist
+ (:fuse A A-as-X))))
+ (unregister-readtable 'does-not-exist)))
+
+(deftest readtable-documentation ()
+ (unwind-protect
+ (let ((readtable (eval '(defreadtable does-not-exist
+ "docstring"))))
+ (is (equal (documentation 'does-not-exist 'readtable) "docstring"))
+ (is (equal (documentation readtable 'readtable) "docstring"))
+ (setf (documentation 'does-not-exist 'readtable) "docstring2")
+ (is (equal (documentation 'does-not-exist 'readtable) "docstring2"))
+ (setf (documentation readtable 'readtable) "docstring3")
+ (is (equal (documentation 'does-not-exist 'readtable) "docstring3"))
+ (rename-readtable 'does-not-exist 'new-name)
+ (is (null (documentation 'does-not-exist 'readtable)))
+ (is (equal (documentation 'new-name 'readtable) "docstring3")))
+ (unregister-readtable 'does-not-exist)
+ (unregister-readtable 'new-name)))
+
+(defun test (&key (debug nil) (print 'unexpected) (describe 'unexpected))
+ ;; Bind *PACKAGE* so that names of tests printed have package names,
+ ;; and M-. works on them in Slime.
+ (let ((*package* (find-package :common-lisp))
+ (*print-duration* nil)
+ (*print-compactly* nil)
+ (*defer-describe* nil))
+ (print (try (find-package :named-readtables-test)
+ :debug debug :print print :describe describe))))
+
+#+nil
+(test)