Author: hhubner
Date: 2007-10-04 16:57:29 -0400 (Thu, 04 Oct 2007)
New Revision: 2209
Added:
branches/trunk-reorg/bknr/datastore/xml/
Log:
copy needed directory
Copied: branches/trunk-reorg/bknr/datastore/xml (from rev 2208, branches/bos/bknr/src/xml)
1
0
Author: hhubner
Date: 2007-10-04 16:57:05 -0400 (Thu, 04 Oct 2007)
New Revision: 2208
Added:
branches/trunk-reorg/bknr/datastore/src/bknr-xml.asd
Log:
copy needed file
Copied: branches/trunk-reorg/bknr/datastore/src/bknr-xml.asd (from rev 2207, branches/bos/bknr/src/bknr-xml.asd)
1
0
Author: hhubner
Date: 2007-10-04 15:56:01 -0400 (Thu, 04 Oct 2007)
New Revision: 2207
Added:
branches/trunk-reorg/thirdparty/closer-mop/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/checkpoints/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/allegro/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/allegro/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/allegro/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/clisp/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/clisp/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/clisp/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/closer-mop-utility-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/closer-mop.asd
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/ecl/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/ecl/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/ecl/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/features.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/features.txt
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/lispworks/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/lispworks/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/lispworks/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/mcl/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/mcl/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/mcl/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/pcl/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/pcl/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/pcl/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/release-notes.txt
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/supported-cls.txt
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/test/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/test/jeffs-code.lisp
branches/trunk-reorg/thirdparty/closer-mop/_darcs/inventories/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/inventories/20070421193107-dccf3-e9d51ab58efdffe18510bddafbfa450f276c224f.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/inventory
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050802151239-dccf3-e268d42f1d0bfb9c7ef64135393a2f63b243ed54.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050816144718-dccf3-c8e542ff6d11161f8c50c8595710590711c6732b.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050816231151-dccf3-e3829cce37824704fb39f3cafdc3c6a92f2d3cf3.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050904001359-dccf3-914880d9d7054a58ddf886f661065a9352df6e08.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050910092744-dccf3-87b02abfabbf534e03e82a45a96521a1d7c7a3b2.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050910103331-dccf3-6311e556632ec0e01cc952b75171e77536716c0c.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050910110130-dccf3-c6296b87c9e0e39bf7e938444dbd278fbba606c3.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051029013651-dccf3-b4be9c6147a26c1e9767e9951f49aee2c898655b.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051029115614-dccf3-65351c2ca451aceaa696ac89c9c8223199afae00.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051029224040-dccf3-98657977f7a5a7dc1dce7fc2b536413116b1e9cb.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051103084956-dccf3-bc5ad826d6d0c656f1e9f7af023c238ad5a5fade.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051105150436-dccf3-42c062a8ce5e51a74d47911cbf0aed17761f25d3.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051117200922-dccf3-2a2e5386869e5788124740a6796aa8d93fe88a07.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051117201142-dccf3-2700459573f278c02078ef40150f7d92fcb4ed5a.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051117201252-dccf3-5469d4a6ff03e37238daa28708a8727f2f88fdd9.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051130202445-dccf3-d3d97662bf9052129efdf34c4af8cb75d437eb27.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051205134118-dccf3-8045f8a6023f1067bf862213cd46cd07363ce091.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051216174627-3cc5d-3c778eca546a1cdb364885cd436fc275f71cb71e.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051220162014-dccf3-5541c25791f62d836e27802984f53014e2cfc72e.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051228150237-dccf3-fc2c4ab8e8c0798d200109ffc20b79259c28258c.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060103112938-dccf3-2f91b0e195aba3b348283c9c21f36d356db9d32b.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060119133808-dccf3-905164dbf83a727c6875e534c8afc7712adde1e2.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060119133914-dccf3-df1b6582ea4210cf1a697b8c75238342e465d444.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060119202553-dccf3-9e87c4d4d342a8a7fe01167b143ed5e67a08fa8c.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127142634-dccf3-0cbc9730e904db90c5598f37d28ed2a5d01e8060.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127142903-dccf3-114489c1437896299eba5cb5e1abcdcee3588f4d.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127142950-dccf3-a9161a505f3d6fc1376d2e9d065da70c59ec99e2.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127214635-dccf3-a6d51c1d634b093f9403635cb3ec6230bba703b1.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000120-dccf3-b4333796ffe0fe6f5c99603b29cc995508b8dcae.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000253-dccf3-6886af50a43d5a624a196f587acf8ef183c6946d.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000433-dccf3-825ddee7bae9c308010ec376b13fe5d4038687d5.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000511-dccf3-b67c903a0922806dde28834fef9548e1a19450df.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060203120853-dccf3-d772fe3f3f39f4c7114b18ba7dd1ce5c4eaf1896.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060211193158-dccf3-4534d4b849a303f855c692e41232ca1db1c18614.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060216145216-3cc5d-508513582f98be0b13ac28491b590ae926133b98.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060224212121-dccf3-4e71a819e03eb87e7e41b8bbb88758857ff26099.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060224212657-dccf3-068ab07c914a910ead2cf314711aec15c95b3f47.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060301115916-dccf3-319e857c38bf42decd2c98fc3df4208011590dd2.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060301200956-dccf3-d0315e6cf06746cfa4d2f9aae97af7ff6b95f979.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060302093912-dccf3-77419535e33067767884542db7d015cfccb3ac61.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060325171005-dccf3-c26bf0552b60f9e02107614b0fd23b84650b82c6.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060327120633-dccf3-c7f73a665f3f8fcd0d666ae7a08eaa1d586e6be5.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060427163929-dccf3-7c2b0e9aa58e3f5a27375162e099f2c8451137ca.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060501082945-dccf3-f330509c7bf886ad34c63a9fa7386a0a458b34ac.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060529180600-dccf3-62cfd9621e1802d45cd4459d96f367f7a10b5ca1.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060531202150-dccf3-686d5ba89231851614891f21e29033003105888d.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060531203220-dccf3-32e3cf5199ceaf2d34b7b9ed3732e923b6a6de53.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060629175352-dccf3-2a287976284aa6a523d7918f4747cf593174ebe7.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060711121904-dccf3-e427b977f9fa61ac7615b3f9266b3c09f6ab394c.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060720085220-dccf3-8733e01e9790f1929009378878359e13931ff231.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060720105100-dccf3-7d147f9c086e13bd2b83e670953ac124ec7dcb27.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060720105302-dccf3-70b8a60a40352e9ffa430467b36b41d9e785561b.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060721125623-dccf3-c9a6e3c8ab13d7545401922436152ef6039f35b8.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729125750-dccf3-677f12862b02fb3e369b3855c7a82fc9c9f07e28.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729134152-dccf3-ee40ebb2ef710ff23053b2765dfd8f5e5adeeb5b.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729134711-dccf3-dbcf08303fe3f2e8ad195382c90e88cb5fa0fda7.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729134940-dccf3-c4c1848e22a3d8293090441fd1a1b39670067107.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729135119-dccf3-62cbac84437b668d5c7b4222d3ffcd9b743a2067.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729135149-dccf3-615006dc944f3c9c6e15b57467e597f67a40ad77.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729135435-dccf3-a6554658258dcdada3b08ad08e6dd17657c7c974.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060802122101-dccf3-c0ae6510f6436c0fb88bb5ff92a25c9ae529ad17.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060821203834-dccf3-d6305a3e3412ff99beace007948dafc3100e1d6e.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826084425-dccf3-1cb35238f9645cd1d5d4e477a9234fc583e0dc6f.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826103957-dccf3-4bfdc272ae29918f08b54d0bdc14fed29b443814.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826124935-dccf3-2a4546691b80a18783c5421d46ac3d72a2c252fb.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826130127-dccf3-eec66c0522b0ab74d72bfdd61250f0ffaae584c6.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060927161258-dccf3-649ad24438070167a2f0100bb9b8f62601147f6d.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061001221204-dccf3-56ed441636d15f7f23de7b76b6be8222fb9b67f8.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061010173021-dccf3-159ee4ddbabc437a75ebf561e3301e92327dadf2.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061010174147-dccf3-d08093855647506dfbfe1c8263a3555f7a08541a.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061013081525-dccf3-fe4c6c81952c166149c00b1fe0df0834743ea370.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061014113836-dccf3-f117c253f5ab3d478f32c411f076a5b9d90f28be.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061028113627-dccf3-5f62832804d6c3dc544bd00341a7551fce46af78.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061031090315-dccf3-42d2030266347debf49e4bf88a13abdcffb4eac1.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061116132730-dccf3-e92c87581e04f60c7a029bbe6d7cdd6958319ff7.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061130202814-dccf3-3120d1936aca4182a1f8fd2e9076e84e1404d7d5.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061130203424-dccf3-74301ed5df59c70046119acac59c5ceef0c00ecf.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061218222443-dccf3-edde41dbcc6152e160bfc02201985e577adc11b0.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061218222546-dccf3-81a4963703b080a4230de18285fcc7f4f8f076a8.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061227142245-dccf3-9eee2aa05227bdf4f4eeaf45e58c845a4707ffff.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228002510-dccf3-163cba8d0d6e4c7548bcac17463887b52d482b11.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228002726-dccf3-2abe813153b4868c6219d045cba84119bbe37b62.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228002856-dccf3-af055d64a95a072906b14cf1713d04f171fae53d.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228003007-dccf3-19d3d52b67d6752806ade229cc573df39fefd736.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228151904-dccf3-ef3232d3763a7a5fcfd18bd92b289590e8dfbb77.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228151916-dccf3-82758310329d2019305d44c787c6ff559720c202.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228161029-dccf3-89435e9661c27dc9251269f3e035574cce8ccc6b.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228161128-dccf3-0adc1e659006165544e9d15583841f321aca1b4e.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127192325-dccf3-d77060b4d6264e601b0a0456c59bc0f9b6b39d42.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127192925-dccf3-0f0f5a0c26d9089334b2f54ae13cea2ddc4cd881.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127195002-dccf3-314892775fb8ae67ee688777168326daba80b565.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127201814-dccf3-128f7776110f2b6673a72a9e5c97d3a090cd028f.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070206104737-dccf3-e8605c338153ef4cfca23e2691bdbd8220ed9c17.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070228193530-dccf3-b0fe50e904a9f06b680ab19c79d5e375c45bb4e1.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070327202949-dccf3-77b1abaa2cd6661419f04d3c1422ee0e4970e2d5.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070421192516-dccf3-13d712262e80609ffa3e44656a11ddf1eb8c5ba2.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070421193020-dccf3-46cccd00d206b252681348edde6d08b9f8c12744.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070421193107-dccf3-e9d51ab58efdffe18510bddafbfa450f276c224f.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070501115057-dccf3-fd3901cf565e463eddafaf82e6f526d9403f5f29.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070528145132-dccf3-e1d978c1cd424af7cfabb1d036d07a10a7a4ed62.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070628201619-dccf3-6697990e3daa875937fba6209b49f9700ce5f98f.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070831233438-dccf3-551d9afcedf44d0735b330c50be407619f4cb8e0.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070916181018-dccf3-e11c738d92d8e1b2dbc979a10f258a647e164022.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070926164316-dccf3-0399c8966f70466f0bb3f1abd28f14b7698f542f.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070926172622-dccf3-0c2318248afb60197e6986c33794e0f97e43cfa2.gz
branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/
branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/binaries
branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/boring
branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/defaultrepo
branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/motd
branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/repos
branches/trunk-reorg/thirdparty/closer-mop/allegro/
branches/trunk-reorg/thirdparty/closer-mop/allegro/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/allegro/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/clisp/
branches/trunk-reorg/thirdparty/closer-mop/clisp/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/clisp/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/closer-mop-utility-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/closer-mop.asd
branches/trunk-reorg/thirdparty/closer-mop/ecl/
branches/trunk-reorg/thirdparty/closer-mop/ecl/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/ecl/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/features.lisp
branches/trunk-reorg/thirdparty/closer-mop/features.txt
branches/trunk-reorg/thirdparty/closer-mop/lispworks/
branches/trunk-reorg/thirdparty/closer-mop/lispworks/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/lispworks/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/mcl/
branches/trunk-reorg/thirdparty/closer-mop/mcl/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/mcl/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/pcl/
branches/trunk-reorg/thirdparty/closer-mop/pcl/closer-mop-packages.lisp
branches/trunk-reorg/thirdparty/closer-mop/pcl/closer-mop.lisp
branches/trunk-reorg/thirdparty/closer-mop/release-notes.txt
branches/trunk-reorg/thirdparty/closer-mop/supported-cls.txt
branches/trunk-reorg/thirdparty/closer-mop/test/
branches/trunk-reorg/thirdparty/closer-mop/test/jeffs-code.lisp
branches/trunk-reorg/thirdparty/lw-compat/
branches/trunk-reorg/thirdparty/lw-compat/_darcs/
branches/trunk-reorg/thirdparty/lw-compat/_darcs/checkpoints/
branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/
branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat-package.lisp
branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat.asd
branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat.lisp
branches/trunk-reorg/thirdparty/lw-compat/_darcs/inventories/
branches/trunk-reorg/thirdparty/lw-compat/_darcs/inventories/20060826123920-dccf3-4b37fa484f969eb9c3837a020e32b42e33f4cef6.gz
branches/trunk-reorg/thirdparty/lw-compat/_darcs/inventory
branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/
branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20050802152818-dccf3-9ba8553d2b62c698e6208680ab099ea6273a7458.gz
branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20050811150118-dccf3-9db8fc99fbfbac77dda86fa3ca80f0f92c0f054b.gz
branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20051228220551-dccf3-bec704780b86cf94b4f443e53d52d8e46f8ab139.gz
branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060821203626-dccf3-a75c8e2b513b571a43ce6c5e8dd377b2bca40887.gz
branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060826123920-dccf3-4b37fa484f969eb9c3837a020e32b42e33f4cef6.gz
branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060826125726-dccf3-b9ca9d92f93eefe4744f2275eaf40b6702e5b743.gz
branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060918174843-dccf3-641503d97f1447c7cf67b79d9d0e557fe35e4dfa.gz
branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/
branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/binaries
branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/boring
branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/defaultrepo
branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/motd
branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/repos
branches/trunk-reorg/thirdparty/lw-compat/lw-compat-package.lisp
branches/trunk-reorg/thirdparty/lw-compat/lw-compat.asd
branches/trunk-reorg/thirdparty/lw-compat/lw-compat.lisp
Log:
adding new libs
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/allegro/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/allegro/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/allegro/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,190 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ (:shadow
+ #:defclass #:defgeneric #:ensure-generic-function
+ #:standard-class #:standard-generic-function)
+ (:export
+ #:defclass #:defgeneric #:ensure-generic-function
+ #:standard-class #:standard-generic-function)
+
+ (:import-from #:mop
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-allegro #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-allegro #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/allegro/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/allegro/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/allegro/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,197 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+;; We need a new standard-class for various things.
+
+(cl:defclass standard-class (cl:standard-class)
+ ((valid-slot-allocations :initform '(:instance :class)
+ :accessor valid-slot-allocations
+ :reader excl::valid-slot-allocation-list)))
+
+;; validate-superclass for metaclass classes is a little bit
+;; more tricky than for class metaobject classes because
+;; we don't want to make all standard-classes compatible to
+;; each other.
+
+;; Our validate-superclass may get passed a class-prototype
+;; as its second argument, so don't expect its readers to
+;; yield useful information. (In ANSI parlance, "the
+;; consequences are undefined...")
+
+(cl:defmethod validate-superclass
+ ((class standard-class)
+ (superclass cl:standard-class))
+ (or (when (eq (class-of class) (find-class 'standard-class))
+ (or (eq (class-of superclass) (find-class 'cl:standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'cl:standard-class))
+ (validate-superclass class (class-prototype (find-class 'standard-class))))))
+
+;; The following macro ensures that the new standard-class is used by default.
+
+(defmacro defclass (name (&rest supers) &body options)
+ (if (member :metaclass options :key #'car)
+ `(cl:defclass ,name ,supers ,@options)
+ `(cl:defclass ,name ,supers ,@options
+ (:metaclass standard-class))))
+
+;; Allegro defines an extra check for :allocation kinds. AMOP expects any kind to be
+;; permissible, though. This is corrected here.
+
+(defmethod direct-slot-definition-class :before ((class standard-class) &key allocation &allow-other-keys)
+ (unless (eq (class-of class) (find-class 'standard-class))
+ (pushnew allocation (valid-slot-allocations class))))
+
+;;; In Allegro, slot-boundp-using-class and slot-makunbound-using-class are specialized
+;;; on slot names instead of effective slot definitions. In order to fix this,
+;;; we need to rewire the slot access protocol.
+
+#-(version>= 8 1)
+(progn
+ (cl:defmethod slot-boundp-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-boundp-using-class class object slotd)
+ (slot-missing class object slot 'slot-boundp))))
+
+ (cl:defmethod slot-boundp-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-boundp-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd))))
+
+(cl:defmethod slot-makunbound-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-makunbound-using-class class object slotd)
+ (slot-missing class object slot 'slot-makunbound))))
+
+(cl:defmethod slot-makunbound-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-makunbound-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd)))
+
+;; We need a new standard-generic-function for various things.
+
+(cl:defclass standard-generic-function (cl:standard-generic-function)
+ ()
+ (:metaclass clos:funcallable-standard-class))
+
+;; The following ensures that the new standard-generic-function is used.
+
+(defun ensure-generic-function
+ (name &rest args
+ &key (generic-function-class 'standard-generic-function)
+ &allow-other-keys)
+ (declare (dynamic-extent args))
+ (when (fboundp name)
+ (let ((function (fdefinition name)))
+ (unless (typep function 'generic-function)
+ (cerror "Discard existing definition and create generic function."
+ "~S is already fbound, but not as a generic function." name)
+ (fmakunbound name))))
+ (if (fboundp name)
+ (let ((function (fdefinition name)))
+ (apply #'ensure-generic-function-using-class
+ function name args))
+ (apply #'ensure-generic-function-using-class nil name
+ :generic-function-class generic-function-class
+ args)))
+
+;; The following macro ensures that the new standard-generic-function
+;; is used by default.
+
+(defmacro defgeneric (name (&rest args) &body options)
+ (if (member :generic-function-class options :key #'car)
+ `(cl:defgeneric ,name ,args ,@options)
+ `(cl:defgeneric ,name ,args ,@options
+ (:generic-function-class standard-generic-function))))
+
+;;; The following three methods ensure that the dependent protocol
+;;; for generic function works.
+
+;; The following method additionally ensures that
+;; compute-discriminating-function is triggered.
+
+(cl:defmethod reinitialize-instance :after
+ ((gf standard-generic-function) &rest initargs)
+ (declare (dynamic-extent initargs))
+ (set-funcallable-instance-function
+ gf (compute-discriminating-function gf))
+ (map-dependents
+ gf (lambda (dep) (apply #'update-dependent gf dep initargs))))
+
+(cl:defmethod add-method :after
+ ((gf standard-generic-function) method)
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'add-method method))))
+
+(cl:defmethod remove-method :after
+ ((gf standard-generic-function) method)
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'remove-method method))))
+
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (funcall (compile nil `(lambda ()
+ (defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ initargs)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/clisp/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/clisp/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/clisp/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,183 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ (:import-from #:clos
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-clisp #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-clisp #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/clisp/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/clisp/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/clisp/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,49 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly 't))))
+ (funcall (compile nil `(lambda ()
+ (defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ initargs)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/closer-mop-utility-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/closer-mop-utility-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/closer-mop-utility-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,18 @@
+(in-package :cl-user)
+
+(defpackage #:closer-common-lisp
+ (:nicknames #:c2cl)
+ (:use))
+
+(let ((syms (nunion (loop for sym being the external-symbols of :common-lisp
+ if (find-symbol (symbol-name sym) :c2mop)
+ collect it
+ else collect sym)
+ (loop for sym being the external-symbols of :c2mop
+ collect sym))))
+ (import syms :c2cl)
+ (export syms :c2cl))
+
+(defpackage #:closer-common-lisp-user
+ (:nicknames #:c2cl-user)
+ (:use #:closer-common-lisp))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/closer-mop.asd
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/closer-mop.asd 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/closer-mop.asd 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,47 @@
+(asdf:defsystem #:closer-mop
+ :name "Closer to MOP"
+ :author "Pascal Costanza"
+ :version "0.42"
+ :licence "
+Copyright (c) 2005 - 2007 Pascal Costanza
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the \"Software\"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or
+sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+"
+ :depends-on (#-lispworks #:lw-compat)
+ :components
+ ((:module
+ #+allegro "allegro"
+ #+clisp "clisp"
+ #+ecl "ecl"
+ #+lispworks "lispworks"
+ #+(or mcl openmcl) "mcl"
+ #+(or cmu sbcl) "pcl"
+ :components ((:file "closer-mop-packages")
+ (:file "closer-mop"
+ :depends-on ("closer-mop-packages"))))
+ (:file "closer-mop-utility-packages"
+ :depends-on (#+allegro "allegro"
+ #+clisp "clisp"
+ #+ecl "ecl"
+ #+lispworks "lispworks"
+ #+(or mcl openmcl) "mcl"
+ #+(or cmu sbcl) "pcl"))))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/ecl/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/ecl/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/ecl/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,190 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ (:shadow #:defgeneric #:ensure-generic-function #:find-method
+ #:remove-method #:standard-generic-function)
+ (:export #:defgeneric #:ensure-generic-function #:find-method
+ #:remove-method #:standard-generic-function)
+
+ (:import-from #:clos
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #-ecl #:eql-specializer
+ #:forward-referenced-class
+ #-ecl #:funcallable-standard-class
+ #-ecl #:funcallable-standard-object
+ #-ecl #:metaobject
+ #:slot-definition
+ #-ecl #:specializer
+ #-ecl #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #-ecl #:standard-reader-method
+ #:standard-slot-definition
+ #-ecl #:standard-writer-method
+
+ #-ecl #:accessor-method-slot-definition
+ #-ecl #:add-dependent
+ #-ecl #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-ecl #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #-ecl #:eql-specializer-object
+ #-ecl #:extract-lambda-list
+ #-ecl #:extract-specializer-names
+ #:finalize-inheritance
+ #-ecl #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #-ecl #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #-ecl #:intern-eql-specializer
+ #-ecl #:make-method-lambda
+ #-ecl #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #-ecl #:reader-method-class
+ #-ecl #:remove-dependent
+ #-ecl #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #-ecl #:specializer-direct-generic-functions
+ #-ecl #:specializer-direct-methods
+ #:standard-instance-access
+ #-ecl #:update-dependent
+ #-ecl #:validate-superclass
+ #-ecl #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #-ecl #:funcallable-standard-class
+ #-ecl #:funcallable-standard-object
+ #-ecl #:metaobject
+ #:slot-definition
+ #-ecl #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #-ecl #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-ecl #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:eql-specializer-object*
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #-ecl #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #-ecl #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #:intern-eql-specializer*
+ #-ecl #:make-method-lambda
+ #-ecl #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #-ecl #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #-ecl #:update-dependent
+ #-ecl #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/ecl/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/ecl/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/ecl/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,312 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+(defun extract-lambda-list (lambda-list)
+ (loop for (arg . rest) on lambda-list
+ until (member arg lambda-list-keywords)
+ if (consp arg)
+ collect (car arg) into args
+ else collect arg into args
+ finally (return (if arg
+ (nconc args (cons arg rest))
+ args))))
+
+(defun extract-specializer-names (lambda-list)
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ if (consp arg)
+ collect (cadr arg)
+ else collect 't))
+
+;; We need a new standard-generic-function for various things.
+
+(cl:defclass standard-generic-function (cl:standard-generic-function)
+ ())
+
+;; The following ensures that the new standard-generic-function is used.
+
+(defun ensure-generic-function
+ (name &rest args
+ &key (generic-function-class 'standard-generic-function)
+ &allow-other-keys)
+ (declare (dynamic-extent args))
+ (apply #'cl:ensure-generic-function name
+ :generic-function-class generic-function-class
+ args))
+
+#|
+(defun ensure-generic-function
+ (name &rest args
+ &key (generic-function-class 'standard-generic-function)
+ &allow-other-keys)
+ (declare (dynamic-extent args))
+ (when (fboundp name)
+ (let ((function (fdefinition name)))
+ (unless (typep function 'generic-function)
+ (cerror "Discard existing definition and create generic function."
+ "~S is already fbound, but not as a generic function." name)
+ (fmakunbound name))))
+ (if (fboundp name)
+ (let ((function (fdefinition name)))
+ (apply #'ensure-generic-function-using-class
+ function name args))
+ (apply #'ensure-generic-function-using-class nil name
+ :generic-function-class generic-function-class
+ args)))
+|#
+
+;; The standard accessor classes.
+
+(cl:defclass standard-accessor-method (standard-method)
+ ((slotd :initarg :slot-definition
+ :reader accessor-method-slot-definition)))
+
+(cl:defclass standard-reader-method (standard-accessor-method)
+ ())
+
+(cl:defclass standard-writer-method (standard-accessor-method)
+ ())
+
+;; In ECL, reader-method-class and writer-method-class are
+;; not used during class initialization. The following definitions
+;; correct this.
+
+(cl:defgeneric reader-method-class (class slot-definition &rest initargs)
+ (:method ((class class) slot-definition &rest initargs)
+ (declare (ignore slot-definition initargs))
+ (load-time-value (find-class 'standard-reader-method))))
+
+(cl:defgeneric writer-method-class (class slot-definition &rest initargs)
+ (:method ((class class) slot-definition &rest initargs)
+ (declare (ignore slot-definition initargs))
+ (load-time-value (find-class 'standard-writer-method))))
+
+(cl:defgeneric find-method (gf qualifiers specializers &optional errorp)
+ (:method ((gf generic-function) qualifiers specializers &optional (errorp t))
+ (cl:find-method gf qualifiers specializers errorp)))
+
+(defun modify-accessors (class)
+ (loop with reader-specializers = (list class)
+ with writer-specializers = (list (find-class 't) class)
+ for slotd in (class-direct-slots class) do
+ (loop for reader in (slot-definition-readers slotd)
+ for reader-function = (fdefinition reader)
+ for reader-method = (find-method reader-function () reader-specializers)
+ for initargs = (list :qualifiers ()
+ :lambda-list '(object)
+ :specializers reader-specializers
+ :function (method-function reader-method)
+ :slot-definition slotd)
+ for method-class = (apply #'reader-method-class class slotd initargs)
+ unless (eq method-class (class-of reader-method))
+ do (add-method reader-function (apply #'make-instance method-class initargs)))
+ (loop for writer in (slot-definition-writers slotd)
+ for writer-function = (fdefinition writer)
+ for writer-method = (find-method writer-function () writer-specializers)
+ for initargs = (list :qualifiers ()
+ :lambda-list '(new-value object)
+ :specializers writer-specializers
+ :function (method-function writer-method)
+ :slot-definition slotd)
+ for method-class = (apply #'writer-method-class class slotd initargs)
+ unless (eq method-class (class-of writer-method))
+ do (add-method writer-function (apply #'make-instance method-class initargs)))))
+
+;; During class re/initialization, we take care of the following things:
+;; - Optimization of slot accessors is deactivated.
+;; - Removal of direct subclasses.
+
+(cl:defmethod initialize-instance :around
+ ((class standard-class) &rest initargs)
+ (declare (dynamic-extent initargs))
+ (prog1 (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs)
+ (modify-accessors class)))
+
+(cl:defmethod reinitialize-instance :around
+ ((class standard-class) &rest initargs
+ &key (direct-superclasses () direct-superclasses-p))
+ (declare (dynamic-extent initargs))
+ (when direct-superclasses-p
+ (loop for superclass in (copy-list (class-direct-superclasses class))
+ unless (member superclass direct-superclasses)
+ do (remove-direct-subclass superclass class)))
+ (prog1 (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs)
+ (modify-accessors class)))
+
+;; In ECL, eql specializers are lists. We cannot change this
+;; but we can soften some of the incompatibilities.
+
+(defun eql-specializer-p (cons)
+ (and (consp cons)
+ (eq (car cons) 'eql)
+ (null (cddr cons))))
+
+(deftype eql-specializer ()
+ '(or eql-specializer*
+ (satisfies eql-specializer-p)))
+
+(cl:defgeneric eql-specializer-object (eql-specializer)
+ (:method ((cons cons))
+ (if (eql-specializer-p cons)
+ (cadr cons)
+ (error "~S is not an eql-specializer." cons))))
+
+(defun intern-eql-specializer (object)
+ `(eql ,object))
+
+(cl:defgeneric specializer-direct-methods (specializer))
+
+(cl:defclass eql-specializer* (standard-object)
+ ((obj :reader eql-specializer-object
+ :initarg eso
+ :initform (error "Use intern-eql-specializer to create eql-specializers."))
+ (direct-methods :reader specializer-direct-methods
+ :accessor es-direct-methods
+ :initform ())))
+
+(defvar *eql-specializers* (make-hash-table))
+
+(defun intern-eql-specializer* (object)
+ (or (gethash object *eql-specializers*)
+ (setf (gethash object *eql-specializers*)
+ (make-instance 'eql-specializer* 'eso object))))
+
+(defvar *direct-methods* (make-hash-table :test #'eq))
+
+(cl:defgeneric add-direct-method (specializer method)
+ (:method ((specializer class) (method method))
+ (pushnew method (gethash specializer *direct-methods*)))
+ (:method ((specializer eql-specializer*) (method method))
+ (pushnew method (es-direct-methods specializer))))
+
+(cl:defgeneric remove-direct-method (specializer method)
+ (:method ((specializer class) (method method))
+ (removef (gethash specializer *direct-methods*) method))
+ (:method ((specializer eql-specializer*) (method method))
+ (removef (es-direct-methods specializer) method)))
+
+(cl:defmethod specializer-direct-methods ((class class))
+ (gethash class *direct-methods*))
+
+(cl:defgeneric specializer-direct-generic-functions (specializer)
+ (:method ((class class))
+ (remove-duplicates
+ (mapcar #'method-generic-function
+ (specializer-direct-methods class))))
+ (:method ((eql-specializer eql-specializer*))
+ (remove-duplicates
+ (mapcar #'method-generic-function
+ (specializer-direct-methods eql-specializer))))
+ (:method ((cons cons))
+ (specializer-direct-generic-functions
+ (intern-eql-specializer*
+ (eql-specializer-object cons)))))
+
+;; The following method ensures that remove-method is called.
+
+(cl:defmethod add-method :before ((gf standard-generic-function) (method method))
+ (when-let (old-method (find-method gf (method-qualifiers method)
+ (method-specializers method) nil))
+ (remove-method gf old-method)))
+
+;; The following two methods ensure that add/remove-direct-method is called,
+;; and that the dependent protocol for generic function works.
+
+(cl:defmethod add-method :after ((gf standard-generic-function) (method method))
+ (loop for specializer in (method-specializers method)
+ do (add-direct-method
+ (if (consp specializer)
+ (intern-eql-specializer*
+ (eql-specializer-object specializer))
+ specializer)
+ method)))
+
+(cl:defgeneric remove-method (generic-function method)
+ (:method ((gf generic-function) (method method))
+ (cl:remove-method gf method)))
+
+(cl:defmethod remove-method :after ((gf generic-function) (method method))
+ (loop for specializer in (method-specializers method)
+ do (remove-direct-method
+ (if (consp specializer)
+ (intern-eql-specializer*
+ (eql-specializer-object specializer))
+ specializer)
+ method)))
+
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (funcall (compile nil `(lambda ()
+ (defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))))
+
+(defmacro defgeneric (&whole form name (&rest args) &body options)
+ (unless (every #'consp options)
+ (error "Illegal generic functions options in defgeneric form ~S." form))
+ `(cl:defgeneric ,name ,args
+ ,@options
+ ,@(unless (member :generic-function-class options :key #'car :test #'eq)
+ '((:generic-function-class standard-generic-function)))))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ (let* ((counts (loop with counts
+ for (key nil) on initargs by #'cddr
+ do (incf (getf counts key 0))
+ finally (return counts)))
+ (keys-to-fix (loop for (key value) on counts by #'cddr
+ if (> value 1) collect key)))
+ (if keys-to-fix
+ (let ((multiple-standard-keys
+ (intersection keys-to-fix *standard-slot-keys*)))
+ (if multiple-standard-keys
+ (error "Too many occurences of ~S in slot initargs ~S."
+ multiple-standard-keys initargs)
+ (loop with fixed-keys
+ for (key value) on initargs by #'cddr
+ if (member key keys-to-fix)
+ do (nconcf (getf fixed-keys key) (list value))
+ else nconc (list key value) into fixed-initargs
+ finally (return (nconc fixed-initargs fixed-keys)))))
+ initargs)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/features.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/features.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/features.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,498 @@
+
+:allegro7.0
+((:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:compute-default-initargs) ; -> :compute-default-initargs-allegro
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defgeneric-calls-find-method-combination)
+ (:defmethod-calls-make-method-lambda)
+ (:dependent-protocol-for-generic-functions fixed)
+ (:extensible-allocation fixed)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:multiple-qualifiers)
+ (:reinitialize-instance-calls-compute-discriminating-function fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-boundp-using-class-specialized-on-slot-definition fixed)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots)
+ (:t-is-always-a-valid-superclass))
+
+:allegro8.0
+((:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:compute-default-initargs) ; -> :compute-default-initargs-allegro
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defgeneric-calls-find-method-combination)
+ (:defmethod-calls-make-method-lambda)
+ (:dependent-protocol-for-generic-functions fixed)
+ (:extensible-allocation fixed)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-boundp-using-class-specialized-on-slot-definition fixed)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots)
+ (:t-is-always-a-valid-superclass))
+
+:allegro8.1
+((:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:compute-default-initargs) ; -> :compute-default-initargs-allegro
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defgeneric-calls-find-method-combination)
+ (:defmethod-calls-make-method-lambda)
+ (:dependent-protocol-for-generic-functions fixed)
+ (:extensible-allocation fixed)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots)
+ (:t-is-always-a-valid-superclass))
+
+:clisp2.35-2.36
+((:accessor-method-initialized-with-function)
+ (:add-method-calls-compute-discriminating-function)
+ (:compute-slots-requested-slot-order-honoured)
+ (:defmethod-calls-make-method-lambda)
+ (:extensible-allocation)
+ (:forward-referenced-class-changed-by-change-class)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-initialized-with-function)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:remove-method-calls-compute-discriminating-function)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots))
+
+:clisp2.37-2.39
+((:accessor-method-initialized-with-function)
+ (:add-method-calls-compute-discriminating-function)
+ (:compute-slots-requested-slot-order-honoured)
+ (:defmethod-calls-make-method-lambda)
+ (:forward-referenced-class-changed-by-change-class)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-initialized-with-function)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:remove-method-calls-compute-discriminating-function)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots))
+
+:clisp2.40-2.41
+((:accessor-method-initialized-with-function)
+ (:add-method-calls-compute-discriminating-function)
+ (:compute-slots-requested-slot-order-honoured)
+ (:defmethod-calls-make-method-lambda)
+ (:forward-referenced-class-changed-by-change-class)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-initialized-with-function)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:remove-method-calls-compute-discriminating-function)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots))
+
+:cmu19c-19d
+((:accessor-method-initialized-with-function fixed)
+ (:accessor-method-initialized-with-lambda-list fixed)
+ (:accessor-method-initialized-with-slot-definition fixed)
+ (:accessor-method-initialized-with-specializers fixed)
+ (:anonymous-classes fixed)
+ (:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:class-initialization-calls-reader-method-class fixed)
+ (:class-initialization-calls-writer-method-class fixed)
+ (:discriminating-functions-can-be-closures)
+ (:discriminating-functions-can-be-funcalled)
+ (:documentation-passed-to-effective-slot-definition-class)
+ (:effective-slot-definition-initialized-with-documentation)
+ (:method-initialized-with-function)
+ (:multiple-slot-options-passed-as-list-to-direct-slot-definition-class) ; fix with fix-slot-initargs
+ (:reinitialize-instance-calls-compute-discriminating-function fixed)
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-definition-documentation fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-class-do-not-inherit-exported-slots)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-eql-specializer-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-specializer-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:ecl0.9i
+((:accessor-method-initialized-with-function fixed)
+ (:accessor-method-initialized-with-lambda-list fixed)
+ (:accessor-method-initialized-with-slot-definition fixed)
+ (:accessor-method-initialized-with-specializers fixed)
+ (:accessor-method-slot-definition fixed)
+ (:add-direct-method fixed)
+ (:add-method-calls-add-direct-method fixed)
+ (:add-method-calls-compute-discriminating-function)
+ (:add-method-calls-remove-method fixed)
+ (:add-method-updates-specializer-direct-generic-functions fixed)
+ (:add-method-updates-specializer-direct-methods fixed)
+ (:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:class-initialization-calls-reader-method-class fixed)
+ (:class-initialization-calls-writer-method-class fixed)
+ (:class-reinitialization-calls-remove-direct-subclass fixed)
+ (:classes-are-always-their-own-valid-superclasses)
+ (:compute-applicable-methods-is-generic)
+ (:compute-applicable-methods-using-classes)
+ (:compute-effective-method-is-generic)
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:default-reader-methods-are-standard-reader-methods fixed)
+ (:default-writer-methods-are-standard-writer-methods fixed)
+ (:defgeneric-calls-find-method-combination)
+ (:defmethod-calls-generic-function-method-class)
+ (:defmethod-calls-initialize-instance)
+ (:defmethod-calls-make-method-lambda)
+ (:dependent-protocol-for-classes)
+ (:dependent-protocol-for-generic-functions)
+ (:direct-slot-definition-initialized-with-type)
+ (:discriminating-functions-can-be-closures)
+ (:discriminating-functions-can-be-funcalled)
+ (:eql-specializer)
+ (:eql-specializer-object fixed)
+ (:eql-specializers-are-objects)
+ (:extract-lambda-list fixed)
+ (:extract-specializer-names fixed)
+ (:find-method-combination)
+ (:find-method-is-generic fixed)
+ (:funcallable-standard-class)
+ (:funcallable-standard-object)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:generic-function-declarations)
+ (:generic-function-method-class-is-generic)
+ (:generic-function-method-combination)
+ (:generic-functions-can-be-empty)
+ (:initform-passed-to-direct-slot-definition-class)
+ (:initform-passed-to-effective-slot-definition-class)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:intern-eql-specializer fixed)
+ (:make-method-lambda)
+ (:metaobject)
+ (:method-functions-take-processed-parameters)
+ (:method-initialized-with-documentation)
+ (:method-initialized-with-function)
+ (:method-initialized-with-lambda-list)
+ (:method-initialized-with-qualifiers)
+ (:method-initialized-with-specializers)
+ (:method-lambdas-are-processed)
+ (:multiple-slot-options-passed-as-list-to-direct-slot-definition-class)
+ (:reader-method-class fixed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:remove-direct-method fixed)
+ (:remove-method-calls-compute-discriminating-function)
+ (:remove-method-calls-remove-direct-method fixed)
+ (:remove-method-is-generic fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-definition-documentation)
+ (:slot-definition-initform)
+ (:slot-definition-initfunction)
+ (:slot-definition-type)
+ (:slot-reader-calls-slot-value-using-class fixed)
+ (:slot-writer-calls-slot-value-using-class fixed)
+ (:specializer)
+ (:specializer-direct-generic-functions fixed)
+ (:specializer-direct-methods fixed)
+ (:standard-accessor-method fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:standard-reader-method fixed)
+ (:standard-writer-method fixed)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-class-do-not-inherit-exported-slots)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:t-is-always-a-valid-superclass)
+ (:type-passed-to-direct-slot-definition-class)
+ (:validate-superclass)
+ (:writer-method-class fixed))
+
+:lispworks4.4
+((:add-method-calls-add-direct-method fixed)
+ (:add-method-calls-compute-discriminating-function)
+ (:add-method-calls-remove-method fixed)
+ (:add-method-updates-specializer-direct-generic-functions fixed)
+ (:allocation-passed-to-effective-slot-definition-class) ; instead :flags-passed-to-effective-slot-definition-class
+ (:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:class-initialized-with-direct-default-initargs) ; instead: conditionalization
+ (:class-reinitialization-calls-remove-direct-subclass fixed)
+ (:compute-applicable-methods-using-classes)
+ (:compute-default-initargs)
+ (:defgeneric-calls-find-method-combination)
+ (:direct-superclasses-by-default-empty) ; not fixed, but direct superclasses are automatically adjusted
+ (:effective-slot-definition-initialized-with-allocation) ; instead :effective-slot-definition-initialized-with-flags
+ (:eql-specializer) ; partially fixed
+ (:eql-specializer-object fixed)
+ (:eql-specializers-are-objects)
+ (:extensible-allocation)
+ (:finalize-inheritance-calls-compute-default-initargs)
+ (:find-method-combination fixed) ; partially
+ (:funcallable-standard-instance-access)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:generic-function-initialized-with-declarations) ; map from generic-function-initialized-with-declare
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:intern-eql-specializer fixed) ; partially
+ (:make-method-lambda fixed) ; partially
+ (:method-functions-take-processed-parameters)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:remove-method-calls-compute-discriminating-function)
+ (:remove-method-calls-remove-direct-method fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:setf-slot-value-using-class-specialized-on-slot-definition fixed)
+ (:slot-boundp-using-class-specialized-on-slot-definition fixed)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:slot-reader-calls-slot-value-using-class fixed)
+ (:slot-value-using-class-specialized-on-slot-definition fixed)
+ (:slot-writer-calls-slot-value-using-class fixed)
+ (:specializer)
+ (:specializer-direct-generic-functions fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:standard-instance-access)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:lispworks5.0-5.0.2
+((:add-method-calls-compute-discriminating-function)
+ (:add-method-updates-specializer-direct-generic-functions fixed)
+ (:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:compute-applicable-methods-using-classes)
+ (:compute-default-initargs)
+ (:defgeneric-calls-find-method-combination)
+ (:eql-specializer) ; partially fixed
+ (:eql-specializer-object fixed)
+ (:eql-specializers-are-objects)
+ (:extensible-allocation)
+ (:finalize-inheritance-calls-compute-default-initargs)
+ (:find-method-combination fixed) ; partially
+ (:funcallable-standard-instance-access)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:intern-eql-specializer fixed) ; partially
+ (:make-method-lambda fixed) ; partially
+ (:method-functions-take-processed-parameters)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:remove-method-calls-compute-discriminating-function)
+ (:setf-slot-value-using-class-specialized-on-slot-definition fixed)
+ (:slot-boundp-using-class-specialized-on-slot-definition fixed)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:slot-reader-calls-slot-value-using-class fixed)
+ (:slot-value-using-class-specialized-on-slot-definition fixed)
+ (:slot-writer-calls-slot-value-using-class fixed)
+ (:specializer)
+ (:specializer-direct-generic-functions fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:standard-instance-access)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:mcl
+((:add-method-calls-compute-discriminating-function)
+ (:compute-applicable-methods-using-classes)
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defmethod-calls-generic-function-method-class)
+ (:defmethod-calls-make-method-lambda)
+ (:discriminating-functions-can-be-closures)
+ (:discriminating-functions-can-be-funcalled)
+ (:funcallable-standard-object)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:generic-function-declarations)
+ (:generic-function-initialized-with-declarations)
+ (:generic-functions-can-be-empty)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:reinitialize-lambda-list-reinitializes-argument-precedence-order)
+ (:remove-method-calls-compute-discriminating-function)
+ (:set-funcallable-instance-function)
+ (:setf-generic-function-name)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+; ---
+ (:compute-slots-requested-slot-order-honoured)
+ (:direct-slot-definition fixed)
+ (:direct-superclasses-by-default-empty) ; not fixed, but direct superclasses are automatically adjusted, not for funcallable-standard-class though
+ (:effective-slot-definition fixed)
+ (:eql-specializer fixed)
+ (:extensible-allocation)
+ (:multiple-slot-options-passed-as-list-to-direct-slot-definition-class) ; fix with fix-slot-initargs
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:slot-definition fixed)
+ (:standard-slot-definition fixed)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:openmcl
+((:add-method-calls-compute-discriminating-function)
+ (:compute-applicable-methods-using-classes)
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defmethod-calls-generic-function-method-class)
+ (:defmethod-calls-make-method-lambda)
+ (:discriminating-functions-can-be-closures)
+ (:discriminating-functions-can-be-funcalled)
+ (:funcallable-standard-object)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:generic-functions-can-be-empty)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:reinitialize-lambda-list-reinitializes-argument-precedence-order)
+ (:remove-method-calls-compute-discriminating-function)
+; ---
+ (:compute-slots-requested-slot-order-honoured)
+ (:eql-specializer fixed)
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:slot-definition-documentation fixed)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slot)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:sbcl 0.9.16-1.0.10
+#| all features implemented |#
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/features.txt
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/features.txt 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/features.txt 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,225 @@
+Features that don't adhere to AMOP in various CLOS MOP implementations, and whether and how they are resolved in Closer to MOP.
+
+Allegro Common Lisp 7.0
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- COMPUTE-DEFAULT-INITARGS takes more parameters than specified. Not fixed. Conditionalize on #+allegro for your own methods instead.
+- FUNCALLABLE-STANDARD-OBJECT is not used as the default superclass for classes with :metaclass FUNCALLABLE-STANDARD-CLASS.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- DEFMETHOD doesn't call MAKE-METHOD-LAMBDA. Not fixed.
+- The dependent protocol for generic functions doesn't work fully. Fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS, COMPUTE-APPLICABLE-METHODS-USING-CLASSES and COMPUTE-EFFECTIVE-METHOD. Not fixed.
+- The :ALLOCATION type cannot be extended. Fixed.
+- MAKE-METHOD-LAMBDA is not provided. Not fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- The defmethod form does not accept multiple qualifiers. Not fixed.
+- REINITIALIZE-INSTANCE doesn't determine a new discriminating function. Fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Not fixed.
+- SLOT-BOUNDP-USING-CLASS and SLOT-MAKUNBOUND-USING-CLASS are not specialized on slot definition metaobjects, but on symbols. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- VALIDATE-SUPERCLASS doesn't recognize T as a valid superclass. Not fixed.
+- Subclasses of BUILT-IN-CLASS, FORWARD-REFERENCED-CLASS, FUNCALLABLE-STANDARD-CLASS, METHOD-COMBINATION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+Allegro Common Lisp 8.0
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- COMPUTE-DEFAULT-INITARGS takes more parameters than specified. Not fixed. Conditionalize on #+allegro for your own methods instead.
+- FUNCALLABLE-STANDARD-OBJECT is not used as the default superclass for classes with :metaclass FUNCALLABLE-STANDARD-CLASS.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- DEFMETHOD doesn't call MAKE-METHOD-LAMBDA. Not fixed.
+- The dependent protocol for generic functions doesn't work fully. Fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS, COMPUTE-APPLICABLE-METHODS-USING-CLASSES and COMPUTE-EFFECTIVE-METHOD. Not fixed.
+- The :ALLOCATION type cannot be extended. Fixed.
+- MAKE-METHOD-LAMBDA is not provided. Not fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- REINITIALIZE-INSTANCE doesn't determine a new discriminating function. Fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Not fixed.
+- SLOT-BOUNDP-USING-CLASS and SLOT-MAKUNBOUND-USING-CLASS are not specialized on slot definition metaobjects, but on symbols. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- VALIDATE-SUPERCLASS doesn't recognize T as a valid superclass. Not fixed.
+- Subclasses of BUILT-IN-CLASS, FORWARD-REFERENCED-CLASS, FUNCALLABLE-STANDARD-CLASS, METHOD-COMBINATION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+Allegro Common Lisp 8.1
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- COMPUTE-DEFAULT-INITARGS takes more parameters than specified. Not fixed. Conditionalize on #+allegro for your own methods instead.
+- FUNCALLABLE-STANDARD-OBJECT is not used as the default superclass for classes with :metaclass FUNCALLABLE-STANDARD-CLASS.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- DEFMETHOD doesn't call MAKE-METHOD-LAMBDA. Not fixed.
+- The dependent protocol for generic functions doesn't work fully. Fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS, COMPUTE-APPLICABLE-METHODS-USING-CLASSES and COMPUTE-EFFECTIVE-METHOD. Not fixed.
+- The :ALLOCATION type cannot be extended. Fixed.
+- MAKE-METHOD-LAMBDA is not provided. Not fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- REINITIALIZE-INSTANCE doesn't determine a new discriminating function. Fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Not fixed.
+- SLOT-MAKUNBOUND-USING-CLASS is not specialized on slot definition metaobjects, but on symbols. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- VALIDATE-SUPERCLASS doesn't recognize T as a valid superclass. Not fixed.
+- Subclasses of BUILT-IN-CLASS, FORWARD-REFERENCED-CLASS, FUNCALLABLE-STANDARD-CLASS, METHOD-COMBINATION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+CLisp 2.35 and 2.36
+
+None of the incompatibilities in CLisp are fixed.
+
+- Methods are not initialized with :function.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP.
+- DEFMETHOD does not call MAKE-METHOD-LAMBDA.
+- The :ALLOCATION type cannot be extended. Not fixed.
+- A FORWARD-REFERENCED-CLASS is not changed via CHANGE-CLASS (but is correctly reinitialized via REINITIALIZE-INSTANCE).
+- MAKE-METHOD-LAMBDA is not provided.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- Subclasses of METHOD-COMBINATION will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+CLisp 2.37 - 2.39
+
+None of the incompatibilities in CLisp are fixed.
+
+- Methods are not initialized with :function.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP.
+- DEFMETHOD does not call MAKE-METHOD-LAMBDA.
+- A FORWARD-REFERENCED-CLASS is not changed via CHANGE-CLASS (but is correctly reinitialized via REINITIALIZE-INSTANCE).
+- MAKE-METHOD-LAMBDA is not provided.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- Subclasses of METHOD-COMBINATION will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+CLisp 2.40 and 2.41
+
+None of the incompatibilities in CLisp are fixed.
+
+- Methods are not initialized with :function.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP.
+- DEFMETHOD does not call MAKE-METHOD-LAMBDA.
+- A FORWARD-REFERENCED-CLASS is not changed via CHANGE-CLASS (but is correctly reinitialized via REINITIALIZE-INSTANCE).
+- MAKE-METHOD-LAMBDA is not provided.
+- Subclasses of METHOD-COMBINATION will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+CMUCL 19c, 19d
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- Accessor methods are not initialized with :function, :lambda-list, :slot-definition and :specializers. Fixed.
+- Classes cannot be anonymous. Fixed.
+- Class initialization doesn't call READER-METHOD-CLASS and WRITER-METHOD-CLASS for accessor methods. Fixed.
+- The object returned by compute-discriminating-function cannot be a closure. Likewise, the second parameter to set-funcallable-instance-function cannot be a closure, but only a "pure" function/thunk. Not fixed.
+- Effective slot definitions are not initialized with :documentation, and EFFECTIVE-SLOT-DEFINITION-CLASS also doesn't receive that initarg. Not fixed.
+- Calling DOCUMENTATION on effective slot definition metaobjects don't return their documentation as specified in ANSI Common Lisp. Fixed.
+- Methods are not initialized with :function. Not fixed.
+- Multiple slot options are not passed as lists to DIRECT-SLOT-DEFINITION-CLASS. Not fixed, but use FIX-SLOT-INITARGS as a workaround.
+- REINITIALIZE-INSTANCE doesn't determine a new discriminating function. Fixed.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- Subclasses of BUILT-IN-CLASS, CLASS, DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, EQL-SPECIALIZER, FORWARD-REFERENCED-CLASS, FUNCALLABLE-STANDARD-CLASS, SLOT-DEFINITION, SPECIALIZER, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+LispWorks, 4.4.5, 4.4.6, Personal and Professional Editions
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- ADD-METHOD doesn't call ADD-DIRECT-METHOD and REMOVE-METHOD. Fixed.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- Effective slot definitions are not initialized with :allocation, and EFFECTIVE-SLOT-DEFINITION-CLASS also doesn't receive that initarg. Not fixed. This information is encoded in the initarg :flags, but I don't have any detailed information about that parameter.
+- Classes are not initialized with :direct-default-initargs, but with :default-initargs. Conditionalize on #+lispworks to fix this.
+- Class reinitialization does not call REMOVE-DIRECT-SUBCLASS. Fixed.
+- COMPUTE-APPLICABLE-METHODS-USING-CLASSES doesn't exist. Not fixed.
+- COMPUTE-DEFAULT-INITARGS doesn't exist. Not fixed.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- When classes are initialized, :direct-superclasses are by default not empty. Not fixed, but direct superclasses are automatically adjusted when you use the standard idiom for adding a new default superclass.
+- EQL-SPECIALIZER, EQL-SPECIALIZER-OBJECT and INTERN-EQL-SPECIALIZER don't exist. In LispWorks, eql specializers are lists not objects. I have provided EQL-SPECIALIZER as a type (not as a class) and EQL-SPECIALIZER-OBJECT and INTERN-EQL-SPECIALIZER to work on lists, and a class EQL-SPECIALIZER* and corresponding EQL-SPECIALIZER-OBJECT* and INTERN-EQL-SPECILAIZER* to soften the incompatibilities.
+- The :ALLOCATION type cannot be extended. Not fixed.
+- FIND-METHOD-COMBINATION doesn't exist. Fixed, but fixed version doesn't work with method combination options.
+- FUNCALLABLE-STANDARD-INSTANCE-ACCESS and STANDARD-INSTANCE-ACCESS don't exist. Not fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS and COMPUTE-APPLICABLE-METHODS-USING-CLASSES. Not fixed.
+- Generic functions are not initialized with :declarations, but with 'declare. Not fixed. Conditionalize on #+lispworks instead.
+- MAKE-METHOD-LAMBDA expects other parameters than specified. Fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- REMOVE-METHOD doesn't call REMOVE-DIRECT-METHOD. Fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Not fixed.
+- The slot methods (SLOT-VALUE-USING-CLASS, etc.) are not specialized on effective slot definitions, but on slot names. Fixed.
+- The generated accessor methods don't use the slot methods for accessing slots. Fixed. (Don't use :optimize-slot-access to deoptimize slot access, or otherwise the fixed slot access protocol doesn't work anymore!)
+- SPECIALIZER doesn't exist. Not fixed.
+- SPECIALIZER-DIRECT-GENERIC-FUNCTIONS doesn't exist. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- Subclasses of BUILT-IN-CLASS (fixed), CLASS (fixed), DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, FORWARD-REFERENCED-CLASS (fixed), FUNCALLABLE-STANDARD-CLASS (fixed), SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS (fixed), STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed, except where indicated otherwise.
+
+
+LispWorks, 5.0 and 5.0.1, Personal Edition
+LispWorks, 5.0 - 5.0.2, Professional Edition
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- COMPUTE-APPLICABLE-METHODS-USING-CLASSES doesn't exist. Not fixed.
+- COMPUTE-DEFAULT-INITARGS doesn't exist. Not fixed.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- EQL-SPECIALIZER, EQL-SPECIALIZER-OBJECT and INTERN-EQL-SPECIALIZER don't exist. In LispWorks, eql specializers are lists not objects. I have provided EQL-SPECIALIZER as a type (not as a class) and EQL-SPECIALIZER-OBJECT and INTERN-EQL-SPECIALIZER to work on lists, and a class EQL-SPECIALIZER* and corresponding EQL-SPECIALIZER-OBJECT* and INTERN-EQL-SPECILAIZER* to soften the incompatibilities.
+- The :ALLOCATION type cannot be extended. Not fixed.
+- FIND-METHOD-COMBINATION doesn't exist. Fixed, but fixed version doesn't work with method combination options.
+- FUNCALLABLE-STANDARD-INSTANCE-ACCESS and STANDARD-INSTANCE-ACCESS don't exist. Not fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS and COMPUTE-APPLICABLE-METHODS-USING-CLASSES. Not fixed.
+- MAKE-METHOD-LAMBDA expects other parameters than specified. Fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- The slot methods (SLOT-VALUE-USING-CLASS, etc.) are not specialized on effective slot definitions, but on slot names. Fixed.
+- The generated accessor methods don't use the slot methods for accessing slots. Fixed. (Don't use :optimize-slot-access to deoptimize slot access, or otherwise the fixed slot access protocol doesn't work anymore!)
+- SPECIALIZER doesn't exist. Not fixed.
+- SPECIALIZER-DIRECT-GENERIC-FUNCTIONS doesn't exist. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- Subclasses of BUILT-IN-CLASS (fixed), CLASS (fixed), DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, FORWARD-REFERENCED-CLASS (fixed), FUNCALLABLE-STANDARD-CLASS (fixed), SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS (fixed), STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed, except where indicated otherwise.
+
+
+MCL 5.1
+
+In MCL, generic functions work completely differently than specified. The specific incompatibilities are not listed and are not fixed.
+
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP. Not fixed.
+- DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, EQL-SPECIALIZER, SLOT-DEFINITION and STANDARD-SLOT-DEFINITION are not exported. Fixed.
+- When classes are initialized, :direct-superclasses are by default not empty. Not fixed, but direct superclasses are automatically adjusted when you use the standard idiom for adding a new default superclass.
+- The :ALLOCATION type cannot be extended. Not fixed.
+- Multiple slot options are not passed as lists to DIRECT-SLOT-DEFINITION-CLASS. Not fixed, but use FIX-SLOT-INITARGS as a workaround.
+- (SETF CLASS-NAME) doesn't use REINITIALIZE-INSTANCE for changing the names. Fixed.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- Subclasses of DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+OpenMCL 1.0
+
+In OpenMCL, generic functions work completely differently than specified. The specific incompatibilities are not listed and are not fixed.
+
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP. Not fixed.
+- EQL-SPECIALIZER is not exported. Fixed.
+- DOCUMENTATION doesn't return the documentation strings for slot definition metaobjects. Fixed.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- Subclasses of DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, GENERIC-FUNCTION, SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+SBCL 0.9.16 - 1.0.10
+
+All features implemented.
+
+
+Summary:
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS exist, but don't work as expected in Allegro Common Lisp, CMUCL and LispWorks.
+- If you specialize COMPUTE-DEFAULT-INITAGS, conditionalize for the extra parameters in Allegro Common Lisp.
+- In Allegro Common Lisp, FUNCALLABLE-STANDARD-OBJECT is not used as the default superclass for classes with :metaclass FUNCALLABLE-STANDARD-CLASS.
+- In CMUCL, the object returned by compute-discriminating-function cannot be a closure. Likewise, the second parameter to set-funcallable-instance-function cannot be a closure, but only a "pure" function/thunk.
+- In CLisp, MCL and OpenMCL, the slot order requested by a primary method for COMPUTE-SLOTS is not honoured by the respective MOPs.
+- Don't rely on FIND-METHOD-COMBINATION to do its job correctly, only when you don't provide method combination options.
+- MAKE-METHOD-LAMBDA only works in CMUCL and SBCL as specified (but make sure that the respective generic function and method metaobject classes and make-method-lambda definitions are part of your compilation enviroment). MAKE-METHOD-LAMBDA also works in LispWorks, but the returned lambda expressions don't adhere to the AMOP specification (which may be good enough for your purposes).
+- Specialize the methods for the dependent protocol on the class or generic function metaobject class. The example in AMOP doesn't do this but that is fragile code.
+- Don't rely on methods being initialized with the specified initargs from inside the MOP.
+- CLisp doesn't change a FORWARD-REFERENCED-CLASS via CHANGE-CLASS. Apart from that, FORWARD-REFERENCED-CLASS works reliably across all MOPs.
+- Effective slot definitions and EFFECTIVE-SLOT-DEFINITION-CLASS don't receive :documentation in CMUCL, and no :allocation (!) in LispWorks before 5.0.
+- If you specialize DIRECT-SLOT-DEFINITION-CLASS, use FIX-SLOT-INITARGS in portable code.
+- If you want to use :ALLOCATION types other than :CLASS or :INSTANCE, you cannot use CLisp before 2.37, LispWorks or MCL. Only Allegro Common Lisp, CLisp from 2.37 on, CMUCL, OpenMCL and SBCL support this.
+- In Allegro, CMUCL and LispWorks, STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible.
+- The function invocation protocol only works in CMUCL, SBCL and CLisp.
+- If you need to see :direct-default-initargs when classes are initialized, conditionalize on #+lispworks to receive :default-initargs instead for LispWorks version before 5.0.
+- COMPUTE-DEFAULT-INITARGS doesn't exist (and isn't called) in LispWorks.
+- In LispWorks, eql specializers are lists.
+- FUNCALLABLE-STANDARD-INSTANCE-ACCESS and STANDARD-INSTANCE-ACCESS doesn't exist / should not be used in LispWorks.
+- In CLisp before version 2.40, and in CMUCL, MCL and OpenMCL, the reinitialization of a class metaobject does not lead to a call of FINALIZE-INHERITANCE, so methods defined on FINALIZE-INHERITANCE won't be called again in that case.
+- If you need to see :declarations when generic functions are initialized, conditionalize on #+lispworks to receive 'declare instead for LispWorks versions before 5.0. (Actually, AMOP and ANSI Common Lisp diverge in this regard. AMOP specifies that :declarations is used whereas ANSI Common Lisp specifies that 'declare is used. Since most MOP implementations adhere to AMOP in this regard, I have also chosen that path.)
+- In Allegro Common Lisp and LispWorks, method functions take the original parameters that a generic function has received.
+- In LispWorks before 5.0, the class SPECIALIZER doesn't exist.
+- If you need to rely on the generic function protocols, don't use MCL or OpenMCL (or be very careful - some minor things work there as specified).
+- The declarations for a generic function cannot be inspected in MCL.
+- All implementations define slots on various specified metaobject classes that are exported from some package and/or accessible in the package common-lisp-user. Only sbcl is safe from this, and clisp is relatively safe in that it does that only for the class METHOD-COMBINATION.
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/lispworks/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/lispworks/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/lispworks/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,194 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ (:shadow
+ #:defclass #:defgeneric #:defmethod
+ #:ensure-generic-function
+ #:standard-class #:standard-generic-function)
+ (:export
+ #:defclass #:defgeneric #:defmethod
+ #:ensure-generic-function
+ #:standard-class #:standard-generic-function)
+
+ (:import-from #:clos
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #-lispworks #:eql-specializer
+ #:forward-referenced-class
+ #-lispworks #:funcallable-standard-class
+ #+lispworks5.0 #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #-lispworks #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #-lispworks4.3 #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-lispworks #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #-lispworks #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #-lispworks #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #-lispworks #:find-method-combination
+ #-lispworks #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #-lispworks #:intern-eql-specializer
+ #-lispworks #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #-lispworks4.3 #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #-lispworks #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #-lispworks #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #-lispworks4.3 #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #+lispworks #:eql-specializer*
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #-lispworks #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #-lispworks4.3 #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-lispworks #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #-lispworks #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #-lispworks #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #+lispworks #:intern-eql-specializer*
+ #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #-lispworks4.3 #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #-lispworks #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #-lispworks4.3 #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/lispworks/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/lispworks/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/lispworks/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,605 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+;; We need a new standard-generic-function for various things.
+
+(cl:defclass standard-generic-function (cl:standard-generic-function)
+ ((initial-methods :initform '()))
+ (:metaclass clos:funcallable-standard-class))
+
+;; The following ensures that the new standard-generic-function is used.
+
+(defun ensure-generic-function
+ (name &rest args
+ &key (generic-function-class 'standard-generic-function)
+ &allow-other-keys)
+ (declare (dynamic-extent args))
+ (when (fboundp name)
+ (let ((function (fdefinition name)))
+ (unless (typep function 'generic-function)
+ (cerror "Discard existing definition and create generic function."
+ "~S is already fbound, but not as a generic function." name)
+ (fmakunbound name))))
+ (if (fboundp name)
+ (let ((function (fdefinition name)))
+ (apply #'ensure-generic-function-using-class
+ function name args))
+ (apply #'ensure-generic-function-using-class nil name
+ :generic-function-class generic-function-class
+ args)))
+
+;; We need a new standard-class for various things.
+
+(cl:defclass standard-class (cl:standard-class)
+ ())
+
+;; validate-superclass for metaclass classes is a little bit
+;; more tricky than for class metaobject classes because
+;; we don't want to make all standard-classes compatible to
+;; each other.
+
+;; Our validate-superclass may get passed a class-prototype
+;; as its second argument, so don't expect its readers to
+;; yield useful information. (In ANSI parlance, "the
+;; consequences are undefined...")
+
+(cl:defmethod validate-superclass
+ ((class standard-class)
+ (superclass cl:standard-class))
+ (or (when (eq (class-of class) (find-class 'standard-class))
+ (or (eq (class-of superclass) (find-class 'cl:standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'cl:standard-class))
+ (validate-superclass class (class-prototype (find-class 'standard-class))))))
+
+;; The following macro ensures that the new standard-class is used
+;; by default. It would have been useful to fix other deficiencies
+;; in a complete redefinition of defclass, but there is no portable
+;; way to ensure the necessary compile-time effects as specified
+;; by ANSI Common Lisp. Therefore, we just expand to the original
+;; cl:defclass.
+
+(defmacro defclass (name (&rest supers) &body options)
+ (if (member :metaclass options :key #'car)
+ `(cl:defclass ,name ,supers ,@options)
+ `(cl:defclass ,name ,supers ,@options
+ (:metaclass standard-class))))
+
+;; We need a new funcallable-standard-class for various things.
+
+(cl:defclass funcallable-standard-class (clos:funcallable-standard-class)
+ ())
+
+;; See the comment on validate-superclass for standard-class above.
+
+(cl:defmethod validate-superclass
+ ((class funcallable-standard-class)
+ (superclass clos:funcallable-standard-class))
+ (or (when (eq (class-of class) (find-class 'funcallable-standard-class))
+ (or (eq (class-of superclass) (find-class 'clos:funcallable-standard-class))
+ (eq (class-of superclass) (find-class 'funcallable-standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'clos:funcallable-standard-class))
+ (validate-superclass class (class-prototype (find-class 'funcallable-standard-class))))))
+
+#+lispworks5.0
+(cl:defmethod validate-superclass
+ ((class funcallable-standard-class)
+ (superclass (eql (find-class 'funcallable-standard-object))))
+ t)
+
+;; We also need a new funcallable-standard-object because the default one
+;; is not an instance of clos:funcallable-standard-class.
+
+#-lispworks5.0
+(cl:defclass funcallable-standard-object (clos:funcallable-standard-object)
+ ()
+ (:metaclass clos:funcallable-standard-class))
+
+;; The following code ensures that possibly incorrect lists of direct
+;; superclasses are corrected.
+
+#-lispworks5.0
+(defun modify-superclasses (direct-superclasses &optional (standardp t))
+ (if (null direct-superclasses)
+ (list (if standardp
+ (find-class 'standard-object)
+ (find-class 'funcallable-standard-object)))
+ (let ((standard-object (if standardp
+ (find-class 'standard-object)
+ (find-class 'clos:funcallable-standard-object))))
+ (if (eq (car (last direct-superclasses)) standard-object)
+ (if standardp
+ direct-superclasses
+ (append (butlast direct-superclasses)
+ (list (find-class 'funcallable-standard-object))))
+ (remove standard-object direct-superclasses)))))
+
+;; During class re/initialization, we take care of the following things:
+;; - Optimization of slot accessors is deactivated.
+;; - Lists of direct superclasses are corrected.
+;; - Removal of direct subclasses.
+
+(cl:defmethod initialize-instance :around
+ ((class standard-class) &rest initargs
+ #-lispworks5.0 &key
+ #-lispworks5.0 (direct-superclasses ()))
+ (declare (dynamic-extent initargs))
+ (apply #'call-next-method class
+ #-lispworks5.0 :direct-superclasses
+ #-lispworks5.0 (modify-superclasses direct-superclasses)
+ :optimize-slot-access nil
+ initargs))
+
+(cl:defmethod reinitialize-instance :around
+ ((class standard-class) &rest initargs
+ #-lispworks5.0 &key
+ #-lispworks5.0 (direct-superclasses () direct-superclasses-p))
+ (declare (dynamic-extent initargs))
+ #-lispworks5.0
+ (progn
+ (when direct-superclasses-p
+ (setq direct-superclasses (modify-superclasses direct-superclasses))
+ (loop for superclass in (copy-list (class-direct-superclasses class))
+ unless (member superclass direct-superclasses)
+ do (remove-direct-subclass superclass class)))
+ (if direct-superclasses-p
+ (apply #'call-next-method class
+ :direct-superclasses direct-superclasses
+ :optimize-slot-access nil
+ initargs)
+ (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs)))
+ #+lispworks5.0
+ (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs))
+
+(cl:defmethod initialize-instance :around
+ ((class funcallable-standard-class) &rest initargs
+ #-lispworks5.0 &key
+ #-lispworks5.0 (direct-superclasses ()))
+ (declare (dynamic-extent initargs))
+ (apply #'call-next-method class
+ #-lispworks5.0 :direct-superclasses
+ #-lispworks5.0 (modify-superclasses direct-superclasses nil)
+ :optimize-slot-access nil
+ initargs))
+
+(cl:defmethod reinitialize-instance :around
+ ((class funcallable-standard-class) &rest initargs
+ #-lispworks5.0 &key
+ #-lispworks5.0 (direct-superclasses () direct-superclasses-p))
+ (declare (dynamic-extent initargs))
+ #-lispworks5.0
+ (progn
+ (when direct-superclasses-p
+ (setq direct-superclasses (modify-superclasses direct-superclasses nil))
+ (loop for superclass in (copy-list (class-direct-superclasses class))
+ unless (member superclass direct-superclasses)
+ do (remove-direct-subclass superclass class)))
+ (if direct-superclasses-p
+ (apply #'call-next-method class
+ :direct-superclasses direct-superclasses
+ :optimize-slot-access nil
+ initargs)
+ (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs)))
+ #+lispworks5.0
+ (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs))
+
+;; The following is necessary for forward-referenced-classes.
+;; Since we replace the original funcallable-standard-object with
+;; a new one, we have to prevent LispWorks from trying to use
+;; the original one when forward-ferenced-classes are resolved.
+
+#-lispworks5.0
+(cl:defmethod change-class :around
+ ((class forward-referenced-class)
+ (new-class funcallable-standard-class)
+ &rest initargs
+ &key (direct-superclasses ()))
+ (declare (dynamic-extent initargs))
+ (apply #'call-next-method class new-class
+ :optimize-slot-access nil
+ :direct-superclasses (modify-superclasses direct-superclasses nil)
+ initargs))
+
+;;; In LispWorks, the slot accessors (slot-value-using-class, etc.) are specialized
+;;; on slot names instead of effective slot definitions. In order to fix this,
+;;; we need to rewire the slot access protocol.
+
+(cl:defmethod slot-value-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-value-using-class class object slotd)
+ (slot-missing class object slot 'slot-value))))
+
+(cl:defmethod slot-value-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-value-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd)))
+
+(cl:defmethod (setf slot-value-using-class)
+ (new-value (class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (setf (slot-value-using-class class object slotd)
+ new-value)
+ (slot-missing class object slot 'setf new-value))))
+
+(cl:defmethod (setf slot-value-using-class)
+ (new-value (class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (setf (slot-value-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd))
+ new-value))
+
+(cl:defmethod slot-boundp-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-boundp-using-class class object slotd)
+ (slot-missing class object slot 'slot-boundp))))
+
+(cl:defmethod slot-boundp-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-boundp-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd)))
+
+(cl:defmethod slot-makunbound-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-makunbound-using-class class object slotd)
+ (slot-missing class object slot 'slot-makunbound))))
+
+(cl:defmethod slot-makunbound-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-makunbound-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd)))
+
+;; In LispWorks, eql specializers are lists. We cannot change this
+;; but we can soften some of the incompatibilities.
+
+(deftype eql-specializer ()
+ '(or eql-specializer*
+ (satisfies clos:eql-specializer-p)))
+
+(cl:defgeneric eql-specializer-object (eql-specializer)
+ (:method ((cons cons))
+ (if (clos:eql-specializer-p cons)
+ (cadr cons)
+ (error "~S is not an eql-specializer." cons))))
+
+(defun intern-eql-specializer (object)
+ `(eql ,object))
+
+(cl:defclass eql-specializer* (metaobject)
+ ((obj :reader eql-specializer-object
+ :initarg eso
+ :initform (error "Use intern-eql-specializer to create eql-specializers."))
+ (direct-methods :reader specializer-direct-methods
+ :accessor es-direct-methods
+ :initform ())))
+
+(defvar *eql-specializers* (make-hash-table))
+
+(defun intern-eql-specializer* (object)
+ (or (gethash object *eql-specializers*)
+ (setf (gethash object *eql-specializers*)
+ (make-instance 'eql-specializer* 'eso object))))
+
+(cl:defmethod add-direct-method ((specializer eql-specializer*) (method method))
+ (pushnew method (es-direct-methods specializer)))
+
+(cl:defmethod remove-direct-method ((specializer eql-specializer*) (method method))
+ (removef (es-direct-methods specializer) method))
+
+(cl:defgeneric specializer-direct-generic-functions (specializer)
+ (:method ((class class))
+ (remove-duplicates
+ (mapcar #'method-generic-function
+ (specializer-direct-methods class))))
+ (:method ((eql-specializer eql-specializer*))
+ (remove-duplicates
+ (mapcar #'method-generic-function
+ (specializer-direct-methods eql-specializer))))
+ (:method ((cons cons))
+ (specializer-direct-generic-functions
+ (intern-eql-specializer*
+ (eql-specializer-object cons)))))
+
+;; The following method ensures that remove-method is called.
+
+#-lispworks5.0
+(cl:defmethod add-method :before ((gf standard-generic-function) (method method))
+ (when-let (old-method (find-method gf (method-qualifiers method)
+ (method-specializers method) nil))
+ (remove-method gf old-method)))
+
+;; The following two methods ensure that add/remove-direct-method is called,
+;; and that the dependent protocol for generic function works.
+
+(cl:defmethod add-method :after ((gf standard-generic-function) (method method))
+ (loop for specializer in (method-specializers method)
+ if (consp specializer)
+ do (add-direct-method
+ (intern-eql-specializer*
+ (eql-specializer-object specializer))
+ method)
+ #-lispworks5.0 else
+ #-lispworks5.0 do
+ #-lispworks5.0 (add-direct-method specializer method))
+ #+lispworks4.3
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'add-method method))))
+
+(cl:defmethod remove-method :after ((gf standard-generic-function) (method method))
+ (loop for specializer in (method-specializers method)
+ if (consp specializer)
+ do (remove-direct-method
+ (intern-eql-specializer*
+ (eql-specializer-object specializer))
+ method)
+ #-lispworks5.0 else
+ #-lispworks5.0 do
+ #-lispworks5.0 (remove-direct-method specializer method))
+ #+lispworks4.3
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'remove-method method))))
+
+(cl:defgeneric find-method-combination (gf combi combi-options)
+ (:method ((gf generic-function) (combi symbol) combi-options)
+ (when combi-options
+ (error "This implementation of find-method-combination cannot handle method combination options."))
+ (clos::find-a-method-combination-type combi)))
+
+;; In LispWorks, make-method-lambda expects different arguments than those
+;; specified in AMOP. We just bridge this. The method lambda returned
+;; still doesn't conform to AMOP, but may be good enough.
+
+(cl:defgeneric make-method-lambda (gf method lambda-expression env)
+ (:method ((gf cl:standard-generic-function)
+ (method standard-method)
+ lambda-expression env)
+ (declare (ignorable env))
+ (destructuring-bind
+ (lambda (&rest args) &body body)
+ lambda-expression
+ (declare (ignore lambda))
+ (loop with documentation = :unbound
+ for (car . cdr) = body then cdr
+ while (or (stringp car)
+ (and (consp car) (eq (car car) 'declare)))
+ if (stringp car)
+ do (setf documentation
+ (if (eq documentation :unbound) car
+ (error "Too many documentation strings in lambda expression ~S."
+ lambda-expression)))
+ else append (loop for declaration in (cdr car)
+ if (eq (car declaration) 'ignore)
+ collect `(ignorable ,@(cdr declaration))
+ and collect `(dynamic-extent ,@(cdr declaration))
+ else collect declaration) into declarations
+ finally (multiple-value-bind
+ (method-lambda method-args)
+ (clos:make-method-lambda
+ gf method args declarations
+ `(progn ,car ,@cdr) env)
+ (if (eq documentation :unbound)
+ (return (values method-lambda method-args))
+ (return (values
+ `(lambda ,(cadr method-lambda)
+ ,documentation
+ ,@(cddr method-lambda))
+ method-args))))))))
+
+(defun ensure-method (gf lambda-expression
+ &key (method-class (generic-function-method-class gf))
+ (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (multiple-value-bind
+ (method-lambda method-args)
+ (make-method-lambda
+ gf (class-prototype method-class)
+ lambda-expression ())
+ (let ((method (apply #'make-instance
+ method-class
+ :qualifiers qualifiers
+ :lambda-list lambda-list
+ :specializers specializers
+ :function (compile nil method-lambda)
+ method-args)))
+ (add-method gf method)
+ method)))
+
+;; helper function for creating a generic function lambda list
+;; from a method lambda list.
+(defun create-gf-lambda-list (method-lambda-list)
+ (loop with stop-keywords = '#.(remove '&optional lambda-list-keywords)
+ for arg in method-lambda-list
+ until (member arg stop-keywords)
+ collect arg into gf-lambda-list
+ finally (return (let (rest)
+ (cond ((member '&key method-lambda-list)
+ (nconc gf-lambda-list '(&key)))
+ ((setq rest (member '&rest method-lambda-list))
+ (nconc gf-lambda-list (subseq rest 0 2)))
+ (t gf-lambda-list))))))
+
+;; The defmethod macro is needed in order to ensure that make-method-lambda
+;; is called. (Unfortunately, this doesn't work in the other CL implementations.)
+
+(defmacro defmethod (&whole form name &body body &environment env)
+ (loop for tail = body then (cdr tail)
+ until (listp (car tail))
+ collect (car tail) into qualifiers
+ finally
+ (destructuring-bind
+ ((&rest specialized-args) &body body) tail
+ (loop with documentation = :unbound
+ for (car . cdr) = body then cdr
+ while (or (stringp car)
+ (and (consp car) (eq (car car) 'declare)))
+ if (stringp car)
+ do (setq documentation
+ (if (eq documentation :unbound) car
+ (error "Too many documentation strings for defmethod form ~S." form)))
+ else append (cdr car) into declarations
+ finally
+ (let* ((lambda-list (extract-lambda-list specialized-args))
+ (gf-lambda-list (create-gf-lambda-list lambda-list))
+ (gf (if (fboundp name)
+ (ensure-generic-function name)
+ (ensure-generic-function name :lambda-list gf-lambda-list)))
+ (method-class (generic-function-method-class gf))
+ (lambda-expression `(lambda ,lambda-list
+ (declare ,@declarations)
+ (block ,name ,car ,@cdr))))
+ (if (equal (compute-applicable-methods
+ #'make-method-lambda
+ (list gf (class-prototype method-class)
+ lambda-expression env))
+ (list (find-method
+ #'make-method-lambda '()
+ (list (find-class 'cl:standard-generic-function)
+ (find-class 'standard-method)
+ (find-class 't)
+ (find-class 't))
+ nil)))
+ (return-from defmethod `(cl:defmethod ,@(rest form)))
+ (multiple-value-bind
+ (method-lambda method-args)
+ (make-method-lambda
+ gf (class-prototype method-class)
+ lambda-expression env)
+ (with-unique-names (gf method)
+ (return-from defmethod
+ `(let ((,gf (if (fboundp ',name)
+ (ensure-generic-function ',name)
+ (ensure-generic-function
+ ',name :lambda-list ',gf-lambda-list)))
+ (,method
+ (make-instance
+ ',method-class
+ :qualifiers ',qualifiers
+ :specializers
+ (list
+ ,@(mapcar
+ (lambda (specializer-name)
+ (typecase specializer-name
+ (symbol `(find-class ',specializer-name))
+ (cons (cond
+ ((> (length specializer-name) 2)
+ (error "Invalid specializer ~S in defmethod form ~S."
+ specializer-name form))
+ ((eq (car specializer-name) 'eql)
+ `(intern-eql-specializer ,(cadr specializer-name)))
+ (t (error "Invalid specializer ~S in defmethod form ~S."
+ specializer-name form))))
+ (t (error "Invalid specializer ~S in defmethod form ~S."
+ specializer-name form))))
+ (extract-specializer-names specialized-args)))
+ :lambda-list ',lambda-list
+ :function (function ,method-lambda)
+ ,@(unless (eq documentation :unbound)
+ (list :documentation documentation))
+ ,@method-args)))
+ (add-method ,gf ,method)
+ ,method))))))))))
+
+;; The following macro ensures that the new standard-generic-function
+;; is used by default. It also ensures that make-method-lambda is called
+;; for the default methods, by expanding into defmethod forms.
+
+(defmacro defgeneric (&whole form name (&rest args) &body options)
+ (unless (every #'consp options)
+ (error "Illegal generic functions options in defgeneric form ~S." form))
+ `(progn
+ (let ((generic-function (ignore-errors (fdefinition ',name))))
+ (when (and generic-function (typep generic-function 'standard-generic-function))
+ (loop for method in (slot-value generic-function 'initial-methods)
+ do (remove-method generic-function method))))
+ (cl:defgeneric ,name ,args
+ ,@(remove :method options :key #'car :test #'eq)
+ ,@(unless (member :generic-function-class options :key #'car :test #'eq)
+ '((:generic-function-class standard-generic-function))))
+ (let ((generic-function (fdefinition ',name)))
+ (setf (slot-value generic-function 'initial-methods)
+ (list ,@(loop for method-spec in (remove :method options :key #'car :test-not #'eq)
+ collect `(defmethod ,name ,@(cdr method-spec)))))
+ generic-function)))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ initargs)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/mcl/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/mcl/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/mcl/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,190 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ #-openmcl
+ (:shadow #:defclass #:standard-class #:typep #:subtypep)
+ #-openmcl
+ (:export #:defclass #:standard-class #:typep #:subtypep)
+
+ (:import-from #:ccl
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #-(or mcl openmcl) #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-(or mcl openmcl) #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-(or mcl openmcl) #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #+openmcl #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #-(or mcl openmcl) #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-(or mcl openmcl) #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-(or mcl openmcl) #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #+openmcl #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #-openmcl #:subtypep
+ #-openmcl #:typep
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/mcl/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/mcl/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/mcl/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,177 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+#-openmcl
+(progn
+ ;; We need a new standard-class for various things.
+
+ (cl:defclass standard-class (cl:standard-class)
+ ())
+
+ ;; validate-superclass for metaclass classes is a little bit
+ ;; more tricky than for class metaobject classes because
+ ;; we don't want to make all standard-classes compatible to
+ ;; each other.
+
+ ;; Our validate-superclass may get passed a class-prototype
+ ;; as its second argument, so don't expect its readers to
+ ;; yield useful information. (In ANSI parlance, "the
+ ;; consequences are undefined...")
+
+ (cl:defmethod validate-superclass
+ ((class standard-class)
+ (superclass cl:standard-class))
+ (or (when (eq (class-of class) (find-class 'standard-class))
+ (or (eq (class-of superclass) (find-class 'cl:standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'cl:standard-class))
+ (validate-superclass class (class-prototype (find-class 'standard-class))))))
+
+ ;; The following macro ensures that the new standard-class is used
+ ;; by default. It would have been useful to fix other deficiencies
+ ;; in a complete redefinition of defclass, but there is no portable
+ ;; way to ensure the necessary compile-time effects as specified
+ ;; by ANSI Common Lisp. Therefore, we just expand to the original
+ ;; cl:defclass.
+
+ (defmacro defclass (name (&rest supers) &body options)
+ (if (member :metaclass options :key #'car)
+ `(cl:defclass ,name ,supers ,@options)
+ `(cl:defclass ,name ,supers ,@options
+ (:metaclass standard-class))))
+
+ ;; In MCL, the list of direct superclasses passed by the
+ ;; defclass macro is not empty, as required by AMOP, but
+ ;; instead passes the class metaobject for standard-object
+ ;; or funcallable-standard-object respectively. This makes
+ ;; replacing the default superclass for a new metaclass a bit
+ ;; more complicated. In order to avoid the tricky bits in user
+ ;; code, the new standard-class adjusts possible incorrect
+ ;; direct superclasses by adding or removing the metaobject
+ ;; for standard-object as needed before passing them to
+ ;; the original standard-class. In user code, just use the
+ ;; idiom suggested by AMOP to APPEND your new default superclass
+ ;; to the list of direct superclasses.
+
+ (defun modify-superclasses (direct-superclasses)
+ (if (null direct-superclasses)
+ (list (find-class 'standard-object))
+ (let ((standard-object (find-class 'standard-object)))
+ (if (eq (car (last direct-superclasses)) standard-object)
+ direct-superclasses
+ (remove standard-object direct-superclasses)))))
+
+ (cl:defmethod initialize-instance :around
+ ((class standard-class) &rest initargs
+ &key (name (gensym)) (direct-superclasses ()))
+ (declare (dynamic-extent initargs))
+ (apply #'call-next-method class
+ :name name
+ :direct-superclasses (modify-superclasses direct-superclasses)
+ initargs))
+
+ (cl:defmethod reinitialize-instance :around
+ ((class standard-class) &rest initargs
+ &key (direct-superclasses () direct-superclasses-p))
+ (declare (dynamic-extent initargs))
+ (if direct-superclasses-p
+ (apply #'call-next-method class
+ :direct-superclasses (modify-superclasses direct-superclasses)
+ initargs)
+ (call-next-method)))
+
+ (defgeneric typep (object type)
+ (:method (object type)
+ (cl:typep object type))
+ (:method (object (type class))
+ (member (class-of object)
+ (class-precedence-list type))))
+
+ (defgeneric subtypep (type1 type2)
+ (:method (type1 type2)
+ (cl:subtypep type1 type2))
+ (:method ((type1 class) (type2 symbol))
+ (let ((class2 (find-class type2 nil)))
+ (if class2
+ (member class2 (class-precedence-list type1))
+ (cl:subtypep type1 type2))))
+ (:method ((type1 symbol) (type2 class))
+ (let ((class1 (find-class type1 nil)))
+ (if class1
+ (member type2 (class-precedence-list class1))
+ (cl:subtypep type1 type2))))
+ (:method ((type1 class) (type2 class))
+ (member type2 (class-precedence-list type1)))))
+
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (eval `(defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))
+
+;; The following ensures that slot definitions have a documentation in OpenMCL.
+
+#+openmcl
+(defmethod initialize-instance :after ((slot slot-definition) &key documentation)
+ (setf (documentation slot 't) documentation))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ #+openmcl initargs
+ #-openmcl
+ (let* ((counts (loop with counts
+ for (key nil) on initargs by #'cddr
+ do (incf (getf counts key 0))
+ finally (return counts)))
+ (keys-to-fix (loop for (key value) on counts by #'cddr
+ if (> value 1) collect key)))
+ (if keys-to-fix
+ (let ((multiple-standard-keys
+ (intersection keys-to-fix *standard-slot-keys*)))
+ (if multiple-standard-keys
+ (error "Too many occurences of ~S in slot initargs ~S."
+ multiple-standard-keys initargs)
+ (loop with fixed-keys
+ for (key value) on initargs by #'cddr
+ if (member key keys-to-fix)
+ do (nconcf (getf fixed-keys key) (list value))
+ else nconc (list key value) into fixed-initargs
+ finally (return (nconc fixed-initargs fixed-keys)))))
+ initargs)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/pcl/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/pcl/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/pcl/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,190 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ #-sbcl (:shadow #:typep #:subtypep)
+ #-sbcl (:export #:typep #:subtypep)
+
+ (:import-from
+ #+cmu #:clos-mop
+ #+sbcl #:sb-mop
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:subtypep
+ #:typep
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/pcl/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/pcl/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/pcl/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,284 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+;; The following is commented out. SBCL now supports compatible standard-class and
+;; funcallable-standard-class metaclasses, but this requires that we don't mess with
+;; the class hierarchy anymore. So we will try the trick we have already used
+;; for generic functions: We just add methods for the existing metaclasses.
+;; This is not AMOP-compliant, but if it works it works.
+
+#|
+;; We need a new standard-class for various things.
+
+(cl:defclass standard-class (cl:standard-class)
+ ())
+
+;; validate-superclass for metaclass classes is a little bit
+;; more tricky than for class metaobject classes because
+;; we don't want to make all standard-classes compatible to
+;; each other.
+
+;; Our validate-superclass may get passed a class-prototype
+;; as its second argument, so don't expect its readers to
+;; yield useful information. (In ANSI parlance, "the
+;; consequences are undefined...")
+
+(cl:defmethod validate-superclass
+ ((class standard-class)
+ (superclass cl:standard-class))
+ (or (when (eq (class-of class) (find-class 'standard-class))
+ (or (eq (class-of superclass) (find-class 'cl:standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'cl:standard-class))
+ (validate-superclass class (class-prototype (find-class 'standard-class))))))
+
+#+sbcl
+(cl:defmethod validate-superclass
+ ((class funcallable-standard-class)
+ (superclass standard-class))
+ (and (eq (class-of class) (find-class 'funcallable-standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+
+;; The following macro ensures that the new standard-class is used
+;; by default. It would have been useful to fix other deficiencies
+;; in a complete redefinition of defclass, but there is no portable
+;; way to ensure the necessary compile-time effects as specified
+;; by ANSI Common Lisp. Therefore, we just expand to the original
+;; cl:defclass.
+
+(defmacro defclass (name (&rest supers) &body options)
+ (if (member :metaclass options :key #'car)
+ `(cl:defclass ,name ,supers ,@options)
+ `(cl:defclass ,name ,supers ,@options
+ (:metaclass standard-class))))
+|#
+
+;; In CMUCL, reader-method-class and writer-method-class are
+;; not used during class initialization. The following definitions
+;; correct this.
+
+#-sbcl
+(defun modify-accessors (class)
+ (loop with reader-specializers = (list class)
+ with writer-specializers = (list (find-class 't) class)
+ for slotd in (class-direct-slots class) do
+ (loop for reader in (slot-definition-readers slotd)
+ for reader-function = (fdefinition reader)
+ for reader-method = (find-method reader-function () reader-specializers)
+ for initargs = (list :qualifiers ()
+ :lambda-list '(object)
+ :specializers reader-specializers
+ :function (method-function reader-method)
+ :slot-definition slotd)
+ for method-class = (apply #'reader-method-class class slotd initargs)
+ unless (eq method-class (class-of reader-method))
+ do (add-method reader-function (apply #'make-instance method-class initargs)))
+ (loop for writer in (slot-definition-writers slotd)
+ for writer-function = (fdefinition writer)
+ for writer-method = (find-method writer-function () writer-specializers)
+ for initargs = (list :qualifiers ()
+ :lambda-list '(new-value object)
+ :specializers writer-specializers
+ :function (method-function writer-method)
+ :slot-definition slotd)
+ for method-class = (apply #'writer-method-class class slotd initargs)
+ unless (eq method-class (class-of writer-method))
+ do (add-method writer-function (apply #'make-instance method-class initargs)))))
+
+;; The following methods additionally create a gensym for the class name
+;; unless a name is explicitly provided. AMOP requires classes to be
+;; potentially anonymous.
+
+#-sbcl
+(cl:defmethod initialize-instance :around
+ ((class standard-class) &rest initargs
+ &key (name (gensym)))
+ (declare (dynamic-extent initargs))
+ (prog1 (apply #'call-next-method class :name name initargs)
+ (modify-accessors class)))
+
+#-sbcl
+(cl:defmethod initialize-instance :around
+ ((class funcallable-standard-class) &rest initargs
+ &key (name (gensym)))
+ (declare (dynamic-extent initargs))
+ (prog1 (apply #'call-next-method class :name name initargs)
+ (modify-accessors class)))
+
+#-sbcl
+(cl:defmethod reinitialize-instance :after
+ ((class standard-class) &key)
+ (modify-accessors class))
+
+#-sbcl
+(cl:defmethod reinitialize-instance :after
+ ((class funcallable-standard-class) &key)
+ (modify-accessors class))
+
+;;; The following three methods ensure that the dependent protocol
+;;; for generic function works.
+
+;; The following method additionally ensures that
+;; compute-discriminating-function is triggered.
+
+; Note that for CMUCL, these methods violate the AMOP specification
+; by specializing on the original standard-generic-function metaclass. However,
+; this is necassary because in CMUCL, only one subclass of
+; standard-generic-function can be created, and taking away that option from user
+; code doesn't make a lot of sense in our context.
+
+#-sbcl
+(cl:defmethod reinitialize-instance :after
+ ((gf standard-generic-function) &rest initargs)
+ (declare (dynamic-extent initargs))
+ (set-funcallable-instance-function
+ gf (compute-discriminating-function gf))
+ #-cmu
+ (map-dependents
+ gf (lambda (dep) (apply #'update-dependent gf dep initargs))))
+
+#-(or cmu sbcl)
+(cl:defmethod add-method :after
+ ((gf standard-generic-function) method)
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'add-method method))))
+
+#-(or cmu sbcl)
+(cl:defmethod remove-method :after
+ ((gf standard-generic-function) method)
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'remove-method method))))
+
+#+sbcl
+(defun ensure-method (gf lambda-expression
+ &key (method-class (generic-function-method-class gf))
+ (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (multiple-value-bind
+ (method-lambda method-args)
+ (make-method-lambda
+ gf (class-prototype method-class)
+ lambda-expression ())
+ (let ((method (apply #'make-instance
+ method-class
+ :qualifiers qualifiers
+ :lambda-list lambda-list
+ :specializers specializers
+ :function (compile nil method-lambda)
+ method-args)))
+ (add-method gf method)
+ method)))
+
+#|
+(defgeneric transform-specializer (specializer)
+ (:method (specializer) specializer)
+ (:method ((specializer class))
+ (class-name specializer))
+ (:method ((specializer eql-specializer))
+ `(eql ,(eql-specializer-object specializer))))
+|#
+
+#-sbcl
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly 't))))
+ (funcall (compile nil `(lambda ()
+ (defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))))
+
+;; The following ensures that effective slot definitions have a documentation in CMUCL.
+
+#+cmu
+(defmethod compute-effective-slot-definition :around
+ ((class standard-class) name direct-slot-definitions)
+ (let ((effective-slot (call-next-method)))
+ (loop for direct-slot in direct-slot-definitions
+ for documentation = (documentation direct-slot 't)
+ when documentation do
+ (setf (documentation effective-slot 't) documentation)
+ (loop-finish))
+ effective-slot))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ #+sbcl initargs
+ #+cmu
+ (let* ((counts (loop with counts
+ for (key nil) on initargs by #'cddr
+ do (incf (getf counts key 0))
+ finally (return counts)))
+ (keys-to-fix (loop for (key value) on counts by #'cddr
+ if (> value 1) collect key)))
+ (if keys-to-fix
+ (let ((multiple-standard-keys
+ (intersection keys-to-fix *standard-slot-keys*)))
+ (if multiple-standard-keys
+ (error "Too many occurences of ~S in slot initargs ~S."
+ multiple-standard-keys initargs)
+ (loop with fixed-keys
+ for (key value) on initargs by #'cddr
+ if (member key keys-to-fix)
+ do (nconcf (getf fixed-keys key) (list value))
+ else nconc (list key value) into fixed-initargs
+ finally (return (nconc fixed-initargs fixed-keys)))))
+ initargs)))
+
+;; In CMUCL, TYPEP and SUBTYPEP don't work as expected
+;; in conjunction with class metaobjects.
+
+#-sbcl
+(progn
+ (defgeneric typep (object type)
+ (:method (object type)
+ (cl:typep object type))
+ (:method (object (type class))
+ (cl:typep object (class-name type))))
+
+ (defgeneric subtypep (type1 type2)
+ (:method (type1 type2)
+ (cl:subtypep type1 type2))
+ (:method ((type1 class) type2)
+ (cl:subtypep (class-name type1) type2))
+ (:method (type1 (type2 class))
+ (cl:subtypep type1 (class-name type2)))
+ (:method ((type1 class) (type2 class))
+ (cl:subtypep (class-name type1)
+ (class-name type2)))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/release-notes.txt
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/release-notes.txt 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/release-notes.txt 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,34 @@
+Closer to MOP Release Note
+
+v0.0 initial release
+
+v0.1
+- separated single implementation into several ones, one for each MOP implementation / implementation family, in order to improve maintainability
+- added support for LispWorks 4.4
+- removed extra method options from the LispWorks defmethod - it's a useful feature, but doesn't belong here
+- the automatically generated slot accessor methods in LispWorks closed over the wrong slot names. fixed. (obsolete because of the next issue)
+- In some cases, LispWorks deoptimizes slot access and reverts to the slot-value-using-class, etc., functions. This rendered the previously taken approach for fixing that protocol useless. Now, we have a much simpler fix. (Thanks to Jeff Caldwell.) Unfortunately, now some of the features that were previously fixed are missing again (correct initialization of accessor methods, accessor-method-slot-definition, reader-method-class and writer-method-class). Fortunately, LispWorks has already fixed those in 4.4, so this is no problem anymore in the long run.
+
+v0.2
+- The trick for reinitialization of generic-function-name or class-name in allegro, pcl, lispworks and mcl didn't work and had to be dropped.
+- In clisp, defgeneric does call ensure-generic-function-using-class. This wasn't detected before due to a bug in mop-feature-tests. (Thanks to Bruno Haible.)
+- Added the utility function ensure-method for programmatically creating methods, supported on all platforms.
+- The defmethod macro for LispWorks didn't have an implicit block with the name of the generic function. Fixed.
+- LispWorks 4.3 is not supported anymore. The existing conditionalizations are still available, though, and will be retained as long as they don't stand in the way of anything else.
+- Since I have to override some symbols from the common-lisp package, I provide two utility packages closer-common-lisp and closer-common-lisp-user, similar to common-lisp and common-lisp-user but with all the MOP symbols added. The default packages additionally added by the various Common Lisp implementations are not added here. (I think that's cleaner.)
+- Handling of pseudo-anonymous classes in CMU CL and SBCL had a copy&paste bug: The name was changed again in reinitialize-instance.
+- TYPEP and SUBTYPEP don't work as expected in CMU CL and SBCL in conjunction with class metaobjects. Same for MCL, but for different reasons. So I have shadowed them and provide a new definition. (In CMU CL and SBCL, class metaobject are not considered types. In MCL, type information for class metaobjects is not available at some stages. Unfortunately, it doesn't seem to be possible to fix this with finalize-inheritance, so I have to revert to membership tests on the class precedence list.)
+- MCL also doesn't like anonymous classes. So I have added a fix for that.
+- I have incorrectly reported that MAKE-METHOD-LAMBDA is unreliable in CMU CL and SBCL. This was due to a bug in my test suite. However, it is required that the respective generic function and method metaobject classes and make-method-lambda definitions are part of the compilation environment when you want to use them. I have updated the respective sections in features.lisp and features.txt.
+- Switched to an MIT/BSD-style license.
+
+v0.3
+- Now supports OpenMCL 1.0, LispWorks 4.4.6, SBCL 0.9.7 - 0.9.9, CMUCL 19C, Allegro 8.0, clisp 2.37 and 2.38.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are now compatible in SBCL. This required some changes in the PCL support.
+- Dropped the reports for LispWorks 4.3.
+- Allegro 6.2 is not supported anymore. The existing conditionalizations are still available, though, and will be retained as long as they don't stand in the way of anything else.
+- The incorrect specialization of slot-boundp-using-class and slot-makunbound-using-class on symbols instead of slot definition metaobjects in Allegro is fixed.
+- SBCL 0.9.7 has improved a lot wrt MOP compatibility. This required some changes in the PCL support.
+- The lack of extensible :allocation kinds in Allegro is fixed. (Covers 6.2, 7.0 and 8.0. Thanks to John Foderaro for giving me the important hint on how to solve this.)
+
+After version 0.3, there are no separate release notes anymore, but they will be generated automatically by darcs in the future.
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/supported-cls.txt
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/supported-cls.txt 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/supported-cls.txt 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,10 @@
+Allegro 7.0, 8.0 & 8.1
+CLisp 2.35 - 2.41
+CMU Common Lisp 19c, 19d
+LispWorks 4.4.5, 4.4.6 Personal Edition
+LispWorks 4.4.5, 4.4.6 Professional Edition
+LispWorks 5.0, 5.0.1, Personal Edition
+LispWorks 5.0 - 5.0.2, Professional Edition
+Macintosh Common Lisp 5.1
+OpenMCL 1.0
+SBCL 0.9.16 - 0.9.18, 1.0.1 - 1.0.10
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/test/jeffs-code.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/test/jeffs-code.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/current/test/jeffs-code.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,207 @@
+;;; Jeff Caldwell 2004-04-16
+;;; LWL 4.3
+;;;
+;;; To reproduce the issues I have come across:
+;;;
+;;; 1. (asdf:oos 'asdf:load-op 'closer-mop)
+;;; 2. (compile-file "c2mop-attributes.lisp" :load t)
+;;; 3. (in-package #:c2mop-test)
+;;; C2MOP-TEST> (setq cr (make-instance 'credit-rating))
+;;; => Stack overflow (stack size 16000).
+;;;
+;;; (In this code, I accidently took out the format statements
+;;; creating the output below. You may wish to put them back
+;;; in the slot-value-using-class and (setf slot-value-using-class)
+;;; methods at the bottom of this file.)
+;;;
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C> slot-name ALL-ATTRIBUTES-2382
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C> slot-name LEVEL
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C>
+;;; slot-name #<ATTRIBUTES-EFFECTIVE-SLOT-DEFINITION LEVEL 2134396C>
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C> slot-name LEVEL
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C>
+;;; slot-name #<ATTRIBUTES-EFFECTIVE-SLOT-DEFINITION LEVEL 2134396C>
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C> slot-name LEVEL
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C>
+;;; slot-name #<ATTRIBUTES-EFFECTIVE-SLOT-DEFINITION LEVEL 2134396C>
+;;; ...
+;;;
+;;; Note that it alternates between slot-name LEVEL and
+;;; slot-name #<ATTRIBUTES-EFFECTIVE-...
+;;;
+;;; In closer-mop.lisp change
+;;;
+;;; (cl:defmethod slot-value-using-class
+;;; ((class standard-class) object (slot symbol))
+;;; (let ((slotd (find slot (class-slots class) :key #'slot-definition-name)))
+;;; (if slotd
+;;; (if (default-reader slotd)
+;;; (slot-value-using-class class object slotd)
+;;; (call-next-method))
+;;; (slot-missing class object slot 'slot-value))))
+;;;
+;;; to
+;;;
+;;; ...
+;;; (if slotd
+;;; (if (default-reader slotd)
+;;; (slot-value-using-class (find-class 'standard-class)
+;;; object slotd)
+;;; ...
+;;;
+;;; (I have no idea if that's a correct patch but it does stop
+;;; the recursive stack overflow.)
+;;;
+;;; Then
+;;; (asdf:oos 'asdf:load-op 'closer-mop)
+;;; (setq cr (make-instance 'credit-rating)
+;;; =>
+;;; The slot #<ATTRIBUTES-EFFECTIVE-SLOT-DEFINITION LEVEL 2133983C> is
+;;; missing from #<CREDIT-RATING 206F0864> (of class #<ATTRIBUTES-CLASS
+;;; CREDIT-RATING 2133B3DC>), when reading the value.
+;;;
+;;; At this point you also can remove the slot-value-using-class and
+;;; setf slot-value-using-class methods. They were no-ops in this
+;;; example, something I had run across in other code. I left them
+;;; here to show the recursive stack overflow. Now that it is "fixed",
+;;; we are left with the missing slot problem above.
+;;; (The problem above is somewhat different from what I reported
+;;; in my first email but the error above is what I'm getting now
+;;; with this example.)
+;;;
+;;; Simply using the LW MOP, instead of using closer-mop,
+;;; "fixes" the problem above. Quit using closer-mop and revert
+;;; to the LW-only MOP. Change the defpackage to
+;;;
+;;; (defpackage #:c2mop-test
+;;; (:use :cl :cl-user :clos))
+;;;
+;;; (cl-user::quit) ;; Make really sure everything's fresh
+;;; M-x slime
+;;; (compile-file "c2mop-attributes.lisp" :load t)
+;;; CL-USER> (in-package #:c2mop-test)
+;;; #<PACKAGE C2MOP-TEST>
+;;; C2MOP-TEST> (setq cr (make-instance 'credit-rating))
+;;; #<CREDIT-RATING 206EDFAC>
+;;; C2MOP-TEST> (setf (level cr) 42)
+;;; 42
+;;; C2MOP-TEST> (level cr)
+;;; 42
+;;; C2MOP-TEST> (setf (slot-attribute cr 'level 'date-set) 20040416)
+;;; 20040416
+;;; C2MOP-TEST> (slot-attribute cr 'level 'date-set)
+;;; 20040416
+;;;
+
+
+;;;
+(defpackage #:c2mop-test
+; (:use :cl :cl-user :clos)
+ (:use :cl :cl-user :closer-mop)
+ (:shadowing-import-from :closer-mop
+ #:defclass #:defmethod #:standard-class
+ #:ensure-generic-function #:defgeneric
+ #:standard-generic-function #:class-name)
+)
+
+(in-package #:c2mop-test)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+(defvar *all-attributes* (gensym "ALL-ATTRIBUTES-"))
+(defvar *current-direct-slot-definitions* nil)
+
+(defclass attributes-class (standard-class) ())
+
+(defclass attributes-mixin
+ (standard-slot-definition)
+ ((attributes :initarg :attributes :accessor slot-definition-attributes
+ :initform nil)))
+
+(defclass attributes-direct-slot-definition
+ (standard-direct-slot-definition attributes-mixin)
+ ())
+
+(defclass attributes-effective-slot-definition
+ (standard-effective-slot-definition attributes-mixin)
+ ())
+
+(defmethod effective-slot-definition-class ((class attributes-class)
+ &rest initargs)
+ (find-class 'attributes-effective-slot-definition))
+
+(defmethod compute-effective-slot-definition ((class attributes-class)
+ name direct-slots)
+ (let* ((normal-slot (call-next-method)))
+ (setf (slot-definition-attributes normal-slot)
+ (remove-duplicates
+ (apply #'append (mapcar #'slot-definition-attributes
+ direct-slots))))
+ normal-slot))
+
+(defmethod direct-slot-definition-class
+ ((class attributes-class) &rest initargs)
+ (find-class 'attributes-direct-slot-definition))
+
+(defmethod process-a-slot-option
+ ((class attributes-class) option value
+ already-processed-options slot)
+ (princ "process-a-slot-option") (princ option)
+ (if (eq option :attributes)
+ (list* :attributes `',value already-processed-options)
+ (call-next-method)))
+
+(defmethod compute-slots ((class attributes-class))
+ (let* ((normal-slots (call-next-method))
+ (alist (mapcar (lambda (slot)
+ (cons (slot-definition-name slot)
+ (mapcar (lambda (attr) (cons attr nil))
+ (slot-definition-attributes
+ slot))))
+ normal-slots)))
+ (cons (make-instance 'attributes-effective-slot-definition
+ :name *all-attributes*
+ :initform alist
+ :initfunction (lambda () alist))
+ normal-slots)))
+
+(defun slot-attribute (instance slot-name attribute)
+ (cdr (slot-attribute-bucket instance slot-name attribute)))
+
+(defun (setf slot-attribute) (new-value instance slot-name attribute)
+ (setf (cdr (slot-attribute-bucket instance slot-name attribute))
+ new-value))
+
+(defun slot-attribute-bucket (instance slot-name attribute)
+ (let* ((all-buckets (slot-value instance *all-attributes*))
+ (slot-bucket (assoc slot-name all-buckets)))
+ (unless slot-bucket
+ (error "Slot ~S of ~S has no attributes."
+ slot-name instance))
+ (let ((attr-bucket (assoc attribute (cdr slot-bucket))))
+ (unless attr-bucket
+ (error "Slot ~S of ~S has no attribute ~S."
+ slot-name instance attribute))
+ attr-bucket)))
+
+(defmethod clos:slot-value-using-class
+ ((class attributes-class) object (slot-name attributes-effective-slot-definition))
+ (call-next-method))
+
+(defmethod (setf clos:slot-value-using-class)
+ (value (class attributes-class) object (slot-name attributes-effective-slot-definition))
+ (call-next-method))
+
+) ; eval-when
+
+(defclass credit-rating ()
+ ((level :attributes (date-set time-set) :accessor level)
+ (desc :accessor desc))
+ (:metaclass attributes-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/inventories/20070421193107-dccf3-e9d51ab58efdffe18510bddafbfa450f276c224f.gz
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/inventories/20070421193107-dccf3-e9d51ab58efdffe18510bddafbfa450f276c224f.gz 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/inventories/20070421193107-dccf3-e9d51ab58efdffe18510bddafbfa450f276c224f.gz 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,239 @@
+[Initial revision (v0.2).
+pc(a)p-cos.net**20050802151239]
+[Class initialization patches.
+pc(a)p-cos.net**20050816144718
+ The correction of lists of direct superclasses was done at the wrong place (in :around methods on initialize-instance and reinitialize-instance). The MOP specification doesn't allow to define primary methods for initialize-instance and reinitialize-instance, but these are the only places where those lists can be corrected in a reasonable way. This affects LispWorks and MCL.
+
+ Further changes:
+ - The typep implementation for MCL was incorrect.
+ - reinitialize-instance for standard-class could be simplified.
+ - reinitialize-instance for standard-generic-function could be simplified.
+]
+[Class initialization patch.
+pc(a)p-cos.net**20050816231151
+ The previous patch was partially incorrect. LispWorks and MCL don't need the change of the direct superclasses in primary methods on initialize-instance / reinitialize-instance. I have rearranged that part of the code back to what it was before.
+]
+[Checked with new versions of CLisp and SBCL.
+pc(a)p-cos.net**20050904001359]
+[Removed spurious &allow-other-keys declarations.
+pc(a)p-cos.net**20050910092744]
+[Minor edit.
+pc(a)p-cos.net**20050910103331]
+[Special cased defmethod macro for LispWorks.
+pc(a)p-cos.net**20050910110130
+
+ The defmethod macro in LispWorks (i.e., the new definition in closer-mop) now checks whether only the default methods for make-method-lambda are applicable. If so, defmethod expands into an equivalent cl:defmethod form. This is a workaround to make keyword argument checking for standard generic functions work.
+
+]
+[Changes triggered by Christophe Rhodes / SBCL.
+pc(a)p-cos.net**20051029013651]
+[Documentation update.
+pc(a)p-cos.net**20051029115614]
+[Supports OpenMCL 1.0 - no changes necessary.
+pc(a)p-cos.net**20051029224040]
+[Checked against LispWorks 4.4.6 - no changes.
+pc(a)p-cos.net**20051103084956]
+[Added reports for lack of extensible :allocation types.
+pc(a)p-cos.net**20051105150436
+
+ See MOP Feature Tests for more details.
+
+]
+[Rewired slot access protocol for slot-boundp-using-class and slot-makunbound-using-class in Allegro.
+pc(a)p-cos.net**20051117200922]
+[Updated reports on supported/fixed features and release notes.
+pc(a)p-cos.net**20051117201142]
+[CMUCL 19c now supports the dependent protocol correctly, so the corresponding fixes could be removed.
+pc(a)p-cos.net**20051117201252]
+[Added support for SBCL 0.9.7.
+pc(a)p-cos.net**20051130202445]
+[Checked against clisp 2.36.
+pc(a)p-cos.net**20051205134118]
+[Switched to symbols in the asdf definition.
+pc(a)p-cos.net**20051220162014]
+[Checked against SBCL 0.9.8.
+pc(a)p-cos.net**20051228150237]
+[Checked against clisp 2.37.
+pc(a)p-cos.net**20060103112938]
+[Fixed lack of extensible allocation kinds in Allegro Common Lisp.
+pc(a)p-cos.net**20060119133808]
+[Support for Allegro Common Lisp 8.0 added. (8.0b removed.)
+pc(a)p-cos.net**20060119133914]
+[TAG 0.3
+pc(a)p-cos.net**20060119202553]
+[Fixed a bug in the loop form for some implementations of ensure-method.
+pc(a)p-cos.net**20060127142634]
+[Checked against clisp 2.38 and SBCL 0.9.9.
+pc(a)p-cos.net**20060127142903]
+[Replaced programmatic implementation of ensure-method in CMUCL and SBCL.
+pc(a)p-cos.net**20060127142950
+
+ In CMUCL and SBCL, ensure-method was implemented as proposed in AMOP. However in some cases, this seems to lead to problems with method combination. For the time being, I have replaced the implementation by using a generated defmethod form instead, like in some of the other CL implementations. (In SBCL, this isn't as straightforward because SBCL doesn't accept class metaobjects as specializers.)
+]
+[Added a utility function required-args.
+pc(a)p-cos.net**20060127214635]
+[Documented the results of the more detailed checks for metaobject readers in MOP Feature Tests.
+pc(a)p-cos.net**20060201000120]
+[The function documentation now returns the documentation strings for slot definition metaobjects in OpenMCL.
+pc(a)p-cos.net**20060201000253]
+[The function documentation now returns the documentation strings for effective slot definition metaobjects in CMUCL.
+pc(a)p-cos.net**20060201000433]
+[Finalized the separate release notes.
+pc(a)p-cos.net**20060201000511]
+[TAG 0.31
+pc(a)p-cos.net**20060203120853]
+[Added reports about the results of the tests whether subclasses of specified metaobject classes inherit any exported slots. See MOP Feature Tests for more details.
+pc(a)p-cos.net**20060211193158]
+[Changed system def to handle ASDF-Install bug
+Gary King <gwking(a)metabang.com>**20051216174627]
+[Updated system defs because MCL is disappearing from OpenMCL's features list
+Gary King <gwking(a)metabang.com>**20060216145216]
+[Removed a conflict between Gary's and my code.
+pc(a)p-cos.net**20060224212121]
+[Updated more code to reflect the disappearance of MCL from OpenMCL's feature list
+pc(a)p-cos.net**20060224212657]
+[Checked against SBCL 0.9.10 - no changes, except for a few specified metaclass that don't define slots with exported symbols anymore.
+pc(a)p-cos.net**20060301115916]
+[Updated the version number and copyright information in the system definition.
+pc(a)p-cos.net**20060301200956]
+[Removed a superfluous export from clisp's c2mop.
+pc(a)p-cos.net**20060302093912]
+[Recorded the results from running MOP Feature Tests on ECL.
+pc(a)p-cos.net**20060325171005]
+[Checked against SBCL 0.9.11. SBCL is now safe from making subclasses of specified metaobject classes inherit slots that they shouldn't see.
+pc(a)p-cos.net**20060327120633]
+[Checked againts SBCL 0.9.12 - no changes.
+pc(a)p-cos.net**20060427163929]
+[Added support for ecl.
+pc(a)p-cos.net**20060501082945]
+[Checked against SBCL 0.9.13 - no changes.
+pc(a)p-cos.net**20060529180600]
+[Added the standard accessor classes to ecl.
+pc(a)p-cos.net**20060531202150]
+[Changed a slot name in the class eql-specializer* in LispWorks that was previously accessible in commen-lisp-user.
+pc(a)p-cos.net**20060531203220]
+[Checked against sbcl 0.9.14 - no changes.
+pc(a)p-cos.net**20060629175352]
+[MCL and OpenMCL don't reinitialize argument-precedence-order properly when a lambda list of a generic function is reinitialized.
+pc(a)p-cos.net**20060711121904]
+[Updated the reports for :reinitialize-instance-calls-finalize-inheritance. See MOP Feature Tests for more details.
+pc(a)p-cos.net**20060720085220]
+[Added a new utility function ensure-finalized.
+pc(a)p-cos.net**20060720105100
+
+ A pretty common idiom is this:
+
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ class
+
+ This is captured in the new utility function ensure-finalized.
+
+]
+[Checked against clisp 2.39 - no changes.
+pc(a)p-cos.net**20060720105302]
+[Updated report for :reinitialize-instance-calls-finalize-inheritance.
+pc(a)p-cos.net**20060721125623]
+[TAG 0.32
+pc(a)p-cos.net**20060729125750]
+[Checked against sbcl 0.9.15 - several changes.
+pc(a)p-cos.net**20060729134152
+
+ SBCL 0.9.15 now has support for anonymous classes and correctly calls finalize-inheritance when reinitialize-instance is invoked on a class metaobject.
+
+ This makes several changes necessary in the Closer to MOP support for SBCL. Therefore, support for versions of SBCL before 0.9.15 is dropped. The darcs repository has been tagged with '0.32' in case you need a version that works on older SBCL versions, up to and including SBCL 0.9.14.
+
+]
+[SBCL 0.9.15 now correctly supports typep and subtypep for class metaobjects, so Closer to MOP's versions thereof are not needed anymore.
+pc(a)p-cos.net**20060729134711]
+[Class metaobjects in SBCL can be anonymous now, so we don't have to force a generated name.
+pc(a)p-cos.net**20060729134940]
+[Removed a spurious call to print.
+pc(a)p-cos.net**20060729135119]
+[SBCL now supports class metaobjects in specializers in defmethod forms, so we don't have to replace them with their names.
+pc(a)p-cos.net**20060729135149]
+[Noted support for clisp 2.39.
+pc(a)p-cos.net**20060729135435]
+[Fixed features.txt: it still claimed that SBCL had a problem with calling finalize-inheritance again.
+pc(a)p-cos.net**20060802122101]
+[Removed a spurious in-package declaration in the .asd file.
+pc(a)p-cos.net**20060821203834]
+[TAG 0.33
+pc(a)p-cos.net**20060826084425]
+[Checked against sbcl 0.9.16 - several changes.
+pc(a)p-cos.net**20060826103957
+
+ SBCL 0.9.16 now passes all MOP Feature Tests.
+
+ This makes several changes necessary in the Closer to MOP support for SBCL, again. Therefore, support for SBCL 0.9.15 is dropped. The darcs repository has been tagged with '0.33' in case you need a version that works with SBCL 0.9.15.
+
+]
+[TAG 0.4
+pc(a)p-cos.net**20060826124935]
+[Updated version number in the .asd file.
+pc(a)p-cos.net**20060826130127]
+[Checked against SBCL 0.9.17 - no changes.
+pc(a)p-cos.net**20060927161258]
+[Checked against clisp 2.40. REINITIALIZE-INSTANCE now calls FINALIZE-INHERITANCE correctly in clisp.
+pc(a)p-cos.net**20061001221204]
+[Fixed a problem in the handling of initial-methods in LispWorks.
+pc(a)p-cos.net**20061010173021]
+[Fixed another issue with initial-methods in LispWorks.
+pc(a)p-cos.net**20061010174147]
+[Checked against clisp 2.41 - no changes.
+pc(a)p-cos.net**20061013081525]
+[Added support for LispWorks 5.0 - numerous changes.
+pc(a)p-cos.net**20061014113836]
+[Fixed a bug in some (loop var on list ...) idioms. Thanks to Attila Lendvai.
+pc(a)p-cos.net**20061028113627]
+[Checked against sbcl 0.9.18 - no changes.
+pc(a)p-cos.net**20061031090315]
+[Checked against CMU 19d - no changes.
+pc(a)p-cos.net**20061116132730]
+[Checked against SBCL 1.0. Modified ensure-method for SBCL.
+pc(a)p-cos.net**20061130202814
+
+ The programmatic version of ensure-method in SBCL has problems again. Therefore, it is replaced with a version that evaluates a defmethod form for the time being.
+]
+[Noted support for SBCL 1.0.
+pc(a)p-cos.net**20061130203424]
+[Checked against LispWorks 5.0.1. No changes.
+pc(a)p-cos.net**20061218222443]
+[Noted support for SBCL 1.0.
+pc(a)p-cos.net**20061218222546]
+[Checked against SBCL 1.0.1. Reinstated the former ensure-method implementation for SBCL.
+pc(a)p-cos.net**20061227142245]
+[Simplified the implementation of some validate-superclass methods. (Reduced consing.)
+pc(a)p-cos.net**20061228002510]
+[Exported set-funcallable-instance-function in ecl and OpenMCL.
+pc(a)p-cos.net**20061228002726]
+[Changed the format of the contents of features.lisp. Better support for comparing feature changes between different versions of a given CL implementation.
+pc(a)p-cos.net**20061228002856]
+[Corrected and added a few feature reports to features.txt.
+pc(a)p-cos.net**20061228003007]
+[Updated version number in the .asd file.
+pc(a)p-cos.net**20061228151904]
+[TAG 0.41
+pc(a)p-cos.net**20061228151916]
+[Noted lack of use of FUNCALLABLE-STANDARD-OBJECT as the default superclass for FUNCALLABLE-STANDARD-CLASS in Allegro Common Lisp.
+pc(a)p-cos.net**20061228161029]
+[Noted support for SBCL 1.0.1.
+pc(a)p-cos.net**20061228161128]
+[Checked against SBCL 1.0.2 - no changes.
+pc(a)p-cos.net**20070127192325]
+[Noted support for SBCL 1.0.1 and 1.0.2.
+pc(a)p-cos.net**20070127192925]
+[Checked against LispWorks 5.0.1 Personal Edition - no changes.
+pc(a)p-cos.net**20070127195002]
+[Fixed a typo in the SBCL version numbers.
+pc(a)p-cos.net**20070127201814]
+[Fixed a bug in the creation of congruent lambda lists for generic functions in c2mop for LispWorks.
+pc(a)p-cos.net**20070206104737]
+[Checked against SBCL 1.0.3 - no changes.
+pc(a)p-cos.net**20070228193530]
+[Checked against SBCL 1.0.4 - no changes.
+pc(a)p-cos.net**20070327202949]
+[Checked against LispWorks 5.0.2 - no changes.
+pc(a)p-cos.net**20070421192516]
+[Incremented version number to 0.42.
+pc(a)p-cos.net**20070421193020]
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/inventory
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/inventory 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/inventory 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,21 @@
+Starting with tag:
+[TAG 0.42
+pc(a)p-cos.net**20070421193107]
+[Checked against SBCL 1.0.5 - no changes.
+pc(a)p-cos.net**20070501115057]
+[Checked against SBCL 1.0.6 - no changes.
+pc(a)p-cos.net**20070528145132]
+[Checked against SBCL 1.0.7 - no changes.
+pc(a)p-cos.net**20070628201619]
+[Checked against SBCL 1.0.8 and 1.0.9 - no changes.
+pc(a)p-cos.net**20070831233438]
+[Fixed a copy&paste bug in the description for funcallable instances for MCL and OpenMCL.
+pc(a)p-cos.net**20070916181018]
+[Checked against SBCL 1.0.10 - no changes.
+pc(a)p-cos.net**20070926164316]
+[Checked against Allegro 8.1. Dropped fix for SLOT-BOUNDP-USING-CLASS for that version.
+pc(a)p-cos.net**20070926172622
+
+ SLOT-BOUNDP-USING-CLASS now works correctly by default in Allegro 8.1.
+
+]
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050802151239-dccf3-e268d42f1d0bfb9c7ef64135393a2f63b243ed54.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050802151239-dccf3-e268d42f1d0bfb9c7ef64135393a2f63b243ed54.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050816144718-dccf3-c8e542ff6d11161f8c50c8595710590711c6732b.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050816144718-dccf3-c8e542ff6d11161f8c50c8595710590711c6732b.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050816231151-dccf3-e3829cce37824704fb39f3cafdc3c6a92f2d3cf3.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050816231151-dccf3-e3829cce37824704fb39f3cafdc3c6a92f2d3cf3.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050904001359-dccf3-914880d9d7054a58ddf886f661065a9352df6e08.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050904001359-dccf3-914880d9d7054a58ddf886f661065a9352df6e08.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050910092744-dccf3-87b02abfabbf534e03e82a45a96521a1d7c7a3b2.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050910092744-dccf3-87b02abfabbf534e03e82a45a96521a1d7c7a3b2.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050910103331-dccf3-6311e556632ec0e01cc952b75171e77536716c0c.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050910103331-dccf3-6311e556632ec0e01cc952b75171e77536716c0c.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050910110130-dccf3-c6296b87c9e0e39bf7e938444dbd278fbba606c3.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20050910110130-dccf3-c6296b87c9e0e39bf7e938444dbd278fbba606c3.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051029013651-dccf3-b4be9c6147a26c1e9767e9951f49aee2c898655b.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051029013651-dccf3-b4be9c6147a26c1e9767e9951f49aee2c898655b.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051029115614-dccf3-65351c2ca451aceaa696ac89c9c8223199afae00.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051029115614-dccf3-65351c2ca451aceaa696ac89c9c8223199afae00.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051029224040-dccf3-98657977f7a5a7dc1dce7fc2b536413116b1e9cb.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051029224040-dccf3-98657977f7a5a7dc1dce7fc2b536413116b1e9cb.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051103084956-dccf3-bc5ad826d6d0c656f1e9f7af023c238ad5a5fade.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051103084956-dccf3-bc5ad826d6d0c656f1e9f7af023c238ad5a5fade.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051105150436-dccf3-42c062a8ce5e51a74d47911cbf0aed17761f25d3.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051105150436-dccf3-42c062a8ce5e51a74d47911cbf0aed17761f25d3.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051117200922-dccf3-2a2e5386869e5788124740a6796aa8d93fe88a07.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051117200922-dccf3-2a2e5386869e5788124740a6796aa8d93fe88a07.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051117201142-dccf3-2700459573f278c02078ef40150f7d92fcb4ed5a.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051117201142-dccf3-2700459573f278c02078ef40150f7d92fcb4ed5a.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051117201252-dccf3-5469d4a6ff03e37238daa28708a8727f2f88fdd9.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051117201252-dccf3-5469d4a6ff03e37238daa28708a8727f2f88fdd9.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051130202445-dccf3-d3d97662bf9052129efdf34c4af8cb75d437eb27.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051130202445-dccf3-d3d97662bf9052129efdf34c4af8cb75d437eb27.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051205134118-dccf3-8045f8a6023f1067bf862213cd46cd07363ce091.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051205134118-dccf3-8045f8a6023f1067bf862213cd46cd07363ce091.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051216174627-3cc5d-3c778eca546a1cdb364885cd436fc275f71cb71e.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051216174627-3cc5d-3c778eca546a1cdb364885cd436fc275f71cb71e.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051220162014-dccf3-5541c25791f62d836e27802984f53014e2cfc72e.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051220162014-dccf3-5541c25791f62d836e27802984f53014e2cfc72e.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051228150237-dccf3-fc2c4ab8e8c0798d200109ffc20b79259c28258c.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20051228150237-dccf3-fc2c4ab8e8c0798d200109ffc20b79259c28258c.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060103112938-dccf3-2f91b0e195aba3b348283c9c21f36d356db9d32b.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060103112938-dccf3-2f91b0e195aba3b348283c9c21f36d356db9d32b.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060119133808-dccf3-905164dbf83a727c6875e534c8afc7712adde1e2.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060119133808-dccf3-905164dbf83a727c6875e534c8afc7712adde1e2.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060119133914-dccf3-df1b6582ea4210cf1a697b8c75238342e465d444.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060119133914-dccf3-df1b6582ea4210cf1a697b8c75238342e465d444.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060119202553-dccf3-9e87c4d4d342a8a7fe01167b143ed5e67a08fa8c.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060119202553-dccf3-9e87c4d4d342a8a7fe01167b143ed5e67a08fa8c.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127142634-dccf3-0cbc9730e904db90c5598f37d28ed2a5d01e8060.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127142634-dccf3-0cbc9730e904db90c5598f37d28ed2a5d01e8060.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127142903-dccf3-114489c1437896299eba5cb5e1abcdcee3588f4d.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127142903-dccf3-114489c1437896299eba5cb5e1abcdcee3588f4d.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127142950-dccf3-a9161a505f3d6fc1376d2e9d065da70c59ec99e2.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127142950-dccf3-a9161a505f3d6fc1376d2e9d065da70c59ec99e2.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127214635-dccf3-a6d51c1d634b093f9403635cb3ec6230bba703b1.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060127214635-dccf3-a6d51c1d634b093f9403635cb3ec6230bba703b1.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000120-dccf3-b4333796ffe0fe6f5c99603b29cc995508b8dcae.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000120-dccf3-b4333796ffe0fe6f5c99603b29cc995508b8dcae.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000253-dccf3-6886af50a43d5a624a196f587acf8ef183c6946d.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000253-dccf3-6886af50a43d5a624a196f587acf8ef183c6946d.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000433-dccf3-825ddee7bae9c308010ec376b13fe5d4038687d5.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000433-dccf3-825ddee7bae9c308010ec376b13fe5d4038687d5.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000511-dccf3-b67c903a0922806dde28834fef9548e1a19450df.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060201000511-dccf3-b67c903a0922806dde28834fef9548e1a19450df.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060203120853-dccf3-d772fe3f3f39f4c7114b18ba7dd1ce5c4eaf1896.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060203120853-dccf3-d772fe3f3f39f4c7114b18ba7dd1ce5c4eaf1896.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060211193158-dccf3-4534d4b849a303f855c692e41232ca1db1c18614.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060211193158-dccf3-4534d4b849a303f855c692e41232ca1db1c18614.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060216145216-3cc5d-508513582f98be0b13ac28491b590ae926133b98.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060216145216-3cc5d-508513582f98be0b13ac28491b590ae926133b98.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060224212121-dccf3-4e71a819e03eb87e7e41b8bbb88758857ff26099.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060224212121-dccf3-4e71a819e03eb87e7e41b8bbb88758857ff26099.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060224212657-dccf3-068ab07c914a910ead2cf314711aec15c95b3f47.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060224212657-dccf3-068ab07c914a910ead2cf314711aec15c95b3f47.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060301115916-dccf3-319e857c38bf42decd2c98fc3df4208011590dd2.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060301115916-dccf3-319e857c38bf42decd2c98fc3df4208011590dd2.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060301200956-dccf3-d0315e6cf06746cfa4d2f9aae97af7ff6b95f979.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060301200956-dccf3-d0315e6cf06746cfa4d2f9aae97af7ff6b95f979.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060302093912-dccf3-77419535e33067767884542db7d015cfccb3ac61.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060302093912-dccf3-77419535e33067767884542db7d015cfccb3ac61.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060325171005-dccf3-c26bf0552b60f9e02107614b0fd23b84650b82c6.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060325171005-dccf3-c26bf0552b60f9e02107614b0fd23b84650b82c6.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060327120633-dccf3-c7f73a665f3f8fcd0d666ae7a08eaa1d586e6be5.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060327120633-dccf3-c7f73a665f3f8fcd0d666ae7a08eaa1d586e6be5.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060427163929-dccf3-7c2b0e9aa58e3f5a27375162e099f2c8451137ca.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060427163929-dccf3-7c2b0e9aa58e3f5a27375162e099f2c8451137ca.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060501082945-dccf3-f330509c7bf886ad34c63a9fa7386a0a458b34ac.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060501082945-dccf3-f330509c7bf886ad34c63a9fa7386a0a458b34ac.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060529180600-dccf3-62cfd9621e1802d45cd4459d96f367f7a10b5ca1.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060529180600-dccf3-62cfd9621e1802d45cd4459d96f367f7a10b5ca1.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060531202150-dccf3-686d5ba89231851614891f21e29033003105888d.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060531202150-dccf3-686d5ba89231851614891f21e29033003105888d.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060531203220-dccf3-32e3cf5199ceaf2d34b7b9ed3732e923b6a6de53.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060531203220-dccf3-32e3cf5199ceaf2d34b7b9ed3732e923b6a6de53.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060629175352-dccf3-2a287976284aa6a523d7918f4747cf593174ebe7.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060629175352-dccf3-2a287976284aa6a523d7918f4747cf593174ebe7.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060711121904-dccf3-e427b977f9fa61ac7615b3f9266b3c09f6ab394c.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060711121904-dccf3-e427b977f9fa61ac7615b3f9266b3c09f6ab394c.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060720085220-dccf3-8733e01e9790f1929009378878359e13931ff231.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060720085220-dccf3-8733e01e9790f1929009378878359e13931ff231.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060720105100-dccf3-7d147f9c086e13bd2b83e670953ac124ec7dcb27.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060720105100-dccf3-7d147f9c086e13bd2b83e670953ac124ec7dcb27.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060720105302-dccf3-70b8a60a40352e9ffa430467b36b41d9e785561b.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060720105302-dccf3-70b8a60a40352e9ffa430467b36b41d9e785561b.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060721125623-dccf3-c9a6e3c8ab13d7545401922436152ef6039f35b8.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060721125623-dccf3-c9a6e3c8ab13d7545401922436152ef6039f35b8.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729125750-dccf3-677f12862b02fb3e369b3855c7a82fc9c9f07e28.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729125750-dccf3-677f12862b02fb3e369b3855c7a82fc9c9f07e28.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729134152-dccf3-ee40ebb2ef710ff23053b2765dfd8f5e5adeeb5b.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729134152-dccf3-ee40ebb2ef710ff23053b2765dfd8f5e5adeeb5b.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729134711-dccf3-dbcf08303fe3f2e8ad195382c90e88cb5fa0fda7.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729134711-dccf3-dbcf08303fe3f2e8ad195382c90e88cb5fa0fda7.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729134940-dccf3-c4c1848e22a3d8293090441fd1a1b39670067107.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729134940-dccf3-c4c1848e22a3d8293090441fd1a1b39670067107.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729135119-dccf3-62cbac84437b668d5c7b4222d3ffcd9b743a2067.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729135119-dccf3-62cbac84437b668d5c7b4222d3ffcd9b743a2067.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729135149-dccf3-615006dc944f3c9c6e15b57467e597f67a40ad77.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729135149-dccf3-615006dc944f3c9c6e15b57467e597f67a40ad77.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729135435-dccf3-a6554658258dcdada3b08ad08e6dd17657c7c974.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060729135435-dccf3-a6554658258dcdada3b08ad08e6dd17657c7c974.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060802122101-dccf3-c0ae6510f6436c0fb88bb5ff92a25c9ae529ad17.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060802122101-dccf3-c0ae6510f6436c0fb88bb5ff92a25c9ae529ad17.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060821203834-dccf3-d6305a3e3412ff99beace007948dafc3100e1d6e.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060821203834-dccf3-d6305a3e3412ff99beace007948dafc3100e1d6e.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826084425-dccf3-1cb35238f9645cd1d5d4e477a9234fc583e0dc6f.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826084425-dccf3-1cb35238f9645cd1d5d4e477a9234fc583e0dc6f.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826103957-dccf3-4bfdc272ae29918f08b54d0bdc14fed29b443814.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826103957-dccf3-4bfdc272ae29918f08b54d0bdc14fed29b443814.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826124935-dccf3-2a4546691b80a18783c5421d46ac3d72a2c252fb.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826124935-dccf3-2a4546691b80a18783c5421d46ac3d72a2c252fb.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826130127-dccf3-eec66c0522b0ab74d72bfdd61250f0ffaae584c6.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060826130127-dccf3-eec66c0522b0ab74d72bfdd61250f0ffaae584c6.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060927161258-dccf3-649ad24438070167a2f0100bb9b8f62601147f6d.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20060927161258-dccf3-649ad24438070167a2f0100bb9b8f62601147f6d.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061001221204-dccf3-56ed441636d15f7f23de7b76b6be8222fb9b67f8.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061001221204-dccf3-56ed441636d15f7f23de7b76b6be8222fb9b67f8.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061010173021-dccf3-159ee4ddbabc437a75ebf561e3301e92327dadf2.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061010173021-dccf3-159ee4ddbabc437a75ebf561e3301e92327dadf2.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061010174147-dccf3-d08093855647506dfbfe1c8263a3555f7a08541a.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061010174147-dccf3-d08093855647506dfbfe1c8263a3555f7a08541a.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061013081525-dccf3-fe4c6c81952c166149c00b1fe0df0834743ea370.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061013081525-dccf3-fe4c6c81952c166149c00b1fe0df0834743ea370.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061014113836-dccf3-f117c253f5ab3d478f32c411f076a5b9d90f28be.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061014113836-dccf3-f117c253f5ab3d478f32c411f076a5b9d90f28be.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061028113627-dccf3-5f62832804d6c3dc544bd00341a7551fce46af78.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061028113627-dccf3-5f62832804d6c3dc544bd00341a7551fce46af78.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061031090315-dccf3-42d2030266347debf49e4bf88a13abdcffb4eac1.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061031090315-dccf3-42d2030266347debf49e4bf88a13abdcffb4eac1.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061116132730-dccf3-e92c87581e04f60c7a029bbe6d7cdd6958319ff7.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061116132730-dccf3-e92c87581e04f60c7a029bbe6d7cdd6958319ff7.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061130202814-dccf3-3120d1936aca4182a1f8fd2e9076e84e1404d7d5.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061130202814-dccf3-3120d1936aca4182a1f8fd2e9076e84e1404d7d5.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061130203424-dccf3-74301ed5df59c70046119acac59c5ceef0c00ecf.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061130203424-dccf3-74301ed5df59c70046119acac59c5ceef0c00ecf.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061218222443-dccf3-edde41dbcc6152e160bfc02201985e577adc11b0.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061218222443-dccf3-edde41dbcc6152e160bfc02201985e577adc11b0.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061218222546-dccf3-81a4963703b080a4230de18285fcc7f4f8f076a8.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061218222546-dccf3-81a4963703b080a4230de18285fcc7f4f8f076a8.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061227142245-dccf3-9eee2aa05227bdf4f4eeaf45e58c845a4707ffff.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061227142245-dccf3-9eee2aa05227bdf4f4eeaf45e58c845a4707ffff.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228002510-dccf3-163cba8d0d6e4c7548bcac17463887b52d482b11.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228002510-dccf3-163cba8d0d6e4c7548bcac17463887b52d482b11.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228002726-dccf3-2abe813153b4868c6219d045cba84119bbe37b62.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228002726-dccf3-2abe813153b4868c6219d045cba84119bbe37b62.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228002856-dccf3-af055d64a95a072906b14cf1713d04f171fae53d.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228002856-dccf3-af055d64a95a072906b14cf1713d04f171fae53d.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228003007-dccf3-19d3d52b67d6752806ade229cc573df39fefd736.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228003007-dccf3-19d3d52b67d6752806ade229cc573df39fefd736.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228151904-dccf3-ef3232d3763a7a5fcfd18bd92b289590e8dfbb77.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228151904-dccf3-ef3232d3763a7a5fcfd18bd92b289590e8dfbb77.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228151916-dccf3-82758310329d2019305d44c787c6ff559720c202.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228151916-dccf3-82758310329d2019305d44c787c6ff559720c202.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228161029-dccf3-89435e9661c27dc9251269f3e035574cce8ccc6b.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228161029-dccf3-89435e9661c27dc9251269f3e035574cce8ccc6b.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228161128-dccf3-0adc1e659006165544e9d15583841f321aca1b4e.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20061228161128-dccf3-0adc1e659006165544e9d15583841f321aca1b4e.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127192325-dccf3-d77060b4d6264e601b0a0456c59bc0f9b6b39d42.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127192325-dccf3-d77060b4d6264e601b0a0456c59bc0f9b6b39d42.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127192925-dccf3-0f0f5a0c26d9089334b2f54ae13cea2ddc4cd881.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127192925-dccf3-0f0f5a0c26d9089334b2f54ae13cea2ddc4cd881.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127195002-dccf3-314892775fb8ae67ee688777168326daba80b565.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127195002-dccf3-314892775fb8ae67ee688777168326daba80b565.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127201814-dccf3-128f7776110f2b6673a72a9e5c97d3a090cd028f.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070127201814-dccf3-128f7776110f2b6673a72a9e5c97d3a090cd028f.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070206104737-dccf3-e8605c338153ef4cfca23e2691bdbd8220ed9c17.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070206104737-dccf3-e8605c338153ef4cfca23e2691bdbd8220ed9c17.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070228193530-dccf3-b0fe50e904a9f06b680ab19c79d5e375c45bb4e1.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070228193530-dccf3-b0fe50e904a9f06b680ab19c79d5e375c45bb4e1.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070327202949-dccf3-77b1abaa2cd6661419f04d3c1422ee0e4970e2d5.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070327202949-dccf3-77b1abaa2cd6661419f04d3c1422ee0e4970e2d5.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070421192516-dccf3-13d712262e80609ffa3e44656a11ddf1eb8c5ba2.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070421192516-dccf3-13d712262e80609ffa3e44656a11ddf1eb8c5ba2.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070421193020-dccf3-46cccd00d206b252681348edde6d08b9f8c12744.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070421193020-dccf3-46cccd00d206b252681348edde6d08b9f8c12744.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070421193107-dccf3-e9d51ab58efdffe18510bddafbfa450f276c224f.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070421193107-dccf3-e9d51ab58efdffe18510bddafbfa450f276c224f.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070501115057-dccf3-fd3901cf565e463eddafaf82e6f526d9403f5f29.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070501115057-dccf3-fd3901cf565e463eddafaf82e6f526d9403f5f29.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070528145132-dccf3-e1d978c1cd424af7cfabb1d036d07a10a7a4ed62.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070528145132-dccf3-e1d978c1cd424af7cfabb1d036d07a10a7a4ed62.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070628201619-dccf3-6697990e3daa875937fba6209b49f9700ce5f98f.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070628201619-dccf3-6697990e3daa875937fba6209b49f9700ce5f98f.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070831233438-dccf3-551d9afcedf44d0735b330c50be407619f4cb8e0.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070831233438-dccf3-551d9afcedf44d0735b330c50be407619f4cb8e0.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070916181018-dccf3-e11c738d92d8e1b2dbc979a10f258a647e164022.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070916181018-dccf3-e11c738d92d8e1b2dbc979a10f258a647e164022.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070926164316-dccf3-0399c8966f70466f0bb3f1abd28f14b7698f542f.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070926164316-dccf3-0399c8966f70466f0bb3f1abd28f14b7698f542f.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070926172622-dccf3-0c2318248afb60197e6986c33794e0f97e43cfa2.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/closer-mop/_darcs/patches/20070926172622-dccf3-0c2318248afb60197e6986c33794e0f97e43cfa2.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/binaries
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/binaries 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/binaries 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,39 @@
+# Binary file regexps:
+\.png$
+\.PNG$
+\.gz$
+\.GZ$
+\.pdf$
+\.PDF$
+\.jpg$
+\.JPG$
+\.gif$
+\.GIF$
+\.tar$
+\.TAR$
+\.bz2$
+\.BZ2$
+\.z$
+\.Z$
+\.zip$
+\.ZIP$
+\.jar$
+\.JAR$
+\.so$
+\.SO$
+\.a$
+\.A$
+\.tgz$
+\.TGZ$
+\.jpeg$
+\.JPEG$
+\.mpg$
+\.MPG$
+\.mpeg$
+\.MPEG$
+\.iso$
+\.ISO$
+\.exe$
+\.EXE$
+\.doc$
+\.DOC$
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/boring
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/boring 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/boring 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,34 @@
+# Boring file regexps:
+\.hi$
+\.o$
+\.o\.cmd$
+# *.ko files aren't boring by default because they might
+# be Korean translations rather than kernel modules.
+# \.ko$
+\.ko\.cmd$
+\.mod\.c$
+(^|/)\.tmp_versions($|/)
+(^|/)CVS($|/)
+(^|/)RCS($|/)
+~$
+#(^|/)\.[^/]
+(^|/)_darcs($|/)
+\.bak$
+\.BAK$
+\.orig$
+(^|/)vssver\.scc$
+\.swp$
+(^|/)MT($|/)
+(^|/)\{arch\}($|/)
+(^|/).arch-ids($|/)
+(^|/),
+\.class$
+\.prof$
+(^|/)\.DS_Store$
+(^|/)BitKeeper($|/)
+(^|/)ChangeSet($|/)
+(^|/)\.svn($|/)
+\.py[co]$
+\#
+\.cvsignore$
+(^|/)Thumbs\.db$
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/defaultrepo
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/defaultrepo 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/defaultrepo 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1 @@
+http://common-lisp.net/project/closer/repos/closer-mop
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/motd
===================================================================
Added: branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/repos
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/repos 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/_darcs/prefs/repos 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1 @@
+http://common-lisp.net/project/closer/repos/closer-mop
Added: branches/trunk-reorg/thirdparty/closer-mop/allegro/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/allegro/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/allegro/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,190 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ (:shadow
+ #:defclass #:defgeneric #:ensure-generic-function
+ #:standard-class #:standard-generic-function)
+ (:export
+ #:defclass #:defgeneric #:ensure-generic-function
+ #:standard-class #:standard-generic-function)
+
+ (:import-from #:mop
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-allegro #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-allegro #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/allegro/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/allegro/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/allegro/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,197 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+;; We need a new standard-class for various things.
+
+(cl:defclass standard-class (cl:standard-class)
+ ((valid-slot-allocations :initform '(:instance :class)
+ :accessor valid-slot-allocations
+ :reader excl::valid-slot-allocation-list)))
+
+;; validate-superclass for metaclass classes is a little bit
+;; more tricky than for class metaobject classes because
+;; we don't want to make all standard-classes compatible to
+;; each other.
+
+;; Our validate-superclass may get passed a class-prototype
+;; as its second argument, so don't expect its readers to
+;; yield useful information. (In ANSI parlance, "the
+;; consequences are undefined...")
+
+(cl:defmethod validate-superclass
+ ((class standard-class)
+ (superclass cl:standard-class))
+ (or (when (eq (class-of class) (find-class 'standard-class))
+ (or (eq (class-of superclass) (find-class 'cl:standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'cl:standard-class))
+ (validate-superclass class (class-prototype (find-class 'standard-class))))))
+
+;; The following macro ensures that the new standard-class is used by default.
+
+(defmacro defclass (name (&rest supers) &body options)
+ (if (member :metaclass options :key #'car)
+ `(cl:defclass ,name ,supers ,@options)
+ `(cl:defclass ,name ,supers ,@options
+ (:metaclass standard-class))))
+
+;; Allegro defines an extra check for :allocation kinds. AMOP expects any kind to be
+;; permissible, though. This is corrected here.
+
+(defmethod direct-slot-definition-class :before ((class standard-class) &key allocation &allow-other-keys)
+ (unless (eq (class-of class) (find-class 'standard-class))
+ (pushnew allocation (valid-slot-allocations class))))
+
+;;; In Allegro, slot-boundp-using-class and slot-makunbound-using-class are specialized
+;;; on slot names instead of effective slot definitions. In order to fix this,
+;;; we need to rewire the slot access protocol.
+
+#-(version>= 8 1)
+(progn
+ (cl:defmethod slot-boundp-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-boundp-using-class class object slotd)
+ (slot-missing class object slot 'slot-boundp))))
+
+ (cl:defmethod slot-boundp-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-boundp-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd))))
+
+(cl:defmethod slot-makunbound-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-makunbound-using-class class object slotd)
+ (slot-missing class object slot 'slot-makunbound))))
+
+(cl:defmethod slot-makunbound-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-makunbound-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd)))
+
+;; We need a new standard-generic-function for various things.
+
+(cl:defclass standard-generic-function (cl:standard-generic-function)
+ ()
+ (:metaclass clos:funcallable-standard-class))
+
+;; The following ensures that the new standard-generic-function is used.
+
+(defun ensure-generic-function
+ (name &rest args
+ &key (generic-function-class 'standard-generic-function)
+ &allow-other-keys)
+ (declare (dynamic-extent args))
+ (when (fboundp name)
+ (let ((function (fdefinition name)))
+ (unless (typep function 'generic-function)
+ (cerror "Discard existing definition and create generic function."
+ "~S is already fbound, but not as a generic function." name)
+ (fmakunbound name))))
+ (if (fboundp name)
+ (let ((function (fdefinition name)))
+ (apply #'ensure-generic-function-using-class
+ function name args))
+ (apply #'ensure-generic-function-using-class nil name
+ :generic-function-class generic-function-class
+ args)))
+
+;; The following macro ensures that the new standard-generic-function
+;; is used by default.
+
+(defmacro defgeneric (name (&rest args) &body options)
+ (if (member :generic-function-class options :key #'car)
+ `(cl:defgeneric ,name ,args ,@options)
+ `(cl:defgeneric ,name ,args ,@options
+ (:generic-function-class standard-generic-function))))
+
+;;; The following three methods ensure that the dependent protocol
+;;; for generic function works.
+
+;; The following method additionally ensures that
+;; compute-discriminating-function is triggered.
+
+(cl:defmethod reinitialize-instance :after
+ ((gf standard-generic-function) &rest initargs)
+ (declare (dynamic-extent initargs))
+ (set-funcallable-instance-function
+ gf (compute-discriminating-function gf))
+ (map-dependents
+ gf (lambda (dep) (apply #'update-dependent gf dep initargs))))
+
+(cl:defmethod add-method :after
+ ((gf standard-generic-function) method)
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'add-method method))))
+
+(cl:defmethod remove-method :after
+ ((gf standard-generic-function) method)
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'remove-method method))))
+
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (funcall (compile nil `(lambda ()
+ (defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ initargs)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/clisp/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/clisp/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/clisp/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,183 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ (:import-from #:clos
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-clisp #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-clisp #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/clisp/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/clisp/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/clisp/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,49 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly 't))))
+ (funcall (compile nil `(lambda ()
+ (defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ initargs)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/closer-mop-utility-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/closer-mop-utility-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/closer-mop-utility-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,18 @@
+(in-package :cl-user)
+
+(defpackage #:closer-common-lisp
+ (:nicknames #:c2cl)
+ (:use))
+
+(let ((syms (nunion (loop for sym being the external-symbols of :common-lisp
+ if (find-symbol (symbol-name sym) :c2mop)
+ collect it
+ else collect sym)
+ (loop for sym being the external-symbols of :c2mop
+ collect sym))))
+ (import syms :c2cl)
+ (export syms :c2cl))
+
+(defpackage #:closer-common-lisp-user
+ (:nicknames #:c2cl-user)
+ (:use #:closer-common-lisp))
Added: branches/trunk-reorg/thirdparty/closer-mop/closer-mop.asd
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/closer-mop.asd 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/closer-mop.asd 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,47 @@
+(asdf:defsystem #:closer-mop
+ :name "Closer to MOP"
+ :author "Pascal Costanza"
+ :version "0.42"
+ :licence "
+Copyright (c) 2005 - 2007 Pascal Costanza
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the \"Software\"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or
+sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+"
+ :depends-on (#-lispworks #:lw-compat)
+ :components
+ ((:module
+ #+allegro "allegro"
+ #+clisp "clisp"
+ #+ecl "ecl"
+ #+lispworks "lispworks"
+ #+(or mcl openmcl) "mcl"
+ #+(or cmu sbcl) "pcl"
+ :components ((:file "closer-mop-packages")
+ (:file "closer-mop"
+ :depends-on ("closer-mop-packages"))))
+ (:file "closer-mop-utility-packages"
+ :depends-on (#+allegro "allegro"
+ #+clisp "clisp"
+ #+ecl "ecl"
+ #+lispworks "lispworks"
+ #+(or mcl openmcl) "mcl"
+ #+(or cmu sbcl) "pcl"))))
Added: branches/trunk-reorg/thirdparty/closer-mop/ecl/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/ecl/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/ecl/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,190 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ (:shadow #:defgeneric #:ensure-generic-function #:find-method
+ #:remove-method #:standard-generic-function)
+ (:export #:defgeneric #:ensure-generic-function #:find-method
+ #:remove-method #:standard-generic-function)
+
+ (:import-from #:clos
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #-ecl #:eql-specializer
+ #:forward-referenced-class
+ #-ecl #:funcallable-standard-class
+ #-ecl #:funcallable-standard-object
+ #-ecl #:metaobject
+ #:slot-definition
+ #-ecl #:specializer
+ #-ecl #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #-ecl #:standard-reader-method
+ #:standard-slot-definition
+ #-ecl #:standard-writer-method
+
+ #-ecl #:accessor-method-slot-definition
+ #-ecl #:add-dependent
+ #-ecl #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-ecl #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #-ecl #:eql-specializer-object
+ #-ecl #:extract-lambda-list
+ #-ecl #:extract-specializer-names
+ #:finalize-inheritance
+ #-ecl #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #-ecl #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #-ecl #:intern-eql-specializer
+ #-ecl #:make-method-lambda
+ #-ecl #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #-ecl #:reader-method-class
+ #-ecl #:remove-dependent
+ #-ecl #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #-ecl #:specializer-direct-generic-functions
+ #-ecl #:specializer-direct-methods
+ #:standard-instance-access
+ #-ecl #:update-dependent
+ #-ecl #:validate-superclass
+ #-ecl #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #-ecl #:funcallable-standard-class
+ #-ecl #:funcallable-standard-object
+ #-ecl #:metaobject
+ #:slot-definition
+ #-ecl #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #-ecl #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-ecl #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:eql-specializer-object*
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #-ecl #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #-ecl #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #:intern-eql-specializer*
+ #-ecl #:make-method-lambda
+ #-ecl #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #-ecl #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #-ecl #:update-dependent
+ #-ecl #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/ecl/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/ecl/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/ecl/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,312 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+(defun extract-lambda-list (lambda-list)
+ (loop for (arg . rest) on lambda-list
+ until (member arg lambda-list-keywords)
+ if (consp arg)
+ collect (car arg) into args
+ else collect arg into args
+ finally (return (if arg
+ (nconc args (cons arg rest))
+ args))))
+
+(defun extract-specializer-names (lambda-list)
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ if (consp arg)
+ collect (cadr arg)
+ else collect 't))
+
+;; We need a new standard-generic-function for various things.
+
+(cl:defclass standard-generic-function (cl:standard-generic-function)
+ ())
+
+;; The following ensures that the new standard-generic-function is used.
+
+(defun ensure-generic-function
+ (name &rest args
+ &key (generic-function-class 'standard-generic-function)
+ &allow-other-keys)
+ (declare (dynamic-extent args))
+ (apply #'cl:ensure-generic-function name
+ :generic-function-class generic-function-class
+ args))
+
+#|
+(defun ensure-generic-function
+ (name &rest args
+ &key (generic-function-class 'standard-generic-function)
+ &allow-other-keys)
+ (declare (dynamic-extent args))
+ (when (fboundp name)
+ (let ((function (fdefinition name)))
+ (unless (typep function 'generic-function)
+ (cerror "Discard existing definition and create generic function."
+ "~S is already fbound, but not as a generic function." name)
+ (fmakunbound name))))
+ (if (fboundp name)
+ (let ((function (fdefinition name)))
+ (apply #'ensure-generic-function-using-class
+ function name args))
+ (apply #'ensure-generic-function-using-class nil name
+ :generic-function-class generic-function-class
+ args)))
+|#
+
+;; The standard accessor classes.
+
+(cl:defclass standard-accessor-method (standard-method)
+ ((slotd :initarg :slot-definition
+ :reader accessor-method-slot-definition)))
+
+(cl:defclass standard-reader-method (standard-accessor-method)
+ ())
+
+(cl:defclass standard-writer-method (standard-accessor-method)
+ ())
+
+;; In ECL, reader-method-class and writer-method-class are
+;; not used during class initialization. The following definitions
+;; correct this.
+
+(cl:defgeneric reader-method-class (class slot-definition &rest initargs)
+ (:method ((class class) slot-definition &rest initargs)
+ (declare (ignore slot-definition initargs))
+ (load-time-value (find-class 'standard-reader-method))))
+
+(cl:defgeneric writer-method-class (class slot-definition &rest initargs)
+ (:method ((class class) slot-definition &rest initargs)
+ (declare (ignore slot-definition initargs))
+ (load-time-value (find-class 'standard-writer-method))))
+
+(cl:defgeneric find-method (gf qualifiers specializers &optional errorp)
+ (:method ((gf generic-function) qualifiers specializers &optional (errorp t))
+ (cl:find-method gf qualifiers specializers errorp)))
+
+(defun modify-accessors (class)
+ (loop with reader-specializers = (list class)
+ with writer-specializers = (list (find-class 't) class)
+ for slotd in (class-direct-slots class) do
+ (loop for reader in (slot-definition-readers slotd)
+ for reader-function = (fdefinition reader)
+ for reader-method = (find-method reader-function () reader-specializers)
+ for initargs = (list :qualifiers ()
+ :lambda-list '(object)
+ :specializers reader-specializers
+ :function (method-function reader-method)
+ :slot-definition slotd)
+ for method-class = (apply #'reader-method-class class slotd initargs)
+ unless (eq method-class (class-of reader-method))
+ do (add-method reader-function (apply #'make-instance method-class initargs)))
+ (loop for writer in (slot-definition-writers slotd)
+ for writer-function = (fdefinition writer)
+ for writer-method = (find-method writer-function () writer-specializers)
+ for initargs = (list :qualifiers ()
+ :lambda-list '(new-value object)
+ :specializers writer-specializers
+ :function (method-function writer-method)
+ :slot-definition slotd)
+ for method-class = (apply #'writer-method-class class slotd initargs)
+ unless (eq method-class (class-of writer-method))
+ do (add-method writer-function (apply #'make-instance method-class initargs)))))
+
+;; During class re/initialization, we take care of the following things:
+;; - Optimization of slot accessors is deactivated.
+;; - Removal of direct subclasses.
+
+(cl:defmethod initialize-instance :around
+ ((class standard-class) &rest initargs)
+ (declare (dynamic-extent initargs))
+ (prog1 (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs)
+ (modify-accessors class)))
+
+(cl:defmethod reinitialize-instance :around
+ ((class standard-class) &rest initargs
+ &key (direct-superclasses () direct-superclasses-p))
+ (declare (dynamic-extent initargs))
+ (when direct-superclasses-p
+ (loop for superclass in (copy-list (class-direct-superclasses class))
+ unless (member superclass direct-superclasses)
+ do (remove-direct-subclass superclass class)))
+ (prog1 (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs)
+ (modify-accessors class)))
+
+;; In ECL, eql specializers are lists. We cannot change this
+;; but we can soften some of the incompatibilities.
+
+(defun eql-specializer-p (cons)
+ (and (consp cons)
+ (eq (car cons) 'eql)
+ (null (cddr cons))))
+
+(deftype eql-specializer ()
+ '(or eql-specializer*
+ (satisfies eql-specializer-p)))
+
+(cl:defgeneric eql-specializer-object (eql-specializer)
+ (:method ((cons cons))
+ (if (eql-specializer-p cons)
+ (cadr cons)
+ (error "~S is not an eql-specializer." cons))))
+
+(defun intern-eql-specializer (object)
+ `(eql ,object))
+
+(cl:defgeneric specializer-direct-methods (specializer))
+
+(cl:defclass eql-specializer* (standard-object)
+ ((obj :reader eql-specializer-object
+ :initarg eso
+ :initform (error "Use intern-eql-specializer to create eql-specializers."))
+ (direct-methods :reader specializer-direct-methods
+ :accessor es-direct-methods
+ :initform ())))
+
+(defvar *eql-specializers* (make-hash-table))
+
+(defun intern-eql-specializer* (object)
+ (or (gethash object *eql-specializers*)
+ (setf (gethash object *eql-specializers*)
+ (make-instance 'eql-specializer* 'eso object))))
+
+(defvar *direct-methods* (make-hash-table :test #'eq))
+
+(cl:defgeneric add-direct-method (specializer method)
+ (:method ((specializer class) (method method))
+ (pushnew method (gethash specializer *direct-methods*)))
+ (:method ((specializer eql-specializer*) (method method))
+ (pushnew method (es-direct-methods specializer))))
+
+(cl:defgeneric remove-direct-method (specializer method)
+ (:method ((specializer class) (method method))
+ (removef (gethash specializer *direct-methods*) method))
+ (:method ((specializer eql-specializer*) (method method))
+ (removef (es-direct-methods specializer) method)))
+
+(cl:defmethod specializer-direct-methods ((class class))
+ (gethash class *direct-methods*))
+
+(cl:defgeneric specializer-direct-generic-functions (specializer)
+ (:method ((class class))
+ (remove-duplicates
+ (mapcar #'method-generic-function
+ (specializer-direct-methods class))))
+ (:method ((eql-specializer eql-specializer*))
+ (remove-duplicates
+ (mapcar #'method-generic-function
+ (specializer-direct-methods eql-specializer))))
+ (:method ((cons cons))
+ (specializer-direct-generic-functions
+ (intern-eql-specializer*
+ (eql-specializer-object cons)))))
+
+;; The following method ensures that remove-method is called.
+
+(cl:defmethod add-method :before ((gf standard-generic-function) (method method))
+ (when-let (old-method (find-method gf (method-qualifiers method)
+ (method-specializers method) nil))
+ (remove-method gf old-method)))
+
+;; The following two methods ensure that add/remove-direct-method is called,
+;; and that the dependent protocol for generic function works.
+
+(cl:defmethod add-method :after ((gf standard-generic-function) (method method))
+ (loop for specializer in (method-specializers method)
+ do (add-direct-method
+ (if (consp specializer)
+ (intern-eql-specializer*
+ (eql-specializer-object specializer))
+ specializer)
+ method)))
+
+(cl:defgeneric remove-method (generic-function method)
+ (:method ((gf generic-function) (method method))
+ (cl:remove-method gf method)))
+
+(cl:defmethod remove-method :after ((gf generic-function) (method method))
+ (loop for specializer in (method-specializers method)
+ do (remove-direct-method
+ (if (consp specializer)
+ (intern-eql-specializer*
+ (eql-specializer-object specializer))
+ specializer)
+ method)))
+
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (funcall (compile nil `(lambda ()
+ (defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))))
+
+(defmacro defgeneric (&whole form name (&rest args) &body options)
+ (unless (every #'consp options)
+ (error "Illegal generic functions options in defgeneric form ~S." form))
+ `(cl:defgeneric ,name ,args
+ ,@options
+ ,@(unless (member :generic-function-class options :key #'car :test #'eq)
+ '((:generic-function-class standard-generic-function)))))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ (let* ((counts (loop with counts
+ for (key nil) on initargs by #'cddr
+ do (incf (getf counts key 0))
+ finally (return counts)))
+ (keys-to-fix (loop for (key value) on counts by #'cddr
+ if (> value 1) collect key)))
+ (if keys-to-fix
+ (let ((multiple-standard-keys
+ (intersection keys-to-fix *standard-slot-keys*)))
+ (if multiple-standard-keys
+ (error "Too many occurences of ~S in slot initargs ~S."
+ multiple-standard-keys initargs)
+ (loop with fixed-keys
+ for (key value) on initargs by #'cddr
+ if (member key keys-to-fix)
+ do (nconcf (getf fixed-keys key) (list value))
+ else nconc (list key value) into fixed-initargs
+ finally (return (nconc fixed-initargs fixed-keys)))))
+ initargs)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/features.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/features.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/features.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,498 @@
+
+:allegro7.0
+((:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:compute-default-initargs) ; -> :compute-default-initargs-allegro
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defgeneric-calls-find-method-combination)
+ (:defmethod-calls-make-method-lambda)
+ (:dependent-protocol-for-generic-functions fixed)
+ (:extensible-allocation fixed)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:multiple-qualifiers)
+ (:reinitialize-instance-calls-compute-discriminating-function fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-boundp-using-class-specialized-on-slot-definition fixed)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots)
+ (:t-is-always-a-valid-superclass))
+
+:allegro8.0
+((:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:compute-default-initargs) ; -> :compute-default-initargs-allegro
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defgeneric-calls-find-method-combination)
+ (:defmethod-calls-make-method-lambda)
+ (:dependent-protocol-for-generic-functions fixed)
+ (:extensible-allocation fixed)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-boundp-using-class-specialized-on-slot-definition fixed)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots)
+ (:t-is-always-a-valid-superclass))
+
+:allegro8.1
+((:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:compute-default-initargs) ; -> :compute-default-initargs-allegro
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defgeneric-calls-find-method-combination)
+ (:defmethod-calls-make-method-lambda)
+ (:dependent-protocol-for-generic-functions fixed)
+ (:extensible-allocation fixed)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots)
+ (:t-is-always-a-valid-superclass))
+
+:clisp2.35-2.36
+((:accessor-method-initialized-with-function)
+ (:add-method-calls-compute-discriminating-function)
+ (:compute-slots-requested-slot-order-honoured)
+ (:defmethod-calls-make-method-lambda)
+ (:extensible-allocation)
+ (:forward-referenced-class-changed-by-change-class)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-initialized-with-function)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:remove-method-calls-compute-discriminating-function)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots))
+
+:clisp2.37-2.39
+((:accessor-method-initialized-with-function)
+ (:add-method-calls-compute-discriminating-function)
+ (:compute-slots-requested-slot-order-honoured)
+ (:defmethod-calls-make-method-lambda)
+ (:forward-referenced-class-changed-by-change-class)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-initialized-with-function)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:remove-method-calls-compute-discriminating-function)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots))
+
+:clisp2.40-2.41
+((:accessor-method-initialized-with-function)
+ (:add-method-calls-compute-discriminating-function)
+ (:compute-slots-requested-slot-order-honoured)
+ (:defmethod-calls-make-method-lambda)
+ (:forward-referenced-class-changed-by-change-class)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-initialized-with-function)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:remove-method-calls-compute-discriminating-function)
+ (:subclasses-of-method-combination-do-not-inherit-exported-slots))
+
+:cmu19c-19d
+((:accessor-method-initialized-with-function fixed)
+ (:accessor-method-initialized-with-lambda-list fixed)
+ (:accessor-method-initialized-with-slot-definition fixed)
+ (:accessor-method-initialized-with-specializers fixed)
+ (:anonymous-classes fixed)
+ (:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:class-initialization-calls-reader-method-class fixed)
+ (:class-initialization-calls-writer-method-class fixed)
+ (:discriminating-functions-can-be-closures)
+ (:discriminating-functions-can-be-funcalled)
+ (:documentation-passed-to-effective-slot-definition-class)
+ (:effective-slot-definition-initialized-with-documentation)
+ (:method-initialized-with-function)
+ (:multiple-slot-options-passed-as-list-to-direct-slot-definition-class) ; fix with fix-slot-initargs
+ (:reinitialize-instance-calls-compute-discriminating-function fixed)
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-definition-documentation fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-class-do-not-inherit-exported-slots)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-eql-specializer-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-specializer-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:ecl0.9i
+((:accessor-method-initialized-with-function fixed)
+ (:accessor-method-initialized-with-lambda-list fixed)
+ (:accessor-method-initialized-with-slot-definition fixed)
+ (:accessor-method-initialized-with-specializers fixed)
+ (:accessor-method-slot-definition fixed)
+ (:add-direct-method fixed)
+ (:add-method-calls-add-direct-method fixed)
+ (:add-method-calls-compute-discriminating-function)
+ (:add-method-calls-remove-method fixed)
+ (:add-method-updates-specializer-direct-generic-functions fixed)
+ (:add-method-updates-specializer-direct-methods fixed)
+ (:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:class-initialization-calls-reader-method-class fixed)
+ (:class-initialization-calls-writer-method-class fixed)
+ (:class-reinitialization-calls-remove-direct-subclass fixed)
+ (:classes-are-always-their-own-valid-superclasses)
+ (:compute-applicable-methods-is-generic)
+ (:compute-applicable-methods-using-classes)
+ (:compute-effective-method-is-generic)
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:default-reader-methods-are-standard-reader-methods fixed)
+ (:default-writer-methods-are-standard-writer-methods fixed)
+ (:defgeneric-calls-find-method-combination)
+ (:defmethod-calls-generic-function-method-class)
+ (:defmethod-calls-initialize-instance)
+ (:defmethod-calls-make-method-lambda)
+ (:dependent-protocol-for-classes)
+ (:dependent-protocol-for-generic-functions)
+ (:direct-slot-definition-initialized-with-type)
+ (:discriminating-functions-can-be-closures)
+ (:discriminating-functions-can-be-funcalled)
+ (:eql-specializer)
+ (:eql-specializer-object fixed)
+ (:eql-specializers-are-objects)
+ (:extract-lambda-list fixed)
+ (:extract-specializer-names fixed)
+ (:find-method-combination)
+ (:find-method-is-generic fixed)
+ (:funcallable-standard-class)
+ (:funcallable-standard-object)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:generic-function-declarations)
+ (:generic-function-method-class-is-generic)
+ (:generic-function-method-combination)
+ (:generic-functions-can-be-empty)
+ (:initform-passed-to-direct-slot-definition-class)
+ (:initform-passed-to-effective-slot-definition-class)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:intern-eql-specializer fixed)
+ (:make-method-lambda)
+ (:metaobject)
+ (:method-functions-take-processed-parameters)
+ (:method-initialized-with-documentation)
+ (:method-initialized-with-function)
+ (:method-initialized-with-lambda-list)
+ (:method-initialized-with-qualifiers)
+ (:method-initialized-with-specializers)
+ (:method-lambdas-are-processed)
+ (:multiple-slot-options-passed-as-list-to-direct-slot-definition-class)
+ (:reader-method-class fixed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:remove-direct-method fixed)
+ (:remove-method-calls-compute-discriminating-function)
+ (:remove-method-calls-remove-direct-method fixed)
+ (:remove-method-is-generic fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:slot-definition-documentation)
+ (:slot-definition-initform)
+ (:slot-definition-initfunction)
+ (:slot-definition-type)
+ (:slot-reader-calls-slot-value-using-class fixed)
+ (:slot-writer-calls-slot-value-using-class fixed)
+ (:specializer)
+ (:specializer-direct-generic-functions fixed)
+ (:specializer-direct-methods fixed)
+ (:standard-accessor-method fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:standard-reader-method fixed)
+ (:standard-writer-method fixed)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots)
+ (:subclasses-of-class-do-not-inherit-exported-slots)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:t-is-always-a-valid-superclass)
+ (:type-passed-to-direct-slot-definition-class)
+ (:validate-superclass)
+ (:writer-method-class fixed))
+
+:lispworks4.4
+((:add-method-calls-add-direct-method fixed)
+ (:add-method-calls-compute-discriminating-function)
+ (:add-method-calls-remove-method fixed)
+ (:add-method-updates-specializer-direct-generic-functions fixed)
+ (:allocation-passed-to-effective-slot-definition-class) ; instead :flags-passed-to-effective-slot-definition-class
+ (:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:class-initialized-with-direct-default-initargs) ; instead: conditionalization
+ (:class-reinitialization-calls-remove-direct-subclass fixed)
+ (:compute-applicable-methods-using-classes)
+ (:compute-default-initargs)
+ (:defgeneric-calls-find-method-combination)
+ (:direct-superclasses-by-default-empty) ; not fixed, but direct superclasses are automatically adjusted
+ (:effective-slot-definition-initialized-with-allocation) ; instead :effective-slot-definition-initialized-with-flags
+ (:eql-specializer) ; partially fixed
+ (:eql-specializer-object fixed)
+ (:eql-specializers-are-objects)
+ (:extensible-allocation)
+ (:finalize-inheritance-calls-compute-default-initargs)
+ (:find-method-combination fixed) ; partially
+ (:funcallable-standard-instance-access)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:generic-function-initialized-with-declarations) ; map from generic-function-initialized-with-declare
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:intern-eql-specializer fixed) ; partially
+ (:make-method-lambda fixed) ; partially
+ (:method-functions-take-processed-parameters)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:remove-method-calls-compute-discriminating-function)
+ (:remove-method-calls-remove-direct-method fixed)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+ (:setf-slot-value-using-class-specialized-on-slot-definition fixed)
+ (:slot-boundp-using-class-specialized-on-slot-definition fixed)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:slot-reader-calls-slot-value-using-class fixed)
+ (:slot-value-using-class-specialized-on-slot-definition fixed)
+ (:slot-writer-calls-slot-value-using-class fixed)
+ (:specializer)
+ (:specializer-direct-generic-functions fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:standard-instance-access)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:lispworks5.0-5.0.2
+((:add-method-calls-compute-discriminating-function)
+ (:add-method-updates-specializer-direct-generic-functions fixed)
+ (:class-default-initargs)
+ (:class-direct-default-initargs)
+ (:compute-applicable-methods-using-classes)
+ (:compute-default-initargs)
+ (:defgeneric-calls-find-method-combination)
+ (:eql-specializer) ; partially fixed
+ (:eql-specializer-object fixed)
+ (:eql-specializers-are-objects)
+ (:extensible-allocation)
+ (:finalize-inheritance-calls-compute-default-initargs)
+ (:find-method-combination fixed) ; partially
+ (:funcallable-standard-instance-access)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:intern-eql-specializer fixed) ; partially
+ (:make-method-lambda fixed) ; partially
+ (:method-functions-take-processed-parameters)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:remove-method-calls-compute-discriminating-function)
+ (:setf-slot-value-using-class-specialized-on-slot-definition fixed)
+ (:slot-boundp-using-class-specialized-on-slot-definition fixed)
+ (:slot-makunbound-using-class-specialized-on-slot-definition fixed)
+ (:slot-reader-calls-slot-value-using-class fixed)
+ (:slot-value-using-class-specialized-on-slot-definition fixed)
+ (:slot-writer-calls-slot-value-using-class fixed)
+ (:specializer)
+ (:specializer-direct-generic-functions fixed)
+ (:standard-class-and-funcallable-standard-class-are-compatible)
+ (:standard-instance-access)
+ (:subclasses-of-built-in-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-forward-referenced-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-funcallable-standard-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-class-do-not-inherit-exported-slots fixed)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:mcl
+((:add-method-calls-compute-discriminating-function)
+ (:compute-applicable-methods-using-classes)
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defmethod-calls-generic-function-method-class)
+ (:defmethod-calls-make-method-lambda)
+ (:discriminating-functions-can-be-closures)
+ (:discriminating-functions-can-be-funcalled)
+ (:funcallable-standard-object)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:generic-function-declarations)
+ (:generic-function-initialized-with-declarations)
+ (:generic-functions-can-be-empty)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:reinitialize-lambda-list-reinitializes-argument-precedence-order)
+ (:remove-method-calls-compute-discriminating-function)
+ (:set-funcallable-instance-function)
+ (:setf-generic-function-name)
+ (:setf-generic-function-name-calls-reinitialize-instance)
+; ---
+ (:compute-slots-requested-slot-order-honoured)
+ (:direct-slot-definition fixed)
+ (:direct-superclasses-by-default-empty) ; not fixed, but direct superclasses are automatically adjusted, not for funcallable-standard-class though
+ (:effective-slot-definition fixed)
+ (:eql-specializer fixed)
+ (:extensible-allocation)
+ (:multiple-slot-options-passed-as-list-to-direct-slot-definition-class) ; fix with fix-slot-initargs
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:setf-class-name-calls-reinitialize-instance)
+ (:slot-definition fixed)
+ (:standard-slot-definition fixed)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:openmcl
+((:add-method-calls-compute-discriminating-function)
+ (:compute-applicable-methods-using-classes)
+ (:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
+ (:defmethod-calls-generic-function-method-class)
+ (:defmethod-calls-make-method-lambda)
+ (:discriminating-functions-can-be-closures)
+ (:discriminating-functions-can-be-funcalled)
+ (:funcallable-standard-object)
+ (:function-invocation-calls-compute-applicable-methods)
+ (:function-invocation-calls-compute-applicable-methods-using-classes)
+ (:function-invocation-calls-compute-effective-method)
+ (:generic-functions-can-be-empty)
+ (:initialize-instance-calls-compute-discriminating-function)
+ (:make-method-lambda)
+ (:method-functions-take-processed-parameters)
+ (:method-lambdas-are-processed)
+ (:reinitialize-instance-calls-compute-discriminating-function)
+ (:reinitialize-lambda-list-reinitializes-argument-precedence-order)
+ (:remove-method-calls-compute-discriminating-function)
+; ---
+ (:compute-slots-requested-slot-order-honoured)
+ (:eql-specializer fixed)
+ (:reinitialize-instance-calls-finalize-inheritance)
+ (:slot-definition-documentation fixed)
+ (:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slot)
+ (:subclasses-of-standard-direct-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-effective-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-generic-function-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-reader-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-accessor-method-do-not-inherit-exported-slots)
+ (:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
+
+:sbcl 0.9.16-1.0.10
+#| all features implemented |#
Added: branches/trunk-reorg/thirdparty/closer-mop/features.txt
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/features.txt 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/features.txt 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,225 @@
+Features that don't adhere to AMOP in various CLOS MOP implementations, and whether and how they are resolved in Closer to MOP.
+
+Allegro Common Lisp 7.0
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- COMPUTE-DEFAULT-INITARGS takes more parameters than specified. Not fixed. Conditionalize on #+allegro for your own methods instead.
+- FUNCALLABLE-STANDARD-OBJECT is not used as the default superclass for classes with :metaclass FUNCALLABLE-STANDARD-CLASS.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- DEFMETHOD doesn't call MAKE-METHOD-LAMBDA. Not fixed.
+- The dependent protocol for generic functions doesn't work fully. Fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS, COMPUTE-APPLICABLE-METHODS-USING-CLASSES and COMPUTE-EFFECTIVE-METHOD. Not fixed.
+- The :ALLOCATION type cannot be extended. Fixed.
+- MAKE-METHOD-LAMBDA is not provided. Not fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- The defmethod form does not accept multiple qualifiers. Not fixed.
+- REINITIALIZE-INSTANCE doesn't determine a new discriminating function. Fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Not fixed.
+- SLOT-BOUNDP-USING-CLASS and SLOT-MAKUNBOUND-USING-CLASS are not specialized on slot definition metaobjects, but on symbols. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- VALIDATE-SUPERCLASS doesn't recognize T as a valid superclass. Not fixed.
+- Subclasses of BUILT-IN-CLASS, FORWARD-REFERENCED-CLASS, FUNCALLABLE-STANDARD-CLASS, METHOD-COMBINATION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+Allegro Common Lisp 8.0
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- COMPUTE-DEFAULT-INITARGS takes more parameters than specified. Not fixed. Conditionalize on #+allegro for your own methods instead.
+- FUNCALLABLE-STANDARD-OBJECT is not used as the default superclass for classes with :metaclass FUNCALLABLE-STANDARD-CLASS.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- DEFMETHOD doesn't call MAKE-METHOD-LAMBDA. Not fixed.
+- The dependent protocol for generic functions doesn't work fully. Fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS, COMPUTE-APPLICABLE-METHODS-USING-CLASSES and COMPUTE-EFFECTIVE-METHOD. Not fixed.
+- The :ALLOCATION type cannot be extended. Fixed.
+- MAKE-METHOD-LAMBDA is not provided. Not fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- REINITIALIZE-INSTANCE doesn't determine a new discriminating function. Fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Not fixed.
+- SLOT-BOUNDP-USING-CLASS and SLOT-MAKUNBOUND-USING-CLASS are not specialized on slot definition metaobjects, but on symbols. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- VALIDATE-SUPERCLASS doesn't recognize T as a valid superclass. Not fixed.
+- Subclasses of BUILT-IN-CLASS, FORWARD-REFERENCED-CLASS, FUNCALLABLE-STANDARD-CLASS, METHOD-COMBINATION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+Allegro Common Lisp 8.1
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- COMPUTE-DEFAULT-INITARGS takes more parameters than specified. Not fixed. Conditionalize on #+allegro for your own methods instead.
+- FUNCALLABLE-STANDARD-OBJECT is not used as the default superclass for classes with :metaclass FUNCALLABLE-STANDARD-CLASS.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- DEFMETHOD doesn't call MAKE-METHOD-LAMBDA. Not fixed.
+- The dependent protocol for generic functions doesn't work fully. Fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS, COMPUTE-APPLICABLE-METHODS-USING-CLASSES and COMPUTE-EFFECTIVE-METHOD. Not fixed.
+- The :ALLOCATION type cannot be extended. Fixed.
+- MAKE-METHOD-LAMBDA is not provided. Not fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- REINITIALIZE-INSTANCE doesn't determine a new discriminating function. Fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Not fixed.
+- SLOT-MAKUNBOUND-USING-CLASS is not specialized on slot definition metaobjects, but on symbols. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- VALIDATE-SUPERCLASS doesn't recognize T as a valid superclass. Not fixed.
+- Subclasses of BUILT-IN-CLASS, FORWARD-REFERENCED-CLASS, FUNCALLABLE-STANDARD-CLASS, METHOD-COMBINATION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+CLisp 2.35 and 2.36
+
+None of the incompatibilities in CLisp are fixed.
+
+- Methods are not initialized with :function.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP.
+- DEFMETHOD does not call MAKE-METHOD-LAMBDA.
+- The :ALLOCATION type cannot be extended. Not fixed.
+- A FORWARD-REFERENCED-CLASS is not changed via CHANGE-CLASS (but is correctly reinitialized via REINITIALIZE-INSTANCE).
+- MAKE-METHOD-LAMBDA is not provided.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- Subclasses of METHOD-COMBINATION will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+CLisp 2.37 - 2.39
+
+None of the incompatibilities in CLisp are fixed.
+
+- Methods are not initialized with :function.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP.
+- DEFMETHOD does not call MAKE-METHOD-LAMBDA.
+- A FORWARD-REFERENCED-CLASS is not changed via CHANGE-CLASS (but is correctly reinitialized via REINITIALIZE-INSTANCE).
+- MAKE-METHOD-LAMBDA is not provided.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- Subclasses of METHOD-COMBINATION will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+CLisp 2.40 and 2.41
+
+None of the incompatibilities in CLisp are fixed.
+
+- Methods are not initialized with :function.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP.
+- DEFMETHOD does not call MAKE-METHOD-LAMBDA.
+- A FORWARD-REFERENCED-CLASS is not changed via CHANGE-CLASS (but is correctly reinitialized via REINITIALIZE-INSTANCE).
+- MAKE-METHOD-LAMBDA is not provided.
+- Subclasses of METHOD-COMBINATION will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+CMUCL 19c, 19d
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- Accessor methods are not initialized with :function, :lambda-list, :slot-definition and :specializers. Fixed.
+- Classes cannot be anonymous. Fixed.
+- Class initialization doesn't call READER-METHOD-CLASS and WRITER-METHOD-CLASS for accessor methods. Fixed.
+- The object returned by compute-discriminating-function cannot be a closure. Likewise, the second parameter to set-funcallable-instance-function cannot be a closure, but only a "pure" function/thunk. Not fixed.
+- Effective slot definitions are not initialized with :documentation, and EFFECTIVE-SLOT-DEFINITION-CLASS also doesn't receive that initarg. Not fixed.
+- Calling DOCUMENTATION on effective slot definition metaobjects don't return their documentation as specified in ANSI Common Lisp. Fixed.
+- Methods are not initialized with :function. Not fixed.
+- Multiple slot options are not passed as lists to DIRECT-SLOT-DEFINITION-CLASS. Not fixed, but use FIX-SLOT-INITARGS as a workaround.
+- REINITIALIZE-INSTANCE doesn't determine a new discriminating function. Fixed.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- Subclasses of BUILT-IN-CLASS, CLASS, DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, EQL-SPECIALIZER, FORWARD-REFERENCED-CLASS, FUNCALLABLE-STANDARD-CLASS, SLOT-DEFINITION, SPECIALIZER, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+LispWorks, 4.4.5, 4.4.6, Personal and Professional Editions
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- ADD-METHOD doesn't call ADD-DIRECT-METHOD and REMOVE-METHOD. Fixed.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- Effective slot definitions are not initialized with :allocation, and EFFECTIVE-SLOT-DEFINITION-CLASS also doesn't receive that initarg. Not fixed. This information is encoded in the initarg :flags, but I don't have any detailed information about that parameter.
+- Classes are not initialized with :direct-default-initargs, but with :default-initargs. Conditionalize on #+lispworks to fix this.
+- Class reinitialization does not call REMOVE-DIRECT-SUBCLASS. Fixed.
+- COMPUTE-APPLICABLE-METHODS-USING-CLASSES doesn't exist. Not fixed.
+- COMPUTE-DEFAULT-INITARGS doesn't exist. Not fixed.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- When classes are initialized, :direct-superclasses are by default not empty. Not fixed, but direct superclasses are automatically adjusted when you use the standard idiom for adding a new default superclass.
+- EQL-SPECIALIZER, EQL-SPECIALIZER-OBJECT and INTERN-EQL-SPECIALIZER don't exist. In LispWorks, eql specializers are lists not objects. I have provided EQL-SPECIALIZER as a type (not as a class) and EQL-SPECIALIZER-OBJECT and INTERN-EQL-SPECIALIZER to work on lists, and a class EQL-SPECIALIZER* and corresponding EQL-SPECIALIZER-OBJECT* and INTERN-EQL-SPECILAIZER* to soften the incompatibilities.
+- The :ALLOCATION type cannot be extended. Not fixed.
+- FIND-METHOD-COMBINATION doesn't exist. Fixed, but fixed version doesn't work with method combination options.
+- FUNCALLABLE-STANDARD-INSTANCE-ACCESS and STANDARD-INSTANCE-ACCESS don't exist. Not fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS and COMPUTE-APPLICABLE-METHODS-USING-CLASSES. Not fixed.
+- Generic functions are not initialized with :declarations, but with 'declare. Not fixed. Conditionalize on #+lispworks instead.
+- MAKE-METHOD-LAMBDA expects other parameters than specified. Fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- REMOVE-METHOD doesn't call REMOVE-DIRECT-METHOD. Fixed.
+- (SETF CLASS-NAME) and (SETF GENERIC-FUNCTION-NAME) do not use REINITIALIZE-INSTANCE for changing the names. Not fixed.
+- The slot methods (SLOT-VALUE-USING-CLASS, etc.) are not specialized on effective slot definitions, but on slot names. Fixed.
+- The generated accessor methods don't use the slot methods for accessing slots. Fixed. (Don't use :optimize-slot-access to deoptimize slot access, or otherwise the fixed slot access protocol doesn't work anymore!)
+- SPECIALIZER doesn't exist. Not fixed.
+- SPECIALIZER-DIRECT-GENERIC-FUNCTIONS doesn't exist. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- Subclasses of BUILT-IN-CLASS (fixed), CLASS (fixed), DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, FORWARD-REFERENCED-CLASS (fixed), FUNCALLABLE-STANDARD-CLASS (fixed), SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS (fixed), STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed, except where indicated otherwise.
+
+
+LispWorks, 5.0 and 5.0.1, Personal Edition
+LispWorks, 5.0 - 5.0.2, Professional Edition
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS don't return canonicalized default initargs as specified. Not fixed.
+- ADD-METHOD, REMOVE-METHOD, INITIALIZE-INSTANCE and REINITIALIZE-INSTANCE do not determine a new discriminating function. This is postponed until function invocation instead, so shouldn't be a problem in practice.
+- COMPUTE-APPLICABLE-METHODS-USING-CLASSES doesn't exist. Not fixed.
+- COMPUTE-DEFAULT-INITARGS doesn't exist. Not fixed.
+- DEFGENERIC does not call FIND-METHOD-COMBINATION. Not fixed.
+- EQL-SPECIALIZER, EQL-SPECIALIZER-OBJECT and INTERN-EQL-SPECIALIZER don't exist. In LispWorks, eql specializers are lists not objects. I have provided EQL-SPECIALIZER as a type (not as a class) and EQL-SPECIALIZER-OBJECT and INTERN-EQL-SPECIALIZER to work on lists, and a class EQL-SPECIALIZER* and corresponding EQL-SPECIALIZER-OBJECT* and INTERN-EQL-SPECILAIZER* to soften the incompatibilities.
+- The :ALLOCATION type cannot be extended. Not fixed.
+- FIND-METHOD-COMBINATION doesn't exist. Fixed, but fixed version doesn't work with method combination options.
+- FUNCALLABLE-STANDARD-INSTANCE-ACCESS and STANDARD-INSTANCE-ACCESS don't exist. Not fixed.
+- The function invocation protocol doesn't call COMPUTE-APPLICABLE-METHODS and COMPUTE-APPLICABLE-METHODS-USING-CLASSES. Not fixed.
+- MAKE-METHOD-LAMBDA expects other parameters than specified. Fixed.
+- Method functions don't take parameters as specified in AMOP, but instead just the parameters that the generic function receives. Not fixed.
+- The slot methods (SLOT-VALUE-USING-CLASS, etc.) are not specialized on effective slot definitions, but on slot names. Fixed.
+- The generated accessor methods don't use the slot methods for accessing slots. Fixed. (Don't use :optimize-slot-access to deoptimize slot access, or otherwise the fixed slot access protocol doesn't work anymore!)
+- SPECIALIZER doesn't exist. Not fixed.
+- SPECIALIZER-DIRECT-GENERIC-FUNCTIONS doesn't exist. Fixed.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
+- Subclasses of BUILT-IN-CLASS (fixed), CLASS (fixed), DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, FORWARD-REFERENCED-CLASS (fixed), FUNCALLABLE-STANDARD-CLASS (fixed), SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS (fixed), STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed, except where indicated otherwise.
+
+
+MCL 5.1
+
+In MCL, generic functions work completely differently than specified. The specific incompatibilities are not listed and are not fixed.
+
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP. Not fixed.
+- DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, EQL-SPECIALIZER, SLOT-DEFINITION and STANDARD-SLOT-DEFINITION are not exported. Fixed.
+- When classes are initialized, :direct-superclasses are by default not empty. Not fixed, but direct superclasses are automatically adjusted when you use the standard idiom for adding a new default superclass.
+- The :ALLOCATION type cannot be extended. Not fixed.
+- Multiple slot options are not passed as lists to DIRECT-SLOT-DEFINITION-CLASS. Not fixed, but use FIX-SLOT-INITARGS as a workaround.
+- (SETF CLASS-NAME) doesn't use REINITIALIZE-INSTANCE for changing the names. Fixed.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- Subclasses of DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+OpenMCL 1.0
+
+In OpenMCL, generic functions work completely differently than specified. The specific incompatibilities are not listed and are not fixed.
+
+- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP. Not fixed.
+- EQL-SPECIALIZER is not exported. Fixed.
+- DOCUMENTATION doesn't return the documentation strings for slot definition metaobjects. Fixed.
+- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
+- Subclasses of DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, GENERIC-FUNCTION, SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
+
+SBCL 0.9.16 - 1.0.10
+
+All features implemented.
+
+
+Summary:
+
+- CLASS-DIRECT-DEFAULT-INITARGS and CLASS-DEFAULT-INITARGS exist, but don't work as expected in Allegro Common Lisp, CMUCL and LispWorks.
+- If you specialize COMPUTE-DEFAULT-INITAGS, conditionalize for the extra parameters in Allegro Common Lisp.
+- In Allegro Common Lisp, FUNCALLABLE-STANDARD-OBJECT is not used as the default superclass for classes with :metaclass FUNCALLABLE-STANDARD-CLASS.
+- In CMUCL, the object returned by compute-discriminating-function cannot be a closure. Likewise, the second parameter to set-funcallable-instance-function cannot be a closure, but only a "pure" function/thunk.
+- In CLisp, MCL and OpenMCL, the slot order requested by a primary method for COMPUTE-SLOTS is not honoured by the respective MOPs.
+- Don't rely on FIND-METHOD-COMBINATION to do its job correctly, only when you don't provide method combination options.
+- MAKE-METHOD-LAMBDA only works in CMUCL and SBCL as specified (but make sure that the respective generic function and method metaobject classes and make-method-lambda definitions are part of your compilation enviroment). MAKE-METHOD-LAMBDA also works in LispWorks, but the returned lambda expressions don't adhere to the AMOP specification (which may be good enough for your purposes).
+- Specialize the methods for the dependent protocol on the class or generic function metaobject class. The example in AMOP doesn't do this but that is fragile code.
+- Don't rely on methods being initialized with the specified initargs from inside the MOP.
+- CLisp doesn't change a FORWARD-REFERENCED-CLASS via CHANGE-CLASS. Apart from that, FORWARD-REFERENCED-CLASS works reliably across all MOPs.
+- Effective slot definitions and EFFECTIVE-SLOT-DEFINITION-CLASS don't receive :documentation in CMUCL, and no :allocation (!) in LispWorks before 5.0.
+- If you specialize DIRECT-SLOT-DEFINITION-CLASS, use FIX-SLOT-INITARGS in portable code.
+- If you want to use :ALLOCATION types other than :CLASS or :INSTANCE, you cannot use CLisp before 2.37, LispWorks or MCL. Only Allegro Common Lisp, CLisp from 2.37 on, CMUCL, OpenMCL and SBCL support this.
+- In Allegro, CMUCL and LispWorks, STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible.
+- The function invocation protocol only works in CMUCL, SBCL and CLisp.
+- If you need to see :direct-default-initargs when classes are initialized, conditionalize on #+lispworks to receive :default-initargs instead for LispWorks version before 5.0.
+- COMPUTE-DEFAULT-INITARGS doesn't exist (and isn't called) in LispWorks.
+- In LispWorks, eql specializers are lists.
+- FUNCALLABLE-STANDARD-INSTANCE-ACCESS and STANDARD-INSTANCE-ACCESS doesn't exist / should not be used in LispWorks.
+- In CLisp before version 2.40, and in CMUCL, MCL and OpenMCL, the reinitialization of a class metaobject does not lead to a call of FINALIZE-INHERITANCE, so methods defined on FINALIZE-INHERITANCE won't be called again in that case.
+- If you need to see :declarations when generic functions are initialized, conditionalize on #+lispworks to receive 'declare instead for LispWorks versions before 5.0. (Actually, AMOP and ANSI Common Lisp diverge in this regard. AMOP specifies that :declarations is used whereas ANSI Common Lisp specifies that 'declare is used. Since most MOP implementations adhere to AMOP in this regard, I have also chosen that path.)
+- In Allegro Common Lisp and LispWorks, method functions take the original parameters that a generic function has received.
+- In LispWorks before 5.0, the class SPECIALIZER doesn't exist.
+- If you need to rely on the generic function protocols, don't use MCL or OpenMCL (or be very careful - some minor things work there as specified).
+- The declarations for a generic function cannot be inspected in MCL.
+- All implementations define slots on various specified metaobject classes that are exported from some package and/or accessible in the package common-lisp-user. Only sbcl is safe from this, and clisp is relatively safe in that it does that only for the class METHOD-COMBINATION.
Added: branches/trunk-reorg/thirdparty/closer-mop/lispworks/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/lispworks/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/lispworks/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,194 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ (:shadow
+ #:defclass #:defgeneric #:defmethod
+ #:ensure-generic-function
+ #:standard-class #:standard-generic-function)
+ (:export
+ #:defclass #:defgeneric #:defmethod
+ #:ensure-generic-function
+ #:standard-class #:standard-generic-function)
+
+ (:import-from #:clos
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #-lispworks #:eql-specializer
+ #:forward-referenced-class
+ #-lispworks #:funcallable-standard-class
+ #+lispworks5.0 #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #-lispworks #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #-lispworks4.3 #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-lispworks #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #-lispworks #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #-lispworks #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #-lispworks #:find-method-combination
+ #-lispworks #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #-lispworks #:intern-eql-specializer
+ #-lispworks #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #-lispworks4.3 #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #-lispworks #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #-lispworks #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #-lispworks4.3 #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #+lispworks #:eql-specializer*
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #-lispworks #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #-lispworks4.3 #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-lispworks #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #-lispworks #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #-lispworks #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #+lispworks #:intern-eql-specializer*
+ #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #-lispworks4.3 #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #-lispworks #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #-lispworks4.3 #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/lispworks/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/lispworks/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/lispworks/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,605 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+;; We need a new standard-generic-function for various things.
+
+(cl:defclass standard-generic-function (cl:standard-generic-function)
+ ((initial-methods :initform '()))
+ (:metaclass clos:funcallable-standard-class))
+
+;; The following ensures that the new standard-generic-function is used.
+
+(defun ensure-generic-function
+ (name &rest args
+ &key (generic-function-class 'standard-generic-function)
+ &allow-other-keys)
+ (declare (dynamic-extent args))
+ (when (fboundp name)
+ (let ((function (fdefinition name)))
+ (unless (typep function 'generic-function)
+ (cerror "Discard existing definition and create generic function."
+ "~S is already fbound, but not as a generic function." name)
+ (fmakunbound name))))
+ (if (fboundp name)
+ (let ((function (fdefinition name)))
+ (apply #'ensure-generic-function-using-class
+ function name args))
+ (apply #'ensure-generic-function-using-class nil name
+ :generic-function-class generic-function-class
+ args)))
+
+;; We need a new standard-class for various things.
+
+(cl:defclass standard-class (cl:standard-class)
+ ())
+
+;; validate-superclass for metaclass classes is a little bit
+;; more tricky than for class metaobject classes because
+;; we don't want to make all standard-classes compatible to
+;; each other.
+
+;; Our validate-superclass may get passed a class-prototype
+;; as its second argument, so don't expect its readers to
+;; yield useful information. (In ANSI parlance, "the
+;; consequences are undefined...")
+
+(cl:defmethod validate-superclass
+ ((class standard-class)
+ (superclass cl:standard-class))
+ (or (when (eq (class-of class) (find-class 'standard-class))
+ (or (eq (class-of superclass) (find-class 'cl:standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'cl:standard-class))
+ (validate-superclass class (class-prototype (find-class 'standard-class))))))
+
+;; The following macro ensures that the new standard-class is used
+;; by default. It would have been useful to fix other deficiencies
+;; in a complete redefinition of defclass, but there is no portable
+;; way to ensure the necessary compile-time effects as specified
+;; by ANSI Common Lisp. Therefore, we just expand to the original
+;; cl:defclass.
+
+(defmacro defclass (name (&rest supers) &body options)
+ (if (member :metaclass options :key #'car)
+ `(cl:defclass ,name ,supers ,@options)
+ `(cl:defclass ,name ,supers ,@options
+ (:metaclass standard-class))))
+
+;; We need a new funcallable-standard-class for various things.
+
+(cl:defclass funcallable-standard-class (clos:funcallable-standard-class)
+ ())
+
+;; See the comment on validate-superclass for standard-class above.
+
+(cl:defmethod validate-superclass
+ ((class funcallable-standard-class)
+ (superclass clos:funcallable-standard-class))
+ (or (when (eq (class-of class) (find-class 'funcallable-standard-class))
+ (or (eq (class-of superclass) (find-class 'clos:funcallable-standard-class))
+ (eq (class-of superclass) (find-class 'funcallable-standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'clos:funcallable-standard-class))
+ (validate-superclass class (class-prototype (find-class 'funcallable-standard-class))))))
+
+#+lispworks5.0
+(cl:defmethod validate-superclass
+ ((class funcallable-standard-class)
+ (superclass (eql (find-class 'funcallable-standard-object))))
+ t)
+
+;; We also need a new funcallable-standard-object because the default one
+;; is not an instance of clos:funcallable-standard-class.
+
+#-lispworks5.0
+(cl:defclass funcallable-standard-object (clos:funcallable-standard-object)
+ ()
+ (:metaclass clos:funcallable-standard-class))
+
+;; The following code ensures that possibly incorrect lists of direct
+;; superclasses are corrected.
+
+#-lispworks5.0
+(defun modify-superclasses (direct-superclasses &optional (standardp t))
+ (if (null direct-superclasses)
+ (list (if standardp
+ (find-class 'standard-object)
+ (find-class 'funcallable-standard-object)))
+ (let ((standard-object (if standardp
+ (find-class 'standard-object)
+ (find-class 'clos:funcallable-standard-object))))
+ (if (eq (car (last direct-superclasses)) standard-object)
+ (if standardp
+ direct-superclasses
+ (append (butlast direct-superclasses)
+ (list (find-class 'funcallable-standard-object))))
+ (remove standard-object direct-superclasses)))))
+
+;; During class re/initialization, we take care of the following things:
+;; - Optimization of slot accessors is deactivated.
+;; - Lists of direct superclasses are corrected.
+;; - Removal of direct subclasses.
+
+(cl:defmethod initialize-instance :around
+ ((class standard-class) &rest initargs
+ #-lispworks5.0 &key
+ #-lispworks5.0 (direct-superclasses ()))
+ (declare (dynamic-extent initargs))
+ (apply #'call-next-method class
+ #-lispworks5.0 :direct-superclasses
+ #-lispworks5.0 (modify-superclasses direct-superclasses)
+ :optimize-slot-access nil
+ initargs))
+
+(cl:defmethod reinitialize-instance :around
+ ((class standard-class) &rest initargs
+ #-lispworks5.0 &key
+ #-lispworks5.0 (direct-superclasses () direct-superclasses-p))
+ (declare (dynamic-extent initargs))
+ #-lispworks5.0
+ (progn
+ (when direct-superclasses-p
+ (setq direct-superclasses (modify-superclasses direct-superclasses))
+ (loop for superclass in (copy-list (class-direct-superclasses class))
+ unless (member superclass direct-superclasses)
+ do (remove-direct-subclass superclass class)))
+ (if direct-superclasses-p
+ (apply #'call-next-method class
+ :direct-superclasses direct-superclasses
+ :optimize-slot-access nil
+ initargs)
+ (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs)))
+ #+lispworks5.0
+ (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs))
+
+(cl:defmethod initialize-instance :around
+ ((class funcallable-standard-class) &rest initargs
+ #-lispworks5.0 &key
+ #-lispworks5.0 (direct-superclasses ()))
+ (declare (dynamic-extent initargs))
+ (apply #'call-next-method class
+ #-lispworks5.0 :direct-superclasses
+ #-lispworks5.0 (modify-superclasses direct-superclasses nil)
+ :optimize-slot-access nil
+ initargs))
+
+(cl:defmethod reinitialize-instance :around
+ ((class funcallable-standard-class) &rest initargs
+ #-lispworks5.0 &key
+ #-lispworks5.0 (direct-superclasses () direct-superclasses-p))
+ (declare (dynamic-extent initargs))
+ #-lispworks5.0
+ (progn
+ (when direct-superclasses-p
+ (setq direct-superclasses (modify-superclasses direct-superclasses nil))
+ (loop for superclass in (copy-list (class-direct-superclasses class))
+ unless (member superclass direct-superclasses)
+ do (remove-direct-subclass superclass class)))
+ (if direct-superclasses-p
+ (apply #'call-next-method class
+ :direct-superclasses direct-superclasses
+ :optimize-slot-access nil
+ initargs)
+ (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs)))
+ #+lispworks5.0
+ (apply #'call-next-method class
+ :optimize-slot-access nil
+ initargs))
+
+;; The following is necessary for forward-referenced-classes.
+;; Since we replace the original funcallable-standard-object with
+;; a new one, we have to prevent LispWorks from trying to use
+;; the original one when forward-ferenced-classes are resolved.
+
+#-lispworks5.0
+(cl:defmethod change-class :around
+ ((class forward-referenced-class)
+ (new-class funcallable-standard-class)
+ &rest initargs
+ &key (direct-superclasses ()))
+ (declare (dynamic-extent initargs))
+ (apply #'call-next-method class new-class
+ :optimize-slot-access nil
+ :direct-superclasses (modify-superclasses direct-superclasses nil)
+ initargs))
+
+;;; In LispWorks, the slot accessors (slot-value-using-class, etc.) are specialized
+;;; on slot names instead of effective slot definitions. In order to fix this,
+;;; we need to rewire the slot access protocol.
+
+(cl:defmethod slot-value-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-value-using-class class object slotd)
+ (slot-missing class object slot 'slot-value))))
+
+(cl:defmethod slot-value-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-value-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd)))
+
+(cl:defmethod (setf slot-value-using-class)
+ (new-value (class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (setf (slot-value-using-class class object slotd)
+ new-value)
+ (slot-missing class object slot 'setf new-value))))
+
+(cl:defmethod (setf slot-value-using-class)
+ (new-value (class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (setf (slot-value-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd))
+ new-value))
+
+(cl:defmethod slot-boundp-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-boundp-using-class class object slotd)
+ (slot-missing class object slot 'slot-boundp))))
+
+(cl:defmethod slot-boundp-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-boundp-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd)))
+
+(cl:defmethod slot-makunbound-using-class
+ ((class standard-class) object (slot symbol))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (let ((slotd (find slot (class-slots class)
+ :test #'eq
+ :key #'slot-definition-name)))
+ (if slotd
+ (slot-makunbound-using-class class object slotd)
+ (slot-missing class object slot 'slot-makunbound))))
+
+(cl:defmethod slot-makunbound-using-class
+ ((class standard-class) object (slotd standard-effective-slot-definition))
+ (declare (optimize (speed 3) (debug 0) (safety 0)
+ (compilation-speed 0)))
+ (slot-makunbound-using-class
+ (load-time-value (class-prototype (find-class 'cl:standard-class)))
+ object
+ (slot-definition-name slotd)))
+
+;; In LispWorks, eql specializers are lists. We cannot change this
+;; but we can soften some of the incompatibilities.
+
+(deftype eql-specializer ()
+ '(or eql-specializer*
+ (satisfies clos:eql-specializer-p)))
+
+(cl:defgeneric eql-specializer-object (eql-specializer)
+ (:method ((cons cons))
+ (if (clos:eql-specializer-p cons)
+ (cadr cons)
+ (error "~S is not an eql-specializer." cons))))
+
+(defun intern-eql-specializer (object)
+ `(eql ,object))
+
+(cl:defclass eql-specializer* (metaobject)
+ ((obj :reader eql-specializer-object
+ :initarg eso
+ :initform (error "Use intern-eql-specializer to create eql-specializers."))
+ (direct-methods :reader specializer-direct-methods
+ :accessor es-direct-methods
+ :initform ())))
+
+(defvar *eql-specializers* (make-hash-table))
+
+(defun intern-eql-specializer* (object)
+ (or (gethash object *eql-specializers*)
+ (setf (gethash object *eql-specializers*)
+ (make-instance 'eql-specializer* 'eso object))))
+
+(cl:defmethod add-direct-method ((specializer eql-specializer*) (method method))
+ (pushnew method (es-direct-methods specializer)))
+
+(cl:defmethod remove-direct-method ((specializer eql-specializer*) (method method))
+ (removef (es-direct-methods specializer) method))
+
+(cl:defgeneric specializer-direct-generic-functions (specializer)
+ (:method ((class class))
+ (remove-duplicates
+ (mapcar #'method-generic-function
+ (specializer-direct-methods class))))
+ (:method ((eql-specializer eql-specializer*))
+ (remove-duplicates
+ (mapcar #'method-generic-function
+ (specializer-direct-methods eql-specializer))))
+ (:method ((cons cons))
+ (specializer-direct-generic-functions
+ (intern-eql-specializer*
+ (eql-specializer-object cons)))))
+
+;; The following method ensures that remove-method is called.
+
+#-lispworks5.0
+(cl:defmethod add-method :before ((gf standard-generic-function) (method method))
+ (when-let (old-method (find-method gf (method-qualifiers method)
+ (method-specializers method) nil))
+ (remove-method gf old-method)))
+
+;; The following two methods ensure that add/remove-direct-method is called,
+;; and that the dependent protocol for generic function works.
+
+(cl:defmethod add-method :after ((gf standard-generic-function) (method method))
+ (loop for specializer in (method-specializers method)
+ if (consp specializer)
+ do (add-direct-method
+ (intern-eql-specializer*
+ (eql-specializer-object specializer))
+ method)
+ #-lispworks5.0 else
+ #-lispworks5.0 do
+ #-lispworks5.0 (add-direct-method specializer method))
+ #+lispworks4.3
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'add-method method))))
+
+(cl:defmethod remove-method :after ((gf standard-generic-function) (method method))
+ (loop for specializer in (method-specializers method)
+ if (consp specializer)
+ do (remove-direct-method
+ (intern-eql-specializer*
+ (eql-specializer-object specializer))
+ method)
+ #-lispworks5.0 else
+ #-lispworks5.0 do
+ #-lispworks5.0 (remove-direct-method specializer method))
+ #+lispworks4.3
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'remove-method method))))
+
+(cl:defgeneric find-method-combination (gf combi combi-options)
+ (:method ((gf generic-function) (combi symbol) combi-options)
+ (when combi-options
+ (error "This implementation of find-method-combination cannot handle method combination options."))
+ (clos::find-a-method-combination-type combi)))
+
+;; In LispWorks, make-method-lambda expects different arguments than those
+;; specified in AMOP. We just bridge this. The method lambda returned
+;; still doesn't conform to AMOP, but may be good enough.
+
+(cl:defgeneric make-method-lambda (gf method lambda-expression env)
+ (:method ((gf cl:standard-generic-function)
+ (method standard-method)
+ lambda-expression env)
+ (declare (ignorable env))
+ (destructuring-bind
+ (lambda (&rest args) &body body)
+ lambda-expression
+ (declare (ignore lambda))
+ (loop with documentation = :unbound
+ for (car . cdr) = body then cdr
+ while (or (stringp car)
+ (and (consp car) (eq (car car) 'declare)))
+ if (stringp car)
+ do (setf documentation
+ (if (eq documentation :unbound) car
+ (error "Too many documentation strings in lambda expression ~S."
+ lambda-expression)))
+ else append (loop for declaration in (cdr car)
+ if (eq (car declaration) 'ignore)
+ collect `(ignorable ,@(cdr declaration))
+ and collect `(dynamic-extent ,@(cdr declaration))
+ else collect declaration) into declarations
+ finally (multiple-value-bind
+ (method-lambda method-args)
+ (clos:make-method-lambda
+ gf method args declarations
+ `(progn ,car ,@cdr) env)
+ (if (eq documentation :unbound)
+ (return (values method-lambda method-args))
+ (return (values
+ `(lambda ,(cadr method-lambda)
+ ,documentation
+ ,@(cddr method-lambda))
+ method-args))))))))
+
+(defun ensure-method (gf lambda-expression
+ &key (method-class (generic-function-method-class gf))
+ (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (multiple-value-bind
+ (method-lambda method-args)
+ (make-method-lambda
+ gf (class-prototype method-class)
+ lambda-expression ())
+ (let ((method (apply #'make-instance
+ method-class
+ :qualifiers qualifiers
+ :lambda-list lambda-list
+ :specializers specializers
+ :function (compile nil method-lambda)
+ method-args)))
+ (add-method gf method)
+ method)))
+
+;; helper function for creating a generic function lambda list
+;; from a method lambda list.
+(defun create-gf-lambda-list (method-lambda-list)
+ (loop with stop-keywords = '#.(remove '&optional lambda-list-keywords)
+ for arg in method-lambda-list
+ until (member arg stop-keywords)
+ collect arg into gf-lambda-list
+ finally (return (let (rest)
+ (cond ((member '&key method-lambda-list)
+ (nconc gf-lambda-list '(&key)))
+ ((setq rest (member '&rest method-lambda-list))
+ (nconc gf-lambda-list (subseq rest 0 2)))
+ (t gf-lambda-list))))))
+
+;; The defmethod macro is needed in order to ensure that make-method-lambda
+;; is called. (Unfortunately, this doesn't work in the other CL implementations.)
+
+(defmacro defmethod (&whole form name &body body &environment env)
+ (loop for tail = body then (cdr tail)
+ until (listp (car tail))
+ collect (car tail) into qualifiers
+ finally
+ (destructuring-bind
+ ((&rest specialized-args) &body body) tail
+ (loop with documentation = :unbound
+ for (car . cdr) = body then cdr
+ while (or (stringp car)
+ (and (consp car) (eq (car car) 'declare)))
+ if (stringp car)
+ do (setq documentation
+ (if (eq documentation :unbound) car
+ (error "Too many documentation strings for defmethod form ~S." form)))
+ else append (cdr car) into declarations
+ finally
+ (let* ((lambda-list (extract-lambda-list specialized-args))
+ (gf-lambda-list (create-gf-lambda-list lambda-list))
+ (gf (if (fboundp name)
+ (ensure-generic-function name)
+ (ensure-generic-function name :lambda-list gf-lambda-list)))
+ (method-class (generic-function-method-class gf))
+ (lambda-expression `(lambda ,lambda-list
+ (declare ,@declarations)
+ (block ,name ,car ,@cdr))))
+ (if (equal (compute-applicable-methods
+ #'make-method-lambda
+ (list gf (class-prototype method-class)
+ lambda-expression env))
+ (list (find-method
+ #'make-method-lambda '()
+ (list (find-class 'cl:standard-generic-function)
+ (find-class 'standard-method)
+ (find-class 't)
+ (find-class 't))
+ nil)))
+ (return-from defmethod `(cl:defmethod ,@(rest form)))
+ (multiple-value-bind
+ (method-lambda method-args)
+ (make-method-lambda
+ gf (class-prototype method-class)
+ lambda-expression env)
+ (with-unique-names (gf method)
+ (return-from defmethod
+ `(let ((,gf (if (fboundp ',name)
+ (ensure-generic-function ',name)
+ (ensure-generic-function
+ ',name :lambda-list ',gf-lambda-list)))
+ (,method
+ (make-instance
+ ',method-class
+ :qualifiers ',qualifiers
+ :specializers
+ (list
+ ,@(mapcar
+ (lambda (specializer-name)
+ (typecase specializer-name
+ (symbol `(find-class ',specializer-name))
+ (cons (cond
+ ((> (length specializer-name) 2)
+ (error "Invalid specializer ~S in defmethod form ~S."
+ specializer-name form))
+ ((eq (car specializer-name) 'eql)
+ `(intern-eql-specializer ,(cadr specializer-name)))
+ (t (error "Invalid specializer ~S in defmethod form ~S."
+ specializer-name form))))
+ (t (error "Invalid specializer ~S in defmethod form ~S."
+ specializer-name form))))
+ (extract-specializer-names specialized-args)))
+ :lambda-list ',lambda-list
+ :function (function ,method-lambda)
+ ,@(unless (eq documentation :unbound)
+ (list :documentation documentation))
+ ,@method-args)))
+ (add-method ,gf ,method)
+ ,method))))))))))
+
+;; The following macro ensures that the new standard-generic-function
+;; is used by default. It also ensures that make-method-lambda is called
+;; for the default methods, by expanding into defmethod forms.
+
+(defmacro defgeneric (&whole form name (&rest args) &body options)
+ (unless (every #'consp options)
+ (error "Illegal generic functions options in defgeneric form ~S." form))
+ `(progn
+ (let ((generic-function (ignore-errors (fdefinition ',name))))
+ (when (and generic-function (typep generic-function 'standard-generic-function))
+ (loop for method in (slot-value generic-function 'initial-methods)
+ do (remove-method generic-function method))))
+ (cl:defgeneric ,name ,args
+ ,@(remove :method options :key #'car :test #'eq)
+ ,@(unless (member :generic-function-class options :key #'car :test #'eq)
+ '((:generic-function-class standard-generic-function))))
+ (let ((generic-function (fdefinition ',name)))
+ (setf (slot-value generic-function 'initial-methods)
+ (list ,@(loop for method-spec in (remove :method options :key #'car :test-not #'eq)
+ collect `(defmethod ,name ,@(cdr method-spec)))))
+ generic-function)))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ initargs)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/mcl/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/mcl/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/mcl/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,190 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ #-openmcl
+ (:shadow #:defclass #:standard-class #:typep #:subtypep)
+ #-openmcl
+ (:export #:defclass #:standard-class #:typep #:subtypep)
+
+ (:import-from #:ccl
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #-(or mcl openmcl) #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-(or mcl openmcl) #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-(or mcl openmcl) #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #+openmcl #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #-(or mcl openmcl) #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #-(or mcl openmcl) #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #-(or mcl openmcl) #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #+openmcl #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #-openmcl #:subtypep
+ #-openmcl #:typep
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/mcl/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/mcl/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/mcl/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,177 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+#-openmcl
+(progn
+ ;; We need a new standard-class for various things.
+
+ (cl:defclass standard-class (cl:standard-class)
+ ())
+
+ ;; validate-superclass for metaclass classes is a little bit
+ ;; more tricky than for class metaobject classes because
+ ;; we don't want to make all standard-classes compatible to
+ ;; each other.
+
+ ;; Our validate-superclass may get passed a class-prototype
+ ;; as its second argument, so don't expect its readers to
+ ;; yield useful information. (In ANSI parlance, "the
+ ;; consequences are undefined...")
+
+ (cl:defmethod validate-superclass
+ ((class standard-class)
+ (superclass cl:standard-class))
+ (or (when (eq (class-of class) (find-class 'standard-class))
+ (or (eq (class-of superclass) (find-class 'cl:standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'cl:standard-class))
+ (validate-superclass class (class-prototype (find-class 'standard-class))))))
+
+ ;; The following macro ensures that the new standard-class is used
+ ;; by default. It would have been useful to fix other deficiencies
+ ;; in a complete redefinition of defclass, but there is no portable
+ ;; way to ensure the necessary compile-time effects as specified
+ ;; by ANSI Common Lisp. Therefore, we just expand to the original
+ ;; cl:defclass.
+
+ (defmacro defclass (name (&rest supers) &body options)
+ (if (member :metaclass options :key #'car)
+ `(cl:defclass ,name ,supers ,@options)
+ `(cl:defclass ,name ,supers ,@options
+ (:metaclass standard-class))))
+
+ ;; In MCL, the list of direct superclasses passed by the
+ ;; defclass macro is not empty, as required by AMOP, but
+ ;; instead passes the class metaobject for standard-object
+ ;; or funcallable-standard-object respectively. This makes
+ ;; replacing the default superclass for a new metaclass a bit
+ ;; more complicated. In order to avoid the tricky bits in user
+ ;; code, the new standard-class adjusts possible incorrect
+ ;; direct superclasses by adding or removing the metaobject
+ ;; for standard-object as needed before passing them to
+ ;; the original standard-class. In user code, just use the
+ ;; idiom suggested by AMOP to APPEND your new default superclass
+ ;; to the list of direct superclasses.
+
+ (defun modify-superclasses (direct-superclasses)
+ (if (null direct-superclasses)
+ (list (find-class 'standard-object))
+ (let ((standard-object (find-class 'standard-object)))
+ (if (eq (car (last direct-superclasses)) standard-object)
+ direct-superclasses
+ (remove standard-object direct-superclasses)))))
+
+ (cl:defmethod initialize-instance :around
+ ((class standard-class) &rest initargs
+ &key (name (gensym)) (direct-superclasses ()))
+ (declare (dynamic-extent initargs))
+ (apply #'call-next-method class
+ :name name
+ :direct-superclasses (modify-superclasses direct-superclasses)
+ initargs))
+
+ (cl:defmethod reinitialize-instance :around
+ ((class standard-class) &rest initargs
+ &key (direct-superclasses () direct-superclasses-p))
+ (declare (dynamic-extent initargs))
+ (if direct-superclasses-p
+ (apply #'call-next-method class
+ :direct-superclasses (modify-superclasses direct-superclasses)
+ initargs)
+ (call-next-method)))
+
+ (defgeneric typep (object type)
+ (:method (object type)
+ (cl:typep object type))
+ (:method (object (type class))
+ (member (class-of object)
+ (class-precedence-list type))))
+
+ (defgeneric subtypep (type1 type2)
+ (:method (type1 type2)
+ (cl:subtypep type1 type2))
+ (:method ((type1 class) (type2 symbol))
+ (let ((class2 (find-class type2 nil)))
+ (if class2
+ (member class2 (class-precedence-list type1))
+ (cl:subtypep type1 type2))))
+ (:method ((type1 symbol) (type2 class))
+ (let ((class1 (find-class type1 nil)))
+ (if class1
+ (member type2 (class-precedence-list class1))
+ (cl:subtypep type1 type2))))
+ (:method ((type1 class) (type2 class))
+ (member type2 (class-precedence-list type1)))))
+
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (eval `(defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))
+
+;; The following ensures that slot definitions have a documentation in OpenMCL.
+
+#+openmcl
+(defmethod initialize-instance :after ((slot slot-definition) &key documentation)
+ (setf (documentation slot 't) documentation))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ #+openmcl initargs
+ #-openmcl
+ (let* ((counts (loop with counts
+ for (key nil) on initargs by #'cddr
+ do (incf (getf counts key 0))
+ finally (return counts)))
+ (keys-to-fix (loop for (key value) on counts by #'cddr
+ if (> value 1) collect key)))
+ (if keys-to-fix
+ (let ((multiple-standard-keys
+ (intersection keys-to-fix *standard-slot-keys*)))
+ (if multiple-standard-keys
+ (error "Too many occurences of ~S in slot initargs ~S."
+ multiple-standard-keys initargs)
+ (loop with fixed-keys
+ for (key value) on initargs by #'cddr
+ if (member key keys-to-fix)
+ do (nconcf (getf fixed-keys key) (list value))
+ else nconc (list key value) into fixed-initargs
+ finally (return (nconc fixed-initargs fixed-keys)))))
+ initargs)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/pcl/closer-mop-packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/pcl/closer-mop-packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/pcl/closer-mop-packages.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,190 @@
+(in-package :cl-user)
+
+(defpackage #:closer-mop
+ (:use #:common-lisp #:lispworks)
+ (:nicknames #:c2mop)
+
+ #-sbcl (:shadow #:typep #:subtypep)
+ #-sbcl (:export #:typep #:subtypep)
+
+ (:import-from
+ #+cmu #:clos-mop
+ #+sbcl #:sb-mop
+
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class)
+
+ (:export
+ #:direct-slot-definition
+ #:effective-slot-definition
+ #:eql-specializer
+ #:forward-referenced-class
+ #:funcallable-standard-class
+ #:funcallable-standard-object
+ #:metaobject
+ #:slot-definition
+ #:specializer
+ #:standard-accessor-method
+ #:standard-direct-slot-definition
+ #:standard-effective-slot-definition
+ #:standard-reader-method
+ #:standard-slot-definition
+ #:standard-writer-method
+
+ #:ensure-finalized
+ #:ensure-method
+ #:fix-slot-initargs
+ #:required-args
+
+ #:accessor-method-slot-definition
+ #:add-dependent
+ #:add-direct-method
+ #:add-direct-subclass
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:compute-applicable-methods-using-classes
+ #:compute-class-precedence-list
+ #:compute-default-initargs
+ #:compute-discriminating-function
+ #:compute-effective-method
+ #:compute-effective-slot-definition
+ #:compute-slots
+ #:direct-slot-definition-class
+ #:effective-slot-definition-class
+ #:ensure-class
+ #:ensure-class-using-class
+ #:ensure-generic-function-using-class
+ #:eql-specializer-object
+ #:extract-lambda-list
+ #:extract-specializer-names
+ #:finalize-inheritance
+ #:find-method-combination
+ #:funcallable-standard-instance-access
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-methods
+ #:generic-function-name
+ #:intern-eql-specializer
+ #:make-method-lambda
+ #:map-dependents
+ #:method-function
+ #:method-generic-function
+ #:method-lambda-list
+ #:method-specializers
+ #:reader-method-class
+ #:remove-dependent
+ #:remove-direct-method
+ #:remove-direct-subclass
+ #:set-funcallable-instance-function
+ #:slot-boundp-using-class
+ #:slot-definition-allocation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-location
+ #:slot-definition-name
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-definition-type
+ #:slot-makunbound-using-class
+ #:slot-value-using-class
+ #:specializer-direct-generic-functions
+ #:specializer-direct-methods
+ #:standard-instance-access
+ #:subtypep
+ #:typep
+ #:update-dependent
+ #:validate-superclass
+ #:writer-method-class))
Added: branches/trunk-reorg/thirdparty/closer-mop/pcl/closer-mop.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/pcl/closer-mop.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/pcl/closer-mop.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,284 @@
+(in-package :closer-mop)
+
+;; Some utility functions.
+
+(defun required-args (lambda-list &optional (collector #'identity))
+ (loop for arg in lambda-list
+ until (member arg lambda-list-keywords)
+ collect (funcall collector arg)))
+
+(defun ensure-finalized (class &optional (errorp t))
+ (if (typep class 'class)
+ (unless (class-finalized-p class)
+ (finalize-inheritance class))
+ (when errorp (error "~S is not a class." class)))
+ class)
+
+;; The following is commented out. SBCL now supports compatible standard-class and
+;; funcallable-standard-class metaclasses, but this requires that we don't mess with
+;; the class hierarchy anymore. So we will try the trick we have already used
+;; for generic functions: We just add methods for the existing metaclasses.
+;; This is not AMOP-compliant, but if it works it works.
+
+#|
+;; We need a new standard-class for various things.
+
+(cl:defclass standard-class (cl:standard-class)
+ ())
+
+;; validate-superclass for metaclass classes is a little bit
+;; more tricky than for class metaobject classes because
+;; we don't want to make all standard-classes compatible to
+;; each other.
+
+;; Our validate-superclass may get passed a class-prototype
+;; as its second argument, so don't expect its readers to
+;; yield useful information. (In ANSI parlance, "the
+;; consequences are undefined...")
+
+(cl:defmethod validate-superclass
+ ((class standard-class)
+ (superclass cl:standard-class))
+ (or (when (eq (class-of class) (find-class 'standard-class))
+ (or (eq (class-of superclass) (find-class 'cl:standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+ (call-next-method)
+ (when (eq (class-of superclass) (find-class 'cl:standard-class))
+ (validate-superclass class (class-prototype (find-class 'standard-class))))))
+
+#+sbcl
+(cl:defmethod validate-superclass
+ ((class funcallable-standard-class)
+ (superclass standard-class))
+ (and (eq (class-of class) (find-class 'funcallable-standard-class))
+ (eq (class-of superclass) (find-class 'standard-class))))
+
+;; The following macro ensures that the new standard-class is used
+;; by default. It would have been useful to fix other deficiencies
+;; in a complete redefinition of defclass, but there is no portable
+;; way to ensure the necessary compile-time effects as specified
+;; by ANSI Common Lisp. Therefore, we just expand to the original
+;; cl:defclass.
+
+(defmacro defclass (name (&rest supers) &body options)
+ (if (member :metaclass options :key #'car)
+ `(cl:defclass ,name ,supers ,@options)
+ `(cl:defclass ,name ,supers ,@options
+ (:metaclass standard-class))))
+|#
+
+;; In CMUCL, reader-method-class and writer-method-class are
+;; not used during class initialization. The following definitions
+;; correct this.
+
+#-sbcl
+(defun modify-accessors (class)
+ (loop with reader-specializers = (list class)
+ with writer-specializers = (list (find-class 't) class)
+ for slotd in (class-direct-slots class) do
+ (loop for reader in (slot-definition-readers slotd)
+ for reader-function = (fdefinition reader)
+ for reader-method = (find-method reader-function () reader-specializers)
+ for initargs = (list :qualifiers ()
+ :lambda-list '(object)
+ :specializers reader-specializers
+ :function (method-function reader-method)
+ :slot-definition slotd)
+ for method-class = (apply #'reader-method-class class slotd initargs)
+ unless (eq method-class (class-of reader-method))
+ do (add-method reader-function (apply #'make-instance method-class initargs)))
+ (loop for writer in (slot-definition-writers slotd)
+ for writer-function = (fdefinition writer)
+ for writer-method = (find-method writer-function () writer-specializers)
+ for initargs = (list :qualifiers ()
+ :lambda-list '(new-value object)
+ :specializers writer-specializers
+ :function (method-function writer-method)
+ :slot-definition slotd)
+ for method-class = (apply #'writer-method-class class slotd initargs)
+ unless (eq method-class (class-of writer-method))
+ do (add-method writer-function (apply #'make-instance method-class initargs)))))
+
+;; The following methods additionally create a gensym for the class name
+;; unless a name is explicitly provided. AMOP requires classes to be
+;; potentially anonymous.
+
+#-sbcl
+(cl:defmethod initialize-instance :around
+ ((class standard-class) &rest initargs
+ &key (name (gensym)))
+ (declare (dynamic-extent initargs))
+ (prog1 (apply #'call-next-method class :name name initargs)
+ (modify-accessors class)))
+
+#-sbcl
+(cl:defmethod initialize-instance :around
+ ((class funcallable-standard-class) &rest initargs
+ &key (name (gensym)))
+ (declare (dynamic-extent initargs))
+ (prog1 (apply #'call-next-method class :name name initargs)
+ (modify-accessors class)))
+
+#-sbcl
+(cl:defmethod reinitialize-instance :after
+ ((class standard-class) &key)
+ (modify-accessors class))
+
+#-sbcl
+(cl:defmethod reinitialize-instance :after
+ ((class funcallable-standard-class) &key)
+ (modify-accessors class))
+
+;;; The following three methods ensure that the dependent protocol
+;;; for generic function works.
+
+;; The following method additionally ensures that
+;; compute-discriminating-function is triggered.
+
+; Note that for CMUCL, these methods violate the AMOP specification
+; by specializing on the original standard-generic-function metaclass. However,
+; this is necassary because in CMUCL, only one subclass of
+; standard-generic-function can be created, and taking away that option from user
+; code doesn't make a lot of sense in our context.
+
+#-sbcl
+(cl:defmethod reinitialize-instance :after
+ ((gf standard-generic-function) &rest initargs)
+ (declare (dynamic-extent initargs))
+ (set-funcallable-instance-function
+ gf (compute-discriminating-function gf))
+ #-cmu
+ (map-dependents
+ gf (lambda (dep) (apply #'update-dependent gf dep initargs))))
+
+#-(or cmu sbcl)
+(cl:defmethod add-method :after
+ ((gf standard-generic-function) method)
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'add-method method))))
+
+#-(or cmu sbcl)
+(cl:defmethod remove-method :after
+ ((gf standard-generic-function) method)
+ (map-dependents
+ gf (lambda (dep) (update-dependent gf dep 'remove-method method))))
+
+#+sbcl
+(defun ensure-method (gf lambda-expression
+ &key (method-class (generic-function-method-class gf))
+ (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly (find-class 't)))))
+ (multiple-value-bind
+ (method-lambda method-args)
+ (make-method-lambda
+ gf (class-prototype method-class)
+ lambda-expression ())
+ (let ((method (apply #'make-instance
+ method-class
+ :qualifiers qualifiers
+ :lambda-list lambda-list
+ :specializers specializers
+ :function (compile nil method-lambda)
+ method-args)))
+ (add-method gf method)
+ method)))
+
+#|
+(defgeneric transform-specializer (specializer)
+ (:method (specializer) specializer)
+ (:method ((specializer class))
+ (class-name specializer))
+ (:method ((specializer eql-specializer))
+ `(eql ,(eql-specializer-object specializer))))
+|#
+
+#-sbcl
+(defun ensure-method (gf lambda-expression
+ &key (qualifiers ())
+ (lambda-list (cadr lambda-expression))
+ (specializers (required-args lambda-list (constantly 't))))
+ (funcall (compile nil `(lambda ()
+ (defmethod ,(generic-function-name gf) ,@qualifiers
+ ,(loop for specializer in specializers
+ for (arg . rest) on lambda-list
+ collect `(,arg ,specializer) into args
+ finally (return (nconc args rest)))
+ ,@(cddr lambda-expression))))))
+
+;; The following ensures that effective slot definitions have a documentation in CMUCL.
+
+#+cmu
+(defmethod compute-effective-slot-definition :around
+ ((class standard-class) name direct-slot-definitions)
+ (let ((effective-slot (call-next-method)))
+ (loop for direct-slot in direct-slot-definitions
+ for documentation = (documentation direct-slot 't)
+ when documentation do
+ (setf (documentation effective-slot 't) documentation)
+ (loop-finish))
+ effective-slot))
+
+;; The following can be used in direct-slot-definition-class to get the correct initargs
+;; for a slot. Use it like this:
+;;
+;; (defmethod direct-slot-definition-class
+;; ((class my-standard-class) &rest initargs)
+;; (declare (dynamic-extent initargs))
+;; (destructuring-bind
+;; (&key key-of-interest &allow-other-keys)
+;; (fix-slot-initargs initargs)
+;; ...))
+
+(defvar *standard-slot-keys*
+ '(:name :documentation
+ :initargs :initform :initfunction
+ :readers :writers))
+
+(defun fix-slot-initargs (initargs)
+ #+sbcl initargs
+ #+cmu
+ (let* ((counts (loop with counts
+ for (key nil) on initargs by #'cddr
+ do (incf (getf counts key 0))
+ finally (return counts)))
+ (keys-to-fix (loop for (key value) on counts by #'cddr
+ if (> value 1) collect key)))
+ (if keys-to-fix
+ (let ((multiple-standard-keys
+ (intersection keys-to-fix *standard-slot-keys*)))
+ (if multiple-standard-keys
+ (error "Too many occurences of ~S in slot initargs ~S."
+ multiple-standard-keys initargs)
+ (loop with fixed-keys
+ for (key value) on initargs by #'cddr
+ if (member key keys-to-fix)
+ do (nconcf (getf fixed-keys key) (list value))
+ else nconc (list key value) into fixed-initargs
+ finally (return (nconc fixed-initargs fixed-keys)))))
+ initargs)))
+
+;; In CMUCL, TYPEP and SUBTYPEP don't work as expected
+;; in conjunction with class metaobjects.
+
+#-sbcl
+(progn
+ (defgeneric typep (object type)
+ (:method (object type)
+ (cl:typep object type))
+ (:method (object (type class))
+ (cl:typep object (class-name type))))
+
+ (defgeneric subtypep (type1 type2)
+ (:method (type1 type2)
+ (cl:subtypep type1 type2))
+ (:method ((type1 class) type2)
+ (cl:subtypep (class-name type1) type2))
+ (:method (type1 (type2 class))
+ (cl:subtypep type1 (class-name type2)))
+ (:method ((type1 class) (type2 class))
+ (cl:subtypep (class-name type1)
+ (class-name type2)))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (pushnew :closer-mop *features*))
Added: branches/trunk-reorg/thirdparty/closer-mop/release-notes.txt
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/release-notes.txt 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/release-notes.txt 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,34 @@
+Closer to MOP Release Note
+
+v0.0 initial release
+
+v0.1
+- separated single implementation into several ones, one for each MOP implementation / implementation family, in order to improve maintainability
+- added support for LispWorks 4.4
+- removed extra method options from the LispWorks defmethod - it's a useful feature, but doesn't belong here
+- the automatically generated slot accessor methods in LispWorks closed over the wrong slot names. fixed. (obsolete because of the next issue)
+- In some cases, LispWorks deoptimizes slot access and reverts to the slot-value-using-class, etc., functions. This rendered the previously taken approach for fixing that protocol useless. Now, we have a much simpler fix. (Thanks to Jeff Caldwell.) Unfortunately, now some of the features that were previously fixed are missing again (correct initialization of accessor methods, accessor-method-slot-definition, reader-method-class and writer-method-class). Fortunately, LispWorks has already fixed those in 4.4, so this is no problem anymore in the long run.
+
+v0.2
+- The trick for reinitialization of generic-function-name or class-name in allegro, pcl, lispworks and mcl didn't work and had to be dropped.
+- In clisp, defgeneric does call ensure-generic-function-using-class. This wasn't detected before due to a bug in mop-feature-tests. (Thanks to Bruno Haible.)
+- Added the utility function ensure-method for programmatically creating methods, supported on all platforms.
+- The defmethod macro for LispWorks didn't have an implicit block with the name of the generic function. Fixed.
+- LispWorks 4.3 is not supported anymore. The existing conditionalizations are still available, though, and will be retained as long as they don't stand in the way of anything else.
+- Since I have to override some symbols from the common-lisp package, I provide two utility packages closer-common-lisp and closer-common-lisp-user, similar to common-lisp and common-lisp-user but with all the MOP symbols added. The default packages additionally added by the various Common Lisp implementations are not added here. (I think that's cleaner.)
+- Handling of pseudo-anonymous classes in CMU CL and SBCL had a copy&paste bug: The name was changed again in reinitialize-instance.
+- TYPEP and SUBTYPEP don't work as expected in CMU CL and SBCL in conjunction with class metaobjects. Same for MCL, but for different reasons. So I have shadowed them and provide a new definition. (In CMU CL and SBCL, class metaobject are not considered types. In MCL, type information for class metaobjects is not available at some stages. Unfortunately, it doesn't seem to be possible to fix this with finalize-inheritance, so I have to revert to membership tests on the class precedence list.)
+- MCL also doesn't like anonymous classes. So I have added a fix for that.
+- I have incorrectly reported that MAKE-METHOD-LAMBDA is unreliable in CMU CL and SBCL. This was due to a bug in my test suite. However, it is required that the respective generic function and method metaobject classes and make-method-lambda definitions are part of the compilation environment when you want to use them. I have updated the respective sections in features.lisp and features.txt.
+- Switched to an MIT/BSD-style license.
+
+v0.3
+- Now supports OpenMCL 1.0, LispWorks 4.4.6, SBCL 0.9.7 - 0.9.9, CMUCL 19C, Allegro 8.0, clisp 2.37 and 2.38.
+- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are now compatible in SBCL. This required some changes in the PCL support.
+- Dropped the reports for LispWorks 4.3.
+- Allegro 6.2 is not supported anymore. The existing conditionalizations are still available, though, and will be retained as long as they don't stand in the way of anything else.
+- The incorrect specialization of slot-boundp-using-class and slot-makunbound-using-class on symbols instead of slot definition metaobjects in Allegro is fixed.
+- SBCL 0.9.7 has improved a lot wrt MOP compatibility. This required some changes in the PCL support.
+- The lack of extensible :allocation kinds in Allegro is fixed. (Covers 6.2, 7.0 and 8.0. Thanks to John Foderaro for giving me the important hint on how to solve this.)
+
+After version 0.3, there are no separate release notes anymore, but they will be generated automatically by darcs in the future.
Added: branches/trunk-reorg/thirdparty/closer-mop/supported-cls.txt
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/supported-cls.txt 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/supported-cls.txt 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,10 @@
+Allegro 7.0, 8.0 & 8.1
+CLisp 2.35 - 2.41
+CMU Common Lisp 19c, 19d
+LispWorks 4.4.5, 4.4.6 Personal Edition
+LispWorks 4.4.5, 4.4.6 Professional Edition
+LispWorks 5.0, 5.0.1, Personal Edition
+LispWorks 5.0 - 5.0.2, Professional Edition
+Macintosh Common Lisp 5.1
+OpenMCL 1.0
+SBCL 0.9.16 - 0.9.18, 1.0.1 - 1.0.10
Added: branches/trunk-reorg/thirdparty/closer-mop/test/jeffs-code.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/closer-mop/test/jeffs-code.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/closer-mop/test/jeffs-code.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,207 @@
+;;; Jeff Caldwell 2004-04-16
+;;; LWL 4.3
+;;;
+;;; To reproduce the issues I have come across:
+;;;
+;;; 1. (asdf:oos 'asdf:load-op 'closer-mop)
+;;; 2. (compile-file "c2mop-attributes.lisp" :load t)
+;;; 3. (in-package #:c2mop-test)
+;;; C2MOP-TEST> (setq cr (make-instance 'credit-rating))
+;;; => Stack overflow (stack size 16000).
+;;;
+;;; (In this code, I accidently took out the format statements
+;;; creating the output below. You may wish to put them back
+;;; in the slot-value-using-class and (setf slot-value-using-class)
+;;; methods at the bottom of this file.)
+;;;
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C> slot-name ALL-ATTRIBUTES-2382
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C> slot-name LEVEL
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C>
+;;; slot-name #<ATTRIBUTES-EFFECTIVE-SLOT-DEFINITION LEVEL 2134396C>
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C> slot-name LEVEL
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C>
+;;; slot-name #<ATTRIBUTES-EFFECTIVE-SLOT-DEFINITION LEVEL 2134396C>
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C> slot-name LEVEL
+;;; slot-value-using-class class #<ATTRIBUTES-CLASS CREDIT-RATING 2134BF1C>
+;;; object #<CREDIT-RATING 21732B2C>
+;;; slot-name #<ATTRIBUTES-EFFECTIVE-SLOT-DEFINITION LEVEL 2134396C>
+;;; ...
+;;;
+;;; Note that it alternates between slot-name LEVEL and
+;;; slot-name #<ATTRIBUTES-EFFECTIVE-...
+;;;
+;;; In closer-mop.lisp change
+;;;
+;;; (cl:defmethod slot-value-using-class
+;;; ((class standard-class) object (slot symbol))
+;;; (let ((slotd (find slot (class-slots class) :key #'slot-definition-name)))
+;;; (if slotd
+;;; (if (default-reader slotd)
+;;; (slot-value-using-class class object slotd)
+;;; (call-next-method))
+;;; (slot-missing class object slot 'slot-value))))
+;;;
+;;; to
+;;;
+;;; ...
+;;; (if slotd
+;;; (if (default-reader slotd)
+;;; (slot-value-using-class (find-class 'standard-class)
+;;; object slotd)
+;;; ...
+;;;
+;;; (I have no idea if that's a correct patch but it does stop
+;;; the recursive stack overflow.)
+;;;
+;;; Then
+;;; (asdf:oos 'asdf:load-op 'closer-mop)
+;;; (setq cr (make-instance 'credit-rating)
+;;; =>
+;;; The slot #<ATTRIBUTES-EFFECTIVE-SLOT-DEFINITION LEVEL 2133983C> is
+;;; missing from #<CREDIT-RATING 206F0864> (of class #<ATTRIBUTES-CLASS
+;;; CREDIT-RATING 2133B3DC>), when reading the value.
+;;;
+;;; At this point you also can remove the slot-value-using-class and
+;;; setf slot-value-using-class methods. They were no-ops in this
+;;; example, something I had run across in other code. I left them
+;;; here to show the recursive stack overflow. Now that it is "fixed",
+;;; we are left with the missing slot problem above.
+;;; (The problem above is somewhat different from what I reported
+;;; in my first email but the error above is what I'm getting now
+;;; with this example.)
+;;;
+;;; Simply using the LW MOP, instead of using closer-mop,
+;;; "fixes" the problem above. Quit using closer-mop and revert
+;;; to the LW-only MOP. Change the defpackage to
+;;;
+;;; (defpackage #:c2mop-test
+;;; (:use :cl :cl-user :clos))
+;;;
+;;; (cl-user::quit) ;; Make really sure everything's fresh
+;;; M-x slime
+;;; (compile-file "c2mop-attributes.lisp" :load t)
+;;; CL-USER> (in-package #:c2mop-test)
+;;; #<PACKAGE C2MOP-TEST>
+;;; C2MOP-TEST> (setq cr (make-instance 'credit-rating))
+;;; #<CREDIT-RATING 206EDFAC>
+;;; C2MOP-TEST> (setf (level cr) 42)
+;;; 42
+;;; C2MOP-TEST> (level cr)
+;;; 42
+;;; C2MOP-TEST> (setf (slot-attribute cr 'level 'date-set) 20040416)
+;;; 20040416
+;;; C2MOP-TEST> (slot-attribute cr 'level 'date-set)
+;;; 20040416
+;;;
+
+
+;;;
+(defpackage #:c2mop-test
+; (:use :cl :cl-user :clos)
+ (:use :cl :cl-user :closer-mop)
+ (:shadowing-import-from :closer-mop
+ #:defclass #:defmethod #:standard-class
+ #:ensure-generic-function #:defgeneric
+ #:standard-generic-function #:class-name)
+)
+
+(in-package #:c2mop-test)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+(defvar *all-attributes* (gensym "ALL-ATTRIBUTES-"))
+(defvar *current-direct-slot-definitions* nil)
+
+(defclass attributes-class (standard-class) ())
+
+(defclass attributes-mixin
+ (standard-slot-definition)
+ ((attributes :initarg :attributes :accessor slot-definition-attributes
+ :initform nil)))
+
+(defclass attributes-direct-slot-definition
+ (standard-direct-slot-definition attributes-mixin)
+ ())
+
+(defclass attributes-effective-slot-definition
+ (standard-effective-slot-definition attributes-mixin)
+ ())
+
+(defmethod effective-slot-definition-class ((class attributes-class)
+ &rest initargs)
+ (find-class 'attributes-effective-slot-definition))
+
+(defmethod compute-effective-slot-definition ((class attributes-class)
+ name direct-slots)
+ (let* ((normal-slot (call-next-method)))
+ (setf (slot-definition-attributes normal-slot)
+ (remove-duplicates
+ (apply #'append (mapcar #'slot-definition-attributes
+ direct-slots))))
+ normal-slot))
+
+(defmethod direct-slot-definition-class
+ ((class attributes-class) &rest initargs)
+ (find-class 'attributes-direct-slot-definition))
+
+(defmethod process-a-slot-option
+ ((class attributes-class) option value
+ already-processed-options slot)
+ (princ "process-a-slot-option") (princ option)
+ (if (eq option :attributes)
+ (list* :attributes `',value already-processed-options)
+ (call-next-method)))
+
+(defmethod compute-slots ((class attributes-class))
+ (let* ((normal-slots (call-next-method))
+ (alist (mapcar (lambda (slot)
+ (cons (slot-definition-name slot)
+ (mapcar (lambda (attr) (cons attr nil))
+ (slot-definition-attributes
+ slot))))
+ normal-slots)))
+ (cons (make-instance 'attributes-effective-slot-definition
+ :name *all-attributes*
+ :initform alist
+ :initfunction (lambda () alist))
+ normal-slots)))
+
+(defun slot-attribute (instance slot-name attribute)
+ (cdr (slot-attribute-bucket instance slot-name attribute)))
+
+(defun (setf slot-attribute) (new-value instance slot-name attribute)
+ (setf (cdr (slot-attribute-bucket instance slot-name attribute))
+ new-value))
+
+(defun slot-attribute-bucket (instance slot-name attribute)
+ (let* ((all-buckets (slot-value instance *all-attributes*))
+ (slot-bucket (assoc slot-name all-buckets)))
+ (unless slot-bucket
+ (error "Slot ~S of ~S has no attributes."
+ slot-name instance))
+ (let ((attr-bucket (assoc attribute (cdr slot-bucket))))
+ (unless attr-bucket
+ (error "Slot ~S of ~S has no attribute ~S."
+ slot-name instance attribute))
+ attr-bucket)))
+
+(defmethod clos:slot-value-using-class
+ ((class attributes-class) object (slot-name attributes-effective-slot-definition))
+ (call-next-method))
+
+(defmethod (setf clos:slot-value-using-class)
+ (value (class attributes-class) object (slot-name attributes-effective-slot-definition))
+ (call-next-method))
+
+) ; eval-when
+
+(defclass credit-rating ()
+ ((level :attributes (date-set time-set) :accessor level)
+ (desc :accessor desc))
+ (:metaclass attributes-class))
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat-package.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat-package.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat-package.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,7 @@
+(in-package :cl-user)
+
+#-lispworks
+(defpackage #:lispworks
+ (:use #:common-lisp)
+ (:export #:appendf #:nconcf #:rebinding #:removef
+ #:when-let #:when-let* #:with-unique-names))
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat.asd
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat.asd 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat.asd 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,34 @@
+(asdf:defsystem #:lw-compat
+ :name "LispWorks Compatibility Library"
+ :author "Pascal Costanza, with permission from http://www.lispworks.com"
+ :version "0.22"
+ :licence "
+Copyright (c) 2005, 2006 Pascal Costanza
+with permission from http://www.lispworks.com
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the \"Software\"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or
+sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+"
+ :components (#-lispworks
+ (:file "lw-compat-package")
+ #-lispworks
+ (:file "lw-compat"
+ :depends-on ("lw-compat-package"))))
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/_darcs/current/lw-compat.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,50 @@
+(in-package #:lispworks)
+
+#+lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (error "lw-compat is not needed in LispWorks."))
+
+(define-modify-macro appendf (&rest lists)
+ append "Appends lists to the end of given list.")
+
+(define-modify-macro nconcf (&rest lists)
+ nconc "Appends lists to the end of given list by NCONC.")
+
+(defmacro rebinding (vars &body body)
+ "Ensures unique names for all the variables in a groups of forms."
+ (loop for var in vars
+ for name = (gensym (symbol-name var))
+ collect `(,name ,var) into renames
+ collect ``(,,var ,,name) into temps
+ finally (return `(let ,renames
+ (with-unique-names
+ ,vars
+ `(let (,,@temps)
+ ,,@body))))))
+
+(define-modify-macro removef (item &rest keys)
+ (lambda (place item &rest keys &key test test-not start end key)
+ (declare (ignorable test test-not start end key))
+ (apply #'remove item place keys))
+ "Removes an item from a sequence.")
+
+(defmacro when-let ((var form) &body body)
+ "Executes a body of code if a form evaluates to non-nil,
+ propagating the result of the form through the body of code."
+ `(let ((,var ,form))
+ (when ,var
+ (locally
+ ,@body))))
+
+(defmacro when-let* (bindings &body body)
+ "Executes a body of code if a series of forms evaluates to non-nil,
+ propagating the results of the forms through the body of code."
+ (loop for form = `(progn ,@body) then `(when-let (,(car binding) ,(cadr binding)) ,form)
+ for binding in (reverse bindings)
+ finally (return form)))
+
+(defmacro with-unique-names (names &body body)
+ "Returns a body of code with each specified name bound to a similar name."
+ `(let ,(mapcar (lambda (name) `(,name (gensym ,(symbol-name name))))
+ names)
+ ,@body))
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/inventories/20060826123920-dccf3-4b37fa484f969eb9c3837a020e32b42e33f4cef6.gz
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/_darcs/inventories/20060826123920-dccf3-4b37fa484f969eb9c3837a020e32b42e33f4cef6.gz 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/_darcs/inventories/20060826123920-dccf3-4b37fa484f969eb9c3837a020e32b42e33f4cef6.gz 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,8 @@
+[Initial revision (v0.2).
+pc(a)p-cos.net**20050802152818]
+[Added licensing information.
+pc(a)p-cos.net**20050811150118]
+[Replaced a reduce idiom with a better understandable loop idiom.
+pc(a)p-cos.net**20051228220551]
+[Removed a spurious in-package declaration in the .asd file.
+pc(a)p-cos.net**20060821203626]
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/inventory
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/_darcs/inventory 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/_darcs/inventory 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,7 @@
+Starting with tag:
+[TAG 0.22
+pc(a)p-cos.net**20060826123920]
+[Updated version number in the .asd file.
+pc(a)p-cos.net**20060826125726]
+[Updated copyright information.
+pc(a)p-cos.net**20060918174843]
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20050802152818-dccf3-9ba8553d2b62c698e6208680ab099ea6273a7458.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20050802152818-dccf3-9ba8553d2b62c698e6208680ab099ea6273a7458.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20050811150118-dccf3-9db8fc99fbfbac77dda86fa3ca80f0f92c0f054b.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20050811150118-dccf3-9db8fc99fbfbac77dda86fa3ca80f0f92c0f054b.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20051228220551-dccf3-bec704780b86cf94b4f443e53d52d8e46f8ab139.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20051228220551-dccf3-bec704780b86cf94b4f443e53d52d8e46f8ab139.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060821203626-dccf3-a75c8e2b513b571a43ce6c5e8dd377b2bca40887.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060821203626-dccf3-a75c8e2b513b571a43ce6c5e8dd377b2bca40887.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060826123920-dccf3-4b37fa484f969eb9c3837a020e32b42e33f4cef6.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060826123920-dccf3-4b37fa484f969eb9c3837a020e32b42e33f4cef6.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060826125726-dccf3-b9ca9d92f93eefe4744f2275eaf40b6702e5b743.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060826125726-dccf3-b9ca9d92f93eefe4744f2275eaf40b6702e5b743.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060918174843-dccf3-641503d97f1447c7cf67b79d9d0e557fe35e4dfa.gz
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/lw-compat/_darcs/patches/20060918174843-dccf3-641503d97f1447c7cf67b79d9d0e557fe35e4dfa.gz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/binaries
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/binaries 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/binaries 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,39 @@
+# Binary file regexps:
+\.png$
+\.PNG$
+\.gz$
+\.GZ$
+\.pdf$
+\.PDF$
+\.jpg$
+\.JPG$
+\.gif$
+\.GIF$
+\.tar$
+\.TAR$
+\.bz2$
+\.BZ2$
+\.z$
+\.Z$
+\.zip$
+\.ZIP$
+\.jar$
+\.JAR$
+\.so$
+\.SO$
+\.a$
+\.A$
+\.tgz$
+\.TGZ$
+\.jpeg$
+\.JPEG$
+\.mpg$
+\.MPG$
+\.mpeg$
+\.MPEG$
+\.iso$
+\.ISO$
+\.exe$
+\.EXE$
+\.doc$
+\.DOC$
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/boring
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/boring 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/boring 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,34 @@
+# Boring file regexps:
+\.hi$
+\.o$
+\.o\.cmd$
+# *.ko files aren't boring by default because they might
+# be Korean translations rather than kernel modules.
+# \.ko$
+\.ko\.cmd$
+\.mod\.c$
+(^|/)\.tmp_versions($|/)
+(^|/)CVS($|/)
+(^|/)RCS($|/)
+~$
+#(^|/)\.[^/]
+(^|/)_darcs($|/)
+\.bak$
+\.BAK$
+\.orig$
+(^|/)vssver\.scc$
+\.swp$
+(^|/)MT($|/)
+(^|/)\{arch\}($|/)
+(^|/).arch-ids($|/)
+(^|/),
+\.class$
+\.prof$
+(^|/)\.DS_Store$
+(^|/)BitKeeper($|/)
+(^|/)ChangeSet($|/)
+(^|/)\.svn($|/)
+\.py[co]$
+\#
+\.cvsignore$
+(^|/)Thumbs\.db$
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/defaultrepo
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/defaultrepo 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/defaultrepo 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1 @@
+http://common-lisp.net/project/closer/repos/lw-compat
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/motd
===================================================================
Added: branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/repos
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/repos 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/_darcs/prefs/repos 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1 @@
+http://common-lisp.net/project/closer/repos/lw-compat
Added: branches/trunk-reorg/thirdparty/lw-compat/lw-compat-package.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/lw-compat-package.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/lw-compat-package.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,7 @@
+(in-package :cl-user)
+
+#-lispworks
+(defpackage #:lispworks
+ (:use #:common-lisp)
+ (:export #:appendf #:nconcf #:rebinding #:removef
+ #:when-let #:when-let* #:with-unique-names))
Added: branches/trunk-reorg/thirdparty/lw-compat/lw-compat.asd
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/lw-compat.asd 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/lw-compat.asd 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,34 @@
+(asdf:defsystem #:lw-compat
+ :name "LispWorks Compatibility Library"
+ :author "Pascal Costanza, with permission from http://www.lispworks.com"
+ :version "0.22"
+ :licence "
+Copyright (c) 2005, 2006 Pascal Costanza
+with permission from http://www.lispworks.com
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the \"Software\"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or
+sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+"
+ :components (#-lispworks
+ (:file "lw-compat-package")
+ #-lispworks
+ (:file "lw-compat"
+ :depends-on ("lw-compat-package"))))
Added: branches/trunk-reorg/thirdparty/lw-compat/lw-compat.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/lw-compat/lw-compat.lisp 2007-10-04 19:49:06 UTC (rev 2206)
+++ branches/trunk-reorg/thirdparty/lw-compat/lw-compat.lisp 2007-10-04 19:56:01 UTC (rev 2207)
@@ -0,0 +1,50 @@
+(in-package #:lispworks)
+
+#+lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (error "lw-compat is not needed in LispWorks."))
+
+(define-modify-macro appendf (&rest lists)
+ append "Appends lists to the end of given list.")
+
+(define-modify-macro nconcf (&rest lists)
+ nconc "Appends lists to the end of given list by NCONC.")
+
+(defmacro rebinding (vars &body body)
+ "Ensures unique names for all the variables in a groups of forms."
+ (loop for var in vars
+ for name = (gensym (symbol-name var))
+ collect `(,name ,var) into renames
+ collect ``(,,var ,,name) into temps
+ finally (return `(let ,renames
+ (with-unique-names
+ ,vars
+ `(let (,,@temps)
+ ,,@body))))))
+
+(define-modify-macro removef (item &rest keys)
+ (lambda (place item &rest keys &key test test-not start end key)
+ (declare (ignorable test test-not start end key))
+ (apply #'remove item place keys))
+ "Removes an item from a sequence.")
+
+(defmacro when-let ((var form) &body body)
+ "Executes a body of code if a form evaluates to non-nil,
+ propagating the result of the form through the body of code."
+ `(let ((,var ,form))
+ (when ,var
+ (locally
+ ,@body))))
+
+(defmacro when-let* (bindings &body body)
+ "Executes a body of code if a series of forms evaluates to non-nil,
+ propagating the results of the forms through the body of code."
+ (loop for form = `(progn ,@body) then `(when-let (,(car binding) ,(cadr binding)) ,form)
+ for binding in (reverse bindings)
+ finally (return form)))
+
+(defmacro with-unique-names (names &body body)
+ "Returns a body of code with each specified name bound to a similar name."
+ `(let ,(mapcar (lambda (name) `(,name (gensym ,(symbol-name name))))
+ names)
+ ,@body))
1
0
[bknr-cvs] r2206 - in branches/trunk-reorg/thirdparty: . cl-interpol-0.1.2 cl-interpol-0.1.2/doc
by bknrï¼ bknr.net 04 Oct '07
by bknrï¼ bknr.net 04 Oct '07
04 Oct '07
Author: hhubner
Date: 2007-10-04 15:49:06 -0400 (Thu, 04 Oct 2007)
New Revision: 2206
Added:
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/CHANGELOG
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/README
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/cl-interpol.asd
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/cl-interpol.system
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/doc/
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/doc/index.html
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/load.lisp
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/packages.lisp
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/read.lisp
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/specials.lisp
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test.lisp
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test.pl
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test2.lisp
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/unicode.lisp
branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/util.lisp
Removed:
branches/trunk-reorg/thirdparty/cl-interpol/
Log:
update cl-interpol
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/CHANGELOG
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/CHANGELOG 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/CHANGELOG 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,16 @@
+Version 0.1.2
+2004-12-16
+Added hyperdoc support
+Added :CL-INTERPOL to *FEATURES*
+Typo fixes in doc/index.html
+
+Version 0.1.1
+2003-12-21
+Fixed an embarrassing bug where COLLECTOR was re-used in read.lisp (reported by Hans H�bner)
+More tests, better failure reporting
+Tried to increase readability of docs
+Mentioned Debian and Gentoo in docs
+
+Version 0.1.0
+2003-10-22
+Initial release
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/README
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/README 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/README 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,39 @@
+Complete documentation for CL-INTERPOL can be found in the 'doc'
+directory.
+
+CL-INTERPOL also supports Nikodemus Siivola's HYPERDOC, see
+<http://common-lisp.net/project/hyperdoc/> and
+<http://www.cliki.net/hyperdoc>.
+
+1. Installation
+
+1.1. Probably the easiest way is
+
+ (load "/path/to/cl-interpol/load.lisp")
+
+ This should compile and load CL-INTERPOL on most Common Lisp
+ implementations.
+
+1.2. With MK:DEFSYSTEM you can make a symbolic link from
+ 'cl-interpol.system' and 'cl-interpol-test.system' to your central registry
+ (which by default is in '/usr/local/lisp/Registry/') and then issue
+ the command
+
+ (mk:compile-system "cl-interpol")
+
+ Note that this relies on TRUENAME returning the original file a
+ symbolic link is pointing to. This will only work with AllegroCL
+ 6.2 if you've applied all patches with (SYS:UPDATE-ALLEGRO).
+
+1.3. You can also use ASDF instead of MK:DEFSYSTEM in a similar way
+ (use the .asd files instead of the .system files).
+
+In order to actually use CL-INTERPOL you have to enable its reader
+syntax with CL-INTERPOL:ENABLE-INTERPOL-SYNTAX - see the docs.
+
+2. Test
+
+For a quick test load the file "test.lisp" after installing
+CL-INTERPOL. (Note: SBCL will emit tons of compiler notes when loading
+"test.lisp" but it will eventually, after a couple of minutes, pass
+all tests - at least it does for me with 0.8.4.8.)
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/cl-interpol.asd
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/cl-interpol.asd 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/cl-interpol.asd 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,43 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/cl-interpol.asd,v 1.1 2003/10/16 23:05:04 edi Exp $
+
+;;; Copyright (c) 2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-user)
+
+(defpackage #:cl-interpol.system
+ (:use #:cl
+ #:asdf))
+
+(in-package #:cl-interpol.system)
+
+(defsystem #:cl-interpol
+ :components ((:file "packages")
+ (:file "specials" :depends-on ("packages"))
+ (:file "util" :depends-on ("specials"))
+ (:file "unicode" :depends-on ("specials"))
+ (:file "read" :depends-on ("util" "unicode"))))
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/cl-interpol.system
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/cl-interpol.system 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/cl-interpol.system 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,43 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/cl-interpol.system,v 1.1 2003/10/16 23:03:54 edi Exp $
+
+;;; Copyright (c) 2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-user)
+
+(defparameter *cl-interpol-base-directory*
+ (make-pathname :name nil :type nil :version nil
+ :defaults (parse-namestring *load-truename*)))
+
+(mk:defsystem #:cl-interpol
+ :source-pathname *cl-interpol-base-directory*
+ :source-extension "lisp"
+ :components ((:file "packages")
+ (:file "specials" :depends-on ("packages"))
+ (:file "util" :depends-on ("specials"))
+ (:file "unicode" :depends-on ("specials"))
+ (:file "read" :depends-on ("unicode" "util"))))
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/doc/index.html
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/doc/index.html 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/doc/index.html 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,821 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<html>
+
+<head>
+ <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
+ <title>CL-INTERPOL - string interpolation for Common Lisp</title>
+ <style type="text/css">
+ pre { padding:5px; background-color:#e0e0e0 }
+ pre.none { padding:5px; background-color:#ffffff }
+ a.none { text-decoration: none; color:black }
+ a.none:visited { text-decoration: none; color:black }
+ a.none:active { text-decoration: none; color:black }
+ a.none:hover { text-decoration: none; color:black }
+ code.yellow { background-color:#ffff00; }
+ a { text-decoration: none; }
+ a:visited { text-decoration: none; }
+ a:active { text-decoration: underline; }
+ a:hover { text-decoration: underline; }
+ </style>
+</head>
+
+<body bgcolor=white>
+
+<h2>CL-INTERPOL - string interpolation for Common Lisp</h2>
+
+<br> <br>
+<em>"<a href="http://www.arf.ru/Notes/Apostro/stfoot.html">The crux of the biscuit is the apostrophe.</a>"</em> (<a href="http://zappa.com/">Frank Zappa</a>)
+
+<blockquote>
+<br> <br><h3>Abstract</h3>
+
+CL-INTERPOL is a library for Common Lisp which modifies the reader so
+that you can have interpolation within strings similar to Perl or Unix Shell
+scripts. It also provides various ways to insert arbitrary characters
+into literal strings even if your editor/IDE doesn't support them.
+Here's an example:
+<pre>
+* (let ((a 42))
+ #?"foo: \xC4\N{U with diaeresis}\nbar: ${a}")
+"foo: ÄÜ
+bar: 42"
+</pre>
+CL-INTERPOL comes with a <a
+href="http://www.opensource.org/licenses/bsd-license.php"><b>BSD-style
+license</b></a> so you can basically do with it whatever you want.
+</blockquote>
+
+<br> <br><h3><a class=none name="contents">Contents</a></h3>
+<ol>
+ <li><a href="#install">Download and installation</a>
+ <li><a href="#mail">Support and mailing lists</a>
+ <li><a href="#syntax">Syntax</a>
+ <ol>
+ <li><a href="#backslash">Backslashes</a>
+ <li><a href="#interpolation">Interpolation</a>
+ <li><a href="#regular">Support for CL-PPCRE/Perl regular expressions</a>
+ </ol>
+ <li><a href="#dictionary">The CL-INTERPOL dictionary</a>
+ <ol>
+ <li><a href="#enable-interpol-syntax"><code>enable-interpol-syntax</code></a>
+ <li><a href="#disable-interpol-syntax"><code>disable-interpol-syntax</code></a>
+ <li><a href="#*list-delimiter*"><code>*list-delimiter*</code></a>
+ <li><a href="#*long-unicode-names-p*"><code>*long-unicode-names-p*</code></a>
+ <li><a href="#*short-unicode-names-p*"><code>*short-unicode-names-p*</code></a>
+ <li><a href="#*unicode-scripts*"><code>*unicode-scripts*</code></a>
+ <li><a href="#quote-meta-chars"><code>quote-meta-chars</code></a>
+ <li><a href="#*outer-delimiters*"><code>*outer-delimiters*</code></a>
+ <li><a href="#*inner-delimiters*"><code>*inner-delimiters*</code></a>
+ <li><a href="#*regex-delimiters*"><code>*regex-delimiters*</code></a>
+ </ol>
+ <li><a href="#bugs">Bugs and problems</a>
+ <ol>
+ <li><a href="#lispworks">CL-INTERPOL doesn't work with LispWorks</a>
+ <li><a href="#slow">Reading of large forms can be slow</a>
+ <li><a href="#curly"><code>{n,m}</code> modifiers in extended mode</a>
+ </ol>
+ <li><a href="#remarks">Remarks</a>
+ <li><a href="#ack">Acknowledgements</a>
+</ol>
+
+<br> <br><h3><a name="install" class=none>Download and installation</a></h3>
+
+CL-INTERPOL together with this documentation can be downloaded from <a
+href="http://weitz.de/files/cl-interpol.tar.gz">http://weitz.de/files/cl-interpol.tar.gz</a>. The
+current version is 0.1.2.
+<p>
+CL-INTERPOL comes with simple system definitions for <a
+href="http://www.cliki.net/mk-defsystem">MK:DEFSYSTEM</a> and <a
+href="http://www.cliki.net/asdf">asdf</a> so you can either adapt it
+to your needs or just unpack the archive and from within the CL-INTERPOL
+directory start your Lisp image and evaluate the form
+<code>(mk:compile-system "cl-interpol")</code> (or the
+equivalent one for asdf) which should compile and load the whole
+system.
+<p>
+If for some reason you don't want to use MK:DEFSYSTEM or asdf you
+can just <code>LOAD</code> the file <code>load.lisp</code> or you
+can also get away with something like this:
+
+<pre>
+(loop for name in '("packages" "specials" "util" "unicode" "read")
+ do (compile-file (make-pathname :name name
+ :type "lisp"))
+ (load name))
+</pre>
+
+Note that on CL implementations which use the Python compiler
+(i.e. CMUCL, SBCL, SCL) you can concatenate the compiled object files
+to create one single object file which you can load afterwards:
+
+<pre>
+cat {packages,specials,util,unicode,read}.x86f > cl-interpol.x86f
+</pre>
+
+(Replace ".<code>x86f</code>" with the correct suffix for
+your platform.)
+<p>
+If you're on <a href="http://www.debian.org/">Debian</a> you should
+probably use the <a
+href="http://packages.debian.org/cgi-bin/search_packages.pl?keywords=cl-interpol&…">cl-interpol
+Debian package</a> which is available thanks to <a href="http://b9.com/">Kevin
+Rosenberg</a>. There's also a port
+for <a href="http://www.cliki.net/gentoo">Gentoo Linux</a> thanks to Matthew Kennedy.
+Installation via <a
+href="http://www.cliki.net/asdf-install">asdf-install</a> should also
+be possible.
+<p>
+<b>Note:</b> Before you can actually <em>use</em> the new reader
+syntax you have to enable it with <a
+href="#enable-interpol-syntax"><code>ENABLE-INTERPOL-SYNTAX</code></a>.
+
+<br> <br><h3><a name="mail" class=none>Support and mailing lists</a></h3>
+
+For questions, bug reports, feature requests, improvements, or patches
+please use the <a
+href="http://common-lisp.net/mailman/listinfo/cl-interpol-devel">cl-interpol-devel
+mailing list</a>. If you want to be notified about future releases
+subscribe to the <a
+href="http://common-lisp.net/mailman/listinfo/cl-interpol-announce">cl-interpol-announce
+mailing list</a>. These mailing lists were made available thanks to
+the services of <a href="http://common-lisp.net/">common-lisp.net</a>.
+
+<br> <br><h3><a name="syntax" class=none>Syntax</a></h3>
+
+CL-INTERPOL installs <code class=yellow>?</code> (question mark) as a
+"sub-character" of the <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_d.htm#dispatching_…">dispatching
+macro character</a> <code class=yellow>#</code> (sharpsign), i.e. it relies on
+the fact that sharpsign is a dispatching macro character in the <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_c.htm#current_read…">current
+readtable</a> when <a
+href="#enable-interpol-syntax"><code>ENABLE-INTERPOL-SYNTAX</code></a>
+is invoked.
+<p>
+The question mark may optionally be followed by an <code class=yellow>R</code> and
+an <code class=yellow>X</code> (case doesn't matter) - see <a href="#regex">the
+section about regular expression syntax</a> below. If both of them are
+present the <code class=yellow>R</code> <em>must</em> precede the <code class=yellow>X</code>.
+<p>
+The next character is the <a class=none name=outer><em>opening outer delimiter</em></a> which may
+be one of <code class=yellow>"</code> (double quote), <code class=yellow>'</code>
+(apostrophe), <code class=yellow>|</code> (vertical bar), <code class=yellow>#</code>
+(sharpsign), <code class=yellow>/</code> (slash), <code class=yellow>(</code> (left
+parenthesis), <code class=yellow><</code> (less than), <code class=yellow>[</code> (left
+square bracket), or <code class=yellow>{</code> (left curly bracket). (But see <a href="#*outer-delimiters*"><code>*OUTER-DELIMITERS*</code></a>.)
+<p>
+The following characters comprise the string which is read until the
+<em>closing outer delimiter</em> is seen. The closing outer delimiter
+is the same character as the opening outer delimiter - unless the
+opening delimiter was one of the last four described below in which
+case the closing outer delimiter is the corresponding closing (right)
+bracketing character. So these are all valid CL-INTERPOL string
+equivalent to <code>"abc"</code>:
+
+<pre>
+* #?"abc"
+"abc"
+* #?r"abc"
+"abc"
+* #?x"abc"
+"abc"
+* #?rx"abc"
+"abc"
+* #?'abc'
+"abc"
+* #?|abc|
+"abc"
+* #?#abc#
+"abc"
+* #?/abc/
+"abc"
+* #?(abc)
+"abc"
+* #?[abc]
+"abc"
+* #?{abc}
+"abc"
+* #?<abc>
+"abc"
+</pre>
+
+A character which would otherwise be a closing outer delimiter can be
+escaped by a backslash immediately preceding it (unless this backslash
+is itself escaped by another backslash). Also, the bracketing
+delimiters can nest, i.e. a right bracketing character which might
+otherwise be closing outer delimiter will be read as part of the
+string if it is matched by a preceding left bracketing character
+within the string.
+<pre>
+* #?"abc"
+"abc"
+* #?"abc\""
+"abc\""
+* #?"abc\\"
+"abc\\"
+* #?[abc]
+"abc"
+* #?[a[b]c]
+"a[b]c"
+* #?[a[[b]]c]
+"a[[b]]c"
+* #?[a[[][]]b]
+"a[[][]]b"
+</pre>
+
+The characters between the outer delimiters are read one by one and
+inserted into the resulting string as is unless one of the special
+characters <a href="#backslash"><code class=yellow>\</code> (backslash)</a>, <code class=yellow>$</code> (dollar sign),
+or <code class=yellow>@</code> (at-sign) is encountered. The behaviour with respect
+to these special characters is modeled after Perl because CL-INTERPOL
+is intended to be usable with <a
+href="http://weitz.de/cl-ppcre/">CL-PPCRE</a>.
+
+<h4><a name="backslash" class=none>Backslashes</a></h4>
+Here's a short summary of what might occur after a backslash, copied
+verbatim from <code>man perlop</code>. Details below - you can
+click on the entries in this table to go to the corresponding
+paragraph.
+
+<pre class=none>
+ <a class=none href="#tab">\t tab (HT, TAB)
+ \n newline (NL)
+ \r return (CR)
+ \f form feed (FF)
+ \b backspace (BS)
+ \a alarm (bell) (BEL)
+ \e escape (ESC)</a>
+ <a class=none href="#octal">\033 octal char (ESC)</a>
+ <a class=none href="#hex">\x1b hex char (ESC)
+ \x{263a} wide hex char (SMILEY)</a>
+ <a class=none href="#control">\c[ control char (ESC)</a>
+ <a class=none href="#name">\N{name} named char</a>
+
+ <a class=none href="#lower">\l lowercase next char
+ \u uppercase next char</a>
+ <a class=none href="#Upper">\L lowercase till \E
+ \U uppercase till \E
+ \E end case modification</a>
+ <a class=none href="#quote">\Q quote non-word characters till \E</a>
+</pre>
+<p>
+<a class=none name="tab">If</a> a backslash is followed by
+<code class=yellow>n</code>, <code class=yellow>r</code>, <code class=yellow>f</code>, <code class=yellow>b</code>,
+<code class=yellow>a</code>, or <code class=yellow>e</code> (all lowercase) then the corresponding character
+<code>#\Newline</code>, <code>#\Return</code>, <code>#\Page</code>,
+<code>#\Backspace</code>, <code>(CODE-CHAR 7)</code>, or
+<code>(CODE-CHAR 27)</code> is inserted into the string.
+<pre>
+* #?"New\nline"
+"New
+line"
+</pre>
+<p>
+<a class=none name="octal">If</a> a backslash if followed by one of
+the digits <code class=yellow>0</code> to <code class=yellow>9</code> then this digit and
+the following characters are read and parsed as octal digits and will
+be interpreted as the character code of the character to insert
+instead of this sequence. The sequence ends with the first character
+which is not an octal digit but <em>at most</em> three digits will be
+read. Only the rightmost eight bits of the resulting number will be
+used for the character code.
+
+<pre>
+* #?"\40\040"
+" " <font color=orange>;; two spaces</font>
+* (map 'list #'char-code #?"\0\377\777")
+(0 255 255) <font color=orange>;; note that \377 and \777 yield the same result</font>
+* #?"Only\0403 digits!"
+"Only 3 digits!"
+* (map 'list #'identity #?"\9")
+(#\Null #\9) <font color=orange>;; strange, isn't it?</font>
+</pre>
+<p>
+<a class=none name="hex">If</a> a backslash is followed by an <code class=yellow>x</code> (lowercase) the
+following characters are read and parsed as hexadecimal digits and
+will be interpreted as the character code of the character to insert
+instead of this sequence. The sequence of hexadecimal digits ends with
+the first character which is not one of the characters <code class=yellow>0</code>
+to <code class=yellow>9</code>, <code class=yellow>a</code> to <code class=yellow>f</code>, or <code class=yellow>A</code>
+to <code class=yellow>F</code> but <em>at most</em> two digits will be read. If the
+character immediately following the <code class=yellow>x</code> is a <code class=yellow>{</code>
+(left curly bracket) then all the following characters up to a
+<code class=yellow>}</code> (right curly bracket) must be hexadecimal digits and
+comprise a number which'll be taken as the character code (and which
+obviously should denote a character known by your Lisp
+implementation). Note that in both case it is legal that zero digits
+will be read which'll be interpreted as the character code
+<code>0</code>. Some examples with <a href="http://clisp.cons.org/">CLISP</a>:
+<pre>
+[28]> (char #?"\x20" 0)
+#\Space
+[29]> (char-code (char #?"\x" 0))
+0
+[30]> (char-code (char #?"\x{}" 0))
+0
+[31]> (char-name (char #?"\x{2323}" 0))
+"SMILE"
+[32]> #?"Only\x202 digits!"
+"Only 2 digits!"
+</pre>
+<p>
+<a class=none name="control">If</a> a backslash is followed by a
+<code class=yellow>c</code> (lowercase) then the <a
+href="http://www.cs.tut.fi/~jkorpela/chars/c0.html">ASCII control
+code</a> of the following character is inserted into the string. Note
+that this only defined for <code class=yellow>A</code> to <code class=yellow>Z</code>,
+<code class=yellow>[</code>, <code class=yellow>\</code>, <code class=yellow>]</code>, <code class=yellow>^</code>, and
+<code class=yellow>_</code> although CL-INTERPOL will also accept other
+characters. In fact, the transformation is implemented as
+<pre>
+(code-char (logxor #x40 (char-code (char-upcase <<em>char</em>>))))
+</pre>
+where <code><<em>char</em>></code> is the character following <code class=yellow>\c</code>.
+<pre>
+* (char-name (char #?"\cH" 0))
+"Backspace"
+* (char= (char #?"\cj" 0) #\Newline)
+T
+</pre>
+
+<p>
+<a class=none name="name">If</a> a backslash is followed by an
+<code class=yellow>N</code> (uppercase) the following character <em>must</em> be a
+<code class=yellow>{</code> (left curly bracket). The characters following the
+bracket are read until a <code class=yellow>}</code> (right curly bracket) is seen
+and comprise the Unicode <em>name</em> of the character to be inserted into the
+string. This name is interpreted as follows:
+<ul>
+<li>If <a href="#*long-unicode-names-p*"><code>*LONG-UNICODE-NAMES-P*</code></a> is <em>true</em> then the name is interpreted as the full <a href="http://www.unicode.org/charts/charindex.html">official Unicode name</a> of the character. Case doesn't matter.
+<li>If <a href="#*short-unicode-names-p*"><code>*SHORT-UNICODE-NAMES-P*</code></a> is <em>true</em> then the name must contain a colon. The part before the colon is assumed to be the name of a Unicode scrippt and the part after the colon should be the full name except for the script name and the word "letter". You can also leave the words "small" and "capital" out. CL-INTERPOL will then try to find a character with one of the Unicode names
+<pre class=none>
+ <<em>script</em>> <<em>size</em>> letter <<em>short-name</em>>
+ <<em>script</em>> letter <<em>short-name</em>>
+</pre>
+where <code><<em>script</em>></code> is the part before the
+colon, <code><<em>short-name</em>></code> is the part after the
+colon, and <code><<em>size</em>></code> is <code>SMALL</code> if
+all letters in <code><<em>short-name</em>></code> are lowercase
+and <code>CAPITAL</code> otherwise.
+<li>If none of these yields a character CL-INTERPOL will try all the strings in the list <a href="#*unicode-scripts*"><code>*UNICODE-SCRIPTS*</code></a> in order and for each one it'll try to find a character with the algorithm described above where <code><<em>script</em>></code> is the corresponding element of <code>*UNICODE-SCRIPTS*</code> and <code><<em>short-name</em>></code> is the string between the curly brackets.
+</ul>
+Confused? Maybe an example will help - CLISP again:
+<pre>
+[3]> cl-interpol:*long-unicode-names-p*
+T
+[4]> (char-name (char #?"\N{Greek capital letter Sigma}" 0))
+"GREEK_CAPITAL_LETTER_SIGMA"
+[5]> (char-name (char #?"\N{GREEK CAPITAL LETTER SIGMA}" 0))
+"GREEK_CAPITAL_LETTER_SIGMA"
+[6]> (setq cl-interpol:*short-unicode-names-p* t)
+T
+[7]> (char-name (char #?"\N{Greek:Sigma}" 0))
+"GREEK_CAPITAL_LETTER_SIGMA"
+[8]> (char-name (char #?"\N{Greek:sigma}" 0))
+"GREEK_SMALL_LETTER_SIGMA"
+[9]> (push "Greek" cl-interpol:*unicode-scripts*)
+("Greek" "latin")
+[10]> (char-name (char #?"\N{Sigma}" 0))
+"GREEK_CAPITAL_LETTER_SIGMA"
+[11]> (char-name (char #?"\N{sigma}" 0))
+"GREEK_SMALL_LETTER_SIGMA"
+</pre>
+
+Of course, <code class=yellow>\N</code> won't magically make your Lisp implementation Unicode-aware. You can only use the names of characters that are actually supported by your Lisp.
+<p>
+<a class=none name="lower">If</a> a backslash is followed by an
+<code class=yellow>l</code> or a <code class=yellow>u</code> (both lowercase) the following
+character (if any) is <a href="http://www.lispworks.com/reference/HyperSpec/Body/f_char_u.htm">downcased or uppercased</a> respectively.
+<pre>
+* #?"\lFOO"
+"fOO"
+* #?"\ufoo"
+"Foo"
+* #?"\l"
+""
+</pre>
+
+<p>
+<a class=none name="Upper">If</a> a backslash is followed by an
+<code class=yellow>L</code> or a <code class=yellow>U</code> (both uppercase) the following
+characters up to <code class=yellow>\E</code> (uppercase) or another <code class=yellow>\L</code> or
+<code class=yellow>\U</code> are <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/f_stg_up.htm">upcased
+or downcased</a> respectively. While <code class=yellow>\E</code> simply ends the
+scope of <code class=yellow>\L</code> or <code class=yellow>\U</code>, another <code class=yellow>\L</code>
+or <code class=yellow>\U</code> will introduce a new round of upcasing or
+downcasing.
+<pre>
+* #?"\Ufoo\Ebar"
+"FOObar"
+* #?"\LFOO\EBAR"
+"fooBAR"
+* #?"\LFOO\Ubar"
+"fooBAR"
+* #?"\LFOO"
+"foo"
+</pre>
+These examples may seem trivial but <code class=yellow>\U</code> and friends might be very helpful if you <a href="#interpolation">interpolate</a> strings.
+
+<p>
+<a class=none name="quote">If</a> a backslash is followed by a
+<code class=yellow>Q</code> (uppercase) the following characters up to <code class=yellow>\E</code> (uppercase) are <em>quoted</em>, i.e. every character except for <code class=yellow>0</code>
+to <code class=yellow>9</code>, <code class=yellow>a</code> to <code class=yellow>z</code>, <code class=yellow>A</code>
+to <code class=yellow>Z</code>, and <code class=yellow>_</code> (underscore) is preceded by a backslash. Corresponding pairs of <code class=yellow>\Q</code> and <code class=yellow>\E</code> can be nested.
+<pre>
+* #?"-\Q-\E-"
+"-\\--"
+* #?"\Q-\Q-\E-\E"
+"\\-\\\\\\-\\-"
+* #?"-\Q-"
+"-\\-"
+</pre>
+As you might have noticed, <code class=yellow>\E</code> is used to end the scope of <code class=yellow>\Q</code> as well as that of <code class=yellow>\L</code> and <code class=yellow>\U</code>. As a consequence, pairs of <code class=yellow>\Q</code> and <code class=yellow>\E</code> can be nested between <code class=yellow>\L</code> or <code class=yellow>\U</code> and <code class=yellow>\E</code> and vice-versa but each occurence of <code class=yellow>\L</code> or <code class=yellow>\U</code> which is preceded by another <code class=yellow>\L</code> or <code class=yellow>\U</code> will immediately end the scope of all enclosed <code class=yellow>\Q</code> modifiers. Hmm, need an example?
+<pre>
+* #?"\LAa-\QAa-\EAa-\E"
+"aa-aa\\-aa-"
+* #?"\QAa-\LAa-\EAa-\E"
+"Aa\\-aa\\-Aa\\-"
+* #?"\U\QAa-\LAa-\EAa-\E"
+"AA\\-aa-Aa-" <font color=orange>;; note that only the first hyphen is quoted now</font>
+</pre>
+
+Quoting characters with <code class=yellow>\Q</code> is especially helpful if you want to <a href="#interpolation">interpolate</a> a string verbatim into a <a href="#regular">regular expression</a>.
+<p>
+All other characters following a backslash are left as is and inserted into the string. This is also true for the backslash itself, for <code class=yellow>$</code>, <code class=yellow>@</code>, and - as mentioned above - for the <a href="#outer">outer closing delimiter</a>.
+<pre>
+* #?"\"\\f\o\o\""
+"\"\\foo\""
+</pre>
+
+<br> <br><h3><a name="interpolation" class=none>Interpolation</a></h3>
+
+If a <code class=yellow>$</code> (dollar sign) or <code class=yellow>@</code> (at-sign) is seen
+and followed by one of <code class=yellow>{</code> (left curly bracket), <code class=yellow>[</code> (left square bracket), <code class=yellow><</code> (less than), or <code class=yellow>(</code> (left parenthesis) (but see <a href="#*inner-delimiters*"><code>*INNER-DELIMITERS*</code></a>), the
+characters following the bracket are read up to the corresponding closing (right)
+bracketing character. They are read as Lisp forms and treated as an <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_i.htm#implicit_pro…">implicit
+progn</a> the result of which will be inserted into the string at
+execution time. (Technically this is done by temporarily making the syntax of the closing right bracketing character in the <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_c.htm#current_read…">current
+readtable</a> be the same as the syntax of <code class=yellow>)</code> (right parenthesis) in the <a href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_s.htm#standard_rea…">standard readtable</a> and then reading the forms with <a href="http://www.lispworks.com/reference/HyperSpec/Body/f_rd_del.htm"><code>READ-DELIMITED-LIST</code></a>.)
+<p>
+The result of the forms following a <code class=yellow>$</code> (dollar sign) is inserted into the string as with <a href="http://www.lispworks.com/reference/HyperSpec/Body/f_wr_pr.htm"><code>PRINC</code></a> at execution time. The result of the forms following an <code class=yellow>@</code> (at-sign) <em>must</em> be a list. The elements of this list are inserted into the string one by one as with <code>PRINC</code> interspersed (or "joined" if you prefer) with the contents of the variable <a href="#*list-delimiter*"><code>*LIST-DELIMITER*</code></a> (also inserted as with <code>PRINC</code>).
+<p>
+Every other <code class=yellow>$</code> or <code class=yellow>@</code> is inserted into the string as is.
+<pre>
+* (let* ((a "foo")
+ (b #\Space)
+ (c "bar")
+ (d (list a b c))
+ (x 40))
+ (values #?"$ @"
+ #?"$(a)"
+ #?"$<a>$[b]"
+ #?"\U${a}\E \u${a}"
+ (let ((cl-interpol:*list-delimiter* #\*))
+ #?"@{d}")
+ (let ((cl-interpol:*list-delimiter* ""))
+ #?"@{d}")
+ #?"The result is ${(let ((y 2)) (+ x y))}"
+ #?"${#?'${a} ${c}'} ${x}")) <font color=orange>;; note the embedded CL-INTERPOL string</font>
+"$ @"
+"foo"
+"foo "
+"FOO Foo"
+"foo* *bar"
+"foo bar"
+"The result is 42"
+"foo bar 40"
+</pre>
+Interpolations are realized by creating code which is evaluated at
+execution time. For example, the expansion of
+<code>#?"\Q-\l${(let ((x 40)) (+ x 2))}"</code> might look
+like this:
+
+<pre>
+(with-output-to-string (#:G1098)
+ (write-string (cl-interpol:quote-meta-chars
+ (with-output-to-string (#:G1099)
+ (write-string "-" #:G1099)
+ (let ((#:G1100
+ (format nil "~A"
+ (progn
+ (let ((x 40))
+ (+ x 2))))))
+ (when (plusp (length #:G1100))
+ (setf (char #:G1100 0)
+ (char-downcase (char #:G1100 0))))
+ (write-string #:G1100 #:G1099))))
+ #:G1098))
+</pre>
+
+However, if a string read by CL-INTERPOL does not contain interpolations it is guaranteed to be expanded into a constant Lisp string.
+
+<br> <br><h3><a name="regular" class=none>Support for CL-PPCRE/Perl regular expressions</a></h3>
+
+Beyond what has been explained above CL-INTERPOL can support Perl regular expression syntax. This feature is mainly intended for use with <a href="http://weitz.de/cl-ppcre/">CL-PPCRE</a> (version 0.7.0 or higher). The <em>regular expression mode</em> is switched on if the <a href="#outer">opening outer delimiter</a> is a <code class=yellow>/</code> (slash) - but see <a href="#*regex-delimiters*"><code>*REGEX-DELIMITERS*</code></a>. It is also on if there's an <code class=yellow>r</code> (lowercase or uppercase) in front of the opening outer delimiter. If there's also an <code class=yellow>x</code> (lowercase or uppercase) in front of the opening outer delimiter (but <em>behind</em> the <code class=yellow>r</code> if it's there) the string will be read in <em>extended mode</em> (see <code>man perlre</code> for a detailed explanation). In these modes the following things are different from what's described above:
+<ul>
+
+ <li><code class=yellow>\w</code>, <code class=yellow>\W</code>, <code class=yellow>\s</code>,
+ <code class=yellow>\S</code>, <code class=yellow>\d</code>, and <code class=yellow>\D</code> are never
+ converted to their unescaped (backslash-less) counterparts because
+ they have a special meaning in regular expressions.
+<pre>
+* #?#\W\o\w#
+"Wow"
+* #?/\W\o\w/
+"\\Wo\\w"
+* #?r#\W\o\w#
+"\\Wo\\w"
+</pre>
+ <li><code class=yellow>\b</code>, <code class=yellow>\B</code>,
+ <code class=yellow>\a</code>, <code class=yellow>\z</code>, and <code class=yellow>\Z</code> are only
+ converted to their unescaped (backslash-less) counterparts if they are within a <em>character class</em> (i.e. enclosed in square brackets) because
+ they have a special meaning in regular expressions outside of character classes.
+<pre>
+* #?/\A[\A-\Z]\Z/
+"\\A[A-Z]\\Z"
+* #?/\A[]\A-\Z]\Z/
+"\\A[]A-Z]\\Z"
+* #?/\A[^]\A-\Z]\Z/
+"\\A[^]A-Z]\\Z"
+</pre>
+ <li><a href="#octal">Octal representations of character codes</a> are left as is and not expanded if they're not within character classes and could possible denote a back-reference to a register group. (Actually, this also holds for sequences starting with <code class=yellow>\8</code> or <code class=yellow>\9</code> in compliance with Perl.)
+<pre>
+* (map 'list #'identity #?/\0\40[\40]/)
+(#\Null #\\ #\4 #\0 #\[ #\Space #\])
+</pre>
+ <li>Characters which are represented by <a href="#octal">octal</a> or <a href="#hex">hexadecimal</a> codes, by <a href="#name">names</a>, or escaped by a preceding backslash are 'protected' by a backslash if they have a special meaning within regular expressions.
+<pre>
+* #?"\x2B\\\.[\.]"
+"+\\.[.]"
+* #?/\x2B\\\.[\.]/
+"\\+\\\\\\.[.]" <font color=orange>;; note that the second dot is not 'protected' because it's in a character class</font>
+</pre>
+ <li>Embedded comments (like <code class=yellow>(?#...)</code>) are removed from the string - with the exception that they are replaced with <code class=yellow>(?:)</code> (a non-capturing, empty group which will be otimized away by CL-PPCRE) if the next character is a hexadecimal digit.
+<pre>
+* #?/A(?#n embedded) comment/
+"A comment"
+* #?/\1(?#)2/
+"\\1(?:)2" <font color=orange>;; instead of "\\12" which has a different meaning to the regex engine</font>
+</pre>
+ <li><a href="#interpolation">Interpolation</a> only works with curly brackets (and only if they haven't been removed from <a href="#*inner-delimiters*"><code>*INNER-DELIMITERS*</code></a>).
+<pre>
+* (let ((a 42))
+ (values #?"$(a)" #?"${a}"
+ #?/$(a)/ #?/${a}/))
+"42"
+"42"
+"$(a)"
+"42"
+</pre>
+ <li>In extended mode whitespace characters (one of <code>#\Space</code>, <code>#\Tab</code>, <code>#\Linefeed</code>, <code>#\Return</code>, and <code>#\Page</code>) are removed from the string unless they are escaped by a backslash or within a character class.
+<pre>
+* #?/ \ [ ]/
+" [ ]" <font color=orange>;; two spaces in front of square bracket</font>
+* #?x/ \ [ ]/
+" [ ]" <font color=orange>;; one space in front of square bracket</font>
+</pre>
+ <li>In extended mode end-of-line comments (starting with <code class=yellow>#</code> (sharpsign) and ending with the newline character) are removed from the string - with the exception that they are replaced with <code class=yellow>(?:)</code> (a non-capturing, empty group which will be otimized away by CL-PPCRE) if the next character is a hexadecimal digit.
+<pre>
+* #?x/[a-z]#blabla
+\$/
+"[a-z]$"
+* #?x/\1#
+2/
+"\\1(?:)2" <font color=orange>;; instead of "\\12" which has a different meaning to the regex engine</font>
+</pre>
+</ul>
+
+If all this seems complicated just keep in mind that this mode is
+meant so that you can feed strings to <a
+href="http://weitz.de/cl-ppcre/">CL-PPCRE</a> exactly as if you had
+written them for Perl (without <a
+href="http://weitz.de/cl-ppcre/#backslash">counting Lisp backslashes
+versus Perl backslashes</a>). However, you should <em>not</em> use
+both CL-INTERPOL's as well as CL-PPCRE's extended mode at once because
+this might lead to errors. (CL-PPCRE's will, e.g., throw away
+whitespace which had been escaped in CL-INTERPOL.)
+<pre>
+* (let ((scanner (cl-ppcre:create-scanner " a\\ a " :extended-mode t)))
+ (cl-ppcre:scan scanner "a a"))
+0
+3
+#()
+#()
+* (let ((scanner (cl-ppcre:create-scanner #?x/ a\ a /)))
+ (cl-ppcre:scan scanner "a a"))
+0
+3
+#()
+#()
+* (let ((scanner (cl-ppcre:create-scanner #?x/ a\ a / :extended-mode t)))
+ <font color=orange>;; wrong, because extended mode is applied twice</font>
+ (cl-ppcre:scan scanner "a a"))
+NIL
+</pre>
+
+<br> <br><h3><a class=none name="dictionary">The CL-INTERPOL dictionary</a></h3>
+
+CL-INTERPOL exports the following symbols:
+
+<p><br>[Macro]
+<br><a class=none name="enable-interpol-syntax"><b>enable-interpol-syntax</b> => |</a>
+
+<blockquote><br>
+
+This is used to enable the reader syntax described <a href="#syntax">above</a>. This macro
+expands into an <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm">EVAL-WHEN</a>
+so that if you use it as a <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_t.htm#top_level_fo…">top-level
+form</a> in a file to be loaded and/or compiled it'll do what you
+expect. Technically this'll push the <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_c.htm#current_read…">current
+readtable</a> on a stack so that matching calls of <code>ENABLE-INTERPOL-SYNTAX</code> and <a href="#disable-interpol-syntax"><code>DISABLE-INTERPOL-SYNTAX</code></a> can nest.
+Note that by default the reader syntax is <em>not</em> enabled after loading CL-INTERPOL.
+
+</blockquote>
+
+<p><br>[Macro]
+<br><a class=none name="disable-interpol-syntax"><b>disable-interpol-syntax</b> => |</a>
+
+<blockquote><br>
+
+This is used to disable the reader syntax described <a href="#syntax">above</a>. This macro
+expands into an <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm">EVAL-WHEN</a>
+so that if you use it as a <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_t.htm#top_level_fo…">top-level
+form</a> in a file to be loaded and/or compiled it'll do what you
+expect. Technically this'll pop a readtable from the stack described <a href="#enable-interpol-syntax">above</a> so that matching calls of <a href="#enable-interpol-syntax"><code>ENABLE-INTERPOL-SYNTAX</code></a> and <code>DISABLE-INTERPOL-SYNTAX</code> can nest. If the stack is empty (i.e. when <code>DISABLE-INTERPOL-SYNTAX</code> is called without a preceding call to <a href="#enable-interpol-syntax"><code>ENABLE-INTERPOL-SYNTAX</code></a>) the <a href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_s.htm#standard_rea…">standard readtable</a> is re-established.
+
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*list-delimiter*"><b>*list-delimiter*</b></a>
+
+<blockquote><br>
+
+The contents of this variable are inserted between the elements of a list <a href="#interpolation">interpolated with <code class=yellow>@</code></a> at execution time. They are inserted as with <a href="http://www.lispworks.com/reference/HyperSpec/Body/f_wr_pr.htm"><code>PRINC</code></a>. The default value is <code class=yellow>" "</code> (one space).
+
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*long-unicode-names-p*"><b>*long-unicode-names-p*</b></a>
+
+<blockquote><br>
+
+This is a <a href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_g.htm#generalized_…">generalized boolean</a> which is used to decide whether <a href="#name"><code class=yellow>\N</code></a> will try the full official Unicode names. Note that this variable has effect at read time so you probably need to wrap an <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm">EVAL-WHEN</a> around forms that change its value. The default value is <code>T</code>.
+
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*short-unicode-names-p*"><b>*short-unicode-names-p*</b></a>
+
+<blockquote><br>
+
+This is a <a href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_g.htm#generalized_…">generalized boolean</a> which is used to decide whether <a href="#name"><code class=yellow>\N</code></a> will try the abbreviated <code>"<em><script></em>:<em><short-name></em>"</code> syntax for Unicode names. Note that this variable has effect at read time so you probably need to wrap an <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm">EVAL-WHEN</a> around forms that change its value. The default value is <code>NIL</code>.
+
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*unicode-scripts*"><b>*unicode-scripts*</b></a>
+
+<blockquote><br>
+
+This should be a list of strings which are in turn tried as names of Unicode scripts as described in the <a href="#name">section about <code class=yellow>\N</code></a>. Note that this variable has effect at read time so you probably need to wrap an <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm">EVAL-WHEN</a> around forms that change its value. The default value is the one-element list <code>'("latin")</code>.
+
+</blockquote>
+
+<p><br>[Function]
+<br><a class=none name="quote-meta-chars"><b>quote-meta-chars</b> <i>string</i> => <i>string'</i></a>
+
+<blockquote><br>
+This is a simple utility function used <a href="#quote"><code class=yellow>\Q</code></a>. It returns a string <code>STRING'</code> where all
+non-word characters (everything except ASCII characters, digits and
+underline) of <code>STRING</code> are quoted by prepending a
+backslash similar to Perl's <code>quotemeta</code> function. It always returns a <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/26_glo_f.htm#fresh">fresh</a>
+string.
+<pre>
+* (cl-interpol:quote-meta-chars "[a-z]*")
+"\\[a\\-z\\]\\*"
+</pre></blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*outer-delimiters*"><b>*outer-delimiters*</b></a>
+
+<blockquote><br>
+
+This is a list of acceptable <a href="#outer">outer delimiters</a>. The elements of this list are either characters or dotted pairs the car and cdr of which are characters. A character denotes a delimiter like <code class=yellow>'</code> (apostrophe) which is the opening as well as the closing delimiter. A dotted pair like <code>(#\{ . #\})</code> denotes a pair of matching bracketing delimiters. The name of this list is exported so that you can customize CL-INTERPOL's behaviour by <em>removing</em> elements from this list, you are advised not to add any - specifically you should not add alphanumeric characters or the backslash. Note that this variable has effect at read time so you probably need to wrap an <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm">EVAL-WHEN</a> around forms that change its value. The default value is
+<pre>
+'((#\( . #\))
+ (#\{ . #\})
+ (#\< . #\>)
+ (#\[ . #\])
+ #\/ #\| #\" #\' #\#))
+</pre>
+
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*inner-delimiters*"><b>*inner-delimiters*</b></a>
+
+<blockquote><br>
+
+This is a list of acceptable delimiters for <a href="#interpolation">interpolation</a>. The elements of this list are either characters or dotted pairs the car and cdr of which are characters. A character denotes a delimiter like <code class=yellow>'</code> (apostrophe) which is the opening as well as the closing delimiter. A dotted pair like <code>(#\{ . #\})</code> denotes a pair of matching bracketing delimiters. The name of this list is exported so that you can customize CL-INTERPOL's behaviour by <em>removing</em> elements from this list, you are advised not to add any - specifically you should not add alphanumeric characters or the backslash. Note that this variable has effect at read time so you probably need to wrap an <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm">EVAL-WHEN</a> around forms that change its value. The default value is
+<pre>
+'((#\( . #\))
+ (#\{ . #\})
+ (#\< . #\>)
+ (#\[ . #\]))
+</pre>
+
+</blockquote>
+
+<p><br>[Special variable]
+<br><a class=none name="*regex-delimiters*"><b>*regex-delimiters*</b></a>
+
+<blockquote><br>
+
+This is a list of <a href="#outer">opening outer delimiters</a> which automatically switch CL-INTERPOL's <a href="#regular">regular expression mode</a> on. The elements of this list are characters. An element of this list must also be an element of <a href="#*outer-delimiters*"><code>*OUTER-DELIMITERS*</code></a> to have any effect.
+Note that this variable has effect at read time so you probably need to wrap an <a
+href="http://www.lispworks.com/reference/HyperSpec/Body/s_eval_w.htm">EVAL-WHEN</a> around forms that change its value. The default value is the one-element list <code>'(#\/)</code>.
+
+</blockquote>
+
+<br> <br><h3><a class=none name="bugs">Bugs and problems</a></h3>
+
+<h4><a name="lispworks" class=none>CL-INTERPOL doesn't work with LispWorks</a></h4>
+
+<a
+href="http://www.lispworks.com/">LispWorks</a>
+(4.3.6 professional on Linux, maybe other versions too) has an error which prevents
+CL-INTERPOL from working correctly. You can check for yourself by
+evaluating the following form in a LispWorks listener:
+
+<pre>
+(let ((collector (make-array 0
+ :element-type 'character
+ :fill-pointer t
+ :adjustable t)))
+ (vector-push-extend #\1 collector)
+ (parse-integer collector))
+</pre>
+
+This should of course return <code>1</code> but signals an error for
+me. If you also encounter this error you can contact Xanalys support
+for a patch.
+<p>
+Update: This was fixed in version 4.3.7.
+
+<h4><a name="slow" class=none>Reading of large forms can be slow</a></h4>
+
+Some Lisps (notably LispWorks and CMUCL/SBCL) seem to have problems if very many (1000+) CL-INTERPOL strings are contained in one form. This seems to be related to GC and not necessarily something specific to CL-INTERPOL. See <a href="http://article.gmane.org/gmane.lisp.cmucl.general/1546">the CMUCL mailing list</a> and <a href="http://article.gmane.org/gmane.lisp.lispworks.general/1443">the LispWorks mailing list</a> for more information. (Note: The behaviour of LispWorks has significantly improved with version 4.3.7.)
+
+<h4><a name="curly" class=none><code>{n,m}</code> modifiers in extended mode</a></h4>
+
+CL-INTERPOL treats 'potential' <code>{n,m}</code> modifiers differently from <a href="http://weitz.de/cl-ppcre/">CL-PPCRE</a> or Perl in <a href="#regular">extended mode</a> <em>if</em> they contain whitespace. CL-INTERPOL will simply remove the whitespace and thus make them valid modifiers for CL-PPCRE while Perl will remove the whitespace but <em>not</em> recognize the character sequence as a modifier. CL-PPCRE behaves like Perl - you decide if this behaviour is sane...:)
+<pre>
+* (let ((scanner (cl-ppcre:create-scanner "^a{3, 3}$" :extended-mode t)))
+ (cl-ppcre:scan scanner "aaa"))
+NIL
+* (let ((scanner (cl-ppcre:create-scanner "^a{3, 3}$" :extended-mode t)))
+ (cl-ppcre:scan scanner "a{3,3}"))
+0
+6
+#()
+#()
+* (cl-ppcre:scan #?x/^a{3, 3}$/ "aaa")
+0
+3
+#()
+#()
+* (cl-ppcre:scan #?x/^a{3, 3}$/ "a{3, 3}")
+NIL
+</pre>
+
+<br> <br><h3><a class=none name="remarks">Remarks</a></h3>
+
+All examples in this text where done with <a
+href="http://www.cons.org/cmucl/">CMUCL</a> except where otherwise noted.
+The sample output has been slightly edited to
+increase readability.
+
+<br> <br><h3><a class=none name="ack">Acknowledgements</a></h3>
+
+Thanks to Peter Seibel who had the idea to do this to make <a href="http://weitz.de/cl-ppcre/">CL-PPCRE</a> more convenient. Read <a href="http://www.apress.com/book/bookDisplay.html?bID=237">his book</a> when it is released!!!
+
+<p>
+$Header: /usr/local/cvsrep/cl-interpol/doc/index.html,v 1.19 2004/12/16 19:20:43 edi Exp $
+<p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>
+
+</body>
+</html>
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/load.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/load.lisp 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/load.lisp 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,53 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/load.lisp,v 1.1 2003/10/19 15:56:51 edi Exp $
+
+;;; Copyright (c) 2002-2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-user)
+
+(defparameter *cl-interpol-base-directory*
+ (make-pathname :name nil :type nil :version nil
+ :defaults (parse-namestring *load-truename*)))
+
+(loop for file in '("packages"
+ "specials"
+ "util"
+ "unicode"
+ "read")
+ do (let ((pathname (make-pathname :name file :type "lisp" :version nil
+ :defaults *cl-interpol-base-directory*)))
+ #-:cormanlisp
+ (let ((compiled-pathname (compile-file-pathname pathname)))
+ (unless (probe-file compiled-pathname)
+ (compile-file pathname))
+ (setq pathname compiled-pathname))
+ (load pathname)))
+
+
+
+
+
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/packages.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/packages.lisp 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/packages.lisp 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,61 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/packages.lisp,v 1.4 2004/04/24 00:19:13 edi Exp $
+
+;;; Copyright (c) 2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-user)
+
+#-:cormanlisp
+(defpackage #:cl-interpol
+ (:nicknames #:interpol)
+ (:use #:cl)
+ (:export #:enable-interpol-syntax
+ #:disable-interpol-syntax
+ #:quote-meta-chars
+ #:*list-delimiter*
+ #:*long-unicode-names-p*
+ #:*short-unicode-names-p*
+ #:*unicode-scripts*
+ #:*outer-delimiters*
+ #:*inner-delimiters*
+ #:*optional-delimiters-p*))
+
+#+:cormanlisp
+(defpackage "CL-INTERPOL"
+ (:nicknames "INTERPOL")
+ (:use "CL")
+ (:export "ENABLE-INTERPOL-SYNTAX"
+ "DISABLE-INTERPOL-SYNTAX"
+ "QUOTE-META-CHARS"
+ "*LIST-DELIMITER*"
+ "*LONG-UNICODE-NAMES-P*"
+ "*SHORT-UNICODE-NAMES-P*"
+ "*UNICODE-SCRIPTS*"
+ "*OUTER-DELIMITERS*"
+ "*INNER-DELIMITERS*"))
+
+(pushnew :cl-interpol *features*)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/read.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/read.lisp 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/read.lisp 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,751 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/read.lisp,v 1.25 2004/04/24 00:19:13 edi Exp $
+
+;;; Copyright (c) 2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-interpol)
+
+(defun read-while (predicate &key max)
+ "Reads characters from *STREAM* while PREDICATE returns a true value
+for each character. Returns at most MAX characters if MAX is true."
+ (when (eql max 0)
+ (return-from read-while ""))
+ (let ((collector (make-collector)))
+ (loop for count of-type fixnum from 1
+ for c = (peek-char*)
+ while (and (or (not max)
+ (<= count max))
+ c
+ (funcall predicate c))
+ do (vector-push-extend (read-char*) collector)
+ finally (return collector))))
+
+(declaim (inline get-number))
+(defun get-number (&key (radix 10) max)
+ "Reads and consumes the number *STREAM* is currently looking at and
+returns it. Returns NIL if no number could be identified. RADIX is
+used as in PARSE-INTEGER. If MAX is not NIL we'll read at most the
+next MAX characters."
+ (parse-integer (read-while (lambda (c)
+ (digit-char-p c radix))
+ :max max)
+ :radix radix
+ :junk-allowed t))
+
+(defun resolve-unicode-name (name)
+ "Tries to return a character which was encoded as \\N<NAME>."
+ (or (and *long-unicode-names-p*
+ ;; first try long name
+ (gethash name *unicode-names*))
+ (and *short-unicode-names-p*
+ ;; now short name including script (separated by a colon)
+ (let ((colon-pos (position #\: name :test #'char=)))
+ (and colon-pos
+ (let* ((script
+ (string-trim " " (nsubvec name 0 colon-pos)))
+ (short-name
+ (string-trim " " (nsubvec name (1+ colon-pos))))
+ ;; size depends on how SHORT-NAME has been
+ ;; written
+ (size (if (every #'lower-case-p* short-name)
+ "small" "capital")))
+ (or (gethash (concatenate 'string
+ script " "
+ size " letter "
+ short-name)
+ *unicode-names*)
+ (gethash (concatenate 'string
+ script " letter "
+ short-name)
+ *unicode-names*))))))
+ ;; finally try all scripts which are in *UNICODE-SCRIPTS*
+ (let ((size (if (every #'lower-case-p* name)
+ "small" "capital")))
+ (loop for script in *unicode-scripts*
+ thereis (or (gethash (concatenate 'string
+ script " "
+ size " letter "
+ name)
+ *unicode-names*)
+ (gethash (concatenate 'string
+ script " letter "
+ name)
+ *unicode-names*))))))
+
+(defun get-char-from-unicode-name ()
+ "Parses and returns a named character after \"\\N\" has already been
+read. This function reads from *STREAM*."
+ (let ((next-char (read-char*)))
+ (unless (char= next-char #\{)
+ (signal-reader-error "Expected { after \\N"))
+ (let ((name (read-while (lambda (c)
+ (and (char/= c #\})
+ (char/= c *term-char*))))))
+ (let ((next-char (read-char*)))
+ (unless (char= next-char #\})
+ (signal-reader-error "Expected } after Unicode character name")))
+ (or (resolve-unicode-name name)
+ (signal-reader-error "Could not find character with name '~A'"
+ name)))))
+
+(defun unescape-char (regex-mode)
+ "Convert the characters(s) on *STREAM* following a backslash into a
+character which is returned. This function is to be called when the
+backslash has already been consumed."
+ (let ((chr (read-char*)))
+ ;; certain escape sequences are left as is when in regex mode
+ (when (or (and (eq regex-mode :in-char-class)
+ (find chr "wWsSdD" :test #'char=))
+ (and (eq regex-mode t)
+ (find chr "wWsSdDbBAZz" :test #'char=)))
+ (return-from unescape-char
+ (concatenate 'string "\\" (string chr))))
+ (let ((result
+ (case chr
+ ((#\N)
+ ;; named Unicode chars
+ (get-char-from-unicode-name))
+ ((#\c)
+ ;; \cx means control-x
+ (when (char= (peek-char*) *term-char*)
+ (signal-reader-error "String ended after \\c"))
+ (code-char (logxor #x40
+ (char-code (char-upcase (read-char*))))))
+ ((#\x)
+ (cond ((char= (peek-char*) #\{)
+ ;; "wide" hex char, i.e. hexadecimal number is
+ ;; enclosed in curly brackets
+ (read-char*)
+ (prog1
+ (let ((code (or (get-number :radix 16)
+ ;; allow for empty string
+ 0)))
+ (or (and (< code char-code-limit)
+ (code-char code))
+ (signal-reader-error
+ "No character for char-code #x~X" code)))
+ (unless (char= (peek-char*) #\})
+ (signal-reader-error "Expected } after hex code"))
+ (read-char*)))
+ (t
+ ;; \x should be followed by a hexadecimal char
+ ;; code, two digits or less; note that it is
+ ;; OK if \x is followed by zero digits
+ (make-char-from-code (get-number :radix 16 :max 2)))))
+ ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+ (cond ((and (eq regex-mode t)
+ (char/= chr #\0))
+ ;; leave as is if we're in regex mode (and not
+ ;; within in a character class)
+ (concatenate 'string "\\" (string chr)))
+ ((or (char= chr #\8)
+ (char= chr #\9))
+ ;; outside of regex mode "\8" is "8" (in regex
+ ;; mode it is read like "\08"...)
+ chr)
+ (t
+ (unread-char chr *stream*)
+ ;; now \x should be followed by an octal char
+ ;; code, three digits or less
+ (make-char-from-code (get-number :radix 8 :max 3)))))
+ ;; the following five character names are
+ ;; 'semi-standard' according to the CLHS but I'm not
+ ;; aware of any implementation that doesn't implement
+ ;; them
+ ((#\t)
+ #\Tab)
+ ((#\n)
+ #\Newline)
+ ((#\r)
+ #\Return)
+ ((#\f)
+ #\Page)
+ ((#\b)
+ #\Backspace)
+ ((#\a)
+ (code-char 7)) ; ASCII bell
+ ((#\e)
+ (code-char 27)) ; ASCII escape
+ (otherwise
+ ;; all other characters aren't affected by a backslash
+ chr))))
+ (cond ((and (characterp result)
+ ;; some characters must be 'protected' from CL-PPCRE
+ (or (and (eq regex-mode :in-char-class)
+ (find result "\\^[]-" :test #'char=))
+ (and (eq regex-mode t)
+ (find result "\\^[]-.$|()*+?" :test #'char=))))
+ (concatenate 'string "\\" (string result)))
+ (t result)))))
+
+(declaim (inline normal-name-char-p)
+ (inline never-name-char-p))
+
+(defun normal-name-char-p (c)
+ (and c (or (alphanumericp c)
+ (member c '(#\_ #\- #\+ #\*)))))
+
+(defun never-name-char-p (c)
+ (or (not c)
+ (get-macro-character c)
+ (member c '(#\$ #\@))))
+
+(defvar quell-warnings-form
+ #+sbcl '(declare (optimize (sb-ext:inhibit-warnings 3)))
+ #-sbcl nil
+ "A declaration form to quiet warnings about unbound variables
+ within a lexical environment.")
+
+(defun read-longest-name ()
+ (coerce
+ (loop until (never-name-char-p (peek-char nil *stream* nil nil t))
+ collect (read-char*))
+ 'string))
+
+(defun read-optional-delimited ()
+ "Read the stuff following an optional delimiter, returning a form
+that tries to deal correctly with lexical variables."
+ (flet ((try-pos (name i form)
+ (let ((ostr (gensym)))
+ `(handler-case
+ (with-output-to-string (,ostr)
+ (princ ,(read-from-string (subseq name 0 i)) ,ostr)
+ (princ ,(subseq name i) ,ostr)
+ ,ostr)
+ (unbound-variable () ,form)))))
+
+ (loop
+ with name = (read-longest-name)
+ with form = `(error ,(format nil "Interpolation error in ~s~%" name))
+ with ostr = (gensym)
+ for i = (position-if-not #'normal-name-char-p name)
+ then (position-if-not #'normal-name-char-p name :start (1+ i))
+
+ unless i
+ return `(let () ,quell-warnings-form
+ (handler-case
+ (with-output-to-string (,ostr)
+ (princ ,(read-from-string name) ,ostr)
+ ,ostr)
+ (unbound-variable () ,form)))
+
+ if (> i 0)
+ do (setq form (try-pos name i form))
+
+ if (< i (length name))
+ do (setq form (try-pos name (1+ i) form)))))
+
+(declaim (inline read-form))
+(defun read-form ()
+ "Reads and returns one or more Lisp forms from *STREAM* if the
+character we're looking at is a valid inner delimiter. Otherwise
+returns NIL."
+ (let* ((start-delimiter (peek-char*))
+ (end-delimiter (get-end-delimiter start-delimiter *inner-delimiters*)))
+ (cond ((null end-delimiter)
+ (if *optional-delimiters-p*
+ (read-optional-delimited)
+ nil))
+ (t
+ `(progn
+ ,@(progn
+ (read-char*)
+ (let ((*readtable* (copy-readtable*)))
+ ;; temporarily change the readtable
+ (set-syntax-from-char end-delimiter #\))
+ (read-delimited-list end-delimiter *stream* t))))))))
+
+(defun interpol-reader (*stream* char arg)
+ "The actual reader function for the 'sub-character' #\?."
+ (declare (ignore arg char))
+ (let ((*start-char* (read-char*))
+ ;; REGEX-MODE is true if we're in regular expression mode; it
+ ;; can have one of the values :START-OF-CHAR-CLASS,
+ ;; :START-OF-NEGATED-CHAR-CLASS, or :IN-CHAR-CLASS if we're
+ ;; inside of a character class or just about to start one -
+ ;; otherwise the value is T
+ regex-mode
+ ;; EXTENDED-MODE is true if we're in extended regular
+ ;; expression mode
+ extended-mode)
+ (when (char-equal *start-char* #\r)
+ (setq regex-mode t
+ *start-char* (read-char*)))
+ (when (char-equal *start-char* #\x)
+ (setq extended-mode t
+ *start-char* (read-char*)))
+ (when (and (not regex-mode)
+ (find *start-char* *regex-delimiters* :test #'char=))
+ (setq regex-mode t))
+ (unless regex-mode
+ (setq extended-mode nil))
+ (let ((*term-char* (get-end-delimiter *start-char*
+ *outer-delimiters*
+ :errorp t))
+ (*pair-level* 0)
+ (*inner-delimiters* (if regex-mode
+ (intersection *inner-delimiters*
+ '((#\{ . #\}))
+ :test #'equal)
+ *inner-delimiters*))
+ *saw-backslash*
+ *readtable-copy*)
+ (prog1
+ (inner-reader regex-mode extended-mode nil nil)
+ ;; consume the closing outer delimiter
+ (read-char*)))))
+
+(defun inner-reader (regex-mode extended-mode quote-mode case-mode)
+ "Helper function for INTERPOL-READER which does all the work. May
+call itself recursively."
+ ;; REGEX-MODE and EXTENDED-MODE as described above; QUOTE-MODE is
+ ;; true if we're inside a \Q scope; CASE-MODE is true if we're
+ ;; inside a \L or \U scope
+ (let* ((string-stream (gensym)) ;; the string stream
+ ;; we use for WITH-OUTPUT-TO-STRING
+ ;; if this is not a constant string
+ (collector (make-collector)) ;; we collect
+ ;; characters into this
+ ;; extentable string
+ result ;; a list of all characters, strings, and forms
+ ;; so far (in reverse order while withing the loop)
+ handle-next-char)
+ (block main-loop ;; we need this name so we can leave the LOOP below
+ (flet ((compute-result ()
+ ;; local function used to leave the loop and compute
+ ;; the final RESULT
+ (setq result
+ (nreverse
+ (if (plusp (length collector))
+ ;; add COLLECTOR if it's not empty
+ (cons collector result)
+ result)))
+ (return-from main-loop))
+ (parse-with-case-mode (action-name)
+ ;; local function used to read while in a \U or \L scope
+ (let ((string-to-modify
+ ;; read until \E, \L, \U, or end of string
+ (inner-reader regex-mode extended-mode regex-mode t)))
+ (if (stringp string-to-modify)
+ ;; modify directly if constant string
+ (funcall action-name string-to-modify)
+ ;; otherwise create a form to do that at run time
+ `(write-string
+ (,action-name ,string-to-modify)
+ ,string-stream)))))
+ (loop
+ (let ((next-char (read-char*)))
+ (when regex-mode
+ ;; when in regex mode make sure where we are with
+ ;; respect to character classes
+ (setq regex-mode
+ (case next-char
+ ((#\[)
+ (ecase regex-mode
+ ((:start-of-char-class
+ :start-of-negated-char-class
+ :in-char-class) :in-char-class)
+ ((t) :start-of-char-class)))
+ ((#\^)
+ (ecase regex-mode
+ ((:start-of-char-class) :start-of-negated-char-class)
+ ((:start-of-negated-char-class
+ :in-char-class) :in-char-class)
+ ((t) t)))
+ ((#\])
+ (ecase regex-mode
+ ((:start-of-char-class
+ :start-of-negated-char-class) :in-char-class)
+ ((:in-char-class t) t)))
+ (otherwise
+ (ecase regex-mode
+ ((:start-of-char-class
+ :start-of-negated-char-class
+ :in-char-class) :in-char-class)
+ ((t) t))))))
+ (when (and (char= next-char *start-char*)
+ (char/= *start-char* *term-char*))
+ ;; if we see, say, #\( and our closing delimiter is #\)
+ ;; we increment *PAIR-LEVEL* so the parentheses can next
+ ;; without ending the string
+ (incf *pair-level*))
+ (let ((interpolation
+ (cond ((and (char= next-char *term-char*)
+ (plusp *pair-level*))
+ ;; although this is the outer closing
+ ;; delimiter we don't stop parsing because
+ ;; we're insided a nested pair of
+ ;; bracketing characters
+ (decf *pair-level*)
+ *term-char*)
+ ((char= next-char *term-char*)
+ ;; now we really stop - but we don't
+ ;; consume the closing delimiter because
+ ;; we may need it again to end another
+ ;; scope
+ (unread-char next-char *stream*)
+ (compute-result))
+ (t
+ (case next-char
+ ((#\L)
+ (cond ((not *saw-backslash*)
+ ;; a normal #\L, no 'pending'
+ ;; backslash
+ #\L)
+ (case-mode
+ ;; a backslashed #\L which
+ ;; we've seen before but we
+ ;; still have to close at
+ ;; least one \Q/\L/\E scope
+ (unread-char #\L *stream*)
+ (compute-result))
+ (t
+ ;; all scopes are closed, now
+ ;; read and downcase 'till \E
+ ;; or somesuch
+ (setq *saw-backslash* nil)
+ (parse-with-case-mode 'string-downcase))))
+ ((#\U)
+ ;; see comments for #\L above
+ (cond ((not *saw-backslash*)
+ #\U)
+ (case-mode
+ (unread-char #\U *stream*)
+ (compute-result))
+ (t
+ (setq *saw-backslash* nil)
+ (parse-with-case-mode 'string-upcase))))
+ ((#\Space #\Tab #\Linefeed #\Return #\Page)
+ (cond ((and extended-mode
+ (not (eq regex-mode :in-char-class)))
+ ;; in extended mode (if not in
+ ;; a character class)
+ ;; whitespace is removed
+ "")
+ (t next-char)))
+ ((#\()
+ (cond ((and (eq regex-mode t)
+ (null quote-mode)
+ (char/= *term-char* #\?)
+ (eql (peek-char*) #\?))
+ ;; this could start an
+ ;; embedded comment in regex
+ ;; mode (and we're /not/
+ ;; inside of a \Q scope or a
+ ;; character class)
+ (read-char*)
+ (cond ((and (char/= *term-char* #\#)
+ (eql (peek-char*) #\#))
+ ;; yes, it's a
+ ;; comment, so consume
+ ;; characters 'till #\)
+ (read-while
+ (lambda (char)
+ (and (char/= char #\))
+ (char/= char *term-char*))))
+ (cond ((char= (read-char*) *term-char*)
+ (signal-reader-error
+ "Incomplete regex comment starting with '(#'"))
+ ((not (digit-char-p (peek-char*) 16))
+ "")
+ ;; special case
+ ;; if next
+ ;; character
+ ;; could
+ ;; potentially
+ ;; continue an
+ ;; octal or
+ ;; hexadecimal
+ ;; representation
+ (t "(?:)")))
+ ;; no, wasn't a comment
+ (t "(?")))
+ (t #\()))
+ ((#\#)
+ (cond ((and (eq regex-mode t)
+ extended-mode
+ (null quote-mode))
+ ;; we're in extended regex
+ ;; mode and not inside of a \Q
+ ;; scope or a character class,
+ ;; so this is a comment and we
+ ;; consume it 'till #\Newline
+ ;; or *TERM-CHAR*
+ (read-while
+ (lambda (char)
+ (and (char/= char #\Newline)
+ (char/= char *term-char*))))
+ (when (char= (peek-char*) #\Newline)
+ (read-char*))
+ (cond ((not (digit-char-p (peek-char*)
+ 16))
+ "")
+ ;; special case, see above
+ (t "(?:)")))
+ (t #\#)))
+ ((#\\)
+ (case (peek-char*)
+ ((#\Q)
+ ;; \Q - start a new quote scope
+ (read-char*)
+ (let ((string-to-quote
+ (inner-reader regex-mode
+ extended-mode
+ t case-mode)))
+ (if (stringp string-to-quote)
+ ;; if we got a constant string
+ ;; we modify it directly
+ (quote-meta-chars string-to-quote)
+ ;; otherwise we expand into code
+ `(write-string
+ (quote-meta-chars ,string-to-quote)
+ ,string-stream))))
+ ((#\L)
+ ;; \L - start a new case-modifying
+ ;; scope
+ (cond (case-mode
+ ;; if we're already in
+ ;; this mode we have to
+ ;; end all previous scopes
+ ;; first - we set
+ ;; *SAW-BACKSLASH* to T so
+ ;; the #\L is read until
+ ;; all scopes are finished
+ (setq *saw-backslash* t)
+ (compute-result))
+ (t
+ ;; all scopes are closed, now
+ ;; read and downcase 'till \E
+ ;; or somesuch
+ (setq *saw-backslash* nil)
+ (read-char*)
+ (parse-with-case-mode 'string-downcase))))
+ ((#\U)
+ ;; see comments for #\L above
+ (cond (case-mode
+ (setq *saw-backslash* t)
+ (compute-result))
+ (t
+ (setq *saw-backslash* nil)
+ (read-char*)
+ (parse-with-case-mode 'string-upcase))))
+ ((#\E)
+ ;; \E - ends exactly one scope
+ (read-char*)
+ (if (or quote-mode case-mode)
+ (compute-result)
+ ""))
+ ((#\l)
+ ;; \l - downcase next character
+ (read-char*)
+ ;; remember that we have to do this
+ (setq handle-next-char :downcase)
+ nil)
+ ((#\u)
+ ;; \u - upcase next character
+ (read-char*)
+ ;; remember that we have to do this
+ (setq handle-next-char :upcase)
+ nil)
+ (otherwise
+ ;; otherwise this is a
+ ;; backslash-escaped character
+ (unescape-char regex-mode))))
+ ((#\$)
+ ;; #\$ - might be an interpolation
+ (let ((form (read-form)))
+ (cond ((null form)
+ ;; no, just dollar sign
+ #\$)
+ (handle-next-char
+ ;; yes, and we have to
+ ;; modify the first
+ ;; character
+ (prog1
+ (let ((string (gensym)))
+ `(let ((,string (format nil "~A"
+ ,form)))
+ (when (plusp (length ,string))
+ (setf (char ,string 0)
+ (,(if (eq handle-next-char
+ :downcase)
+ 'char-downcase
+ 'char-upcase)
+ (char ,string 0))))
+ (write-string ,string ,string-stream)))
+ (setq handle-next-char nil)))
+ (t
+ ;; no modification, just
+ ;; insert a form to PRINC
+ ;; this interpolation
+ `(princ ,form ,string-stream)))))
+ ((#\@)
+ ;; #\Q - might be an interpolation
+ (let ((form (read-form))
+ (element (gensym))
+ (first (gensym)))
+ (cond ((null form)
+ ;; no, just at-sign
+ #\@)
+ (handle-next-char
+ ;; yes, and we have to
+ ;; modify the first
+ ;; character
+ (prog1
+ (let ((string (gensym)))
+ `(loop for ,first = t then nil
+ for ,element in ,form
+ unless ,first do
+ (princ *list-delimiter*
+ ,string-stream)
+ if ,first do
+ (let ((,string
+ (format nil "~A"
+ ,element)))
+ (when (plusp (length ,string))
+ (setf (char ,string 0)
+ (,(if (eq handle-next-char
+ :downcase)
+ 'char-downcase
+ 'char-upcase)
+ (char ,string 0))))
+ (write-string ,string ,string-stream))
+ else do
+ (princ ,element ,string-stream)))
+ (setq handle-next-char nil)))
+ (t
+ ;; no modification, just
+ ;; insert a form to PRINC
+ ;; this interpolated list
+ ;; (including the list
+ ;; delimiters inbetween)
+ `(loop for ,first = t then nil
+ for ,element in ,form
+ unless ,first do (princ *list-delimiter*
+ ,string-stream)
+ do (princ ,element ,string-stream))))))
+ ;; just a 'normal' character
+ (otherwise next-char))))))
+ (when interpolation
+ ;; INTERPOLATION is NIL if we just saw #\l or #\u
+ (when (and handle-next-char
+ (consp interpolation)
+ (eq (first interpolation)
+ 'write-string))
+ ;; if we have to upcase or downcase the following
+ ;; character and we just collected a form (from a
+ ;; \Q/\L/\U scope) we have to insert code for the
+ ;; modification
+ (setf (second interpolation)
+ (let ((string (gensym)))
+ `(let ((,string ,(second interpolation)))
+ (when (plusp (length ,string))
+ (setf (char ,string 0)
+ (,(if (eq handle-next-char :downcase)
+ 'char-downcase
+ 'char-upcase)
+ (char ,string 0))))
+ ,string)))
+ (setq handle-next-char nil))
+ (cond ((characterp interpolation)
+ ;; add one character to COLLECTOR and handle
+ ;; it according to HANDLE-NEXT-CHAR
+ (vector-push-extend (case handle-next-char
+ ((:downcase)
+ (setq handle-next-char nil)
+ (char-downcase interpolation))
+ ((:upcase)
+ (setq handle-next-char nil)
+ (char-upcase interpolation))
+ (otherwise
+ interpolation))
+ collector))
+ ((stringp interpolation)
+ ;; add a string to COLLECTOR and handle its
+ ;; first character according to
+ ;; HANDLE-NEXT-CHAR
+ (loop for char across interpolation
+ do (vector-push-extend (case handle-next-char
+ ((:downcase)
+ (setq handle-next-char nil)
+ (char-downcase char))
+ ((:upcase)
+ (setq handle-next-char nil)
+ (char-upcase char))
+ (otherwise
+ char))
+ collector)))
+ ((plusp (length collector))
+ ;; add code (to be executed at runtime) but
+ ;; make sure to empty COLLECTOR first
+ (push collector result)
+ (push interpolation result)
+ ;; reset collector
+ (setf collector (make-collector)))
+ (t
+ ;; same but COLLECTOR is empty
+ (push interpolation result)))))))))
+ (if (every #'stringp result)
+ ;; if all elements of RESULT are strings we can return a
+ ;; constant string
+ (string-list-to-string result)
+ ;; otherwise we have to wrap the PRINCs emitted above into a
+ ;; WITH-OUTPUT-TO-STRING form
+ `(with-output-to-string (,string-stream)
+ ,@(loop for interpolation in result
+ if (stringp interpolation)
+ collect `(write-string ,interpolation ,string-stream)
+ else
+ collect interpolation)))))
+
+(defun %enable-interpol-syntax ()
+ "Internal function used to enable reader syntax and store current
+readtable on stack."
+ (push *readtable*
+ *previous-readtables*)
+ (setq *readtable* (copy-readtable))
+ (set-dispatch-macro-character #\# #\? #'interpol-reader)
+ (values))
+
+(defun %disable-interpol-syntax ()
+ "Internal function used to restore previous readtable."
+ (if *previous-readtables*
+ (setq *readtable* (pop *previous-readtables*))
+ (setq *readtable* (copy-readtable nil)))
+ (values))
+
+(defmacro enable-interpol-syntax ()
+ "Enable CL-INTERPOL reader syntax."
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (%enable-interpol-syntax)))
+
+(defmacro disable-interpol-syntax ()
+ "Restore readtable which was active before last call to
+ENABLE-INTERPOL-SYNTAX. If there was no such call, the standard
+readtable is used."
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (%disable-interpol-syntax)))
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/specials.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/specials.lisp 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/specials.lisp 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,123 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/specials.lisp,v 1.7 2004/04/24 00:19:13 edi Exp $
+
+;;; Copyright (c) 2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-interpol)
+
+(defvar *list-delimiter* #\Space
+ "What is inserted between the elements of a list which is
+interpolated by #\@.")
+
+(defvar *inner-delimiters* '((#\( . #\))
+ (#\{ . #\})
+ (#\< . #\>)
+ (#\[ . #\]))
+ "Legal delimiters for interpolation with #\$ and #\@.")
+
+(defvar *outer-delimiters* '((#\( . #\))
+ (#\{ . #\})
+ (#\< . #\>)
+ (#\[ . #\])
+ #\/ #\| #\" #\' #\#)
+ "Legal outer delimiters for CL-INTERPOL strings.")
+
+(defvar *regex-delimiters* '(#\/)
+ "Outer delimiters which automatically enable regex mode.")
+
+(defvar *unicode-names*
+ (make-hash-table :test #'equalp :size (min 14000 (+ 50 char-code-limit)))
+ "A hash table which maps Unicode names to characters.")
+
+(defvar *long-unicode-names-p* t
+ "Whether long Unicode names should be tried")
+
+(defvar *short-unicode-names-p* nil
+ "Whether long Unicode names \(like \"Greek:Sigma\") should be tried")
+
+(defvar *unicode-scripts* '("latin")
+ "The Unicode scripts which are to be tried if a name couldn't be
+resolved otherwise.")
+
+(defvar *optional-delimiters-p* nil
+ "Whether text following $ or @ should interpolate even without a
+following delimiter. Lexical variables are handled correctly,
+but the rules are somewhat complex -- see the docs for details.")
+
+(defmacro defvar-unbound (variable-name documentation)
+ "Like DEFVAR, but the variable will be unbound rather than getting
+an initial value. This is useful for variables which should have no
+global value but might have a dynamically bound value."
+ ;; stolen from comp.lang.lisp article <k7727i3s.fsf(a)comcast.net> by
+ ;; "prunesquallor(a)comcast.net"
+ `(eval-when (:load-toplevel :compile-toplevel :execute)
+ (defvar ,variable-name)
+ (setf (documentation ',variable-name 'variable)
+ ,documentation)))
+
+(defvar-unbound *saw-backslash*
+ "Whether we have to re-process an \L or \U because it closes several
+scopes.")
+
+(defvar-unbound *pair-level*
+ "")
+
+(defvar-unbound *stream*
+ "Bound to the stream which is read from while parsing a string.")
+
+(defvar-unbound *start-char*
+ "Bound to the opening outer delimiter while parsing a string.")
+
+(defvar-unbound *term-char*
+ "Bound to the closing outer delimiter while parsing a string.")
+
+(defvar *previous-readtables* nil
+ "A stack which holds the previous readtables that have been pushed
+here by ENABLE-INTERPOL-SYNTAX.")
+
+(defvar-unbound *readtable-copy*
+ "Bound to the current readtable if it has to be temporarily
+modified.")
+
+;; stuff for Nikodemus Siivola's HYPERDOC
+;; see <http://common-lisp.net/project/hyperdoc/>
+;; and <http://www.cliki.net/hyperdoc>
+
+(defvar *hyperdoc-base-uri* "http://weitz.de/cl-interpol/")
+
+(let ((exported-symbols-alist
+ (loop for symbol being the external-symbols of :cl-interpol
+ collect (cons symbol
+ (concatenate 'string
+ "#"
+ (string-downcase symbol))))))
+ (defun hyperdoc-lookup (symbol type)
+ (declare (ignore type))
+ (cdr (assoc symbol
+ exported-symbols-alist
+ :test #'eq))))
+
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test.lisp 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test.lisp 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,177 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/test.lisp,v 1.9 2004/04/24 00:19:13 edi Exp $
+
+;;; Copyright (c) 2002-2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-interpol)
+
+;; Otherwise it's impossible to see which tests are failing for all
+;; the "helpful" warnings.
+#+sbcl (declaim (optimize (sb-ext:inhibit-warnings 3)))
+
+(defvar *temp*)
+
+(defparameter *cl-interpol-base-directory*
+ (make-pathname :name nil :type nil :version nil
+ :defaults (parse-namestring *load-truename*)))
+
+(defparameter *test-counter* 0)
+
+(defparameter *failure-counter* 0)
+
+(defun test (form1 form2)
+ (unless (string= form1 form2)
+ (incf *failure-counter*)
+ (format t "~&Test ~A failed: Expected ~S but got ~S~%"
+ (1+ *test-counter*) form2 form1))
+ (incf *test-counter*)
+ (princ #\.)
+ (when (zerop (mod *test-counter* 10))
+ (princ #\Space)
+ (princ *test-counter*)
+ (terpri))
+ (force-output))
+
+(enable-interpol-syntax)
+
+(test #?"abc" "abc")
+(test #?'abc' "abc")
+(test #?|abc| "abc")
+(test #?/abc/ "abc")
+(test #?#abc# "abc")
+(test #?{abc} "abc")
+(test #?(abc) "abc")
+(test #?<abc> "abc")
+(test #?[abc] "abc")
+(test #?"\t\n\r\f\b\a\e"
+ (coerce (list #\Tab #\Newline #\Return #\Page #\Backspace (code-char 7) (code-char 27))
+ 'string))
+(test #?"\033\x1b\c[\x{1b}"
+ (make-string 4 :initial-element (code-char 27)))
+(test #?"\x" (string (code-char 0)))
+(test #?"\x001" (format nil "~A1" (code-char 0)))
+(test #?"\0001" (format nil "~A1" (code-char 0)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setq *temp* (list *long-unicode-names-p*
+ *short-unicode-names-p*
+ *unicode-scripts*)
+ *long-unicode-names-p* t))
+
+(test #?"\N{LATIN CAPITAL LETTER A WITH DIAERESIS}" "�")
+(test #?"\N{latin capital letter a with diaeresis}" "�")
+(test #?{\N{LATIN CAPITAL LETTER A WITH DIAERESIS}} "�")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setq *short-unicode-names-p* t))
+
+(test #?"\N{Latin:A with Diaeresis}" "�")
+(test #?"\N{Latin:a with diaeresis}" "�")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setq *unicode-scripts* (list "Latin")))
+
+(test #?"\N{A with Diaeresis}" "�")
+(test #?"\N{a with diaeresis}" "�")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setq *long-unicode-names-p* (first *temp*)
+ *short-unicode-names-p* (second *temp*)
+ *unicode-scripts* (third *temp*)))
+
+(test #?/\1/ "\\1")
+(test #?r"\1" "\\1")
+(test #?x/abc / "abc")
+(test #?x/abc
+ / "abc")
+(test #?rx"abc " "abc")
+(test #?/[\1]\1/ (format nil "[~A]\\1" (code-char 1)))
+(test #?/[(?#foo)](?#foo)/ "[(?#foo)]")
+(test #?/a#bc/ "a#bc")
+(test #?x/a#bc/ "a")
+(test #?x/\d\A[\d\A]/ "\\d\\A[\\dA]")
+
+(test #?"\Q-" "\\-")
+(test #?"\Q-\E-" "\\--")
+(test #?"\ufoo" "Foo")
+(test #?"\Ufoo" "FOO")
+(test #?"\Ufoo\Ebar" "FOObar")
+(test #?"\Ufoo\LBAR" "FOObar")
+
+(let ((a "foo"))
+ (test #?"$" "$")
+ (test #?"@ @" "@ @")
+ (test #?"${a}bar" "foobar")
+ (test #?/${a}bar/ "foobar")
+ (test #?"$[a]bar" "foobar")
+ (test #?"$(a)bar" "foobar")
+ (test #?"$<a>bar" "foobar")
+ (test #?/$<a>bar/ "$<a>bar")
+ (test #?"$a @a " "$a @a "))
+
+(let ((a (list 1 2 3)))
+ (test #?"${a}" "(1 2 3)")
+ (test #?"@{a}" "1 2 3")
+ (let ((*list-delimiter* ""))
+ (test #?"@{a}" "123")))
+
+(let* ((a "foo")
+ (b #\Space)
+ (c "bar")
+ (d (list a b c))
+ (x 40))
+ (test #?"$ @" "$ @")
+ (test #?"$(a)" "foo")
+ (test #?"$<a>$[b]" "foo ")
+ (test #?"\U${a}\E \u${a}" "FOO Foo")
+ (test (let ((cl-interpol:*list-delimiter* #\*))
+ #?"@{d}")
+ "foo* *bar")
+ (test (let ((cl-interpol:*list-delimiter* ""))
+ #?"@{d}")
+ "foo bar")
+ (test #?"The result is ${(let ((y 2)) (+ x y))}"
+ "The result is 42")
+ (test #?"${#?'${a} ${c}'} ${x}" "foo bar 40"))
+
+(setq cl-interpol:*optional-delimiters-p* t)
+(test (let ((% 23)) #?"$%a%b%") "23a%b%")
+(test (let ((%a 23)) #?"$%a%b%") "23%b%")
+(test (let ((%a% 23)) #?"$%a%b%") "23b%")
+(test (let ((%a%b 23)) #?"$%a%b%") "23%")
+(test (let ((%a%b% 23)) #?"$%a%b%") "23")
+(setq cl-interpol:*optional-delimiters-p* nil)
+
+(load (merge-pathnames "test2.lisp"
+ *cl-interpol-base-directory*))
+
+(disable-interpol-syntax)
+
+(cond ((zerop *failure-counter*)
+ (format t "~&All tests passed."))
+ (t
+ (format t "~&~A tests failed!" *failure-counter*)))
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test.pl
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test.pl 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test.pl 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+
+### $Header: /usr/local/cvsrep/cl-interpol/test.pl,v 1.4 2003/10/19 15:55:25 edi Exp $
+
+### Copyright (c) 2002-2003, Dr. Edmund Weitz. All rights reserved.
+
+### Redistribution and use in source and binary forms, with or without
+### modification, are permitted provided that the following conditions
+### are met:
+
+### * Redistributions of source code must retain the above copyright
+### notice, this list of conditions and the following disclaimer.
+
+### * Redistributions in binary form must reproduce the above
+### copyright notice, this list of conditions and the following
+### disclaimer in the documentation and/or other materials
+### provided with the distribution.
+
+### THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+### OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+### WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+### ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+### DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+### DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+### GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+### INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+### NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+### SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+my @chars = qw(\Q \L \U \E \l \u);
+
+sub combine {
+ my $delim = shift;
+ my @result = ();
+ foreach my $char (@chars) {
+ foreach my $string (@_) {
+ push @result, "$char$delim$string";
+ }
+ }
+ @result;
+}
+
+sub quote {
+ local $_ = shift;
+ s/\\/\\\\/g;
+ $_;
+}
+
+print <<'HEAD';
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/test.pl,v 1.4 2003/10/19 15:55:25 edi Exp $
+
+;;; Copyright (c) 2002-2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; This file was automatically generated by a Perl script. It should
+;;; not be loaded directly but by "load.lisp" instead.
+
+(in-package #:cl-interpol)
+
+(enable-interpol-syntax)
+
+HEAD
+
+foreach my $a (('Aa-', 'aA-')) {
+ my $counter = 0;
+ my @arr = @chars;
+ while ($counter++ < 4) {
+ foreach my $str (@arr) {
+ print "(let ((a \"$a\"))\n";
+ my $test = "\${a}$str\${a}";
+ print " (test #?\"$test\" \"" . (quote eval "\"$test\"") . "\"))\n";
+ }
+ @arr = combine '${a}', @arr;
+ }
+}
+
+print "\n(disable-interpol-syntax)\n";
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test2.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test2.lisp 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/test2.lisp 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,6254 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/test2.lisp,v 1.3 2003/10/19 15:55:25 edi Exp $
+
+;;; Copyright (c) 2002-2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; This file was automatically generated by a Perl script. It should
+;;; not be loaded directly but by "load.lisp" instead.
+
+(in-package #:cl-interpol)
+
+(enable-interpol-syntax)
+
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}" "Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}" "Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}" "Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}" "Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}" "Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}" "Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}" "Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}" "Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}" "Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}" "Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}" "Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}" "Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}" "Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}" "Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}" "Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}" "Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}" "Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}" "Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}" "Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}" "Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}" "Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}" "Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}" "Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}" "Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}" "Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}" "Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}" "Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}" "Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}" "Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}" "Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}" "Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}" "Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}" "Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}" "Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}" "Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}" "Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}" "Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}" "Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}" "Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}" "Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}" "Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}" "Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}" "Aa-Aa\\-Aa\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}" "Aa-Aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}" "Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}" "Aa-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}" "Aa-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}" "Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}" "Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}" "Aa-Aa\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}" "Aa-Aa\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}" "Aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}" "Aa-Aa\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}" "Aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}" "Aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}" "Aa-Aa\\-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}" "Aa-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}" "Aa-Aa\\-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}" "Aa-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}" "Aa-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}" "Aa-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}" "Aa-Aa\\-aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}" "Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}" "Aa-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}" "Aa-Aa\\-aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}" "Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}" "Aa-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}" "Aa-Aa\\-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}" "Aa-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}" "Aa-Aa\\-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}" "Aa-Aa\\-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}" "Aa-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}" "Aa-Aa\\-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}" "Aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}" "Aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}" "Aa-aa-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}" "Aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}" "Aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}" "Aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}" "Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\L${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\U${a}" "Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\E${a}" "Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\l${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\u${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}" "Aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\L${a}" "Aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\U${a}" "Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\E${a}" "Aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\l${a}" "Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\u${a}" "Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}" "Aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\L${a}" "Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\U${a}" "Aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\E${a}" "Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\l${a}" "Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\u${a}" "Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}" "Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\L${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\U${a}" "Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\E${a}" "Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\l${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\u${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}" "Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\L${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\U${a}" "Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\E${a}" "Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\l${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\u${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}" "Aa-AA-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}" "Aa-AA-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}" "Aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}" "Aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}" "Aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}" "Aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}" "Aa-AA-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\L${a}" "Aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\U${a}" "Aa-AA-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\E${a}" "Aa-AA-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\l${a}" "Aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\u${a}" "Aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}" "Aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\L${a}" "Aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\U${a}" "Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\E${a}" "Aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\l${a}" "Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\u${a}" "Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}" "Aa-AA-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\L${a}" "Aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\U${a}" "Aa-AA-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\E${a}" "Aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\l${a}" "Aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\u${a}" "Aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}" "Aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\L${a}" "Aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\U${a}" "Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\E${a}" "Aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\l${a}" "Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\u${a}" "Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}" "Aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\L${a}" "Aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\U${a}" "Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\E${a}" "Aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\l${a}" "Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\u${a}" "Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}" "Aa-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}" "Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}" "Aa-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}" "Aa-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}" "Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}" "Aa-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}" "Aa-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\L${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\U${a}" "Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\E${a}" "Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\l${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\u${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}" "Aa-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\L${a}" "Aa-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\U${a}" "Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\E${a}" "Aa-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\l${a}" "Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\u${a}" "Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}" "Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\L${a}" "Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\U${a}" "Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\E${a}" "Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\l${a}" "Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\u${a}" "Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}" "Aa-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\L${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\U${a}" "Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\E${a}" "Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\l${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\u${a}" "Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}" "Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\L${a}" "Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\U${a}" "Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\E${a}" "Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\l${a}" "Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\u${a}" "Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}" "Aa-aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}" "Aa-aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}" "Aa-aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}" "Aa-aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}" "Aa-aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}" "Aa-aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}" "Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\L${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\U${a}" "Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\E${a}" "Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\l${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\u${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}" "Aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\L${a}" "Aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\U${a}" "Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\E${a}" "Aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\l${a}" "Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\u${a}" "Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}" "Aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\L${a}" "Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\U${a}" "Aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\E${a}" "Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\l${a}" "Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\u${a}" "Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}" "Aa-aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\L${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\U${a}" "Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\E${a}" "Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\l${a}" "Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\u${a}" "Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}" "Aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\L${a}" "Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\U${a}" "Aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\E${a}" "Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\l${a}" "Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\u${a}" "Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}" "Aa-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}" "Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}" "Aa-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}" "Aa-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}" "Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}" "Aa-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}" "Aa-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\L${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\U${a}" "Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\E${a}" "Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\l${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\u${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}" "Aa-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\L${a}" "Aa-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\U${a}" "Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\E${a}" "Aa-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\l${a}" "Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\u${a}" "Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}" "Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\L${a}" "Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\U${a}" "Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\E${a}" "Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\l${a}" "Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\u${a}" "Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}" "Aa-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\L${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\U${a}" "Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\E${a}" "Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\l${a}" "Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\u${a}" "Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}" "Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\L${a}" "Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\U${a}" "Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\E${a}" "Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\l${a}" "Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\u${a}" "Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\Q${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-Aa\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\L${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\U${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-AA\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\E${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\l${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\u${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-Aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\Q${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\L${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\U${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\E${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\l${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\u${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\Q${a}" "Aa-Aa\\-Aa\\\\\\-AA\\\\\\-AA\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\L${a}" "Aa-Aa\\-Aa\\\\\\-AA\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\U${a}" "Aa-Aa\\-Aa\\\\\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\E${a}" "Aa-Aa\\-Aa\\\\\\-AA\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\l${a}" "Aa-Aa\\-Aa\\\\\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\u${a}" "Aa-Aa\\-Aa\\\\\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\Q${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\L${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\U${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\E${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\l${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\u${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\Q${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-Aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\L${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\U${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\E${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\l${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\u${a}" "Aa-Aa\\-Aa\\\\\\-aa\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\Q${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\L${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\U${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\E${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\l${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\u${a}" "Aa-Aa\\-Aa\\\\\\-Aa\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\Q${a}" "Aa-Aa\\-aa\\-aa\\\\\\-aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\L${a}" "Aa-Aa\\-aa\\-aa\\\\\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\U${a}" "Aa-Aa\\-aa\\-aa\\\\\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\E${a}" "Aa-Aa\\-aa\\-aa\\\\\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\l${a}" "Aa-Aa\\-aa\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\u${a}" "Aa-Aa\\-aa\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\Q${a}" "Aa-Aa\\-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\L${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\U${a}" "Aa-Aa\\-aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\E${a}" "Aa-Aa\\-aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\l${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\u${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\Q${a}" "Aa-Aa\\-aa\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\L${a}" "Aa-Aa\\-aa\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\U${a}" "Aa-Aa\\-aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\E${a}" "Aa-Aa\\-aa\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\l${a}" "Aa-Aa\\-aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\u${a}" "Aa-Aa\\-aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\Q${a}" "Aa-Aa\\-aa\\-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\L${a}" "Aa-Aa\\-aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\U${a}" "Aa-Aa\\-aa\\-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\E${a}" "Aa-Aa\\-aa\\-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\l${a}" "Aa-Aa\\-aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\u${a}" "Aa-Aa\\-aa\\-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\Q${a}" "Aa-Aa\\-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\L${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\U${a}" "Aa-Aa\\-aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\E${a}" "Aa-Aa\\-aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\l${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\u${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\Q${a}" "Aa-Aa\\-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\L${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\U${a}" "Aa-Aa\\-aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\E${a}" "Aa-Aa\\-aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\l${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\u${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\Q${a}" "Aa-Aa\\-AA\\-AA\\\\\\-AA\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\L${a}" "Aa-Aa\\-AA\\-AA\\\\\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\U${a}" "Aa-Aa\\-AA\\-AA\\\\\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\E${a}" "Aa-Aa\\-AA\\-AA\\\\\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\l${a}" "Aa-Aa\\-AA\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\u${a}" "Aa-Aa\\-AA\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\Q${a}" "Aa-Aa\\-AA\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\L${a}" "Aa-Aa\\-AA\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\U${a}" "Aa-Aa\\-AA\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\E${a}" "Aa-Aa\\-AA\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\l${a}" "Aa-Aa\\-AA\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\u${a}" "Aa-Aa\\-AA\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\Q${a}" "Aa-Aa\\-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\L${a}" "Aa-Aa\\-AA\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\U${a}" "Aa-Aa\\-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\E${a}" "Aa-Aa\\-AA\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\l${a}" "Aa-Aa\\-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\u${a}" "Aa-Aa\\-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\Q${a}" "Aa-Aa\\-AA\\-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\L${a}" "Aa-Aa\\-AA\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\U${a}" "Aa-Aa\\-AA\\-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\E${a}" "Aa-Aa\\-AA\\-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\l${a}" "Aa-Aa\\-AA\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\u${a}" "Aa-Aa\\-AA\\-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\Q${a}" "Aa-Aa\\-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\L${a}" "Aa-Aa\\-AA\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\U${a}" "Aa-Aa\\-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\E${a}" "Aa-Aa\\-AA\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\l${a}" "Aa-Aa\\-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\u${a}" "Aa-Aa\\-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\Q${a}" "Aa-Aa\\-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\L${a}" "Aa-Aa\\-AA\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\U${a}" "Aa-Aa\\-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\E${a}" "Aa-Aa\\-AA\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\l${a}" "Aa-Aa\\-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\u${a}" "Aa-Aa\\-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\Q${a}" "Aa-Aa\\-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\L${a}" "Aa-Aa\\-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\U${a}" "Aa-Aa\\-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\E${a}" "Aa-Aa\\-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\l${a}" "Aa-Aa\\-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\u${a}" "Aa-Aa\\-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\Q${a}" "Aa-Aa\\-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\L${a}" "Aa-Aa\\-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\U${a}" "Aa-Aa\\-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\E${a}" "Aa-Aa\\-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\l${a}" "Aa-Aa\\-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\u${a}" "Aa-Aa\\-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\Q${a}" "Aa-Aa\\-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\L${a}" "Aa-Aa\\-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\U${a}" "Aa-Aa\\-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\E${a}" "Aa-Aa\\-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\l${a}" "Aa-Aa\\-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\u${a}" "Aa-Aa\\-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\Q${a}" "Aa-Aa\\-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\L${a}" "Aa-Aa\\-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\U${a}" "Aa-Aa\\-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\E${a}" "Aa-Aa\\-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\l${a}" "Aa-Aa\\-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\u${a}" "Aa-Aa\\-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\Q${a}" "Aa-Aa\\-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\L${a}" "Aa-Aa\\-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\U${a}" "Aa-Aa\\-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\E${a}" "Aa-Aa\\-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\l${a}" "Aa-Aa\\-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\u${a}" "Aa-Aa\\-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\Q${a}" "Aa-Aa\\-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\L${a}" "Aa-Aa\\-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\U${a}" "Aa-Aa\\-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\E${a}" "Aa-Aa\\-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\l${a}" "Aa-Aa\\-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\u${a}" "Aa-Aa\\-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\Q${a}" "Aa-Aa\\-aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\L${a}" "Aa-Aa\\-aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\U${a}" "Aa-Aa\\-aa\\-Aa\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\E${a}" "Aa-Aa\\-aa\\-Aa\\\\\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\l${a}" "Aa-Aa\\-aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\u${a}" "Aa-Aa\\-aa\\-Aa\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\Q${a}" "Aa-Aa\\-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\L${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\U${a}" "Aa-Aa\\-aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\E${a}" "Aa-Aa\\-aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\l${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\u${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\Q${a}" "Aa-Aa\\-aa\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\L${a}" "Aa-Aa\\-aa\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\U${a}" "Aa-Aa\\-aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\E${a}" "Aa-Aa\\-aa\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\l${a}" "Aa-Aa\\-aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\u${a}" "Aa-Aa\\-aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\Q${a}" "Aa-Aa\\-aa\\-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\L${a}" "Aa-Aa\\-aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\U${a}" "Aa-Aa\\-aa\\-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\E${a}" "Aa-Aa\\-aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\l${a}" "Aa-Aa\\-aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\u${a}" "Aa-Aa\\-aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\Q${a}" "Aa-Aa\\-aa\\-aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\L${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\U${a}" "Aa-Aa\\-aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\E${a}" "Aa-Aa\\-aa\\-aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\l${a}" "Aa-Aa\\-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\u${a}" "Aa-Aa\\-aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\Q${a}" "Aa-Aa\\-aa\\-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\L${a}" "Aa-Aa\\-aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\U${a}" "Aa-Aa\\-aa\\-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\E${a}" "Aa-Aa\\-aa\\-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\l${a}" "Aa-Aa\\-aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\u${a}" "Aa-Aa\\-aa\\-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\Q${a}" "Aa-Aa\\-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\L${a}" "Aa-Aa\\-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\U${a}" "Aa-Aa\\-Aa\\-Aa\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\E${a}" "Aa-Aa\\-Aa\\-Aa\\\\\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\l${a}" "Aa-Aa\\-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\u${a}" "Aa-Aa\\-Aa\\-Aa\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\Q${a}" "Aa-Aa\\-Aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\L${a}" "Aa-Aa\\-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\U${a}" "Aa-Aa\\-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\E${a}" "Aa-Aa\\-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\l${a}" "Aa-Aa\\-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\u${a}" "Aa-Aa\\-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\Q${a}" "Aa-Aa\\-Aa\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\L${a}" "Aa-Aa\\-Aa\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\U${a}" "Aa-Aa\\-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\E${a}" "Aa-Aa\\-Aa\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\l${a}" "Aa-Aa\\-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\u${a}" "Aa-Aa\\-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\Q${a}" "Aa-Aa\\-Aa\\-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\L${a}" "Aa-Aa\\-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\U${a}" "Aa-Aa\\-Aa\\-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\E${a}" "Aa-Aa\\-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\l${a}" "Aa-Aa\\-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\u${a}" "Aa-Aa\\-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\Q${a}" "Aa-Aa\\-Aa\\-aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\L${a}" "Aa-Aa\\-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\U${a}" "Aa-Aa\\-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\E${a}" "Aa-Aa\\-Aa\\-aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\l${a}" "Aa-Aa\\-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\u${a}" "Aa-Aa\\-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\Q${a}" "Aa-Aa\\-Aa\\-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\L${a}" "Aa-Aa\\-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\U${a}" "Aa-Aa\\-Aa\\-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\E${a}" "Aa-Aa\\-Aa\\-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\l${a}" "Aa-Aa\\-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\u${a}" "Aa-Aa\\-Aa\\-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\Q${a}" "Aa-aa-aa\\-aa\\\\\\-aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\L${a}" "Aa-aa-aa\\-aa\\\\\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\U${a}" "Aa-aa-aa\\-aa\\\\\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\E${a}" "Aa-aa-aa\\-aa\\\\\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\l${a}" "Aa-aa-aa\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\u${a}" "Aa-aa-aa\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\Q${a}" "Aa-aa-aa\\-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\L${a}" "Aa-aa-aa\\-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\U${a}" "Aa-aa-aa\\-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\E${a}" "Aa-aa-aa\\-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\l${a}" "Aa-aa-aa\\-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\u${a}" "Aa-aa-aa\\-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\Q${a}" "Aa-aa-aa\\-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\L${a}" "Aa-aa-aa\\-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\U${a}" "Aa-aa-aa\\-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\E${a}" "Aa-aa-aa\\-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\l${a}" "Aa-aa-aa\\-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\u${a}" "Aa-aa-aa\\-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\Q${a}" "Aa-aa-aa\\-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\L${a}" "Aa-aa-aa\\-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\U${a}" "Aa-aa-aa\\-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\E${a}" "Aa-aa-aa\\-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\l${a}" "Aa-aa-aa\\-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\u${a}" "Aa-aa-aa\\-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\Q${a}" "Aa-aa-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\L${a}" "Aa-aa-aa\\-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\U${a}" "Aa-aa-aa\\-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\E${a}" "Aa-aa-aa\\-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\l${a}" "Aa-aa-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\u${a}" "Aa-aa-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\Q${a}" "Aa-aa-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\L${a}" "Aa-aa-aa\\-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\U${a}" "Aa-aa-aa\\-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\E${a}" "Aa-aa-aa\\-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\l${a}" "Aa-aa-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\u${a}" "Aa-aa-aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\Q${a}" "Aa-aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\L${a}" "Aa-aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\U${a}" "Aa-aa-aa-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\E${a}" "Aa-aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\l${a}" "Aa-aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\u${a}" "Aa-aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\Q${a}" "Aa-aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\L${a}" "Aa-aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\U${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\E${a}" "Aa-aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\l${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\u${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\Q${a}" "Aa-aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\L${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\U${a}" "Aa-aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\E${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\l${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\u${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\Q${a}" "Aa-aa-AA-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\L${a}" "Aa-aa-AA-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\U${a}" "Aa-aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\E${a}" "Aa-aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\l${a}" "Aa-aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\u${a}" "Aa-aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\Q${a}" "Aa-aa-AA-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\L${a}" "Aa-aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\U${a}" "Aa-aa-AA-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\E${a}" "Aa-aa-AA-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\l${a}" "Aa-aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\u${a}" "Aa-aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\Q${a}" "Aa-aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\L${a}" "Aa-aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\U${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\E${a}" "Aa-aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\l${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\u${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\Q${a}" "Aa-aa-AA-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\L${a}" "Aa-aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\U${a}" "Aa-aa-AA-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\E${a}" "Aa-aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\l${a}" "Aa-aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\u${a}" "Aa-aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\Q${a}" "Aa-aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\L${a}" "Aa-aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\U${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\E${a}" "Aa-aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\l${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\u${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\Q${a}" "Aa-aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\L${a}" "Aa-aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\U${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\E${a}" "Aa-aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\l${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\u${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\Q${a}" "Aa-aa-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\L${a}" "Aa-aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\U${a}" "Aa-aa-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\E${a}" "Aa-aa-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\l${a}" "Aa-aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\u${a}" "Aa-aa-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\Q${a}" "Aa-aa-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\L${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\U${a}" "Aa-aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\E${a}" "Aa-aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\l${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\u${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\Q${a}" "Aa-aa-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\L${a}" "Aa-aa-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\U${a}" "Aa-aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\E${a}" "Aa-aa-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\l${a}" "Aa-aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\u${a}" "Aa-aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\Q${a}" "Aa-aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\L${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\U${a}" "Aa-aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\E${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\l${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\u${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\Q${a}" "Aa-aa-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\L${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\U${a}" "Aa-aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\E${a}" "Aa-aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\l${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\u${a}" "Aa-aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\Q${a}" "Aa-aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\L${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\U${a}" "Aa-aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\E${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\l${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\u${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\Q${a}" "Aa-aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\L${a}" "Aa-aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\U${a}" "Aa-aa-aa-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\E${a}" "Aa-aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\l${a}" "Aa-aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\u${a}" "Aa-aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\Q${a}" "Aa-aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\L${a}" "Aa-aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\U${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\E${a}" "Aa-aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\l${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\u${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\Q${a}" "Aa-aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\L${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\U${a}" "Aa-aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\E${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\l${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\u${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\Q${a}" "Aa-aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\L${a}" "Aa-aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\U${a}" "Aa-aa-aa-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\E${a}" "Aa-aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\l${a}" "Aa-aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\u${a}" "Aa-aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\Q${a}" "Aa-aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\L${a}" "Aa-aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\U${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\E${a}" "Aa-aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\l${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\u${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\Q${a}" "Aa-aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\L${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\U${a}" "Aa-aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\E${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\l${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\u${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\Q${a}" "Aa-AA-AA\\-AA\\\\\\-AA\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\L${a}" "Aa-AA-AA\\-AA\\\\\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\U${a}" "Aa-AA-AA\\-AA\\\\\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\E${a}" "Aa-AA-AA\\-AA\\\\\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\l${a}" "Aa-AA-AA\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\u${a}" "Aa-AA-AA\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\Q${a}" "Aa-AA-AA\\-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\L${a}" "Aa-AA-AA\\-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\U${a}" "Aa-AA-AA\\-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\E${a}" "Aa-AA-AA\\-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\l${a}" "Aa-AA-AA\\-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\u${a}" "Aa-AA-AA\\-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\Q${a}" "Aa-AA-AA\\-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\L${a}" "Aa-AA-AA\\-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\U${a}" "Aa-AA-AA\\-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\E${a}" "Aa-AA-AA\\-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\l${a}" "Aa-AA-AA\\-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\u${a}" "Aa-AA-AA\\-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\Q${a}" "Aa-AA-AA\\-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\L${a}" "Aa-AA-AA\\-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\U${a}" "Aa-AA-AA\\-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\E${a}" "Aa-AA-AA\\-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\l${a}" "Aa-AA-AA\\-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\u${a}" "Aa-AA-AA\\-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\Q${a}" "Aa-AA-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\L${a}" "Aa-AA-AA\\-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\U${a}" "Aa-AA-AA\\-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\E${a}" "Aa-AA-AA\\-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\l${a}" "Aa-AA-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\u${a}" "Aa-AA-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\Q${a}" "Aa-AA-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\L${a}" "Aa-AA-AA\\-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\U${a}" "Aa-AA-AA\\-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\E${a}" "Aa-AA-AA\\-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\l${a}" "Aa-AA-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\u${a}" "Aa-AA-AA\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\Q${a}" "Aa-AA-aa-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\L${a}" "Aa-AA-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\U${a}" "Aa-AA-aa-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\E${a}" "Aa-AA-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\l${a}" "Aa-AA-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\u${a}" "Aa-AA-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\Q${a}" "Aa-AA-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\L${a}" "Aa-AA-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\U${a}" "Aa-AA-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\E${a}" "Aa-AA-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\l${a}" "Aa-AA-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\u${a}" "Aa-AA-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\Q${a}" "Aa-AA-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\L${a}" "Aa-AA-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\U${a}" "Aa-AA-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\E${a}" "Aa-AA-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\l${a}" "Aa-AA-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\u${a}" "Aa-AA-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\Q${a}" "Aa-AA-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\L${a}" "Aa-AA-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\U${a}" "Aa-AA-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\E${a}" "Aa-AA-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\l${a}" "Aa-AA-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\u${a}" "Aa-AA-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\Q${a}" "Aa-AA-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\L${a}" "Aa-AA-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\U${a}" "Aa-AA-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\E${a}" "Aa-AA-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\l${a}" "Aa-AA-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\u${a}" "Aa-AA-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\Q${a}" "Aa-AA-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\L${a}" "Aa-AA-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\U${a}" "Aa-AA-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\E${a}" "Aa-AA-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\l${a}" "Aa-AA-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\u${a}" "Aa-AA-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\Q${a}" "Aa-AA-AA-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\L${a}" "Aa-AA-AA-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\U${a}" "Aa-AA-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\E${a}" "Aa-AA-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\l${a}" "Aa-AA-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\u${a}" "Aa-AA-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\Q${a}" "Aa-AA-AA-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\L${a}" "Aa-AA-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\U${a}" "Aa-AA-AA-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\E${a}" "Aa-AA-AA-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\l${a}" "Aa-AA-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\u${a}" "Aa-AA-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\Q${a}" "Aa-AA-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\L${a}" "Aa-AA-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\U${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\E${a}" "Aa-AA-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\l${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\u${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\Q${a}" "Aa-AA-AA-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\L${a}" "Aa-AA-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\U${a}" "Aa-AA-AA-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\E${a}" "Aa-AA-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\l${a}" "Aa-AA-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\u${a}" "Aa-AA-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\Q${a}" "Aa-AA-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\L${a}" "Aa-AA-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\U${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\E${a}" "Aa-AA-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\l${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\u${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\Q${a}" "Aa-AA-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\L${a}" "Aa-AA-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\U${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\E${a}" "Aa-AA-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\l${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\u${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\Q${a}" "Aa-AA-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\L${a}" "Aa-AA-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\U${a}" "Aa-AA-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\E${a}" "Aa-AA-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\l${a}" "Aa-AA-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\u${a}" "Aa-AA-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\Q${a}" "Aa-AA-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\L${a}" "Aa-AA-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\U${a}" "Aa-AA-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\E${a}" "Aa-AA-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\l${a}" "Aa-AA-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\u${a}" "Aa-AA-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\Q${a}" "Aa-AA-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\L${a}" "Aa-AA-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\U${a}" "Aa-AA-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\E${a}" "Aa-AA-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\l${a}" "Aa-AA-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\u${a}" "Aa-AA-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\Q${a}" "Aa-AA-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\L${a}" "Aa-AA-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\U${a}" "Aa-AA-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\E${a}" "Aa-AA-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\l${a}" "Aa-AA-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\u${a}" "Aa-AA-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\Q${a}" "Aa-AA-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\L${a}" "Aa-AA-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\U${a}" "Aa-AA-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\E${a}" "Aa-AA-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\l${a}" "Aa-AA-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\u${a}" "Aa-AA-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\Q${a}" "Aa-AA-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\L${a}" "Aa-AA-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\U${a}" "Aa-AA-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\E${a}" "Aa-AA-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\l${a}" "Aa-AA-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\u${a}" "Aa-AA-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\Q${a}" "Aa-AA-AA-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\L${a}" "Aa-AA-AA-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\U${a}" "Aa-AA-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\E${a}" "Aa-AA-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\l${a}" "Aa-AA-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\u${a}" "Aa-AA-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\Q${a}" "Aa-AA-AA-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\L${a}" "Aa-AA-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\U${a}" "Aa-AA-AA-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\E${a}" "Aa-AA-AA-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\l${a}" "Aa-AA-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\u${a}" "Aa-AA-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\Q${a}" "Aa-AA-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\L${a}" "Aa-AA-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\U${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\E${a}" "Aa-AA-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\l${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\u${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\Q${a}" "Aa-AA-AA-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\L${a}" "Aa-AA-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\U${a}" "Aa-AA-AA-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\E${a}" "Aa-AA-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\l${a}" "Aa-AA-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\u${a}" "Aa-AA-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\Q${a}" "Aa-AA-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\L${a}" "Aa-AA-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\U${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\E${a}" "Aa-AA-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\l${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\u${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\Q${a}" "Aa-AA-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\L${a}" "Aa-AA-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\U${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\E${a}" "Aa-AA-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\l${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\u${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\Q${a}" "Aa-AA-AA-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\L${a}" "Aa-AA-AA-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\U${a}" "Aa-AA-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\E${a}" "Aa-AA-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\l${a}" "Aa-AA-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\u${a}" "Aa-AA-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\Q${a}" "Aa-AA-AA-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\L${a}" "Aa-AA-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\U${a}" "Aa-AA-AA-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\E${a}" "Aa-AA-AA-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\l${a}" "Aa-AA-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\u${a}" "Aa-AA-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\Q${a}" "Aa-AA-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\L${a}" "Aa-AA-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\U${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\E${a}" "Aa-AA-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\l${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\u${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\Q${a}" "Aa-AA-AA-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\L${a}" "Aa-AA-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\U${a}" "Aa-AA-AA-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\E${a}" "Aa-AA-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\l${a}" "Aa-AA-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\u${a}" "Aa-AA-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\Q${a}" "Aa-AA-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\L${a}" "Aa-AA-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\U${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\E${a}" "Aa-AA-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\l${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\u${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\Q${a}" "Aa-AA-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\L${a}" "Aa-AA-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\U${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\E${a}" "Aa-AA-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\l${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\u${a}" "Aa-AA-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\Q${a}" "Aa-Aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\L${a}" "Aa-Aa-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\U${a}" "Aa-Aa-Aa\\-Aa\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\E${a}" "Aa-Aa-Aa\\-Aa\\\\\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\l${a}" "Aa-Aa-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\u${a}" "Aa-Aa-Aa\\-Aa\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\Q${a}" "Aa-Aa-Aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\L${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\U${a}" "Aa-Aa-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\E${a}" "Aa-Aa-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\l${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\u${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\Q${a}" "Aa-Aa-Aa\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\L${a}" "Aa-Aa-Aa\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\U${a}" "Aa-Aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\E${a}" "Aa-Aa-Aa\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\l${a}" "Aa-Aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\u${a}" "Aa-Aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\Q${a}" "Aa-Aa-Aa\\-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\L${a}" "Aa-Aa-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\U${a}" "Aa-Aa-Aa\\-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\E${a}" "Aa-Aa-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\l${a}" "Aa-Aa-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\u${a}" "Aa-Aa-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\Q${a}" "Aa-Aa-Aa\\-aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\L${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\U${a}" "Aa-Aa-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\E${a}" "Aa-Aa-Aa\\-aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\l${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\u${a}" "Aa-Aa-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\Q${a}" "Aa-Aa-Aa\\-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\L${a}" "Aa-Aa-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\U${a}" "Aa-Aa-Aa\\-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\E${a}" "Aa-Aa-Aa\\-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\l${a}" "Aa-Aa-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\u${a}" "Aa-Aa-Aa\\-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\Q${a}" "Aa-Aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\L${a}" "Aa-Aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\U${a}" "Aa-Aa-aa-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\E${a}" "Aa-Aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\l${a}" "Aa-Aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\u${a}" "Aa-Aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\Q${a}" "Aa-Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\u${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\Q${a}" "Aa-Aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\L${a}" "Aa-Aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\U${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\E${a}" "Aa-Aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\l${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\u${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\Q${a}" "Aa-Aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\L${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\U${a}" "Aa-Aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\E${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\l${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\u${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\Q${a}" "Aa-Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\u${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\Q${a}" "Aa-Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\u${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\Q${a}" "Aa-Aa-AA-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\L${a}" "Aa-Aa-AA-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\U${a}" "Aa-Aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\E${a}" "Aa-Aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\l${a}" "Aa-Aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\u${a}" "Aa-Aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\Q${a}" "Aa-Aa-AA-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\L${a}" "Aa-Aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\U${a}" "Aa-Aa-AA-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\E${a}" "Aa-Aa-AA-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\l${a}" "Aa-Aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\u${a}" "Aa-Aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\Q${a}" "Aa-Aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\L${a}" "Aa-Aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\U${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\E${a}" "Aa-Aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\l${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\u${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\Q${a}" "Aa-Aa-AA-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\L${a}" "Aa-Aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\U${a}" "Aa-Aa-AA-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\E${a}" "Aa-Aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\l${a}" "Aa-Aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\u${a}" "Aa-Aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\Q${a}" "Aa-Aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\L${a}" "Aa-Aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\U${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\E${a}" "Aa-Aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\l${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\u${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\Q${a}" "Aa-Aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\L${a}" "Aa-Aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\U${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\E${a}" "Aa-Aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\l${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\u${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\Q${a}" "Aa-Aa-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\L${a}" "Aa-Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\U${a}" "Aa-Aa-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\E${a}" "Aa-Aa-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\l${a}" "Aa-Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\u${a}" "Aa-Aa-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\Q${a}" "Aa-Aa-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\L${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\U${a}" "Aa-Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\E${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\l${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\u${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\Q${a}" "Aa-Aa-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\L${a}" "Aa-Aa-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\U${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\E${a}" "Aa-Aa-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\l${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\u${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\Q${a}" "Aa-Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\L${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\U${a}" "Aa-Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\E${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\l${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\u${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\Q${a}" "Aa-Aa-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\L${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\U${a}" "Aa-Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\E${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\l${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\u${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\Q${a}" "Aa-Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\L${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\U${a}" "Aa-Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\E${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\l${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\u${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\Q${a}" "Aa-Aa-aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\L${a}" "Aa-Aa-aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\U${a}" "Aa-Aa-aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\E${a}" "Aa-Aa-aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\l${a}" "Aa-Aa-aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\u${a}" "Aa-Aa-aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\Q${a}" "Aa-Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\u${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\Q${a}" "Aa-Aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\L${a}" "Aa-Aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\U${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\E${a}" "Aa-Aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\l${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\u${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\Q${a}" "Aa-Aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\L${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\U${a}" "Aa-Aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\E${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\l${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\u${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\Q${a}" "Aa-Aa-aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\u${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\Q${a}" "Aa-Aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\L${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\U${a}" "Aa-Aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\E${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\l${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\u${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\Q${a}" "Aa-Aa-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\L${a}" "Aa-Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\U${a}" "Aa-Aa-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\E${a}" "Aa-Aa-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\l${a}" "Aa-Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\u${a}" "Aa-Aa-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\Q${a}" "Aa-Aa-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\L${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\U${a}" "Aa-Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\E${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\l${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\u${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\Q${a}" "Aa-Aa-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\L${a}" "Aa-Aa-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\U${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\E${a}" "Aa-Aa-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\l${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\u${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\Q${a}" "Aa-Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\L${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\U${a}" "Aa-Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\E${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\l${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\u${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\Q${a}" "Aa-Aa-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\L${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\U${a}" "Aa-Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\E${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\l${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\u${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\Q${a}" "Aa-Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\L${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\U${a}" "Aa-Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\E${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\l${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\u${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\Q${a}" "Aa-aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\L${a}" "Aa-aa-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\U${a}" "Aa-aa-Aa\\-Aa\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\E${a}" "Aa-aa-Aa\\-Aa\\\\\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\l${a}" "Aa-aa-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\u${a}" "Aa-aa-Aa\\-Aa\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\Q${a}" "Aa-aa-Aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\L${a}" "Aa-aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\U${a}" "Aa-aa-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\E${a}" "Aa-aa-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\l${a}" "Aa-aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\u${a}" "Aa-aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\Q${a}" "Aa-aa-Aa\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\L${a}" "Aa-aa-Aa\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\U${a}" "Aa-aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\E${a}" "Aa-aa-Aa\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\l${a}" "Aa-aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\u${a}" "Aa-aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\Q${a}" "Aa-aa-Aa\\-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\L${a}" "Aa-aa-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\U${a}" "Aa-aa-Aa\\-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\E${a}" "Aa-aa-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\l${a}" "Aa-aa-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\u${a}" "Aa-aa-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\Q${a}" "Aa-aa-Aa\\-aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\L${a}" "Aa-aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\U${a}" "Aa-aa-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\E${a}" "Aa-aa-Aa\\-aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\l${a}" "Aa-aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\u${a}" "Aa-aa-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\Q${a}" "Aa-aa-Aa\\-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\L${a}" "Aa-aa-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\U${a}" "Aa-aa-Aa\\-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\E${a}" "Aa-aa-Aa\\-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\l${a}" "Aa-aa-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\u${a}" "Aa-aa-Aa\\-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\Q${a}" "Aa-aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\L${a}" "Aa-aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\U${a}" "Aa-aa-aa-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\E${a}" "Aa-aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\l${a}" "Aa-aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\u${a}" "Aa-aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\Q${a}" "Aa-aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\L${a}" "Aa-aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\U${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\E${a}" "Aa-aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\l${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\u${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\Q${a}" "Aa-aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\L${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\U${a}" "Aa-aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\E${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\l${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\u${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\Q${a}" "Aa-aa-AA-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\L${a}" "Aa-aa-AA-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\U${a}" "Aa-aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\E${a}" "Aa-aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\l${a}" "Aa-aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\u${a}" "Aa-aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\Q${a}" "Aa-aa-AA-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\L${a}" "Aa-aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\U${a}" "Aa-aa-AA-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\E${a}" "Aa-aa-AA-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\l${a}" "Aa-aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\u${a}" "Aa-aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\Q${a}" "Aa-aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\L${a}" "Aa-aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\U${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\E${a}" "Aa-aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\l${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\u${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\Q${a}" "Aa-aa-AA-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\L${a}" "Aa-aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\U${a}" "Aa-aa-AA-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\E${a}" "Aa-aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\l${a}" "Aa-aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\u${a}" "Aa-aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\Q${a}" "Aa-aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\L${a}" "Aa-aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\U${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\E${a}" "Aa-aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\l${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\u${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\Q${a}" "Aa-aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\L${a}" "Aa-aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\U${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\E${a}" "Aa-aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\l${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\u${a}" "Aa-aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\Q${a}" "Aa-aa-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\L${a}" "Aa-aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\U${a}" "Aa-aa-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\E${a}" "Aa-aa-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\l${a}" "Aa-aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\u${a}" "Aa-aa-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\Q${a}" "Aa-aa-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\L${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\U${a}" "Aa-aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\E${a}" "Aa-aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\l${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\u${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\Q${a}" "Aa-aa-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\L${a}" "Aa-aa-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\U${a}" "Aa-aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\E${a}" "Aa-aa-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\l${a}" "Aa-aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\u${a}" "Aa-aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\Q${a}" "Aa-aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\L${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\U${a}" "Aa-aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\E${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\l${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\u${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\Q${a}" "Aa-aa-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\L${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\U${a}" "Aa-aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\E${a}" "Aa-aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\l${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\u${a}" "Aa-aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\Q${a}" "Aa-aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\L${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\U${a}" "Aa-aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\E${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\l${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\u${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\Q${a}" "Aa-aa-aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\L${a}" "Aa-aa-aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\U${a}" "Aa-aa-aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\E${a}" "Aa-aa-aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\l${a}" "Aa-aa-aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\u${a}" "Aa-aa-aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\Q${a}" "Aa-aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\u${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\Q${a}" "Aa-aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\L${a}" "Aa-aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\U${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\E${a}" "Aa-aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\l${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\u${a}" "Aa-aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\Q${a}" "Aa-aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\L${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\U${a}" "Aa-aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\E${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\l${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\u${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\Q${a}" "Aa-aa-aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\L${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\U${a}" "Aa-aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\E${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\l${a}" "Aa-aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\u${a}" "Aa-aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\Q${a}" "Aa-aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\L${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\U${a}" "Aa-aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\E${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\l${a}" "Aa-aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\u${a}" "Aa-aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\Q${a}" "Aa-aa-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\L${a}" "Aa-aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\U${a}" "Aa-aa-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\E${a}" "Aa-aa-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\l${a}" "Aa-aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\u${a}" "Aa-aa-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\Q${a}" "Aa-aa-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\L${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\U${a}" "Aa-aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\E${a}" "Aa-aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\l${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\u${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\Q${a}" "Aa-aa-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\L${a}" "Aa-aa-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\U${a}" "Aa-aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\E${a}" "Aa-aa-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\l${a}" "Aa-aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\u${a}" "Aa-aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\Q${a}" "Aa-aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\L${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\U${a}" "Aa-aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\E${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\l${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\u${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\Q${a}" "Aa-aa-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\L${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\U${a}" "Aa-aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\E${a}" "Aa-aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\l${a}" "Aa-aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\u${a}" "Aa-aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\Q${a}" "Aa-aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\L${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\U${a}" "Aa-aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\E${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\l${a}" "Aa-aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\u${a}" "Aa-aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\Q${a}" "Aa-Aa-Aa\\-Aa\\\\\\-Aa\\\\\\\\\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\L${a}" "Aa-Aa-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\U${a}" "Aa-Aa-Aa\\-Aa\\\\\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\E${a}" "Aa-Aa-Aa\\-Aa\\\\\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\l${a}" "Aa-Aa-Aa\\-Aa\\\\\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\u${a}" "Aa-Aa-Aa\\-Aa\\\\\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\Q${a}" "Aa-Aa-Aa\\-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\L${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\U${a}" "Aa-Aa-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\E${a}" "Aa-Aa-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\l${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\u${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\Q${a}" "Aa-Aa-Aa\\-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\L${a}" "Aa-Aa-Aa\\-AA\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\U${a}" "Aa-Aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\E${a}" "Aa-Aa-Aa\\-AA\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\l${a}" "Aa-Aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\u${a}" "Aa-Aa-Aa\\-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\Q${a}" "Aa-Aa-Aa\\-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\L${a}" "Aa-Aa-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\U${a}" "Aa-Aa-Aa\\-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\E${a}" "Aa-Aa-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\l${a}" "Aa-Aa-Aa\\-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\u${a}" "Aa-Aa-Aa\\-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\Q${a}" "Aa-Aa-Aa\\-aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\L${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\U${a}" "Aa-Aa-Aa\\-aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\E${a}" "Aa-Aa-Aa\\-aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\l${a}" "Aa-Aa-Aa\\-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\u${a}" "Aa-Aa-Aa\\-aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\Q${a}" "Aa-Aa-Aa\\-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\L${a}" "Aa-Aa-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\U${a}" "Aa-Aa-Aa\\-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\E${a}" "Aa-Aa-Aa\\-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\l${a}" "Aa-Aa-Aa\\-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\u${a}" "Aa-Aa-Aa\\-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\Q${a}" "Aa-Aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\L${a}" "Aa-Aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\U${a}" "Aa-Aa-aa-aa\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\E${a}" "Aa-Aa-aa-aa\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\l${a}" "Aa-Aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\u${a}" "Aa-Aa-aa-aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\Q${a}" "Aa-Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\u${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\Q${a}" "Aa-Aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\L${a}" "Aa-Aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\U${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\E${a}" "Aa-Aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\l${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\u${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\Q${a}" "Aa-Aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\L${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\U${a}" "Aa-Aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\E${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\l${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\u${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\Q${a}" "Aa-Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\u${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\Q${a}" "Aa-Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\u${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\Q${a}" "Aa-Aa-AA-AA\\-AA\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\L${a}" "Aa-Aa-AA-AA\\-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\U${a}" "Aa-Aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\E${a}" "Aa-Aa-AA-AA\\-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\l${a}" "Aa-Aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\u${a}" "Aa-Aa-AA-AA\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\Q${a}" "Aa-Aa-AA-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\L${a}" "Aa-Aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\U${a}" "Aa-Aa-AA-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\E${a}" "Aa-Aa-AA-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\l${a}" "Aa-Aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\u${a}" "Aa-Aa-AA-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\Q${a}" "Aa-Aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\L${a}" "Aa-Aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\U${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\E${a}" "Aa-Aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\l${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\u${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\Q${a}" "Aa-Aa-AA-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\L${a}" "Aa-Aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\U${a}" "Aa-Aa-AA-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\E${a}" "Aa-Aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\l${a}" "Aa-Aa-AA-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\u${a}" "Aa-Aa-AA-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\Q${a}" "Aa-Aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\L${a}" "Aa-Aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\U${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\E${a}" "Aa-Aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\l${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\u${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\Q${a}" "Aa-Aa-AA-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\L${a}" "Aa-Aa-AA-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\U${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\E${a}" "Aa-Aa-AA-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\l${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\u${a}" "Aa-Aa-AA-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\Q${a}" "Aa-Aa-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\L${a}" "Aa-Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\U${a}" "Aa-Aa-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\E${a}" "Aa-Aa-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\l${a}" "Aa-Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\u${a}" "Aa-Aa-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\Q${a}" "Aa-Aa-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\L${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\U${a}" "Aa-Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\E${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\l${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\u${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\Q${a}" "Aa-Aa-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\L${a}" "Aa-Aa-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\U${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\E${a}" "Aa-Aa-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\l${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\u${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\Q${a}" "Aa-Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\L${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\U${a}" "Aa-Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\E${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\l${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\u${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\Q${a}" "Aa-Aa-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\L${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\U${a}" "Aa-Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\E${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\l${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\u${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\Q${a}" "Aa-Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\L${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\U${a}" "Aa-Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\E${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\l${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\u${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\Q${a}" "Aa-Aa-aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\L${a}" "Aa-Aa-aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\U${a}" "Aa-Aa-aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\E${a}" "Aa-Aa-aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\l${a}" "Aa-Aa-aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\u${a}" "Aa-Aa-aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\Q${a}" "Aa-Aa-aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\u${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\Q${a}" "Aa-Aa-aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\L${a}" "Aa-Aa-aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\U${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\E${a}" "Aa-Aa-aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\l${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\u${a}" "Aa-Aa-aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\Q${a}" "Aa-Aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\L${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\U${a}" "Aa-Aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\E${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\l${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\u${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\Q${a}" "Aa-Aa-aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\L${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\U${a}" "Aa-Aa-aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\E${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\l${a}" "Aa-Aa-aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\u${a}" "Aa-Aa-aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\Q${a}" "Aa-Aa-aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\L${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\U${a}" "Aa-Aa-aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\E${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\l${a}" "Aa-Aa-aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\u${a}" "Aa-Aa-aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\Q${a}" "Aa-Aa-Aa-Aa\\-Aa\\\\\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\L${a}" "Aa-Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\U${a}" "Aa-Aa-Aa-Aa\\-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\E${a}" "Aa-Aa-Aa-Aa\\-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\l${a}" "Aa-Aa-Aa-Aa\\-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\u${a}" "Aa-Aa-Aa-Aa\\-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\Q${a}" "Aa-Aa-Aa-aa-aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\L${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\U${a}" "Aa-Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\E${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\l${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\u${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\Q${a}" "Aa-Aa-Aa-AA-AA\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\L${a}" "Aa-Aa-Aa-AA-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\U${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\E${a}" "Aa-Aa-Aa-AA-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\l${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\u${a}" "Aa-Aa-Aa-AA-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\Q${a}" "Aa-Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\L${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\U${a}" "Aa-Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\E${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\l${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\u${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\Q${a}" "Aa-Aa-Aa-aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\L${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\U${a}" "Aa-Aa-Aa-aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\E${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\l${a}" "Aa-Aa-Aa-aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\u${a}" "Aa-Aa-Aa-aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\Q${a}" "Aa-Aa-Aa-Aa-Aa\\-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\L${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\U${a}" "Aa-Aa-Aa-Aa-AA-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\E${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\l${a}" "Aa-Aa-Aa-Aa-aa-"))
+(let ((a "Aa-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\u${a}" "Aa-Aa-Aa-Aa-Aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}" "aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}" "aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}" "aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}" "aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}" "aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}" "aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}" "aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}" "aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}" "aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}" "aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}" "aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}" "aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}" "aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}" "aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}" "aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}" "aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}" "aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}" "aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}" "aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}" "aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}" "aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}" "aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}" "aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}" "aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}" "aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}" "aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}" "aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}" "aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}" "aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}" "aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}" "aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}" "aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}" "aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}" "aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}" "aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}" "aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}" "aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}" "aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}" "aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}" "aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}" "aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}" "aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}" "aA-aA\\-aA\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}" "aA-aA\\-aA\\\\\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}" "aA-aA\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}" "aA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}" "aA-aA\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}" "aA-aA\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}" "aA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}" "aA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}" "aA-aA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}" "aA-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}" "aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}" "aA-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}" "aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}" "aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}" "aA-aA\\-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}" "aA-aA\\-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}" "aA-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}" "aA-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}" "aA-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}" "aA-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}" "aA-aA\\-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}" "aA-aA\\-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}" "aA-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}" "aA-aA\\-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}" "aA-aA\\-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}" "aA-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}" "aA-aA\\-AA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}" "aA-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}" "aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}" "aA-aA\\-AA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}" "aA-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}" "aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}" "aA-aa-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}" "aA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}" "aA-aa-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}" "aA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}" "aA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}" "aA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}" "aA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\L${a}" "aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\U${a}" "aA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\E${a}" "aA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\l${a}" "aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\u${a}" "aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}" "aA-aa-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\L${a}" "aA-aa-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\U${a}" "aA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\E${a}" "aA-aa-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\l${a}" "aA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\u${a}" "aA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}" "aA-aa-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\L${a}" "aA-aa-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\U${a}" "aA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\E${a}" "aA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\l${a}" "aA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\u${a}" "aA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}" "aA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\L${a}" "aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\U${a}" "aA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\E${a}" "aA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\l${a}" "aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\u${a}" "aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}" "aA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\L${a}" "aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\U${a}" "aA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\E${a}" "aA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\l${a}" "aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\u${a}" "aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}" "aA-AA-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}" "aA-AA-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}" "aA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}" "aA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}" "aA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}" "aA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}" "aA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\L${a}" "aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\U${a}" "aA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\E${a}" "aA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\l${a}" "aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\u${a}" "aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}" "aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\L${a}" "aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\U${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\E${a}" "aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\l${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\u${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}" "aA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\L${a}" "aA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\U${a}" "aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\E${a}" "aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\l${a}" "aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\u${a}" "aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}" "aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\L${a}" "aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\U${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\E${a}" "aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\l${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\u${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}" "aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\L${a}" "aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\U${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\E${a}" "aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\l${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\u${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}" "aA-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}" "aA-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}" "aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}" "aA-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}" "aA-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}" "aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}" "aA-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\L${a}" "aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\U${a}" "aA-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\E${a}" "aA-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\l${a}" "aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\u${a}" "aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}" "aA-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\L${a}" "aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\U${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\E${a}" "aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\l${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\u${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}" "aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\L${a}" "aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\U${a}" "aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\E${a}" "aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\l${a}" "aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\u${a}" "aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}" "aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\L${a}" "aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\U${a}" "aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\E${a}" "aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\l${a}" "aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\u${a}" "aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}" "aA-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\L${a}" "aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\U${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\E${a}" "aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\l${a}" "aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\u${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}" "aA-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}" "aA-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}" "aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}" "aA-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}" "aA-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}" "aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}" "aA-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\L${a}" "aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\U${a}" "aA-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\E${a}" "aA-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\l${a}" "aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\u${a}" "aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}" "aA-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\L${a}" "aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\U${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\E${a}" "aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\l${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\u${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}" "aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\L${a}" "aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\U${a}" "aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\E${a}" "aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\l${a}" "aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\u${a}" "aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}" "aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\L${a}" "aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\U${a}" "aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\E${a}" "aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\l${a}" "aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\u${a}" "aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}" "aA-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\L${a}" "aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\U${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\E${a}" "aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\l${a}" "aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\u${a}" "aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}" "aA-AA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}" "aA-AA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}" "aA-AA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}" "aA-AA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}" "aA-AA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}" "aA-AA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}" "aA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\L${a}" "aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\U${a}" "aA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\E${a}" "aA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\l${a}" "aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\u${a}" "aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}" "aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\L${a}" "aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\U${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\E${a}" "aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\l${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\u${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}" "aA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\L${a}" "aA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\U${a}" "aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\E${a}" "aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\l${a}" "aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\u${a}" "aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}" "aA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\L${a}" "aA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\U${a}" "aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\E${a}" "aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\l${a}" "aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\u${a}" "aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}" "aA-AA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\L${a}" "aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\U${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\E${a}" "aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\l${a}" "aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\u${a}" "aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\Q${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-aA\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\L${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-aa\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\U${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-AA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\E${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\l${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-aA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\Q${a}\u${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-AA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\Q${a}" "aA-aA\\-aA\\\\\\-aa\\\\\\-aa\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\L${a}" "aA-aA\\-aA\\\\\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\U${a}" "aA-aA\\-aA\\\\\\-aa\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\E${a}" "aA-aA\\-aA\\\\\\-aa\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\l${a}" "aA-aA\\-aA\\\\\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\L${a}\u${a}" "aA-aA\\-aA\\\\\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\Q${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-AA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\L${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\U${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\E${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\l${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\U${a}\u${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\Q${a}" "aA-aA\\-aA\\\\\\-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\L${a}" "aA-aA\\-aA\\\\\\-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\U${a}" "aA-aA\\-aA\\\\\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\E${a}" "aA-aA\\-aA\\\\\\-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\l${a}" "aA-aA\\-aA\\\\\\-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\E${a}\u${a}" "aA-aA\\-aA\\\\\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\Q${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\-aA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\L${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\U${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\E${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\l${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\l${a}\u${a}" "aA-aA\\-aA\\\\\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\Q${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-aA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\L${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\U${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\E${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\l${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\Q${a}\u${a}\u${a}" "aA-aA\\-aA\\\\\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\Q${a}" "aA-aA\\-aa\\-aa\\\\\\-aa\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\L${a}" "aA-aA\\-aa\\-aa\\\\\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\U${a}" "aA-aA\\-aa\\-aa\\\\\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\E${a}" "aA-aA\\-aa\\-aa\\\\\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\l${a}" "aA-aA\\-aa\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\Q${a}\u${a}" "aA-aA\\-aa\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\Q${a}" "aA-aA\\-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\L${a}" "aA-aA\\-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\U${a}" "aA-aA\\-aa\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\E${a}" "aA-aA\\-aa\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\l${a}" "aA-aA\\-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\L${a}\u${a}" "aA-aA\\-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\Q${a}" "aA-aA\\-aa\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\L${a}" "aA-aA\\-aa\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\U${a}" "aA-aA\\-aa\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\E${a}" "aA-aA\\-aa\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\l${a}" "aA-aA\\-aa\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\U${a}\u${a}" "aA-aA\\-aa\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\Q${a}" "aA-aA\\-aa\\-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\L${a}" "aA-aA\\-aa\\-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\U${a}" "aA-aA\\-aa\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\E${a}" "aA-aA\\-aa\\-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\l${a}" "aA-aA\\-aa\\-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\E${a}\u${a}" "aA-aA\\-aa\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\Q${a}" "aA-aA\\-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\L${a}" "aA-aA\\-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\U${a}" "aA-aA\\-aa\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\E${a}" "aA-aA\\-aa\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\l${a}" "aA-aA\\-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\l${a}\u${a}" "aA-aA\\-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\Q${a}" "aA-aA\\-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\L${a}" "aA-aA\\-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\U${a}" "aA-aA\\-aa\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\E${a}" "aA-aA\\-aa\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\l${a}" "aA-aA\\-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\L${a}\u${a}\u${a}" "aA-aA\\-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\Q${a}" "aA-aA\\-AA\\-AA\\\\\\-AA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\L${a}" "aA-aA\\-AA\\-AA\\\\\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\U${a}" "aA-aA\\-AA\\-AA\\\\\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\E${a}" "aA-aA\\-AA\\-AA\\\\\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\l${a}" "aA-aA\\-AA\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\Q${a}\u${a}" "aA-aA\\-AA\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\Q${a}" "aA-aA\\-AA\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\L${a}" "aA-aA\\-AA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\U${a}" "aA-aA\\-AA\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\E${a}" "aA-aA\\-AA\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\l${a}" "aA-aA\\-AA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\L${a}\u${a}" "aA-aA\\-AA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\Q${a}" "aA-aA\\-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\L${a}" "aA-aA\\-AA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\U${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\E${a}" "aA-aA\\-AA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\l${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\U${a}\u${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\Q${a}" "aA-aA\\-AA\\-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\L${a}" "aA-aA\\-AA\\-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\U${a}" "aA-aA\\-AA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\E${a}" "aA-aA\\-AA\\-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\l${a}" "aA-aA\\-AA\\-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\E${a}\u${a}" "aA-aA\\-AA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\Q${a}" "aA-aA\\-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\L${a}" "aA-aA\\-AA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\U${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\E${a}" "aA-aA\\-AA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\l${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\l${a}\u${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\Q${a}" "aA-aA\\-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\L${a}" "aA-aA\\-AA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\U${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\E${a}" "aA-aA\\-AA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\l${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\U${a}\u${a}\u${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\Q${a}" "aA-aA\\-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\L${a}" "aA-aA\\-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\U${a}" "aA-aA\\-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\E${a}" "aA-aA\\-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\l${a}" "aA-aA\\-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\Q${a}\u${a}" "aA-aA\\-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\Q${a}" "aA-aA\\-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\L${a}" "aA-aA\\-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\U${a}" "aA-aA\\-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\E${a}" "aA-aA\\-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\l${a}" "aA-aA\\-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\L${a}\u${a}" "aA-aA\\-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\Q${a}" "aA-aA\\-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\L${a}" "aA-aA\\-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\U${a}" "aA-aA\\-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\E${a}" "aA-aA\\-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\l${a}" "aA-aA\\-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\U${a}\u${a}" "aA-aA\\-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\Q${a}" "aA-aA\\-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\L${a}" "aA-aA\\-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\U${a}" "aA-aA\\-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\E${a}" "aA-aA\\-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\l${a}" "aA-aA\\-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\E${a}\u${a}" "aA-aA\\-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\Q${a}" "aA-aA\\-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\L${a}" "aA-aA\\-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\U${a}" "aA-aA\\-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\E${a}" "aA-aA\\-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\l${a}" "aA-aA\\-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\l${a}\u${a}" "aA-aA\\-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\Q${a}" "aA-aA\\-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\L${a}" "aA-aA\\-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\U${a}" "aA-aA\\-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\E${a}" "aA-aA\\-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\l${a}" "aA-aA\\-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\E${a}\u${a}\u${a}" "aA-aA\\-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\Q${a}" "aA-aA\\-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\L${a}" "aA-aA\\-aA\\-aA\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\U${a}" "aA-aA\\-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\E${a}" "aA-aA\\-aA\\-aA\\\\\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\l${a}" "aA-aA\\-aA\\-aA\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\Q${a}\u${a}" "aA-aA\\-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\Q${a}" "aA-aA\\-aA\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\L${a}" "aA-aA\\-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\U${a}" "aA-aA\\-aA\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\E${a}" "aA-aA\\-aA\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\l${a}" "aA-aA\\-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\L${a}\u${a}" "aA-aA\\-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\Q${a}" "aA-aA\\-aA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\L${a}" "aA-aA\\-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\U${a}" "aA-aA\\-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\E${a}" "aA-aA\\-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\l${a}" "aA-aA\\-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\U${a}\u${a}" "aA-aA\\-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\Q${a}" "aA-aA\\-aA\\-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\L${a}" "aA-aA\\-aA\\-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\U${a}" "aA-aA\\-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\E${a}" "aA-aA\\-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\l${a}" "aA-aA\\-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\E${a}\u${a}" "aA-aA\\-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\Q${a}" "aA-aA\\-aA\\-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\L${a}" "aA-aA\\-aA\\-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\U${a}" "aA-aA\\-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\E${a}" "aA-aA\\-aA\\-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\l${a}" "aA-aA\\-aA\\-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\l${a}\u${a}" "aA-aA\\-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\Q${a}" "aA-aA\\-aA\\-AA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\L${a}" "aA-aA\\-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\U${a}" "aA-aA\\-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\E${a}" "aA-aA\\-aA\\-AA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\l${a}" "aA-aA\\-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\l${a}\u${a}\u${a}" "aA-aA\\-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\Q${a}" "aA-aA\\-AA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\L${a}" "aA-aA\\-AA\\-aA\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\U${a}" "aA-aA\\-AA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\E${a}" "aA-aA\\-AA\\-aA\\\\\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\l${a}" "aA-aA\\-AA\\-aA\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\Q${a}\u${a}" "aA-aA\\-AA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\Q${a}" "aA-aA\\-AA\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\L${a}" "aA-aA\\-AA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\U${a}" "aA-aA\\-AA\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\E${a}" "aA-aA\\-AA\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\l${a}" "aA-aA\\-AA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\L${a}\u${a}" "aA-aA\\-AA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\Q${a}" "aA-aA\\-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\L${a}" "aA-aA\\-AA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\U${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\E${a}" "aA-aA\\-AA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\l${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\U${a}\u${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\Q${a}" "aA-aA\\-AA\\-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\L${a}" "aA-aA\\-AA\\-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\U${a}" "aA-aA\\-AA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\E${a}" "aA-aA\\-AA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\l${a}" "aA-aA\\-AA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\E${a}\u${a}" "aA-aA\\-AA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\Q${a}" "aA-aA\\-AA\\-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\L${a}" "aA-aA\\-AA\\-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\U${a}" "aA-aA\\-AA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\E${a}" "aA-aA\\-AA\\-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\l${a}" "aA-aA\\-AA\\-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\l${a}\u${a}" "aA-aA\\-AA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\Q${a}" "aA-aA\\-AA\\-AA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\L${a}" "aA-aA\\-AA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\U${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\E${a}" "aA-aA\\-AA\\-AA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\l${a}" "aA-aA\\-AA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\Q${a}\u${a}\u${a}\u${a}" "aA-aA\\-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\Q${a}" "aA-aa-aa\\-aa\\\\\\-aa\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\L${a}" "aA-aa-aa\\-aa\\\\\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\U${a}" "aA-aa-aa\\-aa\\\\\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\E${a}" "aA-aa-aa\\-aa\\\\\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\l${a}" "aA-aa-aa\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\Q${a}\u${a}" "aA-aa-aa\\-aa\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\Q${a}" "aA-aa-aa\\-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\L${a}" "aA-aa-aa\\-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\U${a}" "aA-aa-aa\\-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\E${a}" "aA-aa-aa\\-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\l${a}" "aA-aa-aa\\-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\L${a}\u${a}" "aA-aa-aa\\-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\Q${a}" "aA-aa-aa\\-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\L${a}" "aA-aa-aa\\-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\U${a}" "aA-aa-aa\\-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\E${a}" "aA-aa-aa\\-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\l${a}" "aA-aa-aa\\-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\U${a}\u${a}" "aA-aa-aa\\-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\Q${a}" "aA-aa-aa\\-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\L${a}" "aA-aa-aa\\-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\U${a}" "aA-aa-aa\\-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\E${a}" "aA-aa-aa\\-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\l${a}" "aA-aa-aa\\-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\E${a}\u${a}" "aA-aa-aa\\-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\Q${a}" "aA-aa-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\L${a}" "aA-aa-aa\\-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\U${a}" "aA-aa-aa\\-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\E${a}" "aA-aa-aa\\-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\l${a}" "aA-aa-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\l${a}\u${a}" "aA-aa-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\Q${a}" "aA-aa-aa\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\L${a}" "aA-aa-aa\\-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\U${a}" "aA-aa-aa\\-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\E${a}" "aA-aa-aa\\-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\l${a}" "aA-aa-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\Q${a}\u${a}\u${a}" "aA-aa-aa\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\Q${a}" "aA-aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\L${a}" "aA-aa-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\U${a}" "aA-aa-aa-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\E${a}" "aA-aa-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\l${a}" "aA-aa-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\Q${a}\u${a}" "aA-aa-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\Q${a}" "aA-aa-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\L${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\U${a}" "aA-aa-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\E${a}" "aA-aa-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\l${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\L${a}\u${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\Q${a}" "aA-aa-aa-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\L${a}" "aA-aa-aa-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\U${a}" "aA-aa-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\E${a}" "aA-aa-aa-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\l${a}" "aA-aa-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\U${a}\u${a}" "aA-aa-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\Q${a}" "aA-aa-aa-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\L${a}" "aA-aa-aa-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\U${a}" "aA-aa-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\E${a}" "aA-aa-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\l${a}" "aA-aa-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\E${a}\u${a}" "aA-aa-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\Q${a}" "aA-aa-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\L${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\U${a}" "aA-aa-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\E${a}" "aA-aa-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\l${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\l${a}\u${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\Q${a}" "aA-aa-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\L${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\U${a}" "aA-aa-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\E${a}" "aA-aa-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\l${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\L${a}\u${a}\u${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\Q${a}" "aA-aa-AA-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\L${a}" "aA-aa-AA-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\U${a}" "aA-aa-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\E${a}" "aA-aa-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\l${a}" "aA-aa-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\Q${a}\u${a}" "aA-aa-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\Q${a}" "aA-aa-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\L${a}" "aA-aa-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\U${a}" "aA-aa-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\E${a}" "aA-aa-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\l${a}" "aA-aa-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\L${a}\u${a}" "aA-aa-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\Q${a}" "aA-aa-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\L${a}" "aA-aa-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\U${a}" "aA-aa-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\E${a}" "aA-aa-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\l${a}" "aA-aa-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\U${a}\u${a}" "aA-aa-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\Q${a}" "aA-aa-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\L${a}" "aA-aa-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\U${a}" "aA-aa-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\E${a}" "aA-aa-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\l${a}" "aA-aa-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\E${a}\u${a}" "aA-aa-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\Q${a}" "aA-aa-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\L${a}" "aA-aa-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\U${a}" "aA-aa-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\E${a}" "aA-aa-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\l${a}" "aA-aa-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\l${a}\u${a}" "aA-aa-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\Q${a}" "aA-aa-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\L${a}" "aA-aa-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\U${a}" "aA-aa-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\E${a}" "aA-aa-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\l${a}" "aA-aa-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\U${a}\u${a}\u${a}" "aA-aa-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\Q${a}" "aA-aa-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\L${a}" "aA-aa-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\U${a}" "aA-aa-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\E${a}" "aA-aa-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\l${a}" "aA-aa-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\Q${a}\u${a}" "aA-aa-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\Q${a}" "aA-aa-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\L${a}" "aA-aa-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\U${a}" "aA-aa-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\E${a}" "aA-aa-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\l${a}" "aA-aa-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\L${a}\u${a}" "aA-aa-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\Q${a}" "aA-aa-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\L${a}" "aA-aa-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\U${a}" "aA-aa-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\E${a}" "aA-aa-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\l${a}" "aA-aa-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\U${a}\u${a}" "aA-aa-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\Q${a}" "aA-aa-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\L${a}" "aA-aa-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\U${a}" "aA-aa-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\E${a}" "aA-aa-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\l${a}" "aA-aa-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\E${a}\u${a}" "aA-aa-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\Q${a}" "aA-aa-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\L${a}" "aA-aa-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\U${a}" "aA-aa-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\E${a}" "aA-aa-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\l${a}" "aA-aa-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\l${a}\u${a}" "aA-aa-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\Q${a}" "aA-aa-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\L${a}" "aA-aa-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\U${a}" "aA-aa-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\E${a}" "aA-aa-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\l${a}" "aA-aa-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\E${a}\u${a}\u${a}" "aA-aa-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\Q${a}" "aA-aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\L${a}" "aA-aa-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\U${a}" "aA-aa-aa-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\E${a}" "aA-aa-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\l${a}" "aA-aa-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\Q${a}\u${a}" "aA-aa-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\Q${a}" "aA-aa-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\L${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\U${a}" "aA-aa-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\E${a}" "aA-aa-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\l${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\L${a}\u${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\Q${a}" "aA-aa-aa-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\L${a}" "aA-aa-aa-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\U${a}" "aA-aa-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\E${a}" "aA-aa-aa-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\l${a}" "aA-aa-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\U${a}\u${a}" "aA-aa-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\Q${a}" "aA-aa-aa-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\L${a}" "aA-aa-aa-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\U${a}" "aA-aa-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\E${a}" "aA-aa-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\l${a}" "aA-aa-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\E${a}\u${a}" "aA-aa-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\Q${a}" "aA-aa-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\L${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\U${a}" "aA-aa-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\E${a}" "aA-aa-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\l${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\l${a}\u${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\Q${a}" "aA-aa-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\L${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\U${a}" "aA-aa-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\E${a}" "aA-aa-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\l${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\l${a}\u${a}\u${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\Q${a}" "aA-aa-aa-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\L${a}" "aA-aa-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\U${a}" "aA-aa-aa-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\E${a}" "aA-aa-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\l${a}" "aA-aa-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\Q${a}\u${a}" "aA-aa-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\Q${a}" "aA-aa-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\L${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\U${a}" "aA-aa-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\E${a}" "aA-aa-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\l${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\L${a}\u${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\Q${a}" "aA-aa-aa-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\L${a}" "aA-aa-aa-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\U${a}" "aA-aa-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\E${a}" "aA-aa-aa-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\l${a}" "aA-aa-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\U${a}\u${a}" "aA-aa-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\Q${a}" "aA-aa-aa-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\L${a}" "aA-aa-aa-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\U${a}" "aA-aa-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\E${a}" "aA-aa-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\l${a}" "aA-aa-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\E${a}\u${a}" "aA-aa-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\Q${a}" "aA-aa-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\L${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\U${a}" "aA-aa-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\E${a}" "aA-aa-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\l${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\l${a}\u${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\Q${a}" "aA-aa-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\L${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\U${a}" "aA-aa-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\E${a}" "aA-aa-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\l${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\L${a}\u${a}\u${a}\u${a}" "aA-aa-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\Q${a}" "aA-AA-AA\\-AA\\\\\\-AA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\L${a}" "aA-AA-AA\\-AA\\\\\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\U${a}" "aA-AA-AA\\-AA\\\\\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\E${a}" "aA-AA-AA\\-AA\\\\\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\l${a}" "aA-AA-AA\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\Q${a}\u${a}" "aA-AA-AA\\-AA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\Q${a}" "aA-AA-AA\\-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\L${a}" "aA-AA-AA\\-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\U${a}" "aA-AA-AA\\-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\E${a}" "aA-AA-AA\\-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\l${a}" "aA-AA-AA\\-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\L${a}\u${a}" "aA-AA-AA\\-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\Q${a}" "aA-AA-AA\\-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\L${a}" "aA-AA-AA\\-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\U${a}" "aA-AA-AA\\-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\E${a}" "aA-AA-AA\\-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\l${a}" "aA-AA-AA\\-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\U${a}\u${a}" "aA-AA-AA\\-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\Q${a}" "aA-AA-AA\\-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\L${a}" "aA-AA-AA\\-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\U${a}" "aA-AA-AA\\-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\E${a}" "aA-AA-AA\\-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\l${a}" "aA-AA-AA\\-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\E${a}\u${a}" "aA-AA-AA\\-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\Q${a}" "aA-AA-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\L${a}" "aA-AA-AA\\-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\U${a}" "aA-AA-AA\\-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\E${a}" "aA-AA-AA\\-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\l${a}" "aA-AA-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\l${a}\u${a}" "aA-AA-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\Q${a}" "aA-AA-AA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\L${a}" "aA-AA-AA\\-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\U${a}" "aA-AA-AA\\-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\E${a}" "aA-AA-AA\\-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\l${a}" "aA-AA-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\Q${a}\u${a}\u${a}" "aA-AA-AA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\Q${a}" "aA-AA-aa-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\L${a}" "aA-AA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\U${a}" "aA-AA-aa-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\E${a}" "aA-AA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\l${a}" "aA-AA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\Q${a}\u${a}" "aA-AA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\Q${a}" "aA-AA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\L${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\U${a}" "aA-AA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\E${a}" "aA-AA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\l${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\L${a}\u${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\Q${a}" "aA-AA-aa-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\L${a}" "aA-AA-aa-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\U${a}" "aA-AA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\E${a}" "aA-AA-aa-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\l${a}" "aA-AA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\U${a}\u${a}" "aA-AA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\Q${a}" "aA-AA-aa-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\L${a}" "aA-AA-aa-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\U${a}" "aA-AA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\E${a}" "aA-AA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\l${a}" "aA-AA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\E${a}\u${a}" "aA-AA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\Q${a}" "aA-AA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\L${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\U${a}" "aA-AA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\E${a}" "aA-AA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\l${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\l${a}\u${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\Q${a}" "aA-AA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\L${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\U${a}" "aA-AA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\E${a}" "aA-AA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\l${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\L${a}\u${a}\u${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\Q${a}" "aA-AA-AA-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\L${a}" "aA-AA-AA-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\U${a}" "aA-AA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\E${a}" "aA-AA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\l${a}" "aA-AA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\Q${a}\u${a}" "aA-AA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\Q${a}" "aA-AA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\L${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\U${a}" "aA-AA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\E${a}" "aA-AA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\l${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\L${a}\u${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\U${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\Q${a}" "aA-AA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\L${a}" "aA-AA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\U${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\E${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\l${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\E${a}\u${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\l${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\U${a}\u${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\Q${a}" "aA-AA-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\L${a}" "aA-AA-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\U${a}" "aA-AA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\E${a}" "aA-AA-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\l${a}" "aA-AA-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\Q${a}\u${a}" "aA-AA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\Q${a}" "aA-AA-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\L${a}" "aA-AA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\U${a}" "aA-AA-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\E${a}" "aA-AA-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\l${a}" "aA-AA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\L${a}\u${a}" "aA-AA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\Q${a}" "aA-AA-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\L${a}" "aA-AA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\U${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\E${a}" "aA-AA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\l${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\U${a}\u${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\Q${a}" "aA-AA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\L${a}" "aA-AA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\U${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\E${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\l${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\E${a}\u${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\Q${a}" "aA-AA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\L${a}" "aA-AA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\U${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\E${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\l${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\l${a}\u${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\Q${a}" "aA-AA-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\L${a}" "aA-AA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\U${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\E${a}" "aA-AA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\l${a}" "aA-AA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\E${a}\u${a}\u${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\Q${a}" "aA-AA-AA-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\L${a}" "aA-AA-AA-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\U${a}" "aA-AA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\E${a}" "aA-AA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\l${a}" "aA-AA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\Q${a}\u${a}" "aA-AA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\Q${a}" "aA-AA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\L${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\U${a}" "aA-AA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\E${a}" "aA-AA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\l${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\L${a}\u${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\U${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\Q${a}" "aA-AA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\L${a}" "aA-AA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\U${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\E${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\l${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\E${a}\u${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\l${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\l${a}\u${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\Q${a}" "aA-AA-AA-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\L${a}" "aA-AA-AA-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\U${a}" "aA-AA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\E${a}" "aA-AA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\l${a}" "aA-AA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\Q${a}\u${a}" "aA-AA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\Q${a}" "aA-AA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\L${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\U${a}" "aA-AA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\E${a}" "aA-AA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\l${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\L${a}\u${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\U${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\Q${a}" "aA-AA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\L${a}" "aA-AA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\U${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\E${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\l${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\E${a}\u${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\l${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\U${a}\u${a}\u${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\Q${a}" "aA-aA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\L${a}" "aA-aA-aA\\-aA\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\U${a}" "aA-aA-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\E${a}" "aA-aA-aA\\-aA\\\\\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\l${a}" "aA-aA-aA\\-aA\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\Q${a}\u${a}" "aA-aA-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\Q${a}" "aA-aA-aA\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\L${a}" "aA-aA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\U${a}" "aA-aA-aA\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\E${a}" "aA-aA-aA\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\l${a}" "aA-aA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\L${a}\u${a}" "aA-aA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\Q${a}" "aA-aA-aA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\L${a}" "aA-aA-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\U${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\E${a}" "aA-aA-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\l${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\U${a}\u${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\Q${a}" "aA-aA-aA\\-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\L${a}" "aA-aA-aA\\-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\U${a}" "aA-aA-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\E${a}" "aA-aA-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\l${a}" "aA-aA-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\E${a}\u${a}" "aA-aA-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\Q${a}" "aA-aA-aA\\-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\L${a}" "aA-aA-aA\\-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\U${a}" "aA-aA-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\E${a}" "aA-aA-aA\\-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\l${a}" "aA-aA-aA\\-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\l${a}\u${a}" "aA-aA-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\Q${a}" "aA-aA-aA\\-AA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\L${a}" "aA-aA-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\U${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\E${a}" "aA-aA-aA\\-AA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\l${a}" "aA-aA-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\Q${a}\u${a}\u${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\Q${a}" "aA-aA-aa-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\L${a}" "aA-aA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\U${a}" "aA-aA-aa-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\E${a}" "aA-aA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\l${a}" "aA-aA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\Q${a}\u${a}" "aA-aA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\Q${a}" "aA-aA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\L${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\U${a}" "aA-aA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\E${a}" "aA-aA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\l${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\L${a}\u${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\Q${a}" "aA-aA-aa-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\L${a}" "aA-aA-aa-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\U${a}" "aA-aA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\E${a}" "aA-aA-aa-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\l${a}" "aA-aA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\U${a}\u${a}" "aA-aA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\Q${a}" "aA-aA-aa-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\L${a}" "aA-aA-aa-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\U${a}" "aA-aA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\E${a}" "aA-aA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\l${a}" "aA-aA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\E${a}\u${a}" "aA-aA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\Q${a}" "aA-aA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\L${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\U${a}" "aA-aA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\E${a}" "aA-aA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\l${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\l${a}\u${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\Q${a}" "aA-aA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\L${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\U${a}" "aA-aA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\E${a}" "aA-aA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\l${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\L${a}\u${a}\u${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\Q${a}" "aA-aA-AA-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\L${a}" "aA-aA-AA-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\U${a}" "aA-aA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\E${a}" "aA-aA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\l${a}" "aA-aA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\Q${a}\u${a}" "aA-aA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\Q${a}" "aA-aA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\L${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\U${a}" "aA-aA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\E${a}" "aA-aA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\l${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\L${a}\u${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\Q${a}" "aA-aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\l${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\U${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\Q${a}" "aA-aA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\L${a}" "aA-aA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\U${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\E${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\l${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\E${a}\u${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\Q${a}" "aA-aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\l${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\l${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\Q${a}" "aA-aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\l${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\U${a}\u${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\Q${a}" "aA-aA-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\L${a}" "aA-aA-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\U${a}" "aA-aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\E${a}" "aA-aA-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\l${a}" "aA-aA-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\Q${a}\u${a}" "aA-aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\Q${a}" "aA-aA-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\L${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\U${a}" "aA-aA-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\E${a}" "aA-aA-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\l${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\L${a}\u${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\Q${a}" "aA-aA-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\L${a}" "aA-aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\U${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\E${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\l${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\U${a}\u${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\Q${a}" "aA-aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\L${a}" "aA-aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\U${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\E${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\l${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\E${a}\u${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\Q${a}" "aA-aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\L${a}" "aA-aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\U${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\E${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\l${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\l${a}\u${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\Q${a}" "aA-aA-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\L${a}" "aA-aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\U${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\E${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\l${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\E${a}\u${a}\u${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\Q${a}" "aA-aA-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\L${a}" "aA-aA-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\U${a}" "aA-aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\E${a}" "aA-aA-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\l${a}" "aA-aA-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\Q${a}\u${a}" "aA-aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\Q${a}" "aA-aA-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\L${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\U${a}" "aA-aA-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\E${a}" "aA-aA-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\l${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\L${a}\u${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\Q${a}" "aA-aA-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\L${a}" "aA-aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\U${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\E${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\l${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\U${a}\u${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\Q${a}" "aA-aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\L${a}" "aA-aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\U${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\E${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\l${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\E${a}\u${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\Q${a}" "aA-aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\L${a}" "aA-aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\U${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\E${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\l${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\l${a}\u${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\Q${a}" "aA-aA-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\L${a}" "aA-aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\U${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\E${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\l${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\l${a}\u${a}\u${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\Q${a}" "aA-aA-AA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\L${a}" "aA-aA-AA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\U${a}" "aA-aA-AA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\E${a}" "aA-aA-AA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\l${a}" "aA-aA-AA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\Q${a}\u${a}" "aA-aA-AA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\Q${a}" "aA-aA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\L${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\U${a}" "aA-aA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\E${a}" "aA-aA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\l${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\L${a}\u${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\Q${a}" "aA-aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\l${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\U${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\Q${a}" "aA-aA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\L${a}" "aA-aA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\U${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\E${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\l${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\E${a}\u${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\Q${a}" "aA-aA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\L${a}" "aA-aA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\U${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\E${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\l${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\l${a}\u${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\Q${a}" "aA-aA-AA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\l${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\E${a}\u${a}\u${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\Q${a}" "aA-aA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\L${a}" "aA-aA-aA\\-aA\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\U${a}" "aA-aA-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\E${a}" "aA-aA-aA\\-aA\\\\\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\l${a}" "aA-aA-aA\\-aA\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\Q${a}\u${a}" "aA-aA-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\Q${a}" "aA-aA-aA\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\L${a}" "aA-aA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\U${a}" "aA-aA-aA\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\E${a}" "aA-aA-aA\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\l${a}" "aA-aA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\L${a}\u${a}" "aA-aA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\Q${a}" "aA-aA-aA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\L${a}" "aA-aA-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\U${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\E${a}" "aA-aA-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\l${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\U${a}\u${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\Q${a}" "aA-aA-aA\\-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\L${a}" "aA-aA-aA\\-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\U${a}" "aA-aA-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\E${a}" "aA-aA-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\l${a}" "aA-aA-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\E${a}\u${a}" "aA-aA-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\Q${a}" "aA-aA-aA\\-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\L${a}" "aA-aA-aA\\-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\U${a}" "aA-aA-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\E${a}" "aA-aA-aA\\-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\l${a}" "aA-aA-aA\\-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\l${a}\u${a}" "aA-aA-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\Q${a}" "aA-aA-aA\\-AA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\L${a}" "aA-aA-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\U${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\E${a}" "aA-aA-aA\\-AA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\l${a}" "aA-aA-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\Q${a}\u${a}\u${a}" "aA-aA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\Q${a}" "aA-aA-aa-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\L${a}" "aA-aA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\U${a}" "aA-aA-aa-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\E${a}" "aA-aA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\l${a}" "aA-aA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\Q${a}\u${a}" "aA-aA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\Q${a}" "aA-aA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\L${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\U${a}" "aA-aA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\E${a}" "aA-aA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\l${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\L${a}\u${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\Q${a}" "aA-aA-aa-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\L${a}" "aA-aA-aa-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\U${a}" "aA-aA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\E${a}" "aA-aA-aa-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\l${a}" "aA-aA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\U${a}\u${a}" "aA-aA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\Q${a}" "aA-aA-aa-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\L${a}" "aA-aA-aa-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\U${a}" "aA-aA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\E${a}" "aA-aA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\l${a}" "aA-aA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\E${a}\u${a}" "aA-aA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\Q${a}" "aA-aA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\L${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\U${a}" "aA-aA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\E${a}" "aA-aA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\l${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\l${a}\u${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\Q${a}" "aA-aA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\L${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\U${a}" "aA-aA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\E${a}" "aA-aA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\l${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\L${a}\u${a}\u${a}" "aA-aA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\Q${a}" "aA-aA-AA-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\L${a}" "aA-aA-AA-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\U${a}" "aA-aA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\E${a}" "aA-aA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\l${a}" "aA-aA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\Q${a}\u${a}" "aA-aA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\Q${a}" "aA-aA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\L${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\U${a}" "aA-aA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\E${a}" "aA-aA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\l${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\L${a}\u${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\Q${a}" "aA-aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\l${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\U${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\Q${a}" "aA-aA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\L${a}" "aA-aA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\U${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\E${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\l${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\E${a}\u${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\Q${a}" "aA-aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\l${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\l${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\Q${a}" "aA-aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\l${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\U${a}\u${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\Q${a}" "aA-aA-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\L${a}" "aA-aA-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\U${a}" "aA-aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\E${a}" "aA-aA-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\l${a}" "aA-aA-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\Q${a}\u${a}" "aA-aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\Q${a}" "aA-aA-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\L${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\U${a}" "aA-aA-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\E${a}" "aA-aA-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\l${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\L${a}\u${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\Q${a}" "aA-aA-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\L${a}" "aA-aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\U${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\E${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\l${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\U${a}\u${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\Q${a}" "aA-aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\L${a}" "aA-aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\U${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\E${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\l${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\E${a}\u${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\Q${a}" "aA-aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\L${a}" "aA-aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\U${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\E${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\l${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\l${a}\u${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\Q${a}" "aA-aA-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\L${a}" "aA-aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\U${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\E${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\l${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\E${a}\u${a}\u${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\Q${a}" "aA-aA-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\L${a}" "aA-aA-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\U${a}" "aA-aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\E${a}" "aA-aA-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\l${a}" "aA-aA-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\Q${a}\u${a}" "aA-aA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\Q${a}" "aA-aA-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\L${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\U${a}" "aA-aA-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\E${a}" "aA-aA-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\l${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\L${a}\u${a}" "aA-aA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\Q${a}" "aA-aA-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\L${a}" "aA-aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\U${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\E${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\l${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\U${a}\u${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\Q${a}" "aA-aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\L${a}" "aA-aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\U${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\E${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\l${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\E${a}\u${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\Q${a}" "aA-aA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\L${a}" "aA-aA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\U${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\E${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\l${a}" "aA-aA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\l${a}\u${a}" "aA-aA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\Q${a}" "aA-aA-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\L${a}" "aA-aA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\U${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\E${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\l${a}" "aA-aA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\l${a}\u${a}\u${a}" "aA-aA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\Q${a}" "aA-aA-AA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\L${a}" "aA-aA-AA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\U${a}" "aA-aA-AA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\E${a}" "aA-aA-AA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\l${a}" "aA-aA-AA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\Q${a}\u${a}" "aA-aA-AA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\Q${a}" "aA-aA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\L${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\U${a}" "aA-aA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\E${a}" "aA-aA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\l${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\L${a}\u${a}" "aA-aA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\Q${a}" "aA-aA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\l${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\U${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\Q${a}" "aA-aA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\L${a}" "aA-aA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\U${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\E${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\l${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\E${a}\u${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\Q${a}" "aA-aA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\L${a}" "aA-aA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\U${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\E${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\l${a}" "aA-aA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\l${a}\u${a}" "aA-aA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\Q${a}" "aA-aA-AA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\L${a}" "aA-aA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\U${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\E${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\l${a}" "aA-aA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\l${a}\u${a}\u${a}\u${a}" "aA-aA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\Q${a}" "aA-AA-aA\\-aA\\\\\\-aA\\\\\\\\\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\L${a}" "aA-AA-aA\\-aA\\\\\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\U${a}" "aA-AA-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\E${a}" "aA-AA-aA\\-aA\\\\\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\l${a}" "aA-AA-aA\\-aA\\\\\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\Q${a}\u${a}" "aA-AA-aA\\-aA\\\\\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\Q${a}" "aA-AA-aA\\-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\L${a}" "aA-AA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\U${a}" "aA-AA-aA\\-aa\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\E${a}" "aA-AA-aA\\-aa\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\l${a}" "aA-AA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\L${a}\u${a}" "aA-AA-aA\\-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\Q${a}" "aA-AA-aA\\-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\L${a}" "aA-AA-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\U${a}" "aA-AA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\E${a}" "aA-AA-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\l${a}" "aA-AA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\U${a}\u${a}" "aA-AA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\Q${a}" "aA-AA-aA\\-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\L${a}" "aA-AA-aA\\-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\U${a}" "aA-AA-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\E${a}" "aA-AA-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\l${a}" "aA-AA-aA\\-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\E${a}\u${a}" "aA-AA-aA\\-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\Q${a}" "aA-AA-aA\\-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\L${a}" "aA-AA-aA\\-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\U${a}" "aA-AA-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\E${a}" "aA-AA-aA\\-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\l${a}" "aA-AA-aA\\-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\l${a}\u${a}" "aA-AA-aA\\-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\Q${a}" "aA-AA-aA\\-AA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\L${a}" "aA-AA-aA\\-AA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\U${a}" "aA-AA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\E${a}" "aA-AA-aA\\-AA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\l${a}" "aA-AA-aA\\-AA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\Q${a}\u${a}\u${a}" "aA-AA-aA\\-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\Q${a}" "aA-AA-aa-aa\\-aa\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\L${a}" "aA-AA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\U${a}" "aA-AA-aa-aa\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\E${a}" "aA-AA-aa-aa\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\l${a}" "aA-AA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\Q${a}\u${a}" "aA-AA-aa-aa\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\Q${a}" "aA-AA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\L${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\U${a}" "aA-AA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\E${a}" "aA-AA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\l${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\L${a}\u${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\Q${a}" "aA-AA-aa-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\L${a}" "aA-AA-aa-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\U${a}" "aA-AA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\E${a}" "aA-AA-aa-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\l${a}" "aA-AA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\U${a}\u${a}" "aA-AA-aa-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\Q${a}" "aA-AA-aa-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\L${a}" "aA-AA-aa-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\U${a}" "aA-AA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\E${a}" "aA-AA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\l${a}" "aA-AA-aa-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\E${a}\u${a}" "aA-AA-aa-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\Q${a}" "aA-AA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\L${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\U${a}" "aA-AA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\E${a}" "aA-AA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\l${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\l${a}\u${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\Q${a}" "aA-AA-aa-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\L${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\U${a}" "aA-AA-aa-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\E${a}" "aA-AA-aa-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\l${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\L${a}\u${a}\u${a}" "aA-AA-aa-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\Q${a}" "aA-AA-AA-AA\\-AA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\L${a}" "aA-AA-AA-AA\\-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\U${a}" "aA-AA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\E${a}" "aA-AA-AA-AA\\-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\l${a}" "aA-AA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\Q${a}\u${a}" "aA-AA-AA-AA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\Q${a}" "aA-AA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\L${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\U${a}" "aA-AA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\E${a}" "aA-AA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\l${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\L${a}\u${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\U${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\Q${a}" "aA-AA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\L${a}" "aA-AA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\U${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\E${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\l${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\E${a}\u${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\l${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\U${a}\u${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\Q${a}" "aA-AA-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\L${a}" "aA-AA-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\U${a}" "aA-AA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\E${a}" "aA-AA-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\l${a}" "aA-AA-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\Q${a}\u${a}" "aA-AA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\Q${a}" "aA-AA-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\L${a}" "aA-AA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\U${a}" "aA-AA-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\E${a}" "aA-AA-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\l${a}" "aA-AA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\L${a}\u${a}" "aA-AA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\Q${a}" "aA-AA-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\L${a}" "aA-AA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\U${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\E${a}" "aA-AA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\l${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\U${a}\u${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\Q${a}" "aA-AA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\L${a}" "aA-AA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\U${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\E${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\l${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\E${a}\u${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\Q${a}" "aA-AA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\L${a}" "aA-AA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\U${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\E${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\l${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\l${a}\u${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\Q${a}" "aA-AA-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\L${a}" "aA-AA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\U${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\E${a}" "aA-AA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\l${a}" "aA-AA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\E${a}\u${a}\u${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\Q${a}" "aA-AA-aA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\L${a}" "aA-AA-aA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\U${a}" "aA-AA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\E${a}" "aA-AA-aA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\l${a}" "aA-AA-aA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\Q${a}\u${a}" "aA-AA-aA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\Q${a}" "aA-AA-aA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\L${a}" "aA-AA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\U${a}" "aA-AA-aA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\E${a}" "aA-AA-aA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\l${a}" "aA-AA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\L${a}\u${a}" "aA-AA-aA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\Q${a}" "aA-AA-aA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\L${a}" "aA-AA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\U${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\E${a}" "aA-AA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\l${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\U${a}\u${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\Q${a}" "aA-AA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\L${a}" "aA-AA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\U${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\E${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\l${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\E${a}\u${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\Q${a}" "aA-AA-aA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\L${a}" "aA-AA-aA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\U${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\E${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\l${a}" "aA-AA-aA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\l${a}\u${a}" "aA-AA-aA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\Q${a}" "aA-AA-aA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\L${a}" "aA-AA-aA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\U${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\E${a}" "aA-AA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\l${a}" "aA-AA-aA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\l${a}\u${a}\u${a}" "aA-AA-aA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\Q${a}" "aA-AA-AA-aA\\-aA\\\\\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\L${a}" "aA-AA-AA-aA\\-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\U${a}" "aA-AA-AA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\E${a}" "aA-AA-AA-aA\\-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\l${a}" "aA-AA-AA-aA\\-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\Q${a}\u${a}" "aA-AA-AA-aA\\-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\Q${a}" "aA-AA-AA-aa-aa\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\L${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\U${a}" "aA-AA-AA-aa-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\E${a}" "aA-AA-AA-aa-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\l${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\L${a}\u${a}" "aA-AA-AA-aa-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\Q${a}" "aA-AA-AA-AA-AA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\l${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\U${a}\u${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\Q${a}" "aA-AA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\L${a}" "aA-AA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\U${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\E${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\l${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\E${a}\u${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\Q${a}" "aA-AA-AA-aA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\L${a}" "aA-AA-AA-aA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\U${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\E${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\l${a}" "aA-AA-AA-aA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\l${a}\u${a}" "aA-AA-AA-aA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\Q${a}" "aA-AA-AA-AA-aA\\-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\L${a}" "aA-AA-AA-AA-aa-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\U${a}" "aA-AA-AA-AA-AA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\E${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\l${a}" "aA-AA-AA-AA-aA-"))
+(let ((a "aA-"))
+ (test #?"${a}\u${a}\u${a}\u${a}\u${a}" "aA-AA-AA-AA-AA-"))
+
+(disable-interpol-syntax)
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/unicode.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/unicode.lisp 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/unicode.lisp 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,13912 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/unicode.lisp,v 1.6 2003/10/22 09:22:45 edi Exp $
+
+;;; Copyright (c) 2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-interpol)
+
+;;; this code prepares the hashtable *UNICODE-NAMES*
+
+(loop for (name . code) in '(("NULL" . 0)
+ ("START OF HEADING" . 1)
+ ("START OF TEXT" . 2)
+ ("END OF TEXT" . 3)
+ ("END OF TRANSMISSION" . 4)
+ ("ENQUIRY" . 5)
+ ("ACKNOWLEDGE" . 6)
+ ("BELL" . 7)
+ ("BACKSPACE" . 8)
+ ("CHARACTER TABULATION" . 9)
+ ("LINE FEED (LF)" . 10)
+ ("LINE TABULATION" . 11)
+ ("FORM FEED (FF)" . 12)
+ ("CARRIAGE RETURN (CR)" . 13)
+ ("SHIFT OUT" . 14)
+ ("SHIFT IN" . 15)
+ ("DATA LINK ESCAPE" . 16)
+ ("DEVICE CONTROL ONE" . 17)
+ ("DEVICE CONTROL TWO" . 18)
+ ("DEVICE CONTROL THREE" . 19)
+ ("DEVICE CONTROL FOUR" . 20)
+ ("NEGATIVE ACKNOWLEDGE" . 21)
+ ("SYNCHRONOUS IDLE" . 22)
+ ("END OF TRANSMISSION BLOCK" . 23)
+ ("CANCEL" . 24)
+ ("END OF MEDIUM" . 25)
+ ("SUBSTITUTE" . 26)
+ ("ESCAPE" . 27)
+ ("INFORMATION SEPARATOR FOUR" . 28)
+ ("INFORMATION SEPARATOR THREE" . 29)
+ ("INFORMATION SEPARATOR TWO" . 30)
+ ("INFORMATION SEPARATOR ONE" . 31)
+ ("SPACE" . 32)
+ ("EXCLAMATION MARK" . 33)
+ ("QUOTATION MARK" . 34)
+ ("NUMBER SIGN" . 35)
+ ("DOLLAR SIGN" . 36)
+ ("PERCENT SIGN" . 37)
+ ("AMPERSAND" . 38)
+ ("APOSTROPHE" . 39)
+ ("LEFT PARENTHESIS" . 40)
+ ("RIGHT PARENTHESIS" . 41)
+ ("ASTERISK" . 42)
+ ("PLUS SIGN" . 43)
+ ("COMMA" . 44)
+ ("HYPHEN-MINUS" . 45)
+ ("FULL STOP" . 46)
+ ("SOLIDUS" . 47)
+ ("DIGIT ZERO" . 48)
+ ("DIGIT ONE" . 49)
+ ("DIGIT TWO" . 50)
+ ("DIGIT THREE" . 51)
+ ("DIGIT FOUR" . 52)
+ ("DIGIT FIVE" . 53)
+ ("DIGIT SIX" . 54)
+ ("DIGIT SEVEN" . 55)
+ ("DIGIT EIGHT" . 56)
+ ("DIGIT NINE" . 57)
+ ("COLON" . 58)
+ ("SEMICOLON" . 59)
+ ("LESS-THAN SIGN" . 60)
+ ("EQUALS SIGN" . 61)
+ ("GREATER-THAN SIGN" . 62)
+ ("QUESTION MARK" . 63)
+ ("COMMERCIAL AT" . 64)
+ ("LATIN CAPITAL LETTER A" . 65)
+ ("LATIN CAPITAL LETTER B" . 66)
+ ("LATIN CAPITAL LETTER C" . 67)
+ ("LATIN CAPITAL LETTER D" . 68)
+ ("LATIN CAPITAL LETTER E" . 69)
+ ("LATIN CAPITAL LETTER F" . 70)
+ ("LATIN CAPITAL LETTER G" . 71)
+ ("LATIN CAPITAL LETTER H" . 72)
+ ("LATIN CAPITAL LETTER I" . 73)
+ ("LATIN CAPITAL LETTER J" . 74)
+ ("LATIN CAPITAL LETTER K" . 75)
+ ("LATIN CAPITAL LETTER L" . 76)
+ ("LATIN CAPITAL LETTER M" . 77)
+ ("LATIN CAPITAL LETTER N" . 78)
+ ("LATIN CAPITAL LETTER O" . 79)
+ ("LATIN CAPITAL LETTER P" . 80)
+ ("LATIN CAPITAL LETTER Q" . 81)
+ ("LATIN CAPITAL LETTER R" . 82)
+ ("LATIN CAPITAL LETTER S" . 83)
+ ("LATIN CAPITAL LETTER T" . 84)
+ ("LATIN CAPITAL LETTER U" . 85)
+ ("LATIN CAPITAL LETTER V" . 86)
+ ("LATIN CAPITAL LETTER W" . 87)
+ ("LATIN CAPITAL LETTER X" . 88)
+ ("LATIN CAPITAL LETTER Y" . 89)
+ ("LATIN CAPITAL LETTER Z" . 90)
+ ("LEFT SQUARE BRACKET" . 91)
+ ("REVERSE SOLIDUS" . 92)
+ ("RIGHT SQUARE BRACKET" . 93)
+ ("CIRCUMFLEX ACCENT" . 94)
+ ("LOW LINE" . 95)
+ ("GRAVE ACCENT" . 96)
+ ("LATIN SMALL LETTER A" . 97)
+ ("LATIN SMALL LETTER B" . 98)
+ ("LATIN SMALL LETTER C" . 99)
+ ("LATIN SMALL LETTER D" . 100)
+ ("LATIN SMALL LETTER E" . 101)
+ ("LATIN SMALL LETTER F" . 102)
+ ("LATIN SMALL LETTER G" . 103)
+ ("LATIN SMALL LETTER H" . 104)
+ ("LATIN SMALL LETTER I" . 105)
+ ("LATIN SMALL LETTER J" . 106)
+ ("LATIN SMALL LETTER K" . 107)
+ ("LATIN SMALL LETTER L" . 108)
+ ("LATIN SMALL LETTER M" . 109)
+ ("LATIN SMALL LETTER N" . 110)
+ ("LATIN SMALL LETTER O" . 111)
+ ("LATIN SMALL LETTER P" . 112)
+ ("LATIN SMALL LETTER Q" . 113)
+ ("LATIN SMALL LETTER R" . 114)
+ ("LATIN SMALL LETTER S" . 115)
+ ("LATIN SMALL LETTER T" . 116)
+ ("LATIN SMALL LETTER U" . 117)
+ ("LATIN SMALL LETTER V" . 118)
+ ("LATIN SMALL LETTER W" . 119)
+ ("LATIN SMALL LETTER X" . 120)
+ ("LATIN SMALL LETTER Y" . 121)
+ ("LATIN SMALL LETTER Z" . 122)
+ ("LEFT CURLY BRACKET" . 123)
+ ("VERTICAL LINE" . 124)
+ ("RIGHT CURLY BRACKET" . 125)
+ ("TILDE" . 126)
+ ("DELETE" . 127)
+ ("BREAK PERMITTED HERE" . 130)
+ ("NO BREAK HERE" . 131)
+ ("NEXT LINE (NEL)" . 133)
+ ("START OF SELECTED AREA" . 134)
+ ("END OF SELECTED AREA" . 135)
+ ("CHARACTER TABULATION SET" . 136)
+ ("CHARACTER TABULATION WITH JUSTIFICATION" . 137)
+ ("LINE TABULATION SET" . 138)
+ ("PARTIAL LINE FORWARD" . 139)
+ ("PARTIAL LINE BACKWARD" . 140)
+ ("REVERSE LINE FEED" . 141)
+ ("SINGLE SHIFT TWO" . 142)
+ ("SINGLE SHIFT THREE" . 143)
+ ("DEVICE CONTROL STRING" . 144)
+ ("PRIVATE USE ONE" . 145)
+ ("PRIVATE USE TWO" . 146)
+ ("SET TRANSMIT STATE" . 147)
+ ("CANCEL CHARACTER" . 148)
+ ("MESSAGE WAITING" . 149)
+ ("START OF GUARDED AREA" . 150)
+ ("END OF GUARDED AREA" . 151)
+ ("START OF STRING" . 152)
+ ("SINGLE CHARACTER INTRODUCER" . 154)
+ ("CONTROL SEQUENCE INTRODUCER" . 155)
+ ("STRING TERMINATOR" . 156)
+ ("OPERATING SYSTEM COMMAND" . 157)
+ ("PRIVACY MESSAGE" . 158)
+ ("APPLICATION PROGRAM COMMAND" . 159)
+ ("NO-BREAK SPACE" . 160)
+ ("INVERTED EXCLAMATION MARK" . 161)
+ ("CENT SIGN" . 162)
+ ("POUND SIGN" . 163)
+ ("CURRENCY SIGN" . 164)
+ ("YEN SIGN" . 165)
+ ("BROKEN BAR" . 166)
+ ("SECTION SIGN" . 167)
+ ("DIAERESIS" . 168)
+ ("COPYRIGHT SIGN" . 169)
+ ("FEMININE ORDINAL INDICATOR" . 170)
+ ("LEFT-POINTING DOUBLE ANGLE QUOTATION MARK" . 171)
+ ("NOT SIGN" . 172)
+ ("SOFT HYPHEN" . 173)
+ ("REGISTERED SIGN" . 174)
+ ("MACRON" . 175)
+ ("DEGREE SIGN" . 176)
+ ("PLUS-MINUS SIGN" . 177)
+ ("SUPERSCRIPT TWO" . 178)
+ ("SUPERSCRIPT THREE" . 179)
+ ("ACUTE ACCENT" . 180)
+ ("MICRO SIGN" . 181)
+ ("PILCROW SIGN" . 182)
+ ("MIDDLE DOT" . 183)
+ ("CEDILLA" . 184)
+ ("SUPERSCRIPT ONE" . 185)
+ ("MASCULINE ORDINAL INDICATOR" . 186)
+ ("RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK" . 187)
+ ("VULGAR FRACTION ONE QUARTER" . 188)
+ ("VULGAR FRACTION ONE HALF" . 189)
+ ("VULGAR FRACTION THREE QUARTERS" . 190)
+ ("INVERTED QUESTION MARK" . 191)
+ ("LATIN CAPITAL LETTER A WITH GRAVE" . 192)
+ ("LATIN CAPITAL LETTER A WITH ACUTE" . 193)
+ ("LATIN CAPITAL LETTER A WITH CIRCUMFLEX" . 194)
+ ("LATIN CAPITAL LETTER A WITH TILDE" . 195)
+ ("LATIN CAPITAL LETTER A WITH DIAERESIS" . 196)
+ ("LATIN CAPITAL LETTER A WITH RING ABOVE" . 197)
+ ("LATIN CAPITAL LETTER AE" . 198)
+ ("LATIN CAPITAL LETTER C WITH CEDILLA" . 199)
+ ("LATIN CAPITAL LETTER E WITH GRAVE" . 200)
+ ("LATIN CAPITAL LETTER E WITH ACUTE" . 201)
+ ("LATIN CAPITAL LETTER E WITH CIRCUMFLEX" . 202)
+ ("LATIN CAPITAL LETTER E WITH DIAERESIS" . 203)
+ ("LATIN CAPITAL LETTER I WITH GRAVE" . 204)
+ ("LATIN CAPITAL LETTER I WITH ACUTE" . 205)
+ ("LATIN CAPITAL LETTER I WITH CIRCUMFLEX" . 206)
+ ("LATIN CAPITAL LETTER I WITH DIAERESIS" . 207)
+ ("LATIN CAPITAL LETTER ETH" . 208)
+ ("LATIN CAPITAL LETTER N WITH TILDE" . 209)
+ ("LATIN CAPITAL LETTER O WITH GRAVE" . 210)
+ ("LATIN CAPITAL LETTER O WITH ACUTE" . 211)
+ ("LATIN CAPITAL LETTER O WITH CIRCUMFLEX" . 212)
+ ("LATIN CAPITAL LETTER O WITH TILDE" . 213)
+ ("LATIN CAPITAL LETTER O WITH DIAERESIS" . 214)
+ ("MULTIPLICATION SIGN" . 215)
+ ("LATIN CAPITAL LETTER O WITH STROKE" . 216)
+ ("LATIN CAPITAL LETTER U WITH GRAVE" . 217)
+ ("LATIN CAPITAL LETTER U WITH ACUTE" . 218)
+ ("LATIN CAPITAL LETTER U WITH CIRCUMFLEX" . 219)
+ ("LATIN CAPITAL LETTER U WITH DIAERESIS" . 220)
+ ("LATIN CAPITAL LETTER Y WITH ACUTE" . 221)
+ ("LATIN CAPITAL LETTER THORN" . 222)
+ ("LATIN SMALL LETTER SHARP S" . 223)
+ ("LATIN SMALL LETTER A WITH GRAVE" . 224)
+ ("LATIN SMALL LETTER A WITH ACUTE" . 225)
+ ("LATIN SMALL LETTER A WITH CIRCUMFLEX" . 226)
+ ("LATIN SMALL LETTER A WITH TILDE" . 227)
+ ("LATIN SMALL LETTER A WITH DIAERESIS" . 228)
+ ("LATIN SMALL LETTER A WITH RING ABOVE" . 229)
+ ("LATIN SMALL LETTER AE" . 230)
+ ("LATIN SMALL LETTER C WITH CEDILLA" . 231)
+ ("LATIN SMALL LETTER E WITH GRAVE" . 232)
+ ("LATIN SMALL LETTER E WITH ACUTE" . 233)
+ ("LATIN SMALL LETTER E WITH CIRCUMFLEX" . 234)
+ ("LATIN SMALL LETTER E WITH DIAERESIS" . 235)
+ ("LATIN SMALL LETTER I WITH GRAVE" . 236)
+ ("LATIN SMALL LETTER I WITH ACUTE" . 237)
+ ("LATIN SMALL LETTER I WITH CIRCUMFLEX" . 238)
+ ("LATIN SMALL LETTER I WITH DIAERESIS" . 239)
+ ("LATIN SMALL LETTER ETH" . 240)
+ ("LATIN SMALL LETTER N WITH TILDE" . 241)
+ ("LATIN SMALL LETTER O WITH GRAVE" . 242)
+ ("LATIN SMALL LETTER O WITH ACUTE" . 243)
+ ("LATIN SMALL LETTER O WITH CIRCUMFLEX" . 244)
+ ("LATIN SMALL LETTER O WITH TILDE" . 245)
+ ("LATIN SMALL LETTER O WITH DIAERESIS" . 246)
+ ("DIVISION SIGN" . 247)
+ ("LATIN SMALL LETTER O WITH STROKE" . 248)
+ ("LATIN SMALL LETTER U WITH GRAVE" . 249)
+ ("LATIN SMALL LETTER U WITH ACUTE" . 250)
+ ("LATIN SMALL LETTER U WITH CIRCUMFLEX" . 251)
+ ("LATIN SMALL LETTER U WITH DIAERESIS" . 252)
+ ("LATIN SMALL LETTER Y WITH ACUTE" . 253)
+ ("LATIN SMALL LETTER THORN" . 254)
+ ("LATIN SMALL LETTER Y WITH DIAERESIS" . 255)
+ ("LATIN CAPITAL LETTER A WITH MACRON" . 256)
+ ("LATIN SMALL LETTER A WITH MACRON" . 257)
+ ("LATIN CAPITAL LETTER A WITH BREVE" . 258)
+ ("LATIN SMALL LETTER A WITH BREVE" . 259)
+ ("LATIN CAPITAL LETTER A WITH OGONEK" . 260)
+ ("LATIN SMALL LETTER A WITH OGONEK" . 261)
+ ("LATIN CAPITAL LETTER C WITH ACUTE" . 262)
+ ("LATIN SMALL LETTER C WITH ACUTE" . 263)
+ ("LATIN CAPITAL LETTER C WITH CIRCUMFLEX" . 264)
+ ("LATIN SMALL LETTER C WITH CIRCUMFLEX" . 265)
+ ("LATIN CAPITAL LETTER C WITH DOT ABOVE" . 266)
+ ("LATIN SMALL LETTER C WITH DOT ABOVE" . 267)
+ ("LATIN CAPITAL LETTER C WITH CARON" . 268)
+ ("LATIN SMALL LETTER C WITH CARON" . 269)
+ ("LATIN CAPITAL LETTER D WITH CARON" . 270)
+ ("LATIN SMALL LETTER D WITH CARON" . 271)
+ ("LATIN CAPITAL LETTER D WITH STROKE" . 272)
+ ("LATIN SMALL LETTER D WITH STROKE" . 273)
+ ("LATIN CAPITAL LETTER E WITH MACRON" . 274)
+ ("LATIN SMALL LETTER E WITH MACRON" . 275)
+ ("LATIN CAPITAL LETTER E WITH BREVE" . 276)
+ ("LATIN SMALL LETTER E WITH BREVE" . 277)
+ ("LATIN CAPITAL LETTER E WITH DOT ABOVE" . 278)
+ ("LATIN SMALL LETTER E WITH DOT ABOVE" . 279)
+ ("LATIN CAPITAL LETTER E WITH OGONEK" . 280)
+ ("LATIN SMALL LETTER E WITH OGONEK" . 281)
+ ("LATIN CAPITAL LETTER E WITH CARON" . 282)
+ ("LATIN SMALL LETTER E WITH CARON" . 283)
+ ("LATIN CAPITAL LETTER G WITH CIRCUMFLEX" . 284)
+ ("LATIN SMALL LETTER G WITH CIRCUMFLEX" . 285)
+ ("LATIN CAPITAL LETTER G WITH BREVE" . 286)
+ ("LATIN SMALL LETTER G WITH BREVE" . 287)
+ ("LATIN CAPITAL LETTER G WITH DOT ABOVE" . 288)
+ ("LATIN SMALL LETTER G WITH DOT ABOVE" . 289)
+ ("LATIN CAPITAL LETTER G WITH CEDILLA" . 290)
+ ("LATIN SMALL LETTER G WITH CEDILLA" . 291)
+ ("LATIN CAPITAL LETTER H WITH CIRCUMFLEX" . 292)
+ ("LATIN SMALL LETTER H WITH CIRCUMFLEX" . 293)
+ ("LATIN CAPITAL LETTER H WITH STROKE" . 294)
+ ("LATIN SMALL LETTER H WITH STROKE" . 295)
+ ("LATIN CAPITAL LETTER I WITH TILDE" . 296)
+ ("LATIN SMALL LETTER I WITH TILDE" . 297)
+ ("LATIN CAPITAL LETTER I WITH MACRON" . 298)
+ ("LATIN SMALL LETTER I WITH MACRON" . 299)
+ ("LATIN CAPITAL LETTER I WITH BREVE" . 300)
+ ("LATIN SMALL LETTER I WITH BREVE" . 301)
+ ("LATIN CAPITAL LETTER I WITH OGONEK" . 302)
+ ("LATIN SMALL LETTER I WITH OGONEK" . 303)
+ ("LATIN CAPITAL LETTER I WITH DOT ABOVE" . 304)
+ ("LATIN SMALL LETTER DOTLESS I" . 305)
+ ("LATIN CAPITAL LIGATURE IJ" . 306)
+ ("LATIN SMALL LIGATURE IJ" . 307)
+ ("LATIN CAPITAL LETTER J WITH CIRCUMFLEX" . 308)
+ ("LATIN SMALL LETTER J WITH CIRCUMFLEX" . 309)
+ ("LATIN CAPITAL LETTER K WITH CEDILLA" . 310)
+ ("LATIN SMALL LETTER K WITH CEDILLA" . 311)
+ ("LATIN SMALL LETTER KRA" . 312)
+ ("LATIN CAPITAL LETTER L WITH ACUTE" . 313)
+ ("LATIN SMALL LETTER L WITH ACUTE" . 314)
+ ("LATIN CAPITAL LETTER L WITH CEDILLA" . 315)
+ ("LATIN SMALL LETTER L WITH CEDILLA" . 316)
+ ("LATIN CAPITAL LETTER L WITH CARON" . 317)
+ ("LATIN SMALL LETTER L WITH CARON" . 318)
+ ("LATIN CAPITAL LETTER L WITH MIDDLE DOT" . 319)
+ ("LATIN SMALL LETTER L WITH MIDDLE DOT" . 320)
+ ("LATIN CAPITAL LETTER L WITH STROKE" . 321)
+ ("LATIN SMALL LETTER L WITH STROKE" . 322)
+ ("LATIN CAPITAL LETTER N WITH ACUTE" . 323)
+ ("LATIN SMALL LETTER N WITH ACUTE" . 324)
+ ("LATIN CAPITAL LETTER N WITH CEDILLA" . 325)
+ ("LATIN SMALL LETTER N WITH CEDILLA" . 326)
+ ("LATIN CAPITAL LETTER N WITH CARON" . 327)
+ ("LATIN SMALL LETTER N WITH CARON" . 328)
+ ("LATIN SMALL LETTER N PRECEDED BY APOSTROPHE" . 329)
+ ("LATIN CAPITAL LETTER ENG" . 330)
+ ("LATIN SMALL LETTER ENG" . 331)
+ ("LATIN CAPITAL LETTER O WITH MACRON" . 332)
+ ("LATIN SMALL LETTER O WITH MACRON" . 333)
+ ("LATIN CAPITAL LETTER O WITH BREVE" . 334)
+ ("LATIN SMALL LETTER O WITH BREVE" . 335)
+ ("LATIN CAPITAL LETTER O WITH DOUBLE ACUTE" . 336)
+ ("LATIN SMALL LETTER O WITH DOUBLE ACUTE" . 337)
+ ("LATIN CAPITAL LIGATURE OE" . 338)
+ ("LATIN SMALL LIGATURE OE" . 339)
+ ("LATIN CAPITAL LETTER R WITH ACUTE" . 340)
+ ("LATIN SMALL LETTER R WITH ACUTE" . 341)
+ ("LATIN CAPITAL LETTER R WITH CEDILLA" . 342)
+ ("LATIN SMALL LETTER R WITH CEDILLA" . 343)
+ ("LATIN CAPITAL LETTER R WITH CARON" . 344)
+ ("LATIN SMALL LETTER R WITH CARON" . 345)
+ ("LATIN CAPITAL LETTER S WITH ACUTE" . 346)
+ ("LATIN SMALL LETTER S WITH ACUTE" . 347)
+ ("LATIN CAPITAL LETTER S WITH CIRCUMFLEX" . 348)
+ ("LATIN SMALL LETTER S WITH CIRCUMFLEX" . 349)
+ ("LATIN CAPITAL LETTER S WITH CEDILLA" . 350)
+ ("LATIN SMALL LETTER S WITH CEDILLA" . 351)
+ ("LATIN CAPITAL LETTER S WITH CARON" . 352)
+ ("LATIN SMALL LETTER S WITH CARON" . 353)
+ ("LATIN CAPITAL LETTER T WITH CEDILLA" . 354)
+ ("LATIN SMALL LETTER T WITH CEDILLA" . 355)
+ ("LATIN CAPITAL LETTER T WITH CARON" . 356)
+ ("LATIN SMALL LETTER T WITH CARON" . 357)
+ ("LATIN CAPITAL LETTER T WITH STROKE" . 358)
+ ("LATIN SMALL LETTER T WITH STROKE" . 359)
+ ("LATIN CAPITAL LETTER U WITH TILDE" . 360)
+ ("LATIN SMALL LETTER U WITH TILDE" . 361)
+ ("LATIN CAPITAL LETTER U WITH MACRON" . 362)
+ ("LATIN SMALL LETTER U WITH MACRON" . 363)
+ ("LATIN CAPITAL LETTER U WITH BREVE" . 364)
+ ("LATIN SMALL LETTER U WITH BREVE" . 365)
+ ("LATIN CAPITAL LETTER U WITH RING ABOVE" . 366)
+ ("LATIN SMALL LETTER U WITH RING ABOVE" . 367)
+ ("LATIN CAPITAL LETTER U WITH DOUBLE ACUTE" . 368)
+ ("LATIN SMALL LETTER U WITH DOUBLE ACUTE" . 369)
+ ("LATIN CAPITAL LETTER U WITH OGONEK" . 370)
+ ("LATIN SMALL LETTER U WITH OGONEK" . 371)
+ ("LATIN CAPITAL LETTER W WITH CIRCUMFLEX" . 372)
+ ("LATIN SMALL LETTER W WITH CIRCUMFLEX" . 373)
+ ("LATIN CAPITAL LETTER Y WITH CIRCUMFLEX" . 374)
+ ("LATIN SMALL LETTER Y WITH CIRCUMFLEX" . 375)
+ ("LATIN CAPITAL LETTER Y WITH DIAERESIS" . 376)
+ ("LATIN CAPITAL LETTER Z WITH ACUTE" . 377)
+ ("LATIN SMALL LETTER Z WITH ACUTE" . 378)
+ ("LATIN CAPITAL LETTER Z WITH DOT ABOVE" . 379)
+ ("LATIN SMALL LETTER Z WITH DOT ABOVE" . 380)
+ ("LATIN CAPITAL LETTER Z WITH CARON" . 381)
+ ("LATIN SMALL LETTER Z WITH CARON" . 382)
+ ("LATIN SMALL LETTER LONG S" . 383)
+ ("LATIN SMALL LETTER B WITH STROKE" . 384)
+ ("LATIN CAPITAL LETTER B WITH HOOK" . 385)
+ ("LATIN CAPITAL LETTER B WITH TOPBAR" . 386)
+ ("LATIN SMALL LETTER B WITH TOPBAR" . 387)
+ ("LATIN CAPITAL LETTER TONE SIX" . 388)
+ ("LATIN SMALL LETTER TONE SIX" . 389)
+ ("LATIN CAPITAL LETTER OPEN O" . 390)
+ ("LATIN CAPITAL LETTER C WITH HOOK" . 391)
+ ("LATIN SMALL LETTER C WITH HOOK" . 392)
+ ("LATIN CAPITAL LETTER AFRICAN D" . 393)
+ ("LATIN CAPITAL LETTER D WITH HOOK" . 394)
+ ("LATIN CAPITAL LETTER D WITH TOPBAR" . 395)
+ ("LATIN SMALL LETTER D WITH TOPBAR" . 396)
+ ("LATIN SMALL LETTER TURNED DELTA" . 397)
+ ("LATIN CAPITAL LETTER REVERSED E" . 398)
+ ("LATIN CAPITAL LETTER SCHWA" . 399)
+ ("LATIN CAPITAL LETTER OPEN E" . 400)
+ ("LATIN CAPITAL LETTER F WITH HOOK" . 401)
+ ("LATIN SMALL LETTER F WITH HOOK" . 402)
+ ("LATIN CAPITAL LETTER G WITH HOOK" . 403)
+ ("LATIN CAPITAL LETTER GAMMA" . 404)
+ ("LATIN SMALL LETTER HV" . 405)
+ ("LATIN CAPITAL LETTER IOTA" . 406)
+ ("LATIN CAPITAL LETTER I WITH STROKE" . 407)
+ ("LATIN CAPITAL LETTER K WITH HOOK" . 408)
+ ("LATIN SMALL LETTER K WITH HOOK" . 409)
+ ("LATIN SMALL LETTER L WITH BAR" . 410)
+ ("LATIN SMALL LETTER LAMBDA WITH STROKE" . 411)
+ ("LATIN CAPITAL LETTER TURNED M" . 412)
+ ("LATIN CAPITAL LETTER N WITH LEFT HOOK" . 413)
+ ("LATIN SMALL LETTER N WITH LONG RIGHT LEG" . 414)
+ ("LATIN CAPITAL LETTER O WITH MIDDLE TILDE" . 415)
+ ("LATIN CAPITAL LETTER O WITH HORN" . 416)
+ ("LATIN SMALL LETTER O WITH HORN" . 417)
+ ("LATIN CAPITAL LETTER OI" . 418)
+ ("LATIN SMALL LETTER OI" . 419)
+ ("LATIN CAPITAL LETTER P WITH HOOK" . 420)
+ ("LATIN SMALL LETTER P WITH HOOK" . 421)
+ ("LATIN LETTER YR" . 422)
+ ("LATIN CAPITAL LETTER TONE TWO" . 423)
+ ("LATIN SMALL LETTER TONE TWO" . 424)
+ ("LATIN CAPITAL LETTER ESH" . 425)
+ ("LATIN LETTER REVERSED ESH LOOP" . 426)
+ ("LATIN SMALL LETTER T WITH PALATAL HOOK" . 427)
+ ("LATIN CAPITAL LETTER T WITH HOOK" . 428)
+ ("LATIN SMALL LETTER T WITH HOOK" . 429)
+ ("LATIN CAPITAL LETTER T WITH RETROFLEX HOOK" . 430)
+ ("LATIN CAPITAL LETTER U WITH HORN" . 431)
+ ("LATIN SMALL LETTER U WITH HORN" . 432)
+ ("LATIN CAPITAL LETTER UPSILON" . 433)
+ ("LATIN CAPITAL LETTER V WITH HOOK" . 434)
+ ("LATIN CAPITAL LETTER Y WITH HOOK" . 435)
+ ("LATIN SMALL LETTER Y WITH HOOK" . 436)
+ ("LATIN CAPITAL LETTER Z WITH STROKE" . 437)
+ ("LATIN SMALL LETTER Z WITH STROKE" . 438)
+ ("LATIN CAPITAL LETTER EZH" . 439)
+ ("LATIN CAPITAL LETTER EZH REVERSED" . 440)
+ ("LATIN SMALL LETTER EZH REVERSED" . 441)
+ ("LATIN SMALL LETTER EZH WITH TAIL" . 442)
+ ("LATIN LETTER TWO WITH STROKE" . 443)
+ ("LATIN CAPITAL LETTER TONE FIVE" . 444)
+ ("LATIN SMALL LETTER TONE FIVE" . 445)
+ ("LATIN LETTER INVERTED GLOTTAL STOP WITH STROKE" . 446)
+ ("LATIN LETTER WYNN" . 447)
+ ("LATIN LETTER DENTAL CLICK" . 448)
+ ("LATIN LETTER LATERAL CLICK" . 449)
+ ("LATIN LETTER ALVEOLAR CLICK" . 450)
+ ("LATIN LETTER RETROFLEX CLICK" . 451)
+ ("LATIN CAPITAL LETTER DZ WITH CARON" . 452)
+ ("LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON" . 453)
+ ("LATIN SMALL LETTER DZ WITH CARON" . 454)
+ ("LATIN CAPITAL LETTER LJ" . 455)
+ ("LATIN CAPITAL LETTER L WITH SMALL LETTER J" . 456)
+ ("LATIN SMALL LETTER LJ" . 457)
+ ("LATIN CAPITAL LETTER NJ" . 458)
+ ("LATIN CAPITAL LETTER N WITH SMALL LETTER J" . 459)
+ ("LATIN SMALL LETTER NJ" . 460)
+ ("LATIN CAPITAL LETTER A WITH CARON" . 461)
+ ("LATIN SMALL LETTER A WITH CARON" . 462)
+ ("LATIN CAPITAL LETTER I WITH CARON" . 463)
+ ("LATIN SMALL LETTER I WITH CARON" . 464)
+ ("LATIN CAPITAL LETTER O WITH CARON" . 465)
+ ("LATIN SMALL LETTER O WITH CARON" . 466)
+ ("LATIN CAPITAL LETTER U WITH CARON" . 467)
+ ("LATIN SMALL LETTER U WITH CARON" . 468)
+ ("LATIN CAPITAL LETTER U WITH DIAERESIS AND MACRON" . 469)
+ ("LATIN SMALL LETTER U WITH DIAERESIS AND MACRON" . 470)
+ ("LATIN CAPITAL LETTER U WITH DIAERESIS AND ACUTE" . 471)
+ ("LATIN SMALL LETTER U WITH DIAERESIS AND ACUTE" . 472)
+ ("LATIN CAPITAL LETTER U WITH DIAERESIS AND CARON" . 473)
+ ("LATIN SMALL LETTER U WITH DIAERESIS AND CARON" . 474)
+ ("LATIN CAPITAL LETTER U WITH DIAERESIS AND GRAVE" . 475)
+ ("LATIN SMALL LETTER U WITH DIAERESIS AND GRAVE" . 476)
+ ("LATIN SMALL LETTER TURNED E" . 477)
+ ("LATIN CAPITAL LETTER A WITH DIAERESIS AND MACRON" . 478)
+ ("LATIN SMALL LETTER A WITH DIAERESIS AND MACRON" . 479)
+ ("LATIN CAPITAL LETTER A WITH DOT ABOVE AND MACRON" . 480)
+ ("LATIN SMALL LETTER A WITH DOT ABOVE AND MACRON" . 481)
+ ("LATIN CAPITAL LETTER AE WITH MACRON" . 482)
+ ("LATIN SMALL LETTER AE WITH MACRON" . 483)
+ ("LATIN CAPITAL LETTER G WITH STROKE" . 484)
+ ("LATIN SMALL LETTER G WITH STROKE" . 485)
+ ("LATIN CAPITAL LETTER G WITH CARON" . 486)
+ ("LATIN SMALL LETTER G WITH CARON" . 487)
+ ("LATIN CAPITAL LETTER K WITH CARON" . 488)
+ ("LATIN SMALL LETTER K WITH CARON" . 489)
+ ("LATIN CAPITAL LETTER O WITH OGONEK" . 490)
+ ("LATIN SMALL LETTER O WITH OGONEK" . 491)
+ ("LATIN CAPITAL LETTER O WITH OGONEK AND MACRON" . 492)
+ ("LATIN SMALL LETTER O WITH OGONEK AND MACRON" . 493)
+ ("LATIN CAPITAL LETTER EZH WITH CARON" . 494)
+ ("LATIN SMALL LETTER EZH WITH CARON" . 495)
+ ("LATIN SMALL LETTER J WITH CARON" . 496)
+ ("LATIN CAPITAL LETTER DZ" . 497)
+ ("LATIN CAPITAL LETTER D WITH SMALL LETTER Z" . 498)
+ ("LATIN SMALL LETTER DZ" . 499)
+ ("LATIN CAPITAL LETTER G WITH ACUTE" . 500)
+ ("LATIN SMALL LETTER G WITH ACUTE" . 501)
+ ("LATIN CAPITAL LETTER HWAIR" . 502)
+ ("LATIN CAPITAL LETTER WYNN" . 503)
+ ("LATIN CAPITAL LETTER N WITH GRAVE" . 504)
+ ("LATIN SMALL LETTER N WITH GRAVE" . 505)
+ ("LATIN CAPITAL LETTER A WITH RING ABOVE AND ACUTE" . 506)
+ ("LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE" . 507)
+ ("LATIN CAPITAL LETTER AE WITH ACUTE" . 508)
+ ("LATIN SMALL LETTER AE WITH ACUTE" . 509)
+ ("LATIN CAPITAL LETTER O WITH STROKE AND ACUTE" . 510)
+ ("LATIN SMALL LETTER O WITH STROKE AND ACUTE" . 511)
+ ("LATIN CAPITAL LETTER A WITH DOUBLE GRAVE" . 512)
+ ("LATIN SMALL LETTER A WITH DOUBLE GRAVE" . 513)
+ ("LATIN CAPITAL LETTER A WITH INVERTED BREVE" . 514)
+ ("LATIN SMALL LETTER A WITH INVERTED BREVE" . 515)
+ ("LATIN CAPITAL LETTER E WITH DOUBLE GRAVE" . 516)
+ ("LATIN SMALL LETTER E WITH DOUBLE GRAVE" . 517)
+ ("LATIN CAPITAL LETTER E WITH INVERTED BREVE" . 518)
+ ("LATIN SMALL LETTER E WITH INVERTED BREVE" . 519)
+ ("LATIN CAPITAL LETTER I WITH DOUBLE GRAVE" . 520)
+ ("LATIN SMALL LETTER I WITH DOUBLE GRAVE" . 521)
+ ("LATIN CAPITAL LETTER I WITH INVERTED BREVE" . 522)
+ ("LATIN SMALL LETTER I WITH INVERTED BREVE" . 523)
+ ("LATIN CAPITAL LETTER O WITH DOUBLE GRAVE" . 524)
+ ("LATIN SMALL LETTER O WITH DOUBLE GRAVE" . 525)
+ ("LATIN CAPITAL LETTER O WITH INVERTED BREVE" . 526)
+ ("LATIN SMALL LETTER O WITH INVERTED BREVE" . 527)
+ ("LATIN CAPITAL LETTER R WITH DOUBLE GRAVE" . 528)
+ ("LATIN SMALL LETTER R WITH DOUBLE GRAVE" . 529)
+ ("LATIN CAPITAL LETTER R WITH INVERTED BREVE" . 530)
+ ("LATIN SMALL LETTER R WITH INVERTED BREVE" . 531)
+ ("LATIN CAPITAL LETTER U WITH DOUBLE GRAVE" . 532)
+ ("LATIN SMALL LETTER U WITH DOUBLE GRAVE" . 533)
+ ("LATIN CAPITAL LETTER U WITH INVERTED BREVE" . 534)
+ ("LATIN SMALL LETTER U WITH INVERTED BREVE" . 535)
+ ("LATIN CAPITAL LETTER S WITH COMMA BELOW" . 536)
+ ("LATIN SMALL LETTER S WITH COMMA BELOW" . 537)
+ ("LATIN CAPITAL LETTER T WITH COMMA BELOW" . 538)
+ ("LATIN SMALL LETTER T WITH COMMA BELOW" . 539)
+ ("LATIN CAPITAL LETTER YOGH" . 540)
+ ("LATIN SMALL LETTER YOGH" . 541)
+ ("LATIN CAPITAL LETTER H WITH CARON" . 542)
+ ("LATIN SMALL LETTER H WITH CARON" . 543)
+ ("LATIN CAPITAL LETTER N WITH LONG RIGHT LEG" . 544)
+ ("LATIN CAPITAL LETTER OU" . 546)
+ ("LATIN SMALL LETTER OU" . 547)
+ ("LATIN CAPITAL LETTER Z WITH HOOK" . 548)
+ ("LATIN SMALL LETTER Z WITH HOOK" . 549)
+ ("LATIN CAPITAL LETTER A WITH DOT ABOVE" . 550)
+ ("LATIN SMALL LETTER A WITH DOT ABOVE" . 551)
+ ("LATIN CAPITAL LETTER E WITH CEDILLA" . 552)
+ ("LATIN SMALL LETTER E WITH CEDILLA" . 553)
+ ("LATIN CAPITAL LETTER O WITH DIAERESIS AND MACRON" . 554)
+ ("LATIN SMALL LETTER O WITH DIAERESIS AND MACRON" . 555)
+ ("LATIN CAPITAL LETTER O WITH TILDE AND MACRON" . 556)
+ ("LATIN SMALL LETTER O WITH TILDE AND MACRON" . 557)
+ ("LATIN CAPITAL LETTER O WITH DOT ABOVE" . 558)
+ ("LATIN SMALL LETTER O WITH DOT ABOVE" . 559)
+ ("LATIN CAPITAL LETTER O WITH DOT ABOVE AND MACRON" . 560)
+ ("LATIN SMALL LETTER O WITH DOT ABOVE AND MACRON" . 561)
+ ("LATIN CAPITAL LETTER Y WITH MACRON" . 562)
+ ("LATIN SMALL LETTER Y WITH MACRON" . 563)
+ ("LATIN SMALL LETTER TURNED A" . 592)
+ ("LATIN SMALL LETTER ALPHA" . 593)
+ ("LATIN SMALL LETTER TURNED ALPHA" . 594)
+ ("LATIN SMALL LETTER B WITH HOOK" . 595)
+ ("LATIN SMALL LETTER OPEN O" . 596)
+ ("LATIN SMALL LETTER C WITH CURL" . 597)
+ ("LATIN SMALL LETTER D WITH TAIL" . 598)
+ ("LATIN SMALL LETTER D WITH HOOK" . 599)
+ ("LATIN SMALL LETTER REVERSED E" . 600)
+ ("LATIN SMALL LETTER SCHWA" . 601)
+ ("LATIN SMALL LETTER SCHWA WITH HOOK" . 602)
+ ("LATIN SMALL LETTER OPEN E" . 603)
+ ("LATIN SMALL LETTER REVERSED OPEN E" . 604)
+ ("LATIN SMALL LETTER REVERSED OPEN E WITH HOOK" . 605)
+ ("LATIN SMALL LETTER CLOSED REVERSED OPEN E" . 606)
+ ("LATIN SMALL LETTER DOTLESS J WITH STROKE" . 607)
+ ("LATIN SMALL LETTER G WITH HOOK" . 608)
+ ("LATIN SMALL LETTER SCRIPT G" . 609)
+ ("LATIN LETTER SMALL CAPITAL G" . 610)
+ ("LATIN SMALL LETTER GAMMA" . 611)
+ ("LATIN SMALL LETTER RAMS HORN" . 612)
+ ("LATIN SMALL LETTER TURNED H" . 613)
+ ("LATIN SMALL LETTER H WITH HOOK" . 614)
+ ("LATIN SMALL LETTER HENG WITH HOOK" . 615)
+ ("LATIN SMALL LETTER I WITH STROKE" . 616)
+ ("LATIN SMALL LETTER IOTA" . 617)
+ ("LATIN LETTER SMALL CAPITAL I" . 618)
+ ("LATIN SMALL LETTER L WITH MIDDLE TILDE" . 619)
+ ("LATIN SMALL LETTER L WITH BELT" . 620)
+ ("LATIN SMALL LETTER L WITH RETROFLEX HOOK" . 621)
+ ("LATIN SMALL LETTER LEZH" . 622)
+ ("LATIN SMALL LETTER TURNED M" . 623)
+ ("LATIN SMALL LETTER TURNED M WITH LONG LEG" . 624)
+ ("LATIN SMALL LETTER M WITH HOOK" . 625)
+ ("LATIN SMALL LETTER N WITH LEFT HOOK" . 626)
+ ("LATIN SMALL LETTER N WITH RETROFLEX HOOK" . 627)
+ ("LATIN LETTER SMALL CAPITAL N" . 628)
+ ("LATIN SMALL LETTER BARRED O" . 629)
+ ("LATIN LETTER SMALL CAPITAL OE" . 630)
+ ("LATIN SMALL LETTER CLOSED OMEGA" . 631)
+ ("LATIN SMALL LETTER PHI" . 632)
+ ("LATIN SMALL LETTER TURNED R" . 633)
+ ("LATIN SMALL LETTER TURNED R WITH LONG LEG" . 634)
+ ("LATIN SMALL LETTER TURNED R WITH HOOK" . 635)
+ ("LATIN SMALL LETTER R WITH LONG LEG" . 636)
+ ("LATIN SMALL LETTER R WITH TAIL" . 637)
+ ("LATIN SMALL LETTER R WITH FISHHOOK" . 638)
+ ("LATIN SMALL LETTER REVERSED R WITH FISHHOOK" . 639)
+ ("LATIN LETTER SMALL CAPITAL R" . 640)
+ ("LATIN LETTER SMALL CAPITAL INVERTED R" . 641)
+ ("LATIN SMALL LETTER S WITH HOOK" . 642)
+ ("LATIN SMALL LETTER ESH" . 643)
+ ("LATIN SMALL LETTER DOTLESS J WITH STROKE AND HOOK" . 644)
+ ("LATIN SMALL LETTER SQUAT REVERSED ESH" . 645)
+ ("LATIN SMALL LETTER ESH WITH CURL" . 646)
+ ("LATIN SMALL LETTER TURNED T" . 647)
+ ("LATIN SMALL LETTER T WITH RETROFLEX HOOK" . 648)
+ ("LATIN SMALL LETTER U BAR" . 649)
+ ("LATIN SMALL LETTER UPSILON" . 650)
+ ("LATIN SMALL LETTER V WITH HOOK" . 651)
+ ("LATIN SMALL LETTER TURNED V" . 652)
+ ("LATIN SMALL LETTER TURNED W" . 653)
+ ("LATIN SMALL LETTER TURNED Y" . 654)
+ ("LATIN LETTER SMALL CAPITAL Y" . 655)
+ ("LATIN SMALL LETTER Z WITH RETROFLEX HOOK" . 656)
+ ("LATIN SMALL LETTER Z WITH CURL" . 657)
+ ("LATIN SMALL LETTER EZH" . 658)
+ ("LATIN SMALL LETTER EZH WITH CURL" . 659)
+ ("LATIN LETTER GLOTTAL STOP" . 660)
+ ("LATIN LETTER PHARYNGEAL VOICED FRICATIVE" . 661)
+ ("LATIN LETTER INVERTED GLOTTAL STOP" . 662)
+ ("LATIN LETTER STRETCHED C" . 663)
+ ("LATIN LETTER BILABIAL CLICK" . 664)
+ ("LATIN LETTER SMALL CAPITAL B" . 665)
+ ("LATIN SMALL LETTER CLOSED OPEN E" . 666)
+ ("LATIN LETTER SMALL CAPITAL G WITH HOOK" . 667)
+ ("LATIN LETTER SMALL CAPITAL H" . 668)
+ ("LATIN SMALL LETTER J WITH CROSSED-TAIL" . 669)
+ ("LATIN SMALL LETTER TURNED K" . 670)
+ ("LATIN LETTER SMALL CAPITAL L" . 671)
+ ("LATIN SMALL LETTER Q WITH HOOK" . 672)
+ ("LATIN LETTER GLOTTAL STOP WITH STROKE" . 673)
+ ("LATIN LETTER REVERSED GLOTTAL STOP WITH STROKE" . 674)
+ ("LATIN SMALL LETTER DZ DIGRAPH" . 675)
+ ("LATIN SMALL LETTER DEZH DIGRAPH" . 676)
+ ("LATIN SMALL LETTER DZ DIGRAPH WITH CURL" . 677)
+ ("LATIN SMALL LETTER TS DIGRAPH" . 678)
+ ("LATIN SMALL LETTER TESH DIGRAPH" . 679)
+ ("LATIN SMALL LETTER TC DIGRAPH WITH CURL" . 680)
+ ("LATIN SMALL LETTER FENG DIGRAPH" . 681)
+ ("LATIN SMALL LETTER LS DIGRAPH" . 682)
+ ("LATIN SMALL LETTER LZ DIGRAPH" . 683)
+ ("LATIN LETTER BILABIAL PERCUSSIVE" . 684)
+ ("LATIN LETTER BIDENTAL PERCUSSIVE" . 685)
+ ("MODIFIER LETTER SMALL H" . 688)
+ ("MODIFIER LETTER SMALL H WITH HOOK" . 689)
+ ("MODIFIER LETTER SMALL J" . 690)
+ ("MODIFIER LETTER SMALL R" . 691)
+ ("MODIFIER LETTER SMALL TURNED R" . 692)
+ ("MODIFIER LETTER SMALL TURNED R WITH HOOK" . 693)
+ ("MODIFIER LETTER SMALL CAPITAL INVERTED R" . 694)
+ ("MODIFIER LETTER SMALL W" . 695)
+ ("MODIFIER LETTER SMALL Y" . 696)
+ ("MODIFIER LETTER PRIME" . 697)
+ ("MODIFIER LETTER DOUBLE PRIME" . 698)
+ ("MODIFIER LETTER TURNED COMMA" . 699)
+ ("MODIFIER LETTER APOSTROPHE" . 700)
+ ("MODIFIER LETTER REVERSED COMMA" . 701)
+ ("MODIFIER LETTER RIGHT HALF RING" . 702)
+ ("MODIFIER LETTER LEFT HALF RING" . 703)
+ ("MODIFIER LETTER GLOTTAL STOP" . 704)
+ ("MODIFIER LETTER REVERSED GLOTTAL STOP" . 705)
+ ("MODIFIER LETTER LEFT ARROWHEAD" . 706)
+ ("MODIFIER LETTER RIGHT ARROWHEAD" . 707)
+ ("MODIFIER LETTER UP ARROWHEAD" . 708)
+ ("MODIFIER LETTER DOWN ARROWHEAD" . 709)
+ ("MODIFIER LETTER CIRCUMFLEX ACCENT" . 710)
+ ("CARON" . 711)
+ ("MODIFIER LETTER VERTICAL LINE" . 712)
+ ("MODIFIER LETTER MACRON" . 713)
+ ("MODIFIER LETTER ACUTE ACCENT" . 714)
+ ("MODIFIER LETTER GRAVE ACCENT" . 715)
+ ("MODIFIER LETTER LOW VERTICAL LINE" . 716)
+ ("MODIFIER LETTER LOW MACRON" . 717)
+ ("MODIFIER LETTER LOW GRAVE ACCENT" . 718)
+ ("MODIFIER LETTER LOW ACUTE ACCENT" . 719)
+ ("MODIFIER LETTER TRIANGULAR COLON" . 720)
+ ("MODIFIER LETTER HALF TRIANGULAR COLON" . 721)
+ ("MODIFIER LETTER CENTRED RIGHT HALF RING" . 722)
+ ("MODIFIER LETTER CENTRED LEFT HALF RING" . 723)
+ ("MODIFIER LETTER UP TACK" . 724)
+ ("MODIFIER LETTER DOWN TACK" . 725)
+ ("MODIFIER LETTER PLUS SIGN" . 726)
+ ("MODIFIER LETTER MINUS SIGN" . 727)
+ ("BREVE" . 728)
+ ("DOT ABOVE" . 729)
+ ("RING ABOVE" . 730)
+ ("OGONEK" . 731)
+ ("SMALL TILDE" . 732)
+ ("DOUBLE ACUTE ACCENT" . 733)
+ ("MODIFIER LETTER RHOTIC HOOK" . 734)
+ ("MODIFIER LETTER CROSS ACCENT" . 735)
+ ("MODIFIER LETTER SMALL GAMMA" . 736)
+ ("MODIFIER LETTER SMALL L" . 737)
+ ("MODIFIER LETTER SMALL S" . 738)
+ ("MODIFIER LETTER SMALL X" . 739)
+ ("MODIFIER LETTER SMALL REVERSED GLOTTAL STOP" . 740)
+ ("MODIFIER LETTER EXTRA-HIGH TONE BAR" . 741)
+ ("MODIFIER LETTER HIGH TONE BAR" . 742)
+ ("MODIFIER LETTER MID TONE BAR" . 743)
+ ("MODIFIER LETTER LOW TONE BAR" . 744)
+ ("MODIFIER LETTER EXTRA-LOW TONE BAR" . 745)
+ ("MODIFIER LETTER YIN DEPARTING TONE MARK" . 746)
+ ("MODIFIER LETTER YANG DEPARTING TONE MARK" . 747)
+ ("MODIFIER LETTER VOICING" . 748)
+ ("MODIFIER LETTER UNASPIRATED" . 749)
+ ("MODIFIER LETTER DOUBLE APOSTROPHE" . 750)
+ ("COMBINING GRAVE ACCENT" . 768)
+ ("COMBINING ACUTE ACCENT" . 769)
+ ("COMBINING CIRCUMFLEX ACCENT" . 770)
+ ("COMBINING TILDE" . 771)
+ ("COMBINING MACRON" . 772)
+ ("COMBINING OVERLINE" . 773)
+ ("COMBINING BREVE" . 774)
+ ("COMBINING DOT ABOVE" . 775)
+ ("COMBINING DIAERESIS" . 776)
+ ("COMBINING HOOK ABOVE" . 777)
+ ("COMBINING RING ABOVE" . 778)
+ ("COMBINING DOUBLE ACUTE ACCENT" . 779)
+ ("COMBINING CARON" . 780)
+ ("COMBINING VERTICAL LINE ABOVE" . 781)
+ ("COMBINING DOUBLE VERTICAL LINE ABOVE" . 782)
+ ("COMBINING DOUBLE GRAVE ACCENT" . 783)
+ ("COMBINING CANDRABINDU" . 784)
+ ("COMBINING INVERTED BREVE" . 785)
+ ("COMBINING TURNED COMMA ABOVE" . 786)
+ ("COMBINING COMMA ABOVE" . 787)
+ ("COMBINING REVERSED COMMA ABOVE" . 788)
+ ("COMBINING COMMA ABOVE RIGHT" . 789)
+ ("COMBINING GRAVE ACCENT BELOW" . 790)
+ ("COMBINING ACUTE ACCENT BELOW" . 791)
+ ("COMBINING LEFT TACK BELOW" . 792)
+ ("COMBINING RIGHT TACK BELOW" . 793)
+ ("COMBINING LEFT ANGLE ABOVE" . 794)
+ ("COMBINING HORN" . 795)
+ ("COMBINING LEFT HALF RING BELOW" . 796)
+ ("COMBINING UP TACK BELOW" . 797)
+ ("COMBINING DOWN TACK BELOW" . 798)
+ ("COMBINING PLUS SIGN BELOW" . 799)
+ ("COMBINING MINUS SIGN BELOW" . 800)
+ ("COMBINING PALATALIZED HOOK BELOW" . 801)
+ ("COMBINING RETROFLEX HOOK BELOW" . 802)
+ ("COMBINING DOT BELOW" . 803)
+ ("COMBINING DIAERESIS BELOW" . 804)
+ ("COMBINING RING BELOW" . 805)
+ ("COMBINING COMMA BELOW" . 806)
+ ("COMBINING CEDILLA" . 807)
+ ("COMBINING OGONEK" . 808)
+ ("COMBINING VERTICAL LINE BELOW" . 809)
+ ("COMBINING BRIDGE BELOW" . 810)
+ ("COMBINING INVERTED DOUBLE ARCH BELOW" . 811)
+ ("COMBINING CARON BELOW" . 812)
+ ("COMBINING CIRCUMFLEX ACCENT BELOW" . 813)
+ ("COMBINING BREVE BELOW" . 814)
+ ("COMBINING INVERTED BREVE BELOW" . 815)
+ ("COMBINING TILDE BELOW" . 816)
+ ("COMBINING MACRON BELOW" . 817)
+ ("COMBINING LOW LINE" . 818)
+ ("COMBINING DOUBLE LOW LINE" . 819)
+ ("COMBINING TILDE OVERLAY" . 820)
+ ("COMBINING SHORT STROKE OVERLAY" . 821)
+ ("COMBINING LONG STROKE OVERLAY" . 822)
+ ("COMBINING SHORT SOLIDUS OVERLAY" . 823)
+ ("COMBINING LONG SOLIDUS OVERLAY" . 824)
+ ("COMBINING RIGHT HALF RING BELOW" . 825)
+ ("COMBINING INVERTED BRIDGE BELOW" . 826)
+ ("COMBINING SQUARE BELOW" . 827)
+ ("COMBINING SEAGULL BELOW" . 828)
+ ("COMBINING X ABOVE" . 829)
+ ("COMBINING VERTICAL TILDE" . 830)
+ ("COMBINING DOUBLE OVERLINE" . 831)
+ ("COMBINING GRAVE TONE MARK" . 832)
+ ("COMBINING ACUTE TONE MARK" . 833)
+ ("COMBINING GREEK PERISPOMENI" . 834)
+ ("COMBINING GREEK KORONIS" . 835)
+ ("COMBINING GREEK DIALYTIKA TONOS" . 836)
+ ("COMBINING GREEK YPOGEGRAMMENI" . 837)
+ ("COMBINING BRIDGE ABOVE" . 838)
+ ("COMBINING EQUALS SIGN BELOW" . 839)
+ ("COMBINING DOUBLE VERTICAL LINE BELOW" . 840)
+ ("COMBINING LEFT ANGLE BELOW" . 841)
+ ("COMBINING NOT TILDE ABOVE" . 842)
+ ("COMBINING HOMOTHETIC ABOVE" . 843)
+ ("COMBINING ALMOST EQUAL TO ABOVE" . 844)
+ ("COMBINING LEFT RIGHT ARROW BELOW" . 845)
+ ("COMBINING UPWARDS ARROW BELOW" . 846)
+ ("COMBINING GRAPHEME JOINER" . 847)
+ ("COMBINING DOUBLE TILDE" . 864)
+ ("COMBINING DOUBLE INVERTED BREVE" . 865)
+ ("COMBINING DOUBLE RIGHTWARDS ARROW BELOW" . 866)
+ ("COMBINING LATIN SMALL LETTER A" . 867)
+ ("COMBINING LATIN SMALL LETTER E" . 868)
+ ("COMBINING LATIN SMALL LETTER I" . 869)
+ ("COMBINING LATIN SMALL LETTER O" . 870)
+ ("COMBINING LATIN SMALL LETTER U" . 871)
+ ("COMBINING LATIN SMALL LETTER C" . 872)
+ ("COMBINING LATIN SMALL LETTER D" . 873)
+ ("COMBINING LATIN SMALL LETTER H" . 874)
+ ("COMBINING LATIN SMALL LETTER M" . 875)
+ ("COMBINING LATIN SMALL LETTER R" . 876)
+ ("COMBINING LATIN SMALL LETTER T" . 877)
+ ("COMBINING LATIN SMALL LETTER V" . 878)
+ ("COMBINING LATIN SMALL LETTER X" . 879)
+ ("GREEK NUMERAL SIGN" . 884)
+ ("GREEK LOWER NUMERAL SIGN" . 885)
+ ("GREEK YPOGEGRAMMENI" . 890)
+ ("GREEK QUESTION MARK" . 894)
+ ("GREEK TONOS" . 900)
+ ("GREEK DIALYTIKA TONOS" . 901)
+ ("GREEK CAPITAL LETTER ALPHA WITH TONOS" . 902)
+ ("GREEK ANO TELEIA" . 903)
+ ("GREEK CAPITAL LETTER EPSILON WITH TONOS" . 904)
+ ("GREEK CAPITAL LETTER ETA WITH TONOS" . 905)
+ ("GREEK CAPITAL LETTER IOTA WITH TONOS" . 906)
+ ("GREEK CAPITAL LETTER OMICRON WITH TONOS" . 908)
+ ("GREEK CAPITAL LETTER UPSILON WITH TONOS" . 910)
+ ("GREEK CAPITAL LETTER OMEGA WITH TONOS" . 911)
+ ("GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS" . 912)
+ ("GREEK CAPITAL LETTER ALPHA" . 913)
+ ("GREEK CAPITAL LETTER BETA" . 914)
+ ("GREEK CAPITAL LETTER GAMMA" . 915)
+ ("GREEK CAPITAL LETTER DELTA" . 916)
+ ("GREEK CAPITAL LETTER EPSILON" . 917)
+ ("GREEK CAPITAL LETTER ZETA" . 918)
+ ("GREEK CAPITAL LETTER ETA" . 919)
+ ("GREEK CAPITAL LETTER THETA" . 920)
+ ("GREEK CAPITAL LETTER IOTA" . 921)
+ ("GREEK CAPITAL LETTER KAPPA" . 922)
+ ("GREEK CAPITAL LETTER LAMDA" . 923)
+ ("GREEK CAPITAL LETTER MU" . 924)
+ ("GREEK CAPITAL LETTER NU" . 925)
+ ("GREEK CAPITAL LETTER XI" . 926)
+ ("GREEK CAPITAL LETTER OMICRON" . 927)
+ ("GREEK CAPITAL LETTER PI" . 928)
+ ("GREEK CAPITAL LETTER RHO" . 929)
+ ("GREEK CAPITAL LETTER SIGMA" . 931)
+ ("GREEK CAPITAL LETTER TAU" . 932)
+ ("GREEK CAPITAL LETTER UPSILON" . 933)
+ ("GREEK CAPITAL LETTER PHI" . 934)
+ ("GREEK CAPITAL LETTER CHI" . 935)
+ ("GREEK CAPITAL LETTER PSI" . 936)
+ ("GREEK CAPITAL LETTER OMEGA" . 937)
+ ("GREEK CAPITAL LETTER IOTA WITH DIALYTIKA" . 938)
+ ("GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA" . 939)
+ ("GREEK SMALL LETTER ALPHA WITH TONOS" . 940)
+ ("GREEK SMALL LETTER EPSILON WITH TONOS" . 941)
+ ("GREEK SMALL LETTER ETA WITH TONOS" . 942)
+ ("GREEK SMALL LETTER IOTA WITH TONOS" . 943)
+ ("GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS" . 944)
+ ("GREEK SMALL LETTER ALPHA" . 945)
+ ("GREEK SMALL LETTER BETA" . 946)
+ ("GREEK SMALL LETTER GAMMA" . 947)
+ ("GREEK SMALL LETTER DELTA" . 948)
+ ("GREEK SMALL LETTER EPSILON" . 949)
+ ("GREEK SMALL LETTER ZETA" . 950)
+ ("GREEK SMALL LETTER ETA" . 951)
+ ("GREEK SMALL LETTER THETA" . 952)
+ ("GREEK SMALL LETTER IOTA" . 953)
+ ("GREEK SMALL LETTER KAPPA" . 954)
+ ("GREEK SMALL LETTER LAMDA" . 955)
+ ("GREEK SMALL LETTER MU" . 956)
+ ("GREEK SMALL LETTER NU" . 957)
+ ("GREEK SMALL LETTER XI" . 958)
+ ("GREEK SMALL LETTER OMICRON" . 959)
+ ("GREEK SMALL LETTER PI" . 960)
+ ("GREEK SMALL LETTER RHO" . 961)
+ ("GREEK SMALL LETTER FINAL SIGMA" . 962)
+ ("GREEK SMALL LETTER SIGMA" . 963)
+ ("GREEK SMALL LETTER TAU" . 964)
+ ("GREEK SMALL LETTER UPSILON" . 965)
+ ("GREEK SMALL LETTER PHI" . 966)
+ ("GREEK SMALL LETTER CHI" . 967)
+ ("GREEK SMALL LETTER PSI" . 968)
+ ("GREEK SMALL LETTER OMEGA" . 969)
+ ("GREEK SMALL LETTER IOTA WITH DIALYTIKA" . 970)
+ ("GREEK SMALL LETTER UPSILON WITH DIALYTIKA" . 971)
+ ("GREEK SMALL LETTER OMICRON WITH TONOS" . 972)
+ ("GREEK SMALL LETTER UPSILON WITH TONOS" . 973)
+ ("GREEK SMALL LETTER OMEGA WITH TONOS" . 974)
+ ("GREEK BETA SYMBOL" . 976)
+ ("GREEK THETA SYMBOL" . 977)
+ ("GREEK UPSILON WITH HOOK SYMBOL" . 978)
+ ("GREEK UPSILON WITH ACUTE AND HOOK SYMBOL" . 979)
+ ("GREEK UPSILON WITH DIAERESIS AND HOOK SYMBOL" . 980)
+ ("GREEK PHI SYMBOL" . 981)
+ ("GREEK PI SYMBOL" . 982)
+ ("GREEK KAI SYMBOL" . 983)
+ ("GREEK LETTER ARCHAIC KOPPA" . 984)
+ ("GREEK SMALL LETTER ARCHAIC KOPPA" . 985)
+ ("GREEK LETTER STIGMA" . 986)
+ ("GREEK SMALL LETTER STIGMA" . 987)
+ ("GREEK LETTER DIGAMMA" . 988)
+ ("GREEK SMALL LETTER DIGAMMA" . 989)
+ ("GREEK LETTER KOPPA" . 990)
+ ("GREEK SMALL LETTER KOPPA" . 991)
+ ("GREEK LETTER SAMPI" . 992)
+ ("GREEK SMALL LETTER SAMPI" . 993)
+ ("COPTIC CAPITAL LETTER SHEI" . 994)
+ ("COPTIC SMALL LETTER SHEI" . 995)
+ ("COPTIC CAPITAL LETTER FEI" . 996)
+ ("COPTIC SMALL LETTER FEI" . 997)
+ ("COPTIC CAPITAL LETTER KHEI" . 998)
+ ("COPTIC SMALL LETTER KHEI" . 999)
+ ("COPTIC CAPITAL LETTER HORI" . 1000)
+ ("COPTIC SMALL LETTER HORI" . 1001)
+ ("COPTIC CAPITAL LETTER GANGIA" . 1002)
+ ("COPTIC SMALL LETTER GANGIA" . 1003)
+ ("COPTIC CAPITAL LETTER SHIMA" . 1004)
+ ("COPTIC SMALL LETTER SHIMA" . 1005)
+ ("COPTIC CAPITAL LETTER DEI" . 1006)
+ ("COPTIC SMALL LETTER DEI" . 1007)
+ ("GREEK KAPPA SYMBOL" . 1008)
+ ("GREEK RHO SYMBOL" . 1009)
+ ("GREEK LUNATE SIGMA SYMBOL" . 1010)
+ ("GREEK LETTER YOT" . 1011)
+ ("GREEK CAPITAL THETA SYMBOL" . 1012)
+ ("GREEK LUNATE EPSILON SYMBOL" . 1013)
+ ("GREEK REVERSED LUNATE EPSILON SYMBOL" . 1014)
+ ("CYRILLIC CAPITAL LETTER IE WITH GRAVE" . 1024)
+ ("CYRILLIC CAPITAL LETTER IO" . 1025)
+ ("CYRILLIC CAPITAL LETTER DJE" . 1026)
+ ("CYRILLIC CAPITAL LETTER GJE" . 1027)
+ ("CYRILLIC CAPITAL LETTER UKRAINIAN IE" . 1028)
+ ("CYRILLIC CAPITAL LETTER DZE" . 1029)
+ ("CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I" . 1030)
+ ("CYRILLIC CAPITAL LETTER YI" . 1031)
+ ("CYRILLIC CAPITAL LETTER JE" . 1032)
+ ("CYRILLIC CAPITAL LETTER LJE" . 1033)
+ ("CYRILLIC CAPITAL LETTER NJE" . 1034)
+ ("CYRILLIC CAPITAL LETTER TSHE" . 1035)
+ ("CYRILLIC CAPITAL LETTER KJE" . 1036)
+ ("CYRILLIC CAPITAL LETTER I WITH GRAVE" . 1037)
+ ("CYRILLIC CAPITAL LETTER SHORT U" . 1038)
+ ("CYRILLIC CAPITAL LETTER DZHE" . 1039)
+ ("CYRILLIC CAPITAL LETTER A" . 1040)
+ ("CYRILLIC CAPITAL LETTER BE" . 1041)
+ ("CYRILLIC CAPITAL LETTER VE" . 1042)
+ ("CYRILLIC CAPITAL LETTER GHE" . 1043)
+ ("CYRILLIC CAPITAL LETTER DE" . 1044)
+ ("CYRILLIC CAPITAL LETTER IE" . 1045)
+ ("CYRILLIC CAPITAL LETTER ZHE" . 1046)
+ ("CYRILLIC CAPITAL LETTER ZE" . 1047)
+ ("CYRILLIC CAPITAL LETTER I" . 1048)
+ ("CYRILLIC CAPITAL LETTER SHORT I" . 1049)
+ ("CYRILLIC CAPITAL LETTER KA" . 1050)
+ ("CYRILLIC CAPITAL LETTER EL" . 1051)
+ ("CYRILLIC CAPITAL LETTER EM" . 1052)
+ ("CYRILLIC CAPITAL LETTER EN" . 1053)
+ ("CYRILLIC CAPITAL LETTER O" . 1054)
+ ("CYRILLIC CAPITAL LETTER PE" . 1055)
+ ("CYRILLIC CAPITAL LETTER ER" . 1056)
+ ("CYRILLIC CAPITAL LETTER ES" . 1057)
+ ("CYRILLIC CAPITAL LETTER TE" . 1058)
+ ("CYRILLIC CAPITAL LETTER U" . 1059)
+ ("CYRILLIC CAPITAL LETTER EF" . 1060)
+ ("CYRILLIC CAPITAL LETTER HA" . 1061)
+ ("CYRILLIC CAPITAL LETTER TSE" . 1062)
+ ("CYRILLIC CAPITAL LETTER CHE" . 1063)
+ ("CYRILLIC CAPITAL LETTER SHA" . 1064)
+ ("CYRILLIC CAPITAL LETTER SHCHA" . 1065)
+ ("CYRILLIC CAPITAL LETTER HARD SIGN" . 1066)
+ ("CYRILLIC CAPITAL LETTER YERU" . 1067)
+ ("CYRILLIC CAPITAL LETTER SOFT SIGN" . 1068)
+ ("CYRILLIC CAPITAL LETTER E" . 1069)
+ ("CYRILLIC CAPITAL LETTER YU" . 1070)
+ ("CYRILLIC CAPITAL LETTER YA" . 1071)
+ ("CYRILLIC SMALL LETTER A" . 1072)
+ ("CYRILLIC SMALL LETTER BE" . 1073)
+ ("CYRILLIC SMALL LETTER VE" . 1074)
+ ("CYRILLIC SMALL LETTER GHE" . 1075)
+ ("CYRILLIC SMALL LETTER DE" . 1076)
+ ("CYRILLIC SMALL LETTER IE" . 1077)
+ ("CYRILLIC SMALL LETTER ZHE" . 1078)
+ ("CYRILLIC SMALL LETTER ZE" . 1079)
+ ("CYRILLIC SMALL LETTER I" . 1080)
+ ("CYRILLIC SMALL LETTER SHORT I" . 1081)
+ ("CYRILLIC SMALL LETTER KA" . 1082)
+ ("CYRILLIC SMALL LETTER EL" . 1083)
+ ("CYRILLIC SMALL LETTER EM" . 1084)
+ ("CYRILLIC SMALL LETTER EN" . 1085)
+ ("CYRILLIC SMALL LETTER O" . 1086)
+ ("CYRILLIC SMALL LETTER PE" . 1087)
+ ("CYRILLIC SMALL LETTER ER" . 1088)
+ ("CYRILLIC SMALL LETTER ES" . 1089)
+ ("CYRILLIC SMALL LETTER TE" . 1090)
+ ("CYRILLIC SMALL LETTER U" . 1091)
+ ("CYRILLIC SMALL LETTER EF" . 1092)
+ ("CYRILLIC SMALL LETTER HA" . 1093)
+ ("CYRILLIC SMALL LETTER TSE" . 1094)
+ ("CYRILLIC SMALL LETTER CHE" . 1095)
+ ("CYRILLIC SMALL LETTER SHA" . 1096)
+ ("CYRILLIC SMALL LETTER SHCHA" . 1097)
+ ("CYRILLIC SMALL LETTER HARD SIGN" . 1098)
+ ("CYRILLIC SMALL LETTER YERU" . 1099)
+ ("CYRILLIC SMALL LETTER SOFT SIGN" . 1100)
+ ("CYRILLIC SMALL LETTER E" . 1101)
+ ("CYRILLIC SMALL LETTER YU" . 1102)
+ ("CYRILLIC SMALL LETTER YA" . 1103)
+ ("CYRILLIC SMALL LETTER IE WITH GRAVE" . 1104)
+ ("CYRILLIC SMALL LETTER IO" . 1105)
+ ("CYRILLIC SMALL LETTER DJE" . 1106)
+ ("CYRILLIC SMALL LETTER GJE" . 1107)
+ ("CYRILLIC SMALL LETTER UKRAINIAN IE" . 1108)
+ ("CYRILLIC SMALL LETTER DZE" . 1109)
+ ("CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I" . 1110)
+ ("CYRILLIC SMALL LETTER YI" . 1111)
+ ("CYRILLIC SMALL LETTER JE" . 1112)
+ ("CYRILLIC SMALL LETTER LJE" . 1113)
+ ("CYRILLIC SMALL LETTER NJE" . 1114)
+ ("CYRILLIC SMALL LETTER TSHE" . 1115)
+ ("CYRILLIC SMALL LETTER KJE" . 1116)
+ ("CYRILLIC SMALL LETTER I WITH GRAVE" . 1117)
+ ("CYRILLIC SMALL LETTER SHORT U" . 1118)
+ ("CYRILLIC SMALL LETTER DZHE" . 1119)
+ ("CYRILLIC CAPITAL LETTER OMEGA" . 1120)
+ ("CYRILLIC SMALL LETTER OMEGA" . 1121)
+ ("CYRILLIC CAPITAL LETTER YAT" . 1122)
+ ("CYRILLIC SMALL LETTER YAT" . 1123)
+ ("CYRILLIC CAPITAL LETTER IOTIFIED E" . 1124)
+ ("CYRILLIC SMALL LETTER IOTIFIED E" . 1125)
+ ("CYRILLIC CAPITAL LETTER LITTLE YUS" . 1126)
+ ("CYRILLIC SMALL LETTER LITTLE YUS" . 1127)
+ ("CYRILLIC CAPITAL LETTER IOTIFIED LITTLE YUS" . 1128)
+ ("CYRILLIC SMALL LETTER IOTIFIED LITTLE YUS" . 1129)
+ ("CYRILLIC CAPITAL LETTER BIG YUS" . 1130)
+ ("CYRILLIC SMALL LETTER BIG YUS" . 1131)
+ ("CYRILLIC CAPITAL LETTER IOTIFIED BIG YUS" . 1132)
+ ("CYRILLIC SMALL LETTER IOTIFIED BIG YUS" . 1133)
+ ("CYRILLIC CAPITAL LETTER KSI" . 1134)
+ ("CYRILLIC SMALL LETTER KSI" . 1135)
+ ("CYRILLIC CAPITAL LETTER PSI" . 1136)
+ ("CYRILLIC SMALL LETTER PSI" . 1137)
+ ("CYRILLIC CAPITAL LETTER FITA" . 1138)
+ ("CYRILLIC SMALL LETTER FITA" . 1139)
+ ("CYRILLIC CAPITAL LETTER IZHITSA" . 1140)
+ ("CYRILLIC SMALL LETTER IZHITSA" . 1141)
+ ("CYRILLIC CAPITAL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT" . 1142)
+ ("CYRILLIC SMALL LETTER IZHITSA WITH DOUBLE GRAVE ACCENT" . 1143)
+ ("CYRILLIC CAPITAL LETTER UK" . 1144)
+ ("CYRILLIC SMALL LETTER UK" . 1145)
+ ("CYRILLIC CAPITAL LETTER ROUND OMEGA" . 1146)
+ ("CYRILLIC SMALL LETTER ROUND OMEGA" . 1147)
+ ("CYRILLIC CAPITAL LETTER OMEGA WITH TITLO" . 1148)
+ ("CYRILLIC SMALL LETTER OMEGA WITH TITLO" . 1149)
+ ("CYRILLIC CAPITAL LETTER OT" . 1150)
+ ("CYRILLIC SMALL LETTER OT" . 1151)
+ ("CYRILLIC CAPITAL LETTER KOPPA" . 1152)
+ ("CYRILLIC SMALL LETTER KOPPA" . 1153)
+ ("CYRILLIC THOUSANDS SIGN" . 1154)
+ ("COMBINING CYRILLIC TITLO" . 1155)
+ ("COMBINING CYRILLIC PALATALIZATION" . 1156)
+ ("COMBINING CYRILLIC DASIA PNEUMATA" . 1157)
+ ("COMBINING CYRILLIC PSILI PNEUMATA" . 1158)
+ ("COMBINING CYRILLIC HUNDRED THOUSANDS SIGN" . 1160)
+ ("COMBINING CYRILLIC MILLIONS SIGN" . 1161)
+ ("CYRILLIC CAPITAL LETTER SHORT I WITH TAIL" . 1162)
+ ("CYRILLIC SMALL LETTER SHORT I WITH TAIL" . 1163)
+ ("CYRILLIC CAPITAL LETTER SEMISOFT SIGN" . 1164)
+ ("CYRILLIC SMALL LETTER SEMISOFT SIGN" . 1165)
+ ("CYRILLIC CAPITAL LETTER ER WITH TICK" . 1166)
+ ("CYRILLIC SMALL LETTER ER WITH TICK" . 1167)
+ ("CYRILLIC CAPITAL LETTER GHE WITH UPTURN" . 1168)
+ ("CYRILLIC SMALL LETTER GHE WITH UPTURN" . 1169)
+ ("CYRILLIC CAPITAL LETTER GHE WITH STROKE" . 1170)
+ ("CYRILLIC SMALL LETTER GHE WITH STROKE" . 1171)
+ ("CYRILLIC CAPITAL LETTER GHE WITH MIDDLE HOOK" . 1172)
+ ("CYRILLIC SMALL LETTER GHE WITH MIDDLE HOOK" . 1173)
+ ("CYRILLIC CAPITAL LETTER ZHE WITH DESCENDER" . 1174)
+ ("CYRILLIC SMALL LETTER ZHE WITH DESCENDER" . 1175)
+ ("CYRILLIC CAPITAL LETTER ZE WITH DESCENDER" . 1176)
+ ("CYRILLIC SMALL LETTER ZE WITH DESCENDER" . 1177)
+ ("CYRILLIC CAPITAL LETTER KA WITH DESCENDER" . 1178)
+ ("CYRILLIC SMALL LETTER KA WITH DESCENDER" . 1179)
+ ("CYRILLIC CAPITAL LETTER KA WITH VERTICAL STROKE" . 1180)
+ ("CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE" . 1181)
+ ("CYRILLIC CAPITAL LETTER KA WITH STROKE" . 1182)
+ ("CYRILLIC SMALL LETTER KA WITH STROKE" . 1183)
+ ("CYRILLIC CAPITAL LETTER BASHKIR KA" . 1184)
+ ("CYRILLIC SMALL LETTER BASHKIR KA" . 1185)
+ ("CYRILLIC CAPITAL LETTER EN WITH DESCENDER" . 1186)
+ ("CYRILLIC SMALL LETTER EN WITH DESCENDER" . 1187)
+ ("CYRILLIC CAPITAL LIGATURE EN GHE" . 1188)
+ ("CYRILLIC SMALL LIGATURE EN GHE" . 1189)
+ ("CYRILLIC CAPITAL LETTER PE WITH MIDDLE HOOK" . 1190)
+ ("CYRILLIC SMALL LETTER PE WITH MIDDLE HOOK" . 1191)
+ ("CYRILLIC CAPITAL LETTER ABKHASIAN HA" . 1192)
+ ("CYRILLIC SMALL LETTER ABKHASIAN HA" . 1193)
+ ("CYRILLIC CAPITAL LETTER ES WITH DESCENDER" . 1194)
+ ("CYRILLIC SMALL LETTER ES WITH DESCENDER" . 1195)
+ ("CYRILLIC CAPITAL LETTER TE WITH DESCENDER" . 1196)
+ ("CYRILLIC SMALL LETTER TE WITH DESCENDER" . 1197)
+ ("CYRILLIC CAPITAL LETTER STRAIGHT U" . 1198)
+ ("CYRILLIC SMALL LETTER STRAIGHT U" . 1199)
+ ("CYRILLIC CAPITAL LETTER STRAIGHT U WITH STROKE" . 1200)
+ ("CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE" . 1201)
+ ("CYRILLIC CAPITAL LETTER HA WITH DESCENDER" . 1202)
+ ("CYRILLIC SMALL LETTER HA WITH DESCENDER" . 1203)
+ ("CYRILLIC CAPITAL LIGATURE TE TSE" . 1204)
+ ("CYRILLIC SMALL LIGATURE TE TSE" . 1205)
+ ("CYRILLIC CAPITAL LETTER CHE WITH DESCENDER" . 1206)
+ ("CYRILLIC SMALL LETTER CHE WITH DESCENDER" . 1207)
+ ("CYRILLIC CAPITAL LETTER CHE WITH VERTICAL STROKE" . 1208)
+ ("CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE" . 1209)
+ ("CYRILLIC CAPITAL LETTER SHHA" . 1210)
+ ("CYRILLIC SMALL LETTER SHHA" . 1211)
+ ("CYRILLIC CAPITAL LETTER ABKHASIAN CHE" . 1212)
+ ("CYRILLIC SMALL LETTER ABKHASIAN CHE" . 1213)
+ ("CYRILLIC CAPITAL LETTER ABKHASIAN CHE WITH DESCENDER" . 1214)
+ ("CYRILLIC SMALL LETTER ABKHASIAN CHE WITH DESCENDER" . 1215)
+ ("CYRILLIC LETTER PALOCHKA" . 1216)
+ ("CYRILLIC CAPITAL LETTER ZHE WITH BREVE" . 1217)
+ ("CYRILLIC SMALL LETTER ZHE WITH BREVE" . 1218)
+ ("CYRILLIC CAPITAL LETTER KA WITH HOOK" . 1219)
+ ("CYRILLIC SMALL LETTER KA WITH HOOK" . 1220)
+ ("CYRILLIC CAPITAL LETTER EL WITH TAIL" . 1221)
+ ("CYRILLIC SMALL LETTER EL WITH TAIL" . 1222)
+ ("CYRILLIC CAPITAL LETTER EN WITH HOOK" . 1223)
+ ("CYRILLIC SMALL LETTER EN WITH HOOK" . 1224)
+ ("CYRILLIC CAPITAL LETTER EN WITH TAIL" . 1225)
+ ("CYRILLIC SMALL LETTER EN WITH TAIL" . 1226)
+ ("CYRILLIC CAPITAL LETTER KHAKASSIAN CHE" . 1227)
+ ("CYRILLIC SMALL LETTER KHAKASSIAN CHE" . 1228)
+ ("CYRILLIC CAPITAL LETTER EM WITH TAIL" . 1229)
+ ("CYRILLIC SMALL LETTER EM WITH TAIL" . 1230)
+ ("CYRILLIC CAPITAL LETTER A WITH BREVE" . 1232)
+ ("CYRILLIC SMALL LETTER A WITH BREVE" . 1233)
+ ("CYRILLIC CAPITAL LETTER A WITH DIAERESIS" . 1234)
+ ("CYRILLIC SMALL LETTER A WITH DIAERESIS" . 1235)
+ ("CYRILLIC CAPITAL LIGATURE A IE" . 1236)
+ ("CYRILLIC SMALL LIGATURE A IE" . 1237)
+ ("CYRILLIC CAPITAL LETTER IE WITH BREVE" . 1238)
+ ("CYRILLIC SMALL LETTER IE WITH BREVE" . 1239)
+ ("CYRILLIC CAPITAL LETTER SCHWA" . 1240)
+ ("CYRILLIC SMALL LETTER SCHWA" . 1241)
+ ("CYRILLIC CAPITAL LETTER SCHWA WITH DIAERESIS" . 1242)
+ ("CYRILLIC SMALL LETTER SCHWA WITH DIAERESIS" . 1243)
+ ("CYRILLIC CAPITAL LETTER ZHE WITH DIAERESIS" . 1244)
+ ("CYRILLIC SMALL LETTER ZHE WITH DIAERESIS" . 1245)
+ ("CYRILLIC CAPITAL LETTER ZE WITH DIAERESIS" . 1246)
+ ("CYRILLIC SMALL LETTER ZE WITH DIAERESIS" . 1247)
+ ("CYRILLIC CAPITAL LETTER ABKHASIAN DZE" . 1248)
+ ("CYRILLIC SMALL LETTER ABKHASIAN DZE" . 1249)
+ ("CYRILLIC CAPITAL LETTER I WITH MACRON" . 1250)
+ ("CYRILLIC SMALL LETTER I WITH MACRON" . 1251)
+ ("CYRILLIC CAPITAL LETTER I WITH DIAERESIS" . 1252)
+ ("CYRILLIC SMALL LETTER I WITH DIAERESIS" . 1253)
+ ("CYRILLIC CAPITAL LETTER O WITH DIAERESIS" . 1254)
+ ("CYRILLIC SMALL LETTER O WITH DIAERESIS" . 1255)
+ ("CYRILLIC CAPITAL LETTER BARRED O" . 1256)
+ ("CYRILLIC SMALL LETTER BARRED O" . 1257)
+ ("CYRILLIC CAPITAL LETTER BARRED O WITH DIAERESIS" . 1258)
+ ("CYRILLIC SMALL LETTER BARRED O WITH DIAERESIS" . 1259)
+ ("CYRILLIC CAPITAL LETTER E WITH DIAERESIS" . 1260)
+ ("CYRILLIC SMALL LETTER E WITH DIAERESIS" . 1261)
+ ("CYRILLIC CAPITAL LETTER U WITH MACRON" . 1262)
+ ("CYRILLIC SMALL LETTER U WITH MACRON" . 1263)
+ ("CYRILLIC CAPITAL LETTER U WITH DIAERESIS" . 1264)
+ ("CYRILLIC SMALL LETTER U WITH DIAERESIS" . 1265)
+ ("CYRILLIC CAPITAL LETTER U WITH DOUBLE ACUTE" . 1266)
+ ("CYRILLIC SMALL LETTER U WITH DOUBLE ACUTE" . 1267)
+ ("CYRILLIC CAPITAL LETTER CHE WITH DIAERESIS" . 1268)
+ ("CYRILLIC SMALL LETTER CHE WITH DIAERESIS" . 1269)
+ ("CYRILLIC CAPITAL LETTER YERU WITH DIAERESIS" . 1272)
+ ("CYRILLIC SMALL LETTER YERU WITH DIAERESIS" . 1273)
+ ("CYRILLIC CAPITAL LETTER KOMI DE" . 1280)
+ ("CYRILLIC SMALL LETTER KOMI DE" . 1281)
+ ("CYRILLIC CAPITAL LETTER KOMI DJE" . 1282)
+ ("CYRILLIC SMALL LETTER KOMI DJE" . 1283)
+ ("CYRILLIC CAPITAL LETTER KOMI ZJE" . 1284)
+ ("CYRILLIC SMALL LETTER KOMI ZJE" . 1285)
+ ("CYRILLIC CAPITAL LETTER KOMI DZJE" . 1286)
+ ("CYRILLIC SMALL LETTER KOMI DZJE" . 1287)
+ ("CYRILLIC CAPITAL LETTER KOMI LJE" . 1288)
+ ("CYRILLIC SMALL LETTER KOMI LJE" . 1289)
+ ("CYRILLIC CAPITAL LETTER KOMI NJE" . 1290)
+ ("CYRILLIC SMALL LETTER KOMI NJE" . 1291)
+ ("CYRILLIC CAPITAL LETTER KOMI SJE" . 1292)
+ ("CYRILLIC SMALL LETTER KOMI SJE" . 1293)
+ ("CYRILLIC CAPITAL LETTER KOMI TJE" . 1294)
+ ("CYRILLIC SMALL LETTER KOMI TJE" . 1295)
+ ("ARMENIAN CAPITAL LETTER AYB" . 1329)
+ ("ARMENIAN CAPITAL LETTER BEN" . 1330)
+ ("ARMENIAN CAPITAL LETTER GIM" . 1331)
+ ("ARMENIAN CAPITAL LETTER DA" . 1332)
+ ("ARMENIAN CAPITAL LETTER ECH" . 1333)
+ ("ARMENIAN CAPITAL LETTER ZA" . 1334)
+ ("ARMENIAN CAPITAL LETTER EH" . 1335)
+ ("ARMENIAN CAPITAL LETTER ET" . 1336)
+ ("ARMENIAN CAPITAL LETTER TO" . 1337)
+ ("ARMENIAN CAPITAL LETTER ZHE" . 1338)
+ ("ARMENIAN CAPITAL LETTER INI" . 1339)
+ ("ARMENIAN CAPITAL LETTER LIWN" . 1340)
+ ("ARMENIAN CAPITAL LETTER XEH" . 1341)
+ ("ARMENIAN CAPITAL LETTER CA" . 1342)
+ ("ARMENIAN CAPITAL LETTER KEN" . 1343)
+ ("ARMENIAN CAPITAL LETTER HO" . 1344)
+ ("ARMENIAN CAPITAL LETTER JA" . 1345)
+ ("ARMENIAN CAPITAL LETTER GHAD" . 1346)
+ ("ARMENIAN CAPITAL LETTER CHEH" . 1347)
+ ("ARMENIAN CAPITAL LETTER MEN" . 1348)
+ ("ARMENIAN CAPITAL LETTER YI" . 1349)
+ ("ARMENIAN CAPITAL LETTER NOW" . 1350)
+ ("ARMENIAN CAPITAL LETTER SHA" . 1351)
+ ("ARMENIAN CAPITAL LETTER VO" . 1352)
+ ("ARMENIAN CAPITAL LETTER CHA" . 1353)
+ ("ARMENIAN CAPITAL LETTER PEH" . 1354)
+ ("ARMENIAN CAPITAL LETTER JHEH" . 1355)
+ ("ARMENIAN CAPITAL LETTER RA" . 1356)
+ ("ARMENIAN CAPITAL LETTER SEH" . 1357)
+ ("ARMENIAN CAPITAL LETTER VEW" . 1358)
+ ("ARMENIAN CAPITAL LETTER TIWN" . 1359)
+ ("ARMENIAN CAPITAL LETTER REH" . 1360)
+ ("ARMENIAN CAPITAL LETTER CO" . 1361)
+ ("ARMENIAN CAPITAL LETTER YIWN" . 1362)
+ ("ARMENIAN CAPITAL LETTER PIWR" . 1363)
+ ("ARMENIAN CAPITAL LETTER KEH" . 1364)
+ ("ARMENIAN CAPITAL LETTER OH" . 1365)
+ ("ARMENIAN CAPITAL LETTER FEH" . 1366)
+ ("ARMENIAN MODIFIER LETTER LEFT HALF RING" . 1369)
+ ("ARMENIAN APOSTROPHE" . 1370)
+ ("ARMENIAN EMPHASIS MARK" . 1371)
+ ("ARMENIAN EXCLAMATION MARK" . 1372)
+ ("ARMENIAN COMMA" . 1373)
+ ("ARMENIAN QUESTION MARK" . 1374)
+ ("ARMENIAN ABBREVIATION MARK" . 1375)
+ ("ARMENIAN SMALL LETTER AYB" . 1377)
+ ("ARMENIAN SMALL LETTER BEN" . 1378)
+ ("ARMENIAN SMALL LETTER GIM" . 1379)
+ ("ARMENIAN SMALL LETTER DA" . 1380)
+ ("ARMENIAN SMALL LETTER ECH" . 1381)
+ ("ARMENIAN SMALL LETTER ZA" . 1382)
+ ("ARMENIAN SMALL LETTER EH" . 1383)
+ ("ARMENIAN SMALL LETTER ET" . 1384)
+ ("ARMENIAN SMALL LETTER TO" . 1385)
+ ("ARMENIAN SMALL LETTER ZHE" . 1386)
+ ("ARMENIAN SMALL LETTER INI" . 1387)
+ ("ARMENIAN SMALL LETTER LIWN" . 1388)
+ ("ARMENIAN SMALL LETTER XEH" . 1389)
+ ("ARMENIAN SMALL LETTER CA" . 1390)
+ ("ARMENIAN SMALL LETTER KEN" . 1391)
+ ("ARMENIAN SMALL LETTER HO" . 1392)
+ ("ARMENIAN SMALL LETTER JA" . 1393)
+ ("ARMENIAN SMALL LETTER GHAD" . 1394)
+ ("ARMENIAN SMALL LETTER CHEH" . 1395)
+ ("ARMENIAN SMALL LETTER MEN" . 1396)
+ ("ARMENIAN SMALL LETTER YI" . 1397)
+ ("ARMENIAN SMALL LETTER NOW" . 1398)
+ ("ARMENIAN SMALL LETTER SHA" . 1399)
+ ("ARMENIAN SMALL LETTER VO" . 1400)
+ ("ARMENIAN SMALL LETTER CHA" . 1401)
+ ("ARMENIAN SMALL LETTER PEH" . 1402)
+ ("ARMENIAN SMALL LETTER JHEH" . 1403)
+ ("ARMENIAN SMALL LETTER RA" . 1404)
+ ("ARMENIAN SMALL LETTER SEH" . 1405)
+ ("ARMENIAN SMALL LETTER VEW" . 1406)
+ ("ARMENIAN SMALL LETTER TIWN" . 1407)
+ ("ARMENIAN SMALL LETTER REH" . 1408)
+ ("ARMENIAN SMALL LETTER CO" . 1409)
+ ("ARMENIAN SMALL LETTER YIWN" . 1410)
+ ("ARMENIAN SMALL LETTER PIWR" . 1411)
+ ("ARMENIAN SMALL LETTER KEH" . 1412)
+ ("ARMENIAN SMALL LETTER OH" . 1413)
+ ("ARMENIAN SMALL LETTER FEH" . 1414)
+ ("ARMENIAN SMALL LIGATURE ECH YIWN" . 1415)
+ ("ARMENIAN FULL STOP" . 1417)
+ ("ARMENIAN HYPHEN" . 1418)
+ ("HEBREW ACCENT ETNAHTA" . 1425)
+ ("HEBREW ACCENT SEGOL" . 1426)
+ ("HEBREW ACCENT SHALSHELET" . 1427)
+ ("HEBREW ACCENT ZAQEF QATAN" . 1428)
+ ("HEBREW ACCENT ZAQEF GADOL" . 1429)
+ ("HEBREW ACCENT TIPEHA" . 1430)
+ ("HEBREW ACCENT REVIA" . 1431)
+ ("HEBREW ACCENT ZARQA" . 1432)
+ ("HEBREW ACCENT PASHTA" . 1433)
+ ("HEBREW ACCENT YETIV" . 1434)
+ ("HEBREW ACCENT TEVIR" . 1435)
+ ("HEBREW ACCENT GERESH" . 1436)
+ ("HEBREW ACCENT GERESH MUQDAM" . 1437)
+ ("HEBREW ACCENT GERSHAYIM" . 1438)
+ ("HEBREW ACCENT QARNEY PARA" . 1439)
+ ("HEBREW ACCENT TELISHA GEDOLA" . 1440)
+ ("HEBREW ACCENT PAZER" . 1441)
+ ("HEBREW ACCENT MUNAH" . 1443)
+ ("HEBREW ACCENT MAHAPAKH" . 1444)
+ ("HEBREW ACCENT MERKHA" . 1445)
+ ("HEBREW ACCENT MERKHA KEFULA" . 1446)
+ ("HEBREW ACCENT DARGA" . 1447)
+ ("HEBREW ACCENT QADMA" . 1448)
+ ("HEBREW ACCENT TELISHA QETANA" . 1449)
+ ("HEBREW ACCENT YERAH BEN YOMO" . 1450)
+ ("HEBREW ACCENT OLE" . 1451)
+ ("HEBREW ACCENT ILUY" . 1452)
+ ("HEBREW ACCENT DEHI" . 1453)
+ ("HEBREW ACCENT ZINOR" . 1454)
+ ("HEBREW MARK MASORA CIRCLE" . 1455)
+ ("HEBREW POINT SHEVA" . 1456)
+ ("HEBREW POINT HATAF SEGOL" . 1457)
+ ("HEBREW POINT HATAF PATAH" . 1458)
+ ("HEBREW POINT HATAF QAMATS" . 1459)
+ ("HEBREW POINT HIRIQ" . 1460)
+ ("HEBREW POINT TSERE" . 1461)
+ ("HEBREW POINT SEGOL" . 1462)
+ ("HEBREW POINT PATAH" . 1463)
+ ("HEBREW POINT QAMATS" . 1464)
+ ("HEBREW POINT HOLAM" . 1465)
+ ("HEBREW POINT QUBUTS" . 1467)
+ ("HEBREW POINT DAGESH OR MAPIQ" . 1468)
+ ("HEBREW POINT METEG" . 1469)
+ ("HEBREW PUNCTUATION MAQAF" . 1470)
+ ("HEBREW POINT RAFE" . 1471)
+ ("HEBREW PUNCTUATION PASEQ" . 1472)
+ ("HEBREW POINT SHIN DOT" . 1473)
+ ("HEBREW POINT SIN DOT" . 1474)
+ ("HEBREW PUNCTUATION SOF PASUQ" . 1475)
+ ("HEBREW MARK UPPER DOT" . 1476)
+ ("HEBREW LETTER ALEF" . 1488)
+ ("HEBREW LETTER BET" . 1489)
+ ("HEBREW LETTER GIMEL" . 1490)
+ ("HEBREW LETTER DALET" . 1491)
+ ("HEBREW LETTER HE" . 1492)
+ ("HEBREW LETTER VAV" . 1493)
+ ("HEBREW LETTER ZAYIN" . 1494)
+ ("HEBREW LETTER HET" . 1495)
+ ("HEBREW LETTER TET" . 1496)
+ ("HEBREW LETTER YOD" . 1497)
+ ("HEBREW LETTER FINAL KAF" . 1498)
+ ("HEBREW LETTER KAF" . 1499)
+ ("HEBREW LETTER LAMED" . 1500)
+ ("HEBREW LETTER FINAL MEM" . 1501)
+ ("HEBREW LETTER MEM" . 1502)
+ ("HEBREW LETTER FINAL NUN" . 1503)
+ ("HEBREW LETTER NUN" . 1504)
+ ("HEBREW LETTER SAMEKH" . 1505)
+ ("HEBREW LETTER AYIN" . 1506)
+ ("HEBREW LETTER FINAL PE" . 1507)
+ ("HEBREW LETTER PE" . 1508)
+ ("HEBREW LETTER FINAL TSADI" . 1509)
+ ("HEBREW LETTER TSADI" . 1510)
+ ("HEBREW LETTER QOF" . 1511)
+ ("HEBREW LETTER RESH" . 1512)
+ ("HEBREW LETTER SHIN" . 1513)
+ ("HEBREW LETTER TAV" . 1514)
+ ("HEBREW LIGATURE YIDDISH DOUBLE VAV" . 1520)
+ ("HEBREW LIGATURE YIDDISH VAV YOD" . 1521)
+ ("HEBREW LIGATURE YIDDISH DOUBLE YOD" . 1522)
+ ("HEBREW PUNCTUATION GERESH" . 1523)
+ ("HEBREW PUNCTUATION GERSHAYIM" . 1524)
+ ("ARABIC COMMA" . 1548)
+ ("ARABIC SEMICOLON" . 1563)
+ ("ARABIC QUESTION MARK" . 1567)
+ ("ARABIC LETTER HAMZA" . 1569)
+ ("ARABIC LETTER ALEF WITH MADDA ABOVE" . 1570)
+ ("ARABIC LETTER ALEF WITH HAMZA ABOVE" . 1571)
+ ("ARABIC LETTER WAW WITH HAMZA ABOVE" . 1572)
+ ("ARABIC LETTER ALEF WITH HAMZA BELOW" . 1573)
+ ("ARABIC LETTER YEH WITH HAMZA ABOVE" . 1574)
+ ("ARABIC LETTER ALEF" . 1575)
+ ("ARABIC LETTER BEH" . 1576)
+ ("ARABIC LETTER TEH MARBUTA" . 1577)
+ ("ARABIC LETTER TEH" . 1578)
+ ("ARABIC LETTER THEH" . 1579)
+ ("ARABIC LETTER JEEM" . 1580)
+ ("ARABIC LETTER HAH" . 1581)
+ ("ARABIC LETTER KHAH" . 1582)
+ ("ARABIC LETTER DAL" . 1583)
+ ("ARABIC LETTER THAL" . 1584)
+ ("ARABIC LETTER REH" . 1585)
+ ("ARABIC LETTER ZAIN" . 1586)
+ ("ARABIC LETTER SEEN" . 1587)
+ ("ARABIC LETTER SHEEN" . 1588)
+ ("ARABIC LETTER SAD" . 1589)
+ ("ARABIC LETTER DAD" . 1590)
+ ("ARABIC LETTER TAH" . 1591)
+ ("ARABIC LETTER ZAH" . 1592)
+ ("ARABIC LETTER AIN" . 1593)
+ ("ARABIC LETTER GHAIN" . 1594)
+ ("ARABIC TATWEEL" . 1600)
+ ("ARABIC LETTER FEH" . 1601)
+ ("ARABIC LETTER QAF" . 1602)
+ ("ARABIC LETTER KAF" . 1603)
+ ("ARABIC LETTER LAM" . 1604)
+ ("ARABIC LETTER MEEM" . 1605)
+ ("ARABIC LETTER NOON" . 1606)
+ ("ARABIC LETTER HEH" . 1607)
+ ("ARABIC LETTER WAW" . 1608)
+ ("ARABIC LETTER ALEF MAKSURA" . 1609)
+ ("ARABIC LETTER YEH" . 1610)
+ ("ARABIC FATHATAN" . 1611)
+ ("ARABIC DAMMATAN" . 1612)
+ ("ARABIC KASRATAN" . 1613)
+ ("ARABIC FATHA" . 1614)
+ ("ARABIC DAMMA" . 1615)
+ ("ARABIC KASRA" . 1616)
+ ("ARABIC SHADDA" . 1617)
+ ("ARABIC SUKUN" . 1618)
+ ("ARABIC MADDAH ABOVE" . 1619)
+ ("ARABIC HAMZA ABOVE" . 1620)
+ ("ARABIC HAMZA BELOW" . 1621)
+ ("ARABIC-INDIC DIGIT ZERO" . 1632)
+ ("ARABIC-INDIC DIGIT ONE" . 1633)
+ ("ARABIC-INDIC DIGIT TWO" . 1634)
+ ("ARABIC-INDIC DIGIT THREE" . 1635)
+ ("ARABIC-INDIC DIGIT FOUR" . 1636)
+ ("ARABIC-INDIC DIGIT FIVE" . 1637)
+ ("ARABIC-INDIC DIGIT SIX" . 1638)
+ ("ARABIC-INDIC DIGIT SEVEN" . 1639)
+ ("ARABIC-INDIC DIGIT EIGHT" . 1640)
+ ("ARABIC-INDIC DIGIT NINE" . 1641)
+ ("ARABIC PERCENT SIGN" . 1642)
+ ("ARABIC DECIMAL SEPARATOR" . 1643)
+ ("ARABIC THOUSANDS SEPARATOR" . 1644)
+ ("ARABIC FIVE POINTED STAR" . 1645)
+ ("ARABIC LETTER DOTLESS BEH" . 1646)
+ ("ARABIC LETTER DOTLESS QAF" . 1647)
+ ("ARABIC LETTER SUPERSCRIPT ALEF" . 1648)
+ ("ARABIC LETTER ALEF WASLA" . 1649)
+ ("ARABIC LETTER ALEF WITH WAVY HAMZA ABOVE" . 1650)
+ ("ARABIC LETTER ALEF WITH WAVY HAMZA BELOW" . 1651)
+ ("ARABIC LETTER HIGH HAMZA" . 1652)
+ ("ARABIC LETTER HIGH HAMZA ALEF" . 1653)
+ ("ARABIC LETTER HIGH HAMZA WAW" . 1654)
+ ("ARABIC LETTER U WITH HAMZA ABOVE" . 1655)
+ ("ARABIC LETTER HIGH HAMZA YEH" . 1656)
+ ("ARABIC LETTER TTEH" . 1657)
+ ("ARABIC LETTER TTEHEH" . 1658)
+ ("ARABIC LETTER BEEH" . 1659)
+ ("ARABIC LETTER TEH WITH RING" . 1660)
+ ("ARABIC LETTER TEH WITH THREE DOTS ABOVE DOWNWARDS" . 1661)
+ ("ARABIC LETTER PEH" . 1662)
+ ("ARABIC LETTER TEHEH" . 1663)
+ ("ARABIC LETTER BEHEH" . 1664)
+ ("ARABIC LETTER HAH WITH HAMZA ABOVE" . 1665)
+ ("ARABIC LETTER HAH WITH TWO DOTS VERTICAL ABOVE" . 1666)
+ ("ARABIC LETTER NYEH" . 1667)
+ ("ARABIC LETTER DYEH" . 1668)
+ ("ARABIC LETTER HAH WITH THREE DOTS ABOVE" . 1669)
+ ("ARABIC LETTER TCHEH" . 1670)
+ ("ARABIC LETTER TCHEHEH" . 1671)
+ ("ARABIC LETTER DDAL" . 1672)
+ ("ARABIC LETTER DAL WITH RING" . 1673)
+ ("ARABIC LETTER DAL WITH DOT BELOW" . 1674)
+ ("ARABIC LETTER DAL WITH DOT BELOW AND SMALL TAH" . 1675)
+ ("ARABIC LETTER DAHAL" . 1676)
+ ("ARABIC LETTER DDAHAL" . 1677)
+ ("ARABIC LETTER DUL" . 1678)
+ ("ARABIC LETTER DAL WITH THREE DOTS ABOVE DOWNWARDS" . 1679)
+ ("ARABIC LETTER DAL WITH FOUR DOTS ABOVE" . 1680)
+ ("ARABIC LETTER RREH" . 1681)
+ ("ARABIC LETTER REH WITH SMALL V" . 1682)
+ ("ARABIC LETTER REH WITH RING" . 1683)
+ ("ARABIC LETTER REH WITH DOT BELOW" . 1684)
+ ("ARABIC LETTER REH WITH SMALL V BELOW" . 1685)
+ ("ARABIC LETTER REH WITH DOT BELOW AND DOT ABOVE" . 1686)
+ ("ARABIC LETTER REH WITH TWO DOTS ABOVE" . 1687)
+ ("ARABIC LETTER JEH" . 1688)
+ ("ARABIC LETTER REH WITH FOUR DOTS ABOVE" . 1689)
+ ("ARABIC LETTER SEEN WITH DOT BELOW AND DOT ABOVE" . 1690)
+ ("ARABIC LETTER SEEN WITH THREE DOTS BELOW" . 1691)
+ ("ARABIC LETTER SEEN WITH THREE DOTS BELOW AND THREE DOTS ABOVE" . 1692)
+ ("ARABIC LETTER SAD WITH TWO DOTS BELOW" . 1693)
+ ("ARABIC LETTER SAD WITH THREE DOTS ABOVE" . 1694)
+ ("ARABIC LETTER TAH WITH THREE DOTS ABOVE" . 1695)
+ ("ARABIC LETTER AIN WITH THREE DOTS ABOVE" . 1696)
+ ("ARABIC LETTER DOTLESS FEH" . 1697)
+ ("ARABIC LETTER FEH WITH DOT MOVED BELOW" . 1698)
+ ("ARABIC LETTER FEH WITH DOT BELOW" . 1699)
+ ("ARABIC LETTER VEH" . 1700)
+ ("ARABIC LETTER FEH WITH THREE DOTS BELOW" . 1701)
+ ("ARABIC LETTER PEHEH" . 1702)
+ ("ARABIC LETTER QAF WITH DOT ABOVE" . 1703)
+ ("ARABIC LETTER QAF WITH THREE DOTS ABOVE" . 1704)
+ ("ARABIC LETTER KEHEH" . 1705)
+ ("ARABIC LETTER SWASH KAF" . 1706)
+ ("ARABIC LETTER KAF WITH RING" . 1707)
+ ("ARABIC LETTER KAF WITH DOT ABOVE" . 1708)
+ ("ARABIC LETTER NG" . 1709)
+ ("ARABIC LETTER KAF WITH THREE DOTS BELOW" . 1710)
+ ("ARABIC LETTER GAF" . 1711)
+ ("ARABIC LETTER GAF WITH RING" . 1712)
+ ("ARABIC LETTER NGOEH" . 1713)
+ ("ARABIC LETTER GAF WITH TWO DOTS BELOW" . 1714)
+ ("ARABIC LETTER GUEH" . 1715)
+ ("ARABIC LETTER GAF WITH THREE DOTS ABOVE" . 1716)
+ ("ARABIC LETTER LAM WITH SMALL V" . 1717)
+ ("ARABIC LETTER LAM WITH DOT ABOVE" . 1718)
+ ("ARABIC LETTER LAM WITH THREE DOTS ABOVE" . 1719)
+ ("ARABIC LETTER LAM WITH THREE DOTS BELOW" . 1720)
+ ("ARABIC LETTER NOON WITH DOT BELOW" . 1721)
+ ("ARABIC LETTER NOON GHUNNA" . 1722)
+ ("ARABIC LETTER RNOON" . 1723)
+ ("ARABIC LETTER NOON WITH RING" . 1724)
+ ("ARABIC LETTER NOON WITH THREE DOTS ABOVE" . 1725)
+ ("ARABIC LETTER HEH DOACHASHMEE" . 1726)
+ ("ARABIC LETTER TCHEH WITH DOT ABOVE" . 1727)
+ ("ARABIC LETTER HEH WITH YEH ABOVE" . 1728)
+ ("ARABIC LETTER HEH GOAL" . 1729)
+ ("ARABIC LETTER HEH GOAL WITH HAMZA ABOVE" . 1730)
+ ("ARABIC LETTER TEH MARBUTA GOAL" . 1731)
+ ("ARABIC LETTER WAW WITH RING" . 1732)
+ ("ARABIC LETTER KIRGHIZ OE" . 1733)
+ ("ARABIC LETTER OE" . 1734)
+ ("ARABIC LETTER U" . 1735)
+ ("ARABIC LETTER YU" . 1736)
+ ("ARABIC LETTER KIRGHIZ YU" . 1737)
+ ("ARABIC LETTER WAW WITH TWO DOTS ABOVE" . 1738)
+ ("ARABIC LETTER VE" . 1739)
+ ("ARABIC LETTER FARSI YEH" . 1740)
+ ("ARABIC LETTER YEH WITH TAIL" . 1741)
+ ("ARABIC LETTER YEH WITH SMALL V" . 1742)
+ ("ARABIC LETTER WAW WITH DOT ABOVE" . 1743)
+ ("ARABIC LETTER E" . 1744)
+ ("ARABIC LETTER YEH WITH THREE DOTS BELOW" . 1745)
+ ("ARABIC LETTER YEH BARREE" . 1746)
+ ("ARABIC LETTER YEH BARREE WITH HAMZA ABOVE" . 1747)
+ ("ARABIC FULL STOP" . 1748)
+ ("ARABIC LETTER AE" . 1749)
+ ("ARABIC SMALL HIGH LIGATURE SAD WITH LAM WITH ALEF MAKSURA" . 1750)
+ ("ARABIC SMALL HIGH LIGATURE QAF WITH LAM WITH ALEF MAKSURA" . 1751)
+ ("ARABIC SMALL HIGH MEEM INITIAL FORM" . 1752)
+ ("ARABIC SMALL HIGH LAM ALEF" . 1753)
+ ("ARABIC SMALL HIGH JEEM" . 1754)
+ ("ARABIC SMALL HIGH THREE DOTS" . 1755)
+ ("ARABIC SMALL HIGH SEEN" . 1756)
+ ("ARABIC END OF AYAH" . 1757)
+ ("ARABIC START OF RUB EL HIZB" . 1758)
+ ("ARABIC SMALL HIGH ROUNDED ZERO" . 1759)
+ ("ARABIC SMALL HIGH UPRIGHT RECTANGULAR ZERO" . 1760)
+ ("ARABIC SMALL HIGH DOTLESS HEAD OF KHAH" . 1761)
+ ("ARABIC SMALL HIGH MEEM ISOLATED FORM" . 1762)
+ ("ARABIC SMALL LOW SEEN" . 1763)
+ ("ARABIC SMALL HIGH MADDA" . 1764)
+ ("ARABIC SMALL WAW" . 1765)
+ ("ARABIC SMALL YEH" . 1766)
+ ("ARABIC SMALL HIGH YEH" . 1767)
+ ("ARABIC SMALL HIGH NOON" . 1768)
+ ("ARABIC PLACE OF SAJDAH" . 1769)
+ ("ARABIC EMPTY CENTRE LOW STOP" . 1770)
+ ("ARABIC EMPTY CENTRE HIGH STOP" . 1771)
+ ("ARABIC ROUNDED HIGH STOP WITH FILLED CENTRE" . 1772)
+ ("ARABIC SMALL LOW MEEM" . 1773)
+ ("EXTENDED ARABIC-INDIC DIGIT ZERO" . 1776)
+ ("EXTENDED ARABIC-INDIC DIGIT ONE" . 1777)
+ ("EXTENDED ARABIC-INDIC DIGIT TWO" . 1778)
+ ("EXTENDED ARABIC-INDIC DIGIT THREE" . 1779)
+ ("EXTENDED ARABIC-INDIC DIGIT FOUR" . 1780)
+ ("EXTENDED ARABIC-INDIC DIGIT FIVE" . 1781)
+ ("EXTENDED ARABIC-INDIC DIGIT SIX" . 1782)
+ ("EXTENDED ARABIC-INDIC DIGIT SEVEN" . 1783)
+ ("EXTENDED ARABIC-INDIC DIGIT EIGHT" . 1784)
+ ("EXTENDED ARABIC-INDIC DIGIT NINE" . 1785)
+ ("ARABIC LETTER SHEEN WITH DOT BELOW" . 1786)
+ ("ARABIC LETTER DAD WITH DOT BELOW" . 1787)
+ ("ARABIC LETTER GHAIN WITH DOT BELOW" . 1788)
+ ("ARABIC SIGN SINDHI AMPERSAND" . 1789)
+ ("ARABIC SIGN SINDHI POSTPOSITION MEN" . 1790)
+ ("SYRIAC END OF PARAGRAPH" . 1792)
+ ("SYRIAC SUPRALINEAR FULL STOP" . 1793)
+ ("SYRIAC SUBLINEAR FULL STOP" . 1794)
+ ("SYRIAC SUPRALINEAR COLON" . 1795)
+ ("SYRIAC SUBLINEAR COLON" . 1796)
+ ("SYRIAC HORIZONTAL COLON" . 1797)
+ ("SYRIAC COLON SKEWED LEFT" . 1798)
+ ("SYRIAC COLON SKEWED RIGHT" . 1799)
+ ("SYRIAC SUPRALINEAR COLON SKEWED LEFT" . 1800)
+ ("SYRIAC SUBLINEAR COLON SKEWED RIGHT" . 1801)
+ ("SYRIAC CONTRACTION" . 1802)
+ ("SYRIAC HARKLEAN OBELUS" . 1803)
+ ("SYRIAC HARKLEAN METOBELUS" . 1804)
+ ("SYRIAC HARKLEAN ASTERISCUS" . 1805)
+ ("SYRIAC ABBREVIATION MARK" . 1807)
+ ("SYRIAC LETTER ALAPH" . 1808)
+ ("SYRIAC LETTER SUPERSCRIPT ALAPH" . 1809)
+ ("SYRIAC LETTER BETH" . 1810)
+ ("SYRIAC LETTER GAMAL" . 1811)
+ ("SYRIAC LETTER GAMAL GARSHUNI" . 1812)
+ ("SYRIAC LETTER DALATH" . 1813)
+ ("SYRIAC LETTER DOTLESS DALATH RISH" . 1814)
+ ("SYRIAC LETTER HE" . 1815)
+ ("SYRIAC LETTER WAW" . 1816)
+ ("SYRIAC LETTER ZAIN" . 1817)
+ ("SYRIAC LETTER HETH" . 1818)
+ ("SYRIAC LETTER TETH" . 1819)
+ ("SYRIAC LETTER TETH GARSHUNI" . 1820)
+ ("SYRIAC LETTER YUDH" . 1821)
+ ("SYRIAC LETTER YUDH HE" . 1822)
+ ("SYRIAC LETTER KAPH" . 1823)
+ ("SYRIAC LETTER LAMADH" . 1824)
+ ("SYRIAC LETTER MIM" . 1825)
+ ("SYRIAC LETTER NUN" . 1826)
+ ("SYRIAC LETTER SEMKATH" . 1827)
+ ("SYRIAC LETTER FINAL SEMKATH" . 1828)
+ ("SYRIAC LETTER E" . 1829)
+ ("SYRIAC LETTER PE" . 1830)
+ ("SYRIAC LETTER REVERSED PE" . 1831)
+ ("SYRIAC LETTER SADHE" . 1832)
+ ("SYRIAC LETTER QAPH" . 1833)
+ ("SYRIAC LETTER RISH" . 1834)
+ ("SYRIAC LETTER SHIN" . 1835)
+ ("SYRIAC LETTER TAW" . 1836)
+ ("SYRIAC PTHAHA ABOVE" . 1840)
+ ("SYRIAC PTHAHA BELOW" . 1841)
+ ("SYRIAC PTHAHA DOTTED" . 1842)
+ ("SYRIAC ZQAPHA ABOVE" . 1843)
+ ("SYRIAC ZQAPHA BELOW" . 1844)
+ ("SYRIAC ZQAPHA DOTTED" . 1845)
+ ("SYRIAC RBASA ABOVE" . 1846)
+ ("SYRIAC RBASA BELOW" . 1847)
+ ("SYRIAC DOTTED ZLAMA HORIZONTAL" . 1848)
+ ("SYRIAC DOTTED ZLAMA ANGULAR" . 1849)
+ ("SYRIAC HBASA ABOVE" . 1850)
+ ("SYRIAC HBASA BELOW" . 1851)
+ ("SYRIAC HBASA-ESASA DOTTED" . 1852)
+ ("SYRIAC ESASA ABOVE" . 1853)
+ ("SYRIAC ESASA BELOW" . 1854)
+ ("SYRIAC RWAHA" . 1855)
+ ("SYRIAC FEMININE DOT" . 1856)
+ ("SYRIAC QUSHSHAYA" . 1857)
+ ("SYRIAC RUKKAKHA" . 1858)
+ ("SYRIAC TWO VERTICAL DOTS ABOVE" . 1859)
+ ("SYRIAC TWO VERTICAL DOTS BELOW" . 1860)
+ ("SYRIAC THREE DOTS ABOVE" . 1861)
+ ("SYRIAC THREE DOTS BELOW" . 1862)
+ ("SYRIAC OBLIQUE LINE ABOVE" . 1863)
+ ("SYRIAC OBLIQUE LINE BELOW" . 1864)
+ ("SYRIAC MUSIC" . 1865)
+ ("SYRIAC BARREKH" . 1866)
+ ("THAANA LETTER HAA" . 1920)
+ ("THAANA LETTER SHAVIYANI" . 1921)
+ ("THAANA LETTER NOONU" . 1922)
+ ("THAANA LETTER RAA" . 1923)
+ ("THAANA LETTER BAA" . 1924)
+ ("THAANA LETTER LHAVIYANI" . 1925)
+ ("THAANA LETTER KAAFU" . 1926)
+ ("THAANA LETTER ALIFU" . 1927)
+ ("THAANA LETTER VAAVU" . 1928)
+ ("THAANA LETTER MEEMU" . 1929)
+ ("THAANA LETTER FAAFU" . 1930)
+ ("THAANA LETTER DHAALU" . 1931)
+ ("THAANA LETTER THAA" . 1932)
+ ("THAANA LETTER LAAMU" . 1933)
+ ("THAANA LETTER GAAFU" . 1934)
+ ("THAANA LETTER GNAVIYANI" . 1935)
+ ("THAANA LETTER SEENU" . 1936)
+ ("THAANA LETTER DAVIYANI" . 1937)
+ ("THAANA LETTER ZAVIYANI" . 1938)
+ ("THAANA LETTER TAVIYANI" . 1939)
+ ("THAANA LETTER YAA" . 1940)
+ ("THAANA LETTER PAVIYANI" . 1941)
+ ("THAANA LETTER JAVIYANI" . 1942)
+ ("THAANA LETTER CHAVIYANI" . 1943)
+ ("THAANA LETTER TTAA" . 1944)
+ ("THAANA LETTER HHAA" . 1945)
+ ("THAANA LETTER KHAA" . 1946)
+ ("THAANA LETTER THAALU" . 1947)
+ ("THAANA LETTER ZAA" . 1948)
+ ("THAANA LETTER SHEENU" . 1949)
+ ("THAANA LETTER SAADHU" . 1950)
+ ("THAANA LETTER DAADHU" . 1951)
+ ("THAANA LETTER TO" . 1952)
+ ("THAANA LETTER ZO" . 1953)
+ ("THAANA LETTER AINU" . 1954)
+ ("THAANA LETTER GHAINU" . 1955)
+ ("THAANA LETTER QAAFU" . 1956)
+ ("THAANA LETTER WAAVU" . 1957)
+ ("THAANA ABAFILI" . 1958)
+ ("THAANA AABAAFILI" . 1959)
+ ("THAANA IBIFILI" . 1960)
+ ("THAANA EEBEEFILI" . 1961)
+ ("THAANA UBUFILI" . 1962)
+ ("THAANA OOBOOFILI" . 1963)
+ ("THAANA EBEFILI" . 1964)
+ ("THAANA EYBEYFILI" . 1965)
+ ("THAANA OBOFILI" . 1966)
+ ("THAANA OABOAFILI" . 1967)
+ ("THAANA SUKUN" . 1968)
+ ("THAANA LETTER NAA" . 1969)
+ ("DEVANAGARI SIGN CANDRABINDU" . 2305)
+ ("DEVANAGARI SIGN ANUSVARA" . 2306)
+ ("DEVANAGARI SIGN VISARGA" . 2307)
+ ("DEVANAGARI LETTER A" . 2309)
+ ("DEVANAGARI LETTER AA" . 2310)
+ ("DEVANAGARI LETTER I" . 2311)
+ ("DEVANAGARI LETTER II" . 2312)
+ ("DEVANAGARI LETTER U" . 2313)
+ ("DEVANAGARI LETTER UU" . 2314)
+ ("DEVANAGARI LETTER VOCALIC R" . 2315)
+ ("DEVANAGARI LETTER VOCALIC L" . 2316)
+ ("DEVANAGARI LETTER CANDRA E" . 2317)
+ ("DEVANAGARI LETTER SHORT E" . 2318)
+ ("DEVANAGARI LETTER E" . 2319)
+ ("DEVANAGARI LETTER AI" . 2320)
+ ("DEVANAGARI LETTER CANDRA O" . 2321)
+ ("DEVANAGARI LETTER SHORT O" . 2322)
+ ("DEVANAGARI LETTER O" . 2323)
+ ("DEVANAGARI LETTER AU" . 2324)
+ ("DEVANAGARI LETTER KA" . 2325)
+ ("DEVANAGARI LETTER KHA" . 2326)
+ ("DEVANAGARI LETTER GA" . 2327)
+ ("DEVANAGARI LETTER GHA" . 2328)
+ ("DEVANAGARI LETTER NGA" . 2329)
+ ("DEVANAGARI LETTER CA" . 2330)
+ ("DEVANAGARI LETTER CHA" . 2331)
+ ("DEVANAGARI LETTER JA" . 2332)
+ ("DEVANAGARI LETTER JHA" . 2333)
+ ("DEVANAGARI LETTER NYA" . 2334)
+ ("DEVANAGARI LETTER TTA" . 2335)
+ ("DEVANAGARI LETTER TTHA" . 2336)
+ ("DEVANAGARI LETTER DDA" . 2337)
+ ("DEVANAGARI LETTER DDHA" . 2338)
+ ("DEVANAGARI LETTER NNA" . 2339)
+ ("DEVANAGARI LETTER TA" . 2340)
+ ("DEVANAGARI LETTER THA" . 2341)
+ ("DEVANAGARI LETTER DA" . 2342)
+ ("DEVANAGARI LETTER DHA" . 2343)
+ ("DEVANAGARI LETTER NA" . 2344)
+ ("DEVANAGARI LETTER NNNA" . 2345)
+ ("DEVANAGARI LETTER PA" . 2346)
+ ("DEVANAGARI LETTER PHA" . 2347)
+ ("DEVANAGARI LETTER BA" . 2348)
+ ("DEVANAGARI LETTER BHA" . 2349)
+ ("DEVANAGARI LETTER MA" . 2350)
+ ("DEVANAGARI LETTER YA" . 2351)
+ ("DEVANAGARI LETTER RA" . 2352)
+ ("DEVANAGARI LETTER RRA" . 2353)
+ ("DEVANAGARI LETTER LA" . 2354)
+ ("DEVANAGARI LETTER LLA" . 2355)
+ ("DEVANAGARI LETTER LLLA" . 2356)
+ ("DEVANAGARI LETTER VA" . 2357)
+ ("DEVANAGARI LETTER SHA" . 2358)
+ ("DEVANAGARI LETTER SSA" . 2359)
+ ("DEVANAGARI LETTER SA" . 2360)
+ ("DEVANAGARI LETTER HA" . 2361)
+ ("DEVANAGARI SIGN NUKTA" . 2364)
+ ("DEVANAGARI SIGN AVAGRAHA" . 2365)
+ ("DEVANAGARI VOWEL SIGN AA" . 2366)
+ ("DEVANAGARI VOWEL SIGN I" . 2367)
+ ("DEVANAGARI VOWEL SIGN II" . 2368)
+ ("DEVANAGARI VOWEL SIGN U" . 2369)
+ ("DEVANAGARI VOWEL SIGN UU" . 2370)
+ ("DEVANAGARI VOWEL SIGN VOCALIC R" . 2371)
+ ("DEVANAGARI VOWEL SIGN VOCALIC RR" . 2372)
+ ("DEVANAGARI VOWEL SIGN CANDRA E" . 2373)
+ ("DEVANAGARI VOWEL SIGN SHORT E" . 2374)
+ ("DEVANAGARI VOWEL SIGN E" . 2375)
+ ("DEVANAGARI VOWEL SIGN AI" . 2376)
+ ("DEVANAGARI VOWEL SIGN CANDRA O" . 2377)
+ ("DEVANAGARI VOWEL SIGN SHORT O" . 2378)
+ ("DEVANAGARI VOWEL SIGN O" . 2379)
+ ("DEVANAGARI VOWEL SIGN AU" . 2380)
+ ("DEVANAGARI SIGN VIRAMA" . 2381)
+ ("DEVANAGARI OM" . 2384)
+ ("DEVANAGARI STRESS SIGN UDATTA" . 2385)
+ ("DEVANAGARI STRESS SIGN ANUDATTA" . 2386)
+ ("DEVANAGARI GRAVE ACCENT" . 2387)
+ ("DEVANAGARI ACUTE ACCENT" . 2388)
+ ("DEVANAGARI LETTER QA" . 2392)
+ ("DEVANAGARI LETTER KHHA" . 2393)
+ ("DEVANAGARI LETTER GHHA" . 2394)
+ ("DEVANAGARI LETTER ZA" . 2395)
+ ("DEVANAGARI LETTER DDDHA" . 2396)
+ ("DEVANAGARI LETTER RHA" . 2397)
+ ("DEVANAGARI LETTER FA" . 2398)
+ ("DEVANAGARI LETTER YYA" . 2399)
+ ("DEVANAGARI LETTER VOCALIC RR" . 2400)
+ ("DEVANAGARI LETTER VOCALIC LL" . 2401)
+ ("DEVANAGARI VOWEL SIGN VOCALIC L" . 2402)
+ ("DEVANAGARI VOWEL SIGN VOCALIC LL" . 2403)
+ ("DEVANAGARI DANDA" . 2404)
+ ("DEVANAGARI DOUBLE DANDA" . 2405)
+ ("DEVANAGARI DIGIT ZERO" . 2406)
+ ("DEVANAGARI DIGIT ONE" . 2407)
+ ("DEVANAGARI DIGIT TWO" . 2408)
+ ("DEVANAGARI DIGIT THREE" . 2409)
+ ("DEVANAGARI DIGIT FOUR" . 2410)
+ ("DEVANAGARI DIGIT FIVE" . 2411)
+ ("DEVANAGARI DIGIT SIX" . 2412)
+ ("DEVANAGARI DIGIT SEVEN" . 2413)
+ ("DEVANAGARI DIGIT EIGHT" . 2414)
+ ("DEVANAGARI DIGIT NINE" . 2415)
+ ("DEVANAGARI ABBREVIATION SIGN" . 2416)
+ ("BENGALI SIGN CANDRABINDU" . 2433)
+ ("BENGALI SIGN ANUSVARA" . 2434)
+ ("BENGALI SIGN VISARGA" . 2435)
+ ("BENGALI LETTER A" . 2437)
+ ("BENGALI LETTER AA" . 2438)
+ ("BENGALI LETTER I" . 2439)
+ ("BENGALI LETTER II" . 2440)
+ ("BENGALI LETTER U" . 2441)
+ ("BENGALI LETTER UU" . 2442)
+ ("BENGALI LETTER VOCALIC R" . 2443)
+ ("BENGALI LETTER VOCALIC L" . 2444)
+ ("BENGALI LETTER E" . 2447)
+ ("BENGALI LETTER AI" . 2448)
+ ("BENGALI LETTER O" . 2451)
+ ("BENGALI LETTER AU" . 2452)
+ ("BENGALI LETTER KA" . 2453)
+ ("BENGALI LETTER KHA" . 2454)
+ ("BENGALI LETTER GA" . 2455)
+ ("BENGALI LETTER GHA" . 2456)
+ ("BENGALI LETTER NGA" . 2457)
+ ("BENGALI LETTER CA" . 2458)
+ ("BENGALI LETTER CHA" . 2459)
+ ("BENGALI LETTER JA" . 2460)
+ ("BENGALI LETTER JHA" . 2461)
+ ("BENGALI LETTER NYA" . 2462)
+ ("BENGALI LETTER TTA" . 2463)
+ ("BENGALI LETTER TTHA" . 2464)
+ ("BENGALI LETTER DDA" . 2465)
+ ("BENGALI LETTER DDHA" . 2466)
+ ("BENGALI LETTER NNA" . 2467)
+ ("BENGALI LETTER TA" . 2468)
+ ("BENGALI LETTER THA" . 2469)
+ ("BENGALI LETTER DA" . 2470)
+ ("BENGALI LETTER DHA" . 2471)
+ ("BENGALI LETTER NA" . 2472)
+ ("BENGALI LETTER PA" . 2474)
+ ("BENGALI LETTER PHA" . 2475)
+ ("BENGALI LETTER BA" . 2476)
+ ("BENGALI LETTER BHA" . 2477)
+ ("BENGALI LETTER MA" . 2478)
+ ("BENGALI LETTER YA" . 2479)
+ ("BENGALI LETTER RA" . 2480)
+ ("BENGALI LETTER LA" . 2482)
+ ("BENGALI LETTER SHA" . 2486)
+ ("BENGALI LETTER SSA" . 2487)
+ ("BENGALI LETTER SA" . 2488)
+ ("BENGALI LETTER HA" . 2489)
+ ("BENGALI SIGN NUKTA" . 2492)
+ ("BENGALI VOWEL SIGN AA" . 2494)
+ ("BENGALI VOWEL SIGN I" . 2495)
+ ("BENGALI VOWEL SIGN II" . 2496)
+ ("BENGALI VOWEL SIGN U" . 2497)
+ ("BENGALI VOWEL SIGN UU" . 2498)
+ ("BENGALI VOWEL SIGN VOCALIC R" . 2499)
+ ("BENGALI VOWEL SIGN VOCALIC RR" . 2500)
+ ("BENGALI VOWEL SIGN E" . 2503)
+ ("BENGALI VOWEL SIGN AI" . 2504)
+ ("BENGALI VOWEL SIGN O" . 2507)
+ ("BENGALI VOWEL SIGN AU" . 2508)
+ ("BENGALI SIGN VIRAMA" . 2509)
+ ("BENGALI AU LENGTH MARK" . 2519)
+ ("BENGALI LETTER RRA" . 2524)
+ ("BENGALI LETTER RHA" . 2525)
+ ("BENGALI LETTER YYA" . 2527)
+ ("BENGALI LETTER VOCALIC RR" . 2528)
+ ("BENGALI LETTER VOCALIC LL" . 2529)
+ ("BENGALI VOWEL SIGN VOCALIC L" . 2530)
+ ("BENGALI VOWEL SIGN VOCALIC LL" . 2531)
+ ("BENGALI DIGIT ZERO" . 2534)
+ ("BENGALI DIGIT ONE" . 2535)
+ ("BENGALI DIGIT TWO" . 2536)
+ ("BENGALI DIGIT THREE" . 2537)
+ ("BENGALI DIGIT FOUR" . 2538)
+ ("BENGALI DIGIT FIVE" . 2539)
+ ("BENGALI DIGIT SIX" . 2540)
+ ("BENGALI DIGIT SEVEN" . 2541)
+ ("BENGALI DIGIT EIGHT" . 2542)
+ ("BENGALI DIGIT NINE" . 2543)
+ ("BENGALI LETTER RA WITH MIDDLE DIAGONAL" . 2544)
+ ("BENGALI LETTER RA WITH LOWER DIAGONAL" . 2545)
+ ("BENGALI RUPEE MARK" . 2546)
+ ("BENGALI RUPEE SIGN" . 2547)
+ ("BENGALI CURRENCY NUMERATOR ONE" . 2548)
+ ("BENGALI CURRENCY NUMERATOR TWO" . 2549)
+ ("BENGALI CURRENCY NUMERATOR THREE" . 2550)
+ ("BENGALI CURRENCY NUMERATOR FOUR" . 2551)
+ ("BENGALI CURRENCY NUMERATOR ONE LESS THAN THE DENOMINATOR" . 2552)
+ ("BENGALI CURRENCY DENOMINATOR SIXTEEN" . 2553)
+ ("BENGALI ISSHAR" . 2554)
+ ("GURMUKHI SIGN BINDI" . 2562)
+ ("GURMUKHI LETTER A" . 2565)
+ ("GURMUKHI LETTER AA" . 2566)
+ ("GURMUKHI LETTER I" . 2567)
+ ("GURMUKHI LETTER II" . 2568)
+ ("GURMUKHI LETTER U" . 2569)
+ ("GURMUKHI LETTER UU" . 2570)
+ ("GURMUKHI LETTER EE" . 2575)
+ ("GURMUKHI LETTER AI" . 2576)
+ ("GURMUKHI LETTER OO" . 2579)
+ ("GURMUKHI LETTER AU" . 2580)
+ ("GURMUKHI LETTER KA" . 2581)
+ ("GURMUKHI LETTER KHA" . 2582)
+ ("GURMUKHI LETTER GA" . 2583)
+ ("GURMUKHI LETTER GHA" . 2584)
+ ("GURMUKHI LETTER NGA" . 2585)
+ ("GURMUKHI LETTER CA" . 2586)
+ ("GURMUKHI LETTER CHA" . 2587)
+ ("GURMUKHI LETTER JA" . 2588)
+ ("GURMUKHI LETTER JHA" . 2589)
+ ("GURMUKHI LETTER NYA" . 2590)
+ ("GURMUKHI LETTER TTA" . 2591)
+ ("GURMUKHI LETTER TTHA" . 2592)
+ ("GURMUKHI LETTER DDA" . 2593)
+ ("GURMUKHI LETTER DDHA" . 2594)
+ ("GURMUKHI LETTER NNA" . 2595)
+ ("GURMUKHI LETTER TA" . 2596)
+ ("GURMUKHI LETTER THA" . 2597)
+ ("GURMUKHI LETTER DA" . 2598)
+ ("GURMUKHI LETTER DHA" . 2599)
+ ("GURMUKHI LETTER NA" . 2600)
+ ("GURMUKHI LETTER PA" . 2602)
+ ("GURMUKHI LETTER PHA" . 2603)
+ ("GURMUKHI LETTER BA" . 2604)
+ ("GURMUKHI LETTER BHA" . 2605)
+ ("GURMUKHI LETTER MA" . 2606)
+ ("GURMUKHI LETTER YA" . 2607)
+ ("GURMUKHI LETTER RA" . 2608)
+ ("GURMUKHI LETTER LA" . 2610)
+ ("GURMUKHI LETTER LLA" . 2611)
+ ("GURMUKHI LETTER VA" . 2613)
+ ("GURMUKHI LETTER SHA" . 2614)
+ ("GURMUKHI LETTER SA" . 2616)
+ ("GURMUKHI LETTER HA" . 2617)
+ ("GURMUKHI SIGN NUKTA" . 2620)
+ ("GURMUKHI VOWEL SIGN AA" . 2622)
+ ("GURMUKHI VOWEL SIGN I" . 2623)
+ ("GURMUKHI VOWEL SIGN II" . 2624)
+ ("GURMUKHI VOWEL SIGN U" . 2625)
+ ("GURMUKHI VOWEL SIGN UU" . 2626)
+ ("GURMUKHI VOWEL SIGN EE" . 2631)
+ ("GURMUKHI VOWEL SIGN AI" . 2632)
+ ("GURMUKHI VOWEL SIGN OO" . 2635)
+ ("GURMUKHI VOWEL SIGN AU" . 2636)
+ ("GURMUKHI SIGN VIRAMA" . 2637)
+ ("GURMUKHI LETTER KHHA" . 2649)
+ ("GURMUKHI LETTER GHHA" . 2650)
+ ("GURMUKHI LETTER ZA" . 2651)
+ ("GURMUKHI LETTER RRA" . 2652)
+ ("GURMUKHI LETTER FA" . 2654)
+ ("GURMUKHI DIGIT ZERO" . 2662)
+ ("GURMUKHI DIGIT ONE" . 2663)
+ ("GURMUKHI DIGIT TWO" . 2664)
+ ("GURMUKHI DIGIT THREE" . 2665)
+ ("GURMUKHI DIGIT FOUR" . 2666)
+ ("GURMUKHI DIGIT FIVE" . 2667)
+ ("GURMUKHI DIGIT SIX" . 2668)
+ ("GURMUKHI DIGIT SEVEN" . 2669)
+ ("GURMUKHI DIGIT EIGHT" . 2670)
+ ("GURMUKHI DIGIT NINE" . 2671)
+ ("GURMUKHI TIPPI" . 2672)
+ ("GURMUKHI ADDAK" . 2673)
+ ("GURMUKHI IRI" . 2674)
+ ("GURMUKHI URA" . 2675)
+ ("GURMUKHI EK ONKAR" . 2676)
+ ("GUJARATI SIGN CANDRABINDU" . 2689)
+ ("GUJARATI SIGN ANUSVARA" . 2690)
+ ("GUJARATI SIGN VISARGA" . 2691)
+ ("GUJARATI LETTER A" . 2693)
+ ("GUJARATI LETTER AA" . 2694)
+ ("GUJARATI LETTER I" . 2695)
+ ("GUJARATI LETTER II" . 2696)
+ ("GUJARATI LETTER U" . 2697)
+ ("GUJARATI LETTER UU" . 2698)
+ ("GUJARATI LETTER VOCALIC R" . 2699)
+ ("GUJARATI VOWEL CANDRA E" . 2701)
+ ("GUJARATI LETTER E" . 2703)
+ ("GUJARATI LETTER AI" . 2704)
+ ("GUJARATI VOWEL CANDRA O" . 2705)
+ ("GUJARATI LETTER O" . 2707)
+ ("GUJARATI LETTER AU" . 2708)
+ ("GUJARATI LETTER KA" . 2709)
+ ("GUJARATI LETTER KHA" . 2710)
+ ("GUJARATI LETTER GA" . 2711)
+ ("GUJARATI LETTER GHA" . 2712)
+ ("GUJARATI LETTER NGA" . 2713)
+ ("GUJARATI LETTER CA" . 2714)
+ ("GUJARATI LETTER CHA" . 2715)
+ ("GUJARATI LETTER JA" . 2716)
+ ("GUJARATI LETTER JHA" . 2717)
+ ("GUJARATI LETTER NYA" . 2718)
+ ("GUJARATI LETTER TTA" . 2719)
+ ("GUJARATI LETTER TTHA" . 2720)
+ ("GUJARATI LETTER DDA" . 2721)
+ ("GUJARATI LETTER DDHA" . 2722)
+ ("GUJARATI LETTER NNA" . 2723)
+ ("GUJARATI LETTER TA" . 2724)
+ ("GUJARATI LETTER THA" . 2725)
+ ("GUJARATI LETTER DA" . 2726)
+ ("GUJARATI LETTER DHA" . 2727)
+ ("GUJARATI LETTER NA" . 2728)
+ ("GUJARATI LETTER PA" . 2730)
+ ("GUJARATI LETTER PHA" . 2731)
+ ("GUJARATI LETTER BA" . 2732)
+ ("GUJARATI LETTER BHA" . 2733)
+ ("GUJARATI LETTER MA" . 2734)
+ ("GUJARATI LETTER YA" . 2735)
+ ("GUJARATI LETTER RA" . 2736)
+ ("GUJARATI LETTER LA" . 2738)
+ ("GUJARATI LETTER LLA" . 2739)
+ ("GUJARATI LETTER VA" . 2741)
+ ("GUJARATI LETTER SHA" . 2742)
+ ("GUJARATI LETTER SSA" . 2743)
+ ("GUJARATI LETTER SA" . 2744)
+ ("GUJARATI LETTER HA" . 2745)
+ ("GUJARATI SIGN NUKTA" . 2748)
+ ("GUJARATI SIGN AVAGRAHA" . 2749)
+ ("GUJARATI VOWEL SIGN AA" . 2750)
+ ("GUJARATI VOWEL SIGN I" . 2751)
+ ("GUJARATI VOWEL SIGN II" . 2752)
+ ("GUJARATI VOWEL SIGN U" . 2753)
+ ("GUJARATI VOWEL SIGN UU" . 2754)
+ ("GUJARATI VOWEL SIGN VOCALIC R" . 2755)
+ ("GUJARATI VOWEL SIGN VOCALIC RR" . 2756)
+ ("GUJARATI VOWEL SIGN CANDRA E" . 2757)
+ ("GUJARATI VOWEL SIGN E" . 2759)
+ ("GUJARATI VOWEL SIGN AI" . 2760)
+ ("GUJARATI VOWEL SIGN CANDRA O" . 2761)
+ ("GUJARATI VOWEL SIGN O" . 2763)
+ ("GUJARATI VOWEL SIGN AU" . 2764)
+ ("GUJARATI SIGN VIRAMA" . 2765)
+ ("GUJARATI OM" . 2768)
+ ("GUJARATI LETTER VOCALIC RR" . 2784)
+ ("GUJARATI DIGIT ZERO" . 2790)
+ ("GUJARATI DIGIT ONE" . 2791)
+ ("GUJARATI DIGIT TWO" . 2792)
+ ("GUJARATI DIGIT THREE" . 2793)
+ ("GUJARATI DIGIT FOUR" . 2794)
+ ("GUJARATI DIGIT FIVE" . 2795)
+ ("GUJARATI DIGIT SIX" . 2796)
+ ("GUJARATI DIGIT SEVEN" . 2797)
+ ("GUJARATI DIGIT EIGHT" . 2798)
+ ("GUJARATI DIGIT NINE" . 2799)
+ ("ORIYA SIGN CANDRABINDU" . 2817)
+ ("ORIYA SIGN ANUSVARA" . 2818)
+ ("ORIYA SIGN VISARGA" . 2819)
+ ("ORIYA LETTER A" . 2821)
+ ("ORIYA LETTER AA" . 2822)
+ ("ORIYA LETTER I" . 2823)
+ ("ORIYA LETTER II" . 2824)
+ ("ORIYA LETTER U" . 2825)
+ ("ORIYA LETTER UU" . 2826)
+ ("ORIYA LETTER VOCALIC R" . 2827)
+ ("ORIYA LETTER VOCALIC L" . 2828)
+ ("ORIYA LETTER E" . 2831)
+ ("ORIYA LETTER AI" . 2832)
+ ("ORIYA LETTER O" . 2835)
+ ("ORIYA LETTER AU" . 2836)
+ ("ORIYA LETTER KA" . 2837)
+ ("ORIYA LETTER KHA" . 2838)
+ ("ORIYA LETTER GA" . 2839)
+ ("ORIYA LETTER GHA" . 2840)
+ ("ORIYA LETTER NGA" . 2841)
+ ("ORIYA LETTER CA" . 2842)
+ ("ORIYA LETTER CHA" . 2843)
+ ("ORIYA LETTER JA" . 2844)
+ ("ORIYA LETTER JHA" . 2845)
+ ("ORIYA LETTER NYA" . 2846)
+ ("ORIYA LETTER TTA" . 2847)
+ ("ORIYA LETTER TTHA" . 2848)
+ ("ORIYA LETTER DDA" . 2849)
+ ("ORIYA LETTER DDHA" . 2850)
+ ("ORIYA LETTER NNA" . 2851)
+ ("ORIYA LETTER TA" . 2852)
+ ("ORIYA LETTER THA" . 2853)
+ ("ORIYA LETTER DA" . 2854)
+ ("ORIYA LETTER DHA" . 2855)
+ ("ORIYA LETTER NA" . 2856)
+ ("ORIYA LETTER PA" . 2858)
+ ("ORIYA LETTER PHA" . 2859)
+ ("ORIYA LETTER BA" . 2860)
+ ("ORIYA LETTER BHA" . 2861)
+ ("ORIYA LETTER MA" . 2862)
+ ("ORIYA LETTER YA" . 2863)
+ ("ORIYA LETTER RA" . 2864)
+ ("ORIYA LETTER LA" . 2866)
+ ("ORIYA LETTER LLA" . 2867)
+ ("ORIYA LETTER SHA" . 2870)
+ ("ORIYA LETTER SSA" . 2871)
+ ("ORIYA LETTER SA" . 2872)
+ ("ORIYA LETTER HA" . 2873)
+ ("ORIYA SIGN NUKTA" . 2876)
+ ("ORIYA SIGN AVAGRAHA" . 2877)
+ ("ORIYA VOWEL SIGN AA" . 2878)
+ ("ORIYA VOWEL SIGN I" . 2879)
+ ("ORIYA VOWEL SIGN II" . 2880)
+ ("ORIYA VOWEL SIGN U" . 2881)
+ ("ORIYA VOWEL SIGN UU" . 2882)
+ ("ORIYA VOWEL SIGN VOCALIC R" . 2883)
+ ("ORIYA VOWEL SIGN E" . 2887)
+ ("ORIYA VOWEL SIGN AI" . 2888)
+ ("ORIYA VOWEL SIGN O" . 2891)
+ ("ORIYA VOWEL SIGN AU" . 2892)
+ ("ORIYA SIGN VIRAMA" . 2893)
+ ("ORIYA AI LENGTH MARK" . 2902)
+ ("ORIYA AU LENGTH MARK" . 2903)
+ ("ORIYA LETTER RRA" . 2908)
+ ("ORIYA LETTER RHA" . 2909)
+ ("ORIYA LETTER YYA" . 2911)
+ ("ORIYA LETTER VOCALIC RR" . 2912)
+ ("ORIYA LETTER VOCALIC LL" . 2913)
+ ("ORIYA DIGIT ZERO" . 2918)
+ ("ORIYA DIGIT ONE" . 2919)
+ ("ORIYA DIGIT TWO" . 2920)
+ ("ORIYA DIGIT THREE" . 2921)
+ ("ORIYA DIGIT FOUR" . 2922)
+ ("ORIYA DIGIT FIVE" . 2923)
+ ("ORIYA DIGIT SIX" . 2924)
+ ("ORIYA DIGIT SEVEN" . 2925)
+ ("ORIYA DIGIT EIGHT" . 2926)
+ ("ORIYA DIGIT NINE" . 2927)
+ ("ORIYA ISSHAR" . 2928)
+ ("TAMIL SIGN ANUSVARA" . 2946)
+ ("TAMIL SIGN VISARGA" . 2947)
+ ("TAMIL LETTER A" . 2949)
+ ("TAMIL LETTER AA" . 2950)
+ ("TAMIL LETTER I" . 2951)
+ ("TAMIL LETTER II" . 2952)
+ ("TAMIL LETTER U" . 2953)
+ ("TAMIL LETTER UU" . 2954)
+ ("TAMIL LETTER E" . 2958)
+ ("TAMIL LETTER EE" . 2959)
+ ("TAMIL LETTER AI" . 2960)
+ ("TAMIL LETTER O" . 2962)
+ ("TAMIL LETTER OO" . 2963)
+ ("TAMIL LETTER AU" . 2964)
+ ("TAMIL LETTER KA" . 2965)
+ ("TAMIL LETTER NGA" . 2969)
+ ("TAMIL LETTER CA" . 2970)
+ ("TAMIL LETTER JA" . 2972)
+ ("TAMIL LETTER NYA" . 2974)
+ ("TAMIL LETTER TTA" . 2975)
+ ("TAMIL LETTER NNA" . 2979)
+ ("TAMIL LETTER TA" . 2980)
+ ("TAMIL LETTER NA" . 2984)
+ ("TAMIL LETTER NNNA" . 2985)
+ ("TAMIL LETTER PA" . 2986)
+ ("TAMIL LETTER MA" . 2990)
+ ("TAMIL LETTER YA" . 2991)
+ ("TAMIL LETTER RA" . 2992)
+ ("TAMIL LETTER RRA" . 2993)
+ ("TAMIL LETTER LA" . 2994)
+ ("TAMIL LETTER LLA" . 2995)
+ ("TAMIL LETTER LLLA" . 2996)
+ ("TAMIL LETTER VA" . 2997)
+ ("TAMIL LETTER SSA" . 2999)
+ ("TAMIL LETTER SA" . 3000)
+ ("TAMIL LETTER HA" . 3001)
+ ("TAMIL VOWEL SIGN AA" . 3006)
+ ("TAMIL VOWEL SIGN I" . 3007)
+ ("TAMIL VOWEL SIGN II" . 3008)
+ ("TAMIL VOWEL SIGN U" . 3009)
+ ("TAMIL VOWEL SIGN UU" . 3010)
+ ("TAMIL VOWEL SIGN E" . 3014)
+ ("TAMIL VOWEL SIGN EE" . 3015)
+ ("TAMIL VOWEL SIGN AI" . 3016)
+ ("TAMIL VOWEL SIGN O" . 3018)
+ ("TAMIL VOWEL SIGN OO" . 3019)
+ ("TAMIL VOWEL SIGN AU" . 3020)
+ ("TAMIL SIGN VIRAMA" . 3021)
+ ("TAMIL AU LENGTH MARK" . 3031)
+ ("TAMIL DIGIT ONE" . 3047)
+ ("TAMIL DIGIT TWO" . 3048)
+ ("TAMIL DIGIT THREE" . 3049)
+ ("TAMIL DIGIT FOUR" . 3050)
+ ("TAMIL DIGIT FIVE" . 3051)
+ ("TAMIL DIGIT SIX" . 3052)
+ ("TAMIL DIGIT SEVEN" . 3053)
+ ("TAMIL DIGIT EIGHT" . 3054)
+ ("TAMIL DIGIT NINE" . 3055)
+ ("TAMIL NUMBER TEN" . 3056)
+ ("TAMIL NUMBER ONE HUNDRED" . 3057)
+ ("TAMIL NUMBER ONE THOUSAND" . 3058)
+ ("TELUGU SIGN CANDRABINDU" . 3073)
+ ("TELUGU SIGN ANUSVARA" . 3074)
+ ("TELUGU SIGN VISARGA" . 3075)
+ ("TELUGU LETTER A" . 3077)
+ ("TELUGU LETTER AA" . 3078)
+ ("TELUGU LETTER I" . 3079)
+ ("TELUGU LETTER II" . 3080)
+ ("TELUGU LETTER U" . 3081)
+ ("TELUGU LETTER UU" . 3082)
+ ("TELUGU LETTER VOCALIC R" . 3083)
+ ("TELUGU LETTER VOCALIC L" . 3084)
+ ("TELUGU LETTER E" . 3086)
+ ("TELUGU LETTER EE" . 3087)
+ ("TELUGU LETTER AI" . 3088)
+ ("TELUGU LETTER O" . 3090)
+ ("TELUGU LETTER OO" . 3091)
+ ("TELUGU LETTER AU" . 3092)
+ ("TELUGU LETTER KA" . 3093)
+ ("TELUGU LETTER KHA" . 3094)
+ ("TELUGU LETTER GA" . 3095)
+ ("TELUGU LETTER GHA" . 3096)
+ ("TELUGU LETTER NGA" . 3097)
+ ("TELUGU LETTER CA" . 3098)
+ ("TELUGU LETTER CHA" . 3099)
+ ("TELUGU LETTER JA" . 3100)
+ ("TELUGU LETTER JHA" . 3101)
+ ("TELUGU LETTER NYA" . 3102)
+ ("TELUGU LETTER TTA" . 3103)
+ ("TELUGU LETTER TTHA" . 3104)
+ ("TELUGU LETTER DDA" . 3105)
+ ("TELUGU LETTER DDHA" . 3106)
+ ("TELUGU LETTER NNA" . 3107)
+ ("TELUGU LETTER TA" . 3108)
+ ("TELUGU LETTER THA" . 3109)
+ ("TELUGU LETTER DA" . 3110)
+ ("TELUGU LETTER DHA" . 3111)
+ ("TELUGU LETTER NA" . 3112)
+ ("TELUGU LETTER PA" . 3114)
+ ("TELUGU LETTER PHA" . 3115)
+ ("TELUGU LETTER BA" . 3116)
+ ("TELUGU LETTER BHA" . 3117)
+ ("TELUGU LETTER MA" . 3118)
+ ("TELUGU LETTER YA" . 3119)
+ ("TELUGU LETTER RA" . 3120)
+ ("TELUGU LETTER RRA" . 3121)
+ ("TELUGU LETTER LA" . 3122)
+ ("TELUGU LETTER LLA" . 3123)
+ ("TELUGU LETTER VA" . 3125)
+ ("TELUGU LETTER SHA" . 3126)
+ ("TELUGU LETTER SSA" . 3127)
+ ("TELUGU LETTER SA" . 3128)
+ ("TELUGU LETTER HA" . 3129)
+ ("TELUGU VOWEL SIGN AA" . 3134)
+ ("TELUGU VOWEL SIGN I" . 3135)
+ ("TELUGU VOWEL SIGN II" . 3136)
+ ("TELUGU VOWEL SIGN U" . 3137)
+ ("TELUGU VOWEL SIGN UU" . 3138)
+ ("TELUGU VOWEL SIGN VOCALIC R" . 3139)
+ ("TELUGU VOWEL SIGN VOCALIC RR" . 3140)
+ ("TELUGU VOWEL SIGN E" . 3142)
+ ("TELUGU VOWEL SIGN EE" . 3143)
+ ("TELUGU VOWEL SIGN AI" . 3144)
+ ("TELUGU VOWEL SIGN O" . 3146)
+ ("TELUGU VOWEL SIGN OO" . 3147)
+ ("TELUGU VOWEL SIGN AU" . 3148)
+ ("TELUGU SIGN VIRAMA" . 3149)
+ ("TELUGU LENGTH MARK" . 3157)
+ ("TELUGU AI LENGTH MARK" . 3158)
+ ("TELUGU LETTER VOCALIC RR" . 3168)
+ ("TELUGU LETTER VOCALIC LL" . 3169)
+ ("TELUGU DIGIT ZERO" . 3174)
+ ("TELUGU DIGIT ONE" . 3175)
+ ("TELUGU DIGIT TWO" . 3176)
+ ("TELUGU DIGIT THREE" . 3177)
+ ("TELUGU DIGIT FOUR" . 3178)
+ ("TELUGU DIGIT FIVE" . 3179)
+ ("TELUGU DIGIT SIX" . 3180)
+ ("TELUGU DIGIT SEVEN" . 3181)
+ ("TELUGU DIGIT EIGHT" . 3182)
+ ("TELUGU DIGIT NINE" . 3183)
+ ("KANNADA SIGN ANUSVARA" . 3202)
+ ("KANNADA SIGN VISARGA" . 3203)
+ ("KANNADA LETTER A" . 3205)
+ ("KANNADA LETTER AA" . 3206)
+ ("KANNADA LETTER I" . 3207)
+ ("KANNADA LETTER II" . 3208)
+ ("KANNADA LETTER U" . 3209)
+ ("KANNADA LETTER UU" . 3210)
+ ("KANNADA LETTER VOCALIC R" . 3211)
+ ("KANNADA LETTER VOCALIC L" . 3212)
+ ("KANNADA LETTER E" . 3214)
+ ("KANNADA LETTER EE" . 3215)
+ ("KANNADA LETTER AI" . 3216)
+ ("KANNADA LETTER O" . 3218)
+ ("KANNADA LETTER OO" . 3219)
+ ("KANNADA LETTER AU" . 3220)
+ ("KANNADA LETTER KA" . 3221)
+ ("KANNADA LETTER KHA" . 3222)
+ ("KANNADA LETTER GA" . 3223)
+ ("KANNADA LETTER GHA" . 3224)
+ ("KANNADA LETTER NGA" . 3225)
+ ("KANNADA LETTER CA" . 3226)
+ ("KANNADA LETTER CHA" . 3227)
+ ("KANNADA LETTER JA" . 3228)
+ ("KANNADA LETTER JHA" . 3229)
+ ("KANNADA LETTER NYA" . 3230)
+ ("KANNADA LETTER TTA" . 3231)
+ ("KANNADA LETTER TTHA" . 3232)
+ ("KANNADA LETTER DDA" . 3233)
+ ("KANNADA LETTER DDHA" . 3234)
+ ("KANNADA LETTER NNA" . 3235)
+ ("KANNADA LETTER TA" . 3236)
+ ("KANNADA LETTER THA" . 3237)
+ ("KANNADA LETTER DA" . 3238)
+ ("KANNADA LETTER DHA" . 3239)
+ ("KANNADA LETTER NA" . 3240)
+ ("KANNADA LETTER PA" . 3242)
+ ("KANNADA LETTER PHA" . 3243)
+ ("KANNADA LETTER BA" . 3244)
+ ("KANNADA LETTER BHA" . 3245)
+ ("KANNADA LETTER MA" . 3246)
+ ("KANNADA LETTER YA" . 3247)
+ ("KANNADA LETTER RA" . 3248)
+ ("KANNADA LETTER RRA" . 3249)
+ ("KANNADA LETTER LA" . 3250)
+ ("KANNADA LETTER LLA" . 3251)
+ ("KANNADA LETTER VA" . 3253)
+ ("KANNADA LETTER SHA" . 3254)
+ ("KANNADA LETTER SSA" . 3255)
+ ("KANNADA LETTER SA" . 3256)
+ ("KANNADA LETTER HA" . 3257)
+ ("KANNADA VOWEL SIGN AA" . 3262)
+ ("KANNADA VOWEL SIGN I" . 3263)
+ ("KANNADA VOWEL SIGN II" . 3264)
+ ("KANNADA VOWEL SIGN U" . 3265)
+ ("KANNADA VOWEL SIGN UU" . 3266)
+ ("KANNADA VOWEL SIGN VOCALIC R" . 3267)
+ ("KANNADA VOWEL SIGN VOCALIC RR" . 3268)
+ ("KANNADA VOWEL SIGN E" . 3270)
+ ("KANNADA VOWEL SIGN EE" . 3271)
+ ("KANNADA VOWEL SIGN AI" . 3272)
+ ("KANNADA VOWEL SIGN O" . 3274)
+ ("KANNADA VOWEL SIGN OO" . 3275)
+ ("KANNADA VOWEL SIGN AU" . 3276)
+ ("KANNADA SIGN VIRAMA" . 3277)
+ ("KANNADA LENGTH MARK" . 3285)
+ ("KANNADA AI LENGTH MARK" . 3286)
+ ("KANNADA LETTER FA" . 3294)
+ ("KANNADA LETTER VOCALIC RR" . 3296)
+ ("KANNADA LETTER VOCALIC LL" . 3297)
+ ("KANNADA DIGIT ZERO" . 3302)
+ ("KANNADA DIGIT ONE" . 3303)
+ ("KANNADA DIGIT TWO" . 3304)
+ ("KANNADA DIGIT THREE" . 3305)
+ ("KANNADA DIGIT FOUR" . 3306)
+ ("KANNADA DIGIT FIVE" . 3307)
+ ("KANNADA DIGIT SIX" . 3308)
+ ("KANNADA DIGIT SEVEN" . 3309)
+ ("KANNADA DIGIT EIGHT" . 3310)
+ ("KANNADA DIGIT NINE" . 3311)
+ ("MALAYALAM SIGN ANUSVARA" . 3330)
+ ("MALAYALAM SIGN VISARGA" . 3331)
+ ("MALAYALAM LETTER A" . 3333)
+ ("MALAYALAM LETTER AA" . 3334)
+ ("MALAYALAM LETTER I" . 3335)
+ ("MALAYALAM LETTER II" . 3336)
+ ("MALAYALAM LETTER U" . 3337)
+ ("MALAYALAM LETTER UU" . 3338)
+ ("MALAYALAM LETTER VOCALIC R" . 3339)
+ ("MALAYALAM LETTER VOCALIC L" . 3340)
+ ("MALAYALAM LETTER E" . 3342)
+ ("MALAYALAM LETTER EE" . 3343)
+ ("MALAYALAM LETTER AI" . 3344)
+ ("MALAYALAM LETTER O" . 3346)
+ ("MALAYALAM LETTER OO" . 3347)
+ ("MALAYALAM LETTER AU" . 3348)
+ ("MALAYALAM LETTER KA" . 3349)
+ ("MALAYALAM LETTER KHA" . 3350)
+ ("MALAYALAM LETTER GA" . 3351)
+ ("MALAYALAM LETTER GHA" . 3352)
+ ("MALAYALAM LETTER NGA" . 3353)
+ ("MALAYALAM LETTER CA" . 3354)
+ ("MALAYALAM LETTER CHA" . 3355)
+ ("MALAYALAM LETTER JA" . 3356)
+ ("MALAYALAM LETTER JHA" . 3357)
+ ("MALAYALAM LETTER NYA" . 3358)
+ ("MALAYALAM LETTER TTA" . 3359)
+ ("MALAYALAM LETTER TTHA" . 3360)
+ ("MALAYALAM LETTER DDA" . 3361)
+ ("MALAYALAM LETTER DDHA" . 3362)
+ ("MALAYALAM LETTER NNA" . 3363)
+ ("MALAYALAM LETTER TA" . 3364)
+ ("MALAYALAM LETTER THA" . 3365)
+ ("MALAYALAM LETTER DA" . 3366)
+ ("MALAYALAM LETTER DHA" . 3367)
+ ("MALAYALAM LETTER NA" . 3368)
+ ("MALAYALAM LETTER PA" . 3370)
+ ("MALAYALAM LETTER PHA" . 3371)
+ ("MALAYALAM LETTER BA" . 3372)
+ ("MALAYALAM LETTER BHA" . 3373)
+ ("MALAYALAM LETTER MA" . 3374)
+ ("MALAYALAM LETTER YA" . 3375)
+ ("MALAYALAM LETTER RA" . 3376)
+ ("MALAYALAM LETTER RRA" . 3377)
+ ("MALAYALAM LETTER LA" . 3378)
+ ("MALAYALAM LETTER LLA" . 3379)
+ ("MALAYALAM LETTER LLLA" . 3380)
+ ("MALAYALAM LETTER VA" . 3381)
+ ("MALAYALAM LETTER SHA" . 3382)
+ ("MALAYALAM LETTER SSA" . 3383)
+ ("MALAYALAM LETTER SA" . 3384)
+ ("MALAYALAM LETTER HA" . 3385)
+ ("MALAYALAM VOWEL SIGN AA" . 3390)
+ ("MALAYALAM VOWEL SIGN I" . 3391)
+ ("MALAYALAM VOWEL SIGN II" . 3392)
+ ("MALAYALAM VOWEL SIGN U" . 3393)
+ ("MALAYALAM VOWEL SIGN UU" . 3394)
+ ("MALAYALAM VOWEL SIGN VOCALIC R" . 3395)
+ ("MALAYALAM VOWEL SIGN E" . 3398)
+ ("MALAYALAM VOWEL SIGN EE" . 3399)
+ ("MALAYALAM VOWEL SIGN AI" . 3400)
+ ("MALAYALAM VOWEL SIGN O" . 3402)
+ ("MALAYALAM VOWEL SIGN OO" . 3403)
+ ("MALAYALAM VOWEL SIGN AU" . 3404)
+ ("MALAYALAM SIGN VIRAMA" . 3405)
+ ("MALAYALAM AU LENGTH MARK" . 3415)
+ ("MALAYALAM LETTER VOCALIC RR" . 3424)
+ ("MALAYALAM LETTER VOCALIC LL" . 3425)
+ ("MALAYALAM DIGIT ZERO" . 3430)
+ ("MALAYALAM DIGIT ONE" . 3431)
+ ("MALAYALAM DIGIT TWO" . 3432)
+ ("MALAYALAM DIGIT THREE" . 3433)
+ ("MALAYALAM DIGIT FOUR" . 3434)
+ ("MALAYALAM DIGIT FIVE" . 3435)
+ ("MALAYALAM DIGIT SIX" . 3436)
+ ("MALAYALAM DIGIT SEVEN" . 3437)
+ ("MALAYALAM DIGIT EIGHT" . 3438)
+ ("MALAYALAM DIGIT NINE" . 3439)
+ ("SINHALA SIGN ANUSVARAYA" . 3458)
+ ("SINHALA SIGN VISARGAYA" . 3459)
+ ("SINHALA LETTER AYANNA" . 3461)
+ ("SINHALA LETTER AAYANNA" . 3462)
+ ("SINHALA LETTER AEYANNA" . 3463)
+ ("SINHALA LETTER AEEYANNA" . 3464)
+ ("SINHALA LETTER IYANNA" . 3465)
+ ("SINHALA LETTER IIYANNA" . 3466)
+ ("SINHALA LETTER UYANNA" . 3467)
+ ("SINHALA LETTER UUYANNA" . 3468)
+ ("SINHALA LETTER IRUYANNA" . 3469)
+ ("SINHALA LETTER IRUUYANNA" . 3470)
+ ("SINHALA LETTER ILUYANNA" . 3471)
+ ("SINHALA LETTER ILUUYANNA" . 3472)
+ ("SINHALA LETTER EYANNA" . 3473)
+ ("SINHALA LETTER EEYANNA" . 3474)
+ ("SINHALA LETTER AIYANNA" . 3475)
+ ("SINHALA LETTER OYANNA" . 3476)
+ ("SINHALA LETTER OOYANNA" . 3477)
+ ("SINHALA LETTER AUYANNA" . 3478)
+ ("SINHALA LETTER ALPAPRAANA KAYANNA" . 3482)
+ ("SINHALA LETTER MAHAAPRAANA KAYANNA" . 3483)
+ ("SINHALA LETTER ALPAPRAANA GAYANNA" . 3484)
+ ("SINHALA LETTER MAHAAPRAANA GAYANNA" . 3485)
+ ("SINHALA LETTER KANTAJA NAASIKYAYA" . 3486)
+ ("SINHALA LETTER SANYAKA GAYANNA" . 3487)
+ ("SINHALA LETTER ALPAPRAANA CAYANNA" . 3488)
+ ("SINHALA LETTER MAHAAPRAANA CAYANNA" . 3489)
+ ("SINHALA LETTER ALPAPRAANA JAYANNA" . 3490)
+ ("SINHALA LETTER MAHAAPRAANA JAYANNA" . 3491)
+ ("SINHALA LETTER TAALUJA NAASIKYAYA" . 3492)
+ ("SINHALA LETTER TAALUJA SANYOOGA NAAKSIKYAYA" . 3493)
+ ("SINHALA LETTER SANYAKA JAYANNA" . 3494)
+ ("SINHALA LETTER ALPAPRAANA TTAYANNA" . 3495)
+ ("SINHALA LETTER MAHAAPRAANA TTAYANNA" . 3496)
+ ("SINHALA LETTER ALPAPRAANA DDAYANNA" . 3497)
+ ("SINHALA LETTER MAHAAPRAANA DDAYANNA" . 3498)
+ ("SINHALA LETTER MUURDHAJA NAYANNA" . 3499)
+ ("SINHALA LETTER SANYAKA DDAYANNA" . 3500)
+ ("SINHALA LETTER ALPAPRAANA TAYANNA" . 3501)
+ ("SINHALA LETTER MAHAAPRAANA TAYANNA" . 3502)
+ ("SINHALA LETTER ALPAPRAANA DAYANNA" . 3503)
+ ("SINHALA LETTER MAHAAPRAANA DAYANNA" . 3504)
+ ("SINHALA LETTER DANTAJA NAYANNA" . 3505)
+ ("SINHALA LETTER SANYAKA DAYANNA" . 3507)
+ ("SINHALA LETTER ALPAPRAANA PAYANNA" . 3508)
+ ("SINHALA LETTER MAHAAPRAANA PAYANNA" . 3509)
+ ("SINHALA LETTER ALPAPRAANA BAYANNA" . 3510)
+ ("SINHALA LETTER MAHAAPRAANA BAYANNA" . 3511)
+ ("SINHALA LETTER MAYANNA" . 3512)
+ ("SINHALA LETTER AMBA BAYANNA" . 3513)
+ ("SINHALA LETTER YAYANNA" . 3514)
+ ("SINHALA LETTER RAYANNA" . 3515)
+ ("SINHALA LETTER DANTAJA LAYANNA" . 3517)
+ ("SINHALA LETTER VAYANNA" . 3520)
+ ("SINHALA LETTER TAALUJA SAYANNA" . 3521)
+ ("SINHALA LETTER MUURDHAJA SAYANNA" . 3522)
+ ("SINHALA LETTER DANTAJA SAYANNA" . 3523)
+ ("SINHALA LETTER HAYANNA" . 3524)
+ ("SINHALA LETTER MUURDHAJA LAYANNA" . 3525)
+ ("SINHALA LETTER FAYANNA" . 3526)
+ ("SINHALA SIGN AL-LAKUNA" . 3530)
+ ("SINHALA VOWEL SIGN AELA-PILLA" . 3535)
+ ("SINHALA VOWEL SIGN KETTI AEDA-PILLA" . 3536)
+ ("SINHALA VOWEL SIGN DIGA AEDA-PILLA" . 3537)
+ ("SINHALA VOWEL SIGN KETTI IS-PILLA" . 3538)
+ ("SINHALA VOWEL SIGN DIGA IS-PILLA" . 3539)
+ ("SINHALA VOWEL SIGN KETTI PAA-PILLA" . 3540)
+ ("SINHALA VOWEL SIGN DIGA PAA-PILLA" . 3542)
+ ("SINHALA VOWEL SIGN GAETTA-PILLA" . 3544)
+ ("SINHALA VOWEL SIGN KOMBUVA" . 3545)
+ ("SINHALA VOWEL SIGN DIGA KOMBUVA" . 3546)
+ ("SINHALA VOWEL SIGN KOMBU DEKA" . 3547)
+ ("SINHALA VOWEL SIGN KOMBUVA HAA AELA-PILLA" . 3548)
+ ("SINHALA VOWEL SIGN KOMBUVA HAA DIGA AELA-PILLA" . 3549)
+ ("SINHALA VOWEL SIGN KOMBUVA HAA GAYANUKITTA" . 3550)
+ ("SINHALA VOWEL SIGN GAYANUKITTA" . 3551)
+ ("SINHALA VOWEL SIGN DIGA GAETTA-PILLA" . 3570)
+ ("SINHALA VOWEL SIGN DIGA GAYANUKITTA" . 3571)
+ ("SINHALA PUNCTUATION KUNDDALIYA" . 3572)
+ ("THAI CHARACTER KO KAI" . 3585)
+ ("THAI CHARACTER KHO KHAI" . 3586)
+ ("THAI CHARACTER KHO KHUAT" . 3587)
+ ("THAI CHARACTER KHO KHWAI" . 3588)
+ ("THAI CHARACTER KHO KHON" . 3589)
+ ("THAI CHARACTER KHO RAKHANG" . 3590)
+ ("THAI CHARACTER NGO NGU" . 3591)
+ ("THAI CHARACTER CHO CHAN" . 3592)
+ ("THAI CHARACTER CHO CHING" . 3593)
+ ("THAI CHARACTER CHO CHANG" . 3594)
+ ("THAI CHARACTER SO SO" . 3595)
+ ("THAI CHARACTER CHO CHOE" . 3596)
+ ("THAI CHARACTER YO YING" . 3597)
+ ("THAI CHARACTER DO CHADA" . 3598)
+ ("THAI CHARACTER TO PATAK" . 3599)
+ ("THAI CHARACTER THO THAN" . 3600)
+ ("THAI CHARACTER THO NANGMONTHO" . 3601)
+ ("THAI CHARACTER THO PHUTHAO" . 3602)
+ ("THAI CHARACTER NO NEN" . 3603)
+ ("THAI CHARACTER DO DEK" . 3604)
+ ("THAI CHARACTER TO TAO" . 3605)
+ ("THAI CHARACTER THO THUNG" . 3606)
+ ("THAI CHARACTER THO THAHAN" . 3607)
+ ("THAI CHARACTER THO THONG" . 3608)
+ ("THAI CHARACTER NO NU" . 3609)
+ ("THAI CHARACTER BO BAIMAI" . 3610)
+ ("THAI CHARACTER PO PLA" . 3611)
+ ("THAI CHARACTER PHO PHUNG" . 3612)
+ ("THAI CHARACTER FO FA" . 3613)
+ ("THAI CHARACTER PHO PHAN" . 3614)
+ ("THAI CHARACTER FO FAN" . 3615)
+ ("THAI CHARACTER PHO SAMPHAO" . 3616)
+ ("THAI CHARACTER MO MA" . 3617)
+ ("THAI CHARACTER YO YAK" . 3618)
+ ("THAI CHARACTER RO RUA" . 3619)
+ ("THAI CHARACTER RU" . 3620)
+ ("THAI CHARACTER LO LING" . 3621)
+ ("THAI CHARACTER LU" . 3622)
+ ("THAI CHARACTER WO WAEN" . 3623)
+ ("THAI CHARACTER SO SALA" . 3624)
+ ("THAI CHARACTER SO RUSI" . 3625)
+ ("THAI CHARACTER SO SUA" . 3626)
+ ("THAI CHARACTER HO HIP" . 3627)
+ ("THAI CHARACTER LO CHULA" . 3628)
+ ("THAI CHARACTER O ANG" . 3629)
+ ("THAI CHARACTER HO NOKHUK" . 3630)
+ ("THAI CHARACTER PAIYANNOI" . 3631)
+ ("THAI CHARACTER SARA A" . 3632)
+ ("THAI CHARACTER MAI HAN-AKAT" . 3633)
+ ("THAI CHARACTER SARA AA" . 3634)
+ ("THAI CHARACTER SARA AM" . 3635)
+ ("THAI CHARACTER SARA I" . 3636)
+ ("THAI CHARACTER SARA II" . 3637)
+ ("THAI CHARACTER SARA UE" . 3638)
+ ("THAI CHARACTER SARA UEE" . 3639)
+ ("THAI CHARACTER SARA U" . 3640)
+ ("THAI CHARACTER SARA UU" . 3641)
+ ("THAI CHARACTER PHINTHU" . 3642)
+ ("THAI CURRENCY SYMBOL BAHT" . 3647)
+ ("THAI CHARACTER SARA E" . 3648)
+ ("THAI CHARACTER SARA AE" . 3649)
+ ("THAI CHARACTER SARA O" . 3650)
+ ("THAI CHARACTER SARA AI MAIMUAN" . 3651)
+ ("THAI CHARACTER SARA AI MAIMALAI" . 3652)
+ ("THAI CHARACTER LAKKHANGYAO" . 3653)
+ ("THAI CHARACTER MAIYAMOK" . 3654)
+ ("THAI CHARACTER MAITAIKHU" . 3655)
+ ("THAI CHARACTER MAI EK" . 3656)
+ ("THAI CHARACTER MAI THO" . 3657)
+ ("THAI CHARACTER MAI TRI" . 3658)
+ ("THAI CHARACTER MAI CHATTAWA" . 3659)
+ ("THAI CHARACTER THANTHAKHAT" . 3660)
+ ("THAI CHARACTER NIKHAHIT" . 3661)
+ ("THAI CHARACTER YAMAKKAN" . 3662)
+ ("THAI CHARACTER FONGMAN" . 3663)
+ ("THAI DIGIT ZERO" . 3664)
+ ("THAI DIGIT ONE" . 3665)
+ ("THAI DIGIT TWO" . 3666)
+ ("THAI DIGIT THREE" . 3667)
+ ("THAI DIGIT FOUR" . 3668)
+ ("THAI DIGIT FIVE" . 3669)
+ ("THAI DIGIT SIX" . 3670)
+ ("THAI DIGIT SEVEN" . 3671)
+ ("THAI DIGIT EIGHT" . 3672)
+ ("THAI DIGIT NINE" . 3673)
+ ("THAI CHARACTER ANGKHANKHU" . 3674)
+ ("THAI CHARACTER KHOMUT" . 3675)
+ ("LAO LETTER KO" . 3713)
+ ("LAO LETTER KHO SUNG" . 3714)
+ ("LAO LETTER KHO TAM" . 3716)
+ ("LAO LETTER NGO" . 3719)
+ ("LAO LETTER CO" . 3720)
+ ("LAO LETTER SO TAM" . 3722)
+ ("LAO LETTER NYO" . 3725)
+ ("LAO LETTER DO" . 3732)
+ ("LAO LETTER TO" . 3733)
+ ("LAO LETTER THO SUNG" . 3734)
+ ("LAO LETTER THO TAM" . 3735)
+ ("LAO LETTER NO" . 3737)
+ ("LAO LETTER BO" . 3738)
+ ("LAO LETTER PO" . 3739)
+ ("LAO LETTER PHO SUNG" . 3740)
+ ("LAO LETTER FO TAM" . 3741)
+ ("LAO LETTER PHO TAM" . 3742)
+ ("LAO LETTER FO SUNG" . 3743)
+ ("LAO LETTER MO" . 3745)
+ ("LAO LETTER YO" . 3746)
+ ("LAO LETTER LO LING" . 3747)
+ ("LAO LETTER LO LOOT" . 3749)
+ ("LAO LETTER WO" . 3751)
+ ("LAO LETTER SO SUNG" . 3754)
+ ("LAO LETTER HO SUNG" . 3755)
+ ("LAO LETTER O" . 3757)
+ ("LAO LETTER HO TAM" . 3758)
+ ("LAO ELLIPSIS" . 3759)
+ ("LAO VOWEL SIGN A" . 3760)
+ ("LAO VOWEL SIGN MAI KAN" . 3761)
+ ("LAO VOWEL SIGN AA" . 3762)
+ ("LAO VOWEL SIGN AM" . 3763)
+ ("LAO VOWEL SIGN I" . 3764)
+ ("LAO VOWEL SIGN II" . 3765)
+ ("LAO VOWEL SIGN Y" . 3766)
+ ("LAO VOWEL SIGN YY" . 3767)
+ ("LAO VOWEL SIGN U" . 3768)
+ ("LAO VOWEL SIGN UU" . 3769)
+ ("LAO VOWEL SIGN MAI KON" . 3771)
+ ("LAO SEMIVOWEL SIGN LO" . 3772)
+ ("LAO SEMIVOWEL SIGN NYO" . 3773)
+ ("LAO VOWEL SIGN E" . 3776)
+ ("LAO VOWEL SIGN EI" . 3777)
+ ("LAO VOWEL SIGN O" . 3778)
+ ("LAO VOWEL SIGN AY" . 3779)
+ ("LAO VOWEL SIGN AI" . 3780)
+ ("LAO KO LA" . 3782)
+ ("LAO TONE MAI EK" . 3784)
+ ("LAO TONE MAI THO" . 3785)
+ ("LAO TONE MAI TI" . 3786)
+ ("LAO TONE MAI CATAWA" . 3787)
+ ("LAO CANCELLATION MARK" . 3788)
+ ("LAO NIGGAHITA" . 3789)
+ ("LAO DIGIT ZERO" . 3792)
+ ("LAO DIGIT ONE" . 3793)
+ ("LAO DIGIT TWO" . 3794)
+ ("LAO DIGIT THREE" . 3795)
+ ("LAO DIGIT FOUR" . 3796)
+ ("LAO DIGIT FIVE" . 3797)
+ ("LAO DIGIT SIX" . 3798)
+ ("LAO DIGIT SEVEN" . 3799)
+ ("LAO DIGIT EIGHT" . 3800)
+ ("LAO DIGIT NINE" . 3801)
+ ("LAO HO NO" . 3804)
+ ("LAO HO MO" . 3805)
+ ("TIBETAN SYLLABLE OM" . 3840)
+ ("TIBETAN MARK GTER YIG MGO TRUNCATED A" . 3841)
+ ("TIBETAN MARK GTER YIG MGO -UM RNAM BCAD MA" . 3842)
+ ("TIBETAN MARK GTER YIG MGO -UM GTER TSHEG MA" . 3843)
+ ("TIBETAN MARK INITIAL YIG MGO MDUN MA" . 3844)
+ ("TIBETAN MARK CLOSING YIG MGO SGAB MA" . 3845)
+ ("TIBETAN MARK CARET YIG MGO PHUR SHAD MA" . 3846)
+ ("TIBETAN MARK YIG MGO TSHEG SHAD MA" . 3847)
+ ("TIBETAN MARK SBRUL SHAD" . 3848)
+ ("TIBETAN MARK BSKUR YIG MGO" . 3849)
+ ("TIBETAN MARK BKA- SHOG YIG MGO" . 3850)
+ ("TIBETAN MARK INTERSYLLABIC TSHEG" . 3851)
+ ("TIBETAN MARK DELIMITER TSHEG BSTAR" . 3852)
+ ("TIBETAN MARK SHAD" . 3853)
+ ("TIBETAN MARK NYIS SHAD" . 3854)
+ ("TIBETAN MARK TSHEG SHAD" . 3855)
+ ("TIBETAN MARK NYIS TSHEG SHAD" . 3856)
+ ("TIBETAN MARK RIN CHEN SPUNGS SHAD" . 3857)
+ ("TIBETAN MARK RGYA GRAM SHAD" . 3858)
+ ("TIBETAN MARK CARET -DZUD RTAGS ME LONG CAN" . 3859)
+ ("TIBETAN MARK GTER TSHEG" . 3860)
+ ("TIBETAN LOGOTYPE SIGN CHAD RTAGS" . 3861)
+ ("TIBETAN LOGOTYPE SIGN LHAG RTAGS" . 3862)
+ ("TIBETAN ASTROLOGICAL SIGN SGRA GCAN -CHAR RTAGS" . 3863)
+ ("TIBETAN ASTROLOGICAL SIGN -KHYUD PA" . 3864)
+ ("TIBETAN ASTROLOGICAL SIGN SDONG TSHUGS" . 3865)
+ ("TIBETAN SIGN RDEL DKAR GCIG" . 3866)
+ ("TIBETAN SIGN RDEL DKAR GNYIS" . 3867)
+ ("TIBETAN SIGN RDEL DKAR GSUM" . 3868)
+ ("TIBETAN SIGN RDEL NAG GCIG" . 3869)
+ ("TIBETAN SIGN RDEL NAG GNYIS" . 3870)
+ ("TIBETAN SIGN RDEL DKAR RDEL NAG" . 3871)
+ ("TIBETAN DIGIT ZERO" . 3872)
+ ("TIBETAN DIGIT ONE" . 3873)
+ ("TIBETAN DIGIT TWO" . 3874)
+ ("TIBETAN DIGIT THREE" . 3875)
+ ("TIBETAN DIGIT FOUR" . 3876)
+ ("TIBETAN DIGIT FIVE" . 3877)
+ ("TIBETAN DIGIT SIX" . 3878)
+ ("TIBETAN DIGIT SEVEN" . 3879)
+ ("TIBETAN DIGIT EIGHT" . 3880)
+ ("TIBETAN DIGIT NINE" . 3881)
+ ("TIBETAN DIGIT HALF ONE" . 3882)
+ ("TIBETAN DIGIT HALF TWO" . 3883)
+ ("TIBETAN DIGIT HALF THREE" . 3884)
+ ("TIBETAN DIGIT HALF FOUR" . 3885)
+ ("TIBETAN DIGIT HALF FIVE" . 3886)
+ ("TIBETAN DIGIT HALF SIX" . 3887)
+ ("TIBETAN DIGIT HALF SEVEN" . 3888)
+ ("TIBETAN DIGIT HALF EIGHT" . 3889)
+ ("TIBETAN DIGIT HALF NINE" . 3890)
+ ("TIBETAN DIGIT HALF ZERO" . 3891)
+ ("TIBETAN MARK BSDUS RTAGS" . 3892)
+ ("TIBETAN MARK NGAS BZUNG NYI ZLA" . 3893)
+ ("TIBETAN MARK CARET -DZUD RTAGS BZHI MIG CAN" . 3894)
+ ("TIBETAN MARK NGAS BZUNG SGOR RTAGS" . 3895)
+ ("TIBETAN MARK CHE MGO" . 3896)
+ ("TIBETAN MARK TSA -PHRU" . 3897)
+ ("TIBETAN MARK GUG RTAGS GYON" . 3898)
+ ("TIBETAN MARK GUG RTAGS GYAS" . 3899)
+ ("TIBETAN MARK ANG KHANG GYON" . 3900)
+ ("TIBETAN MARK ANG KHANG GYAS" . 3901)
+ ("TIBETAN SIGN YAR TSHES" . 3902)
+ ("TIBETAN SIGN MAR TSHES" . 3903)
+ ("TIBETAN LETTER KA" . 3904)
+ ("TIBETAN LETTER KHA" . 3905)
+ ("TIBETAN LETTER GA" . 3906)
+ ("TIBETAN LETTER GHA" . 3907)
+ ("TIBETAN LETTER NGA" . 3908)
+ ("TIBETAN LETTER CA" . 3909)
+ ("TIBETAN LETTER CHA" . 3910)
+ ("TIBETAN LETTER JA" . 3911)
+ ("TIBETAN LETTER NYA" . 3913)
+ ("TIBETAN LETTER TTA" . 3914)
+ ("TIBETAN LETTER TTHA" . 3915)
+ ("TIBETAN LETTER DDA" . 3916)
+ ("TIBETAN LETTER DDHA" . 3917)
+ ("TIBETAN LETTER NNA" . 3918)
+ ("TIBETAN LETTER TA" . 3919)
+ ("TIBETAN LETTER THA" . 3920)
+ ("TIBETAN LETTER DA" . 3921)
+ ("TIBETAN LETTER DHA" . 3922)
+ ("TIBETAN LETTER NA" . 3923)
+ ("TIBETAN LETTER PA" . 3924)
+ ("TIBETAN LETTER PHA" . 3925)
+ ("TIBETAN LETTER BA" . 3926)
+ ("TIBETAN LETTER BHA" . 3927)
+ ("TIBETAN LETTER MA" . 3928)
+ ("TIBETAN LETTER TSA" . 3929)
+ ("TIBETAN LETTER TSHA" . 3930)
+ ("TIBETAN LETTER DZA" . 3931)
+ ("TIBETAN LETTER DZHA" . 3932)
+ ("TIBETAN LETTER WA" . 3933)
+ ("TIBETAN LETTER ZHA" . 3934)
+ ("TIBETAN LETTER ZA" . 3935)
+ ("TIBETAN LETTER -A" . 3936)
+ ("TIBETAN LETTER YA" . 3937)
+ ("TIBETAN LETTER RA" . 3938)
+ ("TIBETAN LETTER LA" . 3939)
+ ("TIBETAN LETTER SHA" . 3940)
+ ("TIBETAN LETTER SSA" . 3941)
+ ("TIBETAN LETTER SA" . 3942)
+ ("TIBETAN LETTER HA" . 3943)
+ ("TIBETAN LETTER A" . 3944)
+ ("TIBETAN LETTER KSSA" . 3945)
+ ("TIBETAN LETTER FIXED-FORM RA" . 3946)
+ ("TIBETAN VOWEL SIGN AA" . 3953)
+ ("TIBETAN VOWEL SIGN I" . 3954)
+ ("TIBETAN VOWEL SIGN II" . 3955)
+ ("TIBETAN VOWEL SIGN U" . 3956)
+ ("TIBETAN VOWEL SIGN UU" . 3957)
+ ("TIBETAN VOWEL SIGN VOCALIC R" . 3958)
+ ("TIBETAN VOWEL SIGN VOCALIC RR" . 3959)
+ ("TIBETAN VOWEL SIGN VOCALIC L" . 3960)
+ ("TIBETAN VOWEL SIGN VOCALIC LL" . 3961)
+ ("TIBETAN VOWEL SIGN E" . 3962)
+ ("TIBETAN VOWEL SIGN EE" . 3963)
+ ("TIBETAN VOWEL SIGN O" . 3964)
+ ("TIBETAN VOWEL SIGN OO" . 3965)
+ ("TIBETAN SIGN RJES SU NGA RO" . 3966)
+ ("TIBETAN SIGN RNAM BCAD" . 3967)
+ ("TIBETAN VOWEL SIGN REVERSED I" . 3968)
+ ("TIBETAN VOWEL SIGN REVERSED II" . 3969)
+ ("TIBETAN SIGN NYI ZLA NAA DA" . 3970)
+ ("TIBETAN SIGN SNA LDAN" . 3971)
+ ("TIBETAN MARK HALANTA" . 3972)
+ ("TIBETAN MARK PALUTA" . 3973)
+ ("TIBETAN SIGN LCI RTAGS" . 3974)
+ ("TIBETAN SIGN YANG RTAGS" . 3975)
+ ("TIBETAN SIGN LCE TSA CAN" . 3976)
+ ("TIBETAN SIGN MCHU CAN" . 3977)
+ ("TIBETAN SIGN GRU CAN RGYINGS" . 3978)
+ ("TIBETAN SIGN GRU MED RGYINGS" . 3979)
+ ("TIBETAN SUBJOINED LETTER KA" . 3984)
+ ("TIBETAN SUBJOINED LETTER KHA" . 3985)
+ ("TIBETAN SUBJOINED LETTER GA" . 3986)
+ ("TIBETAN SUBJOINED LETTER GHA" . 3987)
+ ("TIBETAN SUBJOINED LETTER NGA" . 3988)
+ ("TIBETAN SUBJOINED LETTER CA" . 3989)
+ ("TIBETAN SUBJOINED LETTER CHA" . 3990)
+ ("TIBETAN SUBJOINED LETTER JA" . 3991)
+ ("TIBETAN SUBJOINED LETTER NYA" . 3993)
+ ("TIBETAN SUBJOINED LETTER TTA" . 3994)
+ ("TIBETAN SUBJOINED LETTER TTHA" . 3995)
+ ("TIBETAN SUBJOINED LETTER DDA" . 3996)
+ ("TIBETAN SUBJOINED LETTER DDHA" . 3997)
+ ("TIBETAN SUBJOINED LETTER NNA" . 3998)
+ ("TIBETAN SUBJOINED LETTER TA" . 3999)
+ ("TIBETAN SUBJOINED LETTER THA" . 4000)
+ ("TIBETAN SUBJOINED LETTER DA" . 4001)
+ ("TIBETAN SUBJOINED LETTER DHA" . 4002)
+ ("TIBETAN SUBJOINED LETTER NA" . 4003)
+ ("TIBETAN SUBJOINED LETTER PA" . 4004)
+ ("TIBETAN SUBJOINED LETTER PHA" . 4005)
+ ("TIBETAN SUBJOINED LETTER BA" . 4006)
+ ("TIBETAN SUBJOINED LETTER BHA" . 4007)
+ ("TIBETAN SUBJOINED LETTER MA" . 4008)
+ ("TIBETAN SUBJOINED LETTER TSA" . 4009)
+ ("TIBETAN SUBJOINED LETTER TSHA" . 4010)
+ ("TIBETAN SUBJOINED LETTER DZA" . 4011)
+ ("TIBETAN SUBJOINED LETTER DZHA" . 4012)
+ ("TIBETAN SUBJOINED LETTER WA" . 4013)
+ ("TIBETAN SUBJOINED LETTER ZHA" . 4014)
+ ("TIBETAN SUBJOINED LETTER ZA" . 4015)
+ ("TIBETAN SUBJOINED LETTER -A" . 4016)
+ ("TIBETAN SUBJOINED LETTER YA" . 4017)
+ ("TIBETAN SUBJOINED LETTER RA" . 4018)
+ ("TIBETAN SUBJOINED LETTER LA" . 4019)
+ ("TIBETAN SUBJOINED LETTER SHA" . 4020)
+ ("TIBETAN SUBJOINED LETTER SSA" . 4021)
+ ("TIBETAN SUBJOINED LETTER SA" . 4022)
+ ("TIBETAN SUBJOINED LETTER HA" . 4023)
+ ("TIBETAN SUBJOINED LETTER A" . 4024)
+ ("TIBETAN SUBJOINED LETTER KSSA" . 4025)
+ ("TIBETAN SUBJOINED LETTER FIXED-FORM WA" . 4026)
+ ("TIBETAN SUBJOINED LETTER FIXED-FORM YA" . 4027)
+ ("TIBETAN SUBJOINED LETTER FIXED-FORM RA" . 4028)
+ ("TIBETAN KU RU KHA" . 4030)
+ ("TIBETAN KU RU KHA BZHI MIG CAN" . 4031)
+ ("TIBETAN CANTILLATION SIGN HEAVY BEAT" . 4032)
+ ("TIBETAN CANTILLATION SIGN LIGHT BEAT" . 4033)
+ ("TIBETAN CANTILLATION SIGN CANG TE-U" . 4034)
+ ("TIBETAN CANTILLATION SIGN SBUB -CHAL" . 4035)
+ ("TIBETAN SYMBOL DRIL BU" . 4036)
+ ("TIBETAN SYMBOL RDO RJE" . 4037)
+ ("TIBETAN SYMBOL PADMA GDAN" . 4038)
+ ("TIBETAN SYMBOL RDO RJE RGYA GRAM" . 4039)
+ ("TIBETAN SYMBOL PHUR PA" . 4040)
+ ("TIBETAN SYMBOL NOR BU" . 4041)
+ ("TIBETAN SYMBOL NOR BU NYIS -KHYIL" . 4042)
+ ("TIBETAN SYMBOL NOR BU GSUM -KHYIL" . 4043)
+ ("TIBETAN SYMBOL NOR BU BZHI -KHYIL" . 4044)
+ ("TIBETAN SIGN RDEL NAG GSUM" . 4047)
+ ("MYANMAR LETTER KA" . 4096)
+ ("MYANMAR LETTER KHA" . 4097)
+ ("MYANMAR LETTER GA" . 4098)
+ ("MYANMAR LETTER GHA" . 4099)
+ ("MYANMAR LETTER NGA" . 4100)
+ ("MYANMAR LETTER CA" . 4101)
+ ("MYANMAR LETTER CHA" . 4102)
+ ("MYANMAR LETTER JA" . 4103)
+ ("MYANMAR LETTER JHA" . 4104)
+ ("MYANMAR LETTER NYA" . 4105)
+ ("MYANMAR LETTER NNYA" . 4106)
+ ("MYANMAR LETTER TTA" . 4107)
+ ("MYANMAR LETTER TTHA" . 4108)
+ ("MYANMAR LETTER DDA" . 4109)
+ ("MYANMAR LETTER DDHA" . 4110)
+ ("MYANMAR LETTER NNA" . 4111)
+ ("MYANMAR LETTER TA" . 4112)
+ ("MYANMAR LETTER THA" . 4113)
+ ("MYANMAR LETTER DA" . 4114)
+ ("MYANMAR LETTER DHA" . 4115)
+ ("MYANMAR LETTER NA" . 4116)
+ ("MYANMAR LETTER PA" . 4117)
+ ("MYANMAR LETTER PHA" . 4118)
+ ("MYANMAR LETTER BA" . 4119)
+ ("MYANMAR LETTER BHA" . 4120)
+ ("MYANMAR LETTER MA" . 4121)
+ ("MYANMAR LETTER YA" . 4122)
+ ("MYANMAR LETTER RA" . 4123)
+ ("MYANMAR LETTER LA" . 4124)
+ ("MYANMAR LETTER WA" . 4125)
+ ("MYANMAR LETTER SA" . 4126)
+ ("MYANMAR LETTER HA" . 4127)
+ ("MYANMAR LETTER LLA" . 4128)
+ ("MYANMAR LETTER A" . 4129)
+ ("MYANMAR LETTER I" . 4131)
+ ("MYANMAR LETTER II" . 4132)
+ ("MYANMAR LETTER U" . 4133)
+ ("MYANMAR LETTER UU" . 4134)
+ ("MYANMAR LETTER E" . 4135)
+ ("MYANMAR LETTER O" . 4137)
+ ("MYANMAR LETTER AU" . 4138)
+ ("MYANMAR VOWEL SIGN AA" . 4140)
+ ("MYANMAR VOWEL SIGN I" . 4141)
+ ("MYANMAR VOWEL SIGN II" . 4142)
+ ("MYANMAR VOWEL SIGN U" . 4143)
+ ("MYANMAR VOWEL SIGN UU" . 4144)
+ ("MYANMAR VOWEL SIGN E" . 4145)
+ ("MYANMAR VOWEL SIGN AI" . 4146)
+ ("MYANMAR SIGN ANUSVARA" . 4150)
+ ("MYANMAR SIGN DOT BELOW" . 4151)
+ ("MYANMAR SIGN VISARGA" . 4152)
+ ("MYANMAR SIGN VIRAMA" . 4153)
+ ("MYANMAR DIGIT ZERO" . 4160)
+ ("MYANMAR DIGIT ONE" . 4161)
+ ("MYANMAR DIGIT TWO" . 4162)
+ ("MYANMAR DIGIT THREE" . 4163)
+ ("MYANMAR DIGIT FOUR" . 4164)
+ ("MYANMAR DIGIT FIVE" . 4165)
+ ("MYANMAR DIGIT SIX" . 4166)
+ ("MYANMAR DIGIT SEVEN" . 4167)
+ ("MYANMAR DIGIT EIGHT" . 4168)
+ ("MYANMAR DIGIT NINE" . 4169)
+ ("MYANMAR SIGN LITTLE SECTION" . 4170)
+ ("MYANMAR SIGN SECTION" . 4171)
+ ("MYANMAR SYMBOL LOCATIVE" . 4172)
+ ("MYANMAR SYMBOL COMPLETED" . 4173)
+ ("MYANMAR SYMBOL AFOREMENTIONED" . 4174)
+ ("MYANMAR SYMBOL GENITIVE" . 4175)
+ ("MYANMAR LETTER SHA" . 4176)
+ ("MYANMAR LETTER SSA" . 4177)
+ ("MYANMAR LETTER VOCALIC R" . 4178)
+ ("MYANMAR LETTER VOCALIC RR" . 4179)
+ ("MYANMAR LETTER VOCALIC L" . 4180)
+ ("MYANMAR LETTER VOCALIC LL" . 4181)
+ ("MYANMAR VOWEL SIGN VOCALIC R" . 4182)
+ ("MYANMAR VOWEL SIGN VOCALIC RR" . 4183)
+ ("MYANMAR VOWEL SIGN VOCALIC L" . 4184)
+ ("MYANMAR VOWEL SIGN VOCALIC LL" . 4185)
+ ("GEORGIAN CAPITAL LETTER AN" . 4256)
+ ("GEORGIAN CAPITAL LETTER BAN" . 4257)
+ ("GEORGIAN CAPITAL LETTER GAN" . 4258)
+ ("GEORGIAN CAPITAL LETTER DON" . 4259)
+ ("GEORGIAN CAPITAL LETTER EN" . 4260)
+ ("GEORGIAN CAPITAL LETTER VIN" . 4261)
+ ("GEORGIAN CAPITAL LETTER ZEN" . 4262)
+ ("GEORGIAN CAPITAL LETTER TAN" . 4263)
+ ("GEORGIAN CAPITAL LETTER IN" . 4264)
+ ("GEORGIAN CAPITAL LETTER KAN" . 4265)
+ ("GEORGIAN CAPITAL LETTER LAS" . 4266)
+ ("GEORGIAN CAPITAL LETTER MAN" . 4267)
+ ("GEORGIAN CAPITAL LETTER NAR" . 4268)
+ ("GEORGIAN CAPITAL LETTER ON" . 4269)
+ ("GEORGIAN CAPITAL LETTER PAR" . 4270)
+ ("GEORGIAN CAPITAL LETTER ZHAR" . 4271)
+ ("GEORGIAN CAPITAL LETTER RAE" . 4272)
+ ("GEORGIAN CAPITAL LETTER SAN" . 4273)
+ ("GEORGIAN CAPITAL LETTER TAR" . 4274)
+ ("GEORGIAN CAPITAL LETTER UN" . 4275)
+ ("GEORGIAN CAPITAL LETTER PHAR" . 4276)
+ ("GEORGIAN CAPITAL LETTER KHAR" . 4277)
+ ("GEORGIAN CAPITAL LETTER GHAN" . 4278)
+ ("GEORGIAN CAPITAL LETTER QAR" . 4279)
+ ("GEORGIAN CAPITAL LETTER SHIN" . 4280)
+ ("GEORGIAN CAPITAL LETTER CHIN" . 4281)
+ ("GEORGIAN CAPITAL LETTER CAN" . 4282)
+ ("GEORGIAN CAPITAL LETTER JIL" . 4283)
+ ("GEORGIAN CAPITAL LETTER CIL" . 4284)
+ ("GEORGIAN CAPITAL LETTER CHAR" . 4285)
+ ("GEORGIAN CAPITAL LETTER XAN" . 4286)
+ ("GEORGIAN CAPITAL LETTER JHAN" . 4287)
+ ("GEORGIAN CAPITAL LETTER HAE" . 4288)
+ ("GEORGIAN CAPITAL LETTER HE" . 4289)
+ ("GEORGIAN CAPITAL LETTER HIE" . 4290)
+ ("GEORGIAN CAPITAL LETTER WE" . 4291)
+ ("GEORGIAN CAPITAL LETTER HAR" . 4292)
+ ("GEORGIAN CAPITAL LETTER HOE" . 4293)
+ ("GEORGIAN LETTER AN" . 4304)
+ ("GEORGIAN LETTER BAN" . 4305)
+ ("GEORGIAN LETTER GAN" . 4306)
+ ("GEORGIAN LETTER DON" . 4307)
+ ("GEORGIAN LETTER EN" . 4308)
+ ("GEORGIAN LETTER VIN" . 4309)
+ ("GEORGIAN LETTER ZEN" . 4310)
+ ("GEORGIAN LETTER TAN" . 4311)
+ ("GEORGIAN LETTER IN" . 4312)
+ ("GEORGIAN LETTER KAN" . 4313)
+ ("GEORGIAN LETTER LAS" . 4314)
+ ("GEORGIAN LETTER MAN" . 4315)
+ ("GEORGIAN LETTER NAR" . 4316)
+ ("GEORGIAN LETTER ON" . 4317)
+ ("GEORGIAN LETTER PAR" . 4318)
+ ("GEORGIAN LETTER ZHAR" . 4319)
+ ("GEORGIAN LETTER RAE" . 4320)
+ ("GEORGIAN LETTER SAN" . 4321)
+ ("GEORGIAN LETTER TAR" . 4322)
+ ("GEORGIAN LETTER UN" . 4323)
+ ("GEORGIAN LETTER PHAR" . 4324)
+ ("GEORGIAN LETTER KHAR" . 4325)
+ ("GEORGIAN LETTER GHAN" . 4326)
+ ("GEORGIAN LETTER QAR" . 4327)
+ ("GEORGIAN LETTER SHIN" . 4328)
+ ("GEORGIAN LETTER CHIN" . 4329)
+ ("GEORGIAN LETTER CAN" . 4330)
+ ("GEORGIAN LETTER JIL" . 4331)
+ ("GEORGIAN LETTER CIL" . 4332)
+ ("GEORGIAN LETTER CHAR" . 4333)
+ ("GEORGIAN LETTER XAN" . 4334)
+ ("GEORGIAN LETTER JHAN" . 4335)
+ ("GEORGIAN LETTER HAE" . 4336)
+ ("GEORGIAN LETTER HE" . 4337)
+ ("GEORGIAN LETTER HIE" . 4338)
+ ("GEORGIAN LETTER WE" . 4339)
+ ("GEORGIAN LETTER HAR" . 4340)
+ ("GEORGIAN LETTER HOE" . 4341)
+ ("GEORGIAN LETTER FI" . 4342)
+ ("GEORGIAN LETTER YN" . 4343)
+ ("GEORGIAN LETTER ELIFI" . 4344)
+ ("GEORGIAN PARAGRAPH SEPARATOR" . 4347)
+ ("HANGUL CHOSEONG KIYEOK" . 4352)
+ ("HANGUL CHOSEONG SSANGKIYEOK" . 4353)
+ ("HANGUL CHOSEONG NIEUN" . 4354)
+ ("HANGUL CHOSEONG TIKEUT" . 4355)
+ ("HANGUL CHOSEONG SSANGTIKEUT" . 4356)
+ ("HANGUL CHOSEONG RIEUL" . 4357)
+ ("HANGUL CHOSEONG MIEUM" . 4358)
+ ("HANGUL CHOSEONG PIEUP" . 4359)
+ ("HANGUL CHOSEONG SSANGPIEUP" . 4360)
+ ("HANGUL CHOSEONG SIOS" . 4361)
+ ("HANGUL CHOSEONG SSANGSIOS" . 4362)
+ ("HANGUL CHOSEONG IEUNG" . 4363)
+ ("HANGUL CHOSEONG CIEUC" . 4364)
+ ("HANGUL CHOSEONG SSANGCIEUC" . 4365)
+ ("HANGUL CHOSEONG CHIEUCH" . 4366)
+ ("HANGUL CHOSEONG KHIEUKH" . 4367)
+ ("HANGUL CHOSEONG THIEUTH" . 4368)
+ ("HANGUL CHOSEONG PHIEUPH" . 4369)
+ ("HANGUL CHOSEONG HIEUH" . 4370)
+ ("HANGUL CHOSEONG NIEUN-KIYEOK" . 4371)
+ ("HANGUL CHOSEONG SSANGNIEUN" . 4372)
+ ("HANGUL CHOSEONG NIEUN-TIKEUT" . 4373)
+ ("HANGUL CHOSEONG NIEUN-PIEUP" . 4374)
+ ("HANGUL CHOSEONG TIKEUT-KIYEOK" . 4375)
+ ("HANGUL CHOSEONG RIEUL-NIEUN" . 4376)
+ ("HANGUL CHOSEONG SSANGRIEUL" . 4377)
+ ("HANGUL CHOSEONG RIEUL-HIEUH" . 4378)
+ ("HANGUL CHOSEONG KAPYEOUNRIEUL" . 4379)
+ ("HANGUL CHOSEONG MIEUM-PIEUP" . 4380)
+ ("HANGUL CHOSEONG KAPYEOUNMIEUM" . 4381)
+ ("HANGUL CHOSEONG PIEUP-KIYEOK" . 4382)
+ ("HANGUL CHOSEONG PIEUP-NIEUN" . 4383)
+ ("HANGUL CHOSEONG PIEUP-TIKEUT" . 4384)
+ ("HANGUL CHOSEONG PIEUP-SIOS" . 4385)
+ ("HANGUL CHOSEONG PIEUP-SIOS-KIYEOK" . 4386)
+ ("HANGUL CHOSEONG PIEUP-SIOS-TIKEUT" . 4387)
+ ("HANGUL CHOSEONG PIEUP-SIOS-PIEUP" . 4388)
+ ("HANGUL CHOSEONG PIEUP-SSANGSIOS" . 4389)
+ ("HANGUL CHOSEONG PIEUP-SIOS-CIEUC" . 4390)
+ ("HANGUL CHOSEONG PIEUP-CIEUC" . 4391)
+ ("HANGUL CHOSEONG PIEUP-CHIEUCH" . 4392)
+ ("HANGUL CHOSEONG PIEUP-THIEUTH" . 4393)
+ ("HANGUL CHOSEONG PIEUP-PHIEUPH" . 4394)
+ ("HANGUL CHOSEONG KAPYEOUNPIEUP" . 4395)
+ ("HANGUL CHOSEONG KAPYEOUNSSANGPIEUP" . 4396)
+ ("HANGUL CHOSEONG SIOS-KIYEOK" . 4397)
+ ("HANGUL CHOSEONG SIOS-NIEUN" . 4398)
+ ("HANGUL CHOSEONG SIOS-TIKEUT" . 4399)
+ ("HANGUL CHOSEONG SIOS-RIEUL" . 4400)
+ ("HANGUL CHOSEONG SIOS-MIEUM" . 4401)
+ ("HANGUL CHOSEONG SIOS-PIEUP" . 4402)
+ ("HANGUL CHOSEONG SIOS-PIEUP-KIYEOK" . 4403)
+ ("HANGUL CHOSEONG SIOS-SSANGSIOS" . 4404)
+ ("HANGUL CHOSEONG SIOS-IEUNG" . 4405)
+ ("HANGUL CHOSEONG SIOS-CIEUC" . 4406)
+ ("HANGUL CHOSEONG SIOS-CHIEUCH" . 4407)
+ ("HANGUL CHOSEONG SIOS-KHIEUKH" . 4408)
+ ("HANGUL CHOSEONG SIOS-THIEUTH" . 4409)
+ ("HANGUL CHOSEONG SIOS-PHIEUPH" . 4410)
+ ("HANGUL CHOSEONG SIOS-HIEUH" . 4411)
+ ("HANGUL CHOSEONG CHITUEUMSIOS" . 4412)
+ ("HANGUL CHOSEONG CHITUEUMSSANGSIOS" . 4413)
+ ("HANGUL CHOSEONG CEONGCHIEUMSIOS" . 4414)
+ ("HANGUL CHOSEONG CEONGCHIEUMSSANGSIOS" . 4415)
+ ("HANGUL CHOSEONG PANSIOS" . 4416)
+ ("HANGUL CHOSEONG IEUNG-KIYEOK" . 4417)
+ ("HANGUL CHOSEONG IEUNG-TIKEUT" . 4418)
+ ("HANGUL CHOSEONG IEUNG-MIEUM" . 4419)
+ ("HANGUL CHOSEONG IEUNG-PIEUP" . 4420)
+ ("HANGUL CHOSEONG IEUNG-SIOS" . 4421)
+ ("HANGUL CHOSEONG IEUNG-PANSIOS" . 4422)
+ ("HANGUL CHOSEONG SSANGIEUNG" . 4423)
+ ("HANGUL CHOSEONG IEUNG-CIEUC" . 4424)
+ ("HANGUL CHOSEONG IEUNG-CHIEUCH" . 4425)
+ ("HANGUL CHOSEONG IEUNG-THIEUTH" . 4426)
+ ("HANGUL CHOSEONG IEUNG-PHIEUPH" . 4427)
+ ("HANGUL CHOSEONG YESIEUNG" . 4428)
+ ("HANGUL CHOSEONG CIEUC-IEUNG" . 4429)
+ ("HANGUL CHOSEONG CHITUEUMCIEUC" . 4430)
+ ("HANGUL CHOSEONG CHITUEUMSSANGCIEUC" . 4431)
+ ("HANGUL CHOSEONG CEONGCHIEUMCIEUC" . 4432)
+ ("HANGUL CHOSEONG CEONGCHIEUMSSANGCIEUC" . 4433)
+ ("HANGUL CHOSEONG CHIEUCH-KHIEUKH" . 4434)
+ ("HANGUL CHOSEONG CHIEUCH-HIEUH" . 4435)
+ ("HANGUL CHOSEONG CHITUEUMCHIEUCH" . 4436)
+ ("HANGUL CHOSEONG CEONGCHIEUMCHIEUCH" . 4437)
+ ("HANGUL CHOSEONG PHIEUPH-PIEUP" . 4438)
+ ("HANGUL CHOSEONG KAPYEOUNPHIEUPH" . 4439)
+ ("HANGUL CHOSEONG SSANGHIEUH" . 4440)
+ ("HANGUL CHOSEONG YEORINHIEUH" . 4441)
+ ("HANGUL CHOSEONG FILLER" . 4447)
+ ("HANGUL JUNGSEONG FILLER" . 4448)
+ ("HANGUL JUNGSEONG A" . 4449)
+ ("HANGUL JUNGSEONG AE" . 4450)
+ ("HANGUL JUNGSEONG YA" . 4451)
+ ("HANGUL JUNGSEONG YAE" . 4452)
+ ("HANGUL JUNGSEONG EO" . 4453)
+ ("HANGUL JUNGSEONG E" . 4454)
+ ("HANGUL JUNGSEONG YEO" . 4455)
+ ("HANGUL JUNGSEONG YE" . 4456)
+ ("HANGUL JUNGSEONG O" . 4457)
+ ("HANGUL JUNGSEONG WA" . 4458)
+ ("HANGUL JUNGSEONG WAE" . 4459)
+ ("HANGUL JUNGSEONG OE" . 4460)
+ ("HANGUL JUNGSEONG YO" . 4461)
+ ("HANGUL JUNGSEONG U" . 4462)
+ ("HANGUL JUNGSEONG WEO" . 4463)
+ ("HANGUL JUNGSEONG WE" . 4464)
+ ("HANGUL JUNGSEONG WI" . 4465)
+ ("HANGUL JUNGSEONG YU" . 4466)
+ ("HANGUL JUNGSEONG EU" . 4467)
+ ("HANGUL JUNGSEONG YI" . 4468)
+ ("HANGUL JUNGSEONG I" . 4469)
+ ("HANGUL JUNGSEONG A-O" . 4470)
+ ("HANGUL JUNGSEONG A-U" . 4471)
+ ("HANGUL JUNGSEONG YA-O" . 4472)
+ ("HANGUL JUNGSEONG YA-YO" . 4473)
+ ("HANGUL JUNGSEONG EO-O" . 4474)
+ ("HANGUL JUNGSEONG EO-U" . 4475)
+ ("HANGUL JUNGSEONG EO-EU" . 4476)
+ ("HANGUL JUNGSEONG YEO-O" . 4477)
+ ("HANGUL JUNGSEONG YEO-U" . 4478)
+ ("HANGUL JUNGSEONG O-EO" . 4479)
+ ("HANGUL JUNGSEONG O-E" . 4480)
+ ("HANGUL JUNGSEONG O-YE" . 4481)
+ ("HANGUL JUNGSEONG O-O" . 4482)
+ ("HANGUL JUNGSEONG O-U" . 4483)
+ ("HANGUL JUNGSEONG YO-YA" . 4484)
+ ("HANGUL JUNGSEONG YO-YAE" . 4485)
+ ("HANGUL JUNGSEONG YO-YEO" . 4486)
+ ("HANGUL JUNGSEONG YO-O" . 4487)
+ ("HANGUL JUNGSEONG YO-I" . 4488)
+ ("HANGUL JUNGSEONG U-A" . 4489)
+ ("HANGUL JUNGSEONG U-AE" . 4490)
+ ("HANGUL JUNGSEONG U-EO-EU" . 4491)
+ ("HANGUL JUNGSEONG U-YE" . 4492)
+ ("HANGUL JUNGSEONG U-U" . 4493)
+ ("HANGUL JUNGSEONG YU-A" . 4494)
+ ("HANGUL JUNGSEONG YU-EO" . 4495)
+ ("HANGUL JUNGSEONG YU-E" . 4496)
+ ("HANGUL JUNGSEONG YU-YEO" . 4497)
+ ("HANGUL JUNGSEONG YU-YE" . 4498)
+ ("HANGUL JUNGSEONG YU-U" . 4499)
+ ("HANGUL JUNGSEONG YU-I" . 4500)
+ ("HANGUL JUNGSEONG EU-U" . 4501)
+ ("HANGUL JUNGSEONG EU-EU" . 4502)
+ ("HANGUL JUNGSEONG YI-U" . 4503)
+ ("HANGUL JUNGSEONG I-A" . 4504)
+ ("HANGUL JUNGSEONG I-YA" . 4505)
+ ("HANGUL JUNGSEONG I-O" . 4506)
+ ("HANGUL JUNGSEONG I-U" . 4507)
+ ("HANGUL JUNGSEONG I-EU" . 4508)
+ ("HANGUL JUNGSEONG I-ARAEA" . 4509)
+ ("HANGUL JUNGSEONG ARAEA" . 4510)
+ ("HANGUL JUNGSEONG ARAEA-EO" . 4511)
+ ("HANGUL JUNGSEONG ARAEA-U" . 4512)
+ ("HANGUL JUNGSEONG ARAEA-I" . 4513)
+ ("HANGUL JUNGSEONG SSANGARAEA" . 4514)
+ ("HANGUL JONGSEONG KIYEOK" . 4520)
+ ("HANGUL JONGSEONG SSANGKIYEOK" . 4521)
+ ("HANGUL JONGSEONG KIYEOK-SIOS" . 4522)
+ ("HANGUL JONGSEONG NIEUN" . 4523)
+ ("HANGUL JONGSEONG NIEUN-CIEUC" . 4524)
+ ("HANGUL JONGSEONG NIEUN-HIEUH" . 4525)
+ ("HANGUL JONGSEONG TIKEUT" . 4526)
+ ("HANGUL JONGSEONG RIEUL" . 4527)
+ ("HANGUL JONGSEONG RIEUL-KIYEOK" . 4528)
+ ("HANGUL JONGSEONG RIEUL-MIEUM" . 4529)
+ ("HANGUL JONGSEONG RIEUL-PIEUP" . 4530)
+ ("HANGUL JONGSEONG RIEUL-SIOS" . 4531)
+ ("HANGUL JONGSEONG RIEUL-THIEUTH" . 4532)
+ ("HANGUL JONGSEONG RIEUL-PHIEUPH" . 4533)
+ ("HANGUL JONGSEONG RIEUL-HIEUH" . 4534)
+ ("HANGUL JONGSEONG MIEUM" . 4535)
+ ("HANGUL JONGSEONG PIEUP" . 4536)
+ ("HANGUL JONGSEONG PIEUP-SIOS" . 4537)
+ ("HANGUL JONGSEONG SIOS" . 4538)
+ ("HANGUL JONGSEONG SSANGSIOS" . 4539)
+ ("HANGUL JONGSEONG IEUNG" . 4540)
+ ("HANGUL JONGSEONG CIEUC" . 4541)
+ ("HANGUL JONGSEONG CHIEUCH" . 4542)
+ ("HANGUL JONGSEONG KHIEUKH" . 4543)
+ ("HANGUL JONGSEONG THIEUTH" . 4544)
+ ("HANGUL JONGSEONG PHIEUPH" . 4545)
+ ("HANGUL JONGSEONG HIEUH" . 4546)
+ ("HANGUL JONGSEONG KIYEOK-RIEUL" . 4547)
+ ("HANGUL JONGSEONG KIYEOK-SIOS-KIYEOK" . 4548)
+ ("HANGUL JONGSEONG NIEUN-KIYEOK" . 4549)
+ ("HANGUL JONGSEONG NIEUN-TIKEUT" . 4550)
+ ("HANGUL JONGSEONG NIEUN-SIOS" . 4551)
+ ("HANGUL JONGSEONG NIEUN-PANSIOS" . 4552)
+ ("HANGUL JONGSEONG NIEUN-THIEUTH" . 4553)
+ ("HANGUL JONGSEONG TIKEUT-KIYEOK" . 4554)
+ ("HANGUL JONGSEONG TIKEUT-RIEUL" . 4555)
+ ("HANGUL JONGSEONG RIEUL-KIYEOK-SIOS" . 4556)
+ ("HANGUL JONGSEONG RIEUL-NIEUN" . 4557)
+ ("HANGUL JONGSEONG RIEUL-TIKEUT" . 4558)
+ ("HANGUL JONGSEONG RIEUL-TIKEUT-HIEUH" . 4559)
+ ("HANGUL JONGSEONG SSANGRIEUL" . 4560)
+ ("HANGUL JONGSEONG RIEUL-MIEUM-KIYEOK" . 4561)
+ ("HANGUL JONGSEONG RIEUL-MIEUM-SIOS" . 4562)
+ ("HANGUL JONGSEONG RIEUL-PIEUP-SIOS" . 4563)
+ ("HANGUL JONGSEONG RIEUL-PIEUP-HIEUH" . 4564)
+ ("HANGUL JONGSEONG RIEUL-KAPYEOUNPIEUP" . 4565)
+ ("HANGUL JONGSEONG RIEUL-SSANGSIOS" . 4566)
+ ("HANGUL JONGSEONG RIEUL-PANSIOS" . 4567)
+ ("HANGUL JONGSEONG RIEUL-KHIEUKH" . 4568)
+ ("HANGUL JONGSEONG RIEUL-YEORINHIEUH" . 4569)
+ ("HANGUL JONGSEONG MIEUM-KIYEOK" . 4570)
+ ("HANGUL JONGSEONG MIEUM-RIEUL" . 4571)
+ ("HANGUL JONGSEONG MIEUM-PIEUP" . 4572)
+ ("HANGUL JONGSEONG MIEUM-SIOS" . 4573)
+ ("HANGUL JONGSEONG MIEUM-SSANGSIOS" . 4574)
+ ("HANGUL JONGSEONG MIEUM-PANSIOS" . 4575)
+ ("HANGUL JONGSEONG MIEUM-CHIEUCH" . 4576)
+ ("HANGUL JONGSEONG MIEUM-HIEUH" . 4577)
+ ("HANGUL JONGSEONG KAPYEOUNMIEUM" . 4578)
+ ("HANGUL JONGSEONG PIEUP-RIEUL" . 4579)
+ ("HANGUL JONGSEONG PIEUP-PHIEUPH" . 4580)
+ ("HANGUL JONGSEONG PIEUP-HIEUH" . 4581)
+ ("HANGUL JONGSEONG KAPYEOUNPIEUP" . 4582)
+ ("HANGUL JONGSEONG SIOS-KIYEOK" . 4583)
+ ("HANGUL JONGSEONG SIOS-TIKEUT" . 4584)
+ ("HANGUL JONGSEONG SIOS-RIEUL" . 4585)
+ ("HANGUL JONGSEONG SIOS-PIEUP" . 4586)
+ ("HANGUL JONGSEONG PANSIOS" . 4587)
+ ("HANGUL JONGSEONG IEUNG-KIYEOK" . 4588)
+ ("HANGUL JONGSEONG IEUNG-SSANGKIYEOK" . 4589)
+ ("HANGUL JONGSEONG SSANGIEUNG" . 4590)
+ ("HANGUL JONGSEONG IEUNG-KHIEUKH" . 4591)
+ ("HANGUL JONGSEONG YESIEUNG" . 4592)
+ ("HANGUL JONGSEONG YESIEUNG-SIOS" . 4593)
+ ("HANGUL JONGSEONG YESIEUNG-PANSIOS" . 4594)
+ ("HANGUL JONGSEONG PHIEUPH-PIEUP" . 4595)
+ ("HANGUL JONGSEONG KAPYEOUNPHIEUPH" . 4596)
+ ("HANGUL JONGSEONG HIEUH-NIEUN" . 4597)
+ ("HANGUL JONGSEONG HIEUH-RIEUL" . 4598)
+ ("HANGUL JONGSEONG HIEUH-MIEUM" . 4599)
+ ("HANGUL JONGSEONG HIEUH-PIEUP" . 4600)
+ ("HANGUL JONGSEONG YEORINHIEUH" . 4601)
+ ("ETHIOPIC SYLLABLE HA" . 4608)
+ ("ETHIOPIC SYLLABLE HU" . 4609)
+ ("ETHIOPIC SYLLABLE HI" . 4610)
+ ("ETHIOPIC SYLLABLE HAA" . 4611)
+ ("ETHIOPIC SYLLABLE HEE" . 4612)
+ ("ETHIOPIC SYLLABLE HE" . 4613)
+ ("ETHIOPIC SYLLABLE HO" . 4614)
+ ("ETHIOPIC SYLLABLE LA" . 4616)
+ ("ETHIOPIC SYLLABLE LU" . 4617)
+ ("ETHIOPIC SYLLABLE LI" . 4618)
+ ("ETHIOPIC SYLLABLE LAA" . 4619)
+ ("ETHIOPIC SYLLABLE LEE" . 4620)
+ ("ETHIOPIC SYLLABLE LE" . 4621)
+ ("ETHIOPIC SYLLABLE LO" . 4622)
+ ("ETHIOPIC SYLLABLE LWA" . 4623)
+ ("ETHIOPIC SYLLABLE HHA" . 4624)
+ ("ETHIOPIC SYLLABLE HHU" . 4625)
+ ("ETHIOPIC SYLLABLE HHI" . 4626)
+ ("ETHIOPIC SYLLABLE HHAA" . 4627)
+ ("ETHIOPIC SYLLABLE HHEE" . 4628)
+ ("ETHIOPIC SYLLABLE HHE" . 4629)
+ ("ETHIOPIC SYLLABLE HHO" . 4630)
+ ("ETHIOPIC SYLLABLE HHWA" . 4631)
+ ("ETHIOPIC SYLLABLE MA" . 4632)
+ ("ETHIOPIC SYLLABLE MU" . 4633)
+ ("ETHIOPIC SYLLABLE MI" . 4634)
+ ("ETHIOPIC SYLLABLE MAA" . 4635)
+ ("ETHIOPIC SYLLABLE MEE" . 4636)
+ ("ETHIOPIC SYLLABLE ME" . 4637)
+ ("ETHIOPIC SYLLABLE MO" . 4638)
+ ("ETHIOPIC SYLLABLE MWA" . 4639)
+ ("ETHIOPIC SYLLABLE SZA" . 4640)
+ ("ETHIOPIC SYLLABLE SZU" . 4641)
+ ("ETHIOPIC SYLLABLE SZI" . 4642)
+ ("ETHIOPIC SYLLABLE SZAA" . 4643)
+ ("ETHIOPIC SYLLABLE SZEE" . 4644)
+ ("ETHIOPIC SYLLABLE SZE" . 4645)
+ ("ETHIOPIC SYLLABLE SZO" . 4646)
+ ("ETHIOPIC SYLLABLE SZWA" . 4647)
+ ("ETHIOPIC SYLLABLE RA" . 4648)
+ ("ETHIOPIC SYLLABLE RU" . 4649)
+ ("ETHIOPIC SYLLABLE RI" . 4650)
+ ("ETHIOPIC SYLLABLE RAA" . 4651)
+ ("ETHIOPIC SYLLABLE REE" . 4652)
+ ("ETHIOPIC SYLLABLE RE" . 4653)
+ ("ETHIOPIC SYLLABLE RO" . 4654)
+ ("ETHIOPIC SYLLABLE RWA" . 4655)
+ ("ETHIOPIC SYLLABLE SA" . 4656)
+ ("ETHIOPIC SYLLABLE SU" . 4657)
+ ("ETHIOPIC SYLLABLE SI" . 4658)
+ ("ETHIOPIC SYLLABLE SAA" . 4659)
+ ("ETHIOPIC SYLLABLE SEE" . 4660)
+ ("ETHIOPIC SYLLABLE SE" . 4661)
+ ("ETHIOPIC SYLLABLE SO" . 4662)
+ ("ETHIOPIC SYLLABLE SWA" . 4663)
+ ("ETHIOPIC SYLLABLE SHA" . 4664)
+ ("ETHIOPIC SYLLABLE SHU" . 4665)
+ ("ETHIOPIC SYLLABLE SHI" . 4666)
+ ("ETHIOPIC SYLLABLE SHAA" . 4667)
+ ("ETHIOPIC SYLLABLE SHEE" . 4668)
+ ("ETHIOPIC SYLLABLE SHE" . 4669)
+ ("ETHIOPIC SYLLABLE SHO" . 4670)
+ ("ETHIOPIC SYLLABLE SHWA" . 4671)
+ ("ETHIOPIC SYLLABLE QA" . 4672)
+ ("ETHIOPIC SYLLABLE QU" . 4673)
+ ("ETHIOPIC SYLLABLE QI" . 4674)
+ ("ETHIOPIC SYLLABLE QAA" . 4675)
+ ("ETHIOPIC SYLLABLE QEE" . 4676)
+ ("ETHIOPIC SYLLABLE QE" . 4677)
+ ("ETHIOPIC SYLLABLE QO" . 4678)
+ ("ETHIOPIC SYLLABLE QWA" . 4680)
+ ("ETHIOPIC SYLLABLE QWI" . 4682)
+ ("ETHIOPIC SYLLABLE QWAA" . 4683)
+ ("ETHIOPIC SYLLABLE QWEE" . 4684)
+ ("ETHIOPIC SYLLABLE QWE" . 4685)
+ ("ETHIOPIC SYLLABLE QHA" . 4688)
+ ("ETHIOPIC SYLLABLE QHU" . 4689)
+ ("ETHIOPIC SYLLABLE QHI" . 4690)
+ ("ETHIOPIC SYLLABLE QHAA" . 4691)
+ ("ETHIOPIC SYLLABLE QHEE" . 4692)
+ ("ETHIOPIC SYLLABLE QHE" . 4693)
+ ("ETHIOPIC SYLLABLE QHO" . 4694)
+ ("ETHIOPIC SYLLABLE QHWA" . 4696)
+ ("ETHIOPIC SYLLABLE QHWI" . 4698)
+ ("ETHIOPIC SYLLABLE QHWAA" . 4699)
+ ("ETHIOPIC SYLLABLE QHWEE" . 4700)
+ ("ETHIOPIC SYLLABLE QHWE" . 4701)
+ ("ETHIOPIC SYLLABLE BA" . 4704)
+ ("ETHIOPIC SYLLABLE BU" . 4705)
+ ("ETHIOPIC SYLLABLE BI" . 4706)
+ ("ETHIOPIC SYLLABLE BAA" . 4707)
+ ("ETHIOPIC SYLLABLE BEE" . 4708)
+ ("ETHIOPIC SYLLABLE BE" . 4709)
+ ("ETHIOPIC SYLLABLE BO" . 4710)
+ ("ETHIOPIC SYLLABLE BWA" . 4711)
+ ("ETHIOPIC SYLLABLE VA" . 4712)
+ ("ETHIOPIC SYLLABLE VU" . 4713)
+ ("ETHIOPIC SYLLABLE VI" . 4714)
+ ("ETHIOPIC SYLLABLE VAA" . 4715)
+ ("ETHIOPIC SYLLABLE VEE" . 4716)
+ ("ETHIOPIC SYLLABLE VE" . 4717)
+ ("ETHIOPIC SYLLABLE VO" . 4718)
+ ("ETHIOPIC SYLLABLE VWA" . 4719)
+ ("ETHIOPIC SYLLABLE TA" . 4720)
+ ("ETHIOPIC SYLLABLE TU" . 4721)
+ ("ETHIOPIC SYLLABLE TI" . 4722)
+ ("ETHIOPIC SYLLABLE TAA" . 4723)
+ ("ETHIOPIC SYLLABLE TEE" . 4724)
+ ("ETHIOPIC SYLLABLE TE" . 4725)
+ ("ETHIOPIC SYLLABLE TO" . 4726)
+ ("ETHIOPIC SYLLABLE TWA" . 4727)
+ ("ETHIOPIC SYLLABLE CA" . 4728)
+ ("ETHIOPIC SYLLABLE CU" . 4729)
+ ("ETHIOPIC SYLLABLE CI" . 4730)
+ ("ETHIOPIC SYLLABLE CAA" . 4731)
+ ("ETHIOPIC SYLLABLE CEE" . 4732)
+ ("ETHIOPIC SYLLABLE CE" . 4733)
+ ("ETHIOPIC SYLLABLE CO" . 4734)
+ ("ETHIOPIC SYLLABLE CWA" . 4735)
+ ("ETHIOPIC SYLLABLE XA" . 4736)
+ ("ETHIOPIC SYLLABLE XU" . 4737)
+ ("ETHIOPIC SYLLABLE XI" . 4738)
+ ("ETHIOPIC SYLLABLE XAA" . 4739)
+ ("ETHIOPIC SYLLABLE XEE" . 4740)
+ ("ETHIOPIC SYLLABLE XE" . 4741)
+ ("ETHIOPIC SYLLABLE XO" . 4742)
+ ("ETHIOPIC SYLLABLE XWA" . 4744)
+ ("ETHIOPIC SYLLABLE XWI" . 4746)
+ ("ETHIOPIC SYLLABLE XWAA" . 4747)
+ ("ETHIOPIC SYLLABLE XWEE" . 4748)
+ ("ETHIOPIC SYLLABLE XWE" . 4749)
+ ("ETHIOPIC SYLLABLE NA" . 4752)
+ ("ETHIOPIC SYLLABLE NU" . 4753)
+ ("ETHIOPIC SYLLABLE NI" . 4754)
+ ("ETHIOPIC SYLLABLE NAA" . 4755)
+ ("ETHIOPIC SYLLABLE NEE" . 4756)
+ ("ETHIOPIC SYLLABLE NE" . 4757)
+ ("ETHIOPIC SYLLABLE NO" . 4758)
+ ("ETHIOPIC SYLLABLE NWA" . 4759)
+ ("ETHIOPIC SYLLABLE NYA" . 4760)
+ ("ETHIOPIC SYLLABLE NYU" . 4761)
+ ("ETHIOPIC SYLLABLE NYI" . 4762)
+ ("ETHIOPIC SYLLABLE NYAA" . 4763)
+ ("ETHIOPIC SYLLABLE NYEE" . 4764)
+ ("ETHIOPIC SYLLABLE NYE" . 4765)
+ ("ETHIOPIC SYLLABLE NYO" . 4766)
+ ("ETHIOPIC SYLLABLE NYWA" . 4767)
+ ("ETHIOPIC SYLLABLE GLOTTAL A" . 4768)
+ ("ETHIOPIC SYLLABLE GLOTTAL U" . 4769)
+ ("ETHIOPIC SYLLABLE GLOTTAL I" . 4770)
+ ("ETHIOPIC SYLLABLE GLOTTAL AA" . 4771)
+ ("ETHIOPIC SYLLABLE GLOTTAL EE" . 4772)
+ ("ETHIOPIC SYLLABLE GLOTTAL E" . 4773)
+ ("ETHIOPIC SYLLABLE GLOTTAL O" . 4774)
+ ("ETHIOPIC SYLLABLE GLOTTAL WA" . 4775)
+ ("ETHIOPIC SYLLABLE KA" . 4776)
+ ("ETHIOPIC SYLLABLE KU" . 4777)
+ ("ETHIOPIC SYLLABLE KI" . 4778)
+ ("ETHIOPIC SYLLABLE KAA" . 4779)
+ ("ETHIOPIC SYLLABLE KEE" . 4780)
+ ("ETHIOPIC SYLLABLE KE" . 4781)
+ ("ETHIOPIC SYLLABLE KO" . 4782)
+ ("ETHIOPIC SYLLABLE KWA" . 4784)
+ ("ETHIOPIC SYLLABLE KWI" . 4786)
+ ("ETHIOPIC SYLLABLE KWAA" . 4787)
+ ("ETHIOPIC SYLLABLE KWEE" . 4788)
+ ("ETHIOPIC SYLLABLE KWE" . 4789)
+ ("ETHIOPIC SYLLABLE KXA" . 4792)
+ ("ETHIOPIC SYLLABLE KXU" . 4793)
+ ("ETHIOPIC SYLLABLE KXI" . 4794)
+ ("ETHIOPIC SYLLABLE KXAA" . 4795)
+ ("ETHIOPIC SYLLABLE KXEE" . 4796)
+ ("ETHIOPIC SYLLABLE KXE" . 4797)
+ ("ETHIOPIC SYLLABLE KXO" . 4798)
+ ("ETHIOPIC SYLLABLE KXWA" . 4800)
+ ("ETHIOPIC SYLLABLE KXWI" . 4802)
+ ("ETHIOPIC SYLLABLE KXWAA" . 4803)
+ ("ETHIOPIC SYLLABLE KXWEE" . 4804)
+ ("ETHIOPIC SYLLABLE KXWE" . 4805)
+ ("ETHIOPIC SYLLABLE WA" . 4808)
+ ("ETHIOPIC SYLLABLE WU" . 4809)
+ ("ETHIOPIC SYLLABLE WI" . 4810)
+ ("ETHIOPIC SYLLABLE WAA" . 4811)
+ ("ETHIOPIC SYLLABLE WEE" . 4812)
+ ("ETHIOPIC SYLLABLE WE" . 4813)
+ ("ETHIOPIC SYLLABLE WO" . 4814)
+ ("ETHIOPIC SYLLABLE PHARYNGEAL A" . 4816)
+ ("ETHIOPIC SYLLABLE PHARYNGEAL U" . 4817)
+ ("ETHIOPIC SYLLABLE PHARYNGEAL I" . 4818)
+ ("ETHIOPIC SYLLABLE PHARYNGEAL AA" . 4819)
+ ("ETHIOPIC SYLLABLE PHARYNGEAL EE" . 4820)
+ ("ETHIOPIC SYLLABLE PHARYNGEAL E" . 4821)
+ ("ETHIOPIC SYLLABLE PHARYNGEAL O" . 4822)
+ ("ETHIOPIC SYLLABLE ZA" . 4824)
+ ("ETHIOPIC SYLLABLE ZU" . 4825)
+ ("ETHIOPIC SYLLABLE ZI" . 4826)
+ ("ETHIOPIC SYLLABLE ZAA" . 4827)
+ ("ETHIOPIC SYLLABLE ZEE" . 4828)
+ ("ETHIOPIC SYLLABLE ZE" . 4829)
+ ("ETHIOPIC SYLLABLE ZO" . 4830)
+ ("ETHIOPIC SYLLABLE ZWA" . 4831)
+ ("ETHIOPIC SYLLABLE ZHA" . 4832)
+ ("ETHIOPIC SYLLABLE ZHU" . 4833)
+ ("ETHIOPIC SYLLABLE ZHI" . 4834)
+ ("ETHIOPIC SYLLABLE ZHAA" . 4835)
+ ("ETHIOPIC SYLLABLE ZHEE" . 4836)
+ ("ETHIOPIC SYLLABLE ZHE" . 4837)
+ ("ETHIOPIC SYLLABLE ZHO" . 4838)
+ ("ETHIOPIC SYLLABLE ZHWA" . 4839)
+ ("ETHIOPIC SYLLABLE YA" . 4840)
+ ("ETHIOPIC SYLLABLE YU" . 4841)
+ ("ETHIOPIC SYLLABLE YI" . 4842)
+ ("ETHIOPIC SYLLABLE YAA" . 4843)
+ ("ETHIOPIC SYLLABLE YEE" . 4844)
+ ("ETHIOPIC SYLLABLE YE" . 4845)
+ ("ETHIOPIC SYLLABLE YO" . 4846)
+ ("ETHIOPIC SYLLABLE DA" . 4848)
+ ("ETHIOPIC SYLLABLE DU" . 4849)
+ ("ETHIOPIC SYLLABLE DI" . 4850)
+ ("ETHIOPIC SYLLABLE DAA" . 4851)
+ ("ETHIOPIC SYLLABLE DEE" . 4852)
+ ("ETHIOPIC SYLLABLE DE" . 4853)
+ ("ETHIOPIC SYLLABLE DO" . 4854)
+ ("ETHIOPIC SYLLABLE DWA" . 4855)
+ ("ETHIOPIC SYLLABLE DDA" . 4856)
+ ("ETHIOPIC SYLLABLE DDU" . 4857)
+ ("ETHIOPIC SYLLABLE DDI" . 4858)
+ ("ETHIOPIC SYLLABLE DDAA" . 4859)
+ ("ETHIOPIC SYLLABLE DDEE" . 4860)
+ ("ETHIOPIC SYLLABLE DDE" . 4861)
+ ("ETHIOPIC SYLLABLE DDO" . 4862)
+ ("ETHIOPIC SYLLABLE DDWA" . 4863)
+ ("ETHIOPIC SYLLABLE JA" . 4864)
+ ("ETHIOPIC SYLLABLE JU" . 4865)
+ ("ETHIOPIC SYLLABLE JI" . 4866)
+ ("ETHIOPIC SYLLABLE JAA" . 4867)
+ ("ETHIOPIC SYLLABLE JEE" . 4868)
+ ("ETHIOPIC SYLLABLE JE" . 4869)
+ ("ETHIOPIC SYLLABLE JO" . 4870)
+ ("ETHIOPIC SYLLABLE JWA" . 4871)
+ ("ETHIOPIC SYLLABLE GA" . 4872)
+ ("ETHIOPIC SYLLABLE GU" . 4873)
+ ("ETHIOPIC SYLLABLE GI" . 4874)
+ ("ETHIOPIC SYLLABLE GAA" . 4875)
+ ("ETHIOPIC SYLLABLE GEE" . 4876)
+ ("ETHIOPIC SYLLABLE GE" . 4877)
+ ("ETHIOPIC SYLLABLE GO" . 4878)
+ ("ETHIOPIC SYLLABLE GWA" . 4880)
+ ("ETHIOPIC SYLLABLE GWI" . 4882)
+ ("ETHIOPIC SYLLABLE GWAA" . 4883)
+ ("ETHIOPIC SYLLABLE GWEE" . 4884)
+ ("ETHIOPIC SYLLABLE GWE" . 4885)
+ ("ETHIOPIC SYLLABLE GGA" . 4888)
+ ("ETHIOPIC SYLLABLE GGU" . 4889)
+ ("ETHIOPIC SYLLABLE GGI" . 4890)
+ ("ETHIOPIC SYLLABLE GGAA" . 4891)
+ ("ETHIOPIC SYLLABLE GGEE" . 4892)
+ ("ETHIOPIC SYLLABLE GGE" . 4893)
+ ("ETHIOPIC SYLLABLE GGO" . 4894)
+ ("ETHIOPIC SYLLABLE THA" . 4896)
+ ("ETHIOPIC SYLLABLE THU" . 4897)
+ ("ETHIOPIC SYLLABLE THI" . 4898)
+ ("ETHIOPIC SYLLABLE THAA" . 4899)
+ ("ETHIOPIC SYLLABLE THEE" . 4900)
+ ("ETHIOPIC SYLLABLE THE" . 4901)
+ ("ETHIOPIC SYLLABLE THO" . 4902)
+ ("ETHIOPIC SYLLABLE THWA" . 4903)
+ ("ETHIOPIC SYLLABLE CHA" . 4904)
+ ("ETHIOPIC SYLLABLE CHU" . 4905)
+ ("ETHIOPIC SYLLABLE CHI" . 4906)
+ ("ETHIOPIC SYLLABLE CHAA" . 4907)
+ ("ETHIOPIC SYLLABLE CHEE" . 4908)
+ ("ETHIOPIC SYLLABLE CHE" . 4909)
+ ("ETHIOPIC SYLLABLE CHO" . 4910)
+ ("ETHIOPIC SYLLABLE CHWA" . 4911)
+ ("ETHIOPIC SYLLABLE PHA" . 4912)
+ ("ETHIOPIC SYLLABLE PHU" . 4913)
+ ("ETHIOPIC SYLLABLE PHI" . 4914)
+ ("ETHIOPIC SYLLABLE PHAA" . 4915)
+ ("ETHIOPIC SYLLABLE PHEE" . 4916)
+ ("ETHIOPIC SYLLABLE PHE" . 4917)
+ ("ETHIOPIC SYLLABLE PHO" . 4918)
+ ("ETHIOPIC SYLLABLE PHWA" . 4919)
+ ("ETHIOPIC SYLLABLE TSA" . 4920)
+ ("ETHIOPIC SYLLABLE TSU" . 4921)
+ ("ETHIOPIC SYLLABLE TSI" . 4922)
+ ("ETHIOPIC SYLLABLE TSAA" . 4923)
+ ("ETHIOPIC SYLLABLE TSEE" . 4924)
+ ("ETHIOPIC SYLLABLE TSE" . 4925)
+ ("ETHIOPIC SYLLABLE TSO" . 4926)
+ ("ETHIOPIC SYLLABLE TSWA" . 4927)
+ ("ETHIOPIC SYLLABLE TZA" . 4928)
+ ("ETHIOPIC SYLLABLE TZU" . 4929)
+ ("ETHIOPIC SYLLABLE TZI" . 4930)
+ ("ETHIOPIC SYLLABLE TZAA" . 4931)
+ ("ETHIOPIC SYLLABLE TZEE" . 4932)
+ ("ETHIOPIC SYLLABLE TZE" . 4933)
+ ("ETHIOPIC SYLLABLE TZO" . 4934)
+ ("ETHIOPIC SYLLABLE FA" . 4936)
+ ("ETHIOPIC SYLLABLE FU" . 4937)
+ ("ETHIOPIC SYLLABLE FI" . 4938)
+ ("ETHIOPIC SYLLABLE FAA" . 4939)
+ ("ETHIOPIC SYLLABLE FEE" . 4940)
+ ("ETHIOPIC SYLLABLE FE" . 4941)
+ ("ETHIOPIC SYLLABLE FO" . 4942)
+ ("ETHIOPIC SYLLABLE FWA" . 4943)
+ ("ETHIOPIC SYLLABLE PA" . 4944)
+ ("ETHIOPIC SYLLABLE PU" . 4945)
+ ("ETHIOPIC SYLLABLE PI" . 4946)
+ ("ETHIOPIC SYLLABLE PAA" . 4947)
+ ("ETHIOPIC SYLLABLE PEE" . 4948)
+ ("ETHIOPIC SYLLABLE PE" . 4949)
+ ("ETHIOPIC SYLLABLE PO" . 4950)
+ ("ETHIOPIC SYLLABLE PWA" . 4951)
+ ("ETHIOPIC SYLLABLE RYA" . 4952)
+ ("ETHIOPIC SYLLABLE MYA" . 4953)
+ ("ETHIOPIC SYLLABLE FYA" . 4954)
+ ("ETHIOPIC WORDSPACE" . 4961)
+ ("ETHIOPIC FULL STOP" . 4962)
+ ("ETHIOPIC COMMA" . 4963)
+ ("ETHIOPIC SEMICOLON" . 4964)
+ ("ETHIOPIC COLON" . 4965)
+ ("ETHIOPIC PREFACE COLON" . 4966)
+ ("ETHIOPIC QUESTION MARK" . 4967)
+ ("ETHIOPIC PARAGRAPH SEPARATOR" . 4968)
+ ("ETHIOPIC DIGIT ONE" . 4969)
+ ("ETHIOPIC DIGIT TWO" . 4970)
+ ("ETHIOPIC DIGIT THREE" . 4971)
+ ("ETHIOPIC DIGIT FOUR" . 4972)
+ ("ETHIOPIC DIGIT FIVE" . 4973)
+ ("ETHIOPIC DIGIT SIX" . 4974)
+ ("ETHIOPIC DIGIT SEVEN" . 4975)
+ ("ETHIOPIC DIGIT EIGHT" . 4976)
+ ("ETHIOPIC DIGIT NINE" . 4977)
+ ("ETHIOPIC NUMBER TEN" . 4978)
+ ("ETHIOPIC NUMBER TWENTY" . 4979)
+ ("ETHIOPIC NUMBER THIRTY" . 4980)
+ ("ETHIOPIC NUMBER FORTY" . 4981)
+ ("ETHIOPIC NUMBER FIFTY" . 4982)
+ ("ETHIOPIC NUMBER SIXTY" . 4983)
+ ("ETHIOPIC NUMBER SEVENTY" . 4984)
+ ("ETHIOPIC NUMBER EIGHTY" . 4985)
+ ("ETHIOPIC NUMBER NINETY" . 4986)
+ ("ETHIOPIC NUMBER HUNDRED" . 4987)
+ ("ETHIOPIC NUMBER TEN THOUSAND" . 4988)
+ ("CHEROKEE LETTER A" . 5024)
+ ("CHEROKEE LETTER E" . 5025)
+ ("CHEROKEE LETTER I" . 5026)
+ ("CHEROKEE LETTER O" . 5027)
+ ("CHEROKEE LETTER U" . 5028)
+ ("CHEROKEE LETTER V" . 5029)
+ ("CHEROKEE LETTER GA" . 5030)
+ ("CHEROKEE LETTER KA" . 5031)
+ ("CHEROKEE LETTER GE" . 5032)
+ ("CHEROKEE LETTER GI" . 5033)
+ ("CHEROKEE LETTER GO" . 5034)
+ ("CHEROKEE LETTER GU" . 5035)
+ ("CHEROKEE LETTER GV" . 5036)
+ ("CHEROKEE LETTER HA" . 5037)
+ ("CHEROKEE LETTER HE" . 5038)
+ ("CHEROKEE LETTER HI" . 5039)
+ ("CHEROKEE LETTER HO" . 5040)
+ ("CHEROKEE LETTER HU" . 5041)
+ ("CHEROKEE LETTER HV" . 5042)
+ ("CHEROKEE LETTER LA" . 5043)
+ ("CHEROKEE LETTER LE" . 5044)
+ ("CHEROKEE LETTER LI" . 5045)
+ ("CHEROKEE LETTER LO" . 5046)
+ ("CHEROKEE LETTER LU" . 5047)
+ ("CHEROKEE LETTER LV" . 5048)
+ ("CHEROKEE LETTER MA" . 5049)
+ ("CHEROKEE LETTER ME" . 5050)
+ ("CHEROKEE LETTER MI" . 5051)
+ ("CHEROKEE LETTER MO" . 5052)
+ ("CHEROKEE LETTER MU" . 5053)
+ ("CHEROKEE LETTER NA" . 5054)
+ ("CHEROKEE LETTER HNA" . 5055)
+ ("CHEROKEE LETTER NAH" . 5056)
+ ("CHEROKEE LETTER NE" . 5057)
+ ("CHEROKEE LETTER NI" . 5058)
+ ("CHEROKEE LETTER NO" . 5059)
+ ("CHEROKEE LETTER NU" . 5060)
+ ("CHEROKEE LETTER NV" . 5061)
+ ("CHEROKEE LETTER QUA" . 5062)
+ ("CHEROKEE LETTER QUE" . 5063)
+ ("CHEROKEE LETTER QUI" . 5064)
+ ("CHEROKEE LETTER QUO" . 5065)
+ ("CHEROKEE LETTER QUU" . 5066)
+ ("CHEROKEE LETTER QUV" . 5067)
+ ("CHEROKEE LETTER SA" . 5068)
+ ("CHEROKEE LETTER S" . 5069)
+ ("CHEROKEE LETTER SE" . 5070)
+ ("CHEROKEE LETTER SI" . 5071)
+ ("CHEROKEE LETTER SO" . 5072)
+ ("CHEROKEE LETTER SU" . 5073)
+ ("CHEROKEE LETTER SV" . 5074)
+ ("CHEROKEE LETTER DA" . 5075)
+ ("CHEROKEE LETTER TA" . 5076)
+ ("CHEROKEE LETTER DE" . 5077)
+ ("CHEROKEE LETTER TE" . 5078)
+ ("CHEROKEE LETTER DI" . 5079)
+ ("CHEROKEE LETTER TI" . 5080)
+ ("CHEROKEE LETTER DO" . 5081)
+ ("CHEROKEE LETTER DU" . 5082)
+ ("CHEROKEE LETTER DV" . 5083)
+ ("CHEROKEE LETTER DLA" . 5084)
+ ("CHEROKEE LETTER TLA" . 5085)
+ ("CHEROKEE LETTER TLE" . 5086)
+ ("CHEROKEE LETTER TLI" . 5087)
+ ("CHEROKEE LETTER TLO" . 5088)
+ ("CHEROKEE LETTER TLU" . 5089)
+ ("CHEROKEE LETTER TLV" . 5090)
+ ("CHEROKEE LETTER TSA" . 5091)
+ ("CHEROKEE LETTER TSE" . 5092)
+ ("CHEROKEE LETTER TSI" . 5093)
+ ("CHEROKEE LETTER TSO" . 5094)
+ ("CHEROKEE LETTER TSU" . 5095)
+ ("CHEROKEE LETTER TSV" . 5096)
+ ("CHEROKEE LETTER WA" . 5097)
+ ("CHEROKEE LETTER WE" . 5098)
+ ("CHEROKEE LETTER WI" . 5099)
+ ("CHEROKEE LETTER WO" . 5100)
+ ("CHEROKEE LETTER WU" . 5101)
+ ("CHEROKEE LETTER WV" . 5102)
+ ("CHEROKEE LETTER YA" . 5103)
+ ("CHEROKEE LETTER YE" . 5104)
+ ("CHEROKEE LETTER YI" . 5105)
+ ("CHEROKEE LETTER YO" . 5106)
+ ("CHEROKEE LETTER YU" . 5107)
+ ("CHEROKEE LETTER YV" . 5108)
+ ("CANADIAN SYLLABICS E" . 5121)
+ ("CANADIAN SYLLABICS AAI" . 5122)
+ ("CANADIAN SYLLABICS I" . 5123)
+ ("CANADIAN SYLLABICS II" . 5124)
+ ("CANADIAN SYLLABICS O" . 5125)
+ ("CANADIAN SYLLABICS OO" . 5126)
+ ("CANADIAN SYLLABICS Y-CREE OO" . 5127)
+ ("CANADIAN SYLLABICS CARRIER EE" . 5128)
+ ("CANADIAN SYLLABICS CARRIER I" . 5129)
+ ("CANADIAN SYLLABICS A" . 5130)
+ ("CANADIAN SYLLABICS AA" . 5131)
+ ("CANADIAN SYLLABICS WE" . 5132)
+ ("CANADIAN SYLLABICS WEST-CREE WE" . 5133)
+ ("CANADIAN SYLLABICS WI" . 5134)
+ ("CANADIAN SYLLABICS WEST-CREE WI" . 5135)
+ ("CANADIAN SYLLABICS WII" . 5136)
+ ("CANADIAN SYLLABICS WEST-CREE WII" . 5137)
+ ("CANADIAN SYLLABICS WO" . 5138)
+ ("CANADIAN SYLLABICS WEST-CREE WO" . 5139)
+ ("CANADIAN SYLLABICS WOO" . 5140)
+ ("CANADIAN SYLLABICS WEST-CREE WOO" . 5141)
+ ("CANADIAN SYLLABICS NASKAPI WOO" . 5142)
+ ("CANADIAN SYLLABICS WA" . 5143)
+ ("CANADIAN SYLLABICS WEST-CREE WA" . 5144)
+ ("CANADIAN SYLLABICS WAA" . 5145)
+ ("CANADIAN SYLLABICS WEST-CREE WAA" . 5146)
+ ("CANADIAN SYLLABICS NASKAPI WAA" . 5147)
+ ("CANADIAN SYLLABICS AI" . 5148)
+ ("CANADIAN SYLLABICS Y-CREE W" . 5149)
+ ("CANADIAN SYLLABICS GLOTTAL STOP" . 5150)
+ ("CANADIAN SYLLABICS FINAL ACUTE" . 5151)
+ ("CANADIAN SYLLABICS FINAL GRAVE" . 5152)
+ ("CANADIAN SYLLABICS FINAL BOTTOM HALF RING" . 5153)
+ ("CANADIAN SYLLABICS FINAL TOP HALF RING" . 5154)
+ ("CANADIAN SYLLABICS FINAL RIGHT HALF RING" . 5155)
+ ("CANADIAN SYLLABICS FINAL RING" . 5156)
+ ("CANADIAN SYLLABICS FINAL DOUBLE ACUTE" . 5157)
+ ("CANADIAN SYLLABICS FINAL DOUBLE SHORT VERTICAL STROKES" . 5158)
+ ("CANADIAN SYLLABICS FINAL MIDDLE DOT" . 5159)
+ ("CANADIAN SYLLABICS FINAL SHORT HORIZONTAL STROKE" . 5160)
+ ("CANADIAN SYLLABICS FINAL PLUS" . 5161)
+ ("CANADIAN SYLLABICS FINAL DOWN TACK" . 5162)
+ ("CANADIAN SYLLABICS EN" . 5163)
+ ("CANADIAN SYLLABICS IN" . 5164)
+ ("CANADIAN SYLLABICS ON" . 5165)
+ ("CANADIAN SYLLABICS AN" . 5166)
+ ("CANADIAN SYLLABICS PE" . 5167)
+ ("CANADIAN SYLLABICS PAAI" . 5168)
+ ("CANADIAN SYLLABICS PI" . 5169)
+ ("CANADIAN SYLLABICS PII" . 5170)
+ ("CANADIAN SYLLABICS PO" . 5171)
+ ("CANADIAN SYLLABICS POO" . 5172)
+ ("CANADIAN SYLLABICS Y-CREE POO" . 5173)
+ ("CANADIAN SYLLABICS CARRIER HEE" . 5174)
+ ("CANADIAN SYLLABICS CARRIER HI" . 5175)
+ ("CANADIAN SYLLABICS PA" . 5176)
+ ("CANADIAN SYLLABICS PAA" . 5177)
+ ("CANADIAN SYLLABICS PWE" . 5178)
+ ("CANADIAN SYLLABICS WEST-CREE PWE" . 5179)
+ ("CANADIAN SYLLABICS PWI" . 5180)
+ ("CANADIAN SYLLABICS WEST-CREE PWI" . 5181)
+ ("CANADIAN SYLLABICS PWII" . 5182)
+ ("CANADIAN SYLLABICS WEST-CREE PWII" . 5183)
+ ("CANADIAN SYLLABICS PWO" . 5184)
+ ("CANADIAN SYLLABICS WEST-CREE PWO" . 5185)
+ ("CANADIAN SYLLABICS PWOO" . 5186)
+ ("CANADIAN SYLLABICS WEST-CREE PWOO" . 5187)
+ ("CANADIAN SYLLABICS PWA" . 5188)
+ ("CANADIAN SYLLABICS WEST-CREE PWA" . 5189)
+ ("CANADIAN SYLLABICS PWAA" . 5190)
+ ("CANADIAN SYLLABICS WEST-CREE PWAA" . 5191)
+ ("CANADIAN SYLLABICS Y-CREE PWAA" . 5192)
+ ("CANADIAN SYLLABICS P" . 5193)
+ ("CANADIAN SYLLABICS WEST-CREE P" . 5194)
+ ("CANADIAN SYLLABICS CARRIER H" . 5195)
+ ("CANADIAN SYLLABICS TE" . 5196)
+ ("CANADIAN SYLLABICS TAAI" . 5197)
+ ("CANADIAN SYLLABICS TI" . 5198)
+ ("CANADIAN SYLLABICS TII" . 5199)
+ ("CANADIAN SYLLABICS TO" . 5200)
+ ("CANADIAN SYLLABICS TOO" . 5201)
+ ("CANADIAN SYLLABICS Y-CREE TOO" . 5202)
+ ("CANADIAN SYLLABICS CARRIER DEE" . 5203)
+ ("CANADIAN SYLLABICS CARRIER DI" . 5204)
+ ("CANADIAN SYLLABICS TA" . 5205)
+ ("CANADIAN SYLLABICS TAA" . 5206)
+ ("CANADIAN SYLLABICS TWE" . 5207)
+ ("CANADIAN SYLLABICS WEST-CREE TWE" . 5208)
+ ("CANADIAN SYLLABICS TWI" . 5209)
+ ("CANADIAN SYLLABICS WEST-CREE TWI" . 5210)
+ ("CANADIAN SYLLABICS TWII" . 5211)
+ ("CANADIAN SYLLABICS WEST-CREE TWII" . 5212)
+ ("CANADIAN SYLLABICS TWO" . 5213)
+ ("CANADIAN SYLLABICS WEST-CREE TWO" . 5214)
+ ("CANADIAN SYLLABICS TWOO" . 5215)
+ ("CANADIAN SYLLABICS WEST-CREE TWOO" . 5216)
+ ("CANADIAN SYLLABICS TWA" . 5217)
+ ("CANADIAN SYLLABICS WEST-CREE TWA" . 5218)
+ ("CANADIAN SYLLABICS TWAA" . 5219)
+ ("CANADIAN SYLLABICS WEST-CREE TWAA" . 5220)
+ ("CANADIAN SYLLABICS NASKAPI TWAA" . 5221)
+ ("CANADIAN SYLLABICS T" . 5222)
+ ("CANADIAN SYLLABICS TTE" . 5223)
+ ("CANADIAN SYLLABICS TTI" . 5224)
+ ("CANADIAN SYLLABICS TTO" . 5225)
+ ("CANADIAN SYLLABICS TTA" . 5226)
+ ("CANADIAN SYLLABICS KE" . 5227)
+ ("CANADIAN SYLLABICS KAAI" . 5228)
+ ("CANADIAN SYLLABICS KI" . 5229)
+ ("CANADIAN SYLLABICS KII" . 5230)
+ ("CANADIAN SYLLABICS KO" . 5231)
+ ("CANADIAN SYLLABICS KOO" . 5232)
+ ("CANADIAN SYLLABICS Y-CREE KOO" . 5233)
+ ("CANADIAN SYLLABICS KA" . 5234)
+ ("CANADIAN SYLLABICS KAA" . 5235)
+ ("CANADIAN SYLLABICS KWE" . 5236)
+ ("CANADIAN SYLLABICS WEST-CREE KWE" . 5237)
+ ("CANADIAN SYLLABICS KWI" . 5238)
+ ("CANADIAN SYLLABICS WEST-CREE KWI" . 5239)
+ ("CANADIAN SYLLABICS KWII" . 5240)
+ ("CANADIAN SYLLABICS WEST-CREE KWII" . 5241)
+ ("CANADIAN SYLLABICS KWO" . 5242)
+ ("CANADIAN SYLLABICS WEST-CREE KWO" . 5243)
+ ("CANADIAN SYLLABICS KWOO" . 5244)
+ ("CANADIAN SYLLABICS WEST-CREE KWOO" . 5245)
+ ("CANADIAN SYLLABICS KWA" . 5246)
+ ("CANADIAN SYLLABICS WEST-CREE KWA" . 5247)
+ ("CANADIAN SYLLABICS KWAA" . 5248)
+ ("CANADIAN SYLLABICS WEST-CREE KWAA" . 5249)
+ ("CANADIAN SYLLABICS NASKAPI KWAA" . 5250)
+ ("CANADIAN SYLLABICS K" . 5251)
+ ("CANADIAN SYLLABICS KW" . 5252)
+ ("CANADIAN SYLLABICS SOUTH-SLAVEY KEH" . 5253)
+ ("CANADIAN SYLLABICS SOUTH-SLAVEY KIH" . 5254)
+ ("CANADIAN SYLLABICS SOUTH-SLAVEY KOH" . 5255)
+ ("CANADIAN SYLLABICS SOUTH-SLAVEY KAH" . 5256)
+ ("CANADIAN SYLLABICS CE" . 5257)
+ ("CANADIAN SYLLABICS CAAI" . 5258)
+ ("CANADIAN SYLLABICS CI" . 5259)
+ ("CANADIAN SYLLABICS CII" . 5260)
+ ("CANADIAN SYLLABICS CO" . 5261)
+ ("CANADIAN SYLLABICS COO" . 5262)
+ ("CANADIAN SYLLABICS Y-CREE COO" . 5263)
+ ("CANADIAN SYLLABICS CA" . 5264)
+ ("CANADIAN SYLLABICS CAA" . 5265)
+ ("CANADIAN SYLLABICS CWE" . 5266)
+ ("CANADIAN SYLLABICS WEST-CREE CWE" . 5267)
+ ("CANADIAN SYLLABICS CWI" . 5268)
+ ("CANADIAN SYLLABICS WEST-CREE CWI" . 5269)
+ ("CANADIAN SYLLABICS CWII" . 5270)
+ ("CANADIAN SYLLABICS WEST-CREE CWII" . 5271)
+ ("CANADIAN SYLLABICS CWO" . 5272)
+ ("CANADIAN SYLLABICS WEST-CREE CWO" . 5273)
+ ("CANADIAN SYLLABICS CWOO" . 5274)
+ ("CANADIAN SYLLABICS WEST-CREE CWOO" . 5275)
+ ("CANADIAN SYLLABICS CWA" . 5276)
+ ("CANADIAN SYLLABICS WEST-CREE CWA" . 5277)
+ ("CANADIAN SYLLABICS CWAA" . 5278)
+ ("CANADIAN SYLLABICS WEST-CREE CWAA" . 5279)
+ ("CANADIAN SYLLABICS NASKAPI CWAA" . 5280)
+ ("CANADIAN SYLLABICS C" . 5281)
+ ("CANADIAN SYLLABICS SAYISI TH" . 5282)
+ ("CANADIAN SYLLABICS ME" . 5283)
+ ("CANADIAN SYLLABICS MAAI" . 5284)
+ ("CANADIAN SYLLABICS MI" . 5285)
+ ("CANADIAN SYLLABICS MII" . 5286)
+ ("CANADIAN SYLLABICS MO" . 5287)
+ ("CANADIAN SYLLABICS MOO" . 5288)
+ ("CANADIAN SYLLABICS Y-CREE MOO" . 5289)
+ ("CANADIAN SYLLABICS MA" . 5290)
+ ("CANADIAN SYLLABICS MAA" . 5291)
+ ("CANADIAN SYLLABICS MWE" . 5292)
+ ("CANADIAN SYLLABICS WEST-CREE MWE" . 5293)
+ ("CANADIAN SYLLABICS MWI" . 5294)
+ ("CANADIAN SYLLABICS WEST-CREE MWI" . 5295)
+ ("CANADIAN SYLLABICS MWII" . 5296)
+ ("CANADIAN SYLLABICS WEST-CREE MWII" . 5297)
+ ("CANADIAN SYLLABICS MWO" . 5298)
+ ("CANADIAN SYLLABICS WEST-CREE MWO" . 5299)
+ ("CANADIAN SYLLABICS MWOO" . 5300)
+ ("CANADIAN SYLLABICS WEST-CREE MWOO" . 5301)
+ ("CANADIAN SYLLABICS MWA" . 5302)
+ ("CANADIAN SYLLABICS WEST-CREE MWA" . 5303)
+ ("CANADIAN SYLLABICS MWAA" . 5304)
+ ("CANADIAN SYLLABICS WEST-CREE MWAA" . 5305)
+ ("CANADIAN SYLLABICS NASKAPI MWAA" . 5306)
+ ("CANADIAN SYLLABICS M" . 5307)
+ ("CANADIAN SYLLABICS WEST-CREE M" . 5308)
+ ("CANADIAN SYLLABICS MH" . 5309)
+ ("CANADIAN SYLLABICS ATHAPASCAN M" . 5310)
+ ("CANADIAN SYLLABICS SAYISI M" . 5311)
+ ("CANADIAN SYLLABICS NE" . 5312)
+ ("CANADIAN SYLLABICS NAAI" . 5313)
+ ("CANADIAN SYLLABICS NI" . 5314)
+ ("CANADIAN SYLLABICS NII" . 5315)
+ ("CANADIAN SYLLABICS NO" . 5316)
+ ("CANADIAN SYLLABICS NOO" . 5317)
+ ("CANADIAN SYLLABICS Y-CREE NOO" . 5318)
+ ("CANADIAN SYLLABICS NA" . 5319)
+ ("CANADIAN SYLLABICS NAA" . 5320)
+ ("CANADIAN SYLLABICS NWE" . 5321)
+ ("CANADIAN SYLLABICS WEST-CREE NWE" . 5322)
+ ("CANADIAN SYLLABICS NWA" . 5323)
+ ("CANADIAN SYLLABICS WEST-CREE NWA" . 5324)
+ ("CANADIAN SYLLABICS NWAA" . 5325)
+ ("CANADIAN SYLLABICS WEST-CREE NWAA" . 5326)
+ ("CANADIAN SYLLABICS NASKAPI NWAA" . 5327)
+ ("CANADIAN SYLLABICS N" . 5328)
+ ("CANADIAN SYLLABICS CARRIER NG" . 5329)
+ ("CANADIAN SYLLABICS NH" . 5330)
+ ("CANADIAN SYLLABICS LE" . 5331)
+ ("CANADIAN SYLLABICS LAAI" . 5332)
+ ("CANADIAN SYLLABICS LI" . 5333)
+ ("CANADIAN SYLLABICS LII" . 5334)
+ ("CANADIAN SYLLABICS LO" . 5335)
+ ("CANADIAN SYLLABICS LOO" . 5336)
+ ("CANADIAN SYLLABICS Y-CREE LOO" . 5337)
+ ("CANADIAN SYLLABICS LA" . 5338)
+ ("CANADIAN SYLLABICS LAA" . 5339)
+ ("CANADIAN SYLLABICS LWE" . 5340)
+ ("CANADIAN SYLLABICS WEST-CREE LWE" . 5341)
+ ("CANADIAN SYLLABICS LWI" . 5342)
+ ("CANADIAN SYLLABICS WEST-CREE LWI" . 5343)
+ ("CANADIAN SYLLABICS LWII" . 5344)
+ ("CANADIAN SYLLABICS WEST-CREE LWII" . 5345)
+ ("CANADIAN SYLLABICS LWO" . 5346)
+ ("CANADIAN SYLLABICS WEST-CREE LWO" . 5347)
+ ("CANADIAN SYLLABICS LWOO" . 5348)
+ ("CANADIAN SYLLABICS WEST-CREE LWOO" . 5349)
+ ("CANADIAN SYLLABICS LWA" . 5350)
+ ("CANADIAN SYLLABICS WEST-CREE LWA" . 5351)
+ ("CANADIAN SYLLABICS LWAA" . 5352)
+ ("CANADIAN SYLLABICS WEST-CREE LWAA" . 5353)
+ ("CANADIAN SYLLABICS L" . 5354)
+ ("CANADIAN SYLLABICS WEST-CREE L" . 5355)
+ ("CANADIAN SYLLABICS MEDIAL L" . 5356)
+ ("CANADIAN SYLLABICS SE" . 5357)
+ ("CANADIAN SYLLABICS SAAI" . 5358)
+ ("CANADIAN SYLLABICS SI" . 5359)
+ ("CANADIAN SYLLABICS SII" . 5360)
+ ("CANADIAN SYLLABICS SO" . 5361)
+ ("CANADIAN SYLLABICS SOO" . 5362)
+ ("CANADIAN SYLLABICS Y-CREE SOO" . 5363)
+ ("CANADIAN SYLLABICS SA" . 5364)
+ ("CANADIAN SYLLABICS SAA" . 5365)
+ ("CANADIAN SYLLABICS SWE" . 5366)
+ ("CANADIAN SYLLABICS WEST-CREE SWE" . 5367)
+ ("CANADIAN SYLLABICS SWI" . 5368)
+ ("CANADIAN SYLLABICS WEST-CREE SWI" . 5369)
+ ("CANADIAN SYLLABICS SWII" . 5370)
+ ("CANADIAN SYLLABICS WEST-CREE SWII" . 5371)
+ ("CANADIAN SYLLABICS SWO" . 5372)
+ ("CANADIAN SYLLABICS WEST-CREE SWO" . 5373)
+ ("CANADIAN SYLLABICS SWOO" . 5374)
+ ("CANADIAN SYLLABICS WEST-CREE SWOO" . 5375)
+ ("CANADIAN SYLLABICS SWA" . 5376)
+ ("CANADIAN SYLLABICS WEST-CREE SWA" . 5377)
+ ("CANADIAN SYLLABICS SWAA" . 5378)
+ ("CANADIAN SYLLABICS WEST-CREE SWAA" . 5379)
+ ("CANADIAN SYLLABICS NASKAPI SWAA" . 5380)
+ ("CANADIAN SYLLABICS S" . 5381)
+ ("CANADIAN SYLLABICS ATHAPASCAN S" . 5382)
+ ("CANADIAN SYLLABICS SW" . 5383)
+ ("CANADIAN SYLLABICS BLACKFOOT S" . 5384)
+ ("CANADIAN SYLLABICS MOOSE-CREE SK" . 5385)
+ ("CANADIAN SYLLABICS NASKAPI SKW" . 5386)
+ ("CANADIAN SYLLABICS NASKAPI S-W" . 5387)
+ ("CANADIAN SYLLABICS NASKAPI SPWA" . 5388)
+ ("CANADIAN SYLLABICS NASKAPI STWA" . 5389)
+ ("CANADIAN SYLLABICS NASKAPI SKWA" . 5390)
+ ("CANADIAN SYLLABICS NASKAPI SCWA" . 5391)
+ ("CANADIAN SYLLABICS SHE" . 5392)
+ ("CANADIAN SYLLABICS SHI" . 5393)
+ ("CANADIAN SYLLABICS SHII" . 5394)
+ ("CANADIAN SYLLABICS SHO" . 5395)
+ ("CANADIAN SYLLABICS SHOO" . 5396)
+ ("CANADIAN SYLLABICS SHA" . 5397)
+ ("CANADIAN SYLLABICS SHAA" . 5398)
+ ("CANADIAN SYLLABICS SHWE" . 5399)
+ ("CANADIAN SYLLABICS WEST-CREE SHWE" . 5400)
+ ("CANADIAN SYLLABICS SHWI" . 5401)
+ ("CANADIAN SYLLABICS WEST-CREE SHWI" . 5402)
+ ("CANADIAN SYLLABICS SHWII" . 5403)
+ ("CANADIAN SYLLABICS WEST-CREE SHWII" . 5404)
+ ("CANADIAN SYLLABICS SHWO" . 5405)
+ ("CANADIAN SYLLABICS WEST-CREE SHWO" . 5406)
+ ("CANADIAN SYLLABICS SHWOO" . 5407)
+ ("CANADIAN SYLLABICS WEST-CREE SHWOO" . 5408)
+ ("CANADIAN SYLLABICS SHWA" . 5409)
+ ("CANADIAN SYLLABICS WEST-CREE SHWA" . 5410)
+ ("CANADIAN SYLLABICS SHWAA" . 5411)
+ ("CANADIAN SYLLABICS WEST-CREE SHWAA" . 5412)
+ ("CANADIAN SYLLABICS SH" . 5413)
+ ("CANADIAN SYLLABICS YE" . 5414)
+ ("CANADIAN SYLLABICS YAAI" . 5415)
+ ("CANADIAN SYLLABICS YI" . 5416)
+ ("CANADIAN SYLLABICS YII" . 5417)
+ ("CANADIAN SYLLABICS YO" . 5418)
+ ("CANADIAN SYLLABICS YOO" . 5419)
+ ("CANADIAN SYLLABICS Y-CREE YOO" . 5420)
+ ("CANADIAN SYLLABICS YA" . 5421)
+ ("CANADIAN SYLLABICS YAA" . 5422)
+ ("CANADIAN SYLLABICS YWE" . 5423)
+ ("CANADIAN SYLLABICS WEST-CREE YWE" . 5424)
+ ("CANADIAN SYLLABICS YWI" . 5425)
+ ("CANADIAN SYLLABICS WEST-CREE YWI" . 5426)
+ ("CANADIAN SYLLABICS YWII" . 5427)
+ ("CANADIAN SYLLABICS WEST-CREE YWII" . 5428)
+ ("CANADIAN SYLLABICS YWO" . 5429)
+ ("CANADIAN SYLLABICS WEST-CREE YWO" . 5430)
+ ("CANADIAN SYLLABICS YWOO" . 5431)
+ ("CANADIAN SYLLABICS WEST-CREE YWOO" . 5432)
+ ("CANADIAN SYLLABICS YWA" . 5433)
+ ("CANADIAN SYLLABICS WEST-CREE YWA" . 5434)
+ ("CANADIAN SYLLABICS YWAA" . 5435)
+ ("CANADIAN SYLLABICS WEST-CREE YWAA" . 5436)
+ ("CANADIAN SYLLABICS NASKAPI YWAA" . 5437)
+ ("CANADIAN SYLLABICS Y" . 5438)
+ ("CANADIAN SYLLABICS BIBLE-CREE Y" . 5439)
+ ("CANADIAN SYLLABICS WEST-CREE Y" . 5440)
+ ("CANADIAN SYLLABICS SAYISI YI" . 5441)
+ ("CANADIAN SYLLABICS RE" . 5442)
+ ("CANADIAN SYLLABICS R-CREE RE" . 5443)
+ ("CANADIAN SYLLABICS WEST-CREE LE" . 5444)
+ ("CANADIAN SYLLABICS RAAI" . 5445)
+ ("CANADIAN SYLLABICS RI" . 5446)
+ ("CANADIAN SYLLABICS RII" . 5447)
+ ("CANADIAN SYLLABICS RO" . 5448)
+ ("CANADIAN SYLLABICS ROO" . 5449)
+ ("CANADIAN SYLLABICS WEST-CREE LO" . 5450)
+ ("CANADIAN SYLLABICS RA" . 5451)
+ ("CANADIAN SYLLABICS RAA" . 5452)
+ ("CANADIAN SYLLABICS WEST-CREE LA" . 5453)
+ ("CANADIAN SYLLABICS RWAA" . 5454)
+ ("CANADIAN SYLLABICS WEST-CREE RWAA" . 5455)
+ ("CANADIAN SYLLABICS R" . 5456)
+ ("CANADIAN SYLLABICS WEST-CREE R" . 5457)
+ ("CANADIAN SYLLABICS MEDIAL R" . 5458)
+ ("CANADIAN SYLLABICS FE" . 5459)
+ ("CANADIAN SYLLABICS FAAI" . 5460)
+ ("CANADIAN SYLLABICS FI" . 5461)
+ ("CANADIAN SYLLABICS FII" . 5462)
+ ("CANADIAN SYLLABICS FO" . 5463)
+ ("CANADIAN SYLLABICS FOO" . 5464)
+ ("CANADIAN SYLLABICS FA" . 5465)
+ ("CANADIAN SYLLABICS FAA" . 5466)
+ ("CANADIAN SYLLABICS FWAA" . 5467)
+ ("CANADIAN SYLLABICS WEST-CREE FWAA" . 5468)
+ ("CANADIAN SYLLABICS F" . 5469)
+ ("CANADIAN SYLLABICS THE" . 5470)
+ ("CANADIAN SYLLABICS N-CREE THE" . 5471)
+ ("CANADIAN SYLLABICS THI" . 5472)
+ ("CANADIAN SYLLABICS N-CREE THI" . 5473)
+ ("CANADIAN SYLLABICS THII" . 5474)
+ ("CANADIAN SYLLABICS N-CREE THII" . 5475)
+ ("CANADIAN SYLLABICS THO" . 5476)
+ ("CANADIAN SYLLABICS THOO" . 5477)
+ ("CANADIAN SYLLABICS THA" . 5478)
+ ("CANADIAN SYLLABICS THAA" . 5479)
+ ("CANADIAN SYLLABICS THWAA" . 5480)
+ ("CANADIAN SYLLABICS WEST-CREE THWAA" . 5481)
+ ("CANADIAN SYLLABICS TH" . 5482)
+ ("CANADIAN SYLLABICS TTHE" . 5483)
+ ("CANADIAN SYLLABICS TTHI" . 5484)
+ ("CANADIAN SYLLABICS TTHO" . 5485)
+ ("CANADIAN SYLLABICS TTHA" . 5486)
+ ("CANADIAN SYLLABICS TTH" . 5487)
+ ("CANADIAN SYLLABICS TYE" . 5488)
+ ("CANADIAN SYLLABICS TYI" . 5489)
+ ("CANADIAN SYLLABICS TYO" . 5490)
+ ("CANADIAN SYLLABICS TYA" . 5491)
+ ("CANADIAN SYLLABICS NUNAVIK HE" . 5492)
+ ("CANADIAN SYLLABICS NUNAVIK HI" . 5493)
+ ("CANADIAN SYLLABICS NUNAVIK HII" . 5494)
+ ("CANADIAN SYLLABICS NUNAVIK HO" . 5495)
+ ("CANADIAN SYLLABICS NUNAVIK HOO" . 5496)
+ ("CANADIAN SYLLABICS NUNAVIK HA" . 5497)
+ ("CANADIAN SYLLABICS NUNAVIK HAA" . 5498)
+ ("CANADIAN SYLLABICS NUNAVIK H" . 5499)
+ ("CANADIAN SYLLABICS NUNAVUT H" . 5500)
+ ("CANADIAN SYLLABICS HK" . 5501)
+ ("CANADIAN SYLLABICS QAAI" . 5502)
+ ("CANADIAN SYLLABICS QI" . 5503)
+ ("CANADIAN SYLLABICS QII" . 5504)
+ ("CANADIAN SYLLABICS QO" . 5505)
+ ("CANADIAN SYLLABICS QOO" . 5506)
+ ("CANADIAN SYLLABICS QA" . 5507)
+ ("CANADIAN SYLLABICS QAA" . 5508)
+ ("CANADIAN SYLLABICS Q" . 5509)
+ ("CANADIAN SYLLABICS TLHE" . 5510)
+ ("CANADIAN SYLLABICS TLHI" . 5511)
+ ("CANADIAN SYLLABICS TLHO" . 5512)
+ ("CANADIAN SYLLABICS TLHA" . 5513)
+ ("CANADIAN SYLLABICS WEST-CREE RE" . 5514)
+ ("CANADIAN SYLLABICS WEST-CREE RI" . 5515)
+ ("CANADIAN SYLLABICS WEST-CREE RO" . 5516)
+ ("CANADIAN SYLLABICS WEST-CREE RA" . 5517)
+ ("CANADIAN SYLLABICS NGAAI" . 5518)
+ ("CANADIAN SYLLABICS NGI" . 5519)
+ ("CANADIAN SYLLABICS NGII" . 5520)
+ ("CANADIAN SYLLABICS NGO" . 5521)
+ ("CANADIAN SYLLABICS NGOO" . 5522)
+ ("CANADIAN SYLLABICS NGA" . 5523)
+ ("CANADIAN SYLLABICS NGAA" . 5524)
+ ("CANADIAN SYLLABICS NG" . 5525)
+ ("CANADIAN SYLLABICS NNG" . 5526)
+ ("CANADIAN SYLLABICS SAYISI SHE" . 5527)
+ ("CANADIAN SYLLABICS SAYISI SHI" . 5528)
+ ("CANADIAN SYLLABICS SAYISI SHO" . 5529)
+ ("CANADIAN SYLLABICS SAYISI SHA" . 5530)
+ ("CANADIAN SYLLABICS WOODS-CREE THE" . 5531)
+ ("CANADIAN SYLLABICS WOODS-CREE THI" . 5532)
+ ("CANADIAN SYLLABICS WOODS-CREE THO" . 5533)
+ ("CANADIAN SYLLABICS WOODS-CREE THA" . 5534)
+ ("CANADIAN SYLLABICS WOODS-CREE TH" . 5535)
+ ("CANADIAN SYLLABICS LHI" . 5536)
+ ("CANADIAN SYLLABICS LHII" . 5537)
+ ("CANADIAN SYLLABICS LHO" . 5538)
+ ("CANADIAN SYLLABICS LHOO" . 5539)
+ ("CANADIAN SYLLABICS LHA" . 5540)
+ ("CANADIAN SYLLABICS LHAA" . 5541)
+ ("CANADIAN SYLLABICS LH" . 5542)
+ ("CANADIAN SYLLABICS TH-CREE THE" . 5543)
+ ("CANADIAN SYLLABICS TH-CREE THI" . 5544)
+ ("CANADIAN SYLLABICS TH-CREE THII" . 5545)
+ ("CANADIAN SYLLABICS TH-CREE THO" . 5546)
+ ("CANADIAN SYLLABICS TH-CREE THOO" . 5547)
+ ("CANADIAN SYLLABICS TH-CREE THA" . 5548)
+ ("CANADIAN SYLLABICS TH-CREE THAA" . 5549)
+ ("CANADIAN SYLLABICS TH-CREE TH" . 5550)
+ ("CANADIAN SYLLABICS AIVILIK B" . 5551)
+ ("CANADIAN SYLLABICS BLACKFOOT E" . 5552)
+ ("CANADIAN SYLLABICS BLACKFOOT I" . 5553)
+ ("CANADIAN SYLLABICS BLACKFOOT O" . 5554)
+ ("CANADIAN SYLLABICS BLACKFOOT A" . 5555)
+ ("CANADIAN SYLLABICS BLACKFOOT WE" . 5556)
+ ("CANADIAN SYLLABICS BLACKFOOT WI" . 5557)
+ ("CANADIAN SYLLABICS BLACKFOOT WO" . 5558)
+ ("CANADIAN SYLLABICS BLACKFOOT WA" . 5559)
+ ("CANADIAN SYLLABICS BLACKFOOT NE" . 5560)
+ ("CANADIAN SYLLABICS BLACKFOOT NI" . 5561)
+ ("CANADIAN SYLLABICS BLACKFOOT NO" . 5562)
+ ("CANADIAN SYLLABICS BLACKFOOT NA" . 5563)
+ ("CANADIAN SYLLABICS BLACKFOOT KE" . 5564)
+ ("CANADIAN SYLLABICS BLACKFOOT KI" . 5565)
+ ("CANADIAN SYLLABICS BLACKFOOT KO" . 5566)
+ ("CANADIAN SYLLABICS BLACKFOOT KA" . 5567)
+ ("CANADIAN SYLLABICS SAYISI HE" . 5568)
+ ("CANADIAN SYLLABICS SAYISI HI" . 5569)
+ ("CANADIAN SYLLABICS SAYISI HO" . 5570)
+ ("CANADIAN SYLLABICS SAYISI HA" . 5571)
+ ("CANADIAN SYLLABICS CARRIER GHU" . 5572)
+ ("CANADIAN SYLLABICS CARRIER GHO" . 5573)
+ ("CANADIAN SYLLABICS CARRIER GHE" . 5574)
+ ("CANADIAN SYLLABICS CARRIER GHEE" . 5575)
+ ("CANADIAN SYLLABICS CARRIER GHI" . 5576)
+ ("CANADIAN SYLLABICS CARRIER GHA" . 5577)
+ ("CANADIAN SYLLABICS CARRIER RU" . 5578)
+ ("CANADIAN SYLLABICS CARRIER RO" . 5579)
+ ("CANADIAN SYLLABICS CARRIER RE" . 5580)
+ ("CANADIAN SYLLABICS CARRIER REE" . 5581)
+ ("CANADIAN SYLLABICS CARRIER RI" . 5582)
+ ("CANADIAN SYLLABICS CARRIER RA" . 5583)
+ ("CANADIAN SYLLABICS CARRIER WU" . 5584)
+ ("CANADIAN SYLLABICS CARRIER WO" . 5585)
+ ("CANADIAN SYLLABICS CARRIER WE" . 5586)
+ ("CANADIAN SYLLABICS CARRIER WEE" . 5587)
+ ("CANADIAN SYLLABICS CARRIER WI" . 5588)
+ ("CANADIAN SYLLABICS CARRIER WA" . 5589)
+ ("CANADIAN SYLLABICS CARRIER HWU" . 5590)
+ ("CANADIAN SYLLABICS CARRIER HWO" . 5591)
+ ("CANADIAN SYLLABICS CARRIER HWE" . 5592)
+ ("CANADIAN SYLLABICS CARRIER HWEE" . 5593)
+ ("CANADIAN SYLLABICS CARRIER HWI" . 5594)
+ ("CANADIAN SYLLABICS CARRIER HWA" . 5595)
+ ("CANADIAN SYLLABICS CARRIER THU" . 5596)
+ ("CANADIAN SYLLABICS CARRIER THO" . 5597)
+ ("CANADIAN SYLLABICS CARRIER THE" . 5598)
+ ("CANADIAN SYLLABICS CARRIER THEE" . 5599)
+ ("CANADIAN SYLLABICS CARRIER THI" . 5600)
+ ("CANADIAN SYLLABICS CARRIER THA" . 5601)
+ ("CANADIAN SYLLABICS CARRIER TTU" . 5602)
+ ("CANADIAN SYLLABICS CARRIER TTO" . 5603)
+ ("CANADIAN SYLLABICS CARRIER TTE" . 5604)
+ ("CANADIAN SYLLABICS CARRIER TTEE" . 5605)
+ ("CANADIAN SYLLABICS CARRIER TTI" . 5606)
+ ("CANADIAN SYLLABICS CARRIER TTA" . 5607)
+ ("CANADIAN SYLLABICS CARRIER PU" . 5608)
+ ("CANADIAN SYLLABICS CARRIER PO" . 5609)
+ ("CANADIAN SYLLABICS CARRIER PE" . 5610)
+ ("CANADIAN SYLLABICS CARRIER PEE" . 5611)
+ ("CANADIAN SYLLABICS CARRIER PI" . 5612)
+ ("CANADIAN SYLLABICS CARRIER PA" . 5613)
+ ("CANADIAN SYLLABICS CARRIER P" . 5614)
+ ("CANADIAN SYLLABICS CARRIER GU" . 5615)
+ ("CANADIAN SYLLABICS CARRIER GO" . 5616)
+ ("CANADIAN SYLLABICS CARRIER GE" . 5617)
+ ("CANADIAN SYLLABICS CARRIER GEE" . 5618)
+ ("CANADIAN SYLLABICS CARRIER GI" . 5619)
+ ("CANADIAN SYLLABICS CARRIER GA" . 5620)
+ ("CANADIAN SYLLABICS CARRIER KHU" . 5621)
+ ("CANADIAN SYLLABICS CARRIER KHO" . 5622)
+ ("CANADIAN SYLLABICS CARRIER KHE" . 5623)
+ ("CANADIAN SYLLABICS CARRIER KHEE" . 5624)
+ ("CANADIAN SYLLABICS CARRIER KHI" . 5625)
+ ("CANADIAN SYLLABICS CARRIER KHA" . 5626)
+ ("CANADIAN SYLLABICS CARRIER KKU" . 5627)
+ ("CANADIAN SYLLABICS CARRIER KKO" . 5628)
+ ("CANADIAN SYLLABICS CARRIER KKE" . 5629)
+ ("CANADIAN SYLLABICS CARRIER KKEE" . 5630)
+ ("CANADIAN SYLLABICS CARRIER KKI" . 5631)
+ ("CANADIAN SYLLABICS CARRIER KKA" . 5632)
+ ("CANADIAN SYLLABICS CARRIER KK" . 5633)
+ ("CANADIAN SYLLABICS CARRIER NU" . 5634)
+ ("CANADIAN SYLLABICS CARRIER NO" . 5635)
+ ("CANADIAN SYLLABICS CARRIER NE" . 5636)
+ ("CANADIAN SYLLABICS CARRIER NEE" . 5637)
+ ("CANADIAN SYLLABICS CARRIER NI" . 5638)
+ ("CANADIAN SYLLABICS CARRIER NA" . 5639)
+ ("CANADIAN SYLLABICS CARRIER MU" . 5640)
+ ("CANADIAN SYLLABICS CARRIER MO" . 5641)
+ ("CANADIAN SYLLABICS CARRIER ME" . 5642)
+ ("CANADIAN SYLLABICS CARRIER MEE" . 5643)
+ ("CANADIAN SYLLABICS CARRIER MI" . 5644)
+ ("CANADIAN SYLLABICS CARRIER MA" . 5645)
+ ("CANADIAN SYLLABICS CARRIER YU" . 5646)
+ ("CANADIAN SYLLABICS CARRIER YO" . 5647)
+ ("CANADIAN SYLLABICS CARRIER YE" . 5648)
+ ("CANADIAN SYLLABICS CARRIER YEE" . 5649)
+ ("CANADIAN SYLLABICS CARRIER YI" . 5650)
+ ("CANADIAN SYLLABICS CARRIER YA" . 5651)
+ ("CANADIAN SYLLABICS CARRIER JU" . 5652)
+ ("CANADIAN SYLLABICS SAYISI JU" . 5653)
+ ("CANADIAN SYLLABICS CARRIER JO" . 5654)
+ ("CANADIAN SYLLABICS CARRIER JE" . 5655)
+ ("CANADIAN SYLLABICS CARRIER JEE" . 5656)
+ ("CANADIAN SYLLABICS CARRIER JI" . 5657)
+ ("CANADIAN SYLLABICS SAYISI JI" . 5658)
+ ("CANADIAN SYLLABICS CARRIER JA" . 5659)
+ ("CANADIAN SYLLABICS CARRIER JJU" . 5660)
+ ("CANADIAN SYLLABICS CARRIER JJO" . 5661)
+ ("CANADIAN SYLLABICS CARRIER JJE" . 5662)
+ ("CANADIAN SYLLABICS CARRIER JJEE" . 5663)
+ ("CANADIAN SYLLABICS CARRIER JJI" . 5664)
+ ("CANADIAN SYLLABICS CARRIER JJA" . 5665)
+ ("CANADIAN SYLLABICS CARRIER LU" . 5666)
+ ("CANADIAN SYLLABICS CARRIER LO" . 5667)
+ ("CANADIAN SYLLABICS CARRIER LE" . 5668)
+ ("CANADIAN SYLLABICS CARRIER LEE" . 5669)
+ ("CANADIAN SYLLABICS CARRIER LI" . 5670)
+ ("CANADIAN SYLLABICS CARRIER LA" . 5671)
+ ("CANADIAN SYLLABICS CARRIER DLU" . 5672)
+ ("CANADIAN SYLLABICS CARRIER DLO" . 5673)
+ ("CANADIAN SYLLABICS CARRIER DLE" . 5674)
+ ("CANADIAN SYLLABICS CARRIER DLEE" . 5675)
+ ("CANADIAN SYLLABICS CARRIER DLI" . 5676)
+ ("CANADIAN SYLLABICS CARRIER DLA" . 5677)
+ ("CANADIAN SYLLABICS CARRIER LHU" . 5678)
+ ("CANADIAN SYLLABICS CARRIER LHO" . 5679)
+ ("CANADIAN SYLLABICS CARRIER LHE" . 5680)
+ ("CANADIAN SYLLABICS CARRIER LHEE" . 5681)
+ ("CANADIAN SYLLABICS CARRIER LHI" . 5682)
+ ("CANADIAN SYLLABICS CARRIER LHA" . 5683)
+ ("CANADIAN SYLLABICS CARRIER TLHU" . 5684)
+ ("CANADIAN SYLLABICS CARRIER TLHO" . 5685)
+ ("CANADIAN SYLLABICS CARRIER TLHE" . 5686)
+ ("CANADIAN SYLLABICS CARRIER TLHEE" . 5687)
+ ("CANADIAN SYLLABICS CARRIER TLHI" . 5688)
+ ("CANADIAN SYLLABICS CARRIER TLHA" . 5689)
+ ("CANADIAN SYLLABICS CARRIER TLU" . 5690)
+ ("CANADIAN SYLLABICS CARRIER TLO" . 5691)
+ ("CANADIAN SYLLABICS CARRIER TLE" . 5692)
+ ("CANADIAN SYLLABICS CARRIER TLEE" . 5693)
+ ("CANADIAN SYLLABICS CARRIER TLI" . 5694)
+ ("CANADIAN SYLLABICS CARRIER TLA" . 5695)
+ ("CANADIAN SYLLABICS CARRIER ZU" . 5696)
+ ("CANADIAN SYLLABICS CARRIER ZO" . 5697)
+ ("CANADIAN SYLLABICS CARRIER ZE" . 5698)
+ ("CANADIAN SYLLABICS CARRIER ZEE" . 5699)
+ ("CANADIAN SYLLABICS CARRIER ZI" . 5700)
+ ("CANADIAN SYLLABICS CARRIER ZA" . 5701)
+ ("CANADIAN SYLLABICS CARRIER Z" . 5702)
+ ("CANADIAN SYLLABICS CARRIER INITIAL Z" . 5703)
+ ("CANADIAN SYLLABICS CARRIER DZU" . 5704)
+ ("CANADIAN SYLLABICS CARRIER DZO" . 5705)
+ ("CANADIAN SYLLABICS CARRIER DZE" . 5706)
+ ("CANADIAN SYLLABICS CARRIER DZEE" . 5707)
+ ("CANADIAN SYLLABICS CARRIER DZI" . 5708)
+ ("CANADIAN SYLLABICS CARRIER DZA" . 5709)
+ ("CANADIAN SYLLABICS CARRIER SU" . 5710)
+ ("CANADIAN SYLLABICS CARRIER SO" . 5711)
+ ("CANADIAN SYLLABICS CARRIER SE" . 5712)
+ ("CANADIAN SYLLABICS CARRIER SEE" . 5713)
+ ("CANADIAN SYLLABICS CARRIER SI" . 5714)
+ ("CANADIAN SYLLABICS CARRIER SA" . 5715)
+ ("CANADIAN SYLLABICS CARRIER SHU" . 5716)
+ ("CANADIAN SYLLABICS CARRIER SHO" . 5717)
+ ("CANADIAN SYLLABICS CARRIER SHE" . 5718)
+ ("CANADIAN SYLLABICS CARRIER SHEE" . 5719)
+ ("CANADIAN SYLLABICS CARRIER SHI" . 5720)
+ ("CANADIAN SYLLABICS CARRIER SHA" . 5721)
+ ("CANADIAN SYLLABICS CARRIER SH" . 5722)
+ ("CANADIAN SYLLABICS CARRIER TSU" . 5723)
+ ("CANADIAN SYLLABICS CARRIER TSO" . 5724)
+ ("CANADIAN SYLLABICS CARRIER TSE" . 5725)
+ ("CANADIAN SYLLABICS CARRIER TSEE" . 5726)
+ ("CANADIAN SYLLABICS CARRIER TSI" . 5727)
+ ("CANADIAN SYLLABICS CARRIER TSA" . 5728)
+ ("CANADIAN SYLLABICS CARRIER CHU" . 5729)
+ ("CANADIAN SYLLABICS CARRIER CHO" . 5730)
+ ("CANADIAN SYLLABICS CARRIER CHE" . 5731)
+ ("CANADIAN SYLLABICS CARRIER CHEE" . 5732)
+ ("CANADIAN SYLLABICS CARRIER CHI" . 5733)
+ ("CANADIAN SYLLABICS CARRIER CHA" . 5734)
+ ("CANADIAN SYLLABICS CARRIER TTSU" . 5735)
+ ("CANADIAN SYLLABICS CARRIER TTSO" . 5736)
+ ("CANADIAN SYLLABICS CARRIER TTSE" . 5737)
+ ("CANADIAN SYLLABICS CARRIER TTSEE" . 5738)
+ ("CANADIAN SYLLABICS CARRIER TTSI" . 5739)
+ ("CANADIAN SYLLABICS CARRIER TTSA" . 5740)
+ ("CANADIAN SYLLABICS CHI SIGN" . 5741)
+ ("CANADIAN SYLLABICS FULL STOP" . 5742)
+ ("CANADIAN SYLLABICS QAI" . 5743)
+ ("CANADIAN SYLLABICS NGAI" . 5744)
+ ("CANADIAN SYLLABICS NNGI" . 5745)
+ ("CANADIAN SYLLABICS NNGII" . 5746)
+ ("CANADIAN SYLLABICS NNGO" . 5747)
+ ("CANADIAN SYLLABICS NNGOO" . 5748)
+ ("CANADIAN SYLLABICS NNGA" . 5749)
+ ("CANADIAN SYLLABICS NNGAA" . 5750)
+ ("OGHAM SPACE MARK" . 5760)
+ ("OGHAM LETTER BEITH" . 5761)
+ ("OGHAM LETTER LUIS" . 5762)
+ ("OGHAM LETTER FEARN" . 5763)
+ ("OGHAM LETTER SAIL" . 5764)
+ ("OGHAM LETTER NION" . 5765)
+ ("OGHAM LETTER UATH" . 5766)
+ ("OGHAM LETTER DAIR" . 5767)
+ ("OGHAM LETTER TINNE" . 5768)
+ ("OGHAM LETTER COLL" . 5769)
+ ("OGHAM LETTER CEIRT" . 5770)
+ ("OGHAM LETTER MUIN" . 5771)
+ ("OGHAM LETTER GORT" . 5772)
+ ("OGHAM LETTER NGEADAL" . 5773)
+ ("OGHAM LETTER STRAIF" . 5774)
+ ("OGHAM LETTER RUIS" . 5775)
+ ("OGHAM LETTER AILM" . 5776)
+ ("OGHAM LETTER ONN" . 5777)
+ ("OGHAM LETTER UR" . 5778)
+ ("OGHAM LETTER EADHADH" . 5779)
+ ("OGHAM LETTER IODHADH" . 5780)
+ ("OGHAM LETTER EABHADH" . 5781)
+ ("OGHAM LETTER OR" . 5782)
+ ("OGHAM LETTER UILLEANN" . 5783)
+ ("OGHAM LETTER IFIN" . 5784)
+ ("OGHAM LETTER EAMHANCHOLL" . 5785)
+ ("OGHAM LETTER PEITH" . 5786)
+ ("OGHAM FEATHER MARK" . 5787)
+ ("OGHAM REVERSED FEATHER MARK" . 5788)
+ ("RUNIC LETTER FEHU FEOH FE F" . 5792)
+ ("RUNIC LETTER V" . 5793)
+ ("RUNIC LETTER URUZ UR U" . 5794)
+ ("RUNIC LETTER YR" . 5795)
+ ("RUNIC LETTER Y" . 5796)
+ ("RUNIC LETTER W" . 5797)
+ ("RUNIC LETTER THURISAZ THURS THORN" . 5798)
+ ("RUNIC LETTER ETH" . 5799)
+ ("RUNIC LETTER ANSUZ A" . 5800)
+ ("RUNIC LETTER OS O" . 5801)
+ ("RUNIC LETTER AC A" . 5802)
+ ("RUNIC LETTER AESC" . 5803)
+ ("RUNIC LETTER LONG-BRANCH-OSS O" . 5804)
+ ("RUNIC LETTER SHORT-TWIG-OSS O" . 5805)
+ ("RUNIC LETTER O" . 5806)
+ ("RUNIC LETTER OE" . 5807)
+ ("RUNIC LETTER ON" . 5808)
+ ("RUNIC LETTER RAIDO RAD REID R" . 5809)
+ ("RUNIC LETTER KAUNA" . 5810)
+ ("RUNIC LETTER CEN" . 5811)
+ ("RUNIC LETTER KAUN K" . 5812)
+ ("RUNIC LETTER G" . 5813)
+ ("RUNIC LETTER ENG" . 5814)
+ ("RUNIC LETTER GEBO GYFU G" . 5815)
+ ("RUNIC LETTER GAR" . 5816)
+ ("RUNIC LETTER WUNJO WYNN W" . 5817)
+ ("RUNIC LETTER HAGLAZ H" . 5818)
+ ("RUNIC LETTER HAEGL H" . 5819)
+ ("RUNIC LETTER LONG-BRANCH-HAGALL H" . 5820)
+ ("RUNIC LETTER SHORT-TWIG-HAGALL H" . 5821)
+ ("RUNIC LETTER NAUDIZ NYD NAUD N" . 5822)
+ ("RUNIC LETTER SHORT-TWIG-NAUD N" . 5823)
+ ("RUNIC LETTER DOTTED-N" . 5824)
+ ("RUNIC LETTER ISAZ IS ISS I" . 5825)
+ ("RUNIC LETTER E" . 5826)
+ ("RUNIC LETTER JERAN J" . 5827)
+ ("RUNIC LETTER GER" . 5828)
+ ("RUNIC LETTER LONG-BRANCH-AR AE" . 5829)
+ ("RUNIC LETTER SHORT-TWIG-AR A" . 5830)
+ ("RUNIC LETTER IWAZ EOH" . 5831)
+ ("RUNIC LETTER PERTHO PEORTH P" . 5832)
+ ("RUNIC LETTER ALGIZ EOLHX" . 5833)
+ ("RUNIC LETTER SOWILO S" . 5834)
+ ("RUNIC LETTER SIGEL LONG-BRANCH-SOL S" . 5835)
+ ("RUNIC LETTER SHORT-TWIG-SOL S" . 5836)
+ ("RUNIC LETTER C" . 5837)
+ ("RUNIC LETTER Z" . 5838)
+ ("RUNIC LETTER TIWAZ TIR TYR T" . 5839)
+ ("RUNIC LETTER SHORT-TWIG-TYR T" . 5840)
+ ("RUNIC LETTER D" . 5841)
+ ("RUNIC LETTER BERKANAN BEORC BJARKAN B" . 5842)
+ ("RUNIC LETTER SHORT-TWIG-BJARKAN B" . 5843)
+ ("RUNIC LETTER DOTTED-P" . 5844)
+ ("RUNIC LETTER OPEN-P" . 5845)
+ ("RUNIC LETTER EHWAZ EH E" . 5846)
+ ("RUNIC LETTER MANNAZ MAN M" . 5847)
+ ("RUNIC LETTER LONG-BRANCH-MADR M" . 5848)
+ ("RUNIC LETTER SHORT-TWIG-MADR M" . 5849)
+ ("RUNIC LETTER LAUKAZ LAGU LOGR L" . 5850)
+ ("RUNIC LETTER DOTTED-L" . 5851)
+ ("RUNIC LETTER INGWAZ" . 5852)
+ ("RUNIC LETTER ING" . 5853)
+ ("RUNIC LETTER DAGAZ DAEG D" . 5854)
+ ("RUNIC LETTER OTHALAN ETHEL O" . 5855)
+ ("RUNIC LETTER EAR" . 5856)
+ ("RUNIC LETTER IOR" . 5857)
+ ("RUNIC LETTER CWEORTH" . 5858)
+ ("RUNIC LETTER CALC" . 5859)
+ ("RUNIC LETTER CEALC" . 5860)
+ ("RUNIC LETTER STAN" . 5861)
+ ("RUNIC LETTER LONG-BRANCH-YR" . 5862)
+ ("RUNIC LETTER SHORT-TWIG-YR" . 5863)
+ ("RUNIC LETTER ICELANDIC-YR" . 5864)
+ ("RUNIC LETTER Q" . 5865)
+ ("RUNIC LETTER X" . 5866)
+ ("RUNIC SINGLE PUNCTUATION" . 5867)
+ ("RUNIC MULTIPLE PUNCTUATION" . 5868)
+ ("RUNIC CROSS PUNCTUATION" . 5869)
+ ("RUNIC ARLAUG SYMBOL" . 5870)
+ ("RUNIC TVIMADUR SYMBOL" . 5871)
+ ("RUNIC BELGTHOR SYMBOL" . 5872)
+ ("TAGALOG LETTER A" . 5888)
+ ("TAGALOG LETTER I" . 5889)
+ ("TAGALOG LETTER U" . 5890)
+ ("TAGALOG LETTER KA" . 5891)
+ ("TAGALOG LETTER GA" . 5892)
+ ("TAGALOG LETTER NGA" . 5893)
+ ("TAGALOG LETTER TA" . 5894)
+ ("TAGALOG LETTER DA" . 5895)
+ ("TAGALOG LETTER NA" . 5896)
+ ("TAGALOG LETTER PA" . 5897)
+ ("TAGALOG LETTER BA" . 5898)
+ ("TAGALOG LETTER MA" . 5899)
+ ("TAGALOG LETTER YA" . 5900)
+ ("TAGALOG LETTER LA" . 5902)
+ ("TAGALOG LETTER WA" . 5903)
+ ("TAGALOG LETTER SA" . 5904)
+ ("TAGALOG LETTER HA" . 5905)
+ ("TAGALOG VOWEL SIGN I" . 5906)
+ ("TAGALOG VOWEL SIGN U" . 5907)
+ ("TAGALOG SIGN VIRAMA" . 5908)
+ ("HANUNOO LETTER A" . 5920)
+ ("HANUNOO LETTER I" . 5921)
+ ("HANUNOO LETTER U" . 5922)
+ ("HANUNOO LETTER KA" . 5923)
+ ("HANUNOO LETTER GA" . 5924)
+ ("HANUNOO LETTER NGA" . 5925)
+ ("HANUNOO LETTER TA" . 5926)
+ ("HANUNOO LETTER DA" . 5927)
+ ("HANUNOO LETTER NA" . 5928)
+ ("HANUNOO LETTER PA" . 5929)
+ ("HANUNOO LETTER BA" . 5930)
+ ("HANUNOO LETTER MA" . 5931)
+ ("HANUNOO LETTER YA" . 5932)
+ ("HANUNOO LETTER RA" . 5933)
+ ("HANUNOO LETTER LA" . 5934)
+ ("HANUNOO LETTER WA" . 5935)
+ ("HANUNOO LETTER SA" . 5936)
+ ("HANUNOO LETTER HA" . 5937)
+ ("HANUNOO VOWEL SIGN I" . 5938)
+ ("HANUNOO VOWEL SIGN U" . 5939)
+ ("HANUNOO SIGN PAMUDPOD" . 5940)
+ ("PHILIPPINE SINGLE PUNCTUATION" . 5941)
+ ("PHILIPPINE DOUBLE PUNCTUATION" . 5942)
+ ("BUHID LETTER A" . 5952)
+ ("BUHID LETTER I" . 5953)
+ ("BUHID LETTER U" . 5954)
+ ("BUHID LETTER KA" . 5955)
+ ("BUHID LETTER GA" . 5956)
+ ("BUHID LETTER NGA" . 5957)
+ ("BUHID LETTER TA" . 5958)
+ ("BUHID LETTER DA" . 5959)
+ ("BUHID LETTER NA" . 5960)
+ ("BUHID LETTER PA" . 5961)
+ ("BUHID LETTER BA" . 5962)
+ ("BUHID LETTER MA" . 5963)
+ ("BUHID LETTER YA" . 5964)
+ ("BUHID LETTER RA" . 5965)
+ ("BUHID LETTER LA" . 5966)
+ ("BUHID LETTER WA" . 5967)
+ ("BUHID LETTER SA" . 5968)
+ ("BUHID LETTER HA" . 5969)
+ ("BUHID VOWEL SIGN I" . 5970)
+ ("BUHID VOWEL SIGN U" . 5971)
+ ("TAGBANWA LETTER A" . 5984)
+ ("TAGBANWA LETTER I" . 5985)
+ ("TAGBANWA LETTER U" . 5986)
+ ("TAGBANWA LETTER KA" . 5987)
+ ("TAGBANWA LETTER GA" . 5988)
+ ("TAGBANWA LETTER NGA" . 5989)
+ ("TAGBANWA LETTER TA" . 5990)
+ ("TAGBANWA LETTER DA" . 5991)
+ ("TAGBANWA LETTER NA" . 5992)
+ ("TAGBANWA LETTER PA" . 5993)
+ ("TAGBANWA LETTER BA" . 5994)
+ ("TAGBANWA LETTER MA" . 5995)
+ ("TAGBANWA LETTER YA" . 5996)
+ ("TAGBANWA LETTER LA" . 5998)
+ ("TAGBANWA LETTER WA" . 5999)
+ ("TAGBANWA LETTER SA" . 6000)
+ ("TAGBANWA VOWEL SIGN I" . 6002)
+ ("TAGBANWA VOWEL SIGN U" . 6003)
+ ("KHMER LETTER KA" . 6016)
+ ("KHMER LETTER KHA" . 6017)
+ ("KHMER LETTER KO" . 6018)
+ ("KHMER LETTER KHO" . 6019)
+ ("KHMER LETTER NGO" . 6020)
+ ("KHMER LETTER CA" . 6021)
+ ("KHMER LETTER CHA" . 6022)
+ ("KHMER LETTER CO" . 6023)
+ ("KHMER LETTER CHO" . 6024)
+ ("KHMER LETTER NYO" . 6025)
+ ("KHMER LETTER DA" . 6026)
+ ("KHMER LETTER TTHA" . 6027)
+ ("KHMER LETTER DO" . 6028)
+ ("KHMER LETTER TTHO" . 6029)
+ ("KHMER LETTER NNO" . 6030)
+ ("KHMER LETTER TA" . 6031)
+ ("KHMER LETTER THA" . 6032)
+ ("KHMER LETTER TO" . 6033)
+ ("KHMER LETTER THO" . 6034)
+ ("KHMER LETTER NO" . 6035)
+ ("KHMER LETTER BA" . 6036)
+ ("KHMER LETTER PHA" . 6037)
+ ("KHMER LETTER PO" . 6038)
+ ("KHMER LETTER PHO" . 6039)
+ ("KHMER LETTER MO" . 6040)
+ ("KHMER LETTER YO" . 6041)
+ ("KHMER LETTER RO" . 6042)
+ ("KHMER LETTER LO" . 6043)
+ ("KHMER LETTER VO" . 6044)
+ ("KHMER LETTER SHA" . 6045)
+ ("KHMER LETTER SSO" . 6046)
+ ("KHMER LETTER SA" . 6047)
+ ("KHMER LETTER HA" . 6048)
+ ("KHMER LETTER LA" . 6049)
+ ("KHMER LETTER QA" . 6050)
+ ("KHMER INDEPENDENT VOWEL QAQ" . 6051)
+ ("KHMER INDEPENDENT VOWEL QAA" . 6052)
+ ("KHMER INDEPENDENT VOWEL QI" . 6053)
+ ("KHMER INDEPENDENT VOWEL QII" . 6054)
+ ("KHMER INDEPENDENT VOWEL QU" . 6055)
+ ("KHMER INDEPENDENT VOWEL QUK" . 6056)
+ ("KHMER INDEPENDENT VOWEL QUU" . 6057)
+ ("KHMER INDEPENDENT VOWEL QUUV" . 6058)
+ ("KHMER INDEPENDENT VOWEL RY" . 6059)
+ ("KHMER INDEPENDENT VOWEL RYY" . 6060)
+ ("KHMER INDEPENDENT VOWEL LY" . 6061)
+ ("KHMER INDEPENDENT VOWEL LYY" . 6062)
+ ("KHMER INDEPENDENT VOWEL QE" . 6063)
+ ("KHMER INDEPENDENT VOWEL QAI" . 6064)
+ ("KHMER INDEPENDENT VOWEL QOO TYPE ONE" . 6065)
+ ("KHMER INDEPENDENT VOWEL QOO TYPE TWO" . 6066)
+ ("KHMER INDEPENDENT VOWEL QAU" . 6067)
+ ("KHMER VOWEL INHERENT AQ" . 6068)
+ ("KHMER VOWEL INHERENT AA" . 6069)
+ ("KHMER VOWEL SIGN AA" . 6070)
+ ("KHMER VOWEL SIGN I" . 6071)
+ ("KHMER VOWEL SIGN II" . 6072)
+ ("KHMER VOWEL SIGN Y" . 6073)
+ ("KHMER VOWEL SIGN YY" . 6074)
+ ("KHMER VOWEL SIGN U" . 6075)
+ ("KHMER VOWEL SIGN UU" . 6076)
+ ("KHMER VOWEL SIGN UA" . 6077)
+ ("KHMER VOWEL SIGN OE" . 6078)
+ ("KHMER VOWEL SIGN YA" . 6079)
+ ("KHMER VOWEL SIGN IE" . 6080)
+ ("KHMER VOWEL SIGN E" . 6081)
+ ("KHMER VOWEL SIGN AE" . 6082)
+ ("KHMER VOWEL SIGN AI" . 6083)
+ ("KHMER VOWEL SIGN OO" . 6084)
+ ("KHMER VOWEL SIGN AU" . 6085)
+ ("KHMER SIGN NIKAHIT" . 6086)
+ ("KHMER SIGN REAHMUK" . 6087)
+ ("KHMER SIGN YUUKALEAPINTU" . 6088)
+ ("KHMER SIGN MUUSIKATOAN" . 6089)
+ ("KHMER SIGN TRIISAP" . 6090)
+ ("KHMER SIGN BANTOC" . 6091)
+ ("KHMER SIGN ROBAT" . 6092)
+ ("KHMER SIGN TOANDAKHIAT" . 6093)
+ ("KHMER SIGN KAKABAT" . 6094)
+ ("KHMER SIGN AHSDA" . 6095)
+ ("KHMER SIGN SAMYOK SANNYA" . 6096)
+ ("KHMER SIGN VIRIAM" . 6097)
+ ("KHMER SIGN COENG" . 6098)
+ ("KHMER SIGN BATHAMASAT" . 6099)
+ ("KHMER SIGN KHAN" . 6100)
+ ("KHMER SIGN BARIYOOSAN" . 6101)
+ ("KHMER SIGN CAMNUC PII KUUH" . 6102)
+ ("KHMER SIGN LEK TOO" . 6103)
+ ("KHMER SIGN BEYYAL" . 6104)
+ ("KHMER SIGN PHNAEK MUAN" . 6105)
+ ("KHMER SIGN KOOMUUT" . 6106)
+ ("KHMER CURRENCY SYMBOL RIEL" . 6107)
+ ("KHMER SIGN AVAKRAHASANYA" . 6108)
+ ("KHMER DIGIT ZERO" . 6112)
+ ("KHMER DIGIT ONE" . 6113)
+ ("KHMER DIGIT TWO" . 6114)
+ ("KHMER DIGIT THREE" . 6115)
+ ("KHMER DIGIT FOUR" . 6116)
+ ("KHMER DIGIT FIVE" . 6117)
+ ("KHMER DIGIT SIX" . 6118)
+ ("KHMER DIGIT SEVEN" . 6119)
+ ("KHMER DIGIT EIGHT" . 6120)
+ ("KHMER DIGIT NINE" . 6121)
+ ("MONGOLIAN BIRGA" . 6144)
+ ("MONGOLIAN ELLIPSIS" . 6145)
+ ("MONGOLIAN COMMA" . 6146)
+ ("MONGOLIAN FULL STOP" . 6147)
+ ("MONGOLIAN COLON" . 6148)
+ ("MONGOLIAN FOUR DOTS" . 6149)
+ ("MONGOLIAN TODO SOFT HYPHEN" . 6150)
+ ("MONGOLIAN SIBE SYLLABLE BOUNDARY MARKER" . 6151)
+ ("MONGOLIAN MANCHU COMMA" . 6152)
+ ("MONGOLIAN MANCHU FULL STOP" . 6153)
+ ("MONGOLIAN NIRUGU" . 6154)
+ ("MONGOLIAN FREE VARIATION SELECTOR ONE" . 6155)
+ ("MONGOLIAN FREE VARIATION SELECTOR TWO" . 6156)
+ ("MONGOLIAN FREE VARIATION SELECTOR THREE" . 6157)
+ ("MONGOLIAN VOWEL SEPARATOR" . 6158)
+ ("MONGOLIAN DIGIT ZERO" . 6160)
+ ("MONGOLIAN DIGIT ONE" . 6161)
+ ("MONGOLIAN DIGIT TWO" . 6162)
+ ("MONGOLIAN DIGIT THREE" . 6163)
+ ("MONGOLIAN DIGIT FOUR" . 6164)
+ ("MONGOLIAN DIGIT FIVE" . 6165)
+ ("MONGOLIAN DIGIT SIX" . 6166)
+ ("MONGOLIAN DIGIT SEVEN" . 6167)
+ ("MONGOLIAN DIGIT EIGHT" . 6168)
+ ("MONGOLIAN DIGIT NINE" . 6169)
+ ("MONGOLIAN LETTER A" . 6176)
+ ("MONGOLIAN LETTER E" . 6177)
+ ("MONGOLIAN LETTER I" . 6178)
+ ("MONGOLIAN LETTER O" . 6179)
+ ("MONGOLIAN LETTER U" . 6180)
+ ("MONGOLIAN LETTER OE" . 6181)
+ ("MONGOLIAN LETTER UE" . 6182)
+ ("MONGOLIAN LETTER EE" . 6183)
+ ("MONGOLIAN LETTER NA" . 6184)
+ ("MONGOLIAN LETTER ANG" . 6185)
+ ("MONGOLIAN LETTER BA" . 6186)
+ ("MONGOLIAN LETTER PA" . 6187)
+ ("MONGOLIAN LETTER QA" . 6188)
+ ("MONGOLIAN LETTER GA" . 6189)
+ ("MONGOLIAN LETTER MA" . 6190)
+ ("MONGOLIAN LETTER LA" . 6191)
+ ("MONGOLIAN LETTER SA" . 6192)
+ ("MONGOLIAN LETTER SHA" . 6193)
+ ("MONGOLIAN LETTER TA" . 6194)
+ ("MONGOLIAN LETTER DA" . 6195)
+ ("MONGOLIAN LETTER CHA" . 6196)
+ ("MONGOLIAN LETTER JA" . 6197)
+ ("MONGOLIAN LETTER YA" . 6198)
+ ("MONGOLIAN LETTER RA" . 6199)
+ ("MONGOLIAN LETTER WA" . 6200)
+ ("MONGOLIAN LETTER FA" . 6201)
+ ("MONGOLIAN LETTER KA" . 6202)
+ ("MONGOLIAN LETTER KHA" . 6203)
+ ("MONGOLIAN LETTER TSA" . 6204)
+ ("MONGOLIAN LETTER ZA" . 6205)
+ ("MONGOLIAN LETTER HAA" . 6206)
+ ("MONGOLIAN LETTER ZRA" . 6207)
+ ("MONGOLIAN LETTER LHA" . 6208)
+ ("MONGOLIAN LETTER ZHI" . 6209)
+ ("MONGOLIAN LETTER CHI" . 6210)
+ ("MONGOLIAN LETTER TODO LONG VOWEL SIGN" . 6211)
+ ("MONGOLIAN LETTER TODO E" . 6212)
+ ("MONGOLIAN LETTER TODO I" . 6213)
+ ("MONGOLIAN LETTER TODO O" . 6214)
+ ("MONGOLIAN LETTER TODO U" . 6215)
+ ("MONGOLIAN LETTER TODO OE" . 6216)
+ ("MONGOLIAN LETTER TODO UE" . 6217)
+ ("MONGOLIAN LETTER TODO ANG" . 6218)
+ ("MONGOLIAN LETTER TODO BA" . 6219)
+ ("MONGOLIAN LETTER TODO PA" . 6220)
+ ("MONGOLIAN LETTER TODO QA" . 6221)
+ ("MONGOLIAN LETTER TODO GA" . 6222)
+ ("MONGOLIAN LETTER TODO MA" . 6223)
+ ("MONGOLIAN LETTER TODO TA" . 6224)
+ ("MONGOLIAN LETTER TODO DA" . 6225)
+ ("MONGOLIAN LETTER TODO CHA" . 6226)
+ ("MONGOLIAN LETTER TODO JA" . 6227)
+ ("MONGOLIAN LETTER TODO TSA" . 6228)
+ ("MONGOLIAN LETTER TODO YA" . 6229)
+ ("MONGOLIAN LETTER TODO WA" . 6230)
+ ("MONGOLIAN LETTER TODO KA" . 6231)
+ ("MONGOLIAN LETTER TODO GAA" . 6232)
+ ("MONGOLIAN LETTER TODO HAA" . 6233)
+ ("MONGOLIAN LETTER TODO JIA" . 6234)
+ ("MONGOLIAN LETTER TODO NIA" . 6235)
+ ("MONGOLIAN LETTER TODO DZA" . 6236)
+ ("MONGOLIAN LETTER SIBE E" . 6237)
+ ("MONGOLIAN LETTER SIBE I" . 6238)
+ ("MONGOLIAN LETTER SIBE IY" . 6239)
+ ("MONGOLIAN LETTER SIBE UE" . 6240)
+ ("MONGOLIAN LETTER SIBE U" . 6241)
+ ("MONGOLIAN LETTER SIBE ANG" . 6242)
+ ("MONGOLIAN LETTER SIBE KA" . 6243)
+ ("MONGOLIAN LETTER SIBE GA" . 6244)
+ ("MONGOLIAN LETTER SIBE HA" . 6245)
+ ("MONGOLIAN LETTER SIBE PA" . 6246)
+ ("MONGOLIAN LETTER SIBE SHA" . 6247)
+ ("MONGOLIAN LETTER SIBE TA" . 6248)
+ ("MONGOLIAN LETTER SIBE DA" . 6249)
+ ("MONGOLIAN LETTER SIBE JA" . 6250)
+ ("MONGOLIAN LETTER SIBE FA" . 6251)
+ ("MONGOLIAN LETTER SIBE GAA" . 6252)
+ ("MONGOLIAN LETTER SIBE HAA" . 6253)
+ ("MONGOLIAN LETTER SIBE TSA" . 6254)
+ ("MONGOLIAN LETTER SIBE ZA" . 6255)
+ ("MONGOLIAN LETTER SIBE RAA" . 6256)
+ ("MONGOLIAN LETTER SIBE CHA" . 6257)
+ ("MONGOLIAN LETTER SIBE ZHA" . 6258)
+ ("MONGOLIAN LETTER MANCHU I" . 6259)
+ ("MONGOLIAN LETTER MANCHU KA" . 6260)
+ ("MONGOLIAN LETTER MANCHU RA" . 6261)
+ ("MONGOLIAN LETTER MANCHU FA" . 6262)
+ ("MONGOLIAN LETTER MANCHU ZHA" . 6263)
+ ("MONGOLIAN LETTER ALI GALI ANUSVARA ONE" . 6272)
+ ("MONGOLIAN LETTER ALI GALI VISARGA ONE" . 6273)
+ ("MONGOLIAN LETTER ALI GALI DAMARU" . 6274)
+ ("MONGOLIAN LETTER ALI GALI UBADAMA" . 6275)
+ ("MONGOLIAN LETTER ALI GALI INVERTED UBADAMA" . 6276)
+ ("MONGOLIAN LETTER ALI GALI BALUDA" . 6277)
+ ("MONGOLIAN LETTER ALI GALI THREE BALUDA" . 6278)
+ ("MONGOLIAN LETTER ALI GALI A" . 6279)
+ ("MONGOLIAN LETTER ALI GALI I" . 6280)
+ ("MONGOLIAN LETTER ALI GALI KA" . 6281)
+ ("MONGOLIAN LETTER ALI GALI NGA" . 6282)
+ ("MONGOLIAN LETTER ALI GALI CA" . 6283)
+ ("MONGOLIAN LETTER ALI GALI TTA" . 6284)
+ ("MONGOLIAN LETTER ALI GALI TTHA" . 6285)
+ ("MONGOLIAN LETTER ALI GALI DDA" . 6286)
+ ("MONGOLIAN LETTER ALI GALI NNA" . 6287)
+ ("MONGOLIAN LETTER ALI GALI TA" . 6288)
+ ("MONGOLIAN LETTER ALI GALI DA" . 6289)
+ ("MONGOLIAN LETTER ALI GALI PA" . 6290)
+ ("MONGOLIAN LETTER ALI GALI PHA" . 6291)
+ ("MONGOLIAN LETTER ALI GALI SSA" . 6292)
+ ("MONGOLIAN LETTER ALI GALI ZHA" . 6293)
+ ("MONGOLIAN LETTER ALI GALI ZA" . 6294)
+ ("MONGOLIAN LETTER ALI GALI AH" . 6295)
+ ("MONGOLIAN LETTER TODO ALI GALI TA" . 6296)
+ ("MONGOLIAN LETTER TODO ALI GALI ZHA" . 6297)
+ ("MONGOLIAN LETTER MANCHU ALI GALI GHA" . 6298)
+ ("MONGOLIAN LETTER MANCHU ALI GALI NGA" . 6299)
+ ("MONGOLIAN LETTER MANCHU ALI GALI CA" . 6300)
+ ("MONGOLIAN LETTER MANCHU ALI GALI JHA" . 6301)
+ ("MONGOLIAN LETTER MANCHU ALI GALI TTA" . 6302)
+ ("MONGOLIAN LETTER MANCHU ALI GALI DDHA" . 6303)
+ ("MONGOLIAN LETTER MANCHU ALI GALI TA" . 6304)
+ ("MONGOLIAN LETTER MANCHU ALI GALI DHA" . 6305)
+ ("MONGOLIAN LETTER MANCHU ALI GALI SSA" . 6306)
+ ("MONGOLIAN LETTER MANCHU ALI GALI CYA" . 6307)
+ ("MONGOLIAN LETTER MANCHU ALI GALI ZHA" . 6308)
+ ("MONGOLIAN LETTER MANCHU ALI GALI ZA" . 6309)
+ ("MONGOLIAN LETTER ALI GALI HALF U" . 6310)
+ ("MONGOLIAN LETTER ALI GALI HALF YA" . 6311)
+ ("MONGOLIAN LETTER MANCHU ALI GALI BHA" . 6312)
+ ("MONGOLIAN LETTER ALI GALI DAGALGA" . 6313)
+ ("LATIN CAPITAL LETTER A WITH RING BELOW" . 7680)
+ ("LATIN SMALL LETTER A WITH RING BELOW" . 7681)
+ ("LATIN CAPITAL LETTER B WITH DOT ABOVE" . 7682)
+ ("LATIN SMALL LETTER B WITH DOT ABOVE" . 7683)
+ ("LATIN CAPITAL LETTER B WITH DOT BELOW" . 7684)
+ ("LATIN SMALL LETTER B WITH DOT BELOW" . 7685)
+ ("LATIN CAPITAL LETTER B WITH LINE BELOW" . 7686)
+ ("LATIN SMALL LETTER B WITH LINE BELOW" . 7687)
+ ("LATIN CAPITAL LETTER C WITH CEDILLA AND ACUTE" . 7688)
+ ("LATIN SMALL LETTER C WITH CEDILLA AND ACUTE" . 7689)
+ ("LATIN CAPITAL LETTER D WITH DOT ABOVE" . 7690)
+ ("LATIN SMALL LETTER D WITH DOT ABOVE" . 7691)
+ ("LATIN CAPITAL LETTER D WITH DOT BELOW" . 7692)
+ ("LATIN SMALL LETTER D WITH DOT BELOW" . 7693)
+ ("LATIN CAPITAL LETTER D WITH LINE BELOW" . 7694)
+ ("LATIN SMALL LETTER D WITH LINE BELOW" . 7695)
+ ("LATIN CAPITAL LETTER D WITH CEDILLA" . 7696)
+ ("LATIN SMALL LETTER D WITH CEDILLA" . 7697)
+ ("LATIN CAPITAL LETTER D WITH CIRCUMFLEX BELOW" . 7698)
+ ("LATIN SMALL LETTER D WITH CIRCUMFLEX BELOW" . 7699)
+ ("LATIN CAPITAL LETTER E WITH MACRON AND GRAVE" . 7700)
+ ("LATIN SMALL LETTER E WITH MACRON AND GRAVE" . 7701)
+ ("LATIN CAPITAL LETTER E WITH MACRON AND ACUTE" . 7702)
+ ("LATIN SMALL LETTER E WITH MACRON AND ACUTE" . 7703)
+ ("LATIN CAPITAL LETTER E WITH CIRCUMFLEX BELOW" . 7704)
+ ("LATIN SMALL LETTER E WITH CIRCUMFLEX BELOW" . 7705)
+ ("LATIN CAPITAL LETTER E WITH TILDE BELOW" . 7706)
+ ("LATIN SMALL LETTER E WITH TILDE BELOW" . 7707)
+ ("LATIN CAPITAL LETTER E WITH CEDILLA AND BREVE" . 7708)
+ ("LATIN SMALL LETTER E WITH CEDILLA AND BREVE" . 7709)
+ ("LATIN CAPITAL LETTER F WITH DOT ABOVE" . 7710)
+ ("LATIN SMALL LETTER F WITH DOT ABOVE" . 7711)
+ ("LATIN CAPITAL LETTER G WITH MACRON" . 7712)
+ ("LATIN SMALL LETTER G WITH MACRON" . 7713)
+ ("LATIN CAPITAL LETTER H WITH DOT ABOVE" . 7714)
+ ("LATIN SMALL LETTER H WITH DOT ABOVE" . 7715)
+ ("LATIN CAPITAL LETTER H WITH DOT BELOW" . 7716)
+ ("LATIN SMALL LETTER H WITH DOT BELOW" . 7717)
+ ("LATIN CAPITAL LETTER H WITH DIAERESIS" . 7718)
+ ("LATIN SMALL LETTER H WITH DIAERESIS" . 7719)
+ ("LATIN CAPITAL LETTER H WITH CEDILLA" . 7720)
+ ("LATIN SMALL LETTER H WITH CEDILLA" . 7721)
+ ("LATIN CAPITAL LETTER H WITH BREVE BELOW" . 7722)
+ ("LATIN SMALL LETTER H WITH BREVE BELOW" . 7723)
+ ("LATIN CAPITAL LETTER I WITH TILDE BELOW" . 7724)
+ ("LATIN SMALL LETTER I WITH TILDE BELOW" . 7725)
+ ("LATIN CAPITAL LETTER I WITH DIAERESIS AND ACUTE" . 7726)
+ ("LATIN SMALL LETTER I WITH DIAERESIS AND ACUTE" . 7727)
+ ("LATIN CAPITAL LETTER K WITH ACUTE" . 7728)
+ ("LATIN SMALL LETTER K WITH ACUTE" . 7729)
+ ("LATIN CAPITAL LETTER K WITH DOT BELOW" . 7730)
+ ("LATIN SMALL LETTER K WITH DOT BELOW" . 7731)
+ ("LATIN CAPITAL LETTER K WITH LINE BELOW" . 7732)
+ ("LATIN SMALL LETTER K WITH LINE BELOW" . 7733)
+ ("LATIN CAPITAL LETTER L WITH DOT BELOW" . 7734)
+ ("LATIN SMALL LETTER L WITH DOT BELOW" . 7735)
+ ("LATIN CAPITAL LETTER L WITH DOT BELOW AND MACRON" . 7736)
+ ("LATIN SMALL LETTER L WITH DOT BELOW AND MACRON" . 7737)
+ ("LATIN CAPITAL LETTER L WITH LINE BELOW" . 7738)
+ ("LATIN SMALL LETTER L WITH LINE BELOW" . 7739)
+ ("LATIN CAPITAL LETTER L WITH CIRCUMFLEX BELOW" . 7740)
+ ("LATIN SMALL LETTER L WITH CIRCUMFLEX BELOW" . 7741)
+ ("LATIN CAPITAL LETTER M WITH ACUTE" . 7742)
+ ("LATIN SMALL LETTER M WITH ACUTE" . 7743)
+ ("LATIN CAPITAL LETTER M WITH DOT ABOVE" . 7744)
+ ("LATIN SMALL LETTER M WITH DOT ABOVE" . 7745)
+ ("LATIN CAPITAL LETTER M WITH DOT BELOW" . 7746)
+ ("LATIN SMALL LETTER M WITH DOT BELOW" . 7747)
+ ("LATIN CAPITAL LETTER N WITH DOT ABOVE" . 7748)
+ ("LATIN SMALL LETTER N WITH DOT ABOVE" . 7749)
+ ("LATIN CAPITAL LETTER N WITH DOT BELOW" . 7750)
+ ("LATIN SMALL LETTER N WITH DOT BELOW" . 7751)
+ ("LATIN CAPITAL LETTER N WITH LINE BELOW" . 7752)
+ ("LATIN SMALL LETTER N WITH LINE BELOW" . 7753)
+ ("LATIN CAPITAL LETTER N WITH CIRCUMFLEX BELOW" . 7754)
+ ("LATIN SMALL LETTER N WITH CIRCUMFLEX BELOW" . 7755)
+ ("LATIN CAPITAL LETTER O WITH TILDE AND ACUTE" . 7756)
+ ("LATIN SMALL LETTER O WITH TILDE AND ACUTE" . 7757)
+ ("LATIN CAPITAL LETTER O WITH TILDE AND DIAERESIS" . 7758)
+ ("LATIN SMALL LETTER O WITH TILDE AND DIAERESIS" . 7759)
+ ("LATIN CAPITAL LETTER O WITH MACRON AND GRAVE" . 7760)
+ ("LATIN SMALL LETTER O WITH MACRON AND GRAVE" . 7761)
+ ("LATIN CAPITAL LETTER O WITH MACRON AND ACUTE" . 7762)
+ ("LATIN SMALL LETTER O WITH MACRON AND ACUTE" . 7763)
+ ("LATIN CAPITAL LETTER P WITH ACUTE" . 7764)
+ ("LATIN SMALL LETTER P WITH ACUTE" . 7765)
+ ("LATIN CAPITAL LETTER P WITH DOT ABOVE" . 7766)
+ ("LATIN SMALL LETTER P WITH DOT ABOVE" . 7767)
+ ("LATIN CAPITAL LETTER R WITH DOT ABOVE" . 7768)
+ ("LATIN SMALL LETTER R WITH DOT ABOVE" . 7769)
+ ("LATIN CAPITAL LETTER R WITH DOT BELOW" . 7770)
+ ("LATIN SMALL LETTER R WITH DOT BELOW" . 7771)
+ ("LATIN CAPITAL LETTER R WITH DOT BELOW AND MACRON" . 7772)
+ ("LATIN SMALL LETTER R WITH DOT BELOW AND MACRON" . 7773)
+ ("LATIN CAPITAL LETTER R WITH LINE BELOW" . 7774)
+ ("LATIN SMALL LETTER R WITH LINE BELOW" . 7775)
+ ("LATIN CAPITAL LETTER S WITH DOT ABOVE" . 7776)
+ ("LATIN SMALL LETTER S WITH DOT ABOVE" . 7777)
+ ("LATIN CAPITAL LETTER S WITH DOT BELOW" . 7778)
+ ("LATIN SMALL LETTER S WITH DOT BELOW" . 7779)
+ ("LATIN CAPITAL LETTER S WITH ACUTE AND DOT ABOVE" . 7780)
+ ("LATIN SMALL LETTER S WITH ACUTE AND DOT ABOVE" . 7781)
+ ("LATIN CAPITAL LETTER S WITH CARON AND DOT ABOVE" . 7782)
+ ("LATIN SMALL LETTER S WITH CARON AND DOT ABOVE" . 7783)
+ ("LATIN CAPITAL LETTER S WITH DOT BELOW AND DOT ABOVE" . 7784)
+ ("LATIN SMALL LETTER S WITH DOT BELOW AND DOT ABOVE" . 7785)
+ ("LATIN CAPITAL LETTER T WITH DOT ABOVE" . 7786)
+ ("LATIN SMALL LETTER T WITH DOT ABOVE" . 7787)
+ ("LATIN CAPITAL LETTER T WITH DOT BELOW" . 7788)
+ ("LATIN SMALL LETTER T WITH DOT BELOW" . 7789)
+ ("LATIN CAPITAL LETTER T WITH LINE BELOW" . 7790)
+ ("LATIN SMALL LETTER T WITH LINE BELOW" . 7791)
+ ("LATIN CAPITAL LETTER T WITH CIRCUMFLEX BELOW" . 7792)
+ ("LATIN SMALL LETTER T WITH CIRCUMFLEX BELOW" . 7793)
+ ("LATIN CAPITAL LETTER U WITH DIAERESIS BELOW" . 7794)
+ ("LATIN SMALL LETTER U WITH DIAERESIS BELOW" . 7795)
+ ("LATIN CAPITAL LETTER U WITH TILDE BELOW" . 7796)
+ ("LATIN SMALL LETTER U WITH TILDE BELOW" . 7797)
+ ("LATIN CAPITAL LETTER U WITH CIRCUMFLEX BELOW" . 7798)
+ ("LATIN SMALL LETTER U WITH CIRCUMFLEX BELOW" . 7799)
+ ("LATIN CAPITAL LETTER U WITH TILDE AND ACUTE" . 7800)
+ ("LATIN SMALL LETTER U WITH TILDE AND ACUTE" . 7801)
+ ("LATIN CAPITAL LETTER U WITH MACRON AND DIAERESIS" . 7802)
+ ("LATIN SMALL LETTER U WITH MACRON AND DIAERESIS" . 7803)
+ ("LATIN CAPITAL LETTER V WITH TILDE" . 7804)
+ ("LATIN SMALL LETTER V WITH TILDE" . 7805)
+ ("LATIN CAPITAL LETTER V WITH DOT BELOW" . 7806)
+ ("LATIN SMALL LETTER V WITH DOT BELOW" . 7807)
+ ("LATIN CAPITAL LETTER W WITH GRAVE" . 7808)
+ ("LATIN SMALL LETTER W WITH GRAVE" . 7809)
+ ("LATIN CAPITAL LETTER W WITH ACUTE" . 7810)
+ ("LATIN SMALL LETTER W WITH ACUTE" . 7811)
+ ("LATIN CAPITAL LETTER W WITH DIAERESIS" . 7812)
+ ("LATIN SMALL LETTER W WITH DIAERESIS" . 7813)
+ ("LATIN CAPITAL LETTER W WITH DOT ABOVE" . 7814)
+ ("LATIN SMALL LETTER W WITH DOT ABOVE" . 7815)
+ ("LATIN CAPITAL LETTER W WITH DOT BELOW" . 7816)
+ ("LATIN SMALL LETTER W WITH DOT BELOW" . 7817)
+ ("LATIN CAPITAL LETTER X WITH DOT ABOVE" . 7818)
+ ("LATIN SMALL LETTER X WITH DOT ABOVE" . 7819)
+ ("LATIN CAPITAL LETTER X WITH DIAERESIS" . 7820)
+ ("LATIN SMALL LETTER X WITH DIAERESIS" . 7821)
+ ("LATIN CAPITAL LETTER Y WITH DOT ABOVE" . 7822)
+ ("LATIN SMALL LETTER Y WITH DOT ABOVE" . 7823)
+ ("LATIN CAPITAL LETTER Z WITH CIRCUMFLEX" . 7824)
+ ("LATIN SMALL LETTER Z WITH CIRCUMFLEX" . 7825)
+ ("LATIN CAPITAL LETTER Z WITH DOT BELOW" . 7826)
+ ("LATIN SMALL LETTER Z WITH DOT BELOW" . 7827)
+ ("LATIN CAPITAL LETTER Z WITH LINE BELOW" . 7828)
+ ("LATIN SMALL LETTER Z WITH LINE BELOW" . 7829)
+ ("LATIN SMALL LETTER H WITH LINE BELOW" . 7830)
+ ("LATIN SMALL LETTER T WITH DIAERESIS" . 7831)
+ ("LATIN SMALL LETTER W WITH RING ABOVE" . 7832)
+ ("LATIN SMALL LETTER Y WITH RING ABOVE" . 7833)
+ ("LATIN SMALL LETTER A WITH RIGHT HALF RING" . 7834)
+ ("LATIN SMALL LETTER LONG S WITH DOT ABOVE" . 7835)
+ ("LATIN CAPITAL LETTER A WITH DOT BELOW" . 7840)
+ ("LATIN SMALL LETTER A WITH DOT BELOW" . 7841)
+ ("LATIN CAPITAL LETTER A WITH HOOK ABOVE" . 7842)
+ ("LATIN SMALL LETTER A WITH HOOK ABOVE" . 7843)
+ ("LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE" . 7844)
+ ("LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE" . 7845)
+ ("LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE" . 7846)
+ ("LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE" . 7847)
+ ("LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE" . 7848)
+ ("LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE" . 7849)
+ ("LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE" . 7850)
+ ("LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE" . 7851)
+ ("LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW" . 7852)
+ ("LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW" . 7853)
+ ("LATIN CAPITAL LETTER A WITH BREVE AND ACUTE" . 7854)
+ ("LATIN SMALL LETTER A WITH BREVE AND ACUTE" . 7855)
+ ("LATIN CAPITAL LETTER A WITH BREVE AND GRAVE" . 7856)
+ ("LATIN SMALL LETTER A WITH BREVE AND GRAVE" . 7857)
+ ("LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE" . 7858)
+ ("LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE" . 7859)
+ ("LATIN CAPITAL LETTER A WITH BREVE AND TILDE" . 7860)
+ ("LATIN SMALL LETTER A WITH BREVE AND TILDE" . 7861)
+ ("LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW" . 7862)
+ ("LATIN SMALL LETTER A WITH BREVE AND DOT BELOW" . 7863)
+ ("LATIN CAPITAL LETTER E WITH DOT BELOW" . 7864)
+ ("LATIN SMALL LETTER E WITH DOT BELOW" . 7865)
+ ("LATIN CAPITAL LETTER E WITH HOOK ABOVE" . 7866)
+ ("LATIN SMALL LETTER E WITH HOOK ABOVE" . 7867)
+ ("LATIN CAPITAL LETTER E WITH TILDE" . 7868)
+ ("LATIN SMALL LETTER E WITH TILDE" . 7869)
+ ("LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE" . 7870)
+ ("LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE" . 7871)
+ ("LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE" . 7872)
+ ("LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE" . 7873)
+ ("LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE" . 7874)
+ ("LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE" . 7875)
+ ("LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE" . 7876)
+ ("LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE" . 7877)
+ ("LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW" . 7878)
+ ("LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW" . 7879)
+ ("LATIN CAPITAL LETTER I WITH HOOK ABOVE" . 7880)
+ ("LATIN SMALL LETTER I WITH HOOK ABOVE" . 7881)
+ ("LATIN CAPITAL LETTER I WITH DOT BELOW" . 7882)
+ ("LATIN SMALL LETTER I WITH DOT BELOW" . 7883)
+ ("LATIN CAPITAL LETTER O WITH DOT BELOW" . 7884)
+ ("LATIN SMALL LETTER O WITH DOT BELOW" . 7885)
+ ("LATIN CAPITAL LETTER O WITH HOOK ABOVE" . 7886)
+ ("LATIN SMALL LETTER O WITH HOOK ABOVE" . 7887)
+ ("LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE" . 7888)
+ ("LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE" . 7889)
+ ("LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE" . 7890)
+ ("LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE" . 7891)
+ ("LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE" . 7892)
+ ("LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE" . 7893)
+ ("LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE" . 7894)
+ ("LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE" . 7895)
+ ("LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW" . 7896)
+ ("LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW" . 7897)
+ ("LATIN CAPITAL LETTER O WITH HORN AND ACUTE" . 7898)
+ ("LATIN SMALL LETTER O WITH HORN AND ACUTE" . 7899)
+ ("LATIN CAPITAL LETTER O WITH HORN AND GRAVE" . 7900)
+ ("LATIN SMALL LETTER O WITH HORN AND GRAVE" . 7901)
+ ("LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE" . 7902)
+ ("LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE" . 7903)
+ ("LATIN CAPITAL LETTER O WITH HORN AND TILDE" . 7904)
+ ("LATIN SMALL LETTER O WITH HORN AND TILDE" . 7905)
+ ("LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW" . 7906)
+ ("LATIN SMALL LETTER O WITH HORN AND DOT BELOW" . 7907)
+ ("LATIN CAPITAL LETTER U WITH DOT BELOW" . 7908)
+ ("LATIN SMALL LETTER U WITH DOT BELOW" . 7909)
+ ("LATIN CAPITAL LETTER U WITH HOOK ABOVE" . 7910)
+ ("LATIN SMALL LETTER U WITH HOOK ABOVE" . 7911)
+ ("LATIN CAPITAL LETTER U WITH HORN AND ACUTE" . 7912)
+ ("LATIN SMALL LETTER U WITH HORN AND ACUTE" . 7913)
+ ("LATIN CAPITAL LETTER U WITH HORN AND GRAVE" . 7914)
+ ("LATIN SMALL LETTER U WITH HORN AND GRAVE" . 7915)
+ ("LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE" . 7916)
+ ("LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE" . 7917)
+ ("LATIN CAPITAL LETTER U WITH HORN AND TILDE" . 7918)
+ ("LATIN SMALL LETTER U WITH HORN AND TILDE" . 7919)
+ ("LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW" . 7920)
+ ("LATIN SMALL LETTER U WITH HORN AND DOT BELOW" . 7921)
+ ("LATIN CAPITAL LETTER Y WITH GRAVE" . 7922)
+ ("LATIN SMALL LETTER Y WITH GRAVE" . 7923)
+ ("LATIN CAPITAL LETTER Y WITH DOT BELOW" . 7924)
+ ("LATIN SMALL LETTER Y WITH DOT BELOW" . 7925)
+ ("LATIN CAPITAL LETTER Y WITH HOOK ABOVE" . 7926)
+ ("LATIN SMALL LETTER Y WITH HOOK ABOVE" . 7927)
+ ("LATIN CAPITAL LETTER Y WITH TILDE" . 7928)
+ ("LATIN SMALL LETTER Y WITH TILDE" . 7929)
+ ("GREEK SMALL LETTER ALPHA WITH PSILI" . 7936)
+ ("GREEK SMALL LETTER ALPHA WITH DASIA" . 7937)
+ ("GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA" . 7938)
+ ("GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA" . 7939)
+ ("GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA" . 7940)
+ ("GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA" . 7941)
+ ("GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI" . 7942)
+ ("GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI" . 7943)
+ ("GREEK CAPITAL LETTER ALPHA WITH PSILI" . 7944)
+ ("GREEK CAPITAL LETTER ALPHA WITH DASIA" . 7945)
+ ("GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA" . 7946)
+ ("GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA" . 7947)
+ ("GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA" . 7948)
+ ("GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA" . 7949)
+ ("GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI" . 7950)
+ ("GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI" . 7951)
+ ("GREEK SMALL LETTER EPSILON WITH PSILI" . 7952)
+ ("GREEK SMALL LETTER EPSILON WITH DASIA" . 7953)
+ ("GREEK SMALL LETTER EPSILON WITH PSILI AND VARIA" . 7954)
+ ("GREEK SMALL LETTER EPSILON WITH DASIA AND VARIA" . 7955)
+ ("GREEK SMALL LETTER EPSILON WITH PSILI AND OXIA" . 7956)
+ ("GREEK SMALL LETTER EPSILON WITH DASIA AND OXIA" . 7957)
+ ("GREEK CAPITAL LETTER EPSILON WITH PSILI" . 7960)
+ ("GREEK CAPITAL LETTER EPSILON WITH DASIA" . 7961)
+ ("GREEK CAPITAL LETTER EPSILON WITH PSILI AND VARIA" . 7962)
+ ("GREEK CAPITAL LETTER EPSILON WITH DASIA AND VARIA" . 7963)
+ ("GREEK CAPITAL LETTER EPSILON WITH PSILI AND OXIA" . 7964)
+ ("GREEK CAPITAL LETTER EPSILON WITH DASIA AND OXIA" . 7965)
+ ("GREEK SMALL LETTER ETA WITH PSILI" . 7968)
+ ("GREEK SMALL LETTER ETA WITH DASIA" . 7969)
+ ("GREEK SMALL LETTER ETA WITH PSILI AND VARIA" . 7970)
+ ("GREEK SMALL LETTER ETA WITH DASIA AND VARIA" . 7971)
+ ("GREEK SMALL LETTER ETA WITH PSILI AND OXIA" . 7972)
+ ("GREEK SMALL LETTER ETA WITH DASIA AND OXIA" . 7973)
+ ("GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI" . 7974)
+ ("GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI" . 7975)
+ ("GREEK CAPITAL LETTER ETA WITH PSILI" . 7976)
+ ("GREEK CAPITAL LETTER ETA WITH DASIA" . 7977)
+ ("GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA" . 7978)
+ ("GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA" . 7979)
+ ("GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA" . 7980)
+ ("GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA" . 7981)
+ ("GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI" . 7982)
+ ("GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI" . 7983)
+ ("GREEK SMALL LETTER IOTA WITH PSILI" . 7984)
+ ("GREEK SMALL LETTER IOTA WITH DASIA" . 7985)
+ ("GREEK SMALL LETTER IOTA WITH PSILI AND VARIA" . 7986)
+ ("GREEK SMALL LETTER IOTA WITH DASIA AND VARIA" . 7987)
+ ("GREEK SMALL LETTER IOTA WITH PSILI AND OXIA" . 7988)
+ ("GREEK SMALL LETTER IOTA WITH DASIA AND OXIA" . 7989)
+ ("GREEK SMALL LETTER IOTA WITH PSILI AND PERISPOMENI" . 7990)
+ ("GREEK SMALL LETTER IOTA WITH DASIA AND PERISPOMENI" . 7991)
+ ("GREEK CAPITAL LETTER IOTA WITH PSILI" . 7992)
+ ("GREEK CAPITAL LETTER IOTA WITH DASIA" . 7993)
+ ("GREEK CAPITAL LETTER IOTA WITH PSILI AND VARIA" . 7994)
+ ("GREEK CAPITAL LETTER IOTA WITH DASIA AND VARIA" . 7995)
+ ("GREEK CAPITAL LETTER IOTA WITH PSILI AND OXIA" . 7996)
+ ("GREEK CAPITAL LETTER IOTA WITH DASIA AND OXIA" . 7997)
+ ("GREEK CAPITAL LETTER IOTA WITH PSILI AND PERISPOMENI" . 7998)
+ ("GREEK CAPITAL LETTER IOTA WITH DASIA AND PERISPOMENI" . 7999)
+ ("GREEK SMALL LETTER OMICRON WITH PSILI" . 8000)
+ ("GREEK SMALL LETTER OMICRON WITH DASIA" . 8001)
+ ("GREEK SMALL LETTER OMICRON WITH PSILI AND VARIA" . 8002)
+ ("GREEK SMALL LETTER OMICRON WITH DASIA AND VARIA" . 8003)
+ ("GREEK SMALL LETTER OMICRON WITH PSILI AND OXIA" . 8004)
+ ("GREEK SMALL LETTER OMICRON WITH DASIA AND OXIA" . 8005)
+ ("GREEK CAPITAL LETTER OMICRON WITH PSILI" . 8008)
+ ("GREEK CAPITAL LETTER OMICRON WITH DASIA" . 8009)
+ ("GREEK CAPITAL LETTER OMICRON WITH PSILI AND VARIA" . 8010)
+ ("GREEK CAPITAL LETTER OMICRON WITH DASIA AND VARIA" . 8011)
+ ("GREEK CAPITAL LETTER OMICRON WITH PSILI AND OXIA" . 8012)
+ ("GREEK CAPITAL LETTER OMICRON WITH DASIA AND OXIA" . 8013)
+ ("GREEK SMALL LETTER UPSILON WITH PSILI" . 8016)
+ ("GREEK SMALL LETTER UPSILON WITH DASIA" . 8017)
+ ("GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA" . 8018)
+ ("GREEK SMALL LETTER UPSILON WITH DASIA AND VARIA" . 8019)
+ ("GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA" . 8020)
+ ("GREEK SMALL LETTER UPSILON WITH DASIA AND OXIA" . 8021)
+ ("GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI" . 8022)
+ ("GREEK SMALL LETTER UPSILON WITH DASIA AND PERISPOMENI" . 8023)
+ ("GREEK CAPITAL LETTER UPSILON WITH DASIA" . 8025)
+ ("GREEK CAPITAL LETTER UPSILON WITH DASIA AND VARIA" . 8027)
+ ("GREEK CAPITAL LETTER UPSILON WITH DASIA AND OXIA" . 8029)
+ ("GREEK CAPITAL LETTER UPSILON WITH DASIA AND PERISPOMENI" . 8031)
+ ("GREEK SMALL LETTER OMEGA WITH PSILI" . 8032)
+ ("GREEK SMALL LETTER OMEGA WITH DASIA" . 8033)
+ ("GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA" . 8034)
+ ("GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA" . 8035)
+ ("GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA" . 8036)
+ ("GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA" . 8037)
+ ("GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI" . 8038)
+ ("GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI" . 8039)
+ ("GREEK CAPITAL LETTER OMEGA WITH PSILI" . 8040)
+ ("GREEK CAPITAL LETTER OMEGA WITH DASIA" . 8041)
+ ("GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA" . 8042)
+ ("GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA" . 8043)
+ ("GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA" . 8044)
+ ("GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA" . 8045)
+ ("GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI" . 8046)
+ ("GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI" . 8047)
+ ("GREEK SMALL LETTER ALPHA WITH VARIA" . 8048)
+ ("GREEK SMALL LETTER ALPHA WITH OXIA" . 8049)
+ ("GREEK SMALL LETTER EPSILON WITH VARIA" . 8050)
+ ("GREEK SMALL LETTER EPSILON WITH OXIA" . 8051)
+ ("GREEK SMALL LETTER ETA WITH VARIA" . 8052)
+ ("GREEK SMALL LETTER ETA WITH OXIA" . 8053)
+ ("GREEK SMALL LETTER IOTA WITH VARIA" . 8054)
+ ("GREEK SMALL LETTER IOTA WITH OXIA" . 8055)
+ ("GREEK SMALL LETTER OMICRON WITH VARIA" . 8056)
+ ("GREEK SMALL LETTER OMICRON WITH OXIA" . 8057)
+ ("GREEK SMALL LETTER UPSILON WITH VARIA" . 8058)
+ ("GREEK SMALL LETTER UPSILON WITH OXIA" . 8059)
+ ("GREEK SMALL LETTER OMEGA WITH VARIA" . 8060)
+ ("GREEK SMALL LETTER OMEGA WITH OXIA" . 8061)
+ ("GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI" . 8064)
+ ("GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI" . 8065)
+ ("GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI" . 8066)
+ ("GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI" . 8067)
+ ("GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI" . 8068)
+ ("GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI" . 8069)
+ ("GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI" . 8070)
+ ("GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI" . 8071)
+ ("GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI" . 8072)
+ ("GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI" . 8073)
+ ("GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI" . 8074)
+ ("GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI" . 8075)
+ ("GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI" . 8076)
+ ("GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI" . 8077)
+ ("GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI" . 8078)
+ ("GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI" . 8079)
+ ("GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI" . 8080)
+ ("GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI" . 8081)
+ ("GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI" . 8082)
+ ("GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI" . 8083)
+ ("GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI" . 8084)
+ ("GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI" . 8085)
+ ("GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI" . 8086)
+ ("GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI" . 8087)
+ ("GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI" . 8088)
+ ("GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI" . 8089)
+ ("GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI" . 8090)
+ ("GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI" . 8091)
+ ("GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI" . 8092)
+ ("GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI" . 8093)
+ ("GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI" . 8094)
+ ("GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI" . 8095)
+ ("GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI" . 8096)
+ ("GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI" . 8097)
+ ("GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI" . 8098)
+ ("GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI" . 8099)
+ ("GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI" . 8100)
+ ("GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI" . 8101)
+ ("GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI" . 8102)
+ ("GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI" . 8103)
+ ("GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI" . 8104)
+ ("GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI" . 8105)
+ ("GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI" . 8106)
+ ("GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI" . 8107)
+ ("GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI" . 8108)
+ ("GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI" . 8109)
+ ("GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI" . 8110)
+ ("GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI" . 8111)
+ ("GREEK SMALL LETTER ALPHA WITH VRACHY" . 8112)
+ ("GREEK SMALL LETTER ALPHA WITH MACRON" . 8113)
+ ("GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI" . 8114)
+ ("GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI" . 8115)
+ ("GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI" . 8116)
+ ("GREEK SMALL LETTER ALPHA WITH PERISPOMENI" . 8118)
+ ("GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI" . 8119)
+ ("GREEK CAPITAL LETTER ALPHA WITH VRACHY" . 8120)
+ ("GREEK CAPITAL LETTER ALPHA WITH MACRON" . 8121)
+ ("GREEK CAPITAL LETTER ALPHA WITH VARIA" . 8122)
+ ("GREEK CAPITAL LETTER ALPHA WITH OXIA" . 8123)
+ ("GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI" . 8124)
+ ("GREEK KORONIS" . 8125)
+ ("GREEK PROSGEGRAMMENI" . 8126)
+ ("GREEK PSILI" . 8127)
+ ("GREEK PERISPOMENI" . 8128)
+ ("GREEK DIALYTIKA AND PERISPOMENI" . 8129)
+ ("GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI" . 8130)
+ ("GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI" . 8131)
+ ("GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI" . 8132)
+ ("GREEK SMALL LETTER ETA WITH PERISPOMENI" . 8134)
+ ("GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI" . 8135)
+ ("GREEK CAPITAL LETTER EPSILON WITH VARIA" . 8136)
+ ("GREEK CAPITAL LETTER EPSILON WITH OXIA" . 8137)
+ ("GREEK CAPITAL LETTER ETA WITH VARIA" . 8138)
+ ("GREEK CAPITAL LETTER ETA WITH OXIA" . 8139)
+ ("GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI" . 8140)
+ ("GREEK PSILI AND VARIA" . 8141)
+ ("GREEK PSILI AND OXIA" . 8142)
+ ("GREEK PSILI AND PERISPOMENI" . 8143)
+ ("GREEK SMALL LETTER IOTA WITH VRACHY" . 8144)
+ ("GREEK SMALL LETTER IOTA WITH MACRON" . 8145)
+ ("GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA" . 8146)
+ ("GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA" . 8147)
+ ("GREEK SMALL LETTER IOTA WITH PERISPOMENI" . 8150)
+ ("GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI" . 8151)
+ ("GREEK CAPITAL LETTER IOTA WITH VRACHY" . 8152)
+ ("GREEK CAPITAL LETTER IOTA WITH MACRON" . 8153)
+ ("GREEK CAPITAL LETTER IOTA WITH VARIA" . 8154)
+ ("GREEK CAPITAL LETTER IOTA WITH OXIA" . 8155)
+ ("GREEK DASIA AND VARIA" . 8157)
+ ("GREEK DASIA AND OXIA" . 8158)
+ ("GREEK DASIA AND PERISPOMENI" . 8159)
+ ("GREEK SMALL LETTER UPSILON WITH VRACHY" . 8160)
+ ("GREEK SMALL LETTER UPSILON WITH MACRON" . 8161)
+ ("GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA" . 8162)
+ ("GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA" . 8163)
+ ("GREEK SMALL LETTER RHO WITH PSILI" . 8164)
+ ("GREEK SMALL LETTER RHO WITH DASIA" . 8165)
+ ("GREEK SMALL LETTER UPSILON WITH PERISPOMENI" . 8166)
+ ("GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI" . 8167)
+ ("GREEK CAPITAL LETTER UPSILON WITH VRACHY" . 8168)
+ ("GREEK CAPITAL LETTER UPSILON WITH MACRON" . 8169)
+ ("GREEK CAPITAL LETTER UPSILON WITH VARIA" . 8170)
+ ("GREEK CAPITAL LETTER UPSILON WITH OXIA" . 8171)
+ ("GREEK CAPITAL LETTER RHO WITH DASIA" . 8172)
+ ("GREEK DIALYTIKA AND VARIA" . 8173)
+ ("GREEK DIALYTIKA AND OXIA" . 8174)
+ ("GREEK VARIA" . 8175)
+ ("GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI" . 8178)
+ ("GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI" . 8179)
+ ("GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI" . 8180)
+ ("GREEK SMALL LETTER OMEGA WITH PERISPOMENI" . 8182)
+ ("GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI" . 8183)
+ ("GREEK CAPITAL LETTER OMICRON WITH VARIA" . 8184)
+ ("GREEK CAPITAL LETTER OMICRON WITH OXIA" . 8185)
+ ("GREEK CAPITAL LETTER OMEGA WITH VARIA" . 8186)
+ ("GREEK CAPITAL LETTER OMEGA WITH OXIA" . 8187)
+ ("GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI" . 8188)
+ ("GREEK OXIA" . 8189)
+ ("GREEK DASIA" . 8190)
+ ("EN QUAD" . 8192)
+ ("EM QUAD" . 8193)
+ ("EN SPACE" . 8194)
+ ("EM SPACE" . 8195)
+ ("THREE-PER-EM SPACE" . 8196)
+ ("FOUR-PER-EM SPACE" . 8197)
+ ("SIX-PER-EM SPACE" . 8198)
+ ("FIGURE SPACE" . 8199)
+ ("PUNCTUATION SPACE" . 8200)
+ ("THIN SPACE" . 8201)
+ ("HAIR SPACE" . 8202)
+ ("ZERO WIDTH SPACE" . 8203)
+ ("ZERO WIDTH NON-JOINER" . 8204)
+ ("ZERO WIDTH JOINER" . 8205)
+ ("LEFT-TO-RIGHT MARK" . 8206)
+ ("RIGHT-TO-LEFT MARK" . 8207)
+ ("HYPHEN" . 8208)
+ ("NON-BREAKING HYPHEN" . 8209)
+ ("FIGURE DASH" . 8210)
+ ("EN DASH" . 8211)
+ ("EM DASH" . 8212)
+ ("HORIZONTAL BAR" . 8213)
+ ("DOUBLE VERTICAL LINE" . 8214)
+ ("DOUBLE LOW LINE" . 8215)
+ ("LEFT SINGLE QUOTATION MARK" . 8216)
+ ("RIGHT SINGLE QUOTATION MARK" . 8217)
+ ("SINGLE LOW-9 QUOTATION MARK" . 8218)
+ ("SINGLE HIGH-REVERSED-9 QUOTATION MARK" . 8219)
+ ("LEFT DOUBLE QUOTATION MARK" . 8220)
+ ("RIGHT DOUBLE QUOTATION MARK" . 8221)
+ ("DOUBLE LOW-9 QUOTATION MARK" . 8222)
+ ("DOUBLE HIGH-REVERSED-9 QUOTATION MARK" . 8223)
+ ("DAGGER" . 8224)
+ ("DOUBLE DAGGER" . 8225)
+ ("BULLET" . 8226)
+ ("TRIANGULAR BULLET" . 8227)
+ ("ONE DOT LEADER" . 8228)
+ ("TWO DOT LEADER" . 8229)
+ ("HORIZONTAL ELLIPSIS" . 8230)
+ ("HYPHENATION POINT" . 8231)
+ ("LINE SEPARATOR" . 8232)
+ ("PARAGRAPH SEPARATOR" . 8233)
+ ("LEFT-TO-RIGHT EMBEDDING" . 8234)
+ ("RIGHT-TO-LEFT EMBEDDING" . 8235)
+ ("POP DIRECTIONAL FORMATTING" . 8236)
+ ("LEFT-TO-RIGHT OVERRIDE" . 8237)
+ ("RIGHT-TO-LEFT OVERRIDE" . 8238)
+ ("NARROW NO-BREAK SPACE" . 8239)
+ ("PER MILLE SIGN" . 8240)
+ ("PER TEN THOUSAND SIGN" . 8241)
+ ("PRIME" . 8242)
+ ("DOUBLE PRIME" . 8243)
+ ("TRIPLE PRIME" . 8244)
+ ("REVERSED PRIME" . 8245)
+ ("REVERSED DOUBLE PRIME" . 8246)
+ ("REVERSED TRIPLE PRIME" . 8247)
+ ("CARET" . 8248)
+ ("SINGLE LEFT-POINTING ANGLE QUOTATION MARK" . 8249)
+ ("SINGLE RIGHT-POINTING ANGLE QUOTATION MARK" . 8250)
+ ("REFERENCE MARK" . 8251)
+ ("DOUBLE EXCLAMATION MARK" . 8252)
+ ("INTERROBANG" . 8253)
+ ("OVERLINE" . 8254)
+ ("UNDERTIE" . 8255)
+ ("CHARACTER TIE" . 8256)
+ ("CARET INSERTION POINT" . 8257)
+ ("ASTERISM" . 8258)
+ ("HYPHEN BULLET" . 8259)
+ ("FRACTION SLASH" . 8260)
+ ("LEFT SQUARE BRACKET WITH QUILL" . 8261)
+ ("RIGHT SQUARE BRACKET WITH QUILL" . 8262)
+ ("DOUBLE QUESTION MARK" . 8263)
+ ("QUESTION EXCLAMATION MARK" . 8264)
+ ("EXCLAMATION QUESTION MARK" . 8265)
+ ("TIRONIAN SIGN ET" . 8266)
+ ("REVERSED PILCROW SIGN" . 8267)
+ ("BLACK LEFTWARDS BULLET" . 8268)
+ ("BLACK RIGHTWARDS BULLET" . 8269)
+ ("LOW ASTERISK" . 8270)
+ ("REVERSED SEMICOLON" . 8271)
+ ("CLOSE UP" . 8272)
+ ("TWO ASTERISKS ALIGNED VERTICALLY" . 8273)
+ ("COMMERCIAL MINUS SIGN" . 8274)
+ ("QUADRUPLE PRIME" . 8279)
+ ("MEDIUM MATHEMATICAL SPACE" . 8287)
+ ("WORD JOINER" . 8288)
+ ("FUNCTION APPLICATION" . 8289)
+ ("INVISIBLE TIMES" . 8290)
+ ("INVISIBLE SEPARATOR" . 8291)
+ ("INHIBIT SYMMETRIC SWAPPING" . 8298)
+ ("ACTIVATE SYMMETRIC SWAPPING" . 8299)
+ ("INHIBIT ARABIC FORM SHAPING" . 8300)
+ ("ACTIVATE ARABIC FORM SHAPING" . 8301)
+ ("NATIONAL DIGIT SHAPES" . 8302)
+ ("NOMINAL DIGIT SHAPES" . 8303)
+ ("SUPERSCRIPT ZERO" . 8304)
+ ("SUPERSCRIPT LATIN SMALL LETTER I" . 8305)
+ ("SUPERSCRIPT FOUR" . 8308)
+ ("SUPERSCRIPT FIVE" . 8309)
+ ("SUPERSCRIPT SIX" . 8310)
+ ("SUPERSCRIPT SEVEN" . 8311)
+ ("SUPERSCRIPT EIGHT" . 8312)
+ ("SUPERSCRIPT NINE" . 8313)
+ ("SUPERSCRIPT PLUS SIGN" . 8314)
+ ("SUPERSCRIPT MINUS" . 8315)
+ ("SUPERSCRIPT EQUALS SIGN" . 8316)
+ ("SUPERSCRIPT LEFT PARENTHESIS" . 8317)
+ ("SUPERSCRIPT RIGHT PARENTHESIS" . 8318)
+ ("SUPERSCRIPT LATIN SMALL LETTER N" . 8319)
+ ("SUBSCRIPT ZERO" . 8320)
+ ("SUBSCRIPT ONE" . 8321)
+ ("SUBSCRIPT TWO" . 8322)
+ ("SUBSCRIPT THREE" . 8323)
+ ("SUBSCRIPT FOUR" . 8324)
+ ("SUBSCRIPT FIVE" . 8325)
+ ("SUBSCRIPT SIX" . 8326)
+ ("SUBSCRIPT SEVEN" . 8327)
+ ("SUBSCRIPT EIGHT" . 8328)
+ ("SUBSCRIPT NINE" . 8329)
+ ("SUBSCRIPT PLUS SIGN" . 8330)
+ ("SUBSCRIPT MINUS" . 8331)
+ ("SUBSCRIPT EQUALS SIGN" . 8332)
+ ("SUBSCRIPT LEFT PARENTHESIS" . 8333)
+ ("SUBSCRIPT RIGHT PARENTHESIS" . 8334)
+ ("EURO-CURRENCY SIGN" . 8352)
+ ("COLON SIGN" . 8353)
+ ("CRUZEIRO SIGN" . 8354)
+ ("FRENCH FRANC SIGN" . 8355)
+ ("LIRA SIGN" . 8356)
+ ("MILL SIGN" . 8357)
+ ("NAIRA SIGN" . 8358)
+ ("PESETA SIGN" . 8359)
+ ("RUPEE SIGN" . 8360)
+ ("WON SIGN" . 8361)
+ ("NEW SHEQEL SIGN" . 8362)
+ ("DONG SIGN" . 8363)
+ ("EURO SIGN" . 8364)
+ ("KIP SIGN" . 8365)
+ ("TUGRIK SIGN" . 8366)
+ ("DRACHMA SIGN" . 8367)
+ ("GERMAN PENNY SIGN" . 8368)
+ ("PESO SIGN" . 8369)
+ ("COMBINING LEFT HARPOON ABOVE" . 8400)
+ ("COMBINING RIGHT HARPOON ABOVE" . 8401)
+ ("COMBINING LONG VERTICAL LINE OVERLAY" . 8402)
+ ("COMBINING SHORT VERTICAL LINE OVERLAY" . 8403)
+ ("COMBINING ANTICLOCKWISE ARROW ABOVE" . 8404)
+ ("COMBINING CLOCKWISE ARROW ABOVE" . 8405)
+ ("COMBINING LEFT ARROW ABOVE" . 8406)
+ ("COMBINING RIGHT ARROW ABOVE" . 8407)
+ ("COMBINING RING OVERLAY" . 8408)
+ ("COMBINING CLOCKWISE RING OVERLAY" . 8409)
+ ("COMBINING ANTICLOCKWISE RING OVERLAY" . 8410)
+ ("COMBINING THREE DOTS ABOVE" . 8411)
+ ("COMBINING FOUR DOTS ABOVE" . 8412)
+ ("COMBINING ENCLOSING CIRCLE" . 8413)
+ ("COMBINING ENCLOSING SQUARE" . 8414)
+ ("COMBINING ENCLOSING DIAMOND" . 8415)
+ ("COMBINING ENCLOSING CIRCLE BACKSLASH" . 8416)
+ ("COMBINING LEFT RIGHT ARROW ABOVE" . 8417)
+ ("COMBINING ENCLOSING SCREEN" . 8418)
+ ("COMBINING ENCLOSING KEYCAP" . 8419)
+ ("COMBINING ENCLOSING UPWARD POINTING TRIANGLE" . 8420)
+ ("COMBINING REVERSE SOLIDUS OVERLAY" . 8421)
+ ("COMBINING DOUBLE VERTICAL STROKE OVERLAY" . 8422)
+ ("COMBINING ANNUITY SYMBOL" . 8423)
+ ("COMBINING TRIPLE UNDERDOT" . 8424)
+ ("COMBINING WIDE BRIDGE ABOVE" . 8425)
+ ("COMBINING LEFTWARDS ARROW OVERLAY" . 8426)
+ ("ACCOUNT OF" . 8448)
+ ("ADDRESSED TO THE SUBJECT" . 8449)
+ ("DOUBLE-STRUCK CAPITAL C" . 8450)
+ ("DEGREE CELSIUS" . 8451)
+ ("CENTRE LINE SYMBOL" . 8452)
+ ("CARE OF" . 8453)
+ ("CADA UNA" . 8454)
+ ("EULER CONSTANT" . 8455)
+ ("SCRUPLE" . 8456)
+ ("DEGREE FAHRENHEIT" . 8457)
+ ("SCRIPT SMALL G" . 8458)
+ ("SCRIPT CAPITAL H" . 8459)
+ ("BLACK-LETTER CAPITAL H" . 8460)
+ ("DOUBLE-STRUCK CAPITAL H" . 8461)
+ ("PLANCK CONSTANT" . 8462)
+ ("PLANCK CONSTANT OVER TWO PI" . 8463)
+ ("SCRIPT CAPITAL I" . 8464)
+ ("BLACK-LETTER CAPITAL I" . 8465)
+ ("SCRIPT CAPITAL L" . 8466)
+ ("SCRIPT SMALL L" . 8467)
+ ("L B BAR SYMBOL" . 8468)
+ ("DOUBLE-STRUCK CAPITAL N" . 8469)
+ ("NUMERO SIGN" . 8470)
+ ("SOUND RECORDING COPYRIGHT" . 8471)
+ ("SCRIPT CAPITAL P" . 8472)
+ ("DOUBLE-STRUCK CAPITAL P" . 8473)
+ ("DOUBLE-STRUCK CAPITAL Q" . 8474)
+ ("SCRIPT CAPITAL R" . 8475)
+ ("BLACK-LETTER CAPITAL R" . 8476)
+ ("DOUBLE-STRUCK CAPITAL R" . 8477)
+ ("PRESCRIPTION TAKE" . 8478)
+ ("RESPONSE" . 8479)
+ ("SERVICE MARK" . 8480)
+ ("TELEPHONE SIGN" . 8481)
+ ("TRADE MARK SIGN" . 8482)
+ ("VERSICLE" . 8483)
+ ("DOUBLE-STRUCK CAPITAL Z" . 8484)
+ ("OUNCE SIGN" . 8485)
+ ("OHM SIGN" . 8486)
+ ("INVERTED OHM SIGN" . 8487)
+ ("BLACK-LETTER CAPITAL Z" . 8488)
+ ("TURNED GREEK SMALL LETTER IOTA" . 8489)
+ ("KELVIN SIGN" . 8490)
+ ("ANGSTROM SIGN" . 8491)
+ ("SCRIPT CAPITAL B" . 8492)
+ ("BLACK-LETTER CAPITAL C" . 8493)
+ ("ESTIMATED SYMBOL" . 8494)
+ ("SCRIPT SMALL E" . 8495)
+ ("SCRIPT CAPITAL E" . 8496)
+ ("SCRIPT CAPITAL F" . 8497)
+ ("TURNED CAPITAL F" . 8498)
+ ("SCRIPT CAPITAL M" . 8499)
+ ("SCRIPT SMALL O" . 8500)
+ ("ALEF SYMBOL" . 8501)
+ ("BET SYMBOL" . 8502)
+ ("GIMEL SYMBOL" . 8503)
+ ("DALET SYMBOL" . 8504)
+ ("INFORMATION SOURCE" . 8505)
+ ("ROTATED CAPITAL Q" . 8506)
+ ("DOUBLE-STRUCK SMALL GAMMA" . 8509)
+ ("DOUBLE-STRUCK CAPITAL GAMMA" . 8510)
+ ("DOUBLE-STRUCK CAPITAL PI" . 8511)
+ ("DOUBLE-STRUCK N-ARY SUMMATION" . 8512)
+ ("TURNED SANS-SERIF CAPITAL G" . 8513)
+ ("TURNED SANS-SERIF CAPITAL L" . 8514)
+ ("REVERSED SANS-SERIF CAPITAL L" . 8515)
+ ("TURNED SANS-SERIF CAPITAL Y" . 8516)
+ ("DOUBLE-STRUCK ITALIC CAPITAL D" . 8517)
+ ("DOUBLE-STRUCK ITALIC SMALL D" . 8518)
+ ("DOUBLE-STRUCK ITALIC SMALL E" . 8519)
+ ("DOUBLE-STRUCK ITALIC SMALL I" . 8520)
+ ("DOUBLE-STRUCK ITALIC SMALL J" . 8521)
+ ("PROPERTY LINE" . 8522)
+ ("TURNED AMPERSAND" . 8523)
+ ("VULGAR FRACTION ONE THIRD" . 8531)
+ ("VULGAR FRACTION TWO THIRDS" . 8532)
+ ("VULGAR FRACTION ONE FIFTH" . 8533)
+ ("VULGAR FRACTION TWO FIFTHS" . 8534)
+ ("VULGAR FRACTION THREE FIFTHS" . 8535)
+ ("VULGAR FRACTION FOUR FIFTHS" . 8536)
+ ("VULGAR FRACTION ONE SIXTH" . 8537)
+ ("VULGAR FRACTION FIVE SIXTHS" . 8538)
+ ("VULGAR FRACTION ONE EIGHTH" . 8539)
+ ("VULGAR FRACTION THREE EIGHTHS" . 8540)
+ ("VULGAR FRACTION FIVE EIGHTHS" . 8541)
+ ("VULGAR FRACTION SEVEN EIGHTHS" . 8542)
+ ("FRACTION NUMERATOR ONE" . 8543)
+ ("ROMAN NUMERAL ONE" . 8544)
+ ("ROMAN NUMERAL TWO" . 8545)
+ ("ROMAN NUMERAL THREE" . 8546)
+ ("ROMAN NUMERAL FOUR" . 8547)
+ ("ROMAN NUMERAL FIVE" . 8548)
+ ("ROMAN NUMERAL SIX" . 8549)
+ ("ROMAN NUMERAL SEVEN" . 8550)
+ ("ROMAN NUMERAL EIGHT" . 8551)
+ ("ROMAN NUMERAL NINE" . 8552)
+ ("ROMAN NUMERAL TEN" . 8553)
+ ("ROMAN NUMERAL ELEVEN" . 8554)
+ ("ROMAN NUMERAL TWELVE" . 8555)
+ ("ROMAN NUMERAL FIFTY" . 8556)
+ ("ROMAN NUMERAL ONE HUNDRED" . 8557)
+ ("ROMAN NUMERAL FIVE HUNDRED" . 8558)
+ ("ROMAN NUMERAL ONE THOUSAND" . 8559)
+ ("SMALL ROMAN NUMERAL ONE" . 8560)
+ ("SMALL ROMAN NUMERAL TWO" . 8561)
+ ("SMALL ROMAN NUMERAL THREE" . 8562)
+ ("SMALL ROMAN NUMERAL FOUR" . 8563)
+ ("SMALL ROMAN NUMERAL FIVE" . 8564)
+ ("SMALL ROMAN NUMERAL SIX" . 8565)
+ ("SMALL ROMAN NUMERAL SEVEN" . 8566)
+ ("SMALL ROMAN NUMERAL EIGHT" . 8567)
+ ("SMALL ROMAN NUMERAL NINE" . 8568)
+ ("SMALL ROMAN NUMERAL TEN" . 8569)
+ ("SMALL ROMAN NUMERAL ELEVEN" . 8570)
+ ("SMALL ROMAN NUMERAL TWELVE" . 8571)
+ ("SMALL ROMAN NUMERAL FIFTY" . 8572)
+ ("SMALL ROMAN NUMERAL ONE HUNDRED" . 8573)
+ ("SMALL ROMAN NUMERAL FIVE HUNDRED" . 8574)
+ ("SMALL ROMAN NUMERAL ONE THOUSAND" . 8575)
+ ("ROMAN NUMERAL ONE THOUSAND C D" . 8576)
+ ("ROMAN NUMERAL FIVE THOUSAND" . 8577)
+ ("ROMAN NUMERAL TEN THOUSAND" . 8578)
+ ("ROMAN NUMERAL REVERSED ONE HUNDRED" . 8579)
+ ("LEFTWARDS ARROW" . 8592)
+ ("UPWARDS ARROW" . 8593)
+ ("RIGHTWARDS ARROW" . 8594)
+ ("DOWNWARDS ARROW" . 8595)
+ ("LEFT RIGHT ARROW" . 8596)
+ ("UP DOWN ARROW" . 8597)
+ ("NORTH WEST ARROW" . 8598)
+ ("NORTH EAST ARROW" . 8599)
+ ("SOUTH EAST ARROW" . 8600)
+ ("SOUTH WEST ARROW" . 8601)
+ ("LEFTWARDS ARROW WITH STROKE" . 8602)
+ ("RIGHTWARDS ARROW WITH STROKE" . 8603)
+ ("LEFTWARDS WAVE ARROW" . 8604)
+ ("RIGHTWARDS WAVE ARROW" . 8605)
+ ("LEFTWARDS TWO HEADED ARROW" . 8606)
+ ("UPWARDS TWO HEADED ARROW" . 8607)
+ ("RIGHTWARDS TWO HEADED ARROW" . 8608)
+ ("DOWNWARDS TWO HEADED ARROW" . 8609)
+ ("LEFTWARDS ARROW WITH TAIL" . 8610)
+ ("RIGHTWARDS ARROW WITH TAIL" . 8611)
+ ("LEFTWARDS ARROW FROM BAR" . 8612)
+ ("UPWARDS ARROW FROM BAR" . 8613)
+ ("RIGHTWARDS ARROW FROM BAR" . 8614)
+ ("DOWNWARDS ARROW FROM BAR" . 8615)
+ ("UP DOWN ARROW WITH BASE" . 8616)
+ ("LEFTWARDS ARROW WITH HOOK" . 8617)
+ ("RIGHTWARDS ARROW WITH HOOK" . 8618)
+ ("LEFTWARDS ARROW WITH LOOP" . 8619)
+ ("RIGHTWARDS ARROW WITH LOOP" . 8620)
+ ("LEFT RIGHT WAVE ARROW" . 8621)
+ ("LEFT RIGHT ARROW WITH STROKE" . 8622)
+ ("DOWNWARDS ZIGZAG ARROW" . 8623)
+ ("UPWARDS ARROW WITH TIP LEFTWARDS" . 8624)
+ ("UPWARDS ARROW WITH TIP RIGHTWARDS" . 8625)
+ ("DOWNWARDS ARROW WITH TIP LEFTWARDS" . 8626)
+ ("DOWNWARDS ARROW WITH TIP RIGHTWARDS" . 8627)
+ ("RIGHTWARDS ARROW WITH CORNER DOWNWARDS" . 8628)
+ ("DOWNWARDS ARROW WITH CORNER LEFTWARDS" . 8629)
+ ("ANTICLOCKWISE TOP SEMICIRCLE ARROW" . 8630)
+ ("CLOCKWISE TOP SEMICIRCLE ARROW" . 8631)
+ ("NORTH WEST ARROW TO LONG BAR" . 8632)
+ ("LEFTWARDS ARROW TO BAR OVER RIGHTWARDS ARROW TO BAR" . 8633)
+ ("ANTICLOCKWISE OPEN CIRCLE ARROW" . 8634)
+ ("CLOCKWISE OPEN CIRCLE ARROW" . 8635)
+ ("LEFTWARDS HARPOON WITH BARB UPWARDS" . 8636)
+ ("LEFTWARDS HARPOON WITH BARB DOWNWARDS" . 8637)
+ ("UPWARDS HARPOON WITH BARB RIGHTWARDS" . 8638)
+ ("UPWARDS HARPOON WITH BARB LEFTWARDS" . 8639)
+ ("RIGHTWARDS HARPOON WITH BARB UPWARDS" . 8640)
+ ("RIGHTWARDS HARPOON WITH BARB DOWNWARDS" . 8641)
+ ("DOWNWARDS HARPOON WITH BARB RIGHTWARDS" . 8642)
+ ("DOWNWARDS HARPOON WITH BARB LEFTWARDS" . 8643)
+ ("RIGHTWARDS ARROW OVER LEFTWARDS ARROW" . 8644)
+ ("UPWARDS ARROW LEFTWARDS OF DOWNWARDS ARROW" . 8645)
+ ("LEFTWARDS ARROW OVER RIGHTWARDS ARROW" . 8646)
+ ("LEFTWARDS PAIRED ARROWS" . 8647)
+ ("UPWARDS PAIRED ARROWS" . 8648)
+ ("RIGHTWARDS PAIRED ARROWS" . 8649)
+ ("DOWNWARDS PAIRED ARROWS" . 8650)
+ ("LEFTWARDS HARPOON OVER RIGHTWARDS HARPOON" . 8651)
+ ("RIGHTWARDS HARPOON OVER LEFTWARDS HARPOON" . 8652)
+ ("LEFTWARDS DOUBLE ARROW WITH STROKE" . 8653)
+ ("LEFT RIGHT DOUBLE ARROW WITH STROKE" . 8654)
+ ("RIGHTWARDS DOUBLE ARROW WITH STROKE" . 8655)
+ ("LEFTWARDS DOUBLE ARROW" . 8656)
+ ("UPWARDS DOUBLE ARROW" . 8657)
+ ("RIGHTWARDS DOUBLE ARROW" . 8658)
+ ("DOWNWARDS DOUBLE ARROW" . 8659)
+ ("LEFT RIGHT DOUBLE ARROW" . 8660)
+ ("UP DOWN DOUBLE ARROW" . 8661)
+ ("NORTH WEST DOUBLE ARROW" . 8662)
+ ("NORTH EAST DOUBLE ARROW" . 8663)
+ ("SOUTH EAST DOUBLE ARROW" . 8664)
+ ("SOUTH WEST DOUBLE ARROW" . 8665)
+ ("LEFTWARDS TRIPLE ARROW" . 8666)
+ ("RIGHTWARDS TRIPLE ARROW" . 8667)
+ ("LEFTWARDS SQUIGGLE ARROW" . 8668)
+ ("RIGHTWARDS SQUIGGLE ARROW" . 8669)
+ ("UPWARDS ARROW WITH DOUBLE STROKE" . 8670)
+ ("DOWNWARDS ARROW WITH DOUBLE STROKE" . 8671)
+ ("LEFTWARDS DASHED ARROW" . 8672)
+ ("UPWARDS DASHED ARROW" . 8673)
+ ("RIGHTWARDS DASHED ARROW" . 8674)
+ ("DOWNWARDS DASHED ARROW" . 8675)
+ ("LEFTWARDS ARROW TO BAR" . 8676)
+ ("RIGHTWARDS ARROW TO BAR" . 8677)
+ ("LEFTWARDS WHITE ARROW" . 8678)
+ ("UPWARDS WHITE ARROW" . 8679)
+ ("RIGHTWARDS WHITE ARROW" . 8680)
+ ("DOWNWARDS WHITE ARROW" . 8681)
+ ("UPWARDS WHITE ARROW FROM BAR" . 8682)
+ ("UPWARDS WHITE ARROW ON PEDESTAL" . 8683)
+ ("UPWARDS WHITE ARROW ON PEDESTAL WITH HORIZONTAL BAR" . 8684)
+ ("UPWARDS WHITE ARROW ON PEDESTAL WITH VERTICAL BAR" . 8685)
+ ("UPWARDS WHITE DOUBLE ARROW" . 8686)
+ ("UPWARDS WHITE DOUBLE ARROW ON PEDESTAL" . 8687)
+ ("RIGHTWARDS WHITE ARROW FROM WALL" . 8688)
+ ("NORTH WEST ARROW TO CORNER" . 8689)
+ ("SOUTH EAST ARROW TO CORNER" . 8690)
+ ("UP DOWN WHITE ARROW" . 8691)
+ ("RIGHT ARROW WITH SMALL CIRCLE" . 8692)
+ ("DOWNWARDS ARROW LEFTWARDS OF UPWARDS ARROW" . 8693)
+ ("THREE RIGHTWARDS ARROWS" . 8694)
+ ("LEFTWARDS ARROW WITH VERTICAL STROKE" . 8695)
+ ("RIGHTWARDS ARROW WITH VERTICAL STROKE" . 8696)
+ ("LEFT RIGHT ARROW WITH VERTICAL STROKE" . 8697)
+ ("LEFTWARDS ARROW WITH DOUBLE VERTICAL STROKE" . 8698)
+ ("RIGHTWARDS ARROW WITH DOUBLE VERTICAL STROKE" . 8699)
+ ("LEFT RIGHT ARROW WITH DOUBLE VERTICAL STROKE" . 8700)
+ ("LEFTWARDS OPEN-HEADED ARROW" . 8701)
+ ("RIGHTWARDS OPEN-HEADED ARROW" . 8702)
+ ("LEFT RIGHT OPEN-HEADED ARROW" . 8703)
+ ("FOR ALL" . 8704)
+ ("COMPLEMENT" . 8705)
+ ("PARTIAL DIFFERENTIAL" . 8706)
+ ("THERE EXISTS" . 8707)
+ ("THERE DOES NOT EXIST" . 8708)
+ ("EMPTY SET" . 8709)
+ ("INCREMENT" . 8710)
+ ("NABLA" . 8711)
+ ("ELEMENT OF" . 8712)
+ ("NOT AN ELEMENT OF" . 8713)
+ ("SMALL ELEMENT OF" . 8714)
+ ("CONTAINS AS MEMBER" . 8715)
+ ("DOES NOT CONTAIN AS MEMBER" . 8716)
+ ("SMALL CONTAINS AS MEMBER" . 8717)
+ ("END OF PROOF" . 8718)
+ ("N-ARY PRODUCT" . 8719)
+ ("N-ARY COPRODUCT" . 8720)
+ ("N-ARY SUMMATION" . 8721)
+ ("MINUS SIGN" . 8722)
+ ("MINUS-OR-PLUS SIGN" . 8723)
+ ("DOT PLUS" . 8724)
+ ("DIVISION SLASH" . 8725)
+ ("SET MINUS" . 8726)
+ ("ASTERISK OPERATOR" . 8727)
+ ("RING OPERATOR" . 8728)
+ ("BULLET OPERATOR" . 8729)
+ ("SQUARE ROOT" . 8730)
+ ("CUBE ROOT" . 8731)
+ ("FOURTH ROOT" . 8732)
+ ("PROPORTIONAL TO" . 8733)
+ ("INFINITY" . 8734)
+ ("RIGHT ANGLE" . 8735)
+ ("ANGLE" . 8736)
+ ("MEASURED ANGLE" . 8737)
+ ("SPHERICAL ANGLE" . 8738)
+ ("DIVIDES" . 8739)
+ ("DOES NOT DIVIDE" . 8740)
+ ("PARALLEL TO" . 8741)
+ ("NOT PARALLEL TO" . 8742)
+ ("LOGICAL AND" . 8743)
+ ("LOGICAL OR" . 8744)
+ ("INTERSECTION" . 8745)
+ ("UNION" . 8746)
+ ("INTEGRAL" . 8747)
+ ("DOUBLE INTEGRAL" . 8748)
+ ("TRIPLE INTEGRAL" . 8749)
+ ("CONTOUR INTEGRAL" . 8750)
+ ("SURFACE INTEGRAL" . 8751)
+ ("VOLUME INTEGRAL" . 8752)
+ ("CLOCKWISE INTEGRAL" . 8753)
+ ("CLOCKWISE CONTOUR INTEGRAL" . 8754)
+ ("ANTICLOCKWISE CONTOUR INTEGRAL" . 8755)
+ ("THEREFORE" . 8756)
+ ("BECAUSE" . 8757)
+ ("RATIO" . 8758)
+ ("PROPORTION" . 8759)
+ ("DOT MINUS" . 8760)
+ ("EXCESS" . 8761)
+ ("GEOMETRIC PROPORTION" . 8762)
+ ("HOMOTHETIC" . 8763)
+ ("TILDE OPERATOR" . 8764)
+ ("REVERSED TILDE" . 8765)
+ ("INVERTED LAZY S" . 8766)
+ ("SINE WAVE" . 8767)
+ ("WREATH PRODUCT" . 8768)
+ ("NOT TILDE" . 8769)
+ ("MINUS TILDE" . 8770)
+ ("ASYMPTOTICALLY EQUAL TO" . 8771)
+ ("NOT ASYMPTOTICALLY EQUAL TO" . 8772)
+ ("APPROXIMATELY EQUAL TO" . 8773)
+ ("APPROXIMATELY BUT NOT ACTUALLY EQUAL TO" . 8774)
+ ("NEITHER APPROXIMATELY NOR ACTUALLY EQUAL TO" . 8775)
+ ("ALMOST EQUAL TO" . 8776)
+ ("NOT ALMOST EQUAL TO" . 8777)
+ ("ALMOST EQUAL OR EQUAL TO" . 8778)
+ ("TRIPLE TILDE" . 8779)
+ ("ALL EQUAL TO" . 8780)
+ ("EQUIVALENT TO" . 8781)
+ ("GEOMETRICALLY EQUIVALENT TO" . 8782)
+ ("DIFFERENCE BETWEEN" . 8783)
+ ("APPROACHES THE LIMIT" . 8784)
+ ("GEOMETRICALLY EQUAL TO" . 8785)
+ ("APPROXIMATELY EQUAL TO OR THE IMAGE OF" . 8786)
+ ("IMAGE OF OR APPROXIMATELY EQUAL TO" . 8787)
+ ("COLON EQUALS" . 8788)
+ ("EQUALS COLON" . 8789)
+ ("RING IN EQUAL TO" . 8790)
+ ("RING EQUAL TO" . 8791)
+ ("CORRESPONDS TO" . 8792)
+ ("ESTIMATES" . 8793)
+ ("EQUIANGULAR TO" . 8794)
+ ("STAR EQUALS" . 8795)
+ ("DELTA EQUAL TO" . 8796)
+ ("EQUAL TO BY DEFINITION" . 8797)
+ ("MEASURED BY" . 8798)
+ ("QUESTIONED EQUAL TO" . 8799)
+ ("NOT EQUAL TO" . 8800)
+ ("IDENTICAL TO" . 8801)
+ ("NOT IDENTICAL TO" . 8802)
+ ("STRICTLY EQUIVALENT TO" . 8803)
+ ("LESS-THAN OR EQUAL TO" . 8804)
+ ("GREATER-THAN OR EQUAL TO" . 8805)
+ ("LESS-THAN OVER EQUAL TO" . 8806)
+ ("GREATER-THAN OVER EQUAL TO" . 8807)
+ ("LESS-THAN BUT NOT EQUAL TO" . 8808)
+ ("GREATER-THAN BUT NOT EQUAL TO" . 8809)
+ ("MUCH LESS-THAN" . 8810)
+ ("MUCH GREATER-THAN" . 8811)
+ ("BETWEEN" . 8812)
+ ("NOT EQUIVALENT TO" . 8813)
+ ("NOT LESS-THAN" . 8814)
+ ("NOT GREATER-THAN" . 8815)
+ ("NEITHER LESS-THAN NOR EQUAL TO" . 8816)
+ ("NEITHER GREATER-THAN NOR EQUAL TO" . 8817)
+ ("LESS-THAN OR EQUIVALENT TO" . 8818)
+ ("GREATER-THAN OR EQUIVALENT TO" . 8819)
+ ("NEITHER LESS-THAN NOR EQUIVALENT TO" . 8820)
+ ("NEITHER GREATER-THAN NOR EQUIVALENT TO" . 8821)
+ ("LESS-THAN OR GREATER-THAN" . 8822)
+ ("GREATER-THAN OR LESS-THAN" . 8823)
+ ("NEITHER LESS-THAN NOR GREATER-THAN" . 8824)
+ ("NEITHER GREATER-THAN NOR LESS-THAN" . 8825)
+ ("PRECEDES" . 8826)
+ ("SUCCEEDS" . 8827)
+ ("PRECEDES OR EQUAL TO" . 8828)
+ ("SUCCEEDS OR EQUAL TO" . 8829)
+ ("PRECEDES OR EQUIVALENT TO" . 8830)
+ ("SUCCEEDS OR EQUIVALENT TO" . 8831)
+ ("DOES NOT PRECEDE" . 8832)
+ ("DOES NOT SUCCEED" . 8833)
+ ("SUBSET OF" . 8834)
+ ("SUPERSET OF" . 8835)
+ ("NOT A SUBSET OF" . 8836)
+ ("NOT A SUPERSET OF" . 8837)
+ ("SUBSET OF OR EQUAL TO" . 8838)
+ ("SUPERSET OF OR EQUAL TO" . 8839)
+ ("NEITHER A SUBSET OF NOR EQUAL TO" . 8840)
+ ("NEITHER A SUPERSET OF NOR EQUAL TO" . 8841)
+ ("SUBSET OF WITH NOT EQUAL TO" . 8842)
+ ("SUPERSET OF WITH NOT EQUAL TO" . 8843)
+ ("MULTISET" . 8844)
+ ("MULTISET MULTIPLICATION" . 8845)
+ ("MULTISET UNION" . 8846)
+ ("SQUARE IMAGE OF" . 8847)
+ ("SQUARE ORIGINAL OF" . 8848)
+ ("SQUARE IMAGE OF OR EQUAL TO" . 8849)
+ ("SQUARE ORIGINAL OF OR EQUAL TO" . 8850)
+ ("SQUARE CAP" . 8851)
+ ("SQUARE CUP" . 8852)
+ ("CIRCLED PLUS" . 8853)
+ ("CIRCLED MINUS" . 8854)
+ ("CIRCLED TIMES" . 8855)
+ ("CIRCLED DIVISION SLASH" . 8856)
+ ("CIRCLED DOT OPERATOR" . 8857)
+ ("CIRCLED RING OPERATOR" . 8858)
+ ("CIRCLED ASTERISK OPERATOR" . 8859)
+ ("CIRCLED EQUALS" . 8860)
+ ("CIRCLED DASH" . 8861)
+ ("SQUARED PLUS" . 8862)
+ ("SQUARED MINUS" . 8863)
+ ("SQUARED TIMES" . 8864)
+ ("SQUARED DOT OPERATOR" . 8865)
+ ("RIGHT TACK" . 8866)
+ ("LEFT TACK" . 8867)
+ ("DOWN TACK" . 8868)
+ ("UP TACK" . 8869)
+ ("ASSERTION" . 8870)
+ ("MODELS" . 8871)
+ ("TRUE" . 8872)
+ ("FORCES" . 8873)
+ ("TRIPLE VERTICAL BAR RIGHT TURNSTILE" . 8874)
+ ("DOUBLE VERTICAL BAR DOUBLE RIGHT TURNSTILE" . 8875)
+ ("DOES NOT PROVE" . 8876)
+ ("NOT TRUE" . 8877)
+ ("DOES NOT FORCE" . 8878)
+ ("NEGATED DOUBLE VERTICAL BAR DOUBLE RIGHT TURNSTILE" . 8879)
+ ("PRECEDES UNDER RELATION" . 8880)
+ ("SUCCEEDS UNDER RELATION" . 8881)
+ ("NORMAL SUBGROUP OF" . 8882)
+ ("CONTAINS AS NORMAL SUBGROUP" . 8883)
+ ("NORMAL SUBGROUP OF OR EQUAL TO" . 8884)
+ ("CONTAINS AS NORMAL SUBGROUP OR EQUAL TO" . 8885)
+ ("ORIGINAL OF" . 8886)
+ ("IMAGE OF" . 8887)
+ ("MULTIMAP" . 8888)
+ ("HERMITIAN CONJUGATE MATRIX" . 8889)
+ ("INTERCALATE" . 8890)
+ ("XOR" . 8891)
+ ("NAND" . 8892)
+ ("NOR" . 8893)
+ ("RIGHT ANGLE WITH ARC" . 8894)
+ ("RIGHT TRIANGLE" . 8895)
+ ("N-ARY LOGICAL AND" . 8896)
+ ("N-ARY LOGICAL OR" . 8897)
+ ("N-ARY INTERSECTION" . 8898)
+ ("N-ARY UNION" . 8899)
+ ("DIAMOND OPERATOR" . 8900)
+ ("DOT OPERATOR" . 8901)
+ ("STAR OPERATOR" . 8902)
+ ("DIVISION TIMES" . 8903)
+ ("BOWTIE" . 8904)
+ ("LEFT NORMAL FACTOR SEMIDIRECT PRODUCT" . 8905)
+ ("RIGHT NORMAL FACTOR SEMIDIRECT PRODUCT" . 8906)
+ ("LEFT SEMIDIRECT PRODUCT" . 8907)
+ ("RIGHT SEMIDIRECT PRODUCT" . 8908)
+ ("REVERSED TILDE EQUALS" . 8909)
+ ("CURLY LOGICAL OR" . 8910)
+ ("CURLY LOGICAL AND" . 8911)
+ ("DOUBLE SUBSET" . 8912)
+ ("DOUBLE SUPERSET" . 8913)
+ ("DOUBLE INTERSECTION" . 8914)
+ ("DOUBLE UNION" . 8915)
+ ("PITCHFORK" . 8916)
+ ("EQUAL AND PARALLEL TO" . 8917)
+ ("LESS-THAN WITH DOT" . 8918)
+ ("GREATER-THAN WITH DOT" . 8919)
+ ("VERY MUCH LESS-THAN" . 8920)
+ ("VERY MUCH GREATER-THAN" . 8921)
+ ("LESS-THAN EQUAL TO OR GREATER-THAN" . 8922)
+ ("GREATER-THAN EQUAL TO OR LESS-THAN" . 8923)
+ ("EQUAL TO OR LESS-THAN" . 8924)
+ ("EQUAL TO OR GREATER-THAN" . 8925)
+ ("EQUAL TO OR PRECEDES" . 8926)
+ ("EQUAL TO OR SUCCEEDS" . 8927)
+ ("DOES NOT PRECEDE OR EQUAL" . 8928)
+ ("DOES NOT SUCCEED OR EQUAL" . 8929)
+ ("NOT SQUARE IMAGE OF OR EQUAL TO" . 8930)
+ ("NOT SQUARE ORIGINAL OF OR EQUAL TO" . 8931)
+ ("SQUARE IMAGE OF OR NOT EQUAL TO" . 8932)
+ ("SQUARE ORIGINAL OF OR NOT EQUAL TO" . 8933)
+ ("LESS-THAN BUT NOT EQUIVALENT TO" . 8934)
+ ("GREATER-THAN BUT NOT EQUIVALENT TO" . 8935)
+ ("PRECEDES BUT NOT EQUIVALENT TO" . 8936)
+ ("SUCCEEDS BUT NOT EQUIVALENT TO" . 8937)
+ ("NOT NORMAL SUBGROUP OF" . 8938)
+ ("DOES NOT CONTAIN AS NORMAL SUBGROUP" . 8939)
+ ("NOT NORMAL SUBGROUP OF OR EQUAL TO" . 8940)
+ ("DOES NOT CONTAIN AS NORMAL SUBGROUP OR EQUAL" . 8941)
+ ("VERTICAL ELLIPSIS" . 8942)
+ ("MIDLINE HORIZONTAL ELLIPSIS" . 8943)
+ ("UP RIGHT DIAGONAL ELLIPSIS" . 8944)
+ ("DOWN RIGHT DIAGONAL ELLIPSIS" . 8945)
+ ("ELEMENT OF WITH LONG HORIZONTAL STROKE" . 8946)
+ ("ELEMENT OF WITH VERTICAL BAR AT END OF HORIZONTAL STROKE" . 8947)
+ ("SMALL ELEMENT OF WITH VERTICAL BAR AT END OF HORIZONTAL STROKE" . 8948)
+ ("ELEMENT OF WITH DOT ABOVE" . 8949)
+ ("ELEMENT OF WITH OVERBAR" . 8950)
+ ("SMALL ELEMENT OF WITH OVERBAR" . 8951)
+ ("ELEMENT OF WITH UNDERBAR" . 8952)
+ ("ELEMENT OF WITH TWO HORIZONTAL STROKES" . 8953)
+ ("CONTAINS WITH LONG HORIZONTAL STROKE" . 8954)
+ ("CONTAINS WITH VERTICAL BAR AT END OF HORIZONTAL STROKE" . 8955)
+ ("SMALL CONTAINS WITH VERTICAL BAR AT END OF HORIZONTAL STROKE" . 8956)
+ ("CONTAINS WITH OVERBAR" . 8957)
+ ("SMALL CONTAINS WITH OVERBAR" . 8958)
+ ("Z NOTATION BAG MEMBERSHIP" . 8959)
+ ("DIAMETER SIGN" . 8960)
+ ("ELECTRIC ARROW" . 8961)
+ ("HOUSE" . 8962)
+ ("UP ARROWHEAD" . 8963)
+ ("DOWN ARROWHEAD" . 8964)
+ ("PROJECTIVE" . 8965)
+ ("PERSPECTIVE" . 8966)
+ ("WAVY LINE" . 8967)
+ ("LEFT CEILING" . 8968)
+ ("RIGHT CEILING" . 8969)
+ ("LEFT FLOOR" . 8970)
+ ("RIGHT FLOOR" . 8971)
+ ("BOTTOM RIGHT CROP" . 8972)
+ ("BOTTOM LEFT CROP" . 8973)
+ ("TOP RIGHT CROP" . 8974)
+ ("TOP LEFT CROP" . 8975)
+ ("REVERSED NOT SIGN" . 8976)
+ ("SQUARE LOZENGE" . 8977)
+ ("ARC" . 8978)
+ ("SEGMENT" . 8979)
+ ("SECTOR" . 8980)
+ ("TELEPHONE RECORDER" . 8981)
+ ("POSITION INDICATOR" . 8982)
+ ("VIEWDATA SQUARE" . 8983)
+ ("PLACE OF INTEREST SIGN" . 8984)
+ ("TURNED NOT SIGN" . 8985)
+ ("WATCH" . 8986)
+ ("HOURGLASS" . 8987)
+ ("TOP LEFT CORNER" . 8988)
+ ("TOP RIGHT CORNER" . 8989)
+ ("BOTTOM LEFT CORNER" . 8990)
+ ("BOTTOM RIGHT CORNER" . 8991)
+ ("TOP HALF INTEGRAL" . 8992)
+ ("BOTTOM HALF INTEGRAL" . 8993)
+ ("FROWN" . 8994)
+ ("SMILE" . 8995)
+ ("UP ARROWHEAD BETWEEN TWO HORIZONTAL BARS" . 8996)
+ ("OPTION KEY" . 8997)
+ ("ERASE TO THE RIGHT" . 8998)
+ ("X IN A RECTANGLE BOX" . 8999)
+ ("KEYBOARD" . 9000)
+ ("LEFT-POINTING ANGLE BRACKET" . 9001)
+ ("RIGHT-POINTING ANGLE BRACKET" . 9002)
+ ("ERASE TO THE LEFT" . 9003)
+ ("BENZENE RING" . 9004)
+ ("CYLINDRICITY" . 9005)
+ ("ALL AROUND-PROFILE" . 9006)
+ ("SYMMETRY" . 9007)
+ ("TOTAL RUNOUT" . 9008)
+ ("DIMENSION ORIGIN" . 9009)
+ ("CONICAL TAPER" . 9010)
+ ("SLOPE" . 9011)
+ ("COUNTERBORE" . 9012)
+ ("COUNTERSINK" . 9013)
+ ("APL FUNCTIONAL SYMBOL I-BEAM" . 9014)
+ ("APL FUNCTIONAL SYMBOL SQUISH QUAD" . 9015)
+ ("APL FUNCTIONAL SYMBOL QUAD EQUAL" . 9016)
+ ("APL FUNCTIONAL SYMBOL QUAD DIVIDE" . 9017)
+ ("APL FUNCTIONAL SYMBOL QUAD DIAMOND" . 9018)
+ ("APL FUNCTIONAL SYMBOL QUAD JOT" . 9019)
+ ("APL FUNCTIONAL SYMBOL QUAD CIRCLE" . 9020)
+ ("APL FUNCTIONAL SYMBOL CIRCLE STILE" . 9021)
+ ("APL FUNCTIONAL SYMBOL CIRCLE JOT" . 9022)
+ ("APL FUNCTIONAL SYMBOL SLASH BAR" . 9023)
+ ("APL FUNCTIONAL SYMBOL BACKSLASH BAR" . 9024)
+ ("APL FUNCTIONAL SYMBOL QUAD SLASH" . 9025)
+ ("APL FUNCTIONAL SYMBOL QUAD BACKSLASH" . 9026)
+ ("APL FUNCTIONAL SYMBOL QUAD LESS-THAN" . 9027)
+ ("APL FUNCTIONAL SYMBOL QUAD GREATER-THAN" . 9028)
+ ("APL FUNCTIONAL SYMBOL LEFTWARDS VANE" . 9029)
+ ("APL FUNCTIONAL SYMBOL RIGHTWARDS VANE" . 9030)
+ ("APL FUNCTIONAL SYMBOL QUAD LEFTWARDS ARROW" . 9031)
+ ("APL FUNCTIONAL SYMBOL QUAD RIGHTWARDS ARROW" . 9032)
+ ("APL FUNCTIONAL SYMBOL CIRCLE BACKSLASH" . 9033)
+ ("APL FUNCTIONAL SYMBOL DOWN TACK UNDERBAR" . 9034)
+ ("APL FUNCTIONAL SYMBOL DELTA STILE" . 9035)
+ ("APL FUNCTIONAL SYMBOL QUAD DOWN CARET" . 9036)
+ ("APL FUNCTIONAL SYMBOL QUAD DELTA" . 9037)
+ ("APL FUNCTIONAL SYMBOL DOWN TACK JOT" . 9038)
+ ("APL FUNCTIONAL SYMBOL UPWARDS VANE" . 9039)
+ ("APL FUNCTIONAL SYMBOL QUAD UPWARDS ARROW" . 9040)
+ ("APL FUNCTIONAL SYMBOL UP TACK OVERBAR" . 9041)
+ ("APL FUNCTIONAL SYMBOL DEL STILE" . 9042)
+ ("APL FUNCTIONAL SYMBOL QUAD UP CARET" . 9043)
+ ("APL FUNCTIONAL SYMBOL QUAD DEL" . 9044)
+ ("APL FUNCTIONAL SYMBOL UP TACK JOT" . 9045)
+ ("APL FUNCTIONAL SYMBOL DOWNWARDS VANE" . 9046)
+ ("APL FUNCTIONAL SYMBOL QUAD DOWNWARDS ARROW" . 9047)
+ ("APL FUNCTIONAL SYMBOL QUOTE UNDERBAR" . 9048)
+ ("APL FUNCTIONAL SYMBOL DELTA UNDERBAR" . 9049)
+ ("APL FUNCTIONAL SYMBOL DIAMOND UNDERBAR" . 9050)
+ ("APL FUNCTIONAL SYMBOL JOT UNDERBAR" . 9051)
+ ("APL FUNCTIONAL SYMBOL CIRCLE UNDERBAR" . 9052)
+ ("APL FUNCTIONAL SYMBOL UP SHOE JOT" . 9053)
+ ("APL FUNCTIONAL SYMBOL QUOTE QUAD" . 9054)
+ ("APL FUNCTIONAL SYMBOL CIRCLE STAR" . 9055)
+ ("APL FUNCTIONAL SYMBOL QUAD COLON" . 9056)
+ ("APL FUNCTIONAL SYMBOL UP TACK DIAERESIS" . 9057)
+ ("APL FUNCTIONAL SYMBOL DEL DIAERESIS" . 9058)
+ ("APL FUNCTIONAL SYMBOL STAR DIAERESIS" . 9059)
+ ("APL FUNCTIONAL SYMBOL JOT DIAERESIS" . 9060)
+ ("APL FUNCTIONAL SYMBOL CIRCLE DIAERESIS" . 9061)
+ ("APL FUNCTIONAL SYMBOL DOWN SHOE STILE" . 9062)
+ ("APL FUNCTIONAL SYMBOL LEFT SHOE STILE" . 9063)
+ ("APL FUNCTIONAL SYMBOL TILDE DIAERESIS" . 9064)
+ ("APL FUNCTIONAL SYMBOL GREATER-THAN DIAERESIS" . 9065)
+ ("APL FUNCTIONAL SYMBOL COMMA BAR" . 9066)
+ ("APL FUNCTIONAL SYMBOL DEL TILDE" . 9067)
+ ("APL FUNCTIONAL SYMBOL ZILDE" . 9068)
+ ("APL FUNCTIONAL SYMBOL STILE TILDE" . 9069)
+ ("APL FUNCTIONAL SYMBOL SEMICOLON UNDERBAR" . 9070)
+ ("APL FUNCTIONAL SYMBOL QUAD NOT EQUAL" . 9071)
+ ("APL FUNCTIONAL SYMBOL QUAD QUESTION" . 9072)
+ ("APL FUNCTIONAL SYMBOL DOWN CARET TILDE" . 9073)
+ ("APL FUNCTIONAL SYMBOL UP CARET TILDE" . 9074)
+ ("APL FUNCTIONAL SYMBOL IOTA" . 9075)
+ ("APL FUNCTIONAL SYMBOL RHO" . 9076)
+ ("APL FUNCTIONAL SYMBOL OMEGA" . 9077)
+ ("APL FUNCTIONAL SYMBOL ALPHA UNDERBAR" . 9078)
+ ("APL FUNCTIONAL SYMBOL EPSILON UNDERBAR" . 9079)
+ ("APL FUNCTIONAL SYMBOL IOTA UNDERBAR" . 9080)
+ ("APL FUNCTIONAL SYMBOL OMEGA UNDERBAR" . 9081)
+ ("APL FUNCTIONAL SYMBOL ALPHA" . 9082)
+ ("NOT CHECK MARK" . 9083)
+ ("RIGHT ANGLE WITH DOWNWARDS ZIGZAG ARROW" . 9084)
+ ("SHOULDERED OPEN BOX" . 9085)
+ ("BELL SYMBOL" . 9086)
+ ("VERTICAL LINE WITH MIDDLE DOT" . 9087)
+ ("INSERTION SYMBOL" . 9088)
+ ("CONTINUOUS UNDERLINE SYMBOL" . 9089)
+ ("DISCONTINUOUS UNDERLINE SYMBOL" . 9090)
+ ("EMPHASIS SYMBOL" . 9091)
+ ("COMPOSITION SYMBOL" . 9092)
+ ("WHITE SQUARE WITH CENTRE VERTICAL LINE" . 9093)
+ ("ENTER SYMBOL" . 9094)
+ ("ALTERNATIVE KEY SYMBOL" . 9095)
+ ("HELM SYMBOL" . 9096)
+ ("CIRCLED HORIZONTAL BAR WITH NOTCH" . 9097)
+ ("CIRCLED TRIANGLE DOWN" . 9098)
+ ("BROKEN CIRCLE WITH NORTHWEST ARROW" . 9099)
+ ("UNDO SYMBOL" . 9100)
+ ("MONOSTABLE SYMBOL" . 9101)
+ ("HYSTERESIS SYMBOL" . 9102)
+ ("OPEN-CIRCUIT-OUTPUT H-TYPE SYMBOL" . 9103)
+ ("OPEN-CIRCUIT-OUTPUT L-TYPE SYMBOL" . 9104)
+ ("PASSIVE-PULL-DOWN-OUTPUT SYMBOL" . 9105)
+ ("PASSIVE-PULL-UP-OUTPUT SYMBOL" . 9106)
+ ("DIRECT CURRENT SYMBOL FORM TWO" . 9107)
+ ("SOFTWARE-FUNCTION SYMBOL" . 9108)
+ ("APL FUNCTIONAL SYMBOL QUAD" . 9109)
+ ("DECIMAL SEPARATOR KEY SYMBOL" . 9110)
+ ("PREVIOUS PAGE" . 9111)
+ ("NEXT PAGE" . 9112)
+ ("PRINT SCREEN SYMBOL" . 9113)
+ ("CLEAR SCREEN SYMBOL" . 9114)
+ ("LEFT PARENTHESIS UPPER HOOK" . 9115)
+ ("LEFT PARENTHESIS EXTENSION" . 9116)
+ ("LEFT PARENTHESIS LOWER HOOK" . 9117)
+ ("RIGHT PARENTHESIS UPPER HOOK" . 9118)
+ ("RIGHT PARENTHESIS EXTENSION" . 9119)
+ ("RIGHT PARENTHESIS LOWER HOOK" . 9120)
+ ("LEFT SQUARE BRACKET UPPER CORNER" . 9121)
+ ("LEFT SQUARE BRACKET EXTENSION" . 9122)
+ ("LEFT SQUARE BRACKET LOWER CORNER" . 9123)
+ ("RIGHT SQUARE BRACKET UPPER CORNER" . 9124)
+ ("RIGHT SQUARE BRACKET EXTENSION" . 9125)
+ ("RIGHT SQUARE BRACKET LOWER CORNER" . 9126)
+ ("LEFT CURLY BRACKET UPPER HOOK" . 9127)
+ ("LEFT CURLY BRACKET MIDDLE PIECE" . 9128)
+ ("LEFT CURLY BRACKET LOWER HOOK" . 9129)
+ ("CURLY BRACKET EXTENSION" . 9130)
+ ("RIGHT CURLY BRACKET UPPER HOOK" . 9131)
+ ("RIGHT CURLY BRACKET MIDDLE PIECE" . 9132)
+ ("RIGHT CURLY BRACKET LOWER HOOK" . 9133)
+ ("INTEGRAL EXTENSION" . 9134)
+ ("HORIZONTAL LINE EXTENSION" . 9135)
+ ("UPPER LEFT OR LOWER RIGHT CURLY BRACKET SECTION" . 9136)
+ ("UPPER RIGHT OR LOWER LEFT CURLY BRACKET SECTION" . 9137)
+ ("SUMMATION TOP" . 9138)
+ ("SUMMATION BOTTOM" . 9139)
+ ("TOP SQUARE BRACKET" . 9140)
+ ("BOTTOM SQUARE BRACKET" . 9141)
+ ("BOTTOM SQUARE BRACKET OVER TOP SQUARE BRACKET" . 9142)
+ ("RADICAL SYMBOL BOTTOM" . 9143)
+ ("LEFT VERTICAL BOX LINE" . 9144)
+ ("RIGHT VERTICAL BOX LINE" . 9145)
+ ("HORIZONTAL SCAN LINE-1" . 9146)
+ ("HORIZONTAL SCAN LINE-3" . 9147)
+ ("HORIZONTAL SCAN LINE-7" . 9148)
+ ("HORIZONTAL SCAN LINE-9" . 9149)
+ ("DENTISTRY SYMBOL LIGHT VERTICAL AND TOP RIGHT" . 9150)
+ ("DENTISTRY SYMBOL LIGHT VERTICAL AND BOTTOM RIGHT" . 9151)
+ ("DENTISTRY SYMBOL LIGHT VERTICAL WITH CIRCLE" . 9152)
+ ("DENTISTRY SYMBOL LIGHT DOWN AND HORIZONTAL WITH CIRCLE" . 9153)
+ ("DENTISTRY SYMBOL LIGHT UP AND HORIZONTAL WITH CIRCLE" . 9154)
+ ("DENTISTRY SYMBOL LIGHT VERTICAL WITH TRIANGLE" . 9155)
+ ("DENTISTRY SYMBOL LIGHT DOWN AND HORIZONTAL WITH TRIANGLE" . 9156)
+ ("DENTISTRY SYMBOL LIGHT UP AND HORIZONTAL WITH TRIANGLE" . 9157)
+ ("DENTISTRY SYMBOL LIGHT VERTICAL AND WAVE" . 9158)
+ ("DENTISTRY SYMBOL LIGHT DOWN AND HORIZONTAL WITH WAVE" . 9159)
+ ("DENTISTRY SYMBOL LIGHT UP AND HORIZONTAL WITH WAVE" . 9160)
+ ("DENTISTRY SYMBOL LIGHT DOWN AND HORIZONTAL" . 9161)
+ ("DENTISTRY SYMBOL LIGHT UP AND HORIZONTAL" . 9162)
+ ("DENTISTRY SYMBOL LIGHT VERTICAL AND TOP LEFT" . 9163)
+ ("DENTISTRY SYMBOL LIGHT VERTICAL AND BOTTOM LEFT" . 9164)
+ ("SQUARE FOOT" . 9165)
+ ("RETURN SYMBOL" . 9166)
+ ("SYMBOL FOR NULL" . 9216)
+ ("SYMBOL FOR START OF HEADING" . 9217)
+ ("SYMBOL FOR START OF TEXT" . 9218)
+ ("SYMBOL FOR END OF TEXT" . 9219)
+ ("SYMBOL FOR END OF TRANSMISSION" . 9220)
+ ("SYMBOL FOR ENQUIRY" . 9221)
+ ("SYMBOL FOR ACKNOWLEDGE" . 9222)
+ ("SYMBOL FOR BELL" . 9223)
+ ("SYMBOL FOR BACKSPACE" . 9224)
+ ("SYMBOL FOR HORIZONTAL TABULATION" . 9225)
+ ("SYMBOL FOR LINE FEED" . 9226)
+ ("SYMBOL FOR VERTICAL TABULATION" . 9227)
+ ("SYMBOL FOR FORM FEED" . 9228)
+ ("SYMBOL FOR CARRIAGE RETURN" . 9229)
+ ("SYMBOL FOR SHIFT OUT" . 9230)
+ ("SYMBOL FOR SHIFT IN" . 9231)
+ ("SYMBOL FOR DATA LINK ESCAPE" . 9232)
+ ("SYMBOL FOR DEVICE CONTROL ONE" . 9233)
+ ("SYMBOL FOR DEVICE CONTROL TWO" . 9234)
+ ("SYMBOL FOR DEVICE CONTROL THREE" . 9235)
+ ("SYMBOL FOR DEVICE CONTROL FOUR" . 9236)
+ ("SYMBOL FOR NEGATIVE ACKNOWLEDGE" . 9237)
+ ("SYMBOL FOR SYNCHRONOUS IDLE" . 9238)
+ ("SYMBOL FOR END OF TRANSMISSION BLOCK" . 9239)
+ ("SYMBOL FOR CANCEL" . 9240)
+ ("SYMBOL FOR END OF MEDIUM" . 9241)
+ ("SYMBOL FOR SUBSTITUTE" . 9242)
+ ("SYMBOL FOR ESCAPE" . 9243)
+ ("SYMBOL FOR FILE SEPARATOR" . 9244)
+ ("SYMBOL FOR GROUP SEPARATOR" . 9245)
+ ("SYMBOL FOR RECORD SEPARATOR" . 9246)
+ ("SYMBOL FOR UNIT SEPARATOR" . 9247)
+ ("SYMBOL FOR SPACE" . 9248)
+ ("SYMBOL FOR DELETE" . 9249)
+ ("BLANK SYMBOL" . 9250)
+ ("OPEN BOX" . 9251)
+ ("SYMBOL FOR NEWLINE" . 9252)
+ ("SYMBOL FOR DELETE FORM TWO" . 9253)
+ ("SYMBOL FOR SUBSTITUTE FORM TWO" . 9254)
+ ("OCR HOOK" . 9280)
+ ("OCR CHAIR" . 9281)
+ ("OCR FORK" . 9282)
+ ("OCR INVERTED FORK" . 9283)
+ ("OCR BELT BUCKLE" . 9284)
+ ("OCR BOW TIE" . 9285)
+ ("OCR BRANCH BANK IDENTIFICATION" . 9286)
+ ("OCR AMOUNT OF CHECK" . 9287)
+ ("OCR DASH" . 9288)
+ ("OCR CUSTOMER ACCOUNT NUMBER" . 9289)
+ ("OCR DOUBLE BACKSLASH" . 9290)
+ ("CIRCLED DIGIT ONE" . 9312)
+ ("CIRCLED DIGIT TWO" . 9313)
+ ("CIRCLED DIGIT THREE" . 9314)
+ ("CIRCLED DIGIT FOUR" . 9315)
+ ("CIRCLED DIGIT FIVE" . 9316)
+ ("CIRCLED DIGIT SIX" . 9317)
+ ("CIRCLED DIGIT SEVEN" . 9318)
+ ("CIRCLED DIGIT EIGHT" . 9319)
+ ("CIRCLED DIGIT NINE" . 9320)
+ ("CIRCLED NUMBER TEN" . 9321)
+ ("CIRCLED NUMBER ELEVEN" . 9322)
+ ("CIRCLED NUMBER TWELVE" . 9323)
+ ("CIRCLED NUMBER THIRTEEN" . 9324)
+ ("CIRCLED NUMBER FOURTEEN" . 9325)
+ ("CIRCLED NUMBER FIFTEEN" . 9326)
+ ("CIRCLED NUMBER SIXTEEN" . 9327)
+ ("CIRCLED NUMBER SEVENTEEN" . 9328)
+ ("CIRCLED NUMBER EIGHTEEN" . 9329)
+ ("CIRCLED NUMBER NINETEEN" . 9330)
+ ("CIRCLED NUMBER TWENTY" . 9331)
+ ("PARENTHESIZED DIGIT ONE" . 9332)
+ ("PARENTHESIZED DIGIT TWO" . 9333)
+ ("PARENTHESIZED DIGIT THREE" . 9334)
+ ("PARENTHESIZED DIGIT FOUR" . 9335)
+ ("PARENTHESIZED DIGIT FIVE" . 9336)
+ ("PARENTHESIZED DIGIT SIX" . 9337)
+ ("PARENTHESIZED DIGIT SEVEN" . 9338)
+ ("PARENTHESIZED DIGIT EIGHT" . 9339)
+ ("PARENTHESIZED DIGIT NINE" . 9340)
+ ("PARENTHESIZED NUMBER TEN" . 9341)
+ ("PARENTHESIZED NUMBER ELEVEN" . 9342)
+ ("PARENTHESIZED NUMBER TWELVE" . 9343)
+ ("PARENTHESIZED NUMBER THIRTEEN" . 9344)
+ ("PARENTHESIZED NUMBER FOURTEEN" . 9345)
+ ("PARENTHESIZED NUMBER FIFTEEN" . 9346)
+ ("PARENTHESIZED NUMBER SIXTEEN" . 9347)
+ ("PARENTHESIZED NUMBER SEVENTEEN" . 9348)
+ ("PARENTHESIZED NUMBER EIGHTEEN" . 9349)
+ ("PARENTHESIZED NUMBER NINETEEN" . 9350)
+ ("PARENTHESIZED NUMBER TWENTY" . 9351)
+ ("DIGIT ONE FULL STOP" . 9352)
+ ("DIGIT TWO FULL STOP" . 9353)
+ ("DIGIT THREE FULL STOP" . 9354)
+ ("DIGIT FOUR FULL STOP" . 9355)
+ ("DIGIT FIVE FULL STOP" . 9356)
+ ("DIGIT SIX FULL STOP" . 9357)
+ ("DIGIT SEVEN FULL STOP" . 9358)
+ ("DIGIT EIGHT FULL STOP" . 9359)
+ ("DIGIT NINE FULL STOP" . 9360)
+ ("NUMBER TEN FULL STOP" . 9361)
+ ("NUMBER ELEVEN FULL STOP" . 9362)
+ ("NUMBER TWELVE FULL STOP" . 9363)
+ ("NUMBER THIRTEEN FULL STOP" . 9364)
+ ("NUMBER FOURTEEN FULL STOP" . 9365)
+ ("NUMBER FIFTEEN FULL STOP" . 9366)
+ ("NUMBER SIXTEEN FULL STOP" . 9367)
+ ("NUMBER SEVENTEEN FULL STOP" . 9368)
+ ("NUMBER EIGHTEEN FULL STOP" . 9369)
+ ("NUMBER NINETEEN FULL STOP" . 9370)
+ ("NUMBER TWENTY FULL STOP" . 9371)
+ ("PARENTHESIZED LATIN SMALL LETTER A" . 9372)
+ ("PARENTHESIZED LATIN SMALL LETTER B" . 9373)
+ ("PARENTHESIZED LATIN SMALL LETTER C" . 9374)
+ ("PARENTHESIZED LATIN SMALL LETTER D" . 9375)
+ ("PARENTHESIZED LATIN SMALL LETTER E" . 9376)
+ ("PARENTHESIZED LATIN SMALL LETTER F" . 9377)
+ ("PARENTHESIZED LATIN SMALL LETTER G" . 9378)
+ ("PARENTHESIZED LATIN SMALL LETTER H" . 9379)
+ ("PARENTHESIZED LATIN SMALL LETTER I" . 9380)
+ ("PARENTHESIZED LATIN SMALL LETTER J" . 9381)
+ ("PARENTHESIZED LATIN SMALL LETTER K" . 9382)
+ ("PARENTHESIZED LATIN SMALL LETTER L" . 9383)
+ ("PARENTHESIZED LATIN SMALL LETTER M" . 9384)
+ ("PARENTHESIZED LATIN SMALL LETTER N" . 9385)
+ ("PARENTHESIZED LATIN SMALL LETTER O" . 9386)
+ ("PARENTHESIZED LATIN SMALL LETTER P" . 9387)
+ ("PARENTHESIZED LATIN SMALL LETTER Q" . 9388)
+ ("PARENTHESIZED LATIN SMALL LETTER R" . 9389)
+ ("PARENTHESIZED LATIN SMALL LETTER S" . 9390)
+ ("PARENTHESIZED LATIN SMALL LETTER T" . 9391)
+ ("PARENTHESIZED LATIN SMALL LETTER U" . 9392)
+ ("PARENTHESIZED LATIN SMALL LETTER V" . 9393)
+ ("PARENTHESIZED LATIN SMALL LETTER W" . 9394)
+ ("PARENTHESIZED LATIN SMALL LETTER X" . 9395)
+ ("PARENTHESIZED LATIN SMALL LETTER Y" . 9396)
+ ("PARENTHESIZED LATIN SMALL LETTER Z" . 9397)
+ ("CIRCLED LATIN CAPITAL LETTER A" . 9398)
+ ("CIRCLED LATIN CAPITAL LETTER B" . 9399)
+ ("CIRCLED LATIN CAPITAL LETTER C" . 9400)
+ ("CIRCLED LATIN CAPITAL LETTER D" . 9401)
+ ("CIRCLED LATIN CAPITAL LETTER E" . 9402)
+ ("CIRCLED LATIN CAPITAL LETTER F" . 9403)
+ ("CIRCLED LATIN CAPITAL LETTER G" . 9404)
+ ("CIRCLED LATIN CAPITAL LETTER H" . 9405)
+ ("CIRCLED LATIN CAPITAL LETTER I" . 9406)
+ ("CIRCLED LATIN CAPITAL LETTER J" . 9407)
+ ("CIRCLED LATIN CAPITAL LETTER K" . 9408)
+ ("CIRCLED LATIN CAPITAL LETTER L" . 9409)
+ ("CIRCLED LATIN CAPITAL LETTER M" . 9410)
+ ("CIRCLED LATIN CAPITAL LETTER N" . 9411)
+ ("CIRCLED LATIN CAPITAL LETTER O" . 9412)
+ ("CIRCLED LATIN CAPITAL LETTER P" . 9413)
+ ("CIRCLED LATIN CAPITAL LETTER Q" . 9414)
+ ("CIRCLED LATIN CAPITAL LETTER R" . 9415)
+ ("CIRCLED LATIN CAPITAL LETTER S" . 9416)
+ ("CIRCLED LATIN CAPITAL LETTER T" . 9417)
+ ("CIRCLED LATIN CAPITAL LETTER U" . 9418)
+ ("CIRCLED LATIN CAPITAL LETTER V" . 9419)
+ ("CIRCLED LATIN CAPITAL LETTER W" . 9420)
+ ("CIRCLED LATIN CAPITAL LETTER X" . 9421)
+ ("CIRCLED LATIN CAPITAL LETTER Y" . 9422)
+ ("CIRCLED LATIN CAPITAL LETTER Z" . 9423)
+ ("CIRCLED LATIN SMALL LETTER A" . 9424)
+ ("CIRCLED LATIN SMALL LETTER B" . 9425)
+ ("CIRCLED LATIN SMALL LETTER C" . 9426)
+ ("CIRCLED LATIN SMALL LETTER D" . 9427)
+ ("CIRCLED LATIN SMALL LETTER E" . 9428)
+ ("CIRCLED LATIN SMALL LETTER F" . 9429)
+ ("CIRCLED LATIN SMALL LETTER G" . 9430)
+ ("CIRCLED LATIN SMALL LETTER H" . 9431)
+ ("CIRCLED LATIN SMALL LETTER I" . 9432)
+ ("CIRCLED LATIN SMALL LETTER J" . 9433)
+ ("CIRCLED LATIN SMALL LETTER K" . 9434)
+ ("CIRCLED LATIN SMALL LETTER L" . 9435)
+ ("CIRCLED LATIN SMALL LETTER M" . 9436)
+ ("CIRCLED LATIN SMALL LETTER N" . 9437)
+ ("CIRCLED LATIN SMALL LETTER O" . 9438)
+ ("CIRCLED LATIN SMALL LETTER P" . 9439)
+ ("CIRCLED LATIN SMALL LETTER Q" . 9440)
+ ("CIRCLED LATIN SMALL LETTER R" . 9441)
+ ("CIRCLED LATIN SMALL LETTER S" . 9442)
+ ("CIRCLED LATIN SMALL LETTER T" . 9443)
+ ("CIRCLED LATIN SMALL LETTER U" . 9444)
+ ("CIRCLED LATIN SMALL LETTER V" . 9445)
+ ("CIRCLED LATIN SMALL LETTER W" . 9446)
+ ("CIRCLED LATIN SMALL LETTER X" . 9447)
+ ("CIRCLED LATIN SMALL LETTER Y" . 9448)
+ ("CIRCLED LATIN SMALL LETTER Z" . 9449)
+ ("CIRCLED DIGIT ZERO" . 9450)
+ ("NEGATIVE CIRCLED NUMBER ELEVEN" . 9451)
+ ("NEGATIVE CIRCLED NUMBER TWELVE" . 9452)
+ ("NEGATIVE CIRCLED NUMBER THIRTEEN" . 9453)
+ ("NEGATIVE CIRCLED NUMBER FOURTEEN" . 9454)
+ ("NEGATIVE CIRCLED NUMBER FIFTEEN" . 9455)
+ ("NEGATIVE CIRCLED NUMBER SIXTEEN" . 9456)
+ ("NEGATIVE CIRCLED NUMBER SEVENTEEN" . 9457)
+ ("NEGATIVE CIRCLED NUMBER EIGHTEEN" . 9458)
+ ("NEGATIVE CIRCLED NUMBER NINETEEN" . 9459)
+ ("NEGATIVE CIRCLED NUMBER TWENTY" . 9460)
+ ("DOUBLE CIRCLED DIGIT ONE" . 9461)
+ ("DOUBLE CIRCLED DIGIT TWO" . 9462)
+ ("DOUBLE CIRCLED DIGIT THREE" . 9463)
+ ("DOUBLE CIRCLED DIGIT FOUR" . 9464)
+ ("DOUBLE CIRCLED DIGIT FIVE" . 9465)
+ ("DOUBLE CIRCLED DIGIT SIX" . 9466)
+ ("DOUBLE CIRCLED DIGIT SEVEN" . 9467)
+ ("DOUBLE CIRCLED DIGIT EIGHT" . 9468)
+ ("DOUBLE CIRCLED DIGIT NINE" . 9469)
+ ("DOUBLE CIRCLED NUMBER TEN" . 9470)
+ ("BOX DRAWINGS LIGHT HORIZONTAL" . 9472)
+ ("BOX DRAWINGS HEAVY HORIZONTAL" . 9473)
+ ("BOX DRAWINGS LIGHT VERTICAL" . 9474)
+ ("BOX DRAWINGS HEAVY VERTICAL" . 9475)
+ ("BOX DRAWINGS LIGHT TRIPLE DASH HORIZONTAL" . 9476)
+ ("BOX DRAWINGS HEAVY TRIPLE DASH HORIZONTAL" . 9477)
+ ("BOX DRAWINGS LIGHT TRIPLE DASH VERTICAL" . 9478)
+ ("BOX DRAWINGS HEAVY TRIPLE DASH VERTICAL" . 9479)
+ ("BOX DRAWINGS LIGHT QUADRUPLE DASH HORIZONTAL" . 9480)
+ ("BOX DRAWINGS HEAVY QUADRUPLE DASH HORIZONTAL" . 9481)
+ ("BOX DRAWINGS LIGHT QUADRUPLE DASH VERTICAL" . 9482)
+ ("BOX DRAWINGS HEAVY QUADRUPLE DASH VERTICAL" . 9483)
+ ("BOX DRAWINGS LIGHT DOWN AND RIGHT" . 9484)
+ ("BOX DRAWINGS DOWN LIGHT AND RIGHT HEAVY" . 9485)
+ ("BOX DRAWINGS DOWN HEAVY AND RIGHT LIGHT" . 9486)
+ ("BOX DRAWINGS HEAVY DOWN AND RIGHT" . 9487)
+ ("BOX DRAWINGS LIGHT DOWN AND LEFT" . 9488)
+ ("BOX DRAWINGS DOWN LIGHT AND LEFT HEAVY" . 9489)
+ ("BOX DRAWINGS DOWN HEAVY AND LEFT LIGHT" . 9490)
+ ("BOX DRAWINGS HEAVY DOWN AND LEFT" . 9491)
+ ("BOX DRAWINGS LIGHT UP AND RIGHT" . 9492)
+ ("BOX DRAWINGS UP LIGHT AND RIGHT HEAVY" . 9493)
+ ("BOX DRAWINGS UP HEAVY AND RIGHT LIGHT" . 9494)
+ ("BOX DRAWINGS HEAVY UP AND RIGHT" . 9495)
+ ("BOX DRAWINGS LIGHT UP AND LEFT" . 9496)
+ ("BOX DRAWINGS UP LIGHT AND LEFT HEAVY" . 9497)
+ ("BOX DRAWINGS UP HEAVY AND LEFT LIGHT" . 9498)
+ ("BOX DRAWINGS HEAVY UP AND LEFT" . 9499)
+ ("BOX DRAWINGS LIGHT VERTICAL AND RIGHT" . 9500)
+ ("BOX DRAWINGS VERTICAL LIGHT AND RIGHT HEAVY" . 9501)
+ ("BOX DRAWINGS UP HEAVY AND RIGHT DOWN LIGHT" . 9502)
+ ("BOX DRAWINGS DOWN HEAVY AND RIGHT UP LIGHT" . 9503)
+ ("BOX DRAWINGS VERTICAL HEAVY AND RIGHT LIGHT" . 9504)
+ ("BOX DRAWINGS DOWN LIGHT AND RIGHT UP HEAVY" . 9505)
+ ("BOX DRAWINGS UP LIGHT AND RIGHT DOWN HEAVY" . 9506)
+ ("BOX DRAWINGS HEAVY VERTICAL AND RIGHT" . 9507)
+ ("BOX DRAWINGS LIGHT VERTICAL AND LEFT" . 9508)
+ ("BOX DRAWINGS VERTICAL LIGHT AND LEFT HEAVY" . 9509)
+ ("BOX DRAWINGS UP HEAVY AND LEFT DOWN LIGHT" . 9510)
+ ("BOX DRAWINGS DOWN HEAVY AND LEFT UP LIGHT" . 9511)
+ ("BOX DRAWINGS VERTICAL HEAVY AND LEFT LIGHT" . 9512)
+ ("BOX DRAWINGS DOWN LIGHT AND LEFT UP HEAVY" . 9513)
+ ("BOX DRAWINGS UP LIGHT AND LEFT DOWN HEAVY" . 9514)
+ ("BOX DRAWINGS HEAVY VERTICAL AND LEFT" . 9515)
+ ("BOX DRAWINGS LIGHT DOWN AND HORIZONTAL" . 9516)
+ ("BOX DRAWINGS LEFT HEAVY AND RIGHT DOWN LIGHT" . 9517)
+ ("BOX DRAWINGS RIGHT HEAVY AND LEFT DOWN LIGHT" . 9518)
+ ("BOX DRAWINGS DOWN LIGHT AND HORIZONTAL HEAVY" . 9519)
+ ("BOX DRAWINGS DOWN HEAVY AND HORIZONTAL LIGHT" . 9520)
+ ("BOX DRAWINGS RIGHT LIGHT AND LEFT DOWN HEAVY" . 9521)
+ ("BOX DRAWINGS LEFT LIGHT AND RIGHT DOWN HEAVY" . 9522)
+ ("BOX DRAWINGS HEAVY DOWN AND HORIZONTAL" . 9523)
+ ("BOX DRAWINGS LIGHT UP AND HORIZONTAL" . 9524)
+ ("BOX DRAWINGS LEFT HEAVY AND RIGHT UP LIGHT" . 9525)
+ ("BOX DRAWINGS RIGHT HEAVY AND LEFT UP LIGHT" . 9526)
+ ("BOX DRAWINGS UP LIGHT AND HORIZONTAL HEAVY" . 9527)
+ ("BOX DRAWINGS UP HEAVY AND HORIZONTAL LIGHT" . 9528)
+ ("BOX DRAWINGS RIGHT LIGHT AND LEFT UP HEAVY" . 9529)
+ ("BOX DRAWINGS LEFT LIGHT AND RIGHT UP HEAVY" . 9530)
+ ("BOX DRAWINGS HEAVY UP AND HORIZONTAL" . 9531)
+ ("BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL" . 9532)
+ ("BOX DRAWINGS LEFT HEAVY AND RIGHT VERTICAL LIGHT" . 9533)
+ ("BOX DRAWINGS RIGHT HEAVY AND LEFT VERTICAL LIGHT" . 9534)
+ ("BOX DRAWINGS VERTICAL LIGHT AND HORIZONTAL HEAVY" . 9535)
+ ("BOX DRAWINGS UP HEAVY AND DOWN HORIZONTAL LIGHT" . 9536)
+ ("BOX DRAWINGS DOWN HEAVY AND UP HORIZONTAL LIGHT" . 9537)
+ ("BOX DRAWINGS VERTICAL HEAVY AND HORIZONTAL LIGHT" . 9538)
+ ("BOX DRAWINGS LEFT UP HEAVY AND RIGHT DOWN LIGHT" . 9539)
+ ("BOX DRAWINGS RIGHT UP HEAVY AND LEFT DOWN LIGHT" . 9540)
+ ("BOX DRAWINGS LEFT DOWN HEAVY AND RIGHT UP LIGHT" . 9541)
+ ("BOX DRAWINGS RIGHT DOWN HEAVY AND LEFT UP LIGHT" . 9542)
+ ("BOX DRAWINGS DOWN LIGHT AND UP HORIZONTAL HEAVY" . 9543)
+ ("BOX DRAWINGS UP LIGHT AND DOWN HORIZONTAL HEAVY" . 9544)
+ ("BOX DRAWINGS RIGHT LIGHT AND LEFT VERTICAL HEAVY" . 9545)
+ ("BOX DRAWINGS LEFT LIGHT AND RIGHT VERTICAL HEAVY" . 9546)
+ ("BOX DRAWINGS HEAVY VERTICAL AND HORIZONTAL" . 9547)
+ ("BOX DRAWINGS LIGHT DOUBLE DASH HORIZONTAL" . 9548)
+ ("BOX DRAWINGS HEAVY DOUBLE DASH HORIZONTAL" . 9549)
+ ("BOX DRAWINGS LIGHT DOUBLE DASH VERTICAL" . 9550)
+ ("BOX DRAWINGS HEAVY DOUBLE DASH VERTICAL" . 9551)
+ ("BOX DRAWINGS DOUBLE HORIZONTAL" . 9552)
+ ("BOX DRAWINGS DOUBLE VERTICAL" . 9553)
+ ("BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE" . 9554)
+ ("BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE" . 9555)
+ ("BOX DRAWINGS DOUBLE DOWN AND RIGHT" . 9556)
+ ("BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE" . 9557)
+ ("BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE" . 9558)
+ ("BOX DRAWINGS DOUBLE DOWN AND LEFT" . 9559)
+ ("BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE" . 9560)
+ ("BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE" . 9561)
+ ("BOX DRAWINGS DOUBLE UP AND RIGHT" . 9562)
+ ("BOX DRAWINGS UP SINGLE AND LEFT DOUBLE" . 9563)
+ ("BOX DRAWINGS UP DOUBLE AND LEFT SINGLE" . 9564)
+ ("BOX DRAWINGS DOUBLE UP AND LEFT" . 9565)
+ ("BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE" . 9566)
+ ("BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE" . 9567)
+ ("BOX DRAWINGS DOUBLE VERTICAL AND RIGHT" . 9568)
+ ("BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE" . 9569)
+ ("BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE" . 9570)
+ ("BOX DRAWINGS DOUBLE VERTICAL AND LEFT" . 9571)
+ ("BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE" . 9572)
+ ("BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE" . 9573)
+ ("BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL" . 9574)
+ ("BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE" . 9575)
+ ("BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE" . 9576)
+ ("BOX DRAWINGS DOUBLE UP AND HORIZONTAL" . 9577)
+ ("BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE" . 9578)
+ ("BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE" . 9579)
+ ("BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL" . 9580)
+ ("BOX DRAWINGS LIGHT ARC DOWN AND RIGHT" . 9581)
+ ("BOX DRAWINGS LIGHT ARC DOWN AND LEFT" . 9582)
+ ("BOX DRAWINGS LIGHT ARC UP AND LEFT" . 9583)
+ ("BOX DRAWINGS LIGHT ARC UP AND RIGHT" . 9584)
+ ("BOX DRAWINGS LIGHT DIAGONAL UPPER RIGHT TO LOWER LEFT" . 9585)
+ ("BOX DRAWINGS LIGHT DIAGONAL UPPER LEFT TO LOWER RIGHT" . 9586)
+ ("BOX DRAWINGS LIGHT DIAGONAL CROSS" . 9587)
+ ("BOX DRAWINGS LIGHT LEFT" . 9588)
+ ("BOX DRAWINGS LIGHT UP" . 9589)
+ ("BOX DRAWINGS LIGHT RIGHT" . 9590)
+ ("BOX DRAWINGS LIGHT DOWN" . 9591)
+ ("BOX DRAWINGS HEAVY LEFT" . 9592)
+ ("BOX DRAWINGS HEAVY UP" . 9593)
+ ("BOX DRAWINGS HEAVY RIGHT" . 9594)
+ ("BOX DRAWINGS HEAVY DOWN" . 9595)
+ ("BOX DRAWINGS LIGHT LEFT AND HEAVY RIGHT" . 9596)
+ ("BOX DRAWINGS LIGHT UP AND HEAVY DOWN" . 9597)
+ ("BOX DRAWINGS HEAVY LEFT AND LIGHT RIGHT" . 9598)
+ ("BOX DRAWINGS HEAVY UP AND LIGHT DOWN" . 9599)
+ ("UPPER HALF BLOCK" . 9600)
+ ("LOWER ONE EIGHTH BLOCK" . 9601)
+ ("LOWER ONE QUARTER BLOCK" . 9602)
+ ("LOWER THREE EIGHTHS BLOCK" . 9603)
+ ("LOWER HALF BLOCK" . 9604)
+ ("LOWER FIVE EIGHTHS BLOCK" . 9605)
+ ("LOWER THREE QUARTERS BLOCK" . 9606)
+ ("LOWER SEVEN EIGHTHS BLOCK" . 9607)
+ ("FULL BLOCK" . 9608)
+ ("LEFT SEVEN EIGHTHS BLOCK" . 9609)
+ ("LEFT THREE QUARTERS BLOCK" . 9610)
+ ("LEFT FIVE EIGHTHS BLOCK" . 9611)
+ ("LEFT HALF BLOCK" . 9612)
+ ("LEFT THREE EIGHTHS BLOCK" . 9613)
+ ("LEFT ONE QUARTER BLOCK" . 9614)
+ ("LEFT ONE EIGHTH BLOCK" . 9615)
+ ("RIGHT HALF BLOCK" . 9616)
+ ("LIGHT SHADE" . 9617)
+ ("MEDIUM SHADE" . 9618)
+ ("DARK SHADE" . 9619)
+ ("UPPER ONE EIGHTH BLOCK" . 9620)
+ ("RIGHT ONE EIGHTH BLOCK" . 9621)
+ ("QUADRANT LOWER LEFT" . 9622)
+ ("QUADRANT LOWER RIGHT" . 9623)
+ ("QUADRANT UPPER LEFT" . 9624)
+ ("QUADRANT UPPER LEFT AND LOWER LEFT AND LOWER RIGHT" . 9625)
+ ("QUADRANT UPPER LEFT AND LOWER RIGHT" . 9626)
+ ("QUADRANT UPPER LEFT AND UPPER RIGHT AND LOWER LEFT" . 9627)
+ ("QUADRANT UPPER LEFT AND UPPER RIGHT AND LOWER RIGHT" . 9628)
+ ("QUADRANT UPPER RIGHT" . 9629)
+ ("QUADRANT UPPER RIGHT AND LOWER LEFT" . 9630)
+ ("QUADRANT UPPER RIGHT AND LOWER LEFT AND LOWER RIGHT" . 9631)
+ ("BLACK SQUARE" . 9632)
+ ("WHITE SQUARE" . 9633)
+ ("WHITE SQUARE WITH ROUNDED CORNERS" . 9634)
+ ("WHITE SQUARE CONTAINING BLACK SMALL SQUARE" . 9635)
+ ("SQUARE WITH HORIZONTAL FILL" . 9636)
+ ("SQUARE WITH VERTICAL FILL" . 9637)
+ ("SQUARE WITH ORTHOGONAL CROSSHATCH FILL" . 9638)
+ ("SQUARE WITH UPPER LEFT TO LOWER RIGHT FILL" . 9639)
+ ("SQUARE WITH UPPER RIGHT TO LOWER LEFT FILL" . 9640)
+ ("SQUARE WITH DIAGONAL CROSSHATCH FILL" . 9641)
+ ("BLACK SMALL SQUARE" . 9642)
+ ("WHITE SMALL SQUARE" . 9643)
+ ("BLACK RECTANGLE" . 9644)
+ ("WHITE RECTANGLE" . 9645)
+ ("BLACK VERTICAL RECTANGLE" . 9646)
+ ("WHITE VERTICAL RECTANGLE" . 9647)
+ ("BLACK PARALLELOGRAM" . 9648)
+ ("WHITE PARALLELOGRAM" . 9649)
+ ("BLACK UP-POINTING TRIANGLE" . 9650)
+ ("WHITE UP-POINTING TRIANGLE" . 9651)
+ ("BLACK UP-POINTING SMALL TRIANGLE" . 9652)
+ ("WHITE UP-POINTING SMALL TRIANGLE" . 9653)
+ ("BLACK RIGHT-POINTING TRIANGLE" . 9654)
+ ("WHITE RIGHT-POINTING TRIANGLE" . 9655)
+ ("BLACK RIGHT-POINTING SMALL TRIANGLE" . 9656)
+ ("WHITE RIGHT-POINTING SMALL TRIANGLE" . 9657)
+ ("BLACK RIGHT-POINTING POINTER" . 9658)
+ ("WHITE RIGHT-POINTING POINTER" . 9659)
+ ("BLACK DOWN-POINTING TRIANGLE" . 9660)
+ ("WHITE DOWN-POINTING TRIANGLE" . 9661)
+ ("BLACK DOWN-POINTING SMALL TRIANGLE" . 9662)
+ ("WHITE DOWN-POINTING SMALL TRIANGLE" . 9663)
+ ("BLACK LEFT-POINTING TRIANGLE" . 9664)
+ ("WHITE LEFT-POINTING TRIANGLE" . 9665)
+ ("BLACK LEFT-POINTING SMALL TRIANGLE" . 9666)
+ ("WHITE LEFT-POINTING SMALL TRIANGLE" . 9667)
+ ("BLACK LEFT-POINTING POINTER" . 9668)
+ ("WHITE LEFT-POINTING POINTER" . 9669)
+ ("BLACK DIAMOND" . 9670)
+ ("WHITE DIAMOND" . 9671)
+ ("WHITE DIAMOND CONTAINING BLACK SMALL DIAMOND" . 9672)
+ ("FISHEYE" . 9673)
+ ("LOZENGE" . 9674)
+ ("WHITE CIRCLE" . 9675)
+ ("DOTTED CIRCLE" . 9676)
+ ("CIRCLE WITH VERTICAL FILL" . 9677)
+ ("BULLSEYE" . 9678)
+ ("BLACK CIRCLE" . 9679)
+ ("CIRCLE WITH LEFT HALF BLACK" . 9680)
+ ("CIRCLE WITH RIGHT HALF BLACK" . 9681)
+ ("CIRCLE WITH LOWER HALF BLACK" . 9682)
+ ("CIRCLE WITH UPPER HALF BLACK" . 9683)
+ ("CIRCLE WITH UPPER RIGHT QUADRANT BLACK" . 9684)
+ ("CIRCLE WITH ALL BUT UPPER LEFT QUADRANT BLACK" . 9685)
+ ("LEFT HALF BLACK CIRCLE" . 9686)
+ ("RIGHT HALF BLACK CIRCLE" . 9687)
+ ("INVERSE BULLET" . 9688)
+ ("INVERSE WHITE CIRCLE" . 9689)
+ ("UPPER HALF INVERSE WHITE CIRCLE" . 9690)
+ ("LOWER HALF INVERSE WHITE CIRCLE" . 9691)
+ ("UPPER LEFT QUADRANT CIRCULAR ARC" . 9692)
+ ("UPPER RIGHT QUADRANT CIRCULAR ARC" . 9693)
+ ("LOWER RIGHT QUADRANT CIRCULAR ARC" . 9694)
+ ("LOWER LEFT QUADRANT CIRCULAR ARC" . 9695)
+ ("UPPER HALF CIRCLE" . 9696)
+ ("LOWER HALF CIRCLE" . 9697)
+ ("BLACK LOWER RIGHT TRIANGLE" . 9698)
+ ("BLACK LOWER LEFT TRIANGLE" . 9699)
+ ("BLACK UPPER LEFT TRIANGLE" . 9700)
+ ("BLACK UPPER RIGHT TRIANGLE" . 9701)
+ ("WHITE BULLET" . 9702)
+ ("SQUARE WITH LEFT HALF BLACK" . 9703)
+ ("SQUARE WITH RIGHT HALF BLACK" . 9704)
+ ("SQUARE WITH UPPER LEFT DIAGONAL HALF BLACK" . 9705)
+ ("SQUARE WITH LOWER RIGHT DIAGONAL HALF BLACK" . 9706)
+ ("WHITE SQUARE WITH VERTICAL BISECTING LINE" . 9707)
+ ("WHITE UP-POINTING TRIANGLE WITH DOT" . 9708)
+ ("UP-POINTING TRIANGLE WITH LEFT HALF BLACK" . 9709)
+ ("UP-POINTING TRIANGLE WITH RIGHT HALF BLACK" . 9710)
+ ("LARGE CIRCLE" . 9711)
+ ("WHITE SQUARE WITH UPPER LEFT QUADRANT" . 9712)
+ ("WHITE SQUARE WITH LOWER LEFT QUADRANT" . 9713)
+ ("WHITE SQUARE WITH LOWER RIGHT QUADRANT" . 9714)
+ ("WHITE SQUARE WITH UPPER RIGHT QUADRANT" . 9715)
+ ("WHITE CIRCLE WITH UPPER LEFT QUADRANT" . 9716)
+ ("WHITE CIRCLE WITH LOWER LEFT QUADRANT" . 9717)
+ ("WHITE CIRCLE WITH LOWER RIGHT QUADRANT" . 9718)
+ ("WHITE CIRCLE WITH UPPER RIGHT QUADRANT" . 9719)
+ ("UPPER LEFT TRIANGLE" . 9720)
+ ("UPPER RIGHT TRIANGLE" . 9721)
+ ("LOWER LEFT TRIANGLE" . 9722)
+ ("WHITE MEDIUM SQUARE" . 9723)
+ ("BLACK MEDIUM SQUARE" . 9724)
+ ("WHITE MEDIUM SMALL SQUARE" . 9725)
+ ("BLACK MEDIUM SMALL SQUARE" . 9726)
+ ("LOWER RIGHT TRIANGLE" . 9727)
+ ("BLACK SUN WITH RAYS" . 9728)
+ ("CLOUD" . 9729)
+ ("UMBRELLA" . 9730)
+ ("SNOWMAN" . 9731)
+ ("COMET" . 9732)
+ ("BLACK STAR" . 9733)
+ ("WHITE STAR" . 9734)
+ ("LIGHTNING" . 9735)
+ ("THUNDERSTORM" . 9736)
+ ("SUN" . 9737)
+ ("ASCENDING NODE" . 9738)
+ ("DESCENDING NODE" . 9739)
+ ("CONJUNCTION" . 9740)
+ ("OPPOSITION" . 9741)
+ ("BLACK TELEPHONE" . 9742)
+ ("WHITE TELEPHONE" . 9743)
+ ("BALLOT BOX" . 9744)
+ ("BALLOT BOX WITH CHECK" . 9745)
+ ("BALLOT BOX WITH X" . 9746)
+ ("SALTIRE" . 9747)
+ ("WHITE SHOGI PIECE" . 9750)
+ ("BLACK SHOGI PIECE" . 9751)
+ ("REVERSED ROTATED FLORAL HEART BULLET" . 9753)
+ ("BLACK LEFT POINTING INDEX" . 9754)
+ ("BLACK RIGHT POINTING INDEX" . 9755)
+ ("WHITE LEFT POINTING INDEX" . 9756)
+ ("WHITE UP POINTING INDEX" . 9757)
+ ("WHITE RIGHT POINTING INDEX" . 9758)
+ ("WHITE DOWN POINTING INDEX" . 9759)
+ ("SKULL AND CROSSBONES" . 9760)
+ ("CAUTION SIGN" . 9761)
+ ("RADIOACTIVE SIGN" . 9762)
+ ("BIOHAZARD SIGN" . 9763)
+ ("CADUCEUS" . 9764)
+ ("ANKH" . 9765)
+ ("ORTHODOX CROSS" . 9766)
+ ("CHI RHO" . 9767)
+ ("CROSS OF LORRAINE" . 9768)
+ ("CROSS OF JERUSALEM" . 9769)
+ ("STAR AND CRESCENT" . 9770)
+ ("FARSI SYMBOL" . 9771)
+ ("ADI SHAKTI" . 9772)
+ ("HAMMER AND SICKLE" . 9773)
+ ("PEACE SYMBOL" . 9774)
+ ("YIN YANG" . 9775)
+ ("TRIGRAM FOR HEAVEN" . 9776)
+ ("TRIGRAM FOR LAKE" . 9777)
+ ("TRIGRAM FOR FIRE" . 9778)
+ ("TRIGRAM FOR THUNDER" . 9779)
+ ("TRIGRAM FOR WIND" . 9780)
+ ("TRIGRAM FOR WATER" . 9781)
+ ("TRIGRAM FOR MOUNTAIN" . 9782)
+ ("TRIGRAM FOR EARTH" . 9783)
+ ("WHEEL OF DHARMA" . 9784)
+ ("WHITE FROWNING FACE" . 9785)
+ ("WHITE SMILING FACE" . 9786)
+ ("BLACK SMILING FACE" . 9787)
+ ("WHITE SUN WITH RAYS" . 9788)
+ ("FIRST QUARTER MOON" . 9789)
+ ("LAST QUARTER MOON" . 9790)
+ ("MERCURY" . 9791)
+ ("FEMALE SIGN" . 9792)
+ ("EARTH" . 9793)
+ ("MALE SIGN" . 9794)
+ ("JUPITER" . 9795)
+ ("SATURN" . 9796)
+ ("URANUS" . 9797)
+ ("NEPTUNE" . 9798)
+ ("PLUTO" . 9799)
+ ("ARIES" . 9800)
+ ("TAURUS" . 9801)
+ ("GEMINI" . 9802)
+ ("CANCER" . 9803)
+ ("LEO" . 9804)
+ ("VIRGO" . 9805)
+ ("LIBRA" . 9806)
+ ("SCORPIUS" . 9807)
+ ("SAGITTARIUS" . 9808)
+ ("CAPRICORN" . 9809)
+ ("AQUARIUS" . 9810)
+ ("PISCES" . 9811)
+ ("WHITE CHESS KING" . 9812)
+ ("WHITE CHESS QUEEN" . 9813)
+ ("WHITE CHESS ROOK" . 9814)
+ ("WHITE CHESS BISHOP" . 9815)
+ ("WHITE CHESS KNIGHT" . 9816)
+ ("WHITE CHESS PAWN" . 9817)
+ ("BLACK CHESS KING" . 9818)
+ ("BLACK CHESS QUEEN" . 9819)
+ ("BLACK CHESS ROOK" . 9820)
+ ("BLACK CHESS BISHOP" . 9821)
+ ("BLACK CHESS KNIGHT" . 9822)
+ ("BLACK CHESS PAWN" . 9823)
+ ("BLACK SPADE SUIT" . 9824)
+ ("WHITE HEART SUIT" . 9825)
+ ("WHITE DIAMOND SUIT" . 9826)
+ ("BLACK CLUB SUIT" . 9827)
+ ("WHITE SPADE SUIT" . 9828)
+ ("BLACK HEART SUIT" . 9829)
+ ("BLACK DIAMOND SUIT" . 9830)
+ ("WHITE CLUB SUIT" . 9831)
+ ("HOT SPRINGS" . 9832)
+ ("QUARTER NOTE" . 9833)
+ ("EIGHTH NOTE" . 9834)
+ ("BEAMED EIGHTH NOTES" . 9835)
+ ("BEAMED SIXTEENTH NOTES" . 9836)
+ ("MUSIC FLAT SIGN" . 9837)
+ ("MUSIC NATURAL SIGN" . 9838)
+ ("MUSIC SHARP SIGN" . 9839)
+ ("WEST SYRIAC CROSS" . 9840)
+ ("EAST SYRIAC CROSS" . 9841)
+ ("UNIVERSAL RECYCLING SYMBOL" . 9842)
+ ("RECYCLING SYMBOL FOR TYPE-1 PLASTICS" . 9843)
+ ("RECYCLING SYMBOL FOR TYPE-2 PLASTICS" . 9844)
+ ("RECYCLING SYMBOL FOR TYPE-3 PLASTICS" . 9845)
+ ("RECYCLING SYMBOL FOR TYPE-4 PLASTICS" . 9846)
+ ("RECYCLING SYMBOL FOR TYPE-5 PLASTICS" . 9847)
+ ("RECYCLING SYMBOL FOR TYPE-6 PLASTICS" . 9848)
+ ("RECYCLING SYMBOL FOR TYPE-7 PLASTICS" . 9849)
+ ("RECYCLING SYMBOL FOR GENERIC MATERIALS" . 9850)
+ ("BLACK UNIVERSAL RECYCLING SYMBOL" . 9851)
+ ("RECYCLED PAPER SYMBOL" . 9852)
+ ("PARTIALLY-RECYCLED PAPER SYMBOL" . 9853)
+ ("DIE FACE-1" . 9856)
+ ("DIE FACE-2" . 9857)
+ ("DIE FACE-3" . 9858)
+ ("DIE FACE-4" . 9859)
+ ("DIE FACE-5" . 9860)
+ ("DIE FACE-6" . 9861)
+ ("WHITE CIRCLE WITH DOT RIGHT" . 9862)
+ ("WHITE CIRCLE WITH TWO DOTS" . 9863)
+ ("BLACK CIRCLE WITH WHITE DOT RIGHT" . 9864)
+ ("BLACK CIRCLE WITH TWO WHITE DOTS" . 9865)
+ ("UPPER BLADE SCISSORS" . 9985)
+ ("BLACK SCISSORS" . 9986)
+ ("LOWER BLADE SCISSORS" . 9987)
+ ("WHITE SCISSORS" . 9988)
+ ("TELEPHONE LOCATION SIGN" . 9990)
+ ("TAPE DRIVE" . 9991)
+ ("AIRPLANE" . 9992)
+ ("ENVELOPE" . 9993)
+ ("VICTORY HAND" . 9996)
+ ("WRITING HAND" . 9997)
+ ("LOWER RIGHT PENCIL" . 9998)
+ ("PENCIL" . 9999)
+ ("UPPER RIGHT PENCIL" . 10000)
+ ("WHITE NIB" . 10001)
+ ("BLACK NIB" . 10002)
+ ("CHECK MARK" . 10003)
+ ("HEAVY CHECK MARK" . 10004)
+ ("MULTIPLICATION X" . 10005)
+ ("HEAVY MULTIPLICATION X" . 10006)
+ ("BALLOT X" . 10007)
+ ("HEAVY BALLOT X" . 10008)
+ ("OUTLINED GREEK CROSS" . 10009)
+ ("HEAVY GREEK CROSS" . 10010)
+ ("OPEN CENTRE CROSS" . 10011)
+ ("HEAVY OPEN CENTRE CROSS" . 10012)
+ ("LATIN CROSS" . 10013)
+ ("SHADOWED WHITE LATIN CROSS" . 10014)
+ ("OUTLINED LATIN CROSS" . 10015)
+ ("MALTESE CROSS" . 10016)
+ ("STAR OF DAVID" . 10017)
+ ("FOUR TEARDROP-SPOKED ASTERISK" . 10018)
+ ("FOUR BALLOON-SPOKED ASTERISK" . 10019)
+ ("HEAVY FOUR BALLOON-SPOKED ASTERISK" . 10020)
+ ("FOUR CLUB-SPOKED ASTERISK" . 10021)
+ ("BLACK FOUR POINTED STAR" . 10022)
+ ("WHITE FOUR POINTED STAR" . 10023)
+ ("STRESS OUTLINED WHITE STAR" . 10025)
+ ("CIRCLED WHITE STAR" . 10026)
+ ("OPEN CENTRE BLACK STAR" . 10027)
+ ("BLACK CENTRE WHITE STAR" . 10028)
+ ("OUTLINED BLACK STAR" . 10029)
+ ("HEAVY OUTLINED BLACK STAR" . 10030)
+ ("PINWHEEL STAR" . 10031)
+ ("SHADOWED WHITE STAR" . 10032)
+ ("HEAVY ASTERISK" . 10033)
+ ("OPEN CENTRE ASTERISK" . 10034)
+ ("EIGHT SPOKED ASTERISK" . 10035)
+ ("EIGHT POINTED BLACK STAR" . 10036)
+ ("EIGHT POINTED PINWHEEL STAR" . 10037)
+ ("SIX POINTED BLACK STAR" . 10038)
+ ("EIGHT POINTED RECTILINEAR BLACK STAR" . 10039)
+ ("HEAVY EIGHT POINTED RECTILINEAR BLACK STAR" . 10040)
+ ("TWELVE POINTED BLACK STAR" . 10041)
+ ("SIXTEEN POINTED ASTERISK" . 10042)
+ ("TEARDROP-SPOKED ASTERISK" . 10043)
+ ("OPEN CENTRE TEARDROP-SPOKED ASTERISK" . 10044)
+ ("HEAVY TEARDROP-SPOKED ASTERISK" . 10045)
+ ("SIX PETALLED BLACK AND WHITE FLORETTE" . 10046)
+ ("BLACK FLORETTE" . 10047)
+ ("WHITE FLORETTE" . 10048)
+ ("EIGHT PETALLED OUTLINED BLACK FLORETTE" . 10049)
+ ("CIRCLED OPEN CENTRE EIGHT POINTED STAR" . 10050)
+ ("HEAVY TEARDROP-SPOKED PINWHEEL ASTERISK" . 10051)
+ ("SNOWFLAKE" . 10052)
+ ("TIGHT TRIFOLIATE SNOWFLAKE" . 10053)
+ ("HEAVY CHEVRON SNOWFLAKE" . 10054)
+ ("SPARKLE" . 10055)
+ ("HEAVY SPARKLE" . 10056)
+ ("BALLOON-SPOKED ASTERISK" . 10057)
+ ("EIGHT TEARDROP-SPOKED PROPELLER ASTERISK" . 10058)
+ ("HEAVY EIGHT TEARDROP-SPOKED PROPELLER ASTERISK" . 10059)
+ ("SHADOWED WHITE CIRCLE" . 10061)
+ ("LOWER RIGHT DROP-SHADOWED WHITE SQUARE" . 10063)
+ ("UPPER RIGHT DROP-SHADOWED WHITE SQUARE" . 10064)
+ ("LOWER RIGHT SHADOWED WHITE SQUARE" . 10065)
+ ("UPPER RIGHT SHADOWED WHITE SQUARE" . 10066)
+ ("BLACK DIAMOND MINUS WHITE X" . 10070)
+ ("LIGHT VERTICAL BAR" . 10072)
+ ("MEDIUM VERTICAL BAR" . 10073)
+ ("HEAVY VERTICAL BAR" . 10074)
+ ("HEAVY SINGLE TURNED COMMA QUOTATION MARK ORNAMENT" . 10075)
+ ("HEAVY SINGLE COMMA QUOTATION MARK ORNAMENT" . 10076)
+ ("HEAVY DOUBLE TURNED COMMA QUOTATION MARK ORNAMENT" . 10077)
+ ("HEAVY DOUBLE COMMA QUOTATION MARK ORNAMENT" . 10078)
+ ("CURVED STEM PARAGRAPH SIGN ORNAMENT" . 10081)
+ ("HEAVY EXCLAMATION MARK ORNAMENT" . 10082)
+ ("HEAVY HEART EXCLAMATION MARK ORNAMENT" . 10083)
+ ("HEAVY BLACK HEART" . 10084)
+ ("ROTATED HEAVY BLACK HEART BULLET" . 10085)
+ ("FLORAL HEART" . 10086)
+ ("ROTATED FLORAL HEART BULLET" . 10087)
+ ("MEDIUM LEFT PARENTHESIS ORNAMENT" . 10088)
+ ("MEDIUM RIGHT PARENTHESIS ORNAMENT" . 10089)
+ ("MEDIUM FLATTENED LEFT PARENTHESIS ORNAMENT" . 10090)
+ ("MEDIUM FLATTENED RIGHT PARENTHESIS ORNAMENT" . 10091)
+ ("MEDIUM LEFT-POINTING ANGLE BRACKET ORNAMENT" . 10092)
+ ("MEDIUM RIGHT-POINTING ANGLE BRACKET ORNAMENT" . 10093)
+ ("HEAVY LEFT-POINTING ANGLE QUOTATION MARK ORNAMENT" . 10094)
+ ("HEAVY RIGHT-POINTING ANGLE QUOTATION MARK ORNAMENT" . 10095)
+ ("HEAVY LEFT-POINTING ANGLE BRACKET ORNAMENT" . 10096)
+ ("HEAVY RIGHT-POINTING ANGLE BRACKET ORNAMENT" . 10097)
+ ("LIGHT LEFT TORTOISE SHELL BRACKET ORNAMENT" . 10098)
+ ("LIGHT RIGHT TORTOISE SHELL BRACKET ORNAMENT" . 10099)
+ ("MEDIUM LEFT CURLY BRACKET ORNAMENT" . 10100)
+ ("MEDIUM RIGHT CURLY BRACKET ORNAMENT" . 10101)
+ ("DINGBAT NEGATIVE CIRCLED DIGIT ONE" . 10102)
+ ("DINGBAT NEGATIVE CIRCLED DIGIT TWO" . 10103)
+ ("DINGBAT NEGATIVE CIRCLED DIGIT THREE" . 10104)
+ ("DINGBAT NEGATIVE CIRCLED DIGIT FOUR" . 10105)
+ ("DINGBAT NEGATIVE CIRCLED DIGIT FIVE" . 10106)
+ ("DINGBAT NEGATIVE CIRCLED DIGIT SIX" . 10107)
+ ("DINGBAT NEGATIVE CIRCLED DIGIT SEVEN" . 10108)
+ ("DINGBAT NEGATIVE CIRCLED DIGIT EIGHT" . 10109)
+ ("DINGBAT NEGATIVE CIRCLED DIGIT NINE" . 10110)
+ ("DINGBAT NEGATIVE CIRCLED NUMBER TEN" . 10111)
+ ("DINGBAT CIRCLED SANS-SERIF DIGIT ONE" . 10112)
+ ("DINGBAT CIRCLED SANS-SERIF DIGIT TWO" . 10113)
+ ("DINGBAT CIRCLED SANS-SERIF DIGIT THREE" . 10114)
+ ("DINGBAT CIRCLED SANS-SERIF DIGIT FOUR" . 10115)
+ ("DINGBAT CIRCLED SANS-SERIF DIGIT FIVE" . 10116)
+ ("DINGBAT CIRCLED SANS-SERIF DIGIT SIX" . 10117)
+ ("DINGBAT CIRCLED SANS-SERIF DIGIT SEVEN" . 10118)
+ ("DINGBAT CIRCLED SANS-SERIF DIGIT EIGHT" . 10119)
+ ("DINGBAT CIRCLED SANS-SERIF DIGIT NINE" . 10120)
+ ("DINGBAT CIRCLED SANS-SERIF NUMBER TEN" . 10121)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF DIGIT ONE" . 10122)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF DIGIT TWO" . 10123)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF DIGIT THREE" . 10124)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF DIGIT FOUR" . 10125)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF DIGIT FIVE" . 10126)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF DIGIT SIX" . 10127)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF DIGIT SEVEN" . 10128)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF DIGIT EIGHT" . 10129)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF DIGIT NINE" . 10130)
+ ("DINGBAT NEGATIVE CIRCLED SANS-SERIF NUMBER TEN" . 10131)
+ ("HEAVY WIDE-HEADED RIGHTWARDS ARROW" . 10132)
+ ("HEAVY SOUTH EAST ARROW" . 10136)
+ ("HEAVY RIGHTWARDS ARROW" . 10137)
+ ("HEAVY NORTH EAST ARROW" . 10138)
+ ("DRAFTING POINT RIGHTWARDS ARROW" . 10139)
+ ("HEAVY ROUND-TIPPED RIGHTWARDS ARROW" . 10140)
+ ("TRIANGLE-HEADED RIGHTWARDS ARROW" . 10141)
+ ("HEAVY TRIANGLE-HEADED RIGHTWARDS ARROW" . 10142)
+ ("DASHED TRIANGLE-HEADED RIGHTWARDS ARROW" . 10143)
+ ("HEAVY DASHED TRIANGLE-HEADED RIGHTWARDS ARROW" . 10144)
+ ("BLACK RIGHTWARDS ARROW" . 10145)
+ ("THREE-D TOP-LIGHTED RIGHTWARDS ARROWHEAD" . 10146)
+ ("THREE-D BOTTOM-LIGHTED RIGHTWARDS ARROWHEAD" . 10147)
+ ("BLACK RIGHTWARDS ARROWHEAD" . 10148)
+ ("HEAVY BLACK CURVED DOWNWARDS AND RIGHTWARDS ARROW" . 10149)
+ ("HEAVY BLACK CURVED UPWARDS AND RIGHTWARDS ARROW" . 10150)
+ ("SQUAT BLACK RIGHTWARDS ARROW" . 10151)
+ ("HEAVY CONCAVE-POINTED BLACK RIGHTWARDS ARROW" . 10152)
+ ("RIGHT-SHADED WHITE RIGHTWARDS ARROW" . 10153)
+ ("LEFT-SHADED WHITE RIGHTWARDS ARROW" . 10154)
+ ("BACK-TILTED SHADOWED WHITE RIGHTWARDS ARROW" . 10155)
+ ("FRONT-TILTED SHADOWED WHITE RIGHTWARDS ARROW" . 10156)
+ ("HEAVY LOWER RIGHT-SHADOWED WHITE RIGHTWARDS ARROW" . 10157)
+ ("HEAVY UPPER RIGHT-SHADOWED WHITE RIGHTWARDS ARROW" . 10158)
+ ("NOTCHED LOWER RIGHT-SHADOWED WHITE RIGHTWARDS ARROW" . 10159)
+ ("NOTCHED UPPER RIGHT-SHADOWED WHITE RIGHTWARDS ARROW" . 10161)
+ ("CIRCLED HEAVY WHITE RIGHTWARDS ARROW" . 10162)
+ ("WHITE-FEATHERED RIGHTWARDS ARROW" . 10163)
+ ("BLACK-FEATHERED SOUTH EAST ARROW" . 10164)
+ ("BLACK-FEATHERED RIGHTWARDS ARROW" . 10165)
+ ("BLACK-FEATHERED NORTH EAST ARROW" . 10166)
+ ("HEAVY BLACK-FEATHERED SOUTH EAST ARROW" . 10167)
+ ("HEAVY BLACK-FEATHERED RIGHTWARDS ARROW" . 10168)
+ ("HEAVY BLACK-FEATHERED NORTH EAST ARROW" . 10169)
+ ("TEARDROP-BARBED RIGHTWARDS ARROW" . 10170)
+ ("HEAVY TEARDROP-SHANKED RIGHTWARDS ARROW" . 10171)
+ ("WEDGE-TAILED RIGHTWARDS ARROW" . 10172)
+ ("HEAVY WEDGE-TAILED RIGHTWARDS ARROW" . 10173)
+ ("OPEN-OUTLINED RIGHTWARDS ARROW" . 10174)
+ ("WHITE DIAMOND WITH CENTRED DOT" . 10192)
+ ("AND WITH DOT" . 10193)
+ ("ELEMENT OF OPENING UPWARDS" . 10194)
+ ("LOWER RIGHT CORNER WITH DOT" . 10195)
+ ("UPPER LEFT CORNER WITH DOT" . 10196)
+ ("LEFT OUTER JOIN" . 10197)
+ ("RIGHT OUTER JOIN" . 10198)
+ ("FULL OUTER JOIN" . 10199)
+ ("LARGE UP TACK" . 10200)
+ ("LARGE DOWN TACK" . 10201)
+ ("LEFT AND RIGHT DOUBLE TURNSTILE" . 10202)
+ ("LEFT AND RIGHT TACK" . 10203)
+ ("LEFT MULTIMAP" . 10204)
+ ("LONG RIGHT TACK" . 10205)
+ ("LONG LEFT TACK" . 10206)
+ ("UP TACK WITH CIRCLE ABOVE" . 10207)
+ ("LOZENGE DIVIDED BY HORIZONTAL RULE" . 10208)
+ ("WHITE CONCAVE-SIDED DIAMOND" . 10209)
+ ("WHITE CONCAVE-SIDED DIAMOND WITH LEFTWARDS TICK" . 10210)
+ ("WHITE CONCAVE-SIDED DIAMOND WITH RIGHTWARDS TICK" . 10211)
+ ("WHITE SQUARE WITH LEFTWARDS TICK" . 10212)
+ ("WHITE SQUARE WITH RIGHTWARDS TICK" . 10213)
+ ("MATHEMATICAL LEFT WHITE SQUARE BRACKET" . 10214)
+ ("MATHEMATICAL RIGHT WHITE SQUARE BRACKET" . 10215)
+ ("MATHEMATICAL LEFT ANGLE BRACKET" . 10216)
+ ("MATHEMATICAL RIGHT ANGLE BRACKET" . 10217)
+ ("MATHEMATICAL LEFT DOUBLE ANGLE BRACKET" . 10218)
+ ("MATHEMATICAL RIGHT DOUBLE ANGLE BRACKET" . 10219)
+ ("UPWARDS QUADRUPLE ARROW" . 10224)
+ ("DOWNWARDS QUADRUPLE ARROW" . 10225)
+ ("ANTICLOCKWISE GAPPED CIRCLE ARROW" . 10226)
+ ("CLOCKWISE GAPPED CIRCLE ARROW" . 10227)
+ ("RIGHT ARROW WITH CIRCLED PLUS" . 10228)
+ ("LONG LEFTWARDS ARROW" . 10229)
+ ("LONG RIGHTWARDS ARROW" . 10230)
+ ("LONG LEFT RIGHT ARROW" . 10231)
+ ("LONG LEFTWARDS DOUBLE ARROW" . 10232)
+ ("LONG RIGHTWARDS DOUBLE ARROW" . 10233)
+ ("LONG LEFT RIGHT DOUBLE ARROW" . 10234)
+ ("LONG LEFTWARDS ARROW FROM BAR" . 10235)
+ ("LONG RIGHTWARDS ARROW FROM BAR" . 10236)
+ ("LONG LEFTWARDS DOUBLE ARROW FROM BAR" . 10237)
+ ("LONG RIGHTWARDS DOUBLE ARROW FROM BAR" . 10238)
+ ("LONG RIGHTWARDS SQUIGGLE ARROW" . 10239)
+ ("BRAILLE PATTERN BLANK" . 10240)
+ ("BRAILLE PATTERN DOTS-1" . 10241)
+ ("BRAILLE PATTERN DOTS-2" . 10242)
+ ("BRAILLE PATTERN DOTS-12" . 10243)
+ ("BRAILLE PATTERN DOTS-3" . 10244)
+ ("BRAILLE PATTERN DOTS-13" . 10245)
+ ("BRAILLE PATTERN DOTS-23" . 10246)
+ ("BRAILLE PATTERN DOTS-123" . 10247)
+ ("BRAILLE PATTERN DOTS-4" . 10248)
+ ("BRAILLE PATTERN DOTS-14" . 10249)
+ ("BRAILLE PATTERN DOTS-24" . 10250)
+ ("BRAILLE PATTERN DOTS-124" . 10251)
+ ("BRAILLE PATTERN DOTS-34" . 10252)
+ ("BRAILLE PATTERN DOTS-134" . 10253)
+ ("BRAILLE PATTERN DOTS-234" . 10254)
+ ("BRAILLE PATTERN DOTS-1234" . 10255)
+ ("BRAILLE PATTERN DOTS-5" . 10256)
+ ("BRAILLE PATTERN DOTS-15" . 10257)
+ ("BRAILLE PATTERN DOTS-25" . 10258)
+ ("BRAILLE PATTERN DOTS-125" . 10259)
+ ("BRAILLE PATTERN DOTS-35" . 10260)
+ ("BRAILLE PATTERN DOTS-135" . 10261)
+ ("BRAILLE PATTERN DOTS-235" . 10262)
+ ("BRAILLE PATTERN DOTS-1235" . 10263)
+ ("BRAILLE PATTERN DOTS-45" . 10264)
+ ("BRAILLE PATTERN DOTS-145" . 10265)
+ ("BRAILLE PATTERN DOTS-245" . 10266)
+ ("BRAILLE PATTERN DOTS-1245" . 10267)
+ ("BRAILLE PATTERN DOTS-345" . 10268)
+ ("BRAILLE PATTERN DOTS-1345" . 10269)
+ ("BRAILLE PATTERN DOTS-2345" . 10270)
+ ("BRAILLE PATTERN DOTS-12345" . 10271)
+ ("BRAILLE PATTERN DOTS-6" . 10272)
+ ("BRAILLE PATTERN DOTS-16" . 10273)
+ ("BRAILLE PATTERN DOTS-26" . 10274)
+ ("BRAILLE PATTERN DOTS-126" . 10275)
+ ("BRAILLE PATTERN DOTS-36" . 10276)
+ ("BRAILLE PATTERN DOTS-136" . 10277)
+ ("BRAILLE PATTERN DOTS-236" . 10278)
+ ("BRAILLE PATTERN DOTS-1236" . 10279)
+ ("BRAILLE PATTERN DOTS-46" . 10280)
+ ("BRAILLE PATTERN DOTS-146" . 10281)
+ ("BRAILLE PATTERN DOTS-246" . 10282)
+ ("BRAILLE PATTERN DOTS-1246" . 10283)
+ ("BRAILLE PATTERN DOTS-346" . 10284)
+ ("BRAILLE PATTERN DOTS-1346" . 10285)
+ ("BRAILLE PATTERN DOTS-2346" . 10286)
+ ("BRAILLE PATTERN DOTS-12346" . 10287)
+ ("BRAILLE PATTERN DOTS-56" . 10288)
+ ("BRAILLE PATTERN DOTS-156" . 10289)
+ ("BRAILLE PATTERN DOTS-256" . 10290)
+ ("BRAILLE PATTERN DOTS-1256" . 10291)
+ ("BRAILLE PATTERN DOTS-356" . 10292)
+ ("BRAILLE PATTERN DOTS-1356" . 10293)
+ ("BRAILLE PATTERN DOTS-2356" . 10294)
+ ("BRAILLE PATTERN DOTS-12356" . 10295)
+ ("BRAILLE PATTERN DOTS-456" . 10296)
+ ("BRAILLE PATTERN DOTS-1456" . 10297)
+ ("BRAILLE PATTERN DOTS-2456" . 10298)
+ ("BRAILLE PATTERN DOTS-12456" . 10299)
+ ("BRAILLE PATTERN DOTS-3456" . 10300)
+ ("BRAILLE PATTERN DOTS-13456" . 10301)
+ ("BRAILLE PATTERN DOTS-23456" . 10302)
+ ("BRAILLE PATTERN DOTS-123456" . 10303)
+ ("BRAILLE PATTERN DOTS-7" . 10304)
+ ("BRAILLE PATTERN DOTS-17" . 10305)
+ ("BRAILLE PATTERN DOTS-27" . 10306)
+ ("BRAILLE PATTERN DOTS-127" . 10307)
+ ("BRAILLE PATTERN DOTS-37" . 10308)
+ ("BRAILLE PATTERN DOTS-137" . 10309)
+ ("BRAILLE PATTERN DOTS-237" . 10310)
+ ("BRAILLE PATTERN DOTS-1237" . 10311)
+ ("BRAILLE PATTERN DOTS-47" . 10312)
+ ("BRAILLE PATTERN DOTS-147" . 10313)
+ ("BRAILLE PATTERN DOTS-247" . 10314)
+ ("BRAILLE PATTERN DOTS-1247" . 10315)
+ ("BRAILLE PATTERN DOTS-347" . 10316)
+ ("BRAILLE PATTERN DOTS-1347" . 10317)
+ ("BRAILLE PATTERN DOTS-2347" . 10318)
+ ("BRAILLE PATTERN DOTS-12347" . 10319)
+ ("BRAILLE PATTERN DOTS-57" . 10320)
+ ("BRAILLE PATTERN DOTS-157" . 10321)
+ ("BRAILLE PATTERN DOTS-257" . 10322)
+ ("BRAILLE PATTERN DOTS-1257" . 10323)
+ ("BRAILLE PATTERN DOTS-357" . 10324)
+ ("BRAILLE PATTERN DOTS-1357" . 10325)
+ ("BRAILLE PATTERN DOTS-2357" . 10326)
+ ("BRAILLE PATTERN DOTS-12357" . 10327)
+ ("BRAILLE PATTERN DOTS-457" . 10328)
+ ("BRAILLE PATTERN DOTS-1457" . 10329)
+ ("BRAILLE PATTERN DOTS-2457" . 10330)
+ ("BRAILLE PATTERN DOTS-12457" . 10331)
+ ("BRAILLE PATTERN DOTS-3457" . 10332)
+ ("BRAILLE PATTERN DOTS-13457" . 10333)
+ ("BRAILLE PATTERN DOTS-23457" . 10334)
+ ("BRAILLE PATTERN DOTS-123457" . 10335)
+ ("BRAILLE PATTERN DOTS-67" . 10336)
+ ("BRAILLE PATTERN DOTS-167" . 10337)
+ ("BRAILLE PATTERN DOTS-267" . 10338)
+ ("BRAILLE PATTERN DOTS-1267" . 10339)
+ ("BRAILLE PATTERN DOTS-367" . 10340)
+ ("BRAILLE PATTERN DOTS-1367" . 10341)
+ ("BRAILLE PATTERN DOTS-2367" . 10342)
+ ("BRAILLE PATTERN DOTS-12367" . 10343)
+ ("BRAILLE PATTERN DOTS-467" . 10344)
+ ("BRAILLE PATTERN DOTS-1467" . 10345)
+ ("BRAILLE PATTERN DOTS-2467" . 10346)
+ ("BRAILLE PATTERN DOTS-12467" . 10347)
+ ("BRAILLE PATTERN DOTS-3467" . 10348)
+ ("BRAILLE PATTERN DOTS-13467" . 10349)
+ ("BRAILLE PATTERN DOTS-23467" . 10350)
+ ("BRAILLE PATTERN DOTS-123467" . 10351)
+ ("BRAILLE PATTERN DOTS-567" . 10352)
+ ("BRAILLE PATTERN DOTS-1567" . 10353)
+ ("BRAILLE PATTERN DOTS-2567" . 10354)
+ ("BRAILLE PATTERN DOTS-12567" . 10355)
+ ("BRAILLE PATTERN DOTS-3567" . 10356)
+ ("BRAILLE PATTERN DOTS-13567" . 10357)
+ ("BRAILLE PATTERN DOTS-23567" . 10358)
+ ("BRAILLE PATTERN DOTS-123567" . 10359)
+ ("BRAILLE PATTERN DOTS-4567" . 10360)
+ ("BRAILLE PATTERN DOTS-14567" . 10361)
+ ("BRAILLE PATTERN DOTS-24567" . 10362)
+ ("BRAILLE PATTERN DOTS-124567" . 10363)
+ ("BRAILLE PATTERN DOTS-34567" . 10364)
+ ("BRAILLE PATTERN DOTS-134567" . 10365)
+ ("BRAILLE PATTERN DOTS-234567" . 10366)
+ ("BRAILLE PATTERN DOTS-1234567" . 10367)
+ ("BRAILLE PATTERN DOTS-8" . 10368)
+ ("BRAILLE PATTERN DOTS-18" . 10369)
+ ("BRAILLE PATTERN DOTS-28" . 10370)
+ ("BRAILLE PATTERN DOTS-128" . 10371)
+ ("BRAILLE PATTERN DOTS-38" . 10372)
+ ("BRAILLE PATTERN DOTS-138" . 10373)
+ ("BRAILLE PATTERN DOTS-238" . 10374)
+ ("BRAILLE PATTERN DOTS-1238" . 10375)
+ ("BRAILLE PATTERN DOTS-48" . 10376)
+ ("BRAILLE PATTERN DOTS-148" . 10377)
+ ("BRAILLE PATTERN DOTS-248" . 10378)
+ ("BRAILLE PATTERN DOTS-1248" . 10379)
+ ("BRAILLE PATTERN DOTS-348" . 10380)
+ ("BRAILLE PATTERN DOTS-1348" . 10381)
+ ("BRAILLE PATTERN DOTS-2348" . 10382)
+ ("BRAILLE PATTERN DOTS-12348" . 10383)
+ ("BRAILLE PATTERN DOTS-58" . 10384)
+ ("BRAILLE PATTERN DOTS-158" . 10385)
+ ("BRAILLE PATTERN DOTS-258" . 10386)
+ ("BRAILLE PATTERN DOTS-1258" . 10387)
+ ("BRAILLE PATTERN DOTS-358" . 10388)
+ ("BRAILLE PATTERN DOTS-1358" . 10389)
+ ("BRAILLE PATTERN DOTS-2358" . 10390)
+ ("BRAILLE PATTERN DOTS-12358" . 10391)
+ ("BRAILLE PATTERN DOTS-458" . 10392)
+ ("BRAILLE PATTERN DOTS-1458" . 10393)
+ ("BRAILLE PATTERN DOTS-2458" . 10394)
+ ("BRAILLE PATTERN DOTS-12458" . 10395)
+ ("BRAILLE PATTERN DOTS-3458" . 10396)
+ ("BRAILLE PATTERN DOTS-13458" . 10397)
+ ("BRAILLE PATTERN DOTS-23458" . 10398)
+ ("BRAILLE PATTERN DOTS-123458" . 10399)
+ ("BRAILLE PATTERN DOTS-68" . 10400)
+ ("BRAILLE PATTERN DOTS-168" . 10401)
+ ("BRAILLE PATTERN DOTS-268" . 10402)
+ ("BRAILLE PATTERN DOTS-1268" . 10403)
+ ("BRAILLE PATTERN DOTS-368" . 10404)
+ ("BRAILLE PATTERN DOTS-1368" . 10405)
+ ("BRAILLE PATTERN DOTS-2368" . 10406)
+ ("BRAILLE PATTERN DOTS-12368" . 10407)
+ ("BRAILLE PATTERN DOTS-468" . 10408)
+ ("BRAILLE PATTERN DOTS-1468" . 10409)
+ ("BRAILLE PATTERN DOTS-2468" . 10410)
+ ("BRAILLE PATTERN DOTS-12468" . 10411)
+ ("BRAILLE PATTERN DOTS-3468" . 10412)
+ ("BRAILLE PATTERN DOTS-13468" . 10413)
+ ("BRAILLE PATTERN DOTS-23468" . 10414)
+ ("BRAILLE PATTERN DOTS-123468" . 10415)
+ ("BRAILLE PATTERN DOTS-568" . 10416)
+ ("BRAILLE PATTERN DOTS-1568" . 10417)
+ ("BRAILLE PATTERN DOTS-2568" . 10418)
+ ("BRAILLE PATTERN DOTS-12568" . 10419)
+ ("BRAILLE PATTERN DOTS-3568" . 10420)
+ ("BRAILLE PATTERN DOTS-13568" . 10421)
+ ("BRAILLE PATTERN DOTS-23568" . 10422)
+ ("BRAILLE PATTERN DOTS-123568" . 10423)
+ ("BRAILLE PATTERN DOTS-4568" . 10424)
+ ("BRAILLE PATTERN DOTS-14568" . 10425)
+ ("BRAILLE PATTERN DOTS-24568" . 10426)
+ ("BRAILLE PATTERN DOTS-124568" . 10427)
+ ("BRAILLE PATTERN DOTS-34568" . 10428)
+ ("BRAILLE PATTERN DOTS-134568" . 10429)
+ ("BRAILLE PATTERN DOTS-234568" . 10430)
+ ("BRAILLE PATTERN DOTS-1234568" . 10431)
+ ("BRAILLE PATTERN DOTS-78" . 10432)
+ ("BRAILLE PATTERN DOTS-178" . 10433)
+ ("BRAILLE PATTERN DOTS-278" . 10434)
+ ("BRAILLE PATTERN DOTS-1278" . 10435)
+ ("BRAILLE PATTERN DOTS-378" . 10436)
+ ("BRAILLE PATTERN DOTS-1378" . 10437)
+ ("BRAILLE PATTERN DOTS-2378" . 10438)
+ ("BRAILLE PATTERN DOTS-12378" . 10439)
+ ("BRAILLE PATTERN DOTS-478" . 10440)
+ ("BRAILLE PATTERN DOTS-1478" . 10441)
+ ("BRAILLE PATTERN DOTS-2478" . 10442)
+ ("BRAILLE PATTERN DOTS-12478" . 10443)
+ ("BRAILLE PATTERN DOTS-3478" . 10444)
+ ("BRAILLE PATTERN DOTS-13478" . 10445)
+ ("BRAILLE PATTERN DOTS-23478" . 10446)
+ ("BRAILLE PATTERN DOTS-123478" . 10447)
+ ("BRAILLE PATTERN DOTS-578" . 10448)
+ ("BRAILLE PATTERN DOTS-1578" . 10449)
+ ("BRAILLE PATTERN DOTS-2578" . 10450)
+ ("BRAILLE PATTERN DOTS-12578" . 10451)
+ ("BRAILLE PATTERN DOTS-3578" . 10452)
+ ("BRAILLE PATTERN DOTS-13578" . 10453)
+ ("BRAILLE PATTERN DOTS-23578" . 10454)
+ ("BRAILLE PATTERN DOTS-123578" . 10455)
+ ("BRAILLE PATTERN DOTS-4578" . 10456)
+ ("BRAILLE PATTERN DOTS-14578" . 10457)
+ ("BRAILLE PATTERN DOTS-24578" . 10458)
+ ("BRAILLE PATTERN DOTS-124578" . 10459)
+ ("BRAILLE PATTERN DOTS-34578" . 10460)
+ ("BRAILLE PATTERN DOTS-134578" . 10461)
+ ("BRAILLE PATTERN DOTS-234578" . 10462)
+ ("BRAILLE PATTERN DOTS-1234578" . 10463)
+ ("BRAILLE PATTERN DOTS-678" . 10464)
+ ("BRAILLE PATTERN DOTS-1678" . 10465)
+ ("BRAILLE PATTERN DOTS-2678" . 10466)
+ ("BRAILLE PATTERN DOTS-12678" . 10467)
+ ("BRAILLE PATTERN DOTS-3678" . 10468)
+ ("BRAILLE PATTERN DOTS-13678" . 10469)
+ ("BRAILLE PATTERN DOTS-23678" . 10470)
+ ("BRAILLE PATTERN DOTS-123678" . 10471)
+ ("BRAILLE PATTERN DOTS-4678" . 10472)
+ ("BRAILLE PATTERN DOTS-14678" . 10473)
+ ("BRAILLE PATTERN DOTS-24678" . 10474)
+ ("BRAILLE PATTERN DOTS-124678" . 10475)
+ ("BRAILLE PATTERN DOTS-34678" . 10476)
+ ("BRAILLE PATTERN DOTS-134678" . 10477)
+ ("BRAILLE PATTERN DOTS-234678" . 10478)
+ ("BRAILLE PATTERN DOTS-1234678" . 10479)
+ ("BRAILLE PATTERN DOTS-5678" . 10480)
+ ("BRAILLE PATTERN DOTS-15678" . 10481)
+ ("BRAILLE PATTERN DOTS-25678" . 10482)
+ ("BRAILLE PATTERN DOTS-125678" . 10483)
+ ("BRAILLE PATTERN DOTS-35678" . 10484)
+ ("BRAILLE PATTERN DOTS-135678" . 10485)
+ ("BRAILLE PATTERN DOTS-235678" . 10486)
+ ("BRAILLE PATTERN DOTS-1235678" . 10487)
+ ("BRAILLE PATTERN DOTS-45678" . 10488)
+ ("BRAILLE PATTERN DOTS-145678" . 10489)
+ ("BRAILLE PATTERN DOTS-245678" . 10490)
+ ("BRAILLE PATTERN DOTS-1245678" . 10491)
+ ("BRAILLE PATTERN DOTS-345678" . 10492)
+ ("BRAILLE PATTERN DOTS-1345678" . 10493)
+ ("BRAILLE PATTERN DOTS-2345678" . 10494)
+ ("BRAILLE PATTERN DOTS-12345678" . 10495)
+ ("RIGHTWARDS TWO-HEADED ARROW WITH VERTICAL STROKE" . 10496)
+ ("RIGHTWARDS TWO-HEADED ARROW WITH DOUBLE VERTICAL STROKE" . 10497)
+ ("LEFTWARDS DOUBLE ARROW WITH VERTICAL STROKE" . 10498)
+ ("RIGHTWARDS DOUBLE ARROW WITH VERTICAL STROKE" . 10499)
+ ("LEFT RIGHT DOUBLE ARROW WITH VERTICAL STROKE" . 10500)
+ ("RIGHTWARDS TWO-HEADED ARROW FROM BAR" . 10501)
+ ("LEFTWARDS DOUBLE ARROW FROM BAR" . 10502)
+ ("RIGHTWARDS DOUBLE ARROW FROM BAR" . 10503)
+ ("DOWNWARDS ARROW WITH HORIZONTAL STROKE" . 10504)
+ ("UPWARDS ARROW WITH HORIZONTAL STROKE" . 10505)
+ ("UPWARDS TRIPLE ARROW" . 10506)
+ ("DOWNWARDS TRIPLE ARROW" . 10507)
+ ("LEFTWARDS DOUBLE DASH ARROW" . 10508)
+ ("RIGHTWARDS DOUBLE DASH ARROW" . 10509)
+ ("LEFTWARDS TRIPLE DASH ARROW" . 10510)
+ ("RIGHTWARDS TRIPLE DASH ARROW" . 10511)
+ ("RIGHTWARDS TWO-HEADED TRIPLE DASH ARROW" . 10512)
+ ("RIGHTWARDS ARROW WITH DOTTED STEM" . 10513)
+ ("UPWARDS ARROW TO BAR" . 10514)
+ ("DOWNWARDS ARROW TO BAR" . 10515)
+ ("RIGHTWARDS ARROW WITH TAIL WITH VERTICAL STROKE" . 10516)
+ ("RIGHTWARDS ARROW WITH TAIL WITH DOUBLE VERTICAL STROKE" . 10517)
+ ("RIGHTWARDS TWO-HEADED ARROW WITH TAIL" . 10518)
+ ("RIGHTWARDS TWO-HEADED ARROW WITH TAIL WITH VERTICAL STROKE" . 10519)
+ ("RIGHTWARDS TWO-HEADED ARROW WITH TAIL WITH DOUBLE VERTICAL STROKE" . 10520)
+ ("LEFTWARDS ARROW-TAIL" . 10521)
+ ("RIGHTWARDS ARROW-TAIL" . 10522)
+ ("LEFTWARDS DOUBLE ARROW-TAIL" . 10523)
+ ("RIGHTWARDS DOUBLE ARROW-TAIL" . 10524)
+ ("LEFTWARDS ARROW TO BLACK DIAMOND" . 10525)
+ ("RIGHTWARDS ARROW TO BLACK DIAMOND" . 10526)
+ ("LEFTWARDS ARROW FROM BAR TO BLACK DIAMOND" . 10527)
+ ("RIGHTWARDS ARROW FROM BAR TO BLACK DIAMOND" . 10528)
+ ("NORTH WEST AND SOUTH EAST ARROW" . 10529)
+ ("NORTH EAST AND SOUTH WEST ARROW" . 10530)
+ ("NORTH WEST ARROW WITH HOOK" . 10531)
+ ("NORTH EAST ARROW WITH HOOK" . 10532)
+ ("SOUTH EAST ARROW WITH HOOK" . 10533)
+ ("SOUTH WEST ARROW WITH HOOK" . 10534)
+ ("NORTH WEST ARROW AND NORTH EAST ARROW" . 10535)
+ ("NORTH EAST ARROW AND SOUTH EAST ARROW" . 10536)
+ ("SOUTH EAST ARROW AND SOUTH WEST ARROW" . 10537)
+ ("SOUTH WEST ARROW AND NORTH WEST ARROW" . 10538)
+ ("RISING DIAGONAL CROSSING FALLING DIAGONAL" . 10539)
+ ("FALLING DIAGONAL CROSSING RISING DIAGONAL" . 10540)
+ ("SOUTH EAST ARROW CROSSING NORTH EAST ARROW" . 10541)
+ ("NORTH EAST ARROW CROSSING SOUTH EAST ARROW" . 10542)
+ ("FALLING DIAGONAL CROSSING NORTH EAST ARROW" . 10543)
+ ("RISING DIAGONAL CROSSING SOUTH EAST ARROW" . 10544)
+ ("NORTH EAST ARROW CROSSING NORTH WEST ARROW" . 10545)
+ ("NORTH WEST ARROW CROSSING NORTH EAST ARROW" . 10546)
+ ("WAVE ARROW POINTING DIRECTLY RIGHT" . 10547)
+ ("ARROW POINTING RIGHTWARDS THEN CURVING UPWARDS" . 10548)
+ ("ARROW POINTING RIGHTWARDS THEN CURVING DOWNWARDS" . 10549)
+ ("ARROW POINTING DOWNWARDS THEN CURVING LEFTWARDS" . 10550)
+ ("ARROW POINTING DOWNWARDS THEN CURVING RIGHTWARDS" . 10551)
+ ("RIGHT-SIDE ARC CLOCKWISE ARROW" . 10552)
+ ("LEFT-SIDE ARC ANTICLOCKWISE ARROW" . 10553)
+ ("TOP ARC ANTICLOCKWISE ARROW" . 10554)
+ ("BOTTOM ARC ANTICLOCKWISE ARROW" . 10555)
+ ("TOP ARC CLOCKWISE ARROW WITH MINUS" . 10556)
+ ("TOP ARC ANTICLOCKWISE ARROW WITH PLUS" . 10557)
+ ("LOWER RIGHT SEMICIRCULAR CLOCKWISE ARROW" . 10558)
+ ("LOWER LEFT SEMICIRCULAR ANTICLOCKWISE ARROW" . 10559)
+ ("ANTICLOCKWISE CLOSED CIRCLE ARROW" . 10560)
+ ("CLOCKWISE CLOSED CIRCLE ARROW" . 10561)
+ ("RIGHTWARDS ARROW ABOVE SHORT LEFTWARDS ARROW" . 10562)
+ ("LEFTWARDS ARROW ABOVE SHORT RIGHTWARDS ARROW" . 10563)
+ ("SHORT RIGHTWARDS ARROW ABOVE LEFTWARDS ARROW" . 10564)
+ ("RIGHTWARDS ARROW WITH PLUS BELOW" . 10565)
+ ("LEFTWARDS ARROW WITH PLUS BELOW" . 10566)
+ ("RIGHTWARDS ARROW THROUGH X" . 10567)
+ ("LEFT RIGHT ARROW THROUGH SMALL CIRCLE" . 10568)
+ ("UPWARDS TWO-HEADED ARROW FROM SMALL CIRCLE" . 10569)
+ ("LEFT BARB UP RIGHT BARB DOWN HARPOON" . 10570)
+ ("LEFT BARB DOWN RIGHT BARB UP HARPOON" . 10571)
+ ("UP BARB RIGHT DOWN BARB LEFT HARPOON" . 10572)
+ ("UP BARB LEFT DOWN BARB RIGHT HARPOON" . 10573)
+ ("LEFT BARB UP RIGHT BARB UP HARPOON" . 10574)
+ ("UP BARB RIGHT DOWN BARB RIGHT HARPOON" . 10575)
+ ("LEFT BARB DOWN RIGHT BARB DOWN HARPOON" . 10576)
+ ("UP BARB LEFT DOWN BARB LEFT HARPOON" . 10577)
+ ("LEFTWARDS HARPOON WITH BARB UP TO BAR" . 10578)
+ ("RIGHTWARDS HARPOON WITH BARB UP TO BAR" . 10579)
+ ("UPWARDS HARPOON WITH BARB RIGHT TO BAR" . 10580)
+ ("DOWNWARDS HARPOON WITH BARB RIGHT TO BAR" . 10581)
+ ("LEFTWARDS HARPOON WITH BARB DOWN TO BAR" . 10582)
+ ("RIGHTWARDS HARPOON WITH BARB DOWN TO BAR" . 10583)
+ ("UPWARDS HARPOON WITH BARB LEFT TO BAR" . 10584)
+ ("DOWNWARDS HARPOON WITH BARB LEFT TO BAR" . 10585)
+ ("LEFTWARDS HARPOON WITH BARB UP FROM BAR" . 10586)
+ ("RIGHTWARDS HARPOON WITH BARB UP FROM BAR" . 10587)
+ ("UPWARDS HARPOON WITH BARB RIGHT FROM BAR" . 10588)
+ ("DOWNWARDS HARPOON WITH BARB RIGHT FROM BAR" . 10589)
+ ("LEFTWARDS HARPOON WITH BARB DOWN FROM BAR" . 10590)
+ ("RIGHTWARDS HARPOON WITH BARB DOWN FROM BAR" . 10591)
+ ("UPWARDS HARPOON WITH BARB LEFT FROM BAR" . 10592)
+ ("DOWNWARDS HARPOON WITH BARB LEFT FROM BAR" . 10593)
+ ("LEFTWARDS HARPOON WITH BARB UP ABOVE LEFTWARDS HARPOON WITH BARB DOWN" . 10594)
+ ("UPWARDS HARPOON WITH BARB LEFT BESIDE UPWARDS HARPOON WITH BARB RIGHT" . 10595)
+ ("RIGHTWARDS HARPOON WITH BARB UP ABOVE RIGHTWARDS HARPOON WITH BARB DOWN" . 10596)
+ ("DOWNWARDS HARPOON WITH BARB LEFT BESIDE DOWNWARDS HARPOON WITH BARB RIGHT" . 10597)
+ ("LEFTWARDS HARPOON WITH BARB UP ABOVE RIGHTWARDS HARPOON WITH BARB UP" . 10598)
+ ("LEFTWARDS HARPOON WITH BARB DOWN ABOVE RIGHTWARDS HARPOON WITH BARB DOWN" . 10599)
+ ("RIGHTWARDS HARPOON WITH BARB UP ABOVE LEFTWARDS HARPOON WITH BARB UP" . 10600)
+ ("RIGHTWARDS HARPOON WITH BARB DOWN ABOVE LEFTWARDS HARPOON WITH BARB DOWN" . 10601)
+ ("LEFTWARDS HARPOON WITH BARB UP ABOVE LONG DASH" . 10602)
+ ("LEFTWARDS HARPOON WITH BARB DOWN BELOW LONG DASH" . 10603)
+ ("RIGHTWARDS HARPOON WITH BARB UP ABOVE LONG DASH" . 10604)
+ ("RIGHTWARDS HARPOON WITH BARB DOWN BELOW LONG DASH" . 10605)
+ ("UPWARDS HARPOON WITH BARB LEFT BESIDE DOWNWARDS HARPOON WITH BARB RIGHT" . 10606)
+ ("DOWNWARDS HARPOON WITH BARB LEFT BESIDE UPWARDS HARPOON WITH BARB RIGHT" . 10607)
+ ("RIGHT DOUBLE ARROW WITH ROUNDED HEAD" . 10608)
+ ("EQUALS SIGN ABOVE RIGHTWARDS ARROW" . 10609)
+ ("TILDE OPERATOR ABOVE RIGHTWARDS ARROW" . 10610)
+ ("LEFTWARDS ARROW ABOVE TILDE OPERATOR" . 10611)
+ ("RIGHTWARDS ARROW ABOVE TILDE OPERATOR" . 10612)
+ ("RIGHTWARDS ARROW ABOVE ALMOST EQUAL TO" . 10613)
+ ("LESS-THAN ABOVE LEFTWARDS ARROW" . 10614)
+ ("LEFTWARDS ARROW THROUGH LESS-THAN" . 10615)
+ ("GREATER-THAN ABOVE RIGHTWARDS ARROW" . 10616)
+ ("SUBSET ABOVE RIGHTWARDS ARROW" . 10617)
+ ("LEFTWARDS ARROW THROUGH SUBSET" . 10618)
+ ("SUPERSET ABOVE LEFTWARDS ARROW" . 10619)
+ ("LEFT FISH TAIL" . 10620)
+ ("RIGHT FISH TAIL" . 10621)
+ ("UP FISH TAIL" . 10622)
+ ("DOWN FISH TAIL" . 10623)
+ ("TRIPLE VERTICAL BAR DELIMITER" . 10624)
+ ("Z NOTATION SPOT" . 10625)
+ ("Z NOTATION TYPE COLON" . 10626)
+ ("LEFT WHITE CURLY BRACKET" . 10627)
+ ("RIGHT WHITE CURLY BRACKET" . 10628)
+ ("LEFT WHITE PARENTHESIS" . 10629)
+ ("RIGHT WHITE PARENTHESIS" . 10630)
+ ("Z NOTATION LEFT IMAGE BRACKET" . 10631)
+ ("Z NOTATION RIGHT IMAGE BRACKET" . 10632)
+ ("Z NOTATION LEFT BINDING BRACKET" . 10633)
+ ("Z NOTATION RIGHT BINDING BRACKET" . 10634)
+ ("LEFT SQUARE BRACKET WITH UNDERBAR" . 10635)
+ ("RIGHT SQUARE BRACKET WITH UNDERBAR" . 10636)
+ ("LEFT SQUARE BRACKET WITH TICK IN TOP CORNER" . 10637)
+ ("RIGHT SQUARE BRACKET WITH TICK IN BOTTOM CORNER" . 10638)
+ ("LEFT SQUARE BRACKET WITH TICK IN BOTTOM CORNER" . 10639)
+ ("RIGHT SQUARE BRACKET WITH TICK IN TOP CORNER" . 10640)
+ ("LEFT ANGLE BRACKET WITH DOT" . 10641)
+ ("RIGHT ANGLE BRACKET WITH DOT" . 10642)
+ ("LEFT ARC LESS-THAN BRACKET" . 10643)
+ ("RIGHT ARC GREATER-THAN BRACKET" . 10644)
+ ("DOUBLE LEFT ARC GREATER-THAN BRACKET" . 10645)
+ ("DOUBLE RIGHT ARC LESS-THAN BRACKET" . 10646)
+ ("LEFT BLACK TORTOISE SHELL BRACKET" . 10647)
+ ("RIGHT BLACK TORTOISE SHELL BRACKET" . 10648)
+ ("DOTTED FENCE" . 10649)
+ ("VERTICAL ZIGZAG LINE" . 10650)
+ ("MEASURED ANGLE OPENING LEFT" . 10651)
+ ("RIGHT ANGLE VARIANT WITH SQUARE" . 10652)
+ ("MEASURED RIGHT ANGLE WITH DOT" . 10653)
+ ("ANGLE WITH S INSIDE" . 10654)
+ ("ACUTE ANGLE" . 10655)
+ ("SPHERICAL ANGLE OPENING LEFT" . 10656)
+ ("SPHERICAL ANGLE OPENING UP" . 10657)
+ ("TURNED ANGLE" . 10658)
+ ("REVERSED ANGLE" . 10659)
+ ("ANGLE WITH UNDERBAR" . 10660)
+ ("REVERSED ANGLE WITH UNDERBAR" . 10661)
+ ("OBLIQUE ANGLE OPENING UP" . 10662)
+ ("OBLIQUE ANGLE OPENING DOWN" . 10663)
+ ("MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING UP AND RIGHT" . 10664)
+ ("MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING UP AND LEFT" . 10665)
+ ("MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING DOWN AND RIGHT" . 10666)
+ ("MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING DOWN AND LEFT" . 10667)
+ ("MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING RIGHT AND UP" . 10668)
+ ("MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING LEFT AND UP" . 10669)
+ ("MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING RIGHT AND DOWN" . 10670)
+ ("MEASURED ANGLE WITH OPEN ARM ENDING IN ARROW POINTING LEFT AND DOWN" . 10671)
+ ("REVERSED EMPTY SET" . 10672)
+ ("EMPTY SET WITH OVERBAR" . 10673)
+ ("EMPTY SET WITH SMALL CIRCLE ABOVE" . 10674)
+ ("EMPTY SET WITH RIGHT ARROW ABOVE" . 10675)
+ ("EMPTY SET WITH LEFT ARROW ABOVE" . 10676)
+ ("CIRCLE WITH HORIZONTAL BAR" . 10677)
+ ("CIRCLED VERTICAL BAR" . 10678)
+ ("CIRCLED PARALLEL" . 10679)
+ ("CIRCLED REVERSE SOLIDUS" . 10680)
+ ("CIRCLED PERPENDICULAR" . 10681)
+ ("CIRCLE DIVIDED BY HORIZONTAL BAR AND TOP HALF DIVIDED BY VERTICAL BAR" . 10682)
+ ("CIRCLE WITH SUPERIMPOSED X" . 10683)
+ ("CIRCLED ANTICLOCKWISE-ROTATED DIVISION SIGN" . 10684)
+ ("UP ARROW THROUGH CIRCLE" . 10685)
+ ("CIRCLED WHITE BULLET" . 10686)
+ ("CIRCLED BULLET" . 10687)
+ ("CIRCLED LESS-THAN" . 10688)
+ ("CIRCLED GREATER-THAN" . 10689)
+ ("CIRCLE WITH SMALL CIRCLE TO THE RIGHT" . 10690)
+ ("CIRCLE WITH TWO HORIZONTAL STROKES TO THE RIGHT" . 10691)
+ ("SQUARED RISING DIAGONAL SLASH" . 10692)
+ ("SQUARED FALLING DIAGONAL SLASH" . 10693)
+ ("SQUARED ASTERISK" . 10694)
+ ("SQUARED SMALL CIRCLE" . 10695)
+ ("SQUARED SQUARE" . 10696)
+ ("TWO JOINED SQUARES" . 10697)
+ ("TRIANGLE WITH DOT ABOVE" . 10698)
+ ("TRIANGLE WITH UNDERBAR" . 10699)
+ ("S IN TRIANGLE" . 10700)
+ ("TRIANGLE WITH SERIFS AT BOTTOM" . 10701)
+ ("RIGHT TRIANGLE ABOVE LEFT TRIANGLE" . 10702)
+ ("LEFT TRIANGLE BESIDE VERTICAL BAR" . 10703)
+ ("VERTICAL BAR BESIDE RIGHT TRIANGLE" . 10704)
+ ("BOWTIE WITH LEFT HALF BLACK" . 10705)
+ ("BOWTIE WITH RIGHT HALF BLACK" . 10706)
+ ("BLACK BOWTIE" . 10707)
+ ("TIMES WITH LEFT HALF BLACK" . 10708)
+ ("TIMES WITH RIGHT HALF BLACK" . 10709)
+ ("WHITE HOURGLASS" . 10710)
+ ("BLACK HOURGLASS" . 10711)
+ ("LEFT WIGGLY FENCE" . 10712)
+ ("RIGHT WIGGLY FENCE" . 10713)
+ ("LEFT DOUBLE WIGGLY FENCE" . 10714)
+ ("RIGHT DOUBLE WIGGLY FENCE" . 10715)
+ ("INCOMPLETE INFINITY" . 10716)
+ ("TIE OVER INFINITY" . 10717)
+ ("INFINITY NEGATED WITH VERTICAL BAR" . 10718)
+ ("DOUBLE-ENDED MULTIMAP" . 10719)
+ ("SQUARE WITH CONTOURED OUTLINE" . 10720)
+ ("INCREASES AS" . 10721)
+ ("SHUFFLE PRODUCT" . 10722)
+ ("EQUALS SIGN AND SLANTED PARALLEL" . 10723)
+ ("EQUALS SIGN AND SLANTED PARALLEL WITH TILDE ABOVE" . 10724)
+ ("IDENTICAL TO AND SLANTED PARALLEL" . 10725)
+ ("GLEICH STARK" . 10726)
+ ("THERMODYNAMIC" . 10727)
+ ("DOWN-POINTING TRIANGLE WITH LEFT HALF BLACK" . 10728)
+ ("DOWN-POINTING TRIANGLE WITH RIGHT HALF BLACK" . 10729)
+ ("BLACK DIAMOND WITH DOWN ARROW" . 10730)
+ ("BLACK LOZENGE" . 10731)
+ ("WHITE CIRCLE WITH DOWN ARROW" . 10732)
+ ("BLACK CIRCLE WITH DOWN ARROW" . 10733)
+ ("ERROR-BARRED WHITE SQUARE" . 10734)
+ ("ERROR-BARRED BLACK SQUARE" . 10735)
+ ("ERROR-BARRED WHITE DIAMOND" . 10736)
+ ("ERROR-BARRED BLACK DIAMOND" . 10737)
+ ("ERROR-BARRED WHITE CIRCLE" . 10738)
+ ("ERROR-BARRED BLACK CIRCLE" . 10739)
+ ("RULE-DELAYED" . 10740)
+ ("REVERSE SOLIDUS OPERATOR" . 10741)
+ ("SOLIDUS WITH OVERBAR" . 10742)
+ ("REVERSE SOLIDUS WITH HORIZONTAL STROKE" . 10743)
+ ("BIG SOLIDUS" . 10744)
+ ("BIG REVERSE SOLIDUS" . 10745)
+ ("DOUBLE PLUS" . 10746)
+ ("TRIPLE PLUS" . 10747)
+ ("LEFT-POINTING CURVED ANGLE BRACKET" . 10748)
+ ("RIGHT-POINTING CURVED ANGLE BRACKET" . 10749)
+ ("TINY" . 10750)
+ ("MINY" . 10751)
+ ("N-ARY CIRCLED DOT OPERATOR" . 10752)
+ ("N-ARY CIRCLED PLUS OPERATOR" . 10753)
+ ("N-ARY CIRCLED TIMES OPERATOR" . 10754)
+ ("N-ARY UNION OPERATOR WITH DOT" . 10755)
+ ("N-ARY UNION OPERATOR WITH PLUS" . 10756)
+ ("N-ARY SQUARE INTERSECTION OPERATOR" . 10757)
+ ("N-ARY SQUARE UNION OPERATOR" . 10758)
+ ("TWO LOGICAL AND OPERATOR" . 10759)
+ ("TWO LOGICAL OR OPERATOR" . 10760)
+ ("N-ARY TIMES OPERATOR" . 10761)
+ ("MODULO TWO SUM" . 10762)
+ ("SUMMATION WITH INTEGRAL" . 10763)
+ ("QUADRUPLE INTEGRAL OPERATOR" . 10764)
+ ("FINITE PART INTEGRAL" . 10765)
+ ("INTEGRAL WITH DOUBLE STROKE" . 10766)
+ ("INTEGRAL AVERAGE WITH SLASH" . 10767)
+ ("CIRCULATION FUNCTION" . 10768)
+ ("ANTICLOCKWISE INTEGRATION" . 10769)
+ ("LINE INTEGRATION WITH RECTANGULAR PATH AROUND POLE" . 10770)
+ ("LINE INTEGRATION WITH SEMICIRCULAR PATH AROUND POLE" . 10771)
+ ("LINE INTEGRATION NOT INCLUDING THE POLE" . 10772)
+ ("INTEGRAL AROUND A POINT OPERATOR" . 10773)
+ ("QUATERNION INTEGRAL OPERATOR" . 10774)
+ ("INTEGRAL WITH LEFTWARDS ARROW WITH HOOK" . 10775)
+ ("INTEGRAL WITH TIMES SIGN" . 10776)
+ ("INTEGRAL WITH INTERSECTION" . 10777)
+ ("INTEGRAL WITH UNION" . 10778)
+ ("INTEGRAL WITH OVERBAR" . 10779)
+ ("INTEGRAL WITH UNDERBAR" . 10780)
+ ("JOIN" . 10781)
+ ("LARGE LEFT TRIANGLE OPERATOR" . 10782)
+ ("Z NOTATION SCHEMA COMPOSITION" . 10783)
+ ("Z NOTATION SCHEMA PIPING" . 10784)
+ ("Z NOTATION SCHEMA PROJECTION" . 10785)
+ ("PLUS SIGN WITH SMALL CIRCLE ABOVE" . 10786)
+ ("PLUS SIGN WITH CIRCUMFLEX ACCENT ABOVE" . 10787)
+ ("PLUS SIGN WITH TILDE ABOVE" . 10788)
+ ("PLUS SIGN WITH DOT BELOW" . 10789)
+ ("PLUS SIGN WITH TILDE BELOW" . 10790)
+ ("PLUS SIGN WITH SUBSCRIPT TWO" . 10791)
+ ("PLUS SIGN WITH BLACK TRIANGLE" . 10792)
+ ("MINUS SIGN WITH COMMA ABOVE" . 10793)
+ ("MINUS SIGN WITH DOT BELOW" . 10794)
+ ("MINUS SIGN WITH FALLING DOTS" . 10795)
+ ("MINUS SIGN WITH RISING DOTS" . 10796)
+ ("PLUS SIGN IN LEFT HALF CIRCLE" . 10797)
+ ("PLUS SIGN IN RIGHT HALF CIRCLE" . 10798)
+ ("VECTOR OR CROSS PRODUCT" . 10799)
+ ("MULTIPLICATION SIGN WITH DOT ABOVE" . 10800)
+ ("MULTIPLICATION SIGN WITH UNDERBAR" . 10801)
+ ("SEMIDIRECT PRODUCT WITH BOTTOM CLOSED" . 10802)
+ ("SMASH PRODUCT" . 10803)
+ ("MULTIPLICATION SIGN IN LEFT HALF CIRCLE" . 10804)
+ ("MULTIPLICATION SIGN IN RIGHT HALF CIRCLE" . 10805)
+ ("CIRCLED MULTIPLICATION SIGN WITH CIRCUMFLEX ACCENT" . 10806)
+ ("MULTIPLICATION SIGN IN DOUBLE CIRCLE" . 10807)
+ ("CIRCLED DIVISION SIGN" . 10808)
+ ("PLUS SIGN IN TRIANGLE" . 10809)
+ ("MINUS SIGN IN TRIANGLE" . 10810)
+ ("MULTIPLICATION SIGN IN TRIANGLE" . 10811)
+ ("INTERIOR PRODUCT" . 10812)
+ ("RIGHTHAND INTERIOR PRODUCT" . 10813)
+ ("Z NOTATION RELATIONAL COMPOSITION" . 10814)
+ ("AMALGAMATION OR COPRODUCT" . 10815)
+ ("INTERSECTION WITH DOT" . 10816)
+ ("UNION WITH MINUS SIGN" . 10817)
+ ("UNION WITH OVERBAR" . 10818)
+ ("INTERSECTION WITH OVERBAR" . 10819)
+ ("INTERSECTION WITH LOGICAL AND" . 10820)
+ ("UNION WITH LOGICAL OR" . 10821)
+ ("UNION ABOVE INTERSECTION" . 10822)
+ ("INTERSECTION ABOVE UNION" . 10823)
+ ("UNION ABOVE BAR ABOVE INTERSECTION" . 10824)
+ ("INTERSECTION ABOVE BAR ABOVE UNION" . 10825)
+ ("UNION BESIDE AND JOINED WITH UNION" . 10826)
+ ("INTERSECTION BESIDE AND JOINED WITH INTERSECTION" . 10827)
+ ("CLOSED UNION WITH SERIFS" . 10828)
+ ("CLOSED INTERSECTION WITH SERIFS" . 10829)
+ ("DOUBLE SQUARE INTERSECTION" . 10830)
+ ("DOUBLE SQUARE UNION" . 10831)
+ ("CLOSED UNION WITH SERIFS AND SMASH PRODUCT" . 10832)
+ ("LOGICAL AND WITH DOT ABOVE" . 10833)
+ ("LOGICAL OR WITH DOT ABOVE" . 10834)
+ ("DOUBLE LOGICAL AND" . 10835)
+ ("DOUBLE LOGICAL OR" . 10836)
+ ("TWO INTERSECTING LOGICAL AND" . 10837)
+ ("TWO INTERSECTING LOGICAL OR" . 10838)
+ ("SLOPING LARGE OR" . 10839)
+ ("SLOPING LARGE AND" . 10840)
+ ("LOGICAL OR OVERLAPPING LOGICAL AND" . 10841)
+ ("LOGICAL AND WITH MIDDLE STEM" . 10842)
+ ("LOGICAL OR WITH MIDDLE STEM" . 10843)
+ ("LOGICAL AND WITH HORIZONTAL DASH" . 10844)
+ ("LOGICAL OR WITH HORIZONTAL DASH" . 10845)
+ ("LOGICAL AND WITH DOUBLE OVERBAR" . 10846)
+ ("LOGICAL AND WITH UNDERBAR" . 10847)
+ ("LOGICAL AND WITH DOUBLE UNDERBAR" . 10848)
+ ("SMALL VEE WITH UNDERBAR" . 10849)
+ ("LOGICAL OR WITH DOUBLE OVERBAR" . 10850)
+ ("LOGICAL OR WITH DOUBLE UNDERBAR" . 10851)
+ ("Z NOTATION DOMAIN ANTIRESTRICTION" . 10852)
+ ("Z NOTATION RANGE ANTIRESTRICTION" . 10853)
+ ("EQUALS SIGN WITH DOT BELOW" . 10854)
+ ("IDENTICAL WITH DOT ABOVE" . 10855)
+ ("TRIPLE HORIZONTAL BAR WITH DOUBLE VERTICAL STROKE" . 10856)
+ ("TRIPLE HORIZONTAL BAR WITH TRIPLE VERTICAL STROKE" . 10857)
+ ("TILDE OPERATOR WITH DOT ABOVE" . 10858)
+ ("TILDE OPERATOR WITH RISING DOTS" . 10859)
+ ("SIMILAR MINUS SIMILAR" . 10860)
+ ("CONGRUENT WITH DOT ABOVE" . 10861)
+ ("EQUALS WITH ASTERISK" . 10862)
+ ("ALMOST EQUAL TO WITH CIRCUMFLEX ACCENT" . 10863)
+ ("APPROXIMATELY EQUAL OR EQUAL TO" . 10864)
+ ("EQUALS SIGN ABOVE PLUS SIGN" . 10865)
+ ("PLUS SIGN ABOVE EQUALS SIGN" . 10866)
+ ("EQUALS SIGN ABOVE TILDE OPERATOR" . 10867)
+ ("DOUBLE COLON EQUAL" . 10868)
+ ("TWO CONSECUTIVE EQUALS SIGNS" . 10869)
+ ("THREE CONSECUTIVE EQUALS SIGNS" . 10870)
+ ("EQUALS SIGN WITH TWO DOTS ABOVE AND TWO DOTS BELOW" . 10871)
+ ("EQUIVALENT WITH FOUR DOTS ABOVE" . 10872)
+ ("LESS-THAN WITH CIRCLE INSIDE" . 10873)
+ ("GREATER-THAN WITH CIRCLE INSIDE" . 10874)
+ ("LESS-THAN WITH QUESTION MARK ABOVE" . 10875)
+ ("GREATER-THAN WITH QUESTION MARK ABOVE" . 10876)
+ ("LESS-THAN OR SLANTED EQUAL TO" . 10877)
+ ("GREATER-THAN OR SLANTED EQUAL TO" . 10878)
+ ("LESS-THAN OR SLANTED EQUAL TO WITH DOT INSIDE" . 10879)
+ ("GREATER-THAN OR SLANTED EQUAL TO WITH DOT INSIDE" . 10880)
+ ("LESS-THAN OR SLANTED EQUAL TO WITH DOT ABOVE" . 10881)
+ ("GREATER-THAN OR SLANTED EQUAL TO WITH DOT ABOVE" . 10882)
+ ("LESS-THAN OR SLANTED EQUAL TO WITH DOT ABOVE RIGHT" . 10883)
+ ("GREATER-THAN OR SLANTED EQUAL TO WITH DOT ABOVE LEFT" . 10884)
+ ("LESS-THAN OR APPROXIMATE" . 10885)
+ ("GREATER-THAN OR APPROXIMATE" . 10886)
+ ("LESS-THAN AND SINGLE-LINE NOT EQUAL TO" . 10887)
+ ("GREATER-THAN AND SINGLE-LINE NOT EQUAL TO" . 10888)
+ ("LESS-THAN AND NOT APPROXIMATE" . 10889)
+ ("GREATER-THAN AND NOT APPROXIMATE" . 10890)
+ ("LESS-THAN ABOVE DOUBLE-LINE EQUAL ABOVE GREATER-THAN" . 10891)
+ ("GREATER-THAN ABOVE DOUBLE-LINE EQUAL ABOVE LESS-THAN" . 10892)
+ ("LESS-THAN ABOVE SIMILAR OR EQUAL" . 10893)
+ ("GREATER-THAN ABOVE SIMILAR OR EQUAL" . 10894)
+ ("LESS-THAN ABOVE SIMILAR ABOVE GREATER-THAN" . 10895)
+ ("GREATER-THAN ABOVE SIMILAR ABOVE LESS-THAN" . 10896)
+ ("LESS-THAN ABOVE GREATER-THAN ABOVE DOUBLE-LINE EQUAL" . 10897)
+ ("GREATER-THAN ABOVE LESS-THAN ABOVE DOUBLE-LINE EQUAL" . 10898)
+ ("LESS-THAN ABOVE SLANTED EQUAL ABOVE GREATER-THAN ABOVE SLANTED EQUAL" . 10899)
+ ("GREATER-THAN ABOVE SLANTED EQUAL ABOVE LESS-THAN ABOVE SLANTED EQUAL" . 10900)
+ ("SLANTED EQUAL TO OR LESS-THAN" . 10901)
+ ("SLANTED EQUAL TO OR GREATER-THAN" . 10902)
+ ("SLANTED EQUAL TO OR LESS-THAN WITH DOT INSIDE" . 10903)
+ ("SLANTED EQUAL TO OR GREATER-THAN WITH DOT INSIDE" . 10904)
+ ("DOUBLE-LINE EQUAL TO OR LESS-THAN" . 10905)
+ ("DOUBLE-LINE EQUAL TO OR GREATER-THAN" . 10906)
+ ("DOUBLE-LINE SLANTED EQUAL TO OR LESS-THAN" . 10907)
+ ("DOUBLE-LINE SLANTED EQUAL TO OR GREATER-THAN" . 10908)
+ ("SIMILAR OR LESS-THAN" . 10909)
+ ("SIMILAR OR GREATER-THAN" . 10910)
+ ("SIMILAR ABOVE LESS-THAN ABOVE EQUALS SIGN" . 10911)
+ ("SIMILAR ABOVE GREATER-THAN ABOVE EQUALS SIGN" . 10912)
+ ("DOUBLE NESTED LESS-THAN" . 10913)
+ ("DOUBLE NESTED GREATER-THAN" . 10914)
+ ("DOUBLE NESTED LESS-THAN WITH UNDERBAR" . 10915)
+ ("GREATER-THAN OVERLAPPING LESS-THAN" . 10916)
+ ("GREATER-THAN BESIDE LESS-THAN" . 10917)
+ ("LESS-THAN CLOSED BY CURVE" . 10918)
+ ("GREATER-THAN CLOSED BY CURVE" . 10919)
+ ("LESS-THAN CLOSED BY CURVE ABOVE SLANTED EQUAL" . 10920)
+ ("GREATER-THAN CLOSED BY CURVE ABOVE SLANTED EQUAL" . 10921)
+ ("SMALLER THAN" . 10922)
+ ("LARGER THAN" . 10923)
+ ("SMALLER THAN OR EQUAL TO" . 10924)
+ ("LARGER THAN OR EQUAL TO" . 10925)
+ ("EQUALS SIGN WITH BUMPY ABOVE" . 10926)
+ ("PRECEDES ABOVE SINGLE-LINE EQUALS SIGN" . 10927)
+ ("SUCCEEDS ABOVE SINGLE-LINE EQUALS SIGN" . 10928)
+ ("PRECEDES ABOVE SINGLE-LINE NOT EQUAL TO" . 10929)
+ ("SUCCEEDS ABOVE SINGLE-LINE NOT EQUAL TO" . 10930)
+ ("PRECEDES ABOVE EQUALS SIGN" . 10931)
+ ("SUCCEEDS ABOVE EQUALS SIGN" . 10932)
+ ("PRECEDES ABOVE NOT EQUAL TO" . 10933)
+ ("SUCCEEDS ABOVE NOT EQUAL TO" . 10934)
+ ("PRECEDES ABOVE ALMOST EQUAL TO" . 10935)
+ ("SUCCEEDS ABOVE ALMOST EQUAL TO" . 10936)
+ ("PRECEDES ABOVE NOT ALMOST EQUAL TO" . 10937)
+ ("SUCCEEDS ABOVE NOT ALMOST EQUAL TO" . 10938)
+ ("DOUBLE PRECEDES" . 10939)
+ ("DOUBLE SUCCEEDS" . 10940)
+ ("SUBSET WITH DOT" . 10941)
+ ("SUPERSET WITH DOT" . 10942)
+ ("SUBSET WITH PLUS SIGN BELOW" . 10943)
+ ("SUPERSET WITH PLUS SIGN BELOW" . 10944)
+ ("SUBSET WITH MULTIPLICATION SIGN BELOW" . 10945)
+ ("SUPERSET WITH MULTIPLICATION SIGN BELOW" . 10946)
+ ("SUBSET OF OR EQUAL TO WITH DOT ABOVE" . 10947)
+ ("SUPERSET OF OR EQUAL TO WITH DOT ABOVE" . 10948)
+ ("SUBSET OF ABOVE EQUALS SIGN" . 10949)
+ ("SUPERSET OF ABOVE EQUALS SIGN" . 10950)
+ ("SUBSET OF ABOVE TILDE OPERATOR" . 10951)
+ ("SUPERSET OF ABOVE TILDE OPERATOR" . 10952)
+ ("SUBSET OF ABOVE ALMOST EQUAL TO" . 10953)
+ ("SUPERSET OF ABOVE ALMOST EQUAL TO" . 10954)
+ ("SUBSET OF ABOVE NOT EQUAL TO" . 10955)
+ ("SUPERSET OF ABOVE NOT EQUAL TO" . 10956)
+ ("SQUARE LEFT OPEN BOX OPERATOR" . 10957)
+ ("SQUARE RIGHT OPEN BOX OPERATOR" . 10958)
+ ("CLOSED SUBSET" . 10959)
+ ("CLOSED SUPERSET" . 10960)
+ ("CLOSED SUBSET OR EQUAL TO" . 10961)
+ ("CLOSED SUPERSET OR EQUAL TO" . 10962)
+ ("SUBSET ABOVE SUPERSET" . 10963)
+ ("SUPERSET ABOVE SUBSET" . 10964)
+ ("SUBSET ABOVE SUBSET" . 10965)
+ ("SUPERSET ABOVE SUPERSET" . 10966)
+ ("SUPERSET BESIDE SUBSET" . 10967)
+ ("SUPERSET BESIDE AND JOINED BY DASH WITH SUBSET" . 10968)
+ ("ELEMENT OF OPENING DOWNWARDS" . 10969)
+ ("PITCHFORK WITH TEE TOP" . 10970)
+ ("TRANSVERSAL INTERSECTION" . 10971)
+ ("FORKING" . 10972)
+ ("NONFORKING" . 10973)
+ ("SHORT LEFT TACK" . 10974)
+ ("SHORT DOWN TACK" . 10975)
+ ("SHORT UP TACK" . 10976)
+ ("PERPENDICULAR WITH S" . 10977)
+ ("VERTICAL BAR TRIPLE RIGHT TURNSTILE" . 10978)
+ ("DOUBLE VERTICAL BAR LEFT TURNSTILE" . 10979)
+ ("VERTICAL BAR DOUBLE LEFT TURNSTILE" . 10980)
+ ("DOUBLE VERTICAL BAR DOUBLE LEFT TURNSTILE" . 10981)
+ ("LONG DASH FROM LEFT MEMBER OF DOUBLE VERTICAL" . 10982)
+ ("SHORT DOWN TACK WITH OVERBAR" . 10983)
+ ("SHORT UP TACK WITH UNDERBAR" . 10984)
+ ("SHORT UP TACK ABOVE SHORT DOWN TACK" . 10985)
+ ("DOUBLE DOWN TACK" . 10986)
+ ("DOUBLE UP TACK" . 10987)
+ ("DOUBLE STROKE NOT SIGN" . 10988)
+ ("REVERSED DOUBLE STROKE NOT SIGN" . 10989)
+ ("DOES NOT DIVIDE WITH REVERSED NEGATION SLASH" . 10990)
+ ("VERTICAL LINE WITH CIRCLE ABOVE" . 10991)
+ ("VERTICAL LINE WITH CIRCLE BELOW" . 10992)
+ ("DOWN TACK WITH CIRCLE BELOW" . 10993)
+ ("PARALLEL WITH HORIZONTAL STROKE" . 10994)
+ ("PARALLEL WITH TILDE OPERATOR" . 10995)
+ ("TRIPLE VERTICAL BAR BINARY RELATION" . 10996)
+ ("TRIPLE VERTICAL BAR WITH HORIZONTAL STROKE" . 10997)
+ ("TRIPLE COLON OPERATOR" . 10998)
+ ("TRIPLE NESTED LESS-THAN" . 10999)
+ ("TRIPLE NESTED GREATER-THAN" . 11000)
+ ("DOUBLE-LINE SLANTED LESS-THAN OR EQUAL TO" . 11001)
+ ("DOUBLE-LINE SLANTED GREATER-THAN OR EQUAL TO" . 11002)
+ ("TRIPLE SOLIDUS BINARY RELATION" . 11003)
+ ("LARGE TRIPLE VERTICAL BAR OPERATOR" . 11004)
+ ("DOUBLE SOLIDUS OPERATOR" . 11005)
+ ("WHITE VERTICAL BAR" . 11006)
+ ("N-ARY WHITE VERTICAL BAR" . 11007)
+ ("CJK RADICAL REPEAT" . 11904)
+ ("CJK RADICAL CLIFF" . 11905)
+ ("CJK RADICAL SECOND ONE" . 11906)
+ ("CJK RADICAL SECOND TWO" . 11907)
+ ("CJK RADICAL SECOND THREE" . 11908)
+ ("CJK RADICAL PERSON" . 11909)
+ ("CJK RADICAL BOX" . 11910)
+ ("CJK RADICAL TABLE" . 11911)
+ ("CJK RADICAL KNIFE ONE" . 11912)
+ ("CJK RADICAL KNIFE TWO" . 11913)
+ ("CJK RADICAL DIVINATION" . 11914)
+ ("CJK RADICAL SEAL" . 11915)
+ ("CJK RADICAL SMALL ONE" . 11916)
+ ("CJK RADICAL SMALL TWO" . 11917)
+ ("CJK RADICAL LAME ONE" . 11918)
+ ("CJK RADICAL LAME TWO" . 11919)
+ ("CJK RADICAL LAME THREE" . 11920)
+ ("CJK RADICAL LAME FOUR" . 11921)
+ ("CJK RADICAL SNAKE" . 11922)
+ ("CJK RADICAL THREAD" . 11923)
+ ("CJK RADICAL SNOUT ONE" . 11924)
+ ("CJK RADICAL SNOUT TWO" . 11925)
+ ("CJK RADICAL HEART ONE" . 11926)
+ ("CJK RADICAL HEART TWO" . 11927)
+ ("CJK RADICAL HAND" . 11928)
+ ("CJK RADICAL RAP" . 11929)
+ ("CJK RADICAL CHOKE" . 11931)
+ ("CJK RADICAL SUN" . 11932)
+ ("CJK RADICAL MOON" . 11933)
+ ("CJK RADICAL DEATH" . 11934)
+ ("CJK RADICAL MOTHER" . 11935)
+ ("CJK RADICAL CIVILIAN" . 11936)
+ ("CJK RADICAL WATER ONE" . 11937)
+ ("CJK RADICAL WATER TWO" . 11938)
+ ("CJK RADICAL FIRE" . 11939)
+ ("CJK RADICAL PAW ONE" . 11940)
+ ("CJK RADICAL PAW TWO" . 11941)
+ ("CJK RADICAL SIMPLIFIED HALF TREE TRUNK" . 11942)
+ ("CJK RADICAL COW" . 11943)
+ ("CJK RADICAL DOG" . 11944)
+ ("CJK RADICAL JADE" . 11945)
+ ("CJK RADICAL BOLT OF CLOTH" . 11946)
+ ("CJK RADICAL EYE" . 11947)
+ ("CJK RADICAL SPIRIT ONE" . 11948)
+ ("CJK RADICAL SPIRIT TWO" . 11949)
+ ("CJK RADICAL BAMBOO" . 11950)
+ ("CJK RADICAL SILK" . 11951)
+ ("CJK RADICAL C-SIMPLIFIED SILK" . 11952)
+ ("CJK RADICAL NET ONE" . 11953)
+ ("CJK RADICAL NET TWO" . 11954)
+ ("CJK RADICAL NET THREE" . 11955)
+ ("CJK RADICAL NET FOUR" . 11956)
+ ("CJK RADICAL MESH" . 11957)
+ ("CJK RADICAL SHEEP" . 11958)
+ ("CJK RADICAL RAM" . 11959)
+ ("CJK RADICAL EWE" . 11960)
+ ("CJK RADICAL OLD" . 11961)
+ ("CJK RADICAL BRUSH ONE" . 11962)
+ ("CJK RADICAL BRUSH TWO" . 11963)
+ ("CJK RADICAL MEAT" . 11964)
+ ("CJK RADICAL MORTAR" . 11965)
+ ("CJK RADICAL GRASS ONE" . 11966)
+ ("CJK RADICAL GRASS TWO" . 11967)
+ ("CJK RADICAL GRASS THREE" . 11968)
+ ("CJK RADICAL TIGER" . 11969)
+ ("CJK RADICAL CLOTHES" . 11970)
+ ("CJK RADICAL WEST ONE" . 11971)
+ ("CJK RADICAL WEST TWO" . 11972)
+ ("CJK RADICAL C-SIMPLIFIED SEE" . 11973)
+ ("CJK RADICAL SIMPLIFIED HORN" . 11974)
+ ("CJK RADICAL HORN" . 11975)
+ ("CJK RADICAL C-SIMPLIFIED SPEECH" . 11976)
+ ("CJK RADICAL C-SIMPLIFIED SHELL" . 11977)
+ ("CJK RADICAL FOOT" . 11978)
+ ("CJK RADICAL C-SIMPLIFIED CART" . 11979)
+ ("CJK RADICAL SIMPLIFIED WALK" . 11980)
+ ("CJK RADICAL WALK ONE" . 11981)
+ ("CJK RADICAL WALK TWO" . 11982)
+ ("CJK RADICAL CITY" . 11983)
+ ("CJK RADICAL C-SIMPLIFIED GOLD" . 11984)
+ ("CJK RADICAL LONG ONE" . 11985)
+ ("CJK RADICAL LONG TWO" . 11986)
+ ("CJK RADICAL C-SIMPLIFIED LONG" . 11987)
+ ("CJK RADICAL C-SIMPLIFIED GATE" . 11988)
+ ("CJK RADICAL MOUND ONE" . 11989)
+ ("CJK RADICAL MOUND TWO" . 11990)
+ ("CJK RADICAL RAIN" . 11991)
+ ("CJK RADICAL BLUE" . 11992)
+ ("CJK RADICAL C-SIMPLIFIED TANNED LEATHER" . 11993)
+ ("CJK RADICAL C-SIMPLIFIED LEAF" . 11994)
+ ("CJK RADICAL C-SIMPLIFIED WIND" . 11995)
+ ("CJK RADICAL C-SIMPLIFIED FLY" . 11996)
+ ("CJK RADICAL EAT ONE" . 11997)
+ ("CJK RADICAL EAT TWO" . 11998)
+ ("CJK RADICAL EAT THREE" . 11999)
+ ("CJK RADICAL C-SIMPLIFIED EAT" . 12000)
+ ("CJK RADICAL HEAD" . 12001)
+ ("CJK RADICAL C-SIMPLIFIED HORSE" . 12002)
+ ("CJK RADICAL BONE" . 12003)
+ ("CJK RADICAL GHOST" . 12004)
+ ("CJK RADICAL C-SIMPLIFIED FISH" . 12005)
+ ("CJK RADICAL C-SIMPLIFIED BIRD" . 12006)
+ ("CJK RADICAL C-SIMPLIFIED SALT" . 12007)
+ ("CJK RADICAL SIMPLIFIED WHEAT" . 12008)
+ ("CJK RADICAL SIMPLIFIED YELLOW" . 12009)
+ ("CJK RADICAL C-SIMPLIFIED FROG" . 12010)
+ ("CJK RADICAL J-SIMPLIFIED EVEN" . 12011)
+ ("CJK RADICAL C-SIMPLIFIED EVEN" . 12012)
+ ("CJK RADICAL J-SIMPLIFIED TOOTH" . 12013)
+ ("CJK RADICAL C-SIMPLIFIED TOOTH" . 12014)
+ ("CJK RADICAL J-SIMPLIFIED DRAGON" . 12015)
+ ("CJK RADICAL C-SIMPLIFIED DRAGON" . 12016)
+ ("CJK RADICAL TURTLE" . 12017)
+ ("CJK RADICAL J-SIMPLIFIED TURTLE" . 12018)
+ ("CJK RADICAL C-SIMPLIFIED TURTLE" . 12019)
+ ("KANGXI RADICAL ONE" . 12032)
+ ("KANGXI RADICAL LINE" . 12033)
+ ("KANGXI RADICAL DOT" . 12034)
+ ("KANGXI RADICAL SLASH" . 12035)
+ ("KANGXI RADICAL SECOND" . 12036)
+ ("KANGXI RADICAL HOOK" . 12037)
+ ("KANGXI RADICAL TWO" . 12038)
+ ("KANGXI RADICAL LID" . 12039)
+ ("KANGXI RADICAL MAN" . 12040)
+ ("KANGXI RADICAL LEGS" . 12041)
+ ("KANGXI RADICAL ENTER" . 12042)
+ ("KANGXI RADICAL EIGHT" . 12043)
+ ("KANGXI RADICAL DOWN BOX" . 12044)
+ ("KANGXI RADICAL COVER" . 12045)
+ ("KANGXI RADICAL ICE" . 12046)
+ ("KANGXI RADICAL TABLE" . 12047)
+ ("KANGXI RADICAL OPEN BOX" . 12048)
+ ("KANGXI RADICAL KNIFE" . 12049)
+ ("KANGXI RADICAL POWER" . 12050)
+ ("KANGXI RADICAL WRAP" . 12051)
+ ("KANGXI RADICAL SPOON" . 12052)
+ ("KANGXI RADICAL RIGHT OPEN BOX" . 12053)
+ ("KANGXI RADICAL HIDING ENCLOSURE" . 12054)
+ ("KANGXI RADICAL TEN" . 12055)
+ ("KANGXI RADICAL DIVINATION" . 12056)
+ ("KANGXI RADICAL SEAL" . 12057)
+ ("KANGXI RADICAL CLIFF" . 12058)
+ ("KANGXI RADICAL PRIVATE" . 12059)
+ ("KANGXI RADICAL AGAIN" . 12060)
+ ("KANGXI RADICAL MOUTH" . 12061)
+ ("KANGXI RADICAL ENCLOSURE" . 12062)
+ ("KANGXI RADICAL EARTH" . 12063)
+ ("KANGXI RADICAL SCHOLAR" . 12064)
+ ("KANGXI RADICAL GO" . 12065)
+ ("KANGXI RADICAL GO SLOWLY" . 12066)
+ ("KANGXI RADICAL EVENING" . 12067)
+ ("KANGXI RADICAL BIG" . 12068)
+ ("KANGXI RADICAL WOMAN" . 12069)
+ ("KANGXI RADICAL CHILD" . 12070)
+ ("KANGXI RADICAL ROOF" . 12071)
+ ("KANGXI RADICAL INCH" . 12072)
+ ("KANGXI RADICAL SMALL" . 12073)
+ ("KANGXI RADICAL LAME" . 12074)
+ ("KANGXI RADICAL CORPSE" . 12075)
+ ("KANGXI RADICAL SPROUT" . 12076)
+ ("KANGXI RADICAL MOUNTAIN" . 12077)
+ ("KANGXI RADICAL RIVER" . 12078)
+ ("KANGXI RADICAL WORK" . 12079)
+ ("KANGXI RADICAL ONESELF" . 12080)
+ ("KANGXI RADICAL TURBAN" . 12081)
+ ("KANGXI RADICAL DRY" . 12082)
+ ("KANGXI RADICAL SHORT THREAD" . 12083)
+ ("KANGXI RADICAL DOTTED CLIFF" . 12084)
+ ("KANGXI RADICAL LONG STRIDE" . 12085)
+ ("KANGXI RADICAL TWO HANDS" . 12086)
+ ("KANGXI RADICAL SHOOT" . 12087)
+ ("KANGXI RADICAL BOW" . 12088)
+ ("KANGXI RADICAL SNOUT" . 12089)
+ ("KANGXI RADICAL BRISTLE" . 12090)
+ ("KANGXI RADICAL STEP" . 12091)
+ ("KANGXI RADICAL HEART" . 12092)
+ ("KANGXI RADICAL HALBERD" . 12093)
+ ("KANGXI RADICAL DOOR" . 12094)
+ ("KANGXI RADICAL HAND" . 12095)
+ ("KANGXI RADICAL BRANCH" . 12096)
+ ("KANGXI RADICAL RAP" . 12097)
+ ("KANGXI RADICAL SCRIPT" . 12098)
+ ("KANGXI RADICAL DIPPER" . 12099)
+ ("KANGXI RADICAL AXE" . 12100)
+ ("KANGXI RADICAL SQUARE" . 12101)
+ ("KANGXI RADICAL NOT" . 12102)
+ ("KANGXI RADICAL SUN" . 12103)
+ ("KANGXI RADICAL SAY" . 12104)
+ ("KANGXI RADICAL MOON" . 12105)
+ ("KANGXI RADICAL TREE" . 12106)
+ ("KANGXI RADICAL LACK" . 12107)
+ ("KANGXI RADICAL STOP" . 12108)
+ ("KANGXI RADICAL DEATH" . 12109)
+ ("KANGXI RADICAL WEAPON" . 12110)
+ ("KANGXI RADICAL DO NOT" . 12111)
+ ("KANGXI RADICAL COMPARE" . 12112)
+ ("KANGXI RADICAL FUR" . 12113)
+ ("KANGXI RADICAL CLAN" . 12114)
+ ("KANGXI RADICAL STEAM" . 12115)
+ ("KANGXI RADICAL WATER" . 12116)
+ ("KANGXI RADICAL FIRE" . 12117)
+ ("KANGXI RADICAL CLAW" . 12118)
+ ("KANGXI RADICAL FATHER" . 12119)
+ ("KANGXI RADICAL DOUBLE X" . 12120)
+ ("KANGXI RADICAL HALF TREE TRUNK" . 12121)
+ ("KANGXI RADICAL SLICE" . 12122)
+ ("KANGXI RADICAL FANG" . 12123)
+ ("KANGXI RADICAL COW" . 12124)
+ ("KANGXI RADICAL DOG" . 12125)
+ ("KANGXI RADICAL PROFOUND" . 12126)
+ ("KANGXI RADICAL JADE" . 12127)
+ ("KANGXI RADICAL MELON" . 12128)
+ ("KANGXI RADICAL TILE" . 12129)
+ ("KANGXI RADICAL SWEET" . 12130)
+ ("KANGXI RADICAL LIFE" . 12131)
+ ("KANGXI RADICAL USE" . 12132)
+ ("KANGXI RADICAL FIELD" . 12133)
+ ("KANGXI RADICAL BOLT OF CLOTH" . 12134)
+ ("KANGXI RADICAL SICKNESS" . 12135)
+ ("KANGXI RADICAL DOTTED TENT" . 12136)
+ ("KANGXI RADICAL WHITE" . 12137)
+ ("KANGXI RADICAL SKIN" . 12138)
+ ("KANGXI RADICAL DISH" . 12139)
+ ("KANGXI RADICAL EYE" . 12140)
+ ("KANGXI RADICAL SPEAR" . 12141)
+ ("KANGXI RADICAL ARROW" . 12142)
+ ("KANGXI RADICAL STONE" . 12143)
+ ("KANGXI RADICAL SPIRIT" . 12144)
+ ("KANGXI RADICAL TRACK" . 12145)
+ ("KANGXI RADICAL GRAIN" . 12146)
+ ("KANGXI RADICAL CAVE" . 12147)
+ ("KANGXI RADICAL STAND" . 12148)
+ ("KANGXI RADICAL BAMBOO" . 12149)
+ ("KANGXI RADICAL RICE" . 12150)
+ ("KANGXI RADICAL SILK" . 12151)
+ ("KANGXI RADICAL JAR" . 12152)
+ ("KANGXI RADICAL NET" . 12153)
+ ("KANGXI RADICAL SHEEP" . 12154)
+ ("KANGXI RADICAL FEATHER" . 12155)
+ ("KANGXI RADICAL OLD" . 12156)
+ ("KANGXI RADICAL AND" . 12157)
+ ("KANGXI RADICAL PLOW" . 12158)
+ ("KANGXI RADICAL EAR" . 12159)
+ ("KANGXI RADICAL BRUSH" . 12160)
+ ("KANGXI RADICAL MEAT" . 12161)
+ ("KANGXI RADICAL MINISTER" . 12162)
+ ("KANGXI RADICAL SELF" . 12163)
+ ("KANGXI RADICAL ARRIVE" . 12164)
+ ("KANGXI RADICAL MORTAR" . 12165)
+ ("KANGXI RADICAL TONGUE" . 12166)
+ ("KANGXI RADICAL OPPOSE" . 12167)
+ ("KANGXI RADICAL BOAT" . 12168)
+ ("KANGXI RADICAL STOPPING" . 12169)
+ ("KANGXI RADICAL COLOR" . 12170)
+ ("KANGXI RADICAL GRASS" . 12171)
+ ("KANGXI RADICAL TIGER" . 12172)
+ ("KANGXI RADICAL INSECT" . 12173)
+ ("KANGXI RADICAL BLOOD" . 12174)
+ ("KANGXI RADICAL WALK ENCLOSURE" . 12175)
+ ("KANGXI RADICAL CLOTHES" . 12176)
+ ("KANGXI RADICAL WEST" . 12177)
+ ("KANGXI RADICAL SEE" . 12178)
+ ("KANGXI RADICAL HORN" . 12179)
+ ("KANGXI RADICAL SPEECH" . 12180)
+ ("KANGXI RADICAL VALLEY" . 12181)
+ ("KANGXI RADICAL BEAN" . 12182)
+ ("KANGXI RADICAL PIG" . 12183)
+ ("KANGXI RADICAL BADGER" . 12184)
+ ("KANGXI RADICAL SHELL" . 12185)
+ ("KANGXI RADICAL RED" . 12186)
+ ("KANGXI RADICAL RUN" . 12187)
+ ("KANGXI RADICAL FOOT" . 12188)
+ ("KANGXI RADICAL BODY" . 12189)
+ ("KANGXI RADICAL CART" . 12190)
+ ("KANGXI RADICAL BITTER" . 12191)
+ ("KANGXI RADICAL MORNING" . 12192)
+ ("KANGXI RADICAL WALK" . 12193)
+ ("KANGXI RADICAL CITY" . 12194)
+ ("KANGXI RADICAL WINE" . 12195)
+ ("KANGXI RADICAL DISTINGUISH" . 12196)
+ ("KANGXI RADICAL VILLAGE" . 12197)
+ ("KANGXI RADICAL GOLD" . 12198)
+ ("KANGXI RADICAL LONG" . 12199)
+ ("KANGXI RADICAL GATE" . 12200)
+ ("KANGXI RADICAL MOUND" . 12201)
+ ("KANGXI RADICAL SLAVE" . 12202)
+ ("KANGXI RADICAL SHORT TAILED BIRD" . 12203)
+ ("KANGXI RADICAL RAIN" . 12204)
+ ("KANGXI RADICAL BLUE" . 12205)
+ ("KANGXI RADICAL WRONG" . 12206)
+ ("KANGXI RADICAL FACE" . 12207)
+ ("KANGXI RADICAL LEATHER" . 12208)
+ ("KANGXI RADICAL TANNED LEATHER" . 12209)
+ ("KANGXI RADICAL LEEK" . 12210)
+ ("KANGXI RADICAL SOUND" . 12211)
+ ("KANGXI RADICAL LEAF" . 12212)
+ ("KANGXI RADICAL WIND" . 12213)
+ ("KANGXI RADICAL FLY" . 12214)
+ ("KANGXI RADICAL EAT" . 12215)
+ ("KANGXI RADICAL HEAD" . 12216)
+ ("KANGXI RADICAL FRAGRANT" . 12217)
+ ("KANGXI RADICAL HORSE" . 12218)
+ ("KANGXI RADICAL BONE" . 12219)
+ ("KANGXI RADICAL TALL" . 12220)
+ ("KANGXI RADICAL HAIR" . 12221)
+ ("KANGXI RADICAL FIGHT" . 12222)
+ ("KANGXI RADICAL SACRIFICIAL WINE" . 12223)
+ ("KANGXI RADICAL CAULDRON" . 12224)
+ ("KANGXI RADICAL GHOST" . 12225)
+ ("KANGXI RADICAL FISH" . 12226)
+ ("KANGXI RADICAL BIRD" . 12227)
+ ("KANGXI RADICAL SALT" . 12228)
+ ("KANGXI RADICAL DEER" . 12229)
+ ("KANGXI RADICAL WHEAT" . 12230)
+ ("KANGXI RADICAL HEMP" . 12231)
+ ("KANGXI RADICAL YELLOW" . 12232)
+ ("KANGXI RADICAL MILLET" . 12233)
+ ("KANGXI RADICAL BLACK" . 12234)
+ ("KANGXI RADICAL EMBROIDERY" . 12235)
+ ("KANGXI RADICAL FROG" . 12236)
+ ("KANGXI RADICAL TRIPOD" . 12237)
+ ("KANGXI RADICAL DRUM" . 12238)
+ ("KANGXI RADICAL RAT" . 12239)
+ ("KANGXI RADICAL NOSE" . 12240)
+ ("KANGXI RADICAL EVEN" . 12241)
+ ("KANGXI RADICAL TOOTH" . 12242)
+ ("KANGXI RADICAL DRAGON" . 12243)
+ ("KANGXI RADICAL TURTLE" . 12244)
+ ("KANGXI RADICAL FLUTE" . 12245)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER LEFT TO RIGHT" . 12272)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER ABOVE TO BELOW" . 12273)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER LEFT TO MIDDLE AND RIGHT" . 12274)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER ABOVE TO MIDDLE AND BELOW" . 12275)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER FULL SURROUND" . 12276)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM ABOVE" . 12277)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM BELOW" . 12278)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM LEFT" . 12279)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM UPPER LEFT" . 12280)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM UPPER RIGHT" . 12281)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER SURROUND FROM LOWER LEFT" . 12282)
+ ("IDEOGRAPHIC DESCRIPTION CHARACTER OVERLAID" . 12283)
+ ("IDEOGRAPHIC SPACE" . 12288)
+ ("IDEOGRAPHIC COMMA" . 12289)
+ ("IDEOGRAPHIC FULL STOP" . 12290)
+ ("DITTO MARK" . 12291)
+ ("JAPANESE INDUSTRIAL STANDARD SYMBOL" . 12292)
+ ("IDEOGRAPHIC ITERATION MARK" . 12293)
+ ("IDEOGRAPHIC CLOSING MARK" . 12294)
+ ("IDEOGRAPHIC NUMBER ZERO" . 12295)
+ ("LEFT ANGLE BRACKET" . 12296)
+ ("RIGHT ANGLE BRACKET" . 12297)
+ ("LEFT DOUBLE ANGLE BRACKET" . 12298)
+ ("RIGHT DOUBLE ANGLE BRACKET" . 12299)
+ ("LEFT CORNER BRACKET" . 12300)
+ ("RIGHT CORNER BRACKET" . 12301)
+ ("LEFT WHITE CORNER BRACKET" . 12302)
+ ("RIGHT WHITE CORNER BRACKET" . 12303)
+ ("LEFT BLACK LENTICULAR BRACKET" . 12304)
+ ("RIGHT BLACK LENTICULAR BRACKET" . 12305)
+ ("POSTAL MARK" . 12306)
+ ("GETA MARK" . 12307)
+ ("LEFT TORTOISE SHELL BRACKET" . 12308)
+ ("RIGHT TORTOISE SHELL BRACKET" . 12309)
+ ("LEFT WHITE LENTICULAR BRACKET" . 12310)
+ ("RIGHT WHITE LENTICULAR BRACKET" . 12311)
+ ("LEFT WHITE TORTOISE SHELL BRACKET" . 12312)
+ ("RIGHT WHITE TORTOISE SHELL BRACKET" . 12313)
+ ("LEFT WHITE SQUARE BRACKET" . 12314)
+ ("RIGHT WHITE SQUARE BRACKET" . 12315)
+ ("WAVE DASH" . 12316)
+ ("REVERSED DOUBLE PRIME QUOTATION MARK" . 12317)
+ ("DOUBLE PRIME QUOTATION MARK" . 12318)
+ ("LOW DOUBLE PRIME QUOTATION MARK" . 12319)
+ ("POSTAL MARK FACE" . 12320)
+ ("HANGZHOU NUMERAL ONE" . 12321)
+ ("HANGZHOU NUMERAL TWO" . 12322)
+ ("HANGZHOU NUMERAL THREE" . 12323)
+ ("HANGZHOU NUMERAL FOUR" . 12324)
+ ("HANGZHOU NUMERAL FIVE" . 12325)
+ ("HANGZHOU NUMERAL SIX" . 12326)
+ ("HANGZHOU NUMERAL SEVEN" . 12327)
+ ("HANGZHOU NUMERAL EIGHT" . 12328)
+ ("HANGZHOU NUMERAL NINE" . 12329)
+ ("IDEOGRAPHIC LEVEL TONE MARK" . 12330)
+ ("IDEOGRAPHIC RISING TONE MARK" . 12331)
+ ("IDEOGRAPHIC DEPARTING TONE MARK" . 12332)
+ ("IDEOGRAPHIC ENTERING TONE MARK" . 12333)
+ ("HANGUL SINGLE DOT TONE MARK" . 12334)
+ ("HANGUL DOUBLE DOT TONE MARK" . 12335)
+ ("WAVY DASH" . 12336)
+ ("VERTICAL KANA REPEAT MARK" . 12337)
+ ("VERTICAL KANA REPEAT WITH VOICED SOUND MARK" . 12338)
+ ("VERTICAL KANA REPEAT MARK UPPER HALF" . 12339)
+ ("VERTICAL KANA REPEAT WITH VOICED SOUND MARK UPPER HALF" . 12340)
+ ("VERTICAL KANA REPEAT MARK LOWER HALF" . 12341)
+ ("CIRCLED POSTAL MARK" . 12342)
+ ("IDEOGRAPHIC TELEGRAPH LINE FEED SEPARATOR SYMBOL" . 12343)
+ ("HANGZHOU NUMERAL TEN" . 12344)
+ ("HANGZHOU NUMERAL TWENTY" . 12345)
+ ("HANGZHOU NUMERAL THIRTY" . 12346)
+ ("VERTICAL IDEOGRAPHIC ITERATION MARK" . 12347)
+ ("MASU MARK" . 12348)
+ ("PART ALTERNATION MARK" . 12349)
+ ("IDEOGRAPHIC VARIATION INDICATOR" . 12350)
+ ("IDEOGRAPHIC HALF FILL SPACE" . 12351)
+ ("HIRAGANA LETTER SMALL A" . 12353)
+ ("HIRAGANA LETTER A" . 12354)
+ ("HIRAGANA LETTER SMALL I" . 12355)
+ ("HIRAGANA LETTER I" . 12356)
+ ("HIRAGANA LETTER SMALL U" . 12357)
+ ("HIRAGANA LETTER U" . 12358)
+ ("HIRAGANA LETTER SMALL E" . 12359)
+ ("HIRAGANA LETTER E" . 12360)
+ ("HIRAGANA LETTER SMALL O" . 12361)
+ ("HIRAGANA LETTER O" . 12362)
+ ("HIRAGANA LETTER KA" . 12363)
+ ("HIRAGANA LETTER GA" . 12364)
+ ("HIRAGANA LETTER KI" . 12365)
+ ("HIRAGANA LETTER GI" . 12366)
+ ("HIRAGANA LETTER KU" . 12367)
+ ("HIRAGANA LETTER GU" . 12368)
+ ("HIRAGANA LETTER KE" . 12369)
+ ("HIRAGANA LETTER GE" . 12370)
+ ("HIRAGANA LETTER KO" . 12371)
+ ("HIRAGANA LETTER GO" . 12372)
+ ("HIRAGANA LETTER SA" . 12373)
+ ("HIRAGANA LETTER ZA" . 12374)
+ ("HIRAGANA LETTER SI" . 12375)
+ ("HIRAGANA LETTER ZI" . 12376)
+ ("HIRAGANA LETTER SU" . 12377)
+ ("HIRAGANA LETTER ZU" . 12378)
+ ("HIRAGANA LETTER SE" . 12379)
+ ("HIRAGANA LETTER ZE" . 12380)
+ ("HIRAGANA LETTER SO" . 12381)
+ ("HIRAGANA LETTER ZO" . 12382)
+ ("HIRAGANA LETTER TA" . 12383)
+ ("HIRAGANA LETTER DA" . 12384)
+ ("HIRAGANA LETTER TI" . 12385)
+ ("HIRAGANA LETTER DI" . 12386)
+ ("HIRAGANA LETTER SMALL TU" . 12387)
+ ("HIRAGANA LETTER TU" . 12388)
+ ("HIRAGANA LETTER DU" . 12389)
+ ("HIRAGANA LETTER TE" . 12390)
+ ("HIRAGANA LETTER DE" . 12391)
+ ("HIRAGANA LETTER TO" . 12392)
+ ("HIRAGANA LETTER DO" . 12393)
+ ("HIRAGANA LETTER NA" . 12394)
+ ("HIRAGANA LETTER NI" . 12395)
+ ("HIRAGANA LETTER NU" . 12396)
+ ("HIRAGANA LETTER NE" . 12397)
+ ("HIRAGANA LETTER NO" . 12398)
+ ("HIRAGANA LETTER HA" . 12399)
+ ("HIRAGANA LETTER BA" . 12400)
+ ("HIRAGANA LETTER PA" . 12401)
+ ("HIRAGANA LETTER HI" . 12402)
+ ("HIRAGANA LETTER BI" . 12403)
+ ("HIRAGANA LETTER PI" . 12404)
+ ("HIRAGANA LETTER HU" . 12405)
+ ("HIRAGANA LETTER BU" . 12406)
+ ("HIRAGANA LETTER PU" . 12407)
+ ("HIRAGANA LETTER HE" . 12408)
+ ("HIRAGANA LETTER BE" . 12409)
+ ("HIRAGANA LETTER PE" . 12410)
+ ("HIRAGANA LETTER HO" . 12411)
+ ("HIRAGANA LETTER BO" . 12412)
+ ("HIRAGANA LETTER PO" . 12413)
+ ("HIRAGANA LETTER MA" . 12414)
+ ("HIRAGANA LETTER MI" . 12415)
+ ("HIRAGANA LETTER MU" . 12416)
+ ("HIRAGANA LETTER ME" . 12417)
+ ("HIRAGANA LETTER MO" . 12418)
+ ("HIRAGANA LETTER SMALL YA" . 12419)
+ ("HIRAGANA LETTER YA" . 12420)
+ ("HIRAGANA LETTER SMALL YU" . 12421)
+ ("HIRAGANA LETTER YU" . 12422)
+ ("HIRAGANA LETTER SMALL YO" . 12423)
+ ("HIRAGANA LETTER YO" . 12424)
+ ("HIRAGANA LETTER RA" . 12425)
+ ("HIRAGANA LETTER RI" . 12426)
+ ("HIRAGANA LETTER RU" . 12427)
+ ("HIRAGANA LETTER RE" . 12428)
+ ("HIRAGANA LETTER RO" . 12429)
+ ("HIRAGANA LETTER SMALL WA" . 12430)
+ ("HIRAGANA LETTER WA" . 12431)
+ ("HIRAGANA LETTER WI" . 12432)
+ ("HIRAGANA LETTER WE" . 12433)
+ ("HIRAGANA LETTER WO" . 12434)
+ ("HIRAGANA LETTER N" . 12435)
+ ("HIRAGANA LETTER VU" . 12436)
+ ("HIRAGANA LETTER SMALL KA" . 12437)
+ ("HIRAGANA LETTER SMALL KE" . 12438)
+ ("COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK" . 12441)
+ ("COMBINING KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK" . 12442)
+ ("KATAKANA-HIRAGANA VOICED SOUND MARK" . 12443)
+ ("KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK" . 12444)
+ ("HIRAGANA ITERATION MARK" . 12445)
+ ("HIRAGANA VOICED ITERATION MARK" . 12446)
+ ("HIRAGANA DIGRAPH YORI" . 12447)
+ ("KATAKANA-HIRAGANA DOUBLE HYPHEN" . 12448)
+ ("KATAKANA LETTER SMALL A" . 12449)
+ ("KATAKANA LETTER A" . 12450)
+ ("KATAKANA LETTER SMALL I" . 12451)
+ ("KATAKANA LETTER I" . 12452)
+ ("KATAKANA LETTER SMALL U" . 12453)
+ ("KATAKANA LETTER U" . 12454)
+ ("KATAKANA LETTER SMALL E" . 12455)
+ ("KATAKANA LETTER E" . 12456)
+ ("KATAKANA LETTER SMALL O" . 12457)
+ ("KATAKANA LETTER O" . 12458)
+ ("KATAKANA LETTER KA" . 12459)
+ ("KATAKANA LETTER GA" . 12460)
+ ("KATAKANA LETTER KI" . 12461)
+ ("KATAKANA LETTER GI" . 12462)
+ ("KATAKANA LETTER KU" . 12463)
+ ("KATAKANA LETTER GU" . 12464)
+ ("KATAKANA LETTER KE" . 12465)
+ ("KATAKANA LETTER GE" . 12466)
+ ("KATAKANA LETTER KO" . 12467)
+ ("KATAKANA LETTER GO" . 12468)
+ ("KATAKANA LETTER SA" . 12469)
+ ("KATAKANA LETTER ZA" . 12470)
+ ("KATAKANA LETTER SI" . 12471)
+ ("KATAKANA LETTER ZI" . 12472)
+ ("KATAKANA LETTER SU" . 12473)
+ ("KATAKANA LETTER ZU" . 12474)
+ ("KATAKANA LETTER SE" . 12475)
+ ("KATAKANA LETTER ZE" . 12476)
+ ("KATAKANA LETTER SO" . 12477)
+ ("KATAKANA LETTER ZO" . 12478)
+ ("KATAKANA LETTER TA" . 12479)
+ ("KATAKANA LETTER DA" . 12480)
+ ("KATAKANA LETTER TI" . 12481)
+ ("KATAKANA LETTER DI" . 12482)
+ ("KATAKANA LETTER SMALL TU" . 12483)
+ ("KATAKANA LETTER TU" . 12484)
+ ("KATAKANA LETTER DU" . 12485)
+ ("KATAKANA LETTER TE" . 12486)
+ ("KATAKANA LETTER DE" . 12487)
+ ("KATAKANA LETTER TO" . 12488)
+ ("KATAKANA LETTER DO" . 12489)
+ ("KATAKANA LETTER NA" . 12490)
+ ("KATAKANA LETTER NI" . 12491)
+ ("KATAKANA LETTER NU" . 12492)
+ ("KATAKANA LETTER NE" . 12493)
+ ("KATAKANA LETTER NO" . 12494)
+ ("KATAKANA LETTER HA" . 12495)
+ ("KATAKANA LETTER BA" . 12496)
+ ("KATAKANA LETTER PA" . 12497)
+ ("KATAKANA LETTER HI" . 12498)
+ ("KATAKANA LETTER BI" . 12499)
+ ("KATAKANA LETTER PI" . 12500)
+ ("KATAKANA LETTER HU" . 12501)
+ ("KATAKANA LETTER BU" . 12502)
+ ("KATAKANA LETTER PU" . 12503)
+ ("KATAKANA LETTER HE" . 12504)
+ ("KATAKANA LETTER BE" . 12505)
+ ("KATAKANA LETTER PE" . 12506)
+ ("KATAKANA LETTER HO" . 12507)
+ ("KATAKANA LETTER BO" . 12508)
+ ("KATAKANA LETTER PO" . 12509)
+ ("KATAKANA LETTER MA" . 12510)
+ ("KATAKANA LETTER MI" . 12511)
+ ("KATAKANA LETTER MU" . 12512)
+ ("KATAKANA LETTER ME" . 12513)
+ ("KATAKANA LETTER MO" . 12514)
+ ("KATAKANA LETTER SMALL YA" . 12515)
+ ("KATAKANA LETTER YA" . 12516)
+ ("KATAKANA LETTER SMALL YU" . 12517)
+ ("KATAKANA LETTER YU" . 12518)
+ ("KATAKANA LETTER SMALL YO" . 12519)
+ ("KATAKANA LETTER YO" . 12520)
+ ("KATAKANA LETTER RA" . 12521)
+ ("KATAKANA LETTER RI" . 12522)
+ ("KATAKANA LETTER RU" . 12523)
+ ("KATAKANA LETTER RE" . 12524)
+ ("KATAKANA LETTER RO" . 12525)
+ ("KATAKANA LETTER SMALL WA" . 12526)
+ ("KATAKANA LETTER WA" . 12527)
+ ("KATAKANA LETTER WI" . 12528)
+ ("KATAKANA LETTER WE" . 12529)
+ ("KATAKANA LETTER WO" . 12530)
+ ("KATAKANA LETTER N" . 12531)
+ ("KATAKANA LETTER VU" . 12532)
+ ("KATAKANA LETTER SMALL KA" . 12533)
+ ("KATAKANA LETTER SMALL KE" . 12534)
+ ("KATAKANA LETTER VA" . 12535)
+ ("KATAKANA LETTER VI" . 12536)
+ ("KATAKANA LETTER VE" . 12537)
+ ("KATAKANA LETTER VO" . 12538)
+ ("KATAKANA MIDDLE DOT" . 12539)
+ ("KATAKANA-HIRAGANA PROLONGED SOUND MARK" . 12540)
+ ("KATAKANA ITERATION MARK" . 12541)
+ ("KATAKANA VOICED ITERATION MARK" . 12542)
+ ("KATAKANA DIGRAPH KOTO" . 12543)
+ ("BOPOMOFO LETTER B" . 12549)
+ ("BOPOMOFO LETTER P" . 12550)
+ ("BOPOMOFO LETTER M" . 12551)
+ ("BOPOMOFO LETTER F" . 12552)
+ ("BOPOMOFO LETTER D" . 12553)
+ ("BOPOMOFO LETTER T" . 12554)
+ ("BOPOMOFO LETTER N" . 12555)
+ ("BOPOMOFO LETTER L" . 12556)
+ ("BOPOMOFO LETTER G" . 12557)
+ ("BOPOMOFO LETTER K" . 12558)
+ ("BOPOMOFO LETTER H" . 12559)
+ ("BOPOMOFO LETTER J" . 12560)
+ ("BOPOMOFO LETTER Q" . 12561)
+ ("BOPOMOFO LETTER X" . 12562)
+ ("BOPOMOFO LETTER ZH" . 12563)
+ ("BOPOMOFO LETTER CH" . 12564)
+ ("BOPOMOFO LETTER SH" . 12565)
+ ("BOPOMOFO LETTER R" . 12566)
+ ("BOPOMOFO LETTER Z" . 12567)
+ ("BOPOMOFO LETTER C" . 12568)
+ ("BOPOMOFO LETTER S" . 12569)
+ ("BOPOMOFO LETTER A" . 12570)
+ ("BOPOMOFO LETTER O" . 12571)
+ ("BOPOMOFO LETTER E" . 12572)
+ ("BOPOMOFO LETTER EH" . 12573)
+ ("BOPOMOFO LETTER AI" . 12574)
+ ("BOPOMOFO LETTER EI" . 12575)
+ ("BOPOMOFO LETTER AU" . 12576)
+ ("BOPOMOFO LETTER OU" . 12577)
+ ("BOPOMOFO LETTER AN" . 12578)
+ ("BOPOMOFO LETTER EN" . 12579)
+ ("BOPOMOFO LETTER ANG" . 12580)
+ ("BOPOMOFO LETTER ENG" . 12581)
+ ("BOPOMOFO LETTER ER" . 12582)
+ ("BOPOMOFO LETTER I" . 12583)
+ ("BOPOMOFO LETTER U" . 12584)
+ ("BOPOMOFO LETTER IU" . 12585)
+ ("BOPOMOFO LETTER V" . 12586)
+ ("BOPOMOFO LETTER NG" . 12587)
+ ("BOPOMOFO LETTER GN" . 12588)
+ ("HANGUL LETTER KIYEOK" . 12593)
+ ("HANGUL LETTER SSANGKIYEOK" . 12594)
+ ("HANGUL LETTER KIYEOK-SIOS" . 12595)
+ ("HANGUL LETTER NIEUN" . 12596)
+ ("HANGUL LETTER NIEUN-CIEUC" . 12597)
+ ("HANGUL LETTER NIEUN-HIEUH" . 12598)
+ ("HANGUL LETTER TIKEUT" . 12599)
+ ("HANGUL LETTER SSANGTIKEUT" . 12600)
+ ("HANGUL LETTER RIEUL" . 12601)
+ ("HANGUL LETTER RIEUL-KIYEOK" . 12602)
+ ("HANGUL LETTER RIEUL-MIEUM" . 12603)
+ ("HANGUL LETTER RIEUL-PIEUP" . 12604)
+ ("HANGUL LETTER RIEUL-SIOS" . 12605)
+ ("HANGUL LETTER RIEUL-THIEUTH" . 12606)
+ ("HANGUL LETTER RIEUL-PHIEUPH" . 12607)
+ ("HANGUL LETTER RIEUL-HIEUH" . 12608)
+ ("HANGUL LETTER MIEUM" . 12609)
+ ("HANGUL LETTER PIEUP" . 12610)
+ ("HANGUL LETTER SSANGPIEUP" . 12611)
+ ("HANGUL LETTER PIEUP-SIOS" . 12612)
+ ("HANGUL LETTER SIOS" . 12613)
+ ("HANGUL LETTER SSANGSIOS" . 12614)
+ ("HANGUL LETTER IEUNG" . 12615)
+ ("HANGUL LETTER CIEUC" . 12616)
+ ("HANGUL LETTER SSANGCIEUC" . 12617)
+ ("HANGUL LETTER CHIEUCH" . 12618)
+ ("HANGUL LETTER KHIEUKH" . 12619)
+ ("HANGUL LETTER THIEUTH" . 12620)
+ ("HANGUL LETTER PHIEUPH" . 12621)
+ ("HANGUL LETTER HIEUH" . 12622)
+ ("HANGUL LETTER A" . 12623)
+ ("HANGUL LETTER AE" . 12624)
+ ("HANGUL LETTER YA" . 12625)
+ ("HANGUL LETTER YAE" . 12626)
+ ("HANGUL LETTER EO" . 12627)
+ ("HANGUL LETTER E" . 12628)
+ ("HANGUL LETTER YEO" . 12629)
+ ("HANGUL LETTER YE" . 12630)
+ ("HANGUL LETTER O" . 12631)
+ ("HANGUL LETTER WA" . 12632)
+ ("HANGUL LETTER WAE" . 12633)
+ ("HANGUL LETTER OE" . 12634)
+ ("HANGUL LETTER YO" . 12635)
+ ("HANGUL LETTER U" . 12636)
+ ("HANGUL LETTER WEO" . 12637)
+ ("HANGUL LETTER WE" . 12638)
+ ("HANGUL LETTER WI" . 12639)
+ ("HANGUL LETTER YU" . 12640)
+ ("HANGUL LETTER EU" . 12641)
+ ("HANGUL LETTER YI" . 12642)
+ ("HANGUL LETTER I" . 12643)
+ ("HANGUL FILLER" . 12644)
+ ("HANGUL LETTER SSANGNIEUN" . 12645)
+ ("HANGUL LETTER NIEUN-TIKEUT" . 12646)
+ ("HANGUL LETTER NIEUN-SIOS" . 12647)
+ ("HANGUL LETTER NIEUN-PANSIOS" . 12648)
+ ("HANGUL LETTER RIEUL-KIYEOK-SIOS" . 12649)
+ ("HANGUL LETTER RIEUL-TIKEUT" . 12650)
+ ("HANGUL LETTER RIEUL-PIEUP-SIOS" . 12651)
+ ("HANGUL LETTER RIEUL-PANSIOS" . 12652)
+ ("HANGUL LETTER RIEUL-YEORINHIEUH" . 12653)
+ ("HANGUL LETTER MIEUM-PIEUP" . 12654)
+ ("HANGUL LETTER MIEUM-SIOS" . 12655)
+ ("HANGUL LETTER MIEUM-PANSIOS" . 12656)
+ ("HANGUL LETTER KAPYEOUNMIEUM" . 12657)
+ ("HANGUL LETTER PIEUP-KIYEOK" . 12658)
+ ("HANGUL LETTER PIEUP-TIKEUT" . 12659)
+ ("HANGUL LETTER PIEUP-SIOS-KIYEOK" . 12660)
+ ("HANGUL LETTER PIEUP-SIOS-TIKEUT" . 12661)
+ ("HANGUL LETTER PIEUP-CIEUC" . 12662)
+ ("HANGUL LETTER PIEUP-THIEUTH" . 12663)
+ ("HANGUL LETTER KAPYEOUNPIEUP" . 12664)
+ ("HANGUL LETTER KAPYEOUNSSANGPIEUP" . 12665)
+ ("HANGUL LETTER SIOS-KIYEOK" . 12666)
+ ("HANGUL LETTER SIOS-NIEUN" . 12667)
+ ("HANGUL LETTER SIOS-TIKEUT" . 12668)
+ ("HANGUL LETTER SIOS-PIEUP" . 12669)
+ ("HANGUL LETTER SIOS-CIEUC" . 12670)
+ ("HANGUL LETTER PANSIOS" . 12671)
+ ("HANGUL LETTER SSANGIEUNG" . 12672)
+ ("HANGUL LETTER YESIEUNG" . 12673)
+ ("HANGUL LETTER YESIEUNG-SIOS" . 12674)
+ ("HANGUL LETTER YESIEUNG-PANSIOS" . 12675)
+ ("HANGUL LETTER KAPYEOUNPHIEUPH" . 12676)
+ ("HANGUL LETTER SSANGHIEUH" . 12677)
+ ("HANGUL LETTER YEORINHIEUH" . 12678)
+ ("HANGUL LETTER YO-YA" . 12679)
+ ("HANGUL LETTER YO-YAE" . 12680)
+ ("HANGUL LETTER YO-I" . 12681)
+ ("HANGUL LETTER YU-YEO" . 12682)
+ ("HANGUL LETTER YU-YE" . 12683)
+ ("HANGUL LETTER YU-I" . 12684)
+ ("HANGUL LETTER ARAEA" . 12685)
+ ("HANGUL LETTER ARAEAE" . 12686)
+ ("IDEOGRAPHIC ANNOTATION LINKING MARK" . 12688)
+ ("IDEOGRAPHIC ANNOTATION REVERSE MARK" . 12689)
+ ("IDEOGRAPHIC ANNOTATION ONE MARK" . 12690)
+ ("IDEOGRAPHIC ANNOTATION TWO MARK" . 12691)
+ ("IDEOGRAPHIC ANNOTATION THREE MARK" . 12692)
+ ("IDEOGRAPHIC ANNOTATION FOUR MARK" . 12693)
+ ("IDEOGRAPHIC ANNOTATION TOP MARK" . 12694)
+ ("IDEOGRAPHIC ANNOTATION MIDDLE MARK" . 12695)
+ ("IDEOGRAPHIC ANNOTATION BOTTOM MARK" . 12696)
+ ("IDEOGRAPHIC ANNOTATION FIRST MARK" . 12697)
+ ("IDEOGRAPHIC ANNOTATION SECOND MARK" . 12698)
+ ("IDEOGRAPHIC ANNOTATION THIRD MARK" . 12699)
+ ("IDEOGRAPHIC ANNOTATION FOURTH MARK" . 12700)
+ ("IDEOGRAPHIC ANNOTATION HEAVEN MARK" . 12701)
+ ("IDEOGRAPHIC ANNOTATION EARTH MARK" . 12702)
+ ("IDEOGRAPHIC ANNOTATION MAN MARK" . 12703)
+ ("BOPOMOFO LETTER BU" . 12704)
+ ("BOPOMOFO LETTER ZI" . 12705)
+ ("BOPOMOFO LETTER JI" . 12706)
+ ("BOPOMOFO LETTER GU" . 12707)
+ ("BOPOMOFO LETTER EE" . 12708)
+ ("BOPOMOFO LETTER ENN" . 12709)
+ ("BOPOMOFO LETTER OO" . 12710)
+ ("BOPOMOFO LETTER ONN" . 12711)
+ ("BOPOMOFO LETTER IR" . 12712)
+ ("BOPOMOFO LETTER ANN" . 12713)
+ ("BOPOMOFO LETTER INN" . 12714)
+ ("BOPOMOFO LETTER UNN" . 12715)
+ ("BOPOMOFO LETTER IM" . 12716)
+ ("BOPOMOFO LETTER NGG" . 12717)
+ ("BOPOMOFO LETTER AINN" . 12718)
+ ("BOPOMOFO LETTER AUNN" . 12719)
+ ("BOPOMOFO LETTER AM" . 12720)
+ ("BOPOMOFO LETTER OM" . 12721)
+ ("BOPOMOFO LETTER ONG" . 12722)
+ ("BOPOMOFO LETTER INNN" . 12723)
+ ("BOPOMOFO FINAL LETTER P" . 12724)
+ ("BOPOMOFO FINAL LETTER T" . 12725)
+ ("BOPOMOFO FINAL LETTER K" . 12726)
+ ("BOPOMOFO FINAL LETTER H" . 12727)
+ ("KATAKANA LETTER SMALL KU" . 12784)
+ ("KATAKANA LETTER SMALL SI" . 12785)
+ ("KATAKANA LETTER SMALL SU" . 12786)
+ ("KATAKANA LETTER SMALL TO" . 12787)
+ ("KATAKANA LETTER SMALL NU" . 12788)
+ ("KATAKANA LETTER SMALL HA" . 12789)
+ ("KATAKANA LETTER SMALL HI" . 12790)
+ ("KATAKANA LETTER SMALL HU" . 12791)
+ ("KATAKANA LETTER SMALL HE" . 12792)
+ ("KATAKANA LETTER SMALL HO" . 12793)
+ ("KATAKANA LETTER SMALL MU" . 12794)
+ ("KATAKANA LETTER SMALL RA" . 12795)
+ ("KATAKANA LETTER SMALL RI" . 12796)
+ ("KATAKANA LETTER SMALL RU" . 12797)
+ ("KATAKANA LETTER SMALL RE" . 12798)
+ ("KATAKANA LETTER SMALL RO" . 12799)
+ ("PARENTHESIZED HANGUL KIYEOK" . 12800)
+ ("PARENTHESIZED HANGUL NIEUN" . 12801)
+ ("PARENTHESIZED HANGUL TIKEUT" . 12802)
+ ("PARENTHESIZED HANGUL RIEUL" . 12803)
+ ("PARENTHESIZED HANGUL MIEUM" . 12804)
+ ("PARENTHESIZED HANGUL PIEUP" . 12805)
+ ("PARENTHESIZED HANGUL SIOS" . 12806)
+ ("PARENTHESIZED HANGUL IEUNG" . 12807)
+ ("PARENTHESIZED HANGUL CIEUC" . 12808)
+ ("PARENTHESIZED HANGUL CHIEUCH" . 12809)
+ ("PARENTHESIZED HANGUL KHIEUKH" . 12810)
+ ("PARENTHESIZED HANGUL THIEUTH" . 12811)
+ ("PARENTHESIZED HANGUL PHIEUPH" . 12812)
+ ("PARENTHESIZED HANGUL HIEUH" . 12813)
+ ("PARENTHESIZED HANGUL KIYEOK A" . 12814)
+ ("PARENTHESIZED HANGUL NIEUN A" . 12815)
+ ("PARENTHESIZED HANGUL TIKEUT A" . 12816)
+ ("PARENTHESIZED HANGUL RIEUL A" . 12817)
+ ("PARENTHESIZED HANGUL MIEUM A" . 12818)
+ ("PARENTHESIZED HANGUL PIEUP A" . 12819)
+ ("PARENTHESIZED HANGUL SIOS A" . 12820)
+ ("PARENTHESIZED HANGUL IEUNG A" . 12821)
+ ("PARENTHESIZED HANGUL CIEUC A" . 12822)
+ ("PARENTHESIZED HANGUL CHIEUCH A" . 12823)
+ ("PARENTHESIZED HANGUL KHIEUKH A" . 12824)
+ ("PARENTHESIZED HANGUL THIEUTH A" . 12825)
+ ("PARENTHESIZED HANGUL PHIEUPH A" . 12826)
+ ("PARENTHESIZED HANGUL HIEUH A" . 12827)
+ ("PARENTHESIZED HANGUL CIEUC U" . 12828)
+ ("PARENTHESIZED IDEOGRAPH ONE" . 12832)
+ ("PARENTHESIZED IDEOGRAPH TWO" . 12833)
+ ("PARENTHESIZED IDEOGRAPH THREE" . 12834)
+ ("PARENTHESIZED IDEOGRAPH FOUR" . 12835)
+ ("PARENTHESIZED IDEOGRAPH FIVE" . 12836)
+ ("PARENTHESIZED IDEOGRAPH SIX" . 12837)
+ ("PARENTHESIZED IDEOGRAPH SEVEN" . 12838)
+ ("PARENTHESIZED IDEOGRAPH EIGHT" . 12839)
+ ("PARENTHESIZED IDEOGRAPH NINE" . 12840)
+ ("PARENTHESIZED IDEOGRAPH TEN" . 12841)
+ ("PARENTHESIZED IDEOGRAPH MOON" . 12842)
+ ("PARENTHESIZED IDEOGRAPH FIRE" . 12843)
+ ("PARENTHESIZED IDEOGRAPH WATER" . 12844)
+ ("PARENTHESIZED IDEOGRAPH WOOD" . 12845)
+ ("PARENTHESIZED IDEOGRAPH METAL" . 12846)
+ ("PARENTHESIZED IDEOGRAPH EARTH" . 12847)
+ ("PARENTHESIZED IDEOGRAPH SUN" . 12848)
+ ("PARENTHESIZED IDEOGRAPH STOCK" . 12849)
+ ("PARENTHESIZED IDEOGRAPH HAVE" . 12850)
+ ("PARENTHESIZED IDEOGRAPH SOCIETY" . 12851)
+ ("PARENTHESIZED IDEOGRAPH NAME" . 12852)
+ ("PARENTHESIZED IDEOGRAPH SPECIAL" . 12853)
+ ("PARENTHESIZED IDEOGRAPH FINANCIAL" . 12854)
+ ("PARENTHESIZED IDEOGRAPH CONGRATULATION" . 12855)
+ ("PARENTHESIZED IDEOGRAPH LABOR" . 12856)
+ ("PARENTHESIZED IDEOGRAPH REPRESENT" . 12857)
+ ("PARENTHESIZED IDEOGRAPH CALL" . 12858)
+ ("PARENTHESIZED IDEOGRAPH STUDY" . 12859)
+ ("PARENTHESIZED IDEOGRAPH SUPERVISE" . 12860)
+ ("PARENTHESIZED IDEOGRAPH ENTERPRISE" . 12861)
+ ("PARENTHESIZED IDEOGRAPH RESOURCE" . 12862)
+ ("PARENTHESIZED IDEOGRAPH ALLIANCE" . 12863)
+ ("PARENTHESIZED IDEOGRAPH FESTIVAL" . 12864)
+ ("PARENTHESIZED IDEOGRAPH REST" . 12865)
+ ("PARENTHESIZED IDEOGRAPH SELF" . 12866)
+ ("PARENTHESIZED IDEOGRAPH REACH" . 12867)
+ ("CIRCLED NUMBER TWENTY ONE" . 12881)
+ ("CIRCLED NUMBER TWENTY TWO" . 12882)
+ ("CIRCLED NUMBER TWENTY THREE" . 12883)
+ ("CIRCLED NUMBER TWENTY FOUR" . 12884)
+ ("CIRCLED NUMBER TWENTY FIVE" . 12885)
+ ("CIRCLED NUMBER TWENTY SIX" . 12886)
+ ("CIRCLED NUMBER TWENTY SEVEN" . 12887)
+ ("CIRCLED NUMBER TWENTY EIGHT" . 12888)
+ ("CIRCLED NUMBER TWENTY NINE" . 12889)
+ ("CIRCLED NUMBER THIRTY" . 12890)
+ ("CIRCLED NUMBER THIRTY ONE" . 12891)
+ ("CIRCLED NUMBER THIRTY TWO" . 12892)
+ ("CIRCLED NUMBER THIRTY THREE" . 12893)
+ ("CIRCLED NUMBER THIRTY FOUR" . 12894)
+ ("CIRCLED NUMBER THIRTY FIVE" . 12895)
+ ("CIRCLED HANGUL KIYEOK" . 12896)
+ ("CIRCLED HANGUL NIEUN" . 12897)
+ ("CIRCLED HANGUL TIKEUT" . 12898)
+ ("CIRCLED HANGUL RIEUL" . 12899)
+ ("CIRCLED HANGUL MIEUM" . 12900)
+ ("CIRCLED HANGUL PIEUP" . 12901)
+ ("CIRCLED HANGUL SIOS" . 12902)
+ ("CIRCLED HANGUL IEUNG" . 12903)
+ ("CIRCLED HANGUL CIEUC" . 12904)
+ ("CIRCLED HANGUL CHIEUCH" . 12905)
+ ("CIRCLED HANGUL KHIEUKH" . 12906)
+ ("CIRCLED HANGUL THIEUTH" . 12907)
+ ("CIRCLED HANGUL PHIEUPH" . 12908)
+ ("CIRCLED HANGUL HIEUH" . 12909)
+ ("CIRCLED HANGUL KIYEOK A" . 12910)
+ ("CIRCLED HANGUL NIEUN A" . 12911)
+ ("CIRCLED HANGUL TIKEUT A" . 12912)
+ ("CIRCLED HANGUL RIEUL A" . 12913)
+ ("CIRCLED HANGUL MIEUM A" . 12914)
+ ("CIRCLED HANGUL PIEUP A" . 12915)
+ ("CIRCLED HANGUL SIOS A" . 12916)
+ ("CIRCLED HANGUL IEUNG A" . 12917)
+ ("CIRCLED HANGUL CIEUC A" . 12918)
+ ("CIRCLED HANGUL CHIEUCH A" . 12919)
+ ("CIRCLED HANGUL KHIEUKH A" . 12920)
+ ("CIRCLED HANGUL THIEUTH A" . 12921)
+ ("CIRCLED HANGUL PHIEUPH A" . 12922)
+ ("CIRCLED HANGUL HIEUH A" . 12923)
+ ("KOREAN STANDARD SYMBOL" . 12927)
+ ("CIRCLED IDEOGRAPH ONE" . 12928)
+ ("CIRCLED IDEOGRAPH TWO" . 12929)
+ ("CIRCLED IDEOGRAPH THREE" . 12930)
+ ("CIRCLED IDEOGRAPH FOUR" . 12931)
+ ("CIRCLED IDEOGRAPH FIVE" . 12932)
+ ("CIRCLED IDEOGRAPH SIX" . 12933)
+ ("CIRCLED IDEOGRAPH SEVEN" . 12934)
+ ("CIRCLED IDEOGRAPH EIGHT" . 12935)
+ ("CIRCLED IDEOGRAPH NINE" . 12936)
+ ("CIRCLED IDEOGRAPH TEN" . 12937)
+ ("CIRCLED IDEOGRAPH MOON" . 12938)
+ ("CIRCLED IDEOGRAPH FIRE" . 12939)
+ ("CIRCLED IDEOGRAPH WATER" . 12940)
+ ("CIRCLED IDEOGRAPH WOOD" . 12941)
+ ("CIRCLED IDEOGRAPH METAL" . 12942)
+ ("CIRCLED IDEOGRAPH EARTH" . 12943)
+ ("CIRCLED IDEOGRAPH SUN" . 12944)
+ ("CIRCLED IDEOGRAPH STOCK" . 12945)
+ ("CIRCLED IDEOGRAPH HAVE" . 12946)
+ ("CIRCLED IDEOGRAPH SOCIETY" . 12947)
+ ("CIRCLED IDEOGRAPH NAME" . 12948)
+ ("CIRCLED IDEOGRAPH SPECIAL" . 12949)
+ ("CIRCLED IDEOGRAPH FINANCIAL" . 12950)
+ ("CIRCLED IDEOGRAPH CONGRATULATION" . 12951)
+ ("CIRCLED IDEOGRAPH LABOR" . 12952)
+ ("CIRCLED IDEOGRAPH SECRET" . 12953)
+ ("CIRCLED IDEOGRAPH MALE" . 12954)
+ ("CIRCLED IDEOGRAPH FEMALE" . 12955)
+ ("CIRCLED IDEOGRAPH SUITABLE" . 12956)
+ ("CIRCLED IDEOGRAPH EXCELLENT" . 12957)
+ ("CIRCLED IDEOGRAPH PRINT" . 12958)
+ ("CIRCLED IDEOGRAPH ATTENTION" . 12959)
+ ("CIRCLED IDEOGRAPH ITEM" . 12960)
+ ("CIRCLED IDEOGRAPH REST" . 12961)
+ ("CIRCLED IDEOGRAPH COPY" . 12962)
+ ("CIRCLED IDEOGRAPH CORRECT" . 12963)
+ ("CIRCLED IDEOGRAPH HIGH" . 12964)
+ ("CIRCLED IDEOGRAPH CENTRE" . 12965)
+ ("CIRCLED IDEOGRAPH LOW" . 12966)
+ ("CIRCLED IDEOGRAPH LEFT" . 12967)
+ ("CIRCLED IDEOGRAPH RIGHT" . 12968)
+ ("CIRCLED IDEOGRAPH MEDICINE" . 12969)
+ ("CIRCLED IDEOGRAPH RELIGION" . 12970)
+ ("CIRCLED IDEOGRAPH STUDY" . 12971)
+ ("CIRCLED IDEOGRAPH SUPERVISE" . 12972)
+ ("CIRCLED IDEOGRAPH ENTERPRISE" . 12973)
+ ("CIRCLED IDEOGRAPH RESOURCE" . 12974)
+ ("CIRCLED IDEOGRAPH ALLIANCE" . 12975)
+ ("CIRCLED IDEOGRAPH NIGHT" . 12976)
+ ("CIRCLED NUMBER THIRTY SIX" . 12977)
+ ("CIRCLED NUMBER THIRTY SEVEN" . 12978)
+ ("CIRCLED NUMBER THIRTY EIGHT" . 12979)
+ ("CIRCLED NUMBER THIRTY NINE" . 12980)
+ ("CIRCLED NUMBER FORTY" . 12981)
+ ("CIRCLED NUMBER FORTY ONE" . 12982)
+ ("CIRCLED NUMBER FORTY TWO" . 12983)
+ ("CIRCLED NUMBER FORTY THREE" . 12984)
+ ("CIRCLED NUMBER FORTY FOUR" . 12985)
+ ("CIRCLED NUMBER FORTY FIVE" . 12986)
+ ("CIRCLED NUMBER FORTY SIX" . 12987)
+ ("CIRCLED NUMBER FORTY SEVEN" . 12988)
+ ("CIRCLED NUMBER FORTY EIGHT" . 12989)
+ ("CIRCLED NUMBER FORTY NINE" . 12990)
+ ("CIRCLED NUMBER FIFTY" . 12991)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR JANUARY" . 12992)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR FEBRUARY" . 12993)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR MARCH" . 12994)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR APRIL" . 12995)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR MAY" . 12996)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR JUNE" . 12997)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR JULY" . 12998)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR AUGUST" . 12999)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR SEPTEMBER" . 13000)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR OCTOBER" . 13001)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR NOVEMBER" . 13002)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DECEMBER" . 13003)
+ ("CIRCLED KATAKANA A" . 13008)
+ ("CIRCLED KATAKANA I" . 13009)
+ ("CIRCLED KATAKANA U" . 13010)
+ ("CIRCLED KATAKANA E" . 13011)
+ ("CIRCLED KATAKANA O" . 13012)
+ ("CIRCLED KATAKANA KA" . 13013)
+ ("CIRCLED KATAKANA KI" . 13014)
+ ("CIRCLED KATAKANA KU" . 13015)
+ ("CIRCLED KATAKANA KE" . 13016)
+ ("CIRCLED KATAKANA KO" . 13017)
+ ("CIRCLED KATAKANA SA" . 13018)
+ ("CIRCLED KATAKANA SI" . 13019)
+ ("CIRCLED KATAKANA SU" . 13020)
+ ("CIRCLED KATAKANA SE" . 13021)
+ ("CIRCLED KATAKANA SO" . 13022)
+ ("CIRCLED KATAKANA TA" . 13023)
+ ("CIRCLED KATAKANA TI" . 13024)
+ ("CIRCLED KATAKANA TU" . 13025)
+ ("CIRCLED KATAKANA TE" . 13026)
+ ("CIRCLED KATAKANA TO" . 13027)
+ ("CIRCLED KATAKANA NA" . 13028)
+ ("CIRCLED KATAKANA NI" . 13029)
+ ("CIRCLED KATAKANA NU" . 13030)
+ ("CIRCLED KATAKANA NE" . 13031)
+ ("CIRCLED KATAKANA NO" . 13032)
+ ("CIRCLED KATAKANA HA" . 13033)
+ ("CIRCLED KATAKANA HI" . 13034)
+ ("CIRCLED KATAKANA HU" . 13035)
+ ("CIRCLED KATAKANA HE" . 13036)
+ ("CIRCLED KATAKANA HO" . 13037)
+ ("CIRCLED KATAKANA MA" . 13038)
+ ("CIRCLED KATAKANA MI" . 13039)
+ ("CIRCLED KATAKANA MU" . 13040)
+ ("CIRCLED KATAKANA ME" . 13041)
+ ("CIRCLED KATAKANA MO" . 13042)
+ ("CIRCLED KATAKANA YA" . 13043)
+ ("CIRCLED KATAKANA YU" . 13044)
+ ("CIRCLED KATAKANA YO" . 13045)
+ ("CIRCLED KATAKANA RA" . 13046)
+ ("CIRCLED KATAKANA RI" . 13047)
+ ("CIRCLED KATAKANA RU" . 13048)
+ ("CIRCLED KATAKANA RE" . 13049)
+ ("CIRCLED KATAKANA RO" . 13050)
+ ("CIRCLED KATAKANA WA" . 13051)
+ ("CIRCLED KATAKANA WI" . 13052)
+ ("CIRCLED KATAKANA WE" . 13053)
+ ("CIRCLED KATAKANA WO" . 13054)
+ ("SQUARE APAATO" . 13056)
+ ("SQUARE ARUHUA" . 13057)
+ ("SQUARE ANPEA" . 13058)
+ ("SQUARE AARU" . 13059)
+ ("SQUARE ININGU" . 13060)
+ ("SQUARE INTI" . 13061)
+ ("SQUARE UON" . 13062)
+ ("SQUARE ESUKUUDO" . 13063)
+ ("SQUARE EEKAA" . 13064)
+ ("SQUARE ONSU" . 13065)
+ ("SQUARE OOMU" . 13066)
+ ("SQUARE KAIRI" . 13067)
+ ("SQUARE KARATTO" . 13068)
+ ("SQUARE KARORII" . 13069)
+ ("SQUARE GARON" . 13070)
+ ("SQUARE GANMA" . 13071)
+ ("SQUARE GIGA" . 13072)
+ ("SQUARE GINII" . 13073)
+ ("SQUARE KYURII" . 13074)
+ ("SQUARE GIRUDAA" . 13075)
+ ("SQUARE KIRO" . 13076)
+ ("SQUARE KIROGURAMU" . 13077)
+ ("SQUARE KIROMEETORU" . 13078)
+ ("SQUARE KIROWATTO" . 13079)
+ ("SQUARE GURAMU" . 13080)
+ ("SQUARE GURAMUTON" . 13081)
+ ("SQUARE KURUZEIRO" . 13082)
+ ("SQUARE KUROONE" . 13083)
+ ("SQUARE KEESU" . 13084)
+ ("SQUARE KORUNA" . 13085)
+ ("SQUARE KOOPO" . 13086)
+ ("SQUARE SAIKURU" . 13087)
+ ("SQUARE SANTIIMU" . 13088)
+ ("SQUARE SIRINGU" . 13089)
+ ("SQUARE SENTI" . 13090)
+ ("SQUARE SENTO" . 13091)
+ ("SQUARE DAASU" . 13092)
+ ("SQUARE DESI" . 13093)
+ ("SQUARE DORU" . 13094)
+ ("SQUARE TON" . 13095)
+ ("SQUARE NANO" . 13096)
+ ("SQUARE NOTTO" . 13097)
+ ("SQUARE HAITU" . 13098)
+ ("SQUARE PAASENTO" . 13099)
+ ("SQUARE PAATU" . 13100)
+ ("SQUARE BAARERU" . 13101)
+ ("SQUARE PIASUTORU" . 13102)
+ ("SQUARE PIKURU" . 13103)
+ ("SQUARE PIKO" . 13104)
+ ("SQUARE BIRU" . 13105)
+ ("SQUARE HUARADDO" . 13106)
+ ("SQUARE HUIITO" . 13107)
+ ("SQUARE BUSSYERU" . 13108)
+ ("SQUARE HURAN" . 13109)
+ ("SQUARE HEKUTAARU" . 13110)
+ ("SQUARE PESO" . 13111)
+ ("SQUARE PENIHI" . 13112)
+ ("SQUARE HERUTU" . 13113)
+ ("SQUARE PENSU" . 13114)
+ ("SQUARE PEEZI" . 13115)
+ ("SQUARE BEETA" . 13116)
+ ("SQUARE POINTO" . 13117)
+ ("SQUARE BORUTO" . 13118)
+ ("SQUARE HON" . 13119)
+ ("SQUARE PONDO" . 13120)
+ ("SQUARE HOORU" . 13121)
+ ("SQUARE HOON" . 13122)
+ ("SQUARE MAIKURO" . 13123)
+ ("SQUARE MAIRU" . 13124)
+ ("SQUARE MAHHA" . 13125)
+ ("SQUARE MARUKU" . 13126)
+ ("SQUARE MANSYON" . 13127)
+ ("SQUARE MIKURON" . 13128)
+ ("SQUARE MIRI" . 13129)
+ ("SQUARE MIRIBAARU" . 13130)
+ ("SQUARE MEGA" . 13131)
+ ("SQUARE MEGATON" . 13132)
+ ("SQUARE MEETORU" . 13133)
+ ("SQUARE YAADO" . 13134)
+ ("SQUARE YAARU" . 13135)
+ ("SQUARE YUAN" . 13136)
+ ("SQUARE RITTORU" . 13137)
+ ("SQUARE RIRA" . 13138)
+ ("SQUARE RUPII" . 13139)
+ ("SQUARE RUUBURU" . 13140)
+ ("SQUARE REMU" . 13141)
+ ("SQUARE RENTOGEN" . 13142)
+ ("SQUARE WATTO" . 13143)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR ZERO" . 13144)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR ONE" . 13145)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR TWO" . 13146)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR THREE" . 13147)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR FOUR" . 13148)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR FIVE" . 13149)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR SIX" . 13150)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR SEVEN" . 13151)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR EIGHT" . 13152)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR NINE" . 13153)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR TEN" . 13154)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR ELEVEN" . 13155)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR TWELVE" . 13156)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR THIRTEEN" . 13157)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR FOURTEEN" . 13158)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR FIFTEEN" . 13159)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR SIXTEEN" . 13160)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR SEVENTEEN" . 13161)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR EIGHTEEN" . 13162)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR NINETEEN" . 13163)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR TWENTY" . 13164)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR TWENTY-ONE" . 13165)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR TWENTY-TWO" . 13166)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR TWENTY-THREE" . 13167)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR HOUR TWENTY-FOUR" . 13168)
+ ("SQUARE HPA" . 13169)
+ ("SQUARE DA" . 13170)
+ ("SQUARE AU" . 13171)
+ ("SQUARE BAR" . 13172)
+ ("SQUARE OV" . 13173)
+ ("SQUARE PC" . 13174)
+ ("SQUARE ERA NAME HEISEI" . 13179)
+ ("SQUARE ERA NAME SYOUWA" . 13180)
+ ("SQUARE ERA NAME TAISYOU" . 13181)
+ ("SQUARE ERA NAME MEIZI" . 13182)
+ ("SQUARE CORPORATION" . 13183)
+ ("SQUARE PA AMPS" . 13184)
+ ("SQUARE NA" . 13185)
+ ("SQUARE MU A" . 13186)
+ ("SQUARE MA" . 13187)
+ ("SQUARE KA" . 13188)
+ ("SQUARE KB" . 13189)
+ ("SQUARE MB" . 13190)
+ ("SQUARE GB" . 13191)
+ ("SQUARE CAL" . 13192)
+ ("SQUARE KCAL" . 13193)
+ ("SQUARE PF" . 13194)
+ ("SQUARE NF" . 13195)
+ ("SQUARE MU F" . 13196)
+ ("SQUARE MU G" . 13197)
+ ("SQUARE MG" . 13198)
+ ("SQUARE KG" . 13199)
+ ("SQUARE HZ" . 13200)
+ ("SQUARE KHZ" . 13201)
+ ("SQUARE MHZ" . 13202)
+ ("SQUARE GHZ" . 13203)
+ ("SQUARE THZ" . 13204)
+ ("SQUARE MU L" . 13205)
+ ("SQUARE ML" . 13206)
+ ("SQUARE DL" . 13207)
+ ("SQUARE KL" . 13208)
+ ("SQUARE FM" . 13209)
+ ("SQUARE NM" . 13210)
+ ("SQUARE MU M" . 13211)
+ ("SQUARE MM" . 13212)
+ ("SQUARE CM" . 13213)
+ ("SQUARE KM" . 13214)
+ ("SQUARE MM SQUARED" . 13215)
+ ("SQUARE CM SQUARED" . 13216)
+ ("SQUARE M SQUARED" . 13217)
+ ("SQUARE KM SQUARED" . 13218)
+ ("SQUARE MM CUBED" . 13219)
+ ("SQUARE CM CUBED" . 13220)
+ ("SQUARE M CUBED" . 13221)
+ ("SQUARE KM CUBED" . 13222)
+ ("SQUARE M OVER S" . 13223)
+ ("SQUARE M OVER S SQUARED" . 13224)
+ ("SQUARE PA" . 13225)
+ ("SQUARE KPA" . 13226)
+ ("SQUARE MPA" . 13227)
+ ("SQUARE GPA" . 13228)
+ ("SQUARE RAD" . 13229)
+ ("SQUARE RAD OVER S" . 13230)
+ ("SQUARE RAD OVER S SQUARED" . 13231)
+ ("SQUARE PS" . 13232)
+ ("SQUARE NS" . 13233)
+ ("SQUARE MU S" . 13234)
+ ("SQUARE MS" . 13235)
+ ("SQUARE PV" . 13236)
+ ("SQUARE NV" . 13237)
+ ("SQUARE MU V" . 13238)
+ ("SQUARE MV" . 13239)
+ ("SQUARE KV" . 13240)
+ ("SQUARE MV MEGA" . 13241)
+ ("SQUARE PW" . 13242)
+ ("SQUARE NW" . 13243)
+ ("SQUARE MU W" . 13244)
+ ("SQUARE MW" . 13245)
+ ("SQUARE KW" . 13246)
+ ("SQUARE MW MEGA" . 13247)
+ ("SQUARE K OHM" . 13248)
+ ("SQUARE M OHM" . 13249)
+ ("SQUARE AM" . 13250)
+ ("SQUARE BQ" . 13251)
+ ("SQUARE CC" . 13252)
+ ("SQUARE CD" . 13253)
+ ("SQUARE C OVER KG" . 13254)
+ ("SQUARE CO" . 13255)
+ ("SQUARE DB" . 13256)
+ ("SQUARE GY" . 13257)
+ ("SQUARE HA" . 13258)
+ ("SQUARE HP" . 13259)
+ ("SQUARE IN" . 13260)
+ ("SQUARE KK" . 13261)
+ ("SQUARE KM CAPITAL" . 13262)
+ ("SQUARE KT" . 13263)
+ ("SQUARE LM" . 13264)
+ ("SQUARE LN" . 13265)
+ ("SQUARE LOG" . 13266)
+ ("SQUARE LX" . 13267)
+ ("SQUARE MB SMALL" . 13268)
+ ("SQUARE MIL" . 13269)
+ ("SQUARE MOL" . 13270)
+ ("SQUARE PH" . 13271)
+ ("SQUARE PM" . 13272)
+ ("SQUARE PPM" . 13273)
+ ("SQUARE PR" . 13274)
+ ("SQUARE SR" . 13275)
+ ("SQUARE SV" . 13276)
+ ("SQUARE WB" . 13277)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY ONE" . 13280)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWO" . 13281)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY THREE" . 13282)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY FOUR" . 13283)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY FIVE" . 13284)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY SIX" . 13285)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY SEVEN" . 13286)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY EIGHT" . 13287)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY NINE" . 13288)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TEN" . 13289)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY ELEVEN" . 13290)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWELVE" . 13291)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY THIRTEEN" . 13292)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY FOURTEEN" . 13293)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY FIFTEEN" . 13294)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY SIXTEEN" . 13295)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY SEVENTEEN" . 13296)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY EIGHTEEN" . 13297)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY NINETEEN" . 13298)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY" . 13299)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY-ONE" . 13300)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY-TWO" . 13301)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY-THREE" . 13302)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY-FOUR" . 13303)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY-FIVE" . 13304)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY-SIX" . 13305)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY-SEVEN" . 13306)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY-EIGHT" . 13307)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY TWENTY-NINE" . 13308)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY THIRTY" . 13309)
+ ("IDEOGRAPHIC TELEGRAPH SYMBOL FOR DAY THIRTY-ONE" . 13310)
+ ("YI SYLLABLE IT" . 40960)
+ ("YI SYLLABLE IX" . 40961)
+ ("YI SYLLABLE I" . 40962)
+ ("YI SYLLABLE IP" . 40963)
+ ("YI SYLLABLE IET" . 40964)
+ ("YI SYLLABLE IEX" . 40965)
+ ("YI SYLLABLE IE" . 40966)
+ ("YI SYLLABLE IEP" . 40967)
+ ("YI SYLLABLE AT" . 40968)
+ ("YI SYLLABLE AX" . 40969)
+ ("YI SYLLABLE A" . 40970)
+ ("YI SYLLABLE AP" . 40971)
+ ("YI SYLLABLE UOX" . 40972)
+ ("YI SYLLABLE UO" . 40973)
+ ("YI SYLLABLE UOP" . 40974)
+ ("YI SYLLABLE OT" . 40975)
+ ("YI SYLLABLE OX" . 40976)
+ ("YI SYLLABLE O" . 40977)
+ ("YI SYLLABLE OP" . 40978)
+ ("YI SYLLABLE EX" . 40979)
+ ("YI SYLLABLE E" . 40980)
+ ("YI SYLLABLE WU" . 40981)
+ ("YI SYLLABLE BIT" . 40982)
+ ("YI SYLLABLE BIX" . 40983)
+ ("YI SYLLABLE BI" . 40984)
+ ("YI SYLLABLE BIP" . 40985)
+ ("YI SYLLABLE BIET" . 40986)
+ ("YI SYLLABLE BIEX" . 40987)
+ ("YI SYLLABLE BIE" . 40988)
+ ("YI SYLLABLE BIEP" . 40989)
+ ("YI SYLLABLE BAT" . 40990)
+ ("YI SYLLABLE BAX" . 40991)
+ ("YI SYLLABLE BA" . 40992)
+ ("YI SYLLABLE BAP" . 40993)
+ ("YI SYLLABLE BUOX" . 40994)
+ ("YI SYLLABLE BUO" . 40995)
+ ("YI SYLLABLE BUOP" . 40996)
+ ("YI SYLLABLE BOT" . 40997)
+ ("YI SYLLABLE BOX" . 40998)
+ ("YI SYLLABLE BO" . 40999)
+ ("YI SYLLABLE BOP" . 41000)
+ ("YI SYLLABLE BEX" . 41001)
+ ("YI SYLLABLE BE" . 41002)
+ ("YI SYLLABLE BEP" . 41003)
+ ("YI SYLLABLE BUT" . 41004)
+ ("YI SYLLABLE BUX" . 41005)
+ ("YI SYLLABLE BU" . 41006)
+ ("YI SYLLABLE BUP" . 41007)
+ ("YI SYLLABLE BURX" . 41008)
+ ("YI SYLLABLE BUR" . 41009)
+ ("YI SYLLABLE BYT" . 41010)
+ ("YI SYLLABLE BYX" . 41011)
+ ("YI SYLLABLE BY" . 41012)
+ ("YI SYLLABLE BYP" . 41013)
+ ("YI SYLLABLE BYRX" . 41014)
+ ("YI SYLLABLE BYR" . 41015)
+ ("YI SYLLABLE PIT" . 41016)
+ ("YI SYLLABLE PIX" . 41017)
+ ("YI SYLLABLE PI" . 41018)
+ ("YI SYLLABLE PIP" . 41019)
+ ("YI SYLLABLE PIEX" . 41020)
+ ("YI SYLLABLE PIE" . 41021)
+ ("YI SYLLABLE PIEP" . 41022)
+ ("YI SYLLABLE PAT" . 41023)
+ ("YI SYLLABLE PAX" . 41024)
+ ("YI SYLLABLE PA" . 41025)
+ ("YI SYLLABLE PAP" . 41026)
+ ("YI SYLLABLE PUOX" . 41027)
+ ("YI SYLLABLE PUO" . 41028)
+ ("YI SYLLABLE PUOP" . 41029)
+ ("YI SYLLABLE POT" . 41030)
+ ("YI SYLLABLE POX" . 41031)
+ ("YI SYLLABLE PO" . 41032)
+ ("YI SYLLABLE POP" . 41033)
+ ("YI SYLLABLE PUT" . 41034)
+ ("YI SYLLABLE PUX" . 41035)
+ ("YI SYLLABLE PU" . 41036)
+ ("YI SYLLABLE PUP" . 41037)
+ ("YI SYLLABLE PURX" . 41038)
+ ("YI SYLLABLE PUR" . 41039)
+ ("YI SYLLABLE PYT" . 41040)
+ ("YI SYLLABLE PYX" . 41041)
+ ("YI SYLLABLE PY" . 41042)
+ ("YI SYLLABLE PYP" . 41043)
+ ("YI SYLLABLE PYRX" . 41044)
+ ("YI SYLLABLE PYR" . 41045)
+ ("YI SYLLABLE BBIT" . 41046)
+ ("YI SYLLABLE BBIX" . 41047)
+ ("YI SYLLABLE BBI" . 41048)
+ ("YI SYLLABLE BBIP" . 41049)
+ ("YI SYLLABLE BBIET" . 41050)
+ ("YI SYLLABLE BBIEX" . 41051)
+ ("YI SYLLABLE BBIE" . 41052)
+ ("YI SYLLABLE BBIEP" . 41053)
+ ("YI SYLLABLE BBAT" . 41054)
+ ("YI SYLLABLE BBAX" . 41055)
+ ("YI SYLLABLE BBA" . 41056)
+ ("YI SYLLABLE BBAP" . 41057)
+ ("YI SYLLABLE BBUOX" . 41058)
+ ("YI SYLLABLE BBUO" . 41059)
+ ("YI SYLLABLE BBUOP" . 41060)
+ ("YI SYLLABLE BBOT" . 41061)
+ ("YI SYLLABLE BBOX" . 41062)
+ ("YI SYLLABLE BBO" . 41063)
+ ("YI SYLLABLE BBOP" . 41064)
+ ("YI SYLLABLE BBEX" . 41065)
+ ("YI SYLLABLE BBE" . 41066)
+ ("YI SYLLABLE BBEP" . 41067)
+ ("YI SYLLABLE BBUT" . 41068)
+ ("YI SYLLABLE BBUX" . 41069)
+ ("YI SYLLABLE BBU" . 41070)
+ ("YI SYLLABLE BBUP" . 41071)
+ ("YI SYLLABLE BBURX" . 41072)
+ ("YI SYLLABLE BBUR" . 41073)
+ ("YI SYLLABLE BBYT" . 41074)
+ ("YI SYLLABLE BBYX" . 41075)
+ ("YI SYLLABLE BBY" . 41076)
+ ("YI SYLLABLE BBYP" . 41077)
+ ("YI SYLLABLE NBIT" . 41078)
+ ("YI SYLLABLE NBIX" . 41079)
+ ("YI SYLLABLE NBI" . 41080)
+ ("YI SYLLABLE NBIP" . 41081)
+ ("YI SYLLABLE NBIEX" . 41082)
+ ("YI SYLLABLE NBIE" . 41083)
+ ("YI SYLLABLE NBIEP" . 41084)
+ ("YI SYLLABLE NBAT" . 41085)
+ ("YI SYLLABLE NBAX" . 41086)
+ ("YI SYLLABLE NBA" . 41087)
+ ("YI SYLLABLE NBAP" . 41088)
+ ("YI SYLLABLE NBOT" . 41089)
+ ("YI SYLLABLE NBOX" . 41090)
+ ("YI SYLLABLE NBO" . 41091)
+ ("YI SYLLABLE NBOP" . 41092)
+ ("YI SYLLABLE NBUT" . 41093)
+ ("YI SYLLABLE NBUX" . 41094)
+ ("YI SYLLABLE NBU" . 41095)
+ ("YI SYLLABLE NBUP" . 41096)
+ ("YI SYLLABLE NBURX" . 41097)
+ ("YI SYLLABLE NBUR" . 41098)
+ ("YI SYLLABLE NBYT" . 41099)
+ ("YI SYLLABLE NBYX" . 41100)
+ ("YI SYLLABLE NBY" . 41101)
+ ("YI SYLLABLE NBYP" . 41102)
+ ("YI SYLLABLE NBYRX" . 41103)
+ ("YI SYLLABLE NBYR" . 41104)
+ ("YI SYLLABLE HMIT" . 41105)
+ ("YI SYLLABLE HMIX" . 41106)
+ ("YI SYLLABLE HMI" . 41107)
+ ("YI SYLLABLE HMIP" . 41108)
+ ("YI SYLLABLE HMIEX" . 41109)
+ ("YI SYLLABLE HMIE" . 41110)
+ ("YI SYLLABLE HMIEP" . 41111)
+ ("YI SYLLABLE HMAT" . 41112)
+ ("YI SYLLABLE HMAX" . 41113)
+ ("YI SYLLABLE HMA" . 41114)
+ ("YI SYLLABLE HMAP" . 41115)
+ ("YI SYLLABLE HMUOX" . 41116)
+ ("YI SYLLABLE HMUO" . 41117)
+ ("YI SYLLABLE HMUOP" . 41118)
+ ("YI SYLLABLE HMOT" . 41119)
+ ("YI SYLLABLE HMOX" . 41120)
+ ("YI SYLLABLE HMO" . 41121)
+ ("YI SYLLABLE HMOP" . 41122)
+ ("YI SYLLABLE HMUT" . 41123)
+ ("YI SYLLABLE HMUX" . 41124)
+ ("YI SYLLABLE HMU" . 41125)
+ ("YI SYLLABLE HMUP" . 41126)
+ ("YI SYLLABLE HMURX" . 41127)
+ ("YI SYLLABLE HMUR" . 41128)
+ ("YI SYLLABLE HMYX" . 41129)
+ ("YI SYLLABLE HMY" . 41130)
+ ("YI SYLLABLE HMYP" . 41131)
+ ("YI SYLLABLE HMYRX" . 41132)
+ ("YI SYLLABLE HMYR" . 41133)
+ ("YI SYLLABLE MIT" . 41134)
+ ("YI SYLLABLE MIX" . 41135)
+ ("YI SYLLABLE MI" . 41136)
+ ("YI SYLLABLE MIP" . 41137)
+ ("YI SYLLABLE MIEX" . 41138)
+ ("YI SYLLABLE MIE" . 41139)
+ ("YI SYLLABLE MIEP" . 41140)
+ ("YI SYLLABLE MAT" . 41141)
+ ("YI SYLLABLE MAX" . 41142)
+ ("YI SYLLABLE MA" . 41143)
+ ("YI SYLLABLE MAP" . 41144)
+ ("YI SYLLABLE MUOT" . 41145)
+ ("YI SYLLABLE MUOX" . 41146)
+ ("YI SYLLABLE MUO" . 41147)
+ ("YI SYLLABLE MUOP" . 41148)
+ ("YI SYLLABLE MOT" . 41149)
+ ("YI SYLLABLE MOX" . 41150)
+ ("YI SYLLABLE MO" . 41151)
+ ("YI SYLLABLE MOP" . 41152)
+ ("YI SYLLABLE MEX" . 41153)
+ ("YI SYLLABLE ME" . 41154)
+ ("YI SYLLABLE MUT" . 41155)
+ ("YI SYLLABLE MUX" . 41156)
+ ("YI SYLLABLE MU" . 41157)
+ ("YI SYLLABLE MUP" . 41158)
+ ("YI SYLLABLE MURX" . 41159)
+ ("YI SYLLABLE MUR" . 41160)
+ ("YI SYLLABLE MYT" . 41161)
+ ("YI SYLLABLE MYX" . 41162)
+ ("YI SYLLABLE MY" . 41163)
+ ("YI SYLLABLE MYP" . 41164)
+ ("YI SYLLABLE FIT" . 41165)
+ ("YI SYLLABLE FIX" . 41166)
+ ("YI SYLLABLE FI" . 41167)
+ ("YI SYLLABLE FIP" . 41168)
+ ("YI SYLLABLE FAT" . 41169)
+ ("YI SYLLABLE FAX" . 41170)
+ ("YI SYLLABLE FA" . 41171)
+ ("YI SYLLABLE FAP" . 41172)
+ ("YI SYLLABLE FOX" . 41173)
+ ("YI SYLLABLE FO" . 41174)
+ ("YI SYLLABLE FOP" . 41175)
+ ("YI SYLLABLE FUT" . 41176)
+ ("YI SYLLABLE FUX" . 41177)
+ ("YI SYLLABLE FU" . 41178)
+ ("YI SYLLABLE FUP" . 41179)
+ ("YI SYLLABLE FURX" . 41180)
+ ("YI SYLLABLE FUR" . 41181)
+ ("YI SYLLABLE FYT" . 41182)
+ ("YI SYLLABLE FYX" . 41183)
+ ("YI SYLLABLE FY" . 41184)
+ ("YI SYLLABLE FYP" . 41185)
+ ("YI SYLLABLE VIT" . 41186)
+ ("YI SYLLABLE VIX" . 41187)
+ ("YI SYLLABLE VI" . 41188)
+ ("YI SYLLABLE VIP" . 41189)
+ ("YI SYLLABLE VIET" . 41190)
+ ("YI SYLLABLE VIEX" . 41191)
+ ("YI SYLLABLE VIE" . 41192)
+ ("YI SYLLABLE VIEP" . 41193)
+ ("YI SYLLABLE VAT" . 41194)
+ ("YI SYLLABLE VAX" . 41195)
+ ("YI SYLLABLE VA" . 41196)
+ ("YI SYLLABLE VAP" . 41197)
+ ("YI SYLLABLE VOT" . 41198)
+ ("YI SYLLABLE VOX" . 41199)
+ ("YI SYLLABLE VO" . 41200)
+ ("YI SYLLABLE VOP" . 41201)
+ ("YI SYLLABLE VEX" . 41202)
+ ("YI SYLLABLE VEP" . 41203)
+ ("YI SYLLABLE VUT" . 41204)
+ ("YI SYLLABLE VUX" . 41205)
+ ("YI SYLLABLE VU" . 41206)
+ ("YI SYLLABLE VUP" . 41207)
+ ("YI SYLLABLE VURX" . 41208)
+ ("YI SYLLABLE VUR" . 41209)
+ ("YI SYLLABLE VYT" . 41210)
+ ("YI SYLLABLE VYX" . 41211)
+ ("YI SYLLABLE VY" . 41212)
+ ("YI SYLLABLE VYP" . 41213)
+ ("YI SYLLABLE VYRX" . 41214)
+ ("YI SYLLABLE VYR" . 41215)
+ ("YI SYLLABLE DIT" . 41216)
+ ("YI SYLLABLE DIX" . 41217)
+ ("YI SYLLABLE DI" . 41218)
+ ("YI SYLLABLE DIP" . 41219)
+ ("YI SYLLABLE DIEX" . 41220)
+ ("YI SYLLABLE DIE" . 41221)
+ ("YI SYLLABLE DIEP" . 41222)
+ ("YI SYLLABLE DAT" . 41223)
+ ("YI SYLLABLE DAX" . 41224)
+ ("YI SYLLABLE DA" . 41225)
+ ("YI SYLLABLE DAP" . 41226)
+ ("YI SYLLABLE DUOX" . 41227)
+ ("YI SYLLABLE DUO" . 41228)
+ ("YI SYLLABLE DOT" . 41229)
+ ("YI SYLLABLE DOX" . 41230)
+ ("YI SYLLABLE DO" . 41231)
+ ("YI SYLLABLE DOP" . 41232)
+ ("YI SYLLABLE DEX" . 41233)
+ ("YI SYLLABLE DE" . 41234)
+ ("YI SYLLABLE DEP" . 41235)
+ ("YI SYLLABLE DUT" . 41236)
+ ("YI SYLLABLE DUX" . 41237)
+ ("YI SYLLABLE DU" . 41238)
+ ("YI SYLLABLE DUP" . 41239)
+ ("YI SYLLABLE DURX" . 41240)
+ ("YI SYLLABLE DUR" . 41241)
+ ("YI SYLLABLE TIT" . 41242)
+ ("YI SYLLABLE TIX" . 41243)
+ ("YI SYLLABLE TI" . 41244)
+ ("YI SYLLABLE TIP" . 41245)
+ ("YI SYLLABLE TIEX" . 41246)
+ ("YI SYLLABLE TIE" . 41247)
+ ("YI SYLLABLE TIEP" . 41248)
+ ("YI SYLLABLE TAT" . 41249)
+ ("YI SYLLABLE TAX" . 41250)
+ ("YI SYLLABLE TA" . 41251)
+ ("YI SYLLABLE TAP" . 41252)
+ ("YI SYLLABLE TUOT" . 41253)
+ ("YI SYLLABLE TUOX" . 41254)
+ ("YI SYLLABLE TUO" . 41255)
+ ("YI SYLLABLE TUOP" . 41256)
+ ("YI SYLLABLE TOT" . 41257)
+ ("YI SYLLABLE TOX" . 41258)
+ ("YI SYLLABLE TO" . 41259)
+ ("YI SYLLABLE TOP" . 41260)
+ ("YI SYLLABLE TEX" . 41261)
+ ("YI SYLLABLE TE" . 41262)
+ ("YI SYLLABLE TEP" . 41263)
+ ("YI SYLLABLE TUT" . 41264)
+ ("YI SYLLABLE TUX" . 41265)
+ ("YI SYLLABLE TU" . 41266)
+ ("YI SYLLABLE TUP" . 41267)
+ ("YI SYLLABLE TURX" . 41268)
+ ("YI SYLLABLE TUR" . 41269)
+ ("YI SYLLABLE DDIT" . 41270)
+ ("YI SYLLABLE DDIX" . 41271)
+ ("YI SYLLABLE DDI" . 41272)
+ ("YI SYLLABLE DDIP" . 41273)
+ ("YI SYLLABLE DDIEX" . 41274)
+ ("YI SYLLABLE DDIE" . 41275)
+ ("YI SYLLABLE DDIEP" . 41276)
+ ("YI SYLLABLE DDAT" . 41277)
+ ("YI SYLLABLE DDAX" . 41278)
+ ("YI SYLLABLE DDA" . 41279)
+ ("YI SYLLABLE DDAP" . 41280)
+ ("YI SYLLABLE DDUOX" . 41281)
+ ("YI SYLLABLE DDUO" . 41282)
+ ("YI SYLLABLE DDUOP" . 41283)
+ ("YI SYLLABLE DDOT" . 41284)
+ ("YI SYLLABLE DDOX" . 41285)
+ ("YI SYLLABLE DDO" . 41286)
+ ("YI SYLLABLE DDOP" . 41287)
+ ("YI SYLLABLE DDEX" . 41288)
+ ("YI SYLLABLE DDE" . 41289)
+ ("YI SYLLABLE DDEP" . 41290)
+ ("YI SYLLABLE DDUT" . 41291)
+ ("YI SYLLABLE DDUX" . 41292)
+ ("YI SYLLABLE DDU" . 41293)
+ ("YI SYLLABLE DDUP" . 41294)
+ ("YI SYLLABLE DDURX" . 41295)
+ ("YI SYLLABLE DDUR" . 41296)
+ ("YI SYLLABLE NDIT" . 41297)
+ ("YI SYLLABLE NDIX" . 41298)
+ ("YI SYLLABLE NDI" . 41299)
+ ("YI SYLLABLE NDIP" . 41300)
+ ("YI SYLLABLE NDIEX" . 41301)
+ ("YI SYLLABLE NDIE" . 41302)
+ ("YI SYLLABLE NDAT" . 41303)
+ ("YI SYLLABLE NDAX" . 41304)
+ ("YI SYLLABLE NDA" . 41305)
+ ("YI SYLLABLE NDAP" . 41306)
+ ("YI SYLLABLE NDOT" . 41307)
+ ("YI SYLLABLE NDOX" . 41308)
+ ("YI SYLLABLE NDO" . 41309)
+ ("YI SYLLABLE NDOP" . 41310)
+ ("YI SYLLABLE NDEX" . 41311)
+ ("YI SYLLABLE NDE" . 41312)
+ ("YI SYLLABLE NDEP" . 41313)
+ ("YI SYLLABLE NDUT" . 41314)
+ ("YI SYLLABLE NDUX" . 41315)
+ ("YI SYLLABLE NDU" . 41316)
+ ("YI SYLLABLE NDUP" . 41317)
+ ("YI SYLLABLE NDURX" . 41318)
+ ("YI SYLLABLE NDUR" . 41319)
+ ("YI SYLLABLE HNIT" . 41320)
+ ("YI SYLLABLE HNIX" . 41321)
+ ("YI SYLLABLE HNI" . 41322)
+ ("YI SYLLABLE HNIP" . 41323)
+ ("YI SYLLABLE HNIET" . 41324)
+ ("YI SYLLABLE HNIEX" . 41325)
+ ("YI SYLLABLE HNIE" . 41326)
+ ("YI SYLLABLE HNIEP" . 41327)
+ ("YI SYLLABLE HNAT" . 41328)
+ ("YI SYLLABLE HNAX" . 41329)
+ ("YI SYLLABLE HNA" . 41330)
+ ("YI SYLLABLE HNAP" . 41331)
+ ("YI SYLLABLE HNUOX" . 41332)
+ ("YI SYLLABLE HNUO" . 41333)
+ ("YI SYLLABLE HNOT" . 41334)
+ ("YI SYLLABLE HNOX" . 41335)
+ ("YI SYLLABLE HNOP" . 41336)
+ ("YI SYLLABLE HNEX" . 41337)
+ ("YI SYLLABLE HNE" . 41338)
+ ("YI SYLLABLE HNEP" . 41339)
+ ("YI SYLLABLE HNUT" . 41340)
+ ("YI SYLLABLE NIT" . 41341)
+ ("YI SYLLABLE NIX" . 41342)
+ ("YI SYLLABLE NI" . 41343)
+ ("YI SYLLABLE NIP" . 41344)
+ ("YI SYLLABLE NIEX" . 41345)
+ ("YI SYLLABLE NIE" . 41346)
+ ("YI SYLLABLE NIEP" . 41347)
+ ("YI SYLLABLE NAX" . 41348)
+ ("YI SYLLABLE NA" . 41349)
+ ("YI SYLLABLE NAP" . 41350)
+ ("YI SYLLABLE NUOX" . 41351)
+ ("YI SYLLABLE NUO" . 41352)
+ ("YI SYLLABLE NUOP" . 41353)
+ ("YI SYLLABLE NOT" . 41354)
+ ("YI SYLLABLE NOX" . 41355)
+ ("YI SYLLABLE NO" . 41356)
+ ("YI SYLLABLE NOP" . 41357)
+ ("YI SYLLABLE NEX" . 41358)
+ ("YI SYLLABLE NE" . 41359)
+ ("YI SYLLABLE NEP" . 41360)
+ ("YI SYLLABLE NUT" . 41361)
+ ("YI SYLLABLE NUX" . 41362)
+ ("YI SYLLABLE NU" . 41363)
+ ("YI SYLLABLE NUP" . 41364)
+ ("YI SYLLABLE NURX" . 41365)
+ ("YI SYLLABLE NUR" . 41366)
+ ("YI SYLLABLE HLIT" . 41367)
+ ("YI SYLLABLE HLIX" . 41368)
+ ("YI SYLLABLE HLI" . 41369)
+ ("YI SYLLABLE HLIP" . 41370)
+ ("YI SYLLABLE HLIEX" . 41371)
+ ("YI SYLLABLE HLIE" . 41372)
+ ("YI SYLLABLE HLIEP" . 41373)
+ ("YI SYLLABLE HLAT" . 41374)
+ ("YI SYLLABLE HLAX" . 41375)
+ ("YI SYLLABLE HLA" . 41376)
+ ("YI SYLLABLE HLAP" . 41377)
+ ("YI SYLLABLE HLUOX" . 41378)
+ ("YI SYLLABLE HLUO" . 41379)
+ ("YI SYLLABLE HLUOP" . 41380)
+ ("YI SYLLABLE HLOX" . 41381)
+ ("YI SYLLABLE HLO" . 41382)
+ ("YI SYLLABLE HLOP" . 41383)
+ ("YI SYLLABLE HLEX" . 41384)
+ ("YI SYLLABLE HLE" . 41385)
+ ("YI SYLLABLE HLEP" . 41386)
+ ("YI SYLLABLE HLUT" . 41387)
+ ("YI SYLLABLE HLUX" . 41388)
+ ("YI SYLLABLE HLU" . 41389)
+ ("YI SYLLABLE HLUP" . 41390)
+ ("YI SYLLABLE HLURX" . 41391)
+ ("YI SYLLABLE HLUR" . 41392)
+ ("YI SYLLABLE HLYT" . 41393)
+ ("YI SYLLABLE HLYX" . 41394)
+ ("YI SYLLABLE HLY" . 41395)
+ ("YI SYLLABLE HLYP" . 41396)
+ ("YI SYLLABLE HLYRX" . 41397)
+ ("YI SYLLABLE HLYR" . 41398)
+ ("YI SYLLABLE LIT" . 41399)
+ ("YI SYLLABLE LIX" . 41400)
+ ("YI SYLLABLE LI" . 41401)
+ ("YI SYLLABLE LIP" . 41402)
+ ("YI SYLLABLE LIET" . 41403)
+ ("YI SYLLABLE LIEX" . 41404)
+ ("YI SYLLABLE LIE" . 41405)
+ ("YI SYLLABLE LIEP" . 41406)
+ ("YI SYLLABLE LAT" . 41407)
+ ("YI SYLLABLE LAX" . 41408)
+ ("YI SYLLABLE LA" . 41409)
+ ("YI SYLLABLE LAP" . 41410)
+ ("YI SYLLABLE LUOT" . 41411)
+ ("YI SYLLABLE LUOX" . 41412)
+ ("YI SYLLABLE LUO" . 41413)
+ ("YI SYLLABLE LUOP" . 41414)
+ ("YI SYLLABLE LOT" . 41415)
+ ("YI SYLLABLE LOX" . 41416)
+ ("YI SYLLABLE LO" . 41417)
+ ("YI SYLLABLE LOP" . 41418)
+ ("YI SYLLABLE LEX" . 41419)
+ ("YI SYLLABLE LE" . 41420)
+ ("YI SYLLABLE LEP" . 41421)
+ ("YI SYLLABLE LUT" . 41422)
+ ("YI SYLLABLE LUX" . 41423)
+ ("YI SYLLABLE LU" . 41424)
+ ("YI SYLLABLE LUP" . 41425)
+ ("YI SYLLABLE LURX" . 41426)
+ ("YI SYLLABLE LUR" . 41427)
+ ("YI SYLLABLE LYT" . 41428)
+ ("YI SYLLABLE LYX" . 41429)
+ ("YI SYLLABLE LY" . 41430)
+ ("YI SYLLABLE LYP" . 41431)
+ ("YI SYLLABLE LYRX" . 41432)
+ ("YI SYLLABLE LYR" . 41433)
+ ("YI SYLLABLE GIT" . 41434)
+ ("YI SYLLABLE GIX" . 41435)
+ ("YI SYLLABLE GI" . 41436)
+ ("YI SYLLABLE GIP" . 41437)
+ ("YI SYLLABLE GIET" . 41438)
+ ("YI SYLLABLE GIEX" . 41439)
+ ("YI SYLLABLE GIE" . 41440)
+ ("YI SYLLABLE GIEP" . 41441)
+ ("YI SYLLABLE GAT" . 41442)
+ ("YI SYLLABLE GAX" . 41443)
+ ("YI SYLLABLE GA" . 41444)
+ ("YI SYLLABLE GAP" . 41445)
+ ("YI SYLLABLE GUOT" . 41446)
+ ("YI SYLLABLE GUOX" . 41447)
+ ("YI SYLLABLE GUO" . 41448)
+ ("YI SYLLABLE GUOP" . 41449)
+ ("YI SYLLABLE GOT" . 41450)
+ ("YI SYLLABLE GOX" . 41451)
+ ("YI SYLLABLE GO" . 41452)
+ ("YI SYLLABLE GOP" . 41453)
+ ("YI SYLLABLE GET" . 41454)
+ ("YI SYLLABLE GEX" . 41455)
+ ("YI SYLLABLE GE" . 41456)
+ ("YI SYLLABLE GEP" . 41457)
+ ("YI SYLLABLE GUT" . 41458)
+ ("YI SYLLABLE GUX" . 41459)
+ ("YI SYLLABLE GU" . 41460)
+ ("YI SYLLABLE GUP" . 41461)
+ ("YI SYLLABLE GURX" . 41462)
+ ("YI SYLLABLE GUR" . 41463)
+ ("YI SYLLABLE KIT" . 41464)
+ ("YI SYLLABLE KIX" . 41465)
+ ("YI SYLLABLE KI" . 41466)
+ ("YI SYLLABLE KIP" . 41467)
+ ("YI SYLLABLE KIEX" . 41468)
+ ("YI SYLLABLE KIE" . 41469)
+ ("YI SYLLABLE KIEP" . 41470)
+ ("YI SYLLABLE KAT" . 41471)
+ ("YI SYLLABLE KAX" . 41472)
+ ("YI SYLLABLE KA" . 41473)
+ ("YI SYLLABLE KAP" . 41474)
+ ("YI SYLLABLE KUOX" . 41475)
+ ("YI SYLLABLE KUO" . 41476)
+ ("YI SYLLABLE KUOP" . 41477)
+ ("YI SYLLABLE KOT" . 41478)
+ ("YI SYLLABLE KOX" . 41479)
+ ("YI SYLLABLE KO" . 41480)
+ ("YI SYLLABLE KOP" . 41481)
+ ("YI SYLLABLE KET" . 41482)
+ ("YI SYLLABLE KEX" . 41483)
+ ("YI SYLLABLE KE" . 41484)
+ ("YI SYLLABLE KEP" . 41485)
+ ("YI SYLLABLE KUT" . 41486)
+ ("YI SYLLABLE KUX" . 41487)
+ ("YI SYLLABLE KU" . 41488)
+ ("YI SYLLABLE KUP" . 41489)
+ ("YI SYLLABLE KURX" . 41490)
+ ("YI SYLLABLE KUR" . 41491)
+ ("YI SYLLABLE GGIT" . 41492)
+ ("YI SYLLABLE GGIX" . 41493)
+ ("YI SYLLABLE GGI" . 41494)
+ ("YI SYLLABLE GGIEX" . 41495)
+ ("YI SYLLABLE GGIE" . 41496)
+ ("YI SYLLABLE GGIEP" . 41497)
+ ("YI SYLLABLE GGAT" . 41498)
+ ("YI SYLLABLE GGAX" . 41499)
+ ("YI SYLLABLE GGA" . 41500)
+ ("YI SYLLABLE GGAP" . 41501)
+ ("YI SYLLABLE GGUOT" . 41502)
+ ("YI SYLLABLE GGUOX" . 41503)
+ ("YI SYLLABLE GGUO" . 41504)
+ ("YI SYLLABLE GGUOP" . 41505)
+ ("YI SYLLABLE GGOT" . 41506)
+ ("YI SYLLABLE GGOX" . 41507)
+ ("YI SYLLABLE GGO" . 41508)
+ ("YI SYLLABLE GGOP" . 41509)
+ ("YI SYLLABLE GGET" . 41510)
+ ("YI SYLLABLE GGEX" . 41511)
+ ("YI SYLLABLE GGE" . 41512)
+ ("YI SYLLABLE GGEP" . 41513)
+ ("YI SYLLABLE GGUT" . 41514)
+ ("YI SYLLABLE GGUX" . 41515)
+ ("YI SYLLABLE GGU" . 41516)
+ ("YI SYLLABLE GGUP" . 41517)
+ ("YI SYLLABLE GGURX" . 41518)
+ ("YI SYLLABLE GGUR" . 41519)
+ ("YI SYLLABLE MGIEX" . 41520)
+ ("YI SYLLABLE MGIE" . 41521)
+ ("YI SYLLABLE MGAT" . 41522)
+ ("YI SYLLABLE MGAX" . 41523)
+ ("YI SYLLABLE MGA" . 41524)
+ ("YI SYLLABLE MGAP" . 41525)
+ ("YI SYLLABLE MGUOX" . 41526)
+ ("YI SYLLABLE MGUO" . 41527)
+ ("YI SYLLABLE MGUOP" . 41528)
+ ("YI SYLLABLE MGOT" . 41529)
+ ("YI SYLLABLE MGOX" . 41530)
+ ("YI SYLLABLE MGO" . 41531)
+ ("YI SYLLABLE MGOP" . 41532)
+ ("YI SYLLABLE MGEX" . 41533)
+ ("YI SYLLABLE MGE" . 41534)
+ ("YI SYLLABLE MGEP" . 41535)
+ ("YI SYLLABLE MGUT" . 41536)
+ ("YI SYLLABLE MGUX" . 41537)
+ ("YI SYLLABLE MGU" . 41538)
+ ("YI SYLLABLE MGUP" . 41539)
+ ("YI SYLLABLE MGURX" . 41540)
+ ("YI SYLLABLE MGUR" . 41541)
+ ("YI SYLLABLE HXIT" . 41542)
+ ("YI SYLLABLE HXIX" . 41543)
+ ("YI SYLLABLE HXI" . 41544)
+ ("YI SYLLABLE HXIP" . 41545)
+ ("YI SYLLABLE HXIET" . 41546)
+ ("YI SYLLABLE HXIEX" . 41547)
+ ("YI SYLLABLE HXIE" . 41548)
+ ("YI SYLLABLE HXIEP" . 41549)
+ ("YI SYLLABLE HXAT" . 41550)
+ ("YI SYLLABLE HXAX" . 41551)
+ ("YI SYLLABLE HXA" . 41552)
+ ("YI SYLLABLE HXAP" . 41553)
+ ("YI SYLLABLE HXUOT" . 41554)
+ ("YI SYLLABLE HXUOX" . 41555)
+ ("YI SYLLABLE HXUO" . 41556)
+ ("YI SYLLABLE HXUOP" . 41557)
+ ("YI SYLLABLE HXOT" . 41558)
+ ("YI SYLLABLE HXOX" . 41559)
+ ("YI SYLLABLE HXO" . 41560)
+ ("YI SYLLABLE HXOP" . 41561)
+ ("YI SYLLABLE HXEX" . 41562)
+ ("YI SYLLABLE HXE" . 41563)
+ ("YI SYLLABLE HXEP" . 41564)
+ ("YI SYLLABLE NGIEX" . 41565)
+ ("YI SYLLABLE NGIE" . 41566)
+ ("YI SYLLABLE NGIEP" . 41567)
+ ("YI SYLLABLE NGAT" . 41568)
+ ("YI SYLLABLE NGAX" . 41569)
+ ("YI SYLLABLE NGA" . 41570)
+ ("YI SYLLABLE NGAP" . 41571)
+ ("YI SYLLABLE NGUOT" . 41572)
+ ("YI SYLLABLE NGUOX" . 41573)
+ ("YI SYLLABLE NGUO" . 41574)
+ ("YI SYLLABLE NGOT" . 41575)
+ ("YI SYLLABLE NGOX" . 41576)
+ ("YI SYLLABLE NGO" . 41577)
+ ("YI SYLLABLE NGOP" . 41578)
+ ("YI SYLLABLE NGEX" . 41579)
+ ("YI SYLLABLE NGE" . 41580)
+ ("YI SYLLABLE NGEP" . 41581)
+ ("YI SYLLABLE HIT" . 41582)
+ ("YI SYLLABLE HIEX" . 41583)
+ ("YI SYLLABLE HIE" . 41584)
+ ("YI SYLLABLE HAT" . 41585)
+ ("YI SYLLABLE HAX" . 41586)
+ ("YI SYLLABLE HA" . 41587)
+ ("YI SYLLABLE HAP" . 41588)
+ ("YI SYLLABLE HUOT" . 41589)
+ ("YI SYLLABLE HUOX" . 41590)
+ ("YI SYLLABLE HUO" . 41591)
+ ("YI SYLLABLE HUOP" . 41592)
+ ("YI SYLLABLE HOT" . 41593)
+ ("YI SYLLABLE HOX" . 41594)
+ ("YI SYLLABLE HO" . 41595)
+ ("YI SYLLABLE HOP" . 41596)
+ ("YI SYLLABLE HEX" . 41597)
+ ("YI SYLLABLE HE" . 41598)
+ ("YI SYLLABLE HEP" . 41599)
+ ("YI SYLLABLE WAT" . 41600)
+ ("YI SYLLABLE WAX" . 41601)
+ ("YI SYLLABLE WA" . 41602)
+ ("YI SYLLABLE WAP" . 41603)
+ ("YI SYLLABLE WUOX" . 41604)
+ ("YI SYLLABLE WUO" . 41605)
+ ("YI SYLLABLE WUOP" . 41606)
+ ("YI SYLLABLE WOX" . 41607)
+ ("YI SYLLABLE WO" . 41608)
+ ("YI SYLLABLE WOP" . 41609)
+ ("YI SYLLABLE WEX" . 41610)
+ ("YI SYLLABLE WE" . 41611)
+ ("YI SYLLABLE WEP" . 41612)
+ ("YI SYLLABLE ZIT" . 41613)
+ ("YI SYLLABLE ZIX" . 41614)
+ ("YI SYLLABLE ZI" . 41615)
+ ("YI SYLLABLE ZIP" . 41616)
+ ("YI SYLLABLE ZIEX" . 41617)
+ ("YI SYLLABLE ZIE" . 41618)
+ ("YI SYLLABLE ZIEP" . 41619)
+ ("YI SYLLABLE ZAT" . 41620)
+ ("YI SYLLABLE ZAX" . 41621)
+ ("YI SYLLABLE ZA" . 41622)
+ ("YI SYLLABLE ZAP" . 41623)
+ ("YI SYLLABLE ZUOX" . 41624)
+ ("YI SYLLABLE ZUO" . 41625)
+ ("YI SYLLABLE ZUOP" . 41626)
+ ("YI SYLLABLE ZOT" . 41627)
+ ("YI SYLLABLE ZOX" . 41628)
+ ("YI SYLLABLE ZO" . 41629)
+ ("YI SYLLABLE ZOP" . 41630)
+ ("YI SYLLABLE ZEX" . 41631)
+ ("YI SYLLABLE ZE" . 41632)
+ ("YI SYLLABLE ZEP" . 41633)
+ ("YI SYLLABLE ZUT" . 41634)
+ ("YI SYLLABLE ZUX" . 41635)
+ ("YI SYLLABLE ZU" . 41636)
+ ("YI SYLLABLE ZUP" . 41637)
+ ("YI SYLLABLE ZURX" . 41638)
+ ("YI SYLLABLE ZUR" . 41639)
+ ("YI SYLLABLE ZYT" . 41640)
+ ("YI SYLLABLE ZYX" . 41641)
+ ("YI SYLLABLE ZY" . 41642)
+ ("YI SYLLABLE ZYP" . 41643)
+ ("YI SYLLABLE ZYRX" . 41644)
+ ("YI SYLLABLE ZYR" . 41645)
+ ("YI SYLLABLE CIT" . 41646)
+ ("YI SYLLABLE CIX" . 41647)
+ ("YI SYLLABLE CI" . 41648)
+ ("YI SYLLABLE CIP" . 41649)
+ ("YI SYLLABLE CIET" . 41650)
+ ("YI SYLLABLE CIEX" . 41651)
+ ("YI SYLLABLE CIE" . 41652)
+ ("YI SYLLABLE CIEP" . 41653)
+ ("YI SYLLABLE CAT" . 41654)
+ ("YI SYLLABLE CAX" . 41655)
+ ("YI SYLLABLE CA" . 41656)
+ ("YI SYLLABLE CAP" . 41657)
+ ("YI SYLLABLE CUOX" . 41658)
+ ("YI SYLLABLE CUO" . 41659)
+ ("YI SYLLABLE CUOP" . 41660)
+ ("YI SYLLABLE COT" . 41661)
+ ("YI SYLLABLE COX" . 41662)
+ ("YI SYLLABLE CO" . 41663)
+ ("YI SYLLABLE COP" . 41664)
+ ("YI SYLLABLE CEX" . 41665)
+ ("YI SYLLABLE CE" . 41666)
+ ("YI SYLLABLE CEP" . 41667)
+ ("YI SYLLABLE CUT" . 41668)
+ ("YI SYLLABLE CUX" . 41669)
+ ("YI SYLLABLE CU" . 41670)
+ ("YI SYLLABLE CUP" . 41671)
+ ("YI SYLLABLE CURX" . 41672)
+ ("YI SYLLABLE CUR" . 41673)
+ ("YI SYLLABLE CYT" . 41674)
+ ("YI SYLLABLE CYX" . 41675)
+ ("YI SYLLABLE CY" . 41676)
+ ("YI SYLLABLE CYP" . 41677)
+ ("YI SYLLABLE CYRX" . 41678)
+ ("YI SYLLABLE CYR" . 41679)
+ ("YI SYLLABLE ZZIT" . 41680)
+ ("YI SYLLABLE ZZIX" . 41681)
+ ("YI SYLLABLE ZZI" . 41682)
+ ("YI SYLLABLE ZZIP" . 41683)
+ ("YI SYLLABLE ZZIET" . 41684)
+ ("YI SYLLABLE ZZIEX" . 41685)
+ ("YI SYLLABLE ZZIE" . 41686)
+ ("YI SYLLABLE ZZIEP" . 41687)
+ ("YI SYLLABLE ZZAT" . 41688)
+ ("YI SYLLABLE ZZAX" . 41689)
+ ("YI SYLLABLE ZZA" . 41690)
+ ("YI SYLLABLE ZZAP" . 41691)
+ ("YI SYLLABLE ZZOX" . 41692)
+ ("YI SYLLABLE ZZO" . 41693)
+ ("YI SYLLABLE ZZOP" . 41694)
+ ("YI SYLLABLE ZZEX" . 41695)
+ ("YI SYLLABLE ZZE" . 41696)
+ ("YI SYLLABLE ZZEP" . 41697)
+ ("YI SYLLABLE ZZUX" . 41698)
+ ("YI SYLLABLE ZZU" . 41699)
+ ("YI SYLLABLE ZZUP" . 41700)
+ ("YI SYLLABLE ZZURX" . 41701)
+ ("YI SYLLABLE ZZUR" . 41702)
+ ("YI SYLLABLE ZZYT" . 41703)
+ ("YI SYLLABLE ZZYX" . 41704)
+ ("YI SYLLABLE ZZY" . 41705)
+ ("YI SYLLABLE ZZYP" . 41706)
+ ("YI SYLLABLE ZZYRX" . 41707)
+ ("YI SYLLABLE ZZYR" . 41708)
+ ("YI SYLLABLE NZIT" . 41709)
+ ("YI SYLLABLE NZIX" . 41710)
+ ("YI SYLLABLE NZI" . 41711)
+ ("YI SYLLABLE NZIP" . 41712)
+ ("YI SYLLABLE NZIEX" . 41713)
+ ("YI SYLLABLE NZIE" . 41714)
+ ("YI SYLLABLE NZIEP" . 41715)
+ ("YI SYLLABLE NZAT" . 41716)
+ ("YI SYLLABLE NZAX" . 41717)
+ ("YI SYLLABLE NZA" . 41718)
+ ("YI SYLLABLE NZAP" . 41719)
+ ("YI SYLLABLE NZUOX" . 41720)
+ ("YI SYLLABLE NZUO" . 41721)
+ ("YI SYLLABLE NZOX" . 41722)
+ ("YI SYLLABLE NZOP" . 41723)
+ ("YI SYLLABLE NZEX" . 41724)
+ ("YI SYLLABLE NZE" . 41725)
+ ("YI SYLLABLE NZUX" . 41726)
+ ("YI SYLLABLE NZU" . 41727)
+ ("YI SYLLABLE NZUP" . 41728)
+ ("YI SYLLABLE NZURX" . 41729)
+ ("YI SYLLABLE NZUR" . 41730)
+ ("YI SYLLABLE NZYT" . 41731)
+ ("YI SYLLABLE NZYX" . 41732)
+ ("YI SYLLABLE NZY" . 41733)
+ ("YI SYLLABLE NZYP" . 41734)
+ ("YI SYLLABLE NZYRX" . 41735)
+ ("YI SYLLABLE NZYR" . 41736)
+ ("YI SYLLABLE SIT" . 41737)
+ ("YI SYLLABLE SIX" . 41738)
+ ("YI SYLLABLE SI" . 41739)
+ ("YI SYLLABLE SIP" . 41740)
+ ("YI SYLLABLE SIEX" . 41741)
+ ("YI SYLLABLE SIE" . 41742)
+ ("YI SYLLABLE SIEP" . 41743)
+ ("YI SYLLABLE SAT" . 41744)
+ ("YI SYLLABLE SAX" . 41745)
+ ("YI SYLLABLE SA" . 41746)
+ ("YI SYLLABLE SAP" . 41747)
+ ("YI SYLLABLE SUOX" . 41748)
+ ("YI SYLLABLE SUO" . 41749)
+ ("YI SYLLABLE SUOP" . 41750)
+ ("YI SYLLABLE SOT" . 41751)
+ ("YI SYLLABLE SOX" . 41752)
+ ("YI SYLLABLE SO" . 41753)
+ ("YI SYLLABLE SOP" . 41754)
+ ("YI SYLLABLE SEX" . 41755)
+ ("YI SYLLABLE SE" . 41756)
+ ("YI SYLLABLE SEP" . 41757)
+ ("YI SYLLABLE SUT" . 41758)
+ ("YI SYLLABLE SUX" . 41759)
+ ("YI SYLLABLE SU" . 41760)
+ ("YI SYLLABLE SUP" . 41761)
+ ("YI SYLLABLE SURX" . 41762)
+ ("YI SYLLABLE SUR" . 41763)
+ ("YI SYLLABLE SYT" . 41764)
+ ("YI SYLLABLE SYX" . 41765)
+ ("YI SYLLABLE SY" . 41766)
+ ("YI SYLLABLE SYP" . 41767)
+ ("YI SYLLABLE SYRX" . 41768)
+ ("YI SYLLABLE SYR" . 41769)
+ ("YI SYLLABLE SSIT" . 41770)
+ ("YI SYLLABLE SSIX" . 41771)
+ ("YI SYLLABLE SSI" . 41772)
+ ("YI SYLLABLE SSIP" . 41773)
+ ("YI SYLLABLE SSIEX" . 41774)
+ ("YI SYLLABLE SSIE" . 41775)
+ ("YI SYLLABLE SSIEP" . 41776)
+ ("YI SYLLABLE SSAT" . 41777)
+ ("YI SYLLABLE SSAX" . 41778)
+ ("YI SYLLABLE SSA" . 41779)
+ ("YI SYLLABLE SSAP" . 41780)
+ ("YI SYLLABLE SSOT" . 41781)
+ ("YI SYLLABLE SSOX" . 41782)
+ ("YI SYLLABLE SSO" . 41783)
+ ("YI SYLLABLE SSOP" . 41784)
+ ("YI SYLLABLE SSEX" . 41785)
+ ("YI SYLLABLE SSE" . 41786)
+ ("YI SYLLABLE SSEP" . 41787)
+ ("YI SYLLABLE SSUT" . 41788)
+ ("YI SYLLABLE SSUX" . 41789)
+ ("YI SYLLABLE SSU" . 41790)
+ ("YI SYLLABLE SSUP" . 41791)
+ ("YI SYLLABLE SSYT" . 41792)
+ ("YI SYLLABLE SSYX" . 41793)
+ ("YI SYLLABLE SSY" . 41794)
+ ("YI SYLLABLE SSYP" . 41795)
+ ("YI SYLLABLE SSYRX" . 41796)
+ ("YI SYLLABLE SSYR" . 41797)
+ ("YI SYLLABLE ZHAT" . 41798)
+ ("YI SYLLABLE ZHAX" . 41799)
+ ("YI SYLLABLE ZHA" . 41800)
+ ("YI SYLLABLE ZHAP" . 41801)
+ ("YI SYLLABLE ZHUOX" . 41802)
+ ("YI SYLLABLE ZHUO" . 41803)
+ ("YI SYLLABLE ZHUOP" . 41804)
+ ("YI SYLLABLE ZHOT" . 41805)
+ ("YI SYLLABLE ZHOX" . 41806)
+ ("YI SYLLABLE ZHO" . 41807)
+ ("YI SYLLABLE ZHOP" . 41808)
+ ("YI SYLLABLE ZHET" . 41809)
+ ("YI SYLLABLE ZHEX" . 41810)
+ ("YI SYLLABLE ZHE" . 41811)
+ ("YI SYLLABLE ZHEP" . 41812)
+ ("YI SYLLABLE ZHUT" . 41813)
+ ("YI SYLLABLE ZHUX" . 41814)
+ ("YI SYLLABLE ZHU" . 41815)
+ ("YI SYLLABLE ZHUP" . 41816)
+ ("YI SYLLABLE ZHURX" . 41817)
+ ("YI SYLLABLE ZHUR" . 41818)
+ ("YI SYLLABLE ZHYT" . 41819)
+ ("YI SYLLABLE ZHYX" . 41820)
+ ("YI SYLLABLE ZHY" . 41821)
+ ("YI SYLLABLE ZHYP" . 41822)
+ ("YI SYLLABLE ZHYRX" . 41823)
+ ("YI SYLLABLE ZHYR" . 41824)
+ ("YI SYLLABLE CHAT" . 41825)
+ ("YI SYLLABLE CHAX" . 41826)
+ ("YI SYLLABLE CHA" . 41827)
+ ("YI SYLLABLE CHAP" . 41828)
+ ("YI SYLLABLE CHUOT" . 41829)
+ ("YI SYLLABLE CHUOX" . 41830)
+ ("YI SYLLABLE CHUO" . 41831)
+ ("YI SYLLABLE CHUOP" . 41832)
+ ("YI SYLLABLE CHOT" . 41833)
+ ("YI SYLLABLE CHOX" . 41834)
+ ("YI SYLLABLE CHO" . 41835)
+ ("YI SYLLABLE CHOP" . 41836)
+ ("YI SYLLABLE CHET" . 41837)
+ ("YI SYLLABLE CHEX" . 41838)
+ ("YI SYLLABLE CHE" . 41839)
+ ("YI SYLLABLE CHEP" . 41840)
+ ("YI SYLLABLE CHUX" . 41841)
+ ("YI SYLLABLE CHU" . 41842)
+ ("YI SYLLABLE CHUP" . 41843)
+ ("YI SYLLABLE CHURX" . 41844)
+ ("YI SYLLABLE CHUR" . 41845)
+ ("YI SYLLABLE CHYT" . 41846)
+ ("YI SYLLABLE CHYX" . 41847)
+ ("YI SYLLABLE CHY" . 41848)
+ ("YI SYLLABLE CHYP" . 41849)
+ ("YI SYLLABLE CHYRX" . 41850)
+ ("YI SYLLABLE CHYR" . 41851)
+ ("YI SYLLABLE RRAX" . 41852)
+ ("YI SYLLABLE RRA" . 41853)
+ ("YI SYLLABLE RRUOX" . 41854)
+ ("YI SYLLABLE RRUO" . 41855)
+ ("YI SYLLABLE RROT" . 41856)
+ ("YI SYLLABLE RROX" . 41857)
+ ("YI SYLLABLE RRO" . 41858)
+ ("YI SYLLABLE RROP" . 41859)
+ ("YI SYLLABLE RRET" . 41860)
+ ("YI SYLLABLE RREX" . 41861)
+ ("YI SYLLABLE RRE" . 41862)
+ ("YI SYLLABLE RREP" . 41863)
+ ("YI SYLLABLE RRUT" . 41864)
+ ("YI SYLLABLE RRUX" . 41865)
+ ("YI SYLLABLE RRU" . 41866)
+ ("YI SYLLABLE RRUP" . 41867)
+ ("YI SYLLABLE RRURX" . 41868)
+ ("YI SYLLABLE RRUR" . 41869)
+ ("YI SYLLABLE RRYT" . 41870)
+ ("YI SYLLABLE RRYX" . 41871)
+ ("YI SYLLABLE RRY" . 41872)
+ ("YI SYLLABLE RRYP" . 41873)
+ ("YI SYLLABLE RRYRX" . 41874)
+ ("YI SYLLABLE RRYR" . 41875)
+ ("YI SYLLABLE NRAT" . 41876)
+ ("YI SYLLABLE NRAX" . 41877)
+ ("YI SYLLABLE NRA" . 41878)
+ ("YI SYLLABLE NRAP" . 41879)
+ ("YI SYLLABLE NROX" . 41880)
+ ("YI SYLLABLE NRO" . 41881)
+ ("YI SYLLABLE NROP" . 41882)
+ ("YI SYLLABLE NRET" . 41883)
+ ("YI SYLLABLE NREX" . 41884)
+ ("YI SYLLABLE NRE" . 41885)
+ ("YI SYLLABLE NREP" . 41886)
+ ("YI SYLLABLE NRUT" . 41887)
+ ("YI SYLLABLE NRUX" . 41888)
+ ("YI SYLLABLE NRU" . 41889)
+ ("YI SYLLABLE NRUP" . 41890)
+ ("YI SYLLABLE NRURX" . 41891)
+ ("YI SYLLABLE NRUR" . 41892)
+ ("YI SYLLABLE NRYT" . 41893)
+ ("YI SYLLABLE NRYX" . 41894)
+ ("YI SYLLABLE NRY" . 41895)
+ ("YI SYLLABLE NRYP" . 41896)
+ ("YI SYLLABLE NRYRX" . 41897)
+ ("YI SYLLABLE NRYR" . 41898)
+ ("YI SYLLABLE SHAT" . 41899)
+ ("YI SYLLABLE SHAX" . 41900)
+ ("YI SYLLABLE SHA" . 41901)
+ ("YI SYLLABLE SHAP" . 41902)
+ ("YI SYLLABLE SHUOX" . 41903)
+ ("YI SYLLABLE SHUO" . 41904)
+ ("YI SYLLABLE SHUOP" . 41905)
+ ("YI SYLLABLE SHOT" . 41906)
+ ("YI SYLLABLE SHOX" . 41907)
+ ("YI SYLLABLE SHO" . 41908)
+ ("YI SYLLABLE SHOP" . 41909)
+ ("YI SYLLABLE SHET" . 41910)
+ ("YI SYLLABLE SHEX" . 41911)
+ ("YI SYLLABLE SHE" . 41912)
+ ("YI SYLLABLE SHEP" . 41913)
+ ("YI SYLLABLE SHUT" . 41914)
+ ("YI SYLLABLE SHUX" . 41915)
+ ("YI SYLLABLE SHU" . 41916)
+ ("YI SYLLABLE SHUP" . 41917)
+ ("YI SYLLABLE SHURX" . 41918)
+ ("YI SYLLABLE SHUR" . 41919)
+ ("YI SYLLABLE SHYT" . 41920)
+ ("YI SYLLABLE SHYX" . 41921)
+ ("YI SYLLABLE SHY" . 41922)
+ ("YI SYLLABLE SHYP" . 41923)
+ ("YI SYLLABLE SHYRX" . 41924)
+ ("YI SYLLABLE SHYR" . 41925)
+ ("YI SYLLABLE RAT" . 41926)
+ ("YI SYLLABLE RAX" . 41927)
+ ("YI SYLLABLE RA" . 41928)
+ ("YI SYLLABLE RAP" . 41929)
+ ("YI SYLLABLE RUOX" . 41930)
+ ("YI SYLLABLE RUO" . 41931)
+ ("YI SYLLABLE RUOP" . 41932)
+ ("YI SYLLABLE ROT" . 41933)
+ ("YI SYLLABLE ROX" . 41934)
+ ("YI SYLLABLE RO" . 41935)
+ ("YI SYLLABLE ROP" . 41936)
+ ("YI SYLLABLE REX" . 41937)
+ ("YI SYLLABLE RE" . 41938)
+ ("YI SYLLABLE REP" . 41939)
+ ("YI SYLLABLE RUT" . 41940)
+ ("YI SYLLABLE RUX" . 41941)
+ ("YI SYLLABLE RU" . 41942)
+ ("YI SYLLABLE RUP" . 41943)
+ ("YI SYLLABLE RURX" . 41944)
+ ("YI SYLLABLE RUR" . 41945)
+ ("YI SYLLABLE RYT" . 41946)
+ ("YI SYLLABLE RYX" . 41947)
+ ("YI SYLLABLE RY" . 41948)
+ ("YI SYLLABLE RYP" . 41949)
+ ("YI SYLLABLE RYRX" . 41950)
+ ("YI SYLLABLE RYR" . 41951)
+ ("YI SYLLABLE JIT" . 41952)
+ ("YI SYLLABLE JIX" . 41953)
+ ("YI SYLLABLE JI" . 41954)
+ ("YI SYLLABLE JIP" . 41955)
+ ("YI SYLLABLE JIET" . 41956)
+ ("YI SYLLABLE JIEX" . 41957)
+ ("YI SYLLABLE JIE" . 41958)
+ ("YI SYLLABLE JIEP" . 41959)
+ ("YI SYLLABLE JUOT" . 41960)
+ ("YI SYLLABLE JUOX" . 41961)
+ ("YI SYLLABLE JUO" . 41962)
+ ("YI SYLLABLE JUOP" . 41963)
+ ("YI SYLLABLE JOT" . 41964)
+ ("YI SYLLABLE JOX" . 41965)
+ ("YI SYLLABLE JO" . 41966)
+ ("YI SYLLABLE JOP" . 41967)
+ ("YI SYLLABLE JUT" . 41968)
+ ("YI SYLLABLE JUX" . 41969)
+ ("YI SYLLABLE JU" . 41970)
+ ("YI SYLLABLE JUP" . 41971)
+ ("YI SYLLABLE JURX" . 41972)
+ ("YI SYLLABLE JUR" . 41973)
+ ("YI SYLLABLE JYT" . 41974)
+ ("YI SYLLABLE JYX" . 41975)
+ ("YI SYLLABLE JY" . 41976)
+ ("YI SYLLABLE JYP" . 41977)
+ ("YI SYLLABLE JYRX" . 41978)
+ ("YI SYLLABLE JYR" . 41979)
+ ("YI SYLLABLE QIT" . 41980)
+ ("YI SYLLABLE QIX" . 41981)
+ ("YI SYLLABLE QI" . 41982)
+ ("YI SYLLABLE QIP" . 41983)
+ ("YI SYLLABLE QIET" . 41984)
+ ("YI SYLLABLE QIEX" . 41985)
+ ("YI SYLLABLE QIE" . 41986)
+ ("YI SYLLABLE QIEP" . 41987)
+ ("YI SYLLABLE QUOT" . 41988)
+ ("YI SYLLABLE QUOX" . 41989)
+ ("YI SYLLABLE QUO" . 41990)
+ ("YI SYLLABLE QUOP" . 41991)
+ ("YI SYLLABLE QOT" . 41992)
+ ("YI SYLLABLE QOX" . 41993)
+ ("YI SYLLABLE QO" . 41994)
+ ("YI SYLLABLE QOP" . 41995)
+ ("YI SYLLABLE QUT" . 41996)
+ ("YI SYLLABLE QUX" . 41997)
+ ("YI SYLLABLE QU" . 41998)
+ ("YI SYLLABLE QUP" . 41999)
+ ("YI SYLLABLE QURX" . 42000)
+ ("YI SYLLABLE QUR" . 42001)
+ ("YI SYLLABLE QYT" . 42002)
+ ("YI SYLLABLE QYX" . 42003)
+ ("YI SYLLABLE QY" . 42004)
+ ("YI SYLLABLE QYP" . 42005)
+ ("YI SYLLABLE QYRX" . 42006)
+ ("YI SYLLABLE QYR" . 42007)
+ ("YI SYLLABLE JJIT" . 42008)
+ ("YI SYLLABLE JJIX" . 42009)
+ ("YI SYLLABLE JJI" . 42010)
+ ("YI SYLLABLE JJIP" . 42011)
+ ("YI SYLLABLE JJIET" . 42012)
+ ("YI SYLLABLE JJIEX" . 42013)
+ ("YI SYLLABLE JJIE" . 42014)
+ ("YI SYLLABLE JJIEP" . 42015)
+ ("YI SYLLABLE JJUOX" . 42016)
+ ("YI SYLLABLE JJUO" . 42017)
+ ("YI SYLLABLE JJUOP" . 42018)
+ ("YI SYLLABLE JJOT" . 42019)
+ ("YI SYLLABLE JJOX" . 42020)
+ ("YI SYLLABLE JJO" . 42021)
+ ("YI SYLLABLE JJOP" . 42022)
+ ("YI SYLLABLE JJUT" . 42023)
+ ("YI SYLLABLE JJUX" . 42024)
+ ("YI SYLLABLE JJU" . 42025)
+ ("YI SYLLABLE JJUP" . 42026)
+ ("YI SYLLABLE JJURX" . 42027)
+ ("YI SYLLABLE JJUR" . 42028)
+ ("YI SYLLABLE JJYT" . 42029)
+ ("YI SYLLABLE JJYX" . 42030)
+ ("YI SYLLABLE JJY" . 42031)
+ ("YI SYLLABLE JJYP" . 42032)
+ ("YI SYLLABLE NJIT" . 42033)
+ ("YI SYLLABLE NJIX" . 42034)
+ ("YI SYLLABLE NJI" . 42035)
+ ("YI SYLLABLE NJIP" . 42036)
+ ("YI SYLLABLE NJIET" . 42037)
+ ("YI SYLLABLE NJIEX" . 42038)
+ ("YI SYLLABLE NJIE" . 42039)
+ ("YI SYLLABLE NJIEP" . 42040)
+ ("YI SYLLABLE NJUOX" . 42041)
+ ("YI SYLLABLE NJUO" . 42042)
+ ("YI SYLLABLE NJOT" . 42043)
+ ("YI SYLLABLE NJOX" . 42044)
+ ("YI SYLLABLE NJO" . 42045)
+ ("YI SYLLABLE NJOP" . 42046)
+ ("YI SYLLABLE NJUX" . 42047)
+ ("YI SYLLABLE NJU" . 42048)
+ ("YI SYLLABLE NJUP" . 42049)
+ ("YI SYLLABLE NJURX" . 42050)
+ ("YI SYLLABLE NJUR" . 42051)
+ ("YI SYLLABLE NJYT" . 42052)
+ ("YI SYLLABLE NJYX" . 42053)
+ ("YI SYLLABLE NJY" . 42054)
+ ("YI SYLLABLE NJYP" . 42055)
+ ("YI SYLLABLE NJYRX" . 42056)
+ ("YI SYLLABLE NJYR" . 42057)
+ ("YI SYLLABLE NYIT" . 42058)
+ ("YI SYLLABLE NYIX" . 42059)
+ ("YI SYLLABLE NYI" . 42060)
+ ("YI SYLLABLE NYIP" . 42061)
+ ("YI SYLLABLE NYIET" . 42062)
+ ("YI SYLLABLE NYIEX" . 42063)
+ ("YI SYLLABLE NYIE" . 42064)
+ ("YI SYLLABLE NYIEP" . 42065)
+ ("YI SYLLABLE NYUOX" . 42066)
+ ("YI SYLLABLE NYUO" . 42067)
+ ("YI SYLLABLE NYUOP" . 42068)
+ ("YI SYLLABLE NYOT" . 42069)
+ ("YI SYLLABLE NYOX" . 42070)
+ ("YI SYLLABLE NYO" . 42071)
+ ("YI SYLLABLE NYOP" . 42072)
+ ("YI SYLLABLE NYUT" . 42073)
+ ("YI SYLLABLE NYUX" . 42074)
+ ("YI SYLLABLE NYU" . 42075)
+ ("YI SYLLABLE NYUP" . 42076)
+ ("YI SYLLABLE XIT" . 42077)
+ ("YI SYLLABLE XIX" . 42078)
+ ("YI SYLLABLE XI" . 42079)
+ ("YI SYLLABLE XIP" . 42080)
+ ("YI SYLLABLE XIET" . 42081)
+ ("YI SYLLABLE XIEX" . 42082)
+ ("YI SYLLABLE XIE" . 42083)
+ ("YI SYLLABLE XIEP" . 42084)
+ ("YI SYLLABLE XUOX" . 42085)
+ ("YI SYLLABLE XUO" . 42086)
+ ("YI SYLLABLE XOT" . 42087)
+ ("YI SYLLABLE XOX" . 42088)
+ ("YI SYLLABLE XO" . 42089)
+ ("YI SYLLABLE XOP" . 42090)
+ ("YI SYLLABLE XYT" . 42091)
+ ("YI SYLLABLE XYX" . 42092)
+ ("YI SYLLABLE XY" . 42093)
+ ("YI SYLLABLE XYP" . 42094)
+ ("YI SYLLABLE XYRX" . 42095)
+ ("YI SYLLABLE XYR" . 42096)
+ ("YI SYLLABLE YIT" . 42097)
+ ("YI SYLLABLE YIX" . 42098)
+ ("YI SYLLABLE YI" . 42099)
+ ("YI SYLLABLE YIP" . 42100)
+ ("YI SYLLABLE YIET" . 42101)
+ ("YI SYLLABLE YIEX" . 42102)
+ ("YI SYLLABLE YIE" . 42103)
+ ("YI SYLLABLE YIEP" . 42104)
+ ("YI SYLLABLE YUOT" . 42105)
+ ("YI SYLLABLE YUOX" . 42106)
+ ("YI SYLLABLE YUO" . 42107)
+ ("YI SYLLABLE YUOP" . 42108)
+ ("YI SYLLABLE YOT" . 42109)
+ ("YI SYLLABLE YOX" . 42110)
+ ("YI SYLLABLE YO" . 42111)
+ ("YI SYLLABLE YOP" . 42112)
+ ("YI SYLLABLE YUT" . 42113)
+ ("YI SYLLABLE YUX" . 42114)
+ ("YI SYLLABLE YU" . 42115)
+ ("YI SYLLABLE YUP" . 42116)
+ ("YI SYLLABLE YURX" . 42117)
+ ("YI SYLLABLE YUR" . 42118)
+ ("YI SYLLABLE YYT" . 42119)
+ ("YI SYLLABLE YYX" . 42120)
+ ("YI SYLLABLE YY" . 42121)
+ ("YI SYLLABLE YYP" . 42122)
+ ("YI SYLLABLE YYRX" . 42123)
+ ("YI SYLLABLE YYR" . 42124)
+ ("YI RADICAL QOT" . 42128)
+ ("YI RADICAL LI" . 42129)
+ ("YI RADICAL KIT" . 42130)
+ ("YI RADICAL NYIP" . 42131)
+ ("YI RADICAL CYP" . 42132)
+ ("YI RADICAL SSI" . 42133)
+ ("YI RADICAL GGOP" . 42134)
+ ("YI RADICAL GEP" . 42135)
+ ("YI RADICAL MI" . 42136)
+ ("YI RADICAL HXIT" . 42137)
+ ("YI RADICAL LYR" . 42138)
+ ("YI RADICAL BBUT" . 42139)
+ ("YI RADICAL MOP" . 42140)
+ ("YI RADICAL YO" . 42141)
+ ("YI RADICAL PUT" . 42142)
+ ("YI RADICAL HXUO" . 42143)
+ ("YI RADICAL TAT" . 42144)
+ ("YI RADICAL GA" . 42145)
+ ("YI RADICAL ZUP" . 42146)
+ ("YI RADICAL CYT" . 42147)
+ ("YI RADICAL DDUR" . 42148)
+ ("YI RADICAL BUR" . 42149)
+ ("YI RADICAL GGUO" . 42150)
+ ("YI RADICAL NYOP" . 42151)
+ ("YI RADICAL TU" . 42152)
+ ("YI RADICAL OP" . 42153)
+ ("YI RADICAL JJUT" . 42154)
+ ("YI RADICAL ZOT" . 42155)
+ ("YI RADICAL PYT" . 42156)
+ ("YI RADICAL HMO" . 42157)
+ ("YI RADICAL YIT" . 42158)
+ ("YI RADICAL VUR" . 42159)
+ ("YI RADICAL SHY" . 42160)
+ ("YI RADICAL VEP" . 42161)
+ ("YI RADICAL ZA" . 42162)
+ ("YI RADICAL JO" . 42163)
+ ("YI RADICAL NZUP" . 42164)
+ ("YI RADICAL JJY" . 42165)
+ ("YI RADICAL GOT" . 42166)
+ ("YI RADICAL JJIE" . 42167)
+ ("YI RADICAL WO" . 42168)
+ ("YI RADICAL DU" . 42169)
+ ("YI RADICAL SHUR" . 42170)
+ ("YI RADICAL LIE" . 42171)
+ ("YI RADICAL CY" . 42172)
+ ("YI RADICAL CUOP" . 42173)
+ ("YI RADICAL CIP" . 42174)
+ ("YI RADICAL HXOP" . 42175)
+ ("YI RADICAL SHAT" . 42176)
+ ("YI RADICAL ZUR" . 42177)
+ ("YI RADICAL SHOP" . 42178)
+ ("YI RADICAL CHE" . 42179)
+ ("YI RADICAL ZZIET" . 42180)
+ ("YI RADICAL NBIE" . 42181)
+ ("YI RADICAL KE" . 42182)
+ ("CJK COMPATIBILITY IDEOGRAPH-F900" . 63744)
+ ("CJK COMPATIBILITY IDEOGRAPH-F901" . 63745)
+ ("CJK COMPATIBILITY IDEOGRAPH-F902" . 63746)
+ ("CJK COMPATIBILITY IDEOGRAPH-F903" . 63747)
+ ("CJK COMPATIBILITY IDEOGRAPH-F904" . 63748)
+ ("CJK COMPATIBILITY IDEOGRAPH-F905" . 63749)
+ ("CJK COMPATIBILITY IDEOGRAPH-F906" . 63750)
+ ("CJK COMPATIBILITY IDEOGRAPH-F907" . 63751)
+ ("CJK COMPATIBILITY IDEOGRAPH-F908" . 63752)
+ ("CJK COMPATIBILITY IDEOGRAPH-F909" . 63753)
+ ("CJK COMPATIBILITY IDEOGRAPH-F90A" . 63754)
+ ("CJK COMPATIBILITY IDEOGRAPH-F90B" . 63755)
+ ("CJK COMPATIBILITY IDEOGRAPH-F90C" . 63756)
+ ("CJK COMPATIBILITY IDEOGRAPH-F90D" . 63757)
+ ("CJK COMPATIBILITY IDEOGRAPH-F90E" . 63758)
+ ("CJK COMPATIBILITY IDEOGRAPH-F90F" . 63759)
+ ("CJK COMPATIBILITY IDEOGRAPH-F910" . 63760)
+ ("CJK COMPATIBILITY IDEOGRAPH-F911" . 63761)
+ ("CJK COMPATIBILITY IDEOGRAPH-F912" . 63762)
+ ("CJK COMPATIBILITY IDEOGRAPH-F913" . 63763)
+ ("CJK COMPATIBILITY IDEOGRAPH-F914" . 63764)
+ ("CJK COMPATIBILITY IDEOGRAPH-F915" . 63765)
+ ("CJK COMPATIBILITY IDEOGRAPH-F916" . 63766)
+ ("CJK COMPATIBILITY IDEOGRAPH-F917" . 63767)
+ ("CJK COMPATIBILITY IDEOGRAPH-F918" . 63768)
+ ("CJK COMPATIBILITY IDEOGRAPH-F919" . 63769)
+ ("CJK COMPATIBILITY IDEOGRAPH-F91A" . 63770)
+ ("CJK COMPATIBILITY IDEOGRAPH-F91B" . 63771)
+ ("CJK COMPATIBILITY IDEOGRAPH-F91C" . 63772)
+ ("CJK COMPATIBILITY IDEOGRAPH-F91D" . 63773)
+ ("CJK COMPATIBILITY IDEOGRAPH-F91E" . 63774)
+ ("CJK COMPATIBILITY IDEOGRAPH-F91F" . 63775)
+ ("CJK COMPATIBILITY IDEOGRAPH-F920" . 63776)
+ ("CJK COMPATIBILITY IDEOGRAPH-F921" . 63777)
+ ("CJK COMPATIBILITY IDEOGRAPH-F922" . 63778)
+ ("CJK COMPATIBILITY IDEOGRAPH-F923" . 63779)
+ ("CJK COMPATIBILITY IDEOGRAPH-F924" . 63780)
+ ("CJK COMPATIBILITY IDEOGRAPH-F925" . 63781)
+ ("CJK COMPATIBILITY IDEOGRAPH-F926" . 63782)
+ ("CJK COMPATIBILITY IDEOGRAPH-F927" . 63783)
+ ("CJK COMPATIBILITY IDEOGRAPH-F928" . 63784)
+ ("CJK COMPATIBILITY IDEOGRAPH-F929" . 63785)
+ ("CJK COMPATIBILITY IDEOGRAPH-F92A" . 63786)
+ ("CJK COMPATIBILITY IDEOGRAPH-F92B" . 63787)
+ ("CJK COMPATIBILITY IDEOGRAPH-F92C" . 63788)
+ ("CJK COMPATIBILITY IDEOGRAPH-F92D" . 63789)
+ ("CJK COMPATIBILITY IDEOGRAPH-F92E" . 63790)
+ ("CJK COMPATIBILITY IDEOGRAPH-F92F" . 63791)
+ ("CJK COMPATIBILITY IDEOGRAPH-F930" . 63792)
+ ("CJK COMPATIBILITY IDEOGRAPH-F931" . 63793)
+ ("CJK COMPATIBILITY IDEOGRAPH-F932" . 63794)
+ ("CJK COMPATIBILITY IDEOGRAPH-F933" . 63795)
+ ("CJK COMPATIBILITY IDEOGRAPH-F934" . 63796)
+ ("CJK COMPATIBILITY IDEOGRAPH-F935" . 63797)
+ ("CJK COMPATIBILITY IDEOGRAPH-F936" . 63798)
+ ("CJK COMPATIBILITY IDEOGRAPH-F937" . 63799)
+ ("CJK COMPATIBILITY IDEOGRAPH-F938" . 63800)
+ ("CJK COMPATIBILITY IDEOGRAPH-F939" . 63801)
+ ("CJK COMPATIBILITY IDEOGRAPH-F93A" . 63802)
+ ("CJK COMPATIBILITY IDEOGRAPH-F93B" . 63803)
+ ("CJK COMPATIBILITY IDEOGRAPH-F93C" . 63804)
+ ("CJK COMPATIBILITY IDEOGRAPH-F93D" . 63805)
+ ("CJK COMPATIBILITY IDEOGRAPH-F93E" . 63806)
+ ("CJK COMPATIBILITY IDEOGRAPH-F93F" . 63807)
+ ("CJK COMPATIBILITY IDEOGRAPH-F940" . 63808)
+ ("CJK COMPATIBILITY IDEOGRAPH-F941" . 63809)
+ ("CJK COMPATIBILITY IDEOGRAPH-F942" . 63810)
+ ("CJK COMPATIBILITY IDEOGRAPH-F943" . 63811)
+ ("CJK COMPATIBILITY IDEOGRAPH-F944" . 63812)
+ ("CJK COMPATIBILITY IDEOGRAPH-F945" . 63813)
+ ("CJK COMPATIBILITY IDEOGRAPH-F946" . 63814)
+ ("CJK COMPATIBILITY IDEOGRAPH-F947" . 63815)
+ ("CJK COMPATIBILITY IDEOGRAPH-F948" . 63816)
+ ("CJK COMPATIBILITY IDEOGRAPH-F949" . 63817)
+ ("CJK COMPATIBILITY IDEOGRAPH-F94A" . 63818)
+ ("CJK COMPATIBILITY IDEOGRAPH-F94B" . 63819)
+ ("CJK COMPATIBILITY IDEOGRAPH-F94C" . 63820)
+ ("CJK COMPATIBILITY IDEOGRAPH-F94D" . 63821)
+ ("CJK COMPATIBILITY IDEOGRAPH-F94E" . 63822)
+ ("CJK COMPATIBILITY IDEOGRAPH-F94F" . 63823)
+ ("CJK COMPATIBILITY IDEOGRAPH-F950" . 63824)
+ ("CJK COMPATIBILITY IDEOGRAPH-F951" . 63825)
+ ("CJK COMPATIBILITY IDEOGRAPH-F952" . 63826)
+ ("CJK COMPATIBILITY IDEOGRAPH-F953" . 63827)
+ ("CJK COMPATIBILITY IDEOGRAPH-F954" . 63828)
+ ("CJK COMPATIBILITY IDEOGRAPH-F955" . 63829)
+ ("CJK COMPATIBILITY IDEOGRAPH-F956" . 63830)
+ ("CJK COMPATIBILITY IDEOGRAPH-F957" . 63831)
+ ("CJK COMPATIBILITY IDEOGRAPH-F958" . 63832)
+ ("CJK COMPATIBILITY IDEOGRAPH-F959" . 63833)
+ ("CJK COMPATIBILITY IDEOGRAPH-F95A" . 63834)
+ ("CJK COMPATIBILITY IDEOGRAPH-F95B" . 63835)
+ ("CJK COMPATIBILITY IDEOGRAPH-F95C" . 63836)
+ ("CJK COMPATIBILITY IDEOGRAPH-F95D" . 63837)
+ ("CJK COMPATIBILITY IDEOGRAPH-F95E" . 63838)
+ ("CJK COMPATIBILITY IDEOGRAPH-F95F" . 63839)
+ ("CJK COMPATIBILITY IDEOGRAPH-F960" . 63840)
+ ("CJK COMPATIBILITY IDEOGRAPH-F961" . 63841)
+ ("CJK COMPATIBILITY IDEOGRAPH-F962" . 63842)
+ ("CJK COMPATIBILITY IDEOGRAPH-F963" . 63843)
+ ("CJK COMPATIBILITY IDEOGRAPH-F964" . 63844)
+ ("CJK COMPATIBILITY IDEOGRAPH-F965" . 63845)
+ ("CJK COMPATIBILITY IDEOGRAPH-F966" . 63846)
+ ("CJK COMPATIBILITY IDEOGRAPH-F967" . 63847)
+ ("CJK COMPATIBILITY IDEOGRAPH-F968" . 63848)
+ ("CJK COMPATIBILITY IDEOGRAPH-F969" . 63849)
+ ("CJK COMPATIBILITY IDEOGRAPH-F96A" . 63850)
+ ("CJK COMPATIBILITY IDEOGRAPH-F96B" . 63851)
+ ("CJK COMPATIBILITY IDEOGRAPH-F96C" . 63852)
+ ("CJK COMPATIBILITY IDEOGRAPH-F96D" . 63853)
+ ("CJK COMPATIBILITY IDEOGRAPH-F96E" . 63854)
+ ("CJK COMPATIBILITY IDEOGRAPH-F96F" . 63855)
+ ("CJK COMPATIBILITY IDEOGRAPH-F970" . 63856)
+ ("CJK COMPATIBILITY IDEOGRAPH-F971" . 63857)
+ ("CJK COMPATIBILITY IDEOGRAPH-F972" . 63858)
+ ("CJK COMPATIBILITY IDEOGRAPH-F973" . 63859)
+ ("CJK COMPATIBILITY IDEOGRAPH-F974" . 63860)
+ ("CJK COMPATIBILITY IDEOGRAPH-F975" . 63861)
+ ("CJK COMPATIBILITY IDEOGRAPH-F976" . 63862)
+ ("CJK COMPATIBILITY IDEOGRAPH-F977" . 63863)
+ ("CJK COMPATIBILITY IDEOGRAPH-F978" . 63864)
+ ("CJK COMPATIBILITY IDEOGRAPH-F979" . 63865)
+ ("CJK COMPATIBILITY IDEOGRAPH-F97A" . 63866)
+ ("CJK COMPATIBILITY IDEOGRAPH-F97B" . 63867)
+ ("CJK COMPATIBILITY IDEOGRAPH-F97C" . 63868)
+ ("CJK COMPATIBILITY IDEOGRAPH-F97D" . 63869)
+ ("CJK COMPATIBILITY IDEOGRAPH-F97E" . 63870)
+ ("CJK COMPATIBILITY IDEOGRAPH-F97F" . 63871)
+ ("CJK COMPATIBILITY IDEOGRAPH-F980" . 63872)
+ ("CJK COMPATIBILITY IDEOGRAPH-F981" . 63873)
+ ("CJK COMPATIBILITY IDEOGRAPH-F982" . 63874)
+ ("CJK COMPATIBILITY IDEOGRAPH-F983" . 63875)
+ ("CJK COMPATIBILITY IDEOGRAPH-F984" . 63876)
+ ("CJK COMPATIBILITY IDEOGRAPH-F985" . 63877)
+ ("CJK COMPATIBILITY IDEOGRAPH-F986" . 63878)
+ ("CJK COMPATIBILITY IDEOGRAPH-F987" . 63879)
+ ("CJK COMPATIBILITY IDEOGRAPH-F988" . 63880)
+ ("CJK COMPATIBILITY IDEOGRAPH-F989" . 63881)
+ ("CJK COMPATIBILITY IDEOGRAPH-F98A" . 63882)
+ ("CJK COMPATIBILITY IDEOGRAPH-F98B" . 63883)
+ ("CJK COMPATIBILITY IDEOGRAPH-F98C" . 63884)
+ ("CJK COMPATIBILITY IDEOGRAPH-F98D" . 63885)
+ ("CJK COMPATIBILITY IDEOGRAPH-F98E" . 63886)
+ ("CJK COMPATIBILITY IDEOGRAPH-F98F" . 63887)
+ ("CJK COMPATIBILITY IDEOGRAPH-F990" . 63888)
+ ("CJK COMPATIBILITY IDEOGRAPH-F991" . 63889)
+ ("CJK COMPATIBILITY IDEOGRAPH-F992" . 63890)
+ ("CJK COMPATIBILITY IDEOGRAPH-F993" . 63891)
+ ("CJK COMPATIBILITY IDEOGRAPH-F994" . 63892)
+ ("CJK COMPATIBILITY IDEOGRAPH-F995" . 63893)
+ ("CJK COMPATIBILITY IDEOGRAPH-F996" . 63894)
+ ("CJK COMPATIBILITY IDEOGRAPH-F997" . 63895)
+ ("CJK COMPATIBILITY IDEOGRAPH-F998" . 63896)
+ ("CJK COMPATIBILITY IDEOGRAPH-F999" . 63897)
+ ("CJK COMPATIBILITY IDEOGRAPH-F99A" . 63898)
+ ("CJK COMPATIBILITY IDEOGRAPH-F99B" . 63899)
+ ("CJK COMPATIBILITY IDEOGRAPH-F99C" . 63900)
+ ("CJK COMPATIBILITY IDEOGRAPH-F99D" . 63901)
+ ("CJK COMPATIBILITY IDEOGRAPH-F99E" . 63902)
+ ("CJK COMPATIBILITY IDEOGRAPH-F99F" . 63903)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A0" . 63904)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A1" . 63905)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A2" . 63906)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A3" . 63907)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A4" . 63908)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A5" . 63909)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A6" . 63910)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A7" . 63911)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A8" . 63912)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9A9" . 63913)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9AA" . 63914)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9AB" . 63915)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9AC" . 63916)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9AD" . 63917)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9AE" . 63918)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9AF" . 63919)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B0" . 63920)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B1" . 63921)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B2" . 63922)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B3" . 63923)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B4" . 63924)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B5" . 63925)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B6" . 63926)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B7" . 63927)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B8" . 63928)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9B9" . 63929)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9BA" . 63930)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9BB" . 63931)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9BC" . 63932)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9BD" . 63933)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9BE" . 63934)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9BF" . 63935)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C0" . 63936)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C1" . 63937)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C2" . 63938)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C3" . 63939)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C4" . 63940)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C5" . 63941)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C6" . 63942)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C7" . 63943)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C8" . 63944)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9C9" . 63945)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9CA" . 63946)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9CB" . 63947)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9CC" . 63948)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9CD" . 63949)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9CE" . 63950)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9CF" . 63951)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D0" . 63952)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D1" . 63953)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D2" . 63954)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D3" . 63955)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D4" . 63956)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D5" . 63957)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D6" . 63958)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D7" . 63959)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D8" . 63960)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9D9" . 63961)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9DA" . 63962)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9DB" . 63963)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9DC" . 63964)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9DD" . 63965)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9DE" . 63966)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9DF" . 63967)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E0" . 63968)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E1" . 63969)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E2" . 63970)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E3" . 63971)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E4" . 63972)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E5" . 63973)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E6" . 63974)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E7" . 63975)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E8" . 63976)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9E9" . 63977)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9EA" . 63978)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9EB" . 63979)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9EC" . 63980)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9ED" . 63981)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9EE" . 63982)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9EF" . 63983)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F0" . 63984)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F1" . 63985)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F2" . 63986)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F3" . 63987)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F4" . 63988)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F5" . 63989)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F6" . 63990)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F7" . 63991)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F8" . 63992)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9F9" . 63993)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9FA" . 63994)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9FB" . 63995)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9FC" . 63996)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9FD" . 63997)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9FE" . 63998)
+ ("CJK COMPATIBILITY IDEOGRAPH-F9FF" . 63999)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA00" . 64000)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA01" . 64001)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA02" . 64002)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA03" . 64003)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA04" . 64004)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA05" . 64005)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA06" . 64006)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA07" . 64007)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA08" . 64008)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA09" . 64009)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA0A" . 64010)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA0B" . 64011)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA0C" . 64012)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA0D" . 64013)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA0E" . 64014)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA0F" . 64015)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA10" . 64016)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA11" . 64017)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA12" . 64018)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA13" . 64019)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA14" . 64020)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA15" . 64021)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA16" . 64022)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA17" . 64023)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA18" . 64024)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA19" . 64025)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA1A" . 64026)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA1B" . 64027)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA1C" . 64028)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA1D" . 64029)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA1E" . 64030)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA1F" . 64031)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA20" . 64032)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA21" . 64033)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA22" . 64034)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA23" . 64035)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA24" . 64036)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA25" . 64037)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA26" . 64038)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA27" . 64039)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA28" . 64040)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA29" . 64041)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA2A" . 64042)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA2B" . 64043)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA2C" . 64044)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA2D" . 64045)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA30" . 64048)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA31" . 64049)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA32" . 64050)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA33" . 64051)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA34" . 64052)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA35" . 64053)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA36" . 64054)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA37" . 64055)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA38" . 64056)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA39" . 64057)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA3A" . 64058)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA3B" . 64059)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA3C" . 64060)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA3D" . 64061)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA3E" . 64062)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA3F" . 64063)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA40" . 64064)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA41" . 64065)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA42" . 64066)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA43" . 64067)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA44" . 64068)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA45" . 64069)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA46" . 64070)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA47" . 64071)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA48" . 64072)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA49" . 64073)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA4A" . 64074)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA4B" . 64075)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA4C" . 64076)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA4D" . 64077)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA4E" . 64078)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA4F" . 64079)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA50" . 64080)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA51" . 64081)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA52" . 64082)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA53" . 64083)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA54" . 64084)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA55" . 64085)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA56" . 64086)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA57" . 64087)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA58" . 64088)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA59" . 64089)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA5A" . 64090)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA5B" . 64091)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA5C" . 64092)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA5D" . 64093)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA5E" . 64094)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA5F" . 64095)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA60" . 64096)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA61" . 64097)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA62" . 64098)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA63" . 64099)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA64" . 64100)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA65" . 64101)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA66" . 64102)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA67" . 64103)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA68" . 64104)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA69" . 64105)
+ ("CJK COMPATIBILITY IDEOGRAPH-FA6A" . 64106)
+ ("LATIN SMALL LIGATURE FF" . 64256)
+ ("LATIN SMALL LIGATURE FI" . 64257)
+ ("LATIN SMALL LIGATURE FL" . 64258)
+ ("LATIN SMALL LIGATURE FFI" . 64259)
+ ("LATIN SMALL LIGATURE FFL" . 64260)
+ ("LATIN SMALL LIGATURE LONG S T" . 64261)
+ ("LATIN SMALL LIGATURE ST" . 64262)
+ ("ARMENIAN SMALL LIGATURE MEN NOW" . 64275)
+ ("ARMENIAN SMALL LIGATURE MEN ECH" . 64276)
+ ("ARMENIAN SMALL LIGATURE MEN INI" . 64277)
+ ("ARMENIAN SMALL LIGATURE VEW NOW" . 64278)
+ ("ARMENIAN SMALL LIGATURE MEN XEH" . 64279)
+ ("HEBREW LETTER YOD WITH HIRIQ" . 64285)
+ ("HEBREW POINT JUDEO-SPANISH VARIKA" . 64286)
+ ("HEBREW LIGATURE YIDDISH YOD YOD PATAH" . 64287)
+ ("HEBREW LETTER ALTERNATIVE AYIN" . 64288)
+ ("HEBREW LETTER WIDE ALEF" . 64289)
+ ("HEBREW LETTER WIDE DALET" . 64290)
+ ("HEBREW LETTER WIDE HE" . 64291)
+ ("HEBREW LETTER WIDE KAF" . 64292)
+ ("HEBREW LETTER WIDE LAMED" . 64293)
+ ("HEBREW LETTER WIDE FINAL MEM" . 64294)
+ ("HEBREW LETTER WIDE RESH" . 64295)
+ ("HEBREW LETTER WIDE TAV" . 64296)
+ ("HEBREW LETTER ALTERNATIVE PLUS SIGN" . 64297)
+ ("HEBREW LETTER SHIN WITH SHIN DOT" . 64298)
+ ("HEBREW LETTER SHIN WITH SIN DOT" . 64299)
+ ("HEBREW LETTER SHIN WITH DAGESH AND SHIN DOT" . 64300)
+ ("HEBREW LETTER SHIN WITH DAGESH AND SIN DOT" . 64301)
+ ("HEBREW LETTER ALEF WITH PATAH" . 64302)
+ ("HEBREW LETTER ALEF WITH QAMATS" . 64303)
+ ("HEBREW LETTER ALEF WITH MAPIQ" . 64304)
+ ("HEBREW LETTER BET WITH DAGESH" . 64305)
+ ("HEBREW LETTER GIMEL WITH DAGESH" . 64306)
+ ("HEBREW LETTER DALET WITH DAGESH" . 64307)
+ ("HEBREW LETTER HE WITH MAPIQ" . 64308)
+ ("HEBREW LETTER VAV WITH DAGESH" . 64309)
+ ("HEBREW LETTER ZAYIN WITH DAGESH" . 64310)
+ ("HEBREW LETTER TET WITH DAGESH" . 64312)
+ ("HEBREW LETTER YOD WITH DAGESH" . 64313)
+ ("HEBREW LETTER FINAL KAF WITH DAGESH" . 64314)
+ ("HEBREW LETTER KAF WITH DAGESH" . 64315)
+ ("HEBREW LETTER LAMED WITH DAGESH" . 64316)
+ ("HEBREW LETTER MEM WITH DAGESH" . 64318)
+ ("HEBREW LETTER NUN WITH DAGESH" . 64320)
+ ("HEBREW LETTER SAMEKH WITH DAGESH" . 64321)
+ ("HEBREW LETTER FINAL PE WITH DAGESH" . 64323)
+ ("HEBREW LETTER PE WITH DAGESH" . 64324)
+ ("HEBREW LETTER TSADI WITH DAGESH" . 64326)
+ ("HEBREW LETTER QOF WITH DAGESH" . 64327)
+ ("HEBREW LETTER RESH WITH DAGESH" . 64328)
+ ("HEBREW LETTER SHIN WITH DAGESH" . 64329)
+ ("HEBREW LETTER TAV WITH DAGESH" . 64330)
+ ("HEBREW LETTER VAV WITH HOLAM" . 64331)
+ ("HEBREW LETTER BET WITH RAFE" . 64332)
+ ("HEBREW LETTER KAF WITH RAFE" . 64333)
+ ("HEBREW LETTER PE WITH RAFE" . 64334)
+ ("HEBREW LIGATURE ALEF LAMED" . 64335)
+ ("ARABIC LETTER ALEF WASLA ISOLATED FORM" . 64336)
+ ("ARABIC LETTER ALEF WASLA FINAL FORM" . 64337)
+ ("ARABIC LETTER BEEH ISOLATED FORM" . 64338)
+ ("ARABIC LETTER BEEH FINAL FORM" . 64339)
+ ("ARABIC LETTER BEEH INITIAL FORM" . 64340)
+ ("ARABIC LETTER BEEH MEDIAL FORM" . 64341)
+ ("ARABIC LETTER PEH ISOLATED FORM" . 64342)
+ ("ARABIC LETTER PEH FINAL FORM" . 64343)
+ ("ARABIC LETTER PEH INITIAL FORM" . 64344)
+ ("ARABIC LETTER PEH MEDIAL FORM" . 64345)
+ ("ARABIC LETTER BEHEH ISOLATED FORM" . 64346)
+ ("ARABIC LETTER BEHEH FINAL FORM" . 64347)
+ ("ARABIC LETTER BEHEH INITIAL FORM" . 64348)
+ ("ARABIC LETTER BEHEH MEDIAL FORM" . 64349)
+ ("ARABIC LETTER TTEHEH ISOLATED FORM" . 64350)
+ ("ARABIC LETTER TTEHEH FINAL FORM" . 64351)
+ ("ARABIC LETTER TTEHEH INITIAL FORM" . 64352)
+ ("ARABIC LETTER TTEHEH MEDIAL FORM" . 64353)
+ ("ARABIC LETTER TEHEH ISOLATED FORM" . 64354)
+ ("ARABIC LETTER TEHEH FINAL FORM" . 64355)
+ ("ARABIC LETTER TEHEH INITIAL FORM" . 64356)
+ ("ARABIC LETTER TEHEH MEDIAL FORM" . 64357)
+ ("ARABIC LETTER TTEH ISOLATED FORM" . 64358)
+ ("ARABIC LETTER TTEH FINAL FORM" . 64359)
+ ("ARABIC LETTER TTEH INITIAL FORM" . 64360)
+ ("ARABIC LETTER TTEH MEDIAL FORM" . 64361)
+ ("ARABIC LETTER VEH ISOLATED FORM" . 64362)
+ ("ARABIC LETTER VEH FINAL FORM" . 64363)
+ ("ARABIC LETTER VEH INITIAL FORM" . 64364)
+ ("ARABIC LETTER VEH MEDIAL FORM" . 64365)
+ ("ARABIC LETTER PEHEH ISOLATED FORM" . 64366)
+ ("ARABIC LETTER PEHEH FINAL FORM" . 64367)
+ ("ARABIC LETTER PEHEH INITIAL FORM" . 64368)
+ ("ARABIC LETTER PEHEH MEDIAL FORM" . 64369)
+ ("ARABIC LETTER DYEH ISOLATED FORM" . 64370)
+ ("ARABIC LETTER DYEH FINAL FORM" . 64371)
+ ("ARABIC LETTER DYEH INITIAL FORM" . 64372)
+ ("ARABIC LETTER DYEH MEDIAL FORM" . 64373)
+ ("ARABIC LETTER NYEH ISOLATED FORM" . 64374)
+ ("ARABIC LETTER NYEH FINAL FORM" . 64375)
+ ("ARABIC LETTER NYEH INITIAL FORM" . 64376)
+ ("ARABIC LETTER NYEH MEDIAL FORM" . 64377)
+ ("ARABIC LETTER TCHEH ISOLATED FORM" . 64378)
+ ("ARABIC LETTER TCHEH FINAL FORM" . 64379)
+ ("ARABIC LETTER TCHEH INITIAL FORM" . 64380)
+ ("ARABIC LETTER TCHEH MEDIAL FORM" . 64381)
+ ("ARABIC LETTER TCHEHEH ISOLATED FORM" . 64382)
+ ("ARABIC LETTER TCHEHEH FINAL FORM" . 64383)
+ ("ARABIC LETTER TCHEHEH INITIAL FORM" . 64384)
+ ("ARABIC LETTER TCHEHEH MEDIAL FORM" . 64385)
+ ("ARABIC LETTER DDAHAL ISOLATED FORM" . 64386)
+ ("ARABIC LETTER DDAHAL FINAL FORM" . 64387)
+ ("ARABIC LETTER DAHAL ISOLATED FORM" . 64388)
+ ("ARABIC LETTER DAHAL FINAL FORM" . 64389)
+ ("ARABIC LETTER DUL ISOLATED FORM" . 64390)
+ ("ARABIC LETTER DUL FINAL FORM" . 64391)
+ ("ARABIC LETTER DDAL ISOLATED FORM" . 64392)
+ ("ARABIC LETTER DDAL FINAL FORM" . 64393)
+ ("ARABIC LETTER JEH ISOLATED FORM" . 64394)
+ ("ARABIC LETTER JEH FINAL FORM" . 64395)
+ ("ARABIC LETTER RREH ISOLATED FORM" . 64396)
+ ("ARABIC LETTER RREH FINAL FORM" . 64397)
+ ("ARABIC LETTER KEHEH ISOLATED FORM" . 64398)
+ ("ARABIC LETTER KEHEH FINAL FORM" . 64399)
+ ("ARABIC LETTER KEHEH INITIAL FORM" . 64400)
+ ("ARABIC LETTER KEHEH MEDIAL FORM" . 64401)
+ ("ARABIC LETTER GAF ISOLATED FORM" . 64402)
+ ("ARABIC LETTER GAF FINAL FORM" . 64403)
+ ("ARABIC LETTER GAF INITIAL FORM" . 64404)
+ ("ARABIC LETTER GAF MEDIAL FORM" . 64405)
+ ("ARABIC LETTER GUEH ISOLATED FORM" . 64406)
+ ("ARABIC LETTER GUEH FINAL FORM" . 64407)
+ ("ARABIC LETTER GUEH INITIAL FORM" . 64408)
+ ("ARABIC LETTER GUEH MEDIAL FORM" . 64409)
+ ("ARABIC LETTER NGOEH ISOLATED FORM" . 64410)
+ ("ARABIC LETTER NGOEH FINAL FORM" . 64411)
+ ("ARABIC LETTER NGOEH INITIAL FORM" . 64412)
+ ("ARABIC LETTER NGOEH MEDIAL FORM" . 64413)
+ ("ARABIC LETTER NOON GHUNNA ISOLATED FORM" . 64414)
+ ("ARABIC LETTER NOON GHUNNA FINAL FORM" . 64415)
+ ("ARABIC LETTER RNOON ISOLATED FORM" . 64416)
+ ("ARABIC LETTER RNOON FINAL FORM" . 64417)
+ ("ARABIC LETTER RNOON INITIAL FORM" . 64418)
+ ("ARABIC LETTER RNOON MEDIAL FORM" . 64419)
+ ("ARABIC LETTER HEH WITH YEH ABOVE ISOLATED FORM" . 64420)
+ ("ARABIC LETTER HEH WITH YEH ABOVE FINAL FORM" . 64421)
+ ("ARABIC LETTER HEH GOAL ISOLATED FORM" . 64422)
+ ("ARABIC LETTER HEH GOAL FINAL FORM" . 64423)
+ ("ARABIC LETTER HEH GOAL INITIAL FORM" . 64424)
+ ("ARABIC LETTER HEH GOAL MEDIAL FORM" . 64425)
+ ("ARABIC LETTER HEH DOACHASHMEE ISOLATED FORM" . 64426)
+ ("ARABIC LETTER HEH DOACHASHMEE FINAL FORM" . 64427)
+ ("ARABIC LETTER HEH DOACHASHMEE INITIAL FORM" . 64428)
+ ("ARABIC LETTER HEH DOACHASHMEE MEDIAL FORM" . 64429)
+ ("ARABIC LETTER YEH BARREE ISOLATED FORM" . 64430)
+ ("ARABIC LETTER YEH BARREE FINAL FORM" . 64431)
+ ("ARABIC LETTER YEH BARREE WITH HAMZA ABOVE ISOLATED FORM" . 64432)
+ ("ARABIC LETTER YEH BARREE WITH HAMZA ABOVE FINAL FORM" . 64433)
+ ("ARABIC LETTER NG ISOLATED FORM" . 64467)
+ ("ARABIC LETTER NG FINAL FORM" . 64468)
+ ("ARABIC LETTER NG INITIAL FORM" . 64469)
+ ("ARABIC LETTER NG MEDIAL FORM" . 64470)
+ ("ARABIC LETTER U ISOLATED FORM" . 64471)
+ ("ARABIC LETTER U FINAL FORM" . 64472)
+ ("ARABIC LETTER OE ISOLATED FORM" . 64473)
+ ("ARABIC LETTER OE FINAL FORM" . 64474)
+ ("ARABIC LETTER YU ISOLATED FORM" . 64475)
+ ("ARABIC LETTER YU FINAL FORM" . 64476)
+ ("ARABIC LETTER U WITH HAMZA ABOVE ISOLATED FORM" . 64477)
+ ("ARABIC LETTER VE ISOLATED FORM" . 64478)
+ ("ARABIC LETTER VE FINAL FORM" . 64479)
+ ("ARABIC LETTER KIRGHIZ OE ISOLATED FORM" . 64480)
+ ("ARABIC LETTER KIRGHIZ OE FINAL FORM" . 64481)
+ ("ARABIC LETTER KIRGHIZ YU ISOLATED FORM" . 64482)
+ ("ARABIC LETTER KIRGHIZ YU FINAL FORM" . 64483)
+ ("ARABIC LETTER E ISOLATED FORM" . 64484)
+ ("ARABIC LETTER E FINAL FORM" . 64485)
+ ("ARABIC LETTER E INITIAL FORM" . 64486)
+ ("ARABIC LETTER E MEDIAL FORM" . 64487)
+ ("ARABIC LETTER UIGHUR KAZAKH KIRGHIZ ALEF MAKSURA INITIAL FORM" . 64488)
+ ("ARABIC LETTER UIGHUR KAZAKH KIRGHIZ ALEF MAKSURA MEDIAL FORM" . 64489)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH ALEF ISOLATED FORM" . 64490)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH ALEF FINAL FORM" . 64491)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH AE ISOLATED FORM" . 64492)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH AE FINAL FORM" . 64493)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH WAW ISOLATED FORM" . 64494)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH WAW FINAL FORM" . 64495)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH U ISOLATED FORM" . 64496)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH U FINAL FORM" . 64497)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH OE ISOLATED FORM" . 64498)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH OE FINAL FORM" . 64499)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH YU ISOLATED FORM" . 64500)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH YU FINAL FORM" . 64501)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH E ISOLATED FORM" . 64502)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH E FINAL FORM" . 64503)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH E INITIAL FORM" . 64504)
+ ("ARABIC LIGATURE UIGHUR KIRGHIZ YEH WITH HAMZA ABOVE WITH ALEF MAKSURA ISOLATED FORM" . 64505)
+ ("ARABIC LIGATURE UIGHUR KIRGHIZ YEH WITH HAMZA ABOVE WITH ALEF MAKSURA FINAL FORM" . 64506)
+ ("ARABIC LIGATURE UIGHUR KIRGHIZ YEH WITH HAMZA ABOVE WITH ALEF MAKSURA INITIAL FORM" . 64507)
+ ("ARABIC LETTER FARSI YEH ISOLATED FORM" . 64508)
+ ("ARABIC LETTER FARSI YEH FINAL FORM" . 64509)
+ ("ARABIC LETTER FARSI YEH INITIAL FORM" . 64510)
+ ("ARABIC LETTER FARSI YEH MEDIAL FORM" . 64511)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH JEEM ISOLATED FORM" . 64512)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH HAH ISOLATED FORM" . 64513)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH MEEM ISOLATED FORM" . 64514)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH ALEF MAKSURA ISOLATED FORM" . 64515)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH YEH ISOLATED FORM" . 64516)
+ ("ARABIC LIGATURE BEH WITH JEEM ISOLATED FORM" . 64517)
+ ("ARABIC LIGATURE BEH WITH HAH ISOLATED FORM" . 64518)
+ ("ARABIC LIGATURE BEH WITH KHAH ISOLATED FORM" . 64519)
+ ("ARABIC LIGATURE BEH WITH MEEM ISOLATED FORM" . 64520)
+ ("ARABIC LIGATURE BEH WITH ALEF MAKSURA ISOLATED FORM" . 64521)
+ ("ARABIC LIGATURE BEH WITH YEH ISOLATED FORM" . 64522)
+ ("ARABIC LIGATURE TEH WITH JEEM ISOLATED FORM" . 64523)
+ ("ARABIC LIGATURE TEH WITH HAH ISOLATED FORM" . 64524)
+ ("ARABIC LIGATURE TEH WITH KHAH ISOLATED FORM" . 64525)
+ ("ARABIC LIGATURE TEH WITH MEEM ISOLATED FORM" . 64526)
+ ("ARABIC LIGATURE TEH WITH ALEF MAKSURA ISOLATED FORM" . 64527)
+ ("ARABIC LIGATURE TEH WITH YEH ISOLATED FORM" . 64528)
+ ("ARABIC LIGATURE THEH WITH JEEM ISOLATED FORM" . 64529)
+ ("ARABIC LIGATURE THEH WITH MEEM ISOLATED FORM" . 64530)
+ ("ARABIC LIGATURE THEH WITH ALEF MAKSURA ISOLATED FORM" . 64531)
+ ("ARABIC LIGATURE THEH WITH YEH ISOLATED FORM" . 64532)
+ ("ARABIC LIGATURE JEEM WITH HAH ISOLATED FORM" . 64533)
+ ("ARABIC LIGATURE JEEM WITH MEEM ISOLATED FORM" . 64534)
+ ("ARABIC LIGATURE HAH WITH JEEM ISOLATED FORM" . 64535)
+ ("ARABIC LIGATURE HAH WITH MEEM ISOLATED FORM" . 64536)
+ ("ARABIC LIGATURE KHAH WITH JEEM ISOLATED FORM" . 64537)
+ ("ARABIC LIGATURE KHAH WITH HAH ISOLATED FORM" . 64538)
+ ("ARABIC LIGATURE KHAH WITH MEEM ISOLATED FORM" . 64539)
+ ("ARABIC LIGATURE SEEN WITH JEEM ISOLATED FORM" . 64540)
+ ("ARABIC LIGATURE SEEN WITH HAH ISOLATED FORM" . 64541)
+ ("ARABIC LIGATURE SEEN WITH KHAH ISOLATED FORM" . 64542)
+ ("ARABIC LIGATURE SEEN WITH MEEM ISOLATED FORM" . 64543)
+ ("ARABIC LIGATURE SAD WITH HAH ISOLATED FORM" . 64544)
+ ("ARABIC LIGATURE SAD WITH MEEM ISOLATED FORM" . 64545)
+ ("ARABIC LIGATURE DAD WITH JEEM ISOLATED FORM" . 64546)
+ ("ARABIC LIGATURE DAD WITH HAH ISOLATED FORM" . 64547)
+ ("ARABIC LIGATURE DAD WITH KHAH ISOLATED FORM" . 64548)
+ ("ARABIC LIGATURE DAD WITH MEEM ISOLATED FORM" . 64549)
+ ("ARABIC LIGATURE TAH WITH HAH ISOLATED FORM" . 64550)
+ ("ARABIC LIGATURE TAH WITH MEEM ISOLATED FORM" . 64551)
+ ("ARABIC LIGATURE ZAH WITH MEEM ISOLATED FORM" . 64552)
+ ("ARABIC LIGATURE AIN WITH JEEM ISOLATED FORM" . 64553)
+ ("ARABIC LIGATURE AIN WITH MEEM ISOLATED FORM" . 64554)
+ ("ARABIC LIGATURE GHAIN WITH JEEM ISOLATED FORM" . 64555)
+ ("ARABIC LIGATURE GHAIN WITH MEEM ISOLATED FORM" . 64556)
+ ("ARABIC LIGATURE FEH WITH JEEM ISOLATED FORM" . 64557)
+ ("ARABIC LIGATURE FEH WITH HAH ISOLATED FORM" . 64558)
+ ("ARABIC LIGATURE FEH WITH KHAH ISOLATED FORM" . 64559)
+ ("ARABIC LIGATURE FEH WITH MEEM ISOLATED FORM" . 64560)
+ ("ARABIC LIGATURE FEH WITH ALEF MAKSURA ISOLATED FORM" . 64561)
+ ("ARABIC LIGATURE FEH WITH YEH ISOLATED FORM" . 64562)
+ ("ARABIC LIGATURE QAF WITH HAH ISOLATED FORM" . 64563)
+ ("ARABIC LIGATURE QAF WITH MEEM ISOLATED FORM" . 64564)
+ ("ARABIC LIGATURE QAF WITH ALEF MAKSURA ISOLATED FORM" . 64565)
+ ("ARABIC LIGATURE QAF WITH YEH ISOLATED FORM" . 64566)
+ ("ARABIC LIGATURE KAF WITH ALEF ISOLATED FORM" . 64567)
+ ("ARABIC LIGATURE KAF WITH JEEM ISOLATED FORM" . 64568)
+ ("ARABIC LIGATURE KAF WITH HAH ISOLATED FORM" . 64569)
+ ("ARABIC LIGATURE KAF WITH KHAH ISOLATED FORM" . 64570)
+ ("ARABIC LIGATURE KAF WITH LAM ISOLATED FORM" . 64571)
+ ("ARABIC LIGATURE KAF WITH MEEM ISOLATED FORM" . 64572)
+ ("ARABIC LIGATURE KAF WITH ALEF MAKSURA ISOLATED FORM" . 64573)
+ ("ARABIC LIGATURE KAF WITH YEH ISOLATED FORM" . 64574)
+ ("ARABIC LIGATURE LAM WITH JEEM ISOLATED FORM" . 64575)
+ ("ARABIC LIGATURE LAM WITH HAH ISOLATED FORM" . 64576)
+ ("ARABIC LIGATURE LAM WITH KHAH ISOLATED FORM" . 64577)
+ ("ARABIC LIGATURE LAM WITH MEEM ISOLATED FORM" . 64578)
+ ("ARABIC LIGATURE LAM WITH ALEF MAKSURA ISOLATED FORM" . 64579)
+ ("ARABIC LIGATURE LAM WITH YEH ISOLATED FORM" . 64580)
+ ("ARABIC LIGATURE MEEM WITH JEEM ISOLATED FORM" . 64581)
+ ("ARABIC LIGATURE MEEM WITH HAH ISOLATED FORM" . 64582)
+ ("ARABIC LIGATURE MEEM WITH KHAH ISOLATED FORM" . 64583)
+ ("ARABIC LIGATURE MEEM WITH MEEM ISOLATED FORM" . 64584)
+ ("ARABIC LIGATURE MEEM WITH ALEF MAKSURA ISOLATED FORM" . 64585)
+ ("ARABIC LIGATURE MEEM WITH YEH ISOLATED FORM" . 64586)
+ ("ARABIC LIGATURE NOON WITH JEEM ISOLATED FORM" . 64587)
+ ("ARABIC LIGATURE NOON WITH HAH ISOLATED FORM" . 64588)
+ ("ARABIC LIGATURE NOON WITH KHAH ISOLATED FORM" . 64589)
+ ("ARABIC LIGATURE NOON WITH MEEM ISOLATED FORM" . 64590)
+ ("ARABIC LIGATURE NOON WITH ALEF MAKSURA ISOLATED FORM" . 64591)
+ ("ARABIC LIGATURE NOON WITH YEH ISOLATED FORM" . 64592)
+ ("ARABIC LIGATURE HEH WITH JEEM ISOLATED FORM" . 64593)
+ ("ARABIC LIGATURE HEH WITH MEEM ISOLATED FORM" . 64594)
+ ("ARABIC LIGATURE HEH WITH ALEF MAKSURA ISOLATED FORM" . 64595)
+ ("ARABIC LIGATURE HEH WITH YEH ISOLATED FORM" . 64596)
+ ("ARABIC LIGATURE YEH WITH JEEM ISOLATED FORM" . 64597)
+ ("ARABIC LIGATURE YEH WITH HAH ISOLATED FORM" . 64598)
+ ("ARABIC LIGATURE YEH WITH KHAH ISOLATED FORM" . 64599)
+ ("ARABIC LIGATURE YEH WITH MEEM ISOLATED FORM" . 64600)
+ ("ARABIC LIGATURE YEH WITH ALEF MAKSURA ISOLATED FORM" . 64601)
+ ("ARABIC LIGATURE YEH WITH YEH ISOLATED FORM" . 64602)
+ ("ARABIC LIGATURE THAL WITH SUPERSCRIPT ALEF ISOLATED FORM" . 64603)
+ ("ARABIC LIGATURE REH WITH SUPERSCRIPT ALEF ISOLATED FORM" . 64604)
+ ("ARABIC LIGATURE ALEF MAKSURA WITH SUPERSCRIPT ALEF ISOLATED FORM" . 64605)
+ ("ARABIC LIGATURE SHADDA WITH DAMMATAN ISOLATED FORM" . 64606)
+ ("ARABIC LIGATURE SHADDA WITH KASRATAN ISOLATED FORM" . 64607)
+ ("ARABIC LIGATURE SHADDA WITH FATHA ISOLATED FORM" . 64608)
+ ("ARABIC LIGATURE SHADDA WITH DAMMA ISOLATED FORM" . 64609)
+ ("ARABIC LIGATURE SHADDA WITH KASRA ISOLATED FORM" . 64610)
+ ("ARABIC LIGATURE SHADDA WITH SUPERSCRIPT ALEF ISOLATED FORM" . 64611)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH REH FINAL FORM" . 64612)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH ZAIN FINAL FORM" . 64613)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH MEEM FINAL FORM" . 64614)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH NOON FINAL FORM" . 64615)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH ALEF MAKSURA FINAL FORM" . 64616)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH YEH FINAL FORM" . 64617)
+ ("ARABIC LIGATURE BEH WITH REH FINAL FORM" . 64618)
+ ("ARABIC LIGATURE BEH WITH ZAIN FINAL FORM" . 64619)
+ ("ARABIC LIGATURE BEH WITH MEEM FINAL FORM" . 64620)
+ ("ARABIC LIGATURE BEH WITH NOON FINAL FORM" . 64621)
+ ("ARABIC LIGATURE BEH WITH ALEF MAKSURA FINAL FORM" . 64622)
+ ("ARABIC LIGATURE BEH WITH YEH FINAL FORM" . 64623)
+ ("ARABIC LIGATURE TEH WITH REH FINAL FORM" . 64624)
+ ("ARABIC LIGATURE TEH WITH ZAIN FINAL FORM" . 64625)
+ ("ARABIC LIGATURE TEH WITH MEEM FINAL FORM" . 64626)
+ ("ARABIC LIGATURE TEH WITH NOON FINAL FORM" . 64627)
+ ("ARABIC LIGATURE TEH WITH ALEF MAKSURA FINAL FORM" . 64628)
+ ("ARABIC LIGATURE TEH WITH YEH FINAL FORM" . 64629)
+ ("ARABIC LIGATURE THEH WITH REH FINAL FORM" . 64630)
+ ("ARABIC LIGATURE THEH WITH ZAIN FINAL FORM" . 64631)
+ ("ARABIC LIGATURE THEH WITH MEEM FINAL FORM" . 64632)
+ ("ARABIC LIGATURE THEH WITH NOON FINAL FORM" . 64633)
+ ("ARABIC LIGATURE THEH WITH ALEF MAKSURA FINAL FORM" . 64634)
+ ("ARABIC LIGATURE THEH WITH YEH FINAL FORM" . 64635)
+ ("ARABIC LIGATURE FEH WITH ALEF MAKSURA FINAL FORM" . 64636)
+ ("ARABIC LIGATURE FEH WITH YEH FINAL FORM" . 64637)
+ ("ARABIC LIGATURE QAF WITH ALEF MAKSURA FINAL FORM" . 64638)
+ ("ARABIC LIGATURE QAF WITH YEH FINAL FORM" . 64639)
+ ("ARABIC LIGATURE KAF WITH ALEF FINAL FORM" . 64640)
+ ("ARABIC LIGATURE KAF WITH LAM FINAL FORM" . 64641)
+ ("ARABIC LIGATURE KAF WITH MEEM FINAL FORM" . 64642)
+ ("ARABIC LIGATURE KAF WITH ALEF MAKSURA FINAL FORM" . 64643)
+ ("ARABIC LIGATURE KAF WITH YEH FINAL FORM" . 64644)
+ ("ARABIC LIGATURE LAM WITH MEEM FINAL FORM" . 64645)
+ ("ARABIC LIGATURE LAM WITH ALEF MAKSURA FINAL FORM" . 64646)
+ ("ARABIC LIGATURE LAM WITH YEH FINAL FORM" . 64647)
+ ("ARABIC LIGATURE MEEM WITH ALEF FINAL FORM" . 64648)
+ ("ARABIC LIGATURE MEEM WITH MEEM FINAL FORM" . 64649)
+ ("ARABIC LIGATURE NOON WITH REH FINAL FORM" . 64650)
+ ("ARABIC LIGATURE NOON WITH ZAIN FINAL FORM" . 64651)
+ ("ARABIC LIGATURE NOON WITH MEEM FINAL FORM" . 64652)
+ ("ARABIC LIGATURE NOON WITH NOON FINAL FORM" . 64653)
+ ("ARABIC LIGATURE NOON WITH ALEF MAKSURA FINAL FORM" . 64654)
+ ("ARABIC LIGATURE NOON WITH YEH FINAL FORM" . 64655)
+ ("ARABIC LIGATURE ALEF MAKSURA WITH SUPERSCRIPT ALEF FINAL FORM" . 64656)
+ ("ARABIC LIGATURE YEH WITH REH FINAL FORM" . 64657)
+ ("ARABIC LIGATURE YEH WITH ZAIN FINAL FORM" . 64658)
+ ("ARABIC LIGATURE YEH WITH MEEM FINAL FORM" . 64659)
+ ("ARABIC LIGATURE YEH WITH NOON FINAL FORM" . 64660)
+ ("ARABIC LIGATURE YEH WITH ALEF MAKSURA FINAL FORM" . 64661)
+ ("ARABIC LIGATURE YEH WITH YEH FINAL FORM" . 64662)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH JEEM INITIAL FORM" . 64663)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH HAH INITIAL FORM" . 64664)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH KHAH INITIAL FORM" . 64665)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH MEEM INITIAL FORM" . 64666)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH HEH INITIAL FORM" . 64667)
+ ("ARABIC LIGATURE BEH WITH JEEM INITIAL FORM" . 64668)
+ ("ARABIC LIGATURE BEH WITH HAH INITIAL FORM" . 64669)
+ ("ARABIC LIGATURE BEH WITH KHAH INITIAL FORM" . 64670)
+ ("ARABIC LIGATURE BEH WITH MEEM INITIAL FORM" . 64671)
+ ("ARABIC LIGATURE BEH WITH HEH INITIAL FORM" . 64672)
+ ("ARABIC LIGATURE TEH WITH JEEM INITIAL FORM" . 64673)
+ ("ARABIC LIGATURE TEH WITH HAH INITIAL FORM" . 64674)
+ ("ARABIC LIGATURE TEH WITH KHAH INITIAL FORM" . 64675)
+ ("ARABIC LIGATURE TEH WITH MEEM INITIAL FORM" . 64676)
+ ("ARABIC LIGATURE TEH WITH HEH INITIAL FORM" . 64677)
+ ("ARABIC LIGATURE THEH WITH MEEM INITIAL FORM" . 64678)
+ ("ARABIC LIGATURE JEEM WITH HAH INITIAL FORM" . 64679)
+ ("ARABIC LIGATURE JEEM WITH MEEM INITIAL FORM" . 64680)
+ ("ARABIC LIGATURE HAH WITH JEEM INITIAL FORM" . 64681)
+ ("ARABIC LIGATURE HAH WITH MEEM INITIAL FORM" . 64682)
+ ("ARABIC LIGATURE KHAH WITH JEEM INITIAL FORM" . 64683)
+ ("ARABIC LIGATURE KHAH WITH MEEM INITIAL FORM" . 64684)
+ ("ARABIC LIGATURE SEEN WITH JEEM INITIAL FORM" . 64685)
+ ("ARABIC LIGATURE SEEN WITH HAH INITIAL FORM" . 64686)
+ ("ARABIC LIGATURE SEEN WITH KHAH INITIAL FORM" . 64687)
+ ("ARABIC LIGATURE SEEN WITH MEEM INITIAL FORM" . 64688)
+ ("ARABIC LIGATURE SAD WITH HAH INITIAL FORM" . 64689)
+ ("ARABIC LIGATURE SAD WITH KHAH INITIAL FORM" . 64690)
+ ("ARABIC LIGATURE SAD WITH MEEM INITIAL FORM" . 64691)
+ ("ARABIC LIGATURE DAD WITH JEEM INITIAL FORM" . 64692)
+ ("ARABIC LIGATURE DAD WITH HAH INITIAL FORM" . 64693)
+ ("ARABIC LIGATURE DAD WITH KHAH INITIAL FORM" . 64694)
+ ("ARABIC LIGATURE DAD WITH MEEM INITIAL FORM" . 64695)
+ ("ARABIC LIGATURE TAH WITH HAH INITIAL FORM" . 64696)
+ ("ARABIC LIGATURE ZAH WITH MEEM INITIAL FORM" . 64697)
+ ("ARABIC LIGATURE AIN WITH JEEM INITIAL FORM" . 64698)
+ ("ARABIC LIGATURE AIN WITH MEEM INITIAL FORM" . 64699)
+ ("ARABIC LIGATURE GHAIN WITH JEEM INITIAL FORM" . 64700)
+ ("ARABIC LIGATURE GHAIN WITH MEEM INITIAL FORM" . 64701)
+ ("ARABIC LIGATURE FEH WITH JEEM INITIAL FORM" . 64702)
+ ("ARABIC LIGATURE FEH WITH HAH INITIAL FORM" . 64703)
+ ("ARABIC LIGATURE FEH WITH KHAH INITIAL FORM" . 64704)
+ ("ARABIC LIGATURE FEH WITH MEEM INITIAL FORM" . 64705)
+ ("ARABIC LIGATURE QAF WITH HAH INITIAL FORM" . 64706)
+ ("ARABIC LIGATURE QAF WITH MEEM INITIAL FORM" . 64707)
+ ("ARABIC LIGATURE KAF WITH JEEM INITIAL FORM" . 64708)
+ ("ARABIC LIGATURE KAF WITH HAH INITIAL FORM" . 64709)
+ ("ARABIC LIGATURE KAF WITH KHAH INITIAL FORM" . 64710)
+ ("ARABIC LIGATURE KAF WITH LAM INITIAL FORM" . 64711)
+ ("ARABIC LIGATURE KAF WITH MEEM INITIAL FORM" . 64712)
+ ("ARABIC LIGATURE LAM WITH JEEM INITIAL FORM" . 64713)
+ ("ARABIC LIGATURE LAM WITH HAH INITIAL FORM" . 64714)
+ ("ARABIC LIGATURE LAM WITH KHAH INITIAL FORM" . 64715)
+ ("ARABIC LIGATURE LAM WITH MEEM INITIAL FORM" . 64716)
+ ("ARABIC LIGATURE LAM WITH HEH INITIAL FORM" . 64717)
+ ("ARABIC LIGATURE MEEM WITH JEEM INITIAL FORM" . 64718)
+ ("ARABIC LIGATURE MEEM WITH HAH INITIAL FORM" . 64719)
+ ("ARABIC LIGATURE MEEM WITH KHAH INITIAL FORM" . 64720)
+ ("ARABIC LIGATURE MEEM WITH MEEM INITIAL FORM" . 64721)
+ ("ARABIC LIGATURE NOON WITH JEEM INITIAL FORM" . 64722)
+ ("ARABIC LIGATURE NOON WITH HAH INITIAL FORM" . 64723)
+ ("ARABIC LIGATURE NOON WITH KHAH INITIAL FORM" . 64724)
+ ("ARABIC LIGATURE NOON WITH MEEM INITIAL FORM" . 64725)
+ ("ARABIC LIGATURE NOON WITH HEH INITIAL FORM" . 64726)
+ ("ARABIC LIGATURE HEH WITH JEEM INITIAL FORM" . 64727)
+ ("ARABIC LIGATURE HEH WITH MEEM INITIAL FORM" . 64728)
+ ("ARABIC LIGATURE HEH WITH SUPERSCRIPT ALEF INITIAL FORM" . 64729)
+ ("ARABIC LIGATURE YEH WITH JEEM INITIAL FORM" . 64730)
+ ("ARABIC LIGATURE YEH WITH HAH INITIAL FORM" . 64731)
+ ("ARABIC LIGATURE YEH WITH KHAH INITIAL FORM" . 64732)
+ ("ARABIC LIGATURE YEH WITH MEEM INITIAL FORM" . 64733)
+ ("ARABIC LIGATURE YEH WITH HEH INITIAL FORM" . 64734)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH MEEM MEDIAL FORM" . 64735)
+ ("ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH HEH MEDIAL FORM" . 64736)
+ ("ARABIC LIGATURE BEH WITH MEEM MEDIAL FORM" . 64737)
+ ("ARABIC LIGATURE BEH WITH HEH MEDIAL FORM" . 64738)
+ ("ARABIC LIGATURE TEH WITH MEEM MEDIAL FORM" . 64739)
+ ("ARABIC LIGATURE TEH WITH HEH MEDIAL FORM" . 64740)
+ ("ARABIC LIGATURE THEH WITH MEEM MEDIAL FORM" . 64741)
+ ("ARABIC LIGATURE THEH WITH HEH MEDIAL FORM" . 64742)
+ ("ARABIC LIGATURE SEEN WITH MEEM MEDIAL FORM" . 64743)
+ ("ARABIC LIGATURE SEEN WITH HEH MEDIAL FORM" . 64744)
+ ("ARABIC LIGATURE SHEEN WITH MEEM MEDIAL FORM" . 64745)
+ ("ARABIC LIGATURE SHEEN WITH HEH MEDIAL FORM" . 64746)
+ ("ARABIC LIGATURE KAF WITH LAM MEDIAL FORM" . 64747)
+ ("ARABIC LIGATURE KAF WITH MEEM MEDIAL FORM" . 64748)
+ ("ARABIC LIGATURE LAM WITH MEEM MEDIAL FORM" . 64749)
+ ("ARABIC LIGATURE NOON WITH MEEM MEDIAL FORM" . 64750)
+ ("ARABIC LIGATURE NOON WITH HEH MEDIAL FORM" . 64751)
+ ("ARABIC LIGATURE YEH WITH MEEM MEDIAL FORM" . 64752)
+ ("ARABIC LIGATURE YEH WITH HEH MEDIAL FORM" . 64753)
+ ("ARABIC LIGATURE SHADDA WITH FATHA MEDIAL FORM" . 64754)
+ ("ARABIC LIGATURE SHADDA WITH DAMMA MEDIAL FORM" . 64755)
+ ("ARABIC LIGATURE SHADDA WITH KASRA MEDIAL FORM" . 64756)
+ ("ARABIC LIGATURE TAH WITH ALEF MAKSURA ISOLATED FORM" . 64757)
+ ("ARABIC LIGATURE TAH WITH YEH ISOLATED FORM" . 64758)
+ ("ARABIC LIGATURE AIN WITH ALEF MAKSURA ISOLATED FORM" . 64759)
+ ("ARABIC LIGATURE AIN WITH YEH ISOLATED FORM" . 64760)
+ ("ARABIC LIGATURE GHAIN WITH ALEF MAKSURA ISOLATED FORM" . 64761)
+ ("ARABIC LIGATURE GHAIN WITH YEH ISOLATED FORM" . 64762)
+ ("ARABIC LIGATURE SEEN WITH ALEF MAKSURA ISOLATED FORM" . 64763)
+ ("ARABIC LIGATURE SEEN WITH YEH ISOLATED FORM" . 64764)
+ ("ARABIC LIGATURE SHEEN WITH ALEF MAKSURA ISOLATED FORM" . 64765)
+ ("ARABIC LIGATURE SHEEN WITH YEH ISOLATED FORM" . 64766)
+ ("ARABIC LIGATURE HAH WITH ALEF MAKSURA ISOLATED FORM" . 64767)
+ ("ARABIC LIGATURE HAH WITH YEH ISOLATED FORM" . 64768)
+ ("ARABIC LIGATURE JEEM WITH ALEF MAKSURA ISOLATED FORM" . 64769)
+ ("ARABIC LIGATURE JEEM WITH YEH ISOLATED FORM" . 64770)
+ ("ARABIC LIGATURE KHAH WITH ALEF MAKSURA ISOLATED FORM" . 64771)
+ ("ARABIC LIGATURE KHAH WITH YEH ISOLATED FORM" . 64772)
+ ("ARABIC LIGATURE SAD WITH ALEF MAKSURA ISOLATED FORM" . 64773)
+ ("ARABIC LIGATURE SAD WITH YEH ISOLATED FORM" . 64774)
+ ("ARABIC LIGATURE DAD WITH ALEF MAKSURA ISOLATED FORM" . 64775)
+ ("ARABIC LIGATURE DAD WITH YEH ISOLATED FORM" . 64776)
+ ("ARABIC LIGATURE SHEEN WITH JEEM ISOLATED FORM" . 64777)
+ ("ARABIC LIGATURE SHEEN WITH HAH ISOLATED FORM" . 64778)
+ ("ARABIC LIGATURE SHEEN WITH KHAH ISOLATED FORM" . 64779)
+ ("ARABIC LIGATURE SHEEN WITH MEEM ISOLATED FORM" . 64780)
+ ("ARABIC LIGATURE SHEEN WITH REH ISOLATED FORM" . 64781)
+ ("ARABIC LIGATURE SEEN WITH REH ISOLATED FORM" . 64782)
+ ("ARABIC LIGATURE SAD WITH REH ISOLATED FORM" . 64783)
+ ("ARABIC LIGATURE DAD WITH REH ISOLATED FORM" . 64784)
+ ("ARABIC LIGATURE TAH WITH ALEF MAKSURA FINAL FORM" . 64785)
+ ("ARABIC LIGATURE TAH WITH YEH FINAL FORM" . 64786)
+ ("ARABIC LIGATURE AIN WITH ALEF MAKSURA FINAL FORM" . 64787)
+ ("ARABIC LIGATURE AIN WITH YEH FINAL FORM" . 64788)
+ ("ARABIC LIGATURE GHAIN WITH ALEF MAKSURA FINAL FORM" . 64789)
+ ("ARABIC LIGATURE GHAIN WITH YEH FINAL FORM" . 64790)
+ ("ARABIC LIGATURE SEEN WITH ALEF MAKSURA FINAL FORM" . 64791)
+ ("ARABIC LIGATURE SEEN WITH YEH FINAL FORM" . 64792)
+ ("ARABIC LIGATURE SHEEN WITH ALEF MAKSURA FINAL FORM" . 64793)
+ ("ARABIC LIGATURE SHEEN WITH YEH FINAL FORM" . 64794)
+ ("ARABIC LIGATURE HAH WITH ALEF MAKSURA FINAL FORM" . 64795)
+ ("ARABIC LIGATURE HAH WITH YEH FINAL FORM" . 64796)
+ ("ARABIC LIGATURE JEEM WITH ALEF MAKSURA FINAL FORM" . 64797)
+ ("ARABIC LIGATURE JEEM WITH YEH FINAL FORM" . 64798)
+ ("ARABIC LIGATURE KHAH WITH ALEF MAKSURA FINAL FORM" . 64799)
+ ("ARABIC LIGATURE KHAH WITH YEH FINAL FORM" . 64800)
+ ("ARABIC LIGATURE SAD WITH ALEF MAKSURA FINAL FORM" . 64801)
+ ("ARABIC LIGATURE SAD WITH YEH FINAL FORM" . 64802)
+ ("ARABIC LIGATURE DAD WITH ALEF MAKSURA FINAL FORM" . 64803)
+ ("ARABIC LIGATURE DAD WITH YEH FINAL FORM" . 64804)
+ ("ARABIC LIGATURE SHEEN WITH JEEM FINAL FORM" . 64805)
+ ("ARABIC LIGATURE SHEEN WITH HAH FINAL FORM" . 64806)
+ ("ARABIC LIGATURE SHEEN WITH KHAH FINAL FORM" . 64807)
+ ("ARABIC LIGATURE SHEEN WITH MEEM FINAL FORM" . 64808)
+ ("ARABIC LIGATURE SHEEN WITH REH FINAL FORM" . 64809)
+ ("ARABIC LIGATURE SEEN WITH REH FINAL FORM" . 64810)
+ ("ARABIC LIGATURE SAD WITH REH FINAL FORM" . 64811)
+ ("ARABIC LIGATURE DAD WITH REH FINAL FORM" . 64812)
+ ("ARABIC LIGATURE SHEEN WITH JEEM INITIAL FORM" . 64813)
+ ("ARABIC LIGATURE SHEEN WITH HAH INITIAL FORM" . 64814)
+ ("ARABIC LIGATURE SHEEN WITH KHAH INITIAL FORM" . 64815)
+ ("ARABIC LIGATURE SHEEN WITH MEEM INITIAL FORM" . 64816)
+ ("ARABIC LIGATURE SEEN WITH HEH INITIAL FORM" . 64817)
+ ("ARABIC LIGATURE SHEEN WITH HEH INITIAL FORM" . 64818)
+ ("ARABIC LIGATURE TAH WITH MEEM INITIAL FORM" . 64819)
+ ("ARABIC LIGATURE SEEN WITH JEEM MEDIAL FORM" . 64820)
+ ("ARABIC LIGATURE SEEN WITH HAH MEDIAL FORM" . 64821)
+ ("ARABIC LIGATURE SEEN WITH KHAH MEDIAL FORM" . 64822)
+ ("ARABIC LIGATURE SHEEN WITH JEEM MEDIAL FORM" . 64823)
+ ("ARABIC LIGATURE SHEEN WITH HAH MEDIAL FORM" . 64824)
+ ("ARABIC LIGATURE SHEEN WITH KHAH MEDIAL FORM" . 64825)
+ ("ARABIC LIGATURE TAH WITH MEEM MEDIAL FORM" . 64826)
+ ("ARABIC LIGATURE ZAH WITH MEEM MEDIAL FORM" . 64827)
+ ("ARABIC LIGATURE ALEF WITH FATHATAN FINAL FORM" . 64828)
+ ("ARABIC LIGATURE ALEF WITH FATHATAN ISOLATED FORM" . 64829)
+ ("ORNATE LEFT PARENTHESIS" . 64830)
+ ("ORNATE RIGHT PARENTHESIS" . 64831)
+ ("ARABIC LIGATURE TEH WITH JEEM WITH MEEM INITIAL FORM" . 64848)
+ ("ARABIC LIGATURE TEH WITH HAH WITH JEEM FINAL FORM" . 64849)
+ ("ARABIC LIGATURE TEH WITH HAH WITH JEEM INITIAL FORM" . 64850)
+ ("ARABIC LIGATURE TEH WITH HAH WITH MEEM INITIAL FORM" . 64851)
+ ("ARABIC LIGATURE TEH WITH KHAH WITH MEEM INITIAL FORM" . 64852)
+ ("ARABIC LIGATURE TEH WITH MEEM WITH JEEM INITIAL FORM" . 64853)
+ ("ARABIC LIGATURE TEH WITH MEEM WITH HAH INITIAL FORM" . 64854)
+ ("ARABIC LIGATURE TEH WITH MEEM WITH KHAH INITIAL FORM" . 64855)
+ ("ARABIC LIGATURE JEEM WITH MEEM WITH HAH FINAL FORM" . 64856)
+ ("ARABIC LIGATURE JEEM WITH MEEM WITH HAH INITIAL FORM" . 64857)
+ ("ARABIC LIGATURE HAH WITH MEEM WITH YEH FINAL FORM" . 64858)
+ ("ARABIC LIGATURE HAH WITH MEEM WITH ALEF MAKSURA FINAL FORM" . 64859)
+ ("ARABIC LIGATURE SEEN WITH HAH WITH JEEM INITIAL FORM" . 64860)
+ ("ARABIC LIGATURE SEEN WITH JEEM WITH HAH INITIAL FORM" . 64861)
+ ("ARABIC LIGATURE SEEN WITH JEEM WITH ALEF MAKSURA FINAL FORM" . 64862)
+ ("ARABIC LIGATURE SEEN WITH MEEM WITH HAH FINAL FORM" . 64863)
+ ("ARABIC LIGATURE SEEN WITH MEEM WITH HAH INITIAL FORM" . 64864)
+ ("ARABIC LIGATURE SEEN WITH MEEM WITH JEEM INITIAL FORM" . 64865)
+ ("ARABIC LIGATURE SEEN WITH MEEM WITH MEEM FINAL FORM" . 64866)
+ ("ARABIC LIGATURE SEEN WITH MEEM WITH MEEM INITIAL FORM" . 64867)
+ ("ARABIC LIGATURE SAD WITH HAH WITH HAH FINAL FORM" . 64868)
+ ("ARABIC LIGATURE SAD WITH HAH WITH HAH INITIAL FORM" . 64869)
+ ("ARABIC LIGATURE SAD WITH MEEM WITH MEEM FINAL FORM" . 64870)
+ ("ARABIC LIGATURE SHEEN WITH HAH WITH MEEM FINAL FORM" . 64871)
+ ("ARABIC LIGATURE SHEEN WITH HAH WITH MEEM INITIAL FORM" . 64872)
+ ("ARABIC LIGATURE SHEEN WITH JEEM WITH YEH FINAL FORM" . 64873)
+ ("ARABIC LIGATURE SHEEN WITH MEEM WITH KHAH FINAL FORM" . 64874)
+ ("ARABIC LIGATURE SHEEN WITH MEEM WITH KHAH INITIAL FORM" . 64875)
+ ("ARABIC LIGATURE SHEEN WITH MEEM WITH MEEM FINAL FORM" . 64876)
+ ("ARABIC LIGATURE SHEEN WITH MEEM WITH MEEM INITIAL FORM" . 64877)
+ ("ARABIC LIGATURE DAD WITH HAH WITH ALEF MAKSURA FINAL FORM" . 64878)
+ ("ARABIC LIGATURE DAD WITH KHAH WITH MEEM FINAL FORM" . 64879)
+ ("ARABIC LIGATURE DAD WITH KHAH WITH MEEM INITIAL FORM" . 64880)
+ ("ARABIC LIGATURE TAH WITH MEEM WITH HAH FINAL FORM" . 64881)
+ ("ARABIC LIGATURE TAH WITH MEEM WITH HAH INITIAL FORM" . 64882)
+ ("ARABIC LIGATURE TAH WITH MEEM WITH MEEM INITIAL FORM" . 64883)
+ ("ARABIC LIGATURE TAH WITH MEEM WITH YEH FINAL FORM" . 64884)
+ ("ARABIC LIGATURE AIN WITH JEEM WITH MEEM FINAL FORM" . 64885)
+ ("ARABIC LIGATURE AIN WITH MEEM WITH MEEM FINAL FORM" . 64886)
+ ("ARABIC LIGATURE AIN WITH MEEM WITH MEEM INITIAL FORM" . 64887)
+ ("ARABIC LIGATURE AIN WITH MEEM WITH ALEF MAKSURA FINAL FORM" . 64888)
+ ("ARABIC LIGATURE GHAIN WITH MEEM WITH MEEM FINAL FORM" . 64889)
+ ("ARABIC LIGATURE GHAIN WITH MEEM WITH YEH FINAL FORM" . 64890)
+ ("ARABIC LIGATURE GHAIN WITH MEEM WITH ALEF MAKSURA FINAL FORM" . 64891)
+ ("ARABIC LIGATURE FEH WITH KHAH WITH MEEM FINAL FORM" . 64892)
+ ("ARABIC LIGATURE FEH WITH KHAH WITH MEEM INITIAL FORM" . 64893)
+ ("ARABIC LIGATURE QAF WITH MEEM WITH HAH FINAL FORM" . 64894)
+ ("ARABIC LIGATURE QAF WITH MEEM WITH MEEM FINAL FORM" . 64895)
+ ("ARABIC LIGATURE LAM WITH HAH WITH MEEM FINAL FORM" . 64896)
+ ("ARABIC LIGATURE LAM WITH HAH WITH YEH FINAL FORM" . 64897)
+ ("ARABIC LIGATURE LAM WITH HAH WITH ALEF MAKSURA FINAL FORM" . 64898)
+ ("ARABIC LIGATURE LAM WITH JEEM WITH JEEM INITIAL FORM" . 64899)
+ ("ARABIC LIGATURE LAM WITH JEEM WITH JEEM FINAL FORM" . 64900)
+ ("ARABIC LIGATURE LAM WITH KHAH WITH MEEM FINAL FORM" . 64901)
+ ("ARABIC LIGATURE LAM WITH KHAH WITH MEEM INITIAL FORM" . 64902)
+ ("ARABIC LIGATURE LAM WITH MEEM WITH HAH FINAL FORM" . 64903)
+ ("ARABIC LIGATURE LAM WITH MEEM WITH HAH INITIAL FORM" . 64904)
+ ("ARABIC LIGATURE MEEM WITH HAH WITH JEEM INITIAL FORM" . 64905)
+ ("ARABIC LIGATURE MEEM WITH HAH WITH MEEM INITIAL FORM" . 64906)
+ ("ARABIC LIGATURE MEEM WITH HAH WITH YEH FINAL FORM" . 64907)
+ ("ARABIC LIGATURE MEEM WITH JEEM WITH HAH INITIAL FORM" . 64908)
+ ("ARABIC LIGATURE MEEM WITH JEEM WITH MEEM INITIAL FORM" . 64909)
+ ("ARABIC LIGATURE MEEM WITH KHAH WITH JEEM INITIAL FORM" . 64910)
+ ("ARABIC LIGATURE MEEM WITH KHAH WITH MEEM INITIAL FORM" . 64911)
+ ("ARABIC LIGATURE MEEM WITH JEEM WITH KHAH INITIAL FORM" . 64914)
+ ("ARABIC LIGATURE HEH WITH MEEM WITH JEEM INITIAL FORM" . 64915)
+ ("ARABIC LIGATURE HEH WITH MEEM WITH MEEM INITIAL FORM" . 64916)
+ ("ARABIC LIGATURE NOON WITH HAH WITH MEEM INITIAL FORM" . 64917)
+ ("ARABIC LIGATURE NOON WITH HAH WITH ALEF MAKSURA FINAL FORM" . 64918)
+ ("ARABIC LIGATURE NOON WITH JEEM WITH MEEM FINAL FORM" . 64919)
+ ("ARABIC LIGATURE NOON WITH JEEM WITH MEEM INITIAL FORM" . 64920)
+ ("ARABIC LIGATURE NOON WITH JEEM WITH ALEF MAKSURA FINAL FORM" . 64921)
+ ("ARABIC LIGATURE NOON WITH MEEM WITH YEH FINAL FORM" . 64922)
+ ("ARABIC LIGATURE NOON WITH MEEM WITH ALEF MAKSURA FINAL FORM" . 64923)
+ ("ARABIC LIGATURE YEH WITH MEEM WITH MEEM FINAL FORM" . 64924)
+ ("ARABIC LIGATURE YEH WITH MEEM WITH MEEM INITIAL FORM" . 64925)
+ ("ARABIC LIGATURE BEH WITH KHAH WITH YEH FINAL FORM" . 64926)
+ ("ARABIC LIGATURE TEH WITH JEEM WITH YEH FINAL FORM" . 64927)
+ ("ARABIC LIGATURE TEH WITH JEEM WITH ALEF MAKSURA FINAL FORM" . 64928)
+ ("ARABIC LIGATURE TEH WITH KHAH WITH YEH FINAL FORM" . 64929)
+ ("ARABIC LIGATURE TEH WITH KHAH WITH ALEF MAKSURA FINAL FORM" . 64930)
+ ("ARABIC LIGATURE TEH WITH MEEM WITH YEH FINAL FORM" . 64931)
+ ("ARABIC LIGATURE TEH WITH MEEM WITH ALEF MAKSURA FINAL FORM" . 64932)
+ ("ARABIC LIGATURE JEEM WITH MEEM WITH YEH FINAL FORM" . 64933)
+ ("ARABIC LIGATURE JEEM WITH HAH WITH ALEF MAKSURA FINAL FORM" . 64934)
+ ("ARABIC LIGATURE JEEM WITH MEEM WITH ALEF MAKSURA FINAL FORM" . 64935)
+ ("ARABIC LIGATURE SEEN WITH KHAH WITH ALEF MAKSURA FINAL FORM" . 64936)
+ ("ARABIC LIGATURE SAD WITH HAH WITH YEH FINAL FORM" . 64937)
+ ("ARABIC LIGATURE SHEEN WITH HAH WITH YEH FINAL FORM" . 64938)
+ ("ARABIC LIGATURE DAD WITH HAH WITH YEH FINAL FORM" . 64939)
+ ("ARABIC LIGATURE LAM WITH JEEM WITH YEH FINAL FORM" . 64940)
+ ("ARABIC LIGATURE LAM WITH MEEM WITH YEH FINAL FORM" . 64941)
+ ("ARABIC LIGATURE YEH WITH HAH WITH YEH FINAL FORM" . 64942)
+ ("ARABIC LIGATURE YEH WITH JEEM WITH YEH FINAL FORM" . 64943)
+ ("ARABIC LIGATURE YEH WITH MEEM WITH YEH FINAL FORM" . 64944)
+ ("ARABIC LIGATURE MEEM WITH MEEM WITH YEH FINAL FORM" . 64945)
+ ("ARABIC LIGATURE QAF WITH MEEM WITH YEH FINAL FORM" . 64946)
+ ("ARABIC LIGATURE NOON WITH HAH WITH YEH FINAL FORM" . 64947)
+ ("ARABIC LIGATURE QAF WITH MEEM WITH HAH INITIAL FORM" . 64948)
+ ("ARABIC LIGATURE LAM WITH HAH WITH MEEM INITIAL FORM" . 64949)
+ ("ARABIC LIGATURE AIN WITH MEEM WITH YEH FINAL FORM" . 64950)
+ ("ARABIC LIGATURE KAF WITH MEEM WITH YEH FINAL FORM" . 64951)
+ ("ARABIC LIGATURE NOON WITH JEEM WITH HAH INITIAL FORM" . 64952)
+ ("ARABIC LIGATURE MEEM WITH KHAH WITH YEH FINAL FORM" . 64953)
+ ("ARABIC LIGATURE LAM WITH JEEM WITH MEEM INITIAL FORM" . 64954)
+ ("ARABIC LIGATURE KAF WITH MEEM WITH MEEM FINAL FORM" . 64955)
+ ("ARABIC LIGATURE LAM WITH JEEM WITH MEEM FINAL FORM" . 64956)
+ ("ARABIC LIGATURE NOON WITH JEEM WITH HAH FINAL FORM" . 64957)
+ ("ARABIC LIGATURE JEEM WITH HAH WITH YEH FINAL FORM" . 64958)
+ ("ARABIC LIGATURE HAH WITH JEEM WITH YEH FINAL FORM" . 64959)
+ ("ARABIC LIGATURE MEEM WITH JEEM WITH YEH FINAL FORM" . 64960)
+ ("ARABIC LIGATURE FEH WITH MEEM WITH YEH FINAL FORM" . 64961)
+ ("ARABIC LIGATURE BEH WITH HAH WITH YEH FINAL FORM" . 64962)
+ ("ARABIC LIGATURE KAF WITH MEEM WITH MEEM INITIAL FORM" . 64963)
+ ("ARABIC LIGATURE AIN WITH JEEM WITH MEEM INITIAL FORM" . 64964)
+ ("ARABIC LIGATURE SAD WITH MEEM WITH MEEM INITIAL FORM" . 64965)
+ ("ARABIC LIGATURE SEEN WITH KHAH WITH YEH FINAL FORM" . 64966)
+ ("ARABIC LIGATURE NOON WITH JEEM WITH YEH FINAL FORM" . 64967)
+ ("ARABIC LIGATURE SALLA USED AS KORANIC STOP SIGN ISOLATED FORM" . 65008)
+ ("ARABIC LIGATURE QALA USED AS KORANIC STOP SIGN ISOLATED FORM" . 65009)
+ ("ARABIC LIGATURE ALLAH ISOLATED FORM" . 65010)
+ ("ARABIC LIGATURE AKBAR ISOLATED FORM" . 65011)
+ ("ARABIC LIGATURE MOHAMMAD ISOLATED FORM" . 65012)
+ ("ARABIC LIGATURE SALAM ISOLATED FORM" . 65013)
+ ("ARABIC LIGATURE RASOUL ISOLATED FORM" . 65014)
+ ("ARABIC LIGATURE ALAYHE ISOLATED FORM" . 65015)
+ ("ARABIC LIGATURE WASALLAM ISOLATED FORM" . 65016)
+ ("ARABIC LIGATURE SALLA ISOLATED FORM" . 65017)
+ ("ARABIC LIGATURE SALLALLAHOU ALAYHE WASALLAM" . 65018)
+ ("ARABIC LIGATURE JALLAJALALOUHOU" . 65019)
+ ("RIAL SIGN" . 65020)
+ ("VARIATION SELECTOR-1" . 65024)
+ ("VARIATION SELECTOR-2" . 65025)
+ ("VARIATION SELECTOR-3" . 65026)
+ ("VARIATION SELECTOR-4" . 65027)
+ ("VARIATION SELECTOR-5" . 65028)
+ ("VARIATION SELECTOR-6" . 65029)
+ ("VARIATION SELECTOR-7" . 65030)
+ ("VARIATION SELECTOR-8" . 65031)
+ ("VARIATION SELECTOR-9" . 65032)
+ ("VARIATION SELECTOR-10" . 65033)
+ ("VARIATION SELECTOR-11" . 65034)
+ ("VARIATION SELECTOR-12" . 65035)
+ ("VARIATION SELECTOR-13" . 65036)
+ ("VARIATION SELECTOR-14" . 65037)
+ ("VARIATION SELECTOR-15" . 65038)
+ ("VARIATION SELECTOR-16" . 65039)
+ ("COMBINING LIGATURE LEFT HALF" . 65056)
+ ("COMBINING LIGATURE RIGHT HALF" . 65057)
+ ("COMBINING DOUBLE TILDE LEFT HALF" . 65058)
+ ("COMBINING DOUBLE TILDE RIGHT HALF" . 65059)
+ ("PRESENTATION FORM FOR VERTICAL TWO DOT LEADER" . 65072)
+ ("PRESENTATION FORM FOR VERTICAL EM DASH" . 65073)
+ ("PRESENTATION FORM FOR VERTICAL EN DASH" . 65074)
+ ("PRESENTATION FORM FOR VERTICAL LOW LINE" . 65075)
+ ("PRESENTATION FORM FOR VERTICAL WAVY LOW LINE" . 65076)
+ ("PRESENTATION FORM FOR VERTICAL LEFT PARENTHESIS" . 65077)
+ ("PRESENTATION FORM FOR VERTICAL RIGHT PARENTHESIS" . 65078)
+ ("PRESENTATION FORM FOR VERTICAL LEFT CURLY BRACKET" . 65079)
+ ("PRESENTATION FORM FOR VERTICAL RIGHT CURLY BRACKET" . 65080)
+ ("PRESENTATION FORM FOR VERTICAL LEFT TORTOISE SHELL BRACKET" . 65081)
+ ("PRESENTATION FORM FOR VERTICAL RIGHT TORTOISE SHELL BRACKET" . 65082)
+ ("PRESENTATION FORM FOR VERTICAL LEFT BLACK LENTICULAR BRACKET" . 65083)
+ ("PRESENTATION FORM FOR VERTICAL RIGHT BLACK LENTICULAR BRACKET" . 65084)
+ ("PRESENTATION FORM FOR VERTICAL LEFT DOUBLE ANGLE BRACKET" . 65085)
+ ("PRESENTATION FORM FOR VERTICAL RIGHT DOUBLE ANGLE BRACKET" . 65086)
+ ("PRESENTATION FORM FOR VERTICAL LEFT ANGLE BRACKET" . 65087)
+ ("PRESENTATION FORM FOR VERTICAL RIGHT ANGLE BRACKET" . 65088)
+ ("PRESENTATION FORM FOR VERTICAL LEFT CORNER BRACKET" . 65089)
+ ("PRESENTATION FORM FOR VERTICAL RIGHT CORNER BRACKET" . 65090)
+ ("PRESENTATION FORM FOR VERTICAL LEFT WHITE CORNER BRACKET" . 65091)
+ ("PRESENTATION FORM FOR VERTICAL RIGHT WHITE CORNER BRACKET" . 65092)
+ ("SESAME DOT" . 65093)
+ ("WHITE SESAME DOT" . 65094)
+ ("DASHED OVERLINE" . 65097)
+ ("CENTRELINE OVERLINE" . 65098)
+ ("WAVY OVERLINE" . 65099)
+ ("DOUBLE WAVY OVERLINE" . 65100)
+ ("DASHED LOW LINE" . 65101)
+ ("CENTRELINE LOW LINE" . 65102)
+ ("WAVY LOW LINE" . 65103)
+ ("SMALL COMMA" . 65104)
+ ("SMALL IDEOGRAPHIC COMMA" . 65105)
+ ("SMALL FULL STOP" . 65106)
+ ("SMALL SEMICOLON" . 65108)
+ ("SMALL COLON" . 65109)
+ ("SMALL QUESTION MARK" . 65110)
+ ("SMALL EXCLAMATION MARK" . 65111)
+ ("SMALL EM DASH" . 65112)
+ ("SMALL LEFT PARENTHESIS" . 65113)
+ ("SMALL RIGHT PARENTHESIS" . 65114)
+ ("SMALL LEFT CURLY BRACKET" . 65115)
+ ("SMALL RIGHT CURLY BRACKET" . 65116)
+ ("SMALL LEFT TORTOISE SHELL BRACKET" . 65117)
+ ("SMALL RIGHT TORTOISE SHELL BRACKET" . 65118)
+ ("SMALL NUMBER SIGN" . 65119)
+ ("SMALL AMPERSAND" . 65120)
+ ("SMALL ASTERISK" . 65121)
+ ("SMALL PLUS SIGN" . 65122)
+ ("SMALL HYPHEN-MINUS" . 65123)
+ ("SMALL LESS-THAN SIGN" . 65124)
+ ("SMALL GREATER-THAN SIGN" . 65125)
+ ("SMALL EQUALS SIGN" . 65126)
+ ("SMALL REVERSE SOLIDUS" . 65128)
+ ("SMALL DOLLAR SIGN" . 65129)
+ ("SMALL PERCENT SIGN" . 65130)
+ ("SMALL COMMERCIAL AT" . 65131)
+ ("ARABIC FATHATAN ISOLATED FORM" . 65136)
+ ("ARABIC TATWEEL WITH FATHATAN ABOVE" . 65137)
+ ("ARABIC DAMMATAN ISOLATED FORM" . 65138)
+ ("ARABIC TAIL FRAGMENT" . 65139)
+ ("ARABIC KASRATAN ISOLATED FORM" . 65140)
+ ("ARABIC FATHA ISOLATED FORM" . 65142)
+ ("ARABIC FATHA MEDIAL FORM" . 65143)
+ ("ARABIC DAMMA ISOLATED FORM" . 65144)
+ ("ARABIC DAMMA MEDIAL FORM" . 65145)
+ ("ARABIC KASRA ISOLATED FORM" . 65146)
+ ("ARABIC KASRA MEDIAL FORM" . 65147)
+ ("ARABIC SHADDA ISOLATED FORM" . 65148)
+ ("ARABIC SHADDA MEDIAL FORM" . 65149)
+ ("ARABIC SUKUN ISOLATED FORM" . 65150)
+ ("ARABIC SUKUN MEDIAL FORM" . 65151)
+ ("ARABIC LETTER HAMZA ISOLATED FORM" . 65152)
+ ("ARABIC LETTER ALEF WITH MADDA ABOVE ISOLATED FORM" . 65153)
+ ("ARABIC LETTER ALEF WITH MADDA ABOVE FINAL FORM" . 65154)
+ ("ARABIC LETTER ALEF WITH HAMZA ABOVE ISOLATED FORM" . 65155)
+ ("ARABIC LETTER ALEF WITH HAMZA ABOVE FINAL FORM" . 65156)
+ ("ARABIC LETTER WAW WITH HAMZA ABOVE ISOLATED FORM" . 65157)
+ ("ARABIC LETTER WAW WITH HAMZA ABOVE FINAL FORM" . 65158)
+ ("ARABIC LETTER ALEF WITH HAMZA BELOW ISOLATED FORM" . 65159)
+ ("ARABIC LETTER ALEF WITH HAMZA BELOW FINAL FORM" . 65160)
+ ("ARABIC LETTER YEH WITH HAMZA ABOVE ISOLATED FORM" . 65161)
+ ("ARABIC LETTER YEH WITH HAMZA ABOVE FINAL FORM" . 65162)
+ ("ARABIC LETTER YEH WITH HAMZA ABOVE INITIAL FORM" . 65163)
+ ("ARABIC LETTER YEH WITH HAMZA ABOVE MEDIAL FORM" . 65164)
+ ("ARABIC LETTER ALEF ISOLATED FORM" . 65165)
+ ("ARABIC LETTER ALEF FINAL FORM" . 65166)
+ ("ARABIC LETTER BEH ISOLATED FORM" . 65167)
+ ("ARABIC LETTER BEH FINAL FORM" . 65168)
+ ("ARABIC LETTER BEH INITIAL FORM" . 65169)
+ ("ARABIC LETTER BEH MEDIAL FORM" . 65170)
+ ("ARABIC LETTER TEH MARBUTA ISOLATED FORM" . 65171)
+ ("ARABIC LETTER TEH MARBUTA FINAL FORM" . 65172)
+ ("ARABIC LETTER TEH ISOLATED FORM" . 65173)
+ ("ARABIC LETTER TEH FINAL FORM" . 65174)
+ ("ARABIC LETTER TEH INITIAL FORM" . 65175)
+ ("ARABIC LETTER TEH MEDIAL FORM" . 65176)
+ ("ARABIC LETTER THEH ISOLATED FORM" . 65177)
+ ("ARABIC LETTER THEH FINAL FORM" . 65178)
+ ("ARABIC LETTER THEH INITIAL FORM" . 65179)
+ ("ARABIC LETTER THEH MEDIAL FORM" . 65180)
+ ("ARABIC LETTER JEEM ISOLATED FORM" . 65181)
+ ("ARABIC LETTER JEEM FINAL FORM" . 65182)
+ ("ARABIC LETTER JEEM INITIAL FORM" . 65183)
+ ("ARABIC LETTER JEEM MEDIAL FORM" . 65184)
+ ("ARABIC LETTER HAH ISOLATED FORM" . 65185)
+ ("ARABIC LETTER HAH FINAL FORM" . 65186)
+ ("ARABIC LETTER HAH INITIAL FORM" . 65187)
+ ("ARABIC LETTER HAH MEDIAL FORM" . 65188)
+ ("ARABIC LETTER KHAH ISOLATED FORM" . 65189)
+ ("ARABIC LETTER KHAH FINAL FORM" . 65190)
+ ("ARABIC LETTER KHAH INITIAL FORM" . 65191)
+ ("ARABIC LETTER KHAH MEDIAL FORM" . 65192)
+ ("ARABIC LETTER DAL ISOLATED FORM" . 65193)
+ ("ARABIC LETTER DAL FINAL FORM" . 65194)
+ ("ARABIC LETTER THAL ISOLATED FORM" . 65195)
+ ("ARABIC LETTER THAL FINAL FORM" . 65196)
+ ("ARABIC LETTER REH ISOLATED FORM" . 65197)
+ ("ARABIC LETTER REH FINAL FORM" . 65198)
+ ("ARABIC LETTER ZAIN ISOLATED FORM" . 65199)
+ ("ARABIC LETTER ZAIN FINAL FORM" . 65200)
+ ("ARABIC LETTER SEEN ISOLATED FORM" . 65201)
+ ("ARABIC LETTER SEEN FINAL FORM" . 65202)
+ ("ARABIC LETTER SEEN INITIAL FORM" . 65203)
+ ("ARABIC LETTER SEEN MEDIAL FORM" . 65204)
+ ("ARABIC LETTER SHEEN ISOLATED FORM" . 65205)
+ ("ARABIC LETTER SHEEN FINAL FORM" . 65206)
+ ("ARABIC LETTER SHEEN INITIAL FORM" . 65207)
+ ("ARABIC LETTER SHEEN MEDIAL FORM" . 65208)
+ ("ARABIC LETTER SAD ISOLATED FORM" . 65209)
+ ("ARABIC LETTER SAD FINAL FORM" . 65210)
+ ("ARABIC LETTER SAD INITIAL FORM" . 65211)
+ ("ARABIC LETTER SAD MEDIAL FORM" . 65212)
+ ("ARABIC LETTER DAD ISOLATED FORM" . 65213)
+ ("ARABIC LETTER DAD FINAL FORM" . 65214)
+ ("ARABIC LETTER DAD INITIAL FORM" . 65215)
+ ("ARABIC LETTER DAD MEDIAL FORM" . 65216)
+ ("ARABIC LETTER TAH ISOLATED FORM" . 65217)
+ ("ARABIC LETTER TAH FINAL FORM" . 65218)
+ ("ARABIC LETTER TAH INITIAL FORM" . 65219)
+ ("ARABIC LETTER TAH MEDIAL FORM" . 65220)
+ ("ARABIC LETTER ZAH ISOLATED FORM" . 65221)
+ ("ARABIC LETTER ZAH FINAL FORM" . 65222)
+ ("ARABIC LETTER ZAH INITIAL FORM" . 65223)
+ ("ARABIC LETTER ZAH MEDIAL FORM" . 65224)
+ ("ARABIC LETTER AIN ISOLATED FORM" . 65225)
+ ("ARABIC LETTER AIN FINAL FORM" . 65226)
+ ("ARABIC LETTER AIN INITIAL FORM" . 65227)
+ ("ARABIC LETTER AIN MEDIAL FORM" . 65228)
+ ("ARABIC LETTER GHAIN ISOLATED FORM" . 65229)
+ ("ARABIC LETTER GHAIN FINAL FORM" . 65230)
+ ("ARABIC LETTER GHAIN INITIAL FORM" . 65231)
+ ("ARABIC LETTER GHAIN MEDIAL FORM" . 65232)
+ ("ARABIC LETTER FEH ISOLATED FORM" . 65233)
+ ("ARABIC LETTER FEH FINAL FORM" . 65234)
+ ("ARABIC LETTER FEH INITIAL FORM" . 65235)
+ ("ARABIC LETTER FEH MEDIAL FORM" . 65236)
+ ("ARABIC LETTER QAF ISOLATED FORM" . 65237)
+ ("ARABIC LETTER QAF FINAL FORM" . 65238)
+ ("ARABIC LETTER QAF INITIAL FORM" . 65239)
+ ("ARABIC LETTER QAF MEDIAL FORM" . 65240)
+ ("ARABIC LETTER KAF ISOLATED FORM" . 65241)
+ ("ARABIC LETTER KAF FINAL FORM" . 65242)
+ ("ARABIC LETTER KAF INITIAL FORM" . 65243)
+ ("ARABIC LETTER KAF MEDIAL FORM" . 65244)
+ ("ARABIC LETTER LAM ISOLATED FORM" . 65245)
+ ("ARABIC LETTER LAM FINAL FORM" . 65246)
+ ("ARABIC LETTER LAM INITIAL FORM" . 65247)
+ ("ARABIC LETTER LAM MEDIAL FORM" . 65248)
+ ("ARABIC LETTER MEEM ISOLATED FORM" . 65249)
+ ("ARABIC LETTER MEEM FINAL FORM" . 65250)
+ ("ARABIC LETTER MEEM INITIAL FORM" . 65251)
+ ("ARABIC LETTER MEEM MEDIAL FORM" . 65252)
+ ("ARABIC LETTER NOON ISOLATED FORM" . 65253)
+ ("ARABIC LETTER NOON FINAL FORM" . 65254)
+ ("ARABIC LETTER NOON INITIAL FORM" . 65255)
+ ("ARABIC LETTER NOON MEDIAL FORM" . 65256)
+ ("ARABIC LETTER HEH ISOLATED FORM" . 65257)
+ ("ARABIC LETTER HEH FINAL FORM" . 65258)
+ ("ARABIC LETTER HEH INITIAL FORM" . 65259)
+ ("ARABIC LETTER HEH MEDIAL FORM" . 65260)
+ ("ARABIC LETTER WAW ISOLATED FORM" . 65261)
+ ("ARABIC LETTER WAW FINAL FORM" . 65262)
+ ("ARABIC LETTER ALEF MAKSURA ISOLATED FORM" . 65263)
+ ("ARABIC LETTER ALEF MAKSURA FINAL FORM" . 65264)
+ ("ARABIC LETTER YEH ISOLATED FORM" . 65265)
+ ("ARABIC LETTER YEH FINAL FORM" . 65266)
+ ("ARABIC LETTER YEH INITIAL FORM" . 65267)
+ ("ARABIC LETTER YEH MEDIAL FORM" . 65268)
+ ("ARABIC LIGATURE LAM WITH ALEF WITH MADDA ABOVE ISOLATED FORM" . 65269)
+ ("ARABIC LIGATURE LAM WITH ALEF WITH MADDA ABOVE FINAL FORM" . 65270)
+ ("ARABIC LIGATURE LAM WITH ALEF WITH HAMZA ABOVE ISOLATED FORM" . 65271)
+ ("ARABIC LIGATURE LAM WITH ALEF WITH HAMZA ABOVE FINAL FORM" . 65272)
+ ("ARABIC LIGATURE LAM WITH ALEF WITH HAMZA BELOW ISOLATED FORM" . 65273)
+ ("ARABIC LIGATURE LAM WITH ALEF WITH HAMZA BELOW FINAL FORM" . 65274)
+ ("ARABIC LIGATURE LAM WITH ALEF ISOLATED FORM" . 65275)
+ ("ARABIC LIGATURE LAM WITH ALEF FINAL FORM" . 65276)
+ ("ZERO WIDTH NO-BREAK SPACE" . 65279)
+ ("FULLWIDTH EXCLAMATION MARK" . 65281)
+ ("FULLWIDTH QUOTATION MARK" . 65282)
+ ("FULLWIDTH NUMBER SIGN" . 65283)
+ ("FULLWIDTH DOLLAR SIGN" . 65284)
+ ("FULLWIDTH PERCENT SIGN" . 65285)
+ ("FULLWIDTH AMPERSAND" . 65286)
+ ("FULLWIDTH APOSTROPHE" . 65287)
+ ("FULLWIDTH LEFT PARENTHESIS" . 65288)
+ ("FULLWIDTH RIGHT PARENTHESIS" . 65289)
+ ("FULLWIDTH ASTERISK" . 65290)
+ ("FULLWIDTH PLUS SIGN" . 65291)
+ ("FULLWIDTH COMMA" . 65292)
+ ("FULLWIDTH HYPHEN-MINUS" . 65293)
+ ("FULLWIDTH FULL STOP" . 65294)
+ ("FULLWIDTH SOLIDUS" . 65295)
+ ("FULLWIDTH DIGIT ZERO" . 65296)
+ ("FULLWIDTH DIGIT ONE" . 65297)
+ ("FULLWIDTH DIGIT TWO" . 65298)
+ ("FULLWIDTH DIGIT THREE" . 65299)
+ ("FULLWIDTH DIGIT FOUR" . 65300)
+ ("FULLWIDTH DIGIT FIVE" . 65301)
+ ("FULLWIDTH DIGIT SIX" . 65302)
+ ("FULLWIDTH DIGIT SEVEN" . 65303)
+ ("FULLWIDTH DIGIT EIGHT" . 65304)
+ ("FULLWIDTH DIGIT NINE" . 65305)
+ ("FULLWIDTH COLON" . 65306)
+ ("FULLWIDTH SEMICOLON" . 65307)
+ ("FULLWIDTH LESS-THAN SIGN" . 65308)
+ ("FULLWIDTH EQUALS SIGN" . 65309)
+ ("FULLWIDTH GREATER-THAN SIGN" . 65310)
+ ("FULLWIDTH QUESTION MARK" . 65311)
+ ("FULLWIDTH COMMERCIAL AT" . 65312)
+ ("FULLWIDTH LATIN CAPITAL LETTER A" . 65313)
+ ("FULLWIDTH LATIN CAPITAL LETTER B" . 65314)
+ ("FULLWIDTH LATIN CAPITAL LETTER C" . 65315)
+ ("FULLWIDTH LATIN CAPITAL LETTER D" . 65316)
+ ("FULLWIDTH LATIN CAPITAL LETTER E" . 65317)
+ ("FULLWIDTH LATIN CAPITAL LETTER F" . 65318)
+ ("FULLWIDTH LATIN CAPITAL LETTER G" . 65319)
+ ("FULLWIDTH LATIN CAPITAL LETTER H" . 65320)
+ ("FULLWIDTH LATIN CAPITAL LETTER I" . 65321)
+ ("FULLWIDTH LATIN CAPITAL LETTER J" . 65322)
+ ("FULLWIDTH LATIN CAPITAL LETTER K" . 65323)
+ ("FULLWIDTH LATIN CAPITAL LETTER L" . 65324)
+ ("FULLWIDTH LATIN CAPITAL LETTER M" . 65325)
+ ("FULLWIDTH LATIN CAPITAL LETTER N" . 65326)
+ ("FULLWIDTH LATIN CAPITAL LETTER O" . 65327)
+ ("FULLWIDTH LATIN CAPITAL LETTER P" . 65328)
+ ("FULLWIDTH LATIN CAPITAL LETTER Q" . 65329)
+ ("FULLWIDTH LATIN CAPITAL LETTER R" . 65330)
+ ("FULLWIDTH LATIN CAPITAL LETTER S" . 65331)
+ ("FULLWIDTH LATIN CAPITAL LETTER T" . 65332)
+ ("FULLWIDTH LATIN CAPITAL LETTER U" . 65333)
+ ("FULLWIDTH LATIN CAPITAL LETTER V" . 65334)
+ ("FULLWIDTH LATIN CAPITAL LETTER W" . 65335)
+ ("FULLWIDTH LATIN CAPITAL LETTER X" . 65336)
+ ("FULLWIDTH LATIN CAPITAL LETTER Y" . 65337)
+ ("FULLWIDTH LATIN CAPITAL LETTER Z" . 65338)
+ ("FULLWIDTH LEFT SQUARE BRACKET" . 65339)
+ ("FULLWIDTH REVERSE SOLIDUS" . 65340)
+ ("FULLWIDTH RIGHT SQUARE BRACKET" . 65341)
+ ("FULLWIDTH CIRCUMFLEX ACCENT" . 65342)
+ ("FULLWIDTH LOW LINE" . 65343)
+ ("FULLWIDTH GRAVE ACCENT" . 65344)
+ ("FULLWIDTH LATIN SMALL LETTER A" . 65345)
+ ("FULLWIDTH LATIN SMALL LETTER B" . 65346)
+ ("FULLWIDTH LATIN SMALL LETTER C" . 65347)
+ ("FULLWIDTH LATIN SMALL LETTER D" . 65348)
+ ("FULLWIDTH LATIN SMALL LETTER E" . 65349)
+ ("FULLWIDTH LATIN SMALL LETTER F" . 65350)
+ ("FULLWIDTH LATIN SMALL LETTER G" . 65351)
+ ("FULLWIDTH LATIN SMALL LETTER H" . 65352)
+ ("FULLWIDTH LATIN SMALL LETTER I" . 65353)
+ ("FULLWIDTH LATIN SMALL LETTER J" . 65354)
+ ("FULLWIDTH LATIN SMALL LETTER K" . 65355)
+ ("FULLWIDTH LATIN SMALL LETTER L" . 65356)
+ ("FULLWIDTH LATIN SMALL LETTER M" . 65357)
+ ("FULLWIDTH LATIN SMALL LETTER N" . 65358)
+ ("FULLWIDTH LATIN SMALL LETTER O" . 65359)
+ ("FULLWIDTH LATIN SMALL LETTER P" . 65360)
+ ("FULLWIDTH LATIN SMALL LETTER Q" . 65361)
+ ("FULLWIDTH LATIN SMALL LETTER R" . 65362)
+ ("FULLWIDTH LATIN SMALL LETTER S" . 65363)
+ ("FULLWIDTH LATIN SMALL LETTER T" . 65364)
+ ("FULLWIDTH LATIN SMALL LETTER U" . 65365)
+ ("FULLWIDTH LATIN SMALL LETTER V" . 65366)
+ ("FULLWIDTH LATIN SMALL LETTER W" . 65367)
+ ("FULLWIDTH LATIN SMALL LETTER X" . 65368)
+ ("FULLWIDTH LATIN SMALL LETTER Y" . 65369)
+ ("FULLWIDTH LATIN SMALL LETTER Z" . 65370)
+ ("FULLWIDTH LEFT CURLY BRACKET" . 65371)
+ ("FULLWIDTH VERTICAL LINE" . 65372)
+ ("FULLWIDTH RIGHT CURLY BRACKET" . 65373)
+ ("FULLWIDTH TILDE" . 65374)
+ ("FULLWIDTH LEFT WHITE PARENTHESIS" . 65375)
+ ("FULLWIDTH RIGHT WHITE PARENTHESIS" . 65376)
+ ("HALFWIDTH IDEOGRAPHIC FULL STOP" . 65377)
+ ("HALFWIDTH LEFT CORNER BRACKET" . 65378)
+ ("HALFWIDTH RIGHT CORNER BRACKET" . 65379)
+ ("HALFWIDTH IDEOGRAPHIC COMMA" . 65380)
+ ("HALFWIDTH KATAKANA MIDDLE DOT" . 65381)
+ ("HALFWIDTH KATAKANA LETTER WO" . 65382)
+ ("HALFWIDTH KATAKANA LETTER SMALL A" . 65383)
+ ("HALFWIDTH KATAKANA LETTER SMALL I" . 65384)
+ ("HALFWIDTH KATAKANA LETTER SMALL U" . 65385)
+ ("HALFWIDTH KATAKANA LETTER SMALL E" . 65386)
+ ("HALFWIDTH KATAKANA LETTER SMALL O" . 65387)
+ ("HALFWIDTH KATAKANA LETTER SMALL YA" . 65388)
+ ("HALFWIDTH KATAKANA LETTER SMALL YU" . 65389)
+ ("HALFWIDTH KATAKANA LETTER SMALL YO" . 65390)
+ ("HALFWIDTH KATAKANA LETTER SMALL TU" . 65391)
+ ("HALFWIDTH KATAKANA-HIRAGANA PROLONGED SOUND MARK" . 65392)
+ ("HALFWIDTH KATAKANA LETTER A" . 65393)
+ ("HALFWIDTH KATAKANA LETTER I" . 65394)
+ ("HALFWIDTH KATAKANA LETTER U" . 65395)
+ ("HALFWIDTH KATAKANA LETTER E" . 65396)
+ ("HALFWIDTH KATAKANA LETTER O" . 65397)
+ ("HALFWIDTH KATAKANA LETTER KA" . 65398)
+ ("HALFWIDTH KATAKANA LETTER KI" . 65399)
+ ("HALFWIDTH KATAKANA LETTER KU" . 65400)
+ ("HALFWIDTH KATAKANA LETTER KE" . 65401)
+ ("HALFWIDTH KATAKANA LETTER KO" . 65402)
+ ("HALFWIDTH KATAKANA LETTER SA" . 65403)
+ ("HALFWIDTH KATAKANA LETTER SI" . 65404)
+ ("HALFWIDTH KATAKANA LETTER SU" . 65405)
+ ("HALFWIDTH KATAKANA LETTER SE" . 65406)
+ ("HALFWIDTH KATAKANA LETTER SO" . 65407)
+ ("HALFWIDTH KATAKANA LETTER TA" . 65408)
+ ("HALFWIDTH KATAKANA LETTER TI" . 65409)
+ ("HALFWIDTH KATAKANA LETTER TU" . 65410)
+ ("HALFWIDTH KATAKANA LETTER TE" . 65411)
+ ("HALFWIDTH KATAKANA LETTER TO" . 65412)
+ ("HALFWIDTH KATAKANA LETTER NA" . 65413)
+ ("HALFWIDTH KATAKANA LETTER NI" . 65414)
+ ("HALFWIDTH KATAKANA LETTER NU" . 65415)
+ ("HALFWIDTH KATAKANA LETTER NE" . 65416)
+ ("HALFWIDTH KATAKANA LETTER NO" . 65417)
+ ("HALFWIDTH KATAKANA LETTER HA" . 65418)
+ ("HALFWIDTH KATAKANA LETTER HI" . 65419)
+ ("HALFWIDTH KATAKANA LETTER HU" . 65420)
+ ("HALFWIDTH KATAKANA LETTER HE" . 65421)
+ ("HALFWIDTH KATAKANA LETTER HO" . 65422)
+ ("HALFWIDTH KATAKANA LETTER MA" . 65423)
+ ("HALFWIDTH KATAKANA LETTER MI" . 65424)
+ ("HALFWIDTH KATAKANA LETTER MU" . 65425)
+ ("HALFWIDTH KATAKANA LETTER ME" . 65426)
+ ("HALFWIDTH KATAKANA LETTER MO" . 65427)
+ ("HALFWIDTH KATAKANA LETTER YA" . 65428)
+ ("HALFWIDTH KATAKANA LETTER YU" . 65429)
+ ("HALFWIDTH KATAKANA LETTER YO" . 65430)
+ ("HALFWIDTH KATAKANA LETTER RA" . 65431)
+ ("HALFWIDTH KATAKANA LETTER RI" . 65432)
+ ("HALFWIDTH KATAKANA LETTER RU" . 65433)
+ ("HALFWIDTH KATAKANA LETTER RE" . 65434)
+ ("HALFWIDTH KATAKANA LETTER RO" . 65435)
+ ("HALFWIDTH KATAKANA LETTER WA" . 65436)
+ ("HALFWIDTH KATAKANA LETTER N" . 65437)
+ ("HALFWIDTH KATAKANA VOICED SOUND MARK" . 65438)
+ ("HALFWIDTH KATAKANA SEMI-VOICED SOUND MARK" . 65439)
+ ("HALFWIDTH HANGUL FILLER" . 65440)
+ ("HALFWIDTH HANGUL LETTER KIYEOK" . 65441)
+ ("HALFWIDTH HANGUL LETTER SSANGKIYEOK" . 65442)
+ ("HALFWIDTH HANGUL LETTER KIYEOK-SIOS" . 65443)
+ ("HALFWIDTH HANGUL LETTER NIEUN" . 65444)
+ ("HALFWIDTH HANGUL LETTER NIEUN-CIEUC" . 65445)
+ ("HALFWIDTH HANGUL LETTER NIEUN-HIEUH" . 65446)
+ ("HALFWIDTH HANGUL LETTER TIKEUT" . 65447)
+ ("HALFWIDTH HANGUL LETTER SSANGTIKEUT" . 65448)
+ ("HALFWIDTH HANGUL LETTER RIEUL" . 65449)
+ ("HALFWIDTH HANGUL LETTER RIEUL-KIYEOK" . 65450)
+ ("HALFWIDTH HANGUL LETTER RIEUL-MIEUM" . 65451)
+ ("HALFWIDTH HANGUL LETTER RIEUL-PIEUP" . 65452)
+ ("HALFWIDTH HANGUL LETTER RIEUL-SIOS" . 65453)
+ ("HALFWIDTH HANGUL LETTER RIEUL-THIEUTH" . 65454)
+ ("HALFWIDTH HANGUL LETTER RIEUL-PHIEUPH" . 65455)
+ ("HALFWIDTH HANGUL LETTER RIEUL-HIEUH" . 65456)
+ ("HALFWIDTH HANGUL LETTER MIEUM" . 65457)
+ ("HALFWIDTH HANGUL LETTER PIEUP" . 65458)
+ ("HALFWIDTH HANGUL LETTER SSANGPIEUP" . 65459)
+ ("HALFWIDTH HANGUL LETTER PIEUP-SIOS" . 65460)
+ ("HALFWIDTH HANGUL LETTER SIOS" . 65461)
+ ("HALFWIDTH HANGUL LETTER SSANGSIOS" . 65462)
+ ("HALFWIDTH HANGUL LETTER IEUNG" . 65463)
+ ("HALFWIDTH HANGUL LETTER CIEUC" . 65464)
+ ("HALFWIDTH HANGUL LETTER SSANGCIEUC" . 65465)
+ ("HALFWIDTH HANGUL LETTER CHIEUCH" . 65466)
+ ("HALFWIDTH HANGUL LETTER KHIEUKH" . 65467)
+ ("HALFWIDTH HANGUL LETTER THIEUTH" . 65468)
+ ("HALFWIDTH HANGUL LETTER PHIEUPH" . 65469)
+ ("HALFWIDTH HANGUL LETTER HIEUH" . 65470)
+ ("HALFWIDTH HANGUL LETTER A" . 65474)
+ ("HALFWIDTH HANGUL LETTER AE" . 65475)
+ ("HALFWIDTH HANGUL LETTER YA" . 65476)
+ ("HALFWIDTH HANGUL LETTER YAE" . 65477)
+ ("HALFWIDTH HANGUL LETTER EO" . 65478)
+ ("HALFWIDTH HANGUL LETTER E" . 65479)
+ ("HALFWIDTH HANGUL LETTER YEO" . 65482)
+ ("HALFWIDTH HANGUL LETTER YE" . 65483)
+ ("HALFWIDTH HANGUL LETTER O" . 65484)
+ ("HALFWIDTH HANGUL LETTER WA" . 65485)
+ ("HALFWIDTH HANGUL LETTER WAE" . 65486)
+ ("HALFWIDTH HANGUL LETTER OE" . 65487)
+ ("HALFWIDTH HANGUL LETTER YO" . 65490)
+ ("HALFWIDTH HANGUL LETTER U" . 65491)
+ ("HALFWIDTH HANGUL LETTER WEO" . 65492)
+ ("HALFWIDTH HANGUL LETTER WE" . 65493)
+ ("HALFWIDTH HANGUL LETTER WI" . 65494)
+ ("HALFWIDTH HANGUL LETTER YU" . 65495)
+ ("HALFWIDTH HANGUL LETTER EU" . 65498)
+ ("HALFWIDTH HANGUL LETTER YI" . 65499)
+ ("HALFWIDTH HANGUL LETTER I" . 65500)
+ ("FULLWIDTH CENT SIGN" . 65504)
+ ("FULLWIDTH POUND SIGN" . 65505)
+ ("FULLWIDTH NOT SIGN" . 65506)
+ ("FULLWIDTH MACRON" . 65507)
+ ("FULLWIDTH BROKEN BAR" . 65508)
+ ("FULLWIDTH YEN SIGN" . 65509)
+ ("FULLWIDTH WON SIGN" . 65510)
+ ("HALFWIDTH FORMS LIGHT VERTICAL" . 65512)
+ ("HALFWIDTH LEFTWARDS ARROW" . 65513)
+ ("HALFWIDTH UPWARDS ARROW" . 65514)
+ ("HALFWIDTH RIGHTWARDS ARROW" . 65515)
+ ("HALFWIDTH DOWNWARDS ARROW" . 65516)
+ ("HALFWIDTH BLACK SQUARE" . 65517)
+ ("HALFWIDTH WHITE CIRCLE" . 65518)
+ ("INTERLINEAR ANNOTATION ANCHOR" . 65529)
+ ("INTERLINEAR ANNOTATION SEPARATOR" . 65530)
+ ("INTERLINEAR ANNOTATION TERMINATOR" . 65531)
+ ("OBJECT REPLACEMENT CHARACTER" . 65532)
+ ("REPLACEMENT CHARACTER" . 65533)
+ ("OLD ITALIC LETTER A" . 66304)
+ ("OLD ITALIC LETTER BE" . 66305)
+ ("OLD ITALIC LETTER KE" . 66306)
+ ("OLD ITALIC LETTER DE" . 66307)
+ ("OLD ITALIC LETTER E" . 66308)
+ ("OLD ITALIC LETTER VE" . 66309)
+ ("OLD ITALIC LETTER ZE" . 66310)
+ ("OLD ITALIC LETTER HE" . 66311)
+ ("OLD ITALIC LETTER THE" . 66312)
+ ("OLD ITALIC LETTER I" . 66313)
+ ("OLD ITALIC LETTER KA" . 66314)
+ ("OLD ITALIC LETTER EL" . 66315)
+ ("OLD ITALIC LETTER EM" . 66316)
+ ("OLD ITALIC LETTER EN" . 66317)
+ ("OLD ITALIC LETTER ESH" . 66318)
+ ("OLD ITALIC LETTER O" . 66319)
+ ("OLD ITALIC LETTER PE" . 66320)
+ ("OLD ITALIC LETTER SHE" . 66321)
+ ("OLD ITALIC LETTER KU" . 66322)
+ ("OLD ITALIC LETTER ER" . 66323)
+ ("OLD ITALIC LETTER ES" . 66324)
+ ("OLD ITALIC LETTER TE" . 66325)
+ ("OLD ITALIC LETTER U" . 66326)
+ ("OLD ITALIC LETTER EKS" . 66327)
+ ("OLD ITALIC LETTER PHE" . 66328)
+ ("OLD ITALIC LETTER KHE" . 66329)
+ ("OLD ITALIC LETTER EF" . 66330)
+ ("OLD ITALIC LETTER ERS" . 66331)
+ ("OLD ITALIC LETTER CHE" . 66332)
+ ("OLD ITALIC LETTER II" . 66333)
+ ("OLD ITALIC LETTER UU" . 66334)
+ ("OLD ITALIC NUMERAL ONE" . 66336)
+ ("OLD ITALIC NUMERAL FIVE" . 66337)
+ ("OLD ITALIC NUMERAL TEN" . 66338)
+ ("OLD ITALIC NUMERAL FIFTY" . 66339)
+ ("GOTHIC LETTER AHSA" . 66352)
+ ("GOTHIC LETTER BAIRKAN" . 66353)
+ ("GOTHIC LETTER GIBA" . 66354)
+ ("GOTHIC LETTER DAGS" . 66355)
+ ("GOTHIC LETTER AIHVUS" . 66356)
+ ("GOTHIC LETTER QAIRTHRA" . 66357)
+ ("GOTHIC LETTER IUJA" . 66358)
+ ("GOTHIC LETTER HAGL" . 66359)
+ ("GOTHIC LETTER THIUTH" . 66360)
+ ("GOTHIC LETTER EIS" . 66361)
+ ("GOTHIC LETTER KUSMA" . 66362)
+ ("GOTHIC LETTER LAGUS" . 66363)
+ ("GOTHIC LETTER MANNA" . 66364)
+ ("GOTHIC LETTER NAUTHS" . 66365)
+ ("GOTHIC LETTER JER" . 66366)
+ ("GOTHIC LETTER URUS" . 66367)
+ ("GOTHIC LETTER PAIRTHRA" . 66368)
+ ("GOTHIC LETTER NINETY" . 66369)
+ ("GOTHIC LETTER RAIDA" . 66370)
+ ("GOTHIC LETTER SAUIL" . 66371)
+ ("GOTHIC LETTER TEIWS" . 66372)
+ ("GOTHIC LETTER WINJA" . 66373)
+ ("GOTHIC LETTER FAIHU" . 66374)
+ ("GOTHIC LETTER IGGWS" . 66375)
+ ("GOTHIC LETTER HWAIR" . 66376)
+ ("GOTHIC LETTER OTHAL" . 66377)
+ ("GOTHIC LETTER NINE HUNDRED" . 66378)
+ ("DESERET CAPITAL LETTER LONG I" . 66560)
+ ("DESERET CAPITAL LETTER LONG E" . 66561)
+ ("DESERET CAPITAL LETTER LONG A" . 66562)
+ ("DESERET CAPITAL LETTER LONG AH" . 66563)
+ ("DESERET CAPITAL LETTER LONG O" . 66564)
+ ("DESERET CAPITAL LETTER LONG OO" . 66565)
+ ("DESERET CAPITAL LETTER SHORT I" . 66566)
+ ("DESERET CAPITAL LETTER SHORT E" . 66567)
+ ("DESERET CAPITAL LETTER SHORT A" . 66568)
+ ("DESERET CAPITAL LETTER SHORT AH" . 66569)
+ ("DESERET CAPITAL LETTER SHORT O" . 66570)
+ ("DESERET CAPITAL LETTER SHORT OO" . 66571)
+ ("DESERET CAPITAL LETTER AY" . 66572)
+ ("DESERET CAPITAL LETTER OW" . 66573)
+ ("DESERET CAPITAL LETTER WU" . 66574)
+ ("DESERET CAPITAL LETTER YEE" . 66575)
+ ("DESERET CAPITAL LETTER H" . 66576)
+ ("DESERET CAPITAL LETTER PEE" . 66577)
+ ("DESERET CAPITAL LETTER BEE" . 66578)
+ ("DESERET CAPITAL LETTER TEE" . 66579)
+ ("DESERET CAPITAL LETTER DEE" . 66580)
+ ("DESERET CAPITAL LETTER CHEE" . 66581)
+ ("DESERET CAPITAL LETTER JEE" . 66582)
+ ("DESERET CAPITAL LETTER KAY" . 66583)
+ ("DESERET CAPITAL LETTER GAY" . 66584)
+ ("DESERET CAPITAL LETTER EF" . 66585)
+ ("DESERET CAPITAL LETTER VEE" . 66586)
+ ("DESERET CAPITAL LETTER ETH" . 66587)
+ ("DESERET CAPITAL LETTER THEE" . 66588)
+ ("DESERET CAPITAL LETTER ES" . 66589)
+ ("DESERET CAPITAL LETTER ZEE" . 66590)
+ ("DESERET CAPITAL LETTER ESH" . 66591)
+ ("DESERET CAPITAL LETTER ZHEE" . 66592)
+ ("DESERET CAPITAL LETTER ER" . 66593)
+ ("DESERET CAPITAL LETTER EL" . 66594)
+ ("DESERET CAPITAL LETTER EM" . 66595)
+ ("DESERET CAPITAL LETTER EN" . 66596)
+ ("DESERET CAPITAL LETTER ENG" . 66597)
+ ("DESERET SMALL LETTER LONG I" . 66600)
+ ("DESERET SMALL LETTER LONG E" . 66601)
+ ("DESERET SMALL LETTER LONG A" . 66602)
+ ("DESERET SMALL LETTER LONG AH" . 66603)
+ ("DESERET SMALL LETTER LONG O" . 66604)
+ ("DESERET SMALL LETTER LONG OO" . 66605)
+ ("DESERET SMALL LETTER SHORT I" . 66606)
+ ("DESERET SMALL LETTER SHORT E" . 66607)
+ ("DESERET SMALL LETTER SHORT A" . 66608)
+ ("DESERET SMALL LETTER SHORT AH" . 66609)
+ ("DESERET SMALL LETTER SHORT O" . 66610)
+ ("DESERET SMALL LETTER SHORT OO" . 66611)
+ ("DESERET SMALL LETTER AY" . 66612)
+ ("DESERET SMALL LETTER OW" . 66613)
+ ("DESERET SMALL LETTER WU" . 66614)
+ ("DESERET SMALL LETTER YEE" . 66615)
+ ("DESERET SMALL LETTER H" . 66616)
+ ("DESERET SMALL LETTER PEE" . 66617)
+ ("DESERET SMALL LETTER BEE" . 66618)
+ ("DESERET SMALL LETTER TEE" . 66619)
+ ("DESERET SMALL LETTER DEE" . 66620)
+ ("DESERET SMALL LETTER CHEE" . 66621)
+ ("DESERET SMALL LETTER JEE" . 66622)
+ ("DESERET SMALL LETTER KAY" . 66623)
+ ("DESERET SMALL LETTER GAY" . 66624)
+ ("DESERET SMALL LETTER EF" . 66625)
+ ("DESERET SMALL LETTER VEE" . 66626)
+ ("DESERET SMALL LETTER ETH" . 66627)
+ ("DESERET SMALL LETTER THEE" . 66628)
+ ("DESERET SMALL LETTER ES" . 66629)
+ ("DESERET SMALL LETTER ZEE" . 66630)
+ ("DESERET SMALL LETTER ESH" . 66631)
+ ("DESERET SMALL LETTER ZHEE" . 66632)
+ ("DESERET SMALL LETTER ER" . 66633)
+ ("DESERET SMALL LETTER EL" . 66634)
+ ("DESERET SMALL LETTER EM" . 66635)
+ ("DESERET SMALL LETTER EN" . 66636)
+ ("DESERET SMALL LETTER ENG" . 66637)
+ ("BYZANTINE MUSICAL SYMBOL PSILI" . 118784)
+ ("BYZANTINE MUSICAL SYMBOL DASEIA" . 118785)
+ ("BYZANTINE MUSICAL SYMBOL PERISPOMENI" . 118786)
+ ("BYZANTINE MUSICAL SYMBOL OXEIA EKFONITIKON" . 118787)
+ ("BYZANTINE MUSICAL SYMBOL OXEIA DIPLI" . 118788)
+ ("BYZANTINE MUSICAL SYMBOL VAREIA EKFONITIKON" . 118789)
+ ("BYZANTINE MUSICAL SYMBOL VAREIA DIPLI" . 118790)
+ ("BYZANTINE MUSICAL SYMBOL KATHISTI" . 118791)
+ ("BYZANTINE MUSICAL SYMBOL SYRMATIKI" . 118792)
+ ("BYZANTINE MUSICAL SYMBOL PARAKLITIKI" . 118793)
+ ("BYZANTINE MUSICAL SYMBOL YPOKRISIS" . 118794)
+ ("BYZANTINE MUSICAL SYMBOL YPOKRISIS DIPLI" . 118795)
+ ("BYZANTINE MUSICAL SYMBOL KREMASTI" . 118796)
+ ("BYZANTINE MUSICAL SYMBOL APESO EKFONITIKON" . 118797)
+ ("BYZANTINE MUSICAL SYMBOL EXO EKFONITIKON" . 118798)
+ ("BYZANTINE MUSICAL SYMBOL TELEIA" . 118799)
+ ("BYZANTINE MUSICAL SYMBOL KENTIMATA" . 118800)
+ ("BYZANTINE MUSICAL SYMBOL APOSTROFOS" . 118801)
+ ("BYZANTINE MUSICAL SYMBOL APOSTROFOS DIPLI" . 118802)
+ ("BYZANTINE MUSICAL SYMBOL SYNEVMA" . 118803)
+ ("BYZANTINE MUSICAL SYMBOL THITA" . 118804)
+ ("BYZANTINE MUSICAL SYMBOL OLIGON ARCHAION" . 118805)
+ ("BYZANTINE MUSICAL SYMBOL GORGON ARCHAION" . 118806)
+ ("BYZANTINE MUSICAL SYMBOL PSILON" . 118807)
+ ("BYZANTINE MUSICAL SYMBOL CHAMILON" . 118808)
+ ("BYZANTINE MUSICAL SYMBOL VATHY" . 118809)
+ ("BYZANTINE MUSICAL SYMBOL ISON ARCHAION" . 118810)
+ ("BYZANTINE MUSICAL SYMBOL KENTIMA ARCHAION" . 118811)
+ ("BYZANTINE MUSICAL SYMBOL KENTIMATA ARCHAION" . 118812)
+ ("BYZANTINE MUSICAL SYMBOL SAXIMATA" . 118813)
+ ("BYZANTINE MUSICAL SYMBOL PARICHON" . 118814)
+ ("BYZANTINE MUSICAL SYMBOL STAVROS APODEXIA" . 118815)
+ ("BYZANTINE MUSICAL SYMBOL OXEIAI ARCHAION" . 118816)
+ ("BYZANTINE MUSICAL SYMBOL VAREIAI ARCHAION" . 118817)
+ ("BYZANTINE MUSICAL SYMBOL APODERMA ARCHAION" . 118818)
+ ("BYZANTINE MUSICAL SYMBOL APOTHEMA" . 118819)
+ ("BYZANTINE MUSICAL SYMBOL KLASMA" . 118820)
+ ("BYZANTINE MUSICAL SYMBOL REVMA" . 118821)
+ ("BYZANTINE MUSICAL SYMBOL PIASMA ARCHAION" . 118822)
+ ("BYZANTINE MUSICAL SYMBOL TINAGMA" . 118823)
+ ("BYZANTINE MUSICAL SYMBOL ANATRICHISMA" . 118824)
+ ("BYZANTINE MUSICAL SYMBOL SEISMA" . 118825)
+ ("BYZANTINE MUSICAL SYMBOL SYNAGMA ARCHAION" . 118826)
+ ("BYZANTINE MUSICAL SYMBOL SYNAGMA META STAVROU" . 118827)
+ ("BYZANTINE MUSICAL SYMBOL OYRANISMA ARCHAION" . 118828)
+ ("BYZANTINE MUSICAL SYMBOL THEMA" . 118829)
+ ("BYZANTINE MUSICAL SYMBOL LEMOI" . 118830)
+ ("BYZANTINE MUSICAL SYMBOL DYO" . 118831)
+ ("BYZANTINE MUSICAL SYMBOL TRIA" . 118832)
+ ("BYZANTINE MUSICAL SYMBOL TESSERA" . 118833)
+ ("BYZANTINE MUSICAL SYMBOL KRATIMATA" . 118834)
+ ("BYZANTINE MUSICAL SYMBOL APESO EXO NEO" . 118835)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA ARCHAION" . 118836)
+ ("BYZANTINE MUSICAL SYMBOL IMIFTHORA" . 118837)
+ ("BYZANTINE MUSICAL SYMBOL TROMIKON ARCHAION" . 118838)
+ ("BYZANTINE MUSICAL SYMBOL KATAVA TROMIKON" . 118839)
+ ("BYZANTINE MUSICAL SYMBOL PELASTON" . 118840)
+ ("BYZANTINE MUSICAL SYMBOL PSIFISTON" . 118841)
+ ("BYZANTINE MUSICAL SYMBOL KONTEVMA" . 118842)
+ ("BYZANTINE MUSICAL SYMBOL CHOREVMA ARCHAION" . 118843)
+ ("BYZANTINE MUSICAL SYMBOL RAPISMA" . 118844)
+ ("BYZANTINE MUSICAL SYMBOL PARAKALESMA ARCHAION" . 118845)
+ ("BYZANTINE MUSICAL SYMBOL PARAKLITIKI ARCHAION" . 118846)
+ ("BYZANTINE MUSICAL SYMBOL ICHADIN" . 118847)
+ ("BYZANTINE MUSICAL SYMBOL NANA" . 118848)
+ ("BYZANTINE MUSICAL SYMBOL PETASMA" . 118849)
+ ("BYZANTINE MUSICAL SYMBOL KONTEVMA ALLO" . 118850)
+ ("BYZANTINE MUSICAL SYMBOL TROMIKON ALLO" . 118851)
+ ("BYZANTINE MUSICAL SYMBOL STRAGGISMATA" . 118852)
+ ("BYZANTINE MUSICAL SYMBOL GRONTHISMATA" . 118853)
+ ("BYZANTINE MUSICAL SYMBOL ISON NEO" . 118854)
+ ("BYZANTINE MUSICAL SYMBOL OLIGON NEO" . 118855)
+ ("BYZANTINE MUSICAL SYMBOL OXEIA NEO" . 118856)
+ ("BYZANTINE MUSICAL SYMBOL PETASTI" . 118857)
+ ("BYZANTINE MUSICAL SYMBOL KOUFISMA" . 118858)
+ ("BYZANTINE MUSICAL SYMBOL PETASTOKOUFISMA" . 118859)
+ ("BYZANTINE MUSICAL SYMBOL KRATIMOKOUFISMA" . 118860)
+ ("BYZANTINE MUSICAL SYMBOL PELASTON NEO" . 118861)
+ ("BYZANTINE MUSICAL SYMBOL KENTIMATA NEO ANO" . 118862)
+ ("BYZANTINE MUSICAL SYMBOL KENTIMA NEO ANO" . 118863)
+ ("BYZANTINE MUSICAL SYMBOL YPSILI" . 118864)
+ ("BYZANTINE MUSICAL SYMBOL APOSTROFOS NEO" . 118865)
+ ("BYZANTINE MUSICAL SYMBOL APOSTROFOI SYNDESMOS NEO" . 118866)
+ ("BYZANTINE MUSICAL SYMBOL YPORROI" . 118867)
+ ("BYZANTINE MUSICAL SYMBOL KRATIMOYPORROON" . 118868)
+ ("BYZANTINE MUSICAL SYMBOL ELAFRON" . 118869)
+ ("BYZANTINE MUSICAL SYMBOL CHAMILI" . 118870)
+ ("BYZANTINE MUSICAL SYMBOL MIKRON ISON" . 118871)
+ ("BYZANTINE MUSICAL SYMBOL VAREIA NEO" . 118872)
+ ("BYZANTINE MUSICAL SYMBOL PIASMA NEO" . 118873)
+ ("BYZANTINE MUSICAL SYMBOL PSIFISTON NEO" . 118874)
+ ("BYZANTINE MUSICAL SYMBOL OMALON" . 118875)
+ ("BYZANTINE MUSICAL SYMBOL ANTIKENOMA" . 118876)
+ ("BYZANTINE MUSICAL SYMBOL LYGISMA" . 118877)
+ ("BYZANTINE MUSICAL SYMBOL PARAKLITIKI NEO" . 118878)
+ ("BYZANTINE MUSICAL SYMBOL PARAKALESMA NEO" . 118879)
+ ("BYZANTINE MUSICAL SYMBOL ETERON PARAKALESMA" . 118880)
+ ("BYZANTINE MUSICAL SYMBOL KYLISMA" . 118881)
+ ("BYZANTINE MUSICAL SYMBOL ANTIKENOKYLISMA" . 118882)
+ ("BYZANTINE MUSICAL SYMBOL TROMIKON NEO" . 118883)
+ ("BYZANTINE MUSICAL SYMBOL EKSTREPTON" . 118884)
+ ("BYZANTINE MUSICAL SYMBOL SYNAGMA NEO" . 118885)
+ ("BYZANTINE MUSICAL SYMBOL SYRMA" . 118886)
+ ("BYZANTINE MUSICAL SYMBOL CHOREVMA NEO" . 118887)
+ ("BYZANTINE MUSICAL SYMBOL EPEGERMA" . 118888)
+ ("BYZANTINE MUSICAL SYMBOL SEISMA NEO" . 118889)
+ ("BYZANTINE MUSICAL SYMBOL XIRON KLASMA" . 118890)
+ ("BYZANTINE MUSICAL SYMBOL TROMIKOPSIFISTON" . 118891)
+ ("BYZANTINE MUSICAL SYMBOL PSIFISTOLYGISMA" . 118892)
+ ("BYZANTINE MUSICAL SYMBOL TROMIKOLYGISMA" . 118893)
+ ("BYZANTINE MUSICAL SYMBOL TROMIKOPARAKALESMA" . 118894)
+ ("BYZANTINE MUSICAL SYMBOL PSIFISTOPARAKALESMA" . 118895)
+ ("BYZANTINE MUSICAL SYMBOL TROMIKOSYNAGMA" . 118896)
+ ("BYZANTINE MUSICAL SYMBOL PSIFISTOSYNAGMA" . 118897)
+ ("BYZANTINE MUSICAL SYMBOL GORGOSYNTHETON" . 118898)
+ ("BYZANTINE MUSICAL SYMBOL ARGOSYNTHETON" . 118899)
+ ("BYZANTINE MUSICAL SYMBOL ETERON ARGOSYNTHETON" . 118900)
+ ("BYZANTINE MUSICAL SYMBOL OYRANISMA NEO" . 118901)
+ ("BYZANTINE MUSICAL SYMBOL THEMATISMOS ESO" . 118902)
+ ("BYZANTINE MUSICAL SYMBOL THEMATISMOS EXO" . 118903)
+ ("BYZANTINE MUSICAL SYMBOL THEMA APLOUN" . 118904)
+ ("BYZANTINE MUSICAL SYMBOL THES KAI APOTHES" . 118905)
+ ("BYZANTINE MUSICAL SYMBOL KATAVASMA" . 118906)
+ ("BYZANTINE MUSICAL SYMBOL ENDOFONON" . 118907)
+ ("BYZANTINE MUSICAL SYMBOL YFEN KATO" . 118908)
+ ("BYZANTINE MUSICAL SYMBOL YFEN ANO" . 118909)
+ ("BYZANTINE MUSICAL SYMBOL STAVROS" . 118910)
+ ("BYZANTINE MUSICAL SYMBOL KLASMA ANO" . 118911)
+ ("BYZANTINE MUSICAL SYMBOL DIPLI ARCHAION" . 118912)
+ ("BYZANTINE MUSICAL SYMBOL KRATIMA ARCHAION" . 118913)
+ ("BYZANTINE MUSICAL SYMBOL KRATIMA ALLO" . 118914)
+ ("BYZANTINE MUSICAL SYMBOL KRATIMA NEO" . 118915)
+ ("BYZANTINE MUSICAL SYMBOL APODERMA NEO" . 118916)
+ ("BYZANTINE MUSICAL SYMBOL APLI" . 118917)
+ ("BYZANTINE MUSICAL SYMBOL DIPLI" . 118918)
+ ("BYZANTINE MUSICAL SYMBOL TRIPLI" . 118919)
+ ("BYZANTINE MUSICAL SYMBOL TETRAPLI" . 118920)
+ ("BYZANTINE MUSICAL SYMBOL KORONIS" . 118921)
+ ("BYZANTINE MUSICAL SYMBOL LEIMMA ENOS CHRONOU" . 118922)
+ ("BYZANTINE MUSICAL SYMBOL LEIMMA DYO CHRONON" . 118923)
+ ("BYZANTINE MUSICAL SYMBOL LEIMMA TRION CHRONON" . 118924)
+ ("BYZANTINE MUSICAL SYMBOL LEIMMA TESSARON CHRONON" . 118925)
+ ("BYZANTINE MUSICAL SYMBOL LEIMMA IMISEOS CHRONOU" . 118926)
+ ("BYZANTINE MUSICAL SYMBOL GORGON NEO ANO" . 118927)
+ ("BYZANTINE MUSICAL SYMBOL GORGON PARESTIGMENON ARISTERA" . 118928)
+ ("BYZANTINE MUSICAL SYMBOL GORGON PARESTIGMENON DEXIA" . 118929)
+ ("BYZANTINE MUSICAL SYMBOL DIGORGON" . 118930)
+ ("BYZANTINE MUSICAL SYMBOL DIGORGON PARESTIGMENON ARISTERA KATO" . 118931)
+ ("BYZANTINE MUSICAL SYMBOL DIGORGON PARESTIGMENON ARISTERA ANO" . 118932)
+ ("BYZANTINE MUSICAL SYMBOL DIGORGON PARESTIGMENON DEXIA" . 118933)
+ ("BYZANTINE MUSICAL SYMBOL TRIGORGON" . 118934)
+ ("BYZANTINE MUSICAL SYMBOL ARGON" . 118935)
+ ("BYZANTINE MUSICAL SYMBOL IMIDIARGON" . 118936)
+ ("BYZANTINE MUSICAL SYMBOL DIARGON" . 118937)
+ ("BYZANTINE MUSICAL SYMBOL AGOGI POLI ARGI" . 118938)
+ ("BYZANTINE MUSICAL SYMBOL AGOGI ARGOTERI" . 118939)
+ ("BYZANTINE MUSICAL SYMBOL AGOGI ARGI" . 118940)
+ ("BYZANTINE MUSICAL SYMBOL AGOGI METRIA" . 118941)
+ ("BYZANTINE MUSICAL SYMBOL AGOGI MESI" . 118942)
+ ("BYZANTINE MUSICAL SYMBOL AGOGI GORGI" . 118943)
+ ("BYZANTINE MUSICAL SYMBOL AGOGI GORGOTERI" . 118944)
+ ("BYZANTINE MUSICAL SYMBOL AGOGI POLI GORGI" . 118945)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA PROTOS ICHOS" . 118946)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA ALLI PROTOS ICHOS" . 118947)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA DEYTEROS ICHOS" . 118948)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA ALLI DEYTEROS ICHOS" . 118949)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA TRITOS ICHOS" . 118950)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA TRIFONIAS" . 118951)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA TETARTOS ICHOS" . 118952)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA TETARTOS LEGETOS ICHOS" . 118953)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA LEGETOS ICHOS" . 118954)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA PLAGIOS ICHOS" . 118955)
+ ("BYZANTINE MUSICAL SYMBOL ISAKIA TELOUS ICHIMATOS" . 118956)
+ ("BYZANTINE MUSICAL SYMBOL APOSTROFOI TELOUS ICHIMATOS" . 118957)
+ ("BYZANTINE MUSICAL SYMBOL FANEROSIS TETRAFONIAS" . 118958)
+ ("BYZANTINE MUSICAL SYMBOL FANEROSIS MONOFONIAS" . 118959)
+ ("BYZANTINE MUSICAL SYMBOL FANEROSIS DIFONIAS" . 118960)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA VARYS ICHOS" . 118961)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA PROTOVARYS ICHOS" . 118962)
+ ("BYZANTINE MUSICAL SYMBOL MARTYRIA PLAGIOS TETARTOS ICHOS" . 118963)
+ ("BYZANTINE MUSICAL SYMBOL GORTHMIKON N APLOUN" . 118964)
+ ("BYZANTINE MUSICAL SYMBOL GORTHMIKON N DIPLOUN" . 118965)
+ ("BYZANTINE MUSICAL SYMBOL ENARXIS KAI FTHORA VOU" . 118966)
+ ("BYZANTINE MUSICAL SYMBOL IMIFONON" . 118967)
+ ("BYZANTINE MUSICAL SYMBOL IMIFTHORON" . 118968)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA ARCHAION DEYTEROU ICHOU" . 118969)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA DIATONIKI PA" . 118970)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA DIATONIKI NANA" . 118971)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA NAOS ICHOS" . 118972)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA DIATONIKI DI" . 118973)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON DIATONON DI" . 118974)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA DIATONIKI KE" . 118975)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA DIATONIKI ZO" . 118976)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA DIATONIKI NI KATO" . 118977)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA DIATONIKI NI ANO" . 118978)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA MALAKON CHROMA DIFONIAS" . 118979)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA MALAKON CHROMA MONOFONIAS" . 118980)
+ ("BYZANTINE MUSICAL SYMBOL FHTORA SKLIRON CHROMA VASIS" . 118981)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA SKLIRON CHROMA SYNAFI" . 118982)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA NENANO" . 118983)
+ ("BYZANTINE MUSICAL SYMBOL CHROA ZYGOS" . 118984)
+ ("BYZANTINE MUSICAL SYMBOL CHROA KLITON" . 118985)
+ ("BYZANTINE MUSICAL SYMBOL CHROA SPATHI" . 118986)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA I YFESIS TETARTIMORION" . 118987)
+ ("BYZANTINE MUSICAL SYMBOL FTHORA ENARMONIOS ANTIFONIA" . 118988)
+ ("BYZANTINE MUSICAL SYMBOL YFESIS TRITIMORION" . 118989)
+ ("BYZANTINE MUSICAL SYMBOL DIESIS TRITIMORION" . 118990)
+ ("BYZANTINE MUSICAL SYMBOL DIESIS TETARTIMORION" . 118991)
+ ("BYZANTINE MUSICAL SYMBOL DIESIS APLI DYO DODEKATA" . 118992)
+ ("BYZANTINE MUSICAL SYMBOL DIESIS MONOGRAMMOS TESSERA DODEKATA" . 118993)
+ ("BYZANTINE MUSICAL SYMBOL DIESIS DIGRAMMOS EX DODEKATA" . 118994)
+ ("BYZANTINE MUSICAL SYMBOL DIESIS TRIGRAMMOS OKTO DODEKATA" . 118995)
+ ("BYZANTINE MUSICAL SYMBOL YFESIS APLI DYO DODEKATA" . 118996)
+ ("BYZANTINE MUSICAL SYMBOL YFESIS MONOGRAMMOS TESSERA DODEKATA" . 118997)
+ ("BYZANTINE MUSICAL SYMBOL YFESIS DIGRAMMOS EX DODEKATA" . 118998)
+ ("BYZANTINE MUSICAL SYMBOL YFESIS TRIGRAMMOS OKTO DODEKATA" . 118999)
+ ("BYZANTINE MUSICAL SYMBOL GENIKI DIESIS" . 119000)
+ ("BYZANTINE MUSICAL SYMBOL GENIKI YFESIS" . 119001)
+ ("BYZANTINE MUSICAL SYMBOL DIASTOLI APLI MIKRI" . 119002)
+ ("BYZANTINE MUSICAL SYMBOL DIASTOLI APLI MEGALI" . 119003)
+ ("BYZANTINE MUSICAL SYMBOL DIASTOLI DIPLI" . 119004)
+ ("BYZANTINE MUSICAL SYMBOL DIASTOLI THESEOS" . 119005)
+ ("BYZANTINE MUSICAL SYMBOL SIMANSIS THESEOS" . 119006)
+ ("BYZANTINE MUSICAL SYMBOL SIMANSIS THESEOS DISIMOU" . 119007)
+ ("BYZANTINE MUSICAL SYMBOL SIMANSIS THESEOS TRISIMOU" . 119008)
+ ("BYZANTINE MUSICAL SYMBOL SIMANSIS THESEOS TETRASIMOU" . 119009)
+ ("BYZANTINE MUSICAL SYMBOL SIMANSIS ARSEOS" . 119010)
+ ("BYZANTINE MUSICAL SYMBOL SIMANSIS ARSEOS DISIMOU" . 119011)
+ ("BYZANTINE MUSICAL SYMBOL SIMANSIS ARSEOS TRISIMOU" . 119012)
+ ("BYZANTINE MUSICAL SYMBOL SIMANSIS ARSEOS TETRASIMOU" . 119013)
+ ("BYZANTINE MUSICAL SYMBOL DIGRAMMA GG" . 119014)
+ ("BYZANTINE MUSICAL SYMBOL DIFTOGGOS OU" . 119015)
+ ("BYZANTINE MUSICAL SYMBOL STIGMA" . 119016)
+ ("BYZANTINE MUSICAL SYMBOL ARKTIKO PA" . 119017)
+ ("BYZANTINE MUSICAL SYMBOL ARKTIKO VOU" . 119018)
+ ("BYZANTINE MUSICAL SYMBOL ARKTIKO GA" . 119019)
+ ("BYZANTINE MUSICAL SYMBOL ARKTIKO DI" . 119020)
+ ("BYZANTINE MUSICAL SYMBOL ARKTIKO KE" . 119021)
+ ("BYZANTINE MUSICAL SYMBOL ARKTIKO ZO" . 119022)
+ ("BYZANTINE MUSICAL SYMBOL ARKTIKO NI" . 119023)
+ ("BYZANTINE MUSICAL SYMBOL KENTIMATA NEO MESO" . 119024)
+ ("BYZANTINE MUSICAL SYMBOL KENTIMA NEO MESO" . 119025)
+ ("BYZANTINE MUSICAL SYMBOL KENTIMATA NEO KATO" . 119026)
+ ("BYZANTINE MUSICAL SYMBOL KENTIMA NEO KATO" . 119027)
+ ("BYZANTINE MUSICAL SYMBOL KLASMA KATO" . 119028)
+ ("BYZANTINE MUSICAL SYMBOL GORGON NEO KATO" . 119029)
+ ("MUSICAL SYMBOL SINGLE BARLINE" . 119040)
+ ("MUSICAL SYMBOL DOUBLE BARLINE" . 119041)
+ ("MUSICAL SYMBOL FINAL BARLINE" . 119042)
+ ("MUSICAL SYMBOL REVERSE FINAL BARLINE" . 119043)
+ ("MUSICAL SYMBOL DASHED BARLINE" . 119044)
+ ("MUSICAL SYMBOL SHORT BARLINE" . 119045)
+ ("MUSICAL SYMBOL LEFT REPEAT SIGN" . 119046)
+ ("MUSICAL SYMBOL RIGHT REPEAT SIGN" . 119047)
+ ("MUSICAL SYMBOL REPEAT DOTS" . 119048)
+ ("MUSICAL SYMBOL DAL SEGNO" . 119049)
+ ("MUSICAL SYMBOL DA CAPO" . 119050)
+ ("MUSICAL SYMBOL SEGNO" . 119051)
+ ("MUSICAL SYMBOL CODA" . 119052)
+ ("MUSICAL SYMBOL REPEATED FIGURE-1" . 119053)
+ ("MUSICAL SYMBOL REPEATED FIGURE-2" . 119054)
+ ("MUSICAL SYMBOL REPEATED FIGURE-3" . 119055)
+ ("MUSICAL SYMBOL FERMATA" . 119056)
+ ("MUSICAL SYMBOL FERMATA BELOW" . 119057)
+ ("MUSICAL SYMBOL BREATH MARK" . 119058)
+ ("MUSICAL SYMBOL CAESURA" . 119059)
+ ("MUSICAL SYMBOL BRACE" . 119060)
+ ("MUSICAL SYMBOL BRACKET" . 119061)
+ ("MUSICAL SYMBOL ONE-LINE STAFF" . 119062)
+ ("MUSICAL SYMBOL TWO-LINE STAFF" . 119063)
+ ("MUSICAL SYMBOL THREE-LINE STAFF" . 119064)
+ ("MUSICAL SYMBOL FOUR-LINE STAFF" . 119065)
+ ("MUSICAL SYMBOL FIVE-LINE STAFF" . 119066)
+ ("MUSICAL SYMBOL SIX-LINE STAFF" . 119067)
+ ("MUSICAL SYMBOL SIX-STRING FRETBOARD" . 119068)
+ ("MUSICAL SYMBOL FOUR-STRING FRETBOARD" . 119069)
+ ("MUSICAL SYMBOL G CLEF" . 119070)
+ ("MUSICAL SYMBOL G CLEF OTTAVA ALTA" . 119071)
+ ("MUSICAL SYMBOL G CLEF OTTAVA BASSA" . 119072)
+ ("MUSICAL SYMBOL C CLEF" . 119073)
+ ("MUSICAL SYMBOL F CLEF" . 119074)
+ ("MUSICAL SYMBOL F CLEF OTTAVA ALTA" . 119075)
+ ("MUSICAL SYMBOL F CLEF OTTAVA BASSA" . 119076)
+ ("MUSICAL SYMBOL DRUM CLEF-1" . 119077)
+ ("MUSICAL SYMBOL DRUM CLEF-2" . 119078)
+ ("MUSICAL SYMBOL DOUBLE SHARP" . 119082)
+ ("MUSICAL SYMBOL DOUBLE FLAT" . 119083)
+ ("MUSICAL SYMBOL FLAT UP" . 119084)
+ ("MUSICAL SYMBOL FLAT DOWN" . 119085)
+ ("MUSICAL SYMBOL NATURAL UP" . 119086)
+ ("MUSICAL SYMBOL NATURAL DOWN" . 119087)
+ ("MUSICAL SYMBOL SHARP UP" . 119088)
+ ("MUSICAL SYMBOL SHARP DOWN" . 119089)
+ ("MUSICAL SYMBOL QUARTER TONE SHARP" . 119090)
+ ("MUSICAL SYMBOL QUARTER TONE FLAT" . 119091)
+ ("MUSICAL SYMBOL COMMON TIME" . 119092)
+ ("MUSICAL SYMBOL CUT TIME" . 119093)
+ ("MUSICAL SYMBOL OTTAVA ALTA" . 119094)
+ ("MUSICAL SYMBOL OTTAVA BASSA" . 119095)
+ ("MUSICAL SYMBOL QUINDICESIMA ALTA" . 119096)
+ ("MUSICAL SYMBOL QUINDICESIMA BASSA" . 119097)
+ ("MUSICAL SYMBOL MULTI REST" . 119098)
+ ("MUSICAL SYMBOL WHOLE REST" . 119099)
+ ("MUSICAL SYMBOL HALF REST" . 119100)
+ ("MUSICAL SYMBOL QUARTER REST" . 119101)
+ ("MUSICAL SYMBOL EIGHTH REST" . 119102)
+ ("MUSICAL SYMBOL SIXTEENTH REST" . 119103)
+ ("MUSICAL SYMBOL THIRTY-SECOND REST" . 119104)
+ ("MUSICAL SYMBOL SIXTY-FOURTH REST" . 119105)
+ ("MUSICAL SYMBOL ONE HUNDRED TWENTY-EIGHTH REST" . 119106)
+ ("MUSICAL SYMBOL X NOTEHEAD" . 119107)
+ ("MUSICAL SYMBOL PLUS NOTEHEAD" . 119108)
+ ("MUSICAL SYMBOL CIRCLE X NOTEHEAD" . 119109)
+ ("MUSICAL SYMBOL SQUARE NOTEHEAD WHITE" . 119110)
+ ("MUSICAL SYMBOL SQUARE NOTEHEAD BLACK" . 119111)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD UP WHITE" . 119112)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD UP BLACK" . 119113)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD LEFT WHITE" . 119114)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD LEFT BLACK" . 119115)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD RIGHT WHITE" . 119116)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD RIGHT BLACK" . 119117)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD DOWN WHITE" . 119118)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD DOWN BLACK" . 119119)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD UP RIGHT WHITE" . 119120)
+ ("MUSICAL SYMBOL TRIANGLE NOTEHEAD UP RIGHT BLACK" . 119121)
+ ("MUSICAL SYMBOL MOON NOTEHEAD WHITE" . 119122)
+ ("MUSICAL SYMBOL MOON NOTEHEAD BLACK" . 119123)
+ ("MUSICAL SYMBOL TRIANGLE-ROUND NOTEHEAD DOWN WHITE" . 119124)
+ ("MUSICAL SYMBOL TRIANGLE-ROUND NOTEHEAD DOWN BLACK" . 119125)
+ ("MUSICAL SYMBOL PARENTHESIS NOTEHEAD" . 119126)
+ ("MUSICAL SYMBOL VOID NOTEHEAD" . 119127)
+ ("MUSICAL SYMBOL NOTEHEAD BLACK" . 119128)
+ ("MUSICAL SYMBOL NULL NOTEHEAD" . 119129)
+ ("MUSICAL SYMBOL CLUSTER NOTEHEAD WHITE" . 119130)
+ ("MUSICAL SYMBOL CLUSTER NOTEHEAD BLACK" . 119131)
+ ("MUSICAL SYMBOL BREVE" . 119132)
+ ("MUSICAL SYMBOL WHOLE NOTE" . 119133)
+ ("MUSICAL SYMBOL HALF NOTE" . 119134)
+ ("MUSICAL SYMBOL QUARTER NOTE" . 119135)
+ ("MUSICAL SYMBOL EIGHTH NOTE" . 119136)
+ ("MUSICAL SYMBOL SIXTEENTH NOTE" . 119137)
+ ("MUSICAL SYMBOL THIRTY-SECOND NOTE" . 119138)
+ ("MUSICAL SYMBOL SIXTY-FOURTH NOTE" . 119139)
+ ("MUSICAL SYMBOL ONE HUNDRED TWENTY-EIGHTH NOTE" . 119140)
+ ("MUSICAL SYMBOL COMBINING STEM" . 119141)
+ ("MUSICAL SYMBOL COMBINING SPRECHGESANG STEM" . 119142)
+ ("MUSICAL SYMBOL COMBINING TREMOLO-1" . 119143)
+ ("MUSICAL SYMBOL COMBINING TREMOLO-2" . 119144)
+ ("MUSICAL SYMBOL COMBINING TREMOLO-3" . 119145)
+ ("MUSICAL SYMBOL FINGERED TREMOLO-1" . 119146)
+ ("MUSICAL SYMBOL FINGERED TREMOLO-2" . 119147)
+ ("MUSICAL SYMBOL FINGERED TREMOLO-3" . 119148)
+ ("MUSICAL SYMBOL COMBINING AUGMENTATION DOT" . 119149)
+ ("MUSICAL SYMBOL COMBINING FLAG-1" . 119150)
+ ("MUSICAL SYMBOL COMBINING FLAG-2" . 119151)
+ ("MUSICAL SYMBOL COMBINING FLAG-3" . 119152)
+ ("MUSICAL SYMBOL COMBINING FLAG-4" . 119153)
+ ("MUSICAL SYMBOL COMBINING FLAG-5" . 119154)
+ ("MUSICAL SYMBOL BEGIN BEAM" . 119155)
+ ("MUSICAL SYMBOL END BEAM" . 119156)
+ ("MUSICAL SYMBOL BEGIN TIE" . 119157)
+ ("MUSICAL SYMBOL END TIE" . 119158)
+ ("MUSICAL SYMBOL BEGIN SLUR" . 119159)
+ ("MUSICAL SYMBOL END SLUR" . 119160)
+ ("MUSICAL SYMBOL BEGIN PHRASE" . 119161)
+ ("MUSICAL SYMBOL END PHRASE" . 119162)
+ ("MUSICAL SYMBOL COMBINING ACCENT" . 119163)
+ ("MUSICAL SYMBOL COMBINING STACCATO" . 119164)
+ ("MUSICAL SYMBOL COMBINING TENUTO" . 119165)
+ ("MUSICAL SYMBOL COMBINING STACCATISSIMO" . 119166)
+ ("MUSICAL SYMBOL COMBINING MARCATO" . 119167)
+ ("MUSICAL SYMBOL COMBINING MARCATO-STACCATO" . 119168)
+ ("MUSICAL SYMBOL COMBINING ACCENT-STACCATO" . 119169)
+ ("MUSICAL SYMBOL COMBINING LOURE" . 119170)
+ ("MUSICAL SYMBOL ARPEGGIATO UP" . 119171)
+ ("MUSICAL SYMBOL ARPEGGIATO DOWN" . 119172)
+ ("MUSICAL SYMBOL COMBINING DOIT" . 119173)
+ ("MUSICAL SYMBOL COMBINING RIP" . 119174)
+ ("MUSICAL SYMBOL COMBINING FLIP" . 119175)
+ ("MUSICAL SYMBOL COMBINING SMEAR" . 119176)
+ ("MUSICAL SYMBOL COMBINING BEND" . 119177)
+ ("MUSICAL SYMBOL COMBINING DOUBLE TONGUE" . 119178)
+ ("MUSICAL SYMBOL COMBINING TRIPLE TONGUE" . 119179)
+ ("MUSICAL SYMBOL RINFORZANDO" . 119180)
+ ("MUSICAL SYMBOL SUBITO" . 119181)
+ ("MUSICAL SYMBOL Z" . 119182)
+ ("MUSICAL SYMBOL PIANO" . 119183)
+ ("MUSICAL SYMBOL MEZZO" . 119184)
+ ("MUSICAL SYMBOL FORTE" . 119185)
+ ("MUSICAL SYMBOL CRESCENDO" . 119186)
+ ("MUSICAL SYMBOL DECRESCENDO" . 119187)
+ ("MUSICAL SYMBOL GRACE NOTE SLASH" . 119188)
+ ("MUSICAL SYMBOL GRACE NOTE NO SLASH" . 119189)
+ ("MUSICAL SYMBOL TR" . 119190)
+ ("MUSICAL SYMBOL TURN" . 119191)
+ ("MUSICAL SYMBOL INVERTED TURN" . 119192)
+ ("MUSICAL SYMBOL TURN SLASH" . 119193)
+ ("MUSICAL SYMBOL TURN UP" . 119194)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-1" . 119195)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-2" . 119196)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-3" . 119197)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-4" . 119198)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-5" . 119199)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-6" . 119200)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-7" . 119201)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-8" . 119202)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-9" . 119203)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-10" . 119204)
+ ("MUSICAL SYMBOL ORNAMENT STROKE-11" . 119205)
+ ("MUSICAL SYMBOL HAUPTSTIMME" . 119206)
+ ("MUSICAL SYMBOL NEBENSTIMME" . 119207)
+ ("MUSICAL SYMBOL END OF STIMME" . 119208)
+ ("MUSICAL SYMBOL DEGREE SLASH" . 119209)
+ ("MUSICAL SYMBOL COMBINING DOWN BOW" . 119210)
+ ("MUSICAL SYMBOL COMBINING UP BOW" . 119211)
+ ("MUSICAL SYMBOL COMBINING HARMONIC" . 119212)
+ ("MUSICAL SYMBOL COMBINING SNAP PIZZICATO" . 119213)
+ ("MUSICAL SYMBOL PEDAL MARK" . 119214)
+ ("MUSICAL SYMBOL PEDAL UP MARK" . 119215)
+ ("MUSICAL SYMBOL HALF PEDAL MARK" . 119216)
+ ("MUSICAL SYMBOL GLISSANDO UP" . 119217)
+ ("MUSICAL SYMBOL GLISSANDO DOWN" . 119218)
+ ("MUSICAL SYMBOL WITH FINGERNAILS" . 119219)
+ ("MUSICAL SYMBOL DAMP" . 119220)
+ ("MUSICAL SYMBOL DAMP ALL" . 119221)
+ ("MUSICAL SYMBOL MAXIMA" . 119222)
+ ("MUSICAL SYMBOL LONGA" . 119223)
+ ("MUSICAL SYMBOL BREVIS" . 119224)
+ ("MUSICAL SYMBOL SEMIBREVIS WHITE" . 119225)
+ ("MUSICAL SYMBOL SEMIBREVIS BLACK" . 119226)
+ ("MUSICAL SYMBOL MINIMA" . 119227)
+ ("MUSICAL SYMBOL MINIMA BLACK" . 119228)
+ ("MUSICAL SYMBOL SEMIMINIMA WHITE" . 119229)
+ ("MUSICAL SYMBOL SEMIMINIMA BLACK" . 119230)
+ ("MUSICAL SYMBOL FUSA WHITE" . 119231)
+ ("MUSICAL SYMBOL FUSA BLACK" . 119232)
+ ("MUSICAL SYMBOL LONGA PERFECTA REST" . 119233)
+ ("MUSICAL SYMBOL LONGA IMPERFECTA REST" . 119234)
+ ("MUSICAL SYMBOL BREVIS REST" . 119235)
+ ("MUSICAL SYMBOL SEMIBREVIS REST" . 119236)
+ ("MUSICAL SYMBOL MINIMA REST" . 119237)
+ ("MUSICAL SYMBOL SEMIMINIMA REST" . 119238)
+ ("MUSICAL SYMBOL TEMPUS PERFECTUM CUM PROLATIONE PERFECTA" . 119239)
+ ("MUSICAL SYMBOL TEMPUS PERFECTUM CUM PROLATIONE IMPERFECTA" . 119240)
+ ("MUSICAL SYMBOL TEMPUS PERFECTUM CUM PROLATIONE PERFECTA DIMINUTION-1" . 119241)
+ ("MUSICAL SYMBOL TEMPUS IMPERFECTUM CUM PROLATIONE PERFECTA" . 119242)
+ ("MUSICAL SYMBOL TEMPUS IMPERFECTUM CUM PROLATIONE IMPERFECTA" . 119243)
+ ("MUSICAL SYMBOL TEMPUS IMPERFECTUM CUM PROLATIONE IMPERFECTA DIMINUTION-1" . 119244)
+ ("MUSICAL SYMBOL TEMPUS IMPERFECTUM CUM PROLATIONE IMPERFECTA DIMINUTION-2" . 119245)
+ ("MUSICAL SYMBOL TEMPUS IMPERFECTUM CUM PROLATIONE IMPERFECTA DIMINUTION-3" . 119246)
+ ("MUSICAL SYMBOL CROIX" . 119247)
+ ("MUSICAL SYMBOL GREGORIAN C CLEF" . 119248)
+ ("MUSICAL SYMBOL GREGORIAN F CLEF" . 119249)
+ ("MUSICAL SYMBOL SQUARE B" . 119250)
+ ("MUSICAL SYMBOL VIRGA" . 119251)
+ ("MUSICAL SYMBOL PODATUS" . 119252)
+ ("MUSICAL SYMBOL CLIVIS" . 119253)
+ ("MUSICAL SYMBOL SCANDICUS" . 119254)
+ ("MUSICAL SYMBOL CLIMACUS" . 119255)
+ ("MUSICAL SYMBOL TORCULUS" . 119256)
+ ("MUSICAL SYMBOL PORRECTUS" . 119257)
+ ("MUSICAL SYMBOL PORRECTUS FLEXUS" . 119258)
+ ("MUSICAL SYMBOL SCANDICUS FLEXUS" . 119259)
+ ("MUSICAL SYMBOL TORCULUS RESUPINUS" . 119260)
+ ("MUSICAL SYMBOL PES SUBPUNCTIS" . 119261)
+ ("MATHEMATICAL BOLD CAPITAL A" . 119808)
+ ("MATHEMATICAL BOLD CAPITAL B" . 119809)
+ ("MATHEMATICAL BOLD CAPITAL C" . 119810)
+ ("MATHEMATICAL BOLD CAPITAL D" . 119811)
+ ("MATHEMATICAL BOLD CAPITAL E" . 119812)
+ ("MATHEMATICAL BOLD CAPITAL F" . 119813)
+ ("MATHEMATICAL BOLD CAPITAL G" . 119814)
+ ("MATHEMATICAL BOLD CAPITAL H" . 119815)
+ ("MATHEMATICAL BOLD CAPITAL I" . 119816)
+ ("MATHEMATICAL BOLD CAPITAL J" . 119817)
+ ("MATHEMATICAL BOLD CAPITAL K" . 119818)
+ ("MATHEMATICAL BOLD CAPITAL L" . 119819)
+ ("MATHEMATICAL BOLD CAPITAL M" . 119820)
+ ("MATHEMATICAL BOLD CAPITAL N" . 119821)
+ ("MATHEMATICAL BOLD CAPITAL O" . 119822)
+ ("MATHEMATICAL BOLD CAPITAL P" . 119823)
+ ("MATHEMATICAL BOLD CAPITAL Q" . 119824)
+ ("MATHEMATICAL BOLD CAPITAL R" . 119825)
+ ("MATHEMATICAL BOLD CAPITAL S" . 119826)
+ ("MATHEMATICAL BOLD CAPITAL T" . 119827)
+ ("MATHEMATICAL BOLD CAPITAL U" . 119828)
+ ("MATHEMATICAL BOLD CAPITAL V" . 119829)
+ ("MATHEMATICAL BOLD CAPITAL W" . 119830)
+ ("MATHEMATICAL BOLD CAPITAL X" . 119831)
+ ("MATHEMATICAL BOLD CAPITAL Y" . 119832)
+ ("MATHEMATICAL BOLD CAPITAL Z" . 119833)
+ ("MATHEMATICAL BOLD SMALL A" . 119834)
+ ("MATHEMATICAL BOLD SMALL B" . 119835)
+ ("MATHEMATICAL BOLD SMALL C" . 119836)
+ ("MATHEMATICAL BOLD SMALL D" . 119837)
+ ("MATHEMATICAL BOLD SMALL E" . 119838)
+ ("MATHEMATICAL BOLD SMALL F" . 119839)
+ ("MATHEMATICAL BOLD SMALL G" . 119840)
+ ("MATHEMATICAL BOLD SMALL H" . 119841)
+ ("MATHEMATICAL BOLD SMALL I" . 119842)
+ ("MATHEMATICAL BOLD SMALL J" . 119843)
+ ("MATHEMATICAL BOLD SMALL K" . 119844)
+ ("MATHEMATICAL BOLD SMALL L" . 119845)
+ ("MATHEMATICAL BOLD SMALL M" . 119846)
+ ("MATHEMATICAL BOLD SMALL N" . 119847)
+ ("MATHEMATICAL BOLD SMALL O" . 119848)
+ ("MATHEMATICAL BOLD SMALL P" . 119849)
+ ("MATHEMATICAL BOLD SMALL Q" . 119850)
+ ("MATHEMATICAL BOLD SMALL R" . 119851)
+ ("MATHEMATICAL BOLD SMALL S" . 119852)
+ ("MATHEMATICAL BOLD SMALL T" . 119853)
+ ("MATHEMATICAL BOLD SMALL U" . 119854)
+ ("MATHEMATICAL BOLD SMALL V" . 119855)
+ ("MATHEMATICAL BOLD SMALL W" . 119856)
+ ("MATHEMATICAL BOLD SMALL X" . 119857)
+ ("MATHEMATICAL BOLD SMALL Y" . 119858)
+ ("MATHEMATICAL BOLD SMALL Z" . 119859)
+ ("MATHEMATICAL ITALIC CAPITAL A" . 119860)
+ ("MATHEMATICAL ITALIC CAPITAL B" . 119861)
+ ("MATHEMATICAL ITALIC CAPITAL C" . 119862)
+ ("MATHEMATICAL ITALIC CAPITAL D" . 119863)
+ ("MATHEMATICAL ITALIC CAPITAL E" . 119864)
+ ("MATHEMATICAL ITALIC CAPITAL F" . 119865)
+ ("MATHEMATICAL ITALIC CAPITAL G" . 119866)
+ ("MATHEMATICAL ITALIC CAPITAL H" . 119867)
+ ("MATHEMATICAL ITALIC CAPITAL I" . 119868)
+ ("MATHEMATICAL ITALIC CAPITAL J" . 119869)
+ ("MATHEMATICAL ITALIC CAPITAL K" . 119870)
+ ("MATHEMATICAL ITALIC CAPITAL L" . 119871)
+ ("MATHEMATICAL ITALIC CAPITAL M" . 119872)
+ ("MATHEMATICAL ITALIC CAPITAL N" . 119873)
+ ("MATHEMATICAL ITALIC CAPITAL O" . 119874)
+ ("MATHEMATICAL ITALIC CAPITAL P" . 119875)
+ ("MATHEMATICAL ITALIC CAPITAL Q" . 119876)
+ ("MATHEMATICAL ITALIC CAPITAL R" . 119877)
+ ("MATHEMATICAL ITALIC CAPITAL S" . 119878)
+ ("MATHEMATICAL ITALIC CAPITAL T" . 119879)
+ ("MATHEMATICAL ITALIC CAPITAL U" . 119880)
+ ("MATHEMATICAL ITALIC CAPITAL V" . 119881)
+ ("MATHEMATICAL ITALIC CAPITAL W" . 119882)
+ ("MATHEMATICAL ITALIC CAPITAL X" . 119883)
+ ("MATHEMATICAL ITALIC CAPITAL Y" . 119884)
+ ("MATHEMATICAL ITALIC CAPITAL Z" . 119885)
+ ("MATHEMATICAL ITALIC SMALL A" . 119886)
+ ("MATHEMATICAL ITALIC SMALL B" . 119887)
+ ("MATHEMATICAL ITALIC SMALL C" . 119888)
+ ("MATHEMATICAL ITALIC SMALL D" . 119889)
+ ("MATHEMATICAL ITALIC SMALL E" . 119890)
+ ("MATHEMATICAL ITALIC SMALL F" . 119891)
+ ("MATHEMATICAL ITALIC SMALL G" . 119892)
+ ("MATHEMATICAL ITALIC SMALL I" . 119894)
+ ("MATHEMATICAL ITALIC SMALL J" . 119895)
+ ("MATHEMATICAL ITALIC SMALL K" . 119896)
+ ("MATHEMATICAL ITALIC SMALL L" . 119897)
+ ("MATHEMATICAL ITALIC SMALL M" . 119898)
+ ("MATHEMATICAL ITALIC SMALL N" . 119899)
+ ("MATHEMATICAL ITALIC SMALL O" . 119900)
+ ("MATHEMATICAL ITALIC SMALL P" . 119901)
+ ("MATHEMATICAL ITALIC SMALL Q" . 119902)
+ ("MATHEMATICAL ITALIC SMALL R" . 119903)
+ ("MATHEMATICAL ITALIC SMALL S" . 119904)
+ ("MATHEMATICAL ITALIC SMALL T" . 119905)
+ ("MATHEMATICAL ITALIC SMALL U" . 119906)
+ ("MATHEMATICAL ITALIC SMALL V" . 119907)
+ ("MATHEMATICAL ITALIC SMALL W" . 119908)
+ ("MATHEMATICAL ITALIC SMALL X" . 119909)
+ ("MATHEMATICAL ITALIC SMALL Y" . 119910)
+ ("MATHEMATICAL ITALIC SMALL Z" . 119911)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL A" . 119912)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL B" . 119913)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL C" . 119914)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL D" . 119915)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL E" . 119916)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL F" . 119917)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL G" . 119918)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL H" . 119919)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL I" . 119920)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL J" . 119921)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL K" . 119922)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL L" . 119923)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL M" . 119924)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL N" . 119925)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL O" . 119926)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL P" . 119927)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL Q" . 119928)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL R" . 119929)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL S" . 119930)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL T" . 119931)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL U" . 119932)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL V" . 119933)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL W" . 119934)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL X" . 119935)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL Y" . 119936)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL Z" . 119937)
+ ("MATHEMATICAL BOLD ITALIC SMALL A" . 119938)
+ ("MATHEMATICAL BOLD ITALIC SMALL B" . 119939)
+ ("MATHEMATICAL BOLD ITALIC SMALL C" . 119940)
+ ("MATHEMATICAL BOLD ITALIC SMALL D" . 119941)
+ ("MATHEMATICAL BOLD ITALIC SMALL E" . 119942)
+ ("MATHEMATICAL BOLD ITALIC SMALL F" . 119943)
+ ("MATHEMATICAL BOLD ITALIC SMALL G" . 119944)
+ ("MATHEMATICAL BOLD ITALIC SMALL H" . 119945)
+ ("MATHEMATICAL BOLD ITALIC SMALL I" . 119946)
+ ("MATHEMATICAL BOLD ITALIC SMALL J" . 119947)
+ ("MATHEMATICAL BOLD ITALIC SMALL K" . 119948)
+ ("MATHEMATICAL BOLD ITALIC SMALL L" . 119949)
+ ("MATHEMATICAL BOLD ITALIC SMALL M" . 119950)
+ ("MATHEMATICAL BOLD ITALIC SMALL N" . 119951)
+ ("MATHEMATICAL BOLD ITALIC SMALL O" . 119952)
+ ("MATHEMATICAL BOLD ITALIC SMALL P" . 119953)
+ ("MATHEMATICAL BOLD ITALIC SMALL Q" . 119954)
+ ("MATHEMATICAL BOLD ITALIC SMALL R" . 119955)
+ ("MATHEMATICAL BOLD ITALIC SMALL S" . 119956)
+ ("MATHEMATICAL BOLD ITALIC SMALL T" . 119957)
+ ("MATHEMATICAL BOLD ITALIC SMALL U" . 119958)
+ ("MATHEMATICAL BOLD ITALIC SMALL V" . 119959)
+ ("MATHEMATICAL BOLD ITALIC SMALL W" . 119960)
+ ("MATHEMATICAL BOLD ITALIC SMALL X" . 119961)
+ ("MATHEMATICAL BOLD ITALIC SMALL Y" . 119962)
+ ("MATHEMATICAL BOLD ITALIC SMALL Z" . 119963)
+ ("MATHEMATICAL SCRIPT CAPITAL A" . 119964)
+ ("MATHEMATICAL SCRIPT CAPITAL C" . 119966)
+ ("MATHEMATICAL SCRIPT CAPITAL D" . 119967)
+ ("MATHEMATICAL SCRIPT CAPITAL G" . 119970)
+ ("MATHEMATICAL SCRIPT CAPITAL J" . 119973)
+ ("MATHEMATICAL SCRIPT CAPITAL K" . 119974)
+ ("MATHEMATICAL SCRIPT CAPITAL N" . 119977)
+ ("MATHEMATICAL SCRIPT CAPITAL O" . 119978)
+ ("MATHEMATICAL SCRIPT CAPITAL P" . 119979)
+ ("MATHEMATICAL SCRIPT CAPITAL Q" . 119980)
+ ("MATHEMATICAL SCRIPT CAPITAL S" . 119982)
+ ("MATHEMATICAL SCRIPT CAPITAL T" . 119983)
+ ("MATHEMATICAL SCRIPT CAPITAL U" . 119984)
+ ("MATHEMATICAL SCRIPT CAPITAL V" . 119985)
+ ("MATHEMATICAL SCRIPT CAPITAL W" . 119986)
+ ("MATHEMATICAL SCRIPT CAPITAL X" . 119987)
+ ("MATHEMATICAL SCRIPT CAPITAL Y" . 119988)
+ ("MATHEMATICAL SCRIPT CAPITAL Z" . 119989)
+ ("MATHEMATICAL SCRIPT SMALL A" . 119990)
+ ("MATHEMATICAL SCRIPT SMALL B" . 119991)
+ ("MATHEMATICAL SCRIPT SMALL C" . 119992)
+ ("MATHEMATICAL SCRIPT SMALL D" . 119993)
+ ("MATHEMATICAL SCRIPT SMALL F" . 119995)
+ ("MATHEMATICAL SCRIPT SMALL H" . 119997)
+ ("MATHEMATICAL SCRIPT SMALL I" . 119998)
+ ("MATHEMATICAL SCRIPT SMALL J" . 119999)
+ ("MATHEMATICAL SCRIPT SMALL K" . 120000)
+ ("MATHEMATICAL SCRIPT SMALL M" . 120002)
+ ("MATHEMATICAL SCRIPT SMALL N" . 120003)
+ ("MATHEMATICAL SCRIPT SMALL P" . 120005)
+ ("MATHEMATICAL SCRIPT SMALL Q" . 120006)
+ ("MATHEMATICAL SCRIPT SMALL R" . 120007)
+ ("MATHEMATICAL SCRIPT SMALL S" . 120008)
+ ("MATHEMATICAL SCRIPT SMALL T" . 120009)
+ ("MATHEMATICAL SCRIPT SMALL U" . 120010)
+ ("MATHEMATICAL SCRIPT SMALL V" . 120011)
+ ("MATHEMATICAL SCRIPT SMALL W" . 120012)
+ ("MATHEMATICAL SCRIPT SMALL X" . 120013)
+ ("MATHEMATICAL SCRIPT SMALL Y" . 120014)
+ ("MATHEMATICAL SCRIPT SMALL Z" . 120015)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL A" . 120016)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL B" . 120017)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL C" . 120018)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL D" . 120019)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL E" . 120020)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL F" . 120021)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL G" . 120022)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL H" . 120023)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL I" . 120024)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL J" . 120025)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL K" . 120026)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL L" . 120027)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL M" . 120028)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL N" . 120029)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL O" . 120030)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL P" . 120031)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL Q" . 120032)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL R" . 120033)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL S" . 120034)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL T" . 120035)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL U" . 120036)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL V" . 120037)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL W" . 120038)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL X" . 120039)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL Y" . 120040)
+ ("MATHEMATICAL BOLD SCRIPT CAPITAL Z" . 120041)
+ ("MATHEMATICAL BOLD SCRIPT SMALL A" . 120042)
+ ("MATHEMATICAL BOLD SCRIPT SMALL B" . 120043)
+ ("MATHEMATICAL BOLD SCRIPT SMALL C" . 120044)
+ ("MATHEMATICAL BOLD SCRIPT SMALL D" . 120045)
+ ("MATHEMATICAL BOLD SCRIPT SMALL E" . 120046)
+ ("MATHEMATICAL BOLD SCRIPT SMALL F" . 120047)
+ ("MATHEMATICAL BOLD SCRIPT SMALL G" . 120048)
+ ("MATHEMATICAL BOLD SCRIPT SMALL H" . 120049)
+ ("MATHEMATICAL BOLD SCRIPT SMALL I" . 120050)
+ ("MATHEMATICAL BOLD SCRIPT SMALL J" . 120051)
+ ("MATHEMATICAL BOLD SCRIPT SMALL K" . 120052)
+ ("MATHEMATICAL BOLD SCRIPT SMALL L" . 120053)
+ ("MATHEMATICAL BOLD SCRIPT SMALL M" . 120054)
+ ("MATHEMATICAL BOLD SCRIPT SMALL N" . 120055)
+ ("MATHEMATICAL BOLD SCRIPT SMALL O" . 120056)
+ ("MATHEMATICAL BOLD SCRIPT SMALL P" . 120057)
+ ("MATHEMATICAL BOLD SCRIPT SMALL Q" . 120058)
+ ("MATHEMATICAL BOLD SCRIPT SMALL R" . 120059)
+ ("MATHEMATICAL BOLD SCRIPT SMALL S" . 120060)
+ ("MATHEMATICAL BOLD SCRIPT SMALL T" . 120061)
+ ("MATHEMATICAL BOLD SCRIPT SMALL U" . 120062)
+ ("MATHEMATICAL BOLD SCRIPT SMALL V" . 120063)
+ ("MATHEMATICAL BOLD SCRIPT SMALL W" . 120064)
+ ("MATHEMATICAL BOLD SCRIPT SMALL X" . 120065)
+ ("MATHEMATICAL BOLD SCRIPT SMALL Y" . 120066)
+ ("MATHEMATICAL BOLD SCRIPT SMALL Z" . 120067)
+ ("MATHEMATICAL FRAKTUR CAPITAL A" . 120068)
+ ("MATHEMATICAL FRAKTUR CAPITAL B" . 120069)
+ ("MATHEMATICAL FRAKTUR CAPITAL D" . 120071)
+ ("MATHEMATICAL FRAKTUR CAPITAL E" . 120072)
+ ("MATHEMATICAL FRAKTUR CAPITAL F" . 120073)
+ ("MATHEMATICAL FRAKTUR CAPITAL G" . 120074)
+ ("MATHEMATICAL FRAKTUR CAPITAL J" . 120077)
+ ("MATHEMATICAL FRAKTUR CAPITAL K" . 120078)
+ ("MATHEMATICAL FRAKTUR CAPITAL L" . 120079)
+ ("MATHEMATICAL FRAKTUR CAPITAL M" . 120080)
+ ("MATHEMATICAL FRAKTUR CAPITAL N" . 120081)
+ ("MATHEMATICAL FRAKTUR CAPITAL O" . 120082)
+ ("MATHEMATICAL FRAKTUR CAPITAL P" . 120083)
+ ("MATHEMATICAL FRAKTUR CAPITAL Q" . 120084)
+ ("MATHEMATICAL FRAKTUR CAPITAL S" . 120086)
+ ("MATHEMATICAL FRAKTUR CAPITAL T" . 120087)
+ ("MATHEMATICAL FRAKTUR CAPITAL U" . 120088)
+ ("MATHEMATICAL FRAKTUR CAPITAL V" . 120089)
+ ("MATHEMATICAL FRAKTUR CAPITAL W" . 120090)
+ ("MATHEMATICAL FRAKTUR CAPITAL X" . 120091)
+ ("MATHEMATICAL FRAKTUR CAPITAL Y" . 120092)
+ ("MATHEMATICAL FRAKTUR SMALL A" . 120094)
+ ("MATHEMATICAL FRAKTUR SMALL B" . 120095)
+ ("MATHEMATICAL FRAKTUR SMALL C" . 120096)
+ ("MATHEMATICAL FRAKTUR SMALL D" . 120097)
+ ("MATHEMATICAL FRAKTUR SMALL E" . 120098)
+ ("MATHEMATICAL FRAKTUR SMALL F" . 120099)
+ ("MATHEMATICAL FRAKTUR SMALL G" . 120100)
+ ("MATHEMATICAL FRAKTUR SMALL H" . 120101)
+ ("MATHEMATICAL FRAKTUR SMALL I" . 120102)
+ ("MATHEMATICAL FRAKTUR SMALL J" . 120103)
+ ("MATHEMATICAL FRAKTUR SMALL K" . 120104)
+ ("MATHEMATICAL FRAKTUR SMALL L" . 120105)
+ ("MATHEMATICAL FRAKTUR SMALL M" . 120106)
+ ("MATHEMATICAL FRAKTUR SMALL N" . 120107)
+ ("MATHEMATICAL FRAKTUR SMALL O" . 120108)
+ ("MATHEMATICAL FRAKTUR SMALL P" . 120109)
+ ("MATHEMATICAL FRAKTUR SMALL Q" . 120110)
+ ("MATHEMATICAL FRAKTUR SMALL R" . 120111)
+ ("MATHEMATICAL FRAKTUR SMALL S" . 120112)
+ ("MATHEMATICAL FRAKTUR SMALL T" . 120113)
+ ("MATHEMATICAL FRAKTUR SMALL U" . 120114)
+ ("MATHEMATICAL FRAKTUR SMALL V" . 120115)
+ ("MATHEMATICAL FRAKTUR SMALL W" . 120116)
+ ("MATHEMATICAL FRAKTUR SMALL X" . 120117)
+ ("MATHEMATICAL FRAKTUR SMALL Y" . 120118)
+ ("MATHEMATICAL FRAKTUR SMALL Z" . 120119)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL A" . 120120)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL B" . 120121)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL D" . 120123)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL E" . 120124)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL F" . 120125)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL G" . 120126)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL I" . 120128)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL J" . 120129)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL K" . 120130)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL L" . 120131)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL M" . 120132)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL O" . 120134)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL S" . 120138)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL T" . 120139)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL U" . 120140)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL V" . 120141)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL W" . 120142)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL X" . 120143)
+ ("MATHEMATICAL DOUBLE-STRUCK CAPITAL Y" . 120144)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL A" . 120146)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL B" . 120147)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL C" . 120148)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL D" . 120149)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL E" . 120150)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL F" . 120151)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL G" . 120152)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL H" . 120153)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL I" . 120154)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL J" . 120155)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL K" . 120156)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL L" . 120157)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL M" . 120158)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL N" . 120159)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL O" . 120160)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL P" . 120161)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL Q" . 120162)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL R" . 120163)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL S" . 120164)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL T" . 120165)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL U" . 120166)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL V" . 120167)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL W" . 120168)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL X" . 120169)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL Y" . 120170)
+ ("MATHEMATICAL DOUBLE-STRUCK SMALL Z" . 120171)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL A" . 120172)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL B" . 120173)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL C" . 120174)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL D" . 120175)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL E" . 120176)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL F" . 120177)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL G" . 120178)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL H" . 120179)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL I" . 120180)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL J" . 120181)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL K" . 120182)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL L" . 120183)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL M" . 120184)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL N" . 120185)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL O" . 120186)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL P" . 120187)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL Q" . 120188)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL R" . 120189)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL S" . 120190)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL T" . 120191)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL U" . 120192)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL V" . 120193)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL W" . 120194)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL X" . 120195)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL Y" . 120196)
+ ("MATHEMATICAL BOLD FRAKTUR CAPITAL Z" . 120197)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL A" . 120198)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL B" . 120199)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL C" . 120200)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL D" . 120201)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL E" . 120202)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL F" . 120203)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL G" . 120204)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL H" . 120205)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL I" . 120206)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL J" . 120207)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL K" . 120208)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL L" . 120209)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL M" . 120210)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL N" . 120211)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL O" . 120212)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL P" . 120213)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL Q" . 120214)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL R" . 120215)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL S" . 120216)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL T" . 120217)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL U" . 120218)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL V" . 120219)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL W" . 120220)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL X" . 120221)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL Y" . 120222)
+ ("MATHEMATICAL BOLD FRAKTUR SMALL Z" . 120223)
+ ("MATHEMATICAL SANS-SERIF CAPITAL A" . 120224)
+ ("MATHEMATICAL SANS-SERIF CAPITAL B" . 120225)
+ ("MATHEMATICAL SANS-SERIF CAPITAL C" . 120226)
+ ("MATHEMATICAL SANS-SERIF CAPITAL D" . 120227)
+ ("MATHEMATICAL SANS-SERIF CAPITAL E" . 120228)
+ ("MATHEMATICAL SANS-SERIF CAPITAL F" . 120229)
+ ("MATHEMATICAL SANS-SERIF CAPITAL G" . 120230)
+ ("MATHEMATICAL SANS-SERIF CAPITAL H" . 120231)
+ ("MATHEMATICAL SANS-SERIF CAPITAL I" . 120232)
+ ("MATHEMATICAL SANS-SERIF CAPITAL J" . 120233)
+ ("MATHEMATICAL SANS-SERIF CAPITAL K" . 120234)
+ ("MATHEMATICAL SANS-SERIF CAPITAL L" . 120235)
+ ("MATHEMATICAL SANS-SERIF CAPITAL M" . 120236)
+ ("MATHEMATICAL SANS-SERIF CAPITAL N" . 120237)
+ ("MATHEMATICAL SANS-SERIF CAPITAL O" . 120238)
+ ("MATHEMATICAL SANS-SERIF CAPITAL P" . 120239)
+ ("MATHEMATICAL SANS-SERIF CAPITAL Q" . 120240)
+ ("MATHEMATICAL SANS-SERIF CAPITAL R" . 120241)
+ ("MATHEMATICAL SANS-SERIF CAPITAL S" . 120242)
+ ("MATHEMATICAL SANS-SERIF CAPITAL T" . 120243)
+ ("MATHEMATICAL SANS-SERIF CAPITAL U" . 120244)
+ ("MATHEMATICAL SANS-SERIF CAPITAL V" . 120245)
+ ("MATHEMATICAL SANS-SERIF CAPITAL W" . 120246)
+ ("MATHEMATICAL SANS-SERIF CAPITAL X" . 120247)
+ ("MATHEMATICAL SANS-SERIF CAPITAL Y" . 120248)
+ ("MATHEMATICAL SANS-SERIF CAPITAL Z" . 120249)
+ ("MATHEMATICAL SANS-SERIF SMALL A" . 120250)
+ ("MATHEMATICAL SANS-SERIF SMALL B" . 120251)
+ ("MATHEMATICAL SANS-SERIF SMALL C" . 120252)
+ ("MATHEMATICAL SANS-SERIF SMALL D" . 120253)
+ ("MATHEMATICAL SANS-SERIF SMALL E" . 120254)
+ ("MATHEMATICAL SANS-SERIF SMALL F" . 120255)
+ ("MATHEMATICAL SANS-SERIF SMALL G" . 120256)
+ ("MATHEMATICAL SANS-SERIF SMALL H" . 120257)
+ ("MATHEMATICAL SANS-SERIF SMALL I" . 120258)
+ ("MATHEMATICAL SANS-SERIF SMALL J" . 120259)
+ ("MATHEMATICAL SANS-SERIF SMALL K" . 120260)
+ ("MATHEMATICAL SANS-SERIF SMALL L" . 120261)
+ ("MATHEMATICAL SANS-SERIF SMALL M" . 120262)
+ ("MATHEMATICAL SANS-SERIF SMALL N" . 120263)
+ ("MATHEMATICAL SANS-SERIF SMALL O" . 120264)
+ ("MATHEMATICAL SANS-SERIF SMALL P" . 120265)
+ ("MATHEMATICAL SANS-SERIF SMALL Q" . 120266)
+ ("MATHEMATICAL SANS-SERIF SMALL R" . 120267)
+ ("MATHEMATICAL SANS-SERIF SMALL S" . 120268)
+ ("MATHEMATICAL SANS-SERIF SMALL T" . 120269)
+ ("MATHEMATICAL SANS-SERIF SMALL U" . 120270)
+ ("MATHEMATICAL SANS-SERIF SMALL V" . 120271)
+ ("MATHEMATICAL SANS-SERIF SMALL W" . 120272)
+ ("MATHEMATICAL SANS-SERIF SMALL X" . 120273)
+ ("MATHEMATICAL SANS-SERIF SMALL Y" . 120274)
+ ("MATHEMATICAL SANS-SERIF SMALL Z" . 120275)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL A" . 120276)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL B" . 120277)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL C" . 120278)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL D" . 120279)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL E" . 120280)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL F" . 120281)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL G" . 120282)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL H" . 120283)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL I" . 120284)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL J" . 120285)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL K" . 120286)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL L" . 120287)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL M" . 120288)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL N" . 120289)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL O" . 120290)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL P" . 120291)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL Q" . 120292)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL R" . 120293)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL S" . 120294)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL T" . 120295)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL U" . 120296)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL V" . 120297)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL W" . 120298)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL X" . 120299)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL Y" . 120300)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL Z" . 120301)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL A" . 120302)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL B" . 120303)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL C" . 120304)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL D" . 120305)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL E" . 120306)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL F" . 120307)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL G" . 120308)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL H" . 120309)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL I" . 120310)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL J" . 120311)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL K" . 120312)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL L" . 120313)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL M" . 120314)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL N" . 120315)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL O" . 120316)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL P" . 120317)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL Q" . 120318)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL R" . 120319)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL S" . 120320)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL T" . 120321)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL U" . 120322)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL V" . 120323)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL W" . 120324)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL X" . 120325)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL Y" . 120326)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL Z" . 120327)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL A" . 120328)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL B" . 120329)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL C" . 120330)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL D" . 120331)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL E" . 120332)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL F" . 120333)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL G" . 120334)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL H" . 120335)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL I" . 120336)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL J" . 120337)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL K" . 120338)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL L" . 120339)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL M" . 120340)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL N" . 120341)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL O" . 120342)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL P" . 120343)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL Q" . 120344)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL R" . 120345)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL S" . 120346)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL T" . 120347)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL U" . 120348)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL V" . 120349)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL W" . 120350)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL X" . 120351)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL Y" . 120352)
+ ("MATHEMATICAL SANS-SERIF ITALIC CAPITAL Z" . 120353)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL A" . 120354)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL B" . 120355)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL C" . 120356)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL D" . 120357)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL E" . 120358)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL F" . 120359)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL G" . 120360)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL H" . 120361)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL I" . 120362)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL J" . 120363)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL K" . 120364)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL L" . 120365)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL M" . 120366)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL N" . 120367)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL O" . 120368)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL P" . 120369)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL Q" . 120370)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL R" . 120371)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL S" . 120372)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL T" . 120373)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL U" . 120374)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL V" . 120375)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL W" . 120376)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL X" . 120377)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL Y" . 120378)
+ ("MATHEMATICAL SANS-SERIF ITALIC SMALL Z" . 120379)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL A" . 120380)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL B" . 120381)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL C" . 120382)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL D" . 120383)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL E" . 120384)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL F" . 120385)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL G" . 120386)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL H" . 120387)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL I" . 120388)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL J" . 120389)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL K" . 120390)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL L" . 120391)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL M" . 120392)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL N" . 120393)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL O" . 120394)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL P" . 120395)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL Q" . 120396)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL R" . 120397)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL S" . 120398)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL T" . 120399)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL U" . 120400)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL V" . 120401)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL W" . 120402)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL X" . 120403)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL Y" . 120404)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL Z" . 120405)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL A" . 120406)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL B" . 120407)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL C" . 120408)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL D" . 120409)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL E" . 120410)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL F" . 120411)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL G" . 120412)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL H" . 120413)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL I" . 120414)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL J" . 120415)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL K" . 120416)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL L" . 120417)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL M" . 120418)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL N" . 120419)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL O" . 120420)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL P" . 120421)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL Q" . 120422)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL R" . 120423)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL S" . 120424)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL T" . 120425)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL U" . 120426)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL V" . 120427)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL W" . 120428)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL X" . 120429)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL Y" . 120430)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL Z" . 120431)
+ ("MATHEMATICAL MONOSPACE CAPITAL A" . 120432)
+ ("MATHEMATICAL MONOSPACE CAPITAL B" . 120433)
+ ("MATHEMATICAL MONOSPACE CAPITAL C" . 120434)
+ ("MATHEMATICAL MONOSPACE CAPITAL D" . 120435)
+ ("MATHEMATICAL MONOSPACE CAPITAL E" . 120436)
+ ("MATHEMATICAL MONOSPACE CAPITAL F" . 120437)
+ ("MATHEMATICAL MONOSPACE CAPITAL G" . 120438)
+ ("MATHEMATICAL MONOSPACE CAPITAL H" . 120439)
+ ("MATHEMATICAL MONOSPACE CAPITAL I" . 120440)
+ ("MATHEMATICAL MONOSPACE CAPITAL J" . 120441)
+ ("MATHEMATICAL MONOSPACE CAPITAL K" . 120442)
+ ("MATHEMATICAL MONOSPACE CAPITAL L" . 120443)
+ ("MATHEMATICAL MONOSPACE CAPITAL M" . 120444)
+ ("MATHEMATICAL MONOSPACE CAPITAL N" . 120445)
+ ("MATHEMATICAL MONOSPACE CAPITAL O" . 120446)
+ ("MATHEMATICAL MONOSPACE CAPITAL P" . 120447)
+ ("MATHEMATICAL MONOSPACE CAPITAL Q" . 120448)
+ ("MATHEMATICAL MONOSPACE CAPITAL R" . 120449)
+ ("MATHEMATICAL MONOSPACE CAPITAL S" . 120450)
+ ("MATHEMATICAL MONOSPACE CAPITAL T" . 120451)
+ ("MATHEMATICAL MONOSPACE CAPITAL U" . 120452)
+ ("MATHEMATICAL MONOSPACE CAPITAL V" . 120453)
+ ("MATHEMATICAL MONOSPACE CAPITAL W" . 120454)
+ ("MATHEMATICAL MONOSPACE CAPITAL X" . 120455)
+ ("MATHEMATICAL MONOSPACE CAPITAL Y" . 120456)
+ ("MATHEMATICAL MONOSPACE CAPITAL Z" . 120457)
+ ("MATHEMATICAL MONOSPACE SMALL A" . 120458)
+ ("MATHEMATICAL MONOSPACE SMALL B" . 120459)
+ ("MATHEMATICAL MONOSPACE SMALL C" . 120460)
+ ("MATHEMATICAL MONOSPACE SMALL D" . 120461)
+ ("MATHEMATICAL MONOSPACE SMALL E" . 120462)
+ ("MATHEMATICAL MONOSPACE SMALL F" . 120463)
+ ("MATHEMATICAL MONOSPACE SMALL G" . 120464)
+ ("MATHEMATICAL MONOSPACE SMALL H" . 120465)
+ ("MATHEMATICAL MONOSPACE SMALL I" . 120466)
+ ("MATHEMATICAL MONOSPACE SMALL J" . 120467)
+ ("MATHEMATICAL MONOSPACE SMALL K" . 120468)
+ ("MATHEMATICAL MONOSPACE SMALL L" . 120469)
+ ("MATHEMATICAL MONOSPACE SMALL M" . 120470)
+ ("MATHEMATICAL MONOSPACE SMALL N" . 120471)
+ ("MATHEMATICAL MONOSPACE SMALL O" . 120472)
+ ("MATHEMATICAL MONOSPACE SMALL P" . 120473)
+ ("MATHEMATICAL MONOSPACE SMALL Q" . 120474)
+ ("MATHEMATICAL MONOSPACE SMALL R" . 120475)
+ ("MATHEMATICAL MONOSPACE SMALL S" . 120476)
+ ("MATHEMATICAL MONOSPACE SMALL T" . 120477)
+ ("MATHEMATICAL MONOSPACE SMALL U" . 120478)
+ ("MATHEMATICAL MONOSPACE SMALL V" . 120479)
+ ("MATHEMATICAL MONOSPACE SMALL W" . 120480)
+ ("MATHEMATICAL MONOSPACE SMALL X" . 120481)
+ ("MATHEMATICAL MONOSPACE SMALL Y" . 120482)
+ ("MATHEMATICAL MONOSPACE SMALL Z" . 120483)
+ ("MATHEMATICAL BOLD CAPITAL ALPHA" . 120488)
+ ("MATHEMATICAL BOLD CAPITAL BETA" . 120489)
+ ("MATHEMATICAL BOLD CAPITAL GAMMA" . 120490)
+ ("MATHEMATICAL BOLD CAPITAL DELTA" . 120491)
+ ("MATHEMATICAL BOLD CAPITAL EPSILON" . 120492)
+ ("MATHEMATICAL BOLD CAPITAL ZETA" . 120493)
+ ("MATHEMATICAL BOLD CAPITAL ETA" . 120494)
+ ("MATHEMATICAL BOLD CAPITAL THETA" . 120495)
+ ("MATHEMATICAL BOLD CAPITAL IOTA" . 120496)
+ ("MATHEMATICAL BOLD CAPITAL KAPPA" . 120497)
+ ("MATHEMATICAL BOLD CAPITAL LAMDA" . 120498)
+ ("MATHEMATICAL BOLD CAPITAL MU" . 120499)
+ ("MATHEMATICAL BOLD CAPITAL NU" . 120500)
+ ("MATHEMATICAL BOLD CAPITAL XI" . 120501)
+ ("MATHEMATICAL BOLD CAPITAL OMICRON" . 120502)
+ ("MATHEMATICAL BOLD CAPITAL PI" . 120503)
+ ("MATHEMATICAL BOLD CAPITAL RHO" . 120504)
+ ("MATHEMATICAL BOLD CAPITAL THETA SYMBOL" . 120505)
+ ("MATHEMATICAL BOLD CAPITAL SIGMA" . 120506)
+ ("MATHEMATICAL BOLD CAPITAL TAU" . 120507)
+ ("MATHEMATICAL BOLD CAPITAL UPSILON" . 120508)
+ ("MATHEMATICAL BOLD CAPITAL PHI" . 120509)
+ ("MATHEMATICAL BOLD CAPITAL CHI" . 120510)
+ ("MATHEMATICAL BOLD CAPITAL PSI" . 120511)
+ ("MATHEMATICAL BOLD CAPITAL OMEGA" . 120512)
+ ("MATHEMATICAL BOLD NABLA" . 120513)
+ ("MATHEMATICAL BOLD SMALL ALPHA" . 120514)
+ ("MATHEMATICAL BOLD SMALL BETA" . 120515)
+ ("MATHEMATICAL BOLD SMALL GAMMA" . 120516)
+ ("MATHEMATICAL BOLD SMALL DELTA" . 120517)
+ ("MATHEMATICAL BOLD SMALL EPSILON" . 120518)
+ ("MATHEMATICAL BOLD SMALL ZETA" . 120519)
+ ("MATHEMATICAL BOLD SMALL ETA" . 120520)
+ ("MATHEMATICAL BOLD SMALL THETA" . 120521)
+ ("MATHEMATICAL BOLD SMALL IOTA" . 120522)
+ ("MATHEMATICAL BOLD SMALL KAPPA" . 120523)
+ ("MATHEMATICAL BOLD SMALL LAMDA" . 120524)
+ ("MATHEMATICAL BOLD SMALL MU" . 120525)
+ ("MATHEMATICAL BOLD SMALL NU" . 120526)
+ ("MATHEMATICAL BOLD SMALL XI" . 120527)
+ ("MATHEMATICAL BOLD SMALL OMICRON" . 120528)
+ ("MATHEMATICAL BOLD SMALL PI" . 120529)
+ ("MATHEMATICAL BOLD SMALL RHO" . 120530)
+ ("MATHEMATICAL BOLD SMALL FINAL SIGMA" . 120531)
+ ("MATHEMATICAL BOLD SMALL SIGMA" . 120532)
+ ("MATHEMATICAL BOLD SMALL TAU" . 120533)
+ ("MATHEMATICAL BOLD SMALL UPSILON" . 120534)
+ ("MATHEMATICAL BOLD SMALL PHI" . 120535)
+ ("MATHEMATICAL BOLD SMALL CHI" . 120536)
+ ("MATHEMATICAL BOLD SMALL PSI" . 120537)
+ ("MATHEMATICAL BOLD SMALL OMEGA" . 120538)
+ ("MATHEMATICAL BOLD PARTIAL DIFFERENTIAL" . 120539)
+ ("MATHEMATICAL BOLD EPSILON SYMBOL" . 120540)
+ ("MATHEMATICAL BOLD THETA SYMBOL" . 120541)
+ ("MATHEMATICAL BOLD KAPPA SYMBOL" . 120542)
+ ("MATHEMATICAL BOLD PHI SYMBOL" . 120543)
+ ("MATHEMATICAL BOLD RHO SYMBOL" . 120544)
+ ("MATHEMATICAL BOLD PI SYMBOL" . 120545)
+ ("MATHEMATICAL ITALIC CAPITAL ALPHA" . 120546)
+ ("MATHEMATICAL ITALIC CAPITAL BETA" . 120547)
+ ("MATHEMATICAL ITALIC CAPITAL GAMMA" . 120548)
+ ("MATHEMATICAL ITALIC CAPITAL DELTA" . 120549)
+ ("MATHEMATICAL ITALIC CAPITAL EPSILON" . 120550)
+ ("MATHEMATICAL ITALIC CAPITAL ZETA" . 120551)
+ ("MATHEMATICAL ITALIC CAPITAL ETA" . 120552)
+ ("MATHEMATICAL ITALIC CAPITAL THETA" . 120553)
+ ("MATHEMATICAL ITALIC CAPITAL IOTA" . 120554)
+ ("MATHEMATICAL ITALIC CAPITAL KAPPA" . 120555)
+ ("MATHEMATICAL ITALIC CAPITAL LAMDA" . 120556)
+ ("MATHEMATICAL ITALIC CAPITAL MU" . 120557)
+ ("MATHEMATICAL ITALIC CAPITAL NU" . 120558)
+ ("MATHEMATICAL ITALIC CAPITAL XI" . 120559)
+ ("MATHEMATICAL ITALIC CAPITAL OMICRON" . 120560)
+ ("MATHEMATICAL ITALIC CAPITAL PI" . 120561)
+ ("MATHEMATICAL ITALIC CAPITAL RHO" . 120562)
+ ("MATHEMATICAL ITALIC CAPITAL THETA SYMBOL" . 120563)
+ ("MATHEMATICAL ITALIC CAPITAL SIGMA" . 120564)
+ ("MATHEMATICAL ITALIC CAPITAL TAU" . 120565)
+ ("MATHEMATICAL ITALIC CAPITAL UPSILON" . 120566)
+ ("MATHEMATICAL ITALIC CAPITAL PHI" . 120567)
+ ("MATHEMATICAL ITALIC CAPITAL CHI" . 120568)
+ ("MATHEMATICAL ITALIC CAPITAL PSI" . 120569)
+ ("MATHEMATICAL ITALIC CAPITAL OMEGA" . 120570)
+ ("MATHEMATICAL ITALIC NABLA" . 120571)
+ ("MATHEMATICAL ITALIC SMALL ALPHA" . 120572)
+ ("MATHEMATICAL ITALIC SMALL BETA" . 120573)
+ ("MATHEMATICAL ITALIC SMALL GAMMA" . 120574)
+ ("MATHEMATICAL ITALIC SMALL DELTA" . 120575)
+ ("MATHEMATICAL ITALIC SMALL EPSILON" . 120576)
+ ("MATHEMATICAL ITALIC SMALL ZETA" . 120577)
+ ("MATHEMATICAL ITALIC SMALL ETA" . 120578)
+ ("MATHEMATICAL ITALIC SMALL THETA" . 120579)
+ ("MATHEMATICAL ITALIC SMALL IOTA" . 120580)
+ ("MATHEMATICAL ITALIC SMALL KAPPA" . 120581)
+ ("MATHEMATICAL ITALIC SMALL LAMDA" . 120582)
+ ("MATHEMATICAL ITALIC SMALL MU" . 120583)
+ ("MATHEMATICAL ITALIC SMALL NU" . 120584)
+ ("MATHEMATICAL ITALIC SMALL XI" . 120585)
+ ("MATHEMATICAL ITALIC SMALL OMICRON" . 120586)
+ ("MATHEMATICAL ITALIC SMALL PI" . 120587)
+ ("MATHEMATICAL ITALIC SMALL RHO" . 120588)
+ ("MATHEMATICAL ITALIC SMALL FINAL SIGMA" . 120589)
+ ("MATHEMATICAL ITALIC SMALL SIGMA" . 120590)
+ ("MATHEMATICAL ITALIC SMALL TAU" . 120591)
+ ("MATHEMATICAL ITALIC SMALL UPSILON" . 120592)
+ ("MATHEMATICAL ITALIC SMALL PHI" . 120593)
+ ("MATHEMATICAL ITALIC SMALL CHI" . 120594)
+ ("MATHEMATICAL ITALIC SMALL PSI" . 120595)
+ ("MATHEMATICAL ITALIC SMALL OMEGA" . 120596)
+ ("MATHEMATICAL ITALIC PARTIAL DIFFERENTIAL" . 120597)
+ ("MATHEMATICAL ITALIC EPSILON SYMBOL" . 120598)
+ ("MATHEMATICAL ITALIC THETA SYMBOL" . 120599)
+ ("MATHEMATICAL ITALIC KAPPA SYMBOL" . 120600)
+ ("MATHEMATICAL ITALIC PHI SYMBOL" . 120601)
+ ("MATHEMATICAL ITALIC RHO SYMBOL" . 120602)
+ ("MATHEMATICAL ITALIC PI SYMBOL" . 120603)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL ALPHA" . 120604)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL BETA" . 120605)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL GAMMA" . 120606)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL DELTA" . 120607)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL EPSILON" . 120608)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL ZETA" . 120609)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL ETA" . 120610)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL THETA" . 120611)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL IOTA" . 120612)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL KAPPA" . 120613)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL LAMDA" . 120614)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL MU" . 120615)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL NU" . 120616)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL XI" . 120617)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL OMICRON" . 120618)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL PI" . 120619)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL RHO" . 120620)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL THETA SYMBOL" . 120621)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL SIGMA" . 120622)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL TAU" . 120623)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL UPSILON" . 120624)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL PHI" . 120625)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL CHI" . 120626)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL PSI" . 120627)
+ ("MATHEMATICAL BOLD ITALIC CAPITAL OMEGA" . 120628)
+ ("MATHEMATICAL BOLD ITALIC NABLA" . 120629)
+ ("MATHEMATICAL BOLD ITALIC SMALL ALPHA" . 120630)
+ ("MATHEMATICAL BOLD ITALIC SMALL BETA" . 120631)
+ ("MATHEMATICAL BOLD ITALIC SMALL GAMMA" . 120632)
+ ("MATHEMATICAL BOLD ITALIC SMALL DELTA" . 120633)
+ ("MATHEMATICAL BOLD ITALIC SMALL EPSILON" . 120634)
+ ("MATHEMATICAL BOLD ITALIC SMALL ZETA" . 120635)
+ ("MATHEMATICAL BOLD ITALIC SMALL ETA" . 120636)
+ ("MATHEMATICAL BOLD ITALIC SMALL THETA" . 120637)
+ ("MATHEMATICAL BOLD ITALIC SMALL IOTA" . 120638)
+ ("MATHEMATICAL BOLD ITALIC SMALL KAPPA" . 120639)
+ ("MATHEMATICAL BOLD ITALIC SMALL LAMDA" . 120640)
+ ("MATHEMATICAL BOLD ITALIC SMALL MU" . 120641)
+ ("MATHEMATICAL BOLD ITALIC SMALL NU" . 120642)
+ ("MATHEMATICAL BOLD ITALIC SMALL XI" . 120643)
+ ("MATHEMATICAL BOLD ITALIC SMALL OMICRON" . 120644)
+ ("MATHEMATICAL BOLD ITALIC SMALL PI" . 120645)
+ ("MATHEMATICAL BOLD ITALIC SMALL RHO" . 120646)
+ ("MATHEMATICAL BOLD ITALIC SMALL FINAL SIGMA" . 120647)
+ ("MATHEMATICAL BOLD ITALIC SMALL SIGMA" . 120648)
+ ("MATHEMATICAL BOLD ITALIC SMALL TAU" . 120649)
+ ("MATHEMATICAL BOLD ITALIC SMALL UPSILON" . 120650)
+ ("MATHEMATICAL BOLD ITALIC SMALL PHI" . 120651)
+ ("MATHEMATICAL BOLD ITALIC SMALL CHI" . 120652)
+ ("MATHEMATICAL BOLD ITALIC SMALL PSI" . 120653)
+ ("MATHEMATICAL BOLD ITALIC SMALL OMEGA" . 120654)
+ ("MATHEMATICAL BOLD ITALIC PARTIAL DIFFERENTIAL" . 120655)
+ ("MATHEMATICAL BOLD ITALIC EPSILON SYMBOL" . 120656)
+ ("MATHEMATICAL BOLD ITALIC THETA SYMBOL" . 120657)
+ ("MATHEMATICAL BOLD ITALIC KAPPA SYMBOL" . 120658)
+ ("MATHEMATICAL BOLD ITALIC PHI SYMBOL" . 120659)
+ ("MATHEMATICAL BOLD ITALIC RHO SYMBOL" . 120660)
+ ("MATHEMATICAL BOLD ITALIC PI SYMBOL" . 120661)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL ALPHA" . 120662)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL BETA" . 120663)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL GAMMA" . 120664)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL DELTA" . 120665)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL EPSILON" . 120666)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL ZETA" . 120667)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL ETA" . 120668)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL THETA" . 120669)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL IOTA" . 120670)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL KAPPA" . 120671)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL LAMDA" . 120672)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL MU" . 120673)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL NU" . 120674)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL XI" . 120675)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL OMICRON" . 120676)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL PI" . 120677)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL RHO" . 120678)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL THETA SYMBOL" . 120679)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL SIGMA" . 120680)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL TAU" . 120681)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL UPSILON" . 120682)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL PHI" . 120683)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL CHI" . 120684)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL PSI" . 120685)
+ ("MATHEMATICAL SANS-SERIF BOLD CAPITAL OMEGA" . 120686)
+ ("MATHEMATICAL SANS-SERIF BOLD NABLA" . 120687)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL ALPHA" . 120688)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL BETA" . 120689)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL GAMMA" . 120690)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL DELTA" . 120691)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL EPSILON" . 120692)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL ZETA" . 120693)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL ETA" . 120694)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL THETA" . 120695)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL IOTA" . 120696)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL KAPPA" . 120697)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL LAMDA" . 120698)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL MU" . 120699)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL NU" . 120700)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL XI" . 120701)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL OMICRON" . 120702)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL PI" . 120703)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL RHO" . 120704)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL FINAL SIGMA" . 120705)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL SIGMA" . 120706)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL TAU" . 120707)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL UPSILON" . 120708)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL PHI" . 120709)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL CHI" . 120710)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL PSI" . 120711)
+ ("MATHEMATICAL SANS-SERIF BOLD SMALL OMEGA" . 120712)
+ ("MATHEMATICAL SANS-SERIF BOLD PARTIAL DIFFERENTIAL" . 120713)
+ ("MATHEMATICAL SANS-SERIF BOLD EPSILON SYMBOL" . 120714)
+ ("MATHEMATICAL SANS-SERIF BOLD THETA SYMBOL" . 120715)
+ ("MATHEMATICAL SANS-SERIF BOLD KAPPA SYMBOL" . 120716)
+ ("MATHEMATICAL SANS-SERIF BOLD PHI SYMBOL" . 120717)
+ ("MATHEMATICAL SANS-SERIF BOLD RHO SYMBOL" . 120718)
+ ("MATHEMATICAL SANS-SERIF BOLD PI SYMBOL" . 120719)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL ALPHA" . 120720)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL BETA" . 120721)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL GAMMA" . 120722)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL DELTA" . 120723)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL EPSILON" . 120724)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL ZETA" . 120725)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL ETA" . 120726)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL THETA" . 120727)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL IOTA" . 120728)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL KAPPA" . 120729)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL LAMDA" . 120730)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL MU" . 120731)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL NU" . 120732)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL XI" . 120733)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL OMICRON" . 120734)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL PI" . 120735)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL RHO" . 120736)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL THETA SYMBOL" . 120737)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL SIGMA" . 120738)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL TAU" . 120739)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL UPSILON" . 120740)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL PHI" . 120741)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL CHI" . 120742)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL PSI" . 120743)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC CAPITAL OMEGA" . 120744)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC NABLA" . 120745)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL ALPHA" . 120746)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL BETA" . 120747)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL GAMMA" . 120748)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL DELTA" . 120749)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL EPSILON" . 120750)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL ZETA" . 120751)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL ETA" . 120752)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL THETA" . 120753)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL IOTA" . 120754)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL KAPPA" . 120755)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL LAMDA" . 120756)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL MU" . 120757)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL NU" . 120758)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL XI" . 120759)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL OMICRON" . 120760)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL PI" . 120761)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL RHO" . 120762)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL FINAL SIGMA" . 120763)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL SIGMA" . 120764)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL TAU" . 120765)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL UPSILON" . 120766)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL PHI" . 120767)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL CHI" . 120768)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL PSI" . 120769)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC SMALL OMEGA" . 120770)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC PARTIAL DIFFERENTIAL" . 120771)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC EPSILON SYMBOL" . 120772)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC THETA SYMBOL" . 120773)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC KAPPA SYMBOL" . 120774)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC PHI SYMBOL" . 120775)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC RHO SYMBOL" . 120776)
+ ("MATHEMATICAL SANS-SERIF BOLD ITALIC PI SYMBOL" . 120777)
+ ("MATHEMATICAL BOLD DIGIT ZERO" . 120782)
+ ("MATHEMATICAL BOLD DIGIT ONE" . 120783)
+ ("MATHEMATICAL BOLD DIGIT TWO" . 120784)
+ ("MATHEMATICAL BOLD DIGIT THREE" . 120785)
+ ("MATHEMATICAL BOLD DIGIT FOUR" . 120786)
+ ("MATHEMATICAL BOLD DIGIT FIVE" . 120787)
+ ("MATHEMATICAL BOLD DIGIT SIX" . 120788)
+ ("MATHEMATICAL BOLD DIGIT SEVEN" . 120789)
+ ("MATHEMATICAL BOLD DIGIT EIGHT" . 120790)
+ ("MATHEMATICAL BOLD DIGIT NINE" . 120791)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT ZERO" . 120792)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT ONE" . 120793)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT TWO" . 120794)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT THREE" . 120795)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT FOUR" . 120796)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT FIVE" . 120797)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT SIX" . 120798)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT SEVEN" . 120799)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT EIGHT" . 120800)
+ ("MATHEMATICAL DOUBLE-STRUCK DIGIT NINE" . 120801)
+ ("MATHEMATICAL SANS-SERIF DIGIT ZERO" . 120802)
+ ("MATHEMATICAL SANS-SERIF DIGIT ONE" . 120803)
+ ("MATHEMATICAL SANS-SERIF DIGIT TWO" . 120804)
+ ("MATHEMATICAL SANS-SERIF DIGIT THREE" . 120805)
+ ("MATHEMATICAL SANS-SERIF DIGIT FOUR" . 120806)
+ ("MATHEMATICAL SANS-SERIF DIGIT FIVE" . 120807)
+ ("MATHEMATICAL SANS-SERIF DIGIT SIX" . 120808)
+ ("MATHEMATICAL SANS-SERIF DIGIT SEVEN" . 120809)
+ ("MATHEMATICAL SANS-SERIF DIGIT EIGHT" . 120810)
+ ("MATHEMATICAL SANS-SERIF DIGIT NINE" . 120811)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT ZERO" . 120812)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT ONE" . 120813)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT TWO" . 120814)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT THREE" . 120815)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT FOUR" . 120816)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT FIVE" . 120817)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT SIX" . 120818)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT SEVEN" . 120819)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT EIGHT" . 120820)
+ ("MATHEMATICAL SANS-SERIF BOLD DIGIT NINE" . 120821)
+ ("MATHEMATICAL MONOSPACE DIGIT ZERO" . 120822)
+ ("MATHEMATICAL MONOSPACE DIGIT ONE" . 120823)
+ ("MATHEMATICAL MONOSPACE DIGIT TWO" . 120824)
+ ("MATHEMATICAL MONOSPACE DIGIT THREE" . 120825)
+ ("MATHEMATICAL MONOSPACE DIGIT FOUR" . 120826)
+ ("MATHEMATICAL MONOSPACE DIGIT FIVE" . 120827)
+ ("MATHEMATICAL MONOSPACE DIGIT SIX" . 120828)
+ ("MATHEMATICAL MONOSPACE DIGIT SEVEN" . 120829)
+ ("MATHEMATICAL MONOSPACE DIGIT EIGHT" . 120830)
+ ("MATHEMATICAL MONOSPACE DIGIT NINE" . 120831)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F800" . 194560)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F801" . 194561)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F802" . 194562)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F803" . 194563)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F804" . 194564)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F805" . 194565)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F806" . 194566)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F807" . 194567)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F808" . 194568)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F809" . 194569)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F80A" . 194570)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F80B" . 194571)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F80C" . 194572)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F80D" . 194573)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F80E" . 194574)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F80F" . 194575)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F810" . 194576)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F811" . 194577)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F812" . 194578)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F813" . 194579)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F814" . 194580)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F815" . 194581)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F816" . 194582)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F817" . 194583)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F818" . 194584)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F819" . 194585)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F81A" . 194586)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F81B" . 194587)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F81C" . 194588)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F81D" . 194589)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F81E" . 194590)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F81F" . 194591)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F820" . 194592)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F821" . 194593)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F822" . 194594)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F823" . 194595)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F824" . 194596)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F825" . 194597)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F826" . 194598)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F827" . 194599)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F828" . 194600)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F829" . 194601)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F82A" . 194602)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F82B" . 194603)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F82C" . 194604)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F82D" . 194605)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F82E" . 194606)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F82F" . 194607)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F830" . 194608)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F831" . 194609)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F832" . 194610)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F833" . 194611)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F834" . 194612)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F835" . 194613)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F836" . 194614)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F837" . 194615)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F838" . 194616)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F839" . 194617)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F83A" . 194618)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F83B" . 194619)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F83C" . 194620)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F83D" . 194621)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F83E" . 194622)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F83F" . 194623)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F840" . 194624)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F841" . 194625)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F842" . 194626)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F843" . 194627)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F844" . 194628)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F845" . 194629)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F846" . 194630)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F847" . 194631)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F848" . 194632)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F849" . 194633)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F84A" . 194634)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F84B" . 194635)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F84C" . 194636)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F84D" . 194637)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F84E" . 194638)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F84F" . 194639)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F850" . 194640)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F851" . 194641)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F852" . 194642)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F853" . 194643)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F854" . 194644)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F855" . 194645)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F856" . 194646)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F857" . 194647)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F858" . 194648)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F859" . 194649)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F85A" . 194650)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F85B" . 194651)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F85C" . 194652)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F85D" . 194653)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F85E" . 194654)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F85F" . 194655)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F860" . 194656)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F861" . 194657)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F862" . 194658)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F863" . 194659)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F864" . 194660)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F865" . 194661)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F866" . 194662)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F867" . 194663)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F868" . 194664)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F869" . 194665)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F86A" . 194666)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F86B" . 194667)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F86C" . 194668)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F86D" . 194669)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F86E" . 194670)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F86F" . 194671)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F870" . 194672)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F871" . 194673)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F872" . 194674)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F873" . 194675)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F874" . 194676)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F875" . 194677)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F876" . 194678)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F877" . 194679)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F878" . 194680)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F879" . 194681)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F87A" . 194682)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F87B" . 194683)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F87C" . 194684)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F87D" . 194685)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F87E" . 194686)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F87F" . 194687)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F880" . 194688)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F881" . 194689)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F882" . 194690)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F883" . 194691)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F884" . 194692)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F885" . 194693)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F886" . 194694)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F887" . 194695)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F888" . 194696)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F889" . 194697)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F88A" . 194698)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F88B" . 194699)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F88C" . 194700)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F88D" . 194701)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F88E" . 194702)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F88F" . 194703)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F890" . 194704)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F891" . 194705)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F892" . 194706)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F893" . 194707)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F894" . 194708)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F895" . 194709)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F896" . 194710)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F897" . 194711)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F898" . 194712)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F899" . 194713)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F89A" . 194714)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F89B" . 194715)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F89C" . 194716)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F89D" . 194717)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F89E" . 194718)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F89F" . 194719)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A0" . 194720)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A1" . 194721)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A2" . 194722)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A3" . 194723)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A4" . 194724)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A5" . 194725)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A6" . 194726)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A7" . 194727)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A8" . 194728)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8A9" . 194729)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8AA" . 194730)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8AB" . 194731)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8AC" . 194732)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8AD" . 194733)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8AE" . 194734)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8AF" . 194735)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B0" . 194736)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B1" . 194737)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B2" . 194738)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B3" . 194739)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B4" . 194740)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B5" . 194741)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B6" . 194742)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B7" . 194743)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B8" . 194744)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8B9" . 194745)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8BA" . 194746)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8BB" . 194747)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8BC" . 194748)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8BD" . 194749)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8BE" . 194750)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8BF" . 194751)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C0" . 194752)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C1" . 194753)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C2" . 194754)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C3" . 194755)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C4" . 194756)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C5" . 194757)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C6" . 194758)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C7" . 194759)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C8" . 194760)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8C9" . 194761)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8CA" . 194762)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8CB" . 194763)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8CC" . 194764)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8CD" . 194765)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8CE" . 194766)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8CF" . 194767)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D0" . 194768)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D1" . 194769)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D2" . 194770)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D3" . 194771)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D4" . 194772)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D5" . 194773)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D6" . 194774)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D7" . 194775)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D8" . 194776)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8D9" . 194777)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8DA" . 194778)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8DB" . 194779)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8DC" . 194780)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8DD" . 194781)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8DE" . 194782)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8DF" . 194783)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E0" . 194784)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E1" . 194785)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E2" . 194786)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E3" . 194787)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E4" . 194788)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E5" . 194789)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E6" . 194790)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E7" . 194791)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E8" . 194792)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8E9" . 194793)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8EA" . 194794)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8EB" . 194795)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8EC" . 194796)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8ED" . 194797)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8EE" . 194798)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8EF" . 194799)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F0" . 194800)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F1" . 194801)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F2" . 194802)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F3" . 194803)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F4" . 194804)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F5" . 194805)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F6" . 194806)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F7" . 194807)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F8" . 194808)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8F9" . 194809)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8FA" . 194810)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8FB" . 194811)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8FC" . 194812)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8FD" . 194813)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8FE" . 194814)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F8FF" . 194815)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F900" . 194816)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F901" . 194817)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F902" . 194818)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F903" . 194819)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F904" . 194820)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F905" . 194821)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F906" . 194822)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F907" . 194823)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F908" . 194824)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F909" . 194825)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F90A" . 194826)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F90B" . 194827)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F90C" . 194828)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F90D" . 194829)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F90E" . 194830)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F90F" . 194831)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F910" . 194832)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F911" . 194833)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F912" . 194834)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F913" . 194835)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F914" . 194836)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F915" . 194837)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F916" . 194838)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F917" . 194839)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F918" . 194840)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F919" . 194841)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F91A" . 194842)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F91B" . 194843)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F91C" . 194844)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F91D" . 194845)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F91E" . 194846)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F91F" . 194847)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F920" . 194848)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F921" . 194849)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F922" . 194850)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F923" . 194851)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F924" . 194852)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F925" . 194853)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F926" . 194854)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F927" . 194855)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F928" . 194856)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F929" . 194857)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F92A" . 194858)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F92B" . 194859)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F92C" . 194860)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F92D" . 194861)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F92E" . 194862)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F92F" . 194863)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F930" . 194864)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F931" . 194865)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F932" . 194866)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F933" . 194867)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F934" . 194868)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F935" . 194869)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F936" . 194870)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F937" . 194871)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F938" . 194872)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F939" . 194873)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F93A" . 194874)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F93B" . 194875)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F93C" . 194876)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F93D" . 194877)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F93E" . 194878)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F93F" . 194879)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F940" . 194880)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F941" . 194881)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F942" . 194882)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F943" . 194883)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F944" . 194884)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F945" . 194885)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F946" . 194886)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F947" . 194887)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F948" . 194888)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F949" . 194889)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F94A" . 194890)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F94B" . 194891)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F94C" . 194892)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F94D" . 194893)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F94E" . 194894)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F94F" . 194895)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F950" . 194896)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F951" . 194897)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F952" . 194898)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F953" . 194899)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F954" . 194900)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F955" . 194901)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F956" . 194902)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F957" . 194903)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F958" . 194904)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F959" . 194905)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F95A" . 194906)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F95B" . 194907)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F95C" . 194908)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F95D" . 194909)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F95E" . 194910)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F95F" . 194911)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F960" . 194912)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F961" . 194913)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F962" . 194914)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F963" . 194915)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F964" . 194916)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F965" . 194917)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F966" . 194918)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F967" . 194919)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F968" . 194920)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F969" . 194921)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F96A" . 194922)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F96B" . 194923)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F96C" . 194924)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F96D" . 194925)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F96E" . 194926)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F96F" . 194927)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F970" . 194928)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F971" . 194929)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F972" . 194930)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F973" . 194931)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F974" . 194932)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F975" . 194933)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F976" . 194934)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F977" . 194935)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F978" . 194936)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F979" . 194937)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F97A" . 194938)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F97B" . 194939)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F97C" . 194940)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F97D" . 194941)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F97E" . 194942)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F97F" . 194943)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F980" . 194944)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F981" . 194945)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F982" . 194946)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F983" . 194947)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F984" . 194948)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F985" . 194949)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F986" . 194950)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F987" . 194951)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F988" . 194952)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F989" . 194953)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F98A" . 194954)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F98B" . 194955)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F98C" . 194956)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F98D" . 194957)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F98E" . 194958)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F98F" . 194959)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F990" . 194960)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F991" . 194961)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F992" . 194962)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F993" . 194963)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F994" . 194964)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F995" . 194965)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F996" . 194966)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F997" . 194967)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F998" . 194968)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F999" . 194969)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F99A" . 194970)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F99B" . 194971)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F99C" . 194972)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F99D" . 194973)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F99E" . 194974)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F99F" . 194975)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A0" . 194976)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A1" . 194977)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A2" . 194978)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A3" . 194979)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A4" . 194980)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A5" . 194981)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A6" . 194982)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A7" . 194983)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A8" . 194984)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9A9" . 194985)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9AA" . 194986)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9AB" . 194987)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9AC" . 194988)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9AD" . 194989)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9AE" . 194990)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9AF" . 194991)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B0" . 194992)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B1" . 194993)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B2" . 194994)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B3" . 194995)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B4" . 194996)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B5" . 194997)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B6" . 194998)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B7" . 194999)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B8" . 195000)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9B9" . 195001)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9BA" . 195002)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9BB" . 195003)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9BC" . 195004)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9BD" . 195005)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9BE" . 195006)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9BF" . 195007)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C0" . 195008)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C1" . 195009)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C2" . 195010)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C3" . 195011)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C4" . 195012)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C5" . 195013)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C6" . 195014)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C7" . 195015)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C8" . 195016)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9C9" . 195017)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9CA" . 195018)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9CB" . 195019)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9CC" . 195020)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9CD" . 195021)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9CE" . 195022)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9CF" . 195023)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D0" . 195024)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D1" . 195025)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D2" . 195026)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D3" . 195027)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D4" . 195028)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D5" . 195029)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D6" . 195030)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D7" . 195031)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D8" . 195032)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9D9" . 195033)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9DA" . 195034)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9DB" . 195035)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9DC" . 195036)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9DD" . 195037)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9DE" . 195038)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9DF" . 195039)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E0" . 195040)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E1" . 195041)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E2" . 195042)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E3" . 195043)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E4" . 195044)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E5" . 195045)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E6" . 195046)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E7" . 195047)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E8" . 195048)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9E9" . 195049)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9EA" . 195050)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9EB" . 195051)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9EC" . 195052)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9ED" . 195053)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9EE" . 195054)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9EF" . 195055)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F0" . 195056)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F1" . 195057)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F2" . 195058)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F3" . 195059)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F4" . 195060)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F5" . 195061)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F6" . 195062)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F7" . 195063)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F8" . 195064)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9F9" . 195065)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9FA" . 195066)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9FB" . 195067)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9FC" . 195068)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9FD" . 195069)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9FE" . 195070)
+ ("CJK COMPATIBILITY IDEOGRAPH-2F9FF" . 195071)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA00" . 195072)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA01" . 195073)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA02" . 195074)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA03" . 195075)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA04" . 195076)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA05" . 195077)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA06" . 195078)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA07" . 195079)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA08" . 195080)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA09" . 195081)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA0A" . 195082)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA0B" . 195083)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA0C" . 195084)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA0D" . 195085)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA0E" . 195086)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA0F" . 195087)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA10" . 195088)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA11" . 195089)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA12" . 195090)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA13" . 195091)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA14" . 195092)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA15" . 195093)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA16" . 195094)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA17" . 195095)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA18" . 195096)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA19" . 195097)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA1A" . 195098)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA1B" . 195099)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA1C" . 195100)
+ ("CJK COMPATIBILITY IDEOGRAPH-2FA1D" . 195101)
+ ("LANGUAGE TAG" . 917505)
+ ("TAG SPACE" . 917536)
+ ("TAG EXCLAMATION MARK" . 917537)
+ ("TAG QUOTATION MARK" . 917538)
+ ("TAG NUMBER SIGN" . 917539)
+ ("TAG DOLLAR SIGN" . 917540)
+ ("TAG PERCENT SIGN" . 917541)
+ ("TAG AMPERSAND" . 917542)
+ ("TAG APOSTROPHE" . 917543)
+ ("TAG LEFT PARENTHESIS" . 917544)
+ ("TAG RIGHT PARENTHESIS" . 917545)
+ ("TAG ASTERISK" . 917546)
+ ("TAG PLUS SIGN" . 917547)
+ ("TAG COMMA" . 917548)
+ ("TAG HYPHEN-MINUS" . 917549)
+ ("TAG FULL STOP" . 917550)
+ ("TAG SOLIDUS" . 917551)
+ ("TAG DIGIT ZERO" . 917552)
+ ("TAG DIGIT ONE" . 917553)
+ ("TAG DIGIT TWO" . 917554)
+ ("TAG DIGIT THREE" . 917555)
+ ("TAG DIGIT FOUR" . 917556)
+ ("TAG DIGIT FIVE" . 917557)
+ ("TAG DIGIT SIX" . 917558)
+ ("TAG DIGIT SEVEN" . 917559)
+ ("TAG DIGIT EIGHT" . 917560)
+ ("TAG DIGIT NINE" . 917561)
+ ("TAG COLON" . 917562)
+ ("TAG SEMICOLON" . 917563)
+ ("TAG LESS-THAN SIGN" . 917564)
+ ("TAG EQUALS SIGN" . 917565)
+ ("TAG GREATER-THAN SIGN" . 917566)
+ ("TAG QUESTION MARK" . 917567)
+ ("TAG COMMERCIAL AT" . 917568)
+ ("TAG LATIN CAPITAL LETTER A" . 917569)
+ ("TAG LATIN CAPITAL LETTER B" . 917570)
+ ("TAG LATIN CAPITAL LETTER C" . 917571)
+ ("TAG LATIN CAPITAL LETTER D" . 917572)
+ ("TAG LATIN CAPITAL LETTER E" . 917573)
+ ("TAG LATIN CAPITAL LETTER F" . 917574)
+ ("TAG LATIN CAPITAL LETTER G" . 917575)
+ ("TAG LATIN CAPITAL LETTER H" . 917576)
+ ("TAG LATIN CAPITAL LETTER I" . 917577)
+ ("TAG LATIN CAPITAL LETTER J" . 917578)
+ ("TAG LATIN CAPITAL LETTER K" . 917579)
+ ("TAG LATIN CAPITAL LETTER L" . 917580)
+ ("TAG LATIN CAPITAL LETTER M" . 917581)
+ ("TAG LATIN CAPITAL LETTER N" . 917582)
+ ("TAG LATIN CAPITAL LETTER O" . 917583)
+ ("TAG LATIN CAPITAL LETTER P" . 917584)
+ ("TAG LATIN CAPITAL LETTER Q" . 917585)
+ ("TAG LATIN CAPITAL LETTER R" . 917586)
+ ("TAG LATIN CAPITAL LETTER S" . 917587)
+ ("TAG LATIN CAPITAL LETTER T" . 917588)
+ ("TAG LATIN CAPITAL LETTER U" . 917589)
+ ("TAG LATIN CAPITAL LETTER V" . 917590)
+ ("TAG LATIN CAPITAL LETTER W" . 917591)
+ ("TAG LATIN CAPITAL LETTER X" . 917592)
+ ("TAG LATIN CAPITAL LETTER Y" . 917593)
+ ("TAG LATIN CAPITAL LETTER Z" . 917594)
+ ("TAG LEFT SQUARE BRACKET" . 917595)
+ ("TAG REVERSE SOLIDUS" . 917596)
+ ("TAG RIGHT SQUARE BRACKET" . 917597)
+ ("TAG CIRCUMFLEX ACCENT" . 917598)
+ ("TAG LOW LINE" . 917599)
+ ("TAG GRAVE ACCENT" . 917600)
+ ("TAG LATIN SMALL LETTER A" . 917601)
+ ("TAG LATIN SMALL LETTER B" . 917602)
+ ("TAG LATIN SMALL LETTER C" . 917603)
+ ("TAG LATIN SMALL LETTER D" . 917604)
+ ("TAG LATIN SMALL LETTER E" . 917605)
+ ("TAG LATIN SMALL LETTER F" . 917606)
+ ("TAG LATIN SMALL LETTER G" . 917607)
+ ("TAG LATIN SMALL LETTER H" . 917608)
+ ("TAG LATIN SMALL LETTER I" . 917609)
+ ("TAG LATIN SMALL LETTER J" . 917610)
+ ("TAG LATIN SMALL LETTER K" . 917611)
+ ("TAG LATIN SMALL LETTER L" . 917612)
+ ("TAG LATIN SMALL LETTER M" . 917613)
+ ("TAG LATIN SMALL LETTER N" . 917614)
+ ("TAG LATIN SMALL LETTER O" . 917615)
+ ("TAG LATIN SMALL LETTER P" . 917616)
+ ("TAG LATIN SMALL LETTER Q" . 917617)
+ ("TAG LATIN SMALL LETTER R" . 917618)
+ ("TAG LATIN SMALL LETTER S" . 917619)
+ ("TAG LATIN SMALL LETTER T" . 917620)
+ ("TAG LATIN SMALL LETTER U" . 917621)
+ ("TAG LATIN SMALL LETTER V" . 917622)
+ ("TAG LATIN SMALL LETTER W" . 917623)
+ ("TAG LATIN SMALL LETTER X" . 917624)
+ ("TAG LATIN SMALL LETTER Y" . 917625)
+ ("TAG LATIN SMALL LETTER Z" . 917626)
+ ("TAG LEFT CURLY BRACKET" . 917627)
+ ("TAG VERTICAL LINE" . 917628)
+ ("TAG RIGHT CURLY BRACKET" . 917629)
+ ("TAG TILDE" . 917630)
+ ("CANCEL TAG" . 917631))
+ ;; only include characters which are supported by this Lisp
+ while (< code char-code-limit)
+ when (code-char code)
+ do (setf (gethash name *unicode-names*) (code-char code)))
+
+;;; define some aliases
+(loop for (alias . name) in '(("LINE FEED" . "LINE FEED (LF)")
+ ("FORM FEED" . "FORM FEED (LF)")
+ ("CARRIAGE RETURN" . "CARRIAGE RETURN (CR)")
+ ("NEXT LINE" . "NEXT LINE (NEL)")
+ ("LF" . "LINE FEED")
+ ("FF" . "FORM FEED")
+ ("CR" . "CARRIAGE RETURN")
+ ("NEL" . "NEXT LINE")
+ ("ZWNJ" . "ZERO WIDTH NON-JOINER")
+ ("ZWJ" . "ZERO WIDTH JOINER")
+ ("BYTE ORDER MARK" . "ZERO WIDTH NO-BREAK SPACE")
+ ("BOM" . "BYTE ORDER MARK")
+ ("HORIZONTAL TABULATION" . "CHARACTER TABULATION")
+ ("VERTICAL TABULATION" . "LINE TABULATION")
+ ("FILE SEPARATOR" . "INFORMATION SEPARATOR FOUR")
+ ("GROUP SEPARATOR" . "INFORMATION SEPARATOR THREE")
+ ("RECORD SEPARATOR" . "INFORMATION SEPARATOR TWO")
+ ("UNIT SEPARATOR" . "INFORMATION SEPARATOR ONE")
+ ("PARTIAL LINE DOWN" . "PARTIAL LINE FORWARD")
+ ("PARTIAL LINE UP" . "PARTIAL LINE BACKWARD"))
+ for existing-char = (gethash name *unicode-names*)
+ when existing-char
+ do (setf (gethash alias *unicode-names*) existing-char))
Added: branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/util.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/util.lisp 2007-10-04 19:13:23 UTC (rev 2205)
+++ branches/trunk-reorg/thirdparty/cl-interpol-0.1.2/util.lisp 2007-10-04 19:49:06 UTC (rev 2206)
@@ -0,0 +1,135 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-INTERPOL; Base: 10 -*-
+;;; $Header: /usr/local/cvsrep/cl-interpol/util.lisp,v 1.7 2003/10/22 09:20:30 edi Exp $
+
+;;; Copyright (c) 2003, Dr. Edmund Weitz. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-interpol)
+
+(define-condition simple-reader-error (simple-condition reader-error)
+ ()
+ (:documentation "A reader error which can be signalled by ERROR."))
+
+(defmacro signal-reader-error (format-control &rest format-arguments)
+ "Like ERROR but signals a SIMPLE-READER-ERROR for the stream
+*STREAM*."
+ `(error 'simple-reader-error
+ :stream *stream*
+ :format-control ,format-control
+ :format-arguments (list ,@format-arguments)))
+
+(defun string-list-to-string (string-list)
+ "Concatenates a list of strings to one string."
+ ;; this function originally provided by JP Massar for CL-PPCRE; note
+ ;; that we can't use APPLY with CONCATENATE here because of
+ ;; CALL-ARGUMENTS-LIMIT
+ (let ((total-size 0))
+ (dolist (string string-list)
+ (incf total-size (length string)))
+ (let ((result-string (make-array total-size :element-type 'character))
+ (curr-pos 0))
+ (dolist (string string-list)
+ (replace result-string string :start1 curr-pos)
+ (incf curr-pos (length string)))
+ result-string)))
+
+(defun quote-meta-chars (string)
+ "Quote, i.e. prefix with #\\\\, all non-word characters in STRING."
+ (with-output-to-string (s)
+ (loop for char across string
+ if (or (char<= #\a char #\z)
+ (char<= #\A char #\Z)
+ (char<= #\0 char #\9)
+ (char= #\_ char)) do
+ (write-char char s)
+ else do
+ (write-char #\\ s)
+ (write-char char s))))
+
+(defun get-end-delimiter (start-delimiter delimiters &key errorp)
+ "Find the closing delimiter corresponding to the opening delimiter
+START-DELIMITER in a list DELIMITERS which is formatted like
+*OUTER-DELIMITERS*. If ERRORP is true, signal an error if none was
+found, otherwise return NIL."
+ (loop for element in delimiters
+ if (eql start-delimiter element)
+ do (return-from get-end-delimiter start-delimiter)
+ else if (and (consp element)
+ (char= start-delimiter (car element)))
+ do (return-from get-end-delimiter (cdr element)))
+ (when errorp
+ (signal-reader-error "~S not allowed as a delimiter here" start-delimiter)))
+
+(declaim (inline make-collector))
+(defun make-collector ()
+ "Create an empty string which can be extended by
+VECTOR-PUSH-EXTEND."
+ (make-array 0
+ :element-type 'character
+ :fill-pointer t
+ :adjustable t))
+
+(declaim (inline make-char-from-code))
+(defun make-char-from-code (number)
+ "Create character from char-code NUMBER. NUMBER can be NIL which is
+interpreted as 0."
+ ;; Only look at rightmost eight bits in compliance with Perl
+ (let ((code (logand #o377 (or number 0))))
+ (or (and (< code char-code-limit)
+ (code-char code))
+ (signal-reader-error "No character for char-code #x~X"
+ number))))
+
+(declaim (inline lower-case-p*))
+(defun lower-case-p* (char)
+ "Whether CHAR is a character which has case and is lowercase."
+ (or (not (both-case-p char))
+ (lower-case-p char)))
+
+(defmacro read-char* ()
+ "Convenience macro because we always read from the same string with
+the same arguments."
+ `(read-char *stream* t nil t))
+
+(defmacro peek-char* ()
+ "Convenience macro because we always peek at the same string with
+the same arguments."
+ `(peek-char nil *stream* t nil t))
+
+(declaim (inline copy-readtable*))
+(defun copy-readtable* ()
+ "Returns a copy of the readtable which was current when
+INTERPOL-READER was invoked. Memoizes its result."
+ (or *readtable-copy*
+ (setq *readtable-copy* (copy-readtable))))
+
+(declaim (inline nsubvec))
+(defun nsubvec (sequence start &optional (end (length sequence)))
+ "Return a subvector by pointing to location in original vector."
+ (make-array (- end start)
+ :element-type (array-element-type sequence)
+ :displaced-to sequence
+ :displaced-index-offset start))
1
0
[bknr-cvs] r2205 - in branches/trunk-reorg/thirdparty: . puri-1.5.1 trivial-gray-streams-2006-09-16 trivial-gray-streams-2006-09-16/CVS
by bknrï¼ bknr.net 04 Oct '07
by bknrï¼ bknr.net 04 Oct '07
04 Oct '07
Author: hhubner
Date: 2007-10-04 15:13:23 -0400 (Thu, 04 Oct 2007)
New Revision: 2205
Added:
branches/trunk-reorg/thirdparty/puri-1.5.1/
branches/trunk-reorg/thirdparty/puri-1.5.1/LICENSE
branches/trunk-reorg/thirdparty/puri-1.5.1/README
branches/trunk-reorg/thirdparty/puri-1.5.1/puri.asd
branches/trunk-reorg/thirdparty/puri-1.5.1/src.lisp
branches/trunk-reorg/thirdparty/puri-1.5.1/tests.lisp
branches/trunk-reorg/thirdparty/puri-1.5.1/uri.html
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/COPYING
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Entries
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Repository
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Root
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/Makefile
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/README
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/mixin.lisp
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/package.lisp
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/trivial-gray-streams.asd
Log:
updating
Added: branches/trunk-reorg/thirdparty/puri-1.5.1/LICENSE
===================================================================
--- branches/trunk-reorg/thirdparty/puri-1.5.1/LICENSE 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/puri-1.5.1/LICENSE 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,574 @@
+Copyright (c) 1999-2001 Franz, Inc.
+Copyright (c) 2003 Kevin Rosenberg
+All rights reserved.
+
+PURI is licensed under the terms of the Lisp Lesser GNU Public
+License, known as the LLGPL. The LLGPL consists of a preamble (see
+below) and the Lessor GNU Public License 2.1 (LGPL-2.1). Where these
+conflict, the preamble takes precedence. PURI is referenced in the
+preamble as the "LIBRARY."
+
+PURI is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.
+
+
+
+Preamble to the Gnu Lesser General Public License
+-------------------------------------------------
+Copyright (c) 2000 Franz Incorporated, Berkeley, CA 94704
+
+The concept of the GNU Lesser General Public License version 2.1
+("LGPL") has been adopted to govern the use and distribution of
+above-mentioned application. However, the LGPL uses terminology that
+is more appropriate for a program written in C than one written in
+Lisp. Nevertheless, the LGPL can still be applied to a Lisp program if
+certain clarifications are made. This document details those
+clarifications. Accordingly, the license for the open-source Lisp
+applications consists of this document plus the LGPL. Wherever there
+is a conflict between this document and the LGPL, this document takes
+precedence over the LGPL.
+
+A "Library" in Lisp is a collection of Lisp functions, data and
+foreign modules. The form of the Library can be Lisp source code (for
+processing by an interpreter) or object code (usually the result of
+compilation of source code or built with some other
+mechanisms). Foreign modules are object code in a form that can be
+linked into a Lisp executable. When we speak of functions we do so in
+the most general way to include, in addition, methods and unnamed
+functions. Lisp "data" is also a general term that includes the data
+structures resulting from defining Lisp classes. A Lisp application
+may include the same set of Lisp objects as does a Library, but this
+does not mean that the application is necessarily a "work based on the
+Library" it contains.
+
+The Library consists of everything in the distribution file set before
+any modifications are made to the files. If any of the functions or
+classes in the Library are redefined in other files, then those
+redefinitions ARE considered a work based on the Library. If
+additional methods are added to generic functions in the Library,
+those additional methods are NOT considered a work based on the
+Library. If Library classes are subclassed, these subclasses are NOT
+considered a work based on the Library. If the Library is modified to
+explicitly call other functions that are neither part of Lisp itself
+nor an available add-on module to Lisp, then the functions called by
+the modified Library ARE considered a work based on the Library. The
+goal is to ensure that the Library will compile and run without
+getting undefined function errors.
+
+It is permitted to add proprietary source code to the Library, but it
+must be done in a way such that the Library will still run without
+that proprietary code present. Section 5 of the LGPL distinguishes
+between the case of a library being dynamically linked at runtime and
+one being statically linked at build time. Section 5 of the LGPL
+states that the former results in an executable that is a "work that
+uses the Library." Section 5 of the LGPL states that the latter
+results in one that is a "derivative of the Library", which is
+therefore covered by the LGPL. Since Lisp only offers one choice,
+which is to link the Library into an executable at build time, we
+declare that, for the purpose applying the LGPL to the Library, an
+executable that results from linking a "work that uses the Library"
+with the Library is considered a "work that uses the Library" and is
+therefore NOT covered by the LGPL.
+
+Because of this declaration, section 6 of LGPL is not applicable to
+the Library. However, in connection with each distribution of this
+executable, you must also deliver, in accordance with the terms and
+conditions of the LGPL, the source code of Library (or your derivative
+thereof) that is incorporated into this executable.
+
+
+
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL. It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+ This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it. You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations
+below.
+
+ When we speak of free software, we are referring to freedom of use,
+not price. Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+ To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights. These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+ For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you. You must make sure that they, too, receive or can get the source
+code. If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it. And you must show them these terms so they know their rights.
+
+ We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+ To protect each distributor, we want to make it very clear that
+there is no warranty for the free library. Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+^L
+ Finally, software patents pose a constant threat to the existence of
+any free program. We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder. Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+ Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License. This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License. We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+ When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library. The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom. The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+ We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License. It also provides other free software developers Less
+of an advantage over competing non-free programs. These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries. However, the Lesser license provides advantages in certain
+special circumstances.
+
+ For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it
+becomes a de-facto standard. To achieve this, non-free programs must
+be allowed to use the library. A more frequent case is that a free
+library does the same job as widely used non-free libraries. In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+ In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software. For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+ Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+ The precise terms and conditions for copying, distribution and
+modification follow. Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library". The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+^L
+ GNU LESSER GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+ A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+ The "Library", below, refers to any such software library or work
+which has been distributed under these terms. A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language. (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+ "Source code" for a work means the preferred form of the work for
+making modifications to it. For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control
+compilation and installation of the library.
+
+ Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it). Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+ 1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+ You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+ 2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) The modified work must itself be a software library.
+
+ b) You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ c) You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+
+ d) If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library. To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License. (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.) Do not make any other change in
+these notices.
+^L
+ Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+ This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+ 4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+ If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library". Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+ However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library". The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+ When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library. The
+threshold for this to be true is not precisely defined by law.
+
+ If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work. (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+ Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+^L
+ 6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+ You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License. You must supply a copy of this License. If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License. Also, you must do one
+of these things:
+
+ a) Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood
+ that the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+
+ b) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (1) uses at run time a
+ copy of the library already present on the user's computer system,
+ rather than copying library functions into the executable, and (2)
+ will operate properly with a modified version of the library, if
+ the user installs one, as long as the modified version is
+ interface-compatible with the version that the work was made with.
+
+ c) Accompany the work with a written offer, valid for at least
+ three years, to give the same user the materials specified in
+ Subsection 6a, above, for a charge no more than the cost of
+ performing this distribution.
+
+ d) If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+
+ e) Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+
+ For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it. However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+ It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system. Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+^L
+ 7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+ a) Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+
+ b) Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+
+ 8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License. Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License. However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+ 9. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Library or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+ 10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+^L
+ 11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all. For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply, and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License
+may add an explicit geographical distribution limitation excluding those
+countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation. If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+^L
+ 14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission. For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this. Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+ NO WARRANTY
+
+ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+^L
+ How to Apply These Terms to Your New Libraries
+
+ If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change. You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms
+of the ordinary General Public License).
+
+ To apply these terms, attach the following notices to the library.
+It is safest to attach them to the start of each source file to most
+effectively convey the exclusion of warranty; and each file should
+have at least the "copyright" line and a pointer to where the full
+notice is found.
+
+
+ <one line to give the library's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ This library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Added: branches/trunk-reorg/thirdparty/puri-1.5.1/README
===================================================================
--- branches/trunk-reorg/thirdparty/puri-1.5.1/README 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/puri-1.5.1/README 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,46 @@
+PURI - Portable URI Library
+===========================
+
+AUTHORS
+-------
+Franz, Inc <http://www.franz.com>
+Kevin Rosenberg <kevin(a)rosenberg.net>
+
+
+DOWNLOAD
+--------
+Puri home: http://files.b9.com/puri/
+Portable tester home: http://files.b9.com/tester/
+
+
+SUPPORTED PLATFORMS
+-------------------
+ AllegroCL, CLISP, CMUCL, Lispworks, OpenMCL, SBCL
+
+
+OVERVIEW
+--------
+This is portable Universal Resource Identifier library for Common Lisp
+programs. It parses URI according to the RFC 2396 specification. It's
+is based on Franz, Inc's opensource URI package and has been ported to
+work other CL implementations. It is licensed under the LLGPL which
+is included in this distribution.
+
+A regression suite is included which uses Franz's open-source tester
+library. I've ported that library for use on other CL
+implementations. Puri completes 126/126 regression tests successfully.
+
+Franz's unmodified documentation file is included in the file
+uri.html.
+
+
+DIFFERENCES BETWEEN PURI and NET.URI
+------------------------------------
+
+* Puri uses the package 'puri while NET.URI uses the package 'net.uri
+
+* To signal an error parsing a URI, Puri uses the condition
+ :uri-parse-error while NET.URI uses the condition :parse-error. This
+ divergence occurs because Franz's parse-error condition uses
+ :format-control and :format-arguments slots which are not in the ANSI
+ specification for the parse-error condition.
Added: branches/trunk-reorg/thirdparty/puri-1.5.1/puri.asd
===================================================================
--- branches/trunk-reorg/thirdparty/puri-1.5.1/puri.asd 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/puri-1.5.1/puri.asd 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,33 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; Programmer: Kevin Rosenberg
+
+
+(in-package #:cl-user)
+(defpackage #:puri-system (:use #:cl #:asdf))
+(in-package #:puri-system)
+
+
+(defsystem puri
+ :name "cl-puri"
+ :maintainer "Kevin M. Rosenberg <kmr(a)debian.org>"
+ :licence "GNU Lesser General Public License"
+ :description "Portable Universal Resource Indentifier Library"
+ :components
+ ((:file "src")))
+
+(defmethod perform ((o test-op) (c (eql (find-system 'puri))))
+ (oos 'load-op 'puri-tests)
+ (oos 'test-op 'puri-tests))
+
+(defsystem puri-tests
+ :depends-on (:puri :ptester)
+ :components
+ ((:file "tests")))
+
+(defmethod perform ((o test-op) (c (eql (find-system 'puri-tests))))
+ (or (funcall (intern (symbol-name '#:do-tests)
+ (find-package :puri-tests)))
+ (error "test-op failed")))
+
+(defmethod operation-done-p ((o test-op) (c (eql (find-system 'puri-tests))))
+ (values nil))
Added: branches/trunk-reorg/thirdparty/puri-1.5.1/src.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/puri-1.5.1/src.lisp 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/puri-1.5.1/src.lisp 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,1419 @@
+;; -*- mode: common-lisp; package: puri -*-
+;; Support for URIs
+;; For general URI information see RFC2396.
+;;
+;; copyright (c) 1999-2002 Franz Inc, Berkeley, CA - All rights reserved.
+;; copyright (c) 2002-2005 Franz Inc, Oakland, CA - All rights reserved.
+;; copyright (c) 2003-2006 Kevin Rosenberg (porting changes)
+;;
+;; This code is free software; you can redistribute it and/or
+;; modify it under the terms of the version 2.1 of
+;; the GNU Lesser General Public License as published by
+;; the Free Software Foundation, as clarified by the
+;; preamble found here:
+;; http://opensource.franz.com/preamble.html
+;;
+;; Versions ported from Franz's opensource release
+;; uri.cl,v 2.3.6.4.2.1 2001/08/09 17:42:39 layer
+;; uri.cl,v 2.9.84.1 2005/08/11 18:38:52 layer
+
+;; This code is distributed in the hope that it will be useful,
+;; but without any warranty; without even the implied warranty of
+;; merchantability or fitness for a particular purpose. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; $Id: src.lisp 11328 2006-12-02 15:43:07Z kevin $
+
+(defpackage #:puri
+ (:use #:cl)
+ #-allegro (:nicknames #:net.uri)
+ (:export
+ #:uri ; the type and a function
+ #:uri-p
+ #:copy-uri
+
+ #:uri-scheme ; and slots
+ #:uri-host #:uri-port
+ #:uri-path
+ #:uri-query
+ #:uri-fragment
+ #:uri-plist
+ #:uri-authority ; pseudo-slot accessor
+
+ #:urn ; class
+ #:urn-nid ; pseudo-slot accessor
+ #:urn-nss ; pseudo-slot accessor
+
+ #:*strict-parse*
+ #:parse-uri
+ #:merge-uris
+ #:enough-uri
+ #:uri-parsed-path
+ #:render-uri
+
+ #:make-uri-space ; interning...
+ #:uri-space
+ #:uri=
+ #:intern-uri
+ #:unintern-uri
+ #:do-all-uris
+
+ #:uri-parse-error ;; Added by KMR
+ ))
+
+(in-package #:puri)
+
+(eval-when (:compile-toplevel) (declaim (optimize (speed 3))))
+
+
+#-allegro
+(defun parse-body (forms &optional env)
+ "Parses a body, returns (VALUES docstring declarations forms)"
+ (declare (ignore env))
+ ;; fixme -- need to add parsing of multiple declarations
+ (let (docstring declarations)
+ (when (stringp (car forms))
+ (setq docstring (car forms))
+ (setq forms (cdr forms)))
+ (when (and (listp (car forms))
+ (symbolp (caar forms))
+ (string-equal (symbol-name '#:declare)
+ (symbol-name (caar forms))))
+ (setq declarations (car forms))
+ (setq forms (cdr forms)))
+ (values docstring declarations forms)))
+
+
+(defun shrink-vector (str size)
+ #+allegro
+ (excl::.primcall 'sys::shrink-svector str size)
+ #+sbcl
+ (setq str (sb-kernel:shrink-vector str size))
+ #+cmu
+ (lisp::shrink-vector str size)
+ #+lispworks
+ (system::shrink-vector$vector str size)
+ #+scl
+ (common-lisp::shrink-vector str size)
+ #-(or allegro cmu lispworks sbcl scl)
+ (setq str (subseq str 0 size))
+ str)
+
+
+;; KMR: Added new condition to handle cross-implementation variances
+;; in the parse-error condition many implementations define
+
+(define-condition uri-parse-error (parse-error)
+ ((fmt-control :initarg :fmt-control :accessor fmt-control)
+ (fmt-arguments :initarg :fmt-arguments :accessor fmt-arguments ))
+ (:report (lambda (c stream)
+ (format stream "Parse error:")
+ (apply #'format stream (fmt-control c) (fmt-arguments c)))))
+
+(defun .parse-error (fmt &rest args)
+ (error 'uri-parse-error :fmt-control fmt :fmt-arguments args))
+
+#-allegro
+(defun internal-reader-error (stream fmt &rest args)
+ (apply #'format stream fmt args))
+
+#-allegro (defvar *current-case-mode* :case-insensitive-upper)
+#+allegro (eval-when (:compile-toplevel :load-toplevel :execute)
+ (import '(excl:*current-case-mode*
+ excl:delimited-string-to-list
+ excl::parse-body
+ excl::internal-reader-error
+ excl:if*)))
+
+#-allegro
+(defmethod position-char (char (string string) start max)
+ (declare (optimize (speed 3) (safety 0) (space 0))
+ (fixnum start max) (string string))
+ (do* ((i start (1+ i)))
+ ((= i max) nil)
+ (declare (fixnum i))
+ (when (char= char (char string i)) (return i))))
+
+#-allegro
+(defun delimited-string-to-list (string &optional (separator #\space)
+ skip-terminal)
+ (declare (optimize (speed 3) (safety 0) (space 0)
+ (compilation-speed 0))
+ (type string string)
+ (type character separator))
+ (do* ((len (length string))
+ (output '())
+ (pos 0)
+ (end (position-char separator string pos len)
+ (position-char separator string pos len)))
+ ((null end)
+ (if (< pos len)
+ (push (subseq string pos) output)
+ (when (and (plusp len) (not skip-terminal))
+ (push "" output)))
+ (nreverse output))
+ (declare (type fixnum pos len)
+ (type (or null fixnum) end))
+ (push (subseq string pos end) output)
+ (setq pos (1+ end))))
+
+#-allegro
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar if*-keyword-list '("then" "thenret" "else" "elseif"))
+
+ (defmacro if* (&rest args)
+ (do ((xx (reverse args) (cdr xx))
+ (state :init)
+ (elseseen nil)
+ (totalcol nil)
+ (lookat nil nil)
+ (col nil))
+ ((null xx)
+ (cond ((eq state :compl)
+ `(cond ,@totalcol))
+ (t (error "if*: illegal form ~s" args))))
+ (cond ((and (symbolp (car xx))
+ (member (symbol-name (car xx))
+ if*-keyword-list
+ :test #'string-equal))
+ (setq lookat (symbol-name (car xx)))))
+
+ (cond ((eq state :init)
+ (cond (lookat (cond ((string-equal lookat "thenret")
+ (setq col nil
+ state :then))
+ (t (error
+ "if*: bad keyword ~a" lookat))))
+ (t (setq state :col
+ col nil)
+ (push (car xx) col))))
+ ((eq state :col)
+ (cond (lookat
+ (cond ((string-equal lookat "else")
+ (cond (elseseen
+ (error
+ "if*: multiples elses")))
+ (setq elseseen t)
+ (setq state :init)
+ (push `(t ,@col) totalcol))
+ ((string-equal lookat "then")
+ (setq state :then))
+ (t (error "if*: bad keyword ~s"
+ lookat))))
+ (t (push (car xx) col))))
+ ((eq state :then)
+ (cond (lookat
+ (error
+ "if*: keyword ~s at the wrong place " (car xx)))
+ (t (setq state :compl)
+ (push `(,(car xx) ,@col) totalcol))))
+ ((eq state :compl)
+ (cond ((not (string-equal lookat "elseif"))
+ (error "if*: missing elseif clause ")))
+ (setq state :init))))))
+
+
+(defclass uri ()
+ (
+;;;; external:
+ (scheme :initarg :scheme :initform nil :accessor uri-scheme)
+ (host :initarg :host :initform nil :accessor uri-host)
+ (port :initarg :port :initform nil :accessor uri-port)
+ (path :initarg :path :initform nil :accessor uri-path)
+ (query :initarg :query :initform nil :accessor uri-query)
+ (fragment :initarg :fragment :initform nil :accessor uri-fragment)
+ (plist :initarg :plist :initform nil :accessor uri-plist)
+
+;;;; internal:
+ (escaped
+ ;; used to prevent unnessary work, looking for chars to escape and
+ ;; unescape.
+ :initarg :escaped :initform nil :accessor uri-escaped)
+ (string
+ ;; the cached printable representation of the URI. It *might* be
+ ;; different than the original string, though, because the user might
+ ;; have escaped non-reserved chars--they won't be escaped when the URI
+ ;; is printed.
+ :initarg :string :initform nil :accessor uri-string)
+ (parsed-path
+ ;; the cached parsed representation of the URI path.
+ :initarg :parsed-path
+ :initform nil
+ :accessor .uri-parsed-path)
+ (hashcode
+ ;; cached sxhash, so we don't have to compute it more than once.
+ :initarg :hashcode :initform nil :accessor uri-hashcode)))
+
+(defclass urn (uri)
+ ((nid :initarg :nid :initform nil :accessor urn-nid)
+ (nss :initarg :nss :initform nil :accessor urn-nss)))
+
+(eval-when (:compile-toplevel :execute)
+ (defmacro clear-caching-on-slot-change (name)
+ `(defmethod (setf ,name) :around (new-value (self uri))
+ (declare (ignore new-value))
+ (prog1 (call-next-method)
+ (setf (uri-string self) nil)
+ ,@(when (eq name 'uri-path) `((setf (.uri-parsed-path self) nil)))
+ (setf (uri-hashcode self) nil))))
+ )
+
+(clear-caching-on-slot-change uri-scheme)
+(clear-caching-on-slot-change uri-host)
+(clear-caching-on-slot-change uri-port)
+(clear-caching-on-slot-change uri-path)
+(clear-caching-on-slot-change uri-query)
+(clear-caching-on-slot-change uri-fragment)
+
+
+(defmethod make-load-form ((self uri) &optional env)
+ (declare (ignore env))
+ `(make-instance ',(class-name (class-of self))
+ :scheme ,(uri-scheme self)
+ :host ,(uri-host self)
+ :port ,(uri-port self)
+ :path ',(uri-path self)
+ :query ,(uri-query self)
+ :fragment ,(uri-fragment self)
+ :plist ',(uri-plist self)
+ :string ,(uri-string self)
+ :parsed-path ',(.uri-parsed-path self)))
+
+(defmethod uri-p ((thing uri)) t)
+(defmethod uri-p ((thing t)) nil)
+
+(defun copy-uri (uri
+ &key place
+ (scheme (when uri (uri-scheme uri)))
+ (host (when uri (uri-host uri)))
+ (port (when uri (uri-port uri)))
+ (path (when uri (uri-path uri)))
+ (parsed-path
+ (when uri (copy-list (.uri-parsed-path uri))))
+ (query (when uri (uri-query uri)))
+ (fragment (when uri (uri-fragment uri)))
+ (plist (when uri (copy-list (uri-plist uri))))
+ (class (when uri (class-of uri)))
+ &aux (escaped (when uri (uri-escaped uri))))
+ (if* place
+ then (setf (uri-scheme place) scheme)
+ (setf (uri-host place) host)
+ (setf (uri-port place) port)
+ (setf (uri-path place) path)
+ (setf (.uri-parsed-path place) parsed-path)
+ (setf (uri-query place) query)
+ (setf (uri-fragment place) fragment)
+ (setf (uri-plist place) plist)
+ (setf (uri-escaped place) escaped)
+ (setf (uri-string place) nil)
+ (setf (uri-hashcode place) nil)
+ place
+ elseif (eq 'uri class)
+ then ;; allow the compiler to optimize the call to make-instance:
+ (make-instance 'uri
+ :scheme scheme :host host :port port :path path
+ :parsed-path parsed-path
+ :query query :fragment fragment :plist plist
+ :escaped escaped :string nil :hashcode nil)
+ else (make-instance class
+ :scheme scheme :host host :port port :path path
+ :parsed-path parsed-path
+ :query query :fragment fragment :plist plist
+ :escaped escaped :string nil :hashcode nil)))
+
+(defmethod uri-parsed-path ((uri uri))
+ (when (uri-path uri)
+ (when (null (.uri-parsed-path uri))
+ (setf (.uri-parsed-path uri)
+ (parse-path (uri-path uri) (uri-escaped uri))))
+ (.uri-parsed-path uri)))
+
+(defmethod (setf uri-parsed-path) (path-list (uri uri))
+ (assert (and (consp path-list)
+ (or (member (car path-list) '(:absolute :relative)
+ :test #'eq))))
+ (setf (uri-path uri) (render-parsed-path path-list t))
+ (setf (.uri-parsed-path uri) path-list)
+ path-list)
+
+(defun uri-authority (uri)
+ (when (uri-host uri)
+ (let ((*print-pretty* nil))
+ (format nil "~a~@[:~a~]" (uri-host uri) (uri-port uri)))))
+
+(defun uri-nid (uri)
+ (if* (equalp "urn" (uri-scheme uri))
+ then (uri-host uri)
+ else (error "URI is not a URN: ~s." uri)))
+
+(defun uri-nss (uri)
+ (if* (equalp "urn" (uri-scheme uri))
+ then (uri-path uri)
+ else (error "URI is not a URN: ~s." uri)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Parsing
+
+(defparameter *excluded-characters*
+ '(;; `delims' (except #\%, because it's handled specially):
+ #\< #\> #\" #\space #\#
+ ;; `unwise':
+ #\{ #\} #\| #\\ #\^ #\[ #\] #\`))
+
+(defun reserved-char-vector (chars &key except)
+ (do* ((a (make-array 127 :element-type 'bit :initial-element 0))
+ (chars chars (cdr chars))
+ (c (car chars) (car chars)))
+ ((null chars) a)
+ (if* (and except (member c except :test #'char=))
+ thenret
+ else (setf (sbit a (char-int c)) 1))))
+
+(defparameter *reserved-characters*
+ (reserved-char-vector
+ (append *excluded-characters*
+ '(#\; #\/ #\? #\: #\@ #\& #\= #\+ #\$ #\, #\%))))
+(defparameter *reserved-authority-characters*
+ (reserved-char-vector
+ (append *excluded-characters* '(#\; #\/ #\? #\: #\@))))
+(defparameter *reserved-path-characters*
+ (reserved-char-vector
+ (append *excluded-characters*
+ '(#\;
+;;;;The rfc says this should be here, but it doesn't make sense.
+ ;; #\=
+ #\/ #\?))))
+
+(defparameter *reserved-fragment-characters*
+ (reserved-char-vector (remove #\# *excluded-characters*)))
+
+(eval-when (:compile-toplevel :execute)
+(defun gen-char-range-list (start end)
+ (do* ((res '())
+ (endcode (1+ (char-int end)))
+ (chcode (char-int start)
+ (1+ chcode))
+ (hyphen nil))
+ ((= chcode endcode)
+ ;; - has to be first, otherwise it signifies a range!
+ (if* hyphen
+ then (setq res (nreverse res))
+ (push #\- res)
+ res
+ else (nreverse res)))
+ (if* (= #.(char-int #\-) chcode)
+ then (setq hyphen t)
+ else (push (code-char chcode) res))))
+)
+
+(defparameter *valid-nid-characters*
+ (reserved-char-vector
+ '#.(nconc (gen-char-range-list #\a #\z)
+ (gen-char-range-list #\A #\Z)
+ (gen-char-range-list #\0 #\9)
+ '(#\- #\. #\+))))
+(defparameter *reserved-nss-characters*
+ (reserved-char-vector
+ (append *excluded-characters* '(#\& #\~ #\/ #\?))))
+
+(defparameter *illegal-characters*
+ (reserved-char-vector (remove #\# *excluded-characters*)))
+(defparameter *strict-illegal-query-characters*
+ (reserved-char-vector (append '(#\?) (remove #\# *excluded-characters*))))
+(defparameter *illegal-query-characters*
+ (reserved-char-vector
+ *excluded-characters* :except '(#\^ #\| #\#)))
+
+
+(defun parse-uri (thing &key (class 'uri) &aux escape)
+ (when (uri-p thing) (return-from parse-uri thing))
+
+ (setq escape (escape-p thing))
+ (multiple-value-bind (scheme host port path query fragment)
+ (parse-uri-string thing)
+ (when scheme
+ (setq scheme
+ (intern (funcall
+ (case *current-case-mode*
+ ((:case-insensitive-upper :case-sensitive-upper)
+ #'string-upcase)
+ ((:case-insensitive-lower :case-sensitive-lower)
+ #'string-downcase))
+ (decode-escaped-encoding scheme escape))
+ (find-package :keyword))))
+
+ (when (and scheme (eq :urn scheme))
+ (return-from parse-uri
+ (make-instance 'urn :scheme scheme :nid host :nss path)))
+
+ (when host (setq host (decode-escaped-encoding host escape)))
+ (when port
+ (setq port (read-from-string port))
+ (when (not (numberp port)) (error "port is not a number: ~s." port))
+ (when (not (plusp port))
+ (error "port is not a positive integer: ~d." port))
+ (when (eql port (case scheme
+ (:http 80)
+ (:https 443)
+ (:ftp 21)
+ (:telnet 23)))
+ (setq port nil)))
+ (when (or (string= "" path)
+ (and ;; we canonicalize away a reference to just /:
+ scheme
+ (member scheme '(:http :https :ftp) :test #'eq)
+ (string= "/" path)))
+ (setq path nil))
+ (when path
+ (setq path
+ (decode-escaped-encoding path escape *reserved-path-characters*)))
+ (when query (setq query (decode-escaped-encoding query escape)))
+ (when fragment
+ (setq fragment
+ (decode-escaped-encoding fragment escape
+ *reserved-fragment-characters*)))
+ (if* (eq 'uri class)
+ then ;; allow the compiler to optimize the make-instance call:
+ (make-instance 'uri
+ :scheme scheme
+ :host host
+ :port port
+ :path path
+ :query query
+ :fragment fragment
+ :escaped escape)
+ else ;; do it the slow way:
+ (make-instance class
+ :scheme scheme
+ :host host
+ :port port
+ :path path
+ :query query
+ :fragment fragment
+ :escaped escape))))
+
+(defmethod uri ((thing uri))
+ thing)
+
+(defmethod uri ((thing string))
+ (parse-uri thing))
+
+(defmethod uri ((thing t))
+ (error "Cannot coerce ~s to a uri." thing))
+
+(defvar *strict-parse* t)
+
+(defun parse-uri-string (string &aux (illegal-chars *illegal-characters*))
+ (declare (optimize (speed 3)))
+ ;; Speed is important, so use a specialized state machine instead of
+ ;; regular expressions for parsing the URI string. The regexp we are
+ ;; simulating:
+ ;; ^(([^:/?#]+):)?
+ ;; (//([^/?#]*))?
+ ;; ([^?#]*)
+ ;; (\?([^#]*))?
+ ;; (#(.*))?
+ (let* ((state 0)
+ (start 0)
+ (end (length string))
+ (tokval nil)
+ (scheme nil)
+ (host nil)
+ (port nil)
+ (path-components '())
+ (query nil)
+ (fragment nil)
+ ;; namespace identifier, for urn parsing only:
+ (nid nil))
+ (declare (fixnum state start end))
+ (flet ((read-token (kind &optional legal-chars)
+ (setq tokval nil)
+ (if* (>= start end)
+ then :end
+ else (let ((sindex start)
+ (res nil)
+ c)
+ (declare (fixnum sindex))
+ (setq res
+ (loop
+ (when (>= start end) (return nil))
+ (setq c (char string start))
+ (let ((ci (char-int c)))
+ (if* legal-chars
+ then (if* (and (eq :colon kind) (eq c #\:))
+ then (return :colon)
+ elseif (= 0 (sbit legal-chars ci))
+ then (.parse-error
+ "~
+URI ~s contains illegal character ~s at position ~d."
+ string c start))
+ elseif (and (< ci 128)
+ *strict-parse*
+ (= 1 (sbit illegal-chars ci)))
+ then (.parse-error "~
+URI ~s contains illegal character ~s at position ~d."
+ string c start)))
+ (case kind
+ (:path (case c
+ (#\? (return :question))
+ (#\# (return :hash))))
+ (:query (case c (#\# (return :hash))))
+ (:rest)
+ (t (case c
+ (#\: (return :colon))
+ (#\? (return :question))
+ (#\# (return :hash))
+ (#\/ (return :slash)))))
+ (incf start)))
+ (if* (> start sindex)
+ then ;; we found some chars
+ ;; before we stopped the parse
+ (setq tokval (subseq string sindex start))
+ :string
+ else ;; immediately stopped at a special char
+ (incf start)
+ res))))
+ (failure (&optional why)
+ (.parse-error "illegal URI: ~s [~d]~@[: ~a~]"
+ string state why))
+ (impossible ()
+ (.parse-error "impossible state: ~d [~s]" state string)))
+ (loop
+ (case state
+ (0 ;; starting to parse
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:slash (setq state 3))
+ (:string (setq state 1))
+ (:end (setq state 9))))
+ (1 ;; seen <token><special char>
+ (let ((token tokval))
+ (ecase (read-token t)
+ (:colon (setq scheme token)
+ (if* (equalp "urn" scheme)
+ then (setq state 15)
+ else (setq state 2)))
+ (:question (push token path-components)
+ (setq state 7))
+ (:hash (push token path-components)
+ (setq state 8))
+ (:slash (push token path-components)
+ (push "/" path-components)
+ (setq state 6))
+ (:string (failure))
+ (:end (push token path-components)
+ (setq state 9)))))
+ (2 ;; seen <scheme>:
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:slash (setq state 3))
+ (:string (setq state 10))
+ (:end (setq state 9))))
+ (10 ;; seen <scheme>:<token>
+ (let ((token tokval))
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (push token path-components)
+ (setq state 7))
+ (:hash (push token path-components)
+ (setq state 8))
+ (:slash (push token path-components)
+ (setq state 6))
+ (:string (failure))
+ (:end (push token path-components)
+ (setq state 9)))))
+ (3 ;; seen / or <scheme>:/
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (push "/" path-components)
+ (setq state 7))
+ (:hash (push "/" path-components)
+ (setq state 8))
+ (:slash (setq state 4))
+ (:string (push "/" path-components)
+ (push tokval path-components)
+ (setq state 6))
+ (:end (push "/" path-components)
+ (setq state 9))))
+ (4 ;; seen [<scheme>:]//
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (failure))
+ (:hash (failure))
+ (:slash
+ (if* (and (equalp "file" scheme)
+ (null host))
+ then ;; file:///...
+ (push "/" path-components)
+ (setq state 6)
+ else (failure)))
+ (:string (setq host tokval)
+ (setq state 11))
+ (:end (failure))))
+ (11 ;; seen [<scheme>:]//<host>
+ (ecase (read-token t)
+ (:colon (setq state 5))
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:slash (push "/" path-components)
+ (setq state 6))
+ (:string (impossible))
+ (:end (setq state 9))))
+ (5 ;; seen [<scheme>:]//<host>:
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (failure))
+ (:hash (failure))
+ (:slash (push "/" path-components)
+ (setq state 6))
+ (:string (setq port tokval)
+ (setq state 12))
+ (:end (failure))))
+ (12 ;; seen [<scheme>:]//<host>:[<port>]
+ (ecase (read-token t)
+ (:colon (failure))
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:slash (push "/" path-components)
+ (setq state 6))
+ (:string (impossible))
+ (:end (setq state 9))))
+ (6 ;; seen /
+ (ecase (read-token :path)
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:string (push tokval path-components)
+ (setq state 13))
+ (:end (setq state 9))))
+ (13 ;; seen path
+ (ecase (read-token :path)
+ (:question (setq state 7))
+ (:hash (setq state 8))
+ (:string (impossible))
+ (:end (setq state 9))))
+ (7 ;; seen ?
+ (setq illegal-chars
+ (if* *strict-parse*
+ then *strict-illegal-query-characters*
+ else *illegal-query-characters*))
+ (ecase (prog1 (read-token :query)
+ (setq illegal-chars *illegal-characters*))
+ (:hash (setq state 8))
+ (:string (setq query tokval)
+ (setq state 14))
+ (:end (setq state 9))))
+ (14 ;; query
+ (ecase (read-token :query)
+ (:hash (setq state 8))
+ (:string (impossible))
+ (:end (setq state 9))))
+ (8 ;; seen #
+ (ecase (read-token :rest)
+ (:string (setq fragment tokval)
+ (setq state 9))
+ (:end (setq state 9))))
+ (9 ;; done
+ (return
+ (values
+ scheme host port
+ (apply #'concatenate 'string (nreverse path-components))
+ query fragment)))
+ ;; URN parsing:
+ (15 ;; seen urn:, read nid now
+ (case (read-token :colon *valid-nid-characters*)
+ (:string (setq nid tokval)
+ (setq state 16))
+ (t (failure "missing namespace identifier"))))
+ (16 ;; seen urn:<nid>
+ (case (read-token t)
+ (:colon (setq state 17))
+ (t (failure "missing namespace specific string"))))
+ (17 ;; seen urn:<nid>:, rest is nss
+ (return (values scheme
+ nid
+ nil
+ (progn
+ (setq illegal-chars *reserved-nss-characters*)
+ (read-token :rest)
+ tokval))))
+ (t (.parse-error
+ "internal error in parse engine, wrong state: ~s." state)))))))
+
+(defun escape-p (string)
+ (declare (optimize (speed 3)))
+ (do* ((i 0 (1+ i))
+ (max (the fixnum (length string))))
+ ((= i max) nil)
+ (declare (fixnum i max))
+ (when (char= #\% (char string i))
+ (return t))))
+
+(defun parse-path (path-string escape)
+ (do* ((xpath-list (delimited-string-to-list path-string #\/))
+ (path-list
+ (progn
+ (if* (string= "" (car xpath-list))
+ then (setf (car xpath-list) :absolute)
+ else (push :relative xpath-list))
+ xpath-list))
+ (pl (cdr path-list) (cdr pl))
+ segments)
+ ((null pl) path-list)
+
+ (if* (cdr (setq segments
+ (if* (string= "" (car pl))
+ then '("")
+ else (delimited-string-to-list (car pl) #\;))))
+ then ;; there is a param
+ (setf (car pl)
+ (mapcar #'(lambda (s)
+ (decode-escaped-encoding s escape
+ ;; decode all %xx:
+ nil))
+ segments))
+ else ;; no param
+ (setf (car pl)
+ (decode-escaped-encoding (car segments) escape
+ ;; decode all %xx:
+ nil)))))
+
+(defun decode-escaped-encoding (string escape
+ &optional (reserved-chars
+ *reserved-characters*))
+ ;; Return a string with the real characters.
+ (when (null escape) (return-from decode-escaped-encoding string))
+ (do* ((i 0 (1+ i))
+ (max (length string))
+ (new-string (copy-seq string))
+ (new-i 0 (1+ new-i))
+ ch ch2 chc chc2)
+ ((= i max)
+ (shrink-vector new-string new-i))
+ (if* (char= #\% (setq ch (char string i)))
+ then (when (> (+ i 3) max)
+ (.parse-error
+ "Unsyntactic escaped encoding in ~s." string))
+ (setq ch (char string (incf i)))
+ (setq ch2 (char string (incf i)))
+ (when (not (and (setq chc (digit-char-p ch 16))
+ (setq chc2 (digit-char-p ch2 16))))
+ (.parse-error
+ "Non-hexidecimal digits after %: %c%c." ch ch2))
+ (let ((ci (+ (* 16 chc) chc2)))
+ (if* (or (null reserved-chars)
+ (> ci 127) ; bug11527
+ (= 0 (sbit reserved-chars ci)))
+ then ;; ok as is
+ (setf (char new-string new-i)
+ (code-char ci))
+ else (setf (char new-string new-i) #\%)
+ (setf (char new-string (incf new-i)) ch)
+ (setf (char new-string (incf new-i)) ch2)))
+ else (setf (char new-string new-i) ch))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Printing
+
+(defun render-uri (uri stream
+ &aux (escape (uri-escaped uri))
+ (*print-pretty* nil))
+ (when (null (uri-string uri))
+ (setf (uri-string uri)
+ (let ((scheme (uri-scheme uri))
+ (host (uri-host uri))
+ (port (uri-port uri))
+ (path (uri-path uri))
+ (query (uri-query uri))
+ (fragment (uri-fragment uri)))
+ (concatenate 'string
+ (when scheme
+ (encode-escaped-encoding
+ (string-downcase ;; for upper case lisps
+ (symbol-name scheme))
+ *reserved-characters* escape))
+ (when scheme ":")
+ (when (or host (eq :file scheme)) "//")
+ (when host
+ (encode-escaped-encoding
+ host *reserved-authority-characters* escape))
+ (when port ":")
+ (when port
+ #-allegro (format nil "~D" port)
+ #+allegro (with-output-to-string (s)
+ (excl::maybe-print-fast s port))
+ )
+ (when path
+ (encode-escaped-encoding path
+ nil
+ ;;*reserved-path-characters*
+ escape))
+ (when query "?")
+ (when query (encode-escaped-encoding query nil escape))
+ (when fragment "#")
+ (when fragment (encode-escaped-encoding fragment nil escape))))))
+ (if* stream
+ then (format stream "~a" (uri-string uri))
+ else (uri-string uri)))
+
+(defun render-parsed-path (path-list escape)
+ (do* ((res '())
+ (first (car path-list))
+ (pl (cdr path-list) (cdr pl))
+ (pe (car pl) (car pl)))
+ ((null pl)
+ (when res (apply #'concatenate 'string (nreverse res))))
+ (when (or (null first)
+ (prog1 (eq :absolute first)
+ (setq first nil)))
+ (push "/" res))
+ (if* (atom pe)
+ then (push
+ (encode-escaped-encoding pe *reserved-path-characters* escape)
+ res)
+ else ;; contains params
+ (push (encode-escaped-encoding
+ (car pe) *reserved-path-characters* escape)
+ res)
+ (dolist (item (cdr pe))
+ (push ";" res)
+ (push (encode-escaped-encoding
+ item *reserved-path-characters* escape)
+ res)))))
+
+(defun render-urn (urn stream
+ &aux (*print-pretty* nil))
+ (when (null (uri-string urn))
+ (setf (uri-string urn)
+ (let ((nid (urn-nid urn))
+ (nss (urn-nss urn)))
+ (concatenate 'string "urn:" nid ":" nss))))
+ (if* stream
+ then (format stream "~a" (uri-string urn))
+ else (uri-string urn)))
+
+(defparameter *escaped-encoding*
+ (vector #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\f))
+
+(defun encode-escaped-encoding (string reserved-chars escape)
+ (when (null escape) (return-from encode-escaped-encoding string))
+ ;; Make a string as big as it possibly needs to be (3 times the original
+ ;; size), and truncate it at the end.
+ (do* ((max (length string))
+ (new-max (* 3 max)) ;; worst case new size
+ (new-string (make-string new-max))
+ (i 0 (1+ i))
+ (new-i -1)
+ c ci)
+ ((= i max)
+ (shrink-vector new-string (incf new-i)))
+ (setq ci (char-int (setq c (char string i))))
+ (if* (or (null reserved-chars)
+ (> ci 127)
+ (= 0 (sbit reserved-chars ci)))
+ then ;; ok as is
+ (incf new-i)
+ (setf (char new-string new-i) c)
+ else ;; need to escape it
+ (multiple-value-bind (q r) (truncate ci 16)
+ (setf (char new-string (incf new-i)) #\%)
+ (setf (char new-string (incf new-i)) (elt *escaped-encoding* q))
+ (setf (char new-string (incf new-i))
+ (elt *escaped-encoding* r))))))
+
+(defmethod print-object ((uri uri) stream)
+ (if* *print-escape*
+ then (print-unreadable-object (uri stream :type t) (render-uri uri stream))
+ else (render-uri uri stream)))
+
+(defmethod print-object ((urn urn) stream)
+ (if* *print-escape*
+ then (print-unreadable-object (urn stream :type t) (render-urn urn stream))
+ else (render-urn urn stream)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; merging and unmerging
+
+(defmethod merge-uris ((uri string) (base string) &optional place)
+ (merge-uris (parse-uri uri) (parse-uri base) place))
+
+(defmethod merge-uris ((uri uri) (base string) &optional place)
+ (merge-uris uri (parse-uri base) place))
+
+(defmethod merge-uris ((uri string) (base uri) &optional place)
+ (merge-uris (parse-uri uri) base place))
+
+
+(defmethod merge-uris ((uri uri) (base uri) &optional place)
+ ;; See ../doc/rfc2396.txt for info on the algorithm we use to merge
+ ;; URIs.
+ ;;
+ (tagbody
+;;;; step 2
+ (when (and (null (uri-parsed-path uri))
+ (null (uri-scheme uri))
+ (null (uri-host uri))
+ (null (uri-port uri))
+ (null (uri-query uri)))
+ (return-from merge-uris
+ (let ((new (copy-uri base :place place)))
+ (when (uri-query uri)
+ (setf (uri-query new) (uri-query uri)))
+ (when (uri-fragment uri)
+ (setf (uri-fragment new) (uri-fragment uri)))
+ new)))
+
+ (setq uri (copy-uri uri :place place))
+
+;;;; step 3
+ (when (uri-scheme uri)
+ (return-from merge-uris uri))
+ (setf (uri-scheme uri) (uri-scheme base))
+
+;;;; step 4
+ (when (uri-host uri) (go :done))
+ (setf (uri-host uri) (uri-host base))
+ (setf (uri-port uri) (uri-port base))
+
+;;;; step 5
+ (let ((p (uri-parsed-path uri)))
+
+ ;; bug13133:
+ ;; The following form causes our implementation to be at odds with
+ ;; RFC 2396, however this is apparently what was intended by the
+ ;; authors of the RFC. Specifically, (merge-uris "?y" "/foo")
+ ;; should return #<uri /foo?y> instead of #<uri ?y>, according to
+ ;; this:
+;;; http://www.apache.org/~fielding/uri/rev-2002/issues.html#003-relative-query
+ (when (null p)
+ (setf (uri-path uri) (uri-path base))
+ (go :done))
+
+ (when (and p (eq :absolute (car p)))
+ (when (equal '(:absolute "") p)
+ ;; Canonicalize the way parsing does:
+ (setf (uri-path uri) nil))
+ (go :done)))
+
+;;;; step 6
+ (let* ((base-path
+ (or (uri-parsed-path base)
+ ;; needed because we canonicalize away a path of just `/':
+ '(:absolute "")))
+ (path (uri-parsed-path uri))
+ new-path-list)
+ (when (not (eq :absolute (car base-path)))
+ (error "Cannot merge ~a and ~a, since latter is not absolute."
+ uri base))
+
+ ;; steps 6a and 6b:
+ (setq new-path-list
+ (append (butlast base-path)
+ (if* path then (cdr path) else '(""))))
+
+ ;; steps 6c and 6d:
+ (let ((last (last new-path-list)))
+ (if* (atom (car last))
+ then (when (string= "." (car last))
+ (setf (car last) ""))
+ else (when (string= "." (caar last))
+ (setf (caar last) ""))))
+ (setq new-path-list
+ (delete "." new-path-list :test #'(lambda (a b)
+ (if* (atom b)
+ then (string= a b)
+ else nil))))
+
+ ;; steps 6e and 6f:
+ (let ((npl (cdr new-path-list))
+ index tmp fix-tail)
+ (setq fix-tail
+ (string= ".." (let ((l (car (last npl))))
+ (if* (atom l)
+ then l
+ else (car l)))))
+ (loop
+ (setq index
+ (position ".." npl
+ :test #'(lambda (a b)
+ (string= a
+ (if* (atom b)
+ then b
+ else (car b))))))
+ (when (null index) (return))
+ (when (= 0 index)
+ ;; The RFC says, in 6g, "that the implementation may handle
+ ;; this error by retaining these components in the resolved
+ ;; path, by removing them from the resolved path, or by
+ ;; avoiding traversal of the reference." The examples in C.2
+ ;; imply that we should do the first thing (retain them), so
+ ;; that's what we'll do.
+ (return))
+ (if* (= 1 index)
+ then (setq npl (cddr npl))
+ else (setq tmp npl)
+ (dotimes (x (- index 2)) (setq tmp (cdr tmp)))
+ (setf (cdr tmp) (cdddr tmp))))
+ (setf (cdr new-path-list) npl)
+ (when fix-tail (setq new-path-list (nconc new-path-list '("")))))
+
+ ;; step 6g:
+ ;; don't complain if new-path-list starts with `..'. See comment
+ ;; above about this step.
+
+ ;; step 6h:
+ (when (or (equal '(:absolute "") new-path-list)
+ (equal '(:absolute) new-path-list))
+ (setq new-path-list nil))
+ (setf (uri-path uri)
+ (render-parsed-path new-path-list
+ ;; don't know, so have to assume:
+ t)))
+
+;;;; step 7
+ :done
+ (return-from merge-uris uri)))
+
+(defmethod enough-uri ((uri string) (base string) &optional place)
+ (enough-uri (parse-uri uri) (parse-uri base) place))
+
+(defmethod enough-uri ((uri uri) (base string) &optional place)
+ (enough-uri uri (parse-uri base) place))
+
+(defmethod enough-uri ((uri string) (base uri) &optional place)
+ (enough-uri (parse-uri uri) base place))
+
+(defmethod enough-uri ((uri uri) (base uri) &optional place)
+ (let ((new-scheme nil)
+ (new-host nil)
+ (new-port nil)
+ (new-parsed-path nil))
+
+ (when (or (and (uri-scheme uri)
+ (not (equalp (uri-scheme uri) (uri-scheme base))))
+ (and (uri-host uri)
+ (not (equalp (uri-host uri) (uri-host base))))
+ (not (equalp (uri-port uri) (uri-port base))))
+ (return-from enough-uri uri))
+
+ (when (null (uri-host uri))
+ (setq new-host (uri-host base)))
+ (when (null (uri-port uri))
+ (setq new-port (uri-port base)))
+
+ (when (null (uri-scheme uri))
+ (setq new-scheme (uri-scheme base)))
+
+ ;; Now, for the hard one, path.
+ ;; We essentially do here what enough-namestring does.
+ (do* ((base-path (uri-parsed-path base))
+ (path (uri-parsed-path uri))
+ (bp base-path (cdr bp))
+ (p path (cdr p)))
+ ((or (null bp) (null p))
+ ;; If p is nil, that means we have something like
+ ;; (enough-uri "/foo/bar" "/foo/bar/baz.htm"), so
+ ;; new-parsed-path will be nil.
+ (when (null bp)
+ (setq new-parsed-path (copy-list p))
+ (when (not (symbolp (car new-parsed-path)))
+ (push :relative new-parsed-path))))
+ (if* (equal (car bp) (car p))
+ thenret ;; skip it
+ else (setq new-parsed-path (copy-list p))
+ (when (not (symbolp (car new-parsed-path)))
+ (push :relative new-parsed-path))
+ (return)))
+
+ (let ((new-path
+ (when new-parsed-path
+ (render-parsed-path new-parsed-path
+ ;; don't know, so have to assume:
+ t)))
+ (new-query (uri-query uri))
+ (new-fragment (uri-fragment uri))
+ (new-plist (copy-list (uri-plist uri))))
+ (if* (and (null new-scheme)
+ (null new-host)
+ (null new-port)
+ (null new-path)
+ (null new-parsed-path)
+ (null new-query)
+ (null new-fragment))
+ then ;; can't have a completely empty uri!
+ (copy-uri nil
+ :class (class-of uri)
+ :place place
+ :path "/"
+ :plist new-plist)
+ else (copy-uri nil
+ :class (class-of uri)
+ :place place
+ :scheme new-scheme
+ :host new-host
+ :port new-port
+ :path new-path
+ :parsed-path new-parsed-path
+ :query new-query
+ :fragment new-fragment
+ :plist new-plist)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; support for interning URIs
+
+(defun make-uri-space (&rest keys &key (size 777) &allow-other-keys)
+ #+allegro
+ (apply #'make-hash-table :size size
+ :hash-function 'uri-hash
+ :test 'uri= :values nil keys)
+ #-allegro
+ (apply #'make-hash-table :size size keys))
+
+(defun gethash-uri (uri table)
+ #+allegro (gethash uri table)
+ #-allegro
+ (let* ((hash (uri-hash uri))
+ (existing (gethash hash table)))
+ (dolist (u existing)
+ (when (uri= u uri)
+ (return-from gethash-uri (values u t))))
+ (values nil nil)))
+
+(defun puthash-uri (uri table)
+ #+allegro (excl:puthash-key uri table)
+ #-allegro
+ (let ((existing (gethash (uri-hash uri) table)))
+ (dolist (u existing)
+ (when (uri= u uri)
+ (return-from puthash-uri u)))
+ (setf (gethash (uri-hash uri) table)
+ (cons uri existing))
+ uri))
+
+
+(defun uri-hash (uri)
+ (if* (uri-hashcode uri)
+ thenret
+ else (setf (uri-hashcode uri)
+ (sxhash
+ #+allegro
+ (render-uri uri nil)
+ #-allegro
+ (string-downcase
+ (render-uri uri nil))))))
+
+(defvar *uris* (make-uri-space))
+
+(defun uri-space () *uris*)
+
+(defun (setf uri-space) (new-val)
+ (setq *uris* new-val))
+
+;; bootstrapping (uri= changed from function to method):
+(when (fboundp 'uri=) (fmakunbound 'uri=))
+
+(defgeneric uri= (uri1 uri2))
+(defmethod uri= ((uri1 uri) (uri2 uri))
+ (when (not (eq (uri-scheme uri1) (uri-scheme uri2)))
+ (return-from uri= nil))
+ ;; RFC2396 says: a URL with an explicit ":port", where the port is
+ ;; the default for the scheme, is the equivalent to one where the
+ ;; port is elided. Hmmmm. This means that this function has to be
+ ;; scheme dependent. Grrrr.
+ (let ((default-port (case (uri-scheme uri1)
+ (:http 80)
+ (:https 443)
+ (:ftp 21)
+ (:telnet 23))))
+ (and (equalp (uri-host uri1) (uri-host uri2))
+ (eql (or (uri-port uri1) default-port)
+ (or (uri-port uri2) default-port))
+ (string= (uri-path uri1) (uri-path uri2))
+ (string= (uri-query uri1) (uri-query uri2))
+ (string= (uri-fragment uri1) (uri-fragment uri2)))))
+
+(defmethod uri= ((urn1 urn) (urn2 urn))
+ (when (not (eq (uri-scheme urn1) (uri-scheme urn2)))
+ (return-from uri= nil))
+ (and (equalp (urn-nid urn1) (urn-nid urn2))
+ (urn-nss-equal (urn-nss urn1) (urn-nss urn2))))
+
+(defun urn-nss-equal (nss1 nss2 &aux len)
+ ;; Return t iff the nss values are the same.
+ ;; %2c and %2C are equivalent.
+ (when (or (null nss1) (null nss2)
+ (not (= (setq len (length nss1))
+ (length nss2))))
+ (return-from urn-nss-equal nil))
+ (do* ((i 0 (1+ i))
+ (state :char)
+ c1 c2)
+ ((= i len) t)
+ (setq c1 (char nss1 i))
+ (setq c2 (char nss2 i))
+ (ecase state
+ (:char
+ (if* (and (char= #\% c1) (char= #\% c2))
+ then (setq state :percent+1)
+ elseif (char/= c1 c2)
+ then (return nil)))
+ (:percent+1
+ (when (char-not-equal c1 c2) (return nil))
+ (setq state :percent+2))
+ (:percent+2
+ (when (char-not-equal c1 c2) (return nil))
+ (setq state :char)))))
+
+(defmethod intern-uri ((xuri uri) &optional (uri-space *uris*))
+ (let ((uri (gethash-uri xuri uri-space)))
+ (if* uri
+ thenret
+ else (puthash-uri xuri uri-space))))
+
+(defmethod intern-uri ((uri string) &optional (uri-space *uris*))
+ (intern-uri (parse-uri uri) uri-space))
+
+(defun unintern-uri (uri &optional (uri-space *uris*))
+ (if* (eq t uri)
+ then (clrhash uri-space)
+ elseif (uri-p uri)
+ then (remhash uri uri-space)
+ else (error "bad uri: ~s." uri)))
+
+(defmacro do-all-uris ((var &optional uri-space result-form)
+ &rest forms
+ &environment env)
+ "do-all-uris (var [[uri-space] result-form])
+ {declaration}* {tag | statement}*
+Executes the forms once for each uri with var bound to the current uri"
+ (let ((f (gensym))
+ (g-ignore (gensym))
+ (g-uri-space (gensym))
+ (body (third (parse-body forms env))))
+ `(let ((,g-uri-space (or ,uri-space *uris*)))
+ (prog nil
+ (flet ((,f (,var &optional ,g-ignore)
+ (declare (ignore-if-unused ,var ,g-ignore))
+ (tagbody ,@body)))
+ (maphash #',f ,g-uri-space))
+ (return ,result-form)))))
+
+(defun sharp-u (stream chr arg)
+ (declare (ignore chr arg))
+ (let ((arg (read stream nil nil t)))
+ (if *read-suppress*
+ nil
+ (if* (stringp arg)
+ then (parse-uri arg)
+ else
+
+ (internal-reader-error
+ stream
+ "#u takes a string or list argument: ~s" arg)))))
+
+
+#+allegro
+excl::
+#+allegro
+(locally (declare (special std-lisp-readtable))
+ (let ((*readtable* std-lisp-readtable))
+ (set-dispatch-macro-character #\# #\u #'puri::sharp-u)))
+#-allegro
+(set-dispatch-macro-character #\# #\u #'puri::sharp-u)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(provide :uri)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; timings
+;; (don't run under emacs with M-x fi:common-lisp)
+
+#+allegro
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (import 'excl::gc))
+
+#-allegro
+(defun gc (&rest options)
+ (declare (ignore options))
+ #+sbcl (sb-ext::gc)
+ #+cmu (ext::gc)
+ )
+
+(defun time-uri-module ()
+ (declare (optimize (speed 3) (safety 0) (debug 0)))
+ (let ((uri "http://www.franz.com/a/b;x;y;z/c/foo?bar=baz&xxx#foo")
+ (uri2 "http://www.franz.com/a/b;x;y;z/c/%2ffoo?bar=baz&xxx#foo"))
+ (gc t) (gc :tenure) (gc :tenure) (gc :tenure)
+ (format t "~&;;; starting timing testing 1...~%")
+ (time (dotimes (i 100000) (parse-uri uri)))
+
+ (gc t) (gc :tenure) (gc :tenure) (gc :tenure)
+ (format t "~&;;; starting timing testing 2...~%")
+ (let ((uri (parse-uri uri)))
+ (time (dotimes (i 100000)
+ ;; forces no caching of the printed representation:
+ (setf (uri-string uri) nil)
+ (format nil "~a" uri))))
+
+ (gc t) (gc :tenure) (gc :tenure) (gc :tenure)
+ (format t "~&;;; starting timing testing 3...~%")
+ (time
+ (progn
+ (dotimes (i 100000) (parse-uri uri2))
+ (let ((uri (parse-uri uri)))
+ (dotimes (i 100000)
+ ;; forces no caching of the printed representation:
+ (setf (uri-string uri) nil)
+ (format nil "~a" uri)))))))
+
+;;******** reference output (ultra, modified 5.0.1):
+;;; starting timing testing 1...
+; cpu time (non-gc) 13,710 msec user, 0 msec system
+; cpu time (gc) 600 msec user, 10 msec system
+; cpu time (total) 14,310 msec user, 10 msec system
+; real time 14,465 msec
+; space allocation:
+; 1,804,261 cons cells, 7 symbols, 41,628,832 other bytes, 0 static bytes
+;;; starting timing testing 2...
+; cpu time (non-gc) 27,500 msec user, 0 msec system
+; cpu time (gc) 280 msec user, 20 msec system
+; cpu time (total) 27,780 msec user, 20 msec system
+; real time 27,897 msec
+; space allocation:
+; 1,900,463 cons cells, 0 symbols, 17,693,712 other bytes, 0 static bytes
+;;; starting timing testing 3...
+; cpu time (non-gc) 52,290 msec user, 10 msec system
+; cpu time (gc) 1,290 msec user, 30 msec system
+; cpu time (total) 53,580 msec user, 40 msec system
+; real time 54,062 msec
+; space allocation:
+; 7,800,205 cons cells, 0 symbols, 81,697,496 other bytes, 0 static bytes
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; after improving decode-escaped-encoding/encode-escaped-encoding:
+
+;;; starting timing testing 1...
+; cpu time (non-gc) 14,520 msec user, 0 msec system
+; cpu time (gc) 400 msec user, 0 msec system
+; cpu time (total) 14,920 msec user, 0 msec system
+; real time 15,082 msec
+; space allocation:
+; 1,800,270 cons cells, 0 symbols, 41,600,160 other bytes, 0 static bytes
+;;; starting timing testing 2...
+; cpu time (non-gc) 27,490 msec user, 10 msec system
+; cpu time (gc) 300 msec user, 0 msec system
+; cpu time (total) 27,790 msec user, 10 msec system
+; real time 28,025 msec
+; space allocation:
+; 1,900,436 cons cells, 0 symbols, 17,693,712 other bytes, 0 static bytes
+;;; starting timing testing 3...
+; cpu time (non-gc) 47,900 msec user, 20 msec system
+; cpu time (gc) 920 msec user, 10 msec system
+; cpu time (total) 48,820 msec user, 30 msec system
+; real time 49,188 msec
+; space allocation:
+; 3,700,215 cons cells, 0 symbols, 81,707,144 other bytes, 0 static bytes
Added: branches/trunk-reorg/thirdparty/puri-1.5.1/tests.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/puri-1.5.1/tests.lisp 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/puri-1.5.1/tests.lisp 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,419 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;; copyright (c) 1999-2001 Franz Inc, Berkeley, CA - All rights reserved.
+;; copyright (c) 2003 Kevin Rosenberg (significant fixes for using
+;; tester package)
+;;
+;; The software, data and information contained herein are proprietary
+;; to, and comprise valuable trade secrets of, Franz, Inc. They are
+;; given in confidence by Franz, Inc. pursuant to a written license
+;; agreement, and may be stored and used only in accordance with the terms
+;; of such license.
+;;
+;; Restricted Rights Legend
+;; ------------------------
+;; Use, duplication, and disclosure of the software, data and information
+;; contained herein by any agency, department or entity of the U.S.
+;; Government are subject to restrictions of Restricted Rights for
+;; Commercial Software developed at private expense as specified in
+;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
+;;
+;; Original version from ACL 6.1:
+;; t-uri.cl,v 1.3.6.3.2.1 2001/08/09 17:42:43 layer
+;;
+;; $Id: tests.lisp 11031 2006-08-15 00:59:34Z kevin $
+
+
+(defpackage #:puri-tests (:use #:puri #:cl #:ptester))
+(in-package #:puri-tests)
+
+(unintern-uri t)
+
+(defmacro gen-test-forms ()
+ (let ((res '())
+ (base-uri "http://a/b/c/d;p?q"))
+
+ (dolist (x `(;; (relative-uri result base-uri compare-function)
+;;;; RFC Appendix C.1 (normal examples)
+ ("g:h" "g:h" ,base-uri)
+ ("g" "http://a/b/c/g" ,base-uri)
+ ("./g" "http://a/b/c/g" ,base-uri)
+ ("g/" "http://a/b/c/g/" ,base-uri)
+ ("/g" "http://a/g" ,base-uri)
+ ("//g" "http://g" ,base-uri)
+ ;; Following was changed from appendix C of RFC 2396
+ ;; http://www.apache.org/~fielding/uri/rev-2002/issues.html#003-relative-query
+ #-ignore ("?y" "http://a/b/c/d;p?y" ,base-uri)
+ #+ignore ("?y" "http://a/b/c/?y" ,base-uri)
+ ("g?y" "http://a/b/c/g?y" ,base-uri)
+ ("#s" "http://a/b/c/d;p?q#s" ,base-uri)
+ ("g#s" "http://a/b/c/g#s" ,base-uri)
+ ("g?y#s" "http://a/b/c/g?y#s" ,base-uri)
+ (";x" "http://a/b/c/;x" ,base-uri)
+ ("g;x" "http://a/b/c/g;x" ,base-uri)
+ ("g;x?y#s" "http://a/b/c/g;x?y#s" ,base-uri)
+ ("." "http://a/b/c/" ,base-uri)
+ ("./" "http://a/b/c/" ,base-uri)
+ (".." "http://a/b/" ,base-uri)
+ ("../" "http://a/b/" ,base-uri)
+ ("../g" "http://a/b/g" ,base-uri)
+ ("../.." "http://a/" ,base-uri)
+ ("../../" "http://a/" ,base-uri)
+ ("../../g" "http://a/g" ,base-uri)
+;;;; RFC Appendix C.2 (abnormal examples)
+ ("" "http://a/b/c/d;p?q" ,base-uri)
+ ("../../../g" "http://a/../g" ,base-uri)
+ ("../../../../g" "http://a/../../g" ,base-uri)
+ ("/./g" "http://a/./g" ,base-uri)
+ ("/../g" "http://a/../g" ,base-uri)
+ ("g." "http://a/b/c/g." ,base-uri)
+ (".g" "http://a/b/c/.g" ,base-uri)
+ ("g.." "http://a/b/c/g.." ,base-uri)
+ ("..g" "http://a/b/c/..g" ,base-uri)
+ ("./../g" "http://a/b/g" ,base-uri)
+ ("./g/." "http://a/b/c/g/" ,base-uri)
+ ("g/./h" "http://a/b/c/g/h" ,base-uri)
+ ("g/../h" "http://a/b/c/h" ,base-uri)
+ ("g;x=1/./y" "http://a/b/c/g;x=1/y" ,base-uri)
+ ("g;x=1/../y" "http://a/b/c/y" ,base-uri)
+ ("g?y/./x" "http://a/b/c/g?y/./x" ,base-uri)
+ ("g?y/../x" "http://a/b/c/g?y/../x" ,base-uri)
+ ("g#s/./x" "http://a/b/c/g#s/./x" ,base-uri)
+ ("g#s/../x" "http://a/b/c/g#s/../x" ,base-uri)
+ ("http:g" "http:g" ,base-uri)
+
+ ("foo/bar/baz.htm#foo"
+ "http://a/b/foo/bar/baz.htm#foo"
+ "http://a/b/c.htm")
+ ("foo/bar/baz.htm#foo"
+ "http://a/b/foo/bar/baz.htm#foo"
+ "http://a/b/")
+ ("foo/bar/baz.htm#foo"
+ "http://a/foo/bar/baz.htm#foo"
+ "http://a/b")
+ ("foo/bar;x;y/bam.htm"
+ "http://a/b/c/foo/bar;x;y/bam.htm"
+ "http://a/b/c/")))
+ (push `(test (intern-uri ,(second x))
+ (intern-uri (merge-uris (intern-uri ,(first x))
+ (intern-uri ,(third x))))
+ :test 'uri=)
+ res))
+
+;;;; intern tests
+ (dolist (x '(;; default port and specifying the default port are
+ ;; supposed to compare the same:
+ ("http://www.franz.com:80" "http://www.franz.com")
+ ("http://www.franz.com:80" "http://www.franz.com" eq)
+ ;; make sure they're `eq':
+ ("http://www.franz.com:80" "http://www.franz.com" eq)
+ ("http://www.franz.com" "http://www.franz.com" eq)
+ ("http://www.franz.com/foo" "http://www.franz.com/foo" eq)
+ ("http://www.franz.com/foo?bar"
+ "http://www.franz.com/foo?bar" eq)
+ ("http://www.franz.com/foo?bar#baz"
+ "http://www.franz.com/foo?bar#baz" eq)
+ ("http://WWW.FRANZ.COM" "http://www.franz.com" eq)
+ ("http://www.FRANZ.com" "http://www.franz.com" eq)
+ ("http://www.franz.com" "http://www.franz.com/" eq)
+ (;; %72 is "r", %2f is "/", %3b is ";"
+ "http://www.franz.com/ba%72%2f%3b;x;y;z/baz/"
+ "http://www.franz.com/bar%2f%3b;x;y;z/baz/" eq)))
+ (push `(test (intern-uri ,(second x))
+ (intern-uri ,(first x))
+ :test ',(if (third x)
+ (third x)
+ 'uri=))
+ res))
+
+;;;; parsing and equivalence tests
+ (push `(test
+ (parse-uri "http://foo+bar?baz=b%26lob+bof")
+ (parse-uri (parse-uri "http://foo+bar?baz=b%26lob+bof"))
+ :test 'uri=)
+ res)
+ (push '(test
+ (parse-uri "http://www.foo.com")
+ (parse-uri (parse-uri "http://www.foo.com?")) ; allow ? at end
+ :test 'uri=)
+ res)
+ (push `(test
+ "baz=b%26lob+bof"
+ (uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof"))
+ :test 'string=)
+ res)
+ (push `(test
+ "baz=b%26lob+bof%3d"
+ (uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof%3d"))
+ :test 'string=)
+ res)
+ (push
+ `(test (parse-uri "xxx?%41") (parse-uri "xxx?A") :test 'uri=)
+ res)
+ (push
+ `(test "A" (uri-query (parse-uri "xxx?%41")) :test 'string=)
+ res)
+
+ (push `(test-error (parse-uri " ")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "foo ")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri " foo ")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "<foo")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "foo>")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "<foo>")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "%")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "foo%xyr")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "\"foo\"")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test "%20" (format nil "~a" (parse-uri "%20"))
+ :test 'string=)
+ res)
+ (push `(test "&" (format nil "~a" (parse-uri "%26"))
+ :test 'string=)
+ res)
+ (push
+ `(test "foo%23bar" (format nil "~a" (parse-uri "foo%23bar"))
+ :test 'string=)
+ res)
+ (push
+ `(test "foo%23bar#foobar"
+ (format nil "~a" (parse-uri "foo%23bar#foobar"))
+ :test 'string=)
+ res)
+ (push
+ `(test "foo%23bar#foobar#baz"
+ (format nil "~a" (parse-uri "foo%23bar#foobar#baz"))
+ :test 'string=)
+ res)
+ (push
+ `(test "foo%23bar#foobar#baz"
+ (format nil "~a" (parse-uri "foo%23bar#foobar%23baz"))
+ :test 'string=)
+ res)
+ (push
+ `(test "foo%23bar#foobar/baz"
+ (format nil "~a" (parse-uri "foo%23bar#foobar%2fbaz"))
+ :test 'string=)
+ res)
+ (push `(test-error (parse-uri "foobar??")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "foobar?foo?")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test "foobar?%3f"
+ (format nil "~a" (parse-uri "foobar?%3f"))
+ :test 'string=)
+ res)
+ (push `(test
+ "http://foo/bAr;3/baz?baf=3"
+ (format nil "~a" (parse-uri "http://foo/b%41r;3/baz?baf=3"))
+ :test 'string=)
+ res)
+ (push `(test
+ '(:absolute ("/bAr" "3") "baz")
+ (uri-parsed-path (parse-uri "http://foo/%2fb%41r;3/baz?baf=3"))
+ :test 'equal)
+ res)
+ (push `(test
+ "/%2fbAr;3/baz"
+ (let ((u (parse-uri "http://foo/%2fb%41r;3/baz?baf=3")))
+ (setf (uri-parsed-path u) '(:absolute ("/bAr" "3") "baz"))
+ (uri-path u))
+ :test 'string=)
+ res)
+ (push `(test
+ "http://www.verada.com:8010/kapow?name=foo%3Dbar%25"
+ (format nil "~a"
+ (parse-uri
+ "http://www.verada.com:8010/kapow?name=foo%3Dbar%25"))
+ :test 'string=)
+ res)
+ (push `(test
+ "ftp://parcftp.xerox.com/pub/pcl/mop/"
+ (format nil "~a"
+ (parse-uri "ftp://parcftp.xerox.com:/pub/pcl/mop/"))
+ :test 'string=)
+ res)
+
+;;;; enough-uri tests
+ (dolist (x `(("http://www.franz.com/foo/bar/baz.htm"
+ "http://www.franz.com/foo/bar/"
+ "baz.htm")
+ ("http://www.franz.com/foo/bar/baz.htm"
+ "http://www.franz.com/foo/bar"
+ "baz.htm")
+ ("http://www.franz.com:80/foo/bar/baz.htm"
+ "http://www.franz.com:80/foo/bar"
+ "baz.htm")
+ ("http:/foo/bar/baz.htm" "http:/foo/bar" "baz.htm")
+ ("http:/foo/bar/baz.htm" "http:/foo/bar/" "baz.htm")
+ ("/foo/bar/baz.htm" "/foo/bar" "baz.htm")
+ ("/foo/bar/baz.htm" "/foo/bar/" "baz.htm")
+ ("/foo/bar/baz.htm#foo" "/foo/bar/" "baz.htm#foo")
+ ("/foo/bar/baz.htm?bar#foo" "/foo/bar/" "baz.htm?bar#foo")
+
+ ("http://www.dnai.com/~layer/foo.htm"
+ "http://www.known.net"
+ "http://www.dnai.com/~layer/foo.htm")
+ ("http://www.dnai.com/~layer/foo.htm"
+ "http://www.dnai.com:8000/~layer/"
+ "http://www.dnai.com/~layer/foo.htm")
+ ("http://www.dnai.com:8000/~layer/foo.htm"
+ "http://www.dnai.com/~layer/"
+ "http://www.dnai.com:8000/~layer/foo.htm")
+ ("http://www.franz.com"
+ "http://www.franz.com"
+ "/")))
+ (push `(test (parse-uri ,(third x))
+ (enough-uri (parse-uri ,(first x))
+ (parse-uri ,(second x)))
+ :test 'uri=)
+ res))
+
+;;;; urn tests, ideas of which are from rfc2141
+ (let ((urn "urn:com:foo-the-bar"))
+ (push `(test "com" (urn-nid (parse-uri ,urn))
+ :test #'string=)
+ res)
+ (push `(test "foo-the-bar" (urn-nss (parse-uri ,urn))
+ :test #'string=)
+ res))
+ (push `(test-error (parse-uri "urn:")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "urn:foo")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "urn:foo$")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "urn:foo_")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "urn:foo:foo&bar")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test (parse-uri "URN:foo:a123,456")
+ (parse-uri "urn:foo:a123,456")
+ :test #'uri=)
+ res)
+ (push `(test (parse-uri "URN:foo:a123,456")
+ (parse-uri "urn:FOO:a123,456")
+ :test #'uri=)
+ res)
+ (push `(test (parse-uri "urn:foo:a123,456")
+ (parse-uri "urn:FOO:a123,456")
+ :test #'uri=)
+ res)
+ (push `(test (parse-uri "URN:FOO:a123%2c456")
+ (parse-uri "urn:foo:a123%2C456")
+ :test #'uri=)
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:A123,456")
+ (parse-uri "urn:FOO:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:A123,456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:A123,456")
+ (parse-uri "URN:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:a123%2C456")
+ (parse-uri "urn:FOO:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:a123%2C456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "URN:FOO:a123%2c456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:FOO:a123%2c456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:a123%2c456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+
+ (push `(test t
+ (uri= (parse-uri "foo") (parse-uri "foo#")))
+ res)
+
+ (push
+ '(let ((puri::*strict-parse* nil))
+ (test-no-error
+ (puri:parse-uri
+ "http://foo.com/bar?a=zip|zop")))
+ res)
+ (push
+ '(test-error
+ (puri:parse-uri "http://foo.com/bar?a=zip|zop")
+ :condition-type 'uri-parse-error)
+ res)
+
+ (push
+ '(let ((puri::*strict-parse* nil))
+ (test-no-error
+ (puri:parse-uri
+ "http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")))
+ res)
+ (push
+ '(test-error
+ (puri:parse-uri
+ "http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")
+ :condition-type 'uri-parse-error)
+ res)
+
+ (push
+ '(let ((puri::*strict-parse* nil))
+ (test-no-error
+ (puri:parse-uri
+ "http://scbc.booksonline.com/cgi-bin/ndCGI.exe/Develop/pagClubHome.hrfTIOLI_…")))
+ res)
+ (push
+ '(test-error
+ (puri:parse-uri
+ "http://scbc.booksonline.com/cgi-bin/ndCGI.exe/Develop/pagClubHome.hrfTIOLI_…")
+ :condition-type 'uri-parse-error)
+ res)
+
+ `(progn ,@(nreverse res))))
+
+(defun do-tests ()
+ (let ((*break-on-test-failures* t))
+ (with-tests (:name "puri")
+ (gen-test-forms)))
+ t)
+
+
Added: branches/trunk-reorg/thirdparty/puri-1.5.1/uri.html
===================================================================
--- branches/trunk-reorg/thirdparty/puri-1.5.1/uri.html 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/puri-1.5.1/uri.html 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,406 @@
+<html>
+
+<head>
+<title>URI support in Allegro CL</title>
+</head>
+
+<body>
+
+<h1>URI support in Allegro CL</h1>
+
+<p>This document contains the following sections:</p>
+<p><a href="#uri-intro-1">1.0 Introduction</a><br>
+<a href="#uri-api-1">2.0 The URI API definition</a><br>
+<a href="#parsing-decoding-1">3.0 Parsing, escape decoding/encoding and the path</a><br>
+<a href="#interning-uris-1">4.0 Interning URIs</a><br>
+<a href="#acl-implementation-1">5.0 Allegro CL implementation notes</a><br>
+<a href="#examples-1">6.0 Examples</a><br>
+</p>
+
+<p>This version of the Allegro CL URI support documentation is for distribution with the
+Open Source version of the URI code. Links to Allegro CL documentation other than
+URI-specific files have been supressed. To see Allegro CL documentation, see <a
+href="http://www.franz.com/support/documentation/">http://www.franz.com/support/documentation/</a>,
+which is the Allegro CL documentation page of the franz inc. website. Links to Allegro CL
+documentation can be found on that page. </p>
+
+<hr>
+
+<hr>
+
+<h2><a name="uri-intro-1">1.0 Introduction</a></h2>
+
+<p><em>URI</em> stands for <em>Universal Resource Identifier</em>. For a description of
+URIs, see RFC2396, which can be found in several places, including the IETF web site (<a
+href="http://www.ietf.org/rfc/rfc2396.txt">http://www.ietf.org/rfc/rfc2396.txt</a>) and
+the UCI/ICS web site (<a href="http://www.ics.uci.edu/pub/ietf/uri/rfc2396.txt">http://www.ics.uci.edu/pub/ietf/uri/rfc2396.txt</a>).
+We prefer the UCI/ICS one as it has more examples. </p>
+
+<p>URIs are a superset in functionality and syntax to URLs (Universal Resource Locators)
+and URNs (Universal Resource Names). That is, RFC2396 updates and merges RFC1738 and
+RFC1808 into a single syntax, called the URI. It does exclude some portions of RFC1738
+that define specific syntax of individual URL schemes. </p>
+
+<p>In URL slang, the <em>scheme</em> is usually called the `protocol', but it is called
+scheme in RFC1738. A URL `host' corresponds to the URI `authority.' The URL slang
+`bookmark' or `anchor' is `fragment' in URI lingo. </p>
+
+<p>The URI facility was available as a patch to Allegro CL 5.0.1 and is included with
+release 6.0. the URI facility might not be in an Allegro CL image. Evaluate <code>(require
+:uri)</code> to ensure the facility is loaded (that form returns <code>nil</code> if the
+URI module is already loaded). </p>
+
+<p>Broadly, the URI facility creates a Lisp object that represents a URI, and provides
+setters and accessors to fields in the URI object. The URI object can also be interned,
+much like symbols in CL are. This document describes the facility and the related
+operators. </p>
+
+<p>Aside from the obvious slots which are called out in the RFC, URIs also have a property
+list. With interning, this is another similarity between URIs and CL symbols. </p>
+
+<hr>
+
+<hr>
+
+<h2><a name="uri-api-1">2.0 The URI API definition</a></h2>
+
+<p>Symbols naming objects (functions, variables, etc.) in the <em>uri</em> module are
+exported from the <code>net.uri</code> package. </p>
+
+<p>URIs are represented by CLOS objects. Their slots are: </p>
+
+<pre>
+scheme
+host
+port
+path
+query
+fragment
+plist
+</pre>
+
+<p>The <code>host</code> and <code>port</code> slots together correspond to the <code>authority</code>
+(see RFC2396). There is an accessor-like function, <a href="operators/uri-authority.htm"><b>uri-authority</b></a>,
+that can be used to extract the authority from a URI. See the RFC2396 specifications
+pointed to at the beginning of the <a href="#uri-intro-1">1.0 Introduction</a> for details
+of all the slots except <code>plist</code>. The <code>plist</code> slot contains a
+standard Common Lisp property list. </p>
+
+<p>All symbols are external in the <code>net.uri</code> package, unless otherwise noted.
+Brief descriptions are given in this document, with complete descriptions in the
+individual pages.
+
+<ul>
+ <li><a href="classes/uri.htm"><code>uri</code></a>: the class of URI objects. </li>
+ <li><a href="classes/urn.htm"><code>urn</code></a>: the class of URN objects. </li>
+ <li><a href="operators/uri-p.htm"><b>uri-p</b></a> <p><b>Arguments: </b><i>object</i></p>
+ <p>Returns true if <i>object</i> is an instance of class <a href="classes/uri.htm"><code>uri</code></a>.
+ </p>
+ </li>
+ <li><a href="operators/copy-uri.htm"><b>copy-uri</b></a> <p><b>Arguments: </b><i>uri </i>&key
+ <i>place scheme host port path query fragment plist </i></p>
+ <p>Copies the specified URI object. See the description page for information on the
+ keyword arguments. </p>
+ </li>
+ <li><a href="operators/uri-scheme.htm"><b>uri-scheme</b></a><br>
+ <a href="operators/uri-host.htm"><b>uri-host</b></a><br>
+ <a href="operators/uri-port.htm"><b>uri-port</b></a><br>
+ <a href="operators/uri-path.htm"><b>uri-path</b></a><br>
+ <a href="operators/uri-query.htm"><b>uri-query</b></a><br>
+ <a href="operators/uri-fragment.htm"><b>uri-fragment</b></a><br>
+ <a href="operators/uri-plist.htm"><b>uri-plist</b></a><br>
+ <p><b>Arguments: </b><i>uri-object </i></p>
+ <p>These accessors return the value of the associated slots of the <i>uri-object</i> </p>
+ </li>
+ <li><a href="operators/uri-authority.htm"><b>uri-authority</b></a> <p><b>Arguments: </b><i>uri-object
+ </i></p>
+ <p>Returns the authority of <i>uri-object</i>. The authority combines the host and port. </p>
+ </li>
+ <li><a href="operators/render-uri.htm"><b>render-uri</b></a> <p><b>Arguments: </b><i>uri
+ stream </i></p>
+ <p>Print to <i>stream</i> the printed representation of <i>uri</i>. </p>
+ </li>
+ <li><a href="operators/parse-uri.htm"><b>parse-uri</b></a> <p><b>Arguments: </b><i>string </i>&key
+ (<i>class</i> 'uri)<i> </i></p>
+ <p>Parse <i>string</i> into a URI object. </p>
+ </li>
+ <li><a href="operators/merge-uris.htm"><b>merge-uris</b></a> <p><b>Arguments: </b><i>uri
+ base-uri </i>&optional <i>place </i></p>
+ <p>Return an absolute URI, based on <i>uri</i>, which can be relative, and <i>base-uri</i>
+ which must be absolute. </p>
+ </li>
+ <li><a href="operators/enough-uri.htm"><b>enough-uri</b></a> <p><b>Arguments: </b><i>uri
+ base </i></p>
+ <p>Converts <i>uri</i> into a relative URI using <i>base</i> as the base URI. </p>
+ </li>
+ <li><a href="operators/uri-parsed-path.htm"><b>uri-parsed-path</b></a> <p><b>Arguments: </b><i>uri
+ </i></p>
+ <p>Return the parsed representation of the path. </p>
+ </li>
+ <li><a href="operators/uri.htm"><b>uri</b></a> <p><b>Arguments: </b><i>object </i></p>
+ <p>Defined methods: if argument is a uri object, return it; create a uri object if
+ possible and return it, or error if not possible. </p>
+ </li>
+</ul>
+
+<hr>
+
+<hr>
+
+<h2><a name="parsing-decoding-1">3.0 Parsing, escape decoding/encoding and the path</a></h2>
+
+<p>The method <a href="operators/uri-path.htm"><b>uri-path</b></a> returns the path
+portion of the URI, in string form. The method <a href="operators/uri-parsed-path.htm"><b>uri-parsed-path</b></a>
+returns the path portion of the URI, in list form. This list form is discussed below,
+after a discussion of decoding/encoding. </p>
+
+<p>RFC2396 lays out a method for inserting into URIs <em>reserved characters</em>. You do
+this by escaping the character. An <em>escaped</em> character is defined like this: </p>
+
+<pre>
+escaped = "%" hex hex
+
+hex = digit | "A" | "B" | "C" | "D" | "E" | "F" | "a" | "b" | "c" | "d" | "e" | "f"
+</pre>
+
+<p>In addition, the RFC defines excluded characters: </p>
+
+<pre>
+"<" | ">" | "#" | "%" | <"> | "{" | "}" | "|" | "\" | "^" | "[" | "]" | "`"
+</pre>
+
+<p>The set of reserved characters are: </p>
+
+<pre>
+";" | "/" | "?" | ":" | "@" | "&" | "=" | "+" | "$" | ","
+</pre>
+
+<p>with the following exceptions:
+
+<ul>
+ <li>within the authority component, the characters ";", ":",
+ "@", "?", and "/" are reserved. </li>
+ <li>within a path segment, the characters "/", ";", "=", and
+ "?" are reserved. </li>
+ <li>within a query component, the characters ";", "/", "?",
+ ":", "@", "&", "=", "+",
+ ",", and "$" are reserved. </li>
+</ul>
+
+<p>From the RFC, there are two important rules about escaping and unescaping (encoding and
+decoding):
+
+<ul>
+ <li>decoding should only happen when the URI is parsed into component parts;</li>
+ <li>encoding can only occur when a URI is made from component parts (ie, rendered for
+ printing). </li>
+</ul>
+
+<p>The implication of this is that to decode the URI, it must be in a parsed state. That
+is, you can't convert <font face="Courier New">%2f</font> (the escaped form of
+"/") until the path has been parsed into its component parts. Another important
+desire is for the application viewing the component parts to see the decoded values of the
+components. For example, consider: </p>
+
+<pre>
+http://www.franz.com/calculator/3%2f2
+</pre>
+
+<p>This might be the implementation of a calculator, and how someone would execute 3/2.
+Clearly, the application that implements this would want to see path components of
+"calculator" and "3/2". "3%2f2" would not be useful to the
+calculator application. </p>
+
+<p>For the reasons given above, a parsed version of the path is available and has the
+following form: </p>
+
+<pre>
+([:absolute | :relative] component1 [component2...])
+</pre>
+
+<p>where components are: </p>
+
+<pre>
+element | (element param1 [param2 ...])
+</pre>
+
+<p>and <em>element</em> is a path element, and the param's are path element parameters.
+For example, the result of </p>
+
+<pre>
+(uri-parsed-path (parse-uri "foo;10/bar:x;y;z/baz.htm"))
+</pre>
+
+<p>is </p>
+
+<pre>
+(:relative ("foo" "10") ("bar:x" "y" "z") "baz.htm")
+</pre>
+
+<p>There is a certain amount of canonicalization that occurs when parsing:
+
+<ul>
+ <li>A path of <code>(:absolute)</code> or <code>(:absolute "")</code> is
+ equivalent to a <code>nil</code> path. That is, <code>http://a/</code> is parsed with a <code>nil</code>
+ path and printed as <code>http://a</code>. </li>
+ <li>Escaped characters that are not reserved are not escaped upon printing. For example, <code>"foob%61r"</code>
+ is parsed into <code>"foobar"</code> and appears as <code>"foobar"</code>
+ when the URI is printed. </li>
+</ul>
+
+<hr>
+
+<hr>
+
+<h2><a name="interning-uris-1">4.0 Interning URIs</a></h2>
+
+<p>This section describes how to intern URIs. Interning is not mandatory. URIs can be used
+perfectly well without interning them. </p>
+
+<p>Interned URIs in Allegro are like symbols. That is, a string representing a URI, when
+parsed and interned, will always yield an <strong>eq</strong> object. For example: </p>
+
+<pre>
+(eq (intern-uri "http://www.franz.com")
+ (intern-uri "http://www.franz.com"))
+</pre>
+
+<p>is always true. (Two strings with identical contents may or may not be <strong>eq</strong>
+in Common Lisp, note.) </p>
+
+<p>The functions associated with interning are:
+
+<ul>
+ <li><a href="operators/make-uri-space.htm"><b>make-uri-space</b></a> <p><b>Arguments: </b>&key
+ <i>size </i></p>
+ <p>Make a new hash-table object to contain interned URIs. </p>
+ </li>
+ <li><a href="operators/uri-space.htm"><b>uri-space</b></a> <p><b>Arguments: </b></p>
+ <p>Return the object into which URIs are currently being interned. </p>
+ </li>
+ <li><a href="operators/uri_eq.htm"><b>uri=</b></a> <p><b>Arguments: </b><i>uri1 uri2 </i></p>
+ <p>Returns true if <i>uri1</i> and <i>uri2</i> are equivalent. </p>
+ </li>
+ <li><a href="operators/intern-uri.htm"><b>intern-uri</b></a> <p><b>Arguments: </b><i>uri-name
+ </i>&optional <i>uri-space </i></p>
+ <p>Intern the uri object specified in the uri-space specified. Methods exist for strings
+ and uri objects. </p>
+ </li>
+ <li><a href="operators/unintern-uri.htm"><b>unintern-uri</b></a> <p><b>Arguments: </b><i>uri
+ </i>&optional <i>uri-space </i></p>
+ <p>Unintern the uri object specified or all uri objects (in <i>uri-space</i> if specified)
+ if <i>uri</i> is <code>t</code>. </p>
+ </li>
+ <li><a href="operators/do-all-uris.htm"><b>do-all-uris</b></a> <p><b>Arguments: </b><i>(var </i>&optional
+ <i>uri-space result) </i>&body <i>body </i></p>
+ <p>Bind <i>var</i> to all currently defined uris (in <i>uri-space</i> if specified) and
+ evaluate <i>body</i>. </p>
+ </li>
+</ul>
+
+<hr>
+
+<hr>
+
+<h2><a name="acl-implementation-1">5.0 Allegro CL implementation notes</a></h2>
+
+<ol>
+ <li>The following are true: <br>
+ <code>(uri= (parse-uri "http://www.franz.com/")</code> <br>
+ <code>(parse-uri "http://www.franz.com"))</code> <br>
+ <code>(eq (intern-uri "http://www.franz.com/")</code> <br>
+ <code>(intern-uri "http://www.franz.com"))</code><br>
+ </li>
+ <li>The following is true: <br>
+ <code>(eq (intern-uri "http://www.franz.com:80/foo/bar.htm")</code> <br>
+ <code>(intern-uri "http://www.franz.com/foo/bar.htm"))</code><br>
+ (I.e. specifying the default port is the same as specifying no port at all. This is
+ specific in RFC2396.) </li>
+ <li>The <em>scheme</em> and <em>authority</em> are case-insensitive. In Allegro CL, the
+ scheme is a keyword that appears in the normal case for the Lisp in which you are
+ executing. </li>
+ <li><code>#u"..."</code> is shorthand for <code>(parse-uri "...")</code>
+ but if an existing <code>#u</code> dispatch macro definition exists, it will not be
+ overridden. </li>
+ <li>The interaction between setting the scheme, host, port, path, query, and fragment slots
+ of URI objects, in conjunction with interning URIs will have very bad and unpredictable
+ results. </li>
+ <li>The printable representation of URIs is cached, for efficiency. This caching is undone
+ when the above slots are changed. That is, when you create a URI the printed
+ representation is cached. When you change one of the above mentioned slots, the printed
+ representation is cleared and calculated when the URI is next printed. For example: </li>
+</ol>
+
+<pre>
+user(10): (setq u #u"http://foo.bar.com/foo/bar")
+#<uri http://foo.bar.com/foo/bar>
+user(11): (setf (net.uri:uri-host u) "foo.com")
+"foo.com"
+user(12): u
+#<uri http://foo.com/foo/bar>
+user(13):
+</pre>
+
+<p>This allows URIs behavior to follow the principle of least surprise. </p>
+
+<hr>
+
+<hr>
+
+<h2><a name="examples-1">6.0 Examples</a></h2>
+
+<pre>
+uri(10): (use-package :net.uri)
+t
+uri(11): (parse-uri "foo")
+#<uri foo>
+uri(12): #u"foo"
+#<uri foo>
+uri(13): (setq base (intern-uri "http://www.franz.com/foo/bar/"))
+#<uri http://www.franz.com/foo/bar/>
+uri(14): (merge-uris (parse-uri "foo.htm") base)
+#<uri http://www.franz.com/foo/bar/foo.htm>
+uri(15): (merge-uris (parse-uri "?foo") base)
+#<uri http://www.franz.com/foo/bar/?foo>
+uri(16): (setq base (intern-uri "http://www.franz.com/foo/bar/baz.htm"))
+#<uri http://www.franz.com/foo/bar/baz.htm>
+uri(17): (merge-uris (parse-uri "foo.htm") base)
+#<uri http://www.franz.com/foo/bar/foo.htm>
+uri(18): (merge-uris #u"?foo" base)
+#<uri http://www.franz.com/foo/bar/?foo>
+uri(19): (describe #u"http://www.franz.com")
+#<uri http://www.franz.com> is an instance of #<standard-class net.uri:uri>:
+ The following slots have :instance allocation:
+ scheme :http
+ host "www.franz.com"
+ port nil
+ path nil
+ query nil
+ fragment nil
+ plist nil
+ escaped nil
+ string "http://www.franz.com"
+ parsed-path nil
+ hashcode nil
+uri(20): (describe #u"http://www.franz.com/")
+#<uri http://www.franz.com> is an instance of #<standard-class net.uri:uri>:
+ The following slots have :instance allocation:
+ scheme :http
+ host "www.franz.com"
+ port nil
+ path nil
+ query nil
+ fragment nil
+ plist nil
+ escaped nil
+ string "http://www.franz.com"
+ parsed-path nil
+ hashcode nil
+uri(21): #u"foobar#baz%23xxx"
+#<uri foobar#baz#xxx>
+</pre>
+
+<p><small>Copyright (c) 1998-2001, Franz Inc. Berkeley, CA., USA. All rights reserved.
+Created 2001.8.16.</small></p>
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/COPYING
===================================================================
--- branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/COPYING 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/COPYING 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,21 @@
+ Copyright (c) 2005 David Lichteblau
+
+ Permission is hereby granted, free of charge, to any person
+ obtaining a copy of this software and associated documentation files
+ (the "Software"), to deal in the Software without restriction,
+ including without limitation the rights to use, copy, modify, merge,
+ publish, distribute, sublicense, and/or sell copies of the Software,
+ and to permit persons to whom the Software is furnished to do so,
+ subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
+ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
+ ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+ CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ SOFTWARE.
Added: branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Entries 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Entries 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,7 @@
+/COPYING/1.1/Sun Dec 4 23:41:05 2005//
+/Makefile/1.1.1.1/Wed Nov 9 22:11:00 2005//
+/README/1.3/Thu Sep 14 17:45:36 2006//
+/mixin.lisp/1.5/Thu Sep 14 17:45:36 2006//
+/package.lisp/1.4/Thu Sep 14 17:45:36 2006//
+/trivial-gray-streams.asd/1.1.1.1/Wed Nov 9 22:11:00 2005//
+D
Added: branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Repository 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Repository 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1 @@
+trivial-gray-streams
Added: branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Root 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/CVS/Root 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cl-plus-ssl/cvsroot
Added: branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/Makefile
===================================================================
--- branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/Makefile 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/Makefile 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,3 @@
+.PHONY: clean
+clean:
+ rm -f *.fasl *.x86f *.fas *.ufsl *.lib *.pfsl
Added: branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/README
===================================================================
--- branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/README 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/README 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,37 @@
+trivial-gray-streams
+====================
+
+This system provides an extremely thin compatibility layer for gray
+streams. It is nearly *too* trivial for a complete package, except that
+I have copy&pasted this code into enough projects now that I decided to
+factor it out once again now, and then *never* have to touch it again.
+
+
+How to use it
+=============
+
+1. Use the package TRIVIAL-GRAY-STREAMS instead of whatever
+ implementation-specific package you would have to use otherwise to
+ get at gray stream symbols.
+2. For STREAM-READ-SEQUENCE and STREAM-WRITE-SEQUENCE, notice that we
+ use two required arguments and allow additional keyword arguments.
+ So the lambda list when defining a method on either function should look
+ like this:
+ (stream sequence start end &key)
+3. In order for (2) to work on all Lisps, make sure to subclass all your
+ stream classes from TRIVIAL-GRAY-STREAM-MIXIN if you intend to define
+ methods on those two generic functions.
+
+
+Extensions
+==========
+
+Generic function STREAM-READ-SEQUENCE (stream sequence start end &key)
+Generic function STREAM-WRITE-SEQUENCE (stream sequence start end &key)
+
+ See above.
+
+Generic function STREAM-FILE-POSITION (stream) => file position
+Generic function (SETF STREAM-FILE-POSITION) (position-spec stream) => successp
+
+ Will only be called by LispWorks and CLISP.
Added: branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/mixin.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/mixin.lisp 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/mixin.lisp 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,117 @@
+(in-package :trivial-gray-streams)
+
+(defclass trivial-gray-stream-mixin () ())
+
+(defgeneric stream-read-sequence
+ (stream sequence start end &key &allow-other-keys))
+(defgeneric stream-write-sequence
+ (stream sequence start end &key &allow-other-keys))
+
+(defgeneric stream-file-position (stream))
+(defgeneric (setf stream-file-position) (newval stream))
+
+(defmethod stream-write-string
+ ((stream trivial-gray-stream-mixin) seq &optional start end)
+ (stream-write-sequence stream seq (or start 0) (or end (length seq))))
+
+;; Implementations should provide this default method, I believe, but
+;; at least sbcl and allegro don't.
+(defmethod stream-terpri ((stream trivial-gray-stream-mixin))
+ (write-char #\newline stream))
+
+(defmethod stream-file-position ((stream trivial-gray-stream-mixin))
+ nil)
+
+(defmethod (setf stream-file-position)
+ (newval (stream trivial-gray-stream-mixin))
+ (declare (ignore newval))
+ nil)
+
+#+allegro
+(progn
+ (defmethod excl:stream-read-sequence
+ ((s trivial-gray-stream-mixin) seq &optional start end)
+ (stream-read-sequence s seq (or start 0) (or end (length seq))))
+ (defmethod stream:stream-write-sequence
+ ((s trivial-gray-stream-mixin) seq &optional start end)
+ (stream-write-sequence s seq (or start 0) (or end (length seq)))))
+
+#+cmu
+(progn
+ (defmethod ext:stream-read-sequence
+ ((s trivial-gray-stream-mixin) seq &optional start end)
+ (stream-read-sequence s seq (or start 0) (or end (length seq))))
+ (defmethod ext:stream-write-sequence
+ ((s trivial-gray-stream-mixin) seq &optional start end)
+ (stream-write-sequence s seq (or start 0) (or end (length seq)))))
+
+#+lispworks
+(progn
+ (defmethod stream:stream-read-sequence
+ ((s trivial-gray-stream-mixin) seq start end)
+ (stream-read-sequence s seq start end))
+ (defmethod stream:stream-write-sequence
+ ((s trivial-gray-stream-mixin) seq start end)
+ (stream-write-sequence s seq start end))
+
+ (defmethod stream:stream-file-position ((stream trivial-gray-stream-mixin))
+ (stream-file-position stream))
+ (defmethod (setf stream:stream-file-position)
+ (newval (stream trivial-gray-stream-mixin))
+ (setf (stream-file-position stream) newval)))
+
+#+openmcl
+(progn
+ (defmethod ccl:stream-read-vector
+ ((s trivial-gray-stream-mixin) seq start end)
+ (stream-read-sequence s seq start end))
+ (defmethod ccl:stream-write-vector
+ ((s trivial-gray-stream-mixin) seq start end)
+ (stream-write-sequence s seq start end)))
+
+#+clisp
+(progn
+ (defmethod gray:stream-read-byte-sequence
+ ((s trivial-gray-stream-mixin)
+ seq
+ &optional start end no-hang interactive)
+ (when no-hang
+ (error "this stream does not support the NO-HANG argument"))
+ (when interactive
+ (error "this stream does not support the INTERACTIVE argument"))
+ (stream-read-sequence s seq start end))
+
+ (defmethod gray:stream-write-byte-sequence
+ ((s trivial-gray-stream-mixin)
+ seq
+ &optional start end no-hang interactive)
+ (when no-hang
+ (error "this stream does not support the NO-HANG argument"))
+ (when interactive
+ (error "this stream does not support the INTERACTIVE argument"))
+ (stream-write-sequence s seq start end))
+
+ (defmethod gray:stream-read-char-sequence
+ ((s trivial-gray-stream-mixin) seq &optional start end)
+ (stream-read-sequence s seq start end))
+
+ (defmethod gray:stream-write-char-sequence
+ ((s trivial-gray-stream-mixin) seq &optional start end)
+ (stream-write-sequence s seq start end))
+
+ (defmethod gray:stream-position ((stream trivial-gray-stream-mixin) position)
+ (if position
+ (setf (stream-file-position stream) position)
+ (stream-file-position stream))))
+
+#+sbcl
+(progn
+ (defmethod sb-gray:stream-read-sequence
+ ((s trivial-gray-stream-mixin) seq &optional start end)
+ (stream-read-sequence s seq (or start 0) (or end (length seq))))
+ (defmethod sb-gray:stream-write-sequence
+ ((s trivial-gray-stream-mixin) seq &optional start end)
+ (stream-write-sequence s seq (or start 0) (or end (length seq))))
+ ;; SBCL extension:
+ (defmethod sb-gray:stream-line-length ((stream trivial-gray-stream-mixin))
+ 80))
Added: branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/package.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/package.lisp 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/package.lisp 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,44 @@
+(in-package :trivial-gray-streams-system)
+
+#+cmu
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require :gray-streams))
+
+#+allegro
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (unless (fboundp 'stream:stream-write-string)
+ (require "streamc.fasl")))
+
+(macrolet
+ ((frob ()
+ (let
+ ((common-symbols
+ '(#:fundamental-stream #:fundamental-input-stream
+ #:fundamental-output-stream #:fundamental-character-stream
+ #:fundamental-binary-stream #:fundamental-character-input-stream
+ #:fundamental-character-output-stream
+ #:fundamental-binary-input-stream
+ #:fundamental-binary-output-stream #:stream-read-char
+ #:stream-unread-char #:stream-read-char-no-hang
+ #:stream-peek-char #:stream-listen #:stream-read-line
+ #:stream-clear-input #:stream-write-char #:stream-line-column
+ #:stream-start-line-p #:stream-write-string #:stream-terpri
+ #:stream-fresh-line #:stream-finish-output #:stream-force-output
+ #:stream-clear-output #:stream-advance-to-column
+ #:stream-read-byte #:stream-write-byte)))
+ `(defpackage :trivial-gray-streams
+ (:use :cl)
+ (:import-from #+sbcl :sb-gray
+ #+allegro :excl
+ #+cmu :ext
+ #+clisp :gray
+ #+openmcl :ccl
+ #+lispworks :stream
+ #-(or sbcl allegro cmu clisp openmcl lispworks) ...
+ ,@common-symbols)
+ (:export #:trivial-gray-stream-mixin
+ #:stream-read-sequence
+ #:stream-write-sequence
+ #:stream-file-position
+ ,@common-symbols)))))
+ (frob))
Added: branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/trivial-gray-streams.asd
===================================================================
--- branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/trivial-gray-streams.asd 2007-10-04 19:10:49 UTC (rev 2204)
+++ branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/trivial-gray-streams.asd 2007-10-04 19:13:23 UTC (rev 2205)
@@ -0,0 +1,9 @@
+;;; -*- mode: lisp -*-
+
+(defpackage :trivial-gray-streams-system
+(:use :cl :asdf))
+(in-package :trivial-gray-streams-system)
+
+(defsystem :trivial-gray-streams
+ :serial t
+ :components ((:file "package") (:file "mixin")))
1
0
[bknr-cvs] r2204 - in branches/trunk-reorg/thirdparty: . portableaserve/libs
by bknrï¼ bknr.net 04 Oct '07
by bknrï¼ bknr.net 04 Oct '07
04 Oct '07
Author: hhubner
Date: 2007-10-04 15:10:49 -0400 (Thu, 04 Oct 2007)
New Revision: 2204
Removed:
branches/trunk-reorg/thirdparty/portableaserve/libs/cl-ppcre/
branches/trunk-reorg/thirdparty/portableaserve/libs/puri-1.3.1/
branches/trunk-reorg/thirdparty/trivial-gray-streams-2006-09-16/
Log:
updating
1
0
Author: hhubner
Date: 2007-10-04 15:03:03 -0400 (Thu, 04 Oct 2007)
New Revision: 2203
Added:
branches/trunk-reorg/thirdparty/cxml-2007-08-05/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/COPYING
branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Entries
branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Entries.Log
branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Repository
branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Root
branches/trunk-reorg/thirdparty/cxml-2007-08-05/DOMTEST
branches/trunk-reorg/thirdparty/cxml-2007-08-05/GNUmakefile
branches/trunk-reorg/thirdparty/cxml-2007-08-05/OLDNEWS
branches/trunk-reorg/thirdparty/cxml-2007-08-05/README
branches/trunk-reorg/thirdparty/cxml-2007-08-05/TIMES
branches/trunk-reorg/thirdparty/cxml-2007-08-05/XMLCONF
branches/trunk-reorg/thirdparty/cxml-2007-08-05/XMLS-SYMBOLS.diff
branches/trunk-reorg/thirdparty/cxml-2007-08-05/catalog.dtd
branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Entries
branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Repository
branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Root
branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/xhtmlgen.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/cxml.asd
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Entries
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Repository
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Root
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/GNUmakefile
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/bg.png
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/cxml.css
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/dom.html
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/dom.xml
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/html.xsl
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/index.html
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/index.xml
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/installation.html
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/installation.xml
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/klacks.html
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/klacks.xml
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/quickstart.html
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/quickstart.xml
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/sax.html
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/sax.xml
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/xmls-compat.html
branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/xmls-compat.xml
branches/trunk-reorg/thirdparty/cxml-2007-08-05/documentation.css
branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Entries
branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Repository
branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Root
branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-builder.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-impl.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-sax.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/package.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Entries
branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Repository
branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Root
branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/klacks-impl.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/klacks.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/package.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/tap-source.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/mlisp-patch.diff
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes.asd
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Entries
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Repository
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Root
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/characters.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/definline.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/encodings-data.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/encodings.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/package.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/runes.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/stream-scl.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/syntax.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/utf8.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/xstream.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/ystream.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Entries
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Repository
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Root
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/domtest.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/misc.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/utf8domtest.diff
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/xmlconf-base.diff
branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/xmlconf.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Entries
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Entries.Log
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Repository
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Root
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/catalog.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/package.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/recoder.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-handler.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-proxy.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Entries
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Repository
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Root
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/event-collecting-handler.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/package.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/tests.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/space-normalizer.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/split-sequence.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/unparse.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/util.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xml-name-rune-p.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xml-parse.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmlns-normalizer.lisp
branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmls-compat.lisp
Log:
update cxml
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/COPYING
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/COPYING 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/COPYING 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,526 @@
+Closure XML -- a Common Lisp XML parser
+
+Copyright (c) 1999 by Gilbert Baumann
+Copyright (c) 2003 by Henrik Motakef
+Copyright (c) 2004 knowledgeTools Int. GmbH
+Copyright (c) 2004,2005 David Lichteblau
+
+Preamble to the Gnu Lesser General Public License
+
+The concept of the GNU Lesser General Public License version 2.1
+("LGPL") has been adopted to govern the use and distribution of
+above-mentioned application. However, the LGPL uses terminology that is
+more appropriate for a program written in C than one written in
+Lisp. Nevertheless, the LGPL can still be applied to a Lisp program if
+certain clarifications are made. This document details those
+clarifications. Accordingly, the license for the open-source Lisp
+applications consists of this document plus the LGPL. Wherever there is
+a conflict between this document and the LGPL, this document takes
+precedence over the LGPL.
+
+A "Library" in Lisp is a collection of Lisp functions, data and foreign
+modules. The form of the Library can be Lisp source code (for processing
+by an interpreter) or object code (usually the result of compilation of
+source code or built with some other mechanisms). Foreign modules are
+object code in a form that can be linked into a Lisp executable. When we
+speak of functions we do so in the most general way to include, in
+addition, methods and unnamed functions. Lisp "data" is also a general
+term that includes the data structures resulting from defining Lisp
+classes. A Lisp application may include the same set of Lisp objects as
+does a Library, but this does not mean that the application is
+necessarily a "work based on the Library" it contains.
+
+The Library consists of everything in the distribution file set before
+any modifications are made to the files. If any of the functions or
+classes in the Library are redefined in other files, then those
+redefinitions ARE considered a work based on the Library. If additional
+methods are added to generic functions in the Library, those additional
+methods are NOT considered a work based on the Library. If Library
+classes are subclassed, these subclasses are NOT considered a work based
+on the Library. If the Library is modified to explicitly call other
+functions that are neither part of Lisp itself nor an available add-on
+module to Lisp, then the functions called by the modified Library ARE
+considered a work based on the Library. The goal is to ensure that the
+Library will compile and run without getting undefined function errors.
+
+It is permitted to add proprietary source code to the Library, but it
+must be done in a way such that the Library will still run without that
+proprietary code present. Section 5 of the LGPL distinguishes between
+the case of a library being dynamically linked at runtime and one being
+statically linked at build time. Section 5 of the LGPL states that the
+former results in an executable that is a "work that uses the Library."
+Section 5 of the LGPL states that the latter results in one that is a
+"derivative of the Library", which is therefore covered by the
+LGPL. Since Lisp only offers one choice, which is to link the Library
+into an executable at build time, we declare that, for the purpose
+applying the LGPL to the Library, an executable that results from
+linking a "work that uses the Library" with the Library is considered a
+"work that uses the Library" and is therefore NOT covered by the LGPL.
+
+Because of this declaration, section 6 of LGPL is not applicable to the
+Library. However, in connection with each distribution of this
+executable, you must also deliver, in accordance with the terms and
+conditions of the LGPL, the source code of Library (or your derivative
+thereof) that is incorporated into this executable.
+
+End of Document
+------------------------------------------------------------------------
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 2.1, February 1999
+
+ Copyright (C) 1991, 1999 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the Lesser GPL. It also counts
+ as the successor of the GNU Library Public License, version 2, hence
+ the version number 2.1.]
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+ This license, the Lesser General Public License, applies to some
+specially designated software packages--typically libraries--of the
+Free Software Foundation and other authors who decide to use it. You
+can use it too, but we suggest you first think carefully about whether
+this license or the ordinary General Public License is the better
+strategy to use in any particular case, based on the explanations below.
+
+ When we speak of free software, we are referring to freedom of use,
+not price. Our General Public Licenses are designed to make sure that
+you have the freedom to distribute copies of free software (and charge
+for this service if you wish); that you receive source code or can get
+it if you want it; that you can change the software and use pieces of
+it in new free programs; and that you are informed that you can do
+these things.
+
+ To protect your rights, we need to make restrictions that forbid
+distributors to deny you these rights or to ask you to surrender these
+rights. These restrictions translate to certain responsibilities for
+you if you distribute copies of the library or if you modify it.
+
+ For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you. You must make sure that they, too, receive or can get the source
+code. If you link other code with the library, you must provide
+complete object files to the recipients, so that they can relink them
+with the library after making changes to the library and recompiling
+it. And you must show them these terms so they know their rights.
+
+ We protect your rights with a two-step method: (1) we copyright the
+library, and (2) we offer you this license, which gives you legal
+permission to copy, distribute and/or modify the library.
+
+ To protect each distributor, we want to make it very clear that
+there is no warranty for the free library. Also, if the library is
+modified by someone else and passed on, the recipients should know
+that what they have is not the original version, so that the original
+author's reputation will not be affected by problems that might be
+introduced by others.
+
+ Finally, software patents pose a constant threat to the existence of
+any free program. We wish to make sure that a company cannot
+effectively restrict the users of a free program by obtaining a
+restrictive license from a patent holder. Therefore, we insist that
+any patent license obtained for a version of the library must be
+consistent with the full freedom of use specified in this license.
+
+ Most GNU software, including some libraries, is covered by the
+ordinary GNU General Public License. This license, the GNU Lesser
+General Public License, applies to certain designated libraries, and
+is quite different from the ordinary General Public License. We use
+this license for certain libraries in order to permit linking those
+libraries into non-free programs.
+
+ When a program is linked with a library, whether statically or using
+a shared library, the combination of the two is legally speaking a
+combined work, a derivative of the original library. The ordinary
+General Public License therefore permits such linking only if the
+entire combination fits its criteria of freedom. The Lesser General
+Public License permits more lax criteria for linking other code with
+the library.
+
+ We call this license the "Lesser" General Public License because it
+does Less to protect the user's freedom than the ordinary General
+Public License. It also provides other free software developers Less
+of an advantage over competing non-free programs. These disadvantages
+are the reason we use the ordinary General Public License for many
+libraries. However, the Lesser license provides advantages in certain
+special circumstances.
+
+ For example, on rare occasions, there may be a special need to
+encourage the widest possible use of a certain library, so that it becomes
+a de-facto standard. To achieve this, non-free programs must be
+allowed to use the library. A more frequent case is that a free
+library does the same job as widely used non-free libraries. In this
+case, there is little to gain by limiting the free library to free
+software only, so we use the Lesser General Public License.
+
+ In other cases, permission to use a particular library in non-free
+programs enables a greater number of people to use a large body of
+free software. For example, permission to use the GNU C Library in
+non-free programs enables many more people to use the whole GNU
+operating system, as well as its variant, the GNU/Linux operating
+system.
+
+ Although the Lesser General Public License is Less protective of the
+users' freedom, it does ensure that the user of a program that is
+linked with the Library has the freedom and the wherewithal to run
+that program using a modified version of the Library.
+
+ The precise terms and conditions for copying, distribution and
+modification follow. Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library". The
+former contains code derived from the library, whereas the latter must
+be combined with the library in order to run.
+
+ GNU LESSER GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any software library or other
+program which contains a notice placed by the copyright holder or
+other authorized party saying it may be distributed under the terms of
+this Lesser General Public License (also called "this License").
+Each licensee is addressed as "you".
+
+ A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+ The "Library", below, refers to any such software library or work
+which has been distributed under these terms. A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language. (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+ "Source code" for a work means the preferred form of the work for
+making modifications to it. For a library, complete source code means
+all the source code for all modules it contains, plus any associated
+interface definition files, plus the scripts used to control compilation
+and installation of the library.
+
+ Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it). Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+ 1. You may copy and distribute verbatim copies of the Library's
+complete source code as you receive it, in any medium, provided that
+you conspicuously and appropriately publish on each copy an
+appropriate copyright notice and disclaimer of warranty; keep intact
+all the notices that refer to this License and to the absence of any
+warranty; and distribute a copy of this License along with the
+Library.
+
+ You may charge a fee for the physical act of transferring a copy,
+and you may at your option offer warranty protection in exchange for a
+fee.
+
+ 2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) The modified work must itself be a software library.
+
+ b) You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ c) You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+
+ d) If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Library,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Library, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote
+it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library. To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License. (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.) Do not make any other change in
+these notices.
+
+ Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+ This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+ 4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you accompany
+it with the complete corresponding machine-readable source code, which
+must be distributed under the terms of Sections 1 and 2 above on a
+medium customarily used for software interchange.
+
+ If distribution of object code is made by offering access to copy
+from a designated place, then offering equivalent access to copy the
+source code from the same place satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library". Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+ However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library". The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+ When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library. The
+threshold for this to be true is not precisely defined by law.
+
+ If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work. (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+ Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+
+ 6. As an exception to the Sections above, you may also combine or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+ You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License. You must supply a copy of this License. If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License. Also, you must do one
+of these things:
+
+ a) Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood
+ that the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+
+ b) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (1) uses at run time a
+ copy of the library already present on the user's computer system,
+ rather than copying library functions into the executable, and (2)
+ will operate properly with a modified version of the library, if
+ the user installs one, as long as the modified version is
+ interface-compatible with the version that the work was made with.
+
+ c) Accompany the work with a written offer, valid for at
+ least three years, to give the same user the materials
+ specified in Subsection 6a, above, for a charge no more
+ than the cost of performing this distribution.
+
+ d) If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+
+ e) Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+
+ For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it. However, as a special exception,
+the materials to be distributed need not include anything that is
+normally distributed (in either source or binary form) with the major
+components (compiler, kernel, and so on) of the operating system on
+which the executable runs, unless that component itself accompanies
+the executable.
+
+ It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system. Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+
+ 7. You may place library facilities that are a work based on the
+Library side-by-side in a single library together with other library
+facilities not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+ a) Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+
+ b) Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+
+ 8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License. Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library is void, and will automatically terminate your
+rights under this License. However, parties who have received copies,
+or rights, from you under this License will not have their licenses
+terminated so long as such parties remain in full compliance.
+
+ 9. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Library or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+ 10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+subject to these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties with
+this License.
+
+ 11. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Library at all. For example, if a patent
+license would not permit royalty-free redistribution of the Library by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Library.
+
+If any portion of this section is held invalid or unenforceable under any
+particular circumstance, the balance of the section is intended to apply,
+and the section as a whole is intended to apply in other circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library under this License may add
+an explicit geographical distribution limitation excluding those countries,
+so that distribution is permitted only in or among countries not thus
+excluded. In such case, this License incorporates the limitation as if
+written in the body of this License.
+
+ 13. The Free Software Foundation may publish revised and/or new
+versions of the Lesser General Public License from time to time.
+Such new versions will be similar in spirit to the present version,
+but may differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Library
+specifies a version number of this License which applies to it and
+"any later version", you have the option of following the terms and
+conditions either of that version or of any later version published by
+the Free Software Foundation. If the Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+
+ 14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+write to the author to ask for permission. For software which is
+copyrighted by the Free Software Foundation, write to the Free
+Software Foundation; we sometimes make exceptions for this. Our
+decision will be guided by the two goals of preserving the free status
+of all derivatives of our free software and of promoting the sharing
+and reuse of software generally.
+
+ NO WARRANTY
+
+ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Entries 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Entries 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,14 @@
+/COPYING/1.2/Sun Dec 4 23:51:40 2005//
+/DOMTEST/1.33/Thu Dec 29 00:37:57 2005//
+/GNUmakefile/1.2/Thu Jul 5 20:58:15 2007//
+/OLDNEWS/1.1.1.1/Sun Mar 13 18:02:44 2005//
+/README/1.1/Sun Feb 18 12:35:49 2007//
+/TIMES/1.1.1.1/Sun Mar 13 18:02:46 2005//
+/XMLCONF/1.42/Sat Dec 3 21:54:42 2005//
+/XMLS-SYMBOLS.diff/1.1.1.1/Sun Mar 13 18:02:48 2005//
+/catalog.dtd/1.1.1.1/Sun Mar 13 18:02:52 2005//
+/cxml.asd/1.20/Thu Jul 5 20:58:15 2007//
+/documentation.css/1.1.1.1/Sun Mar 13 18:02:28 2005//
+/mlisp-patch.diff/1.2/Wed Apr 6 19:25:18 2005//
+/runes.asd/1.4/Thu Jul 5 20:58:15 2007//
+D
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Entries.Log
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Entries.Log 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Entries.Log 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,11 @@
+A D/contrib////
+A D/doc////
+A D/dom////
+A D/glisp////
+A D/klacks////
+A D/pull////
+A D/runes////
+A D/test////
+A D/xml////
+R D/pull////
+R D/glisp////
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Repository 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Repository 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+cxml
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Root 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/CVS/Root 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cxml/cvsroot
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/DOMTEST
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/DOMTEST 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/DOMTEST 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,840 @@
+
+#P"/home/david/2001/DOM-Test-Suite/tests/level1/core/"
+0/806 attrcreatedocumentfragment.xml
+1/806 attrcreatetextnode.xml
+2/806 attrcreatetextnode2.xml
+3/806 attrdefaultvalue.xml
+4/806 attreffectivevalue.xml
+5/806 attrentityreplacement.xml
+6/806 attrname.xml
+7/806 attrnextsiblingnull.xml
+8/806 attrnotspecifiedvalue.xml
+9/806 attrparentnodenull.xml
+10/806 attrprevioussiblingnull.xml
+11/806 attrsetvaluenomodificationallowederr.xml
+implementationAttribute expandEntityReferences not supported, skipping test
+12/806 attrsetvaluenomodificationallowederrEE.xml
+13/806 attrspecifiedvalue.xml
+14/806 attrspecifiedvaluechanged.xml
+15/806 attrspecifiedvalueremove.xml
+16/806 cdatasectiongetdata.xml
+implementationAttribute coalescing not supported, skipping test
+17/806 cdatasectionnormalize.xml
+18/806 characterdataappenddata.xml
+19/806 characterdataappenddatagetdata.xml
+20/806 characterdataappenddatanomodificationallowederr.xml
+21/806 characterdataappenddatanomodificationallowederrEE.xml
+22/806 characterdatadeletedatabegining.xml
+23/806 characterdatadeletedataend.xml
+24/806 characterdatadeletedataexceedslength.xml
+25/806 characterdatadeletedatagetlengthanddata.xml
+26/806 characterdatadeletedatamiddle.xml
+27/806 characterdatadeletedatanomodificationallowederrEE.xml
+28/806 characterdatagetdata.xml
+29/806 characterdatagetlength.xml
+30/806 characterdataindexsizeerrdeletedatacountnegative.xml
+implementationAttribute signed not supported, skipping test
+31/806 characterdataindexsizeerrdeletedataoffsetgreater.xml
+32/806 characterdataindexsizeerrdeletedataoffsetnegative.xml
+implementationAttribute signed not supported, skipping test
+33/806 characterdataindexsizeerrinsertdataoffsetgreater.xml
+34/806 characterdataindexsizeerrinsertdataoffsetnegative.xml
+implementationAttribute signed not supported, skipping test
+35/806 characterdataindexsizeerrreplacedatacountnegative.xml
+implementationAttribute signed not supported, skipping test
+36/806 characterdataindexsizeerrreplacedataoffsetgreater.xml
+37/806 characterdataindexsizeerrreplacedataoffsetnegative.xml
+implementationAttribute signed not supported, skipping test
+38/806 characterdataindexsizeerrsubstringcountnegative.xml
+implementationAttribute signed not supported, skipping test
+39/806 characterdataindexsizeerrsubstringnegativeoffset.xml
+implementationAttribute signed not supported, skipping test
+40/806 characterdataindexsizeerrsubstringoffsetgreater.xml
+41/806 characterdatainsertdatabeginning.xml
+42/806 characterdatainsertdataend.xml
+43/806 characterdatainsertdatamiddle.xml
+44/806 characterdatainsertdatanomodificationallowederr.xml
+45/806 characterdatainsertdatanomodificationallowederrEE.xml
+46/806 characterdatareplacedatabegining.xml
+47/806 characterdatareplacedataend.xml
+48/806 characterdatareplacedataexceedslengthofarg.xml
+49/806 characterdatareplacedataexceedslengthofdata.xml
+50/806 characterdatareplacedatamiddle.xml
+51/806 characterdatareplacedatanomodificationallowederr.xml
+52/806 characterdatareplacedatanomodificationallowederrEE.xml
+53/806 characterdatasetdatanomodificationallowederr.xml
+54/806 characterdatasetdatanomodificationallowederrEE.xml
+55/806 characterdatasetnodevalue.xml
+56/806 characterdatasubstringexceedsvalue.xml
+57/806 characterdatasubstringvalue.xml
+58/806 commentgetcomment.xml
+59/806 documentcreateattribute.xml
+60/806 documentcreatecdatasection.xml
+61/806 documentcreatecomment.xml
+62/806 documentcreatedocumentfragment.xml
+63/806 documentcreateelement.xml
+64/806 documentcreateelementcasesensitive.xml
+65/806 documentcreateelementdefaultattr.xml
+66/806 documentcreateentityreference.xml
+67/806 documentcreateentityreferenceknown.xml
+68/806 documentcreateprocessinginstruction.xml
+69/806 documentcreatetextnode.xml
+70/806 documentgetdoctype.xml
+71/806 documentgetdoctypenodtd.xml
+72/806 documentgetelementsbytagnamelength.xml
+73/806 documentgetelementsbytagnametotallength.xml
+74/806 documentgetelementsbytagnamevalue.xml
+75/806 documentgetimplementation.xml
+76/806 documentgetrootnode.xml
+77/806 documentinvalidcharacterexceptioncreateattribute.xml
+78/806 documentinvalidcharacterexceptioncreateelement.xml
+79/806 documentinvalidcharacterexceptioncreateentref.xml
+80/806 documentinvalidcharacterexceptioncreateentref1.xml
+81/806 documentinvalidcharacterexceptioncreatepi.xml
+82/806 documentinvalidcharacterexceptioncreatepi1.xml
+83/806 documenttypegetdoctype.xml
+84/806 documenttypegetentities.xml
+85/806 documenttypegetentitieslength.xml
+86/806 documenttypegetentitiestype.xml
+87/806 documenttypegetnotations.xml
+88/806 documenttypegetnotationstype.xml
+89/806 domimplementationfeaturenoversion.xml
+90/806 domimplementationfeaturenull.xml
+implementationAttribute hasNullString not supported, skipping test
+91/806 domimplementationfeaturexml.xml
+92/806 elementaddnewattribute.xml
+93/806 elementassociatedattribute.xml
+94/806 elementchangeattributevalue.xml
+95/806 elementcreatenewattribute.xml
+96/806 elementgetattributenode.xml
+97/806 elementgetattributenodenull.xml
+98/806 elementgetelementempty.xml
+99/806 elementgetelementsbytagname.xml
+100/806 elementgetelementsbytagnameaccessnodelist.xml
+101/806 elementgetelementsbytagnamenomatch.xml
+102/806 elementgetelementsbytagnamespecialvalue.xml
+103/806 elementgettagname.xml
+104/806 elementinuseattributeerr.xml
+105/806 elementinvalidcharacterexception.xml
+106/806 elementnormalize.xml
+107/806 elementnotfounderr.xml
+108/806 elementremoveattribute.xml
+109/806 elementremoveattributeaftercreate.xml
+110/806 elementremoveattributenode.xml
+111/806 elementremoveattributenodenomodificationallowederr.xml
+112/806 elementremoveattributenodenomodificationallowederrEE.xml
+113/806 elementremoveattributenomodificationallowederr.xml
+114/806 elementremoveattributenomodificationallowederrEE.xml
+115/806 elementremoveattributerestoredefaultvalue.xml
+116/806 elementreplaceattributewithself.xml
+117/806 elementreplaceexistingattribute.xml
+118/806 elementreplaceexistingattributegevalue.xml
+119/806 elementretrieveallattributes.xml
+120/806 elementretrieveattrvalue.xml
+121/806 elementretrievetagname.xml
+122/806 elementsetattributenodenomodificationallowederr.xml
+123/806 elementsetattributenodenomodificationallowederrEE.xml
+implementationAttribute expandEntityReferences not supported, skipping test
+124/806 elementsetattributenodenull.xml
+125/806 elementsetattributenomodificationallowederr.xml
+implementationAttribute expandEntityReferences not supported, skipping test
+126/806 elementsetattributenomodificationallowederrEE.xml
+127/806 elementwrongdocumenterr.xml
+128/806 entitygetentityname.xml
+129/806 entitygetpublicid.xml
+130/806 entitygetpublicidnull.xml
+131/806 namednodemapchildnoderange.xml
+132/806 namednodemapgetnameditem.xml
+133/806 namednodemapinuseattributeerr.xml
+134/806 namednodemapnotfounderr.xml
+135/806 namednodemapnumberofnodes.xml
+136/806 namednodemapremovenameditem.xml
+137/806 namednodemapremovenameditemgetvalue.xml
+138/806 namednodemapremovenameditemreturnnodevalue.xml
+139/806 namednodemapreturnattrnode.xml
+140/806 namednodemapreturnfirstitem.xml
+141/806 namednodemapreturnlastitem.xml
+142/806 namednodemapreturnnull.xml
+143/806 namednodemapsetnameditem.xml
+144/806 namednodemapsetnameditemreturnvalue.xml
+145/806 namednodemapsetnameditemthatexists.xml
+146/806 namednodemapsetnameditemwithnewvalue.xml
+147/806 namednodemapwrongdocumenterr.xml
+148/806 nodeappendchild.xml
+149/806 nodeappendchildchildexists.xml
+150/806 nodeappendchilddocfragment.xml
+151/806 nodeappendchildgetnodename.xml
+152/806 nodeappendchildinvalidnodetype.xml
+153/806 nodeappendchildnewchilddiffdocument.xml
+154/806 nodeappendchildnodeancestor.xml
+155/806 nodeappendchildnomodificationallowederr.xml
+156/806 nodeappendchildnomodificationallowederrEE.xml
+157/806 nodeattributenodeattribute.xml
+158/806 nodeattributenodename.xml
+159/806 nodeattributenodetype.xml
+160/806 nodeattributenodevalue.xml
+161/806 nodecdatasectionnodeattribute.xml
+162/806 nodecdatasectionnodename.xml
+163/806 nodecdatasectionnodetype.xml
+implementationAttribute coalescing not supported, skipping test
+164/806 nodecdatasectionnodevalue.xml
+implementationAttribute coalescing not supported, skipping test
+165/806 nodechildnodes.xml
+166/806 nodechildnodesappendchild.xml
+167/806 nodechildnodesempty.xml
+168/806 nodecloneattributescopied.xml
+169/806 nodeclonefalsenocopytext.xml
+170/806 nodeclonegetparentnull.xml
+171/806 nodeclonenodefalse.xml
+172/806 nodeclonenodetrue.xml
+173/806 nodeclonetruecopytext.xml
+174/806 nodecommentnodeattributes.xml
+175/806 nodecommentnodename.xml
+176/806 nodecommentnodetype.xml
+177/806 nodecommentnodevalue.xml
+178/806 nodedocumentfragmentnodename.xml
+179/806 nodedocumentfragmentnodetype.xml
+180/806 nodedocumentfragmentnodevalue.xml
+181/806 nodedocumentnodeattribute.xml
+182/806 nodedocumentnodename.xml
+183/806 nodedocumentnodetype.xml
+184/806 nodedocumentnodevalue.xml
+185/806 nodedocumenttypenodename.xml
+186/806 nodedocumenttypenodetype.xml
+187/806 nodedocumenttypenodevalue.xml
+188/806 nodeelementnodeattributes.xml
+189/806 nodeelementnodename.xml
+190/806 nodeelementnodetype.xml
+191/806 nodeelementnodevalue.xml
+192/806 nodeentitynodeattributes.xml
+193/806 nodeentitynodename.xml
+194/806 nodeentitynodetype.xml
+195/806 nodeentitynodevalue.xml
+196/806 nodeentitysetnodevalue.xml
+197/806 nodeentityreferencenodeattributes.xml
+198/806 nodeentityreferencenodename.xml
+199/806 nodeentityreferencenodetype.xml
+200/806 nodeentityreferencenodevalue.xml
+201/806 nodegetfirstchild.xml
+202/806 nodegetfirstchildnull.xml
+203/806 nodegetlastchild.xml
+204/806 nodegetlastchildnull.xml
+205/806 nodegetnextsibling.xml
+206/806 nodegetnextsiblingnull.xml
+207/806 nodegetownerdocument.xml
+208/806 nodegetownerdocumentnull.xml
+209/806 nodegetprevioussibling.xml
+210/806 nodegetprevioussiblingnull.xml
+211/806 nodehaschildnodes.xml
+212/806 nodehaschildnodesfalse.xml
+213/806 nodeinsertbefore.xml
+214/806 nodeinsertbeforedocfragment.xml
+215/806 nodeinsertbeforeinvalidnodetype.xml
+216/806 nodeinsertbeforenewchilddiffdocument.xml
+217/806 nodeinsertbeforenewchildexists.xml
+218/806 nodeinsertbeforenodeancestor.xml
+219/806 nodeinsertbeforenodename.xml
+220/806 nodeinsertbeforenomodificationallowederr.xml
+221/806 nodeinsertbeforenomodificationallowederrEE.xml
+222/806 nodeinsertbeforerefchildnonexistent.xml
+223/806 nodeinsertbeforerefchildnull.xml
+224/806 nodelistindexequalzero.xml
+225/806 nodelistindexgetlength.xml
+226/806 nodelistindexgetlengthofemptylist.xml
+227/806 nodelistindexnotzero.xml
+228/806 nodelistreturnfirstitem.xml
+229/806 nodelistreturnlastitem.xml
+230/806 nodelisttraverselist.xml
+231/806 nodenotationnodeattributes.xml
+232/806 nodenotationnodename.xml
+233/806 nodenotationnodetype.xml
+234/806 nodenotationnodevalue.xml
+235/806 nodeparentnode.xml
+236/806 nodeparentnodenull.xml
+237/806 nodeprocessinginstructionnodeattributes.xml
+238/806 nodeprocessinginstructionnodename.xml
+239/806 nodeprocessinginstructionnodetype.xml
+240/806 nodeprocessinginstructionnodevalue.xml
+241/806 nodeprocessinginstructionsetnodevalue.xml
+242/806 noderemovechild.xml
+243/806 noderemovechildgetnodename.xml
+244/806 noderemovechildnode.xml
+245/806 noderemovechildnomodificationallowederr.xml
+246/806 noderemovechildnomodificationallowederrEE.xml
+247/806 noderemovechildoldchildnonexistent.xml
+248/806 nodereplacechild.xml
+249/806 nodereplacechildinvalidnodetype.xml
+250/806 nodereplacechildnewchilddiffdocument.xml
+251/806 nodereplacechildnewchildexists.xml
+252/806 nodereplacechildnodeancestor.xml
+253/806 nodereplacechildnodename.xml
+254/806 nodereplacechildnomodificationallowederr.xml
+255/806 nodereplacechildnomodificationallowederrEE.xml
+256/806 nodereplacechildoldchildnonexistent.xml
+257/806 nodesetnodevaluenomodificationallowederr.xml
+258/806 nodesetnodevaluenomodificationallowederrEE.xml
+259/806 nodetextnodeattribute.xml
+260/806 nodetextnodename.xml
+261/806 nodetextnodetype.xml
+262/806 nodetextnodevalue.xml
+263/806 notationgetnotationname.xml
+264/806 notationgetpublicid.xml
+265/806 notationgetpublicidnull.xml
+266/806 notationgetsystemid.xml
+267/806 notationgetsystemidnull.xml
+268/806 processinginstructiongetdata.xml
+269/806 processinginstructiongettarget.xml
+270/806 processinginstructionsetdatanomodificationallowederr.xml
+implementationAttribute expandEntityReferences not supported, skipping test
+271/806 processinginstructionsetdatanomodificationallowederrEE.xml
+272/806 textindexsizeerrnegativeoffset.xml
+implementationAttribute signed not supported, skipping test
+273/806 textindexsizeerroffsetoutofbounds.xml
+274/806 textparseintolistofelements.xml
+275/806 textsplittextfour.xml
+276/806 textsplittextnomodificationallowederr.xml
+277/806 textsplittextnomodificationallowederrEE.xml
+278/806 textsplittextone.xml
+279/806 textsplittextthree.xml
+280/806 textsplittexttwo.xml
+281/806 textwithnomarkup.xml
+282/806 nodevalue01.xml
+283/806 nodevalue02.xml
+284/806 nodevalue03.xml
+285/806 nodevalue04.xml
+286/806 nodevalue05.xml
+287/806 nodevalue06.xml
+288/806 nodevalue07.xml
+289/806 nodevalue08.xml
+290/806 nodevalue09.xml
+291/806 hc_attrcreatedocumentfragment.xml
+292/806 hc_attrcreatetextnode.xml
+293/806 hc_attrcreatetextnode2.xml
+294/806 hc_attreffectivevalue.xml
+295/806 hc_attrname.xml
+296/806 hc_attrnextsiblingnull.xml
+297/806 hc_attrparentnodenull.xml
+298/806 hc_attrprevioussiblingnull.xml
+299/806 hc_attrspecifiedvalue.xml
+300/806 hc_attrspecifiedvaluechanged.xml
+301/806 hc_characterdataappenddata.xml
+302/806 hc_characterdataappenddatagetdata.xml
+303/806 hc_characterdatadeletedatabegining.xml
+304/806 hc_characterdatadeletedataend.xml
+305/806 hc_characterdatadeletedataexceedslength.xml
+306/806 hc_characterdatadeletedatagetlengthanddata.xml
+307/806 hc_characterdatadeletedatamiddle.xml
+308/806 hc_characterdatagetdata.xml
+309/806 hc_characterdatagetlength.xml
+310/806 hc_characterdataindexsizeerrdeletedatacountnegative.xml
+implementationAttribute signed not supported, skipping test
+311/806 hc_characterdataindexsizeerrdeletedataoffsetgreater.xml
+312/806 hc_characterdataindexsizeerrdeletedataoffsetnegative.xml
+implementationAttribute signed not supported, skipping test
+313/806 hc_characterdataindexsizeerrinsertdataoffsetgreater.xml
+314/806 hc_characterdataindexsizeerrinsertdataoffsetnegative.xml
+implementationAttribute signed not supported, skipping test
+315/806 hc_characterdataindexsizeerrreplacedatacountnegative.xml
+implementationAttribute signed not supported, skipping test
+316/806 hc_characterdataindexsizeerrreplacedataoffsetgreater.xml
+317/806 hc_characterdataindexsizeerrreplacedataoffsetnegative.xml
+implementationAttribute signed not supported, skipping test
+318/806 hc_characterdataindexsizeerrsubstringcountnegative.xml
+implementationAttribute signed not supported, skipping test
+319/806 hc_characterdataindexsizeerrsubstringnegativeoffset.xml
+implementationAttribute signed not supported, skipping test
+320/806 hc_characterdataindexsizeerrsubstringoffsetgreater.xml
+321/806 hc_characterdatainsertdatabeginning.xml
+322/806 hc_characterdatainsertdataend.xml
+323/806 hc_characterdatainsertdatamiddle.xml
+324/806 hc_characterdatareplacedatabegining.xml
+325/806 hc_characterdatareplacedataend.xml
+326/806 hc_characterdatareplacedataexceedslengthofarg.xml
+327/806 hc_characterdatareplacedataexceedslengthofdata.xml
+328/806 hc_characterdatareplacedatamiddle.xml
+329/806 hc_characterdatasetnodevalue.xml
+330/806 hc_characterdatasubstringexceedsvalue.xml
+331/806 hc_characterdatasubstringvalue.xml
+332/806 hc_commentgetcomment.xml
+333/806 hc_documentcreateattribute.xml
+334/806 hc_documentcreatecomment.xml
+335/806 hc_documentcreatedocumentfragment.xml
+336/806 hc_documentcreateelement.xml
+337/806 hc_documentcreateelementcasesensitive.xml
+338/806 hc_documentcreatetextnode.xml
+339/806 hc_documentgetdoctype.xml
+340/806 hc_documentgetelementsbytagnamelength.xml
+341/806 hc_documentgetelementsbytagnametotallength.xml
+342/806 hc_documentgetelementsbytagnamevalue.xml
+343/806 hc_documentgetimplementation.xml
+344/806 hc_documentgetrootnode.xml
+345/806 hc_documentinvalidcharacterexceptioncreateattribute.xml
+346/806 hc_documentinvalidcharacterexceptioncreateattribute1.xml
+347/806 hc_documentinvalidcharacterexceptioncreateelement.xml
+348/806 hc_documentinvalidcharacterexceptioncreateelement1.xml
+349/806 hc_domimplementationfeaturenoversion.xml
+350/806 hc_domimplementationfeaturenull.xml
+implementationAttribute hasNullString not supported, skipping test
+351/806 hc_domimplementationfeaturexml.xml
+352/806 hc_elementaddnewattribute.xml
+353/806 hc_elementassociatedattribute.xml
+354/806 hc_elementchangeattributevalue.xml
+355/806 hc_elementcreatenewattribute.xml
+356/806 hc_elementgetattributenode.xml
+357/806 hc_elementgetattributenodenull.xml
+358/806 hc_elementgetelementempty.xml
+359/806 hc_elementgetelementsbytagname.xml
+360/806 hc_elementgetelementsbytagnameaccessnodelist.xml
+361/806 hc_elementgetelementsbytagnamenomatch.xml
+362/806 hc_elementgetelementsbytagnamespecialvalue.xml
+363/806 hc_elementgettagname.xml
+364/806 hc_elementinuseattributeerr.xml
+365/806 hc_elementinvalidcharacterexception.xml
+366/806 hc_elementinvalidcharacterexception1.xml
+367/806 hc_elementnormalize.xml
+368/806 hc_elementnotfounderr.xml
+369/806 hc_elementremoveattribute.xml
+370/806 hc_elementremoveattributeaftercreate.xml
+371/806 hc_elementremoveattributenode.xml
+372/806 hc_elementreplaceattributewithself.xml
+373/806 hc_elementreplaceexistingattribute.xml
+374/806 hc_elementreplaceexistingattributegevalue.xml
+375/806 hc_elementretrieveallattributes.xml
+376/806 hc_elementretrieveattrvalue.xml
+377/806 hc_elementretrievetagname.xml
+378/806 hc_elementsetattributenodenull.xml
+379/806 hc_elementwrongdocumenterr.xml
+380/806 hc_entitiesremovenameditem1.xml
+381/806 hc_entitiessetnameditem1.xml
+382/806 hc_namednodemapchildnoderange.xml
+383/806 hc_namednodemapgetnameditem.xml
+384/806 hc_namednodemapinuseattributeerr.xml
+385/806 hc_namednodemapnotfounderr.xml
+386/806 hc_namednodemapnumberofnodes.xml
+387/806 hc_namednodemapremovenameditem.xml
+388/806 hc_namednodemapreturnattrnode.xml
+389/806 hc_namednodemapreturnfirstitem.xml
+390/806 hc_namednodemapreturnlastitem.xml
+391/806 hc_namednodemapreturnnull.xml
+392/806 hc_namednodemapsetnameditem.xml
+393/806 hc_namednodemapsetnameditemreturnvalue.xml
+394/806 hc_namednodemapsetnameditemthatexists.xml
+395/806 hc_namednodemapsetnameditemwithnewvalue.xml
+396/806 hc_namednodemapwrongdocumenterr.xml
+397/806 hc_nodeappendchild.xml
+398/806 hc_nodeappendchildchildexists.xml
+399/806 hc_nodeappendchilddocfragment.xml
+400/806 hc_nodeappendchildgetnodename.xml
+401/806 hc_nodeappendchildinvalidnodetype.xml
+402/806 hc_nodeappendchildnewchilddiffdocument.xml
+403/806 hc_nodeappendchildnodeancestor.xml
+404/806 hc_nodeattributenodeattribute.xml
+405/806 hc_nodeattributenodename.xml
+406/806 hc_nodeattributenodetype.xml
+407/806 hc_nodeattributenodevalue.xml
+408/806 hc_nodechildnodes.xml
+409/806 hc_nodechildnodesappendchild.xml
+410/806 hc_nodechildnodesempty.xml
+411/806 hc_nodecloneattributescopied.xml
+412/806 hc_nodeclonefalsenocopytext.xml
+413/806 hc_nodeclonegetparentnull.xml
+414/806 hc_nodeclonenodefalse.xml
+415/806 hc_nodeclonenodetrue.xml
+416/806 hc_nodeclonetruecopytext.xml
+417/806 hc_nodecommentnodeattributes.xml
+418/806 hc_nodecommentnodename.xml
+419/806 hc_nodecommentnodetype.xml
+420/806 hc_nodecommentnodevalue.xml
+421/806 hc_nodedocumentfragmentnodename.xml
+422/806 hc_nodedocumentfragmentnodetype.xml
+423/806 hc_nodedocumentfragmentnodevalue.xml
+424/806 hc_nodedocumentnodeattribute.xml
+425/806 hc_nodedocumentnodename.xml
+426/806 hc_nodedocumentnodetype.xml
+427/806 hc_nodedocumentnodevalue.xml
+428/806 hc_nodeelementnodeattributes.xml
+429/806 hc_nodeelementnodename.xml
+430/806 hc_nodeelementnodetype.xml
+431/806 hc_nodeelementnodevalue.xml
+432/806 hc_nodegetfirstchild.xml
+433/806 hc_nodegetfirstchildnull.xml
+434/806 hc_nodegetlastchild.xml
+435/806 hc_nodegetlastchildnull.xml
+436/806 hc_nodegetnextsibling.xml
+437/806 hc_nodegetnextsiblingnull.xml
+438/806 hc_nodegetownerdocument.xml
+439/806 hc_nodegetownerdocumentnull.xml
+440/806 hc_nodegetprevioussibling.xml
+441/806 hc_nodegetprevioussiblingnull.xml
+442/806 hc_nodehaschildnodes.xml
+443/806 hc_nodehaschildnodesfalse.xml
+444/806 hc_nodeinsertbefore.xml
+445/806 hc_nodeinsertbeforedocfragment.xml
+446/806 hc_nodeinsertbeforeinvalidnodetype.xml
+447/806 hc_nodeinsertbeforenewchilddiffdocument.xml
+448/806 hc_nodeinsertbeforenewchildexists.xml
+449/806 hc_nodeinsertbeforenodeancestor.xml
+450/806 hc_nodeinsertbeforenodename.xml
+451/806 hc_nodeinsertbeforerefchildnonexistent.xml
+452/806 hc_nodeinsertbeforerefchildnull.xml
+453/806 hc_nodelistindexequalzero.xml
+454/806 hc_nodelistindexgetlength.xml
+455/806 hc_nodelistindexgetlengthofemptylist.xml
+456/806 hc_nodelistindexnotzero.xml
+457/806 hc_nodelistreturnfirstitem.xml
+458/806 hc_nodelistreturnlastitem.xml
+459/806 hc_nodelisttraverselist.xml
+460/806 hc_nodeparentnode.xml
+461/806 hc_nodeparentnodenull.xml
+462/806 hc_noderemovechild.xml
+463/806 hc_noderemovechildgetnodename.xml
+464/806 hc_noderemovechildnode.xml
+465/806 hc_noderemovechildoldchildnonexistent.xml
+466/806 hc_nodereplacechild.xml
+467/806 hc_nodereplacechildinvalidnodetype.xml
+468/806 hc_nodereplacechildnewchilddiffdocument.xml
+469/806 hc_nodereplacechildnodeancestor.xml
+470/806 hc_nodereplacechildnodename.xml
+471/806 hc_nodereplacechildoldchildnonexistent.xml
+472/806 hc_nodetextnodeattribute.xml
+473/806 hc_nodetextnodename.xml
+474/806 hc_nodetextnodetype.xml
+475/806 hc_nodetextnodevalue.xml
+476/806 hc_nodevalue01.xml
+477/806 hc_nodevalue02.xml
+478/806 hc_nodevalue03.xml
+479/806 hc_nodevalue04.xml
+480/806 hc_nodevalue05.xml
+481/806 hc_nodevalue06.xml
+482/806 hc_nodevalue07.xml
+483/806 hc_nodevalue08.xml
+484/806 hc_notationsremovenameditem1.xml
+485/806 hc_notationssetnameditem1.xml
+486/806 hc_textindexsizeerrnegativeoffset.xml
+implementationAttribute signed not supported, skipping test
+487/806 hc_textindexsizeerroffsetoutofbounds.xml
+488/806 hc_textparseintolistofelements.xml
+489/806 hc_textsplittextfour.xml
+490/806 hc_textsplittextone.xml
+491/806 hc_textsplittextthree.xml
+492/806 hc_textsplittexttwo.xml
+493/806 hc_textwithnomarkup.xml
+494/806 hc_attrappendchild1.xml
+495/806 hc_attrappendchild2.xml
+496/806 hc_attrappendchild3.xml
+497/806 hc_attrappendchild4.xml
+498/806 hc_attrappendchild5.xml
+499/806 hc_attrappendchild6.xml
+500/806 hc_attrchildnodes1.xml
+501/806 hc_attrchildnodes2.xml
+502/806 hc_attrclonenode1.xml
+503/806 hc_attrfirstchild.xml
+504/806 hc_attrgetvalue1.xml
+505/806 hc_attrgetvalue2.xml
+506/806 hc_attrhaschildnodes.xml
+507/806 hc_attrinsertbefore1.xml
+508/806 hc_attrinsertbefore2.xml
+509/806 hc_attrinsertbefore3.xml
+510/806 hc_attrinsertbefore4.xml
+511/806 hc_attrinsertbefore5.xml
+512/806 hc_attrinsertbefore6.xml
+513/806 hc_attrinsertbefore7.xml
+514/806 hc_attrlastchild.xml
+515/806 hc_attrnormalize.xml
+516/806 hc_attrremovechild1.xml
+517/806 hc_attrremovechild2.xml
+518/806 hc_attrreplacechild1.xml
+519/806 hc_attrreplacechild2.xml
+520/806 hc_attrsetvalue1.xml
+521/806 hc_attrsetvalue2.xml
+522/806 attrremovechild1.xml
+523/806 attrreplacechild1.xml
+
+#P"/home/david/2001/DOM-Test-Suite/tests/level2/core/"
+524/806 attrgetownerelement01.xml
+525/806 attrgetownerelement02.xml
+526/806 attrgetownerelement03.xml
+527/806 attrgetownerelement04.xml
+528/806 attrgetownerelement05.xml
+529/806 createAttributeNS01.xml
+530/806 createAttributeNS02.xml
+531/806 createAttributeNS03.xml
+532/806 createAttributeNS04.xml
+533/806 createAttributeNS05.xml
+534/806 createAttributeNS06.xml
+535/806 createDocument01.xml
+536/806 createDocument02.xml
+537/806 createDocument03.xml
+538/806 createDocument04.xml
+539/806 createDocument05.xml
+540/806 createDocument06.xml
+541/806 createDocument07.xml
+542/806 createDocument08.xml
+543/806 createDocumentType01.xml
+544/806 createDocumentType02.xml
+545/806 createDocumentType03.xml
+546/806 createDocumentType04.xml
+547/806 createElementNS01.xml
+548/806 createElementNS02.xml
+549/806 createElementNS03.xml
+550/806 createElementNS04.xml
+551/806 createElementNS05.xml
+552/806 documentcreateattributeNS01.xml
+553/806 documentcreateattributeNS02.xml
+554/806 documentcreateattributeNS03.xml
+555/806 documentcreateattributeNS04.xml
+556/806 documentcreateattributeNS05.xml
+557/806 documentcreateattributeNS06.xml
+558/806 documentcreateattributeNS07.xml
+559/806 documentcreateelementNS01.xml
+560/806 documentcreateelementNS02.xml
+561/806 documentcreateelementNS05.xml
+562/806 documentcreateelementNS06.xml
+563/806 documentgetelementbyid01.xml
+564/806 documentgetelementsbytagnameNS01.xml
+565/806 documentgetelementsbytagnameNS02.xml
+566/806 documentgetelementsbytagnameNS03.xml
+567/806 documentgetelementsbytagnameNS04.xml
+568/806 documentgetelementsbytagnameNS05.xml
+569/806 documentimportnode01.xml
+570/806 documentimportnode02.xml
+571/806 documentimportnode03.xml
+572/806 documentimportnode04.xml
+573/806 documentimportnode05.xml
+574/806 documentimportnode06.xml
+575/806 documentimportnode07.xml
+576/806 documentimportnode08.xml
+577/806 documentimportnode09.xml
+578/806 documentimportnode10.xml
+579/806 documentimportnode11.xml
+580/806 documentimportnode12.xml
+581/806 documentimportnode13.xml
+582/806 documentimportnode14.xml
+583/806 documentimportnode15.xml
+584/806 documentimportnode17.xml
+585/806 documentimportnode18.xml
+586/806 documentimportnode19.xml
+587/806 documentimportnode20.xml
+implementationAttribute expandEntityReferences not supported, skipping test
+588/806 documentimportnode21.xml
+implementationAttribute expandEntityReferences not supported, skipping test
+589/806 documentimportnode22.xml
+590/806 documenttypeinternalSubset01.xml
+591/806 documenttypepublicid01.xml
+592/806 documenttypesystemid01.xml
+593/806 domimplementationcreatedocument03.xml
+594/806 domimplementationcreatedocument04.xml
+595/806 domimplementationcreatedocument05.xml
+596/806 domimplementationcreatedocument07.xml
+597/806 domimplementationcreatedocumenttype01.xml
+598/806 domimplementationcreatedocumenttype02.xml
+599/806 domimplementationcreatedocumenttype04.xml
+600/806 domimplementationfeaturecore.xml
+601/806 domimplementationfeaturexmlversion2.xml
+602/806 domimplementationhasfeature01.xml
+603/806 domimplementationhasfeature02.xml
+604/806 elementgetattributenodens01.xml
+605/806 elementgetattributenodens02.xml
+606/806 elementgetattributenodens03.xml
+607/806 elementgetattributens02.xml
+608/806 elementgetelementsbytagnamens02.xml
+609/806 elementgetelementsbytagnamens04.xml
+610/806 elementgetelementsbytagnamens05.xml
+611/806 elementhasattribute01.xml
+612/806 elementhasattribute02.xml
+613/806 elementhasattribute03.xml
+614/806 elementhasattribute04.xml
+615/806 elementhasattributens01.xml
+616/806 elementhasattributens02.xml
+617/806 elementhasattributens03.xml
+618/806 elementremoveattributens01.xml
+619/806 elementsetattributenodens01.xml
+620/806 elementsetattributenodens02.xml
+621/806 elementsetattributenodens03.xml
+622/806 elementsetattributenodens04.xml
+623/806 elementsetattributenodens05.xml
+624/806 elementsetattributenodens06.xml
+implementationAttribute expandEntityReferences not supported, skipping test
+625/806 elementsetattributens01.xml
+626/806 elementsetattributens02.xml
+627/806 elementsetattributens03.xml
+628/806 elementsetattributens04.xml
+629/806 elementsetattributens05.xml
+630/806 elementsetattributens08.xml
+631/806 elementsetattributensurinull.xml
+632/806 getAttributeNS01.xml
+633/806 getAttributeNS02.xml
+634/806 getAttributeNS03.xml
+635/806 getAttributeNS04.xml
+636/806 getAttributeNS05.xml
+637/806 getAttributeNodeNS01.xml
+638/806 getAttributeNodeNS02.xml
+639/806 getElementById01.xml
+640/806 getElementById02.xml
+641/806 getElementsByTagNameNS01.xml
+642/806 getElementsByTagNameNS02.xml
+643/806 getElementsByTagNameNS03.xml
+644/806 getElementsByTagNameNS04.xml
+645/806 getElementsByTagNameNS05.xml
+646/806 getElementsByTagNameNS06.xml
+647/806 getElementsByTagNameNS07.xml
+648/806 getElementsByTagNameNS08.xml
+649/806 getElementsByTagNameNS09.xml
+650/806 getElementsByTagNameNS10.xml
+651/806 getElementsByTagNameNS11.xml
+652/806 getElementsByTagNameNS12.xml
+653/806 getElementsByTagNameNS13.xml
+654/806 getElementsByTagNameNS14.xml
+655/806 getNamedItemNS01.xml
+656/806 getNamedItemNS02.xml
+657/806 getNamedItemNS03.xml
+658/806 getNamedItemNS04.xml
+659/806 hasAttribute01.xml
+660/806 hasAttribute02.xml
+661/806 hasAttribute03.xml
+662/806 hasAttribute04.xml
+663/806 hasAttributeNS01.xml
+664/806 hasAttributeNS02.xml
+665/806 hasAttributeNS03.xml
+666/806 hasAttributeNS04.xml
+667/806 hasAttributeNS05.xml
+668/806 hasAttributes01.xml
+669/806 hasAttributes02.xml
+670/806 hc_entitiesremovenameditemns1.xml
+671/806 hc_entitiessetnameditemns1.xml
+672/806 hc_namednodemapinvalidtype1.xml
+673/806 hc_nodedocumentfragmentnormalize1.xml
+674/806 hc_nodedocumentfragmentnormalize2.xml
+675/806 hc_notationsremovenameditemns1.xml
+676/806 hc_notationssetnameditemns1.xml
+677/806 importNode01.xml
+678/806 importNode02.xml
+679/806 importNode03.xml
+680/806 importNode04.xml
+681/806 importNode05.xml
+682/806 importNode06.xml
+683/806 importNode07.xml
+684/806 importNode08.xml
+685/806 importNode09.xml
+686/806 importNode10.xml
+687/806 importNode11.xml
+688/806 importNode12.xml
+689/806 importNode13.xml
+690/806 importNode14.xml
+691/806 importNode15.xml
+692/806 importNode16.xml
+693/806 importNode17.xml
+694/806 internalSubset01.xml
+695/806 isSupported01.xml
+696/806 isSupported02.xml
+697/806 isSupported04.xml
+698/806 isSupported05.xml
+699/806 isSupported06.xml
+700/806 isSupported07.xml
+701/806 isSupported09.xml
+702/806 isSupported10.xml
+703/806 isSupported11.xml
+704/806 isSupported12.xml
+705/806 isSupported13.xml
+706/806 isSupported14.xml
+707/806 localName01.xml
+708/806 localName02.xml
+709/806 localName03.xml
+710/806 localName04.xml
+711/806 namednodemapgetnameditemns01.xml
+712/806 namednodemapgetnameditemns02.xml
+713/806 namednodemapgetnameditemns03.xml
+714/806 namednodemapgetnameditemns04.xml
+715/806 namednodemapgetnameditemns05.xml
+716/806 namednodemapgetnameditemns06.xml
+717/806 namednodemapremovenameditemns01.xml
+718/806 namednodemapremovenameditemns02.xml
+719/806 namednodemapremovenameditemns03.xml
+720/806 namednodemapremovenameditemns04.xml
+721/806 namednodemapremovenameditemns05.xml
+722/806 namednodemapremovenameditemns06.xml
+723/806 namednodemapremovenameditemns07.xml
+724/806 namednodemapremovenameditemns08.xml
+725/806 namednodemapremovenameditemns09.xml
+726/806 namednodemapsetnameditemns01.xml
+727/806 namednodemapsetnameditemns02.xml
+728/806 namednodemapsetnameditemns03.xml
+729/806 namednodemapsetnameditemns04.xml
+730/806 namednodemapsetnameditemns05.xml
+731/806 namednodemapsetnameditemns06.xml
+732/806 namednodemapsetnameditemns07.xml
+733/806 namednodemapsetnameditemns08.xml
+734/806 namednodemapsetnameditemns09.xml
+735/806 namednodemapsetnameditemns10.xml
+736/806 namednodemapsetnameditemns11.xml
+737/806 namespaceURI01.xml
+738/806 namespaceURI02.xml
+739/806 namespaceURI03.xml
+740/806 namespaceURI04.xml
+741/806 nodegetlocalname03.xml
+742/806 nodegetnamespaceuri03.xml
+743/806 nodegetownerdocument01.xml
+744/806 nodegetownerdocument02.xml
+745/806 nodegetprefix03.xml
+746/806 nodehasattributes01.xml
+747/806 nodehasattributes02.xml
+748/806 nodehasattributes03.xml
+749/806 nodehasattributes04.xml
+750/806 nodeissupported01.xml
+751/806 nodeissupported02.xml
+752/806 nodeissupported03.xml
+753/806 nodeissupported04.xml
+754/806 nodeissupported05.xml
+755/806 nodenormalize01.xml
+756/806 nodesetprefix01.xml
+757/806 nodesetprefix02.xml
+758/806 nodesetprefix03.xml
+759/806 nodesetprefix04.xml
+760/806 nodesetprefix05.xml
+761/806 nodesetprefix06.xml
+762/806 nodesetprefix07.xml
+763/806 nodesetprefix08.xml
+764/806 nodesetprefix09.xml
+765/806 normalize01.xml
+766/806 ownerDocument01.xml
+767/806 ownerElement01.xml
+768/806 ownerElement02.xml
+769/806 prefix01.xml
+770/806 prefix02.xml
+771/806 prefix03.xml
+772/806 prefix04.xml
+773/806 prefix05.xml
+774/806 prefix06.xml
+775/806 prefix07.xml
+776/806 prefix08.xml
+777/806 prefix09.xml
+778/806 prefix10.xml
+779/806 prefix11.xml
+780/806 publicId01.xml
+781/806 removeAttributeNS01.xml
+782/806 removeAttributeNS02.xml
+783/806 removeNamedItemNS01.xml
+784/806 removeNamedItemNS02.xml
+785/806 removeNamedItemNS03.xml
+786/806 setAttributeNS01.xml
+787/806 setAttributeNS02.xml
+788/806 setAttributeNS03.xml
+789/806 setAttributeNS04.xml
+790/806 setAttributeNS05.xml
+791/806 setAttributeNS06.xml
+792/806 setAttributeNS07.xml
+793/806 setAttributeNS09.xml
+794/806 setAttributeNS10.xml
+795/806 setAttributeNodeNS01.xml
+796/806 setAttributeNodeNS02.xml
+implementationAttribute expandEntityReferences not supported, skipping test
+797/806 setAttributeNodeNS03.xml
+798/806 setAttributeNodeNS04.xml
+799/806 setAttributeNodeNS05.xml
+800/806 setNamedItemNS01.xml
+801/806 setNamedItemNS02.xml
+802/806 setNamedItemNS03.xml
+803/806 setNamedItemNS04.xml
+804/806 setNamedItemNS05.xml
+805/806 systemId01.xml
+0/763 tests failed; 43 tests were skipped
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/GNUmakefile
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/GNUmakefile 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/GNUmakefile 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,7 @@
+all:
+ @echo no such target
+ @exit 1
+
+.PHONY: clean
+clean:
+ find . \( -name \*.fasl -o -name \*.x86f -o -name \*.lx64fsl \) -print0 | xargs -0 rm -f
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/OLDNEWS
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/OLDNEWS 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/OLDNEWS 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,272 @@
+Changes to Gilbert Baumann's Code
+========================================
+(Stand dieser Liste: patch-190)
+
+base-0
+ Import of Closure's src/xml and src/glisp
+
+
+Build system
+----------------
+patch-14
+ dom-builder.lsp braucht package.lisp
+patch-17
+ xml-parse braucht dom-impl
+patch-18
+ xml-parse braucht encodings
+patch-19
+ xml-parse.lisp needs xml-stream.lisp
+patch-157
+ DOM in eigenes Verzeichnis und System verschoben
+patch-158
+ COPYING auch im DOM
+patch-160
+ tests in eigenes Verzeichnis verschoben
+patch-184
+ commented out most of dep-clisp for now
+patch-185
+ CLISP fixes
+
+
+glisp durch runes ersetzt
+----------------
+patch-139 patch-140 patch-141 patch-142 patch-143
+ unbenutzte Funktionen aus glisp entfernt
+ GLISP keine COMMON-LISP-Symbole mehr exportieren lassen
+ glisp defpackage weiter vereinfacht
+patch-148
+ runes.lisp aufgeteilt in runes.lisp und syntax.lisp
+patch-149
+ CHARACTER-basierte Runen-Implementation
+patch-150
+ removed support for oldish gcl
+patch-151
+ removed dep-gcl-2.lisp
+patch-152
+ clarified glisp license as LLGPL as per Gilbert Baumann
+patch-155
+ GLISP in RUNES umbenannt
+patch-156
+ xstream (und encoding) nach runes verschoben
+patch-178
+patch-180
+ really fixed rune-char
+
+
+DOM fixes
+----------------
+patch-3
+ add dom:remove-child, dom:import-node
+patch-6
+ fixed dom:remove-child
+patch-7
+ strings->rods in set-attribute, too
+patch-21
+ dom:item und dom:length fuer NodeList implementiert
+patch-22
+ s/remove-atttribute/remove-attribute
+patch-23
+ dom:remove-attribute-node korrigiert
+patch-24
+ neu: dom:remove-attribute
+patch-25
+ dom:normalize implementiert
+patch-26
+ get-elements-by-tag-name fuer Element implementiert
+patch-32
+ s/data/value/ fuer CHARACTER-DATA
+patch-33
+ Aufruf von Setter-Methoden
+patch-34
+ (setf value) nachgetragen
+patch-35
+ (DOM:NODE-VALUE ATTRIBUTE) korrigiert
+patch-36
+ writer fuer DOM:DATA
+patch-37
+ (setf dom:node-value) implementiert
+patch-43
+ hack: implemented CHILD-NODES for ENTITY-REFERENCE
+patch-44
+ ENTITY-REFERENCE-Kinder als read-only markieren
+patch-45
+ DOM-EXCEPTION implementiert
+patch-46
+ fixed special cases in delete-data and replace-data
+patch-47
+ delete-data: Arraytyp korrigiert
+patch-48
+ DOM:INSERT-DATA implementiert
+patch-49
+ bugfix: replace-data for count != (length arg)
+patch-50
+ patch-46 nachgebessert: offset == length ist OK
+patch-51
+ fixed special cases in dom:substring-data
+patch-52
+ fixed patch-36, my (setf dom:data) implementation was bogus
+patch-55
+ temporary fix: attributes are created with value ""
+patch-58
+ START-DTD, END-DTD, DOCUMENT-TYPE initialisation
+patch-60
+ neu: CLONE-NODE
+patch-65, patch-66
+ verify attribute name syntax in createAttribute
+patch-67
+ more NAME syntax checks: CREATE-ELEMENT, SET-ATTRIBUTE
+patch-68
+ CREATE-ATTRIBUTE: set SPECIFIED to true
+patch-69, patch-70
+ INUSE_ATTRIBUTE_ERR
+patch-71
+ hacked my resolve-entity function to return NIL for undefined entities
+patch-72
+ INVALID_CHARACTER_ERR in create-entity-reference, too
+patch-73
+ Implement no-op methods on (setf node-value) where required...
+patch-74
+ fixed get-elements-by-tag-name not to include the argument itself
+patch-76, patch-77
+ implemented DOM:SPLIT-TEXT
+patch-80
+ noch unfertig: initialisiere dom:enitities richtig, erzeuge Entity-Knoten
+patch-82
+ dom:notations fuellen
+patch-85
+ WRONG_DOCUMENT_ERR auch in set-attribute-node
+patch-86
+ WRONG_DOCUMENT_ERR nicht nur in set-attribute-node, sondern prinzipiell in set-named-item
+patch-91
+ :NOT_FOUND_ERR in remove-named-item
+patch-94
+ can-adopt-p implementiert
+patch-95
+ ENSURE-VALID-INSERTION-REQUEST korrigiert
+patch-96
+ normalize korrigiert: cdata-section nicht beruehren
+patch-98
+ DOCUMENTs have owner NIL
+patch-101
+ (setf dom:data) fuer PI korrigiert
+patch-102
+ NOT_FOUND_ERR in REMOVE-CHILD
+patch-104
+ oops, split-text korrigiert
+patch-106
+ NOT_FOUND_ERROR in removeAttributeNode sucht das Objekt, nicht seinen Namen
+patch-107, patch-113
+ Defaultwert fuer fehlende Attribute ist der leere Rod-String, nicht NIL
+patch-118
+ entity und notation maps sind read-only
+patch-119
+ dom:item liefert NIL bei ungueltigem index
+patch-120, patch-122, patch-124
+ NodeList reimplementiert
+patch-121
+ NAMED-NODE-MAP muss auch auf HIERARCHY_REQUEST_ERR pruefen...
+patch-128
+ ATTRIBUTE hat jetzt Kinder
+patch-129
+ auch Attribute normalisieren
+patch-130
+ (setf dom:value) auf einem Attribut darf ein etwaiges Kinderobjekt nicht wiederverwenden
+patch-131
+ replace-child fuer document-fragment implementiert
+patch-132
+ CAN-ADOPT-P fuer Parent ATTRIBUTE und Kind CDATA-SECTION korrigiert
+patch-133
+ DOCUMENT darf nur jeweils ein ELEMENT- und DOCTYPE-Kind haben
+patch-137
+ neu: map-node-list, do-node-list. ensure-valid-insertion-request korrigiert
+patch-165
+ ANSI conformance fix in MOVE
+patch-181
+ ignore fill-pointers in MOVE
+
+xml-parse.lisp changes
+----------------
+patch-5
+ (assert (eql initial-speed 1)) in make-xstream
+patch-20
+ added a forward declaration for *namespace-bindings*
+patch-39
+ fix for thread safety in p/document
+patch-41
+ Warnung ueber (nicht) redefinierte Attribute abschalten koennen
+patch-54
+ call sax:comment; create comment nodes
+patch-89
+ public-id und system-id der Entities uebergeben
+patch-100
+ Die XML Deklaration ist keine Processing Instruction.
+patch-146
+ SAX-Aufrufe korrigiert fuer DTD ohne ID; Entitydeklaration mit SYSTEM ID
+patch-166
+ added missing format argument in internal-entity-expansion
+patch-172
+ fixed rod type in appenddata
+patch-174
+ reordered definitions to avoid forward references
+patch-177
+ more SBCL warnings removed
+patch-188
+ new function parse-octets
+(See also: patch-58, patch-80, patch-82)
+
+
+DOM-Builder und SAX-Interface
+----------------
+patch-57
+ Warnungen beseitigt ("undefined variable")
+patch-75
+ fixed PARENT slot initialization and added a rant about the current implementation
+patch-97
+ CDATA sections bauen
+patch-136
+ normalisierte Elemente bauen
+
+(See also: patch-58, patch-80, patch-82, patch-86, patch-118, patch-120)
+
+
+unparse
+----------------
+patch-2
+ export UNPARSE-DOCUMENT
+patch-144
+ Kommentare verstehen (und nicht ausgeben)
+patch-189
+ new function UNPARSE-DOCUMENT-TO-OCTETS
+
+
+Misc.
+----------------
+patch-9
+ print elements with their tag-name
+patch-11
+ print attributes with name and value
+
+patch-138
+ workaround, need to revert this later
+
+patch-10 reverted by patch-12
+patch-114 reverted by patch-115
+patch-63 reverted by patch-134
+patch-4 patch-38 patch-87 patch-90 patch-103 reverted by patch-154
+patch-154 STRING-DOM nicht mehr verwenden. File ist aber noch da.
+
+
+domtest.cl
+----------------
+patch-27 patch-28 patch-29 patch-30 patch-31 patch-40 patch-42 patch-53
+patch-59 patch-61 patch-62 patch-64 patch-78 patch-79 patch-83 patch-84
+patch-88 patch-92 patch-93 patch-99 patch-105 patch-108 patch-111
+patch-116 patch-117 patch-123 patch-153 patch-182
+ DOM tests
+
+
+xmlconf.cl
+----------------
+patch-13 patch-15 patch-16 patch-147 patch-186
+ Testfunktion fuer XML Conformance Test Suite
+(need to merge this with Gilbert's work)
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/README
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/README 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/README 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,29 @@
+
+Closure XML Parser
+
+ An XML parser written in Common Lisp.
+
+ Closure XML was written by Gilbert Baumann (unk6 at
+ rz.uni-karlsruhe.de) as part of the Closure web browser.
+
+ Contributions to the parser by
+ * Henrik Motakef (hmot at henrik-motakef.de)
+ * David Lichteblau (david(a)lichteblau.com)
+
+ CXML implements a namespace-aware, validating XML 1.0 parser
+ as well as the DOM Level 2 Core interfaces. Two parser interfaces
+ are offered, one SAX-like, the other similar to StAX.
+
+ CXML is licensed under Lisp-LGPL.
+
+ Send bug reports to cxml-devel(a)common-lisp.net
+ (http://common-lisp.net/cgi-bin/mailman/listinfo/cxml-devel)
+
+
+Documentation
+
+ Please refer to http://common-lisp.net/project/cxml/ for details.
+
+ The documentation is also available in the doc/ subdirectory of this
+ source distribution, run `make' in that directory to build HTML
+ for the XML sources (requires xsltproc).
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/TIMES
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/TIMES 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/TIMES 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,41 @@
+Time required for parsing a simple document (wc: 99621 298859 3267087).
+
+;; CXML with NIL builder
+;; (cxml:parse-file "~/test.xml" nil)
+
+; cpu time (non-gc) 12,940 msec user, 20 msec system
+; cpu time (gc) 0 msec user, 0 msec system
+; cpu time (total) 12,940 msec user, 20 msec system
+; real time 12,991 msec
+; space allocation:
+; 4,184,599 cons cells, 47,682,392 other bytes, 0 static bytes
+
+;; CXML with xmls-compatible builder
+;; (cxml:parse-file "~/test.xml" (cxml-xmls:make-xmls-builder))
+
+; cpu time (non-gc) 14,370 msec user, 20 msec system
+; cpu time (gc) 0 msec user, 0 msec system
+; cpu time (total) 14,370 msec user, 20 msec system
+; real time 14,387 msec
+; space allocation:
+; 8,667,564 cons cells, 47,682,600 other bytes, 0 static bytes
+
+;; For comparison: xmls.lisp
+;; (with-open-file (s "~/test.xml") (xmls:parse s :compress-whitespace nil))
+
+; cpu time (non-gc) 27,440 msec user, 50 msec system
+; cpu time (gc) 860 msec user, 0 msec system
+; cpu time (total) 28,300 msec user, 50 msec system
+; real time 28,813 msec
+; space allocation:
+; 14,821,161 cons cells, 243,886,592 other bytes, 0 static bytes
+
+;; CXML with DOM builder
+;; (cxml:parse-file "~/test.xml" (dom:make-dom-builder))
+
+; cpu time (non-gc) 34,900 msec user, 40 msec system
+; cpu time (gc) 760 msec user, 0 msec system
+; cpu time (total) 35,660 msec user, 40 msec system
+; real time 35,822 msec
+; space allocation:
+; 14,645,503 cons cells, 300,235,640 other bytes, 0 static bytes
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/XMLCONF
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/XMLCONF 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/XMLCONF 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,1834 @@
+xmltest/not-wf/sa/001.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/002.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/003.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/004.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/005.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/006.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/007.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/008.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/009.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/010.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/011.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/012.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/013.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/014.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/015.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/016.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/017.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/018.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/019.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/020.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/021.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/022.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/023.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/024.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/025.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/026.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/027.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/028.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/029.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/030.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/031.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/032.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/033.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/034.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/035.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/036.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/037.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/038.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/039.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/040.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/041.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/042.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/043.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/044.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/045.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/046.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/047.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/048.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/049.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/050.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/051.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/052.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/053.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/054.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/055.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/056.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/057.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/058.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/059.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/060.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/061.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/062.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/063.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/064.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/065.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/066.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/067.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/068.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/069.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/070.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/071.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/072.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/073.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/074.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/075.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/076.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/077.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/078.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/079.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/080.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/081.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/082.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/083.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/084.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/085.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/086.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/087.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/088.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/089.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/090.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/091.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/092.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/093.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/094.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/095.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/096.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/097.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/098.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/099.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/100.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/101.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/102.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/103.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/104.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/105.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/106.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/107.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/108.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/109.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/110.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/111.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/112.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/113.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/114.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/115.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/116.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/117.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/118.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/119.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/120.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/121.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/122.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/123.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/124.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/125.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/126.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/127.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/128.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/129.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/130.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/131.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/132.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/133.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/134.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/135.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/136.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/137.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/138.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/139.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/140.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/141.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/142.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/143.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/144.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/145.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/146.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/147.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/148.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/149.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/150.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/151.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/152.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/153.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/154.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/155.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/156.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/157.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/158.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/159.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/160.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/161.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/162.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/163.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/164.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/165.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/166.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/167.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/168.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/169.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/170.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/171.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/172.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/173.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/174.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/sa/175.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/176.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/177.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/178.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/179.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/180.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/181.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/182.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/183.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/184.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/185.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/sa/186.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/not-sa/001.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/not-sa/002.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/not-sa/003.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/not-sa/004.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/not-sa/006.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/not-sa/007.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/not-sa/008.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/not-sa/009.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/ext-sa/001.xml [not validating:] not-wf [validating:] invalid
+xmltest/not-wf/ext-sa/002.xml [not validating:] not-wf [validating:] not-wf
+xmltest/not-wf/ext-sa/003.xml [not validating:] not-wf [validating:] not-wf
+xmltest/invalid/002.xml [not validating:] input [validating:] invalid
+xmltest/invalid/005.xml [not validating:] input [validating:] invalid
+xmltest/invalid/006.xml [not validating:] input [validating:] invalid
+xmltest/invalid/not-sa/022.xml [not validating:] input/output [validating:] invalid
+xmltest/valid/sa/001.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/002.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/003.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/004.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/005.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/006.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/007.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/008.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/009.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/010.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/011.xml [not validating:] input/output [validating:] input/output
+valid/sa/012.xml: test applies to parsers without namespace support, skipping
+xmltest/valid/sa/013.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/014.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/015.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/016.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/017.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/018.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/019.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/020.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/021.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/022.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/023.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/024.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/025.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/026.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/027.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/028.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/029.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/030.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/031.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/032.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/033.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/034.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/035.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/036.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/037.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/038.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/039.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/040.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/041.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/042.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/043.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/044.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/045.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/046.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/047.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/048.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/049.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/050.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/051.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/052.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/053.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/054.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/055.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/056.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/057.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/058.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/059.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/060.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/061.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/062.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/063.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/064.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/065.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/066.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/067.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/068.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/069.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/070.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/071.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/072.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/073.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/074.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/075.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/076.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/077.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/078.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/079.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/080.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/081.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/082.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/083.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/084.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/085.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/086.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/087.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/088.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/089.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/090.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/091.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/092.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/093.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/094.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/095.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/096.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/097.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/098.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/099.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/100.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/101.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/102.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/103.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/104.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/105.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/106.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/107.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/108.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/109.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/110.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/111.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/112.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/113.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/114.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/115.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/116.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/117.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/118.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/sa/119.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/001.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/002.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/003.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/004.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/005.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/006.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/007.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/008.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/009.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/010.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/011.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/012.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/013.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/014.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/015.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/016.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/017.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/018.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/019.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/020.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/021.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/023.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/024.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/025.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/026.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/027.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/028.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/029.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/030.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/not-sa/031.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/001.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/002.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/003.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/004.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/005.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/006.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/007.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/008.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/009.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/011.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/012.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/013.xml [not validating:] input/output [validating:] input/output
+xmltest/valid/ext-sa/014.xml [not validating:] input/output [validating:] input/output
+japanese/pr-xml-little-endian.xml [not validating:] input [validating:] input
+japanese/pr-xml-utf-16.xml [not validating:] input [validating:] input
+japanese/pr-xml-utf-8.xml [not validating:] input [validating:] input
+japanese/weekly-little-endian.xml [not validating:] input [validating:] input
+japanese/weekly-utf-16.xml [not validating:] input [validating:] input
+japanese/weekly-utf-8.xml [not validating:] input [validating:] input
+sun/valid/pe01.xml [not validating:] input [validating:] input
+sun/valid/dtd00.xml [not validating:] input/output [validating:] input/output
+sun/valid/dtd01.xml [not validating:] input/output [validating:] input/output
+sun/valid/element.xml [not validating:] input/output [validating:] input/output
+sun/valid/ext01.xml [not validating:] input/output [validating:] input/output
+sun/valid/ext02.xml [not validating:] input/output [validating:] input/output
+sun/valid/not-sa01.xml [not validating:] input/output [validating:] input/output
+sun/valid/not-sa02.xml [not validating:] input/output [validating:] input/output
+sun/valid/not-sa03.xml [not validating:] input/output [validating:] input/output
+sun/valid/not-sa04.xml [not validating:] input/output [validating:] input/output
+sun/valid/notation01.xml [not validating:] input/output [validating:] input/output
+sun/valid/optional.xml [not validating:] input/output [validating:] input/output
+sun/valid/required00.xml [not validating:] input/output [validating:] input/output
+sun/valid/sa01.xml [not validating:] input/output [validating:] input/output
+sun/valid/sa02.xml [not validating:] input/output [validating:] input/output
+sun/valid/sa03.xml [not validating:] input/output [validating:] input/output
+sun/valid/sa04.xml [not validating:] input/output [validating:] input/output
+sun/valid/sa05.xml [not validating:] input/output [validating:] input/output
+sun/valid/sgml01.xml [not validating:] input/output [validating:] input/output
+sun/valid/v-lang01.xml [not validating:] input/output [validating:] input/output
+sun/valid/v-lang02.xml [not validating:] input/output [validating:] input/output
+sun/valid/v-lang03.xml [not validating:] input/output [validating:] input/output
+sun/valid/v-lang04.xml [not validating:] input/output [validating:] input/output
+sun/valid/v-lang05.xml [not validating:] input/output [validating:] input/output
+sun/valid/v-lang06.xml [not validating:] input/output [validating:] input/output
+sun/valid/pe00.xml [not validating:] input/output [validating:] input/output
+sun/valid/pe03.xml [not validating:] input/output [validating:] input/output
+sun/valid/pe02.xml [not validating:] input/output [validating:] input/output
+sun/invalid/dtd01.xml [not validating:] input [validating:] invalid
+sun/invalid/dtd02.xml [not validating:] input [validating:] invalid
+sun/invalid/dtd03.xml [not validating:] input [validating:] invalid
+sun/invalid/el01.xml [not validating:] input [validating:] invalid
+sun/invalid/el02.xml [not validating:] input [validating:] invalid
+sun/invalid/el03.xml [not validating:] input [validating:] invalid
+sun/invalid/el04.xml [not validating:] input [validating:] invalid
+sun/invalid/el05.xml [not validating:] input [validating:] invalid
+sun/invalid/el06.xml [not validating:] input [validating:] invalid
+sun/invalid/id01.xml [not validating:] input [validating:] invalid
+sun/invalid/id02.xml [not validating:] input [validating:] invalid
+sun/invalid/id03.xml [not validating:] input [validating:] invalid
+sun/invalid/id04.xml [not validating:] input [validating:] invalid
+sun/invalid/id05.xml [not validating:] input [validating:] invalid
+sun/invalid/id06.xml [not validating:] input [validating:] invalid
+sun/invalid/id07.xml [not validating:] input [validating:] invalid
+sun/invalid/id08.xml [not validating:] input [validating:] invalid
+sun/invalid/id09.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa01.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa02.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa04.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa05.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa06.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa07.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa08.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa09.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa10.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa11.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa12.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa13.xml [not validating:] input [validating:] invalid
+sun/invalid/not-sa14.xml [not validating:] input [validating:] invalid
+sun/invalid/optional01.xml [not validating:] input [validating:] invalid
+sun/invalid/optional02.xml [not validating:] input [validating:] invalid
+sun/invalid/optional03.xml [not validating:] input [validating:] invalid
+sun/invalid/optional04.xml [not validating:] input [validating:] invalid
+sun/invalid/optional05.xml [not validating:] input [validating:] invalid
+sun/invalid/optional06.xml [not validating:] input [validating:] invalid
+sun/invalid/optional07.xml [not validating:] input [validating:] invalid
+sun/invalid/optional08.xml [not validating:] input [validating:] invalid
+sun/invalid/optional09.xml [not validating:] input [validating:] invalid
+sun/invalid/optional10.xml [not validating:] input [validating:] invalid
+sun/invalid/optional11.xml [not validating:] input [validating:] invalid
+sun/invalid/optional12.xml [not validating:] input [validating:] invalid
+sun/invalid/optional13.xml [not validating:] input [validating:] invalid
+sun/invalid/optional14.xml [not validating:] input [validating:] invalid
+sun/invalid/optional20.xml [not validating:] input [validating:] invalid
+sun/invalid/optional21.xml [not validating:] input [validating:] invalid
+sun/invalid/optional22.xml [not validating:] input [validating:] invalid
+sun/invalid/optional23.xml [not validating:] input [validating:] invalid
+sun/invalid/optional24.xml [not validating:] input [validating:] invalid
+sun/invalid/optional25.xml [not validating:] input [validating:] invalid
+sun/invalid/required00.xml [not validating:] input [validating:] invalid
+sun/invalid/required01.xml [not validating:] input [validating:] invalid
+sun/invalid/required02.xml [not validating:] input [validating:] invalid
+sun/invalid/root.xml [not validating:] input [validating:] invalid
+sun/invalid/attr01.xml [not validating:] input [validating:] invalid
+sun/invalid/attr02.xml [not validating:] input [validating:] invalid
+sun/invalid/attr03.xml [not validating:] input [validating:] invalid
+sun/invalid/attr04.xml [not validating:] input [validating:] invalid
+sun/invalid/attr05.xml [not validating:] input [validating:] invalid
+sun/invalid/attr06.xml [not validating:] input [validating:] invalid
+sun/invalid/attr07.xml [not validating:] input [validating:] invalid
+sun/invalid/attr08.xml [not validating:] input [validating:] invalid
+sun/invalid/attr09.xml [not validating:] input [validating:] invalid
+sun/invalid/attr10.xml [not validating:] input [validating:] invalid
+sun/invalid/attr11.xml [not validating:] input [validating:] invalid
+sun/invalid/attr12.xml [not validating:] input [validating:] invalid
+sun/invalid/attr13.xml [not validating:] input [validating:] invalid
+sun/invalid/attr14.xml [not validating:] input [validating:] invalid
+sun/invalid/attr15.xml [not validating:] input [validating:] invalid
+sun/invalid/attr16.xml [not validating:] input [validating:] invalid
+sun/invalid/utf16b.xml [not validating:] input [validating:] invalid
+sun/invalid/utf16l.xml [not validating:] input [validating:] invalid
+sun/invalid/empty.xml [not validating:] input [validating:] invalid
+sun/not-wf/not-sa03.xml [not validating:] not-wf [validating:] invalid
+sun/not-wf/attlist01.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist02.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist03.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist04.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist05.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist06.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist07.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist08.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist09.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist10.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/attlist11.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/cond01.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/cond02.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/content01.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/content02.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/content03.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/decl01.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/dtd00.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/dtd01.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/dtd02.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/dtd03.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/dtd04.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/dtd05.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/dtd07.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/element00.xml [not validating:] not-wf [validating:] invalid
+sun/not-wf/element01.xml [not validating:] not-wf [validating:] invalid
+sun/not-wf/element02.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/element03.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/element04.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/encoding01.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/encoding02.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/encoding03.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/encoding04.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/encoding05.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/encoding06.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/encoding07.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/pi.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/pubid01.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/pubid02.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/pubid03.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/pubid04.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/pubid05.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml01.xml [not validating:] not-wf [validating:] invalid
+sun/not-wf/sgml02.xml [not validating:] not-wf [validating:] invalid
+sun/not-wf/sgml03.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml04.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml05.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml06.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml07.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml08.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml09.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml10.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml11.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml12.xml [not validating:] not-wf [validating:] not-wf
+sun/not-wf/sgml13.xml [not validating:] not-wf [validating:] not-wf
+oasis/p01pass2.xml [not validating:] input [validating:] input
+oasis/p06pass1.xml [not validating:] input [validating:] input
+oasis/p07pass1.xml [not validating:] input [validating:] input
+p08pass1.xml: test applies to parsers without namespace support, skipping
+oasis/p09pass1.xml [not validating:] input [validating:] input
+oasis/p12pass1.xml [not validating:] input [validating:] input
+oasis/p22pass4.xml [not validating:] input [validating:] input
+oasis/p22pass5.xml [not validating:] input [validating:] input
+oasis/p22pass6.xml [not validating:] input [validating:] input
+oasis/p28pass1.xml [not validating:] input [validating:] input
+oasis/p28pass3.xml [not validating:] input [validating:] input
+oasis/p28pass4.xml [not validating:] input [validating:] input
+oasis/p28pass5.xml [not validating:] input [validating:] input
+oasis/p29pass1.xml [not validating:] input [validating:] input
+oasis/p30pass1.xml [not validating:] input [validating:] input
+oasis/p30pass2.xml [not validating:] input [validating:] input
+oasis/p31pass1.xml [not validating:] input [validating:] input
+oasis/p31pass2.xml [not validating:] input [validating:] input
+oasis/p43pass1.xml [not validating:] input [validating:] input
+oasis/p45pass1.xml [not validating:] input [validating:] input
+oasis/p46pass1.xml [not validating:] input [validating:] input
+oasis/p47pass1.xml [not validating:] input [validating:] input
+oasis/p48pass1.xml [not validating:] input [validating:] input
+oasis/p49pass1.xml [not validating:] input [validating:] input
+oasis/p50pass1.xml [not validating:] input [validating:] input
+oasis/p51pass1.xml [not validating:] input [validating:] input
+oasis/p52pass1.xml [not validating:] input [validating:] input
+oasis/p53pass1.xml [not validating:] input [validating:] input
+oasis/p54pass1.xml [not validating:] input [validating:] input
+oasis/p55pass1.xml [not validating:] input [validating:] input
+oasis/p56pass1.xml [not validating:] input [validating:] input
+oasis/p57pass1.xml [not validating:] input [validating:] input
+oasis/p58pass1.xml [not validating:] input [validating:] input
+oasis/p59pass1.xml [not validating:] input [validating:] input
+oasis/p60pass1.xml [not validating:] input [validating:] input
+oasis/p61pass1.xml [not validating:] input [validating:] input
+oasis/p62pass1.xml [not validating:] input [validating:] input
+oasis/p63pass1.xml [not validating:] input [validating:] input
+oasis/p64pass1.xml [not validating:] input [validating:] input
+oasis/p68pass1.xml [not validating:] input [validating:] input
+oasis/p69pass1.xml [not validating:] input [validating:] input
+oasis/p70pass1.xml [not validating:] input [validating:] input
+oasis/p71pass1.xml [not validating:] input [validating:] input
+oasis/p72pass1.xml [not validating:] input [validating:] input
+oasis/p73pass1.xml [not validating:] input [validating:] input
+oasis/p76pass1.xml [not validating:] input [validating:] input
+oasis/p01pass1.xml [not validating:] input [validating:] invalid
+oasis/p01pass3.xml [not validating:] input [validating:] invalid
+oasis/p03pass1.xml [not validating:] input [validating:] invalid
+p04pass1.xml: test applies to parsers without namespace support, skipping
+p05pass1.xml: test applies to parsers without namespace support, skipping
+oasis/p06fail1.xml [not validating:] input [validating:] invalid
+oasis/p08fail1.xml [not validating:] input [validating:] invalid
+oasis/p08fail2.xml [not validating:] input [validating:] invalid
+oasis/p10pass1.xml [not validating:] input [validating:] invalid
+oasis/p14pass1.xml [not validating:] input [validating:] invalid
+oasis/p15pass1.xml [not validating:] input [validating:] invalid
+oasis/p16pass1.xml [not validating:] input [validating:] invalid
+oasis/p16pass2.xml [not validating:] input [validating:] invalid
+oasis/p16pass3.xml [not validating:] input [validating:] invalid
+oasis/p18pass1.xml [not validating:] input [validating:] invalid
+oasis/p22pass1.xml [not validating:] input [validating:] invalid
+oasis/p22pass2.xml [not validating:] input [validating:] invalid
+oasis/p22pass3.xml [not validating:] input [validating:] invalid
+oasis/p23pass1.xml [not validating:] input [validating:] invalid
+oasis/p23pass2.xml [not validating:] input [validating:] invalid
+oasis/p23pass3.xml [not validating:] input [validating:] invalid
+oasis/p23pass4.xml [not validating:] input [validating:] invalid
+oasis/p24pass1.xml [not validating:] input [validating:] invalid
+oasis/p24pass2.xml [not validating:] input [validating:] invalid
+oasis/p24pass3.xml [not validating:] input [validating:] invalid
+oasis/p24pass4.xml [not validating:] input [validating:] invalid
+oasis/p25pass1.xml [not validating:] input [validating:] invalid
+oasis/p25pass2.xml [not validating:] input [validating:] invalid
+oasis/p26pass1.xml [not validating:] input [validating:] invalid
+oasis/p27pass1.xml [not validating:] input [validating:] invalid
+oasis/p27pass2.xml [not validating:] input [validating:] invalid
+oasis/p27pass3.xml [not validating:] input [validating:] invalid
+oasis/p27pass4.xml [not validating:] input [validating:] invalid
+oasis/p32pass1.xml [not validating:] input [validating:] invalid
+oasis/p32pass2.xml [not validating:] input [validating:] invalid
+oasis/p39pass1.xml [not validating:] input [validating:] invalid
+oasis/p39pass2.xml [not validating:] input [validating:] invalid
+oasis/p40pass1.xml [not validating:] input [validating:] invalid
+oasis/p40pass2.xml [not validating:] input [validating:] invalid
+oasis/p40pass3.xml [not validating:] input [validating:] invalid
+oasis/p40pass4.xml [not validating:] input [validating:] invalid
+oasis/p41pass1.xml [not validating:] input [validating:] invalid
+oasis/p41pass2.xml [not validating:] input [validating:] invalid
+oasis/p42pass1.xml [not validating:] input [validating:] invalid
+oasis/p42pass2.xml [not validating:] input [validating:] invalid
+oasis/p44pass1.xml [not validating:] input [validating:] invalid
+oasis/p44pass2.xml [not validating:] input [validating:] invalid
+oasis/p44pass3.xml [not validating:] input [validating:] invalid
+oasis/p44pass4.xml [not validating:] input [validating:] invalid
+oasis/p44pass5.xml [not validating:] input [validating:] invalid
+oasis/p66pass1.xml [not validating:] input [validating:] invalid
+oasis/p74pass1.xml [not validating:] input [validating:] invalid
+oasis/p75pass1.xml [not validating:] input [validating:] invalid
+oasis/e2.xml [not validating:] input [validating:] invalid
+oasis/p01fail1.xml [not validating:] not-wf [validating:] invalid
+oasis/p01fail2.xml [not validating:] not-wf [validating:] invalid
+oasis/p01fail3.xml [not validating:] not-wf [validating:] invalid
+oasis/p01fail4.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail1.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail10.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail11.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail12.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail13.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail14.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail15.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail16.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail17.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail18.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail19.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail2.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail20.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail21.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail22.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail23.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail24.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail25.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail26.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail27.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail28.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail29.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail3.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail30.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail31.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail4.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail5.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail6.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail7.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail8.xml [not validating:] not-wf [validating:] invalid
+oasis/p02fail9.xml [not validating:] not-wf [validating:] invalid
+oasis/p03fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail10.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail11.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail12.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail13.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail14.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail15.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail16.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail17.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail18.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail19.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail20.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail21.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail22.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail23.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail24.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail25.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail26.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail27.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail28.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail29.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail7.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail8.xml [not validating:] not-wf [validating:] not-wf
+oasis/p03fail9.xml [not validating:] not-wf [validating:] not-wf
+oasis/p04fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p04fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p04fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p05fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p05fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p05fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p05fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p05fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p09fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p09fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p09fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p09fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p09fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p10fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p10fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p10fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p11fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p11fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p12fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p12fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p12fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p12fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p12fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p12fail6.xml [not validating:] not-wf [validating:] not-wf
+oasis/p12fail7.xml [not validating:] not-wf [validating:] not-wf
+oasis/p14fail1.xml [not validating:] not-wf [validating:] invalid
+oasis/p14fail2.xml [not validating:] not-wf [validating:] invalid
+oasis/p14fail3.xml [not validating:] not-wf [validating:] invalid
+oasis/p15fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p15fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p15fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p16fail1.xml [not validating:] not-wf [validating:] invalid
+oasis/p16fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p16fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p18fail1.xml [not validating:] not-wf [validating:] invalid
+oasis/p18fail2.xml [not validating:] not-wf [validating:] invalid
+oasis/p18fail3.xml [not validating:] not-wf [validating:] invalid
+oasis/p22fail1.xml [not validating:] not-wf [validating:] invalid
+oasis/p22fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p23fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p23fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p23fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p23fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p23fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p24fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p24fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p25fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p26fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p26fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p27fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p28fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p29fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p30fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p31fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p32fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p32fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p32fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p32fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p32fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p39fail1.xml [not validating:] not-wf [validating:] invalid
+oasis/p39fail2.xml [not validating:] not-wf [validating:] invalid
+oasis/p39fail3.xml [not validating:] not-wf [validating:] invalid
+oasis/p39fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p39fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p40fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p40fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p40fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p40fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p41fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p41fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p41fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p42fail1.xml [not validating:] not-wf [validating:] invalid
+oasis/p42fail2.xml [not validating:] not-wf [validating:] invalid
+oasis/p42fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p43fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p43fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p43fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p44fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p44fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p44fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p44fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p44fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p45fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p45fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p45fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p45fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p46fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p46fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p46fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p46fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p46fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p46fail6.xml [not validating:] not-wf [validating:] not-wf
+oasis/p47fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p47fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p47fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p47fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p48fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p48fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p49fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p50fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p51fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p51fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p51fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p51fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p51fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p51fail6.xml [not validating:] not-wf [validating:] not-wf
+oasis/p51fail7.xml [not validating:] not-wf [validating:] not-wf
+oasis/p52fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p52fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p53fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p53fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p53fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p53fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p53fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p54fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p55fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p56fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p56fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p56fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p56fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p56fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p57fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p58fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p58fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p58fail3.xml [not validating:] not-wf [validating:] invalid
+oasis/p58fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p58fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p58fail6.xml [not validating:] not-wf [validating:] not-wf
+oasis/p58fail7.xml [not validating:] not-wf [validating:] not-wf
+oasis/p58fail8.xml [not validating:] not-wf [validating:] not-wf
+oasis/p59fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p59fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p59fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p60fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p60fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p60fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p60fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p60fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p61fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p62fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p62fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p63fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p63fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p64fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p64fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p66fail1.xml [not validating:] not-wf [validating:] invalid
+oasis/p66fail2.xml [not validating:] not-wf [validating:] invalid
+oasis/p66fail3.xml [not validating:] not-wf [validating:] invalid
+oasis/p66fail4.xml [not validating:] not-wf [validating:] invalid
+oasis/p66fail5.xml [not validating:] not-wf [validating:] invalid
+oasis/p66fail6.xml [not validating:] not-wf [validating:] invalid
+oasis/p68fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p68fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p68fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p69fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p69fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p69fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p70fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p71fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p71fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p71fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p71fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p72fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p72fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p72fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p72fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p73fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p73fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p73fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p73fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p73fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p74fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p74fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p74fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p75fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p75fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p75fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p75fail4.xml [not validating:] not-wf [validating:] not-wf
+oasis/p75fail5.xml [not validating:] not-wf [validating:] not-wf
+oasis/p75fail6.xml [not validating:] not-wf [validating:] not-wf
+oasis/p76fail1.xml [not validating:] not-wf [validating:] not-wf
+oasis/p76fail2.xml [not validating:] not-wf [validating:] not-wf
+oasis/p76fail3.xml [not validating:] not-wf [validating:] not-wf
+oasis/p76fail4.xml [not validating:] not-wf [validating:] not-wf
+ibm/invalid/P28/ibm28i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P32/ibm32i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P32/ibm32i03.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P32/ibm32i04.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P39/ibm39i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P39/ibm39i02.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P39/ibm39i03.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P39/ibm39i04.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P41/ibm41i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P41/ibm41i02.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P45/ibm45i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P49/ibm49i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P50/ibm50i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P51/ibm51i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P51/ibm51i03.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i02.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i03.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i05.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i06.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i07.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i08.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i09.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i10.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i11.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i12.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i13.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i14.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i15.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i16.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i17.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P56/ibm56i18.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P58/ibm58i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P58/ibm58i02.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P59/ibm59i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P60/ibm60i01.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P60/ibm60i02.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P60/ibm60i03.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P60/ibm60i04.xml [not validating:] input/output [validating:] invalid
+ibm/invalid/P76/ibm76i01.xml [not validating:] input/output [validating:] invalid
+ibm/not-wf/P01/ibm01n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P01/ibm01n02.xml [not validating:] not-wf [validating:] invalid
+ibm/not-wf/P01/ibm01n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n11.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n12.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n13.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n14.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n15.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n16.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n17.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n18.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n19.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n20.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n21.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n22.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n23.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n24.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n25.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n26.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n27.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n28.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n29.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n30.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n31.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n32.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P02/ibm02n33.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P03/ibm03n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n11.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n12.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n13.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n14.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n15.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n16.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n17.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P04/ibm04n18.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P05/ibm05n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P05/ibm05n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P05/ibm05n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P09/ibm09n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P09/ibm09n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P09/ibm09n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P09/ibm09n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P10/ibm10n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P10/ibm10n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P10/ibm10n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P10/ibm10n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P10/ibm10n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P10/ibm10n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P10/ibm10n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P10/ibm10n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P11/ibm11n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P11/ibm11n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P11/ibm11n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P11/ibm11n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P12/ibm12n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P12/ibm12n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P12/ibm12n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P13/ibm13n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P13/ibm13n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P13/ibm13n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P14/ibm14n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P14/ibm14n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P14/ibm14n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P15/ibm15n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P15/ibm15n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P15/ibm15n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P15/ibm15n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P16/ibm16n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P16/ibm16n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P16/ibm16n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P16/ibm16n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P17/ibm17n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P17/ibm17n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P17/ibm17n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P17/ibm17n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P18/ibm18n01.xml [not validating:] not-wf [validating:] invalid
+ibm/not-wf/P18/ibm18n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P19/ibm19n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P19/ibm19n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P19/ibm19n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P20/ibm20n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P21/ibm21n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P21/ibm21n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P21/ibm21n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P22/ibm22n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P22/ibm22n02.xml [not validating:] not-wf [validating:] invalid
+ibm/not-wf/P22/ibm22n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P23/ibm23n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P23/ibm23n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P23/ibm23n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P23/ibm23n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P23/ibm23n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P23/ibm23n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P24/ibm24n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P24/ibm24n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P24/ibm24n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P24/ibm24n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P24/ibm24n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P24/ibm24n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P24/ibm24n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P24/ibm24n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P24/ibm24n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P25/ibm25n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P25/ibm25n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P26/ibm26n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P27/ibm27n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P28/ibm28n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P28/ibm28n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P28/ibm28n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P28/ibm28n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P28/ibm28n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P28/ibm28n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P28/ibm28n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P28/ibm28n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/p28a/ibm28an01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P29/ibm29n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P29/ibm29n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P29/ibm29n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P29/ibm29n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P29/ibm29n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P29/ibm29n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P29/ibm29n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P30/ibm30n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P31/ibm31n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P32/ibm32n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P32/ibm32n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P32/ibm32n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P32/ibm32n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P32/ibm32n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P32/ibm32n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P32/ibm32n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P32/ibm32n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P32/ibm32n09.xml [not validating:] not-wf [validating:] invalid
+ibm/not-wf/P39/ibm39n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P39/ibm39n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P39/ibm39n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P39/ibm39n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P39/ibm39n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P39/ibm39n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P40/ibm40n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P40/ibm40n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P40/ibm40n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P40/ibm40n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P40/ibm40n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n11.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n12.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n13.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P41/ibm41n14.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P42/ibm42n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P42/ibm42n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P42/ibm42n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P42/ibm42n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P42/ibm42n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P43/ibm43n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P43/ibm43n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P43/ibm43n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P43/ibm43n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P44/ibm44n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P44/ibm44n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P44/ibm44n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P44/ibm44n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P45/ibm45n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P45/ibm45n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P45/ibm45n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P45/ibm45n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P45/ibm45n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P45/ibm45n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P45/ibm45n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P45/ibm45n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P45/ibm45n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P46/ibm46n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P46/ibm46n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P46/ibm46n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P46/ibm46n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P46/ibm46n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P47/ibm47n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P47/ibm47n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P47/ibm47n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P47/ibm47n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P47/ibm47n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P47/ibm47n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P48/ibm48n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P48/ibm48n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P48/ibm48n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P48/ibm48n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P48/ibm48n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P48/ibm48n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P48/ibm48n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P49/ibm49n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P49/ibm49n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P49/ibm49n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P49/ibm49n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P49/ibm49n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P49/ibm49n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P50/ibm50n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P50/ibm50n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P50/ibm50n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P50/ibm50n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P50/ibm50n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P50/ibm50n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P50/ibm50n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P51/ibm51n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P51/ibm51n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P51/ibm51n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P51/ibm51n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P51/ibm51n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P51/ibm51n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P51/ibm51n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P52/ibm52n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P52/ibm52n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P52/ibm52n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P52/ibm52n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P52/ibm52n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P52/ibm52n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P53/ibm53n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P53/ibm53n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P53/ibm53n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P53/ibm53n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P53/ibm53n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P53/ibm53n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P53/ibm53n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P53/ibm53n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P54/ibm54n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P54/ibm54n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P55/ibm55n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P55/ibm55n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P55/ibm55n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P56/ibm56n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P56/ibm56n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P56/ibm56n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P56/ibm56n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P56/ibm56n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P56/ibm56n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P56/ibm56n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P57/ibm57n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P58/ibm58n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P58/ibm58n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P58/ibm58n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P58/ibm58n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P58/ibm58n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P58/ibm58n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P58/ibm58n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P58/ibm58n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P59/ibm59n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P59/ibm59n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P59/ibm59n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P59/ibm59n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P59/ibm59n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P59/ibm59n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P60/ibm60n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P60/ibm60n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P60/ibm60n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P60/ibm60n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P60/ibm60n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P60/ibm60n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P60/ibm60n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P60/ibm60n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P61/ibm61n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P62/ibm62n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P62/ibm62n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P62/ibm62n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P62/ibm62n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P62/ibm62n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P62/ibm62n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P62/ibm62n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P62/ibm62n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P63/ibm63n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P63/ibm63n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P63/ibm63n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P63/ibm63n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P63/ibm63n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P63/ibm63n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P63/ibm63n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P64/ibm64n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P64/ibm64n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P64/ibm64n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P65/ibm65n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P65/ibm65n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n11.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n12.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n13.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n14.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P66/ibm66n15.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P68/ibm68n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P68/ibm68n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P68/ibm68n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P68/ibm68n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P68/ibm68n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P68/ibm68n06.xml [not validating:] not-wf [validating:] invalid
+ibm/not-wf/P68/ibm68n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P68/ibm68n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P68/ibm68n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P68/ibm68n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P69/ibm69n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P69/ibm69n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P69/ibm69n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P69/ibm69n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P69/ibm69n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P69/ibm69n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P71/ibm70n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P71/ibm71n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P71/ibm71n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P71/ibm71n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P71/ibm71n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P71/ibm71n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P71/ibm71n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P71/ibm71n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P71/ibm71n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P72/ibm72n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P72/ibm72n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P72/ibm72n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P72/ibm72n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P72/ibm72n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P72/ibm72n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P72/ibm72n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P72/ibm72n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P72/ibm72n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P73/ibm73n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P73/ibm73n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P74/ibm74n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n11.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n12.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P75/ibm75n13.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P76/ibm76n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P76/ibm76n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P76/ibm76n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P76/ibm76n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P76/ibm76n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P76/ibm76n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P76/ibm76n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P77/ibm77n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P77/ibm77n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P77/ibm77n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P77/ibm77n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P78/ibm78n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P78/ibm78n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P79/ibm79n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P79/ibm79n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P80/ibm80n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P80/ibm80n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P80/ibm80n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P80/ibm80n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P80/ibm80n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P80/ibm80n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P81/ibm81n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P81/ibm81n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P81/ibm81n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P81/ibm81n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P81/ibm81n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P81/ibm81n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P81/ibm81n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P81/ibm81n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P81/ibm81n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P82/ibm82n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P82/ibm82n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P82/ibm82n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P82/ibm82n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P82/ibm82n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P82/ibm82n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P82/ibm82n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P82/ibm82n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P83/ibm83n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P83/ibm83n02.xml [not validating:] not-wf [validating:] invalid
+ibm/not-wf/P83/ibm83n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P83/ibm83n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P83/ibm83n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P83/ibm83n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n100.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n101.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n102.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n103.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n104.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n105.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n106.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n107.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n108.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n109.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n11.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n110.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n111.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n112.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n113.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n114.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n115.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n116.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n117.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n118.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n119.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n12.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n120.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n121.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n122.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n123.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n124.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n125.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n126.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n127.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n128.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n129.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n13.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n130.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n131.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n132.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n133.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n134.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n135.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n136.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n137.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n138.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n139.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n14.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n140.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n141.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n142.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n143.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n144.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n145.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n146.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n147.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n148.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n149.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n15.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n150.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n151.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n152.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n153.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n154.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n155.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n156.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n157.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n158.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n159.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n16.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n160.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n161.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n162.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n163.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n164.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n165.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n166.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n167.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n168.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n169.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n17.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n170.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n171.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n172.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n173.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n174.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n175.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n176.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n177.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n178.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n179.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n18.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n180.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n181.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n182.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n183.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n184.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n185.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n186.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n187.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n188.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n189.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n19.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n190.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n191.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n192.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n193.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n194.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n195.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n196.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n197.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n198.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n20.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n21.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n22.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n23.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n24.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n25.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n26.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n27.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n28.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n29.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n30.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n31.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n32.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n33.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n34.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n35.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n36.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n37.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n38.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n39.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n40.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n41.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n42.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n43.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n44.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n45.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n46.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n47.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n48.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n49.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n50.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n51.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n52.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n53.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n54.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n55.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n56.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n57.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n58.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n59.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n60.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n61.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n62.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n63.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n64.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n65.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n66.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n67.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n68.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n69.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n70.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n71.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n72.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n73.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n74.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n75.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n76.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n77.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n78.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n79.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n80.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n81.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n82.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n83.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n84.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n85.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n86.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n87.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n88.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n89.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n90.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n91.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n92.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n93.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n94.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n95.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n96.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n97.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n98.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P85/ibm85n99.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P86/ibm86n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P86/ibm86n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P86/ibm86n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P86/ibm86n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n11.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n12.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n13.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n14.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n15.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n16.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n17.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n18.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n19.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n20.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n21.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n22.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n23.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n24.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n25.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n26.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n27.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n28.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n29.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n30.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n31.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n32.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n33.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n34.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n35.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n36.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n37.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n38.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n39.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n40.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n41.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n42.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n43.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n44.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n45.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n46.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n47.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n48.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n49.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n50.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n51.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n52.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n53.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n54.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n55.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n56.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n57.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n58.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n59.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n60.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n61.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n62.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n63.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n64.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n66.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n67.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n68.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n69.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n70.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n71.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n72.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n73.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n74.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n75.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n76.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n77.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n78.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n79.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n80.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n81.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n82.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n83.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n84.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P87/ibm87n85.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n11.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n12.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n13.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n14.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n15.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P88/ibm88n16.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n01.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n02.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n03.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n04.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n05.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n06.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n07.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n08.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n09.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n10.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n11.xml [not validating:] not-wf [validating:] not-wf
+ibm/not-wf/P89/ibm89n12.xml [not validating:] not-wf [validating:] not-wf
+ibm/valid/P01/ibm01v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P02/ibm02v01.xml [not validating:] input [validating:] input
+ibm/valid/P03/ibm03v01.xml [not validating:] input [validating:] input
+ibm/valid/P09/ibm09v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P09/ibm09v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P09/ibm09v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P09/ibm09v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P09/ibm09v05.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P10/ibm10v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P10/ibm10v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P10/ibm10v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P10/ibm10v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P10/ibm10v05.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P10/ibm10v06.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P10/ibm10v07.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P10/ibm10v08.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P11/ibm11v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P11/ibm11v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P11/ibm11v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P11/ibm11v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P12/ibm12v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P12/ibm12v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P12/ibm12v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P12/ibm12v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P13/ibm13v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P14/ibm14v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P14/ibm14v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P14/ibm14v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P15/ibm15v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P15/ibm15v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P15/ibm15v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P15/ibm15v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P16/ibm16v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P16/ibm16v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P16/ibm16v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P17/ibm17v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P18/ibm18v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P19/ibm19v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P20/ibm20v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P20/ibm20v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P21/ibm21v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P22/ibm22v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P22/ibm22v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P22/ibm22v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P22/ibm22v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P22/ibm22v05.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P22/ibm22v06.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P22/ibm22v07.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P23/ibm23v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P23/ibm23v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P23/ibm23v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P23/ibm23v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P23/ibm23v05.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P23/ibm23v06.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P24/ibm24v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P24/ibm24v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P25/ibm25v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P25/ibm25v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P25/ibm25v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P25/ibm25v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P26/ibm26v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P27/ibm27v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P27/ibm27v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P27/ibm27v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P28/ibm28v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P30/ibm30v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P30/ibm30v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P31/ibm31v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P32/ibm32v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P32/ibm32v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P32/ibm32v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P32/ibm32v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P33/ibm33v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P34/ibm34v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P35/ibm35v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P36/ibm36v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P37/ibm37v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P38/ibm38v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P39/ibm39v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P40/ibm40v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P41/ibm41v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P42/ibm42v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P43/ibm43v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P44/ibm44v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P45/ibm45v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P47/ibm47v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P49/ibm49v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P50/ibm50v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P51/ibm51v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P51/ibm51v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P52/ibm52v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P54/ibm54v01.xml [not validating:] input [validating:] input
+ibm/valid/P54/ibm54v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P54/ibm54v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P55/ibm55v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v05.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v06.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v07.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v08.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v09.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P56/ibm56v10.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P57/ibm57v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P58/ibm58v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P58/ibm58v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P59/ibm59v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P59/ibm59v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P60/ibm60v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P60/ibm60v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P60/ibm60v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P60/ibm60v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P61/ibm61v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P61/ibm61v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P62/ibm62v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P62/ibm62v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P62/ibm62v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P62/ibm62v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P62/ibm62v05.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P63/ibm63v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P63/ibm63v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P63/ibm63v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P63/ibm63v04.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P63/ibm63v05.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P64/ibm64v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P64/ibm64v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P64/ibm64v03.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P65/ibm65v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P65/ibm65v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P66/ibm66v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P67/ibm67v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P68/ibm68v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P68/ibm68v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P69/ibm69v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P69/ibm69v02.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P70/ibm70v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P78/ibm78v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P79/ibm79v01.xml [not validating:] input [validating:] input
+ibm/valid/P82/ibm82v01.xml [not validating:] input/output [validating:] input/output
+ibm/valid/P85/ibm85v01.xml [not validating:] input [validating:] input
+ibm/valid/P86/ibm86v01.xml [not validating:] input [validating:] input
+ibm/valid/P87/ibm87v01.xml [not validating:] input [validating:] input
+ibm/valid/P88/ibm88v01.xml [not validating:] input [validating:] input
+ibm/valid/P89/ibm89v01.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/001.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/002.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/003.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/007.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/008.xml [not validating:] input [validating:] input
+eduni/namespaces/1.0/009.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/010.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/011.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/012.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/013.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/014.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/015.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/016.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/017.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/018.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/019.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/020.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/021.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/022.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/023.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/024.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/025.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/026.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/027.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/028.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/029.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/030.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/031.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/032.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/033.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/034.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/035.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/036.xml [not validating:] not-wf [validating:] invalid
+eduni/namespaces/1.0/037.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/038.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/039.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/040.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/041.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/042.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/043.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/044.xml [not validating:] not-wf [validating:] not-wf
+eduni/namespaces/1.0/045.xml [not validating:] input [validating:] invalid
+eduni/namespaces/1.0/046.xml [not validating:] input [validating:] invalid
+0/1829 tests failed; 333 tests were skipped
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/XMLS-SYMBOLS.diff
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/XMLS-SYMBOLS.diff 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/XMLS-SYMBOLS.diff 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,98 @@
+* looking for david(a)knowledgetools.de--cxml/cxml--devel--1.0--patch-309 to compare with
+* comparing to david(a)knowledgetools.de--cxml/cxml--devel--1.0--patch-309
+M xml/xmls-compat.lisp
+
+* modified files
+
+--- orig/xml/xmls-compat.lisp
++++ mod/xml/xmls-compat.lisp
+@@ -12,7 +12,8 @@
+ (defpackage cxml-xmls
+ (:use :cl :runes)
+ (:export #:make-node #:node-name #:node-ns #:node-attrs #:node-children
+- #:make-xmls-builder #:map-node))
++ #:make-xmls-builder #:map-node
++ #:*identifier-case*))
+
+ (in-package :cxml-xmls)
+
+@@ -64,6 +65,10 @@
+
+ ;;;; SAX-Handler (Parser)
+
++(defvar *identifier-case* nil
++ "One of NIL (don't intern names), :PRESERVE, :UPCASE, :DOWNCASE, or :INVERT
++ (intern name into the keyword package after adjusting case).")
++
+ (defclass xmls-builder ()
+ ((element-stack :initform nil :accessor element-stack)
+ (root :initform nil :accessor root)))
+@@ -74,16 +79,46 @@
+ (defmethod sax:end-document ((handler xmls-builder))
+ (root handler))
+
++(defun string-invert-case (str)
++ (map 'string
++ (lambda (c)
++ (cond
++ ((upper-case-p c) (char-downcase c))
++ ((lower-case-p c) (char-upcase c))
++ (t c)))
++ str))
++
++(defun maybe-intern (name)
++ (if *identifier-case*
++ (let ((str (if (stringp name) name (rod-string name))))
++ (intern (ecase *identifier-case*
++ (:preserve str)
++ (:upcase (string-upcase str))
++ (:downcase (string-downcase str))
++ (:invert (string-invert-case str)))
++ :keyword))
++ name))
++
++(defun maybe-stringify (name)
++ (if (symbolp name)
++ (let ((str (symbol-name name)))
++ (ecase *identifier-case*
++ (:preserve str)
++ (:upcase (string-downcase str))
++ (:downcase (string-upcase str))
++ (:invert (string-invert-case str))))
++ name))
++
+ (defmethod sax:start-element
+ ((handler xmls-builder) namespace-uri local-name qname attributes)
+ (declare (ignore namespace-uri))
+ (setf local-name (or local-name qname))
+ (let* ((attributes
+ (mapcar (lambda (attr)
+- (list (sax:attribute-qname attr)
++ (list (maybe-intern (sax:attribute-qname attr))
+ (sax:attribute-value attr)))
+ attributes))
+- (node (make-node :name local-name
++ (node (make-node :name (maybe-intern local-name)
+ :ns (let ((lq (length qname))
+ (ll (length local-name)))
+ (if (eql lq ll)
+@@ -124,7 +159,7 @@
+ (labels ((walk (node)
+ (let* ((attlist
+ (compute-attributes node include-xmlns-attributes))
+- (lname (rod (node-name node)))
++ (lname (rod (maybe-stringify (node-name node))))
+ (ns (rod (node-ns node)))
+ (qname (concatenate 'rod ns (rod ":") lname)))
+ ;; fixme: namespaces
+@@ -141,6 +176,7 @@
+ (remove nil
+ (mapcar (lambda (a)
+ (destructuring-bind (name value) a
++ (setf name (maybe-stringify name))
+ (if (or xmlnsp (not (cxml::xmlns-attr-p (rod name))))
+ (sax:make-attribute :qname (rod name)
+ :value (rod value)
+
+
+
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/catalog.dtd
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/catalog.dtd 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/catalog.dtd 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,149 @@
+<!-- $Id: catalog.dtd,v 1.1.1.1 2005/03/13 18:02:52 david Exp $ -->
+
+<!ENTITY % pubIdChars "CDATA">
+<!ENTITY % publicIdentifier "%pubIdChars;">
+<!ENTITY % partialPublicIdentifier "%pubIdChars;">
+<!ENTITY % uriReference "CDATA">
+<!ENTITY % string "CDATA">
+<!ENTITY % systemOrPublic "(system|public)">
+
+<!ENTITY % p "">
+<!ENTITY % s "">
+<!ENTITY % nsdecl "xmlns%s;">
+
+<!ENTITY % catalog "%p;catalog">
+<!ENTITY % public "%p;public">
+<!ENTITY % system "%p;system">
+<!ENTITY % uri "%p;uri">
+<!ENTITY % rewriteSystem "%p;rewriteSystem">
+<!ENTITY % rewriteURI "%p;rewriteURI">
+<!ENTITY % delegatePublic "%p;delegatePublic">
+<!ENTITY % delegateSystem "%p;delegateSystem">
+<!ENTITY % delegateURI "%p;delegateURI">
+<!ENTITY % nextCatalog "%p;nextCatalog">
+<!ENTITY % group "%p;group">
+
+<!ENTITY % local.catalog.mix "">
+<!ENTITY % local.catalog.attribs "">
+
+<!ELEMENT %catalog; (%public;|%system;|%uri;
+ |%rewriteSystem;|%rewriteURI;
+ |%delegatePublic;|%delegateSystem;|%delegateURI;
+ |%nextCatalog;|%group; %local.catalog.mix;)+>
+<!ATTLIST %catalog;
+ %nsdecl; %uriReference; #FIXED
+ 'urn:oasis:names:tc:entity:xmlns:xml:catalog'
+ prefer %systemOrPublic; #IMPLIED
+ xml:base %uriReference; #IMPLIED
+ %local.catalog.attribs;
+>
+
+<!ENTITY % local.public.attribs "">
+
+<!ELEMENT %public; EMPTY>
+<!ATTLIST %public;
+ id ID #IMPLIED
+ publicId %publicIdentifier; #REQUIRED
+ uri %uriReference; #REQUIRED
+ xml:base %uriReference; #IMPLIED
+ %local.public.attribs;
+>
+
+<!ENTITY % local.system.attribs "">
+
+<!ELEMENT %system; EMPTY>
+<!ATTLIST %system;
+ id ID #IMPLIED
+ systemId %string; #REQUIRED
+ uri %uriReference; #REQUIRED
+ xml:base %uriReference; #IMPLIED
+ %local.system.attribs;
+>
+
+<!ENTITY % local.uri.attribs "">
+
+<!ELEMENT %uri; EMPTY>
+<!ATTLIST %uri;
+ id ID #IMPLIED
+ name %string; #REQUIRED
+ uri %uriReference; #REQUIRED
+ xml:base %uriReference; #IMPLIED
+ %local.uri.attribs;
+>
+
+<!ENTITY % local.rewriteSystem.attribs "">
+
+<!ELEMENT %rewriteSystem; EMPTY>
+<!ATTLIST %rewriteSystem;
+ id ID #IMPLIED
+ systemIdStartString %string; #REQUIRED
+ rewritePrefix %string; #REQUIRED
+ %local.rewriteSystem.attribs;
+>
+
+<!ENTITY % local.rewriteURI.attribs "">
+
+<!ELEMENT %rewriteURI; EMPTY>
+<!ATTLIST %rewriteURI;
+ id ID #IMPLIED
+ uriStartString %string; #REQUIRED
+ rewritePrefix %string; #REQUIRED
+ %local.rewriteURI.attribs;
+>
+
+<!ENTITY % local.delegatePublic.attribs "">
+
+<!ELEMENT %delegatePublic; EMPTY>
+<!ATTLIST %delegatePublic;
+ id ID #IMPLIED
+ publicIdStartString %partialPublicIdentifier; #REQUIRED
+ catalog %uriReference; #REQUIRED
+ xml:base %uriReference; #IMPLIED
+ %local.delegatePublic.attribs;
+>
+
+<!ENTITY % local.delegateSystem.attribs "">
+
+<!ELEMENT %delegateSystem; EMPTY>
+<!ATTLIST %delegateSystem;
+ id ID #IMPLIED
+ systemIdStartString %string; #REQUIRED
+ catalog %uriReference; #REQUIRED
+ xml:base %uriReference; #IMPLIED
+ %local.delegateSystem.attribs;
+>
+
+<!ENTITY % local.delegateURI.attribs "">
+
+<!ELEMENT %delegateURI; EMPTY>
+<!ATTLIST %delegateURI;
+ id ID #IMPLIED
+ uriStartString %string; #REQUIRED
+ catalog %uriReference; #REQUIRED
+ xml:base %uriReference; #IMPLIED
+ %local.delegateURI.attribs;
+>
+
+<!ENTITY % local.nextCatalog.attribs "">
+
+<!ELEMENT %nextCatalog; EMPTY>
+<!ATTLIST %nextCatalog;
+ id ID #IMPLIED
+ catalog %uriReference; #REQUIRED
+ xml:base %uriReference; #IMPLIED
+ %local.nextCatalog.attribs;
+>
+
+<!ENTITY % local.group.mix "">
+<!ENTITY % local.group.attribs "">
+
+<!ELEMENT %group; (%public;|%system;|%uri;
+ |%rewriteSystem;|%rewriteURI;
+ |%delegatePublic;|%delegateSystem;|%delegateURI;
+ |%nextCatalog; %local.group.mix;)+>
+<!ATTLIST %group;
+ id ID #IMPLIED
+ prefer %systemOrPublic; #IMPLIED
+ xml:base %uriReference; #IMPLIED
+ %local.group.attribs;
+>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Entries 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Entries 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,2 @@
+/xhtmlgen.lisp/1.1.1.1/Sun Mar 13 18:02:57 2005//
+D
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Repository 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Repository 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+cxml/contrib
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Root 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/CVS/Root 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cxml/cvsroot
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/xhtmlgen.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/xhtmlgen.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/contrib/xhtmlgen.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,352 @@
+;; xhtmlgen.lisp
+;; This version by david(a)lichteblau.com for headcraft (http://headcraft.de/)
+;;
+;; Derived from htmlgen.cl:
+;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA
+;;
+;; This code is free software; you can redistribute it and/or
+;; modify it under the terms of the version 2.1 of
+;; the GNU Lesser General Public License as published by
+;; the Free Software Foundation, as clarified by the AllegroServe
+;; prequel found in license-allegroserve.txt.
+;;
+;; This code is distributed in the hope that it will be useful,
+;; but without any warranty; without even the implied warranty of
+;; merchantability or fitness for a particular purpose. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; Version 2.1 of the GNU Lesser General Public License is in the file
+;; license-lgpl.txt that was distributed with this file.
+;; If it is not present, you can access it from
+;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer
+;; version) or write to the Free Software Foundation, Inc., 59 Temple Place,
+;; Suite 330, Boston, MA 02111-1307 USA
+
+(defpackage :xhtml-generator
+ (:use :common-lisp)
+ (:export #:with-html #:write-doctype))
+
+(in-package :xhtml-generator)
+
+;; html generation
+
+(defstruct (html-process (:type list) (:constructor
+ make-html-process (key macro special
+ name-attr
+ )))
+ key ; keyword naming this tag
+ macro ; the macro to define this
+ special ; if true then call this to process the keyword and return
+ ; the macroexpansion
+ name-attr ; attribute symbols which can name this object for subst purposes
+ )
+
+
+(defparameter *html-process-table*
+ (make-hash-table :test #'equal) ; #'eq is accurate but want to avoid rehashes
+ )
+
+(defvar *html-sink*)
+
+(defun write-doctype (sink)
+ (sax:start-dtd sink
+ "html"
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
+ (sax:end-dtd sink))
+
+(defmacro with-html (sink &rest forms &environment env)
+ `(let ((*html-sink* ,sink))
+ ,(process-html-forms forms env)))
+
+(defun get-process (form)
+ (let ((ent (gethash form *html-process-table*)))
+ (unless ent
+ (error "unknown html keyword ~s" form))
+ ent))
+
+(defun process-html-forms (forms env)
+ (let (res)
+ (flet ((do-ent (ent args argsp body)
+ ;; ent is an html-process object associated with the
+ ;; html tag we're processing
+ ;; args is the list of values after the tag in the form
+ ;; ((:tag &rest args) ....)
+ ;; argsp is true if this isn't a singleton tag (i.e. it has
+ ;; a body) .. (:tag ...) or ((:tag ...) ...)
+ ;; body is the body if any of the form
+ ;;
+ (let ((special (html-process-special ent)))
+ (push (if special
+ (funcall special ent args argsp body)
+ `(,(html-process-macro ent)
+ ,args
+ ,(process-html-forms body env)))
+ res))))
+ (do* ((xforms forms (cdr xforms))
+ (form (car xforms) (car xforms)))
+ ((null xforms))
+
+ (setq form (macroexpand form env))
+
+ (if (atom form)
+ (typecase form
+ (keyword (do-ent (get-process form) nil nil nil))
+ (string (push `(sax:characters *html-sink* ,form) res))
+ (t (push form res)))
+ (let ((first (car form)))
+ (cond
+ ((keywordp first)
+ ;; (:xxx . body) form
+ (do-ent (get-process (car form)) nil t (cdr form)))
+ ((and (consp first) (keywordp (car first)))
+ ;; ((:xxx args ) . body)
+ (do-ent (get-process (caar form)) (cdr first) t (cdr form)))
+ (t
+ (push form res)))))))
+ `(progn ,@(nreverse res))))
+
+(defun html-body-key-form (string-code args body)
+ (unless (evenp (length args))
+ (error "attribute list ~S isn't even" args))
+ `(let ((.tagname. ,string-code))
+ (sax:start-element *html-sink* nil nil .tagname.
+ (list
+ ,@(loop
+ for (name value) on args by #'cddr
+ collect
+ `(sax:make-attribute
+ :qname ,(etypecase name
+ (symbol (symbol-name name))
+ (string name))
+ :value ,value
+ :specified-p t))))
+ ,@body
+ (sax:end-element *html-sink* nil nil .tagname.)))
+
+(defun emit-without-quoting (str)
+ (let ((s (cxml::chained-handler *html-sink*)))
+ (cxml::maybe-close-tag s)
+ (map nil (lambda (c) (cxml::write-rune (char-code c) s)) str)))
+
+(defun princ-http (val)
+ (warn "use of deprecated :PRINC (use :PRINC-SAFE instead?)")
+ (emit-without-quoting (princ-to-string val)))
+
+(defun prin1-http (val)
+ (warn "use of deprecated :PRIN1 (use :PRIN1-SAFE instead?)")
+ (emit-without-quoting (prin1-to-string val)))
+
+(defun princ-safe-http (val)
+ (sax:characters *html-sink* (princ-to-string val)))
+
+(defun prin1-safe-http (val)
+ (sax:characters *html-sink* (prin1-to-string val)))
+
+
+;; -- defining how html tags are handled. --
+;;
+;; most tags are handled in a standard way and the def-std-html
+;; macro is used to define such tags
+;;
+;; Some tags need special treatment and def-special-html defines
+;; how these are handled. The tags requiring special treatment
+;; are the pseudo tags we added to control operations
+;; in the html generator.
+;;
+;;
+;; tags can be found in three ways:
+;; :br - singleton, no attributes, no body
+;; (:b "foo") - no attributes but with a body
+;; ((:a href="foo") "balh") - attributes and body
+;;
+
+(defmacro def-special-html (kwd fcn)
+ ;; kwd - the tag we're defining behavior for.
+ ;; fcn - function to compute the macroexpansion of a use of this
+ ;; tag. args to fcn are:
+ ;; ent - html-process object holding info on this tag
+ ;; args - list of attribute-values following tag
+ ;; argsp - true if there is a body in this use of the tag
+ ;; body - list of body forms.
+ `(setf (gethash ,kwd *html-process-table*)
+ (make-html-process ,kwd nil ,fcn nil)))
+
+(def-special-html :newline
+ #'(lambda (ent args argsp body)
+ (declare (ignore ent args argsp))
+ (when body
+ (error "can't have a body with :newline -- body is ~s" body))
+ (emit-without-quoting (string #\newline))))
+
+(def-special-html :princ
+ #'(lambda (ent args argsp body)
+ (declare (ignore ent args argsp))
+ `(progn ,@(mapcar #'(lambda (bod)
+ `(princ-http ,bod))
+ body))))
+
+(def-special-html :princ-safe
+ #'(lambda (ent args argsp body)
+ (declare (ignore ent args argsp))
+ `(progn ,@(mapcar #'(lambda (bod)
+ `(princ-safe-http ,bod))
+ body))))
+
+(def-special-html :prin1
+ #'(lambda (ent args argsp body)
+ (declare (ignore ent args argsp))
+ `(progn ,@(mapcar #'(lambda (bod)
+ `(prin1-http ,bod))
+ body))))
+
+(def-special-html :prin1-safe
+ #'(lambda (ent args argsp body)
+ (declare (ignore ent args argsp))
+ `(progn ,@(mapcar #'(lambda (bod)
+ `(prin1-safe-http ,bod))
+ body))))
+
+(def-special-html :comment
+ #'(lambda (ent args argsp body)
+ (declare (ignore ent args argsp body))
+ `(warn ":COMMENT in html macro not supported yet")))
+
+(defmacro def-std-html (kwd name-attrs)
+ (let ((mac-name (intern (format nil "~a-~a" :with-html kwd)))
+ (string-code (string-downcase (string kwd))))
+ `(progn (setf (gethash ,kwd *html-process-table*)
+ (make-html-process ,kwd
+ ',mac-name
+ nil
+ ',name-attrs))
+ (defmacro ,mac-name (args &rest body)
+ (html-body-key-form ,string-code args body)))))
+
+(def-std-html :a nil)
+(def-std-html :abbr nil)
+(def-std-html :acronym nil)
+(def-std-html :address nil)
+(def-std-html :applet nil)
+(def-std-html :area nil)
+
+(def-std-html :b nil)
+(def-std-html :base nil)
+(def-std-html :basefont nil)
+(def-std-html :bdo nil)
+(def-std-html :bgsound nil)
+(def-std-html :big nil)
+(def-std-html :blink nil)
+(def-std-html :blockquote nil)
+(def-std-html :body nil)
+(def-std-html :br nil)
+(def-std-html :button nil)
+
+(def-std-html :caption nil)
+(def-std-html :center nil)
+(def-std-html :cite nil)
+(def-std-html :code nil)
+(def-std-html :col nil)
+(def-std-html :colgroup nil)
+
+(def-std-html :dd nil)
+(def-std-html :del nil)
+(def-std-html :dfn nil)
+(def-std-html :dir nil)
+(def-std-html :div nil)
+(def-std-html :dl nil)
+(def-std-html :dt nil)
+
+(def-std-html :em nil)
+(def-std-html :embed nil)
+
+(def-std-html :fieldset nil)
+(def-std-html :font nil)
+(def-std-html :form :name)
+(def-std-html :frame nil)
+(def-std-html :frameset nil)
+
+(def-std-html :h1 nil)
+(def-std-html :h2 nil)
+(def-std-html :h3 nil)
+(def-std-html :h4 nil)
+(def-std-html :h5 nil)
+(def-std-html :h6 nil)
+(def-std-html :head nil)
+(def-std-html :hr nil)
+(def-std-html :html nil)
+
+(def-std-html :i nil)
+(def-std-html :iframe nil)
+(def-std-html :ilayer nil)
+(def-std-html :img :id)
+(def-std-html :input nil)
+(def-std-html :ins nil)
+(def-std-html :isindex nil)
+
+(def-std-html :kbd nil)
+(def-std-html :keygen nil)
+
+(def-std-html :label nil)
+(def-std-html :layer nil)
+(def-std-html :legend nil)
+(def-std-html :li nil)
+(def-std-html :link nil)
+(def-std-html :listing nil)
+
+(def-std-html :map nil)
+(def-std-html :marquee nil)
+(def-std-html :menu nil)
+(def-std-html :meta nil)
+(def-std-html :multicol nil)
+
+(def-std-html :nobr nil)
+(def-std-html :noembed nil)
+(def-std-html :noframes nil)
+(def-std-html :noscript nil)
+
+(def-std-html :object nil)
+(def-std-html :ol nil)
+(def-std-html :optgroup nil)
+(def-std-html :option nil)
+
+(def-std-html :p nil)
+(def-std-html :param nil)
+(def-std-html :plaintext nil)
+(def-std-html :pre nil)
+
+(def-std-html :q nil)
+
+(def-std-html :s nil)
+(def-std-html :samp nil)
+(def-std-html :script nil)
+(def-std-html :select nil)
+(def-std-html :server nil)
+(def-std-html :small nil)
+(def-std-html :spacer nil)
+(def-std-html :span :id)
+(def-std-html :strike nil)
+(def-std-html :strong nil)
+(def-std-html :style nil)
+(def-std-html :sub nil)
+(def-std-html :sup nil)
+
+(def-std-html :table :name)
+(def-std-html :tbody nil)
+(def-std-html :td nil)
+(def-std-html :textarea nil)
+(def-std-html :tfoot nil)
+(def-std-html :th nil)
+(def-std-html :thead nil)
+(def-std-html :title nil)
+(def-std-html :tr nil)
+(def-std-html :tt nil)
+
+(def-std-html :u nil)
+(def-std-html :ul nil)
+
+(def-std-html :var nil)
+
+(def-std-html :wbr nil)
+
+(def-std-html :xmp nil)
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/cxml.asd
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/cxml.asd 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/cxml.asd 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,102 @@
+(defpackage :cxml-system
+ (:use :asdf :cl))
+(in-package :cxml-system)
+
+;; force loading of runes.asd, which installs *features* this file depends on
+(find-system :runes)
+
+(defclass closure-source-file (cl-source-file) ())
+
+#+scl
+(pushnew 'uri-is-namestring *features*)
+
+#+sbcl
+(defmethod perform :around ((o compile-op) (s closure-source-file))
+ ;; shut up already. Correctness first.
+ (handler-bind ((sb-ext:compiler-note #'muffle-warning))
+ (let (#+sbcl (*compile-print* nil))
+ (call-next-method))))
+
+(asdf:defsystem :cxml-xml
+ :default-component-class closure-source-file
+ :pathname (merge-pathnames
+ "xml/"
+ (make-pathname :name nil :type nil :defaults *load-truename*))
+ :components
+ ((:file "package")
+ (:file "util" :depends-on ("package"))
+ (:file "sax-handler")
+ (:file "xml-name-rune-p" :depends-on ("package" "util"))
+ (:file "split-sequence" :depends-on ("package"))
+ (:file "xml-parse" :depends-on ("package" "util" "sax-handler" "split-sequence" "xml-name-rune-p"))
+ (:file "unparse" :depends-on ("xml-parse"))
+ (:file "xmls-compat" :depends-on ("xml-parse"))
+ (:file "recoder" :depends-on ("xml-parse"))
+ (:file "xmlns-normalizer" :depends-on ("xml-parse"))
+ (:file "space-normalizer" :depends-on ("xml-parse"))
+ (:file "catalog" :depends-on ("xml-parse"))
+ (:file "sax-proxy" :depends-on ("xml-parse")))
+ :depends-on (:runes :puri #-scl :trivial-gray-streams))
+
+(defclass utf8dom-file (closure-source-file) ((of)))
+
+(defmethod output-files ((operation compile-op) (c utf8dom-file))
+ (let* ((normal (car (call-next-method)))
+ (name (concatenate 'string (pathname-name normal) "-utf8")))
+ (list (make-pathname :name name :defaults normal))))
+
+;; must be an extra method because of common-lisp-controller's :around method
+(defmethod output-files :around ((operation compile-op) (c utf8dom-file))
+ (let ((x (call-next-method)))
+ (setf (slot-value c 'of) (car x))
+ x))
+
+(defmethod perform ((o load-op) (c utf8dom-file))
+ (load (slot-value c 'of)))
+
+(defmethod perform ((operation compile-op) (c utf8dom-file))
+ (let ((*features* (cons 'utf8dom-file *features*))
+ (*readtable*
+ (symbol-value (find-symbol "*UTF8-RUNES-READTABLE*" :runes-system))))
+ (call-next-method)))
+
+(asdf:defsystem :cxml-dom
+ :default-component-class closure-source-file
+ :pathname (merge-pathnames
+ "dom/"
+ (make-pathname :name nil :type nil :defaults *load-truename*))
+ :components
+ ((:file "package")
+ (:file rune-impl :pathname "dom-impl" :depends-on ("package"))
+ (:file rune-builder :pathname "dom-builder" :depends-on (rune-impl))
+ #+rune-is-integer
+ (utf8dom-file utf8-impl :pathname "dom-impl" :depends-on ("package"))
+ #+rune-is-integer
+ (utf8dom-file utf8-builder :pathname "dom-builder" :depends-on (utf8-impl))
+ (:file "dom-sax" :depends-on ("package")))
+ :depends-on (:cxml-xml))
+
+(asdf:defsystem :cxml-klacks
+ :default-component-class closure-source-file
+ :pathname (merge-pathnames
+ "klacks/"
+ (make-pathname :name nil :type nil :defaults *load-truename*))
+ :serial t
+ :components
+ ((:file "package")
+ (:file "klacks")
+ (:file "klacks-impl")
+ (:file "tap-source"))
+ :depends-on (:cxml-xml))
+
+(asdf:defsystem :cxml-test
+ :default-component-class closure-source-file
+ :pathname (merge-pathnames
+ "test/"
+ (make-pathname :name nil :type nil :defaults *load-truename*))
+ :components ((:file "domtest") (:file "xmlconf"))
+ :depends-on (:cxml-xml :cxml-klacks :cxml-dom))
+
+(asdf:defsystem :cxml
+ :components ()
+ :depends-on (:cxml-dom :cxml-klacks :cxml-test))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Entries 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Entries 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,12 @@
+/GNUmakefile/1.4/Sun Jul 22 19:59:26 2007//
+/bg.png/1.1/Fri Dec 30 16:06:33 2005/-kb/
+/cxml.css/1.8/Tue May 1 18:21:40 2007//
+/dom.xml/1.1/Sun Feb 18 12:35:50 2007//
+/html.xsl/1.5/Tue May 1 18:21:40 2007//
+/index.xml/1.16/Sun Aug 5 12:01:23 2007//
+/installation.xml/1.3/Sat May 26 21:55:58 2007//
+/klacks.xml/1.9/Sun Apr 22 13:23:54 2007//
+/quickstart.xml/1.2/Tue May 1 18:21:40 2007//
+/sax.xml/1.6/Sat Jul 7 20:47:38 2007//
+/xmls-compat.xml/1.2/Sat Jun 16 11:07:58 2007//
+D
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Repository 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Repository 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+cxml/doc
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Root 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/CVS/Root 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cxml/cvsroot
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/GNUmakefile
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/GNUmakefile 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/GNUmakefile 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,6 @@
+all: dom.html index.html installation.html klacks.html quickstart.html sax.html xmls-compat.html
+
+%.html: %.xml html.xsl
+ xsltproc html.xsl $< >$@.tmp
+ mv $@.tmp $@
+ chmod -w $@
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/bg.png
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/bg.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/cxml.css
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/cxml.css 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/cxml.css 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,90 @@
+div.sidebar {
+ float: right;
+ min-width: 15%;
+ padding: 0pt 5pt 5pt 5pt;
+ font-family: verdana, arial;
+}
+
+div.sidebar-title {
+ font-weight: bold;
+ background-color: #9c0000;
+ border: solid #9c0000;
+ border-top-width: 1px;
+ border-bottom-width: 2px;
+ border-left-width: 4px;
+ border-right-width: 0px;
+ padding-left: 1px;
+ margin: 0em 2pt 0px 2em;
+}
+
+div.sidebar-title a {
+ color: #ffffff;
+}
+
+div.sidebar-main {
+ background-color: #f7f7f7;
+ border: solid #9c0000;
+ border-top-width: 0px;
+ border-bottom-width: 0px;
+ border-left-width: 4px;
+ border-right-width: 0px;
+ margin: 0em 2pt 1em 2em;
+ padding: 1em;
+}
+
+div.sidebar ul.main {
+ padding: 0pt 0pt 0pt 1em;
+ margin: 0 0 1em;
+}
+
+div.sidebar ul.sub {
+ list-style-type: square;
+ padding: 0pt 0pt 0pt 1em;
+ margin: 0 0 1em;
+}
+
+div.sidebar ul.hack {
+ padding: 0 0 0 0;
+ margin: 0 0 1em;
+ list-style-type: none;
+}
+
+body {
+ color: #000000;
+ background-color: #ffffff;
+ margin-right: 0pt;
+ margin-bottom: 10%;
+ margin-left: 40px;
+ padding-left: 30px;
+ font-family: verdana, arial;
+ background-image: url(bg.png);
+ background-position: top left;
+ background-attachment: fixed;
+ background-repeat: no-repeat;
+}
+
+h1 {
+ margin-left: -30px;
+}
+
+h2,h3 {
+ margin-left: -30px;
+ margin-top: 2em;
+}
+
+pre {
+ background-color: #eeeeee;
+ border: solid 1px #d0d0d0;
+ padding: 1em;
+ margin-right: 10%;
+}
+
+.def {
+ background-color: #ddddff;
+ font-weight: bold;
+}
+
+.nomargin {
+ margin-bottom: 0;
+ margin-top: 0;
+}
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/dom.html
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/dom.html 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/dom.html 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,198 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<title>CXML W3C DOM</title>
+<link rel="stylesheet" type="text/css" href="cxml.css">
+</head>
+<body>
+<div class="sidebar">
+<div class="sidebar-title"><a href="index.html">Closure XML</a></div>
+<div class="sidebar-main"><ul class="main">
+<li>
+<a href="installation.html">Installing Closure XML</a><ul class="sub">
+<li><a href="installation.html#download"><b>Download</b></a></li>
+<li><a href="installation.html#implementations">Implementation-specific notes</a></li>
+<li><a href="installation.html#compilation">Compilation</a></li>
+<li><a href="installation.html#tests">Tests</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li>
+<li>
+<a href="sax.html">SAX parsing and serialization</a><ul class="sub">
+<li><a href="sax.html#parser">Parsing and Validating</a></li>
+<li><a href="sax.html#serialization">Serialization</a></li>
+<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li>
+<li><a href="sax.html#rods">Recoders</a></li>
+<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li>
+<li><a href="sax.html#catalogs">XML Catalogs</a></li>
+<li><a href="sax.html#sax">SAX Interface</a></li>
+</ul>
+</li>
+<li>
+<a href="klacks.html">Klacks parser</a><ul class="sub">
+<li><a href="klacks.html#sources">Parsing incrementally</a></li>
+<li><a href="klacks.html#convenience">Convenience functions</a></li>
+<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li>
+<li><a href="klacks.html#locator">Location information</a></li>
+<li><a href="klacks.html#klacksax">Examples</a></li>
+</ul>
+</li>
+<li>
+<a href="dom.html">DOM implementation</a><ul class="sub">
+<li><a href="dom.html#parser">Parsing with the DOM builder</a></li>
+<li><a href="dom.html#serialization">Serialization</a></li>
+<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li>
+</ul></div>
+</div>
+ <h1>W3C DOM</h1>
+ <p>
+ CXML implements the DOM Level 2 Core interfaces. For details
+ on DOM, please refer to the <a href="http://www.w3.org/TR/DOM-Level-2-Core/core.html">specification</a>.
+ </p>
+
+ <a name="parser"></a>
+ <h3>Parsing into DOM</h3>
+ <p>
+ To parse an XML document into a DOM tree, use the SAX parser with a
+ DOM builder as the SAX handler. Example:
+ </p>
+ <pre>(cxml:parse-file "test.xml" (cxml-dom:make-dom-builder))</pre>
+ <p>
+ <div class="def">Function CXML-DOM:MAKE-DOM-BUILDER ()</div>
+ Create a SAX handler which builds a DOM document.
+ <p>
+ </p>
+ This functions returns a DOM builder that will work with the default
+ configuration of the SAX parser and is guaranteed to use
+ characters/strings instead of runes/rods, if that makes a
+ difference on the Lisp in question.
+ <p>
+ </p>
+ This is the same as <tt>rune-dom:make-dom-builder</tt> on Lisps
+ with Unicode support, and the same as
+ <tt>utf8-dom:make-dom-builder</tt> otherwise.
+ </p>
+
+ <p>
+ <div class="def">Function RUNE-DOM:MAKE-DOM-BUILDER ()</div>
+ Create a SAX handler which builds a DOM document using runes and rods.
+ </p>
+
+ <p>
+ <div class="def">Function UTF8-DOM:MAKE-DOM-BUILDER ()</div>
+ (Only on Lisps without Unicode support:)
+ Create a SAX handler which builds a DOM document using
+ UTF-8-encoded strings.
+ </p>
+
+ <a name="serialization"></a>
+ <h3>Serializing DOM</h3>
+ <p>
+ To serialize a DOM document, use a SAX serialization sink as the
+ argument to <tt>dom:map-document</tt>, which generates SAX events
+ for the DOM tree.
+ </p>
+ <p>
+ Applications dealing with namespaces might want to inject a
+ <a href="sax.html#misc">namespace normalizer</a> into the
+ sink chain.
+ </p>
+ <p>
+ <div class="def">Function DOM:MAP-DOCUMENT (handler document &key include-xmlns-attributes include-default-values include-doctype)</div>
+ Traverse a DOM document and call SAX functions as if an XML
+ representation of the document was processed by a SAX parser.
+ </p>
+ <p>Keyword arguments:</p>
+ <ul>
+ <li>
+ <tt>include-xmlns-attributes</tt> -- defaults to
+ <tt>sax:*include-xmlns-attributes*</tt>
+ </li>
+ <li>
+ <tt>include-doctype</tt> -- One of <tt>nil</tt> (no doctype
+ declaration), <tt>:full-internal-subset</tt> (include a doctype
+ declaration and the full internal subset), or
+ <tt>:canonical-notations</tt> (write a doctype declaration
+ with an internal subset including only notations, as required
+ for canonical serialization).
+ </li>
+ <li>
+ <tt>include-default-values</tt> -- include attribute nodes with nil
+ <tt>dom:specified</tt>.
+ </li>
+ <li>
+ <tt>recode</tt> -- (ignored on Lisps with Unicode support.) If
+ true, recode UTF-8 strings to rods. Defaults to true if used
+ with a UTF-8 DOM document. It can be set to false manually to
+ suppress recoding in this case.
+ </li>
+ </ul>
+
+ <a name="mapping"></a>
+ <h3>DOM/Lisp mapping</h3>
+ <p>
+ Note that there is no "standard" DOM mapping for Lisp.
+ </p>
+ <p>
+ DOM is <a href="http://www.w3.org/TR/DOM-Level-2-Core/idl-definitions.html">specified
+ in CORBA IDL</a>, but it refrains from using object-oriented IDL
+ features, allowing for a much more natural Lisp implemenation than
+ the the ordinary IDL/Lisp mapping would.Â
+ Differences between CXML's DOM and the direct IDL/Lisp mapping:
+ </p>
+ <ul>
+ <li>
+ DOM function names are symbols in the <tt>DOM</tt> package (not
+ the <tt>OP</tt> package).
+ </li>
+ <li>
+ DOM functions have proper required arguments, not a huge
+ <tt>&rest</tt> lambda list.
+ </li>
+ <li>
+ Although most IDL interfaces are implemented as CLOS classes by
+ CXML, the Lisp types of DOM objects is not documented and cannot
+ be relied upon. A node's type can be determined using
+ <tt>dom:node-type</tt> instead.
+ </li>
+ <li>
+ <tt>DOMString</tt> is mapped to <tt>rod</tt>, which is either
+ an <tt>(unsigned-byte 16)</tt> array type or a string type.
+ </li>
+ <li>
+ The IDL/Lisp mapping maps CORBA enums to Lisp keywords.Â
+ Unfortunately, the DOM IDL does not use enums. Instead,
+ both exception types and node types are defined integer
+ constants. CXML chooses to ignore this definition and uses
+ keywords instead.
+ </li>
+ <li>
+ DOM uses StudlyCaps. Lisp programmers don't. We
+ insert <tt>#\-</tt> before every upper case letter preceded by a
+ lower case letter and before every upper case letter which is
+ followed by a lower case letter, but preceded by a capital
+ letter. This algorithms leads to the natural Lisp spelling
+ of DOM function names.
+ </li>
+ <li>
+ Implementation note: DOM's <tt>NodeList</tt> does not
+ necessarily map to a native "sequence" type. (For example,
+ node lists are objects in Java, not arrays.)Â
+ <tt>NodeList</tt> is specified to reflect changes done after a
+ node list was created, so node lists cannot be Lisp lists.Â
+ (A node list could be implemented as a CLOS object pointing to
+ said list though.)Â Instead, CXML currently implements node
+ lists as adjustable vectors. Note that code which relies on
+ this implementation and uses Lisp sequence functions
+ instead of sticking to <tt>dom:item</tt> and <tt>dom:length</tt>
+ is not portable. As a compromise, you can use our
+ extensions <tt>dom:map-node-list</tt> or
+ <tt>dom:do-node-list</tt>, which can be implemented portably.
+ </li>
+ </ul>
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/dom.xml
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/dom.xml 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/dom.xml 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,150 @@
+<documentation title="CXML W3C DOM">
+ <h1>W3C DOM</h1>
+ <p>
+ CXML implements the DOM Level 2 Core interfaces.  For details
+ on DOM, please refer to the <a
+ href="http://www.w3.org/TR/DOM-Level-2-Core/core.html">specification</a>.
+ </p>
+
+ <a name="parser"/>
+ <h3>Parsing into DOM</h3>
+ <p>
+ To parse an XML document into a DOM tree, use the SAX parser with a
+ DOM builder as the SAX handler. Example:
+ </p>
+ <pre>(cxml:parse-file "test.xml" (cxml-dom:make-dom-builder))</pre>
+ <p>
+ <div class="def">Function CXML-DOM:MAKE-DOM-BUILDER ()</div>
+ Create a SAX handler which builds a DOM document.
+ <p>
+ </p>
+ This functions returns a DOM builder that will work with the default
+ configuration of the SAX parser and is guaranteed to use
+ characters/strings instead of runes/rods, if that makes a
+ difference on the Lisp in question.
+ <p>
+ </p>
+ This is the same as <tt>rune-dom:make-dom-builder</tt> on Lisps
+ with Unicode support, and the same as
+ <tt>utf8-dom:make-dom-builder</tt> otherwise.
+ </p>
+
+ <p>
+ <div class="def">Function RUNE-DOM:MAKE-DOM-BUILDER ()</div>
+ Create a SAX handler which builds a DOM document using runes and rods.
+ </p>
+
+ <p>
+ <div class="def">Function UTF8-DOM:MAKE-DOM-BUILDER ()</div>
+ (Only on Lisps without Unicode support:)
+ Create a SAX handler which builds a DOM document using
+ UTF-8-encoded strings.
+ </p>
+
+ <a name="serialization"/>
+ <h3>Serializing DOM</h3>
+ <p>
+ To serialize a DOM document, use a SAX serialization sink as the
+ argument to <tt>dom:map-document</tt>, which generates SAX events
+ for the DOM tree.
+ </p>
+ <p>
+ Applications dealing with namespaces might want to inject a
+ <a href="sax.html#misc">namespace normalizer</a> into the
+ sink chain.
+ </p>
+ <p>
+ <div class="def">Function DOM:MAP-DOCUMENT (handler document &key include-xmlns-attributes include-default-values include-doctype)</div>
+ Traverse a DOM document and call SAX functions as if an XML
+ representation of the document was processed by a SAX parser.
+ </p>
+ <p>Keyword arguments:</p>
+ <ul>
+ <li>
+ <tt>include-xmlns-attributes</tt> -- defaults to
+ <tt>sax:*include-xmlns-attributes*</tt>
+ </li>
+ <li>
+ <tt>include-doctype</tt> -- One of <tt>nil</tt> (no doctype
+ declaration), <tt>:full-internal-subset</tt> (include a doctype
+ declaration and the full internal subset), or
+ <tt>:canonical-notations</tt> (write a doctype declaration
+ with an internal subset including only notations, as required
+ for canonical serialization).
+ </li>
+ <li>
+ <tt>include-default-values</tt> -- include attribute nodes with nil
+ <tt>dom:specified</tt>.
+ </li>
+ <li>
+ <tt>recode</tt> -- (ignored on Lisps with Unicode support.) If
+ true, recode UTF-8 strings to rods. Defaults to true if used
+ with a UTF-8 DOM document. It can be set to false manually to
+ suppress recoding in this case.
+ </li>
+ </ul>
+
+ <a name="mapping"/>
+ <h3>DOM/Lisp mapping</h3>
+ <p>
+ Note that there is no "standard" DOM mapping for Lisp.
+ </p>
+ <p>
+ DOM is <a
+ href="http://www.w3.org/TR/DOM-Level-2-Core/idl-definitions.html">specified
+ in CORBA IDL</a>, but it refrains from using object-oriented IDL
+ features, allowing for a much more natural Lisp implemenation than
+ the the ordinary IDL/Lisp mapping would. 
+ Differences between CXML's DOM and the direct IDL/Lisp mapping:
+ </p>
+ <ul>
+ <li>
+ DOM function names are symbols in the <tt>DOM</tt> package (not
+ the <tt>OP</tt> package).
+ </li>
+ <li>
+ DOM functions have proper required arguments, not a huge
+ <tt>&rest</tt> lambda list.
+ </li>
+ <li>
+ Although most IDL interfaces are implemented as CLOS classes by
+ CXML, the Lisp types of DOM objects is not documented and cannot
+ be relied upon.  A node's type can be determined using
+ <tt>dom:node-type</tt> instead.
+ </li>
+ <li>
+ <tt>DOMString</tt> is mapped to <tt>rod</tt>, which is either
+ an <tt>(unsigned-byte 16)</tt> array type or a string type.
+ </li>
+ <li>
+ The IDL/Lisp mapping maps CORBA enums to Lisp keywords. 
+ Unfortunately, the DOM IDL does not use enums.  Instead,
+ both exception types and node types are defined integer
+ constants.  CXML chooses to ignore this definition and uses
+ keywords instead.
+ </li>
+ <li>
+ DOM uses StudlyCaps.  Lisp programmers don't.  We
+ insert <tt>#\-</tt> before every upper case letter preceded by a
+ lower case letter and before every upper case letter which is
+ followed by a lower case letter, but preceded by a capital
+ letter.  This algorithms leads to the natural Lisp spelling
+ of DOM function names.
+ </li>
+ <li>
+ Implementation note: DOM's <tt>NodeList</tt> does not
+ necessarily map to a native "sequence" type.  (For example,
+ node lists are objects in Java, not arrays.) 
+ <tt>NodeList</tt> is specified to reflect changes done after a
+ node list was created, so node lists cannot be Lisp lists. 
+ (A node list could be implemented as a CLOS object pointing to
+ said list though.)  Instead, CXML currently implements node
+ lists as adjustable vectors.  Note that code which relies on
+ this implementation and uses Lisp sequence functions
+ instead of sticking to <tt>dom:item</tt> and <tt>dom:length</tt>
+ is not portable.  As a compromise, you can use our
+ extensions <tt>dom:map-node-list</tt> or
+ <tt>dom:do-node-list</tt>, which can be implemented portably.
+ </li>
+ </ul>
+</documentation>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/html.xsl
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/html.xsl 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/html.xsl 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,110 @@
+<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">
+ <xsl:output method="html"
+ indent="yes"
+ doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN"
+ doctype-system="http://www.w3.org/TR/html4/loose.dtd"/>
+
+ <xsl:template match="@*|node()">
+ <xsl:copy>
+ <xsl:apply-templates select="@*|node()"/>
+ </xsl:copy>
+ </xsl:template>
+
+ <xsl:template match="documentation">
+ <html>
+ <head>
+ <title>
+ <xsl:value-of select="@title"/>
+ </title>
+ <link rel="stylesheet" type="text/css" href="cxml.css"/>
+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
+ </head>
+ <body>
+ <div class="sidebar">
+ <div class="sidebar-title">
+ <a href="index.html">Closure XML</a>
+ </div>
+ <div class="sidebar-main">
+ <ul class="main">
+ <li>
+ <a href="installation.html">Installing Closure XML</a>
+ <ul class="sub">
+ <li><a href="installation.html#download"><b>Download</b></a></li>
+ <li><a href="installation.html#implementations">Implementation-specific notes</a></li>
+ <li><a href="installation.html#compilation">Compilation</a></li>
+ <li><a href="installation.html#tests">Tests</a></li>
+ </ul>
+ </li>
+ <li>
+ <ul class="hack">
+ <li>
+ <a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a>
+ </li>
+ </ul>
+ </li>
+ <li>
+ <a href="sax.html">SAX parsing and serialization</a>
+ <ul class="sub">
+ <li><a href="sax.html#parser">Parsing and Validating</a></li>
+ <li><a href="sax.html#serialization">Serialization</a></li>
+ <li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li>
+ <li><a href="sax.html#rods">Recoders</a></li>
+ <li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li>
+ <li><a href="sax.html#catalogs">XML Catalogs</a></li>
+ <li><a href="sax.html#sax">SAX Interface</a></li>
+ </ul>
+ </li>
+ <li>
+ <a href="klacks.html">Klacks parser</a>
+ <ul class="sub">
+ <li><a href="klacks.html#sources">Parsing incrementally</a></li>
+ <li><a href="klacks.html#convenience">Convenience functions</a></li>
+ <li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li>
+ <li><a href="klacks.html#locator">Location information</a></li>
+ <li><a href="klacks.html#klacksax">Examples</a></li>
+ </ul>
+ </li>
+ <li>
+ <a href="dom.html">DOM implementation</a>
+ <ul class="sub">
+ <li><a href="dom.html#parser">Parsing with the DOM builder</a></li>
+ <li><a href="dom.html#serialization">Serialization</a></li>
+ <li><a href="dom.html#mapping">DOM/Lisp mapping</a></li>
+ </ul>
+ </li>
+ <li>
+ <ul class="hack">
+ <li><a href="xmls-compat.html">XMLS Builder</a></li>
+ </ul>
+ </li>
+ </ul>
+ </div>
+ </div>
+ <xsl:apply-templates/>
+ </body>
+ </html>
+ </xsl:template>
+
+ <xsl:template match="page-index">
+ <ul>
+ <xsl:for-each select="//heading">
+ <li>
+ <a href="#{generate-id()}">
+ <xsl:copy>
+ <xsl:apply-templates select="node()"/>
+ </xsl:copy>
+ </a>
+ </li>
+ </xsl:for-each>
+ </ul>
+ </xsl:template>
+
+ <xsl:template match="heading">
+ <a name="{generate-id()}"/>
+ <h3>
+ <xsl:copy>
+ <xsl:apply-templates select="node()"/>
+ </xsl:copy>
+ </h3>
+ </xsl:template>
+</xsl:stylesheet>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/index.html
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/index.html 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/index.html 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,218 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<title>Closure XML</title>
+<link rel="stylesheet" type="text/css" href="cxml.css">
+</head>
+<body>
+<div class="sidebar">
+<div class="sidebar-title"><a href="index.html">Closure XML</a></div>
+<div class="sidebar-main"><ul class="main">
+<li>
+<a href="installation.html">Installing Closure XML</a><ul class="sub">
+<li><a href="installation.html#download"><b>Download</b></a></li>
+<li><a href="installation.html#implementations">Implementation-specific notes</a></li>
+<li><a href="installation.html#compilation">Compilation</a></li>
+<li><a href="installation.html#tests">Tests</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li>
+<li>
+<a href="sax.html">SAX parsing and serialization</a><ul class="sub">
+<li><a href="sax.html#parser">Parsing and Validating</a></li>
+<li><a href="sax.html#serialization">Serialization</a></li>
+<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li>
+<li><a href="sax.html#rods">Recoders</a></li>
+<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li>
+<li><a href="sax.html#catalogs">XML Catalogs</a></li>
+<li><a href="sax.html#sax">SAX Interface</a></li>
+</ul>
+</li>
+<li>
+<a href="klacks.html">Klacks parser</a><ul class="sub">
+<li><a href="klacks.html#sources">Parsing incrementally</a></li>
+<li><a href="klacks.html#convenience">Convenience functions</a></li>
+<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li>
+<li><a href="klacks.html#locator">Location information</a></li>
+<li><a href="klacks.html#klacksax">Examples</a></li>
+</ul>
+</li>
+<li>
+<a href="dom.html">DOM implementation</a><ul class="sub">
+<li><a href="dom.html#parser">Parsing with the DOM builder</a></li>
+<li><a href="dom.html#serialization">Serialization</a></li>
+<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li>
+</ul></div>
+</div>
+ <h1>Closure XML Parser</h1>
+
+ <p>An XML parser written in Common Lisp.</p>
+
+ <p>
+ Closure XML was written
+ by <a href="http://www.stud.uni-karlsruhe.de/~unk6/">Gilbert
+ Baumann</a> as part of the Closure web browser and is now
+ maintained by
+ <a href="mailto:david@lichteblau.com">David Lichteblau</a>.
+ It is licensed under Lisp-LGPL.
+ </p>
+
+ <p>
+ CXML implements a <a href="http://www.w3.org/TR/REC-xml-names/">namespace-aware</a>,
+ validating <a href="http://www.w3.org/TR/2000/REC-xml-20001006">XMLÂ 1.0</a>
+ parser as well as the <a href="http://www.w3.org/TR/DOM-Level-2-Core/">DOM Level 2 Core</a>
+ interfaces. Two parser interfaces are offered, one SAX-like, the
+ other similar to StAX.
+ </p>
+
+ <p>
+ Send bug reports to <a href="mailto:cxml-devel@common-lisp.net">cxml-devel(a)common-lisp.net</a>
+ (<a href="http://common-lisp.net/cgi-bin/mailman/listinfo/cxml-devel">list
+ information</a>).
+ </p>
+
+ <h3>Add-on features</h3>
+ <p>
+ The following libraries are available as separate downloads:
+ </p>
+ <p>
+ ⬗Â
+ <a href="http://www.lichteblau.com/cxml-rng/">cxml-rng</a>
+ Â Â
+ Relax NG validation
+ </p>
+ <p>
+ ⬗Â
+ <a href="http://www.lichteblau.com/cxml-stp/">cxml-stp</a>
+ Â Â
+ STP, an alternative to DOM
+ </p>
+
+
+ <a name="changes"></a>
+ <h3>Recent Changes</h3>
+ <p class="nomargin"><tt>rel-2007-08-05</tt></p>
+ <ul class="nomargin">
+ <li>Various DTD serialization fixes</li>
+ <li>UTF-8 fix, thanks to Francis Leboutte</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2007-07-07</tt></p>
+ <ul class="nomargin">
+ <li>
+ Fixed build on non-Unicode lisps. Fixed parsing on
+ non-Unicode lisps. Fixed Unicode detection on OpenMCL.
+ </li>
+ <li>New function <tt>cxml:parse</tt>.</li>
+ <li>Serialization no longer defaults to canonical form.</li>
+ <li>Fixed octet array argument to make-source.</li>
+ <li>
+ XMLS compatibility is not <i>bug-for-bug</i>-compatible with
+ XMLS any more. There is now a mode using pairs of local name
+ and namespace URI, and a second mode using qualified names
+ only. The old behaviour using pairs of prefix and local names
+ was removed. (Thanks to Douglas Crosher.)
+ </li>
+ <li>
+ SCL support (thanks to Douglas Crosher). Includes support for
+ implementations where URIs are valid namestrings, and a mode
+ where normal streams are used instead of xstreams and ystreams
+ (albeit both SCL-specific at this point).
+ </li>
+ <li>new convenience serialization function cxml:doctype. Various
+ DTD serialization fixes.</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2007-05-26</tt></p>
+ <ul class="nomargin">
+ <li>cxml.asd has been split up into <tt>cxml.asd</tt> for the
+ XML parser and <tt>runes.asd</tt> for the runes package, in
+ preparation of a complete split of the two systems. Future CXML
+ releases will use separate tarballs for <tt>runes</tt>
+ and <tt>cxml</tt>.</li>
+ <li>xml:base support (SAX and Klacks only, not yet used in DOM).
+ See documentation <a href="sax.html#saxparser">here</a> and <a href="klacks.html#locator">here</a>.</li>
+ <li>New class <tt>broadcast-handler</tt> as a generalization
+ of the older <tt>sax-proxy</tt>.</li>
+ <li>New class <tt>tapping-source</tt>, a klacks source that
+ relays events from an upstream klacks source unchanged, while also
+ emitting them as SAX events to a user-specified handler at the
+ same time.</li>
+ <li>Changed attributes to carry an lname even when occurring
+ without a namespace. Added new functions attribute*,
+ unparse-attribute, and macro with-element*, with-namespace* to
+ the SAX generation wrapper API.</li>
+ <li>Klacks improvements: Incompatibly changed
+ klacks:find-element and find-event to consider the current event
+ as a result. Added klacks-error, klacks:expect, klacks:skip,
+ klacks:expecting-element. Fixed serialize-event to generate
+ start-prefix-mapping and end-prefix-mapping events. New function
+ map-current-namespace-declarations.</li>
+ <li>fixed build with common-lisp-controller</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2007-02-18</tt></p>
+ <ul class="nomargin">
+ <li>New StAX-like parser interface.</li>
+ <li>Serialization fixes (thanks to Nathan Bird, Donavon Keithley).</li>
+ <li>characters.lisp cleanup (thanks to Nathan Bird).</li>
+ <li>Namespace normalizer bugfixes.</li>
+ <li>Minor changes: clone-node on document as an extension. DOM
+ class hierarchy reworked. New function parse-empty-document.
+ Fixed the DOM serializer to not throw away local names.
+ Fixed a long-standing bug in the parser for documents without a
+ doctype. ANSI conformance fixes.</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2006-01-05</tt></p>
+ <ul class="nomargin">
+ <li>Implemented DOM 2 Core.</li>
+ <li>Error handling overhaul.</li>
+ <li>UTF-8 string support in DOM on Lisps without Unicode characters.</li>
+ <li>Sink API has been changed.</li>
+ <li>Support internal subset serialization.</li>
+ <li>Whitespace normalizer.</li>
+ <li>Gilbert Baumann has clarified the license as Lisp-LGPL.</li>
+ <li>Use trivial-gray-streams.</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2005-06-25</tt></p>
+ <ul class="nomargin">
+ <li>Port to OpenMCL (thanks to Rudi Schlatte).</li>
+ <li>Port to LispWorks (thanks to Edi Weitz).</li>
+ <li>Minor new features: <tt>include-default-values</tt> argument to
+ <tt>make-xmls-builder</tt>; <tt>handler</tt> argument
+ to <tt>parse-dtd-stream</tt>; SAX proxy class</li>
+ <li>Various bugfixes.</li>
+ </ul>
+ <p class="nomargin"><tt>patch-357</tt> (2004-10-10)</p>
+ <ul class="nomargin">
+ <li>Auto-detect unicode support for better asdf-installability.</li>
+ <li>Use the puri library for Sys-ID handling.</li>
+ <li>Semi-automatic caching of DTD instances.</li>
+ <li>Support user-defined entity resolvers.</li>
+ <li>Support for Oasis XML Catalogs.</li>
+ <li>xhtmlgen version of Franz htmlgen.</li>
+ <li>Fixes for SBCL's unicode support.</li>
+ </ul>
+ <p class="nomargin"><tt>patch-306</tt> (2004-09-03)</p>
+ <ul class="nomargin">
+ <li>Event-based serialization which does not require DOM documents</li>
+ <li>XMLS compatiblity</li>
+ <li>minor bugfixes (thread safety; should work on clisp again)</li>
+ </ul>
+ <p class="nomargin"><tt>patch-279</tt> (2004-05-11)</p>
+ <ul class="nomargin">
+ <li>Validation</li>
+ <li>bugfixes; XHTML DTD parses again; corrected SAX entity handling</li>
+ </ul>
+ <p class="nomargin"><tt>patch-204</tt></p>
+ <ul class="nomargin">
+ <li>Renamed package <tt>XML</tt> to <tt>CXML</tt>.</li>
+ <li>The unparse functions support non-canonical output now.</li>
+ </ul>
+ <p class="nomargin"><tt>patch-191</tt> (2004-03-18)</p>
+ <ul class="nomargin">
+ <li>Initial release.</li>
+ </ul>
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/index.xml
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/index.xml 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/index.xml 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,174 @@
+<documentation title="Closure XML">
+ <h1>Closure XML Parser</h1>
+
+ <p>An XML parser written in Common Lisp.</p>
+
+ <p>
+ Closure XML was written
+ by <a href="http://www.stud.uni-karlsruhe.de/~unk6/">Gilbert
+ Baumann</a> as part of the Closure web browser and is now
+ maintained by
+ <a href="mailto:david@lichteblau.com">David Lichteblau</a>.
+ It is licensed under Lisp-LGPL.
+ </p>
+
+ <p>
+ CXML implements a <a
+ href="http://www.w3.org/TR/REC-xml-names/">namespace-aware</a>,
+ validating <a
+ href="http://www.w3.org/TR/2000/REC-xml-20001006">XML 1.0</a>
+ parser as well as the <a
+ href="http://www.w3.org/TR/DOM-Level-2-Core/">DOM Level 2 Core</a>
+ interfaces. Two parser interfaces are offered, one SAX-like, the
+ other similar to StAX.
+ </p>
+
+ <p>
+ Send bug reports to <a
+ href="mailto:cxml-devel@common-lisp.net">cxml-devel(a)common-lisp.net</a>
+ (<a
+ href="http://common-lisp.net/cgi-bin/mailman/listinfo/cxml-devel">list
+ information</a>).
+ </p>
+
+ <h3>Add-on features</h3>
+ <p>
+ The following libraries are available as separate downloads:
+ </p>
+ <p>
+ ⬗ 
+ <a href="http://www.lichteblau.com/cxml-rng/">cxml-rng</a>
+   
+ Relax NG validation
+ </p>
+ <p>
+ ⬗ 
+ <a href="http://www.lichteblau.com/cxml-stp/">cxml-stp</a>
+   
+ STP, an alternative to DOM
+ </p>
+
+
+ <a name="changes"/>
+ <h3>Recent Changes</h3>
+ <p class="nomargin"><tt>rel-2007-08-05</tt></p>
+ <ul class="nomargin">
+ <li>Various DTD serialization fixes</li>
+ <li>UTF-8 fix, thanks to Francis Leboutte</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2007-07-07</tt></p>
+ <ul class="nomargin">
+ <li>
+ Fixed build on non-Unicode lisps. Fixed parsing on
+ non-Unicode lisps. Fixed Unicode detection on OpenMCL.
+ </li>
+ <li>New function <tt>cxml:parse</tt>.</li>
+ <li>Serialization no longer defaults to canonical form.</li>
+ <li>Fixed octet array argument to make-source.</li>
+ <li>
+ XMLS compatibility is not <i>bug-for-bug</i>-compatible with
+ XMLS any more. There is now a mode using pairs of local name
+ and namespace URI, and a second mode using qualified names
+ only. The old behaviour using pairs of prefix and local names
+ was removed. (Thanks to Douglas Crosher.)
+ </li>
+ <li>
+ SCL support (thanks to Douglas Crosher). Includes support for
+ implementations where URIs are valid namestrings, and a mode
+ where normal streams are used instead of xstreams and ystreams
+ (albeit both SCL-specific at this point).
+ </li>
+ <li>new convenience serialization function cxml:doctype. Various
+ DTD serialization fixes.</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2007-05-26</tt></p>
+ <ul class="nomargin">
+ <li>cxml.asd has been split up into <tt>cxml.asd</tt> for the
+ XML parser and <tt>runes.asd</tt> for the runes package, in
+ preparation of a complete split of the two systems. Future CXML
+ releases will use separate tarballs for <tt>runes</tt>
+ and <tt>cxml</tt>.</li>
+ <li>xml:base support (SAX and Klacks only, not yet used in DOM).
+ See documentation <a href="sax.html#saxparser">here</a> and <a
+ href="klacks.html#locator">here</a>.</li>
+ <li>New class <tt>broadcast-handler</tt> as a generalization
+ of the older <tt>sax-proxy</tt>.</li>
+ <li>New class <tt>tapping-source</tt>, a klacks source that
+ relays events from an upstream klacks source unchanged, while also
+ emitting them as SAX events to a user-specified handler at the
+ same time.</li>
+ <li>Changed attributes to carry an lname even when occurring
+ without a namespace. Added new functions attribute*,
+ unparse-attribute, and macro with-element*, with-namespace* to
+ the SAX generation wrapper API.</li>
+ <li>Klacks improvements: Incompatibly changed
+ klacks:find-element and find-event to consider the current event
+ as a result. Added klacks-error, klacks:expect, klacks:skip,
+ klacks:expecting-element. Fixed serialize-event to generate
+ start-prefix-mapping and end-prefix-mapping events. New function
+ map-current-namespace-declarations.</li>
+ <li>fixed build with common-lisp-controller</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2007-02-18</tt></p>
+ <ul class="nomargin">
+ <li>New StAX-like parser interface.</li>
+ <li>Serialization fixes (thanks to Nathan Bird, Donavon Keithley).</li>
+ <li>characters.lisp cleanup (thanks to Nathan Bird).</li>
+ <li>Namespace normalizer bugfixes.</li>
+ <li>Minor changes: clone-node on document as an extension. DOM
+ class hierarchy reworked. New function parse-empty-document.
+ Fixed the DOM serializer to not throw away local names.
+ Fixed a long-standing bug in the parser for documents without a
+ doctype. ANSI conformance fixes.</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2006-01-05</tt></p>
+ <ul class="nomargin">
+ <li>Implemented DOM 2 Core.</li>
+ <li>Error handling overhaul.</li>
+ <li>UTF-8 string support in DOM on Lisps without Unicode characters.</li>
+ <li>Sink API has been changed.</li>
+ <li>Support internal subset serialization.</li>
+ <li>Whitespace normalizer.</li>
+ <li>Gilbert Baumann has clarified the license as Lisp-LGPL.</li>
+ <li>Use trivial-gray-streams.</li>
+ </ul>
+ <p class="nomargin"><tt>rel-2005-06-25</tt></p>
+ <ul class="nomargin">
+ <li>Port to OpenMCL (thanks to Rudi Schlatte).</li>
+ <li>Port to LispWorks (thanks to Edi Weitz).</li>
+ <li>Minor new features: <tt>include-default-values</tt> argument to
+ <tt>make-xmls-builder</tt>; <tt>handler</tt> argument
+ to <tt>parse-dtd-stream</tt>; SAX proxy class</li>
+ <li>Various bugfixes.</li>
+ </ul>
+ <p class="nomargin"><tt>patch-357</tt> (2004-10-10)</p>
+ <ul class="nomargin">
+ <li>Auto-detect unicode support for better asdf-installability.</li>
+ <li>Use the puri library for Sys-ID handling.</li>
+ <li>Semi-automatic caching of DTD instances.</li>
+ <li>Support user-defined entity resolvers.</li>
+ <li>Support for Oasis XML Catalogs.</li>
+ <li>xhtmlgen version of Franz htmlgen.</li>
+ <li>Fixes for SBCL's unicode support.</li>
+ </ul>
+ <p class="nomargin"><tt>patch-306</tt> (2004-09-03)</p>
+ <ul class="nomargin">
+ <li>Event-based serialization which does not require DOM documents</li>
+ <li>XMLS compatiblity</li>
+ <li>minor bugfixes (thread safety; should work on clisp again)</li>
+ </ul>
+ <p class="nomargin"><tt>patch-279</tt> (2004-05-11)</p>
+ <ul class="nomargin">
+ <li>Validation</li>
+ <li>bugfixes; XHTML DTD parses again; corrected SAX entity handling</li>
+ </ul>
+ <p class="nomargin"><tt>patch-204</tt></p>
+ <ul class="nomargin">
+ <li>Renamed package <tt>XML</tt> to <tt>CXML</tt>.</li>
+ <li>The unparse functions support non-canonical output now.</li>
+ </ul>
+ <p class="nomargin"><tt>patch-191</tt> (2004-03-18)</p>
+ <ul class="nomargin">
+ <li>Initial release.</li>
+ </ul>
+</documentation>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/installation.html
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/installation.html 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/installation.html 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,150 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<title>CXML Installation</title>
+<link rel="stylesheet" type="text/css" href="cxml.css">
+</head>
+<body>
+<div class="sidebar">
+<div class="sidebar-title"><a href="index.html">Closure XML</a></div>
+<div class="sidebar-main"><ul class="main">
+<li>
+<a href="installation.html">Installing Closure XML</a><ul class="sub">
+<li><a href="installation.html#download"><b>Download</b></a></li>
+<li><a href="installation.html#implementations">Implementation-specific notes</a></li>
+<li><a href="installation.html#compilation">Compilation</a></li>
+<li><a href="installation.html#tests">Tests</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li>
+<li>
+<a href="sax.html">SAX parsing and serialization</a><ul class="sub">
+<li><a href="sax.html#parser">Parsing and Validating</a></li>
+<li><a href="sax.html#serialization">Serialization</a></li>
+<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li>
+<li><a href="sax.html#rods">Recoders</a></li>
+<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li>
+<li><a href="sax.html#catalogs">XML Catalogs</a></li>
+<li><a href="sax.html#sax">SAX Interface</a></li>
+</ul>
+</li>
+<li>
+<a href="klacks.html">Klacks parser</a><ul class="sub">
+<li><a href="klacks.html#sources">Parsing incrementally</a></li>
+<li><a href="klacks.html#convenience">Convenience functions</a></li>
+<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li>
+<li><a href="klacks.html#locator">Location information</a></li>
+<li><a href="klacks.html#klacksax">Examples</a></li>
+</ul>
+</li>
+<li>
+<a href="dom.html">DOM implementation</a><ul class="sub">
+<li><a href="dom.html#parser">Parsing with the DOM builder</a></li>
+<li><a href="dom.html#serialization">Serialization</a></li>
+<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li>
+</ul></div>
+</div>
+ <h1>Installation of Closure XML</h1>
+
+ <a name="download"></a>
+ <h2>Download</h2>
+ <ul>
+ <li>
+ <div><a href="http://common-lisp.net/project/cxml/download/">tarballs</a></div>
+ </li>
+ <li>
+ <div>
+ Anoncvs (<a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/cxml/?cvsroot=cxml">browse</a>):
+ <pre>cvs -d :pserver:anonymous:anonymous@common-lisp.net:/project/cxml/cvsroot co cxml</pre>
+ </div>
+ </li>
+ </ul>
+
+ <a name="implementations"></a>
+ <h2>Implementation-specific notes</h2>
+ <p>
+ CXML should be portable to all Common Lisp implementations
+ supported by <a href="http://common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a>.
+ </p>
+ <ul>
+ <li>
+ The SBCL port uses 16 bit surrogate characters instead of taking
+ advantage of SBCL's full 21 bit character support.
+ </li>
+ </ul>
+
+ <a name="compilation"></a>
+ <h2>Compilation</h2>
+ <p>
+ <a href="http://www.cliki.net/asdf">ASDF</a> is used for
+ compilation. The following instructions assume that ASDF has
+ already been loaded.
+ </p>
+
+ <p>
+ <b>Prerequisites.</b>
+ CXML needs the <a href="http://www.cliki.net/Puri">puri</a> library
+ as well as <a href="http://www.common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a>.
+ </p>
+
+ <p>
+ <b>Compiling and loading CXML.</b>
+ Register the .asd file, e.g. by symlinking it:
+ </p>
+ <pre>$ ln -sf `pwd`/cxml.asd /path/to/your/registry/
+$ ln -sf `pwd`/runes.asd /path/to/your/registry/</pre>
+ <p>Then compile CXML using:</p>
+ <pre>* (asdf:operate 'asdf:load-op :cxml)</pre>
+
+ <p>
+ You can then try the <a href="quickstart.html">quick-start example</a>.
+ </p>
+
+ <a name="tests"></a>
+ <h2>Tests</h2>
+ <p>Check out the XML and DOM testsuites:</p>
+ <pre>$ export CVSROOT=:pserver:anonymous@dev.w3.org:/sources/public
+$ cvs login # password is "anonymous"
+$ cvs co 2001/XML-Test-Suite/xmlconf
+$ cvs co -D '2005-05-06 23:00' 2001/DOM-Test-Suite
+$ cd 2001/DOM-Test-Suite && ant dom1-dtd dom2-dtd</pre>
+ <p>
+ Omit <tt>-D</tt> to get the latest version, which may not work
+ with cxml yet. The <tt>ant</tt> step is necessary to run the DOM
+ tests.
+ </p>
+ <p>Usage:</p>
+ <pre>* (xmlconf:run-all-tests "/path/to/2001/XML-Test-Suite/xmlconf/")
+* (domtest:run-all-tests "/path/to/2001/DOM-Test-Suite/")
+</pre>
+ <p>
+ To compare your results with known output, refer to the files
+ <tt>XMLCONF</tt> and <tt>DOMTEST</tt> in the cxml distribution.
+ </p>
+
+ <p>
+ <i>fixme</i>: Add an explanation of xml/sax-tests here.
+ </p>
+
+ <p>
+ <b>fixme</b> domtest.lisp does not understand the current
+ testsuite driver anymore. To fix this problem, revert the
+ affected files manually after check-out:
+ </p>
+
+ <pre>$ cd 2001/XML-Test-Suite/xmlconf/
+xmltest$ patch -p0 -R </path/to/cxml/test/xmlconf-base.diff</pre>
+
+ <p>
+ The log message for the changes reads "<i>Removed unnecessary
+ xml:base attribute</i>". If I understand correctly, only
+ DOMÂ 3 parsers provide the baseURI attribute necessary for
+ understanding <tt>xmlconf.xml</tt> now. We don't have that
+ yet.
+ </p>
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/installation.xml
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/installation.xml 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/installation.xml 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,101 @@
+<documentation title="CXML Installation">
+ <h1>Installation of Closure XML</h1>
+
+ <a name="download"/>
+ <h2>Download</h2>
+ <ul>
+ <li>
+ <div><a href="http://common-lisp.net/project/cxml/download/">tarballs</a></div>
+ </li>
+ <li>
+ <div>
+ Anoncvs (<a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/cxml/?cvsroot=cxml">browse</a>):
+ <pre>cvs -d :pserver:anonymous:anonymous@common-lisp.net:/project/cxml/cvsroot co cxml</pre>
+ </div>
+ </li>
+ </ul>
+
+ <a name="implementations"/>
+ <h2>Implementation-specific notes</h2>
+ <p>
+ CXML should be portable to all Common Lisp implementations
+ supported by <a
+ href="http://common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a>.
+ </p>
+ <ul>
+ <li>
+ The SBCL port uses 16 bit surrogate characters instead of taking
+ advantage of SBCL's full 21 bit character support.
+ </li>
+ </ul>
+
+ <a name="compilation"/>
+ <h2>Compilation</h2>
+ <p>
+ <a href="http://www.cliki.net/asdf">ASDF</a> is used for
+ compilation. The following instructions assume that ASDF has
+ already been loaded.
+ </p>
+
+ <p>
+ <b>Prerequisites.</b>
+ CXML needs the <a href="http://www.cliki.net/Puri">puri</a> library
+ as well as <a href="http://www.common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a>.
+ </p>
+
+ <p>
+ <b>Compiling and loading CXML.</b>
+ Register the .asd file, e.g. by symlinking it:
+ </p>
+ <pre>$ ln -sf `pwd`/cxml.asd /path/to/your/registry/
+$ ln -sf `pwd`/runes.asd /path/to/your/registry/</pre>
+ <p>Then compile CXML using:</p>
+ <pre>* (asdf:operate 'asdf:load-op :cxml)</pre>
+
+ <p>
+ You can then try the <a href="quickstart.html">quick-start example</a>.
+ </p>
+
+ <a name="tests"/>
+ <h2>Tests</h2>
+ <p>Check out the XML and DOM testsuites:</p>
+ <pre>$ export CVSROOT=:pserver:anonymous@dev.w3.org:/sources/public
+$ cvs login # password is "anonymous"
+$ cvs co 2001/XML-Test-Suite/xmlconf
+$ cvs co -D '2005-05-06 23:00' 2001/DOM-Test-Suite
+$ cd 2001/DOM-Test-Suite && ant dom1-dtd dom2-dtd</pre>
+ <p>
+ Omit <tt>-D</tt> to get the latest version, which may not work
+ with cxml yet. The <tt>ant</tt> step is necessary to run the DOM
+ tests.
+ </p>
+ <p>Usage:</p>
+ <pre>* (xmlconf:run-all-tests "/path/to/2001/XML-Test-Suite/xmlconf/")
+* (domtest:run-all-tests "/path/to/2001/DOM-Test-Suite/")
+</pre>
+ <p>
+ To compare your results with known output, refer to the files
+ <tt>XMLCONF</tt> and <tt>DOMTEST</tt> in the cxml distribution.
+ </p>
+
+ <p>
+ <i>fixme</i>: Add an explanation of xml/sax-tests here.
+ </p>
+
+ <p>
+ <b>fixme</b> domtest.lisp does not understand the current
+ testsuite driver anymore.  To fix this problem, revert the
+ affected files manually after check-out:
+ </p>
+
+ <pre>$ cd 2001/XML-Test-Suite/xmlconf/
+xmltest$ patch -p0 -R </path/to/cxml/test/xmlconf-base.diff</pre>
+
+ <p>
+ The log message for the changes reads "<i>Removed unnecessary
+ xml:base attribute</i>".  If I understand correctly, only
+ DOM 3 parsers provide the baseURI attribute necessary for
+ understanding <tt>xmlconf.xml</tt> now.  We don't have that
+ yet.
+ </p>
+</documentation>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/klacks.html
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/klacks.html 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/klacks.html 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,460 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<title>CXML Klacks parser</title>
+<link rel="stylesheet" type="text/css" href="cxml.css">
+</head>
+<body>
+<div class="sidebar">
+<div class="sidebar-title"><a href="index.html">Closure XML</a></div>
+<div class="sidebar-main"><ul class="main">
+<li>
+<a href="installation.html">Installing Closure XML</a><ul class="sub">
+<li><a href="installation.html#download"><b>Download</b></a></li>
+<li><a href="installation.html#implementations">Implementation-specific notes</a></li>
+<li><a href="installation.html#compilation">Compilation</a></li>
+<li><a href="installation.html#tests">Tests</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li>
+<li>
+<a href="sax.html">SAX parsing and serialization</a><ul class="sub">
+<li><a href="sax.html#parser">Parsing and Validating</a></li>
+<li><a href="sax.html#serialization">Serialization</a></li>
+<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li>
+<li><a href="sax.html#rods">Recoders</a></li>
+<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li>
+<li><a href="sax.html#catalogs">XML Catalogs</a></li>
+<li><a href="sax.html#sax">SAX Interface</a></li>
+</ul>
+</li>
+<li>
+<a href="klacks.html">Klacks parser</a><ul class="sub">
+<li><a href="klacks.html#sources">Parsing incrementally</a></li>
+<li><a href="klacks.html#convenience">Convenience functions</a></li>
+<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li>
+<li><a href="klacks.html#locator">Location information</a></li>
+<li><a href="klacks.html#klacksax">Examples</a></li>
+</ul>
+</li>
+<li>
+<a href="dom.html">DOM implementation</a><ul class="sub">
+<li><a href="dom.html#parser">Parsing with the DOM builder</a></li>
+<li><a href="dom.html#serialization">Serialization</a></li>
+<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li>
+</ul></div>
+</div>
+ <h1>Klacks parser</h1>
+ <p>
+ The Klacks parser provides an alternative parsing interface,
+ similar in concept to Java's <a href="http://jcp.org/en/jsr/detail?id=173">Streaming API for
+ XML</a> (StAX).
+ </p>
+ <p>
+ It implements a streaming, "pull-based" API. This is different
+ from SAX, which is a "push-based" model.
+ </p>
+ <p>
+ Klacks is implemented using the same code base as the SAX parser
+ and has the same parsing characteristics (validation, namespace
+ support, entity resolution) while offering a more flexible interface
+ than SAX.
+ </p>
+ <p>
+ See below for <a href="#examples">examples</a>.
+ </p>
+
+ <a name="sources"></a>
+ <h3>Parsing incrementally using sources</h3>
+ <p>
+ To parse using Klacks, create an XML <tt>source</tt> first.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-SOURCE (input &key validate
+ dtd root entity-resolver disallow-external-subset pathname)</div>
+ Create and return a source for <tt>input</tt>.
+ </p>
+ <p>
+ Exact behaviour depends on <tt>input</tt>, which can
+ be one of the following types:
+ </p>
+ <ul>
+ <li>
+ <tt>pathname</tt> -- a Common Lisp pathname.
+ Open the file specified by the pathname and create a source for
+ the resulting stream. See below for information on how to
+ close the stream.
+ </li>
+ <li>
+<tt>stream</tt> -- a Common Lisp stream with element-type
+ <tt>(unsigned-byte 8)</tt>. See below for information on how to
+ close the stream.
+ </li>
+ <li>
+ <tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array.
+ The array is parsed directly, and interpreted according to the
+ encoding it specifies.
+ </li>
+ <li>
+ <tt>string</tt>/<tt>rod</tt> -- a rod (or <tt>string</tt> on
+ unicode-capable implementations).
+ Parses an XML document from the input string that has already
+ undergone external-format decoding.
+ </li>
+ </ul>
+ <p>
+ <b>Closing streams:</b> Sources can refer to Lisp streams that
+ need to be closed after parsing. This includes a stream passed
+ explicitly as <tt>input</tt>, a stream created implicitly for the
+ <tt>pathname</tt> case, as well as any streams created
+ automatically for external parsed entities referred to by the
+ document.
+ </p>
+ <p>
+ All these stream get closed automatically if end of file is
+ reached normally. Use <tt>klacks:close-source</tt> or
+ <tt>klacks:with-open-source</tt> to ensure that the streams get
+ closed otherwise.
+ </p>
+ <p>
+ <b>Buffering:</b> By default, the Klacks parser performs buffering
+ of octets being read from the stream as an optimization. This can
+ result in unwanted blocking if the stream is a socket and the
+ parser tries to read more data than required to parse the current
+ event. Use <tt>:buffering nil</tt> to disable this optimization.
+ </p>
+ <ul>
+ <li>
+ <tt>buffering</tt> -- Boolean, defaults to <tt>t</tt>. If
+ enabled, read data several kilobytes at time. If disabled,
+ read only single bytes at a time.
+ </li>
+ </ul>
+ <p>
+ The following <b>keyword arguments</b> have the same meaning as
+ with the SAX parser, please refer to the documentation of <a href="sax.html#parser">parse-file</a> for more information:
+ </p>
+ <ul>
+ <li>
+ <tt>validate</tt>
+ </li>
+ <li>
+ <tt>dtd</tt>
+ </li>
+ <li>
+<tt>root</tt>
+ </li>
+ <li>
+ <tt>entity-resolver</tt>
+ </li>
+ <li>
+ <tt>disallow-internal-subset</tt>
+ </li>
+ </ul>
+ <p>
+ In addition, the following argument is for types of <tt>input</tt>
+ other than <tt>pathname</tt>:
+ </p>
+ <ul>
+ <li>
+ <tt>pathname</tt> -- If specified, defines the base URI of the
+ document based on this pathname instance.
+ </li>
+ </ul>
+
+ <p>
+ Events are read from the stream using the following functions:
+ </p>
+ <div class="def">Function KLACKS:PEEK (source)</div>
+ <p> => :start-document<br>
+ or => :start-document, version, encoding, standalonep<br>
+ or => :dtd, name, public-id, system-id<br>
+ or => :start-element, uri, lname, qname<br>
+ or => :end-element, uri, lname, qname<br>
+ or => :characters, data<br>
+ or => :processing-instruction, target, data<br>
+ or => :comment, data<br>
+ or => :end-document, data<br>
+ or => nil
+ </p>
+ <p>
+ <tt>peek</tt> returns the current event's key and main values.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:PEEK-NEXT (source) => key, value*</div>
+ </p>
+ <p>
+ Advance the source forward to the next event and returns it
+ like <tt>peek</tt> would.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:PEEK-VALUE (source) => value*</div>
+ </p>
+ <p>
+ Like <tt>peek</tt>, but return only the values, not the key.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CONSUME (source) => key, value*</div>
+ </p>
+ <p>
+ Return the same values <tt>peek</tt> would, and in addition
+ advance the source forward to the next event.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-URI (source) => uri</div>
+ <div class="def">Function KLACKS:CURRENT-LNAME (source) => string</div>
+ <div class="def">Function KLACKS:CURRENT-QNAME (source) => string</div>
+ </p>
+ <p>
+ If the current event is :start-element or :end-element, return the
+ corresponding value. Else, signal an error.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-CHARACTERS (source) => string</div>
+ </p>
+ <p>
+ If the current event is :characters, return the character data
+ value. Else, signal an error.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-CDATA-SECTION-P (source) => boolean</div>
+ </p>
+ <p>
+ If the current event is :characters, determine whether the data was
+ specified using a CDATA section in the source document. Else,
+ signal an error.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:MAP-CURRENT-NAMESPACE-DECLARATIONS (fn source) => nil</div>
+ </p>
+ <p>
+ For use only on :start-element and :end-element events, this
+ function report every namespace declaration on the current element.
+ On :start-element, these correspond to the xmlns attributes of the
+ start tag. On :end-element, the declarations of the corresponding
+ start tag are reported. No inherited namespaces are
+ included. <tt>fn</tt> is called only for each declaration with two
+ arguments, the prefix and uri.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:MAP-ATTRIBUTES (fn source)</div>
+ </p>
+ <p>
+ Call <tt>fn</tt> for each attribute of the current start tag in
+ turn, and pass the following values as arguments to the function:
+ <ul>
+ <li>namespace uri</li>
+ <li>local name</li>
+ <li>qualified name</li>
+ <li>attribute value</li>
+ <li>a boolean indicating whether the attribute was specified
+ explicitly in the source document, rather than defaulted from
+ a DTD</li>
+ </ul>
+ Only valid for :start-element.
+ </p>
+ <p>
+ Return a list of SAX attribute structures for the current start tag.
+ Only valid for :start-element.
+ </p>
+
+ <p>
+ <div class="def">Function KLACKS:CLOSE-SOURCE (source)</div>
+ Close all streams referred to by <tt>source</tt>.
+ </p>
+ <p>
+ <div class="def">Macro KLACKS:WITH-OPEN-SOURCE ((var source) &body body)</div>
+ Evaluate <tt>source</tt> to create a source object, bind it to
+ symbol <tt>var</tt> and evaluate <tt>body</tt> as an implicit progn.
+ Call <tt>klacks:close-source</tt> to close the source after
+ exiting <tt>body</tt>, whether normally or abnormally.
+ </p>
+
+ <a name="convenience"></a>
+ <h3>Convenience functions</h3>
+ <p>
+ <div class="def">Function KLACKS:FIND-EVENT (source key)</div>
+ Read events from <tt>source</tt> and discard them until an event
+ of type <i>key</i> is found. Return values like <tt>peek</tt>, or
+ NIL if no such event was found.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:FIND-ELEMENT (source &optional
+ lname uri)</div>
+ Read events from <tt>source</tt> and discard them until an event
+ of type :start-element is found with matching local name and
+ namespace uri is found. If <tt>lname</tt> is <tt>nil</tt>, any
+ tag name matches. If <tt>uri</tt> is <tt>nil</tt>, any
+ namespace matches. Return values like <tt>peek</tt> or NIL if no
+ such event was found.
+ </p>
+ <p>
+ <div class="def">Condition KLACKS:KLACKS-ERROR (xml-parse-error)</div>
+ The condition class signalled by <tt>expect</tt>.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:EXPECT (source key &optional
+ value1 value2 value3)</div>
+ Assert that the current event is equal to (key value1 value2
+ value3). (Ignore <i>value</i> arguments that are NIL.) If so,
+ return it as multiple values. Otherwise signal a
+ <tt>klacks-error</tt>.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:SKIP (source key &optional
+ value1 value2 value3)</div>
+ <tt>expect</tt> the specific event, then <tt>consume</tt> it.
+ </p>
+ <p>
+ <div class="def">Macro KLACKS:EXPECTING-ELEMENT ((fn source
+ &optional lname uri) &body body</div>
+ Assert that the current event matches (:start-element uri lname).
+ (Ignore <i>value</i> arguments that are NIL) Otherwise signal a
+ <tt>klacks-error</tt>.
+ Evaluate <tt>body</tt> as an implicit progn. Finally assert that
+ the remaining event matches (:end-element uri lname).
+ </p>
+
+ <a name="klacksax"></a>
+ <h3>Bridging Klacks and SAX</h3>
+ <p>
+ <div class="def">Function KLACKS:SERIALIZE-EVENT (source handler)</div>
+ Send the current klacks event from <tt>source</tt> as a SAX
+ event to the SAX <tt>handler</tt> and consume it.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:SERIALIZE-ELEMENT (source handler
+ &key document-events)</div>
+ Read all klacks events from the following <tt>:start-element</tt> to
+ its <tt>:end-element</tt> and send them as SAX events
+ to <tt>handler</tt>. When this function is called, the current
+ event must be <tt>:start-element</tt>, else an error is
+ signalled. With <tt>document-events</tt> (the default),
+ <tt>sax:start-document</tt> and <tt>sax:end-document</tt> events
+ are sent around the element.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:SERIALIZE-SOURCE (source handler)</div>
+ Read all klacks events from <tt>source</tt> and send them as SAX
+ events to the SAX <tt>handler</tt>.
+ </p>
+ <p>
+ <div class="def">Class KLACKS:TAPPING-SOURCE (source)</div>
+ A klacks source that relays events from an upstream klacks source
+ unchanged, while also emitting them as SAX events to a
+ user-specified handler at the same time.
+ </p>
+ <p>
+ <div class="def">Functon KLACKS:MAKE-TAPPING-SOURCE
+ (upstream-source &optional sax-handler)</div>
+ Create a tapping source relaying events
+ for <tt>upstream-source</tt>, and sending SAX events
+ to <tt>sax-handler</tt>.
+ </p>
+
+ <a name="locator"></a>
+ <h3>Location information</h3>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-LINE-NUMBER (source)</div>
+ Return an approximation of the current line number, or NIL.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-COLUMN-NUMBER (source)</div>
+ Return an approximation of the current column number, or NIL.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-SYSTEM-ID (source)</div>
+ Return the URI of the document being parsed. This is either the
+ main document, or the entity's system ID while contents of a parsed
+ general external entity are being processed.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-XML-BASE (source)</div>
+ Return the [Base URI] of the current element. This URI can differ from
+ the value returned by <tt>current-system-id</tt> if xml:base
+ attributes are present.
+ </p>
+
+ <a name="examples"></a>
+ <h3>Examples</h3>
+ <p>
+ The following example illustrates creation of a klacks <tt>source</tt>,
+ use of the <tt>peek-next</tt> function to read individual events,
+ and shows some of the most common event types.
+ </p>
+ <pre>* <b>(defparameter *source* (cxml:make-source "<example>text</example>"))</b>
+*SOURCE*
+
+* <b>(klacks:peek-next *source*)</b>
+:START-DOCUMENT
+
+* <b>(klacks:peek-next *source*)</b>
+:START-ELEMENT
+NIL ;namespace URI
+"example" ;local name
+"example" ;qualified name
+
+* <b>(klacks:peek-next *source*)</b>
+:CHARACTERS
+"text"
+
+* <b>(klacks:peek-next *source*)</b>
+:END-ELEMENT
+NIL
+"example"
+"example"
+
+* <b>(klacks:peek-next *source*)</b>
+:END-DOCUMENT
+
+* <b>(klacks:peek-next *source*)</b>
+NIL</pre>
+
+ <p>
+ In this example, <tt>find-element</tt> is used to skip over the
+ uninteresting events until the opening <tt>child1</tt> tag is
+ found. Then <tt>serialize-element</tt> is used to generate SAX
+ events for the following element, including its children, and an
+ xmls-compatible list structure is built from those
+ events. <tt>find-element</tt> skips over whitespace,
+ and <tt>find-event</tt> is used to parse up
+ to <tt>:end-document</tt>, ensuring that the source has been
+ closed.
+ </p>
+ <pre>* <b>(defparameter *source*
+ (cxml:make-source "<example>
+ <child1><p>foo</p></child1>
+ <child2 bar='baz'/>
+ </example>"))</b>
+*SOURCE*
+
+* <b>(klacks:find-element *source* "child1")</b>
+:START-ELEMENT
+NIL
+"child1"
+"child1"
+
+* <b>(klacks:serialize-element *source* (cxml-xmls:make-xmls-builder))</b>
+("child1" NIL ("p" NIL "foo"))
+
+* <b>(klacks:find-element *source*)</b>
+:START-ELEMENT
+NIL
+"child2"
+"child2"
+
+* <b>(klacks:serialize-element *source* (cxml-xmls:make-xmls-builder))</b>
+("child2" (("bar" "baz")))
+
+* <b>(klacks:find-event *source* :end-document)</b>
+:END-DOCUMENT
+NIL
+NIL
+NIL
+</pre>
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/klacks.xml
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/klacks.xml 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/klacks.xml 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,410 @@
+<documentation title="CXML Klacks parser">
+ <h1>Klacks parser</h1>
+ <p>
+ The Klacks parser provides an alternative parsing interface,
+ similar in concept to Java's <a
+ href="http://jcp.org/en/jsr/detail?id=173">Streaming API for
+ XML</a> (StAX).
+ </p>
+ <p>
+ It implements a streaming, "pull-based" API. This is different
+ from SAX, which is a "push-based" model.
+ </p>
+ <p>
+ Klacks is implemented using the same code base as the SAX parser
+ and has the same parsing characteristics (validation, namespace
+ support, entity resolution) while offering a more flexible interface
+ than SAX.
+ </p>
+ <p>
+ See below for <a href="#examples">examples</a>.
+ </p>
+
+ <a name="sources"/>
+ <h3>Parsing incrementally using sources</h3>
+ <p>
+ To parse using Klacks, create an XML <tt>source</tt> first.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-SOURCE (input &key validate
+ dtd root entity-resolver disallow-external-subset pathname)</div>
+ Create and return a source for <tt>input</tt>.
+ </p>
+ <p>
+ Exact behaviour depends on <tt>input</tt>, which can
+ be one of the following types:
+ </p>
+ <ul>
+ <li>
+ <tt>pathname</tt> -- a Common Lisp pathname.
+ Open the file specified by the pathname and create a source for
+ the resulting stream. See below for information on how to
+ close the stream.
+ </li>
+ <li><tt>stream</tt> -- a Common Lisp stream with element-type
+ <tt>(unsigned-byte 8)</tt>. See below for information on how to
+ close the stream.
+ </li>
+ <li>
+ <tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array.
+ The array is parsed directly, and interpreted according to the
+ encoding it specifies.
+ </li>
+ <li>
+ <tt>string</tt>/<tt>rod</tt> -- a rod (or <tt>string</tt> on
+ unicode-capable implementations).
+ Parses an XML document from the input string that has already
+ undergone external-format decoding.
+ </li>
+ </ul>
+ <p>
+ <b>Closing streams:</b> Sources can refer to Lisp streams that
+ need to be closed after parsing. This includes a stream passed
+ explicitly as <tt>input</tt>, a stream created implicitly for the
+ <tt>pathname</tt> case, as well as any streams created
+ automatically for external parsed entities referred to by the
+ document.
+ </p>
+ <p>
+ All these stream get closed automatically if end of file is
+ reached normally. Use <tt>klacks:close-source</tt> or
+ <tt>klacks:with-open-source</tt> to ensure that the streams get
+ closed otherwise.
+ </p>
+ <p>
+ <b>Buffering:</b> By default, the Klacks parser performs buffering
+ of octets being read from the stream as an optimization. This can
+ result in unwanted blocking if the stream is a socket and the
+ parser tries to read more data than required to parse the current
+ event. Use <tt>:buffering nil</tt> to disable this optimization.
+ </p>
+ <ul>
+ <li>
+ <tt>buffering</tt> -- Boolean, defaults to <tt>t</tt>. If
+ enabled, read data several kilobytes at time. If disabled,
+ read only single bytes at a time.
+ </li>
+ </ul>
+ <p>
+ The following <b>keyword arguments</b> have the same meaning as
+ with the SAX parser, please refer to the documentation of <a
+ href="sax.html#parser">parse-file</a> for more information:
+ </p>
+ <ul>
+ <li>
+ <tt>validate</tt>
+ </li>
+ <li>
+ <tt>dtd</tt>
+ </li>
+ <li><tt>root</tt>
+ </li>
+ <li>
+ <tt>entity-resolver</tt>
+ </li>
+ <li>
+ <tt>disallow-internal-subset</tt>
+ </li>
+ </ul>
+ <p>
+ In addition, the following argument is for types of <tt>input</tt>
+ other than <tt>pathname</tt>:
+ </p>
+ <ul>
+ <li>
+ <tt>pathname</tt> -- If specified, defines the base URI of the
+ document based on this pathname instance.
+ </li>
+ </ul>
+
+ <p>
+ Events are read from the stream using the following functions:
+ </p>
+ <div class="def">Function KLACKS:PEEK (source)</div>
+ <p> => :start-document<br/>
+ or => :start-document, version, encoding, standalonep<br/>
+ or => :dtd, name, public-id, system-id<br/>
+ or => :start-element, uri, lname, qname<br/>
+ or => :end-element, uri, lname, qname<br/>
+ or => :characters, data<br/>
+ or => :processing-instruction, target, data<br/>
+ or => :comment, data<br/>
+ or => :end-document, data<br/>
+ or => nil
+ </p>
+ <p>
+ <tt>peek</tt> returns the current event's key and main values.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:PEEK-NEXT (source) => key, value*</div>
+ </p>
+ <p>
+ Advance the source forward to the next event and returns it
+ like <tt>peek</tt> would.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:PEEK-VALUE (source) => value*</div>
+ </p>
+ <p>
+ Like <tt>peek</tt>, but return only the values, not the key.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CONSUME (source) => key, value*</div>
+ </p>
+ <p>
+ Return the same values <tt>peek</tt> would, and in addition
+ advance the source forward to the next event.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-URI (source) => uri</div>
+ <div class="def">Function KLACKS:CURRENT-LNAME (source) => string</div>
+ <div class="def">Function KLACKS:CURRENT-QNAME (source) => string</div>
+ </p>
+ <p>
+ If the current event is :start-element or :end-element, return the
+ corresponding value. Else, signal an error.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-CHARACTERS (source) => string</div>
+ </p>
+ <p>
+ If the current event is :characters, return the character data
+ value. Else, signal an error.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-CDATA-SECTION-P (source) => boolean</div>
+ </p>
+ <p>
+ If the current event is :characters, determine whether the data was
+ specified using a CDATA section in the source document. Else,
+ signal an error.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:MAP-CURRENT-NAMESPACE-DECLARATIONS (fn source) => nil</div>
+ </p>
+ <p>
+ For use only on :start-element and :end-element events, this
+ function report every namespace declaration on the current element.
+ On :start-element, these correspond to the xmlns attributes of the
+ start tag. On :end-element, the declarations of the corresponding
+ start tag are reported. No inherited namespaces are
+ included. <tt>fn</tt> is called only for each declaration with two
+ arguments, the prefix and uri.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:MAP-ATTRIBUTES (fn source)</div>
+ </p>
+ <p>
+ Call <tt>fn</tt> for each attribute of the current start tag in
+ turn, and pass the following values as arguments to the function:
+ <ul>
+ <li>namespace uri</li>
+ <li>local name</li>
+ <li>qualified name</li>
+ <li>attribute value</li>
+ <li>a boolean indicating whether the attribute was specified
+ explicitly in the source document, rather than defaulted from
+ a DTD</li>
+ </ul>
+ Only valid for :start-element.
+ </p>
+ <p>
+ Return a list of SAX attribute structures for the current start tag.
+ Only valid for :start-element.
+ </p>
+
+ <p>
+ <div class="def">Function KLACKS:CLOSE-SOURCE (source)</div>
+ Close all streams referred to by <tt>source</tt>.
+ </p>
+ <p>
+ <div class="def">Macro KLACKS:WITH-OPEN-SOURCE ((var source) &body body)</div>
+ Evaluate <tt>source</tt> to create a source object, bind it to
+ symbol <tt>var</tt> and evaluate <tt>body</tt> as an implicit progn.
+ Call <tt>klacks:close-source</tt> to close the source after
+ exiting <tt>body</tt>, whether normally or abnormally.
+ </p>
+
+ <a name="convenience"/>
+ <h3>Convenience functions</h3>
+ <p>
+ <div class="def">Function KLACKS:FIND-EVENT (source key)</div>
+ Read events from <tt>source</tt> and discard them until an event
+ of type <i>key</i> is found. Return values like <tt>peek</tt>, or
+ NIL if no such event was found.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:FIND-ELEMENT (source &optional
+ lname uri)</div>
+ Read events from <tt>source</tt> and discard them until an event
+ of type :start-element is found with matching local name and
+ namespace uri is found. If <tt>lname</tt> is <tt>nil</tt>, any
+ tag name matches. If <tt>uri</tt> is <tt>nil</tt>, any
+ namespace matches. Return values like <tt>peek</tt> or NIL if no
+ such event was found.
+ </p>
+ <p>
+ <div class="def">Condition KLACKS:KLACKS-ERROR (xml-parse-error)</div>
+ The condition class signalled by <tt>expect</tt>.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:EXPECT (source key &optional
+ value1 value2 value3)</div>
+ Assert that the current event is equal to (key value1 value2
+ value3). (Ignore <i>value</i> arguments that are NIL.) If so,
+ return it as multiple values. Otherwise signal a
+ <tt>klacks-error</tt>.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:SKIP (source key &optional
+ value1 value2 value3)</div>
+ <tt>expect</tt> the specific event, then <tt>consume</tt> it.
+ </p>
+ <p>
+ <div class="def">Macro KLACKS:EXPECTING-ELEMENT ((fn source
+ &optional lname uri) &body body</div>
+ Assert that the current event matches (:start-element uri lname).
+ (Ignore <i>value</i> arguments that are NIL) Otherwise signal a
+ <tt>klacks-error</tt>.
+ Evaluate <tt>body</tt> as an implicit progn. Finally assert that
+ the remaining event matches (:end-element uri lname).
+ </p>
+
+ <a name="klacksax"/>
+ <h3>Bridging Klacks and SAX</h3>
+ <p>
+ <div class="def">Function KLACKS:SERIALIZE-EVENT (source handler)</div>
+ Send the current klacks event from <tt>source</tt> as a SAX
+ event to the SAX <tt>handler</tt> and consume it.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:SERIALIZE-ELEMENT (source handler
+ &key document-events)</div>
+ Read all klacks events from the following <tt>:start-element</tt> to
+ its <tt>:end-element</tt> and send them as SAX events
+ to <tt>handler</tt>. When this function is called, the current
+ event must be <tt>:start-element</tt>, else an error is
+ signalled. With <tt>document-events</tt> (the default),
+ <tt>sax:start-document</tt> and <tt>sax:end-document</tt> events
+ are sent around the element.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:SERIALIZE-SOURCE (source handler)</div>
+ Read all klacks events from <tt>source</tt> and send them as SAX
+ events to the SAX <tt>handler</tt>.
+ </p>
+ <p>
+ <div class="def">Class KLACKS:TAPPING-SOURCE (source)</div>
+ A klacks source that relays events from an upstream klacks source
+ unchanged, while also emitting them as SAX events to a
+ user-specified handler at the same time.
+ </p>
+ <p>
+ <div class="def">Functon KLACKS:MAKE-TAPPING-SOURCE
+ (upstream-source &optional sax-handler)</div>
+ Create a tapping source relaying events
+ for <tt>upstream-source</tt>, and sending SAX events
+ to <tt>sax-handler</tt>.
+ </p>
+
+ <a name="locator"/>
+ <h3>Location information</h3>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-LINE-NUMBER (source)</div>
+ Return an approximation of the current line number, or NIL.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-COLUMN-NUMBER (source)</div>
+ Return an approximation of the current column number, or NIL.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-SYSTEM-ID (source)</div>
+ Return the URI of the document being parsed. This is either the
+ main document, or the entity's system ID while contents of a parsed
+ general external entity are being processed.
+ </p>
+ <p>
+ <div class="def">Function KLACKS:CURRENT-XML-BASE (source)</div>
+ Return the [Base URI] of the current element. This URI can differ from
+ the value returned by <tt>current-system-id</tt> if xml:base
+ attributes are present.
+ </p>
+
+ <a name="examples"/>
+ <h3>Examples</h3>
+ <p>
+ The following example illustrates creation of a klacks <tt>source</tt>,
+ use of the <tt>peek-next</tt> function to read individual events,
+ and shows some of the most common event types.
+ </p>
+ <pre>* <b>(defparameter *source* (cxml:make-source "<example>text</example>"))</b>
+*SOURCE*
+
+* <b>(klacks:peek-next *source*)</b>
+:START-DOCUMENT
+
+* <b>(klacks:peek-next *source*)</b>
+:START-ELEMENT
+NIL ;namespace URI
+"example" ;local name
+"example" ;qualified name
+
+* <b>(klacks:peek-next *source*)</b>
+:CHARACTERS
+"text"
+
+* <b>(klacks:peek-next *source*)</b>
+:END-ELEMENT
+NIL
+"example"
+"example"
+
+* <b>(klacks:peek-next *source*)</b>
+:END-DOCUMENT
+
+* <b>(klacks:peek-next *source*)</b>
+NIL</pre>
+
+ <p>
+ In this example, <tt>find-element</tt> is used to skip over the
+ uninteresting events until the opening <tt>child1</tt> tag is
+ found. Then <tt>serialize-element</tt> is used to generate SAX
+ events for the following element, including its children, and an
+ xmls-compatible list structure is built from those
+ events. <tt>find-element</tt> skips over whitespace,
+ and <tt>find-event</tt> is used to parse up
+ to <tt>:end-document</tt>, ensuring that the source has been
+ closed.
+ </p>
+ <pre>* <b>(defparameter *source*
+ (cxml:make-source "<example>
+ <child1><p>foo</p></child1>
+ <child2 bar='baz'/>
+ </example>"))</b>
+*SOURCE*
+
+* <b>(klacks:find-element *source* "child1")</b>
+:START-ELEMENT
+NIL
+"child1"
+"child1"
+
+* <b>(klacks:serialize-element *source* (cxml-xmls:make-xmls-builder))</b>
+("child1" NIL ("p" NIL "foo"))
+
+* <b>(klacks:find-element *source*)</b>
+:START-ELEMENT
+NIL
+"child2"
+"child2"
+
+* <b>(klacks:serialize-element *source* (cxml-xmls:make-xmls-builder))</b>
+("child2" (("bar" "baz")))
+
+* <b>(klacks:find-event *source* :end-document)</b>
+:END-DOCUMENT
+NIL
+NIL
+NIL
+</pre>
+</documentation>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/quickstart.html
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/quickstart.html 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/quickstart.html 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,312 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<title>CXML Quick-Start Example</title>
+<link rel="stylesheet" type="text/css" href="cxml.css">
+</head>
+<body>
+<div class="sidebar">
+<div class="sidebar-title"><a href="index.html">Closure XML</a></div>
+<div class="sidebar-main"><ul class="main">
+<li>
+<a href="installation.html">Installing Closure XML</a><ul class="sub">
+<li><a href="installation.html#download"><b>Download</b></a></li>
+<li><a href="installation.html#implementations">Implementation-specific notes</a></li>
+<li><a href="installation.html#compilation">Compilation</a></li>
+<li><a href="installation.html#tests">Tests</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li>
+<li>
+<a href="sax.html">SAX parsing and serialization</a><ul class="sub">
+<li><a href="sax.html#parser">Parsing and Validating</a></li>
+<li><a href="sax.html#serialization">Serialization</a></li>
+<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li>
+<li><a href="sax.html#rods">Recoders</a></li>
+<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li>
+<li><a href="sax.html#catalogs">XML Catalogs</a></li>
+<li><a href="sax.html#sax">SAX Interface</a></li>
+</ul>
+</li>
+<li>
+<a href="klacks.html">Klacks parser</a><ul class="sub">
+<li><a href="klacks.html#sources">Parsing incrementally</a></li>
+<li><a href="klacks.html#convenience">Convenience functions</a></li>
+<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li>
+<li><a href="klacks.html#locator">Location information</a></li>
+<li><a href="klacks.html#klacksax">Examples</a></li>
+</ul>
+</li>
+<li>
+<a href="dom.html">DOM implementation</a><ul class="sub">
+<li><a href="dom.html#parser">Parsing with the DOM builder</a></li>
+<li><a href="dom.html#serialization">Serialization</a></li>
+<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li>
+</ul></div>
+</div>
+ <h1>Quick-Start Example / FAQ</h1>
+
+ <p>
+ Make sure to <a href="installation.html#installation">install and load</a> cxml first.
+ </p>
+
+ <h3>
+ On this page
+ </h3>
+ <ul>
+<li><a href="#id44301"><heading>Parsing a file</heading></a></li>
+<li><a href="#id45340"><heading>Using DOM</heading></a></li>
+<li><a href="#id45373"><heading>Serializing DOM</heading></a></li>
+<li><a href="#id45393"><heading>Parsing into XMLS-like lists</heading></a></li>
+<li><a href="#id45437"><heading>Parsing incrementally using Klacks</heading></a></li>
+<li><a href="#id45471"><heading>Writing XML</heading></a></li>
+<li><a href="#id45496"><heading>Help! CXML says 'URI scheme :HTTP not supported'</heading></a></li>
+<li><a href="#id45563"><heading>Loading DTDs from local files</heading></a></li>
+<li><a href="#id45589"><heading>Can I skip loading of DTDs entirely?</heading></a></li>
+<li><a href="#id45625"><heading>
+ Catalogs: How can I use the HTML DTD installed by my distribution?
+ </heading></a></li>
+<li><a href="#id45651"><heading>
+ Can I load DTDs through HTTP?
+ </heading></a></li>
+</ul>
+
+ <p>
+ To try the following examples, create a test file
+ called <tt>example.xml</tt>:
+ </p>
+ <pre>* <b>(with-open-file (s "example.xml" :direction :output)
+ (write-string "<test a='b'><child/></test>" s))</b></pre>
+
+ <a name="id44301"></a><h3><heading>Parsing a file</heading></h3>
+
+ <p>Parse <tt>example.xml</tt> into a DOM tree (<a href="sax.html#parser">read
+ more</a>):</p>
+ <pre>* <b>(cxml:parse-file "example.xml" (cxml-dom:make-dom-builder))</b>
+#<DOM-IMPL::DOCUMENT @ #x72206172>
+
+;; save result for later:
+* <b>(defparameter *example* *)</b>
+*EXAMPLE*</pre>
+
+ <a name="id45340"></a><h3><heading>Using DOM</heading></h3>
+
+ <p>Inspect the DOM tree (<a href="sax.html#dom">read more</a>):</p>
+ <pre>* <b>(dom:document-element *example*)</b>
+#<DOM-IMPL::ELEMENT test @ #x722b6ba2>
+
+* (<b>dom:tag-name</b> (dom:document-element *example*))
+"test"
+
+* (<b>dom:child-nodes</b> (dom:document-element *example*))
+#(#<DOM-IMPL::ELEMENT child @ #x722b6d8a>)
+
+* (<b>dom:get-attribute</b> (dom:document-element *example*) <b>"a"</b>)
+"b"</pre>
+
+ <a name="id45373"></a><h3><heading>Serializing DOM</heading></h3>
+
+ <p>Serialize the DOM document back into a file (<a href="sax.html#serialization">read more</a>):</p>
+ <pre>(with-open-file (out "example.out" :direction :output :element-type '(unsigned-byte 8))
+ <b>(dom:map-document (cxml:make-octet-stream-sink out) *example*)</b></pre>
+
+ <a name="id45393"></a><h3><heading>Parsing into XMLS-like lists</heading></h3>
+
+ <p>
+ If DOM is not the representation you want to you, parsing into
+ other data structures is possible using the same SAX parser
+ function, while using a different handler.
+ The XMLS builder is included for compatibility with XMLS, and also
+ also sample code (see cxml/xml/xmls-compat.lisp) for your own
+ handlers.
+ </p>
+
+ <p>As an alternative to DOM, parse into xmls-compatible list
+ structure (<a href="xmls-compat.html">read more</a>):</p>
+ <pre>* <b>(cxml:parse-file "example.xml" (cxml-xmls:make-xmls-builder))</b>
+("test" (("a" "b")) ("child" NIL))</pre>
+
+ <p>
+ Again, serialization into XML is done using a sink as a SAX
+ handler and a data-structure specific function to generate SAX
+ events for the document, in this case <tt>cxml-xmls:map-node</tt>.
+ </p>
+
+ <pre>* (with-open-file (out "example.out" :direction :output :element-type '(unsigned-byte 8))
+ (<b>cxml-xmls:map-node (cxml:make-octet-stream-sink out)
+ '("test" (("a" "b")) ("child" nil)))</b>)</pre>
+
+ <a name="id45437"></a><h3><heading>Parsing incrementally using Klacks</heading></h3>
+
+ <p>Use klacks to read events from the parser incrementally. The
+ following example looks only for :start-element and :end-element
+ events and prints them (<a href="klacks.html">read more</a>):</p>
+ <pre>* <b>(klacks:with-open-source
+ (s (cxml:make-source #p"example.xml"))</b>
+ (loop
+ for key = <b>(klacks:peek s)</b>
+ while key
+ do
+ (case key
+ (:start-element
+ (format t "~A {" <b>(klacks:current-qname s)</b>))
+ (:end-element
+ (format t "}")))
+ <b>(klacks:consume s)</b>))
+test {child {}}</pre>
+
+ <a name="id45471"></a><h3><heading>Writing XML</heading></h3>
+
+ <p>
+ Serialization is always done using sinks, which accept SAX events,
+ but there are convenience functions and macros to make that easier
+ to use:
+ </p>
+ <pre>(cxml:with-xml-output (cxml:make-octet-stream-sink stream :indentation 2 :canonical nil)
+ (cxml:with-element "foo"
+ (cxml:attribute "xyz" "abc")
+ (cxml:with-element "bar"
+ (cxml:attribute "blub" "bla"))
+ (cxml:text "Hi there.")))</pre>
+ <p>
+ Prints this to <tt>stream</tt>:
+ </p>
+ <pre><foo xyz="abc">
+ <bar blub="bla"></bar>
+ Hi there.
+</foo></pre>
+
+ <a name="id45496"></a><h3><heading>Help! CXML says 'URI scheme :HTTP not supported'</heading></h3>
+
+ <p>
+ By default, this error will occur when the DTD (or generally, any
+ entity) has an http:// URL as its system ID. CXML itself
+ understands only file:// URLs, but allows users to customize the
+ behaviour for all URLs.
+ </p>
+
+ <p>
+ The are several solutions to this, covered in detail below:
+ <ul>
+ <li>
+ Load the DTD/entity from local files using an entity resolver
+ </li>
+ <li>
+ Skip parsing of the DTD/entity entirely by pretending it is
+ empty, again using an entity resolver.
+ </li>
+ <li>
+ Use a <em>catalog</em> to make CXML find DTDs in the local
+ filesystem automatically.
+ </li>
+ <li>
+ Teach CXML actually load DTDs using HTTP.
+ </li>
+ </ul>
+ </p>
+
+ <p>
+ Here are the example files for the following solutions to this
+ problem:
+ </p>
+
+ <a href="http://www.lichteblau.com/blubba/dtdexample.xml">
+ <tt>dtdexample.xml</tt>:</a>
+ <pre><!DOCTYPE test SYSTEM 'http://www.lichteblau.com/blubba/dtdexample.dtd'>
+<test a='b'>blub<child/></test></pre>
+
+ <a href="http://www.lichteblau.com/blubba/dtdexample.dtd">
+ <tt>dtdexample.dtd</tt></a>:
+ <pre><!ELEMENT test (#PCDATA|child)*>
+<!ATTLIST test
+ a CDATA #REQUIRED
+ >
+
+<!ELEMENT child EMPTY>
+</pre>
+
+ <a name="id45563"></a><h3><heading>Loading DTDs from local files</heading></h3>
+
+ <p>
+ Use the :entity-resolver argument to <tt>parse-file</tt> to
+ specify a function that maps System IDs and Public IDs to local
+ files of your choice:
+ </p>
+
+ <pre>(let ((uri "http://www.lichteblau.com/blubba/dtdexample.dtd")
+ (pathname "dtdexample.dtd"))
+ (flet ((resolver (pubid sysid)
+ (declare (ignore pubid))
+ <b>(when (puri:uri= sysid (puri:parse-uri uri))
+ (open pathname :element-type '(unsigned-byte 8)))</b>))
+ (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>)))</pre>
+
+
+ <a name="id45589"></a><h3><heading>Can I skip loading of DTDs entirely?</heading></h3>
+
+ <p>
+ Yes and no.
+ </p>
+ <p>
+ <i>Yes</i>, you can force CXML to do this, see the following example.
+ </p>
+
+ <p>
+ But no, skipping the DTD will not actually work if the document
+ references entities declared in the DTD, especially since neither
+ SAX nor DOM are able to report unresolved entity references in
+ attributes.
+ </p>
+
+ <p>
+ The trick to make CXML skip the DTD is to pretend that it is empty
+ by returning a zero-length stream instead:
+ </p>
+
+ <pre>(flet ((resolver (pubid sysid)
+ (declare (ignore pubid sysid))
+ <b>(flexi-streams:make-in-memory-input-stream nil)</b>))
+ (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>))</pre>
+
+ <a name="id45625"></a><h3><heading>
+ Catalogs: How can I use the HTML DTD installed by my distribution?
+ </heading></h3>
+
+ <p>
+ Rather than writing an entity resolver function yourself, CXML can
+ use XML catalogs to find DTDs and entity files on your local system.
+ </p>
+ <p>
+ Catalogs are particularly helpful for DTDs that are
+ pre-installed. For example, most Linux distributions include a
+ package for the XHTML DTD. The DTD will reside in a
+ distribution-dependent location, which the central catalog file
+ points to.
+ </p>
+ <p>By default, CXML looks for the catalog in /etc/xml/catalog
+ (Linux) and /usr/local/share/xml/catalog.ports (FreeBSD).
+ </p>
+ <pre>* <b>(setf cxml:*catalog* (cxml:make-catalog))</b>
+* (cxml:parse-file "test.xhtml" (cxml-dom:make-dom-builder))</pre>
+
+ <a name="id45651"></a><h3><heading>
+ Can I load DTDs through HTTP?
+ </heading></h3>
+
+ <p>
+ Sure, just use an entity-resolver function that does it.
+ </p>
+ <p>
+ Install <a href="http://weitz.de/drakma/">Drakma</a> and try this:
+ </p>
+ <pre>(flet ((resolver (pubid sysid)
+ (declare (ignore pubid))
+ <b>(when (eq (puri:uri-scheme sysid) :http)
+ (drakma:http-request sysid :want-stream t))</b>))
+ (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>))</pre>
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/quickstart.xml
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/quickstart.xml 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/quickstart.xml 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,247 @@
+<documentation title="CXML Quick-Start Example">
+ <h1>Quick-Start Example / FAQ</h1>
+
+ <p>
+ Make sure to <a href="installation.html#installation">install and load</a> cxml first.
+ </p>
+
+ <h3>
+ On this page
+ </h3>
+ <page-index/>
+
+ <p>
+ To try the following examples, create a test file
+ called <tt>example.xml</tt>:
+ </p>
+ <pre>* <b>(with-open-file (s "example.xml" :direction :output)
+ (write-string "<test a='b'><child/></test>" s))</b></pre>
+
+ <heading>Parsing a file</heading>
+
+ <p>Parse <tt>example.xml</tt> into a DOM tree (<a href="sax.html#parser">read
+ more</a>):</p>
+ <pre>* <b>(cxml:parse-file "example.xml" (cxml-dom:make-dom-builder))</b>
+#<DOM-IMPL::DOCUMENT @ #x72206172>
+
+;; save result for later:
+* <b>(defparameter *example* *)</b>
+*EXAMPLE*</pre>
+
+ <heading>Using DOM</heading>
+
+ <p>Inspect the DOM tree (<a href="sax.html#dom">read more</a>):</p>
+ <pre>* <b>(dom:document-element *example*)</b>
+#<DOM-IMPL::ELEMENT test @ #x722b6ba2>
+
+* (<b>dom:tag-name</b> (dom:document-element *example*))
+"test"
+
+* (<b>dom:child-nodes</b> (dom:document-element *example*))
+#(#<DOM-IMPL::ELEMENT child @ #x722b6d8a>)
+
+* (<b>dom:get-attribute</b> (dom:document-element *example*) <b>"a"</b>)
+"b"</pre>
+
+ <heading>Serializing DOM</heading>
+
+ <p>Serialize the DOM document back into a file (<a
+ href="sax.html#serialization">read more</a>):</p>
+ <pre>(with-open-file (out "example.out" :direction :output :element-type '(unsigned-byte 8))
+ <b>(dom:map-document (cxml:make-octet-stream-sink out) *example*)</b></pre>
+
+ <heading>Parsing into XMLS-like lists</heading>
+
+ <p>
+ If DOM is not the representation you want to you, parsing into
+ other data structures is possible using the same SAX parser
+ function, while using a different handler.
+ The XMLS builder is included for compatibility with XMLS, and also
+ also sample code (see cxml/xml/xmls-compat.lisp) for your own
+ handlers.
+ </p>
+
+ <p>As an alternative to DOM, parse into xmls-compatible list
+ structure (<a href="xmls-compat.html">read more</a>):</p>
+ <pre>* <b>(cxml:parse-file "example.xml" (cxml-xmls:make-xmls-builder))</b>
+("test" (("a" "b")) ("child" NIL))</pre>
+
+ <p>
+ Again, serialization into XML is done using a sink as a SAX
+ handler and a data-structure specific function to generate SAX
+ events for the document, in this case <tt>cxml-xmls:map-node</tt>.
+ </p>
+
+ <pre>* (with-open-file (out "example.out" :direction :output :element-type '(unsigned-byte 8))
+ (<b>cxml-xmls:map-node (cxml:make-octet-stream-sink out)
+ '("test" (("a" "b")) ("child" nil)))</b>)</pre>
+
+ <heading>Parsing incrementally using Klacks</heading>
+
+ <p>Use klacks to read events from the parser incrementally. The
+ following example looks only for :start-element and :end-element
+ events and prints them (<a href="klacks.html">read more</a>):</p>
+ <pre>* <b>(klacks:with-open-source
+ (s (cxml:make-source #p"example.xml"))</b>
+ (loop
+ for key = <b>(klacks:peek s)</b>
+ while key
+ do
+ (case key
+ (:start-element
+ (format t "~A {" <b>(klacks:current-qname s)</b>))
+ (:end-element
+ (format t "}")))
+ <b>(klacks:consume s)</b>))
+test {child {}}</pre>
+
+ <heading>Writing XML</heading>
+
+ <p>
+ Serialization is always done using sinks, which accept SAX events,
+ but there are convenience functions and macros to make that easier
+ to use:
+ </p>
+ <pre>(cxml:with-xml-output (cxml:make-octet-stream-sink stream :indentation 2 :canonical nil)
+ (cxml:with-element "foo"
+ (cxml:attribute "xyz" "abc")
+ (cxml:with-element "bar"
+ (cxml:attribute "blub" "bla"))
+ (cxml:text "Hi there.")))</pre>
+ <p>
+ Prints this to <tt>stream</tt>:
+ </p>
+ <pre><foo xyz="abc">
+ <bar blub="bla"></bar>
+ Hi there.
+</foo></pre>
+
+ <heading>Help! CXML says 'URI scheme :HTTP not supported'</heading>
+
+ <p>
+ By default, this error will occur when the DTD (or generally, any
+ entity) has an http:// URL as its system ID. CXML itself
+ understands only file:// URLs, but allows users to customize the
+ behaviour for all URLs.
+ </p>
+
+ <p>
+ The are several solutions to this, covered in detail below:
+ <ul>
+ <li>
+ Load the DTD/entity from local files using an entity resolver
+ </li>
+ <li>
+ Skip parsing of the DTD/entity entirely by pretending it is
+ empty, again using an entity resolver.
+ </li>
+ <li>
+ Use a <em>catalog</em> to make CXML find DTDs in the local
+ filesystem automatically.
+ </li>
+ <li>
+ Teach CXML actually load DTDs using HTTP.
+ </li>
+ </ul>
+ </p>
+
+ <p>
+ Here are the example files for the following solutions to this
+ problem:
+ </p>
+
+ <a href="http://www.lichteblau.com/blubba/dtdexample.xml">
+ <tt>dtdexample.xml</tt>:</a>
+ <pre><!DOCTYPE test SYSTEM 'http://www.lichteblau.com/blubba/dtdexample.dtd'>
+<test a='b'>blub<child/></test></pre>
+
+ <a href="http://www.lichteblau.com/blubba/dtdexample.dtd">
+ <tt>dtdexample.dtd</tt></a>:
+ <pre><!ELEMENT test (#PCDATA|child)*>
+<!ATTLIST test
+ a CDATA #REQUIRED
+ >
+
+<!ELEMENT child EMPTY>
+</pre>
+
+ <heading>Loading DTDs from local files</heading>
+
+ <p>
+ Use the :entity-resolver argument to <tt>parse-file</tt> to
+ specify a function that maps System IDs and Public IDs to local
+ files of your choice:
+ </p>
+
+ <pre>(let ((uri "http://www.lichteblau.com/blubba/dtdexample.dtd")
+ (pathname "dtdexample.dtd"))
+ (flet ((resolver (pubid sysid)
+ (declare (ignore pubid))
+ <b>(when (puri:uri= sysid (puri:parse-uri uri))
+ (open pathname :element-type '(unsigned-byte 8)))</b>))
+ (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>)))</pre>
+
+
+ <heading>Can I skip loading of DTDs entirely?</heading>
+
+ <p>
+ Yes and no.
+ </p>
+ <p>
+ <i>Yes</i>, you can force CXML to do this, see the following example.
+ </p>
+
+ <p>
+ But no, skipping the DTD will not actually work if the document
+ references entities declared in the DTD, especially since neither
+ SAX nor DOM are able to report unresolved entity references in
+ attributes.
+ </p>
+
+ <p>
+ The trick to make CXML skip the DTD is to pretend that it is empty
+ by returning a zero-length stream instead:
+ </p>
+
+ <pre>(flet ((resolver (pubid sysid)
+ (declare (ignore pubid sysid))
+ <b>(flexi-streams:make-in-memory-input-stream nil)</b>))
+ (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>))</pre>
+
+ <heading>
+ Catalogs: How can I use the HTML DTD installed by my distribution?
+ </heading>
+
+ <p>
+ Rather than writing an entity resolver function yourself, CXML can
+ use XML catalogs to find DTDs and entity files on your local system.
+ </p>
+ <p>
+ Catalogs are particularly helpful for DTDs that are
+ pre-installed. For example, most Linux distributions include a
+ package for the XHTML DTD. The DTD will reside in a
+ distribution-dependent location, which the central catalog file
+ points to.
+ </p>
+ <p>By default, CXML looks for the catalog in /etc/xml/catalog
+ (Linux) and /usr/local/share/xml/catalog.ports (FreeBSD).
+ </p>
+ <pre>* <b>(setf cxml:*catalog* (cxml:make-catalog))</b>
+* (cxml:parse-file "test.xhtml" (cxml-dom:make-dom-builder))</pre>
+
+ <heading>
+ Can I load DTDs through HTTP?
+ </heading>
+
+ <p>
+ Sure, just use an entity-resolver function that does it.
+ </p>
+ <p>
+ Install <a href="http://weitz.de/drakma/">Drakma</a> and try this:
+ </p>
+ <pre>(flet ((resolver (pubid sysid)
+ (declare (ignore pubid))
+ <b>(when (eq (puri:uri-scheme sysid) :http)
+ (drakma:http-request sysid :want-stream t))</b>))
+ (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>))</pre>
+</documentation>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/sax.html
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/sax.html 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/sax.html 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,773 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<title>CXML SAX parser</title>
+<link rel="stylesheet" type="text/css" href="cxml.css">
+</head>
+<body>
+<div class="sidebar">
+<div class="sidebar-title"><a href="index.html">Closure XML</a></div>
+<div class="sidebar-main"><ul class="main">
+<li>
+<a href="installation.html">Installing Closure XML</a><ul class="sub">
+<li><a href="installation.html#download"><b>Download</b></a></li>
+<li><a href="installation.html#implementations">Implementation-specific notes</a></li>
+<li><a href="installation.html#compilation">Compilation</a></li>
+<li><a href="installation.html#tests">Tests</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li>
+<li>
+<a href="sax.html">SAX parsing and serialization</a><ul class="sub">
+<li><a href="sax.html#parser">Parsing and Validating</a></li>
+<li><a href="sax.html#serialization">Serialization</a></li>
+<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li>
+<li><a href="sax.html#rods">Recoders</a></li>
+<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li>
+<li><a href="sax.html#catalogs">XML Catalogs</a></li>
+<li><a href="sax.html#sax">SAX Interface</a></li>
+</ul>
+</li>
+<li>
+<a href="klacks.html">Klacks parser</a><ul class="sub">
+<li><a href="klacks.html#sources">Parsing incrementally</a></li>
+<li><a href="klacks.html#convenience">Convenience functions</a></li>
+<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li>
+<li><a href="klacks.html#locator">Location information</a></li>
+<li><a href="klacks.html#klacksax">Examples</a></li>
+</ul>
+</li>
+<li>
+<a href="dom.html">DOM implementation</a><ul class="sub">
+<li><a href="dom.html#parser">Parsing with the DOM builder</a></li>
+<li><a href="dom.html#serialization">Serialization</a></li>
+<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li>
+</ul></div>
+</div>
+ <h1>SAX parsing and serialization</h1>
+
+ <a name="parser"></a>
+
+ <p>
+ This chapter describes CXML's SAX-like parser interface.
+ </p>
+ <p>
+ The SAX layer is an important concept in CXML that users will
+ encounter in various situations:
+ </p>
+ <ul>
+ <li>
+ To <b>parse into DOM</b>, use the SAX parser as described below with
+ a <b>DOM builder</b> as the SAX handler. (Refer to <a href="dom.html#parser">make-dom-builder</a> for information about
+ DOM.)
+ </li>
+ <li>
+ <b>Serialization</b> is done using SAX, too. SAX handlers that
+ process and consume events without sending them to another
+ handler are called <i>sinks</i> in CXML. Serialization sinks
+ write XML output for the events they receive. For example, to
+ serialize DOM, use <tt>map-document</tt> to turn the DOM
+ document into SAX events together with a <tt>sink</tt> for
+ serialization.
+ </li>
+ <li>
+ SAX handlers can be chained together. Various SAX handlers
+ are offered that can be used in this way, transforming SAX
+ events before handing them to the next handler. This includes
+ handlers for <b>whitespace removal</b>, <b>namespace
+ normalization</b>, and rod-to-string <b>recoding</b>.
+ </li>
+ </ul>
+ <p>
+ However, SAX events are easier to generate than to process. That
+ is why CXML offers <i>Klacks</i>, a "pull-based" API in addition to SAX.
+ Klacks events are generally easier to process than to generate.
+ Please refer to the <a href="klacks.html">Klacks documentation</a>
+ for details.
+ </p>
+
+ <h3>Parsing and Validating</h3>
+ <div style="border: 1px dotted black; width: 70%; padding: 1em">
+ <p>
+ Old-style convenience functions:
+ </p>
+ <div style="font-weight: bold">Function CXML:PARSE-FILE (pathname handler &key ...)</div>
+ <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a pathname argument.
+ (But note that <tt>cxml:parse-file</tt> interprets string
+ arguments as namestrings, while <tt>cxml:parse</tt> expects
+ literal XML documents.)
+ </p>
+ <div style="font-weight: bold">Function CXML:PARSE-STREAM (stream handler &key ...)</div>
+ <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a stream argument.</p>
+ <div style="font-weight: bold">Function CXML:PARSE-OCTETS (octets handler &key ...)</div>
+ <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with an octet vector argument.</p>
+ <div style="font-weight: bold">Function CXML:PARSE-ROD (rod handler &key ...)</div>
+ <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a string argument.</p>
+ </div>
+
+ <h4>
+ New all-in-one parser interface:
+ </h4>
+ <div class="def">Function CXML:PARSE (input handler &key ...)</div>
+ <p>
+ Parse an XML document, where input is a string, pathname, octet
+ vector, or stream.
+ Return values from this function depend on the SAX handler used.<br>
+ Arguments:
+ </p>
+ <ul>
+ <li>
+ <tt>input</tt> -- one of:<br>
+ <ul>
+ <li>
+ <tt>pathname</tt> -- a Common Lisp pathname.
+ Open the file specified by the pathname and create a source for
+ the resulting stream. See below for information on how to
+ close the stream.
+ </li>
+ <li>
+<tt>stream</tt> -- a Common Lisp stream with element-type
+ <tt>(unsigned-byte 8)</tt>. See below for information on how to
+ close the stream.
+ </li>
+ <li>
+ <tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array.
+ The array is parsed directly, and interpreted according to the
+ encoding it specifies.
+ </li>
+ <li>
+ <tt>string</tt>/<tt>rod</tt> -- a rod (or <tt>string</tt> on
+ unicode-capable implementations).
+ Parses an XML document from the input string that has already
+ undergone external-format decoding.
+ </li>
+ </ul>
+ </li>
+ <li>
+<tt>stream</tt> -- a Common Lisp stream with element-type
+ <tt>(unsigned-byte 8)</tt>
+</li>
+ <li>
+<tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array</li>
+ <li>
+<tt>handler</tt> -- a SAX handler</li>
+ </ul>
+ <p>
+ Common keyword arguments:
+ </p>
+ <ul>
+ <li>
+ <tt>validate</tt> -- A boolean. Defaults to
+ <tt>nil</tt>. If true, parse in validating mode, i.e. assert that
+ the document contains a DOCTYPE declaration and conforms to the
+ DTD declared.
+ </li>
+ <li>
+ <tt>dtd</tt> -- unless <tt>nil</tt>, an extid instance
+ specifying the external subset to load. This options overrides
+ the extid specified in the document type declaration, if any.
+ See below for <tt>make-extid</tt>. This option is useful
+ for verification purposes together with the <tt>root</tt>
+ and <tt>disallow-internal-subset</tt> arguments.
+ </li>
+ <li>
+<tt>root</tt> -- the expected root element
+ name, or <tt>nil</tt> (the default).
+ </li>
+ <li>
+ <tt>entity-resolver</tt> -- <tt>nil</tt> or a function of two
+ arguments which is invoked for every entity referenced by the
+ document with the entity's Public ID (a rod) and System ID (an
+ URI object) as arguments. The function may either return
+ nil, CXML will then try to resolve the entity as usual.
+ Alternatively it may return a Common Lisp stream specialized on
+ <tt>(unsigned-byte 8)</tt> which will be used instead. (It may
+ also signal an error, of course, which can be useful to prohibit
+ parsed XML documents from including arbitrary files readable by
+ the parser.)
+ </li>
+ <li>
+ <tt>disallow-internal-subset</tt> -- a boolean. If true, signal
+ an error if the document contains an internal subset.
+ </li>
+ <li>
+ <tt>recode</tt> -- a boolean. (Ignored on Lisps with Unicode
+ support.) Recode rods to UTF-8 strings. Defaults to true.
+ Make sure to use <tt>utf8-dom:make-dom-builder</tt> if this
+ option is enabled and <tt>rune-dom:make-dom-builder</tt>
+ otherwise.
+ </li>
+ </ul>
+ <p>
+ Note: <tt>parse-rod</tt> assumes that the input has already been
+ decoded into Unicode runes and ignores the encoding
+ specified in the XML declaration, if any.
+ </p>
+
+ <p>
+ <div class="def">Function CXML:PARSE-EMPTY-DOCUMENT (uri qname handler &key public-id system-id entity-resolver recode)</div>
+ </p>
+ <p>
+ Simulate parsing a document with a document element <tt>qname</tt>
+ having no attributes except for an optional namespace
+ declaration to <tt>uri</tt>. If an external ID is specified
+ (<tt>system-id</tt>, <tt>public-id</tt>), find, parse, and report
+ this DTD as if with <tt>parse-file</tt>, using the specified
+ entity resolver.
+ </p>
+
+ <p>
+ <div class="def">Function CXML:PARSE-DTD-FILE (pathname)</div>
+ <div class="def">Function CXML:PARSE-DTD-STREAM (stream)</div>
+ Parse <a href="http://www.w3.org/TR/2000/REC-xml-20001006#NT-extSubset">declarations</a>
+ from a stand-alone file and return an object representing the DTD,
+ suitable as an argument to <tt>validate</tt>.
+ </p>
+ <ul>
+ <li>
+<tt>pathname</tt> -- a Common Lisp pathname</li>
+ <li>
+<tt>stream</tt> -- a Common Lisp stream with element-type
+ <tt>(unsigned-byte 8)</tt>
+</li>
+ </ul>
+
+ <p>
+ <div class="def">Function CXML:MAKE-EXTID (publicid systemid)</div>
+ Create an object representing the External ID composed
+ of the specified Public ID, a rod or <tt>nil</tt>, and System ID
+ (an URI object).
+ </p>
+
+ <p>
+ <div class="def">Condition class CXML:XML-PARSE-ERROR ()</div>
+ Superclass of all conditions signalled by the CXML parser.
+ </p>
+ <p>
+ <div class="def">Condition class CXML:WELL-FORMEDNESS-VIOLATION (cxml:xml-parse-error)</div>
+ This condition is signalled for all well-formedness violations.
+ (Note that, when parsing document that is not well-formed in validating
+ mode, the parser might encounter validity errors before detecting
+ well-formedness problems, so also be prepared for <tt>validity-error</tt>
+ in that situation.)
+ </p>
+ <p>
+ <div class="def">Condition class CXML:VALIDITY-ERROR (cxml:xml-parse-error)</div>
+ Reports the violation of a validity constraint.
+ </p>
+
+ <a name="serialization"></a>
+ <h3>Serialization</h3>
+ <p>
+ Serialization is performed using <tt>sink</tt> objects. There are
+ different kinds of sinks for output to lisp streams and vectors in
+ various flavours.
+ </p>
+ <p>
+ Technically, sinks are SAX handlers that write XML output for SAX
+ events sent to them. In practise, user code would normally not
+ generate those SAX events manually, and instead use a function
+ like <a href="dom.html#serialization">dom:map-document</a> or <a href="xmls-compat.html">xmls-compat:map-node</a> to serialize an
+ in-memory document.
+ </p>
+ <p>
+ In addition to <tt>map-document</tt>, cxml has a set of
+ convenience macros for serialization (see below for
+ <tt>with-xml-output</tt>, <tt>with-element</tt>, etc).
+ </p>
+
+ <div style="background-color: #ddddff">
+ Portable sinks:<br>
+ <span class="def">Function CXML:MAKE-OCTET-VECTOR-SINK (&rest keys) => sink</span><br>
+ <span class="def">Function CXML:MAKE-OCTET-STREAM-SINK (stream &rest keys) => sink</span><br>
+ <span class="def">Function CXML:MAKE-ROD-SINK (&rest keys) => sink</span><br>
+ <br>
+ Only on Lisps with Unicode support:<br>
+ <span class="def">Function CXML:MAKE-STRING-SINK</span> -- alias for <tt>cxml:make-rod-sink</tt><br>
+ <span class="def">Function CXML:MAKE-CHARACTER-STREAM-SINK (stream &rest keys) => sink</span><br>
+ <br>
+ Only on Lisps <em>without</em> Unicode support:<br>
+ <span class="def">Function CXML:MAKE-STRING-SINK/UTF8 (&rest keys) => sink</span><br>
+ <span class="def">Function CXML:MAKE-CHARACTER-STREAM-SINK/UTF8 (stream &rest keys) => sink</span><br>
+ </div>
+ <p>
+ Return a SAX serialization handle.
+ </p>
+ <ul>
+ <li>
+ The <tt>-octet-</tt> functions write the document encoded into
+ UTF-8.
+ <tt>make-octet-stream-sink</tt> works with Lisp streams of
+ element-type <tt>(unsigned-byte 8)</tt>.
+ <tt>make-octet-vector-sink</tt> returns a vector of
+ <tt>(unsigned-byte 8)</tt>.
+ </li>
+ <li>
+ <tt>make-character-stream-sink</tt> works with character
+ streams. It serializes the document into characters <em>without
+ encoding it into an external format</em>. When using these
+ functions, <em>take care to avoid encoding the result into
+ an incorrect external format</em>. (Note that characters undergo
+ external format conversion when written to a character stream.
+ If the document's XML declaration specifies an encoding, make
+ sure to specify this encoding as the external format if and when
+ writing the serialized document to a character stream. If the
+ document does not specify an encoding, either UTF-8 or UTF-16
+ must be used.) This function is available only on Lisps with
+ unicode support.
+ </li>
+ <li>
+ <tt>make-rod-sink</tt> serializes the document into a vector of
+ runes <em>without encoding it into an external format</em>.
+ (On Lisp with unicode support, the result will be a string;
+ otherwise, a vector of character codes will be returned.)
+ The warnings given for <tt>make-character-stream-sink</tt>
+ apply to this function as well.
+ </li>
+ <li>
+ The <tt>/utf8</tt> functions write the document encoded into
+ characters representing a UTF-8 encoding.
+ When using these functions, <em>take care to avoid encoding the
+ result</em> into an external format for a second time. (Note
+ that characters undergo external format conversion when written
+ to a character stream. Since these functions already perform
+ external format conversion, make sure to specify an external
+ format that does "nothing" if and when writing the serialized document
+ to a character stream. ISO-8859-1 external formats usually
+ achieve the desired effect.)
+ <tt>make-character-stream-sink/utf8</tt> works with character streams.
+ <tt>make-string-sink/utf8</tt> returns a string.
+ These functions are available only on Lisps without unicode support.
+ </li>
+ </ul>
+ <p>Keyword arguments:</p>
+ <ul>
+ <li>
+ <tt>canonical</tt> -- canonical form, one of NIL, T, 1, 2
+ </li>
+ <li>
+ <tt>indentation</tt> -- indentation level. An integer or <tt>nil</tt>.
+ </li>
+ </ul>
+ <p>
+ The following <tt>canonical</tt> values are allowed:
+ </p>
+ <ul>
+ <li>
+ <tt>t</tt> or <tt>1</tt>: <a href="http://www.w3.org/TR/2001/REC-xml-c14n-20010315">Canonical
+ XML</a>
+ </li>
+ <li>
+ <tt>2</tt>: <a href="http://dev.w3.org/cvsweb/~checkout~/2001/XML-Test-Suite/xmlconf/sun/cxml.ht…">Second
+ Canonical Form</a>
+ </li>
+ <li>
+ <tt>NIL</tt>: Use a more readable non-canonical representation.
+ </li>
+ </ul>
+ <p>
+ An internal subset will be included in the result regardless of
+ the <tt>canonical</tt> setting. It is the responsibility of the
+ caller to not report an internal subset for
+ canonical <= 1, or only notations as required for
+ canonical = 2. For example, the
+ <tt>include-doctype</tt> argument to <tt>dom:map-document</tt>
+ should be set to <tt>nil</tt> for the former behaviour and
+ <tt>:canonical-notations</tt> for the latter.
+ </p>
+ <p>
+ With an <tt>indentation</tt> level, pretty-print the XML by
+ inserting additional whitespace. Note that indentation
+ changes the document model and should only be used if whitespace
+ does not matter to the application.
+ </p>
+
+ <p>
+ <div class="def">Macro CXML:WITH-XML-OUTPUT (sink &body body) => sink-specific result</div>
+ <div class="def">Macro CXML:WITH-NAMESPACE ((prefix uri) &body body) => result</div>
+ <div class="def">Macro CXML:WITH-ELEMENT (qname &body body) => result</div>
+ <div class="def">Macro CXML:WITH-ELEMENT* ((prefix lname) &body body) => result</div>
+ <div class="def">Function CXML:ATTRIBUTE (qname value) => value</div>
+ <div class="def">Generic Function CXML:UNPARSE-ATTRIBUTE (value) => string</div>
+ <div class="def">Function CXML:ATTRIBUTE* (prefix lname value) => value</div>
+ <div class="def">Function CXML:TEXT (data) => data</div>
+ <div class="def">Function CXML:CDATA (data) => data</div>
+ <div class="def">Function CXML:doctype (name public-id system-id &optional internal-subset)</div>
+ Convenience syntax for event-based serialization.
+ </p>
+ <p>
+ Example:
+ </p>
+ <pre>(with-xml-output (make-octet-stream-sink stream :indentation 2 :canonical nil)
+ (with-element "foo"
+ (attribute "xyz" "abc")
+ (with-element "bar"
+ (attribute "blub" "bla"))
+ (text "Hi there.")))</pre>
+ <p>
+ Prints this to <tt>stream</tt>:
+ </p>
+ <pre><foo xyz="abc">
+ <bar blub="bla"></bar>
+ Hi there.
+</foo></pre>
+
+ <p>
+ <div class="def">Macro XHTML-GENERATOR:WITH-XHTML (sink &rest forms)</div>
+ <div class="def">Macro XHTML-GENERATOR:WRITE-DOCTYPE (sink)</div>
+ Macro <tt>with-xhtml</tt> is a modified version of
+ Franz' <tt>htmlgen</tt> works as a SAX driver for XHTML.
+ It aims to be a plug-in replacement for the <tt>html</tt> macro.
+ </p>
+ <p>
+ <tt>xhtmlgen</tt> is included as <tt>contrib/xhtmlgen.lisp</tt> in
+ the cxml distribution. Example:
+ </p>
+ <pre>(let ((sink (cxml:make-character-stream-sink *standard-output*)))
+ (sax:start-document sink)
+ (xhtml-generator:write-doctype sink)
+ (xhtml-generator:with-html sink
+ (:html
+ (:head
+ (:title "Titel"))
+ (:body
+ ((:p "style" "font-weight: bold")
+ "Inhalt")
+ (:ul
+ (:li "Eins")
+ (:li "Zwei")
+ (:li "Drei")))))
+ (sax:end-document sink))</pre>
+
+ <a name="misc"></a>
+ <h3>Miscellaneous SAX handlers</h3>
+ <p>
+ <div class="def">Function CXML:MAKE-VALIDATOR (dtd root)</div>
+ Create a SAX handler which validates against a DTD instance.Â
+ The document's root element must be named <tt>root</tt>.Â
+ Used with <tt>dom:map-document</tt>, this validates a document
+ object as if by re-reading it with a validating parser, except
+ that declarations recorded in the document instance are completely
+ ignored.<br>
+ Example:
+ </p>
+ <pre>(let ((d (parse-file "~/test.xml" (cxml-dom:make-dom-builder)))
+ (x (parse-dtd-file "~/test.dtd")))
+ (dom:map-document (cxml:make-validator x #"foo") d))</pre>
+
+ <p>
+ <div class="def">Class CXML:BROADCAST-HANDLER ()</div>
+ <div class="def">Accessor CXML:BROADCAST-HANDLER-HANDLERS</div>
+ <div class="def">Function CXML:MAKE-BROADCAST-HANDLER (&rest handlers)</div>
+ <tt>broadcast-handler</tt> is a SAX handler which passes every event it
+ receives on to each of several chained handlers, somewhat similar
+ to the way a <tt>broadcast-stream</tt> works.
+ </p>
+ <p>
+ You can subclass <tt>broadcast-stream</tt> to modify the events
+ before they are being passed on. Define methods on your handler
+ class for the events to be modified. All other events will pass
+ through to the chained handlers unmodified.
+ </p>
+ <p>
+ Broadcast handler functions return the result of calling the event
+ function on the <i>last</i> handler in the list. In particular,
+ the overall result from <tt>sax:end-document</tt> will be ignored
+ for all other handlers.
+ </p>
+
+ <p>
+ <div class="def">Class CXML:SAX-PROXY (broadcast-handler)</div>
+ <div class="def">Accessor CXML:PROXY-CHAINED-HANDLER</div>
+ <tt>sax-proxy</tt> is a subclass of <tt>broadcast-handler</tt>
+ which sends events to exactly one chained handler. This class is
+ still included for compatibility with older versions of
+ CXML which did not include the more
+ general <tt>broadcast-handler</tt> yet, but has been retrofitted
+ as a subclass of the latter.
+ </p>
+
+ <p>
+ <div class="def">Accessor CXML:MAKE-NAMESPACE-NORMALIZER (next-handler)</div>
+ </p>
+ <p>
+ Return a SAX handler that performs <a href="http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/namespaces-algorith…">DOM
+ 3-style namespace normalization</a> on attribute lists in
+ <tt>start-element</tt> events before passing them on the next
+ handler.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-WHITESPACE-NORMALIZER (chained-handler &optional dtd)</div>
+ Return a SAX handler which removes whitespace from elements that
+ have <em>element content</em> and have not been declared to
+ preserve space using an xml:space attribute.
+ </p>
+ <p>Example:</p>
+ <pre>(cxml:parse-file "example.xml"
+ (cxml:make-whitespace-normalizer (cxml-dom:make-dom-builder))
+ :validate t)</pre>
+ <p>Example input:</p>
+ <pre><!DOCTYPE test [
+<!ELEMENT test (foo,bar*)>
+<!ATTLIST test a CDATA #IMPLIED>
+<!ELEMENT foo #PCDATA>
+<!ELEMENT bar (foo?)>
+<!ATTLIST bar xml:space (default|preserve) "default">
+]>
+<test a='b'>
+ <foo> </foo>
+ <bar> </bar>
+ <bar xml:space="preserve"> </bar>
+</test>
+</pre>
+ <p>Example result:</p>
+ <pre><test a="b"><foo> </foo><bar></bar><bar xml:space="preserve"> </bar></test></pre>
+
+ <a name="rods"></a>
+ <h3>Recoders</h3>
+ <p>
+ Recoders are a mechanism used by CXML internally on Lisp implementations
+ without Unicode support to recode UTF-16 vectors (rods) of
+ integers (runes) into UTF-8 strings.
+ </p>
+ <p>
+ User code does not usually need to deal with recoders in current
+ versions of CXML.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-RECODER (chained-handler recoder-fn)</div>
+ Return a SAX handler which passes all events on to
+ <tt>chained-handler</tt> after converting all strings and rods
+ using <tt>recoder-fn</tt>, a function of one argument.
+ </p>
+
+ <a name="dtdcache"></a>
+ <h3>Caching of DTD Objects</h3>
+ <p>
+ To avoid spending time parsing the same DTD over and over again,
+ CXML can cache DTD objects. The parser consults
+ <tt>cxml:*dtd-cache*</tt> whenever it is looking for an external
+ subset in a document which does not have an internal subset and
+ uses the cached DTD instance if one is present in the cache for
+ the System ID in question.
+ </p>
+ <p>
+ Note that DTDs do not expire from the cache automatically.
+ (Future versions of CXML might introduce automatic checks for
+ outdated DTDs.)
+ </p>
+ <p>
+ <div class="def">Variable CXML:*DTD-CACHE*</div>
+ The DTD cache object consulted by the parser when it needs a DTD.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-DTD-CACHE ()</div>
+ Return a new, empty DTD cache object.
+ </p>
+ <p>
+ <div class="def">Variable CXML:*CACHE-ALL-DTDS*</div>
+ If true, instructs the parser to enter all DTDs that could have
+ been cached into <tt>*dtd-cache*</tt> if they were not cached
+ already. Defaults to <tt>nil</tt>.
+ </p>
+ <p>
+ <div class="def">Reader CXML:GETDTD (uri dtd-cache)</div>
+ Return a cached instance of the DTD at <tt>uri</tt>, if present in
+ the cache, or <tt>nil</tt>.
+ </p>
+ <p>
+ <div class="def">Writer CXML:GETDTD (uri dtd-cache)</div>
+ Enter a new value for <tt>uri</tt> into <tt>dtd-cache</tt>.
+ </p>
+ <p>
+ <div class="def">Function CXML:REMDTD (uri dtd-cache)</div>
+ Ensure that no DTD is recorded for <tt>uri</tt> in the cache and
+ return true if such a DTD was present.
+ </p>
+ <p>
+ <div class="def">Function CXML:CLEAR-DTD-CACHE (dtd-cache)</div>
+ Remove all entries from <tt>dtd-cache</tt>.
+ </p>
+ <p>
+ <em>fixme:</em> thread-safety
+ </p>
+
+ <a name="saxparser"></a>
+ <h3>Location information</h3>
+ <p>
+ <div class="def">Class SAX:SAX-PARSER ()</div>
+ A class providing location information through an
+ implementation-specific subclass. Parsers will use
+ <tt>sax:register-sax-parser</tt> to pass their parser instance to
+ the handler. The easiest way to receive sax parsers instances is
+ to inherit from sax-parser-mixin when defining a sax handler.
+ </p>
+ <p>
+ <div class="def">Class SAX:SAX-PARSER-MIXIN ()</div>
+ A mixin for sax handler classes that records the sax handler
+ object for use with the following functions. Trampoline methods
+ are provided that allow those functions to be called directly on
+ the sax-parser-mixin.
+ </p>
+ <p>
+ <div class="def">Function SAX:SAX-HANDLER (sax-handler-mixin) => sax-handler</div>
+ Return the sax-parser instance recorded by this handler, or NIL.
+ </p>
+ <p>
+ <div class="def">Function SAX:LINE-NUMBER (sax-parser)</div>
+ Return an approximation of the current line number, or NIL.
+ </p>
+ <p>
+ <div class="def">Function SAX:COLUMN-NUMBER (sax-parser)</div>
+ Return an approximation of the current column number, or NIL.
+ </p>
+ <p>
+ <div class="def">Function SAX:SYSTEM-ID (sax-parser)</div>
+ Return the URI of the document being parsed. This is either the
+ main document, or the entity's system ID while contents of a parsed
+ general external entity are being processed.
+ </p>
+ <p>
+ <div class="def">Function SAX:XML-BASE (sax-parser)</div>
+ Return the [Base URI] of the current element. This URI can differ from
+ the value returned by <tt>sax:system-id</tt> if xml:base
+ attributes are present.
+ </p>
+
+ <a name="catalogs"></a>
+ <h3>XML Catalogs</h3>
+ <p>
+ External entities (for example, DTDs) are referred to using their
+ Public and System IDs. Usually the System ID, a URI, is used to
+ locate the entity. CXML itself handles only file://-URIs, but
+ many System IDs in practical use are http://-URIs. There are two
+ different mechanims applications can use to allow CXML to locate
+ entities using arbitrary Public ID or System ID:
+ </p>
+ <ul>
+ <li>
+ User-defined entity resolvers can be used to open entities using
+ arbitrary protocols. For example, an entity resolver could
+ handle all System-IDs with the <tt>http</tt> scheme using some
+ HTTP library. Refer to the description of the
+ <tt>entity-resolver</tt> keyword argument to parser functions (see <a href="#parser"><tt>cxml:parse-file</tt></a>) to more
+ information on entity resolvers.
+ </li>
+ <li>
+ XML Catalogs are (local) tables in XML syntax which map External
+ IDs to alternative System IDs. If, say, the xhtml DTD is
+ present in the local file system and the local copy has been
+ registered with the XML catalog, CXML will use the local copy of
+ the DTD instead of trying to open the version available using HTTP.
+ </li>
+ </ul>
+ <p>
+ This section describes XML Catalogs, the second solution. CXML
+ implements <a href="http://www.oasis-open.org/committees/entity/spec.html">Oasis
+ XML Catalogs</a>.
+ </p>
+ <p>
+ <div class="def">Variable CXML:*CATALOG*</div>
+ The XML Catalog object consulted by the parser before trying to
+ open an entity. Initially <tt>nil</tt>.
+ </p>
+ <p>
+ <div class="def">Variable CXML:*PREFER*</div>
+ The default "prefer" mode from the Catalog specification, one
+ of <tt>:public</tt> or <tt>:system</tt>. Defaults
+ to <tt>:public</tt>.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-CATALOG (&optional uris)</div>
+ Return a catalog object for the catalog files specified.
+ </p>
+ <p>
+ <div class="def">Function CXML:RESOLVE-URI (uri catalog)</div>
+ Look up <tt>uri</tt> in <tt>catalog</tt> and return the
+ resulting URI, or <tt>nil</tt> if no match was found.
+ </p>
+ <p>
+ <div class="def">Function CXML:RESOLVE-EXTID (publicid systemid catalog)</div>
+ Look up the External ID (<tt>publicid</tt>, <tt>systemid</tt>)
+ in <tt>catalog</tt> and return the resulting URI, or <tt>nil</tt>
+ if no match was found.
+ </p>
+ <p>
+ Example:
+ </p>
+ <pre>* (setf cxml:*catalog* nil)
+* (cxml:parse-file "test.xhtml" nil)
+=> Error: URI scheme :HTTP not supported
+
+* (setf cxml:*catalog* (cxml:make-catalog))
+* (cxml:parse-file "test.xhtml" nil)
+;; no error!
+NIL</pre>
+ <p>
+ Note that parsed catalog files are cached in the catalog object.
+ Catalog files cached do not expire automatically. To ensure that
+ all catalog files are parsed again, create a new catalog object.
+ </p>
+
+ <a name="sax"></a>
+ <h2>SAX Interface</h2>
+ <p>
+ A SAX handler is an arbitrary objects that implements some of the
+ generic functions in the SAX package. Note that no default
+ handler class is necessary, because all generic functions have default
+ methods which do nothing. SAX functions are:
+ <div class="def">Function SAX:START-DOCUMENT (handler)</div>
+ <div class="def">Function SAX:END-DOCUMENT (handler)</div>
+ <br>
+ <div class="def">Function SAX:START-ELEMENT (handler namespace-uri local-name qname attributes)</div>
+ <div class="def">Function SAX:END-ELEMENT (handler namespace-uri local-name qname)</div>
+ <div class="def">Function SAX:START-PREFIX-MAPPING (handler prefix uri)</div>
+ <div class="def">Function SAX:END-PREFIX-MAPPING (handler prefix)</div>
+ <div class="def">Function SAX:PROCESSING-INSTRUCTION (handler target data)</div>
+ <div class="def">Function SAX:COMMENT (handler data)</div>
+ <div class="def">Function SAX:START-CDATA (handler)</div>
+ <div class="def">Function SAX:END-CDATA (handler)</div>
+ <div class="def">Function SAX:CHARACTERS (handler data)</div>
+ <br>
+ <div class="def">Function SAX:START-DTD (handler name public-id system-id)</div>
+ <div class="def">Function SAX:END-DTD (handler)</div>
+ <div class="def">Function SAX:START-INTERNAL-SUBSET (handler)</div>
+ <div class="def">Function SAX:END-INTERNAL-SUBSET (handler)</div>
+ <div class="def">Function SAX:UNPARSED-ENTITY-DECLARATION (handler name public-id system-id notation-name)</div>
+ <div class="def">Function SAX:EXTERNAL-ENTITY-DECLARATION (handler kind name public-id system-id)</div>
+ <div class="def">Function SAX:INTERNAL-ENTITY-DECLARATION (handler kind name value)</div>
+ <div class="def">Function SAX:NOTATION-DECLARATION (handler name public-id system-id)</div>
+ <div class="def">Function SAX:ELEMENT-DECLARATION (handler name model)</div>
+ <div class="def">Function SAX:ATTRIBUTE-DECLARATION (handler ename aname type default)</div>
+ <br>
+ <div class="def">Accessor SAX:ATTRIBUTE-PREFIX (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-NAMESPACE-URI (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-LOCAL-NAME (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-QNAME (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-SPECIFIED-P (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-VALUE (attribute)</div>
+ <br>
+ <div class="def">Function SAX:FIND-ATTRIBUTE (qname attributes)</div>
+ <div class="def">Function SAX:FIND-ATTRIBUTE-NS (uri lname attributes)</div>
+ </p>
+ <p>
+ The entity declaration methods are similar to Java SAX
+ definitions, but parameter entities are distinguished from
+ general entities not by a <tt>%</tt> prefix to the name, but by
+ the <tt>kind</tt> argument, either <tt>:parameter</tt> or
+ <tt>:general</tt>.
+ </p>
+ <p>
+ The arguments to <tt>sax:element-declaration</tt> and
+ <tt>sax:attribute-declaration</tt> differ significantly from their
+ Java counterparts.
+ </p>
+ <p>
+ <i>fixme</i>: For more information on these functions refer to the docstrings.
+ </p>
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/sax.xml
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/sax.xml 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/sax.xml 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,724 @@
+<documentation title="CXML SAX parser">
+ <h1>SAX parsing and serialization</h1>
+
+ <a name="parser"/>
+
+ <p>
+ This chapter describes CXML's SAX-like parser interface.
+ </p>
+ <p>
+ The SAX layer is an important concept in CXML that users will
+ encounter in various situations:
+ </p>
+ <ul>
+ <li>
+ To <b>parse into DOM</b>, use the SAX parser as described below with
+ a <b>DOM builder</b> as the SAX handler. (Refer to <a
+ href="dom.html#parser">make-dom-builder</a> for information about
+ DOM.)
+ </li>
+ <li>
+ <b>Serialization</b> is done using SAX, too. SAX handlers that
+ process and consume events without sending them to another
+ handler are called <i>sinks</i> in CXML. Serialization sinks
+ write XML output for the events they receive. For example, to
+ serialize DOM, use <tt>map-document</tt> to turn the DOM
+ document into SAX events together with a <tt>sink</tt> for
+ serialization.
+ </li>
+ <li>
+ SAX handlers can be chained together. Various SAX handlers
+ are offered that can be used in this way, transforming SAX
+ events before handing them to the next handler. This includes
+ handlers for <b>whitespace removal</b>, <b>namespace
+ normalization</b>, and rod-to-string <b>recoding</b>.
+ </li>
+ </ul>
+ <p>
+ However, SAX events are easier to generate than to process. That
+ is why CXML offers <i>Klacks</i>, a "pull-based" API in addition to SAX.
+ Klacks events are generally easier to process than to generate.
+ Please refer to the <a href="klacks.html">Klacks documentation</a>
+ for details.
+ </p>
+
+ <h3>Parsing and Validating</h3>
+ <div style="border: 1px dotted black;
+ width: 70%;
+ padding: 1em">
+ <p>
+ Old-style convenience functions:
+ </p>
+ <div style="font-weight: bold">Function CXML:PARSE-FILE (pathname handler &key ...)</div>
+ <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a pathname argument.
+ (But note that <tt>cxml:parse-file</tt> interprets string
+ arguments as namestrings, while <tt>cxml:parse</tt> expects
+ literal XML documents.)
+ </p>
+ <div style="font-weight: bold">Function CXML:PARSE-STREAM (stream handler &key ...)</div>
+ <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a stream argument.</p>
+ <div style="font-weight: bold">Function CXML:PARSE-OCTETS (octets handler &key ...)</div>
+ <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with an octet vector argument.</p>
+ <div style="font-weight: bold">Function CXML:PARSE-ROD (rod handler &key ...)</div>
+ <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a string argument.</p>
+ </div>
+
+ <h4>
+ New all-in-one parser interface:
+ </h4>
+ <div class="def">Function CXML:PARSE (input handler &key ...)</div>
+ <p>
+ Parse an XML document, where input is a string, pathname, octet
+ vector, or stream.
+ Return values from this function depend on the SAX handler used.<br/>
+ Arguments:
+ </p>
+ <ul>
+ <li>
+ <tt>input</tt> -- one of:<br/>
+ <ul>
+ <li>
+ <tt>pathname</tt> -- a Common Lisp pathname.
+ Open the file specified by the pathname and create a source for
+ the resulting stream. See below for information on how to
+ close the stream.
+ </li>
+ <li><tt>stream</tt> -- a Common Lisp stream with element-type
+ <tt>(unsigned-byte 8)</tt>. See below for information on how to
+ close the stream.
+ </li>
+ <li>
+ <tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array.
+ The array is parsed directly, and interpreted according to the
+ encoding it specifies.
+ </li>
+ <li>
+ <tt>string</tt>/<tt>rod</tt> -- a rod (or <tt>string</tt> on
+ unicode-capable implementations).
+ Parses an XML document from the input string that has already
+ undergone external-format decoding.
+ </li>
+ </ul>
+ </li>
+ <li><tt>stream</tt> -- a Common Lisp stream with element-type
+ <tt>(unsigned-byte 8)</tt></li>
+ <li><tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array</li>
+ <li><tt>handler</tt> -- a SAX handler</li>
+ </ul>
+ <p>
+ Common keyword arguments:
+ </p>
+ <ul>
+ <li>
+ <tt>validate</tt> -- A boolean.  Defaults to
+ <tt>nil</tt>. If true, parse in validating mode, i.e. assert that
+ the document contains a DOCTYPE declaration and conforms to the
+ DTD declared.
+ </li>
+ <li>
+ <tt>dtd</tt> -- unless <tt>nil</tt>, an extid instance
+ specifying the external subset to load. This options overrides
+ the extid specified in the document type declaration, if any.
+ See below for <tt>make-extid</tt>. This option is useful
+ for verification purposes together with the <tt>root</tt>
+ and <tt>disallow-internal-subset</tt> arguments.
+ </li>
+ <li><tt>root</tt> -- the expected root element
+ name, or <tt>nil</tt> (the default).
+ </li>
+ <li>
+ <tt>entity-resolver</tt> -- <tt>nil</tt> or a function of two
+ arguments which is invoked for every entity referenced by the
+ document with the entity's Public ID (a rod) and System ID (an
+ URI object) as arguments. The function may either return
+ nil, CXML will then try to resolve the entity as usual.
+ Alternatively it may return a Common Lisp stream specialized on
+ <tt>(unsigned-byte 8)</tt> which will be used instead. (It may
+ also signal an error, of course, which can be useful to prohibit
+ parsed XML documents from including arbitrary files readable by
+ the parser.)
+ </li>
+ <li>
+ <tt>disallow-internal-subset</tt> -- a boolean. If true, signal
+ an error if the document contains an internal subset.
+ </li>
+ <li>
+ <tt>recode</tt> -- a boolean. (Ignored on Lisps with Unicode
+ support.) Recode rods to UTF-8 strings. Defaults to true.
+ Make sure to use <tt>utf8-dom:make-dom-builder</tt> if this
+ option is enabled and <tt>rune-dom:make-dom-builder</tt>
+ otherwise.
+ </li>
+ </ul>
+ <p>
+ Note: <tt>parse-rod</tt> assumes that the input has already been
+ decoded into Unicode runes and ignores the encoding
+ specified in the XML declaration, if any.
+ </p>
+
+ <p>
+ <div class="def">Function CXML:PARSE-EMPTY-DOCUMENT (uri qname handler &key public-id system-id entity-resolver recode)</div>
+ </p>
+ <p>
+ Simulate parsing a document with a document element <tt>qname</tt>
+ having no attributes except for an optional namespace
+ declaration to <tt>uri</tt>. If an external ID is specified
+ (<tt>system-id</tt>, <tt>public-id</tt>), find, parse, and report
+ this DTD as if with <tt>parse-file</tt>, using the specified
+ entity resolver.
+ </p>
+
+ <p>
+ <div class="def">Function CXML:PARSE-DTD-FILE (pathname)</div>
+ <div class="def">Function CXML:PARSE-DTD-STREAM (stream)</div>
+ Parse <a
+ href="http://www.w3.org/TR/2000/REC-xml-20001006#NT-extSubset">declarations</a>
+ from a stand-alone file and return an object representing the DTD,
+ suitable as an argument to <tt>validate</tt>.
+ </p>
+ <ul>
+ <li><tt>pathname</tt> -- a Common Lisp pathname</li>
+ <li><tt>stream</tt> -- a Common Lisp stream with element-type
+ <tt>(unsigned-byte 8)</tt></li>
+ </ul>
+
+ <p>
+ <div class="def">Function CXML:MAKE-EXTID (publicid systemid)</div>
+ Create an object representing the External ID composed
+ of the specified Public ID, a rod or <tt>nil</tt>, and System ID
+ (an URI object).
+ </p>
+
+ <p>
+ <div class="def">Condition class CXML:XML-PARSE-ERROR ()</div>
+ Superclass of all conditions signalled by the CXML parser.
+ </p>
+ <p>
+ <div class="def">Condition class CXML:WELL-FORMEDNESS-VIOLATION (cxml:xml-parse-error)</div>
+ This condition is signalled for all well-formedness violations.
+ (Note that, when parsing document that is not well-formed in validating
+ mode, the parser might encounter validity errors before detecting
+ well-formedness problems, so also be prepared for <tt>validity-error</tt>
+ in that situation.)
+ </p>
+ <p>
+ <div class="def">Condition class CXML:VALIDITY-ERROR (cxml:xml-parse-error)</div>
+ Reports the violation of a validity constraint.
+ </p>
+
+ <a name="serialization"/>
+ <h3>Serialization</h3>
+ <p>
+ Serialization is performed using <tt>sink</tt> objects. There are
+ different kinds of sinks for output to lisp streams and vectors in
+ various flavours.
+ </p>
+ <p>
+ Technically, sinks are SAX handlers that write XML output for SAX
+ events sent to them. In practise, user code would normally not
+ generate those SAX events manually, and instead use a function
+ like <a href="dom.html#serialization">dom:map-document</a> or <a
+ href="xmls-compat.html">xmls-compat:map-node</a> to serialize an
+ in-memory document.
+ </p>
+ <p>
+ In addition to <tt>map-document</tt>, cxml has a set of
+ convenience macros for serialization (see below for
+ <tt>with-xml-output</tt>, <tt>with-element</tt>, etc).
+ </p>
+
+ <div style="background-color: #ddddff">
+ Portable sinks:<br/>
+ <span class="def">Function CXML:MAKE-OCTET-VECTOR-SINK (&rest keys) => sink</span><br/>
+ <span class="def">Function CXML:MAKE-OCTET-STREAM-SINK (stream &rest keys) => sink</span><br/>
+ <span class="def">Function CXML:MAKE-ROD-SINK (&rest keys) => sink</span><br/>
+ <br/>
+ Only on Lisps with Unicode support:<br/>
+ <span class="def">Function CXML:MAKE-STRING-SINK</span> -- alias for <tt>cxml:make-rod-sink</tt><br/>
+ <span class="def">Function CXML:MAKE-CHARACTER-STREAM-SINK (stream &rest keys) => sink</span><br/>
+ <br/>
+ Only on Lisps <em>without</em> Unicode support:<br/>
+ <span class="def">Function CXML:MAKE-STRING-SINK/UTF8 (&rest keys) => sink</span><br/>
+ <span class="def">Function CXML:MAKE-CHARACTER-STREAM-SINK/UTF8 (stream &rest keys) => sink</span><br/>
+ </div>
+ <p>
+ Return a SAX serialization handle.
+ </p>
+ <ul>
+ <li>
+ The <tt>-octet-</tt> functions write the document encoded into
+ UTF-8.
+ <tt>make-octet-stream-sink</tt> works with Lisp streams of
+ element-type <tt>(unsigned-byte 8)</tt>.
+ <tt>make-octet-vector-sink</tt> returns a vector of
+ <tt>(unsigned-byte 8)</tt>.
+ </li>
+ <li>
+ <tt>make-character-stream-sink</tt> works with character
+ streams. It serializes the document into characters <em>without
+ encoding it into an external format</em>. When using these
+ functions, <em>take care to avoid encoding the result into
+ an incorrect external format</em>. (Note that characters undergo
+ external format conversion when written to a character stream.
+ If the document's XML declaration specifies an encoding, make
+ sure to specify this encoding as the external format if and when
+ writing the serialized document to a character stream. If the
+ document does not specify an encoding, either UTF-8 or UTF-16
+ must be used.) This function is available only on Lisps with
+ unicode support.
+ </li>
+ <li>
+ <tt>make-rod-sink</tt> serializes the document into a vector of
+ runes <em>without encoding it into an external format</em>.
+ (On Lisp with unicode support, the result will be a string;
+ otherwise, a vector of character codes will be returned.)
+ The warnings given for <tt>make-character-stream-sink</tt>
+ apply to this function as well.
+ </li>
+ <li>
+ The <tt>/utf8</tt> functions write the document encoded into
+ characters representing a UTF-8 encoding.
+ When using these functions, <em>take care to avoid encoding the
+ result</em> into an external format for a second time. (Note
+ that characters undergo external format conversion when written
+ to a character stream. Since these functions already perform
+ external format conversion, make sure to specify an external
+ format that does "nothing" if and when writing the serialized document
+ to a character stream. ISO-8859-1 external formats usually
+ achieve the desired effect.)
+ <tt>make-character-stream-sink/utf8</tt> works with character streams.
+ <tt>make-string-sink/utf8</tt> returns a string.
+ These functions are available only on Lisps without unicode support.
+ </li>
+ </ul>
+ <p>Keyword arguments:</p>
+ <ul>
+ <li>
+ <tt>canonical</tt> -- canonical form, one of NIL, T, 1, 2
+ </li>
+ <li>
+ <tt>indentation</tt> -- indentation level. An integer or <tt>nil</tt>.
+ </li>
+ </ul>
+ <p>
+ The following <tt>canonical</tt> values are allowed:
+ </p>
+ <ul>
+ <li>
+ <tt>t</tt> or <tt>1</tt>: <a
+ href="http://www.w3.org/TR/2001/REC-xml-c14n-20010315">Canonical
+ XML</a>
+ </li>
+ <li>
+ <tt>2</tt>: <a
+ href="http://dev.w3.org/cvsweb/~checkout~/2001/XML-Test-Suite/xmlconf/sun/cxml.ht…">Second
+ Canonical Form</a>
+ </li>
+ <li>
+ <tt>NIL</tt>: Use a more readable non-canonical representation.
+ </li>
+ </ul>
+ <p>
+ An internal subset will be included in the result regardless of
+ the <tt>canonical</tt> setting. It is the responsibility of the
+ caller to not report an internal subset for
+ canonical <= 1, or only notations as required for
+ canonical = 2. For example, the
+ <tt>include-doctype</tt> argument to <tt>dom:map-document</tt>
+ should be set to <tt>nil</tt> for the former behaviour and
+ <tt>:canonical-notations</tt> for the latter.
+ </p>
+ <p>
+ With an <tt>indentation</tt> level, pretty-print the XML by
+ inserting additional whitespace.  Note that indentation
+ changes the document model and should only be used if whitespace
+ does not matter to the application.
+ </p>
+
+ <p>
+ <div class="def">Macro CXML:WITH-XML-OUTPUT (sink &body body) => sink-specific result</div>
+ <div class="def">Macro CXML:WITH-NAMESPACE ((prefix uri) &body body) => result</div>
+ <div class="def">Macro CXML:WITH-ELEMENT (qname &body body) => result</div>
+ <div class="def">Macro CXML:WITH-ELEMENT* ((prefix lname) &body body) => result</div>
+ <div class="def">Function CXML:ATTRIBUTE (qname value) => value</div>
+ <div class="def">Generic Function CXML:UNPARSE-ATTRIBUTE (value) => string</div>
+ <div class="def">Function CXML:ATTRIBUTE* (prefix lname value) => value</div>
+ <div class="def">Function CXML:TEXT (data) => data</div>
+ <div class="def">Function CXML:CDATA (data) => data</div>
+ <div class="def">Function CXML:doctype (name public-id system-id &optional internal-subset)</div>
+ Convenience syntax for event-based serialization.
+ </p>
+ <p>
+ Example:
+ </p>
+ <pre>(with-xml-output (make-octet-stream-sink stream :indentation 2 :canonical nil)
+ (with-element "foo"
+ (attribute "xyz" "abc")
+ (with-element "bar"
+ (attribute "blub" "bla"))
+ (text "Hi there.")))</pre>
+ <p>
+ Prints this to <tt>stream</tt>:
+ </p>
+ <pre><foo xyz="abc">
+ <bar blub="bla"></bar>
+ Hi there.
+</foo></pre>
+
+ <p>
+ <div class="def">Macro XHTML-GENERATOR:WITH-XHTML (sink &rest forms)</div>
+ <div class="def">Macro XHTML-GENERATOR:WRITE-DOCTYPE (sink)</div>
+ Macro <tt>with-xhtml</tt> is a modified version of
+ Franz' <tt>htmlgen</tt> works as a SAX driver for XHTML.
+ It aims to be a plug-in replacement for the <tt>html</tt> macro.
+ </p>
+ <p>
+ <tt>xhtmlgen</tt> is included as <tt>contrib/xhtmlgen.lisp</tt> in
+ the cxml distribution. Example:
+ </p>
+ <pre>(let ((sink (cxml:make-character-stream-sink *standard-output*)))
+ (sax:start-document sink)
+ (xhtml-generator:write-doctype sink)
+ (xhtml-generator:with-html sink
+ (:html
+ (:head
+ (:title "Titel"))
+ (:body
+ ((:p "style" "font-weight: bold")
+ "Inhalt")
+ (:ul
+ (:li "Eins")
+ (:li "Zwei")
+ (:li "Drei")))))
+ (sax:end-document sink))</pre>
+
+ <a name="misc"/>
+ <h3>Miscellaneous SAX handlers</h3>
+ <p>
+ <div class="def">Function CXML:MAKE-VALIDATOR (dtd root)</div>
+ Create a SAX handler which validates against a DTD instance. 
+ The document's root element must be named <tt>root</tt>. 
+ Used with <tt>dom:map-document</tt>, this validates a document
+ object as if by re-reading it with a validating parser, except
+ that declarations recorded in the document instance are completely
+ ignored.<br/>
+ Example:
+ </p>
+ <pre>(let ((d (parse-file "~/test.xml" (cxml-dom:make-dom-builder)))
+ (x (parse-dtd-file "~/test.dtd")))
+ (dom:map-document (cxml:make-validator x #"foo") d))</pre>
+
+ <p>
+ <div class="def">Class CXML:BROADCAST-HANDLER ()</div>
+ <div class="def">Accessor CXML:BROADCAST-HANDLER-HANDLERS</div>
+ <div class="def">Function CXML:MAKE-BROADCAST-HANDLER (&rest handlers)</div>
+ <tt>broadcast-handler</tt> is a SAX handler which passes every event it
+ receives on to each of several chained handlers, somewhat similar
+ to the way a <tt>broadcast-stream</tt> works.
+ </p>
+ <p>
+ You can subclass <tt>broadcast-stream</tt> to modify the events
+ before they are being passed on. Define methods on your handler
+ class for the events to be modified. All other events will pass
+ through to the chained handlers unmodified.
+ </p>
+ <p>
+ Broadcast handler functions return the result of calling the event
+ function on the <i>last</i> handler in the list. In particular,
+ the overall result from <tt>sax:end-document</tt> will be ignored
+ for all other handlers.
+ </p>
+
+ <p>
+ <div class="def">Class CXML:SAX-PROXY (broadcast-handler)</div>
+ <div class="def">Accessor CXML:PROXY-CHAINED-HANDLER</div>
+ <tt>sax-proxy</tt> is a subclass of <tt>broadcast-handler</tt>
+ which sends events to exactly one chained handler. This class is
+ still included for compatibility with older versions of
+ CXML which did not include the more
+ general <tt>broadcast-handler</tt> yet, but has been retrofitted
+ as a subclass of the latter.
+ </p>
+
+ <p>
+ <div class="def">Accessor CXML:MAKE-NAMESPACE-NORMALIZER (next-handler)</div>
+ </p>
+ <p>
+ Return a SAX handler that performs <a
+ href="http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/namespaces-algorith…">DOM
+ 3-style namespace normalization</a> on attribute lists in
+ <tt>start-element</tt> events before passing them on the next
+ handler.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-WHITESPACE-NORMALIZER (chained-handler &optional dtd)</div>
+ Return a SAX handler which removes whitespace from elements that
+ have <em>element content</em> and have not been declared to
+ preserve space using an xml:space attribute.
+ </p>
+ <p>Example:</p>
+ <pre>(cxml:parse-file "example.xml"
+ (cxml:make-whitespace-normalizer (cxml-dom:make-dom-builder))
+ :validate t)</pre>
+ <p>Example input:</p>
+ <pre><!DOCTYPE test [
+<!ELEMENT test (foo,bar*)>
+<!ATTLIST test a CDATA #IMPLIED>
+<!ELEMENT foo #PCDATA>
+<!ELEMENT bar (foo?)>
+<!ATTLIST bar xml:space (default|preserve) "default">
+]>
+<test a='b'>
+ <foo> </foo>
+ <bar> </bar>
+ <bar xml:space="preserve"> </bar>
+</test>
+</pre>
+ <p>Example result:</p>
+ <pre><test a="b"><foo> </foo><bar></bar><bar xml:space="preserve"> </bar></test></pre>
+
+ <a name="rods"/>
+ <h3>Recoders</h3>
+ <p>
+ Recoders are a mechanism used by CXML internally on Lisp implementations
+ without Unicode support to recode UTF-16 vectors (rods) of
+ integers (runes) into UTF-8 strings.
+ </p>
+ <p>
+ User code does not usually need to deal with recoders in current
+ versions of CXML.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-RECODER (chained-handler recoder-fn)</div>
+ Return a SAX handler which passes all events on to
+ <tt>chained-handler</tt> after converting all strings and rods
+ using <tt>recoder-fn</tt>, a function of one argument.
+ </p>
+
+ <a name="dtdcache"/>
+ <h3>Caching of DTD Objects</h3>
+ <p>
+ To avoid spending time parsing the same DTD over and over again,
+ CXML can cache DTD objects. The parser consults
+ <tt>cxml:*dtd-cache*</tt> whenever it is looking for an external
+ subset in a document which does not have an internal subset and
+ uses the cached DTD instance if one is present in the cache for
+ the System ID in question.
+ </p>
+ <p>
+ Note that DTDs do not expire from the cache automatically.
+ (Future versions of CXML might introduce automatic checks for
+ outdated DTDs.)
+ </p>
+ <p>
+ <div class="def">Variable CXML:*DTD-CACHE*</div>
+ The DTD cache object consulted by the parser when it needs a DTD.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-DTD-CACHE ()</div>
+ Return a new, empty DTD cache object.
+ </p>
+ <p>
+ <div class="def">Variable CXML:*CACHE-ALL-DTDS*</div>
+ If true, instructs the parser to enter all DTDs that could have
+ been cached into <tt>*dtd-cache*</tt> if they were not cached
+ already. Defaults to <tt>nil</tt>.
+ </p>
+ <p>
+ <div class="def">Reader CXML:GETDTD (uri dtd-cache)</div>
+ Return a cached instance of the DTD at <tt>uri</tt>, if present in
+ the cache, or <tt>nil</tt>.
+ </p>
+ <p>
+ <div class="def">Writer CXML:GETDTD (uri dtd-cache)</div>
+ Enter a new value for <tt>uri</tt> into <tt>dtd-cache</tt>.
+ </p>
+ <p>
+ <div class="def">Function CXML:REMDTD (uri dtd-cache)</div>
+ Ensure that no DTD is recorded for <tt>uri</tt> in the cache and
+ return true if such a DTD was present.
+ </p>
+ <p>
+ <div class="def">Function CXML:CLEAR-DTD-CACHE (dtd-cache)</div>
+ Remove all entries from <tt>dtd-cache</tt>.
+ </p>
+ <p>
+ <em>fixme:</em> thread-safety
+ </p>
+
+ <a name="saxparser"/>
+ <h3>Location information</h3>
+ <p>
+ <div class="def">Class SAX:SAX-PARSER ()</div>
+ A class providing location information through an
+ implementation-specific subclass. Parsers will use
+ <tt>sax:register-sax-parser</tt> to pass their parser instance to
+ the handler. The easiest way to receive sax parsers instances is
+ to inherit from sax-parser-mixin when defining a sax handler.
+ </p>
+ <p>
+ <div class="def">Class SAX:SAX-PARSER-MIXIN ()</div>
+ A mixin for sax handler classes that records the sax handler
+ object for use with the following functions. Trampoline methods
+ are provided that allow those functions to be called directly on
+ the sax-parser-mixin.
+ </p>
+ <p>
+ <div class="def">Function SAX:SAX-HANDLER (sax-handler-mixin) => sax-handler</div>
+ Return the sax-parser instance recorded by this handler, or NIL.
+ </p>
+ <p>
+ <div class="def">Function SAX:LINE-NUMBER (sax-parser)</div>
+ Return an approximation of the current line number, or NIL.
+ </p>
+ <p>
+ <div class="def">Function SAX:COLUMN-NUMBER (sax-parser)</div>
+ Return an approximation of the current column number, or NIL.
+ </p>
+ <p>
+ <div class="def">Function SAX:SYSTEM-ID (sax-parser)</div>
+ Return the URI of the document being parsed. This is either the
+ main document, or the entity's system ID while contents of a parsed
+ general external entity are being processed.
+ </p>
+ <p>
+ <div class="def">Function SAX:XML-BASE (sax-parser)</div>
+ Return the [Base URI] of the current element. This URI can differ from
+ the value returned by <tt>sax:system-id</tt> if xml:base
+ attributes are present.
+ </p>
+
+ <a name="catalogs"/>
+ <h3>XML Catalogs</h3>
+ <p>
+ External entities (for example, DTDs) are referred to using their
+ Public and System IDs. Usually the System ID, a URI, is used to
+ locate the entity. CXML itself handles only file://-URIs, but
+ many System IDs in practical use are http://-URIs. There are two
+ different mechanims applications can use to allow CXML to locate
+ entities using arbitrary Public ID or System ID:
+ </p>
+ <ul>
+ <li>
+ User-defined entity resolvers can be used to open entities using
+ arbitrary protocols. For example, an entity resolver could
+ handle all System-IDs with the <tt>http</tt> scheme using some
+ HTTP library. Refer to the description of the
+ <tt>entity-resolver</tt> keyword argument to parser functions (see <a
+ href="#parser"><tt>cxml:parse-file</tt></a>) to more
+ information on entity resolvers.
+ </li>
+ <li>
+ XML Catalogs are (local) tables in XML syntax which map External
+ IDs to alternative System IDs. If, say, the xhtml DTD is
+ present in the local file system and the local copy has been
+ registered with the XML catalog, CXML will use the local copy of
+ the DTD instead of trying to open the version available using HTTP.
+ </li>
+ </ul>
+ <p>
+ This section describes XML Catalogs, the second solution. CXML
+ implements <a
+ href="http://www.oasis-open.org/committees/entity/spec.html">Oasis
+ XML Catalogs</a>.
+ </p>
+ <p>
+ <div class="def">Variable CXML:*CATALOG*</div>
+ The XML Catalog object consulted by the parser before trying to
+ open an entity. Initially <tt>nil</tt>.
+ </p>
+ <p>
+ <div class="def">Variable CXML:*PREFER*</div>
+ The default "prefer" mode from the Catalog specification, one
+ of <tt>:public</tt> or <tt>:system</tt>. Defaults
+ to <tt>:public</tt>.
+ </p>
+ <p>
+ <div class="def">Function CXML:MAKE-CATALOG (&optional uris)</div>
+ Return a catalog object for the catalog files specified.
+ </p>
+ <p>
+ <div class="def">Function CXML:RESOLVE-URI (uri catalog)</div>
+ Look up <tt>uri</tt> in <tt>catalog</tt> and return the
+ resulting URI, or <tt>nil</tt> if no match was found.
+ </p>
+ <p>
+ <div class="def">Function CXML:RESOLVE-EXTID (publicid systemid catalog)</div>
+ Look up the External ID (<tt>publicid</tt>, <tt>systemid</tt>)
+ in <tt>catalog</tt> and return the resulting URI, or <tt>nil</tt>
+ if no match was found.
+ </p>
+ <p>
+ Example:
+ </p>
+ <pre>* (setf cxml:*catalog* nil)
+* (cxml:parse-file "test.xhtml" nil)
+=> Error: URI scheme :HTTP not supported
+
+* (setf cxml:*catalog* (cxml:make-catalog))
+* (cxml:parse-file "test.xhtml" nil)
+;; no error!
+NIL</pre>
+ <p>
+ Note that parsed catalog files are cached in the catalog object.
+ Catalog files cached do not expire automatically. To ensure that
+ all catalog files are parsed again, create a new catalog object.
+ </p>
+
+ <a name="sax"/>
+ <h2>SAX Interface</h2>
+ <p>
+ A SAX handler is an arbitrary objects that implements some of the
+ generic functions in the SAX package.  Note that no default
+ handler class is necessary, because all generic functions have default
+ methods which do nothing.  SAX functions are:
+ <div class="def">Function SAX:START-DOCUMENT (handler)</div>
+ <div class="def">Function SAX:END-DOCUMENT (handler)</div>
+ <br/>
+ <div class="def">Function SAX:START-ELEMENT (handler namespace-uri local-name qname attributes)</div>
+ <div class="def">Function SAX:END-ELEMENT (handler namespace-uri local-name qname)</div>
+ <div class="def">Function SAX:START-PREFIX-MAPPING (handler prefix uri)</div>
+ <div class="def">Function SAX:END-PREFIX-MAPPING (handler prefix)</div>
+ <div class="def">Function SAX:PROCESSING-INSTRUCTION (handler target data)</div>
+ <div class="def">Function SAX:COMMENT (handler data)</div>
+ <div class="def">Function SAX:START-CDATA (handler)</div>
+ <div class="def">Function SAX:END-CDATA (handler)</div>
+ <div class="def">Function SAX:CHARACTERS (handler data)</div>
+ <br/>
+ <div class="def">Function SAX:START-DTD (handler name public-id system-id)</div>
+ <div class="def">Function SAX:END-DTD (handler)</div>
+ <div class="def">Function SAX:START-INTERNAL-SUBSET (handler)</div>
+ <div class="def">Function SAX:END-INTERNAL-SUBSET (handler)</div>
+ <div class="def">Function SAX:UNPARSED-ENTITY-DECLARATION (handler name public-id system-id notation-name)</div>
+ <div class="def">Function SAX:EXTERNAL-ENTITY-DECLARATION (handler kind name public-id system-id)</div>
+ <div class="def">Function SAX:INTERNAL-ENTITY-DECLARATION (handler kind name value)</div>
+ <div class="def">Function SAX:NOTATION-DECLARATION (handler name public-id system-id)</div>
+ <div class="def">Function SAX:ELEMENT-DECLARATION (handler name model)</div>
+ <div class="def">Function SAX:ATTRIBUTE-DECLARATION (handler ename aname type default)</div>
+ <br/>
+ <div class="def">Accessor SAX:ATTRIBUTE-PREFIX (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-NAMESPACE-URI (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-LOCAL-NAME (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-QNAME (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-SPECIFIED-P (attribute)</div>
+ <div class="def">Accessor SAX:ATTRIBUTE-VALUE (attribute)</div>
+ <br/>
+ <div class="def">Function SAX:FIND-ATTRIBUTE (qname attributes)</div>
+ <div class="def">Function SAX:FIND-ATTRIBUTE-NS (uri lname attributes)</div>
+ </p>
+ <p>
+ The entity declaration methods are similar to Java SAX
+ definitions, but parameter entities are distinguished from
+ general entities not by a <tt>%</tt> prefix to the name, but by
+ the <tt>kind</tt> argument, either <tt>:parameter</tt> or
+ <tt>:general</tt>.
+ </p>
+ <p>
+ The arguments to <tt>sax:element-declaration</tt> and
+ <tt>sax:attribute-declaration</tt> differ significantly from their
+ Java counterparts.
+ </p>
+ <p>
+ <i>fixme</i>: For more information on these functions refer to the docstrings.
+ </p>
+</documentation>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/xmls-compat.html
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/xmls-compat.html 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/xmls-compat.html 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,140 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<title>CXML XMLS Compatibility</title>
+<link rel="stylesheet" type="text/css" href="cxml.css">
+</head>
+<body>
+<div class="sidebar">
+<div class="sidebar-title"><a href="index.html">Closure XML</a></div>
+<div class="sidebar-main"><ul class="main">
+<li>
+<a href="installation.html">Installing Closure XML</a><ul class="sub">
+<li><a href="installation.html#download"><b>Download</b></a></li>
+<li><a href="installation.html#implementations">Implementation-specific notes</a></li>
+<li><a href="installation.html#compilation">Compilation</a></li>
+<li><a href="installation.html#tests">Tests</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li>
+<li>
+<a href="sax.html">SAX parsing and serialization</a><ul class="sub">
+<li><a href="sax.html#parser">Parsing and Validating</a></li>
+<li><a href="sax.html#serialization">Serialization</a></li>
+<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li>
+<li><a href="sax.html#rods">Recoders</a></li>
+<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li>
+<li><a href="sax.html#catalogs">XML Catalogs</a></li>
+<li><a href="sax.html#sax">SAX Interface</a></li>
+</ul>
+</li>
+<li>
+<a href="klacks.html">Klacks parser</a><ul class="sub">
+<li><a href="klacks.html#sources">Parsing incrementally</a></li>
+<li><a href="klacks.html#convenience">Convenience functions</a></li>
+<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li>
+<li><a href="klacks.html#locator">Location information</a></li>
+<li><a href="klacks.html#klacksax">Examples</a></li>
+</ul>
+</li>
+<li>
+<a href="dom.html">DOM implementation</a><ul class="sub">
+<li><a href="dom.html#parser">Parsing with the DOM builder</a></li>
+<li><a href="dom.html#serialization">Serialization</a></li>
+<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li>
+</ul>
+</li>
+<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li>
+</ul></div>
+</div>
+ <h1>XMLS Builder</h1>
+ <p>
+ Like other XML parsers written in Lisp, CXML can work with
+ documents represented as list structures. The specific model
+ implemented by cxml is compatible with the <a href="http://common-lisp.net/project/xmls/">xmls parser</a>. Xmls
+ list structures are a simpler and faster alternative to full DOM
+ document trees. They also serve as an example showing how to
+ implement user-defined document models as an independent layer
+ over the the base parser (c.f. <tt>xml/xmls-compat.lisp</tt> in
+ the cxml distribution). However, note that the list structures do
+ not include all information available in DOM documents
+ (notably, things like <tt>dom:parent-node</tt>) and are
+ sometimes more difficult to work with because of that since many
+ DOM functions cannot be implemented on them.
+ </p>
+ <p>
+ <b>New namespace handling:</b>
+ XMLS compatibility is not <i>bug-for-bug</i>-compatible with
+ XMLS any more. There is now a mode using pairs of local name
+ and namespace URI, and a second mode using qualified names
+ only. The old behaviour using pairs of prefix and local names
+ was removed.
+ </p>
+ <p>
+ <strike>
+ fixme: It is unclear to me how namespaces are meant to
+ work in xmls, since xmls documentation differs from how xmls
+ actually works in current releases. Usually applications need to
+ know both the namespace prefix <em>and</em> the namespace URI. We
+ currently follow the xmls <em>implementation</em> and use the
+ namespace prefix instead of following its <em>documentation</em> which
+ shows the URI. We do not follow xmls in munging xmlns attribute
+ values. Attributes themselves have namespaces and it is not clear
+ to me how that works in xmls.
+ </strike>
+ </p>
+ <p>
+ <div class="def">Function CXML-XMLS:MAKE-XMLS-BUILDER (&key include-default-values include-namespace-uri)</div>
+ Create a SAX handler which builds XMLS list structures.Â
+ If <tt>include-default-values</tt> is true, default values for
+ attributes declared in a DTD are included as attributes in the
+ xmls output. <tt>include-default-values</tt> is true by default
+ and can be set to <tt>nil</tt> to suppress inclusion of default
+ values.
+ </p>
+ <p>
+ If <tt>include-namespace-uri</tt> is true (the default), node
+ names and attribute names are pairs of local name and namespace
+ URI. (Except for attributes without a namespace, which are named
+ using a string.) Otherwise, nodes and attributes are named by
+ their qualified name.
+ </p>
+ <p>
+ Example:
+ </p>
+ <pre>(cxml:parse-file "test.xml" (cxml-xmls:make-xmls-builder))</pre>
+ <p>
+ <div class="def">Function CXML-XMLS:MAP-NODE (handler node &key include-xmlns-attributes include-namespace-uri)</div>
+ Traverse an XMLS document/node and call SAX functions as if an XML
+ representation of the document were processed by a SAX parser.
+ </p>
+ <p>
+ Use this function to serialize XMLS data. For example, we could
+ define a replacement for <tt>xmls:write-xml</tt> like this:
+ </p>
+ <pre>(defun write-xml (stream node &key indent)
+ (let ((sink (cxml:make-character-stream-sink
+ stream :canonical nil :indentation indent)))
+ (cxml-xmls:map-node sink node)))</pre>
+ <p>
+ <div class="def">Function CXML-XMLS:MAKE-NODE (&key name ns attrs
+ children) => xmls node</div>
+ Build a list node of the form
+ (<em>name</em>Â ((<em>name</em>Â <em>value</em>)<em>*</em>)Â <em>child*</em>).
+ </p>
+ <p>
+ The node list's <tt>car</tt> can also be a cons of local <tt>name</tt>
+ and namespace prefix <tt>ns</tt>.
+ </p>
+ <p>
+ <div class="def">Accessor CXML-XMLS:NODE-NAME (node)</div>
+ <div class="def">Accessor CXML-XMLS:NODE-NS (node)</div>
+ <div class="def">Accessor CXML-XMLS:NODE-ATTRS (node)</div>
+ <div class="def">Accessor CXML-XMLS:NODE-CHILDREN (node)</div>
+ Accessors for xmls node data.
+ </p>
+ <p>
+ </p>
+</body>
+</html>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/xmls-compat.xml
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/xmls-compat.xml 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/doc/xmls-compat.xml 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,91 @@
+<documentation title="CXML XMLS Compatibility">
+ <h1>XMLS Builder</h1>
+ <p>
+ Like other XML parsers written in Lisp, CXML can work with
+ documents represented as list structures. The specific model
+ implemented by cxml is compatible with the <a
+ href="http://common-lisp.net/project/xmls/">xmls parser</a>. Xmls
+ list structures are a simpler and faster alternative to full DOM
+ document trees. They also serve as an example showing how to
+ implement user-defined document models as an independent layer
+ over the the base parser (c.f. <tt>xml/xmls-compat.lisp</tt> in
+ the cxml distribution). However, note that the list structures do
+ not include all information available in DOM documents
+ (notably, things like <tt>dom:parent-node</tt>) and are
+ sometimes more difficult to work with because of that since many
+ DOM functions cannot be implemented on them.
+ </p>
+ <p>
+ <b>New namespace handling:</b>
+ XMLS compatibility is not <i>bug-for-bug</i>-compatible with
+ XMLS any more. There is now a mode using pairs of local name
+ and namespace URI, and a second mode using qualified names
+ only. The old behaviour using pairs of prefix and local names
+ was removed.
+ </p>
+ <p>
+ <strike>
+ fixme: It is unclear to me how namespaces are meant to
+ work in xmls, since xmls documentation differs from how xmls
+ actually works in current releases. Usually applications need to
+ know both the namespace prefix <em>and</em> the namespace URI. We
+ currently follow the xmls <em>implementation</em> and use the
+ namespace prefix instead of following its <em>documentation</em> which
+ shows the URI. We do not follow xmls in munging xmlns attribute
+ values. Attributes themselves have namespaces and it is not clear
+ to me how that works in xmls.
+ </strike>
+ </p>
+ <p>
+ <div class="def">Function CXML-XMLS:MAKE-XMLS-BUILDER (&key include-default-values include-namespace-uri)</div>
+ Create a SAX handler which builds XMLS list structures. 
+ If <tt>include-default-values</tt> is true, default values for
+ attributes declared in a DTD are included as attributes in the
+ xmls output. <tt>include-default-values</tt> is true by default
+ and can be set to <tt>nil</tt> to suppress inclusion of default
+ values.
+ </p>
+ <p>
+ If <tt>include-namespace-uri</tt> is true (the default), node
+ names and attribute names are pairs of local name and namespace
+ URI. (Except for attributes without a namespace, which are named
+ using a string.) Otherwise, nodes and attributes are named by
+ their qualified name.
+ </p>
+ <p>
+ Example:
+ </p>
+ <pre>(cxml:parse-file "test.xml" (cxml-xmls:make-xmls-builder))</pre>
+ <p>
+ <div class="def">Function CXML-XMLS:MAP-NODE (handler node &key include-xmlns-attributes include-namespace-uri)</div>
+ Traverse an XMLS document/node and call SAX functions as if an XML
+ representation of the document were processed by a SAX parser.
+ </p>
+ <p>
+ Use this function to serialize XMLS data. For example, we could
+ define a replacement for <tt>xmls:write-xml</tt> like this:
+ </p>
+ <pre>(defun write-xml (stream node &key indent)
+ (let ((sink (cxml:make-character-stream-sink
+ stream :canonical nil :indentation indent)))
+ (cxml-xmls:map-node sink node)))</pre>
+ <p>
+ <div class="def">Function CXML-XMLS:MAKE-NODE (&key name ns attrs
+ children) => xmls node</div>
+ Build a list node of the form
+ (<em>name</em> ((<em>name</em> <em>value</em>)<em>*</em>) <em>child*</em>).
+ </p>
+ <p>
+ The node list's <tt>car</tt> can also be a cons of local <tt>name</tt>
+ and namespace prefix <tt>ns</tt>.
+ </p>
+ <p>
+ <div class="def">Accessor CXML-XMLS:NODE-NAME (node)</div>
+ <div class="def">Accessor CXML-XMLS:NODE-NS (node)</div>
+ <div class="def">Accessor CXML-XMLS:NODE-ATTRS (node)</div>
+ <div class="def">Accessor CXML-XMLS:NODE-CHILDREN (node)</div>
+ Accessors for xmls node data.
+ </p>
+ <p>
+ </p>
+</documentation>
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/documentation.css
===================================================================
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Entries 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Entries 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,5 @@
+/dom-builder.lisp/1.13/Sun Jul 22 19:59:26 2007//
+/dom-impl.lisp/1.42/Sun Sep 10 14:52:44 2006//
+/dom-sax.lisp/1.7/Sun Aug 20 14:59:34 2006//
+/package.lisp/1.6/Sun Aug 20 12:19:01 2006//
+D
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Repository 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Repository 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+cxml/dom
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Root 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/CVS/Root 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cxml/cvsroot
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-builder.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-builder.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-builder.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,208 @@
+;;;; dom-builder.lisp -- DOM-building SAX handler
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;;; Author: Henrik Motakef <hmot(a)henrik-motakef.de>
+;;;; Author: David Lichteblau <david(a)lichteblau.com>
+;;;; Author: knowledgeTools Int. GmbH
+
+#-cxml-system::utf8dom-file
+(in-package :rune-dom)
+
+#+cxml-system::utf8dom-file
+(in-package :utf8-dom)
+
+
+(defclass dom-builder ()
+ ((document :initform nil :accessor document)
+ (element-stack :initform '() :accessor element-stack)
+ (internal-subset :accessor internal-subset)))
+
+(defun make-dom-builder ()
+ (make-instance 'dom-builder))
+
+(defun fast-push (new-element vector)
+ (vector-push-extend new-element vector (max 1 (array-dimension vector 0))))
+
+(defmethod sax:start-document ((handler dom-builder))
+ (when (and sax:*namespace-processing*
+ (not (and sax:*include-xmlns-attributes*
+ sax:*use-xmlns-namespace*)))
+ (error "SAX configuration is incompatible with DOM: *namespace-processing* is activated, but *include-xmlns-attributes* or *use-xmlns-namespace* are not"))
+ (let ((document (make-instance 'document)))
+ (setf (slot-value document 'owner) nil
+ (slot-value document 'doc-type) nil)
+ (setf (document handler) document)
+ (push document (element-stack handler))))
+
+;; fixme
+(defmethod sax::dtd ((handler dom-builder) dtd)
+ (setf (slot-value (document handler) 'dtd) dtd))
+
+(defmethod sax:end-document ((handler dom-builder))
+ (let ((doctype (dom:doctype (document handler))))
+ (when doctype
+ (setf (slot-value (dom:entities doctype) 'read-only-p) t)
+ (setf (slot-value (dom:notations doctype) 'read-only-p) t)))
+ (document handler))
+
+(defmethod sax:entity-resolver ((handler dom-builder) resolver)
+ (setf (slot-value (document handler) 'entity-resolver) resolver))
+
+(defmethod sax:start-dtd ((handler dom-builder) name publicid systemid)
+ (let* ((document (document handler))
+ (doctype (%create-document-type name publicid systemid)))
+ (setf (slot-value doctype 'owner) document
+ (slot-value (dom:notations doctype) 'owner) document
+ (slot-value (dom:entities doctype) 'owner) document
+ (slot-value document 'doc-type) doctype)))
+
+(defmethod sax:start-internal-subset ((handler dom-builder))
+ (setf (internal-subset handler) nil))
+
+(defmethod sax:end-internal-subset ((handler dom-builder))
+ (setf (dom::%internal-subset (slot-value (document handler) 'doc-type))
+ (nreverse (internal-subset handler)))
+ (slot-makunbound handler 'internal-subset))
+
+(macrolet ((defhandler (name &rest args)
+ `(defmethod ,name ((handler dom-builder) ,@args)
+ (when (slot-boundp handler 'internal-subset)
+ (push (list ',name ,@args) (internal-subset handler))))))
+ (defhandler sax:unparsed-entity-declaration
+ name public-id system-id notation-name)
+ (defhandler sax:external-entity-declaration
+ kind name public-id system-id)
+ (defhandler sax:internal-entity-declaration
+ kind name value)
+ (defhandler sax:notation-declaration
+ name public-id system-id)
+ (defhandler sax:element-declaration
+ name model)
+ (defhandler sax:attribute-declaration
+ element-name attribute-name type default))
+
+(defmethod sax:start-element
+ ((handler dom-builder) namespace-uri local-name qname attributes)
+ (check-type qname rod) ;catch recoder/builder mismatch
+ (with-slots (document element-stack) handler
+ (let* ((nsp sax:*namespace-processing*)
+ (element (make-instance 'element
+ :tag-name qname
+ :owner document
+ :namespace-uri (when nsp namespace-uri)
+ :local-name (when nsp local-name)
+ :prefix (%rod (when nsp (cxml::split-qname (real-rod qname))))))
+ (parent (car element-stack))
+ (anodes '()))
+ (dolist (attr attributes)
+ (let ((anode
+ (if nsp
+ (dom:create-attribute-ns document
+ (sax:attribute-namespace-uri attr)
+ (sax:attribute-qname attr))
+ (dom:create-attribute document (sax:attribute-qname attr))))
+ (text
+ (dom:create-text-node document (sax:attribute-value attr))))
+ (setf (slot-value anode 'specified-p)
+ (sax:attribute-specified-p attr))
+ (setf (slot-value anode 'owner-element) element)
+ (dom:append-child anode text)
+ (push anode anodes)))
+ (setf (slot-value element 'parent) parent)
+ (fast-push element (slot-value parent 'children))
+ (let ((map
+ (make-instance 'attribute-node-map
+ :items anodes
+ :element-type :attribute
+ :element element
+ :owner document)))
+ (setf (slot-value element 'attributes) map)
+ (dolist (anode anodes)
+ (setf (slot-value anode 'map) map)))
+ (push element element-stack))))
+
+(defmethod sax:end-element ((handler dom-builder) namespace-uri local-name qname)
+ (declare (ignore namespace-uri local-name qname))
+ (pop (element-stack handler)))
+
+(defmethod sax:characters ((handler dom-builder) data)
+ (with-slots (document element-stack) handler
+ (let* ((parent (car element-stack))
+ (last-child (dom:last-child parent)))
+ (cond
+ ((eq (dom:node-type parent) :cdata-section)
+ (setf (dom:data parent) data))
+ ((and last-child (eq (dom:node-type last-child) :text))
+ ;; um entities herum wird SAX:CHARACTERS mehrfach aufgerufen fuer
+ ;; den gleichen Textknoten. Hier muessen wir den bestehenden Knoten
+ ;; erweitern, sonst ist das Dokument nicht normalisiert.
+ ;; (XXX Oder sollte man besser den Parser entsprechend aendern?)
+ (dom:append-data last-child data))
+ (t
+ (let ((node (dom:create-text-node document data)))
+ (setf (slot-value node 'parent) parent)
+ (fast-push node (slot-value (car element-stack) 'children))))))))
+
+(defmethod sax:start-cdata ((handler dom-builder))
+ (with-slots (document element-stack) handler
+ (let ((node (dom:create-cdata-section document #""))
+ (parent (car element-stack)))
+ (setf (slot-value node 'parent) parent)
+ (fast-push node (slot-value parent 'children))
+ (push node element-stack))))
+
+(defmethod sax:end-cdata ((handler dom-builder))
+ (let ((node (pop (slot-value handler 'element-stack))))
+ (assert (eq (dom:node-type node) :cdata-section))))
+
+(defmethod sax:processing-instruction ((handler dom-builder) target data)
+ (with-slots (document element-stack) handler
+ (let ((node (dom:create-processing-instruction document target data))
+ (parent (car element-stack)))
+ (setf (slot-value node 'parent) parent)
+ (fast-push node (slot-value (car element-stack) 'children)))))
+
+(defmethod sax:comment ((handler dom-builder) data)
+ (with-slots (document element-stack) handler
+ (let ((node (dom:create-comment document data))
+ (parent (car element-stack)))
+ (setf (slot-value node 'parent) parent)
+ (fast-push node (slot-value (car element-stack) 'children)))))
+
+(defmethod sax:unparsed-entity-declaration
+ ((handler dom-builder) name public-id system-id notation-name)
+ (set-entity handler name public-id system-id notation-name))
+
+(defmethod sax:external-entity-declaration
+ ((handler dom-builder) kind name public-id system-id)
+ (ecase kind
+ (:general (set-entity handler name public-id system-id nil))
+ (:parameter)))
+
+(defmethod sax:internal-entity-declaration
+ ((handler dom-builder) kind name value)
+ (declare (ignore value))
+ (ecase kind
+ (:general (set-entity handler name nil nil nil))
+ (:parameter)))
+
+(defun set-entity (handler name pid sid notation)
+ (dom:set-named-item (dom:entities (dom:doctype (document handler)))
+ (make-instance 'entity
+ :owner (document handler)
+ :name name
+ :public-id pid
+ :system-id sid
+ :notation-name notation)))
+
+(defmethod sax:notation-declaration
+ ((handler dom-builder) name public-id system-id)
+ (dom:set-named-item (dom:notations (dom:doctype (document handler)))
+ (make-instance 'notation
+ :owner (document handler)
+ :name name
+ :public-id public-id
+ :system-id system-id)))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-impl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-impl.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-impl.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,1478 @@
+;;;; dom-impl.lisp -- Implementation of DOM 1 Core -*- package: rune-dom -*-
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;;; Author: David Lichteblau <david(a)lichteblau.com>
+;;;; Author: knowledgeTools Int. GmbH
+
+#-cxml-system::utf8dom-file
+(defpackage :rune-dom
+ (:use :cl :runes)
+ #+rune-is-character (:nicknames :cxml-dom)
+ (:export #:implementation #:make-dom-builder #:create-document))
+
+#+cxml-system::utf8dom-file
+(defpackage :utf8-dom
+ (:use :cl :utf8-runes)
+ (:nicknames :cxml-dom)
+ (:export #:implementation #:make-dom-builder #:create-document))
+
+#-cxml-system::utf8dom-file
+(in-package :rune-dom)
+
+#+cxml-system::utf8dom-file
+(in-package :utf8-dom)
+
+
+;; Classes
+
+(define-condition dom-exception (error)
+ ((key :initarg :key :reader dom-exception-key)
+ (string :initarg :string :reader dom-exception-string)
+ (arguments :initarg :arguments :reader dom-exception-arguments))
+ (:report
+ (lambda (c s)
+ (format s "~A (~D):~%~?"
+ (dom-exception-key c)
+ (dom:code c)
+ (dom-exception-string c)
+ (dom-exception-arguments c)))))
+
+(defclass node (dom:node)
+ ((parent :initarg :parent :initform nil)
+ (children :initarg :children :initform (make-node-list))
+ (owner :initarg :owner :initform nil)
+ (read-only-p :initform nil :reader read-only-p)
+ (map :initform nil)))
+
+(defmethod dom:prefix ((node node)) nil)
+(defmethod dom:local-name ((node node)) nil)
+(defmethod dom:namespace-uri ((node node)) nil)
+
+(defclass namespace-mixin ()
+ ((prefix :initarg :prefix :reader dom:prefix)
+ (local-name :initarg :local-name :reader dom:local-name)
+ (namespace-uri :initarg :namespace-uri :reader dom:namespace-uri)))
+
+(defmethod (setf dom:prefix) (newval (node namespace-mixin))
+ (assert-writeable node)
+ (when newval
+ (safe-split-qname (concatenate 'rod newval #":foo")
+ (dom:namespace-uri node)))
+ (setf (slot-value node 'prefix) newval))
+
+(defclass document (node dom:document)
+ ((doc-type :initarg :doc-type :reader dom:doctype)
+ (dtd :initform nil :reader dtd)
+ (entity-resolver :initform nil)))
+
+(defclass document-fragment (node dom:document-fragment)
+ ())
+
+(defclass character-data (node dom:character-data)
+ ((value :initarg :data :reader dom:data)))
+
+(defclass attribute (namespace-mixin node dom:attr)
+ ((name :initarg :name :reader dom:name)
+ (owner-element :initarg :owner-element :reader dom:owner-element)
+ (specified-p :initarg :specified-p :reader dom:specified)))
+
+(defmethod (setf dom:prefix) :before (newval (node attribute))
+ (when (rod= (dom:node-name node) #"xmlns")
+ (dom-error :NAMESPACE_ERR "must not change xmlns attribute prefix")))
+
+(defmethod (setf dom:prefix) :after (newval (node attribute))
+ (setf (slot-value node 'name)
+ (concatenate 'rod newval #":" (dom:local-name node))))
+
+(defmethod print-object ((object attribute) stream)
+ (print-unreadable-object (object stream :type t :identity t)
+ (format stream "~A=~S"
+ (rod-string (dom:name object))
+ (rod-string (dom:value object)))))
+
+(defclass element (namespace-mixin node dom:element)
+ ((tag-name :initarg :tag-name :reader dom:tag-name)
+ (attributes :initarg :attributes :reader dom:attributes)))
+
+(defmethod (setf dom:prefix) :after (newval (node element))
+ (setf (slot-value node 'tag-name)
+ (concatenate 'rod newval #":" (dom:local-name node))))
+
+(defmethod print-object ((object element) stream)
+ (print-unreadable-object (object stream :type t :identity t)
+ (princ (rod-string (dom:tag-name object)) stream)))
+
+(defclass text (character-data dom:text)
+ ())
+
+(defclass comment (character-data dom:comment)
+ ())
+
+(defclass cdata-section (text dom:cdata-section)
+ ())
+
+(defclass document-type (node dom:document-type)
+ ((name :initarg :name :reader dom:name)
+ (public-id :initarg :public-id :reader dom:public-id)
+ (system-id :initarg :system-id :reader dom:system-id)
+ (entities :initarg :entities :reader dom:entities)
+ (notations :initarg :notations :reader dom:notations)
+ (dom::%internal-subset :accessor dom::%internal-subset)))
+
+(defclass notation (node dom:notation)
+ ((name :initarg :name :reader dom:name)
+ (public-id :initarg :public-id :reader dom:public-id)
+ (system-id :initarg :system-id :reader dom:system-id)))
+
+(defclass entity (node dom:entity)
+ ((name :initarg :name :reader dom:name)
+ (public-id :initarg :public-id :reader dom:public-id)
+ (system-id :initarg :system-id :reader dom:system-id)
+ (notation-name :initarg :notation-name :reader dom:notation-name)))
+
+(defclass entity-reference (node dom:entity-reference)
+ ((name :initarg :name :reader dom:name)))
+
+(defclass processing-instruction (node dom:processing-instruction)
+ ((target :initarg :target :reader dom:target)
+ (data :initarg :data :reader dom:data)))
+
+(defclass named-node-map (dom:named-node-map)
+ ((items :initarg :items :reader dom:items
+ :initform nil)
+ (owner :initarg :owner :reader dom:owner-document)
+ (read-only-p :initform nil :reader read-only-p)
+ (element-type :initarg :element-type)))
+
+(defclass attribute-node-map (named-node-map)
+ ((element :initarg :element)))
+
+
+;;; Implementation
+
+(defun %rod (x)
+ (etypecase x
+ (null x)
+ (rod x)
+ #+cxml-system::utf8dom-file (runes::rod (cxml::rod-to-utf8-string x))
+ (string (string-rod x))
+ (vector x)))
+
+#-cxml-system::utf8dom-file
+(defun real-rod (x)
+ (%rod x))
+
+#+cxml-system::utf8dom-file
+(defun real-rod (x)
+ (etypecase x
+ (null x)
+ (runes::rod x)
+ (string (cxml::utf8-string-to-rod x))))
+
+(defun valid-name-p (x)
+ (cxml::valid-name-p (real-rod x)))
+
+(defun assert-writeable (node)
+ (when (read-only-p node)
+ (dom-error :NO_MODIFICATION_ALLOWED_ERR "~S is marked read-only." node)))
+
+(defun dom:map-node-list (fn nodelist)
+ (dotimes (i (dom:length nodelist))
+ (funcall fn (dom:item nodelist i))))
+
+(defmacro dom:do-node-list ((var nodelist &optional resultform) &body body)
+ `(block nil
+ (dom:map-node-list (lambda (,var) ,@body) ,nodelist)
+ ,resultform))
+
+(defun dom:map-node-map (fn node-map)
+ (with-slots (items) node-map
+ (mapc fn items)))
+
+(defmacro dom:do-node-map ((var node-map &optional resultform) &body body)
+ `(block nil
+ (dom:map-node-map (lambda (,var) ,@body) ,node-map)
+ ,resultform))
+
+(defmacro dovector ((var vector &optional resultform) &body body)
+ `(loop
+ for ,var across ,vector do (progn ,@body)
+ ,@(when resultform `(finally (return ,resultform)))))
+
+(defun move (from to from-start to-start length)
+ ;; like (setf (subseq to to-start (+ to-start length))
+ ;; (subseq from from-start (+ from-start length)))
+ ;; but without creating the garbage.
+ ;; Also, this is using AREF not ELT so that fill-pointers are ignored.
+ (if (< to-start from-start)
+ (loop
+ repeat length
+ for i from from-start
+ for j from to-start
+ do (setf (aref to j) (aref from i)))
+ (loop
+ repeat length
+ for i downfrom (+ from-start length -1)
+ for j downfrom (+ to-start length -1)
+ do (setf (aref to j) (aref from i)))))
+
+(defun adjust-vector-exponentially (vector new-dimension set-fill-pointer-p)
+ (let ((d (array-dimension vector 0)))
+ (when (< d new-dimension)
+ (loop
+ do (setf d (* 2 d))
+ while (< d new-dimension))
+ (adjust-array vector d))
+ (when set-fill-pointer-p
+ (setf (fill-pointer vector) new-dimension))))
+
+(defun make-space (vector &optional (n 1))
+ (adjust-vector-exponentially vector (+ (length vector) n) nil))
+
+(defun extension (vector)
+ (max (array-dimension vector 0) 1))
+
+;; dom-exception
+
+(defun dom-error (key fmt &rest args)
+ (error 'dom-exception :key key :string fmt :arguments args))
+
+(defmethod dom:code ((self dom-exception))
+ (ecase (dom-exception-key self)
+ (:INDEX_SIZE_ERR 1)
+ (:DOMSTRING_SIZE_ERR 2)
+ (:HIERARCHY_REQUEST_ERR 3)
+ (:WRONG_DOCUMENT_ERR 4)
+ (:INVALID_CHARACTER_ERR 5)
+ (:NO_DATA_ALLOWED_ERR 6)
+ (:NO_MODIFICATION_ALLOWED_ERR 7)
+ (:NOT_FOUND_ERR 8)
+ (:NOT_SUPPORTED_ERR 9)
+ (:INUSE_ATTRIBUTE_ERR 10)
+ (:INVALID_STATE_ERR 11)
+ (:SYNTAX_ERR 12)
+ (:INVALID_MODIFICATION_ERR 13)
+ (:NAMESPACE_ERR 14)
+ (:INVALID_ACCESS_ERR 15)))
+
+;; dom-implementation protocol
+
+(defmethod dom:has-feature ((factory (eql 'implementation)) feature version)
+ (and (or (string-equal (rod-string feature) "xml")
+ (string-equal (rod-string feature) "core"))
+ (or (zerop (length version))
+ (string-equal (rod-string version) "1.0")
+ (string-equal (rod-string version) "2.0"))))
+
+(defun %create-document-type (name publicid systemid)
+ (make-instance 'document-type
+ :name name
+ :notations (make-instance 'named-node-map
+ :element-type :notation
+ :owner nil)
+ :entities (make-instance 'named-node-map
+ :element-type :entity
+ :owner nil)
+ :public-id publicid
+ :system-id systemid))
+
+(defmethod dom:create-document-type
+ ((factory (eql 'implementation)) name publicid systemid)
+ (safe-split-qname name #"")
+ (let ((result (%create-document-type name publicid systemid)))
+ (setf (slot-value (dom:entities result) 'read-only-p) t)
+ (setf (slot-value (dom:notations result) 'read-only-p) t)
+ result))
+
+(defmethod dom:create-document
+ ((factory (eql 'implementation)) uri qname doctype)
+ (let ((document (make-instance 'document)))
+ (setf (slot-value document 'owner) nil
+ (slot-value document 'doc-type) doctype)
+ (when doctype
+ (unless (typep doctype 'document-type)
+ (dom-error :WRONG_DOCUMENT_ERR
+ "doctype was created by a different dom implementation"))
+ (when (dom:owner-document doctype)
+ (dom-error :WRONG_DOCUMENT_ERR "doctype already in use"))
+ (setf (slot-value doctype 'owner) document
+ (slot-value (dom:notations doctype) 'owner) document
+ (slot-value (dom:entities doctype) 'owner) document))
+ (when (or uri qname)
+ (dom:append-child document (dom:create-element-ns document uri qname)))
+ document))
+
+;; document-fragment protocol
+;; document protocol
+
+(defmethod dom:implementation ((document document))
+ 'implementation)
+
+(defmethod dom:document-element ((document document))
+ (dovector (k (dom:child-nodes document))
+ (cond ((typep k 'element)
+ (return k)))))
+
+(defmethod dom:create-element ((document document) tag-name)
+ (setf tag-name (%rod tag-name))
+ (unless (valid-name-p tag-name)
+ (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string tag-name)))
+ (let ((result (make-instance 'element
+ :tag-name tag-name
+ :namespace-uri nil
+ :local-name nil
+ :prefix nil
+ :owner document)))
+ (setf (slot-value result 'attributes)
+ (make-instance 'attribute-node-map
+ :element-type :attribute
+ :owner document
+ :element result))
+ (add-default-attributes result)
+ result))
+
+(defun safe-split-qname (qname uri)
+ (unless (valid-name-p qname)
+ (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string qname)))
+ (multiple-value-bind (prefix local-name)
+ (handler-case
+ (cxml::split-qname (real-rod qname))
+ (cxml:well-formedness-violation (c)
+ (dom-error :NAMESPACE_ERR "~A" c)))
+ (setf local-name (%rod local-name))
+ (when prefix
+ (setf prefix (%rod prefix))
+ (unless uri
+ (dom-error :NAMESPACE_ERR "prefix specified but no namespace URI"))
+ (when (and (rod= prefix #"xml")
+ (not (rod= uri #"http://www.w3.org/XML/1998/namespace")))
+ (dom-error :NAMESPACE_ERR "invalid uri for prefix `xml'"))
+ (when (and (rod= prefix #"xmlns")
+ (not (rod= uri #"http://www.w3.org/2000/xmlns/")))
+ (dom-error :NAMESPACE_ERR "invalid uri for prefix `xmlns'")))
+ (values prefix local-name)))
+
+(defmethod dom:create-element-ns ((document document) uri qname)
+ (setf qname (%rod qname))
+ (multiple-value-bind (prefix local-name)
+ (safe-split-qname qname uri)
+ (let ((result (make-instance 'element
+ :tag-name qname
+ :namespace-uri uri
+ :local-name local-name
+ :prefix prefix
+ :owner document)))
+ (setf (slot-value result 'attributes)
+ (make-instance 'attribute-node-map
+ :element-type :attribute
+ :owner document
+ :element result))
+ (add-default-attributes result)
+ result)))
+
+(defmethod dom:create-document-fragment ((document document))
+ (make-instance 'document-fragment
+ :owner document))
+
+(defmethod dom:create-text-node ((document document) data)
+ (setf data (%rod data))
+ (make-instance 'text
+ :data data
+ :owner document))
+
+(defmethod dom:create-comment ((document document) data)
+ (setf data (%rod data))
+ (make-instance 'comment
+ :data data
+ :owner document))
+
+(defmethod dom:create-cdata-section ((document document) data)
+ (setf data (%rod data))
+ (make-instance 'cdata-section
+ :data data
+ :owner document))
+
+(defmethod dom:create-processing-instruction ((document document) target data)
+ (setf target (%rod target))
+ (setf data (%rod data))
+ (unless (valid-name-p target)
+ (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string target)))
+ (make-instance 'processing-instruction
+ :owner document
+ :target target
+ :data data))
+
+(defmethod dom:create-attribute ((document document) name)
+ (setf name (%rod name))
+ (unless (valid-name-p name)
+ (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string name)))
+ (make-instance 'attribute
+ :name name
+ :local-name nil
+ :prefix nil
+ :namespace-uri nil
+ :specified-p t
+ :owner-element nil
+ :owner document))
+
+(defmethod dom:create-attribute-ns ((document document) uri qname)
+ (setf uri (%rod uri))
+ (setf qname (%rod qname))
+ (when (and (rod= qname #"xmlns")
+ (not (rod= uri #"http://www.w3.org/2000/xmlns/")))
+ (dom-error :NAMESPACE_ERR "invalid uri for qname `xmlns'"))
+ (multiple-value-bind (prefix local-name)
+ (safe-split-qname qname uri)
+ (make-instance 'attribute
+ :name qname
+ :namespace-uri uri
+ :local-name local-name
+ :prefix prefix
+ :specified-p t
+ :owner-element nil
+ :owner document)))
+
+(defmethod dom:create-entity-reference ((document document) name)
+ (setf name (%rod name))
+ (unless (valid-name-p name)
+ (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string name)))
+ (make-instance 'entity-reference
+ :name name
+ :owner document))
+
+(defmethod get-elements-by-tag-name-internal (node tag-name)
+ (setf tag-name (%rod tag-name))
+ (let ((result (make-node-list))
+ (wild-p (rod= tag-name #"*")))
+ (labels ((walk (n)
+ (dovector (c (dom:child-nodes n))
+ (when (dom:element-p c)
+ (when (or wild-p (rod= tag-name (dom:node-name c)))
+ (vector-push-extend c result (extension result)))
+ (walk c)))))
+ (walk node))
+ result))
+
+(defmethod get-elements-by-tag-name-internal-ns (node uri lname)
+ (setf uri (%rod uri))
+ (setf lname (%rod lname))
+ (let ((result (make-node-list))
+ (wild-uri-p (rod= uri #"*"))
+ (wild-lname-p (rod= lname #"*")))
+ (labels ((walk (n)
+ (dovector (c (dom:child-nodes n))
+ (when (dom:element-p c)
+ (when (and (or wild-lname-p (rod= lname (dom:local-name c)))
+ (or wild-uri-p (rod= uri (dom:namespace-uri c))))
+ (vector-push-extend c result (extension result)))
+ (walk c)))))
+ (walk node))
+ result))
+
+(defmethod dom:get-elements-by-tag-name ((document document) tag-name)
+ (get-elements-by-tag-name-internal document tag-name))
+
+(defmethod dom:get-elements-by-tag-name-ns ((document document) uri lname)
+ (get-elements-by-tag-name-internal-ns document uri lname))
+
+(defmethod dom:get-element-by-id ((document document) id)
+ (block t
+ (unless (dtd document)
+ (return-from t nil))
+ (setf id (%rod id))
+ (labels ((walk (n)
+ (dovector (c (dom:child-nodes n))
+ (when (dom:element-p c)
+ (let ((e (cxml::find-element
+ (real-rod (dom:tag-name c))
+ (dtd document))))
+ (when e
+ (dolist (a (cxml::elmdef-attributes e))
+ (when (eq :ID (cxml::attdef-type a))
+ (let* ((name (%rod (cxml::attdef-name a)))
+ (value (dom:get-attribute c name)))
+ (when (and value (rod= value id))
+ (return-from t c)))))))
+ (walk c)))))
+ (walk document))))
+
+
+;;; Node
+
+(defmethod dom:has-attributes ((element node))
+ nil)
+
+(defmethod dom:is-supported ((node node) feature version)
+ (dom:has-feature 'implementation feature version))
+
+(defmethod dom:parent-node ((node node))
+ (slot-value node 'parent))
+
+(defmethod dom:child-nodes ((node node))
+ (slot-value node 'children))
+
+(defmethod dom:first-child ((node node))
+ (dom:item (slot-value node 'children) 0))
+
+(defmethod dom:last-child ((node node))
+ (with-slots (children) node
+ (if (plusp (length children))
+ (elt children (1- (length children)))
+ nil)))
+
+(defmethod dom:previous-sibling ((node node))
+ (with-slots (parent) node
+ (when parent
+ (with-slots (children) parent
+ (let ((index (1- (position node children))))
+ (if (eql index -1)
+ nil
+ (elt children index)))))))
+
+(defmethod dom:next-sibling ((node node))
+ (with-slots (parent) node
+ (when parent
+ (with-slots (children) parent
+ (let ((index (1+ (position node children))))
+ (if (eql index (length children))
+ nil
+ (elt children index)))))))
+
+(defmethod dom:owner-document ((node node))
+ (slot-value node 'owner))
+
+(defun ensure-valid-insertion-request (node new-child)
+ (assert-writeable node)
+ (unless (can-adopt-p node new-child)
+ (dom-error :HIERARCHY_REQUEST_ERR "~S cannot adopt ~S." node new-child))
+ #+(or) ;XXX needs to be moved elsewhere
+ (when (eq (dom:node-type node) :document)
+ (let ((child-type (dom:node-type new-child)))
+ (when (and (member child-type '(:element :document-type))
+ (find child-type (dom:child-nodes node) :key #'dom:node-type))
+ (dom-error :HIERARCHY_REQUEST_ERR
+ "~S cannot adopt a second child of type ~S."
+ node child-type))))
+ (unless (eq (if (eq (dom:node-type node) :document)
+ node
+ (dom:owner-document node))
+ (dom:owner-document new-child))
+ (dom-error :WRONG_DOCUMENT_ERR
+ "~S cannot adopt ~S, since it was created by a different document."
+ node new-child))
+ (do ((n node (dom:parent-node n)))
+ ((null n))
+ (when (eq n new-child)
+ (dom-error :HIERARCHY_REQUEST_ERR
+ "~S cannot adopt ~S, since that would create a cycle"
+ node new-child)))
+ (unless (null (slot-value new-child 'parent))
+ (dom:remove-child (slot-value new-child 'parent) new-child)))
+
+(defmethod dom:insert-before ((node node) (new-child node) ref-child)
+ (ensure-valid-insertion-request node new-child)
+ (with-slots (children) node
+ (if ref-child
+ (let ((i (position ref-child children)))
+ (unless i
+ (dom-error :NOT_FOUND_ERR "~S is no child of ~S." ref-child node))
+ (make-space children 1)
+ (move children children i (1+ i) (- (length children) i))
+ (incf (fill-pointer children))
+ (setf (elt children i) new-child))
+ (vector-push-extend new-child children (extension children)))
+ (setf (slot-value new-child 'parent) node)
+ new-child))
+
+(defmethod dom:insert-before
+ ((node node) (fragment document-fragment) ref-child)
+ (let ((children (dom:child-nodes fragment)))
+ (cxml::while (plusp (length children))
+ (dom:insert-before node (elt children 0) ref-child)))
+ fragment)
+
+(defmethod dom:replace-child ((node node) (new-child node) (old-child node))
+ (ensure-valid-insertion-request node new-child)
+ (with-slots (children) node
+ (let ((i (position old-child children)))
+ (unless i
+ (dom-error :NOT_FOUND_ERR "~S is no child of ~S." old-child node))
+ (setf (elt children i) new-child))
+ (setf (slot-value new-child 'parent) node)
+ (setf (slot-value old-child 'parent) nil)
+ old-child))
+
+(defmethod dom:replace-child
+ ((node node) (new-child document-fragment) (old-child node))
+ (dom:insert-before node new-child old-child)
+ (dom:remove-child node old-child))
+
+(defmethod dom:remove-child ((node node) (old-child node))
+ (assert-writeable node)
+ (with-slots (children) node
+ (let ((i (position old-child children)))
+ (unless i
+ (dom-error :NOT_FOUND_ERR "~A not found in ~A" old-child node))
+ (move children children (1+ i) i (- (length children) i 1))
+ (decf (fill-pointer children)))
+ (setf (slot-value old-child 'parent) nil)
+ old-child))
+
+(defmethod dom:append-child ((node node) (new-child node))
+ (ensure-valid-insertion-request node new-child)
+ (with-slots (children) node
+ (vector-push-extend new-child children (extension children))
+ (setf (slot-value new-child 'parent) node)
+ new-child))
+
+(defmethod dom:has-child-nodes ((node node))
+ (plusp (length (slot-value node 'children))))
+
+(defmethod dom:append-child ((node node) (new-child document-fragment))
+ (assert-writeable node)
+ (let ((children (dom:child-nodes new-child)))
+ (cxml::while (plusp (length children))
+ (dom:append-child node (elt children 0))))
+ new-child)
+
+;; was auf node noch implemetiert werden muss:
+;; - node-type
+;; - can-adopt-p
+;; - ggf attributes
+;; - node-name
+;; - node-value
+
+;; node-name
+
+(defmethod dom:node-name ((self document))
+ #"#document")
+
+(defmethod dom:node-name ((self document-fragment))
+ #"#document-fragment")
+
+(defmethod dom:node-name ((self text))
+ #"#text")
+
+(defmethod dom:node-name ((self cdata-section))
+ #"#cdata-section")
+
+(defmethod dom:node-name ((self comment))
+ #"#comment")
+
+(defmethod dom:node-name ((self attribute))
+ (dom:name self))
+
+(defmethod dom:node-name ((self element))
+ (dom:tag-name self))
+
+(defmethod dom:node-name ((self document-type))
+ (dom:name self))
+
+(defmethod dom:node-name ((self notation))
+ (dom:name self))
+
+(defmethod dom:node-name ((self entity))
+ (dom:name self))
+
+(defmethod dom:node-name ((self entity-reference))
+ (dom:name self))
+
+(defmethod dom:node-name ((self processing-instruction))
+ (dom:target self))
+
+;; node-type
+
+(defmethod dom:node-type ((self document)) :document)
+(defmethod dom:node-type ((self document-fragment)) :document-fragment)
+(defmethod dom:node-type ((self text)) :text)
+(defmethod dom:node-type ((self comment)) :comment)
+(defmethod dom:node-type ((self cdata-section)) :cdata-section)
+(defmethod dom:node-type ((self attribute)) :attribute)
+(defmethod dom:node-type ((self element)) :element)
+(defmethod dom:node-type ((self document-type)) :document-type)
+(defmethod dom:node-type ((self notation)) :notation)
+(defmethod dom:node-type ((self entity)) :entity)
+(defmethod dom:node-type ((self entity-reference)) :entity-reference)
+(defmethod dom:node-type ((self processing-instruction)) :processing-instruction)
+
+;; node-value
+
+(defmethod dom:node-value ((self document)) nil)
+(defmethod dom:node-value ((self document-fragment)) nil)
+(defmethod dom:node-value ((self character-data)) (dom:data self))
+(defmethod dom:node-value ((self attribute)) (dom:value self))
+(defmethod dom:node-value ((self element)) nil)
+(defmethod dom:node-value ((self document-type)) nil)
+(defmethod dom:node-value ((self notation)) nil)
+(defmethod dom:node-value ((self entity)) nil)
+(defmethod dom:node-value ((self entity-reference)) nil)
+(defmethod dom:node-value ((self processing-instruction)) (dom:data self))
+
+;; (setf node-value), first the meaningful cases...
+
+(defmethod (setf dom:node-value) (newval (self character-data))
+ (assert-writeable self)
+ (setf (dom:data self) newval))
+
+(defmethod (setf dom:node-value) (newval (self attribute))
+ (assert-writeable self)
+ (setf (dom:value self) newval))
+
+(defmethod (setf dom:node-value) (newval (self processing-instruction))
+ (assert-writeable self)
+ (setf (dom:data self) newval))
+
+;; ... and (setf node-value), part II. The DOM Level 1 spec fails to explain
+;; this case, but it is covered by the (Level 1) test suite and clarified
+;; in Level 2:
+;; nodeValue of type DOMString
+;; The value of this node, depending on its type; see the
+;; table above. When it is defined to be null, setting
+;; it has no effect.
+
+(defmethod (setf dom:node-value) (newval (self element))
+ (declare (ignore newval)))
+
+(defmethod (setf dom:node-value) (newval (self entity-reference))
+ (declare (ignore newval)))
+
+(defmethod (setf dom:node-value) (newval (self entity))
+ (declare (ignore newval)))
+
+(defmethod (setf dom:node-value) (newval (self document))
+ (declare (ignore newval)))
+
+(defmethod (setf dom:node-value) (newval (self document-type))
+ (declare (ignore newval)))
+
+(defmethod (setf dom:node-value) (newval (self document-fragment))
+ (declare (ignore newval)))
+
+(defmethod (setf dom:node-value) (newval (self notation))
+ (declare (ignore newval)))
+
+;; attributes
+
+;; (gibt es nur auf element)
+
+(defmethod dom:attributes ((self node))
+ nil)
+
+;; dann fehlt noch can-adopt und attribute conventions fuer adoption
+
+;;; NodeList
+
+(defun make-node-list (&optional initial-contents)
+ (make-array (length initial-contents)
+ :adjustable t
+ :fill-pointer (length initial-contents)
+ :initial-contents initial-contents))
+
+(defmethod dom:item ((self vector) index)
+ (if (< index (length self))
+ (elt self index)
+ nil))
+
+(defmethod dom:length ((self vector))
+ (length self))
+
+;;; NAMED-NODE-MAP
+
+(defmethod dom:get-named-item ((self named-node-map) name)
+ (setf name (%rod name))
+ (with-slots (items) self
+ (dolist (k items nil)
+ (when (rod= name (dom:node-name k))
+ (return k)))))
+
+(defmethod dom:get-named-item-ns ((self named-node-map) uri lname)
+ (setf uri (%rod uri))
+ (setf lname (%rod lname))
+ (with-slots (items) self
+ (dolist (k items nil)
+ (when (and (rod= uri (dom:namespace-uri k))
+ (rod= lname (dom:local-name k)))
+ (return k)))))
+
+(defun %set-named-item (map arg test)
+ (assert-writeable map)
+ (unless (eq (dom:node-type arg) (slot-value map 'element-type))
+ (dom-error :HIERARCHY_REQUEST_ERR
+ "~S cannot adopt ~S, since it is not of type ~S."
+ map arg (slot-value map 'element-type)))
+ (unless (eq (dom:owner-document map) (dom:owner-document arg))
+ (dom-error :WRONG_DOCUMENT_ERR
+ "~S cannot adopt ~S, since it was created by a different document."
+ map arg))
+ (let ((old-map (slot-value arg 'map)))
+ (when (and old-map (not (eq old-map map)))
+ (dom-error :INUSE_ATTRIBUTE_ERR "Attribute node already mapped" arg)))
+ (setf (slot-value arg 'map) map)
+ (with-slots (items) map
+ (dolist (k items (progn (setf items (cons arg items)) nil))
+ (when (funcall test k)
+ (setf items (cons arg (delete k items)))
+ (return k)))))
+
+(defmethod dom:set-named-item ((self named-node-map) arg)
+ (let ((name (dom:node-name arg)))
+ (%set-named-item self arg (lambda (k) (rod= name (dom:node-name k))))))
+
+(defmethod dom:set-named-item-ns ((self named-node-map) arg)
+ (let ((uri (dom:namespace-uri arg))
+ (lname (dom:local-name arg)))
+ (%set-named-item self
+ arg
+ (lambda (k)
+ (and (rod= lname (dom:local-name k))
+ (rod= uri (dom:namespace-uri k)))))))
+
+(defmethod dom:remove-named-item ((self named-node-map) name)
+ (assert-writeable self)
+ (setf name (%rod name))
+ (with-slots (items) self
+ (dolist (k items (dom-error :NOT_FOUND_ERR "~A not found in ~A" name self))
+ (cond ((rod= name (dom:node-name k))
+ (setf items (delete k items))
+ (return k))))))
+
+(defmethod dom:remove-named-item-ns ((self named-node-map) uri lname)
+ (assert-writeable self)
+ (setf uri (%rod uri))
+ (setf lname (%rod lname))
+ (with-slots (items) self
+ (dolist (k items
+ (dom-error :NOT_FOUND_ERR "~A not found in ~A" lname self))
+ (when (and (rod= lname (dom:local-name k))
+ (rod= uri (dom:namespace-uri k)))
+ (setf items (delete k items))
+ (return k)))))
+
+(defmethod dom:length ((self named-node-map))
+ (with-slots (items) self
+ (length items)))
+
+(defmethod dom:item ((self named-node-map) index)
+ (with-slots (items) self
+ (do ((nthcdr items (cdr nthcdr))
+ (i index (1- i)))
+ ((zerop i) (car nthcdr)))))
+
+;;; CHARACTER-DATA
+
+(defmethod (setf dom:data) (newval (self character-data))
+ (assert-writeable self)
+ (setf newval (%rod newval))
+ (setf (slot-value self 'value) newval))
+
+(defmethod dom:length ((node character-data))
+ (length (slot-value node 'value)))
+
+(defmethod dom:substring-data ((node character-data) offset count)
+ (with-slots (value) node
+ (unless (<= 0 offset (length value))
+ (dom-error :INDEX_SIZE_ERR "offset is invalid"))
+ (let ((end (min (length value) (+ offset count))))
+ (subseq value offset end))))
+
+(defmethod dom:append-data ((node character-data) arg)
+ (assert-writeable node)
+ (setq arg (%rod arg))
+ (with-slots (value) node
+ (setf value (concatenate 'rod value arg)))
+ (values))
+
+(defmethod dom:delete-data ((node character-data) offset count)
+ (assert-writeable node)
+ (with-slots (value) node
+ (unless (<= 0 offset (length value))
+ (dom-error :INDEX_SIZE_ERR "offset is invalid"))
+ (when (minusp count)
+ (dom-error :INDEX_SIZE_ERR "count is negative"))
+ (setf count (min count (- (length value) offset)))
+ (let ((new (make-array (- (length value) count)
+ :element-type (array-element-type value))))
+ (replace new value
+ :start1 0 :end1 offset
+ :start2 0 :end2 offset)
+ (replace new value
+ :start1 offset :end1 (length new)
+ :start2 (+ offset count) :end2 (length value))
+ (setf value new)))
+ (values))
+
+(defmethod dom:replace-data ((node character-data) offset count arg)
+ ;; Although we could implement this by calling DELETE-DATA, then INSERT-DATA,
+ ;; we implement this function directly to avoid creating temporary garbage.
+ (assert-writeable node)
+ (setf arg (%rod arg))
+ (with-slots (value) node
+ (unless (<= 0 offset (length value))
+ (dom-error :INDEX_SIZE_ERR "offset is invalid"))
+ (when (minusp count)
+ (dom-error :INDEX_SIZE_ERR "count is negative"))
+ (setf count (min count (- (length value) offset)))
+ (if (= count (length arg))
+ (replace value arg
+ :start1 offset :end1 (+ offset count)
+ :start2 0 :end2 count)
+ (let ((new (make-array (+ (length value) (length arg) (- count))
+ :element-type (array-element-type value))))
+ (replace new value :end1 offset)
+ (replace new arg :start1 offset)
+ (replace new value
+ :start1 (+ offset (length arg))
+ :start2 (+ offset count))
+ (setf value new))))
+ (values))
+
+(defmethod dom:insert-data ((node character-data) offset arg)
+ (assert-writeable node)
+ (setf arg (%rod arg))
+ (with-slots (value) node
+ (unless (<= 0 offset (length value))
+ (dom-error :INDEX_SIZE_ERR "offset is invalid"))
+ (let ((new (make-array (+ (length value) (length arg))
+ :element-type (array-element-type value)))
+ (arglen (length arg)))
+ (replace new value :end1 offset)
+ (replace new arg :start1 offset)
+ (replace new value :start1 (+ offset arglen) :start2 offset)
+ (setf value new)))
+ (values))
+
+;;; ATTR
+;;;
+;;; An attribute value can be read and set as a string using DOM:VALUE
+;;; or frobbed by changing the attribute's children!
+;;;
+;;; We store the value in a TEXT node and read this node's DATA slot
+;;; when asked for our VALUE -- until the user changes the child nodes,
+;;; in which case we have to compute VALUE by traversing the children.
+
+(defmethod dom:value ((node attribute))
+ (with-slots (children) node
+ (cond
+ ((zerop (length children))
+ #.(rod-string ""))
+ ((and (eql (length children) 1)
+ (eq (dom:node-type (elt children 0)) :text))
+ ;; we have as single TEXT-NODE child, just return its DATA
+ (dom:data (elt children 0)))
+ (t
+ ;; traverse children to compute value
+ (attribute-to-string node)))))
+
+(defmethod (setf dom:value) (new-value (node attribute))
+ (assert-writeable node)
+ (let ((rod (%rod new-value)))
+ (with-slots (children owner) node
+ ;; remove children, add new TEXT-NODE child
+ ;; (alas, we must not reuse an old TEXT-NODE)
+ (cxml::while (plusp (length children))
+ (dom:remove-child node (dom:last-child node)))
+ (dom:append-child node (dom:create-text-node owner rod))))
+ new-value)
+
+(defun attribute-to-string (attribute)
+ (let ((stream (make-rod-stream)))
+ (flet ((doit ()
+ (dovector (child (dom:child-nodes attribute))
+ (write-attribute-child child stream))))
+ (doit)
+ (initialize-rod-stream stream)
+ (doit))
+ (rod-stream-buf stream)))
+
+(defmethod write-attribute-child ((node node) stream)
+ (put-rod (dom:node-value node) stream))
+
+(defmethod write-attribute-child ((node entity-reference) stream)
+ (dovector (child (dom:child-nodes node))
+ (write-attribute-child child stream)))
+
+;;; ROD-STREAM als Ersatz fuer MAKE-STRING-OUTPUT-STREAM zu verwenden,
+;;; nur dass der Buffer statische Groesse hat. Solange er NIL ist,
+;;; zaehlt der Stream nur die Runen. Dann ruft man INITIALIZE-ROD-STREAM
+;;; auf, um den Buffer zu erzeugen und die Position zurueckzusetzen, und
+;;; schreibt alles abermals. Dann ist der Buffer gefuellt.
+(defstruct rod-stream
+ (buf nil)
+ (position 0))
+
+(defun put-rod (rod rod-stream)
+ (let ((buf (rod-stream-buf rod-stream)))
+ (when buf
+ (move rod buf 0 (rod-stream-position rod-stream) (length rod)))
+ (incf (rod-stream-position rod-stream) (length rod)))
+ rod)
+
+(defun initialize-rod-stream (stream)
+ (setf (rod-stream-buf stream) (make-rod (rod-stream-position stream)))
+ (setf (rod-stream-position stream) 0)
+ stream)
+
+;;; ELEMENT
+
+(defmethod dom:has-attributes ((element element))
+ (plusp (length (dom:items (dom:attributes element)))))
+
+(defmethod dom:has-attribute ((element element) name)
+ (and (dom:get-named-item (dom:attributes element) name) t))
+
+(defmethod dom:has-attribute-ns ((element element) uri lname)
+ (and (dom:get-named-item-ns (dom:attributes element) uri lname) t))
+
+(defmethod dom:get-attribute-node ((element element) name)
+ (dom:get-named-item (dom:attributes element) name))
+
+(defmethod dom:set-attribute-node ((element element) (new-attr attribute))
+ (assert-writeable element)
+ (dom:set-named-item (dom:attributes element) new-attr))
+
+(defmethod dom:get-attribute-node-ns ((element element) uri lname)
+ (dom:get-named-item-ns (dom:attributes element) uri lname))
+
+(defmethod dom:set-attribute-node-ns ((element element) (new-attr attribute))
+ (assert-writeable element)
+ (dom:set-named-item-ns (dom:attributes element) new-attr))
+
+(defmethod dom:get-attribute ((element element) name)
+ (let ((a (dom:get-attribute-node element name)))
+ (if a
+ (dom:value a)
+ #"")))
+
+(defmethod dom:get-attribute-ns ((element element) uri lname)
+ (let ((a (dom:get-attribute-node-ns element uri lname)))
+ (if a
+ (dom:value a)
+ #"")))
+
+(defmethod dom:set-attribute ((element element) name value)
+ (assert-writeable element)
+ (with-slots (owner) element
+ (let ((attr (dom:create-attribute owner name)))
+ (setf (slot-value attr 'owner-element) element)
+ (setf (dom:value attr) value)
+ (dom:set-attribute-node element attr))
+ (values)))
+
+(defmethod dom:set-attribute-ns ((element element) uri lname value)
+ (assert-writeable element)
+ (with-slots (owner) element
+ (let ((attr (dom:create-attribute-ns owner uri lname)))
+ (setf (slot-value attr 'owner-element) element)
+ (setf (dom:value attr) value)
+ (dom:set-attribute-node-ns element attr))
+ (values)))
+
+(defmethod dom:remove-attribute ((element element) name)
+ (assert-writeable element)
+ (dom:remove-attribute-node element (dom:get-attribute-node element name)))
+
+(defmethod dom:remove-attribute-ns ((elt element) uri lname)
+ (assert-writeable elt)
+ (dom:remove-attribute-node elt (dom:get-attribute-node-ns elt uri lname)))
+
+(defmethod dom:remove-attribute-node ((element element) (old-attr attribute))
+ (assert-writeable element)
+ (with-slots (items) (dom:attributes element)
+ (unless (find old-attr items)
+ (dom-error :NOT_FOUND_ERR "Attribute not found."))
+ (setf items (remove old-attr items))
+ (maybe-add-default-attribute element old-attr)
+ old-attr))
+
+;; eek, defaulting:
+
+(defun maybe-add-default-attribute (element old-attr)
+ (let* ((qname (dom:name old-attr))
+ (dtd (dtd (slot-value element 'owner)))
+ (e (when dtd (cxml::find-element
+ (real-rod (dom:tag-name element))
+ dtd)))
+ (a (when e (cxml::find-attribute e (real-rod qname)))))
+ (when (and a (listp (cxml::attdef-default a)))
+ (let ((new (add-default-attribute element a)))
+ (setf (slot-value new 'namespace-uri) (dom:namespace-uri old-attr))
+ (setf (slot-value new 'prefix) (dom:prefix old-attr))
+ (setf (slot-value new 'local-name) (dom:local-name old-attr))))))
+
+(defun add-default-attributes (element)
+ (let* ((dtd (dtd (slot-value element 'owner)))
+ (e (when dtd (cxml::find-element
+ (real-rod (dom:tag-name element))
+ dtd))))
+ (when e
+ (dolist (a (cxml::elmdef-attributes e))
+ (when (and a
+ (listp (cxml::attdef-default a))
+ (not (dom:get-attribute-node
+ element
+ (%rod (cxml::attdef-name a)))))
+ (let ((anode (add-default-attribute element a)))
+ (multiple-value-bind (prefix local-name)
+ (handler-case
+ (cxml::split-qname (cxml::attdef-name a))
+ (cxml:well-formedness-violation (c)
+ (dom-error :NAMESPACE_ERR "~A" c)))
+ (when prefix (setf prefix (%rod prefix)))
+ (setf local-name (%rod local-name))
+ ;; das ist fuer importnode07.
+ ;; so richtig ueberzeugend finde ich das ja nicht.
+ (setf (slot-value anode 'prefix) prefix)
+ (setf (slot-value anode 'local-name) local-name))))))))
+
+(defun add-default-attribute (element adef)
+ (let* ((value (second (cxml::attdef-default adef)))
+ (owner (slot-value element 'owner))
+ (anode (dom:create-attribute owner (cxml::attdef-name adef)))
+ (text (dom:create-text-node owner value)))
+ (setf (slot-value anode 'specified-p) nil)
+ (setf (slot-value anode 'owner-element) element)
+ (dom:append-child anode text)
+ (push anode (slot-value (dom:attributes element) 'items))
+ anode))
+
+(defmethod dom:remove-named-item ((self attribute-node-map) name)
+ name
+ (let ((k (call-next-method)))
+ (maybe-add-default-attribute (slot-value self 'element) k)
+ k))
+
+(defmethod dom:remove-named-item-ns ((self attribute-node-map) uri lname)
+ uri lname
+ (let ((k (call-next-method)))
+ (maybe-add-default-attribute (slot-value self 'element) k)
+ k))
+
+(defmethod dom:get-elements-by-tag-name ((element element) name)
+ (assert-writeable element)
+ (get-elements-by-tag-name-internal element name))
+
+(defmethod dom:get-elements-by-tag-name-ns ((element element) uri lname)
+ (assert-writeable element)
+ (get-elements-by-tag-name-internal-ns element uri lname))
+
+(defmethod dom:set-named-item :after ((self attribute-node-map) arg)
+ (setf (slot-value arg 'owner-element)
+ (slot-value self 'element)))
+
+(defmethod dom:set-named-item-ns :after ((self attribute-node-map) arg)
+ (setf (slot-value arg 'owner-element)
+ (slot-value self 'element)))
+
+(defmethod dom:normalize ((node node))
+ (assert-writeable node)
+ (labels ((walk (n)
+ (when (eq (dom:node-type n) :element)
+ (map nil #'walk (dom:items (dom:attributes n))))
+ (let ((children (dom:child-nodes n))
+ (i 0)
+ (previous nil))
+ ;; careful here, we're modifying the array we are iterating over
+ (cxml::while (< i (length children))
+ (let ((child (elt children i)))
+ (cond
+ ((not (eq (dom:node-type child) :text))
+ (setf previous nil)
+ (incf i))
+ ((and previous (eq (dom:node-type previous) :text))
+ (setf (slot-value previous 'value)
+ (concatenate 'rod
+ (dom:data previous)
+ (dom:data child)))
+ (dom:remove-child n child)
+ ;; not (incf i)
+ )
+ ((zerop (length (dom:data child)))
+ (dom:remove-child n child)
+ ;; not (incf i)
+ )
+ (t
+ (setf previous child)
+ (incf i))))))
+ (map nil #'walk (dom:child-nodes n))))
+ (walk node))
+ (values))
+
+;;; TEXT
+
+(defmethod dom:split-text ((text text) offset)
+ (assert-writeable text)
+ (with-slots (owner parent value) text
+ (unless (<= 0 offset (length value))
+ (dom-error :INDEX_SIZE_ERR "offset is invalid"))
+ (prog1
+ (dom:insert-before parent
+ (dom:create-text-node owner (subseq value offset))
+ (dom:next-sibling text))
+ (setf value (subseq value 0 offset)))))
+
+;;; COMMENT -- nix
+;;; CDATA-SECTION -- nix
+
+;;; DOCUMENT-TYPE
+
+(defmethod dom:internal-subset ((node document-type))
+ ;; FIXME: encoding ist falsch, anderen sink nehmen!
+ (if (and (slot-boundp node 'dom::%internal-subset)
+ ;; die damen und herren von der test suite sind wohl der meinung,
+ ;; dass ein leeres internal subset nicht vorhanden ist und
+ ;; wir daher nil liefern sollen. bittesehr!
+ (dom::%internal-subset node))
+ (let ((sink
+ #+rune-is-character (cxml:make-string-sink)
+ #-rune-is-character (cxml:make-string-sink/utf8)))
+ (dolist (def (dom::%internal-subset node))
+ (apply (car def) sink (cdr def)))
+ (sax:end-document sink))
+ nil))
+
+;;; NOTATION -- nix
+;;; ENTITY -- nix
+
+;;; ENTITY-REFERENCE
+
+(defmethod initialize-instance :after ((instance entity-reference) &key)
+ (let* ((owner (dom:owner-document instance))
+ (handler (make-dom-builder))
+ (resolver (slot-value owner 'entity-resolver)))
+ (when resolver
+ (setf (document handler) owner)
+ (push instance (element-stack handler))
+ #+cxml-system::utf8dom-file
+ (setf handler (cxml:make-recoder handler #'cxml:rod-to-utf8-string))
+ (funcall resolver (real-rod (dom:name instance)) handler)))
+ (labels ((walk (n)
+ (setf (slot-value n 'read-only-p) t)
+ (when (dom:element-p n)
+ (setf (slot-value (dom:attributes n) 'read-only-p) t)
+ (map nil #'walk (dom:items (dom:attributes n))))
+ (map nil #'walk (dom:child-nodes n))))
+ (walk instance)))
+
+;;; PROCESSING-INSTRUCTION
+
+(defmethod (setf dom:data) (newval (self processing-instruction))
+ (assert-writeable self)
+ (setf newval (%rod newval))
+ (setf (slot-value self 'data) newval))
+
+;; das koennte man auch mit einer GF machen
+(defun can-adopt-p (parent child)
+ (member (dom:node-type child)
+ (let ((default '(:element :processing-instruction :comment :text
+ :cdata-section :entity-reference)))
+ (etypecase parent
+ (document
+ '(:element :processing-instruction :comment :document-type))
+ (document-fragment default)
+ (document-type nil)
+ (entity-reference default)
+ (element default)
+ (attribute '(:text :entity-reference))
+ (processing-instruction nil)
+ (comment nil)
+ (text nil)
+ (cdata-section nil)
+ (entity default)
+ (notation nil)))))
+
+
+;;; predicates
+
+(defmethod dom:node-p ((object node)) t)
+(defmethod dom:node-p ((object t)) nil)
+
+(defmethod dom:document-p ((object document)) t)
+(defmethod dom:document-p ((object t)) nil)
+
+(defmethod dom:document-fragment-p ((object document-fragment)) t)
+(defmethod dom:document-fragment-p ((object t)) nil)
+
+(defmethod dom:character-data-p ((object character-data)) t)
+(defmethod dom:character-data-p ((object t)) nil)
+
+(defmethod dom:attribute-p ((object attribute)) t)
+(defmethod dom:attribute-p ((object t)) nil)
+
+(defmethod dom:element-p ((object element)) t)
+(defmethod dom:element-p ((object t)) nil)
+
+(defmethod dom:text-node-p ((object text)) t)
+(defmethod dom:text-node-p ((object t)) nil)
+
+(defmethod dom:comment-p ((object comment)) t)
+(defmethod dom:comment-p ((object t)) nil)
+
+(defmethod dom:cdata-section-p ((object cdata-section)) t)
+(defmethod dom:cdata-section-p ((object t)) nil)
+
+(defmethod dom:document-type-p ((object document-type)) t)
+(defmethod dom:document-type-p ((object t)) nil)
+
+(defmethod dom:notation-p ((object notation)) t)
+(defmethod dom:notation-p ((object t)) nil)
+
+(defmethod dom:entity-p ((object entity)) t)
+(defmethod dom:entity-p ((object t)) nil)
+
+(defmethod dom:entity-reference-p ((object entity-reference)) t)
+(defmethod dom:entity-reference-p ((object t)) nil)
+
+(defmethod dom:processing-instruction-p ((object processing-instruction)) t)
+(defmethod dom:processing-instruction-p ((object t)) nil)
+
+(defmethod dom:named-node-map-p ((object named-node-map)) t)
+(defmethod dom:named-node-map-p ((object t)) nil)
+
+
+;;; IMPORT-NODE
+
+(defvar *clone-not-import* nil) ;not beautiful, I know. See below.
+
+(defmethod import-node-internal (class document node deep &rest initargs)
+ (let ((result (apply #'make-instance class :owner document initargs)))
+ (when deep
+ (dovector (child (dom:child-nodes node))
+ (dom:append-child result (dom:import-node document child t))))
+ result))
+
+(defmethod dom:import-node ((document document) (node t) deep)
+ (declare (ignore deep))
+ (dom-error :NOT_SUPPORTED_ERR "not implemented"))
+
+(defmethod dom:import-node ((document document) (node attribute) deep)
+ (declare (ignore deep))
+ (import-node-internal 'attribute
+ document node
+ t
+ :specified-p (dom:specified node)
+ :name (dom:name node)
+ :namespace-uri (dom:namespace-uri node)
+ :local-name (dom:local-name node)
+ :prefix (dom:prefix node)
+ :owner-element nil))
+
+(defmethod dom:import-node ((document document) (node document-fragment) deep)
+ (import-node-internal 'document-fragment document node deep))
+
+(defmethod dom:import-node ((document document) (node element) deep)
+ (let* ((attributes (make-instance 'attribute-node-map
+ :element-type :attribute
+ :owner document))
+ (result (import-node-internal 'element document node deep
+ :attributes attributes
+ :namespace-uri (dom:namespace-uri node)
+ :local-name (dom:local-name node)
+ :prefix (dom:prefix node)
+ :tag-name (dom:tag-name node))))
+ (setf (slot-value attributes 'element) result)
+ (dolist (attribute (dom:items (dom:attributes node)))
+ (when (or (dom:specified attribute) *clone-not-import*)
+ (let ((attr (dom:import-node document attribute t)))
+ (if (dom:namespace-uri attribute)
+ (dom:set-attribute-node-ns result attr)
+ (dom:set-attribute-node result attr)))))
+ (add-default-attributes result)
+ result))
+
+(defmethod dom:import-node ((document document) (node entity) deep)
+ (import-node-internal 'entity document node deep
+ :name (dom:name node)
+ :public-id (dom:public-id node)
+ :system-id (dom:system-id node)
+ :notation-name (dom:notation-name node)))
+
+(defmethod dom:import-node ((document document) (node entity-reference) deep)
+ (declare (ignore deep))
+ (import-node-internal 'entity-reference document node nil
+ :name (dom:name node)))
+
+(defmethod dom:import-node ((document document) (node notation) deep)
+ (import-node-internal 'notation document node deep
+ :name (dom:name node)
+ :public-id (dom:public-id node)
+ :system-id (dom:system-id node)))
+
+(defmethod dom:import-node
+ ((document document) (node processing-instruction) deep)
+ (import-node-internal 'processing-instruction document node deep
+ :target (dom:target node)
+ :data (dom:data node)))
+
+;; TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE
+(defmethod dom:import-node
+ ((document document) (node character-data) deep)
+ (import-node-internal (class-of node) document node deep
+ :data (copy-seq (dom:data node))))
+
+;;; CLONE-NODE
+;;;
+;;; As far as I can tell, cloneNode is the same as importNode, except
+;;; for one difference involving element attributes: importNode imports
+;;; only specified attributes, cloneNode copies even default values.
+;;;
+;;; Since I don't want to reimplement all of importNode here, we run
+;;; importNode with a special flag...
+
+(defmethod dom:clone-node ((node node) deep)
+ (let ((*clone-not-import* t))
+ (dom:import-node (dom:owner-document node) node deep)))
+
+;; extension:
+(defmethod dom:clone-node ((node document) deep)
+ (let* ((document (make-instance 'document))
+ (original-doctype (dom:doctype node))
+ (doctype
+ (when original-doctype
+ (make-instance 'document-type
+ :owner document
+ :name (dom:name original-doctype)
+ :public-id (dom:public-id original-doctype)
+ :system-id (dom:system-id original-doctype)
+ :notations (make-instance 'named-node-map
+ :element-type :notation
+ :owner document
+ :items (dom:items (dom:notations original-doctype)))
+ :entities (make-instance 'named-node-map
+ :element-type :entity
+ :owner document
+ :items (dom:items
+ (dom:entities original-doctype)))))))
+ (setf (slot-value document 'owner) nil)
+ (setf (slot-value document 'doc-type) doctype)
+ (setf (slot-value document 'dtd) (dtd node))
+ (setf (slot-value document 'entity-resolver)
+ (slot-value node 'entity-resolver))
+ (setf (slot-value (dom:entities doctype) 'read-only-p) t)
+ (setf (slot-value (dom:notations doctype) 'read-only-p) t)
+ (when (and doctype (slot-boundp doctype 'dom::%internal-subset))
+ (setf (dom::%internal-subset doctype)
+ (dom::%internal-subset original-doctype)))
+ (when (and (dom:document-element node) deep)
+ (let* ((*clone-not-import* t)
+ (clone (dom:import-node document (dom:document-element node) t)))
+ (dom:append-child document clone)))
+ document))
+
+
+;;; Erweiterung
+
+(defun create-document (&optional document-element)
+ ;; Um ein neues Dokumentenobject zu erzeugen, parsen wir einfach ein
+ ;; Dummydokument.
+ (let* ((handler (make-dom-builder))
+ (cxml::*ctx* (cxml::make-context :handler handler))
+ (result
+ (progn
+ (sax:start-document handler)
+ (sax:end-document handler))))
+ (when document-element
+ (dom:append-child result (dom:import-node result document-element t)))
+ result))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-sax.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-sax.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/dom-sax.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,95 @@
+;;;; dom-sax.lisp -- DOM walker
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Author: David Lichteblau <david(a)lichteblau.com>
+;;;; Copyright (c) 2004 knowledgeTools Int. GmbH
+
+(in-package :cxml)
+
+(defun dom:map-document
+ (handler document
+ &key (include-xmlns-attributes sax:*include-xmlns-attributes*)
+ include-doctype
+ include-default-values
+ (recode (and #+rune-is-integer (typep document 'utf8-dom::node))))
+ (declare (ignorable recode))
+ #+rune-is-integer
+ (when recode
+ (setf handler (make-recoder handler #'utf8-string-to-rod)))
+ (sax:start-document handler)
+ (when include-doctype
+ (let ((doctype (dom:doctype document)))
+ (when doctype
+ (sax:start-dtd handler
+ (dom:name doctype)
+ (dom:public-id doctype)
+ (dom:system-id doctype))
+ (ecase include-doctype
+ (:full-internal-subset
+ (when (slot-boundp doctype 'dom::%internal-subset)
+ (sax:start-internal-subset handler)
+ (dolist (def (dom::%internal-subset doctype))
+ (apply (car def) handler (cdr def)))
+ (sax:end-internal-subset handler)))
+ (:canonical-notations
+ ;; need notations for canonical mode 2
+ (let* ((ns (dom:notations doctype))
+ (a (make-array (dom:length ns))))
+ (when (plusp (dom:length ns))
+ (sax:start-internal-subset handler)
+ ;; get them
+ (dotimes (k (dom:length ns))
+ (setf (elt a k) (dom:item ns k)))
+ ;; sort them
+ (setf a (sort a #'rod< :key #'dom:name))
+ (loop for n across a do
+ (sax:notation-declaration handler
+ (dom:name n)
+ (dom:public-id n)
+ (dom:system-id n)))
+ (sax:end-internal-subset handler)))))
+ (sax:end-dtd handler))))
+ (labels ((walk (node)
+ (dom:do-node-list (child (dom:child-nodes node))
+ (ecase (dom:node-type child)
+ (:element
+ (let ((attlist
+ (compute-attributes child
+ include-xmlns-attributes
+ include-default-values))
+ (uri (dom:namespace-uri child))
+ (lname (dom:local-name child))
+ (qname (dom:tag-name child)))
+ (sax:start-element handler uri lname qname attlist)
+ (walk child)
+ (sax:end-element handler uri lname qname)))
+ (:cdata-section
+ (sax:start-cdata handler)
+ (sax:characters handler (dom:data child))
+ (sax:end-cdata handler))
+ (:text
+ (sax:characters handler (dom:data child)))
+ (:comment
+ (sax:comment handler (dom:data child)))
+ (:processing-instruction
+ (sax:processing-instruction handler
+ (dom:target child)
+ (dom:data child)))))))
+ (walk document))
+ (sax:end-document handler))
+
+(defun compute-attributes (element xmlnsp defaultp)
+ (let ((results '()))
+ (dom:do-node-list (a (dom:attributes element))
+ (when (and (or defaultp (dom:specified a))
+ (or xmlnsp (not (cxml::xmlns-attr-p (rod (dom:name a))))))
+ (push
+ (sax:make-attribute :qname (dom:name a)
+ :value (dom:value a)
+ :local-name (dom:local-name a)
+ :namespace-uri (dom:namespace-uri a)
+ :specified-p (dom:specified a))
+ results)))
+ (reverse results)))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/package.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/package.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/dom/package.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,161 @@
+;;;; package.lisp -- Paketdefinition
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+
+(in-package :cl-user)
+
+(defpackage :dom
+ (:use)
+ (:export
+ ;; DOM 2 functions
+ #:owner-element
+ #:import-node
+ #:create-element-ns
+ #:create-attribute-ns
+ #:get-elements-by-tag-name-ns
+ #:get-element-by-id
+ #:get-named-item-ns
+ #:set-named-item-ns
+ #:remove-named-item-ns
+ #:is-supported
+ #:has-attributes
+ #:namespace-uri
+ #:prefix
+ #:local-name
+ #:internal-subset
+ #:create-document-type
+ #:create-document
+ #:get-attribute-ns
+ #:set-attribute-ns
+ #:remove-attribute-ns
+ #:get-attribute-node-ns
+ #:set-attribute-node-ns
+ #:has-attribute
+ #:has-attribute-ns
+
+ ;; DOM 1 functions
+ #:has-feature
+ #:doctype
+ #:implementation
+ #:document-element
+ #:create-element
+ #:create-document-fragment
+ #:create-text-node
+ #:create-comment
+ #:create-cdata-section
+ #:create-processing-instruction
+ #:create-attribute
+ #:create-entity-reference
+ #:get-elements-by-tag-name
+ #:node-name
+ #:node-value
+ #:node-type
+ #:parent-node
+ #:child-nodes
+ #:first-child
+ #:last-child
+ #:previous-sibling
+ #:next-sibling
+ #:attributes
+ #:owner-document
+ #:insert-before
+ #:replace-child
+ #:remove-child
+ #:append-child
+ #:has-child-nodes
+ #:clone-node
+ #:item
+ #:length
+ #:get-named-item
+ #:set-named-item
+ #:remove-named-item
+ #:data
+ #:substring-data
+ #:append-data
+ #:insert-data
+ #:delete-data
+ #:replace-data
+ #:name
+ #:specified
+ #:value
+ #:tag-name
+ #:get-attribute
+ #:set-attribute
+ #:remove-attribute
+ #:get-attribute-node
+ #:set-attribute-node
+ #:remove-attribute-node
+ #:normalize
+ #:split-text
+ #:entities
+ #:notations
+ #:public-id
+ #:system-id
+ #:notation-name
+ #:target
+ #:code
+
+ ;; IDL interfaces, exported "inofficially"
+ #:node
+ #:document
+ #:document-fragment
+ #:character-data
+ #:attr
+ #:element
+ #:text
+ #:comment
+ #:cdata-section
+ #:document-type
+ #:notation
+ #:entity
+ #:entity-reference
+ #:processing-instruction
+ #:named-node-map
+ ;; no classes:
+;;; #:dom-implementation
+;;; #:node-list
+
+ ;;
+ #:items
+
+ ;;
+ #:node-p
+ #:document-p
+ #:document-fragment-p
+ #:character-data-p
+ #:attribute-p
+ #:element-p
+ #:text-node-p
+ #:comment-p
+ #:cdata-section-p
+ #:document-type-p
+ #:notation-p
+ #:entity-p
+ #:entity-reference-p
+ #:processing-instruction-p
+ #:named-node-map-p
+
+ #:map-node-list
+ #:do-node-list
+ #:map-node-map
+ #:do-node-map
+ #:create-document
+ #:map-document))
+
+(defclass dom:node () ())
+(defclass dom:document (dom:node) ())
+(defclass dom:document-fragment (dom:node) ())
+(defclass dom:character-data (dom:node) ())
+(defclass dom:attr (dom:node) ())
+(defclass dom:element (dom:node) ())
+(defclass dom:text (dom:character-data) ())
+(defclass dom:comment (dom:character-data) ())
+(defclass dom:cdata-section (dom:text) ())
+(defclass dom:document-type (dom:node) ())
+(defclass dom:notation (dom:node) ())
+(defclass dom:entity (dom:node) ())
+(defclass dom:entity-reference (dom:node) ())
+(defclass dom:processing-instruction (dom:node) ())
+
+(defclass dom:named-node-map () ())
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Entries 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Entries 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,5 @@
+/klacks-impl.lisp/1.11/Sat Jun 16 09:41:22 2007//
+/klacks.lisp/1.8/Tue May 1 18:21:41 2007//
+/package.lisp/1.6/Tue May 1 18:21:41 2007//
+/tap-source.lisp/1.2/Tue May 1 18:21:41 2007//
+D
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Repository 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Repository 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+cxml/klacks
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Root 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/CVS/Root 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cxml/cvsroot
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/klacks-impl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/klacks-impl.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/klacks-impl.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,529 @@
+;;; -*- Mode: Lisp; readtable: runes; -*-
+;;; (c) copyright 2007 David Lichteblau
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+(in-package :cxml)
+
+(defclass cxml-source (klacks:source)
+ (;; args to make-source
+ (context :initarg :context)
+ (validate :initarg :validate)
+ (root :initarg :root)
+ (dtd :initarg :dtd)
+ (error-culprit :initarg :error-culprit)
+ ;; current state
+ (continuation)
+ (current-key :initform nil)
+ (current-values)
+ (current-attributes)
+ (cdata-section-p :reader klacks:current-cdata-section-p)
+ ;; extra WITH-SOURCE magic
+ (data-behaviour :initform :DTD)
+ (namespace-stack :initform (list *initial-namespace-bindings*))
+ (current-namespace-declarations)
+ (temporary-streams :initform nil)
+ (scratch-pad :initarg :scratch-pad)
+ (scratch-pad-2 :initarg :scratch-pad-2)
+ (scratch-pad-3 :initarg :scratch-pad-3)
+ (scratch-pad-4 :initarg :scratch-pad-4)))
+
+(defmethod klacks:close-source ((source cxml-source))
+ (dolist (xstream (slot-value source 'temporary-streams))
+ ;; fixme: error handling?
+ (close-xstream xstream)))
+
+(defmacro with-source ((source &rest slots) &body body)
+ (let ((s (gensym)))
+ `(let* ((,s ,source)
+ (*ctx* (slot-value ,s 'context))
+ (*validate* (slot-value ,s 'validate))
+ (*data-behaviour* (slot-value source 'data-behaviour))
+ (*namespace-bindings* (car (slot-value source 'namespace-stack)))
+ (*scratch-pad* (slot-value source 'scratch-pad))
+ (*scratch-pad-2* (slot-value source 'scratch-pad-2))
+ (*scratch-pad-3* (slot-value source 'scratch-pad-3))
+ (*scratch-pad-4* (slot-value source 'scratch-pad-4)))
+ (handler-case
+ (with-slots (,@slots) ,s
+ ,@body)
+ (runes-encoding:encoding-error (c)
+ (wf-error (slot-value ,s 'error-culprit) "~A" c))))))
+
+(defun fill-source (source)
+ (with-slots (current-key current-values continuation) source
+ (unless current-key
+ (setf current-key :bogus)
+ (setf continuation (funcall continuation))
+ (assert (not (eq current-key :bogus))))))
+
+(defmethod klacks:peek ((source cxml-source))
+ (with-source (source current-key current-values)
+ (fill-source source)
+ (apply #'values current-key current-values)))
+
+(defmethod klacks:peek-value ((source cxml-source))
+ (with-source (source current-key current-values)
+ (fill-source source)
+ (apply #'values current-values)))
+
+(defmethod klacks:peek-next ((source cxml-source))
+ (with-source (source current-key current-values)
+ (setf current-key nil)
+ (fill-source source)
+ (apply #'values current-key current-values)))
+
+(defmethod klacks:consume ((source cxml-source))
+ (with-source (source current-key current-values)
+ (fill-source source)
+ (multiple-value-prog1
+ (apply #'values current-key current-values)
+ (setf current-key nil))))
+
+(defmethod klacks:map-attributes (fn (source cxml-source))
+ (dolist (a (slot-value source 'current-attributes))
+ (funcall fn
+ (sax:attribute-namespace-uri a)
+ (sax:attribute-local-name a)
+ (sax:attribute-qname a)
+ (sax:attribute-value a)
+ (sax:attribute-specified-p a))))
+
+(defmethod klacks:get-attribute
+ ((source cxml-source) lname &optional uri)
+ (dolist (a (slot-value source 'current-attributes))
+ (when (and (equal (sax:attribute-local-name a) lname)
+ (equal (sax:attribute-namespace-uri a) uri))
+ (return (sax:attribute-value a)))))
+
+(defmethod klacks:list-attributes ((source cxml-source))
+ (slot-value source 'current-attributes))
+
+(defun make-source
+ (input &rest args
+ &key validate dtd root entity-resolver disallow-internal-subset
+ (buffering t) pathname)
+ (declare (ignore validate dtd root entity-resolver disallow-internal-subset))
+ (etypecase input
+ (xstream
+ (when (and (not buffering) (< 1 (runes::xstream-speed input)))
+ (warn "make-source called with !buffering, but xstream is buffering"))
+ (let ((*ctx* nil))
+ (let ((zstream (make-zstream :input-stack (list input))))
+ (peek-rune input)
+ (with-scratch-pads ()
+ (apply #'%make-source
+ zstream
+ (loop
+ for (name value) on args by #'cddr
+ unless (member name '(:pathname :buffering))
+ append (list name value)))))))
+ (stream
+ (let ((xstream (make-xstream input :speed (if buffering 8192 1))))
+ (setf (xstream-name xstream)
+ (make-stream-name
+ :entity-name "main document"
+ :entity-kind :main
+ :uri (pathname-to-uri
+ (merge-pathnames (or pathname (pathname input))))))
+ (apply #'make-source xstream args)))
+ (pathname
+ (let* ((xstream
+ (make-xstream (open input :element-type '(unsigned-byte 8))
+ :speed (if buffering 8192 1))))
+ (setf (xstream-name xstream)
+ (make-stream-name
+ :entity-name "main document"
+ :entity-kind :main
+ :uri (pathname-to-uri (merge-pathnames input))))
+ (let ((source (apply #'make-source
+ xstream
+ :pathname input
+ args)))
+ (push xstream (slot-value source 'temporary-streams))
+ source)))
+ (rod
+ (let ((xstream (string->xstream input)))
+ (setf (xstream-name xstream)
+ (make-stream-name
+ :entity-name "main document"
+ :entity-kind :main
+ :uri nil))
+ (apply #'make-source xstream args)))
+ (array
+ (make-source (cxml::make-octet-input-stream input)))))
+
+(defun %make-source
+ (input &key validate dtd root entity-resolver disallow-internal-subset
+ error-culprit)
+ ;; check types of user-supplied arguments for better error messages:
+ (check-type validate boolean)
+ (check-type dtd (or null extid))
+ (check-type root (or null rod))
+ (check-type entity-resolver (or null function symbol))
+ (check-type disallow-internal-subset boolean)
+ (let* ((xstream (car (zstream-input-stack input)))
+ (name (xstream-name xstream))
+ (base (when name (stream-name-uri name)))
+ (context
+ (make-context :main-zstream input
+ :entity-resolver entity-resolver
+ :base-stack (list (or base ""))
+ :disallow-internal-subset disallow-internal-subset))
+ (source
+ (make-instance 'cxml-source
+ :context context
+ :validate validate
+ :dtd dtd
+ :root root
+ :error-culprit error-culprit
+ :scratch-pad *scratch-pad*
+ :scratch-pad-2 *scratch-pad-2*
+ :scratch-pad-3 *scratch-pad-3*
+ :scratch-pad-4 *scratch-pad-4*)))
+ (setf (handler context) (make-instance 'klacks-dtd-handler :source source))
+ (setf (slot-value source 'continuation)
+ (lambda () (klacks/xmldecl source input)))
+ source))
+
+(defun klacks/xmldecl (source input)
+ (with-source (source current-key current-values)
+ (let ((hd (p/xmldecl input)))
+ (setf current-key :start-document)
+ (setf current-values
+ (when hd
+ (list (xml-header-version hd)
+ (xml-header-encoding hd)
+ (xml-header-standalone-p hd))))
+ (lambda ()
+ (klacks/misc*-2 source input
+ (lambda ()
+ (klacks/doctype source input)))))))
+
+(defun klacks/misc*-2 (source input successor)
+ (with-source (source current-key current-values)
+ (multiple-value-bind (cat sem) (peek-token input)
+ (case cat
+ (:COMMENT
+ (setf current-key :comment)
+ (setf current-values (list sem))
+ (consume-token input)
+ (lambda () (klacks/misc*-2 source input successor)))
+ (:PI
+ (setf current-key :processing-instruction)
+ (setf current-values (list (car sem) (cdr sem)))
+ (consume-token input)
+ (lambda () (klacks/misc*-2 source input successor)))
+ (:S
+ (consume-token input)
+ (klacks/misc*-2 source input successor))
+ (t
+ (funcall successor))))))
+
+(defun klacks/doctype (source input)
+ (with-source (source current-key current-values validate dtd)
+ (let ((cont (lambda () (klacks/finish-doctype source input)))
+ l)
+ (prog1
+ (cond
+ ((eq (peek-token input) :<!DOCTYPE)
+ (setf l (cdr (p/doctype-decl input dtd)))
+ (lambda () (klacks/misc*-2 source input cont)))
+ (dtd
+ (setf l (cdr (synthesize-doctype dtd input)))
+ cont)
+ ((and validate (not dtd))
+ (validity-error "invalid document: no doctype"))
+ (t
+ (return-from klacks/doctype
+ (funcall cont))))
+ (destructuring-bind (&optional name extid) l
+ (setf current-key :dtd)
+ (setf current-values
+ (list name
+ (and extid (extid-public extid))
+ (and extid (extid-system extid)))))))))
+
+(defun klacks/finish-doctype (source input)
+ (with-source (source current-key current-values root data-behaviour)
+ (ensure-dtd)
+ (when root
+ (setf (model-stack *ctx*) (list (make-root-model root))))
+ (setf data-behaviour :DOC)
+ (setf *data-behaviour* :DOC)
+ (fix-seen-< input)
+ (let* ((final
+ (lambda ()
+ (klacks/eof source input)))
+ (next
+ (lambda ()
+ (setf data-behaviour :DTD)
+ (setf *data-behaviour* :DTD)
+ (klacks/misc*-2 source input final))))
+ (klacks/element source input next))))
+
+(defun klacks/eof (source input)
+ (with-source (source current-key current-values)
+ (p/eof input)
+ (klacks:close-source source)
+ (setf current-key :end-document)
+ (setf current-values nil)
+ (lambda () (klacks/nil source))))
+
+(defun klacks/nil (source)
+ (with-source (source current-key current-values)
+ (setf current-key nil)
+ (setf current-values nil)
+ (labels ((klacks/done ()
+ (setf current-key nil)
+ (setf current-values nil)
+ #'klacks/done))
+ #'klacks/done)))
+
+(defun klacks/element (source input cont)
+ (with-source (source current-key current-values current-attributes
+ current-namespace-declarations)
+ (multiple-value-bind (cat n-b new-b uri lname qname attrs) (p/sztag input)
+ (setf current-key :start-element)
+ (setf current-values (list uri lname qname))
+ (setf current-attributes attrs)
+ (setf current-namespace-declarations new-b)
+ (if (eq cat :stag)
+ (lambda ()
+ (klacks/element-2 source input n-b cont))
+ (lambda ()
+ (klacks/ztag source cont))))))
+
+(defun klacks/ztag (source cont)
+ (with-source (source current-key current-values current-attributes)
+ (setf current-key :end-element)
+ (setf current-attributes nil)
+ (validate-end-element *ctx* (third current-values))
+ cont))
+
+(defun klacks/element-2 (source input n-b cont)
+ (with-source (source
+ current-key current-values current-attributes namespace-stack
+ current-namespace-declarations)
+ (let ((values* current-values)
+ (new-b current-namespace-declarations))
+ (setf current-attributes nil)
+ (push n-b namespace-stack)
+ (let ((finish
+ (lambda ()
+ (setf current-namespace-declarations new-b)
+ (klacks/element-3 source input values* cont))))
+ (klacks/content source input finish)))))
+
+(defun klacks/element-3 (source input tag-values cont)
+ (with-source (source current-key current-values current-attributes)
+ (setf current-key :end-element)
+ (setf current-values tag-values)
+ (let ((qname (third tag-values)))
+ (p/etag input qname)
+ (validate-end-element *ctx* qname))
+ cont))
+
+(defun klacks/content (source input cont)
+ (with-source (source current-key current-values cdata-section-p)
+ (let ((recurse (lambda () (klacks/content source input cont))))
+ (multiple-value-bind (cat sem) (peek-token input)
+ (case cat
+ ((:stag :ztag)
+ (klacks/element source input recurse))
+ ((:CDATA)
+ (process-characters input sem)
+ (setf current-key :characters)
+ (setf current-values (list sem))
+ (setf cdata-section-p nil)
+ recurse)
+ ((:ENTITY-REF)
+ (let ((name sem))
+ (consume-token input)
+ (klacks/entity-reference source input name recurse)))
+ ((:<!\[)
+ (setf current-key :characters)
+ (setf current-values (list (process-cdata-section input)))
+ (setf cdata-section-p t)
+ recurse)
+ ((:PI)
+ (setf current-key :processing-instruction)
+ (setf current-values (list (car sem) (cdr sem)))
+ (consume-token input)
+ recurse)
+ ((:COMMENT)
+ (setf current-key :comment)
+ (setf current-values (list sem))
+ (consume-token input)
+ recurse)
+ (otherwise
+ (funcall cont)))))))
+
+(defun klacks/entity-reference (source zstream name cont)
+ (assert (not (zstream-token-category zstream)))
+ (with-source (source temporary-streams context)
+ (let ((new-xstream (entity->xstream zstream name :general nil)))
+ (push new-xstream temporary-streams)
+ (push :stop (zstream-input-stack zstream))
+ (zstream-push new-xstream zstream)
+ (push (stream-name-uri (xstream-name new-xstream)) (base-stack context))
+ (let ((next
+ (lambda ()
+ (klacks/entity-reference-2 source zstream new-xstream cont))))
+ (etypecase (checked-get-entdef name :general)
+ (internal-entdef
+ (klacks/content source zstream next))
+ (external-entdef
+ (klacks/ext-parsed-ent source zstream next)))))))
+
+(defun klacks/entity-reference-2 (source zstream new-xstream cont)
+ (with-source (source temporary-streams context)
+ (unless (eq (peek-token zstream) :eof)
+ (wf-error zstream "Trailing garbage. - ~S" (peek-token zstream)))
+ (assert (eq (peek-token zstream) :eof))
+ (assert (eq (pop (zstream-input-stack zstream)) new-xstream))
+ (assert (eq (pop (zstream-input-stack zstream)) :stop))
+ (pop (base-stack context))
+ (setf (zstream-token-category zstream) nil)
+ (setf temporary-streams (remove new-xstream temporary-streams))
+ (close-xstream new-xstream)
+ (funcall cont)))
+
+(defun klacks/ext-parsed-ent (source input cont)
+ (with-source (source)
+ (when (eq (peek-token input) :xml-decl)
+ (let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input))))))
+ (setup-encoding input hd))
+ (consume-token input))
+ (set-full-speed input)
+ (klacks/content source input cont)))
+
+
+;;;; terrible kludges
+
+(defclass klacks-dtd-handler ()
+ ((handler-source :initarg :source :reader handler-source)
+ (internal-subset-p :initform nil :accessor handler-internal-subset-p)))
+
+(defmethod sax:start-internal-subset ((handler klacks-dtd-handler))
+ (setf (slot-value (handler-source handler) 'internal-declarations) '())
+ (setf (handler-internal-subset-p handler) t))
+
+(defmethod sax:end-internal-subset ((handler klacks-dtd-handler))
+ (setf (handler-internal-subset-p handler) nil))
+
+(defmethod sax:entity-resolver ((handler klacks-dtd-handler) fn)
+ (setf (slot-value (handler-source handler) 'dom-impl-entity-resolver) fn))
+
+(defmethod sax::dtd ((handler klacks-dtd-handler) dtd)
+ (setf (slot-value (handler-source handler) 'dom-impl-dtd) dtd))
+
+(defmethod sax:end-dtd ((handler klacks-dtd-handler))
+ (let ((source (handler-source handler)))
+ (when (slot-boundp source 'internal-declarations)
+ (setf (slot-value source 'internal-declarations)
+ (reverse (slot-value source 'internal-declarations)))
+ (setf (slot-value source 'external-declarations)
+ (reverse (slot-value source 'external-declarations))))))
+
+(macrolet
+ ((defhandler (name &rest args)
+ `(defmethod ,name ((handler klacks-dtd-handler) ,@args)
+ (let ((source (handler-source handler))
+ (spec (list ',name ,@args)))
+ (if (handler-internal-subset-p handler)
+ (push spec (slot-value source 'internal-declarations))
+ (push spec (slot-value source 'external-declarations)))))))
+ (defhandler sax:unparsed-entity-declaration
+ name public-id system-id notation-name)
+ (defhandler sax:external-entity-declaration
+ kind name public-id system-id)
+ (defhandler sax:internal-entity-declaration
+ kind name value)
+ (defhandler sax:notation-declaration
+ name public-id system-id)
+ (defhandler sax:element-declaration
+ name model)
+ (defhandler sax:attribute-declaration
+ element-name attribute-name type default))
+
+
+;;;; locator
+
+(defun source-xstream (source)
+ (car (zstream-input-stack (main-zstream (slot-value source 'context)))))
+
+(defun source-stream-name (source)
+ (let ((xstream (source-xstream source)))
+ (if xstream
+ (xstream-name xstream)
+ nil)))
+
+(defmethod klacks:current-line-number ((source cxml-source))
+ (let ((x (source-xstream source)))
+ (if x
+ (xstream-line-number x)
+ nil)))
+
+(defmethod klacks:current-column-number ((source cxml-source))
+ (let ((x (source-xstream source)))
+ (if x
+ (xstream-column-number x)
+ nil)))
+
+(defmethod klacks:current-system-id ((source cxml-source))
+ (let ((name (source-stream-name source)))
+ (if name
+ (stream-name-uri name)
+ nil)))
+
+(defmethod klacks:current-xml-base ((source cxml-source))
+ (car (base-stack (slot-value source 'context))))
+
+(defmethod klacks:map-current-namespace-declarations (fn (source cxml-source))
+ (loop
+ for (prefix . uri) in (slot-value source 'current-namespace-declarations)
+ do
+ (funcall fn prefix uri)))
+
+(defmethod klacks:find-namespace-binding (prefix (source cxml-source))
+ (with-source (source)
+ (find-namespace-binding prefix)))
+
+(defmethod klacks:decode-qname (qname (source cxml-source))
+ (with-source (source)
+ (multiple-value-bind (prefix local-name) (split-qname qname)
+ (values (and prefix (find-namespace-binding prefix))
+ local-name
+ prefix))))
+
+
+;;;; debugging
+
+#+(or)
+(trace CXML::KLACKS/DOCTYPE
+ CXML::KLACKS/EXT-PARSED-ENT
+ CXML::KLACKS/MISC*-2
+ CXML::KLACKS/ENTITY-REFERENCE
+ CXML::KLACKS/ENTITY-REFERENCE-2
+ CXML::KLACKS/ELEMENT
+ CXML::KLACKS/ZTAG
+ CXML::KLACKS/XMLDECL
+ CXML::KLACKS/FINISH-DOCTYPE
+ CXML::KLACKS/ELEMENT-3
+ CXML::KLACKS/EOF
+ CXML::KLACKS/ELEMENT-2
+ CXML::KLACKS/CONTENT )
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/klacks.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/klacks.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/klacks.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,253 @@
+;;; -*- Mode: Lisp; readtable: runes; -*-
+;;; (c) copyright 2007 David Lichteblau
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+(in-package :cxml)
+
+(defclass klacks:source ()
+ (
+ ;; fixme, terrible DTD kludges
+ (internal-declarations)
+ (external-declarations :initform nil)
+ (dom-impl-dtd :initform nil)
+ (dom-impl-entity-resolver :initform nil)))
+
+(defgeneric klacks:close-source (source))
+
+(defgeneric klacks:peek (source))
+(defgeneric klacks:peek-value (source))
+(defgeneric klacks:consume (source))
+
+(defgeneric klacks:map-attributes (fn source))
+(defgeneric klacks:list-attributes (source))
+(defgeneric klacks:get-attribute (source lname &optional uri))
+;;;(defgeneric klacks:current-uri (source))
+;;;(defgeneric klacks:current-lname (source))
+;;;(defgeneric klacks:current-qname (source))
+;;;(defgeneric klacks:current-characters (source))
+(defgeneric klacks:current-cdata-section-p (source))
+(defgeneric klacks:map-current-namespace-declarations (fn source))
+
+(defgeneric klacks:current-line-number (source))
+(defgeneric klacks:current-column-number (source))
+(defgeneric klacks:current-system-id (source))
+(defgeneric klacks:current-xml-base (source))
+
+(defgeneric klacks:find-namespace-binding (prefix source))
+(defgeneric klacks:decode-qname (qname source))
+
+(defmacro klacks:with-open-source ((var source) &body body)
+ `(let ((,var ,source))
+ (unwind-protect
+ (progn ,@body)
+ (klacks:close-source ,var))))
+
+(defun klacks:current-uri (source)
+ (multiple-value-bind (key uri lname qname) (klacks:peek source)
+ (declare (ignore lname qname))
+ (check-type key (member :start-element :end-element))
+ uri))
+
+(defun klacks:current-lname (source)
+ (multiple-value-bind (key uri lname qname) (klacks:peek source)
+ (declare (ignore uri qname))
+ (check-type key (member :start-element :end-element))
+ lname))
+
+(defun klacks:current-qname (source)
+ (multiple-value-bind (key uri lname qname) (klacks:peek source)
+ (declare (ignore uri lname))
+ (check-type key (member :start-element :end-element))
+ qname))
+
+(defun klacks:current-characters (source)
+ (multiple-value-bind (key characters) (klacks:peek source)
+ (check-type key (member :characters))
+ characters))
+
+(defun klacks:serialize-event (source handler &key (consume t))
+ (multiple-value-bind (key a b c) (klacks:peek source)
+ (let ((result nil))
+ (case key
+ (:start-document
+ (sax:start-document handler)
+ (loop for (prefix . uri) in *initial-namespace-bindings* do
+ (sax:start-prefix-mapping handler prefix uri)))
+ (:characters
+ (cond
+ ((klacks:current-cdata-section-p source)
+ (sax:start-cdata source)
+ (sax:characters handler a)
+ (sax:end-cdata source))
+ (T
+ (sax:characters handler a))))
+ (:processing-instruction
+ (sax:processing-instruction handler a b))
+ (:comment
+ (sax:comment handler a))
+ (:dtd
+ (sax:start-dtd handler a b c)
+ (when (slot-boundp source 'internal-declarations)
+ (sax:start-internal-subset handler)
+ (serialize-declaration-kludge
+ (slot-value source 'internal-declarations)
+ handler)
+ (sax:end-internal-subset handler))
+ (serialize-declaration-kludge
+ (slot-value source 'external-declarations)
+ handler)
+ (sax:end-dtd handler)
+ (sax:entity-resolver handler
+ (slot-value source 'dom-impl-entity-resolver))
+ (sax::dtd handler (slot-value source 'dom-impl-dtd)))
+ (:start-element
+ (klacks:map-current-namespace-declarations
+ (lambda (prefix uri)
+ (sax:start-prefix-mapping handler prefix uri))
+ source)
+ (sax:start-element handler a b c (klacks:list-attributes source)))
+ (:end-element
+ (sax:end-element handler a b c)
+ (klacks:map-current-namespace-declarations
+ (lambda (prefix uri)
+ (declare (ignore uri))
+ (sax:end-prefix-mapping handler prefix))
+ source))
+ (:end-document
+ (loop for (prefix . nil) in *initial-namespace-bindings* do
+ (sax:end-prefix-mapping handler prefix))
+ (setf result (sax:end-document handler)))
+ ((nil)
+ (error "serialize-event read past end of document"))
+ (t
+ (error "unexpected klacks key: ~A" key)))
+ (when consume
+ (klacks:consume source))
+ result)))
+
+(defun serialize-declaration-kludge (list handler)
+ (loop
+ for (fn . args) in list
+ do (apply fn handler args)))
+
+(defun klacks:serialize-source (source handler)
+ (loop
+ (let ((document (klacks:serialize-event source handler)))
+ (when document
+ (return document)))))
+
+(defclass klacksax (sax:sax-parser)
+ ((source :initarg :source)))
+
+(defmethod sax:line-number ((parser klacksax))
+ (klacks:current-line-number (slot-value parser 'source)))
+
+(defmethod sax:column-number ((parser klacksax))
+ (klacks:current-column-number (slot-value parser 'source)))
+
+(defmethod sax:system-id ((parser klacksax))
+ (klacks:current-system-id (slot-value parser 'source)))
+
+(defmethod sax:xml-base ((parser klacksax))
+ (klacks:current-xml-base (slot-value parser 'source)))
+
+(defun klacks:serialize-element (source handler &key (document-events t))
+ (unless (eq (klacks:peek source) :start-element)
+ (error "not at start of element"))
+ (sax:register-sax-parser handler (make-instance 'klacksax :source source))
+ (when document-events
+ (sax:start-document handler))
+ (labels ((recurse ()
+ (klacks:serialize-event source handler)
+ (loop
+ (let ((key (klacks:peek source)))
+ (ecase key
+ (:start-element (recurse))
+ (:end-element (return))
+ ((:characters :comment :processing-instruction)
+ (klacks:serialize-event source handler)))))
+ (klacks:serialize-event source handler)))
+ (recurse))
+ (when document-events
+ (sax:end-document handler)))
+
+(defun klacks:find-element (source &optional lname uri)
+ (loop
+ (multiple-value-bind (key current-uri current-lname current-qname)
+ (klacks:peek source)
+ (case key
+ ((nil)
+ (return nil))
+ (:start-element
+ (when (and (eq key :start-element)
+ (or (null lname)
+ (equal lname (klacks:current-lname source)))
+ (or (null uri)
+ (equal uri (klacks:current-uri source))))
+ (return
+ (values key current-uri current-lname current-qname)))))
+ (klacks:consume source))))
+
+(defun klacks:find-event (source key)
+ (loop
+ (multiple-value-bind (this a b c)
+ (klacks:peek source)
+ (cond
+ ((null this)
+ (return nil))
+ ((eq this key)
+ (return (values this a b c))))
+ (klacks:consume source))))
+
+(define-condition klacks-error (xml-parse-error) ())
+
+(defun klacks-error (fmt &rest args)
+ (%error 'klacks-error
+ nil
+ (format nil "Klacks assertion failed: ~?" fmt args)))
+
+(defun klacks:expect (source key &optional u v w)
+ (multiple-value-bind (this a b c)
+ (klacks:peek source)
+ (unless (eq this key) (klacks-error "expected ~A but got ~A" key this))
+ (when (and u (not (equal a u)))
+ (klacks-error "expected ~A but got ~A" u a))
+ (when (and v (not (equal b v)))
+ (klacks-error "expected ~A but got ~A" v b))
+ (when (and w (not (equal c w)))
+ (klacks-error "expected ~A but got ~A" w c))
+ (values this a b c)))
+
+(defun klacks:skip (source key &optional a b c)
+ (klacks:expect source key a b c)
+ (klacks:consume source))
+
+(defun invoke-expecting-element (fn source &optional lname uri)
+ (multiple-value-bind (key a b)
+ (klacks:peek source)
+ (unless (eq key :start-element)
+ (klacks-error "expected ~A but got ~A" (or lname "element") key))
+ (when (and uri (not (equal a uri)))
+ (klacks-error "expected ~A but got ~A" uri a))
+ (when (and lname (not (equal b lname)))
+ (klacks-error "expected ~A but got ~A" lname b))
+ (multiple-value-prog1
+ (funcall fn)
+ (klacks:skip source :end-element a b))))
+
+(defmacro klacks:expecting-element ((source &optional lname uri) &body body)
+ `(invoke-expecting-element (lambda () ,@body) ,source ,lname ,uri))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/package.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/package.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/package.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,60 @@
+;;; -*- Mode: Lisp; readtable: runes; -*-
+;;; (c) copyright 2007 David Lichteblau
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+(defpackage klacks
+ (:use)
+ (:export #:source
+ #:close-source
+ #:with-open-source
+ #:tapping-source
+ #:make-tapping-source
+
+ #:peek
+ #:peek-value
+ #:peek-next
+ #:consume
+
+ #:expect
+ #:skip
+ #:find-element
+ #:find-event
+ #:expecting-element
+
+ #:map-attributes
+ #:list-attributes
+ #:get-attribute
+ #:current-uri
+ #:current-lname
+ #:current-qname
+ #:current-characters
+ #:current-cdata-section-p
+ #:map-current-namespace-declarations
+
+ #:serialize-event
+ #:serialize-element
+ #:serialize-source
+
+ #:klacks-error
+
+ #:current-line-number
+ #:current-column-number
+ #:current-system-id
+ #:current-xml-base
+
+ #:find-namespace-binding
+ #:decode-qname))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/tap-source.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/tap-source.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/klacks/tap-source.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,106 @@
+;;; -*- Mode: Lisp; readtable: runes; -*-
+;;; (c) copyright 2007 David Lichteblau
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+(in-package :cxml)
+
+(defun klacks:make-tapping-source (upstream-source &optional sax-handler)
+ (make-instance 'klacks:tapping-source
+ :upstream-source upstream-source
+ :dribble-handler sax-handler))
+
+(defclass klacks:tapping-source (klacks:source)
+ ((upstream-source :initarg :upstream-source :accessor upstream-source)
+ (dribble-handler :initarg :dribble-handler :accessor dribble-handler)
+ (seen-event-p :initform nil :accessor seen-event-p)
+ (document-done-p :initform nil :accessor document-done-p)))
+
+(defmethod initialize-instance :after ((instance klacks:tapping-source) &key)
+ (let ((s-p (make-instance 'klacksax :source (upstream-source instance))))
+ (sax:register-sax-parser (dribble-handler instance) s-p)))
+
+
+;;; event dribbling
+
+(defun maybe-dribble (source)
+ (unless (or (seen-event-p source) (document-done-p source))
+ (when (eq (klacks:peek (upstream-source source)) :end-document)
+ (setf (document-done-p source) t))
+ (klacks:serialize-event (upstream-source source)
+ (dribble-handler source)
+ :consume nil)
+ (setf (seen-event-p source) t)))
+
+(defmethod klacks:peek ((source klacks:tapping-source))
+ (multiple-value-prog1
+ (klacks:peek (upstream-source source))
+ (maybe-dribble source)))
+
+(defmethod klacks:peek-value ((source klacks:tapping-source))
+ (multiple-value-prog1
+ (klacks:peek-value (upstream-source source))
+ (maybe-dribble source)))
+
+(defmethod klacks:peek-next ((source klacks:tapping-source))
+ (setf (seen-event-p source) nil)
+ (multiple-value-prog1
+ (klacks:peek-next (upstream-source source))
+ (maybe-dribble source)))
+
+(defmethod klacks:consume ((source klacks:tapping-source))
+ (maybe-dribble source)
+ (multiple-value-prog1
+ (klacks:consume (upstream-source source))
+ (setf (seen-event-p source) nil)))
+
+
+;;; loop through
+
+(defmethod klacks:close-source ((source klacks:tapping-source))
+ (klacks:close-source (upstream-source source)))
+
+(defmethod klacks:map-attributes (fn (source klacks:tapping-source))
+ (klacks:map-attributes fn (upstream-source source)))
+
+(defmethod klacks:map-current-namespace-declarations
+ (fn (source klacks:tapping-source))
+ (klacks:map-current-namespace-declarations fn (upstream-source source)))
+
+(defmethod klacks:list-attributes ((source klacks:tapping-source))
+ (klacks:list-attributes (upstream-source source)))
+
+(defmethod klacks:current-line-number ((source klacks:tapping-source))
+ (klacks:current-line-number (upstream-source source)))
+
+(defmethod klacks:current-column-number ((source klacks:tapping-source))
+ (klacks:current-column-number (upstream-source source)))
+
+(defmethod klacks:current-system-id ((source klacks:tapping-source))
+ (klacks:current-system-id (upstream-source source)))
+
+(defmethod klacks:current-xml-base ((source klacks:tapping-source))
+ (klacks:current-xml-base (upstream-source source)))
+
+(defmethod klacks:current-cdata-section-p ((source klacks:tapping-source))
+ (klacks:current-cdata-section-p (upstream-source source)))
+
+(defmethod klacks:find-namespace-binding
+ (prefix (source klacks:tapping-source))
+ (klacks:find-namespace-binding prefix (upstream-source source)))
+
+(defmethod klacks:decode-qname (qname (source klacks:tapping-source))
+ (klacks:decode-qname qname (upstream-source source)))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/mlisp-patch.diff
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/mlisp-patch.diff 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/mlisp-patch.diff 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,68 @@
+--- xml/xml-parse.lisp
++++ xml/xml-parse.lisp
+@@ -2497,20 +2497,20 @@
+ (let ((input-var (gensym))
+ (collect (gensym))
+ (c (gensym)))
+- `(LET ((,input-var ,input))
+- (MULTIPLE-VALUE-BIND (,res ,res-start ,res-end)
+- (WITH-RUNE-COLLECTOR/RAW (,collect)
+- (LOOP
+- (LET ((,c (PEEK-RUNE ,input-var)))
+- (COND ((EQ ,c :EOF)
++ `(let ((,input-var ,input))
++ (multiple-value-bind (,res ,res-start ,res-end)
++ (with-rune-collector/raw (,collect)
++ (loop
++ (let ((,c (peek-rune ,input-var)))
++ (cond ((eq ,c :eof)
+ ;; xxx error message
+- (RETURN))
+- ((FUNCALL ,predicate ,c)
+- (RETURN))
++ (return))
++ ((funcall ,predicate ,c)
++ (return))
+ (t
+ (,collect ,c)
+- (CONSUME-RUNE ,input-var))))))
+- (LOCALLY
++ (consume-rune ,input-var))))))
++ (locally
+ ,@body)))))
+
+ (defun read-name-token (input)
+
+
+
+Index: xml/xml-name-rune-p.lisp
+===================================================================
+RCS file: /project/cxml/cvsroot/cxml/xml/xml-name-rune-p.lisp,v
+retrieving revision 1.2
+diff -r1.2 xml-name-rune-p.lisp
+214,225c214,225
+< (DEFINLINE NAME-RUNE-P (RUNE)
+< (SETF RUNE (RUNE-CODE RUNE))
+< (AND (<= 0 RUNE ,*max*)
+< (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
+< (= 1 (SBIT ',(predicate-to-bv #'name-rune-p)
+< (THE FIXNUM RUNE))))))
+< (DEFINLINE NAME-START-RUNE-P (RUNE)
+< (SETF RUNE (RUNE-CODE RUNE))
+< (AND (<= 0 RUNE ,*MAX*)
+< (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
+< (= 1 (SBIT ',(predicate-to-bv #'name-start-rune-p)
+< (THE FIXNUM RUNE)))))))) ))))
+---
+> (definline name-rune-p (rune)
+> (setf rune (rune-code rune))
+> (and (<= 0 rune ,*max*)
+> (locally (declare (optimize (safety 0) (speed 3)))
+> (= 1 (sbit ',(predicate-to-bv #'name-rune-p)
+> (the fixnum rune))))))
+> (definline name-start-rune-p (rune)
+> (setf rune (rune-code rune))
+> (and (<= 0 rune ,*max*)
+> (locally (declare (optimize (safety 0) (speed 3)))
+> (= 1 (sbit ',(predicate-to-bv #'name-start-rune-p)
+> (the fixnum rune)))))))) ))))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Entries 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Entries 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,12 @@
+/characters.lisp/1.5/Tue Dec 27 20:01:16 2005//
+/definline.lisp/1.2/Mon Nov 28 22:33:35 2005//
+/encodings-data.lisp/1.2/Sun Nov 27 17:19:12 2005//
+/encodings.lisp/1.7/Sun Jul 22 19:59:26 2007//
+/package.lisp/1.9/Sat Jun 30 21:22:24 2007//
+/runes.lisp/1.4/Mon Nov 28 22:33:35 2005//
+/stream-scl.lisp/1.1/Sat Jun 16 11:27:19 2007//
+/syntax.lisp/1.2/Mon Nov 28 22:33:35 2005//
+/utf8.lisp/1.3/Sat May 26 21:55:58 2007//
+/xstream.lisp/1.6/Sun Sep 10 14:55:29 2006//
+/ystream.lisp/1.6/Sat Jun 16 11:27:19 2007//
+D
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Repository 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Repository 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+cxml/runes
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Root 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/CVS/Root 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cxml/cvsroot
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/characters.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/characters.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/characters.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,148 @@
+;;; copyright (c) 2004 knowledgeTools Int. GmbH
+;;; Author of this version: David Lichteblau <david(a)knowledgetools.de>
+;;;
+;;; derived from runes.lisp, (c) copyright 1998,1999 by Gilbert Baumann
+;;;
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;;
+;;; This code is free software; you can redistribute it and/or modify it
+;;; under the terms of the version 2.1 of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation, as clarified
+;;; by the "Preamble to the Gnu Lesser General Public License" found in
+;;; the file COPYING.
+;;;
+;;; This code is distributed in the hope that it will be useful,
+;;; but without any warranty; without even the implied warranty of
+;;; merchantability or fitness for a particular purpose. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; Version 2.1 of the GNU Lesser General Public License is in the file
+;;; COPYING that was distributed with this file. If it is not present,
+;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
+;;; superseded by a newer version) or write to the Free Software
+;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+(in-package :runes)
+
+(deftype rune () #-lispworks 'character #+lispworks 'lw:simple-char)
+(deftype rod () '(vector rune))
+(deftype simple-rod () '(simple-array rune))
+
+(definline rune (rod index)
+ (char rod index))
+
+(defun (setf rune) (new rod index)
+ (setf (char rod index) new))
+
+(definline %rune (rod index)
+ (aref (the simple-string rod) (the fixnum index)))
+
+(definline (setf %rune) (new rod index)
+ (setf (aref (the simple-string rod) (the fixnum index)) new))
+
+(defun rod-capitalize (rod)
+ (string-upcase rod))
+
+(definline code-rune (x) (code-char x))
+(definline rune-code (x) (char-code x))
+
+(definline rune= (x y)
+ (char= x y))
+
+(defun rune-downcase (rune)
+ (char-downcase rune))
+
+(definline rune-upcase (rune)
+ (char-upcase rune))
+
+(defun rune-upper-case-letter-p (rune)
+ (upper-case-p rune))
+
+(defun rune-lower-case-letter-p (rune)
+ (lower-case-p rune))
+
+(defun rune-equal (x y)
+ (char-equal x y))
+
+(defun rod-downcase (rod)
+ (string-downcase rod))
+
+(defun rod-upcase (rod)
+ (string-upcase rod))
+
+(definline white-space-rune-p (char)
+ (or (char= char #\tab)
+ (char= char #.(code-char 10)) ;Linefeed
+ (char= char #.(code-char 13)) ;Carriage Return
+ (char= char #\space)))
+
+(definline digit-rune-p (char &optional (radix 10))
+ (digit-char-p char radix))
+
+(defun rod (x)
+ (cond
+ ((stringp x) x)
+ ((symbolp x) (string x))
+ ((characterp x) (string x))
+ ((vectorp x) (coerce x 'string))
+ ((integerp x) (string (code-char x)))
+ (t (error "Cannot convert ~S to a ~S" x 'rod))))
+
+(defun runep (x)
+ (characterp x))
+
+(defun sloopy-rod-p (x)
+ (stringp x))
+
+(defun rod= (x y)
+ (if (zerop (length x))
+ (zerop (length y))
+ (and (plusp (length y)) (string= x y))))
+
+(defun rod-equal (x y)
+ (string-equal x y))
+
+(definline make-rod (size)
+ (make-string size :element-type 'rune))
+
+(defun char-rune (char)
+ char)
+
+(defun rune-char (rune &optional default)
+ (declare (ignore default))
+ rune)
+
+(defun rod-string (rod &optional (default-char #\?))
+ (declare (ignore default-char))
+ rod)
+
+(defun string-rod (string)
+ string)
+
+;;;;
+
+(defun rune<= (rune &rest more-runes)
+ (loop
+ for (a b) on (cons rune more-runes)
+ while b
+ always (char<= a b)))
+
+(defun rune>= (rune &rest more-runes)
+ (loop
+ for (a b) on (cons rune more-runes)
+ while b
+ always (char>= a b)))
+
+(defun rodp (object)
+ (stringp object))
+
+(defun rod-subseq (source start &optional (end (length source)))
+ (unless (stringp source)
+ (error "~S is not of type ~S." source 'rod))
+ (subseq source start end))
+
+(defun rod-subseq* (source start &optional (end (length source)))
+ (rod-subseq source start end))
+
+(defun rod< (rod1 rod2)
+ (string< rod1 rod2))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/definline.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/definline.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/definline.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,63 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: definline
+;;; Created: 1999-05-25 22:32
+;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1999 by Gilbert Baumann
+
+;;; This code is free software; you can redistribute it and/or modify it
+;;; under the terms of the version 2.1 of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation, as clarified
+;;; by the "Preamble to the Gnu Lesser General Public License" found in
+;;; the file COPYING.
+;;;
+;;; This code is distributed in the hope that it will be useful,
+;;; but without any warranty; without even the implied warranty of
+;;; merchantability or fitness for a particular purpose. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; Version 2.1 of the GNU Lesser General Public License is in the file
+;;; COPYING that was distributed with this file. If it is not present,
+;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
+;;; superseded by a newer version) or write to the Free Software
+;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+(in-package :runes)
+
+#-(or allegro openmcl)
+(defmacro definline (name args &body body)
+ `(progn
+ (declaim (inline ,name))
+ (defun ,name ,args .,body)))
+
+#+openmcl
+(defmacro runes::definline (fun args &body body)
+ (if (consp fun)
+ `(defun ,fun ,args
+ ,@body)
+ `(progn
+ (defun ,fun ,args .,body)
+ (define-compiler-macro ,fun (&rest .args.)
+ (cons '(lambda ,args .,body)
+ .args.)))))
+
+#+allegro
+(defmacro definline (fun args &body body)
+ (if (and (consp fun) (eq (car fun) 'setf))
+ (let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")")
+ (symbol-package (cadr fun)))))
+ `(progn
+ (defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap))
+ (definline ,fnam ,args .,body)))
+ (labels ((declp (x)
+ (and (consp x) (eq (car x) 'declare))))
+ `(progn
+ (defun ,fun ,args .,body)
+ (define-compiler-macro ,fun (&rest .args.)
+ (cons '(lambda ,args
+ ,@(remove-if-not #'declp body)
+ (block ,fun
+ ,@(remove-if #'declp body)))
+ .args.))))))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/encodings-data.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/encodings-data.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/encodings-data.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,568 @@
+(in-package :runes-encoding)
+
+(progn
+ (add-name :us-ascii "ANSI_X3.4-1968")
+ (add-name :us-ascii "iso-ir-6")
+ (add-name :us-ascii "ANSI_X3.4-1986")
+ (add-name :us-ascii "ISO_646.irv:1991")
+ (add-name :us-ascii "ASCII")
+ (add-name :us-ascii "ISO646-US")
+ (add-name :us-ascii "US-ASCII")
+ (add-name :us-ascii "us")
+ (add-name :us-ascii "IBM367")
+ (add-name :us-ascii "cp367")
+ (add-name :us-ascii "csASCII")
+
+ (add-name :iso-8859-1 "ISO_8859-1:1987")
+ (add-name :iso-8859-1 "iso-ir-100")
+ (add-name :iso-8859-1 "ISO_8859-1")
+ (add-name :iso-8859-1 "ISO-8859-1")
+ (add-name :iso-8859-1 "latin1")
+ (add-name :iso-8859-1 "l1")
+ (add-name :iso-8859-1 "IBM819")
+ (add-name :iso-8859-1 "CP819")
+ (add-name :iso-8859-1 "csISOLatin1")
+
+ (add-name :iso-8859-2 "ISO_8859-2:1987")
+ (add-name :iso-8859-2 "iso-ir-101")
+ (add-name :iso-8859-2 "ISO_8859-2")
+ (add-name :iso-8859-2 "ISO-8859-2")
+ (add-name :iso-8859-2 "latin2")
+ (add-name :iso-8859-2 "l2")
+ (add-name :iso-8859-2 "csISOLatin2")
+
+ (add-name :iso-8859-3 "ISO_8859-3:1988")
+ (add-name :iso-8859-3 "iso-ir-109")
+ (add-name :iso-8859-3 "ISO_8859-3")
+ (add-name :iso-8859-3 "ISO-8859-3")
+ (add-name :iso-8859-3 "latin3")
+ (add-name :iso-8859-3 "l3")
+ (add-name :iso-8859-3 "csISOLatin3")
+
+ (add-name :iso-8859-4 "ISO_8859-4:1988")
+ (add-name :iso-8859-4 "iso-ir-110")
+ (add-name :iso-8859-4 "ISO_8859-4")
+ (add-name :iso-8859-4 "ISO-8859-4")
+ (add-name :iso-8859-4 "latin4")
+ (add-name :iso-8859-4 "l4")
+ (add-name :iso-8859-4 "csISOLatin4")
+
+ (add-name :iso-8859-6 "ISO_8859-6:1987")
+ (add-name :iso-8859-6 "iso-ir-127")
+ (add-name :iso-8859-6 "ISO_8859-6")
+ (add-name :iso-8859-6 "ISO-8859-6")
+ (add-name :iso-8859-6 "ECMA-114")
+ (add-name :iso-8859-6 "ASMO-708")
+ (add-name :iso-8859-6 "arabic")
+ (add-name :iso-8859-6 "csISOLatinArabic")
+
+ (add-name :iso-8859-7 "ISO_8859-7:1987")
+ (add-name :iso-8859-7 "iso-ir-126")
+ (add-name :iso-8859-7 "ISO_8859-7")
+ (add-name :iso-8859-7 "ISO-8859-7")
+ (add-name :iso-8859-7 "ELOT_928")
+ (add-name :iso-8859-7 "ECMA-118")
+ (add-name :iso-8859-7 "greek")
+ (add-name :iso-8859-7 "greek8")
+ (add-name :iso-8859-7 "csISOLatinGreek")
+
+ (add-name :iso-8859-8 "ISO_8859-8:1988")
+ (add-name :iso-8859-8 "iso-ir-138")
+ (add-name :iso-8859-8 "ISO_8859-8")
+ (add-name :iso-8859-8 "ISO-8859-8")
+ (add-name :iso-8859-8 "hebrew")
+ (add-name :iso-8859-8 "csISOLatinHebrew")
+
+ (add-name :iso-8859-5 "ISO_8859-5:1988")
+ (add-name :iso-8859-5 "iso-ir-144")
+ (add-name :iso-8859-5 "ISO_8859-5")
+ (add-name :iso-8859-5 "ISO-8859-5")
+ (add-name :iso-8859-5 "cyrillic")
+ (add-name :iso-8859-5 "csISOLatinCyrillic")
+
+ (add-name :iso-8859-9 "ISO_8859-9:1989")
+ (add-name :iso-8859-9 "iso-ir-148")
+ (add-name :iso-8859-9 "ISO_8859-9")
+ (add-name :iso-8859-9 "ISO-8859-9")
+ (add-name :iso-8859-9 "latin5")
+ (add-name :iso-8859-9 "l5")
+ (add-name :iso-8859-9 "csISOLatin5")
+
+ (add-name :iso-8859-15 "ISO_8859-15")
+ (add-name :iso-8859-15 "ISO-8859-15")
+
+ (add-name :iso-8859-14 "ISO_8859-14")
+ (add-name :iso-8859-14 "ISO-8859-14")
+
+ (add-name :koi8-r "KOI8-R")
+ (add-name :koi8-r "csKOI8R")
+
+ (add-name :utf-8 "UTF-8")
+
+ (add-name :utf-16 "UTF-16")
+
+ (add-name :ucs-4 "ISO-10646-UCS-4")
+ (add-name :ucs-4 "UCS-4")
+
+ (add-name :ucs-2 "ISO-10646-UCS-2")
+ (add-name :ucs-2 "UCS-2") )
+
+
+(progn
+ (define-encoding :iso-8859-1
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-1)))
+
+ (define-encoding :iso-8859-2
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-2)))
+
+ (define-encoding :iso-8859-3
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-3)))
+
+ (define-encoding :iso-8859-4
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-4)))
+
+ (define-encoding :iso-8859-5
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-5)))
+
+ (define-encoding :iso-8859-6
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-6)))
+
+ (define-encoding :iso-8859-7
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-7)))
+
+ (define-encoding :iso-8859-8
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-8)))
+
+ (define-encoding :iso-8859-14
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-14)))
+
+ (define-encoding :iso-8859-15
+ (make-simple-8-bit-encoding
+ :charset (find-charset :iso-8859-15)))
+
+ (define-encoding :koi8-r
+ (make-simple-8-bit-encoding
+ :charset (find-charset :koi8-r)))
+
+ (define-encoding :utf-8 :utf-8)
+ )
+
+(progn
+ (define-8-bit-charset :iso-8859-1
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x00A1 #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7
+ #| #o25x |# #x00A8 #x00A9 #x00AA #x00AB #x00AC #x00AD #x00AE #x00AF
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7
+ #| #o27x |# #x00B8 #x00B9 #x00BA #x00BB #x00BC #x00BD #x00BE #x00BF
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #x00D0 #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x00D7
+ #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x00DD #x00DE #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #x00F0 #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x00F7
+ #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x00FD #x00FE #x00FF)
+
+ (define-8-bit-charset :iso-8859-2
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x0104 #x02D8 #x0141 #x00A4 #x013D #x015A #x00A7
+ #| #o25x |# #x00A8 #x0160 #x015E #x0164 #x0179 #x00AD #x017D #x017B
+ #| #o26x |# #x00B0 #x0105 #x02DB #x0142 #x00B4 #x013E #x015B #x02C7
+ #| #o27x |# #x00B8 #x0161 #x015F #x0165 #x017A #x02DD #x017E #x017C
+ #| #o30x |# #x0154 #x00C1 #x00C2 #x0102 #x00C4 #x0139 #x0106 #x00C7
+ #| #o31x |# #x010C #x00C9 #x0118 #x00CB #x011A #x00CD #x00CE #x010E
+ #| #o32x |# #x0110 #x0143 #x0147 #x00D3 #x00D4 #x0150 #x00D6 #x00D7
+ #| #o33x |# #x0158 #x016E #x00DA #x0170 #x00DC #x00DD #x0162 #x00DF
+ #| #o34x |# #x0155 #x00E1 #x00E2 #x0103 #x00E4 #x013A #x0107 #x00E7
+ #| #o35x |# #x010D #x00E9 #x0119 #x00EB #x011B #x00ED #x00EE #x010F
+ #| #o36x |# #x0111 #x0144 #x0148 #x00F3 #x00F4 #x0151 #x00F6 #x00F7
+ #| #o37x |# #x0159 #x016F #x00FA #x0171 #x00FC #x00FD #x0163 #x02D9)
+
+ (define-8-bit-charset :iso-8859-3
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x0126 #x02D8 #x00A3 #x00A4 #xFFFF #x0124 #x00A7
+ #| #o25x |# #x00A8 #x0130 #x015E #x011E #x0134 #x00AD #xFFFF #x017B
+ #| #o26x |# #x00B0 #x0127 #x00B2 #x00B3 #x00B4 #x00B5 #x0125 #x00B7
+ #| #o27x |# #x00B8 #x0131 #x015F #x011F #x0135 #x00BD #xFFFF #x017C
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #xFFFF #x00C4 #x010A #x0108 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #xFFFF #x00D1 #x00D2 #x00D3 #x00D4 #x0120 #x00D6 #x00D7
+ #| #o33x |# #x011C #x00D9 #x00DA #x00DB #x00DC #x016C #x015C #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #xFFFF #x00E4 #x010B #x0109 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #xFFFF #x00F1 #x00F2 #x00F3 #x00F4 #x0121 #x00F6 #x00F7
+ #| #o37x |# #x011D #x00F9 #x00FA #x00FB #x00FC #x016D #x015D #x02D9)
+
+ (define-8-bit-charset :iso-8859-4
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x0104 #x0138 #x0156 #x00A4 #x0128 #x013B #x00A7
+ #| #o25x |# #x00A8 #x0160 #x0112 #x0122 #x0166 #x00AD #x017D #x00AF
+ #| #o26x |# #x00B0 #x0105 #x02DB #x0157 #x00B4 #x0129 #x013C #x02C7
+ #| #o27x |# #x00B8 #x0161 #x0113 #x0123 #x0167 #x014A #x017E #x014B
+ #| #o30x |# #x0100 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x012E
+ #| #o31x |# #x010C #x00C9 #x0118 #x00CB #x0116 #x00CD #x00CE #x012A
+ #| #o32x |# #x0110 #x0145 #x014C #x0136 #x00D4 #x00D5 #x00D6 #x00D7
+ #| #o33x |# #x00D8 #x0172 #x00DA #x00DB #x00DC #x0168 #x016A #x00DF
+ #| #o34x |# #x0101 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x012F
+ #| #o35x |# #x010D #x00E9 #x0119 #x00EB #x0117 #x00ED #x00EE #x012B
+ #| #o36x |# #x0111 #x0146 #x014D #x0137 #x00F4 #x00F5 #x00F6 #x00F7
+ #| #o37x |# #x00F8 #x0173 #x00FA #x00FB #x00FC #x0169 #x016B #x02D9)
+
+ (define-8-bit-charset :iso-8859-5
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x0401 #x0402 #x0403 #x0404 #x0405 #x0406 #x0407
+ #| #o25x |# #x0408 #x0409 #x040A #x040B #x040C #x00AD #x040E #x040F
+ #| #o26x |# #x0410 #x0411 #x0412 #x0413 #x0414 #x0415 #x0416 #x0417
+ #| #o27x |# #x0418 #x0419 #x041A #x041B #x041C #x041D #x041E #x041F
+ #| #o30x |# #x0420 #x0421 #x0422 #x0423 #x0424 #x0425 #x0426 #x0427
+ #| #o31x |# #x0428 #x0429 #x042A #x042B #x042C #x042D #x042E #x042F
+ #| #o32x |# #x0430 #x0431 #x0432 #x0433 #x0434 #x0435 #x0436 #x0437
+ #| #o33x |# #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E #x043F
+ #| #o34x |# #x0440 #x0441 #x0442 #x0443 #x0444 #x0445 #x0446 #x0447
+ #| #o35x |# #x0448 #x0449 #x044A #x044B #x044C #x044D #x044E #x044F
+ #| #o36x |# #x2116 #x0451 #x0452 #x0453 #x0454 #x0455 #x0456 #x0457
+ #| #o37x |# #x0458 #x0459 #x045A #x045B #x045C #x00A7 #x045E #x045F)
+
+ (define-8-bit-charset :iso-8859-6
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0660 #x0661 #x0662 #x0663 #x0664 #x0665 #x0666 #x0667
+ #| #o07x |# #x0668 #x0669 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #xFFFF #xFFFF #xFFFF #x00A4 #xFFFF #xFFFF #xFFFF
+ #| #o25x |# #xFFFF #xFFFF #xFFFF #xFFFF #x060C #x00AD #xFFFF #xFFFF
+ #| #o26x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o27x |# #xFFFF #xFFFF #xFFFF #x061B #xFFFF #xFFFF #xFFFF #x061F
+ #| #o30x |# #xFFFF #x0621 #x0622 #x0623 #x0624 #x0625 #x0626 #x0627
+ #| #o31x |# #x0628 #x0629 #x062A #x062B #x062C #x062D #x062E #x062F
+ #| #o32x |# #x0630 #x0631 #x0632 #x0633 #x0634 #x0635 #x0636 #x0637
+ #| #o33x |# #x0638 #x0639 #x063A #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o34x |# #x0640 #x0641 #x0642 #x0643 #x0644 #x0645 #x0646 #x0647
+ #| #o35x |# #x0648 #x0649 #x064A #x064B #x064C #x064D #x064E #x064F
+ #| #o36x |# #x0650 #x0651 #x0652 #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o37x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF)
+
+ (define-8-bit-charset :iso-8859-7
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x02BD #x02BC #x00A3 #xFFFF #xFFFF #x00A6 #x00A7
+ #| #o25x |# #x00A8 #x00A9 #xFFFF #x00AB #x00AC #x00AD #xFFFF #x2015
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x0384 #x0385 #x0386 #x00B7
+ #| #o27x |# #x0388 #x0389 #x038A #x00BB #x038C #x00BD #x038E #x038F
+ #| #o30x |# #x0390 #x0391 #x0392 #x0393 #x0394 #x0395 #x0396 #x0397
+ #| #o31x |# #x0398 #x0399 #x039A #x039B #x039C #x039D #x039E #x039F
+ #| #o32x |# #x03A0 #x03A1 #xFFFF #x03A3 #x03A4 #x03A5 #x03A6 #x03A7
+ #| #o33x |# #x03A8 #x03A9 #x03AA #x03AB #x03AC #x03AD #x03AE #x03AF
+ #| #o34x |# #x03B0 #x03B1 #x03B2 #x03B3 #x03B4 #x03B5 #x03B6 #x03B7
+ #| #o35x |# #x03B8 #x03B9 #x03BA #x03BB #x03BC #x03BD #x03BE #x03BF
+ #| #o36x |# #x03C0 #x03C1 #x03C2 #x03C3 #x03C4 #x03C5 #x03C6 #x03C7
+ #| #o37x |# #x03C8 #x03C9 #x03CA #x03CB #x03CC #x03CD #x03CE #xFFFF)
+
+ (define-8-bit-charset :iso-8859-8
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #xFFFF #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7
+ #| #o25x |# #x00A8 #x00A9 #x00D7 #x00AB #x00AC #x00AD #x00AE #x203E
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7
+ #| #o27x |# #x00B8 #x00B9 #x00F7 #x00BB #x00BC #x00BD #x00BE #xFFFF
+ #| #o30x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o31x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o32x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o33x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #x2017
+ #| #o34x |# #x05D0 #x05D1 #x05D2 #x05D3 #x05D4 #x05D5 #x05D6 #x05D7
+ #| #o35x |# #x05D8 #x05D9 #x05DA #x05DB #x05DC #x05DD #x05DE #x05DF
+ #| #o36x |# #x05E0 #x05E1 #x05E2 #x05E3 #x05E4 #x05E5 #x05E6 #x05E7
+ #| #o37x |# #x05E8 #x05E9 #x05EA #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF)
+
+ (define-8-bit-charset :iso-8859-9
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x00A1 #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7
+ #| #o25x |# #x00A8 #x00A9 #x00AA #x00AB #x00AC #x00AD #x00AE #x00AF
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7
+ #| #o27x |# #x00B8 #x00B9 #x00BA #x00BB #x00BC #x00BD #x00BE #x00BF
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #x011E #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x00D7
+ #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x0130 #x015E #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #x011F #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x00F7
+ #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x0131 #x015F #x00FF)
+
+ (define-8-bit-charset :iso-8859-14
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x1E02 #x1E03 #x00A3 #x010A #x010B #x1E0A #x00A7
+ #| #o25x |# #x1E80 #x00A9 #x1E82 #x1E0B #x1EF2 #x00AD #x00AE #x0178
+ #| #o26x |# #x1E1E #x1E1F #x0120 #x0121 #x1E40 #x1E41 #x00B6 #x1E56
+ #| #o27x |# #x1E81 #x1E57 #x1E83 #x1E60 #x1EF3 #x1E84 #x1E85 #x1E61
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #x0174 #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x1E6A
+ #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x00DD #x0176 #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #x0175 #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x1E6B
+ #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x00FD #x0177 #x00FF)
+
+ (define-8-bit-charset :iso-8859-15
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF
+ #| #o24x |# #x00A0 #x00A1 #x00A2 #x00A3 #x20AC #x00A5 #x0160 #x00A7
+ #| #o25x |# #x0161 #x00A9 #x00AA #x00AB #x00AC #x00AD #x00AE #x00AF
+ #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x017D #x00B5 #x00B6 #x00B7
+ #| #o27x |# #x017E #x00B9 #x00BA #x00BB #x0152 #x0153 #x0178 #x00BF
+ #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7
+ #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF
+ #| #o32x |# #x00D0 #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x00D7
+ #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x00DD #x00DE #x00DF
+ #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7
+ #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF
+ #| #o36x |# #x00F0 #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x00F7
+ #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x00FD #x00FE #x00FF)
+
+ (define-8-bit-charset :koi8-r
+ #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007
+ #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F
+ #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017
+ #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F
+ #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027
+ #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F
+ #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037
+ #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F
+ #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047
+ #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F
+ #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057
+ #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F
+ #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067
+ #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F
+ #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077
+ #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F
+ #| #o20x |# #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524
+ #| #o21x |# #x252C #x2534 #x253C #x2580 #x2584 #x2588 #x258C #x2590
+ #| #o22x |# #x2591 #x2592 #x2593 #x2320 #x25A0 #x2219 #x221A #x2248
+ #| #o23x |# #x2264 #x2265 #x00A0 #x2321 #x00B0 #x00B2 #x00B7 #x00F7
+ #| #o24x |# #x2550 #x2551 #x2552 #x0451 #x2553 #x2554 #x2555 #x2556
+ #| #o25x |# #x2557 #x2558 #x2559 #x255A #x255B #x255C #x255D #x255E
+ #| #o26x |# #x255F #x2560 #x2561 #x0401 #x2562 #x2563 #x2564 #x2565
+ #| #o27x |# #x2566 #x2567 #x2568 #x2569 #x256A #x256B #x256C #x00A9
+ #| #o30x |# #x044E #x0430 #x0431 #x0446 #x0434 #x0435 #x0444 #x0433
+ #| #o31x |# #x0445 #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E
+ #| #o32x |# #x043F #x044F #x0440 #x0441 #x0442 #x0443 #x0436 #x0432
+ #| #o33x |# #x044C #x044B #x0437 #x0448 #x044D #x0449 #x0447 #x044A
+ #| #o34x |# #x042E #x0410 #x0411 #x0426 #x0414 #x0415 #x0424 #x0413
+ #| #o35x |# #x0425 #x0418 #x0419 #x041A #x041B #x041C #x041D #x041E
+ #| #o36x |# #x041F #x042F #x0420 #x0421 #x0422 #x0423 #x0416 #x0412
+ #| #o37x |# #x042C #x042B #x0417 #x0428 #x042D #x0429 #x0427 #x042A)
+ )
+
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/encodings.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/encodings.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/encodings.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,396 @@
+(in-package :runes-encoding)
+
+(define-condition encoding-error (simple-error) ())
+
+(defun xerror (fmt &rest args)
+ (error 'encoding-error :format-control fmt :format-arguments args))
+
+;;;; ---------------------------------------------------------------------------
+;;;; Encoding names
+;;;;
+
+(defvar *names* (make-hash-table :test #'eq))
+
+(defun canon-name (string)
+ (with-output-to-string (bag)
+ (map nil (lambda (ch)
+ (cond ((char= ch #\_) (write-char #\- bag))
+ (t (write-char (char-upcase ch) bag))))
+ string)))
+
+(defun canon-name-2 (string)
+ (with-output-to-string (bag)
+ (map nil (lambda (ch)
+ (cond ((char= ch #\_))
+ ((char= ch #\-))
+ (t (write-char (char-upcase ch) bag))))
+ string)))
+
+(defmethod encoding-names ((encoding symbol))
+ (gethash encoding *names*))
+
+(defmethod (setf encoding-names) (new-value (encoding symbol))
+ (setf (gethash encoding *names*) new-value))
+
+(defun add-name (encoding name)
+ (pushnew (canon-name name) (encoding-names encoding) :test #'string=))
+
+(defun resolve-name (string)
+ (cond ((symbolp string)
+ string)
+ (t
+ (setq string (canon-name string))
+ (or
+ (block nil
+ (maphash (lambda (x y)
+ (when (member string y :test #'string=)
+ (return x)))
+ *names*)
+ nil)
+ (block nil
+ (maphash (lambda (x y)
+ (when (member string y
+ :test #'(lambda (x y)
+ (string= (canon-name-2 x)
+ (canon-name-2 y))))
+ (return x)))
+ *names*)
+ nil)))))
+
+;;;; ---------------------------------------------------------------------------
+;;;; Encodings
+;;;;
+
+(defvar *encodings* (make-hash-table :test #'eq))
+
+(defmacro define-encoding (name init-form)
+ `(progn
+ (setf (gethash ',name *encodings*)
+ (list nil (lambda () ,init-form)))
+ ',name))
+
+(defun find-encoding (name)
+ (let ((x (gethash (resolve-name name) *encodings*)))
+ (and x
+ (or (first x)
+ (setf (first x) (funcall (second x)))))))
+
+(defclass encoding () ())
+
+(defclass simple-8-bit-encoding (encoding)
+ ((table :initarg :table)))
+
+(defun make-simple-8-bit-encoding (&key charset)
+ (make-instance 'simple-8-bit-encoding
+ :table (coerce (to-unicode-table charset) '(simple-array (unsigned-byte 16) (256)))))
+
+;;;;;;;
+
+(defmacro fx-op (op &rest xs)
+ `(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))))
+(defmacro fx-pred (op &rest xs)
+ `(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))
+
+(defmacro %+ (&rest xs) `(fx-op + ,@xs))
+(defmacro %- (&rest xs) `(fx-op - ,@xs))
+(defmacro %* (&rest xs) `(fx-op * ,@xs))
+(defmacro %/ (&rest xs) `(fx-op floor ,@xs))
+(defmacro %and (&rest xs) `(fx-op logand ,@xs))
+(defmacro %ior (&rest xs) `(fx-op logior ,@xs))
+(defmacro %xor (&rest xs) `(fx-op logxor ,@xs))
+(defmacro %ash (&rest xs) `(fx-op ash ,@xs))
+(defmacro %mod (&rest xs) `(fx-op mod ,@xs))
+
+(defmacro %= (&rest xs) `(fx-pred = ,@xs))
+(defmacro %<= (&rest xs) `(fx-pred <= ,@xs))
+(defmacro %>= (&rest xs) `(fx-pred >= ,@xs))
+(defmacro %< (&rest xs) `(fx-pred < ,@xs))
+(defmacro %> (&rest xs) `(fx-pred > ,@xs))
+
+;;; Decoders
+
+;; The decoders share a common signature:
+;;
+;; DECODE input input-start input-end
+;; output output-start output-end
+;; eof-p
+;; -> first-not-written ; first-not-read
+;;
+;; These decode functions should decode as much characters off `input'
+;; into the `output' as possible and return the indexes to the first
+;; not read and first not written element of `input' and `output'
+;; respectively. If there are not enough bytes in `input' to decode a
+;; full character, decoding shold be abandomed; the caller has to
+;; ensure that the remaining bytes of `input' are passed to the
+;; decoder again with more bytes appended.
+;;
+;; `eof-p' now in turn indicates, if the given input sequence, is all
+;; the producer does have and might be used to produce error messages
+;; in case of incomplete codes or decided what to do.
+;;
+;; Decoders are expected to handle the various CR/NL conventions and
+;; canonicalize each end of line into a single NL rune (#xA) in good
+;; old Lisp tradition.
+;;
+
+;; TODO: change this to an encoding class, which then might carry
+;; additional state. Stateless encodings could been represented by
+;; keywords. e.g.
+;;
+;; defmethod DECODE-SEQUENCE ((encoding (eql :utf-8)) ...)
+;;
+
+(defmethod decode-sequence ((encoding (eql :utf-16-big-endian))
+ in in-start in-end out out-start out-end eof?)
+ ;; -> new wptr, new rptr
+ (let ((wptr out-start)
+ (rptr in-start))
+ (loop
+ (when (%= wptr out-end)
+ (return))
+ (when (>= (%+ rptr 1) in-end)
+ (return))
+ (let ((hi (aref in rptr))
+ (lo (aref in (%+ 1 rptr))))
+ (setf rptr (%+ 2 rptr))
+ ;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste
+ ;; Zeichen abwarten und nachgucken, dass nicht etwa die andere
+ ;; Haelfte fehlt!
+ (let ((x (logior (ash hi 8) lo)))
+ (when (or (eql x #xFFFE) (eql x #xFFFF))
+ (xerror "not a valid code point: #x~X" x))
+ (setf (aref out wptr) x))
+ (setf wptr (%+ 1 wptr))))
+ (values wptr rptr)))
+
+(defmethod decode-sequence ((encoding (eql :utf-16-little-endian))
+ in in-start in-end out out-start out-end eof?)
+ ;; -> new wptr, new rptr
+ (let ((wptr out-start)
+ (rptr in-start))
+ (loop
+ (when (%= wptr out-end)
+ (return))
+ (when (>= (%+ rptr 1) in-end)
+ (return))
+ (let ((lo (aref in (%+ 0 rptr)))
+ (hi (aref in (%+ 1 rptr))))
+ (setf rptr (%+ 2 rptr))
+ ;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste
+ ;; Zeichen abwarten und nachgucken, dass nicht etwa die andere
+ ;; Haelfte fehlt!
+ (let ((x (logior (ash hi 8) lo)))
+ (when (or (eql x #xFFFE) (eql x #xFFFF))
+ (xerror "not a valid code point: #x~X" x))
+ (setf (aref out wptr) x))
+ (setf wptr (%+ 1 wptr))))
+ (values wptr rptr)))
+
+(defmethod decode-sequence ((encoding (eql :utf-8))
+ in in-start in-end out out-start out-end eof?)
+ (declare (optimize (speed 3) (safety 0))
+ (type (simple-array (unsigned-byte 8) (*)) in)
+ (type (simple-array (unsigned-byte 16) (*)) out)
+ (type fixnum in-start in-end out-start out-end))
+ (let ((wptr out-start)
+ (rptr in-start)
+ byte0)
+ (macrolet ((put (x)
+ `((lambda (x)
+ (when (or (<= #xD800 x #xDBFF)
+ (<= #xDC00 x #xDFFF))
+ (xerror "surrogate encoded in UTF-8: #x~X." x))
+ (cond ((or (%> x #x10FFFF)
+ (eql x #xFFFE)
+ (eql x #xFFFF))
+ (xerror "not a valid code point: #x~X" x))
+ ((%> x #xFFFF)
+ (setf (aref out (%+ 0 wptr)) (%+ #xD7C0 (ash x -10))
+ (aref out (%+ 1 wptr)) (%ior #xDC00 (%and x #x3FF)))
+ (setf wptr (%+ wptr 2)))
+ (t
+ (setf (aref out wptr) x)
+ (setf wptr (%+ wptr 1)))))
+ ,x))
+ (put1 (x)
+ `(progn
+ (setf (aref out wptr) ,x)
+ (setf wptr (%+ wptr 1)))))
+ (loop
+ (when (%= (+ wptr 1) out-end) (return))
+ (when (%>= rptr in-end) (return))
+ (setq byte0 (aref in rptr))
+ (cond ((= byte0 #x0D)
+ ;; CR handling
+ ;; we need to know the following character
+ (cond ((>= (%+ rptr 1) in-end)
+ ;; no characters in buffer
+ (cond (eof?
+ ;; at EOF, pass it as NL
+ (put #x0A)
+ (setf rptr (%+ rptr 1)))
+ (t
+ ;; demand more characters
+ (return))))
+ ((= (aref in (%+ rptr 1)) #x0A)
+ ;; we see CR NL, so forget this CR and the next NL will be
+ ;; inserted literally
+ (setf rptr (%+ rptr 1)))
+ (t
+ ;; singleton CR, pass it as NL
+ (put #x0A)
+ (setf rptr (%+ rptr 1)))))
+
+ ((%<= #|#b00000000|# byte0 #b01111111)
+ (put1 byte0)
+ (setf rptr (%+ rptr 1)))
+
+ ((%<= #|#b10000000|# byte0 #b10111111)
+ (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0)
+ (setf rptr (%+ rptr 1)))
+
+ ((%<= #|#b11000000|# byte0 #b11011111)
+ (cond ((<= (%+ rptr 2) in-end)
+ (put
+ (dpb (ldb (byte 5 0) byte0) (byte 5 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ rptr 1))) (byte 6 0)
+ 0)))
+ (setf rptr (%+ rptr 2)))
+ (t
+ (return))))
+
+ ((%<= #|#b11100000|# byte0 #b11101111)
+ (cond ((<= (%+ rptr 3) in-end)
+ (put
+ (dpb (ldb (byte 4 0) byte0) (byte 4 12)
+ (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 0)
+ 0))))
+ (setf rptr (%+ rptr 3)))
+ (t
+ (return))))
+
+ ((%<= #|#b11110000|# byte0 #b11110111)
+ (cond ((<= (%+ rptr 4) in-end)
+ (put
+ (dpb (ldb (byte 3 0) byte0) (byte 3 18)
+ (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 12)
+ (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ 3 rptr))) (byte 6 0)
+ 0)))))
+ (setf rptr (%+ rptr 4)))
+ (t
+ (return))))
+
+ ((%<= #|#b11111000|# byte0 #b11111011)
+ (cond ((<= (%+ rptr 5) in-end)
+ (put
+ (dpb (ldb (byte 2 0) byte0) (byte 2 24)
+ (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 18)
+ (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 12)
+ (dpb (ldb (byte 6 0) (aref in (%+ 3 rptr))) (byte 6 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ 4 rptr))) (byte 6 0)
+ 0))))))
+ (setf rptr (%+ rptr 5)))
+ (t
+ (return))))
+
+ ((%<= #|#b11111100|# byte0 #b11111101)
+ (cond ((<= (%+ rptr 6) in-end)
+ (put
+ (dpb (ldb (byte 1 0) byte0) (byte 1 30)
+ (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 24)
+ (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 18)
+ (dpb (ldb (byte 6 0) (aref in (%+ 3 rptr))) (byte 6 12)
+ (dpb (ldb (byte 6 0) (aref in (%+ 4 rptr))) (byte 6 6)
+ (dpb (ldb (byte 6 0) (aref in (%+ 5 rptr))) (byte 6 0)
+ 0)))))))
+ (setf rptr (%+ rptr 6)))
+ (t
+ (return))))
+
+ (t
+ (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0)) ) ))
+ (values wptr rptr)) )
+
+(defmethod encoding-p ((object (eql :utf-16-little-endian))) t)
+(defmethod encoding-p ((object (eql :utf-16-big-endian))) t)
+(defmethod encoding-p ((object (eql :utf-8))) t)
+
+(defmethod encoding-p ((object encoding)) t)
+
+(defmethod decode-sequence ((encoding simple-8-bit-encoding)
+ in in-start in-end
+ out out-start out-end
+ eof?)
+ (declare (optimize (speed 3) (safety 0))
+ (type (simple-array (unsigned-byte 8) (*)) in)
+ (type (simple-array (unsigned-byte 16) (*)) out)
+ (type fixnum in-start in-end out-start out-end))
+ (let ((wptr out-start)
+ (rptr in-start)
+ (byte 0)
+ (table (slot-value encoding 'table)))
+ (declare (type fixnum wptr rptr)
+ (type (unsigned-byte 8) byte)
+ (type (simple-array (unsigned-byte 16) (*)) table))
+ (loop
+ (when (%= wptr out-end) (return))
+ (when (%>= rptr in-end) (return))
+ (setq byte (aref in rptr))
+ (cond ((= byte #x0D)
+ ;; CR handling
+ ;; we need to know the following character
+ (cond ((>= (%+ rptr 1) in-end)
+ ;; no characters in buffer
+ (cond (eof?
+ ;; at EOF, pass it as NL
+ (setf (aref out wptr) #x0A)
+ (setf wptr (%+ wptr 1))
+ (setf rptr (%+ rptr 1)))
+ (t
+ ;; demand more characters
+ (return))))
+ ((= (aref in (%+ rptr 1)) #x0A)
+ ;; we see CR NL, so forget this CR and the next NL will be
+ ;; inserted literally
+ (setf rptr (%+ rptr 1)))
+ (t
+ ;; singleton CR, pass it as NL
+ (setf (aref out wptr) #x0A)
+ (setf wptr (%+ wptr 1))
+ (setf rptr (%+ rptr 1)))))
+
+ (t
+ (setf (aref out wptr) (aref table byte))
+ (setf wptr (%+ wptr 1))
+ (setf rptr (%+ rptr 1))) ))
+ (values wptr rptr)))
+
+;;;; ---------------------------------------------------------------------------
+;;;; Character sets
+;;;;
+
+(defvar *charsets* (make-hash-table :test #'eq))
+
+(defclass 8-bit-charset ()
+ ((name :initarg :name)
+ (to-unicode-table
+ :initarg :to-unicode-table
+ :reader to-unicode-table)))
+
+(defmacro define-8-bit-charset (name &rest codes)
+ (assert (= 256 (length codes)))
+ `(progn
+ (setf (gethash ',name *charsets*)
+ (make-instance '8-bit-charset
+ :name ',name
+ :to-unicode-table
+ ',(make-array 256
+ :element-type '(unsigned-byte 16)
+ :initial-contents codes)))
+ ',name))
+
+(defun find-charset (name)
+ (or (gethash name *charsets*)
+ (xerror "There is no character set named ~S." name)))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/package.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/package.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/package.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,99 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Generating a sane DEFPACKAGE for RUNES
+;;; Created: 1999-05-25
+;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1999,2000 by Gilbert Baumann
+
+(in-package :cl-user)
+
+(defpackage :runes
+ (:use :cl #-scl :trivial-gray-streams)
+ (:export #:definline
+
+ ;; runes.lisp
+ #:rune
+ #:rod
+ #:simple-rod
+ #:%rune
+ #:rod-capitalize
+ #:code-rune
+ #:rune-code
+ #:rune-downcase
+ #:rune-upcase
+ #:rod-downcase
+ #:rod-upcase
+ #:white-space-rune-p
+ #:digit-rune-p
+ #:rune=
+ #:rune<=
+ #:rune>=
+ #:rune-equal
+ #:runep
+ #:sloopy-rod-p
+ #:rod=
+ #:rod-equal
+ #:make-rod
+ #:char-rune
+ #:rune-char
+ #:rod-string
+ #:string-rod
+ #:rod-subseq
+ #:rod<
+
+ ;; xstream.lisp
+ #:xstream
+ #:make-xstream
+ #:make-rod-xstream
+ #:close-xstream
+ #:xstream-p
+ #:read-rune
+ #:peek-rune
+ #:fread-rune
+ #:fpeek-rune
+ #:consume-rune
+ #:unread-rune
+ #:xstream-position
+ #:xstream-line-number
+ #:xstream-column-number
+ #:xstream-plist
+ #:xstream-encoding
+ #:set-to-full-speed
+ #:xstream-name
+
+ ;; ystream.lisp
+ #:ystream
+ #:close-ystream
+ #:write-rune
+ #:write-rod
+ #:ystream-column
+ #:make-octet-vector-ystream
+ #:make-octet-stream-ystream
+ #:make-rod-ystream
+ #+rune-is-character #:make-character-stream-ystream
+ ;; These don't make too much sense on Unicode-enabled,
+ ;; implementations but for those applications using them anyway,
+ ;; I have commented out the reader conditionals now:
+ ;; #+rune-is-integer
+ #:make-string-ystream/utf8
+ ;; #+rune-is-integer
+ #:make-character-stream-ystream/utf8
+ #:runes-to-utf8/adjustable-string
+
+ #:rod-to-utf8-string
+ #:utf8-string-to-rod
+ #:make-octet-input-stream))
+
+(defpackage :utf8-runes
+ (:use :cl)
+ (:export *utf8-runes-readtable*
+ #:rune #:rod #:simple-rod #:rod-string #:rod= #:make-rod
+ #:string-rod))
+
+(defpackage :runes-encoding
+ (:use :cl :runes)
+ (:export
+ #:encoding-error
+ #:find-encoding
+ #:decode-sequence))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/runes.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/runes.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/runes.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,230 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Unicode strings (called RODs)
+;;; Created: 1999-05-25 22:29
+;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1998,1999 by Gilbert Baumann
+
+;;; This code is free software; you can redistribute it and/or modify it
+;;; under the terms of the version 2.1 of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation, as clarified
+;;; by the "Preamble to the Gnu Lesser General Public License" found in
+;;; the file COPYING.
+;;;
+;;; This code is distributed in the hope that it will be useful,
+;;; but without any warranty; without even the implied warranty of
+;;; merchantability or fitness for a particular purpose. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; Version 2.1 of the GNU Lesser General Public License is in the file
+;;; COPYING that was distributed with this file. If it is not present,
+;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
+;;; superseded by a newer version) or write to the Free Software
+;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+;; Changes
+;;
+;; When Who What
+;; ----------------------------------------------------------------------------
+;; 1999-08-15 GB - ROD=, ROD-EQUAL
+;; RUNE<=, RUNE>=
+;; MAKE-ROD, ROD-SUBSEQ
+;; CHAR-RUNE, RUNE-CHAR, ROD-STRING, STRING-ROD
+;; new functions
+;; - Added rune reader
+;;
+
+(in-package :runes)
+
+(deftype rune () '(unsigned-byte 16))
+(deftype rod () '(array rune (*)))
+(deftype simple-rod () '(simple-array rune (*)))
+
+(definline rune (rod index)
+ (aref rod index))
+
+(defun (setf rune) (new rod index)
+ (setf (aref rod index) new))
+
+(definline %rune (rod index)
+ (aref (the (simple-array (unsigned-byte 16) (*)) rod) (the fixnum index)))
+
+(definline (setf %rune) (new rod index)
+ (setf (aref (the (simple-array (unsigned-byte 16) (*)) rod) (the fixnum index)) new))
+
+(defun rod-capitalize (rod)
+ (warn "~S is not implemented." 'rod-capitalize)
+ rod)
+
+(definline code-rune (x) x)
+(definline rune-code (x) x)
+
+(definline rune= (x y)
+ (= x y))
+
+(defun rune-downcase (rune)
+ (cond ((<= #x0041 rune #x005a) (+ rune #x20))
+ ((= rune #x00d7) rune)
+ ((<= #x00c0 rune #x00de) (+ rune #x20))
+ (t rune)))
+
+(definline rune-upcase (rune)
+ (cond ((<= #x0061 rune #x007a) (- rune #x20))
+ ((= rune #x00f7) rune)
+ ((<= #x00e0 rune #x00fe) (- rune #x20))
+ (t rune)))
+
+(defun rune-upper-case-letter-p (rune)
+ (or (<= #x0041 rune #x005a) (<= #x00c0 rune #x00de)))
+
+(defun rune-lower-case-letter-p (rune)
+ (or (<= #x0061 rune #x007a) (<= #x00e0 rune #x00fe)
+ (= rune #x00d7)))
+
+
+(defun rune-equal (x y)
+ (rune= (rune-upcase x) (rune-upcase y)))
+
+(defun rod-downcase (rod)
+ ;; FIXME
+ (map '(simple-array (unsigned-byte 16) (*)) #'rune-downcase rod))
+
+(defun rod-upcase (rod)
+ ;; FIXME
+ (map '(simple-array (unsigned-byte 16) (*)) #'rune-upcase rod))
+
+(definline white-space-rune-p (char)
+ (or (= char 9) ;TAB
+ (= char 10) ;Linefeed
+ (= char 13) ;Carriage Return
+ (= char 32))) ;Space
+
+(definline digit-rune-p (char &optional (radix 10))
+ (cond ((<= #.(char-code #\0) char #.(char-code #\9))
+ (and (< (- char #.(char-code #\0)) radix)
+ (- char #.(char-code #\0))))
+ ((<= #.(char-code #\A) char #.(char-code #\Z))
+ (and (< (- char #.(char-code #\A) -10) radix)
+ (- char #.(char-code #\A) -10)))
+ ((<= #.(char-code #\a) char #.(char-code #\z))
+ (and (< (- char #.(char-code #\a) -10) radix)
+ (- char #.(char-code #\a) -10))) ))
+
+(defun rod (x)
+ (cond ((stringp x) (map 'rod #'char-code x))
+ ((symbolp x) (rod (string x)))
+ ((characterp x) (rod (string x)))
+ ((vectorp x) (coerce x 'rod))
+ ((integerp x) (map 'rod #'identity (list x)))
+ (t (error "Cannot convert ~S to a ~S" x 'rod))))
+
+(defun runep (x)
+ (and (integerp x)
+ (<= 0 x #xFFFF)))
+
+(defun sloopy-rod-p (x)
+ (and (not (stringp x))
+ (vectorp x)
+ (every #'runep x)))
+
+(defun rod= (x y)
+ (and (= (length x) (length y))
+ (dotimes (i (length x) t)
+ (unless (rune= (rune x i) (rune y i))
+ (return nil)))))
+
+(defun rod-equal (x y)
+ (and (= (length x) (length y))
+ (dotimes (i (length x) t)
+ (unless (rune-equal (rune x i) (rune y i))
+ (return nil)))))
+
+(definline make-rod (size)
+ (make-array size :element-type 'rune))
+
+(defun char-rune (char)
+ (code-rune (char-code char)))
+
+(defparameter *invalid-rune* nil ;;#\?
+ "Rune to use as a replacement in RUNE-CHAR and ROD-STRING for runes not
+ representable as characters. If NIL, an error is signalled instead.")
+
+(defun rune-char (rune &optional (default *invalid-rune*))
+ (or (if (>= rune char-code-limit)
+ default
+ (or (code-char rune) default))
+ (error "rune cannot be represented as a character: ~A" rune)))
+
+(defun rod-string (rod &optional (default-char *invalid-rune*))
+ (map 'string (lambda (x) (rune-char x default-char)) rod))
+
+(defun string-rod (string)
+ (let* ((n (length string))
+ (res (make-rod n)))
+ (dotimes (i n)
+ (setf (%rune res i) (char-rune (char string i))))
+ res))
+
+;;;;
+
+(defun rune<= (rune &rest more-runes)
+ (apply #'<= rune more-runes))
+
+(defun rune>= (rune &rest more-runes)
+ (apply #'>= rune more-runes))
+
+(defun rodp (object)
+ (typep object 'rod))
+
+(defun rod-subseq (source start &optional (end (length source)))
+ (unless (rodp source)
+ (error "~S is not of type ~S." source 'rod))
+ (unless (and (typep start 'fixnum) (>= start 0))
+ (error "~S is not a non-negative fixnum." start))
+ (unless (and (typep end 'fixnum) (>= end start))
+ (error "END argument, ~S, is not a fixnum no less than START, ~S." end start))
+ (when (> start (length source))
+ (error "START argument, ~S, should be no greater than length of rod." start))
+ (when (> end (length source))
+ (error "END argument, ~S, should be no greater than length of rod." end))
+ (locally
+ (declare (type rod source)
+ (type fixnum start end))
+ (let ((res (make-rod (- end start))))
+ (declare (type rod res))
+ (do ((i (- (- end start) 1) (the fixnum (- i 1))))
+ ((< i 0) res)
+ (declare (type fixnum i))
+ (setf (%rune res i) (%rune source (the fixnum (+ i start))))))))
+
+(defun rod-subseq* (source start &optional (end (length source)))
+ (unless (and (typep start 'fixnum) (>= start 0))
+ (error "~S is not a non-negative fixnum." start))
+ (unless (and (typep end 'fixnum) (>= end start))
+ (error "END argument, ~S, is not a fixnum no less than START, ~S." end start))
+ (when (> start (length source))
+ (error "START argument, ~S, should be no greater than length of rod." start))
+ (when (> end (length source))
+ (error "END argument, ~S, should be no greater than length of rod." end))
+ (locally
+ (declare (type fixnum start end))
+ (let ((res (make-rod (- end start))))
+ (declare (type rod res))
+ (do ((i (- (- end start) 1) (the fixnum (- i 1))))
+ ((< i 0) res)
+ (declare (type fixnum i))
+ (setf (%rune res i) (aref source (the fixnum (+ i start))))))))
+
+(defun rod< (rod1 rod2)
+ (do ((i 0 (+ i 1)))
+ (nil)
+ (cond ((= i (length rod1))
+ (return t))
+ ((= i (length rod2))
+ (return nil))
+ ((< (aref rod1 i) (aref rod2 i))
+ (return t))
+ ((> (aref rod1 i) (aref rod2 i))
+ (return nil)))))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/stream-scl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/stream-scl.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/stream-scl.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,253 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Fast streams
+;;; Created: 1999-07-17
+;;; Author: Douglas Crosher
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 2007 by Douglas Crosher
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+(in-package :runes)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *fast* '(optimize (speed 3) (safety 3))))
+
+(deftype runes-encoding:encoding-error ()
+ 'ext:character-conversion-error)
+
+
+;;; xstream
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+(defclass xstream (ext:character-stream)
+ ((name :initarg :name :initform nil
+ :accessor xstream-name)
+ (column :initarg :column :initform 0)
+ (line :initarg :line :initform 1)
+ (unread-column :initarg :unread-column :initform 0)))
+
+(defclass eol-conversion-xstream (lisp::eol-conversion-input-stream xstream)
+ ())
+
+) ; eval-when
+
+(defun make-eol-conversion-xstream (source-stream)
+ "Returns a character stream that conversion CR-LF pairs and lone CR
+ characters into single linefeed character."
+ (declare (type stream source-stream))
+ (let ((stream (ext:make-eol-conversion-stream source-stream
+ :input t
+ :close-stream-p t)))
+ (change-class stream 'eol-conversion-xstream)))
+
+(definline xstream-p (stream)
+ (typep stream 'xstream))
+
+(defun close-xstream (input)
+ (close input))
+
+(definline read-rune (input)
+ (declare (type stream input)
+ (inline read-char)
+ #.*fast*)
+ (let ((char (read-char input nil :eof)))
+ (cond ((member char '(#\UFFFE #\UFFFF))
+ ;; These characters are illegal within XML documents.
+ (simple-error 'ext:character-conversion-error
+ "~@<Illegal XML document character: ~S~:@>" char))
+ ((eql char #\linefeed)
+ (setf (slot-value input 'unread-column) (slot-value input 'column))
+ (setf (slot-value input 'column) 0)
+ (incf (the kernel:index (slot-value input 'line))))
+ (t
+ (incf (the kernel:index (slot-value input 'column)))))
+ char))
+
+(definline peek-rune (input)
+ (declare (type stream input)
+ (inline peek-char)
+ #.*fast*)
+ (peek-char nil input nil :eof))
+
+(definline consume-rune (input)
+ (declare (type stream input)
+ (inline read-rune)
+ #.*fast*)
+ (read-rune input)
+ nil)
+
+(definline unread-rune (rune input)
+ (declare (type stream input)
+ (inline unread-char)
+ #.*fast*)
+ (unread-char rune input)
+ (cond ((eql rune #\linefeed)
+ (setf (slot-value input 'column) (slot-value input 'unread-column))
+ (setf (slot-value input 'unread-column) 0)
+ (decf (the kernel:index (slot-value input 'line))))
+ (t
+ (decf (the kernel:index (slot-value input 'column)))))
+ nil)
+
+(defun fread-rune (input)
+ (read-rune input))
+
+(defun fpeek-rune (input)
+ (peek-rune input))
+
+(defun xstream-position (input)
+ (file-position input))
+
+(defun runes-encoding:find-encoding (encoding)
+ encoding)
+
+(defun make-xstream (os-stream &key name
+ (speed 8192)
+ (initial-speed 1)
+ (initial-encoding :guess))
+ (declare (ignore speed))
+ (assert (eql initial-speed 1))
+ (assert (eq initial-encoding :guess))
+ (let* ((stream (ext:make-xml-character-conversion-stream os-stream
+ :input t
+ :close-stream-p t))
+ (xstream (make-eol-conversion-xstream stream)))
+ (setf (xstream-name xstream) name)
+ xstream))
+
+
+(defclass xstream-string-input-stream (lisp::string-input-stream xstream)
+ ())
+
+(defun make-rod-xstream (string &key name)
+ (declare (type string string))
+ (let ((stream (make-string-input-stream string)))
+ (change-class stream 'xstream-string-input-stream :name name)))
+
+;;; already at 'full speed' so just return the buffer size.
+(defun set-to-full-speed (stream)
+ (length (ext:stream-in-buffer stream)))
+
+(defun xstream-speed (stream)
+ (length (ext:stream-in-buffer stream)))
+
+(defun xstream-line-number (stream)
+ (slot-value stream 'line))
+
+(defun xstream-column-number (stream)
+ (slot-value stream 'column))
+
+(defun xstream-encoding (stream)
+ (stream-external-format stream))
+
+;;; the encoding will have already been detected, but it is checked against the
+;;; declared encoding here.
+(defun (setf xstream-encoding) (declared-encoding stream)
+ (let* ((initial-encoding (xstream-encoding stream))
+ (canonical-encoding
+ (cond ((and (eq initial-encoding :utf-16le)
+ (member declared-encoding '(:utf-16 :utf16 :utf-16le :utf16le)
+ :test 'string-equal))
+ :utf-16le)
+ ((and (eq initial-encoding :utf-16be)
+ (member declared-encoding '(:utf-16 :utf16 :utf-16be :utf16be)
+ :test 'string-equal))
+ :utf-16be)
+ ((and (eq initial-encoding :ucs-4be)
+ (member declared-encoding '(:ucs-4 :ucs4 :ucs-4be :ucs4be)
+ :test 'string-equal))
+ :ucs4-be)
+ ((and (eq initial-encoding :ucs-4le)
+ (member declared-encoding '(:ucs-4 :ucs4 :ucs-4le :ucs4le)
+ :test 'string-equal))
+ :ucs4-le)
+ (t
+ declared-encoding))))
+ (unless (string-equal initial-encoding canonical-encoding)
+ (warn "Unable to change xstream encoding from ~S to ~S (~S)~%"
+ initial-encoding declared-encoding canonical-encoding))
+ declared-encoding))
+
+
+;;; ystream - a run output stream.
+
+(deftype ystream () 'stream)
+
+(defun ystream-column (stream)
+ (ext:line-column stream))
+
+(definline write-rune (rune stream)
+ (declare (inline write-char))
+ (write-char rune stream))
+
+(defun write-rod (rod stream)
+ (declare (type rod rod)
+ (type stream stream))
+ (write-string rod stream))
+
+(defun make-rod-ystream ()
+ (make-string-output-stream))
+
+(defun close-ystream (stream)
+ (etypecase stream
+ (ext:string-output-stream
+ (get-output-stream-string stream))
+ (ext:character-conversion-output-stream
+ (let ((target (slot-value stream 'stream)))
+ (close stream)
+ (if (typep target 'ext:byte-output-stream)
+ (ext:get-output-stream-bytes target)
+ stream)))))
+
+;;;; CHARACTER-STREAM-YSTREAM
+
+(defun make-character-stream-ystream (target-stream)
+ target-stream)
+
+
+;;;; OCTET-VECTOR-YSTREAM
+
+(defun make-octet-vector-ystream ()
+ (let ((target (ext:make-byte-output-stream)))
+ (ext:make-character-conversion-stream target :output t
+ :external-format :utf-8
+ :close-stream-p t)))
+
+;;;; OCTET-STREAM-YSTREAM
+
+(defun make-octet-stream-ystream (os-stream)
+ (ext:make-character-conversion-stream os-stream :output t
+ :external-format :utf-8
+ :close-stream-p t))
+
+
+;;;; helper functions
+
+(defun rod-to-utf8-string (rod)
+ (ext:make-string-from-bytes (ext:make-bytes-from-string rod :utf8)
+ :iso-8859-1))
+
+(defun utf8-string-to-rod (str)
+ (let ((bytes (map '(vector (unsigned-byte 8)) #'char-code str)))
+ (ext:make-string-from-bytes bytes :utf-8)))
+
+(defun make-octet-input-stream (octets)
+ (ext:make-byte-input-stream octets))
+
+
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/syntax.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/syntax.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/syntax.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,181 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Unicode strings (called RODs)
+;;; Created: 1999-05-25 22:29
+;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1998,1999 by Gilbert Baumann
+
+;;; This code is free software; you can redistribute it and/or modify it
+;;; under the terms of the version 2.1 of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation, as clarified
+;;; by the "Preamble to the Gnu Lesser General Public License" found in
+;;; the file COPYING.
+;;;
+;;; This code is distributed in the hope that it will be useful,
+;;; but without any warranty; without even the implied warranty of
+;;; merchantability or fitness for a particular purpose. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; Version 2.1 of the GNU Lesser General Public License is in the file
+;;; COPYING that was distributed with this file. If it is not present,
+;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
+;;; superseded by a newer version) or write to the Free Software
+;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+;; Changes
+;;
+;; When Who What
+;; ----------------------------------------------------------------------------
+;; 1999-08-15 GB - ROD=, ROD-EQUAL
+;; RUNE<=, RUNE>=
+;; MAKE-ROD, ROD-SUBSEQ
+;; CHAR-RUNE, RUNE-CHAR, ROD-STRING, STRING-ROD
+;; new functions
+;; - Added rune reader
+;;
+
+(in-package :runes)
+
+;;;;
+;;;; RUNE Reader
+;;;;
+
+;; Portable implementation of WHITE-SPACE-P with regard to the current
+;; read table -- this is bit tricky.
+
+(defun rt-white-space-p (char)
+ (let ((stream (make-string-input-stream (string char))))
+ (eq :eof (peek-char t stream nil :eof))))
+
+(defun read-rune-name (input)
+ ;; the first char is unconditionally read
+ (let ((char0 (read-char input t nil t)))
+ (when (char= char0 #\\)
+ (setf char0 (read-char input t nil t)))
+ (with-output-to-string (res)
+ (write-char char0 res)
+ (do ((ch (peek-char nil input nil :eof t) (peek-char nil input nil :eof t)))
+ ((or (eq ch :eof)
+ (rt-white-space-p ch)
+ (multiple-value-bind (function non-terminating-p) (get-macro-character ch)
+ (and function (not non-terminating-p)))))
+ (write-char ch res)
+ (read-char input))))) ;consume this character
+
+(defun iso-10646-char-code (char)
+ (char-code char))
+
+(defvar *rune-names* (make-hash-table :test #'equal)
+ "Hashtable, which maps all known rune names to rune codes;
+ Names are stored in uppercase.")
+
+(defun define-rune-name (name code)
+ (setf (gethash (string-upcase name) *rune-names*) code)
+ name)
+
+(defun lookup-rune-name (name)
+ (gethash (string-upcase name) *rune-names*))
+
+(define-rune-name "null" #x0000)
+(define-rune-name "space" #x0020)
+(define-rune-name "newline" #x000A)
+(define-rune-name "return" #x000D)
+(define-rune-name "tab" #x0009)
+(define-rune-name "page" #x000C)
+
+;; and just for fun:
+(define-rune-name "euro" #x20AC)
+
+;; ASCII control characters
+(define-rune-name "nul" #x0000) ;null
+(define-rune-name "soh" #x0001) ;start of header
+(define-rune-name "stx" #x0002) ;start of text
+(define-rune-name "etx" #x0003) ;end of text
+(define-rune-name "eot" #x0004) ;end of transmission
+(define-rune-name "enq" #x0005) ;
+(define-rune-name "ack" #x0006) ;acknowledge
+(define-rune-name "bel" #x0007) ;bell
+(define-rune-name "bs" #x0008) ;backspace
+(define-rune-name "ht" #x0009) ;horizontal tab
+(define-rune-name "lf" #X000A) ;line feed, new line
+(define-rune-name "vt" #X000B) ;vertical tab
+(define-rune-name "ff" #x000C) ;form feed
+(define-rune-name "cr" #x000D) ;carriage return
+(define-rune-name "so" #x000E) ;shift out
+(define-rune-name "si" #x000F) ;shift in
+(define-rune-name "dle" #x0010) ;device latch enable ?
+(define-rune-name "dc1" #x0011) ;device control 1
+(define-rune-name "dc2" #x0012) ;device control 2
+(define-rune-name "dc3" #x0013) ;device control 3
+(define-rune-name "dc4" #x0014) ;device control 4
+(define-rune-name "nak" #x0015) ;negative acknowledge
+(define-rune-name "syn" #x0016) ;
+(define-rune-name "etb" #x0017) ;
+(define-rune-name "can" #x0018) ;
+(define-rune-name "em" #x0019) ;end of message
+(define-rune-name "sub" #x001A) ;
+(define-rune-name "esc" #x001B) ;escape
+(define-rune-name "fs" #x001C) ;field separator ?
+(define-rune-name "gs" #x001D) ;group separator
+(define-rune-name "rs" #x001E) ;
+(define-rune-name "us" #x001F) ;
+
+(define-rune-name "del" #x007F) ;delete
+
+;; iso-latin
+(define-rune-name "nbsp" #x00A0) ;non breakable space
+(define-rune-name "shy" #x00AD) ;soft hyphen
+
+(defun rune-from-read-name (name)
+ (code-rune
+ (cond ((= (length name) 1)
+ (iso-10646-char-code (char name 0)))
+ ((and (= (length name) 2)
+ (char= (char name 0) #\\))
+ (iso-10646-char-code (char name 1)))
+ ((and (>= (length name) 3)
+ (char-equal (char name 0) #\u)
+ (char-equal (char name 1) #\+)
+ (every (lambda (x) (digit-char-p x 16)) (subseq name 2)))
+ (parse-integer name :start 2 :radix 16))
+ ((lookup-rune-name name))
+ (t
+ (error "Meaningless rune name ~S." name)))))
+
+(defun rune-reader (stream subchar arg)
+ subchar arg
+ (values (rune-from-read-name (read-rune-name stream))))
+
+(set-dispatch-macro-character #\# #\/ 'rune-reader)
+
+;;; ROD ext syntax
+
+(defun rod-reader (stream subchar arg)
+ (declare (ignore arg))
+ (rod
+ (with-output-to-string (bag)
+ (do ((c (read-char stream t nil t)
+ (read-char stream t nil t)))
+ ((char= c subchar))
+ (cond ((char= c #\\)
+ (setf c (read-char stream t nil t))))
+ (princ c bag)))))
+
+#-rune-is-character
+(defun rod-printer (stream rod)
+ (princ #\# stream)
+ (princ #\" stream)
+ (loop for x across rod do
+ (cond ((or (rune= x #.(char-rune #\\))
+ (rune= x #.(char-rune #\")))
+ (princ #\\ stream)
+ (princ (code-char x) stream))
+ ((< x char-code-limit)
+ (princ (code-char x) stream))
+ (t
+ (format stream "\\u~4,'0X" x))))
+ (princ #\" stream))
+
+(set-dispatch-macro-character #\# #\" 'rod-reader)
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/utf8.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/utf8.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/utf8.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,36 @@
+;;; copyright (c) 2005 David Lichteblau <david(a)lichteblau.com>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;;
+;;; Rune emulation for the UTF-8-compatible DOM implementation.
+;;; Used only with 8 bit characters on non-unicode Lisps.
+
+(in-package :utf8-runes)
+
+(deftype rune () 'character)
+(deftype rod () '(vector rune))
+(deftype simple-rod () '(simple-array rune))
+
+(defun rod= (r s)
+ (string= r s))
+
+(defun rod-string (rod &optional default)
+ (declare (ignore default))
+ rod)
+
+(defun string-rod (string)
+ string)
+
+(defun make-rod (size)
+ (make-string size :element-type 'rune))
+
+(defun rune-reader (stream subchar arg)
+ (runes::rune-char (runes::rune-reader stream subchar arg)))
+
+(defun rod-reader (stream subchar arg)
+ (runes::rod-string (runes::rod-reader stream subchar arg)))
+
+(setf runes-system:*utf8-runes-readtable*
+ (let ((rt (copy-readtable)))
+ (set-dispatch-macro-character #\# #\/ 'rune-reader rt)
+ (set-dispatch-macro-character #\# #\" 'rod-reader rt)
+ rt))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/xstream.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/xstream.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/xstream.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,405 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Fast streams
+;;; Created: 1999-07-17
+;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1999 by Gilbert Baumann
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+(in-package :runes)
+
+;;; API
+;;
+;; MAKE-XSTREAM cl-stream &key name! speed initial-speed initial-encoding
+;; [function]
+;; MAKE-ROD-XSTREAM rod &key name [function]
+;; CLOSE-XSTREAM xstream [function]
+;; XSTREAM-P object [function]
+;;
+;; READ-RUNE xstream [macro]
+;; PEEK-RUNE xstream [macro]
+;; FREAD-RUNE xstream [function]
+;; FPEEK-RUNE xstream [function]
+;; CONSUME-RUNE xstream [macro]
+;; UNREAD-RUNE rune xstream [function]
+;;
+;; XSTREAM-NAME xstream [accessor]
+;; XSTREAM-POSITION xstream [function]
+;; XSTREAM-LINE-NUMBER xstream [function]
+;; XSTREAM-COLUMN-NUMBER xstream [function]
+;; XSTREAM-PLIST xstream [accessor]
+;; XSTREAM-ENCODING xstream [accessor] <-- be careful here. [*]
+;; SET-TO-FULL-SPEED xstream [function]
+
+;; [*] switching the encoding on the fly is only possible when the
+;; stream's buffer is empty; therefore to be able to switch the
+;; encoding, while some runes are already read, set the stream's speed
+;; to 1 initially (via the initial-speed argument for MAKE-XSTREAM)
+;; and later set it to full speed. (The encoding of the runes
+;; sequence, you fetch off with READ-RUNE is always UTF-16 though).
+;; After switching the encoding, SET-TO-FULL-SPEED can be used to bump the
+;; speed up to a full buffer length.
+
+;; An encoding is simply something, which provides the DECODE-SEQUENCE
+;; method.
+
+;;; Controller protocol
+;;
+;; READ-OCTECTS sequence os-stream start end -> first-non-written
+;; XSTREAM/CLOSE os-stream
+;;
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *fast* '(optimize (speed 3) (safety 0))))
+
+;; Let us first define fast fixnum arithmetric get rid of type
+;; checks. (After all we know what we do here).
+
+(defmacro fx-op (op &rest xs)
+ `(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))))
+(defmacro fx-pred (op &rest xs)
+ `(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))
+
+(defmacro %+ (&rest xs) `(fx-op + ,@xs))
+(defmacro %= (&rest xs) `(fx-pred = ,@xs))
+
+(deftype buffer-index ()
+ `(unsigned-byte ,(integer-length array-total-size-limit)))
+
+(deftype buffer-byte ()
+ `(unsigned-byte 16))
+
+(deftype octet ()
+ `(unsigned-byte 8))
+
+;; The usage of a special marker for EOF is experimental and
+;; considered unhygenic.
+
+(defconstant +end+ #xFFFF
+ "Special marker inserted into stream buffers to indicate end of buffered data.")
+
+(defvar +null-buffer+ (make-array 0 :element-type 'buffer-byte))
+(defvar +null-octet-buffer+ (make-array 0 :element-type 'octet))
+
+(defstruct (xstream
+ (:constructor make-xstream/low)
+ (:copier nil)
+ (:print-function print-xstream))
+
+ ;;; Read buffer
+
+ ;; the buffer itself
+ (buffer +null-buffer+
+ :type (simple-array buffer-byte (*)))
+ ;; points to the next element of `buffer' containing the next rune
+ ;; about to be read.
+ (read-ptr 0 :type buffer-index)
+ ;; points to the first element of `buffer' not containing a rune to
+ ;; be read.
+ (fill-ptr 0 :type buffer-index)
+
+ ;;; OS buffer
+
+ ;; a scratch pad for READ-SEQUENCE
+ (os-buffer +null-octet-buffer+
+ :type (simple-array octet (*)))
+
+ ;; `os-left-start', `os-left-end' designate a region of os-buffer,
+ ;; which still contains some undecoded data. This is needed because
+ ;; of the DECODE-SEQUENCE protocol
+ (os-left-start 0 :type buffer-index)
+ (os-left-end 0 :type buffer-index)
+
+ ;; How much to read each time
+ (speed 0 :type buffer-index)
+
+ ;; Some stream object obeying to a certain protcol
+ os-stream
+
+ ;; The external format
+ ;; (some object offering the ENCODING protocol)
+ (encoding :utf-8)
+
+ ;;A STREAM-NAME object
+ (name nil)
+
+ ;; a plist a struct keeps the hack away
+ (plist nil)
+
+ ;; Stream Position
+ (line-number 1 :type integer) ;current line number
+ (line-start 0 :type integer) ;stream position the current line starts at
+ (buffer-start 0 :type integer) ;stream position the current buffer starts at
+
+ ;; There is no need to maintain a column counter for each character
+ ;; read, since we can easily compute it from `line-start' and
+ ;; `buffer-start'.
+ )
+
+(defun print-xstream (self sink depth)
+ (declare (ignore depth))
+ (format sink "#<~S ~S>" (type-of self) (xstream-name self)))
+
+(defmacro read-rune (input)
+ "Read a single rune off the xstream `input'. In case of end of file :EOF
+ is returned."
+ `((lambda (input)
+ (declare (type xstream input)
+ #.*fast*)
+ (let ((rp (xstream-read-ptr input)))
+ (declare (type buffer-index rp))
+ (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input))
+ rp)))
+ (declare (type buffer-byte ch))
+ (setf (xstream-read-ptr input) (%+ rp 1))
+ (cond ((%= ch +end+)
+ (the (or (member :eof) rune)
+ (xstream-underflow input)))
+ ((%= ch #x000A) ;line break
+ (account-for-line-break input)
+ (code-rune ch))
+ (t
+ (code-rune ch))))))
+ ,input))
+
+(defmacro peek-rune (input)
+ "Peek a single rune off the xstream `input'. In case of end of file :EOF
+ is returned."
+ `((lambda (input)
+ (declare (type xstream input)
+ #.*fast*)
+ (let ((rp (xstream-read-ptr input)))
+ (declare (type buffer-index rp))
+ (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input))
+ rp)))
+ (declare (type buffer-byte ch))
+ (cond ((%= ch +end+)
+ (prog1
+ (the (or (member :eof) rune) (xstream-underflow input))
+ (setf (xstream-read-ptr input) 0)))
+ (t
+ (code-rune ch))))))
+ ,input))
+
+(defmacro consume-rune (input)
+ "Like READ-RUNE, but does not actually return the read rune."
+ `((lambda (input)
+ (declare (type xstream input)
+ #.*fast*)
+ (let ((rp (xstream-read-ptr input)))
+ (declare (type buffer-index rp))
+ (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input))
+ rp)))
+ (declare (type buffer-byte ch))
+ (setf (xstream-read-ptr input) (%+ rp 1))
+ (when (%= ch +end+)
+ (xstream-underflow input))
+ (when (%= ch #x000A) ;line break
+ (account-for-line-break input) )))
+ nil)
+ ,input))
+
+(definline unread-rune (rune input)
+ "Unread the last recently read rune; if there wasn't such a rune, you
+ deserve to lose."
+ (declare (ignore rune))
+ (decf (xstream-read-ptr input))
+ (when (rune= (peek-rune input) #/u+000A) ;was it a line break?
+ (unaccount-for-line-break input)))
+
+(defun fread-rune (input)
+ (read-rune input))
+
+(defun fpeek-rune (input)
+ (peek-rune input))
+
+;;; Line counting
+
+(defun account-for-line-break (input)
+ (declare (type xstream input))
+ (incf (xstream-line-number input))
+ (setf (xstream-line-start input)
+ (+ (xstream-buffer-start input) (xstream-read-ptr input))))
+
+(defun unaccount-for-line-break (input)
+ ;; incomplete!
+ ;; We better use a traditional lookahead technique or forbid unread-rune.
+ (decf (xstream-line-number input)))
+
+;; User API:
+
+(defun xstream-position (input)
+ (+ (xstream-buffer-start input) (xstream-read-ptr input)))
+
+;; xstream-line-number is structure accessor
+
+(defun xstream-column-number (input)
+ (+ (- (xstream-position input)
+ (xstream-line-start input))
+ 1))
+
+;;; Underflow
+
+(defmethod xstream-underflow ((input xstream))
+ (declare (type xstream input))
+ ;; we are about to fill new data into the buffer, so we need to
+ ;; adjust buffer-start.
+ (incf (xstream-buffer-start input)
+ (- (xstream-fill-ptr input) 0))
+ (let (n m)
+ ;; when there is something left in the os-buffer, we move it to
+ ;; the start of the buffer.
+ (setf m (- (xstream-os-left-end input) (xstream-os-left-start input)))
+ (unless (zerop m)
+ (replace (xstream-os-buffer input) (xstream-os-buffer input)
+ :start1 0 :end1 m
+ :start2 (xstream-os-left-start input)
+ :end2 (xstream-os-left-end input))
+ ;; then we take care that the buffer is large enough to carry at
+ ;; least 100 bytes (a random number)
+ ;;
+ ;; david: was heisst da random? ich nehme an, dass 100 einfach
+ ;; ausreichend sein soll, um die laengste utf-8 bytesequenz oder die
+ ;; beiden utf-16 surrogates zu halten? dann ist 100 ja wohl dicke
+ ;; ausreichend und koennte in make-xstream ordentlich geprueft werden.
+ ;; oder was geht hier vor?
+ (unless (>= (length (xstream-os-buffer input)) 100)
+ (error "You lost")))
+ (setf n
+ (read-octets (xstream-os-buffer input) (xstream-os-stream input)
+ m (min (1- (length (xstream-os-buffer input)))
+ (+ m (xstream-speed input)))))
+ (cond ((%= n 0)
+ (setf (xstream-read-ptr input) 0
+ (xstream-fill-ptr input) n)
+ (setf (aref (xstream-buffer input) (xstream-fill-ptr input)) +end+)
+ :eof)
+ (t
+ (multiple-value-bind (fnw fnr)
+ (runes-encoding:decode-sequence
+ (xstream-encoding input)
+ (xstream-os-buffer input) 0 n
+ (xstream-buffer input) 0 (1- (length (xstream-buffer input)))
+ (= n m))
+ (setf (xstream-os-left-start input) fnr
+ (xstream-os-left-end input) n
+ (xstream-read-ptr input) 0
+ (xstream-fill-ptr input) fnw)
+ (setf (aref (xstream-buffer input) (xstream-fill-ptr input)) +end+)
+ (read-rune input))))))
+
+;;; constructor
+
+(defun make-xstream (os-stream &key name
+ (speed 8192)
+ (initial-speed 1)
+ (initial-encoding :guess))
+ ;; XXX if initial-speed isn't 1, encoding will me munged up
+ (assert (eql initial-speed 1))
+ (multiple-value-bind (encoding preread)
+ (if (eq initial-encoding :guess)
+ (figure-encoding os-stream)
+ (values initial-encoding nil))
+ (let ((osbuf (make-array speed :element-type '(unsigned-byte 8))))
+ (replace osbuf preread)
+ (make-xstream/low
+ :buffer (let ((r (make-array speed :element-type 'buffer-byte)))
+ (setf (elt r 0) #xFFFF)
+ r)
+ :read-ptr 0
+ :fill-ptr 0
+ :os-buffer osbuf
+ :speed initial-speed
+ :os-stream os-stream
+ :os-left-start 0
+ :os-left-end (length preread)
+ :encoding encoding
+ :name name))))
+
+(defun make-rod-xstream (string &key name)
+ ;; XXX encoding is mis-handled by this kind of stream
+ (let ((n (length string)))
+ (let ((buffer (make-array (1+ n) :element-type 'buffer-byte)))
+ (declare (type (simple-array buffer-byte (*)) buffer))
+ ;; copy the rod
+ (do ((i (1- n) (- i 1)))
+ ((< i 0))
+ (declare (type fixnum i))
+ (setf (aref buffer i) (rune-code (%rune string i))))
+ (setf (aref buffer n) +end+)
+ ;;
+ (make-xstream/low :buffer buffer
+ :read-ptr 0
+ :fill-ptr n
+ ;; :os-buffer nil
+ :speed 1
+ :os-stream nil
+ :name name))))
+
+(defmethod figure-encoding ((stream null))
+ (values :utf-8 nil))
+
+(defmethod figure-encoding ((stream stream))
+ (let ((c0 (read-byte stream nil :eof)))
+ (cond ((eq c0 :eof)
+ (values :utf-8 nil))
+ (t
+ (let ((c1 (read-byte stream nil :eof)))
+ (cond ((eq c1 :eof)
+ (values :utf-8 (list c0)))
+ (t
+ (cond ((and (= c0 #xFE) (= c1 #xFF)) (values :utf-16-big-endian nil))
+ ((and (= c0 #xFF) (= c1 #xFE)) (values :utf-16-little-endian nil))
+ (t
+ (values :utf-8 (list c0 c1)))))))))))
+
+;;; misc
+
+(defun close-xstream (input)
+ (xstream/close (xstream-os-stream input)))
+
+(defun set-to-full-speed (xstream)
+ (setf (xstream-speed xstream) (length (xstream-os-buffer xstream))))
+
+;;; controller implementations
+
+(defmethod read-octets (sequence (stream stream) start end)
+ (#+CLISP ext:read-byte-sequence
+ #-CLISP read-sequence
+ sequence stream :start start :end end))
+
+#+cmu
+(defmethod read-octets :around (sequence (stream stream) start end)
+ ;; CMUCL <= 19a on non-SunOS accidentally triggers EFAULT in read(2)
+ ;; if SEQUENCE has been write protected by GC. Workaround: Touch all pages
+ ;; in SEQUENCE and make sure no GC happens between that and the read(2).
+ (ext::without-gcing
+ (loop for i from start below end
+ do (setf (elt sequence i) (elt sequence i)))
+ (call-next-method)))
+
+(defmethod read-octets (sequence (stream null) start end)
+ (declare (ignore sequence start end))
+ 0)
+
+(defmethod xstream/close ((stream stream))
+ (close stream))
+
+(defmethod xstream/close ((stream null))
+ nil)
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/ystream.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/ystream.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes/ystream.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,297 @@
+;;; (c) 2005 David Lichteblau <david(a)lichteblau.com>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;;
+;;; ystream (for lack of a better name): a rune output "stream"
+
+(in-package :runes)
+
+(defconstant +ystream-bufsize+ 1024)
+
+(defun make-ub8-array (n)
+ (make-array n :element-type '(unsigned-byte 8)))
+
+(defun make-ub16-array (n)
+ (make-array n :element-type '(unsigned-byte 16)))
+
+(defun make-buffer (&key (element-type '(unsigned-byte 8)))
+ (make-array 1
+ :element-type element-type
+ :adjustable t
+ :fill-pointer 0))
+
+(defmacro while (test &body body)
+ `(until (not ,test) ,@body))
+
+(defmacro until (test &body body)
+ `(do () (,test) ,@body))
+
+;;; ystream
+;;; +- utf8-ystream
+;;; | +- octet-vector-ystream
+;;; | \- %stream-ystream
+;;; | +- octet-stream-ystream
+;;; | \- character-stream-ystream/utf8
+;;; | \- string-ystream/utf8
+;;; +- rod-ystream
+;;; \-- character-stream-ystream
+
+(defstruct ystream
+ (column 0 :type integer)
+ (in-ptr 0 :type fixnum)
+ (in-buffer (make-rod +ystream-bufsize+) :type simple-rod))
+
+(defstruct (utf8-ystream
+ (:include ystream)
+ (:conc-name "YSTREAM-"))
+ (out-buffer (make-ub8-array (* 6 +ystream-bufsize+))
+ :type (simple-array (unsigned-byte 8) (*))))
+
+(defstruct (%stream-ystream (:include utf8-ystream) (:conc-name "YSTREAM-"))
+ (os-stream nil))
+
+(definline write-rune (rune ystream)
+ (let ((in (ystream-in-buffer ystream)))
+ (when (eql (ystream-in-ptr ystream) (length in))
+ (flush-ystream ystream)
+ (setf in (ystream-in-buffer ystream)))
+ (setf (elt in (ystream-in-ptr ystream)) rune)
+ (incf (ystream-in-ptr ystream))
+ (setf (ystream-column ystream)
+ (if (eql rune #/U+0010) 0 (1+ (ystream-column ystream))))
+ rune))
+
+(defmethod close-ystream :before ((ystream ystream))
+ (flush-ystream ystream))
+
+
+;;;; UTF8-YSTREAM (abstract)
+
+(defmethod close-ystream ((ystream %stream-ystream))
+ (ystream-os-stream ystream))
+
+(defgeneric ystream-device-write (ystream buf nbytes))
+
+(defmethod flush-ystream ((ystream utf8-ystream))
+ (let ((ptr (ystream-in-ptr ystream)))
+ (when (plusp ptr)
+ (let* ((in (ystream-in-buffer ystream))
+ (out (ystream-out-buffer ystream))
+ (surrogatep (<= #xD800 (rune-code (elt in (1- ptr))) #xDBFF))
+ n)
+ (when surrogatep
+ (decf ptr))
+ (when (plusp ptr)
+ (setf n (runes-to-utf8 out in ptr))
+ (ystream-device-write ystream out n)
+ (cond
+ (surrogatep
+ (setf (elt in 0) (elt in (1- ptr)))
+ (setf (ystream-in-ptr ystream) 1))
+ (t
+ (setf (ystream-in-ptr ystream) 0))))))))
+
+(defun write-rod (rod sink)
+ (loop for rune across rod do (write-rune rune sink)))
+
+(defun fast-push (new-element vector)
+ (vector-push-extend new-element vector (max 1 (array-dimension vector 0))))
+
+(macrolet ((define-utf8-writer (name (byte &rest aux) result &body body)
+ `(defun ,name (out in n)
+ (let ((high-surrogate nil)
+ ,@aux)
+ (labels
+ ((write0 (,byte)
+ ,@body)
+ (write1 (r)
+ (cond
+ ((<= #x00000000 r #x0000007F)
+ (write0 r))
+ ((<= #x00000080 r #x000007FF)
+ (write0 (logior #b11000000 (ldb (byte 5 6) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 0) r))))
+ ((<= #x00000800 r #x0000FFFF)
+ (write0 (logior #b11100000 (ldb (byte 4 12) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 6) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 0) r))))
+ ((<= #x00010000 r #x001FFFFF)
+ (write0 (logior #b11110000 (ldb (byte 3 18) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 12) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 6) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 0) r))))
+ ((<= #x00200000 r #x03FFFFFF)
+ (write0 (logior #b11111000 (ldb (byte 2 24) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 18) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 12) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 6) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 0) r))))
+ ((<= #x04000000 r #x7FFFFFFF)
+ (write0 (logior #b11111100 (ldb (byte 1 30) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 24) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 18) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 12) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 6) r)))
+ (write0 (logior #b10000000 (ldb (byte 6 0) r))))))
+ (write2 (r)
+ (cond
+ ((<= #xD800 r #xDBFF)
+ (setf high-surrogate r))
+ ((<= #xDC00 r #xDFFF)
+ (let ((q (logior (ash (- high-surrogate #xD7C0) 10)
+ (- r #xDC00))))
+ (write1 q))
+ (setf high-surrogate nil))
+ (t
+ (write1 r)))))
+ (dotimes (j n)
+ (write2 (rune-code (elt in j)))))
+ ,result))))
+ (define-utf8-writer runes-to-utf8 (x (i 0))
+ i
+ (setf (elt out i) x)
+ (incf i))
+ (define-utf8-writer runes-to-utf8/adjustable-string (x)
+ nil
+ (fast-push (code-char x) out)))
+
+
+;;;; ROD-YSTREAM
+
+(defstruct (rod-ystream (:include ystream)))
+
+(defmethod flush-ystream ((ystream rod-ystream))
+ (let* ((old (ystream-in-buffer ystream))
+ (new (make-rod (* 2 (length old)))))
+ (replace new old)
+ (setf (ystream-in-buffer ystream) new)))
+
+(defmethod close-ystream ((ystream rod-ystream))
+ (subseq (ystream-in-buffer ystream) 0 (ystream-in-ptr ystream)))
+
+
+;;;; CHARACTER-STREAM-YSTREAM
+
+#+rune-is-character
+(progn
+ (defstruct (character-stream-ystream
+ (:constructor make-character-stream-ystream (target-stream))
+ (:include ystream)
+ (:conc-name "YSTREAM-"))
+ (target-stream nil))
+
+ (defmethod flush-ystream ((ystream character-stream-ystream))
+ (write-string (ystream-in-buffer ystream)
+ (ystream-target-stream ystream)
+ :end (ystream-in-ptr ystream))
+ (setf (ystream-in-ptr ystream) 0))
+
+ (defmethod close-ystream ((ystream character-stream-ystream))
+ (ystream-target-stream ystream)))
+
+
+;;;; OCTET-VECTOR-YSTREAM
+
+(defstruct (octet-vector-ystream
+ (:include utf8-ystream)
+ (:conc-name "YSTREAM-"))
+ (result (make-buffer)))
+
+(defmethod ystream-device-write ((ystream octet-vector-ystream) buf nbytes)
+ (let* ((result (ystream-result ystream))
+ (start (length result))
+ (size (array-dimension result 0)))
+ (while (> (+ start nbytes) size)
+ (setf size (* 2 size)))
+ (adjust-array result size :fill-pointer (+ start nbytes))
+ (replace result buf :start1 start :end2 nbytes)))
+
+(defmethod close-ystream ((ystream octet-vector-ystream))
+ (ystream-result ystream))
+
+
+;;;; OCTET-STREAM-YSTREAM
+
+(defstruct (octet-stream-ystream
+ (:include %stream-ystream)
+ (:constructor make-octet-stream-ystream (os-stream))
+ (:conc-name "YSTREAM-")))
+
+(defmethod ystream-device-write ((ystream octet-stream-ystream) buf nbytes)
+ (write-sequence buf (ystream-os-stream ystream) :end nbytes))
+
+
+;;;; CHARACTER-STREAM-YSTREAM/UTF8
+
+;; #+rune-is-integer
+(progn
+ (defstruct (character-stream-ystream/utf8
+ (:constructor make-character-stream-ystream/utf8 (os-stream))
+ (:include %stream-ystream)
+ (:conc-name "YSTREAM-")))
+
+ (defmethod ystream-device-write
+ ((ystream character-stream-ystream/utf8) buf nbytes)
+ (declare (type (simple-array (unsigned-byte 8) (*)) buf))
+ (let ((out (ystream-os-stream ystream)))
+ (dotimes (x nbytes)
+ (write-char (code-char (elt buf x)) out)))))
+
+
+;;;; STRING-YSTREAM/UTF8
+
+;; #+rune-is-integer
+(progn
+ (defstruct (string-ystream/utf8
+ (:include character-stream-ystream/utf8
+ (os-stream (make-string-output-stream)))
+ (:conc-name "YSTREAM-")))
+
+ (defmethod close-ystream ((ystream string-ystream/utf8))
+ (get-output-stream-string (ystream-os-stream ystream))))
+
+
+;;;; helper functions
+
+(defun rod-to-utf8-string (rod)
+ (let ((out (make-buffer :element-type 'character)))
+ (runes-to-utf8/adjustable-string out rod (length rod))
+ out))
+
+(defun utf8-string-to-rod (str)
+ (let* ((bytes (map '(vector (unsigned-byte 8)) #'char-code str))
+ (buffer (make-array (length bytes) :element-type '(unsigned-byte 16)))
+ (n (runes-encoding:decode-sequence
+ :utf-8 bytes 0 (length bytes) buffer 0 0 nil))
+ (result (make-array n :element-type 'rune)))
+ (map-into result #'code-rune buffer)
+ result))
+
+(defclass octet-input-stream
+ (trivial-gray-stream-mixin fundamental-binary-input-stream)
+ ((octets :initarg :octets)
+ (pos :initform 0)))
+
+(defmethod close ((stream octet-input-stream) &key abort)
+ (declare (ignore abort))
+ (open-stream-p stream))
+
+(defmethod stream-read-byte ((stream octet-input-stream))
+ (with-slots (octets pos) stream
+ (if (>= pos (length octets))
+ :eof
+ (prog1
+ (elt octets pos)
+ (incf pos)))))
+
+(defmethod stream-read-sequence
+ ((stream octet-input-stream) sequence start end &key &allow-other-keys)
+ (with-slots (octets pos) stream
+ (let* ((length (min (- end start) (- (length octets) pos)))
+ (end1 (+ start length))
+ (end2 (+ pos length)))
+ (replace sequence octets :start1 start :end1 end1 :start2 pos :end2 end2)
+ (setf pos end2)
+ end1)))
+
+(defun make-octet-input-stream (octets)
+ (make-instance 'octet-input-stream :octets octets))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes.asd
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes.asd 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/runes.asd 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,63 @@
+;;; XXX Die vielen verschiedenen Systeme hier sollten vielleicht
+;;; Module eines grossen Systems CXML werden?
+
+(defpackage :runes-system
+ (:use :asdf :cl)
+ (:export #:*utf8-runes-readtable*))
+
+(in-package :runes-system)
+
+(defvar *utf8-runes-readtable*)
+
+(defclass closure-source-file (cl-source-file) ())
+
+#+sbcl
+(defmethod perform :around ((o compile-op) (s closure-source-file))
+ ;; shut up already. Correctness first.
+ (handler-bind ((sb-ext:compiler-note #'muffle-warning))
+ (let (#+sbcl (*compile-print* nil))
+ (call-next-method))))
+
+#-(or rune-is-character rune-is-integer)
+(progn
+ (format t "~&;;; Checking for wide character support...")
+ (force-output)
+ (pushnew (dotimes (x 65536
+ (progn
+ (format t " ok, characters have at least 16 bits.~%")
+ :rune-is-character))
+ (unless (or (<= #xD800 x #xDFFF)
+ (and (< x char-code-limit) (code-char x)))
+ (print (code-char x))
+ (format t " no, reverting to octet strings.~%")
+ (return :rune-is-integer)))
+ *features*))
+
+#-rune-is-character
+(format t "~&;;; Building Closure with (UNSIGNED-BYTE 16) RUNES~%")
+
+#+rune-is-character
+(format t "~&;;; Building Closure with CHARACTER RUNES~%")
+
+(defsystem :runes
+ :default-component-class closure-source-file
+ :pathname (merge-pathnames
+ "runes/"
+ (make-pathname :name nil :type nil :defaults *load-truename*))
+ :serial t
+ :components
+ ((:file "package")
+ (:file "definline")
+ (:file runes
+ :pathname
+ #-rune-is-character "runes"
+ #+rune-is-character "characters")
+ #+rune-is-integer (:file "utf8")
+ (:file "syntax")
+ #-x&y-streams-are-stream (:file "encodings")
+ #-x&y-streams-are-stream (:file "encodings-data")
+ #-x&y-streams-are-stream (:file "xstream")
+ #-x&y-streams-are-stream (:file "ystream")
+ #+x&y-streams-are-stream (:file #+scl "stream-scl")
+ )
+ :depends-on (#-scl :trivial-gray-streams))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Entries 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Entries 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,6 @@
+/domtest.lisp/1.18/Sat Jun 16 09:52:15 2007//
+/misc.lisp/1.1/Sun Jul 22 19:59:27 2007//
+/utf8domtest.diff/1.1/Tue Dec 27 01:35:16 2005//
+/xmlconf-base.diff/1.1.1.1/Sun Mar 13 18:02:28 2005//
+/xmlconf.lisp/1.16/Sun Jul 1 17:26:12 2007//
+D
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Repository 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Repository 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+cxml/test
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Root 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/CVS/Root 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cxml/cvsroot
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/domtest.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/domtest.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/domtest.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,719 @@
+(defpackage :domtest
+ (:use :cl :cxml)
+ (:export #:run-all-tests))
+(defpackage :domtest-tests
+ (:use))
+(in-package :domtest)
+
+
+;;;; allgemeine Hilfsfunktionen
+
+(defmacro string-case (keyform &rest clauses)
+ (let ((key (gensym "key")))
+ `(let ((,key ,keyform))
+ (declare (ignorable ,key))
+ (cond
+ ,@(loop
+ for (keys . forms) in clauses
+ for test = (etypecase keys
+ (string `(string= ,key ,keys))
+ (sequence `(find ,key ',keys :test 'string=))
+ ((eql t) t))
+ collect
+ `(,test ,@forms))))))
+
+(defun rcurry (function &rest args)
+ (lambda (&rest more-args)
+ (apply function (append more-args args))))
+
+(defmacro for ((&rest clauses) &rest body-forms)
+ `(%for ,clauses (progn ,@body-forms)))
+
+(defmacro for* ((&rest clauses) &rest body-forms)
+ `(%for* ,clauses (progn ,@body-forms)))
+
+(defmacro %for ((&rest clauses) body-form &rest finally-forms)
+ (for-aux 'for clauses body-form finally-forms))
+
+(defmacro %for* ((&rest clauses) body-form &rest finally-forms)
+ (for-aux 'for* clauses body-form finally-forms))
+
+(defmacro for-finish ()
+ '(loop-finish))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun for-aux (kind clauses body-form finally-forms)
+ ` (loop ,@ (loop for firstp = t then nil
+ for %clauses = clauses then (rest %clauses)
+ for clause = (first %clauses) then (first %clauses)
+ while (and %clauses (listp clause))
+ append (cons (ecase kind
+ (for (if firstp 'as 'and))
+ (for* 'as))
+ (if (= 2 (length clause))
+ (list (first clause) '= (second clause))
+ clause))
+ into result
+ finally (return (append result %clauses)))
+ do (progn ,body-form)
+ finally (progn ,@finally-forms))))
+
+
+;;;; spezielle Hilfsfunktionen
+
+(defun tag-name (elt)
+ (runes:rod-string (dom:tag-name elt)))
+
+(defmacro with-attributes ((&rest attributes) element &body body)
+ (let ((e (gensym "element")))
+ `(let* ((,e ,element)
+ ,@(mapcar (lambda (var)
+ `(,var (dom:get-attribute ,e ,(symbol-name var))))
+ attributes))
+ ,@body)))
+
+(defun map-child-elements (result-type fn element &key name)
+ (remove '#1=#:void
+ (map result-type
+ (lambda (node)
+ (if (and (eq (dom:node-type node) :element)
+ (or (null name)
+ (equal (tag-name node) name)))
+ (funcall fn node)
+ '#1#))
+ (dom:child-nodes element))))
+
+(defmacro do-child-elements ((var element &key name) &body body)
+ `(block nil
+ (map-child-elements nil (lambda (,var) ,@body) ,element :name ,name)))
+
+(defun find-child-element (name element)
+ (do-child-elements (child element :name name)
+ (return child)))
+
+(defun %intern (name)
+ (unless (stringp name)
+ (setf name (runes:rod-string name)))
+ (if (zerop (length name))
+ nil
+ (intern name :domtest-tests)))
+
+(defun replace-studly-caps (str)
+ (unless (stringp str)
+ (setf str (runes:rod-string str)))
+ ;; s/([A-Z][a-z])/-\1/
+ (with-output-to-string (out)
+ (with-input-from-string (in str)
+ (for ((c = (read-char in nil nil))
+ (previous = nil then c)
+ (next = (peek-char nil in nil nil))
+ :while c)
+ (when (and previous
+ (upper-case-p c) next (lower-case-p next)
+ (not (lower-case-p previous)))
+ (write-char #\- out))
+ (write-char (char-downcase c) out)
+ (when (and (lower-case-p c) next (upper-case-p next))
+ (write-char #\- out))))))
+
+(defun intern-dom (name)
+ (setf name (replace-studly-caps name))
+ (when (eq :foo :FOO)
+ (setf name (string-upcase name)))
+ (intern name :dom))
+
+(defun child-elements (element)
+ (map-child-elements 'list #'identity element))
+
+(defun parse-java-literal (str)
+ (when (stringp str)
+ (setf str (runes:string-rod str)))
+ (cond
+ ((zerop (length str)) nil)
+ ((runes:rod= str #"true")
+ t)
+ ((runes:rod= str #"false")
+ nil)
+ ((digit-char-p (runes:rune-char (elt str 0)))
+ (parse-integer (runes:rod-string str)))
+ ((runes:rune= (elt str 0) #.(runes:char-rune #\"))
+ (let ((v (make-array 1 :fill-pointer 0 :adjustable t)))
+ (for* ((i = 1 :then (1+ i))
+ (c = (elt str i))
+ :until (runes:rune= c #.(runes:char-rune #\")))
+ (if (runes:rune= c #.(runes:char-rune #\\))
+ (let ((frob
+ (progn
+ (incf i)
+ (elt str i))))
+ (ecase frob
+ ;; ...
+ (#/n (vector-push-extend #/newline v (length v)))
+ ((#/\\ #/\") (vector-push-extend #/\\ v (length v)))))
+ (vector-push-extend c v (length v))))
+ (make-array (length v) :element-type 'runes:rune :initial-contents v)))
+ (t
+ (%intern str))))
+
+(defun maybe-setf (place form)
+ (if place
+ `(setf ,place ,form)
+ form))
+
+(defun nullify (str)
+ (if (zerop (length str)) nil str))
+
+
+;;;; dom1-interfaces.xml auslesen
+
+(defparameter *methods* '())
+(defparameter *fields* '())
+
+(declaim (special *directory*))
+(declaim (special *files-directory*))
+
+(defun read-members (&optional (directory *directory*))
+ (let* ((pathname (merge-pathnames "build/dom2-interfaces.xml" directory))
+ (builder (rune-dom:make-dom-builder))
+ (library (dom:document-element
+ (cxml:parse-file pathname builder :recode nil)))
+ (methods '())
+ (fields '()))
+ (do-child-elements (interface library :name "interface")
+ (do-child-elements (method interface :name "method")
+ (let ((parameters (find-child-element "parameters" method)))
+ (push (cons (dom:get-attribute method "name")
+ (map-child-elements 'list
+ (rcurry #'dom:get-attribute "name")
+ parameters
+ :name "param"))
+ methods)))
+ (do-child-elements (attribute interface :name "attribute")
+ (push (dom:get-attribute attribute "name") fields)))
+ (values methods fields)))
+
+
+;;;; Conditions uebersetzen
+
+(defun translate-condition (element)
+ (string-case (tag-name element)
+ ("equals" (translate-equals element))
+ ("notEquals" (translate-not-equals element))
+ ("contentType" (translate-content-type element))
+ ("implementationAttribute" (assert-have-implementation-attribute element))
+ ("isNull" (translate-is-null element))
+ ("not" (translate-is-null element))
+ ("notNull" (translate-not-null element))
+ ("or" (translate-or element))
+ ("same" (translate-same element))
+ ("less" (translate-less element))
+ (t (error "unknown condition: ~A" element))))
+
+(defun equalsp (a b test)
+ (when (dom:named-node-map-p a)
+ (setf a (dom:items a)))
+ (when (dom:named-node-map-p b)
+ (setf b (dom:items b)))
+ (if (and (typep a 'sequence) (typep b 'sequence))
+ (null (set-exclusive-or (coerce a 'list) (coerce b 'list) :test test))
+ (funcall test a b)))
+
+(defun %equal (a b)
+ (or (equal a b) (and (runes::rodp a) (runes::rodp b) (runes:rod= a b))))
+
+(defun %equalp (a b)
+ (or (equalp a b) (and (runes::rodp a) (runes::rodp b) (runes:rod-equal a b))))
+
+(defun translate-equals (element)
+ (with-attributes (|actual| |expected| |ignoreCase|) element
+ `(equalsp ,(%intern |actual|)
+ ,(parse-java-literal |expected|)
+ ',(if (parse-java-literal |ignoreCase|) '%equal '%equal))))
+
+(defun translate-not-equals (element)
+ `(not ,(translate-equals element)))
+
+(defun translate-same (element)
+ (with-attributes (|actual| |expected|) element
+ `(eql ,(%intern |actual|) ,(parse-java-literal |expected|))))
+
+(defun translate-less (element)
+ (with-attributes (|actual| |expected|) element
+ `(< ,(%intern |actual|) ,(parse-java-literal |expected|))))
+
+(defun translate-or (element)
+ `(or ,@(map-child-elements 'list #'translate-condition element)))
+
+(defun translate-instance-of (element)
+ (with-attributes (|obj| |type|) element
+ `(eq (dom:node-type ,(%intern |obj|))
+ ',(string-case (runes:rod-string |type|)
+ ("Document" :document)
+ ("DocumentFragment" :document-fragment)
+ ("Text" :text)
+ ("Comment" :comment)
+ ("CDATASection" :cdata-section)
+ ("Attr" :attribute)
+ ("Element" :element)
+ ("DocumentType" :document-type)
+ ("Notation" :notation)
+ ("Entity" :entity)
+ ("EntityReference" :entity-reference)
+ ("ProcessingInstruction" :processing-instruction)
+ (t (error "unknown interface: ~A" |type|))))))
+
+(defun translate-is-null (element)
+ (with-attributes (|obj|) element
+ `(null ,(%intern |obj|))))
+
+(defun translate-not-null (element)
+ (with-attributes (|obj|) element
+ (%intern |obj|)))
+
+(defun translate-content-type (element) ;XXX verstehe ich nicht
+ (with-attributes (|type|) element
+ `(equal ,|type| "text/xml")))
+
+(defun translate-uri-equals (element)
+ (with-attributes
+ (|actual|
+ |scheme| |path| |host| |file| |name| |query| |fragment| |isAbsolute|)
+ element
+ |isAbsolute|
+ `(let ((uri (net.uri:parse-uri (runes:rod-string ,(%intern |actual|)))))
+ (flet ((uri-directory (path)
+ (namestring
+ (make-pathname :directory (pathname-directory path))))
+ (uri-file (path)
+ (namestring (make-pathname :name (pathname-name path)
+ :type (pathname-type path))))
+ (uri-name (path)
+ (pathname-name path))
+ (maybe-equal (expected actual)
+ (if expected
+ (%equal (runes::rod expected) (runes::rod actual))
+ t)))
+ (and (maybe-equal ,(parse-java-literal |scheme|)
+ (net.uri:uri-scheme uri))
+ (maybe-equal ,(parse-java-literal |host|)
+ (net.uri:uri-host uri))
+ (maybe-equal ,(parse-java-literal |path|)
+ (uri-directory (net.uri:uri-path uri)))
+ (maybe-equal ,(parse-java-literal |file|)
+ (uri-file (net.uri:uri-path uri)))
+ (maybe-equal ,(parse-java-literal |name|)
+ (uri-name (net.uri:uri-path uri)))
+ (maybe-equal ,(parse-java-literal |query|)
+ (net.uri:uri-query uri))
+ (maybe-equal ,(parse-java-literal |fragment|)
+ (net.uri:uri-fragment uri)))))))
+
+
+;;;; Statements uebersetzen
+
+(defun translate-statement (element)
+ (string-case (tag-name element)
+ ("append" (translate-append element))
+ ("assertDOMException" (translate-assert-domexception element))
+ ("assertEquals" (translate-assert-equals element))
+ ("assertNotNull" (translate-assert-not-null element))
+ ("assertInstanceOf" (translate-assert-instance-of element))
+ ("assertNull" (translate-assert-null element))
+ ("assertSame" (translate-assert-same element))
+ ("assertSize" (translate-assert-size element))
+ ("assertTrue" (translate-assert-true element))
+ ("assertFalse" (translate-assert-false element))
+ ("assertURIEquals" (translate-assert-uri-equals element))
+ ("assign" (translate-assign element))
+ ("for-each" (translate-for-each element))
+ ("fail" (translate-fail element))
+ ("hasFeature" (translate-has-feature element))
+ ("if" (translate-if element))
+ ("implementation" (translate-implementation element))
+ ("increment" (translate-unary-assignment '+ element))
+ ("decrement" (translate-unary-assignment '- element))
+ ("length" (translate-length element))
+ ("load" (translate-load element))
+ ("nodeType" (translate-node-type element))
+ ("plus" (translate-binary-assignment '+ element))
+ ("try" (translate-try element))
+ ("while" (translate-while element))
+ (t (translate-member element))))
+
+(defun translate-binary-assignment (fn element)
+ (with-attributes (|var| |op1| |op2|) element
+ (maybe-setf (%intern |var|)
+ `(,fn ,(parse-java-literal |op1|)
+ ,(parse-java-literal |op2|)))))
+
+(defun translate-assign (element)
+ (with-attributes (|var| |value|) element
+ (maybe-setf (%intern |var|) (parse-java-literal |value|))))
+
+(defun translate-unary-assignment (fn element)
+ (with-attributes (|var| |value|) element
+ (maybe-setf (%intern |var|)
+ `(,fn ,(%intern |var|) ,(parse-java-literal |value|)))))
+
+(defun translate-load (load)
+ (with-attributes (|var| |href| |willBeModified|) load
+ (maybe-setf (%intern |var|)
+ `(load-file ,|href| ,(parse-java-literal |willBeModified|)))))
+
+(defun translate-implementation (elt)
+ (with-attributes (|var|) elt
+ (maybe-setf (%intern |var|) `'rune-dom:implementation)))
+
+(defun translate-length (load)
+ ;; XXX Soweit ich sehe unterscheiden die Tests nicht zwischen
+ ;; der Laenge von DOMString und der length()-Methode der uebrigen
+ ;; Interfaces. Also unterscheiden wir das erstmal manuell.
+ (with-attributes (|var| |obj|) load
+ (let ((obj (%intern |obj|)))
+ (maybe-setf (%intern |var|)
+ `(if (typep ,obj 'sequence)
+ (length ,obj)
+ (dom:length ,obj))))))
+
+(defun translate-call (call method)
+ (let ((name (car method))
+ (args (mapcar (lambda (name)
+ (parse-java-literal (dom:get-attribute call name)))
+ (cdr method))))
+ (with-attributes (|var| |obj|) call
+ (maybe-setf (%intern |var|)
+ `(,(intern-dom name) ,(%intern |obj|) ,@args)))))
+
+(defun translate-get (call name)
+ (with-attributes (|var| |value| |obj|) call
+ (cond
+ ((nullify |var|) ;get
+ (maybe-setf (%intern |var|) `(,(intern-dom name) ,(%intern |obj|))))
+ ((nullify |value|) ;set
+ `(setf (,(intern-dom name) ,(%intern |obj|))
+ ,(parse-java-literal |value|)))
+ (t
+ (error "oops")))))
+
+(defun translate-has-feature (element)
+ (with-attributes (|obj| |var| |feature| |version|) element
+ (if (nullify |obj|)
+ (translate-member element)
+ (maybe-setf (%intern |var|)
+ `(dom:has-feature 'rune-dom:implementation
+ ,(parse-java-literal |feature|)
+ ,(parse-java-literal |version|))))))
+
+(defun translate-fail (element)
+ (declare (ignore element))
+ `(error "failed"))
+
+(defun translate-node-type (element)
+ ;; XXX Das muessten eigentlich ints sein, sind aber Keywords in CXML.
+ (with-attributes (|var| |obj|) element
+ (maybe-setf (%intern |var|)
+ `(ecase (dom:node-type ,(%intern |obj|))
+ (:element 1)
+ (:attribute 2)
+ (:text 3)
+ (:cdata-section 4)
+ (:entity-reference 5)
+ (:entity 6)
+ (:processing-instruction 7)
+ (:comment 8)
+ (:document 9)
+ (:document-type 10)
+ (:document-fragment 11)
+ (:notation 12)))))
+
+(defun translate-member (element)
+ (let* ((name (dom:tag-name element))
+ (method (find name *methods* :key #'car :test #'runes:rod=))
+ (field (find name *fields* :test #'runes:rod=)))
+ (cond
+ (method (translate-call element method))
+ (field (translate-get element field))
+ (t (error "unknown element ~A" element)))))
+
+(defun translate-assert-equals (element)
+ `(assert ,(translate-equals element)))
+
+(defun translate-assert-same (element)
+ `(assert ,(translate-same element)))
+
+(defun translate-assert-null (element)
+ (with-attributes (|actual|) element
+ `(assert (null ,(%intern |actual|)))))
+
+(defun translate-assert-not-null (element)
+ (with-attributes (|actual|) element
+ `(assert ,(%intern |actual|))))
+
+(defun translate-assert-size (element)
+ (with-attributes (|collection| |size|) element
+ `(let ((collection ,(%intern |collection|)))
+ (when (dom:named-node-map-p collection)
+ (setf collection (dom:items collection)))
+ (assert (eql (length collection) ,(parse-java-literal |size|))))))
+
+(defun translate-assert-instance-of (element)
+ `(assert ,(translate-instance-of element)))
+
+(defun translate-if (element)
+ (destructuring-bind (condition &rest rest)
+ (child-elements element)
+ (let (then else)
+ (dolist (r rest)
+ (when (equal (tag-name r) "else")
+ (setf else (child-elements r))
+ (return))
+ (push r then))
+ `(cond
+ (,(translate-condition condition)
+ ,@(mapcar #'translate-statement (reverse then)))
+ (t
+ ,@(mapcar #'translate-statement else))))))
+
+(defun translate-while (element)
+ (destructuring-bind (condition &rest body)
+ (child-elements element)
+ `(loop
+ while ,(translate-condition condition)
+ do (progn ,@(mapcar #'translate-statement body)))))
+
+(defun translate-assert-domexception (element)
+ (do-child-elements (c element)
+ (unless (equal (tag-name c) "metadata")
+ (return
+ `(block assert-domexception
+ (handler-bind
+ ((rune-dom::dom-exception
+ (lambda (c)
+ (when (eq (rune-dom::dom-exception-key c)
+ ,(intern (tag-name c) :keyword))
+ (return-from assert-domexception)))))
+ ,@(translate-body c)
+ (error "expected exception ~A" ,(tag-name c))))))))
+
+(defun translate-catch (catch return)
+ `(lambda (c)
+ ,@(map-child-elements
+ 'list
+ (lambda (exception)
+ `(when (eq (rune-dom::dom-exception-key c)
+ ,(intern (runes:rod-string (dom:get-attribute exception "code"))
+ :keyword))
+ ,@(translate-body exception)
+ ,return))
+ catch)))
+
+(defun translate-try (element)
+ `(block try
+ (handler-bind
+ ((rune-dom::dom-exception
+ ,(translate-catch
+ (do-child-elements (c element :name "catch") (return c))
+ '(return-from try))))
+ ,@(map-child-elements 'list
+ (lambda (c)
+ (if (equal (tag-name c) "catch")
+ nil
+ (translate-statement c)))
+ element))))
+
+(defun translate-append (element)
+ (with-attributes (|collection| |item|) element
+ (let ((c (%intern |collection|))
+ (i (%intern |item|)))
+ (maybe-setf c `(append ,c (list ,i))))))
+
+(defun translate-assert-true (element)
+ (with-attributes (|actual|) element
+ `(assert ,(if (nullify |actual|)
+ (%intern |actual|)
+ (translate-condition
+ (do-child-elements (c element) (return c)))))))
+
+(defun translate-assert-false (element)
+ (with-attributes (|actual|) element
+ `(assert (not ,(%intern |actual|)))))
+
+(defun translate-assert-uri-equals (element)
+ `(assert ,(translate-uri-equals element)))
+
+
+;;;; Tests uebersetzen
+
+(defun translate-body (element)
+ (map-child-elements 'list #'translate-statement element))
+
+(defun translate-for-each (element)
+ (with-attributes (|collection| |member|) element
+ `(let ((collection ,(%intern |collection|)))
+ (when (dom:named-node-map-p collection)
+ (setf collection (dom:items collection)))
+ (map nil (lambda (,(%intern |member|)) ,@(translate-body element))
+ collection))))
+
+(defun assert-have-implementation-attribute (element)
+ (let ((attribute (runes:rod-string (dom:get-attribute element "name"))))
+ (string-case attribute
+ ;; fixme: expandEntityReferences sollten wir auch mal anschalten, wo
+ ;; wir uns schon die muehe machen...
+ ("validating"
+ (setf cxml::*validate* t))
+ ("namespaceAware"
+ ;; ??? dom 2 ohne namespace-support gibt's doch gar nicht,
+ ;; ausser vielleicht in html-only implementationen, und dann sollen
+ ;; sie halt auf hasFeature "XML" testen.
+ )
+ (t
+ (format t "~&implementationAttribute ~A not supported, skipping test~%"
+ attribute)
+ (throw 'give-up nil)))))
+
+(defun slurp-test (pathname)
+ (unless *fields*
+ (multiple-value-setq (*methods* *fields*) (read-members)))
+ (catch 'give-up
+ (let* ((builder (rune-dom:make-dom-builder))
+ (cxml::*validate* nil) ;dom1.dtd is buggy
+ (test (dom:document-element
+ (cxml:parse-file pathname builder :recode nil)))
+ title
+ (bindings '())
+ (code '()))
+ (declare (ignorable title))
+ (do-child-elements (e test)
+ (string-case (tag-name e)
+ ("metadata"
+ (let ((title-element (find-child-element "title" e)))
+ (setf title (dom:data (dom:first-child title-element)))))
+ ("var"
+ (push (list (%intern (dom:get-attribute e "name"))
+ (string-case (runes:rod-string
+ (dom:get-attribute e "type"))
+ (("byte" "short" "int" "long") 0)
+ (t nil)))
+ bindings)
+ (let ((value (dom:get-attribute e "value")))
+ (when value
+ (push `(setf ,(%intern (dom:get-attribute e "name"))
+ ,(parse-java-literal value))
+ code)))
+ (do-child-elements (member e :name "member") e
+ (push `(setf ,(%intern (dom:get-attribute e "name"))
+ (append ,(%intern (dom:get-attribute e "name"))
+ (list
+ ,(parse-java-literal
+ (dom:data
+ (dom:item
+ (dom:child-nodes member)
+ 0))))))
+ code)))
+ ("implementationAttribute"
+ (assert-have-implementation-attribute e))
+ (t
+ (push (translate-statement e) code))))
+ `(lambda ()
+ (let ((*files-directory* ,*files-directory*) ;fuer copy&paste:
+ ,@bindings)
+ (declare (ignorable ,@(mapcar #'car bindings)))
+ ,@(reverse code))))))
+
+(defun load-file (name &optional will-be-modified-p)
+ (declare (ignore will-be-modified-p))
+ (setf name (runes:rod-string name))
+ (cxml:parse-file
+ (make-pathname :name name :type "xml" :defaults *files-directory*)
+ (rune-dom:make-dom-builder)
+ :recode nil))
+
+(defparameter *bad-tests*
+ '("hc_elementnormalize2.xml"
+ "hc_nodereplacechildnewchildexists.xml"
+ "characterdatadeletedatanomodificationallowederr.xml"))
+
+(defun dribble-tests (directory)
+ (let ((base (slot-value (asdf:find-system :cxml) 'asdf::relative-pathname)))
+ (with-open-file (*standard-output*
+ (merge-pathnames "DOMTEST" base)
+ :direction :output
+ :if-exists :supersede)
+ (run-all-tests directory))))
+
+(defun run-all-tests (*directory* &optional verbose)
+ (let* ((cxml::*redefinition-warning* nil)
+ (n 0)
+ (i 0)
+ (ntried 0)
+ (nfailed 0))
+ (flet ((parse (test-directory)
+ (let* ((all-tests (merge-pathnames "alltests.xml" test-directory))
+ (builder (rune-dom:make-dom-builder))
+ (suite (dom:document-element
+ (cxml:parse-file all-tests builder :recode nil)))
+ (*files-directory*
+ (merge-pathnames "files/" test-directory)))
+ (do-child-elements (member suite)
+ (unless
+ (or (equal (dom:tag-name member) "metadata")
+ (member (runes:rod-string
+ (dom:get-attribute member "href"))
+ *bad-tests*
+ :test 'equal))
+ (incf n)))
+ suite))
+ (run (test-directory suite)
+ (print test-directory)
+ (let ((*files-directory*
+ (merge-pathnames "files/" test-directory)))
+ (do-child-elements (member suite)
+ (let ((href (runes:rod-string
+ (dom:get-attribute member "href"))))
+ (unless (or (runes:rod= (dom:tag-name member) #"metadata")
+ (member href *bad-tests* :test 'equal))
+ (format t "~&~D/~D ~A~%" i n href)
+ (let ((lisp (slurp-test
+ (merge-pathnames href test-directory))))
+ (when verbose
+ (print lisp))
+ (when lisp
+ (incf ntried)
+ (with-simple-restart (skip-test "Skip this test")
+ (handler-case
+ (let ((cxml::*validate* nil))
+ (funcall (compile nil lisp)))
+ (serious-condition (c)
+ (incf nfailed)
+ (format t "~&TEST FAILED: ~A~&" c))))))
+ (incf i)))))))
+ (let* ((d1 (merge-pathnames "tests/level1/core/" *directory*))
+ (d2 (merge-pathnames "tests/level2/core/" *directory*))
+ (suite1 (parse d1))
+ (suite2 (parse d2)))
+ (run d1 suite1)
+ (run d2 suite2)))
+ (format t "~&~D/~D tests failed; ~D test~:P were skipped"
+ nfailed ntried (- n ntried))))
+
+(defun run-test (*directory* level href)
+ (let* ((test-directory
+ (ecase level
+ (1 (merge-pathnames "tests/level1/core/" *directory*))
+ (2 (merge-pathnames "tests/level2/core/" *directory*))))
+ (*files-directory* (merge-pathnames "files/" test-directory))
+ (lisp (slurp-test (merge-pathnames href test-directory)))
+ (cxml::*validate* nil))
+ (print lisp)
+ (fresh-line)
+ (when lisp
+ (funcall (compile nil lisp)))))
+
+#+(or)
+(domtest::run-all-tests "/home/david/2001/DOM-Test-Suite/")
+
+#+(or)
+(domtest::run-test "/home/david/2001/DOM-Test-Suite/"
+ 1
+ "attrcreatedocumentfragment.xml")
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/misc.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/misc.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/misc.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,29 @@
+;;;
+;;; When I'll grow up, I'll be a complete test suite.
+
+(deftest utf-8
+ (flet ((doit (from below)
+ (loop for code from from below below do
+ (when (and (code-char code)
+ (not (eql code #xfffe))
+ (not (eql code #xffff)))
+ (let* ((a (if (< code #x10000)
+ (format nil "abc~C" (code-char code))
+ (let* ((x (- code #x10000))
+ (lo (ldb (byte 10 0) x))
+ (hi (ldb (byte 10 10) x)))
+ (format nil "abc~C~C"
+ (code-char (logior #xD800 hi))
+ (code-char
+ (logior #xDC00 lo))))))
+ (b (cxml:utf8-string-to-rod
+ (cxml:rod-to-utf8-string
+ a))))
+ (unless (string= a b)
+ (format t "FAIL: ~S ~A ~A~%"
+ (code-char code)
+ (map 'vector #'char-code a)
+ (map 'vector #'char-code b))))))))
+ (doit 32 #xD800)
+ (doit #x10000 char-code-limit)
+ (values)))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/utf8domtest.diff
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/utf8domtest.diff 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/utf8domtest.diff 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,102 @@
+Index: test/domtest.lisp
+===================================================================
+RCS file: /project/cxml/cvsroot/cxml/test/domtest.lisp,v
+retrieving revision 1.13
+diff -u -r1.13 domtest.lisp
+--- test/domtest.lisp 27 Dec 2005 00:21:37 -0000 1.13
++++ test/domtest.lisp 27 Dec 2005 00:46:00 -0000
+@@ -137,21 +137,22 @@
+ ((digit-char-p (runes:rune-char (elt str 0)))
+ (parse-integer (runes:rod-string str)))
+ ((runes:rune= (elt str 0) #.(runes:char-rune #\"))
+- (let ((v (make-array 1 :fill-pointer 0 :adjustable t)))
+- (for* ((i = 1 :then (1+ i))
+- (c = (elt str i))
+- :until (runes:rune= c #.(runes:char-rune #\")))
+- (if (runes:rune= c #.(runes:char-rune #\\))
+- (let ((frob
+- (progn
+- (incf i)
+- (elt str i))))
+- (ecase frob
+- ;; ...
+- (#/n (vector-push-extend #/newline v (length v)))
+- ((#/\\ #/\") (vector-push-extend #/\\ v (length v)))))
+- (vector-push-extend c v (length v))))
+- (coerce v 'runes::simple-rod)))
++ (utf8-dom::%rod
++ (let ((v (make-array 1 :fill-pointer 0 :adjustable t)))
++ (for* ((i = 1 :then (1+ i))
++ (c = (elt str i))
++ :until (runes:rune= c #.(runes:char-rune #\")))
++ (if (runes:rune= c #.(runes:char-rune #\\))
++ (let ((frob
++ (progn
++ (incf i)
++ (elt str i))))
++ (ecase frob
++ ;; ...
++ (#/n (vector-push-extend #/newline v (length v)))
++ ((#/\\ #/\") (vector-push-extend #/\\ v (length v)))))
++ (vector-push-extend c v (length v))))
++ (coerce v 'runes::simple-rod))))
+ (t
+ (%intern str))))
+
+@@ -368,7 +369,7 @@
+
+ (defun translate-implementation (elt)
+ (with-attributes (|var|) elt
+- (maybe-setf (%intern |var|) `'rune-dom:implementation)))
++ (maybe-setf (%intern |var|) `'utf8-dom:implementation)))
+
+ (defun translate-length (load)
+ ;; XXX Soweit ich sehe unterscheiden die Tests nicht zwischen
+@@ -406,7 +407,7 @@
+ (if (nullify |obj|)
+ (translate-member element)
+ (maybe-setf (%intern |var|)
+- `(dom:has-feature 'rune-dom:implementation
++ `(dom:has-feature 'utf8-dom:implementation
+ ,(parse-java-literal |feature|)
+ ,(parse-java-literal |version|))))))
+
+@@ -493,9 +494,9 @@
+ (return
+ `(block assert-domexception
+ (handler-bind
+- ((rune-dom::dom-exception
++ ((utf8-dom::dom-exception
+ (lambda (c)
+- (when (eq (rune-dom::dom-exception-key c)
++ (when (eq (utf8-dom::dom-exception-key c)
+ ,(intern (tag-name c) :keyword))
+ (return-from assert-domexception)))))
+ ,@(translate-body c)
+@@ -506,7 +507,7 @@
+ ,@(map-child-elements
+ 'list
+ (lambda (exception)
+- `(when (eq (rune-dom::dom-exception-key c)
++ `(when (eq (utf8-dom::dom-exception-key c)
+ ,(intern (runes:rod-string (dom:get-attribute exception "code"))
+ :keyword))
+ ,@(translate-body exception)
+@@ -516,7 +517,7 @@
+ (defun translate-try (element)
+ `(block try
+ (handler-bind
+- ((rune-dom::dom-exception
++ ((utf8-dom::dom-exception
+ ,(translate-catch
+ (do-child-elements (c element :name "catch") (return c))
+ '(return-from try))))
+@@ -631,7 +632,7 @@
+ (setf name (runes:rod-string name))
+ (cxml:parse-file
+ (make-pathname :name name :type "xml" :defaults *files-directory*)
+- (rune-dom:make-dom-builder)))
++ (cxml:make-recoder (utf8-dom:make-dom-builder) 'cxml:rod-to-utf8-string)))
+
+ (defparameter *bad-tests*
+ '("hc_elementnormalize2.xml"
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/xmlconf-base.diff
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/xmlconf-base.diff 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/xmlconf-base.diff 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,53 @@
+A recent check-in to the XML-Test-Suite's metadata has broken my parser for
+xmlconf.xml. Apply this patch to revert it.
+
+Index: oasis/oasis.xml
+===================================================================
+RCS file: /sources/public/2001/XML-Test-Suite/xmlconf/oasis/oasis.xml,v
+retrieving revision 1.5
+retrieving revision 1.6
+diff -u -r1.5 -r1.6
+--- oasis/oasis.xml 16 May 2002 14:46:32 -0000 1.5
++++ oasis/oasis.xml 4 Mar 2004 18:23:37 -0000 1.6
+@@ -1,6 +1,6 @@
+ <?xml version='1.0' encoding='UTF-8'?>
+
+-<TESTCASES PROFILE='OASIS/NIST TESTS, 1-Nov-1998' xml:base="oasis/">
++<TESTCASES PROFILE='OASIS/NIST TESTS, 1-Nov-1998'>
+
+ <TEST TYPE='valid' SECTIONS='2.2 [1]'
+ ID='o-p01pass2' URI='p01pass2.xml'>
+Index: xmltest/xmltest.xml
+===================================================================
+RCS file: /sources/public/2001/XML-Test-Suite/xmlconf/xmltest/xmltest.xml,v
+retrieving revision 1.9
+retrieving revision 1.10
+diff -u -r1.9 -r1.10
+--- xmltest/xmltest.xml 21 May 2002 19:05:57 -0000 1.9
++++ xmltest/xmltest.xml 4 Mar 2004 18:25:11 -0000 1.10
+@@ -5,7 +5,7 @@
+ All Rights Reserved.
+ -->
+
+-<TESTCASES PROFILE="James Clark XMLTEST cases, 18-Nov-1998" xml:base="xmltest/">
++<TESTCASES PROFILE="James Clark XMLTEST cases, 18-Nov-1998">
+
+ <!-- Start: not-wf/sa -->
+ <TEST TYPE="not-wf" ENTITIES="none" ID="not-wf-sa-001"
+Index: japanese/japanese.xml
+===================================================================
+RCS file: /sources/public/2001/XML-Test-Suite/xmlconf/japanese/japanese.xml,v
+retrieving revision 1.4
+retrieving revision 1.5
+diff -u -r1.4 -r1.5
+--- japanese/japanese.xml 26 Mar 2002 14:43:54 -0000 1.4
++++ japanese/japanese.xml 4 Mar 2004 18:18:39 -0000 1.5
+@@ -5,7 +5,7 @@
+ All Rights Reserved.
+ -->
+
+-<TESTCASES PROFILE="Fuji Xerox Japanese Text Tests" xml:base="japanese/">
++<TESTCASES PROFILE="Fuji Xerox Japanese Text Tests">
+
+ <TEST TYPE="error" SECTIONS="4.3.3 [4,84]"
+ ID="pr-xml-euc-jp" ENTITIES="parameter" URI="pr-xml-euc-jp.xml">
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/xmlconf.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/xmlconf.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/test/xmlconf.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,232 @@
+(defpackage xmlconf
+ (:use :cl :runes)
+ (:export #:run-all-tests))
+(in-package :xmlconf)
+
+(defun get-attribute (element name)
+ (rod-string (dom:get-attribute element name)))
+
+(defparameter *bad-tests*
+ '(;; TS14
+ ;; http://lists.w3.org/Archives/Public/public-xml-testsuite/2002Mar/0001.html
+ "ibm-valid-P28-ibm28v02.xml"
+ "ibm-valid-P29-ibm29v01.xml"
+ "ibm-valid-P29-ibm29v02.xml"))
+
+(defun test-class (test)
+ (cond
+ ((not (and (let ((version (get-attribute test "RECOMMENDATION")))
+ (cond
+ ((or (equal version "") ;XXX
+ (equal version "XML1.0")
+ (equal version "NS1.0"))
+ (cond
+ ((equal (get-attribute test "NAMESPACE") "no")
+ (format t "~A: test applies to parsers without namespace support, skipping~%"
+ (get-attribute test "URI"))
+ nil)
+ (t
+ t)))
+ ((equal version "XML1.1")
+ ;; not supported
+ nil)
+ (t
+ (warn "unrecognized RECOMMENDATION value: ~S" version)
+ nil)))
+ (not (member (get-attribute test "ID") *bad-tests* :test 'equal))))
+ nil)
+ ((equal (get-attribute test "TYPE") "valid") :valid)
+ ((equal (get-attribute test "TYPE") "invalid") :invalid)
+ ((equal (get-attribute test "TYPE") "not-wf") :not-wf)
+ (t nil)))
+
+(defun test-pathnames (directory test)
+ (let* ((sub-directory
+ (loop
+ for parent = test then (dom:parent-node parent)
+ for base = (get-attribute parent "xml:base")
+ until (plusp (length base))
+ finally (return (merge-pathnames base directory))))
+ (uri (get-attribute test "URI"))
+ (output (get-attribute test "OUTPUT")))
+ (values (merge-pathnames uri sub-directory)
+ (when (plusp (length output))
+ (merge-pathnames output sub-directory)))))
+
+(defmethod serialize-document ((document t))
+ (dom:map-document (cxml:make-octet-vector-sink :canonical 2)
+ document
+ :include-doctype :canonical-notations
+ :include-default-values t))
+
+(defun file-contents (pathname)
+ (with-open-file (s pathname :element-type '(unsigned-byte 8))
+ (let ((result
+ (make-array (file-length s) :element-type '(unsigned-byte 8))))
+ (read-sequence result s )
+ result)))
+
+(defun dribble-tests (parser-fn directory)
+ (let ((base (slot-value (asdf:find-system :cxml) 'asdf::relative-pathname)))
+ (with-open-file (*standard-output*
+ (merge-pathnames "XMLCONF" base)
+ :direction :output
+ :external-format :iso-8859-1
+ :if-exists :supersede)
+ (run-all-tests parser-fn directory))))
+
+(defvar *parser-fn* 'sax-test)
+
+(defun sax-test (filename handler &rest args)
+ (apply #'cxml:parse-file filename handler :recode nil args))
+
+(defun klacks-test (filename handler &rest args)
+ (klacks:with-open-source
+ (s (apply #'cxml:make-source (pathname filename) args))
+ (klacks:serialize-source s handler)))
+
+(defun run-all-tests (parser-fn directory)
+ (let* ((*parser-fn* parser-fn)
+ (pathname (merge-pathnames "xmlconf.xml" directory))
+ (builder (rune-dom:make-dom-builder))
+ (xmlconf (cxml:parse-file pathname builder :recode nil))
+ (ntried 0)
+ (nfailed 0)
+ (nskipped 0)
+ ;; XXX someone found it funny to include invalid URIs in the
+ ;; test suite. And no, in "invalid" not "not-wf".
+ (puri:*strict-parse* nil))
+ (dom:do-node-list (test (dom:get-elements-by-tag-name xmlconf "TEST"))
+ (let ((description
+ (apply #'concatenate
+ 'string
+ (map 'list
+ (lambda (child)
+ (if (dom:text-node-p child)
+ (rod-string (dom:data child))
+ ""))
+ (dom:child-nodes test))))
+ (class (test-class test)))
+ (cond
+ (class
+ (incf ntried)
+ (multiple-value-bind (pathname output)
+ (test-pathnames directory test)
+ (princ (enough-namestring pathname directory))
+ (unless (probe-file pathname)
+ (error "file not found: ~A" pathname))
+ (with-simple-restart (skip-test "Skip this test")
+ (unless (run-test class pathname output description)
+ (incf nfailed))
+ (fresh-line))))
+ (t
+ (incf nskipped)))))
+ (format t "~&~D/~D tests failed; ~D test~:P were skipped"
+ nfailed ntried nskipped)))
+
+(defmethod run-test :around (class pathname output description &rest args)
+ (declare (ignore class pathname output args))
+ (handler-case
+ (call-next-method)
+ (serious-condition (c)
+ (format t " FAILED:~% ~A~%[~A]~%" c description)
+ nil)))
+
+(defmethod run-test ((class null) pathname output description &rest args)
+ (declare (ignore description))
+ (let ((document (apply *parser-fn*
+ pathname
+ (rune-dom:make-dom-builder)
+ args)))
+ (cond
+ ((null output)
+ (format t " input"))
+ ((equalp (file-contents output) (serialize-document document))
+ (format t " input/output"))
+ (t
+ (let ((error-output (make-pathname :type "error" :defaults output)))
+ (with-open-file (s error-output
+ :element-type '(unsigned-byte 8)
+ :direction :output
+ :if-exists :supersede)
+ (write-sequence (serialize-document document) s))
+ (error "well-formed, but output ~S not the expected ~S~%"
+ error-output output))))
+ t))
+
+(defmethod run-test
+ ((class (eql :valid)) pathname output description &rest args)
+ (assert (null args))
+ (and (progn
+ (format t " [not validating:]")
+ (run-test nil pathname output description :validate nil))
+ (progn
+ (format t " [validating:]")
+ (run-test nil pathname output description :validate t))))
+
+(defmethod run-test
+ ((class (eql :invalid)) pathname output description &rest args)
+ (assert (null args))
+ (and (progn
+ (format t " [not validating:]")
+ (run-test nil pathname output description :validate nil))
+ (handler-case
+ (progn
+ (format t " [validating:]")
+ (funcall *parser-fn*
+ pathname
+ (rune-dom:make-dom-builder)
+ :validate t)
+ (error "validity error not detected")
+ nil)
+ (cxml:validity-error ()
+ (format t " invalid")
+ t))))
+
+(defmethod run-test
+ ((class (eql :not-wf)) pathname output description &rest args)
+ (assert (null args))
+ (handler-case
+ (progn
+ (format t " [not validating:]")
+ (funcall *parser-fn*
+ pathname
+ (rune-dom:make-dom-builder)
+ :validate nil)
+ (error "well-formedness violation not detected")
+ nil)
+ #+fixme-stp-test
+ (error ()
+ (format t " unexpected-error")
+ t)
+ (cxml:well-formedness-violation ()
+ (format t " not-wf")
+ t))
+ (handler-case
+ (progn
+ (format t " [validating:]")
+ (funcall *parser-fn*
+ pathname
+ (rune-dom:make-dom-builder)
+ :validate t)
+ (error "well-formedness violation not detected")
+ nil)
+ #+fixme-stp-test
+ (error ()
+ (format t " unexpected-error")
+ t)
+ (cxml:well-formedness-violation ()
+ (format t " not-wf")
+ t)
+ (cxml:validity-error ()
+ ;; das erlauben wir mal auch, denn valide => wf
+ (format t " invalid")
+ t)))
+
+#+(or)
+(xmlconf::run-all-tests 'xmlconf::sax-test
+ "/home/david/2001/XML-Test-Suite/xmlconf/")
+
+#+(or)
+(xmlconf::run-all-tests 'xmlconf::klacks-test
+ "/home/david/2001/XML-Test-Suite/xmlconf/")
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Entries 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Entries 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,14 @@
+/catalog.lisp/1.5/Sun Mar 4 21:04:13 2007//
+/package.lisp/1.19/Sat Jul 7 20:47:39 2007//
+/recoder.lisp/1.5/Thu Dec 29 00:31:36 2005//
+/sax-handler.lisp/1.8/Sun Jul 1 17:25:45 2007//
+/sax-proxy.lisp/1.6/Sun May 20 09:38:35 2007//
+/space-normalizer.lisp/1.2/Thu Dec 29 00:39:25 2005//
+/split-sequence.lisp/1.1.1.1/Sun Mar 13 18:02:35 2005//
+/unparse.lisp/1.20/Sun Aug 5 11:16:15 2007//
+/util.lisp/1.2/Mon Nov 28 22:33:47 2005//
+/xml-name-rune-p.lisp/1.8/Sun Sep 10 14:52:44 2006//
+/xml-parse.lisp/1.72/Sun Aug 5 11:15:48 2007//
+/xmlns-normalizer.lisp/1.4/Sat Jun 16 11:07:58 2007//
+/xmls-compat.lisp/1.5/Sun Jul 1 17:26:04 2007//
+D
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Entries.Log
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Entries.Log 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Entries.Log 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+A D/sax-tests////
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Repository 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Repository 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+cxml/xml
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Root 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/CVS/Root 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cxml/cvsroot
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/catalog.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/catalog.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/catalog.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,349 @@
+;;;; catalogs.lisp -- XML Catalogs -*- Mode: Lisp; readtable: runes -*-
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Developed 2004 for headcraft - http://headcraft.de/
+;;;; Copyright: David Lichteblau
+
+(in-package :cxml)
+
+;;; http://www.oasis-open.org/committees/entity/spec.html
+;;;
+;;; Bugs:
+;;; - We validate using the Catalog DTD while parsing, which is too strict
+;;; and will will fail to parse files using other parser's extensions.
+;;; (Jedenfalls behauptet das die Spec.)
+;;; A long-term solution might be an XML Schema validator.
+
+(defvar *prefer* :public)
+(defvar *default-catalog*
+ '(;; libxml standard
+ "/etc/xml/catalog"
+ ;; FreeBSD
+ "/usr/local/share/xml/catalog.ports"))
+
+(defstruct (catalog (:constructor %make-catalog ()))
+ main-files
+ (dtd-cache (make-dtd-cache))
+ (file-table (puri:make-uri-space)))
+
+(defstruct (entry-file (:conc-name ""))
+ (system-entries) ;extid 2
+ (rewrite-system-entries) ; 3
+ (delegate-system-entries) ; 4
+ (public-entries) ; 5
+ (delegate-public-entries) ; 6
+ (uri-entries) ;uri 2
+ (rewrite-uri-entries) ; 3
+ (delegate-uri-entries) ; 4
+ (next-catalog-entries) ; 5/7
+ )
+
+(defun starts-with-p (string prefix)
+ (let ((mismatch (mismatch string prefix)))
+ (or (null mismatch) (= mismatch (length prefix)))))
+
+(defun normalize-public (str)
+ (setf str (rod-to-utf8-string (rod str)))
+ (flet ((whitespacep (c)
+ (find c #.(map 'string #'code-char '(#x9 #xa #xd #x20)))))
+ (let ((start (position-if-not #'whitespacep str))
+ (end (position-if-not #'whitespacep str :from-end t))
+ (spacep nil))
+ (with-output-to-string (out)
+ (when start
+ (loop for i from start to end do
+ (let ((c (char str i)))
+ (cond
+ ((whitespacep c)
+ (unless spacep
+ (setf spacep t)
+ (write-char #\space out)))
+ (t
+ (setf spacep nil)
+ (write-char c out))))))))))
+
+(defun normalize-uri (str)
+ (when (typep str 'puri:uri)
+ (setf str (puri:render-uri str nil)))
+ (setf str (rod-to-utf8-string (rod str)))
+ (with-output-to-string (out)
+ (loop for ch across str do
+ (let ((c (char-code ch)))
+ (if (< c 15)
+ (write-string (string-upcase (format nil "%~2,'0X" c)) out)
+ (write-char ch out))))))
+
+(defun unwrap-publicid (str)
+ (normalize-public
+ (with-output-to-string (out)
+ (let ((i (length "urn:publicid:"))
+ (n (length str)))
+ (while (< i n)
+ (let ((c (char str i)))
+ (case c
+ (#\+ (write-char #\space out))
+ (#\: (write-string "//" out))
+ (#\; (write-string "::" out))
+ (#\%
+ (let ((code
+ (parse-integer str
+ :start (+ i 1)
+ :end (+ i 3)
+ :radix 16)))
+ (write-char (code-char code) out))
+ (incf i 2))
+ (t (write-char c out))))
+ (incf i))))))
+
+(defun match-exact (key table &optional check-prefer)
+ (dolist (pair table)
+ (destructuring-bind (from to &optional prefer) pair
+ (when (and (equal key from) (or (not check-prefer) (eq prefer :public)))
+ (return to)))))
+
+(defun match-prefix/rewrite (key table &optional check-prefer)
+ (let ((match nil)
+ (match-length -1))
+ (dolist (pair table)
+ (destructuring-bind (from to &optional prefer) pair
+ (when (and (or (not check-prefer) (eq prefer :public))
+ (starts-with-p key from)
+ (> (length from) match-length))
+ (setf match-length (length from))
+ (setf match to))))
+ (if match
+ (concatenate 'string
+ match
+ (subseq key match-length))
+ nil)))
+
+(defun match-prefix/sorted (key table &optional check-prefer)
+ (let ((result '()))
+ (dolist (pair table)
+ (destructuring-bind (from to &optional prefer) pair
+ (when (and (or (not check-prefer) (eq prefer :public))
+ (starts-with-p key from))
+ (push (cons (length from) to) result))))
+ (mapcar #'cdr (sort result #'> :key #'car))))
+
+(defun resolve-extid (public system catalog)
+ (when public (setf public (normalize-public public)))
+ (when system (setf system (normalize-uri system)))
+ (when (and system (starts-with-p system "urn:publicid:"))
+ (let ((new-public (unwrap-publicid system)))
+ (assert (or (null public) (equal public new-public)))
+ (setf public new-public
+ system nil)))
+ (let ((files (catalog-main-files catalog))
+ (seen '()))
+ (while files
+ (let ((file (pop files))
+ (delegates nil))
+ (unless (typep file 'entry-file)
+ (setf file (find-catalog-file file catalog)))
+ (unless (or (null file) (member file seen))
+ (push file seen)
+ (when system
+ (let ((result
+ (or (match-exact system (system-entries file))
+ (match-prefix/rewrite
+ system
+ (rewrite-system-entries file)))))
+ (when result
+ (return result))
+ (setf delegates
+ (match-prefix/sorted
+ system
+ (delegate-system-entries file)))))
+ (when (and public (not delegates))
+ (let* ((check-prefer (and system t))
+ (result
+ (match-exact public
+ (public-entries file)
+ check-prefer)))
+ (when result
+ (return result))
+ (setf delegates
+ (match-prefix/sorted
+ public
+ (delegate-public-entries file)
+ check-prefer))))
+ (if delegates
+ (setf files delegates)
+ (setf files (append (next-catalog-entries file) files))))))))
+
+(defun resolve-uri (uri catalog)
+ (setf uri (normalize-uri uri))
+ (when (starts-with-p uri "urn:publicid:")
+ (return-from resolve-uri
+ (resolve-extid (unwrap-publicid uri) nil catalog)))
+ (let ((files (catalog-main-files catalog))
+ (seen '()))
+ (while files
+ (let ((file (pop files)))
+ (unless (typep file 'entry-file)
+ (setf file (find-catalog-file file catalog)))
+ (unless (or (null file) (member file seen))
+ (push file seen)
+ (let ((result
+ (or (match-exact uri (uri-entries file))
+ (match-prefix/rewrite uri (rewrite-uri-entries file)))))
+ (when result
+ (return result))
+ (let* ((delegate-entries
+ (delegate-uri-entries file))
+ (delegates
+ (match-prefix/sorted uri delegate-entries)))
+ (if delegates
+ (setf files delegates)
+ (setf files (append (next-catalog-entries file) files))))))))))
+
+(defun find-catalog-file (uri catalog)
+ (setf uri (if (stringp uri) (safe-parse-uri uri) uri))
+ (let* ((*dtd-cache* (catalog-dtd-cache catalog))
+ (*cache-all-dtds* t)
+ (file (parse-catalog-file uri)))
+ (when file
+ (let ((interned (puri:intern-uri uri (catalog-file-table catalog))))
+ (setf (getf (puri:uri-plist interned) 'catalog) file)))
+ file))
+
+(defun make-catalog (&optional (uris *default-catalog*))
+ (let ((result (%make-catalog)))
+ (setf (catalog-main-files result)
+ (loop
+ for uri in uris
+ for file = (find-catalog-file uri result)
+ when file collect file))
+ result))
+
+(defun parse-catalog-file (uri)
+ (handler-case
+ (parse-catalog-file/strict uri)
+ ((or file-error xml-parse-error) (c)
+ (warn "ignoring catalog error: ~A" c))))
+
+(defparameter *catalog-dtd*
+ (let* ((cxml
+ (slot-value (asdf:find-system :cxml) 'asdf::relative-pathname))
+ (dtd (merge-pathnames "catalog.dtd" cxml)))
+ (with-open-file (s dtd :element-type '(unsigned-byte 8))
+ (let ((bytes
+ (make-array (file-length s) :element-type '(unsigned-byte 8))))
+ (read-sequence bytes s)
+ bytes))))
+
+(defun parse-catalog-file/strict (uri)
+ (let* ((*catalog* nil)
+ (dtd-sysid
+ (puri:parse-uri "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd")))
+ (flet ((entity-resolver (public system)
+ (declare (ignore public))
+ (if (puri:uri= system dtd-sysid)
+ (make-octet-input-stream *catalog-dtd*)
+ nil)))
+ (with-open-stream (s (open (uri-to-pathname uri)
+ :element-type '(unsigned-byte 8)
+ :direction :input))
+ (parse-stream s
+ (make-instance 'catalog-parser :uri uri)
+ :validate nil
+ :dtd (make-extid nil dtd-sysid)
+ :root #"catalog"
+ :entity-resolver #'entity-resolver)))))
+
+(defclass catalog-parser ()
+ ((result :initform (make-entry-file) :accessor result)
+ (next :initform '() :accessor next)
+ (prefer-stack :initform (list *prefer*) :accessor prefer-stack)
+ (catalog-base-stack :accessor catalog-base-stack)))
+
+(defmethod initialize-instance :after
+ ((instance catalog-parser) &key uri)
+ (setf (catalog-base-stack instance) (list uri)))
+
+(defmethod prefer ((handler catalog-parser))
+ (car (prefer-stack handler)))
+
+(defmethod base ((handler catalog-parser))
+ (car (catalog-base-stack handler)))
+
+(defun get-attribute/lname (name attributes)
+ (let ((a (find name attributes
+ :key (lambda (a)
+ (or (sax:attribute-local-name a)
+ (sax:attribute-qname a)))
+ :test #'string=)))
+ (and a (sax:attribute-value a))))
+
+(defmethod sax:start-element ((handler catalog-parser) uri lname qname attrs)
+ (declare (ignore uri))
+ (setf lname (or lname qname))
+ ;; we can dispatch on lnames only because we validate against the DTD,
+ ;; which disallows other namespaces.
+ ;; FIXME: we don't, because we can't.
+ (push (let ((new (get-attribute/lname "prefer" attrs)))
+ (cond
+ ((equal new "public") :public)
+ ((equal new "system") :system)
+ ((null new) (prefer handler))))
+ (prefer-stack handler))
+ (push (string-or (get-attribute/lname "base" attrs) (base handler))
+ (catalog-base-stack handler))
+ (flet ((geturi (lname)
+ (puri:merge-uris
+ (safe-parse-uri (get-attribute/lname lname attrs))
+ (base handler))))
+ (cond
+ ((string= lname "public")
+ (push (list (normalize-public (get-attribute/lname "publicId" attrs))
+ (geturi "uri")
+ (prefer handler))
+ (public-entries (result handler))))
+ ((string= lname "system")
+ (push (list (normalize-uri (get-attribute/lname "systemId" attrs))
+ (geturi "uri"))
+ (system-entries (result handler))))
+ ((string= lname "uri")
+ (push (list (normalize-uri (get-attribute/lname "name" attrs))
+ (geturi "uri"))
+ (uri-entries (result handler))))
+ ((string= lname "rewriteSystem")
+ (push (list (normalize-uri
+ (get-attribute/lname "systemIdStartString" attrs))
+ (get-attribute/lname "rewritePrefix" attrs))
+ (rewrite-system-entries (result handler))))
+ ((string= lname "rewriteURI")
+ (push (list (normalize-uri
+ (get-attribute/lname "uriStartString" attrs))
+ (get-attribute/lname "rewritePrefix" attrs))
+ (rewrite-uri-entries (result handler))))
+ ((string= lname "delegatePublic")
+ (push (list (normalize-public
+ (get-attribute/lname "publicIdStartString" attrs))
+ (geturi "catalog")
+ (prefer handler))
+ (delegate-public-entries (result handler))))
+ ((string= lname "delegateSystem")
+ (push (list (normalize-uri
+ (get-attribute/lname "systemIdStartString" attrs))
+ (geturi "catalog"))
+ (delegate-system-entries (result handler))))
+ ((string= lname "delegateURI")
+ (push (list (normalize-uri
+ (get-attribute/lname "uriStartString" attrs))
+ (geturi "catalog"))
+ (delegate-uri-entries (result handler))))
+ ((string= lname "nextCatalog")
+ (push (geturi "catalog")
+ (next-catalog-entries (result handler)))))))
+
+(defmethod sax:end-element ((handler catalog-parser) uri lname qname)
+ (declare (ignore uri lname qname))
+ (pop (catalog-base-stack handler))
+ (pop (prefer-stack handler)))
+
+(defmethod sax:end-document ((handler catalog-parser))
+ (result handler))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/package.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/package.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/package.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,98 @@
+;;;; package.lisp -- Paketdefinition
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+
+(in-package :cl-user)
+
+(defpackage :cxml
+ (:use :cl :runes :runes-encoding #-scl :trivial-gray-streams)
+ (:export
+ ;; xstreams
+ #:make-xstream
+ #:make-rod-xstream
+ #:close-xstream
+ #:read-rune
+ #:peek-rune
+ #:unread-rune
+ #:fread-rune
+ #:fpeek-rune
+ #:xstream-position
+ #:xstream-line-number
+ #:xstream-column-number
+ #:xstream-plist
+ #:xstream-encoding
+
+ ;; xstream controller protocol
+ #:read-octects
+ #:xstream/close
+
+ #:attribute-namespace-uri
+ #:attribute-local-name
+ #:attribute-qname
+ #:attribute-value
+
+ #:parse
+ #:parse-file
+ #:parse-stream
+ #:parse-rod
+ #:parse-octets
+ #:parse-empty-document
+
+ #:make-octet-vector-sink
+ #:make-octet-stream-sink
+ #:make-rod-sink
+ #+rune-is-character #:make-string-sink
+ #+rune-is-character #:make-character-stream-sink
+ ;; See comment in runes/package.lisp
+ ;; #-rune-is-character
+ #:make-string-sink/utf8
+ ;; #-rune-is-character
+ #:make-character-stream-sink/utf8
+
+ #:with-xml-output
+ #:with-namespace
+ #:with-element
+ #:with-element*
+ #:attribute
+ #:attribute*
+ #:unparse-attribute
+ #:cdata
+ #:text
+ #:doctype
+
+ #:xml-parse-error
+ #:well-formedness-violation
+ #:validity-error
+
+ #:parse-dtd-file
+ #:parse-dtd-stream
+ #:make-validator
+
+ #:*cache-all-dtds*
+ #:*dtd-cache*
+ #:getdtd
+ #:remdtd
+ #:make-dtd-cache
+ #:clear-dtd-cache
+ #:make-extid
+
+ #:*catalog*
+ #:*prefer*
+ #:make-catalog
+ #:resolve-uri
+ #:resolve-extid
+
+ #:make-recoder
+ #:make-namespace-normalizer
+ #:make-whitespace-normalizer
+ #:rod-to-utf8-string
+ #:utf8-string-to-rod
+
+ #:broadcast-handler
+ #:broadcast-handler-handlers
+ #:make-broadcast-handler
+ #:sax-proxy
+ #:proxy-chained-handler
+
+ #:make-source))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/recoder.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/recoder.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/recoder.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,125 @@
+;;;; recoder.lisp -- SAX handler for string conversion
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Developed 2004 for headcraft - http://headcraft.de/
+;;;; Copyright: David Lichteblau
+
+(in-package :cxml)
+
+(defclass recoder ()
+ ((recoder :initarg :recoder :accessor recoder)
+ (chained-handler :initarg :chained-handler :accessor chained-handler)))
+
+(defun make-recoder (chained-handler recoder-fn)
+ (make-instance 'recoder
+ :recoder recoder-fn
+ :chained-handler chained-handler))
+
+(macrolet ((%string (rod)
+ `(let ((rod ,rod))
+ (if (typep rod '(or rod string))
+ (funcall (recoder handler) rod)
+ rod)))
+ (defwrapper (name (&rest args) &rest forms)
+ `(defmethod ,name ((handler recoder) ,@args)
+ (,name (chained-handler handler) ,@forms))))
+ (defwrapper sax:start-document ())
+
+ (defwrapper sax:start-element
+ (namespace-uri local-name qname attributes)
+ (%string namespace-uri)
+ (%string local-name)
+ (%string qname)
+ (mapcar (lambda (attr)
+ (sax:make-attribute
+ :namespace-uri (%string (sax:attribute-namespace-uri attr))
+ :local-name (%string (sax:attribute-local-name attr))
+ :qname (%string (sax:attribute-qname attr))
+ :value (%string (sax:attribute-value attr))
+ :specified-p (sax:attribute-specified-p attr)))
+ attributes))
+
+ (defwrapper sax:start-prefix-mapping (prefix uri)
+ (%string prefix)
+ (%string uri))
+
+ (defwrapper sax:characters (data)
+ (%string data))
+
+ (defwrapper sax:processing-instruction (target data)
+ (%string target)
+ (%string data))
+
+ (defwrapper sax:end-prefix-mapping (prefix)
+ (%string prefix))
+
+ (defwrapper sax:end-element (namespace-uri local-name qname)
+ (%string namespace-uri)
+ (%string local-name)
+ (%string qname))
+
+ (defwrapper sax:end-document ())
+
+ (defwrapper sax:comment (data)
+ (%string data))
+
+ (defwrapper sax:start-cdata ())
+
+ (defwrapper sax:end-cdata ())
+
+ (defwrapper sax:start-dtd (name public-id system-id)
+ (%string name)
+ (%string public-id)
+ (%string system-id))
+
+ (defwrapper sax:start-internal-subset ())
+ (defwrapper sax:end-internal-subset ())
+
+ (defwrapper sax:end-dtd ())
+
+ (defwrapper sax:unparsed-entity-declaration
+ (name public-id system-id notation-name)
+ (%string name)
+ (%string public-id)
+ (%string system-id)
+ (%string notation-name))
+
+ (defwrapper sax:external-entity-declaration
+ (kind name public-id system-id)
+ (%string kind)
+ (%string name)
+ (%string public-id)
+ (%string system-id))
+
+ (defwrapper sax:internal-entity-declaration
+ (kind name value)
+ kind
+ (%string name)
+ (%string value))
+
+ (defwrapper sax:notation-declaration
+ (name public-id system-id)
+ (%string name)
+ (%string public-id)
+ (%string system-id))
+
+ (defwrapper sax:element-declaration (name model)
+ (%string name)
+ model)
+
+ (defwrapper sax:attribute-declaration
+ (element-name attribute-name type default)
+ (%string element-name)
+ (%string attribute-name)
+ (%string type)
+ (%string default))
+
+ (defwrapper sax:entity-resolver
+ (resolver)
+ resolver)
+
+ (defwrapper sax::dtd
+ (dtd)
+ dtd))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-handler.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-handler.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-handler.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,422 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: SAX; readtable: runes; Encoding: utf-8; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: A SAX2-like API for the xml parser
+;;; Created: 2003-06-30
+;;; Author: Henrik Motakef <hmot(a)henrik-motakef.de>
+;;; Author: David Lichteblau (DTD-related changes)
+;;; License: BSD
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 2003 by Henrik Motakef
+;;; (c) copyright 2004 knowledgeTools Int. GmbH
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions are
+;;; met:
+;;;
+;;; 1. Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+;;;
+;;; 2. Redistributions in binary form must reproduce the above copyright
+;;; notice, this list of conditions and the following disclaimer in the
+;;; documentation and/or other materials provided with the distribution
+;;;
+;;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
+;;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+;;; IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+;;; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+;;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+;;; IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+;;; POSSIBILITY OF SUCH DAMAGE.
+
+;;; TODO/ Open Questions:
+
+;; o Should there be a predefined "handler" class, or even several
+;; (like Java SAX' ContentHandler, DTDHandler, LexicalHandler etc? I
+;; don't really see why.
+;; o Missing stuff from Java SAX2:
+;; * ignorable-whitespace
+;; * skipped-entity
+;; * The whole ErrorHandler class, this is better handled using
+;; conditions (but isn't yet)
+;; * The LexicalHandler (start-cdata etc) would be nice [-- partly done]
+
+(defpackage :sax
+ (:use :common-lisp)
+ (:export #:*namespace-processing*
+ #:*include-xmlns-attributes*
+ #:*use-xmlns-namespace*
+
+ #:make-attribute
+ #:find-attribute
+ #:find-attribute-ns
+ #:attribute-namespace-uri
+ #:attribute-local-name
+ #:attribute-qname
+ #:attribute-value
+ #:attribute-specified-p
+
+ #:start-document
+ #:start-prefix-mapping
+ #:start-element
+ #:characters
+ #:processing-instruction
+ #:end-element
+ #:end-prefix-mapping
+ #:end-document
+ #:comment
+ #:start-cdata
+ #:end-cdata
+ #:start-dtd
+ #:end-dtd
+ #:start-internal-subset
+ #:unparsed-internal-subset
+ #:end-internal-subset
+ #:unparsed-entity-declaration
+ #:external-entity-declaration
+ #:internal-entity-declaration
+ #:notation-declaration
+ #:element-declaration
+ #:attribute-declaration
+ #:entity-resolver
+
+ #:sax-parser
+ #:sax-parser-mixin
+ #:register-sax-parser
+ #:line-number
+ #:column-number
+ #:system-id
+ #:xml-base))
+
+(in-package :sax)
+
+
+;;;; SAX-PARSER interface
+
+(defclass sax-parser () ())
+
+(defclass sax-parser-mixin ()
+ ((sax-parser :initform nil :reader sax-parser)))
+
+(defgeneric line-number (sax-parser)
+ (:documentation
+ "Return an approximation of the current line number, or NIL.")
+ (:method ((handler sax-parser-mixin))
+ (if (sax-parser handler)
+ (line-number (sax-parser handler))
+ nil)))
+
+(defgeneric column-number (sax-parser)
+ (:documentation
+ "Return an approximation of the current column number, or NIL.")
+ (:method ((handler sax-parser-mixin))
+ (if (sax-parser handler)
+ (column-number (sax-parser handler))
+ nil)))
+
+(defgeneric system-id (sax-parser)
+ (:documentation
+ "Return the URI of the document being parsed. This is either the
+ main document, or the entity's system ID while contents of a parsed
+ general external entity are being processed.")
+ (:method ((handler sax-parser-mixin))
+ (if (sax-parser handler)
+ (system-id (sax-parser handler))
+ nil)))
+
+(defgeneric xml-base (sax-parser)
+ (:documentation
+ "Return the [Base URI] of the current element. This URI can differ from
+ the value returned by SAX:SYSTEM-ID if xml:base attributes are present.")
+ (:method ((handler sax-parser-mixin))
+ (if (sax-parser handler)
+ (xml-base (sax-parser handler))
+ nil)))
+
+
+;;;; Configuration variables
+
+;; The http://xml.org/sax/features/namespaces property
+(defvar *namespace-processing* t
+ "If non-nil (the default), namespace processing is enabled.
+
+See also `start-element' and `end-element' for a detailed description
+of the consequences of modifying this variable, and
+`*include-xmlns-attributes*' and `*use-xmlns-namespace*' for further
+related options.")
+
+;; The http://xml.org/sax/features/namespace-prefixes property.
+(defvar *include-xmlns-attributes* t
+ "If non-nil, namespace declarations are reported as normal
+attributes.
+
+This variable has no effect unless `*namespace-processing*' is
+non-nil.
+
+See also `*use-xmlns-namespace*', and `start-element' for a detailed
+description of the consequences of setting this variable.")
+
+(defvar *use-xmlns-namespace* t
+ "If this variable is nil (the default), attributes with a name like
+'xmlns:x' are not considered to be in a namespace, following the
+'Namespaces in XML' specification.
+
+If it is non-nil, such attributes are considered to be in a namespace
+with the URI 'http://www.w3.org/2000/xmlns/', following an
+incompatible change silently introduced in the errata to that spec,
+and adopted by some W3C standards.
+
+For example, an attribute like xmlns:ex='http://example.com' would be
+reported like this:
+
+*use-xmlns-namespace*: nil
+namespace-uri: nil
+local-name: nil
+qname: #\"xmlns:ex\"
+
+*use-xmlns-namespace*: t
+namespace-uri: #\"http://www.w3.org/2000/xmlns/\"
+local-name: #\"ex\"
+qname: #\"xmlns:ex\"
+
+Setting this variable has no effect unless both
+`*namespace-processing*' and `*include-xmlns-attributes*' are non-nil.")
+
+(defstruct attribute
+ namespace-uri
+ local-name
+ qname
+ value
+ specified-p)
+
+(defun %rod= (x y)
+ ;; allow rods *and* strings *and* null
+ (cond
+ ((zerop (length x)) (zerop (length y)))
+ ((zerop (length y)) nil)
+ ((stringp x) (string= x y))
+ (t (runes:rod= x y))))
+
+(defun find-attribute (qname attrs)
+ (find qname attrs :key #'attribute-qname :test #'%rod=))
+
+(defun find-attribute-ns (uri lname attrs)
+ (find-if (lambda (attr)
+ (and (%rod= uri (sax:attribute-namespace-uri attr))
+ (%rod= lname (sax:attribute-local-name attr))))
+ attrs))
+
+(defgeneric start-document (handler)
+ (:documentation "Called at the beginning of the parsing process,
+before any element, processing instruction or comment is reported.
+
+Handlers that need to maintain internal state may use this to perform
+any neccessary initializations.")
+ (:method ((handler t)) nil))
+
+(defgeneric start-element (handler namespace-uri local-name qname attributes)
+ (:documentation "Called to report the beginning of an element.
+
+There will always be a corresponding call to end-element, even in the
+case of an empty element (i.e. <foo/>).
+
+If the value of *namespaces* is non-nil, namespace-uri, local-name and
+qname are rods. If it is nil, namespace-uri and local-name are always
+nil, and it is not an error if the qname is not a well-formed
+qualified element name (for example, if it contains more than one
+colon).
+
+The attributes parameter is a list (in arbitrary order) of instances
+of the `attribute' structure class. The for their namespace-uri and
+local-name properties, the same rules as for the element name
+apply. Additionally, namespace-declaring attributes (those whose name
+is \"xmlns\" or starts with \"xmlns:\") are only included if
+*include-xmlns-attributes* is non-nil.")
+ (:method ((handler t) namespace-uri local-name qname attributes)
+ (declare (ignore namespace-uri local-name qname attributes))
+ nil))
+
+(defgeneric start-prefix-mapping (handler prefix uri)
+ (:documentation "Called when the scope of a new prefix -> namespace-uri mapping begins.
+
+This will always be called immediatly before the `start-element' event
+for the element on which the namespaces are declared.
+
+Clients don't usually have to implement this except under special
+circumstances, for example when they have to deal with qualified names
+in textual content. The parser will handle namespaces of elements and
+attributes on its own.")
+ (:method ((handler t) prefix uri) (declare (ignore prefix uri)) nil))
+
+(defgeneric characters (handler data)
+ (:documentation "Called for textual element content.
+
+The data is passed as a rod, with all entity references resolved.
+It is possible that the character content of an element is reported
+via multiple subsequent calls to this generic function.")
+ (:method ((handler t) data) (declare (ignore data)) nil))
+
+(defgeneric processing-instruction (handler target data)
+ (:documentation "Called when a processing instruction is read.
+
+Both target and data are rods.")
+ (:method ((handler t) target data) (declare (ignore target data)) nil))
+
+(defgeneric end-prefix-mapping (handler prefix)
+ (:documentation "Called when a prefix -> namespace-uri mapping goes out of scope.
+
+This will always be called immediatly after the `end-element' event
+for the element on which the namespace is declared. The order of the
+end-prefix-mapping events is otherwise not guaranteed.
+
+Clients don't usually have to implement this except under special
+circumstances, for example when they have to deal with qualified names
+in textual content. The parser will handle namespaces of elements and
+attributes on its own.")
+ (:method ((handler t) prefix) prefix nil))
+
+(defgeneric end-element (handler namespace-uri local-name qname)
+ (:documentation "Called to report the end of an element.
+
+See the documentation for `start-element' for a description of the
+parameters.")
+ (:method ((handler t) namespace-uri local-name qname)
+ (declare (ignore namespace-uri local-name qname))
+ nil))
+
+(defgeneric end-document (handler)
+ (:documentation "Called at the end of parsing a document.
+This is always the last function called in the parsing process.
+
+In contrast to all of the other methods, the return value of this gf
+is significant, it will be returned by the parse-file/stream/string function.")
+ (:method ((handler t)) nil))
+
+;; LexicalHandler
+
+(defgeneric comment (handler data)
+ (:method ((handler t) data) data nil))
+
+(defgeneric start-cdata (handler)
+ (:documentation "Called at the beginning of parsing a CDATA section.
+
+Handlers only have to implement this if they are interested in the
+lexical structure of the parsed document. The content of the CDATA
+section is reported via the `characters' generic function like all
+other textual content.")
+ (:method ((handler t)) nil))
+
+(defgeneric end-cdata (handler)
+ (:documentation "Called at the end of parsing a CDATA section.
+
+Handlers only have to implement this if they are interested in the
+lexical structure of the parsed document. The content of the CDATA
+section is reported via the `characters' generic function like all
+other textual content.")
+ (:method ((handler t)) nil))
+
+(defgeneric start-dtd (handler name public-id system-id)
+ (:documentation "Called at the beginning of parsing a DTD.")
+ (:method ((handler t) name public-id system-id)
+ (declare (ignore name public-id system-id))
+ nil))
+
+(defgeneric end-dtd (handler)
+ (:documentation "Called at the end of parsing a DTD.")
+ (:method ((handler t)) nil))
+
+(defgeneric start-internal-subset (handler)
+ (:documentation "Reports that an internal subset is present. Called before
+any definition from the internal subset is reported.")
+ (:method ((handler t)) nil))
+
+(defgeneric end-internal-subset (handler)
+ (:documentation "Called after processing of the internal subset has
+finished, if present.")
+ (:method ((handler t)) nil))
+
+(defgeneric unparsed-internal-subset (handler str)
+ (:documentation "Reports that an internal subset is present, but has not
+been parsed and is available as a string.")
+ (:method ((handler t) str) nil))
+
+(defgeneric unparsed-entity-declaration
+ (handler name public-id system-id notation-name)
+ (:documentation
+ "Called when an unparsed entity declaration is seen in a DTD.")
+ (:method ((handler t) name public-id system-id notation-name)
+ (declare (ignore name public-id system-id notation-name))
+ nil))
+
+(defgeneric external-entity-declaration
+ (handler kind name public-id system-id)
+ (:documentation
+ "Called when a parsed external entity declaration is seen in a DTD.")
+ (:method ((handler t) kind name public-id system-id)
+ (declare (ignore kind name public-id system-id))
+ nil))
+
+(defgeneric internal-entity-declaration
+ (handler kind name value)
+ (:documentation
+ "Called when an internal entity declaration is seen in a DTD.")
+ (:method ((handler t) kind name value)
+ (declare (ignore kind name value))
+ nil))
+
+(defgeneric notation-declaration
+ (handler name public-id system-id)
+ (:documentation
+ "Called when a notation declaration is seen while parsing a DTD.")
+ (:method ((handler t) name public-id system-id)
+ (declare (ignore name public-id system-id))
+ nil))
+
+(defgeneric element-declaration (handler name model)
+ (:documentation
+ "Called when a element declaration is seen in a DTD. Model is not a string,
+ but a nested list, with *, ?, +, OR, and AND being the operators, rods
+ as names, :EMPTY and :PCDATA as special tokens. (AND represents
+ sequences.)")
+ (:method ((handler t) name model)
+ (declare (ignore name model))
+ nil))
+
+(defgeneric attribute-declaration
+ (handler element-name attribute-name type default)
+ (:documentation
+ "Called when an attribute declaration is seen in a DTD.
+ type one of :CDATA, :ID, :IDREF, :IDREFS,
+ :ENTITY, :ENTITIES, :NMTOKEN, :NMTOKENS,
+ (:NOTATION <name>*), or (:ENUMERATION <name>*)
+ default :REQUIRED, :IMPLIED, (:FIXED content), or (:DEFAULT content)")
+ (:method ((handler t) element-name attribute-name type value)
+ (declare (ignore element-name attribute-name type value))
+ nil))
+
+(defgeneric entity-resolver
+ (handler resolver)
+ (:documentation
+ "Called between sax:end-dtd and sax:end-document to register an entity
+ resolver, a function of two arguments: An entity name and SAX handler.
+ When called, the resolver function will parse the named entity's data.")
+ (:method ((handler t) resolver)
+ (declare (ignore resolver))
+ nil))
+
+(defgeneric register-sax-parser
+ (handler sax-parser)
+ (:documentation
+ "Set the SAX-PARSER instance of this handler.")
+ (:method ((handler t) sax-parser)
+ (declare (ignore sax-parser))
+ nil)
+ (:method ((handler sax-parser-mixin) sax-parser)
+ (setf (slot-value handler 'sax-parser) sax-parser)))
+
+;; internal for now
+(defgeneric dtd (handler dtd)
+ (:method ((handler t) dtd) (declare (ignore dtd)) nil))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-proxy.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-proxy.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-proxy.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,64 @@
+;;;; sax-proxy.lisp
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Copyright (c) 2004 David Lichteblau
+;;;; Author: David Lichteblau
+
+(in-package :cxml)
+
+(defclass broadcast-handler (sax:sax-parser-mixin)
+ ((handlers :initform nil
+ :initarg :handlers
+ :accessor broadcast-handler-handlers)))
+
+(defun make-broadcast-handler (&rest handlers)
+ (make-instance 'broadcast-handler :handlers handlers))
+
+(defclass sax-proxy (broadcast-handler)
+ ())
+
+(defmethod initialize-instance
+ :after ((instance sax-proxy) &key chained-handler)
+ (setf (proxy-chained-handler instance) chained-handler))
+
+(defmethod proxy-chained-handler ((instance sax-proxy))
+ (car (broadcast-handler-handlers instance)))
+
+(defmethod (setf proxy-chained-handler) (newval (instance sax-proxy))
+ (setf (broadcast-handler-handlers instance) (list newval)))
+
+(macrolet ((define-proxy-method (name (&rest args))
+ `(defmethod ,name ((handler broadcast-handler) ,@args)
+ (let (result)
+ (dolist (next (broadcast-handler-handlers handler))
+ (setf result (,name next ,@args)))
+ result))))
+ (define-proxy-method sax:start-document ())
+ (define-proxy-method sax:start-element (uri lname qname attributes))
+ (define-proxy-method sax:start-prefix-mapping (prefix uri))
+ (define-proxy-method sax:characters (data))
+ (define-proxy-method sax:processing-instruction (target data))
+ (define-proxy-method sax:end-prefix-mapping (prefix))
+ (define-proxy-method sax:end-element (namespace-uri local-name qname))
+ (define-proxy-method sax:end-document ())
+ (define-proxy-method sax:comment (data))
+ (define-proxy-method sax:start-cdata ())
+ (define-proxy-method sax:end-cdata ())
+ (define-proxy-method sax:start-dtd (name public-id system-id))
+ (define-proxy-method sax:end-dtd ())
+ (define-proxy-method sax:start-internal-subset ())
+ (define-proxy-method sax:end-internal-subset ())
+ (define-proxy-method sax:unparsed-entity-declaration (name pub sys not))
+ (define-proxy-method sax:external-entity-declaration (kind name pub sys))
+ (define-proxy-method sax:internal-entity-declaration (kind name value))
+ (define-proxy-method sax:notation-declaration (name public-id system-id))
+ (define-proxy-method sax:element-declaration (name model))
+ (define-proxy-method sax:attribute-declaration (elt attr type default))
+ (define-proxy-method sax:entity-resolver (resolver))
+ (define-proxy-method sax::dtd (dtd)))
+
+(defmethod sax:register-sax-parser :after ((handler broadcast-handler) parser)
+ (dolist (next (broadcast-handler-handlers handler))
+ (sax:register-sax-parser next parser)))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Entries 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Entries 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,4 @@
+/event-collecting-handler.lisp/1.1.1.1/Sun Mar 13 18:02:10 2005//
+/package.lisp/1.1.1.1/Sun Mar 13 18:02:10 2005//
+/tests.lisp/1.2/Wed Dec 28 23:18:07 2005//
+D
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Repository 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Repository 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+cxml/xml/sax-tests
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Root 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/CVS/Root 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1 @@
+:ext:dlichteblau@common-lisp.net:/project/cxml/cvsroot
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/event-collecting-handler.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/event-collecting-handler.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/event-collecting-handler.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,37 @@
+(in-package :sax-tests)
+
+(defclass event-collecting-handler ()
+ ((event-list :initform '() :accessor event-list)))
+
+(defmethod start-document ((handler event-collecting-handler))
+ (push (list :start-document) (event-list handler)))
+
+(defmethod start-element ((handler event-collecting-handler) ns-uri local-name qname attrs)
+ (push (list :start-element ns-uri local-name qname attrs)
+ (event-list handler)))
+
+(defmethod start-prefix-mapping ((handler event-collecting-handler) prefix uri)
+ (push (list :start-prefix-mapping prefix uri)
+ (event-list handler)))
+
+(defmethod characters ((handler event-collecting-handler) data)
+ (push (list :characters data)
+ (event-list handler)))
+
+(defmethod processing-instruction ((handler event-collecting-handler) target data)
+ (push (list :processing-instruction target data)
+ (event-list handler)))
+
+(defmethod end-prefix-mapping ((handler event-collecting-handler) prefix)
+ (push (list :end-prefix-mapping prefix)
+ (event-list handler)))
+
+(defmethod end-element ((handler event-collecting-handler) namespace-uri local-name qname)
+ (push (list :end-element namespace-uri local-name qname)
+ (event-list handler)))
+
+(defmethod end-document ((handler event-collecting-handler))
+ (push (list :end-document)
+ (event-list handler))
+
+ (nreverse (event-list handler)))
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/package.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/package.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/package.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,4 @@
+(defpackage :sax-tests
+ (:use :cl :xml :sax :glisp :rt)
+ (:export #:event-collecting-handler))
+
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/tests.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/tests.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/sax-tests/tests.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,330 @@
+(in-package :sax-tests)
+
+(defun first-start-element-event (string)
+ (let ((events (cxml:parse-rod string (make-instance 'event-collecting-handler))))
+ (find :start-element events :key #'car)))
+
+
+;;; Attribute handling
+
+(deftest no-default-namespace-for-attributes
+ (let* ((evt (first-start-element-event "<x xmlns='http://example.com' a='b'/>"))
+ (attr (car (fifth evt))))
+ (values
+ (attribute-namespace-uri attr)
+ (attribute-local-name attr)))
+ nil nil)
+
+(deftest attribute-uniqueness-1
+ (handler-case
+ (cxml:parse-rod "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest attribute-uniqueness-2
+ (handler-case
+ (cxml:parse-rod "<x xmlns:a='http://example.com' xmlns='http://example.com' a:a='1' a='1'/>")
+ (error () nil)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ t))
+ t)
+
+(deftest attribute-uniqueness-3
+ (let ((sax:*namespace-processing* nil))
+ (handler-case
+ (cxml:parse-rod "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>")
+ (error () nil)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ t)))
+ t)
+
+;;; Namespace undeclaring
+
+(deftest undeclare-default-namespace-1
+ (let* ((evts (cxml:parse-rod "<x xmlns='http://example.com'><y xmlns='' a='1'/></x>"
+ (make-instance 'event-collecting-handler)))
+ (start-elt-events (remove :start-element evts :test (complement #'eql) :key #'car))
+ (evt1 (first start-elt-events))
+ (evt2 (second start-elt-events )))
+ (values
+ (rod= #"http://example.com" (second evt1))
+ (second evt2)
+ (third evt2)))
+ t nil nil)
+
+(deftest undeclare-other-namespace
+ (handler-case
+ (cxml:parse-rod "<x:x xmlns:x='http://example.com'><x:y xmlns:x='' a='1'/></x:x>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+
+;;; Require names otherwise totally out of scope of the xmlns rec to be NcNames for no reason
+
+(deftest pi-names-are-ncnames-when-namespace-processing-1
+ (handler-case
+ (cxml:parse-rod "<?a:b c?><x/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest pi-names-are-ncnames-when-namespace-processing-2
+ (let ((sax:*namespace-processing* nil))
+ (handler-case
+ (cxml:parse-rod "<?a:b c?><x/>")
+ (error () nil)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ t)))
+ t)
+
+(deftest entity-names-are-ncnames-when-namespace-processing-1
+ (handler-case
+ (cxml:parse-rod "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest entity-names-are-ncnames-when-namespace-processing-2
+ (handler-case
+ (cxml:parse-rod "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest entity-names-are-ncnames-when-namespace-processing-3
+ (let ((sax:*namespace-processing* nil))
+ (handler-case
+ (cxml:parse-rod "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>")
+ (error () nil)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ t)))
+ t)
+
+(deftest entity-names-are-ncnames-when-namespace-processing-4
+ (let ((sax:*namespace-processing* nil))
+ (handler-case
+ (cxml:parse-rod "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>")
+ (error () nil)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ t)))
+ t)
+
+;;; Inclusion of xmlns attributes
+
+(deftest xmlns-attr-include-1
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (evt (first-start-element-event "<x xmlns='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (length attrs))
+ 1)
+
+(deftest xmlns-attr-discard-1
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* nil)
+ (evt (first-start-element-event "<x xmlns='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (length attrs))
+ 0)
+
+;;; Namespace of xmlns attributes
+
+(deftest xmlns-attr-ns-uri-1
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* nil)
+ (evt (first-start-element-event "<x xmlns='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (attribute-namespace-uri (car attrs)))
+ nil)
+
+(deftest xmlns-attr-ns-uri-2
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* nil)
+ (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (attribute-namespace-uri (car attrs)))
+ nil)
+
+(deftest xmlns-attr-ns-uri-3
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* t)
+ (evt (first-start-element-event "<x xmlns='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (attribute-namespace-uri (car attrs)))
+ nil)
+
+(deftest xmlns-attr-ns-uri-4
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* t)
+ (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (rod= #"http://www.w3.org/2000/xmlns/" (attribute-namespace-uri (car attrs))))
+ t)
+
+(deftest xmlns-attr-ns-local-name-1
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* nil)
+ (evt (first-start-element-event "<x xmlns='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (attribute-local-name (car attrs)))
+ nil)
+
+(deftest xmlns-attr-ns-local-name-2
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* nil)
+ (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (attribute-local-name (car attrs)))
+ nil)
+
+(deftest xmlns-attr-ns-local-name-3
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* t)
+ (evt (first-start-element-event "<x xmlns='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (attribute-local-name (car attrs)))
+ nil)
+
+(deftest xmlns-attr-ns-local-name-4
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* t)
+ (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (rod= #"foo" (attribute-local-name (car attrs))))
+ t)
+
+(deftest xmlns-attr-qname-1
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* nil)
+ (evt (first-start-element-event "<x xmlns='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (rod= #"xmlns" (attribute-qname (car attrs))))
+ t)
+
+(deftest xmlns-attr-qname-2
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* nil)
+ (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (rod= #"xmlns:foo" (attribute-qname (car attrs))))
+ t)
+
+(deftest xmlns-attr-qname-4
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* t)
+ (evt (first-start-element-event "<x xmlns='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (rod= #"xmlns" (attribute-qname (car attrs))))
+ t)
+
+(deftest xmlns-attr-qname-4
+ (let* ((sax:*namespace-processing* t)
+ (sax:*include-xmlns-attributes* t)
+ (sax:*use-xmlns-namespace* t)
+ (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>"))
+ (attrs (fifth evt)))
+ (rod= #"xmlns:foo" (attribute-qname (car attrs))))
+ t)
+
+
+;;; Predefined Namespaces
+
+(deftest redefine-xml-namespace-1
+ (handler-case
+ (cxml:parse-rod "<x xmlns:xml='http://www.w3.org/XML/1998/namespace'/>")
+ (error () nil)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ t))
+ t)
+
+(deftest redefine-xml-namespace-2
+ (handler-case
+ (cxml:parse-rod "<x xmlns:xml='http://example.com/wrong-uri'/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest redefine-xml-namespace-3
+ (handler-case
+ (cxml:parse-rod "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest redefine-xml-namespace-4
+ (handler-case
+ (cxml:parse-rod "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest redefine-xmlns-namespace-1
+ (handler-case
+ (cxml:parse-rod "<x xmlns:xmlns='http://www.w3.org/2000/xmlns/'/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest redefine-xmlns-namespace-2
+ (handler-case
+ (cxml:parse-rod "<x xmlns:xmlns='http://example.com/wrong-ns'/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest redefine-xmlns-namespace-3
+ (handler-case
+ (cxml:parse-rod "<x xmlns:wrong='http://www.w3.org/2000/xmlns/'/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
+
+(deftest redefine-xmlns-namespace-4
+ (handler-case
+ (cxml:parse-rod "<x xmlns='http://www.w3.org/2000/xmlns/'/>")
+ (error () t)
+ (:no-error (&rest junk)
+ (declare (ignore junk))
+ nil))
+ t)
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/space-normalizer.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/space-normalizer.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/space-normalizer.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,62 @@
+;;;; space-normalizer.lisp -- whitespace removal
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Copyright (c) 2005 David Lichteblau
+
+(in-package :cxml)
+
+(defclass whitespace-normalizer (sax-proxy)
+ ((attributes :initform '(t) :accessor xml-space-attributes)
+ (models :initform nil :accessor xml-space-models)
+ (dtd :initarg :dtd :accessor xml-space-dtd)))
+
+(defun make-whitespace-normalizer (chained-handler &optional dtd)
+ (make-instance 'whitespace-normalizer
+ :dtd dtd
+ :chained-handler chained-handler))
+
+(defmethod sax::dtd ((handler whitespace-normalizer) dtd)
+ (unless (xml-space-dtd handler)
+ (setf (xml-space-dtd handler) dtd)))
+
+(defmethod sax:start-element
+ ((handler whitespace-normalizer) uri lname qname attrs)
+ (declare (ignore uri lname))
+ (let ((dtd (xml-space-dtd handler)))
+ (when dtd
+ (let ((xml-space
+ (sax:find-attribute (if (stringp qname) "xml:space" #"xml:space")
+ attrs)))
+ (push (if xml-space
+ (rod= (rod (sax:attribute-value xml-space)) #"default")
+ (car (xml-space-attributes handler)))
+ (xml-space-attributes handler)))
+ (let* ((e (cxml::find-element (rod qname) dtd))
+ (cspec (when e (cxml::elmdef-content e))))
+ (push (and (consp cspec)
+ (not (and (eq (car cspec) '*)
+ (let ((subspec (second cspec)))
+ (and (eq (car subspec) 'or)
+ (eq (cadr subspec) :PCDATA))))))
+ (xml-space-models handler)))))
+ (call-next-method))
+
+(defmethod sax:characters ((handler whitespace-normalizer) data)
+ (cond
+ ((and (xml-space-dtd handler)
+ (car (xml-space-attributes handler))
+ (car (xml-space-models handler)))
+ (unless (every #'white-space-rune-p (rod data))
+ (warn "non-whitespace character data in element content")
+ (call-next-method)))
+ (t
+ (call-next-method))))
+
+(defmethod sax:end-element ((handler whitespace-normalizer) uri lname qname)
+ (declare (ignore uri lname qname))
+ (when (xml-space-dtd handler)
+ (pop (xml-space-attributes handler))
+ (pop (xml-space-models handler)))
+ (call-next-method))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/split-sequence.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/split-sequence.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/split-sequence.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,44 @@
+;;; This code was based on Arthur Lemmens' in
+;;; <URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40simplex.nl>;
+
+(in-package :cxml)
+
+(defun split-sequence-if (predicate seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (key nil key-supplied))
+ (let ((len (length seq))
+ (other-keys (when key-supplied
+ (list :key key))))
+ (unless end (setq end len))
+ (if from-end
+ (loop for right = end then left
+ for left = (max (or (apply #'position-if predicate seq
+ :end right
+ :from-end t
+ other-keys)
+ -1)
+ (1- start))
+ unless (and (= right (1+ left))
+ remove-empty-subseqs) ; empty subseq we don't want
+ if (and count (>= nr-elts count))
+ ;; We can't take any more. Return now.
+ return (values (nreverse subseqs) right)
+ else
+ collect (subseq seq (1+ left) right) into subseqs
+ and sum 1 into nr-elts
+ until (< left start)
+ finally (return (values (nreverse subseqs) (1+ left))))
+ (loop for left = start then (+ right 1)
+ for right = (min (or (apply #'position-if predicate seq
+ :start left
+ other-keys)
+ len)
+ end)
+ unless (and (= right left)
+ remove-empty-subseqs) ; empty subseq we don't want
+ if (and count (>= nr-elts count))
+ ;; We can't take any more. Return now.
+ return (values subseqs left)
+ else
+ collect (subseq seq left right) into subseqs
+ and sum 1 into nr-elts
+ until (>= right end)
+ finally (return (values subseqs right))))))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/unparse.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/unparse.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/unparse.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,673 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CXML; readtable: runes; Encoding: utf-8; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Unparse XML
+;;; Title: (including support for canonic XML according to J.Clark)
+;;; Created: 1999-09-09
+;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;; Author: David Lichteblau <david(a)lichteblau.com>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1999 by Gilbert Baumann
+;;; (c) copyright 2004 by knowledgeTools Int. GmbH
+;;; (c) copyright 2004 by David Lichteblau (for headcraft.de)
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+(in-package :cxml)
+
+;;
+;; | Canonical XML
+;; | =============
+;; |
+;; | This document defines a subset of XML called canonical XML. The
+;; | intended use of canonical XML is in testing XML processors, as a
+;; | representation of the result of parsing an XML document.
+;; |
+;; | Every well-formed XML document has a unique structurally equivalent
+;; | canonical XML document. Two structurally equivalent XML documents have
+;; | a byte-for-byte identical canonical XML document. Canonicalizing an
+;; | XML document requires only information that an XML processor is
+;; | required to make available to an application.
+;; |
+;; | A canonical XML document conforms to the following grammar:
+;; |
+;; | CanonXML ::= Pi* element Pi*
+;; | element ::= Stag (Datachar | Pi | element)* Etag
+;; | Stag ::= '<' Name Atts '>'
+;; | Etag ::= '</' Name '>'
+;; | Pi ::= '<?' Name ' ' (((Char - S) Char*)? - (Char* '?>' Char*)) '?>'
+;; | Atts ::= (' ' Name '=' '"' Datachar* '"')*
+;; | Datachar ::= '&' | '<' | '>' | '"'
+;; | | '	'| ' '| ' '
+;; | | (Char - ('&' | '<' | '>' | '"' | #x9 | #xA | #xD))
+;; | Name ::= (see XML spec)
+;; | Char ::= (see XML spec)
+;; | S ::= (see XML spec)
+;; |
+;; | Attributes are in lexicographical order (in Unicode bit order).
+;; |
+;; | A canonical XML document is encoded in UTF-8.
+;; |
+;; | Ignorable white space is considered significant and is treated
+;; | equivalently to data.
+;;
+;; -- James Clark (jjc(a)jclark.com)
+
+
+;;;; SINK: an xml output sink
+
+(defclass sink ()
+ ((ystream :initarg :ystream :accessor sink-ystream)
+ (width :initform 79 :initarg :width :accessor width)
+ (canonical :initform nil :initarg :canonical :accessor canonical)
+ (indentation :initform nil :initarg :indentation :accessor indentation)
+ (current-indentation :initform 0 :accessor current-indentation)
+ (notations :initform (make-buffer :element-type t) :accessor notations)
+ (name-for-dtd :accessor name-for-dtd)
+ (previous-notation :initform nil :accessor previous-notation)
+ (have-doctype :initform nil :accessor have-doctype)
+ (have-internal-subset :initform nil :accessor have-internal-subset)
+ (stack :initform nil :accessor stack)))
+
+(defmethod initialize-instance :after ((instance sink) &key)
+ (when (eq (canonical instance) t)
+ (setf (canonical instance) 1))
+ (unless (member (canonical instance) '(nil 1 2))
+ (error "Invalid canonical form: ~A" (canonical instance)))
+ (when (and (canonical instance) (indentation instance))
+ (error "Cannot indent XML in canonical mode")))
+
+(defun make-buffer (&key (element-type '(unsigned-byte 8)))
+ (make-array 1
+ :element-type element-type
+ :adjustable t
+ :fill-pointer 0))
+
+;; bisschen unschoen hier die ganze api zu duplizieren, aber die
+;; ystreams sind noch undokumentiert
+(macrolet ((define-maker (make-sink make-ystream &rest args)
+ `(defun ,make-sink (,@args &rest initargs)
+ (apply #'make-instance
+ 'sink
+ :ystream (,make-ystream ,@args)
+ initargs))))
+ (define-maker make-octet-vector-sink make-octet-vector-ystream)
+ (define-maker make-octet-stream-sink make-octet-stream-ystream stream)
+ (define-maker make-rod-sink make-rod-ystream)
+
+ #+rune-is-character
+ (define-maker make-character-stream-sink make-character-stream-ystream stream)
+
+ #-rune-is-character
+ (define-maker make-string-sink/utf8 make-string-ystream/utf8)
+
+ #-rune-is-character
+ (define-maker make-character-stream-sink/utf8
+ make-character-stream-ystream/utf8
+ stream))
+
+#+rune-is-character
+(defun make-string-sink (&rest args) (apply #'make-rod-sink args))
+
+
+(defmethod sax:end-document ((sink sink))
+ (close-ystream (sink-ystream sink)))
+
+
+;;;; doctype and notations
+
+(defmethod sax:start-document ((sink sink))
+ (unless (canonical sink)
+ (%write-rod #"<?xml version=\"1.0\" encoding=\"UTF-8\"?>" sink)
+ (%write-rune #/U+000A sink)))
+
+(defmethod sax:start-dtd ((sink sink) name public-id system-id)
+ (setf (name-for-dtd sink) name)
+ (unless (canonical sink)
+ (ensure-doctype sink public-id system-id)))
+
+(defun ensure-doctype (sink &optional public-id system-id)
+ (unless (have-doctype sink)
+ (setf (have-doctype sink) t)
+ (%write-rod #"<!DOCTYPE " sink)
+ (%write-rod (name-for-dtd sink) sink)
+ (cond
+ ((not (zerop (length public-id)))
+ (%write-rod #" PUBLIC \"" sink)
+ (unparse-string public-id sink)
+ (%write-rod #"\" \"" sink)
+ (unparse-string system-id sink)
+ (%write-rod #"\"" sink))
+ ((not (zerop (length system-id)))
+ (%write-rod #" SYSTEM \"" sink)
+ (unparse-string system-id sink)
+ (%write-rod #"\"" sink)))))
+
+(defmethod sax:start-internal-subset ((sink sink))
+ (when (have-internal-subset sink)
+ (error "duplicate internal subset"))
+ (setf (have-internal-subset sink) t)
+ (ensure-doctype sink)
+ (%write-rod #" [" sink)
+ (%write-rune #/U+000A sink))
+
+(defmethod sax:end-internal-subset ((sink sink))
+ (ensure-doctype sink)
+ (%write-rod #"]" sink))
+
+(defmethod sax:unparsed-internal-subset ((sink sink) str)
+ (when (have-internal-subset sink)
+ (error "duplicate internal subset"))
+ (setf (have-internal-subset sink) t)
+ (ensure-doctype sink)
+ (%write-rod #" [" sink)
+ (%write-rune #/U+000A sink)
+ (%write-rod str sink)
+ (%write-rod #"]" sink))
+
+;; for the benefit of the XML test suite, prefer ' over "
+(defun write-quoted-rod (x sink)
+ (let ((q (if (find #/' x) #/" #/'
+ ;; '" (thanks you Emacs indentation, the if ends here)
+ )))
+ (%write-rune q sink)
+ (%write-rod x sink)
+ (%write-rune q sink)))
+
+(defmethod sax:notation-declaration ((sink sink) name public-id system-id)
+ (let ((prev (previous-notation sink)))
+ (when (and (and (canonical sink) (>= (canonical sink) 2))
+ prev
+ (not (rod< prev name)))
+ (error "misordered notations; cannot unparse canonically"))
+ (setf (previous-notation sink) name))
+ (%write-rod #"<!NOTATION " sink)
+ (%write-rod name sink)
+ (cond
+ ((zerop (length public-id))
+ (%write-rod #" SYSTEM " sink)
+ (write-quoted-rod system-id sink))
+ ((zerop (length system-id))
+ (%write-rod #" PUBLIC " sink)
+ (write-quoted-rod public-id sink))
+ (t
+ (%write-rod #" PUBLIC " sink)
+ (write-quoted-rod public-id sink)
+ (%write-rod #" " sink)
+ (write-quoted-rod system-id sink)))
+ (%write-rune #/> sink)
+ (%write-rune #/U+000A sink))
+
+(defmethod sax:unparsed-entity-declaration
+ ((sink sink) name public-id system-id notation-name)
+ (unless (and (canonical sink) (< (canonical sink) 3))
+ (%write-rod #"<!ENTITY " sink)
+ (%write-rod name sink)
+ (cond
+ ((zerop (length public-id))
+ (%write-rod #" SYSTEM " sink)
+ (write-quoted-rod system-id sink))
+ ((zerop (length system-id))
+ (%write-rod #" PUBLIC " sink)
+ (write-quoted-rod public-id sink))
+ (t
+ (%write-rod #" PUBLIC " sink)
+ (write-quoted-rod public-id sink)
+ (%write-rod #" " sink)
+ (write-quoted-rod system-id sink)))
+ (%write-rod #" NDATA " sink)
+ (%write-rod notation-name sink)
+ (%write-rune #/> sink)
+ (%write-rune #/U+000A sink)))
+
+(defmethod sax:external-entity-declaration
+ ((sink sink) kind name public-id system-id)
+ (when (canonical sink)
+ (error "cannot serialize parsed entities in canonical mode"))
+ (%write-rod #"<!ENTITY " sink)
+ (when (eq kind :parameter)
+ (%write-rod #" % " sink))
+ (%write-rod name sink)
+ (cond
+ ((zerop (length public-id))
+ (%write-rod #" SYSTEM " sink)
+ (write-quoted-rod system-id sink))
+ ((zerop (length system-id))
+ (%write-rod #" PUBLIC " sink)
+ (write-quoted-rod public-id sink))
+ (t
+ (%write-rod #" PUBLIC " sink)
+ (write-quoted-rod public-id sink)
+ (%write-rod #" " sink)
+ (write-quoted-rod system-id sink)))
+ (%write-rune #/> sink)
+ (%write-rune #/U+000A sink))
+
+(defmethod sax:internal-entity-declaration ((sink sink) kind name value)
+ (when (canonical sink)
+ (error "cannot serialize parsed entities in canonical mode"))
+ (%write-rod #"<!ENTITY " sink)
+ (when (eq kind :parameter)
+ (%write-rod #" % " sink))
+ (%write-rod name sink)
+ (%write-rune #/U+0020 sink)
+ (%write-rune #/\" sink)
+ (unparse-dtd-string value sink)
+ (%write-rune #/\" sink)
+ (%write-rune #/> sink)
+ (%write-rune #/U+000A sink))
+
+(defmethod sax:element-declaration ((sink sink) name model)
+ (when (canonical sink)
+ (error "cannot serialize element type declarations in canonical mode"))
+ (%write-rod #"<!ELEMENT " sink)
+ (%write-rod name sink)
+ (%write-rune #/U+0020 sink)
+ (labels ((walk (m)
+ (cond
+ ((eq m :EMPTY)
+ (%write-rod "EMPTY" sink))
+ ((eq m :PCDATA)
+ (%write-rod "#PCDATA" sink))
+ ((atom m)
+ (unparse-string m sink))
+ (t
+ (ecase (car m)
+ (and
+ (%write-rune #/\( sink)
+ (loop for (n . rest) on (cdr m) do
+ (walk n)
+ (when rest
+ (%write-rune #\, sink)))
+ (%write-rune #/\) sink))
+ (or
+ (%write-rune #/\( sink)
+ (loop for (n . rest) on (cdr m) do
+ (walk n)
+ (when rest
+ (%write-rune #\| sink)))
+ (%write-rune #/\) sink))
+ (*
+ (walk (second m))
+ (%write-rod #/* sink))
+ (+
+ (walk (second m))
+ (%write-rod #/+ sink))
+ (?
+ (walk (second m))
+ (%write-rod #/? sink)))))))
+ (walk model))
+ (%write-rune #/> sink)
+ (%write-rune #/U+000A sink))
+
+(defmethod sax:attribute-declaration ((sink sink) ename aname type default)
+ (when (canonical sink)
+ (error "cannot serialize attribute type declarations in canonical mode"))
+ (%write-rod #"<!ATTLIST " sink)
+ (%write-rod ename sink)
+ (%write-rune #/U+0020 sink)
+ (%write-rod aname sink)
+ (%write-rune #/U+0020 sink)
+ (cond
+ ((atom type)
+ (%write-rod (rod (string-upcase (symbol-name type))) sink))
+ (t
+ (when (eq :NOTATION (car type))
+ (%write-rod #"NOTATION " sink))
+ (%write-rune #/\( sink)
+ (loop for (n . rest) on (cdr type) do
+ (%write-rod n sink)
+ (when rest
+ (%write-rune #\| sink)))
+ (%write-rune #/\) sink)))
+ (%write-rune #/U+0020 sink)
+ (cond
+ ((atom default)
+ (%write-rune #/# sink)
+ (%write-rod (rod (string-upcase (symbol-name default))) sink))
+ (t
+ (when (eq :FIXED (car default))
+ (%write-rod #"#FIXED " sink))
+ (%write-rune #/\" sink)
+ (unparse-string (second default) sink)
+ (%write-rune #/\" sink)))
+ (%write-rune #/> sink)
+ (%write-rune #/U+000A sink))
+
+(defmethod sax:end-dtd ((sink sink))
+ (when (have-doctype sink)
+ (%write-rod #">" sink)
+ (%write-rune #/U+000A sink)))
+
+
+;;;; elements
+
+(defstruct (tag (:constructor make-tag (name)))
+ name
+ (n-children 0)
+ (have-gt nil))
+
+(defun sink-fresh-line (sink)
+ (unless (zerop (ystream-column (sink-ystream sink)))
+ (%write-rune #/U+000A sink) ;newline
+ (indent sink)))
+
+(defun maybe-close-tag (sink)
+ (let ((tag (car (stack sink))))
+ (when (and (tag-p tag) (not (tag-have-gt tag)))
+ (setf (tag-have-gt tag) t)
+ (%write-rune #/> sink))))
+
+(defmethod sax:start-element
+ ((sink sink) namespace-uri local-name qname attributes)
+ (declare (ignore namespace-uri local-name))
+ (maybe-close-tag sink)
+ (when (stack sink)
+ (incf (tag-n-children (first (stack sink)))))
+ (push (make-tag qname) (stack sink))
+ (when (indentation sink)
+ (sink-fresh-line sink)
+ (start-indentation-block sink))
+ (%write-rune #/< sink)
+ (%write-rod qname sink)
+ (dolist (a (if (canonical sink)
+ (sort (copy-list attributes)
+ #'rod<
+ :key #'sax:attribute-qname)
+ attributes))
+ (%write-rune #/space sink)
+ (%write-rod (sax:attribute-qname a) sink)
+ (%write-rune #/= sink)
+ (%write-rune #/\" sink)
+ (unparse-string (sax:attribute-value a) sink)
+ (%write-rune #/\" sink))
+ (when (canonical sink)
+ (maybe-close-tag sink)))
+
+(defmethod sax:end-element
+ ((sink sink) namespace-uri local-name qname)
+ (declare (ignore namespace-uri local-name))
+ (let ((tag (pop (stack sink))))
+ (unless (tag-p tag)
+ (error "output does not nest: not in an element"))
+ (unless (rod= (tag-name tag) qname)
+ (error "output does not nest: expected ~A but got ~A"
+ (rod qname) (rod (tag-name tag))))
+ (when (indentation sink)
+ (end-indentation-block sink)
+ (unless (zerop (tag-n-children tag))
+ (sink-fresh-line sink)))
+ (cond
+ ((tag-have-gt tag)
+ (%write-rod '#.(string-rod "</") sink)
+ (%write-rod qname sink)
+ (%write-rod '#.(string-rod ">") sink))
+ (t
+ (%write-rod #"/>" sink)))))
+
+(defmethod sax:processing-instruction ((sink sink) target data)
+ (maybe-close-tag sink)
+ (unless (rod-equal target '#.(string-rod "xml"))
+ (%write-rod '#.(string-rod "<?") sink)
+ (%write-rod target sink)
+ (cond
+ ((plusp (length data))
+ (%write-rune #/space sink)
+ (%write-rod data sink))
+ ((canonical sink)
+ (%write-rune #/space sink)))
+ (%write-rod '#.(string-rod "?>") sink)))
+
+(defmethod sax:start-cdata ((sink sink))
+ (maybe-close-tag sink)
+ (push :cdata (stack sink)))
+
+(defmethod sax:characters ((sink sink) data)
+ (maybe-close-tag sink)
+ (cond
+ ((and (eq (car (stack sink)) :cdata)
+ (not (canonical sink))
+ (not (search #"]]" data)))
+ (when (indentation sink)
+ (sink-fresh-line sink))
+ (%write-rod #"<![CDATA[" sink)
+ ;; XXX signal error if body is unprintable?
+ (map nil (lambda (c) (%write-rune c sink)) data)
+ (%write-rod #"]]>" sink))
+ (t
+ (if (indentation sink)
+ (unparse-indented-text data sink)
+ (let ((y (sink-ystream sink)))
+ (if (canonical sink)
+ (loop for c across data do (unparse-datachar c y))
+ (loop for c across data do (unparse-datachar-readable c y))))))))
+
+(defmethod sax:comment ((sink sink) data)
+ (maybe-close-tag sink)
+ (unless (canonical sink)
+ ;; XXX signal error if body is unprintable?
+ (%write-rod #"<!--" sink)
+ (map nil (lambda (c) (%write-rune c sink)) data)
+ (%write-rod #"-->" sink)))
+
+(defmethod sax:end-cdata ((sink sink))
+ (unless (eq (pop (stack sink)) :cdata)
+ (error "output does not nest: not in a cdata section")))
+
+(defun indent (sink)
+ (dotimes (x (current-indentation sink))
+ (%write-rune #/U+0020 sink))) ; space
+
+(defun start-indentation-block (sink)
+ (incf (current-indentation sink) (indentation sink)))
+
+(defun end-indentation-block (sink)
+ (decf (current-indentation sink) (indentation sink)))
+
+(defun unparse-indented-text (data sink)
+ (flet ((whitespacep (x)
+ (or (rune= x #/U+000A) (rune= x #/U+0020))))
+ (let* ((n (length data))
+ (pos (position-if-not #'whitespacep data))
+ (need-whitespace-p nil))
+ (cond
+ ((zerop n))
+ (pos
+ (sink-fresh-line sink)
+ (while (< pos n)
+ (let* ((w (or (position-if #'whitespacep data :start (1+ pos)) n))
+ (next (or (position-if-not #'whitespacep data :start w) n)))
+ (when need-whitespace-p
+ (if (< (+ (ystream-column (sink-ystream sink)) w (- pos))
+ (width sink))
+ (%write-rune #/U+0020 sink)
+ (sink-fresh-line sink)))
+ (loop
+ with y = (sink-ystream sink)
+ for i from pos below w do
+ (unparse-datachar-readable (elt data i) y))
+ (setf need-whitespace-p (< w n))
+ (setf pos next))))
+ (t
+ (%write-rune #/U+0020 sink))))))
+
+(defun unparse-string (str sink)
+ (let ((y (sink-ystream sink)))
+ (loop for rune across str do (unparse-datachar rune y))))
+
+(defun unparse-datachar (c ystream)
+ (cond ((rune= c #/&) (write-rod '#.(string-rod "&") ystream))
+ ((rune= c #/<) (write-rod '#.(string-rod "<") ystream))
+ ((rune= c #/>) (write-rod '#.(string-rod ">") ystream))
+ ((rune= c #/\") (write-rod '#.(string-rod """) ystream))
+ ((rune= c #/U+0009) (write-rod '#.(string-rod "	") ystream))
+ ((rune= c #/U+000A) (write-rod '#.(string-rod " ") ystream))
+ ((rune= c #/U+000D) (write-rod '#.(string-rod " ") ystream))
+ (t
+ (write-rune c ystream))))
+
+(defun unparse-datachar-readable (c ystream)
+ (cond ((rune= c #/&) (write-rod '#.(string-rod "&") ystream))
+ ((rune= c #/<) (write-rod '#.(string-rod "<") ystream))
+ ((rune= c #/>) (write-rod '#.(string-rod ">") ystream))
+ ((rune= c #/\") (write-rod '#.(string-rod """) ystream))
+ ((rune= c #/U+000D) (write-rod '#.(string-rod " ") ystream))
+ (t
+ (write-rune c ystream))))
+
+(defun unparse-dtd-string (str sink)
+ (let ((y (sink-ystream sink)))
+ (loop for rune across str do (unparse-dtd-char rune y))))
+
+(defun unparse-dtd-char (c ystream)
+ (cond ((rune= c #/%) (write-rod '#.(string-rod "%") ystream))
+ ((rune= c #/&) (write-rod '#.(string-rod "&") ystream))
+ ((rune= c #/<) (write-rod '#.(string-rod "<") ystream))
+ ((rune= c #/>) (write-rod '#.(string-rod ">") ystream))
+ ((rune= c #/\") (write-rod '#.(string-rod """) ystream))
+ ((rune= c #/U+0009) (write-rod '#.(string-rod "	") ystream))
+ ((rune= c #/U+000A) (write-rod '#.(string-rod " ") ystream))
+ ((rune= c #/U+000D) (write-rod '#.(string-rod " ") ystream))
+ (t
+ (write-rune c ystream))))
+
+(defun %write-rune (c sink)
+ (write-rune c (sink-ystream sink)))
+
+(defun %write-rod (r sink)
+ (write-rod r (sink-ystream sink)))
+
+
+;;;; convenience functions for DOMless XML serialization
+
+(defvar *current-element*)
+(defvar *sink*)
+(defvar *unparse-namespace-bindings*)
+(defvar *current-namespace-bindings*)
+
+(defmacro with-xml-output (sink &body body)
+ `(invoke-with-xml-output (lambda () ,@body) ,sink))
+
+(defun invoke-with-xml-output (fn sink)
+ (let ((*sink* sink)
+ (*current-element* nil)
+ (*unparse-namespace-bindings* *initial-namespace-bindings*)
+ (*current-namespace-bindings* nil))
+ (sax:start-document *sink*)
+ (funcall fn)
+ (sax:end-document *sink*)))
+
+(defmacro with-element (qname &body body)
+ `(invoke-with-element (lambda () ,@body) ,qname))
+
+(defmacro with-element* ((prefix lname) &body body)
+ `(invoke-with-element* (lambda () ,@body) ,prefix ,lname))
+
+(defmacro with-namespace ((prefix uri) &body body)
+ `(invoke-with-namespace (lambda () ,@body) ,prefix ,uri))
+
+(defun doctype (name public-id system-id &optional internal-subset)
+ (sax:start-dtd *sink* name public-id system-id)
+ (when internal-subset
+ (sax:unparsed-internal-subset *sink* internal-subset))
+ (sax:end-dtd *sink*))
+
+(defun maybe-emit-start-tag ()
+ (when *current-element*
+ ;; starting child node, need to emit opening tag of parent first:
+ (destructuring-bind ((uri lname qname) &rest attributes) *current-element*
+ (sax:start-element *sink* uri lname qname (reverse attributes)))
+ (setf *current-element* nil)))
+
+(defun invoke-with-namespace (fn prefix uri)
+ (let ((*unparse-namespace-bindings*
+ (acons prefix uri *unparse-namespace-bindings*))
+ (*current-namespace-bindings*
+ (acons prefix uri *current-namespace-bindings*)))
+ (sax:start-prefix-mapping *sink* prefix uri)
+ (multiple-value-prog1
+ (funcall fn)
+ (sax:end-prefix-mapping *sink* prefix))))
+
+(defun invoke-with-element (fn qname)
+ (setf qname (rod qname))
+ (multiple-value-bind (prefix lname)
+ (split-qname qname)
+ (invoke-with-element* fn prefix lname qname)))
+
+(defun find-unparse-namespace (prefix)
+ (cdr (assoc prefix *unparse-namespace-bindings* :test 'equal)))
+
+(defun invoke-with-element* (fn prefix lname &optional qname)
+ (setf prefix (when prefix (rod prefix)))
+ (setf lname (rod lname))
+ (maybe-emit-start-tag)
+ (let* ((qname (or qname
+ (if prefix (concatenate 'rod prefix #":" lname) lname)))
+ (uri (find-unparse-namespace (or prefix #"")))
+ (*current-element*
+ (cons (list uri lname qname)
+ (mapcar (lambda (x)
+ (destructuring-bind (prefix &rest uri) x
+ (sax:make-attribute
+ :namespace-uri #"http://www.w3.org/2000/xmlns/"
+ :local-name prefix
+ :qname (if (zerop (length prefix))
+ #"xmlns"
+ (concatenate 'rod #"xmlns:" prefix))
+ :value uri)))
+ *current-namespace-bindings*))))
+ (multiple-value-prog1
+ (let ((*current-namespace-bindings* nil))
+ (funcall fn))
+ (maybe-emit-start-tag)
+ (sax:end-element *sink* uri lname qname))))
+
+(defgeneric unparse-attribute (value))
+(defmethod unparse-attribute ((value string)) value)
+(defmethod unparse-attribute ((value null)) nil)
+(defmethod unparse-attribute ((value integer)) (write-to-string value))
+
+(defun attribute (qname value)
+ (setf qname (rod qname))
+ (multiple-value-bind (prefix lname)
+ (split-qname qname)
+ (attribute* prefix lname value qname)))
+
+(defun attribute* (prefix lname value &optional qname)
+ (setf value (unparse-attribute value))
+ (when value
+ (setf prefix (when prefix (rod prefix)))
+ (setf lname (rod lname))
+ (push (sax:make-attribute
+ :namespace-uri (find-unparse-namespace prefix)
+ :local-name lname
+ :qname (or qname
+ (if prefix (concatenate 'rod prefix #":" lname) lname))
+ :value (rod value))
+ (cdr *current-element*))))
+
+(defun cdata (data)
+ (maybe-emit-start-tag)
+ (sax:start-cdata *sink*)
+ (sax:characters *sink* (rod data))
+ (sax:end-cdata *sink*)
+ data)
+
+(defun text (data)
+ (maybe-emit-start-tag)
+ (sax:characters *sink* (rod data))
+ data)
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/util.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/util.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/util.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,73 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: Some common utilities for the Closure browser
+;;; Created: 1997-12-27
+;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1997-1999 by Gilbert Baumann
+
+;;; This code is free software; you can redistribute it and/or modify it
+;;; under the terms of the version 2.1 of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation, as clarified
+;;; by the "Preamble to the Gnu Lesser General Public License" found in
+;;; the file COPYING.
+;;;
+;;; This code is distributed in the hope that it will be useful,
+;;; but without any warranty; without even the implied warranty of
+;;; merchantability or fitness for a particular purpose. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; Version 2.1 of the GNU Lesser General Public License is in the file
+;;; COPYING that was distributed with this file. If it is not present,
+;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until
+;;; superseded by a newer version) or write to the Free Software
+;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+;; Changes
+;;
+;; When Who What
+;; ----------------------------------------------------------------------------
+;; 1999-08-24 GB = fixed MULTIPLE-VALUE-OR it now takes any number of
+;; subforms
+;;
+
+(in-package :cxml)
+
+;;; --------------------------------------------------------------------------------
+;;; Meta functions
+
+(defun curry (fun &rest args)
+ #'(lambda (&rest more)
+ (apply fun (append args more))))
+
+(defun rcurry (fun &rest args)
+ #'(lambda (&rest more)
+ (apply fun (append more args))))
+
+(defun compose (f g)
+ #'(lambda (&rest args)
+ (funcall f (apply g args))))
+
+;;; --------------------------------------------------------------------------------
+;;; while and until
+
+(defmacro while (test &body body)
+ `(until (not ,test) ,@body))
+
+(defmacro until (test &body body)
+ `(do () (,test) ,@body))
+
+;; prime numbers
+
+(defun primep (n)
+ "Returns true, iff `n' is prime."
+ (and (> n 2)
+ (do ((i 2 (+ i 1)))
+ ((> (* i i) n) t)
+ (cond ((zerop (mod n i)) (return nil))))))
+
+(defun nearest-greater-prime (n)
+ "Returns the smallest prime number no less than `n'."
+ (cond ((primep n) n)
+ ((nearest-greater-prime (+ n 1)))))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xml-name-rune-p.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xml-name-rune-p.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xml-name-rune-p.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,185 @@
+;;;; xml-name-rune-p -- character class definitions
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+
+(in-package :cxml)
+
+#.(funcall
+ (compile
+ nil
+ '(lambda ()
+ (let ((+max+ #xD800)
+ (base-char-ranges
+ #((#x0041 #x005A) (#x0061 #x007A) (#x00C0 #x00D6) (#x00D8 #x00F6)
+ (#x00F8 #x00FF) (#x0100 #x0131) (#x0134 #x013E) (#x0141 #x0148)
+ (#x014A #x017E) (#x0180 #x01C3) (#x01CD #x01F0) (#x01F4 #x01F5)
+ (#x01FA #x0217) (#x0250 #x02A8) (#x02BB #x02C1) (#x0386 #x0386)
+ (#x0388 #x038A) (#x038C #x038C) (#x038E #x03A1) (#x03A3 #x03CE)
+ (#x03D0 #x03D6) (#x03DA #x03DA) (#x03DC #x03DC) (#x03DE #x03DE)
+ (#x03E0 #x03E0) (#x03E2 #x03F3) (#x0401 #x040C) (#x040E #x044F)
+ (#x0451 #x045C) (#x045E #x0481) (#x0490 #x04C4) (#x04C7 #x04C8)
+ (#x04CB #x04CC) (#x04D0 #x04EB) (#x04EE #x04F5) (#x04F8 #x04F9)
+ (#x0531 #x0556) (#x0559 #x0559) (#x0561 #x0586) (#x05D0 #x05EA)
+ (#x05F0 #x05F2) (#x0621 #x063A) (#x0641 #x064A) (#x0671 #x06B7)
+ (#x06BA #x06BE) (#x06C0 #x06CE) (#x06D0 #x06D3) (#x06D5 #x06D5)
+ (#x06E5 #x06E6) (#x0905 #x0939) (#x093D #x093D) (#x0958 #x0961)
+ (#x0985 #x098C) (#x098F #x0990) (#x0993 #x09A8) (#x09AA #x09B0)
+ (#x09B2 #x09B2) (#x09B6 #x09B9) (#x09DC #x09DD) (#x09DF #x09E1)
+ (#x09F0 #x09F1) (#x0A05 #x0A0A) (#x0A0F #x0A10) (#x0A13 #x0A28)
+ (#x0A2A #x0A30) (#x0A32 #x0A33) (#x0A35 #x0A36) (#x0A38 #x0A39)
+ (#x0A59 #x0A5C) (#x0A5E #x0A5E) (#x0A72 #x0A74) (#x0A85 #x0A8B)
+ (#x0A8D #x0A8D) (#x0A8F #x0A91) (#x0A93 #x0AA8) (#x0AAA #x0AB0)
+ (#x0AB2 #x0AB3) (#x0AB5 #x0AB9) (#x0ABD #x0ABD) (#x0AE0 #x0AE0)
+ (#x0B05 #x0B0C) (#x0B0F #x0B10) (#x0B13 #x0B28) (#x0B2A #x0B30)
+ (#x0B32 #x0B33) (#x0B36 #x0B39) (#x0B3D #x0B3D) (#x0B5C #x0B5D)
+ (#x0B5F #x0B61) (#x0B85 #x0B8A) (#x0B8E #x0B90) (#x0B92 #x0B95)
+ (#x0B99 #x0B9A) (#x0B9C #x0B9C) (#x0B9E #x0B9F) (#x0BA3 #x0BA4)
+ (#x0BA8 #x0BAA) (#x0BAE #x0BB5) (#x0BB7 #x0BB9) (#x0C05 #x0C0C)
+ (#x0C0E #x0C10) (#x0C12 #x0C28) (#x0C2A #x0C33) (#x0C35 #x0C39)
+ (#x0C60 #x0C61) (#x0C85 #x0C8C) (#x0C8E #x0C90) (#x0C92 #x0CA8)
+ (#x0CAA #x0CB3) (#x0CB5 #x0CB9) (#x0CDE #x0CDE) (#x0CE0 #x0CE1)
+ (#x0D05 #x0D0C) (#x0D0E #x0D10) (#x0D12 #x0D28) (#x0D2A #x0D39)
+ (#x0D60 #x0D61) (#x0E01 #x0E2E) (#x0E30 #x0E30) (#x0E32 #x0E33)
+ (#x0E40 #x0E45) (#x0E81 #x0E82) (#x0E84 #x0E84) (#x0E87 #x0E88)
+ (#x0E8A #x0E8A) (#x0E8D #x0E8D) (#x0E94 #x0E97) (#x0E99 #x0E9F)
+ (#x0EA1 #x0EA3) (#x0EA5 #x0EA5) (#x0EA7 #x0EA7) (#x0EAA #x0EAB)
+ (#x0EAD #x0EAE) (#x0EB0 #x0EB0) (#x0EB2 #x0EB3) (#x0EBD #x0EBD)
+ (#x0EC0 #x0EC4) (#x0F40 #x0F47) (#x0F49 #x0F69) (#x10A0 #x10C5)
+ (#x10D0 #x10F6) (#x1100 #x1100) (#x1102 #x1103) (#x1105 #x1107)
+ (#x1109 #x1109) (#x110B #x110C) (#x110E #x1112) (#x113C #x113C)
+ (#x113E #x113E) (#x1140 #x1140) (#x114C #x114C) (#x114E #x114E)
+ (#x1150 #x1150) (#x1154 #x1155) (#x1159 #x1159) (#x115F #x1161)
+ (#x1163 #x1163) (#x1165 #x1165) (#x1167 #x1167) (#x1169 #x1169)
+ (#x116D #x116E) (#x1172 #x1173) (#x1175 #x1175) (#x119E #x119E)
+ (#x11A8 #x11A8) (#x11AB #x11AB) (#x11AE #x11AF) (#x11B7 #x11B8)
+ (#x11BA #x11BA) (#x11BC #x11C2) (#x11EB #x11EB) (#x11F0 #x11F0)
+ (#x11F9 #x11F9) (#x1E00 #x1E9B) (#x1EA0 #x1EF9) (#x1F00 #x1F15)
+ (#x1F18 #x1F1D) (#x1F20 #x1F45) (#x1F48 #x1F4D) (#x1F50 #x1F57)
+ (#x1F59 #x1F59) (#x1F5B #x1F5B) (#x1F5D #x1F5D) (#x1F5F #x1F7D)
+ (#x1F80 #x1FB4) (#x1FB6 #x1FBC) (#x1FBE #x1FBE) (#x1FC2 #x1FC4)
+ (#x1FC6 #x1FCC) (#x1FD0 #x1FD3) (#x1FD6 #x1FDB) (#x1FE0 #x1FEC)
+ (#x1FF2 #x1FF4) (#x1FF6 #x1FFC) (#x2126 #x2126) (#x212A #x212B)
+ (#x212E #x212E) (#x2180 #x2182) (#x3041 #x3094) (#x30A1 #x30FA)
+ (#x3105 #x312C) (#xAC00 #xD7A3)))
+ (ideographic-ranges #((#x3007 #x3007) (#x3021 #x3029)(#x4E00 #x9FA5)))
+ (combining-char-ranges
+ #((#x0300 #x0345) (#x0360 #x0361) (#x0483 #x0486) (#x0591 #x05A1)
+ (#x05A3 #x05B9) (#x05BB #x05BD) (#x05BF #x05BF) (#x05C1 #x05C2)
+ (#x05C4 #x05C4) (#x064B #x0652) (#x0670 #x0670) (#x06D6 #x06DC)
+ (#x06DD #x06DF) (#x06E0 #x06E4) (#x06E7 #x06E8) (#x06EA #x06ED)
+ (#x0901 #x0903) (#x093C #x093C) (#x093E #x094C) (#x094D #x094D)
+ (#x0951 #x0954) (#x0962 #x0963) (#x0981 #x0983) (#x09BC #x09BC)
+ (#x09BE #x09BE) (#x09BF #x09BF) (#x09C0 #x09C4) (#x09C7 #x09C8)
+ (#x09CB #x09CD) (#x09D7 #x09D7) (#x09E2 #x09E3) (#x0A02 #x0A02)
+ (#x0A3C #x0A3C) (#x0A3E #x0A3E) (#x0A3F #x0A3F) (#x0A40 #x0A42)
+ (#x0A47 #x0A48) (#x0A4B #x0A4D) (#x0A70 #x0A71) (#x0A81 #x0A83)
+ (#x0ABC #x0ABC) (#x0ABE #x0AC5) (#x0AC7 #x0AC9) (#x0ACB #x0ACD)
+ (#x0B01 #x0B03) (#x0B3C #x0B3C) (#x0B3E #x0B43) (#x0B47 #x0B48)
+ (#x0B4B #x0B4D) (#x0B56 #x0B57) (#x0B82 #x0B83) (#x0BBE #x0BC2)
+ (#x0BC6 #x0BC8) (#x0BCA #x0BCD) (#x0BD7 #x0BD7) (#x0C01 #x0C03)
+ (#x0C3E #x0C44) (#x0C46 #x0C48) (#x0C4A #x0C4D) (#x0C55 #x0C56)
+ (#x0C82 #x0C83) (#x0CBE #x0CC4) (#x0CC6 #x0CC8) (#x0CCA #x0CCD)
+ (#x0CD5 #x0CD6) (#x0D02 #x0D03) (#x0D3E #x0D43) (#x0D46 #x0D48)
+ (#x0D4A #x0D4D) (#x0D57 #x0D57) (#x0E31 #x0E31) (#x0E34 #x0E3A)
+ (#x0E47 #x0E4E) (#x0EB1 #x0EB1) (#x0EB4 #x0EB9) (#x0EBB #x0EBC)
+ (#x0EC8 #x0ECD) (#x0F18 #x0F19) (#x0F35 #x0F35) (#x0F37 #x0F37)
+ (#x0F39 #x0F39) (#x0F3E #x0F3E) (#x0F3F #x0F3F) (#x0F71 #x0F84)
+ (#x0F86 #x0F8B) (#x0F90 #x0F95) (#x0F97 #x0F97) (#x0F99 #x0FAD)
+ (#x0FB1 #x0FB7) (#x0FB9 #x0FB9) (#x20D0 #x20DC) (#x20E1 #x20E1)
+ (#x302A #x302F) (#x3099 #x3099) (#x309A #x309A))
+ )
+ (digit-ranges
+ #((#x0030 #x0039) (#x0660 #x0669) (#x06F0 #x06F9) (#x0966 #x096F)
+ (#x09E6 #x09EF) (#x0A66 #x0A6F) (#x0AE6 #x0AEF) (#x0B66 #x0B6F)
+ (#x0BE7 #x0BEF) (#x0C66 #x0C6F) (#x0CE6 #x0CEF) (#x0D66 #x0D6F)
+ (#x0E50 #x0E59) (#x0ED0 #x0ED9) (#x0F20 #x0F29)))
+ (extender-ranges
+ #((#x00B7 #x00B7) (#x02D0 #x02D0) (#x02D1 #x02D1) (#x0387 #x0387)
+ (#x0640 #x0640) (#x0E46 #x0E46) (#x0EC6 #x0EC6) (#x3005 #x3005)
+ (#x3031 #x3035) (#x309D #x309E) (#x30FC #x30FE))))
+ (labels
+ ((rune-in-range-p (code range-vector)
+ (declare (type simple-vector range-vector))
+ ;;we were always dealing with a sorted vector... bin search it
+
+ (let ((start 0)
+ (end (length range-vector)))
+ (while (< start end)
+ (let ((mid-index (+ start (floor (- end start) 2))))
+ (destructuring-bind (mid-item-low mid-item-high)
+ (aref range-vector mid-index)
+ (cond
+ ((< mid-item-high code)
+ (setf start (1+ mid-index)))
+ ((< code mid-item-low)
+ (setf end mid-index))
+ (t
+ (return t))))))))
+
+ (name-start-rune-p (rune)
+ (or (letter-rune-p rune)
+ (= #.(char-code #\_) rune)
+ (= #.(char-code #\:) rune)))
+
+ (name-rune-p (rune)
+ (or (letter-rune-p rune)
+ (digit-rune-p* rune)
+ (= rune #.(char-code #\.))
+ (= rune #.(char-code #\-))
+ (= rune #.(char-code #\_))
+ (= rune #.(char-code #\:))
+ (combining-rune-p rune)
+ (extender-rune-p rune)))
+
+ (letter-rune-p (rune)
+ (or (base-rune-p rune)
+ (ideographic-rune-p rune)))
+
+ (digit-rune-p* (rune)
+ (rune-in-range-p rune digit-ranges))
+
+
+ (combining-rune-p (rune)
+ (rune-in-range-p rune combining-char-ranges))
+
+ (extender-rune-p (rune)
+ (rune-in-range-p rune extender-ranges))
+
+ (base-rune-p (rune)
+ (rune-in-range-p rune base-char-ranges))
+
+ (ideographic-rune-p (rune)
+ (rune-in-range-p rune ideographic-ranges))
+
+
+ (predicate-to-bv (p)
+ (let ((r (make-array +max+ :element-type 'bit :initial-element 0)))
+ (dotimes (i +max+ r)
+ (when (funcall p i)
+ (setf (aref r i) 1))))) )
+
+ `(progn
+ (DEFINLINE NAME-RUNE-P (RUNE)
+ (SETF RUNE (RUNE-CODE RUNE))
+ (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3))
+ (type fixnum rune))
+ (AND (<= 0 RUNE ,+max+)
+ (= 1 (SBIT ',(predicate-to-bv #'name-rune-p)
+ RUNE)))))
+ (DEFINLINE NAME-START-RUNE-P (RUNE)
+ (SETF RUNE (RUNE-CODE RUNE))
+ (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3))
+ (type fixnum rune))
+ (AND (<= 0 RUNE ,+MAX+)
+ (= 1 (SBIT ',(predicate-to-bv #'name-start-rune-p)
+ RUNE)))))
+ (definline valid-name-p (rod)
+ (and (plusp (length rod))
+ (name-start-rune-p (elt rod 0))
+ (every #'name-rune-p rod)))
+ (definline valid-nmtoken-p (rod)
+ (and (plusp (length rod))
+ (every #'name-rune-p rod)))))))))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xml-parse.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xml-parse.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xml-parse.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,3738 @@
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CXML; readtable: runes; -*-
+;;; ---------------------------------------------------------------------------
+;;; Title: XML parser
+;;; Created: 1999-07-17
+;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
+;;; Author: Henrik Motakef <hmot(a)henrik-motakef.de>
+;;; Author: David Lichteblau <david(a)lichteblau.com>
+;;; License: Lisp-LGPL (See file COPYING for details).
+;;; ---------------------------------------------------------------------------
+;;; (c) copyright 1999 by Gilbert Baumann
+;;; (c) copyright 2003 by Henrik Motakef
+;;; (c) copyright 2004 knowledgeTools Int. GmbH
+;;; (c) copyright 2004 David Lichteblau
+;;; (c) copyright 2005 David Lichteblau
+
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Library General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 2 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Library General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Library General Public
+;;; License along with this library; if not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307 USA.
+
+;;; Streams
+
+;;; xstreams
+
+;; For reading runes, I defined my own streams, called xstreams,
+;; because we want to be fast. A function call or even a method call
+;; per character is not acceptable, instead of that we define a
+;; buffered stream with and advertised buffer layout, so that we
+;; could use the trick stdio uses: READ-RUNE and PEEK-RUNE are macros,
+;; directly accessing the buffer and only calling some underflow
+;; handler in case of stream underflows. This will yield to quite a
+;; performance boost vs calling READ-BYTE per character.
+
+;; Also we need to do encoding t conversion on ; this better done at large chunks of data rather than on a character
+;; by character basis. This way we need a dispatch on the active
+;; encoding only once in a while, instead of for each character. This
+;; allows us to use a CLOS interface to do the underflow handling.
+
+;;; zstreams
+
+;; Now, for reading tokens, we define another kind of streams, called
+;; zstreams. These zstreams also maintain an input stack to implement
+;; inclusion of external entities. This input stack contains xstreams
+;; or the special marker :STOP. Such a :STOP marker indicates, that
+;; input should not continue there, but well stop; that is simulate an
+;; EOF. The user is then responsible to pop this marker off the input
+;; stack.
+;;
+;; This input stack is also used to detect circular entity inclusion.
+
+;; The zstream tokenizer recognizes the following types of tokens and
+;; is controlled by the *DATA-BEHAVIOUR* flag. (Which should become a
+;; slot of zstreams instead).
+
+;; Common
+;; :xml-decl (<target> . <content>) ;processing-instruction starting with "<?xml"
+;; :pi (<target> . <content>) ;processing-instruction
+;; :stag (<name> . <atts>) ;start tag
+;; :etag (<name> . <atts>) ;end tag
+;; :ztag (<name> . <atts>) ;empty tag
+;; :<!ELEMENT
+;; :<!ENTITY
+;; :<!ATTLIST
+;; :<!NOTATION
+;; :<!DOCTYPE
+;; :<![
+;; :comment <content>
+
+;; *data-behaviour* = :DTD
+;;
+;; :nmtoken <interned-rod>
+;; :#required
+;; :#implied
+;; :#fixed
+;; :#pcdata
+;; :s
+;; :\[ :\] :\( :\) :|\ :\> :\" :\' :\, :\? :\* :\+
+
+;; *data-behaviour* = :DOC
+;;
+;; :entity-ref <interned-rod>
+;; :cdata <rod>
+
+
+;;; TODO
+;;
+;; o provide for a faster DOM
+;;
+;; o morph zstream into a context object and thus also get rid of
+;; special variables. Put the current DTD there too.
+;; [partly done]
+
+;; o the *scratch-pad* hack should become something much more
+;; reentrant, we could either define a system-wide resource
+;; or allocate some scratch-pads per context.
+;; [for thread-safety reasons the array are allocated per context now,
+;; reentrancy is still open]
+
+;; o CR handling in utf-16 deocders
+;;
+;; o UCS-4 reader
+;;
+;; o max depth together with circle detection
+;; (or proof, that our circle detection is enough).
+;; [gemeint ist zstream-push--david]
+;;
+;; o better extensibility wrt character representation, one may want to
+;; have
+;; - UCS-4 in vectoren
+;;
+;; o xstreams auslagern, documententieren und dann auch in SGML und
+;; CSS parser verwenden. (halt alles was zeichen liest).
+;; [ausgelagert sind sie; dokumentiert "so la la"; die Reintegration
+;; in Closure ist ein ganz anderes Thema]
+;;
+;; o recording of source locations for nodes.
+;;
+;; o based on the DTD and xml:space attribute implement HTML white
+;; space rules.
+;;
+;; o on a parser option, do not expand external entities.
+
+;;;; Validity constraints:
+;;;; (00) Root Element Type like (03), c.f. MAKE-ROOT-MODEL
+;;;; (01) Proper Declaration/PE Nesting P/MARKUP-DECL
+;;;; (02) Standalone Document Declaration all over the place [*]
+;;;; (03) Element Valid VALIDATE-*-ELEMENT, -CHARACTERS
+;;;; (04) Attribute Value Type VALIDATE-ATTRIBUTE
+;;;; (05) Unique Element Type Declaration DEFINE-ELEMENT
+;;;; (06) Proper Group/PE Nesting P/CSPEC
+;;;; (07) No Duplicate Types LEGAL-CONTENT-MODEL-P
+;;;; (08) ID VALIDATE-ATTRIBUTE
+;;;; (09) One ID per Element Type DEFINE-ATTRIBUTE
+;;;; (10) ID Attribute Default DEFINE-ATTRIBUTE
+;;;; (11) IDREF VALIDATE-ATTRIBUTE, P/DOCUMENT
+;;;; (12) Entity Name VALIDATE-ATTRIBUTE
+;;;; (13) Name Token VALIDATE-ATTRIBUTE
+;;;; (14) Notation Attributes VALIDATE-ATTRIBUTE, P/ATT-TYPE
+;;;; (15) One Notation Per Element Type DEFINE-ATTRIBUTE
+;;;; (16) No Notation on Empty Element DEFINE-ELEMENT, -ATTRIBUTE
+;;;; (17) Enumeration VALIDATE-ATTRIBUTE
+;;;; (18) Required Attribute PROCESS-ATTRIBUTES
+;;;; (19) Attribute Default Legal DEFINE-ATTRIBUTE
+;;;; (20) Fixed Attribute Default VALIDATE-ATTRIBUTE
+;;;; (21) Proper Conditional Section/PE Nesting P/CONDITIONAL-SECT, ...
+;;;; (22) Entity Declared [**]
+;;;; (23) Notation Declared P/ENTITY-DEF, P/DOCUMENT
+;;;; (24) Unique Notation Name DEFINE-NOTATION
+;;;;
+;;;; [*] Perhaps we could revert the explicit checks of (02), if we did
+;;;; _not_ read external subsets of standalone documents when parsing in
+;;;; validating mode. Violations of VC (02) constraints would then appear as
+;;;; wellformedness violations, right?
+;;;;
+;;;; [**] Although I haven't investigated this properly yet, I believe that
+;;;; we check this VC together with the WFC even in non-validating mode.
+
+(in-package :cxml)
+
+#+allegro
+(setf (excl:named-readtable :runes) *readtable*)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *fast* '(optimize (speed 3) (safety 0)))
+ ;;(defparameter *fast* '(optimize (speed 2) (safety 3)))
+ )
+
+;;; parser context
+
+(defvar *ctx* nil)
+
+(defstruct (context (:conc-name nil))
+ handler
+ (dtd nil)
+ model-stack
+ ;; xml:base machen wir fuer klacks mal gleich als expliziten stack:
+ base-stack
+ (referenced-notations '())
+ (id-table (%make-rod-hash-table))
+ ;; FIXME: Wofuer ist name-hashtable da? Will man das wissen?
+ (name-hashtable (make-rod-hashtable :size 2000))
+ (standalone-p nil)
+ (entity-resolver nil)
+ (disallow-internal-subset nil)
+ main-zstream)
+
+(defvar *expand-pe-p* nil)
+
+(defparameter *initial-namespace-bindings*
+ '((#"" . nil)
+ (#"xmlns" . #"http://www.w3.org/2000/xmlns/")
+ (#"xml" . #"http://www.w3.org/XML/1998/namespace")))
+
+(defparameter *namespace-bindings* *initial-namespace-bindings*)
+
+;;;; ---------------------------------------------------------------------------
+;;;; xstreams
+;;;;
+
+
+(defstruct (stream-name
+ (:print-function print-stream-name))
+ entity-name
+ entity-kind
+ uri)
+
+(defun print-stream-name (object stream depth)
+ (declare (ignore depth))
+ (format stream "[~A ~S ~A]"
+ (rod-string (stream-name-entity-name object))
+ (stream-name-entity-kind object)
+ (stream-name-uri object)))
+
+(deftype read-element () 'rune)
+
+(defun call-with-open-xstream (fn stream)
+ (unwind-protect
+ (funcall fn stream)
+ (close-xstream stream)))
+
+(defmacro with-open-xstream ((var value) &body body)
+ `(call-with-open-xstream (lambda (,var) ,@body) ,value))
+
+(defun call-with-open-xfile (continuation &rest open-args)
+ (let ((input (apply #'open (car open-args) :element-type '(unsigned-byte 8) (cdr open-args))))
+ (unwind-protect
+ (progn
+ (funcall continuation (make-xstream input)))
+ (close input))))
+
+(defmacro with-open-xfile ((stream &rest open-args) &body body)
+ `(call-with-open-xfile (lambda (,stream) .,body) .,open-args))
+
+;;;; -------------------------------------------------------------------
+;;;; Rechnen mit Runen
+;;;;
+
+;; Let us first define fast fixnum arithmetric get rid of type
+;; checks. (After all we know what we do here).
+
+(defmacro fx-op (op &rest xs)
+ `(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))))
+(defmacro fx-pred (op &rest xs)
+ `(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))
+
+(defmacro %+ (&rest xs) `(fx-op + ,@xs))
+(defmacro %- (&rest xs) `(fx-op - ,@xs))
+(defmacro %* (&rest xs) `(fx-op * ,@xs))
+(defmacro %/ (&rest xs) `(fx-op floor ,@xs))
+(defmacro %and (&rest xs) `(fx-op logand ,@xs))
+(defmacro %ior (&rest xs) `(fx-op logior ,@xs))
+(defmacro %xor (&rest xs) `(fx-op logxor ,@xs))
+(defmacro %ash (&rest xs) `(fx-op ash ,@xs))
+(defmacro %mod (&rest xs) `(fx-op mod ,@xs))
+
+(defmacro %= (&rest xs) `(fx-pred = ,@xs))
+(defmacro %<= (&rest xs) `(fx-pred <= ,@xs))
+(defmacro %>= (&rest xs) `(fx-pred >= ,@xs))
+(defmacro %< (&rest xs) `(fx-pred < ,@xs))
+(defmacro %> (&rest xs) `(fx-pred > ,@xs))
+
+;;; XXX Geschwindigkeit dieser Definitionen untersuchen!
+
+(defmacro rune-op (op &rest xs)
+ `(code-rune (,op ,@(mapcar (lambda (x) `(rune-code ,x)) xs))))
+(defmacro rune-pred (op &rest xs)
+ `(,op ,@(mapcar (lambda (x) `(rune-code ,x)) xs)))
+
+(defmacro %rune+ (&rest xs) `(rune-op + ,@xs))
+(defmacro %rune- (&rest xs) `(rune-op - ,@xs))
+(defmacro %rune* (&rest xs) `(rune-op * ,@xs))
+(defmacro %rune/ (&rest xs) `(rune-op floor ,@xs))
+(defmacro %rune-and (&rest xs) `(rune-op logand ,@xs))
+(defmacro %rune-ior (&rest xs) `(rune-op logior ,@xs))
+(defmacro %rune-xor (&rest xs) `(rune-op logxor ,@xs))
+(defmacro %rune-ash (a b) `(code-rune (ash (rune-code ,a) ,b)))
+(defmacro %rune-mod (&rest xs) `(rune-op mod ,@xs))
+
+(defmacro %rune= (&rest xs) `(rune-pred = ,@xs))
+(defmacro %rune<= (&rest xs) `(rune-pred <= ,@xs))
+(defmacro %rune>= (&rest xs) `(rune-pred >= ,@xs))
+(defmacro %rune< (&rest xs) `(rune-pred < ,@xs))
+(defmacro %rune> (&rest xs) `(rune-pred > ,@xs))
+
+;;;; ---------------------------------------------------------------------------
+;;;; rod hashtable
+;;;;
+
+;;; make-rod-hashtable
+;;; rod-hash-get hashtable rod &optional start end -> value ; successp
+;;; (setf (rod-hash-get hashtable rod &optional start end) new-value
+;;;
+
+(defstruct (rod-hashtable (:constructor make-rod-hashtable/low))
+ size ;size of table
+ table ;
+ )
+
+(defun make-rod-hashtable (&key (size 200))
+ (setf size (nearest-greater-prime size))
+ (make-rod-hashtable/low
+ :size size
+ :table (make-array size :initial-element nil)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defconstant +fixnum-bits+
+ (1- (integer-length most-positive-fixnum))
+ "Pessimistic approximation of the number of bits of fixnums.")
+
+ (defconstant +fixnum-mask+
+ (1- (expt 2 +fixnum-bits+))
+ "Pessimistic approximation of the largest bit-mask, still being a fixnum."))
+
+(definline stir (a b)
+ (%and +fixnum-mask+
+ (%xor (%ior (%ash (%and a #.(ash +fixnum-mask+ -5)) 5)
+ (%ash a #.(- 5 +fixnum-bits+)))
+ b)))
+
+(definline rod-hash (rod start end)
+ "Compute a hash code out of a rod."
+ (let ((res (%- end start)))
+ (do ((i start (%+ i 1)))
+ ((%= i end))
+ (declare (type fixnum i))
+ (setf res (stir res (rune-code (%rune rod i)))))
+ res))
+
+(definline rod=* (x y &key (start1 0) (end1 (length x))
+ (start2 0) (end2 (length y)))
+ (and (%= (%- end1 start1) (%- end2 start2))
+ (do ((i start1 (%+ i 1))
+ (j start2 (%+ j 1)))
+ ((%= i end1)
+ t)
+ (unless (rune= (%rune x i) (%rune y j))
+ (return nil)))))
+
+(definline rod=** (x y start1 end1 start2 end2)
+ (and (%= (%- end1 start1) (%- end2 start2))
+ (do ((i start1 (%+ i 1))
+ (j start2 (%+ j 1)))
+ ((%= i end1)
+ t)
+ (unless (rune= (%rune x i) (%rune y j))
+ (return nil)))))
+
+(defun rod-hash-get (hashtable rod &optional (start 0) (end (length rod)))
+ (declare (type (simple-array rune (*)) rod))
+ (let ((j (%mod (rod-hash rod start end)
+ (rod-hashtable-size hashtable))))
+ (dolist (q (svref (rod-hashtable-table hashtable) j)
+ (values nil nil nil))
+ (declare (type cons q))
+ (when (rod=** (car q) rod 0 (length (the (simple-array rune (*)) (car q))) start end)
+ (return (values (cdr q) t (car q)))))))
+
+(defun rod-hash-set (new-value hashtable rod &optional (start 0) (end (length rod)))
+ (let ((j (%mod (rod-hash rod start end)
+ (rod-hashtable-size hashtable)))
+ (key nil))
+ (dolist (q (svref (rod-hashtable-table hashtable) j)
+ (progn
+ (setf key (rod-subseq* rod start end))
+ (push (cons key new-value)
+ (aref (rod-hashtable-table hashtable) j))))
+ (when (rod=* (car q) rod :start2 start :end2 end)
+ (setf key (car q))
+ (setf (cdr q) new-value)
+ (return)))
+ (values new-value key)))
+
+#-rune-is-character
+(defun rod-subseq* (source start &optional (end (length source)))
+ (unless (and (typep start 'fixnum) (>= start 0))
+ (error "~S is not a non-negative fixnum." start))
+ (unless (and (typep end 'fixnum) (>= end start))
+ (error "END argument, ~S, is not a fixnum no less than START, ~S." end start))
+ (when (> start (length source))
+ (error "START argument, ~S, should be no greater than length of rod." start))
+ (when (> end (length source))
+ (error "END argument, ~S, should be no greater than length of rod." end))
+ (locally
+ (declare (type fixnum start end))
+ (let ((res (make-rod (- end start))))
+ (declare (type rod res))
+ (do ((i (- (- end start) 1) (the fixnum (- i 1))))
+ ((< i 0) res)
+ (declare (type fixnum i))
+ (setf (%rune res i) (aref source (the fixnum (+ i start))))))))
+
+#+rune-is-character
+(defun rod-subseq* (source start &optional (end (length source)))
+ (subseq source start end))
+
+(deftype ufixnum () `(unsigned-byte ,(integer-length most-positive-fixnum)))
+
+#-rune-is-character
+(defun rod-subseq** (source start &optional (end (length source)))
+ (declare (type (simple-array rune (*)) source)
+ (type ufixnum start)
+ (type ufixnum end)
+ (optimize (speed 3) (safety 0)))
+ (let ((res (make-array (%- end start) :element-type 'rune)))
+ (declare (type (simple-array rune (*)) res))
+ (let ((i (%- end start)))
+ (declare (type ufixnum i))
+ (loop
+ (setf i (- i 1))
+ (when (= i 0)
+ (return))
+ (setf (%rune res i) (%rune source (the ufixnum (+ i start))))))
+ res))
+
+#+rune-is-character
+(defun rod-subseq** (source start &optional (end (length source)))
+ (subseq source start end))
+
+(defun (setf rod-hash-get) (new-value hashtable rod &optional (start 0) (end (length rod)))
+ (rod-hash-set new-value hashtable rod start end))
+
+(defun intern-name (rod &optional (start 0) (end (length rod)))
+ (multiple-value-bind (value successp key) (rod-hash-get (name-hashtable *ctx*) rod start end)
+ (declare (ignore value))
+ (if successp
+ key
+ (nth-value 1 (rod-hash-set t (name-hashtable *ctx*) rod start end)))))
+
+;;;; ---------------------------------------------------------------------------
+;;;;
+;;;; rod collector
+;;;;
+
+(defvar *scratch-pad*)
+(defvar *scratch-pad-2*)
+(defvar *scratch-pad-3*)
+(defvar *scratch-pad-4*)
+
+(declaim (type (simple-array rune (*))
+ *scratch-pad* *scratch-pad-2* *scratch-pad-3* *scratch-pad-4*))
+
+(defmacro with-scratch-pads ((&optional) &body body)
+ `(let ((*scratch-pad* (make-array 1024 :element-type 'rune))
+ (*scratch-pad-2* (make-array 1024 :element-type 'rune))
+ (*scratch-pad-3* (make-array 1024 :element-type 'rune))
+ (*scratch-pad-4* (make-array 1024 :element-type 'rune)))
+ ,@body))
+
+(defmacro %put-unicode-char (code-var put)
+ `(progn
+ (cond ((%> ,code-var #xFFFF)
+ (,put (the rune (code-rune (%+ #xD7C0 (%ash ,code-var -10)))))
+ (,put (the rune (code-rune (%ior #xDC00 (%and ,code-var #x03FF))))))
+ (t
+ (,put (code-rune ,code-var))))))
+
+(defun adjust-array-by-copying (old-array new-size)
+ "Adjust an array by copying and thus ensures, that result is a SIMPLE-ARRAY."
+ (let ((res (make-array new-size :element-type (array-element-type old-array))))
+ (replace res old-array
+ :start1 0 :end1 (length old-array)
+ :start2 0 :end2 (length old-array))
+ res))
+
+(defmacro with-rune-collector-aux (scratch collect body mode)
+ (let ((rod (gensym))
+ (n (gensym))
+ (i (gensym))
+ (b (gensym)))
+ `(let ((,n (length ,scratch))
+ (,i 0)
+ (,b ,scratch))
+ (declare (type fixnum ,n ,i))
+ (macrolet
+ ((,collect (x)
+ `((lambda (x)
+ (locally
+ (declare #.*fast*)
+ (when (%>= ,',i ,',n)
+ (setf ,',n (* 2 ,',n))
+ (setf ,',b
+ (setf ,',scratch
+ (adjust-array-by-copying ,',scratch ,',n))))
+ (setf (aref (the (simple-array rune (*)) ,',b) ,',i) x)
+ (incf ,',i)))
+ ,x)))
+ ,@body
+ ,(ecase mode
+ (:intern
+ `(intern-name ,b 0 ,i))
+ (:copy
+ `(let ((,rod (make-rod ,i)))
+ (while (not (%= ,i 0))
+ (setf ,i (%- ,i 1))
+ (setf (%rune ,rod ,i)
+ (aref (the (simple-array rune (*)) ,b) ,i)))
+ ,rod))
+ (:raw
+ `(values ,b 0 ,i))
+ )))))
+
+'(defmacro with-rune-collector-aux (scratch collect body mode)
+ (let ((rod (gensym))
+ (n (gensym))
+ (i (gensym))
+ (b (gensym)))
+ `(let ((,n (length ,scratch))
+ (,i 0))
+ (declare (type fixnum ,n ,i))
+ (macrolet
+ ((,collect (x)
+ `((lambda (x)
+ (locally
+ (declare #.*fast*)
+ (when (%>= ,',i ,',n)
+ (setf ,',n (* 2 ,',n))
+ (setf ,',scratch
+ (setf ,',scratch
+ (adjust-array-by-copying ,',scratch ,',n))))
+ (setf (aref (the (simple-array rune (*)) ,',scratch) ,',i) x)
+ (incf ,',i)))
+ ,x)))
+ ,@body
+ ,(ecase mode
+ (:intern
+ `(intern-name ,scratch 0 ,i))
+ (:copy
+ `(let ((,rod (make-rod ,i)))
+ (while (%> ,i 0)
+ (setf ,i (%- ,i 1))
+ (setf (%rune ,rod ,i)
+ (aref (the (simple-array rune (*)) ,scratch) ,i)))
+ ,rod))
+ (:raw
+ `(values ,scratch 0 ,i))
+ )))))
+
+(defmacro with-rune-collector ((collect) &body body)
+ `(with-rune-collector-aux *scratch-pad* ,collect ,body :copy))
+
+(defmacro with-rune-collector-2 ((collect) &body body)
+ `(with-rune-collector-aux *scratch-pad-2* ,collect ,body :copy))
+
+(defmacro with-rune-collector-3 ((collect) &body body)
+ `(with-rune-collector-aux *scratch-pad-3* ,collect ,body :copy))
+
+(defmacro with-rune-collector-4 ((collect) &body body)
+ `(with-rune-collector-aux *scratch-pad-4* ,collect ,body :copy))
+
+(defmacro with-rune-collector/intern ((collect) &body body)
+ `(with-rune-collector-aux *scratch-pad* ,collect ,body :intern))
+
+(defmacro with-rune-collector/raw ((collect) &body body)
+ `(with-rune-collector-aux *scratch-pad* ,collect ,body :raw))
+
+#|
+(defmacro while-reading-runes ((reader stream-in) &rest body)
+ ;; Thou shalt not leave body via a non local exit
+ (let ((stream (make-symbol "STREAM"))
+ (rptr (make-symbol "RPTR"))
+ (fptr (make-symbol "FPTR"))
+ (buf (make-symbol "BUF")) )
+ `(let* ((,stream ,stream-in)
+ (,rptr (xstream-read-ptr ,stream))
+ (,fptr (xstream-fill-ptr ,stream))
+ (,buf (xstream-buffer ,stream)))
+ (declare (type fixnum ,rptr ,fptr)
+ (type xstream ,stream))
+ (macrolet ((,reader (res-var)
+ `(cond ((%= ,',rptr ,',fptr)
+ (setf (xstream-read-ptr ,',stream) ,',rptr)
+ (setf ,res-var (xstream-underflow ,',stream))
+ (setf ,',rptr (xstream-read-ptr ,',stream))
+ (setf ,',fptr (xstream-fill-ptr ,',stream))
+ (setf ,',buf (xstream-buffer ,',stream)))
+ (t
+ (setf ,res-var
+ (aref (the (simple-array read-element (*)) ,',buf)
+ (the fixnum ,',rptr)))
+ (setf ,',rptr (%+ ,',rptr 1))))))
+ (prog1
+ (let () .,body)
+ (setf (xstream-read-ptr ,stream) ,rptr) )))))
+|#
+
+;;;; ---------------------------------------------------------------------------
+;;;; DTD
+;;;;
+
+(define-condition xml-parse-error (simple-error) ())
+(define-condition well-formedness-violation (xml-parse-error) ())
+(define-condition validity-error (xml-parse-error) ())
+
+;; We make some effort to signal end of file as a special condition, but we
+;; don't actually try very hard. Not sure whether we should. Right now I
+;; would prefer not to document this class.
+(define-condition end-of-xstream (well-formedness-violation) ())
+
+(defun describe-xstream (x s)
+ (format s " Line ~D, column ~D in ~A~%"
+ (xstream-line-number x)
+ (xstream-column-number x)
+ (let ((name (xstream-name x)))
+ (cond
+ ((null name)
+ "<anonymous stream>")
+ ((eq :main (stream-name-entity-kind name))
+ (stream-name-uri name))
+ (t
+ name)))))
+
+(defun %error (class stream message)
+ (let* ((zmain (if *ctx* (main-zstream *ctx*) nil))
+ (zstream (if (zstream-p stream) stream zmain))
+ (xstream (if (xstream-p stream) stream nil))
+ (s (make-string-output-stream)))
+ (write-line message s)
+ (when xstream
+ (write-line "Location:" s)
+ (describe-xstream xstream s))
+ (when zstream
+ (let ((stack
+ (remove xstream (remove :stop (zstream-input-stack zstream)))))
+ (when stack
+ (write-line "Context:" s)
+ (dolist (x stack)
+ (describe-xstream x s)))))
+ (when (and zmain (not (eq zstream zmain)))
+ (let ((stack
+ (remove xstream (remove :stop (zstream-input-stack zmain)))))
+ (when stack
+ (write-line "Context in main document:" s)
+ (dolist (x stack)
+ (describe-xstream x s)))))
+ (error class
+ :format-control "~A"
+ :format-arguments (list (get-output-stream-string s)))))
+
+(defun validity-error (fmt &rest args)
+ (%error 'validity-error
+ nil
+ (format nil "Document not valid: ~?" fmt args)))
+
+(defun wf-error (stream fmt &rest args)
+ (%error 'well-formedness-violation
+ stream
+ (format nil "Document not well-formed: ~?" fmt args)))
+
+(defun eox (stream &optional x &rest args)
+ (%error 'end-of-xstream
+ stream
+ (format nil "End of file~@[: ~?~]" x args)))
+
+(defclass cxml-parser (sax:sax-parser) ((ctx :initarg :ctx)))
+
+(defun parser-xstream (parser)
+ (car (zstream-input-stack (main-zstream (slot-value parser 'ctx)))))
+
+(defun parser-stream-name (parser)
+ (let ((xstream (parser-xstream parser)))
+ (if xstream
+ (xstream-name xstream)
+ nil)))
+
+(defmethod sax:line-number ((parser cxml-parser))
+ (let ((x (parser-xstream parser)))
+ (if x
+ (xstream-line-number x)
+ nil)))
+
+(defmethod sax:column-number ((parser cxml-parser))
+ (let ((x (parser-xstream parser)))
+ (if x
+ (xstream-column-number x)
+ nil)))
+
+(defmethod sax:system-id ((parser cxml-parser))
+ (let ((name (parser-stream-name parser)))
+ (if name
+ (stream-name-uri name)
+ nil)))
+
+(defmethod sax:xml-base ((parser cxml-parser))
+ (car (base-stack (slot-value parser 'ctx))))
+
+(defvar *validate* t)
+(defvar *external-subset-p* nil)
+
+(defun validate-start-element (ctx name)
+ (when *validate*
+ (let* ((pair (car (model-stack ctx)))
+ (newval (funcall (car pair) name)))
+ (unless newval
+ (validity-error "(03) Element Valid: ~A" (rod-string name)))
+ (setf (car pair) newval)
+ (let ((e (find-element name (dtd ctx))))
+ (unless e
+ (validity-error "(03) Element Valid: no definition for ~A"
+ (rod-string name)))
+ (maybe-compile-cspec e)
+ (push (copy-cons (elmdef-compiled-cspec e)) (model-stack ctx))))))
+
+(defun copy-cons (x)
+ (cons (car x) (cdr x)))
+
+(defun validate-end-element (ctx name)
+ (when *validate*
+ (let ((pair (car (model-stack ctx))))
+ (unless (eq (funcall (car pair) nil) t)
+ (validity-error "(03) Element Valid: ~A" (rod-string name)))
+ (pop (model-stack ctx)))))
+
+(defun validate-characters (ctx rod)
+ (when *validate*
+ (let ((pair (car (model-stack ctx))))
+ (unless (funcall (cdr pair) rod)
+ (validity-error "(03) Element Valid: unexpected PCDATA")))))
+
+(defun standalone-check-necessary-p (def)
+ (and *validate*
+ (standalone-p *ctx*)
+ (etypecase def
+ (elmdef (elmdef-external-p def))
+ (attdef (attdef-external-p def)))))
+
+;; attribute validation, defaulting, and normalization -- except for for
+;; uniqueness checks, which are done after namespaces have been declared
+(defun process-attributes (ctx name attlist)
+ (let ((e (find-element name (dtd ctx))))
+ (cond
+ (e
+ (dolist (ad (elmdef-attributes e)) ;handle default values
+ (unless (get-attribute (attdef-name ad) attlist)
+ (case (attdef-default ad)
+ (:IMPLIED)
+ (:REQUIRED
+ (when *validate*
+ (validity-error "(18) Required Attribute: ~S not specified"
+ (rod-string (attdef-name ad)))))
+ (t
+ (when (standalone-check-necessary-p ad)
+ (validity-error "(02) Standalone Document Declaration: missing attribute value"))
+ (push (sax:make-attribute :qname (attdef-name ad)
+ :value (cadr (attdef-default ad))
+ :specified-p nil)
+ attlist)))))
+ (dolist (a attlist) ;normalize non-CDATA values
+ (let* ((qname (sax:attribute-qname a))
+ (adef (find-attribute e qname)))
+ (when adef
+ (when (and *validate*
+ sax:*namespace-processing*
+ (eq (attdef-type adef) :ID)
+ (find #/: (sax:attribute-value a)))
+ (validity-error "colon in ID attribute"))
+ (unless (eq (attdef-type adef) :CDATA)
+ (let ((canon (canon-not-cdata-attval (sax:attribute-value a))))
+ (when (and (standalone-check-necessary-p adef)
+ (not (rod= (sax:attribute-value a) canon)))
+ (validity-error "(02) Standalone Document Declaration: attribute value not normalized"))
+ (setf (sax:attribute-value a) canon))))))
+ (when *validate* ;maybe validate attribute values
+ (dolist (a attlist)
+ (validate-attribute ctx e a))))
+ ((and *validate* attlist)
+ (validity-error "(04) Attribute Value Type: no definition for element ~A"
+ (rod-string name)))))
+ attlist)
+
+(defun get-attribute (name attributes)
+ (member name attributes :key #'sax:attribute-qname :test #'rod=))
+
+(defun validate-attribute (ctx e a)
+ (when (sax:attribute-specified-p a) ;defaults checked by DEFINE-ATTRIBUTE
+ (let* ((qname (sax:attribute-qname a))
+ (adef
+ (or (find-attribute e qname)
+ (validity-error "(04) Attribute Value Type: not declared: ~A"
+ (rod-string qname)))))
+ (validate-attribute* ctx adef (sax:attribute-value a)))))
+
+(defun validate-attribute* (ctx adef value)
+ (let ((type (attdef-type adef))
+ (default (attdef-default adef)))
+ (when (and (listp default)
+ (eq (car default) :FIXED)
+ (not (rod= value (cadr default))))
+ (validity-error "(20) Fixed Attribute Default: expected ~S but got ~S"
+ (rod-string (cadr default))
+ (rod-string value)))
+ (ecase (if (listp type) (car type) type)
+ (:ID
+ (unless (valid-name-p value)
+ (validity-error "(08) ID: not a name: ~S" (rod-string value)))
+ (when (eq (gethash value (id-table ctx)) t)
+ (validity-error "(08) ID: ~S not unique" (rod-string value)))
+ (setf (gethash value (id-table ctx)) t))
+ (:IDREF
+ (validate-idref ctx value))
+ (:IDREFS
+ (let ((names (split-names value)))
+ (unless names
+ (validity-error "(11) IDREF: malformed names"))
+ (mapc (curry #'validate-idref ctx) names)))
+ (:NMTOKEN
+ (validate-nmtoken value))
+ (:NMTOKENS
+ (let ((tokens (split-names value)))
+ (unless tokens
+ (validity-error "(13) Name Token: malformed NMTOKENS"))
+ (mapc #'validate-nmtoken tokens)))
+ (:ENUMERATION
+ (unless (member value (cdr type) :test #'rod=)
+ (validity-error "(17) Enumeration: value not declared: ~S"
+ (rod-string value))))
+ (:NOTATION
+ (unless (member value (cdr type) :test #'rod=)
+ (validity-error "(14) Notation Attributes: ~S" (rod-string value))))
+ (:ENTITY
+ (validate-entity value))
+ (:ENTITIES
+ (let ((names (split-names value)))
+ (unless names
+ (validity-error "(13) Name Token: malformed NMTOKENS"))
+ (mapc #'validate-entity names)))
+ (:CDATA))))
+
+(defun validate-idref (ctx value)
+ (unless (valid-name-p value)
+ (validity-error "(11) IDREF: not a name: ~S" (rod-string value)))
+ (unless (gethash value (id-table ctx))
+ (setf (gethash value (id-table ctx)) nil)))
+
+(defun validate-nmtoken (value)
+ (unless (valid-nmtoken-p value)
+ (validity-error "(13) Name Token: not a NMTOKEN: ~S"
+ (rod-string value))))
+
+(defstruct (entdef (:constructor)))
+
+(defstruct (internal-entdef
+ (:include entdef)
+ (:constructor make-internal-entdef (value))
+ (:conc-name #:entdef-))
+ (value (error "missing argument") :type rod)
+ (expansion nil)
+ (external-subset-p *external-subset-p*))
+
+(defstruct (external-entdef
+ (:include entdef)
+ (:constructor make-external-entdef (extid ndata))
+ (:conc-name #:entdef-))
+ (extid (error "missing argument") :type extid)
+ (ndata nil :type (or rod null)))
+
+(defun validate-entity (value)
+ (unless (valid-name-p value)
+ (validity-error "(12) Entity Name: not a name: ~S" (rod-string value)))
+ (let ((def (let ((*validate*
+ ;; Similarly the entity refs are internal and
+ ;; don't need normalization ... the unparsed
+ ;; entities (and entities) aren't "references"
+ ;; -- sun/valid/sa03.xml
+ nil))
+ (get-entity-definition value :general (dtd *ctx*)))))
+ (unless (and (typep def 'external-entdef) (entdef-ndata def))
+ ;; unparsed entity
+ (validity-error "(12) Entity Name: ~S" (rod-string value)))))
+
+(defun split-names (rod)
+ (flet ((whitespacep (x)
+ (or (rune= x #/U+0009)
+ (rune= x #/U+000A)
+ (rune= x #/U+000D)
+ (rune= x #/U+0020))))
+ (if (let ((n (length rod)))
+ (and (not (zerop n))
+ (or (whitespacep (rune rod 0))
+ (whitespacep (rune rod (1- n))))))
+ nil
+ (split-sequence-if #'whitespacep rod :remove-empty-subseqs t))))
+
+(defun zstream-base-sysid (zstream)
+ (let ((base-sysid
+ (dolist (k (zstream-input-stack zstream))
+ (let ((base-sysid (stream-name-uri (xstream-name k))))
+ (when base-sysid (return base-sysid))))))
+ base-sysid))
+
+(defun absolute-uri (sysid source-stream)
+ (let ((base-sysid (zstream-base-sysid source-stream)))
+ ;; XXX is the IF correct?
+ (if base-sysid
+ (puri:merge-uris sysid base-sysid)
+ sysid)))
+
+(defstruct (extid (:constructor make-extid (public system)))
+ (public nil :type (or rod null))
+ (system (error "missing argument") :type (or puri:uri null)))
+
+(defun absolute-extid (source-stream extid)
+ (let ((sysid (extid-system extid))
+ (result (copy-extid extid)))
+ (setf (extid-system result) (absolute-uri sysid source-stream))
+ result))
+
+(defun define-entity (source-stream name kind def)
+ (setf name (intern-name name))
+ (when (and sax:*namespace-processing* (find #/: name))
+ (wf-error source-stream "colon in entity name"))
+ (let ((table
+ (ecase kind
+ (:general (dtd-gentities (dtd *ctx*)))
+ (:parameter (dtd-pentities (dtd *ctx*))))))
+ (unless (gethash name table)
+ (when (and source-stream (handler *ctx*))
+ (report-entity (handler *ctx*) kind name def))
+ (when (typep def 'external-entdef)
+ (setf (entdef-extid def)
+ (absolute-extid source-stream (entdef-extid def))))
+ (setf (gethash name table)
+ (cons *external-subset-p* def)))))
+
+(defun get-entity-definition (entity-name kind dtd)
+ (unless dtd
+ (wf-error nil "entity not defined: ~A" (rod-string entity-name)))
+ (destructuring-bind (extp &rest def)
+ (gethash entity-name
+ (ecase kind
+ (:general (dtd-gentities dtd))
+ (:parameter (dtd-pentities dtd)))
+ '(nil))
+ (when (and *validate* (standalone-p *ctx*) extp)
+ (validity-error "(02) Standalone Document Declaration: entity reference: ~S"
+ (rod-string entity-name)))
+ def))
+
+(defun entity->xstream (zstream entity-name kind &optional internalp)
+ ;; `zstream' is for error messages
+ (let ((def (get-entity-definition entity-name kind (dtd *ctx*))))
+ (unless def
+ (wf-error zstream "Entity '~A' is not defined." (rod-string entity-name)))
+ (let (r)
+ (etypecase def
+ (internal-entdef
+ (when (and (standalone-p *ctx*)
+ (entdef-external-subset-p def))
+ (wf-error
+ zstream
+ "entity declared in external subset, but document is standalone"))
+ (setf r (make-rod-xstream (entdef-value def)))
+ (setf (xstream-name r)
+ (make-stream-name :entity-name entity-name
+ :entity-kind kind
+ :uri nil)))
+ (external-entdef
+ (when internalp
+ (wf-error zstream
+ "entity not internal: ~A" (rod-string entity-name)))
+ (when (entdef-ndata def)
+ (wf-error zstream
+ "reference to unparsed entity: ~A"
+ (rod-string entity-name)))
+ (setf r (xstream-open-extid (extid-using-catalog (entdef-extid def))))
+ (setf (stream-name-entity-name (xstream-name r)) entity-name
+ (stream-name-entity-kind (xstream-name r)) kind)))
+ r)))
+
+(defun checked-get-entdef (name type)
+ (let ((def (get-entity-definition name type (dtd *ctx*))))
+ (unless def
+ (wf-error nil "Entity '~A' is not defined." (rod-string name)))
+ def))
+
+(defun xstream-open-extid* (entity-resolver pubid sysid)
+ (let* ((stream
+ (or (funcall (or entity-resolver (constantly nil)) pubid sysid)
+ (open (uri-to-pathname sysid)
+ :element-type '(unsigned-byte 8)
+ :direction :input))))
+ (make-xstream stream
+ :name (make-stream-name :uri sysid)
+ :initial-speed 1)))
+
+(defun xstream-open-extid (extid)
+ (xstream-open-extid* (entity-resolver *ctx*)
+ (extid-public extid)
+ (extid-system extid)))
+
+(defun call-with-entity-expansion-as-stream (zstream cont name kind internalp)
+ ;; `zstream' is for error messages
+ (let ((in (entity->xstream zstream name kind internalp)))
+ (push (stream-name-uri (xstream-name in)) (base-stack *ctx*))
+ (unwind-protect
+ (funcall cont in)
+ (pop (base-stack *ctx*))
+ (close-xstream in))))
+
+(defun ensure-dtd ()
+ (unless (dtd *ctx*)
+ (setf (dtd *ctx*) (make-dtd))
+ (define-default-entities)))
+
+(defun define-default-entities ()
+ (define-entity nil #"lt" :general (make-internal-entdef #"<"))
+ (define-entity nil #"gt" :general (make-internal-entdef #">"))
+ (define-entity nil #"amp" :general (make-internal-entdef #"&"))
+ (define-entity nil #"apos" :general (make-internal-entdef #"'"))
+ (define-entity nil #"quot" :general (make-internal-entdef #"\"")))
+
+(defstruct attdef
+ ;; an attribute definition
+ element ;name of element this attribute belongs to
+ name ;name of attribute
+ type ;type of attribute; either one of :CDATA, :ID, :IDREF, :IDREFS,
+ ; :ENTITY, :ENTITIES, :NMTOKEN, :NMTOKENS, or
+ ; (:NOTATION <name>*)
+ ; (:ENUMERATION <name>*)
+ default ;default value of attribute:
+ ; :REQUIRED, :IMPLIED, (:FIXED content) or (:DEFAULT content)
+ (external-p *external-subset-p*)
+ )
+
+(defstruct elmdef
+ ;; an element definition
+ name ;name of the element
+ content ;content model [*]
+ attributes ;list of defined attributes
+ compiled-cspec ;cons of validation function for contentspec
+ (external-p *external-subset-p*)
+ )
+
+;; [*] in XML it is possible to define attributes before the element
+;; itself is defined and since we hang attribute definitions into the
+;; relevant element definitions, the `content' slot indicates whether an
+;; element was actually defined. It is NIL until set to a content model
+;; when the element type declaration is processed.
+
+(defun %make-rod-hash-table ()
+ ;; XXX with portable hash tables, this is the only way to case-sensitively
+ ;; use rods. However, EQUALP often has horrible performance! Most Lisps
+ ;; provide extensions for user-defined equality, we should use them! There
+ ;; is also a home-made hash table for rods defined below, written by
+ ;; Gilbert (I think). We could also use that one, but I would prefer the
+ ;; first method, even if it's unportable.
+ (make-hash-table :test
+ #+rune-is-character 'equal
+ #-rune-is-character 'equalp))
+
+(defstruct dtd
+ (elements (%make-rod-hash-table)) ;elmdefs
+ (gentities (%make-rod-hash-table)) ;general entities
+ (pentities (%make-rod-hash-table)) ;parameter entities
+ (notations (%make-rod-hash-table)))
+
+(defun make-dtd-cache ()
+ (puri:make-uri-space))
+
+(defvar *cache-all-dtds* nil)
+(defvar *dtd-cache* (make-dtd-cache))
+
+(defun remdtd (uri dtd-cache)
+ (setf uri (puri:intern-uri uri dtd-cache))
+ (prog1
+ (and (getf (puri:uri-plist uri) 'dtd) t)
+ (puri:unintern-uri uri dtd-cache)))
+
+(defun clear-dtd-cache (dtd-cache)
+ (puri:unintern-uri t dtd-cache))
+
+(defun getdtd (uri dtd-cache)
+ (getf (puri:uri-plist (puri:intern-uri uri dtd-cache)) 'dtd))
+
+(defun (setf getdtd) (newval uri dtd-cache)
+ (setf (getf (puri:uri-plist (puri:intern-uri uri dtd-cache)) 'dtd) newval)
+ newval)
+
+
+;;;;
+
+(defun find-element (name dtd)
+ (gethash name (dtd-elements dtd)))
+
+(defun define-element (dtd element-name &optional content-model)
+ (let ((e (find-element element-name dtd)))
+ (cond
+ ((null e)
+ (prog1
+ (setf (gethash element-name (dtd-elements dtd))
+ (make-elmdef :name element-name :content content-model))
+ (sax:element-declaration (handler *ctx*) element-name content-model)))
+ ((null content-model)
+ e)
+ (t
+ (when *validate*
+ (when (elmdef-content e)
+ (validity-error "(05) Unique Element Type Declaration"))
+ (when (eq content-model :EMPTY)
+ (dolist (ad (elmdef-attributes e))
+ (let ((type (attdef-type ad)))
+ (when (and (listp type) (eq (car type) :NOTATION))
+ (validity-error "(16) No Notation on Empty Element: ~S"
+ (rod-string element-name)))))))
+ (sax:element-declaration (handler *ctx*) element-name content-model)
+ (setf (elmdef-content e) content-model)
+ (setf (elmdef-external-p e) *external-subset-p*)
+ e))))
+
+(defvar *redefinition-warning* nil)
+
+(defun define-attribute (dtd element name type default)
+ (let ((adef (make-attdef :element element
+ :name name
+ :type type
+ :default default))
+ (e (or (find-element element dtd)
+ (define-element dtd element))))
+ (when (and *validate* (listp default))
+ (unless (eq (attdef-type adef) :CDATA)
+ (setf (second default) (canon-not-cdata-attval (second default))))
+ (validate-attribute* *ctx* adef (second default)))
+ (cond ((find-attribute e name)
+ (when *redefinition-warning*
+ (warn "Attribute \"~A\" of \"~A\" not redefined."
+ (rod-string name)
+ (rod-string element))))
+ (t
+ (when *validate*
+ (when (eq type :ID)
+ (when (find :ID (elmdef-attributes e) :key #'attdef-type)
+ (validity-error "(09) One ID per Element Type: element ~A"
+ (rod-string element)))
+ (unless (member default '(:REQUIRED :IMPLIED))
+ (validity-error "(10) ID Attribute Default: ~A"
+ (rod-string element))))
+ (flet ((notationp (type)
+ (and (listp type) (eq (car type) :NOTATION))))
+ (when (notationp type)
+ (when (find-if #'notationp (elmdef-attributes e)
+ :key #'attdef-type)
+ (validity-error "(15) One Notation Per Element Type: ~S"
+ (rod-string element)))
+ (when (eq (elmdef-content e) :EMPTY)
+ (validity-error "(16) No Notation on Empty Element: ~S"
+ (rod-string element))))))
+ (sax:attribute-declaration (handler *ctx*) element name type default)
+ (push adef (elmdef-attributes e))))))
+
+(defun find-attribute (elmdef name)
+ (find name (elmdef-attributes elmdef) :key #'attdef-name :test #'rod=))
+
+(defun define-notation (dtd name id)
+ (let ((ns (dtd-notations dtd)))
+ (when (gethash name ns)
+ (validity-error "(24) Unique Notation Name: ~S" (rod-string name)))
+ (setf (gethash name ns) id)))
+
+(defun find-notation (name dtd)
+ (gethash name (dtd-notations dtd)))
+
+;;;; ---------------------------------------------------------------------------
+;;;; z streams and lexer
+;;;;
+
+(defstruct zstream
+ token-category
+ token-semantic
+ input-stack)
+
+(defun call-with-zstream (fn zstream)
+ (unwind-protect
+ (funcall fn zstream)
+ (dolist (input (zstream-input-stack zstream))
+ (cond #-x&y-streams-are-stream
+ ((xstream-p input)
+ (close-xstream input))
+ #+x&y-streams-are-stream
+ ((streamp input)
+ (close input))))))
+
+(defmacro with-zstream ((zstream &rest args) &body body)
+ `(call-with-zstream (lambda (,zstream) ,@body)
+ (make-zstream ,@args)))
+
+(defun read-token (input)
+ (cond ((zstream-token-category input)
+ (multiple-value-prog1
+ (values (zstream-token-category input)
+ (zstream-token-semantic input))
+ (setf (zstream-token-category input) nil
+ (zstream-token-semantic input) nil)))
+ (t
+ (read-token-2 input))))
+
+(defun peek-token (input)
+ (cond ((zstream-token-category input)
+ (values
+ (zstream-token-category input)
+ (zstream-token-semantic input)))
+ (t
+ (multiple-value-bind (c s) (read-token input)
+ (setf (zstream-token-category input) c
+ (zstream-token-semantic input) s))
+ (values (zstream-token-category input)
+ (zstream-token-semantic input)))))
+
+(defun read-token-2 (input)
+ (cond ((null (zstream-input-stack input))
+ (values :eof nil))
+ (t
+ (let ((c (peek-rune (car (zstream-input-stack input)))))
+ (cond ((eq c :eof)
+ (cond ((eq (cadr (zstream-input-stack input)) :stop)
+ (values :eof nil))
+ (t
+ (close-xstream (pop (zstream-input-stack input)))
+ (if (null (zstream-input-stack input))
+ (values :eof nil)
+ (values :S nil) ;fake #x20 after PE expansion
+ ))))
+ (t
+ (read-token-3 input)))))))
+
+(defvar *data-behaviour*
+ ) ;either :DTD or :DOC
+
+(defun read-token-3 (zinput)
+ (let ((input (car (zstream-input-stack zinput))))
+ ;; PI Comment
+ (let ((c (read-rune input)))
+ (cond
+ ;; first the common tokens
+ ((rune= #/< c)
+ (read-token-after-|<| zinput input))
+ ;; now dispatch
+ (t
+ (ecase *data-behaviour*
+ (:DTD
+ (cond ((rune= #/\[ c) :\[)
+ ((rune= #/\] c) :\])
+ ((rune= #/\( c) :\()
+ ((rune= #/\) c) :\))
+ ((rune= #/\| c) :\|)
+ ((rune= #/\> c) :\>)
+ ((rune= #/\" c) :\")
+ ((rune= #/\' c) :\')
+ ((rune= #/\, c) :\,)
+ ((rune= #/\? c) :\?)
+ ((rune= #/\* c) :\*)
+ ((rune= #/\+ c) :\+)
+ ((name-rune-p c)
+ (unread-rune c input)
+ (values :nmtoken (read-name-token input)))
+ ((rune= #/# c)
+ (let ((q (read-name-token input)))
+ (cond ((rod= q '#.(string-rod "REQUIRED")) :|#REQUIRED|)
+ ((rod= q '#.(string-rod "IMPLIED")) :|#IMPLIED|)
+ ((rod= q '#.(string-rod "FIXED")) :|#FIXED|)
+ ((rod= q '#.(string-rod "PCDATA")) :|#PCDATA|)
+ (t
+ (wf-error zinput "Unknown token: ~S." q)))))
+ ((or (rune= c #/U+0020)
+ (rune= c #/U+0009)
+ (rune= c #/U+000D)
+ (rune= c #/U+000A))
+ (values :S nil))
+ ((rune= #/% c)
+ (cond ((name-start-rune-p (peek-rune input))
+ ;; an entity reference
+ (read-pe-reference zinput))
+ (t
+ (values :%))))
+ (t
+ (wf-error zinput "Unexpected character ~S." c))))
+ (:DOC
+ (cond
+ ((rune= c #/&)
+ (multiple-value-bind (kind data) (read-entity-like input)
+ (cond ((eq kind :ENTITY-REFERENCE)
+ (values :ENTITY-REF data))
+ ((eq kind :CHARACTER-REFERENCE)
+ (values :CDATA
+ (with-rune-collector (collect)
+ (%put-unicode-char data collect)))))))
+ (t
+ (unread-rune c input)
+ (values :CDATA (read-cdata input)))))))))))
+
+(definline check-rune (input actual expected)
+ (unless (eql actual expected)
+ (wf-error input "expected #/~A but found #/~A"
+ (rune-char expected)
+ (rune-char actual))))
+
+(defun read-pe-reference (zinput)
+ (let* ((input (car (zstream-input-stack zinput)))
+ (nam (read-name-token input)))
+ (check-rune input #/\; (read-rune input))
+ (cond (*expand-pe-p*
+ ;; no external entities here!
+ (let ((i2 (entity->xstream zinput nam :parameter)))
+ (zstream-push i2 zinput))
+ (values :S nil) ;space before inserted PE expansion.
+ )
+ (t
+ (values :PE-REFERENCE nam)) )))
+
+(defun read-token-after-|<| (zinput input)
+ (let ((d (read-rune input)))
+ (cond ((eq d :eof)
+ (eox input "EOF after '<'"))
+ ((rune= #/! d)
+ (read-token-after-|<!| input))
+ ((rune= #/? d)
+ (multiple-value-bind (target content) (read-pi input)
+ (cond ((rod= target '#.(string-rod "xml"))
+ (values :xml-decl (cons target content)))
+ ((rod-equal target '#.(string-rod "XML"))
+ (wf-error zinput
+ "You lost -- no XML processing instructions."))
+ ((and sax:*namespace-processing* (position #/: target))
+ (wf-error zinput
+ "Processing instruction target ~S is not a ~
+ valid NcName."
+ (mu target)))
+ (t
+ (values :PI (cons target content))))))
+ ((eq *data-behaviour* :DTD)
+ (unread-rune d input)
+ (unless (or (rune= #// d) (name-start-rune-p d))
+ (wf-error zinput "Expected '!' or '?' after '<' in DTD."))
+ (values :seen-< nil))
+ ((rune= #// d)
+ (let ((c (peek-rune input)))
+ (cond ((name-start-rune-p c)
+ (read-tag-2 zinput input :etag))
+ (t
+ (wf-error zinput
+ "Expecting name start rune after \"</\".")))))
+ ((name-start-rune-p d)
+ (unread-rune d input)
+ (read-tag-2 zinput input :stag))
+ (t
+ (wf-error zinput "Expected '!' or '?' after '<' in DTD.")))))
+
+(defun read-token-after-|<!| (input)
+ (let ((d (read-rune input)))
+ (cond ((eq d :eof)
+ (eox input "EOF after \"<!\"."))
+ ((name-start-rune-p d)
+ (unread-rune d input)
+ (let ((name (read-name-token input)))
+ (cond ((rod= name '#.(string-rod "ELEMENT")) :|<!ELEMENT|)
+ ((rod= name '#.(string-rod "ENTITY")) :|<!ENTITY|)
+ ((rod= name '#.(string-rod "ATTLIST")) :|<!ATTLIST|)
+ ((rod= name '#.(string-rod "NOTATION")) :|<!NOTATION|)
+ ((rod= name '#.(string-rod "DOCTYPE")) :|<!DOCTYPE|)
+ (t
+ (wf-error input"`<!~A' unknown." (rod-string name))))))
+ ((rune= #/\[ d)
+ (values :|<![| nil))
+ ((rune= #/- d)
+ (setf d (read-rune input))
+ (cond ((rune= #/- d)
+ (values
+ :COMMENT
+ (read-comment-content input)))
+ (t
+ (wf-error input"Bad character ~S after \"<!-\"" d))))
+ (t
+ (wf-error input "Bad character ~S after \"<!\"" d)))))
+
+(definline read-S? (input)
+ (while (member (peek-rune input) '(#/U+0020 #/U+0009 #/U+000A #/U+000D)
+ :test #'eql)
+ (consume-rune input)))
+
+(defun read-attribute-list (zinput input imagine-space-p)
+ (cond ((or imagine-space-p
+ (let ((c (peek-rune input)))
+ (and (not (eq c :eof))
+ (space-rune-p c))))
+ (read-S? input)
+ (cond ((eq (peek-rune input) :eof)
+ nil)
+ ((name-start-rune-p (peek-rune input))
+ (cons (read-attribute zinput input)
+ (read-attribute-list zinput input nil)))
+ (t
+ nil)))
+ (t
+ nil)))
+
+(defun read-entity-like (input)
+ "Read an entity reference off the xstream `input'. Returns two values:
+ either :ENTITY-REFERENCE <interned-rod> in case of a named entity
+ or :CHARACTER-REFERENCE <integer> in case of character references.
+ The initial #\\& is considered to be consumed already."
+ (let ((c (peek-rune input)))
+ (cond ((eq c :eof)
+ (eox input "EOF after '&'"))
+ ((rune= c #/#)
+ (values :CHARACTER-REFERENCE (read-character-reference input)))
+ (t
+ (unless (name-start-rune-p (peek-rune input))
+ (wf-error input "Expecting name after &."))
+ (let ((name (read-name-token input)))
+ (setf c (read-rune input))
+ (unless (rune= c #/\;)
+ (wf-error input "Expected \";\"."))
+ (values :ENTITY-REFERENCE name))))))
+
+(defun read-tag-2 (zinput input kind)
+ (let ((name (read-name-token input))
+ (atts nil))
+ (setf atts (read-attribute-list zinput input nil))
+
+ ;; check for double attributes
+ (do ((q atts (cdr q)))
+ ((null q))
+ (cond ((find (caar q) (cdr q) :key #'car)
+ (wf-error zinput "Attribute ~S has two definitions in element ~S."
+ (rod-string (caar q))
+ (rod-string name)))))
+
+ (cond ((eq (peek-rune input) #/>)
+ (consume-rune input)
+ (values kind (cons name atts)))
+ ((eq (peek-rune input) #//)
+ (consume-rune input)
+ (check-rune input #/> (read-rune input))
+ (values :ztag (cons name atts)))
+ (t
+ (wf-error zinput "syntax error in read-tag-2.")) )))
+
+(defun read-attribute (zinput input)
+ (unless (name-start-rune-p (peek-rune input))
+ (wf-error zinput "Expected name."))
+ ;; arg thanks to the post mortem nature of name space declarations,
+ ;; we could only process the attribute values post mortem.
+ (let ((name (read-name-token input)))
+ (while (let ((c (peek-rune input)))
+ (and (not (eq c :eof))
+ (or (rune= c #/U+0020)
+ (rune= c #/U+0009)
+ (rune= c #/U+000A)
+ (rune= c #/U+000D))))
+ (consume-rune input))
+ (unless (eq (read-rune input) #/=)
+ (wf-error zinput "Expected \"=\"."))
+ (while (let ((c (peek-rune input)))
+ (and (not (eq c :eof))
+ (or (rune= c #/U+0020)
+ (rune= c #/U+0009)
+ (rune= c #/U+000A)
+ (rune= c #/U+000D))))
+ (consume-rune input))
+ (cons name (read-att-value-2 input))))
+
+(defun canon-not-cdata-attval (value)
+ ;; | If the declared value is not CDATA, then the XML processor must
+ ;; | further process the normalized attribute value by discarding any
+ ;; | leading and trailing space (#x20) characters, and by replacing
+ ;; | sequences of space (#x20) characters by a single space (#x20)
+ ;; | character.
+ (with-rune-collector (collect)
+ (let ((gimme-20 nil)
+ (anything-seen-p nil))
+ (map nil (lambda (c)
+ (cond ((rune= c #/u+0020)
+ (setf gimme-20 t))
+ (t
+ (when (and anything-seen-p gimme-20)
+ (collect #/u+0020))
+ (setf gimme-20 nil)
+ (setf anything-seen-p t)
+ (collect c))))
+ value))))
+
+(definline data-rune-p (rune)
+ ;; any Unicode character, excluding the surrogate blocks, FFFE, and FFFF.
+ ;;
+ ;; FIXME: das halte ich fuer verkehrt. Surrogates als Unicode-Zeichen
+ ;; sind verboten. Das liegt hier aber nicht vor, denn wir arbeiten
+ ;; ja tatsaechlich mit UTF-16. Verboten ist es nur, wenn wir ein
+ ;; solches Zeichen beim Dekodieren finden, das wird aber eben
+ ;; in encodings.lisp bereits geprueft. --david
+ (let ((c (rune-code rune)))
+ (or (= c #x9) (= c #xA) (= c #xD)
+ (<= #x20 c #xD7FF)
+ (<= #xE000 c #xFFFD)
+ (<= #xD800 c #xDBFF)
+ (<= #xDC00 c #xDFFF))))
+
+(defun read-att-value (zinput input mode &optional canon-space-p (delim nil))
+ (with-rune-collector-2 (collect)
+ (labels ((muffle (input delim)
+ (let (c)
+ (loop
+ (setf c (read-rune input))
+ (cond ((eql delim c)
+ (return))
+ ((eq c :eof)
+ (eox input "EOF"))
+ ((rune= c #/&)
+ (setf c (peek-rune input))
+ (cond ((eql c :eof)
+ (eox input))
+ ((rune= c #/#)
+ (let ((c (read-character-reference input)))
+ (%put-unicode-char c collect)))
+ (t
+ (unless (name-start-rune-p (peek-rune input))
+ (wf-error zinput "Expecting name after &."))
+ (let ((name (read-name-token input)))
+ (setf c (read-rune input))
+ (check-rune input c #/\;)
+ (ecase mode
+ (:ATT
+ (recurse-on-entity
+ zinput name :general
+ (lambda (zinput)
+ (muffle (car (zstream-input-stack zinput))
+ :eof))
+ t))
+ (:ENT
+ ;; bypass, but never the less we
+ ;; need to check for legal
+ ;; syntax.
+ ;; Must it be defined?
+ ;; allerdings: unparsed sind verboten
+ (collect #/&)
+ (map nil (lambda (x) (collect x)) name)
+ (collect #/\; )))))))
+ ((and (eq mode :ENT) (rune= c #/%))
+ (let ((d (peek-rune input)))
+ (when (eq d :eof)
+ (eox input))
+ (unless (name-start-rune-p d)
+ (wf-error zinput "Expecting name after %.")))
+ (let ((name (read-name-token input)))
+ (setf c (read-rune input))
+ (check-rune input c #/\;)
+ (cond (*expand-pe-p*
+ (recurse-on-entity
+ zinput name :parameter
+ (lambda (zinput)
+ (muffle (car (zstream-input-stack zinput))
+ :eof))))
+ (t
+ (wf-error zinput "No PE here.")))))
+ ((and (eq mode :ATT) (rune= c #/<))
+ (wf-error zinput "unexpected #\/<"))
+ ((and canon-space-p (space-rune-p c))
+ (collect #/space))
+ ((not (data-rune-p c))
+ (wf-error zinput "illegal char: ~S." c))
+ (t
+ (collect c)))))))
+ (declare (dynamic-extent #'muffle))
+ (muffle input (or delim
+ (let ((delim (read-rune input)))
+ (unless (member delim '(#/\" #/\') :test #'eql)
+ (wf-error zinput "invalid attribute delimiter"))
+ delim))))))
+
+(defun read-character-reference (input)
+ ;; The #/& is already read
+ (let ((res
+ (let ((c (read-rune input)))
+ (check-rune input c #/#)
+ (setq c (read-rune input))
+ (cond ((eql c :eof)
+ (eox input))
+ ((eql c #/x)
+ ;; hexadecimal
+ (setq c (read-rune input))
+ (when (eql c :eof)
+ (eox input))
+ (unless (digit-rune-p c 16)
+ (wf-error input "garbage in character reference"))
+ (prog1
+ (parse-integer
+ (with-output-to-string (sink)
+ (write-char (rune-char c) sink)
+ (while (progn
+ (setq c (read-rune input))
+ (when (eql c :eof)
+ (eox input))
+ (digit-rune-p c 16))
+ (write-char (rune-char c) sink)))
+ :radix 16)
+ (check-rune input c #/\;)))
+ ((rune<= #/0 c #/9)
+ ;; decimal
+ (prog1
+ (parse-integer
+ (with-output-to-string (sink)
+ (write-char (rune-char c) sink)
+ (while (progn
+ (setq c (read-rune input))
+ (when (eql c :eof)
+ (eox input))
+ (rune<= #/0 c #/9))
+ (write-char (rune-char c) sink)))
+ :radix 10)
+ (check-rune input c #/\;)))
+ (t
+ (wf-error input "Bad char in numeric character entity."))))))
+ (unless (code-data-char-p res)
+ (wf-error
+ input
+ "expansion of numeric character reference (#x~X) is no data char."
+ res))
+ res))
+
+(defun read-pi (input)
+ ;; "<?" is already read
+ (let (name)
+ (let ((c (peek-rune input)))
+ (unless (name-start-rune-p c)
+ (wf-error input "Expecting name after '<?'"))
+ (setf name (read-name-token input)))
+ (cond
+ ((member (peek-rune input) '(#/U+0020 #/U+0009 #/U+000A #/U+000D)
+ :test #'eql)
+ (values name (read-pi-content input)))
+ (t
+ (unless (and (eql (read-rune input) #/?)
+ (eql (read-rune input) #/>))
+ (wf-error input "malformed processing instruction"))
+ (values name "")))))
+
+(defun read-pi-content (input)
+ (read-S? input)
+ (let (d)
+ (with-rune-collector (collect)
+ (block nil
+ (tagbody
+ state-1
+ (setf d (read-rune input))
+ (when (eq d :eof)
+ (eox input))
+ (unless (data-rune-p d)
+ (wf-error input "Illegal char: ~S." d))
+ (when (rune= d #/?) (go state-2))
+ (collect d)
+ (go state-1)
+ state-2 ;; #/? seen
+ (setf d (read-rune input))
+ (when (eq d :eof)
+ (eox input))
+ (unless (data-rune-p d)
+ (wf-error input "Illegal char: ~S." d))
+ (when (rune= d #/>) (return))
+ (when (rune= d #/?)
+ (collect #/?)
+ (go state-2))
+ (collect #/?)
+ (collect d)
+ (go state-1))))))
+
+(defun read-comment-content (input &aux d)
+ (with-rune-collector (collect)
+ (block nil
+ (tagbody
+ state-1
+ (setf d (read-rune input))
+ (when (eq d :eof)
+ (eox input))
+ (unless (data-rune-p d)
+ (wf-error input "Illegal char: ~S." d))
+ (when (rune= d #/-) (go state-2))
+ (collect d)
+ (go state-1)
+ state-2 ;; #/- seen
+ (setf d (read-rune input))
+ (when (eq d :eof)
+ (eox input))
+ (unless (data-rune-p d)
+ (wf-error input "Illegal char: ~S." d))
+ (when (rune= d #/-) (go state-3))
+ (collect #/-)
+ (collect d)
+ (go state-1)
+ state-3 ;; #/- #/- seen
+ (setf d (read-rune input))
+ (when (eq d :eof)
+ (eox input))
+ (unless (data-rune-p d)
+ (wf-error input "Illegal char: ~S." d))
+ (when (rune= d #/>) (return))
+ (wf-error input "'--' not allowed in a comment")
+ (when (rune= d #/-)
+ (collect #/-)
+ (go state-3))
+ (collect #/-)
+ (collect #/-)
+ (collect d)
+ (go state-1)))))
+
+(defun read-cdata-sect (input &aux d)
+ ;; <![CDATA[ is already read
+ ;; read anything up to ]]>
+ (with-rune-collector (collect)
+ (block nil
+ (tagbody
+ state-1
+ (setf d (read-rune input))
+ (when (eq d :eof)
+ (eox input))
+ (unless (data-rune-p d)
+ (wf-error input "Illegal char: ~S." d))
+ (when (rune= d #/\]) (go state-2))
+ (collect d)
+ (go state-1)
+ state-2 ;; #/] seen
+ (setf d (read-rune input))
+ (when (eq d :eof)
+ (eox input))
+ (unless (data-rune-p d)
+ (wf-error input "Illegal char: ~S." d))
+ (when (rune= d #/\]) (go state-3))
+ (collect #/\])
+ (collect d)
+ (go state-1)
+ state-3 ;; #/\] #/\] seen
+ (setf d (read-rune input))
+ (when (eq d :eof)
+ (eox input))
+ (unless (data-rune-p d)
+ (wf-error input "Illegal char: ~S." d))
+ (when (rune= d #/>)
+ (return))
+ (when (rune= d #/\])
+ (collect #/\])
+ (go state-3))
+ (collect #/\])
+ (collect #/\])
+ (collect d)
+ (go state-1)))))
+
+;; some character categories
+
+(defun space-rune-p (rune)
+ (declare (type rune rune))
+ (or (rune= rune #/U+0020)
+ (rune= rune #/U+0009)
+ (rune= rune #/U+000A)
+ (rune= rune #/U+000D)))
+
+(defun code-data-char-p (c)
+ ;; any Unicode character, excluding the surrogate blocks, FFFE, and FFFF.
+ (or (= c #x9) (= c #xA) (= c #xD)
+ (<= #x20 c #xD7FF)
+ (<= #xE000 c #xFFFD)
+ (<= #x10000 c #x10FFFF)))
+
+(defun pubid-char-p (c)
+ (or (rune= c #/u+0020) (rune= c #/u+000D) (rune= c #/u+000A)
+ (rune<= #/a c #/z)
+ (rune<= #/A c #/Z)
+ (rune<= #/0 c #/9)
+ (member c '(#/- #/' #/\( #/\) #/+ #/, #/. #//
+ #/: #/= #/? #/\; #/! #/* #/#
+ #/@ #/$ #/_ #/%))))
+
+
+(defun expect (input category)
+ (multiple-value-bind (cat sem) (read-token input)
+ (unless (eq cat category)
+ (wf-error input "Expected ~S saw ~S [~S]" category cat sem))
+ (values cat sem)))
+
+(defun consume-token (input)
+ (read-token input))
+
+;;;; ---------------------------------------------------------------------------
+;;;; Parser
+;;;;
+
+(defun p/S (input)
+ ;; S ::= (#x20 | #x9 | #xD | #xA)+
+ (expect input :S)
+ (while (eq (peek-token input) :S)
+ (consume-token input)))
+
+(defun p/S? (input)
+ ;; S ::= (#x20 | #x9 | #xD | #xA)+
+ (while (eq (peek-token input) :S)
+ (consume-token input)))
+
+(defun p/nmtoken (input)
+ (nth-value 1 (expect input :nmtoken)))
+
+(defun p/name (input)
+ (let ((result (p/nmtoken input)))
+ (unless (name-start-rune-p (elt result 0))
+ (wf-error input "Expected name."))
+ result))
+
+(defun p/attlist-decl (input)
+ ;; [52] AttlistDecl ::= '<!ATTLIST' S Name (S AttDef)* S? '>'
+ (let (elm-name)
+ (expect input :|<!ATTLIST|)
+ (p/S input)
+ (setf elm-name (p/nmtoken input))
+ (loop
+ (let ((tok (read-token input)))
+ (case tok
+ (:S
+ (p/S? input)
+ (cond ((eq (peek-token input) :>)
+ (consume-token input)
+ (return))
+ (t
+ (multiple-value-bind (name type default) (p/attdef input)
+ (define-attribute (dtd *ctx*) elm-name name type default)) )))
+ (:>
+ (return))
+ (otherwise
+ (wf-error input
+ "Expected either another AttDef or end of \"<!ATTLIST\". -- saw ~S."
+ tok)))))))
+
+(defun p/attdef (input)
+ ;; [53] AttDef ::= Name S AttType S DefaultDecl
+ (let (name type default)
+ (setf name (p/nmtoken input))
+ (p/S input)
+ (setf type (p/att-type input))
+ (p/S input)
+ (setf default (p/default-decl input))
+ (values name type default)))
+
+(defun p/list (input item-parser delimiter)
+ ;; Parse something like S? <item> (S? <delimiter> <item>)* S?
+ ;;
+ (declare (type function item-parser))
+ (let (res)
+ (p/S? input)
+ (setf res (list (funcall item-parser input)))
+ (loop
+ (p/S? input)
+ (cond ((eq (peek-token input) delimiter)
+ (consume-token input)
+ (p/S? input)
+ (push (funcall item-parser input) res))
+ (t
+ (return))))
+ (p/S? input)
+ (reverse res)))
+
+(defun p/att-type (input)
+ ;; [54] AttType ::= StringType | TokenizedType | EnumeratedType
+ ;; [55] StringType ::= 'CDATA'
+ ;; [56] TokenizedType ::= 'ID' /*VC: ID */
+ ;; /*VC: One ID per Element Type */
+ ;; /*VC: ID Attribute Default */
+ ;; | 'IDREF' /*VC: IDREF */
+ ;; | 'IDREFS' /*VC: IDREF */
+ ;; | 'ENTITY' /*VC: Entity Name */
+ ;; | 'ENTITIES' /*VC: Entity Name */
+ ;; | 'NMTOKEN' /*VC: Name Token */
+ ;; | 'NMTOKENS' /*VC: Name Token */
+ ;; [57] EnumeratedType ::= NotationType | Enumeration
+ ;; [58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'
+ ;; /* VC: Notation Attributes */
+ ;; [59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' /* VC: Enumeration */
+ (multiple-value-bind (cat sem) (read-token input)
+ (cond ((eq cat :nmtoken)
+ (cond ((rod= sem '#.(string-rod "CDATA")) :CDATA)
+ ((rod= sem '#.(string-rod "ID")) :ID)
+ ((rod= sem '#.(string-rod "IDREF")) :IDREFS)
+ ((rod= sem '#.(string-rod "IDREFS")) :IDREFS)
+ ((rod= sem '#.(string-rod "ENTITY")) :ENTITY)
+ ((rod= sem '#.(string-rod "ENTITIES")) :ENTITIES)
+ ((rod= sem '#.(string-rod "NMTOKEN")) :NMTOKEN)
+ ((rod= sem '#.(string-rod "NMTOKENS")) :NMTOKENS)
+ ((rod= sem '#.(string-rod "NOTATION"))
+ (let (names)
+ (p/S input)
+ (expect input :\()
+ (setf names (p/list input #'p/nmtoken :\| ))
+ (expect input :\))
+ (when *validate*
+ (setf (referenced-notations *ctx*)
+ (append names (referenced-notations *ctx*))))
+ (cons :NOTATION names)))
+ (t
+ (wf-error input "In p/att-type: ~S ~S." cat sem))))
+ ((eq cat :\()
+ ;; XXX Die Nmtoken-Syntax pruefen wir derzeit nur beim Validieren.
+ (let (names)
+ ;;(expect input :\()
+ (setf names (p/list input #'p/nmtoken :\| ))
+ (expect input :\))
+ (cons :ENUMERATION names)))
+ (t
+ (wf-error input "In p/att-type: ~S ~S." cat sem)) )))
+
+(defun p/default-decl (input)
+ ;; [60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED'
+ ;; | (('#FIXED' S)? AttValue) /* VC: Required Attribute */
+ ;;
+ ;; /* VC: Attribute Default Legal */
+ ;; /* WFC: No < in Attribute Values */
+ ;; /* VC: Fixed Attribute Default */
+ (multiple-value-bind (cat sem) (peek-token input)
+ (cond ((eq cat :|#REQUIRED|)
+ (consume-token input) :REQUIRED)
+ ((eq cat :|#IMPLIED|)
+ (consume-token input) :IMPLIED)
+ ((eq cat :|#FIXED|)
+ (consume-token input)
+ (p/S input)
+ (list :FIXED (p/att-value input)))
+ ((or (eq cat :\') (eq cat :\"))
+ (list :DEFAULT (p/att-value input)))
+ (t
+ (wf-error input "p/default-decl: ~S ~S." cat sem)) )))
+;;;;
+
+;; [70] EntityDecl ::= GEDecl | PEDecl
+;; [71] GEDecl ::= '<!ENTITY' S Name S EntityDef S? '>'
+;; [72] PEDecl ::= '<!ENTITY' S '%' S Name S PEDef S? '>'
+;; [73] EntityDef ::= EntityValue | (ExternalID NDataDecl?)
+;; [74] PEDef ::= EntityValue | ExternalID
+;; [75] ExternalID ::= 'SYSTEM' S SystemLiteral
+;; | 'PUBLIC' S PubidLiteral S SystemLiteral
+;; [76] NDataDecl ::= S 'NDATA' S Name /* VC: Notation Declared */
+
+(defun p/entity-decl (input)
+ (let (name def kind)
+ (expect input :|<!ENTITY|)
+ (p/S input)
+ (cond ((eq (peek-token input) :%)
+ (setf kind :parameter)
+ (consume-token input)
+ (p/S input))
+ (t
+ (setf kind :general)))
+ (setf name (p/name input))
+ (p/S input)
+ (setf def (p/entity-def input kind))
+ (define-entity input name kind def)
+ (p/S? input)
+ (expect input :\>)))
+
+(defun report-entity (h kind name def)
+ (etypecase def
+ (external-entdef
+ (let ((extid (entdef-extid def))
+ (ndata (entdef-ndata def)))
+ (if ndata
+ (sax:unparsed-entity-declaration h
+ name
+ (extid-public extid)
+ (uri-rod (extid-system extid))
+ ndata)
+ (sax:external-entity-declaration h
+ kind
+ name
+ (extid-public extid)
+ (uri-rod (extid-system extid))))))
+ (internal-entdef
+ (sax:internal-entity-declaration h kind name (entdef-value def)))))
+
+(defun p/entity-def (input kind)
+ (multiple-value-bind (cat sem) (peek-token input)
+ (cond ((member cat '(:\" :\'))
+ (make-internal-entdef (p/entity-value input)))
+ ((and (eq cat :nmtoken)
+ (or (rod= sem '#.(string-rod "SYSTEM"))
+ (rod= sem '#.(string-rod "PUBLIC"))))
+ (let (extid ndata)
+ (setf extid (p/external-id input nil))
+ (when (eq kind :general) ;NDATA allowed at all?
+ (cond ((eq (peek-token input) :S)
+ (p/S? input)
+ (when (and (eq (peek-token input) :nmtoken)
+ (rod= (nth-value 1 (peek-token input))
+ '#.(string-rod "NDATA")))
+ (consume-token input)
+ (p/S input)
+ (setf ndata (p/nmtoken input))
+ (when *validate*
+ (push ndata (referenced-notations *ctx*)))))))
+ (make-external-entdef extid ndata)))
+ (t
+ (wf-error input "p/entity-def: ~S / ~S." cat sem)) )))
+
+(defun p/entity-value (input)
+ (let ((delim (if (eq (read-token input) :\") #/\" #/\')))
+ (read-att-value input
+ (car (zstream-input-stack input))
+ :ENT
+ nil
+ delim)))
+
+(defun p/att-value (input)
+ (let ((delim (if (eq (read-token input) :\") #/\" #/\')))
+ (read-att-value input
+ (car (zstream-input-stack input))
+ :ATT
+ t
+ delim)))
+
+(defun p/external-id (input &optional (public-only-ok-p nil))
+ ;; xxx public-only-ok-p
+ (multiple-value-bind (cat sem) (read-token input)
+ (cond ((and (eq cat :nmtoken) (rod= sem '#.(string-rod "SYSTEM")))
+ (p/S input)
+ (make-extid nil (p/system-literal input)))
+ ((and (eq cat :nmtoken) (rod= sem '#.(string-rod "PUBLIC")))
+ (let (pub sys)
+ (p/S input)
+ (setf pub (p/pubid-literal input))
+ (when (eq (peek-token input) :S)
+ (p/S input)
+ (when (member (peek-token input) '(:\" :\'))
+ (setf sys (p/system-literal input))))
+ (when (and (not public-only-ok-p)
+ (null sys))
+ (wf-error input "System identifier needed for this PUBLIC external identifier."))
+ (make-extid pub sys)))
+ (t
+ (wf-error input "Expected external-id: ~S / ~S." cat sem)))))
+
+
+;; [11] SystemLiteral ::= ('"' [^"]* '"') | ("'" [^']* "'")
+;; [12] PubidLiteral ::= '"' PubidChar* '"' | "'" (PubidChar - "'")* "'"
+;; [13] PubidChar ::= #x20 | #xD | #xA | [a-zA-Z0-9]
+;; | [-'()+,./:=?;!*#@$_%]
+
+(defun p/id (input)
+ (multiple-value-bind (cat) (read-token input)
+ (cond ((member cat '(:\" :\'))
+ (let ((delim (if (eq cat :\") #/\" #/\')))
+ (with-rune-collector (collect)
+ (loop
+ (let ((c (read-rune (car (zstream-input-stack input)))))
+ (cond ((eq c :eof)
+ (eox input "EOF in system literal."))
+ ((rune= c delim)
+ (return))
+ (t
+ (collect c))))))))
+ (t
+ (wf-error input "Expect either \" or \'.")))))
+
+;; it is important to cache the orginal URI rod, since the re-serialized
+;; uri-string can be different from the one parsed originally.
+(defun uri-rod (uri)
+ (if uri
+ (or (getf (puri:uri-plist uri) 'original-rod)
+ (rod (puri:render-uri uri nil)))
+ nil))
+
+(defun safe-parse-uri (str)
+ ;; puri doesn't like strings starting with file:///, although that is a very
+ ;; common is practise. Cut it away, we don't distinguish between scheme
+ ;; :FILE and NIL anway.
+ (when (eql (search "file://" str) 0)
+ (setf str (subseq str (length "file://"))))
+ (puri:parse-uri (coerce str 'simple-string)))
+
+(defun p/system-literal (input)
+ (let* ((rod (p/id input))
+ (result (safe-parse-uri (rod-string rod))))
+ (setf (getf (puri:uri-plist result) 'original-rod) rod)
+ result))
+
+(defun p/pubid-literal (input)
+ (let ((result (p/id input)))
+ (unless (every #'pubid-char-p result)
+ (wf-error input "Illegal pubid: ~S." (rod-string result)))
+ result))
+
+
+;;;;
+
+(defun p/element-decl (input)
+ (let (name content)
+ (expect input :|<!ELEMENT|)
+ (p/S input)
+ (setf name (p/nmtoken input))
+ (p/S input)
+ (setf content (normalize-mixed-cspec (p/cspec input)))
+ (unless (legal-content-model-p content *validate*)
+ (wf-error input "Malformed or invalid content model: ~S." (mu content)))
+ (p/S? input)
+ (expect input :\>)
+ (when *validate*
+ (define-element (dtd *ctx*) name content))
+ (list :element name content)))
+
+(defun maybe-compile-cspec (e)
+ (or (elmdef-compiled-cspec e)
+ (setf (elmdef-compiled-cspec e)
+ (let ((cspec (elmdef-content e)))
+ (unless cspec
+ (validity-error "(03) Element Valid: no definition for ~A"
+ (rod-string (elmdef-name e))))
+ (multiple-value-call #'cons
+ (compile-cspec cspec (standalone-check-necessary-p e)))))))
+
+(defun make-root-model (name)
+ (cons (lambda (actual-name)
+ (if (rod= actual-name name)
+ (constantly :dummy)
+ nil))
+ (constantly t)))
+
+;;; content spec validation:
+;;;
+;;; Given a `contentspec', COMPILE-CSPEC returns as multiple values two
+;;; functions A and B of one argument to be called for every
+;;; A. child element
+;;; B. text child node
+;;;
+;;; Function A will be called with
+;;; - the element name rod as its argument. If that element may appear
+;;; at the current position, a new function to be called for the next
+;;; child is returned. Otherwise NIL is returned.
+;;; - argument NIL at the end of the element, it must then return T or NIL
+;;; to indicate whether the end tag is valid.
+;;;
+;;; Function B will be called with the character data rod as its argument, it
+;;; returns a boolean indicating whether this text node is allowed.
+;;;
+;;; That is, if one of the functions ever returns NIL, the node is
+;;; rejected as invalid.
+
+(defun cmodel-done (actual-value)
+ (null actual-value))
+
+(defun compile-cspec (cspec &optional standalone-check)
+ (cond
+ ((atom cspec)
+ (ecase cspec
+ (:EMPTY (values #'cmodel-done (constantly nil)))
+ (:PCDATA (values #'cmodel-done (constantly t)))
+ (:ANY
+ (values (labels ((doit (name) (if name #'doit t))) #'doit)
+ (constantly t)))))
+ ((and (eq (car cspec) '*)
+ (let ((subspec (second cspec)))
+ (and (eq (car subspec) 'or) (eq (cadr subspec) :PCDATA))))
+ (values (compile-mixed (second cspec))
+ (constantly t)))
+ (t
+ (values (compile-content-model cspec)
+ (lambda (rod)
+ (when standalone-check
+ (validity-error "(02) Standalone Document Declaration: whitespace"))
+ (every #'white-space-rune-p rod))))))
+
+(defun compile-mixed (cspec)
+ ;; das koennten wir theoretisch auch COMPILE-CONTENT-MODEL erledigen lassen
+ (let ((allowed-names (cddr cspec)))
+ (labels ((doit (actual-name)
+ (cond
+ ((null actual-name) t)
+ ((member actual-name allowed-names :test #'rod=) #'doit)
+ (t nil))))
+ #'doit)))
+
+(defun compile-content-model (cspec &optional (continuation #'cmodel-done))
+ (if (vectorp cspec)
+ (lambda (actual-name)
+ (if (and actual-name (rod= cspec actual-name))
+ continuation
+ nil))
+ (ecase (car cspec)
+ (and
+ (labels ((traverse (seq)
+ (compile-content-model (car seq)
+ (if (cdr seq)
+ (traverse (cdr seq))
+ continuation))))
+ (traverse (cdr cspec))))
+ (or
+ (let ((options (mapcar (rcurry #'compile-content-model continuation)
+ (cdr cspec))))
+ (lambda (actual-name)
+ (some (rcurry #'funcall actual-name) options))))
+ (?
+ (let ((maybe (compile-content-model (second cspec) continuation)))
+ (lambda (actual-name)
+ (or (funcall maybe actual-name)
+ (funcall continuation actual-name)))))
+ (*
+ (let (maybe-continuation)
+ (labels ((recurse (actual-name)
+ (if (null actual-name)
+ (funcall continuation actual-name)
+ (or (funcall maybe-continuation actual-name)
+ (funcall continuation actual-name)))))
+ (setf maybe-continuation
+ (compile-content-model (second cspec) #'recurse))
+ #'recurse)))
+ (+
+ (let ((it (cadr cspec)))
+ (compile-content-model `(and ,it (* ,it)) continuation))))))
+
+(defun setp (list &key (test 'eql))
+ (equal list (remove-duplicates list :test test)))
+
+(defun legal-content-model-p (cspec &optional validate)
+ (or (eq cspec :PCDATA)
+ (eq cspec :ANY)
+ (eq cspec :EMPTY)
+ (and (consp cspec)
+ (eq (car cspec) '*)
+ (consp (cadr cspec))
+ (eq (car (cadr cspec)) 'or)
+ (eq (cadr (cadr cspec)) :PCDATA)
+ (every #'vectorp (cddr (cadr cspec)))
+ (if (and validate (not (setp (cddr (cadr cspec)) :test #'rod=)))
+ (validity-error "VC: No Duplicate Types (07)")
+ t))
+ (labels ((walk (x)
+ (cond ((member x '(:PCDATA :ANY :EMPTY))
+ nil)
+ ((atom x) t)
+ ((and (walk (car x))
+ (walk (cdr x)))))))
+ (walk cspec))))
+
+;; wir fahren besser, wenn wir machen:
+
+;; cspec ::= 'EMPTY' | 'ANY' | '#PCDATA'
+;; | Name
+;; | cs
+;; cs ::= '(' S? cspec ( S? '|' S? cspec)* S? ')' ('?' | '*' | '+')?
+;; und eine post factum analyse
+
+(defun p/cspec (input &optional recursivep)
+ (let ((term
+ (let ((names nil) op-cat op res stream)
+ (multiple-value-bind (cat sem) (peek-token input)
+ (cond ((eq cat :nmtoken)
+ (consume-token input)
+ (cond ((rod= sem '#.(string-rod "EMPTY"))
+ :EMPTY)
+ ((rod= sem '#.(string-rod "ANY"))
+ :ANY)
+ ((not recursivep)
+ (wf-error input "invalid content spec"))
+ (t
+ sem)))
+ ((eq cat :\#PCDATA)
+ (consume-token input)
+ :PCDATA)
+ ((eq cat :\()
+ (setf stream (car (zstream-input-stack input)))
+ (consume-token input)
+ (p/S? input)
+ (setq names (list (p/cspec input t)))
+ (p/S? input)
+ (cond ((member (peek-token input) '(:\| :\,))
+ (setf op-cat (peek-token input))
+ (setf op (if (eq op-cat :\,) 'and 'or))
+ (while (eq (peek-token input) op-cat)
+ (consume-token input)
+ (p/S? input)
+ (push (p/cspec input t) names)
+ (p/S? input))
+ (setf res (cons op (reverse names))))
+ (t
+ (setf res (cons 'and names))))
+ (p/S? input)
+ (expect input :\))
+ (when *validate*
+ (unless (eq stream (car (zstream-input-stack input)))
+ (validity-error "(06) Proper Group/PE Nesting")))
+ res)
+ (t
+ (wf-error input "p/cspec - ~s / ~s" cat sem)))))))
+ (cond ((eq (peek-token input) :?) (consume-token input) (list '? term))
+ ((eq (peek-token input) :+) (consume-token input) (list '+ term))
+ ((eq (peek-token input) :*) (consume-token input) (list '* term))
+ (t
+ term))))
+
+(defun normalize-mixed-cspec (cspec)
+ ;; der Parser oben funktioniert huebsch fuer die children-Regel, aber
+ ;; fuer Mixed ist das Ergebnis nicht praktisch, denn dort wollen wir
+ ;; eigentlich auf eine Liste von Namen in einheitlichem Format hinaus.
+ ;; Dazu normalisieren wir einfach in eine der beiden folgenden Formen:
+ ;; (* (or :PCDATA ...rods...)) -- und zwar exakt so!
+ ;; :PCDATA -- sonst ganz trivial
+ (flet ((trivialp (c)
+ (and (consp c)
+ (and (eq (car c) 'and)
+ (eq (cadr c) :PCDATA)
+ (null (cddr c))))))
+ (if (or (trivialp cspec) ;(and PCDATA)
+ (and (consp cspec) ;(* (and PCDATA))
+ (and (eq (car cspec) '*)
+ (null (cddr cspec))
+ (trivialp (cadr cspec)))))
+ :PCDATA
+ cspec)))
+
+;; [52] AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>'
+
+
+;; [52] AttlistDecl ::= '<!ATTLIST' S Name AttDefs S? '>'
+;; [52] AttlistDecl ::= '<!ATTLIST' S Name S? '>'
+;; [53] AttDefs ::= S Name S AttType S DefaultDecl AttDefs
+;; [53] AttDefs ::=
+
+(defun p/notation-decl (input)
+ (let (name id)
+ (expect input :|<!NOTATION|)
+ (p/S input)
+ (setf name (p/name input))
+ (p/S input)
+ (setf id (p/external-id input t))
+ (p/S? input)
+ (expect input :\>)
+ (sax:notation-declaration (handler *ctx*)
+ name
+ (if (extid-public id)
+ (normalize-public-id (extid-public id))
+ nil)
+ (uri-rod (extid-system id)))
+ (when (and sax:*namespace-processing* (find #/: name))
+ (wf-error input "colon in notation name"))
+ (when *validate*
+ (define-notation (dtd *ctx*) name id))
+ (list :notation-decl name id)))
+
+(defun normalize-public-id (rod)
+ (with-rune-collector (collect)
+ (let ((gimme-20 nil)
+ (anything-seen-p nil))
+ (map nil (lambda (c)
+ (cond
+ ((or (rune= c #/u+0009)
+ (rune= c #/u+000A)
+ (rune= c #/u+000D)
+ (rune= c #/u+0020))
+ (setf gimme-20 t))
+ (t
+ (when (and anything-seen-p gimme-20)
+ (collect #/u+0020))
+ (setf gimme-20 nil)
+ (setf anything-seen-p t)
+ (collect c))))
+ rod))))
+
+;;;
+
+(defun p/conditional-sect (input)
+ (expect input :<!\[ )
+ (let ((stream (car (zstream-input-stack input))))
+ (p/S? input)
+ (multiple-value-bind (cat sem) (read-token input)
+ (cond ((and (eq cat :nmtoken)
+ (rod= sem '#.(string-rod "INCLUDE")))
+ (p/include-sect input stream))
+ ((and (eq cat :nmtoken)
+ (rod= sem '#.(string-rod "IGNORE")))
+ (p/ignore-sect input stream))
+ (t
+ (wf-error input "Expected INCLUDE or IGNORE after \"<![\"."))))))
+
+(defun p/cond-expect (input cat initial-stream)
+ (expect input cat)
+ (when *validate*
+ (unless (eq (car (zstream-input-stack input)) initial-stream)
+ (validity-error "(21) Proper Conditional Section/PE Nesting"))))
+
+(defun p/include-sect (input initial-stream)
+ ;; <![INCLUDE is already read.
+ (p/S? input)
+ (p/cond-expect input :\[ initial-stream)
+ (p/ext-subset-decl input)
+ (p/cond-expect input :\] initial-stream)
+ (p/cond-expect input :\] initial-stream)
+ (p/cond-expect input :\> initial-stream))
+
+(defun p/ignore-sect (input initial-stream)
+ ;; <![IGNORE is already read.
+ ;; XXX Is VC 21 being checked for nested sections?
+ (p/S? input)
+ (p/cond-expect input :\[ initial-stream)
+ (let ((input (car (zstream-input-stack input))))
+ (let ((level 0))
+ (do ((c1 (read-rune input) (read-rune input))
+ (c2 #/U+0000 c1)
+ (c3 #/U+0000 c2))
+ ((= level -1))
+ (declare (type fixnum level))
+ (cond ((eq c1 :eof)
+ (eox input "EOF in <![IGNORE ... >")))
+ (cond ((and (rune= c3 #/<) (rune= c2 #/!) (rune= c1 #/\[))
+ (incf level)))
+ (cond ((and (rune= c3 #/\]) (rune= c2 #/\]) (rune= c1 #/>))
+ (decf level))) )))
+ (unless (eq (car (zstream-input-stack input)) initial-stream)
+ (validity-error "(21) Proper Conditional Section/PE Nesting")))
+
+(defun p/ext-subset-decl (input)
+ ;; ( markupdecl | conditionalSect | S )*
+ (loop
+ (case (let ((*expand-pe-p* nil)) (peek-token input))
+ (:|<![| (let ((*expand-pe-p* t)) (p/conditional-sect input)))
+ (:S (consume-token input))
+ (:eof (return))
+ ((:|<!ELEMENT| :|<!ATTLIST| :|<!ENTITY| :|<!NOTATION| :PI :COMMENT)
+ (let ((*expand-pe-p* t)
+ (*external-subset-p* t))
+ (p/markup-decl input)))
+ ((:PE-REFERENCE)
+ (let ((name (nth-value 1 (read-token input))))
+ (recurse-on-entity input name :parameter
+ (lambda (input)
+ (etypecase (checked-get-entdef name :parameter)
+ (external-entdef
+ (p/ext-subset input))
+ (internal-entdef
+ (p/ext-subset-decl input)))
+ (unless (eq :eof (peek-token input))
+ (wf-error input "Trailing garbage."))))))
+ (otherwise (return)))) )
+
+(defun p/markup-decl (input)
+ (peek-token input)
+ (let ((stream (car (zstream-input-stack input))))
+ (multiple-value-prog1
+ (p/markup-decl-unsafe input)
+ (when *validate*
+ (unless (eq stream (car (zstream-input-stack input)))
+ (validity-error "(01) Proper Declaration/PE Nesting"))))))
+
+(defun p/markup-decl-unsafe (input)
+ ;; markupdecl ::= elementdecl | AttlistDecl /* VC: Proper Declaration/PE Nesting */
+ ;; | EntityDecl | NotationDecl
+ ;; | PI | Comment /* WFC: PEs in Internal Subset */
+ (let ((token (peek-token input))
+ (*expand-pe-p* (and *expand-pe-p* *external-subset-p*)))
+ (case token
+ (:|<!ELEMENT| (p/element-decl input))
+ (:|<!ATTLIST| (p/attlist-decl input))
+ (:|<!ENTITY| (p/entity-decl input))
+ (:|<!NOTATION| (p/notation-decl input))
+ (:PI
+ (let ((sem (nth-value 1 (read-token input))))
+ (sax:processing-instruction (handler *ctx*) (car sem) (cdr sem))))
+ (:COMMENT (consume-token input))
+ (otherwise
+ (wf-error input "p/markup-decl ~S" (peek-token input))))))
+
+(defun setup-encoding (input xml-header)
+ (when (xml-header-encoding xml-header)
+ (let ((enc (find-encoding (xml-header-encoding xml-header))))
+ (cond (enc
+ (setf (xstream-encoding (car (zstream-input-stack input)))
+ enc))
+ (t
+ (warn "There is no such encoding: ~S." (xml-header-encoding xml-header)))))))
+
+(defun set-full-speed (input)
+ (let ((xstream (car (zstream-input-stack input))))
+ (when xstream
+ (set-to-full-speed xstream))))
+
+(defun p/ext-subset (input)
+ (cond ((eq (peek-token input) :xml-decl)
+ (let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input))))))
+ (setup-encoding input hd))
+ (consume-token input)))
+ (set-full-speed input)
+ (p/ext-subset-decl input)
+ (unless (eq (peek-token input) :eof)
+ (wf-error input "Trailing garbage - ~S." (peek-token input))))
+
+(defvar *catalog* nil)
+
+(defun extid-using-catalog (extid)
+ (if *catalog*
+ (let ((sysid
+ (resolve-extid (extid-public extid)
+ (extid-system extid)
+ *catalog*)))
+ (if sysid
+ (make-extid nil sysid)
+ extid))
+ extid))
+
+(defun p/doctype-decl (input &optional dtd-extid)
+ (let ()
+ (let ((*expand-pe-p* nil)
+ name extid)
+ (expect input :|<!DOCTYPE|)
+ (p/S input)
+ (setq name (p/nmtoken input))
+ (when *validate*
+ (setf (model-stack *ctx*) (list (make-root-model name))))
+ (when (eq (peek-token input) :S)
+ (p/S input)
+ (unless (or (eq (peek-token input) :\[ )
+ (eq (peek-token input) :\> ))
+ (setf extid (p/external-id input t))))
+ (when dtd-extid
+ (setf extid dtd-extid))
+ (p/S? input)
+ (sax:start-dtd (handler *ctx*)
+ name
+ (and extid (extid-public extid))
+ (and extid (uri-rod (extid-system extid))))
+ (when (eq (peek-token input) :\[ )
+ (when (disallow-internal-subset *ctx*)
+ (wf-error input "document includes an internal subset"))
+ (ensure-dtd)
+ (consume-token input)
+ (sax:start-internal-subset (handler *ctx*))
+ (while (progn (p/S? input)
+ (not (eq (peek-token input) :\] )))
+ (if (eq (peek-token input) :PE-REFERENCE)
+ (let ((name (nth-value 1 (read-token input))))
+ (recurse-on-entity input name :parameter
+ (lambda (input)
+ (etypecase (checked-get-entdef name :parameter)
+ (external-entdef
+ (p/ext-subset input))
+ (internal-entdef
+ (p/ext-subset-decl input)))
+ (unless (eq :eof (peek-token input))
+ (wf-error input "Trailing garbage.")))))
+ (let ((*expand-pe-p* t))
+ (p/markup-decl input))))
+ (consume-token input)
+ (sax:end-internal-subset (handler *ctx*))
+ (p/S? input))
+ (expect input :>)
+ (when extid
+ (let* ((effective-extid
+ (extid-using-catalog (absolute-extid input extid)))
+ (sysid (extid-system effective-extid))
+ (fresh-dtd-p (null (dtd *ctx*)))
+ (cached-dtd
+ (and fresh-dtd-p
+ (not (standalone-p *ctx*))
+ (getdtd sysid *dtd-cache*))))
+ (cond
+ (cached-dtd
+ (setf (dtd *ctx*) cached-dtd)
+ (report-cached-dtd cached-dtd))
+ (t
+ (let ((xi2 (xstream-open-extid effective-extid)))
+ (with-zstream (zi2 :input-stack (list xi2))
+ (ensure-dtd)
+ (p/ext-subset zi2)
+ (when (and fresh-dtd-p
+ *cache-all-dtds*
+ *validate*
+ (not (standalone-p *ctx*)))
+ (setf (getdtd sysid *dtd-cache*) (dtd *ctx*)))))))))
+ (sax:end-dtd (handler *ctx*))
+ (let ((dtd (dtd *ctx*)))
+ (sax:entity-resolver
+ (handler *ctx*)
+ (lambda (name handler) (resolve-entity name handler dtd)))
+ (sax::dtd (handler *ctx*) dtd))
+ (list :DOCTYPE name extid))))
+
+(defun report-cached-dtd (dtd)
+ (maphash (lambda (k v)
+ (report-entity (handler *ctx*) :general k (cdr v)))
+ (dtd-gentities dtd))
+ (maphash (lambda (k v)
+ (report-entity (handler *ctx*) :parameter k (cdr v)))
+ (dtd-pentities dtd))
+ (maphash (lambda (k v)
+ (sax:notation-declaration
+ (handler *ctx*)
+ k
+ (if (extid-public v)
+ (normalize-public-id (extid-public v))
+ nil)
+ (uri-rod (extid-system v))))
+ (dtd-notations dtd)))
+
+(defun p/misc*-2 (input)
+ ;; Misc*
+ (while (member (peek-token input) '(:COMMENT :PI :S))
+ (case (peek-token input)
+ (:COMMENT
+ (sax:comment (handler *ctx*) (nth-value 1 (peek-token input))))
+ (:PI
+ (sax:processing-instruction
+ (handler *ctx*)
+ (car (nth-value 1 (peek-token input)))
+ (cdr (nth-value 1 (peek-token input))))))
+ (consume-token input)))
+
+(defun p/document
+ (input handler
+ &key validate dtd root entity-resolver disallow-internal-subset
+ (recode t))
+ ;; check types of user-supplied arguments for better error messages:
+ (check-type validate boolean)
+ (check-type recode boolean)
+ (check-type dtd (or null extid))
+ (check-type root (or null rod))
+ (check-type entity-resolver (or null function symbol))
+ (check-type disallow-internal-subset boolean)
+ #+rune-is-integer
+ (when recode
+ (setf handler (make-recoder handler #'rod-to-utf8-string)))
+ (let* ((xstream (car (zstream-input-stack input)))
+ (name (xstream-name xstream))
+ (base (when name (stream-name-uri name)))
+ (*ctx*
+ (make-context :handler handler
+ :main-zstream input
+ :entity-resolver entity-resolver
+ :base-stack (list (or base ""))
+ :disallow-internal-subset disallow-internal-subset))
+ (*validate* validate)
+ (*namespace-bindings* *initial-namespace-bindings*))
+ (sax:register-sax-parser handler (make-instance 'cxml-parser :ctx *ctx*))
+ (sax:start-document handler)
+ ;; document ::= XMLDecl? Misc* (doctypedecl Misc*)? element Misc*
+ ;; Misc ::= Comment | PI | S
+ ;; xmldecl::='<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>'
+ ;; sddecl::= S 'standalone' Eq (("'" ('yes' | 'no') "'") | ('"' ('yes' | 'no') '"'))
+ (let ((*data-behaviour* :DTD))
+ ;; optional XMLDecl?
+ (p/xmldecl input)
+ ;; Misc*
+ (p/misc*-2 input)
+ ;; (doctypedecl Misc*)?
+ (cond
+ ((eq (peek-token input) :<!DOCTYPE)
+ (p/doctype-decl input dtd)
+ (p/misc*-2 input))
+ (dtd
+ (synthesize-doctype dtd input))
+ ((and validate (not dtd))
+ (validity-error "invalid document: no doctype")))
+ (ensure-dtd)
+ ;; Override expected root element if asked to
+ (when root
+ (setf (model-stack *ctx*) (list (make-root-model root))))
+ ;; element
+ (let ((*data-behaviour* :DOC))
+ (fix-seen-< input)
+ (p/element input))
+ ;; optional Misc*
+ (p/misc*-2 input)
+ (p/eof input)
+ (sax:end-document handler))))
+
+(defun synthesize-doctype (dtd input)
+ (let ((dummy (string->xstream "<!DOCTYPE dummy>")))
+ (setf (xstream-name dummy)
+ (make-stream-name
+ :entity-name "dummy doctype"
+ :entity-kind :main
+ :uri (zstream-base-sysid input)))
+ (with-zstream (zstream :input-stack (list dummy))
+ (p/doctype-decl zstream dtd))))
+
+(defun fix-seen-< (input)
+ (when (eq (peek-token input) :seen-<)
+ (multiple-value-bind (c s)
+ (read-token-after-|<| input (car (zstream-input-stack input)))
+ (setf (zstream-token-category input) c
+ (zstream-token-semantic input) s))))
+
+(defun p/xmldecl (input)
+ ;; we will use the attribute-value parser for the xml decl.
+ (prog1
+ (when (eq (peek-token input) :xml-decl)
+ (let ((hd (parse-xml-decl (cdr (nth-value 1 (peek-token input))))))
+ (setf (standalone-p *ctx*) (eq (xml-header-standalone-p hd) :yes))
+ (setup-encoding input hd)
+ (read-token input)
+ hd))
+ (set-full-speed input)))
+
+(defun p/eof (input)
+ (unless (eq (peek-token input) :eof)
+ (wf-error input "Garbage at end of document."))
+ (when *validate*
+ (maphash (lambda (k v)
+ (unless v
+ (validity-error "(11) IDREF: ~S not defined" (rod-string k))))
+ (id-table *ctx*))
+
+ (dolist (name (referenced-notations *ctx*))
+ (unless (find-notation name (dtd *ctx*))
+ (validity-error "(23) Notation Declared: ~S" (rod-string name))))))
+
+(defun p/element (input)
+ (multiple-value-bind (cat n-b new-b uri lname qname attrs) (p/sztag input)
+ (sax:start-element (handler *ctx*) uri lname qname attrs)
+ (when (eq cat :stag)
+ (let ((*namespace-bindings* n-b))
+ (p/content input))
+ (p/etag input qname))
+ (sax:end-element (handler *ctx*) uri lname qname)
+ (undeclare-namespaces new-b)
+ (pop (base-stack *ctx*))
+ (validate-end-element *ctx* qname)))
+
+(defun p/sztag (input)
+ (multiple-value-bind (cat sem) (read-token input)
+ (case cat
+ ((:stag :ztag))
+ (:eof (eox input))
+ (t (wf-error input "element expected")))
+ (destructuring-bind (&optional name &rest raw-attrs) sem
+ (validate-start-element *ctx* name)
+ (let* ((attrs
+ (process-attributes *ctx* name (build-attribute-list raw-attrs)))
+ (*namespace-bindings* *namespace-bindings*)
+ new-namespaces)
+ (when sax:*namespace-processing*
+ (setf new-namespaces (declare-namespaces attrs))
+ (mapc #'set-attribute-namespace attrs))
+ (push (compute-base attrs) (base-stack *ctx*))
+ (multiple-value-bind (uri prefix local-name)
+ (if sax:*namespace-processing*
+ (decode-qname name)
+ (values nil nil nil))
+ (declare (ignore prefix))
+ (check-attribute-uniqueness attrs)
+ (unless (or sax:*include-xmlns-attributes*
+ (null sax:*namespace-processing*))
+ (setf attrs
+ (remove-if (compose #'xmlns-attr-p #'sax:attribute-qname)
+ attrs)))
+ (values cat
+ *namespace-bindings*
+ new-namespaces
+ uri local-name name attrs))))))
+
+(defun p/etag (input qname)
+ (multiple-value-bind (cat2 sem2) (read-token input)
+ (unless (and (eq cat2 :etag)
+ (eq (car sem2) qname))
+ (wf-error input "Bad nesting. ~S / ~S"
+ (mu qname)
+ (mu (cons cat2 sem2))))
+ (when (cdr sem2)
+ (wf-error input "no attributes allowed in end tag"))))
+
+;; copy&paste from cxml-rng
+(defun escape-uri (string)
+ (with-output-to-string (out)
+ (loop for c across (cxml::rod-to-utf8-string string) do
+ (let ((code (char-code c)))
+ ;; http://www.w3.org/TR/xlink/#link-locators
+ (if (or (>= code 127) (<= code 32) (find c "<>\"{}|\\^`"))
+ (format out "%~2,'0X" code)
+ (write-char c out))))))
+
+(defun compute-base (attrs)
+ (let ((new (sax:find-attribute #"xml:base" attrs))
+ (current (car (base-stack *ctx*))))
+ (if new
+ (puri:merge-uris (escape-uri (sax:attribute-value new)) current)
+ current)))
+
+(defun process-characters (input sem)
+ (consume-token input)
+ (when (search #"]]>" sem)
+ (wf-error input "']]>' not allowed in CharData"))
+ (validate-characters *ctx* sem))
+
+(defun process-cdata-section (input)
+ (consume-token input)
+ (let ((input (car (zstream-input-stack input))))
+ (unless (and (rune= #/C (read-rune input))
+ (rune= #/D (read-rune input))
+ (rune= #/A (read-rune input))
+ (rune= #/T (read-rune input))
+ (rune= #/A (read-rune input))
+ (rune= #/\[ (read-rune input)))
+ (wf-error input "After '<![', 'CDATA[' is expected."))
+ (validate-characters *ctx* #"hack") ;anything other than whitespace
+ (read-cdata-sect input)))
+
+(defun p/content (input)
+ ;; [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
+ (multiple-value-bind (cat sem) (peek-token input)
+ (case cat
+ ((:stag :ztag)
+ (p/element input)
+ (p/content input))
+ ((:CDATA)
+ (process-characters input sem)
+ (sax:characters (handler *ctx*) sem)
+ (p/content input))
+ ((:ENTITY-REF)
+ (let ((name sem))
+ (consume-token input)
+ (append
+ (recurse-on-entity input name :general
+ (lambda (input)
+ (prog1
+ (etypecase (checked-get-entdef name :general)
+ (internal-entdef (p/content input))
+ (external-entdef (p/ext-parsed-ent input)))
+ (unless (eq (peek-token input) :eof)
+ (wf-error input "Trailing garbage. - ~S"
+ (peek-token input))))))
+ (p/content input))))
+ ((:<!\[)
+ (let ((data (process-cdata-section input)))
+ (sax:start-cdata (handler *ctx*))
+ (sax:characters (handler *ctx*) data)
+ (sax:end-cdata (handler *ctx*)))
+ (p/content input))
+ ((:PI)
+ (consume-token input)
+ (sax:processing-instruction (handler *ctx*) (car sem) (cdr sem))
+ (p/content input))
+ ((:COMMENT)
+ (consume-token input)
+ (sax:comment (handler *ctx*) sem)
+ (p/content input))
+ (otherwise
+ nil))))
+
+;; [78] extParsedEnt ::= TextDecl? contentw
+;; [79] extPE ::= TextDecl? extSubsetDecl
+
+(defstruct xml-header
+ version
+ encoding
+ (standalone-p nil))
+
+(defun p/ext-parsed-ent (input)
+ ;; [78] extParsedEnt ::= '<?xml' VersionInfo? EncodingDecl S? '?>' content
+ (when (eq (peek-token input) :xml-decl)
+ (let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input))))))
+ (setup-encoding input hd))
+ (consume-token input))
+ (set-full-speed input)
+ (p/content input))
+
+(defun parse-xml-decl (content)
+ (let* ((res (make-xml-header))
+ (i (make-rod-xstream content)))
+ (with-zstream (z :input-stack (list i))
+ (let ((atts (read-attribute-list z i t)))
+ (unless (eq (peek-rune i) :eof)
+ (wf-error i "Garbage at end of XMLDecl."))
+ ;; versioninfo muss da sein
+ ;; dann ? encodingdecl
+ ;; dann ? sddecl
+ ;; dann ende
+ (unless (eq (caar atts) (intern-name '#.(string-rod "version")))
+ (wf-error i "XMLDecl needs version."))
+ (unless (and (>= (length (cdar atts)) 1)
+ (every (lambda (x)
+ (or (rune<= #/a x #/z)
+ (rune<= #/A x #/Z)
+ (rune<= #/0 x #/9)
+ (rune= x #/_)
+ (rune= x #/.)
+ (rune= x #/:)
+ (rune= x #/-)))
+ (cdar atts)))
+ (wf-error i"Bad XML version number: ~S." (rod-string (cdar atts))))
+ (setf (xml-header-version res) (rod-string (cdar atts)))
+ (pop atts)
+ (when (eq (caar atts) (intern-name '#.(string-rod "encoding")))
+ (unless (and (>= (length (cdar atts)) 1)
+ (every (lambda (x)
+ (or (rune<= #/a x #/z)
+ (rune<= #/A x #/Z)
+ (rune<= #/0 x #/9)
+ (rune= x #/_)
+ (rune= x #/.)
+ (rune= x #/-)))
+ (cdar atts))
+ ((lambda (x)
+ (or (rune<= #/a x #/z)
+ (rune<= #/A x #/Z)))
+ (aref (cdar atts) 0)))
+ (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts))))
+ (setf (xml-header-encoding res) (rod-string (cdar atts)))
+ (pop atts))
+ (when (eq (caar atts) (intern-name '#.(string-rod "standalone")))
+ (unless (or (rod= (cdar atts) '#.(string-rod "yes"))
+ (rod= (cdar atts) '#.(string-rod "no")))
+ (wf-error i "XMLDecl's 'standalone' attribute must be exactly \"yes\" or \"no\" and not ~S."
+ (rod-string (cdar atts))))
+ (setf (xml-header-standalone-p res)
+ (if (rod-equal '#.(string-rod "yes") (cdar atts))
+ :yes
+ :no))
+ (pop atts))
+ (when atts
+ (wf-error i "Garbage in XMLDecl: ~A" (rod-string content)))
+ res))))
+
+(defun parse-text-decl (content)
+ (let* ((res (make-xml-header))
+ (i (make-rod-xstream content)))
+ (with-zstream (z :input-stack (list i))
+ (let ((atts (read-attribute-list z i t)))
+ (unless (eq (peek-rune i) :eof)
+ (wf-error i "Garbage at end of TextDecl"))
+ ;; versioninfo optional
+ ;; encodingdecl muss da sein
+ ;; dann ende
+ (when (eq (caar atts) (intern-name '#.(string-rod "version")))
+ (unless (and (>= (length (cdar atts)) 1)
+ (every (lambda (x)
+ (or (rune<= #/a x #/z)
+ (rune<= #/A x #/Z)
+ (rune<= #/0 x #/9)
+ (rune= x #/_)
+ (rune= x #/.)
+ (rune= x #/:)
+ (rune= x #/-)))
+ (cdar atts)))
+ (wf-error i "Bad XML version number: ~S." (rod-string (cdar atts))))
+ (setf (xml-header-version res) (rod-string (cdar atts)))
+ (pop atts))
+ (unless (eq (caar atts) (intern-name '#.(string-rod "encoding")))
+ (wf-error i "TextDecl needs encoding."))
+ (unless (and (>= (length (cdar atts)) 1)
+ (every (lambda (x)
+ (or (rune<= #/a x #/z)
+ (rune<= #/A x #/Z)
+ (rune<= #/0 x #/9)
+ (rune= x #/_)
+ (rune= x #/.)
+ (rune= x #/-)))
+ (cdar atts))
+ ((lambda (x)
+ (or (rune<= #/a x #/z)
+ (rune<= #/A x #/Z)
+ (rune<= #/0 x #/9)))
+ (aref (cdar atts) 0)))
+ (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts))))
+ (setf (xml-header-encoding res) (rod-string (cdar atts)))
+ (pop atts)
+ (when atts
+ (wf-error i "Garbage in TextDecl: ~A" (rod-string content)))))
+ res))
+
+;;;; ---------------------------------------------------------------------------
+;;;; mu
+;;;;
+
+(defun mu (x)
+ (cond ((stringp x) x)
+ ((vectorp x) (rod-string x))
+ ((consp x)
+ (cons (mu (car x)) (mu (cdr x))))
+ (x)))
+
+;;;; ---------------------------------------------------------------------------
+;;;; User interface ;;;;
+
+#-cxml-system::uri-is-namestring
+(defun specific-or (component &optional (alternative nil))
+ (if (eq component :unspecific)
+ alternative
+ component))
+
+(defun string-or (str &optional (alternative nil))
+ (if (zerop (length str))
+ alternative
+ str))
+
+#-cxml-system::uri-is-namestring
+(defun make-uri (&rest initargs &key path query &allow-other-keys)
+ (apply #'make-instance
+ 'puri:uri
+ :path (and path (escape-path path))
+ :query (and query (escape-query query))
+ initargs))
+
+#-cxml-system::uri-is-namestring
+(defun escape-path (list)
+ (puri::render-parsed-path list t))
+
+#-cxml-system::uri-is-namestring
+(defun escape-query (pairs)
+ (flet ((escape (str)
+ (puri::encode-escaped-encoding str puri::*reserved-characters* t)))
+ (let ((first t))
+ (with-output-to-string (s)
+ (dolist (pair pairs)
+ (if first
+ (setf first nil)
+ (write-char #\& s))
+ (write-string (escape (car pair)) s)
+ (write-char #\= s)
+ (write-string (escape (cdr pair)) s))))))
+
+#-cxml-system::uri-is-namestring
+(defun uri-parsed-query (uri)
+ (flet ((unescape (str)
+ (puri::decode-escaped-encoding str t puri::*reserved-characters*)))
+ (let ((str (puri:uri-query uri)))
+ (cond
+ (str
+ (let ((pairs '()))
+ (dolist (s (split-sequence-if (lambda (x) (eql x #\&)) str))
+ (destructuring-bind (name value)
+ (split-sequence-if (lambda (x) (eql x #\=)) s)
+ (push (cons (unescape name) (unescape value)) pairs)))
+ (reverse pairs)))
+ (t
+ nil)))))
+
+#-cxml-system::uri-is-namestring
+(defun query-value (name alist)
+ (cdr (assoc name alist :test #'equal)))
+
+#-cxml-system::uri-is-namestring
+(defun pathname-to-uri (pathname)
+ (let ((path
+ (append (pathname-directory pathname)
+ (list
+ (if (specific-or (pathname-type pathname))
+ (concatenate 'string
+ (pathname-name pathname)
+ "."
+ (pathname-type pathname))
+ (pathname-name pathname))))))
+ (if (eq (car path) :relative)
+ (make-uri :path path)
+ (make-uri :scheme :file
+ :host (concatenate 'string
+ (string-or (host-namestring pathname))
+ "+"
+ (specific-or (pathname-device pathname)))
+ :path path))))
+
+#+cxml-system::uri-is-namestring
+(defun pathname-to-uri (pathname)
+ (puri:parse-uri (namestring pathname)))
+
+#-cxml-system::uri-is-namestring
+(defun parse-name.type (str)
+ (if str
+ (let ((i (position #\. str :from-end t)))
+ (if i
+ (values (subseq str 0 i) (subseq str (1+ i)))
+ (values str nil)))
+ (values nil nil)))
+
+#-cxml-system::uri-is-namestring
+(defun uri-to-pathname (uri)
+ (let ((scheme (puri:uri-scheme uri))
+ (path (puri:uri-parsed-path uri)))
+ (unless (member scheme '(nil :file))
+ (error 'xml-parse-error
+ :format-control "URI scheme ~S not supported"
+ :format-arguments (list scheme)))
+ (if (eq (car path) :relative)
+ (multiple-value-bind (name type)
+ (parse-name.type (car (last path)))
+ (make-pathname :directory (butlast path)
+ :name name
+ :type type))
+ (multiple-value-bind (name type)
+ (parse-name.type (car (last (cdr path))))
+ (destructuring-bind (host device)
+ (split-sequence-if (lambda (x) (eql x #\+))
+ (or (puri:uri-host uri) "+"))
+ (make-pathname :host (string-or host)
+ :device (string-or device)
+ :directory (cons :absolute (butlast (cdr path)))
+ :name name
+ :type type))))))
+#+cxml-system::uri-is-namestring
+(defun uri-to-pathname (uri)
+ (let ((pathname (puri:render-uri uri nil)))
+ (when (equalp (pathname-host pathname) "+")
+ (setf (slot-value pathname 'lisp::host) "localhost"))
+ pathname))
+
+(defun parse
+ (input handler &rest args
+ &key validate dtd root entity-resolver disallow-internal-subset
+ recode pathname)
+ (declare (ignore validate dtd root entity-resolver disallow-internal-subset
+ recode))
+ (let ((args
+ (loop
+ for (name value) on args by #'cddr
+ unless (eq name :pathname)
+ append (list name value))))
+ (etypecase input
+ (xstream (apply #'make-xstream input handler args))
+ (pathname (apply #'parse-file input handler args))
+ (rod (apply #'parse-rod input handler args))
+ (array (apply #'parse-octets input handler args))
+ (stream
+ (let ((xstream (make-xstream input :speed 8192)))
+ (setf (xstream-name xstream)
+ (make-stream-name
+ :entity-name "main document"
+ :entity-kind :main
+ :uri (pathname-to-uri
+ (merge-pathnames (or pathname (pathname input))))))
+ (apply #'parse-xstream xstream handler args))))))
+
+(defun parse-xstream (xstream handler &rest args)
+ (let ((*ctx* nil))
+ (handler-case
+ (with-zstream (zstream :input-stack (list xstream))
+ (peek-rune xstream)
+ (with-scratch-pads ()
+ (apply #'p/document zstream handler args)))
+ (runes-encoding:encoding-error (c)
+ (wf-error xstream "~A" c)))))
+
+(defun parse-file (filename handler &rest args)
+ (with-open-xfile (input filename)
+ (setf (xstream-name input)
+ (make-stream-name
+ :entity-name "main document"
+ :entity-kind :main
+ :uri (pathname-to-uri (merge-pathnames filename))))
+ (apply #'parse-xstream input handler args)))
+
+(defun resolve-synonym-stream (stream)
+ (while (typep stream 'synonym-stream)
+ (setf stream (symbol-value (synonym-stream-symbol stream))))
+ stream)
+
+(defun safe-stream-sysid (stream)
+ (if (and (typep (resolve-synonym-stream stream) 'file-stream)
+ ;; ignore-errors, because sb-bsd-sockets creates instances of
+ ;; FILE-STREAMs that aren't
+ (ignore-errors (pathname stream)))
+ (pathname-to-uri (merge-pathnames (pathname stream)))
+ nil))
+
+(defun parse-stream (stream handler &rest args)
+ (let ((xstream
+ (make-xstream
+ stream
+ :name (make-stream-name
+ :entity-name "main document"
+ :entity-kind :main
+ :uri (safe-stream-sysid stream))
+ :initial-speed 1)))
+ (apply #'parse-xstream xstream handler args)))
+
+(defun parse-empty-document
+ (uri qname handler &key public-id system-id entity-resolver (recode t))
+ (check-type uri (or null rod))
+ (check-type qname (or null rod))
+ (check-type public-id (or null rod))
+ (check-type system-id (or null puri:uri))
+ (check-type entity-resolver (or null function symbol))
+ (check-type recode boolean)
+ #+rune-is-integer
+ (when recode
+ (setf handler (make-recoder handler #'rod-to-utf8-string)))
+ (let ((*ctx*
+ (make-context :handler handler :entity-resolver entity-resolver))
+ (*validate* nil)
+ (extid
+ (when (or public-id system-id)
+ (extid-using-catalog (make-extid public-id system-id)))))
+ (sax:start-document handler)
+ (when extid
+ (sax:start-dtd handler
+ qname
+ (and public-id)
+ (and system-id (uri-rod system-id)))
+ (setf (dtd *ctx*) (getdtd (extid-system extid) *dtd-cache*))
+ (unless (dtd *ctx*)
+ (with-scratch-pads ()
+ (let ((*data-behaviour* :DTD))
+ (let ((xi2 (xstream-open-extid extid)))
+ (with-zstream (zi2 :input-stack (list xi2))
+ (ensure-dtd)
+ (p/ext-subset zi2))))))
+ (sax:end-dtd handler)
+ (let ((dtd (dtd *ctx*)))
+ (sax:entity-resolver handler (lambda (n h) (resolve-entity n h dtd)))
+ (sax::dtd handler dtd)))
+ (ensure-dtd)
+ (when (or uri qname)
+ (let* ((attrs
+ (when uri
+ (list (sax:make-attribute :qname #"xmlns"
+ :value (rod uri)
+ :specified-p t))))
+ (*namespace-bindings* *namespace-bindings*)
+ new-namespaces)
+ (when sax:*namespace-processing*
+ (setf new-namespaces (declare-namespaces attrs))
+ (mapc #'set-attribute-namespace attrs))
+ (multiple-value-bind (uri prefix local-name)
+ (if sax:*namespace-processing* (decode-qname qname) nil)
+ (declare (ignore prefix))
+ (unless (or sax:*include-xmlns-attributes*
+ (null sax:*namespace-processing*))
+ (setf attrs nil))
+ (sax:start-element (handler *ctx*) uri local-name qname attrs)
+ (sax:end-element (handler *ctx*) uri local-name qname))
+ (undeclare-namespaces new-namespaces)))
+ (sax:end-document handler)))
+
+(defun parse-dtd-file (filename &optional handler)
+ (with-open-file (s filename :element-type '(unsigned-byte 8))
+ (parse-dtd-stream s handler)))
+
+(defun parse-dtd-stream (stream &optional handler)
+ (let ((input (make-xstream stream)))
+ (setf (xstream-name input)
+ (make-stream-name
+ :entity-name "dtd"
+ :entity-kind :main
+ :uri (safe-stream-sysid stream)))
+ (let ((*ctx* (make-context :handler handler))
+ (*validate* t)
+ (*data-behaviour* :DTD))
+ (with-zstream (zstream :input-stack (list input))
+ (with-scratch-pads ()
+ (ensure-dtd)
+ (peek-rune input)
+ (p/ext-subset zstream)
+ (dtd *ctx*))))))
+
+(defun parse-rod (string handler &rest args)
+ (let ((xstream (string->xstream string)))
+ (setf (xstream-name xstream)
+ (make-stream-name
+ :entity-name "main document"
+ :entity-kind :main
+ :uri nil))
+ (apply #'parse-xstream xstream handler args)))
+
+(defun string->xstream (string)
+ (make-rod-xstream (string-rod string)))
+
+(defun parse-octets (octets handler &rest args)
+ (apply #'parse-stream (make-octet-input-stream octets) handler args))
+
+;;;;
+
+(defun zstream-push (new-xstream zstream)
+ (cond ((find-if (lambda (x)
+ (and (xstream-p x)
+ (eql (stream-name-entity-name (xstream-name x))
+ (stream-name-entity-name (xstream-name new-xstream)))
+ (eql (stream-name-entity-kind (xstream-name x))
+ (stream-name-entity-kind (xstream-name new-xstream)))))
+ (zstream-input-stack zstream))
+ (wf-error zstream "Infinite recursion.")))
+ (push new-xstream (zstream-input-stack zstream))
+ zstream)
+
+(defun recurse-on-entity (zstream name kind continuation &optional internalp)
+ (assert (not (zstream-token-category zstream)))
+ (call-with-entity-expansion-as-stream
+ zstream
+ (lambda (new-xstream)
+ (push :stop (zstream-input-stack zstream))
+ (zstream-push new-xstream zstream)
+ (prog1
+ (funcall continuation zstream)
+ (assert (eq (peek-token zstream) :eof))
+ (assert (eq (pop (zstream-input-stack zstream)) new-xstream))
+ (close-xstream new-xstream)
+ (assert (eq (pop (zstream-input-stack zstream)) :stop))
+ (setf (zstream-token-category zstream) nil)
+ '(consume-token zstream)) )
+ name
+ kind
+ internalp))
+
+#||
+(defmacro read-data-until* ((predicate input res res-start res-end) &body body)
+ ;; fast variant -- for now disabled for no apparent reason
+ ;; -> res, res-start, res-end
+ `(let* ((rptr (xstream-read-ptr ,input))
+ (p0 rptr)
+ (fptr (xstream-fill-ptr ,input))
+ (buf (xstream-buffer ,input))
+ ,res ,res-start ,res-end)
+ (declare (type fixnum rptr fptr p0)
+ (type (simple-array read-element (*)) buf))
+ (loop
+ (cond ((%= rptr fptr)
+ ;; underflow -- hmm inject the scratch-pad with what we
+ ;; read and continue, while using read-rune and collecting
+ ;; d.h. besser waere hier auch while-reading zu benutzen.
+ (setf (xstream-read-ptr ,input) rptr)
+ (multiple-value-setq (,res ,res-start ,res-end)
+ (with-rune-collector/raw (collect)
+ (do ((i p0 (%+ i 1)))
+ ((%= i rptr))
+ (collect (%rune buf i)))
+ (let (c)
+ (loop
+ (cond ((%= rptr fptr)
+ (setf (xstream-read-ptr ,input) rptr)
+ (setf c (peek-rune input))
+ (cond ((eq c :eof)
+ (return)))
+ (setf rptr (xstream-read-ptr ,input)
+ fptr (xstream-fill-ptr ,input)
+ buf (xstream-buffer ,input)))
+ (t
+ (setf c (%rune buf rptr))))
+ (cond ((,predicate c)
+ ;; we stop
+ (setf (xstream-read-ptr ,input) rptr)
+ (return))
+ (t
+ ;; we continue
+ (collect c)
+ (setf rptr (%+ rptr 1))) )))))
+ (return))
+ ((,predicate (%rune buf rptr))
+ ;; we stop
+ (setf (xstream-read-ptr ,input) rptr)
+ (setf ,res buf ,res-start p0 ,res-end rptr)
+ (return) )
+ (t
+ we continue
+ (sf rptr (%+ rptr 1))) ))
+ ,@body ))
+||#
+
+(defmacro read-data-until* ((predicate input res res-start res-end) &body body)
+ "Read data from `input' until `predicate' applied to the read char
+ turns true. Then execute `body' with `res', `res-start', `res-end'
+ bound to denote a subsequence (of RUNEs) containing the read portion.
+ The rune upon which `predicate' turned true is neither consumed from
+ the stream, nor included in `res'.
+
+ Keep the predicate short, this it may be included more than once into
+ the macro's expansion."
+ ;;
+ (let ((input-var (gensym))
+ (collect (gensym))
+ (c (gensym)))
+ `(LET ((,input-var ,input))
+ (MULTIPLE-VALUE-BIND (,res ,res-start ,res-end)
+ (WITH-RUNE-COLLECTOR/RAW (,collect)
+ (LOOP
+ (LET ((,c (PEEK-RUNE ,input-var)))
+ (COND ((EQ ,c :EOF)
+ ;; xxx error message
+ (RETURN))
+ ((FUNCALL ,predicate ,c)
+ (RETURN))
+ (t
+ (,collect ,c)
+ (CONSUME-RUNE ,input-var))))))
+ (LOCALLY
+ ,@body)))))
+
+(defun read-name-token (input)
+ (read-data-until* ((lambda (rune)
+ (declare (type rune rune))
+ (not (name-rune-p rune)))
+ input
+ r rs re)
+ (intern-name r rs re)))
+
+(defun read-cdata (input)
+ (read-data-until* ((lambda (rune)
+ (declare (type rune rune))
+ (when (and (%rune< rune #/U+0020)
+ (not (or (%rune= rune #/U+0009)
+ (%rune= rune #/U+000a)
+ (%rune= rune #/U+000d))))
+ (wf-error input "code point invalid: ~A" rune))
+ (or (%rune= rune #/<) (%rune= rune #/&)))
+ input
+ source start end)
+ (locally
+ (declare (type (simple-array rune (*)) source)
+ (type ufixnum start)
+ (type ufixnum end)
+ (optimize (speed 3) (safety 0)))
+ (let ((res (make-array (%- end start) :element-type 'rune)))
+ (declare (type (simple-array rune (*)) res))
+ (let ((i (%- end start)))
+ (declare (type ufixnum i))
+ (loop
+ (setf i (- i 1))
+ (setf (%rune res i) (%rune source (the ufixnum (+ i start))))
+ (when (= i 0)
+ (return))))
+ res))))
+
+;; used only by read-att-value-2
+(defun internal-entity-expansion (name)
+ (let ((def (get-entity-definition name :general (dtd *ctx*))))
+ (unless def
+ (wf-error nil "Entity '~A' is not defined." (rod-string name)))
+ (unless (typep def 'internal-entdef)
+ (wf-error nil "Entity '~A' is not an internal entity." name))
+ (or (entdef-expansion def)
+ (setf (entdef-expansion def) (find-internal-entity-expansion name)))))
+
+;; used only by read-att-value-2
+(defun find-internal-entity-expansion (name)
+ (with-zstream (zinput)
+ (with-rune-collector-3 (collect)
+ (labels ((muffle (input)
+ (let (c)
+ (loop
+ (setf c (read-rune input))
+ (cond ((eq c :eof)
+ (return))
+ ((rune= c #/&)
+ (setf c (peek-rune input))
+ (cond ((eql c :eof)
+ (eox input))
+ ((rune= c #/#)
+ (let ((c (read-character-reference input)))
+ (%put-unicode-char c collect)))
+ (t
+ (unless (name-start-rune-p c)
+ (wf-error zinput "Expecting name after &."))
+ (let ((name (read-name-token input)))
+ (setf c (read-rune input))
+ (check-rune input c #/\;)
+ (recurse-on-entity
+ zinput name :general
+ (lambda (zinput)
+ (muffle (car (zstream-input-stack zinput)))))))))
+ ((rune= c #/<)
+ (wf-error zinput "unexpected #\/<"))
+ ((space-rune-p c)
+ (collect #/space))
+ ((not (data-rune-p c))
+ (wf-error zinput "illegal char: ~S." c))
+ (t
+ (collect c)))))))
+ (declare (dynamic-extent #'muffle))
+ (recurse-on-entity
+ zinput name :general
+ (lambda (zinput)
+ (muffle (car (zstream-input-stack zinput)))))))))
+
+;; callback for DOM
+(defun resolve-entity (name handler dtd)
+ (let ((*validate* nil))
+ (if (get-entity-definition name :general dtd)
+ (let* ((*ctx* (make-context :handler handler :dtd dtd))
+ (*data-behaviour* :DOC))
+ (with-zstream (input)
+ (with-scratch-pads ()
+ (recurse-on-entity
+ input name :general
+ (lambda (input)
+ (prog1
+ (etypecase (checked-get-entdef name :general)
+ (internal-entdef (p/content input))
+ (external-entdef (p/ext-parsed-ent input)))
+ (unless (eq (peek-token input) :eof)
+ (wf-error input "Trailing garbage. - ~S"
+ (peek-token input)))))))))
+ nil)))
+
+(defun read-att-value-2 (input)
+ (let ((delim (read-rune input)))
+ (when (eql delim :eof)
+ (eox input))
+ (unless (member delim '(#/\" #/\') :test #'eql)
+ (wf-error input
+ "Bad attribute value delimiter ~S, must be either #\\\" or #\\\'."
+ (rune-char delim)))
+ (with-rune-collector-4 (collect)
+ (loop
+ (let ((c (read-rune input)))
+ (cond ((eq c :eof)
+ (eox input "EOF"))
+ ((rune= c delim)
+ (return))
+ ((rune= c #/<)
+ (wf-error input "'<' not allowed in attribute values"))
+ ((rune= #/& c)
+ (multiple-value-bind (kind sem) (read-entity-like input)
+ (ecase kind
+ (:CHARACTER-REFERENCE
+ (%put-unicode-char sem collect))
+ (:ENTITY-REFERENCE
+ (let* ((exp (internal-entity-expansion sem))
+ (n (length exp)))
+ (declare (type (simple-array rune (*)) exp))
+ (do ((i 0 (%+ i 1)))
+ ((%= i n))
+ (collect (%rune exp i))))))))
+ ((space-rune-p c)
+ (collect #/u+0020))
+ (t
+ (collect c))))))))
+
+;;;;;;;;;;;;;;;;;
+
+;;; Namespace stuff
+
+;; We already know that name is part of a valid XML name, so all we
+;; have to check is that the first rune is a name-start-rune and that
+;; there is not colon in it.
+(defun nc-name-p (name)
+ (and (plusp (length name))
+ (name-start-rune-p (rune name 0))
+ (notany #'(lambda (rune) (rune= #/: rune)) name)))
+
+(defun split-qname (qname)
+ (declare (type runes:simple-rod qname))
+ (let ((pos (position #/: qname)))
+ (if pos
+ (let ((prefix (subseq qname 0 pos))
+ (local-name (subseq qname (1+ pos))))
+ (when (zerop pos)
+ (wf-error nil "empty namespace prefix"))
+ (if (nc-name-p local-name)
+ (values prefix local-name)
+ (wf-error nil "~S is not a valid NcName."
+ (rod-string local-name))))
+ (values () qname))))
+
+(defun decode-qname (qname)
+ "decode-qname name => namespace-uri, prefix, local-name"
+ (declare (type runes:simple-rod qname))
+ (multiple-value-bind (prefix local-name) (split-qname qname)
+ (let ((uri (find-namespace-binding prefix)))
+ (if uri
+ (values uri prefix local-name)
+ (values nil nil qname)))))
+
+
+(defun find-namespace-binding (prefix)
+ (cdr (or (assoc (or prefix #"") *namespace-bindings* :test #'rod=)
+ (wf-error nil "Undeclared namespace prefix: ~A" (rod-string prefix)))))
+
+;; FIXME: Should probably be refactored by adding :start and :end to rod=/rod-equal
+(defun rod-starts-with (prefix rod)
+ (and (<= (length prefix) (length rod))
+ (dotimes (i (length prefix) t)
+ (unless (rune= (rune prefix i) (rune rod i))
+ (return nil)))))
+
+(defun xmlns-attr-p (attr-name)
+ (rod-starts-with #.(string-rod "xmlns") attr-name))
+
+(defun attrname->prefix (attrname)
+ (if (< 5 (length attrname))
+ (subseq attrname 6)
+ nil))
+
+(defun find-namespace-declarations (attributes)
+ (loop
+ for attribute in attributes
+ for qname = (sax:attribute-qname attribute)
+ when (xmlns-attr-p qname)
+ collect (cons (attrname->prefix qname) (sax:attribute-value attribute))))
+
+(defun declare-namespaces (attributes)
+ (let ((ns-decls (find-namespace-declarations attributes)))
+ (dolist (ns-decl ns-decls)
+ ;; check some namespace validity constraints
+ (let ((prefix (car ns-decl))
+ (uri (cdr ns-decl)))
+ (cond
+ ((and (rod= prefix #"xml")
+ (not (rod= uri #"http://www.w3.org/XML/1998/namespace")))
+ (wf-error nil
+ "Attempt to rebind the prefix \"xml\" to ~S." (mu uri)))
+ ((and (rod= uri #"http://www.w3.org/XML/1998/namespace")
+ (not (rod= prefix #"xml")))
+ (wf-error nil
+ "The namespace ~
+ URI \"http://www.w3.org/XML/1998/namespace\" may not ~
+ be bound to the prefix ~S, only \"xml\" is legal."
+ (mu prefix)))
+ ((and (rod= prefix #"xmlns")
+ (rod= uri #"http://www.w3.org/2000/xmlns/"))
+ (wf-error nil
+ "Attempt to bind the prefix \"xmlns\" to its predefined ~
+ URI \"http://www.w3.org/2000/xmlns/\", which is ~
+ forbidden for no good reason."))
+ ((rod= prefix #"xmlns")
+ (wf-error nil
+ "Attempt to bind the prefix \"xmlns\" to the URI ~S, ~
+ but it may not be declared." (mu uri)))
+ ((rod= uri #"http://www.w3.org/2000/xmlns/")
+ (wf-error nil
+ "The namespace URI \"http://www.w3.org/2000/xmlns/\" may ~
+ not be bound to prefix ~S (or any other)." (mu prefix)))
+ ((and (rod= uri #"") prefix)
+ (wf-error nil
+ "Only the default namespace (the one without a prefix) ~
+ may be bound to an empty namespace URI, thus ~
+ undeclaring it."))
+ (t
+ (push (cons prefix (if (rod= #"" uri) nil uri))
+ *namespace-bindings*)
+ (sax:start-prefix-mapping (handler *ctx*)
+ (car ns-decl)
+ (cdr ns-decl))))))
+ ns-decls))
+
+(defun undeclare-namespaces (ns-decls)
+ (dolist (ns-decl ns-decls)
+ (sax:end-prefix-mapping (handler *ctx*) (car ns-decl))))
+
+(defun build-attribute-list (attr-alist)
+ ;; fixme: if there is a reason this function reverses attribute order,
+ ;; it should be documented.
+ (let (attributes)
+ (dolist (pair attr-alist)
+ (push (sax:make-attribute :qname (car pair)
+ :value (cdr pair)
+ :specified-p t)
+ attributes))
+ attributes))
+
+(defun check-attribute-uniqueness (attributes)
+ ;; 5.3 Uniqueness of Attributes
+ ;; In XML documents conforming to [the xmlns] specification, no
+ ;; tag may contain two attributes which:
+ ;; 1. have identical names, or
+ ;; 2. have qualified names with the same local part and with
+ ;; prefixes which have been bound to namespace names that are
+ ;; identical.
+ ;;
+ ;; 1. is checked by read-tag-2, so we only deal with 2 here
+ (loop for (attr-1 . rest) on attributes do
+ (when (and (sax:attribute-namespace-uri attr-1)
+ (find-if (lambda (attr-2)
+ (and (rod= (sax:attribute-namespace-uri attr-1)
+ (sax:attribute-namespace-uri attr-2))
+ (rod= (sax:attribute-local-name attr-1)
+ (sax:attribute-local-name attr-2))))
+ rest))
+ (wf-error nil
+ "Multiple definitions of attribute ~S in namespace ~S."
+ (mu (sax:attribute-local-name attr-1))
+ (mu (sax:attribute-namespace-uri attr-1))))))
+
+(defun set-attribute-namespace (attribute)
+ (let ((qname (sax:attribute-qname attribute)))
+ (if (and sax:*use-xmlns-namespace* (rod= qname #"xmlns"))
+ (setf (sax:attribute-namespace-uri attribute)
+ #"http://www.w3.org/2000/xmlns/")
+ (multiple-value-bind (prefix local-name) (split-qname qname)
+ (when (and prefix ;; default namespace doesn't apply to attributes
+ (or (not (rod= #"xmlns" prefix))
+ sax:*use-xmlns-namespace*))
+ (setf (sax:attribute-namespace-uri attribute)
+ (decode-qname qname)))
+ (setf (sax:attribute-local-name attribute) local-name)))))
+
+;;;;;;;;;;;;;;;;;
+
+;; System Identifier Protocol
+
+;; A system identifier is an object obeying to the system identifier
+;; protocol. Often something like an URL or a pathname.
+
+;; OPEN-SYS-ID sys-id [generic function]
+;;
+;; Opens the resource associated with the system identifier `sys-id'
+;; for reading and returns a stream. For now it is expected, that the
+;; stream is an octet stream (one of element type (unsigned-byte 8)).
+;;
+;; More precisely: The returned object only has to obey to the xstream
+;; controller protocol. (That is it has to provide implementations for
+;; READ-OCTETS and XSTREAM-CONTROLLER-CLOSE).
+
+;; MERGE-SYS-ID sys-id base [generic function]
+;;
+;; Merges two system identifiers. That is resolve `sys-id' relative to
+;; `base' yielding an absolute system identifier suitable for
+;; OPEN-SYS-ID.
+
+
+;;;;;;;;;;;;;;;;;
+;;; SAX validation handler
+
+(defclass validator ()
+ ((context :initarg :context :accessor context)
+ (cdatap :initform nil :accessor cdatap)))
+
+(defun make-validator (dtd root)
+ (make-instance 'validator
+ :context (make-context
+ :handler nil
+ :dtd dtd
+ :model-stack (list (make-root-model root)))))
+
+(macrolet ((with-context ((validator) &body body)
+ `(let ((*ctx* (context ,validator))
+ (*validate* t))
+ (with-scratch-pads () ;nicht schoen
+ ,@body))))
+ (defmethod sax:start-element ((handler validator) uri lname qname attributes)
+ uri lname
+ (with-context (handler)
+ (validate-start-element *ctx* qname)
+ (process-attributes *ctx* qname attributes)))
+
+ (defmethod sax:start-cdata ((handler validator))
+ (setf (cdatap handler) t))
+
+ (defmethod sax:characters ((handler validator) data)
+ (with-context (handler)
+ (validate-characters *ctx* (if (cdatap handler) #"hack" data))))
+
+ (defmethod sax:end-cdata ((handler validator))
+ (setf (cdatap handler) nil))
+
+ (defmethod sax:end-element ((handler validator) uri lname qname)
+ uri lname
+ (with-context (handler)
+ (validate-end-element *ctx* qname))))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmlns-normalizer.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmlns-normalizer.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmlns-normalizer.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,136 @@
+;;;; xmlns-normalizer.lisp -- DOM 3-style namespace normalization
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Copyright (c) 2005 David Lichteblau
+
+;;;; Hier eine Variante des reichlich furchtbaren Algorithmus zur
+;;;; Namespace-Normalisierung aus DOM 3 Core.[1]
+;;;;
+;;;; Gebraucht wir die Sache, weil Element- und Attributknoten in DOM
+;;;; zwar ein Prefix-Attribut speichern, massgeblich fuer ihren Namespace
+;;;; aber nur die URI sein soll. Und eine Anpassung der zugehoerigen
+;;;; xmlns-Attribute findet bei Veraenderungen im DOM-Baum nicht statt,
+;;;; bzw. wird dem Nutzer ueberlassen.
+;;;;
+;;;; Daher muss letztlich spaetestens beim Serialisieren eine
+;;;; Namespace-Deklaration fuer die angegebene URI nachgetragen und das
+;;;; Praefix ggf. umbenannt werden, damit am Ende doch etwas
+;;;; Namespace-konformes heraus kommt.
+;;;;
+;;;; Und das nennen sie dann Namespace-Support.
+;;;;
+;;;; [1] http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/namespaces-algorith…
+
+(in-package :cxml)
+
+(defclass namespace-normalizer (sax-proxy)
+ ((xmlns-stack :initarg :xmlns-stack :accessor xmlns-stack)))
+
+(defvar *xmlns-namespace* #"http://www.w3.org/2000/xmlns/")
+
+(defun make-namespace-normalizer (chained-handler)
+ (make-instance 'namespace-normalizer
+ :xmlns-stack (list (mapcar (lambda (cons)
+ (make-xmlns-attribute (car cons) (cdr cons)))
+ *initial-namespace-bindings*))
+ :chained-handler chained-handler))
+
+(defun normalizer-find-prefix (handler prefix)
+ (when (zerop (length prefix))
+ (setf prefix #"xmlns"))
+ (block t
+ (dolist (bindings (xmlns-stack handler))
+ (dolist (attribute bindings)
+ (when (rod= (sax:attribute-local-name attribute) prefix)
+ (return-from t attribute))))))
+
+(defun normalizer-find-uri (handler uri)
+ (block t
+ (dolist (bindings (xmlns-stack handler))
+ (dolist (attribute bindings)
+ (when (and (rod= (sax:attribute-value attribute) uri)
+ ;; default-namespace interessiert uns nicht
+ (not (rod= (sax:attribute-qname attribute) #"xmlns")))
+ (return-from t attribute))))))
+
+(defun make-xmlns-attribute (prefix uri)
+ (if (and (plusp (length prefix)) (not (equal prefix #"xmlns")))
+ (sax:make-attribute
+ :qname (concatenate 'rod #"xmlns:" prefix)
+ :namespace-uri *xmlns-namespace*
+ :local-name prefix
+ :value uri)
+ (sax:make-attribute
+ :qname #"xmlns"
+ :namespace-uri *xmlns-namespace*
+ :local-name #"xmlns"
+ :value uri)))
+
+(defun rename-attribute (a new-prefix)
+ (setf (sax:attribute-qname a)
+ (concatenate 'rod new-prefix #":" (sax:attribute-local-name a))))
+
+(defmethod sax:start-element
+ ((handler namespace-normalizer) uri lname qname attrs)
+ (when (null uri)
+ (setf uri #""))
+ (let ((normal-attrs '()))
+ (push nil (xmlns-stack handler))
+ (dolist (a attrs)
+ (if (rod= *xmlns-namespace* (sax:attribute-namespace-uri a))
+ (push a (car (xmlns-stack handler)))
+ (push a normal-attrs)))
+ (flet ((push-namespace (prefix uri)
+ (let ((new (make-xmlns-attribute prefix uri)))
+ (unless (find (sax:attribute-qname new)
+ attrs
+ :test #'rod=
+ :key #'sax:attribute-qname)
+ (push new (car (xmlns-stack handler)))
+ (push new attrs)))))
+ (multiple-value-bind (prefix local-name) (split-qname qname)
+ (setf lname local-name)
+ (let ((binding (normalizer-find-prefix handler prefix)))
+ (cond
+ ((null binding)
+ (unless (and (null prefix) (zerop (length uri)))
+ (push-namespace prefix uri)))
+ ((rod= (sax:attribute-value binding) uri))
+ ((member binding (car (xmlns-stack handler)))
+ (setf (sax:attribute-value binding) uri))
+ (t
+ (push-namespace prefix uri)))))
+ (dolist (a normal-attrs)
+ (let ((u (sax:attribute-namespace-uri a)))
+ (when u
+ (let* ((prefix (split-qname (sax:attribute-qname a)))
+ (prefix-binding
+ (when prefix
+ (normalizer-find-prefix handler prefix))))
+ (when (or (null prefix-binding)
+ (not (rod= (sax:attribute-value prefix-binding) u)))
+ (let ((uri-binding (normalizer-find-uri handler u)))
+ (cond
+ (uri-binding
+ (rename-attribute
+ a
+ (sax:attribute-local-name uri-binding)))
+ ((and prefix (null prefix-binding))
+ (push-namespace prefix u))
+ (t
+ (loop
+ for i from 1
+ for prefix = (rod (format nil "NS~D" i))
+ unless (normalizer-find-prefix handler prefix)
+ do
+ (push-namespace prefix u)
+ (rename-attribute a prefix)
+ (return))))))))))))
+ (sax:start-element (proxy-chained-handler handler) uri lname qname attrs))
+
+(defmethod sax:end-element ((handler namespace-normalizer) uri lname qname)
+ (declare (ignore qname))
+ (pop (xmlns-stack handler))
+ (sax:end-element (proxy-chained-handler handler) (or uri #"") lname qname))
Added: branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmls-compat.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmls-compat.lisp 2007-10-04 19:02:16 UTC (rev 2202)
+++ branches/trunk-reorg/thirdparty/cxml-2007-08-05/xml/xmls-compat.lisp 2007-10-04 19:03:03 UTC (rev 2203)
@@ -0,0 +1,243 @@
+;;;; xml-compat.lisp -- XMLS-compatible data structures
+;;;;
+;;;; This file is part of the CXML parser, released under Lisp-LGPL.
+;;;; See file COPYING for details.
+;;;;
+;;;; Developed 2004 for headcraft - http://headcraft.de/
+;;;; Copyright: David Lichteblau
+
+(defpackage cxml-xmls
+ (:use :cl :runes)
+ (:export #:make-node #:node-name #:node-ns #:node-attrs #:node-children
+ #:make-xmls-builder #:map-node))
+
+(in-package :cxml-xmls)
+
+
+;;;; Knoten
+
+(defun make-node (&key name ns attrs children)
+ `(,(if ns (cons name ns) name)
+ ,attrs
+ ,@children))
+
+(defun node-name (node)
+ (let ((car (car node)))
+ (if (consp car)
+ (car car)
+ car)))
+
+(defun (setf node-name) (newval node)
+ (let ((car (car node)))
+ (if (consp car)
+ (setf (car car) newval)
+ (setf (car node) newval))))
+
+(defun node-ns (node)
+ (let ((car (car node)))
+ (if (consp car)
+ (cdr car)
+ nil)))
+
+(defun (setf node-ns) (newval node)
+ (let ((car (car node)))
+ (if (consp car)
+ (setf (cdr car) newval)
+ (setf (car node) (cons car newval)))
+ newval))
+
+(defun node-attrs (node)
+ (cadr node))
+
+(defun (setf node-attrs) (newval node)
+ (setf (cadr node) newval))
+
+(defun node-children (node)
+ (cddr node))
+
+(defun (setf node-children) (newval node)
+ (setf (cddr node) newval))
+
+
+;;;; SAX-Handler (Parser)
+
+(defclass xmls-builder ()
+ ((element-stack :initform nil :accessor element-stack)
+ (root :initform nil :accessor root)
+ (include-default-values :initform t
+ :initarg :include-default-values
+ :accessor include-default-values)
+ (include-namespace-uri :initform t
+ :initarg :include-namespace-uri
+ :accessor include-namespace-uri)))
+
+(defun make-xmls-builder (&key (include-default-values t)
+ (include-namespace-uri t))
+ "Make a XMLS style builder. When 'include-namespace-uri is true a modified
+ XMLS tree is generated that includes the element namespace URI rather than
+ the qualified name prefix and also includes the namespace URI for attributes."
+ (make-instance 'xmls-builder
+ :include-default-values include-default-values
+ :include-namespace-uri include-namespace-uri))
+
+(defmethod sax:end-document ((handler xmls-builder))
+ (root handler))
+
+(defmethod sax:start-element
+ ((handler xmls-builder) namespace-uri local-name qname attributes)
+ (let* ((include-default-values (include-default-values handler))
+ (include-namespace-uri (include-namespace-uri handler))
+ (attributes
+ (loop
+ for attr in attributes
+ for attr-namespace-uri = (sax:attribute-namespace-uri attr)
+ for attr-local-name = (sax:attribute-local-name attr)
+ when (and (or (sax:attribute-specified-p attr)
+ include-default-values)
+ #+(or)
+ (or (not include-namespace-uri)
+ (not attr-namespace-uri)
+ attr-local-name))
+ collect
+ (list (cond (include-namespace-uri
+ (cond (attr-namespace-uri
+ (cons attr-local-name attr-namespace-uri))
+ (t
+ (sax:attribute-qname attr))))
+ (t
+ (sax:attribute-qname attr)))
+ (sax:attribute-value attr))))
+ (namespace (when include-namespace-uri namespace-uri))
+ (node (make-node :name local-name
+ :ns namespace
+ :attrs attributes))
+ (parent (car (element-stack handler))))
+ (if parent
+ (push node (node-children parent))
+ (setf (root handler) node))
+ (push node (element-stack handler))))
+
+(defmethod sax:end-element
+ ((handler xmls-builder) namespace-uri local-name qname)
+ (declare (ignore namespace-uri local-name qname))
+ (let ((node (pop (element-stack handler))))
+ (setf (node-children node) (reverse (node-children node)))))
+
+(defmethod sax:characters ((handler xmls-builder) data)
+ (let* ((parent (car (element-stack handler)))
+ (prev (car (node-children parent))))
+ ;; Be careful to accept both rods and strings here, so that xmls can be
+ ;; used with strings even if cxml is configured to use octet string rods.
+ (if (typep prev '(or rod string))
+ ;; um entities herum wird SAX:CHARACTERS mehrfach aufgerufen fuer
+ ;; den gleichen Textknoten. Hier muessen wir den bestehenden Knoten
+ ;; erweitern, sonst ist das Dokument nicht normalisiert.
+ ;; (XXX Oder sollte man besser den Parser entsprechend aendern?)
+ (setf (car (node-children parent))
+ (concatenate `(vector ,(array-element-type prev))
+ prev
+ data))
+ (push data (node-children parent)))))
+
+
+;;;; SAX-Treiber (fuer Serialisierung)
+
+(defun map-node
+ (handler node
+ &key (include-xmlns-attributes sax:*include-xmlns-attributes*)
+ (include-namespace-uri t))
+ (if include-namespace-uri
+ (map-node/lnames (cxml:make-namespace-normalizer handler)
+ node
+ include-xmlns-attributes)
+ (map-node/qnames handler node include-xmlns-attributes)))
+
+(defun map-node/lnames (handler node include-xmlns-attributes)
+ (sax:start-document handler)
+ (labels ((walk (node)
+ (unless (node-ns node)
+ (error "serializing with :INCLUDE-NAMESPACE-URI, but node ~
+ was created without namespace URI"))
+ (let* ((attlist
+ (compute-attributes/lnames node include-xmlns-attributes))
+ (uri (node-ns node))
+ (lname (node-name node))
+ (qname lname) ;let the normalizer fix it
+ )
+ (sax:start-element handler uri lname qname attlist)
+ (dolist (child (node-children node))
+ (typecase child
+ (list (walk child))
+ ((or string rod)
+ (sax:characters handler (string-rod child)))))
+ (sax:end-element handler uri lname qname))))
+ (walk node))
+ (sax:end-document handler))
+
+(defun map-node/qnames (handler node include-xmlns-attributes)
+ (sax:start-document handler)
+ (labels ((walk (node)
+ (when (node-ns node)
+ (error "serializing without :INCLUDE-NAMESPACE-URI, but node ~
+ was created with a namespace URI"))
+ (let* ((attlist
+ (compute-attributes/qnames node include-xmlns-attributes))
+ (qname (string-rod (node-name node)))
+ (lname (nth-value 1 (cxml::split-qname qname))))
+ (sax:start-element handler nil lname qname attlist)
+ (dolist (child (node-children node))
+ (typecase child
+ (list (walk child))
+ ((or string rod)
+ (sax:characters handler (string-rod child)))))
+ (sax:end-element handler nil lname qname))))
+ (walk node))
+ (sax:end-document handler))
+
+(defun compute-attributes/lnames (node xmlnsp)
+ (remove nil
+ (mapcar (lambda (a)
+ (destructuring-bind (name value) a
+ (unless (listp name)
+ (setf name (cons name nil)))
+ (destructuring-bind (lname &rest uri) name
+ (cond
+ ((not (equal uri "http://www.w3.org/2000/xmlns/"))
+ (sax:make-attribute
+ ;; let the normalizer fix the qname
+ :qname (if uri
+ (string-rod (concatenate 'string
+ "dummy:"
+ lname))
+ (string-rod lname))
+ :local-name (string-rod lname)
+ :namespace-uri uri
+ :value (string-rod value)
+ :specified-p t))
+ (xmlnsp
+ (sax:make-attribute
+ :qname (string-rod
+ (if lname
+ (concatenate 'string "xmlns:" lname)
+ "xmlns"))
+ :local-name (string-rod lname)
+ :namespace-uri uri
+ :value (string-rod value)
+ :specified-p t))))))
+ (node-attrs node))))
+
+(defun compute-attributes/qnames (node xmlnsp)
+ (remove nil
+ (mapcar (lambda (a)
+ (destructuring-bind (name value) a
+ (when (listp name)
+ (error "serializing without :INCLUDE-NAMESPACE-URI, ~
+ but attribute was created with a namespace ~
+ URI"))
+ (if (or xmlnsp
+ (not (cxml::xmlns-attr-p (string-rod name))))
+ (sax:make-attribute :qname (string-rod name)
+ :value (string-rod value)
+ :specified-p t)
+ nil)))
+ (node-attrs node))))
1
0
Author: hhubner
Date: 2007-10-04 15:02:16 -0400 (Thu, 04 Oct 2007)
New Revision: 2202
Removed:
branches/trunk-reorg/thirdparty/cxml/
Log:
update cxml
1
0
Author: hhubner
Date: 2007-10-04 13:27:56 -0400 (Thu, 04 Oct 2007)
New Revision: 2201
Removed:
branches/trunk-reorg/thirdparty/emacs/slime/
Log:
checkpoint
1
0
[bknr-cvs] r2200 - in branches/trunk-reorg/thirdparty: . slime slime/CVS slime/contrib slime/contrib/CVS slime/doc slime/doc/CVS
by bknrï¼ bknr.net 04 Oct '07
by bknrï¼ bknr.net 04 Oct '07
04 Oct '07
Author: hhubner
Date: 2007-10-04 13:23:45 -0400 (Thu, 04 Oct 2007)
New Revision: 2200
Added:
branches/trunk-reorg/thirdparty/slime/
branches/trunk-reorg/thirdparty/slime/.cvsignore
branches/trunk-reorg/thirdparty/slime/CVS/
branches/trunk-reorg/thirdparty/slime/CVS/Entries
branches/trunk-reorg/thirdparty/slime/CVS/Entries.Log
branches/trunk-reorg/thirdparty/slime/CVS/Repository
branches/trunk-reorg/thirdparty/slime/CVS/Root
branches/trunk-reorg/thirdparty/slime/CVS/Template
branches/trunk-reorg/thirdparty/slime/ChangeLog
branches/trunk-reorg/thirdparty/slime/HACKING
branches/trunk-reorg/thirdparty/slime/NEWS
branches/trunk-reorg/thirdparty/slime/PROBLEMS
branches/trunk-reorg/thirdparty/slime/README
branches/trunk-reorg/thirdparty/slime/contrib/
branches/trunk-reorg/thirdparty/slime/contrib/CVS/
branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries
branches/trunk-reorg/thirdparty/slime/contrib/CVS/Repository
branches/trunk-reorg/thirdparty/slime/contrib/CVS/Root
branches/trunk-reorg/thirdparty/slime/contrib/CVS/Template
branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog
branches/trunk-reorg/thirdparty/slime/contrib/README
branches/trunk-reorg/thirdparty/slime/contrib/bridge.el
branches/trunk-reorg/thirdparty/slime/contrib/inferior-slime.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-asdf.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-banner.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-c-p-c.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-highlight-edits.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-presentation-streams.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-references.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-scratch.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-tramp.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-xref-browser.el
branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp
branches/trunk-reorg/thirdparty/slime/contrib/swank-asdf.lisp
branches/trunk-reorg/thirdparty/slime/contrib/swank-c-p-c.lisp
branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp
branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp
branches/trunk-reorg/thirdparty/slime/contrib/swank-listener-hooks.lisp
branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp
branches/trunk-reorg/thirdparty/slime/contrib/swank-presentations.lisp
branches/trunk-reorg/thirdparty/slime/doc/
branches/trunk-reorg/thirdparty/slime/doc/.cvsignore
branches/trunk-reorg/thirdparty/slime/doc/CVS/
branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries
branches/trunk-reorg/thirdparty/slime/doc/CVS/Repository
branches/trunk-reorg/thirdparty/slime/doc/CVS/Root
branches/trunk-reorg/thirdparty/slime/doc/CVS/Template
branches/trunk-reorg/thirdparty/slime/doc/Makefile
branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.pdf
branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.tex
branches/trunk-reorg/thirdparty/slime/doc/slime-small.eps
branches/trunk-reorg/thirdparty/slime/doc/slime-small.pdf
branches/trunk-reorg/thirdparty/slime/doc/slime.texi
branches/trunk-reorg/thirdparty/slime/doc/texinfo-tabulate.awk
branches/trunk-reorg/thirdparty/slime/hyperspec.el
branches/trunk-reorg/thirdparty/slime/metering.lisp
branches/trunk-reorg/thirdparty/slime/mkdist.sh
branches/trunk-reorg/thirdparty/slime/nregex.lisp
branches/trunk-reorg/thirdparty/slime/sbcl-pprint-patch.lisp
branches/trunk-reorg/thirdparty/slime/slime-autoloads.el
branches/trunk-reorg/thirdparty/slime/slime.el
branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp
branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp
branches/trunk-reorg/thirdparty/slime/swank-backend.lisp
branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp
branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp
branches/trunk-reorg/thirdparty/slime/swank-corman.lisp
branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp
branches/trunk-reorg/thirdparty/slime/swank-gray.lisp
branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp
branches/trunk-reorg/thirdparty/slime/swank-loader.lisp
branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp
branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp
branches/trunk-reorg/thirdparty/slime/swank-scl.lisp
branches/trunk-reorg/thirdparty/slime/swank-source-file-cache.lisp
branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp
branches/trunk-reorg/thirdparty/slime/swank.asd
branches/trunk-reorg/thirdparty/slime/swank.lisp
branches/trunk-reorg/thirdparty/slime/test-all.sh
branches/trunk-reorg/thirdparty/slime/test.sh
branches/trunk-reorg/thirdparty/slime/xref.lisp
Log:
update slime
Added: branches/trunk-reorg/thirdparty/slime/.cvsignore
===================================================================
--- branches/trunk-reorg/thirdparty/slime/.cvsignore 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/.cvsignore 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,6 @@
+*.x86f
+*.fasl
+*.dfsl
+*.lx64fsl
+*.elc
+_darcs
Added: branches/trunk-reorg/thirdparty/slime/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/slime/CVS/Entries 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/CVS/Entries 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,34 @@
+/.cvsignore/1.5/Sun Apr 8 19:23:57 2007//
+/ChangeLog/1.1234/Thu Sep 27 12:56:13 2007//
+/HACKING/1.8/Wed Sep 19 11:08:27 2007//
+/NEWS/1.8/Sun Mar 27 19:41:17 2005//
+/PROBLEMS/1.8/Sun Nov 20 23:31:56 2005//
+/README/1.14/Tue Oct 3 21:49:13 2006//
+/hyperspec.el/1.11/Thu Dec 7 07:36:54 2006//
+/metering.lisp/1.4/Fri Apr 1 20:16:35 2005//
+/mkdist.sh/1.7/Mon Aug 29 20:02:58 2005//
+/nregex.lisp/1.4/Mon Sep 19 08:20:48 2005//
+/sbcl-pprint-patch.lisp/1.1/Fri Feb 17 01:30:21 2006//
+/slime-autoloads.el/1.3/Thu Sep 20 14:59:08 2007//
+/slime.el/1.875/Thu Sep 27 12:56:40 2007//
+/swank-abcl.lisp/1.43/Tue Sep 4 15:45:19 2007//
+/swank-allegro.lisp/1.98/Wed Sep 26 23:15:41 2007//
+/swank-backend.lisp/1.126/Mon Sep 10 15:39:05 2007//
+/swank-clisp.lisp/1.64/Thu Aug 23 19:03:37 2007//
+/swank-cmucl.lisp/1.174/Wed Sep 5 12:04:43 2007//
+/swank-corman.lisp/1.11/Thu Aug 23 19:03:37 2007//
+/swank-ecl.lisp/1.8/Thu May 17 11:49:40 2007//
+/swank-gray.lisp/1.10/Wed Apr 12 08:43:55 2006//
+/swank-lispworks.lisp/1.92/Thu Aug 23 19:03:37 2007//
+/swank-loader.lisp/1.73/Fri Sep 14 12:41:28 2007//
+/swank-openmcl.lisp/1.119/Thu Aug 23 19:03:37 2007//
+/swank-sbcl.lisp/1.185/Tue Sep 11 19:31:03 2007//
+/swank-scl.lisp/1.13/Thu Aug 23 19:03:37 2007//
+/swank-source-file-cache.lisp/1.8/Tue Dec 5 13:00:42 2006//
+/swank-source-path-parser.lisp/1.17/Sun Jun 25 08:33:16 2006//
+/swank.asd/1.5/Fri Sep 14 12:41:28 2007//
+/swank.lisp/1.511/Wed Sep 19 11:12:07 2007//
+/test-all.sh/1.2/Mon Aug 29 20:02:58 2005//
+/test.sh/1.9/Mon Aug 27 13:16:49 2007//
+/xref.lisp/1.2/Mon May 17 00:25:24 2004//
+D
Added: branches/trunk-reorg/thirdparty/slime/CVS/Entries.Log
===================================================================
--- branches/trunk-reorg/thirdparty/slime/CVS/Entries.Log 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/CVS/Entries.Log 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2 @@
+A D/contrib////
+A D/doc////
Added: branches/trunk-reorg/thirdparty/slime/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/slime/CVS/Repository 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/CVS/Repository 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+slime
Added: branches/trunk-reorg/thirdparty/slime/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/slime/CVS/Root 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/CVS/Root 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+:pserver:anonymous:anonymous@common-lisp.net:/project/slime/cvsroot
Added: branches/trunk-reorg/thirdparty/slime/CVS/Template
===================================================================
Added: branches/trunk-reorg/thirdparty/slime/ChangeLog
===================================================================
--- branches/trunk-reorg/thirdparty/slime/ChangeLog 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/ChangeLog 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,13172 @@
+2007-09-27 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-filesystem-toplevel-directory): New function.
+ Windows doesn't have a filesystem that is as hierarchical as the
+ Unix' one. Reported by Carsten Blaauw and Stefan Kluehspies.
+ (slime-file-name-merge-source-root): Use it.
+ (slime-highlight-differences-in-dirname): Use it.
+
+2007-09-26 Utz-Uwe Haus <haus+slime(a)mail.math.uni-magdeburg.de>
+
+ * swank-allegro.lisp (fspec-definition-locations): Allow the
+ POSITION datum of :top-level-form fspecs to be missing. This
+ apparently helpful for Allegro CL 8.1.
+
+2007-09-21 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-length=, slime-length>): Restore support for
+ vectors, as `slime-length=' was already used with strings in
+ `slime-parse.el'. This broke extended arglist display.
+
+2007-09-20 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-setup): Call the respective init functions of
+ contribs.
+
+ * slime-autoloads.el (slime-setup-contribs): Ditto.
+
+2007-09-19 Helmut Eller <heller(a)common-lisp.net>
+
+ Simplify slime-compile-file.
+
+ * slime.el (slime-compile-file): Don't save window config.
+ (slime-curry, slime-rcurry): New functions.
+
+ * slime.el (slime-complete-symbol*-fancy): Move defcustom to
+ contrib/slime-c-p-c.el
+
+ * swank-version.el: Delete file. No longer used.
+
+ * bridge.el: Moved to contrib.
+
+ * tree-widget.el: File deleted. Only needed by contribs and is
+ distributed with Emacs 21.
+
+ * slime.el: Reorder some devfars and menus code so that the
+ compiler doesn't complain about free variables.
+
+ Fix apropos in Emacs 22.
+
+ * slime.el (slime-print-apropos): Add button props for Emacs 22.
+ (slime-call-describer): ARG is a marker in Emacs 22.
+
+ (def-slime-selector-method ?c): Wait until slime-list-threads
+ returns.
+
+ Remove define-slime-dialect.
+
+ * slime.el (define-slime-dialect): Deleted. Use
+ slime-lisp-implementations instead.
+
+ Introduce a slime-start-and-init function.
+
+ * slime.el (slime-start-and-init, slime-lisp-options): New
+ functions.
+ (slime-start-and-load): Use it.
+
+ Simplify slime-length=.
+
+ * slime.el (slime-length=, slime-length>): No need for vectors.
+
+ Remove explicit support for Scheme mode.
+
+ * slime.el (slime-scheme-mode-hook, slime-shared-lisp-mode-hook)
+ Deleted.
+ (slime-indentation-update-hooks): New hook.
+ (slime-handle-indentation-update): Use it.
+
+ Fix close-connection.
+
+ * swank.lisp (close-connection): Use *log-output* instead of
+ *debug-io* (which could be redirected to the to-be-closed
+ connection).
+
+2007-09-15 Helmut Eller <heller(a)common-lisp.net>
+
+ Let slime-setup load contribs.
+
+ * slime.el (slime-setup): Take a list of contribs to load as
+ argument.
+
+ * slime-autoloads.el (slime-setup): Ditto, but delay the actual
+ loading until slime is loaded.
+ (slime-setup-contribs): New function.
+
+2007-09-15 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-maybe-warn-for-different-source-root): Catch
+ returned NIL from `slime-file-name-merge-source-root' if the two
+ filenames don't share a common source root.
+ Reported by Frank Goenninger.
+
+2007-09-15 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-split-string): New semi-portability function.
+ The behaviour of `split-string' changed between Emacs21 and
+ Emacs22. Thanks to Christophe Rhodes for reporting this.
+ (slime-file-name-merge-source-root): Use `slime-split-string'.
+ (slime-highlight-differences-in-dirname): Likewise.
+
+2007-09-14 Helmut Eller <heller(a)common-lisp.net>
+
+ Some cleanups for the REPL.
+
+ * slime.el (slime-repl-write-string): Split it up into smaller
+ functions.
+ (slime-repl-emit, slime-repl-emit-result)
+ (slime-emit-string): New functions.
+
+ (slime-repl-save-history): Use prin1 instead of pp.
+
+ (repl-type-ahead): New test case.
+
+2007-09-12 Christophe Rhodes <csr21(a)cantab.net>
+
+ Make ASDF:LOAD-OP (and SBCL REQUIRE) happy with swank.asd
+
+ * swank.asd: Define and use a CL-SCRIPT-FILE class for loading as
+ source, even with ASDF:LOAD-OP.
+
+2007-09-11 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank-loader.lisp: Aways compile-file `contrib/swank-asdf.lisp'
+ on SBCL. This fixes "Undefined function" style-warnings when using
+ `slime-asdf' in combination with SBCL. Reported by Cyrus Harmon.
+
+ * swank-sbcl.lisp: Explicitly require ASDF. (While this is not
+ strictly necessary, as it's implicitly loaded on requiring the
+ other modules, I think it's better to be explicit about it.)
+
+2007-09-10 Helmut Eller <heller(a)common-lisp.net>
+
+ Fix some bugs introduced while moving doc refs to contrib.
+
+ * swank-sbcl.lisp (condition-references): It's still needed.
+
+ * slime.el (sldb-dispatch-extras): Add missing quote.
+ (slime-sbcl-manual-root): Move definition to
+ contrib/slime-references.el.
+ (slime-cl-symbol-name, slime-cl-symbol-package): Move to
+ contrib/slime-parse.el.
+
+2007-09-10 Helmut Eller <heller(a)common-lisp.net>
+
+ Move SBCL doc references to contrib.
+
+ * slime.el (sldb-insert-condition): Merge REFERENCES and EXTRAS.
+ (sldb-extras-hooks, sldb-dispatch-extras): New hook.
+
+ * swank-backend.lisp (condition-references): Removed. Merged with
+ condition-extras.
+
+ * swank-sbcl.lisp (condition-references): Removed.
+ (condition-extras): Include references.
+ (externalize-reference): New function. Don't return plain
+ symbols.
+
+ * swank-allegro.lisp (condition-references): Removed.
+
+2007-09-10 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-cl-symbol-name, slime-cl-symbol-package):
+ Ressurected, as they're still used in this file.
+ Reported by Edward Cant.
+
+2007-09-10 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ When working on multiple source trees simultaneously, the way
+ `slime-edit-definition' (M-.) works can sometimes be confusing:
+
+ `M-.' visits locations that are present in the current Lisp image,
+ which works perfectly well as long as the image reflects the
+ source tree that one is currently looking at.
+
+ In the other case, however, one can easily end up visiting a file
+ in a different source root directory (the one corresponding to the
+ Lisp image), and is thus easily tricked to modify the wrong source
+ files---which can lead to quite some stressfull cursing.
+
+ If the variable `slime-warn-when-possibly-tricked-by-M-.' is
+ T (the default), a warning message is issued to raise the user's
+ attention whenever `M-.' is about opening a file in a different
+ source root that also exists in the source root directory of the
+ user's _current buffer_.
+
+ There's no guarantee that all possible cases are covered, but if
+ you encounter such a warning, it's a strong indication that you
+ should check twice before modifying.
+
+ * slime.el (slime-file-name-merge-source-root): New function.
+ (slime-highlight-differences-in-dirname): New function.
+ (slime-maybe-warn-for-different-source-root): New function.
+ (slime-warn-when-possibly-tricked-by-M-.): New variable (T by default.)
+ (slime-goto-location-buffer): Where appropriate, call
+ `slime-maybe-warn-for-different-source-root'
+
+2007-09-08 Stelian Ionescu <sionescu(a)common-lisp.net>
+
+ * slime.el (save-restriction-if-possible): Place macro definition
+ above use of the macro, to regain ability to byte-compile-file.
+
+2007-09-08 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ Fix message displaying on XEmacs. Reported by Steven E. Harris,
+ and Ken Causey.
+
+ * slime.el (slime-display-message): Resurrect secondary
+ `buffer-name' argument which got lost in 2007-08-24.
+ (slime-format-display-message): Resurrect passing "*SLIME Note*"
+ as default buffer-name to `slime-display-message'.
+
+2007-09-08 Matt Pillsbury <mtbp(a)rci.rutgers.edu>
+
+ * swank-backend.lisp (definterface): Updated docstring.
+
+2007-09-06 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-repl-write-string): Use case, not ecase, for
+ dispatching targets.Should fix XEmacs compatibility.
+ Reported by Steven E. Harris.
+
+2007-09-05 Didier Verna <didier(a)xemacs.org>
+
+ * slime.el (slime-filename-translations): Fix custom type.
+
+2007-09-05 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-toggle-trace-fdefinition): Fix typo. The
+ argument for interactive should be "P" not "p".
+
+2007-09-04 Mark Evenson <mark.evenson(a)gmx.at>
+
+ * swank-abcl.lisp: Call accessors of compiler-condition at load
+ time to work around some ABCL problems.
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ Move asdf support to contrib.
+
+ * swank-backend.lisp (operate-on-system): Moved to
+ swank-asdf.lisp. It wasn't specialized in any backend.
+
+ * swank.lisp (operate-on-system-for-emacs)
+ (list-all-systems-known-to-asdf, list-asdf-systems): Moved to
+ swank-asdf.lisp.
+
+ * slime.el: Move asdf commands to contrib slime-adsf.el.
+
+ * swank-loader.lisp: Load swank-asdf if ASDF is in
+ *FEATURES*. Also add the contrib source directory to
+ swank::*load-path*.
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el: Move tramp support to contrib.
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ Move startup animation to contrib.
+
+ * slime.el (slime-repl-banner-function): New hook.
+ (slime-repl-update-banner): Use it and reset markers after calling
+ it.
+ (slime-set-default-directory): Don't call slime-repl-update-banner
+ here.
+ (slime-repl-insert-prompt): Set slime-repl-input-end-mark to
+ point-max.
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el: Move inferior-slime-mode to contrib.
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el: Fix the test suite (except for SBCL).
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ Simplify slime-process-available-input.
+
+ * slime.el (slime-process-available-input): We are called in a
+ process filter, i.e. at arbitrary times and in an aribtrary
+ buffer. So it doesn't make sense to save-and-restore the current
+ buffer here
+ (slime-eval-async): Instead, save and restore the buffer here.
+ (slime-net-read-or-lose): New.
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ Remove request-abort condition.
+
+ * swank-backend.lisp (request-abort): Removed
+ (abort-request): Removed. Replace all (3) uses with ERROR.
+ * swank.lisp (eval-for-emacs): No special case for request-abort.
+ * slime.el (slime-eval-async): Remove optional arg of :abort.
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ Rename slime-insert-possibly-as-rectangle to slime-insert-indented.
+
+ * slime.el (slime-insert-indented): Renamed. Update callers.
+
+2007-08-31 Helmut Eller <heller(a)common-lisp.net>
+
+ Move compound prefix completion and autodoc to contrib.
+
+ * swank.lisp (simple-completions): Rewritten for simplicity.
+ (operator-arglist): Rewritten for simplicity.
+
+ * slime.el (slime-complete-symbol-function): Make simple
+ completion the default.
+ (slime-echo-arglist-function, slime-echo-arglist): New hook.
+
+ Remove corresponding key bindigs.
+
+ * slime.el (slime-obsolete-commands): New table. Use it to bind
+ a command with an upgrade notice.
+
+2007-08-31 Andreas Fuchs <asf(a)boinkor.net>
+
+ * slime.el (slime-reindent-defun): Fixed when used in lisp file
+ buffers. (Similiar patch also provided by G�bor Melis; problem
+ also reported by Jeff Cunningham.)
+
+2007-08-31 Jon Allen Boone <ipmonger(a)delamancha.org>
+
+ * swank-cmucl.lisp: CMUCL now has an x86-Darwin port as well as
+ the PPC-Darwin version. Changed to conditionalize on the
+ presence of darwin instead of ppc so that slime works with both
+ Darwin versions of CMUCL.
+
+2007-08-31 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-sexp-at-point): Explicitely set current syntax
+ table to operate in `lisp-mode-syntax-table' because
+ `thing-at-point' is used which depends on the syntax table. (E.g.
+ keywords like `:foo' aren't recognized as sexp otherwise.)
+
+ * slime.el (slime-parse-extended-operator/declare): Wrap regexp
+ stuff in `save-match-data'
+ (slime-internal-scratch-buffer): Removed again. Was only
+ introduced as a performance hack; but it turned out that the bad
+ performance was because of unneccessary recursive calls of
+ `slime-make-form-spec-from-string'. (Which was fixed on 2007-08-27
+ already.)
+ (slime-make-form-spec-from-string): Use `with-temp-buffer' instead
+ of `slime-internal-scratch-buffer'. Removed activation of
+ `lisp-mode' in the temporary buffer, because this made
+ `lisp-mode-hooks' run. This activated autodoc in the temp buffer,
+ although the temp buffer is used to compute an autodoc
+ itself (which resulted in some very mutual recursion which caused
+ the current arglist to be displayed again and again---as could
+ have been witnessed in `*Messages*'.) `Lisp-mode' was activated to
+ get the right syntax-table for `slime-sexp-at-point', but this one
+ sets the correct syntax-table itself now.
+
+2007-08-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Fix user input type-ahead again (this change from 2007-08-25 got
+ lost). Testcase: Type (dotimes (i 5) (format t "Number ~A~%"
+ i) (sleep 1)) and then type ahead while the command is executing
+ and output arrives.
+
+ * slime.el (slime-repl-insert-prompt): Don't go to point-max but
+ to slime-repl-input-start-mark if there is one.
+ (slime-repl-write-string): Insert a :repl-result before the
+ prompt, not at point-max. Update markers properly.
+
+2007-08-28 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-cmucl.lisp (safe-definition-finding): Remove whitespace
+ around error messages.
+ (trim-whitespace): New function.
+
+2007-08-28 Helmut Eller <heller(a)common-lisp.net>
+
+ Fix some output related bugs.
+
+ * swank.lisp (send-repl-results-to-emacs): Emit a fresh line.
+
+ * slime.el (slime-insert-transcript-delimiter): Use
+ insert-before-markers since slime-output-end is no longer left
+ inserting. Reported by Austin Haas <austin(a)pettomato.com>.
+
+2007-08-28 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-display-or-scroll-completions,
+ slime-scroll-completions): New functions. Factored out of
+ slime-expand-abbreviations-and-complete.
+
+2007-08-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-repl-write-string): Handle arbitrary targets
+ using slime-output-target-marker.
+ (slime-last-output-target-id, slime-output-target-to-marker)
+ (slime-output-target-marker)
+ (slime-redirect-trace-output): Move back here from slime-presentations.el.
+
+2007-08-28 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp (classify-symbol, symbol-classification->string):
+ Resurrected in swank.lisp. (I was bitten by cvs-pcl which
+ committed (2007-08-27) my locally changed `contribs/swank-fuzzy.lisp'
+ where I already removed these functions from.)
+
+2007-08-28 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-make-form-spec-from-string): Elisp Hacking 101:
+ Don't use `beginning-of-buffer' and `end-of-buffer' in Elisp code.
+
+ * swank.lisp (read-form-spec): Unintern just newly interned
+ symbols when an reader error occurs.
+
+2007-08-28 Helmut Eller <heller(a)common-lisp.net>
+
+ Move presentations to contrib. Part II.
+
+ * swank.lisp (*listener-eval-function*): New variables.
+ (listener-eval): Use it
+ (repl-eval): Used to be listener-eval.
+ (*send-repl-results-function*): New variable.
+ (eval-region): Simplify.
+ (track-package, cat): New functions.
+ (slime-repl-clear-buffer-hook): New hook.
+ (slime-repl-clear-buffer): Use it.
+
+2007-08-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Remove the ID argument from :write-string protocol messages.
+ Everything, except for rigid-indentation tricks, can be achieved
+ by using :write-string in conjunction with :presentation-start and
+ :presentation-end.
+
+ * swank.lisp (present-in-emacs): Unused, removed.
+
+ * swank.lisp (make-output-function-for-target): Remove id argument
+ from :write-string.
+ (send-repl-results-to-emacs): Don't call
+ save-presented-object. Remove id argument from :write-string.
+
+ * slime.el (slime-dispatch-event): Change it here.
+ (slime-write-string, slime-repl-write-string): And here.
+
+2007-08-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank-loader.lisp (*contribs*): Add swank-presentations.
+
+2007-08-27 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-make-extended-operator-parser/look-ahead): Move
+ to end of symbol at point.
+ (slime-make-form-spec-from-string): Fixes unexpected behaviour of
+ `save-excursion'.
+
+2007-08-27 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-sexp-at-point): Fixes a few edge cases were
+ Emacs' `(thing-at-point 'sexp)' behaves suboptimally. For example,
+ `foo(bar baz)' where point is at the ?\(.
+ (slime-internal-scratch-buffer): New. This variable holds an
+ internal scratch buffer that can be reused instead of having to
+ create a new temporary buffer again and again.
+ (slime-make-extended-operator-parser/look-ahead): Uses
+ `slime-make-form-spec-from-string' to parse nested expressions
+ properly.
+ (slime-nesting-until-point): Added docstring.
+ (slime-make-form-spec-from-string): Added new optional parameter
+ for stripping the operator off the passed string representation of
+ a form. Necessary to work in the context of
+ `slime-make-extended-operator-parser/look-ahead'. Added safety check
+ against a possible endless recursion.
+
+ * swank.lisp (parse-form-spec): Looses restriction for nesting.
+
+2007-08-27 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-eval-feature-conditional): Fix typo.
+ (slime-keywordify): Simplify.
+
+2007-08-27 Helmut Eller <heller(a)common-lisp.net>
+
+ Move presentations to contrib. Part I.
+
+ * slime.el (slime-event-hooks, slime-dispatch-event): New hook.
+ (slime-write-string-function, slime-write-string): New hook.
+ (slime-repl-return-hooks, slime-repl-return): New hook.
+ (slime-repl-current-input-hooks, slime-repl-current-input): New hook.
+ (slime-open-stream-hooks, slime-open-stream-to-lisp): New hook.
+ (sldb-insert-locals, slime-inspector-insert-ispec)
+ (slime-last-expression): Don't use presentations.
+
+2007-08-26 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ Reduces needless interning of symbols that was introduced by my
+ recent work on autodoc to a minimum. Also fixes this issue for
+ `slime-complete-form' which always interned symbols even before my
+ changes.
+
+ * slime.el (slime-sexp-at-point): If N is given, but there aren't
+ N sexps available at point, make it return a list of just as many
+ as there are.
+ (slime-make-form-spec-from-string): New. Creates a ``raw form
+ spec'' from a string that's suited for determining newly interned
+ symbols later in Swank.
+ (slime-parse-extended-operator/declare): Uses it.
+
+ * swank.lisp (parse-symbol): Returns internal knowledge, to
+ provide a means for callers to perform a sanity check.
+ (call-with-ignored-reader-errors): New. Abstracted out from
+ `read-incomplete-form-from-string.'
+
+ * swank.lisp (read-form-spec): New. Only READs elements of a form
+ spec if necessary. And if it does have to READ, it keeps track
+ of newly interned symbols which are returned as secondary
+ return value.
+ (parse-form-spec): Use it. Propagate newly interned symbols.
+ (parse-first-valid-form-spec): Likewise.
+ (arglist-for-echo-area, complete-form, completions-for-keyword):
+ Adapted to unintern the newly interned symbols.
+
+
+2007-08-26 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (current-slime-narrowing-configuration):
+ Renamed to `slime-current-narrowing-configuration'.
+ (set-slime-narrowing-configuration):
+ Renamed to `slime-set-narrowing-configuration'.
+ (current-slime-emacs-snapshot):
+ Renamed to `slime-current-emacs-snapshot'.
+ (current-slime-emacs-snapshot-fingerprint):
+ Renamed to `slime-current-emacs-snapshot-fingerprint'.
+ (set-slime-emacs-snapshot):
+ Renamed to `slime-set-emacs-snapshot'.
+
+2007-08-26 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (save-restriction-if-possible): Fixed another typo,
+ duh! Thanks again to Matthias Koeppe.
+
+2007-08-26 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-cl-symbol-name): Handle vertical bars (|)
+ (%slime-nesting-until-point): Renamed to `slime-nesting-until-point'.
+
+2007-08-25 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Fix a bug where REPL results would sometimes be indented by a
+ random amount.
+
+ * slime.el (slime-insert-presentation): Make the
+ rectangle-ification of multi-line presentations, introduced
+ 2006-12-19, optional.
+ (slime-write-string): Use it here only for regular output, but not
+ for REPL results.
+ (sldb-insert-locals): Use it here.
+ (slime-inspector-insert-ispec): Use it here.
+
+2007-08-25 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Fix handling of user-input type-ahead in the REPL.
+ Reported by Madhu <enometh(a)meer.net> on 2007-04-24.
+
+ * slime.el (slime-write-string): Make sure text properties are
+ rear-nonsticky, so typed-ahead user input does not pick up the
+ text properties. Fix up some markers.
+ (slime-reset-repl-markers): Make the marker slime-output-end of
+ insertion type nil (no automatic advances on insertions).
+ (slime-with-output-end-mark): Update the location of
+ slime-output-end here manually.
+ (slime-repl-update-banner): Use insert-before-markers.
+
+2007-08-25 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ New command slime-redirect-trace-output creates a separate Emacs
+ buffer, where all subsequent trace output is sent.
+
+ * slime.el (slime-last-output-target-id): New variable.
+ (slime-output-target-to-marker): New variable.
+ (slime-output-target-marker): New function.
+ (slime-write-string): Handle general "target" arguments using
+ slime-output-target-marker.
+ (slime-redirect-trace-output): New command.
+ (slime-easy-menu): Add a menu item for it.
+
+ * slime.el (slime-mark-presentation-start)
+ (slime-mark-presentation-end): Make "target" argument optional.
+ Use slime-output-target-to-marker.
+
+ * swank.lisp (make-output-stream-for-target): New function,
+ factored out from open-streams.
+ (open-streams): Use it here.
+
+ * swank.lisp (connection): New slot "trace-output".
+ (call-with-redirected-io): Use it here.
+ (redirect-trace-output): New slimefun; set the slot to a new
+ target stream.
+
+2007-08-25 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (save-restriction-if-possible): Fixed typo in
+ macroexpansion. Thanks to Matthias Koeppe for reporting.
+
+2007-08-24 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-insert-arglist): Removed, superseded by
+ slime-complete-form since 2005-02-20.
+
+ * swank.lisp (arglist-for-insertion): Now unused, removed.
+
+2007-08-24 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Some fixes to the presentation-streams contrib.
+
+ * slime.el (slime-dispatch-event): Handle new optionals args of
+ messages :presentation-start and :presentation-end.
+
+ * slime.el (slime-mark-presentation-start)
+ (slime-mark-presentation-end): New arg "target"; record
+ presentation boundaries separately for REPL results and regular
+ process output. This fixes the presentation markup of REPL
+ results when the presentation-streams contrib is loaded.
+
+2007-08-24 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Make the fancy presentation-streams feature a contrib.
+ Previously, it was only available if "present.lisp" was loaded
+ manually. Now it can be loaded automatically using:
+
+ (add-hook 'slime-load-hook
+ (lambda () (require 'slime-presentation-streams)))
+
+ Note that the normal presentations that are created by REPL
+ results, the inspector, and the debugger are NOT dependent on this
+ code.
+
+ * present.lisp: Moved to contrib/swank-presentation-streams.lisp.
+ * swank-loader.lisp (*contribs*): Add swank-presentation-streams.
+
+2007-08-24 Helmut Eller <heller(a)common-lisp.net>
+
+ Move typeout frame to contrib.
+
+ * slime.el (slime-message-function, slime-background-message-function)
+ (slime-autodoc-message-function): New variables.
+ (slime-message, slime-background-message)
+ (slime-autodoc-message): Call the function in the respective
+ variable, so that the typeout window can be plugged in.
+
+2007-08-24 Helmut Eller <heller(a)common-lisp.net>
+
+ Move xref and class browser to contrib.
+
+ * slime.el (slime-browse-classes, slime-browse-xrefs): Gone. The
+ Common Lisp part is still there.
+
+2007-08-24 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-forward-blanks): Wrapped w/ `ignore-errors.'
+ (slime-sexp-at-point): Return results as a list of strings, rather
+ than just one big string if called with arg > 1.
+ (slime-parse-extended-operator-name): Wrapping some movement code
+ in `ignore-errors'. Adapted to new return value of
+ `slime-enclosing-form-specs'. Minor cosmetic changes.
+ (slime-make-extended-operator-parser/look-ahead): Adapted to
+ changes of the ``raw form spec'' format; returns a form of
+ strings, instead of a string of a form.
+ (slime-parse-extended-operator/declare): Simplified. Adapted to
+ changes of the ``raw form spec'' format; passes decl-identifiers,
+ or typespec-operators respectively, along the decl/type-spec.
+ (%slime-in-mid-of-typespec-p): Removed. Replaced by an regexp
+ based approach.
+ (%slime-nesting-until-point): New helper for
+ `slime-parse-extended-operator/declare'.
+
+ * swank.lisp (parse-form-spec): Adapted to new ``raw form spec''
+ format. Updated format description in docstring accordingly. The
+ new format allows less interning of wrong symbols names comming
+ from Slime. Thanks to Matthias Koeppe for spotting this.
+
+2007-08-24 Helmut Eller <heller(a)common-lisp.net>
+
+ Move slime-highlight-edits-mode to contrib.
+
+2007-08-24 Helmut Eller <heller(a)common-lisp.net>
+
+ Move slime-scratch to contrib.
+
+ * slime.el (slime-scratch): Gone.
+
+2007-08-24 Helmut Eller <heller(a)common-lisp.net>
+
+ Various cleanups related to slime-insert-propertized.
+
+ * slime.el (slime-with-rigid-indentation): Fix evaluation order.
+ (slime-indent-rigidly): New.
+ (slime-insert-possibly-as-rectange): Don't set mark.
+ (slime-insert-propertized): Use plain insert instead of
+ slime-insert-possibly-as-rectange.
+
+2007-08-24 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-sbcl.lisp (sbcl-inspector): Fix typo.
+
+2007-08-23 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Repair inspection of presentations.
+
+ * swank.lisp (inspect-presentation): New slimefun.
+ * slime.el (slime-inspect-presentation-at-mouse): Use it here.
+
+2007-08-23 Helmut Eller <heller(a)common-lisp.net>
+
+ Move Marco Baringer's inspector to contrib.
+
+ * swank.lisp (*default-inspector*): New variable. Set this
+ variable dispatch to different inspectors.
+ (inspect-object): Use it.
+
+ * swank-loader.lisp (*contribs*): Add 'swank-fancy-inspector.
+
+ * swank-backend.lisp (backend-inspector): New class. Introduce a
+ named class to give as another way to dispatch to backend methods.
+
+ * swank-cmucl.lisp: Use backend-inspector class.
+ * swank-sbcl.lisp: Use backend-inspector class.
+ * swank-clisp.lisp: Use backend-inspector class.
+ * swank-lispworks.lisp: Use backend-inspector class.
+ * swank-allegro.lisp: Use backend-inspector class.
+ * swank-openmcl.lisp: Use backend-inspector class.
+ * swank-abcl.lisp: Use backend-inspector class.
+ * swank-corman.lisp: Use backend-inspector class.
+ * swank-scl.lisp: Use backend-inspector class.
+
+2007-08-23 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ Added arglist display for declaration specifiers and type
+ specifiers.
+
+ Examples:
+
+ `(declare (type' will display
+
+ (declare (type type-specifier &rest vars))
+
+ `(declare (type (float' will display
+
+ [Typespec] (float &optional lower-limit upper-limit)
+
+ `(declare (optimize' will display
+
+ (declare (optimize &any (safety 1) (space 1) (speed 1) ...))
+
+ &ANY is a new lambda keyword that is introduced for arglist
+ description purpose, and is very similiar to &KEY, but isn't based
+ upon plists; they're more based upon *FEATURES* lists. (See the
+ comment near the ARGLIST defstruct in `swank.lisp'.)
+
+ * slime.el:
+ (slime-to-feature-keyword): Renamed to `slime-keywordify'.
+ (slime-eval-feature-conditional): Adapted to use `slime-keywordify'.
+ (slime-ensure-list): New utility.
+ (slime-sexp-at-point): Now takes an argument that specify how many
+ sexps at point should be returned.
+ (slime-enclosing-operator-names): Renamed to
+ `slime-enclosing-form-specs'.
+ (slime-enclosing-form-specs): Returns a list of ``raw form specs''
+ instead of what was called ``extended operator names'' before, see
+ `swank::parse-form-spec' for more information. This is a
+ simplified superset. Additionally as tertiary return value return
+ a list of points to let the caller see where each form spec is
+ located. Adapted callers accordingly. Extended docstring.
+ (slime-parse-extended-operator-name): Adapted to changes in
+ `slime-enclosing-form-specs'. Now gets more context, and is such
+ more powerful. This was needed to allow parsing DECLARE forms.
+ (slime-make-extended-operator-parser/look-ahead): Because the
+ protocol for arglist display was simplified, it was possible to
+ replace the plethora of parsing function just by this one.
+ (slime-extended-operator-name-parser-alist): Use it. Also add
+ parser for DECLARE forms.
+ (slime-parse-extended-operator/declare): Responsible for parsing
+ DECLARE forms.
+ (%slime-in-mid-of-typespec-p): Helper function for
+ `slime-parse-extended-operator/declare'.
+ (slime-incomplete-form-at-point): New. Return the ``raw form
+ spec'' near point.
+ (slime-complete-form): Use `slime-incomplete-form-at-point'.
+
+ * swank.lisp: New Helper functions.
+ (length=, ensure-list, recursively-empty-p): New.
+ (maybecall, exactly-one-p): New.
+
+ * swank.lisp (arglist-for-echo-area): Adapted to take ``raw form
+ specs'' from Slime.
+ (parse-form-spec): New. Takes a ``raw form spec'' and returns a
+ ``form spec'' for further processing in Swank. Docstring documents
+ these two terms.
+ (split-form-spec): New. Return relevant information from a form spec.
+ (parse-first-valid-form-spec): Replaces `find-valid-operator-name'.
+ (find-valid-operator-name): Removed.
+ (operator-designator-to-form): Removed. Obsoleted by `parse-form-spec'.
+
+ (defstruct arglist): Add `any-p' and `any-args' slots to contain
+ arguments belonging to the &ANY lambda keyword.
+ (print-arglist): Adapted to also print &ANY args.
+ (print-decoded-arglist-as-template): Likewise.
+ (decode-arglist): Adapted to also decode &ANY args.
+ (remove-actual-args): Adapted to also remove &ANY args.
+ (remove-&key-args): Split out from `remove-actual-args'.
+ (remove-&any-args): New. Removes already provided &ANY args.
+ (arglist-from-form-spec): New. Added detailed docstring.
+ (arglist-dispatch): Dispatching generic function for
+ `arglist-from-form-spec' that does all the work. Renamed from
+ prior `form-completion'.
+ (arglist-dispatch) Added methods for dealing with declaration and
+ type-specifiers.
+ (complete-form): Adapted to take ``raw form specs'' from Slime.
+ (completions-for-keyword): Likewise.
+ (format-arglist-for-echo-area): Removed. Not needed anymore.
+
+ * swank-backend.lisp (declaration-arglist): New generic
+ function. Returns the arglist for a given declaration
+ identifier. (Backends are supposed to specialize it if they can
+ provide additional information.)
+ (type-specifier-arglist): New generic function. Returns the
+ arglist for a given type-specifier operator. (Backends are
+ supposed to specialize it if they can provide additional
+ information.)
+ (*type-specifier-arglists*): New variable. Contains the arglists
+ for the type specifiers in Common Lisp.
+
+ * swank-sbcl.lisp: Now depends upon sb-cltl2.
+ (declaration-arglist 'optimize): Specialize the `optimize'
+ declaration identifier to pass it to
+ sb-cltl2:declaration-information.
+
+
+2007-08-23 Helmut Eller <heller(a)common-lisp.net>
+
+ Some inspector cleanups.
+
+ * slime.el (slime-inspect): Remove dwim stuff and drop keyword
+ args.
+ (slime-read-object): Killed.
+ (slime-open-inspector): Drop keyword args. Update callers
+ accodordingly, expect presentation related code. Presentations no
+ longer work in the inspector.
+
+ * swank.lisp (*inspector-dwim-lookup-hooks*)
+ (default-dwim-inspector-lookup-hook): Deleted.
+ (init-inspector): Sanitize arglist.
+ (inspect-object): Don't return an :id for *inspectee-parts*.
+
+ * swank-backend (type-for-emacs): Removed. No backend implemented
+ it.
+
+2007-08-23 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-fuzzy-upgrade-notice): New function. Bound to
+ the key where slime-fuzzy-complete-symbol used to be.
+
+2007-08-22 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-close-all-parens-in-sexp): Fix interplay with
+ `slime-close-parens-limit'. This should also affect
+ `slime-complete-form' (C-c C-s) in a positive way.
+
+2007-08-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * contrib: New directory. Move fuzzy completion code to that
+ directory.
+
+ * swank.lisp (swank-require): New function to load contrib code.
+ (*find-module*, module-filename, *load-path*, merged-directory)
+ (find-module, module-canditates): New. Pathname acrobatics for
+ swank-require.
+
+ * swank-loader.lisp: Compile (but don't load) contribs.
+ (*contribs*, contrib-source-files): New.
+
+2007-08-16 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-process-available-input): Correct yesterday's
+ change: the buffer a request was originally performed in doesn't
+ necessarily exist at this time anymore, so we check for buffer
+ liveness now.
+
+ The problem arised when quitting in SLDB which would cause Swank
+ to send a `:debug-return' message before the acknowledgement
+ message for `sldb-quit' is sent. So the acknowledgement is
+ received in a context where the sldb-buffer is closed already.
+
+2007-08-15 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-process-available-input): Make sure that the
+ event received from SWANK is processed in the context of the
+ original buffer the request of the response was performed in.
+ Previously, the clauses of `slime-rex' were processed in the
+ internal *cl-connection* buffer. And as a result the continuations
+ passed to `slime-eval' and `slime-eval-async' ditto.
+
+2007-08-15 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ Make `M-.' work on definitions outside the current restriction.
+ `M-,' will also properly restore the narrowing as of before the
+ jump. Similiarly for quiting from the compilation notes buffer and
+ the Xref buffers.
+
+ * slime.el (slime-narrowing-configuration, slime-emacs-snapshot),
+ (current-slime-narrowing-configuration),
+ (set-slime-narrowing-configuration),
+ (current-slime-emacs-snapshot),
+ (set-slime-emacs-snapshot),
+ (current-slime-emacs-snapshot-fingerprint): New. Emacs' window
+ configurations do not restore narrowing, so introduce a
+ snapshot facility that contains the necessary information.
+
+ * slime.el: Various renaming and adaptions in the Slime temp
+ buffer, xref, goto-definition and compilation notes section to use
+ the newly introduced snapshots instead of mere window
+ configurations.
+
+ * slime.el: (slime-highlight-notes, slime-remove-old-overlays):
+ Still operate on whole buffer, but restore previous restriction if
+ there was any.
+ (slime-goto-location-position): Now widens the buffer to properly
+ jump to definitions outside of the current restriction.
+
+ * slime.el (slime-push-definition-stack),
+ (slime-pop-find-definition-stack): Now also stores information
+ about narrowing on the definition stack, in order to properly
+ restore narrowing on `M-,'.
+
+ * slime.el (def-slime-test narrowing): Test case for properly
+ dealing with narrowing.
+
+ * slime.el (slime-buffer-narrowed-p): New function, tests whether
+ the current buffer is narrowed or not.
+ (save-restriction-if-possibly): Like `save-restriction', but not
+ as strict---see doc string.
+
+ * slime.el (slime-length=): New function; semantically the same
+ as (= (length seq) n), but more efficiently implemented for lists.
+ Changed the above pattern into a call to SLIME-LENGTH= where
+ appropriate.
+
+2007-08-05 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (backtrace): Handle printer errors while printing a
+ frame. This makes debugging print-object methods with SLIME
+ easier. Reported by Utz-Uwe Haus.
+
+2007-08-02 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-kill-all-buffers): Now also kills all buffers
+ beginning with a `*SLIME' prefix (like, for instance, `*SLIME
+ Apropos*', or `*SLIME macroexpansion*'.)
+
+2007-06-28 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (def-slime-selector-method): Revert Marco's change from
+ 2007-05-23. BODY can return a buffer name, like "*slime-events*".
+ Handle that and never ignore invalid return values. Force BODY to
+ abort if there's no suitable buffer. Why would you want to switch
+ buffers if the desired buffer doesn't exist?
+
+2007-06-27 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ Fixing `C-c M-q' at the REPL. Thanks to Andr� Thieme for pointing
+ out that it has been broken since several months.
+
+ * slime.el (slime-reindent-defun): Use functions
+ `slime-beginning-of-defun' and `slime-end-of-defun' that were
+ introduced in the last changeset.
+
+2007-06-16 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el: Pressing `C-M-a' (beginning-of-defun) in midst of the
+ last REPL prompt directs the cursor to the beginning of the
+ prompt. Pressing it again, would do nothing; now it moves the
+ cursor to the start of the previous prompt (as it's consistent
+ with the behaviour when the cursor was placed midst one of the old
+ prompts.)
+
+ Likewise for `C-M-e' (end-of-defun)
+
+ Additionally fixing `C-c C-s' (slime-complete-form) at the REPL.
+
+ (slime-keys): New bindings for `C-M-a' and `C-M-e' to
+ SLIME-BEGINNING-OF-DEFUN and SLIME-END-OF-DEFUN respectively.
+ (slime-keys): Making `C-c C-q' (slime-close-parens-at-point)
+ obsolete, as it didn't work correctly on the REPL.
+ (slime-repl-mode-map): Removed bindings for `C-M-a' and `C-M-e',
+ as they're now inherited from SLIME-KEYS.
+ (slime-repl-beginning-of-defun, slime-repl-end-of-defun): Jump to
+ the previous (next) prompt if called twice in a row.
+
+ (slime-close-parens-at-point): Commented out.
+ (slime-close-all-sexp): Renamed to SLIME-CLOSE-ALL-PARENS-IN-SEXP.
+ (slime-close-all-parens-in-sexp): Modified to take
+ SLIME-CLOSE-PARENS-LIMIT into account.
+ (slime-complete-form): Use SLIME-CLOSE-ALL-PARENS-IN-SEXP.
+
+
+2007-05-24 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Fixed regression in completion: "swank[TAB]" would
+ previously be completed to "swank-backend:"; "get-internal[TAB]"
+ would be completed to "get-internal-r-time" (instead of simply
+ "get-internal-r"); and "custom:*comp[TAB]" would be completed to
+ "custom:*compiled-" on CLISP, even though there's a
+ "custom:*complile-".
+
+ Thanks to Ken Causey for helping me find the first two.
+
+ (completions): Revert changes from 2007-05-11.
+ (longest-compound-prefix): Fixed to properly generate a compound
+ _prefix_.
+
+2007-05-23 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (def-slime-selector-method): Allow the selector body to
+ not return a buffer. This means that, instead of being to forced
+ to signal an error when a choosen buffer can't be found (like
+ choosing d when there are no debugger buffers) can simply display
+ a message.
+
+ Fix handling of auto-flushing on sbcl:
+
+ * swank-sbcl.lisp (*auto-flush-interval*): New variable
+ controlling how often streams are flushed.
+ (*auto-flush-lock*): New lock guarding access to the shared
+ variable *auto-flush-streams*.
+ (make-stream-interactive): Wrapped access to *auto-flush-streams*
+ in a call-with-recursive-lock-held.
+ (flush-streams): Wrapped in call-with-recursive-lock-held.
+
+2007-05-17 Martin Simmons <martin(a)lispworks.com>
+
+ * swank-lispworks.lisp (lispworks-inspect): Fix hanging caused by
+ mapcan, i.e. nconc, on a constant list returned by
+ label-value-line.
+
+2007-05-17 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-complete-form): Only insert a closing
+ parenthesis if the form is not already closed. Reported by and
+ adapted from Mac Chan.
+
+2007-05-17 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Fixed bug in completion as previously "swank:[tab]"
+ would correctly list all the symbols in SWANK, but would
+ simultaneously append a spooky dash to the original
+ string ("swank:-").
+
+ (completions): Strip off the package identifier part, and only
+ compute the longest compound prefix for the actual symbol
+ identifiers.
+ (untokenize-symbol): New function. Inverse of TOKENIZE-SYMBOL.
+ (format-completion-result): Use UNTOKENIZE-SYMBOL.
+
+2007-05-17 Dustin Long <dlong(a)stevens.edu>
+
+ * swank-ecl.lisp (compile-from-stream): Fixed typo that prevented
+ `slime-compile-defun' from actually compiling a function.
+
+2007-05-17 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank-loader.lisp (*sysdep-files*): Load the auxiliary files
+ swank-source-*.lisp before swank-sbcl.lisp to avoid
+ undefined-function style warnings.
+
+2007-05-16 Takehiko Abe <keke(a)gol.com>
+
+ * swank.lisp (inspect-for-emacs file-stream, stream-error): Fixed
+ typo in keyword arg; it's `:refreshp', not `:refresh'.
+
+2007-05-14 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el: Fixed proper handling of the abortion of a
+ request. (For instance, when calling (SWANK::ABORT-REQUEST "FOO")
+ from the REPL.)
+
+ (sldb-quit): Updated the DESTRUCTURE-CASE clause for (:abort) to
+ take an argument.
+ (sldb-continue): Likewise.
+ (sldb-invoke-restart): Likewise.
+ (sldb-break-with-default-debugger): Likewise.
+ (sldb-return-from-frame): Likewise.
+ (sldb-restart-frame): Likewise.
+ (slime-repl-eval-string) Likewise.
+ (slime-repl-show-abort): Now also inserts the reason for the abort
+ into the REPL buffer.
+
+ * swank.lisp (eval-for-emacs): Remove code that would suggest that
+ it's possible to use the rex `(:abort ...)' with more than one
+ argument.
+
+2007-05-14 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Liberated from unnecessary style-warnings!
+
+ (eval-for-emacs): Don't use SLOT-VALUE on condition objects!
+ (inspect-bigger-piece-actions): Changed from DEFMETHOD to DEFUN.
+ (inspect-whole-thing-action): Likewise.
+ (inspect-show-more-action): Likewise.
+ (make-symbols-listing): Adds an explicit DEFGENERIC.
+ (menu-choices-for-presentation): Likewise.
+
+ (make-symbols-listing (eql :classification)): Use `(loop for k
+ being EACH hash-key ...)' rather than `(loop for k being THE
+ hash-key)', to omit the justified style-warning from CLISP.
+
+2007-05-14 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp (package-names): Make sure to return a fresh list.
+ (fuzzy-find-matching-packages): Use PACKAGE-NAMES.
+ (list-all-package-names): Use PACKAGE-NAMES.
+
+2007-05-13 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-pretty-lambdas): Removed. If you really want
+ this, please use one of the external ressources that provide this;
+ for instance, `pretty-lambda.el', `pretty-greek.el', or even
+ `pretty-symbols.el'. For more information, please see
+
+ http://www.emacswiki.org/cgi-bin/wiki/PrettyLambda
+
+2007-05-11 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp (fuzzy-find-matching-symbols): Modified to take
+ package nicknames into account. Previously, fuzzy completing on
+ nicknames did (except for some incidental cases) not work. Thanks
+ to Lu�s Oliveira and Attila Lendvai for pointing that out.
+
+2007-05-11 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ Removed support for completing to the longest compound pre- and
+ suffix with the default completion method (C-c TAB, or just TAB on
+ the REPL), because it has been causing trouble all the time, but
+ didn't offer any real advantage besides niftiness. E.g.:
+
+ previous behaviour:
+
+ asdf:*com TAB => asdf:*compile-file--behaviour*
+
+ now simply:
+
+ asdf:*com TAB => asdf:*compile-file-
+
+ For discussing on this subject, please see the mail with
+ message-id <87y7l53lch.fsf(a)freebits.de> that was posted to
+ slime-devel 2007-04-06, or alternatively:
+
+ http://common-lisp.net/pipermail/slime-devel/2007-April/006087.html
+
+ * swank.lisp (make-compound-prefix-matcher): New function.
+ Abstracted from COMPOUND-PREFIX-MATCH.
+ (compound-prefix-match): Use MAKE-COMPOUND-PREFIX-MATCHER.
+ (compound-prefix-match/ci/underscores): Removed.
+
+ (longest-completion): Renamed to LONGEST-COMPOUND-PREFIX. Changed
+ to only return a compound prefix, instead of a concatenation of a
+ compound prefix and a compound suffix. Added an &optional
+ parameter to specify what delimeter the passed string is
+ compounded with.
+ (tokenize-completion): Takes additional parameter to specify the
+ delimeter for tokenization.
+ (longest-completion/underscores): Removed; not needed anymore.
+ (tokenize-completion/underscores): Likewise.
+ (untokenize-completion/underscores): Likewise.
+
+ (completions): Slight docstring modification, also added an
+ examplary use case; use LONGEST-COMPOUND-PREFIX instead of
+ LONGEST-COMPLETION.
+ (completions-for-character): Use LONGEST-COMPOUND-PREFIX, and
+ MAKE-COMPOUND-PREFIX-MATCHER.
+ (completions-for-keyword): Use LONGEST-COMPOUND-PREFIX.
+
+2007-05-11 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp (apropos-symbols): Really use MAKE-REGEXP-MATCHER.
+
+2007-05-10 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Previously when using SLIME-APROPOS-PACKAGE, only
+ those symbols were considered whose home package matched the
+ given package; this would, however, prevent all those symbols from
+ being listed that are imported from another package, and then
+ exported again in the package they got imported into. (As an
+ example, SWANK:RESTART-FRAME is actually from SWANK-BACKEND.)
+
+ (apropos-matcher): Renamed to MAKE-REGEXP-MATCHER.
+ (make-regexp-matcher): Changed to only match for a given regexp.
+ (apropos-symbols): Use MAKE-REGEXP-MATCHER.
+
+2007-05-10 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el: Fix macroexpanding on things like ",(loop ...)".
+
+ (slime-sexp-at-point-for-macroexpansion): New function; like
+ SLIME-SEXP-AT-POINT-OR-ERROR, but fixes up some misbehaviour with
+ respect to macroexpansion.
+ (slime-eval-macroexpand, slime-eval-macroexpand-inplace): Use the
+ new function.
+
+2007-05-10 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el: Within the Slime Inspector, `S-Tab' will now also work
+ on X. Furthermore `Tab' and `S-Tab' will now correctly wrap
+ around the beginning and end of the buffer; priorly it'd hang on
+ the beginning with a message "Beginning of buffer", and would
+ require an additional `S-Tab'.
+
+ (slime-inspector-mode-map): Attached `[backtab]' to
+ SLIME-INSPECTOR-PREVIOUS-INSPECTABLE-OBJECT, as Emacs translates
+ `S-Tab' to `Backtab' on X.
+ (slime-find-inspectable-object): New function; finds next or
+ previous inspectable object.
+ (slime-inspector-next-inspectable-object): Mostly rewritten. Use
+ SLIME-FIND-INSPECTABLE-OBJECT to make the code clearer.
+
+2007-04-19 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank-backend.lisp (label-value-line): Add :newline as &key
+ argument; if true (the default) inserts a newline.
+
+ * swank.lisp (inspect-for-emacs-list): Don't add a newline after
+ the last value of the list.
+
+2007-04-18 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (log-event): Setup the printer so that, no matter
+ what the global values of the *print-XYZ* variables, this function
+ works as expected.
+ (*debug-on-swank-error*): New variable.
+ (defpackage :swank): Export *debug-on-swank-error*.
+ (with-reader-error-handler): When *debug-on-swank-error* is
+ non-nil drop into a debugger.
+ (dispatch-loop): Idem.
+
+2007-04-17 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Instead of just having all the symbols of a package
+ listed alphabetically in the inspector page recently introduced
+ for that purpose, add a button to that page to group them by their
+ classification.
+
+ (%package-symbols-container): New slot GROUPING-KIND.
+ (%make-package-symbols-container): New function; wraps around
+ %%MAKE-PACKAGE-SYMBOLS-CONTAINER, which will actually create the
+ structure. We need this, to make GROUPING-KIND an entirely
+ internal affair.
+
+ (make-symbols-listing): New generic function to dispatch on
+ GROUPING-KIND.
+ (make-symbols-listing :symbol): Just the stuff that was priorly
+ wired into INSPECT-FOR-EMACS (%PACKAGE-SYMBOLS-CONTAINER).
+ (make-symbols-listing :classification): New; returns the passed
+ symbols grouped by their classification.
+ (inspect-for-emacs %package-symbols-container): Most code split
+ off into MAKE-SYMBOLS-LISTING.
+
+2007-04-17 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp (swank-compiler): Fix the return value to always be a
+ list of two elements even if the abort restart is invoked which
+ originally just returned NIL. (Which wouldn't play with the recent
+ change to use DESTRUCTURING-BIND in SLIME-COMPILATION-FINISHED.)
+
+2007-04-17 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp (inspect-for-emacs %package-symbols-container):
+ Revert Marco's change from 2007-04-08; he had the good idea of
+ adding a facility to jump to the relevant source line of a symbol,
+ but `M-.' is already bound to SLIME-FIND-DEFINITION in the
+ inspector, which is a nicer way of doing this alltogether.
+
+2007-04-16 Takehiko Abe <keke(a)gol.com>
+
+ * swank-openmcl.lisp (accept-connection, find-external-format):
+ utf-8 support.
+
+2007-04-16 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-with-xref-buffer): Added missing ,
+
+2007-04-16 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el: Pressing `q' in *compiler notes* after a `C-c C-k' or
+ `C-c M-k' would not probably restore the original window
+ configuration. Fix that.
+
+ (slime-get-temp-buffer-create): New &key arg WINDOW-CONFIGURATION.
+ (slime-with-xref-buffer): Likewise.
+
+ (slime-compilation-finished): New &optional arg WINDOW-CONFIG.
+ (slime-maybe-show-xrefs-for-notes): Likewise.
+ (slime-show-xrefs) Likewise.
+ (slime-maybe-list-compiler-notes): Likewise.
+ (slime-list-compiler-notes): Likewise.
+
+ (slime-compilation-finished-continuation): Renamed to
+ SLIME-MAKE-COMPILATION-FINISHED-CONTINUATION.
+
+ (slime-make-compilation-finished-continuation): Now takes two
+ args, the current buffer and optionally the current window config
+ to be restored.
+
+ (slime-compile-file): Save current window configuration before
+ popping up the REPL for compilation output, pass it down.
+ (slime-easy-menu): Add entry for SLIME-UNTRACE-ALL.
+
+2007-04-16 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp (fuzzy-find-matching-packages): Fix a small typo that
+ prevented interpreting NIL as the argument TIME-LIMIT-IN-MEC to
+ mean an infinite time limit. This bug propagated up to explicit
+ calls to FUZZY-COMPLETIONS, like
+ (swank:fuzzy-completions "mvb" "COMMON-LISP") => (NIL, T)
+
+ (format-fuzzy-completions): Renamed to FORMAT-FUZZY-COMPLETION-SET
+
+ (format-fuzzy-completion-set): Accomodated to recent changes of
+ the return value of FUZZY-COMPLETIONS; changed the docstring to
+ make it explicit that this function is supposed to take the return
+ value of FUZZY-COMPLETION-SET.
+
+ * slime.el (slime-compilation-finished): Don't use
+ MULTIPLE-VALUE-BIND for list destructuring, only because multiple
+ values happen to be implemented via lists in elisp!
+ (slime-fuzzy-completions-mode): Added an detailed explanation to
+ the docstring of how Fuzzy Completion works and how it'ss supposed
+ to be worked with.
+ (slime-fuzzy-explanation): Shortened to reference to
+ SLIME-FUZZY-COMPLETIONS-MODE for help on fuzzy completion.
+ (slime-fuzzy-choices-buffer): Set BUFFER-QUIT-FUNCTION to
+ SLIME-FUZZY-ABORT to make it correctly exit fuzzy completion when
+ pressing `Esc Esc Esc' (`M-Esc Esc').
+
+2007-04-12 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * swank-sbcl.lisp (emacs-buffer-source-location): Add &allow-other-keys
+ to the descructuring of the source location plist in order to accept
+ :emacs-directory.
+
+2007-04-09 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (inspector-content-for-emacs): Look for refresh
+ keyword argument in :action links.
+ (inspect-whole-thing-action, inspect-show-more-action): Update for
+ new :action argument handling.
+ (inspect-for-emacs stream, inspect-for-emacs stream-error): Pass
+ :refresh nil on :action links.
+ (action-part-for-emacs): Set both lambda and refresh in the
+ *inspectee-actions* array.
+ (inspector-call-nth-action): *inspectee-actions* now holds both
+ the function and the boolean specifying whether to refresh or not.
+
+ * swank-backend.lisp (inspect-for-emacs): Docstring update.
+
+ * slime.el (slime-inspector-operate-on-point): Allow the action
+ calls to return nil.
+
+2007-04-08 Marco Baringer <mb(a)bese.it>
+
+ * .cvsignore: Added *.lx64fsl (openmcl on linux fasls).
+
+2007-04-08 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (inspect-for-emacs): Added 'jump to source' action
+ for symbols in the new package-symbol browser.
+
+2007-04-08 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Implemented a new special inspector page for
+ displaying internal (external, &c) symbols that display
+ classification flags additionally to each symbol, similiar to the
+ content of a *Fuzzy Completion* buffer. Furthermore, added the
+ possibility to display all symbols that are /present/ in a
+ package. Combined with cleanup of the code parts in question.
+
+ (symbol-status): New function. Returns the status of a symbol in a
+ given package (:internal, :external &c.)
+
+ (symbol-external-p): Adapted to use new function SYMBOL-STATUS.
+
+ (symbol-classification->string): New function. Converts a list of
+ classification flags into a concise string representation.
+
+ (%package-symbols-container): New struct. We need a unique type to
+ dispatch in INSPECT-FOR-EMACS for the new inspector page, use this
+ as a wrapper structure.
+
+ (inspect-for-emacs package): Reorganized to not cause too much eye
+ cancer; now with a saner maximum column width. Changed to make use
+ of new SYMBOL-STATUS, for code reuse. Also changed to make use of
+ new %PACKAGE-SYMBOLS-CONTAINER to let a new page pop up in Emacs
+ if the user wants to access the list of symbols of the package.
+ Added such a possibility to access all `present' symbols.
+
+ (inspect-for-emacs %package-symbols-container): New method.
+ Displays all symbols wrapped up in the container structure
+ combined with their classification flags as determined by
+ CLASSIFY-SYMBOL.
+
+2007-04-08 Lu�s Oliveira <loliveira(a)common-lisp.net>
+
+ * swank-backend.lisp (compute-sane-restarts): New interface.
+ * swank-clisp.lisp: Fix tabs and trailing whitespace.
+ (compute-sane-restarts): Implement new interface.
+
+2007-04-08 Takehiko Abe <keke(a)gol.com>
+
+ * swank-openmcl.lisp (xref-locations):
+
+2007-04-08 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (fuzzy-completion-set): Use two check-type forms
+ instead of a place like (values limit time-limit-in-msec). While
+ sbcl seems to accept this form openmcl doesn't and it's not clear
+ from the spec that this is allowed.
+
+2007-04-07 Harald Hanche-Olsen <hanche(a)math.ntnu.no>
+
+ * slime.el (sldb-mode-map): Added key definition for follow-link.
+
+2007-04-06 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Making fuzzy completion regard the time limit
+ correctly. Also make it properly use microseconds as time
+ granularity and inform the Emacs side if the time limit has
+ exhausted. Additionally, over all minor and cosmetic changes:
+
+ (fuzzy-completions, fuzzy-completion-set): Returns now
+ additionally a flag indicating whether the time limit has
+ exhausted under the hood. Accomodated docstring accordingly.
+
+ (fuzzy-create-completion-set): Changed to correctly catch and
+ propagate the remaining time limit to the actual match functions,
+ and return once time limit has exhausted. Some aesthetical code
+ reorganization.
+
+ (get-real-time-in-msecs): New function.
+
+ (fuzzy-find-matching-symbols, fuzzy-find-matching-packages):
+ Correctly regard the time limit. Use new function
+ GET-REAL-TIME-IN-MSECS for that purpose. Return the remaining
+ time limit as second value.
+
+ * slime.el (slime-fuzzy-complete-symbol): Accomodated to deal with
+ the additionally returned flag of SWANK:FUZZY-COMPLETIONS. Pass
+ the flag by.
+ (slime-fuzzy-choices-buffer): Pass interruption flag by.
+ (slime-fuzzy-fill-completions-buffer): If time limit has exhausted
+ during completion retrieval, show an informational indication as
+ last entry in *Fuzzy Completion*.
+ (slime-fuzzy-last): New variable. To hold the last real completion
+ choice previous to the (possible) Time Limit Exhausted information.
+ (slime-fuzzy-next): Accomodated to not go beneath SLIME-FUZZY-LAST.
+
+2007-04-06 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp (tokenize-symbol, tokenize-symbol-thoroughly):
+ Previously these functions said a string representing a symbol is
+ internal exactly if it contained "::" as substring. Now they say
+ additionally so for symbols without any package identifier, as
+ they are internal to am implicit current package. (Otherwise
+ will break fuzzy completion.)
+
+ (tokenize-symbol): Added docstring.
+
+ * swank.lisp (format-completion-result): Fixed formation
+ for the case that PACKAGE-NAME is NIL but INTERNAL-P is T.
+
+2007-04-06 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Making fuzzy completion semantically right from a
+ user perspective. As an example on SBCL, "sb:with- C-c M-i" will
+ display all exported "with"-style macros in all sb-* packages from
+ now on. :)
+
+ (parse-completion-arguments): Replacing with a semantically-sound
+ implementation, as the previous one was a bit confused. Clarifying
+ docstring. Adding commentary table of various constellations of
+ returned values for thorough explanation.
+
+ (carefully-find-package): Removed. Obsolete by above change.
+
+ (defstruct fuzzy-matching): Introduced to make internally-used
+ datastructure explicit. Distinguishing ``completion chunks''
+ between those pertaining to the symbol itself and those to the
+ package identifier.
+
+ (convert-fuzzy-completion-result): Renamed to
+ FUZZY-CONVERT-MATCHING-FOR-EMACS.
+
+ (fuzzy-convert-matching-for-emacs): Accomodating for the new
+ datastructure. Only the chunks pertaining to the symbol itself are
+ fixed up positionally, the package-chunks are untouched.
+ Necessary for letting package identifiers be highlighted within
+ *Fuzzy Completions* in cases like "sb:with- C-c M-i."
+
+ (fuzzy-completion-set): Taking out most code to become new
+ function FUZZY-CREATE-COMPLETION-SET.
+
+ (fuzzy-create-completion-set): Doing all the hard work. Crux of
+ this changeset. so to speak. Largly rewritten to accomodate all
+ different cases of PARSE-COMPLETION-ARGUMENT.
+
+ (fuzzy-find-matching-symbols, fuzzy-find-matching-packages):
+ Accomodating to new datatstructure FUZZY-MATCHING. Adapting
+ docstring accordingly.
+
+ * swank-backend.lisp: Export WITH-STRUCT.
+
+ * swank.lisp (eval-for-emacs, fuzzy-completions):
+ Various trivia like fixing spelling and indentation.
+
+2007-04-06 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-fuzzy-highlight-current-completion): Fix
+ off-by-one error that causes the currently selected
+ completion in the *Fuzzy Completion* buffer be highlighted
+ one char too far.
+
+2007-04-06 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank.lisp: Cleanup of parts of the fuzzy completion code.
+ Additionally a couple of enhancements. As follows:
+
+ (fuzzy-completions, fuzzy-completion-selected): Minor
+ stylistic and clarifying modifications of the docstrings.
+
+ (fuzzy-find-matching-symbols): Huge code reorganization.
+ Organizing relevant code into local function TIME-EXHAUSTED-P,
+ renaming local function SYMBOL-MATCH to PERFORM-FUZZY-MATCH,
+ making previously required argument EXTERNAL to new &key
+ argument :EXTERNAL-ONLY, clarifying docstring.
+
+ (fuzzy-find-matching-packages): Making its return value
+ conformant to that of FUZZY-FIND-MATCHING-SYMBOLS, i.e.
+ instead of returning, among others, a package's name as
+ string, it now returns a symbol representing the package.
+ Accomodates the docstring accordingly.
+
+ (fuzzy-completion-set): Minor typographical fix in docstring.
+ Changing local function CONVERT to use MAP-INTO instead of
+ doing it essentially manually. Accomodating to changes of
+ FUZZY-FIND-MATCHING-SYMBOLS, resp. -PACKAGES.
+
+ (fuzzy-completion-set): Additional new feature:
+ The returned completions are sorted alphabetically by the
+ matched completion string before sorted by its score.
+ Affects especially the list of all possible completions when
+ the user hits fuzzy-completion on an empty string within Emacs;
+ also makes the potential limitness of the listed completions
+ clearer to the end user of SLIME.
+
+ (classify-symbol): New function. Returns a list with keywords
+ that classifies a given symbol. (E.g. :BOUNDP, :MACRO &c)
+ Supersedes parts of CONVERT-FUZZY-COMPLETION-RESULT,
+ implementing them in a more straightforward and proper way;
+ removes prior KLUDGE in that part of the original function.
+
+ (convert-fuzzy-completion-result): The above changes made
+ it possible to simplify this function drastically. Now uses
+ the newly introduced function CLASSIFY-SYMBOL.
+
+ * slime.el: Minor stylistic changes. Additionally:
+ (slime-fuzzy-insert-completion-choice):
+ (slime-fuzzy-fill-completions-buffer) : Adding use of the
+ :PACKAGE classification flag returned by SWANK:FUZZY-COMPLETIONS.
+ This flag is called "p".
+
+2007-04-06 Neil Van Dyke <neil(a)neilvandyke.org>
+
+ * slime.el (sldb-insert-frame): Added mouse-face to frame label
+ and expression in Backtrace.
+ (sldb-insert-frames): Added mouse-face to "--more--" label in
+ Backtrace.
+
+2007-04-06 Michael Weber <michaelw+slime(a)foldr.org>
+
+ * slime.el (slime-call-defun): insert the closing parenthesis for
+ the form.
+
+2007-04-06 Marco Baringer <mb(a)bese.it>
+
+ * swank-openmcl.lisp (package swank-mop): Added
+ slot-makunbound-using-class.
+
+2007-03-29 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * swank-sbcl.lisp (swank-compile-string): save the original
+ directory into the source plist as :emacs-directory.
+ (make-definition-source-location): use the :emacs-directory from
+ the source plist and guess-readtable-for-filename to determine the
+ correct readtable for string-compiled definitions.
+
+2007-03-29 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * swank.lisp (*macroexpand-printer-bindings*): add *print-lines*
+ to defaults (NIL).
+ (find-definitions-for-emacs): use unless instead of cond.
+
+2007-03-25 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * slime.el (with-selected-window): define for compatibility with
+ Emacs 21.
+
+2007-03-24 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (menu-choices-for-presentation): Offer a
+ "disassemble" menu item for functions.
+
+2007-03-24 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-read-port-and-connect): Fix race condition:
+ retry one more time if the port file is empty. Pop up the debugger
+ on other errors.
+ (slime-attempt-connection): Moved to toplevel.
+ (slime-timer-call): New. Used by slime-attempt-connection.
+ (slime-cancel-connect-retry-timer): New.
+ (slime-abort-connection): Use it.
+ (slime-repl-insert-prompt): Use insert-before-markers. This fixes
+ some redisplay problems, but I don't know why. Also: remove the
+ timer for async output.
+ (slime-repl-move-output-mark-before-prompt): Removed.
+ (slime-repl-save-merged-history): Use with-temp-message.
+ (slime-goto-location-buffer): Support Zip files.
+ (sldb-quit): Don't print "Evaluation aborted".
+
+2007-03-22 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-scratch-buffer): Respect the syntax text
+ properties of presentations.
+
+2007-03-21 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (lookup-presented-object): The presentation id of
+ frame locals now includes the thread id; ignore it for now.
+
+ * slime.el (slime-copy-presentation-at-mouse-to-point): Manually
+ invoke the after-change function, so that the presentation overlay
+ is created even if we paste to non-REPL buffers.
+ (slime-menu-choices-for-presentation): Evaluate
+ menu-choices-for-presentation-id in the right buffer, thus in the
+ right Lisp thread. Reported by Attila Lendvai.
+ (slime-menu-choices-for-presentation): Show the id of the presentation.
+ (sldb-insert-locals): Include the thread id in the presentation id.
+
+2007-03-21 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-repl-eval-string, slime-repl-insert-result):
+ Support the presentation-less old protocol.
+ (slime-goto-location-position): Use column number if available.
+
+2007-03-20 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (completion-output-symbol-converter): Fix completion
+ for mixed-case symbols that need escaping in readtable-case
+ :upcase or :downcase.
+
+ * slime.el (slime-copy-presentation-at-mouse-to-point)
+ (slime-copy-presentation-at-mouse-to-kill-ring): New commands.
+ (slime-menu-choices-for-presentation): Change interface. New
+ menu options, Copy to kill-ring, Copy to point.
+ (slime-presentation-menu): Change call to
+ slime-menu-choices-for-presentation.
+
+2007-03-20 Takehiko Abe <keke(a)gol.com>
+
+ * swank-openmcl.lisp (hash-table-weakness): fix typo
+
+2007-03-14 Christophe Rhodes <csr21(a)cantab.net>
+
+ * slime.el (slime-search-suppressed-forms): handle multiple
+ conditionals on the same line.
+
+2007-02-26 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * swank.lisp (inspect-for-emacs): Add support for inspecting
+ non-decodable float entities like NaNs and infinities.
+
+2007-02-25 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank-backend.lisp (inspect-for-emacs): Remove reference to
+ inexistent argument from docstring.
+
+2007-02-25 Harald Hanche-Olsen <hanche(a)math.ntnu.no>
+
+ * slime.el (slime-init-keymaps): Use vectors when defining keys,
+ because e.g. (define-key (string ?\C-c) ...) doesn't work in the
+ emacs-unicode-2 branch. Some strings are still there.
+
+2007-02-25 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-delete-swank-port-file): Don't use
+ display-warning; that's not available everywhere.
+ (slime-repl-update-banner): Insert the date only if the buffer is
+ empty.
+ (slime-list-compiler-notes): Fetch the notes only if called
+ interactively.
+ (slime-set-query-on-exit-flag): New function, to avoid compiler
+ warnings about obsolete function process-kill-without-query.
+ (slime-defun-if-undefined): Perform the test at runtime not at
+ compile time. Reported by Lennart Staflin.
+
+ * swank.lisp (guess-package): Renamed from
+ guess-package-from-string.
+ (set-package): Use it.
+
+2007-02-22 Juho Snellman <jsnell(a)iki.fi>
+
+ * slime.el (slime-start-lisp): Don't cd if no directory was specified.
+ (slime-maybe-start-lisp): Pass directory argument to slime-start-lisp
+ also in other cond branch.
+ (slime-restart-sentinel): Pass a NIL directory to slime-start-lisp.
+
+2007-02-21 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-start): Added :directory argument and pass it to
+ slime-maybe-start-lisp.
+ (slime-maybe-start-lisp): Added directory argument and pass it to
+ slime-start-lisp (but not slime-reinitialize-inferior-lisp-p)
+ (slime-start-lisp): Added directory argument. Used to set buffer's
+ directory before starting the inferior lisp.
+
+2007-02-17 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-find-tag-if-tags-table-visited): New function.
+ (slime-edit-definition-fallback-function): Offer it as a value
+ for customization.
+
+2007-02-05 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (sldb-insert-locals): Repair presentation markup of
+ frame locals.
+
+2007-02-04 Antonio Menezes Leitao <aml(a)gia.ist.utl.pt>
+
+ * swank-lispworks.lisp (dspec-file-position): Bind
+ *compile-file-pathname*, *compile-file-truename*, *load-pathname*
+ and *load-truename* in dspec-file-position.
+
+2007-02-04 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-write-string): When writing a :repl-result,
+ update the slime-output-end marker for the purpose of asynchronous
+ output (when *use-dedicated-output-stream* is true).
+ Reported by Madhu <enometh(a)meer.net>.
+
+2007-02-03 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-delete-swank-port-file): Fix typo in
+ warning message.
+
+2007-02-02 Marco Baringer <mb(a)bese.it>
+
+ Warn, as opposed to bailing out with an error, when deleting the
+ port file fails. Patch by: Samium Gromoff
+ <_deepfire(a)feelingofgreen.ru>
+
+ * slime.el (slime-delete-swank-port-file): New function.
+ (slime-inferior-connect): Use slime-delete-swank-port-file.
+ (slime-read-port-and-connect): Use slime-delete-swank-port-file.
+
+2007-01-31 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-repl-update-banner): Restore animation.
+ (slime-startup-animation): restore.
+
+2007-01-30 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-complete-symbol-function): Restore old default.
+ (set-keymap-parents): Deleted.
+ (slime-startup-animation): Deleted.
+ (slime-read-from-minibuffer): Don't use defun*.
+ (slime-repl-terminate-history-search): New.
+ (slime-repl-next-matching-input): Use it.
+
+ * slime-autoloads.el: New file.
+
+2007-01-29 Sean O'Rourke <sorourke(a)cs.ucsd.edu>
+
+ * slime.el (slime-start): Continue even if the user, after
+ prompting, didn't recompile the stale .elc file.
+ (slime-urge-bytecode-recompile) [xemacs]: Abort immediately if the
+ user doesn't want to continue.
+ (slime-recompile-bytecode): Don't use byte-compile-warning-types;
+ it may not exist in XEmacs.
+
+2007-01-24 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (sldb-recenter-region): Use count-screen-lines instead
+ of count-lines.
+
+ * swank.lisp (unparse-name): New function.
+ (list-all-package-names): Use it. This fixes a bug related to
+ readtable-case and makes package name completions look prettier.
+ Suggested by Harald Hanche-Olsen <hanche(a)math.ntnu.no>.
+
+2007-01-24 Bill Clementson <billclem(a)gmail.com>
+
+ * slime.el (slime-call-defun): Put the docstring before
+ the (interactive) form so that "C-h f slime-call-defun" will
+ return it.
+
+ * slime.el (slime-scratch-mode-map): Changed parent keymap to
+ lisp-mode-map to prevent unnecessary duplication of slime-mode-map
+ bindings and so that lisp-mode-map key bindings are present in the
+ slime scratch buffer. Change identified by Ariel Badichi.
+
+2007-01-20 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime): Use COMMAND and CODING-SYSTEM parameters
+ Previously they were ignored.
+
+2007-01-17 Christian Lynbech <christian.lynbech(a)ericsson.com>
+
+ * slime.el (slime-init-command): Use expanded files when writing
+ the LOAD form for swank.
+
+2007-01-14 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el: Cleanups for the repl history code.
+ (slime-repl-mode-map): Don't shadow M-C-d.
+ (slime-repl-history-replace): Simplified.
+ (slime-repl-history-search-in-progress-p): New.
+ (slime-repl-position-in-history): If there's no match return
+ out-of-bound positions instead of nil.
+ (slime-repl-add-to-input-history): Never modify the argument.
+ (slime-repl-previous-input): Renamed from
+ slime-repl-previous-input-starting-with-current-input.
+ (slime-repl-next-input): Renamed from
+ slime-repl-next-input-starting-with-current-input
+ (slime-repl-forward-input): Renamed from slime-repl-next-input.
+ (slime-repl-backward-input): Renamed from
+ slime-repl-previous-input.
+ (slime-repl-history-pattern): Renamed from
+ slime-repl-matching-input-regexp.
+ (slime-repl-delete-from-input-history): Simplified.
+
+ (slime-repl-history-map)
+ (slime-repl-history-navigation-neutral-commands)
+ (slime-repl-jump-to-history-item)
+ (slime-repl-previous-or-next-input)
+ (slime-repl-starting-with-current-input-regexp)
+ (slime-repl-continue-search-with-last-pattern)
+ (slime-repl-previous-or-next-matching-input): Deleted.
+
+ (sldb-list-locals, sldb-list-catch-tags): Deleted. Aren't of much
+ use anymore.
+
+2007-01-12 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-clisp.lisp: Better classification on frames on the stack.
+ Make variables in eval frames accessible to the debugger.
+ (frame-type, *frame-prefixes*, frame-to-string, is-prefix-p)
+ (frame-string-type, boring-frame-p): New.
+ (%frame-count-vars, %frame-var-name, %frame-var-value)
+ (frame-venv, next-venv, venv-ref, %parse-stack-values): Replaces
+ old frame-do-venv.
+ (extract-frame-line, extract-function-name, split-frame-string)
+ (string-match): New code to print frames.
+ (frame-locals, frame-var-value): Use the new stuff.
+
+ (inspect-for-emacs): Fix various bugs.
+
+ * swank-loader.lisp (compile-files-if-needed-serially): Don't wrap
+ everything in a compilation unit. If we abort on load errors and
+ it is confusing to see compiler warnings after the abort message.
+ (handle-loadtime-error): CLISP's format implements ~< differently
+ as everybody else, so use a explicit pprint-logical-block instead.
+
+ * swank.lisp (list-all-systems-in-central-registry): Don't
+ reference asdf directly, that leads to read errors in some
+ systems.
+
+2007-01-12 Juho Snellman <jsnell(a)iki.fi>
+
+ * slime.el (slime-read-expression-map): Switch the slime-mode-map
+ and minibuffer-local-map back the way they were. The previous change
+ was made due to a misunderstanding, caused by a keybinding for
+ [(return)] apparently being more specific than one for (kbd "RET"),
+ even when the former is in a parent keymap and the latter in the
+ child.
+
+2007-01-12 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (handle-request): Use 'abort as restart name, but
+ bind *sldb-quit-restart* to the restart returned by find-restart.
+ Also use a slighly friendlier message, because newbies seem to
+ invoke the ABORT restart instead of pressing q in the debugger.
+
+2007-01-12 Edi Weitz <edi(a)agharta.de>
+
+ * slime.el (slime-find-asd): Remove file extension.
+
+ (slime-read-system-name): Use SWANK:LIST-ASDF-SYSTEMS.
+
+ * swank.lisp (list-all-systems-in-central-registry): Use only
+ pathname name.
+
+ (list-all-systems-known-to-asdf): New function.
+
+ (list-asdf-systems): New function.
+
+2007-01-12 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-keys): Remove binding of M-*, restore binding of
+ M-,.
+
+2007-01-11 Edi Weitz <edi(a)agharta.de>
+
+ * slime.el (slime-repl-test-system, slime-repl-test/force-system):
+ New REPL shortcuts. Patch by Kevin Rosenberg
+ <kevin(a)rosenberg.net>.
+
+2007-01-11 Juho Snellman <jsnell(a)iki.fi>
+
+ * slime.el (slime-read-expression-map): restore tab completion in
+ the minibuffer. Switch the slime-mode-map and minibuffer-local-map
+ around, so that the minibuffer binding for return takes precedence
+ over the slime-mode one.
+
+2007-01-11 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (inspect-for-emacs integer): Don't die if the integer
+ can't be expressed as a float. Patch by Ariel Badichi
+ <abadichi(a)bezeqint.net>.
+
+ * slime.el (slime-keys): Removed binding of M-,
+
+2007-01-11 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el: Some cleanups for the debugger code: add some outline
+ sections and docstrings.
+
+ (sldb-setup): Always display the beginning of the condition
+ text. Previously, we always showed the beginning of the backtrace.
+
+ (sldb-prune-initial-frames): Do what the docstring says. Reverted
+ to Luke's version.
+
+ (sldb-dispatch-extras): Fix typo.
+
+ (sldb-insert-restarts, sldb-insert-frames)
+ (sldb-insert-frame, sldb-fetch-more-frames)
+ (sldb-toggle-details, sldb-show-frame-details)
+ (sldb-insert-locals): Simplified.
+ (sldb-frame-details): New.
+
+ (slime-save-coordinates, slime-coordinates)
+ (slime-restore-coordinate, slime-count-lines): New macro and its
+ helpers.
+ (sldb-recenter-region): Renamed from slime-maybe-recenter-region.
+
+ (sldb-enable-styled-backtrace, sldb-show-catch-tags)
+ (sldb-highlight): Deleted. Seem to be obsolete.
+ (sldb-add-face): Removed, because it is now the same as
+ slime-add-face.
+
+ (sldb-help-summary): Deleted. The docstring for sldb-mode is
+ already pretty terse.
+ (define-sldb-face): Renamed from def-sldb-face.
+
+ * swank-sbcl.lisp, swank-cmucl.lisp (condition-extras): Fix typo
+
+2007-01-10 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (*sldb-printer-bindings*): Add *print-right-margin*.
+ (debug-in-emacs): Bind *sldb-printer-bindings* here ...
+ (backtrace, debugger-info-for-emacs, frame-locals-for-emacs):
+ ... and remove redundant bindings here.
+
+2007-01-10 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el: FIX: set-keymap-parents for GNU Emacs was bogus, fixed
+ by Ariel Badichi.
+
+2007-01-09 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-repl-merge-histories): Use (setf (gethash ...)
+ instead of puthash, for Emacs 20.
+
+2007-01-09 Juho Snellman <jsnell(a)iki.fi>
+
+ SBCL 1.0.1.15 supports restart-frame natively, and uses a different
+ debug catch tag interface than earlier versions.
+
+ * swank-sbcl (sbcl-with-restart-frame): New function, detects SBCL
+ 1.0.1.15 or later.
+ (return-from-frame): Another version for 1.0.1.15, using
+ sb-debug:unwind-to-frame-and-call
+ (restart-frame): Another version for 1.0.1.15, using
+ sb-debug:unwind-to-frame-and-call
+
+2007-01-07 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (open-streams): Don't pass nil to make-fn-streams;
+ use a dummy function as workaround. Both arguments must be
+ functions and CMUCL checks the types.
+
+2007-01-06 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el: Added set-keymap-parents when not available (GNU
+ Emacs). Result: slime bindings while reading expressions from the
+ minibuffer.
+
+ * slime.el, swank.lisp: FIX: slime-insert-possibly-as-rectange and
+ sldb stuff on newer emacsen
+
+2007-01-04 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el: Added slime-insert-possibly-as-rectangle and use it
+ when inserting things here and there. The effect of this is that
+ multi-line strings coming from swank (e.g. stuff in sldb) are
+ inserted with insert-rectangle, so they are properly indented.
+
+ * swank.lisp: FIX: sort is destructive, call copy-seq at a few
+ places. FIX: bind *sldb-printer-bindings* also in
+ frame-locals-for-emacs.
+
+2007-01-03 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * swank.lisp: FIX: drop extra "Slots: " from standard-object's
+ inspector presentation
+
+ * swank.lisp: FIX: keyword symbols keep their : when travelling
+ from swank to slime
+
+ * slime.el: FIX: older Emacsen have no line-number-at-pos.
+
+ * slime.el: Convert some minibuffer reading defun's to defun* and
+ use keywords. Support extra arguments.
+
+ * slime.el: Use set-parent-keymaps when available (xemacs only for
+ now) when setting up slime-read-expression-map. The effect of this
+ is that the minibuffer will have all the slime-mode-map keys where
+ minibuffer-local-map is not overriding.
+
+ * slime.el, swank.lisp: Handle better the case when swank can not
+ read anything from the string sent to be inspected. Only bring up
+ the debugger when the inspect command is prefixed.
+
+2006-12-31 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Restore the nested-presentations feature.
+
+ * present.lisp (slime-stream-p): Allow sending presentations to
+ the repl-results stream.
+ (make-presentations-result): Removed.
+ (send-repl-results-to-emacs): New.
+
+ * swank.lisp (connection): New slot repl-results (a stream).
+ (make-output-function-for-target): New.
+ (open-streams): Use it here to also create a stream for REPL results.
+ (initialize-streams-for-connection): Store the stream.
+
+2006-12-29 Edi Weitz <edi(a)agharta.de>
+
+ * slime.el (slime-find-asd, slime-read-system-name): Only offer
+ initial input if system is really in central registry.
+
+2006-12-29 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Simplify the REPL-results protocol. The results are now printed
+ using special :WRITE-STRING events from the Lisp side.
+
+ * slime.el (slime-repl-insert-prompt): Don't insert a result, only
+ the prompt.
+ (slime-repl-insert-result): Removed.
+ (slime-repl-eval-string, slime-repl-show-abort)
+ (slime-repl-set-package, slime-output-buffer)
+ (slime-repl-update-banner): Change all callers.
+ (slime-dispatch-event): Event :WRITE-STRING gets an
+ optional argument TARGET, which controls where the string is
+ inserted.
+ (slime-write-string): Handle targets NIL (regular process output)
+ and :REPL-RESULT.
+
+ * swank.lisp (make-presentations-result): Removed.
+ (send-repl-results-to-emacs): New function, sends :WRITE-STRING events.
+ (listener-eval): Use it here instead of make-presentations-result.
+
+2006-12-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Performance improvement for slime-autodoc-mode, in particular when
+ there are REPL results that are long lists.
+
+ * slime.el (slime-repl-mode-beginning-of-defun)
+ (slime-repl-mode-end-of-defun): New.
+ (slime-repl-mode): Use them as beginning-of-defun-function and
+ end-of-defun-function.
+ (slime-enclosing-operator-names): Bind
+ parse-sexp-lookup-properties to nil, don't parse more than 20000
+ characters before point, don't determine exact argument positions
+ larger than 64. Byte-compile this function.
+
+2006-12-24 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el, swank.lisp: Added customizable dwim lookup hook
+ support for inspect
+
+ * doc/slime.texi: Small doc fixes by Alfredo Beaumont
+
+ * swank.lisp: Change the order to [set value] [make unbound]. Sort
+ slot names in the inspector
+
+2006-12-23 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank-clisp.lisp (make-weak-key-hash-table)
+ (make-weak-value-hash-table): Implement for CLISP, so that the
+ REPL results history does not cause "memory leaks".
+
+ * slime.el (slime-inspect): Add a dwim-mode keyword argument, move
+ all input handling into the interactive spec. Restore the
+ behavior of slime-inspect when point is within a presentation (no
+ prompting, no DWIM).
+ (slime-inspect-presentation-at-mouse): Don't do DWIM here, so the
+ presentation-retrieval expression does not end up on the inspector
+ stack.
+ (slime-inspector-position): New.
+ (slime-inspector-operate-on-point, slime-inspector-reinspect): Use
+ it here to make it work on GNU Emacs too.
+ (slime-open-inspector): Fix row-col addressing at end of buffer.
+
+2006-12-20 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el: FIX: inspecting presentations from the right click
+ menu broke in the inspect refactor
+
+ * slime.el: FIX: slime-fuzzy-target-buffer-completions-mode's
+ keymap must always precede other keymaps
+
+ * slime.el, swank.lisp: Extend :write-string with and &optional
+ presentation id and use this in present-in-emacs
+
+ * swank.lisp: Added present-in-emacs that prints a presentation of
+ the given object in the repl
+
+ * swank.lisp: Return the inspected object when inspecting from the
+ lisp side.
+
+ * swank.lisp: Turn off right margin for restart printing, too
+
+2006-12-19 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * HACKING: Added useful init.el piece into HACKING about
+ update-change-log
+
+ * swank.lisp: In all-slots-for-inspector pad slot names to be
+ equal length, so the result is more readable
+
+ * slime.el: Fix slime-insert-presentation to handle multi-line
+ presentations better (use insert-rectangle)
+
+ * swank.lisp: Properly bind *sldb-printer-bindings* and turn off
+ right margin while printing stuff in sldb
+
+ * slime.el: Smarten up the sldb heuristic that drops swank frames
+
+ * swank-allegro.lisp, swank-backend.lisp, swank-openmcl.lisp,
+ swank-sbcl.lisp, swank.lisp: Added hash-table-weakness and use it
+ in hash-table-inspecting
+
+ * swank.lisp: Hashtable inspecting: added [clear hashtable]
+ and [remove entry] actions
+
+ * slime.el, swank.lisp: FIX dwim inspecting to handle (setf
+ some-fun) functions, too
+
+ * slime.el: FIX: slime-sexp-at-point for foo::|bar::baz|
+
+ * slime.el: FIX: Properly keep track of slime-buffer-package in
+ the inspector
+
+ * swank.lisp: Small: get rid of notes and warnings
+
+ * slime.el, swank.lisp: Added dwim-mode to slime-inspect that
+ tries to be smart unless prefixed
+
+ * slime.el: Make slime-fuzzy-complete-symbol the default in the
+ belife that it's better for new users
+
+ * swank.lisp: Add (expt 1.2 length) higher scores for longer
+ matches in fuzzy completion. A good example: puts "make-instance"
+ before "make-string-input-stream" while completing "make-ins"
+
+ * slime.el: Set slime-fuzzy-completion-in-place enabled by default
+
+ * slime.el: Added (cons row col) addressing to
+ slime-open-inspector, use in slime-inspector-operate-on-point
+
+ * slime.el: FIX: operate the inspector in the debug thread when
+ started from sldb
+
+ * slime.el: Convert some inspector defuns to defun* and use
+ keywords. Other minor cleanups.
+
+2006-12-18 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-region-for-defun-at-point): end-of-defun and
+ beginning-of-defun modify match-data, added a save-match-data to
+ prevent this from affecting callers of
+ slime-region-for-defun-at-point.
+
+2006-12-15 Edi Weitz <edi(a)agharta.de>
+
+ * swank-lispworks.lisp (make-weak-key-hash-table): Weak hash
+ tables for Lispworks.
+ (make-weak-value-hash-table): Ditto.
+
+2006-12-14 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (*sldb-printer-bindings*): *PRINT-LINES* is in
+ effect only if *PRINT-PRETTY* is non-NIL, so it better to enable
+ the pretty printer. Suggested by Madhu <enometh(a)meer.net>.
+
+ * slime.el (slime-expand-abbreviations-and-complete): Emacs
+ `choose-completion' (choosing a completion from the *Completions*
+ buffer) always replaces text upto (point). So the code which
+ figures out an `unambiguous-completion-length' and places the
+ point there in `slime-expand-abbreviations-and-complete' causes
+ problems: the replacement text gets garbled. Get rid of the bogus
+ `unambiguous-completion-length'. Patch by Madhu <enometh(a)meer.net>
+
+ * swank-cmucl.lisp (remove-gc-hooks): The variables
+ EXT:*GC-NOTIFY-AFTER* and EXT:*NOTIFY-BEFORE* should hold
+ functions and should be NIL. This affects the function
+ REMOVE-GC-HOOKS in swank-cmucl.lisp which sets them to
+ NIL, (should one happen to use it). Set them back to the original
+ parameters. Patch by Madhu <enometh(a)meer.net>
+
+ * slime.el (slime-repl-output-mouseover-face): Fix a pair of extra
+ parens. Patch by Madhu <enometh(a)meer.net>
+
+2006-12-14 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-search-buffer-package): Remove Xemacs special
+ casing. There's already a compatibility defun for
+ match-string-no-properties.
+
+2006-12-13 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * swank.lisp: FIX: fuzzy completion for M-V-B. Fix by Madhu.
+
+2006-12-12 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * swank.lisp (inspect-for-emacs integer): Pad the hex formatted
+ value to eight digits, "Code-char:" instead of "Corresponding
+ character:", "Integer-length:" instead of "Length:",
+ "Universal-time:" instead of "As time".
+ (inspect-object): Use TYPE-FOR-EMACS instead of TYPE-OF.
+ (inspect-in-emacs): New function, analogous to ED-IN-EMACS.
+
+ * swank-backend.lisp (type-for-emacs): New generic function,
+ defaults to TYPE-OF for non-integers, and returns FIXNUM or BIGNUM
+ for integers.
+
+ * slime.el (destructure-case): Indicate in the error message that
+ it was the Elisp destructure-case that failed to avoid confusion.
+ (slime-check-eval-in-emacs-enabled): More verbose error message.
+
+2006-12-11 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * swank.lisp: Added [set value] command for slot inspecting
+
+ * slime.el: Work on repl history navigation, restore old M-p/M-n
+ behaviour due to #lisp demand
+
+ Also print the current regexp in the minibuffer messages. M-p/M-n
+ takes the repl input up to the point not the entire input as it
+ did before.
+ slime-repl-previous/next-input-starting-with-current-input: new
+ names for the old M-p/M-n commands History navigation commands
+ jump to the end of buffer when point is before the prompt.
+
+ * slime.el: Fix/smarten up temp-buffer-quit
+
+ Now it tries its best to remember the original window config and
+ restore it at slime-temp-buffer-quit unless it was changed
+ meanwhile. IOW, fix "q" after macroexpand in a macroexpand buffer
+ not closing the temp window.
+ Also fix the compiler notes usage of the temp buffer.
+
+ * swank-backend.lisp, swank.lisp:
+ Added inspect-slot-for-emacs to let users customize it.
+
+ Use all-slots-for-inspector everywhere, render link to both the
+ effective and direct slots when both are available. Dropped
+ slot-value-using-class-for-inspector and friends. Added
+ slot-makunbound-using-class to the swank-mop package and added
+ a [make-unbound] action to the standard slot presentation.
+
+ * slime.el: FIX: slime-symbol-name-at-point for symbols like
+ foo::|bar::baz|
+
+ * .cvsignore, swank.lisp: FIX: Drop #\. and add #\, to escaped
+ symbol chars
+
+ * slime.el: Added slime-repl-delete-from-input-history that
+ deletes the current history entry when no input is supplied
+
+ * slime.el: slime-repl-kill-input kills the entire input when
+ point is at the prompt and resets the history navigation state
+
+ * slime.el:
+ Use a hashtable to remove duplicates in slime-repl-merge-histories
+
+2006-12-07 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (init-inspector): Added eval parameter. If NIL we
+ don't eval FORM but limit our selves to cl:read'ing it and
+ inspecting that value.
+
+ * slime.el (slime-inspect): If a prefix argument is provided pass
+ :eval nil to swank:init-inspector.
+
+2006-12-07 Paul Collins <paul(a)briny.ondioline.org>
+
+ * hyperspec.el (common-lisp-hyperspec): Strip all text properties
+ from the symbol-at-point to avoid problems with read-only text.
+
+2006-12-06 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-search-buffer-package): Don't call
+ match-string-no-properties if it's not defined (as is on some
+ xemacs')
+ (slime-repl-clear-buffer): Added optional prefix argument
+ specifying how many lines to leave.
+
+2006-12-06 Johan Bockg�rd <bojohan+sf(a)dd.chalmers.se>
+
+ * swank.lisp (fuzzy-completion-set): Don't mix for clauses and
+ body clauses in loop.
+
+2006-12-05 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (create-swank-server): Removed. Use create-server
+ instead.
+
+ * slime.el (slime-first-change-hook): Don't do anything if buffers
+ file doesn't exist.
+ (slime-start, slime-set-connection-info): Add support for a
+ :init-function which is called after the usual initialization of the
+ connection is completed.
+
+ * swank-source-file-cache.lisp (buffer-first-change): Always
+ return nil and remove the now redundant test with probe-file.
+
+ * swank-backend.lisp (guess-external-format): Return nil if the
+ file can't be opened. Previusly we wrongly read from stdin.
+
+2006-12-05 Juho Snellman <jsnell(a)iki.fi>
+
+ Real xref support for SBCL (requires SBCL 1.0.0.18).
+
+ * swank-sbcl.lisp (who-calls): New function, fetch xref data from
+ sb-introspect.
+ (who-binds): Ditto.
+ (who-sets): Ditto.
+ (who-references): Ditto.
+ (who-macroexpands): Ditto.
+ (defxref): New macro, create the above functions.
+ (source-location-for-xref-data): New, map from sb-introspect xref
+ format to the Swank xref format.
+ (sanitize-xrefs): Map PCL method names to something more readable.
+ (string-path-snippet): New function, finds a more accurate source
+ snippet for definition source locations which have both an
+ :emacs-string and a full source path available. Otherwise the xref
+ location would point to the toplevel form rather than the exact
+ form for functions compiled with C-c C-c.
+ (source-file-position): New function, somewhat like
+ source-path-file-position but uses the source-file cache, handles
+ missing form-paths more gracefully.
+ (make-definition-source-location): Use the above two functions.
+ (sbcl-with-xref-p): New function, detect whether SBCL has xref support
+ for backwards compability.
+
+2006-11-26 Juho Snellman <jsnell(a)iki.fi>
+
+ * swank-source-file-cache.lisp (buffer-first-change): Check
+ whether a file exists before trying load it into the source cache.
+
+2006-11-26 Juho Snellman <jsnell(a)iki.fi>
+
+ Restore the way M-n and M-p used to work in the REPL. (cherry-picked
+ from a patch with other changes, sent by Attila Lendvai).
+
+ * slime.el (slime-repl-previous-input-starting-with-current-input)
+ (slime-repl-next-input-starting-with-current-input): New functions,
+ work like the old slime-repl-previous-input / next-input.
+ (slime-repl-matching-input-regexp): Restore old version.
+ (slime-repl-mode-map): Bind s-r-p-i-s-w-c-i and s-r-n-i-s-w-c-i
+ to M-p and M-n respectively. slime-repl-previous-input and
+ slime-repl-next-input are still accessible with C-up / C-down.
+
+2006-11-25 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-repl-read-break): Use a :emacs-interrupt message
+ instead of a RPC to swank:simple-break. Suggested by Taylor R
+ Campbell.
+
+2006-11-24 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-search-buffer-package): Prettify the package
+ name if it is written as string or keyword.
+
+2006-11-23 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-in-expression-p): Use `read' and `eq' to test
+ the first element of the list. Previuosly, the pattern (foo)
+ wrongly matched (foobar) because we used (looking-at <symbol>).
+
+ * swank-cmucl.lisp (setf-definitions): Also include defs which
+ were created with (defun (setf NAME) ...). Previously we only
+ found definitions created with defsetf or define-setf-expander.
+
+2006-11-22 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-edit-definition): Don't hide error messages.
+
+2006-11-21 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (*coding-system*): "Coding systems" are now strings
+ instead of keywords.
+
+2006-11-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-compile-file): Let the Lisp side choose the
+ coding system.
+ (slime-coding): Deleted.
+
+ * swank.lisp (compile-file-for-emacs): Use guess-external-format.
+ (swank:create-server): no more accepts an :external-format 'enc ,
+ use :coding-system "enc" instead.
+
+ * swank-backend.lisp (find-external-format)
+ (guess-external-format): New.
+ (swank-compile-file): The external-format argument is now a
+ backend specific value returned by find-external-format.
+
+ * swank-cmucl.lisp, swank-sbcl.lisp, swank-clisp,
+ swank-lispworks.lisp, swank-allegro.lisp, swank-corman.lisp,
+ swank-ecl.lisp, swank-scl.lisp, swank-abcl.lisp, swank-openmcl:
+ Update implementations accordingly.
+
+ * swank-source-file-cache.lisp (read-file): Use guess-external-format.
+
+ * swank.lisp (*swank-wire-protocol-version*): Is now initialized
+ by the loader.
+ (wire-protocol-version): Removed, because it contained a reference
+ to swank-loader::*source-directory*.
+
+ * slime.el (slime-set-connection-info): On protocol version
+ mismatch, ask the user how to proceed.
+ (slime-protocol-version): New variable. Initialize it at compile
+ time to detect stale elc files.
+
+ * swank-loader.lisp (load-swank): Set the protocol version.
+
+2006-11-12 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-make-tramp-file-name): Added (require 'tramp)
+ since tramp-make-tramp-file-name is not an autoloaded function.
+
+2006-11-07 Edi Weitz <edi(a)agharta.de>
+
+ * slime.el (slime-fuzzy-completion-time-limit-in-msec): Escaped
+ left parenthesis in doc string.
+
+2006-11-05 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-complete-keywords-contextually): Unused
+ variable, removed.
+
+2006-11-05 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (sldb-sexp-highlight-mode): Remove bloat.
+
+2006-11-04 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Support nested presentations in REPL results, when present.lisp is
+ loaded.
+
+ * swank.lisp (make-presentations-result): New, factored out from
+ listener-eval.
+ (listener-eval): Use it here.
+
+ * present.lisp (make-presentations-result): Override it here.
+
+2006-11-03 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (all-slots-for-inspector): Added declare ignore for
+ unused argument inspector (openmcl warns about this). Reindented.
+
+2006-11-01 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el (sldb-sexp-highlight-mode): New custom.
+ (slime-handle-repl-shortcut): Trigger slime-lookup-shortcut when
+ the point is anywhere before slime-repl-input-start-mark. IOW,
+ you can press "," anywhere before the prompt.
+ (slime-edit-definition): Handle the case when there are only such
+ entries returned from swank that have errors.
+ (slime-read-from-minibuffer): Allow overriding of the keymap.
+ (slime-repl-previous-matching-input): Similar behaviour like
+ isearch-forward.
+ (slime-repl-next-matching-input): Ditto. In more details: You can
+ freely navigate with slime-repl-previous/next-input with M-p and
+ M-n at any time among the history entries. When M-r is pressed,
+ which invokes slime-repl-previous-matching-input, the the
+ minibuffer is activated to read the regexp to search for and the
+ contents will default to the current repl input. Pressing M-r
+ again will start searching with the last pattern used no matter
+ what the content of the minibuffer is. Subsequent invocations of
+ M-r get the next match, and of course the same applies for M-s,
+ which is slime-repl-previous-matching-input.
+
+ * swank.lisp (fuzzy-completion-set): Fix on clisp.
+ (convert-fuzzy-completion-result): Fix symbol fbound and other
+ annotations.
+ (slot-value-using-class-for-inspector): New.
+ (slot-boundp-using-class-for-inspector): New.
+ (inspect-for-emacs): Use the special slot access methods so that
+ it's possible to customize the inspecting of complex
+ slots (e.g. computed-class at
+ http://common-lisp.net/project/computed-class/).
+ (all-slots-for-inspector): Converted to generic method.
+
+2006-11-01 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (*swank-wire-protocol-version*): Use a defvar to
+ declare the existence of tihs variable to the lisp (Reported by:
+ Jonathon McKitrick <jcm(a)FreeBSD-uk.eu.org>).
+
+2006-10-30 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (*dont-close*): New variable.
+ (defpackage :swank): Export *dont-close*.
+ (start-server, create-server): Use *dont-close* as the default
+ value of the :dont-close parameter.
+ (connection-info): Send the wire-protocol-version (supplied by the
+ swank-version.el file) to slime when connecting.
+ (wire-protocol-version): New function.
+
+ * slime.el (slime-global-variable-name-regexp): New variable.
+ (slime-global-variable-name-p): Use
+ slime-global-variable-name-regexp.
+ ("swank-version"): Load swank-version.el to get the wire protocol
+ version.
+ (slime-set-connection-info): Check the wire protocol version.
+
+2006-10-30 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-global-variable-name-p): Oops... need to handle
+ very long strings.
+
+2006-10-29 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el (slime-global-variable-name-p): Use defun* instead of
+ defun.
+
+2006-10-29 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-global-variable-name-p): Simplified.
+
+2006-10-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Add completion for character names.
+
+ * slime.el (slime-completions-for-character): New.
+ (slime-contextual-completions): Use it here.
+
+ * swank-backend.lisp (character-completion-set): New interface.
+
+ * swank-allegro.lisp (character-completion-set): Implement it.
+
+ * swank.lisp (completions-for-character): New slimefun.
+ (compound-prefix-match/ci/underscores)
+ (longest-completion/underscores, tokenize-completion/underscores)
+ (untokenize-completion/underscores): New functions.
+
+2006-10-28 Ivan Toshkov <ivan(a)toshkov.org>
+
+ * hyperspec.el: Missing Hyperspec links for ~| and ~~
+
+2006-10-27 Ivan Toshkov <ivan(a)toshkov.org>
+
+ * hyperspec.el: Missing Hyperspec links for ~% and ~&
+
+2006-10-27 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * swank-sbcl.lisp (make-weak-key-hash-table): Restore support
+ for older SBCLs without weak hash-tables.
+ (make-weak-value-hash-table): Ditto.
+
+2006-10-26 Utz-Uwe Haus <haus+slime(a)mail.math.uni-magdeburg.de>
+
+ * swank-allegro.lisp (sldb-break-at-start): Implement.
+
+2006-10-26 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el (slime-setup-command-hooks): Use make-local-hook.
+ (slime-repl-mode): Ditto.
+ (slime-fuzzy-choices-buffer): Ditto.
+ (sldb-mode): Ditto.
+ (slime-fuzzy-completion-limit): New variable.
+ (slime-fuzzy-completion-time-limit-in-msec): New variable.
+ (slime-fuzzy-next): Fix when at the end of the buffer.
+ (completion-output-symbol-converter): New to handle escaped
+ symbols for those who need to mess around with symbols like
+ layered-function-definers::|CONTEXTL::SLOT-VALUE-USING-LAYER|.
+ When a symbol is escaped then completion is case sensitive.
+ (completion-output-package-converter): New.
+ (mimic-key-bindings): New to easily define bindings by first
+ trying to look up bindings for an operation and only use the
+ provided default bindings if nothing was found in the source
+ keymap. Use it to set up fuzzy bindings. (Hint: if you have keys
+ like previous-line customized, then only load slime after they
+ have been set, and the fuzzy mode will mimic them.)
+ (slime-temp-buffer-quit): Always close the opened window, updated
+ docstring. Also made the fuzzy maps smarter, they now try to look
+ up keys with 'where-is-internal and map the functions on them.
+
+ * swank-sbcl.lisp
+ (make-weak-value-hash-table): New for sbcl.
+ (make-weak-key-hash-table): New for sbcl.
+
+ * swank.lisp (fuzzy-completions and friends): Added :limit and
+ :time-limit-in-msec keyword params. Used vectors instead of lists
+ that nearly doubled its speed (at least on sbcl). Also added some
+ declare optimize and type annotations.
+ (do-symbols*): New, uses a hash-table to visit only non-seen
+ symbols. Replaced various uses of do-symbols where it was
+ appropiate.
+
+2006-10-26 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-global-variable-name-p): Use a custom 'parser'
+ instead of string-match to avoid regexp overflow errors on very
+ long strings.
+
+2006-10-21 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-lispworks.lisp (initialize-multiprocessing): Don't init
+ MP if it is already running.
+
+ * test.sh: Run Emacs in Screen.
+
+2006-10-20 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-backend.lisp, swank-cmucl.lisp:
+ (startup-idle-and-top-level-loops): Deleted. Merged into
+ initialize-multiprocessing.
+
+2006-10-20 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el (slime-fuzzy-choices-buffer): Added kill-buffer-hook to
+ the completion buffer to slime-fuzzy-abort, so we get out from the
+ completion mode and key maps when the completion buffer is closed.
+
+2006-10-20 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-target-buffer-fuzzy-completions-map): Fix a bug
+ I introduced when applying levente's patch.
+
+2006-10-20 Martin Simmons <martin(a)lispworks.com>
+
+ * swank-backend.lisp (initialize-multiprocessing): New API to
+ support lisps where initialize-multiprocessing may not return (lispworks).
+
+ * swank.lisp (start-server): initialize-multiprocessing's API has changed.
+
+ * swank-lispworks.lisp (initialize-multiprocessing): Update for new API.
+
+ * swank-cmucl.lisp (initialize-multiprocessing): Update for new API.
+
+ * swank-allegro.lisp (initialize-multiprocessing): Update for new api.
+
+2006-10-20 Levente M�sz�ros <levente.meszaros(a)gmail.com>
+
+ Added "in-place" fuzzy completion GUI. See
+ slime-fuzzy-completions-map and
+ slime-target-buffer-fuzzy-completions-map for details.
+
+ * slime.el (slime-fuzzy-completion-in-place): New variable.
+ (slime-target-buffer-fuzzy-completions-mode): New keymap for
+ in-place fuzzy completions.
+ (slime-fuzzy-target-buffer-completions-mode): New minor mode for
+ in-place fuzzy completions.
+ (slime-fuzzy-current-completion-overlay): New overlay for
+ highlighting currently selected completion.
+ (slime-fuzzy-completions-map): Added new fuzzy completon keys
+ (slime-fuzzy-indent-and-complete-symbol): New function.
+ (slime-fuzzy-complete-symbol): Use new in-place fuzzy completion.
+ (slime-fuzzy-choices-buffer): Support in-place completion editing.
+ (slime-fuzzy-fill-completions-buffer): Highlight completions,
+ don't automatically jump to completion buffer.
+ (slime-fuzzy-enable-target-buffer-completions-mode,
+ slime-fuzzy-disable-target-buffer-completions-mode): New modes for
+ moving in/out of in-place fuzzy completion mode
+ (slime-fuzzy-next, slime-fuzzy-prev): Don't assume point is in the
+ completion buffer.
+ (slime-fuzzy-dehighlight-current-completion,
+ slime-fuzzy-highlight-current-completion): Manage completion
+ selection highlighting.
+ (slime-fuzzy-select-or-update-completions): New function.
+ (slime-fuzzy-process-event-in-completions-buffer): New function.
+ (slime-fuzzy-select-and-process-event-in-target-buffer): New function.
+ (slime-fuzzy-done): Changed to deal with in-place completion.
+
+2006-10-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-backend.lisp (ignored-xref-function-names): Deleted.
+
+ * swank.lisp (guess-package-from-string): Remove special case for
+ "#.". parse-package will handle that just fine.
+ (find-definitions-for-emacs): Don't filter errors out.
+ (sanitize-xrefs): Moved to swank-sbcl. The backend is supposed to
+ return sane values.
+
+ * swank-sbcl.lisp: See above.
+
+ * slime.el (slime-find-buffer-package): Simplify.
+
+2006-10-17 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-accept-process-output): The timeout arg can be
+ nil. Handle that case.
+
+2006-10-17 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime.el (slime-find-buffer-package): Handle #. forms.
+
+ * swank.lisp (guess-package-from-string): Handle #. forms.
+ (inspect-for-emacs standard-class): Handle non-string
+ :documentation slot contents.
+
+ * swank-sbcl.lisp (inspect-for-emacs weak-pointer ...): Added
+ method.
+
+2006-10-16 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (sldb-activate): Get debug-info from the correct
+ thread. Fixes bug reported by Dan Weinreb <dlw(a)itasoftware.com>.
+ (unwind-to-previous-sldb-level): New test.
+ (slime-init-command): Send a single form.
+ (slime-insert-presentation): Honor slime-repl-enable-presentations.
+ Presentations kill SLDB and the inspector in Emacs 20 (besides
+ being troublesome GC-wise).
+
+ * swank.lisp: Clean up global IO redirection.
+ (setup-stream-indirection): Turn macro into a
+ function and delay initialization after user init files are
+ loaded, so that we do nothing if *globally-redirect-io* is nil.
+ (*after-init-hook*, run-after-init-hook)
+ (init-global-stream-redirection): New.
+
+ (parse-symbol-or-lose): Lose loudly and early (instead of failing
+ silently).
+
+ * swank-loader.lisp: Abort on compile-time or load-time errors.
+ Don't try to load the source-file if COMPILE-FILE's 3rd return
+ value is true (it's true even for warnings).
+ (handle-loadtime-error): New function.
+
+ Run the after-init-hook.
+
+ * swank-cmucl.lisp (inspect-for-emacs): Don't break for
+ simple-strings.
+
+2006-10-11 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-presentation-syntax-table): New.
+ (slime-add-presentation-properties): Install it in a syntax-table
+ text property, so that #<...> is balanced in a presentation.
+ (slime-remove-presentation-properties): Remove the text property.
+ (slime-repl-mode): Respect the syntax text properties of
+ presentations in REPL buffers.
+
+2006-10-09 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (completions-for-keyword): Look up the operator names
+ in the right package. Return nil (rather than signalling an
+ error) when no valid operator name is present.
+
+2006-10-08 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank-loader.lisp (lisp-version-string) [allegro]: Distinguish
+ between 32-bit and 64-bit version on the SPARC architecture.
+
+2006-10-03 Marco Baringer <mb(a)bese.it>
+
+ Change license statement to say that all files without an explicit
+ copyright notice are public domain. This change will allow SLIME
+ to moved out of debian's nonfree tree.
+
+ * README: Update license statement.
+
+2006-10-02 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-highlight-compiler-notes): New variable.
+ (slime-compilation-finished): Only highlight notes when
+ slime-highlight-compiler-notes is non-NIL.
+
+2006-09-28 Marco Baringer <mb(a)bese.it>
+
+ * swank-loader.lisp (compile-files-if-needed-serially): Don't
+ ignore compile-time errors but drop into a debugger (it's not a
+ slime debugger but it's certainly better than ignoring the error).
+
+2006-09-27 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (*globally-redirect-io*): Change default value to T.
+
+2006-09-25 Juho Snellman <jsnell(a)iki.fi>
+
+ Fix Slime on SBCL 0.9.17.
+
+ * swank-backend.lisp (ignored-xref-function-names): New interface
+
+ * swank.lisp (sanitize-xrefs): Use ignored-xref-function-names
+ instead of having a #+sbcl special case.
+
+ * swank-sbcl.lisp (ignored-xref-function-names): Implement.
+ Filter out SB-C::STEP-VALUES, not just SB-C::STEP-FORM, as done by
+ the old sanitize-xrefs. Don't implement the interface at all if
+ SBCL is sufficiently new (those symbols don't exist any more, and
+ there's nothing in their place to be ignored).
+
+2006-09-21 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (find-definitions-for-emacs): Don't return locations
+ whose CAR is :error.
+ (xref): Process whatever is returned by the various xref functions
+ with the new sanitize-xrefs functions.
+ (sanitize-xrefs): Clean up the list of xrefs to remove duplicates.
+ Patch by Dan Weinreb <dlw(a)itasoftware.com>
+
+ * slime.el (slime-goto-first-note-after-compilation): New
+ variable. This controls the behaviour of (next|prev)-note
+ immediatly after a slime-compile-and-load-file.
+ (slime-compilation-just-finished): New variable.
+ (slime-compilation-finished): Update slime-compilation-finished.
+ (slime-next-note, slime-previous-note): Respect
+ slime-compilation-just-finished.
+ (slime-autodoc-use-multiline-p): Specify the type.
+ (slime-repl-grab-old-input): Typo in docstring.
+ (slime-cheat-sheet): Deal with multiple-bindings
+ (slime-cheat-sheet-table): Update as per #lisp's suggestions.
+
+2006-09-20 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-cheat-sheet): New function.
+ (slime-cheat-sheet-table): New variable which specifies what the
+ cheat sheet should list.
+ (slime-read-package-name): Set require to T in the call to
+ completing read, it doesn't make any sense to switch to an
+ inexistent package.
+
+ * doc/slime.texi: Added "Tips and Tricks" chapter (need a better
+ name for this).
+
+ * swank-sbcl.lisp (fallback-source-location): Use abort-request
+ instead of error.
+ (locate-compiler-note): Say, in the error message, what data
+ caused the error.
+
+2006-09-20 Juho Snellman <jsnell(a)iki.fi>
+
+ * swank-sbcl.lisp (call-with-debugger-hook): use INVOKE-STEPPER
+ instead of calling the stepper hook manually
+
+2006-09-19 Juho Snellman <jsnell(a)iki.fi>
+
+ * swank-sbcl.lisp (call-with-debugger-hook): make the stepper
+ also work with a threaded SBCL, by binding a handler for
+ sb-ext:stepper-condition instead of relying on the one that SBCL
+ establishes on the toplevel
+
+2006-09-19 Juho Snellman <jsnell(a)iki.fi>
+
+ Extend the stepper protocol to work nicely with the SBCL stepper.
+
+ If sldb is invoked on a condition that's sldb-stepper-condition-p,
+ the sldb functions sldb-step, sldb-next and sldb-out will invoke
+ the matching backend functions for stepping into the stepped form,
+ to the next form, or out of the current function. Otherwise the
+ functions will behave like sldb-step used to (call active-stepping and
+ select the continue restart).
+
+ * swank-backend.lisp (sldb-stepper-condition-p, sldb-step-into,
+ sldb-step-next, sldb-step-out): New interface functions
+
+ * swank-sbcl.lisp (activate-stepper, condition-extras,
+ sldb-stepper-condition-p, sldb-step-into, sldb-step-next,
+ sldb-step-out): Implemented (conditional on CVS SBCL)
+ (call-with-debugger-hook): bind sb-ext:*stepper-hook* to
+ a function that binds *stack-top-hint* and invokes the debugger
+ (conditional on CVS SBCL)
+
+ * swank.lisp (define-stepper-function): new macro for defining
+ stepper-related functions, since they all follow the same form
+ (sldb-step): redefine with define-stepper-function
+ (sldb-next, sldb-out): new functions
+ (*sldb-stepping-p*): typo in docstring
+
+ * slime.el (sldb-next, sldb-out): New commands
+ (sldb-mode-map): bind sldb-next to "x" and sldb-out to "o"
+
+2006-09-18 Dan Weinreb <dlw(a)itasoftware.com>
+
+ For those cases where SLIME can't complete a user request (like
+ loading an asdf system without asdf or describing an inexistent
+ symbol) instead of signaling an error SWANK should politely inform
+ the user and return normally.
+
+ * swank.lisp (eval-for-emacs): Handle request-abort conditions.
+ (decode-keyword-arg, get-repl-result, parse-symbol-or-lose): Use
+ abort-request instead of error.
+
+ * swank-backend.lisp (request-abort): New condition.
+ (abort-request): Convenience function for signaling request-abort
+ conditions.
+ (operate-on-system): Use abort-request instead of error
+ (:swank-backend): Export the symbols abort-request and
+ request-abort.
+
+ * slime.el (slime-rex): Update docstring.
+ (slime-eval, slime-eval-async): Added new REASON parameter sent
+ along with :abort message.
+
+2006-09-14 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * swank-scl (arglist, function-arglist, spawn): update for the SCL.
+
+2006-09-13 Brandon Bergren <bdragon(a)mailsnare.net>
+
+ * slime.el (slime-filename-translations): Fix docstring
+
+2006-09-13 Bob Halley <halley(a)play-bow.us>
+
+ * swank.lisp (format-iso8601-time): Properly handle non integer
+ time zones.
+
+2006-09-13 Taylor R Campbell <campbell(a)mumble.net>
+
+ * slime.el (slime-init-output-buffer): Initial directory and
+ package stacks should be empty.
+ (slime-repl-push-package): Push the current package, as opposed to
+ the new package, and set the new package to whatever the user
+ specified.
+ (slime-repl-pop-package): Set the current package to the top of
+ the package stack, unless it's empty.
+
+2006-09-13 Daniel Koning <dkoning(a)seas.smu.edu>
+
+ * slime.el (slime-repl-disconnect): New repl shortcut.
+
+2006-09-13 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-open-inspector): Added a slime-part-number
+ property to the topline so that you can slime-inspector-copy-down
+ the object being inspected. There are some cases where we have an
+ object in the inspector and we'd like to dump it to the repl but
+ we can't get at it through other means (like in back-traces).
+ (slime-insert-xrefs): Specify which file the item is in (when that
+ information is available).
+
+ * swank.lisp (format-arglist-for-echo-area): Instead of using
+ let+first+rest to destructure a form use destructuring-bind.
+ (lookup-presented-object): Added (declare (special
+ *inspectee-parts*)) to silence openmcl's compiler.
+ (inspect-object): Generate, and send to emacs, an ID for the
+ object being inspected.
+
+2006-09-01 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * slime.el (slime-repl-matching-input-regexp): Use the portion
+ between slime-repl-input-mark and point for history search, not
+ the entire input. Patch by Ivan Shvedunov.
+
+ * swank-sbcl.lisp: Declaim SB-C:INSERT-STEP-CONDITIONS 0 for to
+ hide Swank while stepping and avoid endless mutex-acquisition
+ loops.
+
+2006-08-27 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (input-available-p, process-available-input): Use
+ READ-CHAR-NO-HANG instead of LISTEN because LISTEN suddenly
+ returns false in SBCL 0.9.?? even if we are called from a
+ fd-handler and the OPEN-STREAM-P returns true.
+
+2006-08-26 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-repl-return-behaviour): Fix the defcustom type,
+ so Emacs 21.3 does not signal an error when creating a
+ customization buffer containing this variable.
+
+2006-08-25 Kai Kaminski <kai.kaminski(a)gmx.de>
+
+ * swank.lisp (lookup-presented-object): Fix for OpenMCL 1.0
+ [ppc32], which requires that the :NO-ERROR clause is last in
+ HANDLER-CASE.
+
+2006-08-24 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-ensure-presentation-overlay): Provide a
+ help-echo for presentations, showing the mouse bindings.
+ (slime-presentation-around-click): New function.
+ (slime-copy-or-inspect-presentation-at-mouse)
+ (slime-inspect-presentation-at-mouse)
+ (slime-copy-presentation-at-mouse)
+ (slime-describe-presentation-at-mouse)
+ (slime-pretty-print-presentation-at-mouse): New commands.
+ (slime-copy-presentation-at-point): Removed (misnomer).
+ (slime-presentation-map): Bind mouse-2 to
+ slime-copy-or-inspect-presentation-at-mouse, so the right thing is
+ done in REPL buffers and in Inspector and Debugger buffers.
+ (slime-menu-choices-for-presentation): Use the new commands here
+ instead of inline lambdas.
+ (sldb-inspect-in-frame): Use slime-read-object here, so if point
+ is in a presentation in the debugger buffer, inspect it
+ immediately just like slime-inspect does.
+ (slime-inspect-presented-object): Removed.
+ (slime-inspect): Don't expect that "swank:init-inspector" is
+ already part of the form. Accept an optional arg "no-reset".
+ (slime-read-object): Don't add "swank:init-inspector" to the read
+ form; slime-inspect now adds it.
+
+2006-08-21 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Make the values of local variables in debugger frames and values
+ of parts in the inspector accessible as presentations. In
+ particular, this allows to copy #<unreadable> values to the REPL
+ for further investigation. It also provides a context menu for
+ the values, offering to inspect, pretty-print, and describe them.
+
+ Note that the presentations are only valid as long as the
+ corresponding Inspector or Debugger buffer is open.
+
+ * swank.lisp (lookup-presented-object): Handle presentation ids
+ (:frame-var frame index), (:inspected-part part-index).
+ (init-inspector): New optional argument, reset.
+
+ * slime.el (slime-inspector-insert-ispec): Mark up all values of
+ inspected parts as presentations.
+ (sldb-insert-locals): Mark up the values of local variables as
+ presentations.
+ (slime-remove-presentation-properties): Fix for read-only buffers.
+ (slime-copy-presentation-at-point): Make it work when the current
+ buffer is not the REPL buffer.
+ (slime-menu-choices-for-presentation): Describe into a separate
+ buffer, not the REPL. New menu item, pretty-print.
+ (slime-presentation-expression): Handle presentation ids that are
+ not numbers.
+ (slime-inspect-presented-object): Don't reset the inspector if
+ already in the inspector buffer.
+
+2006-08-20 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (*nil-surrogate*): New.
+ (save-presented-object, lookup-presented-object): Distinguish
+ between a saved NIL and a garbage-collected object that was
+ replaced by NIL in the weak hash table.
+ (compute-enriched-decoded-arglist with-open-file): Add an IGNORE
+ declaration.
+
+2006-08-19 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-parse-extended-operator-name/apply): New.
+ (slime-extended-operator-name-parser-alist): Add it to the alist.
+
+ * swank.lisp (compute-enriched-decoded-arglist): Add method for
+ handling APPLY.
+
+2006-08-14 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-accept-process-output): Use brute-force to
+ detect whether accept-process-output can be called with a float as
+ timeout arg.
+
+ * swank-openmcl.lisp: Fix some breakage caused by the new
+ defimplementation.
+
+2006-08-11 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (close-connection, swank-error): Include backtraces
+ in our own errors.
+ (simple-serve-requests): Don't try to enter the
+ debugger if the connection is closed.
+
+ * slime.el (disconnect): Test disconnecting.
+
+ * swank-cmucl.lisp (startup-idle-and-top-level-loops): Initialize
+ MP only once.
+
+2006-08-10 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-allegro.lisp (fspec-definition-locations): Improve
+ handling of (:internal ... n) like fspecs.
+
+ * slime.el (slime-restart-inferior-lisp-aux): Remove the
+ interactive spec.
+
+ * swank-backend.lisp (definterface): Drop that incredibly
+ unportable CLOS stuff. Use plists and plain functions instead.
+ Update backends accordingly.
+
+2006-08-09 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-find-filename-translators): CL:MACHINE-INSTANCE
+ can return nil. Silently accept that case for now.
+
+ * swank.lisp (test-print-arglist): Print a message instead of
+ signalling an error. This should avoid startup problems, in
+ particular with CormanLisp.
+ (setup-stream-indirection): Disable it for now. We should fix it,
+ if there is a need for this functionality or just remove it.
+
+ * swank-backend.lisp (definterface): Bring the old implementation
+ based on NO-APPLICABLE-METHOD back. It avoids lots of redefintion
+ warnings (but it creates more "noise" in backtraces).
+
+ * swank-*.lisp (inspect-for-emacs): Don't use defimplementation
+ for real generics.
+
+2006-07-28 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-thread-quit): Call swank:quit-thread-browser.
+ Reported by Taylor R Campbell.
+
+2006-07-28 Willem Broekema <metawilm(a)gmail.com>
+
+ * swank-allegro.lisp: Profiling functions on Allegro (except for
+ profile-package).
+
+2006-07-24 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Add support for destructuring macro arglists in arglist display,
+ form completion, and keyword completion; in particular for
+ with-open-file.
+
+ * swank.lisp (find-valid-operator-name): New, factored out from
+ arglist-for-echo-area.
+ (arglist-for-echo-area): Use it here.
+ (print-arglist): New, factored out from decoded-arglist-to-string.
+ Handle recursive arglist structures that arise in destructuring
+ macro arglists.
+ (decode-required-arg, encode-required-arg): New, handle
+ destructuring patterns.
+ (decode-keyword-arg, encode-keyword-arg, decode-optional-arg)
+ (encode-optional-arg, decode-arglist, encode-arglist): Use them
+ here to handle destructuring patterns.
+ (print-decoded-arglist-as-template): Change interface, handle
+ destructuring patterns.
+ (decoded-arglist-to-template-string): Use it here.
+ (enrich-decoded-arglist-with-keywords): New, factored out from
+ enrich-decoded-arglist-with-extra-keywords.
+ (enrich-decoded-arglist-with-extra-keywords): Use it here.
+ (compute-enriched-decoded-arglist): New generic function, factored
+ out from arglist-for-insertion, form-completion. Add specialized
+ method for with-open-file.
+ (arglist-for-insertion, form-completion): Use it here.
+ (arglist-ref): New.
+ (completions-for-keyword): Change interface, handle destructuring
+ macro arglists.
+
+ * slime.el (slime-enclosing-operator-names): For nesting levels
+ without operator, record nil.
+ (slime-completions-for-keyword): New argument arg-indices.
+ (slime-contextual-completions): Pass all enclosing operators and
+ arg-indices to slime-completions-for-keyword.
+
+2006-07-16 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-edit-definition): Invoke the
+ slime-edit-definition-fall-back-function also in the case where
+ find-definitions-for-emacs returns an error message.
+ (slime-edit-definition-fallback-function): Fix typo (find-tag
+ rather than find-tags).
+
+2006-07-15 Juho Snellman <jsnell(a)iki.fi>
+
+ * swank-sbcl.lisp (preferred-communication-style): Remove use of
+ linux_no_threads_p alien variable (the value has been hardcoded to
+ false for about a year), so that we can also remove it from from SBCL
+ in the future.
+ (*definition-types*): defcondition -> define-condition,
+ to make slime-show-definitions display condition FOO as
+ (DEFINE-CONDITION FOO) instead of (SWANK-BACKEND::DEFCONDITION FOO).
+
+2006-07-15 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-shared-lisp-mode-hook): New function, factored
+ out from slime-lisp-mode-hook.
+ (slime-lisp-mode-hook): Use it here.
+ (slime-scheme-mode-hook): New function, use
+ slime-shared-lisp-mode-hook.
+ (slime-setup): If scheme-mode is one of the slime-lisp-modes,
+ install our hook.
+
+2006-07-13 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (keywords-of-operator): New support function for
+ writing user-defined `extra-keywords' methods.
+
+2006-07-11 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-allegro.lisp (make-weak-key-hash-table): Use ACL's weak
+ hashtables.
+
+ * swank.asd: Set *source-directory* to the asdf component dir.
+
+2006-07-01 Lu�s Oliveira <loliveira(a)common-lisp.net>
+
+ * swank-sbcl.lisp (locate-compiler-note): Change first branch to
+ handle the changes introduced by the previous patch to
+ swank-compile-string.
+
+2006-06-26 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-sbcl.lisp (find-definitions): Remove backward
+ compatibility code.
+
+2006-06-26 Lu�s Oliveira <loliveira(a)common-lisp.net>
+
+ * swank-sbcl.lisp (tmpnam, temp-file-name): New functions.
+ (swank-compile-string): Create temporary file with the string and
+ compile-file it instead of compiling an anonymous lambda, as
+ before, in order to better handle eval-when forms.
+
+2006-06-25 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-source-path-parser.lisp (suppress-sharp-dot): Return a
+ unique symbol to avoid multiple entries for nil at toplevel in the
+ source-map.
+
+ * slime.el (test compile-defun): Add a test for #. reader macro at
+ toplevel.
+ (slime-run-one-test): New command.
+ (sldb-activate): Recreate the sldb buffer if it doesn't
+ exist. (Can happen if someone kills the buffer manually.)
+ (slime-wait-condition): Add a dummy to slime-stack-eval-tags while
+ waiting so that the SLDB enters a recursive edit.
+
+2006-06-18 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-echo-arglist): Simplify, just use slime-autodoc.
+
+ * swank.lisp (arglist): Distinguish between provided actual args
+ and required formal args using the new slot provided-args.
+ (form-completion): Likewise.
+ (decoded-arglist-to-string): Use it here to display the argument
+ list (make-instance 'CLASS-NAME ...) rather
+ than (make-instance (quote CLASS-NAME) ...).
+
+ * swank.lisp (extra-keywords change-class): Don't drop the first
+ argument.
+
+ * slime.el (slime-parse-extended-operator-name): Don't move
+ point; fixes infinite loop.
+
+2006-06-17 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-parse-extended-operator-name/cerror): Handle
+ cerror and change-class with :make-instance.
+ (slime-extended-operator-name-parser-alist): Handle change-class.
+ (slime-parse-extended-operator-name)
+ (slime-enclosing-operator-names): Fix the case when point is
+ within the operator.
+
+ * swank.lisp (operator-designator-to-form): Handle cerror and
+ change-class with :make-instance.
+
+2006-06-16 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (operator-designator-to-form): Handle :cerror.
+ (extra-keywords cerror): Make it work.
+
+ * slime.el (slime-parse-extended-operator-name)
+ (slime-parse-extended-operator-name/make-instance)
+ (slime-parse-extended-operator-name/defmethod): New functions,
+ factored out from slime-enclosing-operator-names.
+ (slime-parse-extended-operator-name/cerror): New function.
+ (slime-extended-operator-name-parser-alist): New variable.
+ (slime-enclosing-operator-names): Use them here.
+
+2006-06-14 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-goto-definition): If all definitions of a name
+ have the same location, go there directly rather than presenting
+ an xref buffer.
+
+2006-06-11 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * swank-scl (ext:stream-write-chars): update for SCL 1.3.
+
+2006-06-09 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank-abcl: Update to cvs version of abcl and warnings errors
+ when compiling in a buffer will now be properly caught by slime vs
+ current behavior of always saying 0 errors 0 warnings and printing
+ them in the repl instead
+
+2006-05-31 Nathan Bird <nathan(a)acceleration.net>
+
+ * swank.lisp (*sldb-quit-restart*): New variable.
+ (throw-to-toplevel): Use the restart named by *sldb-quit-restart*
+ as opposed to hard coding abort-request.
+
+2006-05-30 Tobias Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-get-temp-buffer-create): New keyword REUSEP
+ which indicates whether an already-existing buffer named like the
+ buffer to be created should be reused, i.e. not killed, then
+ freshly created. Update docstring accordingly.
+ (slime-with-output-to-temp-buffer): Make &optional arg MODE an
+ &key keyword arg. Add REUSEP keyword.
+ (slime-macroexpansion-minor-mode-map): Make remapped `undo' update
+ highlighted edits in the macroexpansion buffer.
+ (slime-eval-macroexpand-in-place): Update highlighted edits when
+ macroexpanding in-place.
+ (slime-eval-macroexpand): Reuse macroexpansion buffer if it exists
+ already to preserve `undo' functionality.
+
+2006-05-30 Tobias Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-use-autodoc-mode): Fix typo in docstring.
+ (slime-use-highlight-edits-mode): New variable, analogous to
+ SLIME-USE-AUTODOC-MODE.
+ (slime-setup, slime-lisp-mode-hook): Make above variable
+ work. Also, activates the HIGHLIGHT-EDITS-MODE in proper way (thus
+ avoiding the nasty "Toggling ... off; better pass an explicit
+ argument." message.)
+
+ * slime.el: Fix typo in comment about communication protocol.
+
+2006-05-27 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * swank-abcl: slot-boundp-using-class slot-value-using-class so you
+ can inspect instances
+
+2006-05-26 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime.el (slime-eval-macroexpand-inplace): Fix out-of-range
+ error on in-place macroexpand when point is placed at a closing
+ parenthesis. In this case the sexp closed by that paren is
+ expanded.
+ Also make expanding of expressions work that are quoted like, for
+ instance, "'(FOO BAR)" if point is placed at the opening paren.
+
+2006-05-24 Brian Downing <bdowning(a)lavos.net>
+
+ * swank.lisp (recursively-compute-most-completions & friends):
+ Micro-optimize the fuzzy completion engine, improving performace
+ by a factor of about 4 on SBCL. However, it will only work on
+ simple-strings now, and CHAR= is burned in instead of being an
+ option. I don't think this is too much of a limitation. At this
+ point rendering the results on the emacs side takes much longer
+ than finding them for long result lists.
+
+2006-05-24 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * swank-abcl: Add some more mop functions to you can inspect classes,
+ generic functions, methods, slots.
+
+2006-05-16 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-repl-return-behaviour): New variable which
+ controls slime-repl-return's heaviour.
+ (slime-repl-return): Respect slime-repl-return-behaviour.
+
+2006-05-14 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-macroexpansion-minor-mode-map): Rebind 'undo' to
+ set buffer-read-only temporarily to t.
+ (slime-repl-return): Only send repl input if point is past a
+ complete form.
+
+2006-05-12 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (update-indentation-information): Fix for problem
+ with Allegro CL 8.0: If I type M-x slime-update-indentation,
+ Allegro CL starts growing until it hits a STORAGE-CONDITION or
+ even segfaults.
+
+2006-05-04 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank-allegro.lisp (fspec-definition-locations): Handle
+ :top-level-form entries that appear in backtraces.
+
+2006-04-20 Marco Baringer <mb(a)bese.it>
+
+ * swank-openmcl.lisp (toggle-trace): Implemented. Currently only
+ provides 'best effort' support, :labels and :flet are ignored,
+ :defmethod and :call are treated like a normal trace of the
+ operator.
+
+2006-04-20 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (*use-dedicated-output-stream*): Make it nil by
+ default to avoid race conditions.
+
+2006-04-19 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * doc/Makefile (contributors.texi): use texinfo macros for
+ accented characters.
+
+ * ChangeLog: canonize Gabor Melis' spelling, otherwise he appears
+ twice in the "Hackers of the good Hack table"
+
+ * doc/slime.texi (nyorsko): delete
+ (EDITION): make it say 2.0
+
+2006-04-19 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * swank.lisp (decoded-arglist-to-string): if the keyword and the
+ variable are different, print the keyword name with escapes.
+ (encode-keyword-arg): get the keyword and the arg-name the same
+ way round as in lambda lists.
+ (appliable-methods-keywords): use
+ swank-mop:compute-applicable-methods-using-classes and
+ compute-applicable-methods in the AMOP-friendly way, to get EQL
+ specializers right.
+ (class-from-class-name-form, extra-keywords/slots): new.
+ (extra-keywords/make-instance): use new functions. Also get
+ keywords from SHARED-INITIALIZE (after Dan Barlow) and
+ ALLOCATE-INSTANCE.
+ (extra-keywords/change-class): new.
+ (extra-keywords (eql 'change-class)): new. Won't work at present,
+ just as the CERROR case doesn't work.
+
+2006-04-19 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * swank-sbcl.lisp (preferred-communication-style): Make it nil
+ under win32, for now.
+
+ * doc/slime.texi: document nil *communication-style*
+
+2006-04-18 Espen Wiborg <espenhw(a)grumblesmurf.org>
+
+ * swank-corman.lisp: Define a class file-stream to let swank.lisp
+ load.
+
+2005-04-17 Andras Simon <andras(a)renyi.hu>
+
+ * swank-abcl.lisp: (accept-connection): New argument: timeout.
+
+2006-04-14 Gerd Flaig <gefla(a)pond.sub.org>
+
+ * slime.el (slime-autodoc): Fix reference to unbound variable.
+
+2006-04-13 Martin Simmons <martin(a)lispworks.com>
+
+ * swank-loader.lisp (load-site-init-file, swank-source-files): Fix
+ pathname construction to take all unspecified components from the
+ directory pathname, in particular the drive letter on Windows.
+
+2006-04-13 Helmut Eller <helmut(a)common-lisp.net>
+
+ * slime.el (slime-find-filename-translators): Use assoc-if instead
+ of assoc-default for XEmacs compatibility.
+ (slime-show-note-counts): Don't show the highlighting bit as it
+ spills of the screen.
+ (slime-highlight-notes): Use with-temp-message.
+ (with-temp-message): Define it for XEmacs.
+ (slime-beginning-of-symbol): Use eq instead of char-equal as
+ char-equal signals an error at the beginning of a buffer.
+
+2006-04-13 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * swank-scl (make-socket-io-stream): set the stream to ignore
+ character conversion errors, and to substitute the character #\?.
+ Without this the communication channel is prone to lockup when a
+ conversion error occurs.
+
+ * swank-scl (inspect-for-emacs function): correct the index into the
+ closure environment; it was reading off the end of the closure
+ environment and picking up a corrupting value.
+
+ * swank-scl (mailbox): rework the mailbox implementation to better
+ handle interruption. Use a polling loop rather than condition
+ variables because interrupting a condition variable wait leaves the
+ thread with the condition variable lock held and leads to a deadlock
+ error.
+
+2006-04-12 Robert Macomber <slime(a)rojoma.com>
+
+ * swank-backend.lisp (make-recursive-lock): New interface
+ function.
+ (call-with-recursive-lock-held): New interface function.
+
+ * swank-grey.lisp (class slime-output-stream): Added recursive
+ locking to class and generic functions specialized on it.
+ (clss slime-input-stream): Added recursive locking to class and
+ generic functions specialized on it.
+
+ * swank-sbcl.lisp (make-recursive-lock): Implement the new interface.
+ (call-with-recursive-lock): Implement the new interface.
+
+2006-04-01 Matthew D. Swank <akopa(a)charter.net>
+
+ * slime.el (slime-fontify-string): Use set-text-properties, not
+ propertize, for Emacs 20 compatibility.
+
+2006-03-30 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-init-command): Don't translate filenames since
+ the new scheme doesn't work without a connection.
+ (slime-to-lisp-filename,slime-from-lisp-filename): Remove some
+ redundancy.
+ (slime-macroexpansion-minor-mode): Make it Emacs 20 compatible.
+
+2006-03-29 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-repl-mode): Enable autodoc-mode if
+ slime-use-autodoc-mode is true.
+
+2006-03-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (multiple-value-or): New macro.
+
+ * slime.el (slime-recently-visited-buffer): Ignore internal
+ buffers (starting with a space), to avoid selecting the
+ *slime-fontify* buffer. Reported by Andreas Fuchs.
+
+ * slime.el (slime-enclosing-operator-names): Handle forms similar
+ to make-instance (make-condition, error, etc.), to get extra
+ keywords based on the condition class.
+
+ * swank.lisp (operator-designator-to-form): Handle forms similar
+ to make-instance (make-condition, error, etc.)
+ (extra-keywords/make-instance): New function.
+ (extra-keywords): Specialize on operators make-condition, error,
+ signal, warn, cerror. Use multiple-value-or.
+
+2006-03-27 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-make-tramp-file-name): If emcas' tramp has
+ tramp-multi-methods then pass the method parameter to
+ tramp-make-tramp-file-name, otherwise don't.
+ (slime-create-filename-translator): Use
+ slime-make-tramp-file-name.
+
+2006-03-27 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * hyperspec.el (common-lisp-hyperspec-strip-cl-package): New
+ function.
+ (common-lisp-hyperspec): Don't get confused by a cl: or
+ common-lisp: package prefix.
+
+ * slime.el (slime-hyperspec-lookup): Don't get confused by a cl:
+ or common-lisp: package prefix.
+
+2006-03-26 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-enclosing-operator-names): Fix for situation
+ when point is at end of buffer, as it happens often in the REPL.
+
+2006-03-25 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (arglist-for-echo-area): New keyword arg,
+ print-lines.
+ (decoded-arglist-to-string): New function, implement argument
+ highlighting also for &optional and &rest/&body arguments.
+ (arglist-to-string): Use decoded-arglist-to-string.
+ (arglist): New slots aux-args, known-junk, unknown-junk.
+ (nreversef): New macro.
+ (decode-arglist, encode-arglist): Refine to handle more structure
+ in argument lists, including implementation-defined stuff like
+ &parse-body.
+ (format-arglist-for-echo-area): New keyword arg, print-lines.
+ Simplify the code as there is no need to fall back to the unparsed
+ arglist any more.
+
+ * slime.el (slime-fontify-string): Fix for arguments spanning
+ multiple lines.
+ (slime-autodoc-message-dimensions): New.
+ (slime-autodoc-thing-at-point): Use it here to either ask for a
+ one-line or a nicely formatted multi-line arglist.
+ (slime-enclosing-operator-names): Handle linebreaks.
+
+2006-03-24 Mikel Bancroft <mutandiz(a)yahoo.com>
+
+ * swank-allegro.lisp (set-default-directory): Fix for pathnames
+ without a trailing slash.
+
+2006-03-24 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-background-activities-enabled-p): Allow
+ "background activities" in sldb-mode.
+ (slime-autodoc-message-ok-p): Allow autodoc in sldb-mode.
+ (sldb-mode-syntax-table): New variable.
+ (sldb-mode): Enable autodoc-mode when slime-use-autodoc-mode is
+ true. Use sldb-mode-syntax-table to make #<...> balance like
+ parentheses. This enables autodoc-mode to match #<unreadable>
+ actual arguments in the backtraces with formal arguments of the
+ function.
+ (slime-beginning-of-symbol, slime-end-of-symbol): Handle
+ es::|caped| symbols.
+ (slime-enclosing-operator-names): Use syntax table to check
+ whether we are at the beginning of a balanced expression.
+
+2006-03-23 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * swank.lisp (ed-in-emacs): Allow conses as function names.
+ Ensure that there is a connection to emacs before sending the
+ :ed message.
+
+ * slime.el (slime-edit-definition): read names, not symbols.
+ (slime-ed): handle conses whose car is not a string as function
+ names.
+
+2006-03-23 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-qualify-cl-symbol-name): Strip leading colon
+ from package names for qualifying symbols.
+ (slime-call-defun): New command.
+ (slime-keys): Bind it to C-c C-y.
+ (slime-easy-menu): Show it in the menu.
+
+ * slime.el (slime-autodoc-use-multiline-p): New defcustom.
+ (slime-autodoc-message): Use it here. Fix bug that autodoc
+ messages exceeding one line could not be overwritten by later
+ autodoc messages.
+ (slime-autodoc-pre-command-refresh-echo-area): Use message
+ rather than slime-background-message.
+
+ * swank.lisp (casify): Removed.
+ (casify-char, tokenize-symbol-thoroughly): New functions.
+ (parse-symbol): Use tokenize-symbol-thoroughly, so as to handle
+ |escaped symbols|. This fixes arglist display for operators with
+ strange symbol names.
+
+2006-03-23 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * swank-backend (accept-connection): add a 'timeout argument to
+ this function.
+
+ * swank-backend (set-stream-timeout): new implementation specific
+ function. Used to set the timeout for stream operations, which
+ can help make the network connection establishment more robust.
+
+ * swank (setup-server): ignore errors from the function 'serve to
+ allow another connection to be made.
+
+ * swank (serve-connection): ensure the listener socket is closed
+ when 'dont-close is false, even if the connection attempt fails.
+
+ * swank (accept-authenticated-connection): ensure the new
+ connection is closed if the connection establishment fails. Set a
+ short stream timeout to prevent denial of survice.
+
+ * swank (open-dedicated-output-stream): ensure the listener socket
+ is closed, even if unable to open the dedicated stream. Implement
+ a timeout while waiting for a connection for the dedicate stream
+ to prevent denial of service.
+
+ * swank (create-connection): ensure the new connection is closed
+ if not successful.
+
+2006-03-22 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (arglist-for-echo-area): Fix when arg-indices are
+ not given.
+
+ * slime.el (slime-ed): Handle (FILENAME :charpos CHARPOS).
+
+ * swank.lisp (inspect-for-emacs): Specialize on FILE-STREAM and
+ STREAM-ERROR, offering to visit the file at the current stream
+ position as an inspector action. Useful for dealing with reader
+ errors.
+
+2006-03-20 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-autodoc-pre-command-refresh-echo-area):
+ Show the last autodoc message again (movement commands clear it);
+ technique to avoid flickering, taken from eldoc.
+ (slime-autodoc-mode): Install it as a pre-command-hook.
+ (slime-autodoc-last-message): New variable.
+ (slime-autodoc-message): New function.
+ (slime-autodoc): Use them here.
+ (slime-autodoc-message-ok-p): OK to overwrite an autodoc message.
+
+ * slime.el (slime-handle-indentation-update): Also update
+ scheme-indent-function if slime-lisp-modes contains scheme-mode.
+
+2006-03-19 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Highlight the formal argument corresponding to the actual
+ argument around point in the echo-area arg-list display.
+ Works most impressively when slime-autodoc-mode is enabled
+ and when one has to deal with extremely long argument lists.
+
+ * slime.el (slime-space): First insert the space, then obtain
+ information.
+ (slime-fontify-string): Also handle argument highlights.
+ (slime-enclosing-operator-names): As a secondary value, return a
+ list of the indices of the arguments to the nested operator.
+ (slime-contextual-completions): Use changed interface of
+ slime-enclosing-operator-names.
+ (slime-function-called-at-point): Removed.
+ (slime-function-called-at-point/line): Removed.
+ (slime-autodoc-thing-at-point): New.
+ (slime-autodoc): Re-implement with slime-enclosing-operator-names
+ instead of slime-function-called-at-point.
+ (slime-echo-arglist): Pass the argument indices to
+ arglist-for-echo-area.
+ (slime-autodoc-message-ok-p): Autodoc is also OK in REPL buffers.
+
+ * swank.lisp (arglist-for-echo-area): New keyword argument
+ arg-indices.
+ (arglist-to-string): New keyword argument highlight.
+ (format-arglist-for-echo-area): Likewise.
+
+2006-03-18 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-goto-location-buffer): Avoid calling the
+ expensive function find-file-noselect when we are already in the
+ right buffer.
+
+ * swank.lisp (arglist-for-echo-area): Add keyword argument
+ print-right-margin.
+ (arglist-to-string, format-arglist-for-echo-area): Likewise.
+ * slime.el (slime-autodoc): Use it here to make use of the whole
+ width of the echo area for arglist display.
+
+2006-03-16 G�bor Melis <mega(a)hotpop.com>
+
+ * swank-allegro.lisp (inspect-for-emacs): Fix typo.
+
+2006-03-16 Gary King <gwking(a)metabang.com>
+
+ * swank-loader.lisp (lisp-version-string): Modified swank-loader
+ so that Allegro's alisp and mlisp programs get different
+ locations. Otherwise mlisp complains about alisp's files.
+
+2006-03-16 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-to-lisp-filename): Call expand-file-name before
+ passing the filename to the to-lisp function.
+
+2006-03-14 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-system-history): New variable.
+ (slime-read-system-name): Use a separate history list for ASDF
+ system names.
+ (slime-note-counts-message): New variable.
+ (slime-show-note-counts): Store the note counts message for later use.
+ (slime-highlight-notes, slime-list-compiler-notes): Show a
+ progress message, keeping note counts visible.
+ (slime-find-buffer-package): Handle IN-PACKAGE forms that appear
+ in SWIG/Allegro CL wrappers.
+
+ * swank-allegro.lisp (compile-from-temp-file): Suppress Allegro's
+ redefinition warnings; they are pointless when we are compiling
+ via a temporary file.
+ (profile-report): Implement.
+
+2006-03-06 Nathan Bird <nathan(a)acceleration.net>
+
+ * slime.el (slime-create-filename-translator): use the tramp
+ methods for dissecting and building filenames.
+
+2006-03-04 Wojciech Kaczmarek <wojtekk(a)kofeina.net>
+
+ * slime.el (slime-filename-translations): Typo in example.
+ (slime-create-filename-translator): Typo in generated lambdas.
+
+2006-03-03 Marco Baringer <mb(a)bese.it>
+
+ Allow per-host (per machine-instance actually) filename
+ translation functions.
+
+ * slime.el (slime-translate-to-lisp-filename-function): removed.
+ (slime-translate-from-lisp-filename-function): removed.
+ (slime-filename-translations): New variable.
+ (slime-to-lisp-filename): Rewrote to search through available
+ transalations.
+ (slime-from-lisp-filename): idem.
+ (slime-create-filename-translator): New function.
+ (slime-add-filename-translation): New function.
+
+2006-02-27 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-eval-macroexpand-inplace): Indent the inserted
+ macroexpansion.
+
+2006-02-27 Marco Baringer <mb(a)bese.it>
+
+ Provide functions for performing macroexpansion inplace, use these
+ functions in the *SLIME macroexpansion* buffer.
+
+ * slime.el (slime-macroexpansion-minor-mode): Attempt to map
+ -inplace functions to the same keys as their regular contureparts
+ in slime-mode-map.
+ (slime-eval-macroexpand-inplace): New function.
+ (slime-macroexpand-1-inplace): New function.
+ (slime-macroexpand-all-inplace): New function.
+ * doc/slime.texi: Document new macroexpansion mode.
+
+2006-02-26 Douglas Crosher <dcrosher(a)common-lisp.net>
+ * swank-scl.lisp: (ext:stream-read-chars): Correct the updating of
+ the buffer index. Fixes slime input stream problems.
+
+2006-02-25 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-loader.lisp (default-fasl-directory): Previously we return
+ only the directory-namestring which breaks SCL, because it loses
+ the host and device components. Return the complete pathname
+ instead. Patch by Douglas Crosher.
+
+ * slime.el (slime-lisp-host): New variable. Replace all references
+ to "127.0.0.1" with the variable.
+
+2006-02-25 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * swank-backend.lisp (operate-on-system): symbol case fix for
+ SCL's lowercase mode.
+
+ * swak.lisp (setup-stream-indirection)
+ (globally-redirect-io-to-connection)
+ (revert-global-io-redirection): symbol case fixes.
+
+ * swank-scl.lisp: (inspect-for-emacs): Fixes for the inspect
+ standard-objects, and inspect array. Plus misc symbol case fixes.
+
+2006-02-22 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-repl-send-input): Don't include the final
+ newline in the slime-repl-input-face overlay, thus avoid showing the
+ "Evaluation aborted" message in boldface. Don't set non-existent
+ "rear-nonsticky" overlay property; overlay stickiness is
+ controlled by make-overlay arguments.
+
+2006-02-20 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Use argument list information to complete keywords contextually.
+ Example: (find 1 '(1 2 3) :s <M-TAB> --completes--> :start
+ rather than suggesting all ever-interned keywords starting with ":s".
+
+ * slime.el (slime-complete-keywords-contextually): New
+ customizable variable.
+ (slime-enclosing-operator-names): New optional argument
+ max-levels.
+ (slime-completions-for-keyword): New.
+ (slime-contextual-completions): New.
+ (slime-expand-abbreviations-and-complete): Use it instead of
+ slime-completions.
+
+ * swank.lisp (operator-designator-to-form): New, factored out from
+ arglist-for-echo-area.
+ (arglist-for-echo-area): Use it here.
+ (completions-for-keyword): New.
+ (find-matching-symbols-in-list): New.
+
+2006-02-19 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-expand-abbreviations-and-complete): Scroll the
+ completions buffer if the TAB key is pressed another time, like
+ Emacs minibuffer completion does.
+
+2006-02-18 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-macroexpansion-minor-mode): New minor mode for
+ macroexpansion buffer. Exactly like slime-temp-buffer-mode but
+ with slime-macroexpand-again bound to "g".
+ (*slime-eval-macroexpand-expression*): New variable. introduced
+ for slime-macroexpand-again, used by slime-eval-macroexpand as
+ well.
+ (slime-eval-macroexpand): Added optional string argument which
+ defaults to (slime-sexp-at-point-or-error).
+ (slime-macroexpand-again): New function, redoes the last
+ macroexpansion.
+ (slime-sexp-at-point-or-error): New function. Like
+ slime-sexp-at-point but signals an error when slime-sexp-at-point
+ would return nil.
+ * swank-openmcl.lisp (swank-mop:compute-applicable-methods-using-classes):
+ Implement.
+
+2006-02-16 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * sbcl-pprint-patch.lisp: New file, adds the annotations feature
+ to the SBCL pretty printer. This is needed for sending
+ presentations through pretty-printing streams.
+ * present.lisp [sbcl]: Load it here.
+ (slime-stream-p, write-annotation) [sbcl]: Handle pretty-streams.
+
+2006-02-10 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-allegro.lisp, swank-lispworks.lisp (inspect-for-emacs):
+ Use the backend specific method to inspect standard-objects
+ because {slot-boundp,slot-value}-using-class don't conform to the
+ MOP spec in LW and ACL.
+
+ * swank.lisp (macro-indentation): Don't count '&optional as
+ argument.
+
+ * swank-loader.lisp (default-fasl-directory): Include the SLIME
+ version.
+ (slime-version-string): New.
+
+2006-02-06 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Show enriched arglists for DEFMETHOD in the echo area when the
+ user types SPC after the generic function name.
+
+ * swank.lisp (arglist-to-template-string): Unused, removed.
+ (extra-keywords): Indicate which part of the actual arglist was
+ used to determine the extra keywords. For MAKE-INSTANCE, don't
+ signal an error if the class does not exist.
+ (enrich-decoded-arglist-with-extra-keywords): Indicate which part
+ of the actual arglist was used to determine the extra keywords,
+ and whether any extra keywords were added.
+ (form-completion): Generalize to handle display of enriched formal
+ arglists.
+ (read-incomplete-form-from-string): New, factored out from
+ complete-form. Handle end-of-file.
+ (complete-form): Use it here.
+ (format-arglist-for-echo-area): Use form-completion, so as to
+ show enriched formal arglists for MAKE-INSTANCE and DEFMETHOD
+ calls.
+ (arglist-for-echo-area): Handle MAKE-INSTANCE and DEFMETHOD
+ calls.
+
+ * slime.el (slime-enclosing-operator-names): Represent
+ MAKE-INSTANCE calls by (:make-instance "CLASS-NAME"), handle
+ DEFMETHOD too.
+
+2006-02-05 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-complete-form): Indent the inserted template.
+
+2006-02-04 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-fontify-string): New.
+ (slime-echo-arglist, slime-arglist, slime-autodoc): Use it here to
+ fontify echo-area arglists.
+
+2006-02-02 Marco Baringer <mb(a)bese.it>
+
+ * swank-openmcl.lisp: Added imports for slot-boundp-using-class,
+ slot-value-using-class and finalize-inheritance.
+
+2006-02-01 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank-abcl.lisp: define with-compilation-hooks (= funcall for now), so that you can do slime-oos
+
+2006-01-30 Ian Eslick <eslick(a)csail.mit.edu>
+
+ Show slot values for metaclasses that override the default storage
+ locations for objects slots (i.e. where the default slot-boundp
+ returns nil) in the inspector.
+
+ * swank.lisp (inspect-for-emacs standard-object): Use
+ slot-value-using-class and slot-boundp-using-class.
+
+ * swank-backend.lisp: Add slot-value-using-class and
+ slot-boundp-using-class to the swank-mop package.
+
+2006-01-26 Lu�s Oliveira <loliveira(a)common-lisp.net>
+
+ * slime.el (slime-enclosing-operator-names): detect make-instance
+ forms and collect the class-name argument if it exists and is a
+ quoted symbol.
+
+ * swank.lisp (arglist-for-echo-area): handle pairs of of the form
+ ("make-instance" . "<class-name>") by passing them to
+ format-initargs-and-initforms-for-echo-area.
+ (class-initargs-and-iniforms): New function.
+ (format-initargs-and-initforms-for-echo-area): New function.
+
+2006-01-20 M�sz�ros Levente <melevy(a)freemail.hu>
+
+ * swank-sbcl.lisp (restart-frame): Provide an implementation even
+ if it doesn't quite do what it's supposed to do.
+
+2006-01-19 Helmut Eller <heller(a)common-lisp.net>
+
+ Return to the previous loading strategy: load everything when
+ swank-loader is loaded. It's just to convenient to give that up.
+ To customize the fasl directories, the new variable
+ swank-loader:*fasl-directory* can be set before loading
+ swank-loader.
+
+ * swank-loader.lisp (*fasl-directory*, *source-directory*): New
+ variables.
+ (load-swank): Call it during loading.
+
+2006-01-14 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-compile-defun): If point was at the opening
+ paren we wrongly used the preceding toplevel form. Fix it.
+ Reported by Chisheng Huang and Liam M. Healy.
+
+ * swank.lisp (spawn-threads-for-connection): Fix a race condition:
+ Don't accept input before all threads are ready.
+
+ Make the fasl directory customizable: load-swank must now be
+ called explicitly so that we can supply the fasl dir as argument.
+
+ * swank-loader.lisp (load-swank): New entry point.
+
+2006-01-14 Andreas Fuchs <asf(a)boinkor.net>
+
+ * slime.el (slime-selector ?r): Call slime instead of slime-start
+ to pick up the usual defaults.
+
+2005-12-31 Harald Hanche-Olsen <hanche(a)math.ntnu.no>
+
+ * slime.el (slime-open-stream-to-lisp): Inherit the
+ process-coding-system from the current connection.
+
+2005-12-27 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank-abcl. (backtrace-as-list-ignoring-swank-calls): remove the
+ swank calls from the backtrace to make it easier to use.
+ (frame-locals): Fix a typo that caused entry into the debugger if
+ you tried to look at frame locals. Now you don't error out, but
+ you still don't see frame locals because I don't know how to get
+ them :(
+
+2005-12-27 Helmut Eller <heller(a)common-lisp.net>
+
+ Keep a history of protocol events for better bug reports.
+
+ * swank.lisp (log-event): Record the event in the history buffer.
+ (*event-history*): Buffer for events.
+ (dump-event-history): New function.
+ (close-connection): Escape non-ascii strings and include the event
+ history in the error message.
+
+2005-12-22 Helmut Eller <heller(a)common-lisp.net>
+
+ Make highlighting of modified text a minor mode. Also use
+ after-change-functions instead of rebinding all self-inserting
+ keys.
+
+ * slime.el (slime-highlight-edits-mode): New minor mode.
+ (slime-self-insert-command): Deleted.
+ (slime-before-compile-functions): New hook to decouple edit
+ highlighting from compilation.
+ (slime-highlight-edits-face): Renamed from slime-display-edit-face.
+
+2005-12-20 Marco Baringer <mb(a)bese.it>
+
+ When inspecting classes, methods and generic functions show all
+ the slots in the case that what we're inspecting is a subclass of
+ the standard class and has extra user defined slots.
+
+ * swank.lisp (all-slots-for-inspector): New function.
+ (inspect-for-emacs): Use all-slots-for-inspector.
+
+2005-12-19 Peter Seibel <peter(a)gigamonkeys.com>
+
+ * slime.el (slime-self-insert-command): Got rid of message about
+ setting up face and skipping edit-hilights when in a comment.
+
+2005-12-18 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * slime.el (slime-mode-hook): Bind simple characters to
+ slime-self-insert-command only if there was no previous local
+ binding, and the major mode is _not_ slime-repl-mode. This
+ restores keybindings of slime-xref-mode and prevents us from
+ stomping on user bindings. The hilighting also makes no sense in
+ the REPL.
+
+2005-12-16 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * slime.el (slime-selector-method: ?r): If no connection offer to
+ start Slime.
+
+ * swank.lisp (to-string): Handle errors from printing objects.
+ Among other things makes the inspector more robust in the face of
+ objects with unbound slots and print-methods that fail to cope.
+
+2005-12-16 William Bland <doctorbill.news(a)gmail.com>
+
+ Added hilighting of tetx which has been edited but not yet
+ compilied.
+
+ * slime.el (slime-display-edit-hilights): New variable.
+ (slime-display-edit-face): New face.
+ (slime-compile-file, slime-compile-defun, slime-compile-region):
+ Remove edits overlay.
+ (slime-remove-edits): New function.
+ (slime-self-insert-command): New function.
+ (slime-mode-hook): Rebind simple characters to
+ slime-self-insert-command.
+
+2005-12-07 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank-allegro.lisp (find-definition-in-file)
+ (find-fspec-location, fspec-definition-locations): Allegro CL
+ properly records all definitions made by arbitrary macros whose
+ names start with "def". Use excl::find-source-file and
+ scm:find-definition-in-definition-group (rather than
+ scm:find-definition-in-file) to find them.
+
+ * slime.el (slime-load-file): Change the default to be the buffer
+ file name with extension. This is more convenient for files like
+ .asd files that do not have the default source file extension.
+ (slime-save-some-lisp-buffers, slime-update-modeline-package):
+ Handle all files with major mode in slime-lisp-modes, not just
+ lisp-mode.
+
+2005-12-06 Juho Snellman <jsnell(a)iki.fi>
+
+ * swank-sbcl.lisp (function-source-location,
+ safe-function-source-location): Oops, define these functions also
+ for the >0.9.6 case. Fixes broken sldb-show-source on SBCL 0.9.7.
+
+2005-12-05 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-find-coding-system): Use check-coding-system
+ only if it's actually fbound.
+
+2005-11-22 Marco Monteiro <masmxx(a)gmail.com>
+
+ * slime.el (slime-connect): Use slime-net-coding system if the
+ optional arg coding-system was not supplied.
+
+2005-11-22 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-compile-file): Call 'check-parens before
+ compiling.
+ (slime-compile-file): Call 'check-parens before compiling.
+ (slime-find-coding-system): Return nil if the coding system
+ isn'tvalid instead of singalling an error.
+ (slime-repl-history-file-coding-system): Use
+ slime-find-coding-system to find the default.
+
+ * swank-cmucl.lisp (accept-connection): Remove fd-handlers if the
+ encoding isn't iso-latin-1.
+
+2005-11-21 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-start): Don't set slime-net-coding-system ..
+ (slime-read-port-and-connect): .. read it from the inferior lisp args.
+ (slime-connect): Take the coding-system as third argument.
+ (slime-repl-history-file-coding-system): New user option.
+ (slime-repl-safe-save-merged-history): New function. Use it in
+ hooks so that bad coding systems don't stop us from exiting.
+ (slime-repl-save-history): Include the coding-system which was
+ used to save the buffer.
+ (repl-shoctut change-package): Add alias ,in and ,in-package.
+ (slime-eval-macroexpand): Error out early if there's no sexp at
+ point.
+ (slime-compiler-macroexpand): New command.
+ (slime-inspector-pprint): New command.
+
+ * swank-cmucl.lisp (inspect-for-emacs): Add support for
+ funcallable instances.
+
+ * swank.lisp (pprint-inspector-part, swank-compiler-macroexpand): New.
+
+ * swank-backend.lisp (compiler-macroexpand)
+ (compiler-macroexpand-1): New functions.
+
+2005-11-14 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * swank-scl.lisp (accept-connection): handle the :buffering argument.
+
+2005-11-13 Andras Simon <andras(a)renyi.hu>
+
+ * swank-abcl.lisp: (accept-connection): New argument: buffering.
+
+2005-11-13 Andras Simon <andras(a)renyi.hu>
+
+ * swank-abcl.lisp: Steal auto-flush stuff from swank-sbcl.lisp
+
+2005-11-11 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (*dedicated-output-stream-buffering*): New variable
+ to customize the buffering scheme. For single-threaded Lisps we
+ disable buffering because lazy programmers forget to call
+ finish-output.
+ (open-dedicated-output-stream): Use it.
+
+ * swank-backend.lisp, swank-allegro.lisp, swank-lispworks.lisp,
+ swank-openmcl.lisp, swank-cmucl.lisp, swank-sbcl.lisp,
+ swank-clisp.lisp, swank-abcl.lisp, swank-corman.lisp,
+ swank-ecl.lisp (accept-connection): New argument: buffering.
+
+ * slime.el (slime-repl-save-history): When the history exceeds
+ slime-repl-history-size remove the old not the new entries.
+ Some renaming:
+ slime-repl-read-history -> slime-repl-load-history,
+ slime-repl-read-history-internal -> slime-repl-read-history.
+ (slime-eval-macroexpand): Call font-lock-fontify-buffer
+ explicitly, because with certain Emacs versions the buffer doesn't
+ get fontified immediately.
+
+2005-11-07 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-eval-macroexpand): Use lisp-mode (and
+ font-lock-mode) when dispaying the expansion. Suggested by Jan
+ Rychter.
+
+ * swank-source-path-parser.lisp (make-source-recording-readtable):
+ Suppress the #. reader-macro.
+
+2005-11-06 Juho Snellman <jsnell(a)iki.fi>
+
+ * swank-sbcl.lisp (find-definitions, make-source-location-specification
+ make-definition-source-location, source-hint-snippet): As of
+ SBCL 0.9.6.25 SB-INTROSPECT has better support for finding
+ source locations. Use as much of it in swank-sbcl as possible.
+ (Original version left reader-conditionalized for older SBCLs).
+
+2005-11-04 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (connection-info): Docfix.
+
+ * slime.el (slime-set-connection-info): Generate a new connection
+ name only if the implementation-name and the inferior-lisp-name
+ are different.
+
+2005-10-31 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-start, slime-lookup-lisp-implementation)
+ (slime-set-connection-info): Add a :name property for the
+ implementation and use it to derive the connection-name.
+ (slime-lisp-implementation-name): Renamed from
+ slime-lisp-implementation-type-name.
+
+ * swank.lisp (simple-serve-requests): Add an extra abort restart.
+ (connection-info): Rename :type-name to :name.
+
+2005-10-30 Andras Simon <andras(a)renyi.hu>
+
+ * swank-abcl.lisp (inspect-for-emacs): Track mop changes in ABCL.
+
+2005-10-30 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-eval): Ensure that the connection is open before
+ waiting for input.
+
+ * swank.lisp (simple-serve-requests): Close the connection at the
+ end.
+
+2005-10-23 Harald Hanche-Olsen <hanche(a)math.ntnu.no>
+
+ * slime.el (slime-init-keymaps): Use vectors when defining keys,
+ because e.g. (define-key (string ?\C-c) ...) doesn't work in the
+ emacs-unicode-2 branch.
+
+2005-10-23 Stefan Kamphausen <skampi(a)gmx.net>
+
+ * slime.el (slime-repl-history-size, slime-repl-history-file): Use
+ defcustom to declare the variables.
+
+2005-10-23 G�bor Melis <mega(a)hotpop.com>
+
+ * swank-backend.lisp (install-debugger-globally): new interface
+ function
+
+ * swank.lisp (install-debugger): call install-debugger-globally
+
+ * swank-sbcl.lisp (install-debugger-globally): set
+ sb-ext:*invoke-debugger-hook* too
+
+2005-10-23 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-sbcl.lisp (make-stream-interactive): Spawn a thread to
+ flush interactive streams in reasonably short intervals.
+ Remove the old backward-compatible threading implementation.
+
+ * swank.lisp (package-string-for-prompt): Respect *print-case*.
+
+2005-10-21 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-start-swank-server): Avoid comint-send-input
+ here as it seems to trigger a bug in ansi-color-for-commit-mode.
+
+2005-10-18 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * swank.lisp (canonical-package-nickname): always return the
+ package name as a STRING if found. This restores the printing of
+ package names as strings.
+
+2005-10-17 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (eval-in-emacs): Instead of taking a string and
+ attempting to parse it emacs side the function now takes a form
+ and converts it to a string internally. This should allow users of
+ the function to not have to worry about quoting issues and emacs'
+ different printed represenation for, among other things,
+ characters.
+ (process-form-for-emacs): New function. Converts a list into a
+ string for passing to emacs.
+
+ * slime.el (slime-eval-for-lisp): New API. This function now takes
+ a single string, representing the form to evaluate, and uses
+ emacs' read function to convert it into a form before eval'ing it.
+ (slime-dispatch-event): The :eval event now passes a single
+ string (instead of a string and something looking kind of like a
+ form).
+
+2005-10-15 Douglas Crosher <dcrosher(a)common-lisp.net>
+
+ * swank-scl.lisp: Support for Scieneer Common Lisp.
+
+ * swank-backend.lisp (*gray-stream-symbols*) Scieneer Common Lisp
+ implements stream-line-length.
+
+ * swank-loader.lisp: Support for Scieneer Common Lisp:
+ (*sysdep-pathnames*) use swank-scl.
+ (*impl ementation-features*) add :scl.
+ (*os-features*) add :hpux.
+ (*architecture-features*) add :amd64, :i686, :i486, :sparc64, :sparc,
+ :hppa64, and :hppa.
+
+ * swank.lisp: (*canonical-package-nicknames*) use lowercase
+ symbols to name the packages. This supports CL implementations
+ with lowercase default symbol names, such as Scieneer Common Lisp,
+ while still being compatible with ANSI-CL.
+
+2005-10-11 Stefan Kamphausen <skampi(a)gmx.net>
+
+ * slime.el: Persistent REPL history. The history from REPL
+ buffers is now saved to the file ~/.slime-history.eld. The file
+ is read on startup and saved when a REPL buffer gets killed or
+ when Emacs exits. There are also commands to save or read the
+ history file.
+ (slime-repl-save-merged-history, slime-repl-merge-histories)
+ (slime-repl-read-history, slime-repl-save-history): New functions.
+ (slime-repl-history-file, slime-repl-history-size): New vars.
+ (slime-repl-mode): Add hooks to load and save the history.
+
+2005-10-11 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-read-interactive-args): Split the string
+ inferior-lisp-program to get the values for :program and
+ :program-args. Also let slime-lisp-implementations take
+ precedence if non-nil.
+ (slime-lisp-implementations): Renamed from
+ slime-registered-lisp-implementations.
+
+ * swank.lisp (force-user-output): There seems to be a bug in
+ Allegro's two-way-streams. As a workaround we use force-output for
+ the user-io stream. (finish-output *debug-io*) still triggers the
+ bug.
+
+2005-10-10 Svein Ove Aas <svein.ove(a)aas.no>
+
+ * swank-allegro.lisp (find-external-format): Translate :utf-8-unix
+ to :utf8, which Allegro 7.0 understands.
+
+2005-10-09 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime, slime-start): Introduce a separate function for
+ the non-interactive case. `slime-start' takes lots of keyword
+ arguments and `slime' is reserved for interactive use.
+ (slime-read-interactive-args): New function.
+ (slime-maybe-start-lisp, slime-inferior-lisp)
+ (slime-start-swank-server): Pass all arguments needed to start
+ the subprocess as a property list. Also store this list in a
+ buffer-local var in the inferior-lisp buffer, so that we can
+ cleanly restart the process.
+ (slime-registered-lisp-implementations): Change the format and
+ document it. M-- M-x slime can now be used select a registered
+ implementation.
+ (slime-symbolic-lisp-name): Deleted. And updated all the functions
+ which passed it along.
+ (slime-set-connection-info): Use the new format.
+ (slime-output-buffer): Don't re-initialize buffer-local variables
+ if the buffer already exists. This saves the history. From Juho
+ Snellman.
+
+ * swank-cmucl.lisp (sis/in): Use finish-output instead of
+ force-output.
+
+ * swank.lisp (connection-info): Include the initial package and
+ a more self-descriptive format.
+
+2005-10-01 Juho Snellman <jsnell(a)iki.fi>
+
+ * swank-backend (*gray-stream-symbols*): Add :STREAM-LINE-LENGTH
+ to *GRAY-STREAM-SYMBOLS* on implementations that support this
+ extension to gray streams. Reported by Matthew D Swank.
+
+2005-09-29 Luke Gorrie <luke(a)synap.se>
+
+ * swank-scheme48: Removed due to excessive whining.
+
+2005-09-28 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-multiprocessing): Deleted. No longer needed.
+ (slime-init-command): Updated accordingly.
+ (slime-current-package): Add a special case for Scheme.
+ (slime-simple-completions, slime-apropos): Quote the package,
+ because in can be a plain symbol in Scheme.
+ (slime-inspector-reinspect): Use a proper defslimefun.
+
+ * swank.lisp (inspector-reinspect): New function.
+ (start-server): Call initialize-multiprocessing before starting
+ the server and startup-idle-and-top-level-loops afterwards.
+ Calling startup-idle-and-top-level-loops here shouldn't be a
+ problem because start-server is only invoked at startup via stdin.
+
+ * swank-scheme48/source-location.scm: New file. For M-.
+ * swank-scheme48/module.scm (list-all-package): New function.
+ * swank-scheme48/interfaces.scm (module-control-interface): Export it.
+ * swank-scheme48/inspector.scm: Add methods for records and hashtables.
+ (swank:arglist-for-echo-area): Implement it. Only works for
+ functions with enough debug-data (ie. only user-defined functions).
+ * swank-scheme48/completion.scm: New file.
+ (swank:simple-completions, swank:apropos-list-for-emacs): Implemented.
+ * swank-scheme48/load.scm, swank-scheme48/defrectypeX.scm: Renamed
+ the file from defrectype*.scm
+ * swank-scheme48/packages.scm (swank-general-rpc): Don't use
+ posix-process because it doesn't work on Windows, and we don't need
+ it for a mulithreaded server.
+
+2005-09-22 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-backend.lisp (*gray-stream-symbols*): Collect the needed
+ symbols here, so that we don't need to mention them in every
+ backend.
+ (import-from). New function.
+
+ * swank-sbcl.lisp, swank-allegro.lisp, swank-lispworks.lisp,
+ swank-openmcl.lisp, swank-ecl.lisp: Use *gray-stream-symbols* when
+ importing the needed symbols.
+
+ * swank-gray.lisp (stream-fresh-line): Define a method, so that
+ Allegro passes our tests.
+
+2005-09-21 Aleksandar Bakic <a_bakic(a)yahoo.com>
+
+ * swank.lisp (accept-authenticated-connection): Minor fix. Ensure
+ that the decoded message is a string before calling string= on it.
+
+2005-09-21 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-setup-command-hooks): Make
+ after-change-functions a buffer-local variable; it's by default
+ global in XEmacs.
+
+ * swank.lisp (throw-to-toplevel): Invoke the `abort-restart'
+ request instead of throwing to the `slime-toplevel' catch tag.
+ (handle-request): Rename the restart from abort to abort-request.
+ (call-with-connection): Remove the slime-toplevel catch tag
+ because with-connection is used in far to many places which aren't
+ at "toplevel".
+
+ * present.lisp (presentation-start, presentation-end): Use
+ finish-output instead of force-output.
+
+ * swank-gray.lisp, swank-cmucl.lisp: Improve stream efficiency by
+ buffering more output. stream-force-output simply does nothing, if
+ the output buffer was flushed less than 200 millisecons before.
+ stream-finish-output can still be used to really flush the buffer.
+ (slime-output-stream): New slot last-flush-time.
+ (stream-finish-output): New function. Do what stream-force-output
+ did previously.
+ (stream-force-output): Buffer more output.
+
+ * slime.el (slime-process-available-input): Oops, don't start a
+ timer for every event.
+ (slime-write-string): Renamed from slime-output-string.
+ (slime-dispatch-event): Rename :read-output to :write-string.
+ (slime-io-speed-test): New command.
+ (slime-open-stream-to-lisp): Fix parens. The coding system should
+ also be set if presentations are disabled.
+
+ * swank.lisp (make-output-function): Rename :read-output to
+ :write-string.
+ (eval-for-emacs, interactive-eval, eval-region): Use finish-output
+ not force-output.
+
+ * swank-sbcl.lisp, swank-openmcl.lisp, swank-allegro.lisp,
+ swank-lispworks: Import `stream-finish-output'.
+
+ * swank-scheme48/io.scm (empty-swank-output-buffer): Rename
+ :read-output to :write-string.
+
+ * swank-scheme48/load.scm (slime48-start): Fix '() vs. #f bug.
+
+2005-09-19 Luke Gorrie <luke(a)synap.se>
+
+ * nregex.lisp: Released into the public domain by Lawrence E. Freil.
+
+2005-09-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime48): New command.
+
+2005-09-19 Taylor Campbell <campbell(a)mumble.net>
+
+ * swank-scheme48/: New backend.
+
+2005-09-18 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * bridge.el: cl is required at macro expansion time (because of
+ `block'). Reported by Matthew D Swank.
+
+2005-09-18 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp: Move presentation menu protocol here from present.lisp.
+
+2005-09-15 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * slime.el (slime-repl-return) don't copy presentation to input if
+ already in input area.
+
+2005-09-15 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-clisp.lisp (compute-backtrace): Include only "function
+ frames" in the backtrace. I hope that makes some sense.
+ (sldb-backtrace, function-frame-p): New functions.
+ (*sldb-backtrace*, call-with-debugging-environment, nth-frame):
+ Compute and remember the backtrace when entering the debugger.
+ (arglist): If the function has a function-lambda-expression, fetch
+ the arglist from there.
+ (find-encoding): Use strings instead of 'charset:foo symbols to
+ avoid compile time problems if the charset is not available.
+ Suggested by Vaucher Laurent.
+
+ * swank.lisp (eval-in-emacs): Fix a race condition which occurred
+ with sigio.
+ (*echo-area-prefix*): New variable.
+
+ * slime.el (slime-process-available-input): Simplify it a bit and
+ make it easier to debug read errors.
+ (slime-net-close): Don't kill the buffer if the new optional arg
+ `debug' is true.
+ (slime-run-when-idle): Accept arguments for the function.
+ (slime-init-connection-state): Close over the proc variable. It
+ was lost when the async evaluation returned.
+ (slime-output-buffer, slime-connection-output-buffer): Make
+ slime-output-buffer faster by keeping the buffer in a connection
+ variable.
+ (slime-restart-inferior-lisp-aux, slime-quit-lisp): Disable the
+ process filter to avoid errors in XEmacs.
+
+2005-09-14 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el (slime-menu-choices-for-presentation), (slime-presentation-menu)
+ Fix loss after refactoring. xemacs can't handle lambda forms in
+ the menu spec given to x-popup-menu, only symbols, so save the
+ actions in a hash table keyed by a gensym, give x-popup-menu the
+ gensym and then call the gensym. Haven't checked that it actually
+ works in xemacs because my xemacs is hosed in os x Tiger. Could
+ someone let me know...
+
+ * swank.lisp (inspect-factor-more-action)
+ rename (inspect-show-more-action) Prompt before reading how many
+ more. Would be nicer to prompt in the minibuffer...
+
+2005-09-14 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-presentation-expression): Remove handling of
+ cons presentation-ids.
+
+2005-09-13 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el (defcustom slime-ed-use-dedicated-frame ... vs defvar
+
+ (defcustom slime-when-complete-filename-expand: Use
+ comint-replace-by-expanded-filename instead of
+ comint-dynamic-complete-as-filename to complete file names
+
+ * swank.lisp (run-repl-eval-hooks .. finally (return vs no return
+
+ inspector-call-nth-action Allow second value :replace for inspector actions
+
+ (defvar *slime-inspect-contents-limit* default nil. How many elements of
+ a hash table or array to show by default. If table has more than
+ this then offer actions to view more. Set to nil for no limit. Probably should
+ set default to reasonable value - I like 200.
+
+ (inspect-for-emacs ((ht hash-table) inspector)) - banner line is hash table object.
+ Respect *slime-inspect-contents-limit*
+
+ (defmethod inspect-for-emacs ((array array) inspector)
+ Respect *slime-inspect-contents-limit*
+
+ * swank-openmcl.lisp inspector for closures shows closed-over
+ values. To be fixed: inspector-princ needs to be loaded earlier
+ since swank package not available when compiling
+
+2005-09-13 Helmut Eller <heller(a)common-lisp.net>
+
+ * present.lisp (menu-choices-for-presentation-id): Use
+ lookup-presented-object secondary return value instead of
+ *not-present*.
+ (execute-menu-choice-for-presentation-id, presenting-object-1):
+ Remove references to *can-print-presentation*.
+
+ * slime.el (slime-current-output-id): Remove this ugly klugde.
+ (slime-repl-insert-result): New function. Handle the presentations
+ and other special cases cleaner.
+ (slime-repl-insert-prompt): Use it. The `result' arg is now a
+ structured list; update callers accordingly.
+ (slime-repl-return): Make the prefix arg work again.
+ (package-updating): The result of swank::listener-eval changed a
+ bit. Update the test.
+
+ Remove some unnecessary uses of `defun*' and reindent it to 80
+ columns.
+
+ * swank.lisp: Simplify the object <-> presentation-id mapping.
+ (save-presented-object): Remove the optional `id' arg.
+ (lookup-presented-object): Id should be a fixnum not some cons
+ with fuzzy/non-documented meaning. Use the secondary return value
+ to test for absence of the id. Update callers accordingly.
+ (*not-present*): Deleted.
+
+ Remove the repl result special cases, let the general presentation
+ machinery handle it.
+ (*last-repl-result-id*, add-repl-result, *current-id*)
+ (clear-last-repl-result): Deleted.
+ (listener-eval): Don't *current-id* to tag result values.
+
+ (*can-print-presentation*): Deleted. Nobody quite knows whether
+ it's still needed so let just try without it. Updated referrers
+ accordingly.
+
+ (eval-region, run-repl-eval-hooks): Move the eval hook stuff to
+ a separate function.
+
+ * swank-loader.lisp (lisp-version-string)[cmu]: Replace spaces
+ with underscores.
+
+2005-09-12 NIIMI Satoshi <sa2c(a)sa2c.net>
+
+ * swank.lisp, slime.el, swank-clisp.lisp, swank-sbcl.lisp: add
+ EUC-JP as coding system. This patch eliminates the requirement of
+ Mule-UCS to use Japanese characters. (Nice for pre-22 Emacs
+ users.)
+
+2005-09-10 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-enable-evaluate-in-emacs): Resurrected.
+ (slime-dispatch-event): Respect slime-enable-evaluate-in-emacs for
+ messages :eval-no-wait and :eval.
+
+2005-09-09 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * slime.el (slime-choose-overlay-region). Don't try to overlay a
+ note if location is nil.
+
+2005-09-08 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * bridge.el Fix bug in bridge filter where a bridge message which
+ straddled a packet would be mishandled. Sometimes this would
+ result in spurious bridge message text being inserted with the
+ presentation and the presentation not being sensitive. In other
+ cases there would be an actual error. Introduce bridge-leftovers
+ to save the last, unfinished bit for the next call, and prepend it
+ before processing a chuunk. Also, fix the parentheses so that the
+ unwind protect cleanup forms are actually in the cleanup section.
+ In openmcl, where apparently communication with slime is done in
+ 2k chunks, you can trigger the bug with something like this:
+ (swank::presenting-object 'foo t
+ (dotimes (i 2040) (write-char #\:)))
+
+ * swank-openmcl.lisp (handle-compiler-warning). Don't create a
+ location if the condition doesn't have a filename. If it does,
+ make sure you pass a string rather than a pathname object
+ otherwise you get a net-read error
+
+2005-09-07 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * present.lisp (menu-choices-for-presentation): The
+ Inspect/Describe/Copy items are now provided from the Emacs side.
+ Implement all pathname menu items without having Emacs evaluate a
+ form. Fix for Lisps where ".lisp" is parsed as :name ".lisp".
+
+ * slime.el (slime-menu-choices-for-presentation): New function,
+ return a menu with Inspect/Describe/Copy plus the items that come
+ from the menu protocol.
+ (slime-presentation-menu): Security improvement for the
+ presentation menu protocol: Don't eval arbitrary forms coming from
+ the Lisp. Minor cleanup: Use x-popup-menu in the normal Emacs way,
+ associating a command with each menu item.
+
+2005-09-05 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-cmucl.lisp (background-message): New function. Forward the
+ call to the front end.
+ (pre-gc-hook, post-gc-hook): Use it.
+ (swank-sym, sending-safe-p): Deleted.
+
+ * swank.lisp (y-or-n-p-in-emacs): Simplify arglist.
+ (evaluate-in-emacs, dispatch-event, send-to-socket-io): Remove
+ evaluate-in-emacs stuff.
+ (to-string): Undo last change. to-string is not to supposed to
+ ignore errors. Bind *print-readably* instead.
+ (background-message): New function.
+ (symbol-external-p): Simplify it a little.
+
+ * slime.el (slime-setup-command-hooks): Add after-change-functions
+ only if presentations are enabled.
+ (slime-dispatch-event, slime-enable-evaluate-in-emacs)
+ (evaluate-in-emacs): Remove evaluate-in-emacs stuff. It was not
+ used and redundant.
+ (slime-save-some-lisp-buffers): Renamed from
+ save-some-lisp-buffers.
+ (slime-choose-overlay-region): Ignore :source-form locations.
+ (slime-choose-overlay-for-sexp): Ignore errors when stepping over
+ forms.
+ (slime-search-method-location, slime-goto-location-position): Move
+ all this regexpery to its own function.
+ (slime-recenter-if-needed, slime-repl-return): Factor some
+ duplicated code into its own function.
+ (slime-presentation-bounds, slime-presentation-around-point)
+ (slime-presentation-around-or-before-point): Minor cleanups.
+
+2005-09-04 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-ensure-presentation-overlay): New.
+ (slime-add-presentation-properties): Don't add face, mouse-face,
+ keymap text properties. Call slime-ensure-presentation-overlay to
+ implement them via overlays.
+ (slime-remove-presentation-properties): Don't remove these text
+ properties. Delete the right overlay.
+ (slime-after-change-function): Add overlays for presentations if
+ necessary.
+ (slime-copy-presentation-at-point): Don't add face text property.
+ (slime-repl-grab-old-output): Likewise.
+
+2005-08-31 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (to-string): Handle errors during printing of objects.
+
+2005-08-30 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * slime.el (slime-mark-presentation-start/end-handler) modify
+ regexp to recognize negative presentation ids to make
+ presenting-object work with bridge mode.
+
+2005-08-30 Luke Gorrie <luke(a)synap.se>
+
+ * present.lisp: Added public domain dedication (OK'd by Alanr and
+ Matthias on the list).
+
+2005-08-29 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank-lispworks.lisp (env-internals:confirm-p): Use new function
+ y-or-n-p-in-emacs rather than eval-in-emacs.
+
+ * swank-cmucl.lisp (eval-in-emacs): Removed.
+ (send-to-emacs): New.
+ (pre-gc-hook, post-gc-hook): Use new protocol message
+ :background-message rather than eval-in-emacs.
+
+ * swank.lisp (dispatch-event, send-to-socket-io): Handle new
+ messages :y-or-n-p, :background-message.
+ (y-or-n-p-in-emacs): New function.
+
+ * slime.el (slime-dispatch-event): Handle new messages :y-or-n-p,
+ :background-message.
+ (slime-y-or-n-p): New.
+
+2005-08-29 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el (sldb-insert-condition) - Add tooltip for long
+ condition string which otherwise falls off the right of the screen
+ * swank.lisp (list-threads) - thread name might be a symbol - pass
+ the symbol name when that happens
+
+2005-08-29 Juho Snellman <jsnell(a)iki.fi>
+
+ * swank-sbcl.lisp (make-weak-key-hash-table): Remove the
+ implementation; SBCL doesn't actually support weak hash-tables.
+
+2005-08-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-repl-kill-input): New command.
+ (slime-repl-mode-map): Bind it to C-c C-u, like in comint.
+ (slime-repl-easy-menu): Include it in the REPL menu.
+ (slime-repl-mode-hook): Show the SLIME menu in the REPL too.
+
+ * swank-backend.lisp (make-weak-key-hash-table)
+ (make-weak-value-hash-table): New interfaces.
+ * swank-cmucl.lisp (make-weak-key-hash-table): Implement it.
+ * swank-sbcl.lisp (make-weak-key-hash-table): Implement it.
+ * swank-openmcl.lisp (make-weak-key-hash-table)
+ (make-weak-value-hash-table): Implement it.
+
+ * swank.lisp (*object-to-presentation-id*)
+ (*presentation-id-to-object*): Use new functions
+ make-weak-key-hash-table, make-weak-value-hash-table.
+
+ * slime.el (slime-enable-evaluate-in-emacs): New variable.
+ (evaluate-in-emacs): Security improvement: If
+ slime-enable-evaluate-in-emacs is nil (the default), don't
+ evaluate forms sent by the Lisp.
+
+ * swank.lisp (send-to-socket-io): Handle :evaluate-in-emacs.
+
+2005-08-27 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-presentation-menu): When an object is no longer
+ recorded, remove text properties from the presentation.
+
+2005-08-15 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank-openmcl.lisp (condition-source-position)
+ ccl::compiler-warning-stream-position is sometimes nil, so placate
+ this function by making it (or .. 0). Wrong but I don't have
+ enough time now to figure out what the right thing is.
+
+
+2005-08-24 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (fuzzy-find-matching-symbols): When completing the
+ string "package:" present a list of all the external symbols in
+ package (completing "package::" lists internal symbols as well).
+ (inspect-for-emacs standard-class): List all the slots in the
+ class (as per standard-object). The previous method of hard coding
+ the slots in the inspector's code made inspecting custom
+ meta-classes useless.
+
+2005-08-24 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * swank-sbcl.lisp (method-definitions): present qualifiers (if
+ any).
+
+2005-08-23 Taylor R. Campbell <campbell(a)bloodandcoffee.net>
+
+ * slime.el (slime-goto-location-position): Added a second regexp
+ for the :function-name case which matches "(def... ((function-name
+ ..." (with N opening parens preceding the function name). This is
+ to allow scheme48 style function names and definitions.
+
+2005-08-22 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * swank-clisp.lisp (fspec-pathname): Cope with CVS CLISP's
+ (documentation symbol 'sys::file) returning a list. Return either
+ a list of start and end line positions or nil as second value.
+ (fspec-location): Use it. Also, if we have to guess the name of a
+ source file make sure that it actually exists.
+
+ (with-blocked-signals, call-without-interrupts): Don't add
+ :linux to *features* since this changes the return value of
+ unique-directory-name in swank-loader.lisp.
+ Comment out with-blocked-signals.
+
+ Update some comments at the top of the file.
+ State the licence in the same terms as slime.el does.
+
+2005-08-21 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * present.lisp (menu-choices-for-presentation-id): Check against
+ the gensym in *not-present* instead of :non-present.
+
+2005-08-20 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * swank-sbcl.lisp (preferred-communication-style): guard against
+ non-Linux non-linkage-table platforms (and assume that they won't
+ have dodgy threads) with #+linux.
+
+2005-08-20 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Enable nested presentations.
+
+ * slime.el (slime-presentation): Remove slots start-p, stop-p.
+ (slime-add-presentation-properties): Use a new text property
+ layout. Also add an overlay to enable nested highlighting.
+ (slime-remove-presentation-properties): New.
+ (slime-presentation-whole-p): Changed interface.
+ (slime-presentations-around-point): New.
+ (slime-same-presentation-p): Removed.
+ (slime-presentation-start-p, slime-presentation-stop-p): New.
+ (slime-presentation-start, slime-presentation-end): Changed to use
+ new text property layout.
+ (slime-presentation-bounds): New.
+ (slime-presentation-around-point): Reimplemented to handle nested
+ presentations.
+ (slime-for-each-presentation-in-region): New.
+ (slime-after-change-function): Use
+ slime-remove-presentation-properties and
+ slime-for-each-presentation-in-region.
+ (slime-copy-presentation-at-point): Complain if no presentation.
+ (slime-repl-insert-prompt): Don't put rear-nonsticky text property.
+ (slime-reify-old-output): Handle nested presentations.
+ (slime-repl-return): Use slime-presentation-around-or-before-point.
+
+ Enable reification of presentations in non-REPL buffers.
+
+ * slime.el (slime-buffer-substring-with-reified-output): New,
+ factored out from slime-repl-current-input.
+ (slime-repl-current-input): Use it here.
+ (slime-last-expression): Use it here.
+
+ (slime-add-presentation-properties): Add text properties
+ modification-hooks et al. to enable self-destruction of incomplete
+ or edited presentations in non-REPL buffers.
+
+2005-08-15 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el (slime-goto-location-position) fix so the :method locator
+ regexp so that it can find eql specializers, (setf foo) methods, and to
+ allow (a single) newline between arguments in the arglist.
+
+ * swank-openmcl.lisp (specializer-name) patch from Gary Byers and
+ Bryan O'Conner to fix complaint about certain classes slipping
+ through the etypecase
+
+2005-08-14 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-mark-presentation-end): Really remove the
+ presentation-start entry from the hash table.
+
+ Merge some code from present.lisp, removing code duplication.
+ Minor code clean-up.
+
+ * swank.lisp (*object-to-presentation-id*)
+ (*presentation-id-to-object*, clear-presentation-tables)
+ (*presentation-counter*, lookup-presented-object): Move here from
+ present.lisp.
+ (save-presented-object): Likewise. Assign negative numbers only,
+ so as not to clash with continuation ids.
+
+ * swank.lisp (*repl-results*): Removed.
+
+ * swank.lisp (get-repl-result, clear-repl-results): Use new
+ implementations from present.lisp.
+ (add-repl-result): Likewise, don't take the negative of the id.
+ (*last-repl-result-id*): New variable.
+ (clear-last-repl-result): Use it here.
+
+ * slime.el (slime-repl-insert-prompt): Don't take the negative of
+ the id.
+ (slime-presentation-expression): New, take care to handle
+ arbitrary *read-base* settings.
+ (reify-old-output): Use it here.
+ (slime-read-object): Use it here.
+
+2005-08-12 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (substring-no-properties): Fix to handle non-zero start
+ argument correctly.
+
+ Patch to remove use of the slime-repl-old-output text property in
+ favor of the slime-repl-presentation text property, in order to
+ simplify the code.
+
+ * slime.el (slime-presentation-whole-p): Generalize to work with
+ strings too.
+ (slime-presentation-start, slime-presentation-end): Likewise.
+ (slime-presentation-around-point): Likewise.
+ (slime-presentation-around-or-before-point): New.
+
+ * slime.el (reify-old-output): Use slime-repl-presentation
+ property and slime-presentation-around-point function rather than
+ slime-repl-old-output property.
+ (slime-repl-return): Use slime-repl-presentation rather than
+ slime-repl-old-output.
+ (slime-repl-grab-old-output): Use
+ slime-presentation-around-or-before-point.
+ (slime-read-object): Use slime-presentation-around-point.
+
+ * slime.el (toplevel): Don't handle slime-repl-old-output text
+ property.
+ (slime-add-presentation-properties): Likewise.
+ (slime-after-change-function): Likewise.
+
+2005-08-12 Yaroslav Kavenchuk <kavenchuk(a)jenty.by>
+
+ * swank-clisp.lisp (fspec-pathname): Use the documentation
+ function instead of accessing clisp internals.
+
+2005-08-11 Edi Weitz <edi(a)agharta.de>
+
+ * swank.lisp (transpose-lists): Fixed it.
+
+2005-08-10 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el move slime-repl-add-to-input-history to
+ slime-repl-send-input so we can see the presentations we copied to
+ input when we reuse history rather than #.(blah...)
+ [Thanks Matthias! - was very busy and just returned to see your
+ changes merged. Most excellent.]
+
+2005-08-10 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-presentation-around-point): Change interface,
+ return presentation as primary return value.
+ (slime-copy-presentation-at-point): Use
+ slime-presentation-around-point. Copying now also works when the
+ first character is clicked and when the REPL buffer is not current.
+ (slime-presentation-menu): Use slime-presentation-around-point.
+
+2005-08-10 Martin Simmons <martin(a)lispworks.com>
+
+ * swank-lispworks.lisp (defadvice compile-file): Return all values
+ from the real compile-file.
+
+2005-08-10 Edi Weitz <edi(a)agharta.de>
+
+ * swank.lisp (transpose-lists): Replaced with much nicer function
+ by Helmut Eller.
+
+2005-08-09 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-read-object): Handle ids that are conses.
+ Patch by "Thas" on #lisp.
+
+2005-08-09 Edi Weitz <edi(a)agharta.de>
+
+ * swank.lisp (transpose-lists): Reimplemented without APPLY so we
+ don't have problems with CALL-ARGUMENTS-LIMIT.
+
+2005-08-08 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (undo-in-progress): Define for XEmacs compatibility.
+ Reported by Friedrich Dominicus.
+
+2005-08-07 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Fix for the presentations menu. Reported by Aleksandar Bakic.
+
+ * present.lisp (lookup-presented-object): Handle ids that are
+ conses.
+ (execute-menu-choice-for-presentation-id): Use equal for comparing
+ ids, to handle the cons case.
+ (menu-choices-for-presentation): Quote the presentation id, as it
+ can be a cons.
+ * slime.el (slime-presentation-menu, slime-presentation-menu)
+ (slime-inspect-presented-object): Quote the presentation id.
+
+2005-08-06 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (form-completion): New generic function, factored out
+ from complete-form.
+ (complete-form): Factor out form-completion.
+ (form-completion): Specialize on defmethod forms to insert arglist
+ of generic function.
+
+ * doc/slime.texi (Programming Helpers): Document C-c C-s,
+ slime-complete-form.
+
+2005-08-04 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Improvements to the presentations feature. Parts of presentations
+ can be copied reliably using all available Emacs facilities (not
+ just kill-ring-save), and they are no longer "semi-readonly" (in
+ the sense that keypresses are silently ignored). Whenever a user
+ attempts to edit a presentation, it now simply turns into plain
+ text (which is indicated by changing the face); this can be
+ undone. Presentations are now also supported if
+ *use-dedicated-output-stream* is nil. It is now possible to
+ access the individual values of multiple-value results. For some
+ systems (Allegro CL and upcoming CMUCL snapshots), presentations
+ can be reliably printed through pretty-printing streams.
+
+ * present.lisp (slime-stream-p) [allegro]: Allow printing
+ presentations through pretty printing streams.
+ [cmu]: Allow printing presentations through pretty printing
+ streams, if CMUCL has annotations support and we are using the
+ bridge-less protocol.
+ [sbcl]: Allow printing presentations through indenting streams.
+
+ * present.lisp (write-annotation): New function.
+ (presentation-record): New structure.
+ (presentation-start, presentation-end): New functions, supporting
+ both bridge protocol and bridge-less protocol.
+ (presenting-object-1): Use them here.
+
+ * present.lisp [sbcl, allegro]: Add printer hooks for unreadable
+ objects and pathnames.
+
+ * swank.lisp (*can-print-presentation*): New variable, moved here
+ from present.lisp.
+ * swank.lisp (interactive-eval, listener-eval, backtrace)
+ (swank-compiler, compile-file-for-emacs, load-file)
+ (init-inspector): Bind *can-print-presentation* to an appropriate
+ value.
+ * present.lisp: Remove code duplication with swank.lisp for the
+ functions above.
+
+ * swank.lisp (encode-message): Don't use the pretty printer for
+ printing the message length.
+
+ * slime.el (slime-dispatch-event): New events :presentation-start,
+ :presentation-end for bridge-less presentation markup.
+ * swank.lisp (dispatch-event, send-to-socket-io): Likewise.
+
+ * swank.lisp (listener-eval): Store the whole values-list with
+ add-repl-result.
+ * slime.el (slime-repl-insert-prompt): Accept a list of strings,
+ representing individual values of a multiple-value result. Mark
+ them up as separate presentations.
+ (reify-old-output): Support reifying individual values of a
+ multiple-value result.
+
+ * slime.el (slime-pre-command-hook): Don't call
+ slime-presentation-command-hook.
+ (slime-post-command-hook): Don't call
+ slime-presentation-post-command-hook.
+ (slime-presentation-command-hook): Removed.
+ (slime-presentation-post-command-hook): Removed.
+
+ * slime.el (slime-presentation-whole-p): New.
+ (slime-same-presentation-p): New.
+ (slime-presentation-start, slime-presentation-end): New.
+ (slime-presentation-around-point): New.
+ (slime-after-change-function): New.
+ (slime-setup-command-hooks): Install slime-after-change-function
+ as an after-change-function.
+
+ * slime.el (slime-repl-enable-presentations): Make
+ slime-repl-presentation nonsticky.
+ (slime-mark-presentation-start, slime-mark-presentation-end): New
+ functions.
+ (slime-mark-presentation-start-handler): Renamed from
+ slime-mark-presentation-start.
+ (slime-mark-presentation-end-handler): Renamed from
+ slime-mark-presentation-end.
+ (slime-presentation): New structure.
+ (slime-add-presentation-properties): New function.
+ (slime-insert-presentation): New function.
+
+2005-08-03 Zach Beane <xach(a)gwi.net>
+
+ * swank-sbcl.lisp (swank-compile-string): Restore honoring of
+ *trap-load-time-warnings*.
+
+2005-08-03 Juho Snellman <jsnell(a)iki.fi>
+
+ * swank-sbcl.lisp: Remove SBCL 0.9.1 support.
+ (swank-compile-string): Funcall the compiled function outside
+ with-compilation-hooks to prevent runtime warnings from
+ popping up a *compiler-notes* buffer.
+
+2005-07-29 Marco Baringer <mb(a)bese.it>
+
+ * doc/slime.texi (Other configurables): Document
+ *dedicated-output-stream-port*.
+
+ * swank.lisp (*dedicated-output-stream-port*): New variable.
+ (open-dedicated-output-stream): Open the stream on the port
+ *dedicated-output-stream-port*.
+
+ * slime.el (slime-set-default-directory): Fix typo in doc string.
+
+2005-07-26 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank.lisp (inspect-for-emacs): Don't make whitespace
+ surrounding :action buttons part of the highlighted region.
+
+ * slime.el (slime-goto-location-buffer): Put "SLIME Source Form"
+ buffer into Lisp mode.
+
+2005-07-26 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (compile-file-for-emacs): Accept optional
+ external-format arg. I frogot to commit this file on 2005-07-05.
+
+ * slime.el (slime-input-complete-p): Skip over strings too.
+
+2005-07-26 Zach Beane <xach(a)xach.com>
+
+ * swank-sbcl.lisp (swank-compile-string): Revert to old string
+ compilation behavior to fix compiler note annotations. Code from
+ Juho Snellman.
+
+2005-07-24 Tom Pierce <tlpierce(a)gmail.com>
+
+ * swank.lisp (format-iso8601-time): New functions. Properly
+ formats a universal-time as an iso8601 string.
+ (inspect-for-emacs integer): Use the new
+ format-iso8601 function when printing an integer as a date.
+
+2005-07-22 Marco Baringer <mb(a)bese.it>
+
+ * swank-openmcl.lisp (frame-catch-tags): Remove some debugging
+ forms which were "polluting" the repl buffer when viewing an sldb
+ buffer.
+ (function-source-location): Make :error messages have the proper
+ form (exactly one string argument). This fix also removes the
+ issues with sending unreadble lists (containing #<...> to emacs).
+
+2005-07-14 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-allegro.lisp (find-external-format): Fix typo.
+
+2005-07-06 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-send-sigint): Use the symbol SIGINT stead of the
+ signal number. Suggested by Joerg Hoehle.
+ (slime-compile-file): XEmacs needs the buffer as argument to
+ local-variable-p. Reported by Andy Sloane.
+
+2005-07-05 Helmut Eller <heller(a)common-lisp.net>
+
+ The file variable slime-coding can now be used to specify the
+ coding system to use for C-c C-k. E.g., if the file contains
+ -*- slime-coding: utf-8-unix -*- Emacs will tell the Lisp side
+ to call COMPILE-FILE with an external-format argument.
+
+ * slime.el (slime-compile-file): Send the coding system if
+ the buffer local variable `slime-coding' is bound.
+
+ * swank-backend.lisp, swank-sbcl.lisp, swank-clisp.lisp,
+ swank-lispworks.lisp, swank-cmucl, swank-allegro.lisp,
+ swank-abcl.lisp, swank-corman.lisp
+ (swank-compile-file): New optional argument `external-format'.
+
+ * swank-clisp.lisp (getpid): Undo the last change.
+
+ * swank-corman.lisp (spawn, thread-alive-p): More thread tweaking.
+
+2005-07-03 Joerg Hoehle <hoehle(a)users.sourceforge.net>
+
+ * swank-clisp (describe-symbol-for-emacs): Report :setf and :type
+ where appropriate.
+
+2005-07-03 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (next-single-char-property-change)
+ (previous-single-char-property-change) [xemacs]: Only define them
+ if not present.
+ (next-char-property-change, previous-char-property-change): Define
+ if needed.
+
+ * README: Show examples for the filenames instead of the general
+ "/the/path/to/this/directory". Suggested by Brandon J. Van Every.
+
+ * swank-corman.lisp (default-directory): Return a namestring
+ instead of the pathname.
+ (inspect-for-emacs, inspect-structure): Teach the inspector how to
+ deal with structures.
+ (spawn, send, receive): Implement rudimentary threading support.
+ It's now possible to connect with the :spawn communication style
+ and to bring up a listener. Unfortunately, debugging the
+ non-primary threads doesn't work at all. Still no support for
+ interrupt-thread.
+
+ * slime.el (slime-start-swank-server): Send an extra newline
+ before the "(swank:start-server ...". I don't know why, but this
+ seems to fix the problem when starting CLISP/Win32. Interrupting
+ CLISP/W32 is still horribly broken.
+
+ * swank-loader.lisp (compile-files-if-needed-serially) [corman]:
+ force-output after each file.
+
+2005-07-02 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (save-some-lisp-buffers): New Function.
+ (slime-repl-only-save-lisp-buffers): New customizable variable.
+ (slime-repl-compile-and-load): Use save-some-lisp-buffers.
+ (slime-oos): Use save-some-lisp-buffers.
+
+2005-07-01 G�bor Melis <mega(a)hotpop.com>
+
+ * swank-sbcl.lisp (threaded stuff): make SBCL 0.9.2.9+ work while
+ retaining support for 0.9.2
+
+2005-06-28 G�bor Melis <mega(a)hotpop.com>
+
+ * swank-sbcl.lisp (threaded stuff): horrible hack to make threaded
+ SBCL 0.9.2 work. (also, Happy Birthday Christophe!)
+
+2005-06-21 Edi Weitz <edi(a)agharta.de>
+
+ * swank.lisp (find-matching-packages): Also use nicknames.
+
+2005-06-13 Edi Weitz <edi(a)agharta.de>
+
+ * swank.lisp (list-all-systems-in-central-registry): Delete
+ duplicates.
+
+ * swank-lispworks.lisp (unmangle-unfun): If you rename a package
+ you should rename it everywhere...
+
+2005-06-12 Alexey Dejneka <adejneka(a)comail.ru>
+
+ * slime.el (slime-with-xref-buffer): fix "pgk" typo.
+
+2005-06-12 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * swank.lisp (ed-in-emacs): allow strings as well as pathnames;
+ don't call emacs for things that the emacs editor doesn't know how
+ to deal with. Return T if we called emacs and NIL if not.
+
+ * slime.el (slime-ed): Change a listp to consp, so that NIL
+ arguments are correctly handled.
+
+2005-06-11 Nikodemus Siivola <nikodemus(a)random-state.net>
+
+ * swank-sbcl.lisp: Patched for SBCL HEAD: utilize the new
+ :source-plist functionality; maintain compatibility with 0.9.1
+ till 0.9.2 is out. Removed cruft left over from previous
+ excercises in supporting both HEAD and latest release.
+
+ * doc/slime.texi: Document Slime as supporting the latest official
+ release of SBCL, as opposed to a specific version number which
+ would need to be updated monthly.
+
+2005-06-10 Helmut Eller <heller(a)common-lisp.net>
+
+ * nregex.lisp (slime-nregex): Rename package to avoid name clashes
+ with other version of this file.
+
+ * swank.lisp (compiled-regex): Use the new package name.
+
+ * slime.el (slime-with-xref-buffer): Gensym package too, to avoid
+ problems when switching to buffers with -*- package: ... -*- file
+ variables. From Antonio Menezes Leitao.
+ (slime-property-bounds): Use the prop argument instead of the
+ hardcoded 'slime-repl-old-output. From Andras Simon.
+
+2005-06-07 Espen Wiborg <espenhw(a)grumblesmurf.org>
+
+ * swank-corman.lisp: Convert to Unix line-endings.
+ (create-socket): Pass through the port argument unmodified,
+ gettting a random port if 0. Requires supporting change in
+ <ccl>/modules/sockets.lisp.
+ (inspect-for-emacs): defimplementation instead of defmethod.
+
+2005-06-06 Espen Wiborg <espenhw(a)grumblesmurf.org>
+
+ * doc/slime.texi, PROBLEMS: Added notes about CCL.
+
+2005-06-03 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-background-activities-enabled-p): Allow
+ background stuff in repl-mode buffers too.
+
+ * swank-cmucl.lisp (sis/misc): Return t for :interactive-p.
+
+2005-06-01 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-load-system, slime-oos): Fix bug related to file
+ locking. Don't bind the variable system-name. system-name is a
+ predefined Emacs variable and is used among other things for lock
+ filenames.
+
+2005-06-01 Joerg Hoehle <hoehle(a)users.sourceforge.net>
+
+ * swank-clisp (getpid): Updates for current CLISP versions. Use
+ defimplementation. Define always (slime needs it).
+
+2005-06-01 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-background-activities-enabled-p): Return nil
+ instead of signalling an error if there is a open but no default
+ connection.
+ (slime-current-connection): New helper function.
+ (slime-connection): Use it.
+ (slime-first-change-hook): Only run when
+ slime-background-activities-enabled-p.
+
+2005-06-01 Joerg Hoehle <hoehle(a)users.sourceforge.net>
+
+ * swank-cmucl.lisp, swank-sbcl.lisp, swank-clisp.lisp
+ (describe-symbol-for-emacs): Distinguish macro and special
+ operators from functions.
+
+ * slime.el (slime-print-apropos): Must keep in sync with above,
+ therefore added :macro and :special-operator properties.
+
+ * swank.lisp (present-symbol-before-p): Make it conform to its
+ specification -- sort first by package and then by symbol name.
+
+ * swank-clisp.lisp (describe-symbol-for-emacs): Report :alien-type
+ when the name is known as foreign type.
+
+2005-06-01 Espen Wiborg <espenhw(a)grumblesmurf.org>
+
+ * swank-loader.lisp: Redefine compile-files-if-needed-serially for
+ Corman Lisp to load everything from source.
+
+2005-05-27 Espen Wiborg <espenhw(a)grumblesmurf.org>
+
+ * swank-corman.lisp: New file, swank for Corman Lisp.
+
+ * swank.lisp (simple-announce-function): force-output after
+ announcing.
+ (symbol-external-p): Be extra paranoid about the symbol's package;
+ find-symbol barfs on a nil package in Corman Lisp.
+
+ * swank-loader.lisp: Add Corman Lisp support.
+
+2005-05-24 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el text-property-default-nonsticky not defined in
+ xemacs. oops.
+
+2005-05-24 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el meta-w now removes properties before insertion if you
+ cut just a portion of the presentation. Added xemacs
+ support. Enabled in xemacs.
+
+2005-05-23 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el slime-presentation-menu - use with-current-buffer, so
+ that menus work even if you are not in the buffer with the
+ presentation.
+
+ * present.lisp More menu items for pathnames. Remember last
+ slime-stream-p value. *can-print-presentation* t during
+ swank-compiler and during presentation menu action.
+
+2005-05-22 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * present.lisp. (slime-stream-p) check if a stream is destined for
+ output in a slime listener. (checks *connections* looks into pretty-print
+ streams in openmcl and cmucl)
+ Don't present unless (slime-stream-p stream).
+
+ Variable *enable-presenting-readable-objects* The only readable object
+ which is presented are pathnames (e.g. pathnames printed when loading
+ and *load-verbose* is t). Try the useful menu :)
+ More to come if this doesn't cause problems. (nil this if it does)
+
+ *can-print-presentation* t around compile-string-for-emacs,
+ load-file, interactive-eval.
+
+ In cmucl, use fwrappers to modify behaviour rather than redefinition.
+
+2005-05-22 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * present.lisp. mouse-3 now gives a menu for actions on the
+ presentation. See documentation in file for information about how
+ to define menus. Also, disable presentations in inspector. Initial bits
+ of dealing with the possibility of presenting readable objects.
+
+ * slime.el support menu. Xemacs users beware this uses x-popup-menu,
+ which may be fsf specific.
+
+2005-05-20 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * swank.lisp make repl output presentation work even if
+ present.lisp not loaded
+
+2005-05-20 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-repl-enable-presentations): Default is enabled
+ in GNU Emacs but disabled in XEmacs. Feature is not portable yet.
+ Brutally 80-column'ified alanr's latest changes :-)
+
+2005-05-20 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * bridge.el new file. from ilisp cvs distribution to collect
+ in-band messages using process filter mechanisms. One edit which
+ calls bridge-insert with process argument as well as output
+
+ * present.lisp new file. Enough code to do the following:
+ (swank::presenting-object object stream (print "This is really
+ object")). This makes the string "This is really object" behave
+ like old repl input for the object. Sample code for openmcl and
+ cmucl that hooks this into the printing of unreadable objects This
+ should be part of swank.lisp (and lisp specific files) but I am
+ too chicken to merge yet. For now you have to load this file
+ manually.
+
+ * slime.el changes to support above:
+ slime-repl-enable-presentations: customize to enable this stuff.
+ Default value t. Set to nil to turn it off.
+ slime-presentation-start-to-point: map object ids to the (point)
+ where they start to print out. slime-mark-presentation-start,
+ slime-mark-presentation-end. handlers for the bridge messages.
+ slime-open-stream-to-lisp: When enabled start the bridge and
+ define the handlers.
+
+2005-05-19 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el slime-presentation-map
+
+2005-05-20 Luke Gorrie <luke(a)synap.se>
+
+ * swank.lisp (clear-repl-results): Fixed unbalanced parens. Thanks
+ Lawrence Mitchell.
+
+2005-05-19 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el (slime-presentation-command-hook) new function for
+ nicer behaviour for presentations.
+ (slime-pre-command-hook) do slime-presentation-command-hook
+ (slime-post-command-hook) put pre-command-hook back if goes away
+ (slime-copy-presentation-at-point) mouse-2 copies previous output to point
+ slime-repl-output-mouseover-face what the old output looks like when the mouse moves over it
+ default: box around it like on lispm
+ (slime-repl-insert-prompt) add mouseover face, mouse action. newline after output not propertized.
+ (slime-property-bounds) adjust for lack of propertized newline
+ to fix: presentation region behaviour should be attach to generic property like
+ (:acts-as-token t ) rather than tying to repl-output property
+
+2005-05-19 Luke Gorrie <luke(a)synap.se>
+
+ * swank.lisp (*record-repl-results*): Variable to enable/disable
+ recording of REPL results. True by default.
+ (*repl-results*): Renamed from ****.
+
+ * slime.el (slime-property-bounds): Factored out this common part
+ of slime-repl-grab-old-{input,output}.
+ (slime-read-object): Avoid inline CL code.
+
+2005-05-18 Antonio Menezes Leitao <aml(a)gia.ist.utl.pt>
+
+ * slime.el (slime-repl-inputed-output-face): new face.
+ (slime-current-output-id): New variable.
+ (slime-dispatch-event): Bind slime-current-output-id when
+ neccessary.
+ (slime-repl-insert-prompt): Add the neccessary text properties to
+ the result.
+ (reify-old-output): New function which makes sure swank sees
+ \(swank::get-**** ...) while the user sees the printed
+ representation of the object.
+ (slime-repl-return): When called on a old output (as per the
+ slime-repl-old-output text property, call
+ slime-repl-grab-old-output.
+ (slime-repl-send-input): Added the slime-repl-old-input text
+ property.
+ (slime-repl-grab-old-input): Keep the old input's text
+ properties (unwanted text properties are removed later).
+ (slime-repl-grab-old-output): New function.
+ (slime-repl-clear-buffer): Added call to swank::clear-****
+ (slime-repl-clear-output): Added call to swank::clear-**** and
+ bind inhibit-read-only to nil.
+ (slime-inspect): Call slime-read-object to get the value to
+ inspect.
+ (slime-read-object): New function which either reads an object
+ from the minibuffer or returns the object at point if it has the
+ slime-repl-old-output text property.
+
+ * swank.lisp (*current-id*, ****): New variables.
+ (add-****, get-****, clear-last-****, clear-****): New functions
+ for manipulating the repl history.
+ (listener-eval): Add * to ****.
+
+2005-05-12 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank.lisp Add ability to customize behavior of the repl. To do
+ so, add a function to the list swank::*slime-repl-eval-hooks*.
+ This function is passed the form typed into the repl. The function
+ should decide whether it wants to handle evaluation of the
+ form. If not, call (repl-eval-hook-pass) and the next hook is
+ tried. Otherwise the values the function returns are used instead
+ of calling eval. Inside the body of the function you can also
+ suppress having the repl print the result by calling
+ (repl-suppress-output) and/or suppress the advancement of the
+ history variables (*** ** * /// // /) by calling
+ (repl-suppress-advance-history).
+
+
+2005-05-11 Tim Daly Jr. <tim(a)tenkan.org>
+
+ * swank-source-path-parser.lisp (read-and-record-source-map):
+ Ensure that at least the toplevel form is in the source-map.
+
+2005-05-11 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-remove-old-overlays): Remove overlays in all
+ slime buffers not only in the current buffer.
+ (slime-filter-buffers): New helper.
+ (slime-display-completion-list): Take the completed prefix as
+ additional argument to initialize completion-base-size. This is
+ apparently needed to make mouse-selection working.
+ (slime-maybe-complete-as-filename): Factor for common code in
+ slime-complete-symbol* and slime-simple-complete-symbol.
+
+2005-05-06 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank-openmcl.lisp specializer-name didn't handle
+ structure-class which caused meta-. of methods specialized on
+ defstruct arguments to fail.
+
+2005-05-06 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-cmucl.lisp (post-gc-hook): Include the elapsed time and
+ the size distribution.
+
+2005-05-05 Edi Weitz <edi(a)agharta.de>
+
+ * swank-lispworks.lisp (unmangle-unfun): New function to convert
+ strange symbols in SETF package to SETF function names.
+ (signal-undefined-functions): Use it.
+
+2005-05-04 Edi Weitz <edi(a)agharta.de>
+
+ * swank-lispworks.lisp (call-with-compilation-hooks): Provide
+ better implementation.
+ (compile-file-and-collect-notes): Advice for COMPILE-FILE so
+ pathname information for undefined functions can be recorded.
+ (*within-call-with-compilation-hooks*): New special variable used
+ by CALL-WITH-COMPILATION-HOOKS.
+ (*undefined-functions-hash*): New special variable to record
+ pathname information for undefined functions.
+ (signal-error-database): Make LOCATION parameter optional, use
+ FILENAME info from error database if not provided.
+ (signal-undefined-functions): Make LOCATION parameter optional,
+ use info from *UNDEFINED-FUNCTIONS-HASH* if not provided.
+
+2005-05-03 Luke Gorrie <luke(a)synap.se>
+
+ * swank.lisp (slime-secret): Removed #+unix conditional, suggested
+ by Edi Weitz.
+
+2005-05-02 Mark Wooding <mdw(a)nsict.org>
+
+ * swank.lisp: If ~/.slime-secret exists then insist that Emacs
+ sends the contents (as a password) during initial handshaking.
+ (announce-server-port): Use :IF-EXISTS :ERROR to prevent bad guys
+ from slipping a symlink into /tmp and reading what port Lisp is
+ listening on.
+
+ * slime.el: If ~/.slime-secret exists then send it, as per above.
+
+2005-05-01 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-inspector-reinspect): New function which
+ reinspects the current object.
+ (slime-inspector-mode-map): Bind slime-inspector-reinspect to g.
+
+2005-04-29 Dan Pierson <dlp(a)itasoftware.com>
+
+ * slime.el (slime-parse-context): Fix method parsing so that
+ pressing, say, C-c C-t when point is on a '-' in a symbol name
+ won't break.
+ (slime-browser-map): New variable. Add support for the common 'q'
+ keystroke to quit out of the xref.
+ (slime-fetch-browsable-xrefs): New function. Remove the (FLET ...)
+ entries which appear on at least CMUCL. I don't believe you can
+ actually expand them on any current implementation and they just
+ mess up the browse tree. Use only the method name when looking
+ up (METHOD ...) entries on CMUCL. This really shouldn't be here,
+ but I can't see how to avoid the error thrown by swank:xref.
+ (slime-expand-xrefs): Use it.
+ (slime-call-with-browser-setup): Initialize slime-buffer-package
+ properly. Previously, lisp-mode was called after setting it, but
+ lisp-mode clears all local variables, use lisp-mode-variables
+ instead.
+
+ * swank-cmucl.lisp (toggle-trace): Be more carefully when tracing
+ methods: try both (METHOD ...) and (PCL:FAST-METHOD ...).
+
+2005-04-27 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-cmucl.lisp (+header-type-symbols+): Drop the third arg to
+ apropos-list; it's no longer supported in recent CMUCLs.
+
+2005-04-21 Luke Gorrie <luke(a)synap.se>
+
+ * swank.lisp (arglist-to-string): Rolled back the previous change
+ because it interferred with values appearing in parameter lists.
+
+2005-04-20 Luke Gorrie <luke(a)synap.se>
+
+ * swank.lisp (arglist-to-string): Bind *PRINT-ESCAPE* to NIL. This
+ way symbols in arglists are printed as with PRINC, i.e. without
+ package qualifier.
+
+ * swank-sbcl.lisp (preferred-communication-style): Use
+ `linux_no_threads_p' alien variable to decide whether to use
+ :SPAWN. From dan_b for compatibility with new SBCLs.
+
+2005-04-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * PROBLEMS: Warn about old kernels.
+
+ * swank-backend.lisp: Fix some typos.
+
+ * swank-sbcl.lisp (preferred-communication-style): Don't test for
+ sb-futex, it has lost its meaning in 0.8.21.
+
+2005-04-18 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (inferior-lisp-program): Defvar it here, in case it is
+ not defined in loaddefs and inf-lisp is not loaded. (That's the
+ case in XEmacs.)
+
+ * mkdist.sh: update version number.
+
+ * doc/slime.texi: Update version numbers for SBCL and ACL.
+
+2005-04-17 Peter Seibel <peter(a)gigamonkeys.com>
+
+ * swank-loader.lisp (*implementation-features*): Added features
+ for GCL and ECL ...
+ (lisp-version-string): ... and code to compute version
+ string. (Supplied by someone who's email I've misplaced.)
+
+2005-04-14 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-selector): Discard input after sleeping.
+
+2005-04-09 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (sldb-get-buffer): Create a fresh buffer if there's no
+ buffer for the connection (and don't reuse an existing buffer even
+ if it has a matching name).
+ (slime-buffer-visible-p, slime-ir1-expand): Delete unused
+ functions. Mark some others as unused, but leave them there
+ because they are potentially useful.
+
+ * swank.lisp (with-io-redirection, with-connection)
+ (with-buffer-syntax): Implement macros with `call-with' functions
+ to avoid some code bloat.
+ (call-with-connection, maybe-call-with-io-redirection)
+ (call-with-buffer-syntax): New functions.
+ (interactive-eval): Use from-string instead of read-from-string to
+ avoid problems whit *read-suppress*.
+
+ * swank-sbcl.lisp: Add a few comments.
+
+ * swank-abcl.lisp (print-frame): Trim whitespace to make the
+ backtrace look a bit terser.
+
+2005-04-07 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-net-coding-system): More fixes for
+ non-mule-XEmacsen.
+ (slime-net-coding-system): Even more fixes to make it for
+ mule-XEmacs.
+
+2005-04-05 Juergen Gmeiner <gj(a)gjdv.at>
+
+ * swank-lisworks.lisp (find-top-frame): If we can't find an
+ invoke-debugger frame we take any old frame at the top.
+
+2005-04-04 James McIlree <ovrskeek(a)mac.com>
+
+ * slime.el (find-coding-system, check-coding-system)
+ (process-coding-system, set-process-coding-system): Dummy
+ functions for no-mule-XEmacsen.
+
+2005-04-04 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-repl-show-maximum-output): New
+ function. Immitate the scrolling behavior of a terminal.
+ (slime-with-output-end-mark, slime-repl-return)
+ (slime-repl-send-input, slime-display-output-buffer): Use it
+ (slime-lisp-implementation-version, slime-machine-instance): New
+ connection variables. Suggested by Eduardo Mu�oz.
+ (slime-set-connection-info): Initialize them.
+
+ * swank.lisp (connection-info): Include version and hostname in
+ the result.
+
+ * swank-cmucl.lisp (breakpoint-values): Fixes for CMUCL-2005-03
+ snapshot.
+
+ * doc/slime.texi: Fix spelling errors.
+
+ * cl-indent.el: Remove the file. Let the Emacs developers
+ maintain it.
+
+2005-04-01 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (sldb-get-buffer): Initialize the buffer local
+ variables slime-buffer-connection and slime-current-thread when
+ creating a fresh buffer.
+
+ * swank.lisp (spawn-repl-thread): Use
+ *default-worker-thread-bindings* just like spawn-worker-thread.
+ (wrap-sldb-vars): New function. Rebind *sldb-level* to avoid
+ confusion with recursive errors during eval-in-frame.
+ (eval-string-in-frame, pprint-eval-string-in-frame): Use it.
+
+ * swank-allegro.lisp (eval-in-frame): Allegro's
+ eval-form-in-context does nothing special with lexical variables
+ in the frame. Wrap an explicit LET around the form to get similar
+ behavior as in the other Lisps.
+ (inspect-for-emacs (structure-object)): Remove structure related
+ methods. It's already covered by the general case with
+ allegro-inspect.
+ (common-seperated-spec): Deleted
+
+2005-04-01 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-xref-mode): Summarise the most important
+ bindings in the mode description.
+
+ * metering.lisp: Now supports only CLISP and OpenMCL.
+ Removed a lot of really ugly reader-conditionalized code, much of
+ it for archaic lisps (#+cltl2, #+lcl3.0, #+mcl1.3.2, etc).
+
+ * swank-source-path-parser.lisp (check-source-path): Signal an
+ error if a source path is malformed. SBCL sometimes gives (NIL).
+ (source-path-stream-position): Use it.
+
+ * slime.el (slime-goto-definition): Handle :error locations here
+ before any window/buffer changes are made.
+
+2005-04-01 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-keys): Bind slime-edit-definition-other-window
+ to `C-x 4 .' and slime-edit-definition-other-frame to `C-x 5 .',
+ shadowing the equivalent find-tag... bindings.
+ (slime-goto-definition): In the other-window and other-frame cases,
+ make sure point does not move in the originating window, even when
+ the definition is found in the same buffer.
+
+2005-03-31 Luke Gorrie <luke(a)synap.se>
+
+ * doc/slime.texi (slime-selector): New section.
+ (Inspector): Updated for the post-1.0 inspector.
+
+ * slime.el (slime-selector): Removed unneeded "the" prefixes in
+ descriptions of what the selector methods do.
+
+2005-03-27 Helmut Eller <heller(a)common-lisp.net>
+
+ * PROBLEMS, NEWS, doc/slime.texi: Some updates for the upcoming
+ release.
+
+2005-03-27 Russell McManus <russell_mcmanus(a)yahoo.com>
+
+ * swank-clisp.lisp (getpid): Try sys::process-id if
+ sys::program-id doesn't exist.
+
+2005-03-23 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (commit-edited-value): Read a backquated string,
+ instead of quating the result of read. This allows one to put
+ ,(form) into edit-value buffers.
+
+2005-03-22 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-lispworks.lisp (swank-compile-string): Bind *print-radix*
+ to t, to avoid problems if somebody uses different values for
+ *print-base* and *read-base*. Reported by Alain Picard.
+ (emacs-connected): Add default methods for
+ environment-display-notifier and environment-display-debugger.
+
+2005-03-21 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-sbcl.lisp (locate-compiler-note): Handle errors in macros
+ better.
+ (source-file-source-location): Read the snippet at the right
+ position.
+
+ * swank-source-file-cache.lisp (read-snippet): Take the start
+ position as optional argument.
+
+2005-03-21 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-sbcl.lisp (quit-lisp): If we are running multithreaded,
+ terminate all other threads too. (still broken in 0.8.20.27; used
+ to work in ~0.8.20.2.)
+ (with-debootstrapping, call-with-debootstrapping): Remove ugly
+ backward compatibility code.
+ (sbcl-source-file-p, guess-readtable-for-filename): New utilities.
+ (function-source-location): Handle work off to helper functions.
+ (find-function-source-location): New function. Use the
+ shebang-readtable for SBCL source files.
+ (function-source-position, function-source-filename)
+ (function-source-write-date, function-toplevel-form-number)
+ (function-hint-snippet, function-has-start-location-p)
+ (function-start-location): New helpers.
+ (safe-source-location-for-emacs): Don't catch errors if
+ *debug-definition-finding* is true.
+ (inspect-for-emacs): Minor beautifications.
+
+ * swank.lisp (commit-edited-value): Use buffer syntax.
+ (compile-file-for-emacs, compile-string-for-emacs): Bind
+ *compile-print* to nil.
+
+ * swank-cmucl.lisp (call-with-debugging-environment): Rebind
+ kernel:*current-level* 0. Useful for debugging pretty printer
+ code.
+ (inspect-for-emacs): Show details of interpreted functions.
+
+2005-03-21 Luke Gorrie <luke(a)synap.se>
+
+ * swank-sbcl.lisp (function-source-location): For definitions
+ compiled in Emacs buffers, include the :emacs-string as a :snippet
+ hint for search-based M-. lookup.
+
+2005-03-21 Edi Weitz <edi(a)agharta.de>
+
+ * swank-loader-lisp (*implementation-features*, *os-features*,
+ *architecture-features*): LispWorks was completely missing.
+
+2005-03-18 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-complete-symbol*-fancy): Now nil by default.
+
+2005-03-18 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-source-path-parser.lisp (make-source-recording-readtable):
+ Ignore non-ascii chars.
+
+ * swank-sbcl.lisp (swank-compile-string): Re-implemented. This
+ time with temp-files and proper source-location tracking.
+ (install-debug-source-patch, debug-source-for-info-advice): Patch
+ SBCL's debug-source-for-info so that we can dump our own bits of
+ debug info.
+ (function-source-location, code-location-source-path): Rewritten
+ to handle C-c C-c functions. Also use the source-path to locate
+ the position.
+ (locate-compiler-note): Renamed from resolve-note-location.
+ (temp-file-name, call/temp-file): New utilities.
+ (file-source-location, lisp-source-location)
+ (temp-file-source-location, source-file-source-location)
+ (string-source-position, code-location-debug-source-info)
+ (code-location-debug-source-name, code-location-debug-source-created,)
+ (code-location-debug-fun-fun, code-location-from-emacs-buffer-p)
+ (function-from-emacs-buffer-p, function-debug-source-info)
+ (info-from-emacs-buffer-p, code-location-has-debug-block-info-p)
+ (stream-source-position): Lots of new helper functions.
+ (with-debootstrapping): Moved upwards so that it can be used for
+ source location searching.
+ (source-location-for-emacs): Deleted
+
+2005-03-16 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime/swank.lisp (*macroexpand-printer-bindings*): New user
+ variable.
+ (apply-macro-expander): Use it.
+ (call-with-bindings): Bind variables in reverse order. Thit makes
+ it easer to cons or push a new binding at the front the list.
+ (with-bindings): New macro.
+
+ * slime.el (slime-run-when-idle): New function to hide
+ Emacs/XEmacs differences.
+ (slime-process-available-input): Use it.
+
+ * swank-loader.lisp (unique-directory-name): Rewritten to avoid
+ the rather irritating warning that (warn "Don't know ...") is
+ unreachable.
+
+2005-03-13 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-dispatch-event): Use `slime-busy-p' to control
+ the "; pipelined request" message. This way it takes requests
+ blocked in the debugger into account and avoids spurious messages.
+
+ * swank.lisp (inspect-for-emacs symbol): Add an "unintern it"
+ action for symbols.
+
+ * swank-source-file-cache.lisp (read-snippet): Skip comments and
+ whitespace in SBCL. The source-positions reported by SBCL are not
+ adjusted to skip over whitespace before the definition.
+
+ * swank-sbcl.lisp (function-source-location): Updated for revised
+ sb-introspect patch:
+ s/DEFINITION-SOURCE-CREATED/DEFINITION-SOURCE-WRITE-DATE/
+
+ * swank-loader.lisp (*os-features*): Added :mswindows. Thanks Will
+ Glozer.
+
+2005-03-12 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-edit-value): New function on `C-c E'. Prompts
+ for a Lisp expression, evaluates and displays the result in a new
+ buffer for editing, and then setf's the edited value in Lisp after
+ you press C-c C-c. Usage example: `C-c E asdf:*central-registry*'
+ Minor docstring and pull-down-menu changes.
+
+ * swank.lisp (value-for-editing, commit-edited-value): New
+ functions for slime-edit-value.
+
+ * swank-allegro.lisp (toggle-trace): Fix from Antonio Menezes
+ Leitao.
+
+ * swank-sbcl.lisp: Use swank-source-file-cache to find snippets of
+ definitions. M-. is now much more robust to modifications in the
+ source file.
+ NOTE: To be effective requires a patch to sb-introspect that I
+ have posted to sbcl-devel.
+
+ * swank-source-file-cache.lisp: Factored this into its own file,
+ from swank-cmucl.lisp.
+
+ * swank-loader.lisp, swank-cmucl.lisp: Updated for the above.
+
+2005-03-10 Antonio Menezes Leitao <aml(a)gia.ist.utl.pt>
+
+ * slime.el (slime-toggle-trace-fdefinition): If there is no symbol
+ at point then prompt for one.
+
+2005-03-09 Peter Seibel <peter(a)gigamonkeys.com>
+
+ * swank-loader.lisp (*architecture-features*): Added :pc386 for CLISP.
+ (unique-directory-name): Change ERROR to WARN.
+
+ * slime.el (slime-register-lisp-implementation): Add facility for
+ registering lisp implementations with symbolic names that can be
+ passed to C-u M-x slime.
+
+2005-03-08 Peter Seibel <peter(a)gigamonkeys.com>
+
+ * doc/Makefile (clean): added clean and really_clean targets.
+ (all): and added slime.pdf to all prerequisites.
+
+ * swank-loader.lisp (*implementation-features*): Whoops. Forgot
+ CLISP.
+ (*architecture-features*): Added :x86-64 for SBCL on AMD64 (thanks
+ Vincent Arkesteijn)
+
+2005-03-07 Peter Seibel <peter(a)gigamonkeys.com>
+
+ * swank-loader.lisp (unique-directory-name): Replaced *lisp-name*
+ variable with more sophisticated version that accounts for impl,
+ impl version, os, and hardware architecture.
+
+2005-03-07 Edi Weitz <edi(a)agharta.de>
+
+ * swank.lisp: Fixed parenthesis-balancing problem.
+
+2005-03-06 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-easy-menu): Add menu item for
+ slime-complete-form.
+
+ * swank.lisp (format-arglist-for-echo-area): Use extra-keywords to
+ enrich the list of keywords.
+ (arglist-to-string): Remove extraneous whitespace.
+ (keyword-arg, optional-arg): New structures.
+ (decode-keyword-arg, decode-optional-arg): Return structure
+ objects rather than multiple values.
+ (encode-keyword-arg, encode-optional-arg, encode-arglist): New
+ functions.
+ (arglist): New slot key-p.
+ (decode-arglist): Handle &whole, &environment. Store more
+ information on optional and keyword args, set arglist.key-p.
+ (values-equal?): Removed.
+ (print-decoded-arglist-as-template): If keyword is
+ not a keyword symbol, quote it in the template.
+ (extra-keywords): Return a secondary value (allow-other-keys).
+ For make-instance, try to finalize the class if it is not
+ finalized yet (fix for Allegro CL 6.2). If class is not
+ finalizable, use direct slots instead of slots and indicate that
+ the keywords are not complete.
+ (enrich-decoded-arglist-with-extra-keywords): New function, use
+ the secondary value of extra-keywords.
+ (arglist-for-insertion, complete-form): Use it here.
+ (remove-keywords-alist): New variable.
+ (remove-actual-args): When the keyword :test is provided, don't
+ suggest :test-not and vice versa.
+
+ * swank-backend.lisp (:swank-mop package): Export
+ finalize-inheritance.
+
+2005-03-06 Luke Gorrie <luke(a)synap.se>
+
+ * swank.lisp: Export *LOG-OUTPUT*.
+
+2005-03-05 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-net-sentinel): Always print a message when the
+ lisp disconnects.
+ (slime-inferior-lisp): Don't display the buffer. Let callers do
+ that.
+ (slime): Display the inferior buffer here.
+ (slime-quit-lisp, slime-quit-sentinel): Use set a special sentinel
+ and do most of the cleanups there.
+ (slime-repl-sayoonara): Use slime-quit-lisp.
+ (slime-restart-inferior-lisp, slime-restart-inferior-lisp-aux)
+ (slime-restart-sentinel): Use a special sentinel to restart
+ processes.
+ (slime-hide-inferior-lisp-buffer): Do the windows arrangement a
+ bit differently. Related to restart-lisp.
+ (slime-repl-buffer): Take the connection as second optional
+ argument. Useful for rearranging windows for dead processes.
+
+ * swank-allegro.lisp (call-with-debugging-environment)
+ (find-topframe): Hide the first 2 frames. Those are created
+ by swank-internal functions.
+
+2005-03-04 Antonio Menezes Leitao <aml(a)gia.ist.utl.pt>
+
+ * swank-allegro.lisp (process-fspec-for-allegro, toggle-trace):
+ Handle setf functions.
+ (tracedp): Fix free variable.
+
+ * slime.el (slime-trace-query): The :defgeneric query was bogus.
+ (slime-extract-context): Don't skip over the method name if we are
+ already at the end of the name.
+
+2005-03-03 Nikodemus Siivola <tsiivola(a)cc.hut.fi>
+
+ * swank-sbcl.lisp: Fixed for latest SBCL HEAD revision and
+ temporarily backwards-compatible with the current release.
+
+2005-03-02 Marco Baringer <mb(a)bese.it>
+
+ * swank-loader.lisp Look for a file in the same directory as
+ swank-loader.lisp called site-init.lisp. If it exists we load that
+ instead of attempting to load ~/.swank.lisp.
+ (user-init-file): Superseded by load-user-init-file.
+ (load-user-init-file): New function.
+ (load-site-init-file): New function.
+
+2005-03-01 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-who-bindings): Bind who-specializes to C-c W a.
+ (slime-extract-context): Renamed from name-context-at-point.
+ (slime-beginning-of-list): Renamed from out-first.
+ (slime-slime-parse-toplevel-form): Renamed from definition-name.
+ (slime-arglist-specializers): Renamed from parameter-specializers.
+ (slime-toggle-trace-function, slime-toggle-trace-defgeneric)
+ (slime-toggle-trace-defmethod, slime-toggle-trace-maybe-wherein)
+ (slime-toggle-trace-within): Deleted. Everything is now handled
+ by slime-trace-query.
+ (slime-calls-who): For symmetry with silme-who-calls.
+ (slime-edit-definition-with-etags): Better intergration with TAGS.
+ (slime-edit-definition-fallback-function): Mention it in the
+ docstring.
+
+ * swank-backend (calls-who, toggle-trace): New functions.
+ (toggle-trace-function, toggle-trace-generic-function-methods,
+ (toggle-trace-method, toggle-trace-fdefinition-wherein): Replaced
+ by toggle-trace.
+
+ * swank.lisp (*sldb-printer-bindings*, *swank-pprint-bindings*):
+ New variables. The alists replace the variables which where
+ previously hidden with the define-printer-variables macro.
+ (define-printer-variables, with-printer-settings): Deleted,
+ because the variable names where not visible in the source code.
+ (swank-toggle-trace): Renamed from toggle-trace-fdefinition.
+
+ * swank-cmucl.lisp, swank-lispworks, swank-sbcl.lisp,
+ swank-allegro.lisp (toggle-trace): Update tracing code for new
+ interface.
+
+2005-02-24 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-dispatch-event): Add :eval-no-wait and :eval
+ events.
+ (slime-eval-for-lisp): New function.
+ (sldb-buffers): Delete the variable. Use buffer-list instead.
+
+ * swank.lisp: (eval-for-emacs): Use the new backend function
+ call-with-debugger-hook.
+ (eval-in-emacs): Cleaned up. Add support for synchronous RPCs.
+ (receive-eval-result): New function.
+ (dispatch-event, read-from-socket-io, send-to-socket-io): New
+ :eval event. Rename :%apply to :eval-no-wait.
+ (read-user-input-from-emacs, evaluate-in-emacs): Increment
+ *read-input-catch-tag* instead of re-binding it. Reduces the
+ danger of throwing to the wrong tag a bit.
+
+ * swank-backend.lisp (call-with-debugger-hook): New function.
+ Useful if the backend needs special incantations for BREAK.
+ (toggle-trace-function): Add a default implementation for simple
+ symbols.
+
+ * swank-lispworks.lisp (slime-env): New class.
+ (call-with-debugger-hook): Use env:with-environment to pop up our
+ debugger on a BREAK.
+ (toggle-trace-method, parse-fspec, tracedp, toggle-trace):
+ Implement method tracing.
+
+ * swank-sbcl.lisp (call-with-debugger-hook): Bind
+ sb-ext:*invoke-debugger-hook* instead of setting it in
+ emacs-connected.
+ (emacs-connected): Deleted.
+
+ * swank-loader.lisp (compile-files-if-needed-serially): Reduce
+ verbosity by setting the :print argument for compile-file to nil.
+
+2005-02-23 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-startup-animation, slime-repl-update-banner):
+ Put the animation back in to keep the kids quiet.
+ (slime-kill-without-query-p): Change default to nil.
+ (slime-eval-describe, slime-eval-region)
+ (slime-pprint-eval-last-expression): Fix typos in docstrings.
+ (slime-eval/compile-defun-dwim): Deleted. We never had a key
+ binding anyway.
+
+2005-02-22 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-complete-form): Emacs 20 compatibility fix.
+ (slime-repl-update-banner): Remove animation stuff.
+ (slime-startup-animation): Deleted.
+
+ * swank-lispworks.lisp (compute-applicable-methods-using-classes):
+ Implement it.
+
+2005-02-20 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Supersede the command slime-insert-arglist with the new command
+ slime-complete-form and bind it to C-c C-s. The command completes
+ an incomplete form with a template for the missing arguments.
+ There is special code for discovering extra keywords of generic
+ functions and for handling make-instance. Examples:
+
+ (subseq "abc" <C-c C-s>
+ --inserts--> start [end])
+ (find 17 <C-c C-s>
+ --inserts--> sequence :from-end from-end :test test
+ :test-not test-not :start start :end end :key key)
+ (find 17 '(17 18 19) :test #'= <C-c C-s>
+ --inserts--> :from-end from-end
+ :test-not test-not :start start :end end :key key)
+ (defclass foo () ((bar :initarg :bar)))
+ (defmethod initialize-instance :after ((object foo) &key blub))
+ (make-instance 'foo <C-c C-s>
+ --inserts--> :bar bar :blub blub initargs...)
+
+ * swank.lisp (arglist): New struct for storing decoded arglists.
+ (decode-arglist): New function.
+ (arglist-keywords, methods-keywords, generic-function-keywords,
+ applicable-methods-keywords): New functions.
+ (decoded-arglist-to-template-string,
+ print-decoded-arglist-as-template): New functions.
+ (arglist-to-template-string): Rewrite using above functions.
+ (remove-actual-args): New function.
+ (complete-form): New slimefun.
+
+ * swank.lisp (extra-keywords): New generic function.
+
+ * swank-backend.lisp (:swank-mop package):
+ Export compute-applicable-methods-using-classes.
+
+ * swank.lisp (arglist-for-insertion): Use extra-keywords to
+ enrich the list of keywords.
+
+ * swank.lisp (valid-operator-symbol-p): New function.
+ (valid-operator-name-p): Use valid-operator-symbol-p.
+
+ * slime.el (slime-complete-form): New command.
+ (slime-keys): Bind C-c C-s to slime-complete-form rather than
+ slime-insert-arglist.
+
+2005-02-18 Antonio Menezes Leitao <aml(a)gia.ist.utl.pt>
+
+ Improve the trace mechanism (on lisps that support it). SLIME is
+ now able to trace/untrace flet/labels functions, methods and, of
+ course, regular and generic functions.
+
+ In the process support for sending code to emacs form the lisp was
+ added. The code, elisp forms, is sent over the wire like normal
+ lisp code, evaluated in emacs and the return value is returned
+ back to the lisp.
+
+ * slime.el (slime-dispatch-event): Added the :evaluale-in-emacs
+ dispatch state which simply parses the message and class
+ evaluate-in-emacs.
+ (evaluate-in-emacs): New function.
+ (complete-name-context-at-point, name-context-at-point, out-first,
+ definition-name, parameter-specializers,
+ slime-toggle-trace-fdefinition, slime-toggle-trace-function,
+ slime-toggle-trace-defgeneric, slime-toggle-trace-defmethod,
+ slime-toggle-trace-maybe-wherein, slime-toggle-trace-within): New
+ functions implementing the new intelligent slime trace.
+
+ * swank-backend.lisp (toggle-trace-function,
+ toggle-trace-generic-function-methods, toggle-trace-method,
+ toggle-trace-fdefinition-wherein,
+ toggle-trace-fdefinition-within): New backend functions
+ for the new trace facility.
+
+ * swank.lisp (dispatch-event): Handle the :evaluate-in-emacs
+ message type.
+ (evaluate-in-emacs): New function.
+
+ * swank-allegro.lisp (toggle-trace-generic-function-methods,
+ toggle-trace, toggle-trace-function, toggle-trace-method,
+ toggle-trace-fdefinition-wherein,
+ toggle-trace-fdefinition-within): Implement.
+ (process-fspec-for-allegro): New function.
+
+ * swank-cmucl.lisp (toggle-trace-generic-function-methods,
+ toggle-trace-function, toggle-trace-method,
+ toggle-trace-fdefinition-wherein): Implement.
+ (toggle-trace, process-fspec): New functions.
+
+ * swank-sbcl.lisp (toggle-trace-generic-function-methods,
+ toggle-trace-function, toggle-trace-method,
+ toggle-trace-fdefinition-wherein): Implement.
+ (toggle-trace, process-fspec): New functions.
+
+2005-02-02 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el: Require the timer package explicitly.
+
+2005-02-02 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-repl-send-input): Move some properties
+ of old REPL input (e.g. read-only) from text properties into an
+ overlay, so that kill/yank will leave them behind. Left
+ `slime-repl-old-input' as a text properties because it's more
+ convenient to lookup that way.
+ (slime-repl-return): Ignore `slime-repl-old-input' property if the
+ point is in front of the current REPL prompt, i.e. if the user has
+ copy&pasted some old REPL input into the current input area.
+
+2005-01-30 Bryan O'Connor <bryan-slime(a)lunch.org>
+
+ * slime.el (slime-goto-location-position): Changed the regexp to
+ require the function-name to be followed by a
+ non-symbol-constituent character \S_. Previously, a function-name
+ of "find" first matched find-if-not if it occured earlier in the
+ file.
+
+2005-01-27 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-busy-p): Ignore debugged continuations to enable
+ arglist lookup while debugging. Suggested by Lynn Quam.
+ (sldb-continuations): New buffer local variable in sldb buffers to
+ keep track of debugged continuations.
+ (sldb-debugged-continuations): New function.
+ (sldb-buffers): Renamed from sldb-remove-killed-buffers.
+ (slime-eval-print): New function to insert the stream output and
+ the result of an evaluation in the current buffer.
+ (slime-eval-print-last-expression): Use it.
+ (slime-interactive-eval): Use slime-eval-print when a prefix
+ argument was given.
+
+ * swank.lisp (*pending-continuations*, eval-in-emacs)
+ (debugger-info-for-emacs): Keep track of debugged continuation the
+ new variable *pending-continuations* and include the list of
+ active continuations in the debugger info for Emacs.
+ (eval-and-grab-output): New function. Used by slime-eval-print.
+ (*log-output*): Renamed from *log-io*. Use *standard-error* as
+ initial value instead of *terminal-io*. CMUCL opens its own tty
+ and that makes it hard to redirect to output with a shell.
+ *standard-error* writes its output to file descriptor 2.
+ (*canonical-package-nicknames*): Fix typo.
+
+2005-01-20 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (parse-symbol): Don't break if the package doesn't
+ exist. Reported by Lynn Quam.
+
+2005-01-20 Ian Eslick <eslick(a)csail.mit.edu>
+
+ * swank-allegro.lisp (restart-frame): Handle frames with arguments
+ better.
+
+2005-01-20 Edi Weitz <edi(a)agharta.de>
+
+ * swank-allegro.lisp (handle-undefined-functions-warning): Prevent
+ breakage if the undefined function is called at multiple
+ locations.
+
+2005-01-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-gray.lisp (stream-unread-char): If the char argument
+ doesn't match the contents in the buffer, ignore it and emit a
+ warning instead.
+
+2005-01-19 Utz-Uwe Haus <haus+slime(a)merkur.math.uni-magdeburg.de>
+
+ * swank-cmucl.lisp (breakpoint): Add a slot for return values to
+ make return values inspectable in the debugger.
+ (signal-breakpoint): Initialize the new slot.
+
+2005-01-19 Matthias Koeppe <mkoeppe(a)merkur.math.uni-magdeburg.de>
+
+ * slime.el (slime-insert-arglist): Inserts a template for a
+ function call instead of the plain arglist; this makes a
+ difference for functions with optional and keyword arguments.
+
+ * swank.lisp (arglist-to-template-string): New function.
+ (arglist-for-insertion): Use it
+ (decode-keyword-arg, decode-optional-arg): New functions.
+
+2005-01-19 Lars Magne Ingebrigtsen <larsi(a)gnus.org>
+
+ * slime.el (slime-header-line-p): Customize variable to
+ enable/disable the header-line in the REPL.
+
+2005-01-18 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-complete-symbol*-fancy): New variable to enable
+ extra bells and whistles with slime-complete-symbol*. Currently
+ controls whether to use arglists semantically. Default is t.
+ (slime-complete-symbol*-fancy-bit): Factored out this function.
+ Only do "semantic" completion when the symbol is in
+ function-position, avoid interning argument names in Emacs, and
+ don't display arglists if the minibuffer is active.
+
+2005-01-14 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-repl-send-input): Make old input read-only using
+ an overlay instead of a text property. This way if you copy&paste
+ the input elsewhere it will become editable (overlay is associated
+ with the buffer region and not the text).
+
+2005-01-14 Edi Weitz <edi(a)agharta.de>
+
+ * slime.el (slime-complete-symbol*): Maybe insert closing
+ parenthesis or space (depending on arglist) after symbol
+ completion has finished. Optionally also show arglist.
+
+2005-01-13 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-cmucl.lisp (create-socket): The byte-order of the :host
+ argument for CREATE-INET-LISTENER was changed in the Jan 2005
+ snapshot. Test whether the symbol 'ext:socket-error exists to
+ decide if we are in a older version.
+ (resolve-hostname): Return the address in host byte-order.
+
+2005-01-12 Robert Lehr <bozzio(a)the-lehrs.com>
+
+ * slime.el (slime-changelog-date): Return nil if the ChangLog file
+ doesn't exits.
+ (slime-repl-update-banner): Write "ChangeLog file not found" if
+ the ChangeLog doesn't exist.
+
+2005-01-12 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime.el (slime-inspector-operate-on-click): New command for
+ inspecting the value value at the clicked-at position or invoking
+ an inspector action.
+ (slime-inspector-mode-map): Bind it to mouse-2.
+ (slime-inspector-insert-ispec): Add mouse-face properties for
+ clickable values and action buttons.
+
+2005-01-12 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (*default-worker-thread-bindings*): New variable to
+ initialize dynamic variables in worker threads.
+ (spawn-worker-thread, call-with-bindings): New helper functions.
+ (thread-for-evaluation): Use them.
+
+2005-01-10 Utz-Uwe Haus <haus+slime(a)merkur.math.uni-magdeburg.de>
+
+ * swank-sbcl.lisp (profile-package): Add implementation for SBCL.
+
+2005-01-10 Eduardo Mu�oz <emufer(a)terra.es>
+
+ * swank.lisp (inspect-for-emacs-list): LispWorks has a low args
+ limit for apply: use reduce instead of apply.
+
+2005-01-10 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-conservative-indentation): The default is now
+ nil. Suggested by Travis Cross.
+
+2005-01-10 Matthias Koeppe <mkoeppe(a)merkur.math.uni-magdeburg.de>
+
+ * slime.el (slime-inspector-next-inspectable-object): Accept a
+ prefix argument and make wrapping around more reliable. The code
+ is adapted from `widget-move'.
+ (slime-inspector-previous-inspectable-object): New command.
+ (slime-inspector-mode-map): Bind to S-TAB.
+
+2004-12-16 Martin Simmons <martin(a)xanalys.com>
+
+ * swank-lispworks.lisp (create-socket): Work around bug in
+ comm::create-tcp-socket-for-service on Mac OS LW 4.3.
+
+2004-12-16 Edi Weitz <edi(a)agharta.de>
+
+ * slime.el (slime-complete-symbol*): Bind
+ comint-completion-addsuffix so unambiguous or exact completion
+ closes the string automatically.
+
+2004-12-16 Matthias Koeppe <mkoeppe(a)merkur.math.uni-magdeburg.de>
+
+ * slime.el (slime-keys): Bind M-* to
+ slime-pop-find-definition-stack for compatibility with standard
+ Emacs conventions.
+
+2004-12-16 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-source-path-parser.lisp (read-source-form): New function
+ which uses *read-suppress* properly. Common code from
+ source-path-stream-position and form-number-stream-position.
+ (source-path-stream-position): Use it.
+
+ * swank-cmucl.lisp (form-number-stream-position): Use
+ read-source-form.
+
+ * swank.lisp (frame-for-emacs): Print the frame number a little
+ nicer with ~2D.
+
+2004-12-15 Matthias Koeppe <mkoeppe(a)merkur.math.uni-magdeburg.de>
+
+ * slime.el (slime-lisp-modes): New variable to make C-c C-k
+ customizable and usable in scheme-mode.
+ (slime-compile-file): Use it.
+
+2004-12-15 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-cmucl.lisp, swank-backend.lisp (frame-package): Delete it.
+ Include the package name for local variables because it is utterly
+ confusing if `eval-in-frame' doesn't work due to missing package
+ prefixes.
+
+ * swank-source-path-parser.lisp (source-path-stream-position):
+ Bind *read-suppress* to nil before calling
+ read-and-record-source-map.
+
+ * swank-clisp.lisp (*buffer-name*, *buffer-offset*): Move
+ definitions upward before the first use.
+
+2004-12-15 Bryan O'Connor <bryan-slime(a)lunch.org>
+
+ * slime.el (slime-edit-definition): Switch to the other frame if
+ the `where' is 'frame.
+ (slime-edit-definition-other-frame): New function.
+
+2004-12-15 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-repl-send-input): Make the input read-only to
+ avoid confusion.
+ (slime-make-region-read-only): New function.
+
+2004-12-13 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-repl-mode-map): Bind <home> to slime-repl-bol.
+ Suggested by Chris Capel.
+ (slime-repl-grab-old-input): Remove the 'old-input text-property
+ from the copied text. Reported by Tim Oates.
+ (slime-repl-grab-old-input): Append the old input to the current
+ input by default. If the new `replace' argument is true, replace
+ the current input. Suggested by Antonio Menezes Leitao.
+ (slime-repl-return): Pass the prefix argument to
+ slime-repl-grab-old-input.
+
+2004-12-09 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (*sldb-print-pretty*, *sldb-print-circle*)
+ (*sldb-print-length*, *sldb-print-level*, *sldb-print-lines*)
+ (*sldb-print-pprint-dispatch*): Export those symbols.
+
+2004-12-05 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-global-variable-name-p): Also return true for
+ names of constants like +foo+. Suggested by Christian Lynbech.
+
+ * swank-allegro.lisp (handle-compiler-warning): Handle
+ undefined-functions warnings by looking the fromat-arguments of
+ the condition.
+ (compiler-undefined-functions-called-warning-p)
+ (location-for-warning, handle-undefined-functions-warning): New
+ functions.
+
+ * swank-cmucl.lisp (*install-gc-hooks*): New user variable.
+ (sending-safe-p): New predicate.
+ (pre-gc-hook, post-gc-hook): Use it.
+
+ * swank.lisp (eval-region): Use a simple loop.
+
+2004-12-02 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp: (inspect-for-emacs (symbol)): Handle non-interned
+ symbols.
+
+ * slime.el (slime-repl-clear-buffer, slime-repl-clear-output): Fix
+ docstrings.
+
+2004-11-29 Lynn Quam <quam(a)ai.sri.com>
+
+ * slime.el (slime-global-variable-name-p): Allow optional
+ "<package-name>:" or "<package-name>::".
+
+2004-11-29 Chris Capel <pdf23ds(a)gmail.com>
+
+ * swank.lisp (macro-indentation): Ignore &whole, &aux, and
+ &environment args.
+
+2004-11-29 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-repl-wrap-history): New user variable.
+ (slime-repl-history-replace): Implement wrap around.
+ (slime-repl-easy-menu): Fix binding for "Next Input". Reported by
+ Surendra Singhi.
+
+ * swank-lispworks.lisp (list-callers-internal): Return the
+ function if dspec:object-dspec returns nil.
+ (xref-results): Previously, functions for which
+ dspec:dspec-definition-locations returned nil were ignored.
+ Include them with a unknown source-location.
+
+ * swank-abcl.lisp, swank-allegro.lisp, swank-clisp.lisp,
+ swank-cmucl.lisp, swank-openmcl.lisp, swank-sbcl.lisp,
+ swank-lispworks (accept-connection): The :external-format argument
+ defaults now to :iso-latin-1-unix.
+
+2004-11-26 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-cmucl.lisp (read-into-simple-string): Use #-cmu19 instead
+ of #+cmu18e.
+
+2004-11-25 Chris Capel <pdf23ds(a)gmail.com>
+
+ * slime.el (slime-indent-and-complete-symbol): Echo the arglist if
+ there's no symbol before point. Don't complete after parens.
+ (slime-echo-arglist): Factorized from slime-space.
+ (slime-space): Use it.
+ (slime-repl-history-replace): Clear the input at the end of the
+ history.
+
+ * swank.lisp (arglist-to-string): Don't show &whole, &aux and
+ &environment args.
+ (clean-arglist): New function.
+
+2004-11-25 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-net-coding-system): Emacs does funky encoding
+ for `raw-text-unix' use `binary' instead.
+ (slime-safe-encoding-p): New function.
+ (slime-net-send): Use it and don't try to send stuff which can't
+ be decoded by Lisp.
+ (slime-inferior-lisp-program-history): XEmacs compatibility:
+ declare it as a variable.
+ (slime-xref-mode): In Emacs 21, set delayed-mode-hooks to nil
+ because we don't want to run the lisp-mode-hook. Reported by
+ Chris Capel.
+
+ * swank.lisp (dispatch-loop): Catch errors and close the
+ connection. It's almost impossible to run the debugger inside the
+ control-thread, so let it crash instead. A backtrace would be
+ nice, though.
+ (cleanup-connection-threads): Can now be called in the
+ control-thread. Add a check to avoid thread suicide.
+ (start-swank-server-in-thread): Fix the call to start-server.
+
+ * swank-sbcl.lisp (%thread-state-slot, %thread-state): Refactored
+ from thread-status.
+ (thread-status): Use it.
+ (all-threads): Exclude zombies.
+
+2004-11-24 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-start-and-load): Use vanilla comint instead of
+ inf-lisp. Let's try that for a while.
+ (slime): Ask for the coding system when invoked with C-u C-u.
+ (slime-net-coding-system, slime-net-valid-coding-systems): Add
+ some alternatives for older Emacsen.
+ (slime-find-buffer-package): Skip quotes. Old code looks
+ sometimes like (in-package 'foo).
+ (slime-repl-mode-map): Inhibit C-c C-z. Avoids accidental loading
+ inf-lisp.
+ (slime-net-coding-system): Use find-coding-system in XEmacs.
+ coding-system-p means something different here.
+ (slime-repl-mode-map): XEmacs compatibility: use (kbd "C-<up>")
+ instead of [C-up].
+
+ * swank.lisp (inspect-for-emacs-list): subseq on improper lists
+ breaks in Lispworks. Handle that case better.
+
+ * swank-sbcl.lisp (inspect-for-emacs)[code-component]: Disassemble
+ code-components too.
+
+ * swank-backend.lisp (import-swank-mop-symbols): Better error
+ message for the assertion.
+
+ * swank-cmucl.lisp (debug-var-value): Return #:invalid or
+ #:unknown instead of :<not-available>.
+ (swank-compile-file): Load the fasl file only if load-p is true.
+ (inspect-for-emacs, inspect-alien-record, inspect-alien-pointer):
+ Add inspector support for some alien types.
+
+ * swank-lispworks.lisp (emacs-connected): Set the sigint handler
+ only for single threaded operation. I.e. when
+ *communication-style* is nil.
+
+ * swank-allegro.lisp (set-external-format): New function. Use LF
+ as eol mark.
+ (call-with-compilation-hooks): Trap compiler-notes too.
+
+2004-11-24 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-repl-mode-map): Add C-up and C-down to move
+ through history. Consistent with comint-mode.
+ (slime-repl-mode-map): Add slime-load-file on `C-c C-l' and
+ slime-compile-file on `C-c C-k'. This is mostly to override
+ unwanted inf-lisp bindings in lisp-mode-map.
+ (slime-load-file): Handle (buffer-file-name) being nil.
+
+2004-11-20 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-sbcl.lisp (make-socket-io-stream): Add some #+sb-unicode.
+
+2004-11-20 Travis Cross <travis(a)crosswirecorp.com>
+
+ * swank-sbcl.lisp (thread-status): Fix unbalanced parenthesis.
+
+2004-11-20 Marco Baringer <mb(a)bese.it>
+
+ * swank-openmcl.lisp (make-stream-interactive): Only add ouptut
+ streams (subclasses of ccl:fundamental-output-stream) to
+ ccl::*auto-flush-streams*.
+
+2004-11-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-net-coding-system): New variable. Specifies the
+ coding system to use for network communication. The default is
+ iso-latin-1 and should work for all Lisps. Only a small set of
+ coding systems is currently supported.
+ (slime-net-valid-coding-systems): New variable. A list of coding
+ systems which may be used.
+ (slime-check-coding-system, slime-coding-system-mulibyte-p)
+ (slime-coding-system-cl-name): New utility function for coding
+ systems.
+ (slime-net-connect, slime-make-net-buffer,
+ slime-open-stream-to-lisp): Use it.
+ (slime-net-decode-length, slime-net-encode-length): Renamed from
+ slime-net-read3 and slime-net-enc3. The length is now encoded as
+ a 6 char hex string.
+
+ * swank.lisp (*coding-system*): New variable.
+ (start-server): Accept external-format as argument.
+ (create-server, create-swank-server, setup-server)
+ (serve-connection, open-dedicated-output-stream)
+ (create-connection): Ditto.
+ (defstruct connection): Add external-format slot.
+ (decode-message-length): New function for new length encoding.
+ (decode-message): Use it.
+ (encode-message): Use new encoding.
+
+ * swank-cmucl.lisp (accept-connection): Accept external-format
+ argument.
+ (inspect-for-emacs): Add CMUCL specific versions for array and
+ vectors.
+
+ * swank-sbcl.lisp, swank-openmcl.lisp, swank-lispworks.lisp,
+ swank-clisp.lisp, swank-backend.lisp, swank-allegro.lisp,
+ swank-abcl.lisp (accept-connection): Accept :external-format as
+ argument.
+
+2004-11-19 Matthew Danish <mrd+nospam(a)cmu.edu>
+
+ * swank-allegro.lisp: (count-cr): New function. Convert
+ file-offsets to match Emacs' eol-conventions.
+ (find-definition-in-file): Use it.
+
+ * slime.el (slime-insert-xrefs): Display the multi-line label much
+ more cleanly.
+
+2004-11-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-sbcl.lisp (thread-status): Decode the thread-state-slot
+ instead of returning ???.
+
+ * swank-allegro.lisp (swank-mop:slot-definition-documentation):
+ ACL 7 says documentation should have 2 args. So, pass t as second
+ argument.
+ (fspec-primary-name): Recurse until we have a symbol.
+ (allegro-inspect): New function. Mostly reverse engineered from
+ ACL's native inspector.
+ (inspect-for-emacs (t), inspect-for-emacs (function)): Use it.
+
+ * swank.lisp (inspect-for-emacs array): Use row-major-aref instead
+ of a displaced array. I hope that does the same.
+ (inspect-for-emacs integer): Ignore errors in
+ decode-universal-time. Negative values and, in SBCL, also small
+ values cannot be decoded.
+ (list-threads): Include the thread-id. Useful for SLIME debugging.
+
+ * slime.el (slime-list-threads, slime-thread-insert): Show the
+ thread-id.
+ (slime-thread-control-mode-map): Remove the binding for the
+ no-longer-existent slime-thread-goahead command.
+
+2004-11-18 Alexey Dejneka <adejneka(a)comail.ru>
+
+ * swank.lisp (inspect-for-emacs): Fix bug in handling of arrays
+ with fill-pointers.
+
+2004-11-15 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el: The REPL commands ,quit and ,sayoonara are now
+ distinct. Previously Quit killed all Lisps an all buffers. The
+ new Quit command kills only the current Lisp.
+ (slime-quit-lisp): New function.
+ (repl-command quit): Use it. Don't delete all buffers.
+ (repl-command sayoonara): No longer an alias for ,quit.
+ (slime-connection-list-mode-map): Bind C-k to slime-quit-lisp.
+ (slime-communication-style): New connection variable.
+ (slime-use-sigint-for-interrupt): Is no longer a connection local
+ variable. It's derived from the new slime-communication-style.
+ (slime-inhibit-pipelining): New user option.
+ (slime-background-activities-enabled-p): New predicate to control
+ various background activities like autodoc and arglist fetching.
+ (slime-space, slime-autodoc-message-ok-p): Use it.
+ (slime-search-call-site): Use hints provided to search a call-site
+ in a defun. Useful for the show-frame-source command.
+ (slime-goto-source-location): Use it.
+ (slime-quit): Deleted, as it was broken. May come back later.
+ (slime-inspector-label-face, slime-inspector-value-face)
+ (slime-inspector-action-face, slime-reader-conditional-face):
+ Provide better defaults for Emacsen which don't support :inherited
+ faces.
+
+ * swank-backend.lisp (emacs-connected): Don't pass the stream as
+ argument. make-stream-interactive is a better place for setting
+ buffering options.
+
+ * swank-cmucl.lisp (emacs-connected): Install GC hooks to display
+ GC messages in the echo area.
+ (sos/misc :flush-output): There seem to be funny signal safety
+ issues if the dedicated output stream is not used. So, lets first
+ reset the buffer index before sending the buffer to the underlying
+ stream.
+
+ * swank-lispworks.lisp (frame-source-location-for-emacs): Pass the
+ function name of the next (newer) frame as a hint to Emacs. This
+ way we can highlight the call site in some cases, instead of the
+ entire defun.
+ (frame-location): Renamed from function-name-location. The
+ argument is now a dspec, not only a name. Also include hints for
+ Emacs.
+ (lispworks-inspect): Simplified from old code.
+ (inspect-for-emacs): Use it for also for simple functions.
+ (emacs-connected, make-stream-interactive): Move the
+ soft-force-output stuff to make-stream-interactive.
+
+ * swank-abcl.lisp (emacs-connected): Deleted. The default
+ implementation should be good enough.
+
+ * swank-sbcl.lisp (emacs-connected): Updated for new interface.
+
+ * swank-openmcl.lisp (emacs-connected, make-stream-interactive):
+ Move buffering stuff to make-stream-interactive.
+
+ * swank.lisp (defstruct connection): Add new slot:
+ communication-style for convenience.
+ (create-connection): Initialize the new slot.
+ (connection-info): Send the communication-style to Emacs.
+ (install-fd-handler, simple-serve-requests): Sending
+ :use-sigint-for-interrupt is no longer necessary.
+
+2004-11-11 Raymond Toy <raymond.toy(a)ericsson.com>
+
+ * slime.el (slime-activate-font-lock-magic): Add XEmacs support.
+ (slime-reader-conditional-face): New face.
+
+2004-11-10 Marco Baringer <mb(a)bese.it>
+
+ * swank-backend.lisp (definterface): Eliminate unused variable
+ received-args.
+ (emacs-connected, make-stream-interactive, condition-references,
+ condition-extras, buffer-first-change): Add (declare (ignore X))
+ for unused arguments in default implementations.
+ (inspect-for-emacs): Remove (declare (ignore)) for inexistent
+ variable inspection-mode. Added T qualifiers in method arguments.
+
+ * swank-openmcl.lisp (inspect-for-emacs): Use definterface so
+ SLIME knows we implement this.
+ (arglist function): Use ccl:arglist, not ccl::arglist-from-map.
+ (inspect-for-emacs): Added support for inspecting the uvector
+ objects under lisp datums.
+
+2004-11-09 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (features-for-emacs): New function to avoid
+ keyword/string confusion. Case doesn't matter since Emacs will
+ downcase them anyway.
+ (connection-info, sync-features-to-emacs): Use it. Should fix
+ highlighting bug reported by Edi Weitz.
+
+ * slime.el (slime-eval-feature-conditional): Convert AND, OR, and
+ NOT to lowercase keywords.
+ (slime-net-read3): Silly optimization: give char-after the offset
+ as argument to avoid save-excursion and forward-char.
+
+2004-11-07 Brian Downing <bdowning(a)lavos.net>
+
+ * slime.el (slime-fuzzy-explanation): Added line to describe
+ flags (:boundp, :fboundp, :macro, etc), which are now reported in
+ the fuzzy-completion output.
+ (slime-fuzzy-insert-completion-choice): Added flags.
+ (slime-fuzzy-choices-buffer): Added flags header.
+
+ * swank.lisp (fuzzy-completions): Changed docstring to describe
+ new flags in the completion results.
+ (convert-fuzzy-completion-result): New function to marshall the
+ results from the completion core into something Emacs is
+ expecting. Added flags.
+ (fuzzy-completion-set): Use the above.
+ (compute-completion): Removed.
+ (score-completion): Cleaned up a little bit.
+ (highlight-completion): Use destructive nstring-upcase.
+
+2004-11-01 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-easy-menu): Add item for
+ slime-update-indentation. Suggested by Lynn Quam.
+ (slime-severity-faceslime-show-note-counts)
+ (slime-most-severe, slime-choose-overlay-region): Handle
+ read-errors.
+ (slime-show-buffer-position): New function.
+ (slime-show-source-location): Use it.
+
+ * swank-backend.lisp (deftype severity): Add read-errors.
+
+ * swank-cmucl.lisp (severity-for-emacs): Special case read-errors.
+ (read-error-location): Add the offset to the buffer start.
+
+ * swank.lisp (assign-index): Avoid linear search.
+
+2004-10-30 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-source-path-parser.lisp (source-path-stream-position):
+ Bind *read-suppress* only as long as we skip over forms. The last
+ toplevel form in the path is read with *read-suppress* = nil
+ because in newer versions of CMUCL and SBCL read will return nil
+ if *read-suppress* is t.
+
+2004-10-28 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-clisp.lisp: Ups. Undo previous change.
+
+ * swank-clisp.lisp: Add workaround for CLISP's broken control
+ string parser.
+
+ * swank-cmucl.lisp (set-step-breakpoints): Handle breakpoints at
+ single-return points in escaped frames better. Previously we
+ tried to set a breakpoint at the current position and consequently
+ was only hit during the next call.
+ (inspect-for-emacs)[function]: Call the next method only for
+ funcallable instances.
+ (profile-report, profile-reset, unprofile-all): We have to use
+ eval because the macro expansion depends on the value of
+ *timed-functions*. Reported by Chisheng Huang.
+
+ * slime.el (slime-space): Call slime-message in the right buffer,
+ so that after-command hooks are added in the right buffer.
+ Reported by Juho Snellman.
+ (slime-dispatch-event): Accept stepping flag.
+ (sldb-setup): Don't query when entering a recursive edit.
+ (sldb-exit): Don't kill the buffer if we are in stepping mode.
+ (slime-inspector-insert-ispec): New function.
+ (slime-open-inspector): Use it.
+ (slime-inspector-operate-on-point): Simplified.
+ (test interactive-eval): Fix test case.
+ (slime-kill-all-buffers): More regexp kludges. From Bill Clementson.
+
+ * swank-backend.lisp (activate-stepping): New function.
+
+ * swank.lisp (*sldb-stepping-p*): New variable. Used to tell
+ emacs that the debugger buffer should not be closed even if we
+ unwind.
+ (debug-in-emacs): Use it.
+ (sldb-step): Moved to the front end.
+ (inspector-princ, method-specializers-for-inspect): Simplified.
+ (methods-by-applicability): Use a simpler algorithm. I doubt there
+ is much difference in practice.
+ (inspect-for-emacs)[symbol, function, standard-generic-function]
+ [standard-method]: Use less than 80 columns.
+ (inspector-call-nth-action): Don't accept &rest args. Was never
+ used.
+ (inspect-for-emacs) [integer]: Fix control string. Thanks to CSR
+ for pointing it out.
+
+2004-10-27 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-sbcl.lisp (signal-compiler-condition): Actually delete one
+ of the reader-conditionalized forms.
+
+2004-10-26 Helmut Eller <heller(a)common-lisp.net>
+
+ * cl-indent.el: Add indentation specs for some missing CL symbols.
+ (lisp-prefix-match-indentation): Change default to
+ nil to avoid confusion for people who don't care about the issue.
+
+ * swank-sbcl.lisp (signal-compiler-condition): Remove reader
+ conditionals as the current code doesn't work in any SBCL before
+ 0.8.13 anyway.
+
+ * swank-source-path-parser.lisp: Remove workarounds for SBCL bugs.
+ The bugs are fixed in the versions we support.
+
+ * swank-cmucl.lisp (read-error-location)
+ (signal-compiler-condition): Handle read-errors.
+ (swank-compile-file): Don't load the fasl file if there was an
+ error.
+
+ * swank.lisp (define-printer-variables): Handle doc strings
+ properly.
+ (*sldb-pprint-dispatch*): Initialize it with the default dispatch
+ table.
+
+ * slime.el (slime-init-command): New function to send the command
+ to load swank. Having a separate function for the task should
+ make it easier to start a Lips with a preloaded swank.
+ (slime-maybe-start-lisp): Use it.
+ (slime-maybe-start-multiprocessing): Deleted.
+ (slime-repl-buffer): Include the name of the implementation.
+ (slime-set-default-directory)
+ (slime-sync-package-and-default-directory): Translate filenames.
+
+2004-10-25 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (inspect-for-emacs array): Properly deal with arrays
+ without fill pointers.
+ (inspect-for-emacs function): Show function-lambda-expression
+ when available.
+
+ * swank-openmcl.lisp (specializer-name): New function.
+ (who-specializes): Use it.
+ (maybe-method-location): Use it.
+ (function-source-location): Use it.
+
+ * swank-cmucl.lisp (inspect-for-emacs function): Use next
+ method's values and simply add cmucl specific details.
+
+ * slime.el (slime-repl-defparameter): Change default value to "*".
+
+2004-10-25 Thomas Schilling <tjs_ng(a)yahoo.de>
+
+ * swank-allegro.lisp (inspect-for-emacs): Use
+ excl::external-fn_symdef to get the function documentation.
+
+ * swank.lisp (inspect-for-emacs): Order generic function's methods
+ and show abbreviated docs for methods.
+ (abbrev-doc): New function.
+ (methods-by-applicability): New function.
+ (*gf-method-getter*): New variable.
+
+2004-10-19 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-show-source-location): Call `push-mark' to push
+ the source position onto the global mark ring.
+
+2004-10-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank.lisp (define-printer-variables): NIL is not a valid
+ docstring. Reported by Alain Picard.
+ (printer-variables sldb-print): Include print-gensym,
+ pprint-dispatch, base, radix, array, and lines.
+
+2004-10-17 Luke Gorrie <luke(a)synap.se>
+
+ * slime.el (slime-message): Use slime-typeout-frame if available.
+
+2004-10-17 Helmut Eller <heller(a)common-lisp.net>
+
+ * cl-indent.el: Our local copy. Should eventually be merged the
+ file with in the main distribution.
+
+ * slime.el: (slime-find-buffer-package-function): New variable to
+ allow customization for unusal syntax.
+ (slime-maybe-rearrange-inferior-lisp): Removed unused function.
+ (slime-set-inferior-process): Non-macro version to make
+ byte-compiler happy. Reported by Raymond Wiker.
+ (slime-maybe-start-lisp): Use it.
+ (slime-sync-package-and-default-directory): Synch the
+ default-directory in the REPL buffer too.
+ (slime-goto-connection): Close the connection list window.
+ Suggested by Andras Simon.
+ (slime-repl-clear-buffer): Place point after the prompt.
+ (selector-method ?i): Use slime-process to switch to the right
+ buffer.
+ (slime-background-message): Do nothing if the minibuffer is
+ active.
+ (slime-indent-and-complete-symbol): Don't indent if we at the same
+ line as the prompt.
+
+ * swank.lisp (*sldb-pprint-frames*): Renamed to
+ *sldb-print-pretty*.
+ (*sldb-print-level*, *sldb-print-length*, *sldb-print-circle*)
+ (*sldb-print-readbly): Group of new variables to customize
+ printing in the debugger. The default values should be safe.
+ (define-printer-variables, with-printer-settings): New macros to
+ make defining and binding groups of printer variables easier.
+ (inspect-for-emacs-list): Fix bug with circular lists and only
+ shows the first 40 elements.
+ (inspect-for-emacs): Various cleanups.
+ (all-qualified-readnames): Removed. It was not needed because
+ common-lisp-indent-function strips of any package prefix and
+ downcases the symbol anyway.
+ (printer-variables sldb-print): Ooops. Better use sldb-print as prefix
+ than sldb alone. *sldb-level* was already defined.
+
+ * swank-cmucl.lisp (inspect-for-emacs (code-component)):
+ Disassemble the memory region if there's not enough debug info.
+
+2004-10-17 Jan Rychter <jan(a)rychter.com>
+
+ * swank-cmucl.lisp (return-from-frame): Add it.
+
+2004-10-11 Thomas F. Burdick <tfb(a)OCF.Berkeley.EDU>
+
+ * swank-sbcl.lisp (function-definitions): Find compiler macros, too.
+ (find-defintions, compiler-definitions)
+ (optimizer-definitions, transform-definitions): Add compiler
+ transformers and optimizers to the list of definitions.
+
+2004-10-07 Peter Seibel <peter(a)javamonkey.com>
+
+ * swank.lisp (spawn-threads-for-connection): Bind *debugger-hook*
+ instead of SETF'ing it.
+
+2004-10-06 Luke Gorrie <luke(a)synap.se>
+
+ * swank.lisp (update-indentation/delta-for-emacs): Configure Emacs
+ indentation settings not just for the symbol name but for all
+ package-qualified forms of it as well.
+
+ * doc/slime.texi (Credits): Updated the credits list to include
+ more Lisp implementors who're also SLIME hackers.
+
+2004-10-05 Luke Gorrie <luke(a)synap.se>
+
+ * swank.lisp (arglist-for-echo-area): Handle errors and return a
+ message.
+ (parse-symbol): Recognise an empty package name as the KEYWORD
+ package.
+
+2004-10-03 Reini Urban <rurban(a)x-ray.at>
+
+ * swank-clisp.lisp (getpid)[win32]: Use
+ win32:|GetCurrentProcessId|.
+
+2004-10-03 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el: Reduce dependency on inf-lisp internals. Make it
+ possible to start the inferior lisp in a buffer different from
+ "*inferior-lisp*".
+ (slime): Parse the command argument explicitly and don't rely on
+ `inferior-lisp'. Don't close all connections, but only the one
+ for the inferior lisp buffer we are using.
+ (slime-maybe-start-lisp): Take the command and buffer as argument.
+ Decide here whether we should start start a new processwe or just
+ disconnect and reconnect .
+ (slime-start-lisp): Load verbosely.
+ (slime-inferior-lisp): New function. Replaces call to
+ `inferior-lisp'.
+ (slime-inferior-connect, slime-start-swank-server): Take the
+ inferior process as argument
+ (slime-read-port-and-connect): Set the slime-inferior-process
+ variable in the new connection.
+ (slime-inferior-process): New connection local variable.
+ (slime-process): Use it.
+ (slime-restart-inferior-lisp): Don't use inferior lisp stuff.
+ (slime-switch-to-output-buffer): Process interactive arguments
+ properly.
+
+ * swank-loader.lisp (compile-files-if-needed-serially): Load
+ verbosely.
+
+2004-10-01 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-allegro.lisp (find-fspec-location): excl:source-file can
+ return stuff like (:operator ...); try to handle it.
+
+ * swank-cmucl.lisp (code-component-entry-points): Only include
+ entry points with "valid" functions names. This excludes internal
+ lambdas which have usually a string as name, like "defun foo".
+
+ * swank.lisp (parse-symbol): Don't use the reader to avoid
+ interning unknown symbols. The downside is that we no longer
+ handle escaped |symbols| correctly.
+
+ * slime.el (slime-set-connection-info): Hide the *inferior-lisp*
+ buffer after we know Lisp's pid. Print the words of encouragement
+ here, when all the other asynchronous initialization is completed.
+ (slime-find-buffer-package): We need to preserve the case for
+ things like (:in-package "foo"), so return "\"foo\"".
+
+2004-09-27 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-process): New function intended to replace all
+ those references to the *inferior-lisp* buffer.
+ (slime-maybe-start-lisp): Split it up.
+ (slime-start-lisp): New function.
+ (slime-restart-inferior-lisp): Use the command from the existing
+ process to start the new process.
+
+2004-09-27 Christian Lynbech <christian(a)defun.dk>
+
+ * slime.el (define-slime-dialect): New macro to make starting
+ Lisps with different command line options easier.
+
+2004-09-27 Rui Patroc�nio <rui.patrocinio(a)netvisao.pt>
+
+ * swank.lisp (mop, mop-helper): Support functions for the class
+ browser.
+
+ * slime.el (slime-browse-classes, slime-browse-xrefs): New
+ commands to browse class hierarchies and xref graphs in a tree
+ widget.
+
+ * tree-widget.el: New file. Only needed for older Emacsen.
+
+2004-09-23 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime.el (slime-start-and-load): Take arguments so that the
+ function can be called non-interactively. Only start SLIME is if
+ it is not running.
+ (slime-recompile-bytecode): Don't warn about uses of cl-functions.
+ (slime-reset): Kill all sldb buffers.
+ (slime-goto-location-position): Fix syntax for Emacs 20.
+ (sldb-mode-map): Add C-c C-d bindings.
+ (slime-open-inspector): Insert the type in the second line so that
+ we can make longer titles, e.g we should include the princed
+ version of the inspected object.
+
+ * swank-backend.lisp (frame-package, label-value-line)
+ (label-value-line*): New functions.
+
+ * swank.lisp (frame-locals-for-emacs): Bind *print-pretty* to
+ *sldb-pprint-frames* to get more compact lines and bind *package*
+ to frame-package to get shorter labels for variables.
+ (format-values-for-echo-area): Include the hex and octal
+ representation for integers.
+ (apply-macro-expander, disassemble-symbol): Use the buffer-package
+ for reading.
+ (inspector-content-for-emacs): Use print-part-to-string so that we
+ see cycles in the data structure.
+ (inspect-for-emacs): Minor beautifications.
+ (load-file-set-package): New function.
+
+ * swank-cmucl.lisp (frame-package): Implemented.
+ (inspect-for-emacs): Only include stuff that is actually stored in
+ the object itself (see objdef.lisp for exact object layout).
+ Include the disassembly for functions and code components.
+
+2004-09-19 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-gray.lisp (stream-read-char): Treat empty strings as
+ end-of-file.
+
+ * swank-cmucl.lisp (sis/in): Treat empty strings as end-of-file.
+ (map-allocated-code-components): Inhibit efficiency notes.
+ (arglist)[symbol] Delete unreachable code.
+ (sldb-break-on-return, sldb-break-at-start): Implement it
+ (sldb-step): Some cleanups.
+
+ * swank.lisp (thread-for-evaluation): Restart the listener thread
+ if it was dead for some reason.
+ (debugger-condition-for-emacs): Include "extra" stuff. Currenlty
+ only used to pop up the source buffer at breakpoints.
+ (sldb-break): New function.
+ (interrupt-worker-thread): Interrupt the repl thread if there is
+ no other active thread.
+
+ * swank-backend.lisp (import-swank-mop-symbols): New
+ function. Useful if the implementation has most of the mop symbols
+ in the same package.
+ (sldb-break-on-return, sldb-break-at-start, condition-extras): New
+ functions.
+
+ * slime.el (sldb-break-on-return, sldb-break): New commands.
+ (slime-repl-return-string): Allow empty strings. That's our way
+ to send end-of-file.
+ (sldb-insert-condition): Add "extra" slot for random thing that
+ don't fit nicely somewhere else.
+ (sldb-dispatch-extras): New function.
+ (sldb-show-frame-source): New non-interactive version of
+ sldb-show-source.
+ (sldb-show-source): Use it.
+ (slime-beginning-of-symbol, slime-end-of-symbol): New functions
+ which don't include the character after a hash '#'.
+ (slime-symbol-name-at-point): Use them.
+ (slime-symbol-start-pos, slime-symbol-end-pos): Ditto.
+
+2004-09-17 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp: Don't print "Documentation:" if none is available;
+ add support for classes specializer-direct-methods; deal with
+ eql-specializers in methods.
+ (inspector-princ): New function.
+ (method-specializers-for-inspect): New function.
+ (method-for-inspect-value): New function.
+ (inspect-for-emacs): Use inspector-princ instead of
+ princ-to-string.
+
+ * swank-backend.lisp (swank-mop): Require eql-specializer,
+ eql-specializer-object and specializer-direct-methods in swank-mop
+ package.
+
+ * swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+ swank-openmcl.lisp, swank-sbcl.lisp (swank-mop): Export
+ eql-specializer, eql-specializer-object and
+ specializer-direct-methods from swank-mop.
+
+ * swank-cmucl.lisp (inspect-for-emacs): Thinko fix.
+
+ * swank-lispworks.lisp (swank-mop): Export
+ specializer-direct-methods.
+ (eql-specializer): Implement.
+ (eql-specializer-object): Implement.
+
+ * swank-sbcl.lisp (inspect-for-emacs): Fix broken ignore
+ declaration.
+
+ * doc/slime.texi: Update inspector documentation.
+
+2004-09-16 Marco Baringer <mb(a)bese.it>
+
+ * swank-clisp.lisp (swank-mop, inspect-for-emacs): Only define the
+ CLOS parts of the inspector if the underlying lisp provides the
+ required functionality. If not enough MOP is present to implement
+ the inspector then we define some very simple replacement methods.
+
+2004-09-16 Marco Baringer <mb(a)bese.it>
+
+ * swank-clisp.lisp (swank-mop): Implement the MOP compatability
+ package.
+ (inspect-for-emacs): Update for new inspection API.
+
+2004-09-15 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * swank-openmcl: typo in who-references. Fix frame-var-value
+
+2004-09-15 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-inspector-label-face,
+ slime-inspector-value-face, slime-inspector-action-face,
+ slime-inspector-type-face): These faces now inherit from similar
+ font-lock-<whatever> faces.
+ (slime-open-inspector): Use slime-inspector-value-face for values.
+
+ * swank.lisp (inspect-for-emacs): Add function and compiler-macro
+ documentation when inspecting symbols. View the truename of
+ logical pathnames where they exist. Fix typos in package
+ inspector (fix by Torsten Poulin <torsten(a)diku.dk>).
+
+ * swank-sbcl.lisp, swank-cmucl.lisp (inspect-for-emacs): Insert
+ function object's documentation when it's available.
+
+2004-09-15 Eduardo Mu�oz <emufer(a)terra.es>
+
+ * .cvsignore: Added *.elc
+
+ * hyperspec.el: Fixed syntax error.
+
+2004-09-15 Alan Caulkins <fatman(a)maxint.net>
+
+ * swank.lisp (cleanp-connection-threads): Kill all Swank threads
+ for a connection when it terminates.
+
+2004-09-14 Thomas Schilling <tjs_ng(a)yahoo.de>
+
+ * swank-allegro.lisp (inspect-for-emacs): Fixes to previous patch.
+
+2004-09-14 Marco Baringer <mb(a)bese.it>
+
+ * swank-backend.lisp (inspector, make-default-inspector): Add an
+ INSPECTOR object argument to the inspector protocol. This allows
+ implementations to provide more information regarding cretain
+ objects which can't be, or simply aren't, inspected using the
+ generic inspector implementation. also export inspect-for-emacs
+ and related symbols from the backend package.
+ (make-default-inspector): New function.
+
+ * swank.lisp (inspected-parts): Rename to inspect-for-emacs and
+ add an inspector argument. Move inspect-for-emacs to
+ swank-backend.lisp, leave only the default implementations.
+
+ * swank-openml.lisp, swank-sbcl.lisp, swank-allegro.lisp,
+ swank-cmucl.lisp, swank-lispworks.lisp (inspected-parts): Rename
+ and change argument list. Many of the inspected-parts methods were
+ being clobbered by the inspected-parts in swank.lisp, now that
+ they're being used the return values have been updated for the new
+ inspect-for-emacs API.
+
+2004-09-14 Thomas Schilling <tjs_ng(a)yahoo.de>
+
+ * swank-allegro.lisp (inspected-parts): Implement inspector for
+ structs.
+
+2004-09-13 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp (intern-catch-tag): New function.
+ (read-user-input-from-emacs, take-input): Use it.
+
+2004-09-13 John Paul Wallington <jpw(a)gnu.org>
+
+ * swank.lisp (define-special): Make the doc-type `variable'
+ rather than `symbol'. Don't quote `doc'. Doc fix.
+
+2004-09-09 Martin Simmons <martin(a)xanalys.com>
+
+ * swank-lispworks.lisp: Set up the swank-mop package. Implement
+ swank-mop:slot-definition-documentation and function-name.
+
+2004-09-13 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (inspected-parts): Added inspectors for pathnames,
+ logical pathnames, standard-objects and numbers (float, ratio,
+ integer and complex).
+
+ * swank-backend.lisp: Define import-to-swank-mop.
+
+ * swank-openmcl.lisp, swank-sbcl.lisp, swank-allegro.lisp: Don't
+ define the import-to-swank-mop function (now defined in
+ swank-backend.lisp).
+
+ * swank-cmucl.lisp (swank-mop, function-name): Implement backend
+ for inspector.
+ (arglist): Add support for extracting arglists from function
+ objects.
+ (create-socket): Don't specify the host on PPC.
+
+2004-09-13 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * slime.el slime-goto-location-position: New location specifiers:
+ (:method name specializers . qualifiers) all are strings. Looks
+ for defxxx name then the qualifiers as words, in order then the
+ specializers as words, in order (except for "T", which is
+ optional). Pass the symbols names for specializers and qualifiers
+ (no packages). Used by openmcl but might be useful for others
+ (:text-anchored <position fixnum> <string> <delta fixnum>)
+ Got to position, then search for string, then move delta. To
+ support upcoming source recording for openmcl debugging.
+
+ * swank-openmcl multiple changes: - fix support for *sldb-top*
+ (formerly *swank-debugger-stack-frame*) Was not thread safe. Now
+ (application-error), and (interrupt-thread) records the error
+ pointer in a table associated with thread and map-backtrace picks
+ up the appropriate pointer. *process-to-stack-top*,
+ (grab-stack-top), (record-stack-top).
+
+ - Other adjustments for changes to multiprocessing: remove
+ (force-break-in-listener) no longer necessary since we use
+ process-interrupt instead of ccl::*interactive-abort-process*
+ Adjust break-in-sldb to do so for swank repl connections
+ (abstraction breaking reference to swank::*connections*, but
+ nicely via intern)
+
+ - changes to (find-definitions) (function-source-location),
+ addition of (maybe-method-location) (remove-filename-quoting). To support
+ editing definitions of methods. To fix bug with pathnames with
+ quoted characters (like "\\.swank.lisp"). To remove bogus source
+ recording of l1-boot-3 in functions that didn't have a source file
+ noted.
+
+ - Implementation of xref functions: (xref-locations) uses xref
+ implementation added to openmcl recently. Note that you have to
+ (ccl::start-xref) for it to work for other than who-calls, and
+ that xref information is not currently persisted in fasl files (I
+ will release a patch for this soon) Backend functions (who-binds)
+ (who-macroexpands) (who-references) (who-sets)
+ (who-calls) (list-callees) (who-specializes)
+
+ - Lifted profile backend functions from swank-clisp which use
+ "metering.lisp"
+
+ - (openmcl-set-debug-switches) turns on the various variables I.
+ know about that have the lisp record extra debugging
+ information(including starting xref). I suggest you call
+ it. Should it be called by default?
+
+ - (frame-arguments) use builtin ccl::frame-supplied-args since the
+ current version was sometimes missing the first argument to the
+ function. (I think this was when it was passed by register. If you
+ don't want to lose it in the frame locals in backtrace, call
+ (openmcl-set-debug-switches) specifically, set
+ ccl::*ppc2-compiler-register-save-label* to t
+
+ - implement frame-var-value backend
+
+ * metering.lisp: Minor changes to #+ #- to recognize openmcl
+
+ * swank-loader.lisp: Load "metering.lisp"
+
+2004-09-13 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (inspected-parts): Deal with unfinalized classes in
+ standard-class inspector. (Patch from Thomas Schilling)
+
+2004-09-13 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp: New inspector protocol. The lisp side now returns a
+ specially formated list of "things" to format which are then
+ passed to emacs and rendered in the inspector buffer. Things can
+ be either text, recursivly inspectable values, or functions to
+ call.
+ (inspected-parts): Redefine for new inspector protocol.
+ (*inspectee-parts*): Redefine as array.
+ (*inspectee-actions*): New array, similar to *inspectee-parts*.
+ (reset-inspector): Update for new implementation of
+ *inspectee-parts* and new variable *inspectee-actions*.
+ (inspector-contents-for-emacs): New function.
+ (inspect-object): Update for new inspector protocol.
+ (inspector-nth-part): Update for new *inspectee-parts*
+ implementation.
+ (inspector-call-nth-action): New function.
+
+ * slime.el (slime-inspector-action-face): New face.
+ (slime-open-inspector): Adapt to new inspector protocol.
+ (slime-inspector-operate-on-point): New function, subsumes
+ slime-inspector-inspect-object-at-point.
+ (slime-inspector-next-inspectable-object): Skip to next object,
+ not just end of current object; wrap around buffer.
+ (slime-inspector-mode-map): change bindings of [return] and "\C-m"
+
+ * swank-bacend.lisp (swank-mop): New package. Simply defines all
+ the MOP related symbols we need from an implementation.
+ (arglist): Update doc string. Provide default implementation.
+ (function-name): New backend function.
+
+ * swank-allegro.lisp (swank-mop, slot-definition-documentation):
+ Implement. (Patch from Thomas Schilling)
+
+ * swank-sbcl.lisp (swank-mop, slot-definition-documentation,
+ function-name): Implement.
+
+ * swank-openmcl.lisp (swank-mop, function-name): Implement.
+ (arglist): Implement for function objects.
+
+2004-09-12 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp (compile-file-for-emacs): Use with-buffer-syntax so
+ that SBCL source files can be compiled. From Christophe Rhodes.
+
+2004-09-09 Martin Simmons <martin(a)xanalys.com>
+
+ * swank-loader.lisp (make-swank-pathname): Preserve the host
+ component (important for LispWorks on Windows).
+
+2004-09-08 Martin Simmons <martin(a)xanalys.com>
+
+ * swank-lispworks.lisp: Implement call-with-compilation-hooks.
+
+2004-09-03 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * NEWS: Summarize changes since August.
+
+ * slime.el: Add some docstrings.
+
+ * mkdist.sh: Add PROBLEMS file. We're no longer alpha.
+
+ * swank.lisp: Remove debugging code in comment.
+
+ * swank-sbcl.lisp: Delete dead code.
+
+ * swank-lispworks.lisp (defimplementation): define-dspec-alias
+ seems to more apropriate than define-form-parser.
+
+ * swank-cmucl.lisp (print-frame): Catch errors during printing.
+
+ * README: Fix typo.
+
+2004-09-02 Wolfgang Mederle <wolfgang.mederle(a)stud.uni-muenchen.de>
+
+ * swank-loader.lisp (*lisp-name*): Replace / with - in CMUCL
+ version strings.
+
+2004-09-01 John Paul Wallington <jpw(a)gnu.org>
+
+ * slime.el (slime-oneliner): Don't use free variable.
+ (slime-recenter-window, slime-set-connection-info)
+ (slime-pprint-event, slime-compiler-notes-quit)
+ (slime-apropos-summary): Likewise.
+ (slime-connect): Tidy up handshake `message' call.
+
+2004-09-01 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-repl-push-directory): Fix interactive spec.
+ (sldb-reference-properties): Take a the reference object as
+ argument instead of its parts. Fix callers accordingly.
+ (slime-fuzzy-choices-buffer): Remove assignment to unused variable
+ slime-fuzzy-target-mtime.
+ (slime-ed): Replace call to new-frame with make-frame.
+ (sldb-find-buffer): Cleanup.
+ (sldb-highlight-sexp): Fix regexp. It's now almost a full line.
+
+ * swank.lisp (completion-set, tokenize-symbol-designator)
+ (tokenize-completion, fuzzy-completion-set)
+ (briefly-describe-symbol-for-emacs): Remove simple-base-string
+ declarations.
+
+2004-08-30 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * PROBLEMS: We require SBCL 0.8.13. 0.8.12 is no longer
+ supported.
+
+ * swank-allegro.lisp (find-fspec-location): Catch errors in
+ excl:source-file.
+
+ * swank.lisp (send-to-socket-io): Add some ignore declarations.
+
+ * slime.el (sldb-fetch-all-frames, sldb-end-of-backtrace)
+ (sldb-beginning-of-backtrace): New commands.
+ (slime-search-suppressed-forms): Change the start regexp so that
+ reader conditionals in single line comments, like "; #+foo", are
+ ignored.
+
+2004-08-27 Peter Seibel <peter(a)javamonkey.com>
+
+ * swank-backend.lisp (swank-compile-string): Add directory
+ argument which is used by Allegro backend to improve source
+ recording for definitions compiled with C-c C-c.
+
+2004-08-23 John Paul Wallington <jpw(a)gnu.org>
+
+ * slime.el (slime-pretty-package-name): Fix last cond clause.
+
+2004-08-21 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (*global-debugger*): New configurable to globally
+ install swank-debugger-hook as *debugger-hook*. True by default.
+
+2004-08-19 Luke Gorrie <luke(a)bluetail.com>
+
+ * doc/slime.texi: C-c C-c C-a, C-c C-u C-e.
+ Thanks Barry Fishman for reporting incorrect indexing.
+
+2004-08-18 Matthew Danish <mrd+nospam(a)cmu.edu>
+
+ * swank-allegro.lisp (swank-compile-string): Use #\; instead of
+ #\: to separate the position from the buffer-name. This avoids
+ troubles on Windows.
+
+2004-08-16 Luke Gorrie <luke(a)bluetail.com>
+
+ * doc/slime.texi: Random updates.
+
+ * slime.el (slime-space): Use slime-message instead of
+ slime-background-message. This displays multi-line arglists.
+ (sldb-mode-map): Bind 'C' to sldb-inspect-condition.
+
+2004-08-14 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-find-buffer-package): Use "%s", not "%S", to
+ avoid ugly escape characters, if the package name contains dots.
+
+2004-08-13 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (sldb-eval-in-frame): Print result to the REPL when a
+ prefix argument is given.
+ Added pull-down menus for SLDB and the REPL.
+
+ * swank-source-path-parser.lisp: Removed caching of readtables and
+ the source-map hashtable. Fresh creation is ultra-cheap (<1ms).
+ The caching didn't handle modifications to readtables and
+ generally made me feel uneasy while tracking down an obscure bug
+ in a reader macro.
+ The cached source-map hashtable also wasn't thread-safe (ho hum).
+
+2004-08-13 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-merge-notes, slime-tree-for-note): Use the short
+ note message for annotation in the source buffer and the long
+ message in the tree widget. Used to be the other way around.
+ (sldb-insert-frames): Set the `start-open' property for XEmacs.
+ Without `start-open', the `point-entered' property is inherited
+ when we insert something before the "--more--" marker. Reported
+ by Sundar Narasimhan.
+
+ * swank.lisp (variable-desc-for-echo-area): Bind some printer
+ variables to limit the length of the output.
+
+2004-08-05 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-setup): Added typeout-frame keyword argument.
+ (slime-thread-attach): Fixed misnamed function call.
+
+2004-08-04 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-allegro.lisp (find-fspec-location): Fixed to work for more
+ types of definition than just functions. So M-. now works for e.g.
+ classes in Allegro. From Matthew Danish.
+ (find-fspec-location): Include the type of the definition in the
+ designator sent to Emacs. From Matthew Danish.
+
+2004-08-04 Martin Simmons <martin(a)xanalys.com>
+
+ * swank-lispworks.lisp (frame-actual-args): Correct syntax for
+ handler-case.
+
+2004-08-04 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: (slime-mode-map, slime-repl-mode-map)
+ (slime-repl-read-mode-map): Remove the binding for C-c C-g. C-c
+ C-b is now the default interrupt key.
+ (slime-list-repl-short-cuts): Don't trash the shortcut-table: copy
+ it before sorting. (Thanks to Mark Simpson.)
+
+2004-08-02 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-connect): Shorten the welcome message by leaving
+ out the port number (which is displayed in the REPL anyway). This
+ avoids line-wrapping some messages of encouragement.
+
+ * swank.lisp (with-buffer-syntax): Don't bind *readtable* to
+ *buffer-readtable* if they are already EQ. When we shadow this
+ binding the user can't assign *readtable* from the REPL so it's
+ best avoided when possible.
+
+ * swank-allegro.lisp: Removed fwrapper-based code for inheriting
+ "swankiness" to newly spawned threads. This was fighting the
+ system and not the right thing.
+
+ * slime.el (slime-choose-overlay-region): Tweaked the
+ multiline-annotation-avoidance code to work with forms not
+ starting with an open-paren, e.g. `(..) or #'(..).
+ (slime-update-modeline-package): New configurable. Non-nil (the
+ default) means update the Lisp package in the modeline using an
+ idle timer.
+ (slime-repl-send-input): Make the `slime-repl-old-input' property
+ cover the whole input (including newline) so that pressing RET on
+ the end of an input line works.
+ Use a unique integer as the value of this property to distinguish
+ adjacent inputs.
+ (slime-current-package): Deal with narrowing.
+
+2004-08-01 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-allegro.lisp (swank-compile-string): Use a temporary file
+ and set excl::*source-pathname* manually. This way we can find
+ the source buffer of functions compiled with C-c C-c.
+ (call-with-temp-file, compile-from-temp-file): New functions.
+ (list-callers, function-callers, in-constants-p)
+ (map-function-constants): Implements list callers by groveling
+ through the constants pools of named functions.
+
+ * swank-lispworks.lisp: Minor refactoring.
+
+2004-07-30 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-connection): Say "No default connection
+ selected" if there are open connections but no default connection.
+ (slime-tree-indent-item): Point wasn't updated correctly if the
+ last line was empty. Use insert-before-markers instead of insert
+ to do it properly.
+ (slime-draw-connection-list): Don't break if there is no default
+ connection.
+
+ * swank-cmucl.lisp (call-with-debugging-environment): Only handle
+ DI::UNHANDLED-CONDITION not all DI:DEBUG-CONDITIONs.
+
+ * swank-backend.lisp (sldb-condition): Show the original condition
+ in the message.
+
+2004-07-28 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-eval-feature-conditional): Treat uppercase
+ operators NOT, AND, OR correctly.
+ (sldb-find-buffer): Remove killed buffers.
+ (sldb-quit): Raise an error if the RPC returns.
+ (slime-expected-failures): Delete unused function.
+ (complete-symbol): Test completion of
+ swank::compile-file. LispWorks has extra completions for
+ cl::compile-file.
+ (arglist): Test arglist of method cl:class-name. Add enough
+ regexpery to pass the test in most implementations.
+
+ * swank-sbcl.lisp (list-callers, list-callees): Implemented.
+
+2004-07-26 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-first-change-hook): Add `save-match-data' to
+ avoid breaking e.g. query-replace. Also added `save-excursion'
+ just to be safe.
+
+ * README: s/setup-slime/slime-setup/ in the .emacs snippet.
+
+2004-07-23 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-set-state): Show the message in the modeline in
+ the case where we aren't connected. Otherwise the "not connected"
+ status is ignored.
+ (slime-net-sentinel): Close the connection before changing the
+ status message. The old behaviour of this combined with the old
+ behaviour of `slime-set-state' could generally cause spurious
+ errors after a connection was closed.
+
+2004-07-22 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (carefully-find-package): Return *BUFFER-PACKAGE* if
+ no other package can be found. This is reverting a previous change
+ that broke completion in buffers with no known package.
+
+ * slime.el (slime-maybe-start-lisp): Check that *inferior-lisp*
+ exists /and/ has a running process. Fixes a startup problem if
+ your inferior-lisp has died and you want to restart SLIME.
+
+2004-07-21 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-sync-package-and-default-directory): Sync
+ `default-directory' in the REPL buffer too.
+ (slime-set-state): Convenience function for setting a connection's
+ state-name and updating the modeline if appropriate. This function
+ is called in the right places.
+ (slime-to-lisp-filename): Use `expand-file-name'.
+
+2004-07-20 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-repl-update-banner): Restore old behaviour of
+ using an asynchronous evaluation to setup the REPL. This works
+ around a problem I'd reintroduced where the first REPL command
+ uses the wrong keymap.
+
+2004-07-20 Andreas Fuchs <asf(a)boinkor.net>
+
+ * swank-sbcl.lisp (call-with-compilation-hooks): Trap and report
+ errors that cause compilation to fail, e.g. read errors.
+
+2004-07-19 Luke Gorrie <luke(a)bluetail.com>
+
+ * HACKING: Updated. Some notes about Emacs features.
+
+ * slime.el: More major refactoring.
+ Restructured and documented the networking and protocol code.
+ (slime-rex-continuations): Now connection-local.
+
+2004-07-18 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el: Major refactoring.
+ Mostly resectioning and reordering definitions to try and improve
+ readability.
+ (slime-get-temp-buffer-create): New utility function to popup a
+ temporary buffer that automatically has a binding on `q' to
+ intelligently restore window configuration. Handy, but currently
+ not applicable to all of our temporary buffers.
+ (slime-with-chosen-connection): Removed this macro. Consequently
+ the compilation commands no longer prompt for which connection to
+ use when given a prefix argument. `slime-switch-to-output-buffer'
+ still works like that, but for other cases I think the
+ connection-list buffer is sufficient.
+ (slime-eval-async): New arglist: (form &optional cont pkg). If the
+ continuation is unspecified then the evaluation result is ignored,
+ and if the package is unspecified then (slime-buffer-package) is
+ used.
+ (slime-eval): Package arg now defaults to (slime-buffer-package).
+ (slime-current-package): New name for (slime-buffer-package). No
+ more caching: returns the buffer-local `slime-buffer-package' if
+ set, otherwise searches for an `in-package' form.
+ A consequence of non-caching is that the package name doesn't
+ appear in the modeline anymore. The simplification is worthwhile
+ in my opinion.
+
+2004-07-17 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-autodoc): If there is a global variable name at
+ point then show its value.
+ (slime-autodoc-cache-type): Cache type 'full is no longer
+ supported.
+ (slime-background-message): Truncate messages to fit on a single
+ echo area line.
+ (slime-repl-update-banner-p, slime-dont-prompt)
+ (slime-swank-connection-retries): Removed these unused or unuseful
+ configuration variables.
+ Rearranged organised "customize" groups.
+
+ * swank.lisp (variable-desc-for-echo-area): New function.
+ (arglist-for-echo-area): Return nil if symbol can't be found.
+ (close-connection): Close connection before printing error
+ message. This avoids it getting lost in closed I/O redirection.
+
+ * README, doc/slime.texi: Updated setup instructions.
+
+2004-07-16 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-conservative-indentation): New variable. When
+ true (the default) don't auto-learn indentation of def* and with-*
+ macros. Set to nil if you want to learn them.
+ (slime-handle-indentation-update): Use it.
+
+ * swank.lisp (known-to-emacs-p): Removed filtering of def* and
+ with-*. Now handled by Emacs.
+
+ * slime.el (slime-interactive-eval): Changed display of results.
+ By default the result goes to `slime-message', which leads either
+ to echo area, temporary buffer, or typeout frame.
+ With a prefix argument the result is printed to the REPL.
+ This goes for all commands based on slime-interactive-eval, e.g.
+ `C-x C-e' and `C-c M-:'.
+
+2004-07-16 Peter Seibel <peter(a)javamonkey.com>
+
+ * slime.el (package-updating): Fixing this and other tests I broke
+ with my change to how emacs keeps track of the package prompt
+ string.
+ (arglist): Fix an test failure under Allegro due to a slight
+ difference in the way EXCL:ARGLIST returns arglist (no default
+ values of &optional parameters)
+
+2004-07-16 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (print-connection): print-function for connection
+ objects. Dumping the indentation-cache was damned ugly with
+ non-truncated lines (e.g. bug reports on slime-devel).
+
+ * slime.el (slime-setup): New function for installing a
+ lisp-mode-hook. You can call this from ~/.emacs to setup SLIME.
+ Takes a `autodoc' keyword argument to enable
+ slime-autodoc-mode. We can add more keywords in future.
+ (slime-keys): Moved `slime-reindent-defun' from C-M-q to
+ C-cM-q. This avoids overriding the standard binding of C-M-q to
+ index-sexp.
+ (slime-typeout-frame-properties): Removed some properties:
+ `name', because it interacts badly with X properties, `left' and
+ `top' because they don't put the frame anywhere terribly
+ convenient, and (width . 40) because it makes the frame narrower
+ than the usual word-wrapping width.
+
+2004-07-14 Peter Seibel <peter(a)javamonkey.com>
+
+ * slime.el (slime-lisp-package-prompt-string): Separate SLIME's
+ notion of package into two parts, an actual package name and the
+ name used in the prompt since the latter isn't necessarily an
+ actual package nickname any more.
+
+2004-07-13 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-restart-inferior-lisp): Renamed shortcut to
+ "restart-inferior-lisp" from "restart-lisp". The name better
+ suggests what it does: kill *inferior-lisp* and rerun SLIME.
+
+2004-07-13 Eric Blood <eblood(a)winkywooster.org>
+
+ (slime-inspector-next-inspectable-object): New inspector command
+ to goto the next inspectable object (slot). Bound to TAB.
+
+2004-07-13 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * slime.el: add support for actionable references in the
+ *slime-compiler-notes* buffer.
+ (slime-merge-notes): merge references if applicable.
+ (slime-compiler-notes-mode-map): use new functions defaulting to
+ show-details, but overrideable by text properties.
+ (slime-tree-default-printer): destroy generality by assuming a
+ tree of conditions, and insert references if applicable.
+ (sldb-format-reference-source): add :amop
+
+ * swank-sbcl.lisp (signal-compiler-condition,
+ brief-compiler-message-for-emacs,
+ long-compiler-message-for-emacs): handle references in compiler
+ conditions.
+
+ * swank.lisp (make-compiler-note): propagate references.
+
+ * swank-backend.lisp (compiler-condition): add references slot.
+
+2004-07-12 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-easy-menu): Added "Apropos all" menu item.
+ (slime-restart-lisp): Added `restart-lisp' shortcut. Doesn't do
+ the right thing if you have multiple Lisps up.
+
+ * swank.lisp: Added some docstrings.
+ Rearranged completion code and somewhat SLDB trying to layout
+ functions above their subfunctions in a tree-like way.
+ (slime-protocol-error): Renamed from slime-read-error.
+ (carefully-find-package): Now returns NIL if package can't be
+ determined, rather than *BUFFER-PACKAGE*. Correct? I didn't see
+ why it should return *BUFFER-PACKAGE*.
+ (xref): Find symbol in *BUFFER-PACKAGE*.
+
+2004-07-09 Peter Seibel <peter(a)javamonkey.com>
+
+ * swank.lisp (package-string-for-prompt): Change the way package
+ name in prompt is computed. N.B. after this change the name
+ displayed will not necsarily be either an actual name or nickname
+ of the package: if the name contains dots by default the prompt
+ will only display the last element, i.e. COM.GIGAMONKEYS.SPAM will
+ be shown as SPAM. This change also makes CL-USER the canonical
+ name for COMMON-LISP-USER even in implementations that provide a
+ shorter nickname such as USER.
+
+2004-07-09 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * slime.el (sldb-lookup-reference): substitute hyphens for spaces
+ in the url.
+
+2004-07-07 Thomas Schilling <tjs_ng(a)yahoo.de>
+
+ * swank.lisp (arglist-for-insertion): Changed formatting to use
+ arglist-to-string. That results in proper cases for
+ slime-insert-arglist.
+
+2004-07-07 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-loader.lisp (*lisp-name*): Include the version number in
+ ACL.
+
+ * slime.el (slime-alistify): Preserve order. This keeps the
+ *compiler-notes* right. Pointed out by Christophe Rhodes.
+ (slime-repl-update-banner-p): Renamed from slime-reply-..
+ (slime-changelog-date): Reintroduced for informational purposes.
+ (slime-repl-update-banner): Show ChangeLog date in the animation.
+ (slime-space): Do arglist lookup before inserting the
+ space. Otherwise we get a funky race condition: entering the space
+ may trigger `first-change-hook', which would send an async
+ notification to Lisp, which would put us in the 'busy' state and
+ thus we wouldn't lookup the arglist! Detective work by Edi Weitz.
+ (sldb-prune-initial-frames): More regexp fudgery :-(.
+ (read-directory-name): Use `file-name-as-directory' to ensure we
+ have the trailing / on the directory name.
+ (byte-compile-warnings): Bye-compile slime-alistify. Its inputs
+ can be pretty big.
+
+2004-07-04 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el, swank-backend.lisp, swank.lisp: Added a new backend
+ function `buffer-first-change' which is called via Emacs's
+ `first-change-hook' in slime-mode buffers. This gives Lisp a
+ chance to do something with source files before you change them on
+ disk.
+
+ * swank-cmucl.lisp (buffer-first-change): Suck the source file
+ into the cache unless already present. This is for M-. to increase
+ the chances of our having a copy of the sources corresponding with
+ the loaded code. Should help with the case where a user edits and
+ saves a file (without recompiling it) and then M-.'s for one of
+ its definitions.
+
+ * swank-allegro.lisp (make-process/inherit): Changed reader
+ conditionals to use fwrappers for #+(version>= 6).
+
+ * swank-backend.lisp (make-stream-interactive): This backend
+ function is called with each stream that will be used for
+ user-interaction, i.e. the redirected stdio streams. Can be used
+ to setup special output-flushing or similar.
+
+ * swank.lisp (open-streams): Call make-stream-interactive on the
+ redirected io streams.
+
+ * swank-allegro.lisp (make-stream-interactive): Set
+ interactive-stream-p slot on the stream to make it auto-flush.
+ (*swank-thread*, *inherited-bindings*): New variables.
+ (spawn): Bind *swank-thread* to T.
+ (make-process/inherit): Fwrapper (advice) for
+ mp:make-process. When *swank-thread* is T then make the new thread
+ inherit "sliminess": debugger hook, I/O streams, and also
+ *swank-thread* so that its children will inherit too.
+
+2004-07-03 Luke Gorrie <luke(a)bluetail.com>
+
+ * hyperspec.el (common-lisp-hyperspec-section-4.0): Bugfix from
+ Lennart Staflin.
+
+ * slime.el (slime-repl-clear-output): Avoid clearing the previous
+ REPL expression too. Patch from Andras Simon.
+
+ * swank-backend.lisp (definterface): Don't use
+ NO-APPLICABLE-METHOD for default methods. Instead just define them
+ as regular methods with all argument types being
+ T. Defimplementation will then replace them by using the same
+ signature. N-A-M was a stupid idea!
+
+2004-07-02 Brian Downing <bdowning(a)lavos.net>
+
+ * slime.el (slime-reindent-defun): Added a check for (boundp
+ 'slime-repl-input-start-mark) before checking the variable, as
+ XEmacs leaves variables unbound when `make-variable-buffer-local'
+ is run, while GNU Emacs binds them to NIL.
+
+2004-07-02 Martin Simmons <martin(a)xanalys.com>
+
+ * swank-lispworks.lisp (dspec-stream-position,
+ make-dspec-location): Fix typo in features for LW 4.1 and 4.2.
+
+2004-07-01 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-lispworks.lisp (frame-actual-args): Bind
+ *break-on-signals* to nil and special case &rest, &optional, and
+ &key.
+
+2004-07-01 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (sldb-lookup-reference): Preserve case in SBCL node
+ names. Previously they were downcased, but the HTML manual's
+ filenames seem to have changed.
+
+ * NEWS: Added security note about the TCP server.
+ Added notes for ACL and ABCL.
+
+ * doc/slime.texi: General updatings for an alpha release.
+
+2004-06-30 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-display-compilation-output): New customizable
+ variable.
+
+ * swank.lisp: Minor cleanups.
+ (find-symbol-designator, find-symbol-or-lose)
+ (case-convert-input): Deleted. Replaced with calls to
+ parse-symbol{-or-lose}.
+
+ * swank-lispworks.lisp (describe-symbol-for-emacs): Include
+ information about setf-functions.
+ (emacs-connected): Add a default method to
+ env-internals:environment-display-debugger.
+
+2004-06-30 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-read-port-and-connect-to-running-swank)
+ (slime-connect, slime-open-stream-to-lisp): Replace "localhost"
+ with "127.0.0.1". This is believed to avoid unwanted DNS lookups
+ on certain operating systems. The lookups can become crippling if
+ the DNS server isn't available.
+ (line-beginning-position, line-end-position): Simple bugfix
+ suggested by Richard Klinda.
+
+ * swank-sbcl.lisp (preferred-communication-style): Choose
+ :fd-handler instead of :sigio when threads aren't available. A lot
+ of people seem to have had problems with :sigio on SBCL.
+
+2004-06-30 Luke Gorrie <luke(a)bluetail.com>
+
+ * NEWS: Wrote preliminary release notes for alpha-1.
+
+2004-06-29 Luke Gorrie <luke(a)bluetail.com>
+
+ * mkdist.sh: New shell script for creating a tarball for
+ distribution.
+
+2004-06-29 Bill Clementson <Bill_Clementson(a)peoplesoft.com>
+
+ * slime.el (slime-who-map): Add extra bindings for the XREF
+ commands as with the documentation commands. Now `C-c C-w C-c' is
+ `slime-who-calls' in addition to `C-c C-w c', etc.
+
+2004-06-29 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (sldb-prune-initial-frames): Tweaked regexp for
+ matching SWANK's own stack frames for effectiveness in SBCL.
+ (slime-keys): Shadow remaining inf-lisp keys (C-c C-a, C-c C-v)
+ with a null `slime-nop' command until we put them to a real use.
+
+ * swank.lisp (open-streams): Renamed the restart around reads from
+ the user-input stream from ABORT to ABORT-READ. Invoking this
+ restart seems kinda dangerous, so better for 'a' in SLDB not to do
+ so.
+
+2004-06-28 Thomas F. Burdick <tfb(a)OCF.Berkeley.EDU>
+
+ * swank.lisp (inspector-nth-part):
+ * slime.el (slime-inspector-copy-down, slime-inspector-mode-map):
+ Added copy-down command (M-RET) to easily move an object from the
+ inspector to the repl.
+
+2004-06-28 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-doc-map): New keymap for documentation
+ commands. These all use the `C-c C-d' prefix, followed by:
+ a - apropos
+ p - apropos-package
+ z - apropos-all
+ d - describe-symbol
+ f - describe-function
+ h - hyperspec lookup
+ ~ - hyperspec lookup of a format character
+ The final keystroke is bound both unmodified and with control, so
+ both `C-c C-d a' and `C-c C-d C-a' will make an apropos
+ search. The exception is hyperspec-lookup, because it's nice to
+ leave C-h unbound so that `C-c C-d C-h' will summarise the
+ documentation bindings.
+
+2004-06-28 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-allegro.lisp (nth-frame): Skip frames where
+ frame-visible-p is false.
+
+ * slime.el (slime-buffer-package): Return the cached package if we
+ can't find something more sensible; this reverts a previous
+ change. The Lisp side will now fall back to an existing package
+ if the one supplied by Emacs doesn't exist. Using the cached
+ version is also necessary for some commands in the apropos buffer.
+ (sldb-insert-frame): Set the default-action property; pressing RET
+ on frame lines now shows/hides details.
+ (sldb-toggle-details): Preserve the current column.
+ (slime-inspector-buffer, slime-saved-window-config)
+ (slime-inspector-quit): Save and restore the window configuration.
+ (slime-highlight-suppressed-forms, slime-search-suppressed-forms):
+ Display expressions with reader conditionals (#+/#-) in
+ font-lock-comment-face if the test is false. Not implemented for
+ XEmacs.
+ (repl-return): New test.
+
+2004-06-28 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el: Events in the *slime-events* buffer are now exact
+ on-the-wire messages, without including e.g. Elisp continuation
+ functions. This is easier for debugging I think.
+
+ * swank-allegro.lisp (compute-backtrace): Only include frames
+ satisfying `debugger:frame-visible-p'. I did this as a lame
+ workaround for a problem where `output-frame' was segfaulting on
+ certain frames, and those frames happened not to be visible-p. I
+ don't know if it really fixes anything.
+
+ * hyperspec.el (common-lisp-hyperspec-format): This command now
+ works at the end of the buffer, fixed `char-after' usage as
+ suggested by Johan Bockg�rd.
+
+2004-06-28 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * hyperspec.el: add support for issue cross-reference lookups,
+ strongly inspired by hyperspec symbol lookup.
+ (common-lisp-hyperspec-issuex-table,
+ common-lisp-hyperspec-issuex-symbols): new variables
+ (common-lisp-issuex): new function
+
+ * slime.el (sldb-format-reference-node, sldb-lookup-reference):
+ (sldb-reference-properties): use new support for issue lookups
+ to support :ansi-cl :issue reference types.
+
+ * hyperspec.el: add support for glossary lookups.
+ (common-lisp-glossary-fun): new variable
+ (common-lisp-glossary-4.0, common-lisp-glossary-6.0): new functions
+
+ * slime.el (sldb-format-reference-node, sldb-lookup-reference):
+ (sldb-reference-properties): use new support for glossary lookupts
+ to support :ansi-cl :glossary reference types.
+
+2004-06-27 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * doc/slime.texi: Remove macros from chapter and section headings
+ to avoid texi2pdf breakage.
+
+ * swank-source-path-parser.lisp (cmucl-style-get-macro-character):
+ Add tests for #\space and #\\. Suggested by Christophe Rhodes.
+
+ * swank-sbcl.lisp, swank-openmcl.lisp, swank-lispworks.lisp,
+ swank-cmucl.lisp, swank-backend.lisp, swank-allegro.lisp,
+ swank-abcl.lisp (thread-id, find-thread): New backend functions.
+
+ * swank.lisp (dispatch-event): Quitting from the debugger was
+ seriously broken. Fix it. Move generation of thread ids to the
+ backends.
+ (encode-message, send-to-socket-io): Use WITHOUT-INTERRUPTS in
+ send-to-socket-io. The multithreaded version of encode-message
+ doesn't need it.
+ (nth-thread): Renamed from lookup-thread-by-id.
+ (debug-nth-thread): Renamed from debug-thread-by-id:
+ (kill-nth-thread): Renamed from kill-thread-by-id.
+
+ * slime.el (sldb-get-buffer): Add support for sldb buffers for
+ multiple threads.
+
+2004-06-25 Thomas F. Burdick <tfb(a)OCF.Berkeley.EDU>
+
+ * swank-sbcl.lisp (call-with-syntax-hooks, with-debootstrapping):
+ Preserve compatability with fairly recent SBCLs by checking for
+ the presense of the debootstrapping facilities at macroexpansion
+ time.
+
+ * slime.el (sldb-insert-condition): Initialize sldb-default-action
+ so that pressing RET inspects the condition.
+
+2004-06-25 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-repl-insert-prompt): Set defun-prompt-regexp.
+ beginning-of-defun can be very slow in the repl buffer if the
+ defun-prompt-regexp is not set.
+ (sldb-insert-locals): Initialize sldb-default-action.
+ (sldb-var-number-at-point, sldb-inspect-var): New function.
+
+ * swank.lisp (inspect-frame-var): New function.
+
+ * swank-backend, swank-cmucl.lisp, swank-sbcl.lisp,
+ swank-allegro.lisp, swank-lispworks.lisp, swank-clisp.lisp
+ (frame-var-value): New backend function.
+
+2004-06-24 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * slime.el (sldb-format-reference-node): fix for when `what' is a
+ list.
+ (sldb-lookup-reference,sldb-reference-properties): support
+ :ansi-cl :section reference types.
+
+ * hyperspec.el (common-lisp-hyperspec-6.0): generalize to work
+ with section numbers lower than 10.
+
+2004-06-24 Brian Downing <bdowning(a)lavos.net>
+
+ * slime.el (slime-repl-send-input): Fixed a subtle difference in
+ sending input to the Lisp introduced in 1.316. The newline was
+ not getting sent, resulting in the Lisp constantly asking for more
+ read data. I believe the code has been adjusted to behave the
+ same as 1.315 with regard to sending newlines.
+ Also adjusted the `slime-repl-old-input' text property to end just
+ before the newline, not just after. This causes a gap between
+ inputs even if no Lisp output appeared in between, so that putting
+ point on an old line and hitting RET will only call up that line,
+ and hitting RET in the middle of the current line will send it and
+ not bring up a confusing combination of all previous input.
+ Many thanks to Loyd Fueston for pinpointing the date and exact
+ patch for when this problem was introduced.
+
+2004-06-23 Brian Downing <bdowning(a)lavos.net>
+
+ * slime.el: Re-added most of Luke's patches from yesterday. It
+ has the shortened names, uses markers instead of stored `(point)'
+ values, and `slime-fuzzy-complete-symbol' is an option for
+ `slime-complete-symbol-function'.
+ It still string compares the target buffer instead of using
+ `(buffer-modified-tick)'.
+ I left the `C-c M-i' keybinding in, as it allows use of the
+ regular completion as well. If there's an objection to this it
+ can be removed.
+ `window-configuration-change-hook' is used if the variable is
+ present, and ignored it not. This neatly sidesteps its absence in
+ XEmacs while not killing the functionality for GNU Emacs.
+
+ * doc/slime.texi: Added a command entry and short description for
+ `C-c M-I, slime-fuzzy-complete-symbol', and added its existence to
+ the `slime-complete-symbol-function' documentation.
+
+2004-06-22 Luke Gorrie <luke(a)bluetail.com>
+
+ * doc/slime.texi: Noted ABCL support.
+
+ * slime.el: Backed out all of my changes to fuzzy completion. I
+ was too hasty and didn't do good things. Now it's back in pristine
+ state from Brian's patch -- use `C-c M-i' to fuzzy-complete.
+
+ * doc/Makefile (contributors.texi): The contributors list in the
+ manual is now sorted by most number of ChangeLog entries. Patch
+ from Michael Weber.
+
+ * slime.el: Some minor hacking to fuzzy completion:
+ Use the shorter `slime-fuzzy-' symbol prefix.
+ Use markers instead of numbers to remember where the completion is
+ being done. This way they are self-updating.
+ Use `buffer-modified-tick' to detect modifications instead of text
+ comparison.
+ Always restore window configuration when a completion is
+ chosen. For this completion style I think this will work okay
+ [famous last words], and the existing code wasn't
+ XEmacs-compatible for want of window-configuration-change-hook.
+ Now there is no separate keybinding for fuzzy completion, but it's
+ included as a customize option for `slime-complete-symbol-function'
+
+2004-06-22 Brian Downing <bdowning(a)lavos.net>
+
+ * slime.el, swank.lisp: Added "fuzzy completion."
+
+2004-06-22 Matthew Danish <mdanish(a)andrew.cmu.edu>
+
+ * swank-backend.lisp (unbound-slot-filler): New structure for
+ representing an unbound slot in the inspector functions.
+
+ * swank.lisp, swank-allegro.lisp: Use it.
+
+2004-06-22 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-output-filter): Choose connection based on
+ process-buffer, not current buffer. This fixes a bug where output
+ from multiple Lisp sessions could get mixed up.
+ (slime-kill-all-buffers): Include all *inferior-lisp*[<n>] buffers.
+ Split the customize settings into more subgroups.
+
+ * swank.lisp (prefixed-var): Intern *REAL-STANDARD-INPUT* etc in
+ the SWANK package instead of the COMMON-LISP package.
+
+2004-06-21 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-loader.lisp (*lisp-name*): Add version number to
+ Lispwork's fasl directory. We should do this for ACL and OpenMCL
+ too, but for some reason my ACL 5.0 gets an error when trying to
+ create a directory with a version number in its name, and I don't
+ have OpenMCL to test with.
+
+ * swank-backend.lisp, swank.lisp (add-hook, run-hook): Moved the
+ hook mechanism and all hooks to swank.lisp (from
+ swank-backend.lisp). There is no compelling use for the hooks in
+ backends yet and I want to pass swank.lisp-internal data
+ structures in the existing hooks.
+ (notify-backend-of-connection): Call `emacs-connected' with the
+ user-io stream for its argument. Should fix previous breakage
+ where the connection structure was passed instead.
+ (*globally-redirect-io*): New configurable: when true the standard
+ streams are globally redirected to Emacs. That way even
+ e.g. SERVE-EVENT handlers will print to Emacs. Currently does not
+ handle standard input -- that is trickier since the Lisp's native
+ REPL can be trying to read from that.
+
+ * slime.el (slime-complete-maybe-restore-window-configuration):
+ Only restore the window configuration if the completions buffer is
+ currently visible in the window that we popped it up in.
+ (slime-complete-maybe-save-window-configuration): Don't save the
+ window configuration if the completions buffer is already visible.
+ (slime-repl-return): Make sure the newline goes at the end of the
+ input, not at point.
+ (slime-complete-restore-window-configuration): Wrap the
+ `set-window-configuration' call in (run-at-time 0 ..). XEmacs does
+ not allow us to set the window configuration from inside
+ pre-command-hook.
+
+2004-06-20 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-sbcl.lisp (emacs-connected): Set *invoke-debugger-hook* to
+ our debugger hook. Not optimal, but at least BREAK will then
+ invoke our debugger.
+ (*trap-load-time-warnings*): New variable. If it is true,
+ conditions, most notably redefinition warnings, signalled at load
+ time are not trapped.
+ (swank-compile-file, swank-compile-string): Use it.
+
+ * swank.lisp (guess-buffer-package): Don't signal a continuable
+ error if the package doesn't exists; that's too annoying.
+
+ * slime.el: Fix outline structure.
+ (slime-maybe-list-compiler-notes): Fix thinko.
+ (break): New test. Reorganize the test-suite a bit to support
+ "expected failures".
+ (slime-eval-feature-conditional, slime-to-feature-keyword): Add a
+ ?: to the symbol-name if needed.
+
+2004-06-20 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (changelog-date): Removed unneeded function.
+ (connection-info): No more version field in result.
+
+ * slime.el: Audited to remove namespace slipups. Tracking a really
+ horrible clashing-with-some-user-configuration bug and want to
+ eliminate potential symbol conflicts.
+ (sldb-get-buffer): Renamed from `get-sldb-buffer'.
+ (slime-emacs-20-p): Renamed from `emacs-20-p'.
+ (slime-defun-if-undefined): Renamed from `defun-if-undefined'.
+ (slime-isearch): Small bugfix that could cause M-. to go to the
+ wrong place in CMUCL.
+ (slime-changelog-date, slime-check-protocol-version): Removed
+ unneeded functions.
+
+ * swank-backend.lisp (add-hook, run-hook): Added an Emacs-like
+ hook mechanism. The hope is that this will make some sections of
+ the code more self-describing by showing where they hook in.
+ (*new-connection-hook*): Hook run when a new connection is
+ established. Initialized to '(swank-backend:emacs-connected).
+ (*pre-reply-hook*): Hook run before sending a reply to Emacs.
+
+ * swank.lisp: Added some comments and docstrings.
+ (package-external-symbols): Removed unused function.
+ (serve-connection): Call *new-connection-hook*.
+ (eval-for-emacs): Call *pre-reply-hook*.
+ (sync-features-to-emacs, sync-indentation-to-emacs): Added to
+ *pre-reply-hook*.
+ (cl-package, keyword-package): Now defconstant instead of
+ defvar. Removed the *'s accordingly.
+
+ * slime.el (slime-abort-connection): Renamed from
+ `slime-connection-abort'. The new name is easier to find with
+ completion.
+
+ * swank-sbcl.lisp: Change sb-posix:: to sb-posix:
+
+2004-06-19 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (known-to-emacs-p): Bugfix. Indentation-updates was
+ broken.
+
+2004-06-18 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-buffer-package): If DONT-CACHE is true and no
+ package name can be found, then default to "COMMON-LISP-USER."
+ Previously we just kept using the cached version, but that could
+ lead to error-after-error if it was incorrect.
+
+ * swank.lisp (throw-to-toplevel): If our top-level catcher isn't
+ on the stack (i.e. we're using the debugger from outside an RPC)
+ then ABORT instead. That makes 'q' DWIM in SLDB.
+
+2004-06-18 Matthew Danish <mdanish(a)andrew.cmu.edu>
+
+ * swank-allegro.lisp (frame-source-location-for-emacs):
+ Implemented.
+
+2004-06-18 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-repl-return): If the user presses return on old
+ REPL input then take it and insert it as the current input.
+ Signal an error if the point is not on any input.
+ (slime-preserve-zmacs-region): Function to ensure that the current
+ command doesn't deactivate zmacs-region (XEmacs only).
+ (slime-repl-bol, slime-repl-eol): Use it.
+ (slime-kill-all-buffers): Changed buffer-name regexps for XEmacs
+ compatibility. The ",quit" shortcut now works in XEmacs.
+ (slime-display-message): Fixed call to `slime-typeout-message'
+ to handle formatting characters. Avoids errors on certain messages.
+ (slime-list-compiler-notes): Save the window configuration
+ earlier. This fixes an error under XEmacs when dismissing the
+ notes buffer.
+ (slime-recenter-window): Avoid moving the point. This keeps the
+ point in the right place when showing debugger-frame locations in
+ Emacs 21.
+
+2004-06-17 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-loader.lisp (binary-pathname): Place fasl files under
+ ~/.slime/fasl/ instead of the SLIME installation directory. The
+ installation directory can now be read-only.
+ (binary-pathname, user-init-file): Removed Win32
+ conditionalization. The init file is now called ~/.swank.lisp
+ instead of ~/_swank.lsp.
+
+ * swank-lispworks.lisp (with-fairly-standard-io-syntax): New
+ macro. Like with-standard-io-syntax, but keeps the existing values
+ of *package* and *readtable*.
+ (dspec-stream-position): Use it.
+ (quit-lisp): Implemented.
+
+2004-06-16 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-set-default-directory): Don't call
+ slime-repl-update-banner in Emacs 20.
+ (slime-show-source-location, slime-recenter-window): Use
+ set-window-start instead of recenter; this avoids flickering.
+ (sldb-list-locals): Don't forget about slime-current-thread in the
+ temporary buffer. (Fixes bug reported by Mike Beedle.)
+ (sldb-step): Re-enabled. The CMUCL backend has rudimentary support
+ for stepping.
+
+ * swank.lisp (*readtable-alist*): Call backend function for
+ initialization.
+ (eval-for-emacs, guess-buffer-package): Signal a continuable error
+ if a package name was supplied but no such package exists. Not
+ sure if this is better than what we did before (i.e. silently use
+ the current package).
+
+ * swank-cmucl.lisp (default-directory): Add implementation.
+ (sldb-step): Uncomment it and remove references to
+ *swank-debugger-condition*.
+
+ * swank-backend.lisp (sldb-step, default-readtable-alist): New
+ backend functions.
+ (emacs-connected): Pass the redirected stream as argument, so that
+ the OpenMCL backend can add it to CCL::*AUTO-FLUSH-STREAMS*.
+
+ * swank-sbcl.lisp (default-readtable-alist): Implement it.
+
+ * swank-loader.lisp: Move readtable-alist initialization to
+ swank-sbcl.lisp.
+
+ * swank-allegro.lisp (default-directory, call-with-syntax-hooks):
+ Add implementations as workarounds for ACL5 bugs.
+
+2004-06-16 Lawrence Mitchell <wence(a)gmx.li>
+
+ * slime.el (slime-maybe-rearrange-inferior-lisp): Call
+ `generate-new-buffer-name' manually, rather than relying on the
+ UNIQUE argument to `rename-buffer' to do so.
+
+2004-06-16 Frederic Brunel <frederic.brunel(a)in-fusio.com>
+
+ * slime.el (slime-startup-animation): Use defcustom to declare the
+ variable.
+ (slime-enable-startup-animation-p): Deleted.
+
+2004-06-16 Robert Lehr <bozzio(a)the-lehrs.com>
+
+ * slime.el (slime-backend): This variable can now be set to an
+ absolute filename.
+
+2004-06-15 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-compile-file): Just prompt for saving the
+ current file instead of calling `save-some-buffers'. Based on a
+ patch from Brian Downing.
+
+2004-06-12 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * wank-allegro.lisp (format-sldb-condition, condition-references):
+ Add workarounds for buggy no-applicable-method.
+
+ * swank.lisp (parse-symbol, parse-package): Handle reader errors.
+
+ * swank-openmcl.lisp (send, receive): Ensure that messages are
+ never nil.
+
+2004-06-10 Christophe Rhodes <csr21(a)cam.ac.uk>
+
+ * swank-sbcl.lisp (call-with-syntax-hooks): Add hooks to fix
+ "SB!"-style package names.
+ (shebang-readtable): Return a readtable with readermacros needed
+ to parse SBCL sources.
+
+ * swank.lisp (with-buffer-syntax): New macro. This should be used
+ for code which needs to READ code from Emacs buffers. *package*
+ and *readtable* are bound suitable values.
+ (to-string, format-values-for-echo-area, interactive-eval)
+ (eval-region, interactive-eval-region, re-evaluate-defvar)
+ (swank-pprint, pprint-eval, listener-eval)
+ (compile-string-for-emacs, disassemble-symbol, describe-to-string)
+ (describe-symbol, describe-function)
+ (describe-definition-for-emacs)
+ (documentation-symbol, init-inspector, inspect-nth-part)
+ (inspector-pop, inspector-next, describe-inspectee)
+ (inspect-current-condition): Use it.
+
+2004-06-10 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-loader.lisp: Initialize swank::*readtable-alist* for SBCL.
+
+ * swank-backend.lisp (default-directory, call-with-syntax-hooks):
+ New functions.
+
+ * swank.lisp (*readtable-alist*): New configurable. The keys are
+ package name and the values readtables. The readtable will be
+ used to READ code originating from Emacs buffers in the associated
+ slime-buffer-package.
+ (drop-thread): Simplified.
+ (*buffer-readtable*): New variable.
+ (parse-package): New function.
+ (parse-string): Renamed from symbol-from-string. Make it case
+ insensitive.
+ (eval-for-emacs): Initialize the *buffer-readtable*.
+ (symbol-indentation): Don't consider symbols in the CL package.
+ Emacs already knows how to indent them.
+ (compile-file-if-needed): Used for REPL shortcut
+ 'compile-and-load'.
+
+ * slime.el (pwd): Re-add REPL shortcut.
+ (slime-repl-push-directory, slime-repl-compile-and-load): Simplified.
+
+2004-06-10 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (sldb-step): Command is disabled because the function
+ `swank:sldb-step' that it calls doesn't exist. I don't see any
+ stepping code in our backends.
+
+2004-06-09 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-goto-location-position) [:function-name]: The
+ function name can also occur after a ?(, not only after
+ whitespace.
+
+ * (slime-init-output-buffer): Initialize the package stack.
+ Reported by Rui Patroc�nio.
+
+ * (slime-completions): Make it consistent with
+ slime-simple-completions. The second argument was never supplied.
+ Reported by Rui Patroc�nio.
+
+2004-06-09 Eric Blood <eblood(a)winkywooster.org>
+
+ * slime.el (slime-indent-and-complete-symbol): Renamed from
+ slime-repl-indent-and-complete-symbol.
+
+ (slime-typeout-frame-properties): Add more default options for the
+ typeout frame--specifically it now has a default width, and moves
+ the typeout frame to the upper right.
+
+2004-06-09 Andras Simon <andras(a)renyi.hu>
+
+ * swank-abcl.lisp: New backend for Armed Bear Common Lisp.
+
+ * swank-loader.lisp: Add ABCL support.
+
+2004-06-09 Martin Simmons <martin(a)xanalys.com>
+
+ * swank-lispworks.lisp (dspec-stream-position): New function to
+ make source location work for anything complicated e.g. methods.
+ (with-swank-compilation-unit): Refactoring.
+ (who-macroexpands): Implemented.
+ (list-callers): Implemented.
+
+ * swank-backend.lisp (network-error): Inherit from simple-error to
+ get correct initargs.
+
+2004-06-09 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (sldb-insert-references): Added support for hyperlinked
+ references as part of conditions being debugged. This is a new
+ feature in SBCL to reference appropriate sections of their manual
+ or CLHS from condition objects. The references are clickable.
+
+ * swank-backend.lisp (format-sldb-condition): New backend function
+ to format conditions for SLDB.
+ (condition-references): New function to return a list of
+ documentation references associated with a condition.
+
+ * swank.lisp (debugger-condition-for-emacs): Call the above
+ backend functions to add a `references' list for Emacs.
+
+ * swank-sbcl.lisp (format-sldb-condition, condition-references):
+ Implemented. Requires a recent (latest?) SBCL release.
+
+2004-06-08 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-cmucl.lisp (close-socket): Remove any SERVE-EVENT handlers
+ for the socket's file descriptor.
+
+ * swank-sbcl.lisp (close-socket): Same fix.
+
+2004-06-07 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-cmucl.lisp: Minor refactorings.
+
+2004-06-07 Edi Weitz <edi(a)agharta.de>
+
+ * swank-allegro.lisp (call-with-compilation-hooks): Implemented.
+ Wrap IMPORT call in EVAL-WHEN.
+
+ * swank.lisp, swank-backend.lisp: Wrap EXPORT calls in
+ EVAL-WHEN. Fixes many warnings in ACL.
+
+2004-05-25 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-kill-without-query-p): Default to T.
+ (sldb-highlight): Variable to control face-based highlighting of
+ SLDB locations. (In Emacs21 the point is visible even in unselected
+ windows, which is sufficient for me.)
+ (sldb-show-location-recenter-arg): Argument to `recenter' when
+ showing SLDB locations. Default to nil, i.e. location appears in
+ the middle of the window.
+
+2004-05-24 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-input-complete-p): Return nil for unbalanced
+ sexps starting with quote ?', backquote ?`, or hash ?#. C-j can
+ be used for more complicated cases.
+
+2004-05-22 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-repl-sayoonara): Added "quit" as an alias for
+ sayoonara.
+
+2004-05-22 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (arglist): Catch (reader) errors in
+ READ-ARGLIST.
+
+ * swank-allegro.lisp (fspec-primary-name): New function.
+ (find-fspec-location): Use it, if the start position cannot be
+ found.
+
+ * slime.el (slime-pprint-event): New function.
+ (slime-log-event): Use it.
+ (slime-reindent-defun): Indent the form after point, if point is
+ in the first column an immediately before a #\(.
+
+2004-05-21 Bill Clementson <Bill_Clementson(a)peoplesoft.com>
+
+ * slime.el (slime-switch-to-output-buffer): Use "P" as interactive
+ spec.
+
+2004-05-21 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-switch-to-output-buffer): Override the
+ prefix-arg if we are called non-interactively.
+ (slime-repl-current-input): Don't add newlines.
+ (slime-repl-return): Send input if we are in read-mode also if it
+ isn't a complete expression.
+ (repl-read-lines): New test case.
+ (slime-enable-startup-animation-p): New configurable.
+ (slime-repl-update-banner): Use it.
+ (slime-hide-inferior-lisp-buffer): New function. Reuse the
+ *inferior-lisp* buffer window for the SLIME REPL.
+
+ * swank-allegro.lisp (find-fspec-location): Better handling of
+ methods. From Bill Clementson.
+
+2004-05-17 Luke Gorrie <luke(a)bluetail.com>
+
+ * xref.lisp, swank-clisp.lisp: Renamed XREF package to PXREF (P
+ for portable). This makes it possible to load the package in
+ e.g. CMUCL, which is nice because it's a good package.
+
+ * swank-cmucl.lisp: Some refactoring and high-level
+ commenting. Mostly just trying to organise things into fairly
+ self-contained sections (my new hobby, sad I know!)
+
+ * slime.el: Added `C-c C-e' as an alternative binding for
+ `slime-interactive-eval' (usually `C-c :'). This seems slightly
+ more convenient, and has the added bonus of clobbering an unwanted
+ `inf-lisp' binding.
+
+2004-05-14 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-with-output-to-temp-buffer): Now takes a
+ package arg specifying what slime-buffer-package should be in the
+ generated buffer.
+ (slime-show-description): actually pass the package arg.
+ (slime-show-apropos): pass the package arg to
+ slime-with-output-to-temp-buffer.
+ (slime-list-repl-shortcuts): pass a package arg.
+
+2004-05-12 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * swank-openmcl.lisp: Fixes to support openmcl 0.14.2 changes in
+ backtrace protocol, from Gary Byers.
+ - Replace string "tcr" to "context".
+ - Change the call to %current-tcr in map-backtrace to get-backtrace-context,
+ defined so as to be back compatible with 0.14.1.
+ - Change the call to %catch-top to explicitly use %current-tcr
+ instead of the passed in tcr-which-is-now-called-context.
+
+ Users of map-backtrace (outside of slime code) note: The tcr position in the
+ function call is now occupied by the backtrace "context" which is always nil.
+ If you really need the tcr then you need to call %current-tcr yourself now.
+
+ Gary comments: The part that's a little hard to document about
+ the new "context" stuff - used to walk the stacks of thread A from
+ thread B - is that thread B has to be aware of when a context
+ becomes invalid (a context describing part of thread A's stack is
+ valid while thread A's sitting in a break loop and becomes invalid
+ as soon as it exits that break loop.) A thread sort of announces
+ when a context becomes valid and when it becomes invalid; whether
+ and how SWANK could hook into that isn't yet clear.
+
+ * swank-openmcl.lisp: Minor changes to backtrace display: Anonymous
+ functions names in function position surrounded by #<>. Use prin1 instead of
+ princ to print function arguments (so strings have "s around them).
+ prefix symbol and list arguments by "'" to make them more look like a
+ valid function call. Let me know if you don't like this...
+
+2004-05-12 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el: Fixes for outline-mode in *slime-events* from Edi
+ Weitz.
+
+2004-05-11 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-events-buffer): Disable outline-mode by default.
+ (slime-inhibit-ouline-mode-in-events-buffer): New variable.
+ (slime-expected-failures): Reduce the number for SBCL.
+
+ * swank-sbcl.lisp (resolve-note-location): Resolve the location if
+ we are called by swank-compile-string. The pathname argument is
+ never :stream in SBCL, so the method written for CMUCL was never
+ called.
+
+2004-05-10 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (from-string): Bind *READ-SUPPRESS* to NIL.
+ (swank-compiler): Bind a restart to abort compilation but still
+ report the compiler messages already trapped.
+ (string-to-package-designator): Function that uses READ to
+ case-convert package names.
+ (apropos-list-for-emacs): Use it.
+
+ * slime.el (slime-eval-with-transcript): Don't print the "=>"
+ prefix in messages showing evaluation results. It mucks up
+ alignment in multi-line messages.
+ (sldb-eval-in-frame): Don't print "==>" prefix on evaluation
+ results, for the same reason.
+ (slime-show-source-location): Move the point to the source
+ location in addition to highlighting the matching parens.
+
+2004-05-08 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (find-definitions): Add support for variables
+ and constants.
+
+2004-05-07 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-clisp.lisp (compiler-note-location): Use make-location to
+ instead of `(:location ...). This initializes the new hint slot
+ automatically.
+
+2004-05-07 Barry Fishman <barry_fishman(a)att.net>
+
+ * swank.lisp (prin1-to-string-for-emacs, arglist-to-string): CVS
+ CLISP prints NIL as |COMMON-LISP|::|NIL| if *print-readably* is
+ true. Set *print-readably* to nil for a more Emacs friendly
+ printer syntax.
+
+2004-05-06 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-maybe-list-compiler-notes): Display the notes
+ listing after C-c C-c only if there are no annotations in the
+ buffer. CMUCL creates usually one warning with an error location
+ and an almost redundant warning without at the end of the
+ compilation unit. Don't display the listing in this common case.
+
+ (slime-reindent-defun): Pass nil as the third arument to
+ indent-region.
+
+2004-05-06 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-repl-sayoonara): Don't attempt to quit the lisp
+ if we're not connected.
+
+ * swank-openmcl.lisp (*buffer-offset*, *buffer-name*): Supply
+ default values. This avoids unbound value errors when compiling an
+ asdf system signals errors.
+
+2004-05-04 Alan Shutko <ats(a)acm.org>
+
+ * slime.el (slime-compiler-notes-show-details/mouse): New command.
+ (slime-compiler-notes-mode-map): Use it.
+
+2004-05-04 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (arglist): Handle byte-code functions better.
+ We don't know much about the actual argument list, only the number
+ of arguments. Return at least something mildly interesting like
+ (arg0 arg1 &optional arg2 ...)
+ (function-location): Special-case byte-code functions.
+
+ * swank-backend.lisp (with-struct): New macro.
+
+2004-05-04 Thomas F. Burdick <tfb(a)OCF.Berkeley.EDU>
+
+ * slime.el (slime-reindent-defun): New command on C-M-q. Reindent
+ the current Lisp defun after trying to close any unmatched
+ parenthesis. If used within a comment it just calls fill-paragraph.
+
+2004-05-04 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-goto-location-position): Regexp fix.
+ (slime-reindent-defun): New command on M-q. Reindent the current
+ Lisp defun after trying to close any unmatched parenthesis.
+
+ * swank.lisp: Remove (declaim (optimize ...)). The side-effect
+ this has on people's environment seems harmful (I saw someone
+ having trouble on the OpenMCL list).
+
+ * swank-cmucl.lisp (source-location-from-code-location): Fixed a
+ bug where the source-file-cache was not really used.
+ Now always report the location based on source file (cached or
+ not) even if modified -- not falling back on regexps, which was
+ probably a misfeature.
+
+ * slime.el: Remove `slime-cleanup-definition-refs'.
+
+2004-05-02 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-start-and-load): New command. Suggested by
+ Lars Magne Ingebrigtsen.
+
+2004-05-02 Lars Magne Ingebrigtsen <larsi(a)netfonds.no>
+
+ * slime.el (slime-kill-without-query-p): New variable.
+ (slime-net-connect): Use it.
+ (slime-open-stream-to-lisp): Ditto.
+ (slime-maybe-start-lisp): Ditto.
+
+2004-05-02 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-goto-source-location): Added support for the
+ :snippet "hint" in a location specifier. If Lisp sends the
+ (initial) source text for the definition then Emacs isearches for
+ it in both directions from the given character position. This
+ makes M-. robust when the Emacs buffer has been edited. Requires
+ backends to provide this snippet information.
+ (slime-goto-location-position): Tightened up the regular
+ expressions for :function-name style location search.
+ (slime-cleanup-definition-refs): New function to do a little
+ post-processing on definition references from Lisp. Mostly this is
+ a hack: if POSITION is NIL then we fill it in with the function
+ name, ready for regexp search. I was in a hurry and it was easier
+ to do here, and it doesn't seem entirely unreasonable.
+
+ * swank-backend.lisp (:location): Added a 'hints' property list
+ to the location structure. This is for extra information that
+ compliments the buffer/position.
+
+ * swank-cmucl.lisp (code-location-stream-position): Position the
+ argument stream at the definition before returning.
+ (source-location-from-code-location): Include the :snippet hint
+ for Emacs (see above). The snippet will only be accurate provided
+ that the source file on disk has not been modified.
+ (*source-file-cache*) The contents of all source files consulted
+ for M-. are now cached if they match the version of the running
+ code. This is so that we can accurately lookup source locations
+ even when the file is modified, provided we manage to get the
+ right version (by file timestamp) at least once.
+ (source-location-from-code-location): If the right source version
+ is not available on disk or in our cache then let Emacs fall back
+ on a regular expression search.
+
+2004-05-01 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-lispworks.lisp (find-top-frame): New function used to hide
+ debugger-internal frames.
+ (call-with-debugging-environment): Use it.
+
+2004-05-01 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (sldb-abort): Print a message if the Emacs RPC
+ returns. It shouldn't, if ABORT manages to unwind the stack, but
+ it currently does in OpenMCL due to some bug.
+ (slime-edit-definition-fallback-function): Name of a function to
+ try if the builtin edit-definition finding fails. You can set
+ this to `find-tag' to fall back on TAGS.
+
+ * swank.lisp (list-all-systems-in-central-registry): Use explicit
+ :wild in pathname for matching (needed in at least SBCL).
+
+ * swank-openmcl.lisp: Removed obsolete `swank-compile-system'.
+
+ * swank-sbcl.lisp: Removed obsolete `swank-compile-system'.
+ Removed some stale comments about supported features.
+
+2004-04-30 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-repl-update-banner): Don't print the working
+ directory. It rarely fits in a line and was only Emacs'
+ default-directory. M-x pwd is convenient enough.
+
+ * swank.lisp (symbol-indentation): Don't infer indentation for
+ symbols starting with 'def' or 'with-'. It was wrong most of the
+ time and Emacs' defaults are better.
+
+ * swank-lispworks.lisp (emacs-connected): Add methods to
+ stream-soft-force-output for socket-streams and
+ slime-output-streams. This flushes those streams automatically
+ (i assume it gets called when Lisp is idle).
+
+2004-04-29 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-repl-mode): Set slime-current-thread to
+ :repl-thread.
+
+ * swank.lisp (thread-for-evaluation, dispatch-event): Accept
+ :repl-thread as thread specifier and dispatch evaluation and
+ interrupt request properly.
+ (repl-thread-eval, repl-eval): Deleted. We do the special casing in
+ thread-for-evaluation.
+
+2004-04-29 Lars Magne Ingebrigtsen <larsi(a)netfonds.no>
+
+ * slime.el (slime-event-buffer-name): New variable.
+ (slime-events-buffer): Use it.
+ (slime-space-information-p): Ditto.
+ (slime-space): Use it.
+ (slime-reply-update-banner-p): Ditto.
+ (slime-repl-update-banner): Use it.
+
+2004-04-28 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-loader.lisp (*lisp-name*): Add versioning support for
+ CLISP.
+
+ * swank-clisp.lisp (arglist): Trap exceptions and return
+ :not-available in that case.
+
+ * swank.lisp (arglist-for-insertion): Don't use ~< ..~:@>.
+ CLISP's pretty printer can't handle it.
+
+2004-04-28 Luke Gorrie <luke(a)bluetail.com>
+
+ * NEWS: Created a NEWS file for recording changes that we want
+ users to read about.
+
+ * slime.el (slime-log-event): Use outline-minor-mode in
+ *slime-events* instead of hideshow-mode. It's more
+ reliable. (Patch from Lawrence Mitchell.)
+
+2004-04-28 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-net-connect): Bind inhibit-quit to nil, so that
+ we have a chance to interrupt Emacs if open-network-stream blocks.
+ (slime-complete-maybe-restore-window-configuration): Keep trying
+ after slime-repl-indent-and-complete-symbol.
+ (slime-space): Don't close the completion buffer. We don't know
+ the window-config before the completion, so leave the buffer open.
+
+ * swank.lisp (create-server): New keyword based variant to start
+ the server in background.
+ (setup-server): Add support to keep the socket open for
+ single-threaded Lisps.
+
+2004-04-27 Luke Gorrie <luke(a)bluetail.com>
+
+ * doc/slime.texi (Other configurables): Updated instructions on
+ globally installing SLDB on *debugger-hook*.
+
+ * slime.el (slime-log-event): Better bug-avoidance with
+ hs-minor-mode. Hopefully XEmacs users can rest safely now.
+ (slime-prin1-to-string): Bind `print-escape-newlines' to nil.
+ (slime-set-connection-info): Commented out call to
+ `slime-check-protocol-version'. Let's see how we do without it.
+ (slime-oneway-eval): Removed unused function.
+
+ * swank.lisp (oneway-eval-string): Removed unused function.
+
+2004-04-26 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp: Move definition of `with-io-redirection' above
+ `with-connection' to avoid a CLISP error. This is really weird.
+ (interactive-eval): Bind *package* to *buffer-package*, so that
+ `C-x C-e' and related commands evaluate in the expected package.
+
+ * slime.el (sldb-insert-frames): Handle empty backtrace (I got one
+ in CLISP).
+
+ * swank-allegro.lisp (arglist): Return :not-available if arglist
+ lookup fails with an error.
+
+ * slime.el: Moved snippets of Common Lisp code into swank.lisp
+ from the thread control panel. (Remember, no CL code in slime.el!)
+
+ * swank-loader.lisp (*lisp-name*): Include a short version number
+ in the Lisp name to separate FASL files for different
+ versions. Only implemented for CMUCL and SBCL sofar.
+
+ * swank.lisp (ed-in-emacs): Avoid mutating the argument.
+ (spawn-repl-thread): Add a new thread for evaluating REPL
+ expressions. This same thread is used for all REPL
+ evaluation. This fixes some issues with variables like * and **
+ in at least SBCL.
+
+ * nregex.lisp: Typo fix (thanks Barry Fishman).
+
+ * slime.el (slime-events-buffer): Don't use hideshow-mode in
+ XEmacs for the *slime-events* buffer. It causes obscure problems
+ for some users. Still used in GNU Emacs.
+
+2004-04-25 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-backend.lisp (arglist): Return a list or :not-available.
+ Don't return strings or raise exceptions.
+
+ * swank.lisp (arglist-for-echo-area): Simplified and adapted for
+ the new semantic of ARGLIST.
+ (arglist-for-insertion): Now a separate function.
+ (read-arglist): Deleted. No longer needed.
+
+ * swank-cmucl.lisp, swank-lispworks.lisp (arglist): Return
+ :not-available if the arglist cannot be determined.
+
+ * slime.el (slime-set-connection-info): Hide the *inferior-lisp*
+ buffer here, so that we have all the buffer rearrangement in one
+ place.
+ (slime-insert-arglist): Use swank:arglist-for-insertion.
+
+2004-04-24 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-init-connection-state): Use an asynchronous RPC
+ instead of slime-eval to reduce the amount of work we do in the
+ timer function. We can remove the workaround for the timer
+ problem.
+
+2004-04-23 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el: Updated top comments.
+ Make SLIME faces inherit from their font-lock cousins properly.
+ (slime-connect): Bind `slime-dispatching-connection' to avoid
+ being confused by old buffer-local variables when initializing
+ the connection. This fixes a bug where doing `M-x slime' from the
+ REPL could give a "Not connected" error.
+
+2004-04-22 Edi Weitz <edi(a)agharta.de>
+
+ * slime.el (slime-read-system-name): Perform completion on all
+ systems in the central registry.
+
+ * swank.lisp (list-all-systems-in-central-registry): New function.
+
+2004-04-22 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-repl-update-banner): Add workaround to force the
+ proper behavior of the the first command in the REPL buffer.
+ (slime-repl-shortcut-history): Define the variable to make XEmacs
+ happy.
+
+2004-04-22 Tiago Maduro-Dias <tcmd(a)rnl.ist.utl.pt>
+
+ * slime.el (slime-space): Cleanup.
+ (slime-complete-restore-window-configuration): Use
+ slime-close-buffer instead of bury-buffer.
+
+2004-04-21 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Suppress byte-compiler warnings by binding
+ byte-compiler-warnings to nil.
+ (slime-repl-shortcut): Use a structure instead of a list for the
+ short cut info. Update the users accordingly.
+
+ * swank-cmucl.lisp (arglist): Return a list instead of the string.
+
+2004-04-21 Edi Weitz <edi(a)agharta.de>
+
+ * slime.el (slime-apropos): Add support for regexp-based apropos.
+ We use nregex, so the regexp syntax is different from Emacs'
+ regexps and bit restricted (alternation '|' and optional groups
+ '(xy)?' are not implemented).
+ (slime-insert-arglist): New command - stolen from ILISP. I always
+ thought this was quite useful.
+ (slime-oos): Fix typo.
+
+ * swank.lisp (apropos-symbols): Use regexp and support
+ case-sensitive matching.
+ (arglist-for-echo-area): New argument to control if the operator
+ name should be included.
+
+ * nregex.lisp: New file.
+
+ * swank-loader.lisp (*sysdep-pathnames*): Load it.
+
+2004-04-21 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * doc/slime.texi (Compilation): slime-remove-notes is bound to C-c
+ M-c not M-c. Noted by Edi Weitz.
+
+2004-04-21 Edi Weitz <edi(a)agharta.de>
+
+ * swank.lisp (list-all-package-names): Optionally include
+ nicknames in the result.
+
+ * slime.el (slime-read-package-name): Include nicknames in the
+ completions set.
+ (slime-repl-mode-map): Bind C-c : to slime-interactive-eval just
+ like in most other SLIME buffers.
+ (read-directory-name): Compatibilty defun.
+
+2004-04-20 Tiago Maduro-Dias <tcmd(a)rnl.ist.utl.pt>
+
+ * slime.el (slime-close-buffer): New utility function.
+ (slime-space): Use it to kill superfluous *Completions* buffers.
+
+2004-04-17 Raymond Toy <rtoy(a)earthlink.net>
+
+ * swank-cmucl.lisp (source-location-tlf-number)
+ (source-location-form-number): New functions to extract the
+ encoded form-numbers from source locations.
+ (resolve-stream-source-location, resolve-file-source-location):
+ Use them.
+
+2004-04-17 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-merge-notes): Use mapconcat instead of
+ (concat (slime-intersperse (mapcar ....)))
+ (slime-intersperse): Handle empty lists.
+
+2004-04-16 Luke Gorrie <luke(a)bluetail.com>
+
+ * doc/Makefile: Added 'install' and 'uninstall' targets for the
+ Info manual. It may be necessary to tweak `infodir' in the
+ Makefile to suit the local system before installing. (Patch from
+ from Richard M Kreuter.)
+
+ * doc/slime.texi (Top): The Top node is now smaller, with details
+ moved into Introduction. This makes the Info front page easier to
+ navigate. (Patch from Richard M Kreuter.)
+
+2004-04-15 Ivan Boldyrev <email@secret-by-request>
+
+ * slime.el (slime-handle-repl-shortcut): Call `completing-read'
+ with an alist as expected, using `slime-bogus-completion-alist'.
+
+2004-04-14 Luke Gorrie <luke(a)bluetail.com>
+
+ * doc/slime.texi (Shortcuts): Described REPL shortcuts.
+
+ * slime.el (slime-oos): Generic ASDF interface.
+ (force-compile-system, compile-system, load-system,
+ force-load-system): New REPL commands.
+
+ * swank-backend.lisp (operate-on-system): More generic interface
+ to ASDF.
+
+ * swank.lisp (operate-on-system-for-emacs): More generic
+ interface to ASDF.
+
+ * slime.el (slime-repl-mode-map): Portability fix for definition
+ of the REPL command character.
+ (slime-maybe-rearrange-inferior-lisp): Bugfix for running
+ multiple inferior lisps.
+
+2004-04-13 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-handle-repl-shortcut,
+ slime-list-all-repl-shortcuts, slime-lookup-shortcut,
+ defslime-repl-shortcut): Refactor repl shortcut code to provide a
+ more leggible help.
+
+2004-04-09 Lawrence Mitchell <wence(a)gmx.li>
+
+ * slime.el (slime-same-line-p): Use `line-end-position', rather
+ than searching for a newline manually.
+ (slime-repl-defparameter): Use VALUE, not VALUE-FORM.
+
+2004-04-08 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-repl-package-stack): New buffer local variable.
+ (slime-repl-directory-stack): New buffer local variable.
+ (slime-repl-command-input-complete-p): Remove.
+ (slime-repl-update-banner): New function.
+ (slime-init-output-buffer): Use slime-repl-update-banner.
+ (slime-repl-shortcut-dispatch-char): New variable.
+ (slime-repl-return): Don't check for repl commands anymore.
+ (slime-repl-send-repl-command): Remove.
+ (slime-repl-mode-map): Bind slime-repl-shortcut-dispatch-char to
+ slime-handle-repl-shortcut.
+ (slime-set-default-directory): Use read-directory-name, call
+ slime-repl-update-banner.
+ (slime-repl-shortcut-table): New global variable.
+ (slime-handle-repl-shortcut): New function.
+ (defslime-repl-shortcut): New macro for defining repl shortcuts.
+ (slime-repl-shortcut-help, "change-directory",
+ slime-repl-push-directory, slime-repl-pop-directory,
+ "change-package", slime-repl-push-package, slime-repl-pop-package,
+ slime-repl-resend, slime-repl-sayoonara, slime-repl-defparameter,
+ slime-repl-compile-and-load): New repl shortcuts.
+ (slime-kill-all-buffers): Kill sldb buffers as well.
+
+ * swank.lisp: Remove the repl related functions.
+ (requires-compile-p): New function.
+
+2004-04-07 Lawrence Mitchell <wence(a)gmx.li>
+
+ * slime.el (slime-repl-prompt-face): New face.
+ (slime-repl-insert-prompt): Use it.
+ (slime-with-chosen-connection, with-struct): Docstring
+ fix for function's arglist display.
+ (when-let, slime-with-chosen-connection, with-struct): Docstring
+ fix for function's arglist display.
+ (slime-read-package-name): Use `slime-bogus-completion-alist' to
+ construct completion table.
+ (slime-maybe-rearrange-inferior-lisp): Use `rename-buffer's
+ optional argument to rename uniquely.
+ (slime-check-connected): Display keybinding for `slime' via
+ `substitute-command-keys'.
+ (slime-repl-send-repl-command): Use whitespace character class in
+ regexp.
+ (slime-autodoc-stop-timer): New function.
+ (slime-autodoc-mode): Add `interactive' spec to specify optional
+ arg. This allows prefix toggling of mode (behaves more like
+ most Emacs modes now). Stop timer if switching mode off with
+ `slime-autodoc-stop-timer'.
+ (slime-autodoc-start-timer, slime-complete-symbol)
+ (slime-complete-saved-window-configuration)
+ (slime-insert-balanced-comments): Docstring fix.
+ (slime-ed): Call `slime-from-lisp-filename' on filename for list
+ case of argument.
+ (slime-insert-transcript-delimiter, slime-thread-insert): Use
+ ?\040 to indicate SPC.
+ (line-beginning-position): `forward-line' always puts us in
+ column 0.
+ (line-end-position): Define if not fboundp (for older XEmacs).
+
+2004-04-07 Peter Seibel <peter(a)javamonkey.com>
+
+ * swank-allegro.lisp (set-default-directory): Allegro specific
+ version that also uses excl:chdir.
+
+ * swank.lisp (swank-pprint): Add swank versions of two missing
+ pretty-printer control variables.
+
+2004-04-07 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (completion-set): Also complete package
+ names. (Patch from Sean O'Rourke.)
+ (find-matching-packages): Add a ":" to the end of package names
+ in completion.
+
+2004-04-06 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-bytecode-stale-p): Automatically check if
+ slime.elc is older than slime.el and try to help the user out if
+ so.
+
+2004-04-06 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-repl-command-input-complete-p): New function.
+ (slime-repl-send-string): New optional arg specifying what string
+ to put on slime-repl-input-history, usefull when this string
+ differs from what we actually want to eval.
+ (slime-repl-return): Check for repl commands and pass then to
+ slime-repl-send-repl-command.
+ (slime-repl-send-repl-command): New function.
+ (slime-kill-all-buffers): New function.
+
+ * swank.lisp: Define the various repl command handlers: sayoonara,
+ cd, pwd, pack and cload.
+
+ * swank-backend.lisp (quit-lisp): Define as part of the backend
+ interface and export.
+
+ * swank-sbcl.lisp, swank-openmcl.lisp, swank-cmucl.lisp,
+ swank-clisp.lisp, swank-allegro.lisp (quit-lisp): implement.
+
+2004-04-06 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (macro-indentation): Check that the arglist is
+ well-formed. This works around a problem with ACL returning
+ arglists that aren't real lambda-lists.
+
+2004-04-05 Lawrence Mitchell <wence(a)gmx.li>
+
+ * swank.lisp (*swank-pprint-circle*, *swank-pprint-escape*)
+ (*swank-pprint-level*, *swank-pprint-length*): Fix typo in
+ docstring.
+
+ * slime.el (slime-arglist): Don't `message' arglist directly, in
+ case it contains %-signs.
+ (slime-repl-output-face): Fix quoting.
+ (slime-symbol-at-point): Call `slime-symbol-name-at-point',
+ rather than ourselves.
+ (slime-check-protocol-version): Docstring fix.
+
+2004-04-05 Luke Gorrie <luke(a)bluetail.com>
+
+ * doc/slime.texi (Semantic indentation): Documented new
+ automatically-learn-how-to-indent-macros feature.
+ Added auto version control header in subtitle.
+
+ * slime.el (slime-close-parens-at-point): New command bound to
+ C-a C-a. Inserts close-parenthesis characters at point until the
+ top-level form becomes well formed. Could perhaps be made fancier.
+ (slime-update-indentation): New command to update indentation
+ information (`common-lisp-indent-function' properties) based on
+ macro information extracted from Lisp. This happens
+ automatically, the command is just to force a full rescan.
+
+ * swank.lisp (connection): Added slots to track indentation caching.
+ (*connections*): List of all open connections.
+ (default-connection): Function to get a "default"
+ connection. This is intended to support globally using the
+ debugger hook outside the context of a SLIME request, which is
+ broken at present.
+ (with-connection): Don't setup a restart: that must be done
+ separately.
+ (sync-state-to-emacs): Call `update-connection-indentation'.
+ (update-connection-indentation): Automatically discover how to
+ indent macros and tell Emacs.
+
+ * swank-backend.lisp (arglist): Specify that strings returned
+ from ARGLIST should be READable.
+
+2004-04-02 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-maybe-list-compiler-notes): Display the notes
+ for C-c C-c, when there are notes without a good source-location.
+
+2004-04-01 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-sbcl.lisp: Remove the non-working workarounds for
+ non-existent fcntl. Reported by Brian Mastenbrook.
+ (preferred-communication-style): Use multithreading if futexes are
+ available, sigio if fcntl is present, and fd-handlers otherwise.
+ (resolve-note-location): Don't try to construct a source-location
+ if there's no context. Notes without location will be displayed
+ in the note-listing buffer.
+
+2004-04-01 Bill Clementson <Bill_Clementson(a)peoplesoft.com>
+
+ * swank-allegro.lisp (send): Fix misplaced parens.
+
+2004-03-31 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (debug-function-arglist): Return symbols if
+ possible.
+ (class-location): Support for experimental source-location
+ recording.
+
+2004-03-30 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-repl-result-face): New face.
+ (slime-inspector-mode-map): Add a binding for M-.
+ (compile-defun): Add test case for escaped double quotes inside a
+ string.
+
+ * swank.lisp (ed-in-emacs): New allowed form for argument.
+ (pprint-eval-string-in-frame): Apply arguments in proper order.
+
+ * swank-cmucl.lisp (method-dspec): Include method-qualifiers.
+ (class-definitions): Renamed from struct-definitions. Try to
+ locate condition-classes and PCL classes (in the future).
+ (debug-function-arglist): Insert &optional, &key, &rest in the
+ right places.
+ (form-number-stream-position): Make it a separate function.
+
+2004-03-29 Lawrence Mitchell <wence(a)gmx.li>
+
+ * swank.lisp (ed-in-emacs): New allowed form for argument.
+
+ * slime.el (slime-ed): Deal with list form of argument. For a
+ list (FILENAME LINE [COLUMN]), visit the correct line and column
+ number.
+
+2004-03-29 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-source-path-parser.lisp (cmucl-style-get-macro-character):
+ New function. Workaround for bug(?) in SBCL.
+ (make-source-recording-readtable): Use it.
+
+2004-03-29 Luke Gorrie <luke(a)bluetail.com>
+
+ * HACKING: Some small updates (more needed).
+
+ * slime.el (slime-inspector-buffer): Enter `slime-inspector-mode'
+ after `slime-mode'. This seems to give priority of keymap to the
+ inspector, so that it can override SPC.
+ (slime-easy-menu): Add slime-switch-to-output-buffer.
+ Enable SLIME menu in the REPL buffer.
+ (slime-symbol-name-at-point): Avoid mistaking the REPL prompt for
+ a symbol.
+ (slime-words-of-encouragement): A few new ones.
+ (slime-insert-xrefs): Removed the final newline from XREF
+ buffers. This helps to avoid unwanted scrolling.
+
+ * doc/slime.texi: Added a section about user-interface
+ conventions and our relationship with inf-lisp.
+
+2004-03-27 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-changelog-date): Reinitialize it at load-time.
+ This avoids the need to restart Emacs (horror!) after an update.
+
+ * swank-cmucl.lisp (debug-function-arglist): Properly reconstruct
+ the arglist from the debug-info. (Not complete yet.)
+ (arglist): Use it.
+
+ * swank-lispworks.lisp (spawn): Remove CL symbols from
+ mp:*process-initial-bindings*, to avoid the irritating behavior
+ for requests executed in different threads. E.g., when someone
+ tries to set *package*.
+
+ * swank.lisp (*log-io*): New variable. Bind it to *terminal-io*
+ at load-time, so we can log to a non-redirected stream.
+ (disassemble-symbol): Allow generalized function names.
+ (apropos-symbols): Handle the PACKAGE argument properly to get
+ useful output for C-c P.
+
+ * slime.el (slime-repl-indent-and-complete-symbol): New command.
+ Bound to TAB in the REPL mode. First try to indent the current
+ line then try to complete the symbol at point.
+ (slime-dispatch-event): Ignore a unused thread variable to keep
+ XEmacs' byte compiler quiet.
+
+ * swank-sbcl.lisp (enable-sigio-on-fd): Use sb-posix::fcntl
+ instead of sb-posix:fcntl to avoid the ugly reader hack. SBCL
+ doesn't have package locks and even if they add locks in the
+ future sb-posix::fcntl will still be valid.
+ (getpid): Use defimplementation instead of defmethod.
+ (function-definitions): Take generalized function names ala '(setf
+ car)' as argument.
+
+2004-03-26 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-group-similar): Bugfix: return NIL if the input
+ list is NIL.
+ (slime-inspector-buffer): Enter `slime-inspector-mode' after
+ `slime-mode'. This seems to give priority of keymap to the
+ inspector, so that it can override SPC.
+
+2004-03-26 Bj�rn Nordb� <bn(a)telenor.net>
+
+ * swank.lisp (print-arglist): Updated to handle arglists with
+ string elements, causing arglists for macros to display properly
+ in LW 4.1.
+
+2004-03-26 Marco Baringer <mb(a)bese.it>
+
+ * swank-cmucl.lisp (set-default-directory): Define only once;
+ define with defimplementation, not defun.
+
+2004-03-26 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-merge-notes-for-display): New function to merge
+ together compiler notes that refer to the same location. This is
+ an optimization for when there are a lot of compiler notes:
+ `slime-merge-note-into-overlay' concat'd messages together one by
+ one in O(n^2) time/space, and became noticeably slow in practice
+ with ~100 notes or more.
+ (slime-tree-insert): This function is now automatically
+ byte-compiled (good speed gain).
+ Wrap byte-compilation in `save-window-excursion' to avoid showing
+ an unwanted warnings buffer (in XEmacs).
+
+2004-03-25 Bj�rn Nordb� <bn(a)telenor.net>
+
+ * swank-lispworks.lisp: (create-socket, set-sigint-handler)
+ (who-references, who-binds, who-sets): Add backward compatibility
+ for LW 4.1.
+ (dspec-buffer-position): Fix inappropriate use of etypecase.
+
+2004-03-24 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-sbcl.lisp (getpid): Use sb-posix:getpid.
+
+ * slime.el (slime-inspector-mode-map): Added SPC as extra binding
+ for slime-inspector-next (like info-mode).
+
+ * doc/slime.texi: Added completion style and configuration.
+
+2004-03-23 Alan Shutko <ats(a)acm.org>
+
+ * swank-clisp.lisp (set-default-directory): New function.
+
+2004-03-23 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-allegro.lisp (send): Wait a bit if there are already many
+ message in the mailbox.
+
+ * swank-clisp.lisp (xref-results): Use fspec-location instead of
+ the of fspec-source-locations. Reported by Alan Shutko.
+ (break): Be friendly to case-inverting readtables.
+
+ * swank-lispworks.lisp (emacs-connected): Add default method to
+ environment-display-notifier. Reported by Bj�rn Nordb�.
+ (set-default-directory, who-specializes): Implemented for
+ Lispworks.
+ (gfp): New function.
+ (describe-symbol-for-emacs, describe-definition): Distinguish
+ between ordinary and generic functions.
+ (call-with-debugging-environment): Unwind a few frames. Looks
+ better and avoids the problems with the real topframe.
+ (interesting-frame-p): Use Lispworks dbg:*print-xxx* variables to
+ decide which frames are interesting.
+ (frame-actual-args): New function.
+ (print-frame): Use it.
+
+ * swank.lisp (open-streams, make-output-function): Capture the
+ connection not only the socket. This way the streams can be used
+ from unrelated threads. Reported by Alain Picard.
+ (create-connection): Factorized. Initialize the streams after the
+ connection is created.
+ (initialize-streams-for-connection, spawn-threads-for-connection):
+ New functions.
+ (with-connection): Fix quoting bug and move upwards before first
+ use.
+ (guess-package-from-string): Add kludge for SBCL !-package names.
+ (apropos-list-for-emacs): Lispworks apparently returns duplicates;
+ remove them.
+ (inspect-object): Princ the label to allow strings and symbols.
+ (send-output-to-emacs): Deleted.
+ (defslimefun-unimplemented): Deleted. Was unused.
+
+ * slime.el (slime-easy-menu): Add some more commands.
+ (slime-changelog-date): New variable. Initialized with the value
+ returned by the function of the same name. This detects
+ incompatible versions if Emacs has not been restarted after an
+ upgrade.
+ (slime-check-protocol-version, slime-init-output-buffer): Use it.
+ (slime-events-buffer, slime-log-event): Use fundamental mode
+ instead of lisp-mode to avoid excessive font-locking for messages
+ with lots of strings.
+
+2004-03-22 Luke Gorrie <luke(a)bluetail.com>
+
+ * doc/slime.texi: New user manual.
+
+ * swank.lisp (*communication-style*): New name for
+ *swank-in-background*.
+ Exported configuration variables: *communication-style*,
+ *log-events*, *use-dedicated-output-stream*.
+
+2004-03-20 Julian Stecklina <der_julian(a)web.de>
+
+ * swank-sbcl.lisp (+o_async+, +f_setown+, +f_setfl+): Add correct
+ constants for FreeBSD.
+
+2004-03-19 Alan Shutko <ats(a)acm.org>
+
+ * swank.lisp, swank-loader.lisp: Take into account
+ `pathname-device' when deriving paths. A fix for Windows.
+
+2004-03-19 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-connected-hook): New hook called each time SLIME
+ successfully connects to Lisp. This is handy for calling
+ `slime-ensure-typeout-frame', if you want to use that feature.
+ (sldb-print-condition): New command to print the SLDB condition
+ description into the REPL, for reference after SLDB exits. Can be
+ called from `sldb-hook' if you want the condition to always be
+ printed. Bound to 'P' in SLDB.
+
+2004-03-18 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp (format-values-for-echo-area): Bind *package* to
+ *buffer-package*.
+ (load-system-for-emacs): Renamed from swank-load-system.
+ (carefully-find-package): Be friendly to case inverting
+ readtables.
+ (inspect-current-condition): New function.
+
+ * swank-backend.lisp, swank-cmucl.lisp (set-default-directory):
+ New backend function.
+
+ * swank-allegro.lisp, swank-clisp.lisp, swank-lispworks.lisp,
+ swank-sbcl.lisp (swank-compile-string): Be friendly to
+ case-inverting readtables.
+
+ * slime.el (sldb-inspect-condition): Use
+ swank:inspect-current-condition.
+ (slime-inspector-label-face): Make it bold by default.
+ (slime-check-protocol-version, slime-process-available-input):
+ Wait 2 secs after displaying the error message.
+ (sldb-list-catch-tags, sldb-show-frame-details): Display catch
+ tags as symbols not as strings.
+
+2004-03-16 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-dispatch-event, slime-rex): Pass a form instead
+ of a string with :emacs-rex.
+ (slime-connection-name): New connection variable. Use it in
+ various places instead of slime-lisp-implementation-type-name.
+
+ * swank.lisp: Better symbol completion for case-inverting
+ readtables. (Thanks Thomas F. Burdick for suggestions.)
+ (output-case-converter): New function.
+ (find-matching-symbols): Case convert the symbol-name before
+ comparing.
+ (compound-prefix-match, prefix-match-p): Use char= instead of
+ char-equal.
+ (case-convert-input): Renamed from case-convert.
+ (eval-for-emacs): Renamed from eval-string. Take a form instead
+ of a string.
+ (dispatch-event, read-from-socket-io): Update callers.
+ (eval-region, interactive-eval): Use fresh-line to reset the column.
+
+2004-03-13 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-space): Send a list of the operator names
+ surrounding point to Lisp. Lisp can use the list to select the
+ most suitable arglist for the echo area. Suggested by Christophe
+ Rhodes and Ivan Boldyrev.
+ (slime-enclosing-operator-names): New function.
+
+ * swank.lisp (arglist-for-echo-area): Renamed from arglist-string.
+ (format-arglist-for-echo-area, arglist-to-string): New functions.
+
+2004-03-12 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-backend.lisp (find-definitions): Fix docstring.
+
+ * slime.el (slime-dispatch-event): Re-enable :ed command.
+ (sldb-return-from-frame): Send swank:sldb-return-from-frame.
+
+ * swank-cmucl.lisp (find-definitions): Allow names like (setf car).
+
+ * swank.lisp (sldb-return-from-frame): Convert the string to a
+ sexp.
+ (dispatch-event, send-to-socket-io): Allow %apply events.
+ (safe-condition-message): Bind *pretty-print* to t.
+ (set-default-directory): Use the truename.
+ (find-definitions-for-emacs): Allow names like (setf car).
+
+2004-03-12 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * swank.lisp (:swank): Export startup-multiprocessing,
+ restart-frame, return-from-frame.
+ What about kill-thread and interrupt-thread, which are accessed
+ as internal symbols?
+
+2004-03-10 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (struct-definitions, find-dd)
+ (type-definitions, function-info-definitions)
+ (source-transform-definitions, setf-definitions): New funtions.
+ (find-definitions): Include struct definitions, deftypes, setf
+ defintions, compiler-macros and compiler transforms.
+
+2004-03-10 Andras Simon <andras(a)renyi.hu>
+
+ * swank.lisp (print-arglist): Use with-standard-io-syntax.
+
+2004-03-10 Pawel Ostrowski <pasza(a)zodiac.mimuw.edu.pl>
+
+ * swank-cmucl.lisp (unprofile-all): (eval '(profile:unprofile))
+ instead of just calling it since it is a macro in cmucl.
+
+ * swank.lisp (:swank): export profile symbols (profiled-functions,
+ profile-report, profile-reset, unprofile-all, profile-package)
+
+2004-03-10 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-allegro.lisp, swank-lispworks.lisp, swank-sbcl.lisp,
+ swank-clisp.lisp, swank-cmucl.lisp (find-definitions): Some
+ tweaking.
+
+ * swank.lisp (print-arglist): Bind *pretty-circle* to nil to avoid
+ output like "(function . (cons))". Suggested by Michael Livshin.
+ (test-print-arglist): Re-enable the tests.
+ (find-definitions-for-emacs): Renamed from
+ find-function-locations.
+
+ * slime.el (slime-edit-definition): Renamed from
+ slime-edit-fdefinition. Display the dspec if there are multiple
+ definitions.
+ (slime-symbol-name-at-point): Handle the case when there is no
+ symbol at point.
+ (slime-expected-failures): New function
+ (slime-execute-tests): Use it.
+
+2004-03-09 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp (frame-source-location-for-emacs): Export it.
+ Reported by Jouni K Seppanen
+ (test-print-arglist): Disable the tests until we know what's wrong
+ with print-arglist. Reported by Michael Livshin.
+
+ * swank-source-path-parser.lisp, swank-gray.lisp (in-package): We
+ are in-package :swank-backend. Thanks to Raymond Wiker.
+
+ Merge package-split branch into main trunk.
+
+ * swank-clisp.lisp (find-fspec-location): Handle "No such file"
+ errors.
+
+ * swank-openmcl.lisp (preferred-communication-style): Implemented.
+ (call-without-interrupts, getpid): Use defimplementation.
+ (arglist, swank-compile-file, swank-compile-string)
+ (swank-compile-system, backtrace): Renamed.
+ (print-frame): New function.
+ (frame-catch-tags): Don't exclude nil source location.
+ (format-restarts-for-emacs, debugger-info-for-emacs,
+ inspect-in-frame). deleted
+ (frame-arguments): Don't use to-string.
+ (find-source-locations, find-function-locations
+ (method-source-location): Deleted.
+ (canonicalize-location, find-definitions,
+ function-source-location, list-callers): Use
+ ccl::edit-definition-p and
+ ccl::get-source-files-with-types&classes. Makes things easier.
+ (return-from-frame): Take a sexp not a string.
+ (describe-definition): Describe more types.
+
+ * swank-loader.lisp: Change load order. swank.lisp is now the last
+ file.
+
+ * swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+ swank-gray.lisp, swank-lispworks.lisp, swank-sbcl.lisp,
+ swank-source-path-parser.lisp: Implement changed backend interface
+ and remove references to frontend symbols.
+
+ * swank-backend.lisp (:swank-backend): New package.
+ (definterface): Export the symbol.
+ (:location, :error, :position, :buffer): Define structure of
+ source locations here.
+ (preferred-communication-style, compute-backtrace, print-frame):
+ New functions.
+ (debugger-info-for-emacs): Deleted.
+
+ Renaming:
+
+ compile-file-for-emacs -> swank-compile-file
+ compile-string-for-emacs -> swank-compile-string
+ compile-system-for-emacs -> swank-compile-stystem
+ arglist-string -> arglist
+ backrace -> compute-backtrace
+ find-function-locations -> find-definitions
+
+ * swank.lisp (:swank): Create the package here.
+ (*swank-in-background*): Call the backend function
+ preferred-communication-style to for the initial value.
+ (find-symbol-designator): Handle NIL properly.
+ (arglist-string): Renamed from format-arglist. Call backend
+ function directly.
+ (*sldb-restarts*, swank-debugger-hook, format-restarts-for-emacs)
+ (nth-restart, invoke-nth-restart, sldb-abort): Handle restarts in
+ the front end.
+ (frame-for-emacs): Renamed from print-with-frame-label.
+ (backtrace, debugger-info-for-emacs, pprint-eval-string-in-frame)
+ (set-default-directory): Now in the front end.
+ (frame-locals-for-emacs): Use print not princ for variable names.
+ (compile-file-for-emacs, compile-string-for-emacs): Small wrappers
+ around backend functions.
+ (describe-definition-for-emacs): Handle unknown symbols before
+ calling the backend.
+ (find-function-locations): Wrapper for new backend function
+ find-definitions.
+ (group-xrefs, partition, location-valid-p, xref-buffer, xref):
+ Updated for the new backend functions.
+
+ * slime.el:
+ (slime-symbol-at-point, slime-symbol-name-at-point):
+ slime-symbol-at-point calls slime-symbol-name-at-point not the
+ other way around. This avoids the mess if the symbol at point is
+ NIL.
+ (slime-compile-file, slime-load-system, slime-compile-region)
+ (slime-call-describer, slime-who-calls, sldb-catch-tags): Updates
+ for renamed lisp functions.
+ (slime-list-callers, slime-list-callees): Unified with other xref
+ commands.
+ (sldb-show-frame-details): Catch tags no longer include the source
+ location.
+ (sldb-insert-locals): Simplified.
+
+2004-03-09 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (read-into-simple-string): Use the correct fix.
+ Reported by H�kon Alstadheim.
+
+2004-03-08 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-start-swank-server, slime-maybe-start-lisp):
+ Translate filenames. Reported by Dan Muller.
+
+2004-03-08 Bill Clementson <Bill_Clementson(a)peoplesoft.com>
+
+ * slime.el (slime-insert-balanced-comments)
+ (slime-remove-balanced-comments, slime-pretty-lambdas): New
+ functions.
+
+2004-03-07 Jouni K Seppanen <jks(a)iki.fi>
+
+ * slime.el (sldb-help-summary): New function.
+ (sldb-mode): Add docstring so that describe-mode is useful.
+ (sldb-mode-map): Add bindings for sldb-help-summary and
+ describe-mode.
+ (define-sldb-invoke-restart-key): Generate docstrings.
+ (sldb-default-action/mouse, sldb-default-action)
+ (sldb-eval-in-frame, sldb-pprint-eval-in-frame)
+ (sldb-inspect-in-frame, sldb-down, sldb-up, sldb-details-up)
+ (sldb-details-down, sldb-list-locals, sldb-quit, sldb-continue)
+ (sldb-abort, sldb-invoke-restart, sldb-break-with-default-debugger)
+ (sldb-step): Add rudimentary docstrings.
+
+2004-03-07 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-complete-symbol*, slime-simple-complete-symbol):
+ Use the correct block name when returning.
+ (slime-display-completion-list): Fix typo.
+
+ * swank-cmucl.lisp (frame-locals): Use #:not-available instead of
+ "<not-available>".
+
+2004-03-05 Bill Clementson <Bill_Clementson(a)peoplesoft.com>
+
+ * swank-lispworks.lisp (getpid, emacs-connected): Conditionalize
+ for Windows.
+
+2004-03-05 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp (frame-locals-for-emacs): Bind *print-readably* to
+ nil.
+
+2004-03-05 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (frame-locals-for-emacs): New function.
+
+ * slime.el (sldb-frame-locals): Use swank::frame-locals-for-emacs
+ not swank::frame-locals.
+ (sldb-insert-locals): use the :value property, not the
+ :value-string property.
+
+ * swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+ swank-lispworks.lisp, swank-sbcl.lisp (frame-locals): Return lisp
+ objects, not strings. Use the :value property and not the
+ :value-string property.
+
+2004-03-04 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-display-comletion-list): New function. Set
+ syntax table properly.
+ (slime-complete-symbol*, slime-simple-complete-symbol): Use it.
+ (slime-update-connection-list): New function.
+ (slime-draw-connection-list): Simplified.
+ (slime-connection-list-mode-map): Bind g to update-connection-list.
+ (slime-open-inspector): Print the primitive type in brackets.
+ (slime-test-arglist): Add test for empty arglist.
+
+ * swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+ swank-lispworks.lisp, swank-sbcl.lisp, swank-backend.lisp
+ (thread-alive-p): Add default implementation.
+ (describe-primitive-type): Add default implementation.
+ (inspected-parts): Implemented for Allegro and CLISP.
+
+ * swank.lisp (remove-dead-threads): New function.
+ (lookup-thread): Use it.
+ (print-arglist): New function. This time without a custom pretty
+ print dispatch table.
+ (format-arglist): Use it.
+ (inspected-parts): Add method for hash-tables.
+
+2004-03-03 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp: Use *emacs-connection*, *active-threads*, and
+ *thread-counter* as thread local dynamic variables.
+ (init-emacs-connection): Don't set *emacs-connection*.
+ (create-connection, dispatch-event): Pass the connection object to
+ newly created threads.
+ (with-connection): New macro
+ (handle-request, install-fd-handler, debug-thread): Use it.
+
+ * swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+ swank-openmcl.lisp, swank-sbcl.lisp (call-with-compilation-hooks):
+ Bind fewer variables. Most of them are already bound in
+ swank.lisp.
+
+ * swank.lisp (setup-server, serve-connection): New dont-close
+ argument to keep the socket open after the first connection.
+ (start-server, create-swank-server): Update callers.
+ Reported by Bill Clementson.
+
+ * swank-cmucl.lisp (resolve-note-location): Don't be too clever,
+ if there is no context available. The compiler notes buffer is
+ probably more adequate in this situation.
+ (compile-file-for-emacs): Use the :load argument to compile-file.
+ (inspect-in-frame): Deleted.
+
+ * slime.el (slime-compilation-finished-hook): Use
+ slime-maybe-list-compiler-notes as default.
+ (slime-maybe-list-compiler-notes): New function.
+ (slime-list-compiler-notes): Insert "[no notes]" if there aren't
+ any. Pop to the buffer.
+ (slime-complete-symbol*, slime-simple-complete-symbol): Set the
+ lisp-mode-syntax-table in the completion buffer.
+ (check-parens): Compatibility function for XEmacs and Emacs 20.
+
+ * swank.lisp (find-completions): Deleted.
+ (simple-completions): Use longest-common-prefix instead of
+ longest-completion.
+ (inspect-in-frame): Moved here from swank-cmucl.lisp.
+
+ * swank-lispworks.lisp (call-with-debugging-environment): Bind
+ *sldb-top-frame*.
+ (nth-frame): Use *sldb-top-frame*.
+ (name-source-location, name-source-locations): Renamed from
+ dspec-source-location, dspec-source-locations. The result now
+ includes methods for generic functions.
+ (eval-in-frame, return-from-frame, restart-frame): Implemented.
+ (compile-string-for-emacs): Set dspec::*location* to the buffer
+ location.
+ (signal-undefined-functions, signal-error-data-base)
+ (make-dspec-location): Remove temp-file kludges.
+ (patch-source-locations, replace-source-file): Deleted.
+
+2004-03-01 Marco Baringer <mb(a)bese.it>
+
+ * swank.lisp (format-arglist): deal with nil arglists.
+
+2004-03-01 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-lispworks.lisp (compile-string-for-emacs): Patch the
+ recorded source locations.
+ (replace-source-file, patch-source-locations): New function.
+ (dspec-buffer-position): Handle defgeneric.
+ (make-dspec-location): Handle (patched) emacs-buffer locations.
+ (emacs-buffer-location-p): New function.
+ (describe-primitive-type, inspected-parts): Implemented.
+ (kill-thread): Implemented.
+
+ * swank-sbcl.lisp, swank-cmucl.lisp, swank-allegro.lisp
+ (kill-thread): Implemented.
+
+2004-02-29 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-complete-symbol): Make slime-complete-symbol
+ customizable. I don't understand how the ILISP style completion
+ is supposed to work and find it unintuitive.
+ (slime-complete-symbol-function): New variable.
+ (slime-complete-symbol*): Renamed from slime-complete-symbol.
+ (slime-simple-complete-symbol, slime-simple-completions): New
+ function.
+ (slime-compiler-notes-to-tree): Return a list of trees, not a single
+ tree.
+
+ * swank.lisp (format-arglist): Don't use a custom pprint table.
+ Didn't work with CLISP and the behavior was different in SBCL and
+ Lispworks.
+ (completions): Factorize.
+ (parse-completion-arguments, format-completion-set,
+ (completion-set, find-matching-symbols, find-completions): New
+ functions.
+ (simple-completions): New function.
+ (prefix-match-p) New function.
+
+2004-02-28 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-compilation-finished-hook): New hook variable.
+ (slime-compilation-finished): Call it.
+ (slime-maybe-show-xrefs-for-notes): New function.
+ (slime-make-default-connection): Use the current connection.
+ (slime-connection-at-point): New function.
+ (slime-goto-connection, slime-connection-list-make-default): Use
+ it.
+ (slime-draw-connection-list): Minor cleanups.
+
+ Define selectors for t and c for thread and connection list.
+
+ * swank.lisp: (*initial-pprint-dispatch-table*)
+ (*arglist-pprint-dispatch-table*): Workaround for bug in
+ CLISP. Don't supply nil as argument to copy-pprint-dispatch.
+ (print-cons-argument): Insert a space after the car.
+
+2004-02-27 Marco Baringer <mb(a)bese.it>
+
+ * slime.el (slime-read-port-and-connect,
+ slime-read-port-and-connect-to-running-swank): Refactor
+ slime-read-port-and-connect into two functions so that
+ slime-thread-attach can use the logic in
+ slime-read-port-and-connect.
+ (slime-thread-control-mode-map): Added key bindings for
+ slime-thread-kill, slime-thread-attach, slime-thread-debug and
+ slime-list-threads.
+ (slime-thread-kill, slime-thread-attach, slime-thread-debug): New
+ functions.
+
+ * swank-backend.lisp (kill-thread): Added to swank interface.
+
+ * swank-openmcl.lisp (kill-thread): Implement.
+
+ * swank.lisp (start-server): Add optional background argument,
+ defaults to *swank-background*.
+ (lookup-thread-by-id): New function.
+ (debug-thread): New function.
+
+2004-02-26 Peter Seibel <peter(a)javamonkey.com>
+
+ * slime.el (slime-draw-connection-list): Use text-properties to
+ associate the connections each line of the connections list
+ buffer.
+
+2004-02-26 Peter Seibel <peter(a)javamonkey.com>
+
+ * slime.el (slime-list-connections): Make the buffer created by
+ this function do a bit more: Can use it to switch to different
+ connections and change the default.
+
+2004-02-26 Marco Baringer <mb(a)bese.it>
+
+ * swank-openmcl.lisp (ccl::force-break-in-listener): Pass a
+ condition object to invoke-debugger.
+ Patch by Bryan O'Connor <bryan-slime(a)lunch.org>
+
+2004-02-26 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-backend.lisp (:swank): export connection-info.
+
+ * swank-allegro.lisp (lisp-implementation-type-name): Implement
+ it.
+
+ * swank-sbcl.lisp (compile-file-for-emacs): Load the fasl file
+ regardless of f-p.
+
+ * swank.lisp (swank-pprint): Bind *package* to *buffer-package*.
+ Reported by Alan Picard.
+
+ * swank-lispworks.lisp (dspec-buffer-position): Renamed from
+ dspec-buffer-buffer-position. Handle dspecs of the form (defmacro
+ foo). Reported by Alan Picard.
+ (arglist-string): Handle unknown arglists properly.
+
+2004-02-25 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (arglist-string): Delay the call to
+ di::function-debug-function until it is actually needed.
+ (compile-file-for-emacs): Load the fasl file irrespective of
+ COMILE-FILE's third return value.
+
+ * swank.lisp (connection-info): New function.
+ (open-streams): Don't send the :check-protocol-version message. Now
+ handled with CONNECTION-INFO.
+
+ * slime.el (slime-symbol-at-point): Don't skip backwards across
+ whitespace when we are at the first character of a symbol. To
+ handle this case: skip symbol constituents forward before skipping
+ whitespace backwards. Reported by Jan Richter.
+ (slime-connection-close-hook, slime-next-connection)
+ (slime-make-default-connection): Remove extra call to format.
+ (slime-init-connection-state): Use only a single RPC instead of 4.
+
+2004-02-25 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-with-chosen-connection): Bind
+ slime-dispatching-connection and not slime-buffer-connection.
+ slime-buffer-connection is a buffer local variable not a dynamic
+ variable.
+ (slime-find-connection-by-type-name)
+ (slime-read-lisp-implementation-type-name): Were lost during the
+ merge.
+ (sldb-fetch-more-frames): Use (goto-char (point-max)) instead of
+ end-of-buffer.
+
+2004-02-25 Peter Seibel <peter(a)javamonkey.com>
+
+ * slime.el: Various bits of support for maintaining multiple SLIME
+ connections to different Lisp implementations simultaneously.
+
+ * swank-backend.lisp (lisp-implementation-type-name): Add function to
+ return simple name of lisp implementation; used by new
+ multi-connection functionality in slime.el.
+
+2004-02-25 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp (format-arglist): Use a special pprint-dispatch table.
+
+2004-02-22 Lawrence Mitchell <wence(a)gmx.li>
+
+ * swank.lisp (format-arglist): Bind *PRINT-PRETTY* to NIL.
+ (eval-in-emacs): Fix typo in docstring.
+
+ * swank-cmucl.lisp (arglist-string): Bind *PRINT-PRETTY* to NIL.
+
+2004-02-21 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ Add support for SERVE-EVENT based communication.
+
+ * swank-sbcl.lisp (add-sigio-handler, remove-sigio-handlers):
+ Renamed.
+ (add-fd-handler, remove-fd-handlers): Implement interface.
+
+ * swank-cmucl.lisp (fcntl): New function.
+ (add-sigio-handler, remove-sigio-handlers): Renamed.
+ (add-fd-handler, remove-fd-handlers): Implement interface.
+
+ * swank.lisp (create-connection): Add support for fd-handlers.
+ (install-fd-handler, deinstall-fd-handler): New functions.
+
+ * swank-backend.lisp (add-sigio-handler): Renamed from
+ add-input-handler.
+ (remove-sigio-handlers): Renamed from remove-input-handlers.
+ (add-fd-handler, remove-fd-handlers): New interface functions.
+
+ * slime.el (slime-batch-test): Use sit-for instead of
+ accept-process-output, so that we see something when swank gets
+ compiled. May be problematic in real batch mode.
+ (loop-interrupt-continue-interrupt-quit): Wait a second before
+ interrupting. The signal seems to arrive before the evaluation
+ request if don't wait => the endless loop is executed inside the
+ debugger and sldb-quit will not be processed with fd-handlers.
+
+ * swank.lisp (process-available-input): Move auxiliary function to
+ toplevel. Test if the stream is open.
+ (install-sigio-handler): Handle the first request after installing
+ the signal handler.
+
+ * slime.el (slime-keys): Bind C-c C-x t to slime-list-threads and
+ C-c C-x c to slime-list-connections.
+ (slime): Disconnect before reconnecting if the inferior-lisp
+ buffer wasn't renamed.
+ (slime-connect): Use the host argument and not "localhost".
+ (slime-compilation-finished): Undo last change. Switch to the
+ buffer to remove old annotations.
+ (slime-choose-overlay-region): Ignore errors in
+ slime-forward-sexp.
+
+2004-02-18 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime): Just close the connection when called without
+ prefix-argument. Keeping the connection open doesn't make sense.
+ We could ask if the Lisp process should be killed, though.
+ (slime-maybe-close-old-connections): Delete unused function.
+ (slime-start-swank-server): Use comint-send-string instead of
+ comint-proc-query, 'cause I don't like Olin "100%" Shivers' code.
+ (slime-init-output-buffer): Show some animations.
+ (slime-repl-clear-output): Fixed.
+ (slime-compilation-finished): It's not necessary to switch to the
+ original buffer, because the buffer is encoded in the
+ source-locations.
+ (sldb-show-source): Don't raise an error if the source cannot be
+ located. Print a message instead, because errors in
+ process-filters cause a 1 second delay.
+
+ * swank-cmucl.lisp (read-into-simple-string): Workaround for
+ read-sequence bug in 18e.
+
+2004-02-18 Peter Seibel <peter(a)javamonkey.com>
+
+ * swank-loader.lisp: Place the fasl files of different
+ implementations in different directories.
+
+2004-02-18 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-clisp.lisp: Update comments about metering package.
+
+ * metering.lisp: Imported from CLOCC. Suggested by Peter Seibel.
+
+2004-02-17 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp, slime.el (make-compiler-note): Don't send the
+ short-message across the wire if the slot is nil.
+
+ * swank-cmucl.lisp (clear-xref-info): Compare the truenames with
+ equalp instead of the unix-truenames. The old version was very
+ inefficient (clearing the tables with about 1000 entries required
+ serveral seconds).
+ (xref-context-derived-from-p, pathname=): Delete unused functions.
+
+ * swank-clisp.lisp (remove-input-handlers):
+ socket:socket-stream-handle is not available on Windows.
+ Reported by Alan Shutko.
+
+ * slime.el (slime-length>): New function.
+ (slime-compiler-notes-to-tree): Don't collapse if there is only
+ one kind of notes.
+
+2004-02-16 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp (make-compiler-note): Include short-message.
+
+ * swank-sbcl.lisp (signal-compiler-condition): Initialize
+ short-message slot.
+ (long-compiler-message-for-emacs): New function.
+
+ * swank-cmucl.lisp (handle-notification-condition): Don't use the
+ context of the previous message.
+ (signal-compiler-condition): Set short message slot.
+ (long-compiler-message-for-emacs): New function.
+ (sigio-handler): Ignore arguments.
+
+ * swank-clisp.lisp (set-sigio-handler, add-input-handler):
+ Conditionalize for linux.
+
+ * swank-backend.lisp (compile-system-for-emacs): Add default
+ implementation.
+ (compiler-condition): New slot short-message.
+
+ * slime.el (slime-compilation-finished): Display compiler notes
+ grouped by severity in a separate buffer.
+ (slime-compilation-finished-continuation, slime-compile-file)
+ (slime-load-system, slime-compile-string): Update callers.
+ (slime-list-compiler-notes, slime-alistify, slime-tree-for-note)
+ (slime-tree-for-severity, slime-compiler-notes-to-tree)
+ (slime-compiler-notes-mode, slime-compiler-notes-quit): New
+ functions.
+ (with-struct, slime-tree): New code for pseudo tree widget.
+ (slime-init-connection-state): Set slime-state-name to "".
+
+2004-02-08 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (create-socket): Fix last fix. Use the proper
+ port argument.
+
+ * swank-allegro.lisp, swank-backend.lisp, swank-clisp.lisp,
+ swank-cmucl.lisp, swank-lispworks.lisp, swank-openmcl.lisp,
+ swank-sbcl.lisp (create-socket): Take interface as argument.
+
+ * slime.el (sldb-show-frame-details): Fix typos.
+ (slime-print-apropos): Don't bind action.
+ (slime-reset): Kill sldb-buffers.
+ (slime-test-find-definition, slime-test-complete-symbol)
+ (slime-test-arglist): Add more slime-check-top-level calls.
+
+ * swank.lisp (setup-server): Pass loopback-interface to
+ create-socket. Reported by Dirk Gerrits.
+ (*loopback-interface*): New parameter.
+ (sldb-loop): Send :debug event inside unwind-protect, so we never
+ lose the corresponding :debug-return event.
+
+2004-02-08 Marco Baringer <mb(a)bese.it>
+
+ * swank-openmcl.lisp (find-source-locations): Eliminate unused
+ variable warning.
+
+ * swank.lisp (swank-pprint): Bind pretty print vars to
+ *swank-pprint-X* counter parts.
+ (*swank-pprint-circle*, *swank-pprint-escape*,
+ *swank-pprint-level*, *swank-pprint-length*): Swank counterparts
+ to *print-X* variables used when swank needs to pretty print a
+ form.
+ (apply-macro-expander): Use swank-pprint.
+
+2004-02-07 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (send, receive, interrupt-thread): Implement
+ more threading functions.
+
+ * swank-sbcl.lisp (inspected-parts): Implemented.
+
+ * slime.el (slime-rex): Mention thread argument in docstring.
+ (sldb-break-with-default-debugger): Use slime-rex and don't switch
+ to the output buffer (happens automatically).
+ (slime-list-threads): Renamed from slime-thread-control-panel.
+ (slime-thread-insert): Use slightly different layout.
+ (slime-give-goahead, slime-waiting-threads)
+ (slime-popup-thread-control-panel, slime-register-waiting-thread)
+ (slime-thread-goahead): Deleted.
+ (slime-maybe-start-multiprocessing): Call
+ swank:startup-multiprocessing. Reported by Paolo Amoroso.
+
+ * swank.lisp (dispatch-event): :debug, :debug-condition,
+ :debug-activate events were all encoded as :debug events, which
+ means the debugger never worked! Fix it. I guess no one uses
+ SLIME with a multithreaded Lisp.
+ (read-user-input-from-emacs): Flush the output before reading.
+ (sldb-loop): Add a sldb-enter-default-debugger tag, so we can
+ enter the default debugger by throwing to it.
+ (sldb-break-with-default-debugger): Throw to
+ sldb-enter-default-debugger.
+ (*thread-list*): New variable.
+ (list-threads): New function.
+
+ * swank-backend.lisp (thread-name): Take a thread object as
+ argument.
+ (thread-status, all-threads, thread-alive-p): New function.
+ (thread-id): Deleted.
+
+ * swank-allegro.lisp, swank-cmucl.lisp, swank-lispworks.lisp,
+ swank-openmcl.lisp, swank-sbcl.lisp: Update for modified thread
+ interface.
+
+ * swank-sbcl.lisp (enable-sigio-on-fd): New function. Use
+ fallback if sb-posix:fcntl isn't fbound.
+
+ * swank-cmucl.lisp (gf-definition-location): Return an error when
+ pathname for the GF is nil (this happens if the GF is not compiled
+ from a file).
+
+ * swank.lisp (undefine-function): New function.
+ (print-with-frame-label, print-part-to-string): Bind
+ *print-circle* to t, to avoid unbound recursion when printing
+ cyclic data structures.
+
+ * slime.el (slime-undefine-function): New command. Bound to C-c
+ C-u.
+
+2004-02-06 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (sldb-setup): Offer to enter a recursive edit if there
+ are pending continuations.
+ (slime-eval): Unwind the stack, thereby exititing recursive edits,
+ before signaling the error.
+
+2004-02-05 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-openmcl.lisp (compile-system-for-emacs): Remove compile
+ time dependency on ASDF.
+
+2004-02-05 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * swank-clisp.lisp, swank-loader.lisp: Add profiling support via
+ Kantrowitz's metering package. Reporting needs to be
+ refined (profile-package currently ignores callers-p and methods).
+
+2004-02-04 Bryan O'Connor <bryan-slime(a)lunch.org>
+
+ * swank-openmcl.lisp (mailbox): Use a semaphore instead of
+ process-wait. Works better with native threads.
+
+2004-02-04 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-backend.lisp (debugger-info-for-emacs): Export it.
+
+ * swank-sbcl.lisp (add-input-handler): Use fcntl from the sb-posix
+ package.
+
+ * swank.lisp (sldb-loop, dispatch-event, send-to-socket-io): Send
+ a :debug-activate event instead of a :debug event (to avoid
+ sending a potentially long backtrace each time).
+ (handle-sldb-condition): Include the thread-id in the message.
+
+ * slime.el (slime-path): Use load-file-name as fallback.
+ Suggested by Lawrence Mitchell.
+ (slime-dispatch-event): Add support for :debug-activate event.
+ (sldb-activate): New function.
+ (sldb-mode): make-local-hook doesn't seem to work in Emacs 20.
+ Use a buffer local variable instead.
+ (slime-list-connections): Don't print Lisp's state.
+ (slime-short-state-name): Deleted.
+
+2004-02-02 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-debugger): The customization group is called
+ 'slime-debugger', fix referrers. Reported by Jouni K Seppanen.
+
+ * swank.lisp (simple-break): Bind *debugger-hook* before invoking
+ the debugger. Reported by Michael Livshin.
+
+2004-01-31 Robert E. Brown <bbrown(a)speakeasy.net>
+
+ * swank-sbcl.lisp, swank.lisp: Add more type declarations and
+ detect missing initargs for the connection struct.
+
+2004-01-31 Jouni K Seppanen <jks(a)iki.fi>
+
+ * slime.el (slime-path): Placed inside an eval-and-compile. Works
+ around some problems when byte-compiling slime-changelog-date.
+
+2004-01-31 Marco Baringer <mb(a)bese.it>
+
+ * swank-openmcl.lisp: remove defslimefun-unimplemented forms.
+ (call-with-compilation-hooks, compile-system-for-emacs): Implement
+ them.
+ (compile-file-for-emacs, compile-string-for-emacs): Use
+ with-compilation-hooks.
+ (list-callers): Define with defimplementation and not defslimefun.
+
+ * swank-backend.lisp (compile-system-for-emacs): Declare method
+ as part of the interface.
+
+ * slime.el (slime-find-asd): Handle files whose directory does
+ not contain an asdf system definition.
+
+2004-01-31 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ Merge stateless-emacs branch into main trunk. We use now signal
+ driven IO for CMUCL and one thread per request for multithreaded
+ Lisps.
+
+2004-01-31 Robert E. Brown <bbrown(a)speakeasy.net>
+
+ * swank-backend.lisp, swank-sbcl.lisp,
+ swank-source-path-parser.lisp, swank.lisp: Add type declarations
+ to keep SBCL quiet.
+
+2004-01-29 Michael Weber <michaelw+slime(a)foldr.org>
+
+ * slime.el, swank-backend.lisp, swank-cmucl.lisp, swank-sbcl.lisp,
+ swank.lisp: Profiler support.
+
+2004-01-23 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank-openmcl.lisp: Bind ccl::*signal-printing-errors* to nil
+ inside debugger so that error while printing error take us down.
+
+2004-01-23 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-sbcl.lisp (eval-in-frame, return-from-frame): Implemented.
+ (sb-debug-catch-tag-p): New auxiliary predicate.
+ (source-path<): Delete unused function.
+
+2004-01-23 Michael Weber <michaelw(a)foldr.org>
+
+ * slime.el (slime-keys): Bind C-c M-p to slime-repl-set-package.
+ (slime-easy-menu): Add entry for slime-repl-set-package.
+
+2004-01-23 Michael Weber <michaelw(a)foldr.org>
+
+ * slime.el (slime-repl-set-package): New command to set the
+ package in the REPL buffer.
+
+ * swank.lisp (set-package): Return the shortest nickname.
+
+2004-01-23 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (sldb-disassemble): Was lost somewhere.
+
+2004-01-22 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * swank-clisp.lisp: Replace defmethod by defimplementation where
+ appropriate.
+ (return-from-frame, restart-frame): Implement them.
+
+2004-01-22 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * test.sh: Copy the ChangeLog file too.
+
+ * swank-cmucl.lisp: Replace some defmethods with
+ defimplementation.
+
+ * swank-allegro.lisp (return-from-frame, restart-name): Implement
+ interface (partly).
+
+ * swank-openmcl.lisp (restart-frame, return-from-frame): Remove
+ sldb-prefix.
+
+ * swank-backend.lisp (return-from-frame, restart-frame):
+ Are now interface functions.
+
+ * swank.asd: Remove dependency on :sb-bsd-sockets. Is already
+ done in swank-sbcl.
+
+ * swank-loader.lisp: Don't reference the swank package at
+ read-time.
+
+ * swank.lisp (completions): Never bind *package* to nil. That's a
+ type error in SBCL.
+ (swank-debugger-hook): Flush the output streams and be careful
+ when accessing *buffer-package*.
+ (create-swank-server): Return the port of the serve socket.
+
+ * swank-lispworks.lisp (interesting-frame-p): Don't print catch
+ frames.
+ (make-sigint-handler): New function.
+ (emacs-connected): Use it.
+
+ * slime.el (slime-lisp-implementation-type): New per connection
+ variable.
+ (slime-handle-oob): Handle debug-condition event. Can be signaled
+ CMUCL when cannot produce a backtrace.
+ (slime-debugging-state): Don't pop up the debugger buffer an
+ activate events. Annoying.
+ (sldb-break-with-default-debugger): Switch to the output buffer
+ before returning to the tty-debugger.
+ (sldb-return-from-frame, sldb-restart-frame): Use slime-rex.
+ (slime-list-connections, slime-short-state-name): New functions.
+
+2004-01-20 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-complete-symbol): Insert the completed-prefix
+ before deleting the original text to avoid troubles with left
+ inserting markers.
+ (slime-symbol-start-pos): Skip backward across symbol
+ constituents.
+ (slime-evaluating-state): [:read-sring] Save the window
+ configuration.
+ (slime-read-string-state): Don't handle activate events
+ (troublesome if, e.g, complete-symbol is used from another
+ buffer). Restore the window configuration.
+ (slime-repl-read-string): Goto the end of buffer.
+ (slime-debugging-state): [:activate] Display the debugger buffer
+ if not visible.
+ (slime-to-lisp-filename, slime-from-lisp-filename)
+ (slime-translate-to-lisp-filename-function)
+ (slime-translate-from-lisp-filename-function, slime-compile-file)
+ (slime-goto-location-buffer, slime-ed, slime-load-file): Support
+ for remote filename translation (untested).
+
+ * swank.lisp (create-swank-server): Take announce-fn as optional
+ argument.
+
+ * swank-allegro.lisp: Replace defmethod with defimplementation.
+ (eval-in-frame): Implemented.
+
+2004-01-20 Lasse Rasinen <lrasinen(a)iki.fi>
+
+ * slime.el (slime-prin1-to-string): Replacement for
+ prin1-to-string that avoids escaping non-ascii characters in a
+ way that the CL reader doesn't understand. Allows use of 8-bit
+ characters in Lisp expressions with Emacs in unibyte-mode.
+
+2004-01-20 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-eval-print-last-expression): Insert a newline
+ before and after the result.
+ (slime-easy-menu): Added menu items:
+ "Eval Region", "Scratch Buffer", "Apropos Package..."
+ Added some bold to default SLDB faces.
+
+2004-01-19 Alan Ruttenberg <alanr-l(a)mumble.net>
+ *swank-openmcl.lisp in frame-catch-tags, ppc32::catch-frame.catch-tag-cell -> 0,
+ ppc32::catch-frame.csp-cell -> 3. FIXME when this code is more stable in openMCL.
+
+2004-01-19 Michael Weber <michaelw(a)foldr.org>
+
+ * slime.el (slime-close-all-sexp): New command to close all
+ unmatched parens in the current defun. Bound to `C-c C-]'. With
+ prefix argument, only operate in the region (for closing
+ subforms).
+
+2004-01-19 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-openmcl.lisp (thread-id, thread-name): Fixed silly bugs
+ (thanks Marco Baringer).
+
+ * swank-loader.lisp: Call (swank:warn-unimplemented-interfaces).
+
+ * swank.lisp (ed-in-emacs): New command with the same interface
+ as CL:ED.
+
+ * swank-cmucl.lisp, swank-sbcl.lisp, swank-lispworks.lisp,
+ swank-openmcl.lisp, swank-allegro.lisp, swank-clisp.lisp: Updated
+ to use `defimplementation'.
+
+ * swank-backend.lisp (definterface, defimplementation): New macros
+ as sugar around defgeneric/defmethod. This supports conveniently
+ supplying a default (on NO-APPLICABLE-METHOD). Because the
+ underly mechanism is still generic functions this doesn't break
+ code that isn't updated.
+ (warn-unimplemented-interfaces): Print a list of backend functions
+ that are not implemented.
+ (xref and list-callers): Defined interfaces for these functions.
+ (describe-definition): New function that takes over from the many
+ other describe-* functions called from apropos listing. Takes the
+ type of definition (as returned by describe-symbol-for-emacs) as
+ an argument.
+
+ * slime.el (sldb-enable-styled-backtrace): This is now true by
+ default.
+ (slime-keys): Bound `slime-inspect' to `C-c I'.
+ (slime): `M-x slime' now offers to keep existing connections
+ alive (else disconnect them). If you disconnect them, the new
+ connection gets to reuse the existing REPL.
+ (slime-connection): Error if the connection is closed.
+ (slime-handle-oob): New message (:ED WHAT) for `slime-ed'.
+ (slime-display-output-buffer): Don't pop up the REPL if it is
+ already visible in any frame.
+ (slime-find-asd): Handle case where (buffer-file-name) is nil.
+ (slime-ed): Elisp backend for (CL:ED WHAT).
+ (slime-apropos): Add a summary line to apropos listings.
+ (slime-print-apropos): Replaced `action' property (name of lisp
+ describe function) with `type' (argument to pass to unified
+ swank:describe-definition function).
+ (slime-apropos-package): New command on `C-c P'. Presents apropos
+ listing for all external (with prefix also internal) symbols in a
+ package.
+
+2004-01-18 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-lispworks.lisp (sigint-handler): Bind a continue restart.
+ (make-dspec-location): Handle strings like pathnames.
+ Some multithreading support.
+
+ * slime.el (compile-defun): Don't use keywords. The keyword
+ package is locked in Lispworks and causes the test-suite to hang.
+ (slime-eval-with-transcript): Fix bug triggered when 'package' is
+ a buffer local variable. Reported by Janis Dzerins.
+ (slime-batch-test): Wait until the connection is ready.
+
+2004-01-18 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank-openmcl: Implement frame-catch-tags. Added debugger functions
+ sldb-restart-frame, sldb-return-from-frame. Should probably be added to backend.lisp
+ but let's discuss first. Do other lisps support this?
+
+ * slime.el sldb-restart-frame, sldb-return-from-frame
+
+2004-01-18 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * swank-clisp.lisp (call-without-interrupts): Evaluate
+ linux:SIGFOO at read time since the macro with-blocked-signals
+ expects a fixnum.
+ (compile-file-for-emacs): Comment fix.
+
+2004-01-18 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-sbcl.lisp (make-fn-streams): Deleted. Already defined in
+ swank-gray.lisp.
+
+ * swank.lisp (find-symbol-or-lose, format-arglist): New functions.
+ (without-interrupts): New macro.
+ (send-to-emacs): Use it.
+
+ * swank-backend.lisp, swank-clisp.lisp, swank-lispworks.lisp,
+ swank-openmcl.lisp, swank-sbcl.lisp, swank-allegro.lisp:
+ (arglist-string): Refactor common code to swank.lisp.
+ (call-without-interrupts, getpid): Are now generic functions.
+
+ * slime.el (arglist): Test slot readers and closures.
+
+ * swank-cmucl.lisp (arglist-string): Use
+ pcl:generic-function-lambda-list for generic functions. Handle
+ closures. Print arglist in lower case.
+ (inspected-parts-of-value-cell): Was lost during the inspector
+ refactoring.
+
+2004-01-18 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * swank-clisp.lisp (compile-file-for-emacs,
+ split-compiler-note-line): Revert last change.
+ (handle-notification-condition): Don't signal the condition.
+ (*compiler-note-line-regexp*): Fix and rewrite it as extended
+ regexp.
+
+ * slime.el (slime-changelog-date): Use file-truename of
+ byte-compile-current-file.
+
+2004-01-17 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-format-arglist): Add some sanity checks and
+ print zero argument functions nicer. Suggested by Ivan Boldyrev.
+ (slime-test-expect): Take test predicate as argument.
+ (arglist): Test generic functions.
+
+ * swank-cmucl.lisp (arglist-string): Handle generic functions
+ better. Reported by Ivan Boldyrev.
+
+2004-01-16 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-allegro.lisp: Multiprocessing support.
+
+ * swank-openmcl.lisp, swank-cmucl.lisp, swank-backend.lisp,
+ swank.lisp: Refactor inspector code.
+
+ * swank.lisp (changelog-date): Use *compile-file-truename* instead
+ of *compile-file-pathname*.
+ (with-I/O-lock, with-a-connection): The usual CLISP fixes.
+ (create-swank-server): Patch by Marco Baringer <mb(a)bese.it>.
+ Bring it back again.
+ (create-connection): Use return the dedicated output stream if
+ available.
+
+ * slime.el: Numerous REPL related fixes.
+ (slime-update-state-name): Take state as argument.
+ (slime-repl-beginning-of-defun, slime-repl-end-of-defun): Fix
+ typos.
+ (sldb-insert-restarts): Remove duplicate definition.
+
+2004-01-16 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-openmcl.lisp: Multiprocessing support.
+
+ * swank.lisp (changelog-date): make-pathname portability fix
+ (from alanr).
+ (with-io-redirection): Use (current-connection) instead of
+ *dispatching-connection* (from alanr).
+
+ * slime.el (slime-init-output-buffer): XEmacs portability fix, and
+ use header-line-format to show info about Lisp in Emacs21.
+
+2004-01-15 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-sbcl.lisp, swank-cmucl.lisp (remove-input-handlers): New
+ method.
+
+ * swank-allegro.lisp (excl:stream-read-char-no-hang): Import it.
+ (emacs-connected): Add default method. The method for
+ no-applicable-method doesn't seem to work. ACL bug?
+
+ * swank-loader.lisp (compile-files-if-needed-serially): Don't
+ handle compilation errors. We must compile everything because
+ changelog-date requires *compile-file-truename*.
+
+ * slime.el: (slime-changelog-date)
+ (slime-check-protocol-version): New functions.
+ (slime-handle-oob): Handle :check-protocol-version event.
+ (slime-init-output-buffer): Print some info about the remote Lisp.
+ (slime-connect): Use it.
+ (slime-note-transcript-start): Renamed from
+ slime-insert-transcript-delimiter.
+ (slime-note-transcript-end): New function.
+ (slime-with-output-end-mark, slime-repl-insert-prompt)
+ (slime-repl-show-result, slime-compile-file)
+ (slime-show-evaluation-result): Insert output from eval commands
+ after the prompt and asynchronous output before the prompt. Needs
+ documentation.
+ (repl-test, repl-read, interactive-eval-output): New tests.
+ (slime-flush-output): Accept output from all processes.
+
+ * swank.lisp (serve-requests): New function.
+ (setup-server): Use it.
+ (start-server): Pass backgroud to setup-server.
+ (create-connection): Check the protocol version.
+ (changelog-date): New function.
+ (make-output-function): Use write-string instead of princ.
+
+ * swank-backend.lisp (remove-input-handlers): New function.
+
+2004-01-15 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-aux-connect, slime-handle-oob): Support for
+ (:open-aux-connection port) message where Lisp requests that
+ Emacs make a connection. These are "auxiliary" connections which
+ don't (or at least shouldn't) have their own REPL etc.
+
+ * swank.lisp: New support for multiprocessing and multiple
+ connections + commentary.
+ (with-a-connection): Macro to execute some forms "with a
+ connection". This is used in the debugger hook to automatically
+ create a temporary connection if needed (i.e. if the current
+ thread doesn't already have one).
+ (open-aux-connection): Helper function to create an extra
+ connection to Emacs.
+
+ * swank-sbcl.lisp: Implemented multiprocessing. Not perfect.
+
+ * swank-cmucl.lisp: Implemented new multiprocessing interface.
+ (create-socket): Make FDs non-blocking when multiprocessing is
+ enabled.
+ (startup-multiprocessing): Set *swank-in-background* to :spawn.
+
+ * swank-backend.lisp: Changed multiprocessing interface.
+
+2004-01-15 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * swank-clisp.lisp (with-blocked-signals): New macro.
+ (without-interrupts): Use it.
+ (*use-dedicated-output-stream*, *redirect-output*): Don't set them
+ here, use the default settings.
+ Make :linux one of *features* if we find the "LINUX" package.
+
+2004-01-14 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-openmcl.lisp (emacs-connected): Typo fix (missing
+ close-paren).
+
+2004-01-13 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-input-complete-p): Tolerate extra close parens.
+ (slime-idle-state): Don't active the repl.
+ (slime-insert-transcript-delimiter): Insert output before prompt.
+ (slime-open-stream-to-lisp): Initialize the process-buffer with
+ the connection buffer.
+ (slime-repl-activate): Deleted.
+ (slime-repl-eval-string, slime-repl-show-result)
+ (slime-repl-show-abort): Better handling of abortion.
+ (slime-compile-file): Insert output before prompt.
+
+ * swank-lispworks.lisp (create-socket): Fix condition message.
+
+ * swank-openmcl.lisp (*swank-in-background*): Set to :spawn.
+ (emacs-connected): Initialize ccl::*interactive-abort-process*.
+
+ * swank.lisp (*swank-in-background*): New variable.
+ (start-server): Start swank in background, depending on
+ *swank-in-background*.
+
+ * swank-cmucl.lisp, swank-sbcl.lisp (*swank-in-background*): Set
+ to :fd-handler.
+
+ * swank-clisp.lisp (accept-connection): Remove superfluous call to
+ socket-wait.
+
+ New more direct socket interface. The new interface is closer to
+ the functions provided by the implementations. For Lispworks we
+ use some non-exported functions to get a sane interface. The
+ interface also includes add-input-handler and a spawn function
+ (not used yet). The idea is that most of the logic can be shared
+ between similar backends.
+
+ * swank-gray.lisp (make-fn-streams): New function.
+ (stream-read-char-no-hang, stream-read-char-will-hang-p): Moved to
+ here from swank-clisp.lisp.
+
+ * swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+ swank-lispworks.lisp, swank-openmcl.lisp, swank-sbcl.lisp:
+ (create-socket, local-port, close-socket, accept-connection)
+ (add-input-handler, spawn): Implement new socket interface.
+
+ * swank.lisp (start-server, open-dedicated-output-stream &etc):
+ Use new socket functions.
+
+ * swank-backend.lisp (create-socket, local-port, close-socket)
+ (accept-connection, add-input-handler, spawn): New functions.
+ (accept-socket/stream, accept-socket/run): Deleted.
+
+2004-01-13 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-clisp.lisp: Updated for new network interface but not
+ tested! Probably slightly broken.
+
+ * swank-lispworks.lisp: Updated for new network interface.
+ (accept-socket/stream): This function is currently broken, so
+ LispWorks can't use the dedicated output channel at the moment.
+
+ * swank.lisp, swank-cmucl.lisp, swank-sbcl.lisp: Updated for new
+ network interface.
+
+ * swank-backend.lisp (accept-socket/stream, accept-socket/run):
+ New functions replacing the ancient (over 24 hours!)
+ `create-socket-server'. This interface is much simpler.
+
+2004-01-12 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-lispworks.lisp: Partially updated for new backend
+ interface, but not actually working. The sockets code is broken, I
+ haven't grokked LispWorks the interface properly.
+
+ * swank-gray.lisp (slime-input-stream, slime-output-buffer): Added
+ slots to support the new `make-fn-streams' interface from
+ swank-backend.lisp. These slots need to be initialized by the
+ backend, see swank-sbcl.lisp for an example (very easy).
+
+ * swank-sbcl.lisp (create-socket-server): Implemented new server
+ interface.
+
+ * slime.el (slime-handle-oob): Added
+ :open-dedicated-output-stream message, previously implemented
+ with :%apply.
+ (slime-repl-read-string, slime-repl-return-string): Pass integer
+ argument to `slime-repl-read-mode' to set rather than toggle.
+
+ * swank.lisp: Taking over previously non-portable jobs:
+ (start-server): Now only uses sockets code from the backend.
+ (handle-request): Top-level request loop.
+ (open-dedicated-output-stream): Dedicated output socket.
+ (connection): New data structure that bundles together the things
+ that constitute a connection to Emacs: socket-level stream and
+ user-level redirected streams.
+
+ * swank-cmucl.lisp (create-socket-server): Generic TCP server
+ driven by SERVE-EVENT.
+ (serve-one-request, open-stream-to-emacs): Deleted. Now handled
+ portably in swank.lisp.
+ (make-fn-streams): Implement new stream-redirection interface.
+ (slime-input-stream): New slot referencing output sibling, so it
+ can be forced before input requests.
+
+ * swank-backend.lisp (create-socket-server): Generic
+ callback-driven TCP server interface. Replaces
+ `create-swank-server', with the higher-level logic moved into
+ swank.lisp.
+ (emacs-connected): Invoked when Emacs initially connects, as a
+ hook for backend implementations.
+ (make-fn-streams): Interface for creating pairs of input/output
+ streams that are backended by callback functions. Used to
+ implement redirected-via-Emacs standard I/O streams.
+
+2004-01-12 Lawrence Mitchell <wence(a)gmx.li>
+
+ * slime.el (slime-events-buffer): Set `hs-block-start-regexp'
+ before running `hs-minor-mode'.
+
+2004-01-10 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (package-updating): Expected package is now a list (can
+ be any), since the shortest nickname is not
+ standardized. e.g. USER or CL-USER for COMMON-LISP-USER.
+
+ * swank-cmucl.lisp: Don't enable xref (let the user decide).
+ (set-fd-non-blocking): Removed unused function.
+ Miscellaneous refactoring of the networking code.
+
+ * slime.el (slime-complete-symbol): Use markers to hold the
+ beginning and end of the completion prefix, in case looking up
+ completions causes insertions (e.g. GC announcements).
+
+2004-01-09 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-activate-state): Only update state name when
+ `slime-default-connection' activates. This fixes an annoying
+ "Selecting deleted buffer" bug that prevented SLIME from being
+ restarted.
+ (slime-next-connection): Fixed a bug where buffer-local connection
+ bindings could get in the way and prevent the connection from
+ actually changing.
+ (slime-complete-restore-window-configuration): Wrap
+ `set-window-configuration' in `save-excursion'. This fixes a
+ problem where the cursor would end up in the wrong place after
+ completion in XEmacs.
+
+2004-01-09 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Place (require 'cl) inside a eval-and-compile.
+ (slime-with-connection-buffer): Move definition upwards before the
+ first use.
+ (package-updateing): New test for package updates in the listeners.
+
+ * swank.lisp (eval-region): Bind *package* outside the
+ unwind-protect to detect updates.
+
+ * swank-backend.lisp (debugger-info-for-emacs)
+ (find-function-locations): Doc fix.
+
+2004-01-09 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * swank-clisp.lisp: Add methods for GRAY:STREAM-READ-CHAR-NO-HANG
+ and for the CLISP specific GRAY:STREAM-READ-CHAR-WILL-HANG-P.
+ This should fix the behaviour of SYS::READ-FORM.
+
+2004-01-08 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-inspector-fontify): Function to insert a string
+ in a particular inspector face. Replaces macro-code-generation
+ function `slime-inspector-expand-fontify'. Fixes a byte-compile
+ problem (macro was calling function not defined at compile-time).
+
+2004-01-07 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el: Multisession internal improvements. Now there are
+ three separate connection variables, in order of priority:
+ slime-dispatching-connection (dynamically-bound)
+ slime-buffer-connection (buffer-local)
+ slime-default-connection (global)
+ The most specific one available is used. This is splitting
+ `slime-connection' into multiple variables, so that you can be
+ specific about what you want to assign (i.e. know if you're
+ setting a dynamic binding or a buffer-local one).
+ Fixed some related bugs.
+ (slime-connection-close-hook): If default connection closes,
+ select another connection.
+ (slime-lisp-package): Initially CL-USER nickname instead of
+ COMMON-LISP-USER (for REPL prompt).
+
+ * slime.el (slime): Multisession support: with prefix argument,
+ gives the option of keeping existing sessions and firing up an
+ additional *inferior-lisp* to connect to. Each connection now has
+ its own *slime-repl[<n>]* buffer.
+ (slime-connection): Should now be read via the function of the
+ same name. The accessor will check if the value is NIL, and if so
+ use `slime-default-connection'.
+ (slime-default-connection): The connection that will be used by
+ default, i.e. unless `slime-connection' is bound. Renamed from
+ `slime-primary-connection'.
+ (slime-init-connection-state): When reconnecting, update the
+ `slime-connection' binding in the REPL to use the new connection.
+ (slime-repl-input-history, ...): REPL variables are now
+ buffer-local.
+
+2004-01-06 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp (eval-string): New argument 'id'. Used to identify
+ the remote continuation.
+ (log-event): New debugging function.
+ (read-from-emacs, send-to-emacs): Use it.
+
+ * slime.el: The new macro 'slime-rex' can now be used to evaluate
+ sexps remotely. It offers finer control what to do when the
+ evaluation aborts.
+ (slime-rex): New macro
+ (slime-eval, slime-eval-async, sldb-continue)
+ (sldb-invoke-restart): Use it.
+ (slime-continuation-counter, slime-push-evaluating-state): New
+ functions.
+ (slime-output-buffer): Initialize markers.
+ (sldb-mode): XEmacs doesn't like (add-hook (make-local-hook ...)).
+ (slime-init-connection): New optional argument SELECT.
+ (slime-def-connection-var): Workarounds for Emacs 20 reader bugs.
+ Backquote is pretty broken Emacs 20.
+
+2004-01-06 Ignas Mikalajunas <i.mikalajunas(a)mbt.lt>
+
+ * swank-loader.lisp (user-init-file): Use merge-pathames. Fix
+ Windows support.
+
+2004-01-05 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el: Multiple session support, i.e. Emacs can open
+ multiple connections to Lisps. The guts is there, but
+ user-interface is currently minimal.
+ (slime-net-process): Replaced with slime-net-processes.
+ (slime-net-send): Take process as argument.
+ (slime-process-available-input): Poll all connections.
+ (slime-connection): Current connection (process) to use for
+ talking to Lisp. Can be bound dynamically or buffer-local.
+ (slime-with-connection-buffer): Macro to enter the process-buffer
+ of `slime-connection' to manipulate the local variables.
+ (slime-stack-stack): Now buffer-local in the process-buffer of
+ each connection.
+ (slime-push-state, slime-pop-state): Operate on the stack inside
+ `slime-connection's process-buffer.
+ (slime-dispatch-event): Take optional process argument, to bind
+ `slime-connection' appropriately when events arrive from the
+ network.
+ (slime-def-connection-var): Macro to define variables that are
+ "connection-local". Such variables are used via (setf'able)
+ accessor functions, and their real bindings exist as local
+ variables in the process-buffers of connections. The accessors
+ automatically work on `slime-connection'.
+ (slime-lisp-features, slime-lisp-package, slime-pid, sldb-level):
+ These variables are now connection-local.
+ (slime-read-from-minibuffer): Inherit `slime-connection' as
+ buffer-local so that we complete towards the right Lisp.
+ (sldb-mode): Inherit `slime-connection' as buffer-local so that we
+ debug towards the right Lisp.
+ (get-sldb-buffer): New function to return (optionally create) the
+ SLDB buffer for the current connection. Since multiple Lisps can
+ be debugged simultaneously, the buffername now includes the
+ connection number.
+ (slime-connection-abort): New command to abort a connection
+ attempt (don't use `slime-disconnect' anymore - that closes all
+ connections).
+ (slime-execute-tests): Honor `slime-test-debug-on-error'.
+ (slime-next-connection): Cycle through open Lisp connections.
+
+2004-01-02 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-display-output-buffer): Move the output markers
+ to the end of the buffer.
+
+ * swank-clisp.lisp (frame-do-venv): Rename the :symbol property to
+ :name.
+ (format-condition-for-emacs): Replaced with
+ debugger-condition-for-emacs.
+ (backtrace): Use print-with-frame-label.
+
+ * swank-openmcl.lisp (format-condition-for-emacs): Replaced with
+ debugger-condition-for-emacs.
+ (backtrace): Use print-with-frame-label.
+ (frame-locals): Rename the :symbol property to :name.
+
+ * swank-lispworks.lisp (format-condition-for-emacs): Replaced with
+ debugger-condition-for-emacs.
+ (backtrace): Use print-with-frame-label.
+ (frame-locals): Rename the :symbol property to :name.
+
+ * swank-allegro.lisp (frame-locals): Rename the :symbol property
+ to :name.
+ (format-condition-for-emacs): Replaced with
+ debugger-condition-for-emacs.
+ (backtrace): Use print-with-frame-label.
+
+ * swank-sbcl.lisp (tracedp, toggle-trace-fdefinition)
+ (format-condition-for-emacs): Remove unused functions.
+ (format-frame-for-emacs): Use print-with-frame-label.
+ (compute-backtrace): Simplified.
+ (backtrace): Return our frame numbers.
+ (frame-locals): Rename the :symbol property to :name. Remove the
+ :validity property.
+
+ * swank-cmucl.lisp (accept-loop, safe-definition-finding): Doc
+ fix.
+ (location-buffer=, file-xrefs-for-emacs)
+ (sort-contexts-by-source-path, source-path<)
+ (format-condition-for-emacs): Remove unused functions.
+ (format-frame-for-emacs): Don't include the frame number in the
+ description, but use the frame number for indentation. Update
+ callers.
+ (frame-locals): Rename the :symbol property to :name.
+
+ * slime.el (slime-add-face): New function.
+ (sldb-add-face): Use it.
+ (sldb-setup): Some refactoring.
+ (sldb-insert-condition): New function. Factorized from
+ sldb-setup. Message and types are now separate.
+ (sldb-insert-restarts): New function. Factorized from sldb-setup.
+ (sldb-insert-frame): Factorized from slime-insert-frames. The
+ frame number in no longer part of the string describing the frame.
+ (sldb-insert-frames): Use it.
+ (sldb-show-frame-details): Print frame numbers. Fix printing of
+ catch tags. Move to the start of the frame before at the
+ beginning to get unfontified text properties.
+ (sldb-inspect-condition): New command.
+ (sldb-insert-locals): The :symbol property is now called :name.
+ Fix locals with :id attribute.
+ (slime-open-inspector): Fix the bugs I introduced last time.
+
+ * swank.lisp (safe-condition-message): New function.
+ (debugger-condition-for-emacs): Used to be
+ format-condition-for-emacs in each backend. Separate the
+ condition message from the type description. Update all backends
+ accordingly.
+ (print-with-frame-label): New function.
+
+ * slime.el (slime-hyperspec-lookup): New function.
+
+2004-01-02 Wolfgang Jenkner <wjenkner(a)inode.at>
+
+ * swank-clisp.lisp: New file. Merged with Vladimir's version.
+
+ * xref.lisp: New file. Used by swank-clisp.
+
+ * swank-loader.lisp (user-init-file): Add CLISP files.
+
+ * swank.lisp (eval-region, tokenize-completion): Modify loops a
+ bit to make CLISP happy.
+
+ * swank-backend.lisp (with-compilation-hooks): Replace () with
+ (&rest _) to make CLISP happy.
+
+ * slime.el (slime-goto-source-location): Support for CLISP style
+ line numbers. Split it up.
+ (slime-goto-location-buffer, slime-goto-location-position): New
+ functions.
+ (slime-load-system): Use slime-display-output-buffer.
+ (slime-repl-mode): Disable conservative scrolling. Not sure if it
+ was a good idea.
+ (sldb-insert-frames, sldb-show-frame-details, sldb-list-locals):
+ Minor fixes.
+ (sldb-insert-locals): Renamed from sldb-princ-locals.
+ (sldb-invoke-restart): Use slime-eval instead of
+ slime-oneway-eval, because interactive restarts may read input.
+ (slime-open-inspector): Minor indentation fixes.
+ (slime-net-output-funcall): Removed. Was unused.
+
+2003-12-19 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * slime.el 1.157
+ fix bug in sldb-princ-locals I introduced when adding fonts to sldb
+
+2003-12-19 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * swank-openmcl.lisp 1.42
+ in request-loop register output stream to be periodically slushed per Gary Byer's email.
+ * slime.el 1.156
+ slime-goto-source-location. Sometimes source information is recorded but it isn't a standard "def"
+ in that case, don't error out, just look for the most likely place for the definition.
+
+2003-12-19 Luke Gorrie <luke(a)bluetail.com>
+
+ * null-swank-impl.lisp: Deleted this old file. See
+ swank-backend.lisp instead.
+
+2003-12-18 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * swank-openmcl.lisp 1.41
+ in openmcl (break) now goes into slime debugger.
+ (setq swank:*break-in-sldb* nil) to disable that.
+
+2003-12-17 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * slime.el 1.155
+ Allow font choices for backtrack. Add group for customizing them: sldb.
+ Whole thing is enabled with sldb-enable-styled-backtrace which is off by default, for now.
+ Try
+ '(sldb-condition-face ((t (:foreground "DarkSlateGray" :weight bold))))
+ '(sldb-detailed-frame-line-face ((t (:foreground "brown" :weight bold :height 1.2))))
+ '(sldb-local-name-face ((t (:weight bold))))
+ '(sldb-restart-face ((t (:foreground "DarkBlue" :weight bold))))
+ '(sldb-restart-number-face ((t (:underline t :weight bold))))
+ '(sldb-restart-type-face ((t (:foreground "DarkSlateGrey" :weight bold))))
+ '(sldb-section-face ((t (:weight bold :height 1.2))))
+ '(sldb-selected-frame-line-face ((t (:foreground "brown" :weight bold :height 1.2))))
+ '(sldb-topline-face ((t (:foreground "brown" :weight bold :height 1.2))))
+
+2003-12-17 Alan Ruttenberg <alanr-l(a)mumble.net>
+ * slime.el 1.154
+ Allow some face choices in the inspector. Try
+ '(slime-inspector-label-face ((t (:weight bold))))
+ '(slime-inspector-topline-face ((t (:foreground "brown" :weight bold :height 1.2))))
+ '(slime-inspector-type-face ((t (:foreground "DarkRed" :weight bold))))
+ You can also set slime-inspector-value-face
+
+2003-12-17 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank-openmcl.lisp 1.40
+ Fix an error with frame-source-location-for-emacs when the
+ function was a method-function.
+ Defined method-source-location that handles this case. You can
+ still end up looking at the wrong definition, as the protocol
+ doesn't allow passing back the qualifiers and specializers to look
+ up the correct one in the file
+
+. * swank-openmcl.lisp 1.39
+ Allow you to continue after interrupting.
+ Properly set *swank-debugger-stack-frame* when interrupting.
+
+ * slime.el 1.152
+ sldb-continue now uses slime-oneway-eval
+
+2003-12-17 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Better handling of asynchronous output.
+ (slime-output-end): New variable. Use this marker to insert
+ output. Insert asynchronous output inserted before the "input
+ region" and before the prompt.
+ (slime-show-last-output): Use it.
+ (slime-repl-insert-prompt): Initialize it.
+ (slime-last-output-start): Removed.
+ (slime-flush-output): Increase delay to 20 usecs.
+ (slime-with-output-end-mark): Renamed from
+ slime-with-output-at-eob. Insert a newline if needed.
+ (slime-output-string, slime-repl-activate): Use it.
+ (slime-repl-return): Ensure that slime-repl-input-end-mark points
+ to a reasonable location.
+
+2003-12-17 Luke Gorrie <luke(a)bluetail.com>
+
+ * HACKING: New file summarising our way of working.
+
+2003-12-16 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-lisp-preferred-package-nicknames): Removed. Not
+ very interesting (and slightly broken) now that shortest-nicknames
+ are automatically used.
+ (slime-output-oneway-evaluate-request): New function to evaluate
+ an expression for side-effects (without getting a
+ result).
+ (slime-idle-state): Handle new :emacs-evaluate-oneway.
+ (slime-debugging-state): Handle :emacs-evaluate-oneway.
+ (sldb-invoke-restart): Use slime-oneway-eval. This avoids pushing
+ an evaluating state (which will be aborted, and print an unnecessary
+ message saying so).
+ (sldb-break-with-default-debugger): New command to break into the
+ default TTY debugger. Bound to 'B' in *sldb*.
+ (slime-read-string-state): Added :emacs-evaluate-oneway.
+
+ * swank.lisp (invoke-nth-restart-for-emacs): Wrapper around
+ INVOKE-NTH-RESTART that checks that Lisp and Emacs agree on the
+ debug level. This detects and ignores old restart requests when
+ several are sent at once (possible because of new oneway-eval
+ feature).
+ (oneway-eval-string): New function to evaluate a string without
+ sending a result, and with *DEBUGGER-HOOK* bound to NIL. (The
+ debugger hook is inhibited to avoid state conflicts.)
+
+2003-12-15 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-openmcl.lisp (ccl::*warn-if-redefine-kernel*): Support for
+ interrupting the listener (by Alan Ruttenberg).
+
+2003-12-15 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp *start-swank-in-background*: Set to t by default.
+
+ * slime.el (slime-eval-last-expression-display-output): New
+ command. Bound to C-x M-e. Suggested by Nicolas Neuss.
+ (slime-display-output-buffer): New function.
+ (slime-slime-compile-file): Use it.
+
+2003-12-15 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (*processing-rpc*, *multiprocessing-enabled*,
+ *debugger-hook-passback*): New variables.
+ (with-conversation-lock, with-I/O-lock): New macros.
+ (read-next-form): Use with-I/O-lock.
+ (send-to-emacs): Use with-I/O-lock.
+ (swank-debugger-hook): When called asynchronously (i.e. not
+ during RPC) and multiprocessing is enabled, suspend until
+ acknowleged by Emacs.
+ (install-global-debugger-hook): Install a SLIME-DEBUGGER-FUNCTION
+ globally on *DEBUGGER-HOOK*.
+ (startup-multiprocessing-for-emacs): Called to initialize multiprocessing.
+ (eval-string): Dynamically set the *PROCESSING-RPC* flag.
+ (eval-string): Nasty hack with *DEBUGGER-HOOK-PASSBACK* to
+ install debugger hook. Temporary, I swear!
+ (eval-region, shortest-package-nickname): Report the shortest
+ package nickname to Emacs (for the REPL prompt). Patch from Marco
+ Baringer.
+
+ * swank-backend.lisp: Defined multiprocessing interface.
+
+ * swank-cmucl.lisp: Implmemented the multiprocessing interface.
+
+ * slime.el (slime-multiprocessing): When true, use
+ multiprocessing in Lisp if available.
+ (slime-global-debugger-hook): When true, globally set
+ *debugger-hook* to use the SLIME debugger. For use with
+ SERVE-EVENT and multiprocessing.
+ (slime-handle-oob): Handle :AWAITING-GOAHEAD message from threads
+ that have suspended to wait for Emacs's attention.
+ (slime-give-goahead): New command to allow a suspended thread to
+ continue (bound to RET in the thread-control-panel).
+ (slime-thread-control-panel): New command to display a buffer
+ showing all threads that are suspending waiting for Emacs's
+ attention. Bound to `C-c C-x t'.
+ (slime-popup-thread-control-panel): When true, automatically
+ popup the thread-control buffer when a new thread suspends.
+
+2003-12-14 Alan Ruttenberg <alanr-l(a)mumble.net>
+
+ * swank-openmcl.lisp (eval-in-frame, inspect-object and friends):
+ Most of this is copied from swank-cmucl. The parts between &&&&&
+ are what I added for openmcl. I piggyback off the inspector which
+ is shipped with openmcl, so inspecting won't look the same as it
+ would in cmucl, I imagine. Still, it's a start. eval in frame
+ uses frame-locals to get bindings so if you have debug settings
+ low or don't have *save-local-symbols* set you won't be able to
+ evaluate.
+
+2003-12-14 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-lispworks.lisp (tracedp, toggle-trace-fdefinition): Moved
+ to swank.lisp.
+
+ * swank-allegro.lisp (create-swank-server): Add support for
+ BACKGROUND and CLOSE argument.
+ (call-with-debugging-environment): Use excl::int-newest-frame to
+ avoid the kludge with *break-hook*.
+ (sldb-abort): New function.
+ (frame-source-location-for-emacs): Dummy definition.
+ (compile-file-for-emacs): The argument is called
+ :load-after-compile and not :load.
+ (xref-results-for-emacs): Use dolist instead of loop.
+
+ * swank-openmcl.lisp (create-swank-server): Add support for
+ BACKGROUND and CLOSE argument.
+ (open-stream-to-emacs): Support for dedicated output stream.
+
+ * swank.lisp: *start-swank-in-background*,
+ *close-swank-socket-after-setup*, *use-dedicated-output-stream*:
+ Moved here from swank-cmucl.
+ (sldb-continue): Don't pass the condition as argument, because
+ that doesn't work with Allegro.
+ (toggle-trace-fdefinition, tracedp): Replace backend specific code
+ with portable, but ugly, calls to eval.
+
+ * swank-cmucl.lisp (compile-system-for-emacs): Add method for
+ CMUCL.
+
+ * slime.el (slime-goto-source-location): Better regexp for package
+ qualified symbols. Allow dashes in the name and two colons.
+ Reported by Alan Ruttenberg.
+
+2003-12-13 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-openmcl.lisp (create-swank-server): Interrupt the right
+ thread. Patch by Alan Ruttenberg. Not yet enabled, due to lack
+ of test platform.
+ (sldb-disassemble): Implement sldb-disassemble command. Patch by
+ Alan Ruttenberg.
+ Remove #' from lambdas.
+
+2003-12-12 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (create-swank-server): New keyword arguments to
+ control the server: BACKGROUND and CLOSE. fd-handlers are used if
+ BACKGROUND is true. If close CLOSE is true, close the socket
+ after the first connection; keep it open otherwise.
+ *start-swank-in-background*, *close-swank-socket-after-setup*: The
+ default values of the corresponding arguments for
+ create-swank-server.
+ (compile-file-for-emacs): Don't load the fasl-file when the
+ compilation failed.
+
+ * swank-openmcl.lisp (toggle-trace-fdefinition, tracedp):
+ Implement trace command. Patch by Alan Ruttenberg.
+ (find-function-locations, find-source-locations): Handle
+ variables, and method-combinations. General cleanups.
+ (source-info-first-file-name): Removed.
+ (list-callers): Fixed.
+ (list-callers): Fixed some more. method-name is not exported in
+ 0.14. From Marco Baringer.
+ (swank-accept-connection): Accept multiple connections. Patch by
+ Marco Baringer.
+
+ * swank-loader.lisp (user-init-file): Use homedir's truename.
+ Reported by Friedrich Dominicus.
+
+ * slime.el (slime-repl-current-input): Don't remove the final
+ newline if we are in reading state.
+ (slime-goto-source-location): Regex-quote the function-name and
+ handle package prefixes. Reported by Alan Ruttenberg.
+ (slime-output-string): Insert asynchronous output before the
+ prompt.
+
+2003-12-12 Daniel Barlow <dan(a)telent.net>
+
+ * swank-source-path-parser.lisp: new file, excerpting part of
+ swank-cmucl.lisp to where SBCL can find it as well.
+
+2003-12-11 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-one-line-ify): New function to convert
+ multi-line strings to one-liners by replacing any newline
+ followed by indentation by a single space.
+ (slime-xrefs-for-notes): Use it.
+
+2003-12-11 Daniel Barlow <dan(a)telent.net>
+
+ * swank-sbcl.lisp (compiler-note-location): replace with
+ thinly-ported version from the CMUCL backend which understands
+ :lisp as a pathname
+
+ * slime.el (slime-xrefs-for-notes): a little more temporary
+ variables, a little less cdr. Should be slightly faster on
+ big systems
+ (slime-goto-next-xref): set window point as well as buffer point -
+ now works in GNU Emacs 21.2.1
+
+ * swank.lisp (swank-compiler): new function abstracts commonality
+ between swank-compile-{file, string}.
+ (swank-load-system): call swank-compiler to load asdf system
+
+ * swank-sbcl.lisp (compiler-note-location and elsewhere):
+ remove all trace of *compile-filename*
+ (compile-*-for-emacs): shorten
+
+ * swank-backend.lisp (call-with-compilation-hooks): new GF
+ should set up all appropriate error condition loggers etc
+ to do a compilation preserving the notes. Implement for
+ sbcl, cmucl
+
+ * slime.el (slime-find-asd, slime-load-system): new command
+ to compile and load an ASDF system with all the usual compiler
+ notes and stuff
+ (slime-compilation-finished): if more than one file has new
+ errors/notes, create an xref buffer to show them all
+ (slime-remove-old-overlays): bug fix: now removes overlays even
+ at start of buffer
+ (slime-overlay-note): do nothing quietly if
+ slime-choose-overlay-region returns nil
+ (slime-choose-overlay-region): return nil if note has no location
+
+2003-12-11 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-repl-previous-prompt, slime-repl-next-prompt):
+ New commands. Suggested by H�kon Alstadheim.
+ (slime-repl-beginning-of-defun, slime-repl-end-of-defun): New
+ commands. Suggested by Andreas Fuchs.
+ (slime-repl-insert-prompt): Mark the prompt with a
+ slime-repl-prompt text property.
+ (slime-repl-eol): New function. Mostly for symmetry.
+ (slime-repl-in-input-area-p, slime-repl-at-prompt-end-p): New
+ predicates.
+ (slime-repl-find-prompt, slime-search-property-change-fn): New
+ functions.
+ (slime-ir1-expand): New command.
+
+ * swank-cmucl.lisp (accept-connection, request-loop): Don't use
+ fd-handlers. The code for the request-loop itself is now almost
+ the same as in the Allegro version.
+ (print-ir1-converted-blocks, expand-ir1-top-level): New functions.
+
+2003-12-10 Daniel Barlow <dan(a)telent.net>
+
+ * swank-sbcl.lisp (serve-request): more fiddling with serve-event
+ descriptors
+
+ * slime.el (slime-repl-return): slime-check-connected, otherwise
+ pressing Return in an unconnected repl gets a bit weird
+
+2003-12-10 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-allegro.lisp, swank-lispworks.lisp, swank-openmcl.lisp,
+ swank-sbcl.lisp (create-swank-server): Accept an announce-function
+ keyword argument.
+
+ * swank.lisp (start-server): Pass an announce callback function to
+ create-swank-server. Works better with single threaded
+ implementations.
+ (announce-server-port, simple-announce-function): New functions.
+ (alistify): Doc fix.
+
+ * swank-cmucl.lisp (create-swank-server): Use announce callback.
+ (sldb-disassemble): New function.
+
+ * slime.el (sldb-disassemble): New command. Bound to D.
+
+2003-12-08 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-cmucl.lisp (*debug-definition-finding*): Now nil by
+ default, so that errors while looking for definitions are printed
+ as a message and not debugged.
+
+ * slime.el (slime-read-from-minibuffer): Now the only
+ completing-read function, stale ones deleted.
+
+2003-12-07 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (sldb-prune-initial-frames): Use regexp-heuristics and
+ the '--more--' token to avoid showing the user Swank-internal
+ backtrace frames initially.
+ (slime-repl-current-input): Don't include the final newline
+ character, to make backtraces prettier.
+ (slime-autodoc): Fixed annoying case where autodocs would be
+ fetched in a loop for undocumented symbols.
+
+ * swank.lisp (compound-prefix-match): New name and rewritten for
+ speed. Completion is much faster now.
+ (*sldb-initial-frames*): Send up to this many (default 20)
+ backtrace frames to Emacs when entering the debugger.
+
+2003-12-07 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-allegro.lisp, swank-backend.lisp, swank-cmucl.lisp,
+ swank-lispworks.lisp, swank-openmcl.lisp, swank-sbcl.lisp
+ (function-source-locations): Make it at generic function.
+ (function-source-location-for-emacs): Removed. Fixes bug reported
+ by Marco Baringer.
+
+ * slime.el (slime-interactive-eval): Insert the result at point,
+ if called with prefix argument.
+
+2003-12-06 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-easy-menu): Added menubar support, contributed
+ by Friedrich Dominicus.
+
+2003-12-06 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-allegro.lisp: New file.
+
+ * swank-loader.lisp (user-init-file): Translate logical
+ pathnames. Reported by Friedrich Dominicus.
+
+ * swank-sbcl.lisp (handle-notification-condition): Don't ignore
+ warnings without context.
+ (compiler-note-location, brief-compiler-message-for-emacs,
+ compiler-note-location): Handle null context.
+ (compile-file-for-emacs): Bind *compile-filename* and load the
+ fasl file only if it exists.
+ (function-source-location): The name argument is now optional and
+ should be a symbol.
+ (find-function-locations): Return errors as a list of one error.
+ (call-with-debugging-environment): Set *print-level* to 4 and
+ *print-length* to 10. (Both where nil.)
+ (source-location-for-emacs): Fall back to the location of the
+ function, if there is no debug-block-info.
+ (safe-source-location-for-emacs): Don't catch all conditions; only
+ errors.
+ *compile-filename*: New variable
+ (open-listener): Don't make the socket non-blocking.
+
+ * slime.el (slime-eval/compile-defun-dwim): New command.
+ Suggested by "jan" <janmar(a)iprimus.com.au>.
+
+2003-12-04 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-debugging-state): Don't set sldb-level after
+ sldb-setup. Breaks the test-suite.
+ (slime-eval-defun): Fix typos.
+ (slime-xref-buffer, slime-goto-next-xref): Updated for the new
+ xref code.
+ (sldb-inspect-in-frame): Query with the sexp at point as initial
+ value.
+ (sldb-step): New command. Bound to s.
+
+ * swank-cmucl.lisp (format-frame-for-emacs, compute-backtrace,
+ backtrace): Don't send CMUCL's frame numbers to Emacs, use our own
+ numbering.
+ (set-step-breakpoints, sldb-step): Lisp side of sldb-step command.
+
+2003-12-04 Luke Gorrie <luke(a)bluetail.com>
+
+ * hyperspec.el: Updated URL to point to a live copy of the
+ hyperspec at lispworks.com, because the one on xanalys.com has
+ disappeared. Patch from Vincent Arkesteijn on the ilisp-devel
+ mailing list.
+
+2003-12-04 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-lispworks.lisp (toggle-trace-fdefinition, tracedp): New
+ support functions for toggle-trace command. Written by Alain
+ Picard.
+ (compile-from-temp-file): Don't delete the binary file if there is
+ none.
+ (lispworks-severity): Map all ERRORs to :error.
+
+ * slime.el (slime-eval-defun): Use slime-re-evaluate-defvar if the
+ defun starts with "defvar". C-M-x in elisp does this too.
+ (slime-re-evaluate-defvar): Take the form as argument.
+
+2003-12-03 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-debugging-state): Initialize the sldb-buffer if
+ (/= sldb-level level).
+ (slime-who-specializes): New command.
+
+ * swank-cmucl.lisp (create-swank-server): Set reuse-address to t
+ by default.
+ (resolve-note-location): Add method for warnings in interpreted
+ code.
+ (who-specializes): New function.
+ (dd-source-location): Handle case without constructors more
+ correctly.
+ (source-path-source-position): Skip ambigous entries in
+ source-map.
+ (source-location-from-code-location): Simplified.
+
+2003-12-03 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-completing-read-internal): Fix from Sean
+ O'Rourke.
+
+2003-12-02 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-sbcl.lisp (find-function-locations): Return a non-empty
+ list of source locations.
+
+ * slime.el (slime-with-xref-buffer): Remove spurious comma. (Bug
+ reported by Raymond Wiker). Some reordering of the xref code.
+
+ * swank.lisp (documentation-symbol): New optional argument for
+ return value if the symbol is not documented.
+
+2003-12-02 Sean O'Rourke <sorourke(a)cs.ucsd.edu>
+
+ * slime.el: (slime-repl-{clear-buffer,clear-output}): clear the
+ last and entire output in the *slime-repl* buffer
+ (slime-documentation): pop up a buffer with a symbol's
+ documentation instead of its description, if found.
+ (slime-complete-symbol): tweak the completion, taken from ilisp, to
+ complete filenames inside strings.
+ (slime-set-default-directory): also set *slime-repl*'s
+ default-directory, so e.g. find-file makes sense.
+
+2003-12-02 Daniel Barlow <dan(a)telent.net>
+
+ * slime.el (slime-with-xref-buffer): moved further up the file so
+ it's defined before slime-show-xrefs needs it
+
+ * swank-sbcl.lisp (function-source-location-for-emacs): return a
+ list of source locations (one per method) when the request is
+ for a GF. This seems to make the elisp side popup a window
+ to let the user select one. Cool.
+
+2003-12-01 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-[cmucl,sbcl,openmcl,lispworks].lisp (invoke-nth-restart):
+ Use invoke-restart-interactively.
+
+ * slime.el (slime-create-note-overlay, slime-sexp-depth): The
+ 'priority' property is unused. Remove it.
+
+ * swank-openmcl.lisp (find-function-locations): Return all methods
+ for generic functions. Doesn't work very well if multiple methods
+ are in the same file.
+ (swank-accept-connection): Don't create an extra thread, call
+ request-loop directly.
+
+2003-12-01 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-repl-return): Goto end of input area before
+ inserting newline.
+ (slime-autodoc-message-ok-p): Test to see if a documentation
+ message should be printed (returns nil if the
+ minibuffer/echo-area is already being used).
+ (slime-symbol-at-point): Skip back over whitespace before
+ looking for the symbol.
+ (slime-autodoc-delay): New configurable to specify the delay
+ before printing an autodoc message (default 0.2 secs).
+ (slime-ensure-typeout-frame): New function to call create a
+ typeout frame unless it already exists. Suitable to run on
+ slime-mode-hook if you always want to have a typeout window.
+ (slime-log-events): When nil, don't log events to
+ *slime-events*. This works-around a problem Raymond Toy has when
+ starting SLIME under XEmacs. Still investigating..
+
+2003-11-29 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Rewrite the xref code to work with other source
+ locations.
+ (slime-edit-fdefinition): Use the xref window to display generic
+ functions with methods.
+ (slime-goto-source-location): New representation for source
+ locations. Drop old code.
+ (slime-list-callers, slime-list-callees): Use the xref window.
+ Remove the slime-select-* stuff.
+ (slime-describe-function): New command. Bound to C-c C-f.
+ Primarily useful in Lispworks.
+ (slime-complete-symbol): Display the completion window if the
+ prefix is complete but not unique.
+ (slime-forward-positioned-source-path): Enter the sexp only if the
+ remaining sourcepath is not empty.
+ (slime-read-symbol-name): New optional argument QUERY forces
+ querying.
+
+ * swank.lisp (group-xrefs): Handle unresolved source locations.
+ (describe-symbol): Print something sensible about unknown symbols.
+
+ * swank-cmucl.lisp: Use the new format for source locations.
+ (find-function-locations): New function. Replaces
+ function-source-location-for-emacs. Returns a list of
+ source-locations.
+ (resolve-note-location): Renamed from resolve-location.
+ Simplified.
+ (brief-compiler-message-for-emacs): Print the source context
+ (that's the thing after ==>).
+ (who-xxxx): Take strings, not symbols, as arguments.
+ (function-callees, function-callers): Use the same format as the
+ who-xxx functions. Support for byte-compiled stuff.
+ (code-location-stream-position): Try to be clever is the source
+ path doesn't match the form.
+ (call-with-debugging-environment): Bind *print-readably* to nil.
+
+ * swank-lispworks.lisp: Use the new format for source
+ locations. Implement the find-function-locations.
+ (list-callers, list-callers): New functions.
+
+ * swank-sbcl.lisp, swank-openmcl.lisp: Use the new format for
+ source locations and implement find-function-locations (just calls
+ the old code).
+
+2003-11-29 Daniel Barlow <dan(a)telent.net>
+
+ * swank-sbcl.lisp (source-location-for-emacs):
+ sb-debug::print-description-to-string takes only two args, not
+ three. Now 'v' command works in sldb :-)
+
+ * slime.el (slime-idle-state): added :debug as a valid transition
+
+ * swank.lisp (slime-debugger-function): New. Returns a function
+ suitable for use as the value of *DEBUGGER-HOOK* to install the
+ SLIME debugger globally. Must be run from the *slime-repl* buffer
+ or somewhere else that the slime streams are visible so that it
+ can capture them. e.g. for Araneida:
+ PKG> (setf araneida:*restart-on-handler-errors*
+ (swank:slime-debugger-fucntion))
+
+2003-11-29 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Some tweaking to the REPL. slime-repl-input-end-mark
+ is now always left inserting and slime-mark-input-end
+ "deactivates" the end mark by moving it to the beginning of the
+ buffer.
+ (slime-goto-source-location): Next try for more uniform
+ source-locations. A source-location is now a structure with a
+ "buffer-designator" and "position-designator". The buffer-designator
+ open the file or buffer and the position-designator moves point to the
+ right position.
+ (slime-autodoc-mode): New command.
+ (slime-find-fdefinitions): Experimental support for generic functions
+ with methods.
+ (slime-show-xrefs, slime-insert-xrefs, slime-goto-xref): Rewritten to
+ work with more general source locations.
+
+ * swank.lisp: Structure definitions for source-locations.
+ (alistify, location-position<, group-xrefs): Utilities for xref
+ support.
+
+ * swank-cmucl.lisp (code-location-source-location): Renamed from
+ safe-source-location-for-emacs.
+ (code-location-from-source-location): Renamed from
+ source-location-for-emacs.
+ (find-fdefinitions, function-source-locations): New functions.
+ (safe-definition-finding): New macro.
+
+ * swank-lispworks.lisp: Xref support.
+ (make-dspec-location): Updated for the new source-location format.
+
+2003-11-29 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (complete-symbol, arglist): Updated test cases for new
+ completion interface.
+
+2003-11-28 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-complete-symbol): Use the new completion
+ support from the Lisp side. Don't obscure minibuffer input with
+ completion messages.
+
+ * completer.el: Dead and buried! Replaced by half a page of Common
+ Lisp. Thanks Bill Clementson for a motivational and well-deserved
+ taunt.
+
+ * swank.lisp (longest-completion): Compute the best partial
+ completion for Emacs.
+
+ * slime.el (slime-swank-port-file): Try (temp-directory),
+ temporary-file-directory, or "/tmp/", depending on what
+ is (f)bound.
+
+2003-11-28 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-lispworks.lisp (make-dspec-location): Handle logical
+ pathnames. Reported by Alain Picard.
+
+ * swank-sbcl.lisp, swank-cmucl.lisp: Support for output
+ redirection to an Emacs buffer via a dedicated network stream.
+ Can be enabled with *use-dedicated-output-stream*.
+
+ * swank.lisp (slime-read-string, eval-string): Flush *emacs-io*.
+ (eval-in-emacs): New function.
+
+ * slime.el: Support for output from a dedicated socket.
+ (slime-open-stream-to-lisp, slime-output-filter): New functions.
+ Reorganized REPL code a bit.
+ (slime-input-complete-p): Use vanilla forward-sexp, because
+ slime-forward-sexp sometimes caused endless loops.
+ (slime-disconnect): Close the output-stream-connection if present.
+ (slime-handle-oob): A new :%apply event. Executes arbitrary code;
+ useful for bootstrapping.
+ (slime-flush-output): New function.
+ (slime-symbol-end-pos): Didn't work at all in Emacs20. Just use
+ point until someone commits a proper fix.
+ Various uses of display-buffer: The second argument is different in
+ XEmacs.
+ (interrupt-bubbling-idiot): Reduce the timeout to 5 seconds.
+
+2003-11-27 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-swank-port-file): Use `temporary-file-directory'
+ instead of hardcoding "/tmp/".
+
+2003-11-27 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-lispworks.lisp: New backend.
+
+ * slime.el (slime-with-output-to-temp-buffer): Save the window
+ configuration in a buffer local variable instead on a global
+ stack.
+ (slime-show-last-output): Behavior customizable with
+ slime-show-last-output-function. Various tweaking for better
+ multi-frame support.
+
+ * swank-backend.lisp: List exported symbols explicitly.
+
+ * swank-cmucl.lisp (function-source-location): Better support for
+ generic functions.
+
+ * swank.lisp (briefly-describe-symbol-for-emacs): Don't return
+ unbound symbols.
+ (describe-symbol, describe-function): Support package-qualified
+ strings.
+
+ * swank-loader.lisp: *sysdep-pathnames*: Add Lispworks files.
+ (compile-files-if-needed-serially): Compile all files in a
+ compilation unit.
+
+2003-11-27 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-complete-symbol): Make a bogus alist out of the
+ completion set, for compatibility with XEmacs.
+
+ * completer.el: Stolen^Wimported from ILISP version 1.4. This is
+ one revision prior to their latest, where they added a (require)
+ for some other ILISP code. I backed down a revision to make it
+ stand-alone, but this may mean that putting SLIME in the load-path
+ before ILISP will break ILISP. So, beware.
+ (completer-message): Cut dependency on undefined ilisp constant
+ testing for xemacs.
+
+2003-11-27 Zach Beane <xach(a)xach.com>
+
+ * swank.lisp (completions): Complete compound symbols (see below).
+
+ * slime.el (slime-complete-symbol): Use `completer' package to
+ handle more sophisticated completions. This includes abbreviations
+ like "m-v-b" => "multiple-value-bind". It also (somewhat scarily)
+ redefines other standard Emacs completion functions with similar
+ capabilities. See commentary in completer.erl for details.
+
+2003-11-25 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-make-typeout-frame): New command to create a
+ frame where commands can print messages that would otherwise go to
+ the echo area.
+ (slime-background-message): Function for printing "background"
+ messages. Uses the "typeout-frame" if it exists.
+ (slime-arglist): Print arglist with `slime-background-message'.
+ (slime-message): Use typeout frame if it exists, but only for
+ multi-line messages.
+
+2003-11-25 Daniel Barlow <dan(a)telent.net>
+
+ * swank-sbcl.lisp: delete big chunk of leftover commented-out
+ code
+
+ * slime.el: arglist command to use slime-read-symbol-name,
+ not slime-read-symbol
+
+ * README: Minor updates for currency
+
+2003-11-24 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-backend.lisp (compiler-condition): Removed use of
+ :documentation slot option. That is not portable (to CMUCL 18e).
+
+ * swank.lisp (eval-string-in-frame): Fixed symbol-visibility
+ problem (thanks Lawrence Mitchell).
+
+ * swank-sbcl.lisp (function-source-location): Use TRUENAME to
+ resolve source file name (thanks Lawrence Mitchell).
+
+ * slime.el (slime-goto-source-location): Fixes when finding
+ definition by regexp: open the right file (was missed), and
+ tweaked regexp to match more 'def' forms - especially
+ `defmacro-mundanely' (hyphen wasn't allowed before).
+
+2003-11-23 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (sldb-fetch-more-frames): Call swank:backtrace instead
+ of (renamed) swank:backtrace-for-emacs.
+
+ * swank-cmucl.lisp, swank-sbcl.lisp, swank-openmcl-lisp: Updated
+ to use new debugger interfaces in swank-backend.lisp.
+
+ * swank-backend.lisp (backtrace, eval-in-frame, frame-catch-tags,
+ frame-locals, frame-source-location-for-emacs): More interface
+ functions.
+
+ * slime.el (slime-goto-source-location): Added optional `align-p'
+ argument for :file and :emacs-buffer location types. This is for
+ OpenMCL - unlike CMUCL its positions are not character-accurate so
+ it needs to be aligned to the beginning of the sexp.
+ (slime-connect): Don't delete a random window when *inferior-lisp*
+ isn't visible.
+
+ * swank-cmucl.lisp: Tidied up outline-minor-mode structure and
+ added comments and docstrings.
+
+ * swank-cmucl.lisp, swank-sbcl.lisp, swank-openmcl-lisp: Updated
+ to use new debugger interface in swank-backend.lisp.
+
+ * swank-backend.lisp (call-with-debugging-environment,
+ sldb-condition, debugger-info-for-emacs): More callbacks defined.
+
+ * swank.lisp: Tidied up outline-minor-mode structure, added
+ comments and docstrings.
+ (sldb-loop): Took over the main debugger loop.
+
+ * swank-openmcl.lisp: Updated after refactoring of other backends
+ (was broken).
+
+ * slime.el (slime-goto-source-location): Align at beginning of
+ sexp after (:file name pos) and (:emacs-buffer buffer pos).
+
+ * swank-sbcl.lisp (describe-symbol-for-emacs): Don't ask for
+ (documentation SYM 'class), CLHS says there isn't any 'class
+ documentation (and SBCL warns).
+
+ * swank.lisp, swank-cmucl.lisp, swank-sbcl.lisp: Refactored
+ interface through swank-backend.lisp for: swank-compile-file,
+ swank-compile-string, describe-symbol-for-emacs (apropos),
+ macroexpand-all, arglist-string.
+
+ * swank-backend.lisp: New file defining the interface between
+ swank.lisp and the swank-*.lisp implementation files.
+
+2003-11-22 Brian Mastenbrook <bmastenb(a)cs.indiana.edu>
+
+ * swank.asd: ASDF definition to load "swank-loader.lisp". This is
+ useful for starting the Swank server in a separate Lisp and later
+ connecting with Emacs. The file includes commentary.
+
+2003-11-22 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-connect): Slightly reordered some window
+ operations to ensure that *slime-repl* is popped up after `M-x
+ slime-connect'.
+ (slime-show-last-output): If the *slime-repl* buffer is already
+ visible in any frame, don't change anything.
+
+ * swank.lisp (listener-eval): Format results in *buffer-package*.
+ Exporting (CREATE-SWANK-SERVER <port>). This function can be
+ called directly to start a swank server, which you can then
+ connect to with `M-x slime-connect'. It takes a port number as
+ argument, but this can be zero to use a random available port.
+ The function always returns the actual port number being used.
+
+2003-11-19 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp: Better printing off return values. In the REPL
+ buffer we print now every value in a separate line and in the echo
+ area separated by a comma. We also print "; No value" for the
+ degenerated case (values). A new variable *sldb-pprint-frames*
+ controls the printing of frames in the debugger. (Thanks Raymond
+ Toy for the suggestions.)
+
+ * swank-cmucl.lisp (format-frame-for-emacs): Bind *pretty-print*
+ to *sldb-pprint-frames*.
+
+ * slime.el: Window configuration are now saved on a stack, not in
+ a single global variable.
+ (slime-with-output-to-temp-buffer) We use now our own version of
+ with-output-to-temp-buffer. The default version is painfully
+ incompatible between Emacs versions. The version selects the
+ temporary buffer and the behaivor of "q" is now more consistent
+ (as suggested by Jan Rychter).
+ (slime-connect): Hide the *inferior-lisp-buffer* when we are
+ connected.
+ sldb-mode-map: Bind n and p to sldb-down and sldb-up.
+ (slime-edit-fdefinition-other-window): New function. Suggested by
+ Christian Lynbech.
+
+ * swank-loader.lisp (user-init-file): There is now a user init
+ file (~/.swank.lisp). It is loaded after the other files.
+
+2003-11-16 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: [slime-keys] Override C-c C-r with slime-eval-region
+ (reported by Paolo Amoroso).
+
+ * swank-loader.lisp: Compile and load gray stream stuff for SBCL
+ and OpenMCL.
+
+ * swank-openmcl.lisp, swank-sbcl.lisp: Import gray stream symbols.
+ (without-interrupts*): New function.
+
+ * swank.lisp (send-to-emacs): Protect the write operations by a
+ without-interrupts, so that we don't trash the *cl-connection*
+ buffer with partially written messages.
+
+ * swank-cmucl.lisp (without-interrupts*): New function.
+
+ * swank-gray.lisp (stream-write-char): Don't flush the buffer on
+ newlines.
+
+ * slime.el: Add some docstring.
+ (interrupt-bubbling-idiot): New test.
+ [slime-keys]: Don't bind "\C- ". Problematic on LinuxPPC.
+
+2003-11-15 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Some tweaking for better scrolling in the *slime-repl*
+ buffer (suggested by Jan Rychter).
+ (slime-compile-file): Display the output buffer at the beginning.
+ (slime-show-last-output): Include the prompt so that window-point
+ is updated properly.
+ (slime-with-output-at-eob): Update window-point if the buffer is
+ visible.
+ (slime-state/event-panic): Include the *slime-events* and
+ *cl-connection* buffers in the report.
+
+ * swank-cmucl.lisp (sos/out): Don't flush the buffer on newlines.
+
+2003-11-13 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Imititate an "output-mark". Output from Lisp should
+ move point only if point is at the end of the buffer. (Thanks
+ William Halliburton for the suggestion.)
+ (slime-with-output-at-eob): New function.
+ (slime-output-string, slime-repl-maybe-prompt): Use it.
+
+ slime-repl-mode-map: Override "\C-\M-x".
+
+ An experimental scratch buffer:
+ (slime-eval-print-last-expression): New function.
+ (slime-scratch-mode-map, slime-scratch-buffer,
+ slime-switch-to-scratch-buffer, slime-scratch): New functions.
+
+ * swank-cmucl.lisp (resolve-location): Emacs buffer positions are
+ 1 based. Add 1 to the 0 based file-position.
+
+2003-11-13 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-connect): pop-to-buffer into *slime-repl* when
+ we connect.
+
+2003-11-13 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el, swank-cmucl.lisp, swank-sbcl.lisp, swank-openmcl: New
+ representation for "source-locations". Compiler notes have now a
+ message, a severity, and a source-location field. Compiler notes,
+ edit-definition, and the debugger all use now the same
+ representation for source-location. CMUCL does the source-path to
+ file-position translation at the Lisp side. This works better
+ with reader macros, in particular with backquote. The SBCL
+ backend still does the translation on the Emacs side. OpenMCL
+ support is probably totally broken at the moment
+
+2003-11-13 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-repl-previous-input, slime-repl-next-input):
+ When partial input has already been entered, the M-{p,n} REPL
+ history commands only match lines that start with the
+ already-entered prefix. This is comint-compatible behaviour which
+ has been requested. The history commands also skip over line
+ identical to the one already entered.
+ (slime-complete-maybe-restore-window-confguration): Catch errors,
+ so that we don't cause `pre-command-hook' to be killed.
+ (slime-truncate-lines): If you set this to nil, slime won't set
+ `truncate-lines' in buffers like sldb, apropos, etc.
+
+2003-11-12 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-show-description): XEmacs portability: don't use
+ `temp-buffer-show-hook'.
+ (slime-inspect): Use `(slime-sexp-at-point)' as default inspection
+ value (thanks Jan Rychter).
+
+2003-11-10 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-post-command-hook): Inhibit unless (still) in
+ slime-mode. Only call `slime-autodoc-post-command-hook' when
+ `slime-autodoc-mode' is non-nil.
+ (slime-setup-command-hooks): Use `make-local-hook' instead of
+ `make-local-variable'.
+
+2003-11-08 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: slime-highlight-face: Use the :inherit attribute if
+ possible.
+ (slime-face-inheritance-possible-p): New function.
+
+ * slime.el (slime-repl-return): Only send the current input to
+ Lisp if it is a complete expression, like inferior-slime-return.
+
+ * swank.lisp (completions): Use *buffer-package* if no other
+ package is given.
+
+ * slime.el: Remove the non-working face inheriting stuff.
+ Hardcode colors for slime-highlight-face and specify the :inherit
+ attribute for slime-repl-output-face. So Emacs21 will do the
+ right thing and the others get at least a customizable face.
+
+ * slime.el (slime-buffer-package): Try to find be the
+ package name before resorting to slime-buffer-package. Return nil
+ and not "CL-USER" if the package cannot be determined.
+ (slime-goto-location): Insert notes with a source path, but
+ without filename or buffername, at point. This can happen for
+ warnings during macro expansion. (The macro expander is a
+ interpreted function and doesn't have a filename or buffername.)
+ (slime-show-note): Display 2 double quotes "" in the echo area for
+ zero length messages. SERIES tends to signal warnings with zero
+ length messages.
+ (slime-print-apropos): Add support for alien types.
+
+ * swank-cmucl.lisp (briefly-describe-symbol-for-emacs): Add
+ support for alien types.
+ (source-path-file-position): Read the entire expression with a
+ special readtable. The readtable records source positions for
+ each sub-expression in a hashtable. Extract the sub-expression
+ for the source path from the read object and lookup the
+ sub-expression in the hashtable to find its source position.
+
+ * swank-sbcl.lisp (swank-macroexpand-all): Implemented.
+
+2003-11-06 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-autodoc-mode): When non-nil, display the
+ argument list for the function-call near point each time the point
+ moves in a slime-mode buffer. This is a first-cut; more useful
+ context-sensitive help to follow (e.g. looking up variable
+ documentation).
+ (slime-autodoc-cache-type): Cache policy "autodoc" documentation:
+ either nil (no caching), 'last (the default - cache most recent
+ only), or 'all (cache everything on symbol plists forever).
+
+ * slime.el: Convenience macros:
+ (when-bind (var exp) &rest body)
+ => (let ((var exp)) (when var . body))
+ (with-lexical-bindings (var1 ...) . body)
+ => (lexical-let ((var1 var1) ...) . body)
+
+ * slime.el (slime, slime-lisp-package): Reset `slime-lisp-package'
+ (the REPL package) when reconnecting.
+ (slime-buffer-package): Return `slime-lisp-package' when the
+ major-mode is `slime-repl-mode'.
+
+2003-11-04 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-read-string-state): Add support for evaluation
+ requests.
+ (slime-repl-read-break): New command.
+ alternative.
+ slime-keys: XEmacs cannot rebind C-c C-g. Use C-c C-b as an
+ alternative.
+ (slime-selector): XEmacs has no prompt argument for read-char.
+ (slime-underline-color, slime-face-attributes): Make face
+ definitions compatible with XEmacs and Emacs20.
+ (slime-disconnect): Delete the buffer of the socket.
+ (slime-net-connect): Prefix the connection buffer name with a
+ space to avoid accidental deletion.
+
+ * swank.lisp (slime-read-string): Send a :read-aborted event for
+ non-local exits.
+ (case-convert): Handle :invert case better.
+
+2003-11-03 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-display-message-or-view,
+ slime-remove-message-window): Display too long lines in a new
+ window. Add a temporary pre-command-hook to remove the multiline
+ window before the next command is executed.
+
+ (slime-complete-symbol): Save the window configuration before
+ displaying the completions and try to restore it later. The
+ configuration is restored when: (a) the completion is unique (b) there
+ are no completion. It is also possible to delay the restoration until
+ (c) certain characters, e.g, space or a closing paren, are inserted.
+
+ (slime-selector): Don't abort when an unkown character is pressed;
+ display a message and continue. Similiar for ?\?. Add a selector for
+ the *sldb* buffer.
+
+ (slbd-hook, sldb-xemacs-post-command-hook): Emulate Emacs'
+ point-entered text property with a post-command hook.
+
+ * swank.lisp (case-convert, find-symbol-designator): New
+ functions.
+
+ * swank-cmucl.lisp, swank-openmcl.lisp, swank-sbcl.lisp
+ (arglist-string): Don't intern the function name. Use
+ find-symbol-designator instead.
+
+2003-11-03 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-display-buffer-region): Hacked to fix completely
+ inexplicable XEmacs problems.
+
+2003-11-2 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * null-swank-impl.lisp, swank-cmucl.lisp, swank-openmcl.lisp,
+ swank.lisp: Input redirection works now on the line level, like a
+ tty. Output streams are now line buffered. We no longer compute
+ the backtrace-length.
+
+ * slime.el:
+ (slime-repl-read-mode, slime-repl-read-string, slime-repl-return,
+ slime-repl-send-string, slime-read-string-state,
+ slime-activate-state): Reorganize input redirection. We no longer
+ work on the character level but on a line or region; more like a
+ terminal. This works better, because REPLs and debuggers are
+ usually written with a line buffering tty in mind.
+ (sldb-backtrace-length, slime-debugging-state,
+ slime-evaluating-state, sldb-setup, sldb-mode, sldb-insert-frames,
+ sldb-fetch-more-frames): Don't use backtrace-length. Computing
+ the length of the backtrace is (somewhat strangely) an expensive
+ operation in CMUCL, e.g., it takes >30 seconds to compute the
+ length when the yellow zone stack guard is hit.
+
+2003-11-02 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-log-event): Added a *slime-events* buffer
+ recording all state machine events. The buffer uses hideshow-mode
+ to fold messages down to single lines.
+ (slime-show-source-location): Bugfix: only create source-highlight
+ overlay if the source was actually located.
+ (slime-selector): Renamed from `slime-select' because that
+ function name was already in use. Ooops!
+
+ * swank.lisp (eval-string): force-output on *slime-output* before
+ returning the result. This somewhat works around some trouble
+ where output printed by lisp is being buffered too long.
+
+ * slime.el (slime-lisp-package-translations): Association list of
+ preferred package nicknames, for the REPL prompt. By default maps
+ COMMON-LISP->CL and COMMON-LISP-USER->CL-USER.
+
+2003-11-01 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-select): Added an extensible "Select" command,
+ which I gather is a LispM/Martin-Cracauer knock-off. When invoked,
+ the select command reads a single character and uses that to
+ decide which buffer to switch to. New characters can be defined,
+ and the currently availables ones can be seen with '?'. I have not
+ assigned a key to Select, because it seems like a command that
+ should have a global binding. I would suggest `C-c s'.
+
+ * swank.lisp (*slime-features*): Variable remembering the FEATURES
+ list.
+ (sync-state-to-emacs): Update Emacs about any state changes -
+ currently this just means changes to the FEATURES list.
+ (eval-string): Call `sync-state-to-emacs' before sending result.
+ (eval-region): With optional PACKAGE-UPDATE-P, if the evaluation
+ changes the current package, tell Emacs about the new package.
+ (listener-eval): Tell `eval-region' to notify Emacs of package
+ changes, so that e.g. (in-package :swank) does the right thing
+ when evaluated in the REPL.
+
+ * slime.el (slime-repl-output-face, slime-repl-input-face): Face
+ definitions for output printed by Lisp and for previous REPL user
+ inputs, respectively. Defaulting the input face to bold rather
+ than underline, because it looks better on multi-line input.
+ (slime-handle-oob): Two new out-of-band messages
+ (:new-features FEATURES) and (:new-package PACKAGE-NAME). These
+ are used for Lisp to tell Emacs about changes to *FEATURES* and
+ *PACKAGE* when appropriate.
+ (slime-same-line-p): Better implementation (does what the name
+ suggests).
+ (slime-lisp-package): New variable keeping track of *PACKAGE* in
+ Lisp -- or at least, the package to use for the REPL.
+ (slime-repl-insert-prompt): The prompt now includes the package
+ name.
+ (slime-repl-bol): C-a in the REPL now stops at the prompt.
+ (slime-repl-closing-return): C-RET & C-M-m now close all open
+ lists and then send input in REPL.
+ (slime-repl-newline-and-indent): C-j in REPL is now better with
+ indentation (won't get confused by unmatched quotes etc appearing
+ before the prompt).
+
+2003-11-1 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-debugging-state): Save the window configuration
+ in a state variable.
+ sldb-saved-window-configuration: Removed.
+ (slime-repl-mode): Use conservative scrolling.
+ (slime-repl-insert-prompt): Set window-point after the prompt.
+ (slime-repl-add-to-input-history): Don't add subsequent duplicates to
+ the history.
+
+ * swank.lisp (slime-read-char): Flush the output before reading.
+ (listener-eval): Like eval region but set reader variables (*, **,
+ *** etc.)
+
+ * swank-openmcl.lisp, swank-sbcl.lisp: Implement stream-line-column.
+
+ * swank-cmucl.lisp (slime-input-stream-misc-ops): Renamed from
+ slime-input-stream-misc.
+
+2003-10-31 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-repl-mode-map): Bound `slime-interrupt' on both
+ C-c C-c and C-c C-g.
+
+ * swank.lisp (interactive-eval): Evaluate in *buffer-package*.
+
+ * slime.el: Tweaked debugger window management somewhat: the
+ window configuration is saved when the debugger is first entered
+ and then restored when the idle state is reached.
+
+2003-10-31 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: (slime-repl-read-mode, slime-repl-read-xxx): New minor
+ mode for stream character based input to Lisp.
+
+ * swank.lisp: *read-input-catch-tag*, take-input, slime-read-char:
+ Moved here from swank-cmucl.lisp.
+ (defslimefun, defslimefun-unimplemented): Move macro definitions to
+ the beginning of the file.
+
+ * swank-cmucl.lisp: (slime-input-stream, slime-input-stream-read-char,
+ lime-input-stream-misc): Character input stream from Emacs.
+ (slime-input-stream/n-bin): Removed.
+
+ * swank-openmcl.lisp, swank-sbcl.lisp: Gray stream based input
+ redirection from Emacs.
+
+2003-10-29 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el:
+ Beginnings of a REPL-mode.
+ Minor debugger cleanups.
+
+ * swank.lisp:
+ slime-read-error: New condition.
+ (read-next-form): Re-signal the conditions as slime-read-errors. And
+ check the result of read-sequence (i.e. detect CMUCL's read-sequence
+ bug).
+ (sldb-continue, throw-to-toplevel): Was more or less the same in all
+ backends.
+
+ * swank-openmcl.lisp, swank-sbcl.lisp, swank-cmucl.lisp:
+ (serve-request): Handle slime-read-errors and bind a
+ slime-toplevel catcher.
+
+ * swank-cmucl.lisp:
+ (sldb-loop): Flush output at the beginning.
+ (inspect-in-frame): New function.
+ (frame-locals): Don't send the validity indicator across wire. Too
+ cmucl specific.
+
+2003-10-29 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-net-sentinel): Only show a message about
+ disconnection if the inferior-lisp is still running.
+ (slime-interrupt, slime-quit): Only send the quit/interrupt
+ message to Lisp if it is in fact evaluating something for us. This
+ fixes a protocol bug reported by Paolo Amoroso. Added (require
+ 'pp).
+
+2003-10-28 James Bielman <jamesjb(a)jamesjb.com>
+
+ * null-swank-impl.lisp: New file.
+
+ * swank-openmcl.lisp: Pre-refactoring updates to the OpenMCL backend:
+ (map-backtrace): Renamed from DO-BACKTRACE.
+ (frame-source-location-for-emacs): New function.
+ (function-source-location-for-emacs): New function,
+
+ * swank-openmcl.lisp: Docstring updates/additions.
+
+2003-10-25 Luke Gorrie <luke(a)bluetail.com>
+
+ * Everywhere: Changed the connection setup to use a dynamic
+ collision-free TCP port. The new protocol is this:
+
+ Emacs calls (swank:start-server FILENAME) via the
+ listener. FILENAME is /tmp/slime.${emacspid}
+ Lisp starts a TCP server on a dynamic available port and writes
+ the port number it gets to FILENAME.
+ Emacs asynchronously polls for FILENAME's creation. When it
+ exists, Emacs reads the port number, deletes the file, and makes
+ the connection.
+
+ The advantage is that you can run multiple Emacsen each with an
+ inferior lisp, and the port numbers will never collide and Emacs
+ will always connect to the right lisp.
+
+ All backends are updated, but only CMUCL and SBCL are
+ tested. Therefore, OpenMCL is almost certainly broken just now.
+
+ * slime.el (inferior-slime-closing-return): New command that
+ closes all open lists and sends the result to Lisp. Bound to C-RET
+ and (for people who use C-m for RET) C-M-m.
+ (inferior-slime-indent-line): Improved indentation in the inferior
+ list buffer.
+
+2003-10-24 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (inferior-slime-return): Command bound to RET in
+ inferior-slime-mode: only send the current input to Lisp if it is
+ a complete expression (or prefix argument is given). Two reasons:
+ it makes the input history contain complete expressions, and it
+ lets us nicely indent multiple-line inputs. (Thanks Raymond Toy
+ for the suggestions.)
+
+2003-10-23 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-maybe-start-lisp): Restart inferior-lisp if the
+ process has died.
+
+ * swank-sbcl.lisp (accept-connection): Use a character stream to
+ match swank.lisp.
+
+2003-10-22 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp (setup-request-handler): Create a character
+ stream.
+ (read-next-form): Removed.
+
+ * swank.lisp (read-next-form, send-to-emacs): Assume *emacs-io* is
+ a character stream. Add the necessary char-code/code-char
+ conversions.
+
+ * slime.el: slime-keys: Add :sldb keywords for keys useful in the
+ debugger.
+ (slime-init-keymaps): Allow allow :sldb keywords.
+
+ inferior-lisp-mode-hook: Display the inf-lisp buffer if there is
+ some output.
+
+ (slime-process-available-input): Start a timer to process any
+ remaining input.
+ (slime-dispatch-event): The timer should take care of any lost
+ input. So don't process the available input here. Remove the
+ process-input argument.
+ (slime-push-state, slime-pop-state, slime-activate-state,
+ slime-idle-state, slime-evaluating-state): Update callers.
+ (slime-debugging-state): Remove the unwind-protect in the
+ :debug-return clause. Should not be necessary.
+
+ sldb-mode-map: Define more slime-mode keys.
+
+ (slime-time<, slime-time-add): Removed. Emacs-21 has equivalent time
+ functions.
+ (slime-sync-state-stack): Use Emacs-21 time-date functions.
+ (seconds-to-time, time-less-p, time-add): Compatibility defuns.
+
+2003-10-22 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime): With a prefix argument, prompt for the port
+ number to use for communication with Lisp. This is remembered for
+ future connections.
+
+2003-10-22 Hannu Koivisto <azure(a)iki.fi>
+
+ * slime.el (slime-space): Now allows one to insert several spaces
+ with a prefix argument.
+
+2003-10-21 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-space): Don't give an error when not connected,
+ to avoid feeping.
+
+ * swank-sbcl.lisp (swank-compile-string): Include only one
+ :SOURCE-PATH attribute in the plist, and replace the front element
+ with a 0 (fixes a problem probably due to recent hacks to the
+ elisp source-path lookups).
+
+ * slime.el (inferior-slime-mode): New minor mode for use with
+ `inferior-lisp-mode'. Defines a subset of the `slime-mode' keys
+ which don't clash with comint (e.g. doesn't bind M-{p,n}).
+ (slime-keys): List of keybinding specifications.
+ (slime-find-buffer-package): If we don't find the "(in-package" by
+ searching backwards, then try forwards too.
+
+ * swank.lisp (completions): Fixed semantics: should now consider
+ only/all completions that would not cause a read-error due to
+ symbol visibility. Also avoiding duplicates and sorting on
+ symbol-name.
+
+2003-10-20 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (completions): Slight change of semantics: when a
+ prefix-designator is package-qualified, like "swank:", only match
+ symbols whose home-package matches the one given - ignore
+ inherited symbols.
+
+ * slime.el: Updated test suite to work with the different backends:
+ (find-definition): Lookup definitions in swank.lisp.
+ (arglist): Lookup arglists of functions in swank.lisp.
+
+2003-10-20 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (interactive-eval): Make test case independent of
+ *print-case*.
+
+2003-10-20 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank-cmucl.lisp (clear-xref-info): Conditionalised
+ xref:*who-is-called* and xref:*who-macroexpands* with
+ #+CMU19. This makes SLIME compatible with CMUCL 18e, but also
+ disables the `who-macroexpands' command in any CMUCL version that
+ doesn't have the "19A" feature (which does break the command in
+ some snapshot builds that can actually support it).
+
+2003-10-20 Daniel Barlow <dan(a)telent.net>
+
+ * swank.lisp (*notes-database*): tyop fix
+
+ * swank-sbcl.lisp (throw-to-toplevel): select TOPLEVEL restart
+ instead of throwing to a catch that no longer exists
+
+ * slime.el: change some strings containing 'CMUCL' to more
+ backend-agnostic phrases
+
+2003-10-19 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el, swank-cmucl.lisp, swank.lisp: First shoot at input
+ redirection.
+
+ * swank-sbcl.lisp, swank-openmcl.lisp: Bind *slime-input* and
+ *slime-io* to dummy values.
+
+2003-10-19 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime): Connection setup is now asynchronous, with
+ retrying on a timer. This makes it possible to bring the server up
+ by hand while debugging. `M-x slime' while already connected will
+ cause the old connection to be dropped and a new one established.
+ (slime-disconnect): New command to disconnect from Swank, or
+ cancel asynchronous connection attempts when not yet connected.
+ (slime-state/event-panic): Illegal events in the communication
+ state machine now trigger a general panic that disconnects from
+ Lisp, and displays a message describing what has happened. This is
+ a bug situation.
+ (slime-connect): Print a message during connection attempts unless
+ the minibuffer is active (it's annoying to get messages while
+ trying to enter commands).
+
+2003-10-18 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Fix some bugs in the state machine and be a bit more
+ careful when processing pending input.
+ (slime-compile-region): New command.
+ Some more tests.
+
+2003-10-17 James Bielman <jamesjb(a)jamesjb.com>
+
+ * .cvsignore: Add OpenMCL and SBCL fasl file extensions.
+
+ * swank-openmcl.lisp (who-calls): Fix bug where we would try to
+ take the TRUENAME of NIL when source information isn't available
+ for a caller.
+ (backtrace-for-emacs): Clean up the backtrace code a bit in
+ preparation for implementing FRAME-LOCALS.
+ (frame-catch-tags): Implement a stub version of this.
+ (frame-locals): Implemented fully for OpenMCL.
+
+ * swank-loader.lisp (compile-files-if-needed-serially): Be a little
+ more verbose when compiling files.
+
+2003-10-17 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp, swank-sbcl.lisp, swank-openmcl.lisp,
+ swank-cmucl.lisp: Move more stuff to swank.lisp.
+
+2003-10-17 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-post-command-hook): Check that we are connected
+ before trying to process input.
+ (slime-net-connect): Handle `network-error' condition for XEmacs
+ 21.5. (Thanks Raymond Toy.)
+
+ * swank-sbcl.lisp: Report style-warnings separately from notes
+ (patch from Christophe Rhodes). Use REQUIRE to load sb-introspect
+ instead of loading the source file (requires the sb-introspect
+ library to be installed, which doesn't yet happen in the
+ sourceforge-lagged SBCL anoncvs, but does in the real one).
+
+ * slime.el (slime-style-warning-face): Added style-warnings, which
+ are between a warning and a note in severity. (Patch from
+ Christophe Rhodes).
+
+ * test.sh: When the test fails to complete, print "crashed"
+ instead of reporting nonsense.
+
+2003-10-17 James Bielman <jamesjb(a)jamesjb.com>
+
+ * swank.lisp (apropos-symbols): Change back to using the standard
+ 2-argument APROPOS-LIST and check symbols explicitly when
+ EXTERNAL-ONLY is true.
+ Move loading of sys-dependent backend code into 'swank-loader'.
+
+ * swank-sbcl.lisp: Moved declarations of *PREVIOUS-COMPILER-CONDITION*
+ into 'swank.lisp' to kill warnings about undefined variables.
+
+ * swank-openmcl.lisp (handle-compiler-warning): Use source position
+ instead of function name for warning locations.
+ (swank-compile-string): Compile into a temporary file instead of
+ using COMPILE so finding warning positions works when using C-c C-c.
+ (compute-backtrace): Don't display frames without a function.
+ (apropos-list-for-emacs): Implement APROPOS.
+ (who-calls): Implement WHO-CALLS.
+ (completions): Implement COMPLETIONS.
+ Use NIL instead of zero so FRESH-LINE does the right thing.
+
+ * slime.el (slime-maybe-compile-swank): Removed function---compile
+ the backend using 'swank-loader.lisp' instead.
+ (slime-backend): Changed default backend to 'slime-loader'.
+ (slime-lisp-binary-extension): Deleted as this is no longer needed.
+
+ * swank-loader.lisp: New file.
+
+2003-10-17 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-net-connect): Check that
+ `set-process-coding-system' is fbound before calling it. This is
+ needed in the XEmacs I built from sources.
+
+2003-10-17 Daniel Barlow <dan(a)telent.net>
+
+ * swank-sbcl.lisp: Transplanted Helmut's serve-event server to
+ replace the existing thread-using server. SLIME now has no
+ dependency on SB-THREAD
+
+ * slime.el (slime-find-buffer-package): handle errors from (read)
+ for the case where the buffer ends before the in-package form does
+ (slime-set-package): insert missing comma
+ (slime-goto-source-location): sbcl has a disagreement with emacs
+ over the meaning of a character position. Level up with
+ C-M-f C-M-b
+
+ * assorted typo fixes
+
+2003-10-16 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-forward-source-path): Improved somewhat. Seems
+ to work for all common cases except backquote. Backquote is
+ tricky, because the source-paths are based on the reader's
+ expansion, e.g.:
+ * (let ((*print-pretty* nil))
+ (print (read-from-string "`(a ,@(b c) d)")))
+ -->
+ (COMMON-LISP::BACKQ-CONS (QUOTE A)
+ (COMMON-LISP::BACKQ-APPEND (B C)
+ (QUOTE (D))))
+ Must investigate whether we need to write a hairy
+ backquote-traversing state machine or whether this is something
+ that could be fixed in CMUCL.
+
+ * swank*.lisp (with-trapping-compiler-notes): This macro is now
+ defined here, and expands to a call to the backend-defined
+ `call-trapping-compiler-notes' with the body wrapped in a
+ lambda. This is to avoid swank.lisp referring to macros in the
+ backends -- it gets compiled first so it thinks they're functions.
+
+ * slime.el (slime-swank-connection-retries): New default value is
+ `nil', which means unlimited retries (until user aborts). Retry
+ interval also reduced from once per second to four times per
+ second.
+
+2003-10-16 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank-cmucl.lisp, swank.lisp: Fix CMUCL support.
+
+2003-10-15 Daniel Barlow <dan(a)telent.net>
+
+ * swank.lisp: rearrange the backends. rename swank.lisp to
+ swank-cmucl.lisp, then create new swank.lisp which loads an
+ appropriate backend according to *features*. Next up,
+ identify common functions in the backends and move them
+ into swank.lisp
+
+2003-10-15 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Inspector support. list-callers, list-callees
+ implemented without xref.
+
+ * swank.lisp: Lisp side for inspector and list-callers,
+ list-calees. Better fdefinition finding for struct-accessors.
+
+
+2003-10-15 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-point-moves-p): Macro for executing subforms and
+ returning true if they move the point.
+
+ * test.sh: New file to run the test suite in batch-mode. Will need
+ a little extending to allow configuring the right variables to
+ work with non-CMUCL backends.
+
+ * slime.el: Set `indent-tabs-mode' to nil. This makes diffs look
+ better.
+ (slime-start-swank-server): Now passing the port number to
+ SWANK:START-SERVER.
+ (slime-evaluating-state): Debugging synchronous evaluations with
+ recursive edits now works.
+ (slime-forward-sexp): Added support for #|...|# reader comments.
+ (sldb-hook): New hook for entry to the debugger (used for the test
+ suite).
+ (slime-run-tests): Reworked the testing framework. Now presents
+ results in an outline-mode buffer, with only the subtrees
+ containing failed tests expanded initially.
+ (slime-check): Check-name can now be a string or
+ format-control. (Test cases have been updated to take advantage of
+ this.)
+ (compile-defun): This test case now works for the case containing
+ #|..|#
+ (async-eval-debugging): New test case for recursively debugging
+ asynchronous evaluation.
+
+2003-10-15 Daniel Barlow <dan(a)telent.net>
+
+ * README.sbcl: new file
+
+ * README: update for new backends, change of hosting provider
+
+ * swank-sbcl.lisp: new file.
+ New SWANK backend for Steel Bank Common Lisp, adapted from
+ swank.lisp with bits of swank-openmcl.lisp
+
+2003-10-12 Daniel Barlow <dan(a)telent.net>
+
+ * slime.el (sldb-mode-map): add mouse-2 clickability for areas
+ in sldb buffers covered by the sldb-default-action property:
+ restarts can now be mouse-activated
+
+2003-09-28 James Bielman <jamesjb(a)jamesjb.com>
+
+ * swank-openmcl.lisp: New file, a Slime backend for OpenMCL 0.14.x.
+ (condition-function-name): Figure out the name of methods correctly
+ instead of passing a list to Emacs.
+
+ * slime.el (slime-goto-location): Try to position notes based on
+ some (questionable) regex searching if the :FUNCTION-NAME property
+ is set. Used in the OpenMCL backend which does not support source
+ paths.
+
+2003-09-29 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el: Fairly major hacking.
+ Rewrote the evaluation mechanics: similar design but some macros
+ to make it look more like a push-down automaton (which it really
+ was!). Debugging Lisp no longer uses recursive edits, partly as a
+ side-effect and partly to see if it's better this way.
+ Removed the asynchronous-communication test cases that tested
+ something we decided not to do.
+ (slime-eval-string-async): Give a meaningful error message when
+ trying to make a request while already busy.
+ (slime-lisp-binary-extension): Uh oh, time to start taking out
+ gratuitous CMUCL-isms. This variable renamed from
+ `slime-cmucl-binary-extension'.
+ (slime-backend): Name of the Lisp backend file, defaulting to
+ "swank", but can be set to e.g. "swank-openmcl".
+
+ * swank.lisp: Minor protocol changes to accomodate slime.el's
+ changes above.
+
+2003-09-28 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp
+ (getpid, set-package, set-default-directory): New functions.
+ (slime-out-misc): Don't send empty strings.
+ (*redirect-output*, read-from-emacs): A new switch to turn output
+ redirection off. Useful for debugging.
+ (interactive-eval, interactive-eval-region, pprint-eval,
+ re-evaluate-defvar): Bind *package* to *buffer-package*.
+ (with-trapping-compilation-notes): Add a dummy argument for better
+ indentation.
+ (measure-time-intervall, call-with-compilation-hooks): Measure
+ compilation time.
+ (frame-locals): Use di::debug-function-debug-variables instead of
+ di:ambiguous-debug-variables. Don't access non-valid variables.
+
+ * slime.el
+ (slime-display-message-or-view): Delete old multi-line windows.
+ (slime-read-package-name): Added an optional initial-value
+ argument. slime-pid: New variable.
+ (slime-init-dispatcher): Initialize slime-pid.
+ (slime-send-sigint): Use slime-pid instead of inferior-lisp-proc.
+ (slime-eval): Accept debug-condition messages.
+ (slime-output-buffer): Turn slime-mode on.
+ (slime-switch-to-output-buffer): New command. Bound to C-c C-z.
+ (slime-show-note-counts): Display compilation time.
+ (slime-untrace-all, slime-set-package, slime-set-default-directory
+ slime-sync-package-and-default-directory): New commands.
+ (slime-princ-locals): Don't access non-valid variables. This may
+ cause segfaults and severely confuse CMUCL.
+ (slime-define-keys): New macro.
+
+2003-09-28 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (create-swank-server): Bind the listen-socket on the
+ loopback interface by default, so that remote machines can't
+ connect to the Swank server.
+
+2003-09-27 Luke Gorrie <luke(a)bluetail.com>
+
+ * swank.lisp (with-trapping-compilation-notes): New macro for
+ bindings the handlers to record compiler notes. Now being used in
+ `compile-string', which I had broken when removing the compilation
+ hook.
+
+ * slime.el (slime-function-called-at-point): Rewritten to work
+ better. Now considers "((foo ..." _not_ to be a function call to
+ foo because of the double ('s - this will keep it from misfiring
+ in e.g. LET bindings.
+ (def-slime-test): All tests now being with (slime-sync). This
+ fixes some accidental/bogus test failures.
+
+ * swank.lisp (handle-notification-condition): Rewrote
+ compiler-note collection. Now it uses lower-level condition
+ handlers instead of c:*compiler-notification-function*. This way
+ the error messages are tailored to omit redundant information,
+ like the filename and original source text (which are displayed
+ and highlighted in Emacs already). Much nicer.
+ (sort-contexts-by-source-path): Now sorting xref results by
+ lexical source-path order, so that you're always jumping in the
+ same direction.
+ (*debug-definition-finding*): New variable. You can set this to
+ true if you want to be popped into the debugger when M-. fails to
+ find a definition (for debugging the
+ definition-finding). Otherwise it reports the error to Emacs as a
+ message, like "Error: SETQ is a special form."
+
+ * slime.el (slime-fetch-features-list): New command to fetch the
+ *FEATURES* list from Lisp and store it away. This is done
+ automatically upon connection, but can also be called manually to
+ update.
+ (slime-forward-reader-conditional): Now does the right things with
+ reader-conditionals (#+ and #-) based on the Lisp features.
+
+2003-09-26 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (sldb-setup): Setting `truncate-lines' to t in the
+ debug buffer. I like having the backtrace take strictly one line
+ per frame, since otherwise a few ugly arguments (e.g. streams) can
+ chew up a lot of space. (Can make this a configurable on request
+ if tastes differ :-)
+
+ * swank.lisp: Did a little defensive programming so that asking
+ for the definition of an unbound function will return nil to Emacs
+ instead of entering the debugger.
+ (format-frame-for-emacs): Binding *PRETTY-PRINT* to nil when
+ formatting frames (due to truncate-lines change above).
+
+2003-09-24 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp:
+ Support for stream redirection.
+ slime-output-stream: New structure.
+ (slime-out-misc): New function.
+ *slime-output*: New variable.
+ (read-from-emacs): Redirect output to *slime-output*.
+ (read-form): Bind *package* inside the standard-io-syntax macro.
+ (eval-string): Read the string with read-form.
+ (completions): Support for keyword completion.
+
+ * slime.el (slime-process-available-input, slime-eval): Rewritten
+ once again. Don't use unwind-protect anymore. Didn't work
+ properly when the Lisp side aborted due to too many debug
+ levels. "Continuing" from the Emacs debugger aborts one level on
+ the Lisp side. "Quitting" from the Emacs debugger quits the Lisp
+ side too. Increase stack sizes before entering the recursive edit.
+ (slime-eval-async-state, slime-eval, sldb-state): Support for stream
+ output.
+ slime-last-output-start: New variable.
+ (slime-output-buffer, slime-output-buffer-position,
+ slime-insert-transcript-delimiter, slime-show-last-output,
+ slime-output-string): New functions.
+ (slime-show-evaluation-result,
+ slime-show-evaluation-result-continuation): Use them.
+ (slime-use-inf-lisp-p, slime-insert-transcript-delimiter,
+ slime-inferior-lisp-marker-position,
+ slime-inferior-lisp-show-last-output): Deleted.
+ (slime-use-tty-debugger, slime-debugger-hook,
+ slime-enter-tty-debugger, slime-tty-debugger-state): Deleted. Removed
+ tty debugger support.
+ (def-sldb-invoke-restart): Renamed.
+ (define-sldb-invoke-restart-key, define-sldb-invoke-restart-keys):
+ Version without eval.
+ (defun-if-undefined): New macro.
+ Many indentation fixes.
+
+2003-09-23 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * swank.lisp (completions):
+ Moved most of the completion code to Lisp.
+ (string-prefix-p): Be case insensitive.
+
+ * slime.el:
+ Make sure define-minor-mode is defined before we use it.
+ (slime-completing-read-internal, slime-completing-read-symbol-name,
+ slime-read-from-minibuffer, slime-completions, slime-complete-symbol):
+ Support for reading symbols and expressions with completion.
+ (slime-read-symbol-name): New function.
+ (slime-read-symbol): Use it.
+ (slime-read-package-name): Case insensitive completion.
+
+ (slime-edit-symbol-fdefinition, slime-edit-fdefinition): Rename
+ slime-edit-symbol-fdefinition to slime-edit-fdefinition.
+
+2003-09-23 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-show-xrefs): Improved the xrefs buffer, now
+ using a custom minor mode.
+ (slime-next-location): This function goes to the next "something"
+ by funcall'ing slime-next-location-function. Currently that
+ variable is set by xref commands like who-calls to go to the next
+ matching reference. In future it can also be used to go to the
+ next function definition for a generic-function-understanding
+ version of edit-fdefinition. Bound to C-M-. and C-c C-SPC, until
+ we see which binding is better.
+
+2003-09-22 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-symbol-at-point): Now returns a symbol, as the
+ name suggests.
+ (slime-symbol-name-at-point): This one returns a string.
+ (slime-read-symbol): New function for taking the symbol at point,
+ or prompting if there isn't one.
+ (slime-edit-fdefinition): Now uses looks up the symbol at point,
+ not the function being called at point.
+
+ * swank.lisp (who-calls, who-references, who-binds, who-sets,
+ who-macroexpands): New function.
+ (present-symbol-before-p): Use `*buffer-package*' when checking
+ accessibility of symbols.
+
+ * slime.el (slime-restore-window-configuration): New command to
+ put the Emacs window configuration back the way it was before
+ SLIME last changed it.
+ (slime-who-calls, etc): Very basic WHO-{CALLS,..} support. Not
+ finished, wrestling around trying to make `view-mode' or
+ `help-mode' help me (I just want to hijack RET and C-m). Bound to
+ "C-c C-w ...".
+
+2003-09-21 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el: Rearranged the `outline-mode' structure slightly.
+ (slime-check-connected): Using new function to give a helpful
+ error message if you try to use commands before establishing a
+ connection to CMUCL.
+ (sldb-mode): Keys 0-9 are now shortcuts to invoke restarts.
+
+ * README, swank.el: Updated commentary.
+
+2003-09-20 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-choose-overlay-region): Tweaked overlay
+ placement.
+
+ * swank.lisp (handle-notification): Skipping null
+ notifications. For some reason CMUCL occasionally calls us with
+ NIL as each argument.
+
+2003-09-19 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-connect): Propose default values when called
+ interactively.
+ (slime-process-available-input): If possible, use while rather than
+ recursion.
+ (slime-compilation-finished-continuation): New function.
+ (slime-compile-file, slime-compile-defun): Use it.
+ (slime-forward-source-path): Id an error is encounter move back to the
+ last valid point.
+ (slime-eval-region): Use append COND. Send the entire string to the
+ Lisp side and read&evaluate it there.
+ (slime-eval-buffer): New function.
+ (sldb-sugar-move, sldb-details-up, sldb-details-down): New functions.
+
+ * swank.lisp (interactive-eval-region): New function.
+ (re-evaluate-defvar): New function.
+ (compile-defun): Install handler for compiler-errors.
+ (function-first-code-location): Simplified.
+
+2003-09-17 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-apropos-all): New command, bound to C-c M-a.
+ (slime-eval): Simplified.
+ (swank:arglist-string): Send a string and not a symbol. It easier
+ to package related thins in CL.
+ (slime-edit-symbol-fdefinition): Prompt when called with
+ prefix-argument.
+ (slime-eval-region): New function.
+ (slime-load-file): New function.
+ (slime-show-description): Set slime minor mode in Help buffer.
+
+ * swank.lisp: (read-string, from-string): Renamed read-string to
+ from-string.
+ (to-string) New function.
+ (arglist-string): Catch reader errors.
+ (sldb-loop): Also bind *readstrable*.
+
+
+2003-09-16 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el (slime-toggle-trace-fdefinition): New command.
+ (slime-symbol-at-point, slime-sexp-at-point): New utility functions.
+ (slime-edit-symbol-fdefinition): Similar to slime-edit-fdefinition but
+ uses swank:function-source-location-for-emacs.
+ (slime-goto-source-location): New function.
+ (sldb-show-source): Use it.
+ (slime-read-package-name): Completing read for package names.
+ (slime-apropos): Use it.
+
+ * swank.lisp (function-source-location,
+ function-source-location-for-emacs): New functions to extract
+ source locations from compiled code. For struct-accessors we try
+ to find the source location of the corresponding constructor.
+ (list-all-package-names): New function.
+ (toggle-trace-fdefinition, tracedp): New functions.
+
+2003-09-15 Helmut Eller <e9626484(a)stud3.tuwien.ac.at>
+
+ * slime.el: Moved many CL fragments from slime.el to swank.lisp.
+ (slime-compile-file, slime-compile-defun, slime-goto-location):
+ Compiler notes are now represented with a property list. To find
+ the source expression first move to the file offset of the
+ top-level form and then use the source path to find the
+ expression. This should avoid many reader issues. For
+ compile-defun store the start position of the top-level expression
+ from the buffer in the compiler notes and use that to locate error
+ messages. Add error overlays for notes without context to the
+ first available expression.
+
+ * swank.lisp: Moved many CL fragments from slime.el to swank.lisp.
+ (defslimefun): New macro.
+
+2003-09-15 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-setup-command-hooks): Removed post-command-hook
+ that was used for cleaning up input that was unprocessed due to an
+ error breaking out of the process filter. This is now handled by
+ an `unwind-protect' in the filter.
+
+ * swank.lisp (apropos-list-for-emacs): Hacked the apropos listing
+ to accept more options and to specially sort results.
+
+ * slime.el (slime-net-send): Added newlines to messages over the
+ wire. This makes the protocol nicely readable in Ethereal.
+ (slime-sync): New function for blocking until asynchronous
+ requests are complete.
+ (slime-apropos): Hacked the apropos command: by default, only
+ external symbols are shown. With a prefix argument you have the
+ option to include internal symbols and to specify a package.
+ (slime-run-tests): Extended the test suite. Use `M-x
+ slime-run-tests' to run it.
+
+2003-09-14 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el, swank.lisp: Added the debugger written by Helmut.
+
+ * cmucl-wire.el: Removed. The WIRE communication protocol has been
+ replaced by a simple custom TCP protocol based on READ/PRIN1 to
+ send sexps as ascii text. This simplifies the code, makes the
+ protocol nicely debugable with ethereal, and should ease porting
+ to other Lisps. Incremented TCP port number to 4005 in honor of
+ the new protocol.
+
+ In addition, Lisp now always uses *print-case* of :DOWNCASE when
+ preparing sexps for Emacs. This is in reaction to a bug with Emacs
+ reading the empty list as `NIL' instead of `nil'.
+
+ * slime.el (slime-net-connect): The Emacs end of the new
+ communication protocol.
+
+ * swank.lisp (create-swank-server): The Lisp end of the new
+ communication protocol.
+
+2003-09-11 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-mode): Added Helmut's commands to the mode
+ description.
+ (slime-show-apropos): Setting `truncate-lines' to t in apropos
+ listings, to avoid line-wrapping on overly long descriptions.
+ (slime-run-tests): Added the beginnings of an automated test
+ suite. (This is most useful for testing cross-Emacsen
+ compatibility before releases.)
+
+ * swank.lisp (symbol-external-p): Put back this function which was
+ lost in a merge.
+
+2003-09-10 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el, cmucl-wire.el, swank.lisp: Large patch from Helmut
+ Eller. Includes: apropos, describe, compile-defun, fully
+ asynchronous continuation-based wire interface, interactive
+ evaluation, and more. Very nice :-)
+
+2003-09-08 Luke Gorrie <luke(a)bluetail.com>
+
+ * cmucl-wire.el (wire-symbol-name, wire-symbol-package): Fixed to
+ handle internal references (pkg::name).
+
+ * slime.el (slime-swank-connection-retries): Increased default
+ number of connection retries from 5 to ten.
+
+ * swank.lisp (find-fdefinition): Support for finding
+ function/macro definitions for Emacs.
+
+ * slime.el: Indentation "cleanups": somehow I was using
+ `common-lisp-indent-function' for Emacs Lisp code previously.
+ (slime-edit-fdefinition): Added M-. (edit definition) and M-, (pop
+ definition stack) commands. Definitions are found in much the same
+ way Hemlock does it. The user-interface is not the same as TAGS,
+ because I like this one better. We can add TAGS-compatibility as
+ an optional feature in future.
+
+2003-09-04 Luke Gorrie <luke(a)bluetail.com>
+
+ * slime.el (slime-completions): Now supports completing
+ package-internal symbols with "pkg::prefix" syntax.
+
+ * Everything: imported slime-0.2 sources.
+
+;; Local Variables:
+;; coding: latin-1
+;; End:
+
+This file has been placed in the public domain.
Added: branches/trunk-reorg/thirdparty/slime/HACKING
===================================================================
--- branches/trunk-reorg/thirdparty/slime/HACKING 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/HACKING 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,136 @@
+* The SLIME Hacker's Handbook -*- outline -*-
+
+* Lisp code file structure
+
+The Lisp code is organised into these files:
+
+ swank-backend.lisp:
+ Definition of the interface to non-portable features.
+ Stand-alone.
+
+ swank-<cmucl|...>.lisp:
+ Backend implementation for a specific Common Lisp system.
+ Uses swank-backend.lisp.
+
+ swank.lisp:
+ The top-level server program, built from the other components.
+ Uses swank-backend.lisp as an interface to the actual backends.
+
+* ChangeLog
+
+For each change we make an entry in the ChangeLog file. This is
+typically done using the command `add-change-log-entry-other-window'
+(C-x 4 a). The message can be automatically extracted from the
+ChangeLog to use in a CVS commit message by pressing C-c C-a in a
+vc-mode or pcl-cvs commit buffer.
+
+ChangeLog diffs are automatically sent to the slime-devel mailing list
+each day as a sort of digest summary of the slime-cvs list.
+
+There are good tips on writing ChangeLog entries in the GNU Coding Standards:
+ http://www.gnu.org/prep/standards_40.html#SEC40
+
+For information about Emacs's ChangeLog support see the `Change Log'
+and `Change Logs and VC' nodes of the Emacs manual:
+ http://www.gnu.org/software/emacs/manual/html_node/emacs_333.html#SEC333
+ http://www.gnu.org/software/emacs/manual/html_node/emacs_156.html#SEC156
+
+* Sending Patches
+
+If you would like to send us improvements you can create a patch with
+C-x v = in the buffer or manually with 'cvs diff -u'. It's helpful if
+you also include a ChangeLog entry describing your change.
+
+* Test Suite
+
+The Elisp code includes a command `slime-run-tests' to run a test
+suite. This can give a pretty good sanity-check for your changes.
+
+Some backends do not pass the full test suite because of missing
+features. In these cases the test suite is still useful to ensure that
+changes don't introduce new errors. CMUCL historically passes the full
+test suite so it makes a good sanity check for fundamental changes
+(e.g. to the protocol).
+
+Running the test suite, adding new cases, and increasing the number of
+cases that backends support are all very good for karma.
+
+
+* Source code layout
+
+We use a special source file layout to take advantage of some fancy
+Emacs features: outline-mode and "narrowing".
+
+** Outline structure
+
+Our source files have a hierarchical structure using comments like
+these:
+
+ ;;;; Heading
+ ;;;;; Subheading
+ ... etc
+
+We do this as a nice way to structure the program. We try to keep each
+(sub)section small enough to fit in your head: typically around 50-200
+lines of code each. Each section usually begins with a brief
+introduction, followed by its highest-level functions, followed by
+their subroutines. This is a pleasing shape for a source file to have.
+
+Of course the comments mean something to Emacs too. One handy usage is
+to bring up a hyperlinked "table of contents" for the source file
+using this command:
+
+ (defun show-outline-structure ()
+ "Show the outline-mode structure of the current buffer."
+ (interactive)
+ (occur (concat "^" outline-regexp)))
+
+Another is to use `outline-minor-mode' to fold away certain parts of
+the buffer. See the `Outline Mode' section of the Emacs manual for
+details about that.
+
+(This file is also formatted for outline mode. If you're reading in
+Emacs you can play around e.g. by pressing `C-c C-d' right now.)
+
+** Pagebreak characters (^L)
+
+We partition source files into chunks using pagebreak characters. Each
+chunk is a substantial piece of code that can be considered in
+isolation, that could perhaps be a separate source file if we were
+fanatical about small source files (rather than big ones!)
+
+The page breaks usually go in the same place as top-level outline-mode
+headings, but they don't have to. They're flexible.
+
+In the old days, when slime.el was less than 100 pages long, these
+page breaks were helpful when printing it out to read. Now they're
+useful for something else: narrowing.
+
+You can use `C-x n p' (narrow-to-page) to "zoom in" on a
+pagebreak-delimited section of the file as if it were a separate
+buffer in itself. You can then use `C-x n w' (widen) to "zoom out" and
+see the whole file again. This is tremendously helpful for focusing
+your attention on one part of the program as if it were its own file.
+
+(This file contains some page break characters. If you're reading in
+Emacs you can press `C-x n p' to narrow to this page, and then later
+`C-x n w' to make the whole buffer visible again.)
+
+
+* Coding style
+
+We like the fact that each function in SLIME will fit on a single
+screen (80x20), and would like to preserve this property! Beyond that
+we're not dogmatic :-)
+
+In early discussions we all made happy noises about the advice in
+Norvig and Pitman's _Tutorial on Good Lisp Programming Style_:
+ http://www.norvig.com/luv-slides.ps
+
+For Emacs Lisp, we try to follow the _Tips and Conventions_ in
+Appendix D of the GNU Emacs Lisp Reference Manual (see Info file
+`elisp', node `Tips').
+
+Remember that to rewrite a program better is the sincerest form of
+code appreciation. When you can see a way to rewrite a part of SLIME
+better, please do so!
Added: branches/trunk-reorg/thirdparty/slime/NEWS
===================================================================
--- branches/trunk-reorg/thirdparty/slime/NEWS 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/NEWS 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,110 @@
+* SLIME News -*- outline -*-
+
+* 1.2 (March 2005)
+
+** New inspector
+The lisp side now returns a specially formated list of "things" to
+format which are then passed to emacs and rendered in the inspector
+buffer. Things can be either text, recursivly inspectable values, or
+functions to call. The new inspector has much better support CLOS
+objects and methods.
+
+** Unicode
+It's now possible to send non-ascii characters to Emacs, if the
+communication channel is configured properly. See the variable
+`slime-net-coding-system'.
+
+** Arglist lookup while debugging
+Previously, arglist lookup was disabled while debugging. This
+restriction was removed.
+
+** Extended tracing command
+It's now possible to trace individual a single methods or all methods
+of a generic function. Also tracing can be restricted to situations
+in which the traced function is called from a specific function.
+
+** M-x slime-browse-classes
+A simple class browser was added.
+
+** FASL files
+The fasl files for different Lisp/OS/hardware combinations are now
+placed in different directories.
+
+** Many other small improvements and bugfixes
+
+* 1.0 (September 2004)
+
+** slime-interrupt
+The default key binding for slime-interrupt is now C-c C-b.
+
+** sldb-inspect-condition
+In SLDB 'C' is now bound to sldb-inspect-condition.
+
+** More Menus
+SLDB and the REPL have now pull-down menus.
+
+** Global debugger hook.
+A new configurable *global-debugger* to control whether
+swank-debugger-hook should be installed globally is available. True by
+default.
+
+** When you call sldb-eval-in-frame with a prefix argument, the result is
+now inserted in the REPL buffer.
+
+** Compile function
+For Allegro M-. works now for functions compiled with C-c C-c.
+
+** slime-edit-definition
+Better support for Allegro: works now for different type of
+definitions not only. So M-. now works for e.g. classes in Allegro.
+
+** SBCL 0.8.13
+SBCL 0.8.12 is no longer supported. Support for 0.8.12 was broken for
+for some time now.
+
+* 1.0 beta (August 2004)
+
+** autodoc global variables
+The slime-autodoc-mode will now automatically show the value of a
+global variable at point.
+
+** Customize group
+The customize group is expanded and better-organised.
+
+** slime-interactive-eval
+Interactive-eval commands now print their results to the REPL when
+given a prefix argument.
+
+** slime-conservative-indentation
+New Elisp variable. Non-nil means that we exclude def* and with-* from
+indentation-learning. The default is t.
+
+** (slime-setup)
+New function to streamline setup in ~/.emacs
+
+** Modeline package
+The package name in the modeline is now updated on an idle timer. The
+message should now be more meaningful when moving around in files
+containing multiple IN-PACKAGE forms.
+
+** XREF bugfix
+The XREF commands did not find symbols in the right package.
+
+** REPL prompt
+The package name in the REPL's prompt is now abbreviated to the last
+`.'-delimited token, e.g. MY.COMPANY.PACKAGE would be PACKAGE. This
+can be disabled by setting SWANK::*AUTO-ABBREVIATE-DOTTED-PACKAGES* to
+NIL.
+
+** CMUCL source cache
+The source cache is now populated on `first-change-hook'. This makes
+M-. work accurately in more file modification scenarios.
+
+** SBCL compiler errors
+Detect compiler errors and make some noise. Previously certain
+problems (e.g. reader-errors) could slip by quietly.
+
+* 1.0 alpha (June 2004)
+
+The first preview release of SLIME.
+
Added: branches/trunk-reorg/thirdparty/slime/PROBLEMS
===================================================================
--- branches/trunk-reorg/thirdparty/slime/PROBLEMS 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/PROBLEMS 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,95 @@
+Known problems with SLIME -*- outline -*-
+
+* Common to all backends
+
+** Caution: network security
+The `M-x slime' command has Lisp listen on a TCP socket and wait for
+Emacs to connect, which typically takes on the order of one second. If
+someone else were to connect to this socket then they could use the
+SLIME protocol to control the Lisp process.
+
+The listen socket is bound on the loopback interface in all Lisps that
+support this. This way remote hosts are unable to connect.
+
+** READ-CHAR-NO-HANG is broken
+
+READ-CHAR-NO-HANG doesn't work properly for slime-input-streams. Due
+to the way we request input from Emacs it's not possible to repeatedly
+poll for input. To get any input you have to call READ-CHAR (or a
+function which calls READ-CHAR).
+
+* Backend-specific problems
+
+** CMUCL
+
+The default communication style :SIGIO is reportedly unreliable with
+certain libraries (like libSDL) and certain platforms (like Solaris on
+Sparc). It generally works very well on x86 so it remains the default.
+
+** SBCL
+
+The latest released version of SBCL at the time of packaging should
+work. Older or newer SBCLs may or may not work. Do not use
+multithreading with unpatched 2.4 Linux kernels. There are also
+problems with kernel versions 2.6.5 - 2.6.10.
+
+The (v)iew-source command in the debugger can only locate exact source
+forms for code compiled at (debug 2) or higher. The default level is
+lower and SBCL itself is compiled at a lower setting. Thus only
+defun-granularity is available with default policies.
+
+The XREF commands are not implemented.
+
+** OpenMCL
+
+We support OpenMCL 0.14.3.
+
+The XREF commands are not available.
+
+** LispWorks
+
+On Windows, SLIME hangs when calling foreign functions or certain
+other functions. The reason for this problem is unknown.
+
+We only support latin1 encoding. (Unicode wouldn't be hard to add.)
+
+** Allegro CL
+
+Interrupting Allegro with C-c C-b can be slow. This is caused by the
+a relatively large process-quantum: 2 seconds by default. Allegro
+responds much faster if mp:*default-process-quantum* is set to 0.1.
+
+** CLISP
+
+We require version 2.33.2 or higher. We also require socket support, so
+you may have to start CLISP with "clisp -K full".
+
+Under Windows, interrupting (with C-c C-b) doesn't work. Emacs sends
+a SIGINT signal, but the signal is either ignored or CLISP exits
+immediately.
+
+Function arguments and local variables aren't displayed properly in
+the backtrace. Changes to CLISP's C code are needed to fix this
+problem. Interpreted code is usually easer to debug.
+
+M-. (find-definition) only works if the fasl file is in the same
+directory as the source file.
+
+The arglist doesn't include the proper names only "fake symbols" like
+`arg1'.
+
+** Armed Bear Common Lisp
+
+The ABCL support is still new and experimental.
+
+** Corman Common Lisp
+
+We require version 2.51 or higher, with several patches (available at
+http://www.grumblesmurf.org/lisp/corman-patches).
+
+The only communication style currently supported is NIL.
+
+Interrupting (with C-c C-b) doesn't work.
+
+The tracing, stepping and XREF commands are not implemented along with
+some debugger functionality.
Added: branches/trunk-reorg/thirdparty/slime/README
===================================================================
--- branches/trunk-reorg/thirdparty/slime/README 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/README 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,41 @@
+Overview.
+----------------------------------------
+
+ SLIME is the Superior Lisp Interaction Mode for Emacs. It is
+ implemented in two main parts: the Emacs Lisp side (slime.el), and
+ the support library for the Common Lisp (swank.lisp and swank-*.lisp)
+
+ For a real description, see the manual in doc/
+
+Quick setup instructions
+------------------------
+
+ Add this to your ~/.emacs file and fill in the appropriate filenames:
+
+ (add-to-list 'load-path "~/hacking/lisp/slime/") ; your SLIME directory
+ (setq inferior-lisp-program "/opt/sbcl/bin/sbcl") ; your Lisp system
+ (require 'slime)
+ (slime-setup)
+
+ Make sure your `inferior-lisp-program' is set to a compatible
+ version of Lisp.
+
+ Use `M-x' slime to fire up and connect to an inferior Lisp.
+ SLIME will now automatically be available in your Lisp source
+ buffers.
+
+Licence.
+----------------------------------------
+
+ SLIME is free software. All files, unless explicitly stated
+ otherwise, are public domain.
+
+Contact.
+----------------------------------------
+
+ Questions and comments are best directed to the mailing list:
+ http://common-lisp.net/mailman/listinfo/slime-devel
+
+ The mailing list archive is also available on Gmane:
+ http://news.gmane.org/gmane.lisp.slime.devel
+
Added: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,30 @@
+/ChangeLog/1.62/Mon Oct 1 13:37:22 2007//
+/README/1.3/Fri Sep 28 13:05:44 2007//
+/bridge.el/1.1/Wed Sep 19 11:47:03 2007//
+/inferior-slime.el/1.2/Mon Sep 10 21:44:48 2007//
+/slime-asdf.el/1.3/Fri Sep 21 12:44:13 2007//
+/slime-autodoc.el/1.5/Mon Oct 1 13:37:10 2007//
+/slime-banner.el/1.4/Thu Sep 20 14:55:53 2007//
+/slime-c-p-c.el/1.8/Thu Sep 20 14:55:53 2007//
+/slime-editing-commands.el/1.5/Thu Sep 20 14:55:53 2007//
+/slime-fancy-inspector.el/1.2/Thu Sep 20 14:55:53 2007//
+/slime-fancy.el/1.4/Fri Sep 28 13:05:35 2007//
+/slime-fuzzy.el/1.4/Thu Sep 20 14:55:53 2007//
+/slime-highlight-edits.el/1.3/Thu Sep 20 14:55:53 2007//
+/slime-parse.el/1.7/Sat Sep 15 11:09:36 2007//
+/slime-presentation-streams.el/1.2/Tue Aug 28 08:25:12 2007//
+/slime-presentations.el/1.8/Thu Sep 20 14:55:53 2007//
+/slime-references.el/1.4/Thu Sep 20 14:55:53 2007//
+/slime-scratch.el/1.4/Thu Sep 20 14:55:53 2007//
+/slime-tramp.el/1.2/Tue Sep 4 10:18:44 2007//
+/slime-typeout-frame.el/1.5/Mon Oct 1 11:50:06 2007//
+/slime-xref-browser.el/1.1/Fri Aug 24 14:47:11 2007//
+/swank-arglists.lisp/1.10/Tue Sep 11 12:33:00 2007//
+/swank-asdf.lisp/1.1/Tue Sep 4 10:32:07 2007//
+/swank-c-p-c.lisp/1.2/Wed Sep 5 19:35:35 2007//
+/swank-fancy-inspector.lisp/1.4/Thu Sep 20 14:55:53 2007//
+/swank-fuzzy.lisp/1.6/Sat Sep 15 22:21:21 2007//
+/swank-listener-hooks.lisp/1.1/Tue Aug 28 13:53:02 2007//
+/swank-presentation-streams.lisp/1.4/Tue Aug 28 16:26:32 2007//
+/swank-presentations.lisp/1.4/Tue Sep 4 09:49:10 2007//
+D
Added: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/CVS/Repository 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/CVS/Repository 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+slime/contrib
Added: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/CVS/Root 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/CVS/Root 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+:pserver:anonymous:anonymous@common-lisp.net:/project/slime/cvsroot
Added: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Template
===================================================================
Added: branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,500 @@
+2007-10-01 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime-autdoc.el (slime-autodoc-message-ok-p): Don't display an
+ arglist when the minibuffer is active.
+
+2007-10-01 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime-typeout-frame.el: Messages in the typeout frame were too
+ easily overwritten by `slime-autodoc'. Fix that.
+ Reported by Geoff Wozniak.
+
+ (slime-typeout-message-aux): Split out from `slime-typeout-message'.
+ (slime-typeout-message): Wrapper around it. Additionally disable
+ the autodoc timer temporarily.
+
+2007-09-30 Geoff Wozniak <geoff(a)wozniak.ca>
+
+ * slime-typeout-frame.el (slime-typeout-frame-init): Fix quoted
+ FUNCTION forms in literal.
+
+2007-09-28 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * README: Updated.
+
+ * slime-fancy.el: `slime-highlighting-edits' is not enabled by
+ default anymore, as its functionality is controversial, and it's
+ easier to explicitly enable it than to disable it once it got
+ globally activated. Better to be conservative.
+
+ * slime-fancy.el: Not only load, but also enable `slime-scratch'.
+
+2007-09-21 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime-asdf.el (slime-asdf-init, slime-asdf-unload): Fix typos.
+ Reported by Ariel Badichi.
+
+2007-09-20 Helmut Eller <heller(a)common-lisp.net>
+
+ Separate loading from initialization for many contribs.
+
+ * slime-asdf.el
+ * slime-autodoc.el
+ * slime-banner.el
+ * slime-c-p-c.el
+ * slime-editing-commands.el
+ * slime-fancy-inspector.el
+ * slime-fuzzy.el
+ * slime-highlight-edits.el
+ * slime-presentations.el
+ * slime-references.el
+ * slime-scratch.el
+ * slime-typeout-frame.el
+ * swank-fancy-inspector.lisp
+
+ * slime-fancy.el: As an exception, call the respective init
+ function when loading.
+
+2007-09-19 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime-c-p-c.el (slime-complete-symbol*-fancy): Move defcustom
+ from slime.el to contrib/slime-c-p-c.el.
+
+2007-09-16 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank-fuzzy.lisp: Fix regression that would not allow to fuzzy
+ complete on inputs without package qualifier like "app".
+ Reported by David J. Neu.
+
+ (%make-duplicate-symbols-filter): Return complement.
+ (fuzzy-find-matching-symbols): Treat passed filter as an acceptor
+ predicate, not as a rejector.
+
+2007-09-15 Helmut Eller <heller(a)common-lisp.net>
+
+ Add the necessary hooks when loading some contribs, so that those
+ contribs can be easily loaded with slime-setup.
+
+ * slime-highlight-edits.el (slime-highlight-edits-mode-on): New
+ function. Add this to slime-mode-hook by default.
+
+ * slime-autodoc.el (slime-use-autodoc-mode): Change default to t.
+
+2007-09-15 Ariel Badichi <abadichi(a)bezeqint.net>
+
+ * swank-fancy-inspector.lisp (inspect-for-emacs package): When
+ inspecting a package, the links in the use list and the used-by
+ list lead to inspecting package names, rather than the packages
+ themselves. Fix that.
+
+2007-09-15 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime-parse.el: Fix extended arglist display on misbalanced
+ expressions like `(defun foo | ... (defun bar () 'bar)'
+ Reported by Ariel Badichi.
+
+ (slime-inside-string-p): Use `beginning-of-defun' directly than
+ relying on `slime-region-for-defun-at-point' (as this one uses
+ `end-of-defun' which signals an error on misbalanced expressions.)
+
+2007-09-15 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank-fuzzy.lisp: Code reorganization and cleanup; making it
+ compute less and couple of other minor issues fixed on the
+ way. Thanks to Stelian Ionescu for testing and providing feedback!
+
+ (defstruct fuzzy-matching): New `package-name' slot.
+ (make-fuzzy-matching): Updated for new slot.
+ (format-completion-result): Renamed to `fuzzy-format-matching'.
+ (%fuzzy-extract-matching-info): Helper for `fuzzy-format-matching'.
+
+ (fuzzy-completion-set): Convert the matchings after they got
+ truncated to the passed completion-set limit from Emacs.
+ I.e. `slime-fuzzy-completion-limit' This means a huge
+ computational reduction.
+
+ (fuzzy-create-completion-set): Renamed to `fuzzy-generate-matchings'.
+ (fuzzy-generate-matchings): Returns the fuzzy matchings
+ themselves, do not yet convert them for Emacs. Do not perform two
+ sorts on the generated matchings (first alphabetically, then per
+ score), but just one with an appropriate predicate that sorts per
+ score, unless matchings are equal, then sort alphabetically. Prune
+ matchings with symbols which are found in a differenta package
+ than their home package when the home package is among the matched
+ packages. Try to take the time needed to sort the generated
+ matchings into account for the time-limit.
+ (%guess-sort-duration): Helper.
+ Tries to guess how long the sort will take.
+ (%make-duplicate-symbols-filter): Helper.
+ Used for pruning of matchings.
+ (fuzzy-matching-greaterp): New testing predicate for sorting.
+
+ (fuzzy-find-matching-symbols): Now takes a :filter keyarg; only
+ considers symbols that pass through the filter.
+ (fuzzy-find-matching-packages): Do not return matchings for all
+ nicknames of package, but just the one that matches best.
+
+2007-09-11 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime-editing-commands.el: Automatically bind the editing
+ commands when this module is required. (Previously, one had to
+ enable them explicitly, but this is inconsistent to, for instance,
+ the `slime-c-p-c' module which also sets up its bindings
+ automatically.)
+ (slime-bind-editing-commands): Renamed to `slime-editing-commands-init'.
+ (slime-editing-commands-init): Evaluated at toplevel.
+
+2007-09-11 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime-parse.el (slime-enclosing-form-specs): Now also works even
+ when point is inside a string.
+ (slime-inside-string-p): New function.
+ (slime-beginning-of-string): New function.
+
+2007-09-11 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank-arglist.lisp (read-conversatively-for-autodoc): Also parse
+ quoted symbols explicitly. This fixed extended arglist display for
+ `(make-instance 'foo'. Reported by: Johannes Groedem.
+
+2007-09-11 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime-fancy.el: Require `slime-references'.
+
+2007-09-10 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime-parse.el (slime-cl-symbol-name, slime-cl-symbol-package):
+ Move from slime.el to contrib/slime-parse.el.
+
+2007-09-10 Helmut Eller <heller(a)common-lisp.net>
+
+ * inferior-slime.el: Fix installation comment.
+
+2007-09-10 Helmut Eller <heller(a)common-lisp.net>
+
+ Fix some of the bugs introduced with the last change.
+
+ * slime-references.el (sldb-reference-face): Add missing quote.
+ (sldb-reference-properties): We are lucky and can use keywords
+ instead of strings.
+ (sldb-maybe-insert-references): Insert newlines differently.
+
+2007-09-10 Helmut Eller <heller(a)common-lisp.net>
+
+ Move SBCL doc references to contrib.
+
+ * slime-references.el: New file.
+
+2007-09-10 Attila Lendvai <attila.lendvai(a)gmail.com>
+
+ * slime-fuzzy.el: Fixed some race condition that prevented a
+ proper closing of the *Fuzzy Completions* buffer in some
+ circumstances.
+
+ (slime-fuzzy-save-window-configuration): Removed. Hooking up
+ `window-configuration-change-hook' via `run-with-timer' was racy
+ and lead to this bug; we now set the hook explicitely at the
+ necessary place instead.
+ (slime-fuzzy-window-configuration-change-add-hook): Removed.
+ (slime-fuzzy-choices-buffer): Explicitly save the
+ window-configuration, and explicitly set the hook.
+ (slime-fuzzy-done): Explicitely remove the hook.
+
+2007-09-10 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime-parse.el (slime-cl-symbol-name, slime-cl-symbol-package):
+ Moved back into slime.el.
+
+2007-09-08 Stelian Ionescu <sionescu(a)common-lisp.net>
+
+ * slime-banner.el: Fixed typo to provide `slime-banner', not
+ `slime-startup-animation'.
+
+2007-09-06 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime-presentations.el (slime-presentation-write): Use case, not
+ ecase, for dispatching targets. Should fix XEmacs compatibility.
+ Reported by Steven E. Harris.
+
+2007-09-05 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank-c-p-c.el: This file incorrectly provided the module
+ `:swank-compound-prefix'; changed that to `:swank-c-p-c'.
+
+ This gets rid off the nasty redefinition warnings that were
+ previously signalled when loading SWANK with SBCL.
+
+ * swank-arglist.lisp (arglist-for-echo-area): Locally declare
+ `*arglist-pprint-bindings*' to be special, as the variable is
+ defined later in the file. (Gets rid of warnings during loading.)
+
+2007-09-05 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * slime-c-p-c.el (slime-c-p-c-init): Bind `slime-complete-form' to
+ `C-c C-s' in `slime-repl-mode-map'.
+
+2007-09-05 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ Added extended arglist display for DECLAIM and PROCLAIM.
+
+ * slime-parse.el (slime-extended-operator-name-parser-alist): Added
+ entries for "DECLAIM", and "PROCLAIM".
+ (slime-parse-extended-operator/declare): Provide information about
+ the operator the arglist is requested for.
+ (slime-make-form-spec-from-string): Fixed for "()" as input.
+
+ * swank-arglists.lisp (valid-operator-symbol-p): Explicitly allow
+ the symbol 'DECLARE.
+ (arglist-dispatch): New method for `DECLARE'. We have to catch
+ this explicitly, as DECLARE doesn't have an arglist (in the
+ `swank-backend:arglist' sense.)
+ (*arglist-pprint-bindings*): New variable. Splitted out from
+ `decoded-arglist-to-string'.
+ (decoded-arglist-to-string): Use `*arglist-pprint-bindings*'.
+
+ (parse-first-valid-form-spec): Rewritten, because function
+ signature had to be changed: doesn't take arg-indices anymore;
+ returns position of first valid spec as second value to remedy.
+ (arglist-for-echo-area): Accomodated to new signature of
+ `parse-first-valid-form-spec'; now searchs for contextual
+ declaration operator name, to prefix a declaration arglist by
+ "declare", "declaim", or "proclaim" depending on what was used at
+ user's point in Slime. Use `*arglist-pprint-bindings*' for
+ printing the found declaration operator name.
+ (%find-declaration-operator): New helper to do this search.
+ (completions-for-keyword): Accomodated to new signature of
+ `parse-first-valid-form-spec'. Also fixed to correctly provide
+ keyword completions in nested expressions like:
+
+ `(defun foo (x)
+ (let ((bar 'quux))
+ (with-open-file (s f :|' [`|' being point]
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-arglists.lisp (parse-first-valid-form-spec): Rewrite it for
+ ABCL.
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ Some bug fixes for slime-complete-symbol*.
+ Patches by Mr. Madhu <enometh(a)meer.net>
+
+ * slime-c-p-c.el (slime-c-p-c-unambiguous-prefix-p): New variable.
+ (slime-expand-abbreviations-and-complete): Use it. Also add a
+ workaround for XEmacs issues.
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ Move asdf support to contrib:
+
+ * slime-asdf.el: New file.
+
+ * swank-asdf.lisp: New file
+ (operate-on-system, asdf-central-registry)
+ (list-all-systems-known-to-asdf): Use the asdf package in the
+ source code, i.e. write asdf:operate instead of
+ (find-symbol "OPERATE" "ASDF").
+
+2007-09-04 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime-tramp.el: New file.
+ * slime-banner.el: New file.
+ * inferior-slime.el: New file.
+
+2007-09-01 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime-fancy.el: New meta-contrib.
+
+2007-09-01 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime-presentations.el (slime-dispatch-presentation-event):
+ Explicitly return t to indicate the events have been handled,
+ rather than relying on the return values of the called functions.
+
+2007-09-01 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime-typeout-frame.el (slime-typeout-autodoc-message): Fix for
+ messages that contain "%". Reported by Martin Simmons.
+
+2007-09-01 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ Makes `slime-complete-form' work on `(eval-when |'; doesn't work
+ on `(eval-when (|' yet.
+
+ * slime-parse.el (slime-parse-sexp-at-point): Guard against
+ `(char-after)' being NIL at end of buffer (especially important
+ for use on the REPL.)
+
+ * swank-arglist.lisp (arglist-dispatch 'eval-when): Fix typo.
+ (print-decoded-arglist-as-template): Print keywords with PRIN1.
+
+2007-08-31 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ Added extended arglist display for EVAL-WHEN, viz:
+
+ (eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)
+
+ Notice that completion works as expected on these keywords.
+
+ Die, EVAL-ALWAYS, die!
+
+ * swank-arglist (arglist-dispatch): New method for EVAL-WHEN.
+ (print-arglist): Print keywords with PRIN1 rather than PRINC,
+ to get a result as shown above for the EVAL-WHEN case.
+ (completions-for-keyword): Add support for &ANY args.
+
+2007-08-31 Tobias C. Rittweiler <tcr(a)freebits.de>
+
+ * swank-arglist.lisp: Do not fall back to READ when interpreting
+ the ``raw form specs'' comming from Slime's autodoc stuff. But
+ still do so for those comming from `slime-complete-form'.
+
+ (unintern-in-home-package): New.
+
+ (*arglist-dummy*): New.
+ (read-conversatively-for-autodoc): New function. Doesn't READ
+ anything that comes from Slime's autodoc. Just tries to parse
+ symbols. If that's not successfull, returns the dummy placeholder
+ datum stored in `*arglist-dummy*'.
+ (arglist-for-echo-area): Parse form-specs using
+ `read-conversatively-for-autodoc'. Use `unintern-in-home-package'.
+
+ (read-softly): New. Splitted out from `read-form-spec'. This
+ function tries to keep track of newly interned functions before
+ READing.
+ (read-form-spec): Parametrized to take a function to read the
+ elements of the passed ``raw form spec''. Uses `read-softly' as
+ default reader.
+
+ (complete-form, completions-for-keywords):
+ Use `unintern-in-home-package'.
+
+2007-08-31 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime-autodoc.el: Add installation notes.
+ * slime-editing-commands.el: Add installation notes.
+ * slime-c-p-c.el (slime-c-p-c-init): Fix typos.
+
+2007-08-31 Helmut Eller <heller(a)common-lisp.net>
+
+ Move compound prefix completion and autodoc to contrib.
+ Interdependencies made it almost necessary to move parsing code
+ and editing commands in the same patch.
+
+ * slime-c-p-c.el: New file.
+ * swank-c-p-c.el: New file.
+ * slime-parse.el: New file.
+ * swank-arglists.el: New file.
+ * slime-editing-commands.el: New file.
+ * slime-autodoc.el: New file.
+
+2007-08-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * slime-presentations.el (slime-last-output-target-id)
+ (slime-output-target-to-marker, slime-output-target-marker)
+ (slime-redirect-trace-output): Moved back into SLIME core.
+
+ * swank-presentation-streams.lisp: Require swank-presentations.
+ (present-repl-results-via-presentation-streams): New.
+ (*send-repl-results-function*): Set this variable rather than
+ overriding send-repl-results-to-emacs.
+
+2007-08-28 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime-presentations.el (slime-clear-presentations): New
+ function. Add it to slime-repl-clear-buffer-hook.
+
+2007-08-28 Helmut Eller <heller(a)common-lisp.net>
+
+ * swank-listener-hooks.lisp: New file
+
+2007-08-28 Helmut Eller <heller(a)common-lisp.net>
+
+ Move the rest of the presentation related code.
+
+ * swank-presentations.lisp (present-repl-results): Renamed from
+ send-repl-results-to-emacs.
+
+2007-08-28 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ * swank-presentations.lisp (send-repl-results-to-emacs):
+ Override core defun to mark up REPL results as presentations.
+
+ * swank-presentations.lisp: New file.
+ * slime-presentations.el: Load it.
+
+ * slime-presentations.el (slime-presentation-write): Remove id
+ argument.
+
+ * slime-presentation-streams.el: Require slime-presentations contrib.
+
+2007-08-27 Helmut Eller <heller(a)common-lisp.net>
+
+ Move presentations to contrib. (ELisp part)
+
+ * slime-presentations.el: New file.
+ * slime-scratch.el (slime-scratch-buffer): Ignore presentations.
+
+2007-08-24 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Some fixes to the presentation-streams contrib.
+
+ * swank-presentation-streams.lisp [sbcl]: Load the pretty-printer
+ patch only at load time. Add some trickery so that SBCL does not
+ complain about the changed layout of the pretty-stream class.
+
+ * swank-presentation-streams.lisp (slime-stream-p): Using special
+ return values, indicate whether we are printing to the
+ REPL-results stream, or a dedicated stream.
+ (presentation-record): New slot "target".
+ (presentation-start, presentation-end): Use it (rather than the
+ global variable *use-dedicated-output-stream*) to decide whether
+ to use the bridge protocol or the :presentation-start/-end
+ protocol. Also use it as the TARGET argument of
+ :presentation-start/-end messages.
+ (presenting-object-1): Use the new return values of
+ slime-stream-p.
+
+ * swank-presentation-streams.lisp (slime-stream-p) [cmu]: Use the
+ return value of slime-stream-p rather than the global variable
+ *use-dedicated-output-stream* to decide whether printing through
+ pretty streams is safe for the layout.
+
+2007-08-24 Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+
+ Make the fancy "presentation streams" feature a contrib.
+ Previously, it was only available if "present.lisp" was loaded
+ manually.
+
+ * slime-presentation-streams.el: New file.
+ * swank-presentation-streams.lisp: New file, moved here from
+ ../present.lisp
+
+2007-08-24 Helmut Eller <heller(a)common-lisp.net>
+
+ * slime-typeout-frame.el: New file.
+ * slime-xref-browser.el: New file.
+ * slime-highlight-edits.el: New file.
+ * slime-scratch.el: New file.
+
+2007-08-23 Helmut Eller <heller(a)common-lisp.net>
+
+ Move Marco Baringer's inspector to contrib.
+
+ * swank-fancy-inspector.lisp: New file. The only difference to the
+ code is that inspect-for-emacs methods in this file are
+ specialized to the new class `fancy-inspector'.
+ (fancy-inspector): New class.
+
+ * slime-fancy-inspector.el: New file.
+
+2007-08-19 Helmut Eller <heller(a)common-lisp.net>
+
+ Moved fuzzy completion code to contrib directory.
+
+ * slime-fuzzy.el: New file.
+ (slime-fuzzy-init): New function. Load CL code on startup.
+
+ * swank-fuzzy.lisp: New file. Common Lisp code for fuzzy
+ completion.
Added: branches/trunk-reorg/thirdparty/slime/contrib/README
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/README 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/README 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,30 @@
+This directory contains source code which may be useful to some Slime
+users. *.el files are Emacs Lisp source and *.lisp files contain
+Common Lisp source code. If not otherwise stated in the file itself,
+the files are placed in the Public Domain.
+
+The components in this directory are more or less detached from the
+rest of Slime. They are essentially "add-ons". But Slime can also be
+used without them. The code is maintained by the respective authors.
+
+To use the packages here, you should add this directory to your Emacs
+load-path, require the contrib, and call the contrib's init function to
+enable the functionality that's provided by the respective contrib.
+
+E.g. for fuzzy completion add this to your .emacs:
+
+ (add-to-list 'load-path "<this-directory>")
+ (add-hook 'slime-load-hook (lambda () (require 'slime-fuzzy)
+ (slime-fuzzy-init)))
+
+Alternatively, you can use the `slime-setup' function which takes a
+list of contrib names, and which loads and enables them automatically
+for you:
+
+ (slime-setup '(slime-fancy slime-asdf slime-tramp ...))
+
+
+Finally, the contrib `slime-fancy' is specially noteworthy, as it
+represents a meta-contrib that'll load a bunch of commonly used
+contribs. Look into `slime-fancy.el' to find out which.
+
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/contrib/bridge.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/bridge.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/bridge.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,467 @@
+;;; -*-Emacs-Lisp-*-
+;;;%Header
+;;; Bridge process filter, V1.0
+;;; Copyright (C) 1991 Chris McConnell, ccm(a)cs.cmu.edu
+;;;
+;;; Send mail to ilisp(a)cons.org if you have problems.
+;;;
+;;; Send mail to majordomo(a)cons.org if you want to be on the
+;;; ilisp mailing list.
+
+;;; This file is part of GNU Emacs.
+
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY. No author or distributor
+;;; accepts responsibility to anyone for the consequences of using it
+;;; or for whether it serves any particular purpose or works at all,
+;;; unless he says so in writing. Refer to the GNU Emacs General Public
+;;; License for full details.
+
+;;; Everyone is granted permission to copy, modify and redistribute
+;;; GNU Emacs, but only under the conditions described in the
+;;; GNU Emacs General Public License. A copy of this license is
+;;; supposed to have been given to you along with GNU Emacs so you
+;;; can know your rights and responsibilities. It should be in a
+;;; file named COPYING. Among other things, the copyright notice
+;;; and this notice must be preserved on all copies.
+
+;;; Send any bugs or comments. Thanks to Todd Kaufmann for rewriting
+;;; the process filter for continuous handlers.
+
+;;; USAGE: M-x install-bridge will add a process output filter to the
+;;; current buffer. Any output that the process does between
+;;; bridge-start-regexp and bridge-end-regexp will be bundled up and
+;;; passed to the first handler on bridge-handlers that matches the
+;;; output using string-match. If bridge-prompt-regexp shows up
+;;; before bridge-end-regexp, the bridge will be cancelled. If no
+;;; handler matches the output, the first symbol in the output is
+;;; assumed to be a buffer name and the rest of the output will be
+;;; sent to that buffer's process. This can be used to communicate
+;;; between processes or to set up two way interactions between Emacs
+;;; and an inferior process.
+
+;;; You can write handlers that process the output in special ways.
+;;; See bridge-send-handler for the default handler. The command
+;;; hand-bridge is useful for testing. Keep in mind that all
+;;; variables are buffer local.
+
+;;; YOUR .EMACS FILE:
+;;;
+;;; ;;; Set up load path to include bridge
+;;; (setq load-path (cons "/bridge-directory/" load-path))
+;;; (autoload 'install-bridge "bridge" "Install a process bridge." t)
+;;; (setq bridge-hook
+;;; '(lambda ()
+;;; ;; Example options
+;;; (setq bridge-source-insert nil) ;Don't insert in source buffer
+;;; (setq bridge-destination-insert nil) ;Don't insert in dest buffer
+;;; ;; Handle copy-it messages yourself
+;;; (setq bridge-handlers
+;;; '(("copy-it" . my-copy-handler)))))
+
+;;; EXAMPLE:
+;;; # This pipes stdin to the named buffer in a Unix shell
+;;; alias devgnu '(echo -n "\!* "; cat -; echo -n " ")'
+;;;
+;;; ls | devgnu *scratch*
+
+(eval-when-compile
+ (require 'cl))
+
+;;;%Parameters
+(defvar bridge-hook nil
+ "Hook called when a bridge is installed by install-hook.")
+
+(defvar bridge-start-regexp ""
+ "*Regular expression to match the start of a process bridge in
+process output. It should be followed by a buffer name, the data to
+be sent and a bridge-end-regexp.")
+
+(defvar bridge-end-regexp " "
+ "*Regular expression to match the end of a process bridge in process
+output.")
+
+(defvar bridge-prompt-regexp nil
+ "*Regular expression for detecting a prompt. If there is a
+comint-prompt-regexp, it will be initialized to that. A prompt before
+a bridge-end-regexp will stop the process bridge.")
+
+(defvar bridge-handlers nil
+ "Alist of (regexp . handler) for handling process output delimited
+by bridge-start-regexp and bridge-end-regexp. The first entry on the
+list whose regexp matches the output will be called on the process and
+the delimited output.")
+
+(defvar bridge-source-insert t
+ "*T to insert bridge input in the source buffer minus delimiters.")
+
+(defvar bridge-destination-insert t
+ "*T for bridge-send-handler to insert bridge input into the
+destination buffer minus delimiters.")
+
+(defvar bridge-chunk-size 512
+ "*Long inputs send to comint processes are broken up into chunks of
+this size. If your process is choking on big inputs, try lowering the
+value.")
+
+;;;%Internal variables
+(defvar bridge-old-filter nil
+ "Old filter for a bridged process buffer.")
+
+(defvar bridge-string nil
+ "The current output in the process bridge.")
+
+(defvar bridge-in-progress nil
+ "The current handler function, if any, that bridge passes strings on to,
+or nil if none.")
+
+(defvar bridge-leftovers nil
+ "Because of chunking you might get an incomplete bridge signal - start but the end is in the next packet. Save the overhanging text here.")
+
+(defvar bridge-send-to-buffer nil
+ "The buffer that the default bridge-handler (bridge-send-handler) is
+currently sending to, or nil if it hasn't started yet. Your handler
+function can use this variable also.")
+
+(defvar bridge-last-failure ()
+ "Last thing that broke the bridge handler. First item is function call
+(eval'able); last item is error condition which resulted. This is provided
+to help handler-writers in their debugging.")
+
+;;;%Utilities
+(defun bridge-insert (output)
+ "Insert process OUTPUT into the current buffer."
+ (if output
+ (let* ((buffer (current-buffer))
+ (process (get-buffer-process buffer))
+ (mark (process-mark process))
+ (window (selected-window))
+ (at-end nil))
+ (if (eq (window-buffer window) buffer)
+ (setq at-end (= (point) mark))
+ (setq window (get-buffer-window buffer)))
+ (save-excursion
+ (goto-char mark)
+ (insert output)
+ (set-marker mark (point)))
+ (if window
+ (progn
+ (if at-end (goto-char mark))
+ (if (not (pos-visible-in-window-p (point) window))
+ (let ((original (selected-window)))
+ (save-excursion
+ (select-window window)
+ (recenter '(center))
+ (select-window original)))))))))
+
+;;;
+;(defun bridge-send-string (process string)
+; "Send PROCESS the contents of STRING as input.
+;This is equivalent to process-send-string, except that long input strings
+;are broken up into chunks of size comint-input-chunk-size. Processes
+;are given a chance to output between chunks. This can help prevent processes
+;from hanging when you send them long inputs on some OS's."
+; (let* ((len (length string))
+; (i (min len bridge-chunk-size)))
+; (process-send-string process (substring string 0 i))
+; (while (< i len)
+; (let ((next-i (+ i bridge-chunk-size)))
+; (accept-process-output)
+; (process-send-string process (substring string i (min len next-i)))
+; (setq i next-i)))))
+
+;;;
+(defun bridge-call-handler (handler proc string)
+ "Funcall HANDLER on PROC, STRING carefully. Error is caught if happens,
+and user is signaled. State is put in bridge-last-failure. Returns t if
+handler executed without error."
+ (let ((inhibit-quit nil)
+ (failed nil))
+ (condition-case err
+ (funcall handler proc string)
+ (error
+ (ding)
+ (setq failed t)
+ (message "bridge-handler \"%s\" failed %s (see bridge-last-failure)"
+ handler err)
+ (setq bridge-last-failure
+ (` ((funcall '(, handler) '(, proc) (, string))
+ "Caused: "
+ (, err))))))
+ (not failed)))
+
+;;;%Handlers
+(defun bridge-send-handler (process input)
+ "Send PROCESS INPUT to the buffer name found at the start of the
+input. The input after the buffer name is sent to the buffer's
+process if it has one. If bridge-destination-insert is T, the input
+will be inserted into the buffer. If it does not have a process, it
+will be inserted at the end of the buffer."
+ (if (null input)
+ (setq bridge-send-to-buffer nil) ; end of bridge
+ (let (buffer-and-start buffer-name dest to)
+ ;; if this is first time, get the buffer out of the first line
+ (cond ((not bridge-send-to-buffer)
+ (setq buffer-and-start (read-from-string input)
+ buffer-name (format "%s" (car (read-from-string input)))
+ dest (get-buffer buffer-name)
+ to (get-buffer-process dest)
+ input (substring input (cdr buffer-and-start)))
+ (setq bridge-send-to-buffer dest))
+ (t
+ (setq buffer-name bridge-send-to-buffer
+ dest (get-buffer buffer-name)
+ to (get-buffer-process dest)
+ )))
+ (if dest
+ (let ((buffer (current-buffer)))
+ (if bridge-destination-insert
+ (unwind-protect
+ (progn
+ (set-buffer dest)
+ (if to
+ (bridge-insert process input)
+ (goto-char (point-max))
+ (insert input)))
+ (set-buffer buffer)))
+ (if to
+ ;; (bridge-send-string to input)
+ (process-send-string to input)
+ ))
+ (error "%s is not a buffer" buffer-name)))))
+
+;;;%Filter
+(defun bridge-filter (process output)
+ "Given PROCESS and some OUTPUT, check for the presence of
+bridge-start-regexp. Everything prior to this will be passed to the
+normal filter function or inserted in the buffer if it is nil. The
+output up to bridge-end-regexp will be sent to the first handler on
+bridge-handlers that matches the string. If no handlers match, the
+input will be sent to bridge-send-handler. If bridge-prompt-regexp is
+encountered before the bridge-end-regexp, the bridge will be cancelled."
+ (let ((inhibit-quit t)
+ (match-data (match-data))
+ (buffer (current-buffer))
+ (process-buffer (process-buffer process))
+ (case-fold-search t)
+ (start 0) (end 0)
+ function
+ b-start b-start-end b-end)
+ (set-buffer process-buffer) ;; access locals
+
+ ;; Handle bridge messages that straddle a packet by prepending
+ ;; them to this packet.
+
+ (when bridge-leftovers
+ (setq output (concat bridge-leftovers output))
+ (setq bridge-leftovers nil))
+
+ (setq function bridge-in-progress)
+
+ ;; How it works:
+ ;;
+ ;; start, end delimit the part of string we are interested in;
+ ;; initially both 0; after an iteration we move them to next string.
+
+ ;; b-start, b-end delimit part of string to bridge (possibly whole string);
+ ;; this will be string between corresponding regexps.
+
+ ;; There are two main cases when we come into loop:
+
+ ;; bridge in progress
+ ;;0 setq b-start = start
+ ;;1 setq b-end (or end-pattern end)
+ ;;4 process string
+ ;;5 remove handler if end found
+
+ ;; no bridge in progress
+ ;;0 setq b-start if see start-pattern
+ ;;1 setq b-end if bstart to (or end-pattern end)
+ ;;2 send (substring start b-start) to normal place
+ ;;3 find handler (in b-start, b-end) if not set
+ ;;4 process string
+ ;;5 remove handler if end found
+
+ ;; equivalent sections have the same numbers here;
+ ;; we fold them together in this code.
+
+ (block bridge-filter
+ (unwind-protect
+ (while (< end (length output))
+
+ ;;0 setq b-start if find
+ (setq b-start
+ (cond (bridge-in-progress
+ (setq b-start-end start)
+ start)
+ ((string-match bridge-start-regexp output start)
+ (setq b-start-end (match-end 0))
+ (match-beginning 0))
+ (t nil)))
+ ;;1 setq b-end
+ (setq b-end
+ (if b-start
+ (let ((end-seen (string-match bridge-end-regexp
+ output b-start-end)))
+ (if end-seen (setq end (match-end 0)))
+
+ end-seen)))
+
+ ;; Detect and save partial bridge messages
+ (when (and b-start b-start-end (not b-end))
+ (setq bridge-leftovers (substring output b-start))
+ )
+
+ (if (and b-start (not b-end))
+ (setq end b-start)
+ (if (not b-end)
+ (setq end (length output))))
+
+ ;;1.5 - if see prompt before end, remove current
+ (if (and b-start b-end)
+ (let ((prompt (string-match bridge-prompt-regexp
+ output b-start-end)))
+ (if (and prompt (<= (match-end 0) b-end))
+ (setq b-start nil ; b-start-end start
+ b-end start
+ end (match-end 0)
+ bridge-in-progress nil
+ ))))
+
+ ;;2 send (substring start b-start) to old filter, if any
+ (when (not (equal start (or b-start end))) ; don't bother on empty string
+ (let ((pass-on (substring output start (or b-start end))))
+ (if bridge-old-filter
+ (let ((old bridge-old-filter))
+ (store-match-data match-data)
+ (funcall old process pass-on)
+ ;; if filter changed, re-install ourselves
+ (let ((new (process-filter process)))
+ (if (not (eq new 'bridge-filter))
+ (progn (setq bridge-old-filter new)
+ (set-process-filter process 'bridge-filter)))))
+ (set-buffer process-buffer)
+ (bridge-insert pass-on))))
+
+ (if (and b-start-end (not b-end))
+ (return-from bridge-filter t) ; when last bit has prematurely ending message, exit early.
+ (progn
+ ;;3 find handler (in b-start, b-end) if none current
+ (if (and b-start (not bridge-in-progress))
+ (let ((handlers bridge-handlers))
+ (while (and handlers (not function))
+ (let* ((handler (car handlers))
+ (m (string-match (car handler) output b-start-end)))
+ (if (and m (< m b-end))
+ (setq function (cdr handler))
+ (setq handlers (cdr handlers)))))
+ ;; Set default handler if none
+ (if (null function)
+ (setq function 'bridge-send-handler))
+ (setq bridge-in-progress function)))
+ ;;4 process strin
+ (if function
+ (let ((ok t))
+ (if (/= b-start-end b-end)
+ (let ((send (substring output b-start-end b-end)))
+ ;; also, insert the stuff in buffer between
+ ;; iff bridge-source-insert.
+ (if bridge-source-insert (bridge-insert send))
+ ;; call handler on string
+ (setq ok (bridge-call-handler function process send))))
+ ;;5 remove handler if end found
+ ;; if function removed then tell it that's all
+ (if (or (not ok) (/= b-end end)) ;; saw end before end-of-string
+ (progn
+ (bridge-call-handler function process nil)
+ ;; have to remove function too for next time around
+ (setq function nil
+ bridge-in-progress nil)
+ ))
+ ))
+
+ ;; continue looping, in case there's more string
+ (setq start end))
+ ))
+ ;; protected forms: restore buffer, match-data
+ (set-buffer buffer)
+ (store-match-data match-data)
+ ))))
+
+
+;;;%Interface
+(defun install-bridge ()
+ "Set up a process bridge in the current buffer."
+ (interactive)
+ (if (not (get-buffer-process (current-buffer)))
+ (error "%s does not have a process" (buffer-name (current-buffer)))
+ (make-local-variable 'bridge-start-regexp)
+ (make-local-variable 'bridge-end-regexp)
+ (make-local-variable 'bridge-prompt-regexp)
+ (make-local-variable 'bridge-handlers)
+ (make-local-variable 'bridge-source-insert)
+ (make-local-variable 'bridge-destination-insert)
+ (make-local-variable 'bridge-chunk-size)
+ (make-local-variable 'bridge-old-filter)
+ (make-local-variable 'bridge-string)
+ (make-local-variable 'bridge-in-progress)
+ (make-local-variable 'bridge-send-to-buffer)
+ (make-local-variable 'bridge-leftovers)
+ (setq bridge-string nil bridge-in-progress nil
+ bridge-send-to-buffer nil)
+ (if (boundp 'comint-prompt-regexp)
+ (setq bridge-prompt-regexp comint-prompt-regexp))
+ (let ((process (get-buffer-process (current-buffer))))
+ (if process
+ (if (not (eq (process-filter process) 'bridge-filter))
+ (progn
+ (setq bridge-old-filter (process-filter process))
+ (set-process-filter process 'bridge-filter)))
+ (error "%s does not have a process"
+ (buffer-name (current-buffer)))))
+ (run-hooks 'bridge-hook)
+ (message "Process bridge is installed")))
+
+;;;
+(defun reset-bridge ()
+ "Must be called from the process's buffer. Removes any active bridge."
+ (interactive)
+ ;; for when things get wedged
+ (if bridge-in-progress
+ (unwind-protect
+ (funcall bridge-in-progress (get-buffer-process
+ (current-buffer))
+ nil)
+ (setq bridge-in-progress nil))
+ (message "No bridge in progress.")))
+
+;;;
+(defun remove-bridge ()
+ "Remove bridge from the current buffer."
+ (interactive)
+ (let ((process (get-buffer-process (current-buffer))))
+ (if (or (not process) (not (eq (process-filter process) 'bridge-filter)))
+ (error "%s has no bridge" (buffer-name (current-buffer)))
+ ;; remove any bridge-in-progress
+ (reset-bridge)
+ (set-process-filter process bridge-old-filter)
+ (funcall bridge-old-filter process bridge-string)
+ (message "Process bridge is removed."))))
+
+;;;% Utility for testing
+(defun hand-bridge (start end)
+ "With point at bridge-start, sends bridge-start + string +
+bridge-end to bridge-filter. With prefix, use current region to send."
+ (interactive "r")
+ (let ((p0 (if current-prefix-arg (min start end)
+ (if (looking-at bridge-start-regexp) (point)
+ (error "Not looking at bridge-start-regexp"))))
+ (p1 (if current-prefix-arg (max start end)
+ (if (re-search-forward bridge-end-regexp nil t)
+ (point) (error "Didn't see bridge-end-regexp")))))
+
+ (bridge-filter (get-buffer-process (current-buffer))
+ (buffer-substring-no-properties p0 p1))
+ ))
+
+(provide 'bridge)
Added: branches/trunk-reorg/thirdparty/slime/contrib/inferior-slime.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/inferior-slime.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/inferior-slime.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,88 @@
+;;; inferior-slime.el --- Minor mode with Slime keys for comint buffers
+;;
+;; Author: Luke Gorrie <luke(a)synap.se>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'inferior-slime)))
+;; (add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode 1)))
+
+(define-minor-mode inferior-slime-mode
+ "\\<slime-mode-map>\
+Inferior SLIME mode: The Inferior Superior Lisp Mode for Emacs.
+
+This mode is intended for use with `inferior-lisp-mode'. It provides a
+subset of the bindings from `slime-mode'.
+
+\\{inferior-slime-mode-map}"
+ nil
+ nil
+ ;; Fake binding to coax `define-minor-mode' to create the keymap
+ '((" " 'undefined)))
+
+(add-to-list 'minor-mode-alist
+ '(inferior-slime-mode
+ (" Inf-Slime" slime-state-name)))
+
+(defun inferior-slime-return ()
+ "Handle the return key in the inferior-lisp buffer.
+The current input should only be sent if a whole expression has been
+entered, i.e. the parenthesis are matched.
+
+A prefix argument disables this behaviour."
+ (interactive)
+ (if (or current-prefix-arg (inferior-slime-input-complete-p))
+ (comint-send-input)
+ (insert "\n")
+ (inferior-slime-indent-line)))
+
+(defun inferior-slime-indent-line ()
+ "Indent the current line, ignoring everything before the prompt."
+ (interactive)
+ (save-restriction
+ (let ((indent-start
+ (save-excursion
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (let ((inhibit-field-text-motion t))
+ (beginning-of-line 1))
+ (point))))
+ (narrow-to-region indent-start (point-max)))
+ (lisp-indent-line)))
+
+(defun inferior-slime-input-complete-p ()
+ "Return true if the input is complete in the inferior lisp buffer."
+ (slime-input-complete-p (process-mark (get-buffer-process (current-buffer)))
+ (point-max)))
+
+(defun inferior-slime-closing-return ()
+ "Send the current expression to Lisp after closing any open lists."
+ (interactive)
+ (goto-char (point-max))
+ (save-restriction
+ (narrow-to-region (process-mark (get-buffer-process (current-buffer)))
+ (point-max))
+ (while (ignore-errors (save-excursion (backward-up-list 1) t))
+ (insert ")")))
+ (comint-send-input))
+
+(defun inferior-slime-init-keymap ()
+ (let ((map inferior-slime-mode-map))
+ (define-key map [return] 'inferior-slime-return)
+ (define-key map [(control return)] 'inferior-slime-closing-return)
+ (define-key map [(meta control ?m)] 'inferior-slime-closing-return)
+ (define-key map "\C-c\C-d" slime-doc-map)
+ (define-key map "\C-c\C-w" slime-who-map)
+ (loop for (key command . keys) in slime-keys do
+ (destructuring-bind (&key prefixed inferior &allow-other-keys) keys
+ (when prefixed
+ (setq key (concat slime-prefix-key key)))
+ (when inferior
+ (define-key map key command))))))
+
+(inferior-slime-init-keymap)
+
+(provide 'inferior-slime)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-asdf.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-asdf.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-asdf.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,113 @@
+;;; slime-asdf.el -- ASDF support
+;;
+;; Authors: Daniel Barlow <dan(a)telent.net>
+;; Marco Baringer <mb(a)bese.it>
+;; Edi Weitz <edi(a)agharta.de>
+;; and others
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs:
+;;
+;; (add-to-list 'load-path ".../slime/contrib")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-asdf)))
+;;
+
+;; NOTE: `system-name' is a predefined variable in Emacs. Try to
+;; avoid it as local variable name.
+
+
+(defun slime-load-system (&optional system)
+ "Compile and load an ASDF system.
+
+Default system name is taken from first file matching *.asd in current
+buffer's working directory"
+ (interactive (list (slime-read-system-name)))
+ (slime-oos system "LOAD-OP"))
+
+(defvar slime-system-history nil
+ "History list for ASDF system names.")
+
+(defun slime-read-system-name (&optional prompt initial-value)
+ "Read a system name from the minibuffer, prompting with PROMPT."
+ (setq prompt (or prompt "System: "))
+ (let* ((completion-ignore-case nil)
+ (system-names (slime-eval `(swank:list-asdf-systems)))
+ (alist (slime-bogus-completion-alist system-names)))
+ (completing-read prompt alist nil nil
+ (or initial-value (slime-find-asd system-names) "")
+ 'slime-system-history)))
+
+(defun slime-find-asd (system-names)
+ "Tries to find an ASDF system definition in the default
+directory or in the directory belonging to the current buffer and
+returns it if it's in `system-names'."
+ (let* ((asdf-systems-in-directory
+ (mapcar #'file-name-sans-extension
+ (directory-files
+ (file-name-directory (or default-directory
+ (buffer-file-name)))
+ nil "\.asd$"))))
+ (loop for system in asdf-systems-in-directory
+ for candidate = (file-name-sans-extension system)
+ when (find candidate system-names :test #'string-equal)
+ do (return candidate))))
+
+(defun slime-oos (system operation &rest keyword-args)
+ (slime-save-some-lisp-buffers)
+ (slime-display-output-buffer)
+ (message "Performing ASDF %S%s on system %S"
+ operation (if keyword-args (format " %S" keyword-args) "")
+ system)
+ (slime-eval-async
+ `(swank:operate-on-system-for-emacs ,system ,operation ,@keyword-args)
+ (slime-make-compilation-finished-continuation (current-buffer))))
+
+(defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
+ (:handler (lambda ()
+ (interactive)
+ (slime-oos (slime-read-system-name) "LOAD-OP" :force t)))
+ (:one-liner "Recompile and load an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-load-system ("load-system")
+ (:handler (lambda ()
+ (interactive)
+ (slime-oos (slime-read-system-name) "LOAD-OP")))
+ (:one-liner "Compile (as needed) and load an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-test/force-system ("force-test-system")
+ (:handler (lambda ()
+ (interactive)
+ (slime-oos (slime-read-system-name) "TEST-OP" :force t)))
+ (:one-liner "Compile (as needed) and force test an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-test-system ("test-system")
+ (:handler (lambda ()
+ (interactive)
+ (slime-oos (slime-read-system-name) "TEST-OP")))
+ (:one-liner "Compile (as needed) and test an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-compile-system ("compile-system")
+ (:handler (lambda ()
+ (interactive)
+ (slime-oos (slime-read-system-name) "COMPILE-OP")))
+ (:one-liner "Compile (but not load) an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-compile/force-system
+ ("force-compile-system")
+ (:handler (lambda ()
+ (interactive)
+ (slime-oos (slime-read-system-name) "COMPILE-OP" :force t)))
+ (:one-liner "Recompile (but not load) an ASDF system."))
+
+(defun slime-asdf-on-connect ()
+ (slime-eval-async '(swank:swank-require :swank-asdf)))
+
+(defun slime-asdf-init ()
+ (add-hook 'slime-connected-hook 'slime-asdf-on-connect))
+
+(defun slime-asdf-unload ()
+ (remove-hook 'slime-connected-hook 'slime-asdf-on-connect))
+
+(provide 'slime-asdf)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,273 @@
+;;; slime-autodoc.el --- show fancy arglist in echo area
+;;
+;; Authors: Luke Gorrie <luke(a)bluetail.com>
+;; Lawrence Mitchell <wence(a)gmx.li>
+;; Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;; Tobias C. Rittweiler <tcr(a)freebits.de>
+;; and others
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-autodoc)))
+;;
+
+(require 'slime-parse)
+
+(defvar slime-use-autodoc-mode t
+ "When non-nil always enable slime-autodoc-mode in slime-mode.")
+
+(defun slime-fontify-string (string)
+ "Fontify STRING as `font-lock-mode' does in Lisp mode."
+ (with-current-buffer (get-buffer-create " *slime-fontify*")
+ (erase-buffer)
+ (if (not (eq major-mode 'lisp-mode))
+ (lisp-mode))
+ (insert string)
+ (let ((font-lock-verbose nil))
+ (font-lock-fontify-buffer))
+ (goto-char (point-min))
+ (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
+ (let ((highlight (match-string 1)))
+ ;; Can't use (replace-match highlight) here -- broken in Emacs 21
+ (delete-region (match-beginning 0) (match-end 0))
+ (slime-insert-propertized '(face highlight) highlight)))
+ (buffer-substring (point-min) (point-max))))
+
+(defun slime-arglist (name)
+ "Show the argument list for NAME."
+ (interactive (list (slime-read-symbol-name "Arglist of: ")))
+ (slime-eval-async
+ `(swank:arglist-for-echo-area (quote (,name)))
+ (lambda (arglist)
+ (if arglist
+ (message "%s" (slime-fontify-string arglist))
+ (error "Arglist not available")))))
+
+
+
+;;;; Autodocs (automatic context-sensitive help)
+
+(defvar slime-autodoc-mode nil
+ "*When non-nil, print documentation about symbols as the point moves.")
+
+(defvar slime-autodoc-cache-type 'last
+ "*Cache policy for automatically fetched documentation.
+Possible values are:
+ nil - none.
+ last - cache only the most recently-looked-at symbol's documentation.
+ The values are stored in the variable `slime-autodoc-cache'.
+
+More caching means fewer calls to the Lisp process, but at the risk of
+using outdated information.")
+
+(defvar slime-autodoc-cache nil
+ "Cache variable for when `slime-autodoc-cache-type' is 'last'.
+The value is (SYMBOL-NAME . DOCUMENTATION).")
+
+(defun slime-autodoc-mode (&optional arg)
+ "Enable `slime-autodoc'."
+ (interactive "P")
+ (cond ((< (prefix-numeric-value arg) 0) (setq slime-autodoc-mode nil))
+ (arg (setq slime-autodoc-mode t))
+ (t (setq slime-autodoc-mode (not slime-autodoc-mode))))
+ (if slime-autodoc-mode
+ (progn
+ (slime-autodoc-start-timer)
+ (add-hook 'pre-command-hook
+ 'slime-autodoc-pre-command-refresh-echo-area t))
+ (slime-autodoc-stop-timer)))
+
+(defvar slime-autodoc-last-message "")
+
+(defun slime-autodoc ()
+ "Print some apropos information about the code at point, if applicable."
+ (destructuring-bind (cache-key retrieve-form) (slime-autodoc-thing-at-point)
+ (let ((cached (slime-get-cached-autodoc cache-key)))
+ (if cached
+ (slime-autodoc-message cached)
+ ;; Asynchronously fetch, cache, and display documentation
+ (slime-eval-async
+ retrieve-form
+ (with-lexical-bindings (cache-key)
+ (lambda (doc)
+ (let ((doc (if doc (slime-fontify-string doc) "")))
+ (slime-update-autodoc-cache cache-key doc)
+ (slime-autodoc-message doc)))))))))
+
+(defcustom slime-autodoc-use-multiline-p nil
+ "If non-nil, allow long autodoc messages to resize echo area display."
+ :type 'boolean
+ :group 'slime-ui)
+
+(defvar slime-autodoc-message-function 'slime-autodoc-show-message)
+
+(defun slime-autodoc-message (doc)
+ "Display the autodoc documentation string DOC."
+ (funcall slime-autodoc-message-function doc))
+
+(defun slime-autodoc-show-message (doc)
+ (unless slime-autodoc-use-multiline-p
+ (setq doc (slime-oneliner doc)))
+ (setq slime-autodoc-last-message doc)
+ (message "%s" doc))
+
+(defun slime-autodoc-message-dimensions ()
+ "Return the available width and height for pretty printing autodoc
+messages."
+ (cond
+ (slime-autodoc-use-multiline-p
+ ;; Use the full width of the minibuffer;
+ ;; minibuffer will grow vertically if necessary
+ (values (window-width (minibuffer-window))
+ nil))
+ (t
+ ;; Try to fit everything in one line; we cut off when displaying
+ (values 1000 1))))
+
+(defun slime-autodoc-pre-command-refresh-echo-area ()
+ (unless (string= slime-autodoc-last-message "")
+ (if (slime-autodoc-message-ok-p)
+ (message "%s" slime-autodoc-last-message)
+ (setq slime-autodoc-last-message ""))))
+
+(defun slime-autodoc-thing-at-point ()
+ "Return a cache key and a swank form."
+ (let ((global (slime-autodoc-global-at-point)))
+ (if global
+ (values (slime-qualify-cl-symbol-name global)
+ `(swank:variable-desc-for-echo-area ,global))
+ (multiple-value-bind (operators arg-indices points)
+ (slime-enclosing-form-specs)
+ (values (mapcar* (lambda (designator arg-index)
+ (cons
+ (if (symbolp designator)
+ (slime-qualify-cl-symbol-name designator)
+ designator)
+ arg-index))
+ operators arg-indices)
+ (multiple-value-bind (width height)
+ (slime-autodoc-message-dimensions)
+ `(swank:arglist-for-echo-area ',operators
+ :arg-indices ',arg-indices
+ :print-right-margin ,width
+ :print-lines ,height)))))))
+
+(defun slime-autodoc-global-at-point ()
+ "Return the global variable name at point, if any."
+ (when-let (name (slime-symbol-name-at-point))
+ (if (slime-global-variable-name-p name) name)))
+
+(defcustom slime-global-variable-name-regexp "^\\(.*:\\)?\\([*+]\\).+\\2$"
+ "Regexp used to check if a symbol name is a global variable.
+
+Default value assumes +this+ or *that* naming conventions."
+ :type 'regexp
+ :group 'slime)
+
+(defun slime-global-variable-name-p (name)
+ "Is NAME a global variable?
+Globals are recognised purely by *this-naming-convention*."
+ (and (< (length name) 80) ; avoid overflows in regexp matcher
+ (string-match slime-global-variable-name-regexp name)))
+
+(defun slime-get-cached-autodoc (symbol-name)
+ "Return the cached autodoc documentation for SYMBOL-NAME, or nil."
+ (ecase slime-autodoc-cache-type
+ ((nil) nil)
+ ((last)
+ (when (equal (car slime-autodoc-cache) symbol-name)
+ (cdr slime-autodoc-cache)))
+ ((all)
+ (when-let (symbol (intern-soft symbol-name))
+ (get symbol 'slime-autodoc-cache)))))
+
+(defun slime-update-autodoc-cache (symbol-name documentation)
+ "Update the autodoc cache for SYMBOL with DOCUMENTATION.
+Return DOCUMENTATION."
+ (ecase slime-autodoc-cache-type
+ ((nil) nil)
+ ((last)
+ (setq slime-autodoc-cache (cons symbol-name documentation)))
+ ((all)
+ (put (intern symbol-name) 'slime-autodoc-cache documentation)))
+ documentation)
+
+
+;;;;; Asynchronous message idle timer
+
+(defvar slime-autodoc-idle-timer nil
+ "Idle timer for the next autodoc message.")
+
+(defvar slime-autodoc-delay 0.2
+ "*Delay before autodoc messages are fetched and displayed, in seconds.")
+
+(defun slime-autodoc-start-timer ()
+ "(Re)start the timer that prints autodocs every `slime-autodoc-delay' seconds."
+ (interactive)
+ (when slime-autodoc-idle-timer
+ (cancel-timer slime-autodoc-idle-timer))
+ (setq slime-autodoc-idle-timer
+ (run-with-idle-timer slime-autodoc-delay slime-autodoc-delay
+ 'slime-autodoc-timer-hook)))
+
+(defun slime-autodoc-stop-timer ()
+ "Stop the timer that prints autodocs.
+See also `slime-autodoc-start-timer'."
+ (when slime-autodoc-idle-timer
+ (cancel-timer slime-autodoc-idle-timer)
+ (setq slime-autodoc-idle-timer nil)))
+
+(defun slime-autodoc-timer-hook ()
+ "Function to be called after each Emacs becomes idle.
+When `slime-autodoc-mode' is non-nil, print apropos information about
+the symbol at point if applicable."
+ (when (slime-autodoc-message-ok-p)
+ (condition-case err
+ (slime-autodoc)
+ (error
+ (setq slime-autodoc-mode nil)
+ (message "Error: %S; slime-autodoc-mode now disabled." err)))))
+
+(defun slime-autodoc-message-ok-p ()
+ "Return true if printing a message is currently okay (shouldn't
+annoy the user)."
+ (and (or slime-mode (eq major-mode 'slime-repl-mode)
+ (eq major-mode 'sldb-mode))
+ slime-autodoc-mode
+ (or (null (current-message))
+ (string= (current-message) slime-autodoc-last-message))
+ (not executing-kbd-macro)
+ (not (and (boundp 'edebug-active) (symbol-value 'edebug-active)))
+ (not cursor-in-echo-area)
+ (not (active-minibuffer-window))
+ (not (eq (selected-window) (minibuffer-window)))
+ (slime-background-activities-enabled-p)))
+
+
+;;; Initialization
+
+(defun slime-autodoc-init ()
+ (setq slime-echo-arglist-function 'slime-autodoc)
+ (add-hook 'slime-connected-hook 'slime-autodoc-on-connect)
+ (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
+ (add-hook h 'slime-autodoc-maybe-enable)))
+
+(defun slime-autodoc-on-connect ()
+ (slime-eval-async '(swank:swank-require :swank-arglists)))
+
+(defun slime-autodoc-maybe-enable ()
+ (when slime-use-autodoc-mode
+ (slime-autodoc-mode 1)))
+
+(defun slime-autodoc-unload ()
+ (setq slime-echo-arglist-function 'slime-show-arglist)
+ (remove-hook 'slime-connected-hook 'slime-autodoc-on-connect)
+ (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
+ (remove-hook h 'slime-autodoc-maybe-enable)))
+
+(provide 'slime-autodoc)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-banner.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-banner.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-banner.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,44 @@
+;;; slime-banner.el -- Persistent header line and startup animation
+;;
+;; Authors: Helmut Eller <heller(a)common-lisp.net>
+;; Luke Gorrie <luke(a)synap.se>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs:
+;;
+;; (add-to-list 'load-path ".../slime/contrib")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-banner)))
+
+(defcustom slime-startup-animation (fboundp 'animate-string)
+ "Enable the startup animation."
+ :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
+ :group 'slime-ui)
+
+(defcustom slime-header-line-p (boundp 'header-line-format)
+ "If non-nil, display a header line in Slime buffers."
+ :type 'boolean
+ :group 'slime-repl)
+
+(defun slime-startup-message ()
+ (when slime-header-line-p
+ (setq header-line-format
+ (format "%s Port: %s Pid: %s"
+ (slime-lisp-implementation-type)
+ (slime-connection-port (slime-connection))
+ (slime-pid))))
+ (when (zerop (buffer-size))
+ (let ((welcome (concat "; SLIME " (or (slime-changelog-date)
+ "- ChangeLog file not found"))))
+ (if slime-startup-animation
+ (animate-string welcome 0 0)
+ (insert welcome)))))
+
+(defun slime-banner-init ()
+ (setq slime-repl-banner-function 'slime-startup-message))
+
+(defun slime-banner-unload ()
+ (setq slime-repl-banner-function 'slime-repl-insert-banner))
+
+(provide 'slime-banner)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-c-p-c.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-c-p-c.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-c-p-c.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,202 @@
+;;; slime-c-p-c.el --- ILISP style Compound Prefix Completion
+;;
+;; Authors: Luke Gorrie <luke(a)synap.se>
+;; Edi Weitz <edi(a)agharta.de>
+;; Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;; Tobias C. Rittweiler <tcr(a)freebits.de>
+;; and others
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation
+;;
+;; Add this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-c-p-c)))
+;;
+
+
+
+(require 'slime)
+(require 'slime-parse)
+(require 'slime-editing-commands)
+
+(defcustom slime-c-p-c-unambiguous-prefix-p t
+ "If true, set point after the unambigous prefix.
+If false, move point to the end of the inserted text."
+ :type 'boolean
+ :group 'slime-ui)
+
+(defcustom slime-complete-symbol*-fancy nil
+ "Use information from argument lists for DWIM'ish symbol completion."
+ :group 'slime-mode
+ :type 'boolean)
+
+(defun slime-complete-symbol* ()
+ "Expand abbreviations and complete the symbol at point."
+ ;; NB: It is only the name part of the symbol that we actually want
+ ;; to complete -- the package prefix, if given, is just context.
+ (or (slime-maybe-complete-as-filename)
+ (slime-expand-abbreviations-and-complete)))
+
+;; FIXME: factorize
+(defun slime-expand-abbreviations-and-complete ()
+ (let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
+ (beg (move-marker (make-marker) (slime-symbol-start-pos)))
+ (prefix (buffer-substring-no-properties beg end))
+ (completion-result (slime-contextual-completions beg end))
+ (completion-set (first completion-result))
+ (completed-prefix (second completion-result)))
+ (if (null completion-set)
+ (progn (slime-minibuffer-respecting-message
+ "Can't find completion for \"%s\"" prefix)
+ (ding)
+ (slime-complete-restore-window-configuration))
+ ;; some XEmacs issue makes this distinction necessary
+ (cond ((> (length completed-prefix) (- end beg))
+ (goto-char end)
+ (insert-and-inherit completed-prefix)
+ (delete-region beg end)
+ (goto-char (+ beg (length completed-prefix))))
+ (t nil))
+ (cond ((and (member completed-prefix completion-set)
+ (slime-length= completion-set 1))
+ (slime-minibuffer-respecting-message "Sole completion")
+ (when slime-complete-symbol*-fancy
+ (slime-complete-symbol*-fancy-bit))
+ (slime-complete-restore-window-configuration))
+ ;; Incomplete
+ (t
+ (when (member completed-prefix completion-set)
+ (slime-minibuffer-respecting-message
+ "Complete but not unique"))
+ (when slime-c-p-c-unambiguous-prefix-p
+ (let ((unambiguous-completion-length
+ (loop for c in completion-set
+ minimizing (or (mismatch completed-prefix c)
+ (length completed-prefix)))))
+ (goto-char (+ beg unambiguous-completion-length))))
+ (slime-display-or-scroll-completions completion-set
+ completed-prefix))))))
+
+(defun slime-complete-symbol*-fancy-bit ()
+ "Do fancy tricks after completing a symbol.
+\(Insert a space or close-paren based on arglist information.)"
+ (let ((arglist (slime-get-arglist (slime-symbol-name-at-point))))
+ (when arglist
+ (let ((args
+ ;; Don't intern these symbols
+ (let ((obarray (make-vector 10 0)))
+ (cdr (read arglist))))
+ (function-call-position-p
+ (save-excursion
+ (backward-sexp)
+ (equal (char-before) ?\())))
+ (when function-call-position-p
+ (if (null args)
+ (insert-and-inherit ")")
+ (insert-and-inherit " ")
+ (when (and slime-space-information-p
+ (slime-background-activities-enabled-p)
+ (not (minibuffer-window-active-p (minibuffer-window))))
+ (slime-echo-arglist))))))))
+
+(defun slime-get-arglist (symbol-name)
+ "Return the argument list for SYMBOL-NAME."
+ (slime-eval `(swank:arglist-for-echo-area (quote (,symbol-name)))))
+
+(defun* slime-contextual-completions (beg end)
+ "Return a list of completions of the token from BEG to END in the
+current buffer."
+ (let ((token (buffer-substring-no-properties beg end)))
+ (cond
+ ((and (< beg (point-max))
+ (string= (buffer-substring-no-properties beg (1+ beg)) ":"))
+ ;; Contextual keyword completion
+ (multiple-value-bind (operator-names arg-indices points)
+ (save-excursion
+ (goto-char beg)
+ (slime-enclosing-form-specs))
+ (when operator-names
+ (let ((completions
+ (slime-completions-for-keyword operator-names token
+ arg-indices)))
+ (when (first completions)
+ (return-from slime-contextual-completions completions))
+ ;; If no matching keyword was found, do regular symbol
+ ;; completion.
+ ))))
+ ((and (> beg 2)
+ (string= (buffer-substring-no-properties (- beg 2) beg) "#\\"))
+ ;; Character name completion
+ (return-from slime-contextual-completions
+ (slime-completions-for-character token))))
+ ;; Regular symbol completion
+ (slime-completions token)))
+
+(defun slime-completions (prefix)
+ (slime-eval `(swank:completions ,prefix ',(slime-current-package))))
+
+(defun slime-completions-for-keyword (operator-designator prefix
+ arg-indices)
+ (slime-eval `(swank:completions-for-keyword ',operator-designator
+ ,prefix
+ ',arg-indices)))
+
+(defun slime-completions-for-character (prefix)
+ (slime-eval `(swank:completions-for-character ,prefix)))
+
+
+;;; Complete form
+
+(defun slime-complete-form ()
+ "Complete the form at point.
+This is a superset of the functionality of `slime-insert-arglist'."
+ (interactive)
+ ;; Find the (possibly incomplete) form around point.
+ (let ((form-string (slime-incomplete-form-at-point)))
+ (let ((result (slime-eval `(swank:complete-form ',form-string))))
+ (if (eq result :not-available)
+ (error "Could not generate completion for the form `%s'" form-string)
+ (progn
+ (just-one-space)
+ (save-excursion
+ ;; SWANK:COMPLETE-FORM always returns a closing
+ ;; parenthesis; but we only want to insert one if it's
+ ;; really necessary (thinking especially of paredit.el.)
+ (insert (substring result 0 -1))
+ (let ((slime-close-parens-limit 1))
+ (slime-close-all-parens-in-sexp)))
+ (save-excursion
+ (backward-up-list 1)
+ (indent-sexp)))))))
+
+;;; Initialization
+
+(defvar slime-c-p-c-init-undo-stack nil)
+
+(defun slime-c-p-c-init ()
+ ;; save current state for unload
+ (push
+ `(progn
+ (setq slime-complete-symbol-function ',slime-complete-symbol-function)
+ (remove-hook 'slime-connected-hook 'slime-c-p-c-on-connect)
+ (define-key slime-mode-map "\C-c\C-s"
+ ',(lookup-key slime-mode-map "\C-c\C-s"))
+ (define-key slime-repl-mode-map "\C-c\C-s"
+ ',(lookup-key slime-repl-mode-map "\C-c\C-s")))
+ slime-c-p-c-init-undo-stack)
+ (setq slime-complete-symbol-function 'slime-complete-symbol*)
+ (add-hook 'slime-connected-hook 'slime-c-p-c-on-connect)
+ (define-key slime-mode-map "\C-c\C-s" 'slime-complete-form)
+ (define-key slime-repl-mode-map "\C-c\C-s" 'slime-complete-form))
+
+(defun slime-c-p-c-on-connect ()
+ (slime-eval-async '(swank:swank-require :swank-arglists)))
+
+(defun slime-c-p-c-unload ()
+ (while slime-c-p-c-init-undo-stack
+ (eval (pop slime-c-p-c-init-undo-stack))))
+
+(provide 'slime-c-p-c)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,189 @@
+;;; slime-editing-commands.el -- editing commands whithout server interaction
+;;
+;; Authors: Thomas F. Burdick <tfb(a)OCF.Berkeley.EDU>
+;; Luke Gorrie <luke(a)synap.se>
+;; Bill Clementson <billclem(a)gmail.com>
+;; Tobias C. Rittweiler <tcr(a)freebits.de>
+;; and others
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation
+;;
+;; Add something like this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-editing-commands)))
+;;
+
+(defun slime-beginning-of-defun ()
+ (interactive)
+ (if (and (boundp 'slime-repl-input-start-mark)
+ slime-repl-input-start-mark)
+ (slime-repl-beginning-of-defun)
+ (beginning-of-defun)))
+
+(defun slime-end-of-defun ()
+ (interactive)
+ (if (and (boundp 'slime-repl-input-end-mark)
+ slime-repl-input-end-mark)
+ (slime-repl-end-of-defun)
+ (end-of-defun)))
+
+(defvar slime-comment-start-regexp
+ "\\(\\(^\\|[^\n\\\\]\\)\\([\\\\][\\\\]\\)*\\);+[ \t]*"
+ "Regexp to match the start of a comment.")
+
+(defun slime-beginning-of-comment ()
+ "Move point to beginning of comment.
+If point is inside a comment move to beginning of comment and return point.
+Otherwise leave point unchanged and return NIL."
+ (let ((boundary (point)))
+ (beginning-of-line)
+ (cond ((re-search-forward slime-comment-start-regexp boundary t)
+ (point))
+ (t (goto-char boundary)
+ nil))))
+
+(defun slime-close-all-parens-in-sexp (&optional region)
+ "Balance parentheses of open s-expressions at point.
+Insert enough right parentheses to balance unmatched left parentheses.
+Delete extra left parentheses. Reformat trailing parentheses
+Lisp-stylishly.
+
+If REGION is true, operate on the region. Otherwise operate on
+the top-level sexp before point."
+ (interactive "P")
+ (let ((sexp-level 0)
+ point)
+ (save-excursion
+ (save-restriction
+ (when region
+ (narrow-to-region (region-beginning) (region-end))
+ (goto-char (point-max)))
+ ;; skip over closing parens, but not into comment
+ (skip-chars-backward ") \t\n")
+ (when (slime-beginning-of-comment)
+ (forward-line)
+ (skip-chars-forward " \t"))
+ (setq point (point))
+ ;; count sexps until either '(' or comment is found at first column
+ (while (and (not (looking-at "^[(;]"))
+ (ignore-errors (backward-up-list 1) t))
+ (incf sexp-level))))
+ (when (> sexp-level 0)
+ ;; insert correct number of right parens
+ (goto-char point)
+ (dotimes (i sexp-level) (insert ")"))
+ ;; delete extra right parens
+ (setq point (point))
+ (skip-chars-forward " \t\n)")
+ (skip-chars-backward " \t\n")
+ (let* ((deleted-region (delete-and-extract-region point (point)))
+ (deleted-text (substring-no-properties deleted-region))
+ (prior-parens-count (count ?\) deleted-text)))
+ ;; Remember: we always insert as many parentheses as necessary
+ ;; and only afterwards delete the superfluously-added parens.
+ (when slime-close-parens-limit
+ (let ((missing-parens (- sexp-level prior-parens-count
+ slime-close-parens-limit)))
+ (dotimes (i (max 0 missing-parens))
+ (delete-char -1))))))))
+
+(defvar slime-close-parens-limit nil
+ "Maxmimum parens for `slime-close-all-sexp' to insert. NIL
+means to insert as many parentheses as necessary to correctly
+close the form.")
+
+(defun slime-insert-balanced-comments (arg)
+ "Insert a set of balanced comments around the s-expression
+containing the point. If this command is invoked repeatedly
+\(without any other command occurring between invocations), the
+comment progressively moves outward over enclosing expressions.
+If invoked with a positive prefix argument, the s-expression arg
+expressions out is enclosed in a set of balanced comments."
+ (interactive "*p")
+ (save-excursion
+ (when (eq last-command this-command)
+ (when (search-backward "#|" nil t)
+ (save-excursion
+ (delete-char 2)
+ (while (and (< (point) (point-max)) (not (looking-at " *|#")))
+ (forward-sexp))
+ (replace-match ""))))
+ (while (> arg 0)
+ (backward-char 1)
+ (cond ((looking-at ")") (incf arg))
+ ((looking-at "(") (decf arg))))
+ (insert "#|")
+ (forward-sexp)
+ (insert "|#")))
+
+(defun slime-remove-balanced-comments ()
+ "Remove a set of balanced comments enclosing point."
+ (interactive "*")
+ (save-excursion
+ (when (search-backward "#|" nil t)
+ (delete-char 2)
+ (while (and (< (point) (point-max)) (not (looking-at " *|#")))
+ (forward-sexp))
+ (replace-match ""))))
+
+
+;; SLIME-CLOSE-PARENS-AT-POINT is obsolete:
+
+;; It doesn't work correctly on the REPL, because there
+;; BEGINNING-OF-DEFUN-FUNCTION and END-OF-DEFUN-FUNCTION is bound to
+;; SLIME-REPL-MODE-BEGINNING-OF-DEFUN (and
+;; SLIME-REPL-MODE-END-OF-DEFUN respectively) which compromises the
+;; way how they're expect to work (i.e. END-OF-DEFUN does not signal
+;; an UNBOUND-PARENTHESES error.)
+
+;; Use SLIME-CLOSE-ALL-PARENS-IN-SEXP instead.
+
+;; (defun slime-close-parens-at-point ()
+;; "Close parenthesis at point to complete the top-level-form. Simply
+;; inserts ')' characters at point until `beginning-of-defun' and
+;; `end-of-defun' execute without errors, or `slime-close-parens-limit'
+;; is exceeded."
+;; (interactive)
+;; (loop for i from 1 to slime-close-parens-limit
+;; until (save-excursion
+;; (slime-beginning-of-defun)
+;; (ignore-errors (slime-end-of-defun) t))
+;; do (insert ")")))
+
+(defun slime-reindent-defun (&optional force-text-fill)
+ "Reindent the current defun, or refill the current paragraph.
+If point is inside a comment block, the text around point will be
+treated as a paragraph and will be filled with `fill-paragraph'.
+Otherwise, it will be treated as Lisp code, and the current defun
+will be reindented. If the current defun has unbalanced parens,
+an attempt will be made to fix it before reindenting.
+
+When given a prefix argument, the text around point will always
+be treated as a paragraph. This is useful for filling docstrings."
+ (interactive "P")
+ (save-excursion
+ (if (or force-text-fill (slime-beginning-of-comment))
+ (fill-paragraph nil)
+ (let ((start (progn (unless (or (and (zerop (current-column))
+ (eq ?\( (char-after)))
+ (and slime-repl-input-start-mark
+ (slime-repl-at-prompt-start-p)))
+ (slime-beginning-of-defun))
+ (point)))
+ (end (ignore-errors (slime-end-of-defun) (point))))
+ (unless end
+ (forward-paragraph)
+ (slime-close-all-parens-in-sexp)
+ (slime-end-of-defun)
+ (setf end (point)))
+ (indent-region start end nil)))))
+
+(defun slime-editing-commands-init ()
+ (define-key slime-mode-map "\M-\C-a" 'slime-beginning-of-defun)
+ (define-key slime-mode-map "\M-\C-e" 'slime-end-of-defun)
+ (define-key slime-mode-map "\C-c\M-q" 'slime-reindent-defun))
+
+(provide 'slime-editing-commands)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,28 @@
+;;; slime-fancy-inspector.el --- Fancy inspector for CLOS objects
+;;
+;; Author: Marco Baringer <mb(a)bese.it> and others
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation
+;;
+;; Add this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-fancy-inspector)))
+;; (add-hook 'slime-connected-hook 'slime-install-fancy-inspector)
+
+(defun slime-install-fancy-inspector ()
+ (slime-eval-async '(swank:swank-require :swank-fancy-inspector)
+ (lambda (_)
+ (slime-eval-async '(swank:fancy-inspector-init)))))
+
+(defun slime-deinstall-fancy-inspector ()
+ (slime-eval-async '(swank:fancy-inspector-unload)))
+
+(defun slime-fancy-inspector-init ()
+ (add-hook 'slime-connected-hook 'slime-install-fancy-inspector))
+
+(defun slime-fancy-inspector-unload ()
+ (remove-hook 'slime-connected-hook 'slime-install-fancy-inspector))
+
+(provide 'slime-fancy-inspector)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,74 @@
+;;; slime-fancy.el --- Load and init some fancy SLIME contribs
+;;
+;; Authors: Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-fancy)))
+;;
+;; We load all SLIME contribs that are currently working,
+;; and which only "upgrade" the behavior of SLIME in some way.
+;; This includes:
+;; * Adding new commands, keybindings, menu items
+;; * Making things clickable that would otherwise be just plain text
+
+;; Better arglist display, can be turned off by customization.
+(require 'slime-autodoc)
+(slime-autodoc-init)
+
+;; Adds new commands and installs compound-prefix-completion as
+;; default completion command. Behaves similar to standard Emacs
+;; completion, unless dashes are present. --mkoeppe
+(require 'slime-c-p-c)
+(slime-c-p-c-init)
+
+;; Just adds commands. (Well, shadows commands in lisp-mode-map)
+(require 'slime-editing-commands)
+(slime-editing-commands-init)
+
+;; Makes the inspector fancier.
+(require 'slime-fancy-inspector)
+(slime-fancy-inspector-init)
+
+;; Just adds the command C-c M-i. We do not make fuzzy completion the
+;; default completion invoked by TAB. --mkoeppe
+(require 'slime-fuzzy)
+(slime-fuzzy-init)
+
+;; Do not activate slime-highlighting-edits by default, as it's easier
+;; to explictly activate it (if a user really wants it) than to explictly
+;; deactivate it once it got globally enabled. -TCR.
+(require 'slime-highlight-edits)
+;(slime-highlight-edits-init)
+
+;; Load slime-presentations even though they seem to be a
+;; controversial feature, as they can be easily turned off by
+;; customizing swank:*record-repl-results*. --mkoeppe
+(require 'slime-presentations)
+(slime-presentations-init)
+
+;;; Do not load slime-presentation-streams, as this is an experimental
+;;; feature that installs patches into some Lisps. --mkoeppe
+;;(require 'slime-presentation-streams)
+
+(require 'slime-scratch)
+(slime-scratch-init)
+
+;;; Do not load slime-typeout-frame, as simply loading causes display of a
+;;; typeout frame, which cannot be turned off. --mkoeppe
+;;(require 'slime-typeout-frame)
+
+;; Just adds commands.
+(when (locate-library "tree-widget")
+ (require 'slime-xref-browser))
+
+;; Puts clickable references to documentation into SBCL errors.
+(require 'slime-references)
+(slime-references-init)
+
+(provide 'slime-fancy)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,598 @@
+;;; slime-fuzzy.el --- fuzzy symbol completion
+;;
+;; Authors: Brian Downing <bdowning(a)lavos.net>
+;; Tobias C. Rittweiler <tcr(a)freebits.de>
+;; Attila Lendvai <attila.lendvai(a)gmail.com>
+;; and others
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation
+;;
+;; Add this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-fuzzy)))
+;;
+
+
+;;; Code
+
+(defcustom slime-fuzzy-completion-in-place t
+ "When non-NIL the fuzzy symbol completion is done in place as
+opposed to moving the point to the completion buffer."
+ :group 'slime-mode
+ :type 'boolean)
+
+(defcustom slime-fuzzy-completion-limit 300
+ "Only return and present this many symbols from swank."
+ :group 'slime-mode
+ :type 'integer)
+
+(defcustom slime-fuzzy-completion-time-limit-in-msec 1500
+ "Limit the time spent (given in msec) in swank while gathering comletitions.
+\(NOTE: currently it's rounded up the nearest second)"
+ :group 'slime-mode
+ :type 'integer)
+
+(defvar slime-fuzzy-target-buffer nil
+ "The buffer that is the target of the completion activities.")
+(defvar slime-fuzzy-saved-window-configuration nil
+ "The saved window configuration before the fuzzy completion
+buffer popped up.")
+(defvar slime-fuzzy-start nil
+ "The beginning of the completion slot in the target buffer.
+This is a non-advancing marker.")
+(defvar slime-fuzzy-end nil
+ "The end of the completion slot in the target buffer.
+This is an advancing marker.")
+(defvar slime-fuzzy-original-text nil
+ "The original text that was in the completion slot in the
+target buffer. This is what is put back if completion is
+aborted.")
+(defvar slime-fuzzy-text nil
+ "The text that is currently in the completion slot in the
+target buffer. If this ever doesn't match, the target buffer has
+been modified and we abort without touching it.")
+(defvar slime-fuzzy-first nil
+ "The position of the first completion in the completions buffer.
+The descriptive text and headers are above this.")
+(defvar slime-fuzzy-last nil
+ "The position of the last completion in the completions buffer.
+If the time limit has exhausted during generation possible completion
+choices inside SWANK, an indication is printed below this.")
+(defvar slime-fuzzy-current-completion nil
+ "The current completion object. If this is the same before and
+after point moves in the completions buffer, the text is not
+replaced in the target for efficiency.")
+(defvar slime-fuzzy-current-completion-overlay nil
+ "The overlay representing the current completion in the completion
+buffer. This is used to hightlight the text.")
+
+;;;;;;; slime-target-buffer-fuzzy-completions-mode
+;; NOTE: this mode has to be able to override key mappings in slime-mode
+
+;; FIXME: clean this up
+
+(defun mimic-key-bindings (from-keymap to-keymap bindings-or-operation operation)
+ "Iterate on BINDINGS-OR-OPERATION. If an element is a symbol then
+try to look it up (as an operation) in FROM-KEYMAP. Non symbols are taken
+as default key bindings when none to be mimiced was found in FROM-KEYMAP.
+Set the resulting list of keys in TO-KEYMAP to OPERATION."
+ (let ((mimic-keys nil)
+ (direct-keys nil))
+ (dolist (key-or-operation bindings-or-operation)
+ (if (symbolp key-or-operation)
+ (setf mimic-keys (append mimic-keys (where-is-internal key-or-operation from-keymap nil t)))
+ (push key-or-operation direct-keys)))
+ (dolist (key (or mimic-keys direct-keys))
+ (define-key to-keymap key operation))))
+
+(defvar slime-target-buffer-fuzzy-completions-map
+ (let* ((map (make-sparse-keymap)))
+ (flet ((remap (keys to)
+ (mimic-key-bindings global-map map keys to)))
+
+ (remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort)
+
+ (remap (list 'slime-fuzzy-indent-and-complete-symbol
+ 'slime-indent-and-complete-symbol
+ (kbd "<tab>"))
+ 'slime-fuzzy-select-or-update-completions)
+ (remap (list 'previous-line (kbd "<up>")) 'slime-fuzzy-prev)
+ (remap (list 'next-line (kbd "<down>")) 'slime-fuzzy-next)
+ (remap (list 'isearch-forward (kbd "C-s"))
+ (lambda ()
+ (interactive)
+ (select-window (get-buffer-window (slime-get-fuzzy-buffer)))
+ (call-interactively 'isearch-forward)))
+
+ ;; some unconditional direct bindings
+ (dolist (key (list (kbd "<return>") (kbd "RET") (kbd "<SPC>") "(" ")" "[" "]"))
+ (define-key map key 'slime-fuzzy-select-and-process-event-in-target-buffer)))
+ map
+ )
+ "Keymap for slime-target-buffer-fuzzy-completions-mode. This will override the key
+bindings in the target buffer temporarily during completion.")
+
+;; Make sure slime-fuzzy-target-buffer-completions-mode's map is
+;; before everything else.
+(setf minor-mode-map-alist
+ (stable-sort minor-mode-map-alist
+ (lambda (a b)
+ (eq a 'slime-fuzzy-target-buffer-completions-mode))
+ :key #'car))
+
+
+(define-minor-mode slime-fuzzy-target-buffer-completions-mode
+ "This minor mode is intented to override key bindings during fuzzy
+completions in the target buffer. Most of the bindings will do an implicit select
+in the completion window and let the keypress be processed in the target buffer."
+ nil
+ nil
+ slime-target-buffer-fuzzy-completions-map)
+
+(add-to-list 'minor-mode-alist
+ '(slime-fuzzy-target-buffer-completions-mode
+ " Fuzzy Target Buffer Completions"))
+
+(define-derived-mode slime-fuzzy-completions-mode
+ fundamental-mode "Fuzzy Completions"
+ "Major mode for presenting fuzzy completion results.
+
+When you run `slime-fuzzy-complete-symbol', the symbol token at
+point is completed using the Fuzzy Completion algorithm; this
+means that the token is taken as a sequence of characters and all
+the various possibilities that this sequence could meaningfully
+represent are offered as selectable choices, sorted by how well
+they deem to be a match for the token. (For instance, the first
+choice of completing on \"mvb\" would be \"multiple-value-bind\".)
+
+Therefore, a new buffer (*Fuzzy Completions*) will pop up that
+contains the different completion choices. Simultaneously, a
+special minor-mode will be temporarily enabled in the original
+buffer where you initiated fuzzy completion (also called the
+``target buffer'') in order to navigate through the *Fuzzy
+Completions* buffer without leaving.
+
+With focus in *Fuzzy Completions*:
+ Type `n' and `p' (`UP', `DOWN') to navigate between completions.
+ Type `RET' or `TAB' to select the completion near point.
+ Type `q' to abort.
+
+With focus in the target buffer:
+ Type `UP' and `DOWN' to navigate between completions.
+ Type a character that does not constitute a symbol name
+ to insert the current choice and then that character (`(', `)',
+ `SPACE', `RET'.) Use `TAB' to simply insert the current choice.
+ Use C-g to abort.
+
+Alternatively, you can click <mouse-2> on a completion to select it.
+
+
+Complete listing of keybindings within the target buffer:
+
+\\<slime-target-buffer-fuzzy-completions-map>\
+\\{slime-target-buffer-fuzzy-completions-map}
+
+Complete listing of keybindings with *Fuzzy Completions*:
+
+\\<slime-fuzzy-completions-map>\
+\\{slime-fuzzy-completions-map}"
+ (use-local-map slime-fuzzy-completions-map))
+
+(defvar slime-fuzzy-completions-map
+ (let* ((map (make-sparse-keymap)))
+ (flet ((remap (keys to)
+ (mimic-key-bindings global-map map keys to)))
+ (remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort)
+ (define-key map "q" 'slime-fuzzy-abort)
+
+ (remap (list 'previous-line (kbd "<up>")) 'slime-fuzzy-prev)
+ (remap (list 'next-line (kbd "<down>")) 'slime-fuzzy-next)
+
+ (define-key map "n" 'slime-fuzzy-next)
+ (define-key map "\M-n" 'slime-fuzzy-next)
+
+ (define-key map "p" 'slime-fuzzy-prev)
+ (define-key map "\M-p" 'slime-fuzzy-prev)
+
+ (define-key map "\d" 'scroll-down)
+
+ (remap (list 'slime-fuzzy-indent-and-complete-symbol
+ 'slime-indent-and-complete-symbol
+ (kbd "<tab>"))
+ 'slime-fuzzy-select)
+
+ (define-key map (kbd "<mouse-2>") 'slime-fuzzy-select/mouse))
+
+ (define-key map (kbd "RET") 'slime-fuzzy-select)
+ (define-key map (kbd "<SPC>") 'slime-fuzzy-select)
+
+ map)
+ "Keymap for slime-fuzzy-completions-mode when in the completion buffer.")
+
+(defun slime-fuzzy-completions (prefix &optional default-package)
+ "Get the list of sorted completion objects from completing
+`prefix' in `package' from the connected Lisp."
+ (let ((prefix (etypecase prefix
+ (symbol (symbol-name prefix))
+ (string prefix))))
+ (slime-eval `(swank:fuzzy-completions ,prefix
+ ,(or default-package
+ (slime-find-buffer-package)
+ (slime-current-package))
+ :limit ,slime-fuzzy-completion-limit
+ :time-limit-in-msec ,slime-fuzzy-completion-time-limit-in-msec))))
+
+(defun slime-fuzzy-selected (prefix completion)
+ "Tell the connected Lisp that the user selected completion
+`completion' as the completion for `prefix'."
+ (let ((no-properties (copy-sequence prefix)))
+ (set-text-properties 0 (length no-properties) nil no-properties)
+ (slime-eval `(swank:fuzzy-completion-selected ,no-properties
+ ',completion))))
+
+(defun slime-fuzzy-indent-and-complete-symbol ()
+ "Indent the current line and perform fuzzy symbol completion. First
+indent the line. If indenting doesn't move point, complete the
+symbol. If there's no symbol at the point, show the arglist for the
+most recently enclosed macro or function."
+ (interactive)
+ (let ((pos (point)))
+ (unless (get-text-property (line-beginning-position) 'slime-repl-prompt)
+ (lisp-indent-line))
+ (when (= pos (point))
+ (cond ((save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t))
+ (slime-fuzzy-complete-symbol))
+ ((memq (char-before) '(?\t ?\ ))
+ (slime-echo-arglist))))))
+
+(defun* slime-fuzzy-complete-symbol ()
+ "Fuzzily completes the abbreviation at point into a symbol."
+ (interactive)
+ (when (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
+ (return-from slime-fuzzy-complete-symbol
+ (if slime-when-complete-filename-expand
+ (comint-replace-by-expanded-filename)
+ (comint-dynamic-complete-as-filename))))
+ (let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
+ (beg (move-marker (make-marker) (slime-symbol-start-pos)))
+ (prefix (buffer-substring-no-properties beg end)))
+ (destructuring-bind (completion-set interrupted-p)
+ (slime-fuzzy-completions prefix)
+ (if (null completion-set)
+ (progn (slime-minibuffer-respecting-message
+ "Can't find completion for \"%s\"" prefix)
+ (ding)
+ (slime-fuzzy-done))
+ (goto-char end)
+ (cond ((slime-length= completion-set 1)
+ (insert-and-inherit (caar completion-set)) ; insert completed string
+ (delete-region beg end)
+ (goto-char (+ beg (length (caar completion-set))))
+ (slime-minibuffer-respecting-message "Sole completion")
+ (slime-fuzzy-done))
+ ;; Incomplete
+ (t
+ (slime-minibuffer-respecting-message "Complete but not unique")
+ (slime-fuzzy-choices-buffer completion-set interrupted-p beg end)))))))
+
+
+(defun slime-get-fuzzy-buffer ()
+ (get-buffer-create "*Fuzzy Completions*"))
+
+(defvar slime-fuzzy-explanation
+ "For help on how the use this buffer, see `slime-fuzzy-completions-mode'.
+
+Flags: boundp fboundp generic-function class macro special-operator package
+\n"
+ "The explanation that gets inserted at the beginning of the
+*Fuzzy Completions* buffer.")
+
+(defun slime-fuzzy-insert-completion-choice (completion max-length)
+ "Inserts the completion object `completion' as a formatted
+completion choice into the current buffer, and mark it with the
+proper text properties."
+ (let ((start (point))
+ (symbol-name (first completion))
+ (score (second completion))
+ (chunks (third completion))
+ (flags (fourth completion)))
+ (insert symbol-name)
+ (let ((end (point)))
+ (dolist (chunk chunks)
+ (put-text-property (+ start (first chunk))
+ (+ start (first chunk)
+ (length (second chunk)))
+ 'face 'bold))
+ (put-text-property start (point) 'mouse-face 'highlight)
+ (dotimes (i (- max-length (- end start)))
+ (insert " "))
+ (insert (format " %s%s%s%s%s%s%s %8.2f"
+ (if (member :boundp flags) "b" "-")
+ (if (member :fboundp flags) "f" "-")
+ (if (member :generic-function flags) "g" "-")
+ (if (member :class flags) "c" "-")
+ (if (member :macro flags) "m" "-")
+ (if (member :special-operator flags) "s" "-")
+ (if (member :package flags) "p" "-")
+ score))
+ (insert "\n")
+ (put-text-property start (point) 'completion completion))))
+
+(defun slime-fuzzy-insert (text)
+ "Inserts `text' into the target buffer in the completion slot.
+If the buffer has been modified in the meantime, abort the
+completion process. Otherwise, update all completion variables
+so that the new text is present."
+ (with-current-buffer slime-fuzzy-target-buffer
+ (cond
+ ((not (string-equal slime-fuzzy-text
+ (buffer-substring slime-fuzzy-start
+ slime-fuzzy-end)))
+ (slime-fuzzy-done)
+ (beep)
+ (message "Target buffer has been modified!"))
+ (t
+ (goto-char slime-fuzzy-start)
+ (delete-region slime-fuzzy-start slime-fuzzy-end)
+ (insert-and-inherit text)
+ (setq slime-fuzzy-text text)
+ (goto-char slime-fuzzy-end)))))
+
+(defun slime-fuzzy-choices-buffer (completions interrupted-p start end)
+ "Creates (if neccessary), populates, and pops up the *Fuzzy
+Completions* buffer with the completions from `completions' and
+the completion slot in the current buffer bounded by `start' and
+`end'. This saves the window configuration before popping the
+buffer so that it can possibly be restored when the user is
+done."
+ (let ((new-completion-buffer (not slime-fuzzy-target-buffer)))
+ (when new-completion-buffer
+ (setq slime-fuzzy-saved-window-configuration
+ (current-window-configuration)))
+ (slime-fuzzy-enable-target-buffer-completions-mode)
+ (setq slime-fuzzy-target-buffer (current-buffer))
+ (setq slime-fuzzy-start (move-marker (make-marker) start))
+ (setq slime-fuzzy-end (move-marker (make-marker) end))
+ (set-marker-insertion-type slime-fuzzy-end t)
+ (setq slime-fuzzy-original-text (buffer-substring start end))
+ (setq slime-fuzzy-text slime-fuzzy-original-text)
+ (slime-fuzzy-fill-completions-buffer completions interrupted-p)
+ (pop-to-buffer (slime-get-fuzzy-buffer))
+ (when new-completion-buffer
+ ;; Hook to nullify window-config restoration if the user changes
+ ;; the window configuration himself.
+ (when (boundp 'window-configuration-change-hook)
+ (add-hook 'window-configuration-change-hook
+ 'slime-fuzzy-window-configuration-change))
+ (add-local-hook 'kill-buffer-hook 'slime-fuzzy-abort)
+ (setq buffer-quit-function 'slime-fuzzy-abort)) ; M-Esc Esc
+ (when slime-fuzzy-completion-in-place
+ ;; switch back to the original buffer
+ (switch-to-buffer-other-window slime-fuzzy-target-buffer))))
+
+(defun slime-fuzzy-fill-completions-buffer (completions interrupted-p)
+ "Erases and fills the completion buffer with the given completions."
+ (with-current-buffer (slime-get-fuzzy-buffer)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (slime-fuzzy-completions-mode)
+ (insert slime-fuzzy-explanation)
+ (let ((max-length 12))
+ (dolist (completion completions)
+ (setf max-length (max max-length (length (first completion)))))
+
+ (insert "Completion:")
+ (dotimes (i (- max-length 10)) (insert " "))
+ ;; Flags: Score:
+ ;; ... ------- --------
+ ;; bfgcmsp
+ (insert "Flags: Score:\n")
+ (dotimes (i max-length) (insert "-"))
+ (insert " ------- --------\n")
+ (setq slime-fuzzy-first (point))
+
+ (dolist (completion completions)
+ (setq slime-fuzzy-last (point)) ; will eventually become the last entry
+ (slime-fuzzy-insert-completion-choice completion max-length))
+
+ (when interrupted-p
+ (insert "...\n")
+ (insert "[Interrupted: time limit exhausted]"))
+
+ (setq buffer-read-only t))
+ (setq slime-fuzzy-current-completion
+ (caar completions))
+ (goto-char 0)
+ (slime-fuzzy-next)))
+
+(defun slime-fuzzy-enable-target-buffer-completions-mode ()
+ "Store the target buffer's local map, so that we can restore it."
+ (unless slime-fuzzy-target-buffer-completions-mode
+; (slime-log-event "Enabling target buffer completions mode")
+ (slime-fuzzy-target-buffer-completions-mode 1)))
+
+(defun slime-fuzzy-disable-target-buffer-completions-mode ()
+ "Restores the target buffer's local map when completion is finished."
+ (when slime-fuzzy-target-buffer-completions-mode
+; (slime-log-event "Disabling target buffer completions mode")
+ (slime-fuzzy-target-buffer-completions-mode 0)))
+
+(defun slime-fuzzy-insert-from-point ()
+ "Inserts the completion that is under point in the completions
+buffer into the target buffer. If the completion in question had
+already been inserted, it does nothing."
+ (with-current-buffer (slime-get-fuzzy-buffer)
+ (let ((current-completion (get-text-property (point) 'completion)))
+ (when (and current-completion
+ (not (eq slime-fuzzy-current-completion
+ current-completion)))
+ (slime-fuzzy-insert
+ (first (get-text-property (point) 'completion)))
+ (setq slime-fuzzy-current-completion
+ current-completion)))))
+
+(defun slime-fuzzy-post-command-hook ()
+ "The post-command-hook for the *Fuzzy Completions* buffer.
+This makes sure the completion slot in the target buffer matches
+the completion that point is on in the completions buffer."
+ (condition-case err
+ (when slime-fuzzy-target-buffer
+ (slime-fuzzy-insert-from-point))
+ (error
+ ;; Because this is called on the post-command-hook, we mustn't let
+ ;; errors propagate.
+ (message "Error in slime-fuzzy-post-command-hook: %S" err))))
+
+(defun slime-fuzzy-next ()
+ "Moves point directly to the next completion in the completions
+buffer."
+ (interactive)
+ (with-current-buffer (slime-get-fuzzy-buffer)
+ (slime-fuzzy-dehighlight-current-completion)
+ (let ((point (next-single-char-property-change (point) 'completion nil slime-fuzzy-last)))
+ (set-window-point (get-buffer-window (current-buffer)) point)
+ (goto-char point))
+ (slime-fuzzy-highlight-current-completion)))
+
+(defun slime-fuzzy-prev ()
+ "Moves point directly to the previous completion in the
+completions buffer."
+ (interactive)
+ (with-current-buffer (slime-get-fuzzy-buffer)
+ (slime-fuzzy-dehighlight-current-completion)
+ (let ((point (previous-single-char-property-change (point) 'completion nil slime-fuzzy-first)))
+ (set-window-point (get-buffer-window (current-buffer)) point)
+ (goto-char point))
+ (slime-fuzzy-highlight-current-completion)))
+
+(defun slime-fuzzy-dehighlight-current-completion ()
+ "Restores the original face for the current completion."
+ (when slime-fuzzy-current-completion-overlay
+ (overlay-put slime-fuzzy-current-completion-overlay 'face 'nil)))
+
+(defun slime-fuzzy-highlight-current-completion ()
+ "Highlights the current completion, so that the user can see it on the screen."
+ (let ((pos (point)))
+ (setq slime-fuzzy-current-completion-overlay
+ (make-overlay (point) (1- (search-forward " "))
+ (current-buffer) t nil))
+ (overlay-put slime-fuzzy-current-completion-overlay 'face 'secondary-selection)
+ (goto-char pos)))
+
+(defun slime-fuzzy-abort ()
+ "Aborts the completion process, setting the completions slot in
+the target buffer back to its original contents."
+ (interactive)
+ (when slime-fuzzy-target-buffer
+ (slime-fuzzy-done)))
+
+(defun slime-fuzzy-select ()
+ "Selects the current completion, making sure that it is inserted
+into the target buffer. This tells the connected Lisp what completion
+was selected."
+ (interactive)
+ (when slime-fuzzy-target-buffer
+ (with-current-buffer (slime-get-fuzzy-buffer)
+ (let ((completion (get-text-property (point) 'completion)))
+ (when completion
+ (slime-fuzzy-insert (first completion))
+ (slime-fuzzy-selected slime-fuzzy-original-text
+ completion)
+ (slime-fuzzy-done))))))
+
+(defun slime-fuzzy-select-or-update-completions ()
+ "If there were no changes since the last time fuzzy completion was started
+this function will select the current completion. Otherwise refreshes the completion
+list based on the changes made."
+ (interactive)
+; (slime-log-event "Selecting or updating completions")
+ (if (string-equal slime-fuzzy-original-text
+ (buffer-substring slime-fuzzy-start
+ slime-fuzzy-end))
+ (slime-fuzzy-select)
+ (slime-fuzzy-complete-symbol)))
+
+(defun slime-fuzzy-process-event-in-completions-buffer ()
+ "Simply processes the event in the target buffer"
+ (interactive)
+ (with-current-buffer (slime-get-fuzzy-buffer)
+ (push last-input-event unread-command-events)))
+
+(defun slime-fuzzy-select-and-process-event-in-target-buffer ()
+ "Selects the current completion, making sure that it is inserted
+into the target buffer and processes the event in the target buffer."
+ (interactive)
+; (slime-log-event "Selecting and processing event in target buffer")
+ (when slime-fuzzy-target-buffer
+ (let ((buff slime-fuzzy-target-buffer))
+ (slime-fuzzy-select)
+ (with-current-buffer buff
+ (slime-fuzzy-disable-target-buffer-completions-mode)
+ (push last-input-event unread-command-events)))))
+
+(defun slime-fuzzy-select/mouse (event)
+ "Handle a mouse-2 click on a completion choice as if point were
+on the completion choice and the slime-fuzzy-select command was
+run."
+ (interactive "e")
+ (with-current-buffer (window-buffer (posn-window (event-end event)))
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
+ (when (get-text-property (point) 'mouse-face)
+ (slime-fuzzy-insert-from-point)
+ (slime-fuzzy-select)))))
+
+(defun slime-fuzzy-done ()
+ "Cleans up after the completion process. This removes all hooks,
+and attempts to restore the window configuration. If this fails,
+it just burys the completions buffer and leaves the window
+configuration alone."
+ (when slime-fuzzy-target-buffer
+ (set-buffer slime-fuzzy-target-buffer)
+ (slime-fuzzy-disable-target-buffer-completions-mode)
+ (if (slime-fuzzy-maybe-restore-window-configuration)
+ (bury-buffer (slime-get-fuzzy-buffer))
+ ;; We couldn't restore the windows, so just bury the fuzzy
+ ;; completions buffer and let something else fill it in.
+ (pop-to-buffer (slime-get-fuzzy-buffer))
+ (bury-buffer))
+ (pop-to-buffer slime-fuzzy-target-buffer)
+ (goto-char slime-fuzzy-end)
+ (setq slime-fuzzy-target-buffer nil)
+ (remove-hook 'window-configuration-change-hook
+ 'slime-fuzzy-window-configuration-change)))
+
+(defun slime-fuzzy-maybe-restore-window-configuration ()
+ "Restores the saved window configuration if it has not been
+nullified."
+ (when (boundp 'window-configuration-change-hook)
+ (remove-hook 'window-configuration-change-hook
+ 'slime-fuzzy-window-configuration-change))
+ (if (not slime-fuzzy-saved-window-configuration)
+ nil
+ (set-window-configuration slime-fuzzy-saved-window-configuration)
+ (setq slime-fuzzy-saved-window-configuration nil)
+ t))
+
+(defun slime-fuzzy-window-configuration-change ()
+ "Called on window-configuration-change-hook. Since the window
+configuration was changed, we nullify our saved configuration."
+ (setq slime-fuzzy-saved-window-configuration nil))
+
+;;; Initialization
+
+(defun slime-fuzzy-init ()
+ (add-hook 'slime-connected-hook 'slime-fuzzy-on-connect)
+ (slime-fuzzy-bind-keys))
+
+(defun slime-fuzzy-bind-keys ()
+ (define-key slime-mode-map "\C-c\M-i" 'slime-fuzzy-complete-symbol)
+ (define-key slime-repl-mode-map "\C-c\M-i" 'slime-fuzzy-complete-symbol))
+
+(defun slime-fuzzy-on-connect ()
+ (slime-eval-async '(swank:swank-require :swank-fuzzy)))
+
+(provide 'slime-fuzzy)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-highlight-edits.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-highlight-edits.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-highlight-edits.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,99 @@
+;;; slime-higlight-edits --- highlight edited, i.e. not yet compiled, code
+;;
+;; Author: William Bland <doctorbill.news(a)gmail.com> and others
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this your .emacs:
+;;
+;; (add-to-list 'load-path "<contrib-dir>")
+;; (autoload 'slime-highlight-edits-mode "slime-highlight-edits")
+;; (add-hook 'slime-mode-hook (lambda () (slime-highlight-edits-mode 1)))
+
+(defface slime-highlight-edits-face
+ `((((class color) (background light))
+ (:background "lightgray"))
+ (((class color) (background dark))
+ (:background "dimgray"))
+ (t (:background "yellow")))
+ "Face for displaying edit but not compiled code."
+ :group 'slime-mode-faces)
+
+(define-minor-mode slime-highlight-edits-mode
+ "Minor mode to highlight not-yet-compiled code." nil)
+
+(add-hook 'slime-highlight-edits-mode-on-hook
+ 'slime-highlight-edits-init-buffer)
+
+(add-hook 'slime-highlight-edits-mode-off-hook
+ 'slime-highlight-edits-reset-buffer)
+
+(defun slime-highlight-edits-init-buffer ()
+ (make-local-variable 'after-change-functions)
+ (add-to-list 'after-change-functions
+ 'slime-highlight-edits)
+ (add-to-list 'slime-before-compile-functions
+ 'slime-highlight-edits-compile-hook))
+
+(defun slime-highlight-edits-reset-buffer ()
+ (setq after-change-functions
+ (remove 'slime-highlight-edits after-change-functions))
+ (slime-remove-edits (point-min) (point-max)))
+
+;; FIXME: what's the LEN arg for?
+(defun slime-highlight-edits (beg end &optional len)
+ (save-match-data
+ (when (and (slime-connected-p)
+ (not (slime-inside-comment-p beg end))
+ (not (slime-only-whitespace-p beg end)))
+ (let ((overlay (make-overlay beg end)))
+ (overlay-put overlay 'face 'slime-highlight-edits-face)
+ (overlay-put overlay 'slime-edit t)))))
+
+(defun slime-remove-edits (start end)
+ "Delete the existing Slime edit hilights in the current buffer."
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (dolist (o (overlays-at (point)))
+ (when (overlay-get o 'slime-edit)
+ (delete-overlay o)))
+ (goto-char (next-overlay-change (point))))))
+
+(defun slime-highlight-edits-compile-hook (start end)
+ (when slime-highlight-edits-mode
+ (let ((start (save-excursion (goto-char start)
+ (skip-chars-backward " \t\n\r")
+ (point)))
+ (end (save-excursion (goto-char end)
+ (skip-chars-forward " \t\n\r")
+ (point))))
+ (slime-remove-edits start end))))
+
+(defun slime-inside-comment-p (beg end)
+ "Is the region from BEG to END in a comment?"
+ (save-excursion
+ (goto-char beg)
+ (let* ((hs-c-start-regexp ";\\|#|")
+ (comment (hs-inside-comment-p)))
+ (and comment
+ (destructuring-bind (cbeg cend) comment
+ (<= end cend))))))
+
+(defun slime-only-whitespace-p (beg end)
+ "Contains the region from BEG to END only whitespace?"
+ (save-excursion
+ (goto-char beg)
+ (skip-chars-forward " \n\t\r" end)
+ (<= end (point))))
+
+(defun slime-highlight-edits-mode-on () (slime-highlight-edits-mode 1))
+
+(defun slime-highlight-edits-init ()
+ (add-hook 'slime-mode-hook 'slime-highlight-edits-mode-on))
+
+(defun slime-highlight-edits-unload ()
+ (remove-hook 'slime-mode-hook 'slime-highlight-edits-mode-on))
+
+(provide 'slime-highlight-edits)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,378 @@
+;;; slime-parse.el --- parsing of Common Lisp source code
+;;
+;; Authors: Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;; Tobias C. Rittweiler <tcr(a)freebits.de>
+;; and others
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+
+(defun slime-incomplete-form-at-point ()
+ "Looks for a ``raw form spec'' around point to be processed by
+SWANK::PARSE-FORM-SPEC. It is similiar to
+SLIME-INCOMPLETE-SEXP-AT-POINT but looks further back than just
+one sexp to find out the context."
+ (multiple-value-bind (operators arg-indices points)
+ (slime-enclosing-form-specs)
+ (if (null operators)
+ ""
+ (let ((op (first operators)))
+ (destructure-case (slime-ensure-list op)
+ ((:declaration declspec) op)
+ ((:type-specifier typespec) op)
+ (t (slime-ensure-list
+ (save-excursion (goto-char (first points))
+ (slime-parse-sexp-at-point
+ (1+ (first arg-indices)))))))))))
+
+;; XXX: unused function
+(defun slime-cl-symbol-external-ref-p (symbol)
+ "Does SYMBOL refer to an external symbol?
+FOO:BAR is an external reference.
+FOO::BAR is not, and nor is BAR."
+ (let ((name (if (stringp symbol) symbol (symbol-name symbol))))
+ (and (string-match ":" name)
+ (not (string-match "::" name)))))
+
+(defun slime-cl-symbol-name (symbol)
+ (let ((n (if (stringp symbol) symbol (symbol-name symbol))))
+ (if (string-match ":\\([^:]*\\)$" n)
+ (let ((symbol-part (match-string 1 n)))
+ (if (string-match "^|\\(.*\\)|$" symbol-part)
+ (match-string 1 symbol-part)
+ symbol-part))
+ n)))
+
+(defun slime-cl-symbol-package (symbol &optional default)
+ (let ((n (if (stringp symbol) symbol (symbol-name symbol))))
+ (if (string-match "^\\([^:]*\\):" n)
+ (match-string 1 n)
+ default)))
+
+;; XXX: unused function
+(defun slime-qualify-cl-symbol (symbol-or-name)
+ "Like `slime-qualify-cl-symbol-name', but interns the result."
+ (intern (slime-qualify-cl-symbol-name symbol-or-name)))
+
+(defun slime-qualify-cl-symbol-name (symbol-or-name)
+ "Return a package-qualified symbol-name that indicates the CL symbol
+SYMBOL. If SYMBOL doesn't already have a package prefix the current
+package is used."
+ (let ((s (if (stringp symbol-or-name)
+ symbol-or-name
+ (symbol-name symbol-or-name))))
+ (if (slime-cl-symbol-package s)
+ s
+ (format "%s::%s"
+ (let* ((package (slime-current-package)))
+ ;; package is a string like ":cl-user" or "CL-USER".
+ (if (and package (string-match "^:" package))
+ (substring package 1)
+ package))
+ (slime-cl-symbol-name s)))))
+
+
+(defun slime-parse-sexp-at-point (&optional n skip-blanks-p)
+ "Return the sexp at point as a string, otherwise nil.
+If N is given and greater than 1, a list of all such sexps
+following the sexp at point is returned. (If there are not
+as many sexps as N, a list with < N sexps is returned.)
+
+If SKIP-BLANKS-P is true, leading whitespaces &c are skipped.
+"
+ (interactive "p") (or n (setq n 1))
+ (flet ((sexp-at-point (first-choice)
+ (let ((string (if (eq first-choice :symbol-first)
+ (or (slime-symbol-name-at-point)
+ (thing-at-point 'sexp))
+ (or (thing-at-point 'sexp)
+ (slime-symbol-name-at-point)))))
+ (if string (substring-no-properties string) nil))))
+ ;; `thing-at-point' depends upon the current syntax table; otherwise
+ ;; keywords like `:foo' are not recognized as sexps. (This function
+ ;; may be called from temporary buffers etc.)
+ (with-syntax-table lisp-mode-syntax-table
+ (save-excursion
+ (when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(.
+ (slime-forward-blanks))
+ (let ((result nil))
+ (dotimes (i n)
+ ;; `foo(bar baz)' where point is at ?\( or ?\).
+ (if (and (char-after) (member (char-syntax (char-after)) '(?\( ?\) ?\')))
+ (push (sexp-at-point :sexp-first) result)
+ (push (sexp-at-point :symbol-first) result))
+ (ignore-errors (forward-sexp) (slime-forward-blanks))
+ (save-excursion
+ (unless (slime-point-moves-p (ignore-errors (forward-sexp)))
+ (return))))
+ (if (slime-length= result 1)
+ (first result)
+ (nreverse result)))))))
+
+(defun slime-incomplete-sexp-at-point (&optional n)
+ (interactive "p") (or n (setq n 1))
+ (buffer-substring-no-properties (save-excursion (backward-up-list n) (point))
+ (point)))
+
+
+(defun slime-parse-extended-operator-name (user-point forms indices points)
+ "Assume that point is directly at the operator that should be parsed.
+USER-POINT is the value of `point' where the user was looking at.
+OPS, INDICES and POINTS are updated to reflect the new values after
+parsing, and are then returned back as multiple values."
+ ;; OPS, INDICES and POINTS are like the finally returned values of
+ ;; SLIME-ENCLOSING-FORM-SPECS except that they're in reversed order,
+ ;; i.e. the leftmost (that is the latest) operator comes
+ ;; first.
+ (save-excursion
+ (ignore-errors
+ (let* ((current-op (first (first forms)))
+ (op-name (upcase (slime-cl-symbol-name current-op)))
+ (assoc (assoc op-name slime-extended-operator-name-parser-alist))
+ (entry (cdr assoc))
+ (parser (if (and entry (listp entry))
+ (apply (first entry) (rest entry))
+ entry)))
+ (ignore-errors
+ (forward-char (1+ (length current-op)))
+ (slime-forward-blanks))
+ (when parser
+ (multiple-value-setq (forms indices points)
+ (funcall parser op-name user-point forms indices points))))))
+ (values forms indices points))
+
+
+(defvar slime-extended-operator-name-parser-alist
+ '(("MAKE-INSTANCE" . (slime-make-extended-operator-parser/look-ahead 1))
+ ("MAKE-CONDITION" . (slime-make-extended-operator-parser/look-ahead 1))
+ ("ERROR" . (slime-make-extended-operator-parser/look-ahead 1))
+ ("SIGNAL" . (slime-make-extended-operator-parser/look-ahead 1))
+ ("WARN" . (slime-make-extended-operator-parser/look-ahead 1))
+ ("CERROR" . (slime-make-extended-operator-parser/look-ahead 2))
+ ("CHANGE-CLASS" . (slime-make-extended-operator-parser/look-ahead 2))
+ ("DEFMETHOD" . (slime-make-extended-operator-parser/look-ahead 1))
+ ("APPLY" . (slime-make-extended-operator-parser/look-ahead 1))
+ ("DECLARE" . slime-parse-extended-operator/declare)
+ ("DECLAIM" . slime-parse-extended-operator/declare)
+ ("PROCLAIM" . slime-parse-extended-operator/declare)))
+
+(defun slime-make-extended-operator-parser/look-ahead (steps)
+ "Returns a parser that parses the current operator at point
+plus STEPS-many additional sexps on the right side of the
+operator."
+ (lexical-let ((n steps))
+ #'(lambda (name user-point current-forms current-indices current-points)
+ (let ((old-forms (rest current-forms)))
+ (let* ((args (slime-ensure-list (slime-parse-sexp-at-point n)))
+ (arg-specs (mapcar #'slime-make-form-spec-from-string args)))
+ (setq current-forms (cons `(,name ,@arg-specs) old-forms))))
+ (values current-forms current-indices current-points)
+ )))
+
+(defun slime-parse-extended-operator/declare
+ (name user-point current-forms current-indices current-points)
+ (when (string= (thing-at-point 'char) "(")
+ (let ((orig-point (point)))
+ (goto-char user-point)
+ (slime-end-of-symbol)
+ ;; Head of CURRENT-FORMS is "declare" at this point, but we're
+ ;; interested in what comes next.
+ (let* ((decl-ops (rest current-forms))
+ (decl-indices (rest current-indices))
+ (decl-points (rest current-points))
+ (decl-pos (1- (first decl-points)))
+ (nesting (slime-nesting-until-point decl-pos))
+ (declspec-str (concat (slime-incomplete-sexp-at-point nesting)
+ (make-string nesting ?\)))))
+ (save-match-data ; `(declare ((foo ...))' or `(declare (type (foo ...)))' ?
+ (if (or (eql 0 (string-match "\\s-*(\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
+ declspec-str))
+ (eql 0 (string-match "\\s-*(type\\s-*\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
+ declspec-str)))
+ (let* ((typespec-str (match-string 1 declspec-str))
+ (typespec (slime-make-form-spec-from-string typespec-str)))
+ (setq current-forms (list `(:type-specifier ,typespec)))
+ (setq current-indices (list (second decl-indices)))
+ (setq current-points (list (second decl-points))))
+ (let ((declspec (slime-make-form-spec-from-string declspec-str)))
+ (setq current-forms (list `(,name) `(:declaration ,declspec)))
+ (setq current-indices (list (first current-indices)
+ (first decl-indices)))
+ (setq current-points (list (first current-points)
+ (first decl-points)))))))))
+ (values current-forms current-indices current-points))
+
+(defun slime-nesting-until-point (target-point)
+ "Returns the nesting level between current point and TARGET-POINT.
+If TARGET-POINT could not be reached, 0 is returned. (As a result
+TARGET-POINT should always be placed just before a `?\('.)"
+ (save-excursion
+ (let ((nesting 0))
+ (while (> (point) target-point)
+ (backward-up-list)
+ (incf nesting))
+ (if (= (point) target-point)
+ nesting
+ 0))))
+
+(defun slime-make-form-spec-from-string (string &optional strip-operator-p)
+ "If STRIP-OPERATOR-P is T and STRING is the string
+representation of a form, the string representation of this form
+is stripped from the form. This can be important to avoid mutual
+recursion between this function, `slime-enclosing-form-specs' and
+`slime-parse-extended-operator-name'.
+
+Examples:
+
+ \"(foo (bar 1 (baz :quux)) 'toto)\"
+
+ => (\"foo\" (\"bar\" \"1\" (\"baz\" \":quux\")) \"'toto\")
+"
+ (cond ((slime-length= string 0) "")
+ ((equal string "()") '())
+ (t
+ (with-temp-buffer
+ ;; Do NEVER ever try to activate `lisp-mode' here with
+ ;; `slime-use-autodoc-mode' enabled, as this function is used
+ ;; to compute the current autodoc itself.
+ (erase-buffer)
+ (insert string)
+ (when strip-operator-p ; `(OP arg1 arg2 ...)' ==> `(arg1 arg2 ...)'
+ (goto-char (point-min))
+ (when (string= (thing-at-point 'char) "(")
+ (ignore-errors (forward-char 1)
+ (forward-sexp)
+ (slime-forward-blanks))
+ (delete-region (point-min) (point))
+ (insert "(")))
+ (goto-char (1- (point-max))) ; `(OP arg1 ... argN|)'
+ (multiple-value-bind (forms indices points)
+ (slime-enclosing-form-specs 1)
+ (if (null forms)
+ string
+ (let ((n (first (last indices))))
+ (goto-char (1+ (point-min))) ; `(|OP arg1 ... argN)'
+ (mapcar #'(lambda (s)
+ (assert (not (equal s string))) ; trap against
+ (slime-make-form-spec-from-string s)) ; endless recursion.
+ (slime-ensure-list
+ (slime-parse-sexp-at-point (1+ n) t))))))))))
+
+
+(defun slime-enclosing-form-specs (&optional max-levels)
+ "Return the list of ``raw form specs'' of all the forms
+containing point from right to left.
+
+As a secondary value, return a list of indices: Each index tells
+for each corresponding form spec in what argument position the
+user's point is.
+
+As tertiary value, return the positions of the operators that are
+contained in the returned form specs.
+
+When MAX-LEVELS is non-nil, go up at most this many levels of
+parens.
+
+\(See SWANK::PARSE-FORM-SPEC for more information about what
+exactly constitutes a ``raw form specs'')
+
+Examples:
+
+ A return value like the following
+
+ (values ((\"quux\") (\"bar\") (\"foo\")) (3 2 1) (p1 p2 p3))
+
+ can be interpreted as follows:
+
+ The user point is located in the 3rd argument position of a
+ form with the operator name \"quux\" (which starts at P1.)
+
+ This form is located in the 2nd argument position of a form
+ with the operator name \"bar\" (which starts at P2.)
+
+ This form again is in the 1st argument position of a form
+ with the operator name \"foo\" (which itself begins at P3.)
+
+ For instance, the corresponding buffer content could have looked
+ like `(foo (bar arg1 (quux 1 2 |' where `|' denotes point.
+"
+ (let ((level 1)
+ (parse-sexp-lookup-properties nil)
+ (initial-point (point))
+ (result '()) (arg-indices '()) (points '()))
+ ;; The expensive lookup of syntax-class text properties is only
+ ;; used for interactive balancing of #<...> in presentations; we
+ ;; do not need them in navigating through the nested lists.
+ ;; This speeds up this function significantly.
+ (ignore-errors
+ (save-excursion
+ ;; Make sure we get the whole thing at point.
+ (if (not (slime-inside-string-p))
+ (slime-end-of-symbol)
+ (slime-beginning-of-string)
+ (forward-sexp))
+ (save-restriction
+ ;; Don't parse more than 20000 characters before point, so we don't spend
+ ;; too much time.
+ (narrow-to-region (max (point-min) (- (point) 20000)) (point-max))
+ (narrow-to-region (save-excursion (beginning-of-defun) (point))
+ (min (1+ (point)) (point-max)))
+ (while (or (not max-levels)
+ (<= level max-levels))
+ (let ((arg-index 0))
+ ;; Move to the beginning of the current sexp if not already there.
+ (if (or (and (char-after)
+ (member (char-syntax (char-after)) '(?\( ?')))
+ (member (char-syntax (char-before)) '(?\ ?>)))
+ (incf arg-index))
+ (ignore-errors (backward-sexp 1))
+ (while (and (< arg-index 64)
+ (ignore-errors (backward-sexp 1)
+ (> (point) (point-min))))
+ (incf arg-index))
+ (backward-up-list 1)
+ (when (member (char-syntax (char-after)) '(?\( ?'))
+ (incf level)
+ (forward-char 1)
+ (let ((name (slime-symbol-name-at-point)))
+ (cond
+ (name
+ (save-restriction
+ (widen) ; to allow looking-ahead/back in extended parsing.
+ (multiple-value-bind (new-result new-indices new-points)
+ (slime-parse-extended-operator-name initial-point
+ (cons `(,name) result) ; minimal form spec
+ (cons arg-index arg-indices)
+ (cons (point) points))
+ (setq result new-result)
+ (setq arg-indices new-indices)
+ (setq points new-points))))
+ (t
+ (push nil result)
+ (push arg-index arg-indices)
+ (push (point) points))))
+ (backward-up-list 1)))))))
+ (values
+ (nreverse result)
+ (nreverse arg-indices)
+ (nreverse points))))
+
+
+(defun slime-ensure-list (thing)
+ (if (listp thing) thing (list thing)))
+
+(defun slime-inside-string-p ()
+ (let* ((toplevel-begin (save-excursion (beginning-of-defun) (point)))
+ (parse-result (parse-partial-sexp toplevel-begin (point)))
+ (inside-string-p (nth 3 parse-result))
+ (string-start-pos (nth 8 parse-result)))
+ (and inside-string-p string-start-pos)))
+
+(defun slime-beginning-of-string ()
+ (let ((string-start-pos (slime-inside-string-p)))
+ (if string-start-pos
+ (goto-char string-start-pos)
+ (error "We're not within a string"))))
+
+(provide 'slime-parse)
+
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-presentation-streams.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-presentation-streams.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-presentation-streams.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,29 @@
+;;; swank-presentation-streams.el --- Streams that allow attaching object identities
+;;; to portions of output
+;;;
+;;; Authors: Alan Ruttenberg <alanr-l(a)mumble.net>
+;;; Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;;; Helmut Eller <heller(a)common-lisp.net>
+;;;
+;;; License: GNU GPL (same license as Emacs)
+;;;
+;;; Installation
+;;
+;; Add this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-presentation-streams)))
+;;
+
+
+;;; Initialization
+
+(require 'slime-presentations)
+
+(add-hook 'slime-connected-hook 'slime-install-presentation-streams)
+
+(defun slime-install-presentation-streams ()
+ (slime-eval-async '(swank:swank-require :swank-presentation-streams)))
+
+(provide 'slime-presentation-streams)
+
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,649 @@
+;;; swank-presentations.el --- imitat LispM' presentations
+;;;
+;;; Authors: Alan Ruttenberg <alanr-l(a)mumble.net>
+;;; Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;;;
+;;; License: GNU GPL (same license as Emacs)
+;;;
+;;; Installation
+;;
+;; Add this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-presentations)))
+;;
+
+(defface slime-repl-output-mouseover-face
+ (if (featurep 'xemacs)
+ '((t (:bold t)))
+ (if (slime-face-inheritance-possible-p)
+ '((t
+ (:box
+ (:line-width 1 :color "black" :style released-button)
+ :inherit
+ slime-repl-inputed-output-face)))
+ '((t (:box (:line-width 1 :color "black"))))))
+ "Face for Lisp output in the SLIME REPL, when the mouse hovers over it"
+ :group 'slime-repl)
+
+(defface slime-repl-inputed-output-face
+ '((((class color) (background light)) (:foreground "Red"))
+ (((class color) (background dark)) (:foreground "Red"))
+ (t (:slant italic)))
+ "Face for the result of an evaluation in the SLIME REPL."
+ :group 'slime-repl)
+
+;; FIXME: This conditional is not right - just used because the code
+;; here does not work in XEmacs.
+(when (boundp 'text-property-default-nonsticky)
+ (pushnew '(slime-repl-presentation . t) text-property-default-nonsticky
+ :test 'equal)
+ (pushnew '(slime-repl-result-face . t) text-property-default-nonsticky
+ :test 'equal))
+
+(make-variable-buffer-local
+ (defvar slime-presentation-start-to-point (make-hash-table)))
+
+(defun slime-mark-presentation-start (id &optional target)
+ "Mark the beginning of a presentation with the given ID.
+TARGET can be nil (regular process output) or :repl-result."
+ (setf (gethash id slime-presentation-start-to-point)
+ ;; We use markers because text can also be inserted before this presentation.
+ ;; (Output arrives while we are writing presentations within REPL results.)
+ (copy-marker (slime-output-target-marker target) nil)))
+
+(defun slime-mark-presentation-start-handler (process string)
+ (if (and string (string-match "<\\([-0-9]+\\)" string))
+ (let* ((match (substring string (match-beginning 1) (match-end 1)))
+ (id (car (read-from-string match))))
+ (slime-mark-presentation-start id))))
+
+(defun slime-mark-presentation-end (id &optional target)
+ "Mark the end of a presentation with the given ID.
+TARGET can be nil (regular process output) or :repl-result."
+ (let ((start (gethash id slime-presentation-start-to-point)))
+ (remhash id slime-presentation-start-to-point)
+ (when start
+ (let* ((marker (slime-output-target-marker target))
+ (buffer (and marker (marker-buffer marker))))
+ (with-current-buffer buffer
+ (let ((end (marker-position marker)))
+ (slime-add-presentation-properties start end
+ id nil)))))))
+
+(defun slime-mark-presentation-end-handler (process string)
+ (if (and string (string-match ">\\([-0-9]+\\)" string))
+ (let* ((match (substring string (match-beginning 1) (match-end 1)))
+ (id (car (read-from-string match))))
+ (slime-mark-presentation-end id))))
+
+(defstruct slime-presentation text id)
+
+(defvar slime-presentation-syntax-table
+ (let ((table (copy-syntax-table lisp-mode-syntax-table)))
+ ;; We give < and > parenthesis syntax, so that #< ... > is treated
+ ;; as a balanced expression. This allows to use C-M-k, C-M-SPC,
+ ;; etc. to deal with a whole presentation. (For Lisp mode, this
+ ;; is not desirable, since we do not wish to get a mismatched
+ ;; paren highlighted everytime we type < or >.)
+ (modify-syntax-entry ?< "(>" table)
+ (modify-syntax-entry ?> ")<" table)
+ table)
+ "Syntax table for presentations.")
+
+(defun slime-add-presentation-properties (start end id result-p)
+ "Make the text between START and END a presentation with ID.
+RESULT-P decides whether a face for a return value or output text is used."
+ (let* ((text (buffer-substring-no-properties start end))
+ (presentation (make-slime-presentation :text text :id id)))
+ (let ((inhibit-modification-hooks t))
+ (add-text-properties start end
+ `(modification-hooks (slime-after-change-function)
+ insert-in-front-hooks (slime-after-change-function)
+ insert-behind-hooks (slime-after-change-function)
+ syntax-table ,slime-presentation-syntax-table
+ rear-nonsticky t))
+ ;; Use the presentation as the key of a text property
+ (case (- end start)
+ (0)
+ (1
+ (add-text-properties start end
+ `(slime-repl-presentation ,presentation
+ ,presentation :start-and-end)))
+ (t
+ (add-text-properties start (1+ start)
+ `(slime-repl-presentation ,presentation
+ ,presentation :start))
+ (when (> (- end start) 2)
+ (add-text-properties (1+ start) (1- end)
+ `(,presentation :interior)))
+ (add-text-properties (1- end) end
+ `(slime-repl-presentation ,presentation
+ ,presentation :end))))
+ ;; Also put an overlay for the face and the mouse-face. This enables
+ ;; highlighting of nested presentations. However, overlays get lost
+ ;; when we copy a presentation; their removal is also not undoable.
+ ;; In these cases the mouse-face text properties need to take over ---
+ ;; but they do not give nested highlighting.
+ (slime-ensure-presentation-overlay start end presentation))))
+
+(defun slime-ensure-presentation-overlay (start end presentation)
+ (unless (find presentation (overlays-at start)
+ :key (lambda (overlay)
+ (overlay-get overlay 'slime-repl-presentation)))
+ (let ((overlay (make-overlay start end (current-buffer) t nil)))
+ (overlay-put overlay 'slime-repl-presentation presentation)
+ (overlay-put overlay 'mouse-face 'slime-repl-output-mouseover-face)
+ (overlay-put overlay 'help-echo
+ (if (eq major-mode 'slime-repl-mode)
+ "mouse-2: copy to input; mouse-3: menu"
+ "mouse-2: inspect; mouse-3: menu"))
+ (overlay-put overlay 'face 'slime-repl-inputed-output-face)
+ (overlay-put overlay 'keymap slime-presentation-map))))
+
+(defun slime-remove-presentation-properties (from to presentation)
+ (let ((inhibit-read-only t))
+ (remove-text-properties from to
+ `(,presentation t syntax-table t rear-nonsticky t))
+ (when (eq (get-text-property from 'slime-repl-presentation) presentation)
+ (remove-text-properties from (1+ from) `(slime-repl-presentation t)))
+ (when (eq (get-text-property (1- to) 'slime-repl-presentation) presentation)
+ (remove-text-properties (1- to) to `(slime-repl-presentation t)))
+ (dolist (overlay (overlays-at from))
+ (when (eq (overlay-get overlay 'slime-repl-presentation) presentation)
+ (delete-overlay overlay)))))
+
+(defun slime-insert-presentation (string output-id &optional rectangle)
+ "Insert STRING in current buffer and mark it as a presentation
+corresponding to OUTPUT-ID. If RECTANGLE is true, indent multi-line
+strings to line up below the current point."
+ (flet ((insert-it ()
+ (if rectangle
+ (slime-insert-indented string)
+ (insert string))))
+ (let ((start (point)))
+ (insert-it)
+ (slime-add-presentation-properties start (point) output-id t))))
+
+(defun slime-presentation-whole-p (presentation start end &optional object)
+ (let ((object (or object (current-buffer))))
+ (string= (etypecase object
+ (buffer (with-current-buffer object
+ (buffer-substring-no-properties start end)))
+ (string (substring-no-properties object start end)))
+ (slime-presentation-text presentation))))
+
+(defun slime-presentations-around-point (point &optional object)
+ (let ((object (or object (current-buffer))))
+ (loop for (key value . rest) on (text-properties-at point object) by 'cddr
+ when (slime-presentation-p key)
+ collect key)))
+
+(defun slime-presentation-start-p (tag)
+ (memq tag '(:start :start-and-end)))
+
+(defun slime-presentation-stop-p (tag)
+ (memq tag '(:end :start-and-end)))
+
+(defun* slime-presentation-start (point presentation
+ &optional (object (current-buffer)))
+ "Find start of `presentation' at `point' in `object'.
+Return buffer index and whether a start-tag was found."
+ (let* ((this-presentation (get-text-property point presentation object)))
+ (while (not (slime-presentation-start-p this-presentation))
+ (let ((change-point (previous-single-property-change
+ point presentation object)))
+ (unless change-point
+ (return-from slime-presentation-start
+ (values (etypecase object
+ (buffer (with-current-buffer object 1))
+ (string 0))
+ nil)))
+ (setq this-presentation (get-text-property change-point
+ presentation object))
+ (unless this-presentation
+ (return-from slime-presentation-start
+ (values point nil)))
+ (setq point change-point)))
+ (values point t)))
+
+(defun* slime-presentation-end (point presentation
+ &optional (object (current-buffer)))
+ "Find end of presentation at `point' in `object'. Return buffer
+index (after last character of the presentation) and whether an
+end-tag was found."
+ (let* ((this-presentation (get-text-property point presentation object)))
+ (while (not (slime-presentation-stop-p this-presentation))
+ (let ((change-point (next-single-property-change
+ point presentation object)))
+ (unless change-point
+ (return-from slime-presentation-end
+ (values (etypecase object
+ (buffer (with-current-buffer object (point-max)))
+ (string (length object)))
+ nil)))
+ (setq point change-point)
+ (setq this-presentation (get-text-property point
+ presentation object))))
+ (if this-presentation
+ (let ((after-end (next-single-property-change point
+ presentation object)))
+ (if (not after-end)
+ (values (etypecase object
+ (buffer (with-current-buffer object (point-max)))
+ (string (length object)))
+ t)
+ (values after-end t)))
+ (values point nil))))
+
+(defun* slime-presentation-bounds (point presentation
+ &optional (object (current-buffer)))
+ "Return start index and end index of `presentation' around `point'
+in `object', and whether the presentation is complete."
+ (multiple-value-bind (start good-start)
+ (slime-presentation-start point presentation object)
+ (multiple-value-bind (end good-end)
+ (slime-presentation-end point presentation object)
+ (values start end
+ (and good-start good-end
+ (slime-presentation-whole-p presentation
+ start end object))))))
+
+(defun slime-presentation-around-point (point &optional object)
+ "Return presentation, start index, end index, and whether the
+presentation is complete."
+ (let ((object (or object (current-buffer)))
+ (innermost-presentation nil)
+ (innermost-start 0)
+ (innermost-end most-positive-fixnum))
+ (dolist (presentation (slime-presentations-around-point point object))
+ (multiple-value-bind (start end whole-p)
+ (slime-presentation-bounds point presentation object)
+ (when whole-p
+ (when (< (- end start) (- innermost-end innermost-start))
+ (setq innermost-start start
+ innermost-end end
+ innermost-presentation presentation)))))
+ (values innermost-presentation
+ innermost-start innermost-end)))
+
+(defun slime-presentation-around-or-before-point (point &optional object)
+ (let ((object (or object (current-buffer))))
+ (multiple-value-bind (presentation start end whole-p)
+ (slime-presentation-around-point point object)
+ (if presentation
+ (values presentation start end whole-p)
+ (slime-presentation-around-point (1- point) object)))))
+
+(defun* slime-for-each-presentation-in-region (from to function &optional (object (current-buffer)))
+ "Call `function' with arguments `presentation', `start', `end',
+`whole-p' for every presentation in the region `from'--`to' in the
+string or buffer `object'."
+ (flet ((handle-presentation (presentation point)
+ (multiple-value-bind (start end whole-p)
+ (slime-presentation-bounds point presentation object)
+ (funcall function presentation start end whole-p))))
+ ;; Handle presentations active at `from'.
+ (dolist (presentation (slime-presentations-around-point from object))
+ (handle-presentation presentation from))
+ ;; Use the `slime-repl-presentation' property to search for new presentations.
+ (let ((point from))
+ (while (< point to)
+ (setq point (next-single-property-change point 'slime-repl-presentation object to))
+ (let* ((presentation (get-text-property point 'slime-repl-presentation object))
+ (status (get-text-property point presentation object)))
+ (when (slime-presentation-start-p status)
+ (handle-presentation presentation point)))))))
+
+;; XEmacs compatibility hack, from message by Stephen J. Turnbull on
+;; xemacs-beta(a)xemacs.org of 18 Mar 2002
+(unless (boundp 'undo-in-progress)
+ (defvar undo-in-progress nil
+ "Placeholder defvar for XEmacs compatibility from SLIME.")
+ (defadvice undo-more (around slime activate)
+ (let ((undo-in-progress t)) ad-do-it)))
+
+(defun slime-after-change-function (start end &rest ignore)
+ "Check all presentations within and adjacent to the change.
+When a presentation has been altered, change it to plain text."
+ (let ((inhibit-modification-hooks t))
+ (let ((real-start (max 1 (1- start)))
+ (real-end (min (1+ (buffer-size)) (1+ end)))
+ (any-change nil))
+ ;; positions around the change
+ (slime-for-each-presentation-in-region
+ real-start real-end
+ (lambda (presentation from to whole-p)
+ (cond
+ (whole-p
+ (slime-ensure-presentation-overlay from to presentation))
+ ((not undo-in-progress)
+ (slime-remove-presentation-properties from to
+ presentation)
+ (setq any-change t)))))
+ (when any-change
+ (undo-boundary)))))
+
+(defun slime-presentation-around-click (event)
+ "Return the presentation around the position of the mouse-click EVENT.
+If there is no presentation, signal an error.
+Also return the start position, end position, and buffer of the presentation."
+ (when (and (featurep 'xemacs) (not (button-press-event-p event)))
+ (error "Command must be bound to a button-press-event"))
+ (let ((point (if (featurep 'xemacs) (event-point event) (posn-point (event-end event))))
+ (window (if (featurep 'xemacs) (event-window event) (caadr event))))
+ (with-current-buffer (window-buffer window)
+ (multiple-value-bind (presentation start end)
+ (slime-presentation-around-point point)
+ (unless presentation
+ (error "No presentation at click"))
+ (values presentation start end (current-buffer))))))
+
+(defun slime-copy-or-inspect-presentation-at-mouse (event)
+ (interactive "e") ; no "@" -- we don't want to select the clicked-at window
+ (multiple-value-bind (presentation start end buffer)
+ (slime-presentation-around-click event)
+ (if (with-current-buffer buffer
+ (eq major-mode 'slime-repl-mode))
+ (slime-copy-presentation-at-mouse event)
+ (slime-inspect-presentation-at-mouse event))))
+
+(defun slime-inspect-presentation-at-mouse (event)
+ (interactive "e")
+ (multiple-value-bind (presentation start end buffer)
+ (slime-presentation-around-click event)
+ (let ((reset-p
+ (with-current-buffer buffer
+ (not (eq major-mode 'slime-inspector-mode)))))
+ (slime-eval-async `(swank:inspect-presentation ',(slime-presentation-id presentation) ,reset-p)
+ 'slime-open-inspector))))
+
+(defun slime-copy-presentation-at-mouse (event)
+ (interactive "e")
+ (multiple-value-bind (presentation start end buffer)
+ (slime-presentation-around-click event)
+ (let ((presentation-text
+ (with-current-buffer buffer
+ (buffer-substring start end))))
+ (unless (eql major-mode 'slime-repl-mode)
+ (slime-switch-to-output-buffer))
+ (flet ((do-insertion ()
+ (when (not (string-match "\\s-"
+ (buffer-substring (1- (point)) (point))))
+ (insert " "))
+ (insert presentation-text)
+ (when (and (not (eolp)) (not (looking-at "\\s-")))
+ (insert " "))))
+ (if (>= (point) slime-repl-prompt-start-mark)
+ (do-insertion)
+ (save-excursion
+ (goto-char (point-max))
+ (do-insertion)))))))
+
+(defun slime-copy-presentation-at-mouse-to-point (event)
+ (interactive "e")
+ (multiple-value-bind (presentation start end buffer)
+ (slime-presentation-around-click event)
+ (let ((presentation-text
+ (with-current-buffer buffer
+ (buffer-substring start end))))
+ (when (not (string-match "\\s-"
+ (buffer-substring (1- (point)) (point))))
+ (insert " "))
+ (insert presentation-text)
+ (slime-after-change-function (point) (point))
+ (when (and (not (eolp)) (not (looking-at "\\s-")))
+ (insert " ")))))
+
+(defun slime-copy-presentation-at-mouse-to-kill-ring (event)
+ (interactive "e")
+ (multiple-value-bind (presentation start end buffer)
+ (slime-presentation-around-click event)
+ (let ((presentation-text
+ (with-current-buffer buffer
+ (buffer-substring start end))))
+ (kill-new presentation-text))))
+
+(defun slime-describe-presentation-at-mouse (event)
+ (interactive "@e")
+ (multiple-value-bind (presentation) (slime-presentation-around-click event)
+ (slime-eval-describe
+ `(swank::describe-to-string
+ (swank::lookup-presented-object ',(slime-presentation-id presentation))))))
+
+(defun slime-pretty-print-presentation-at-mouse (event)
+ (interactive "@e")
+ (multiple-value-bind (presentation) (slime-presentation-around-click event)
+ (slime-eval-describe
+ `(swank::swank-pprint
+ (cl:list
+ (swank::lookup-presented-object ',(slime-presentation-id presentation)))))))
+
+(defvar slime-presentation-map (make-sparse-keymap))
+
+(define-key slime-presentation-map [mouse-2] 'slime-copy-or-inspect-presentation-at-mouse)
+(define-key slime-presentation-map [mouse-3] 'slime-presentation-menu)
+
+(when (featurep 'xemacs)
+ (define-key slime-presentation-map [button2] 'slime-copy-or-inspect-presentation-at-mouse)
+ (define-key slime-presentation-map [button3] 'slime-presentation-menu))
+
+;; protocol for handling up a menu.
+;; 1. Send lisp message asking for menu choices for this object.
+;; Get back list of strings.
+;; 2. Let used choose
+;; 3. Call back to execute menu choice, passing nth and string of choice
+
+(defun slime-menu-choices-for-presentation (presentation buffer from to choice-to-lambda)
+ "Return a menu for `presentation' at `from'--`to' in `buffer', suitable for `x-popup-menu'."
+ (let* ((what (slime-presentation-id presentation))
+ (choices (with-current-buffer buffer
+ (slime-eval
+ `(swank::menu-choices-for-presentation-id ',what)))))
+ (flet ((savel (f) ;; IMPORTANT - xemacs can't handle lambdas in x-popup-menu. So give them a name
+ (let ((sym (gensym)))
+ (setf (gethash sym choice-to-lambda) f)
+ sym)))
+ (etypecase choices
+ (list
+ `(,(format "Presentation %s" what)
+ (""
+ ("Inspect" . ,(savel 'slime-inspect-presentation-at-mouse))
+ ("Describe" . ,(savel 'slime-describe-presentation-at-mouse))
+ ("Pretty-print" . ,(savel 'slime-pretty-print-presentation-at-mouse))
+ ("Copy to REPL" . ,(savel 'slime-copy-presentation-at-mouse))
+ ("Copy to kill ring" . ,(savel 'slime-copy-presentation-at-mouse-to-kill-ring))
+ ,@(unless buffer-read-only
+ `(("Copy to point" . ,(savel 'slime-copy-presentation-at-mouse-to-point))))
+ ,@(let ((nchoice 0))
+ (mapcar
+ (lambda (choice)
+ (incf nchoice)
+ (cons choice
+ (savel `(lambda ()
+ (interactive)
+ (slime-eval
+ '(swank::execute-menu-choice-for-presentation-id
+ ',what ,nchoice ,(nth (1- nchoice) choices)))))))
+ choices)))))
+ (symbol ; not-present
+ (with-current-buffer buffer
+ (slime-remove-presentation-properties from to presentation))
+ (sit-for 0) ; allow redisplay
+ `("Object no longer recorded"
+ ("sorry" . ,(if (featurep 'xemacs) nil '(nil)))))))))
+
+(defun slime-presentation-menu (event)
+ (interactive "e")
+ (let* ((point (if (featurep 'xemacs) (event-point event)
+ (posn-point (event-end event))))
+ (window (if (featurep 'xemacs) (event-window event) (caadr event)))
+ (buffer (window-buffer window))
+ (choice-to-lambda (make-hash-table)))
+ (multiple-value-bind (presentation from to)
+ (with-current-buffer buffer
+ (slime-presentation-around-point point))
+ (unless presentation
+ (error "No presentation at event position"))
+ (let ((menu (slime-menu-choices-for-presentation
+ presentation buffer from to choice-to-lambda)))
+ (let ((choice (x-popup-menu event menu)))
+ (when choice
+ (call-interactively (gethash choice choice-to-lambda))))))))
+
+(defun slime-presentation-expression (presentation)
+ "Return a string that contains a CL s-expression accessing
+the presented object."
+ (let ((id (slime-presentation-id presentation)))
+ (etypecase id
+ (number
+ ;; Make sure it works even if *read-base* is not 10.
+ (format "(swank:get-repl-result #10r%d)" id))
+ (list
+ ;; for frame variables and inspector parts
+ (format "(swank:get-repl-result '%s)" id)))))
+
+(defun slime-buffer-substring-with-reified-output (start end)
+ (let ((str-props (buffer-substring start end))
+ (str-no-props (buffer-substring-no-properties start end)))
+ (slime-reify-old-output str-props str-no-props)))
+
+(defun slime-reify-old-output (str-props str-no-props)
+ (let ((pos (slime-property-position 'slime-repl-presentation str-props)))
+ (if (null pos)
+ str-no-props
+ (multiple-value-bind (presentation start-pos end-pos whole-p)
+ (slime-presentation-around-point pos str-props)
+ (if (not presentation)
+ str-no-props
+ (concat (substring str-no-props 0 pos)
+ ;; Eval in the reader so that we play nice with quote.
+ ;; -luke (19/May/2005)
+ "#." (slime-presentation-expression presentation)
+ (slime-reify-old-output (substring str-props end-pos)
+ (substring str-no-props end-pos))))))))
+
+
+
+(defun slime-repl-grab-old-output (replace)
+ "Resend the old REPL output at point.
+If replace it non-nil the current input is replaced with the old
+output; otherwise the new input is appended."
+ (multiple-value-bind (presentation beg end)
+ (slime-presentation-around-or-before-point (point))
+ (let ((old-output (buffer-substring beg end))) ;;keep properties
+ ;; Append the old input or replace the current input
+ (cond (replace (goto-char slime-repl-input-start-mark))
+ (t (goto-char slime-repl-input-end-mark)
+ (unless (eq (char-before) ?\ )
+ (insert " "))))
+ (delete-region (point) slime-repl-input-end-mark)
+ (let ((inhibit-read-only t))
+ (insert old-output)))))
+
+
+;;; hook functions (hard to isolate stuff)
+
+(defun slime-dispatch-presentation-event (event)
+ (destructure-case event
+ ((:presentation-start id &optional target)
+ (slime-mark-presentation-start id target)
+ t)
+ ((:presentation-end id &optional target)
+ (slime-mark-presentation-end id target)
+ t)
+ (t nil)))
+
+(defun slime-presentation-write (string &optional target)
+ (case target
+ ((nil) ; Regular process output
+ (with-current-buffer (slime-output-buffer)
+ (slime-with-output-end-mark
+ (slime-propertize-region '(face slime-repl-output-face
+ rear-nonsticky (face))
+ (insert string))
+ (set-marker slime-output-end (point))
+ (when (and (= (point) slime-repl-prompt-start-mark)
+ (not (bolp)))
+ (insert "\n")
+ (set-marker slime-output-end (1- (point))))
+ (if (< slime-repl-input-start-mark (point))
+ (set-marker slime-repl-input-start-mark
+ (point))))))
+ (:repl-result
+ (with-current-buffer (slime-output-buffer)
+ (let ((marker (slime-output-target-marker target)))
+ (goto-char marker)
+ (let ((result-start (point)))
+ (slime-propertize-region `(face slime-repl-result-face
+ rear-nonsticky (face))
+ (insert string))
+ ;; Move the input-start marker after the REPL result.
+ (set-marker marker (point))))))
+ (t
+ (let* ((marker (slime-output-target-marker target))
+ (buffer (and marker (marker-buffer marker))))
+ (when buffer
+ (with-current-buffer buffer
+ (save-excursion
+ ;; Insert STRING at MARKER, then move MARKER behind
+ ;; the insertion.
+ (goto-char marker)
+ (insert-before-markers string)
+ (set-marker marker (point)))))))))
+
+(defun slime-presentation-current-input (&optional until-point-p)
+ "Return the current input as string.
+The input is the region from after the last prompt to the end of
+buffer. Presentations of old results are expanded into code."
+ (slime-buffer-substring-with-reified-output slime-repl-input-start-mark
+ (if (and until-point-p
+ (<= (point) slime-repl-input-end-mark))
+ (point)
+ slime-repl-input-end-mark)))
+(defun slime-presentation-on-return-pressed ()
+ (cond ((and (car (slime-presentation-around-or-before-point (point)))
+ (< (point) slime-repl-input-start-mark))
+ (slime-repl-grab-old-output end-of-input)
+ (slime-repl-recenter-if-needed)
+ t)
+ (t nil)))
+
+(defun slime-presentation-on-stream-open (stream)
+ (require 'bridge)
+ (defun bridge-insert (process output)
+ (slime-output-filter process (or output "")))
+ (install-bridge)
+ (setq bridge-destination-insert nil)
+ (setq bridge-source-insert nil)
+ (setq bridge-handlers
+ (list* '("<" . slime-mark-presentation-start-handler)
+ '(">" . slime-mark-presentation-end-handler)
+ bridge-handlers)))
+
+(defun slime-clear-presentations ()
+ (slime-eval-async `(swank:clear-repl-results)))
+
+;;; Initialization
+
+(defun slime-presentations-init ()
+ (add-hook 'slime-repl-mode-hook
+ (lambda ()
+ ;; Respect the syntax text properties of presentation.
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (add-local-hook 'after-change-functions
+ 'slime-after-change-function)))
+ (add-hook 'slime-event-hooks 'slime-dispatch-presentation-event)
+ (setq slime-write-string-function 'slime-presentation-write)
+ (add-hook 'slime-repl-return-hooks 'slime-presentation-on-return-pressed)
+ (add-hook 'slime-repl-current-input-hooks 'slime-presentation-current-input)
+ (add-hook 'slime-open-stream-hooks 'slime-presentation-on-stream-open)
+ (add-hook 'slime-repl-clear-buffer-hook 'slime-clear-presentations)
+ (add-hook 'slime-connected-hook 'slime-install-presentations))
+
+(defun slime-install-presentations ()
+ (slime-eval-async '(swank:swank-require :swank-presentations)))
+
+(slime-presentations-init)
+
+(provide 'slime-presentations)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-references.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-references.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-references.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,135 @@
+;;; slime-references.el --- Clickable references to documentation (SBCL only)
+;;
+;; Authors: Christophe Rhodes <csr21(a)cantab.net>
+;; Luke Gorrie <luke(a)bluetail.com>
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+;;;
+
+(defcustom slime-sbcl-manual-root "http://www.sbcl.org/manual/"
+ "*The base URL of the SBCL manual, for documentation lookup."
+ :type 'string
+ :group 'slime-mode)
+
+(defface sldb-reference-face
+ (list (list t '(:underline t)))
+ "Face for references."
+ :group 'slime-debugger)
+
+(defun slime-note.references (note)
+ (plist-get note :references))
+
+(defun slime-tree-print-with-references (tree)
+ ;; for SBCL-style references
+ (slime-tree-default-printer tree)
+ (when-let (note (plist-get (slime-tree.plist tree) 'note))
+ (when-let (references (slime-note.references note))
+ (terpri (current-buffer))
+ (princ "See also:" (current-buffer))
+ (terpri (current-buffer))
+ (slime-tree-insert-references references))))
+
+(defun slime-tree-insert-references (references)
+ "Insert documentation references from a condition.
+See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
+ (loop for refs on references
+ for ref = (car refs)
+ do
+ (destructuring-bind (where type what) ref
+ ;; FIXME: this is poorly factored, and shares some code and
+ ;; data with sldb that it shouldn't: notably
+ ;; sldb-reference-face. Probably the names of
+ ;; sldb-reference-foo should be altered to be not sldb
+ ;; specific.
+ (insert " " (sldb-format-reference-source where) ", ")
+ (slime-insert-propertized (sldb-reference-properties ref)
+ (sldb-format-reference-node what))
+ (insert (format " [%s]" type))
+ (when (cdr refs)
+ (terpri (current-buffer))))))
+
+
+;;;;; SLDB references (rather SBCL specific)
+
+(defun sldb-insert-references (references)
+ "Insert documentation references from a condition.
+See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
+ (dolist (ref references)
+ (destructuring-bind (where type what) ref
+ (insert "\n" (sldb-format-reference-source where) ", ")
+ (slime-insert-propertized (sldb-reference-properties ref)
+ (sldb-format-reference-node what))
+ (insert (format " [%s]" type)))))
+
+(defun sldb-reference-properties (reference)
+ "Return the properties for a reference.
+Only add clickability to properties we actually know how to lookup."
+ (destructuring-bind (where type what) reference
+ (if (or (and (eq where :sbcl) (eq type :node))
+ (and (eq where :ansi-cl)
+ (memq type '(:function :special-operator :macro
+ :section :glossary :issue))))
+ `(sldb-default-action
+ sldb-lookup-reference
+ ;; FIXME: this is a hack! slime-compiler-notes and sldb are a
+ ;; little too intimately entwined.
+ slime-compiler-notes-default-action sldb-lookup-reference
+ sldb-reference ,reference
+ face sldb-reference-face
+ mouse-face highlight))))
+
+(defun sldb-format-reference-source (where)
+ (case where
+ (:amop "The Art of the Metaobject Protocol")
+ (:ansi-cl "Common Lisp Hyperspec")
+ (:sbcl "SBCL Manual")
+ (t (format "%S" where))))
+
+(defun sldb-format-reference-node (what)
+ (if (listp what)
+ (mapconcat #'prin1-to-string what ".")
+ what))
+
+(defun sldb-lookup-reference ()
+ "Browse the documentation reference at point."
+ (destructuring-bind (where type what)
+ (get-text-property (point) 'sldb-reference)
+ (case where
+ (:ansi-cl
+ (case type
+ (:section
+ (browse-url (funcall common-lisp-hyperspec-section-fun what)))
+ (:glossary
+ (browse-url (funcall common-lisp-glossary-fun what)))
+ (:issue
+ (browse-url (funcall 'common-lisp-issuex what)))
+ (t
+ (hyperspec-lookup what))))
+ (t
+ (let ((url (format "%s%s.html" slime-sbcl-manual-root
+ (subst-char-in-string ?\ ?\- what))))
+ (browse-url url))))))
+
+(defun sldb-maybe-insert-references (extra)
+ (destructure-case extra
+ ((:references references)
+ (when references
+ (insert "\nSee also:")
+ (slime-with-rigid-indentation 2
+ (sldb-insert-references references)))
+ t)
+ (t nil)))
+
+
+;;; Initialization
+
+(defun slime-references-init ()
+ (setq slime-tree-printer 'slime-tree-print-with-references)
+ (add-hook 'sldb-extras-hooks 'sldb-maybe-insert-references))
+
+(defun slime-references-unload ()
+ (setq slime-tree-printer 'slime-tree-default-printer)
+ (remove-hook 'sldb-extras-hooks 'sldb-maybe-insert-references))
+
+(provide 'slime-references)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-scratch.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-scratch.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-scratch.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,48 @@
+;;; slime-scratch.el --- imitate Emacs' *scratch* buffer
+;;
+;; Author: Helmut Eller <heller(a)common-lisp.net>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs:
+;;
+;; (add-to-list 'load-path ".../slime/contrib")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-scratch)))
+;;
+
+
+;;; Code
+
+(defvar slime-scratch-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map lisp-mode-map)
+ map))
+
+(defun slime-scratch ()
+ (interactive)
+ (slime-switch-to-scratch-buffer))
+
+(defun slime-switch-to-scratch-buffer ()
+ (set-buffer (slime-scratch-buffer))
+ (unless (eq (current-buffer) (window-buffer))
+ (pop-to-buffer (current-buffer) t)))
+
+(defun slime-scratch-buffer ()
+ "Return the scratch buffer, create it if necessary."
+ (or (get-buffer "*slime-scratch*")
+ (with-current-buffer (get-buffer-create "*slime-scratch*")
+ (lisp-mode)
+ (use-local-map slime-scratch-mode-map)
+ (slime-mode t)
+ (current-buffer))))
+
+(slime-define-keys slime-scratch-mode-map
+ ("\C-j" 'slime-eval-print-last-expression))
+
+(defun slime-scratch-init ()
+ (def-slime-selector-method ?s
+ "*slime-scratch* buffer."
+ (slime-scratch-buffer)))
+
+(provide 'slime-scratch)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-tramp.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-tramp.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-tramp.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,55 @@
+;;; slime-tramp.el --- Filename translations for tramp
+;;
+;; Authors: Marco Baringer <mb(a)bese.it>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs:
+;;
+;; (add-to-list 'load-path ".../slime/contrib")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-tramp)))
+;;
+
+(defun slime-make-tramp-file-name (username remote-host lisp-filename)
+ "Old (with multi-hops) tramp compatability function"
+ (require 'tramp)
+ (if (boundp 'tramp-multi-methods)
+ (tramp-make-tramp-file-name nil nil
+ username
+ remote-host
+ lisp-filename)
+ (tramp-make-tramp-file-name nil
+ username
+ remote-host
+ lisp-filename)))
+
+(defun* slime-create-filename-translator (&key machine-instance
+ remote-host
+ username)
+ "Creates a three element list suitable for push'ing onto
+slime-filename-translations which uses Tramp to load files on
+hostname using username. MACHINE-INSTANCE is a required
+parameter, REMOTE-HOST defaults to MACHINE-INSTANCE and USERNAME
+defaults to (user-login-name).
+
+MACHINE-INSTANCE is the value returned by slime-machine-instance,
+which is just the value returned by cl:machine-instance on the
+remote lisp. REMOTE-HOST is the fully qualified domain name (or
+just the IP) of the remote machine. USERNAME is the username we
+should login with.
+The functions created here expect your tramp-default-method or
+ tramp-default-method-alist to be setup correctly."
+ (lexical-let ((remote-host (or remote-host machine-instance))
+ (username (or username (user-login-name))))
+ (list (concat "^" machine-instance "$")
+ (lambda (emacs-filename)
+ (tramp-file-name-localname
+ (tramp-dissect-file-name emacs-filename)))
+ `(lambda (lisp-filename)
+ (slime-make-tramp-file-name
+ ,username
+ ,remote-host
+ lisp-filename)))))
+
+(provide 'slime-tramp)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,91 @@
+;;; slime-typeout-frame.el --- display some message in a dedicated frame
+;;
+;; Author: Luke Gorrie <luke(a)synap.se>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-typeout-frame)))
+;;
+
+
+;;;; Typeout frame
+
+;; When a "typeout frame" exists it is used to display certain
+;; messages instead of the echo area or pop-up windows.
+
+(defvar slime-typeout-window nil
+ "The current typeout window.")
+
+(defvar slime-typeout-frame-properties
+ '((height . 10) (minibuffer . nil))
+ "The typeout frame properties (passed to `make-frame').")
+
+(defun slime-typeout-active-p ()
+ (and slime-typeout-window
+ (window-live-p slime-typeout-window)))
+
+(defun slime-typeout-message-aux (format-string &rest format-args)
+ (slime-ensure-typeout-frame)
+ (with-current-buffer (window-buffer slime-typeout-window)
+ (let ((msg (apply #'format format-string format-args)))
+ (unless (string= msg "")
+ (erase-buffer)
+ (insert msg)))))
+
+(defun slime-typeout-message (format-string &rest format-args)
+ (apply #'slime-typeout-message-aux format-string format-args)
+ ;; Disable the timer for autodoc temporarily, as it would overwrite
+ ;; the current typeout message otherwise.
+ (when (and (featurep 'slime-autodoc) slime-autodoc-mode)
+ (slime-autodoc-stop-timer)
+ (add-hook 'pre-command-hook #'slime-autodoc-start-timer)))
+
+(defun slime-make-typeout-frame ()
+ "Create a frame for displaying messages (e.g. arglists)."
+ (interactive)
+ (let ((frame (make-frame slime-typeout-frame-properties)))
+ (save-selected-window
+ (select-window (frame-selected-window frame))
+ (switch-to-buffer "*SLIME-Typeout*")
+ (setq slime-typeout-window (selected-window)))))
+
+(defun slime-ensure-typeout-frame ()
+ "Create the typeout frame unless it already exists."
+ (interactive)
+ (unless (slime-typeout-active-p)
+ (slime-make-typeout-frame)))
+
+(defun slime-typeout-autodoc-message (doc)
+ ;; No need for refreshing per `slime-autodoc-pre-command-refresh-echo-area'.
+ (setq slime-autodoc-last-message "")
+ (slime-typeout-message-aux "%s" doc))
+
+
+;;; Initialization
+
+(defvar slime-typeout-frame-unbind-stack ())
+
+(defun slime-typeout-frame-init ()
+ (add-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
+ (loop for (var value) in
+ '((slime-message-function slime-typeout-message)
+ (slime-background-message-function slime-typeout-message)
+ (slime-autodoc-message-function slime-typeout-autodoc-message))
+ do (slime-typeout-frame-init-var var value)))
+
+(defun slime-typeout-frame-init-var (var value)
+ (push (list var (if (boundp var) (symbol-value var) 'slime-unbound))
+ slime-typeout-frame-unbind-stack)
+ (set var value))
+
+(defun slime-typeout-frame-unload ()
+ (remove-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
+ (loop for (var value) in slime-typeout-frame-unbind-stack
+ do (cond ((eq var 'slime-unbound) (makunbound var))
+ (t (set var value)))))
+
+(provide 'slime-typeout-frame)
Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-xref-browser.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-xref-browser.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-xref-browser.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,104 @@
+;;; slime-xref-browser.el --- xref browsing with tree-widget
+;;
+;; Author: Rui Patroc�nio <rui.patrocinio(a)netvisao.pt>
+;; Licencse: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add this to your .emacs:
+;;
+;; (add-to-list 'load-path "<directory-of-this-file>")
+;; (add-hook 'slime-load-hook (lambda () (require 'slime-xref-browser)))
+;;
+
+
+;;;; classes browser
+
+(defun slime-expand-class-node (widget)
+ (or (widget-get widget :args)
+ (let ((name (widget-get widget :tag)))
+ (loop for kid in (slime-eval `(swank:mop :subclasses ,name))
+ collect `(tree-widget :tag ,kid
+ :dynargs slime-expand-class-node
+ :has-children t)))))
+
+(defun slime-browse-classes (name)
+ "Read the name of a class and show its subclasses."
+ (interactive (list (slime-read-symbol-name "Class Name: ")))
+ (slime-call-with-browser-setup
+ "*slime class browser*" (slime-current-package) "Class Browser"
+ (lambda ()
+ (widget-create 'tree-widget :tag name
+ :dynargs 'slime-expand-class-node
+ :has-echildren t))))
+
+(defvar slime-browser-map nil
+ "Keymap for tree widget browsers")
+
+(require 'tree-widget)
+(unless slime-browser-map
+ (setq slime-browser-map (make-sparse-keymap))
+ (set-keymap-parent slime-browser-map widget-keymap)
+ (define-key slime-browser-map "q" 'bury-buffer))
+
+(defun slime-call-with-browser-setup (buffer package title fn)
+ (switch-to-buffer buffer)
+ (kill-all-local-variables)
+ (setq slime-buffer-package package)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (widget-insert title "\n\n")
+ (save-excursion
+ (funcall fn))
+ (lisp-mode-variables t)
+ (slime-mode t)
+ (use-local-map slime-browser-map)
+ (widget-setup))
+
+
+;;;; Xref browser
+
+(defun slime-fetch-browsable-xrefs (type name)
+ "Return a list ((LABEL DSPEC)).
+LABEL is just a string for display purposes.
+DSPEC can be used to expand the node."
+ (let ((xrefs '()))
+ (loop for (_file . specs) in (slime-eval `(swank:xref ,type ,name)) do
+ (loop for (dspec . _location) in specs do
+ (let ((exp (ignore-errors (read (downcase dspec)))))
+ (cond ((and (consp exp) (eq 'flet (car exp)))
+ ;; we can't expand FLET references so they're useless
+ )
+ ((and (consp exp) (eq 'method (car exp)))
+ ;; this isn't quite right, but good enough for now
+ (push (list dspec (string (second exp))) xrefs))
+ (t
+ (push (list dspec dspec) xrefs))))))
+ xrefs))
+
+(defun slime-expand-xrefs (widget)
+ (or (widget-get widget :args)
+ (let* ((type (widget-get widget :xref-type))
+ (dspec (widget-get widget :xref-dspec))
+ (xrefs (slime-fetch-browsable-xrefs type dspec)))
+ (loop for (label dspec) in xrefs
+ collect `(tree-widget :tag ,label
+ :xref-type ,type
+ :xref-dspec ,dspec
+ :dynargs slime-expand-xrefs
+ :has-children t)))))
+
+(defun slime-browse-xrefs (name type)
+ "Show the xref graph of a function in a tree widget."
+ (interactive
+ (list (slime-read-from-minibuffer "Name: "
+ (slime-symbol-name-at-point))
+ (read (completing-read "Type: " (slime-bogus-completion-alist
+ '(":callers" ":callees" ":calls"))
+ nil t ":"))))
+ (slime-call-with-browser-setup
+ "*slime xref browser*" (slime-current-package) "Xref Browser"
+ (lambda ()
+ (widget-create 'tree-widget :tag name :xref-type type :xref-dspec name
+ :dynargs 'slime-expand-xrefs :has-echildren t))))
+
+(provide 'slime-xref-browser)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1217 @@
+;;; swank-arglists.lisp --- arglist related code ??
+;;
+;; Authors: Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;; Tobias C. Rittweiler <tcr(a)freebits.de>
+;; and others
+;;
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-c-p-c))
+
+(defun valid-operator-symbol-p (symbol)
+ "Is SYMBOL the name of a function, a macro, or a special-operator?"
+ (or (fboundp symbol)
+ (macro-function symbol)
+ (special-operator-p symbol)
+ (eq symbol 'declare)))
+
+(defun valid-operator-name-p (string)
+ "Is STRING the name of a function, macro, or special-operator?"
+ (let ((symbol (parse-symbol string)))
+ (valid-operator-symbol-p symbol)))
+
+(defslimefun arglist-for-echo-area (raw-specs &key arg-indices
+ print-right-margin print-lines)
+ "Return the arglist for the first valid ``form spec'' in
+RAW-SPECS. A ``form spec'' is a superset of functions, macros,
+special-ops, declarations and type specifiers.
+
+For more information about the format of ``raw form specs'' and
+``form specs'', please see PARSE-FORM-SPEC."
+ (handler-case
+ (with-buffer-syntax ()
+ (multiple-value-bind (form-spec position newly-interned-symbols)
+ (parse-first-valid-form-spec raw-specs #'read-conversatively-for-autodoc)
+ (unwind-protect
+ (when form-spec
+ (let ((arglist (arglist-from-form-spec form-spec :remove-args nil)))
+ (unless (eql arglist :not-available)
+ (multiple-value-bind (type operator arguments)
+ (split-form-spec form-spec)
+ (declare (ignore arguments))
+ (multiple-value-bind (stringified-arglist)
+ (decoded-arglist-to-string
+ arglist
+ :operator operator
+ :print-right-margin print-right-margin
+ :print-lines print-lines
+ :highlight (let ((index (nth position arg-indices)))
+ ;; don't highlight the operator
+ (and index (not (zerop index)) index)))
+ ;; Post formatting:
+ (case type
+ (:type-specifier (format nil "[Typespec] ~A" stringified-arglist))
+ (:declaration
+ (locally (declare (special *arglist-pprint-bindings*))
+ (with-bindings *arglist-pprint-bindings*
+ (let ((op (%find-declaration-operator raw-specs position)))
+ (if op
+ (format nil "(~A ~A)" op stringified-arglist)
+ (format nil "[Declaration] ~A" stringified-arglist))))))
+ (t stringified-arglist)))))))
+ (mapc #'unintern-in-home-package newly-interned-symbols))))
+ (error (cond)
+ (format nil "ARGLIST (error): ~A" cond))
+ ))
+
+(defun %find-declaration-operator (raw-specs position)
+ (let ((op-rawspec (nth (1+ position) raw-specs)))
+ (first (parse-form-spec op-rawspec #'read-conversatively-for-autodoc))))
+
+(defvar *arglist-dummy* (cons :dummy nil))
+
+(defun read-conversatively-for-autodoc (string)
+ "Tries to find the symbol that's represented by STRING.
+
+If it can't, this either means that STRING does not represent a
+symbol, or that the symbol behind STRING would have to be freshly
+interned. Because this function is supposed to be called from the
+automatic arglist display stuff from Slime, interning freshly
+symbols is a big no-no.
+
+In such a case (that no symbol could be found), the object
+*ARGLIST-DUMMY* is returned instead, which works as a placeholder
+datum for subsequent logics to rely on."
+ (let* ((string (string-left-trim '(#\Space #\Tab #\Newline) string))
+ (quoted? (eql (aref string 0) #\')))
+ (multiple-value-bind (symbol found?)
+ (parse-symbol (if quoted? (subseq string 1) string))
+ (if found?
+ (if quoted? `(quote ,symbol) symbol)
+ *arglist-dummy*))))
+
+
+(defun parse-form-spec (raw-spec &optional reader)
+ "Takes a raw (i.e. unparsed) form spec from SLIME and returns a
+proper form spec for further processing within SWANK. Returns NIL
+if RAW-SPEC could not be parsed. Symbols that had to be interned
+in course of the conversion, are returned as secondary return value.
+
+A ``raw form spec'' can be either:
+
+ i) a list of strings representing a Common Lisp form
+
+ ii) a list of strings as of i), but which additionally
+ contains other raw form specs
+
+ iii) one of:
+
+ a) (:declaration declspec)
+
+ where DECLSPEC is a raw form spec.
+
+ b) (:type-specifier typespec)
+
+ where TYPESPEC is a raw form spec.
+
+
+A ``form spec'' is either
+
+ 1) a normal Common Lisp form
+
+ 2) a Common Lisp form with a list as its CAR specifying what namespace
+ the operator is supposed to be interpreted in:
+
+ a) ((:declaration decl-identifier) declarg1 declarg2 ...)
+
+ b) ((:type-specifier typespec-op) typespec-arg1 typespec-arg2 ...)
+
+
+Examples:
+
+ (\"defmethod\") => (defmethod)
+ (\"cl:defmethod\") => (cl:defmethod)
+ (\"defmethod\" \"print-object\") => (defmethod print-object)
+
+ (\"foo\" (\"bar\" (\"quux\")) \"baz\" => (foo (bar (quux)) baz)
+
+ (:declaration \"optimize\" \"(optimize)\") => ((:declaration optimize))
+ (:declaration \"type\" \"(type string)\") => ((:declaration type) string)
+ (:type-specifier \"float\" \"(float)\") => ((:type-specifier float))
+ (:type-specifier \"float\" \"(float 0 100)\") => ((:type-specifier float) 0 100)
+"
+ (flet ((parse-extended-spec (raw-extension extension-flag)
+ (when (and (stringp (first raw-extension)) ; (:DECLARATION (("a" "b" ("c")) "d"))
+ (nth-value 1 (parse-symbol (first raw-extension))))
+ (multiple-value-bind (extension introduced-symbols)
+ (read-form-spec raw-extension reader)
+ (unless (recursively-empty-p extension) ; (:DECLARATION (())) &c.
+ (destructuring-bind (identifier &rest args) extension
+ (values `((,extension-flag ,identifier) ,@args)
+ introduced-symbols)))))))
+ (when (consp raw-spec)
+ (destructure-case raw-spec
+ ((:declaration raw-declspec)
+ (parse-extended-spec raw-declspec :declaration))
+ ((:type-specifier raw-typespec)
+ (parse-extended-spec raw-typespec :type-specifier))
+ (t
+ (when (every #'(lambda (x) (or (stringp x) (consp x))) raw-spec)
+ (destructuring-bind (raw-operator &rest raw-args) raw-spec
+ (multiple-value-bind (operator found?) (parse-symbol raw-operator)
+ (when (and found? (valid-operator-symbol-p operator))
+ (multiple-value-bind (parsed-args introduced-symbols)
+ (read-form-spec raw-args reader)
+ (values `(,operator ,@parsed-args) introduced-symbols)))))))))))
+
+
+(defun split-form-spec (spec)
+ "Returns all three relevant information a ``form spec''
+contains: the operator type, the operator, and the operands."
+ (destructuring-bind (operator-designator &rest arguments) spec
+ (multiple-value-bind (type operator)
+ (if (listp operator-designator)
+ (values (first operator-designator) (second operator-designator))
+ (values :function operator-designator)) ; functions, macros, special ops
+ (values type operator arguments)))) ; are all fbound.
+
+(defun parse-first-valid-form-spec (raw-specs &optional reader)
+ "Returns the first parsed form spec in RAW-SPECS that can
+successfully be parsed. Additionally returns that spec's position
+as secondary, and all newly interned symbols as tertiary return
+value."
+ (loop for raw-spec in raw-specs
+ for pos upfrom 0
+ do (multiple-value-bind (spec symbols) (parse-form-spec raw-spec reader)
+ (when spec (return (values spec pos symbols))))))
+
+(defun read-form-spec (spec &optional reader)
+ "Turns the ``raw form spec'' SPEC into a proper Common Lisp
+form. As secondary return value, it returns all the symbols that
+had to be newly interned during the conversion.
+
+READER is a function that takes a string, and returns two values:
+the Common Lisp datum that the string represents, a flag whether
+the returned datum is a symbol and has been newly interned in
+some package.
+
+If READER is not explicitly given, the function READ-SOFTLY is
+used instead."
+ (when spec
+ (with-buffer-syntax ()
+ (call-with-ignored-reader-errors
+ #'(lambda ()
+ (let ((result) (newly-interned-symbols) (ok))
+ (unwind-protect
+ (dolist (element spec (setq ok t))
+ (etypecase element
+ (string
+ (multiple-value-bind (sexp newly-interned?)
+ (funcall (or reader 'read-softly) element)
+ (push sexp result)
+ (when newly-interned?
+ (push sexp newly-interned-symbols))))
+ (cons
+ (multiple-value-bind (read-spec interned-symbols)
+ (read-form-spec element)
+ (push read-spec result)
+ (setf newly-interned-symbols
+ (append interned-symbols
+ newly-interned-symbols))))))
+ (unless ok
+ (mapc #'unintern-in-home-package newly-interned-symbols)))
+ (values (nreverse result)
+ (nreverse newly-interned-symbols))))))))
+
+(defun unintern-in-home-package (symbol)
+ (unintern symbol (symbol-package symbol)))
+
+(defun read-softly (string)
+ "Returns two values:
+
+ 1. the object resulting from READing STRING.
+
+ 2. T if the object is a symbol that had to be newly interned
+ in some package. (This does not work for symbols in
+ compound forms like lists or vectors.)"
+ (multiple-value-bind (symbol found? symbol-name package) (parse-symbol string)
+ (if found?
+ (values symbol nil)
+ (let ((sexp (read-from-string string)))
+ (values sexp
+ (when (symbolp sexp)
+ (prog1 t
+ ;; assert that PARSE-SYMBOL didn't parse incorrectly.
+ (assert (and (equal symbol-name (symbol-name sexp))
+ (eq package (symbol-package sexp)))))))))))
+
+
+(defstruct (arglist (:conc-name arglist.) (:predicate arglist-p))
+ provided-args ; list of the provided actual arguments
+ required-args ; list of the required arguments
+ optional-args ; list of the optional arguments
+ key-p ; whether &key appeared
+ keyword-args ; list of the keywords
+ rest ; name of the &rest or &body argument (if any)
+ body-p ; whether the rest argument is a &body
+ allow-other-keys-p ; whether &allow-other-keys appeared
+ aux-args ; list of &aux variables
+ any-p ; whether &any appeared
+ any-args ; list of &any arguments [*]
+ known-junk ; &whole, &environment
+ unknown-junk) ; unparsed stuff
+
+;;;
+;;; [*] The &ANY lambda keyword is an extension to ANSI Common Lisp,
+;;; and is only used to describe certain arglists that cannot be
+;;; described in another way.
+;;;
+;;; &ANY is very similiar to &KEY but while &KEY is based upon
+;;; the idea of a plist (key1 value1 key2 value2), &ANY is a
+;;; cross between &OPTIONAL, &KEY and *FEATURES* lists:
+;;;
+;;; a) (&ANY :A :B :C) means that you can provide any (non-null)
+;;; set consisting of the keywords `:A', `:B', or `:C' in
+;;; the arglist. E.g. (:A) or (:C :B :A).
+;;;
+;;; (This is not restricted to keywords only, but any self-evaluating
+;;; expression is allowed.)
+;;;
+;;; b) (&ANY (key1 v1) (key2 v2) (key3 v3)) means that you can
+;;; provide any (non-null) set consisting of lists where
+;;; the CAR of the list is one of `key1', `key2', or `key3'.
+;;; E.g. ((key1 100) (key3 42)), or ((key3 66) (key2 23))
+;;;
+;;;
+;;; For example, a) let us describe the situations of EVAL-WHEN as
+;;;
+;;; (EVAL-WHEN (&ANY :compile-toplevel :load-toplevel :execute) &BODY body)
+;;;
+;;; and b) let us describe the optimization qualifiers that are valid
+;;; in the declaration specifier `OPTIMIZE':
+;;;
+;;; (DECLARE (OPTIMIZE &ANY (compilation-speed 1) (safety 1) ...))
+;;;
+
+(defun print-arglist (arglist &key operator highlight)
+ (let ((index 0)
+ (need-space nil))
+ (labels ((print-arg (arg)
+ (typecase arg
+ (arglist ; destructuring pattern
+ (print-arglist arg))
+ (optional-arg
+ (princ (encode-optional-arg arg)))
+ (keyword-arg
+ (let ((enc-arg (encode-keyword-arg arg)))
+ (etypecase enc-arg
+ (symbol (princ enc-arg))
+ ((cons symbol)
+ (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+ (princ (car enc-arg))
+ (write-char #\space)
+ (pprint-fill *standard-output* (cdr enc-arg) nil)))
+ ((cons cons)
+ (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+ (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+ (prin1 (caar enc-arg))
+ (write-char #\space)
+ (print-arg (keyword-arg.arg-name arg)))
+ (unless (null (cdr enc-arg))
+ (write-char #\space))
+ (pprint-fill *standard-output* (cdr enc-arg) nil))))))
+ (t ; required formal or provided actual arg
+ (if (keywordp arg)
+ (prin1 arg) ; for &ANY args.
+ (princ arg)))))
+ (print-space ()
+ (ecase need-space
+ ((nil))
+ ((:miser)
+ (write-char #\space)
+ (pprint-newline :miser))
+ ((t)
+ (write-char #\space)
+ (pprint-newline :fill)))
+ (setq need-space t))
+ (print-with-space (obj)
+ (print-space)
+ (print-arg obj))
+ (print-with-highlight (arg &optional (index-ok-p #'=))
+ (print-space)
+ (cond
+ ((and highlight (funcall index-ok-p index highlight))
+ (princ "===> ")
+ (print-arg arg)
+ (princ " <==="))
+ (t
+ (print-arg arg)))
+ (incf index)))
+ (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+ (when operator
+ (print-with-highlight operator)
+ (setq need-space :miser))
+ (mapc #'print-with-highlight
+ (arglist.provided-args arglist))
+ (mapc #'print-with-highlight
+ (arglist.required-args arglist))
+ (when (arglist.optional-args arglist)
+ (print-with-space '&optional)
+ (mapc #'print-with-highlight
+ (arglist.optional-args arglist)))
+ (when (arglist.key-p arglist)
+ (print-with-space '&key)
+ (mapc #'print-with-space
+ (arglist.keyword-args arglist)))
+ (when (arglist.allow-other-keys-p arglist)
+ (print-with-space '&allow-other-keys))
+ (when (arglist.any-args arglist)
+ (print-with-space '&any)
+ (mapc #'print-with-space
+ (arglist.any-args arglist)))
+ (cond ((not (arglist.rest arglist)))
+ ((arglist.body-p arglist)
+ (print-with-space '&body)
+ (print-with-highlight (arglist.rest arglist) #'<=))
+ (t
+ (print-with-space '&rest)
+ (print-with-highlight (arglist.rest arglist) #'<=)))
+ (mapc #'print-with-space
+ (arglist.unknown-junk arglist))))))
+
+(defvar *arglist-pprint-bindings*
+ '((*print-case* . :downcase)
+ (*print-pretty* . t)
+ (*print-circle* . nil)
+ (*print-readably* . nil)
+ (*print-level* . 10)
+ (*print-length* . 20)
+ (*print-escape* . nil))) ; no package qualifiers.
+
+(defun decoded-arglist-to-string (arglist
+ &key operator highlight (package *package*)
+ print-right-margin print-lines)
+ "Print the decoded ARGLIST for display in the echo area. The
+argument name are printed without package qualifiers and pretty
+printing of (function foo) as #'foo is suppressed. If HIGHLIGHT is
+non-nil, it must be the index of an argument; highlight this argument.
+If OPERATOR is non-nil, put it in front of the arglist."
+ (with-output-to-string (*standard-output*)
+ (with-standard-io-syntax
+ (with-bindings *arglist-pprint-bindings*
+ (let ((*package* package)
+ (*print-right-margin* print-right-margin)
+ (*print-lines* print-lines))
+ (print-arglist arglist :operator operator :highlight highlight))))))
+
+(defslimefun variable-desc-for-echo-area (variable-name)
+ "Return a short description of VARIABLE-NAME, or NIL."
+ (with-buffer-syntax ()
+ (let ((sym (parse-symbol variable-name)))
+ (if (and sym (boundp sym))
+ (let ((*print-pretty* nil) (*print-level* 4)
+ (*print-length* 10) (*print-circle* t))
+ (format nil "~A => ~A" sym (symbol-value sym)))))))
+
+(defun decode-required-arg (arg)
+ "ARG can be a symbol or a destructuring pattern."
+ (etypecase arg
+ (symbol arg)
+ (list (decode-arglist arg))))
+
+(defun encode-required-arg (arg)
+ (etypecase arg
+ (symbol arg)
+ (arglist (encode-arglist arg))))
+
+(defstruct (keyword-arg
+ (:conc-name keyword-arg.)
+ (:constructor make-keyword-arg (keyword arg-name default-arg)))
+ keyword
+ arg-name
+ default-arg)
+
+(defun decode-keyword-arg (arg)
+ "Decode a keyword item of formal argument list.
+Return three values: keyword, argument name, default arg."
+ (cond ((symbolp arg)
+ (make-keyword-arg (intern (symbol-name arg) keyword-package)
+ arg
+ nil))
+ ((and (consp arg)
+ (consp (car arg)))
+ (make-keyword-arg (caar arg)
+ (decode-required-arg (cadar arg))
+ (cadr arg)))
+ ((consp arg)
+ (make-keyword-arg (intern (symbol-name (car arg)) keyword-package)
+ (car arg)
+ (cadr arg)))
+ (t
+ (error "Bad keyword item of formal argument list"))))
+
+(defun encode-keyword-arg (arg)
+ (cond
+ ((arglist-p (keyword-arg.arg-name arg))
+ ;; Destructuring pattern
+ (let ((keyword/name (list (keyword-arg.keyword arg)
+ (encode-required-arg
+ (keyword-arg.arg-name arg)))))
+ (if (keyword-arg.default-arg arg)
+ (list keyword/name
+ (keyword-arg.default-arg arg))
+ (list keyword/name))))
+ ((eql (intern (symbol-name (keyword-arg.arg-name arg))
+ keyword-package)
+ (keyword-arg.keyword arg))
+ (if (keyword-arg.default-arg arg)
+ (list (keyword-arg.arg-name arg)
+ (keyword-arg.default-arg arg))
+ (keyword-arg.arg-name arg)))
+ (t
+ (let ((keyword/name (list (keyword-arg.keyword arg)
+ (keyword-arg.arg-name arg))))
+ (if (keyword-arg.default-arg arg)
+ (list keyword/name
+ (keyword-arg.default-arg arg))
+ (list keyword/name))))))
+
+(progn
+ (assert (equalp (decode-keyword-arg 'x)
+ (make-keyword-arg :x 'x nil)))
+ (assert (equalp (decode-keyword-arg '(x t))
+ (make-keyword-arg :x 'x t)))
+ (assert (equalp (decode-keyword-arg '((:x y)))
+ (make-keyword-arg :x 'y nil)))
+ (assert (equalp (decode-keyword-arg '((:x y) t))
+ (make-keyword-arg :x 'y t))))
+
+(defstruct (optional-arg
+ (:conc-name optional-arg.)
+ (:constructor make-optional-arg (arg-name default-arg)))
+ arg-name
+ default-arg)
+
+(defun decode-optional-arg (arg)
+ "Decode an optional item of a formal argument list.
+Return an OPTIONAL-ARG structure."
+ (etypecase arg
+ (symbol (make-optional-arg arg nil))
+ (list (make-optional-arg (decode-required-arg (car arg))
+ (cadr arg)))))
+
+(defun encode-optional-arg (optional-arg)
+ (if (or (optional-arg.default-arg optional-arg)
+ (arglist-p (optional-arg.arg-name optional-arg)))
+ (list (encode-required-arg
+ (optional-arg.arg-name optional-arg))
+ (optional-arg.default-arg optional-arg))
+ (optional-arg.arg-name optional-arg)))
+
+(progn
+ (assert (equalp (decode-optional-arg 'x)
+ (make-optional-arg 'x nil)))
+ (assert (equalp (decode-optional-arg '(x t))
+ (make-optional-arg 'x t))))
+
+(define-modify-macro nreversef () nreverse "Reverse the list in PLACE.")
+
+(defun decode-arglist (arglist)
+ "Parse the list ARGLIST and return an ARGLIST structure."
+ (let ((mode nil)
+ (result (make-arglist)))
+ (dolist (arg arglist)
+ (cond
+ ((eql mode '&unknown-junk)
+ ;; don't leave this mode -- we don't know how the arglist
+ ;; after unknown lambda-list keywords is interpreted
+ (push arg (arglist.unknown-junk result)))
+ ((eql arg '&allow-other-keys)
+ (setf (arglist.allow-other-keys-p result) t))
+ ((eql arg '&key)
+ (setf (arglist.key-p result) t
+ mode arg))
+ ((member arg '(&optional &rest &body &aux))
+ (setq mode arg))
+ ((member arg '(&whole &environment))
+ (setq mode arg)
+ (push arg (arglist.known-junk result)))
+ ((and (symbolp arg)
+ (string= (symbol-name arg) (string '#:&ANY))) ; may be interned
+ (setf (arglist.any-p result) t) ; in any *package*.
+ (setq mode '&any))
+ ((member arg lambda-list-keywords)
+ (setq mode '&unknown-junk)
+ (push arg (arglist.unknown-junk result)))
+ (t
+ (ecase mode
+ (&key
+ (push (decode-keyword-arg arg)
+ (arglist.keyword-args result)))
+ (&optional
+ (push (decode-optional-arg arg)
+ (arglist.optional-args result)))
+ (&body
+ (setf (arglist.body-p result) t
+ (arglist.rest result) arg))
+ (&rest
+ (setf (arglist.rest result) arg))
+ (&aux
+ (push (decode-optional-arg arg)
+ (arglist.aux-args result)))
+ ((nil)
+ (push (decode-required-arg arg)
+ (arglist.required-args result)))
+ ((&whole &environment)
+ (setf mode nil)
+ (push arg (arglist.known-junk result)))
+ (&any
+ (push arg (arglist.any-args result)))))))
+ (nreversef (arglist.required-args result))
+ (nreversef (arglist.optional-args result))
+ (nreversef (arglist.keyword-args result))
+ (nreversef (arglist.aux-args result))
+ (nreversef (arglist.any-args result))
+ (nreversef (arglist.known-junk result))
+ (nreversef (arglist.unknown-junk result))
+ (assert (or (and (not (arglist.key-p result)) (not (arglist.any-p result)))
+ (exactly-one-p (arglist.key-p result) (arglist.any-p result))))
+ result))
+
+(defun encode-arglist (decoded-arglist)
+ (append (mapcar #'encode-required-arg (arglist.required-args decoded-arglist))
+ (when (arglist.optional-args decoded-arglist)
+ '(&optional))
+ (mapcar #'encode-optional-arg (arglist.optional-args decoded-arglist))
+ (when (arglist.key-p decoded-arglist)
+ '(&key))
+ (mapcar #'encode-keyword-arg (arglist.keyword-args decoded-arglist))
+ (when (arglist.allow-other-keys-p decoded-arglist)
+ '(&allow-other-keys))
+ (when (arglist.any-args decoded-arglist)
+ `(&any ,(a)(arglist.any-args decoded-arglist)))
+ (cond ((not (arglist.rest decoded-arglist))
+ '())
+ ((arglist.body-p decoded-arglist)
+ `(&body ,(arglist.rest decoded-arglist)))
+ (t
+ `(&rest ,(arglist.rest decoded-arglist))))
+ (when (arglist.aux-args decoded-arglist)
+ `(&aux ,(arglist.aux-args decoded-arglist)))
+ (arglist.known-junk decoded-arglist)
+ (arglist.unknown-junk decoded-arglist)))
+
+(defun arglist-keywords (arglist)
+ "Return the list of keywords in ARGLIST.
+As a secondary value, return whether &allow-other-keys appears."
+ (let ((decoded-arglist (decode-arglist arglist)))
+ (values (arglist.keyword-args decoded-arglist)
+ (arglist.allow-other-keys-p decoded-arglist))))
+
+(defun methods-keywords (methods)
+ "Collect all keywords in the arglists of METHODS.
+As a secondary value, return whether &allow-other-keys appears somewhere."
+ (let ((keywords '())
+ (allow-other-keys nil))
+ (dolist (method methods)
+ (multiple-value-bind (kw aok)
+ (arglist-keywords
+ (swank-mop:method-lambda-list method))
+ (setq keywords (remove-duplicates (append keywords kw)
+ :key #'keyword-arg.keyword)
+ allow-other-keys (or allow-other-keys aok))))
+ (values keywords allow-other-keys)))
+
+(defun generic-function-keywords (generic-function)
+ "Collect all keywords in the methods of GENERIC-FUNCTION.
+As a secondary value, return whether &allow-other-keys appears somewhere."
+ (methods-keywords
+ (swank-mop:generic-function-methods generic-function)))
+
+(defun applicable-methods-keywords (generic-function arguments)
+ "Collect all keywords in the methods of GENERIC-FUNCTION that are
+applicable for argument of CLASSES. As a secondary value, return
+whether &allow-other-keys appears somewhere."
+ (methods-keywords
+ (multiple-value-bind (amuc okp)
+ (swank-mop:compute-applicable-methods-using-classes
+ generic-function (mapcar #'class-of arguments))
+ (if okp
+ amuc
+ (compute-applicable-methods generic-function arguments)))))
+
+(defun decoded-arglist-to-template-string (decoded-arglist package &key (prefix "(") (suffix ")"))
+ (with-output-to-string (*standard-output*)
+ (with-standard-io-syntax
+ (let ((*package* package) (*print-case* :downcase)
+ (*print-pretty* t) (*print-circle* nil) (*print-readably* nil)
+ (*print-level* 10) (*print-length* 20))
+ (print-decoded-arglist-as-template decoded-arglist
+ :prefix prefix
+ :suffix suffix)))))
+
+(defun print-decoded-arglist-as-template (decoded-arglist &key
+ (prefix "(") (suffix ")"))
+ (pprint-logical-block (nil nil :prefix prefix :suffix suffix)
+ (let ((first-p t))
+ (flet ((space ()
+ (unless first-p
+ (write-char #\space)
+ (pprint-newline :fill))
+ (setq first-p nil))
+ (print-arg-or-pattern (arg)
+ (etypecase arg
+ (symbol (if (keywordp arg) (prin1 arg) (princ arg)))
+ (string (princ arg))
+ (list (princ arg))
+ (arglist (print-decoded-arglist-as-template arg)))))
+ (dolist (arg (arglist.required-args decoded-arglist))
+ (space)
+ (print-arg-or-pattern arg))
+ (dolist (arg (arglist.optional-args decoded-arglist))
+ (space)
+ (princ "[")
+ (print-arg-or-pattern (optional-arg.arg-name arg))
+ (princ "]"))
+ (dolist (keyword-arg (arglist.keyword-args decoded-arglist))
+ (space)
+ (let ((arg-name (keyword-arg.arg-name keyword-arg))
+ (keyword (keyword-arg.keyword keyword-arg)))
+ (format t "~W "
+ (if (keywordp keyword) keyword `',keyword))
+ (print-arg-or-pattern arg-name)))
+ (dolist (any-arg (arglist.any-args decoded-arglist))
+ (space)
+ (print-arg-or-pattern any-arg))
+ (when (and (arglist.rest decoded-arglist)
+ (or (not (arglist.keyword-args decoded-arglist))
+ (arglist.allow-other-keys-p decoded-arglist)))
+ (if (arglist.body-p decoded-arglist)
+ (pprint-newline :mandatory)
+ (space))
+ (format t "~A..." (arglist.rest decoded-arglist)))))
+ (pprint-newline :fill)))
+
+
+(defgeneric extra-keywords (operator &rest args)
+ (:documentation "Return a list of extra keywords of OPERATOR (a
+symbol) when applied to the (unevaluated) ARGS.
+As a secondary value, return whether other keys are allowed.
+As a tertiary value, return the initial sublist of ARGS that was needed
+to determine the extra keywords."))
+
+(defun keywords-of-operator (operator)
+ "Return a list of KEYWORD-ARGs that OPERATOR accepts.
+This function is useful for writing EXTRA-KEYWORDS methods for
+user-defined functions which are declared &ALLOW-OTHER-KEYS and which
+forward keywords to OPERATOR."
+ (let ((arglist (arglist-from-form-spec (ensure-list operator)
+ :remove-args nil)))
+ (unless (eql arglist :not-available)
+ (values
+ (arglist.keyword-args arglist)
+ (arglist.allow-other-keys-p arglist)))))
+
+(defmethod extra-keywords (operator &rest args)
+ ;; default method
+ (declare (ignore args))
+ (let ((symbol-function (symbol-function operator)))
+ (if (typep symbol-function 'generic-function)
+ (generic-function-keywords symbol-function)
+ nil)))
+
+(defun class-from-class-name-form (class-name-form)
+ (when (and (listp class-name-form)
+ (= (length class-name-form) 2)
+ (eq (car class-name-form) 'quote))
+ (let* ((class-name (cadr class-name-form))
+ (class (find-class class-name nil)))
+ (when (and class
+ (not (swank-mop:class-finalized-p class)))
+ ;; Try to finalize the class, which can fail if
+ ;; superclasses are not defined yet
+ (handler-case (swank-mop:finalize-inheritance class)
+ (program-error (c)
+ (declare (ignore c)))))
+ class)))
+
+(defun extra-keywords/slots (class)
+ (multiple-value-bind (slots allow-other-keys-p)
+ (if (swank-mop:class-finalized-p class)
+ (values (swank-mop:class-slots class) nil)
+ (values (swank-mop:class-direct-slots class) t))
+ (let ((slot-init-keywords
+ (loop for slot in slots append
+ (mapcar (lambda (initarg)
+ (make-keyword-arg
+ initarg
+ (swank-mop:slot-definition-name slot)
+ (swank-mop:slot-definition-initform slot)))
+ (swank-mop:slot-definition-initargs slot)))))
+ (values slot-init-keywords allow-other-keys-p))))
+
+(defun extra-keywords/make-instance (operator &rest args)
+ (declare (ignore operator))
+ (unless (null args)
+ (let* ((class-name-form (car args))
+ (class (class-from-class-name-form class-name-form)))
+ (when class
+ (multiple-value-bind (slot-init-keywords class-aokp)
+ (extra-keywords/slots class)
+ (multiple-value-bind (allocate-instance-keywords ai-aokp)
+ (applicable-methods-keywords
+ #'allocate-instance (list class))
+ (multiple-value-bind (initialize-instance-keywords ii-aokp)
+ (applicable-methods-keywords
+ #'initialize-instance (list (swank-mop:class-prototype class)))
+ (multiple-value-bind (shared-initialize-keywords si-aokp)
+ (applicable-methods-keywords
+ #'shared-initialize (list (swank-mop:class-prototype class) t))
+ (values (append slot-init-keywords
+ allocate-instance-keywords
+ initialize-instance-keywords
+ shared-initialize-keywords)
+ (or class-aokp ai-aokp ii-aokp si-aokp)
+ (list class-name-form))))))))))
+
+(defun extra-keywords/change-class (operator &rest args)
+ (declare (ignore operator))
+ (unless (null args)
+ (let* ((class-name-form (car args))
+ (class (class-from-class-name-form class-name-form)))
+ (when class
+ (multiple-value-bind (slot-init-keywords class-aokp)
+ (extra-keywords/slots class)
+ (declare (ignore class-aokp))
+ (multiple-value-bind (shared-initialize-keywords si-aokp)
+ (applicable-methods-keywords
+ #'shared-initialize (list (swank-mop:class-prototype class) t))
+ ;; FIXME: much as it would be nice to include the
+ ;; applicable keywords from
+ ;; UPDATE-INSTANCE-FOR-DIFFERENT-CLASS, I don't really see
+ ;; how to do it: so we punt, always declaring
+ ;; &ALLOW-OTHER-KEYS.
+ (declare (ignore si-aokp))
+ (values (append slot-init-keywords shared-initialize-keywords)
+ t
+ (list class-name-form))))))))
+
+(defmacro multiple-value-or (&rest forms)
+ (if (null forms)
+ nil
+ (let ((first (first forms))
+ (rest (rest forms)))
+ `(let* ((values (multiple-value-list ,first))
+ (primary-value (first values)))
+ (if primary-value
+ (values-list values)
+ (multiple-value-or ,@rest))))))
+
+(defmethod extra-keywords ((operator (eql 'make-instance))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'make-condition))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'error))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'signal))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'warn))
+ &rest args)
+ (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+ (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'cerror))
+ &rest args)
+ (multiple-value-bind (keywords aok determiners)
+ (apply #'extra-keywords/make-instance operator
+ (cdr args))
+ (if keywords
+ (values keywords aok
+ (cons (car args) determiners))
+ (call-next-method))))
+
+(defmethod extra-keywords ((operator (eql 'change-class))
+ &rest args)
+ (multiple-value-bind (keywords aok determiners)
+ (apply #'extra-keywords/change-class operator (cdr args))
+ (if keywords
+ (values keywords aok
+ (cons (car args) determiners))
+ (call-next-method))))
+
+(defun enrich-decoded-arglist-with-keywords (decoded-arglist keywords allow-other-keys-p)
+ "Modify DECODED-ARGLIST using KEYWORDS and ALLOW-OTHER-KEYS-P."
+ (when keywords
+ (setf (arglist.key-p decoded-arglist) t)
+ (setf (arglist.keyword-args decoded-arglist)
+ (remove-duplicates
+ (append (arglist.keyword-args decoded-arglist)
+ keywords)
+ :key #'keyword-arg.keyword)))
+ (setf (arglist.allow-other-keys-p decoded-arglist)
+ (or (arglist.allow-other-keys-p decoded-arglist)
+ allow-other-keys-p)))
+
+(defun enrich-decoded-arglist-with-extra-keywords (decoded-arglist form)
+ "Determine extra keywords from the function call FORM, and modify
+DECODED-ARGLIST to include them. As a secondary return value, return
+the initial sublist of ARGS that was needed to determine the extra
+keywords. As a tertiary return value, return whether any enrichment
+was done."
+ (multiple-value-bind (extra-keywords extra-aok determining-args)
+ (apply #'extra-keywords form)
+ ;; enrich the list of keywords with the extra keywords
+ (enrich-decoded-arglist-with-keywords decoded-arglist
+ extra-keywords extra-aok)
+ (values decoded-arglist
+ determining-args
+ (or extra-keywords extra-aok))))
+
+(defgeneric compute-enriched-decoded-arglist (operator-form argument-forms)
+ (:documentation
+ "Return three values: DECODED-ARGLIST, DETERMINING-ARGS, and
+ANY-ENRICHMENT, just like enrich-decoded-arglist-with-extra-keywords.
+If the arglist is not available, return :NOT-AVAILABLE."))
+
+(defmethod compute-enriched-decoded-arglist (operator-form argument-forms)
+ (let ((arglist (arglist operator-form)))
+ (etypecase arglist
+ ((member :not-available)
+ :not-available)
+ (list
+ (let ((decoded-arglist (decode-arglist arglist)))
+ (enrich-decoded-arglist-with-extra-keywords decoded-arglist
+ (cons operator-form
+ argument-forms)))))))
+
+(defmethod compute-enriched-decoded-arglist ((operator-form (eql 'with-open-file))
+ argument-forms)
+ (declare (ignore argument-forms))
+ (multiple-value-bind (decoded-arglist determining-args)
+ (call-next-method)
+ (let ((first-arg (first (arglist.required-args decoded-arglist)))
+ (open-arglist (compute-enriched-decoded-arglist 'open nil)))
+ (when (and (arglist-p first-arg) (arglist-p open-arglist))
+ (enrich-decoded-arglist-with-keywords
+ first-arg
+ (arglist.keyword-args open-arglist)
+ nil)))
+ (values decoded-arglist determining-args t)))
+
+(defmethod compute-enriched-decoded-arglist ((operator-form (eql 'apply))
+ argument-forms)
+ (let ((function-name-form (car argument-forms)))
+ (when (and (listp function-name-form)
+ (length= function-name-form 2)
+ (member (car function-name-form) '(quote function)))
+ (let ((function-name (cadr function-name-form)))
+ (when (valid-operator-symbol-p function-name)
+ (let ((function-arglist
+ (compute-enriched-decoded-arglist function-name
+ (cdr argument-forms))))
+ (return-from compute-enriched-decoded-arglist
+ (values (make-arglist :required-args
+ (list 'function)
+ :optional-args
+ (append
+ (mapcar #'(lambda (arg)
+ (make-optional-arg arg nil))
+ (arglist.required-args function-arglist))
+ (arglist.optional-args function-arglist))
+ :key-p
+ (arglist.key-p function-arglist)
+ :keyword-args
+ (arglist.keyword-args function-arglist)
+ :rest
+ 'args
+ :allow-other-keys-p
+ (arglist.allow-other-keys-p function-arglist))
+ (list function-name-form)
+ t)))))))
+ (call-next-method))
+
+(defvar *remove-keywords-alist*
+ '((:test :test-not)
+ (:test-not :test)))
+
+(defun remove-actual-args (decoded-arglist actual-arglist)
+ "Remove from DECODED-ARGLIST the arguments that have already been
+provided in ACTUAL-ARGLIST."
+ (assert (or (and (not (arglist.key-p decoded-arglist))
+ (not (arglist.any-p decoded-arglist)))
+ (exactly-one-p (arglist.key-p decoded-arglist)
+ (arglist.any-p decoded-arglist))))
+ (loop while (and actual-arglist
+ (arglist.required-args decoded-arglist))
+ do (progn (pop actual-arglist)
+ (pop (arglist.required-args decoded-arglist))))
+ (loop while (and actual-arglist
+ (arglist.optional-args decoded-arglist))
+ do (progn (pop actual-arglist)
+ (pop (arglist.optional-args decoded-arglist))))
+ (if (arglist.any-p decoded-arglist)
+ (remove-&any-args decoded-arglist actual-arglist)
+ (remove-&key-args decoded-arglist actual-arglist))
+ decoded-arglist)
+
+(defun remove-&key-args (decoded-arglist key-args)
+ (loop for keyword in key-args by #'cddr
+ for keywords-to-remove = (cdr (assoc keyword *remove-keywords-alist*))
+ do (setf (arglist.keyword-args decoded-arglist)
+ (remove-if (lambda (kw)
+ (or (eql kw keyword)
+ (member kw keywords-to-remove)))
+ (arglist.keyword-args decoded-arglist)
+ :key #'keyword-arg.keyword))) )
+
+(defun remove-&any-args (decoded-arglist any-args)
+ (setf (arglist.any-args decoded-arglist)
+ (remove-if #'(lambda (x) (member x any-args))
+ (arglist.any-args decoded-arglist)
+ :key #'(lambda (x) (first (ensure-list x))))))
+
+
+(defun arglist-from-form-spec (form-spec &key (remove-args t))
+ "Returns the decoded arglist that corresponds to FORM-SPEC. If
+REMOVE-ARGS is T, the arguments that are contained in FORM-SPEC
+are removed from the result arglist.
+
+Examples:
+
+ (arglist-from-form-spec '(defun))
+
+ ~=> (name args &body body)
+
+ (arglist-from-form-spec '(defun foo))
+
+ ~=> (args &body body)
+
+ (arglist-from-form-spec '(defun foo) :remove-args nil))
+
+ ~=> (name args &body body))
+
+ (arglist-from-form-spec '((:type-specifier float) 42) :remove-args nil)
+
+ ~=> (&optional lower-limit upper-limit)
+"
+ (if (null form-spec)
+ :not-available
+ (multiple-value-bind (type operator arguments)
+ (split-form-spec form-spec)
+ (arglist-dispatch type operator arguments :remove-args remove-args))))
+
+
+(defmacro with-availability ((var) form &body body)
+ `(let ((,var ,form))
+ (if (eql ,var :not-available)
+ :not-available
+ (progn ,@body))))
+
+(defgeneric arglist-dispatch (operator-type operator arguments &key remove-args))
+
+(defmethod arglist-dispatch (operator-type operator arguments &key (remove-args t))
+ (when (and (symbolp operator)
+ (valid-operator-symbol-p operator))
+ (multiple-value-bind (decoded-arglist determining-args any-enrichment)
+ (compute-enriched-decoded-arglist operator arguments)
+ (etypecase decoded-arglist
+ ((member :not-available)
+ :not-available)
+ (arglist
+ (cond
+ (remove-args
+ ;; get rid of formal args already provided
+ (remove-actual-args decoded-arglist arguments))
+ (t
+ ;; replace some formal args by determining actual args
+ (remove-actual-args decoded-arglist determining-args)
+ (setf (arglist.provided-args decoded-arglist)
+ determining-args)))
+ (return-from arglist-dispatch
+ (values decoded-arglist any-enrichment))))))
+ :not-available)
+
+(defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'defmethod))
+ arguments &key (remove-args t))
+ (when (and (listp arguments)
+ (not (null arguments)) ;have generic function name
+ (notany #'listp (rest arguments))) ;don't have arglist yet
+ (let* ((gf-name (first arguments))
+ (gf (and (or (symbolp gf-name)
+ (and (listp gf-name)
+ (eql (first gf-name) 'setf)))
+ (fboundp gf-name)
+ (fdefinition gf-name))))
+ (when (typep gf 'generic-function)
+ (with-availability (arglist) (arglist gf)
+ (return-from arglist-dispatch
+ (values (make-arglist :provided-args (if remove-args
+ nil
+ (list gf-name))
+ :required-args (list arglist)
+ :rest "body" :body-p t)
+ t))))))
+ (call-next-method))
+
+(defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'eval-when))
+ arguments &key (remove-args t))
+ (let ((eval-when-args '(:compile-toplevel :load-toplevel :execute)))
+ (make-arglist :required-args (list (maybecall remove-args #'remove-actual-args
+ (make-arglist :any-args eval-when-args)
+ arguments))
+ :rest '#:body :body-p t)))
+
+(defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'declare))
+ arguments &key (remove-args t))
+ ;; Catching 'DECLARE before SWANK-BACKEND:ARGLIST can barf.
+ (declare (ignore remove-args))
+ (make-arglist :rest '#:decl-specifiers))
+
+(defmethod arglist-dispatch ((operator-type (eql :declaration))
+ decl-identifier decl-args &key (remove-args t))
+ (with-availability (arglist)
+ (declaration-arglist decl-identifier)
+ (maybecall remove-args #'remove-actual-args
+ (decode-arglist arglist) decl-args))
+ ;; We don't fall back to CALL-NEXT-METHOD because we're within a
+ ;; different namespace!
+ )
+
+(defmethod arglist-dispatch ((operator-type (eql :type-specifier))
+ type-specifier specifier-args &key (remove-args t))
+ (with-availability (arglist)
+ (type-specifier-arglist type-specifier)
+ (maybecall remove-args #'remove-actual-args
+ (decode-arglist arglist) specifier-args))
+ ;; No CALL-NEXT-METHOD, see above.
+ )
+
+
+(defun read-incomplete-form-from-string (form-string)
+ (with-buffer-syntax ()
+ (call-with-ignored-reader-errors
+ #'(lambda ()
+ (read-from-string form-string)))))
+
+(defun call-with-ignored-reader-errors (thunk)
+ (declare (type (function () (values &rest t)) thunk))
+ (declare (optimize (speed 3) (safety 1)))
+ (handler-case (funcall thunk)
+ (reader-error (c)
+ (declare (ignore c))
+ nil)
+ (stream-error (c)
+ (declare (ignore c))
+ nil)))
+
+(defslimefun complete-form (form-string)
+ "Read FORM-STRING in the current buffer package, then complete it
+by adding a template for the missing arguments."
+ (multiple-value-bind (form newly-interned-symbols)
+ (parse-form-spec form-string)
+ (unwind-protect
+ (when (consp form)
+ (let ((form-completion (arglist-from-form-spec form)))
+ (unless (eql form-completion :not-available)
+ (return-from complete-form
+ (decoded-arglist-to-template-string form-completion
+ *buffer-package*
+ :prefix "")))))
+ (mapc #'unintern-in-home-package newly-interned-symbols))
+ :not-available))
+
+
+(defun arglist-ref (decoded-arglist operator &rest indices)
+ (cond
+ ((null indices) decoded-arglist)
+ ((not (arglist-p decoded-arglist)) nil)
+ (t
+ (let ((index (first indices))
+ (args (append (and operator
+ (list operator))
+ (arglist.required-args decoded-arglist)
+ (arglist.optional-args decoded-arglist))))
+ (when (< index (length args))
+ (let ((arg (elt args index)))
+ (apply #'arglist-ref arg nil (rest indices))))))))
+
+(defslimefun completions-for-keyword (raw-specs keyword-string arg-index-specs)
+ (with-buffer-syntax ()
+ (multiple-value-bind (form-spec position newly-interned-symbols)
+ (parse-first-valid-form-spec raw-specs)
+ (unwind-protect
+ (when form-spec
+ (let ((arglist (arglist-from-form-spec form-spec :remove-args nil)))
+ (unless (eql arglist :not-available)
+ (let* ((operator (nth-value 1 (split-form-spec form-spec)))
+ (indices (reverse (rest (subseq arg-index-specs 0 (1+ position)))))
+ (arglist (apply #'arglist-ref arglist operator indices)))
+ (when (and arglist (arglist-p arglist))
+ ;; It would be possible to complete keywords only if we
+ ;; are in a keyword position, but it is not clear if we
+ ;; want that.
+ (let* ((keywords
+ (append (mapcar #'keyword-arg.keyword
+ (arglist.keyword-args arglist))
+ (remove-if-not #'keywordp (arglist.any-args arglist))))
+ (keyword-name
+ (tokenize-symbol keyword-string))
+ (matching-keywords
+ (find-matching-symbols-in-list keyword-name keywords
+ #'compound-prefix-match))
+ (converter (completion-output-symbol-converter keyword-string))
+ (strings
+ (mapcar converter
+ (mapcar #'symbol-name matching-keywords)))
+ (completion-set
+ (format-completion-set strings nil "")))
+ (list completion-set
+ (longest-compound-prefix completion-set))))))))
+ (mapc #'unintern-in-home-package newly-interned-symbols)))))
+
+
+(defun arglist-to-string (arglist package &key print-right-margin highlight)
+ (decoded-arglist-to-string (decode-arglist arglist)
+ :package package
+ :print-right-margin print-right-margin
+ :highlight highlight))
+
+(defun test-print-arglist ()
+ (flet ((test (list string)
+ (let* ((p (find-package :swank))
+ (actual (arglist-to-string list p)))
+ (unless (string= actual string)
+ (warn "Test failed: ~S => ~S~% Expected: ~S"
+ list actual string)))))
+ (test '(function cons) "(function cons)")
+ (test '(quote cons) "(quote cons)")
+ (test '(&key (function #'+)) "(&key (function #'+))")
+ (test '(&whole x y z) "(y z)")
+ (test '(x &aux y z) "(x)")
+ (test '(x &environment env y) "(x y)")
+ (test '(&key ((function f))) "(&key ((function f)))")
+ (test '(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)
+ "(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)")
+ (test '(declare (optimize &any (speed 1) (safety 1)))
+ "(declare (optimize &any (speed 1) (safety 1)))")
+ ))
+
+(test-print-arglist)
+
+(provide :swank-arglists)
Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-asdf.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-asdf.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-asdf.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,63 @@
+;;; swank-asdf.el -- ASDF support
+;;
+;; Authors: Daniel Barlow <dan(a)telent.net>
+;; Marco Baringer <mb(a)bese.it>
+;; Edi Weitz <edi(a)agharta.de>
+;; and others
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+(defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
+ "Compile and load SYSTEM using ASDF.
+Record compiler notes signalled as `compiler-condition's."
+ (swank-compiler
+ (lambda ()
+ (apply #'operate-on-system system-name operation keywords))))
+
+(defun operate-on-system (system-name operation-name &rest keyword-args)
+ "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
+The KEYWORD-ARGS are passed on to the operation.
+Example:
+\(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
+ (with-compilation-hooks ()
+ (let ((operation (find-symbol operation-name :asdf)))
+ (when (null operation)
+ (error "Couldn't find ASDF operation ~S" operation-name))
+ (apply #'asdf:operate operation system-name keyword-args))))
+
+(defun asdf-central-registry ()
+ asdf:*central-registry*)
+
+(defslimefun list-all-systems-in-central-registry ()
+ "Returns a list of all systems in ASDF's central registry."
+ (mapcar #'pathname-name
+ (delete-duplicates
+ (loop for dir in (asdf-central-registry)
+ for defaults = (eval dir)
+ when defaults
+ nconc (mapcar #'file-namestring
+ (directory
+ (make-pathname :defaults defaults
+ :version :newest
+ :type "asd"
+ :name :wild
+ :case :local))))
+ :test #'string=)))
+
+(defslimefun list-all-systems-known-to-asdf ()
+ "Returns a list of all systems ASDF knows already."
+ ;; ugh, yeah, it's unexported - but do we really expect this to
+ ;; change anytime soon?
+ (loop for name being the hash-keys of asdf::*defined-systems*
+ collect name))
+
+(defslimefun list-asdf-systems ()
+ "Returns the systems in ASDF's central registry and those which ASDF
+already knows."
+ (nunion (list-all-systems-known-to-asdf)
+ (list-all-systems-in-central-registry)
+ :test #'string=))
+
+(provide :swank-asdf)
Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-c-p-c.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-c-p-c.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-c-p-c.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,279 @@
+;;; swank-c-p-c.lisp -- ILISP style Compound Prefix Completion
+;;
+;; Author: Luke Gorrie <luke(a)synap.se>
+;; Edi Weitz <edi(a)agharta.de>
+;; Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;; Tobias C. Rittweiler <tcr(a)freebits.de>
+;; and others
+;;
+;; License: Public Domain
+;;
+
+
+(in-package :swank)
+
+(defslimefun completions (string default-package-name)
+ "Return a list of completions for a symbol designator STRING.
+
+The result is the list (COMPLETION-SET COMPLETED-PREFIX), where
+COMPLETION-SET is the list of all matching completions, and
+COMPLETED-PREFIX is the best (partial) completion of the input
+string.
+
+Simple compound matching is supported on a per-hyphen basis:
+
+ (completions \"m-v-\" \"COMMON-LISP\")
+ ==> ((\"multiple-value-bind\" \"multiple-value-call\"
+ \"multiple-value-list\" \"multiple-value-prog1\"
+ \"multiple-value-setq\" \"multiple-values-limit\")
+ \"multiple-value\")
+
+\(For more advanced compound matching, see FUZZY-COMPLETIONS.)
+
+If STRING is package qualified the result list will also be
+qualified. If string is non-qualified the result strings are
+also not qualified and are considered relative to
+DEFAULT-PACKAGE-NAME.
+
+The way symbols are matched depends on the symbol designator's
+format. The cases are as follows:
+ FOO - Symbols with matching prefix and accessible in the buffer package.
+ PKG:FOO - Symbols with matching prefix and external in package PKG.
+ PKG::FOO - Symbols with matching prefix and accessible in package PKG.
+"
+ (let ((completion-set (completion-set string default-package-name
+ #'compound-prefix-match)))
+ (when completion-set
+ (list completion-set (longest-compound-prefix completion-set)))))
+
+;;;;; Find completion set
+
+(defun completion-set (string default-package-name matchp)
+ "Return the set of completion-candidates as strings."
+ (multiple-value-bind (name package-name package internal-p)
+ (parse-completion-arguments string default-package-name)
+ (let* ((symbols (mapcar (completion-output-symbol-converter name)
+ (and package
+ (mapcar #'symbol-name
+ (find-matching-symbols name
+ package
+ (and (not internal-p)
+ package-name)
+ matchp)))))
+ (packs (mapcar (completion-output-package-converter name)
+ (and (not package-name)
+ (find-matching-packages name matchp)))))
+ (format-completion-set (nconc symbols packs) internal-p package-name))))
+
+(defun find-matching-symbols (string package external test)
+ "Return a list of symbols in PACKAGE matching STRING.
+TEST is called with two strings. If EXTERNAL is true, only external
+symbols are returned."
+ (let ((completions '())
+ (converter (completion-output-symbol-converter string)))
+ (flet ((symbol-matches-p (symbol)
+ (and (or (not external)
+ (symbol-external-p symbol package))
+ (funcall test string
+ (funcall converter (symbol-name symbol))))))
+ (do-symbols* (symbol package)
+ (when (symbol-matches-p symbol)
+ (push symbol completions))))
+ completions))
+
+(defun find-matching-symbols-in-list (string list test)
+ "Return a list of symbols in LIST matching STRING.
+TEST is called with two strings."
+ (let ((completions '())
+ (converter (completion-output-symbol-converter string)))
+ (flet ((symbol-matches-p (symbol)
+ (funcall test string
+ (funcall converter (symbol-name symbol)))))
+ (dolist (symbol list)
+ (when (symbol-matches-p symbol)
+ (push symbol completions))))
+ (remove-duplicates completions)))
+
+(defun find-matching-packages (name matcher)
+ "Return a list of package names matching NAME with MATCHER.
+MATCHER is a two-argument predicate."
+ (let ((to-match (string-upcase name)))
+ (remove-if-not (lambda (x) (funcall matcher to-match x))
+ (mapcar (lambda (pkgname)
+ (concatenate 'string pkgname ":"))
+ (loop for package in (list-all-packages)
+ collect (package-name package)
+ append (package-nicknames package))))))
+
+
+;; PARSE-COMPLETION-ARGUMENTS return table:
+;;
+;; user behaviour | NAME | PACKAGE-NAME | PACKAGE
+;; ----------------+--------+--------------+-----------------------------------
+;; asdf [tab] | "asdf" | NIL | #<PACKAGE "DEFAULT-PACKAGE-NAME">
+;; | | | or *BUFFER-PACKAGE*
+;; asdf: [tab] | "" | "asdf" | #<PACKAGE "ASDF">
+;; | | |
+;; asdf:foo [tab] | "foo" | "asdf" | #<PACKAGE "ASDF">
+;; | | |
+;; as:fo [tab] | "fo" | "as" | NIL
+;; | | |
+;; : [tab] | "" | "" | #<PACKAGE "KEYWORD">
+;; | | |
+;; :foo [tab] | "foo" | "" | #<PACKAGE "KEYWORD">
+;;
+(defun parse-completion-arguments (string default-package-name)
+ "Parse STRING as a symbol designator.
+Return these values:
+ SYMBOL-NAME
+ PACKAGE-NAME, or nil if the designator does not include an explicit package.
+ PACKAGE, generally the package to complete in. (However, if PACKAGE-NAME is
+ NIL, return the respective package of DEFAULT-PACKAGE-NAME instead;
+ if PACKAGE is non-NIL but a package cannot be found under that name,
+ return NIL.)
+ INTERNAL-P, if the symbol is qualified with `::'."
+ (multiple-value-bind (name package-name internal-p)
+ (tokenize-symbol string)
+ (if package-name
+ (let ((package (guess-package (if (equal package-name "")
+ "KEYWORD"
+ package-name))))
+ (values name package-name package internal-p))
+ (let ((package (guess-package default-package-name)))
+ (values name package-name (or package *buffer-package*) internal-p))
+ )))
+
+
+
+(defun completion-output-case-converter (input &optional with-escaping-p)
+ "Return a function to convert strings for the completion output.
+INPUT is used to guess the preferred case."
+ (ecase (readtable-case *readtable*)
+ (:upcase (cond ((or with-escaping-p
+ (not (some #'lower-case-p input)))
+ #'identity)
+ (t #'string-downcase)))
+ (:invert (lambda (output)
+ (multiple-value-bind (lower upper) (determine-case output)
+ (cond ((and lower upper) output)
+ (lower (string-upcase output))
+ (upper (string-downcase output))
+ (t output)))))
+ (:downcase (cond ((or with-escaping-p
+ (not (some #'upper-case-p input)))
+ #'identity)
+ (t #'string-upcase)))
+ (:preserve #'identity)))
+
+(defun completion-output-package-converter (input)
+ "Return a function to convert strings for the completion output.
+INPUT is used to guess the preferred case."
+ (completion-output-case-converter input))
+
+(defun completion-output-symbol-converter (input)
+ "Return a function to convert strings for the completion output.
+INPUT is used to guess the preferred case. Escape symbols when needed."
+ (let ((case-converter (completion-output-case-converter input))
+ (case-converter-with-escaping (completion-output-case-converter input t)))
+ (lambda (str)
+ (if (or (multiple-value-bind (lowercase uppercase)
+ (determine-case str)
+ ;; In these readtable cases, symbols with letters from
+ ;; the wrong case need escaping
+ (case (readtable-case *readtable*)
+ (:upcase lowercase)
+ (:downcase uppercase)
+ (t nil)))
+ (some (lambda (el)
+ (or (member el '(#\: #\Space #\Newline #\Tab))
+ (multiple-value-bind (macrofun nonterminating)
+ (get-macro-character el)
+ (and macrofun
+ (not nonterminating)))))
+ str))
+ (concatenate 'string "|" (funcall case-converter-with-escaping str) "|")
+ (funcall case-converter str)))))
+
+
+(defun determine-case (string)
+ "Return two booleans LOWER and UPPER indicating whether STRING
+contains lower or upper case characters."
+ (values (some #'lower-case-p string)
+ (some #'upper-case-p string)))
+
+
+;;;;; Compound-prefix matching
+
+(defun make-compound-prefix-matcher (delimeter &key (test #'char=))
+ "Returns a matching function that takes a `prefix' and a
+`target' string and which returns T if `prefix' is a
+compound-prefix of `target', and otherwise NIL.
+
+Viewing each of `prefix' and `target' as a series of substrings
+delimited by DELIMETER, if each substring of `prefix' is a prefix
+of the corresponding substring in `target' then we call `prefix'
+a compound-prefix of `target'."
+ (lambda (prefix target)
+ (declare (type simple-string prefix target))
+ (loop for ch across prefix
+ with tpos = 0
+ always (and (< tpos (length target))
+ (if (char= ch delimeter)
+ (setf tpos (position #\- target :start tpos))
+ (funcall test ch (aref target tpos))))
+ do (incf tpos))))
+
+(defun compound-prefix-match (prefix target)
+ "Examples:
+\(compound-prefix-match \"foo\" \"foobar\") => t
+\(compound-prefix-match \"m--b\" \"multiple-value-bind\") => t
+\(compound-prefix-match \"m-v-c\" \"multiple-value-bind\") => NIL
+"
+ (funcall (make-compound-prefix-matcher #\-) prefix target))
+
+
+;;;;; Extending the input string by completion
+
+(defun longest-compound-prefix (completions &optional (delimeter #\-))
+ "Return the longest compound _prefix_ for all COMPLETIONS."
+ (flet ((tokenizer (string) (tokenize-completion string delimeter)))
+ (untokenize-completion
+ (loop for token-list in (transpose-lists (mapcar #'tokenizer completions))
+ if (notevery #'string= token-list (rest token-list))
+ collect (longest-common-prefix token-list) ; Note that we possibly collect
+ and do (loop-finish) ; the "" here as well, so that
+ else collect (first token-list))))) ; UNTOKENIZE-COMPLETION will
+ ; append a hyphen for us.
+(defun tokenize-completion (string delimeter)
+ "Return all substrings of STRING delimited by DELIMETER."
+ (loop with end
+ for start = 0 then (1+ end)
+ until (> start (length string))
+ do (setq end (or (position delimeter string :start start) (length string)))
+ collect (subseq string start end)))
+
+(defun untokenize-completion (tokens)
+ (format nil "~{~A~^-~}" tokens))
+
+(defun transpose-lists (lists)
+ "Turn a list-of-lists on its side.
+If the rows are of unequal length, truncate uniformly to the shortest.
+
+For example:
+\(transpose-lists '((ONE TWO THREE) (1 2)))
+ => ((ONE 1) (TWO 2))"
+ (cond ((null lists) '())
+ ((some #'null lists) '())
+ (t (cons (mapcar #'car lists)
+ (transpose-lists (mapcar #'cdr lists))))))
+
+
+;;;; Completion for character names
+
+(defslimefun completions-for-character (prefix)
+ (let* ((matcher (make-compound-prefix-matcher #\_ :test #'char-equal))
+ (completion-set (character-completion-set prefix matcher))
+ (completions (sort completion-set #'string<)))
+ (list completions (longest-compound-prefix completions #\_))))
+
+(provide :swank-c-p-c)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,737 @@
+;;; swank-fancy-inspector.lisp --- Fancy inspector for CLOS objects
+;;
+;; Author: Marco Baringer <mb(a)bese.it> and others
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+;; Subclass `backend-inspector' so that backend specific methods are
+;; also considered.
+(defclass fancy-inspector (backend-inspector) ())
+
+(defmethod inspect-for-emacs ((symbol symbol) (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (let ((package (symbol-package symbol)))
+ (multiple-value-bind (_symbol status)
+ (and package (find-symbol (string symbol) package))
+ (declare (ignore _symbol))
+ (values
+ "A symbol."
+ (append
+ (label-value-line "Its name is" (symbol-name symbol))
+ ;;
+ ;; Value
+ (cond ((boundp symbol)
+ (label-value-line (if (constantp symbol)
+ "It is a constant of value"
+ "It is a global variable bound to")
+ (symbol-value symbol)))
+ (t '("It is unbound." (:newline))))
+ (docstring-ispec "Documentation" symbol 'variable)
+ (multiple-value-bind (expansion definedp) (macroexpand symbol)
+ (if definedp
+ (label-value-line "It is a symbol macro with expansion"
+ expansion)))
+ ;;
+ ;; Function
+ (if (fboundp symbol)
+ (append (if (macro-function symbol)
+ `("It a macro with macro-function: "
+ (:value ,(macro-function symbol)))
+ `("It is a function: "
+ (:value ,(symbol-function symbol))))
+ `(" " (:action "[make funbound]"
+ ,(lambda () (fmakunbound symbol))))
+ `((:newline)))
+ `("It has no function value." (:newline)))
+ (docstring-ispec "Function Documentation" symbol 'function)
+ (if (compiler-macro-function symbol)
+ (label-value-line "It also names the compiler macro"
+ (compiler-macro-function symbol)))
+ (docstring-ispec "Compiler Macro Documentation"
+ symbol 'compiler-macro)
+ ;;
+ ;; Package
+ (if package
+ `("It is " ,(string-downcase (string status))
+ " to the package: "
+ (:value ,package ,(package-name package))
+ ,@(if (eq :internal status)
+ `(" "
+ (:action "[export it]"
+ ,(lambda () (export symbol package)))))
+ " "
+ (:action "[unintern it]"
+ ,(lambda () (unintern symbol package)))
+ (:newline))
+ '("It is a non-interned symbol." (:newline)))
+ ;;
+ ;; Plist
+ (label-value-line "Property list" (symbol-plist symbol))
+ ;;
+ ;; Class
+ (if (find-class symbol nil)
+ `("It names the class "
+ (:value ,(find-class symbol) ,(string symbol))
+ " "
+ (:action "[remove]"
+ ,(lambda () (setf (find-class symbol) nil)))
+ (:newline)))
+ ;;
+ ;; More package
+ (if (find-package symbol)
+ (label-value-line "It names the package" (find-package symbol)))
+ )))))
+
+(defun docstring-ispec (label object kind)
+ "Return a inspector spec if OBJECT has a docstring of of kind KIND."
+ (let ((docstring (documentation object kind)))
+ (cond ((not docstring) nil)
+ ((< (+ (length label) (length docstring))
+ 75)
+ (list label ": " docstring '(:newline)))
+ (t
+ (list label ": " '(:newline) " " docstring '(:newline))))))
+
+(defmethod inspect-for-emacs ((f function) (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (values "A function."
+ (append
+ (label-value-line "Name" (function-name f))
+ `("Its argument list is: "
+ ,(inspector-princ (arglist f)) (:newline))
+ (docstring-ispec "Documentation" f t)
+ (if (function-lambda-expression f)
+ (label-value-line "Lambda Expression"
+ (function-lambda-expression f))))))
+
+(defun method-specializers-for-inspect (method)
+ "Return a \"pretty\" list of the method's specializers. Normal
+ specializers are replaced by the name of the class, eql
+ specializers are replaced by `(eql ,object)."
+ (mapcar (lambda (spec)
+ (typecase spec
+ (swank-mop:eql-specializer
+ `(eql ,(swank-mop:eql-specializer-object spec)))
+ (t (swank-mop:class-name spec))))
+ (swank-mop:method-specializers method)))
+
+(defun method-for-inspect-value (method)
+ "Returns a \"pretty\" list describing METHOD. The first element
+ of the list is the name of generic-function method is
+ specialiazed on, the second element is the method qualifiers,
+ the rest of the list is the method's specialiazers (as per
+ method-specializers-for-inspect)."
+ (append (list (swank-mop:generic-function-name
+ (swank-mop:method-generic-function method)))
+ (swank-mop:method-qualifiers method)
+ (method-specializers-for-inspect method)))
+
+(defmethod inspect-for-emacs ((object standard-object)
+ (inspector fancy-inspector))
+ (let ((class (class-of object)))
+ (values "An object."
+ `("Class: " (:value ,class) (:newline)
+ ,@(all-slots-for-inspector object inspector)))))
+
+(defvar *gf-method-getter* 'methods-by-applicability
+ "This function is called to get the methods of a generic function.
+The default returns the method sorted by applicability.
+See `methods-by-applicability'.")
+
+(defun specializer< (specializer1 specializer2)
+ "Return true if SPECIALIZER1 is more specific than SPECIALIZER2."
+ (let ((s1 specializer1) (s2 specializer2) )
+ (cond ((typep s1 'swank-mop:eql-specializer)
+ (not (typep s2 'swank-mop:eql-specializer)))
+ (t
+ (flet ((cpl (class)
+ (and (swank-mop:class-finalized-p class)
+ (swank-mop:class-precedence-list class))))
+ (member s2 (cpl s1)))))))
+
+(defun methods-by-applicability (gf)
+ "Return methods ordered by most specific argument types.
+
+`method-specializer<' is used for sorting."
+ ;; FIXME: argument-precedence-order and qualifiers are ignored.
+ (labels ((method< (meth1 meth2)
+ (loop for s1 in (swank-mop:method-specializers meth1)
+ for s2 in (swank-mop:method-specializers meth2)
+ do (cond ((specializer< s2 s1) (return nil))
+ ((specializer< s1 s2) (return t))))))
+ (stable-sort (copy-seq (swank-mop:generic-function-methods gf)) #'method<)))
+
+(defun abbrev-doc (doc &optional (maxlen 80))
+ "Return the first sentence of DOC, but not more than MAXLAN characters."
+ (subseq doc 0 (min (1+ (or (position #\. doc) (1- maxlen)))
+ maxlen
+ (length doc))))
+
+(defgeneric inspect-slot-for-emacs (class object slot)
+ (:method (class object slot)
+ (let ((slot-name (swank-mop:slot-definition-name slot))
+ (boundp (swank-mop:slot-boundp-using-class class object slot)))
+ `(,@(if boundp
+ `((:value ,(swank-mop:slot-value-using-class class object slot)))
+ `("#<unbound>"))
+ " "
+ (:action "[set value]"
+ ,(lambda () (with-simple-restart
+ (abort "Abort setting slot ~S" slot-name)
+ (let ((value-string (eval-in-emacs
+ `(condition-case c
+ (slime-read-object
+ ,(format nil "Set slot ~S to (evaluated) : " slot-name))
+ (quit nil)))))
+ (when (and value-string
+ (not (string= value-string "")))
+ (setf (swank-mop:slot-value-using-class class object slot)
+ (eval (read-from-string value-string))))))))
+ ,@(when boundp
+ `(" " (:action "[make unbound]"
+ ,(lambda () (swank-mop:slot-makunbound-using-class class object slot)))))))))
+
+(defgeneric all-slots-for-inspector (object inspector)
+ (:method ((object standard-object) inspector)
+ (declare (ignore inspector))
+ (append '("--------------------" (:newline)
+ "All Slots:" (:newline))
+ (let* ((class (class-of object))
+ (direct-slots (swank-mop:class-direct-slots class))
+ (effective-slots (sort (copy-seq (swank-mop:class-slots class))
+ #'string< :key #'swank-mop:slot-definition-name))
+ (slot-presentations (loop for effective-slot :in effective-slots
+ collect (inspect-slot-for-emacs
+ class object effective-slot)))
+ (longest-slot-name-length
+ (loop for slot :in effective-slots
+ maximize (length (symbol-name
+ (swank-mop:slot-definition-name slot))))))
+ (loop
+ for effective-slot :in effective-slots
+ for slot-presentation :in slot-presentations
+ for direct-slot = (find (swank-mop:slot-definition-name effective-slot)
+ direct-slots :key #'swank-mop:slot-definition-name)
+ for slot-name = (inspector-princ
+ (swank-mop:slot-definition-name effective-slot))
+ for padding-length = (- longest-slot-name-length
+ (length (symbol-name
+ (swank-mop:slot-definition-name
+ effective-slot))))
+ collect `(:value ,(if direct-slot
+ (list direct-slot effective-slot)
+ effective-slot)
+ ,slot-name)
+ collect (make-array padding-length
+ :element-type 'character
+ :initial-element #\Space)
+ collect " = "
+ append slot-presentation
+ collect '(:newline))))))
+
+(defmethod inspect-for-emacs ((gf standard-generic-function)
+ (inspector fancy-inspector))
+ (flet ((lv (label value) (label-value-line label value)))
+ (values
+ "A generic function."
+ (append
+ (lv "Name" (swank-mop:generic-function-name gf))
+ (lv "Arguments" (swank-mop:generic-function-lambda-list gf))
+ (docstring-ispec "Documentation" gf t)
+ (lv "Method class" (swank-mop:generic-function-method-class gf))
+ (lv "Method combination"
+ (swank-mop:generic-function-method-combination gf))
+ `("Methods: " (:newline))
+ (loop for method in (funcall *gf-method-getter* gf) append
+ `((:value ,method ,(inspector-princ
+ ;; drop the name of the GF
+ (cdr (method-for-inspect-value method))))
+ " "
+ (:action "[remove method]"
+ ,(let ((m method)) ; LOOP reassigns method
+ (lambda ()
+ (remove-method gf m))))
+ (:newline)))
+ `((:newline))
+ (all-slots-for-inspector gf inspector)))))
+
+(defmethod inspect-for-emacs ((method standard-method)
+ (inspector fancy-inspector))
+ (values "A method."
+ `("Method defined on the generic function "
+ (:value ,(swank-mop:method-generic-function method)
+ ,(inspector-princ
+ (swank-mop:generic-function-name
+ (swank-mop:method-generic-function method))))
+ (:newline)
+ ,@(docstring-ispec "Documentation" method t)
+ "Lambda List: " (:value ,(swank-mop:method-lambda-list method))
+ (:newline)
+ "Specializers: " (:value ,(swank-mop:method-specializers method)
+ ,(inspector-princ (method-specializers-for-inspect method)))
+ (:newline)
+ "Qualifiers: " (:value ,(swank-mop:method-qualifiers method))
+ (:newline)
+ "Method function: " (:value ,(swank-mop:method-function method))
+ (:newline)
+ ,@(all-slots-for-inspector method inspector))))
+
+(defmethod inspect-for-emacs ((class standard-class)
+ (inspector fancy-inspector))
+ (values "A class."
+ `("Name: " (:value ,(class-name class))
+ (:newline)
+ "Super classes: "
+ ,@(common-seperated-spec (swank-mop:class-direct-superclasses class))
+ (:newline)
+ "Direct Slots: "
+ ,@(common-seperated-spec
+ (swank-mop:class-direct-slots class)
+ (lambda (slot)
+ `(:value ,slot ,(inspector-princ (swank-mop:slot-definition-name slot)))))
+ (:newline)
+ "Effective Slots: "
+ ,@(if (swank-mop:class-finalized-p class)
+ (common-seperated-spec
+ (swank-mop:class-slots class)
+ (lambda (slot)
+ `(:value ,slot ,(inspector-princ
+ (swank-mop:slot-definition-name slot)))))
+ '("#<N/A (class not finalized)>"))
+ (:newline)
+ ,@(let ((doc (documentation class t)))
+ (when doc
+ `("Documentation:" (:newline) ,(inspector-princ doc) (:newline))))
+ "Sub classes: "
+ ,@(common-seperated-spec (swank-mop:class-direct-subclasses class)
+ (lambda (sub)
+ `(:value ,sub ,(inspector-princ (class-name sub)))))
+ (:newline)
+ "Precedence List: "
+ ,@(if (swank-mop:class-finalized-p class)
+ (common-seperated-spec (swank-mop:class-precedence-list class)
+ (lambda (class)
+ `(:value ,class ,(inspector-princ (class-name class)))))
+ '("#<N/A (class not finalized)>"))
+ (:newline)
+ ,@(when (swank-mop:specializer-direct-methods class)
+ `("It is used as a direct specializer in the following methods:" (:newline)
+ ,@(loop
+ for method in (sort (copy-seq (swank-mop:specializer-direct-methods class))
+ #'string< :key (lambda (x)
+ (symbol-name
+ (let ((name (swank-mop::generic-function-name
+ (swank-mop::method-generic-function x))))
+ (if (symbolp name) name (second name))))))
+ collect " "
+ collect `(:value ,method ,(inspector-princ (method-for-inspect-value method)))
+ collect '(:newline)
+ if (documentation method t)
+ collect " Documentation: " and
+ collect (abbrev-doc (documentation method t)) and
+ collect '(:newline))))
+ "Prototype: " ,(if (swank-mop:class-finalized-p class)
+ `(:value ,(swank-mop:class-prototype class))
+ '"#<N/A (class not finalized)>")
+ (:newline)
+ ,@(all-slots-for-inspector class inspector))))
+
+(defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition)
+ (inspector fancy-inspector))
+ (values "A slot."
+ `("Name: " (:value ,(swank-mop:slot-definition-name slot))
+ (:newline)
+ ,@(when (swank-mop:slot-definition-documentation slot)
+ `("Documentation:" (:newline)
+ (:value ,(swank-mop:slot-definition-documentation slot))
+ (:newline)))
+ "Init args: " (:value ,(swank-mop:slot-definition-initargs slot)) (:newline)
+ "Init form: " ,(if (swank-mop:slot-definition-initfunction slot)
+ `(:value ,(swank-mop:slot-definition-initform slot))
+ "#<unspecified>") (:newline)
+ "Init function: " (:value ,(swank-mop:slot-definition-initfunction slot))
+ (:newline)
+ ,@(all-slots-for-inspector slot inspector))))
+
+
+;; Wrapper structure over the list of symbols of a package that should
+;; be displayed with their respective classification flags. This is
+;; because we need a unique type to dispatch on in INSPECT-FOR-EMACS.
+;; Used by the Inspector for packages.
+(defstruct (%package-symbols-container (:conc-name %container.)
+ (:constructor %%make-package-symbols-container))
+ title ;; A string; the title of the inspector page in Emacs.
+ description ;; A list of renderable objects; used as description.
+ symbols ;; A list of symbols. Supposed to be sorted alphabetically.
+ grouping-kind ;; Either :SYMBOL or :CLASSIFICATION. Cf. MAKE-SYMBOLS-LISTING.
+ )
+
+(defun %make-package-symbols-container (&key title description symbols)
+ (%%make-package-symbols-container :title title :description description
+ :symbols symbols :grouping-kind :symbol))
+
+(defgeneric make-symbols-listing (grouping-kind symbols))
+
+(defmethod make-symbols-listing ((grouping-kind (eql :symbol)) symbols)
+ "Returns an object renderable by Emacs' inspector side that
+alphabetically lists all the symbols in SYMBOLS together with a
+concise string representation of what each symbol
+represents (cf. CLASSIFY-SYMBOL & Fuzzy Completion.)"
+ (let ((max-length (loop for s in symbols maximizing (length (symbol-name s))))
+ (distance 10)) ; empty distance between name and classification
+ (flet ((string-representations (symbol)
+ (let* ((name (symbol-name symbol))
+ (length (length name))
+ (padding (- max-length length))
+ (classification (classify-symbol symbol)))
+ (values
+ (concatenate 'string
+ name
+ (make-string (+ padding distance) :initial-element #\Space))
+ (symbol-classification->string classification)))))
+ `("" ; 8 is (length "Symbols:")
+ "Symbols:" ,(make-string (+ -8 max-length distance) :initial-element #\Space) "Flags:"
+ (:newline)
+ ,(concatenate 'string ; underlining dashes
+ (make-string (+ max-length distance -1) :initial-element #\-)
+ " "
+ (let* ((dummy (classify-symbol (gensym)))
+ (dummy (symbol-classification->string dummy))
+ (classification-length (length dummy)))
+ (make-string classification-length :initial-element #\-)))
+ (:newline)
+ ,@(loop for symbol in symbols appending
+ (multiple-value-bind (symbol-string classification-string)
+ (string-representations symbol)
+ `((:value ,symbol ,symbol-string) ,classification-string
+ (:newline)
+ )))))))
+
+(defmethod make-symbols-listing ((grouping-kind (eql :classification)) symbols)
+ "For each possible classification (cf. CLASSIFY-SYMBOL), group
+all the symbols in SYMBOLS to all of their respective
+classifications. (If a symbol is, for instance, boundp and a
+generic-function, it'll appear both below the BOUNDP group and
+the GENERIC-FUNCTION group.) As macros and special-operators are
+specified to be FBOUNDP, there is no general FBOUNDP group,
+instead there are the three explicit FUNCTION, MACRO and
+SPECIAL-OPERATOR groups."
+ (let ((table (make-hash-table :test #'eq)))
+ (flet ((maybe-convert-fboundps (classifications)
+ ;; Convert an :FBOUNDP in CLASSIFICATIONS to :FUNCTION if possible.
+ (if (and (member :fboundp classifications)
+ (not (member :macro classifications))
+ (not (member :special-operator classifications)))
+ (substitute :function :fboundp classifications)
+ (remove :fboundp classifications))))
+ (loop for symbol in symbols do
+ (loop for classification in (maybe-convert-fboundps (classify-symbol symbol))
+ ;; SYMBOLS are supposed to be sorted alphabetically;
+ ;; this property is preserved here except for reversing.
+ do (push symbol (gethash classification table)))))
+ (let* ((classifications (loop for k being each hash-key in table collect k))
+ (classifications (sort classifications #'string<)))
+ (loop for classification in classifications
+ for symbols = (gethash classification table)
+ appending`(,(symbol-name classification)
+ (:newline)
+ ,(make-string 64 :initial-element #\-)
+ (:newline)
+ ,@(mapcan #'(lambda (symbol)
+ (list `(:value ,symbol ,(symbol-name symbol)) '(:newline)))
+ (nreverse symbols)) ; restore alphabetic orderness.
+ (:newline)
+ )))))
+
+(defmethod inspect-for-emacs ((%container %package-symbols-container)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (with-struct (%container. title description symbols grouping-kind) %container
+ (values title
+ `(,@description
+ (:newline)
+ " " ,(ecase grouping-kind
+ (:symbol
+ `(:action "[Group by classification]"
+ ,(lambda () (setf grouping-kind :classification))
+ :refreshp t))
+ (:classification
+ `(:action "[Group by symbol]"
+ ,(lambda () (setf grouping-kind :symbol))
+ :refreshp t)))
+ (:newline) (:newline)
+ ,@(make-symbols-listing grouping-kind symbols)))))
+
+
+(defmethod inspect-for-emacs ((package package)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (let ((package-name (package-name package))
+ (package-nicknames (package-nicknames package))
+ (package-use-list (package-use-list package))
+ (package-used-by-list (package-used-by-list package))
+ (shadowed-symbols (package-shadowing-symbols package))
+ (present-symbols '()) (present-symbols-length 0)
+ (internal-symbols '()) (internal-symbols-length 0)
+ (external-symbols '()) (external-symbols-length 0))
+
+ (do-symbols* (sym package)
+ (let ((status (symbol-status sym package)))
+ (when (not (eq status :inherited))
+ (push sym present-symbols) (incf present-symbols-length)
+ (if (eq status :internal)
+ (progn (push sym internal-symbols) (incf internal-symbols-length))
+ (progn (push sym external-symbols) (incf external-symbols-length))))))
+
+ (setf package-nicknames (sort (copy-list package-nicknames) #'string<)
+ package-use-list (sort (copy-list package-use-list) #'string< :key #'package-name)
+ package-used-by-list (sort (copy-list package-used-by-list) #'string< :key #'package-name)
+ shadowed-symbols (sort (copy-list shadowed-symbols) #'string<))
+
+ (setf present-symbols (sort present-symbols #'string<) ; SORT + STRING-LESSP
+ internal-symbols (sort internal-symbols #'string<) ; conses on at least
+ external-symbols (sort external-symbols #'string<)) ; SBCL 0.9.18.
+
+
+ (values
+ "A package."
+ `("" ; dummy to preserve indentation.
+ "Name: " (:value ,package-name) (:newline)
+
+ "Nick names: " ,@(common-seperated-spec package-nicknames) (:newline)
+
+ ,@(when (documentation package t)
+ `("Documentation:" (:newline) ,(documentation package t) (:newline)))
+
+ "Use list: " ,@(common-seperated-spec
+ package-use-list
+ (lambda (package)
+ `(:value ,package ,(package-name package))))
+ (:newline)
+
+ "Used by list: " ,@(common-seperated-spec
+ package-used-by-list
+ (lambda (package)
+ `(:value ,package ,(package-name package))))
+ (:newline)
+
+ ,@ ; ,@(flet ((...)) ...) would break indentation in Emacs.
+ (flet ((display-link (type symbols length &key title description)
+ (if (null symbols)
+ (format nil "0 ~A symbols." type)
+ `(:value ,(%make-package-symbols-container :title title
+ :description description
+ :symbols symbols)
+ ,(format nil "~D ~A symbol~P." length type length)))))
+
+ `(,(display-link "present" present-symbols present-symbols-length
+ :title (format nil "All present symbols of package \"~A\"" package-name)
+ :description
+ '("A symbol is considered present in a package if it's" (:newline)
+ "\"accessible in that package directly, rather than" (:newline)
+ "being inherited from another package.\"" (:newline)
+ "(CLHS glossary entry for `present')" (:newline)))
+
+ (:newline)
+ ,(display-link "external" external-symbols external-symbols-length
+ :title (format nil "All external symbols of package \"~A\"" package-name)
+ :description
+ '("A symbol is considered external of a package if it's" (:newline)
+ "\"part of the `external interface' to the package and" (:newline)
+ "[is] inherited by any other package that uses the" (:newline)
+ "package.\" (CLHS glossary entry of `external')" (:newline)))
+ (:newline)
+ ,(display-link "internal" internal-symbols internal-symbols-length
+ :title (format nil "All internal symbols of package \"~A\"" package-name)
+ :description
+ '("A symbol is considered internal of a package if it's" (:newline)
+ "present and not external---that is if the package is" (:newline)
+ "the home package of the symbol, or if the symbol has" (:newline)
+ "been explicitly imported into the package." (:newline)
+ (:newline)
+ "Notice that inherited symbols will thus not be listed," (:newline)
+ "which deliberately deviates from the CLHS glossary" (:newline)
+ "entry of `internal' because it's assumed to be more" (:newline)
+ "useful this way." (:newline)))
+ (:newline)
+ ,(display-link "shadowed" shadowed-symbols (length shadowed-symbols)
+ :title (format nil "All shadowed symbols of package \"~A\"" package-name)
+ :description nil)))))))
+
+
+(defmethod inspect-for-emacs ((pathname pathname)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (values (if (wild-pathname-p pathname)
+ "A wild pathname."
+ "A pathname.")
+ (append (label-value-line*
+ ("Namestring" (namestring pathname))
+ ("Host" (pathname-host pathname))
+ ("Device" (pathname-device pathname))
+ ("Directory" (pathname-directory pathname))
+ ("Name" (pathname-name pathname))
+ ("Type" (pathname-type pathname))
+ ("Version" (pathname-version pathname)))
+ (unless (or (wild-pathname-p pathname)
+ (not (probe-file pathname)))
+ (label-value-line "Truename" (truename pathname))))))
+
+(defmethod inspect-for-emacs ((pathname logical-pathname)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (values "A logical pathname."
+ (append
+ (label-value-line*
+ ("Namestring" (namestring pathname))
+ ("Physical pathname: " (translate-logical-pathname pathname)))
+ `("Host: "
+ ,(pathname-host pathname)
+ " (" (:value ,(logical-pathname-translations
+ (pathname-host pathname)))
+ "other translations)"
+ (:newline))
+ (label-value-line*
+ ("Directory" (pathname-directory pathname))
+ ("Name" (pathname-name pathname))
+ ("Type" (pathname-type pathname))
+ ("Version" (pathname-version pathname))
+ ("Truename" (if (not (wild-pathname-p pathname))
+ (probe-file pathname)))))))
+
+(defmethod inspect-for-emacs ((n number)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (values "A number." `("Value: " ,(princ-to-string n))))
+
+(defun format-iso8601-time (time-value &optional include-timezone-p)
+ "Formats a universal time TIME-VALUE in ISO 8601 format, with
+ the time zone included if INCLUDE-TIMEZONE-P is non-NIL"
+ ;; Taken from http://www.pvv.ntnu.no/~nsaa/ISO8601.html
+ ;; Thanks, Nikolai Sandved and Thomas Russ!
+ (flet ((format-iso8601-timezone (zone)
+ (if (zerop zone)
+ "Z"
+ (multiple-value-bind (h m) (truncate (abs zone) 1.0)
+ ;; Tricky. Sign of time zone is reversed in ISO 8601
+ ;; relative to Common Lisp convention!
+ (format nil "~:[+~;-~]~2,'0D:~2,'0D"
+ (> zone 0) h (round (* 60 m)))))))
+ (multiple-value-bind (second minute hour day month year dow dst zone)
+ (decode-universal-time time-value)
+ (declare (ignore dow dst))
+ (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D~:[~*~;~A~]"
+ year month day hour minute second
+ include-timezone-p (format-iso8601-timezone zone)))))
+
+(defmethod inspect-for-emacs ((i integer)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (values "A number."
+ (append
+ `(,(format nil "Value: ~D = #x~8,'0X = #o~O = #b~,,' ,8:B~@[ = ~E~]"
+ i i i i (ignore-errors (coerce i 'float)))
+ (:newline))
+ (when (< -1 i char-code-limit)
+ (label-value-line "Code-char" (code-char i)))
+ (label-value-line "Integer-length" (integer-length i))
+ (ignore-errors
+ (label-value-line "Universal-time" (format-iso8601-time i t))))))
+
+(defmethod inspect-for-emacs ((c complex)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (values "A complex number."
+ (label-value-line*
+ ("Real part" (realpart c))
+ ("Imaginary part" (imagpart c)))))
+
+(defmethod inspect-for-emacs ((r ratio)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (values "A non-integer ratio."
+ (label-value-line*
+ ("Numerator" (numerator r))
+ ("Denominator" (denominator r))
+ ("As float" (float r)))))
+
+(defmethod inspect-for-emacs ((f float)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (values "A floating point number."
+ (cond
+ ((> f most-positive-long-float)
+ (list "Positive infinity."))
+ ((< f most-negative-long-float)
+ (list "Negative infinity."))
+ ((not (= f f))
+ (list "Not a Number."))
+ (t
+ (multiple-value-bind (significand exponent sign) (decode-float f)
+ (append
+ `("Scientific: " ,(format nil "~E" f) (:newline)
+ "Decoded: "
+ (:value ,sign) " * "
+ (:value ,significand) " * "
+ (:value ,(float-radix f)) "^" (:value ,exponent) (:newline))
+ (label-value-line "Digits" (float-digits f))
+ (label-value-line "Precision" (float-precision f))))))))
+
+(defmethod inspect-for-emacs ((stream file-stream)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (multiple-value-bind (title content)
+ (call-next-method)
+ (declare (ignore title))
+ (values "A file stream."
+ (append
+ `("Pathname: "
+ (:value ,(pathname stream))
+ (:newline) " "
+ (:action "[visit file and show current position]"
+ ,(let ((pathname (pathname stream))
+ (position (file-position stream)))
+ (lambda ()
+ (ed-in-emacs `(,pathname :charpos ,position))))
+ :refreshp nil)
+ (:newline))
+ content))))
+
+(defmethod inspect-for-emacs ((condition stream-error)
+ (inspector fancy-inspector))
+ (declare (ignore inspector))
+ (multiple-value-bind (title content)
+ (call-next-method)
+ (let ((stream (stream-error-stream condition)))
+ (if (typep stream 'file-stream)
+ (values "A stream error."
+ (append
+ `("Pathname: "
+ (:value ,(pathname stream))
+ (:newline) " "
+ (:action "[visit file and show current position]"
+ ,(let ((pathname (pathname stream))
+ (position (file-position stream)))
+ (lambda ()
+ (ed-in-emacs `(,pathname :charpos ,position))))
+ :refreshp nil)
+ (:newline))
+ content))
+ (values title content)))))
+
+(defvar *fancy-inpector-undo-list* nil)
+
+(defslimefun fancy-inspector-init ()
+ (let ((i *default-inspector*))
+ (push (lambda () (setq *default-inspector* i))
+ *fancy-inpector-undo-list*))
+ (setq *default-inspector* (make-instance 'fancy-inspector))
+ t)
+
+(defslimefun fancy-inspector-unload ()
+ (loop while *fancy-inpector-undo-list* do
+ (funcall (pop *fancy-inpector-undo-list*))))
+
+(provide :swank-fancy-inspector)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,620 @@
+;;; swank-fuzzy.lisp --- fuzzy symbol completion
+;;
+;; Authors: Brian Downing <bdowning(a)lavos.net>
+;; Tobias C. Rittweiler <tcr(a)freebits.de>
+;; and others
+;;
+;; License: Public Domain
+;;
+
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (swank-require :swank-c-p-c))
+
+;;; For nomenclature of the fuzzy completion section, please read
+;;; through the following docstring.
+
+(defslimefun fuzzy-completions (string default-package-name &key limit time-limit-in-msec)
+"Returns a list of two values:
+
+ An (optionally limited to LIMIT best results) list of fuzzy
+ completions for a symbol designator STRING. The list will be
+ sorted by score, most likely match first.
+
+ A flag that indicates whether or not TIME-LIMIT-IN-MSEC has
+ been exhausted during computation. If that parameter's value is
+ NIL or 0, no time limit is assumed.
+
+The main result is a list of completion objects, where a completion
+object is:
+
+ (COMPLETED-STRING SCORE (&rest CHUNKS) FLAGS)
+
+where a CHUNK is a description of a matched substring:
+
+ (OFFSET SUBSTRING)
+
+and FLAGS is a list of keywords describing properties of the
+symbol (see CLASSIFY-SYMBOL).
+
+E.g., completing \"mvb\" in a package that uses COMMON-LISP would
+return something like:
+
+ ((\"multiple-value-bind\" 26.588236 ((0 \"m\") (9 \"v\") (15 \"b\"))
+ (:FBOUNDP :MACRO))
+ ...)
+
+If STRING is package qualified the result list will also be
+qualified. If string is non-qualified the result strings are
+also not qualified and are considered relative to
+DEFAULT-PACKAGE-NAME.
+
+Which symbols are candidates for matching depends on the symbol
+designator's format. The cases are as follows:
+ FOO - Symbols accessible in the buffer package.
+ PKG:FOO - Symbols external in package PKG.
+ PKG::FOO - Symbols accessible in package PKG."
+ ;; For Emacs we allow both NIL and 0 as value of TIME-LIMIT-IN-MSEC
+ ;; to denote an infinite time limit. Internally, we only use NIL for
+ ;; that purpose, to be able to distinguish between "no time limit
+ ;; alltogether" and "current time limit already exhausted." So we've
+ ;; got to canonicalize its value at first:
+ (let* ((no-time-limit-p (or (not time-limit-in-msec) (zerop time-limit-in-msec)))
+ (time-limit (if no-time-limit-p nil time-limit-in-msec)))
+ (multiple-value-bind (completion-set interrupted-p)
+ (fuzzy-completion-set string default-package-name :limit limit
+ :time-limit-in-msec time-limit)
+ ;; We may send this as elisp [] arrays to spare a coerce here,
+ ;; but then the network serialization were slower by handling arrays.
+ ;; Instead we limit the number of completions that is transferred
+ ;; (the limit is set from Emacs.)
+ (list (coerce completion-set 'list) interrupted-p))))
+
+
+;;; A Fuzzy Matching -- Not to be confused with a fuzzy completion
+;;; object that will be sent back to Emacs, as described above.
+
+(defstruct (fuzzy-matching (:conc-name fuzzy-matching.)
+ (:predicate fuzzy-matching-p)
+ (:constructor %make-fuzzy-matching))
+ symbol ; The symbol that has been found to match.
+ package-name ; The name of the package where SYMBOL was found in.
+ ; (This is not necessarily the same as the home-package
+ ; of SYMBOL, because the SYMBOL can be internal to
+ ; lots of packages; also think of package nicknames.)
+ score ; The higher the better SYMBOL is a match.
+ package-chunks ; Chunks pertaining to the package identifier of SYMBOL.
+ symbol-chunks) ; Chunks pertaining to SYMBOL's name.
+
+(defun make-fuzzy-matching (symbol package-name score package-chunks symbol-chunks)
+ (declare (inline %make-fuzzy-matching))
+ (%make-fuzzy-matching :symbol symbol :package-name package-name :score score
+ :package-chunks package-chunks
+ :symbol-chunks symbol-chunks))
+
+(defun %fuzzy-extract-matching-info (fuzzy-matching user-input-string)
+ (multiple-value-bind (_ user-package-name __ input-internal-p)
+ (parse-completion-arguments user-input-string nil)
+ (declare (ignore _ __))
+ (with-struct (fuzzy-matching. score symbol package-name package-chunks symbol-chunks)
+ fuzzy-matching
+ (let (symbol-name real-package-name internal-p)
+ (cond (symbol ; symbol fuzzy matching?
+ (setf symbol-name (symbol-name symbol))
+ (setf internal-p input-internal-p)
+ (setf real-package-name (cond ((keywordp symbol) "")
+ ((not user-package-name) nil)
+ (t package-name))))
+ (t ; package fuzzy matching?
+ (setf symbol-name "")
+ (setf real-package-name package-name)
+ ;; If no explicit package name was given by the user
+ ;; (e.g. input was "asdf"), we want to append only
+ ;; one colon ":" to the package names.
+ (setf internal-p (if user-package-name input-internal-p nil))))
+ (values symbol-name
+ real-package-name
+ (if user-package-name internal-p nil)
+ (completion-output-symbol-converter user-input-string)
+ (completion-output-package-converter user-input-string))))))
+
+(defun fuzzy-format-matching (fuzzy-matching user-input-string)
+ "Returns the completion (\"foo:bar\") that's represented by FUZZY-MATCHING."
+ (multiple-value-bind (symbol-name package-name internal-p symbol-converter package-converter)
+ (%fuzzy-extract-matching-info fuzzy-matching user-input-string)
+ (setq symbol-name (and symbol-name (funcall symbol-converter symbol-name)))
+ (setq package-name (and package-name (funcall package-converter package-name)))
+ (let ((result (untokenize-symbol package-name internal-p symbol-name)))
+ ;; We return the length of the possibly added prefix as second value.
+ (values result (search symbol-name result)))))
+
+(defun fuzzy-convert-matching-for-emacs (fuzzy-matching user-input-string)
+ "Converts a result from the fuzzy completion core into
+something that emacs is expecting. Converts symbols to strings,
+fixes case issues, and adds information describing if the symbol
+is :bound, :fbound, a :class, a :macro, a :generic-function,
+a :special-operator, or a :package."
+ (with-struct (fuzzy-matching. symbol score package-chunks symbol-chunks) fuzzy-matching
+ (multiple-value-bind (name added-length)
+ (fuzzy-format-matching fuzzy-matching user-input-string)
+ (list name
+ score
+ (append package-chunks
+ (mapcar #'(lambda (chunk)
+ ;; Fix up chunk positions to account for possible
+ ;; added package identifier.
+ (let ((offset (first chunk)) (string (second chunk)))
+ (list (+ added-length offset) string)))
+ symbol-chunks))
+ (classify-symbol symbol)))))
+
+(defun fuzzy-completion-set (string default-package-name &key limit time-limit-in-msec)
+ "Returns two values: an array of completion objects, sorted by
+their score, that is how well they are a match for STRING
+according to the fuzzy completion algorithm. If LIMIT is set,
+only the top LIMIT results will be returned. Additionally, a flag
+is returned that indicates whether or not TIME-LIMIT-IN-MSEC was
+exhausted."
+ (check-type limit (or null (integer 0 #.(1- most-positive-fixnum))))
+ (check-type time-limit-in-msec (or null (integer 0 #.(1- most-positive-fixnum))))
+ (multiple-value-bind (matchings interrupted-p)
+ (fuzzy-generate-matchings string default-package-name time-limit-in-msec)
+ (when (and limit
+ (> limit 0)
+ (< limit (length matchings)))
+ (if (array-has-fill-pointer-p matchings)
+ (setf (fill-pointer matchings) limit)
+ (setf matchings (make-array limit :displaced-to matchings))))
+ (map-into matchings #'(lambda (m)
+ (fuzzy-convert-matching-for-emacs m string))
+ matchings)
+ (values matchings interrupted-p)))
+
+
+(defun fuzzy-generate-matchings (string default-package-name time-limit-in-msec)
+ "Does all the hard work for FUZZY-COMPLETION-SET. If
+TIME-LIMIT-IN-MSEC is NIL, an infinite time limit is assumed."
+ (multiple-value-bind (parsed-symbol-name parsed-package-name package internal-p)
+ (parse-completion-arguments string default-package-name)
+ (flet ((fix-up (matchings parent-package-matching)
+ ;; The components of each matching in MATCHINGS have been computed
+ ;; relatively to PARENT-PACKAGE-MATCHING. Make them absolute.
+ (let* ((p parent-package-matching)
+ (p.name (fuzzy-matching.package-name p))
+ (p.score (fuzzy-matching.score p))
+ (p.chunks (fuzzy-matching.package-chunks p)))
+ (map-into matchings
+ #'(lambda (m)
+ (let ((m.score (fuzzy-matching.score m)))
+ (setf (fuzzy-matching.package-name m) p.name)
+ (setf (fuzzy-matching.package-chunks m) p.chunks)
+ (setf (fuzzy-matching.score m)
+ (if (equal parsed-symbol-name "")
+ ;; (Make package matchings be sorted before all the
+ ;; relative symbol matchings while preserving over
+ ;; all orderness.)
+ (/ p.score 100)
+ (+ p.score m.score)))
+ m))
+ matchings)))
+ (find-symbols (designator package time-limit &optional filter)
+ (fuzzy-find-matching-symbols designator package
+ :time-limit-in-msec time-limit
+ :external-only (not internal-p)
+ :filter (or filter #'identity)))
+ (find-packages (designator time-limit)
+ (fuzzy-find-matching-packages designator :time-limit-in-msec time-limit)))
+ (let ((time-limit time-limit-in-msec) (symbols) (packages) (results))
+ (cond ((not parsed-package-name) ; E.g. STRING = "asd"
+ ;; We don't know if user is searching for a package or a symbol
+ ;; within his current package. So we try to find either.
+ (setf (values packages time-limit) (find-packages parsed-symbol-name time-limit))
+ (setf (values symbols time-limit) (find-symbols parsed-symbol-name package time-limit)))
+ ((string= parsed-package-name "") ; E.g. STRING = ":" or ":foo"
+ (setf (values symbols time-limit) (find-symbols parsed-symbol-name package time-limit)))
+ (t ; E.g. STRING = "asd:" or "asd:foo"
+ ;; Find fuzzy matchings of the denoted package identifier part.
+ ;; After that, find matchings for the denoted symbol identifier
+ ;; relative to all the packages found.
+ (multiple-value-bind (found-packages rest-time-limit)
+ (find-packages parsed-package-name time-limit-in-msec)
+ (loop
+ for package-matching across found-packages
+ for package = (find-package (fuzzy-matching.package-name package-matching))
+ while (or (not time-limit) (> rest-time-limit 0)) do
+ (multiple-value-bind (matchings remaining-time)
+ ;; The filter removes all those symbols which are also present
+ ;; in one of the other packages, specifically if such a package
+ ;; represents the home package of the symbol, because that one
+ ;; is deemed to be the best match.
+ (find-symbols parsed-symbol-name package rest-time-limit
+ (%make-duplicate-symbols-filter
+ (remove package-matching found-packages)))
+ (setf matchings (fix-up matchings package-matching))
+ (setf symbols (concatenate 'vector symbols matchings))
+ (setf rest-time-limit remaining-time)
+ (let ((guessed-sort-duration (%guess-sort-duration (length symbols))))
+ (when (<= rest-time-limit guessed-sort-duration)
+ (decf rest-time-limit guessed-sort-duration)
+ (loop-finish))))
+ finally
+ (setf time-limit rest-time-limit)
+ (when (equal parsed-symbol-name "") ; E.g. STRING = "asd:"
+ (setf packages found-packages))))))
+ ;; Sort by score; thing with equal score, sort alphabetically.
+ ;; (Especially useful when PARSED-SYMBOL-NAME is empty, and all possible
+ ;; completions are to be returned.)
+ (setf results (concatenate 'vector symbols packages))
+ (setf results (sort results #'fuzzy-matching-greaterp))
+ (values results (and time-limit (<= time-limit 0)))))))
+
+(defun %guess-sort-duration (length)
+ ;; These numbers are pretty much arbitrary, except that they're
+ ;; vaguely correct on my machine with SBCL. Yes, this is an ugly
+ ;; kludge, but it's better than before (where this didn't exist at
+ ;; all, which essentially meant, that this was taken to be 0.)
+ (if (zerop length)
+ 0
+ (let ((comparasions (* 3.8 (* length (log length 2)))))
+ (* 1000 (* comparasions (expt 10 -7)))))) ; msecs
+
+(defun %make-duplicate-symbols-filter (fuzzy-package-matchings)
+ ;; Returns a filter function that takes a symbol and which returns T
+ ;; only if no matching in FUZZY-PACKAGE-MATCHINGS represents the
+ ;; home-package of the.
+ (let ((packages (mapcar #'(lambda (m)
+ (find-package (fuzzy-matching.package-name m)))
+ (coerce fuzzy-package-matchings 'list))))
+ #'(lambda (symbol)
+ (not (member (symbol-package symbol) packages)))))
+
+(defun fuzzy-matching-greaterp (m1 m2)
+ "Returns T if fuzzy-matching M1 should be sorted before M2.
+Basically just the scores of the two matchings are compared, and
+the match with higher score wins. For the case that the score is
+equal, the one which comes alphabetically first wins."
+ (declare (type fuzzy-matching m1 m2))
+ (let ((score1 (fuzzy-matching.score m1))
+ (score2 (fuzzy-matching.score m2)))
+ (cond ((> score1 score2) t)
+ ((< score1 score2) nil) ; total order
+ (t
+ (let ((name1 (symbol-name (fuzzy-matching.symbol m1)))
+ (name2 (symbol-name (fuzzy-matching.symbol m2))))
+ (string< name1 name2))))))
+
+
+(defun get-real-time-in-msecs ()
+ (let ((units-per-msec (max 1 (floor internal-time-units-per-second 1000))))
+ (values (floor (get-internal-real-time) units-per-msec)))) ; return just one value!
+
+(defun fuzzy-find-matching-symbols
+ (string package &key (filter #'identity) external-only time-limit-in-msec)
+ "Returns two values: a vector of fuzzy matchings for matching
+symbols in PACKAGE, using the fuzzy completion algorithm, and the
+remaining time limit.
+
+Only those symbols are considered of which FILTER does return T.
+
+If EXTERNAL-ONLY is true, only external symbols are considered. A
+TIME-LIMIT-IN-MSEC of NIL is considered no limit; if it's zero or
+negative, perform a NOP."
+ (let ((time-limit-p (and time-limit-in-msec t))
+ (time-limit (or time-limit-in-msec 0))
+ (rtime-at-start (get-real-time-in-msecs))
+ (package-name (package-name package))
+ (count 0))
+ (declare (type boolean time-limit-p))
+ (declare (type integer time-limit rtime-at-start))
+ (declare (type (integer 0 #.(1- most-positive-fixnum)) count))
+
+ (flet ((recompute-remaining-time (old-remaining-time)
+ (cond ((not time-limit-p)
+ (values nil nil)) ; propagate NIL back as infinite time limit.
+ ((> count 0) ; ease up on getting internal time like crazy.
+ (setf count (mod (1+ count) 128))
+ (values nil old-remaining-time))
+ (t (let* ((elapsed-time (- (get-real-time-in-msecs) rtime-at-start))
+ (remaining (- time-limit elapsed-time)))
+ (values (<= remaining 0) remaining)))))
+ (perform-fuzzy-match (string symbol-name)
+ (let* ((converter (completion-output-symbol-converter string))
+ (converted-symbol-name (funcall converter symbol-name)))
+ (compute-highest-scoring-completion string converted-symbol-name))))
+ (let ((completions (make-array 256 :adjustable t :fill-pointer 0))
+ (rest-time-limit time-limit))
+ (block loop
+ (do-symbols* (symbol package)
+ (multiple-value-bind (exhausted? remaining-time)
+ (recompute-remaining-time rest-time-limit)
+ (setf rest-time-limit remaining-time)
+ (cond (exhausted? (return-from loop))
+ ((or (not external-only) (symbol-external-p symbol package))
+ (when (funcall filter symbol)
+ (if (string= "" string) ; "" matches always
+ (vector-push-extend (make-fuzzy-matching symbol package-name
+ 0.0 '() '())
+ completions)
+ (multiple-value-bind (match-result score)
+ (perform-fuzzy-match string (symbol-name symbol))
+ (when match-result
+ (vector-push-extend
+ (make-fuzzy-matching symbol package-name score
+ '() match-result)
+ completions))))))))))
+ (values completions rest-time-limit)))))
+
+
+(defun fuzzy-find-matching-packages (name &key time-limit-in-msec)
+ "Returns a vector of fuzzy matchings for each package that is
+similiar to NAME, and the remaining time limit.
+Cf. FUZZY-FIND-MATCHING-SYMBOLS."
+ (let ((time-limit-p (and time-limit-in-msec t))
+ (time-limit (or time-limit-in-msec 0))
+ (rtime-at-start (get-real-time-in-msecs))
+ (converter (completion-output-package-converter name))
+ (completions (make-array 32 :adjustable t :fill-pointer 0)))
+ (declare (type boolean time-limit-p))
+ (declare (type integer time-limit rtime-at-start))
+ (declare (type function converter))
+ (if (and time-limit-p (<= time-limit 0))
+ (values #() time-limit)
+ (loop for package in (list-all-packages) do
+ ;; Find best-matching package-nickname:
+ (loop with max-pkg-name = ""
+ with max-result = nil
+ with max-score = 0
+ for package-name in (package-names package)
+ for converted-name = (funcall converter package-name)
+ do
+ (multiple-value-bind (result score)
+ (compute-highest-scoring-completion name converted-name)
+ (when (and result (> score max-score))
+ (setf max-pkg-name package-name)
+ (setf max-result result)
+ (setf max-score score)))
+ finally
+ (when max-result
+ (vector-push-extend (make-fuzzy-matching nil max-pkg-name
+ max-score max-result '())
+ completions)))
+ finally
+ (return
+ (values completions
+ (and time-limit-p
+ (let ((elapsed-time (- (get-real-time-in-msecs) rtime-at-start)))
+ (- time-limit elapsed-time)))))))))
+
+
+(defslimefun fuzzy-completion-selected (original-string completion)
+ "This function is called by Slime when a fuzzy completion is
+selected by the user. It is for future expansion to make
+testing, say, a machine learning algorithm for completion scoring
+easier.
+
+ORIGINAL-STRING is the string the user completed from, and
+COMPLETION is the completion object (see docstring for
+SWANK:FUZZY-COMPLETIONS) corresponding to the completion that the
+user selected."
+ (declare (ignore original-string completion))
+ nil)
+
+
+;;;;; Fuzzy completion core
+
+(defparameter *fuzzy-recursion-soft-limit* 30
+ "This is a soft limit for recursion in
+RECURSIVELY-COMPUTE-MOST-COMPLETIONS. Without this limit,
+completing a string such as \"ZZZZZZ\" with a symbol named
+\"ZZZZZZZZZZZZZZZZZZZZZZZ\" will result in explosive recursion to
+find all the ways it can match.
+
+Most natural language searches and symbols do not have this
+problem -- this is only here as a safeguard.")
+(declaim (fixnum *fuzzy-recursion-soft-limit*))
+
+(defun compute-highest-scoring-completion (short full)
+ "Finds the highest scoring way to complete the abbreviation
+SHORT onto the string FULL, using CHAR= as a equality function for
+letters. Returns two values: The first being the completion
+chunks of the highest scorer, and the second being the score."
+ (let* ((scored-results
+ (mapcar #'(lambda (result)
+ (cons (score-completion result short full) result))
+ (compute-most-completions short full)))
+ (winner (first (sort scored-results #'> :key #'first))))
+ (values (rest winner) (first winner))))
+
+(defun compute-most-completions (short full)
+ "Finds most possible ways to complete FULL with the letters in SHORT.
+Calls RECURSIVELY-COMPUTE-MOST-COMPLETIONS recursively. Returns
+a list of (&rest CHUNKS), where each CHUNKS is a description of
+how a completion matches."
+ (let ((*all-chunks* nil))
+ (declare (special *all-chunks*))
+ (recursively-compute-most-completions short full 0 0 nil nil nil t)
+ *all-chunks*))
+
+(defun recursively-compute-most-completions
+ (short full
+ short-index initial-full-index
+ chunks current-chunk current-chunk-pos
+ recurse-p)
+ "Recursively (if RECURSE-P is true) find /most/ possible ways
+to fuzzily map the letters in SHORT onto FULL, using CHAR= to
+determine if two letters match.
+
+A chunk is a list of elements that have matched consecutively.
+When consecutive matches stop, it is coerced into a string,
+paired with the starting position of the chunk, and pushed onto
+CHUNKS.
+
+Whenever a letter matches, if RECURSE-P is true,
+RECURSIVELY-COMPUTE-MOST-COMPLETIONS calls itself with a position
+one index ahead, to find other possibly higher scoring
+possibilities. If there are less than
+*FUZZY-RECURSION-SOFT-LIMIT* results in *ALL-CHUNKS* currently,
+this call will also recurse.
+
+Once a word has been completely matched, the chunks are pushed
+onto the special variable *ALL-CHUNKS* and the function returns."
+ (declare ;(optimize speed)
+ (fixnum short-index initial-full-index)
+ (simple-string short full)
+ (special *all-chunks*))
+ (flet ((short-cur ()
+ "Returns the next letter from the abbreviation, or NIL
+ if all have been used."
+ (if (= short-index (length short))
+ nil
+ (aref short short-index)))
+ (add-to-chunk (char pos)
+ "Adds the CHAR at POS in FULL to the current chunk,
+ marking the start position if it is empty."
+ (unless current-chunk
+ (setf current-chunk-pos pos))
+ (push char current-chunk))
+ (collect-chunk ()
+ "Collects the current chunk to CHUNKS and prepares for
+ a new chunk."
+ (when current-chunk
+ (push (list current-chunk-pos
+ (coerce (reverse current-chunk) 'string)) chunks)
+ (setf current-chunk nil
+ current-chunk-pos nil))))
+ ;; If there's an outstanding chunk coming in collect it. Since
+ ;; we're recursively called on skipping an input character, the
+ ;; chunk can't possibly continue on.
+ (when current-chunk (collect-chunk))
+ (do ((pos initial-full-index (1+ pos)))
+ ((= pos (length full)))
+ (let ((cur-char (aref full pos)))
+ (if (and (short-cur)
+ (char= cur-char (short-cur)))
+ (progn
+ (when recurse-p
+ ;; Try other possibilities, limiting insanely deep
+ ;; recursion somewhat.
+ (recursively-compute-most-completions
+ short full short-index (1+ pos)
+ chunks current-chunk current-chunk-pos
+ (not (> (length *all-chunks*)
+ *fuzzy-recursion-soft-limit*))))
+ (incf short-index)
+ (add-to-chunk cur-char pos))
+ (collect-chunk))))
+ (collect-chunk)
+ ;; If we've exhausted the short characters we have a match.
+ (if (short-cur)
+ nil
+ (let ((rev-chunks (reverse chunks)))
+ (push rev-chunks *all-chunks*)
+ rev-chunks))))
+
+
+;;;;; Fuzzy completion scoring
+
+(defparameter *fuzzy-completion-symbol-prefixes* "*+-%&?<"
+ "Letters that are likely to be at the beginning of a symbol.
+Letters found after one of these prefixes will be scored as if
+they were at the beginning of ths symbol.")
+(defparameter *fuzzy-completion-symbol-suffixes* "*+->"
+ "Letters that are likely to be at the end of a symbol.
+Letters found before one of these suffixes will be scored as if
+they were at the end of the symbol.")
+(defparameter *fuzzy-completion-word-separators* "-/."
+ "Letters that separate different words in symbols. Letters
+after one of these symbols will be scores more highly than other
+letters.")
+
+(defun score-completion (completion short full)
+ "Scores the completion chunks COMPLETION as a completion from
+the abbreviation SHORT to the full string FULL. COMPLETION is a
+list like:
+ ((0 \"mul\") (9 \"v\") (15 \"b\"))
+Which, if SHORT were \"mulvb\" and full were \"multiple-value-bind\",
+would indicate that it completed as such (completed letters
+capitalized):
+ MULtiple-Value-Bind
+
+Letters are given scores based on their position in the string.
+Letters at the beginning of a string or after a prefix letter at
+the beginning of a string are scored highest. Letters after a
+word separator such as #\- are scored next highest. Letters at
+the end of a string or before a suffix letter at the end of a
+string are scored medium, and letters anywhere else are scored
+low.
+
+If a letter is directly after another matched letter, and its
+intrinsic value in that position is less than a percentage of the
+previous letter's value, it will use that percentage instead.
+
+Finally, a small scaling factor is applied to favor shorter
+matches, all other things being equal."
+ (labels ((at-beginning-p (pos)
+ (= pos 0))
+ (after-prefix-p (pos)
+ (and (= pos 1)
+ (find (aref full 0) *fuzzy-completion-symbol-prefixes*)))
+ (word-separator-p (pos)
+ (find (aref full pos) *fuzzy-completion-word-separators*))
+ (after-word-separator-p (pos)
+ (find (aref full (1- pos)) *fuzzy-completion-word-separators*))
+ (at-end-p (pos)
+ (= pos (1- (length full))))
+ (before-suffix-p (pos)
+ (and (= pos (- (length full) 2))
+ (find (aref full (1- (length full)))
+ *fuzzy-completion-symbol-suffixes*)))
+ (score-or-percentage-of-previous (base-score pos chunk-pos)
+ (if (zerop chunk-pos)
+ base-score
+ (max base-score
+ (+ (* (score-char (1- pos) (1- chunk-pos)) 0.85)
+ (expt 1.2 chunk-pos)))))
+ (score-char (pos chunk-pos)
+ (score-or-percentage-of-previous
+ (cond ((at-beginning-p pos) 10)
+ ((after-prefix-p pos) 10)
+ ((word-separator-p pos) 1)
+ ((after-word-separator-p pos) 8)
+ ((at-end-p pos) 6)
+ ((before-suffix-p pos) 6)
+ (t 1))
+ pos chunk-pos))
+ (score-chunk (chunk)
+ (loop for chunk-pos below (length (second chunk))
+ for pos from (first chunk)
+ summing (score-char pos chunk-pos))))
+ (let* ((chunk-scores (mapcar #'score-chunk completion))
+ (length-score (/ 10.0 (1+ (- (length full) (length short))))))
+ (values
+ (+ (reduce #'+ chunk-scores) length-score)
+ (list (mapcar #'list chunk-scores completion) length-score)))))
+
+(defun highlight-completion (completion full)
+ "Given a chunk definition COMPLETION and the string FULL,
+HIGHLIGHT-COMPLETION will create a string that demonstrates where
+the completion matched in the string. Matches will be
+capitalized, while the rest of the string will be lower-case."
+ (let ((highlit (nstring-downcase (copy-seq full))))
+ (dolist (chunk completion)
+ (setf highlit (nstring-upcase highlit
+ :start (first chunk)
+ :end (+ (first chunk)
+ (length (second chunk))))))
+ highlit))
+
+(defun format-fuzzy-completion-set (winners)
+ "Given a list of completion objects such as on returned by
+FUZZY-COMPLETION-SET, format the list into user-readable output
+for interactive debugging purpose."
+ (let ((max-len
+ (loop for winner in winners maximizing (length (first winner)))))
+ (loop for (sym score result) in winners do
+ (format t "~&~VA score ~8,2F ~A"
+ max-len (highlight-completion result sym) score result))))
+
+(provide :swank-fuzzy)
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-listener-hooks.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-listener-hooks.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-listener-hooks.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,82 @@
+;;; swank-listener-hooks.lisp --- listener with special hooks
+;;
+;; Author: Alan Ruttenberg <alanr-l(a)mumble.net>
+
+;; I guess that only Alan Ruttenberg knows how to use this code. It
+;; was in swank.lisp for a long time, so here it is. -- Helmut Eller
+
+(defvar *slime-repl-advance-history* nil
+ "In the dynamic scope of a single form typed at the repl, is set to nil to
+ prevent the repl from advancing the history - * ** *** etc.")
+
+(defvar *slime-repl-suppress-output* nil
+ "In the dynamic scope of a single form typed at the repl, is set to nil to
+ prevent the repl from printing the result of the evalation.")
+
+(defvar *slime-repl-eval-hook-pass* (gensym "PASS")
+ "Token to indicate that a repl hook declines to evaluate the form")
+
+(defvar *slime-repl-eval-hooks* nil
+ "A list of functions. When the repl is about to eval a form, first try running each of
+ these hooks. The first hook which returns a value which is not *slime-repl-eval-hook-pass*
+ is considered a replacement for calling eval. If there are no hooks, or all
+ pass, then eval is used.")
+
+(defslimefun repl-eval-hook-pass ()
+ "call when repl hook declines to evaluate the form"
+ (throw *slime-repl-eval-hook-pass* *slime-repl-eval-hook-pass*))
+
+(defslimefun repl-suppress-output ()
+ "In the dynamic scope of a single form typed at the repl, call to
+ prevent the repl from printing the result of the evalation."
+ (setq *slime-repl-suppress-output* t))
+
+(defslimefun repl-suppress-advance-history ()
+ "In the dynamic scope of a single form typed at the repl, call to
+ prevent the repl from advancing the history - * ** *** etc."
+ (setq *slime-repl-advance-history* nil))
+
+(defun %eval-region (string)
+ (with-input-from-string (stream string)
+ (let (- values)
+ (loop
+ (let ((form (read stream nil stream)))
+ (when (eq form stream)
+ (fresh-line)
+ (finish-output)
+ (return (values values -)))
+ (setq - form)
+ (if *slime-repl-eval-hooks*
+ (setq values (run-repl-eval-hooks form))
+ (setq values (multiple-value-list (eval form))))
+ (finish-output))))))
+
+(defun run-repl-eval-hooks (form)
+ (loop for hook in *slime-repl-eval-hooks*
+ for res = (catch *slime-repl-eval-hook-pass*
+ (multiple-value-list (funcall hook form)))
+ until (not (eq res *slime-repl-eval-hook-pass*))
+ finally (return
+ (if (eq res *slime-repl-eval-hook-pass*)
+ (multiple-value-list (eval form))
+ res))))
+
+(defun %listener-eval (string)
+ (clear-user-input)
+ (with-buffer-syntax ()
+ (track-package
+ (lambda ()
+ (let ((*slime-repl-suppress-output* :unset)
+ (*slime-repl-advance-history* :unset))
+ (multiple-value-bind (values last-form) (%eval-region string)
+ (unless (or (and (eq values nil) (eq last-form nil))
+ (eq *slime-repl-advance-history* nil))
+ (setq *** ** ** * * (car values)
+ /// // // / / values))
+ (setq +++ ++ ++ + + last-form)
+ (unless (eq *slime-repl-suppress-output* t)
+ (funcall *send-repl-results-function* values))))))))
+
+(setq *listener-eval-function* '%listener-eval)
+
+(provide :swank-listener-hooks)
Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,319 @@
+;;; swank-presentation-streams.lisp --- Streams that allow attaching object identities
+;;; to portions of output
+;;;
+;;; Authors: Alan Ruttenberg <alanr-l(a)mumble.net>
+;;; Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;;; Helmut Eller <heller(a)common-lisp.net>
+;;;
+;;; License: This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+
+(in-package :swank)
+
+(swank-require :swank-presentations)
+
+;; This file contains a mechanism for printing to the slime repl so
+;; that the printed result remembers what object it is associated
+;; with. This extends the recording of REPL results.
+;;
+;; There are two methods:
+;;
+;; 1. Depends on the ilisp bridge code being installed and ready to
+;; intercept messages in the printed stream. We encode the
+;; information with a message saying that we are starting to print
+;; an object corresponding to a given id and another when we are
+;; done. The process filter notices these and adds the necessary
+;; text properties to the output.
+;;
+;; 2. Use separate protocol messages :presentation-start and
+;; :presentation-end for sending presentations.
+;;
+;; We only do this if we know we are printing to a slime stream,
+;; checked with the method slime-stream-p. Initially this checks for
+;; the knows slime streams looking at *connections*. In cmucl, sbcl, and
+;; openmcl it also checks if it is a pretty-printing stream which
+;; ultimately prints to a slime stream.
+;;
+;; Method 1 seems to be faster, but the printed escape sequences can
+;; disturb the column counting, and thus the layout in pretty-printing.
+;; We use method 1 when a dedicated output stream is used.
+;;
+;; Method 2 is cleaner and works with pretty printing if the pretty
+;; printers support "annotations". We use method 2 when no dedicated
+;; output stream is used.
+
+;; Control
+(defvar *enable-presenting-readable-objects* t
+ "set this to enable automatically printing presentations for some
+subset of readable objects, such as pathnames." )
+
+;; doing it
+
+(defmacro presenting-object (object stream &body body)
+ "What you use in your code. Wrap this around some printing and that text will
+be sensitive and remember what object it is in the repl"
+ `(presenting-object-1 ,object ,stream #'(lambda () ,@body)))
+
+(defmacro presenting-object-if (predicate object stream &body body)
+ "What you use in your code. Wrap this around some printing and that text will
+be sensitive and remember what object it is in the repl if predicate is true"
+ (let ((continue (gensym)))
+ `(let ((,continue #'(lambda () ,@body)))
+ (if ,predicate
+ (presenting-object-1 ,object ,stream ,continue)
+ (funcall ,continue)))))
+
+;;; Get pretty printer patches for SBCL at load (not compile) time.
+#+sbcl
+(eval-when (:load-toplevel)
+ (handler-bind ((simple-error
+ (lambda (c)
+ (declare (ignore c))
+ (let ((clobber-it (find-restart 'sb-kernel::clobber-it)))
+ (when clobber-it (invoke-restart clobber-it))))))
+ (sb-ext:without-package-locks
+ (swank-backend::with-debootstrapping
+ (load (make-pathname
+ :name "sbcl-pprint-patch"
+ :type "lisp"
+ :directory (pathname-directory swank-loader:*source-directory*)))))))
+
+(let ((last-stream nil)
+ (last-answer nil))
+ (defun slime-stream-p (stream)
+ "Check if stream is one of the slime streams, since if it isn't we
+don't want to present anything.
+Two special return values:
+:DEDICATED -- Output ends up on a dedicated output stream
+:REPL-RESULT -- Output ends up on the :repl-results target.
+"
+ (if (eq last-stream stream)
+ last-answer
+ (progn
+ (setq last-stream stream)
+ (if (eq stream t)
+ (setq stream *standard-output*))
+ (setq last-answer
+ (or #+openmcl
+ (and (typep stream 'ccl::xp-stream)
+ ;(slime-stream-p (ccl::xp-base-stream (slot-value stream 'ccl::xp-structure)))
+ (slime-stream-p (ccl::%svref (slot-value stream 'ccl::xp-structure) 1)))
+ #+cmu
+ (or (and (typep stream 'lisp::indenting-stream)
+ (slime-stream-p (lisp::indenting-stream-stream stream)))
+ (and (typep stream 'pretty-print::pretty-stream)
+ (fboundp 'pretty-print::enqueue-annotation)
+ (let ((slime-stream-p
+ (slime-stream-p (pretty-print::pretty-stream-target stream))))
+ (and ;; Printing through CMUCL pretty
+ ;; streams is only cleanly
+ ;; possible if we are using the
+ ;; bridge-less protocol with
+ ;; annotations, because the bridge
+ ;; escape sequences disturb the
+ ;; pretty printer layout.
+ (not (eql slime-stream-p :dedicated-output))
+ ;; If OK, return the return value
+ ;; we got from slime-stream-p on
+ ;; the target stream (could be
+ ;; :repl-result):
+ slime-stream-p))))
+ #+sbcl
+ (let ()
+ (declare (notinline sb-pretty::pretty-stream-target))
+ (or (and (typep stream 'sb-impl::indenting-stream)
+ (slime-stream-p (sb-impl::indenting-stream-stream stream)))
+ (and (typep stream (find-symbol "PRETTY-STREAM" 'sb-pretty))
+ (find-symbol "ENQUEUE-ANNOTATION" 'sb-pretty)
+ (not *use-dedicated-output-stream*)
+ (slime-stream-p (sb-pretty::pretty-stream-target stream)))))
+ #+allegro
+ (and (typep stream 'excl:xp-simple-stream)
+ (slime-stream-p (excl::stream-output-handle stream)))
+ (loop for connection in *connections*
+ thereis (or (and (eq stream (connection.dedicated-output connection))
+ :dedicated)
+ (eq stream (connection.socket-io connection))
+ (eq stream (connection.user-output connection))
+ (eq stream (connection.user-io connection))
+ (and (eq stream (connection.repl-results connection))
+ :repl-result)))))))))
+
+(defun can-present-readable-objects (&optional stream)
+ (declare (ignore stream))
+ *enable-presenting-readable-objects*)
+
+;; If we are printing to an XP (pretty printing) stream, printing the
+;; escape sequences directly would mess up the layout because column
+;; counting is disturbed. Use "annotations" instead.
+#+allegro
+(defun write-annotation (stream function arg)
+ (if (typep stream 'excl:xp-simple-stream)
+ (excl::schedule-annotation stream function arg)
+ (funcall function arg stream nil)))
+#+cmu
+(defun write-annotation (stream function arg)
+ (if (and (typep stream 'pp:pretty-stream)
+ (fboundp 'pp::enqueue-annotation))
+ (pp::enqueue-annotation stream function arg)
+ (funcall function arg stream nil)))
+#+sbcl
+(defun write-annotation (stream function arg)
+ (let ((enqueue-annotation
+ (find-symbol "ENQUEUE-ANNOTATION" 'sb-pretty)))
+ (if (and enqueue-annotation
+ (typep stream (find-symbol "PRETTY-STREAM" 'sb-pretty)))
+ (funcall enqueue-annotation stream function arg)
+ (funcall function arg stream nil))))
+#-(or allegro cmu sbcl)
+(defun write-annotation (stream function arg)
+ (funcall function arg stream nil))
+
+(defstruct presentation-record
+ (id)
+ (printed-p)
+ (target))
+
+(defun presentation-start (record stream truncatep)
+ (unless truncatep
+ ;; Don't start new presentations when nothing is going to be
+ ;; printed due to *print-lines*.
+ (let ((pid (presentation-record-id record))
+ (target (presentation-record-target record)))
+ (case target
+ (:dedicated
+ ;; Use bridge protocol
+ (write-string "<" stream)
+ (prin1 pid stream)
+ (write-string " " stream))
+ (t
+ (finish-output stream)
+ (send-to-emacs `(:presentation-start ,pid ,target)))))
+ (setf (presentation-record-printed-p record) t)))
+
+(defun presentation-end (record stream truncatep)
+ (declare (ignore truncatep))
+ ;; Always end old presentations that were started.
+ (when (presentation-record-printed-p record)
+ (let ((pid (presentation-record-id record))
+ (target (presentation-record-target record)))
+ (case target
+ (:dedicated
+ ;; Use bridge protocol
+ (write-string ">" stream)
+ (prin1 pid stream)
+ (write-string " " stream))
+ (t
+ (finish-output stream)
+ (send-to-emacs `(:presentation-end ,pid ,target)))))))
+
+(defun presenting-object-1 (object stream continue)
+ "Uses the bridge mechanism with two messages >id and <id. The first one
+says that I am starting to print an object with this id. The second says I am finished"
+ (let ((slime-stream-p
+ (and *record-repl-results* (slime-stream-p stream))))
+ (if slime-stream-p
+ (let* ((pid (swank::save-presented-object object))
+ (record (make-presentation-record :id pid :printed-p nil
+ :target (if (eq slime-stream-p :repl-result)
+ :repl-result
+ nil))))
+ (write-annotation stream #'presentation-start record)
+ (multiple-value-prog1
+ (funcall continue)
+ (write-annotation stream #'presentation-end record)))
+ (funcall continue))))
+
+(defun present-repl-results-via-presentation-streams (values)
+ ;; Override a function in swank.lisp, so that
+ ;; nested presentations work in the REPL result.
+ (let ((repl-results (connection.repl-results *emacs-connection*)))
+ (flet ((send (value)
+ (presenting-object value repl-results
+ (prin1 value repl-results))
+ (terpri repl-results)))
+ (if (null values)
+ (progn
+ (princ "; No value" repl-results)
+ (terpri repl-results))
+ (mapc #'send values)))
+ (finish-output repl-results)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Example: Tell openmcl and cmucl to always present unreadable objects. try (describe 'class)
+#+openmcl
+(in-package :ccl)
+#+openmcl
+(let ((*warn-if-redefine-kernel* nil)
+ (*warn-if-redefine* nil))
+ (defun %print-unreadable-object (object stream type id thunk)
+ (cond ((null stream) (setq stream *standard-output*))
+ ((eq stream t) (setq stream *terminal-io*)))
+ (swank::presenting-object object stream
+ (write-unreadable-start object stream)
+ (when type
+ (princ (type-of object) stream)
+ (stream-write-char stream #\space))
+ (when thunk
+ (funcall thunk))
+ (if id
+ (%write-address object stream #\>)
+ (pp-end-block stream ">"))
+ nil))
+ (defmethod print-object :around ((pathname pathname) stream)
+ (swank::presenting-object-if
+ (swank::can-present-readable-objects stream)
+ pathname stream (call-next-method))))
+
+#+openmcl
+(ccl::def-load-pointers clear-presentations ()
+ (swank::clear-presentation-tables))
+
+(in-package :swank)
+
+#+cmu
+(progn
+ (fwrappers:define-fwrapper presenting-unreadable-wrapper (object stream type identity body)
+ (presenting-object object stream
+ (fwrappers:call-next-function)))
+
+ (fwrappers:define-fwrapper presenting-pathname-wrapper (pathname stream depth)
+ (presenting-object-if (can-present-readable-objects stream) pathname stream
+ (fwrappers:call-next-function)))
+
+ (fwrappers::fwrap 'lisp::%print-pathname #'presenting-pathname-wrapper)
+ (fwrappers::fwrap 'lisp::%print-unreadable-object #'presenting-unreadable-wrapper)
+ )
+
+#+sbcl
+(progn
+ (defvar *saved-%print-unreadable-object*
+ (fdefinition 'sb-impl::%print-unreadable-object))
+ (sb-ext:without-package-locks
+ (setf (fdefinition 'sb-impl::%print-unreadable-object)
+ (lambda (object stream type identity body)
+ (presenting-object object stream
+ (funcall *saved-%print-unreadable-object*
+ object stream type identity body))))
+ (defmethod print-object :around ((object pathname) stream)
+ (presenting-object object stream
+ (call-next-method)))))
+
+#+allegro
+(progn
+ (excl:def-fwrapper presenting-unreadable-wrapper (object stream type identity continuation)
+ (swank::presenting-object object stream (excl:call-next-fwrapper)))
+ (excl:def-fwrapper presenting-pathname-wrapper (pathname stream depth)
+ (presenting-object-if (can-present-readable-objects stream) pathname stream
+ (excl:call-next-fwrapper)))
+ (excl:fwrap 'excl::print-unreadable-object-1
+ 'print-unreadable-present 'presenting-unreadable-wrapper)
+ (excl:fwrap 'excl::pathname-printer
+ 'print-pathname-present 'presenting-pathname-wrapper))
+
+;; Hook into SWANK.
+
+(setq *send-repl-results-function* 'present-repl-results-via-presentation-streams)
+
+(provide :swank-presentation-streams)
Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-presentations.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-presentations.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-presentations.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,235 @@
+;;; swank-presentations.lisp --- imitate LispM's presentations
+;;
+;; Authors: Alan Ruttenberg <alanr-l(a)mumble.net>
+;; Luke Gorrie <luke(a)synap.se>
+;; Helmut Eller <heller(a)common-lisp.net>
+;; Matthias Koeppe <mkoeppe(a)mail.math.uni-magdeburg.de>
+;;
+;; License: This code has been placed in the Public Domain. All warranties
+;; are disclaimed.
+;;
+
+(in-package :swank)
+
+;;;; Recording and accessing results of computations
+
+(defvar *record-repl-results* t
+ "Non-nil means that REPL results are saved for later lookup.")
+
+(defvar *object-to-presentation-id*
+ (make-weak-key-hash-table :test 'eq)
+ "Store the mapping of objects to numeric identifiers")
+
+(defvar *presentation-id-to-object*
+ (make-weak-value-hash-table :test 'eql)
+ "Store the mapping of numeric identifiers to objects")
+
+(defun clear-presentation-tables ()
+ (clrhash *object-to-presentation-id*)
+ (clrhash *presentation-id-to-object*))
+
+(defvar *presentation-counter* 0 "identifier counter")
+
+(defvar *nil-surrogate* (make-symbol "nil-surrogate"))
+
+;; XXX thread safety? [2006-09-13] mb: not in the slightest (fwiw the
+;; rest of slime isn't thread safe either), do we really care?
+(defun save-presented-object (object)
+ "Save OBJECT and return the assigned id.
+If OBJECT was saved previously return the old id."
+ (let ((object (if (null object) *nil-surrogate* object)))
+ ;; We store *nil-surrogate* instead of nil, to distinguish it from
+ ;; an object that was garbage collected.
+ (or (gethash object *object-to-presentation-id*)
+ (let ((id (incf *presentation-counter*)))
+ (setf (gethash id *presentation-id-to-object*) object)
+ (setf (gethash object *object-to-presentation-id*) id)
+ id))))
+
+(defun lookup-presented-object (id)
+ "Retrieve the object corresponding to ID.
+The secondary value indicates the absence of an entry."
+ (etypecase id
+ (integer
+ ;;
+ (multiple-value-bind (object foundp)
+ (gethash id *presentation-id-to-object*)
+ (cond
+ ((eql object *nil-surrogate*)
+ ;; A stored nil object
+ (values nil t))
+ ((null object)
+ ;; Object that was replaced by nil in the weak hash table
+ ;; when the object was garbage collected.
+ (values nil nil))
+ (t
+ (values object foundp)))))
+ (cons
+ (destructure-case id
+ ((:frame-var thread-id frame index)
+ (declare (ignore thread-id)) ; later
+ (handler-case
+ (frame-var-value frame index)
+ (t (condition)
+ (declare (ignore condition))
+ (values nil nil))
+ (:no-error (value)
+ (values value t))))
+ ((:inspected-part part-index)
+ (declare (special *inspectee-parts*))
+ (if (< part-index (length *inspectee-parts*))
+ (values (inspector-nth-part part-index) t)
+ (values nil nil)))))))
+
+(defslimefun get-repl-result (id)
+ "Get the result of the previous REPL evaluation with ID."
+ (multiple-value-bind (object foundp) (lookup-presented-object id)
+ (cond (foundp object)
+ (t (error "Attempt to access unrecorded object (id ~D)." id)))))
+
+(defslimefun clear-repl-results ()
+ "Forget the results of all previous REPL evaluations."
+ (clear-presentation-tables)
+ t)
+
+(defun present-repl-results (values)
+ ;; Override a function in swank.lisp, so that
+ ;; presentations are associated with every REPL result.
+ (flet ((send (value)
+ (let ((id (and *record-repl-results*
+ (save-presented-object value))))
+ (send-to-emacs `(:presentation-start ,id :repl-result))
+ (send-to-emacs `(:write-string ,(prin1-to-string value)
+ :repl-result))
+ (send-to-emacs `(:presentation-end ,id :repl-result))
+ (send-to-emacs `(:write-string ,(string #\Newline)
+ :repl-result)))))
+ (if (null values)
+ (send-to-emacs `(:write-string "; No value" :repl-result))
+ (mapc #'send values))))
+
+
+;;;; Presentation menu protocol
+;;
+;; To define a menu for a type of object, define a method
+;; menu-choices-for-presentation on that object type. This function
+;; should return a list of two element lists where the first element is
+;; the name of the menu action and the second is a function that will be
+;; called if the menu is chosen. The function will be called with 3
+;; arguments:
+;;
+;; choice: The string naming the action from above
+;;
+;; object: The object
+;;
+;; id: The presentation id of the object
+;;
+;; You might want append (when (next-method-p) (call-next-method)) to
+;; pick up the Menu actions of superclasses.
+;;
+
+(defvar *presentation-active-menu* nil)
+
+(defun menu-choices-for-presentation-id (id)
+ (multiple-value-bind (ob presentp) (lookup-presented-object id)
+ (cond ((not presentp) 'not-present)
+ (t
+ (let ((menu-and-actions (menu-choices-for-presentation ob)))
+ (setq *presentation-active-menu* (cons id menu-and-actions))
+ (mapcar 'car menu-and-actions))))))
+
+(defun swank-ioify (thing)
+ (cond ((keywordp thing) thing)
+ ((and (symbolp thing)(not (find #\: (symbol-name thing))))
+ (intern (symbol-name thing) 'swank-io-package))
+ ((consp thing) (cons (swank-ioify (car thing)) (swank-ioify (cdr thing))))
+ (t thing)))
+
+(defun execute-menu-choice-for-presentation-id (id count item)
+ (let ((ob (lookup-presented-object id)))
+ (assert (equal id (car *presentation-active-menu*)) ()
+ "Bug: Execute menu call for id ~a but menu has id ~a"
+ id (car *presentation-active-menu*))
+ (let ((action (second (nth (1- count) (cdr *presentation-active-menu*)))))
+ (swank-ioify (funcall action item ob id)))))
+
+
+(defgeneric menu-choices-for-presentation (object)
+ (:method (ob) (declare (ignore ob)) nil)) ; default method
+
+;; Pathname
+(defmethod menu-choices-for-presentation ((ob pathname))
+ (let* ((file-exists (ignore-errors (probe-file ob)))
+ (lisp-type (make-pathname :type "lisp"))
+ (source-file (and (not (member (pathname-type ob) '("lisp" "cl") :test 'equal))
+ (let ((source (merge-pathnames lisp-type ob)))
+ (and (ignore-errors (probe-file source))
+ source))))
+ (fasl-file (and file-exists
+ (equal (ignore-errors
+ (namestring
+ (truename
+ (compile-file-pathname
+ (merge-pathnames lisp-type ob)))))
+ (namestring (truename ob))))))
+ (remove nil
+ (list*
+ (and (and file-exists (not fasl-file))
+ (list "Edit this file"
+ (lambda(choice object id)
+ (declare (ignore choice id))
+ (ed-in-emacs (namestring (truename object)))
+ nil)))
+ (and file-exists
+ (list "Dired containing directory"
+ (lambda (choice object id)
+ (declare (ignore choice id))
+ (ed-in-emacs (namestring
+ (truename
+ (merge-pathnames
+ (make-pathname :name "" :type "") object))))
+ nil)))
+ (and fasl-file
+ (list "Load this fasl file"
+ (lambda (choice object id)
+ (declare (ignore choice id object))
+ (load ob)
+ nil)))
+ (and fasl-file
+ (list "Delete this fasl file"
+ (lambda (choice object id)
+ (declare (ignore choice id object))
+ (let ((nt (namestring (truename ob))))
+ (when (y-or-n-p-in-emacs "Delete ~a? " nt)
+ (delete-file nt)))
+ nil)))
+ (and source-file
+ (list "Edit lisp source file"
+ (lambda (choice object id)
+ (declare (ignore choice id object))
+ (ed-in-emacs (namestring (truename source-file)))
+ nil)))
+ (and source-file
+ (list "Load lisp source file"
+ (lambda(choice object id)
+ (declare (ignore choice id object))
+ (load source-file)
+ nil)))
+ (and (next-method-p) (call-next-method))))))
+
+(defmethod menu-choices-for-presentation ((ob function))
+ (list (list "Disassemble"
+ (lambda (choice object id)
+ (declare (ignore choice id))
+ (disassemble object)))))
+
+(defslimefun inspect-presentation (id reset-p)
+ (let ((what (lookup-presented-object id)))
+ (when reset-p
+ (reset-inspector))
+ (inspect-object what)))
+
+
+(setq *send-repl-results-function* 'present-repl-results)
+
+(provide :swank-presentations)
Added: branches/trunk-reorg/thirdparty/slime/doc/.cvsignore
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/.cvsignore 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/.cvsignore 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,15 @@
+contributors.texi
+slime.aux
+slime.cp
+slime.dvi
+slime.fn
+slime.info
+slime.ky
+slime.log
+slime.pdf
+slime.pg
+slime.ps
+slime.tmp
+slime.toc
+slime.tp
+slime.vr
Added: branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,9 @@
+/.cvsignore/1.1/Mon Jul 24 14:13:23 2006//
+/Makefile/1.12/Mon Sep 17 14:04:27 2007//
+/slime-refcard.pdf/1.1/Thu Aug 9 09:18:50 2007//
+/slime-refcard.tex/1.1/Thu Aug 9 09:18:50 2007//
+/slime-small.eps/1.1/Wed Nov 22 06:27:38 2006//
+/slime-small.pdf/1.1/Wed Nov 22 06:27:38 2006//
+/slime.texi/1.57/Mon Sep 17 13:44:48 2007//
+/texinfo-tabulate.awk/1.2/Mon Aug 29 20:02:57 2005//
+D
Added: branches/trunk-reorg/thirdparty/slime/doc/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/CVS/Repository 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/CVS/Repository 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+slime/doc
Added: branches/trunk-reorg/thirdparty/slime/doc/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/CVS/Root 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/CVS/Root 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+:pserver:anonymous:anonymous@common-lisp.net:/project/slime/cvsroot
Added: branches/trunk-reorg/thirdparty/slime/doc/CVS/Template
===================================================================
Added: branches/trunk-reorg/thirdparty/slime/doc/Makefile
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/Makefile 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/Makefile 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,97 @@
+# This file has been placed in the public domain.
+#
+# Where to put the info file(s). NB: the GNU Coding Standards (GCS)
+# and the Filesystem Hierarchy Standard (FHS) differ on where info
+# files belong. The GCS says /usr/local/info; the FHS says
+# /usr/local/share/info. Many distros obey the FHS, but people who
+# installed their emacs from source probably have a GCS-ish file
+# hierarchy.
+infodir=/usr/local/info
+
+# What command to use to install info file(s)
+INSTALL_CMD=install -m 644
+
+# Info files generated here.
+infofiles=slime.info
+
+TEXI = slime.texi contributors.texi
+
+all: slime.info slime.pdf html/index.html
+
+slime.dvi: $(TEXI)
+ texi2dvi slime.texi
+
+slime.ps: slime.dvi
+ dvips -o $@ $<
+
+slime.info: $(TEXI)
+ makeinfo $<
+
+slime.html: $(TEXI)
+ texi2html $<
+
+html/index.html: $(TEXI)
+ makeinfo -o html --html $<
+
+slime.pdf: $(TEXI)
+ texi2pdf $<
+
+install: install-info
+
+uninstall: uninstall-info
+
+# Create contributors.texi, a texinfo table listing all known
+# contributors of code.
+#
+# Explicitly includes Eric Marsden (pre-ChangeLog hacker)
+#
+# The gist of this horror show is that the contributor list is piped
+# into texinfo-tabulate.awk with one name per line, sorted
+# alphabetically.
+#
+# Some special-case TeX-escaping of international characters.
+contributors.texi: ../ChangeLog Makefile texinfo-tabulate.awk
+ cat ../ChangeLog | \
+ sed -ne '/^[0-9]/{s/^[^ ]* *//; s/ *<.*//; p;}' | \
+ sort | \
+ uniq -c | \
+ sort -nr| \
+ sed -e 's/^[^A-Z]*//' | \
+ awk -f texinfo-tabulate.awk | \
+ sed -e "s/\o341/@'a/g" | \
+ sed -e "s/\o355/@'{@dotless{i}}/g" | \
+ sed -e "s/\o351/@'e/g" | \
+ sed -e "s/\o361/@~n/g" | \
+ sed -e 's/\o370/@o{}/g' \
+ > $@
+
+#.INTERMEDIATE: contributors.texi
+
+# Debian's install-info wants a --section argument.
+section := $(shell grep INFO-DIR-SECTION $(infofiles) | sed 's/INFO-DIR-SECTION //')
+install-info: slime.info
+ mkdir -p $(infodir)
+ $(INSTALL_CMD) $(infofiles) $(infodir)/$(infofiles)
+ @if (install-info --version && \
+ install-info --version 2>&1 | sed 1q | grep -i -v debian) >/dev/null 2>&1; then \
+ echo "install-info --info-dir=$(infodir) $(infodir)/$(infofiles)";\
+ install-info --info-dir="$(infodir)" "$(infodir)/$(infofiles)" || :;\
+ else \
+ echo "install-info --infodir=$(infodir) --section $(section) $(section) $(infodir)/$(infofiles)" && \
+ install-info --infodir="$(infodir)" --section $(section) ${section} "$(infodir)/$(infofiles)" || :; fi
+
+uninstall-info:
+ @if (install-info --version && \
+ install-info --version 2>&1 | sed 1q | grep -i -v debian) >/dev/null 2>&1; then \
+ echo "install-info --info-dir=$(infodir) --remove $(infodir)/$(infofiles)";\
+ install-info --info-dir="$(infodir)" --remove "$(infodir)/$(infofiles)" || :;\
+ else \
+ echo "install-info --infodir=$(infodir) --remove $(infodir)/$(infofiles)";\
+ install-info --infodir="$(infodir)" --remove "$(infodir)/$(infofiles)" || :; fi
+ rm -f $(infodir)/$(infofiles)
+
+clean:
+ rm -f contributors.texi
+ rm -f slime.{aux,cp,cps,fn,fns,ky,kys,log,pg,tmp,toc,tp,vr,vrs}
+ rm -f slime.{info,pdf,dvi,ps,html}
+ rm -rf html
Added: branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.pdf
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.pdf
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.tex
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.tex 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.tex 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,123 @@
+\documentclass[a4paper,10pt]{article}
+
+\usepackage{textcomp}
+\usepackage{fullpage}
+\pagestyle{empty}
+
+
+\newcommand{\group}[1]{\bigskip\par\noindent\textbf{\large#1}\medskip}
+\newcommand{\subgroup}[1]{\medskip\par\noindent\textbf{#1}\smallskip}
+\newcommand{\key}[2]{\par\noindent\textbf{#1}\hfill{#2}}
+\newcommand{\meta}[1]{\textlangle{#1}\textrangle}
+
+\begin{document}
+
+\twocolumn[\LARGE\centering{SLIME Quick Reference Card}\vskip1cm]
+
+\group{Getting help in Emacs}
+
+\key{C-h \meta{key}}{describe function bound to \meta{key}}
+\key{C-h b}{list the current key-bindings for the focus buffer}
+\key{C-h m}{describe mode}
+\key{C-h l}{shows the keys you have pressed}
+\key{\meta{key} l}{what starts with \meta{key}}
+
+\group{Programming}
+
+\subgroup{Completion}
+
+\key{M-tab, C-c C-i, C-M-i}{complete symbol}
+\key{C-c C-s}{complete form}
+\key{C-c M-i}{fuzzy complete symbol}
+
+\subgroup{Closure}
+
+\key{C-c C-q}{close parens at point}
+\key{C-]}{cl}{close all sexp}
+
+\subgroup{Indentation}
+
+\key{C-c M-q}{reindent defun}
+\key{C-M-q}{indent sexp}
+
+\subgroup{Documentation}
+
+\key{spc}{insert a space, display argument list}
+\key{C-c C-d d}{describe symbol}
+\key{C-c C-f}{describe function}
+\key{C-c C-d a}{apropos search for regexp}
+\key{C-c C-d z}{apropos with internal symbols}
+\key{C-c C-d p}{apropos in package}
+\key{C-c C-d h}{hyperspec lookup}
+\key{C-c C-d ~}{format character hyperspec lookup}
+
+
+\subgroup{Cross reference}
+
+\key{C-c C-w c}{show function callers}
+\key{C-c C-w r}{show references to global variable}
+\key{C-c C-w b}{show bindings of a global variable}
+\key{C-c C-w s}{show assignments to a global variable}
+\key{C-c C-w m}{show expansions of a macro}
+\key{C-c \textless}{list callers of a function}
+\key{C-c \textgreater}{list callees of a function}
+
+\subgroup{Finding definitions}
+
+\key{M-.}{edit definition}
+\key{M-, or M-*}{pop definition stack}
+\key{C-x 4 .}{edit definition in other window}
+\key{C-x 5 .}{edit definition in other frame}
+
+\newpage
+
+\subgroup{Macro expansion commands}
+
+\key{C-c C-m or C-c RET}{macroexpand-1}
+\key{C-c C-m}{macroexpand-all}
+\key{C-c C-t}{toggle tracing of the function at point}
+
+\subgroup{Disassembly}
+
+\key{C-c M-d}{disassemble function definition}
+
+\group{Compilation}
+
+\key{C-c C-c}{compile defun}
+\key{C-c C-y}{call defun}
+\key{C-c C-k}{compile and load file}
+\key{C-c M-k}{compile file}
+\key{C-c C-l}{load file}
+\key{C-c C-z}{switch to output buffer}
+\key{M-n}{next note}
+\key{M-p}{previous note}
+\key{C-c M-c}{remove notes}
+
+\group{Evaluation}
+
+\key{C-M-x}{eval defun}
+\key{C-x C-e}{eval last expression}
+\key{C-c C-p}{eval \& pretty print last expression}
+\key{C-c C-r}{eval region}
+\key{C-x M-e}{eval last expression, display output}
+\key{C-c :}{interactive eval}
+\key{C-c E}{edit value}
+\key{C-c C-u}{undefine function}
+
+\group{Abort/Recovery}
+
+\key{C-c C-b}{interrupt (send SIGINT)}
+\key{C-c \~}{sync the current package and working directory}
+\key{C-c M-p}{set package in REPL}
+
+\group{Inspector}
+
+\key{C-c I}{inspect (from minibuffer)}
+\key{ret}{operate on point}
+\key{d}{describe}
+\key{l}{pop}
+\key{n}{next}
+\key{q}{quit}
+\key{M-ret}{copy down}
+
+\end{document}
Added: branches/trunk-reorg/thirdparty/slime/doc/slime-small.eps
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/slime-small.eps 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/slime-small.eps 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,995 @@
+%!PS-Adobe-3.0 EPSF-3.0
+%%Creator: GIMP PostScript file plugin V 1.17 by Peter Kirchgessner
+%%Title: slime-small.eps
+%%CreationDate: Tue Nov 14 18:44:25 2006
+%%DocumentData: Clean7Bit
+%%LanguageLevel: 2
+%%Pages: 1
+%%BoundingBox: 0 0 252 104
+%%EndComments
+%%BeginProlog
+% Use own dictionary to avoid conflicts
+10 dict begin
+%%EndProlog
+%%Page: 1 1
+% Translate for offset
+0 0 translate
+% Translate to begin of first scanline
+0 103.29540259080517 translate
+251.14960629921259 -103.29540259080517 scale
+% Image geometry
+248 102 8
+% Transformation matrix
+[ 248 0 0 102 0 0 ]
+% Strings to hold RGB-samples per scanline
+/rstr 248 string def
+/gstr 248 string def
+/bstr 248 string def
+{currentfile /ASCII85Decode filter /RunLengthDecode filter rstr readstring pop}
+{currentfile /ASCII85Decode filter /RunLengthDecode filter gstr readstring pop}
+{currentfile /ASCII85Decode filter /RunLengthDecode filter bstr readstring pop}
+true 3
+%%BeginData: 57552 ASCII Bytes
+colorimage
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcDnQp&=1TJ,~>
+JcDnQp&=1TJ,~>
+JcDnQp&=1TJ,~>
+JcE=]rVd0(rr2loqtg-`p\+IV#PRoeq>:*grpKf:~>
+JcE=]rVd0(rr2loqtg-`p\+IV#PRoeq>:*grpKf:~>
+JcE=]rVd0(rr2loqtg-`p\+IV#PRoeq>:*grpKf:~>
+^&S*2K`;\ar;-0]p@n@Wp@RnBl/gp^gtM_[%,0ImiT04hnFZMQrVl?eJ,~>
+^&S*2K`;\ar;-0]p@n@Wp@RnBl/gp^gtM_[%,0ImiT04hnFZMQrVl?eJ,~>
+^&S*2K`;\ar;-0]p@n@Wp@RnBl/gp^gtM_[%,0ImiT04hnFZMQrVl?eJ,~>
+_#FK8r;$?d!r;cn\,QX2rVZTlrpKdkrquWgqYU6joD]L&q=<e0hVR5Pj58P;ahkZtYGnAsUCF&u
+Xg>RRajSr)m.C/Qo)F4~>
+_#FK8r;$?d!r;cn\,QX2rVZTlrpKdkrquWgqYU6joD]L&q=<e0hVR5Pj58P;ahkZtYGnAsUCF&u
+Xg>RRajSr)m.C/Qo)F4~>
+_#FK8r;$?d!r;cn\,QX2rVZTlrpKdkrquWgqYU6joD]L&q=<e0hVR5Pj58P;ahkZtYGnAsUCF&u
+Xg>RRajSr)m.C/Qo)F4~>
+_>al?q!dM,hr<khq#'=Ts8E&tr;?HlqY^3lr;HTmrp0RjrquQ`naQ,CqYg!b$NBttna#E'me-GU
+p&>['q!?_R[B6U<\@8]>TW+a/a2[rL%+WD>YGn1p]$&prp\j^`J,~>
+_>al?q!dM,hr<khq#'=Ts8E&tr;?HlqY^3lr;HTmrp0RjrquQ`naQ,CqYg!b$NBttna#E'me-GU
+p&>['q!?_R[B6U<\@8]>SYMdk^:j@0%*ZE"VkT`^]$&prp\j^`J,~>
+_>al?q!dM,hr<khq#'=Ts8E&tr;?HlqY^3lr;HTmrp0RjrquQ`naQ,CqYg!b$NBttna#E'me-GU
+p&>['q!?_R[B6U<\@8]>V6mGObffhD%+WSI]!S?7]$&prp\j^`J,~>
+h>[WWrVZQgrV-NkqY^<ko`#?tp?:)F[BI!Uf')i*lMh(eqtTjUnF$;Brp0RM%di]RoCV_Lp\=R\
+qu$Elo)B*rq=<_'da6P&m.UALrs\o'o&\EB_8O^YmeHbTrs\o'mFAPViU?6RSZ0Nnmg%djUU8G5
+p\jaaJ,~>
+h>[WWrVZQgrV-NkqY^<ko`#?tp?:)F[BI!Uf')i*lMh(eqtTjUnF$;Brp0RM%di]RoCV_Lp\=R\
+qu$Elo)B*rq=<_'da6P&m.UALrs\o'o&\EB_8O^YmeHbTrs\o'mFAPNg$@t9Q_M(XlNc+VT=!#1
+p\jaaJ,~>
+h>[WWrVZQgrV-NkqY^<ko`#?tp?:)F[BI!Uf')i*lMh(eqtTjUnF$;Brp0RM%di]RoCV_Lp\=R\
+qu$Elo)B*rq=<_'da6P&m.UALrs\o'o&\EB_8O^YmeHbTrrrDumFAP[rlbJ^Vm=2*bQc%f[*e.4
+rUg,?~>
+i;XMjrVH<]nEfB#j5]4`lgOH>q>C3jq>Us'pZTo*]]&><]WTQDp\jIY$N0Yek2"S6bK.`Erl4rX
+&]r8De_&U3i8`tbmIBiCqYgEerser%mFoFYYH=n8d,t$!pAYX%qXE=XWP-?nW4LRHq>U0h%/ohS
+[aX<je^`UCkMY^W#he/'d]LsbqYp0fJ,~>
+i;XMjrVH<]nEfB#j5]4`lgOH>q>C3jq>Us'pZTo'Ze=ZtZ`DC8p\jIY$N0Yek2"S6bK.`Erl4rX
+&]r8De_&U3i8`tbmIBiCqYgEerser%mFoFYWMcZ'd,t$!pAYX%qXE=XVR4(PUUo%Cq>U0h%/ohS
+[`n%#kND*rlfmd!#jCO?bH'(YqYp0fJ,~>
+i;XMjrVH<]nEfB#j5]4`lgOH>q>C3jq>UWspZTo0_>_X^_6_GNp\jIY$N0Yek2"S6bK.`Erl4rX
+&]r8De_&U3i8`tbmIBiCqYgEerser%mFoFY\[SrTd,t$!pAYX%qXE=XXhr)uZ+ANQq>U0h%/ohS
+[`cFp[C*Zc_S#6C#e.Ieb-TO`qYp0fJ,~>
+ir9kpr:omMj4hu'_7R1c\\?)/fAPl]p%eObqu70'nC=YujOr):jPR)inGDVQ#lOAYeA&,YUT+6j
+rMKRl&ZM@nU8Fur\%T]%dFmOFo_SR^rt#,*mFJYMn*93*d]1LSp\jjd&,YqR];b5Zi8F"CZIeRB
+rqZR'qsDY1lH-<4XLlTm]<(D##dM"dh:&pnpAO[aJ,~>
+ir9kpr:omMj4hu'_7R1c\\?)/fAPl]p%eObqu70'nC=SolKIEplJ&AinGDVQ#lOAYeA&,YT;)+R
+&tu(iSt`*_Z+%Eab0eo%lh(&Qq#:m(qX)k@WpB$<mE;ENkkG&Mrt#"th7KHKlKRR#^9ZAZqu6Ek%
+/]G:VsNL&hr!DRj5K@^#iO\'l-$WrpAO[aJ,~>
+ir9kpr:omMj4hu'_7R1c\\?)/fAPl]p%eObqu70'nC=kd^ULV[^W<b3nGDVQ$iK\\eA&,YXL#19
+Yl1d*YS+4IURn3WX0K.I_ogB[ip675rqQL(rqc$5[(=K"`5g$'bNS^!p\td$o%gpab.kU%a2YF:
+n,*+[rsekmc*tWnTq@sSXfJ=km@FTWVQdYS\`*8\p&BO~>
+jSp5!r:odDfu^e(TW#$4`5KX*VPBrn_U.-&nbE%]rr3Q/q<,T+jM8%%Z,#G4_<:Xnn,E[lpZKc$
+a7&Kap$)PFrpL<S_o0']WM$/ubMVgcrqZR)r:8UMa62!paj&Z!WmpM7q#:p(p>j&hlI!DZ]?TEJ
+]]&S_qYq$(q<,Q6i4G)-M3+3lOR.f0N0'^WmB"n/r:U)?~>
+jSoYfr:odDfu^e(SYE!prk&ZETV&$d_U.-&nbE%]rr3Q/q<,T#lJgaZi8X%._<:Xnn,E[lpZKc"
+^?b+Po^)SC%GA>*Yb%S[Vmjk,nG<.[rt#%ugU4c]kN(^cl.W)cn,)n[&H2=`_5$AZio/kXlE\(]
+pAOjf%K?1d^qT'lg=Os1gtUQLf*L$_h<"%&f(&\2s*t~>
+jSoYfr:odDfu^e(V6RMKrko5ZYH4P+_U.-&nbE%]rr3Q/q<,T1^SmiuTr>`A_<:Xnn,E[lpZKc*
+`luZIou$jQrQG\e`4`=ZUo1]FhsgLAq>V!'o%URl_R6MJYe%o[eF3;0rt,/&jMA1@ZDaXtYeRud
+iV*6Hrso&(kJ5*MVO*gCQ^<u(SF)jQS!TSJa0jLgr:U)?~>
+jo5bfq=3Rs^o=!Gi9omnrSSgZlL"&YYFr&9f&uZ$rr<#tp><.DeZ=^dN2tLtZ/>9Sn,E[jn'nDq
+i76B&ouR3]rm_J2i8E\]lL+,hXhEQ]r;-F*rqPZpWTqU,S"$+djLMq`p\t!g&GtqFVs_s0PE:m'
+dI*aUmeck\%0$%_\AdC<OF21uK7NrKs+:9-!/p]8re^Z,$@I,DJssdGY0lb:p&BO~>
+jo5bfq=3Rs^o<g:g$J(krTPHim-X,NVk(!.f&uZ$rr<#tp><.@kMOqDf\blXZ/>9Sn,E[jn'n>j
+l0%6kp#H,8roXCIl07L4liue!VnLpWr;-F*rqPZpU?psugt^`FlE\(_p\t!g#5dl<V!R7#rn7S5
+k3Sbfmeck\%0$%_\@h(bg="<qeC4EFs4%)#!8./%rn%2"$I[>KeD0-OVpY#3p&BO~>
+jo5bfq=3Rs^o=9Obf[l@rOa8f`5g*>\>6:Ff&uZ$rr<#tp><.![@`qYS"@%3Z/>9Sn,E[jn'nV`
+]X>/OorS5"rj<3E]Y)"t`6-<H\%UVgr;-F*rqPZpZc&u<Q^=/>^V@GAp\t!g&GtqFXNIi=QC!r.
+ZH9&lmeck\%0$%_\AZ%WQ`IKoUS[sjs.fUb!1WhPrgj(a$EL>7UR/+$\'a^Cp&BO~>
+kPl%kr:]F/_5=EomGQ[Fai+.i+Mc+De_oWYdBTXhhspRBs8DWFVsi0;M04ZUeaKEjp&4C[$3'b_
+^rPBFXK8,gRfK>bX:DMI]>2P1dFI(<^;T1/rql^-r:8L?i7YAoK7f#]eaK<anbi7`')q^i^q/UB
+PC(a)n.P/$(f]]Akequ7B0pYrX"i4G(uBk_L(Jr,SXR]EKoqRZ[,s-a:VNerU]aQg"Znbi([J,~>
+kPl%kr:]F/_5=0amHNisjQ$3t+QDJDkNV=!af25XhspRBs8DWFVsEO'f?`(+kNf&#p&4C[$3'b_
+^q]-mhr!8_g]641h[\T'iSrqZk3)!q[`%>'rql^-r:8L?g$%AHeC<+-kNeqonbi7`')q^i^p<7b
+g=+Kug>_D&]]Akequ7B0pYrWol/C@Eb0%rPeCWF0gu%#IqVhG2s4dt8g"4j2jQrnrnbi([J,~>
+kPl%kr:]F/_5=`da1SmeXfMDt+K2EH[CjB!agn@hhspRBs8DWFVp)Q@S@"iY[EPQ'p&4C[$3'b_
+^rO*bT:_SFQN3QTT+7QlVPpW!ZF.9^_o1^4rql^-r:8L?bdX:8USFBO[EPGsnbi7`')q^i^qd^`
+QDgj_QDhR4]]Akequ7B0pYrX!]V_$raiV93URdd=Q_'eBqPO7`s-F([R(a)Tn8Xi.d"nbi([J,~>
+kl21mqXW[jYG^=Ag!..6VONkLO<BaVTrblEdG=!DXM<]cr;Z`ffq\#dXGM(VX4?[6g%>74rsA]!
+iNr"'XGMdfon*7"reV,DOH>ZqS#39qeaKToo_n^f'E7jn`i87FRtGWtJssdGVoS*!rql^.rUo!M
+dG;6kH>.S]Z.\'7g%51>rtPJ-j0lna]9%DS>]54_X1HBne^`@Li;V:,a9oMeX/ii!jIG&urUp2@~>
+kl21mqXW[jYFsS7kiLd]hV?l`g)o,+hr3VXl0I$"^Ynb^s8DTCU[.+#f?`(+kNenro_n:Z$3'\X
+Zg6f3f@SRGe,\)!f)XJ&gAfq6hV[;Tl`Ak5rVZ[/rqbp"U?psreBH.dguRgqa6NO#qu7<-p"cgo
+l/C=Cb0\f!kh2rgoDSRd'`Rmf[_1k`g="-?bgbG*iT0(_kNMd,roa=Bs5F"8#3"t'QJM33p&BO~>
+kl21mqXW[jYHc<g\$2a'S<oN>QQVT\R\-IXZF[os[D1Ylr;Z`ffqZd!T:E9ZT!ce;g%>74rsA]!
+iNpb9T:DFFoqMMYrgXIfQ^=#)Q^j\C[EP`,o_n^f'E7jn`j3ObQ_V:/UR/+$YfH&*rql^.rUo!M
+ah"78Y0!r<Tsr7Fg%51>rtPJ-j0ln=VO+@*`4r(6Su/Wl[C*L?]`,>=XU:r#St;h"fsBN,rUp2@~>
+l2M=oqXE=XUVuHN`3H"tN/*%9rHo`:K8#/DQ);".g$5``lh^VZo[oo,eZ=UMM6#1qU=f,:nG`am
+pY`=FeZ=W(K)0BuF*2bUG^OmfK7er9R`Octe+*A6rtGA)i3^G\]9%DSBRGoQi5E+ap\t'i')_:K
+TC:=3M03<JKqQ]XUWr6(qu7W7puK!)i4G(uBlATlaOT56lL43!_SEt)_na(en,MY[i8)r6i9cK,
+lM:GPs*t~>
+l2M=oqXE=XTtKaUj5AbIf[eR$rR)h;eCE1)gYUoLkj57klh^VZo[oo(kMOn;fAGcWU=f,:nG`am
+pY`=BkMOnfeG@B%cHjndd*g@keC<($guRh$e+*A6rtGA)i3^/]iS)`&ajSo%l+FLbp\t'i')_:K
+TBk[tf?_"Pe_T?ST?Zg$qu7W7puJuul/C@Eb08AjjQGdom-Euj]!f)[]=,0Ili6;Yl0.<nl0Wu"
+lM:GPs*t~>
+l2M=oqXE=XWPl`aX.buKS"?COrMq'>US43EQ(4VM\&>c!lh^VZo[on^[@`trSY!75U=f,:nG`am
+pY`=#[@`ucU\_\;\$W<=Z)aq(USFENQ`\3:e+*A6rtGA)i3^G8VO+@*b,^o,]Yh5<p\t'i')_:K
+T?O^8S@$>KTpi4+XNg21qu79-puK!(]V_$rahOU;XgPg[`;[sb_8jX6_T0^rbl>Tg]XkMY]Z7S&
+lM:GPs*t~>
+lMhLrq<ltJU#+_LZ'C9%I!BpeJqs>^+GGDrH$k-tNg6m"n%.TTrr)KAU@6X6M04ZUeaK6bo_n:Z
+#QFM[][>QDT_b)XJoCQl!b$#!r/(B(#,]f9YL;q<r;RH.n^X?%eZ=UM(a)q9eAZ.\'6g%>7?rtG7p
+aJ\=FRtGWaCk.ehkH;Ybq>U<l.fT8,^8^;6Q%3e)R`Od-_ip@!CNQauDmZliDJX'$Q(l+An*e,M
+I_bURo`'F~>
+lMhLrq<ltJSD*5gi7lo7da6CjeCOWN+P"uidF-Lpg"YHJlal0Prr)KAU?h""f?`(+kNekpo_n:Z
+#QFM[]ZKEsh>5n-eBIif!jg,#r7Cns#2\M/WRC;6r;RH.n^X?!kMOn;\\?GCi98jmg%>7?rtG7p
+aJ%t]gsjQFbL>5+l__M^q>U<l.fT8,^7X`OgXFBrguRh/]7l#@=_+^A?F7(F>Zt61LRbiolg)'+
+DS#K<o`'F~>
+lMhLrq<ltJWQ2ZRTp;+@X0Jh)US%OV+JGR/Y,eCjR?aJRbdum1rr)KAU<L$;S@"iY[EPAto_n:Z
+#QFM[]Zds^Rei?OUV?ZF!li!Mr13e]#+W!(a)]$g*Gr;RH.n^X>W[@`tra2kNTTsr7Eg%>7?rtG7p
+aK`[cQ_V:6_PWU!_RIAFq>U<l(]O6n^:M1^Q)26jQ`\3B_RmL`Yd(C=[JmNDZa$a:]rT5tbfn2@
+]@Z]Qo`'F~>
+li.Xtq<lnDVsVmDRuDlBF+/n$Q("TLX!"((P)bBSJqBZ,i:488p\t-`fV7ibXGM(VX4?[5f_#.2
+rs&>ecA:l@c2,KfRt>Q`91rN.JsuV<rL*qfdI*[[oDSUe'Dh%9W9VKoK5Y"&F,-X?m[qkpr;?R/
+rqPQc\E(GhIVW)"I#tqt_mSLurqudGrqblrS*J+bK7]Q5lAK2SF*;eSL>RB+iSf03H[9p[_/X@p
+DfU)Zc27M4s*t~>
+li.Xtq<lnDT^Cn#gt:*&cI1:qgYCZbh]Ub1g=b*/eC<=5l0>_:p\t-`fV7]phq-3+hrj="f_#.2
+rs&>ec?\g(a)jne$EgsjQEBP=6deD0uZrS.V6k3SPhoDSUe'Dh%9U?psreBFepcIUk7m$uGkr;?R/
+rqPQcYNk-$e'"0$db<[E]X?bnrqudGrqblrOmM/aeC<:7m!_j6@:Wt`G2I%MiSeNdBkV*h_-^HL
+?!q8ia8>l.s*t~>
+li.Xtq<lnDYfF&HQ^ahV\>Z$jQ'\$?SfjJgQC4;9USF9T][XCLp\t-`fV6TtT:E9ZT!ce:f_#.2
+rs&>ecF_-+YkkI.Q_V:5]tMA!UR1nMrKd_YZH9E)oDSUe'Dh%9Z,Ec2UV=^e\=]:saeR5Or;?R/
+rqPQc]t^M3W5ZZsX-fcs_mSLurqudGrqblr[)B)5USF0X`3cMF\@]Gh_r&;IiShVh^q[Rp_7$_Q
+[(!`gjSSrKs*t~>
+m/Ie!qXE4IV<Z=&OFqdrIYWcWX2N*,rm`.9aM50aVOEsH]'dSQk5##To[oo,eZ=UMM6#1qU=f,:
+n,EUjp#:(\iU-L,$-AZgDd6OcJssdYec!PndFH75jS/ZPrtYP.jh&%`^ls4_=^5lsR`Ocj`9R3u
+rVmT1p"Z[sh6r>iB2rJdMm:snWnd:Gqu7Q1lG]=Zad[p7R`OcVDUX#aJV&sWK7ipmKDpH1JUls4
+I,97"J<87ZoDa=~>
+m/Ie!qXE4ITBt[rg=4Kndam%,hrEe[roYEcjPo.UhV?oBiU".jk5##To[oo(kMOn;fAGcWU=f,:
+n,EUjp#9G<g?nb'$09mkbbh5\eD0-_kPaHGk3'LOjS/ZPrtYP.jh%_]inDl)RAJ-WguRgo`9R3u
+rVmT1p"Z[ll/C=C`JhOXf\kuHWnd:Gqu8)@lG\tRjP887guRgS>gmJ+DfC7$EH1aIEH,r:Df4cS
+C>N]ADLg"2oDa=~>
+m/Ie!qXE4IYJdZ8Q_Uh#W1TWNSu]!!rj<lQXf/"dS<oS2VTI6#k5##To[on^[@`trSY!75U=f,:
+n,EUjp#<NtbfBRu$*BPh^;Rt)UR/+\[Jd33ZF.Q_jS/ZPrtYP.jh&4@W0XC$_o0<bQ`\3/`9R3u
+rVmT1p"Z[k\tb[rahc''S"[=8Wnd:Gqu8)@lG^0LXd>fXQ`\3:ZdZe1`lH?uaN4,MaN2EB`l7/Y
+_;<#G`Qd]IoDa=~>
+m/IdtoA@0XlH,`THuEqGM5I?$e`Z5crpLuslK$dOdE'DRea@b2med"^o[oo,eZ=UMM6#1qU=f,:
+n,F7(qso,XGH%U-Pbt7>Q)D`nK5Y[[R`NR_rU9^M"n&Y&\FBCnrtYM*hQG8^[Z5ZH<E<d\OLjAg
+\`EPbrVmT0n^F)ueZ=UM@o6]XM6#1qT[iW3qu73'lc,L\ad[p7R`OcYF6%rPKE[S=Kn]O*re:?)
+#l91+p4J!NP1K4(J,~>
+m/IdtoA@0Qm,[!Rd`fq]fA>EIkNhL$rp(]om-<ftk2bUbkNlp1med"^o[oo(kMOn;fAGcWU=f,:
+n,F7(qsnN5B;D;XL7b&iO.YLgeBH.dguQG\rTjCJ"K/W4nGE.`(&dg^Y0-"fg!RctOic&*iT\"c
+jS8`QrtPD$e"5mghq-2bI^m_Uhrj<ueai\9rttUu`focMgsjj/jQqS/jD]-[F+aI5F8l1;F8p7d
+qJgNKEH-#Od.73e~>
+m/IdtoA@0a`3#K"X1l?USXc:W[DKl(rlcM*`4rmkZE:75[E5l)med"^o[on^[@`trSY!75U=f,:
+n,F7(qsqV9['?sN]W\HKT!b\eUV=L<Q`\!;rQP5Y"j+Tfd.$r1rtYM*hQFu3URA:,_8=?qR&7O7
+\`EPbrVmT0n^F)R[@`tra1o[%SY!75T[iW3qu7N0lc-BOXd>fXQ`\3<\E(]Pai`!0b0'__rQ>/^
+#l;W`p;k=sd-^E(J,~>
+mJf3GpufYlmEM>YF(oQ8M6#%Sma%ntS"+2]Kp9'nn*]K+mGF7PjS&QPrUea:n("LrFc!0Ln"SJ,
+rU0\3rqh:sLXXIiFiM79Q&Y(NRtH<]aQe[mBPM7MQBd`$HZRi\q>U<l(&d^SU@6X6M03<*<+^E9
+[b]?6hY-sIrtP=qa/A4ERtGWa9jVgnTZukucL:Z-rt"tl`guD:RtH<]aQf"3l(a)f.j"dAt?L&_2M
+K`h@/L&V(*!L)+*s*t~>
+mJe4+pufYhmH*0ScH=AWfAG`Rm)YrVR@I?IG(m-?li-5fmFmD,jS&QPrUea:lf[0Wce%(;l_<&(
+rU0\3rqgYOGLOcGA&c>kQ%//]gsjj/jQq=l<`iImLkgbBC15c3q>U<l(&d^SU?h""f?_!VMT!oq
+iTSCdhY-sIrtP=qa.Ve[gsjQFDQD%4h<"$qcL:Z-rt"tl`focMgsjj/jQqV2l>llF"bZhrF8u:;
+Es)G`F8l/[!JAbis*t~>
+mJf3GpufYta0;#+\&lClSY!-paiCa#Tq&9S\@]DsbfRfAa3)0.jS&QPrUea:bdF(5[%3erbbEb^
+rU0\3rqjaS`7)rA]#MRoQ*nQ4Q_U=BXi.TFXfnps^:h4p\%()Kq>U<l(&d^SU<L$;S@$>O_9&jJ
+UUnOLhY-sIrtP=qa0ERbQ_V:6]u@UWR]si4cL:Z-rt"tl`jWgfQ_U=BXi.l`lH0%J"jm:lb5_M=
+aoh[db5VC_!RU6)s*t~>
+mJf3DnC=Jqfs-K\AT)sQX4?XAG&4^3cI7'eG'(<5CNukFWNp\qoDARfrUea:n("LrFc!0Ln"SJ,
+rU'V0re,obna:pXlK*8mYiNT`IY+$0lB,q,H$Rh^G'8(UIdkeaqu7E.m`hKnc(Ti2?VO@+Fc!0L
+n"\M+rVlg3rqGKa\E(GhIVW(Z>]54_aQfYBlh^MY&,PV3Sa+=dK7]Q5lBHGWK`6Z/PQ->js8VtM
+"94(/s8I]QPLf=)J,~>
+mJf3DnC=Jjkht+?^Wb-Xhrj@&AQlWScI6FSAR`5U=_FOdV6XWIoDARfrUea:lf[0Wce%(;l_<&(
+rU'V0rc<(0na::4lK)Z\V<['oe(!16m"8PRB4oY(A7T7bD",[Iqu7E.m`h?jjk\J3XDiQsce%(;
+l_E)'rVlg3rqGKaYNk-$e'".kV9IHEjQrPZlh^MY&,PV3PO.AceC<:7m"T$9ErL+`KE$"6s8Vt;
+"93F`s8I'?K@'2hJ,~>
+mJf3DnC=J]\"T:raM4dHT!c\TZ*LpOcI9MU]XbV[YdCdOZ*M!YoDARfrUea:bdF(5[%3erbbEb^
+rU'V0rlW=,na=B8lK,a^`4r7:W2#]]`4<4d^:r%.]=Y_j_slphqu7E.m`hfQYaV8s`P0+-[%3er
+bbNe]rVlg3rqGKa]t^M3W5ZZe`4r(6Xi.E_lh^MY&,PV3[`#;7USF0X`4W\Iao9Edd/V82s8Vu=
+"96Nds8L.Ad-^E(J,~>
+mf,?IpZ9/nkJWX9D/Xf`X4=@sDfpBeJ+)r[nUQ,NI!U%_GLYK!K)>QIs8DTBU@6X6M04ZUeaK6b
+o_n.Vs+M8Pr;2/#q=B!@_;MqeI"e6<m?D^@JV!@iJ-1CUqpkTD(B40p_klY?RtGWa928l9LSiJe
+S^6d&rr3c4o\-=lh6r>iB2qN,Ck.ehkH)G]q>U<l&,PV3Sa+=dK7]Q5lBHGWK`6Z/PQ->js8VtM
+"94(/s8I]QPLf=)J,~>
+mf,?IpZ9/glf6aKbfnMhhrgeI?"@X0D=@%7nSW4*C1q5)A^oRRE;TY7s8DTBU?h""f?`(+kNekp
+o_n.Vs)T97r;1MTq=A@.\*;l*dad18m=o(cDf>/aDJjB3EVn)ZrtbV1l,0+ZjP88/VJ(+WcIUk7
+m$c8hr;Q^3rUegDam%d;dD_&OT$,U;j6NPVkP>,Trt"tl`focMgsjj/jQqV2lZ2uG"bZhrF8u:;
+Es)G`F8u5\!JAbis*t~>
+mf,?IpZ90"_Q/ru_S<.=T!c;<[(F*6`:*9;n\rH._8!\/][YfVa8>l9s8DTBU<L$;S@"iY[EPAt
+o_n.Vs2lG1r;4UXq=DG0aLnC:X.buda1]%#`l@Pg`Poj;aSYB%rtbV1l,0[BXd>fs`P'"*\=]:s
+aeI,Mr;Q^3rUegDah"78Y0"Mm_nr:9X2;9ZkP>,Trt"tl`jWgfQ_U=BXi.l`lcK.K"jm:lb5_M=
+aoh[db5_I`!RU6)s*t~>
+mf+X3o%0etfs-K\Dg[YXeW=TiH[gYBK`(e%r.KauJqARBJFW;bK`:uN&H27RU@6X6M04ZUeaK6b
+o_n.Vs+M8Qs8Re,rqCiK_;MqeI"e6<m=oh8KS9:$KE?l-f),I_rqPQb`Se@iHtcYO93cCeR`Ock
+`p<L#rtbM#c_'XQVMB5$:IS;tI#tqt`4+e%rqud,qWc%jlH,NJJssdGP]c;Fre1N>s+Q1,s8.KP
+s+Q1,re1B:f(/ik~>
+mf+X3o%0emkht+?bgP5(kCZrJBl.haEr>lWr,QiQEH#jbDt3L?F8l1=&H27RU?h""f?`(+kNekp
+o_n.Vs)T!/s8R.]rqC39\*;l*dad18m<<,ZEcV*VErU1]s3UZC(B4*i\\.1cg="-,;J)cLeD0-O
+T>p3nrr3c2n'@Njk2+\7ZZf6.ajSo%l+FLcq#:3k&,PS1PO.AceC<:7m"T$9ErL+`KE$"6s8Vt;
+"93F`s8I'?K@'2hJ,~>
+mf+X3o%0e`\"T:r^T3a![C*<O^r4:gao)+[r5m(UaN)<h`pr`Cb5VD?&H27RU<L$;S@"iY[EPAt
+o_n.Vs2l/)s8U6arqF:;aLnC:X.buda18k%aiXJZaoBKas6]^`(B4*i\\u.XQ`J6F]"GtrUR/+$
+YK#o)rr3c2n'@fPZCIMq`kK%$b,^o,]Yh5=q#:3k&,PS1[D]26USF0X`4W\Iao9Edd/V82s8Vu=
+"96Nds8L.Ad-^E(J,~>
+mf+U0lc?'jad[p$I#tqtNbs#iJqSgVL&_1,s+Q1,KnP-WK`(h'L&M#_rUea:n("LrFc!0Ln"SJ,
+rTsRaKbosQs+Q1+pO'9_i4G(uM6#1qBR#)]L&_%(!WUaJs"OHGhQOiT]9%DS=%5\^C4;>\jLDnc
+q>UEnq<,SskJWX9D-KS#<bQlB]&:H/htI'Jrt,2+l,0%Vad[p7R`OcYFmF_[Ka!\?Kn]R,qh5.P
+Kn]R+K`RCgo)F4~>
+mf+U0lc>gejP88/db<[EJQl`&E,p%!F8u8]s)W8]F)uC"Er>oXF8c+MrUea:lf[0Wce%(;l_<&(
+rTsRaEu0K/s)W8\pM7(Cl/C@EfAGcW<bH>kF8u,Y!WUODs"OHGhQONTiS)`&P#>DLbL5,(lEIta
+q>UEnq<,Sllf6aKbb&<?Oic&*iT[qWhtI'Jrt,2+l,/\NjP887guRgVA*\17Es73rF*%B]qf;l>
+F*%B\Ergp?o)F4~>
+mf+U0lc?BMXd>fsX-fcsZa.9^a2uL'b5_Las2rLab0%j(ao).\b5M>OrUea:bdF(5[%3erbbEb^
+rTsRaaqrG)s2rL`pVO5W]V_$rSY!75Y.hotb5_@]!WVQas"OHGhQOf/VO+@*_Rd@s`i,3%^V.>C
+q>UEnq<,T'_Q/ru_Sj*u_TJpHVS'aKhtI'Jrt,2+l,0pIXd>fXQ`\3=]'IK;ap$/lb0'baqoT$@
+b0'b`aoTlVo)F4~>
+n,FF-puK!)i4G(uI#tqtcXh3IJqSf2s+ULQL&Zj\s8I]Us+ULQKn]L*&H27RU$pO5M04ZUeaK6b
+o_n.Vs+M8Qs8Re,rq:`C^u2hdI#4oSmqI'!KSBI'K`V5)qu8AKo@Tl-eZ=UM@o5Z`<bQlB]&:K4
+i:m6NrUo'Q_r/.gHtcYO78RH9M6#1qVqUeArVmH.q<,M^lH,NJJssdGP]c;Fre1N>re6()rV_EL
+K*_7)KDU=UKp1*Ys*t~>
+n,FF-puJuul/C@Edb<[E`Dg;_E,p#@s)\5?F8p<&s8I'Cs)\5?F*%<[&H27RU$Ln!f?`(+kNekp
+o_n.Vs)T!/s8R.]rq:*1[cuc)db!C>lW@e=F*%BYErl<fqu8AKo@Tl)kMOn;\UHe?Oic&*iT[t\
+i:m6NrUo'Q]BS;.d`R_N:jfe!fAGcWVqUeArVmH.q<,MSm,ZsOeD0-OL1BOirc86qrc</ZrV^d:
+E<GuUEVo`V!JAbis*t~>
+n,FF-puK!(]V_$rX-fcsbH&1ka2uKHs2tBAb5]W,s8L.Es2tBAb0'\_&H27RU!0p:S@"iY[EPAt
+o_n.Vs2l/)s8U6arq=13aLnC:X.>iibceb$b0'b]aoVP0qu8AKo@Tk_[@`tra1o*p_TJpHVS'dP
+i:m6NrUo'Q_n;k5X3&5i]"c:mSY!75VqUeArVmH.q<,N!`3#B$UR/+$]XmFNrlPDkrlWC^rVak<
+a924YaSYtZ!RU6)s*t~>
+n,FF-p>2t1fs-K\I#tqt^1MM:JqJ`0qh4nGK`6[Zs8I]Us+ULQKn]L*&H24OTC:=3M04ZUeaK9d
+o_n.Vs+M8Qs8Re,rq1W<i7YAoG_rKOmqR0#KSBI'K`V5)qu8AJn'@TndAD\?@8BKa;Ik!0Z.\'6
+g@Y@Dr:/7.n("LrF^n9A78RH9M6#1qT%*?/rVn;FpuT-,i4G(uJssdGP]Z)?K7nl=pO\"ho7;FB
+Isuk,I=CR8K7oH>o)F4~>
+n,FF-p>2t*kht+?db<[EZrCOOE,fo=qf;W5F8g6%s8I'Cs)\5?F*%<[&H24OTBk[tf?`(+kNenr
+o_n.Vs)T!/s8R.]rq1!*f]_8Gd+@1<lW@h>F*%BYErl<fqu8AJn'@Kik2+\7ZZeT0K>,^bi98jm
+g@Y@Dr:/7.lf[0WcaeL::jfe!fAGcWT%*?/rVn;FpuT-$l/C@EeD0-OL19=cEH6&MpMk0Eo5AMa
+D/=%KCM`BWEH?cZo)F4~>
+n,FF-p>2sr\"T:rX-fcs`N6Yga2lBEqoSd7b5TQ+s8L.Es2tBAb0'\_&H24OT?O^8S@"iY[EPE!
+o_n.Vs2l/)s8U6arq4(,bdX:8Z(7Jobcee%b0'b]aoVP0qu8AJn'@cOZCIMq`kJmm^rWdMTsr7E
+g@Y@Dr:/7.bdF(5[)]qo]"c:mSY!75T%*?/rVn;FpuT-,]V_$rUR/+$]Xd4HaN;NKpW1DIo>\bg
+`5BLQ_Sbc]aNDlso)F4~>
+n,FF,p"QG6eZ=UMF,-X?h/I4SH[^Hom""TrK(X_Jq>Q$Nre:CPKn]L*&H)(IS+"n/M04`]g$klm
+p&47Ws+M8Qs8Re,rUkK6n("LrFc!0LmqR0#KSBI'K`V5)qu8AHlc,jfad[p$>Y@sb:h"R(X4?[/
+ddd87qWc%tlH,NJDd5q3787*.KqQ]XU!<$&rVn;FpuAj%i4G(uJssdGPB#B,It)p(iSJq6eTc7[
+FE2B2EHB?NItIULo)F4~>
+n,Fa5p"QG2kMOn;cIUk7fO.rqBl%X'lu)=`E:n3jq/ULsrcA,>F*%<[&H)(IS*T7pf?`+-kj,,"
+p&47Ws)T!/s8R.]rUjm%lf[0Wce%(;lW@h>F*%BYErl<fqu8AHlc,UajP88/VJ&%nI(7MShrj<q
+ddd87qWc%mm,ZsObbf'$:i<>Ye_T?SS^$U"rVmE-puAirl/C@EeD0-OKj`^8D&$l4iSJ;$eRi?%
+@UWWR?X_/mD/oL#o)F4~>
+n,Fa5p"QFh[@`tr\=]:s`iQMZ^r++/m)AJba7[Npq8pb$rlY9@b0'\_&H)(IS'8:4S@"cZ\'Lr*
+p&47Ws2l/)s8U6arUmt'bdF(5[%3erbcnk&b0'b]aoVP0qu8AHlc-0IXd>fs`P&[k^W3^PT!ce4
+ddd87qWc&(`3#B$^;[e#]"Q(pTpi4+Wm0u/rVmE-puAj%]V_$rUR/+$]=6Sp`"g20iSMB&e\/T+
+\[])X[^aPs`5qlDo)F4~>
+n,Fa5p"QG6eZ=UMA93O'dG9@fDK9iAaEGnYHJ*XmjaVi5q1S_HKn]L*&H)"BU[?="Km\uni8L]k
+p&=:W(kn1Rs+Q1*oQm;$eZ=UMM6#1qC3kJbL&_%(!WUaKs"XNJk.J4b^ls4_=[u+a93cCeR`Ocm
+amAm&p>NEti4G(uBiePK<_H\9JssdGUr;QprVn;FpYrU!i4G(uJssdGOD;JJFE;K4Z`\,>Sp-Kc
+Pc_pC_T/`rGCK;:o)F4~>
+n,Fa5p"QG2kMOn;^<Y<dk1O`U>[V#NaCNWGB\@*7j_\pTq/ZH6F*%<[&H)"BTC(are^E11l.N)l
+p&=:W(it?0s)W8[oOt#ckMOn;fAGcW=D2YpF8u,Y!WUOEs"XNJk.Iq`inDl)R9F2aAu3`$guRgr
+amAm&p>NEll/C@Eb*&U2O_1H6eD0-OT#BpjrVn;FpYrTml/C@EeD0-OJQTV)@prcTZ`[K,SnEk6
+L8DPq\%\_FASq1fo)F4~>
+n,Fa5p"QFh[@`traL@e3ZH';S[(!TWaLfdI^Y-E=ji#0Zq8rU8b0'\_&H)"BX2hH5TrXQX][3\6
+p&=:W(s:5*s2rL_oY70F[@`trSY!75YeS6$b5_@]!WVQbs"XNJk.JCBW0XC$_n3Rh]YqR[Q`\33
+amAm&p>NEt]V_$rahl!:_S!h%UR/+$Y/KW%rVn;FpYrTu]V_$rUR/+$\$3Qb]"#5ZZ`^U/T!Z5F
+]X>\rai:`q]YsR2o)F4~>
+n,Fa6p>2t@eZ=UM@pjA5VU=eg_3:+KVj4$IC8Gcc]6/@Fk(*1&Kn]L*&Gtk;WTqTpK7&cli5)VS
+pAXCX(kn1Rs+Q1*oQm8#eZ=UMM6#1qC3kJbL&_%(!WUaKs"aTIi3L8Y]9%DS=%c@_8Qoq\Q,Mje
+^ZYCho%'Vpfs-K\AR&nkBNA5MIZhJ,\%Lhtrr2p5rqGBY`8J7hI"Ig.lAAo;Vj*CN`5KOlmf;eT
+l2^#Gi!/K*H[+r+rq$/?~>
+n,Fa6p>2t<kMOn;\['N3hWF4X[Y0BiTST51=J]5-]45Gek&9tjF*%<[&Gtk;U?psreC*(0l*mkR
+pAXCX(it?0s)W8[oOsubkMOn;fAGcW=D2YpF8u,Y!WUOEs"aTIi3KuZiS)`&P%K)R?_5HigZ.Ur
+^ZYCho%'Vikht+?^ST&uacVt6db<^GYIrulrr2p5rqGBY]BS;.da[(5m!MKmTSA/t]XtcSli$/M
+li$&Pm+H,cmEGS$s*t~>
+n,Fa6p>2sr[@`tra2YT\S?g2ZaLf*uZ+d9/YGJP3]=P\kk/R,lb0'\_&Gtk;Zc&u4UT9cZ]Z%)3
+pAXCX(s:5*s2rL_oY7-E[@`trSY!75YeS6$b5_@]!WVQbs"aTIi3L85VO+@*_S!Xr]YhU`Q)hd0
+^ZYCho%'V[\"T:raMc6.b/2'9W0XBs]tEJ%rr2p5rqGBY_n;k5X.u#``3Q/5Z+[ch`5BIkbQ,fb
+_uR[Q]EZ=!\@q:orq$/?~>
+n,F"!puK'(i4G(uBjP1gLSi>Li;Dj?mJZJ]_8V[aD81>TmXp2lrr3Q+m)Z*iad[p1OLjAdZJbKV
+lMhZas8Re,rUbE1n("LrFc!0LmqR0#KSBI'K`V5)r;SPNo@Tqufs-K\AQW2H>YA+2I#tqt_mA:p
+q!6%omEM>YEF3C,M0ru;BRGoQi5;n[p\t0l&,u=]ZGYV4OF1tuS&ssamJcANjSn*:eH""raT09X
+]*?C5d;e*jrU^&>~>
+n,F"!puK&rl/C@Eb,_hnf&#NPl29lJmJZ>Y[_7E.>ean1mW!:Hrr3Q+m)YjdjP885g>V;+ZJbKV
+lMhZQs8R.]rUactlf[0Wce%(;lW@h>F*%BYErl<fr;SPNo(a)Tqnkht+?^R1k-V.Yq4db<[E]<gGh
+q!6%kmH*0Sc)f%8f@%d'ajSo%l+=:\p\t0l&,u=]ZFfA[g="3pguRhfmJcGPlMg&Ik5aZDj8e6=
+i<JB,aC!lIrU^&>~>
+n,F"!puK'/]V_$rai29/T:E-p]_o\Ja8O3iaMkj"ZbO35m`<NLrr3Q+m)ZHMXd>f`R&7O8ZJbKV
+lMh[Is8U6arUdk!bdF(5[%3erbcnk&b0'b]aoVP0r;SPNo@Tq`\"T:raMYs:`4Wt0X-fcs_R&1o
+q!6&#a0;#+]#DgmSZBoMb,^o,]Y_#6p\t0l&,u=]ZGX>PQ`IiqQ`\3Ma8X!W^](nF[/dN3XT5F#
+V?X06bdQHlrU^&>~>
+mf*jpm*(7Pc(Ti:EGB$*LS:ubr5er`rRLr+*U<(NY'IS+IY.Irs8Vr]`i&+DRtH*M]&:E3iV3?6
+rtC+bo[oo,eZ=UMM6#1qC3kJbL&_()s8N)Mr;SPLn'@TndAD\?@9dDeDd61NGDi`Zi25/to]!Ek
+jM6t.CN"T^X,q^BA9Ws:g#/jap&4mi&,u:[YJ];1OF1b\Jt'm4c2Pfb_#CtFX8o-sRfJ`PO9VB&
+m>BH;r:Br=~>
+mf*jpm*'_Ajk\J7c-*iHf%o9Cr8[k>rTF4Fs6L]XVJ3ThCiK:Ns8Vr]`h;\Zgsjd+iT[kZiV3?6
+rtBJPo[oo(kMOn;fAGcW=D2YpF8u/Zs8N)Gr;SPLn'@Kik2+\7Z_bUdbb]s+d+I:?fr!Emo]!Eb
+lJgOHbKSDghqHN$^<kNjkh2rip&4mi&,u:[YI`uWg="-feD0-Jjo4<@ir7p9hZ2O4g]6+-g'6Bp
+m<[=%r:Br=~>
+mf*jpm**&]YaV8g]>hq$Ssl@Mr2ft'rO)[<*Q6+E[^EZo_oMZRs8Vr]`j!C`Q_UUKVS'pUiV3?6
+rtEQRo[on^[@`trSY!75YeS6$b5_C^s8N)dr;SPLn'@cOZCIMq`l-!+^Vmq/Z(%GrbGNq_o]!Ep
+^SmHs`P8I(a)SsZS$aK_5.\'1i+p&4mi&,u:[YJRrLQ`J6BUR/*jYl:a)W;`[nT)bD\QN3<LQNin_
+a1Ts_r:Br=~>
+mf*jso\XW*i4kqFKmn5cF+oR7r0m\[rN-%2*Qc^^kO,mVFF<TSrr2c[`i&+DRtH*M]&:E3iV3?6
+rtL1co[oo,eZ=UMM6#1qC3kJbL&_2OL&_/Qf)>V)rqYfrV<Z0lK5Y",H&7,k>[VW.VU=h'cg:)O
+VVp.4N-K8gOLhF&OF1bbM6#1qT(a)EH0rr3N.p"ZS*fs-K\AR'/*S#i=_RfJZOOT((:L]2o+JGsp$
+JssdGQdEnQoDa=~>
+mf*jso\X#cl/LOPe^DghcILS$r7h;.rSRY6*TZAHlg1mP@qtN0rr2c[`h;\Zgsjd+iT[kZiV3?6
+rtKPQo[oo(kMOn;fAGcW=D2YpF8u:=F8u7?d/Eu#rqYfrT'YOneBFf.dFZmlV6S=shWF0ocg:)O
+VV11kf[.jjg>T*kg="-ifAGcWT(a)EH0rr3N.p"ZS#kht+?^ST0(gu$reh#5t+f)XD$e,[tsdKe:W
+jQq`M`;K6,J,~>
+mf*gro\[+"]Vq9eTr>6.\"T;gQN3KQTDtc/Xg5FQb.ja`_=7=#rqbs#Yf*Z1UT9cZ]Z.>;p\s=T
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8N)drVn\Qq<>f"`3#B$^;\3sSYNp;`jhY2ZH8iem-`K&
+bdX:8Z+m?,VQH__X3.f?T!ce7eFNP:rt#,%goAT-Tpr=.`4i"5T:5bG!1*VNrgWt[rhBIiri6:!
+Q`\3@d,Foos*t~>
+mf*aqqX/WG_W8tMTTY4eK)U/qK)gW(M>rYXS#3I/dH'5?Eng'ZrVGj"Vs;BnK7&cli5)eZp\s=T
+'SZMXfV7ibXGM(VX4?ZRH@gg(s8W%Os8N)MrVn\Qp>NEti4G(uC2\BXUmcmR>]54_aQfS<jQ=OV
+mEM>YEI<kZi.J;HOF2&%TZuktbjPB-rt#)$g8=>hXGM(0;-\$lM1tq]!.Oops)n<g!.b'#reUiJ
+c0C\FbP^u3J,~>
+mf*aqqX/!#\*E)6h:gN3eGdnoe,\%tfDjPFgtpuLk3CWD@,(/HrVGj"T^:apeC*(0l+"+Zp\s=T
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8N)GrVn\Qp>NEll/C@EbKSAebhU^lV9IHEjQrJTjQ=OQ
+mH*0Sc-k>)l$'>ig="6rh<"$pbjPB-rt#)$g8=3!hq-2bI\k9<f@BlM!7Uqqs3L\m!7UqsrmqA0
+jm7iQ`Vf?-J,~>
+mf*aqqX2)'ahP'TR[0G:U].=lUB%"dSGnipS>!!h^Wa6tg[G";qWl/*`3#B$X-fcs`jF_!roX4p
+b5LtbU<L$;S@"iY[EPkia3)R)s8C+?rrDHbs"jZJiO-S9VO+@'^TNurQ_V:5^S@-t`3-u<k/aLA
+YaV8sX-fcsWO/OhX1P'oYfEcfmed"`&,l1TVTcH?S@$>O`4i":U&LeeW;`jt[/R*+VZ*@iSHbFb
+`4sd\r:Br=~>
+mJd^qpj[O*\aA4t^TjH#OH>CuM#`>1K)U-<K85DNVSLmPQ+GfBqYBHsVWu9mK7&cli5)e[p\s=T
+'SZMXfV7ibXGM(VX4?ZRH@gg(s8W%Os8N)MrVo=bo%0_rfs-K\Dg@AOR%p.&DeON[]&:N6g"NpF
+jM6t.I#tqtnQ!<]]9%DlR`Oci_Wgprs8W&ifq\#dXGM(0;-\$^H2`3jJcLN(M>iS:Q2[6OWs60&
+oPWI0rU^&>~>
+mJd^qphaVJZ0gc:io&YJg=k3Wf)XD$eGdl:eCN:,hW!bdLUu=4qYBHsT^:apeC*(0l+"+[p\s=T
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8N)GrVo=bo%0_kkht+?bgG,&R&f#lbfS;eiT\"^g"Np=
+lJgOHdb<[El9quCiS)`0guRgm_Wgprs8W&ifq[lrhq-2bI\k97dJhSne,\%ufDaJ(g]$"-hZi',
+lWi5drU^&>~>
+mJd^qpr'kP^;mghW1fZHR$aB(a)SH,;]U].;7URms?S>`p;]t3%jqYBHsYJdQ0UT9cZ]Z.><p\s=T
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8N)drVo=bo%0_]\"T:r^TO!"V5]fV^<3LDVS'gRg"NpK
+^SmHsX-fcse=4FiVO+?YQ`\3._Wgprs8W&ifqZd!T:E:/^VmmoY5YL$UB%"eSc4uVQ2[-LSd)(4
+gp>etrU^&>~>
+m/IRoK7A0UL=#>Kg!.UL]!;16!2faa+HVV=HujO_LQf!flD_V\p%[glVWu9mK7&cli5)e[p\s=T
+'SZMXfV7ibXGM(VX4?ZRH@gg(s8W%Os8N)MrVo=`mE;6kc(Ti2H&f>hKr2t]Jo>jkZ.\'2bfcd>
+fs-K\JssdG_-N&cad[p1OLjAg\E!A`s8W&ifV7ibXGM(0>]54NNrG.>RK0#[X8][1`;[jWeHXt!
+QZ_N>rq$/?~>
+m/IRoEG]?tGK9+9kiLmaiSaXk!8d_1+PPN"da$4gf%T'Dm%_DXp%[glT^:apeC*(0l+"+[p\s=T
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8N)GrVo=`mE;'fjk\J3dFmLBHCj3QeBH:li98jibfcd7
+kht+?eD0-O\4hD=jP885g>V;/\E!A`s8W&ifV7]phq-2bV9IH@g&B_)g]610hu;R7j8S-=k6C2<
+M.>bmrq$/?~>
+m/IRoaMbg%\]`%.\$3!3VP3pZ!1a%T+IJRhX1,@1SsH(S`3R5?p%[glYJdQ0UT9cZ]Z.><p\s=T
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8N)drVo=`mE;NMYaV8sY*l&rV6m@kUV="&Tsr7Abfcd*
+\"T:rUR/+$_kXWXXd>f`R&7O6\E!A`s8W&ifV6TtT:E:/`4r(<RJrTQQN3KRT)PSeX8]7#[0F:a
+^UiXmrq$/?~>
+li.EIK7Mg$DMG[ZmHWWfg&0A#dJh30]!eJtHt[A<IZ1/OhPJTcp$'GllH,NJI#tqt_6r:sroX4p
+L&LYrU@6X6M04ZUeaI7!JqSjXs8@ZOrrCXLs$m"_jh7eZ`0GjuNjdd5>E%jhRtGd;VU=h"]==F!
+c(Ti2JssdGS7RiJad[p.NjdcjXPNRJs8W&ifV.caXGM(0Dh=FY[f3l;a8jKaec+J,kPjcGmfg[e
+F+!T/o)F4~>
+li.E8EGjWC>^*F*mHj*%kksTDk5OHAi?$k0d`TeZe(EO>g8!$]p$'Gfm,ZsOdb<[E\@(>jroX4p
+F8ba`U?h""f?`(+kNc5`E-$+#s8@$=rrCFFs$cq^jh7MVj4i&1g#;/[97H6ggsjX#hWF0k]==6q
+jk\J3eD0-OQ;`J'jP884g#;/:XPNRJs8W&ifV.Wohq-2bbgbG*rSdb:!9O4CrojFKrp9XM"hf1j
+C@faAs*t~>
+li.F:aMm#I[(3loa2GX'\,<W6ZMpsKVPBZKX3/;gW10<_`i@DPp$'H!`3#B$X-fcs`jOh#roX4p
+b5LtbU<L$;S@"iY[EPkia3)R)s8C+?rrDHcs$m"_jh8(=X-KNaRA7@AR'af6Q_V'_S?g8/]==]X
+YaV8sUR/+$V5h,FXd>fcRA7@7XPNRJs8W&ifV-NsT:E:/^S@-eU]..iXT5U)[Jmf=_Z%LQbQYtt
+\\[n'o)F4~>
+li7!=$\\/%HZm!"Um/^2i;E$Dmf)Joi8)elOF1bNCOVG]jLD\VnE7]clH,NJI#tqt_RAM"roX4p
+L&LYrU@6X6M04ZUeaI7!JqSjXs8@ZOrrCXLs$ltZgo\u[[Z5ZaQ,Mk5ARFoVXGM(OR`OceV4b6W
+^ls4rP/$)KPAFh!eZ=UMM6#1qT[iW2s8W&heXl6[XGM(<Jssd2h>Z@3l2^5Nmgm:N_4m0YQCDZ,
+]Q\dTqpk9;J,~>
+li7!+$ZblVBk=lTT8'h`g&117llbQVk2G%Bb-T:>g>_D%\)6]<_k-5Ugsjd+iT[k\j7rW9rtKPQ
+o[oo(kMOn;fAGcW=D2YpF8u:=F8u7?d/O&7rUemIb3@m<dF6k1lc3"#lf[0Wcd^b2m$X]CXm4p"
+e'ct0lKXR:;sWW(f?`(+kNeeko)/OfrU\R2lf[0WccjnojQGb+l2L#LmJcD^]!o/6KnbAP=^8UN
+CN'*ro)F4~>
+li7"-$H_qY^q@7XXh;`qqof&^rkoql]!A3#X3/H$W0XBs]slngkJOI@Xd>f`R&7O9[c@/^k5Q.<
+rUea:bdF(5[%3erbcnk&b0'barQ>0?!:Bdc7fDu7Xi\/LRBEEPX2<2WV9H?>S(a)#&XXi.38TY%t;
+QDgaJW5$rJZ)Z$UT:E9ZT!ce8eaiY<s8DQ>T$4U7S@$&+Q`[[,rk/6K!6>)_&&H?.^q7:oS$963
+]Y_\cmIL:-~>
+li6s<2#W&YJE5FsFE)5@ChmdZBqD8fTu#(Ci4G(uBjc";VU=h+cfjE(U?]jiK7K6*kJXplq#9FU
+'SZMXfV7ibXGM(VX4?ZRH@gg(s8W%Os8N)Mrr6C(n'RfrdAD\?KqQ]XTl+Jgh6r>iI#tqt_23g5
+eZ=UMKqQ]X\#XO`i7YAoG_Mg8m@_Yiqu?]on^<lpeZ=UMJssdGn'Ake_3:+KUM4MBY&A<#FEMfU
+H@4h)JqX-So)F4~>
+li6s*2#VE5DWKN]@UNJQ>$4t$=.>q=S%$E(l/C@Eb-B7ChWF0tcfjE(SF#=leC314laaReq#9FU
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8N)Grr6C(n'R]mk2+\7e_T?SP[7>0l/C=Cdb<[E\VYt)
+kMOn;e_T?SYH)&5g$%AHd+-t6m@2;dqu?]on^<llkMOn;eD0-Olc-NF[tTQlSl]'nY$PID@Uiut
+BPQXHEH;'*o)F4~>
+li6t,2#YM9`T5ar\[SrOZ*:I+Y+i57WlW?)]V_$rai:i_S?g88cfjE(X2M-,USa<W_TKFMq#9FU
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8N)drr6C(n'RuSZCIMqTpi4+^oONY\tb[rX-fcs^km]f
+[@`trTpi4+^8n`HbI=17Z([Vja/I2Kqu?]on^<lM[@`trUR/+$bf[cCaLf*uX0/\*Y-k^J\[oH%
+^VT$NaN=GKo)F4~>
+li6s<2#i8_K_Y2kIsud#H[:"iH-j`V^2IeN^Yl_cHtd>EP/$(g^YmtZ`Se@iI"Ig.lD;5Xq>TOV
+'SZMXfV7ibXGM(VX4?ZRH@gg(s8W%Os8QW\s8W)ol,0@_ad[p&KqQ]XKQ_1:jM6t.GDi`ZheJ;=
+ad[p&KqQ]XT"oMd_r/.gI"7L#kH2M^q>UEkm`hftad[p7R`OcP@;2l`EH?5FcZsikhL'a#It3(>
+JqEcNKSBHWo)F4~>
+li6s*2#hW<Eqo:UD/=!3BkV23B@+h3^0Xs)[HZZ(d`Tb]g>_D'^YmtZ^$4M0da[(5m$YTNq>TOV
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8QWVs8W)ol,0+ZjP880e_T?SFCn^QlJgOHd+I:?fP6?2
+jP880e_T?SR_WK>]BS;.daQt2l_VAZq>UEkm`hQojP887guRgM:fsl,?t!PUcY$qGhJ6nCD/O:^
+E,kYnF*%B.o)F4~>
+li6t,+TKU,anYMj`5BI1^q[Y9^<k'7^9t24a1S:9X3&A[QDjet&E)EU`Or(7X.u#``4itKq>TOV
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8QWss8W)ol,0^CXd>fpTpi4+[^36X^SmHsZ(%Grb%dEa
+Xd>fpTpi4+VnfsO_n;k5X/;/__R@5Bq>UEkm`i,WXd>fXQ`\34Vm!82\%'#]cb(a)0KhSR.I`5Tad
+a2n%tb0'bOo)F4~>
+li6s<!<<%P#6+S\KS+o=rdlKhJai)WkBqQiBY`Q<OF1bfNjdckYLhI8`8J7hI"Ig.lB]<OqYoXW
+'SZMXfV7ibXGM(VX4?ZRH@gg(s8W%Os8Q*Ms8W)li3UA[]9%DfOLjB?BmjudlH,NJEJ:(1m;TS[
+TnRK8P/$):VU9^0\E(GhIXI6gi5;kXpAP!fm)c3kad[p7R`OcUD0FZ^IXZcsn:?2apAT^DKEM.*
+L&V(*!WUaAs*t~>
+li6s*!<<%>#6+SXEcH)Lrbs4VDt*13kA"YE<jq8Og="-kg#;/:YLhI8]]nD/da[(5m"rUDqYoXW
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8Q*Gs8W)li3U&[iS)`.g>V;]=)D<!m,ZsOc.1Y3m;0/k
+h:9cug>_DNVU9'aYj16%e'ct/l+=7YpAP!fm)c!gjP887guRgR>@lQ)Ci+$,n8E:=pAT(2EWc5\
+F8l/[!WUO;s*t~>
+li6t,!<<&@#6+SkaiMQJrl6AX`piE7kJ=mIY/e2PQ`J62RA7@8YLhI8`4Vt6X.u#``4<bLqYoXW
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8Q*ds8W)li3U>6VO+?aR&7OGY.D'T`3#B$]:k[ta*G"q
+R\@<kQDhRHVU</e]t^M3W2l;_]Y^u3pAP!fm)cNNXd>fXQ`\39ZFnr/_o0L4nA`NApAW/4aTMI`
+b5VC_!WVQXs*t~>
+li6s<!<<%Ps8N)[re2ebKnY3YK`(_#q1=1VF(X=_Z&EpMM6#1qU!D2o`8J7hI"Ig.lBfKTqW7_k
+L&LYrU@6X6M04ZUeaI7!JqSjXs8@ZOs&IYMs8;H=U[Qa7M04?6`95!TJotereZ=UMEJ:(1T$<s_
+EH?o4dI+ERhL0LDlH,NJFc!0Ln"\J)r;QQYa/A4ERtH<]aQet0II`$cq>,dBKS9@(qh51QKn]P\
+rr2uLo)F4~>
+li6s*!<<%>s8N)Wrc8'lrc9CaF8YoUq/L?3@T;"Di7QE&fAGcWU!D2o]BS;.da[(5m#&dIqW7_k
+F8ba`U?h""f?`(+kNc5`E-$+#s8(a)$=s&IGGs8;H=U[.+#f?_q#j6O-YEb&8;kMOn;c.1Y3RH<8T
+c-Fnsk3T+ZhJ6Snm,ZsOce%(;l_E&%r;QQYa.Ve[gsjj/jQqS/C[uK?q>,.0F*%?[qf;o?F*%A&
+rr2uFo)F4~>
+li6t,!<<&(a)s8N)jrlP5frlQPcb5D.Yq8gS7\Z<r`Tpr<oSY!75U!D2o_n;k5X.u#``4<kPqW7_k
+b5LtbU<L$;S@"iY[EPkia3)R)s8C+?s&JIds8;H=UWg-<S@#/YX2<&d^UpYm[@`tr]:k[tT<OcX
+]""B&ZH:.uhSQh-`3#B$[%3erbbNb[r;QQYa0<LaQ_U=BXi.i]_XbeCq>/52b0'__qoT'Ab0'b,
+rr2uco)F4~>
+n,ELhr;-6gKE2#NL&_/QjSji5PQ$7^s+ULQL&Zj[nTo&VjM6t.EJ:(1mA%_LYf,J3OF2YKaQf/4
+lh]`C'SZMXfV7ibXGM(VX4?ZRH@gg(s8W%Or;T@cm)ksfc(Ti2KqQ]XUN2*7D9q%HNd>>XKqZbb
+KlLLALSiJeHctZ'GFn6MVMB5HTZuktbjG<,qWl/!lH,NJJssdGPf8.JL&V)UL&Zj\s8VtM!rmt.
+r;QcJo)F4~>
+n,EXlr;-50Ec_6ZF8u7?i;RctKDop<s)\5?F8p<%nRu.&lJgOHc.1Y3m@VGHYe0/Yg="L+jQqfE
+lh]`C'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=r;T@cm)kgbjk\J3e_T?SQ=+lK>KH'fg!Rd`e_T?C
+e]kAEf&#QUD9M0\AXi&KhU^!&h<"$objG<,qWl.om,ZsOeD0-OL;e$*F8l1CF8p<&s8Vt;!rm=_
+r;QcDo)F4~>
+n,EXlr;-62aiaV^b5_JAoDZl4d/M06s2tBAb5]W+n\;BI^SmHs]:k[ta/m>/Yf",NQ`HmJXi.fj
+lh]`C'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?r;T@cm)l9IYaV8sTpi4+_RIFsZHKhSRBFZDTpi3S
+Tt87RT:E4/Z-2CM]VEWTS=[3`R]si3bjG<,qWl/*`3#B$UR/+$]Z%hbb5VDEb5]W,s8Vu=!rpEc
+r;Qcao)F4~>
+nc'.!r:faIk^J&6q1OHUs8V0ZK`I>9KdHbQs8RfQKn]8LEKTP.RtGX2R`Ocm_U#F'i4G(uJssdG
+R)nXjjo6$KrUea:n("LrFc!0LmqR0#KSBI+rIt4M9)eVI]Xd+=PC@M*TZukXG)CZeZK/fbIVW80
+KqX3??Yk7X`95Tkg@9`?VXN':M04?6`948;kP>)Qlc,jfad[p7R`OcY`ddi=rr3.Us+Q1,s8.KO
+s+Q1)rrCX@s*t~>
+nc&ppr:faIk\Y3Vq>PI8rrD!VEr^jlF!^j-s8R0?F*%(k?\Ie,gsjQtguRgr_U#Etl/C@EeD0-O
+Mob8]jo6$9rUea:lf[0Wce%(;lW@h>F*%B]rH%r;9)eVI]Wg\\g=+<sh<"$IA9r$!VX!0pe'"i;
+e_Sd#XNT)Ij6Oiug@9)pVX*F&f?_q#j6NPVkP>)Qlc,UajP887guRgV`bkQnrr3.Cs)W8]s8-j=
+s)W8ZrrCF:s*t~>
+nc&ppr:faIketH\q>SP:rrDZiaoKffasI)1s8U7Ab0'Iq[^sDZQ_V9iQ`\32_U#F']V_$rUR/+$
+]#a77jo6%;rUea:bdF(5[%3erbcnk&b0'barQ>*=9)eVI]Y;.ZQDhEhR]siB]>qdt`kSI<W5Z`f
+Tph[d`PSL;X2</eg@<1tVTcH?S@#/YX2;<[kP>)Qlc-0IXd>fXQ`\3=`l._rrr3/Es2rLas80q?
+s2rL^rrDHWs*t~>
+nc'-soB+WF^iO[Fl@O\Cs8V0ZK`I>9KdHbQs8RfQKnT/JE09G-RtGX2R`Ock^s/sui4G(uKqQ]X
+R*+gnjSonlo[oo,eZ=UMM6#1qU=b'NL&_2OL&M$DrUo!KdG;6kH@1gci:1T.N.5u(mEM>YEF3$l
+KlLI-F,-X?m]V!!p@Wg>`8J7hI!h$ei5;eUp&+[P`hr%CRtH<]aQf#0J,4lurrn,VKn]R,qh5+O
+Kn]I)!7p`@J,~>
+nc'-soB+WF^gUbfl>^ics8V$VEr^jlF!^j-s8R0?F*%%j?\@_+gsjQtguRgp^s/sll/C@Ee_T?S
+N6:PbjSonlo[oo(kMOn;fAGcWU=aF+F8u:=F8c,2rUo!Kb3@m<dF-b-l0;DaI;NM<mH*0Sc)e"k
+e]k2#cIUk7m&+X\p@W1,]BS;.daHk.l+=1Vp&+[P`h;\Zgsjj/jQqW@D>J>QrrmKDF*%B]qf;i=
+F*%9Z!7:<:J,~>
+nc'-soB+WF^pq"llH%)is8V]iaoKffasI)1s8U7Ab0'Fp[^j>YQ_V9iQ`\31^s/st]V_$rTpi4+
+]ZTX=jSonlo[on^[@`trSY!75U=dN/b5_M?b5M?4rUo!Kah"78Y,dqe][X1"b/Cp%a0;#+]#DY"
+Tt84_\=]:sagnqCp@Z8._n;k5X/hVb]Y^o0p&+[P`im=_Q_U=BXi.ll`;7XUrrpRFb0'baqoT!?
+b0'Y^!:B@WJ,~>
+nc'-kiPqq)a2=clc$k7ts8V0ZK`I>9KdHbQs8RfQL&18gCp<!9PC@G%R`Ocl^rr^oi4G(uKqQ]X
+MU(\gjSoeio[oo,eZ=UMM6#1qU=b(rrr<"P!WRlPs%<4Ze"6$YXGM(MQ,Mk&Dg[UsH#)m!XGM(0
+;-n6L:1/-uVU=h(JaWC0I_`,L`0GjqM6#1qT[`N/qWl/!lH,NJJssdGPfA4LL&V)UL&Zj\s8VtM
+!rmt.r;QcJo)F4~>
+nc'-kiPqjt^:9S9c"q??s8V$VEr^jlF!^j-s8R0?F8G@U>,:HCg=+9qguRgq^rr^gl/C@Ee_T?S
+IEq<ZjSoeio[oo(kMOn;fAGcWU=aG`rr<">!WR6>s%<4Ze"5mghq-3'gZ.V.?#"k-B3FQ`hq-2b
+I]UeqFg96ChWF0pEUN\uCquq6j4i&/fAGcWT[`N/qWl.om,ZsOeD0-OL;n*,F8l1CF8p<&s8Vt;
+!rm=_r;QcDo)F4~>
+nc'-kiPr.7`lc6+c,7TEs8V]iaoKffasI)1s8U7Ab51SWZ,=>TQDhQnQ`\31^rr^o]V_$rTpi4+
+\'FI?jSoeio[on^[@`trSY!75U=dNbrr<#@!WU=@s%<4Ze"4dkT:E9cQ)hdF[)'u+^9GhhT:E:/
+^W!e'^;d[TS?g83^(a)(jm_n`auX-KNgSY!75T[`N/qWl/*`3#B$UR/+$]Z.ndb5VDEb5]W,s8Vu=
+!rpEcr;Qcao)F4~>
+nc'-^a04poi8EeVW-3ZCrVtsXK`I>9KdHbQs8RfNKC@U-F5>6@LN@BcR`Oco`65"GeZ=UMM6#1q
+DU\.Rp&><sr;6?dqYU6jq>V90o[oo,eZ=UMM6#1qU"4elrVc_LL&Qf)s%<.Ra/A4ERtGX5TZul!
+F+3lVHuHjZ]9%DS=&!$r>&8_S`95UOL@kE@JBOYRc(Ti2JssdGW6"<#q<Q%ulH,NJJssdGPfA4L
+L&V)UL&Zj\s8VtM!rmt.r;QcJo)F4~>
+nc'-^a/J(a)jl07NeV.FL`rVtgTEr^jlF!^j-s8R0<EUV\pA(g#$f$;LhguRgt`65"CkMOn;fAGcW
+?ISHBp&><sr;6?dqYU6jq>V90o[oo(kMOn;fAGcWU"4/ZrVc_:F8g7Zs%<.Ra._k\gsjQuh<"$i
+@;P]2C0e=5iS)`&P&IF@T$,U;j6OjiG4b_0DTeR;jk\J3eD0-OU<)Zrq<Q%nm,ZsOeD0-OL;n*,
+F8l1CF8p<&s8Vt;!rm=_r;QcDo)F4~>
+nc'-^a10:/]Y),+XLuKmrVuKgaoKffasI)1s8U7>aR@orYf<u=T!uJ0Q`\35`65"$[@`trSY!75
+X4-V:p&><sr;6?dqYU6jq>V90o[on^[@`trSY!75U"76\rVc`<b5TQ^s%<.Ra0ERbQ_V9gR]siL
+\AS(6_6h:rVO+@*_S*q&_nr:9X2</a_t<m(`QP7$YaV8sUR/+$Z,l8,q<Q&)`3#B$UR/+$]Z.nd
+b5VDEb5]W,s8Vu=!rpEcr;Qcao)F4~>
+nc'9SXPhXI]=Z#7iG<diqYoQ0L&[A9KdHbQrqqE>IaturhU/3UF(T]X[b^G5bKQ^LeZ=UMM6#1q
+E7a^[q>V!)rVQEao'PZ(l0e6@rVuorrb)3,n^X9#eZ=UMM6#1qS'QTTo^qg.K(aiorVlfkjh&%`
+^ls4eKqQ]XKm&"Cq0mFMlH,NJDd5q0:1/-uVU=h8^P_gcr.3Fnn("LrFafLgjL;_]p\F-qVs;Bn
+K7]Q5lBK;<qM"qK"blu1L&_2MK`_:.L&CrNf(/ik~>
+nc'9SWnHRqiSih\fii$+qYoDoF8pmlF!^j-rqpd,Ct6(]g#h/BcG\,`iTTQ_bKQ^HkMOn;fAGcW
+@+Y#Kq>V!)rVQEao'PZ(l0e6@rVuorrb)3,n^X8tkMOn;fAGcWS'PsBo^qfqE;";KrVlfkjh%_]
+inDl+e_T?SG%>Leq/'Sqm,ZsObbf&mFg96ChWF1&^O#\Sr,:/\lf[0WcdLP,lE@e[p\F-qT^:ap
+eC<:7m"WMsqK)Z9"`s]bF8u:;EruA_F8Z%<d.73e~>
+nc'9SZH9MTVP^E'bd+t%qYp*/b5]ifasI)1rqsk._pu;gaKh>-\&ke@UUnmMbKQ^)[@`trSY!75
+Xk31Cq>V!)rVQEao'PZ(l0e6@rVuorrb)3,n^X8U[@`trSY!75S'T%Do^qgsa7dUOrVlfkjh&4@
+W0XBoTpi4+\@]`Vq8BhV`3#B$^;[e"^;d[TS?g8I^W6-Kr5R<^bdF(5[&B:h^V%/=p\F-qZ,Ec2
+USF0X`4X+.qTAg;"j6kfb5_M=ao_Ucb5D8>mIL:-~>
+nc*OK[-uPGOH>aGkFupAn+bmrL&R9iKnT>Up@*O`FJtS`dAD\?@;LIZ`95R;eBafVeZ=UMM6#1q
+ES:!_s8W)trVZNep@@V6hpffb^;J=Un+chXq=jUUo^V+fQg`J+M04ZUeaJ@(GLtL"fm7s@hL4ea
+qu$0FYL217Nd?)7]&<*nH%GnjJ9ZA-dAD\?@8BKj?uq+#dI*XPNVi_RK&3]Ii4G(uH&f>hd&Ypm
+q!?,$lH,NJJssdGPf/(JL&V)UL&Zj\s8VtM!rmt.r;QcJo)F4~>
+nc'9DXR#',g=k<Al]tjkn+ba\F8ggkF&i*Wp@)nN@]5OEk2+\7ZcghPj6OdNeBafRkMOn;fAGcW
+@bLDPs8W)trVZNep@@V6hpffb^;J=Un+chXq=jUUo^V+fQg<hlf?`(+kNdu6A_5Se;qYhuhJ;NO
+qu$0FYKH+gg!S7%iT]W0B5d_FDe<\Lk2+\7ZZeTUZ-LqWk3SV`IJa$BESdn-l/C@EdFmLBafF1f
+q!?+sm,ZsOeD0-OKu@j)F8l1CF8p<&s8Vt;!rm=_r;QcDo)F4~>
+nc'9D^Wa*WQ^<u<_SNXqn+cFqb5Tceb#S>[p@,uP\Yu4BZCIMq`knU<X2<8heBaf3[@`trSY!75
+YM&RHs8W)trVZNep@@V6hpffb^;J=Un+chXq=jUUo^V+fQcuk0S@"iY[EOK:][tfg;q\q$hSS[Q
+qu$0FYK=ANRBETXVS(E^^;g*J`kAb%ZCIMq`kJmq`jhY2ZH8leb5;2:aPO,A]V_$rY*l&raK+(e
+q!?,-`3#B$UR/+$]>VYab5VDEb5]W,s8Vu=!rpEcr;Qcao)F4~>
+nc'9;b4!l]M0t)UdGB"cfBCk=p@j[JJoL1-hpQSFL!f;8VMB5$?uLXcaQfS"h9hk`eZ=UMOLjB?
+F4p-[qYBp[oC)#,hUTfaYbA&-`lG$ifB`%tki(=Mf[S$HJa_-jM04ZUeaI.-BVD/pUMFYIER*V8
+q"!(5n("LrFaT:^i4s2VK)PX-JpVC^h6r>iB2q?'Ck.ehkL-KfO8]+XKB9bOjM6t.F,-X?m\%qq
+p[6;,lH,NJJssdGP.uJ@K`:rSL&Qd[rr)_I"T*k*rVlfr!7p`@J,~>
+nc*F?_!C1@f@&7,k1O9PfBC_'p@j)WE,b8_hpPr4Fis+6hU]uYZ-:_QjQr5-h9hk\kMOn;g>V;]
+A(gGKqYBp[oC)#,hUTfaYb@es]t^>SfB`%tki(=Mf[S$HJa;LVf?`(+kNcc;<hZ7^;kmK!X^KH7
+o(_e.V!I4$f?_n!iT[dUBlO%LE+rRtl/C=C`JdH]bL>5+lc?3`J,TEHETOj1lJgOHcIUk7m%)Ml
+p[6;%m,ZsOeD0-OKthI!F8l.BF8g6%rr)e:s)J8>EcV-Xrr2uFo)F4~>
+nc*F?cciegSZABQZH'5YfBDD<p@lhQa2dYehpT$6\&l[rS=[40`kS:8Xi/)kh9hk=[@`trR&7OG
+YhAUCqYBp[oC)#,hUTfaYbAD=`Q,6qfB`%tki(=Mf[S$HJ]tNoS@"iY[EN9?Y+_Sa;kpS%XgcU9
+o(_e.Us-6=S@#>aVS'sU^rQEPa2#%)\tb[rahbO*_PWU!_U,F?bl.S@aQ:(S^SmHs\=]:sae[;P
+p[6;5`3#B$UR/+$]>)8Yb5VADb5TQ+rr)f<s2bE@aiXM\rr2uco)F4~>
+nc*47am[c\M03lpVU=7AX2DYthr*F?He$BWZ(@3,mG6$aLN?m+F+Tk%lJl]gjO'LdeZ=UTOLjAd
+Ems7=lK@0_f?_FIY+_Mj_scmOi8F"D[FF'`_m?><U7RUANp=`UK5YmhX4?t5=OF+bi:--\TC1+(
+LNA'9aQgZ_I=qOuK77j9kJWX9D-KS>F,-X?m\IV[OT,:[K^6^ElH,NJDh=G!lD2;\p@-Ohn("Lr
+IZhJ,YdAcGK(o!4K(X_Io^r*6$A!`qJ:[ChrVliJo)F4~>
+nc*47_!C1@f?_anhWEL#X2DM_hr*F-C":JEZ(?]lmHN`hf$:UhcICY1m+PXHjO'L`kMOn>g>V;,
+@ajQ-lK@0_f?_FIY+_>^]BehKl07TM[FF'`_m?><U7RU;M!X3XeBH7jhrjb"=NRAUi:--\SF#Cp
+f$;e#jQsB`CN9@QEGT'Llf6aKbb&=KcIUk7m$>EKJc>]LEpLf%m,ZsObgbG/m%2)Xp@-Oblf[0W
+db<^GV6jt*E;0)"E:n0ho^r*$s)/22DK#4DrVliDo)F4~>
+nc*47cciegS[>kuS?g5>X2E2thr*G/^t$]GZ(AVMa1ALFT!u_W\>,Cm`7D3;jO'LA[@`tiR&7O3
+YLD_%lK@0_f?_FIY+_f&_p$'6]Y);*[FF'`_m?><U7RUKQc-"mUV=++T!e:9=0]X#nEnSub-IP/
+\"f:l`6Ga-aSu1[_mmP"X-KNu`4X+"T:E4/_nY?Zrr<#?lc?cXXd>fsUR/+$Xhs;qnC+,U[@`tf
+QDhR:[(u.Np\+=$ouG,Fo_li1`X)"O`qB0+rr;BVs*t~>
+nc)Y-^$jLPM039KLSiJe[@<=qYHkHOCnR8m`:*!Ic*j=$F(&HcF+Tk%lBlY.kg#aedAD\HOLjAb
+CqIj4`P/a]U7J-idI6Jci75rb]=Z>NZ*V*B]]&eWs69m3RtGWa@WdO/pXLeMmB4Okk/aLdad[p$
+JssdGPB25+rr7Y%GB`K&VMB5$:LJ7!VU=gVcgHtqs!`WjdV81#XGM(IOLjAf[,CTIfTP^RXGM=d
+]&:>mFOtothV<G1H@"5rrd"rtG^%>TGi%`Xqu51;s*t~>
+nc)Y-[-Qo4f?^qOf&#QUXI"rNYHkH=>+h:S]BehJjl,%HcEjdccICY1m#,>akg#[ak2+\;g>V;*
+>eA/$`P/a]U77dYb3SH\l0%-eiSinaWjB@;[+YBCs6L$PgsjQF\BidapZF'kmAS+ek/a:`jP88/
+eD0-OKjnn=rr7"VAS1;khU]uYGHoHEhWF0;cgHDas!`!XdT>bthq-3&g>V;.[,CTIfSo.Zhq-<1
+iT[b>@b5APhV;huBP?&Nrb)[PAnB.sBAVqGqu4t5s*t~>
+nc)V,`lti^S[?GHT:E40\tl%*YHkI?ZCmnn_p$'1YbRYY\&QG.\>,Cm`4NS3kg#pFZCIMeR&7O2
+WOp<q`P/a]U8"j)aiqfB]X=l?VP^T7\[/rJ_>DIV`!EK3UV=^f[%3f_[4Ai/\&dXmaK`[cQ_V9i
+Q`\3<\\uSgs2i6mZc]SDT!u_R`jhY2ZH9H!ma(n4.EV)-Y0=;GS@#>aVS'gRi:QTmWQ_cBS?&$S
+]Z-GOf>6A$gq_UX^Y%3<^C.ch]Z[t%hWjb1rpB:VJ,~>
+nc'0HRIA\,M0398F,-X?jR)E^rkh(<i:$+!i75rXToOhJA861.LP`(^`-6OKlH?0lad[p1OLjA^
+?]1/JV6.\_n*]K%h:9cg]<%KcOH?p,d?'OMjOsI]s2bP9K5Y!k<+:!,pT,mRg#90eh7o`Mad[p$
+JssdGQ$.\2s8Rb(H>MNmZ&Ep=<,[AWaQh5lh=Qm0s!`WngMGg$Z&EpMM6#1qUt5&,hO2^G[Z5Zl
+Z.\#UAuBONY,Q33CMTZ=rb;gTBU>]aLpG1^o)&FWs*t~>
+nc)8.O6budf?^q3cIUk7lL!oX]">S_f^%njl0%-dh:^?(^<=gJf%8gB]k;&rlH>shjP885g>V;&
+:Q(I3T;B3Blg4!'l0%0giSWGig'?U#acM\=lKJ0/s5XI@eBFe;MR_!apYRL[kh32lh7oNIjP88/
+eD0-OLLb:Cs8R.ZBj03Ri7QDkMTjT*jQsunh=Q@!s!`$]gKN:oi7QE&fAGcWUt5&,hNQ%FiRuW2
+i98d6<2X!*Y,PR!=]qJnrE'D-LnfcOZHD.squ60dJ,~>
+nc)Y9[*5qLS[?GW\"B1r^W4R@_Sa:4bfn5J]X=l:R[KkYaMt`sT:MR]^pLo8lH?NPXd>f`R&7O.
+S;WW<YI29hbf[l=]!\cCVOs3@Q^=JYaH2S/^UO-Ks/cQnUV=^^_8ipRpR`t2\'2).h7p)1Xd>fs
+UR/+$]t;8*s8U6^^p;1nTpr=._7ub3Xi/Yoh=T(ns#A0ngTo&4Tpr<oSY!75Ut5&,hQY27URA9S
+Tsr3dXJ`D/Y,SY#YcsjrYct=7XhV3W]<]T<o)&FWs*t~>
+nc'0VN6pChNd>MP?uq+#^s1EcrSSpRe^;LNXIG6(H?!kGIYWcWX4>"cJq))3aJeCGRtGX,OLsHM
+n,MYikMY1HdE024XJ(o@M1^8)MlYCsFL1&DZ2C^'RfS.[raGtABP;P_M(>%9lEJOb\AdC<OF22-
+X4?ZQG_(PJs+Q)REO4`APC@:PDh=G!lBHDSq31gX,),dNE5LPFOF2&%TZuktbO"i\Tu,a"OF282
+Z.\U7d)!W:p$_nF#4:BQ_rC@fo)F4~>
+nc'-UK#m38g!S!WZHh%XioTA$kp,ETk2bLYgtC6*c-4M^f%8d9kI7I4D92%aU?psreBH@piT^@-
+s6LTgl07BnjPo.Uh:pZ8eC2juhrj<IX6S^&r87P0!S#?m\-'[kaj9_5/)94PWm0/*^$4M0da-P&
+kNc2]DfYmXF)bu&WTrKse'"T3eD0-OL19BBKDtlpF8+[#\EVu+d`p=ujmAV^m.98,\*;l*da6Y)
+kj.QV[^s'Cli-5TmFnMViq<9@s*t~>
+nc'0VZcp"URBFEJ`j_P0W3E\@rOaAa[Bcp3T9kt>Y.DBTW1TWNT!cJ9^r5@#aK`[cQ_V9qR&7Oq
+bl>Tu_S!IfZE:(#T:2%3S>3$`S"@%3FLf/bU&:P_QN<kqrl5,_b0%*cS1Br.`4=.E\Ac+XQ`IKa
+T!ceF]uJ1os2rF"[_okYQDhd@^S@-t`4WYEq9]-@,0KZ>[E#qWQ`I`lR]si4bO"i\\B2C\Q`IB\
+Tsr7iaN268p!!ER#04rt_rC@fo)F4~>
+nc'0cRtpCUVMftKDeO3IPG,(drOX;ZXJVJKM1^+oFaSdtP,>;-e\H%JMh9@BaJeCGRtGWmI#tu>
+ec3`.`4NIZVONd0M1pJ-Fa&4bMne?DB^aKQN;SP4K)foiFT?^[Hn9lHdI+0[e?m0P]9%DfOLjB?
+CjL\ds8RfLJ9?_9c(Ti2A:Tr`kMg9&nbeUMruZskl#`9Wad[p$J<e(9Xha,ll)U*7ad[p$GDrfW
+e_U5_p!s&`#0kigWQso-o)F4~>
+nc'-bOa-9ThUp<(bfS/]g>1Zai?R:<hV?i:eBuOedaZn&hV[JY\6I:+EQd[hU?psreBH(`g>W%o
+s5Y$WiSi\NgtLH5e^Msmd*gFrip,fBlf[0Xr7Ctu!6tJg!7CJf/C`P=m&8(V[(PY^g="F'iT]W2
+BlJ.ns)\$SA:3e+h:9cae(`pKfii%Yr.G"K*cq2B@Z'O5gsjQsgZ.Us^ut@SV2"?tgsjQpf\krU
+rTX"<ro=:Fkj>1kmJ?DRJ,~>
+nc'0c_RddlS=?C\^WO$WQC=G@rMCg5T:D77S>36u[&]smQCOPP[D]AsaN3T2aK`[cQ_V:;X-]^_
+[K!?GX/;YaS<oP0S=ud[['?[,S#F*RB[!lVS,AfVUB%q)ZiI9%X":$9ZH9W!e?m0,VO+?aR&7OG
+Z,"E&s8U7<`OiS!YaV8saJP6'_UPj)nbgc5ru]D[l++@CXd>fsVNn4![_V(ul,(-PXd>fsZ(%Gp
+[CZ@MosOe$#-bSWZ-Mb5o)F4~>
+nc'0mWH+9hdBSspJp_c`IYEW=rK&7_M2-_2FaSXiM3+1,^X:TgUi1MBOG)'LbGsjLRtGW]Bmc$A
+XT+b,Q&q#_LP(&%Fa8@dLP_+]X2!`#EpqP[M>_f(J:`B,rJ:N7oT1T#dI*ONf!WHS]9%DhP/$(r
+Dg[1ks8RfNJU2A*eZ=UMFb#q%lD8QNp\pBUruZslmWXTVc(Ti2I#tqt_m\Rsn$RH/dAD\?A9a'7
+XLA,?orS.^#GJT^e%=]9rq$/?~>
+nc'0mT4!H@k2>"HeC)^he(*('rRrLKf@JI"cdL7kf@o$;io]FXT3Z'nJ9&m$bG=LcgsjQ8b0o#C
+huDIKgY1?4f$r0rcdC1jf%8X2hr<ptEpMoGfDX,"e'umtrRV&&o\(hPk3SD[f!W0TiS)`.g>_D0
+?>FP%s8R0<DeNVGkMOn;cdU\1m$V9up\ogEruQ7YmU^h6jk\J3db<[E]XHhln#pHlk2+\7^<kNi
+hu2O,hu;C9h;RS@]B&bdoDa=~>
+nc'0mcaUU+ZD!PQUT:Z/W1f`LrKeauS=ZLV[&^.#SX>b8W3WhNX0fS)c,o5;bHo-hQ_V:4b,^m.
+TDt5pQ'[o/Sti6e['$I)T:M@9SuBEEEm1q`SGfJjVPBo[rLEqVoU%/!ZH9;rf!WH/VO+?^QDhR:
+[DL#-s8U7>`kS_$[@`tr[&01l`4rh"p\rP=ru]D\m_$$LYaV8sX-fcs_m\Rsn'&2^ZCIMqaK_5,
+T;2C_oq25M#F_F!b.Ha0rq$/?~>
+nc'*rZ?pShmb,O`RZNG_Jq3]F,(P8sLP_+UR]F$@e`?/&Uq_5+pQC6[nC"9&c(Ti0C1q:.re^Z-
+(k@![H$k-oLP_%QR\m-saOTA/FcG>4Z','I"-o=DT`(nk[e.-]aOSk7gYKK]i4G(uI\tN\]5rFR
+L&_1,re#WFZK/fbM2@86lJlo1Jc#J2rr4'orUY>Wi7YAoG_1dQeaKa"o^on;_Vi%fIWojXM2@8l
+OS+J0K*R76eaKa"pAX[`J,~>
+nc'*rW+fV4m-*KfgtLE3eC49B,1G&kf%8X0gu%)OkN_E1U;(AZpOdP4nC"*!jk\J2bK7lSrn%2"
+(Xpg[dF-Lnf%8U/gtprIjQGg]A<#:+i;D:2gYCT?rSR5*/*,m<RbQZ1^$4M0daI"7m'L5=EHD0[
+F8g/pC8^@Vg=Os0jQtT0B5d\IKDtlmF8b]EAD-2)f[/."hrj=0ht6QO?ao:Yg="?nd+?n&rn@%s
+rmV2)hrj=0htI'@s*t~>
+nc'*rftb&#ag\=EQ^F87USdmg,,V-1T:M@8Q_((V[D0huWP?3epX%(KnC"P]YaV9#`lcH)rga"`
+(o=:9Y,eFpT:MC;Q^jYEXgPpcZ&Qu:TpGYE"-o4>Rf/fXU\(E6XgQ]ggYKK\]V_$rW1:08`4<h-
+b5_LarlDsc`kSI<SXl1N`7D-+`r#e_rr4(_rU[h0bdX:8Z(mk][EPl4o^p_Cah4L;W3Nk;S=H#H
+Qh?mJUBd?][EPl4pAX[`J,~>
+nc'*u\:Aq>T&AebaL\XRR[*`2+-i:`VQ7;CaOT56hQihocf9S/rKDrco\?(sfs-KfIf+R4J:`B,
+M2@7SQ("SN[^sQ-e_o`LZZC,kVru=>rON*LaN2X)eH"Fti%+*MXL%-P`i\FBQ&q*)dI*cSmt?Dp
+s+UK+J:`(7dC-*V[`Ia4I=?hJs-*H^+GKgiIXAK`^lsA%TXs(OZJbHOaEMptdAE(bLOsu&I!>7+
+!."Qk#_8APh=.W*pAX[`J,~>
+nc'*uY&A$fS([,kjPf%RgtV\Z*o#K*hV[;OjQGdofqt?Jcf8q`rI]1;o\>qhkht+CqpHG4eC<%#
+f@em4gtprIiT0.al0R*$@pcL1lfI.)i</-$jQ6@'!9j(>/*tuiXm"ldU[-spg=kEGm%J%[Ec_9\
+F8p8uEbXn&iSWPOjQrUXCiTISKDtljF8krNCT?[Zg=4X.iT]X5i:cr_ASLMnhV-W5eGdkrd.P]b
+dJhQ"e(ipGlEB+=rq$/?~>
+nc'*uho<IFU<UQaXeqe^Q^.E7+-i1ZS=ZUVXgPg[ai('bcf<$drQr^Ro\?Un\"T:dW;N\8VPBo[
+SXl19Q'\#4USb0![CjH"`NZeU^r!=SrMB[tXf\i+[/df1]IUqCZ-):l`kK<jQ'dr/ZH9)Zn&``P
+s2tA``P8k(ZD4"_UTMJ>]#2Vgs3UcF+Nj]Y_mm\#W0X3RR\maIZJbHOhn6A>ZCI5MT;/?cX0M?)
+!3Z=%#c<r`]$de>pAX[`J,~>
+nG`s0KRr(&CnoqRi7ZN!`;7%e`5p$Ie_oNRn&(E2ER0%"p4S/"PD.Q^kH_PW^oNoer/_k_R[TnM
+X1#UXaO/Poi9Kaf`2@ZsK6u$j_sQO`hui0-lL"Q=!7:PW0Z1`C`58R!cc#GDeW'"E`4EP$e]#+I
+p4S/"s+UK+Jr+Q8mG6=Ch<MtfL4P$Xs-*B\*rCJ?JDS\YR[Tn\m`*$(q#&EcF-Z%<^TjZ)P)tc`
+on`[/rf@DNR^VM2]&`YcoDa=~>
+nG`s&Ec9mW>*dk.l0.9jj8.^Uj5f:`kNV9ulb&!^@*`TTp2Y6SK6,B6kH:lNinrPgg)Jf%gtglF
+iSihXk3(smm-NE<TjqMPC!p\*mHXZ7"7,=?mJZ>PaL8PS[kPG'\%K5IB@"<`n(!$Vk2YFZjQF7g
+C\Dgjs8R0?F)cJ7M!aEhkNM9I[WZS0s8R`Lru1cQF)p!si8!,DiU".jk4nkrCLN%ck2P=Uh#?"-
+f_*hrg&B\2gYCcSah$R.rq$/?~>
+nG`sVai<8[ZGFc']XP2KX88\8X0&M0[Cj8mbeq,t\'MnXp;tJWd)tbNkJ>0QW1K?Ar0SFgQ^=/4
+Sti0`Xg5(a)G]Yqq6`3HPV^qeC+b/_9q]E?$h`5hi#!m&F&qoCJ.aN2<A[C"97oC(5:b-J(FVQI8B
+]#+0`b5_Las2rF&\\?+q[C*Ta_7%8$aoDCfr;Ri8`k]"&ZD!VOR\n3S^ZP=hk/+XB`3Q>8S<oP/
+R%*c>!1EhR#aLaO`7)<Yq#9mbJ,~>
+nG`s0KnT*^H#n&*_;ObHkPF*YkN_@#n%cGuC:&,:II;^`rIot*PD0&7n\fXgjOM>dr44>qaN2WV
+e_T0HlL+,e_53cF\As8ONIgDKEJV6G_84'kPc0=NC29cLDYe9*[;^)AF0C>achd@tO-f:ti8EnI
+Y18(!Kn]R,L&Zj[NdPo(dI6POQFPP*K8'@*PPkG%rI]rTRd/SIaN`Q/HID9ZrmQFFEL#tQg!RmU
+]"50>WrTU-\d-0pe`rLFm/$;QJ,~>
+nG`s&F)pp:B45;E\(L'6lh]iGli-5ilaF$Q=L;R[C[Q0<rH!&[K6.(jn\AeIlK@6fr8B-cjQ,Fc
+kNM0rm-O&Y\"B1#\Ar`.I;eFo@!T)l\$s#HKqW]l=BVT(>[@550XY4nI:9*ulcK"sk(JTXlfm[#
+afa04qK$`Xs)\3]Edhb3Gf]4:aG@@XI;s?.s+C7L*rU))D2moGjQ,FdltXu;qu4iYBjZ\_lKIBk
+io/kSp##`,#NOn.m"rsQqXXZ:~>
+nG`sWb/s;>^::DQaNVcE_YUne_SjC7bf@E1YdD!X_X>J@rQ<:_d)uCdn^Fke^U:2Br2(sEXf\h8
+[CX#f`6$6HaKD;B\AuJ(b/Wba\%BGoaN2<-]<SoLYHXt,[']V9+Lel$_s?I]p?''(ahk^'`5o+3
+`qmj#s8U7Ab/qiC\@VX_#emh#b/ha*s3U]D*rX1#]"GtjXf\h=ag]^equ5m#^p^u!^ULMNW2?Gc
+opu/Yrh]q$XgQ*^bj>2ss*t~>
+nGa!1Kn]L#JUW9nEGTluXi^IV+/5QrTVZS?Fa;npNe@4^s8Re,s-*K_rqY&rDmSotjS[pakN_@"
+n*eT=U6Kk;DK3VAL#_KZK9Co_NI5ug]5V`#^N@SAG^=\jh>)FPidH6JI`RTGec,I;SooCU`knis
+e*;SaKn]R,L&Zj\Ob%q)EGi"#G2;SJKSBI+PPbA#qi6GYXPrI0mEp6&k4eiSeV&L#F*Y(Lmcrlk
+i7[eR!8[Y4#NtC@V/kMdrUTu=~>
+nGa!'F*%<TDesR;?Wq*9VSrA@+-iFQSY]W*A7sh;IW>7+s8R.]s+C@OrqXo^?)[)UlMTlqlg4!*
+lg)U#Q%ipS>[PFrG2qn;EIr6+I;3B3]3epV^LG;rB4tu5h.le%0]Hk`P\e3dq9T';o9*TuR(g).
+?IS1ZrH!&[s)\3]F+J7FARJcI?Y&!\JTGo4s+C4K*W(;0CSoeOm-Vl.AENXbs3G_(Bjk_Rg$J(j
+l07F)k5a`Fkm-P@l^2,=o_n@\J,~>
+nGa!Xb0'\X`l#[7[^*9F[_DX[+2G%mV5:Q4]>!4AbK0S's8U6as3UfGrqYTi[)U>.^\k_n_SjC5
+bfn8O^qI(YZaRg!_rL(+aNr!'b/(d/]=,/Z^U_J!^;%G;h8/s)0]KsdcGSSaq<\+Xo?=eT_o9a+
+[F=E^rQ<:_s2tAab0J#D]XP8P[_(A`cH=<0s3UZC*W+$u\@0W"`5g*1]B8kds6[qJ^pphlbfRf<
+]Y(`H[/df;]Ec<lbepsKo_n@\J,~>
+nGa!1Kn]R+KS,<NI<p.[_5dEP'le<6G1,&kk(&$VKT_&hL&_1,L&[A9s#'c2N-]QCWj9IZ_nj9c
+Pa-upCMn*4Fa/4[IHp9^p\L&,PD0!uJq3+II=:5?J*hc;JqE[hq1C6nK7g1Vdus^]s8MnoIX-(P
+FO#7#pOrR#L&_1,s+Q/jKS"`'I,B@&o_Oc*rr2t^qu7]9OcG4<G*nVtE-Hd'r;ZfJKnP#*G]InN
+Pd8-Bi:ZOHcbRB9UR%s&I.7"3o)F4~>
+nGa$(F*%B\EcHQoCM@D&_5:T=?N4@H@Dud*fkTYeDt\4'F8p=]s)W8]KDtm.rRuX4@Afp!\%KA_
+]Tn2+GFhuC?=@>UBPM>Jmsk*.JocQcrdf$,l/c\rjl^LJDf9T6p%J3$/GO4)SoN#-rm:]Eqj_J8
+A&2X"C$kY9s)W8]s)\3]F+\LPDJX(FCMre(a)K6.%l!/(1K*WCV=GK=BRM5O]lD"RZ*s3Ph-Deirn
+AS?gq\%:5blO1bA\%S)`X(,o6qYp'cJ,~>
+nGa$Yb0'b`aiMZk_SEk,_7(a)#R[K!ZL\Ac).ftlgi`qIO#b5]Was2rLad/O&&rU%_A\>Q[PaMYp:
+`5'!u\Xp(4[CEf]^VRePn'(P&ccXVWrm&R(l/fe!jlaSL`l?'>p%J4&/GR<-fZ<@)rpBabqpr[!
+]"tr&_!Um=s2rLas2tAab0\8N`P]OL_Su0Dd)u@f!7:WC*<+7,`5o:#^U1G^_t<m,s6[tN`koF!
+ZF%<aaMRSn$d6T3`500g]#!n4rpp)>~>
+nGa!1Kn]R,KnY]dK7\[@kg'*Ss*bXHJFW8`q1OG#Kp.5jL&_1,L&[A8s"<;nJUZ7pF)eXrE4U+4
+Fa)>]I!pHoJV&K+qYZNUs-&/#L&[?iK_kIrKD>7qqu26ML&V)IKc'iDKs$-\PQ056s8K*PJUcm5
+mXk<6L&Zl+rt'naKnY_EKS4u1pOe.trf`'8rrA8ZruI;cO6MFEGh%1lK)GWJs42mXKS+f(L3Ri]
+E3X7rrbE.@C20K<CMRa'DfE:/bh7GsqYp$bJ,~>
+nGa!'F*%B]F)us0EH#j_kfWg=s(iA6DXm@=q/UQUF+\Q6F8u8]F8pmks"E8\Df"(L@:-IN?b0ZT
+A7a8(C27X'DfB]9qYZ!Fs+>BFF8pl6Er,QNEVT?Mqf;[Ws8Mh8)#nYuU3"\6s3UfGrh+7LD<Pj)
+E;KNSs)\2>&9IkmF+\OTEcH*nEH;$WK6.%l!/(.J*J8oml$$cPeS8uAr;Q`rcuX8KEGoZ:An,7V
+Z!1E2=V@H2=JDQn=^#$8?FjUifkbX(rpg#=~>
+nGa!Xb0'bab0&',aN)<ekhZ0Rs2,N8`UWTAq8peYb0\<2b5_Lab5]ies"Erg`l$HP\@/iR[^ruZ
+]=cY._8=+/`lH0AqY\_>s3Sp8b5]i2ankeRaS>SQqoSi[s8Mi:)#qb$grf$2s6]jdrn>H5`9>/-
+a85bWs2t?@&Bb$qb0\;RaiMQtaN=D[d)u@f!7:TB*RN*Ul,:<Le\T5Gr;Q`rmE3SnaMu-8]t1_^
+Z*LY6YS*\7YbInsYd(L@[CWomfu(l,rpg#=~>
+nGa!1Kn]R,KnY`jKnP-Vq=so@(ANN7qLneFL&_1,s+QYjs+ULQKn]PjrVmSmPD"S[m='KDidKp;
+It3+@JqAW-re1<*s8N^qs8S::PD0%#Kn]R,Kn]R,L&_+*s8VnK#lfU4Y(bGjs472L%'G;;K_^;u
+K`;"*s+UIP"GQl0Kp2Fg#6'=1s8S::rr2t^qZ$SZ#a5"EJV!BDKS9=(!7q+&$&!qlJUi2ti8&bZ
+HN2V.HJ$nsH@(!dIH>tHo7M_qnGe"~>
+nGa!'F*%B]F*!!6F)uC!q=so.(AMlhqJuN4F8u8]s)Wg6s)\5?F*%A6rVmJfK5tu'm;6Y!ibRXl
+D/O:_E;jkWErL.[rt9tas+>BFF8pl6F8u8]F8u8]s8@$=s7p^As)W7UF3oR>d/O%RU2t?qq/Z@R
+rr7'>F8l1BF8p<&KD]cprc</\s+>Clrr@]Js8R]WK)'q8Dt7mgF8c+=d/A"lEcHVJDJX+Hh.ck%
+s4@Eef\'s;BaAHhj_aGWEH;'Js*t~>
+nGa!Xb0'bab0&*2b0%j'q=sp0(APtlqT8[6b5_Las2r^2s2tBAb0'b2rVmK$d)jB#mDQm%ikjfp
+`5Taea8X0[ao9H_rt<]Ys3Sp8b5]i2b5_Lab5_Las8C+?s7seCs2rL>b3dRUmJd+ogrda\q8rNV
+rr:.@b5VDDb5]W,d/;#jrlWC`s3SpfrrCFBs8UFOchYi*`q%3mb5M>?mJY06aiM`H`P]RNh8'$)
+s4(a)Fgf\+%=^^.cnji$TYaN=GNs*t~>
+nG`d+Kn]R,KnY`jre:@OrIl$eKn]P\s8RfQs+UK,PD0$js8Re,s-*E]%-3V+L&Ln$KD>4opk/R!
+!<)\Hs8N^qs8S::PD0%#Kn]R,Kn]R,L&_+*s8VnK#lfU4Y(bGjs472L!3Z<T#lfVYL&_1,s+UIP
+"GQl0Kp2Fg"oj:1s8S;]rrA8Zs8J2brfVqfrVhNLrrCXIKa*]nKS+pOpAKUCoE'X;p&0LBK*D%'
+qu)5&n,In~>
+nG`d!F*%B]F*!!6rcA)=rGrbSF*%A&s8R0?s)\3]K6.'6s8R.]s+C:M%,cbZF8buUEVT<Kpi6:R
+!<)\6s8N^as8R^mK6.'FF*%B]F*%B]F8u2[s8Vn9#leseU3"\6s3UcF!2BI6#leuGF8u8]s)\2>
+"EXTaF+aC3"oiXbs8R`Mrr@]Js8IWRre#63rVgm:rrCFCEs@8;EcH*npAJt1oE'")p&8q0E<Z,X
+qu(SWn,In~>
+nG`dRb0'bab0&*2rlY6?rQ5oUb0'b,s8U7As2tAad)uC2s8U6as3U`E%.higb5M4YaS>POprNHV
+!<)]8s8N_Ys8UHgd)uC8b0'bab0'bab5_F_s8Vo;#li&igrf$2s6]gc!8RRr#li'Ib5_Las2t?@
+"Npbeb0^(/"ol`fs8UIErrCFBs8L@Jrm8d/rVjt<rrDH`ap-57aiMQtpAN&3oE*)+p&<#2a9D@\
+qu+[[n,In~>
+nG`d+Kn]R,KnY`jre:@OrIl$eKn]P\s8RfQs+UK,PD0$js8Re,s-*E]$fmM*L&_1,L&_1,s8@WO
+s7h<Jrt:Oqs-&/#L&[?jL&_1,L&_1,s8@ZOs7q?Ss+Q00L";Iff)G[LY5X+\s+UK,s8RfQL&V)T
+L&Zj\s87QSs+Q1,s-*E]!0d9Zrf[KbPD+_jre:=N!7q%$!0dA8s8MtNs8<"Prr2eK"oj;Vs+Q0q
+s*t~>
+nG`d!F*%B]F*!!6rcA)=rGrbSF*%A&s8R0?s)\3]K6.'6s8R.]s+C:M$fHYYF8u8]F8u8]s8@!=
+s7g[8rt9tas+>BFF8pl6F8u8]F8u8]s8@$=s7p^As)W7UF3oR>d/O%FUAf3>s)\3]s8R0?F8l1B
+F8p<&s86pAs)W8]s+C:M!/(.Jrdt@RK6),6rcA&<!7:Ua!/(5ks8Mt<s8<"?rr2e9"oiZDs)W8M
+s*t~>
+nG`dRb0'bab0&*2rlY6?rQ5oUb0'b,s8U7As2tAad)uC2s8U6as3U`E$hM`fb5_Lab5_Las8C(?
+s7jb:rt<]Ys3Sp8b5]i2b5_Lab5_Las8C+?s7seCs2rL>b3dRUmJd+ch#>G%s2tAas8U7Ab5VDD
+b5]W,s8:"Cs2rLas3U`E!7:TBrm1fJd)sN2rlY3>!:B[+!7:\es8Mu>s8<#Arr2f;"olaFs2rLQ
+s*t~>
+nG`d+Kn]R,KnY`jre:@OrIl$eKn]P\s8RfQs+UK,PD0$js8Re,s-*E]$fmM*L&_1,L&_1,s8@WO
+s7h<Jrt:Oqs-&/#L&[?jL&_1,L&_1,s8@ZOs7q?Ss+Q00L";Iff)G[LY5X+Zs+UK,s8RfNrre&U
+Kn]R)Ka%L1L&_1:rVlk]qZ$PY"TO[>L&_.+rVllKqh5$6rIt:OrIt:O!ep[Sqh54RL&_1,L%#%l~>
+nG`d!F*%B]F*!!6rcA)=rGrbSF*%A&s8R0?s)\3]K6.'6s8R.]s+C:M$fHYYF8u8]F8u8]s8@!=
+s7g[8rt9tas+>BFF8pl6F8u8]F8u8]s8@$=s7p^As)W7UF3oR>d/O%FUAf3<s)\3]s8R0<rrdEC
+F*%BZEs;SbF8u8mrVlkMqZ$PI"TO*qF8u5\rVllEqf;airH&#=rH&#=!d"DAqf;r@F8u8]F79-Z~>
+nG`dRb0'bab0&*2rlY6?rQ5oUb0'b,s8U7As2tAad)uC2s8U6as3U`E$hM`fb5_Lab5_Las8C(?
+s7jb:rt<]Ys3Sp8b5]i2b5_Lab5_Las8C+?s7seCs2rL>b3dRUmJd+ch#>G#s2tAas8U7>rrgLE
+b0'b^ap%gfb5_LgrVllEqZ$QA"TQikb5_I`rVllbqoSocrQ>0?rQ>0?!m:QCqoT*Bb5_Lab4#@\~>
+nG`O$L&V,PK`RD;re:@OrIl$eKn]P\s8RfQs+UK,PD0$js8Re,s-*E]$fmM*L&_1,L&_1,s8@WO
+s7h<Jrt:Oqs-&/#L&[?jL&_1,L&_1,s8@ZOs7q?Qs+Q00L";IcrrB5$Ka.R2s+ULQL&CrRL&Zj\
+s87QSs+Q1,s-*E]!0d9Zrf[KbPD+_jre:=N!7q%$!0dD9rr;qNs8N.Ss8W(P#lfU4s+ULQKn]!q
+J,~>
+nG`NoF8l4>ErgpnrcA)=rGrbSF*%A&s8R0?s)\3]K6.'6s8R.]s+C:M$fHYYF8u8]F8u8]s8@!=
+s7g[8rt9tas+>BFF8pl6F8u8]F8u8]s8@$=s7p^?s)W7UF3oR;rrAemEsDYcs)\5?F8Z%@F8p<&
+s86pAs)W8]s+C:M!/(.Jrdt@RK6),6rcA&<!7:Ua!/(8lrr;q<s8N.As8W(>#leses)\5?F*$gM
+J,~>
+nG`OKb5VG@aoTlhrlY6?rQ5oUb0'b,s8U7As2tAad)uC2s8U6as3U`E$hM`fb5_Lab5_Las8C(?
+s7jb:rt<]Ys3Sp8b5]i2b5_Lab5_Las8C+?s7seAs2rL>b3dRRrrCjRap.mgs2tBAb5D8Bb5]W,
+s8:"Cs2rLas3U`E!7:TBrm1fJd)sN2rlY3>!:B[+!7:_frr;r>s8N/Cs8W)@#li&is2tBAb0'2Q
+J,~>
+nG`O$L&V,PK`RD;re:@OrIka]Kn]P\s8RfQs+UK,PD/u8s+LLRPPtLhjHG:Os8Re,s8RfQrIk7O
+pkAbJ&sN@qPD,3Ss-&.js8Re,s8RfQrIt:Oq1T%QKnZ[`es$%3!3Z<T#60DWL&_1,r;QqSs+Q1,
+s8@WTs+Q1,s-*E]!0d9Zrf[KbPD+_jre:=N!7q%$!0dD9rr;qNs8N.Ss8W(P#lfU4s+ULQKn]!q
+J,~>
+nG`NoF8l4>ErgpnrcA)=rGrJKF*%A&s8R0?s)\3]K6."ks)S5(a)KDkfXi.H)ls8R.]s8R0?rGqu=
+piHK8&qg5aK6)Zds+>B6s8R.]s8R0?rH&#=q/Zc?F*"'sd"D8r!2BI6#6/cEF8u8]r;QqAs)W8]
+s8@!Bs)W8]s+C:M!/(.Jrdt@RK6),6rcA&<!7:Ua!/(8lrr;q<s8N.As8W(>#leses)\5?F*$gM
+J,~>
+nG`OKb5VG@aoTlhrlY6?rQ5WMb0'b,s8U7As2tAad)u=es2kBBd/EtPo?bY&s8U6as8U7ArQ5-?
+pr`X:'%$[Yd)s_Xs3Sp2s8U6as8U7ArQ>0?q8rpAb0&M^mEke2!8RRr#62jGb5_Lar;QrCs2rLa
+s8C(Ds2rLas3U`E!7:TBrm1fJd)sN2rlY3>!:B[+!7:_frr;r>s8N/Cs8W)@#li&is2tBAb0'2Q
+J,~>
+nG`O$L&V,PK`RD;re:@OrIka]Kn]P\s8RfQs+UK,PD/u8s+LLRPPkFfPD+_js+Q1,s+ULOK`M/J
+L&_/cPQ1ZHKp.5js+Q1,s+Q1,s+ULOL&_2KKa.R2Ks$-\PPkF\Y5X+Zs+UK,s8RfNrrn,VKn]R,
+rIkFTKn]R,PPtL]PPY:aPQ-jHPD+_jre:=N!7q%$!0dD9rr;qNs8N.Ss8W(P#lfU4s+ULQKn]!q
+J,~>
+nG`NoF8l4>ErgpnrcA)=rGrJKF*%A&s8R0?s)\3]K6."ks)S5@KDb`VK6),6s)W8]s)\5=Erc78
+F8u7QKE(t(F+\Q6s)W8]s)W8]s)\5=F8u:9EsDYcF/!a&KDb`LUAf3<s)\3]s8R0<rrmKDF*%B]
+rGr/BF*%B]KDkfMKDPTQKE$T(K6),6rcA&<!7:Ua!/(8lrr;q<s8N.As8W(>#leses)\5?F*$gM
+J,~>
+nG`OKb5VG@aoTlhrlY6?rQ5WMb0'b,s8U7As2tAad)u=es2kBBd/<nNd)sN2s2rLas2tB?aoMJ:
+b5_JSd/X-mb0\<2s2rLas2rLas2tB?b5_M;ap.mgb1t/,d/<nDh#>G#s2tAas8U7>rrpRFb0'ba
+rQ5<Db0'bad/EtEd/*bId/VJmd)sN2rlY3>!:B[+!7:_frr;r>s8N/Cs8W)@#li&is2tBAb0'2Q
+J,~>
+nG`O$L&V,PK`RD;re:@OrIka]Kn]P\s8RfQs+UK,PD/u8s+LLRPPkFfPD+_js+Q1,s+ULOK`M/J
+L&_/QPQ(R`Kp.5irs4>Ys+Q1,s+ULOL&V,KKa.R2Ks(I,PPkF\Y5X+Zs+UK,s8RfNrrn,VKn]R,
+rIkFTKn]R,PPtL]PPY:cPQ-jHPD+_jKn]I)!7q%$!0dD9rr;qNs8N.Ss8W(P#QKL3s+ULQL$ntk~>
+nG`NoF8l4>ErgpnrcA)=rGrJKF*%A&s8R0?s)\3]K6."ks)S5@KDb`VK6),6s)W8]s)\5=Erc78
+F8u7?KDtlPF+\Q5rs3]Gs)W8]s)\5=F8l49EsDYcF/&]]KDb`LUAf3<s)\3]s8R0<rrmKDF*%B]
+rGr/BF*%B]KDkfMKDPTSKE$T(K6),6F*%9Z!7:Ua!/(8lrr;q<s8N.As8W(>#QJjds)\5?F70'Y~>
+nG`OKb5VG@aoTlhrlY6?rQ5WMb0'b,s8U7As2tAad)u=es2kBBd/<nNd)sN2s2rLas2tB?aoMJ:
+b5_JAd/O%Hb0\<1rs6dIs2rLas2tB?b5VG;ap.mgb2!$ad/<nDh#>G#s2tAas8U7>rrpRFb0'ba
+rQ5<Db0'bad/EtEd/*bKd/VJmd)sN2b0'Y^!:B[+!7:_frr;r>s8N/Cs8W)@#QMrhs2tBAb3o:[~>
+nG`O$L&V,PK`RD;re:@OrIkLVKn]P\s8RfOrrRn<L&M&OK`V4;r;R+fs+ULQKn]R,L&_+*!<;hJ
+qu6_OPD/o6s+ULQ!/:FPs+UIPrIkCSKn]P\rr3#MPPkFaY5a30s+UFO!/:@N%u(%;L&_1,s+Q1,
+Kn]R,PPtL]PPY:cPQ-jHPD+_jKn]I)!7q%$!0dD9rr;qNs8N.Ss8W(P#QKL3s+ULQL$ntk~>
+nG`NoF8l4>ErgpnrcA)=rGr5DF*%A&s8R0=rrR7oF8c.=Erl;nr;R+Vs)\5?F*%B]F8u2[!<;h8
+qu6_=K6-qis)\5?!-A/>s)\2>rGr,AF*%A&rr3#GKDb`QUAo:Us)\/=!-A)<%s.blF8u8]s)W8]
+F*%B]KDkfMKDPTSKE$T(K6),6F*%9Z!7:Ua!/(8lrr;q<s8N.As8W(>#QJjds)\5?F70'Y~>
+nG`OKb5VG@aoTlhrlY6?rQ5BFb0'b,s8U7?rrU?ib5MA?aoVOhr;R,Ns2tBAb0'bab5_F_!<;i:
+qu6`?d)u7cs2tBA!6Y<@s2t?@rQ59Cb0'b,rr3#dd/<nIh#GO>s2t<?!6Y6>&'Fppb5_Las2rLa
+b0'bad/EtEd/*bKd/VJmd)sN2b0'Y^!:B[+!7:_frr;r>s8N/Cs8W)@#QMrhs2tBAb3o:[~>
+nG`O$L&V,PK`RD;re:@Os+LUUL&Zj\rVlkOrVlqQPD/u8s+LLRPPkFfPQ-@:s+Q1,s+ULOK`h@/
+s+UFOs+U@M!elhlqu?\Ms8N(Qrr<"Prr;qN"TO10s+UIP!S3J4rr]G(Kn]F(!/:@N%u(%;L&_1,
+s+Q1,Kn]R,PPtL]PPY:bPQ-jHPD+_jL&:lMf)::(s+Q[9L&V,NL&_/SL&_2PKa7X3L&Zl,s+Tn@
+J,~>
+nG`NoF8l4>ErgpnrcA)=s)S>CF8p<&rVlk=rVlq?K6."ks)S5@KDb`VKE$#ms)W8]s)\5=Es)G`
+s)\/=s)\);!cs!8qu?\;s8N(?rr<">rr;q<"TNOas)\2>!RQJsrr]"qF*%6Y!-A)<%s.blF8u8]
+s)W8]F*%B]KDkfMKDPTRKE$T(K6),6F8Pt;d/A"es)WhlF8l4<F8u7AF8u:>EsM_dF8p=]s)[W.
+J,~>
+nG`OKb5VG@aoTlhrlY6?s2kKEb5]W,rVll?rVlrAd)u=es2kBBd/<nNd/V8gs2rLas2tB?aoh[d
+s2t<?s2t6=!m8m4qu?]=s8N)Arr<#@rr;r>"TQWes2t?@!U\83rr_'Vb0'V]!6Y6>&'Fppb5_La
+s2rLab0'bad/EtEd/*bJd/VJmd)sN2b5;2=mJY0/s2r^fb5VG>b5_JCb5_M@ap7shb5]Was2sd0
+J,~>
+nG`O$L&V,PK`mV>L&Zl+s8RcUs+UK,L&M#OL&M#QKp.5hs8RcRs-*B\!gEY<rr3C\s8RfQs+UK,
+s+UK,rVunOqu6_OPD/o6s+ULQ!/:FPs+UIPrIkCSKn]P\rr3#MPPkF_Y5a30qu6YMr;R:]s+Q1,
+s+UK,L&Zj\s8S;]rrA8Zrs4hgPQ-i#L&Zl(rrCXKK`_:.PQ$:8s8@ZOrrRoSs8I]Ws+Q1,L&_1,
+mf.e~>
+nG`NoF8l4>Es.-qF8p=\s8R-Cs)\3]F8c+=F8c+?F+\Q4s8R-@s+C7L!e^Morr3CJs8R0?s)\3]
+s)\3]rVun=qu6_=K6-qis)\5?!-A/>s)\2>rGr,AF*%A&rr3#GKDb`OUAo:Uqu6Y;r;R:Ks)W8]
+s)\3]F8p<&s8R`Mrr@]Jrs48WKE$RFF8p=YrrCFEEruA_KDorks8@$=rrR9As8I'Es)W8]F8u8]
+mf.e~>
+nG`OKb5VG@aop)kb5]W`s8U4Es2tAab5M>?b5M>Ab0\<0s8U4Bs3U]D!mptirr3DLs8U7As2tAa
+s2tAarVuo?qu6`?d)u7cs2tBA!6Y<@s2t?@rQ59Cb0'b,rr3#dd/<nGh#GO>qu6Z=r;R;Ms2rLa
+s2tAab5]W,s8UIErrCFBrs7!Od/VJ8b5]W]rrDHbao_Ucd/M2es8C+?rrU(a)Cs8L.Gs2rLab5_La
+mf.e~>
+nG`O$L&V,PK`[J<L&CuNK`qF0s+Q1*rr@cOrrRn<L&M&OK`V4;r;Qh^s+UIP%#+`]L&_1,s+UK,
+s+UFOs+U@M!elhlqu?\Ms8N(Qrr<"Prr;qN"TO10s+UIP!S3J4rr]G(Kn]4"%u(%;L&_1,s+Q1,
+Kn]R,PPtL]PPY:bPQ-jHPD+_jL&:lMf)::(s+Q[9L&V,PKa.R2s8RfQs8I]Ws+Q1,L&_1,mf.e~>
+nG`NoF8l4>Erq!oF8Z(<Es2Mas)W8[rr(a)-=rrR7oF8c.=Erl;nr;QhNs)\2>%!2IKF8u8]s)\3]
+s)\/=s)\);!cs!8qu?\;s8N(?rr<">rr;q<"TNOas)\2>!RQJsrr]"qF*%$S%s.blF8u8]s)W8]
+F*%B]KDkfMKDPTRKE$T(K6),6F8Pt;d/A"es)WhlF8l4>EsDYcs8R0?s8I'Es)W8]F8u8]mf.e~>
+nG`OKb5VG@ao]rib5D;>aoqaes2rL_rrC4?rrU?ib5MA?aoVOhr;QiFs2t?@%*JVMb5_Las2tAa
+s2t<?s2t6=!m8m4qu?]=s8N)Arr<#@rr;r>"TQWes2t?@!U\83rr_'Vb0'DW&'Fppb5_Las2rLa
+b0'bad/EtEd/*bJd/VJmd)sN2b5;2=mJY0/s2r^fb5VG(a)ap.mgs8U7As8L.Gs2rLab5_Lamf.e~>
+nG`O$L&V,PK`[J<L&:lRL&Zl,Kn]L*!/:CO!elhlrVunO!WSA]rrSDaL&V)\L&_1,s8RfQL&Zl,
+L&M&OL&:lOKp.5fs8RfQrr@cPs8RfPs8@WSs+Q1,L&V)Qes$%3"0VZXL%YHVL&Zj\s8RfQKn]P\
+L&_1:rVlk]qYphbs-*JHKn]P\qu6ZIrIk=QKp2Lirr<"P#60DWs+ULQre:CP"blu1s8Rf@s*t~>
+nG`NoF8l4>Erq!oF8Pt@F8p=]F*%<[!-A,=!cs!8rVun=!WRfMrrRiQF8l1JF8u8]s8R0?F8p=]
+F8c.=F8Pt=F+\Q2s8R0?rr@->s8R0>s8@!As)W8]F8l1?d"D8r"/>g:F7oPDF8p<&s8R0?F*%A&
+F8u8mrVlkMqYphRs+C?(F*%A&qu6ZCrGr&?F+aI5rr<">#6/cEs)\5?rcA,>"`s]bs8R0.s*t~>
+nG`OKb5VG@ao]rib5;2Bb5]Wab0'\_!6Y9?!m8m4rVuo?!WUOErrURIb5VDLb5_Las8U7Ab5]Wa
+b5MA?b5;2?b0\<.s8U7ArrC4@s8U7@s8C(Cs2rLab5VDAmEke2"5Nq!b4YcFb5]W,s8U7Ab0'b,
+b5_LgrVllEqYpiJs3Uemb0'b,qu6Z`rQ53Ab0^.1rr<#@#62jGs2tBArlY9@"j6kfs8U70s*t~>
+p]#dES,i?aJ,~>
+p]#dES,i?aJ,~>
+p]#dES,i?aJ,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+o`#!5WoMY0s5WDE!6>&<_uB_Wrr2u=p&G&loD\l4<TETKr2KbWh#Dm~>
+o`#!5WoMY0s5WDE!6>&<_uB_Wrr2u=p&G&loD\l4<TETKr2KbWh#Dm~>
+o`#!5WoMY0s5WDE!6>&<_uB_Wrr2u=p&G&loD\l4<TETKr2KbWh#Dm~>
+pAY0R<W2suEp<T)j)XYhs&K$t!TS4irr=)<!!((9s8V-ArrC+=s8T+err`=^s/H(ls8Q*krr[9A
+<TEWL!35qs!-6lpJ,~>
+pAY0R<W2suEp<T)j)XYhs&K$t!TS4irr=)<!!((9s8V-ArrC+=s8T+err`=^s/H(ls8Q*krr[9A
+<TEWL!35qs!-6lpJ,~>
+pAY0R<W2suEp<T)j)XYhs&K$t!TS4irr=)<!!((9s8V-ArrC+=s8T+err`=^s/H(ls8Q*krr[9A
+<TEWL!35qs!-6lpJ,~>
+pAY:r3TL.>j6?REj)XYhs&K$t!TS4grrE,"q#C@okPkR_!<3#uWpfrl`rK->EWF/Rs8Q*krrE+[
+n,EEg!8%7$~>
+pAY:r3TL.>j6?REj)XYhs&K$t!TS4grrE,"q#C@okPkR_!<3#uWpfrl`rK->EWF/Rs8Q*krrE+[
+n,EEg!8%7$~>
+pAY:r3TL.>j6?REj)XYhs&K$t!TS4grrE,"q#C@okPkR_!<3#uWpfrl`rK->EWF/Rs8Q*krrE+[
+n,EEg!8%7$~>
+pAY-nEr>qDEo[2[ElS0?<HA*=(33Dqj5Y1#<HA,>WrN+!<HA-"ElV1#qu?[rrVunts8N@b<E6&>
+*KF."q>WDSWrN+ZElV1?j&I*?<TF,><E5(ZWiD(ZWrN*Z<H@."s,L*>j)R-[<N?(>j8]."<N?)Z
+ElV1?qYpb[!'1'>!36%u%rt[Ms8V+Z<B4(Zs)M+[j8Aogj&H(><TF,><E8)ZElW3#j8AoXWW;ts
+s)J7&<N9&>rr3ML<E7*>s2S,[a8b1?<E8)Qs*t~>
+pAY-nEr>qDEo[2[ElS0?<HA*=(33Dqj5Y1#<HA,>WrN+!<HA-"ElV1#qu?[rrVunts8N@b<E6&>
+*KF."q>WDSWrN+ZElV1?j&I*?<TF,><E5(ZWiD(ZWrN*Z<H@."s,L*>j)R-[<N?(>j8]."<N?)Z
+ElV1?qYpb[!'1'>!36%u%rt[Ms8V+Z<B4(Zs)M+[j8Aogj&H(><TF,><E8)ZElW3#j8AoXWW;ts
+s)J7&<N9&>rr3ML<E7*>s2S,[a8b1?<E8)Qs*t~>
+pAY-nEr>qDEo[2[ElS0?<HA*=(33Dqj5Y1#<HA,>WrN+!<HA-"ElV1#qu?[rrVunts8N@b<E6&>
+*KF."q>WDSWrN+ZElV1?j&I*?<TF,><E5(ZWiD(ZWrN*Z<H@."s,L*>j)R-[<N?(>j8]."<N?)Z
+ElV1?qYpb[!'1'>!36%u%rt[Ms8V+Z<B4(Zs)M+[j8Aogj&H(><TF,><E8)ZElW3#j8AoXWW;ts
+s)J7&<N9&>rr3ML<E7*>s2S,[a8b1?<E8)Qs*t~>
+pAY+mrW";dWrE(!s/H(!!!$">ErT,[<?6+[!!#"ZW`<(!WW6$>EiK*>3<6)Ws8Q*ts8Q(,s)K,[
+3E9&Z*E<*[qYrPUWrN+!!!#"ZW`:&[<TE*[3E6("<<*"Z!<6%!3?;-"NW<'"EcO/?<N?'!WrH'>
+<<1(>!!#"Za8>lS<<*%!!$-+[s&C(>!6=+"3E6&Zs&C(>*HM)X&B@cN3E>,"*B?,#rr<$>*EE%;
+!NH.u<>smt!$)%>*<<,>WW4&"!<;'Z3B8,[*B@+?WqQIC~>
+pAY+mrW";dWrE(!s/H(!!!$">ErT,[<?6+[!!#"ZW`<(!WW6$>EiK*>3<6)Ws8Q*ts8Q(,s)K,[
+3E9&Z*E<*[qYrPUWrN+!!!#"ZW`:&[<TE*[3E6("<<*"Z!<6%!3?;-"NW<'"EcO/?<N?'!WrH'>
+<<1(>!!#"Za8>lS<<*%!!$-+[s&C(>!6=+"3E6&Zs&C(>*HM)X&B@cN3E>,"*B?,#rr<$>*EE%;
+!NH.u<>smt!$)%>*<<,>WW4&"!<;'Z3B8,[*B@+?WqQIC~>
+pAY+mrW";dWrE(!s/H(!!!$">ErT,[<?6+[!!#"ZW`<(!WW6$>EiK*>3<6)Ws8Q*ts8Q(,s)K,[
+3E9&Z*E<*[qYrPUWrN+!!!#"ZW`:&[<TE*[3E6("<<*"Z!<6%!3?;-"NW<'"EcO/?<N?'!WrH'>
+<<1(>!!#"Za8>lS<<*%!!$-+[s&C(>!6=+"3E6&Zs&C(>*HM)X&B@cN3E>,"*B?,#rr<$>*EE%;
+!NH.u<>smt!$)%>*<<,>WW4&"!<;'Z3B8,[*B@+?WqQIC~>
+p&?N%WiB&!irH+ZWW<&!NrQ*Z`rM,[!33%!WrF*[<E9&>ErV."WW9(!*QS*Xs&K$ts&BI,EZL2?
+s/H(Zs&E(qruqHCs8T)!<W<'!s&E)!s)K-?*?F0?*TP0\`rN.><E8&ZNrAtYWW<%u%03EK!6>+"
+<N6%!rrB(rrttfW!-/'[<WC)>a8\/"EZP2[<E7'>N]@*>qYq$*WrN*>*WP."WW6'!EcV*X!NH.u
+<>"7k*TI-[rrB)!*EE->!<5&>rVlp>3QLdlJ,~>
+p&?N%WiB&!irH+ZWW<&!NrQ*Z`rM,[!33%!WrF*[<E9&>ErV."WW9(!*QS*Xs&K$ts&BI,EZL2?
+s/H(Zs&E(qruqHCs8T)!<W<'!s&E)!s)K-?*?F0?*TP0\`rN.><E8&ZNrAtYWW<%u%03EK!6>+"
+<N6%!rrB(rrttfW!-/'[<WC)>a8\/"EZP2[<E7'>N]@*>qYq$*WrN*>*WP."WW6'!EcV*X!NH.u
+<>"7k*TI-[rrB)!*EE->!<5&>rVlp>3QLdlJ,~>
+p&?N%WiB&!irH+ZWW<&!NrQ*Z`rM,[!33%!WrF*[<E9&>ErV."WW9(!*QS*Xs&K$ts&BI,EZL2?
+s/H(Zs&E(qruqHCs8T)!<W<'!s&E)!s)K-?*?F0?*TP0\`rN.><E8&ZNrAtYWW<%u%03EK!6>+"
+<N6%!rrB(rrttfW!-/'[<WC)>a8\/"EZP2[<E7'>N]@*>qYq$*WrN*>*WP."WW6'!EcV*X!NH.u
+<>"7k*TI-[rrB)!*EE->!<5&>rVlp>3QLdlJ,~>
+nc':'WW9(!WW<&!WrK(!WW3$!a8`.>rVumt#QFe(s/H(!!;QTo<W2st<WE(*NZB/#WW<)!<E8nq
+('(B7s/H(ZrrB)!<E9)!<<+%[j8W+Zrr35'!<<(!<N6&srrK,"rr3E-Wi?(!s&E(!!9=(ZWr2l*
+WW;'"!*-$!s/H)!s8>sts8Q(%WW3$!a8,`C!36)!<E9)!!3-%!q>UJq!;uls<=]$/WrE'>rrB)!
+WW<&!Wr;r"j)P-"p&BO~>
+nc':'WW9(!WW<&!WrK(!WW3$!a8`.>rVumt#QFe(s/H(!!;QTo<W2st<WE(*NZB/#WW<)!<E8nq
+('(B7s/H(ZrrB)!<E9)!<<+%[j8W+Zrr35'!<<(!<N6&srrK,"rr3E-Wi?(!s&E(!!9=(ZWr2l*
+WW;'"!*-$!s/H)!s8>sts8Q(%WW3$!a8,`C!36)!<E9)!!3-%!q>UJq!;uls<=]$/WrE'>rrB)!
+WW<&!Wr;r"j)P-"p&BO~>
+nc':'WW9(!WW<&!WrK(!WW3$!a8`.>rVumt#QFe(s/H(!!;QTo<W2st<WE(*NZB/#WW<)!<E8nq
+('(B7s/H(ZrrB)!<E9)!<<+%[j8W+Zrr35'!<<(!<N6&srrK,"rr3E-Wi?(!s&E(!!9=(ZWr2l*
+WW;'"!*-$!s/H)!s8>sts8Q(%WW3$!a8,`C!36)!<E9)!!3-%!q>UJq!;uls<=]$/WrE'>rrB)!
+WW<&!Wr;r"j)P-"p&BO~>
+p\u.P<WE*>3<8([WrK(!rrB)!<?9*[WrL+>WW<"ts&B=(*EE,>3N<)Ss8Q(2s/L+><E9(!j8U-"
+WW<(Z*HM)X(rrWVEiT/>!<<'!WrH(!s8R*[j8Y."<E9%u%`\Ris#F*"!36'ZWrK(!rr3E-WlG+>
+iuO/[!<<'!Wr2l8EZP0[!07'ZWlG+>iuO/#*TQ0?<Q>*>s2S.9rsJh,s8R*[j/N+>!35kp!NH.t
+s8Q(8rrB)!3E?)"ErV."ruG,>a)^4?s2P,>pA]X~>
+p\u.P<WE*>3<8([WrK(!rrB)!<?9*[WrL+>WW<"ts&B=(*EE,>3N<)Ss8Q(2s/L+><E9(!j8U-"
+WW<(Z*HM)X(rrWVEiT/>!<<'!WrH(!s8R*[j8Y."<E9%u%`\Ris#F*"!36'ZWrK(!rr3E-WlG+>
+iuO/[!<<'!Wr2l8EZP0[!07'ZWlG+>iuO/#*TQ0?<Q>*>s2S.9rsJh,s8R*[j/N+>!35kp!NH.t
+s8Q(8rrB)!3E?)"ErV."ruG,>a)^4?s2P,>pA]X~>
+p\u.P<WE*>3<8([WrK(!rrB)!<?9*[WrL+>WW<"ts&B=(*EE,>3N<)Ss8Q(2s/L+><E9(!j8U-"
+WW<(Z*HM)X(rrWVEiT/>!<<'!WrH(!s8R*[j8Y."<E9%u%`\Ris#F*"!36'ZWrK(!rr3E-WlG+>
+iuO/[!<<'!Wr2l8EZP0[!07'ZWlG+>iuO/#*TQ0?<Q>*>s2S.9rsJh,s8R*[j/N+>!35kp!NH.t
+s8Q(8rrB)!3E?)"ErV."ruG,>a)^4?s2P,>pA]X~>
+p\t5nr;Zp?WrI,<!!*&t!!92#<W2t"<N6&ts8Q("s/Q%u!lq;@q#:=orW!*BW`<(!*W?'=Wr;u!
+*TR(t!$2"<%EGIKs8N)!s&E)!s5P.!!!90#<W2pt3W/pYs&K$u"02C$!<3!-!36'!!!"&>WW<)!
+!35tss&BR/WW;)Z<HA+>!!"&>iuS+!!`f8#rVupuqYpp'WrN+Z*<6([rrB(prrM-[rDa3bEcV0[
+WrH(!s,R$Xs/Q%u!EI2>!!+,#pA]X~>
+p\t5nr;Zp?WrI,<!!*&t!!92#<W2t"<N6&ts8Q("s/Q%u!lq;@q#:=orW!*BW`<(!*W?'=Wr;u!
+*TR(t!$2"<%EGIKs8N)!s&E)!s5P.!!!90#<W2pt3W/pYs&K$u"02C$!<3!-!36'!!!"&>WW<)!
+!35tss&BR/WW;)Z<HA+>!!"&>iuS+!!`f8#rVupuqYpp'WrN+Z*<6([rrB(prrM-[rDa3bEcV0[
+WrH(!s,R$Xs/Q%u!EI2>!!+,#pA]X~>
+p\t5nr;Zp?WrI,<!!*&t!!92#<W2t"<N6&ts8Q("s/Q%u!lq;@q#:=orW!*BW`<(!*W?'=Wr;u!
+*TR(t!$2"<%EGIKs8N)!s&E)!s5P.!!!90#<W2pt3W/pYs&K$u"02C$!<3!-!36'!!!"&>WW<)!
+!35tss&BR/WW;)Z<HA+>!!"&>iuS+!!`f8#rVupuqYpp'WrN+Z*<6([rrB(prrM-[rDa3bEcV0[
+WrH(!s,R$Xs/Q%u!EI2>!!+,#pA]X~>
+pAY6TWiF,<rs6ZFa2e2[EiS1!rrpHCa8c1[rVuoXs8N8_WoO-Za8#ZHj/T->s8V->s8T+!j8Z+Z
+WiG[j#KQlEa8c2"j8K#XWWV;]j5^(;s/H;'a8c1[WoO*Y!6>*=!6>*=!QV5>rr^=As2Y$:s5X.Z
+#fluFWiH+!a/]+<s/Q+Zs8N/@WlOr8!?K5Zrrf@Bs8U.6rrC+<<<2(YrtKM6s5W/>s2V/"a8c2"
+WlP/>j/T-Os*t~>
+pAY6TWiF,<rs6ZFa2e2[EiS1!rrpHCa8c1[rVuoXs8N8_WoO-Za8#ZHj/T->s8V->s8T+!j8Z+Z
+WiG[j#KQlEa8c2"j8K#XWWV;]j5^(;s/H;'a8c1[WoO*Y!6>*=!6>*=!QV5>rr^=As2Y$:s5X.Z
+#fluFWiH+!a/]+<s/Q+Zs8N/@WlOr8!?K5Zrrf@Bs8U.6rrC+<<<2(YrtKM6s5W/>s2V/"a8c2"
+WlP/>j/T-Os*t~>
+pAY6TWiF,<rs6ZFa2e2[EiS1!rrpHCa8c1[rVuoXs8N8_WoO-Za8#ZHj/T->s8V->s8T+!j8Z+Z
+WiG[j#KQlEa8c2"j8K#XWWV;]j5^(;s/H;'a8c1[WoO*Y!6>*=!6>*=!QV5>rr^=As2Y$:s5X.Z
+#fluFWiH+!a/]+<s/Q+Zs8N/@WlOr8!?K5Zrrf@Bs8U.6rrC+<<<2(YrtKM6s5W/>s2V/"a8c2"
+WlP/>j/T-Os*t~>
+l2LbaWmUhIWW7VMec1.~>
+l2LbaWmUhIWW7VMec1.~>
+l2LbaWmUhIWW7VMec1.~>
+l2Lc)a3jnf`uTa2ec1.~>
+l2Lc)a3jnf`uTa2ec1.~>
+l2Lc)a3jnf`uTa2ec1.~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+%%EndData
+showpage
+%%Trailer
+end
+%%EOF
Added: branches/trunk-reorg/thirdparty/slime/doc/slime-small.pdf
===================================================================
(Binary files differ)
Property changes on: branches/trunk-reorg/thirdparty/slime/doc/slime-small.pdf
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: branches/trunk-reorg/thirdparty/slime/doc/slime.texi
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/slime.texi 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/slime.texi 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2471 @@
+\input texinfo
+-@c %**start of header
+@setfilename slime.info
+@settitle The Superior Lisp Interaction Mode for Emacs
+
+@dircategory Emacs
+@direntry
+* SLIME: (slime). Superior Lisp Interaction Mode for Emacs.
+@end direntry
+-@c %**end of header
+
+@set EDITION 3.0-alpha
+@set SLIMEVER 3.0-alpha
+@c @set UPDATED @today{}
+@set UPDATED @code{$Date: 2007/09/17 13:44:48 $}
+@set TITLE SLIME User Manual
+@settitle @value{TITLE}, version @value{EDITION}
+
+@copying
+Written by Luke Gorrie.
+
+Additional contributions: Jeff Cunningham,
+
+This file has been placed in the public domain.
+@end copying
+
+@titlepage
+@title @value{TITLE}
+@titlefont{version @value{EDITION}}
+@sp 2
+@center @image{slime-small}
+@sp 4
+@subtitle Compiled: @value{UPDATED}
+
+@page
+@insertcopying
+
+@end titlepage
+
+
+@macro SLIME
+@acronym{SLIME}
+@end macro
+
+@macro SLDB
+@acronym{SLDB}
+@end macro
+
+@macro REPL
+@acronym{REPL}
+@end macro
+
+@macro CVS
+@acronym{CVS}
+@end macro
+
+@macro kbditem{key, command}
+@item \key\
+@itemx M-x \command\
+@kindex \key\
+@findex \command\
+@c
+@end macro
+
+@macro kbditempair{key1, key2, command1, command2}
+@item \key1\, M-x \command1\
+@itemx \key2\, M-x \command2\
+@kindex \key1\
+@kindex \key2\
+@findex \command1\
+@findex \command2\
+@c
+@end macro
+
+@macro cmditem{command}
+@item M-x \command\
+@findex \command\
+@c
+@end macro
+
+@macro kbdanchorc{key, command, comment}
+@anchor{\command\}
+@item \key\
+@code{\command\}
+@i{\comment\}@*
+@end macro
+
+@macro fcnindex{name}
+@item \name\
+@xref{\name\}.
+@end macro
+
+@c @setchapternewpage off
+@c @shortcontents
+@contents
+
+@ifnottex
+@node Top
+@top SLIME
+
+@SLIME{} is the ``Superior Lisp Interaction Mode for Emacs''. This is
+the manual for version @value{SLIMEVER}.
+
+@insertcopying
+@end ifnottex
+
+@menu
+* Introduction::
+* Getting started::
+* slime-mode::
+* REPL::
+* Debugger::
+* Extras::
+* Customization::
+* Tips and Tricks::
+* Credits::
+@c * Index to Functions::
+* Key Index::
+* Command Index::
+* Variable Index::
+@end menu
+
+@c -----------------------
+@node Introduction
+@chapter Introduction
+
+@SLIME{} is the ``Superior Lisp Interaction Mode for Emacs.''
+
+@SLIME{} extends Emacs with support for interactive programming in
+Common Lisp. The features are centered around @code{slime-mode}, an
+Emacs minor-mode that complements the standard @code{lisp-mode}. While
+@code{lisp-mode} supports editing Lisp source files, @code{slime-mode}
+adds support for interacting with a running Common Lisp process for
+compilation, debugging, documentation lookup, and so on.
+
+The @code{slime-mode} programming environment follows the example of
+Emacs's native Emacs Lisp environment. We have also included good
+ideas from similar systems (such as @acronym{ILISP}) and some new
+ideas of our own.
+
+@SLIME{} is constructed from two parts: a user-interface written in
+Emacs Lisp, and a supporting server program written in Common
+Lisp. The two sides are connected together with a socket and
+communicate using an @acronym{RPC}-like protocol.
+
+The Lisp server is primarily written in portable Common Lisp. The
+required implementation-specific functionality is specified by a
+well-defined interface and implemented separately for each Lisp
+implementation. This makes @SLIME{} readily portable.
+
+@c -----------------------
+@node Getting started
+@chapter Getting started
+
+This chapter tells you how to get @SLIME{} up and running.
+
+@menu
+* Platforms::
+* Downloading::
+* Installation::
+* Running::
+* Setup Tuning::
+@end menu
+
+@c -----------------------
+@node Platforms
+@section Supported Platforms
+
+@SLIME{} supports a wide range of operating systems and Lisp
+implementations. @SLIME{} runs on Unix systems, Mac OSX, and Microsoft
+Windows. GNU Emacs versions 20, 21 and 22 and XEmacs version 21 are
+supported.
+
+The supported Lisp implementations, roughly ordered from the
+best-supported, are:
+
+@itemize @bullet
+@item
+CMU Common Lisp (@acronym{CMUCL}), 19d or newer
+@item
+Steel Bank Common Lisp (@acronym{SBCL}), 1.0 or newer
+@item
+OpenMCL, version 0.14.3 or newer
+@item
+LispWorks, version 4.3 or newer
+@item
+Allegro Common Lisp (@acronym{ACL}), version 6 or newer
+@item
+@acronym{CLISP}, version 2.35 or newer
+@item
+Armed Bear Common Lisp (@acronym{ABCL})
+@item
+Corman Common Lisp (@acronym{CCL}), version 2.51 or newer with the
+patches from @url{http://www.grumblesmurf.org/lisp/corman-patches})
+@item
+Scieneer Common Lisp (@acronym{SCL}), version 1.2.7 or newer
+@end itemize
+
+Most features work uniformly across implementations, but some are
+prone to variation. These include the precision of placing
+compiler-note annotations, @acronym{XREF} support, and fancy debugger
+commands (like ``restart frame'').
+
+@c -----------------------
+@node Downloading
+@section Downloading SLIME
+
+You can choose between using a released version of @SLIME{} or
+accessing our @CVS{} repository directly. You can download the latest
+released version from our website:
+
+@url{http://www.common-lisp.net/project/slime/}
+
+We recommend that users who participate in the @code{slime-devel}
+mailing list use the @CVS{} version of the code.
+
+@menu
+* CVS::
+* CVS Incantations::
+@end menu
+
+@c -----------------------
+@node CVS
+@subsection Downloading from CVS
+
+@SLIME{} is available from the @CVS{} repository on
+(a)file{common-lisp.net}. You have the option to use either the very
+latest code or the tagged @code{FAIRLY-STABLE} snapshot.
+
+The latest version tends to have more features and fewer bugs than the
+@code{FAIRLY-STABLE} version, but it can be unstable during times of
+major surgery. As a rule-of-thumb recommendation we suggest that if
+you follow the @code{slime-devel} mailing list then you're better off
+with the latest version (we'll send a note when it's undergoing major
+hacking). If you don't follow the mailing list you won't know the
+status of the latest code, so tracking @code{FAIRLY-STABLE} or using a
+released version is the safe option.
+
+If you checkout from @CVS{} then remember to @code{cvs update}
+occasionally. Improvements are continually being committed, and the
+@code{FAIRLY-STABLE} tag is moved forward from time to time.
+
+@menu
+* CVS Incantations::
+@end menu
+
+@c -----------------------
+@node CVS Incantations
+@subsection CVS incantations
+
+To download @SLIME{} you first configure your @code{CVSROOT} and login
+to the repository.
+
+@example
+export CVSROOT=:pserver:anonymous@@common-lisp.net:/project/slime/cvsroot
+cvs login
+@end example
+@emph{(The password is @code{anonymous})}
+
+The latest version can then be checked out with:
+@example
+cvs checkout slime
+@end example
+
+Or the @code{FAIRLY-STABLE} version can be checked out with:
+
+@example
+cvs checkout -rFAIRLY-STABLE slime
+@end example
+
+If you want to find out what's new since the version you're currently
+running, you can diff the local @file{ChangeLog} against the
+repository version:
+
+@example
+cvs diff -rHEAD ChangeLog # or: -rFAIRLY-STABLE
+@end example
+
+@c -----------------------
+@node Installation
+@section Installation
+
+With a Lisp implementation that can be started from the command-line,
+installation just requires a few lines in your @file{~/.emacs}:
+
+@vindex inferior-lisp-program
+@vindex load-path
+@example
+(setq inferior-lisp-program "@emph{the path to your Lisp system}")
+(add-to-list 'load-path "@emph{the path of your @file{slime} directory}")
+(require 'slime)
+(slime-setup)
+@end example
+
+@iftex
+The snippet above also appears in the @file{README} file. You can
+copy&paste it from there, but remember to fill in the appropriate
+paths.
+@end iftex
+
+We recommend not loading the @acronym{ILISP} package into Emacs if you
+intend to use @SLIME{}. Doing so will add a lot of extra bindings to
+the keymap for Lisp source files that may be confusing and may not
+work correctly for a Lisp process started by @SLIME{}.
+
+@c -----------------------
+@node Running
+@section Running SLIME
+
+@SLIME{} is started with the Emacs command @kbd{M-x slime}. This uses
+the @code{inferior-lisp} package to start a Lisp process, loads and
+starts the Lisp-side server (known as ``Swank''), and establishes a
+socket connection between Emacs and Lisp. Finally a @REPL{} buffer is
+created where you can enter Lisp expressions for evaluation.
+
+At this point @SLIME{} is up and running and you can start exploring.
+
+You can restart the @code{inferior-lisp} process using the function:
+@table @kbd
+@cmditem{slime-restart-inferior-lisp}
+@end table
+
+@node Setup Tuning
+@section Setup Tuning
+
+This section explains ways to reduce @SLIME{}'s startup time and how
+to configure @SLIME{} for multiple Lisp systems.
+
+Please proceed with this section only if your basic setup works. If
+you are happy with the basic setup, skip this section.
+
+@menu
+* Autoloading::
+* Multiple Lisps::
+* Loading Swank faster::
+* Loading Contribs::
+@end menu
+
+@node Autoloading
+@subsection Autoloading
+
+The basic setup loads @SLIME{} always, even if you don't use @SLIME{}.
+Emacs will start up a little faster if we load @SLIME{} only on
+demand. To achieve that, you have to change your @file{~/.emacs}
+slightly:
+
+@example
+(setq inferior-lisp-program "@emph{the path to your Lisp system}")
+(add-to-list 'load-path "@emph{the path of your @file{slime} directory}")
+(require 'slime-autoloads)
+(slime-setup)
+@end example
+
+The only difference compared to the basic setup is the line
+@code{(require 'slime-autoloads)}. It tells Emacs that the rest of
+@SLIME{} should be loaded when one of the commands @kbd{M-x slime} or
+@kbd{M-x slime-connect} is executed the first time.
+
+@node Multiple Lisps
+@subsection Multiple Lisps
+
+By default, the command @kbd{M-x slime} starts the program specified
+with @code{inferior-lisp-program}. If you invoke @kbd{M-x slime} with
+a prefix argument, Emacs prompts for the program which should be
+started instead. If you need that frequently or if the command
+involves long filenames it's more convenient to set the
+@code{slime-lisp-implementations} variable in your @file{.emacs}. For
+example here we define two programs:
+
+@vindex slime-lisp-implementations
+@lisp
+(setq slime-lisp-implementations
+ '((cmucl ("cmucl" "-quiet"))
+ (sbcl ("/opt/sbcl/bin/sbcl") :coding-system utf-8-unix)))
+@end lisp
+
+This variable holds a list of programs and if you invoke @SLIME{} with
+a negative prefix argument, @kbd{M-- M-x slime}, you can select a
+program from that list. The elements of the list should look like
+
+@lisp
+(NAME (PROGRAM PROGRAM-ARGS...) &key CODING-SYSTEM INIT INIT-FUNCTION)
+@end lisp
+
+@table @code
+@item NAME
+is a symbol and is used to identify the program.
+@item PROGRAM
+is the filename of the program. Note that the filename can contain
+spaces.
+@item PROGRAM-ARGS
+is a list of command line arguments.
+@item CODING-SYSTEM
+the coding system for the connection.
+@item INIT
+@itemx INIT-FUNCTION
+ ... to be written ...
+@end table
+
+@node Loading Swank faster
+@subsection Loading Swank faster
+
+For SBCL, we recommend that you create a custom core file with socket
+support and @acronym{POSIX} bindings included because those modules
+take the most time to load. To create such a core, execute the
+following steps:
+
+@example
+shell$ sbcl
+* (mapc 'require '(sb-bsd-sockets sb-posix sb-introspect sb-cltl2 asdf))
+* (save-lisp-and-die "sbcl.core-for-slime")
+@end example
+
+After that, add something like this to your @file{.emacs}:
+
+@lisp
+(setq slime-lisp-implementations
+ '((sbcl ("sbcl" "--core" "sbcl.core-for-slime"))))
+@end lisp
+
+For maximum startup speed you can include the Swank server directly in
+a core file. The disadvantage of this approach is that the setup is a
+bit more involved and that you need to create a new core file when you
+want to update @SLIME{} or @acronym{SBCL}. The steps to execute are:
+
+@example
+shell$ sbcl
+* (load ".../slime/swank-loader.lisp")
+* (save-lisp-and-die "sbcl.core-with-slime")
+@end example
+
+@noindent
+Then add this to your @file{.emacs}:
+
+@lisp
+(setq slime-lisp-implementations
+ '((sbcl ("sbcl" "--core" "sbcl.core-with-slime")
+ :init (lambda (port-file _)
+ (format "(swank:start-server %S)\n" port-file)))))
+@end lisp
+
+@noindent
+Similar setups should also work for other Lisp implementations.
+
+@node Loading Contribs
+@subsection Loading Contribs
+... to be written ...
+
+@node slime-mode
+@chapter Using slime-mode
+
+@SLIME{}'s commands are provided via @code{slime-mode}, a minor-mode
+used in conjunction with Emacs's @code{lisp-mode}. This chapter
+describes the @code{slime-mode} and its relatives.
+
+@menu
+* User-interface conventions::
+* Key bindings::
+* Commands::
+* Semantic indentation::
+* Reader conditionals::
+@end menu
+
+@c -----------------------
+@node User-interface conventions
+@section User-interface conventions
+
+To use @SLIME{} comfortably it is important to understand a few
+``global'' user-interface characteristics. The most important
+principles are described in this section.
+
+@menu
+* Temporary buffers::
+* Inferior-lisp::
+* Multithreading::
+@end menu
+
+@c -----------------------
+@node Temporary buffers
+@subsection Temporary buffers
+
+Some @SLIME{} commands create temporary buffers to display their
+results. Although these buffers usually have their own special-purpose
+major-modes, certain conventions are observed throughout.
+
+Temporary buffers can be dismissed by pressing @kbd{q}. This kills the
+buffer and restores the window configuration as it was before the
+buffer was displayed. Temporary buffers can also be killed with the
+usual commands like @code{kill-buffer}, in which case the previous
+window configuration won't be restored.
+
+Pressing @kbd{RET} is supposed to ``do the most obvious useful
+thing.'' For instance, in an apropos buffer this prints a full
+description of the symbol at point, and in an @acronym{XREF} buffer it
+displays the source code for the reference at point. This convention
+is inherited from Emacs's own buffers for apropos listings,
+compilation results, etc.
+
+Temporary buffers containing Lisp symbols use @code{slime-mode} in
+addition to any special mode of their own. This makes the usual
+@SLIME{} commands available for describing symbols, looking up
+function definitions, and so on.
+
+@c -----------------------
+@node Inferior-lisp
+@subsection @code{*inferior-lisp*} buffer
+
+@SLIME{} internally uses the @code{comint} package to start Lisp
+processes. This has a few user-visible consequences, some good and
+some not-so-terribly. To avoid confusion it is useful to understand
+the interactions.
+
+The buffer @code{*inferior-lisp*} contains the Lisp process's own
+top-level. This direct access to Lisp is useful for troubleshooting,
+and some degree of @SLIME{} integration is available using the
+@code{inferior-slime-mode}. However, in normal use we recommend using
+the fully-integrated @SLIME{} @REPL{} and ignoring the
+@code{*inferior-lisp*} buffer.
+
+@c -----------------------
+@node Multithreading
+@subsection Multithreading
+
+If the Lisp system supports multithreading, SLIME spawns a new thread
+for each request, e.g., @kbd{C-x C-e} creates a new thread to evaluate
+the expression. An exception to this rule are requests from the
+@REPL{}: all commands entered in the @REPL{} buffer are evaluated in a
+dedicated @REPL{} thread.
+
+Some complications arise with multithreading and special variables.
+Non-global special bindings are thread-local, e.g., changing the value
+of a let bound special variable in one thread has no effect on the
+binding of the variables with the same name in other threads. This
+makes it sometimes difficult to change the printer or reader behaviour
+for new threads. The variable
+@code{swank:*default-worker-thread-bindings*} was introduced for such
+situtuations: instead of modifying the global value of a variable, add a
+binding the @code{swank:*default-worker-thread-bindings*}. E.g., with
+the following code, new threads will read floating point values as
+doubles by default:
+
+@example
+(push '(*read-default-float-format* . double-float)
+ swank:*default-worker-thread-bindings*).
+@end example
+
+@c -----------------------
+@node Key bindings
+@section Key bindings
+
+@quotation
+@i{``Are you deliberately spiting Emacs's brilliant online help facilities? The gods will be angry!''}
+@end quotation
+
+@noindent This is a brilliant piece of advice. The Emacs online help facilities
+are your most immediate, up-to-date and complete resource for keybinding
+information. They are your friends:
+
+@table @kbd
+@kbdanchorc{C-h k <key>, describe-key, ``What does this key do?''}
+Describes current function bound to @kbd{<key>} for focus buffer.
+
+@kbdanchorc{C-h b, describe-bindings, ``Exactly what bindings are available?''}
+Lists the current key-bindings for the focus buffer.
+
+@kbdanchorc{C-h m, describe-mode, ``Tell me all about this mode''}
+Shows all the available major mode keys, then the minor mode keys, for
+the modes of the focus buffer.
+
+@kbdanchorc{C-h l, view-lossage, ``Woah@comma{} what key chord did I just do?''}
+Shows you the literal sequence of keys you've pressed in order.
+
+
+@c <key> is breaks links PDF, despite that it's not l it's C-h
+@c @kbdanchorc{ <key> l, , ``What starts with?''}
+@c Lists all keybindings that begin with @code{<key>} for the focus buffer mode.
+
+
+@end table
+
+@emph{Note:} In this documentation the designation @kbd{C-h} is a
+@dfn{cannonical key} which might actually mean Ctrl-h, or F1, or
+whatever you have @code{help-command} bound to in your
+(a)code{.emacs}. Here is a common situation:
+
+@example
+(global-set-key [f1] 'help-command)
+(global-set-key "\C-h" 'delete-backward-char)
+@end example
+
+@noindent In this situation everywhere you see @kbd{C-h} in the
+documentation you would substitute @kbd{F1}.
+
+In general we try to make our key bindings fit with the overall Emacs
+style. We also have the following somewhat unusual convention of our
+own: when entering a three-key sequence, the final key can be pressed
+either with control or unmodified. For example, the
+@code{slime-describe-symbol} command is bound to @kbd{C-c C-d d}, but
+it also works to type @kbd{C-c C-d C-d}. We're simply binding both key
+sequences because some people like to hold control for all three keys
+and others don't, and with the two-key prefix we're not afraid of
+running out of keys.
+
+There is one exception to this rule, just to trip you up. We never
+bind @kbd{C-h} anywhere in a key sequence, so @kbd{C-c C-d C-h}
+doesn't do the same thing as @kbd{C-c C-d h}. This is because Emacs
+has a built-in default so that typing a prefix followed by @kbd{C-h}
+will display all bindings starting with that prefix, so @kbd{C-c C-d
+C-h} will actually list the bindings for all documentation commands.
+This feature is just a bit too useful to clobber!
+
+You can assign or change default key bindings globally using the
+@code{global-set-key} function in your @file{~/.emacs} file like this:
+@example
+(global-set-key "\C-c s" 'slime-selector)
+@end example
+@noindent
+which binds @kbd{C-c s} to the function @code{slime-selector}.
+
+Alternatively, if you want to assign or change a key binding in just a
+particular slime mode, you can use the @code{global-set-key} function
+in your @file{~/.emacs} file like this:
+@example
+(define-key slime-repl-mode-map (kbd "C-c ;")
+ 'slime-insert-balanced-comments)
+@end example
+@noindent
+which binds @kbd{C-c ;} to the function
+@code{slime-insert-balanced-comments} in the REPL buffer.
+
+@c -----------------------
+@node Commands
+@section Commands
+
+@acronym{SLIME} commands are divided into the following general
+categories: @strong{Programming, Compilation, Evaluation, Recovery,
+Inspector, and Profiling}, discussed in separate sections below. There
+are also comprehensive indices to commands by function
+(@pxref{Command Index}).
+
+@menu
+* Programming::
+* Compilation::
+* Evaluation::
+* Recovery::
+* Inspector::
+* Profiling::
+* Other::
+@end menu
+
+@c -----------------------
+@node Programming
+@subsection Programming commands
+
+Programming commands are divided into the following categories:
+@strong{Completion, Documentation, Cross-reference, Finding
+definitions, Macro-expansion, and Disassembly}, discussed in
+separate sections below.
+
+@menu
+* Completion::
+* Closure::
+* Indentation::
+* Documentation::
+* Cross-reference::
+* Finding definitions::
+* Macro-expansion::
+* Disassembly::
+@end menu
+
+@c -----------------------
+@node Completion
+@subsubsection Completion commands
+
+Completion commands are used to complete a symbol or form based on
+what is already present at point. Classical completion assumes an
+exact prefix and gives choices only where branches may occur. Fuzzy
+completion tries harder.
+
+@table @kbd
+@kbditem{M-TAB,slime-complete-symbol}
+@itemx ESC TAB
+@itemx C-c C-i
+@itemx C-M-i
+Complete the symbol at point. Note that three styles of completion are
+available in @SLIME{}, and the default differs from normal Emacs
+completion (@pxref{slime-complete-symbol-function}).
+
+@kbditem{C-c C-s, slime-complete-form}
+Looks up and inserts into the current buffer the argument list for the
+function at point, if there is one. More generally, the command
+completes an incomplete form with a template for the missing arguments.
+There is special code for discovering extra keywords of generic
+functions and for handling @code{make-instance} and
+@code{defmethod}. Examples:
+
+@example
+(subseq "abc" <C-c C-s>
+ --inserts--> start [end])
+(find 17 <C-c C-s>
+ --inserts--> sequence :from-end from-end :test test
+ :test-not test-not :start start :end end
+ :key key)
+(find 17 '(17 18 19) :test #'= <C-c C-s>
+ --inserts--> :from-end from-end
+ :test-not test-not :start start :end end
+ :key key)
+(defclass foo () ((bar :initarg :bar)))
+(defmethod print-object <C-c C-s>
+ --inserts--> (object stream)
+ body...)
+(defmethod initialize-instance :after ((object foo) &key blub))
+(make-instance 'foo <C-c C-s>
+ --inserts--> :bar bar :blub blub initargs...)
+@end example
+
+@anchor{slime-fuzzy-complete-symbol}
+@kbditem{C-c M-i, slime-fuzzy-complete-symbol}
+Presents a list of likely completions to choose from for an
+abbreviation at point. This is a third completion method and it is
+very different from the more traditional completion to which
+@command{slime-complete-symbol} defaults. It attempts to complete a
+symbol all at once, instead of in pieces. For example, ``mvb'' will
+find ``@code{multiple-value-bind}'' and ``norm-df'' will find
+``@code{least-positive-normalized-double-float}''. This can also be
+selected as the method of completion used for
+@code{slime-complete-symbol}.
+
+@cmditem{slime-fuzzy-completions-mode}
+@cmditem{slime-fuzzy-abort}
+@end table
+
+
+@c -----------------------
+@node Closure
+@subsubsection Closure commands
+
+Closure commands are used to fill in missing parenthesis.
+
+@table @kbd
+@kbditem{C-c C-q, slime-close-parens-at-point}
+Closes parentheses at point to complete the top-level-form by inserting ')'
+characters at until @code{beginning-of-defun} and @code{end-of-defun}
+execute without errors, or @code{slime-close-parens-limit} is exceeded.
+
+@kbditem{C-], slime-close-all-sexp}
+Balance parentheses of open s-expressions at point.
+Insert enough right-parentheses to balance unmatched left-parentheses.
+Delete extra left-parentheses. Reformat trailing parentheses
+Lisp-stylishly.
+
+If @code{REGION} is true, operate on the region. Otherwise operate on
+the top-level sexp before point.
+@end table
+
+
+@c -----------------------
+@node Indentation
+@subsubsection Indentation commands
+
+@table @kbd
+@kbditem{C-c M-q, slime-reindent-defun}
+Re-indents the current defun, or refills the current paragraph.
+If point is inside a comment block, the text around point will be
+treated as a paragraph and will be filled with @code{fill-paragraph}.
+Otherwise, it will be treated as Lisp code, and the current defun
+will be reindented. If the current defun has unbalanced parens,
+an attempt will be made to fix it before reindenting.
+
+@kbditem{C-M-q, indent-sexp}
+Indents the list immediately following point to match the level at point.
+
+When given a prefix argument, the text around point will always
+be treated as a paragraph. This is useful for filling docstrings."
+@end table
+
+
+@c -----------------------
+@node Documentation
+@subsubsection Documentation commands
+
+@SLIME{}'s online documentation commands follow the example of Emacs
+Lisp. The commands all share the common prefix @kbd{C-c C-d} and allow
+the final key to be modified or unmodified (@pxref{Key bindings}.)
+
+@table @kbd
+
+@kbditem{SPC, slime-space}
+The space key inserts a space, but also looks up and displays the
+argument list for the function at point, if there is one.
+
+@kbditem{C-c C-d d, slime-describe-symbol}
+Describe the symbol at point.
+
+@kbditem{C-c C-f, slime-describe-function}
+Describe the function at point.
+
+@kbditem{C-c C-d a, slime-apropos}
+Perform an apropos search on Lisp symbol names for a regular expression
+match and display their documentation strings. By default the external
+symbols of all packages are searched. With a prefix argument you can choose a
+specific package and whether to include unexported symbols.
+
+@kbditem{C-c C-d z, slime-apropos-all}
+Like @code{slime-apropos} but also includes internal symbols by default.
+
+@kbditem{C-c C-d p, slime-apropos-package}
+Show apropos results of all symbols in a package. This command is for
+browsing a package at a high-level. With package-name completion it
+also serves as a rudimentary Smalltalk-ish image-browser.
+
+@kbditem{C-c C-d h, slime-hyperspec-lookup}
+Lookup the symbol at point in the @cite{Common Lisp Hyperspec}. This
+uses the familiar @file{hyperspec.el} to show the appropriate section
+in a web browser. The Hyperspec is found either on the Web or in
+@code{common-lisp-hyperspec-root}, and the browser is selected by
+@code{browse-url-browser-function}.
+
+Note: this is one case where @kbd{C-c C-d h} is @emph{not} the same as
+@kbd{C-c C-d C-h}.
+
+@kbditem{C-c C-d ~, common-lisp-hyperspec-format}
+Lookup a @emph{format character} in the @cite{Common Lisp Hyperspec}.
+@end table
+
+
+@c -----------------------
+@node Cross-reference
+@subsubsection Cross-reference commands
+
+@SLIME{}'s cross-reference commands are based on the support provided
+by the Lisp system, which varies widely between Lisps. For systems
+with no built-in @acronym{XREF} support @SLIME{} queries a portable
+@acronym{XREF} package, which is taken from the @cite{CMU AI
+Repository} and bundled with @SLIME{}.
+
+Each command operates on the symbol at point, or prompts if there is
+none. With a prefix argument they always prompt. You can either enter
+the key bindings as shown here or with the control modified on the
+last key, @xref{Key bindings}.
+
+@table @kbd
+@kbditem{C-c C-w c, slime-who-calls}
+Show function callers.
+
+@kbditem{C-c C-w w, slime-calls-who}
+Show all known callees.
+
+@kbditem{C-c C-w r, slime-who-references}
+Show references to global variable.
+
+@kbditem{C-c C-w b, slime-who-binds}
+Show bindings of a global variable.
+
+@kbditem{C-c C-w s, slime-who-sets}
+Show assignments to a global variable.
+
+@kbditem{C-c C-w m, slime-who-macroexpands}
+Show expansions of a macro.
+
+@cmditem{slime-who-specializes}
+Show all known methods specialized on a class.
+
+@end table
+
+There are also ``List callers/callees'' commands. These operate by
+rummaging through function objects on the heap at a low-level to
+discover the call graph. They are only available with some Lisp
+systems, and are most useful as a fallback when precise @acronym{XREF}
+information is unavailable.
+
+@table @kbd
+@kbditem{C-c <, slime-list-callers}
+List callers of a function.
+
+@kbditem{C-c >, slime-list-callees}
+List callees of a function.
+
+@end table
+
+
+
+@c -----------------------
+@node Finding definitions
+@subsubsection Finding definitions (``Meta-Point'' commands).
+
+The familiar @kbd{M-.} command is provided. For generic functions this
+command finds all methods, and with some systems it does other fancy
+things (like tracing structure accessors to their @code{DEFSTRUCT}
+definition).
+
+@table @kbd
+
+@kbditem{M-., slime-edit-definition}
+Go to the definition of the symbol at point.
+
+@item M-,
+@itemx M-*
+@itemx M-x slime-pop-find-definition-stack
+@kindex M-,
+@findex slime-pop-find-definition-stack
+Go back to the point where @kbd{M-.} was invoked. This gives multi-level
+backtracking when @kbd{M-.} has been used several times.
+
+@kbditem{C-x 4 ., slime-edit-definition-other-window}
+Like @code{slime-edit-definition} but switchs to the other window to
+edit the definition in.
+
+@kbditem{C-x 5 ., slime-edit-definition-other-frame}
+Like @code{slime-edit-definition} but opens another frame to edit the
+definition in.
+
+@cmditem{slime-edit-definition-with-etags}
+Use an ETAGS table to find definition at point.
+
+@end table
+
+@c -----------------------
+@node Macro-expansion
+@subsubsection Macro-expansion commands
+
+@table @kbd
+@kbditem{C-c C-m, slime-macroexpand-1}
+Macroexpand the expression at point once. If invoked with a prefix
+argument, use macroexpand instead of macroexpand-1.
+
+@kbditem{C-c M-m, slime-macroexpand-all}
+Fully macroexpand the expression at point.
+
+@cmditem{slime-compiler-macroexpand-1}
+Display the compiler-macro expansion of sexp at point.
+
+@cmditem{slime-compiler-macroexpand}
+Repeatedy expamd compiler macros of sexp at point.
+
+@end table
+
+For additional minor-mode commands and discussion,
+@pxref{slime-macroexpansion-minor-mode}.
+
+
+@c -----------------------
+@node Disassembly
+@subsubsection Disassembly commands
+
+@table @kbd
+
+@kbditem{C-c M-d, slime-disassemble-symbol}
+Disassemble the function definition of the symbol at point.
+
+@kbditem{C-c C-t, slime-toggle-trace-fdefinition}
+Toggle tracing of the function at point. If invoked with a prefix
+argument, read additional information, like which particular method
+should be traced.
+
+@cmditem{slime-untrace-all}
+Untrace all functions.
+
+@end table
+
+@c -----------------------
+@node Compilation
+@subsection Compilation commands
+
+@SLIME{} has fancy commands for compiling functions, files, and
+packages. The fancy part is that notes and warnings offered by the
+Lisp compiler are intercepted and annotated directly onto the
+corresponding expressions in the Lisp source buffer. (Give it a try to
+see what this means.)
+
+@table @kbd
+@kbditem{C-c C-c, slime-compile-defun}
+Compile the top-level form at point.
+@cindex compiling functions
+
+@kbditem{C-c C-y, slime-call-defun}
+Insert a call to the function defined around point into the REPL.
+
+@kbditem{C-c C-k, slime-compile-and-load-file}
+Compile and load the current buffer's source file.
+
+@kbditem{C-c M-k, slime-compile-file}
+Compile (but don't load) the current buffer's source file.
+
+@kbditem{C-c C-l, slime-load-file}
+Load a source file and compile if necessary, without loading into a buffer..
+
+@kbditem{C-c C-z, slime-switch-to-output-buffer}
+Select the output buffer, preferably in a different window.
+
+@cmditem{slime-compile-region}
+Compile region at point.
+
+@end table
+
+The annotations are indicated as underlining on source forms. The
+compiler message associated with an annotation can be read either by
+placing the mouse over the text or with the selection commands below.
+
+@table @kbd
+@kbditem{M-n, slime-next-note}
+Move the point to the next compiler note and displays the note.
+
+@kbditem{M-p, slime-previous-note}
+Move the point to the previous compiler note and displays the note.
+
+@kbditem{C-c M-c, slime-remove-notes}
+Remove all annotations from the buffer.
+@end table
+
+@c -----------------------
+@node Evaluation
+@subsection Evaluation commands
+
+These commands each evaluate a Lisp expression in a different way. By
+default they show their results in a message, but a prefix argument
+causes the results to be printed in the @REPL{} instead.
+
+@table @kbd
+
+@kbditem{C-M-x, slime-eval-defun}
+Evaluate the current toplevel form.
+Use @code{slime-re-evaluate-defvar} if the from starts with @code{(defvar}.
+
+@kbditem{C-x C-e, slime-eval-last-expression}
+Evaluate the expression before point.
+@end table
+
+If @kbd{C-M-x} or @kbd{C-x C-e} is given a numeric argument, it inserts the
+value into the current buffer at point, rather than displaying it in the
+echo area.
+
+@table @kbd
+@kbditem{C-c C-p, slime-pprint-eval-last-expression}
+Evaluate the expression before point and pretty-print the result.
+
+@kbditem{C-c C-r, slime-eval-region}
+Evaluate the region.
+
+@kbditem{C-x M-e, slime-eval-last-expression-display-output}
+Display output buffer and evaluate the expression preceding point.
+
+@kbditem{C-c :, slime-interactive-eval}
+Evaluate an expression read from the minibuffer.
+
+@anchor{slime-scratch}
+@cmditem{slime-scratch}
+Create a @file{*slime-scratch*} buffer. In this
+buffer you can enter Lisp expressions and evaluate them with
+@kbd{C-j}, like in Emacs's @file{*scratch*} buffer.
+
+@kbditem{C-c E, slime-edit-value}
+Edit the value of a setf-able form in a new buffer @file{*Edit <form>*}.
+The value is inserted into a temporary buffer for editing and then set
+in Lisp when committed with @code{slime-edit-value-commit}.
+
+@kbditem{C-c C-u, slime-undefine-function}
+Unbind symbol for function at point.
+@end table
+
+
+@c -----------------------
+@node Recovery
+@subsection Abort/Recovery commands
+
+@table @kbd
+@kbditem{C-c C-b, slime-interrupt}
+Interrupt Lisp (send @code{SIGINT}).
+
+@kbditem{C-c ~, slime-sync-package-and-default-directory}
+Synchronize the current package and working directory from Emacs to
+Lisp.
+
+@kbditem{C-c M-p, slime-repl-set-package}
+Set the current package of the @acronym{REPL}.
+
+@end table
+
+@c -----------------------
+@node Inspector
+@subsection Inspector commands
+
+The @SLIME{} inspector is a very fancy Emacs-based alternative to the
+standard @code{INSPECT} function. The inspector presents objects in
+Emacs buffers using a combination of plain text, hyperlinks to related
+objects, and ``actions'' that can be selected to invoke Lisp code on
+the inspected object. For example, to present a generic function the
+inspector shows the documentation in plain text and presents each
+method with both a hyperlink to inspect the method object and a
+``remove method'' action that you can invoke interactively.
+
+The inspector can easily be specialized for the objects in your own
+programs. For details see the the @code{inspect-for-emacs} generic
+function in @file{swank-backend.lisp}.
+
+@table @kbd
+
+@kbditem{C-c I, slime-inspect}
+Inspect the value of an expression entered in the minibuffer.
+
+@end table
+
+The standard commands available in the inspector are:
+
+@table @kbd
+
+@kbditem{RET, slime-inspector-operate-on-point}
+If point is on a value then recursivly call the inspcetor on that
+value. If point is on an action then call that action.
+
+@kbditem{d, slime-inspector-describe}
+Describe the slot at point.
+
+@kbditem{l, slime-inspector-pop}
+Go back to the previous object (return from @kbd{RET}).
+
+@kbditem{n, slime-inspector-next}
+The inverse of @kbd{l}. Also bound to @kbd{SPC}.
+
+@kbditem{q, slime-inspector-quit}
+Dismiss the inspector buffer.
+
+@kbditem{M-RET, slime-inspector-copy-down}
+Evaluate the value under point via the REPL (to set `*').
+
+@end table
+
+@c -----------------------
+@node Profiling
+@subsection Profiling commands
+
+@table @kbd
+@cmditem{slime-toggle-profile-fdefinition}
+Toggle profiling of a function.
+@cmditem{slime-profile-package}
+Profile all functions in a package.
+@cmditem{slime-unprofile-all}
+Unprofile all functions.
+@cmditem{slime-profile-report}
+Report profiler data.
+@cmditem{slime-profile-reset}
+Reset profiler data.
+@cmditem{slime-profiled-functions}
+Show list of currently profiled functions.
+@end table
+
+@c -----------------------
+@node Other
+@subsection Shadowed Commands
+
+@table @kbd
+
+@kbditempair{C-c C-a, C-c C-v, slime-nop, slime-nop}
+This key-binding is shadowed from inf-lisp.
+
+@end table
+
+@c -----------------------
+@node Semantic indentation
+@section Semantic indentation
+
+@SLIME{} automatically discovers how to indent the macros in your Lisp
+system. To do this the Lisp side scans all the macros in the system and
+reports to Emacs all the ones with @code{&body} arguments. Emacs then
+indents these specially, putting the first arguments four spaces in and
+the ``body'' arguments just two spaces, as usual.
+
+This should ``just work.'' If you are a lucky sort of person you needn't
+read the rest of this section.
+
+To simplify the implementation, @SLIME{} doesn't distinguish between
+macros with the same symbol-name but different packages. This makes it
+fit nicely with Emacs's indentation code. However, if you do have
+several macros with the same symbol-name then they will all be indented
+the same way, arbitrarily using the style from one of their
+arglists. You can find out which symbols are involved in collisions
+with:
+
+@example
+(swank:print-indentation-lossage)
+@end example
+
+If a collision causes you irritation, don't have a nervous breakdown,
+just override the Elisp symbol's @code{common-lisp-indent-function}
+property to your taste. @SLIME{} won't override your custom settings, it
+just tries to give you good defaults.
+
+A more subtle issue is that imperfect caching is used for the sake of
+performance. @footnote{@emph{Of course} we made sure it was actually too
+slow before making the ugly optimization.}
+
+In an ideal world, Lisp would automatically scan every symbol for
+indentation changes after each command from Emacs. However, this is too
+expensive to do every time. Instead Lisp usually just scans the symbols
+whose home package matches the one used by the Emacs buffer where the
+request comes from. That is sufficient to pick up the indentation of
+most interactively-defined macros. To catch the rest we make a full scan
+of every symbol each time a new Lisp package is created between commands
+-- that takes care of things like new systems being loaded.
+
+You can use @kbd{M-x slime-update-indentation} to force all symbols to
+be scanned for indentation information.
+
+@c -----------------------
+@node Reader conditionals
+@section Reader conditional fontification
+
+@SLIME{} automatically evaluates reader-conditional expressions in
+source buffers and ``grays out'' code that will be skipped for the
+current Lisp connection.
+
+
+@c -----------------------
+@node REPL
+@chapter REPL: the ``top level''
+
+@SLIME{} uses a custom Read-Eval-Print Loop (@REPL{}, also known as a
+``top level''). The @REPL{} user-interface is written in Emacs Lisp,
+which gives more Emacs-integration than the traditional
+@code{comint}-based Lisp interaction:
+
+@itemize @bullet
+@item
+Conditions signalled in @REPL{} expressions are debugged with @SLDB{}.
+@item
+Return values are distinguished from printed output by separate Emacs
+faces (colours).
+@item
+Emacs manages the @REPL{} prompt with markers. This ensures that Lisp
+output is inserted in the right place, and doesn't get mixed up with
+user input.
+@end itemize
+
+@menu
+* REPL commands::
+* Input Navigation::
+* Shortcuts::
+@end menu
+
+@c -----------------------
+@node REPL commands
+@section REPL commands
+
+@table @kbd
+
+@kbditem{RET, slime-repl-return}
+Evaluate the current input in Lisp if it is complete. If incomplete,
+open a new line and indent. If a prefix argument is given then the
+input is evaluated without checking for completeness.
+
+@kbditem{C-RET, slime-repl-closing-return}
+Close any unmatched parenthesis and then evaluate the current input in
+Lisp. Also bound to @kbd{M-RET}.
+
+@kbditem{C-j, slime-repl-newline-and-indent}
+Open and indent a new line.
+
+@c @anchor{slime-interrupt}
+@kbditem{C-c C-c, slime-interrupt}
+Interrupt the Lisp process with @code{SIGINT}.
+
+@kbditem{C-c M-g, slime-quit}
+Quit slime.
+
+@kbditem{C-c C-o, slime-repl-clear-output}
+Remove the output and result of the previous expression from the
+buffer.
+
+@kbditem{C-c C-t, slime-repl-clear-buffer}
+Clear the entire buffer, leaving only a prompt.
+
+@end table
+
+@c -----------------------
+@node Input Navigation
+@section Input navigation
+
+@table @kbd
+
+@kbditem{C-a, slime-repl-bol}
+Go to the beginning of the line, but stop at the @REPL{} prompt.
+
+@kbditempair{M-n, M-p, slime-repl-next-input, slime-repl-previous-input}
+Go to next/previous in command history.
+
+@kbditempair{M-s, M-r,
+slime-repl-next-matching-input, slime-repl-previous-matching-input}
+Search forward/reverse through command history with regex
+
+@c @code{slime-repl-@{next,previous@}-input}@*
+@c @code{slime-repl-@{next,previous@}-matching-input}@*
+@c @code{comint}-style input history commands.
+
+@kbditempair{C-c C-n, C-c C-p,
+slime-repl-next-prompt, slime-repl-previous-prompt}
+Move between the current and previous prompts in the @REPL{} buffer.
+
+@kbditempair{C-M-a, C-M-e,
+slime-repl-beginning-of-defun, slime-repl-end-of-defun}
+These commands are like @code{beginning-of-defun} and
+@code{end-of-defun}, but when used inside the @REPL{} input area they
+instead go directly to the beginning or the end, respectively.
+
+@end table
+
+@c -----------------------
+@comment node-name, next, previous, up
+@node Shortcuts
+@section Shortcuts
+
+``Shortcuts'' are a special set of @REPL{} commands that are invoked
+by name. To invoke a shortcut you first press @kbd{,} (comma) at the
+@REPL{} prompt and then enter the shortcut's name when prompted.
+
+Shortcuts deal with things like switching between directories and
+compiling and loading Lisp systems. The set of shortcuts is listed
+below, and you can also use the @code{help}
+shortcut to list them interactively.
+
+@table @kbd
+@item change-directory (aka !d, cd)
+Change the current directory.
+
+@item change-package (aka !p)
+Change the current package.
+
+@item compile-and-load (aka cl)
+Compile (if neccessary) and load a lisp file.
+
+@item compile-system
+Compile (but not load) an ASDF system.
+
+@item defparameter (aka !)
+Define a new global, special, variable.
+
+@item force-compile-system
+Recompile (but not load) an ASDF system.
+
+@item force-load-system
+Recompile and load an ASDF system.
+
+@item help (aka ?)
+Display the help.
+
+@item load-system
+Compile (as needed) and load an ASDF system.
+
+@item pop-directory (aka -d)
+Pop the current directory.
+
+@item pop-package (aka -p)
+Pop the top of the package stack.
+
+@item push-directory (aka +d, pushd)
+Push a new directory onto the directory stack.
+
+@item push-package (aka +p)
+Push a package onto the package stack.
+
+@item pwd
+Show the current directory.
+
+@item quit
+Quit the current Lisp.
+
+@item resend-form
+Resend the last form.
+
+@item restart-inferior-lisp
+Restart *inferior-lisp* and reconnect SLIME.
+
+@item sayoonara
+Quit all Lisps and close all SLIME buffers.
+
+@end table
+
+@c -----------------------
+@node Debugger
+@chapter SLDB: the SLIME debugger
+
+@SLIME{} has a custom Emacs-based debugger called @SLDB{}. Conditions
+signalled in the Lisp system invoke @SLDB{} in Emacs by way of the
+Lisp @code{*DEBUGGER-HOOK*}.
+
+@SLDB{} pops up a buffer when a condition is signalled. The buffer
+displays a description of the condition, a list of restarts, and a
+backtrace. Commands are offered for invoking restarts, examining the
+backtrace, and poking around in stack frames.
+
+@menu
+* Examining frames::
+* Restarts::
+* Frame Navigation::
+* Miscellaneous::
+@end menu
+
+@c -----------------------
+@node Examining frames
+@section Examining frames
+
+Commands for examining the stack frame at point.
+
+@table @kbd
+@kbditem{t, sldb-toggle-details}
+Toggle display of local variables and @code{CATCH} tags.
+
+@kbditem{v, sldb-show-source}
+View the frame's current source expression. The expression is
+presented in the Lisp source file's buffer.
+
+@kbditem{e, sldb-eval-in-frame}
+Evaluate an expression in the frame. The expression can refer to the
+available local variables in the frame.
+
+@kbditem{d, sldb-pprint-eval-in-frame}
+Evaluate an expression in the frame and pretty-print the result in a
+temporary buffer.
+
+@kbditem{D, sldb-disassemble}
+Disassemble the frame's function. Includes information such as the
+instruction pointer within the frame.
+
+@kbditem{i, sldb-inspect-in-frame}
+Inspect the result of evaluating an expression in the frame.
+@end table
+
+@c -----------------------
+@node Restarts
+@section Invoking restarts
+
+@table @kbd
+@kbditem{a, sldb-abort}
+Invoke the @code{ABORT} restart.
+
+@kbditem{q, sldb-quit}
+``Quit'' -- @code{THROW} to a tag that the top-level @SLIME{}
+request-loop catches.
+
+@kbditem{c, sldb-continue}
+Invoke the @code{CONTINUE} restart.
+
+@item 0 ... 9
+Invoke a restart by number.
+@end table
+
+Restarts can also be invoked by pressing @kbd{RET} or @kbd{Mouse-2} on
+them in the buffer.
+
+@c -----------------------
+@node Frame Navigation
+@section Navigating between frames
+
+@table @kbd
+@kbditempair{n,p,sldb-down,sldb-up}
+Move between frames.
+
+@kbditempair{M-n, M-p, sldb-details-down, sldb-details-up}
+Move between frames ``with sugar'': hide the details of the original
+frame and display the details and source code of the next. Sugared
+motion makes you see the details and source code for the current frame
+only.
+@end table
+
+@c -----------------------
+@node Miscellaneous
+@section Miscellaneous Commands
+
+@table @kbd
+@kbditem{r, sldb-restart-frame}
+Restart execution of the frame with the same arguments it was
+originally called with. (This command is not available in all
+implementations.)
+
+@kbditem{R, sldb-return-from-frame}
+Return from the frame with a value entered in the minibuffer. (This
+command is not available in all implementations.)
+
+@kbditem{s, sldb-step}
+Step to the next expression in the frame. (This command is not
+available in all implementations.)
+
+@kbditem{B, sldb-break-with-default-debugger}
+Exit @SLDB{} and debug the condition using the Lisp system's default
+debugger.
+
+@kbditem{C-c :, slime-interactive-eval}
+Evaluate an expression entered in the minibuffer.
+@end table
+
+
+@c -----------------------
+@node Extras
+@chapter Extras
+
+@menu
+* slime-selector::
+* slime-autodoc-mode::
+* slime-macroexpansion-minor-mode::
+* Multiple connections::
+* Typeout frames::
+@end menu
+
+@c -----------------------
+@node slime-selector
+@section @code{slime-selector}
+
+The @code{slime-selector} command is for quickly switching to
+important buffers: the @REPL{}, @SLDB{}, the Lisp source you were just
+hacking, etc. Once invoked the command prompts for a single letter to
+specify which buffer it should display. Here are some of the options:
+
+@table @kbd
+@item ?
+A help buffer listing all @code{slime-selectors}'s available buffers.
+@item r
+The @REPL{} buffer for the current @SLIME{} connection.
+@item d
+The most recently activated @SLDB{} buffer for the current connection.
+@item l
+The most recently visited @code{lisp-mode} source buffer.
+@item s
+The @code{*slime-scratch*} buffer (@pxref{slime-scratch}).
+@end table
+
+@code{slime-selector} doesn't have a key binding by default but we
+suggest that you assign it a global one. You can bind it to @kbd{C-c s}
+like this:
+
+@example
+(global-set-key "\C-cs" 'slime-selector)
+@end example
+
+@noindent
+And then you can switch to the @REPL{} from anywhere with @kbd{C-c s
+r}.
+
+The macro @code{def-slime-selector-method} can be used to define new
+buffers for @code{slime-selector} to find.
+
+@c -----------------------
+@node slime-autodoc-mode
+@section @code{slime-autodoc-mode}
+
+@table @kbd
+@cmditem{slime-autodoc-mode}
+Autodoc mode is an additional minor-mode for automatically showing
+information about symbols near the point. For function names the
+argument list is displayed, and for global variables, the value.
+This is a clone of @code{eldoc-mode} for Emacs Lisp.
+@end table
+
+The mode can be enabled by default in the @code{slime-setup} call of your
+(a)code{~/.emacs}:
+@example
+(slime-setup '(slime-autodoc))
+@end example
+
+@c -----------------------
+@node slime-macroexpansion-minor-mode
+@section slime-macroexpansion-minor-mode
+
+Within a slime macroexpansion buffer some extra commands are provided
+(these commands are always available but are only bound to keys in a
+macroexpansion buffer).
+
+@table @kbd
+@kbditem{C-c C-m, slime-macroexpand-1-inplace}
+Just like slime-macroexpand-1 but the original form is replaced with
+the expansion.
+
+@c @anchor{slime-macroexpand-1-inplace}
+@kbditem{g, slime-macroexpand-1-inplace}
+The last macroexpansion is performed again, the current contents of
+the macroexpansion buffer are replaced with the new expansion.
+
+@kbditem{q, slime-temp-buffer-quit}
+Close the expansion buffer.
+
+@end table
+
+@c -----------------------
+@node Multiple connections
+@section Multiple connections
+
+@SLIME{} is able to connect to multiple Lisp processes at the same
+time. The @kbd{M-x slime} command, when invoked with a prefix
+argument, will offer to create an additional Lisp process if one is
+already running. This is often convenient, but it requires some
+understanding to make sure that your @SLIME{} commands execute in the
+Lisp that you expect them to.
+
+Some buffers are tied to specific Lisp processes. Each Lisp connection
+has its own @acronym{REPL} buffer, and all expressions entered or
+@SLIME{} commands invoked in that buffer are sent to the associated
+connection. Other buffers created by @SLIME{} are similarly tied to
+the connections they originate from, including @SLDB{} buffers,
+apropos result listings, and so on. These buffers are the result of
+some interaction with a Lisp process, so commands in them always go
+back to that same process.
+
+Commands executed in other places, such as @code{slime-mode} source
+buffers, always use the ``default'' connection. Usually this is the
+most recently established connection, but this can be reassigned via
+the ``connection list'' buffer:
+
+@table @kbd
+@kbditem{C-c C-x c, slime-list-connections}
+Pop up a buffer listing the established connections.
+
+@kbditem{C-c C-x t, slime-list-threads}
+Pop up a buffer listing the current threads.
+
+@end table
+
+The buffer displayed by @code{slime-list-connections} gives a one-line
+summary of each connection. The summary shows the connection's serial
+number, the name of the Lisp implementation, and other details of the
+Lisp process. The current ``default'' connection is indicated with an
+asterisk.
+
+The commands available in the connection-list buffer are:
+
+@table @kbd
+@kbditem{RET, slime-goto-connection}
+Pop to the @acronym{REPL} buffer of the connection at point.
+
+@kbditem{d, slime-connection-list-make-default}
+Make the connection at point the ``default'' connection. It will then
+be used for commands in @code{slime-mode} source buffers.
+
+@kbditem{g, slime-update-connection-list}
+Update the connection list in the buffer.
+
+@kbditem{q, slime-temp-buffer-quit}
+Quit the connection list (kill buffer, restore window configuration).
+
+@kbditem{R, slime-restart-connection-at-point}
+Restart the Lisp process for the connection at point.
+
+@cmditem{slime-connect}
+Connect to a running Swank server.
+
+@cmditem{slime-disconnect}
+Disconnect all connections.
+
+@cmditem{slime-abort-connection}
+Abort the current attempt to connect.
+
+@end table
+
+@c -----------------------
+@node Typeout frames
+@section Typeout frames
+
+A ``typeout frame'' is a special Emacs frame which is used instead of
+the echo area (minibuffer) to display messages from @SLIME{} commands.
+This is an optional feature. The advantage of a typeout frame over the
+echo area is that it can hold more text, it can be scrolled, and its
+contents don't disappear when you press a key. All potentially long
+messages are sent to the typeout frame, such as argument lists, macro
+expansions, and so on.
+
+@table @kbd
+@cmditem{slime-ensure-typeout-frame}
+Ensure that a typeout frame exists, creating one if necessary.
+@end table
+
+If the typeout frame is closed then the echo area will be used again
+as usual.
+
+To have a typeout frame created automatically at startup you can add
+the @code{slime-connected-hook} to your @file{~/.emacs} file:
+
+@example
+(add-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
+@end example
+
+@c -----------------------
+@node Customization
+@chapter Customization
+
+@menu
+* Emacs-side customization::
+* Lisp-side::
+@end menu
+
+@c -----------------------
+@node Emacs-side customization
+@section Emacs-side
+
+The Emacs part of @SLIME{} can be configured with the Emacs
+@code{customize} system, just use @kbd{M-x customize-group slime
+RET}. Because the customize system is self-describing, we only cover a
+few important or obscure configuration options here in the manual.
+
+@table @code
+
+@item slime-truncate-lines
+The value to use for @code{truncate-lines} in line-by-line summary
+buffers popped up by @SLIME{}. This is @code{t} by default, which
+ensures that lines do not wrap in backtraces, apropos listings, and so
+on. It can however cause information to spill off the screen.
+
+@anchor{slime-complete-symbol-function}
+@vindex slime-complete-symbol-function
+@item slime-complete-symbol-function
+The function to use for completion of Lisp symbols. Three completion
+styles are available. The default @code{slime-complete-symbol*}
+performs completion ``in parallel'' over the hyphen-delimited
+sub-words of a symbol name.
+@footnote{This style of completion is modelled on @file{completer.el}
+by Chris McConnell. That package is bundled with @acronym{ILISP}.}
+Formally this means that ``@code{a-b-c}'' can complete to any symbol
+matching the regular expression ``(a)code{^a.*-b.*-c.*}'' (where ``dot''
+matches anything but a hyphen). Examples give a more intuitive
+feeling:
+@itemize @bullet
+@item
+@code{m-v-b} completes to @code{multiple-value-bind}.
+@item
+@code{w-open} is ambiguous: it completes to either
+@code{with-open-file} or @code{with-open-stream}. The symbol is
+expanded to the longest common completion (@code{with-open-}) and the
+point is placed at the first point of ambiguity, which in this case is
+the end.
+@item
+@code{w--stream} completes to @code{with-open-stream}.
+@end itemize
+An alternative is @code{slime-simple-complete-symbol}, which
+completes in the usual Emacs way. Finally, there is
+@code{slime-fuzzy-complete-symbol}, which is quite different from both
+of the above and tries to find best matches to an abbreviated symbol.
+It also has its own key binding, defaulting to @kbd{C-c M-i}.
+@xref{slime-fuzzy-complete-symbol}, for more information.
+
+@vindex slime-filename-translations
+@item slime-filename-translations
+This variable controls filename translation between Emacs and the Lisp
+system. It is useful if you run Emacs and Lisp on separate machines
+which don't share a common file system or if they share the filessytem
+but have different layouts, as is the case with @acronym{SMB}-based
+file sharing.
+
+@vindex slime-net-coding-system
+@item slime-net-coding-system
+If you want to transmit Unicode characters between Emacs and the Lisp
+system, you should customize this variable. E.g., if you use SBCL, you
+can set:
+@example
+(setq slime-net-coding-system 'utf-8-unix)
+@end example
+To actually display Unicode characters you also need appropriate fonts,
+otherwise the characters will be rendered as hollow boxes. If you are
+using Allegro CL and GNU Emacs, you can also use @code{emacs-mule-unix}
+as coding system. GNU Emacs has often nicer fonts for the latter
+encoding.
+
+@end table
+
+@menu
+* Hooks::
+@end menu
+
+@c -----------------------
+@node Hooks
+@subsection Hooks
+
+@table @code
+
+@vindex slime-mode-hook
+@item slime-mode-hook
+This hook is run each time a buffer enters @code{slime-mode}. It is
+most useful for setting buffer-local configuration in your Lisp source
+buffers. An example use is to enable @code{slime-autodoc-mode}
+(@pxref{slime-autodoc-mode}).
+
+@vindex slime-connected-hook
+@item slime-connected-hook
+This hook is run when @SLIME{} establishes a connection to a Lisp
+server. An example use is to create a Typeout frame (@xref{Typeout frames}.)
+
+@vindex sldb-hook
+@item sldb-hook
+This hook is run after @SLDB{} is invoked. The hook functions are
+called from the @SLDB{} buffer after it is initialized. An example use
+is to add @code{sldb-print-condition} to this hook, which makes all
+conditions debugged with @SLDB{} be recorded in the @REPL{} buffer.
+
+@end table
+
+@c -----------------------
+@node Lisp-side
+@section Lisp-side (Swank)
+
+The Lisp server side of @SLIME{} (known as ``Swank'') offers several
+variables to configure. The initialization file @file{~/.swank.lisp}
+is automatically evaluated at startup and can be used to set these
+variables.
+
+@menu
+* Communication style::
+* Other configurables::
+@end menu
+
+@c -----------------------
+@node Communication style
+@subsection Communication style
+@vindex SWANK:*COMMUNICATION-STYLE*
+
+The most important configurable is @code{SWANK:*COMMUNICATION-STYLE*},
+which specifies the mechanism by which Lisp reads and processes
+protocol messages from Emacs. The choice of communication style has a
+global influence on @SLIME{}'s operation.
+
+The available communication styles are:
+
+@table @code
+@item NIL
+This style simply loops reading input from the communication socket
+and serves @SLIME{} protocol events as they arise. The simplicity
+means that the Lisp cannot do any other processing while under
+@SLIME{}'s control.
+
+@item :FD-HANDLER
+This style uses the classical Unix-style ``@code{select()}-loop.''
+Swank registers the communication socket with an event-dispatching
+framework (such as @code{SERVE-EVENT} in @acronym{CMUCL} and
+@acronym{SBCL}) and receives a callback when data is available. In
+this style requests from Emacs are only detected and processed when
+Lisp enters the event-loop. This style is simple and predictable.
+
+@item :SIGIO
+This style uses @dfn{signal-driven I/O} with a @code{SIGIO} signal
+handler. Lisp receives requests from Emacs along with a signal,
+causing it to interrupt whatever it is doing to serve the
+request. This style has the advantage of responsiveness, since Emacs
+can perform operations in Lisp even while it is busy doing other
+things. It also allows Emacs to issue requests concurrently, e.g. to
+send one long-running request (like compilation) and then interrupt
+that with several short requests before it completes. The
+disadvantages are that it may conflict with other uses of @code{SIGIO}
+by Lisp code, and it may cause untold havoc by interrupting Lisp at an
+awkward moment.
+
+@item :SPAWN
+This style uses multiprocessing support in the Lisp system to execute
+each request in a separate thread. This style has similar properties
+to @code{:SIGIO}, but it does not use signals and all requests issued
+by Emacs can be executed in parallel.
+
+@end table
+
+The default request handling style is chosen according to the
+capabilities of your Lisp system. The general order of preference is
+@code{:SPAWN}, then @code{:SIGIO}, then @code{:FD-HANDLER}, with
+@code{NIL} as a last resort. You can check the default style by
+calling @code{SWANK-BACKEND:PREFERRED-COMMUNICATION-STYLE}. You can
+also override the default by setting
+@code{SWANK:*COMMUNICATION-STYLE*} in your Swank init file.
+
+@c -----------------------
+@node Other configurables
+@subsection Other configurables
+
+These Lisp variables can be configured via your @file{~/.swank.lisp}
+file:
+
+@table @code
+
+@vindex SWANK:*CONFIGURE-EMACS-INDENTATION*
+@item SWANK:*CONFIGURE-EMACS-INDENTATION*
+This variable controls whether indentation styles for
+@code{&body}-arguments in macros are discovered and sent to Emacs. It
+is enabled by default.
+
+@vindex SWANK:*GLOBALLY-REDIRECT-IO*
+@item SWANK:*GLOBALLY-REDIRECT-IO*
+When true this causes the standard streams (@code{*standard-output*},
+etc) to be globally redirected to the @REPL{} in Emacs. When
+@code{NIL} (the default) these streams are only temporarily redirected
+to Emacs using dynamic bindings while handling requests. Note that
+@code{*standard-input*} is currently never globally redirected into
+Emacs, because it can interact badly with the Lisp's native @REPL{} by
+having it try to read from the Emacs one.
+
+@vindex SWANK:*GLOBAL-DEBUGGER*
+@item SWANK:*GLOBAL-DEBUGGER*
+When true (the default) this causes @code{*DEBUGGER-HOOK*} to be
+globally set to @code{SWANK:SWANK-DEBUGGER-HOOK} and thus for @SLIME{}
+to handle all debugging in the Lisp image. This is for debugging
+multithreaded and callback-driven applications.
+
+@vindex SWANK:*SLDB-PRINTER-BINDINGS*
+@vindex SWANK:*MACROEXPAND-PRINTER-BINDINGS*
+@vindex SWANK:*SWANK-PPRINT-BINDINGS*
+@item SWANK:*SLDB-PRINTER-BINDINGS*
+@itemx SWANK:*MACROEXPAND-PRINTER-BINDINGS*
+@itemx SWANK:*SWANK-PPRINT-BINDINGS*
+These variables can be used to customize the printer in various
+situations. The values of the variables are association lists of
+printer variable names with the corresponding value. E.g., to enable
+the pretty printer for formatting backtraces in @SLDB{}, you can use:
+@example
+(push '(*print-pretty* . t) swank:*sldb-printer-bindings*).
+@end example
+
+@vindex SWANK:*USE-DEDICATED-OUTPUT-STREAM*
+@item SWANK:*USE-DEDICATED-OUTPUT-STREAM*
+This variable controls whether to use an unsafe efficiency hack for
+sending printed output from Lisp to Emacs. The default is @code{nil},
+don't use it, and is strongly recommended to keep.
+
+When @code{t}, a separate socket is established solely for Lisp to send
+printed output to Emacs through, which is faster than sending the output
+in protocol-messages to Emacs. However, as nothing can be guaranteed
+about the timing between the dedicated output stream and the stream of
+protocol messages, the output of a Lisp command can arrive before or
+after the corresponding REPL results. Thus output and REPL results can
+end up in the wrong order, or even interleaved, in the REPL buffer.
+Using a dedicated output stream also makes it more difficult to
+communicate to a Lisp running on a remote host via SSH
+(@pxref{Connecting to a remote lisp}).
+
+@vindex SWANK:*DEDICATED-OUTPUT-STREAM-PORT*
+@item SWANK:*DEDICATED-OUTPUT-STREAM-PORT*
+When @code{*USE-DEDICATED-OUTPUT-STREAM*} is @code{t} the stream will
+be opened on this port. The default value, @code{0}, means that the
+stream will be opened on some random port.
+
+@vindex SWANK:*LOG-EVENTS*
+@item SWANK:*LOG-EVENTS*
+Setting this variable to @code{t} causes all protocol messages
+exchanged with Emacs to be printed to @code{*TERMINAL-IO*}. This is
+useful for low-level debugging and for observing how @SLIME{} works
+``on the wire.'' The output of @code{*TERMINAL-IO*} can be found in
+your Lisp system's own listener, usually in the buffer
+@code{*inferior-lisp*}.
+
+@end table
+
+@c -----------------------
+@node Tips and Tricks
+@chapter Tips and Tricks
+
+@menu
+* Connecting to a remote lisp::
+* Global IO Redirection::
+* Auto-SLIME::
+@end menu
+
+@c -----------------------
+@node Connecting to a remote lisp
+@section Connecting to a remote lisp
+
+One of the advantages of the way @SLIME{} is implemented is that we
+can easily run the Emacs side (slime.el) on one machine and the lisp
+backend (swank) on another. The basic idea is to start up lisp on the
+remote machine, load swank and wait for incoming slime connections. On
+the local machine we start up emacs and tell slime to connect to the
+remote machine. The details are a bit messier but the underlying idea
+is that simple.
+
+@menu
+* Setting up the lisp image::
+* Setting up Emacs::
+* Setting up pathname translations::
+@end menu
+
+@c -----------------------
+@node Setting up the lisp image
+@subsection Setting up the lisp image
+
+
+When you want to load swank without going through the normal, Emacs
+based, process just load the @file{swank-loader.lisp} file. Just
+execute
+
+@example
+(load "/path/to/swank-loader.lisp")
+@end example
+
+inside a running lisp image@footnote{@SLIME{} also provides an
+@acronym{ASDF} system definiton which does the same thing}. Now all we
+need to do is startup our swank server. The first example assumes we're
+using the default settings.
+
+@example
+(swank:create-server)
+@end example
+
+Since we're going to be tunneling our connection via
+ssh@footnote{there is a way to connect without an ssh tunnel, but it
+has the side-effect of giving the entire world access to your lisp
+image, so we're not going to talk about it} and we'll only have one
+port open we want to tell swank to not use an extra connection for
+output (this is actually the default in current SLIME):
+
+@example
+(setf swank:*use-dedicated-output-stream* nil)
+@end example
+
+@c -----------------------
+If you need to do anything particular
+(like be able to reconnect to swank after you're done), look into
+@code{swank:create-server}'s other arguments. Some of these arguments
+are
+@table @code
+
+@item :PORT
+Port number for the server to listen on (default: 4005).
+@item :STYLE
+See @xref{Communication style}.
+@item :DONT-CLOSE
+Boolean indicating if the server will continue to accept connections
+after the first one (default: @code{NIL}). For ``long-running'' lisp processes
+to which you want to be able to connect from time to time,
+specify @code{:dont-close t}
+@item :CODING-SYSTEM
+String designating the encoding to be used to communicate between the
+Emacs and Lisp.
+@end table
+
+So the more complete example will be
+@example
+(swank:create-server :port 4005 :dont-close t :coding-system "utf-8-unix")
+@end example
+On the emacs side you will use something like
+@example
+(setq slime-net-coding-system 'utf-8-unix)
+(slime-connect "127.0.0.1" 4005))
+@end example
+to connect to this lisp image from the same machine.
+
+
+@node Setting up Emacs
+@subsection Setting up Emacs
+
+Now we need to create the tunnel between the local machine and the
+remote machine.
+
+@example
+ssh -L4005:127.0.0.1:4005 username@@remote.example.com
+@end example
+
+That ssh invocation creates an ssh tunnel between the port 4005 on our
+local machine and the port 4005 on the remote machine@footnote{By
+default swank listens for incoming connections on port 4005, had we
+passed a @code{:port} parameter to @code{swank:create-server} we'd be
+using that port number instead}.
+
+Finally we can start @SLIME{}:
+
+@example
+M-x slime-connect RET RET
+@end example
+
+The @kbd{RET RET} sequence just means that we want to use the default
+host (@code{127.0.0.1}) and the default port (@code{4005}). Even
+though we're connecting to a remote machine the ssh tunnel fools Emacs
+into thinking it's actually @code{127.0.0.1}.
+
+@c -----------------------
+@node Setting up pathname translations
+@subsection Setting up pathname translations
+
+One of the main problems with running swank remotely is that Emacs
+assumes the files can be found using normal filenames. if we want
+things like @code{slime-compile-and-load-file} (@kbd{C-c C-k}) and
+@code{slime-edit-definition} (@kbd{M-.}) to work correctly we need to
+find a way to let our local Emacs refer to remote files.
+
+There are, mainly, two ways to do this. The first is to mount, using
+NFS or similar, the remote machine's hard disk on the local machine's
+file system in such a fashion that a filename like
+(a)file{/opt/project/source.lisp} refers to the same file on both
+machines. Unfortunetly NFS is usually slow, often buggy, and not
+always feasable, fortunetely we have an ssh connection and Emacs'
+@code{tramp-mode} can do the rest.
+
+What we do is teach Emacs how to take a filename on the remote machine
+and translate it into something that tramp can understand and access
+(and vice-versa). Assuming the remote machine's host name is
+(a)code{remote.example.com}, @code{cl:machine-instance} returns
+``remote'' and we login as the user ``user'' we can use @SLIME{}'s
+built-in mechanism to setup the proper transaltions by simply doing:
+
+@example
+(push (slime-create-filename-translator :machine-instance "remote.example.com"
+ :remote-host "remote"
+ :username "user")
+ slime-filename-translations)
+@end example
+
+@c -----------------------
+@node Global IO Redirection
+@section Globally redirecting all IO to the REPL
+
+By default @SLIME{} does not change @code{*standard-output*} and
+friends outside of the @REPL{}. If you have any other threads which
+call @code{format}, @code{write-string}, etc. that output will be seen
+only in the @code{*inferior-lisp*} buffer or on the terminal, more
+often than not this is inconvenient. So, if you want code such as this:
+
+@example
+(run-in-new-thread
+ (lambda ()
+ (write-line "In some random thread.~%" *standard-output*)))
+@end example
+
+to send its output to @SLIME{}'s repl buffer, as opposed to
+@code{*inferior-lisp*}, set @code{swank:*globally-redirect-io*} to T.
+
+Note that the value of this variable is only checked when swank
+accepts the connection so you should set it via
+(a)file{~/.swank.lisp}. Otherwise you will need to call
+@code{swank::globally-redirect-io-to-connection} yourself, but you
+shouldn't do that unless you know what you're doing.
+
+@c -----------------------
+@node Auto-SLIME
+@section Connecting to SLIME automatically
+
+To make @SLIME{} connect to your lisp whenever you open a lisp file
+just add this to your @file{.emacs}:
+
+@example
+(add-hook 'slime-mode-hook
+ (lambda ()
+ (unless (slime-connected-p)
+ (save-excursion (slime)))))
+@end example
+
+
+@c -----------------------
+@node Credits
+@chapter Credits
+
+@emph{The soppy ending...}
+
+@unnumberedsec Hackers of the good hack
+
+@SLIME{} is an Extension of @acronym{SLIM} by Eric Marsden. At the
+time of writing, the authors and code-contributors of @SLIME{} are:
+
+@include contributors.texi
+
+... not counting the bundled code from @file{hyperspec.el},
+@cite{CLOCC}, and the @cite{CMU AI Repository}.
+
+Many people on the @code{slime-devel} mailing list have made non-code
+contributions to @SLIME{}. Life is hard though: you gotta send code to
+get your name in the manual. @code{:-)}
+
+@unnumberedsec Thanks!
+
+We're indebted to the good people of @code{common-lisp.net} for their
+hosting and help, and for rescuing us from ``Sourceforge hell.''
+
+Implementors of the Lisps that we support have been a great help. We'd
+like to thank the @acronym{CMUCL} maintainers for their helpful
+answers, Craig Norvell and Kevin Layer at Franz providing Allegro CL
+licenses for @SLIME{} development, and Peter Graves for his help to
+get @SLIME{} running with @acronym{ABCL}.
+
+Most of all we're happy to be working with the Lisp implementors
+who've joined in the @SLIME{} development: Dan Barlow and Christophe
+Rhodes of @acronym{SBCL}, Gary Byers of OpenMCL, and Martin Simmons of
+LispWorks. Thanks also to Alain Picard and Memetrics for funding
+Martin's initial work on the LispWorks backend!
+
+@ignore
+This index is currently ingored, because texinfo's built-in indexing
+produces nicer results. -- Helmut Eller
+
+@node Index to Functions
+@appendix Index to Functions
+
+These functions are all available (when relevant). To find the
+keybinding (if there is one) refer to the function description.
+
+@c Note to editors: @fcnindex{...} lines commented out below are place holders
+@c ----------------
+@c They have yet to be documented
+@c Please feel free to add descriptions in the text where appropriate, add the
+@c appropriate anchors and uncomment them.
+@c
+@c [jkc]
+
+@table @code
+@fcnindex{common-lisp-hyperspec-format}
+@fcnindex{sldb-abort}
+@c @fcnindex{sldb-activate}
+@c @fcnindex{sldb-add-face}
+@c @fcnindex{sldb-backward-frame}
+@c @fcnindex{sldb-beginning-of-backtrace}
+@c @fcnindex{sldb-break}
+@c @fcnindex{sldb-break-on-return}
+@fcnindex{sldb-break-with-default-debugger}
+@c @fcnindex{sldb-buffers}
+@c @fcnindex{sldb-catch-tags}
+@fcnindex{sldb-continue}
+@c @fcnindex{sldb-debugged-continuations}
+@c @fcnindex{sldb-default-action}
+@c @fcnindex{sldb-default-action/mouse}
+@c @fcnindex{sldb-delete-overlays}
+@c @fcnindex{sldb-details-down}
+@c @fcnindex{sldb-details-up}
+@fcnindex{sldb-disassemble}
+@c @fcnindex{sldb-dispatch-extras}
+@c @fcnindex{sldb-down}
+@c @fcnindex{sldb-end-of-backtrace}
+@fcnindex{sldb-eval-in-frame}
+@c @fcnindex{sldb-exit}
+@c @fcnindex{sldb-fetch-all-frames}
+@c @fcnindex{sldb-fetch-more-frames}
+@c @fcnindex{sldb-find-buffer}
+@c @fcnindex{sldb-format-reference-node}
+@c @fcnindex{sldb-format-reference-source}
+@c @fcnindex{sldb-forward-frame}
+@c @fcnindex{sldb-frame-details-visible-p}
+@c @fcnindex{sldb-frame-locals}
+@c @fcnindex{sldb-frame-number-at-point}
+@c @fcnindex{sldb-frame-region}
+@c @fcnindex{sldb-get-buffer}
+@c @fcnindex{sldb-get-default-buffer}
+@c @fcnindex{sldb-goto-last-frame}
+@c @fcnindex{sldb-help-summary}
+@c @fcnindex{sldb-hide-frame-details}
+@c @fcnindex{sldb-highlight-sexp}
+@c @fcnindex{sldb-insert-condition}
+@c @fcnindex{sldb-insert-frame}
+@c @fcnindex{sldb-insert-frames}
+@c @fcnindex{sldb-insert-locals}
+@c @fcnindex{sldb-insert-references}
+@c @fcnindex{sldb-insert-restarts}
+@c @fcnindex{sldb-inspect-condition}
+@fcnindex{sldb-inspect-in-frame}
+@c @fcnindex{sldb-inspect-var}
+@c @fcnindex{sldb-invoke-restart}
+@c @fcnindex{sldb-level}
+@c @fcnindex{sldb-list-catch-tags}
+@c @fcnindex{sldb-list-locals}
+@c @fcnindex{sldb-lookup-reference}
+@c @fcnindex{sldb-maybe-recenter-region}
+@c @fcnindex{sldb-mode-hook}
+@c @fcnindex{sldb-next}
+@c @fcnindex{sldb-out}
+@fcnindex{sldb-pprint-eval-in-frame}
+@c @fcnindex{sldb-previous-frame-number}
+@c @fcnindex{sldb-print-condition}
+@c @fcnindex{sldb-prune-initial-frames}
+@fcnindex{sldb-quit}
+@c @fcnindex{sldb-reference-properties}
+@c @fcnindex{sldb-restart-at-point}
+@fcnindex{sldb-restart-frame}
+@fcnindex{sldb-return-from-frame}
+@c @fcnindex{sldb-setup}
+@c @fcnindex{sldb-show-frame-details}
+@c @fcnindex{sldb-show-frame-source}
+@fcnindex{sldb-show-source}
+@fcnindex{sldb-step}
+@c @fcnindex{sldb-sugar-move}
+@fcnindex{sldb-toggle-details}
+@c @fcnindex{sldb-up}
+@c @fcnindex{sldb-var-number-at-point}
+@c @fcnindex{sldb-xemacs-emulate-point-entered-hook}
+@c @fcnindex{sldb-xemacs-post-command-hook}
+
+
+@c @fcnindex{inferior-slime-closing-return}
+@c @fcnindex{inferior-slime-indent-line}
+@c @fcnindex{inferior-slime-mode}
+@c @fcnindex{inferior-slime-return}
+@fcnindex{slime-abort-connection}
+@fcnindex{slime-apropos}
+@fcnindex{slime-apropos-all}
+@fcnindex{slime-apropos-package}
+@c @fcnindex{slime-arglist}
+@fcnindex{slime-autodoc-mode}
+@c @fcnindex{slime-autodoc-start-timer}
+@c @fcnindex{slime-background-activities-enabled-p}
+@c @fcnindex{slime-background-message}
+@c @fcnindex{slime-browse-classes}
+@c @fcnindex{slime-browse-xrefs}
+@fcnindex{slime-call-defun}
+@fcnindex{slime-calls-who}
+@c @fcnindex{slime-check-coding-system}
+@fcnindex{slime-close-all-sexp}
+@fcnindex{slime-close-parens-at-point}
+@fcnindex{slime-compile-and-load-file}
+@fcnindex{slime-compile-defun}
+@fcnindex{slime-compile-file}
+@fcnindex{slime-compile-region}
+@fcnindex{slime-compiler-macroexpand}
+@fcnindex{slime-compiler-macroexpand-1}
+@c @fcnindex{slime-compiler-notes-default-action-or-show-details}
+@c @fcnindex{slime-compiler-notes-default-action-or-show-details/mouse}
+@c @fcnindex{slime-compiler-notes-quit}
+@c @fcnindex{slime-compiler-notes-show-details}
+@c @fcnindex{slime-complete-form}
+@fcnindex{slime-complete-symbol}
+@fcnindex{slime-connect}
+@fcnindex{slime-connection-list-make-default}
+@c @fcnindex{slime-connection-list-mode}
+@c @fcnindex{slime-copy-presentation-at-point}
+@fcnindex{slime-describe-function}
+@fcnindex{slime-describe-symbol}
+@fcnindex{slime-disassemble-symbol}
+@fcnindex{slime-disconnect}
+@c @fcnindex{slime-documentation}
+@fcnindex{slime-edit-definition}
+@fcnindex{slime-edit-definition-other-frame}
+@fcnindex{slime-edit-definition-other-window}
+@fcnindex{slime-edit-definition-with-etags}
+@fcnindex{slime-edit-value}
+@c @fcnindex{slime-edit-value-commit}
+@c @fcnindex{slime-edit-value-mode}
+@fcnindex{slime-ensure-typeout-frame}
+@c @fcnindex{slime-eval-buffer}
+@fcnindex{slime-eval-defun}
+@fcnindex{slime-eval-last-expression}
+@fcnindex{slime-eval-last-expression-display-output}
+@c @fcnindex{slime-eval-print-last-expression}
+@fcnindex{slime-eval-region}
+@fcnindex{slime-fuzzy-abort}
+@fcnindex{slime-fuzzy-complete-symbol}
+@fcnindex{slime-fuzzy-completions-mode}
+@c @fcnindex{slime-fuzzy-next}
+@c @fcnindex{slime-fuzzy-prev}
+@c @fcnindex{slime-fuzzy-select}
+@c @fcnindex{slime-fuzzy-select/mouse}
+@fcnindex{slime-goto-connection}
+@fcnindex{slime-goto-xref}
+@c @fcnindex{slime-handle-repl-shortcut}
+@c @fcnindex{slime-highlight-notes}
+@fcnindex{slime-hyperspec-lookup}
+@c @fcnindex{slime-indent-and-complete-symbol}
+@c @fcnindex{slime-init-keymaps}
+@c @fcnindex{slime-insert-arglist}
+@c @fcnindex{slime-insert-balanced-comments}
+@fcnindex{slime-inspect}
+@fcnindex{slime-inspector-copy-down}
+@fcnindex{slime-inspector-describe}
+@fcnindex{slime-inspector-next}
+@c @fcnindex{slime-inspector-next-inspectable-object}
+@fcnindex{slime-inspector-quit}
+@c @fcnindex{slime-inspector-reinspect}
+@fcnindex{slime-interactive-eval}
+@fcnindex{slime-interrupt}
+@fcnindex{slime-list-callees}
+@fcnindex{slime-list-callers}
+@c @fcnindex{slime-list-compiler-notes}
+@fcnindex{slime-list-connections}
+@c @fcnindex{slime-list-repl-shortcuts}
+@fcnindex{slime-list-threads}
+@fcnindex{slime-load-file}
+@c @fcnindex{slime-load-system}
+@fcnindex{slime-macroexpand-1}
+@fcnindex{slime-macroexpand-1-inplace}
+@fcnindex{slime-macroexpand-all}
+@c @fcnindex{slime-make-default-connection}
+@c @fcnindex{slime-make-typeout-frame}
+@fcnindex{slime-mode}
+@c @fcnindex{slime-next-line/not-add-newlines}
+@c @fcnindex{slime-next-location}
+@fcnindex{slime-next-note}
+@fcnindex{slime-nop}
+@c @fcnindex{slime-ping}
+@fcnindex{slime-pop-find-definition-stack}
+@fcnindex{slime-pprint-eval-last-expression}
+@c @fcnindex{slime-presentation-menu}
+@c @fcnindex{slime-pretty-lambdas}
+@fcnindex{slime-previous-note}
+@fcnindex{slime-profile-package}
+@fcnindex{slime-profile-report}
+@fcnindex{slime-profile-reset}
+@fcnindex{slime-profiled-functions}
+@fcnindex{slime-quit}
+@c @fcnindex{slime-quit-connection-at-point}
+@c @fcnindex{slime-quit-lisp}
+@c @fcnindex{slime-re-evaluate-defvar}
+@c @fcnindex{slime-recompile-bytecode}
+@c @fcnindex{slime-register-lisp-implementation}
+@fcnindex{slime-reindent-defun}
+@c @fcnindex{slime-remove-balanced-comments}
+@fcnindex{slime-remove-notes}
+@c @fcnindex{slime-repl}
+@fcnindex{slime-repl-beginning-of-defun}
+@fcnindex{slime-repl-bol}
+@fcnindex{slime-repl-clear-buffer}
+@fcnindex{slime-repl-clear-output}
+@fcnindex{slime-repl-closing-return}
+@c @fcnindex{slime-repl-compile-and-load}
+@c @fcnindex{slime-repl-compile-system}
+@c @fcnindex{slime-repl-compile/force-system}
+@c @fcnindex{slime-repl-defparameter}
+@fcnindex{slime-repl-end-of-defun}
+@c @fcnindex{slime-repl-eol}
+@c @fcnindex{slime-repl-load-system}
+@c @fcnindex{slime-repl-load/force-system}
+@c @fcnindex{slime-repl-mode}
+@fcnindex{slime-repl-newline-and-indent}
+@fcnindex{slime-repl-next-input}
+@fcnindex{slime-repl-next-matching-input}
+@fcnindex{slime-repl-next-prompt}
+@c @fcnindex{slime-repl-pop-directory}
+@c @fcnindex{slime-repl-pop-packages}
+@fcnindex{slime-repl-previous-input}
+@fcnindex{slime-repl-previous-matching-input}
+@fcnindex{slime-repl-previous-prompt}
+@c @fcnindex{slime-repl-push-directory}
+@c @fcnindex{slime-repl-push-package}
+@c @fcnindex{slime-repl-read-break}
+@c @fcnindex{slime-repl-read-mode}
+@fcnindex{slime-repl-return}
+@fcnindex{slime-repl-set-package}
+@c @fcnindex{slime-repl-shortcut-help}
+@c @fcnindex{slime-reset}
+@c @fcnindex{slime-restart-connection-at-point}
+@c @fcnindex{slime-restart-inferior-lisp}
+@c @fcnindex{slime-restart-inferior-lisp-aux}
+@fcnindex{slime-scratch}
+@c @fcnindex{slime-select-lisp-implementation}
+@fcnindex{slime-selector}
+@c @fcnindex{slime-send-sigint}
+@c @fcnindex{slime-set-default-directory}
+@c @fcnindex{slime-set-package}
+@c @fcnindex{slime-show-xref}
+@fcnindex{slime-space}
+@c @fcnindex{slime-start-and-load}
+@fcnindex{slime-switch-to-output-buffer}
+@fcnindex{slime-sync-package-and-default-directory}
+@c @fcnindex{slime-temp-buffer-mode}
+@fcnindex{slime-temp-buffer-quit}
+@c @fcnindex{slime-thread-attach}
+@c @fcnindex{slime-thread-debug}
+@c @fcnindex{slime-thread-control-mode}
+@c @fcnindex{slime-thread-kill}
+@c @fcnindex{slime-thread-quit}
+@fcnindex{slime-toggle-profile-fdefinition}
+@fcnindex{slime-toggle-trace-fdefinition}
+@fcnindex{slime-undefine-function}
+@fcnindex{slime-unprofile-all}
+@fcnindex{slime-untrace-all}
+@fcnindex{slime-update-connection-list}
+@c @fcnindex{slime-update-indentation} ???
+@fcnindex{slime-who-binds}
+@fcnindex{slime-who-calls}
+@fcnindex{slime-who-macroexpands}
+@fcnindex{slime-who-references}
+@fcnindex{slime-who-sets}
+@fcnindex{slime-who-specializes}
+@c @fcnindex{slime-xref-mode}
+@c @fcnindex{slime-xref-quit}
+@end table
+
+@end ignore
+
+@node Key Index, Command Index, Credits, top
+@unnumbered Key (Character) Index
+@printindex ky
+
+@node Command Index, Variable Index, Key Index, top
+@unnumbered Command and Function Index
+@printindex fn
+
+@node Variable Index, , Command Index, top
+@unnumbered Variable Index
+@printindex vr
+
+@bye
Added: branches/trunk-reorg/thirdparty/slime/doc/texinfo-tabulate.awk
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/texinfo-tabulate.awk 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/texinfo-tabulate.awk 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,21 @@
+#!/usr/bin/env awk -f
+#
+# Format input lines into a multi-column texinfo table.
+# Note: does not do texinfo-escaping of the input.
+
+# This code has been placed in the Public Domain. All warranties
+# are disclaimed.
+
+BEGIN {
+ columns = 3;
+ printf("@multitable @columnfractions");
+ for (i = 0; i < columns; i++)
+ printf(" %f", 1.0/columns);
+ print
+}
+
+{ if (NR % columns == 1) printf("\n@item %s", $0);
+ else printf(" @tab %s", $0); }
+
+END { printf("\n@end multitable\n"); }
+
Added: branches/trunk-reorg/thirdparty/slime/hyperspec.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/hyperspec.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/hyperspec.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1671 @@
+;;; hyperspec.el --- Browse documentation from the Common Lisp HyperSpec
+
+;; Copyright 1997 Naggum Software
+
+;; Author: Erik Naggum <erik(a)naggum.no>
+;; Keywords: lisp
+
+;; This file is not part of GNU Emacs, but distributed under the same
+;; conditions as GNU Emacs, and is useless without GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Kent Pitman and Xanalys Inc. have made the text of American National
+;; Standard for Information Technology -- Programming Language -- Common
+;; Lisp, ANSI X3.226-1994 available on the WWW, in the form of the Common
+;; Lisp HyperSpec. This package makes it convenient to peruse this
+;; documentation from within Emacs.
+
+;;; Code:
+
+(require 'cl)
+(require 'browse-url) ;you need the Emacs 20 version
+(require 'thingatpt)
+
+(defvar common-lisp-hyperspec-root
+ "http://www.lispworks.com/reference/HyperSpec/"
+ "The root of the Common Lisp HyperSpec URL.
+If you copy the HyperSpec to your local system, set this variable to
+something like \"file:/usr/local/doc/HyperSpec/\".")
+
+;;; Added variable for CLHS symbol table. See details below.
+;;;
+;;; 20011201 Edi Weitz
+
+(defvar common-lisp-hyperspec-symbol-table nil
+ "The HyperSpec symbol table file.
+If you copy the HyperSpec to your local system, set this variable to
+the location of the symbol table which is usually \"Map_Sym.txt\"
+or \"Symbol-Table.text\".")
+
+(defvar common-lisp-hyperspec-history nil
+ "History of symbols looked up in the Common Lisp HyperSpec.")
+
+;;if only we had had packages or hash tables..., but let's fake it.
+
+(defvar common-lisp-hyperspec-symbols (make-vector 67 0))
+
+(defun common-lisp-hyperspec-strip-cl-package (name)
+ (if (string-match "^\\([^:]*\\)::?\\([^:]*\\)$" name)
+ (let ((package-name (match-string 1 name))
+ (symbol-name (match-string 2 name)))
+ (if (member (downcase package-name)
+ '("cl" "common-lisp"))
+ symbol-name
+ name))
+ name))
+
+(defun common-lisp-hyperspec (symbol-name)
+ "View the documentation on SYMBOL-NAME from the Common Lisp HyperSpec.
+If SYMBOL-NAME has more than one definition, all of them are displayed with
+your favorite browser in sequence. The browser should have a \"back\"
+function to view the separate definitions.
+
+The Common Lisp HyperSpec is the full ANSI Standard Common Lisp, provided
+by Kent Pitman and Xanalys Inc. By default, the Xanalys Web site is
+visited to retrieve the information. Xanalys Inc. allows you to transfer
+the entire Common Lisp HyperSpec to your own site under certain conditions.
+Visit http://www.lispworks.com/reference/HyperSpec/ for more information.
+If you copy the HyperSpec to another location, customize the variable
+`common-lisp-hyperspec-root' to point to that location."
+ (interactive (list (let* ((symbol-at-point (thing-at-point 'symbol))
+ (stripped-symbol
+ (and symbol-at-point
+ (substring-no-properties
+ (downcase
+ (common-lisp-hyperspec-strip-cl-package
+ symbol-at-point))))))
+ (if (and stripped-symbol
+ (intern-soft stripped-symbol
+ common-lisp-hyperspec-symbols))
+ stripped-symbol
+ (completing-read
+ "Look up symbol in Common Lisp HyperSpec: "
+ common-lisp-hyperspec-symbols #'boundp
+ t stripped-symbol
+ 'common-lisp-hyperspec-history)))))
+ (maplist (lambda (entry)
+ (browse-url (concat common-lisp-hyperspec-root "Body/" (car entry)))
+ (if (cdr entry)
+ (sleep-for 1.5)))
+ (let ((symbol (intern-soft
+ (common-lisp-hyperspec-strip-cl-package
+ (downcase symbol-name))
+ common-lisp-hyperspec-symbols)))
+ (if (and symbol (boundp symbol))
+ (symbol-value symbol)
+ (error "The symbol `%s' is not defined in Common Lisp"
+ symbol-name)))))
+
+;;; Added the following just to provide a common entry point according
+;;; to the various 'hyperspec' implementations.
+;;;
+;;; 19990820 Marco Antoniotti
+
+(eval-when (load eval)
+ (defalias 'hyperspec-lookup 'common-lisp-hyperspec))
+
+
+;;; Added dynamic lookup of symbol in CLHS symbol table
+;;;
+;;; 20011202 Edi Weitz
+
+;;; Replaced symbol table for v 4.0 with the one for v 6.0
+;;; (which is now online at Xanalys' site)
+;;;
+;;; 20020213 Edi Weitz
+
+(if common-lisp-hyperspec-symbol-table
+ (let ((index-buffer (find-file-noselect common-lisp-hyperspec-symbol-table)))
+ (labels ((get-one-line ()
+ (prog1
+ (delete* ?\n (thing-at-point 'line))
+ (forward-line))))
+ (save-excursion
+ (set-buffer index-buffer)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (let* ((symbol (intern (downcase (get-one-line))
+ common-lisp-hyperspec-symbols))
+ (relative-url (get-one-line)))
+ (set symbol (list (subseq relative-url
+ (1+ (position ?\/ relative-url :from-end t))))))))))
+ (mapcar (lambda (entry)
+ (let ((symbol (intern (car entry) common-lisp-hyperspec-symbols)))
+ (if (boundp symbol)
+ (push (cadr entry) (symbol-value symbol))
+ (set symbol (cdr entry)))))
+ '(("&allow-other-keys" "03_da.htm")
+ ("&aux" "03_da.htm")
+ ("&body" "03_dd.htm")
+ ("&environment" "03_dd.htm")
+ ("&key" "03_da.htm")
+ ("&optional" "03_da.htm")
+ ("&rest" "03_da.htm")
+ ("&whole" "03_dd.htm")
+ ("*" "a_st.htm")
+ ("**" "v__stst_.htm")
+ ("***" "v__stst_.htm")
+ ("*break-on-signals*" "v_break_.htm")
+ ("*compile-file-pathname*" "v_cmp_fi.htm")
+ ("*compile-file-truename*" "v_cmp_fi.htm")
+ ("*compile-print*" "v_cmp_pr.htm")
+ ("*compile-verbose*" "v_cmp_pr.htm")
+ ("*debug-io*" "v_debug_.htm")
+ ("*debugger-hook*" "v_debugg.htm")
+ ("*default-pathname-defaults*" "v_defaul.htm")
+ ("*error-output*" "v_debug_.htm")
+ ("*features*" "v_featur.htm")
+ ("*gensym-counter*" "v_gensym.htm")
+ ("*load-pathname*" "v_ld_pns.htm")
+ ("*load-print*" "v_ld_prs.htm")
+ ("*load-truename*" "v_ld_pns.htm")
+ ("*load-verbose*" "v_ld_prs.htm")
+ ("*macroexpand-hook*" "v_mexp_h.htm")
+ ("*modules*" "v_module.htm")
+ ("*package*" "v_pkg.htm")
+ ("*print-array*" "v_pr_ar.htm")
+ ("*print-base*" "v_pr_bas.htm")
+ ("*print-case*" "v_pr_cas.htm")
+ ("*print-circle*" "v_pr_cir.htm")
+ ("*print-escape*" "v_pr_esc.htm")
+ ("*print-gensym*" "v_pr_gen.htm")
+ ("*print-length*" "v_pr_lev.htm")
+ ("*print-level*" "v_pr_lev.htm")
+ ("*print-lines*" "v_pr_lin.htm")
+ ("*print-miser-width*" "v_pr_mis.htm")
+ ("*print-pprint-dispatch*" "v_pr_ppr.htm")
+ ("*print-pretty*" "v_pr_pre.htm")
+ ("*print-radix*" "v_pr_bas.htm")
+ ("*print-readably*" "v_pr_rda.htm")
+ ("*print-right-margin*" "v_pr_rig.htm")
+ ("*query-io*" "v_debug_.htm")
+ ("*random-state*" "v_rnd_st.htm")
+ ("*read-base*" "v_rd_bas.htm")
+ ("*read-default-float-format*" "v_rd_def.htm")
+ ("*read-eval*" "v_rd_eva.htm")
+ ("*read-suppress*" "v_rd_sup.htm")
+ ("*readtable*" "v_rdtabl.htm")
+ ("*standard-input*" "v_debug_.htm")
+ ("*standard-output*" "v_debug_.htm")
+ ("*terminal-io*" "v_termin.htm")
+ ("*trace-output*" "v_debug_.htm")
+ ("+" "a_pl.htm")
+ ("++" "v_pl_plp.htm")
+ ("+++" "v_pl_plp.htm")
+ ("-" "a__.htm")
+ ("/" "a_sl.htm")
+ ("//" "v_sl_sls.htm")
+ ("///" "v_sl_sls.htm")
+ ("/=" "f_eq_sle.htm")
+ ("1+" "f_1pl_1_.htm")
+ ("1-" "f_1pl_1_.htm")
+ ("<" "f_eq_sle.htm")
+ ("<=" "f_eq_sle.htm")
+ ("=" "f_eq_sle.htm")
+ (">" "f_eq_sle.htm")
+ (">=" "f_eq_sle.htm")
+ ("abort" "a_abort.htm")
+ ("abs" "f_abs.htm")
+ ("acons" "f_acons.htm")
+ ("acos" "f_asin_.htm")
+ ("acosh" "f_sinh_.htm")
+ ("add-method" "f_add_me.htm")
+ ("adjoin" "f_adjoin.htm")
+ ("adjust-array" "f_adjust.htm")
+ ("adjustable-array-p" "f_adju_1.htm")
+ ("allocate-instance" "f_alloca.htm")
+ ("alpha-char-p" "f_alpha_.htm")
+ ("alphanumericp" "f_alphan.htm")
+ ("and" "a_and.htm")
+ ("append" "f_append.htm")
+ ("apply" "f_apply.htm")
+ ("apropos" "f_apropo.htm")
+ ("apropos-list" "f_apropo.htm")
+ ("aref" "f_aref.htm")
+ ("arithmetic-error" "e_arithm.htm")
+ ("arithmetic-error-operands" "f_arithm.htm")
+ ("arithmetic-error-operation" "f_arithm.htm")
+ ("array" "t_array.htm")
+ ("array-dimension" "f_ar_dim.htm")
+ ("array-dimension-limit" "v_ar_dim.htm")
+ ("array-dimensions" "f_ar_d_1.htm")
+ ("array-displacement" "f_ar_dis.htm")
+ ("array-element-type" "f_ar_ele.htm")
+ ("array-has-fill-pointer-p" "f_ar_has.htm")
+ ("array-in-bounds-p" "f_ar_in_.htm")
+ ("array-rank" "f_ar_ran.htm")
+ ("array-rank-limit" "v_ar_ran.htm")
+ ("array-row-major-index" "f_ar_row.htm")
+ ("array-total-size" "f_ar_tot.htm")
+ ("array-total-size-limit" "v_ar_tot.htm")
+ ("arrayp" "f_arrayp.htm")
+ ("ash" "f_ash.htm")
+ ("asin" "f_asin_.htm")
+ ("asinh" "f_sinh_.htm")
+ ("assert" "m_assert.htm")
+ ("assoc" "f_assocc.htm")
+ ("assoc-if" "f_assocc.htm")
+ ("assoc-if-not" "f_assocc.htm")
+ ("atan" "f_asin_.htm")
+ ("atanh" "f_sinh_.htm")
+ ("atom" "a_atom.htm")
+ ("base-char" "t_base_c.htm")
+ ("base-string" "t_base_s.htm")
+ ("bignum" "t_bignum.htm")
+ ("bit" "a_bit.htm")
+ ("bit-and" "f_bt_and.htm")
+ ("bit-andc1" "f_bt_and.htm")
+ ("bit-andc2" "f_bt_and.htm")
+ ("bit-eqv" "f_bt_and.htm")
+ ("bit-ior" "f_bt_and.htm")
+ ("bit-nand" "f_bt_and.htm")
+ ("bit-nor" "f_bt_and.htm")
+ ("bit-not" "f_bt_and.htm")
+ ("bit-orc1" "f_bt_and.htm")
+ ("bit-orc2" "f_bt_and.htm")
+ ("bit-vector" "t_bt_vec.htm")
+ ("bit-vector-p" "f_bt_vec.htm")
+ ("bit-xor" "f_bt_and.htm")
+ ("block" "s_block.htm")
+ ("boole" "f_boole.htm")
+ ("boole-1" "v_b_1_b.htm")
+ ("boole-2" "v_b_1_b.htm")
+ ("boole-and" "v_b_1_b.htm")
+ ("boole-andc1" "v_b_1_b.htm")
+ ("boole-andc2" "v_b_1_b.htm")
+ ("boole-c1" "v_b_1_b.htm")
+ ("boole-c2" "v_b_1_b.htm")
+ ("boole-clr" "v_b_1_b.htm")
+ ("boole-eqv" "v_b_1_b.htm")
+ ("boole-ior" "v_b_1_b.htm")
+ ("boole-nand" "v_b_1_b.htm")
+ ("boole-nor" "v_b_1_b.htm")
+ ("boole-orc1" "v_b_1_b.htm")
+ ("boole-orc2" "v_b_1_b.htm")
+ ("boole-set" "v_b_1_b.htm")
+ ("boole-xor" "v_b_1_b.htm")
+ ("boolean" "t_ban.htm")
+ ("both-case-p" "f_upper_.htm")
+ ("boundp" "f_boundp.htm")
+ ("break" "f_break.htm")
+ ("broadcast-stream" "t_broadc.htm")
+ ("broadcast-stream-streams" "f_broadc.htm")
+ ("built-in-class" "t_built_.htm")
+ ("butlast" "f_butlas.htm")
+ ("byte" "f_by_by.htm")
+ ("byte-position" "f_by_by.htm")
+ ("byte-size" "f_by_by.htm")
+ ("caaaar" "f_car_c.htm")
+ ("caaadr" "f_car_c.htm")
+ ("caaar" "f_car_c.htm")
+ ("caadar" "f_car_c.htm")
+ ("caaddr" "f_car_c.htm")
+ ("caadr" "f_car_c.htm")
+ ("caar" "f_car_c.htm")
+ ("cadaar" "f_car_c.htm")
+ ("cadadr" "f_car_c.htm")
+ ("cadar" "f_car_c.htm")
+ ("caddar" "f_car_c.htm")
+ ("cadddr" "f_car_c.htm")
+ ("caddr" "f_car_c.htm")
+ ("cadr" "f_car_c.htm")
+ ("call-arguments-limit" "v_call_a.htm")
+ ("call-method" "m_call_m.htm")
+ ("call-next-method" "f_call_n.htm")
+ ("car" "f_car_c.htm")
+ ("case" "m_case_.htm")
+ ("catch" "s_catch.htm")
+ ("ccase" "m_case_.htm")
+ ("cdaaar" "f_car_c.htm")
+ ("cdaadr" "f_car_c.htm")
+ ("cdaar" "f_car_c.htm")
+ ("cdadar" "f_car_c.htm")
+ ("cdaddr" "f_car_c.htm")
+ ("cdadr" "f_car_c.htm")
+ ("cdar" "f_car_c.htm")
+ ("cddaar" "f_car_c.htm")
+ ("cddadr" "f_car_c.htm")
+ ("cddar" "f_car_c.htm")
+ ("cdddar" "f_car_c.htm")
+ ("cddddr" "f_car_c.htm")
+ ("cdddr" "f_car_c.htm")
+ ("cddr" "f_car_c.htm")
+ ("cdr" "f_car_c.htm")
+ ("ceiling" "f_floorc.htm")
+ ("cell-error" "e_cell_e.htm")
+ ("cell-error-name" "f_cell_e.htm")
+ ("cerror" "f_cerror.htm")
+ ("change-class" "f_chg_cl.htm")
+ ("char" "f_char_.htm")
+ ("char-code" "f_char_c.htm")
+ ("char-code-limit" "v_char_c.htm")
+ ("char-downcase" "f_char_u.htm")
+ ("char-equal" "f_chareq.htm")
+ ("char-greaterp" "f_chareq.htm")
+ ("char-int" "f_char_i.htm")
+ ("char-lessp" "f_chareq.htm")
+ ("char-name" "f_char_n.htm")
+ ("char-not-equal" "f_chareq.htm")
+ ("char-not-greaterp" "f_chareq.htm")
+ ("char-not-lessp" "f_chareq.htm")
+ ("char-upcase" "f_char_u.htm")
+ ("char/=" "f_chareq.htm")
+ ("char<" "f_chareq.htm")
+ ("char<=" "f_chareq.htm")
+ ("char=" "f_chareq.htm")
+ ("char>" "f_chareq.htm")
+ ("char>=" "f_chareq.htm")
+ ("character" "a_ch.htm")
+ ("characterp" "f_chp.htm")
+ ("check-type" "m_check_.htm")
+ ("cis" "f_cis.htm")
+ ("class" "t_class.htm")
+ ("class-name" "f_class_.htm")
+ ("class-of" "f_clas_1.htm")
+ ("clear-input" "f_clear_.htm")
+ ("clear-output" "f_finish.htm")
+ ("close" "f_close.htm")
+ ("clrhash" "f_clrhas.htm")
+ ("code-char" "f_code_c.htm")
+ ("coerce" "f_coerce.htm")
+ ("compilation-speed" "d_optimi.htm")
+ ("compile" "f_cmp.htm")
+ ("compile-file" "f_cmp_fi.htm")
+ ("compile-file-pathname" "f_cmp__1.htm")
+ ("compiled-function" "t_cmpd_f.htm")
+ ("compiled-function-p" "f_cmpd_f.htm")
+ ("compiler-macro" "f_docume.htm")
+ ("compiler-macro-function" "f_cmp_ma.htm")
+ ("complement" "f_comple.htm")
+ ("complex" "a_comple.htm")
+ ("complexp" "f_comp_3.htm")
+ ("compute-applicable-methods" "f_comput.htm")
+ ("compute-restarts" "f_comp_1.htm")
+ ("concatenate" "f_concat.htm")
+ ("concatenated-stream" "t_concat.htm")
+ ("concatenated-stream-streams" "f_conc_1.htm")
+ ("cond" "m_cond.htm")
+ ("condition" "e_cnd.htm")
+ ("conjugate" "f_conjug.htm")
+ ("cons" "a_cons.htm")
+ ("consp" "f_consp.htm")
+ ("constantly" "f_cons_1.htm")
+ ("constantp" "f_consta.htm")
+ ("continue" "a_contin.htm")
+ ("control-error" "e_contro.htm")
+ ("copy-alist" "f_cp_ali.htm")
+ ("copy-list" "f_cp_lis.htm")
+ ("copy-pprint-dispatch" "f_cp_ppr.htm")
+ ("copy-readtable" "f_cp_rdt.htm")
+ ("copy-seq" "f_cp_seq.htm")
+ ("copy-structure" "f_cp_stu.htm")
+ ("copy-symbol" "f_cp_sym.htm")
+ ("copy-tree" "f_cp_tre.htm")
+ ("cos" "f_sin_c.htm")
+ ("cosh" "f_sinh_.htm")
+ ("count" "f_countc.htm")
+ ("count-if" "f_countc.htm")
+ ("count-if-not" "f_countc.htm")
+ ("ctypecase" "m_tpcase.htm")
+ ("debug" "d_optimi.htm")
+ ("decf" "m_incf_.htm")
+ ("declaim" "m_declai.htm")
+ ("declaration" "d_declar.htm")
+ ("declare" "s_declar.htm")
+ ("decode-float" "f_dec_fl.htm")
+ ("decode-universal-time" "f_dec_un.htm")
+ ("defclass" "m_defcla.htm")
+ ("defconstant" "m_defcon.htm")
+ ("defgeneric" "m_defgen.htm")
+ ("define-compiler-macro" "m_define.htm")
+ ("define-condition" "m_defi_5.htm")
+ ("define-method-combination" "m_defi_4.htm")
+ ("define-modify-macro" "m_defi_2.htm")
+ ("define-setf-expander" "m_defi_3.htm")
+ ("define-symbol-macro" "m_defi_1.htm")
+ ("defmacro" "m_defmac.htm")
+ ("defmethod" "m_defmet.htm")
+ ("defpackage" "m_defpkg.htm")
+ ("defparameter" "m_defpar.htm")
+ ("defsetf" "m_defset.htm")
+ ("defstruct" "m_defstr.htm")
+ ("deftype" "m_deftp.htm")
+ ("defun" "m_defun.htm")
+ ("defvar" "m_defpar.htm")
+ ("delete" "f_rm_rm.htm")
+ ("delete-duplicates" "f_rm_dup.htm")
+ ("delete-file" "f_del_fi.htm")
+ ("delete-if" "f_rm_rm.htm")
+ ("delete-if-not" "f_rm_rm.htm")
+ ("delete-package" "f_del_pk.htm")
+ ("denominator" "f_numera.htm")
+ ("deposit-field" "f_deposi.htm")
+ ("describe" "f_descri.htm")
+ ("describe-object" "f_desc_1.htm")
+ ("destructuring-bind" "m_destru.htm")
+ ("digit-char" "f_digit_.htm")
+ ("digit-char-p" "f_digi_1.htm")
+ ("directory" "f_dir.htm")
+ ("directory-namestring" "f_namest.htm")
+ ("disassemble" "f_disass.htm")
+ ("division-by-zero" "e_divisi.htm")
+ ("do" "m_do_do.htm")
+ ("do*" "m_do_do.htm")
+ ("do-all-symbols" "m_do_sym.htm")
+ ("do-external-symbols" "m_do_sym.htm")
+ ("do-symbols" "m_do_sym.htm")
+ ("documentation" "f_docume.htm")
+ ("dolist" "m_dolist.htm")
+ ("dotimes" "m_dotime.htm")
+ ("double-float" "t_short_.htm")
+ ("double-float-epsilon" "v_short_.htm")
+ ("double-float-negative-epsilon" "v_short_.htm")
+ ("dpb" "f_dpb.htm")
+ ("dribble" "f_dribbl.htm")
+ ("dynamic-extent" "d_dynami.htm")
+ ("ecase" "m_case_.htm")
+ ("echo-stream" "t_echo_s.htm")
+ ("echo-stream-input-stream" "f_echo_s.htm")
+ ("echo-stream-output-stream" "f_echo_s.htm")
+ ("ed" "f_ed.htm")
+ ("eighth" "f_firstc.htm")
+ ("elt" "f_elt.htm")
+ ("encode-universal-time" "f_encode.htm")
+ ("end-of-file" "e_end_of.htm")
+ ("endp" "f_endp.htm")
+ ("enough-namestring" "f_namest.htm")
+ ("ensure-directories-exist" "f_ensu_1.htm")
+ ("ensure-generic-function" "f_ensure.htm")
+ ("eq" "f_eq.htm")
+ ("eql" "a_eql.htm")
+ ("equal" "f_equal.htm")
+ ("equalp" "f_equalp.htm")
+ ("error" "a_error.htm")
+ ("etypecase" "m_tpcase.htm")
+ ("eval" "f_eval.htm")
+ ("eval-when" "s_eval_w.htm")
+ ("evenp" "f_evenpc.htm")
+ ("every" "f_everyc.htm")
+ ("exp" "f_exp_e.htm")
+ ("export" "f_export.htm")
+ ("expt" "f_exp_e.htm")
+ ("extended-char" "t_extend.htm")
+ ("fboundp" "f_fbound.htm")
+ ("fceiling" "f_floorc.htm")
+ ("fdefinition" "f_fdefin.htm")
+ ("ffloor" "f_floorc.htm")
+ ("fifth" "f_firstc.htm")
+ ("file-author" "f_file_a.htm")
+ ("file-error" "e_file_e.htm")
+ ("file-error-pathname" "f_file_e.htm")
+ ("file-length" "f_file_l.htm")
+ ("file-namestring" "f_namest.htm")
+ ("file-position" "f_file_p.htm")
+ ("file-stream" "t_file_s.htm")
+ ("file-string-length" "f_file_s.htm")
+ ("file-write-date" "f_file_w.htm")
+ ("fill" "f_fill.htm")
+ ("fill-pointer" "f_fill_p.htm")
+ ("find" "f_find_.htm")
+ ("find-all-symbols" "f_find_a.htm")
+ ("find-class" "f_find_c.htm")
+ ("find-if" "f_find_.htm")
+ ("find-if-not" "f_find_.htm")
+ ("find-method" "f_find_m.htm")
+ ("find-package" "f_find_p.htm")
+ ("find-restart" "f_find_r.htm")
+ ("find-symbol" "f_find_s.htm")
+ ("finish-output" "f_finish.htm")
+ ("first" "f_firstc.htm")
+ ("fixnum" "t_fixnum.htm")
+ ("flet" "s_flet_.htm")
+ ("float" "a_float.htm")
+ ("float-digits" "f_dec_fl.htm")
+ ("float-precision" "f_dec_fl.htm")
+ ("float-radix" "f_dec_fl.htm")
+ ("float-sign" "f_dec_fl.htm")
+ ("floating-point-inexact" "e_floa_1.htm")
+ ("floating-point-invalid-operation" "e_floati.htm")
+ ("floating-point-overflow" "e_floa_2.htm")
+ ("floating-point-underflow" "e_floa_3.htm")
+ ("floatp" "f_floatp.htm")
+ ("floor" "f_floorc.htm")
+ ("fmakunbound" "f_fmakun.htm")
+ ("force-output" "f_finish.htm")
+ ("format" "f_format.htm")
+ ("formatter" "m_format.htm")
+ ("fourth" "f_firstc.htm")
+ ("fresh-line" "f_terpri.htm")
+ ("fround" "f_floorc.htm")
+ ("ftruncate" "f_floorc.htm")
+ ("ftype" "d_ftype.htm")
+ ("funcall" "f_funcal.htm")
+ ("function" "a_fn.htm")
+ ("function-keywords" "f_fn_kwd.htm")
+ ("function-lambda-expression" "f_fn_lam.htm")
+ ("functionp" "f_fnp.htm")
+ ("gcd" "f_gcd.htm")
+ ("generic-function" "t_generi.htm")
+ ("gensym" "f_gensym.htm")
+ ("gentemp" "f_gentem.htm")
+ ("get" "f_get.htm")
+ ("get-decoded-time" "f_get_un.htm")
+ ("get-dispatch-macro-character" "f_set__1.htm")
+ ("get-internal-real-time" "f_get_in.htm")
+ ("get-internal-run-time" "f_get__1.htm")
+ ("get-macro-character" "f_set_ma.htm")
+ ("get-output-stream-string" "f_get_ou.htm")
+ ("get-properties" "f_get_pr.htm")
+ ("get-setf-expansion" "f_get_se.htm")
+ ("get-universal-time" "f_get_un.htm")
+ ("getf" "f_getf.htm")
+ ("gethash" "f_gethas.htm")
+ ("go" "s_go.htm")
+ ("graphic-char-p" "f_graphi.htm")
+ ("handler-bind" "m_handle.htm")
+ ("handler-case" "m_hand_1.htm")
+ ("hash-table" "t_hash_t.htm")
+ ("hash-table-count" "f_hash_1.htm")
+ ("hash-table-p" "f_hash_t.htm")
+ ("hash-table-rehash-size" "f_hash_2.htm")
+ ("hash-table-rehash-threshold" "f_hash_3.htm")
+ ("hash-table-size" "f_hash_4.htm")
+ ("hash-table-test" "f_hash_5.htm")
+ ("host-namestring" "f_namest.htm")
+ ("identity" "f_identi.htm")
+ ("if" "s_if.htm")
+ ("ignorable" "d_ignore.htm")
+ ("ignore" "d_ignore.htm")
+ ("ignore-errors" "m_ignore.htm")
+ ("imagpart" "f_realpa.htm")
+ ("import" "f_import.htm")
+ ("in-package" "m_in_pkg.htm")
+ ("incf" "m_incf_.htm")
+ ("initialize-instance" "f_init_i.htm")
+ ("inline" "d_inline.htm")
+ ("input-stream-p" "f_in_stm.htm")
+ ("inspect" "f_inspec.htm")
+ ("integer" "t_intege.htm")
+ ("integer-decode-float" "f_dec_fl.htm")
+ ("integer-length" "f_intege.htm")
+ ("integerp" "f_inte_1.htm")
+ ("interactive-stream-p" "f_intera.htm")
+ ("intern" "f_intern.htm")
+ ("internal-time-units-per-second" "v_intern.htm")
+ ("intersection" "f_isec_.htm")
+ ("invalid-method-error" "f_invali.htm")
+ ("invoke-debugger" "f_invoke.htm")
+ ("invoke-restart" "f_invo_1.htm")
+ ("invoke-restart-interactively" "f_invo_2.htm")
+ ("isqrt" "f_sqrt_.htm")
+ ("keyword" "t_kwd.htm")
+ ("keywordp" "f_kwdp.htm")
+ ("labels" "s_flet_.htm")
+ ("lambda" "a_lambda.htm")
+ ("lambda-list-keywords" "v_lambda.htm")
+ ("lambda-parameters-limit" "v_lamb_1.htm")
+ ("last" "f_last.htm")
+ ("lcm" "f_lcm.htm")
+ ("ldb" "f_ldb.htm")
+ ("ldb-test" "f_ldb_te.htm")
+ ("ldiff" "f_ldiffc.htm")
+ ("least-negative-double-float" "v_most_1.htm")
+ ("least-negative-long-float" "v_most_1.htm")
+ ("least-negative-normalized-double-float" "v_most_1.htm")
+ ("least-negative-normalized-long-float" "v_most_1.htm")
+ ("least-negative-normalized-short-float" "v_most_1.htm")
+ ("least-negative-normalized-single-float" "v_most_1.htm")
+ ("least-negative-short-float" "v_most_1.htm")
+ ("least-negative-single-float" "v_most_1.htm")
+ ("least-positive-double-float" "v_most_1.htm")
+ ("least-positive-long-float" "v_most_1.htm")
+ ("least-positive-normalized-double-float" "v_most_1.htm")
+ ("least-positive-normalized-long-float" "v_most_1.htm")
+ ("least-positive-normalized-short-float" "v_most_1.htm")
+ ("least-positive-normalized-single-float" "v_most_1.htm")
+ ("least-positive-short-float" "v_most_1.htm")
+ ("least-positive-single-float" "v_most_1.htm")
+ ("length" "f_length.htm")
+ ("let" "s_let_l.htm")
+ ("let*" "s_let_l.htm")
+ ("lisp-implementation-type" "f_lisp_i.htm")
+ ("lisp-implementation-version" "f_lisp_i.htm")
+ ("list" "a_list.htm")
+ ("list*" "f_list_.htm")
+ ("list-all-packages" "f_list_a.htm")
+ ("list-length" "f_list_l.htm")
+ ("listen" "f_listen.htm")
+ ("listp" "f_listp.htm")
+ ("load" "f_load.htm")
+ ("load-logical-pathname-translations" "f_ld_log.htm")
+ ("load-time-value" "s_ld_tim.htm")
+ ("locally" "s_locall.htm")
+ ("log" "f_log.htm")
+ ("logand" "f_logand.htm")
+ ("logandc1" "f_logand.htm")
+ ("logandc2" "f_logand.htm")
+ ("logbitp" "f_logbtp.htm")
+ ("logcount" "f_logcou.htm")
+ ("logeqv" "f_logand.htm")
+ ("logical-pathname" "a_logica.htm")
+ ("logical-pathname-translations" "f_logica.htm")
+ ("logior" "f_logand.htm")
+ ("lognand" "f_logand.htm")
+ ("lognor" "f_logand.htm")
+ ("lognot" "f_logand.htm")
+ ("logorc1" "f_logand.htm")
+ ("logorc2" "f_logand.htm")
+ ("logtest" "f_logtes.htm")
+ ("logxor" "f_logand.htm")
+ ("long-float" "t_short_.htm")
+ ("long-float-epsilon" "v_short_.htm")
+ ("long-float-negative-epsilon" "v_short_.htm")
+ ("long-site-name" "f_short_.htm")
+ ("loop" "m_loop.htm")
+ ("loop-finish" "m_loop_f.htm")
+ ("lower-case-p" "f_upper_.htm")
+ ("machine-instance" "f_mach_i.htm")
+ ("machine-type" "f_mach_t.htm")
+ ("machine-version" "f_mach_v.htm")
+ ("macro-function" "f_macro_.htm")
+ ("macroexpand" "f_mexp_.htm")
+ ("macroexpand-1" "f_mexp_.htm")
+ ("macrolet" "s_flet_.htm")
+ ("make-array" "f_mk_ar.htm")
+ ("make-broadcast-stream" "f_mk_bro.htm")
+ ("make-concatenated-stream" "f_mk_con.htm")
+ ("make-condition" "f_mk_cnd.htm")
+ ("make-dispatch-macro-character" "f_mk_dis.htm")
+ ("make-echo-stream" "f_mk_ech.htm")
+ ("make-hash-table" "f_mk_has.htm")
+ ("make-instance" "f_mk_ins.htm")
+ ("make-instances-obsolete" "f_mk_i_1.htm")
+ ("make-list" "f_mk_lis.htm")
+ ("make-load-form" "f_mk_ld_.htm")
+ ("make-load-form-saving-slots" "f_mk_l_1.htm")
+ ("make-method" "m_call_m.htm")
+ ("make-package" "f_mk_pkg.htm")
+ ("make-pathname" "f_mk_pn.htm")
+ ("make-random-state" "f_mk_rnd.htm")
+ ("make-sequence" "f_mk_seq.htm")
+ ("make-string" "f_mk_stg.htm")
+ ("make-string-input-stream" "f_mk_s_1.htm")
+ ("make-string-output-stream" "f_mk_s_2.htm")
+ ("make-symbol" "f_mk_sym.htm")
+ ("make-synonym-stream" "f_mk_syn.htm")
+ ("make-two-way-stream" "f_mk_two.htm")
+ ("makunbound" "f_makunb.htm")
+ ("map" "f_map.htm")
+ ("map-into" "f_map_in.htm")
+ ("mapc" "f_mapc_.htm")
+ ("mapcan" "f_mapc_.htm")
+ ("mapcar" "f_mapc_.htm")
+ ("mapcon" "f_mapc_.htm")
+ ("maphash" "f_maphas.htm")
+ ("mapl" "f_mapc_.htm")
+ ("maplist" "f_mapc_.htm")
+ ("mask-field" "f_mask_f.htm")
+ ("max" "f_max_m.htm")
+ ("member" "a_member.htm")
+ ("member-if" "f_mem_m.htm")
+ ("member-if-not" "f_mem_m.htm")
+ ("merge" "f_merge.htm")
+ ("merge-pathnames" "f_merge_.htm")
+ ("method" "t_method.htm")
+ ("method-combination" "a_method.htm")
+ ("method-combination-error" "f_meth_1.htm")
+ ("method-qualifiers" "f_method.htm")
+ ("min" "f_max_m.htm")
+ ("minusp" "f_minusp.htm")
+ ("mismatch" "f_mismat.htm")
+ ("mod" "a_mod.htm")
+ ("most-negative-double-float" "v_most_1.htm")
+ ("most-negative-fixnum" "v_most_p.htm")
+ ("most-negative-long-float" "v_most_1.htm")
+ ("most-negative-short-float" "v_most_1.htm")
+ ("most-negative-single-float" "v_most_1.htm")
+ ("most-positive-double-float" "v_most_1.htm")
+ ("most-positive-fixnum" "v_most_p.htm")
+ ("most-positive-long-float" "v_most_1.htm")
+ ("most-positive-short-float" "v_most_1.htm")
+ ("most-positive-single-float" "v_most_1.htm")
+ ("muffle-warning" "a_muffle.htm")
+ ("multiple-value-bind" "m_multip.htm")
+ ("multiple-value-call" "s_multip.htm")
+ ("multiple-value-list" "m_mult_1.htm")
+ ("multiple-value-prog1" "s_mult_1.htm")
+ ("multiple-value-setq" "m_mult_2.htm")
+ ("multiple-values-limit" "v_multip.htm")
+ ("name-char" "f_name_c.htm")
+ ("namestring" "f_namest.htm")
+ ("nbutlast" "f_butlas.htm")
+ ("nconc" "f_nconc.htm")
+ ("next-method-p" "f_next_m.htm")
+ ("nil" "a_nil.htm")
+ ("nintersection" "f_isec_.htm")
+ ("ninth" "f_firstc.htm")
+ ("no-applicable-method" "f_no_app.htm")
+ ("no-next-method" "f_no_nex.htm")
+ ("not" "a_not.htm")
+ ("notany" "f_everyc.htm")
+ ("notevery" "f_everyc.htm")
+ ("notinline" "d_inline.htm")
+ ("nreconc" "f_revapp.htm")
+ ("nreverse" "f_revers.htm")
+ ("nset-difference" "f_set_di.htm")
+ ("nset-exclusive-or" "f_set_ex.htm")
+ ("nstring-capitalize" "f_stg_up.htm")
+ ("nstring-downcase" "f_stg_up.htm")
+ ("nstring-upcase" "f_stg_up.htm")
+ ("nsublis" "f_sublis.htm")
+ ("nsubst" "f_substc.htm")
+ ("nsubst-if" "f_substc.htm")
+ ("nsubst-if-not" "f_substc.htm")
+ ("nsubstitute" "f_sbs_s.htm")
+ ("nsubstitute-if" "f_sbs_s.htm")
+ ("nsubstitute-if-not" "f_sbs_s.htm")
+ ("nth" "f_nth.htm")
+ ("nth-value" "m_nth_va.htm")
+ ("nthcdr" "f_nthcdr.htm")
+ ("null" "a_null.htm")
+ ("number" "t_number.htm")
+ ("numberp" "f_nump.htm")
+ ("numerator" "f_numera.htm")
+ ("nunion" "f_unionc.htm")
+ ("oddp" "f_evenpc.htm")
+ ("open" "f_open.htm")
+ ("open-stream-p" "f_open_s.htm")
+ ("optimize" "d_optimi.htm")
+ ("or" "a_or.htm")
+ ("otherwise" "m_case_.htm")
+ ("output-stream-p" "f_in_stm.htm")
+ ("package" "t_pkg.htm")
+ ("package-error" "e_pkg_er.htm")
+ ("package-error-package" "f_pkg_er.htm")
+ ("package-name" "f_pkg_na.htm")
+ ("package-nicknames" "f_pkg_ni.htm")
+ ("package-shadowing-symbols" "f_pkg_sh.htm")
+ ("package-use-list" "f_pkg_us.htm")
+ ("package-used-by-list" "f_pkg__1.htm")
+ ("packagep" "f_pkgp.htm")
+ ("pairlis" "f_pairli.htm")
+ ("parse-error" "e_parse_.htm")
+ ("parse-integer" "f_parse_.htm")
+ ("parse-namestring" "f_pars_1.htm")
+ ("pathname" "a_pn.htm")
+ ("pathname-device" "f_pn_hos.htm")
+ ("pathname-directory" "f_pn_hos.htm")
+ ("pathname-host" "f_pn_hos.htm")
+ ("pathname-match-p" "f_pn_mat.htm")
+ ("pathname-name" "f_pn_hos.htm")
+ ("pathname-type" "f_pn_hos.htm")
+ ("pathname-version" "f_pn_hos.htm")
+ ("pathnamep" "f_pnp.htm")
+ ("peek-char" "f_peek_c.htm")
+ ("phase" "f_phase.htm")
+ ("pi" "v_pi.htm")
+ ("plusp" "f_minusp.htm")
+ ("pop" "m_pop.htm")
+ ("position" "f_pos_p.htm")
+ ("position-if" "f_pos_p.htm")
+ ("position-if-not" "f_pos_p.htm")
+ ("pprint" "f_wr_pr.htm")
+ ("pprint-dispatch" "f_ppr_di.htm")
+ ("pprint-exit-if-list-exhausted" "m_ppr_ex.htm")
+ ("pprint-fill" "f_ppr_fi.htm")
+ ("pprint-indent" "f_ppr_in.htm")
+ ("pprint-linear" "f_ppr_fi.htm")
+ ("pprint-logical-block" "m_ppr_lo.htm")
+ ("pprint-newline" "f_ppr_nl.htm")
+ ("pprint-pop" "m_ppr_po.htm")
+ ("pprint-tab" "f_ppr_ta.htm")
+ ("pprint-tabular" "f_ppr_fi.htm")
+ ("prin1" "f_wr_pr.htm")
+ ("prin1-to-string" "f_wr_to_.htm")
+ ("princ" "f_wr_pr.htm")
+ ("princ-to-string" "f_wr_to_.htm")
+ ("print" "f_wr_pr.htm")
+ ("print-not-readable" "e_pr_not.htm")
+ ("print-not-readable-object" "f_pr_not.htm")
+ ("print-object" "f_pr_obj.htm")
+ ("print-unreadable-object" "m_pr_unr.htm")
+ ("probe-file" "f_probe_.htm")
+ ("proclaim" "f_procla.htm")
+ ("prog" "m_prog_.htm")
+ ("prog*" "m_prog_.htm")
+ ("prog1" "m_prog1c.htm")
+ ("prog2" "m_prog1c.htm")
+ ("progn" "s_progn.htm")
+ ("program-error" "e_progra.htm")
+ ("progv" "s_progv.htm")
+ ("provide" "f_provid.htm")
+ ("psetf" "m_setf_.htm")
+ ("psetq" "m_psetq.htm")
+ ("push" "m_push.htm")
+ ("pushnew" "m_pshnew.htm")
+ ("quote" "s_quote.htm")
+ ("random" "f_random.htm")
+ ("random-state" "t_rnd_st.htm")
+ ("random-state-p" "f_rnd_st.htm")
+ ("rassoc" "f_rassoc.htm")
+ ("rassoc-if" "f_rassoc.htm")
+ ("rassoc-if-not" "f_rassoc.htm")
+ ("ratio" "t_ratio.htm")
+ ("rational" "a_ration.htm")
+ ("rationalize" "f_ration.htm")
+ ("rationalp" "f_rati_1.htm")
+ ("read" "f_rd_rd.htm")
+ ("read-byte" "f_rd_by.htm")
+ ("read-char" "f_rd_cha.htm")
+ ("read-char-no-hang" "f_rd_c_1.htm")
+ ("read-delimited-list" "f_rd_del.htm")
+ ("read-from-string" "f_rd_fro.htm")
+ ("read-line" "f_rd_lin.htm")
+ ("read-preserving-whitespace" "f_rd_rd.htm")
+ ("read-sequence" "f_rd_seq.htm")
+ ("reader-error" "e_rder_e.htm")
+ ("readtable" "t_rdtabl.htm")
+ ("readtable-case" "f_rdtabl.htm")
+ ("readtablep" "f_rdta_1.htm")
+ ("real" "t_real.htm")
+ ("realp" "f_realp.htm")
+ ("realpart" "f_realpa.htm")
+ ("reduce" "f_reduce.htm")
+ ("reinitialize-instance" "f_reinit.htm")
+ ("rem" "f_mod_r.htm")
+ ("remf" "m_remf.htm")
+ ("remhash" "f_remhas.htm")
+ ("remove" "f_rm_rm.htm")
+ ("remove-duplicates" "f_rm_dup.htm")
+ ("remove-if" "f_rm_rm.htm")
+ ("remove-if-not" "f_rm_rm.htm")
+ ("remove-method" "f_rm_met.htm")
+ ("remprop" "f_rempro.htm")
+ ("rename-file" "f_rn_fil.htm")
+ ("rename-package" "f_rn_pkg.htm")
+ ("replace" "f_replac.htm")
+ ("require" "f_provid.htm")
+ ("rest" "f_rest.htm")
+ ("restart" "t_rst.htm")
+ ("restart-bind" "m_rst_bi.htm")
+ ("restart-case" "m_rst_ca.htm")
+ ("restart-name" "f_rst_na.htm")
+ ("return" "m_return.htm")
+ ("return-from" "s_ret_fr.htm")
+ ("revappend" "f_revapp.htm")
+ ("reverse" "f_revers.htm")
+ ("room" "f_room.htm")
+ ("rotatef" "m_rotate.htm")
+ ("round" "f_floorc.htm")
+ ("row-major-aref" "f_row_ma.htm")
+ ("rplaca" "f_rplaca.htm")
+ ("rplacd" "f_rplaca.htm")
+ ("safety" "d_optimi.htm")
+ ("satisfies" "t_satisf.htm")
+ ("sbit" "f_bt_sb.htm")
+ ("scale-float" "f_dec_fl.htm")
+ ("schar" "f_char_.htm")
+ ("search" "f_search.htm")
+ ("second" "f_firstc.htm")
+ ("sequence" "t_seq.htm")
+ ("serious-condition" "e_seriou.htm")
+ ("set" "f_set.htm")
+ ("set-difference" "f_set_di.htm")
+ ("set-dispatch-macro-character" "f_set__1.htm")
+ ("set-exclusive-or" "f_set_ex.htm")
+ ("set-macro-character" "f_set_ma.htm")
+ ("set-pprint-dispatch" "f_set_pp.htm")
+ ("set-syntax-from-char" "f_set_sy.htm")
+ ("setf" "a_setf.htm")
+ ("setq" "s_setq.htm")
+ ("seventh" "f_firstc.htm")
+ ("shadow" "f_shadow.htm")
+ ("shadowing-import" "f_shdw_i.htm")
+ ("shared-initialize" "f_shared.htm")
+ ("shiftf" "m_shiftf.htm")
+ ("short-float" "t_short_.htm")
+ ("short-float-epsilon" "v_short_.htm")
+ ("short-float-negative-epsilon" "v_short_.htm")
+ ("short-site-name" "f_short_.htm")
+ ("signal" "f_signal.htm")
+ ("signed-byte" "t_sgn_by.htm")
+ ("signum" "f_signum.htm")
+ ("simple-array" "t_smp_ar.htm")
+ ("simple-base-string" "t_smp_ba.htm")
+ ("simple-bit-vector" "t_smp_bt.htm")
+ ("simple-bit-vector-p" "f_smp_bt.htm")
+ ("simple-condition" "e_smp_cn.htm")
+ ("simple-condition-format-arguments" "f_smp_cn.htm")
+ ("simple-condition-format-control" "f_smp_cn.htm")
+ ("simple-error" "e_smp_er.htm")
+ ("simple-string" "t_smp_st.htm")
+ ("simple-string-p" "f_smp_st.htm")
+ ("simple-type-error" "e_smp_tp.htm")
+ ("simple-vector" "t_smp_ve.htm")
+ ("simple-vector-p" "f_smp_ve.htm")
+ ("simple-warning" "e_smp_wa.htm")
+ ("sin" "f_sin_c.htm")
+ ("single-float" "t_short_.htm")
+ ("single-float-epsilon" "v_short_.htm")
+ ("single-float-negative-epsilon" "v_short_.htm")
+ ("sinh" "f_sinh_.htm")
+ ("sixth" "f_firstc.htm")
+ ("sleep" "f_sleep.htm")
+ ("slot-boundp" "f_slt_bo.htm")
+ ("slot-exists-p" "f_slt_ex.htm")
+ ("slot-makunbound" "f_slt_ma.htm")
+ ("slot-missing" "f_slt_mi.htm")
+ ("slot-unbound" "f_slt_un.htm")
+ ("slot-value" "f_slt_va.htm")
+ ("software-type" "f_sw_tpc.htm")
+ ("software-version" "f_sw_tpc.htm")
+ ("some" "f_everyc.htm")
+ ("sort" "f_sort_.htm")
+ ("space" "d_optimi.htm")
+ ("special" "d_specia.htm")
+ ("special-operator-p" "f_specia.htm")
+ ("speed" "d_optimi.htm")
+ ("sqrt" "f_sqrt_.htm")
+ ("stable-sort" "f_sort_.htm")
+ ("standard" "07_ffb.htm")
+ ("standard-char" "t_std_ch.htm")
+ ("standard-char-p" "f_std_ch.htm")
+ ("standard-class" "t_std_cl.htm")
+ ("standard-generic-function" "t_std_ge.htm")
+ ("standard-method" "t_std_me.htm")
+ ("standard-object" "t_std_ob.htm")
+ ("step" "m_step.htm")
+ ("storage-condition" "e_storag.htm")
+ ("store-value" "a_store_.htm")
+ ("stream" "t_stream.htm")
+ ("stream-element-type" "f_stm_el.htm")
+ ("stream-error" "e_stm_er.htm")
+ ("stream-error-stream" "f_stm_er.htm")
+ ("stream-external-format" "f_stm_ex.htm")
+ ("streamp" "f_stmp.htm")
+ ("string" "a_string.htm")
+ ("string-capitalize" "f_stg_up.htm")
+ ("string-downcase" "f_stg_up.htm")
+ ("string-equal" "f_stgeq_.htm")
+ ("string-greaterp" "f_stgeq_.htm")
+ ("string-left-trim" "f_stg_tr.htm")
+ ("string-lessp" "f_stgeq_.htm")
+ ("string-not-equal" "f_stgeq_.htm")
+ ("string-not-greaterp" "f_stgeq_.htm")
+ ("string-not-lessp" "f_stgeq_.htm")
+ ("string-right-trim" "f_stg_tr.htm")
+ ("string-stream" "t_stg_st.htm")
+ ("string-trim" "f_stg_tr.htm")
+ ("string-upcase" "f_stg_up.htm")
+ ("string/=" "f_stgeq_.htm")
+ ("string<" "f_stgeq_.htm")
+ ("string<=" "f_stgeq_.htm")
+ ("string=" "f_stgeq_.htm")
+ ("string>" "f_stgeq_.htm")
+ ("string>=" "f_stgeq_.htm")
+ ("stringp" "f_stgp.htm")
+ ("structure" "f_docume.htm")
+ ("structure-class" "t_stu_cl.htm")
+ ("structure-object" "t_stu_ob.htm")
+ ("style-warning" "e_style_.htm")
+ ("sublis" "f_sublis.htm")
+ ("subseq" "f_subseq.htm")
+ ("subsetp" "f_subset.htm")
+ ("subst" "f_substc.htm")
+ ("subst-if" "f_substc.htm")
+ ("subst-if-not" "f_substc.htm")
+ ("substitute" "f_sbs_s.htm")
+ ("substitute-if" "f_sbs_s.htm")
+ ("substitute-if-not" "f_sbs_s.htm")
+ ("subtypep" "f_subtpp.htm")
+ ("svref" "f_svref.htm")
+ ("sxhash" "f_sxhash.htm")
+ ("symbol" "t_symbol.htm")
+ ("symbol-function" "f_symb_1.htm")
+ ("symbol-macrolet" "s_symbol.htm")
+ ("symbol-name" "f_symb_2.htm")
+ ("symbol-package" "f_symb_3.htm")
+ ("symbol-plist" "f_symb_4.htm")
+ ("symbol-value" "f_symb_5.htm")
+ ("symbolp" "f_symbol.htm")
+ ("synonym-stream" "t_syn_st.htm")
+ ("synonym-stream-symbol" "f_syn_st.htm")
+ ("t" "a_t.htm")
+ ("tagbody" "s_tagbod.htm")
+ ("tailp" "f_ldiffc.htm")
+ ("tan" "f_sin_c.htm")
+ ("tanh" "f_sinh_.htm")
+ ("tenth" "f_firstc.htm")
+ ("terpri" "f_terpri.htm")
+ ("the" "s_the.htm")
+ ("third" "f_firstc.htm")
+ ("throw" "s_throw.htm")
+ ("time" "m_time.htm")
+ ("trace" "m_tracec.htm")
+ ("translate-logical-pathname" "f_tr_log.htm")
+ ("translate-pathname" "f_tr_pn.htm")
+ ("tree-equal" "f_tree_e.htm")
+ ("truename" "f_tn.htm")
+ ("truncate" "f_floorc.htm")
+ ("two-way-stream" "t_two_wa.htm")
+ ("two-way-stream-input-stream" "f_two_wa.htm")
+ ("two-way-stream-output-stream" "f_two_wa.htm")
+ ("type" "a_type.htm")
+ ("type-error" "e_tp_err.htm")
+ ("type-error-datum" "f_tp_err.htm")
+ ("type-error-expected-type" "f_tp_err.htm")
+ ("type-of" "f_tp_of.htm")
+ ("typecase" "m_tpcase.htm")
+ ("typep" "f_typep.htm")
+ ("unbound-slot" "e_unboun.htm")
+ ("unbound-slot-instance" "f_unboun.htm")
+ ("unbound-variable" "e_unbo_1.htm")
+ ("undefined-function" "e_undefi.htm")
+ ("unexport" "f_unexpo.htm")
+ ("unintern" "f_uninte.htm")
+ ("union" "f_unionc.htm")
+ ("unless" "m_when_.htm")
+ ("unread-char" "f_unrd_c.htm")
+ ("unsigned-byte" "t_unsgn_.htm")
+ ("untrace" "m_tracec.htm")
+ ("unuse-package" "f_unuse_.htm")
+ ("unwind-protect" "s_unwind.htm")
+ ("update-instance-for-different-class" "f_update.htm")
+ ("update-instance-for-redefined-class" "f_upda_1.htm")
+ ("upgraded-array-element-type" "f_upgr_1.htm")
+ ("upgraded-complex-part-type" "f_upgrad.htm")
+ ("upper-case-p" "f_upper_.htm")
+ ("use-package" "f_use_pk.htm")
+ ("use-value" "a_use_va.htm")
+ ("user-homedir-pathname" "f_user_h.htm")
+ ("values" "a_values.htm")
+ ("values-list" "f_vals_l.htm")
+ ("variable" "f_docume.htm")
+ ("vector" "a_vector.htm")
+ ("vector-pop" "f_vec_po.htm")
+ ("vector-push" "f_vec_ps.htm")
+ ("vector-push-extend" "f_vec_ps.htm")
+ ("vectorp" "f_vecp.htm")
+ ("warn" "f_warn.htm")
+ ("warning" "e_warnin.htm")
+ ("when" "m_when_.htm")
+ ("wild-pathname-p" "f_wild_p.htm")
+ ("with-accessors" "m_w_acce.htm")
+ ("with-compilation-unit" "m_w_comp.htm")
+ ("with-condition-restarts" "m_w_cnd_.htm")
+ ("with-hash-table-iterator" "m_w_hash.htm")
+ ("with-input-from-string" "m_w_in_f.htm")
+ ("with-open-file" "m_w_open.htm")
+ ("with-open-stream" "m_w_op_1.htm")
+ ("with-output-to-string" "m_w_out_.htm")
+ ("with-package-iterator" "m_w_pkg_.htm")
+ ("with-simple-restart" "m_w_smp_.htm")
+ ("with-slots" "m_w_slts.htm")
+ ("with-standard-io-syntax" "m_w_std_.htm")
+ ("write" "f_wr_pr.htm")
+ ("write-byte" "f_wr_by.htm")
+ ("write-char" "f_wr_cha.htm")
+ ("write-line" "f_wr_stg.htm")
+ ("write-sequence" "f_wr_seq.htm")
+ ("write-string" "f_wr_stg.htm")
+ ("write-to-string" "f_wr_to_.htm")
+ ("y-or-n-p" "f_y_or_n.htm")
+ ("yes-or-no-p" "f_y_or_n.htm")
+ ("zerop" "f_zerop.htm"))))
+
+;;; FORMAT character lookup by Frode Vatvedt Fjeld <frodef(a)acm.org> 20030902
+;;;
+;;; adjusted for ILISP by Nikodemus Siivola 20030903
+
+(defvar common-lisp-hyperspec-format-history nil
+ "History of format characters looked up in the Common Lisp HyperSpec.")
+
+(defvar common-lisp-hyperspec-format-characters (make-vector 67 0))
+
+
+(defun common-lisp-hyperspec-section-6.0 (indices)
+ (let ((string (format "%sBody/%s_"
+ common-lisp-hyperspec-root
+ (let ((base (pop indices)))
+ (if (< base 10)
+ (format "0%s" base)
+ base)))))
+ (concat string
+ (mapconcat (lambda (n)
+ (make-string 1 (+ ?a (- n 1))))
+ indices
+ "")
+ ".htm")))
+
+(defun common-lisp-hyperspec-section-4.0 (indices)
+ (let ((string (format "%sBody/sec_"
+ common-lisp-hyperspec-root)))
+ (concat string
+ (mapconcat (lambda (n)
+ (format "%d" n))
+ indices
+ "-")
+ ".html")))
+
+(defvar common-lisp-hyperspec-section-fun 'common-lisp-hyperspec-section-6.0)
+
+(defun common-lisp-hyperspec-section (indices)
+ (funcall common-lisp-hyperspec-section-fun indices))
+
+(defun common-lisp-hyperspec-format (character-name)
+ (interactive
+ (list (let ((char-at-point
+ (ignore-errors (char-to-string (char-after (point))))))
+ (if (and char-at-point
+ (intern-soft (upcase char-at-point)
+ common-lisp-hyperspec-format-characters))
+ char-at-point
+ (completing-read
+ "Look up format control character in Common Lisp HyperSpec: "
+ common-lisp-hyperspec-format-characters nil #'boundp
+ nil nil 'common-lisp-hyperspec-format-history)))))
+ (maplist (lambda (entry)
+ (browse-url (common-lisp-hyperspec-section (car entry))))
+ (let ((symbol (intern-soft character-name
+ common-lisp-hyperspec-format-characters)))
+ (if (and symbol (boundp symbol))
+ (symbol-value symbol)
+ (error "The symbol `%s' is not defined in Common Lisp"
+ character-name)))))
+
+(eval-when (load eval)
+ (defalias 'hyperspec-lookup-format 'common-lisp-hyperspec-format))
+
+(mapcar (lambda (entry)
+ (let ((symbol (intern (car entry)
+ common-lisp-hyperspec-format-characters)))
+ (if (boundp symbol)
+ (pushnew (cadr entry) (symbol-value symbol) :test 'equal)
+ (set symbol (cdr entry))))
+ (when (and (= 1 (length (car entry)))
+ (not (string-equal (car entry) (upcase (car entry)))))
+ (let ((symbol (intern (upcase (car entry))
+ common-lisp-hyperspec-format-characters)))
+ (if (boundp symbol)
+ (pushnew (cadr entry) (symbol-value symbol) :test 'equal)
+ (set symbol (cdr entry))))))
+ '(("c" (22 3 1 1)) ("C: Character" (22 3 1 1))
+ ("%" (22 3 1 2)) ("Percent: Newline" (22 3 1 2))
+ ("&" (22 3 1 3)) ("Ampersand: Fresh-line" (22 3 1 3))
+ ("|" (22 3 1 4)) ("Vertical-Bar: Page" (22 3 1 4))
+ ("~" (22 3 1 5)) ("Tilde: Tilde" (22 3 1 5))
+ ("r" (22 3 2 1)) ("R: Radix" (22 3 2 1))
+ ("d" (22 3 2 2)) ("D: Decimal" (22 3 2-2))
+ ("b" (22 3 2 3)) ("B: Binary" (22 3 2 3))
+ ("o" (22 3 2 4)) ("O: Octal" (22 3 2 4))
+ ("x" (22 3 2 5)) ("X: Hexadecimal" (22 3 2 5))
+ ("f" (22 3 3 1)) ("F: Fixed-Format Floating-Point" (22 3 3 1))
+ ("e" (22 3 3 2)) ("E: Exponential Floating-Point" (22 3 3 2))
+ ("g" (22 3 3 3)) ("G: General Floating-Point" (22 3 3 3))
+ ("$" (22 3 3 4)) ("Dollarsign: Monetary Floating-Point" (22 3 3 4))
+ ("a" (22 3 4 1)) ("A: Aesthetic" (22 3 4 1))
+ ("s" (22 3 4 2)) ("S: Standard" (22 3 4 2))
+ ("w" (22 3 4 3)) ("W: Write" (22 3 4 3))
+ ("_" (22 3 5 1)) ("Underscore: Conditional Newline" (22 3 5 1))
+ ("<" (22 3 5 2)) ("Less-Than-Sign: Logical Block" (22 3 5 2))
+ ("i" (22 3 5 3)) ("I: Indent" (22 3 5 3))
+ ("/" (22 3 5 4)) ("Slash: Call Function" (22 3 5 4))
+ ("t" (22 3 6 1)) ("T: Tabulate" (22 3 6 1))
+ ("<" (22 3 6 2)) ("Less-Than-Sign: Justification" (22 3 6 2))
+ (">" (22 3 6 3)) ("Greater-Than-Sign: End of Justification" (22 3 6 3))
+ ("*" (22 3 7 1)) ("Asterisk: Go-To" (22 3 7 1))
+ ("[" (22 3 7 2)) ("Left-Bracket: Conditional Expression" (22 3 7 2))
+ ("]" (22 3 7 3)) ("Right-Bracket: End of Conditional Expression" (22 3 7 3))
+ ("{" (22 3 7 4)) ("Left-Brace: Iteration" (22 3 7 4))
+ ("}" (22 3 7 5)) ("Right-Brace: End of Iteration" (22 3 7 5))
+ ("?" (22 3 7 6)) ("Question-Mark: Recursive Processing" (22 3 7 6))
+ ("(" (22 3 8 1)) ("Left-Paren: Case Conversion" (22 3 8 1))
+ (")" (22 3 8 2)) ("Right-Paren: End of Case Conversion" (22 3 8 2))
+ ("p" (22 3 8 3)) ("P: Plural" (22 3 8-3))
+ (";" (22 3 9 1)) ("Semicolon: Clause Separator" (22 3 9 1))
+ ("^" (22 3 9 2)) ("Circumflex: Escape Upward" (22 3 9 2))
+ ("Newline: Ignored Newline" (22 3 9 3))
+ ("Nesting of FORMAT Operations" (22 3 10 1))
+ ("Missing and Additional FORMAT Arguments" (22 3 10 2))
+ ("Additional FORMAT Parameters" (22 3 10 3))))
+
+(defvar common-lisp-glossary-fun 'common-lisp-glossary-6.0)
+
+(defun common-lisp-glossary-6.0 (string)
+ (format "%sBody/26_glo_%s.htm#%s"
+ common-lisp-hyperspec-root
+ (let ((char (string-to-char string)))
+ (if (and (<= ?a char)
+ (<= char ?z))
+ (make-string 1 char)
+ "9"))
+ (subst-char-in-string ?\ ?_ string)))
+
+(defun common-lisp-glossary-4.0 (string)
+ (format "%sBody/glo_%s.html#%s"
+ common-lisp-hyperspec-root
+ (let ((char (string-to-char string)))
+ (if (and (<= ?a char)
+ (<= char ?z))
+ (make-string 1 char)
+ "9"))
+ (subst-char-in-string ?\ ?_ string)))
+
+(defvar common-lisp-hyperspec-issuex-table nil
+ "The HyperSpec IssueX table file. If you copy the HyperSpec to your
+local system, set this variable to the location of the Issue
+cross-references table which is usually \"Map_IssX.txt\" or
+\"Issue-Cross-Refs.text\".")
+
+(defvar common-lisp-hyperspec-issuex-symbols (make-vector 67 0))
+
+(if common-lisp-hyperspec-issuex-table
+ (let ((index-buffer (find-file-noselect common-lisp-hyperspec-issuex-table)))
+ (labels ((get-one-line ()
+ (prog1
+ (delete* ?\n (thing-at-point 'line))
+ (forward-line))))
+ (save-excursion
+ (set-buffer index-buffer)
+ (goto-char (point-min))
+ (while (< (point) (point-max))
+ (let* ((symbol (intern (downcase (get-one-line))
+ common-lisp-hyperspec-issuex-symbols))
+ (relative-url (get-one-line)))
+ (set symbol (subseq relative-url
+ (1+ (position ?\/ relative-url :from-end t)))))))))
+ (mapcar
+ (lambda (entry)
+ (let ((symbol (intern (car entry) common-lisp-hyperspec-issuex-symbols)))
+ (set symbol (cadr entry))))
+ '(("&environment-binding-order:first" "iss001.htm")
+ ("access-error-name" "iss002.htm")
+ ("adjust-array-displacement" "iss003.htm")
+ ("adjust-array-fill-pointer" "iss004.htm")
+ ("adjust-array-not-adjustable:implicit-copy" "iss005.htm")
+ ("allocate-instance:add" "iss006.htm")
+ ("allow-local-inline:inline-notinline" "iss007.htm")
+ ("allow-other-keys-nil:permit" "iss008.htm")
+ ("aref-1d" "iss009.htm")
+ ("argument-mismatch-error-again:consistent" "iss010.htm")
+ ("argument-mismatch-error-moon:fix" "iss011.htm")
+ ("argument-mismatch-error:more-clarifications" "iss012.htm")
+ ("arguments-underspecified:specify" "iss013.htm")
+ ("array-dimension-limit-implications:all-fixnum" "iss014.htm")
+ ("array-type-element-type-semantics:unify-upgrading" "iss015.htm")
+ ("assert-error-type:error" "iss016.htm")
+ ("assoc-rassoc-if-key" "iss017.htm")
+ ("assoc-rassoc-if-key:yes" "iss018.htm")
+ ("boa-aux-initialization:error-on-read" "iss019.htm")
+ ("break-on-warnings-obsolete:remove" "iss020.htm")
+ ("broadcast-stream-return-values:clarify-minimally" "iss021.htm")
+ ("butlast-negative:should-signal" "iss022.htm")
+ ("change-class-initargs:permit" "iss023.htm")
+ ("char-name-case:x3j13-mar-91" "iss024.htm")
+ ("character-loose-ends:fix" "iss025.htm")
+ ("character-proposal:2" "iss026.htm")
+ ("character-proposal:2-1-1" "iss027.htm")
+ ("character-proposal:2-1-2" "iss028.htm")
+ ("character-proposal:2-2-1" "iss029.htm")
+ ("character-proposal:2-3-1" "iss030.htm")
+ ("character-proposal:2-3-2" "iss031.htm")
+ ("character-proposal:2-3-3" "iss032.htm")
+ ("character-proposal:2-3-4" "iss033.htm")
+ ("character-proposal:2-3-5" "iss034.htm")
+ ("character-proposal:2-3-6" "iss035.htm")
+ ("character-proposal:2-4-1" "iss036.htm")
+ ("character-proposal:2-4-2" "iss037.htm")
+ ("character-proposal:2-4-3" "iss038.htm")
+ ("character-proposal:2-5-2" "iss039.htm")
+ ("character-proposal:2-5-6" "iss040.htm")
+ ("character-proposal:2-5-7" "iss041.htm")
+ ("character-proposal:2-6-1" "iss042.htm")
+ ("character-proposal:2-6-2" "iss043.htm")
+ ("character-proposal:2-6-3" "iss044.htm")
+ ("character-proposal:2-6-5" "iss045.htm")
+ ("character-vs-char:less-inconsistent-short" "iss046.htm")
+ ("class-object-specializer:affirm" "iss047.htm")
+ ("clos-conditions-again:allow-subset" "iss048.htm")
+ ("clos-conditions:integrate" "iss049.htm")
+ ("clos-error-checking-order:no-applicable-method-first" "iss050.htm")
+ ("clos-macro-compilation:minimal" "iss051.htm")
+ ("close-constructed-stream:argument-stream-only" "iss052.htm")
+ ("closed-stream-operations:allow-inquiry" "iss053.htm")
+ ("coercing-setf-name-to-function:all-function-names" "iss054.htm")
+ ("colon-number" "iss055.htm")
+ ("common-features:specify" "iss056.htm")
+ ("common-type:remove" "iss057.htm")
+ ("compile-argument-problems-again:fix" "iss058.htm")
+ ("compile-file-handling-of-top-level-forms:clarify" "iss059.htm")
+ ("compile-file-output-file-defaults:input-file" "iss060.htm")
+ ("compile-file-package" "iss061.htm")
+ ("compile-file-pathname-arguments:make-consistent" "iss062.htm")
+ ("compile-file-symbol-handling:new-require-consistency" "iss063.htm")
+ ("compiled-function-requirements:tighten" "iss064.htm")
+ ("compiler-diagnostics:use-handler" "iss065.htm")
+ ("compiler-let-confusion:eliminate" "iss066.htm")
+ ("compiler-verbosity:like-load" "iss067.htm")
+ ("compiler-warning-stream" "iss068.htm")
+ ("complex-atan-branch-cut:tweak" "iss069.htm")
+ ("complex-atanh-bogus-formula:tweak-more" "iss070.htm")
+ ("complex-rational-result:extend" "iss071.htm")
+ ("compute-applicable-methods:generic" "iss072.htm")
+ ("concatenate-sequence:signal-error" "iss073.htm")
+ ("condition-accessors-setfable:no" "iss074.htm")
+ ("condition-restarts:buggy" "iss075.htm")
+ ("condition-restarts:permit-association" "iss076.htm")
+ ("condition-slots:hidden" "iss077.htm")
+ ("cons-type-specifier:add" "iss078.htm")
+ ("constant-circular-compilation:yes" "iss079.htm")
+ ("constant-collapsing:generalize" "iss080.htm")
+ ("constant-compilable-types:specify" "iss081.htm")
+ ("constant-function-compilation:no" "iss082.htm")
+ ("constant-modification:disallow" "iss083.htm")
+ ("constantp-definition:intentional" "iss084.htm")
+ ("constantp-environment:add-arg" "iss085.htm")
+ ("contagion-on-numerical-comparisons:transitive" "iss086.htm")
+ ("copy-symbol-copy-plist:copy-list" "iss087.htm")
+ ("copy-symbol-print-name:equal" "iss088.htm")
+ ("data-io:add-support" "iss089.htm")
+ ("data-types-hierarchy-underspecified" "iss090.htm")
+ ("debugger-hook-vs-break:clarify" "iss091.htm")
+ ("declaration-scope:no-hoisting" "iss092.htm")
+ ("declare-array-type-element-references:restrictive" "iss093.htm")
+ ("declare-function-ambiguity:delete-ftype-abbreviation" "iss094.htm")
+ ("declare-macros:flush" "iss095.htm")
+ ("declare-type-free:lexical" "iss096.htm")
+ ("decls-and-doc" "iss097.htm")
+ ("decode-universal-time-daylight:like-encode" "iss098.htm")
+ ("defconstant-special:no" "iss099.htm")
+ ("defgeneric-declare:allow-multiple" "iss100.htm")
+ ("define-compiler-macro:x3j13-nov89" "iss101.htm")
+ ("define-condition-syntax:incompatibly-more-like-defclass+emphasize-read-only" "iss102.htm")
+ ("define-method-combination-behavior:clarify" "iss103.htm")
+ ("defining-macros-non-top-level:allow" "iss104.htm")
+ ("defmacro-block-scope:excludes-bindings" "iss105.htm")
+ ("defmacro-lambda-list:tighten-description" "iss106.htm")
+ ("defmethod-declaration-scope:corresponds-to-bindings" "iss107.htm")
+ ("defpackage:addition" "iss108.htm")
+ ("defstruct-constructor-key-mixture:allow-key" "iss109.htm")
+ ("defstruct-constructor-options:explicit" "iss110.htm")
+ ("defstruct-constructor-slot-variables:not-bound" "iss111.htm")
+ ("defstruct-copier-argument-type:restrict" "iss112.htm")
+ ("defstruct-copier:argument-type" "iss113.htm")
+ ("defstruct-default-value-evaluation:iff-needed" "iss114.htm")
+ ("defstruct-include-deftype:explicitly-undefined" "iss115.htm")
+ ("defstruct-print-function-again:x3j13-mar-93" "iss116.htm")
+ ("defstruct-print-function-inheritance:yes" "iss117.htm")
+ ("defstruct-redefinition:error" "iss118.htm")
+ ("defstruct-slots-constraints-name:duplicates-error" "iss119.htm")
+ ("defstruct-slots-constraints-number" "iss120.htm")
+ ("deftype-destructuring:yes" "iss121.htm")
+ ("deftype-key:allow" "iss122.htm")
+ ("defvar-documentation:unevaluated" "iss123.htm")
+ ("defvar-init-time:not-delayed" "iss124.htm")
+ ("defvar-initialization:conservative" "iss125.htm")
+ ("deprecation-position:limited" "iss126.htm")
+ ("describe-interactive:no" "iss127.htm")
+ ("describe-underspecified:describe-object" "iss128.htm")
+ ("destructive-operations:specify" "iss129.htm")
+ ("destructuring-bind:new-macro" "iss130.htm")
+ ("disassemble-side-effect:do-not-install" "iss131.htm")
+ ("displaced-array-predicate:add" "iss132.htm")
+ ("do-symbols-block-scope:entire-form" "iss133.htm")
+ ("do-symbols-duplicates" "iss134.htm")
+ ("documentation-function-bugs:fix" "iss135.htm")
+ ("documentation-function-tangled:require-argument" "iss136.htm")
+ ("dotimes-ignore:x3j13-mar91" "iss137.htm")
+ ("dotted-list-arguments:clarify" "iss138.htm")
+ ("dotted-macro-forms:allow" "iss139.htm")
+ ("dribble-technique" "iss140.htm")
+ ("dynamic-extent-function:extend" "iss141.htm")
+ ("dynamic-extent:new-declaration" "iss142.htm")
+ ("equal-structure:maybe-status-quo" "iss143.htm")
+ ("error-terminology-warning:might" "iss144.htm")
+ ("eval-other:self-evaluate" "iss145.htm")
+ ("eval-top-level:load-like-compile-file" "iss146.htm")
+ ("eval-when-non-top-level:generalize-eval-new-keywords" "iss147.htm")
+ ("eval-when-obsolete-keywords:x3j13-mar-1993" "iss148.htm")
+ ("evalhook-step-confusion:fix" "iss149.htm")
+ ("evalhook-step-confusion:x3j13-nov-89" "iss150.htm")
+ ("exit-extent-and-condition-system:like-dynamic-bindings" "iss151.htm")
+ ("exit-extent:minimal" "iss152.htm")
+ ("expt-ratio:p.211" "iss153.htm")
+ ("extensions-position:documentation" "iss154.htm")
+ ("external-format-for-every-file-connection:minimum" "iss155.htm")
+ ("extra-return-values:no" "iss156.htm")
+ ("file-open-error:signal-file-error" "iss157.htm")
+ ("fixnum-non-portable:tighten-definition" "iss158.htm")
+ ("flet-declarations" "iss159.htm")
+ ("flet-declarations:allow" "iss160.htm")
+ ("flet-implicit-block:yes" "iss161.htm")
+ ("float-underflow:add-variables" "iss162.htm")
+ ("floating-point-condition-names:x3j13-nov-89" "iss163.htm")
+ ("format-atsign-colon" "iss164.htm")
+ ("format-colon-uparrow-scope" "iss165.htm")
+ ("format-comma-interval" "iss166.htm")
+ ("format-e-exponent-sign:force-sign" "iss167.htm")
+ ("format-op-c" "iss168.htm")
+ ("format-pretty-print:yes" "iss169.htm")
+ ("format-string-arguments:specify" "iss170.htm")
+ ("function-call-evaluation-order:more-unspecified" "iss171.htm")
+ ("function-composition:jan89-x3j13" "iss172.htm")
+ ("function-definition:jan89-x3j13" "iss173.htm")
+ ("function-name:large" "iss174.htm")
+ ("function-type" "iss175.htm")
+ ("function-type-argument-type-semantics:restrictive" "iss176.htm")
+ ("function-type-key-name:specify-keyword" "iss177.htm")
+ ("function-type-rest-list-element:use-actual-argument-type" "iss178.htm")
+ ("function-type:x3j13-march-88" "iss179.htm")
+ ("generalize-pretty-printer:unify" "iss180.htm")
+ ("generic-flet-poorly-designed:delete" "iss181.htm")
+ ("gensym-name-stickiness:like-teflon" "iss182.htm")
+ ("gentemp-bad-idea:deprecate" "iss183.htm")
+ ("get-macro-character-readtable:nil-standard" "iss184.htm")
+ ("get-setf-method-environment:add-arg" "iss185.htm")
+ ("hash-table-access:x3j13-mar-89" "iss186.htm")
+ ("hash-table-key-modification:specify" "iss187.htm")
+ ("hash-table-package-generators:add-with-wrapper" "iss188.htm")
+ ("hash-table-rehash-size-integer" "iss189.htm")
+ ("hash-table-size:intended-entries" "iss190.htm")
+ ("hash-table-tests:add-equalp" "iss191.htm")
+ ("ieee-atan-branch-cut:split" "iss192.htm")
+ ("ignore-use-terminology:value-only" "iss193.htm")
+ ("import-setf-symbol-package" "iss194.htm")
+ ("in-package-functionality:mar89-x3j13" "iss195.htm")
+ ("in-syntax:minimal" "iss196.htm")
+ ("initialization-function-keyword-checking" "iss197.htm")
+ ("iso-compatibility:add-substrate" "iss198.htm")
+ ("jun90-trivial-issues:11" "iss199.htm")
+ ("jun90-trivial-issues:14" "iss200.htm")
+ ("jun90-trivial-issues:24" "iss201.htm")
+ ("jun90-trivial-issues:25" "iss202.htm")
+ ("jun90-trivial-issues:27" "iss203.htm")
+ ("jun90-trivial-issues:3" "iss204.htm")
+ ("jun90-trivial-issues:4" "iss205.htm")
+ ("jun90-trivial-issues:5" "iss206.htm")
+ ("jun90-trivial-issues:9" "iss207.htm")
+ ("keyword-argument-name-package:any" "iss208.htm")
+ ("last-n" "iss209.htm")
+ ("lcm-no-arguments:1" "iss210.htm")
+ ("lexical-construct-global-definition:undefined" "iss211.htm")
+ ("lisp-package-name:common-lisp" "iss212.htm")
+ ("lisp-symbol-redefinition-again:more-fixes" "iss213.htm")
+ ("lisp-symbol-redefinition:mar89-x3j13" "iss214.htm")
+ ("load-objects:make-load-form" "iss215.htm")
+ ("load-time-eval:r**2-new-special-form" "iss216.htm")
+ ("load-time-eval:r**3-new-special-form" "iss217.htm")
+ ("load-truename:new-pathname-variables" "iss218.htm")
+ ("locally-top-level:special-form" "iss219.htm")
+ ("loop-and-discrepancy:no-reiteration" "iss220.htm")
+ ("loop-for-as-on-typo:fix-typo" "iss221.htm")
+ ("loop-initform-environment:partial-interleaving-vague" "iss222.htm")
+ ("loop-miscellaneous-repairs:fix" "iss223.htm")
+ ("loop-named-block-nil:override" "iss224.htm")
+ ("loop-present-symbols-typo:flush-wrong-words" "iss225.htm")
+ ("loop-syntax-overhaul:repair" "iss226.htm")
+ ("macro-as-function:disallow" "iss227.htm")
+ ("macro-declarations:make-explicit" "iss228.htm")
+ ("macro-environment-extent:dynamic" "iss229.htm")
+ ("macro-function-environment" "iss230.htm")
+ ("macro-function-environment:yes" "iss231.htm")
+ ("macro-subforms-top-level-p:add-constraints" "iss232.htm")
+ ("macroexpand-hook-default:explicitly-vague" "iss233.htm")
+ ("macroexpand-hook-initial-value:implementation-dependent" "iss234.htm")
+ ("macroexpand-return-value:true" "iss235.htm")
+ ("make-load-form-confusion:rewrite" "iss236.htm")
+ ("make-load-form-saving-slots:no-initforms" "iss237.htm")
+ ("make-package-use-default:implementation-dependent" "iss238.htm")
+ ("map-into:add-function" "iss239.htm")
+ ("mapping-destructive-interaction:explicitly-vague" "iss240.htm")
+ ("metaclass-of-system-class:unspecified" "iss241.htm")
+ ("method-combination-arguments:clarify" "iss242.htm")
+ ("method-initform:forbid-call-next-method" "iss243.htm")
+ ("muffle-warning-condition-argument" "iss244.htm")
+ ("multiple-value-setq-order:like-setf-of-values" "iss245.htm")
+ ("multiple-values-limit-on-variables:undefined" "iss246.htm")
+ ("nintersection-destruction" "iss247.htm")
+ ("nintersection-destruction:revert" "iss248.htm")
+ ("not-and-null-return-value:x3j13-mar-93" "iss249.htm")
+ ("nth-value:add" "iss250.htm")
+ ("optimize-debug-info:new-quality" "iss251.htm")
+ ("package-clutter:reduce" "iss252.htm")
+ ("package-deletion:new-function" "iss253.htm")
+ ("package-function-consistency:more-permissive" "iss254.htm")
+ ("parse-error-stream:split-types" "iss255.htm")
+ ("pathname-component-case:keyword-argument" "iss256.htm")
+ ("pathname-component-value:specify" "iss257.htm")
+ ("pathname-host-parsing:recognize-logical-host-names" "iss258.htm")
+ ("pathname-logical:add" "iss259.htm")
+ ("pathname-print-read:sharpsign-p" "iss260.htm")
+ ("pathname-stream" "iss261.htm")
+ ("pathname-stream:files-or-synonym" "iss262.htm")
+ ("pathname-subdirectory-list:new-representation" "iss263.htm")
+ ("pathname-symbol" "iss264.htm")
+ ("pathname-syntax-error-time:explicitly-vague" "iss265.htm")
+ ("pathname-unspecific-component:new-token" "iss266.htm")
+ ("pathname-wild:new-functions" "iss267.htm")
+ ("peek-char-read-char-echo:first-read-char" "iss268.htm")
+ ("plist-duplicates:allow" "iss269.htm")
+ ("pretty-print-interface" "iss270.htm")
+ ("princ-readably:x3j13-dec-91" "iss271.htm")
+ ("print-case-behavior:clarify" "iss272.htm")
+ ("print-case-print-escape-interaction:vertical-bar-rule-no-upcase" "iss273.htm")
+ ("print-circle-shared:respect-print-circle" "iss274.htm")
+ ("print-circle-structure:user-functions-work" "iss275.htm")
+ ("print-readably-behavior:clarify" "iss276.htm")
+ ("printer-whitespace:just-one-space" "iss277.htm")
+ ("proclaim-etc-in-compile-file:new-macro" "iss278.htm")
+ ("push-evaluation-order:first-item" "iss279.htm")
+ ("push-evaluation-order:item-first" "iss280.htm")
+ ("pushnew-store-required:unspecified" "iss281.htm")
+ ("quote-semantics:no-copying" "iss282.htm")
+ ("range-of-count-keyword:nil-or-integer" "iss283.htm")
+ ("range-of-start-and-end-parameters:integer-and-integer-nil" "iss284.htm")
+ ("read-and-write-bytes:new-functions" "iss285.htm")
+ ("read-case-sensitivity:readtable-keywords" "iss286.htm")
+ ("read-modify-write-evaluation-order:delayed-access-stores" "iss287.htm")
+ ("read-suppress-confusing:generalize" "iss288.htm")
+ ("reader-error:new-type" "iss289.htm")
+ ("real-number-type:x3j13-mar-89" "iss290.htm")
+ ("recursive-deftype:explicitly-vague" "iss291.htm")
+ ("reduce-argument-extraction" "iss292.htm")
+ ("remf-destruction-unspecified:x3j13-mar-89" "iss293.htm")
+ ("require-pathname-defaults-again:x3j13-dec-91" "iss294.htm")
+ ("require-pathname-defaults-yet-again:restore-argument" "iss295.htm")
+ ("require-pathname-defaults:eliminate" "iss296.htm")
+ ("rest-list-allocation:may-share" "iss297.htm")
+ ("result-lists-shared:specify" "iss298.htm")
+ ("return-values-unspecified:specify" "iss299.htm")
+ ("room-default-argument:new-value" "iss300.htm")
+ ("self-modifying-code:forbid" "iss301.htm")
+ ("sequence-type-length:must-match" "iss302.htm")
+ ("setf-apply-expansion:ignore-expander" "iss303.htm")
+ ("setf-find-class:allow-nil" "iss304.htm")
+ ("setf-functions-again:minimal-changes" "iss305.htm")
+ ("setf-get-default:evaluated-but-ignored" "iss306.htm")
+ ("setf-macro-expansion:last" "iss307.htm")
+ ("setf-method-vs-setf-method:rename-old-terms" "iss308.htm")
+ ("setf-multiple-store-variables:allow" "iss309.htm")
+ ("setf-of-apply:only-aref-and-friends" "iss310.htm")
+ ("setf-of-values:add" "iss311.htm")
+ ("setf-sub-methods:delayed-access-stores" "iss312.htm")
+ ("shadow-already-present" "iss313.htm")
+ ("shadow-already-present:works" "iss314.htm")
+ ("sharp-comma-confusion:remove" "iss315.htm")
+ ("sharp-o-foobar:consequences-undefined" "iss316.htm")
+ ("sharp-star-delimiter:normal-delimiter" "iss317.htm")
+ ("sharpsign-plus-minus-package:keyword" "iss318.htm")
+ ("slot-missing-values:specify" "iss319.htm")
+ ("slot-value-metaclasses:less-minimal" "iss320.htm")
+ ("special-form-p-misnomer:rename" "iss321.htm")
+ ("special-type-shadowing:clarify" "iss322.htm")
+ ("standard-input-initial-binding:defined-contracts" "iss323.htm")
+ ("standard-repertoire-gratuitous:rename" "iss324.htm")
+ ("step-environment:current" "iss325.htm")
+ ("step-minimal:permit-progn" "iss326.htm")
+ ("stream-access:add-types-accessors" "iss327.htm")
+ ("stream-capabilities:interactive-stream-p" "iss328.htm")
+ ("string-coercion:make-consistent" "iss329.htm")
+ ("string-output-stream-bashing:undefined" "iss330.htm")
+ ("structure-read-print-syntax:keywords" "iss331.htm")
+ ("subseq-out-of-bounds" "iss332.htm")
+ ("subseq-out-of-bounds:is-an-error" "iss333.htm")
+ ("subsetting-position:none" "iss334.htm")
+ ("subtypep-environment:add-arg" "iss335.htm")
+ ("subtypep-too-vague:clarify-more" "iss336.htm")
+ ("sxhash-definition:similar-for-sxhash" "iss337.htm")
+ ("symbol-macrolet-declare:allow" "iss338.htm")
+ ("symbol-macrolet-semantics:special-form" "iss339.htm")
+ ("symbol-macrolet-type-declaration:no" "iss340.htm")
+ ("symbol-macros-and-proclaimed-specials:signals-an-error" "iss341.htm")
+ ("symbol-print-escape-behavior:clarify" "iss342.htm")
+ ("syntactic-environment-access:retracted-mar91" "iss343.htm")
+ ("tagbody-tag-expansion:no" "iss344.htm")
+ ("tailp-nil:t" "iss345.htm")
+ ("test-not-if-not:flush-all" "iss346.htm")
+ ("the-ambiguity:for-declaration" "iss347.htm")
+ ("the-values:return-number-received" "iss348.htm")
+ ("time-zone-non-integer:allow" "iss349.htm")
+ ("type-declaration-abbreviation:allow-all" "iss350.htm")
+ ("type-of-and-predefined-classes:type-of-handles-floats" "iss351.htm")
+ ("type-of-and-predefined-classes:unify-and-extend" "iss352.htm")
+ ("type-of-underconstrained:add-constraints" "iss353.htm")
+ ("type-specifier-abbreviation:x3j13-jun90-guess" "iss354.htm")
+ ("undefined-variables-and-functions:compromise" "iss355.htm")
+ ("uninitialized-elements:consequences-undefined" "iss356.htm")
+ ("unread-char-after-peek-char:dont-allow" "iss357.htm")
+ ("unsolicited-messages:not-to-system-user-streams" "iss358.htm")
+ ("variable-list-asymmetry:symmetrize" "iss359.htm")
+ ("with-added-methods:delete" "iss360.htm")
+ ("with-compilation-unit:new-macro" "iss361.htm")
+ ("with-open-file-does-not-exist:stream-is-nil" "iss362.htm")
+ ("with-open-file-setq:explicitly-vague" "iss363.htm")
+ ("with-open-file-stream-extent:dynamic-extent" "iss364.htm")
+ ("with-output-to-string-append-style:vector-push-extend" "iss365.htm")
+ ("with-standard-io-syntax-readtable:x3j13-mar-91" "iss366.htm"))))
+
+(defun common-lisp-issuex (issue-name)
+ (let ((symbol
+ (intern (downcase issue-name) common-lisp-hyperspec-issuex-symbols)))
+ (concat common-lisp-hyperspec-root "Issues/" (symbol-value symbol))))
+
+(provide 'hyperspec)
+
+;;; hyperspec.el ends here
Added: branches/trunk-reorg/thirdparty/slime/metering.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/metering.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/metering.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1222 @@
+;;; -*- Mode: LISP; Package: monitor; Syntax: Common-lisp; Base: 10.; -*-
+;;; Tue Jan 25 18:32:28 1994 by Mark Kantrowitz <mkant(a)GLINDA.OZ.CS.CMU.EDU>
+
+;;; ****************************************************************
+;;; Metering System ************************************************
+;;; ****************************************************************
+;;;
+;;; The Metering System is a portable Common Lisp code profiling tool.
+;;; It gathers timing and consing statistics for specified functions
+;;; while a program is running.
+;;;
+;;; The Metering System is a combination of
+;;; o the Monitor package written by Chris McConnell
+;;; o the Profile package written by Skef Wholey and Rob MacLachlan
+;;; The two systems were merged and extended by Mark Kantrowitz.
+;;;
+;;; Address: Carnegie Mellon University
+;;; School of Computer Science
+;;; Pittsburgh, PA 15213
+;;;
+;;; This code is in the public domain and is distributed without warranty
+;;; of any kind.
+;;;
+;;; This copy is from SLIME, http://www.common-lisp.net/project/slime/
+;;;
+;;;
+
+;;; ********************************
+;;; Change Log *********************
+;;; ********************************
+;;;
+;;; 26-JUN-90 mk Merged functionality of Monitor and Profile packages.
+;;; 26-JUN-90 mk Now handles both inclusive and exclusive statistics
+;;; with respect to nested calls. (Allows it to subtract
+;;; total monitoring overhead for each function, not just
+;;; the time spent monitoring the function itself.)
+;;; 26-JUN-90 mk The table is now saved so that one may manipulate
+;;; the data (sorting it, etc.) even after the original
+;;; source of the data has been cleared.
+;;; 25-SEP-90 mk Added get-cons functions for Lucid 3.0, MACL 1.3.2
+;;; required-arguments functions for Lucid 3.0,
+;;; Franz Allegro CL, and MACL 1.3.2.
+;;; 25-JAN-91 mk Now uses fdefinition if available.
+;;; 25-JAN-91 mk Replaced (and :allegro (not :coral)) with :excl.
+;;; Much better solution for the fact that both call
+;;; themselves :allegro.
+;;; 5-JUL-91 mk Fixed warning to occur only when file is loaded
+;;; uncompiled.
+;;; 5-JUL-91 mk When many unmonitored functions, print out number
+;;; instead of whole list.
+;;; 24-MAR-92 mk Updated for CLtL2 compatibility. space measuring
+;;; doesn't work in MCL, but fixed so that timing
+;;; statistics do.
+;;; 26-MAR-92 mk Updated for Lispworks. Replaced :ccl with
+;;; (and :ccl (not :lispworks)).
+;;; 27-MAR-92 mk Added get-cons for Allegro-V4.0.
+;;; 01-JAN-93 mk v2.0 Support for MCL 2.0, CMU CL 16d, Allegro V3.1/4.0/4.1,
+;;; Lucid 4.0, ibcl
+;;; 25-JAN-94 mk v2.1 Patches for CLISP from Bruno Haible.
+;;; 01-APR-05 lgorrie Removed support for all Lisps except CLISP and OpenMCL.
+;;; Purely to cut down on stale code (e.g. #+cltl2) in this
+;;; version that is bundled with SLIME.
+;;;
+;;;
+
+;;; ********************************
+;;; To Do **************************
+;;; ********************************
+;;;
+;;; - Need get-cons for Allegro, AKCL.
+;;; - Speed up monitoring code. Replace use of hash tables with an embedded
+;;; offset in an array so that it will be faster than using gethash.
+;;; (i.e., svref/closure reference is usually faster than gethash).
+;;; - Beware of (get-internal-run-time) overflowing. Yikes!
+;;; - Check robustness with respect to profiled functions.
+;;; - Check logic of computing inclusive and exclusive time and consing.
+;;; Especially wrt incf/setf comment below. Should be incf, so we
+;;; sum recursive calls.
+;;; - Add option to record caller statistics -- this would list who
+;;; called which functions and how often.
+;;; - switches to turn timing/CONSING statistics collection on/off.
+
+
+;;; ********************************
+;;; Notes **************************
+;;; ********************************
+;;;
+;;; METERING has been tested (successfully) in the following lisps:
+;;; CMU Common Lisp (16d, Python Compiler 1.0 ) :new-compiler
+;;; CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
+;;; Macintosh Allegro Common Lisp (1.3.2)
+;;; Macintosh Common Lisp (2.0)
+;;; ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 11/19/90) :allegro-v3.1
+;;; ExCL (Franz Allegro CL 4.0.1 [Sun4] 2/8/91) :allegro-v4.0
+;;; ExCL (Franz Allegro CL 4.1 [SPARC R1] 8/28/92 14:06) :allegro-v4.1
+;;; ExCL (Franz ACL 5.0.1 [Linux/X86] 6/29/99 16:11) :allegro-v5.0.1
+;;; Lucid CL (Version 2.1 6-DEC-87)
+;;; Lucid Common Lisp (3.0)
+;;; Lucid Common Lisp (4.0.1 HP-700 12-Aug-91)
+;;; AKCL (1.86, June 30, 1987 or later)
+;;; Ibuki Common Lisp (Version 2, release 01.027)
+;;; CLISP (January 1994)
+;;;
+;;; METERING needs to be tested in the following lisps:
+;;; Symbolics Common Lisp (8.0)
+;;; KCL (June 3, 1987 or later)
+;;; TI (Release 4.1 or later)
+;;; Golden Common Lisp (3.1 IBM-PC)
+;;; VAXLisp (2.0, 3.1)
+;;; Procyon Common Lisp
+
+
+;;; ****************************************************************
+;;; Documentation **************************************************
+;;; ****************************************************************
+;;;
+;;; This system runs in any valid Common Lisp. Four small
+;;; implementation-dependent changes can be made to improve performance
+;;; and prettiness. In the section labelled "Implementation Dependent
+;;; Changes" below, you should tailor the functions REQUIRED-ARGUMENTS,
+;;; GET-CONS, GET-TIME, and TIME-UNITS-PER-SECOND to your implementation
+;;; for the best results. If GET-CONS is not specified for your
+;;; implementation, no consing information will be reported. The other
+;;; functions will default to working forms, albeit inefficient, in
+;;; non-CMU implementations. If you tailor these functions for a particular
+;;; version of Common Lisp, we'd appreciate receiving the code.
+;;;
+
+;;; ****************************************************************
+;;; Usage Notes ****************************************************
+;;; ****************************************************************
+;;;
+;;; SUGGESTED USAGE:
+;;;
+;;; Start by monitoring big pieces of the program, then carefully choose
+;;; which functions close to, but not in, the inner loop are to be
+;;; monitored next. Don't monitor functions that are called by other
+;;; monitored functions: you will only confuse yourself.
+;;;
+;;; If the per-call time reported is less than 1/10th of a second, then
+;;; consider the clock resolution and profiling overhead before you believe
+;;; the time. It may be that you will need to run your program many times
+;;; in order to average out to a higher resolution.
+;;;
+;;; The easiest way to use this package is to load it and execute either
+;;; (mon:with-monitoring (names*) ()
+;;; your-forms*)
+;;; or
+;;; (mon:monitor-form your-form)
+;;; The former allows you to specify which functions will be monitored; the
+;;; latter monitors all functions in the current package. Both automatically
+;;; produce a table of statistics. Other variants can be constructed from
+;;; the monitoring primitives, which are described below, along with a
+;;; fuller description of these two macros.
+;;;
+;;; For best results, compile this file before using.
+;;;
+;;;
+;;; CLOCK RESOLUTION:
+;;;
+;;; Unless you are very lucky, the length of your machine's clock "tick" is
+;;; probably much longer than the time it takes a simple function to run.
+;;; For example, on the IBM RT, the clock resolution is 1/50th of a second.
+;;; This means that if a function is only called a few times, then only the
+;;; first couple of decimal places are really meaningful.
+;;;
+;;;
+;;; MONITORING OVERHEAD:
+;;;
+;;; The added monitoring code takes time to run every time that the monitored
+;;; function is called, which can disrupt the attempt to collect timing
+;;; information. In order to avoid serious inflation of the times for functions
+;;; that take little time to run, an estimate of the overhead due to monitoring
+;;; is subtracted from the times reported for each function.
+;;;
+;;; Although this correction works fairly well, it is not totally accurate,
+;;; resulting in times that become increasingly meaningless for functions
+;;; with short runtimes. For example, subtracting the estimated overhead
+;;; may result in negative times for some functions. This is only a concern
+;;; when the estimated profiling overhead is many times larger than
+;;; reported total CPU time.
+;;;
+;;; If you monitor functions that are called by monitored functions, in
+;;; :inclusive mode the monitoring overhead for the inner function is
+;;; subtracted from the CPU time for the outer function. [We do this by
+;;; counting for each function not only the number of calls to *this*
+;;; function, but also the number of monitored calls while it was running.]
+;;; In :exclusive mode this is not necessary, since we subtract the
+;;; monitoring time of inner functions, overhead & all.
+;;;
+;;; Otherwise, the estimated monitoring overhead is not represented in the
+;;; reported total CPU time. The sum of total CPU time and the estimated
+;;; monitoring overhead should be close to the total CPU time for the
+;;; entire monitoring run (as determined by TIME).
+;;;
+;;; A timing overhead factor is computed at load time. This will be incorrect
+;;; if the monitoring code is run in a different environment than this file
+;;; was loaded in. For example, saving a core image on a high performance
+;;; machine and running it on a low performance one will result in the use
+;;; of an erroneously small overhead factor.
+;;;
+;;;
+;;; If your times vary widely, possible causes are:
+;;; - Garbage collection. Try turning it off, then running your code.
+;;; Be warned that monitoring code will probably cons when it does
+;;; (get-internal-run-time).
+;;; - Swapping. If you have enough memory, execute your form once
+;;; before monitoring so that it will be swapped into memory. Otherwise,
+;;; get a bigger machine!
+;;; - Resolution of internal-time-units-per-second. If this value is
+;;; too low, then the timings become wild. You can try executing more
+;;; of whatever your test is, but that will only work if some of your
+;;; paths do not match the timer resolution.
+;;; internal-time-units-per-second is so coarse -- on a Symbolics it is
+;;; 977, in MACL it is 60.
+;;;
+;;;
+
+;;; ****************************************************************
+;;; Interface ******************************************************
+;;; ****************************************************************
+;;;
+;;; WITH-MONITORING (&rest functions) [Macro]
+;;; (&optional (nested :exclusive)
+;;; (threshold 0.01)
+;;; (key :percent-time))
+;;; &body body
+;;; The named functions will be set up for monitoring, the body forms executed,
+;;; a table of results printed, and the functions unmonitored. The nested,
+;;; threshold, and key arguments are passed to report-monitoring below.
+;;;
+;;; MONITOR-FORM form [Macro]
+;;; &optional (nested :exclusive)
+;;; (threshold 0.01)
+;;; (key :percent-time)
+;;; All functions in the current package are set up for monitoring while
+;;; the form is executed, and automatically unmonitored after a table of
+;;; results has been printed. The nested, threshold, and key arguments
+;;; are passed to report-monitoring below.
+;;;
+;;; *MONITORED-FUNCTIONS* [Variable]
+;;; This holds a list of all functions that are currently being monitored.
+;;;
+;;; MONITOR &rest names [Macro]
+;;; The named functions will be set up for monitoring by augmenting
+;;; their function definitions with code that gathers statistical information
+;;; about code performance. As with the TRACE macro, the function names are
+;;; not evaluated. Calls the function MON::MONITORING-ENCAPSULATE on each
+;;; function name. If no names are specified, returns a list of all
+;;; monitored functions.
+;;;
+;;; If name is not a symbol, it is evaled to return the appropriate
+;;; closure. This allows you to monitor closures stored anywhere like
+;;; in a variable, array or structure. Most other monitoring packages
+;;; can't handle this.
+;;;
+;;; MONITOR-ALL &optional (package *package*) [Function]
+;;; Monitors all functions in the specified package, which defaults to
+;;; the current package.
+;;;
+;;; UNMONITOR &rest names [Macro]
+;;; Removes monitoring code from the named functions. If no names are
+;;; specified, all currently monitored functions are unmonitored.
+;;;
+;;; RESET-MONITORING-INFO name [Function]
+;;; Resets the monitoring statistics for the specified function.
+;;;
+;;; RESET-ALL-MONITORING [Function]
+;;; Resets the monitoring statistics for all monitored functions.
+;;;
+;;; MONITORED name [Function]
+;;; Predicate to test whether a function is monitored.
+;;;
+;;; REPORT-MONITORING &optional names [Function]
+;;; (nested :exclusive)
+;;; (threshold 0.01)
+;;; (key :percent-time)
+;;; Creates a table of monitoring information for the specified list
+;;; of names, and displays the table using display-monitoring-results.
+;;; If names is :all or nil, uses all currently monitored functions.
+;;; Takes the following arguments:
+;;; - NESTED specifies whether nested calls of monitored functions
+;;; are included in the times for monitored functions.
+;;; o If :inclusive, the per-function information is for the entire
+;;; duration of the monitored function, including any calls to
+;;; other monitored functions. If functions A and B are monitored,
+;;; and A calls B, then the accumulated time and consing for A will
+;;; include the time and consing of B. Note: if a function calls
+;;; itself recursively, the time spent in the inner call(s) may
+;;; be counted several times.
+;;; o If :exclusive, the information excludes time attributed to
+;;; calls to other monitored functions. This is the default.
+;;; - THRESHOLD specifies that only functions which have been executed
+;;; more than threshold percent of the time will be reported. Defaults
+;;; to 1%. If a threshold of 0 is specified, all functions are listed,
+;;; even those with 0 or negative running times (see note on overhead).
+;;; - KEY specifies that the table be sorted by one of the following
+;;; sort keys:
+;;; :function alphabetically by function name
+;;; :percent-time by percent of total execution time
+;;; :percent-cons by percent of total consing
+;;; :calls by number of times the function was called
+;;; :time-per-call by average execution time per function
+;;; :cons-per-call by average consing per function
+;;; :time same as :percent-time
+;;; :cons same as :percent-cons
+;;;
+;;; REPORT &key (names :all) [Function]
+;;; (nested :exclusive)
+;;; (threshold 0.01)
+;;; (sort-key :percent-time)
+;;; (ignore-no-calls nil)
+;;;
+;;; Same as REPORT-MONITORING but we use a nicer keyword interface.
+;;;
+;;; DISPLAY-MONITORING-RESULTS &optional (threshold 0.01) [Function]
+;;; (key :percent-time)
+;;; Prints a table showing for each named function:
+;;; - the total CPU time used in that function for all calls
+;;; - the total number of bytes consed in that function for all calls
+;;; - the total number of calls
+;;; - the average amount of CPU time per call
+;;; - the average amount of consing per call
+;;; - the percent of total execution time spent executing that function
+;;; - the percent of total consing spent consing in that function
+;;; Summary totals of the CPU time, consing, and calls columns are printed.
+;;; An estimate of the monitoring overhead is also printed. May be run
+;;; even after unmonitoring all the functions, to play with the data.
+;;;
+;;; SAMPLE TABLE:
+#|
+ Cons
+ % % Per Total Total
+Function Time Cons Calls Sec/Call Call Time Cons
+----------------------------------------------------------------------
+FIND-ROLE: 0.58 0.00 136 0.003521 0 0.478863 0
+GROUP-ROLE: 0.35 0.00 365 0.000802 0 0.292760 0
+GROUP-PROJECTOR: 0.05 0.00 102 0.000408 0 0.041648 0
+FEATURE-P: 0.02 0.00 570 0.000028 0 0.015680 0
+----------------------------------------------------------------------
+TOTAL: 1173 0.828950 0
+Estimated total monitoring overhead: 0.88 seconds
+|#
+
+;;; ****************************************************************
+;;; METERING *******************************************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Warn people using the wrong Lisp
+;;; ********************************
+
+#-(or clisp openmcl)
+(warn "metering.lisp does not support your Lisp implementation!")
+
+;;; ********************************
+;;; Packages ***********************
+;;; ********************************
+
+;;; For CLtL2 compatible lisps
+
+(defpackage "MONITOR" (:nicknames "MON") (:use "COMMON-LISP")
+ (:export "*MONITORED-FUNCTIONS*"
+ "MONITOR" "MONITOR-ALL" "UNMONITOR" "MONITOR-FORM"
+ "WITH-MONITORING"
+ "RESET-MONITORING-INFO" "RESET-ALL-MONITORING"
+ "MONITORED"
+ "REPORT-MONITORING"
+ "DISPLAY-MONITORING-RESULTS"
+ "MONITORING-ENCAPSULATE" "MONITORING-UNENCAPSULATE"
+ "REPORT"))
+(in-package "MONITOR")
+
+;;; Warn user if they're loading the source instead of compiling it first.
+(eval-when (eval)
+ (warn "This file should be compiled before loading for best results."))
+
+;;; ********************************
+;;; Version ************************
+;;; ********************************
+
+(defparameter *metering-version* "v2.1 25-JAN-94"
+ "Current version number/date for Metering.")
+
+
+;;; ****************************************************************
+;;; Implementation Dependent Definitions ***************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Timing Functions ***************
+;;; ********************************
+;;; The get-time function is called to find the total number of ticks since
+;;; the beginning of time. time-units-per-second allows us to convert units
+;;; to seconds.
+
+#-(or clisp openmcl)
+(eval-when (compile eval)
+ (warn
+ "You may want to supply implementation-specific get-time functions."))
+
+(defconstant time-units-per-second internal-time-units-per-second)
+
+(defmacro get-time ()
+ `(the time-type (get-internal-run-time)))
+
+;;; NOTE: In Macintosh Common Lisp, CCL::GCTIME returns the number of
+;;; milliseconds spent during GC. We could subtract this from
+;;; the value returned by get-internal-run-time to eliminate
+;;; the effect of GC on the timing values, but we prefer to let
+;;; the user run without GC on. If the application is so big that
+;;; it requires GC to complete, then the GC times are part of the
+;;; cost of doing business, and will average out in the long run.
+;;; If it seems really important to a user that GC times not be
+;;; counted, then uncomment the following three lines and read-time
+;;; conditionalize the definition of get-time above with #-:openmcl.
+;#+openmcl
+;(defmacro get-time ()
+; `(the time-type (- (get-internal-run-time) (ccl:gctime))))
+
+;;; ********************************
+;;; Consing Functions **************
+;;; ********************************
+;;; The get-cons macro is called to find the total number of bytes
+;;; consed since the beginning of time.
+
+#+clisp
+(defun get-cons ()
+ (multiple-value-bind (real1 real2 run1 run2 gc1 gc2 space1 space2 gccount)
+ (sys::%%time)
+ (declare (ignore real1 real2 run1 run2 gc1 gc2 gccount))
+ (dpb space1 (byte 24 24) space2)))
+
+;;; Macintosh Common Lisp 2.0
+;;; Note that this includes bytes that were allocated during GC.
+;;; We could subtract this out by advising GC like we did under
+;;; MCL 1.3.2, but I'd rather users ran without GC. If they can't
+;;; run without GC, then the bytes consed during GC are a cost of
+;;; running their program. Metering the code a few times will
+;;; avoid the consing values being too lopsided. If a user really really
+;;; wants to subtract out the consing during GC, replace the following
+;;; two lines with the commented out code.
+#+openmcl
+(defmacro get-cons () `(the consing-type (ccl::total-bytes-allocated)))
+;; #+openmcl
+;; (progn
+;; (in-package :ccl)
+;; (defvar *bytes-consed-chkpt* 0)
+;; (defun reset-consing () (setq *bytes-consed-chkpt* 0))
+;; (let ((old-gc (symbol-function 'gc))
+;; (ccl:*warn-if-redefine-kernel* nil))
+;; (setf (symbol-function 'gc)
+;; #'(lambda ()
+;; (let ((old-consing (total-bytes-consed)))
+;; (prog1
+;; (funcall old-gc)
+;; (incf *bytes-consed-chkpt*
+;; (- old-consing (total-bytes-consed))))))))
+;; (defun total-bytes-consed ()
+;; "Returns number of conses (8 bytes each)"
+;; (ccl::total-bytes-allocated))
+;; (in-package "MONITOR")
+;; (defun get-cons ()
+;; (the consing-type (+ (ccl::total-bytes-consed) ccl::*bytes-consed-chkpt*))))
+
+
+#-(or clisp openmcl)
+(progn
+ (eval-when (compile eval)
+ (warn "No consing will be reported unless a get-cons function is ~
+ defined."))
+
+ (defmacro get-cons () '(the consing-type 0)))
+
+;; actually, neither `get-cons' nor `get-time' are used as is,
+;; but only in the following macro `with-time/cons'
+#-:clisp
+(defmacro with-time/cons ((delta-time delta-cons) form &body post-process)
+ (let ((start-cons (gensym "START-CONS-"))
+ (start-time (gensym "START-TIME-")))
+ `(let ((,start-time (get-time)) (,start-cons (get-cons)))
+ (declare (type time-type ,start-time)
+ (type consing-type ,start-cons))
+ (multiple-value-prog1 ,form
+ (let ((,delta-time (- (get-time) ,start-time))
+ (,delta-cons (- (get-cons) ,start-cons)))
+ ,@post-process)))))
+
+#+clisp
+(progn
+ (defmacro delta4 (nv1 nv2 ov1 ov2 by)
+ `(- (dpb (- ,nv1 ,ov1) (byte ,by ,by) ,nv2) ,ov2))
+
+ (let ((del (find-symbol "DELTA4" "SYS")))
+ (when del (setf (fdefinition 'delta4) (fdefinition del))))
+
+ (if (< internal-time-units-per-second 1000000)
+ ;; TIME_1: AMIGA, OS/2, UNIX_TIMES
+ (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2)
+ `(delta4 ,new-time1 ,new-time2 ,old-time1 ,old-time2 16))
+ ;; TIME_2: other UNIX, WIN32
+ (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2)
+ `(+ (* (- ,new-time1 ,old-time1) internal-time-units-per-second)
+ (- ,new-time2 ,old-time2))))
+
+ (defmacro delta4-cons (new-cons1 new-cons2 old-cons1 old-cons2)
+ `(delta4 ,new-cons1 ,new-cons2 ,old-cons1 ,old-cons2 24))
+
+ ;; avoid consing: when the application conses a lot,
+ ;; get-cons may return a bignum, so we really should not use it.
+ (defmacro with-time/cons ((delta-time delta-cons) form &body post-process)
+ (let ((beg-cons1 (gensym "BEG-CONS1-")) (end-cons1 (gensym "END-CONS1-"))
+ (beg-cons2 (gensym "BEG-CONS2-")) (end-cons2 (gensym "END-CONS2-"))
+ (beg-time1 (gensym "BEG-TIME1-")) (end-time1 (gensym "END-TIME1-"))
+ (beg-time2 (gensym "BEG-TIME2-")) (end-time2 (gensym "END-TIME2-"))
+ (re1 (gensym)) (re2 (gensym)) (gc1 (gensym)) (gc2 (gensym)))
+ `(multiple-value-bind (,re1 ,re2 ,beg-time1 ,beg-time2
+ ,gc1 ,gc2 ,beg-cons1 ,beg-cons2) (sys::%%time)
+ (declare (ignore ,re1 ,re2 ,gc1 ,gc2))
+ (multiple-value-prog1 ,form
+ (multiple-value-bind (,re1 ,re2 ,end-time1 ,end-time2
+ ,gc1 ,gc2 ,end-cons1 ,end-cons2) (sys::%%time)
+ (declare (ignore ,re1 ,re2 ,gc1 ,gc2))
+ (let ((,delta-time (delta4-time ,end-time1 ,end-time2
+ ,beg-time1 ,beg-time2))
+ (,delta-cons (delta4-cons ,end-cons1 ,end-cons2
+ ,beg-cons1 ,beg-cons2)))
+ ,@post-process)))))))
+
+;;; ********************************
+;;; Required Arguments *************
+;;; ********************************
+;;;
+;;; Required (Fixed) vs Optional Args
+;;;
+;;; To avoid unnecessary consing in the "encapsulation" code, we find out the
+;;; number of required arguments, and use &rest to capture only non-required
+;;; arguments. The function Required-Arguments returns two values: the first
+;;; is the number of required arguments, and the second is T iff there are any
+;;; non-required arguments (e.g. &optional, &rest, &key).
+
+;;; Lucid, Allegro, and Macintosh Common Lisp
+#+openmcl
+(defun required-arguments (name)
+ (let* ((function (symbol-function name))
+ (args (ccl:arglist function))
+ (pos (position-if #'(lambda (x)
+ (and (symbolp x)
+ (let ((name (symbol-name x)))
+ (and (>= (length name) 1)
+ (char= (schar name 0)
+ #\&)))))
+ args)))
+ (if pos
+ (values pos t)
+ (values (length args) nil))))
+
+#+clisp
+(defun required-arguments (name)
+ (multiple-value-bind (name req-num opt-num rest-p key-p keywords allow-p)
+ (sys::function-signature name t)
+ (if name ; no error
+ (values req-num (or (/= 0 opt-num) rest-p key-p keywords allow-p))
+ (values 0 t))))
+
+#-(or clisp openmcl)
+(progn
+ (eval-when (compile eval)
+ (warn
+ "You may want to add an implementation-specific Required-Arguments function."))
+ (eval-when (load eval)
+ (defun required-arguments (name)
+ (declare (ignore name))
+ (values 0 t))))
+
+#|
+;;;Examples
+(defun square (x) (* x x))
+(defun square2 (x &optional y) (* x x y))
+(defun test (x y &optional (z 3)) 3)
+(defun test2 (x y &optional (z 3) &rest fred) 3)
+
+(required-arguments 'square) => 1 nil
+(required-arguments 'square2) => 1 t
+(required-arguments 'test) => 2 t
+(required-arguments 'test2) => 2 t
+|#
+
+
+;;; ****************************************************************
+;;; Main METERING Code *********************************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Global Variables ***************
+;;; ********************************
+(defvar *MONITOR-TIME-OVERHEAD* nil
+ "The amount of time an empty monitored function costs.")
+(defvar *MONITOR-CONS-OVERHEAD* nil
+ "The amount of cons an empty monitored function costs.")
+
+(defvar *TOTAL-TIME* 0
+ "Total amount of time monitored so far.")
+(defvar *TOTAL-CONS* 0
+ "Total amount of consing monitored so far.")
+(defvar *TOTAL-CALLS* 0
+ "Total number of calls monitored so far.")
+(proclaim '(type time-type *total-time*))
+(proclaim '(type consing-type *total-cons*))
+(proclaim '(fixnum *total-calls*))
+
+;;; ********************************
+;;; Accessor Functions *************
+;;; ********************************
+;;; Perhaps the SYMBOLP should be FBOUNDP? I.e., what about variables
+;;; containing closures.
+(defmacro PLACE-FUNCTION (function-place)
+ "Return the function found at FUNCTION-PLACE. Evals FUNCTION-PLACE
+if it isn't a symbol, to allow monitoring of closures located in
+variables/arrays/structures."
+ ;; Note that (fboundp 'fdefinition) returns T even if fdefinition
+ ;; is a macro, which is what we want.
+ (if (fboundp 'fdefinition)
+ `(if (fboundp ,function-place)
+ (fdefinition ,function-place)
+ (eval ,function-place))
+ `(if (symbolp ,function-place)
+ (symbol-function ,function-place)
+ (eval ,function-place))))
+
+(defsetf PLACE-FUNCTION (function-place) (function)
+ "Set the function in FUNCTION-PLACE to FUNCTION."
+ (if (fboundp 'fdefinition)
+ ;; If we're conforming to CLtL2, use fdefinition here.
+ `(if (fboundp ,function-place)
+ (setf (fdefinition ,function-place) ,function)
+ (eval '(setf ,function-place ',function)))
+ `(if (symbolp ,function-place)
+ (setf (symbol-function ,function-place) ,function)
+ (eval '(setf ,function-place ',function)))))
+
+#|
+;;; before using fdefinition
+(defun PLACE-FUNCTION (function-place)
+ "Return the function found at FUNCTION-PLACE. Evals FUNCTION-PLACE
+if it isn't a symbol, to allow monitoring of closures located in
+variables/arrays/structures."
+ (if (symbolp function-place)
+ (symbol-function function-place)
+ (eval function-place)))
+
+(defsetf PLACE-FUNCTION (function-place) (function)
+ "Set the function in FUNCTION-PLACE to FUNCTION."
+ `(if (symbolp ,function-place)
+ (setf (symbol-function ,function-place) ,function)
+ (eval '(setf ,function-place ',function))))
+|#
+
+(defun PLACE-FBOUNDP (function-place)
+ "Test to see if FUNCTION-PLACE is a function."
+ ;; probably should be
+ #|(or (and (symbolp function-place)(fboundp function-place))
+ (functionp (place-function function-place)))|#
+ (if (symbolp function-place)
+ (fboundp function-place)
+ (functionp (place-function function-place))))
+
+(defun PLACE-MACROP (function-place)
+ "Test to see if FUNCTION-PLACE is a macro."
+ (when (symbolp function-place)
+ (macro-function function-place)))
+
+;;; ********************************
+;;; Measurement Tables *************
+;;; ********************************
+(defvar *monitored-functions* nil
+ "List of monitored symbols.")
+
+;;; We associate a METERING-FUNCTIONS structure with each monitored function
+;;; name or other closure. This holds the functions that we call to manipulate
+;;; the closure which implements the encapsulation.
+;;;
+(defstruct metering-functions
+ (name nil)
+ (old-definition nil :type function)
+ (new-definition nil :type function)
+ (read-metering nil :type function)
+ (reset-metering nil :type function))
+
+;;; In general using hash tables in time-critical programs is a bad idea,
+;;; because when one has to grow the table and rehash everything, the
+;;; timing becomes grossly inaccurate. In this case it is not an issue
+;;; because all inserting of entries in the hash table occurs before the
+;;; timing commences. The only circumstance in which this could be a
+;;; problem is if the lisp rehashes on the next reference to the table,
+;;; instead of when the entry which forces a rehash was inserted.
+;;;
+;;; Note that a similar kind of problem can occur with GC, which is why
+;;; one should turn off GC when monitoring code.
+;;;
+(defvar *monitor* (make-hash-table :test #'equal)
+ "Hash table in which METERING-FUNCTIONS structures are stored.")
+(defun get-monitor-info (name)
+ (gethash name *monitor*))
+(defsetf get-monitor-info (name) (info)
+ `(setf (gethash ,name *monitor*) ,info))
+
+(defun MONITORED (function-place)
+ "Test to see if a FUNCTION-PLACE is monitored."
+ (and (place-fboundp function-place) ; this line necessary?
+ (get-monitor-info function-place)))
+
+(defun reset-monitoring-info (name)
+ "Reset the monitoring info for the specified function."
+ (let ((finfo (get-monitor-info name)))
+ (when finfo
+ (funcall (metering-functions-reset-metering finfo)))))
+(defun reset-all-monitoring ()
+ "Reset monitoring info for all functions."
+ (setq *total-time* 0
+ *total-cons* 0
+ *total-calls* 0)
+ (dolist (symbol *monitored-functions*)
+ (when (monitored symbol)
+ (reset-monitoring-info symbol))))
+
+(defun monitor-info-values (name &optional (nested :exclusive) warn)
+ "Returns monitoring information values for the named function,
+adjusted for overhead."
+ (let ((finfo (get-monitor-info name)))
+ (if finfo
+ (multiple-value-bind (inclusive-time inclusive-cons
+ exclusive-time exclusive-cons
+ calls nested-calls)
+ (funcall (metering-functions-read-metering finfo))
+ (unless (or (null warn)
+ (eq (place-function name)
+ (metering-functions-new-definition finfo)))
+ (warn "Funtion ~S has been redefined, so times may be inaccurate.~@
+ MONITOR it again to record calls to the new definition."
+ name))
+ (case nested
+ (:exclusive (values calls
+ nested-calls
+ (- exclusive-time
+ (* calls *monitor-time-overhead*))
+ (- exclusive-cons
+ (* calls *monitor-cons-overhead*))))
+ ;; In :inclusive mode, subtract overhead for all the
+ ;; called functions as well. Nested-calls includes the
+ ;; calls of the function as well. [Necessary 'cause of
+ ;; functions which call themselves recursively.]
+ (:inclusive (values calls
+ nested-calls
+ (- inclusive-time
+ (* nested-calls ;(+ calls)
+ *monitor-time-overhead*))
+ (- inclusive-cons
+ (* nested-calls ;(+ calls)
+ *monitor-cons-overhead*))))))
+ (values 0 0 0 0))))
+
+;;; ********************************
+;;; Encapsulate ********************
+;;; ********************************
+(eval-when (compile load eval)
+;; Returns a lambda expression for a function that, when called with the
+;; function name, will set up that function for metering.
+;;
+;; A function is monitored by replacing its definition with a closure
+;; created by the following function. The closure records the monitoring
+;; data, and updates the data with each call of the function.
+;;
+;; Other closures are used to read and reset the data.
+(defun make-monitoring-encapsulation (min-args optionals-p)
+ (let (required-args)
+ (dotimes (i min-args) (push (gensym) required-args))
+ `(lambda (name)
+ (let ((inclusive-time 0)
+ (inclusive-cons 0)
+ (exclusive-time 0)
+ (exclusive-cons 0)
+ (calls 0)
+ (nested-calls 0)
+ (old-definition (place-function name)))
+ (declare (type time-type inclusive-time)
+ (type time-type exclusive-time)
+ (type consing-type inclusive-cons)
+ (type consing-type exclusive-cons)
+ (fixnum calls)
+ (fixnum nested-calls))
+ (pushnew name *monitored-functions*)
+
+ (setf (place-function name)
+ #'(lambda (,@required-args
+ ,@(when optionals-p
+ `(&rest optional-args)))
+ (let ((prev-total-time *total-time*)
+ (prev-total-cons *total-cons*)
+ (prev-total-calls *total-calls*)
+ ;; (old-time inclusive-time)
+ ;; (old-cons inclusive-cons)
+ ;; (old-nested-calls nested-calls)
+ )
+ (declare (type time-type prev-total-time)
+ (type consing-type prev-total-cons)
+ (fixnum prev-total-calls))
+ (with-time/cons (delta-time delta-cons)
+ ;; form
+ ,(if optionals-p
+ `(apply old-definition
+ ,@required-args optional-args)
+ `(funcall old-definition ,@required-args))
+ ;; post-processing:
+ ;; Calls
+ (incf calls)
+ (incf *total-calls*)
+ ;; nested-calls includes this call
+ (incf nested-calls (the fixnum
+ (- *total-calls*
+ prev-total-calls)))
+ ;; (setf nested-calls (+ old-nested-calls
+ ;; (- *total-calls*
+ ;; prev-total-calls)))
+ ;; Time
+ ;; Problem with inclusive time is that it
+ ;; currently doesn't add values from recursive
+ ;; calls to the same function. Change the
+ ;; setf to an incf to fix this?
+ (incf inclusive-time (the time-type delta-time))
+ ;; (setf inclusive-time (+ delta-time old-time))
+ (incf exclusive-time (the time-type
+ (+ delta-time
+ (- prev-total-time
+ *total-time*))))
+ (setf *total-time* (the time-type
+ (+ delta-time
+ prev-total-time)))
+ ;; Consing
+ (incf inclusive-cons (the consing-type delta-cons))
+ ;; (setf inclusive-cons (+ delta-cons old-cons))
+ (incf exclusive-cons (the consing-type
+ (+ delta-cons
+ (- prev-total-cons
+ *total-cons*))))
+ (setf *total-cons*
+ (the consing-type
+ (+ delta-cons prev-total-cons)))))))
+ (setf (get-monitor-info name)
+ (make-metering-functions
+ :name name
+ :old-definition old-definition
+ :new-definition (place-function name)
+ :read-metering #'(lambda ()
+ (values inclusive-time
+ inclusive-cons
+ exclusive-time
+ exclusive-cons
+ calls
+ nested-calls))
+ :reset-metering #'(lambda ()
+ (setq inclusive-time 0
+ inclusive-cons 0
+ exclusive-time 0
+ exclusive-cons 0
+ calls 0
+ nested-calls 0)
+ t)))))))
+);; End of EVAL-WHEN
+
+;;; For efficiency reasons, we precompute the encapsulation functions
+;;; for a variety of combinations of argument structures
+;;; (min-args . optional-p). These are stored in the following hash table
+;;; along with any new ones we encounter. Since we're now precomputing
+;;; closure functions for common argument signatures, this eliminates
+;;; the former need to call COMPILE for each monitored function.
+(eval-when (compile eval)
+ (defconstant precomputed-encapsulations 8))
+
+(defvar *existing-encapsulations* (make-hash-table :test #'equal))
+(defun find-encapsulation (min-args optionals-p)
+ (or (gethash (cons min-args optionals-p) *existing-encapsulations*)
+ (setf (gethash (cons min-args optionals-p) *existing-encapsulations*)
+ (compile nil
+ (make-monitoring-encapsulation min-args optionals-p)))))
+
+(macrolet ((frob ()
+ (let ((res ()))
+ (dotimes (i precomputed-encapsulations)
+ (push `(setf (gethash '(,i . nil) *existing-encapsulations*)
+ #',(make-monitoring-encapsulation i nil))
+ res)
+ (push `(setf (gethash '(,i . t) *existing-encapsulations*)
+ #',(make-monitoring-encapsulation i t))
+ res))
+ `(progn ,@res))))
+ (frob))
+
+(defun monitoring-encapsulate (name &optional warn)
+ "Monitor the function Name. If already monitored, unmonitor first."
+ ;; Saves the current definition of name and inserts a new function which
+ ;; returns the result of evaluating body.
+ (cond ((not (place-fboundp name)) ; not a function
+ (when warn
+ (warn "Ignoring undefined function ~S." name)))
+ ((place-macrop name) ; a macro
+ (when warn
+ (warn "Ignoring macro ~S." name)))
+ (t ; tis a function
+ (when (get-monitor-info name) ; monitored
+ (when warn
+ (warn "~S already monitored, so unmonitoring it first." name))
+ (monitoring-unencapsulate name))
+ (multiple-value-bind (min-args optionals-p)
+ (required-arguments name)
+ (funcall (find-encapsulation min-args optionals-p) name)))))
+
+(defun monitoring-unencapsulate (name &optional warn)
+ "Removes monitoring encapsulation code from around Name."
+ (let ((finfo (get-monitor-info name)))
+ (when finfo ; monitored
+ (remprop name 'metering-functions)
+ (setq *monitored-functions*
+ (remove name *monitored-functions* :test #'equal))
+ (if (eq (place-function name)
+ (metering-functions-new-definition finfo))
+ (setf (place-function name)
+ (metering-functions-old-definition finfo))
+ (when warn
+ (warn "Preserving current definition of redefined function ~S."
+ name))))))
+
+;;; ********************************
+;;; Main Monitoring Functions ******
+;;; ********************************
+(defmacro MONITOR (&rest names)
+ "Monitor the named functions. As in TRACE, the names are not evaluated.
+ If a function is already monitored, then unmonitor and remonitor (useful
+ to notice function redefinition). If a name is undefined, give a warning
+ and ignore it. See also unmonitor, report-monitoring,
+ display-monitoring-results and reset-time."
+ `(progn
+ ,@(mapcar #'(lambda (name) `(monitoring-encapsulate ',name)) names)
+ *monitored-functions*))
+
+(defmacro UNMONITOR (&rest names)
+ "Remove the monitoring on the named functions.
+ Names defaults to the list of all currently monitored functions."
+ `(dolist (name ,(if names `',names '*monitored-functions*) (values))
+ (monitoring-unencapsulate name)))
+
+(defun MONITOR-ALL (&optional (package *package*))
+ "Monitor all functions in the specified package."
+ (let ((package (if (packagep package)
+ package
+ (find-package package))))
+ (do-symbols (symbol package)
+ (when (eq (symbol-package symbol) package)
+ (monitoring-encapsulate symbol)))))
+
+(defmacro MONITOR-FORM (form
+ &optional (nested :exclusive) (threshold 0.01)
+ (key :percent-time))
+ "Monitor the execution of all functions in the current package
+during the execution of FORM. All functions that are executed above
+THRESHOLD % will be reported."
+ `(unwind-protect
+ (progn
+ (monitor-all)
+ (reset-all-monitoring)
+ (prog1
+ (time ,form)
+ (report-monitoring :all ,nested ,threshold ,key :ignore-no-calls)))
+ (unmonitor)))
+
+(defmacro WITH-MONITORING ((&rest functions)
+ (&optional (nested :exclusive)
+ (threshold 0.01)
+ (key :percent-time))
+ &body body)
+ "Monitor the specified functions during the execution of the body."
+ `(unwind-protect
+ (progn
+ (dolist (fun ',functions)
+ (monitoring-encapsulate fun))
+ (reset-all-monitoring)
+ ,@body
+ (report-monitoring :all ,nested ,threshold ,key))
+ (unmonitor)))
+
+;;; ********************************
+;;; Overhead Calculations **********
+;;; ********************************
+(defconstant overhead-iterations 5000
+ "Number of iterations over which the timing overhead is averaged.")
+
+;;; Perhaps this should return something to frustrate clever compilers.
+(defun STUB-FUNCTION (x)
+ (declare (ignore x))
+ nil)
+(proclaim '(notinline stub-function))
+
+(defun SET-MONITOR-OVERHEAD ()
+ "Determines the average overhead of monitoring by monitoring the execution
+of an empty function many times."
+ (setq *monitor-time-overhead* 0
+ *monitor-cons-overhead* 0)
+ (stub-function nil)
+ (monitor stub-function)
+ (reset-all-monitoring)
+ (let ((overhead-function (symbol-function 'stub-function)))
+ (dotimes (x overhead-iterations)
+ (funcall overhead-function overhead-function)))
+; (dotimes (x overhead-iterations)
+; (stub-function nil))
+ (let ((fiter (float overhead-iterations)))
+ (multiple-value-bind (calls nested-calls time cons)
+ (monitor-info-values 'stub-function)
+ (declare (ignore calls nested-calls))
+ (setq *monitor-time-overhead* (/ time fiter)
+ *monitor-cons-overhead* (/ cons fiter))))
+ (unmonitor stub-function))
+(set-monitor-overhead)
+
+;;; ********************************
+;;; Report Data ********************
+;;; ********************************
+(defvar *monitor-results* nil
+ "A table of monitoring statistics is stored here.")
+(defvar *no-calls* nil
+ "A list of monitored functions which weren't called.")
+(defvar *estimated-total-overhead* 0)
+;; (proclaim '(type time-type *estimated-total-overhead*))
+
+(defstruct (monitoring-info
+ (:conc-name m-info-)
+ (:constructor make-monitoring-info
+ (name calls time cons
+ percent-time percent-cons
+ time-per-call cons-per-call)))
+ name
+ calls
+ time
+ cons
+ percent-time
+ percent-cons
+ time-per-call
+ cons-per-call)
+
+(defun REPORT (&key (names :all)
+ (nested :exclusive)
+ (threshold 0.01)
+ (sort-key :percent-time)
+ (ignore-no-calls nil))
+ "Same as REPORT-MONITORING but with a nicer keyword interface"
+ (declare (type (member :function :percent-time :time :percent-cons
+ :cons :calls :time-per-call :cons-per-call)
+ sort-key)
+ (type (member :inclusive :exclusive) nested))
+ (report-monitoring names nested threshold sort-key ignore-no-calls))
+
+(defun REPORT-MONITORING (&optional names
+ (nested :exclusive)
+ (threshold 0.01)
+ (key :percent-time)
+ ignore-no-calls)
+ "Report the current monitoring state.
+The percentage of the total time spent executing unmonitored code
+in each function (:exclusive mode), or total time (:inclusive mode)
+will be printed together with the number of calls and
+the unmonitored time per call. Functions that have been executed
+below THRESHOLD % of the time will not be reported. To report on all
+functions set NAMES to be either NIL or :ALL."
+ (when (or (null names) (eq names :all)) (setq names *monitored-functions*))
+
+ (let ((total-time 0)
+ (total-cons 0)
+ (total-calls 0))
+ ;; Compute overall time and consing.
+ (dolist (name names)
+ (multiple-value-bind (calls nested-calls time cons)
+ (monitor-info-values name nested :warn)
+ (declare (ignore nested-calls))
+ (incf total-calls calls)
+ (incf total-time time)
+ (incf total-cons cons)))
+ ;; Total overhead.
+ (setq *estimated-total-overhead*
+ (/ (* *monitor-time-overhead* total-calls)
+ time-units-per-second))
+ ;; Assemble data for only the specified names (all monitored functions)
+ (if (zerop total-time)
+ (format *trace-output* "Not enough execution time to monitor.")
+ (progn
+ (setq *monitor-results* nil *no-calls* nil)
+ (dolist (name names)
+ (multiple-value-bind (calls nested-calls time cons)
+ (monitor-info-values name nested)
+ (declare (ignore nested-calls))
+ (when (minusp time) (setq time 0.0))
+ (when (minusp cons) (setq cons 0.0))
+ (if (zerop calls)
+ (push (if (symbolp name)
+ (symbol-name name)
+ (format nil "~S" name))
+ *no-calls*)
+ (push (make-monitoring-info
+ (format nil "~S" name) ; name
+ calls ; calls
+ (/ time (float time-units-per-second)) ; time in secs
+ (round cons) ; consing
+ (/ time (float total-time)) ; percent-time
+ (if (zerop total-cons) 0
+ (/ cons (float total-cons))) ; percent-cons
+ (/ (/ time (float calls)) ; time-per-call
+ time-units-per-second) ; sec/call
+ (round (/ cons (float calls)))) ; cons-per-call
+ *monitor-results*))))
+ (display-monitoring-results threshold key ignore-no-calls)))))
+
+(defun display-monitoring-results (&optional (threshold 0.01) (key :percent-time)
+ (ignore-no-calls t))
+ (let ((max-length 8) ; Function header size
+ (max-cons-length 8)
+ (total-time 0.0)
+ (total-consed 0)
+ (total-calls 0)
+ (total-percent-time 0)
+ (total-percent-cons 0))
+ (sort-results key)
+ (dolist (result *monitor-results*)
+ (when (or (zerop threshold)
+ (> (m-info-percent-time result) threshold))
+ (setq max-length
+ (max max-length
+ (length (m-info-name result))))
+ (setq max-cons-length
+ (max max-cons-length
+ (m-info-cons-per-call result)))))
+ (incf max-length 2)
+ (setf max-cons-length (+ 2 (ceiling (log max-cons-length 10))))
+ (format *trace-output*
+ "~%~%~
+ ~VT ~VA~
+ ~% ~VT % % ~VA Total Total~
+ ~%Function~VT Time Cons Calls Sec/Call ~VA Time Cons~
+ ~%~V,,,'-A"
+ max-length
+ max-cons-length "Cons"
+ max-length
+ max-cons-length "Per"
+ max-length
+ max-cons-length "Call"
+ (+ max-length 62 (max 0 (- max-cons-length 5))) "-")
+ (dolist (result *monitor-results*)
+ (when (or (zerop threshold)
+ (> (m-info-percent-time result) threshold))
+ (format *trace-output*
+ "~%~A:~VT~6,2F ~6,2F ~7D ~,6F ~VD ~8,3F ~10D"
+ (m-info-name result)
+ max-length
+ (* 100 (m-info-percent-time result))
+ (* 100 (m-info-percent-cons result))
+ (m-info-calls result)
+ (m-info-time-per-call result)
+ max-cons-length
+ (m-info-cons-per-call result)
+ (m-info-time result)
+ (m-info-cons result))
+ (incf total-time (m-info-time result))
+ (incf total-consed (m-info-cons result))
+ (incf total-calls (m-info-calls result))
+ (incf total-percent-time (m-info-percent-time result))
+ (incf total-percent-cons (m-info-percent-cons result))))
+ (format *trace-output*
+ "~%~V,,,'-A~
+ ~%TOTAL:~VT~6,2F ~6,2F ~7D ~9@T ~VA ~8,3F ~10D~
+ ~%Estimated monitoring overhead: ~5,2F seconds~
+ ~%Estimated total monitoring overhead: ~5,2F seconds"
+ (+ max-length 62 (max 0 (- max-cons-length 5))) "-"
+ max-length
+ (* 100 total-percent-time)
+ (* 100 total-percent-cons)
+ total-calls
+ max-cons-length " "
+ total-time total-consed
+ (/ (* *monitor-time-overhead* total-calls)
+ time-units-per-second)
+ *estimated-total-overhead*)
+ (when (and (not ignore-no-calls) *no-calls*)
+ (setq *no-calls* (sort *no-calls* #'string<))
+ (let ((num-no-calls (length *no-calls*)))
+ (if (> num-no-calls 20)
+ (format *trace-output*
+ "~%~@(~r~) monitored functions were not called. ~
+ ~%See the variable mon::*no-calls* for a list."
+ num-no-calls)
+ (format *trace-output*
+ "~%The following monitored functions were not called:~
+ ~%~{~<~%~:; ~A~>~}~%"
+ *no-calls*))))
+ (values)))
+
+(defun sort-results (&optional (key :percent-time))
+ (setq *monitor-results*
+ (case key
+ (:function (sort *monitor-results* #'string>
+ :key #'m-info-name))
+ ((:percent-time :time) (sort *monitor-results* #'>
+ :key #'m-info-time))
+ ((:percent-cons :cons) (sort *monitor-results* #'>
+ :key #'m-info-cons))
+ (:calls (sort *monitor-results* #'>
+ :key #'m-info-calls))
+ (:time-per-call (sort *monitor-results* #'>
+ :key #'m-info-time-per-call))
+ (:cons-per-call (sort *monitor-results* #'>
+ :key #'m-info-cons-per-call)))))
+
+;;; *END OF FILE*
+
+
Added: branches/trunk-reorg/thirdparty/slime/mkdist.sh
===================================================================
--- branches/trunk-reorg/thirdparty/slime/mkdist.sh 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/mkdist.sh 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,17 @@
+#!/bin/sh
+
+# This code has been placed in the Public Domain. All warranties
+# are disclaimed.
+
+version="1.2"
+dist="slime-$version"
+
+if [ -d $dist ]; then rm -rf $dist; fi
+
+mkdir $dist
+cp NEWS README HACKING PROBLEMS ChangeLog *.el *.lisp $dist/
+
+mkdir $dist/doc
+cp doc/Makefile doc/slime.texi doc/texinfo-tabulate.awk $dist/doc
+
+tar czf $dist.tar.gz $dist
Property changes on: branches/trunk-reorg/thirdparty/slime/mkdist.sh
___________________________________________________________________
Name: svn:executable
+ *
Added: branches/trunk-reorg/thirdparty/slime/nregex.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/nregex.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/nregex.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,523 @@
+;;;
+;;; This code was written by:
+;;;
+;;; Lawrence E. Freil <lef(a)freil.com>
+;;; National Science Center Foundation
+;;; Augusta, Georgia 30909
+;;;
+;;; This program was released into the public domain on 2005-08-31.
+;;; (See the slime-devel mailing list archive for details.)
+;;;
+;;; nregex.lisp - My 4/8/92 attempt at a Lisp based regular expression
+;;; parser.
+;;;
+;;; This regular expression parser operates by taking a
+;;; regular expression and breaking it down into a list
+;;; consisting of lisp expressions and flags. The list
+;;; of lisp expressions is then taken in turned into a
+;;; lambda expression that can be later applied to a
+;;; string argument for parsing.
+;;;;
+;;;; Modifications made 6 March 2001 By Chris Double (chris(a)double.co.nz)
+;;;; to get working with Corman Lisp 1.42, add package statement and export
+;;;; relevant functions.
+;;;;
+
+(in-package :cl-user)
+
+;; Renamed to slime-nregex avoid name clashes with other versions of
+;; this file. -- he
+
+;;;; CND - 6/3/2001
+(defpackage slime-nregex
+ (:use #:common-lisp)
+ (:export
+ #:regex
+ #:regex-compile
+ ))
+
+;;;; CND - 6/3/2001
+(in-package :slime-nregex)
+
+;;;
+;;; First we create a copy of macros to help debug the beast
+(eval-when (:compile-toplevel :load-toplevel :execute)
+(defvar *regex-debug* nil) ; Set to nil for no debugging code
+)
+
+(defmacro info (message &rest args)
+ (if *regex-debug*
+ `(format *standard-output* ,message ,@args)))
+
+;;;
+;;; Declare the global variables for storing the paren index list.
+;;;
+(defvar *regex-groups* (make-array 10))
+(defvar *regex-groupings* 0)
+
+;;;
+;;; Declare a simple interface for testing. You probably wouldn't want
+;;; to use this interface unless you were just calling this once.
+;;;
+(defun regex (expression string)
+ "Usage: (regex <expression> <string)
+ This function will call regex-compile on the expression and then apply
+ the string to the returned lambda list."
+ (let ((findit (cond ((stringp expression)
+ (regex-compile expression))
+ ((listp expression)
+ expression)))
+ (result nil))
+ (if (not (funcall (if (functionp findit)
+ findit
+ (eval `(function ,findit))) string))
+ (return-from regex nil))
+ (if (= *regex-groupings* 0)
+ (return-from regex t))
+ (dotimes (i *regex-groupings*)
+ (push (funcall 'subseq
+ string
+ (car (aref *regex-groups* i))
+ (cadr (aref *regex-groups* i)))
+ result))
+ (reverse result)))
+
+;;;
+;;; Declare some simple macros to make the code more readable.
+;;;
+(defvar *regex-special-chars* "?*+.()[]\\${}")
+
+(defmacro add-exp (list)
+ "Add an item to the end of expression"
+ `(setf expression (append expression ,list)))
+
+;;;
+;;; Define a function that will take a quoted character and return
+;;; what the real character should be plus how much of the source
+;;; string was used. If the result is a set of characters, return an
+;;; array of bits indicating which characters should be set. If the
+;;; expression is one of the sub-group matches return a
+;;; list-expression that will provide the match.
+;;;
+(defun regex-quoted (char-string &optional (invert nil))
+ "Usage: (regex-quoted <char-string> &optional invert)
+ Returns either the quoted character or a simple bit vector of bits set for
+ the matching values"
+ (let ((first (char char-string 0))
+ (result (char char-string 0))
+ (used-length 1))
+ (cond ((eql first #\n)
+ (setf result #\NewLine))
+ ((eql first #\c)
+ (setf result #\Return))
+ ((eql first #\t)
+ (setf result #\Tab))
+ ((eql first #\d)
+ (setf result #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+ ((eql first #\D)
+ (setf result #*1111111111111111111111111111111111111111111111110000000000111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+ ((eql first #\w)
+ (setf result #*0000000000000000000000000000000000000000000000001111111111000000011111111111111111111111111000010111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+ ((eql first #\W)
+ (setf result #*1111111111111111111111111111111111111111111111110000000000111111100000000000000000000000000111101000000000000000000000000001111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+ ((eql first #\b)
+ (setf result #*0000000001000000000000000000000011000000000010100000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+ ((eql first #\B)
+ (setf result #*1111111110111111111111111111111100111111111101011111111111011111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+ ((eql first #\s)
+ (setf result #*0000000001100000000000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+ ((eql first #\S)
+ (setf result #*1111111110011111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+ ((and (>= (char-code first) (char-code #\0))
+ (<= (char-code first) (char-code #\9)))
+ (if (and (> (length char-string) 2)
+ (and (>= (char-code (char char-string 1)) (char-code #\0))
+ (<= (char-code (char char-string 1)) (char-code #\9))
+ (>= (char-code (char char-string 2)) (char-code #\0))
+ (<= (char-code (char char-string 2)) (char-code #\9))))
+ ;;
+ ;; It is a single character specified in octal
+ ;;
+ (progn
+ (setf result (do ((x 0 (1+ x))
+ (return 0))
+ ((= x 2) return)
+ (setf return (+ (* return 8)
+ (- (char-code (char char-string x))
+ (char-code #\0))))))
+ (setf used-length 3))
+ ;;
+ ;; We have a group number replacement.
+ ;;
+ (let ((group (- (char-code first) (char-code #\0))))
+ (setf result `((let ((nstring (subseq string (car (aref *regex-groups* ,group))
+ (cadr (aref *regex-groups* ,group)))))
+ (if (< length (+ index (length nstring)))
+ (return-from compare nil))
+ (if (not (string= string nstring
+ :start1 index
+ :end1 (+ index (length nstring))))
+ (return-from compare nil)
+ (incf index (length nstring)))))))))
+ (t
+ (setf result first)))
+ (if (and (vectorp result) invert)
+ (bit-xor result #*1111111110011111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 t))
+ (values result used-length)))
+
+;;;
+;;; Now for the main regex compiler routine.
+;;;
+(defun regex-compile (source &key (anchored nil))
+ "Usage: (regex-compile <expression> [ :anchored (t/nil) ])
+ This function take a regular expression (supplied as source) and
+ compiles this into a lambda list that a string argument can then
+ be applied to. It is also possible to compile this lambda list
+ for better performance or to save it as a named function for later
+ use"
+ (info "Now entering regex-compile with \"~A\"~%" source)
+ ;;
+ ;; This routine works in two parts.
+ ;; The first pass take the regular expression and produces a list of
+ ;; operators and lisp expressions for the entire regular expression.
+ ;; The second pass takes this list and produces the lambda expression.
+ (let ((expression '()) ; holder for expressions
+ (group 1) ; Current group index
+ (group-stack nil) ; Stack of current group endings
+ (result nil) ; holder for built expression.
+ (fast-first nil)) ; holder for quick unanchored scan
+ ;;
+ ;; If the expression was an empty string then it alway
+ ;; matches (so lets leave early)
+ ;;
+ (if (= (length source) 0)
+ (return-from regex-compile
+ '(lambda (&rest args)
+ (declare (ignore args))
+ t)))
+ ;;
+ ;; If the first character is a caret then set the anchored
+ ;; flags and remove if from the expression string.
+ ;;
+ (cond ((eql (char source 0) #\^)
+ (setf source (subseq source 1))
+ (setf anchored t)))
+ ;;
+ ;; If the first sequence is .* then also set the anchored flags.
+ ;; (This is purely for optimization, it will work without this).
+ ;;
+ (if (>= (length source) 2)
+ (if (string= source ".*" :start1 0 :end1 2)
+ (setf anchored t)))
+ ;;
+ ;; Also, If this is not an anchored search and the first character is
+ ;; a literal, then do a quick scan to see if it is even in the string.
+ ;; If not then we can issue a quick nil,
+ ;; otherwise we can start the search at the matching character to skip
+ ;; the checks of the non-matching characters anyway.
+ ;;
+ ;; If I really wanted to speed up this section of code it would be
+ ;; easy to recognize the case of a fairly long multi-character literal
+ ;; and generate a Boyer-Moore search for the entire literal.
+ ;;
+ ;; I generate the code to do a loop because on CMU Lisp this is about
+ ;; twice as fast a calling position.
+ ;;
+ (if (and (not anchored)
+ (not (position (char source 0) *regex-special-chars*))
+ (not (and (> (length source) 1)
+ (position (char source 1) *regex-special-chars*))))
+ (setf fast-first `((if (not (dotimes (i length nil)
+ (if (eql (char string i)
+ ,(char source 0))
+ (return (setf start i)))))
+ (return-from final-return nil)))))
+ ;;
+ ;; Generate the very first expression to save the starting index
+ ;; so that group 0 will be the entire string matched always
+ ;;
+ (add-exp '((setf (aref *regex-groups* 0)
+ (list index nil))))
+ ;;
+ ;; Loop over each character in the regular expression building the
+ ;; expression list as we go.
+ ;;
+ (do ((eindex 0 (1+ eindex)))
+ ((= eindex (length source)))
+ (let ((current (char source eindex)))
+ (info "Now processing character ~A index = ~A~%" current eindex)
+ (case current
+ ((#\.)
+ ;;
+ ;; Generate code for a single wild character
+ ;;
+ (add-exp '((if (>= index length)
+ (return-from compare nil)
+ (incf index)))))
+ ((#\$)
+ ;;
+ ;; If this is the last character of the expression then
+ ;; anchor the end of the expression, otherwise let it slide
+ ;; as a standard character (even though it should be quoted).
+ ;;
+ (if (= eindex (1- (length source)))
+ (add-exp '((if (not (= index length))
+ (return-from compare nil))))
+ (add-exp '((if (not (and (< index length)
+ (eql (char string index) #\$)))
+ (return-from compare nil)
+ (incf index))))))
+ ((#\*)
+ (add-exp '(ASTRISK)))
+
+ ((#\+)
+ (add-exp '(PLUS)))
+
+ ((#\?)
+ (add-exp '(QUESTION)))
+
+ ((#\()
+ ;;
+ ;; Start a grouping.
+ ;;
+ (incf group)
+ (push group group-stack)
+ (add-exp `((setf (aref *regex-groups* ,(1- group))
+ (list index nil))))
+ (add-exp `(,group)))
+ ((#\))
+ ;;
+ ;; End a grouping
+ ;;
+ (let ((group (pop group-stack)))
+ (add-exp `((setf (cadr (aref *regex-groups* ,(1- group)))
+ index)))
+ (add-exp `(,(- group)))))
+ ((#\[)
+ ;;
+ ;; Start of a range operation.
+ ;; Generate a bit-vector that has one bit per possible character
+ ;; and then on each character or range, set the possible bits.
+ ;;
+ ;; If the first character is carat then invert the set.
+ (let* ((invert (eql (char source (1+ eindex)) #\^))
+ (bitstring (make-array 256 :element-type 'bit
+ :initial-element
+ (if invert 1 0)))
+ (set-char (if invert 0 1)))
+ (if invert (incf eindex))
+ (do ((x (1+ eindex) (1+ x)))
+ ((eql (char source x) #\]) (setf eindex x))
+ (info "Building range with character ~A~%" (char source x))
+ (cond ((and (eql (char source (1+ x)) #\-)
+ (not (eql (char source (+ x 2)) #\])))
+ (if (>= (char-code (char source x))
+ (char-code (char source (+ 2 x))))
+ (error "Invalid range \"~A-~A\". Ranges must be in acending order"
+ (char source x) (char source (+ 2 x))))
+ (do ((j (char-code (char source x)) (1+ j)))
+ ((> j (char-code (char source (+ 2 x))))
+ (incf x 2))
+ (info "Setting bit for char ~A code ~A~%" (code-char j) j)
+ (setf (sbit bitstring j) set-char)))
+ (t
+ (cond ((not (eql (char source x) #\]))
+ (let ((char (char source x)))
+ ;;
+ ;; If the character is quoted then find out what
+ ;; it should have been
+ ;;
+ (if (eql (char source x) #\\ )
+ (let ((length))
+ (multiple-value-setq (char length)
+ (regex-quoted (subseq source x) invert))
+ (incf x length)))
+ (info "Setting bit for char ~A code ~A~%" char (char-code char))
+ (if (not (vectorp char))
+ (setf (sbit bitstring (char-code (char source x))) set-char)
+ (bit-ior bitstring char t))))))))
+ (add-exp `((let ((range ,bitstring))
+ (if (>= index length)
+ (return-from compare nil))
+ (if (= 1 (sbit range (char-code (char string index))))
+ (incf index)
+ (return-from compare nil)))))))
+ ((#\\ )
+ ;;
+ ;; Intreprete the next character as a special, range, octal, group or
+ ;; just the character itself.
+ ;;
+ (let ((length)
+ (value))
+ (multiple-value-setq (value length)
+ (regex-quoted (subseq source (1+ eindex)) nil))
+ (cond ((listp value)
+ (add-exp value))
+ ((characterp value)
+ (add-exp `((if (not (and (< index length)
+ (eql (char string index)
+ ,value)))
+ (return-from compare nil)
+ (incf index)))))
+ ((vectorp value)
+ (add-exp `((let ((range ,value))
+ (if (>= index length)
+ (return-from compare nil))
+ (if (= 1 (sbit range (char-code (char string index))))
+ (incf index)
+ (return-from compare nil)))))))
+ (incf eindex length)))
+ (t
+ ;;
+ ;; We have a literal character.
+ ;; Scan to see how many we have and if it is more than one
+ ;; generate a string= verses as single eql.
+ ;;
+ (let* ((lit "")
+ (term (dotimes (litindex (- (length source) eindex) nil)
+ (let ((litchar (char source (+ eindex litindex))))
+ (if (position litchar *regex-special-chars*)
+ (return litchar)
+ (progn
+ (info "Now adding ~A index ~A to lit~%" litchar
+ litindex)
+ (setf lit (concatenate 'string lit
+ (string litchar)))))))))
+ (if (= (length lit) 1)
+ (add-exp `((if (not (and (< index length)
+ (eql (char string index) ,current)))
+ (return-from compare nil)
+ (incf index))))
+ ;;
+ ;; If we have a multi-character literal then we must
+ ;; check to see if the next character (if there is one)
+ ;; is an astrisk or a plus or a question mark. If so then we must not use this
+ ;; character in the big literal.
+ (progn
+ (if (or (eql term #\*)
+ (eql term #\+)
+ (eql term #\?))
+ (setf lit (subseq lit 0 (1- (length lit)))))
+ (add-exp `((if (< length (+ index ,(length lit)))
+ (return-from compare nil))
+ (if (not (string= string ,lit :start1 index
+ :end1 (+ index ,(length lit))))
+ (return-from compare nil)
+ (incf index ,(length lit)))))))
+ (incf eindex (1- (length lit))))))))
+ ;;
+ ;; Plug end of list to return t. If we made it this far then
+ ;; We have matched!
+ (add-exp '((setf (cadr (aref *regex-groups* 0))
+ index)))
+ (add-exp '((return-from final-return t)))
+ ;;
+;;; (print expression)
+ ;;
+ ;; Now take the expression list and turn it into a lambda expression
+ ;; replacing the special flags with lisp code.
+ ;; For example: A BEGIN needs to be replace by an expression that
+ ;; saves the current index, then evaluates everything till it gets to
+ ;; the END then save the new index if it didn't fail.
+ ;; On an ASTRISK I need to take the previous expression and wrap
+ ;; it in a do that will evaluate the expression till an error
+ ;; occurs and then another do that encompases the remainder of the
+ ;; regular expression and iterates decrementing the index by one
+ ;; of the matched expression sizes and then returns nil. After
+ ;; the last expression insert a form that does a return t so that
+ ;; if the entire nested sub-expression succeeds then the loop
+ ;; is broken manually.
+ ;;
+ (setf result (copy-tree nil))
+ ;;
+ ;; Reversing the current expression makes building up the
+ ;; lambda list easier due to the nexting of expressions when
+ ;; and astrisk has been encountered.
+ (setf expression (reverse expression))
+ (do ((elt 0 (1+ elt)))
+ ((>= elt (length expression)))
+ (let ((piece (nth elt expression)))
+ ;;
+ ;; Now check for PLUS, if so then ditto the expression and then let the
+ ;; ASTRISK below handle the rest.
+ ;;
+ (cond ((eql piece 'PLUS)
+ (cond ((listp (nth (1+ elt) expression))
+ (setf result (append (list (nth (1+ elt) expression))
+ result)))
+ ;;
+ ;; duplicate the entire group
+ ;; NOTE: This hasn't been implemented yet!!
+ (t
+ (error "GROUP repeat hasn't been implemented yet~%")))))
+ (cond ((listp piece) ;Just append the list
+ (setf result (append (list piece) result)))
+ ((eql piece 'QUESTION) ; Wrap it in a block that won't fail
+ (cond ((listp (nth (1+ elt) expression))
+ (setf result
+ (append `((progn (block compare
+ ,(nth (1+ elt)
+ expression))
+ t))
+ result))
+ (incf elt))
+ ;;
+ ;; This is a QUESTION on an entire group which
+ ;; hasn't been implemented yet!!!
+ ;;
+ (t
+ (error "Optional groups not implemented yet~%"))))
+ ((or (eql piece 'ASTRISK) ; Do the wild thing!
+ (eql piece 'PLUS))
+ (cond ((listp (nth (1+ elt) expression))
+ ;;
+ ;; This is a single character wild card so
+ ;; do the simple form.
+ ;;
+ (setf result
+ `((let ((oindex index))
+ (block compare
+ (do ()
+ (nil)
+ ,(nth (1+ elt) expression)))
+ (do ((start index (1- start)))
+ ((< start oindex) nil)
+ (let ((index start))
+ (block compare
+ ,@result))))))
+ (incf elt))
+ (t
+ ;;
+ ;; This is a subgroup repeated so I must build
+ ;; the loop using several values.
+ ;;
+ ))
+ )
+ (t t)))) ; Just ignore everything else.
+ ;;
+ ;; Now wrap the result in a lambda list that can then be
+ ;; invoked or compiled, however the user wishes.
+ ;;
+ (if anchored
+ (setf result
+ `(lambda (string &key (start 0) (end (length string)))
+ (setf *regex-groupings* ,group)
+ (block final-return
+ (block compare
+ (let ((index start)
+ (length end))
+ ,@result)))))
+ (setf result
+ `(lambda (string &key (start 0) (end (length string)))
+ (setf *regex-groupings* ,group)
+ (block final-return
+ (let ((length end))
+ ,@fast-first
+ (do ((marker start (1+ marker)))
+ ((> marker end) nil)
+ (let ((index marker))
+ (if (block compare
+ ,@result)
+ (return t)))))))))))
+
+;; (provide 'nregex)
Added: branches/trunk-reorg/thirdparty/slime/sbcl-pprint-patch.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/sbcl-pprint-patch.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/sbcl-pprint-patch.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,332 @@
+;; Pretty printer patch for SBCL, which adds the "annotations" feature
+;; required for sending presentations through pretty-printing streams.
+;;
+;; The section marked "Changed functions" and the DEFSTRUCT
+;; PRETTY-STREAM are based on SBCL's pprint.lisp.
+;;
+;; Public domain.
+
+(in-package "SB!PRETTY")
+
+(defstruct (annotation (:include queued-op))
+ (handler (constantly nil) :type function)
+ (record))
+
+
+(defstruct (pretty-stream (:include sb!kernel:ansi-stream
+ (out #'pretty-out)
+ (sout #'pretty-sout)
+ (misc #'pretty-misc))
+ (:constructor make-pretty-stream (target))
+ (:copier nil))
+ ;; Where the output is going to finally go.
+ (target (missing-arg) :type stream)
+ ;; Line length we should format to. Cached here so we don't have to keep
+ ;; extracting it from the target stream.
+ (line-length (or *print-right-margin*
+ (sb!impl::line-length target)
+ default-line-length)
+ :type column)
+ ;; A simple string holding all the text that has been output but not yet
+ ;; printed.
+ (buffer (make-string initial-buffer-size) :type (simple-array character (*)))
+ ;; The index into BUFFER where more text should be put.
+ (buffer-fill-pointer 0 :type index)
+ ;; Whenever we output stuff from the buffer, we shift the remaining noise
+ ;; over. This makes it difficult to keep references to locations in
+ ;; the buffer. Therefore, we have to keep track of the total amount of
+ ;; stuff that has been shifted out of the buffer.
+ (buffer-offset 0 :type posn)
+ ;; The column the first character in the buffer will appear in. Normally
+ ;; zero, but if we end up with a very long line with no breaks in it we
+ ;; might have to output part of it. Then this will no longer be zero.
+ (buffer-start-column (or (sb!impl::charpos target) 0) :type column)
+ ;; The line number we are currently on. Used for *PRINT-LINES*
+ ;; abbreviations and to tell when sections have been split across
+ ;; multiple lines.
+ (line-number 0 :type index)
+ ;; the value of *PRINT-LINES* captured at object creation time. We
+ ;; use this, instead of the dynamic *PRINT-LINES*, to avoid
+ ;; weirdness like
+ ;; (let ((*print-lines* 50))
+ ;; (pprint-logical-block ..
+ ;; (dotimes (i 10)
+ ;; (let ((*print-lines* 8))
+ ;; (print (aref possiblybigthings i) prettystream)))))
+ ;; terminating the output of the entire logical blockafter 8 lines.
+ (print-lines *print-lines* :type (or index null) :read-only t)
+ ;; Stack of logical blocks in effect at the buffer start.
+ (blocks (list (make-logical-block)) :type list)
+ ;; Buffer holding the per-line prefix active at the buffer start.
+ ;; Indentation is included in this. The length of this is stored
+ ;; in the logical block stack.
+ (prefix (make-string initial-buffer-size) :type (simple-array character (*)))
+ ;; Buffer holding the total remaining suffix active at the buffer start.
+ ;; The characters are right-justified in the buffer to make it easier
+ ;; to output the buffer. The length is stored in the logical block
+ ;; stack.
+ (suffix (make-string initial-buffer-size) :type (simple-array character (*)))
+ ;; Queue of pending operations. When empty, HEAD=TAIL=NIL. Otherwise,
+ ;; TAIL holds the first (oldest) cons and HEAD holds the last (newest)
+ ;; cons. Adding things to the queue is basically (setf (cdr head) (list
+ ;; new)) and removing them is basically (pop tail) [except that care must
+ ;; be taken to handle the empty queue case correctly.]
+ (queue-tail nil :type list)
+ (queue-head nil :type list)
+ ;; Block-start queue entries in effect at the queue head.
+ (pending-blocks nil :type list)
+ ;; Queue of annotations to the buffer
+ (annotations-tail nil :type list)
+ (annotations-head nil :type list))
+
+
+(defmacro enqueue (stream type &rest args)
+ (let ((constructor (intern (concatenate 'string
+ "MAKE-"
+ (symbol-name type))
+ "SB-PRETTY")))
+ (once-only ((stream stream)
+ (entry `(,constructor :posn
+ (index-posn
+ (pretty-stream-buffer-fill-pointer
+ ,stream)
+ ,stream)
+ ,@args))
+ (op `(list ,entry))
+ (head `(pretty-stream-queue-head ,stream)))
+ `(progn
+ (if ,head
+ (setf (cdr ,head) ,op)
+ (setf (pretty-stream-queue-tail ,stream) ,op))
+ (setf (pretty-stream-queue-head ,stream) ,op)
+ ,entry))))
+
+;;;
+;;; New helper functions
+;;;
+
+(defun enqueue-annotation (stream handler record)
+ (enqueue stream annotation :handler handler
+ :record record))
+
+(defun re-enqueue-annotation (stream annotation)
+ (let* ((annotation-cons (list annotation))
+ (head (pretty-stream-annotations-head stream)))
+ (if head
+ (setf (cdr head) annotation-cons)
+ (setf (pretty-stream-annotations-tail stream) annotation-cons))
+ (setf (pretty-stream-annotations-head stream) annotation-cons)
+ nil))
+
+(defun re-enqueue-annotations (stream end)
+ (loop for tail = (pretty-stream-queue-tail stream) then (cdr tail)
+ while (and tail (not (eql (car tail) end)))
+ when (annotation-p (car tail))
+ do (re-enqueue-annotation stream (car tail))))
+
+(defun dequeue-annotation (stream &key end-posn)
+ (let ((next-annotation (car (pretty-stream-annotations-tail stream))))
+ (when next-annotation
+ (when (or (not end-posn)
+ (<= (annotation-posn next-annotation) end-posn))
+ (pop (pretty-stream-annotations-tail stream))
+ (unless (pretty-stream-annotations-tail stream)
+ (setf (pretty-stream-annotations-head stream) nil))
+ next-annotation))))
+
+(defun invoke-annotation (stream annotation truncatep)
+ (let ((target (pretty-stream-target stream)))
+ (funcall (annotation-handler annotation)
+ (annotation-record annotation)
+ target
+ truncatep)))
+
+(defun output-buffer-with-annotations (stream end)
+ (let ((target (pretty-stream-target stream))
+ (buffer (pretty-stream-buffer stream))
+ (end-posn (index-posn end stream))
+ (start 0))
+ (loop
+ for annotation = (dequeue-annotation stream :end-posn end-posn)
+ while annotation
+ do
+ (let ((annotation-index (posn-index (annotation-posn annotation)
+ stream)))
+ (when (> annotation-index start)
+ (write-string buffer target :start start
+ :end annotation-index)
+ (setf start annotation-index))
+ (invoke-annotation stream annotation nil)))
+ (when (> end start)
+ (write-string buffer target :start start :end end))))
+
+(defun flush-annotations (stream end truncatep)
+ (let ((end-posn (index-posn end stream)))
+ (loop
+ for annotation = (dequeue-annotation stream :end-posn end-posn)
+ while annotation
+ do (invoke-annotation stream annotation truncatep))))
+
+;;;
+;;; Changed functions
+;;;
+
+(defun maybe-output (stream force-newlines-p)
+ (declare (type pretty-stream stream))
+ (let ((tail (pretty-stream-queue-tail stream))
+ (output-anything nil))
+ (loop
+ (unless tail
+ (setf (pretty-stream-queue-head stream) nil)
+ (return))
+ (let ((next (pop tail)))
+ (etypecase next
+ (newline
+ (when (ecase (newline-kind next)
+ ((:literal :mandatory :linear) t)
+ (:miser (misering-p stream))
+ (:fill
+ (or (misering-p stream)
+ (> (pretty-stream-line-number stream)
+ (logical-block-section-start-line
+ (first (pretty-stream-blocks stream))))
+ (ecase (fits-on-line-p stream
+ (newline-section-end next)
+ force-newlines-p)
+ ((t) nil)
+ ((nil) t)
+ (:dont-know
+ (return))))))
+ (setf output-anything t)
+ (output-line stream next)))
+ (indentation
+ (unless (misering-p stream)
+ (set-indentation stream
+ (+ (ecase (indentation-kind next)
+ (:block
+ (logical-block-start-column
+ (car (pretty-stream-blocks stream))))
+ (:current
+ (posn-column
+ (indentation-posn next)
+ stream)))
+ (indentation-amount next)))))
+ (block-start
+ (ecase (fits-on-line-p stream (block-start-section-end next)
+ force-newlines-p)
+ ((t)
+ ;; Just nuke the whole logical block and make it look like one
+ ;; nice long literal. (But don't nuke annotations.)
+ (let ((end (block-start-block-end next)))
+ (expand-tabs stream end)
+ (re-enqueue-annotations stream end)
+ (setf tail (cdr (member end tail)))))
+ ((nil)
+ (really-start-logical-block
+ stream
+ (posn-column (block-start-posn next) stream)
+ (block-start-prefix next)
+ (block-start-suffix next)))
+ (:dont-know
+ (return))))
+ (block-end
+ (really-end-logical-block stream))
+ (tab
+ (expand-tabs stream next))
+ (annotation
+ (re-enqueue-annotation stream next))))
+ (setf (pretty-stream-queue-tail stream) tail))
+ output-anything))
+
+(defun output-line (stream until)
+ (declare (type pretty-stream stream)
+ (type newline until))
+ (let* ((target (pretty-stream-target stream))
+ (buffer (pretty-stream-buffer stream))
+ (kind (newline-kind until))
+ (literal-p (eq kind :literal))
+ (amount-to-consume (posn-index (newline-posn until) stream))
+ (amount-to-print
+ (if literal-p
+ amount-to-consume
+ (let ((last-non-blank
+ (position #\space buffer :end amount-to-consume
+ :from-end t :test #'char/=)))
+ (if last-non-blank
+ (1+ last-non-blank)
+ 0)))))
+ (output-buffer-with-annotations stream amount-to-print)
+ (flush-annotations stream amount-to-consume nil)
+ (let ((line-number (pretty-stream-line-number stream)))
+ (incf line-number)
+ (when (and (not *print-readably*)
+ (pretty-stream-print-lines stream)
+ (>= line-number (pretty-stream-print-lines stream)))
+ (write-string " .." target)
+ (flush-annotations stream
+ (pretty-stream-buffer-fill-pointer stream)
+ t)
+ (let ((suffix-length (logical-block-suffix-length
+ (car (pretty-stream-blocks stream)))))
+ (unless (zerop suffix-length)
+ (let* ((suffix (pretty-stream-suffix stream))
+ (len (length suffix)))
+ (write-string suffix target
+ :start (- len suffix-length)
+ :end len))))
+ (throw 'line-limit-abbreviation-happened t))
+ (setf (pretty-stream-line-number stream) line-number)
+ (write-char #\newline target)
+ (setf (pretty-stream-buffer-start-column stream) 0)
+ (let* ((fill-ptr (pretty-stream-buffer-fill-pointer stream))
+ (block (first (pretty-stream-blocks stream)))
+ (prefix-len
+ (if literal-p
+ (logical-block-per-line-prefix-end block)
+ (logical-block-prefix-length block)))
+ (shift (- amount-to-consume prefix-len))
+ (new-fill-ptr (- fill-ptr shift))
+ (new-buffer buffer)
+ (buffer-length (length buffer)))
+ (when (> new-fill-ptr buffer-length)
+ (setf new-buffer
+ (make-string (max (* buffer-length 2)
+ (+ buffer-length
+ (floor (* (- new-fill-ptr buffer-length)
+ 5)
+ 4)))))
+ (setf (pretty-stream-buffer stream) new-buffer))
+ (replace new-buffer buffer
+ :start1 prefix-len :start2 amount-to-consume :end2 fill-ptr)
+ (replace new-buffer (pretty-stream-prefix stream)
+ :end1 prefix-len)
+ (setf (pretty-stream-buffer-fill-pointer stream) new-fill-ptr)
+ (incf (pretty-stream-buffer-offset stream) shift)
+ (unless literal-p
+ (setf (logical-block-section-column block) prefix-len)
+ (setf (logical-block-section-start-line block) line-number))))))
+
+(defun output-partial-line (stream)
+ (let* ((fill-ptr (pretty-stream-buffer-fill-pointer stream))
+ (tail (pretty-stream-queue-tail stream))
+ (count
+ (if tail
+ (posn-index (queued-op-posn (car tail)) stream)
+ fill-ptr))
+ (new-fill-ptr (- fill-ptr count))
+ (buffer (pretty-stream-buffer stream)))
+ (when (zerop count)
+ (error "Output-partial-line called when nothing can be output."))
+ (output-buffer-with-annotations stream count)
+ (incf (pretty-stream-buffer-start-column stream) count)
+ (replace buffer buffer :end1 new-fill-ptr :start2 count :end2 fill-ptr)
+ (setf (pretty-stream-buffer-fill-pointer stream) new-fill-ptr)
+ (incf (pretty-stream-buffer-offset stream) count)))
+
+(defun force-pretty-output (stream)
+ (maybe-output stream nil)
+ (expand-tabs stream nil)
+ (re-enqueue-annotations stream nil)
+ (output-buffer-with-annotations stream
+ (pretty-stream-buffer-fill-pointer stream)))
+
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/slime-autoloads.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/slime-autoloads.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/slime-autoloads.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,50 @@
+;;; slime-autoloads.el --- autoload definitions for SLIME
+
+;; Copyright (C) 2007 Helmut Eller
+
+;; This file is protected by the GNU GPLv2 (or later), as distributed
+;; with GNU Emacs.
+
+;;; Commentary:
+
+;; This code defines the necessary autoloads, so that we don't need to
+;; load everything from .emacs.
+
+;;; Code:
+
+(autoload 'slime "slime"
+ "Start a Lisp subprocess and connect to its Swank server." t)
+
+(autoload 'slime-mode "slime"
+ "SLIME: The Superior Lisp Interaction (Minor) Mode for Emacs." t)
+
+(autoload 'slime-connect "slime"
+ "Connect to a running Swank server." t)
+
+(autoload 'hyperspec-lookup "hyperspec" nil t)
+
+(autoload 'slime-lisp-mode-hook "slime")
+(autoload 'slime-scheme-mode-hook "slime")
+
+(defvar slime-lisp-modes '(lisp-mode))
+
+(defun slime-setup (&optional contribs)
+ "Setup Emacs so that lisp-mode buffers always use SLIME.
+CONTRIBS is a list of contrib packages to load."
+ (when (member 'lisp-mode slime-lisp-modes)
+ (add-hook 'lisp-mode-hook 'slime-lisp-mode-hook))
+ (setq slime-setup-contribs contribs)
+ (add-hook 'slime-load-hook 'slime-setup-contribs))
+
+(defvar slime-setup-contribs nil)
+
+(defun slime-setup-contribs ()
+ (dolist (c slime-setup-contribs)
+ (require c)
+ (let ((init (intern (format "%s-init" c))))
+ (when (fboundp init)
+ (funcall init)))))
+
+(provide 'slime-autoloads)
+
+;;; slime-autoloads.el ends here
Added: branches/trunk-reorg/thirdparty/slime/slime.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/slime.el 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/slime.el 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,9543 @@
+;;; slime.el --- Superior Lisp Interaction Mode for Emacs
+;;
+;;;; License
+;; Copyright (C) 2003 Eric Marsden, Luke Gorrie, Helmut Eller
+;; Copyright (C) 2004,2005,2006 Luke Gorrie, Helmut Eller
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public
+;; License along with this program; if not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+
+;;;; Commentary
+;;
+;; This file contains extensions for programming in Common Lisp. The
+;; main features are:
+;;
+;; A socket-based communication/RPC interface between Emacs and
+;; Lisp.
+;;
+;; The `slime-mode' minor-mode complementing `lisp-mode'. This new
+;; mode includes many commands for interacting with the Common Lisp
+;; process.
+;;
+;; Common Lisp REPL (Read-Eval-Print Loop) written in Emacs Lisp,
+;; similar to `ielm'.
+;;
+;; Common Lisp debugger written in Emacs Lisp. The debugger pops up
+;; an Emacs buffer similar to the Emacs/Elisp debugger.
+;;
+;; Trapping compiler messages and creating annotations in the source
+;; file on the appropriate forms.
+;;
+;; SLIME is compatible with GNU Emacs 20 and 21 and XEmacs 21. In
+;; order to run SLIME requires a supporting Lisp server called
+;; Swank. Swank is distributed with slime.el and will automatically be
+;; started in a normal installation.
+
+
+;;;; Dependencies and setup
+
+(eval-and-compile
+ (require 'cl)
+ (unless (fboundp 'define-minor-mode)
+ (require 'easy-mmode)
+ (defalias 'define-minor-mode 'easy-mmode-define-minor-mode)))
+(require 'comint)
+(require 'timer)
+(require 'pp)
+(require 'hideshow)
+(require 'hyperspec)
+(require 'font-lock)
+(when (featurep 'xemacs)
+ (require 'overlay))
+(require 'easymenu)
+
+(defvar slime-lisp-modes '(lisp-mode))
+
+(defun slime-setup (&optional contribs)
+ "Setup Emacs so that lisp-mode buffers always use SLIME.
+CONTRIBS is a list of contrib packages to load."
+ (when (member 'lisp-mode slime-lisp-modes)
+ (add-hook 'lisp-mode-hook 'slime-lisp-mode-hook))
+ (dolist (c contribs)
+ (require c)
+ (let ((init (intern (format "%s-init" c))))
+ (when (fboundp init)
+ (funcall init)))))
+
+(defun slime-lisp-mode-hook ()
+ (slime-mode 1)
+ (set (make-local-variable 'lisp-indent-function)
+ 'common-lisp-indent-function))
+
+(eval-and-compile
+ (defvar slime-path
+ (let ((path (or (locate-library "slime") load-file-name)))
+ (and path (file-name-directory path)))
+ "Directory containing the Slime package.
+This is used to load the supporting Common Lisp library, Swank.
+The default value is automatically computed from the location of the
+Emacs Lisp package."))
+
+(eval-and-compile
+ (defun slime-changelog-date ()
+ "Return the datestring of the latest entry in the ChangeLog file.
+Return nil if the ChangeLog file cannot be found."
+ (let ((changelog (concat slime-path "ChangeLog")))
+ (if (file-exists-p changelog)
+ (with-temp-buffer
+ (insert-file-contents changelog nil 0 100)
+ (goto-char (point-min))
+ (symbol-name (read (current-buffer))))
+ nil))))
+
+(defvar slime-protocol-version nil)
+(setq slime-protocol-version
+ (eval-when-compile (slime-changelog-date)))
+
+
+;;;; Customize groups
+;;
+;;;;; slime
+
+(defgroup slime nil
+ "Interaction with the Superior Lisp Environment."
+ :prefix "slime-"
+ :group 'applications)
+
+;;;;; slime-ui
+
+(defgroup slime-ui nil
+ "Interaction with the Superior Lisp Environment."
+ :prefix "slime-"
+ :group 'slime)
+
+(defcustom slime-truncate-lines t
+ "Set `truncate-lines' in popup buffers.
+This applies to buffers that present lines as rows of data, such as
+debugger backtraces and apropos listings."
+ :type 'boolean
+ :group 'slime-ui)
+
+(defcustom slime-update-modeline-package t
+ "Automatically update the Lisp package name in the minibuffer.
+This is done with a text-search that runs on an idle timer."
+ :type 'boolean
+ :group 'slime-ui)
+
+(defcustom slime-kill-without-query-p nil
+ "If non-nil, kill SLIME processes without query when quitting Emacs.
+This applies to the *inferior-lisp* buffer and the network connections."
+ :type 'boolean
+ :group 'slime-ui)
+
+;;;;; slime-lisp
+
+(defgroup slime-lisp nil
+ "Lisp server configuration."
+ :prefix "slime-"
+ :group 'slime)
+
+(defcustom slime-backend "swank-loader.lisp"
+ "The name of the Lisp file that loads the Swank server.
+This name is interpreted relative to the directory containing
+slime.el, but could also be set to an absolute filename."
+ :type 'string
+ :group 'slime-lisp)
+
+(defcustom slime-connected-hook nil
+ "List of functions to call when SLIME connects to Lisp."
+ :type 'hook
+ :group 'slime-lisp)
+
+(defcustom slime-filename-translations nil
+ "Assoc list of hostnames and filename translation functions.
+Each element is of the form (HOSTNAME-REGEXP TO-LISP FROM-LISP).
+
+HOSTNAME-REGEXP is a regexp which is applied to the connection's
+slime-machine-instance. If HOSTNAME-REGEXP maches then the
+corresponding TO-LISP and FROM-LISP functions will be used to
+translate emacs filenames and lisp filenames.
+
+TO-LISP will be passed the filename of an emacs buffer and must
+return a string which the underlying lisp understandas as a
+pathname. FROM-LISP will be passed a pathname as returned by the
+underlying lisp and must return something that emacs will
+understand as a filename (this string will be passed to
+find-file).
+
+This list will be traversed in order, so multiple matching
+regexps are possible.
+
+Example:
+
+Assuming you run emacs locally and connect to slime running on
+the machine 'soren' and you can connect with the username
+'animaliter':
+
+ (push (list \"^soren$\"
+ (lambda (emacs-filename)
+ (subseq emacs-filename (length \"/ssh:animaliter@soren:\")))
+ (lambda (lisp-filename)
+ (concat \"/ssh:animaliter@soren:\" lisp-filename)))
+ slime-filename-translations)
+
+See also `slime-create-filename-translator'."
+ :type '(repeat (list :tag "Host description"
+ (regexp :tag "Hostname regexp")
+ (function :tag "To lisp function")
+ (function :tag "From lisp function")))
+ :group 'slime-lisp)
+
+(defcustom slime-enable-evaluate-in-emacs nil
+ "*If non-nil, the inferior Lisp can evaluate arbitrary forms in Emacs.
+The default is nil, as this feature can be a security risk."
+ :type '(boolean)
+ :group 'slime-lisp)
+
+;;;;; slime-mode
+
+(defgroup slime-mode nil
+ "Settings for slime-mode Lisp source buffers."
+ :prefix "slime-"
+ :group 'slime)
+
+(defcustom slime-edit-definition-fallback-function nil
+ "Function to call when edit-definition fails to find the source itself.
+The function is called with the definition name, a string, as its argument.
+
+If you want to fallback on TAGS you can set this to `find-tag',
+`slime-find-tag-if-tags-table-visited', or
+`slime-edit-definition-with-etags'."
+ :type 'symbol
+ :group 'slime-mode-mode
+ :options '(nil
+ slime-edit-definition-with-etags
+ slime-find-tag-if-tags-table-visited
+ find-tag))
+
+(defcustom slime-complete-symbol-function 'slime-simple-complete-symbol
+ "*Function to perform symbol completion."
+ :group 'slime-mode
+ :type '(choice (const :tag "Simple" slime-simple-complete-symbol)
+ (const :tag "Compound" slime-complete-symbol*)
+ (const :tag "Fuzzy" slime-fuzzy-complete-symbol)))
+
+(defcustom slime-when-complete-filename-expand nil
+ "Use comint-replace-by-expanded-filename instead of comint-dynamic-complete-as-filename to complete file names"
+ :group 'slime-mode
+ :type 'boolean)
+
+(defcustom slime-space-information-p t
+ "Have the SPC key offer arglist information."
+ :type 'boolean
+ :group 'slime-mode)
+
+;;;;; slime-mode-faces
+
+(defgroup slime-mode-faces nil
+ "Faces in slime-mode source code buffers."
+ :prefix "slime-"
+ :group 'slime-mode)
+
+(defun slime-underline-color (color)
+ "Return a legal value for the :underline face attribute based on COLOR."
+ ;; In XEmacs the :underline attribute can only be a boolean.
+ ;; In GNU it can be the name of a colour.
+ (if (featurep 'xemacs)
+ (if color t nil)
+ color))
+
+(defface slime-error-face
+ `((((class color) (background light))
+ (:underline ,(slime-underline-color "red")))
+ (((class color) (background dark))
+ (:underline ,(slime-underline-color "red")))
+ (t (:underline t)))
+ "Face for errors from the compiler."
+ :group 'slime-mode-faces)
+
+(defface slime-warning-face
+ `((((class color) (background light))
+ (:underline ,(slime-underline-color "orange")))
+ (((class color) (background dark))
+ (:underline ,(slime-underline-color "coral")))
+ (t (:underline t)))
+ "Face for warnings from the compiler."
+ :group 'slime-mode-faces)
+
+(defface slime-style-warning-face
+ `((((class color) (background light))
+ (:underline ,(slime-underline-color "brown")))
+ (((class color) (background dark))
+ (:underline ,(slime-underline-color "gold")))
+ (t (:underline t)))
+ "Face for style-warnings from the compiler."
+ :group 'slime-mode-faces)
+
+(defface slime-note-face
+ `((((class color) (background light))
+ (:underline ,(slime-underline-color "brown4")))
+ (((class color) (background dark))
+ (:underline ,(slime-underline-color "light goldenrod")))
+ (t (:underline t)))
+ "Face for notes from the compiler."
+ :group 'slime-mode-faces)
+
+(defun slime-face-inheritance-possible-p ()
+ "Return true if the :inherit face attribute is supported."
+ (assq :inherit custom-face-attributes))
+
+(defface slime-highlight-face
+ (if (slime-face-inheritance-possible-p)
+ '((t (:inherit highlight :underline nil)))
+ '((((class color) (background light))
+ (:background "darkseagreen2"))
+ (((class color) (background dark))
+ (:background "darkolivegreen"))
+ (t (:inverse-video t))))
+ "Face for compiler notes while selected."
+ :group 'slime-mode-faces)
+
+;;;;; sldb
+
+(defgroup slime-debugger nil
+ "Backtrace options and fontification."
+ :prefix "sldb-"
+ :group 'slime)
+
+(defmacro define-sldb-faces (&rest faces)
+ "Define the set of SLDB faces.
+Each face specifiation is (NAME DESCRIPTION &optional PROPERTIES).
+NAME is a symbol; the face will be called sldb-NAME-face.
+DESCRIPTION is a one-liner for the customization buffer.
+PROPERTIES specifies any default face properties."
+ `(progn ,@(loop for face in faces
+ collect `(define-sldb-face ,@face))))
+
+(defmacro define-sldb-face (name description &optional default)
+ (let ((facename (intern (format "sldb-%s-face" (symbol-name name)))))
+ `(defface ,facename
+ (list (list t ,default))
+ ,(format "Face for %s." description)
+ :group 'slime-debugger)))
+
+(define-sldb-faces
+ (topline "the top line describing the error")
+ (condition "the condition class")
+ (section "the labels of major sections in the debugger buffer")
+ (frame-label "backtrace frame numbers")
+ (restart-type "restart names."
+ (if (slime-face-inheritance-possible-p)
+ '(:inherit font-lock-keyword-face)))
+ (restart "restart descriptions")
+ (restart-number "restart numbers (correspond to keystrokes to invoke)"
+ '(:bold t))
+ (frame-line "function names and arguments in the backtrace")
+ (detailed-frame-line
+ "function names and arguments in a detailed (expanded) frame")
+ (local-name "local variable names")
+ (local-value "local variable values")
+ (catch-tag "catch tags"))
+
+;;;;; slime-repl
+
+(defgroup slime-repl nil
+ "The Read-Eval-Print Loop (*slime-repl* buffer)."
+ :prefix "slime-repl-"
+ :group 'slime)
+
+(defcustom slime-repl-shortcut-dispatch-char ?\,
+ "Character used to distinguish repl commands from lisp forms."
+ :type '(character)
+ :group 'slime-repl)
+
+(defcustom slime-repl-only-save-lisp-buffers t
+ "When T we only attempt to save lisp-mode file buffers. When
+ NIL slime will attempt to save all buffers (as per
+ save-some-buffers). This applies to all ASDF related repl
+ shortcuts."
+ :type '(boolean)
+ :group 'slime-repl)
+
+(defcustom slime-repl-return-behaviour :send-if-complete
+ "Keyword specifying how slime-repl-return behaves when the
+ point is on a lisp expression (as opposed to being on a
+ previous output).
+
+Currently only two values are supported:
+
+:send-if-complete - If the current expression is complete, as per
+slime-input-complete-p, it is sent to the underlying lisp,
+otherwise a newline is inserted. The current value of (point) has
+no effect.
+
+:send-only-if-after-complete - If the current expression is complete
+and point is after the expression it is sent, otherwise a newline
+is inserted."
+ :type '(choice (const :tag "Send if complete" :value :send-if-complete)
+ (const :tag "Send only if after complete" :value :send-only-if-after-complete))
+ :group 'slime-repl)
+
+
+(defface slime-repl-prompt-face
+ (if (slime-face-inheritance-possible-p)
+ '((t (:inherit font-lock-keyword-face)))
+ '((((class color) (background light)) (:foreground "Purple"))
+ (((class color) (background dark)) (:foreground "Cyan"))
+ (t (:weight bold))))
+ "Face for the prompt in the SLIME REPL."
+ :group 'slime-repl)
+
+(defface slime-repl-output-face
+ (if (slime-face-inheritance-possible-p)
+ '((t (:inherit font-lock-string-face)))
+ '((((class color) (background light)) (:foreground "RosyBrown"))
+ (((class color) (background dark)) (:foreground "LightSalmon"))
+ (t (:slant italic))))
+ "Face for Lisp output in the SLIME REPL."
+ :group 'slime-repl)
+
+(defface slime-repl-input-face
+ '((t (:bold t)))
+ "Face for previous input in the SLIME REPL."
+ :group 'slime-repl)
+
+(defface slime-repl-result-face
+ '((t ()))
+ "Face for the result of an evaluation in the SLIME REPL."
+ :group 'slime-repl)
+
+(defcustom slime-repl-history-file "~/.slime-history.eld"
+ "File to save the persistent REPL history to."
+ :type 'string
+ :group 'slime-repl)
+
+(defcustom slime-repl-history-size 200
+ "*Maximum number of lines for persistent REPL history."
+ :type 'integer
+ :group 'slime-repl)
+
+
+;;;; Minor modes
+
+;;;;; slime-mode
+
+(define-minor-mode slime-mode
+ "\\<slime-mode-map>\
+SLIME: The Superior Lisp Interaction Mode for Emacs (minor-mode).
+
+Commands to compile the current buffer's source file and visually
+highlight any resulting compiler notes and warnings:
+\\[slime-compile-and-load-file] - Compile and load the current buffer's file.
+\\[slime-compile-file] - Compile (but not load) the current buffer's file.
+\\[slime-compile-defun] - Compile the top-level form at point.
+
+Commands for visiting compiler notes:
+\\[slime-next-note] - Goto the next form with a compiler note.
+\\[slime-previous-note] - Goto the previous form with a compiler note.
+\\[slime-remove-notes] - Remove compiler-note annotations in buffer.
+
+Finding definitions:
+\\[slime-edit-definition] - Edit the definition of the function called at point.
+\\[slime-pop-find-definition-stack] - Pop the definition stack to go back from a definition.
+
+Documentation commands:
+\\[slime-describe-symbol] - Describe symbol.
+\\[slime-apropos] - Apropos search.
+\\[slime-disassemble-symbol] - Disassemble a function.
+
+Evaluation commands:
+\\[slime-eval-defun] - Evaluate top-level from containing point.
+\\[slime-eval-last-expression] - Evaluate sexp before point.
+\\[slime-pprint-eval-last-expression] - Evaluate sexp before point, pretty-print result.
+
+Full set of commands:
+\\{slime-mode-map}"
+ nil
+ nil
+ ;; Fake binding to coax `define-minor-mode' to create the keymap
+ '((" " 'undefined)))
+
+(make-variable-buffer-local
+ (defvar slime-modeline-package nil
+ "The Lisp package to show in the modeline.
+This is automatically updated based on the buffer/point."))
+
+(defun slime-update-modeline-package ()
+ (ignore-errors
+ (when (and slime-update-modeline-package
+ (memq major-mode slime-lisp-modes)
+ slime-mode)
+ (let ((package (slime-current-package)))
+ (when package
+ (setq slime-modeline-package
+ (slime-pretty-package-name package)))))))
+
+(defun slime-pretty-package-name (name)
+ "Return a pretty version of a package name NAME."
+ (let ((name (cond ((string-match "^:\\(.*\\)$" name)
+ (match-string 1 name))
+ ((string-match "^\"\\(.*\\)\"$" name)
+ (match-string 1 name))
+ (t name))))
+ (format "%s" (read name))))
+
+(when slime-update-modeline-package
+ (run-with-idle-timer 0.2 0.2 'slime-update-modeline-package))
+
+;; Setup the mode-line to say when we're in slime-mode, and which CL
+;; package we think the current buffer belongs to.
+(add-to-list 'minor-mode-alist
+ '(slime-mode
+ (" Slime"
+ ((slime-modeline-package (":" slime-modeline-package) "")
+ slime-state-name))))
+
+(defun slime-input-complete-p (start end)
+ "Return t if the region from START to END contains a complete sexp."
+ (save-excursion
+ (goto-char start)
+ (cond ((looking-at "\\s *['`#]?[(\"]")
+ (ignore-errors
+ (save-restriction
+ (narrow-to-region start end)
+ ;; Keep stepping over blanks and sexps until the end of
+ ;; buffer is reached or an error occurs. Tolerate extra
+ ;; close parens.
+ (loop do (skip-chars-forward " \t\r\n)")
+ until (eobp)
+ do (forward-sexp))
+ t)))
+ (t t))))
+
+
+;;;;; Key bindings
+
+;; See `slime-define-key' below for keyword meanings.
+(defvar slime-keys
+ '(;; Compiler notes
+ ("\M-p" slime-previous-note)
+ ("\M-n" slime-next-note)
+ ("\M-c" slime-remove-notes :prefixed t)
+ ("\C-k" slime-compile-and-load-file :prefixed t)
+ ("\M-k" slime-compile-file :prefixed t)
+ ("\C-c" slime-compile-defun :prefixed t)
+ ("\C-l" slime-load-file :prefixed t)
+ ;; Editing/navigating
+ ("\M-\C-i" slime-complete-symbol :inferior t)
+ ("\C-i" slime-complete-symbol :prefixed t :inferior t)
+ ("\M-." slime-edit-definition :inferior t :sldb t)
+ ("\C-x4." slime-edit-definition-other-window :inferior t :sldb t)
+ ("\C-x5." slime-edit-definition-other-frame :inferior t :sldb t)
+ ("\M-," slime-pop-find-definition-stack :inferior t :sldb t)
+ ;; Evaluating
+ ("\C-x\C-e" slime-eval-last-expression :inferior t)
+ ("\C-x\M-e" slime-eval-last-expression-display-output :inferior t)
+ ("\C-p" slime-pprint-eval-last-expression :prefixed t :inferior t)
+ ("\C-r" slime-eval-region :prefixed t :inferior t)
+ ("\C-\M-x" slime-eval-defun)
+ (":" slime-interactive-eval :prefixed t :sldb t)
+ ("\C-e" slime-interactive-eval :prefixed t :sldb t :inferior t)
+ ("\C-y" slime-call-defun :prefixed t)
+ ("E" slime-edit-value :prefixed t :sldb t :inferior t)
+ ("\C-z" slime-switch-to-output-buffer :prefixed t :sldb t)
+ ("\C-b" slime-interrupt :prefixed t :inferior t :sldb t)
+ ("\M-g" slime-quit :prefixed t :inferior t :sldb t)
+ ;; Documentation
+ (" " slime-space :inferior t)
+ ("\C-f" slime-describe-function :prefixed t :inferior t :sldb t)
+ ("\M-d" slime-disassemble-symbol :prefixed t :inferior t :sldb t)
+ ("\C-t" slime-toggle-trace-fdefinition :prefixed t :sldb t)
+ ("\C-u" slime-undefine-function :prefixed t)
+ ("\C-m" slime-macroexpand-1 :prefixed t :inferior t)
+ ("\M-m" slime-macroexpand-all :prefixed t :inferior t)
+ ("\M-0" slime-restore-window-configuration :prefixed t :inferior t)
+ ([(control meta ?\.)] slime-next-location :inferior t)
+ ("~" slime-sync-package-and-default-directory :prefixed t :inferior t)
+ ("\M-p" slime-repl-set-package :prefixed t :inferior t)
+ ;; Cross reference
+ ("<" slime-list-callers :prefixed t :inferior t :sldb t)
+ (">" slime-list-callees :prefixed t :inferior t :sldb t)
+ ;; "Other"
+ ("\I" slime-inspect :prefixed t :inferior t :sldb t)
+ ("\C-]" slime-close-all-parens-in-sexp :prefixed t :inferior t :sldb t)
+ ("\C-xt" slime-list-threads :prefixed t :inferior t :sldb t)
+ ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t)
+ ;; ;; Shadow unwanted bindings from inf-lisp
+ ;; ("\C-a" slime-nop :prefixed t :inferior t :sldb t)
+ ;; ("\C-v" slime-nop :prefixed t :inferior t :sldb t)
+ ))
+
+(defun slime-nop ()
+ "The null command. Used to shadow currently-unused keybindings."
+ (interactive)
+ (call-interactively 'undefined))
+
+(defvar slime-doc-map (make-sparse-keymap)
+ "Keymap for documentation commands. Bound to a prefix key.")
+
+(defvar slime-doc-bindings
+ '((?a slime-apropos)
+ (?z slime-apropos-all)
+ (?p slime-apropos-package)
+ (?d slime-describe-symbol)
+ (?f slime-describe-function)
+ (?h slime-hyperspec-lookup)
+ (?~ common-lisp-hyperspec-format)))
+
+(defvar slime-who-map (make-sparse-keymap)
+ "Keymap for who-xref commands. Bound to a prefix key.")
+
+(defvar slime-who-bindings
+ '((?c slime-who-calls)
+ (?w slime-calls-who)
+ (?r slime-who-references)
+ (?b slime-who-binds)
+ (?s slime-who-sets)
+ (?m slime-who-macroexpands)
+ (?a slime-who-specializes)))
+
+;; Maybe a good idea, maybe not..
+(defvar slime-prefix-key "\C-c"
+ "The prefix key to use in SLIME keybinding sequences.")
+
+(defun* slime-define-key (key command &key prefixed inferior)
+ "Define a keybinding of KEY for COMMAND.
+If PREFIXED is non-nil, `slime-prefix-key' is prepended to KEY."
+ (when prefixed
+ (setq key (concat slime-prefix-key key)))
+ (define-key slime-mode-map key command))
+
+(defun slime-init-keymaps ()
+ "(Re)initialize the keymaps for `slime-mode'."
+ (interactive)
+ (loop for (key command . keys) in slime-keys
+ do (apply #'slime-define-key key command :allow-other-keys t keys))
+ ;; Documentation
+ (setq slime-doc-map (make-sparse-keymap))
+ (loop for (key command) in slime-doc-bindings
+ do (progn
+ ;; We bind both unmodified and with control.
+ (define-key slime-doc-map (vector key) command)
+ (unless (equal key ?h) ; But don't bind C-h
+ (let ((modified (slime-control-modified-char key)))
+ (define-key slime-doc-map (vector modified) command)))))
+ ;; C-c C-d is the prefix for the doc map.
+ (slime-define-key "\C-d" slime-doc-map :prefixed t :inferior t)
+ ;; Who-xref
+ (setq slime-who-map (make-sparse-keymap))
+ (loop for (key command) in slime-who-bindings
+ do (progn
+ ;; We bind both unmodified and with control.
+ (define-key slime-who-map (vector key) command)
+ (let ((modified (slime-control-modified-char key)))
+ (define-key slime-who-map (vector modified) command))))
+ ;; C-c C-w is the prefix for the who-xref map.
+ (slime-define-key "\C-w" slime-who-map :prefixed t :inferior t))
+
+(defun slime-control-modified-char (char)
+ "Return the control-modified version of CHAR."
+ ;; Maybe better to just bitmask it?
+ (read (format "?\\C-%c" char)))
+
+(slime-init-keymaps)
+
+
+;;;; Setup initial `slime-mode' hooks
+
+(make-variable-buffer-local
+ (defvar slime-pre-command-actions nil
+ "List of functions to execute before the next Emacs command.
+This list of flushed between commands."))
+
+(defun slime-pre-command-hook ()
+ "Execute all functions in `slime-pre-command-actions', then NIL it."
+ (dolist (undo-fn slime-pre-command-actions)
+ (ignore-errors (funcall undo-fn)))
+ (setq slime-pre-command-actions nil))
+
+(defun slime-post-command-hook ()
+ (when (null pre-command-hook) ; sometimes this is lost
+ (add-hook 'pre-command-hook 'slime-pre-command-hook)))
+
+(defun slime-setup-command-hooks ()
+ "Setup a buffer-local `pre-command-hook' to call `slime-pre-command-hook'."
+ (add-local-hook 'pre-command-hook 'slime-pre-command-hook)
+ (add-local-hook 'post-command-hook 'slime-post-command-hook))
+
+
+;;;; Framework'ey bits
+;;;
+;;; This section contains some standard SLIME idioms: basic macros,
+;;; ways of showing messages to the user, etc. All the code in this
+;;; file should use these functions when applicable.
+;;;
+;;;;; Syntactic sugar
+
+(defmacro* when-let ((var value) &rest body)
+ "Evaluate VALUE, and if the result is non-nil bind it to VAR and
+evaluate BODY.
+
+\(fn (VAR VALUE) &rest BODY)"
+ `(let ((,var ,value))
+ (when ,var ,@body)))
+
+(put 'when-let 'lisp-indent-function 1)
+
+(defmacro with-lexical-bindings (variables &rest body)
+ "Execute BODY with VARIABLES in lexical scope."
+ `(lexical-let ,(mapcar (lambda (variable) (list variable variable))
+ variables)
+ ,@body))
+
+(put 'with-lexical-bindings 'lisp-indent-function 1)
+
+(defmacro destructure-case (value &rest patterns)
+ "Dispatch VALUE to one of PATTERNS.
+A cross between `case' and `destructuring-bind'.
+The pattern syntax is:
+ ((HEAD . ARGS) . BODY)
+The list of patterns is searched for a HEAD `eq' to the car of
+VALUE. If one is found, the BODY is executed with ARGS bound to the
+corresponding values in the CDR of VALUE."
+ (let ((operator (gensym "op-"))
+ (operands (gensym "rand-"))
+ (tmp (gensym "tmp-")))
+ `(let* ((,tmp ,value)
+ (,operator (car ,tmp))
+ (,operands (cdr ,tmp)))
+ (case ,operator
+ ,@(mapcar (lambda (clause)
+ (if (eq (car clause) t)
+ `(t ,@(cdr clause))
+ (destructuring-bind ((op &rest rands) &rest body) clause
+ `(,op (destructuring-bind ,rands ,operands
+ . ,body)))))
+ patterns)
+ ,@(if (eq (caar (last patterns)) t)
+ '()
+ `((t (error "Elisp destructure-case failed: %S" ,tmp))))))))
+
+(put 'destructure-case 'lisp-indent-function 1)
+
+(defmacro slime-define-keys (keymap &rest key-command)
+ "Define keys in KEYMAP. Each KEY-COMMAND is a list of (KEY COMMAND)."
+ `(progn . ,(mapcar (lambda (k-c) `(define-key ,keymap . ,k-c))
+ key-command)))
+
+(put 'slime-define-keys 'lisp-indent-function 1)
+
+(defmacro* with-struct ((conc-name &rest slots) struct &body body)
+ "Like with-slots but works only for structs.
+\(fn (CONC-NAME &rest SLOTS) STRUCT &body BODY)"
+ (flet ((reader (slot) (intern (concat (symbol-name conc-name)
+ (symbol-name slot)))))
+ (let ((struct-var (gensym "struct")))
+ `(let ((,struct-var ,struct))
+ (symbol-macrolet
+ ,(mapcar (lambda (slot)
+ (etypecase slot
+ (symbol `(,slot (,(reader slot) ,struct-var)))
+ (cons `(,(first slot) (,(reader (second slot))
+ ,struct-var)))))
+ slots)
+ . ,body)))))
+
+(put 'with-struct 'lisp-indent-function 2)
+
+;;;;; Very-commonly-used functions
+
+(defvar slime-message-function 'message)
+
+;; Interface
+(defun slime-message (format &rest args)
+ "Like `message' but with special support for multi-line messages.
+Single-line messages use the echo area."
+ (apply slime-message-function format args))
+
+(when (or (featurep 'xemacs)
+ (= emacs-major-version 20))
+ (setq slime-message-function 'slime-format-display-message))
+
+(defun slime-format-display-message (format &rest args)
+ (slime-display-message (apply #'format format args) "*SLIME Note*"))
+
+(defun slime-display-message (message buffer-name)
+ "Display MESSAGE in the echo area or in BUFFER-NAME.
+Use the echo area if MESSAGE needs only a single line. If the MESSAGE
+requires more than one line display it in BUFFER-NAME and add a hook
+to `slime-pre-command-actions' to remove the window before the next
+command."
+ (when (get-buffer-window buffer-name) (delete-windows-on buffer-name))
+ (cond ((or (string-match "\n" message)
+ (> (length message) (1- (frame-width))))
+ (lexical-let ((buffer (get-buffer-create buffer-name)))
+ (with-current-buffer buffer
+ (erase-buffer)
+ (insert message)
+ (goto-char (point-min))
+ (let ((win (slime-create-message-window)))
+ (set-window-buffer win (current-buffer))
+ (shrink-window-if-larger-than-buffer
+ (display-buffer (current-buffer)))))
+ (push (lambda () (delete-windows-on buffer) (bury-buffer buffer))
+ slime-pre-command-actions)))
+ (t (message "%s" message))))
+
+(defun slime-create-message-window ()
+ "Create a window at the bottom of the frame, above the minibuffer."
+ (let ((previous (previous-window (minibuffer-window))))
+ (when (<= (window-height previous) (* 2 window-min-height))
+ (save-selected-window
+ (select-window previous)
+ (enlarge-window (- (1+ (* 2 window-min-height))
+ (window-height previous)))))
+ (split-window previous)))
+
+(defvar slime-background-message-function 'slime-display-oneliner)
+
+;; Interface
+(defun slime-background-message (format-string &rest format-args)
+ "Display a message in passing.
+This is like `slime-message', but less distracting because it
+will never pop up a buffer or display multi-line messages.
+It should be used for \"background\" messages such as argument lists."
+ (apply slime-background-message-function format-string format-args))
+
+(defun slime-display-oneliner (format-string &rest format-args)
+ (let* ((msg (apply #'format format-string format-args)))
+ (unless (minibuffer-window-active-p (minibuffer-window))
+ (message "%s" (slime-oneliner msg)))))
+
+(defun slime-oneliner (string)
+ "Return STRING truncated to fit in a single echo-area line."
+ (substring string 0 (min (length string)
+ (or (position ?\n string) most-positive-fixnum)
+ (1- (frame-width)))))
+
+;; Interface
+(defun slime-set-truncate-lines ()
+ "Apply `slime-truncate-lines' to the current buffer."
+ (when slime-truncate-lines
+ (set (make-local-variable 'truncate-lines) t)))
+
+;; Interface
+(defun slime-read-package-name (prompt &optional initial-value)
+ "Read a package name from the minibuffer, prompting with PROMPT."
+ (let ((completion-ignore-case t))
+ (completing-read prompt (slime-bogus-completion-alist
+ (slime-eval
+ `(swank:list-all-package-names t)))
+ nil t initial-value)))
+
+;; Interface
+(defun slime-read-symbol-name (prompt &optional query)
+ "Either read a symbol name or choose the one at point.
+The user is prompted if a prefix argument is in effect, if there is no
+symbol at point, or if QUERY is non-nil.
+
+This function avoids mistaking the REPL prompt for a symbol."
+ (cond ((or current-prefix-arg query (not (slime-symbol-name-at-point)))
+ (slime-read-from-minibuffer prompt (slime-symbol-name-at-point)))
+ (t (slime-symbol-name-at-point))))
+
+;; Interface
+(defmacro slime-propertize-region (props &rest body)
+ "Execute BODY and add PROPS to all the text it inserts.
+More precisely, PROPS are added to the region between the point's
+positions before and after executing BODY."
+ (let ((start (gensym)))
+ `(let ((,start (point)))
+ (prog1 (progn ,@body)
+ (add-text-properties ,start (point) ,props)))))
+
+(put 'slime-propertize-region 'lisp-indent-function 1)
+
+;; Interface
+(defsubst slime-insert-propertized (props &rest args)
+ "Insert all ARGS and then add text-PROPS to the inserted text."
+ (slime-propertize-region props (apply #'insert args)))
+
+(defmacro slime-with-rigid-indentation (level &rest body)
+ "Execute BODY and then rigidly indent its text insertions.
+Assumes all insertions are made at point."
+ (let ((start (gensym)) (l (gensym)))
+ `(let ((,start (point)) (,l ,(or level '(current-column))))
+ (prog1 (progn ,@body)
+ (slime-indent-rigidly ,start (point) ,l)))))
+
+(put 'slime-with-rigid-indentation 'lisp-indent-function 1)
+
+(defun slime-indent-rigidly (start end column)
+ ;; Similar to `indent-rigidly' but doesn't inherit text props.
+ (save-excursion
+ (goto-char end)
+ (beginning-of-line)
+ (while (and (<= start (point))
+ (progn
+ (save-excursion (insert-char ?\ column))
+ (zerop (forward-line -1)))))))
+
+(defun slime-insert-indented (&rest strings)
+ "Insert all arguments rigidly indented."
+ (slime-with-rigid-indentation nil
+ (apply #'insert strings)))
+
+(defun slime-curry (fun &rest args)
+ `(lambda (&rest more) (apply ',fun (append ',args more))))
+
+(defun slime-rcurry (fun &rest args)
+ `(lambda (&rest more) (apply ',fun (append more ',args))))
+
+;;;;; Snapshots of current Emacs state
+
+;;; Window configurations do not save (and hence not restore)
+;;; any narrowing that could be applied to a buffer.
+;;;
+;;; For this purpose, we introduce a superset of a window
+;;; configuration that does include the necessary information to
+;;; properly restore narrowing.
+;;;
+;;; We call this superset an Emacs Snapshot.
+
+(defstruct (slime-narrowing-configuration
+ (:conc-name slime-narrowing-configuration.))
+ narrowedp beg end)
+
+(defstruct (slime-emacs-snapshot (:conc-name slime-emacs-snapshot.))
+ window-configuration narrowing-configuration)
+
+(defun slime-current-narrowing-configuration (&optional buffer)
+ (with-current-buffer (or buffer (current-buffer))
+ (make-slime-narrowing-configuration :narrowedp (slime-buffer-narrowed-p)
+ :beg (point-min-marker)
+ :end (point-max-marker))))
+
+(defun slime-set-narrowing-configuration (narrowing-cfg)
+ (when (slime-narrowing-configuration.narrowedp narrowing-cfg)
+ (narrow-to-region (slime-narrowing-configuration.beg narrowing-cfg)
+ (slime-narrowing-configuration.end narrowing-cfg))))
+
+(defun slime-current-emacs-snapshot (&optional frame)
+ "Returns a snapshot of the current state of FRAME, or the
+currently active frame if FRAME is not given respectively."
+ (with-current-buffer
+ (if frame
+ (window-buffer (frame-selected-window (selected-frame)))
+ (current-buffer))
+ (make-slime-emacs-snapshot
+ :window-configuration (current-window-configuration frame)
+ :narrowing-configuration (slime-current-narrowing-configuration))))
+
+(defun slime-set-emacs-snapshot (snapshot)
+ "Restores the state of Emacs according to the information saved
+in SNAPSHOT."
+ (let ((window-cfg (slime-emacs-snapshot.window-configuration snapshot))
+ (narrowing-cfg (slime-emacs-snapshot.narrowing-configuration snapshot)))
+ (set-window-configuration window-cfg) ; restores previously current buffer.
+ (slime-set-narrowing-configuration narrowing-cfg)))
+
+(defun slime-current-emacs-snapshot-fingerprint (&optional frame)
+ "Return a fingerprint of the current emacs snapshot.
+Fingerprints are `equalp' if and only if they represent window
+configurations that are very similar (same windows and buffers.)
+
+Unlike real window-configuration objects, fingerprints are not
+sensitive to the point moving and they can't be restored."
+ (mapcar (lambda (window) (list window (window-buffer window)))
+ (slime-frame-windows frame)))
+
+(defun slime-frame-windows (&optional frame)
+ "Return the list of windows in FRAME."
+ (loop with last-window = (previous-window (frame-first-window frame))
+ for window = (frame-first-window frame) then (next-window window)
+ collect window
+ until (eq window last-window)))
+
+
+(defmacro save-restriction-if-possible (&rest body)
+ "Very similiarly to `save-restriction'. The only difference is
+that it's not enforcing the restriction as strictly: It's only
+enforced if `point' was not moved outside of the restriction
+after executing BODY.
+
+Example:
+
+ (progn (goto-line 1000)
+ (narrow-to-page)
+ (save-restriction-if-possible (widen) (goto-line 999)))
+
+ In this case, the buffer is narrowed to the current page, and
+ point is on line 999.
+
+ (progn (goto-char 1000)
+ (narrow-to-page)
+ (save-restriction-if-possible (widen) (goto-line 1)))
+
+ Whereas in this case, the buffer is widened and point is on
+ line 1."
+ (let ((gcfg (gensym "NARROWING-CFG+"))
+ (gbeg (gensym "OLDBEG+"))
+ (gend (gensym "OLDEND+")))
+ `(let ((,gcfg (slime-current-narrowing-configuration)))
+ (unwind-protect (progn ,@body)
+ (let ((,gbeg (slime-narrowing-configuration.beg ,gcfg))
+ (,gend (slime-narrowing-configuration.end ,gcfg)))
+ (when (and (>= (point) ,gbeg) (<= (point) ,gend))
+ (slime-set-narrowing-configuration ,gcfg)))))))
+
+(put 'save-restriction-if-possible 'lisp-indent-function 0)
+
+;;;;; Temporary popup buffers
+
+(make-variable-buffer-local
+ (defvar slime-temp-buffer-saved-emacs-snapshot nil
+ "The snapshot of the current state in Emacs before the temp-buffer
+was displayed, so that this state can be restored later on.
+Buffer local in temp-buffers."))
+
+(make-variable-buffer-local
+ (defvar slime-temp-buffer-saved-fingerprint nil
+ "The emacs snapshot \"fingerprint\" after displaying the buffer."))
+
+;; Interface
+(defun* slime-get-temp-buffer-create (name &key mode noselectp reusep
+ emacs-snapshot)
+ "Return a fresh temporary buffer called NAME in MODE.
+The buffer also uses the minor-mode `slime-temp-buffer-mode'. Pressing
+`q' in the buffer will restore the window configuration to the way it
+is when the buffer was created, i.e. when this function was called.
+
+If NOSELECTP is true, then the buffer is shown by `display-buffer',
+otherwise it is shown and selected by `pop-to-buffer'.
+
+If REUSEP is true and a buffer does already exist with name NAME,
+then the buffer will be reused instead of being killed.
+
+If EMACS-SNAPSHOT is non-NIL, it's used to restore the previous
+state of Emacs after closing the temporary buffer. Otherwise, the
+current state will be saved and later restored.
+"
+ (let ((snapshot (or emacs-snapshot (slime-current-emacs-snapshot)))
+ (buffer (get-buffer name)))
+ (when (and buffer (not reusep))
+ (kill-buffer name)
+ (setq buffer nil))
+ (with-current-buffer (or buffer (get-buffer-create name))
+ (when mode
+ (let ((original-configuration slime-temp-buffer-saved-emacs-snapshot)
+ (original-fingerprint slime-temp-buffer-saved-fingerprint))
+ (funcall mode)
+ (setq slime-temp-buffer-saved-emacs-snapshot original-configuration)
+ (setq slime-temp-buffer-saved-fingerprint original-fingerprint)))
+ (slime-temp-buffer-mode 1)
+ (let ((window (get-buffer-window (current-buffer))))
+ (if window
+ (unless noselectp
+ (select-window window))
+ (progn
+ (if noselectp
+ (display-buffer (current-buffer) t)
+ (pop-to-buffer (current-buffer))
+ (selected-window))
+ (setq slime-temp-buffer-saved-emacs-snapshot snapshot)
+ (setq slime-temp-buffer-saved-fingerprint
+ (slime-current-emacs-snapshot-fingerprint)))))
+ (current-buffer))))
+
+;; Interface
+(defmacro* slime-with-output-to-temp-buffer ((name &key mode reusep)
+ package &rest body)
+ "Similar to `with-output-to-temp-buffer'.
+Also saves the current state of Emacs (window configuration &c),
+and inherits the current `slime-connection' in a buffer-local
+variable. Cf. `slime-get-temp-buffer-create'"
+ `(let ((connection (slime-connection))
+ (standard-output (slime-get-temp-buffer-create ,name :mode ',mode
+ :reusep ,reusep)))
+ (prog1 (with-current-buffer standard-output
+ ;; set explicitely to NIL in case the buffer got reused. (REUSEP)
+ (let ((buffer-read-only nil)) ,@body))
+ (with-current-buffer standard-output
+ (setq slime-buffer-connection connection)
+ (setq slime-buffer-package ,package)
+ (goto-char (point-min))
+ (slime-mode 1)
+ (set-syntax-table lisp-mode-syntax-table)
+ (setq buffer-read-only t)))))
+
+(put 'slime-with-output-to-temp-buffer 'lisp-indent-function 2)
+
+(define-minor-mode slime-temp-buffer-mode
+ "Mode for displaying read only stuff"
+ nil
+ " temp"
+ '(("q" . slime-temp-buffer-quit)))
+
+;; Interface
+(defun slime-temp-buffer-quit (&optional kill-buffer-p)
+ "Get rid of the current (temp) buffer without asking. Restore the
+window configuration unless it was changed since we last activated the buffer."
+ (interactive)
+ (let ((snapshot slime-temp-buffer-saved-emacs-snapshot)
+ (temp-buffer (current-buffer)))
+ (setq slime-temp-buffer-saved-emacs-snapshot nil)
+ (if (and snapshot (equalp (slime-current-emacs-snapshot-fingerprint)
+ slime-temp-buffer-saved-fingerprint))
+ (slime-set-emacs-snapshot snapshot)
+ (bury-buffer))
+ (when kill-buffer-p
+ (kill-buffer temp-buffer))))
+
+;;;;; Filename translation
+;;;
+;;; Filenames passed between Emacs and Lisp should be translated using
+;;; these functions. This way users who run Emacs and Lisp on separate
+;;; machines have a chance to integrate file operations somehow.
+
+(defun slime-to-lisp-filename (filename)
+ "Translate the string FILENAME to a Lisp filename.
+See `slime-filename-translations'."
+ (funcall (first (slime-find-filename-translators (slime-machine-instance)))
+ (expand-file-name filename)))
+
+(defun slime-from-lisp-filename (filename)
+ "Translate the Lisp filename FILENAME to an Emacs filename.
+See `slime-filename-translations'."
+ (funcall (second (slime-find-filename-translators (slime-machine-instance)))
+ filename))
+
+(defun slime-find-filename-translators (hostname)
+ (cond ((and hostname slime-filename-translations)
+ (or (cdr (assoc-if (lambda (regexp) (string-match regexp hostname))
+ slime-filename-translations))
+ (error "No filename-translations for hostname: %s" hostname)))
+ (t (list #'identity #'identity))))
+
+
+;;;; Starting SLIME
+;;;
+;;; This section covers starting an inferior-lisp, compiling and
+;;; starting the server, initiating a network connection.
+
+;;;;; Entry points
+
+;; We no longer load inf-lisp, but we use this variable for backward
+;; compatibility.
+(defvar inferior-lisp-program "lisp"
+ "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.")
+
+(defvar slime-lisp-implementations nil
+ "*A list of known Lisp implementations.
+The list should have the form:
+ ((NAME (PROGRAM PROGRAM-ARGS...) &key INIT CODING-SYSTEM) ...)
+
+NAME is a symbol for the implementation.
+PROGRAM and PROGRAM-ARGS are strings used to start the Lisp process.
+INIT is a function that should return a string to load and start
+ Swank. The function will be called with the PORT-FILENAME and ENCODING as
+ arguments. INIT defaults to `slime-init-command'.
+CODING-SYSTEM a symbol for the coding system. The default is
+ slime-net-coding-system
+
+Here's an example:
+ ((cmucl (\"/opt/cmucl/bin/lisp\" \"-quiet\") :init slime-init-command)
+ (acl (\"acl7\") :coding-system emacs-mule))")
+
+(defvar slime-default-lisp nil
+ "*The name of the default Lisp implementation.
+See `slime-lisp-implementations'")
+
+(defvar slime-lisp-host "127.0.0.1"
+ "The default hostname (or IP address) to connect to.")
+
+;; dummy definitions for the compiler
+(defvar slime-net-coding-system)
+(defvar slime-net-processes)
+(defvar slime-default-connection)
+
+(defun slime (&optional command coding-system)
+ "Start an inferior^_superior Lisp and connect to its Swank server."
+ (interactive)
+ (let ((inferior-lisp-program (or command inferior-lisp-program))
+ (slime-net-coding-system (or coding-system slime-net-coding-system)))
+ (slime-start* (slime-read-interactive-args))))
+
+(defvar slime-inferior-lisp-program-history '()
+ "History list of command strings. Used by `slime'.")
+
+(defun slime-read-interactive-args ()
+ "Return the list of args which should be passed to `slime-start'.
+
+The rules for selecting the arguments are rather complicated:
+
+- In the most common case, i.e. if there's no prefix-arg in
+ effect and if `slime-lisp-implementations' is nil, use
+ `inferior-lisp-program' as fallback.
+
+- If the table `slime-lisp-implementations' is non-nil use the
+ implementation with name `slime-default-lisp' or if that's nil
+ the first entry in the table.
+
+- If the prefix-arg is `-', prompt for one of the registered
+ lisps.
+
+- If the prefix-arg is positive, read the command to start the
+ process."
+ (let ((table slime-lisp-implementations))
+ (cond ((not current-prefix-arg) (slime-lisp-options))
+ ((eq current-prefix-arg '-)
+ (let ((key (completing-read
+ "Lisp name: " (mapcar (lambda (x)
+ (list (symbol-name (car x))))
+ table)
+ nil t)))
+ (slime-lookup-lisp-implementation table (intern key))))
+ (t
+ (destructuring-bind (program &rest program-args)
+ (split-string (read-string
+ "Run lisp: " inferior-lisp-program
+ 'slime-inferior-lisp-program-history))
+ (let ((coding-system
+ (if (eq 16 (prefix-numeric-value current-prefix-arg))
+ (read-coding-system "set slime-coding-system: "
+ slime-net-coding-system)
+ slime-net-coding-system)))
+ (list :program program :program-args program-args
+ :coding-system coding-system)))))))
+
+(defun slime-lisp-options (&optional name)
+ (let ((table slime-lisp-implementations))
+ (assert (or (not name) table))
+ (cond (table (slime-lookup-lisp-implementation slime-lisp-implementations
+ (or name slime-default-lisp
+ (car (car table)))))
+ (t (destructuring-bind (program &rest args)
+ (split-string inferior-lisp-program)
+ (list :program program :program-args args))))))
+
+(defun slime-lookup-lisp-implementation (table name)
+ (destructuring-bind (name (prog &rest args) &rest keys) (assoc name table)
+ (list* :name name :program prog :program-args args keys)))
+
+(defun* slime-start (&key (program inferior-lisp-program) program-args
+ directory
+ (coding-system slime-net-coding-system)
+ (init 'slime-init-command)
+ name
+ (buffer "*inferior-lisp*")
+ init-function)
+ (let ((args (list :program program :program-args program-args :buffer buffer
+ :coding-system coding-system :init init :name name
+ :init-function init-function)))
+ (slime-check-coding-system coding-system)
+ (when (slime-bytecode-stale-p)
+ (slime-urge-bytecode-recompile))
+ (let ((proc (slime-maybe-start-lisp program program-args
+ directory buffer)))
+ (slime-inferior-connect proc args)
+ (pop-to-buffer (process-buffer proc)))))
+
+(defun slime-start* (options)
+ (apply #'slime-start options))
+
+(defun slime-connect (host port &optional coding-system)
+ "Connect to a running Swank server."
+ (interactive (list (read-from-minibuffer "Host: " slime-lisp-host)
+ (read-from-minibuffer "Port: " "4005" nil t)))
+ (when (and (interactive-p) slime-net-processes
+ (y-or-n-p "Close old connections first? "))
+ (slime-disconnect))
+ (message "Connecting to Swank on port %S.." port)
+ (let ((coding-system (or coding-system slime-net-coding-system)))
+ (slime-check-coding-system coding-system)
+ (message "Connecting to Swank on port %S.." port)
+ (let* ((process (slime-net-connect host port coding-system))
+ (slime-dispatching-connection process))
+ (slime-setup-connection process))))
+
+(defun slime-start-and-load (filename &optional package)
+ "Start Slime, if needed, load the current file and set the package."
+ (interactive (list (expand-file-name (buffer-file-name))
+ (slime-find-buffer-package)))
+ (cond ((slime-connected-p)
+ (slime-load-file-set-package filename package))
+ (t
+ (slime-start-and-init (slime-lisp-options)
+ (slime-curry #'slime-start-and-load
+ filename package)))))
+
+(defun slime-start-and-init (options fun)
+ (let* ((rest (plist-get options :init-function))
+ (init (cond (rest `(lambda () (funcall ',rest) (funcall ',fun)))
+ (t fun))))
+ (slime-start* (plist-put (copy-list options) :init-function init))))
+
+(defun slime-load-file-set-package (filename package)
+ (let ((filename (slime-to-lisp-filename filename)))
+ (slime-eval-async `(swank:load-file-set-package ,filename ,package)
+ (lambda (package)
+ (when package
+ (slime-repl-set-package (second package)))))))
+
+;;;;; Start inferior lisp
+;;;
+;;; Here is the protocol for starting SLIME:
+;;;
+;;; 0. Emacs recompiles/reloads slime.elc if it exists and is stale.
+;;; 1. Emacs starts an inferior Lisp process.
+;;; 2. Emacs tells Lisp (via stdio) to load and start Swank.
+;;; 3. Lisp recompiles the Swank if needed.
+;;; 4. Lisp starts the Swank server and writes its TCP port to a temp file.
+;;; 5. Emacs reads the temp file to get the port and then connects.
+;;; 6. Emacs prints a message of warm encouragement for the hacking ahead.
+;;;
+;;; Between steps 2-5 Emacs polls for the creation of the temp file so
+;;; that it can make the connection. This polling may continue for a
+;;; fair while if Swank needs recompilation.
+
+(defvar slime-connect-retry-timer nil
+ "Timer object while waiting for an inferior-lisp to start.")
+
+;;; Recompiling bytecode:
+
+(defun slime-bytecode-stale-p ()
+ "Return true if slime.elc is older than slime.el."
+ (when-let (libfile (locate-library "slime"))
+ (let* ((basename (file-name-sans-extension libfile))
+ (sourcefile (concat basename ".el"))
+ (bytefile (concat basename ".elc")))
+ (and (file-exists-p bytefile)
+ (file-newer-than-file-p sourcefile bytefile)))))
+
+(defun slime-recompile-bytecode ()
+ "Recompile and reload slime.
+Warning: don't use this in XEmacs, it seems to crash it!"
+ (interactive)
+ (let ((sourcefile (concat (file-name-sans-extension (locate-library "slime"))
+ ".el")))
+ (byte-compile-file sourcefile t)))
+
+(defun slime-urge-bytecode-recompile ()
+ "Urge the user to recompile slime.elc.
+Return true if we have been given permission to continue."
+ (cond ((featurep 'xemacs)
+ ;; My XEmacs crashes and burns if I recompile/reload an elisp
+ ;; file from itself. So they have to do it themself.
+ (or (y-or-n-p "slime.elc is older than source. Continue? ")
+ (signal 'quit nil)))
+ ((y-or-n-p "slime.elc is older than source. Recompile first? ")
+ (slime-recompile-bytecode))
+ (t)))
+
+(defun slime-abort-connection ()
+ "Abort connection the current connection attempt."
+ (interactive)
+ (cond (slime-connect-retry-timer
+ (slime-cancel-connect-retry-timer)
+ (message "Cancelled connection attempt."))
+ (t (error "Not connecting"))))
+
+;;; Starting the inferior Lisp and loading Swank:
+
+(defun slime-maybe-start-lisp (program program-args directory buffer)
+ "Return a new or existing inferior lisp process."
+ (cond ((not (comint-check-proc buffer))
+ (slime-start-lisp program program-args directory buffer))
+ ((slime-reinitialize-inferior-lisp-p program program-args buffer)
+ (when-let (conn (find (get-buffer-process buffer) slime-net-processes
+ :key #'slime-inferior-process))
+ (slime-net-close conn))
+ (get-buffer-process buffer))
+ (t (slime-start-lisp program program-args
+ directory
+ (generate-new-buffer-name buffer)))))
+
+(defun slime-reinitialize-inferior-lisp-p (program program-args buffer)
+ (let ((args (slime-inferior-lisp-args (get-buffer-process buffer))))
+ (and (equal (plist-get args :program) program)
+ (equal (plist-get args :program-args) program-args)
+ (not (y-or-n-p "Create an additional *inferior-lisp*? ")))))
+
+(defun slime-start-lisp (program program-args directory buffer)
+ "Does the same as `inferior-lisp' but less ugly.
+Return the created process."
+ (with-current-buffer (get-buffer-create buffer)
+ (when directory
+ (cd (expand-file-name directory)))
+ (comint-mode)
+ (comint-exec (current-buffer) "inferior-lisp" program nil program-args)
+ (lisp-mode-variables t)
+ (let ((proc (get-buffer-process (current-buffer))))
+ (slime-set-query-on-exit-flag proc)
+ proc)))
+
+(defun slime-inferior-connect (process args)
+ "Start a Swank server in the inferior Lisp and connect."
+ (slime-delete-swank-port-file 'quiet)
+ (slime-start-swank-server process args)
+ (slime-read-port-and-connect process nil))
+
+(defvar slime-inferior-lisp-args nil
+ "A buffer local variable in the inferior proccess.")
+
+(defun slime-start-swank-server (process args)
+ "Start a Swank server on the inferior lisp."
+ (destructuring-bind (&key coding-system init &allow-other-keys) args
+ (with-current-buffer (process-buffer process)
+ (make-local-variable 'slime-inferior-lisp-args)
+ (setq slime-inferior-lisp-args args)
+ (let ((str (funcall init (slime-swank-port-file) coding-system)))
+ (goto-char (process-mark process))
+ (insert-before-markers str)
+ (process-send-string process str)))))
+
+(defun slime-inferior-lisp-args (process)
+ (with-current-buffer (process-buffer process)
+ slime-inferior-lisp-args))
+
+;; XXX load-server & start-server used to be separated. maybe that was better.
+(defun slime-init-command (port-filename coding-system)
+ "Return a string to initialize Lisp."
+ (let ((loader (if (file-name-absolute-p slime-backend)
+ slime-backend
+ (concat slime-path slime-backend)))
+ (encoding (slime-coding-system-cl-name coding-system)))
+ ;; Return a single form to avoid problems with buffered input.
+ (format "%S\n\n"
+ `(progn
+ (load ,(expand-file-name loader) :verbose t)
+ (funcall (read-from-string "swank:start-server")
+ ,port-filename
+ :coding-system ,encoding)))))
+
+(defun slime-swank-port-file ()
+ "Filename where the SWANK server writes its TCP port number."
+ (concat (file-name-as-directory
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ (t "/tmp/")))
+ (format "slime.%S" (emacs-pid))))
+
+(defun slime-delete-swank-port-file (&optional quiet)
+ (condition-case data
+ (delete-file (slime-swank-port-file))
+ (error
+ (ecase quiet
+ ((nil) (signal (car data) (cdr data)))
+ (quiet)
+ (message (message "Unable to delete swank port file %S"
+ (slime-swank-port-file)))))))
+
+(defun slime-read-port-and-connect (inferior-process retries)
+ (slime-cancel-connect-retry-timer)
+ (slime-attempt-connection inferior-process retries 1))
+
+(defun slime-attempt-connection (process retries attempt)
+ ;; A small one-state machine to attempt a connection with
+ ;; timer-based retries.
+ (let ((file (slime-swank-port-file)))
+ (unless (active-minibuffer-window)
+ (message "Polling %S.. (Abort with `M-x slime-abort-connection'.)" file))
+ (unless (slime-connected-p)
+ (slime-set-state (format "[polling:%S]" attempt)))
+ (slime-cancel-connect-retry-timer)
+ (cond ((and (file-exists-p file)
+ (> (nth 7 (file-attributes file)) 0)) ; file size
+ (let ((port (slime-read-swank-port))
+ (args (slime-inferior-lisp-args process)))
+ (slime-delete-swank-port-file 'message)
+ (let ((c (slime-connect slime-lisp-host port
+ (plist-get args :coding-system))))
+ (slime-set-inferior-process c process))))
+ ((and retries (zerop retries))
+ (message "Failed to connect to Swank."))
+ (t
+ (when (and (file-exists-p file)
+ (zerop (nth 7 (file-attributes file))))
+ (message "(Zero length port file)")
+ ;; the file may be in the filesystem but not yet written
+ (unless retries (setq retries 3)))
+ (setq slime-connect-retry-timer
+ (run-with-timer 0.3 nil
+ #'slime-timer-call #'slime-attempt-connection
+ process (and retries (1- retries))
+ (1+ attempt)))))))
+
+(defun slime-timer-call (fun &rest args)
+ "Call function FUN with ARGS, reporting all errors.
+
+The default condition handler for timer functions (see
+`timer-event-handler') ignores errors."
+ (condition-case data
+ (apply fun args)
+ (error (debug nil (list "Error in timer" fun args data)))))
+
+(defun slime-cancel-connect-retry-timer ()
+ (when slime-connect-retry-timer
+ (cancel-timer slime-connect-retry-timer)
+ (setq slime-connect-retry-timer nil)))
+
+(defun slime-read-swank-port ()
+ "Read the Swank server port number from the `slime-swank-port-file'."
+ (save-excursion
+ (with-temp-buffer
+ (insert-file-contents (slime-swank-port-file))
+ (goto-char (point-min))
+ (let ((port (read (current-buffer))))
+ (assert (integerp port))
+ port))))
+
+(defun slime-hide-inferior-lisp-buffer ()
+ "Display the REPL buffer instead of the *inferior-lisp* buffer."
+ (let* ((buffer (if (slime-process)
+ (process-buffer (slime-process))))
+ (window (if buffer (get-buffer-window buffer)))
+ (repl-buffer (slime-output-buffer t))
+ (repl-window (get-buffer-window repl-buffer)))
+ (when buffer
+ (bury-buffer buffer))
+ (cond (repl-window
+ (when window
+ (delete-window window)))
+ (window
+ (set-window-buffer window repl-buffer))
+ (t
+ (pop-to-buffer repl-buffer)
+ (goto-char (point-max))))))
+
+;;; Words of encouragement
+
+(defun slime-user-first-name ()
+ (let ((name (if (string= (user-full-name) "")
+ (user-login-name)
+ (user-full-name))))
+ (string-match "^[^ ]*" name)
+ (capitalize (match-string 0 name))))
+
+(defvar slime-words-of-encouragement
+ `("Let the hacking commence!"
+ "Hacks and glory await!"
+ "Hack and be merry!"
+ "Your hacking starts... NOW!"
+ "May the source be with you!"
+ "Take this REPL, brother, and may it serve you well."
+ "Lemonodor-fame is but a hack away!"
+ ,(format "%s, this could be the start of a beautiful program."
+ (slime-user-first-name)))
+ "Scientifically-proven optimal words of hackerish encouragement.")
+
+(defun slime-random-words-of-encouragement ()
+ "Return a string of hackerish encouragement."
+ (eval (nth (random (length slime-words-of-encouragement))
+ slime-words-of-encouragement)))
+
+
+;;;; Networking
+;;;
+;;; This section covers the low-level networking: establishing
+;;; connections and encoding/decoding protocol messages.
+;;;
+;;; Each SLIME protocol message beings with a 3-byte length header
+;;; followed by an S-expression as text. The sexp must be readable
+;;; both by Emacs and by Common Lisp, so if it contains any embedded
+;;; code fragments they should be sent as strings.
+;;;
+;;; The set of meaningful protocol messages are not specified
+;;; here. They are defined elsewhere by the event-dispatching
+;;; functions in this file and in swank.lisp.
+
+(defvar slime-net-processes nil
+ "List of processes (sockets) connected to Lisps.")
+
+(defvar slime-net-process-close-hooks '()
+ "List of functions called when a slime network connection closes.
+The functions are called with the process as their argument.")
+
+(defun slime-secret ()
+ "Finds the magic secret from the user's home directory.
+Returns nil if the file doesn't exist or is empty; otherwise the first
+line of the file."
+ (condition-case err
+ (with-temp-buffer
+ (insert-file-contents "~/.slime-secret")
+ (goto-char (point-min))
+ (buffer-substring (point-min) (line-end-position)))
+ (file-error nil)))
+
+;;; Interface
+(defun slime-net-connect (host port coding-system)
+ "Establish a connection with a CL."
+ (let* ((inhibit-quit nil)
+ (proc (open-network-stream "SLIME Lisp" nil host port))
+ (buffer (slime-make-net-buffer " *cl-connection*")))
+ (push proc slime-net-processes)
+ (set-process-buffer proc buffer)
+ (set-process-filter proc 'slime-net-filter)
+ (set-process-sentinel proc 'slime-net-sentinel)
+ (slime-set-query-on-exit-flag proc)
+ (when (fboundp 'set-process-coding-system)
+ (slime-check-coding-system coding-system)
+ (set-process-coding-system proc coding-system coding-system))
+ (when-let (secret (slime-secret))
+ (slime-net-send secret proc))
+ proc))
+
+(defun slime-make-net-buffer (name)
+ "Make a buffer suitable for a network process."
+ (let ((buffer (generate-new-buffer name)))
+ (with-current-buffer buffer
+ (buffer-disable-undo))
+ buffer))
+
+(defun slime-set-query-on-exit-flag (process)
+ "Set PROCESS's query-on-exit-flag to `slime-kill-without-query-p'."
+ (when slime-kill-without-query-p
+ ;; avoid byte-compiler warnings
+ (let ((fun (if (fboundp 'set-process-query-on-exit-flag)
+ 'set-process-query-on-exit-flag
+ 'process-kill-without-query)))
+ (funcall fun process nil))))
+
+;;;;; Coding system madness
+
+(defvar slime-net-valid-coding-systems
+ '((iso-latin-1-unix nil "iso-latin-1-unix")
+ (iso-8859-1-unix nil "iso-latin-1-unix")
+ (binary nil "iso-latin-1-unix")
+ (utf-8-unix t "utf-8-unix")
+ (emacs-mule-unix t "emacs-mule-unix")
+ (euc-jp-unix t "euc-jp-unix"))
+ "A list of valid coding systems.
+Each element is of the form: (NAME MULTIBYTEP CL-NAME)")
+
+(defun slime-find-coding-system (name)
+ "Return the coding system for the symbol NAME.
+The result is either an element in `slime-net-valid-coding-systems'
+of nil."
+ (let* ((probe (assq name slime-net-valid-coding-systems)))
+ (if (and probe (if (fboundp 'check-coding-system)
+ (ignore-errors (check-coding-system (car probe)))
+ (eq (car probe) 'binary)))
+ probe)))
+
+(defvar slime-net-coding-system
+ (find-if 'slime-find-coding-system
+ '(iso-latin-1-unix iso-8859-1-unix binary))
+ "*Coding system used for network connections.
+See also `slime-net-valid-coding-systems'.")
+
+(defun slime-check-coding-system (coding-system)
+ "Signal an error if CODING-SYSTEM isn't a valid coding system."
+ (interactive)
+ (let ((props (slime-find-coding-system coding-system)))
+ (unless props
+ (error "Invalid slime-net-coding-system: %s. %s"
+ coding-system (mapcar #'car slime-net-valid-coding-systems)))
+ (when (and (second props) (boundp 'default-enable-multibyte-characters))
+ (assert default-enable-multibyte-characters))
+ t))
+
+(defcustom slime-repl-history-file-coding-system
+ (cond ((slime-find-coding-system 'utf-8-unix) 'utf-8-unix)
+ (t slime-net-coding-system))
+ "*The coding system for the history file."
+ :type 'symbol
+ :group 'slime-repl)
+
+(defun slime-coding-system-mulibyte-p (coding-system)
+ (second (slime-find-coding-system coding-system)))
+
+(defun slime-coding-system-cl-name (coding-system)
+ (third (slime-find-coding-system coding-system)))
+
+;;; Interface
+(defun slime-net-send (sexp proc)
+ "Send a SEXP to Lisp over the socket PROC.
+This is the lowest level of communication. The sexp will be READ and
+EVAL'd by Lisp."
+ (let* ((msg (concat (slime-prin1-to-string sexp) "\n"))
+ (string (concat (slime-net-encode-length (length msg)) msg))
+ (coding-system (cdr (process-coding-system proc))))
+ (slime-log-event sexp)
+ (cond ((slime-safe-encoding-p coding-system string)
+ (process-send-string proc string))
+ (t (error "Coding system %s not suitable for %S"
+ coding-system string)))))
+
+(defun slime-safe-encoding-p (coding-system string)
+ "Return true iff CODING-SYSTEM can safely encode STRING."
+ (if (featurep 'xemacs)
+ ;; FIXME: XEmacs encodes non-encodeable chars as ?~ automatically
+ t
+ (or (let ((candidates (find-coding-systems-string string))
+ (base (coding-system-base coding-system)))
+ (or (equal candidates '(undecided))
+ (memq base candidates)))
+ (and (not (multibyte-string-p string))
+ (not (slime-coding-system-mulibyte-p coding-system))))))
+
+(defun slime-net-close (process &optional debug)
+ (setq slime-net-processes (remove process slime-net-processes))
+ (when (eq process slime-default-connection)
+ (setq slime-default-connection nil))
+ (cond (debug
+ (set-process-sentinel process 'ignore)
+ (set-process-filter process 'ignore)
+ (delete-process process))
+ (t
+ (run-hook-with-args 'slime-net-process-close-hooks process)
+ ;; killing the buffer also closes the socket
+ (kill-buffer (process-buffer process)))))
+
+(defun slime-net-sentinel (process message)
+ (message "Lisp connection closed unexpectedly: %s" message)
+ (slime-net-close process)
+ (slime-set-state "[not connected]" process))
+
+;;; Socket input is handled by `slime-net-filter', which decodes any
+;;; complete messages and hands them off to the event dispatcher.
+
+(defun slime-net-filter (process string)
+ "Accept output from the socket and process all complete messages."
+ (with-current-buffer (process-buffer process)
+ (goto-char (point-max))
+ (insert string))
+ (slime-process-available-input process))
+
+(defun slime-run-when-idle (function &rest args)
+ "Call FUNCTION as soon as Emacs is idle."
+ (apply #'run-at-time
+ (if (featurep 'xemacs) itimer-short-interval 0)
+ nil function args))
+
+(defun slime-process-available-input (process)
+ "Process all complete messages that have arrived from Lisp."
+ (with-current-buffer (process-buffer process)
+ (while (slime-net-have-input-p)
+ (let ((event (slime-net-read-or-lose process))
+ (ok nil))
+ (slime-log-event event)
+ (unwind-protect
+ (save-current-buffer
+ (slime-dispatch-event event process)
+ (setq ok t))
+ (unless ok
+ (slime-run-when-idle 'slime-process-available-input process)))))))
+
+(defun slime-net-have-input-p ()
+ "Return true if a complete message is available."
+ (goto-char (point-min))
+ (and (>= (buffer-size) 6)
+ (>= (- (buffer-size) 6) (slime-net-decode-length))))
+
+(defun slime-net-read-or-lose (process)
+ (condition-case error
+ (slime-net-read)
+ (error
+ (debug)
+ (slime-net-close process t)
+ (error "net-read error: %S" error))))
+
+(defun slime-net-read ()
+ "Read a message from the network buffer."
+ (goto-char (point-min))
+ (let* ((length (slime-net-decode-length))
+ (start (+ 6 (point)))
+ (end (+ start length)))
+ (assert (plusp length))
+ (let ((string (buffer-substring-no-properties start end)))
+ (prog1 (read string)
+ (delete-region (point-min) end)))))
+
+(defun slime-net-decode-length ()
+ "Read a 24-bit hex-encoded integer from buffer."
+ (string-to-number (buffer-substring-no-properties (point) (+ (point) 6)) 16))
+
+(defun slime-net-encode-length (n)
+ "Encode an integer into a 24-bit hex string."
+ (format "%06x" n))
+
+(defun slime-prin1-to-string (sexp)
+ "Like `prin1-to-string' but don't octal-escape non-ascii characters.
+This is more compatible with the CL reader."
+ (with-temp-buffer
+ (let ((print-escape-nonascii nil)
+ (print-escape-newlines nil))
+ (prin1 sexp (current-buffer))
+ (buffer-string))))
+
+
+;;;; Connections
+;;;
+;;; "Connections" are the high-level Emacs<->Lisp networking concept.
+;;;
+;;; Emacs has a connection to each Lisp process that it's interacting
+;;; with. Typically there would only be one, but a user can choose to
+;;; connect to many Lisps simultaneously.
+;;;
+;;; A connection consists of a control socket, optionally an extra
+;;; socket dedicated to receiving Lisp output (an optimization), and a
+;;; set of connection-local state variables.
+;;;
+;;; The state variables are stored as buffer-local variables in the
+;;; control socket's process-buffer and are used via accessor
+;;; functions. These variables include things like the *FEATURES* list
+;;; and Unix Pid of the Lisp process.
+;;;
+;;; One connection is "current" at any given time. This is:
+;;; `slime-dispatching-connection' if dynamically bound, or
+;;; `slime-buffer-connection' if this is set buffer-local, or
+;;; `slime-default-connection' otherwise.
+;;;
+;;; When you're invoking commands in your source files you'll be using
+;;; `slime-default-connection'. This connection can be interactively
+;;; reassigned via the connection-list buffer.
+;;;
+;;; When a command creates a new buffer it will set
+;;; `slime-buffer-connection' so that commands in the new buffer will
+;;; use the connection that the buffer originated from. For example,
+;;; the apropos command creates the *Apropos* buffer and any command
+;;; in that buffer (e.g. `M-.') will go to the same Lisp that did the
+;;; apropos search. REPL buffers are similarly tied to their
+;;; respective connections.
+;;;
+;;; When Emacs is dispatching some network message that arrived from a
+;;; connection it will dynamically bind `slime-dispatching-connection'
+;;; so that the event will be processed in the context of that
+;;; connection.
+;;;
+;;; This is mostly transparent. The user should be aware that he can
+;;; set the default connection to pick which Lisp handles commands in
+;;; Lisp-mode source buffers, and slime hackers should be aware that
+;;; they can tie a buffer to a specific connection. The rest takes
+;;; care of itself.
+
+(defvar slime-dispatching-connection nil
+ "Network process currently executing.
+This is dynamically bound while handling messages from Lisp; it
+overrides `slime-buffer-connection' and `slime-default-connection'.")
+
+(make-variable-buffer-local
+ (defvar slime-buffer-connection nil
+ "Network connection to use in the current buffer.
+This overrides `slime-default-connection'."))
+
+(defvar slime-default-connection nil
+ "Network connection to use by default.
+Used for all Lisp communication, except when overridden by
+`slime-dispatching-connection' or `slime-buffer-connection'.")
+
+(defun slime-current-connection ()
+ "Return the connection to use for Lisp interaction.
+Return nil if there's no connection."
+ (or slime-dispatching-connection
+ slime-buffer-connection
+ slime-default-connection))
+
+(defun slime-connection ()
+ "Return the connection to use for Lisp interaction.
+Signal an error if there's no connection."
+ (let ((conn (slime-current-connection)))
+ (cond ((and (not conn) slime-net-processes)
+ (error "No default connection selected."))
+ ((not conn)
+ (error "Not connected."))
+ ((not (eq (process-status conn) 'open))
+ (error "Connection closed."))
+ (t conn))))
+
+(defun slime-select-connection (process)
+ "Make PROCESS the default connection."
+ (setq slime-default-connection process))
+
+(defmacro* slime-with-connection-buffer ((&optional process) &rest body)
+ "Execute BODY in the process-buffer of PROCESS.
+If PROCESS is not specified, `slime-connection' is used.
+
+\(fn (&optional PROCESS) &body BODY))"
+ `(with-current-buffer
+ (process-buffer (or ,process (slime-connection)
+ (error "No connection")))
+ ,@body))
+
+(put 'slime-with-connection-buffer 'lisp-indent-function 1)
+
+(defvar slime-state-name "[??]"
+ "Name of the current state of `slime-default-connection'.
+Just used for informational display in the mode-line.")
+
+(defun slime-set-state (name &optional connection)
+ "Set the current connection's informational state name.
+If this is the default connection then the state will be displayed in
+the modeline."
+ (when (or (not (slime-connected-p))
+ (eq (or connection (slime-connection)) slime-default-connection))
+ (setq slime-state-name name)
+ (force-mode-line-update)))
+
+;;; Connection-local variables:
+
+(defmacro slime-def-connection-var (varname &rest initial-value-and-doc)
+ "Define a connection-local variable.
+The value of the variable can be read by calling the function of the
+same name (it must not be accessed directly). The accessor function is
+setf-able.
+
+The actual variable bindings are stored buffer-local in the
+process-buffers of connections. The accessor function refers to
+the binding for `slime-connection'."
+ (let ((real-var (intern (format "%s:connlocal" varname))))
+ `(progn
+ ;; Variable
+ (make-variable-buffer-local
+ (defvar ,real-var ,@initial-value-and-doc))
+ ;; Accessor
+ (defun ,varname (&optional process)
+ (slime-with-connection-buffer (process) ,real-var))
+ ;; Setf
+ (defsetf ,varname (&optional process) (store)
+ `(slime-with-connection-buffer (,process)
+ (setq (\, (quote (\, real-var))) (\, store))
+ (\, store)))
+ '(\, varname))))
+
+(put 'slime-def-connection-var 'lisp-indent-function 2)
+
+;; Let's indulge in some pretty colours.
+(unless (featurep 'xemacs)
+ (font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("(\\(slime-def-connection-var\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"
+ (1 font-lock-keyword-face)
+ (2 font-lock-variable-name-face)))))
+
+(slime-def-connection-var slime-connection-number nil
+ "Serial number of a connection.
+Bound in the connection's process-buffer.")
+
+(slime-def-connection-var slime-lisp-features '()
+ "The symbol-names of Lisp's *FEATURES*.
+This is automatically synchronized from Lisp.")
+
+(slime-def-connection-var slime-lisp-package
+ "COMMON-LISP-USER"
+ "The current package name of the Superior lisp.
+This is automatically synchronized from Lisp.")
+
+(slime-def-connection-var slime-lisp-package-prompt-string
+ "CL-USER"
+ "The current package name of the Superior lisp.
+This is automatically synchronized from Lisp.")
+
+(slime-def-connection-var slime-pid nil
+ "The process id of the Lisp process.")
+
+(slime-def-connection-var slime-lisp-implementation-type nil
+ "The implementation type of the Lisp process.")
+
+(slime-def-connection-var slime-lisp-implementation-version nil
+ "The implementation type of the Lisp process.")
+
+(slime-def-connection-var slime-lisp-implementation-name nil
+ "The short name for the Lisp implementation.")
+
+(slime-def-connection-var slime-connection-name nil
+ "The short name for connection.")
+
+(slime-def-connection-var slime-inferior-process nil
+ "The inferior process for the connection if any.")
+
+(slime-def-connection-var slime-communication-style nil
+ "The communication style.")
+
+(slime-def-connection-var slime-machine-instance nil
+ "The name of the (remote) machine running the Lisp process.")
+
+;;;;; Connection setup
+
+(defvar slime-connection-counter 0
+ "The number of SLIME connections made. For generating serial numbers.")
+
+;;; Interface
+(defun slime-setup-connection (process)
+ "Make a connection out of PROCESS."
+ (let ((slime-dispatching-connection process))
+ (slime-init-connection-state process)
+ (slime-select-connection process)
+ process))
+
+(defun slime-init-connection-state (proc)
+ "Initialize connection state in the process-buffer of PROC."
+ ;; To make life simpler for the user: if this is the only open
+ ;; connection then reset the connection counter.
+ (when (equal slime-net-processes (list proc))
+ (setq slime-connection-counter 0))
+ (slime-with-connection-buffer ()
+ (setq slime-buffer-connection proc))
+ (setf (slime-connection-number proc) (incf slime-connection-counter))
+ ;; We do the rest of our initialization asynchronously. The current
+ ;; function may be called from a timer, and if we setup the REPL
+ ;; from a timer then it mysteriously uses the wrong keymap for the
+ ;; first command.
+ (slime-eval-async '(swank:connection-info)
+ (with-lexical-bindings (proc)
+ (lambda (info)
+ (slime-set-connection-info proc info)))))
+
+(defun slime-set-connection-info (connection info)
+ "Initialize CONNECTION with INFO received from Lisp."
+ (let ((slime-dispatching-connection connection))
+ (destructuring-bind (&key pid style lisp-implementation machine
+ features package version &allow-other-keys) info
+ (or (equal version slime-protocol-version)
+ (yes-or-no-p "Protocol version mismatch. Continue anyway? ")
+ (slime-net-close connection)
+ (top-level))
+ (setf (slime-pid) pid
+ (slime-communication-style) style
+ (slime-lisp-features) features)
+ (destructuring-bind (&key name prompt) package
+ (setf (slime-lisp-package) name
+ (slime-lisp-package-prompt-string) prompt))
+ (destructuring-bind (&key type name version) lisp-implementation
+ (setf (slime-lisp-implementation-type) type
+ (slime-lisp-implementation-version) version
+ (slime-lisp-implementation-name) name
+ (slime-connection-name) (slime-generate-connection-name name)))
+ (destructuring-bind (&key instance type version) machine
+ (setf (slime-machine-instance) instance)))
+ (setq slime-state-name "") ; FIXME
+ (let ((args (when-let (p (slime-inferior-process))
+ (slime-inferior-lisp-args p))))
+ (when-let (name (plist-get args ':name))
+ (unless (string= (slime-lisp-implementation-name) name)
+ (setf (slime-connection-name)
+ (slime-generate-connection-name (symbol-name name)))))
+ (slime-hide-inferior-lisp-buffer)
+ (slime-init-output-buffer connection)
+ (run-hooks 'slime-connected-hook)
+ (when-let (fun (plist-get args ':init-function))
+ (funcall fun)))
+ (message "Connected. %s" (slime-random-words-of-encouragement))))
+
+(defun slime-generate-connection-name (lisp-name)
+ (loop for i from 1
+ for name = lisp-name then (format "%s<%d>" lisp-name i)
+ while (find name slime-net-processes
+ :key #'slime-connection-name :test #'equal)
+ finally (return name)))
+
+(defun slime-connection-close-hook (process)
+ (when (eq process slime-default-connection)
+ (when slime-net-processes
+ (slime-select-connection (car slime-net-processes))
+ (message "Default connection closed; switched to #%S (%S)"
+ (slime-connection-number)
+ (slime-connection-name)))))
+
+(add-hook 'slime-net-process-close-hooks 'slime-connection-close-hook)
+
+;;;;; Commands on connections
+
+(defun slime-disconnect ()
+ "Disconnect all connections."
+ (interactive)
+ (mapc #'slime-net-close slime-net-processes))
+
+(defun slime-make-default-connection ()
+ "Make the current connection the default connection."
+ (interactive)
+ (slime-select-connection (slime-connection))
+ (message "Connection #%S (%s) now default SLIME connection."
+ (slime-connection-number)
+ (slime-connection-name)))
+
+(defun slime-choose-connection ()
+ "Return an established connection chosen by the user."
+ (let ((default (slime-connection-name)))
+ (slime-find-connection-by-name
+ (completing-read (format "Connection name (default %s): " default)
+ (slime-bogus-completion-alist
+ (mapcar #'slime-connection-name slime-net-processes))
+ nil
+ t
+ nil
+ nil
+ default))))
+
+(defun slime-find-connection-by-name (name)
+ (find name slime-net-processes
+ :test #'string= :key #'slime-connection-name))
+
+(defun slime-connection-port (connection)
+ "Return the remote port number of CONNECTION."
+ (if (featurep 'xemacs)
+ (car (process-id connection))
+ (cadr (process-contact connection))))
+
+(defun slime-process (&optional connection)
+ "Return the Lisp process for CONNECTION (default `slime-connection').
+Can return nil if there's no process object for the connection."
+ (let ((proc (slime-inferior-process connection)))
+ (if (and proc
+ (memq (process-status proc) '(run stop)))
+ proc)))
+
+;; Non-macro version to keep the file byte-compilable.
+(defun slime-set-inferior-process (connection process)
+ (setf (slime-inferior-process connection) process))
+
+(defun slime-use-sigint-for-interrupt (&optional connection)
+ (let ((c (or connection (slime-connection))))
+ (ecase (slime-communication-style c)
+ ((:fd-handler nil) t)
+ ((:spawn :sigio) nil))))
+
+(defvar slime-inhibit-pipelining t
+ "*If true, don't send background requests if Lisp is already busy.")
+
+(defun slime-background-activities-enabled-p ()
+ (and (or slime-mode
+ (eq major-mode 'sldb-mode)
+ (eq major-mode 'slime-repl-mode))
+ (let ((con (slime-current-connection)))
+ (and con
+ (eq (process-status con) 'open)))
+ (or (not (slime-busy-p))
+ (not slime-inhibit-pipelining))))
+
+
+;;;; Communication protocol
+
+;;;;; Emacs Lisp programming interface
+;;;
+;;; The programming interface for writing Emacs commands is based on
+;;; remote procedure calls (RPCs). The basic operation is to ask Lisp
+;;; to apply a named Lisp function to some arguments, then to do
+;;; something with the result.
+;;;
+;;; Requests can be either synchronous (blocking) or asynchronous
+;;; (with the result passed to a callback/continuation function). If
+;;; an error occurs during the request then the debugger is entered
+;;; before the result arrives -- for synchronous evaluations this
+;;; requires a recursive edit.
+;;;
+;;; You should use asynchronous evaluations (`slime-eval-async') for
+;;; most things. Reserve synchronous evaluations (`slime-eval') for
+;;; the cases where blocking Emacs is really appropriate (like
+;;; completion) and that shouldn't trigger errors (e.g. not evaluate
+;;; user-entered code).
+;;;
+;;; We have the concept of the "current Lisp package". RPC requests
+;;; always say what package the user is making them from and the Lisp
+;;; side binds that package to *BUFFER-PACKAGE* to use as it sees
+;;; fit. The current package is defined as the buffer-local value of
+;;; `slime-buffer-package' if set, and otherwise the package named by
+;;; the nearest IN-PACKAGE as found by text search (first backwards,
+;;; then forwards).
+;;;
+;;; Similarly we have the concept of the current thread, i.e. which
+;;; thread in the Lisp process should handle the request. The current
+;;; thread is determined solely by the buffer-local value of
+;;; `slime-current-thread'. This is usually bound to t meaning "no
+;;; particular thread", but can also be used to nominate a specific
+;;; thread. The REPL and the debugger both use this feature to deal
+;;; with specific threads.
+
+(make-variable-buffer-local
+ (defvar slime-current-thread t
+ "The id of the current thread on the Lisp side.
+t means the \"current\" thread;
+:repl-thread the thread that executes REPL requests;
+fixnum a specific thread."))
+
+(make-variable-buffer-local
+ (defvar slime-buffer-package nil
+ "The Lisp package associated with the current buffer.
+This is set only in buffers bound to specific packages."))
+
+;;; `slime-rex' is the RPC primitive which is used to implement both
+;;; `slime-eval' and `slime-eval-async'. You can use it directly if
+;;; you need to, but the others are usually more convenient.
+
+(defmacro* slime-rex ((&rest saved-vars)
+ (sexp &optional
+ (package '(slime-current-package))
+ (thread 'slime-current-thread))
+ &rest continuations)
+ "(slime-rex (VAR ...) (SEXP &optional PACKAGE THREAD) CLAUSES ...)
+
+Remote EXecute SEXP.
+
+VARs are a list of saved variables visible in the other forms. Each
+VAR is either a symbol or a list (VAR INIT-VALUE).
+
+SEXP is evaluated and the princed version is sent to Lisp.
+
+PACKAGE is evaluated and Lisp binds *BUFFER-PACKAGE* to this package.
+The default value is (slime-current-package).
+
+CLAUSES is a list of patterns with same syntax as
+`destructure-case'. The result of the evaluation of SEXP is
+dispatched on CLAUSES. The result is either a sexp of the
+form (:ok VALUE) or (:abort). CLAUSES is executed
+asynchronously.
+
+Note: don't use backquote syntax for SEXP, because Emacs20 cannot
+deal with that."
+ (let ((result (gensym)))
+ `(lexical-let ,(loop for var in saved-vars
+ collect (etypecase var
+ (symbol (list var var))
+ (cons var)))
+ (slime-dispatch-event
+ (list :emacs-rex ,sexp ,package ,thread
+ (lambda (,result)
+ (destructure-case ,result
+ ,@continuations)))))))
+
+(put 'slime-rex 'lisp-indent-function 2)
+
+;;; Interface
+(defun slime-current-package ()
+ "Return the Common Lisp package in the current context.
+If `slime-buffer-package' has a value then return that, otherwise
+search for and read an `in-package' form.
+
+The REPL buffer is a special case: it's package is `slime-lisp-package'."
+ (cond ((eq major-mode 'slime-repl-mode)
+ (slime-lisp-package))
+ (slime-buffer-package)
+ (t (save-restriction
+ (widen)
+ (slime-find-buffer-package)))))
+
+(defvar slime-find-buffer-package-function 'slime-search-buffer-package
+ "*Function to use for `slime-find-buffer-package'.
+The result should be the package-name (a string)
+or nil if nothing suitable can be found.")
+
+(defun slime-find-buffer-package ()
+ "Figure out which Lisp package the current buffer is associated with."
+ (funcall slime-find-buffer-package-function))
+
+;; When modifing this code consider cases like:
+;; (in-package #.*foo*)
+;; (in-package #:cl)
+;; (in-package :cl)
+;; (in-package "CL")
+;; (in-package |CL|)
+;; (in-package #+ansi-cl :cl #-ansi-cl 'lisp)
+(defun slime-search-buffer-package ()
+ (let ((case-fold-search t)
+ (regexp (concat "^(\\(cl:\\|common-lisp:\\)?in-package\\>[ \n\t\r']*"
+ "\\([^)]+\\)[ \n\t]*)")))
+ (save-excursion
+ (when (or (re-search-backward regexp nil t)
+ (re-search-forward regexp nil t))
+ (let ((string (match-string-no-properties 2)))
+ (cond ((string-match "^\"" string) (ignore-errors (read string)))
+ ((string-match "^#?:" string) (substring string (match-end 0)))
+ (t string)))))))
+
+;;; Synchronous requests are implemented in terms of asynchronous
+;;; ones. We make an asynchronous request with a continuation function
+;;; that `throw's its result up to a `catch' and then enter a loop of
+;;; handling I/O until that happens.
+
+(defvar slime-stack-eval-tags nil
+ "List of stack-tags of continuations waiting on the stack.")
+
+(defun slime-eval (sexp &optional package)
+ "Evaluate EXPR on the superior Lisp and return the result."
+ (when (null package) (setq package (slime-current-package)))
+ (let* ((tag (gensym (format "slime-result-%d-"
+ (1+ (slime-continuation-counter)))))
+ (slime-stack-eval-tags (cons tag slime-stack-eval-tags)))
+ (apply
+ #'funcall
+ (catch tag
+ (slime-rex (tag sexp)
+ (sexp package)
+ ((:ok value)
+ (unless (member tag slime-stack-eval-tags)
+ (error "tag = %S eval-tags = %S sexp = %S"
+ tag slime-stack-eval-tags sexp))
+ (throw tag (list #'identity value)))
+ ((:abort)
+ (throw tag (list #'error "Synchronous Lisp Evaluation aborted."))))
+ (let ((debug-on-quit t)
+ (inhibit-quit nil)
+ (conn (slime-connection)))
+ (while t
+ (unless (eq (process-status conn) 'open)
+ (error "Lisp connection closed unexpectedly"))
+ (slime-accept-process-output nil 0.01)))))))
+
+(defun slime-eval-async (sexp &optional cont package)
+ "Evaluate EXPR on the superior Lisp and call CONT with the result."
+ (slime-rex (cont (buffer (current-buffer)))
+ (sexp (or package (slime-current-package)))
+ ((:ok result)
+ (when cont
+ (set-buffer buffer)
+ (funcall cont result)))
+ ((:abort)
+ (message "Evaluation aborted."))))
+
+;;; These functions can be handy too:
+
+(defun slime-connected-p ()
+ "Return true if the Swank connection is open."
+ (not (null slime-net-processes)))
+
+(defun slime-check-connected ()
+ "Signal an error if we are not connected to Lisp."
+ (unless (slime-connected-p)
+ (error "Not connected. Use `%s' to start a Lisp."
+ (substitute-command-keys "\\[slime]"))))
+
+(defun slime-busy-p ()
+ "True if Lisp has outstanding requests.
+Debugged requests are ignored."
+ (let ((debugged (sldb-debugged-continuations (slime-connection))))
+ (remove-if (lambda (id)
+ (memq id debugged))
+ (slime-rex-continuations)
+ :key #'car)))
+
+;; dummy defvar for compiler
+(defvar slime-repl-read-mode)
+
+(defun slime-reading-p ()
+ "True if Lisp is currently reading input from the REPL."
+ (with-current-buffer (slime-output-buffer)
+ slime-repl-read-mode))
+
+(defun slime-sync ()
+ "Block until the most recent request has finished."
+ (when (slime-rex-continuations)
+ (let ((tag (caar (slime-rex-continuations))))
+ (while (find tag (slime-rex-continuations) :key #'car)
+ (slime-accept-process-output nil 0.1)))))
+
+(defun slime-ping ()
+ "Check that communication works."
+ (interactive)
+ (message "%s" (slime-eval "PONG")))
+
+;;;;; Protocol event handler (the guts)
+;;;
+;;; This is the protocol in all its glory. The input to this function
+;;; is a protocol event that either originates within Emacs or arrived
+;;; over the network from Lisp.
+;;;
+;;; Each event is a list beginning with a keyword and followed by
+;;; arguments. The keyword identifies the type of event. Events
+;;; originating from Emacs have names starting with :emacs- and events
+;;; from Lisp don't.
+
+(slime-def-connection-var slime-rex-continuations '()
+ "List of (ID . FUNCTION) continuations waiting for RPC results.")
+
+(slime-def-connection-var slime-continuation-counter 0
+ "Continuation serial number counter.")
+
+(defvar slime-event-hooks)
+
+(defun slime-dispatch-event (event &optional process)
+ (let ((slime-dispatching-connection (or process (slime-connection))))
+ (or (run-hook-with-args-until-success 'slime-event-hooks event)
+ (destructure-case event
+ ((:write-string output &optional target)
+ (slime-write-string output target))
+ ((:emacs-rex form package thread continuation)
+ (slime-set-state "|eval...")
+ (when (and (slime-use-sigint-for-interrupt) (slime-busy-p))
+ (message "; pipelined request... %S" form))
+ (let ((id (incf (slime-continuation-counter))))
+ (push (cons id continuation) (slime-rex-continuations))
+ (slime-send `(:emacs-rex ,form ,package ,thread ,id))))
+ ((:return value id)
+ (let ((rec (assq id (slime-rex-continuations))))
+ (cond (rec (setf (slime-rex-continuations)
+ (remove rec (slime-rex-continuations)))
+ (when (null (slime-rex-continuations))
+ (slime-set-state ""))
+ (funcall (cdr rec) value))
+ (t
+ (error "Unexpected reply: %S %S" id value)))))
+ ((:debug-activate thread level)
+ (assert thread)
+ (sldb-activate thread level))
+ ((:debug thread level condition restarts frames conts)
+ (assert thread)
+ (sldb-setup thread level condition restarts frames conts))
+ ((:debug-return thread level stepping)
+ (assert thread)
+ (sldb-exit thread level stepping))
+ ((:emacs-interrupt thread)
+ (slime-send `(:emacs-interrupt ,thread)))
+ ((:read-string thread tag)
+ (assert thread)
+ (slime-repl-read-string thread tag))
+ ((:y-or-n-p thread tag question)
+ (slime-y-or-n-p thread tag question))
+ ((:read-aborted thread tag)
+ (assert thread)
+ (slime-repl-abort-read thread tag))
+ ((:emacs-return-string thread tag string)
+ (slime-send `(:emacs-return-string ,thread ,tag ,string)))
+ ;;
+ ((:new-package package prompt-string)
+ (setf (slime-lisp-package) package)
+ (setf (slime-lisp-package-prompt-string) prompt-string))
+ ((:new-features features)
+ (setf (slime-lisp-features) features))
+ ((:indentation-update info)
+ (slime-handle-indentation-update info))
+ ((:open-dedicated-output-stream port)
+ (slime-open-stream-to-lisp port))
+ ((:eval-no-wait fun args)
+ (apply (intern fun) args))
+ ((:eval thread tag form-string)
+ (slime-check-eval-in-emacs-enabled)
+ (slime-eval-for-lisp thread tag form-string))
+ ((:emacs-return thread tag value)
+ (slime-send `(:emacs-return ,thread ,tag ,value)))
+ ((:ed what)
+ (slime-ed what))
+ ((:inspect what)
+ (slime-open-inspector what))
+ ((:background-message message)
+ (slime-background-message "%s" message))
+ ((:debug-condition thread message)
+ (assert thread)
+ (message "%s" message))))))
+
+(defun slime-send (sexp)
+ "Send SEXP directly over the wire on the current connection."
+ (slime-net-send sexp (slime-connection)))
+
+(defun slime-reset ()
+ "Clear all pending continuations."
+ (interactive)
+ (setf (slime-rex-continuations) '())
+ (mapc #'kill-buffer (sldb-buffers)))
+
+(defun slime-send-sigint ()
+ (interactive)
+ (signal-process (slime-pid) 'SIGINT))
+
+;;;;; Event logging to *slime-events*
+;;;
+;;; The *slime-events* buffer logs all protocol messages for debugging
+;;; purposes. Optionally you can enable outline-mode in that buffer,
+;;; which is convenient but slows things down significantly.
+
+(defvar slime-log-events t
+ "*Log protocol events to the *slime-events* buffer.")
+
+(defvar slime-outline-mode-in-events-buffer nil
+ "*Non-nil means use outline-mode in *slime-events*.")
+
+(defvar slime-event-buffer-name "*slime-events*"
+ "The name of the slime event buffer.")
+
+(defun slime-log-event (event)
+ "Record the fact that EVENT occurred."
+ (when slime-log-events
+ (with-current-buffer (slime-events-buffer)
+ ;; trim?
+ (when (> (buffer-size) 100000)
+ (goto-char (/ (buffer-size) 2))
+ (re-search-forward "^(" nil t)
+ (delete-region (point-min) (point)))
+ (goto-char (point-max))
+ (save-excursion
+ (slime-pprint-event event (current-buffer)))
+ (when (and (boundp 'outline-minor-mode)
+ outline-minor-mode)
+ (hide-entry))
+ (goto-char (point-max)))))
+
+(defun slime-pprint-event (event buffer)
+ "Pretty print EVENT in BUFFER with limited depth and width."
+ (let ((print-length 20)
+ (print-level 6)
+ (pp-escape-newlines t))
+ (pp event buffer)))
+
+(defun slime-events-buffer ()
+ (or (get-buffer slime-event-buffer-name)
+ (let ((buffer (get-buffer-create slime-event-buffer-name)))
+ (with-current-buffer buffer
+ (set (make-local-variable 'outline-regexp) "^(")
+ (set (make-local-variable 'comment-start) ";")
+ (set (make-local-variable 'comment-end) "")
+ (when slime-outline-mode-in-events-buffer
+ (outline-minor-mode)))
+ buffer)))
+
+
+;;;; Stream output
+
+(slime-def-connection-var slime-connection-output-buffer nil
+ "The buffer for the REPL. May be nil or a dead buffer.")
+
+(make-variable-buffer-local
+ (defvar slime-output-start nil
+ "Marker for the start of the output for the evaluation."))
+
+(make-variable-buffer-local
+ (defvar slime-output-end nil
+ "Marker for end of output. New output is inserted at this mark."))
+
+;; dummy definitions for the compiler
+(defvar slime-repl-package-stack)
+(defvar slime-repl-directory-stack)
+(defvar slime-repl-input-start-mark)
+(defvar slime-repl-prompt-start-mark)
+
+
+(defun slime-output-buffer (&optional noprompt)
+ "Return the output buffer, create it if necessary."
+ (let ((buffer (slime-connection-output-buffer)))
+ (or (if (buffer-live-p buffer) buffer)
+ (setf (slime-connection-output-buffer)
+ (let ((connection (slime-connection)))
+ (with-current-buffer (slime-repl-buffer t connection)
+ (unless (eq major-mode 'slime-repl-mode)
+ (slime-repl-mode))
+ (setq slime-buffer-connection connection)
+ (slime-reset-repl-markers)
+ (unless noprompt
+ (slime-repl-insert-prompt))
+ (current-buffer)))))))
+
+(defvar slime-repl-banner-function 'slime-repl-insert-banner)
+
+(defun slime-repl-update-banner ()
+ (funcall slime-repl-banner-function)
+ (goto-char (point-max))
+ (slime-mark-output-start)
+ (slime-mark-input-start)
+ (slime-repl-insert-prompt)
+ (pop-to-buffer (current-buffer)))
+
+(defun slime-repl-insert-banner ()
+ (when (zerop (buffer-size))
+ (let ((welcome (concat "; SLIME " (or (slime-changelog-date)
+ "- ChangeLog file not found"))))
+ (insert welcome))))
+
+(defun slime-init-output-buffer (connection)
+ (with-current-buffer (slime-output-buffer t)
+ (setq slime-buffer-connection connection
+ slime-repl-directory-stack '()
+ slime-repl-package-stack '())
+ (slime-repl-update-banner)))
+
+(defvar slime-show-last-output-function
+ 'slime-maybe-display-output-buffer
+ "*This function is called when a evaluation request is finished.
+It is called in the slime-output buffer and receives the region of the
+output as arguments.")
+
+(defun slime-show-last-output-region (start end)
+ (when (< start end)
+ (slime-display-buffer-region (current-buffer) (1- start)
+ slime-repl-input-start-mark)))
+
+(defun slime-maybe-display-output-buffer (start end)
+ (when (and (< start end)
+ (not (get-buffer-window (current-buffer) t)))
+ (display-buffer (current-buffer)))
+ (when (eobp)
+ (slime-repl-show-maximum-output t)))
+
+(defun slime-show-last-output ()
+ "Show the output from the last Lisp evaluation."
+ (with-current-buffer (slime-output-buffer)
+ (let ((start slime-output-start)
+ (end slime-output-end))
+ (funcall slime-show-last-output-function start end))))
+
+(defun slime-display-output-buffer ()
+ "Display the output buffer and scroll to bottom."
+ (with-current-buffer (slime-output-buffer)
+ (goto-char (point-max))
+ (unless (get-buffer-window (current-buffer) t)
+ (display-buffer (current-buffer) t))
+ (slime-repl-show-maximum-output)))
+
+(defmacro slime-with-output-end-mark (&rest body)
+ "Execute BODY at `slime-output-end'.
+
+If point is initially at `slime-output-end' and the buffer is visible
+update window-point afterwards. If point is initially not at
+`slime-output-end, execute body inside a `save-excursion' block."
+ `(let ((body.. (lambda () ,@body))
+ (updatep.. (and (eobp) (pos-visible-in-window-p))))
+ (cond ((= (point) slime-output-end)
+ (let ((start.. (point)))
+ (funcall body..)
+ (set-marker slime-output-end (point))
+ (when (= start.. slime-repl-input-start-mark)
+ (set-marker slime-repl-input-start-mark (point)))))
+ (t
+ (save-excursion
+ (goto-char slime-output-end)
+ (funcall body..))))
+ (when updatep..
+ (slime-repl-show-maximum-output
+ (> (- slime-output-end slime-output-start) 1000)))))
+
+(defun slime-output-filter (process string)
+ (with-current-buffer (process-buffer process)
+ (when (and (plusp (length string))
+ (eq (process-status slime-buffer-connection) 'open))
+ (slime-write-string string))))
+
+(defvar slime-open-stream-hooks)
+
+(defun slime-open-stream-to-lisp (port)
+ (let ((stream (open-network-stream "*lisp-output-stream*"
+ (slime-with-connection-buffer ()
+ (current-buffer))
+ slime-lisp-host port)))
+ (slime-set-query-on-exit-flag stream)
+ (set-process-filter stream 'slime-output-filter)
+ (let ((pcs (process-coding-system (slime-current-connection))))
+ (set-process-coding-system stream (car pcs) (cdr pcs)))
+ (when-let (secret (slime-secret))
+ (slime-net-send secret stream))
+ (run-hook-with-args 'slime-open-stream-hooks stream)
+ stream))
+
+(defun slime-io-speed-test (&optional profile)
+ "A simple minded benchmark for stream performance.
+If a prefix argument is given, instrument the slime package for
+profiling before running the benchmark."
+ (interactive "P")
+ (eval-and-compile
+ (require 'elp))
+ (elp-reset-all)
+ (elp-restore-all)
+ (load "slime.el")
+ ;;(byte-compile-file "slime-net.el" t)
+ ;;(setq slime-log-events nil)
+ (setq slime-enable-evaluate-in-emacs t)
+ ;;(setq slime-repl-enable-presentations nil)
+ (when profile
+ (elp-instrument-package "slime-"))
+ (kill-buffer (slime-output-buffer))
+ ;;(display-buffer (slime-output-buffer))
+ (delete-other-windows)
+ (sit-for 0)
+ (slime-repl-send-string "(swank:io-speed-test 5000 1)")
+ (let ((proc (slime-inferior-process)))
+ (when proc
+ (switch-to-buffer (process-buffer proc))
+ (goto-char (point-max)))))
+
+(defvar slime-write-string-function 'slime-repl-write-string)
+
+(defun slime-write-string (string &optional target)
+ "Insert STRING in the REPL buffer or some other TARGET.
+If TARGET is nil, insert STRING as regular process
+output. If TARGET is :repl-result, insert STRING as the result of the
+evaluation. Other values of TARGET map to an Emacs marker via the
+hashtable `slime-output-target-to-marker'; output is inserted at this marker."
+ (funcall slime-write-string-function string target))
+
+(defun slime-repl-write-string (string &optional target)
+ (case target
+ ((nil) (slime-repl-emit string))
+ (:repl-result (slime-repl-emit-result string))
+ (t (slime-emit-string string target))))
+
+(defun slime-repl-emit (string)
+ ;; insert the string STRING in the output buffer
+ (with-current-buffer (slime-output-buffer)
+ (slime-with-output-end-mark
+ (slime-insert-propertized '(face slime-repl-output-face
+ rear-nonsticky (face))
+ string)
+ (set-marker slime-output-end (point))
+ (when (and (= (point) slime-repl-prompt-start-mark)
+ (not (bolp)))
+ (insert "\n")
+ (set-marker slime-output-end (1- (point))))
+ (when (< slime-repl-input-start-mark (point))
+ (set-marker slime-repl-input-start-mark (point))))))
+
+(defun slime-repl-emit-result (string)
+ ;; insert STRING and mark it as evaluation result
+ (with-current-buffer (slime-output-buffer)
+ (goto-char slime-repl-input-start-mark)
+ (slime-insert-propertized `(face slime-repl-result-face
+ rear-nonsticky (face))
+ string)
+ (set-marker slime-repl-input-start-mark (point))))
+
+(defvar slime-last-output-target-id 0
+ "The last integer we used as a TARGET id.")
+
+(defvar slime-output-target-to-marker
+ (make-hash-table)
+ "Map from TARGET ids to Emacs markers.
+The markers indicate where output should be inserted.")
+
+(defun slime-output-target-marker (target)
+ "Return the marker where output for TARGET should be inserted."
+ (case target
+ ((nil)
+ (with-current-buffer (slime-output-buffer)
+ slime-output-end))
+ (:repl-result
+ (with-current-buffer (slime-output-buffer)
+ slime-repl-input-start-mark))
+ (t
+ (gethash target slime-output-target-to-marker))))
+
+(defun slime-emit-string (string target)
+ "Insert STRING at target TARGET.
+See `slime-output-target-to-marker'."
+ (let* ((marker (slime-output-target-marker target))
+ (buffer (and marker (marker-buffer marker))))
+ (when buffer
+ (with-current-buffer buffer
+ (save-excursion
+ ;; Insert STRING at MARKER, then move MARKER behind
+ ;; the insertion.
+ (goto-char marker)
+ (insert-before-markers string)
+ (set-marker marker (point)))))))
+
+(defun slime-switch-to-output-buffer (&optional connection)
+ "Select the output buffer, preferably in a different window."
+ (interactive (list (if prefix-arg (slime-choose-connection))))
+ (let ((slime-dispatching-connection (or connection
+ slime-dispatching-connection)))
+ (set-buffer (slime-output-buffer))
+ (unless (eq (current-buffer) (window-buffer))
+ (pop-to-buffer (current-buffer) t))
+ (goto-char (point-max))))
+
+
+;;;; REPL
+;;
+;; The REPL uses some markers to separate input from output. The
+;; usual configuration is as follows:
+;;
+;; ... output ... ... result ... prompt> ... input ...
+;; ^ ^ ^ ^ ^
+;; output-start output-end prompt-start input-start input-end
+;;
+;; output-start and input-start are right inserting markers;
+;; output-end and input-end left inserting.
+;;
+;; We maintain the following invariant:
+;;
+;; output-start <= output-end <= input-start <= input-end.
+;;
+;; This invariant is important, because we must be prepared for
+;; asynchronous output and asynchronous reads. ("Asynchronous" means,
+;; triggered by Lisp and not by Emacs.)
+;;
+;; All output is inserted at the output-end marker. Some care must be
+;; taken when output-end and input-start are at the same position: if
+;; we blindly insert at that point, we break the invariant stated
+;; above, because the output-end marker is left inserting. The macro
+;; `slime-with-output-end-mark' handles this complication by moving
+;; the input-start marker to an appropriate place. The macro also
+;; updates window-point if necessary, and tries to keep the prompt in
+;; the first column by inserting a newline.
+;;
+;; A "synchronous" evaluation request proceeds as follows: the user
+;; inserts some text between input-start and input-end and then hits
+;; return. We send the text between the input markers to Lisp, move
+;; the output and input makers to the line after the input and wait.
+;; When we receive the result, we insert it together with a prompt
+;; between the output-end and input-start mark.
+;; `slime-repl-insert-prompt' does this.
+;;
+;; It is possible that some output for such an evaluation request
+;; arrives after the result. This output is inserted before the
+;; result (and before the prompt). Output that doesn't belong the
+;; evaluation request should not be inserted before the result, but
+;; immediately before the prompt. To achieve this, we move the
+;; output-end mark to prompt-start after a short delay (by starting a
+;; timer in `slime-repl-insert-prompt'). In summary: synchronous
+;; output should go before the result, asynchronous before the prompt.
+;;
+;; If we are in "reading" state, e.g., during a call to Y-OR-N-P,
+;; there is no prompt between output-end and input-start.
+;;
+
+;; Small helper.
+(defun slime-make-variables-buffer-local (&rest variables)
+ (mapcar #'make-variable-buffer-local variables))
+
+(slime-make-variables-buffer-local
+ (defvar slime-repl-package-stack nil
+ "The stack of packages visited in this repl.")
+
+ (defvar slime-repl-directory-stack nil
+ "The stack of default directories associated with this repl.")
+
+ (defvar slime-repl-prompt-start-mark)
+ (defvar slime-repl-input-start-mark)
+ (defvar slime-repl-input-end-mark)
+ (defvar slime-repl-last-input-start-mark)
+ (defvar slime-repl-old-input-counter 0
+ "Counter used to generate unique `slime-repl-old-input' properties.
+This property value must be unique to avoid having adjacent inputs be
+joined together."))
+
+(defun slime-reset-repl-markers ()
+ (dolist (markname '(slime-output-start
+ slime-output-end
+ slime-repl-prompt-start-mark
+ slime-repl-input-start-mark
+ slime-repl-input-end-mark
+ slime-repl-last-input-start-mark))
+ (set markname (make-marker))
+ (set-marker (symbol-value markname) (point)))
+ ;; (set-marker-insertion-type slime-output-end t)
+ (set-marker-insertion-type slime-repl-input-end-mark t)
+ (set-marker-insertion-type slime-repl-prompt-start-mark t))
+
+;;;;; REPL mode setup
+
+(defvar slime-repl-mode-map)
+
+(setq slime-repl-mode-map (make-sparse-keymap))
+(set-keymap-parent slime-repl-mode-map lisp-mode-map)
+
+(dolist (spec slime-keys)
+ (destructuring-bind (key command &key inferior prefixed
+ &allow-other-keys) spec
+ (when inferior
+ (let ((key (if prefixed (concat slime-prefix-key key) key)))
+ (define-key slime-repl-mode-map key command)))))
+
+(slime-define-keys slime-repl-mode-map
+ ("\C-m" 'slime-repl-return)
+ ("\C-j" 'slime-repl-newline-and-indent)
+ ("\C-\M-m" 'slime-repl-closing-return)
+ ([(control return)] 'slime-repl-closing-return)
+ ("\C-a" 'slime-repl-bol)
+ ([home] 'slime-repl-bol)
+ ("\C-e" 'slime-repl-eol)
+ ("\M-p" 'slime-repl-previous-input)
+ ((kbd "C-<up>") 'slime-repl-backward-input)
+ ("\M-n" 'slime-repl-next-input)
+ ((kbd "C-<down>") 'slime-repl-forward-input)
+ ("\M-r" 'slime-repl-previous-matching-input)
+ ("\M-s" 'slime-repl-next-matching-input)
+ ("\C-c\C-c" 'slime-interrupt)
+ ("\C-c\C-b" 'slime-interrupt)
+ ("\C-c:" 'slime-interactive-eval)
+ ("\C-c\C-e" 'slime-interactive-eval)
+ ("\C-cE" 'slime-edit-value)
+ ;("\t" 'slime-complete-symbol)
+ ("\t" 'slime-indent-and-complete-symbol)
+ (" " 'slime-space)
+ ("\C-c\C-d" slime-doc-map)
+ ("\C-c\C-w" slime-who-map)
+ ("\C-\M-x" 'slime-eval-defun)
+ ("\C-c\C-o" 'slime-repl-clear-output)
+ ("\C-c\C-t" 'slime-repl-clear-buffer)
+ ("\C-c\C-u" 'slime-repl-kill-input)
+ ("\C-c\C-n" 'slime-repl-next-prompt)
+ ("\C-c\C-p" 'slime-repl-previous-prompt)
+ ("\C-c\C-l" 'slime-load-file)
+ ("\C-c\C-k" 'slime-compile-and-load-file)
+ ("\C-c\C-z" 'slime-nop))
+
+(defun slime-repl-mode ()
+ "Major mode for interacting with a superior Lisp.
+\\{slime-repl-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'slime-repl-mode)
+ (use-local-map slime-repl-mode-map)
+ (lisp-mode-variables t)
+ (set (make-local-variable 'lisp-indent-function)
+ 'common-lisp-indent-function)
+ (setq font-lock-defaults nil)
+ (setq mode-name "REPL")
+ (setq slime-current-thread :repl-thread)
+ (set (make-local-variable 'scroll-conservatively) 20)
+ (set (make-local-variable 'scroll-margin) 0)
+ (slime-repl-safe-load-history)
+ (add-local-hook 'kill-buffer-hook 'slime-repl-safe-save-merged-history)
+ (add-hook 'kill-emacs-hook 'slime-repl-save-all-histories)
+ (slime-setup-command-hooks)
+ ;; At the REPL, we define beginning-of-defun and end-of-defun to be
+ ;; the start of the previous prompt or next prompt respectively.
+ ;; Notice the interplay with SLIME-REPL-BEGINNING-OF-DEFUN.
+ (set (make-local-variable 'beginning-of-defun-function)
+ 'slime-repl-mode-beginning-of-defun)
+ (set (make-local-variable 'end-of-defun-function)
+ 'slime-repl-mode-end-of-defun)
+ (run-hooks 'slime-repl-mode-hook))
+
+(defun slime-repl-buffer (&optional create connection)
+ "Get the REPL buffer for the current connection; optionally create."
+ (funcall (if create #'get-buffer-create #'get-buffer)
+ (format "*slime-repl %s*" (slime-connection-name connection))))
+
+(defun slime-repl ()
+ (interactive)
+ (slime-switch-to-output-buffer))
+
+(defun slime-repl-mode-beginning-of-defun ()
+ (slime-repl-previous-prompt)
+ t)
+
+(defun slime-repl-mode-end-of-defun ()
+ (slime-repl-next-prompt)
+ t)
+
+(defun slime-repl-send-string (string &optional command-string)
+ (cond (slime-repl-read-mode
+ (slime-repl-return-string string))
+ (t (slime-repl-eval-string string))))
+
+(defun slime-repl-eval-string (string)
+ (slime-rex ()
+ ((list 'swank:listener-eval string) (slime-lisp-package))
+ ((:ok result)
+ (slime-repl-insert-result result))
+ ((:abort)
+ (slime-repl-show-abort))))
+
+(defun slime-repl-insert-result (result)
+ (with-current-buffer (slime-output-buffer)
+ (goto-char (point-max))
+ (when result
+ (destructure-case result
+ ((:values &rest strings)
+ (unless (bolp) (insert "\n"))
+ (cond ((null strings)
+ (insert "; No value\n"))
+ (t
+ (dolist (string strings)
+ (slime-propertize-region `(face slime-repl-result-face)
+ (insert string))
+ (insert "\n")))))))
+ (slime-repl-insert-prompt)))
+
+(defun slime-repl-show-abort ()
+ (with-current-buffer (slime-output-buffer)
+ (slime-with-output-end-mark
+ (unless (bolp) (insert-before-markers "\n"))
+ (insert-before-markers "; Evaluation aborted.\n"))
+ (slime-repl-insert-prompt)))
+
+(defun slime-repl-insert-prompt ()
+ "Goto to point max, and insert the prompt."
+ (goto-char slime-repl-input-start-mark)
+ (assert (= slime-repl-input-end-mark (point-max)))
+ (unless (bolp) (insert "\n"))
+ (let ((prompt-start (point))
+ (prompt (format "%s> " (slime-lisp-package-prompt-string))))
+ (slime-propertize-region
+ '(face slime-repl-prompt-face read-only t intangible t
+ slime-repl-prompt t
+ ;; emacs stuff
+ rear-nonsticky (slime-repl-prompt read-only face intangible)
+ ;; xemacs stuff
+ start-open t end-open t)
+ (insert-before-markers prompt))
+ (slime-mark-input-start)
+ (set-marker slime-repl-input-end-mark (point-max))
+ (set-marker slime-repl-prompt-start-mark prompt-start)
+ (goto-char slime-repl-prompt-start-mark)
+ (slime-mark-output-start)
+ (goto-char (point-max)))
+ (slime-repl-show-maximum-output))
+
+(defun slime-repl-show-maximum-output (&optional force)
+ "Put the end of the buffer at the bottom of the window."
+ (assert (eobp))
+ (let ((win (get-buffer-window (current-buffer))))
+ (when win
+ (with-selected-window win
+ (recenter -1)))))
+
+(defvar slime-repl-current-input-hooks)
+
+(defun slime-repl-current-input (&optional until-point-p)
+ "Return the current input as string.
+The input is the region from after the last prompt to the end of
+buffer."
+ (or (run-hook-with-args-until-success 'slime-repl-current-input-hooks
+ until-point-p)
+ (buffer-substring-no-properties
+ slime-repl-input-start-mark
+ (if (and until-point-p (<= (point) slime-repl-input-end-mark))
+ (point)
+ slime-repl-input-end-mark))))
+
+(defun slime-property-position (text-property &optional object)
+ "Return the first position of TEXT-PROPERTY, or nil."
+ (if (get-text-property 0 text-property object)
+ 0
+ (next-single-property-change 0 text-property object)))
+
+(defun slime-mark-input-start ()
+ (set-marker slime-repl-last-input-start-mark
+ (marker-position slime-repl-input-start-mark))
+ (set-marker slime-repl-input-start-mark (point) (current-buffer))
+ (set-marker slime-repl-input-end-mark (point) (current-buffer)))
+
+(defun slime-mark-output-start (&optional position)
+ (let ((position (or position (point))))
+ (set-marker slime-output-start position)
+ (set-marker slime-output-end position)))
+
+(defun slime-mark-output-end ()
+ ;; Don't put slime-repl-output-face again; it would remove the
+ ;; special presentation face, for instance in the SBCL inspector.
+ (add-text-properties slime-output-start slime-output-end
+ '(;;face slime-repl-output-face
+ rear-nonsticky (face))))
+
+(defun slime-repl-bol ()
+ "Go to the beginning of line or the prompt."
+ (interactive)
+ (cond ((and (>= (point) slime-repl-input-start-mark)
+ (slime-same-line-p (point) slime-repl-input-start-mark))
+ (goto-char slime-repl-input-start-mark))
+ (t (beginning-of-line 1)))
+ (slime-preserve-zmacs-region))
+
+(defun slime-repl-eol ()
+ "Go to the end of line or the prompt."
+ (interactive)
+ (if (and (<= (point) slime-repl-input-end-mark)
+ (slime-same-line-p (point) slime-repl-input-end-mark))
+ (goto-char slime-repl-input-end-mark)
+ (end-of-line 1))
+ (slime-preserve-zmacs-region))
+
+(defun slime-preserve-zmacs-region ()
+ "In XEmacs, ensure that the zmacs-region stays active after this command."
+ (when (boundp 'zmacs-region-stays)
+ (set 'zmacs-region-stays t)))
+
+(defun slime-repl-in-input-area-p ()
+ (and (<= slime-repl-input-start-mark (point))
+ (<= (point) slime-repl-input-end-mark)))
+
+(defun slime-repl-at-prompt-start-p ()
+ ;; This will not work on non-current prompts.
+ (= (point) slime-repl-input-start-mark))
+
+(defun slime-repl-beginning-of-defun ()
+ "Move to beginning of defun."
+ (interactive)
+ ;; We call BEGINNING-OF-DEFUN if we're at the start of a prompt
+ ;; already, to trigger SLIME-REPL-MODE-BEGINNING-OF-DEFUN by means
+ ;; of the locally bound BEGINNING-OF-DEFUN-FUNCTION, in order to
+ ;; jump to the start of the previous prompt.
+ (if (and (not (slime-repl-at-prompt-start-p))
+ (slime-repl-in-input-area-p))
+ (goto-char slime-repl-input-start-mark)
+ (beginning-of-defun))
+ t)
+
+(defun slime-repl-end-of-defun ()
+ "Move to next of defun."
+ (interactive)
+ ;; C.f. SLIME-REPL-BEGINNING-OF-DEFUN.
+ (if (and (not (= (point) slime-repl-input-end-mark))
+ (slime-repl-in-input-area-p))
+ (goto-char slime-repl-input-end-mark)
+ (end-of-defun))
+ t)
+
+;; FIXME: Shouldn't this be (= (point) slime-repl-input-end-mark)?
+(defun slime-repl-at-prompt-end-p ()
+ (and (get-char-property (max 1 (1- (point))) 'slime-repl-prompt)
+ (not (get-char-property (point) 'slime-repl-prompt))))
+
+(defun slime-repl-find-prompt (move)
+ (let ((origin (point)))
+ (loop (funcall move)
+ (when (or (slime-repl-at-prompt-end-p) (bobp) (eobp))
+ (return)))
+ (unless (slime-repl-at-prompt-end-p)
+ (goto-char origin))))
+
+(defun slime-search-property-change-fn (prop &optional backward)
+ (with-lexical-bindings (prop)
+ (if backward
+ (lambda ()
+ (goto-char
+ (previous-single-char-property-change (point) prop)))
+ (lambda ()
+ (goto-char
+ (next-single-char-property-change (point) prop))))))
+
+(defun slime-repl-previous-prompt ()
+ "Move backward to the previous prompt."
+ (interactive)
+ (slime-repl-find-prompt
+ (slime-search-property-change-fn 'slime-repl-prompt t)))
+
+(defun slime-repl-next-prompt ()
+ "Move forward to the next prompt."
+ (interactive)
+ (slime-repl-find-prompt
+ (slime-search-property-change-fn 'slime-repl-prompt)))
+
+(defvar slime-repl-return-hooks)
+
+(defun slime-repl-return (&optional end-of-input)
+ "Evaluate the current input string, or insert a newline.
+Send the current input ony if a whole expression has been entered,
+i.e. the parenthesis are matched.
+
+With prefix argument send the input even if the parenthesis are not
+balanced."
+ (interactive "P")
+ (slime-check-connected)
+ (assert (<= (point) slime-repl-input-end-mark))
+ (cond (end-of-input
+ (slime-repl-send-input))
+ (slime-repl-read-mode ; bad style?
+ (slime-repl-send-input t))
+ ((and (get-text-property (point) 'slime-repl-old-input)
+ (< (point) slime-repl-input-start-mark))
+ (slime-repl-grab-old-input end-of-input)
+ (slime-repl-recenter-if-needed))
+ ((run-hook-with-args-until-success 'slime-repl-return-hooks))
+ ((slime-input-complete-p slime-repl-input-start-mark
+ (ecase slime-repl-return-behaviour
+ (:send-only-if-after-complete (min (point) slime-repl-input-end-mark))
+ (:send-if-complete slime-repl-input-end-mark)))
+ (slime-repl-send-input t))
+ (t
+ (slime-repl-newline-and-indent)
+ (message "[input not complete]"))))
+
+(defun slime-repl-recenter-if-needed ()
+ "Make sure that slime-repl-input-end-mark is visible."
+ (unless (pos-visible-in-window-p slime-repl-input-end-mark)
+ (save-excursion
+ (goto-char slime-repl-input-end-mark)
+ (recenter -1))))
+
+(defun slime-repl-send-input (&optional newline)
+ "Goto to the end of the input and send the current input.
+If NEWLINE is true then add a newline at the end of the input."
+ (when (< (point) slime-repl-input-start-mark)
+ (error "No input at point."))
+ (goto-char slime-repl-input-end-mark)
+ (let ((end (point))) ; end of input, without the newline
+ (slime-repl-add-to-input-history
+ (buffer-substring slime-repl-input-start-mark end))
+ (when newline
+ (insert "\n")
+ (slime-repl-show-maximum-output))
+ (let ((inhibit-read-only t))
+ (add-text-properties slime-repl-input-start-mark
+ (point)
+ `(slime-repl-old-input
+ ,(incf slime-repl-old-input-counter))))
+ (let ((overlay (make-overlay slime-repl-input-start-mark end)))
+ ;; These properties are on an overlay so that they won't be taken
+ ;; by kill/yank.
+ (overlay-put overlay 'read-only t)
+ (overlay-put overlay 'face 'slime-repl-input-face)))
+ (let ((input (slime-repl-current-input)))
+ (goto-char slime-repl-input-end-mark)
+ (slime-mark-input-start)
+ (slime-mark-output-start)
+ (slime-repl-send-string input)))
+
+(defun slime-repl-grab-old-input (replace)
+ "Resend the old REPL input at point.
+If replace is non-nil the current input is replaced with the old
+input; otherwise the new input is appended. The old input has the
+text property `slime-repl-old-input'."
+ (multiple-value-bind (beg end) (slime-property-bounds 'slime-repl-old-input)
+ (let ((old-input (buffer-substring beg end)) ;;preserve
+ ;;properties, they will be removed later
+ (offset (- (point) beg)))
+ ;; Append the old input or replace the current input
+ (cond (replace (goto-char slime-repl-input-start-mark))
+ (t (goto-char slime-repl-input-end-mark)
+ (unless (eq (char-before) ?\ )
+ (insert " "))))
+ (delete-region (point) slime-repl-input-end-mark)
+ (save-excursion (insert old-input))
+ (forward-char offset))))
+
+(defun slime-property-bounds (prop)
+ "Return two the positions of the previous and next changes to PROP.
+PROP is the name of a text property."
+ (let* ((beg (save-excursion
+ ;; previous-single-char-property-change searches for a
+ ;; property change from the previous character, but we
+ ;; want to look for a change from the point. We step
+ ;; forward one char to avoid doing the wrong thing if
+ ;; we're at the beginning of the old input. -luke
+ ;; (18/Jun/2004)
+ (unless (not (get-text-property (point) prop))
+ ;; alanr unless we are sitting right after it May 19, 2005
+ (ignore-errors (forward-char)))
+ (previous-single-char-property-change (point) prop)))
+ (end (save-excursion
+ (if (get-text-property (point) prop)
+ (progn (goto-char (next-single-char-property-change
+ (point) prop))
+ (skip-chars-backward "\n \t\r" beg)
+ (point))
+ (point)))))
+ (values beg end)))
+
+(defun slime-repl-closing-return ()
+ "Evaluate the current input string after closing all open lists."
+ (interactive)
+ (goto-char (point-max))
+ (save-restriction
+ (narrow-to-region slime-repl-input-start-mark (point))
+ (while (ignore-errors (save-excursion (backward-up-list 1)) t)
+ (insert ")")))
+ (slime-repl-return))
+
+(defun slime-repl-newline-and-indent ()
+ "Insert a newline, then indent the next line.
+Restrict the buffer from the prompt for indentation, to avoid being
+confused by strange characters (like unmatched quotes) appearing
+earlier in the buffer."
+ (interactive)
+ (save-restriction
+ (narrow-to-region slime-repl-prompt-start-mark (point-max))
+ (insert "\n")
+ (lisp-indent-line)))
+
+(defun slime-repl-delete-current-input ()
+ (delete-region slime-repl-input-start-mark slime-repl-input-end-mark))
+
+(defun slime-repl-kill-input ()
+ "Kill all text from the prompt to point."
+ (interactive)
+ (cond ((< (marker-position slime-repl-input-start-mark) (point))
+ (kill-region slime-repl-input-start-mark (point)))
+ ((= (point) (marker-position slime-repl-input-start-mark))
+ (slime-repl-delete-current-input))))
+
+(defun slime-repl-replace-input (string)
+ (slime-repl-delete-current-input)
+ (insert-and-inherit string))
+
+(defun slime-repl-input-line-beginning-position ()
+ (save-excursion
+ (goto-char slime-repl-input-start-mark)
+ (line-beginning-position)))
+
+(defvar slime-repl-clear-buffer-hook)
+
+(defun slime-repl-clear-buffer ()
+ "Delete the output generated by the Lisp process."
+ (interactive)
+ (set-marker slime-repl-last-input-start-mark nil)
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (slime-repl-input-line-beginning-position))
+ (goto-char slime-repl-input-start-mark))
+ (run-hooks 'slime-repl-clear-buffer-hook))
+
+(defun slime-repl-clear-output ()
+ "Delete the output inserted since the last input."
+ (interactive)
+ (let ((start (save-excursion
+ (slime-repl-previous-prompt)
+ (ignore-errors (forward-sexp))
+ (forward-line)
+ (point)))
+ (end (1- (slime-repl-input-line-beginning-position))))
+ (when (< start end)
+ (let ((inhibit-read-only t))
+ (delete-region start end)
+ (save-excursion
+ (goto-char start)
+ (insert ";;; output flushed"))))))
+
+(defun slime-indent-and-complete-symbol ()
+ "Indent the current line and perform symbol completion.
+First indent the line. If indenting doesn't move point, complete
+the symbol. If there's no symbol at the point, show the arglist
+for the most recently enclosed macro or function."
+ (interactive)
+ (let ((pos (point)))
+ (unless (get-text-property (line-beginning-position) 'slime-repl-prompt)
+ (lisp-indent-line))
+ (when (= pos (point))
+ (cond ((save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t))
+ (slime-complete-symbol))
+ ((memq (char-before) '(?\t ?\ ))
+ (slime-echo-arglist))))))
+
+(defun slime-repl-set-package (package)
+ "Set the package of the REPL buffer to PACKAGE."
+ (interactive (list (slime-read-package-name "Package: "
+ (slime-find-buffer-package))))
+ (with-current-buffer (slime-output-buffer)
+ (let ((unfinished-input (slime-repl-current-input)))
+ (destructuring-bind (name prompt-string)
+ (slime-eval `(swank:set-package ,package))
+ (setf (slime-lisp-package) name)
+ (setf (slime-lisp-package-prompt-string) prompt-string)
+ (slime-repl-insert-prompt)
+ (insert unfinished-input)))))
+
+
+;;;;; History
+
+(defcustom slime-repl-wrap-history nil
+ "*T to wrap history around when the end is reached."
+ :type 'boolean
+ :group 'slime-repl)
+
+(make-variable-buffer-local
+ (defvar slime-repl-input-history '()
+ "History list of strings read from the REPL buffer."))
+
+(defun slime-repl-add-to-input-history (string)
+ "Add STRING to the input history.
+Empty strings and duplicates are ignored."
+ (unless (or (equal string "")
+ (equal string (car slime-repl-input-history)))
+ (push string slime-repl-input-history)))
+
+;; These two vars contain the state of the last history search. We
+;; only use them if `last-command' was 'slime-repl-history-replace,
+;; otherwise we reinitialize them.
+
+(defvar slime-repl-input-history-position -1
+ "Newer items have smaller indices.")
+
+(defvar slime-repl-history-pattern nil
+ "The regexp most recently used for finding input history.")
+
+(defun slime-repl-history-replace (direction &optional regexp delete-at-end-p)
+ "Replace the current input with the next line in DIRECTION.
+DIRECTION is 'forward' or 'backward' (in the history list).
+If REGEXP is non-nil, only lines matching REGEXP are considered.
+If DELETE-AT-END-P is non-nil then remove the string if the end of the
+history is reached."
+ (setq slime-repl-history-pattern regexp)
+ (let* ((min-pos -1)
+ (max-pos (length slime-repl-input-history))
+ (pos0 (cond ((slime-repl-history-search-in-progress-p)
+ slime-repl-input-history-position)
+ (t min-pos)))
+ (pos (slime-repl-position-in-history pos0 direction (or regexp "")))
+ (msg nil))
+ (cond ((and (< min-pos pos) (< pos max-pos))
+ (slime-repl-replace-input (nth pos slime-repl-input-history))
+ (setq msg (format "History item: %d" pos)))
+ ((not slime-repl-wrap-history)
+ (setq msg (cond ((= pos min-pos) "End of history")
+ ((= pos max-pos) "Beginning of history"))))
+ (slime-repl-wrap-history
+ (setq pos (if (= pos min-pos) max-pos min-pos))
+ (setq msg "Wrapped history")))
+ (when (or (<= pos min-pos) (<= max-pos pos))
+ (when regexp
+ (setq msg (concat msg "; no matching item")))
+ (when delete-at-end-p
+ (slime-repl-replace-input "")))
+ ;;(message "%s [%d %d %s]" msg start-pos pos regexp)
+ (message "%s%s" msg (cond ((not regexp) "")
+ (t (format "; current regexp: %s" regexp))))
+ (setq slime-repl-input-history-position pos)
+ (setq this-command 'slime-repl-history-replace)))
+
+(defun slime-repl-history-search-in-progress-p ()
+ (eq last-command 'slime-repl-history-replace))
+
+(defun slime-repl-terminate-history-search ()
+ (setq last-command this-command))
+
+(defun slime-repl-position-in-history (start-pos direction regexp)
+ "Return the position of the history item matching regexp.
+Return -1 resp. the length of the history if no item matches"
+ ;; Loop through the history list looking for a matching line
+ (let* ((step (ecase direction
+ (forward -1)
+ (backward 1)))
+ (history slime-repl-input-history)
+ (len (length history)))
+ (loop for pos = (+ start-pos step) then (+ pos step)
+ if (< pos 0) return -1
+ if (<= len pos) return len
+ if (string-match regexp (nth pos history)) return pos)))
+
+(defun slime-repl-previous-input ()
+ "Cycle backwards through input history.
+If the `last-command' was a history navigation command use the
+same search pattern for this command.
+Otherwise use the current input as search pattern."
+ (interactive)
+ (slime-repl-history-replace 'backward (slime-repl-history-pattern t) t))
+
+(defun slime-repl-next-input ()
+ "Cycle forwards through input history.
+See `slime-repl-previous-input'."
+ (interactive)
+ (slime-repl-history-replace 'forward (slime-repl-history-pattern t) t))
+
+(defun slime-repl-forward-input ()
+ "Cycle forwards through input history."
+ (interactive)
+ (slime-repl-history-replace 'forward (slime-repl-history-pattern) t))
+
+(defun slime-repl-backward-input ()
+ "Cycle backwards through input history."
+ (interactive)
+ (slime-repl-history-replace 'backward (slime-repl-history-pattern) t))
+
+(defun slime-repl-previous-matching-input (regexp)
+ (interactive "sPrevious element matching (regexp): ")
+ (slime-repl-terminate-history-search)
+ (slime-repl-history-replace 'backward regexp))
+
+(defun slime-repl-next-matching-input (regexp)
+ (interactive "sNext element matching (regexp): ")
+ (slime-repl-terminate-history-search)
+ (slime-repl-history-replace 'forward regexp))
+
+(defun slime-repl-history-pattern (&optional use-current-input)
+ "Return the regexp for the navigation commands."
+ (cond ((slime-repl-history-search-in-progress-p)
+ slime-repl-history-pattern)
+ (use-current-input
+ (let ((str (slime-repl-current-input)))
+ (cond ((string-match "^[ \n]*$" str) nil)
+ (t (concat "^" (regexp-quote str))))))
+ (t nil)))
+
+(defun slime-repl-delete-from-input-history (string)
+ "Delete STRING from the repl input history.
+
+When string is not provided then clear the current repl input and
+use it as an input. This is useful to get rid of unwanted repl
+history entries while navigating the repl history."
+ (interactive (list (slime-repl-current-input)))
+ (let ((merged-history
+ (slime-repl-merge-histories slime-repl-input-history
+ (slime-repl-read-history nil t))))
+ (setq slime-repl-input-history
+ (delete* string merged-history :test #'string=))
+ (slime-repl-save-history))
+ (slime-repl-delete-current-input))
+
+;;;;; Persistent History
+
+(defun slime-repl-merge-histories (old-hist new-hist)
+ "Merge entries from OLD-HIST and NEW-HIST."
+ ;; Newer items in each list are at the beginning.
+ (let* ((ht (make-hash-table :test #'equal))
+ (test (lambda (entry)
+ (or (gethash entry ht)
+ (progn (setf (gethash entry ht) t)
+ nil)))))
+ (append (remove-if test new-hist)
+ (remove-if test old-hist))))
+
+(defun slime-repl-load-history (&optional filename)
+ "Set the current SLIME REPL history.
+It can be read either from FILENAME or `slime-repl-history-file' or
+from a user defined filename."
+ (interactive (list (slime-repl-read-history-filename)))
+ (let ((file (or filename slime-repl-history-file)))
+ (setq slime-repl-input-history (slime-repl-read-history file t))))
+
+(defun slime-repl-read-history (&optional filename noerrer)
+ "Read and return the history from FILENAME.
+The default value for FILENAME is `slime-repl-history-file'.
+If NOERROR is true return and the file doesn't exits return nil."
+ (let ((file (or filename slime-repl-history-file)))
+ (cond ((not (file-readable-p file)) '())
+ (t (with-temp-buffer
+ (insert-file-contents file)
+ (read (current-buffer)))))))
+
+(defun slime-repl-read-history-filename ()
+ (read-file-name "Use SLIME REPL history from file: "
+ slime-repl-history-file))
+
+(defun slime-repl-save-merged-history (&optional filename)
+ "Read the history file, merge the current REPL history and save it.
+This tries to be smart in merging the history from the file and the
+current history in that it tries to detect the unique entries using
+`slime-repl-merge-histories'."
+ (interactive (list (slime-repl-read-history-filename)))
+ (let ((file (or filename slime-repl-history-file)))
+ (with-temp-message "saving history..."
+ (let ((hist (slime-repl-merge-histories (slime-repl-read-history file t)
+ slime-repl-input-history)))
+ (slime-repl-save-history file hist)))))
+
+(defun slime-repl-save-history (&optional filename history)
+ "Simply save the current SLIME REPL history to a file.
+When SLIME is setup to always load the old history and one uses only
+one instance of slime all the time, there is no need to merge the
+files and this function is sufficient.
+
+When the list is longer than `slime-repl-history-size' it will be
+truncated. That part is untested, though!"
+ (interactive (list (slime-repl-read-history-filename)))
+ (let ((file (or filename slime-repl-history-file))
+ (hist (or history slime-repl-input-history)))
+ (unless (file-writable-p file)
+ (error (format "History file not writable: %s" file)))
+ (let ((hist (subseq hist 0 (min (length hist) slime-repl-history-size))))
+ ;;(message "saving %s to %s\n" hist file)
+ (with-temp-file file
+ (let ((cs slime-repl-history-file-coding-system)
+ (print-length nil) (print-level nil))
+ (setq buffer-file-coding-system cs)
+ (insert (format ";; -*- coding: %s -*-\n" cs))
+ (insert ";; History for SLIME REPL. Automatically written.\n"
+ ";; Edit only if you know what you're doing\n")
+ (prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))))
+
+(defun slime-repl-save-all-histories ()
+ "Save the history in each repl buffer."
+ (dolist (b (buffer-list))
+ (with-current-buffer b
+ (when (eq major-mode 'slime-repl-mode)
+ (slime-repl-safe-save-merged-history)))))
+
+(defun slime-repl-safe-save-merged-history ()
+ (slime-repl-call-with-handler
+ #'slime-repl-save-merged-history
+ "%S while saving the history. Continue? "))
+
+(defun slime-repl-safe-load-history ()
+ (slime-repl-call-with-handler
+ #'slime-repl-load-history
+ "%S while loading the history. Continue? "))
+
+(defun slime-repl-call-with-handler (fun query)
+ "Call FUN in the context of an error handler.
+The handler will use qeuery to ask the use if the error should be ingored."
+ (condition-case err
+ (funcall fun)
+ (error
+ (if (y-or-n-p (format query (error-message-string err)))
+ nil
+ (signal (car err) (cdr err))))))
+
+
+;;;;; REPL Read Mode
+
+(define-key slime-repl-mode-map
+ (string slime-repl-shortcut-dispatch-char) 'slime-handle-repl-shortcut)
+
+(define-minor-mode slime-repl-read-mode
+ "Mode the read input from Emacs
+\\{slime-repl-read-mode-map}"
+ nil
+ "[read]"
+ '(("\C-m" . slime-repl-return)
+ ("\C-c\C-b" . slime-repl-read-break)
+ ("\C-c\C-c" . slime-repl-read-break)))
+
+(make-variable-buffer-local
+ (defvar slime-read-string-threads nil))
+
+(make-variable-buffer-local
+ (defvar slime-read-string-tags nil))
+
+(defun slime-repl-read-string (thread tag)
+ (slime-switch-to-output-buffer)
+ (push thread slime-read-string-threads)
+ (push tag slime-read-string-tags)
+ (goto-char (point-max))
+ (slime-mark-output-end)
+ (slime-mark-input-start)
+ (slime-repl-read-mode 1))
+
+(defun slime-y-or-n-p (thread tag question)
+ (slime-dispatch-event `(:emacs-return ,thread ,tag ,(y-or-n-p question))))
+
+(defun slime-repl-return-string (string)
+ (slime-dispatch-event `(:emacs-return-string
+ ,(pop slime-read-string-threads)
+ ,(pop slime-read-string-tags)
+ ,string))
+ (slime-repl-read-mode -1))
+
+(defun slime-repl-read-break ()
+ (interactive)
+ (slime-dispatch-event `(:emacs-interrupt ,(car slime-read-string-threads))))
+
+(defun slime-repl-abort-read (thread tag)
+ (with-current-buffer (slime-output-buffer)
+ (pop slime-read-string-threads)
+ (pop slime-read-string-tags)
+ (slime-repl-read-mode -1)
+ (message "Read aborted")))
+
+
+;;;;; REPL handlers
+
+(defstruct (slime-repl-shortcut (:conc-name slime-repl-shortcut.))
+ symbol names handler one-liner)
+
+(defvar slime-repl-shortcut-table nil
+ "A list of slime-repl-shortcuts")
+
+(defvar slime-repl-shortcut-history '()
+ "History list of shortcut command names.")
+
+(defun slime-handle-repl-shortcut ()
+ (interactive)
+ (if (> (point) slime-repl-input-start-mark)
+ (insert (string slime-repl-shortcut-dispatch-char))
+ (let ((shortcut (slime-lookup-shortcut
+ (completing-read "Command: "
+ (slime-bogus-completion-alist
+ (slime-list-all-repl-shortcuts))
+ nil t nil
+ 'slime-repl-shortcut-history))))
+ (call-interactively (slime-repl-shortcut.handler shortcut)))))
+
+(defun slime-list-all-repl-shortcuts ()
+ (loop for shortcut in slime-repl-shortcut-table
+ append (slime-repl-shortcut.names shortcut)))
+
+(defun slime-lookup-shortcut (name)
+ (find-if (lambda (s) (member name (slime-repl-shortcut.names s)))
+ slime-repl-shortcut-table))
+
+(defmacro defslime-repl-shortcut (elisp-name names &rest options)
+ "Define a new repl shortcut. ELISP-NAME is a symbol specifying
+ the name of the interactive function to create, or NIL if no
+ function should be created. NAMES is a list of (full-name .
+ aliases). OPTIONS is an olist specifying the handler and the
+ help text."
+ `(progn
+ ,(when elisp-name
+ `(defun ,elisp-name ()
+ (interactive)
+ (call-interactively ,(second (assoc :handler options)))))
+ (let ((new-shortcut (make-slime-repl-shortcut
+ :symbol ',elisp-name
+ :names (list ,@names)
+ ,@(apply #'append options))))
+ (setq slime-repl-shortcut-table
+ (remove-if (lambda (s)
+ (member ',(car names) (slime-repl-shortcut.names s)))
+ slime-repl-shortcut-table))
+ (push new-shortcut slime-repl-shortcut-table)
+ ',elisp-name)))
+
+(defun slime-list-repl-short-cuts ()
+ (interactive)
+ (slime-with-output-to-temp-buffer ("*slime-repl-help*") nil
+ (let ((table (sort* (copy-list slime-repl-shortcut-table) #'string<
+ :key (lambda (x)
+ (car (slime-repl-shortcut.names x))))))
+ (dolist (shortcut table)
+ (let ((names (slime-repl-shortcut.names shortcut)))
+ (insert (pop names)) ;; first print the "full" name
+ (when names
+ ;; we also have aliases
+ (insert " (aka ")
+ (while (cdr names)
+ (insert (pop names) ", "))
+ (insert (car names) ")"))
+ (insert "\n " (slime-repl-shortcut.one-liner shortcut)
+ "\n"))))))
+
+(defun slime-save-some-lisp-buffers ()
+ (if slime-repl-only-save-lisp-buffers
+ (save-some-buffers nil (lambda ()
+ (and (memq major-mode slime-lisp-modes)
+ (not (null buffer-file-name)))))
+ (save-some-buffers)))
+
+(defslime-repl-shortcut slime-repl-shortcut-help ("help" "?")
+ (:handler 'slime-list-repl-short-cuts)
+ (:one-liner "Display the help."))
+
+(defslime-repl-shortcut nil ("change-directory" "!d" "cd")
+ (:handler 'slime-set-default-directory)
+ (:one-liner "Change the current directory."))
+
+(defslime-repl-shortcut nil ("pwd")
+ (:handler (lambda ()
+ (interactive)
+ (let ((dir (slime-eval `(swank:default-directory))))
+ (message "Directory %s" dir))))
+ (:one-liner "Show the current directory."))
+
+(defslime-repl-shortcut slime-repl-push-directory
+ ("push-directory" "+d" "pushd")
+ (:handler (lambda (directory)
+ (interactive
+ (list (read-directory-name
+ "Push directory: "
+ (slime-eval '(swank:default-directory))
+ nil nil "")))
+ (push (slime-eval '(swank:default-directory))
+ slime-repl-directory-stack)
+ (slime-set-default-directory directory)))
+ (:one-liner "Save the current directory and set it to a new one."))
+
+(defslime-repl-shortcut slime-repl-pop-directory
+ ("pop-directory" "-d" "popd")
+ (:handler (lambda ()
+ (interactive)
+ (if (null slime-repl-directory-stack)
+ (message "Directory stack is empty.")
+ (slime-set-default-directory
+ (pop slime-repl-directory-stack)))))
+ (:one-liner "Restore the last saved directory."))
+
+(defslime-repl-shortcut nil ("change-package" "!p" "in-package" "in")
+ (:handler 'slime-repl-set-package)
+ (:one-liner "Change the current package."))
+
+(defslime-repl-shortcut slime-repl-push-package ("push-package" "+p")
+ (:handler (lambda (package)
+ (interactive (list (slime-read-package-name "Package: ")))
+ (push (slime-lisp-package) slime-repl-package-stack)
+ (slime-repl-set-package package)))
+ (:one-liner "Save the current package and set it to a new one."))
+
+(defslime-repl-shortcut slime-repl-pop-package ("pop-package" "-p")
+ (:handler (lambda ()
+ (interactive)
+ (if (null slime-repl-package-stack)
+ (message "Package stack is empty.")
+ (slime-repl-set-package
+ (pop slime-repl-package-stack)))))
+ (:one-liner "Restore the last saved package."))
+
+(defslime-repl-shortcut slime-repl-resend ("resend-form")
+ (:handler (lambda ()
+ (interactive)
+ (insert (car slime-repl-input-history))
+ (insert "\n")
+ (slime-repl-send-input)))
+ (:one-liner "Resend the last form."))
+
+(defslime-repl-shortcut slime-repl-disconnect ("disconnect")
+ (:handler 'slime-disconnect)
+ (:one-liner "Disconnect all connections."))
+
+(defslime-repl-shortcut slime-repl-sayoonara ("sayoonara")
+ (:handler (lambda ()
+ (interactive)
+ (when (slime-connected-p)
+ (slime-quit-lisp))
+ (slime-kill-all-buffers)))
+ (:one-liner "Quit all Lisps and close all SLIME buffers."))
+
+(defslime-repl-shortcut slime-repl-quit ("quit")
+ (:handler 'slime-quit-lisp)
+ (:one-liner "Quit the current Lisp."))
+
+(defslime-repl-shortcut slime-repl-defparameter ("defparameter" "!")
+ (:handler (lambda (name value)
+ (interactive (list (slime-read-symbol-name "Name (symbol): " t)
+ (slime-read-from-minibuffer "Value: " "*")))
+ (insert "(cl:defparameter " name " " value
+ " \"REPL generated global variable.\")")
+ (slime-repl-send-input t)))
+ (:one-liner "Define a new global, special, variable."))
+
+(defslime-repl-shortcut slime-repl-compile-and-load ("compile-and-load" "cl")
+ (:handler (lambda (filename)
+ (interactive (list (expand-file-name
+ (read-file-name "File: " nil nil nil nil))))
+ (slime-save-some-lisp-buffers)
+ (slime-eval-async
+ `(swank:compile-file-if-needed
+ ,(slime-to-lisp-filename filename) t)
+ (slime-make-compilation-finished-continuation (current-buffer)))))
+ (:one-liner "Compile (if neccessary) and load a lisp file."))
+
+(defslime-repl-shortcut nil ("restart-inferior-lisp")
+ (:handler 'slime-restart-inferior-lisp)
+ (:one-liner "Restart *inferior-lisp* and reconnect SLIME."))
+
+(defun slime-restart-inferior-lisp ()
+ (interactive)
+ (assert (slime-inferior-process) () "No inferior lisp process")
+ (slime-eval-async '(swank:quit-lisp))
+ (set-process-filter (slime-connection) nil)
+ (set-process-sentinel (slime-connection) 'slime-restart-sentinel))
+
+(defun slime-restart-sentinel (process message)
+ "Restart the inferior lisp process.
+Also rearrange windows."
+ (assert (process-status process) 'closed)
+ (let* ((proc (slime-inferior-process process))
+ (args (slime-inferior-lisp-args proc))
+ (buffer (buffer-name (process-buffer proc)))
+ (buffer-window (get-buffer-window buffer))
+ (new-proc (slime-start-lisp (plist-get args :program)
+ (plist-get args :program-args)
+ nil
+ buffer))
+ (repl-buffer (slime-repl-buffer nil process))
+ (repl-window (and repl-buffer (get-buffer-window repl-buffer))))
+ (slime-net-close process)
+ (slime-inferior-connect new-proc args)
+ (cond ((and repl-window (not buffer-window))
+ (set-window-buffer repl-window buffer)
+ (select-window repl-window))
+ (repl-window
+ (select-window repl-window))
+ (t
+ (pop-to-buffer buffer)))
+ (switch-to-buffer buffer)
+ (goto-char (point-max))))
+
+
+;;;;; Cleanup after a quit
+
+(defun slime-kill-all-buffers ()
+ "Kill all the slime related buffers. This is only used by the
+ repl command sayoonara."
+ (dolist (buf (buffer-list))
+ (when (or (string= (buffer-name buf) slime-event-buffer-name)
+ (string-match "^\\*inferior-lisp*" (buffer-name buf))
+ (string-match "^\\*slime-repl .*\\*$" (buffer-name buf))
+ (string-match "^\\*sldb .*\\*$" (buffer-name buf))
+ (string-match "^\\*SLIME.*\\*$" (buffer-name buf)))
+ (kill-buffer buf))))
+
+
+;;;; Compilation and the creation of compiler-note annotations
+
+(defvar slime-highlight-compiler-notes t
+ "*When non-nil annotate buffers with compilation notes etc.")
+
+(defcustom slime-display-compilation-output t
+ "Display the REPL buffer before compiling files."
+ :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
+ :group 'slime-mode)
+
+(defvar slime-before-compile-functions nil
+ "A list of function called before compiling a buffer or region.
+The function receive two arguments: the beginning and the end of the
+region that will be compiled.")
+
+(defcustom slime-compilation-finished-hook 'slime-maybe-list-compiler-notes
+ "Hook called with a list of compiler notes after a compilation."
+ :group 'slime-mode
+ :type 'hook
+ :options '(slime-maybe-list-compiler-notes
+ slime-list-compiler-notes
+ slime-maybe-show-xrefs-for-notes))
+
+(defcustom slime-goto-first-note-after-compilation nil
+ "When T next-note will always goto to the first note in a
+final, no matter where the point is."
+ :group 'slime-mode
+ :type 'boolean)
+
+(defun slime-compile-and-load-file ()
+ "Compile and load the buffer's file and highlight compiler notes.
+
+Each source location that is the subject of a compiler note is
+underlined and annotated with the relevant information. The commands
+`slime-next-note' and `slime-previous-note' can be used to navigate
+between compiler notes and to display their full details."
+ (interactive)
+ (slime-compile-file t))
+
+(defun slime-compile-file (&optional load)
+ "Compile current buffer's file and highlight resulting compiler notes.
+
+See `slime-compile-and-load-file' for further details."
+ (interactive)
+ ;;(unless (memq major-mode slime-lisp-modes)
+ ;; (error "Only valid in lisp-mode"))
+ (check-parens)
+ (unless buffer-file-name
+ (error "Buffer %s is not associated with a file." (buffer-name)))
+ (when (and (buffer-modified-p)
+ (y-or-n-p (format "Save file %s? " (buffer-file-name))))
+ (save-buffer))
+ (run-hook-with-args 'slime-before-compile-functions (point-min) (point-max))
+ (let ((file (slime-to-lisp-filename (buffer-file-name))))
+ (slime-insert-transcript-delimiter (format "Compile file %s" file))
+ (when slime-display-compilation-output
+ (slime-display-output-buffer))
+ (slime-eval-async
+ `(swank:compile-file-for-emacs ,file ,(if load t nil))
+ (slime-rcurry #'slime-compilation-finished (current-buffer)))
+ (message "Compiling %s..." file)))
+
+(defun slime-compile-defun ()
+ "Compile the current toplevel form."
+ (interactive)
+ (apply #'slime-compile-region (slime-region-for-defun-at-point)))
+
+(defun slime-compile-region (start end)
+ "Compile the region."
+ (interactive "r")
+ (run-hook-with-args 'slime-before-compile-functions start end)
+ (slime-compile-string (buffer-substring-no-properties start end) start))
+
+(defun slime-compile-string (string start-offset)
+ (slime-eval-async
+ `(swank:compile-string-for-emacs
+ ,string
+ ,(buffer-name)
+ ,start-offset
+ ,(if (buffer-file-name) (file-name-directory (buffer-file-name))))
+ (slime-make-compilation-finished-continuation (current-buffer))))
+
+(defun slime-note-count-string (severity count &optional suppress-if-zero)
+ (cond ((and (zerop count) suppress-if-zero)
+ "")
+ (t (format "%2d %s%s " count severity (if (= count 1) "" "s")))))
+
+(defun slime-show-note-counts (notes &optional secs)
+ (let ((nerrors 0) (nwarnings 0) (nstyle-warnings 0) (nnotes 0))
+ (dolist (note notes)
+ (ecase (slime-note.severity note)
+ ((:error :read-error) (incf nerrors))
+ (:warning (incf nwarnings))
+ (:style-warning (incf nstyle-warnings))
+ (:note (incf nnotes))))
+ (message "Compilation finished:%s%s%s%s%s"
+ (slime-note-count-string "error" nerrors)
+ (slime-note-count-string "warning" nwarnings)
+ (slime-note-count-string "style-warning" nstyle-warnings t)
+ (slime-note-count-string "note" nnotes)
+ (if secs (format "[%s secs]" secs) ""))))
+
+(defun slime-xrefs-for-notes (notes)
+ (let ((xrefs))
+ (dolist (note notes)
+ (let* ((location (getf note :location))
+ (fn (cadr (assq :file (cdr location))))
+ (file (assoc fn xrefs))
+ (node
+ (cons (format "%s: %s"
+ (getf note :severity)
+ (slime-one-line-ify (getf note :message)))
+ location)))
+ (when fn
+ (if file
+ (push node (cdr file))
+ (setf xrefs (acons fn (list node) xrefs))))))
+ xrefs))
+
+(defun slime-one-line-ify (string)
+ "Return a single-line version of STRING.
+Each newlines and following indentation is replaced by a single space."
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (while (re-search-forward "\n[\n \t]*" nil t)
+ (replace-match " "))
+ (buffer-string)))
+
+(defun slime-compilation-finished (result buffer &optional emacs-snapshot)
+ (let ((notes (slime-compiler-notes)))
+ (with-current-buffer buffer
+ (setf slime-compilation-just-finished t)
+ (destructuring-bind (result secs) result
+ (slime-show-note-counts notes secs)
+ (when slime-highlight-compiler-notes
+ (slime-highlight-notes notes))))
+ (run-hook-with-args 'slime-compilation-finished-hook notes emacs-snapshot)))
+
+(defun slime-make-compilation-finished-continuation (current-buffer &optional emacs-snapshot)
+ (lexical-let ((buffer current-buffer) (snapshot emacs-snapshot))
+ (lambda (result)
+ (slime-compilation-finished result buffer snapshot))))
+
+(defun slime-highlight-notes (notes)
+ "Highlight compiler notes, warnings, and errors in the buffer."
+ (interactive (list (slime-compiler-notes)))
+ (with-temp-message "Highlighting notes..."
+ (save-excursion
+ (save-restriction
+ (widen) ; highlight notes on the whole buffer
+ (slime-remove-old-overlays)
+ (mapc #'slime-overlay-note (slime-merge-notes-for-display notes))))))
+
+(defun slime-compiler-notes ()
+ "Return all compiler notes, warnings, and errors."
+ (slime-eval `(swank:compiler-notes-for-emacs)))
+
+(defun slime-remove-old-overlays ()
+ "Delete the existing Slime overlays in the current buffer."
+ (dolist (buffer (slime-filter-buffers (lambda () slime-mode)))
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen) ; remove overlays within the whole buffer.
+ (goto-char (point-min))
+ (while (not (eobp))
+ (dolist (o (overlays-at (point)))
+ (when (overlay-get o 'slime)
+ (delete-overlay o)))
+ (goto-char (next-overlay-change (point)))))))))
+
+(defun slime-filter-buffers (predicate)
+ "Return a list of where PREDICATE returns true.
+PREDICATE is executed in the buffer to test."
+ (remove-if-not (lambda (%buffer)
+ (with-current-buffer %buffer
+ (funcall predicate)))
+ (buffer-list)))
+
+
+;;;;; Merging together compiler notes in the same location.
+
+(defun slime-merge-notes-for-display (notes)
+ "Merge together notes that refer to the same location.
+This operation is \"lossy\" in the broad sense but not for display purposes."
+ (mapcar #'slime-merge-notes
+ (slime-group-similar 'slime-notes-in-same-location-p notes)))
+
+(defun slime-merge-notes (notes)
+ "Merge NOTES together. Keep the highest severity, concatenate the messages."
+ (let* ((new-severity (reduce #'slime-most-severe notes
+ :key #'slime-note.severity))
+ (new-message (mapconcat #'slime-note.short-message notes "\n")))
+ (let ((new-note (copy-list (car notes))))
+ (setf (getf new-note :message) new-message)
+ (setf (getf new-note :severity) new-severity)
+ new-note)))
+
+;; XXX: unused function
+(defun slime-intersperse (element list)
+ "Intersperse ELEMENT between each element of LIST."
+ (if (null list)
+ '()
+ (cons (car list)
+ (mapcan (lambda (x) (list element x)) (cdr list)))))
+
+(defun slime-notes-in-same-location-p (a b)
+ (equal (slime-note.location a) (slime-note.location b)))
+
+(defun slime-group-similar (similar-p list)
+ "Return the list of lists of 'similar' adjacent elements of LIST.
+The function SIMILAR-P is used to test for similarity.
+The order of the input list is preserved."
+ (if (null list)
+ nil
+ (let ((accumulator (list (list (car list)))))
+ (dolist (x (cdr list))
+ (if (funcall similar-p x (caar accumulator))
+ (push x (car accumulator))
+ (push (list x) accumulator)))
+ (reverse (mapcar #'reverse accumulator)))))
+
+
+;;;;; Compiler notes list
+
+(defun slime-maybe-show-xrefs-for-notes (&optional notes emacs-snapshot)
+ "Show the compiler notes NOTES if they come from more than one file."
+ (let* ((notes (or notes (slime-compiler-notes)))
+ (xrefs (slime-xrefs-for-notes notes)))
+ (when (slime-length> xrefs 1) ; >1 file
+ (slime-show-xrefs
+ xrefs 'definition "Compiler notes" (slime-current-package)
+ emacs-snapshot))))
+
+(defun slime-note-has-location-p (note)
+ (not (eq ':error (car (slime-note.location note)))))
+
+(defun slime-maybe-list-compiler-notes (notes &optional emacs-snapshot)
+ "Show the compiler notes if appropriate."
+ ;; don't pop up a buffer if all notes are already annotated in the
+ ;; buffer itself
+ (unless (every #'slime-note-has-location-p notes)
+ (slime-list-compiler-notes notes emacs-snapshot)))
+
+(defun slime-list-compiler-notes (notes &optional emacs-snapshot)
+ "Show the compiler notes NOTES in tree view."
+ (interactive (list (slime-compiler-notes)))
+ (with-temp-message "Preparing compiler note tree..."
+ (with-current-buffer
+ (slime-get-temp-buffer-create "*compiler notes*"
+ :mode 'slime-compiler-notes-mode
+ :emacs-snapshot emacs-snapshot)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (when (null notes)
+ (insert "[no notes]"))
+ (dolist (tree (slime-compiler-notes-to-tree notes))
+ (slime-tree-insert tree "")
+ (insert "\n")))
+ (setq buffer-read-only t)
+ (goto-char (point-min)))))
+
+(defun slime-alistify (list key test)
+ "Partition the elements of LIST into an alist.
+KEY extracts the key from an element and TEST is used to compare keys."
+ (declare (type function key))
+ (let ((alist '()))
+ (dolist (e list)
+ (let* ((k (funcall key e))
+ (probe (assoc* k alist :test test)))
+ (if probe
+ (push e (cdr probe))
+ (push (cons k (list e)) alist))))
+ ;; Put them back in order.
+ (loop for (key . value) in alist
+ collect (cons key (reverse value)))))
+
+(defun slime-note.severity (note)
+ (plist-get note :severity))
+
+(defun slime-note.message (note)
+ (plist-get note :message))
+
+(defun slime-note.short-message (note)
+ (or (plist-get note :short-message)
+ (plist-get note :message)))
+
+(defun slime-note.location (note)
+ (plist-get note :location))
+
+(defun slime-severity-label (severity)
+ (ecase severity
+ (:note "Notes")
+ (:warning "Warnings")
+ (:error "Errors")
+ (:read-error "Read Errors")
+ (:style-warning "Style Warnings")))
+
+(defvar slime-tree-printer 'slime-tree-default-printer)
+
+(defun slime-tree-for-note (note)
+ (make-slime-tree :item (slime-note.message note)
+ :plist (list 'note note)
+ :print-fn slime-tree-printer))
+
+(defun slime-tree-for-severity (severity notes collapsed-p)
+ (make-slime-tree :item (format "%s (%d)"
+ (slime-severity-label severity)
+ (length notes))
+ :kids (mapcar #'slime-tree-for-note notes)
+ :collapsed-p collapsed-p))
+
+(defun slime-compiler-notes-to-tree (notes)
+ (let* ((alist (slime-alistify notes #'slime-note.severity #'eq))
+ (collapsed-p (slime-length> alist 1)))
+ (loop for (severity . notes) in alist
+ collect (slime-tree-for-severity severity notes
+ collapsed-p))))
+
+(defvar slime-compiler-notes-mode-map)
+
+(define-derived-mode slime-compiler-notes-mode fundamental-mode
+ "Compiler Notes"
+ "\\<slime-compiler-notes-mode-map>\
+\\{slime-compiler-notes-mode-map}"
+ (slime-set-truncate-lines))
+
+(slime-define-keys slime-compiler-notes-mode-map
+ ((kbd "RET") 'slime-compiler-notes-default-action-or-show-details)
+ ([mouse-2] 'slime-compiler-notes-default-action-or-show-details/mouse)
+ ("q" 'slime-temp-buffer-quit))
+
+(defun slime-compiler-notes-default-action-or-show-details/mouse (event)
+ "Invoke the action pointed at by the mouse, or show details."
+ (interactive "e")
+ (destructuring-bind (mouse-2 (w pos &rest _) &rest __) event
+ (save-excursion
+ (goto-char pos)
+ (let ((fn (get-text-property (point)
+ 'slime-compiler-notes-default-action)))
+ (if fn (funcall fn) (slime-compiler-notes-show-details))))))
+
+(defun slime-compiler-notes-default-action-or-show-details ()
+ "Invoke the action at point, or show details."
+ (interactive)
+ (let ((fn (get-text-property (point) 'slime-compiler-notes-default-action)))
+ (if fn (funcall fn) (slime-compiler-notes-show-details))))
+
+(defun slime-compiler-notes-show-details ()
+ (interactive)
+ (let* ((tree (slime-tree-at-point))
+ (note (plist-get (slime-tree.plist tree) 'note))
+ (inhibit-read-only t))
+ (cond ((not (slime-tree-leaf-p tree))
+ (slime-tree-toggle tree))
+ (t
+ (slime-show-source-location (slime-note.location note) t)))))
+
+
+;;;;;; Tree Widget
+
+(defstruct (slime-tree (:conc-name slime-tree.))
+ item
+ (print-fn #'slime-tree-default-printer :type function)
+ (kids '() :type list)
+ (collapsed-p t :type boolean)
+ (prefix "" :type string)
+ (start-mark nil)
+ (end-mark nil)
+ (plist '() :type list))
+
+(defun slime-tree-leaf-p (tree)
+ (not (slime-tree.kids tree)))
+
+(defun slime-tree-default-printer (tree)
+ (princ (slime-tree.item tree) (current-buffer)))
+
+(defun slime-tree-decoration (tree)
+ (cond ((slime-tree-leaf-p tree) "-- ")
+ ((slime-tree.collapsed-p tree) "[+] ")
+ (t "-+ ")))
+
+(defun slime-tree-insert-list (list prefix)
+ "Insert a list of trees."
+ (loop for (elt . rest) on list
+ do (cond (rest
+ (insert prefix " |")
+ (slime-tree-insert elt (concat prefix " |"))
+ (insert "\n"))
+ (t
+ (insert prefix " `")
+ (slime-tree-insert elt (concat prefix " "))))))
+
+(defun slime-tree-insert-decoration (tree)
+ (insert (slime-tree-decoration tree)))
+
+(defun slime-tree-indent-item (start end prefix)
+ "Insert PREFIX at the beginning of each but the first line.
+This is used for labels spanning multiple lines."
+ (save-excursion
+ (goto-char end)
+ (beginning-of-line)
+ (while (< start (point))
+ (insert-before-markers prefix)
+ (forward-line -1))))
+
+(defun slime-tree-insert (tree prefix)
+ "Insert TREE prefixed with PREFIX at point."
+ (with-struct (slime-tree. print-fn kids collapsed-p start-mark end-mark) tree
+ (let ((line-start (line-beginning-position)))
+ (setf start-mark (point-marker))
+ (slime-tree-insert-decoration tree)
+ (funcall print-fn tree)
+ (slime-tree-indent-item start-mark (point) (concat prefix " "))
+ (add-text-properties line-start (point) (list 'slime-tree tree))
+ (set-marker-insertion-type start-mark t)
+ (when (and kids (not collapsed-p))
+ (terpri (current-buffer))
+ (slime-tree-insert-list kids prefix))
+ (setf (slime-tree.prefix tree) prefix)
+ (setf end-mark (point-marker)))))
+
+(defun slime-tree-at-point ()
+ (cond ((get-text-property (point) 'slime-tree))
+ (t (error "No tree at point"))))
+
+(defun slime-tree-delete (tree)
+ "Delete the region for TREE."
+ (delete-region (slime-tree.start-mark tree)
+ (slime-tree.end-mark tree)))
+
+(defun slime-tree-toggle (tree)
+ "Toggle the visibility of TREE's children."
+ (with-struct (slime-tree. collapsed-p start-mark end-mark prefix) tree
+ (setf collapsed-p (not collapsed-p))
+ (slime-tree-delete tree)
+ (insert-before-markers " ") ; move parent's end-mark
+ (backward-char 1)
+ (slime-tree-insert tree prefix)
+ (delete-char 1)
+ (goto-char start-mark)))
+
+
+;;;;; Adding a single compiler note
+
+(defun slime-overlay-note (note)
+ "Add a compiler note to the buffer as an overlay.
+If an appropriate overlay for a compiler note in the same location
+already exists then the new information is merged into it. Otherwise a
+new overlay is created."
+ (multiple-value-bind (start end) (slime-choose-overlay-region note)
+ (when start
+ (goto-char start)
+ (let ((severity (plist-get note :severity))
+ (message (plist-get note :message))
+ (overlay (slime-note-at-point)))
+ (if overlay
+ (slime-merge-note-into-overlay overlay severity message)
+ (slime-create-note-overlay note start end severity message))))))
+
+(defun slime-create-note-overlay (note start end severity message)
+ "Create an overlay representing a compiler note.
+The overlay has several properties:
+ FACE - to underline the relevant text.
+ SEVERITY - for future reference, :NOTE, :STYLE-WARNING, :WARNING, or :ERROR.
+ MOUSE-FACE - highlight the note when the mouse passes over.
+ HELP-ECHO - a string describing the note, both for future reference
+ and for display as a tooltip (due to the special
+ property name)."
+ (let ((overlay (make-overlay start end)))
+ (flet ((putp (name value) (overlay-put overlay name value)))
+ (putp 'slime note)
+ (putp 'face (slime-severity-face severity))
+ (putp 'severity severity)
+ (unless (slime-emacs-20-p)
+ (putp 'mouse-face 'highlight))
+ (putp 'help-echo message)
+ overlay)))
+
+;; XXX Obsolete due to `slime-merge-notes-for-display' doing the
+;; work already -- unless we decide to put several sets of notes on a
+;; buffer without clearing in between, which only this handles.
+(defun slime-merge-note-into-overlay (overlay severity message)
+ "Merge another compiler note into an existing overlay.
+The help text describes both notes, and the highest of the severities
+is kept."
+ (flet ((putp (name value) (overlay-put overlay name value))
+ (getp (name) (overlay-get overlay name)))
+ (putp 'severity (slime-most-severe severity (getp 'severity)))
+ (putp 'face (slime-severity-face (getp 'severity)))
+ (putp 'help-echo (concat (getp 'help-echo) "\n" message))))
+
+(defun slime-choose-overlay-region (note)
+ "Choose the start and end points for an overlay over NOTE.
+If the location's sexp is a list spanning multiple lines, then the
+region around the first element is used.
+Return nil if there's no useful source location."
+ (let ((location (slime-note.location note)))
+ (when location
+ (destructure-case location
+ ((:error _) _ nil) ; do nothing
+ ((:location file pos _hints)
+ (cond ((eq (car file) ':source-form) nil)
+ (t
+ (destructure-case pos
+ ((:position pos &optional alignp)
+ (if (eq (slime-note.severity note) :read-error)
+ (values pos (1+ pos))
+ (slime-choose-overlay-for-sexp location)))
+ (t
+ (slime-choose-overlay-for-sexp location))))))))))
+
+(defun slime-choose-overlay-for-sexp (location)
+ (slime-goto-source-location location)
+ (skip-chars-forward "'#`")
+ (let ((start (point)))
+ (ignore-errors (slime-forward-sexp))
+ (if (slime-same-line-p start (point))
+ (values start (point))
+ (values (1+ start)
+ (progn (goto-char (1+ start))
+ (ignore-errors (forward-sexp 1))
+ (point))))))
+
+(defun slime-same-line-p (pos1 pos2)
+ "Return t if buffer positions POS1 and POS2 are on the same line."
+ (save-excursion (goto-char (min pos1 pos2))
+ (<= (max pos1 pos2) (line-end-position))))
+
+(defun slime-severity-face (severity)
+ "Return the name of the font-lock face representing SEVERITY."
+ (ecase severity
+ (:error 'slime-error-face)
+ (:read-error 'slime-error-face)
+ (:warning 'slime-warning-face)
+ (:style-warning 'slime-style-warning-face)
+ (:note 'slime-note-face)))
+
+(defun slime-most-severe (sev1 sev2)
+ "Return the most servere of two conditions.
+Severity is ordered as :NOTE < :STYLE-WARNING < :WARNING < :ERROR."
+ ; Well, not exactly Smullyan..
+ (let ((order '(:note :style-warning :warning :error :read-error)))
+ (if (>= (position sev1 order)
+ (position sev2 order))
+ sev1
+ sev2)))
+
+;; XXX: unused function
+(defun slime-visit-source-path (source-path)
+ "Visit a full source path including the top-level form."
+ (goto-char (point-min))
+ (slime-forward-source-path source-path))
+
+(defun slime-forward-positioned-source-path (source-path)
+ "Move forward through a sourcepath from a fixed position.
+The point is assumed to already be at the outermost sexp, making the
+first element of the source-path redundant."
+ (ignore-errors
+ (slime-forward-sexp)
+ (beginning-of-defun))
+ (when-let (source-path (cdr source-path))
+ (down-list 1)
+ (slime-forward-source-path source-path)))
+
+(defun slime-forward-source-path (source-path)
+ (let ((origin (point)))
+ (condition-case nil
+ (progn
+ (loop for (count . more) on source-path
+ do (progn
+ (slime-forward-sexp count)
+ (when more (down-list 1))))
+ ;; Align at beginning
+ (slime-forward-sexp)
+ (beginning-of-sexp))
+ (error (goto-char origin)))))
+
+(defun slime-filesystem-toplevel-directory ()
+ ;; Windows doesn't have a true toplevel root directory, and all
+ ;; filenames look like "c:/foo/bar/quux.baz" from an Emacs
+ ;; perspective anyway.
+ (if (memq system-type '(ms-dos windows-nt))
+ ""
+ (file-name-as-directory "/")))
+
+(defun slime-file-name-merge-source-root (target-filename buffer-filename)
+ "Returns a filename where the source root directory of TARGET-FILENAME
+is replaced with the source root directory of BUFFER-FILENAME.
+
+If no common source root could be determined, return NIL.
+
+E.g. (slime-file-name-merge-source-root
+ \"/usr/local/src/joe/upstream/sbcl/code/late-extensions.lisp\"
+ \"/usr/local/src/joe/hacked/sbcl/compiler/deftype.lisp\")
+
+ ==> \"/usr/local/src/joe/hacked/sbcl/code/late-extensions.lisp\"
+"
+ (let ((target-dirs (slime-split-string (file-name-directory target-filename) "/" t))
+ (buffer-dirs (slime-split-string (file-name-directory buffer-filename) "/" t)))
+ ;; Starting from the end, we look if one of the TARGET-DIRS exists
+ ;; in BUFFER-FILENAME---if so, it and everything left from that dirname
+ ;; is considered to be the source root directory of BUFFER-FILENAME.
+ (loop with target-suffix-dirs = nil
+ with buffer-dirs* = (reverse buffer-dirs)
+ with target-dirs* = (reverse target-dirs)
+ for target-dir in target-dirs*
+ do (flet ((concat-dirs (dirs)
+ (apply #'concat (mapcar #'file-name-as-directory dirs))))
+ (let ((pos (position target-dir buffer-dirs* :test #'equal)))
+ (if (not pos) ; TARGET-DIR not in BUFFER-FILENAME?
+ (push target-dir target-suffix-dirs)
+ (let* ((target-suffix (concat-dirs target-suffix-dirs)) ; PUSH reversed for us!
+ (buffer-root (concat-dirs (reverse (nthcdr pos buffer-dirs*)))))
+ (return (concat (slime-filesystem-toplevel-directory)
+ buffer-root
+ target-suffix
+ (file-name-nondirectory target-filename))))))))))
+
+(defun slime-highlight-differences-in-dirname (base-dirname contrast-dirname)
+ "Returns a copy of BASE-DIRNAME where all differences between
+BASE-DIRNAME and CONTRAST-DIRNAME are propertized with a
+highlighting face."
+ (setq base-dirname (file-name-as-directory base-dirname))
+ (setq contrast-dirname (file-name-as-directory contrast-dirname))
+ (flet ((insert-dir (dirname)
+ (insert (file-name-as-directory dirname)))
+ (insert-dir/propzd (dirname)
+ (slime-insert-propertized '(face highlight) dirname)
+ (insert "/"))) ; Not exactly portable (to VMS...)
+ (let ((base-dirs (slime-split-string base-dirname "/" t))
+ (contrast-dirs (slime-split-string contrast-dirname "/" t)))
+ (with-temp-buffer
+ (loop initially (insert (slime-filesystem-toplevel-directory))
+ for base-dir in base-dirs do
+ (let ((pos (position base-dir contrast-dirs :test #'equal)))
+ (if (not pos)
+ (insert-dir/propzd base-dir)
+ (progn (insert-dir base-dir)
+ (setq contrast-dirs (nthcdr (1+ pos) contrast-dirs))))))
+ (buffer-substring (point-min) (point-max))))))
+
+(defvar slime-warn-when-possibly-tricked-by-M-. t
+ "When working on multiple source trees simultaneously, the way
+`slime-edit-definition' (M-.) works can sometimes be confusing:
+
+`M-.' visits locations that are present in the current Lisp image,
+which works perfectly well as long as the image reflects the source
+tree that one is currently looking at.
+
+In the other case, however, one can easily end up visiting a file
+in a different source root directory (the one corresponding to
+the Lisp image), and is thus easily tricked to modify the wrong
+source files---which can lead to quite some stressfull cursing.
+
+If this variable is T, a warning message is issued to raise the
+user's attention whenever `M-.' is about opening a file in a
+different source root that also exists in the source root
+directory of the user's current buffer.
+
+There's no guarantee that all possible cases are covered, but
+if you encounter such a warning, it's a strong indication that
+you should check twice before modifying.")
+
+(defun slime-maybe-warn-for-different-source-root (target-filename buffer-filename)
+ (when slime-warn-when-possibly-tricked-by-M-.
+ (let ((guessed-target (slime-file-name-merge-source-root target-filename
+ buffer-filename)))
+ (when (and guessed-target
+ (not (equal guessed-target target-filename))
+ (file-exists-p guessed-target))
+ (slime-message "Attention: This is `%s'."
+ (concat (slime-highlight-differences-in-dirname
+ (file-name-directory target-filename)
+ (file-name-directory guessed-target))
+ (file-name-nondirectory target-filename)))))))
+
+
+(defun slime-goto-location-buffer (buffer)
+ (flet ((file-truename-safe (filename) (and filename (file-truename filename))))
+ (destructure-case buffer
+ ((:file filename)
+ (let ((target-filename (file-truename-safe (slime-from-lisp-filename filename)))
+ (buffer-filename (file-truename-safe (buffer-file-name))))
+ (when buffer-filename
+ (slime-maybe-warn-for-different-source-root target-filename buffer-filename))
+ (unless (and buffer-filename (string= buffer-filename target-filename))
+ (set-buffer (find-file-noselect target-filename t))))
+ (goto-char (point-min)))
+ ((:buffer buffer-name)
+ (let ((old-buffer-filename (file-truename-safe (buffer-file-name)))
+ (target-buffer-filename (file-truename-safe
+ (buffer-file-name (get-buffer buffer-name)))))
+ (when (and target-buffer-filename old-buffer-filename)
+ (slime-maybe-warn-for-different-source-root target-buffer-filename
+ old-buffer-filename)))
+ (set-buffer buffer-name)
+ (goto-char (point-min)))
+ ((:source-form string)
+ (set-buffer (get-buffer-create "*SLIME Source Form*"))
+ (erase-buffer)
+ (lisp-mode)
+ (insert string)
+ (goto-char (point-min)))
+ ((:zip file entry)
+ (require 'arc-mode)
+ (set-buffer (find-file-noselect file t))
+ (goto-char (point-min))
+ (re-search-forward (concat " " entry "$"))
+ (let ((buffer (save-window-excursion
+ (archive-extract)
+ (current-buffer))))
+ (set-buffer buffer)
+ (goto-char (point-min)))))))
+
+(defun slime-goto-location-position (position)
+ (save-restriction-if-possible ; try to keep restriction if possible.
+ (widen)
+ (destructure-case position
+ ((:position pos &optional align-p)
+ (goto-char pos)
+ (when align-p
+ (slime-forward-sexp)
+ (beginning-of-sexp)))
+ ((:line start &optional column)
+ (goto-line start)
+ (cond (column (move-to-column column))
+ (t (skip-chars-forward " \t"))))
+ ((:function-name name)
+ (let ((case-fold-search t)
+ (name (regexp-quote name)))
+ (or
+ (re-search-forward
+ (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\S_" name) nil t)
+ (re-search-forward
+ (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +(*%s\\S_" name) nil t)
+ (re-search-forward
+ (format "[( \t]%s\\>\\(\\s \\|$\\)" name) nil t)))
+ (goto-char (match-beginning 0)))
+ ((:method name specializers &rest qualifiers)
+ (slime-search-method-location name specializers qualifiers))
+ ((:source-path source-path start-position)
+ (cond (start-position
+ (goto-char start-position)
+ (slime-forward-positioned-source-path source-path))
+ (t
+ (slime-forward-source-path source-path))))
+ ;; Goes to "start" then looks for the anchor text, then moves
+ ;; delta from that position.
+ ((:text-anchored start text delta)
+ (goto-char start)
+ (slime-isearch text)
+ (forward-char delta)))))
+
+(defun slime-search-method-location (name specializers qualifiers)
+ ;; Look for a sequence of words (def<something> method name
+ ;; qualifers specializers don't look for "T" since it isn't requires
+ ;; (arg without t) as class is taken as such.
+ (let* ((case-fold-search t)
+ (name (regexp-quote name))
+ (qualifiers (mapconcat (lambda (el) (concat ".+?\\<" el "\\>"))
+ qualifiers ""))
+ (specializers (mapconcat (lambda (el)
+ (if (eql (aref el 0) ?\()
+ (let ((spec (read el)))
+ (if (eq (car spec) 'EQL)
+ (concat ".*?\\n\\{0,1\\}.*?(EQL.*?'\\{0,1\\}" (format "%s" (second spec)) ")")
+ (error "don't understand specializer: %s,%s" el (car spec))))
+ (concat ".+?\n\\{0,1\\}.+?\\<" el "\\>")))
+ (remove "T" specializers) ""))
+ (regexp (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\s +%s%s" name
+ qualifiers specializers)))
+ (or (and (re-search-forward regexp nil t)
+ (goto-char (match-beginning 0)))
+ ;; (slime-goto-location-position `(:function-name ,name))
+ )))
+
+(defun slime-search-call-site (fname)
+ "Move to the place where FNAME called.
+Don't move if there are multiple or no calls in the current defun."
+ (save-restriction
+ (narrow-to-defun)
+ (let ((start (point))
+ (regexp (concat "(" fname "[\n \t]")))
+ (cond ((and (re-search-forward regexp nil t)
+ (not (re-search-forward regexp nil t)))
+ (goto-char (match-beginning 0)))
+ (t (goto-char start))))))
+
+(defun slime-goto-source-location (location &optional noerror)
+ "Move to the source location LOCATION. Several kinds of locations
+are supported:
+
+<location> ::= (:location <buffer> <position> <hints>)
+ | (:error <message>)
+
+<buffer> ::= (:file <filename>)
+ | (:buffer <buffername>)
+ | (:source-form <string>)
+ | (:zip <file> <entry>)
+
+<position> ::= (:position <fixnum> [<align>]) ; 1 based
+ | (:line <line> [<column>])
+ | (:function-name <string>)
+ | (:source-path <list> <start-position>)
+ | (:text-anchored <fixnum> <string> <fixnum>)
+ | (:method <name string> <specializer strings> . <qualifiers strings>)"
+ (destructure-case location
+ ((:location buffer position hints)
+ (slime-goto-location-buffer buffer)
+ (slime-goto-location-position position)
+ (when-let (snippet (getf hints :snippet))
+ (slime-isearch snippet))
+ (when-let (fname (getf hints :call-site))
+ (slime-search-call-site fname)))
+ ((:error message)
+ (if noerror
+ (slime-message "%s" message)
+ (error "%s" message)))))
+
+(defmacro slime-point-moves-p (&rest body)
+ "Execute BODY and return true if the current buffer's point moved."
+ (let ((pointvar (gensym "point-")))
+ `(let ((,pointvar (point)))
+ (save-current-buffer ,@body)
+ (/= ,pointvar (point)))))
+
+(put 'slime-point-moves-p 'lisp-indent-function 0)
+
+(defun slime-forward-sexp (&optional count)
+ "Like `forward-sexp', but understands reader-conditionals (#- and #+)."
+ (dotimes (i (or count 1))
+ (while (slime-point-moves-p (slime-forward-blanks)
+ (slime-forward-reader-comment)
+ (slime-forward-reader-conditional)))
+ (forward-sexp)))
+
+(defun slime-forward-blanks ()
+ "Move forward over all whitespace and newlines at point."
+ (ignore-errors
+ (while (slime-point-moves-p
+ (skip-syntax-forward " ")
+ ;; newlines aren't in lisp-mode's whitespace syntax class
+ (when (eolp) (forward-char))))))
+
+;; Emacs 21's forward-sexp understands #| |# comments in lisp-mode
+;; buffers, but (at least) Emacs 20's doesn't, so here it is.
+(defun slime-forward-reader-comment ()
+ "Move forward over #|...|# reader comments. The comments may be nested."
+ (when (looking-at "#|")
+ (goto-char (match-end 0))
+ (while (not (looking-at "|#"))
+ (re-search-forward (regexp-opt '("|#" "#|")))
+ (goto-char (match-beginning 0))
+ (when (looking-at "#|") ; nested comment
+ (slime-forward-reader-comment)))
+ (goto-char (match-end 0))))
+
+(defun slime-forward-reader-conditional ()
+ "Move past any reader conditional (#+ or #-) at point."
+ (when (or (looking-at "#\\+")
+ (looking-at "#-"))
+ (goto-char (match-end 0))
+ (let* ((plus-conditional-p (eq (char-before) ?+))
+ (result (slime-eval-feature-conditional (read (current-buffer)))))
+ (unless (if plus-conditional-p result (not result))
+ ;; skip this sexp
+ (slime-forward-sexp)))))
+
+(defun slime-keywordify (symbol)
+ "Make a keyword out of the symbol SYMBOL."
+ (let ((name (downcase (symbol-name symbol))))
+ (intern (if (eq ?: (aref name 0))
+ name
+ (concat ":" name)))))
+
+(defun slime-eval-feature-conditional (e)
+ "Interpret a reader conditional expression."
+ (if (symbolp e)
+ (memq (slime-keywordify e) (slime-lisp-features))
+ (funcall (ecase (slime-keywordify (car e))
+ (:and #'every)
+ (:or #'some)
+ (:not (lambda (f l) (not (apply f l)))))
+ #'slime-eval-feature-conditional
+ (cdr e))))
+
+
+;;;;; Incremental search
+;;
+;; Search for the longest match of a string in either direction.
+;;
+;; This is for locating text that is expected to be near the point and
+;; may have been modified (but hopefully not near the beginning!)
+
+(defun slime-isearch (string)
+ "Find the longest occurence of STRING either backwards of forwards.
+If multiple matches exist the choose the one nearest to point."
+ (goto-char
+ (let* ((start (point))
+ (len1 (slime-isearch-with-function 'search-forward string))
+ (pos1 (point)))
+ (goto-char start)
+ (let* ((len2 (slime-isearch-with-function 'search-backward string))
+ (pos2 (point)))
+ (cond ((and len1 len2)
+ ;; Have a match in both directions
+ (cond ((= len1 len2)
+ ;; Both are full matches -- choose the nearest.
+ (if (< (abs (- start pos1))
+ (abs (- start pos2)))
+ pos1 pos2))
+ ((> len1 len2) pos1)
+ ((> len2 len1) pos2)))
+ (len1 pos1)
+ (len2 pos2)
+ (t start))))))
+
+(defun slime-isearch-with-function (search-fn string)
+ "Search for the longest substring of STRING using SEARCH-FN.
+SEARCH-FN is either the symbol `search-forward' or `search-backward'."
+ (unless (string= string "")
+ (loop for i from 1 to (length string)
+ while (funcall search-fn (substring string 0 i) nil t)
+ for match-data = (match-data)
+ do (case search-fn
+ (search-forward (goto-char (match-beginning 0)))
+ (search-backward (goto-char (1+ (match-end 0)))))
+ finally (return (if (null match-data)
+ nil
+ ;; Finish based on the last successful match
+ (store-match-data match-data)
+ (goto-char (match-beginning 0))
+ (- (match-end 0) (match-beginning 0)))))))
+
+
+;;;;; Visiting and navigating the overlays of compiler notes
+
+(defvar slime-compilation-just-finished nil
+ "A buffer local variable which is T when we've just compiled a
+buffer and haven't yet started navigating its notes.")
+(make-variable-buffer-local 'slime-compilation-just-finished)
+
+(defun slime-next-note ()
+ "Go to and describe the next compiler note in the buffer."
+ (interactive)
+ (let ((here (point)))
+ (when (and slime-goto-first-note-after-compilation
+ slime-compilation-just-finished)
+ (goto-char (point-min))
+ (setf slime-compilation-just-finished nil))
+ (slime-find-next-note)
+ (if (slime-note-at-point)
+ (slime-show-note (slime-note-at-point))
+ (progn
+ (goto-char here)
+ (message "No next note.")))))
+
+(defun slime-previous-note ()
+ "Go to and describe the previous compiler note in the buffer."
+ (interactive)
+ (let ((here (point)))
+ (when (and slime-goto-first-note-after-compilation
+ slime-compilation-just-finished)
+ (goto-char (point-max))
+ (setf slime-compilation-just-finished nil))
+ (slime-find-previous-note)
+ (if (slime-note-at-point)
+ (slime-show-note (slime-note-at-point))
+ (progn
+ (goto-char here)
+ (message "No previous note.")))))
+
+(defun slime-remove-notes ()
+ "Remove compiler-note annotations from the current buffer."
+ (interactive)
+ (slime-remove-old-overlays))
+
+(defun slime-show-note (overlay)
+ "Present the details of a compiler note to the user."
+ (slime-temporarily-highlight-note overlay)
+ (let ((message (get-char-property (point) 'help-echo)))
+ (slime-message "%s" (if (zerop (length message)) "\"\"" message))))
+
+(defun slime-temporarily-highlight-note (overlay)
+ "Temporarily highlight a compiler note's overlay.
+The highlighting is designed to both make the relevant source more
+visible, and to highlight any further notes that are nested inside the
+current one.
+
+The highlighting is automatically undone before the next Emacs command."
+ (lexical-let ((old-face (overlay-get overlay 'face))
+ (overlay overlay))
+ (push (lambda () (overlay-put overlay 'face old-face))
+ slime-pre-command-actions)
+ (overlay-put overlay 'face 'slime-highlight-face)))
+
+
+;;;;; Overlay lookup operations
+
+(defun slime-note-at-point ()
+ "Return the overlay for a note starting at point, otherwise NIL."
+ (find (point) (slime-note-overlays-at-point)
+ :key 'overlay-start))
+
+(defun slime-note-overlay-p (overlay)
+ "Return true if OVERLAY represents a compiler note."
+ (overlay-get overlay 'slime))
+
+(defun slime-note-overlays-at-point ()
+ "Return a list of all note overlays that are under the point."
+ (remove-if-not 'slime-note-overlay-p (overlays-at (point))))
+
+(defun slime-find-next-note ()
+ "Go to the next position with the `slime-note' text property.
+Retuns true if such a position is found."
+ (slime-find-note 'next-single-char-property-change))
+
+(defun slime-find-previous-note ()
+ "Go to the next position with the `slime' text property.
+Returns true if such a position is found."
+ (slime-find-note 'previous-single-char-property-change))
+
+(defun slime-find-note (next-candidate-fn)
+ "Seek out the beginning of a note.
+NEXT-CANDIDATE-FN is called to find each new position for consideration."
+ (let ((origin (point)))
+ (loop do (goto-char (funcall next-candidate-fn (point) 'slime))
+ until (or (slime-note-at-point)
+ (eobp)
+ (bobp)))
+ (unless (slime-note-at-point)
+ (goto-char origin))))
+
+
+;;;; Arglist Display
+
+(defun slime-space (n)
+ "Insert a space and print some relevant information (function arglist).
+Designed to be bound to the SPC key. Prefix argument can be used to insert
+more than one space."
+ (interactive "p")
+ (self-insert-command n)
+ (when (and slime-space-information-p
+ (slime-background-activities-enabled-p))
+ (slime-echo-arglist)))
+
+(defvar slime-echo-arglist-function 'slime-show-arglist)
+
+(defun slime-echo-arglist ()
+ "Display the arglist of the current form in the echo area."
+ (funcall slime-echo-arglist-function))
+
+(defun slime-show-arglist ()
+ (let ((op (slime-operator-before-point)))
+ (when op
+ (slime-eval-async `(swank:operator-arglist ,op ,(slime-current-package))
+ (lambda (arglist)
+ (when arglist
+ (slime-message "%s" arglist)))))))
+
+(defun slime-operator-before-point ()
+ (ignore-errors
+ (save-excursion
+ (backward-up-list 1)
+ (down-list 1)
+ (slime-symbol-name-at-point))))
+
+
+;;;; Completion
+
+;; XXX those long names are ugly to read; long names an indicator for
+;; bad factoring?
+
+(defvar slime-completions-buffer-name "*Completions*")
+
+(make-variable-buffer-local
+ (defvar slime-complete-saved-window-configuration nil
+ "Window configuration before we show the *Completions* buffer.
+This is buffer local in the buffer where the completion is
+performed."))
+
+(make-variable-buffer-local
+ (defvar slime-completions-window nil
+ "The window displaying *Completions* after saving window configuration.
+If this window is no longer active or displaying the completions
+buffer then we can ignore `slime-complete-saved-window-configuration'."))
+
+(defun slime-complete-maybe-save-window-configuration ()
+ "Maybe save the current window configuration.
+Return true if the configuration was saved."
+ (unless (or slime-complete-saved-window-configuration
+ (get-buffer-window slime-completions-buffer-name))
+ (setq slime-complete-saved-window-configuration
+ (current-window-configuration))
+ t))
+
+(defun slime-complete-delay-restoration ()
+ (make-local-hook 'pre-command-hook)
+ (add-hook 'pre-command-hook
+ 'slime-complete-maybe-restore-window-configuration))
+
+(defun slime-complete-forget-window-configuration ()
+ (setq slime-complete-saved-window-configuration nil)
+ (setq slime-completions-window nil))
+
+(defun slime-complete-restore-window-configuration ()
+ "Restore the window config if available."
+ (remove-hook 'pre-command-hook
+ 'slime-complete-maybe-restore-window-configuration)
+ (when (and slime-complete-saved-window-configuration
+ (slime-completion-window-active-p))
+ ;; XEmacs does not allow us to restore a window configuration from
+ ;; pre-command-hook, so we do it asynchronously.
+ (slime-run-when-idle
+ (lambda ()
+ (save-excursion
+ (set-window-configuration
+ slime-complete-saved-window-configuration))
+ (setq slime-complete-saved-window-configuration nil)
+ (when (buffer-live-p slime-completions-buffer-name)
+ (kill-buffer slime-completions-buffer-name))))))
+
+(defun slime-complete-maybe-restore-window-configuration ()
+ "Restore the window configuration, if the following command
+terminates a current completion."
+ (remove-hook 'pre-command-hook
+ 'slime-complete-maybe-restore-window-configuration)
+ (condition-case err
+ (cond ((find last-command-char "()\"'`,# \r\n:")
+ (slime-complete-restore-window-configuration))
+ ((not (slime-completion-window-active-p))
+ (slime-complete-forget-window-configuration))
+ (t
+ (slime-complete-delay-restoration)))
+ (error
+ ;; Because this is called on the pre-command-hook, we mustn't let
+ ;; errors propagate.
+ (message "Error in slime-complete-restore-window-configuration: %S" err))))
+
+(defun slime-completion-window-active-p ()
+ "Is the completion window currently active?"
+ (and (window-live-p slime-completions-window)
+ (equal (buffer-name (window-buffer slime-completions-window))
+ slime-completions-buffer-name)))
+
+(defun slime-display-completion-list (completions base)
+ (let ((savedp (slime-complete-maybe-save-window-configuration)))
+ (with-output-to-temp-buffer slime-completions-buffer-name
+ (display-completion-list completions)
+ (let ((offset (- (point) 1 (length base))))
+ (with-current-buffer standard-output
+ (setq completion-base-size offset)
+ (set-syntax-table lisp-mode-syntax-table))))
+ (when savedp
+ (setq slime-completions-window
+ (get-buffer-window slime-completions-buffer-name)))))
+
+(defun slime-display-or-scroll-completions (completions base)
+ (cond ((and (eq last-command this-command)
+ (slime-completion-window-active-p))
+ (slime-scroll-completions))
+ (t
+ (slime-display-completion-list completions base)))
+ (slime-complete-delay-restoration))
+
+(defun slime-scroll-completions ()
+ (let ((window slime-completions-window))
+ (with-current-buffer (window-buffer window)
+ (if (pos-visible-in-window-p (point-max) window)
+ (set-window-start window (point-min))
+ (save-selected-window
+ (select-window window)
+ (scroll-up))))))
+
+(defun slime-complete-symbol ()
+ "Complete the symbol at point.
+
+Completion is performed by `slime-complete-symbol-function'."
+ (interactive)
+ (funcall slime-complete-symbol-function))
+
+(defun slime-simple-complete-symbol ()
+ "Complete the symbol at point.
+Perform completion more similar to Emacs' complete-symbol."
+ (or (slime-maybe-complete-as-filename)
+ (let* ((end (point))
+ (beg (slime-symbol-start-pos))
+ (prefix (buffer-substring-no-properties beg end))
+ (result (slime-simple-completions prefix)))
+ (destructuring-bind (completions partial) result
+ (if (null completions)
+ (progn (slime-minibuffer-respecting-message
+ "Can't find completion for \"%s\"" prefix)
+ (ding)
+ (slime-complete-restore-window-configuration))
+ (insert-and-inherit (substring partial (length prefix)))
+ (cond ((slime-length= completions 1)
+ (slime-minibuffer-respecting-message "Sole completion")
+ (slime-complete-restore-window-configuration))
+ ;; Incomplete
+ (t
+ (slime-minibuffer-respecting-message
+ "Complete but not unique")
+ (slime-display-or-scroll-completions completions
+ partial))))))))
+
+(defun slime-maybe-complete-as-filename ()
+ "If point is at a string starting with \", complete it as filename.
+Return nil iff if point is not at filename."
+ (if (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
+ (let ((comint-completion-addsuffix '("/" . "\"")))
+ (if slime-when-complete-filename-expand
+ (comint-replace-by-expanded-filename)
+ (comint-dynamic-complete-as-filename))
+ t)
+ nil))
+
+(defun slime-minibuffer-respecting-message (format &rest format-args)
+ "Display TEXT as a message, without hiding any minibuffer contents."
+ (let ((text (format " [%s]" (apply #'format format format-args))))
+ (if (minibuffer-window-active-p (minibuffer-window))
+ (if (fboundp 'temp-minibuffer-message) ;; XEmacs
+ (temp-minibuffer-message text)
+ (minibuffer-message text))
+ (message "%s" text))))
+
+(defvar slime-read-expression-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\t" 'slime-complete-symbol)
+ (define-key map "\M-\t" 'slime-complete-symbol)
+ map)
+ "Minibuffer keymap used for reading CL expressions.")
+
+(defvar slime-read-expression-history '()
+ "History list of expressions read from the minibuffer.")
+
+(defun slime-read-from-minibuffer (prompt &optional initial-value)
+ "Read a string from the minibuffer, prompting with PROMPT.
+If INITIAL-VALUE is non-nil, it is inserted into the minibuffer before
+reading input. The result is a string (\"\" if no input was given)."
+ (let ((minibuffer-setup-hook
+ (cons (lexical-let ((package (slime-current-package))
+ (connection (slime-connection)))
+ (lambda ()
+ (setq slime-buffer-package package)
+ (setq slime-buffer-connection connection)
+ (set-syntax-table lisp-mode-syntax-table)))
+ minibuffer-setup-hook)))
+ (read-from-minibuffer prompt initial-value slime-read-expression-map
+ nil 'slime-read-expression-history)))
+
+(defun slime-bogus-completion-alist (list)
+ "Make an alist out of list.
+The same elements go in the CAR, and nil in the CDR. To support the
+apparently very stupid `try-completions' interface, that wants an
+alist but ignores CDRs."
+ (mapcar (lambda (x) (cons x nil)) list))
+
+(defun slime-simple-completions (prefix)
+ (slime-eval `(swank:simple-completions ,prefix ',(slime-current-package))))
+
+
+;;;; Edit definition
+
+(defvar slime-find-definition-history-ring (make-ring 20)
+ "History ring recording the definition-finding \"stack\".")
+
+(defun slime-push-definition-stack (&optional marker narrowing-configuration)
+ "Add MARKER and NARROWING-CONFIGURATION to the edit-definition history stack.
+If MARKER is nil, use the current point. If NARROWING-CONFIGURATION is nil,
+look if the current buffer is narrowed, and if so use the relevant values."
+ (ring-insert-at-beginning slime-find-definition-history-ring
+ (list (or marker (point-marker))
+ (or narrowing-configuration
+ (slime-current-narrowing-configuration)))))
+
+(defun slime-pop-find-definition-stack ()
+ "Pop the edit-definition stack and goto the location."
+ (interactive)
+ (unless (ring-empty-p slime-find-definition-history-ring)
+ (destructuring-bind (marker narrowing-cfg)
+ (ring-remove slime-find-definition-history-ring)
+ (let ((buffer (marker-buffer marker))
+ (narrowedp (slime-narrowing-configuration.narrowedp narrowing-cfg))
+ (narrow-beg (slime-narrowing-configuration.beg narrowing-cfg))
+ (narrow-end (slime-narrowing-configuration.end narrowing-cfg)))
+ (if (buffer-live-p buffer)
+ (progn (switch-to-buffer buffer)
+ (goto-char (marker-position marker))
+ (when narrowedp
+ (narrow-to-region narrow-beg narrow-end)))
+ ;; If this buffer was deleted, recurse to try the next one
+ (slime-pop-find-definition-stack))))))
+
+(defstruct (slime-definition (:conc-name slime-definition.)
+ (:type list))
+ dspec location)
+
+(defun slime-edit-definition (name &optional where)
+ "Lookup the definition of the name at point.
+If there's no name at point, or a prefix argument is given, then the
+function name is prompted."
+ (interactive (list (slime-read-symbol-name "Name: ")))
+ (let ((definitions (slime-eval `(swank:find-definitions-for-emacs ,name))))
+ (cond
+ ((null definitions)
+ (if slime-edit-definition-fallback-function
+ (funcall slime-edit-definition-fallback-function name)
+ (error "No known definition for: %s" name)))
+ ((and (slime-length= definitions 1)
+ (eql (car (slime-definition.location (car definitions))) :error))
+ (if slime-edit-definition-fallback-function
+ (funcall slime-edit-definition-fallback-function name)
+ (error "%s" (cadr (slime-definition.location (car definitions))))))
+ (t
+ (slime-goto-definition name definitions where)))))
+
+(defun slime-find-tag-if-tags-table-visited (name)
+ "Find tag (in current tags table) whose name contains NAME.
+If no tags table is visited, don't offer to visit one;
+just signal that no definition is known."
+ (if tags-table-list
+ (find-tag name)
+ (error "No known definition for: %s; use M-x visit-tags-table RET" name)))
+
+(defun slime-goto-definition (name definitions &optional where)
+ (slime-push-definition-stack)
+ (let ((all-locations-equal
+ (or (null definitions)
+ (let ((first-location (slime-definition.location (first definitions))))
+ (every (lambda (definition)
+ (equal (slime-definition.location definition)
+ first-location))
+ (rest definitions))))))
+ (if (and (slime-length> definitions 1)
+ (not all-locations-equal))
+ (slime-show-definitions name definitions)
+ (let ((def (car definitions)))
+ (destructure-case (slime-definition.location def)
+ ;; Take care of errors before switching any windows/buffers.
+ ((:error message)
+ (error "%s" message))
+ (t
+ (cond ((equal where 'window)
+ (slime-goto-definition-other-window (car definitions)))
+ ((equal where 'frame)
+ (let ((pop-up-frames t))
+ (slime-goto-definition-other-window (car definitions))))
+ (t
+ (slime-goto-source-location (slime-definition.location
+ (car definitions)))
+ (switch-to-buffer (current-buffer))))))))))
+
+(defun slime-goto-definition-other-window (definition)
+ (slime-pop-to-other-window)
+ (slime-goto-source-location (slime-definition.location definition))
+ (switch-to-buffer (current-buffer)))
+
+(defun slime-pop-to-other-window ()
+ "Pop to the other window, but not to any particular buffer."
+ (pop-to-buffer (current-buffer) t))
+
+(defun slime-edit-definition-other-window (name)
+ "Like `slime-edit-definition' but switch to the other window."
+ (interactive (list (slime-read-symbol-name "Symbol: ")))
+ (slime-edit-definition name 'window))
+
+(defun slime-edit-definition-other-frame (name)
+ "Like `slime-edit-definition' but switch to the other window."
+ (interactive (list (slime-read-symbol-name "Symbol: ")))
+ (slime-edit-definition name 'frame))
+
+(defun slime-edit-definition-with-etags (name)
+ (interactive (list (slime-read-symbol-name "Symbol: ")))
+ (let ((tagdefs (slime-etags-definitions name)))
+ (cond (tagdefs
+ (message "Using tag file...")
+ (slime-goto-definition name tagdefs))
+ (t
+ (error "No known definition for: %s" name)))))
+
+(defun slime-etags-definitions (name)
+ "Search definitions matching NAME in the tags file.
+The result is a (possibly empty) list of definitions."
+ (require 'etags)
+ (let ((defs '()))
+ (save-excursion
+ (let ((first-time t))
+ (while (visit-tags-table-buffer (not first-time))
+ (setq first-time nil)
+ (goto-char (point-min))
+ (while (search-forward name nil t)
+ (beginning-of-line)
+ (destructuring-bind (hint line &rest pos) (etags-snarf-tag)
+ (unless (eq hint t) ; hint==t if we are in a filename line
+ (let ((file (expand-file-name (file-of-tag))))
+ (let ((loc `(:location (:file ,file)
+ (:line ,line)
+ (:snippet ,hint))))
+ (push (list hint loc) defs))))))))
+ (reverse defs))))
+
+(defun slime-show-definitions (name definitions)
+ (slime-show-xrefs
+ `((,name . ,(loop for (dspec location) in definitions
+ collect (cons dspec location))))
+ 'definition
+ name
+ (slime-current-package)))
+
+;;;;; first-change-hook
+
+(defun slime-first-change-hook ()
+ "Notify Lisp that a source file's buffer has been modified."
+ ;; Be careful not to disturb anything!
+ ;; In particular if we muck up the match-data then query-replace
+ ;; breaks. -luke (26/Jul/2004)
+ (save-excursion
+ (save-match-data
+ (when (and (buffer-file-name)
+ (file-exists-p (buffer-file-name))
+ (slime-background-activities-enabled-p))
+ (let ((filename (slime-to-lisp-filename (buffer-file-name))))
+ (slime-eval-async `(swank:buffer-first-change ,filename)))))))
+
+(defun slime-setup-first-change-hook ()
+ (add-hook (make-local-variable 'first-change-hook)
+ 'slime-first-change-hook))
+
+(add-hook 'slime-mode-hook 'slime-setup-first-change-hook)
+
+
+;;;; Eval for Lisp
+
+(defun slime-eval-for-lisp (thread tag form-string)
+ (let ((ok nil)
+ (value nil)
+ (c (slime-connection)))
+ (unwind-protect (progn
+ (slime-check-eval-in-emacs-enabled)
+ (setq value (eval (read form-string)))
+ (setq ok t))
+ (let ((result (if ok `(:ok ,value) `(:abort))))
+ (slime-dispatch-event `(:emacs-return ,thread ,tag ,result) c)))))
+
+(defun slime-check-eval-in-emacs-enabled ()
+ "Raise an error if `slime-enable-evaluate-in-emacs' isn't true."
+ (unless slime-enable-evaluate-in-emacs
+ (error "slime-eval-in-emacs disabled for security. Set slime-enable-evaluate-in-emacs true to enable it.")))
+
+
+;;;; `ED'
+
+(defvar slime-ed-frame nil
+ "The frame used by `slime-ed'.")
+
+(defcustom slime-ed-use-dedicated-frame t
+ "*When non-nil, `slime-ed' will create and reuse a dedicated frame."
+ :type 'boolean
+ :group 'slime-mode)
+
+(defun slime-ed (what)
+ "Edit WHAT.
+
+WHAT can be:
+ A filename (string),
+ A list (FILENAME LINE [COLUMN]),
+ A list (FILENAME :charpos CHARPOS),
+ A function name (symbol or cons),
+ nil.
+
+This is for use in the implementation of COMMON-LISP:ED."
+ ;; Without `save-excursion' very strange things happen if you call
+ ;; (swank:ed-in-emacs X) from the REPL. -luke (18/Jan/2004)
+ (save-excursion
+ (when slime-ed-use-dedicated-frame
+ (unless (and slime-ed-frame (frame-live-p slime-ed-frame))
+ (setq slime-ed-frame (make-frame)))
+ (select-frame slime-ed-frame))
+ (cond ((stringp what)
+ (find-file (slime-from-lisp-filename what)))
+ ((and (consp what) (stringp (first what)))
+ (find-file (first (slime-from-lisp-filename what)))
+ (cond
+ ((eql (second what) :charpos)
+ (goto-char (third what)))
+ (t
+ (goto-line (second what))
+ ;; Find the correct column, without going past the end of
+ ;; the line.
+ (let ((col (third what)))
+ (while (and col
+ (< (point) (point-at-eol))
+ (/= (decf col) -1))
+ (forward-char 1))))))
+ ((and what (symbolp what))
+ (slime-edit-definition (symbol-name what)))
+ ((consp what)
+ (slime-edit-definition (prin1-to-string what)))
+ (t nil)))) ; nothing in particular
+
+
+;;;; Interactive evaluation.
+
+(defun slime-interactive-eval (string)
+ "Read and evaluate STRING and print value in minibuffer.
+
+Note: If a prefix argument is in effect then the result will be
+inserted in the current buffer."
+ (interactive (list (slime-read-from-minibuffer "Slime Eval: ")))
+ (slime-insert-transcript-delimiter string)
+ (cond ((not current-prefix-arg)
+ (slime-eval-with-transcript `(swank:interactive-eval ,string)
+ 'slime-display-eval-result))
+ (t
+ (slime-eval-print string))))
+
+(defun slime-display-eval-result (value)
+ (slime-message "%s" value))
+
+(defun slime-eval-print (string)
+ "Eval STRING in Lisp; insert any output and the result at point."
+ (slime-eval-async `(swank:eval-and-grab-output ,string)
+ (lexical-let ((buffer (current-buffer)))
+ (lambda (result)
+ (with-current-buffer buffer
+ (destructuring-bind (output value) result
+ (insert output value)))))))
+
+(defun slime-eval-with-transcript (form &optional fn)
+ "Send FROM and PACKAGE to Lisp and pass the result to FN.
+Display the result in the message area, if FN is nil.
+Show the output buffer if the evaluation causes any output."
+ (with-current-buffer (slime-output-buffer)
+ (slime-with-output-end-mark
+ (slime-mark-output-start)))
+ (with-lexical-bindings (fn)
+ (slime-eval-async form
+ (lambda (value)
+ (with-current-buffer (slime-output-buffer)
+ (slime-show-last-output)
+ (cond (fn (funcall fn value))
+ (t (message "%s" value))))))))
+
+(defun slime-eval-describe (form)
+ "Evaluate FORM in Lisp and display the result in a new buffer."
+ (lexical-let ((package (slime-current-package)))
+ (slime-eval-with-transcript
+ form (lambda (string) (slime-show-description string package)))))
+
+(defun slime-insert-transcript-delimiter (string)
+ (with-current-buffer (slime-output-buffer)
+ (slime-with-output-end-mark
+ (unless (bolp) (insert-before-markers "\n"))
+ (slime-propertize-region '(slime-transcript-delimiter t)
+ (insert-before-markers
+ ";;;; " (subst-char-in-string ?\n ?\
+ (substring string 0
+ (min 60 (length string))))
+ " ...\n")))))
+
+(defun slime-display-buffer-region (buffer start end &optional other-window)
+ "Like `display-buffer', but only display the specified region."
+ (let ((window-min-height 1))
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (goto-char start)
+ (beginning-of-line)
+ (narrow-to-region (point) end)
+ (let ((window (display-buffer buffer other-window t)))
+ (set-window-start window (point))
+ (unless (or (one-window-p t)
+ (/= (frame-width) (window-width)))
+ (set-window-text-height window (/ (1- (frame-height)) 2)))
+ (shrink-window-if-larger-than-buffer window)
+ window))))))
+
+(defun slime-last-expression ()
+ (buffer-substring-no-properties
+ (save-excursion (backward-sexp) (point))
+ (point)))
+
+(defun slime-eval-last-expression ()
+ "Evaluate the expression preceding point."
+ (interactive)
+ (slime-interactive-eval (slime-last-expression)))
+
+(defun slime-eval-last-expression-display-output ()
+ "Display output buffer and evaluate the expression preceding point."
+ (interactive)
+ (slime-display-output-buffer)
+ (slime-interactive-eval (slime-last-expression)))
+
+(defun slime-eval-defun ()
+ "Evaluate the current toplevel form.
+Use `slime-re-evaluate-defvar' if the from starts with '(defvar'"
+ (interactive)
+ (let ((form (slime-defun-at-point)))
+ (cond ((string-match "^(defvar " form)
+ (slime-re-evaluate-defvar form))
+ (t
+ (slime-interactive-eval form)))))
+
+(defun slime-eval-region (start end)
+ "Evaluate region."
+ (interactive "r")
+ (slime-eval-with-transcript
+ `(swank:interactive-eval-region
+ ,(buffer-substring-no-properties start end))))
+
+(defun slime-eval-buffer ()
+ "Evaluate the current buffer.
+The value is printed in the echo area."
+ (interactive)
+ (slime-eval-region (point-min) (point-max)))
+
+(defun slime-re-evaluate-defvar (form)
+ "Force the re-evaluaton of the defvar form before point.
+
+First make the variable unbound, then evaluate the entire form."
+ (interactive (list (slime-last-expression)))
+ (slime-eval-with-transcript `(swank:re-evaluate-defvar ,form)))
+
+(defun slime-pprint-eval-last-expression ()
+ "Evaluate the form before point; pprint the value in a buffer."
+ (interactive)
+ (slime-eval-describe `(swank:pprint-eval ,(slime-last-expression))))
+
+(defun slime-eval-print-last-expression (string)
+ "Evaluate sexp before point; print value into the current buffer"
+ (interactive (list (slime-last-expression)))
+ (insert "\n")
+ (slime-eval-print string))
+
+(defun slime-call-defun ()
+ "Insert a call to the function defined around point into the REPL."
+ (interactive)
+ (let ((toplevel (slime-parse-toplevel-form)))
+ (unless (and (consp toplevel)
+ (member (car toplevel) '(:defun :defmethod :defgeneric))
+ (symbolp (cadr toplevel)))
+ (error "Not in a function definition"))
+ (let* ((symbol (cadr toplevel))
+ (function-call
+ (format "(%s " (slime-qualify-cl-symbol-name symbol))))
+ (slime-switch-to-output-buffer)
+ (goto-char slime-repl-input-start-mark)
+ (insert function-call)
+ (save-excursion (insert ")")))))
+
+;;;; Edit Lisp value
+;;;
+(defun slime-edit-value (form-string)
+ "\\<slime-edit-value-mode-map>\
+Edit the value of a setf'able form in a new buffer.
+The value is inserted into a temporary buffer for editing and then set
+in Lisp when committed with \\[slime-edit-value-commit]."
+ (interactive
+ (list (slime-read-from-minibuffer "Edit value (evaluated): "
+ (slime-sexp-at-point))))
+ (slime-eval-async `(swank:value-for-editing ,form-string)
+ (lexical-let ((form-string form-string)
+ (package (slime-current-package)))
+ (lambda (result)
+ (slime-edit-value-callback form-string result
+ package)))))
+
+(make-variable-buffer-local
+ (defvar slime-edit-form-string nil
+ "The form being edited by `slime-edit-value'."))
+
+(define-minor-mode slime-edit-value-mode
+ "Mode for editing a Lisp value."
+ nil
+ " edit"
+ '(("\C-c\C-c" . slime-edit-value-commit)))
+
+(defun slime-edit-value-callback (form-string current-value package)
+ (let ((name (generate-new-buffer-name (format "*Edit %s*" form-string))))
+ (with-current-buffer (slime-get-temp-buffer-create name :mode 'lisp-mode)
+ (slime-mode 1)
+ (slime-temp-buffer-mode -1) ; don't want binding of 'q'
+ (slime-edit-value-mode 1)
+ (setq slime-edit-form-string form-string)
+ (setq slime-buffer-connection (slime-connection))
+ (setq slime-buffer-package package)
+ (insert current-value))))
+
+(defun slime-edit-value-commit ()
+ "Commit the edited value to the Lisp image.
+\\(See `slime-edit-value'.)"
+ (interactive)
+ (if (null slime-edit-form-string)
+ (error "Not editing a value.")
+ (let ((value (buffer-substring-no-properties (point-min) (point-max))))
+ (lexical-let ((buffer (current-buffer)))
+ (slime-eval-async `(swank:commit-edited-value ,slime-edit-form-string
+ ,value)
+ (lambda (_)
+ (with-current-buffer buffer
+ (slime-temp-buffer-quit t))))))))
+
+;;;; Tracing
+
+(defun slime-redirect-trace-output ()
+ "Redirect the trace output to a separate Emacs buffer."
+ (interactive)
+ (let ((buffer (get-buffer-create "*SLIME Trace Output*")))
+ (with-current-buffer buffer
+ (let ((marker (copy-marker (buffer-size)))
+ (target (incf slime-last-output-target-id)))
+ (puthash target marker slime-output-target-to-marker)
+ (slime-eval `(swank:redirect-trace-output ,target))))
+ ;; Note: We would like the entries in
+ ;; slime-output-target-to-marker to disappear when the buffers are
+ ;; killed. We cannot just make the hash-table ":weakness 'value"
+ ;; -- there is no reference from the buffers to the markers in the
+ ;; buffer, so entries would disappear even though the buffers are
+ ;; alive. Best solution might be to make buffer-local variables
+ ;; that keep the markers. --mkoeppe
+ (pop-to-buffer buffer)))
+
+(defun slime-untrace-all ()
+ "Untrace all functions."
+ (interactive)
+ (slime-eval `(swank:untrace-all)))
+
+(defun slime-toggle-trace-fdefinition (&optional using-context-p)
+ "Toggle trace."
+ (interactive "P")
+ (let* ((spec (if using-context-p
+ (slime-extract-context)
+ (slime-symbol-name-at-point)))
+ (spec (slime-trace-query spec)))
+ (message "%s" (slime-eval `(swank:swank-toggle-trace ,spec)))))
+
+(defun slime-trace-query (spec)
+ "Ask the user which function to trace; SPEC is the default.
+The result is a string."
+ (cond ((null spec)
+ (slime-read-from-minibuffer "(Un)trace: "))
+ ((stringp spec)
+ (slime-read-from-minibuffer "(Un)trace: " spec))
+ (t
+ (destructure-case spec
+ ((setf n)
+ (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec)))
+ (((:defun :defmacro) n)
+ (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string n)))
+ ((:defgeneric n)
+ (let* ((name (prin1-to-string n))
+ (answer (slime-read-from-minibuffer "(Un)trace: " name)))
+ (cond ((and (string= name answer)
+ (y-or-n-p (concat "(Un)trace also all "
+ "methods implementing "
+ name "? ")))
+ (prin1-to-string `(:defgeneric ,n)))
+ (t
+ answer))))
+ ((:defmethod &rest _)
+ (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec)))
+ ((:call caller callee)
+ (let* ((callerstr (prin1-to-string caller))
+ (calleestr (prin1-to-string callee))
+ (answer (slime-read-from-minibuffer "(Un)trace: "
+ calleestr)))
+ (cond ((and (string= calleestr answer)
+ (y-or-n-p (concat "(Un)trace only when " calleestr
+ " is called by " callerstr "? ")))
+ (prin1-to-string `(:call ,caller ,callee)))
+ (t
+ answer))))
+ (((:labels :flet) &rest _)
+ (slime-read-from-minibuffer "(Un)trace local function: "
+ (prin1-to-string spec)))))))
+
+(defun slime-extract-context ()
+ "Parse the context for the symbol at point.
+Nil is returned if there's no symbol at point. Otherwise we detect
+the following cases (the . shows the point position):
+
+ (defun n.ame (...) ...) -> (:defun name)
+ (defun (setf n.ame) (...) ...) -> (:defun (setf name))
+ (defmethod n.ame (...) ...) -> (:defmethod name (...))
+ (defun ... (...) (labels ((n.ame (...) -> (:labels (:defun ...) name)
+ (defun ... (...) (flet ((n.ame (...) -> (:flet (:defun ...) name)
+ (defun ... (...) ... (n.ame ...) ...) -> (:call (:defun ...) name)
+ (defun ... (...) ... (setf (n.ame ...) -> (:call (:defun ...) (setf name))
+
+For other contexts we return the symbol at point."
+ (let ((name (slime-symbol-name-at-point)))
+ (if name
+ (let ((symbol (read name)))
+ (or (progn ;;ignore-errors
+ (slime-parse-context symbol))
+ symbol)))))
+
+(defun slime-parse-context (name)
+ (save-excursion
+ (cond ((slime-in-expression-p '(defun *)) `(:defun ,name))
+ ((slime-in-expression-p '(defmacro *)) `(:defmacro ,name))
+ ((slime-in-expression-p '(defgeneric *)) `(:defgeneric ,name))
+ ((slime-in-expression-p '(setf *))
+ ;;a setf-definition, but which?
+ (backward-up-list 1)
+ (slime-parse-context `(setf ,name)))
+ ((slime-in-expression-p '(defmethod *))
+ (unless (looking-at "\\s ")
+ (forward-sexp 1)) ; skip over the methodname
+ (let (qualifiers arglist)
+ (loop for e = (read (current-buffer))
+ until (listp e) do (push e qualifiers)
+ finally (setq arglist e))
+ `(:defmethod ,name ,@qualifiers
+ ,(slime-arglist-specializers arglist))))
+ ((and (symbolp name)
+ (slime-in-expression-p `(,name)))
+ ;; looks like a regular call
+ (let ((toplevel (ignore-errors (slime-parse-toplevel-form))))
+ (cond ((slime-in-expression-p `(setf (*))) ;a setf-call
+ (if toplevel
+ `(:call ,toplevel (setf ,name))
+ `(setf ,name)))
+ ((not toplevel)
+ name)
+ ((slime-in-expression-p `(labels ((*))))
+ `(:labels ,toplevel ,name))
+ ((slime-in-expression-p `(flet ((*))))
+ `(:flet ,toplevel ,name))
+ (t
+ `(:call ,toplevel ,name)))))
+ (t
+ name))))
+
+(defun slime-in-expression-p (pattern)
+ "A helper function to determine the current context.
+The pattern can have the form:
+ pattern ::= () ;matches always
+ | (*) ;matches inside a list
+ | (<symbol> <pattern>) ;matches if the first element in
+ ; the current list is <symbol> and
+ ; if <pattern> matches.
+ | ((<pattern>)) ;matches if we are in a nested list."
+ (save-excursion
+ (let ((path (reverse (slime-pattern-path pattern))))
+ (loop for p in path
+ always (ignore-errors
+ (etypecase p
+ (symbol (slime-beginning-of-list)
+ (eq (read (current-buffer)) p))
+ (number (backward-up-list p)
+ t)))))))
+
+(defun slime-pattern-path (pattern)
+ ;; Compute the path to the * in the pattern to make matching
+ ;; easier. The path is a list of symbols and numbers. A number
+ ;; means "(down-list <n>)" and a symbol "(look-at <sym>)")
+ (if (null pattern)
+ '()
+ (etypecase (car pattern)
+ ((member *) '())
+ (symbol (cons (car pattern) (slime-pattern-path (cdr pattern))))
+ (cons (cons 1 (slime-pattern-path (car pattern)))))))
+
+(defun slime-beginning-of-list (&optional up)
+ "Move backward the the beginning of the current expression.
+Point is placed before the first expression in the list."
+ (backward-up-list (or up 1))
+ (down-list 1)
+ (skip-syntax-forward " "))
+
+(defun slime-parse-toplevel-form ()
+ (save-excursion
+ (beginning-of-defun)
+ (down-list 1)
+ (forward-sexp 1)
+ (slime-parse-context (read (current-buffer)))))
+
+(defun slime-arglist-specializers (arglist)
+ (cond ((or (null arglist)
+ (member (first arglist) '(&optional &key &rest &aux)))
+ (list))
+ ((consp (first arglist))
+ (cons (second (first arglist))
+ (slime-arglist-specializers (rest arglist))))
+ (t
+ (cons 't
+ (slime-arglist-specializers (rest arglist))))))
+
+(defun slime-disassemble-symbol (symbol-name)
+ "Display the disassembly for SYMBOL-NAME."
+ (interactive (list (slime-read-symbol-name "Disassemble: ")))
+ (slime-eval-describe `(swank:disassemble-symbol ,symbol-name)))
+
+(defun slime-undefine-function (symbol-name)
+ "Unbind the function slot of SYMBOL-NAME."
+ (interactive (list (slime-read-symbol-name "fmakunbound: " t)))
+ (slime-eval-async `(swank:undefine-function ,symbol-name)
+ (lambda (result) (message "%s" result))))
+
+(defun slime-load-file (filename)
+ "Load the Lisp file FILENAME."
+ (interactive (list
+ (read-file-name "Load file: " nil nil
+ nil (if (buffer-file-name)
+ (file-name-nondirectory
+ (buffer-file-name))))))
+ (let ((lisp-filename (slime-to-lisp-filename (expand-file-name filename))))
+ (slime-eval-with-transcript `(swank:load-file ,lisp-filename))))
+
+
+
+
+;;;; Profiling
+
+(defun slime-toggle-profile-fdefinition (fname-string)
+ "Toggle profiling for FNAME-STRING."
+ (interactive (list (slime-read-from-minibuffer
+ "(Un)Profile: "
+ (slime-symbol-name-at-point))))
+ (slime-eval-async `(swank:toggle-profile-fdefinition ,fname-string)
+ (lambda (r) (message "%s" r))))
+
+(defun slime-unprofile-all ()
+ "Unprofile all functions."
+ (interactive)
+ (slime-eval-async '(swank:unprofile-all)
+ (lambda (r) (message "%s" r))))
+
+(defun slime-profile-report ()
+ "Print profile report."
+ (interactive)
+ (slime-eval-with-transcript '(swank:profile-report)))
+
+(defun slime-profile-reset ()
+ "Reset profile counters."
+ (interactive)
+ (slime-eval-async (slime-eval `(swank:profile-reset))
+ (lambda (r) (message "%s" r))))
+
+(defun slime-profiled-functions ()
+ "Return list of names of currently profiled functions."
+ (interactive)
+ (slime-eval-async `(swank:profiled-functions)
+ (lambda (r) (message "%s" r))))
+
+(defun slime-profile-package (package callers methods)
+ "Profile all functions in PACKAGE.
+If CALLER is non-nil names have counts of the most common calling
+functions recorded.
+If METHODS is non-nil, profile all methods of all generic function
+having names in the given package."
+ (interactive (list (slime-read-package-name "Package: ")
+ (y-or-n-p "Record the most common callers? ")
+ (y-or-n-p "Profile methods? ")))
+ (slime-eval-async `(swank:profile-package ,package ,callers ,methods)
+ (lambda (r) (message "%s" r))))
+
+
+
+;;;; Documentation
+
+(defun slime-hyperspec-lookup (symbol-name)
+ "A wrapper for `hyperspec-lookup'"
+ (interactive (list (let* ((symbol-at-point (slime-symbol-name-at-point))
+ (stripped-symbol
+ (and symbol-at-point
+ (downcase
+ (common-lisp-hyperspec-strip-cl-package
+ symbol-at-point)))))
+ (if (and stripped-symbol
+ (intern-soft stripped-symbol
+ common-lisp-hyperspec-symbols))
+ stripped-symbol
+ (completing-read
+ "Look up symbol in Common Lisp HyperSpec: "
+ common-lisp-hyperspec-symbols #'boundp
+ t stripped-symbol
+ 'common-lisp-hyperspec-history)))))
+ (hyperspec-lookup symbol-name))
+
+(defun slime-show-description (string package)
+ (slime-with-output-to-temp-buffer ("*SLIME Description*")
+ package (princ string)))
+
+(defun slime-describe-symbol (symbol-name)
+ "Describe the symbol at point."
+ (interactive (list (slime-read-symbol-name "Describe symbol: ")))
+ (when (not symbol-name)
+ (error "No symbol given"))
+ (slime-eval-describe `(swank:describe-symbol ,symbol-name)))
+
+(defun slime-documentation (symbol-name)
+ "Display function- or symbol-documentation for SYMBOL-NAME."
+ (interactive (list (slime-read-symbol-name "Documentation for symbol: ")))
+ (when (not symbol-name)
+ (error "No symbol given"))
+ (slime-eval-describe
+ `(swank:documentation-symbol ,symbol-name "(not documented)")))
+
+(defun slime-describe-function (symbol-name)
+ (interactive (list (slime-read-symbol-name "Describe symbol: ")))
+ (when (not symbol-name)
+ (error "No symbol given"))
+ (slime-eval-describe `(swank:describe-function ,symbol-name)))
+
+(defun slime-apropos-summary (string case-sensitive-p package only-external-p)
+ "Return a short description for the performed apropos search."
+ (concat (if case-sensitive-p "Case-sensitive " "")
+ "Apropos for "
+ (format "%S" string)
+ (if package (format " in package %S" package) "")
+ (if only-external-p " (external symbols only)" "")))
+
+(defun slime-apropos (string &optional only-external-p package
+ case-sensitive-p)
+ "Show all bound symbols whose names match STRING, a regular expression."
+ (interactive
+ (if current-prefix-arg
+ (list (read-string "SLIME Apropos: ")
+ (y-or-n-p "External symbols only? ")
+ (let ((pkg (slime-read-package-name "Package: ")))
+ (if (string= pkg "") nil pkg))
+ (y-or-n-p "Case-sensitive? "))
+ (list (read-string "SLIME Apropos: ") t nil nil)))
+ (let ((buffer-package (or package (slime-current-package))))
+ (slime-eval-async
+ `(swank:apropos-list-for-emacs ,string ,only-external-p
+ ,case-sensitive-p ',package)
+ (lexical-let ((string string)
+ (package buffer-package)
+ (summary (slime-apropos-summary string case-sensitive-p
+ package only-external-p)))
+ (lambda (r) (slime-show-apropos r string package summary))))))
+
+(defun slime-apropos-all ()
+ "Shortcut for (slime-apropos <pattern> nil nil)"
+ (interactive)
+ (slime-apropos (read-string "SLIME Apropos: ") nil nil))
+
+(defun slime-apropos-package (package &optional internal)
+ "Show apropos listing for symbols in PACKAGE.
+With prefix argument include internal symbols."
+ (interactive (list (let ((pkg (slime-read-package-name "Package: ")))
+ (if (string= pkg "") (slime-current-package) pkg))
+ current-prefix-arg))
+ (slime-apropos "" (not internal) package))
+
+(defun slime-show-apropos (plists string package summary)
+ (if (null plists)
+ (message "No apropos matches for %S" string)
+ (slime-with-output-to-temp-buffer ("*SLIME Apropos*" :mode apropos-mode)
+ package
+ (set-syntax-table lisp-mode-syntax-table)
+ (slime-mode t)
+ (if (boundp 'header-line-format)
+ (setq header-line-format summary)
+ (insert summary "\n\n"))
+ (slime-set-truncate-lines)
+ (slime-print-apropos plists))))
+
+(defvar slime-apropos-label-properties
+ (progn
+ (require 'apropos)
+ (cond ((and (boundp 'apropos-label-properties)
+ (symbol-value 'apropos-label-properties)))
+ ((boundp 'apropos-label-face)
+ (etypecase (symbol-value 'apropos-label-face)
+ (symbol `(face ,(or (symbol-value 'apropos-label-face)
+ 'italic)
+ mouse-face highlight))
+ (list (symbol-value 'apropos-label-face)))))))
+
+(eval-when-compile (require 'apropos))
+
+(defun slime-print-apropos (plists)
+ (dolist (plist plists)
+ (let ((designator (plist-get plist :designator)))
+ (assert designator)
+ (slime-insert-propertized (list 'face apropos-symbol-face
+ 'item designator
+ 'action 'slime-describe-symbol)
+ designator))
+ (terpri)
+ (let ((apropos-label-properties slime-apropos-label-properties))
+ (loop for (prop namespace)
+ in '((:variable "Variable")
+ (:function "Function")
+ (:generic-function "Generic Function")
+ (:macro "Macro")
+ (:special-operator "Special Operator")
+ (:setf "Setf")
+ (:type "Type")
+ (:class "Class")
+ (:alien-type "Alien type")
+ (:alien-struct "Alien struct")
+ (:alien-union "Alien type")
+ (:alien-enum "Alien enum"))
+ ;; Properties not listed here will not show up in the buffer
+ do
+ (let ((value (plist-get plist prop))
+ (start (point)))
+ (when value
+ (princ " ")
+ (slime-insert-propertized apropos-label-properties namespace)
+ (princ ": ")
+ (princ (etypecase value
+ (string value)
+ ((member :not-documented) "(not documented)")))
+ (add-text-properties
+ start (point)
+ (list 'type prop 'action 'slime-call-describer
+ 'button t 'apropos-label namespace
+ 'item (plist-get plist :designator)))
+ (terpri)))))))
+
+(defun slime-call-describer (arg)
+ (let* ((pos (if (markerp arg) arg (point)))
+ (type (get-text-property pos 'type))
+ (item (get-text-property pos 'item)))
+ (slime-eval-describe `(swank:describe-definition-for-emacs ,item ,type))))
+
+
+;;;; XREF: cross-referencing
+
+(defvar slime-xref-mode-map)
+(defvar slime-xref-saved-emacs-snapshot nil
+ "Buffer local variable in xref windows.")
+
+(define-derived-mode slime-xref-mode lisp-mode "xref"
+ "slime-xref-mode: Major mode for cross-referencing.
+\\<slime-xref-mode-map>\
+The most important commands:
+\\[slime-xref-quit] - Dismiss buffer.
+\\[slime-show-xref] - Display referenced source and keep xref window.
+\\[slime-goto-xref] - Jump to referenced source and dismiss xref window.
+
+\\{slime-xref-mode-map}"
+ (setq font-lock-defaults nil)
+ (setq delayed-mode-hooks nil)
+ (slime-mode -1))
+
+(slime-define-keys slime-xref-mode-map
+ ((kbd "RET") 'slime-show-xref)
+ ("\C-m" 'slime-show-xref)
+ (" " 'slime-goto-xref)
+ ("q" 'slime-xref-quit)
+ ("n" 'slime-next-line/not-add-newlines)
+ ("p" 'previous-line))
+
+(defun slime-next-line/not-add-newlines ()
+ (interactive)
+ (let ((next-line-add-newlines nil))
+ (next-line 1)))
+
+;; FIXME: binding SLDB keys in xref buffer? -luke
+(dolist (spec slime-keys)
+ (destructuring-bind (key command &key sldb prefixed &allow-other-keys) spec
+ (when sldb
+ (let ((key (if prefixed (concat slime-prefix-key key) key)))
+ (define-key slime-xref-mode-map key command)))))
+
+
+;;;;; XREF results buffer and window management
+
+(defun slime-xref-buffer ()
+ "Return the XREF results buffer.
+If CREATE is non-nil, create it if necessary."
+ (or (find-if (lambda (b) (string-match "*XREF\\[" (buffer-name b)))
+ (buffer-list))
+ (error "No XREF buffer")))
+
+(defun slime-init-xref-buffer (package ref-type symbol)
+ "Initialize the current buffer for displaying XREF information."
+ (slime-xref-mode)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (setq slime-buffer-package package)
+ (slime-set-truncate-lines))
+
+;; XXX: unused function
+(defun slime-display-xref-buffer ()
+ "Display the XREF results buffer in a window and select it."
+ (let* ((buffer (slime-xref-buffer))
+ (window (get-buffer-window buffer)))
+ (if (and window (window-live-p window))
+ (select-window window)
+ (select-window (display-buffer buffer t))
+ (shrink-window-if-larger-than-buffer))))
+
+(defmacro* slime-with-xref-buffer ((package ref-type symbol &key emacs-snapshot)
+ &body body)
+ "Execute BODY in a xref buffer, then show that buffer."
+ (let ((type (gensym "TYPE+")) (sym (gensym "SYM+"))
+ (pkg (gensym "PKG+")) (snapshot (gensym "SNAPSHOT+")))
+ `(let ((,type ,ref-type) (,sym ,symbol) (,pkg ,package))
+ ;; We don't want the the xref buffer to be the current buffer
+ ;; in the snapshot, so we gotta take the snapshot here.
+ (let ((,snapshot (or ,emacs-snapshot (slime-current-emacs-snapshot))))
+ (with-current-buffer (get-buffer-create
+ (format "*XREF[%s: %s]*" ,type ,sym))
+ (prog2 (progn
+ (slime-init-xref-buffer ,pkg ,type ,sym)
+ (make-local-variable 'slime-xref-saved-emacs-snapshot)
+ (setq slime-xref-saved-emacs-snapshot ,snapshot))
+ (progn ,@body)
+ (setq buffer-read-only t)
+ (select-window (or (get-buffer-window (current-buffer) t)
+ (display-buffer (current-buffer) t)))
+ (shrink-window-if-larger-than-buffer)))))))
+
+(put 'slime-with-xref-buffer 'lisp-indent-function 1)
+
+(defun slime-insert-xrefs (xrefs)
+ "Insert XREFS in the current-buffer.
+XREFS is a list of the form ((GROUP . ((LABEL . LOCATION) ...)) ...)
+GROUP and LABEL are for decoration purposes. LOCATION is a source-location."
+ (unless (bobp) (insert "\n"))
+ (loop for (group . refs) in xrefs do
+ (progn
+ (slime-insert-propertized '(face bold) group "\n")
+ (loop
+ for (label . location) in refs
+ do (slime-insert-propertized
+ (list 'slime-location location
+ 'face 'font-lock-keyword-face)
+ " " (slime-one-line-ify label))
+ do (insert " - " (if (and (eql :location (car location))
+ (assoc :file (cdr location)))
+ (second (assoc :file (cdr location)))
+ "file unknown")
+ "\n"))))
+ ;; Remove the final newline to prevent accidental window-scrolling
+ (backward-char 1)
+ (delete-char 1))
+
+(defvar slime-next-location-function nil
+ "Function to call for going to the next location.")
+
+(defun slime-show-xrefs (xrefs type symbol package &optional emacs-snapshot)
+ "Show the results of an XREF query."
+ (if (null xrefs)
+ (message "No references found for %s." symbol)
+ (setq slime-next-location-function 'slime-goto-next-xref)
+ (slime-with-xref-buffer (package type symbol :emacs-snapshot emacs-snapshot)
+ (slime-insert-xrefs xrefs)
+ (goto-char (point-min))
+ (forward-line)
+ (skip-chars-forward " \t"))))
+
+
+;;;;; XREF commands
+
+(defun slime-who-calls (symbol)
+ "Show all known callers of the function SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who calls: " t)))
+ (slime-xref :calls symbol))
+
+(defun slime-calls-who (symbol)
+ "Show all known functions called by the function SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who calls: " t)))
+ (slime-xref :calls-who symbol))
+
+(defun slime-who-references (symbol)
+ "Show all known referrers of the global variable SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who references: " t)))
+ (slime-xref :references symbol))
+
+(defun slime-who-binds (symbol)
+ "Show all known binders of the global variable SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who binds: " t)))
+ (slime-xref :binds symbol))
+
+(defun slime-who-sets (symbol)
+ "Show all known setters of the global variable SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who sets: " t)))
+ (slime-xref :sets symbol))
+
+(defun slime-who-macroexpands (symbol)
+ "Show all known expanders of the macro SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who macroexpands: " t)))
+ (slime-xref :macroexpands symbol))
+
+(defun slime-who-specializes (symbol)
+ "Show all known methods specialized on class SYMBOL."
+ (interactive (list (slime-read-symbol-name "Who specializes: " t)))
+ (slime-xref :specializes symbol))
+
+(defun slime-list-callers (symbol-name)
+ "List the callers of SYMBOL-NAME in a xref window."
+ (interactive (list (slime-read-symbol-name "List callers: ")))
+ (slime-xref :callers symbol-name))
+
+(defun slime-list-callees (symbol-name)
+ "List the callees of SYMBOL-NAME in a xref window."
+ (interactive (list (slime-read-symbol-name "List callees: ")))
+ (slime-xref :callees symbol-name))
+
+(defun slime-xref (type symbol)
+ "Make an XREF request to Lisp."
+ (slime-eval-async
+ `(swank:xref ',type ',symbol)
+ (lexical-let ((type type)
+ (symbol symbol)
+ (package (slime-current-package))
+ ;; We have to take the snapshot here, because SLIME-EVAL-ASYNC
+ ;; is invoking its continuation within the extent of a different
+ ;; buffer. (2007-08-14)
+ (snapshot (slime-current-emacs-snapshot)))
+ (lambda (result)
+ (slime-show-xrefs result type symbol package snapshot)))))
+
+
+;;;;; XREF navigation
+
+(defun slime-xref-location-at-point ()
+ (save-excursion
+ ;; When the end of the last line is at (point-max) we can't find
+ ;; the text property there. Going to bol avoids this problem.
+ (beginning-of-line 1)
+ (or (get-text-property (point) 'slime-location)
+ (error "No reference at point."))))
+
+(defun slime-goto-xref ()
+ "Goto the cross-referenced location at point."
+ (interactive)
+ (let ((location (slime-xref-location-at-point)))
+ (slime-xref-cleanup)
+ (slime-goto-source-location location)
+ (switch-to-buffer (current-buffer))))
+
+(defun slime-show-xref ()
+ "Display the xref at point in the other window."
+ (interactive)
+ (let ((location (slime-xref-location-at-point)))
+ (slime-show-source-location location)))
+
+(defun slime-goto-next-xref ()
+ "Goto the next cross-reference location."
+ (let ((location (with-current-buffer (slime-xref-buffer)
+ (let ((w (display-buffer (current-buffer) t)))
+ (goto-char (1+ (next-single-char-property-change
+ (point) 'slime-location)))
+ (set-window-point w (point)))
+ (cond ((eobp)
+ (message "No more xrefs.")
+ nil)
+ (t
+ (slime-xref-location-at-point))))))
+ (when location
+ (slime-goto-source-location location)
+ (switch-to-buffer (current-buffer)))))
+
+(defun slime-next-location ()
+ "Go to the next location, depending on context.
+When displaying XREF information, this goes to the next reference."
+ (interactive)
+ (when (null slime-next-location-function)
+ (error "No context for finding locations."))
+ (funcall slime-next-location-function))
+
+(defun slime-xref-quit ()
+ "Kill the current xref buffer and restore the window configuration."
+ (interactive)
+ (let ((snapshot slime-xref-saved-emacs-snapshot))
+ (slime-xref-cleanup)
+ (slime-set-emacs-snapshot snapshot)))
+
+(defun slime-xref-cleanup ()
+ "Delete overlays created by xref mode and kill the xref buffer."
+ (sldb-delete-overlays)
+ (let ((buffer (current-buffer)))
+ (delete-windows-on buffer)
+ (kill-buffer buffer)))
+
+
+;;;; Macroexpansion
+
+(define-minor-mode slime-macroexpansion-minor-mode
+ "SLIME mode for macroexpansion"
+ nil
+ " temp"
+ '(("q" . slime-temp-buffer-quit)
+ ("g" . slime-macroexpand-again)))
+
+(flet ((remap (from to)
+ (dolist (mapping (where-is-internal from slime-mode-map))
+ (define-key slime-macroexpansion-minor-mode-map mapping to))))
+ (remap 'slime-macroexpand-1 'slime-macroexpand-1-inplace)
+ (remap 'slime-macroexpand-all 'slime-macroexpand-all-inplace)
+ (remap 'undo '(lambda (&optional arg)
+ (interactive)
+ (let ((buffer-read-only nil))
+ (when (fboundp 'slime-remove-edits)
+ (slime-remove-edits (point-min) (point-max)))
+ (undo arg)))))
+
+(defun slime-sexp-at-point-for-macroexpansion ()
+ "Essentially like SLIME-SEXP-AT-POINT-OR-ERROR, but behaves a
+bit more sanely in situations like ,(loop ...) where you want to
+expand the LOOP form. See comment in the source of this function."
+ (let ((string (slime-sexp-at-point-or-error))
+ (bounds (bounds-of-thing-at-point 'sexp))
+ (char-at-point (substring-no-properties (thing-at-point 'char))))
+ ;; SLIME-SEXP-AT-POINT(-OR-ERROR) uses (THING-AT-POINT 'SEXP)
+ ;; which is quite a bit botched: it returns "'(FOO BAR BAZ)" even
+ ;; when point is placed _at the opening parenthesis_, and hence
+ ;; "(FOO BAR BAZ)" wouldn't get expanded. Likewise for ",(...)",
+ ;; ",@(...)" (would return "@(...)"!!), and "\"(...)".
+ ;; So we better fix this up here:
+ (when (string= char-at-point "(")
+ (let ((char0 (elt string 0)))
+ (when (member char0 '(?\' ?\, ?\" ?\@))
+ (setf string (substring string 1))
+ (incf (car bounds)))))
+ (list string bounds)))
+
+(defvar slime-eval-macroexpand-expression nil
+ "Specifies the last macroexpansion preformed. This variable
+ specifies both what was expanded and how.")
+
+(defun slime-eval-macroexpand (expander &optional string)
+ (unless string
+ (setf string (first (slime-sexp-at-point-for-macroexpansion))))
+ (setf slime-eval-macroexpand-expression `(,expander ,string))
+ (lexical-let ((package (slime-current-package)))
+ (slime-eval-async
+ slime-eval-macroexpand-expression
+ (lambda (expansion)
+ (slime-with-output-to-temp-buffer
+ ;; reusep for preserving `undo' functionality.
+ ("*SLIME macroexpansion*" :mode lisp-mode :reusep t) package
+ (slime-macroexpansion-minor-mode)
+ (erase-buffer)
+ (insert expansion)
+ (font-lock-fontify-buffer))))))
+
+(defun slime-eval-macroexpand-inplace (expander)
+ "Substitutes the current sexp at place with its macroexpansion.
+
+NB: Does not affect *slime-eval-macroexpand-expression*"
+ (interactive)
+ (destructuring-bind (string bounds)
+ (slime-sexp-at-point-for-macroexpansion)
+ (lexical-let* ((start (car bounds))
+ (end (cdr bounds))
+ (point (point))
+ (package (slime-current-package))
+ (buffer (current-buffer)))
+ (slime-eval-async
+ `(,expander ,string)
+ (lambda (expansion)
+ (with-current-buffer buffer
+ (let ((buffer-read-only nil))
+ (when (fboundp 'slime-remove-edits)
+ (slime-remove-edits (point-min) (point-max)))
+ (goto-char start)
+ (delete-region start end)
+ (insert expansion)
+ (goto-char start)
+ (indent-sexp)
+ (goto-char point))))))))
+
+(defun slime-macroexpand-1 (&optional repeatedly)
+ "Display the macro expansion of the form at point. The form is
+expanded with CL:MACROEXPAND-1 or, if a prefix argument is given, with
+CL:MACROEXPAND."
+ (interactive "P")
+ (slime-eval-macroexpand
+ (if repeatedly 'swank:swank-macroexpand 'swank:swank-macroexpand-1)))
+
+(defun slime-macroexpand-1-inplace (&optional repeatedly)
+ (interactive "P")
+ (slime-eval-macroexpand-inplace
+ (if repeatedly 'swank:swank-macroexpand 'swank:swank-macroexpand-1)))
+
+(defun slime-macroexpand-all ()
+ "Display the recursively macro expanded sexp at point."
+ (interactive)
+ (slime-eval-macroexpand 'swank:swank-macroexpand-all))
+
+(defun slime-macroexpand-all-inplace ()
+ "Display the recursively macro expanded sexp at point."
+ (interactive)
+ (slime-eval-macroexpand-inplace 'swank:swank-macroexpand-all))
+
+(defun slime-compiler-macroexpand ()
+ "Display the compiler-macro expansion of sexp at point."
+ (interactive)
+ (slime-eval-macroexpand 'swank:swank-compiler-macroexpand))
+
+(defun slime-compiler-macroexpand-1 ()
+ "Display the compiler-macro expansion of sexp at point."
+ (interactive)
+ (slime-eval-macroexpand 'swank:swank-compiler-macroexpand-1))
+
+(defun slime-macroexpand-again ()
+ "Reperform the last macroexpansion."
+ (interactive)
+ (slime-eval-macroexpand (first slime-eval-macroexpand-expression)
+ (second slime-eval-macroexpand-expression)))
+
+
+;;;; Subprocess control
+
+(defun slime-interrupt ()
+ "Interrupt Lisp."
+ (interactive)
+ (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint))
+ (t (slime-dispatch-event `(:emacs-interrupt ,slime-current-thread)))))
+
+(defun slime-quit ()
+ (error "Not implemented properly. Use `slime-interrupt' instead."))
+
+(defun slime-quit-lisp (&optional keep-buffers)
+ "Quit lisp, kill the inferior process and associated buffers."
+ (interactive)
+ (slime-eval-async '(swank:quit-lisp))
+ (kill-buffer (slime-output-buffer))
+ (set-process-filter (slime-connection) nil)
+ (set-process-sentinel (slime-connection) 'slime-quit-sentinel))
+
+(defun slime-quit-sentinel (process message)
+ (assert (process-status process) 'closed)
+ (let* ((inferior (slime-inferior-process process))
+ (inferior-buffer (if inferior (process-buffer inferior))))
+ (when inferior (delete-process inferior))
+ (when inferior-buffer (kill-buffer inferior-buffer))
+ (slime-net-close process)
+ (message "Connection closed.")))
+
+(defun slime-set-package (package)
+ (interactive (list (slime-read-package-name "Package: "
+ (slime-find-buffer-package))))
+ (message "*package*: %s" (slime-eval `(swank:set-package ,package))))
+
+(defun slime-set-default-directory (directory)
+ "Make DIRECTORY become Lisp's current directory."
+ (interactive (list (read-directory-name "Directory: " nil nil t)))
+ (message "default-directory: %s"
+ (slime-from-lisp-filename
+ (slime-eval `(swank:set-default-directory
+ ,(slime-to-lisp-filename directory)))))
+ (with-current-buffer (slime-output-buffer)
+ (setq default-directory (expand-file-name directory))))
+
+(defun slime-sync-package-and-default-directory ()
+ "Set Lisp's package and directory to the values in current buffer."
+ (interactive)
+ (let ((package (slime-eval `(swank:set-package
+ ,(slime-find-buffer-package))))
+ (directory (slime-from-lisp-filename
+ (slime-eval `(swank:set-default-directory
+ ,(slime-to-lisp-filename
+ default-directory))))))
+ (let ((dir default-directory))
+ ;; Sync REPL dir
+ (with-current-buffer (slime-output-buffer)
+ (setq default-directory dir))
+ ;; Sync *inferior-lisp* dir
+ (let* ((proc (slime-process))
+ (buffer (and proc (process-buffer proc))))
+ (when buffer
+ (with-current-buffer buffer
+ (setq default-directory dir)))))
+ (message "package: %s default-directory: %s" (car package) directory)))
+
+
+;;;; Debugger (SLDB)
+
+(defvar sldb-hook nil
+ "Hook run on entry to the debugger.")
+
+
+;;;;; Local variables in the debugger buffer
+
+(slime-make-variables-buffer-local
+ (defvar sldb-condition nil
+ "A list (DESCRIPTION TYPE) describing the condition being debugged.")
+
+ (defvar sldb-saved-window-configuration nil
+ "Window configuration before the debugger was initially entered.")
+
+ (defvar sldb-restarts nil
+ "List of (NAME DESCRIPTION) for each available restart.")
+
+ (defvar sldb-level nil
+ "Current debug level (recursion depth) displayed in buffer.")
+
+ (defvar sldb-backtrace-start-marker nil
+ "Marker placed at the beginning of the backtrace text.")
+
+ (defvar sldb-continuations nil
+ "List of ids for pending continuation."))
+
+;;;;; SLDB macros
+
+;; some macros that we need to define before the first use
+
+(defmacro in-sldb-face (name string)
+ "Return STRING propertised with face sldb-NAME-face."
+ (let ((facename (intern (format "sldb-%s-face" (symbol-name name))))
+ (var (gensym "string")))
+ `(let ((,var ,string))
+ (slime-add-face ',facename ,var)
+ ,var)))
+
+(put 'in-sldb-face 'lisp-indent-function 1)
+
+(defun slime-add-face (face string)
+ (add-text-properties 0 (length string) (list 'face face) string)
+ string)
+
+
+;;;;; sldb-mode
+
+(defvar sldb-mode-syntax-table
+ (let ((table (copy-syntax-table lisp-mode-syntax-table)))
+ ;; We give < and > parenthesis syntax, so that #< ... > is treated
+ ;; as a balanced expression. This enables autodoc-mode to match
+ ;; #<unreadable> actual arguments in the backtraces with formal
+ ;; arguments of the function. (For Lisp mode, this is not
+ ;; desirable, since we do not wish to get a mismatched paren
+ ;; highlighted everytime we type < or >.)
+ (modify-syntax-entry ?< "(" table)
+ (modify-syntax-entry ?> ")" table)
+ table)
+ "Syntax table for SLDB mode.")
+
+(define-derived-mode sldb-mode fundamental-mode "sldb"
+ "Superior lisp debugger mode. In addition to ordinary SLIME commands,
+the following are available:\\<sldb-mode-map>
+
+Commands to examine the selected frame:
+ \\[sldb-toggle-details] - toggle details (local bindings, CATCH tags)
+ \\[sldb-show-source] - view source for the frame
+ \\[sldb-eval-in-frame] - eval in frame
+ \\[sldb-pprint-eval-in-frame] - eval in frame, pretty-print result
+ \\[sldb-disassemble] - disassemble
+ \\[sldb-inspect-in-frame] - inspect
+
+Commands to invoke restarts:
+ \\[sldb-quit] - quit
+ \\[sldb-abort] - abort
+ \\[sldb-continue] - continue
+ \\[sldb-invoke-restart-0]-\\[sldb-invoke-restart-9] - restart shortcuts
+
+Commands to navigate frames:
+ \\[sldb-down] - down
+ \\[sldb-up] - up
+ \\[sldb-details-down] - down, with details
+ \\[sldb-details-up] - up, with details
+
+Miscellaneous commands:
+ \\[sldb-restart-frame] - restart frame
+ \\[sldb-return-from-frame] - return from frame
+ \\[sldb-step] - step
+ \\[sldb-break-with-default-debugger] - switch to default debugger
+ \\[slime-interactive-eval] - eval
+
+Full list of commands:
+
+\\{sldb-mode-map}"
+ (erase-buffer)
+ (set-syntax-table sldb-mode-syntax-table)
+ (slime-set-truncate-lines)
+ ;; Make original slime-connection "sticky" for SLDB commands in this buffer
+ (setq slime-buffer-connection (slime-connection))
+ (add-local-hook 'kill-buffer-hook 'sldb-delete-overlays))
+
+(slime-define-keys sldb-mode-map
+ ("h" 'describe-mode)
+ ("v" 'sldb-show-source)
+ ((kbd "RET") 'sldb-default-action)
+ ("\C-m" 'sldb-default-action)
+ ([mouse-2] 'sldb-default-action/mouse)
+ ([follow-link] 'mouse-face)
+ ("e" 'sldb-eval-in-frame)
+ ("d" 'sldb-pprint-eval-in-frame)
+ ("D" 'sldb-disassemble)
+ ("i" 'sldb-inspect-in-frame)
+ ("n" 'sldb-down)
+ ("p" 'sldb-up)
+ ("\M-n" 'sldb-details-down)
+ ("\M-p" 'sldb-details-up)
+ ("<" 'sldb-beginning-of-backtrace)
+ (">" 'sldb-end-of-backtrace)
+ ("t" 'sldb-toggle-details)
+ ("r" 'sldb-restart-frame)
+ ("R" 'sldb-return-from-frame)
+ ("c" 'sldb-continue)
+ ("s" 'sldb-step)
+ ("x" 'sldb-next)
+ ("o" 'sldb-out)
+ ("b" 'sldb-break-on-return)
+ ("a" 'sldb-abort)
+ ("q" 'sldb-quit)
+ ("B" 'sldb-break-with-default-debugger)
+ ("P" 'sldb-print-condition)
+ ("C" 'sldb-inspect-condition)
+ (":" 'slime-interactive-eval)
+ ("\C-c\C-d" slime-doc-map))
+
+;; Inherit bindings from slime-mode
+(dolist (spec slime-keys)
+ (destructuring-bind (key command &key sldb prefixed &allow-other-keys) spec
+ (when sldb
+ (let ((key (if prefixed (concat slime-prefix-key key) key)))
+ (define-key sldb-mode-map key command)))))
+
+;; Keys 0-9 are shortcuts to invoke particular restarts.
+(defmacro define-sldb-invoke-restart-key (number key)
+ (let ((fname (intern (format "sldb-invoke-restart-%S" number)))
+ (docstring (format "Invoke restart numbered %S." number)))
+ `(progn
+ (defun ,fname ()
+ ,docstring
+ (interactive)
+ (sldb-invoke-restart ,number))
+ (define-key sldb-mode-map ,key ',fname))))
+
+(defmacro define-sldb-invoke-restart-keys (from to)
+ `(progn
+ ,@(loop for n from from to to
+ collect `(define-sldb-invoke-restart-key ,n
+ ,(number-to-string n)))))
+
+(define-sldb-invoke-restart-keys 0 9)
+
+
+;;;;; SLDB buffer creation & update
+
+(defun sldb-buffers ()
+ "Return a list of all sldb buffers."
+ (slime-filter-buffers (lambda () (eq major-mode 'sldb-mode))))
+
+(defun sldb-find-buffer (thread &optional connection)
+ (let ((connection (or connection (slime-connection))))
+ (find-if (lambda (buffer)
+ (with-current-buffer buffer
+ (and (eq slime-buffer-connection connection)
+ (eq slime-current-thread thread))))
+ (sldb-buffers))))
+
+(defun sldb-get-default-buffer ()
+ "Get a sldb buffer.
+The buffer is chosen more or less randomly."
+ (car (sldb-buffers)))
+
+(defun sldb-get-buffer (thread &optional connection)
+ "Find or create a sldb-buffer for THREAD."
+ (let ((connection (or connection (slime-connection))))
+ (or (sldb-find-buffer thread connection)
+ (let ((name (format "*sldb %s/%s*" (slime-connection-name) thread)))
+ (with-current-buffer (generate-new-buffer name)
+ (setq slime-buffer-connection connection
+ slime-current-thread thread)
+ (current-buffer))))))
+
+(defun sldb-debugged-continuations (connection)
+ "Return the debugged continuations for CONNECTION."
+ (lexical-let ((accu '()))
+ (dolist (b (sldb-buffers))
+ (with-current-buffer b
+ (when (eq slime-buffer-connection connection)
+ (setq accu (append sldb-continuations accu)))))
+ accu))
+
+(defun sldb-setup (thread level condition restarts frames conts)
+ "Setup a new SLDB buffer.
+CONDITION is a string describing the condition to debug.
+RESTARTS is a list of strings (NAME DESCRIPTION) for each available restart.
+FRAMES is a list (NUMBER DESCRIPTION) describing the initial
+portion of the backtrace. Frames are numbered from 0.
+CONTS is a list of pending Emacs continuations."
+ (with-current-buffer (sldb-get-buffer thread)
+ (unless (equal sldb-level level)
+ (setq buffer-read-only nil)
+ (sldb-mode)
+ (unless sldb-saved-window-configuration
+ (setq sldb-saved-window-configuration (current-window-configuration)))
+ (setq slime-current-thread thread)
+ (setq sldb-level level)
+ (setq mode-name (format "sldb[%d]" sldb-level))
+ (setq sldb-condition condition)
+ (setq sldb-restarts restarts)
+ (setq sldb-continuations conts)
+ (sldb-insert-condition condition)
+ (insert "\n\n" (in-sldb-face section "Restarts:") "\n")
+ (sldb-insert-restarts restarts)
+ (insert "\n" (in-sldb-face section "Backtrace:") "\n")
+ (setq sldb-backtrace-start-marker (point-marker))
+ (save-excursion
+ (sldb-insert-frames (sldb-prune-initial-frames frames) t))
+ (run-hooks 'sldb-hook)
+ (pop-to-buffer (current-buffer))
+ (sldb-recenter-region (point-min) (point))
+ (setq buffer-read-only t)
+ (when (and slime-stack-eval-tags
+ ;; (y-or-n-p "Enter recursive edit? ")
+ )
+ (message "Entering recursive edit..")
+ (recursive-edit)))))
+
+(defun sldb-activate (thread level)
+ "Display the debugger buffer for THREAD.
+If LEVEL isn't the same as in the buffer, reinitialize the buffer."
+ (unless (let ((b (sldb-find-buffer thread)))
+ (and b (with-current-buffer b (equal sldb-level level))))
+ (slime-rex (thread level)
+ ('(swank:debugger-info-for-emacs 0 10)
+ nil thread)
+ ((:ok result)
+ (apply #'sldb-setup thread level result)))))
+
+(defun sldb-exit (thread level &optional stepping)
+ "Exit from the debug level LEVEL."
+ (when-let (sldb (sldb-find-buffer thread))
+ (with-current-buffer sldb
+ (unless stepping
+ (set-window-configuration sldb-saved-window-configuration))
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (setq sldb-level nil))
+ (when (and (= level 1) (not stepping))
+ (kill-buffer sldb))))
+
+(defun sldb-insert-condition (condition)
+ "Insert the text for CONDITION.
+CONDITION should be a list (MESSAGE TYPE EXTRAS).
+EXTRAS is currently used for the stepper."
+ (destructuring-bind (message type extras) condition
+ (when (> (length message) 70)
+ (add-text-properties 0 (length message) (list 'help-echo message)
+ message))
+ (slime-insert-propertized '(sldb-default-action sldb-inspect-condition)
+ (in-sldb-face topline message)
+ "\n"
+ (in-sldb-face condition type))
+ (sldb-dispatch-extras extras)))
+
+(defvar sldb-extras-hooks)
+
+(defun sldb-dispatch-extras (extras)
+ ;; this is (mis-)used for the stepper
+ (dolist (extra extras)
+ (destructure-case extra
+ ((:show-frame-source n)
+ (sldb-show-frame-source n))
+ (t
+ (or (run-hook-with-args-until-success 'sldb-extras-hooks extra)
+ ;;(error "Unhandled extra element:" extra)
+ )))))
+
+(defun sldb-insert-restarts (restarts)
+ "Insert RESTARTS and add the needed text props
+RESTARTS should be alist ((NAME DESCRIPTION) ...)."
+ (loop for (name string) in restarts
+ for number from 0 do
+ (insert " ")
+ (slime-insert-propertized
+ `(,@nil restart-number ,number
+ sldb-default-action sldb-invoke-restart
+ mouse-face highlight)
+ (in-sldb-face restart-number (number-to-string number))
+ ": [" (in-sldb-face restart-type name) "] "
+ (in-sldb-face restart string))
+ (insert "\n")))
+
+(defun sldb-prune-initial-frames (frames)
+ "Return the prefix of FRAMES to initially present to the user.
+Regexp heuristics are used to avoid showing SWANK-internal frames."
+ (let* ((case-fold-search t)
+ (rx "^\\([() ]\\|lambda\\)*swank\\>"))
+ (or (loop for frame in frames
+ for (_ string) = frame
+ until (string-match rx string)
+ collect frame)
+ frames)))
+
+(defun sldb-insert-frames (frames more)
+ "Insert FRAMES into buffer.
+If MORE is non-nil, more frames are on the Lisp stack."
+ (mapc #'sldb-insert-frame frames)
+ (when more
+ (destructuring-bind ((num _)) (last frames)
+ (slime-insert-propertized
+ `(,@nil sldb-default-action sldb-fetch-more-frames
+ sldb-previous-frame-number ,num
+ point-entered sldb-fetch-more-frames
+ start-open t
+ face sldb-section-face
+ mouse-face highlight)
+ " --more--")
+ (insert "\n"))))
+
+(defun sldb-insert-frame (frame &optional face)
+ "Insert FRAME with FACE at point.
+If FACE is nil use `sldb-frame-line-face'."
+ (destructuring-bind (number string) frame
+ (let ((props `(frame ,frame sldb-default-action sldb-toggle-details)))
+ (slime-propertize-region props
+ (slime-propertize-region '(mouse-face highlight)
+ (insert " " (in-sldb-face frame-label (format "%2d:" number)) " ")
+ (slime-insert-indented
+ (slime-add-face (or face 'sldb-frame-line-face)
+ string)))
+ (insert "\n")))))
+
+(defun sldb-fetch-more-frames (&rest ignore)
+ "Fetch more backtrace frames.
+Called on the `point-entered' text-property hook."
+ (let ((inhibit-point-motion-hooks t)
+ (inhibit-read-only t)
+ (prev (get-text-property (point) 'sldb-previous-frame-number)))
+ ;; for unkown reasons, PREV is sometimes nil
+ (when prev
+ (let* ((count 40)
+ (from (1+ prev))
+ (to (+ from count))
+ (frames (slime-eval `(swank:backtrace ,from ,to)))
+ (more (slime-length= frames count))
+ (pos (point)))
+ (delete-region (line-beginning-position) (point-max))
+ (sldb-insert-frames frames more)
+ (goto-char pos)))))
+
+
+;;;;;; SLDB examining text props
+
+(defun sldb-restart-at-point ()
+ (or (get-text-property (point) 'restart-number)
+ (error "No restart at point")))
+
+(defun sldb-frame-number-at-point ()
+ (let ((frame (get-text-property (point) 'frame)))
+ (cond (frame (car frame))
+ (t (error "No frame at point")))))
+
+(defun sldb-var-number-at-point ()
+ (let ((var (get-text-property (point) 'var)))
+ (cond (var var)
+ (t (error "No variable at point")))))
+
+(defun sldb-previous-frame-number ()
+ (save-excursion
+ (sldb-backward-frame)
+ (sldb-frame-number-at-point)))
+
+(defun sldb-frame-details-visible-p ()
+ (and (get-text-property (point) 'frame)
+ (get-text-property (point) 'details-visible-p)))
+
+(defun sldb-frame-region ()
+ (save-excursion
+ (goto-char (next-single-property-change (point) 'frame nil (point-max)))
+ (backward-char)
+ (values (previous-single-property-change (point) 'frame)
+ (next-single-property-change (point) 'frame nil (point-max)))))
+
+(defun sldb-forward-frame ()
+ (goto-char (next-single-char-property-change (point) 'frame)))
+
+(defun sldb-backward-frame ()
+ (goto-char (previous-single-char-property-change
+ (car (sldb-frame-region))
+ 'frame
+ nil sldb-backtrace-start-marker)))
+
+(defun sldb-goto-last-frame ()
+ (goto-char (point-max))
+ (while (not (get-text-property (point) 'frame))
+ (goto-char (previous-single-property-change (point) 'frame))))
+
+(defun sldb-beginning-of-backtrace ()
+ "Goto the first frame."
+ (interactive)
+ (goto-char sldb-backtrace-start-marker))
+
+
+;;;;;; SLDB recenter & redisplay
+
+;; FIXME: these functions need factorization
+
+(defvar sldb-show-location-recenter-arg nil
+ "Argument to pass to `recenter' when displaying a source location.")
+
+(defun slime-show-buffer-position (position)
+ "Ensure sure that the POSITION in the current buffer is visible."
+ (save-selected-window
+ (let ((w (select-window (or (get-buffer-window (current-buffer) t)
+ (display-buffer (current-buffer) t)))))
+ (goto-char position)
+ (push-mark)
+ (unless (pos-visible-in-window-p)
+ (slime-recenter-window w sldb-show-location-recenter-arg)))))
+
+(defun slime-recenter-window (window line)
+ "Set window-start in WINDOW LINE lines before point."
+ (let* ((line (if (not line)
+ (/ (window-height window) 2)
+ line))
+ (start (save-excursion
+ (loop repeat line do (forward-line -1))
+ (point))))
+ (set-window-start window start)))
+
+(defun sldb-recenter-region (start end &optional center)
+ "Make the region from START to END visible.
+Avoid point motions, if possible.
+Minimize scrolling, if CENTER is nil.
+If CENTER is true, scroll enough to center the region in the window."
+ (let ((pos (point)) (lines (count-screen-lines start end t)))
+ (assert (and (<= start pos) (<= pos end)))
+ ;;(sit-for 0)
+ (cond ((and (pos-visible-in-window-p start)
+ (pos-visible-in-window-p end)))
+ ((< lines (window-height))
+ (cond (center (recenter (+ (/ (- (window-height) 1 lines)
+ 2)
+ (slime-count-lines start pos))))
+ (t (recenter (+ (- (window-height) 1 lines)
+ (slime-count-lines start pos))))))
+ (t
+ (goto-char start)
+ (recenter 0)
+ (cond ((pos-visible-in-window-p pos)
+ (goto-char pos))
+ (t
+ (goto-char start)
+ (next-line (- (window-height) 2))))))))
+
+;; not sure yet, whether this is a good idea.
+(defmacro slime-save-coordinates (origin &rest body)
+ "Restore line and column relative to ORIGIN, after executing BODY.
+
+This is useful if BODY deletes and inserts some text but we want to
+preserve the current row and column as closely as possible."
+ (let ((base (make-symbol "base"))
+ (goal (make-symbol "goal"))
+ (mark (make-symbol "mark")))
+ `(let* ((,base ,origin)
+ (,goal (slime-coordinates ,base))
+ (,mark (point-marker)))
+ (set-marker-insertion-type ,mark t)
+ (prog1 (save-excursion ,@body)
+ (slime-restore-coordinate ,base ,goal ,mark)))))
+
+(put 'slime-save-coordinates 'lisp-indent-function 1)
+
+(defun slime-coordinates (origin)
+ ;; Return a pair (X . Y) for the column and line distance to ORIGIN.
+ (let ((y (slime-count-lines origin (point)))
+ (x (save-excursion
+ (- (current-column)
+ (progn (goto-char origin) (current-column))))))
+ (cons x y)))
+
+(defun slime-restore-coordinate (base goal limit)
+ ;; Move point to GOAL. Coordinates are relative to BASE.
+ ;; Don't move beyond LIMIT.
+ (save-restriction
+ (narrow-to-region base limit)
+ (goto-char (point-min))
+ (let ((col (current-column)))
+ (forward-line (cdr goal))
+ (when (and (eobp) (bolp) (not (bobp)))
+ (backward-char))
+ (move-to-column (+ col (car goal))))))
+
+(defun slime-count-lines (start end)
+ "Return the number of lines between START and END.
+This is 0 if START and END at the same line."
+ (- (count-lines start end)
+ (if (save-excursion (goto-char end) (bolp)) 0 1)))
+
+
+;;;;; SLDB commands
+
+(defun sldb-default-action ()
+ "Invoke the action at point."
+ (interactive)
+ (let ((fn (get-text-property (point) 'sldb-default-action)))
+ (if fn (funcall fn))))
+
+(defun sldb-default-action/mouse (event)
+ "Invoke the action pointed at by the mouse."
+ (interactive "e")
+ (destructuring-bind (mouse-1 (w pos &rest _)) event
+ (save-excursion
+ (goto-char pos)
+ (let ((fn (get-text-property (point) 'sldb-default-action)))
+ (if fn (funcall fn))))))
+
+(defun sldb-end-of-backtrace ()
+ "Fetch the entire backtrace and go to the last frame."
+ (interactive)
+ (sldb-fetch-all-frames)
+ (sldb-goto-last-frame))
+
+(defun sldb-fetch-all-frames ()
+ (let ((inhibit-read-only t)
+ (inhibit-point-motion-hooks t))
+ (sldb-goto-last-frame)
+ (let ((last (sldb-frame-number-at-point)))
+ (goto-char (next-single-char-property-change (point) 'frame))
+ (delete-region (point) (point-max))
+ (save-excursion
+ (sldb-insert-frames (slime-eval `(swank:backtrace ,(1+ last) nil))
+ nil)))))
+
+
+;;;;;; SLDB show source
+
+(defvar sldb-overlays '()
+ "List of overlays created in source code buffers to highlight expressions.")
+
+(defun sldb-show-source ()
+ "Highlight the frame at point's expression in a source code buffer."
+ (interactive)
+ (sldb-show-frame-source (sldb-frame-number-at-point)))
+
+(defun sldb-show-frame-source (frame-number)
+ (sldb-delete-overlays)
+ (slime-eval-async
+ `(swank:frame-source-location-for-emacs ,frame-number)
+ (lambda (source-location)
+ (destructure-case source-location
+ ((:error message)
+ (message "%s" message)
+ (ding))
+ (t
+ (slime-show-source-location source-location))))))
+
+(defun slime-show-source-location (source-location &optional no-highlight-p)
+ (slime-goto-source-location source-location)
+ (unless no-highlight-p (sldb-highlight-sexp))
+ (slime-show-buffer-position (point)))
+
+(defun sldb-highlight-sexp (&optional start end)
+ "Highlight the first sexp after point."
+ (sldb-delete-overlays)
+ (let ((start (or start (point)))
+ (end (or end (save-excursion (ignore-errors (forward-sexp)) (point)))))
+ (push (make-overlay start (1+ start)) sldb-overlays)
+ (push (make-overlay (1- end) end) sldb-overlays))
+ (dolist (overlay sldb-overlays)
+ (overlay-put overlay 'face 'secondary-selection)))
+
+(defun sldb-delete-overlays ()
+ (mapc #'delete-overlay sldb-overlays)
+ (setq sldb-overlays '()))
+
+
+;;;;;; SLDB toggle details
+
+(defun sldb-toggle-details (&optional on)
+ "Toggle display of details for the current frame.
+The details include local variable bindings and CATCH-tags."
+ (interactive)
+ (assert (sldb-frame-number-at-point))
+ (let ((inhibit-read-only t))
+ (if (or on (not (sldb-frame-details-visible-p)))
+ (sldb-show-frame-details)
+ (sldb-hide-frame-details))))
+
+(defun sldb-show-frame-details ()
+ ;; fetch and display info about local variables and catch tags
+ (destructuring-bind (start end frame locals catches) (sldb-frame-details)
+ (slime-save-coordinates start
+ (delete-region start end)
+ (slime-propertize-region `(frame ,frame details-visible-p t)
+ (sldb-insert-frame frame 'sldb-detailed-frame-line-face)
+ (let ((indent1 " ")
+ (indent2 " "))
+ (insert indent1 (in-sldb-face section
+ (if locals "Locals:" "[No Locals]")) "\n")
+ (sldb-insert-locals locals indent2 frame)
+ (when catches
+ (insert indent1 (in-sldb-face section "Catch-tags:") "\n")
+ (dolist (tag catches)
+ (slime-propertize-region `(catch-tag ,tag)
+ (insert indent2 (in-sldb-face catch-tag (format "%s" tag))
+ "\n"))))
+ (setq end (point)))))
+ (sldb-recenter-region start end)))
+
+(defun sldb-frame-details ()
+ ;; Return a list (START END FRAME LOCALS CATCHES) for frame at point.
+ (let* ((frame (get-text-property (point) 'frame))
+ (num (car frame))
+ (catches (sldb-catch-tags num))
+ (locals (sldb-frame-locals num)))
+ (destructuring-bind (start end) (sldb-frame-region)
+ (list start end frame locals catches))))
+
+(defun sldb-insert-locals (vars prefix frame)
+ "Insert VARS and add PREFIX at the beginning of each inserted line.
+VAR should be a plist with the keys :name, :id, and :value."
+ (loop for i from 0
+ for var in vars do
+ (destructuring-bind (&key name id value) var
+ (slime-propertize-region (list 'sldb-default-action 'sldb-inspect-var
+ 'var i)
+ (insert prefix
+ (in-sldb-face local-name
+ (concat name (if (zerop id) "" (format "#%d" id))))
+ " = ")
+ (insert (in-sldb-face local-value value) "\n")))))
+
+(defun sldb-hide-frame-details ()
+ ;; delete locals and catch tags, but keep the function name and args.
+ (destructuring-bind (start end) (sldb-frame-region)
+ (let ((frame (get-text-property (point) 'frame)))
+ (slime-save-coordinates start
+ (delete-region start end)
+ (slime-propertize-region '(details-visible-p nil)
+ (sldb-insert-frame frame))))))
+
+(defun sldb-disassemble ()
+ "Disassemble the code for the current frame."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-disassemble ,frame)
+ (lambda (result)
+ (slime-show-description result nil)))))
+
+(defun sldb-print-condition ()
+ "Print the condition SLDB is handling in the REPL.
+This way you can still see what the error was after exiting SLDB."
+ (interactive)
+ (unless sldb-condition
+ (error "No condition known (wrong buffer?)"))
+ (slime-write-string (format "%s\n%s\n"
+ (first sldb-condition)
+ (second sldb-condition))))
+
+(defun sldb-frame-locals (frame)
+ (slime-eval `(swank:frame-locals-for-emacs ,frame)))
+
+(defun sldb-catch-tags (frame)
+ (slime-eval `(swank:frame-catch-tags-for-emacs ,frame)))
+
+
+;;;;;; SLDB eval and inspect
+
+(defun sldb-eval-in-frame (string)
+ "Prompt for an expression and evaluate it in the selected frame."
+ (interactive (list (slime-read-from-minibuffer "Eval in frame: ")))
+ (let* ((number (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:eval-string-in-frame ,string ,number)
+ (if current-prefix-arg
+ 'slime-write-string
+ 'slime-display-eval-result))))
+
+(defun sldb-pprint-eval-in-frame (string)
+ "Prompt for an expression, evaluate in selected frame, pretty-print result."
+ (interactive (list (slime-read-from-minibuffer "Eval in frame: ")))
+ (let* ((number (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:pprint-eval-string-in-frame ,string ,number)
+ (lambda (result)
+ (slime-show-description result nil)))))
+
+
+
+(defun sldb-inspect-in-frame (string)
+ "Prompt for an expression and inspect it in the selected frame."
+ (interactive (list (slime-read-from-minibuffer
+ "Inspect in frame (evaluated): "
+ (slime-sexp-at-point))))
+ (let ((number (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:inspect-in-frame ,string ,number)
+ 'slime-open-inspector)))
+
+(defun sldb-inspect-var ()
+ (let ((frame (sldb-frame-number-at-point))
+ (var (sldb-var-number-at-point)))
+ (slime-eval-async `(swank:inspect-frame-var ,frame ,var)
+ 'slime-open-inspector)))
+
+(defun sldb-inspect-condition ()
+ "Inspect the current debugger condition."
+ (interactive)
+ (slime-eval-async '(swank:inspect-current-condition)
+ 'slime-open-inspector))
+
+
+;;;;;; SLDB movement
+
+(defun sldb-down ()
+ "Select next frame."
+ (interactive)
+ (sldb-forward-frame))
+
+(defun sldb-up ()
+ "Select previous frame."
+ (interactive)
+ (sldb-backward-frame)
+ (when (= (point) sldb-backtrace-start-marker)
+ (recenter (1+ (count-lines (point-min) (point))))))
+
+(defun sldb-sugar-move (move-fn)
+ (let ((inhibit-read-only t))
+ (when (sldb-frame-details-visible-p) (sldb-hide-frame-details))
+ (funcall move-fn)
+ (sldb-show-source)
+ (sldb-toggle-details t)))
+
+(defun sldb-details-up ()
+ "Select previous frame and show details."
+ (interactive)
+ (sldb-sugar-move 'sldb-up))
+
+(defun sldb-details-down ()
+ "Select next frame and show details."
+ (interactive)
+ (sldb-sugar-move 'sldb-down))
+
+
+;;;;;; SLDB restarts
+
+(defun sldb-quit ()
+ "Quit to toplevel."
+ (interactive)
+ (slime-rex () ('(swank:throw-to-toplevel))
+ ((:ok _) (error "sldb-quit returned"))
+ ((:abort))))
+
+(defun sldb-continue ()
+ "Invoke the \"continue\" restart."
+ (interactive)
+ (slime-rex ()
+ ('(swank:sldb-continue))
+ ((:ok _)
+ (message "No restart named continue")
+ (ding))
+ ((:abort))))
+
+(defun sldb-abort ()
+ "Invoke the \"abort\" restart."
+ (interactive)
+ (slime-eval-async '(swank:sldb-abort)
+ (lambda (v) (message "Restart returned: %S" v))))
+
+(defun sldb-invoke-restart (&optional number)
+ "Invoke a restart.
+Optional NUMBER specifies the restart to invoke, otherwise
+use the restart at point."
+ (interactive)
+ (let ((restart (or number (sldb-restart-at-point))))
+ (slime-rex ()
+ ((list 'swank:invoke-nth-restart-for-emacs sldb-level restart))
+ ((:ok value) (message "Restart returned: %s" value))
+ ((:abort)))))
+
+(defun sldb-break-with-default-debugger ()
+ "Enter default debugger."
+ (interactive)
+ (slime-rex ()
+ ('(swank:sldb-break-with-default-debugger) nil slime-current-thread)
+ ((:abort))))
+
+(defun sldb-step ()
+ "Select the \"continue\" restart and set a new break point."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-step ,frame))))
+
+(defun sldb-next ()
+ "Select the \"continue\" restart and set a new break point."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-next ,frame))))
+
+(defun sldb-out ()
+ "Select the \"continue\" restart and set a new break point."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-out ,frame))))
+
+(defun sldb-break-on-return ()
+ "Set a breakpoint at the current frame.
+The debugger is entered when the frame exits."
+ (interactive)
+ (let ((frame (sldb-frame-number-at-point)))
+ (slime-eval-async `(swank:sldb-break-on-return ,frame)
+ (lambda (msg) (message "%s" msg)))))
+
+(defun sldb-break (name)
+ "Set a breakpoint at the start of the function NAME."
+ (interactive (list (slime-read-symbol-name "Function: " t)))
+ (slime-eval-async `(swank:sldb-break ,name)
+ (lambda (msg) (message "%s" msg))))
+
+(defun sldb-return-from-frame (string)
+ "Reads an expression in the minibuffer and causes the function to
+return that value, evaluated in the context of the frame."
+ (interactive (list (slime-read-from-minibuffer "Return from frame: ")))
+ (let* ((number (sldb-frame-number-at-point)))
+ (slime-rex ()
+ ((list 'swank:sldb-return-from-frame number string))
+ ((:ok value) (message "%s" value))
+ ((:abort)))))
+
+(defun sldb-restart-frame ()
+ "Causes the frame to restart execution with the same arguments as it
+was called originally."
+ (interactive)
+ (let* ((number (sldb-frame-number-at-point)))
+ (slime-rex ()
+ ((list 'swank:restart-frame number))
+ ((:ok value) (message "%s" value))
+ ((:abort)))))
+
+
+;;;; Thread control panel
+
+(defun slime-list-threads ()
+ "Display a list of threads."
+ (interactive)
+ (slime-eval-async
+ '(swank:list-threads)
+ (lambda (threads)
+ (with-current-buffer (get-buffer-create "*slime-threads*")
+ (slime-thread-control-mode)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (loop for idx from 0
+ for (name status id) in threads
+ do (slime-thread-insert idx name status id))
+ (goto-char (point-min))
+ (setq buffer-read-only t)
+ (pop-to-buffer (current-buffer)))))))
+
+(defun slime-thread-insert (idx name summary id)
+ (slime-propertize-region `(thread-id ,idx)
+ (insert (format "%3s: " id))
+ (slime-insert-propertized '(face bold) name)
+ (insert-char ?\ (- 30 (current-column)))
+ (let ((summary-start (point)))
+ (insert " " summary)
+ (unless (bolp) (insert "\n"))
+ (indent-rigidly summary-start (point) 2))))
+
+
+;;;;; Major mode
+
+(define-derived-mode slime-thread-control-mode fundamental-mode
+ "thread-control"
+ "SLIME Thread Control Panel Mode.
+
+\\{slime-thread-control-mode-map}"
+ (when slime-truncate-lines
+ (set (make-local-variable 'truncate-lines) t)))
+
+(slime-define-keys slime-thread-control-mode-map
+ ("a" 'slime-thread-attach)
+ ("d" 'slime-thread-debug)
+ ("g" 'slime-list-threads)
+ ("k" 'slime-thread-kill)
+ ("q" 'slime-thread-quit))
+
+(defun slime-thread-quit ()
+ (interactive)
+ (slime-eval-async `(swank:quit-thread-browser))
+ (kill-buffer (current-buffer)))
+
+(defun slime-thread-kill ()
+ (interactive)
+ (let ((id (get-text-property (point) 'thread-id)))
+ (slime-eval `(swank:kill-nth-thread ,id)))
+ (call-interactively 'slime-list-threads))
+
+(defun slime-thread-attach ()
+ (interactive)
+ (let ((id (get-text-property (point) 'thread-id))
+ (file (slime-swank-port-file)))
+ (slime-eval-async `(swank:start-swank-server-in-thread ,id ,file)))
+ (slime-read-port-and-connect nil nil))
+
+(defun slime-thread-debug ()
+ (interactive)
+ (let ((id (get-text-property (point) 'thread-id)))
+ (slime-eval-async `(swank:debug-nth-thread ,id))))
+
+
+;;;;; Connection listing
+
+(define-derived-mode slime-connection-list-mode fundamental-mode
+ "connection-list"
+ "SLIME Connection List Mode.
+
+\\{slime-connection-list-mode-map}"
+ (when slime-truncate-lines
+ (set (make-local-variable 'truncate-lines) t)))
+
+(slime-define-keys slime-connection-list-mode-map
+ ((kbd "RET") 'slime-goto-connection)
+ ("d" 'slime-connection-list-make-default)
+ ("g" 'slime-update-connection-list)
+ ((kbd "C-k") 'slime-quit-connection-at-point)
+ ("R" 'slime-restart-connection-at-point))
+
+(defun slime-connection-at-point ()
+ (or (get-text-property (point) 'slime-connection)
+ (error "No connection at point")))
+
+(defun slime-goto-connection ()
+ "Switch to the REPL buffer for the connection at point."
+ (interactive)
+ (let ((slime-dispatching-connection (slime-connection-at-point)))
+ (switch-to-buffer (slime-output-buffer))))
+
+(defun slime-quit-connection-at-point (connection)
+ (interactive (list (slime-connection-at-point)))
+ (let ((slime-dispatching-connection connection))
+ (slime-quit-lisp)
+ (while (memq connection slime-net-processes)
+ (sit-for 0 100)))
+ (slime-update-connection-list))
+
+(defun slime-restart-connection-at-point (connection)
+ (interactive (list (slime-connection-at-point)))
+ (let ((slime-dispatching-connection connection))
+ (slime-restart-inferior-lisp)))
+
+(defun slime-connection-list-make-default ()
+ "Make the connection at point the default connection."
+ (interactive)
+ (slime-select-connection (slime-connection-at-point))
+ (slime-update-connection-list))
+
+(defun slime-list-connections ()
+ "Display a list of all connections."
+ (interactive)
+ (when (get-buffer "*SLIME connections*")
+ (kill-buffer "*SLIME connections*"))
+ (with-current-buffer
+ (slime-get-temp-buffer-create "*SLIME connections*"
+ :mode 'slime-connection-list-mode)
+ (slime-draw-connection-list)
+ (setq buffer-read-only t)
+ (pop-to-buffer (current-buffer))))
+
+(defun slime-update-connection-list ()
+ "Display a list of all connections."
+ (interactive)
+ (let ((pos (point))
+ (inhibit-read-only t))
+ (erase-buffer)
+ (slime-draw-connection-list)
+ (goto-char pos)))
+
+(defun slime-draw-connection-list ()
+ (let ((default-pos nil)
+ (default slime-default-connection)
+ (fstring "%s%2s %-10s %-17s %-7s %-s\n"))
+ (insert (format fstring " " "Nr" "Name" "Port" "Pid" "Type")
+ (format fstring " " "--" "----" "----" "---" "----"))
+ (dolist (p (reverse slime-net-processes))
+ (when (eq default p) (setf default-pos (point)))
+ (slime-insert-propertized
+ (list 'slime-connection p)
+ (format fstring
+ (if (eq default p) "*" " ")
+ (slime-connection-number p)
+ (slime-connection-name p)
+ (or (process-id p) (process-contact p))
+ (slime-pid p)
+ (slime-lisp-implementation-type p))))
+ (when default
+ (goto-char default-pos))))
+
+
+;;;; Inspector
+
+(defgroup slime-inspector nil
+ "Inspector faces."
+ :prefix "slime-inspector-"
+ :group 'slime)
+
+(defface slime-inspector-topline-face
+ '((t ()))
+ "Face for top line describing object."
+ :group 'slime-inspector)
+
+(defface slime-inspector-label-face
+ '((t (:inherit font-lock-constant-face)))
+ "Face for labels in the inspector."
+ :group 'slime-inspector)
+
+(defface slime-inspector-value-face
+ (if (slime-face-inheritance-possible-p)
+ '((t (:inherit font-lock-builtin-face)))
+ '((((background light)) (:foreground "MediumBlue" :bold t))
+ (((background dark)) (:foreground "LightGray" :bold t))))
+ "Face for things which can themselves be inspected."
+ :group 'slime-inspector)
+
+(defface slime-inspector-action-face
+ (if (slime-face-inheritance-possible-p)
+ '((t (:inherit font-lock-warning-face)))
+ '((t (:foreground "OrangeRed"))))
+ "Face for labels of inspector actions."
+ :group 'slime-inspector)
+
+(defface slime-inspector-type-face
+ '((t (:inherit font-lock-type-face)))
+ "Face for type description in inspector."
+ :group 'slime-inspector)
+
+(defvar slime-inspector-mark-stack '())
+(defvar slime-saved-window-config)
+
+(defun slime-inspect (string)
+ "Eval an expression and inspect the result."
+ (interactive
+ (list (slime-read-from-minibuffer "Inspect value (evaluated): "
+ (slime-sexp-at-point))))
+ (slime-eval-async `(swank:init-inspector ,string) 'slime-open-inspector))
+
+(define-derived-mode slime-inspector-mode fundamental-mode "Slime-Inspector"
+ (set-syntax-table lisp-mode-syntax-table)
+ (slime-set-truncate-lines)
+ (setq buffer-read-only t))
+
+(defun slime-inspector-buffer ()
+ (or (get-buffer "*Slime Inspector*")
+ (with-current-buffer (get-buffer-create "*Slime Inspector*")
+ (setq slime-inspector-mark-stack '())
+ (slime-mode t)
+ (slime-inspector-mode)
+ (make-local-variable 'slime-saved-window-config)
+ (setq slime-saved-window-config (current-window-configuration))
+ (current-buffer))))
+
+(defmacro slime-inspector-fontify (face string)
+ `(slime-add-face ',(intern (format "slime-inspector-%s-face" face)) ,string))
+
+(defun slime-open-inspector (inspected-parts &optional point)
+ "Display INSPECTED-PARTS in a new inspector window.
+Optionally set point to POINT."
+ (with-current-buffer (slime-inspector-buffer)
+ (setq slime-buffer-connection (slime-current-connection))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (destructuring-bind (&key title type content) inspected-parts
+ (macrolet ((fontify (face string)
+ `(slime-inspector-fontify ,face ,string)))
+ (insert (fontify topline title))
+ (while (eq (char-before) ?\n)
+ (backward-delete-char 1))
+ (insert "\n [" (fontify label "type:") " " (fontify type type) "]\n"
+ (fontify label "--------------------") "\n")
+ (save-excursion
+ (mapc #'slime-inspector-insert-ispec content))
+ (pop-to-buffer (current-buffer))
+ (when point
+ (check-type point cons)
+ (ignore-errors
+ (goto-line (car point))
+ (move-to-column (cdr point)))))))))
+
+(defun slime-inspector-insert-ispec (ispec)
+ (if (stringp ispec)
+ (insert ispec)
+ (destructure-case ispec
+ ((:value string id)
+ (slime-propertize-region
+ (list 'slime-part-number id
+ 'mouse-face 'highlight
+ 'face 'slime-inspector-value-face)
+ (insert string)))
+ ((:action string id)
+ (slime-insert-propertized (list 'slime-action-number id
+ 'mouse-face 'highlight
+ 'face 'slime-inspector-action-face)
+ string)))))
+
+(defun slime-inspector-position ()
+ "Return a pair (Y-POSITION X-POSITION) representing the
+position of point in the current buffer."
+ ;; We make sure we return absolute coordinates even if the user has
+ ;; narrowed the buffer.
+ (save-restriction
+ (widen)
+ (cons (cond ((fboundp 'line-number)
+ (line-number)) ; XEmacs
+ ((fboundp 'line-number-at-pos)
+ (line-number-at-pos)) ; Recent GNU Emacs
+ (t (1+ (count-lines 1 (point-at-bol)))))
+ (current-column))))
+
+(defun slime-inspector-operate-on-point ()
+ "If point is on a value then recursivly call the inspector on
+ that value. If point is on an action then call that action."
+ (interactive)
+ (let ((part-number (get-text-property (point) 'slime-part-number))
+ (action-number (get-text-property (point) 'slime-action-number))
+ (opener (lexical-let ((point (slime-inspector-position)))
+ (lambda (parts)
+ (when parts
+ (slime-open-inspector parts point))))))
+ (cond (part-number
+ (slime-eval-async `(swank:inspect-nth-part ,part-number)
+ opener)
+ (push (slime-inspector-position) slime-inspector-mark-stack))
+ (action-number
+ (slime-eval-async `(swank::inspector-call-nth-action ,action-number)
+ opener)))))
+
+(defun slime-inspector-operate-on-click (event)
+ "Inspect the value at the clicked-at position or invoke an action."
+ (interactive "@e")
+ (let ((point (posn-point (event-end event))))
+ (cond ((and point
+ (or (get-text-property point 'slime-part-number)
+ (get-text-property point 'slime-action-number)))
+ (goto-char point)
+ (slime-inspector-operate-on-point))
+ (t
+ (error "No clickable part here")))))
+
+(defun slime-inspector-copy-down (number)
+ "Evaluate the slot at point via the REPL (to set `*')."
+ (interactive (list (or (get-text-property (point) 'slime-part-number)
+ (error "No part at point"))))
+ (slime-repl-send-string (format "%s" `(swank:inspector-nth-part ,number)))
+ (slime-repl))
+
+(defun slime-inspector-pop ()
+ (interactive)
+ (slime-eval-async
+ `(swank:inspector-pop)
+ (lambda (result)
+ (cond (result
+ (slime-open-inspector result (pop slime-inspector-mark-stack)))
+ (t
+ (message "No previous object")
+ (ding))))))
+
+(defun slime-inspector-next ()
+ (interactive)
+ (let ((result (slime-eval `(swank:inspector-next))))
+ (cond (result
+ (push (slime-inspector-position) slime-inspector-mark-stack)
+ (slime-open-inspector result))
+ (t (message "No next object")
+ (ding)))))
+
+(defun slime-inspector-quit ()
+ (interactive)
+ (slime-eval-async `(swank:quit-inspector))
+ (set-window-configuration slime-saved-window-config)
+ (kill-buffer (current-buffer)))
+
+(defun slime-find-inspectable-object (direction limit)
+ "Finds the next or previous inspectable object within the
+current buffer, depending on whether DIRECTION is 'NEXT or
+'PREV. LIMIT is the maximum or minimum position in the current
+buffer.
+
+Returns a list of two values: If an object could be found, the
+starting position of the found object and T is returned;
+otherwise LIMIT and NIL is returned.
+"
+ (let ((finder (ecase direction
+ (next 'next-single-property-change)
+ (prev 'previous-single-property-change))))
+ (let ((prop nil) (curpos (point)))
+ (while (and (not prop) (not (= curpos limit)))
+ (let ((newpos (funcall finder curpos 'slime-part-number nil limit)))
+ (setq prop (get-text-property newpos 'slime-part-number))
+ (setq curpos newpos)))
+ (list curpos (and prop t)))))
+
+(defun slime-inspector-next-inspectable-object (arg)
+ "Move point to the next inspectable object.
+With optional ARG, move across that many objects.
+If ARG is negative, move backwards."
+ (interactive "p")
+ (let ((maxpos (point-max)) (minpos (point-min))
+ (previously-wrapped-p nil))
+ ;; Forward.
+ (while (> arg 0)
+ (destructuring-bind (pos foundp)
+ (slime-find-inspectable-object 'next maxpos)
+ (if foundp
+ (progn (goto-char pos) (setq arg (1- arg))
+ (setq previously-wrapped-p nil))
+ (if (not previously-wrapped-p) ; cycle detection
+ (progn (goto-char minpos) (setq previously-wrapped-p t))
+ (error "No inspectable objects")))))
+ ;; Backward.
+ (while (< arg 0)
+ (destructuring-bind (pos foundp)
+ (slime-find-inspectable-object 'prev minpos)
+ ;; SLIME-OPEN-INSPECTOR inserts the title of an inspector page
+ ;; as a presentation at the beginning of the buffer; skip
+ ;; that. (Notice how this problem can not arise in ``Forward.'')
+ (if (and foundp (/= pos minpos))
+ (progn (goto-char pos) (setq arg (1+ arg))
+ (setq previously-wrapped-p nil))
+ (if (not previously-wrapped-p) ; cycle detection
+ (progn (goto-char maxpos) (setq previously-wrapped-p t))
+ (error "No inspectable objects")))))))
+
+
+(defun slime-inspector-previous-inspectable-object (arg)
+ "Move point to the previous inspectable object.
+With optional ARG, move across that many objects.
+If ARG is negative, move forwards."
+ (interactive "p")
+ (slime-inspector-next-inspectable-object (- arg)))
+
+(defun slime-inspector-describe ()
+ (interactive)
+ (slime-eval-describe `(swank:describe-inspectee)))
+
+(defun slime-inspector-pprint (part)
+ (interactive (list (or (get-text-property (point) 'slime-part-number)
+ (error "No part at point"))))
+ (slime-eval-describe `(swank:pprint-inspector-part ,part)))
+
+(defun slime-inspector-reinspect ()
+ (interactive)
+ (slime-eval-async `(swank:inspector-reinspect)
+ (lexical-let ((point (slime-inspector-position)))
+ (lambda (parts)
+ (slime-open-inspector parts point)))))
+
+(slime-define-keys slime-inspector-mode-map
+ ([return] 'slime-inspector-operate-on-point)
+ ([(meta return)] 'slime-inspector-copy-down)
+ ("\C-m" 'slime-inspector-operate-on-point)
+ ([mouse-2] 'slime-inspector-operate-on-click)
+ ("l" 'slime-inspector-pop)
+ ("n" 'slime-inspector-next)
+ (" " 'slime-inspector-next)
+ ("d" 'slime-inspector-describe)
+ ("p" 'slime-inspector-pprint)
+ ("q" 'slime-inspector-quit)
+ ("g" 'slime-inspector-reinspect)
+ ("\C-i" 'slime-inspector-next-inspectable-object)
+ ([(shift tab)] 'slime-inspector-previous-inspectable-object) ; Emacs translates S-TAB
+ ([backtab] 'slime-inspector-previous-inspectable-object) ; to BACKTAB on X.
+ ("\M-." 'slime-edit-definition))
+
+
+;;;; Buffer selector
+
+(defvar slime-selector-methods nil
+ "List of buffer-selection methods for the `slime-select' command.
+Each element is a list (KEY DESCRIPTION FUNCTION).
+DESCRIPTION is a one-line description of what the key selects.")
+
+(defun slime-selector ()
+ "Select a new buffer by type, indicated by a single character.
+The user is prompted for a single character indicating the method by
+which to choose a new buffer. The `?' character describes the
+available methods.
+
+See `def-slime-selector-method' for defining new methods."
+ (interactive)
+ (message "Select [%s]: "
+ (apply #'string (mapcar #'car slime-selector-methods)))
+ (let* ((ch (save-window-excursion
+ (select-window (minibuffer-window))
+ (read-char)))
+ (method (find ch slime-selector-methods :key #'car)))
+ (cond ((null method)
+ (message "No method for character: ?\\%c" ch)
+ (ding)
+ (sleep-for 1)
+ (discard-input)
+ (slime-selector))
+ (t
+ (funcall (third method))))))
+
+(defmacro def-slime-selector-method (key description &rest body)
+ "Define a new `slime-select' buffer selection method.
+
+KEY is the key the user will enter to choose this method.
+
+DESCRIPTION is a one-line sentence describing how the method
+selects a buffer.
+
+BODY is a series of forms which are evaluated when the selector
+is chosen. The returned buffer is selected with
+switch-to-buffer."
+ `(setq slime-selector-methods
+ (sort* (cons (list ,key ,description
+ (lambda ()
+ (let ((buffer (progn ,@body)))
+ (cond ((get-buffer buffer)
+ (switch-to-buffer buffer))
+ (t
+ (message "No such buffer: %S" buffer)
+ (ding))))))
+ (remove* ,key slime-selector-methods :key #'car))
+ #'< :key #'car)))
+
+(def-slime-selector-method ?? "Selector help buffer."
+ (ignore-errors (kill-buffer "*Select Help*"))
+ (with-current-buffer (get-buffer-create "*Select Help*")
+ (insert "Select Methods:\n\n")
+ (loop for (key line function) in slime-selector-methods
+ do (insert (format "%c:\t%s\n" key line)))
+ (help-mode)
+ (display-buffer (current-buffer) t)
+ (shrink-window-if-larger-than-buffer
+ (get-buffer-window (current-buffer))))
+ (slime-selector)
+ (current-buffer))
+
+(def-slime-selector-method ?r
+ "SLIME Read-Eval-Print-Loop."
+ (cond ((slime-current-connection)
+ (slime-output-buffer))
+ ((y-or-n-p "No connection: start Slime? ")
+ (slime))))
+
+(def-slime-selector-method ?i
+ "*inferior-lisp* buffer."
+ (cond ((and (slime-connected-p) (slime-process))
+ (process-buffer (slime-process)))
+ (t
+ "*inferior-lisp*")))
+
+(def-slime-selector-method ?v
+ "*slime-events* buffer."
+ slime-event-buffer-name)
+
+(def-slime-selector-method ?l
+ "most recently visited lisp-mode buffer."
+ (slime-recently-visited-buffer 'lisp-mode))
+
+(def-slime-selector-method ?d
+ "*sldb* buffer for the current connection."
+ (or (sldb-get-default-buffer)
+ (error "No debugger buffer")))
+
+(def-slime-selector-method ?e
+ "most recently visited emacs-lisp-mode buffer."
+ (slime-recently-visited-buffer 'emacs-lisp-mode))
+
+(def-slime-selector-method ?c
+ "SLIME connections buffer."
+ (slime-list-connections)
+ "*SLIME connections*")
+
+(def-slime-selector-method ?t
+ "SLIME threads buffer."
+ (slime-list-threads)
+ (slime-eval `(cl:quote nil)) ;wait until slime-list-threads returns
+ "*slime-threads*")
+
+(defun slime-recently-visited-buffer (mode)
+ "Return the most recently visited buffer whose major-mode is MODE.
+Only considers buffers that are not already visible."
+ (loop for buffer in (buffer-list)
+ when (and (with-current-buffer buffer (eq major-mode mode))
+ (not (string-match "^ " (buffer-name buffer)))
+ (null (get-buffer-window buffer 'visible)))
+ return buffer
+ finally (error "Can't find unshown buffer in %S" mode)))
+
+
+;;;; Editing commands
+
+
+
+;;;; Font Lock
+
+(defcustom slime-highlight-suppressed-forms t
+ "Display forms disabled by reader conditionals as comments."
+ :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
+ :group 'slime-mode)
+
+(defface slime-reader-conditional-face
+ (if (slime-face-inheritance-possible-p)
+ '((t (:inherit font-lock-comment-face)))
+ '((((background light)) (:foreground "DimGray" :bold t))
+ (((background dark)) (:foreground "LightGray" :bold t))))
+ "Face for compiler notes while selected."
+ :group 'slime-mode-faces)
+
+(defun slime-search-suppressed-forms (limit)
+ "Find reader conditionalized forms where the test is false."
+ (when (and slime-highlight-suppressed-forms
+ (slime-connected-p)
+ (re-search-forward "^\\([^;\n]*?[ \t(]\\)?#[-+]" limit t))
+ (ignore-errors
+ (let* ((start (- (point) 2))
+ (char (char-before))
+ (e (read (current-buffer)))
+ (val (slime-eval-feature-conditional e)))
+ (when (<= (point) limit)
+ (if (or (and (eq char ?+) (not val))
+ (and (eq char ?-) val))
+ (progn
+ (forward-sexp) (backward-sexp)
+ (slime-forward-sexp)
+ (assert (<= (point) limit))
+ (let ((md (match-data)))
+ (fill md nil)
+ (setf (first md) start)
+ (setf (second md) (point))
+ (set-match-data md)
+ t))
+ (slime-search-suppressed-forms limit)))))))
+
+(defun slime-activate-font-lock-magic ()
+ (if (featurep 'xemacs)
+ (let ((pattern `((slime-search-suppressed-forms
+ (0 slime-reader-conditional-face t)))))
+ (dolist (sym '(lisp-font-lock-keywords
+ lisp-font-lock-keywords-1
+ lisp-font-lock-keywords-2))
+ (set sym (append (symbol-value sym) pattern))))
+ (font-lock-add-keywords
+ 'lisp-mode
+ `((slime-search-suppressed-forms 0 ,''slime-reader-conditional-face t)))))
+
+(when slime-highlight-suppressed-forms
+ (slime-activate-font-lock-magic))
+
+
+;;;; Indentation
+
+(defun slime-update-indentation ()
+ "Update indentation for all macros defined in the Lisp system."
+ (interactive)
+ (slime-eval-async '(swank:update-indentation-information)))
+
+(defvar slime-indentation-update-hooks)
+
+(defun slime-handle-indentation-update (alist)
+ "Update Lisp indent information.
+
+ALIST is a list of (SYMBOL-NAME . INDENT-SPEC) of proposed indentation
+settings for `common-lisp-indent-function'. The appropriate property
+is setup, unless the user already set one explicitly."
+ (dolist (info alist)
+ (let ((symbol (intern (car info)))
+ (indent (cdr info)))
+ ;; Does the symbol have an indentation value that we set?
+ (when (equal (get symbol 'common-lisp-indent-function)
+ (get symbol 'slime-indent))
+ (put symbol 'slime-indent indent)
+ (put symbol 'common-lisp-indent-function indent))
+ (run-hook-with-args 'slime-indentation-update-hooks symbol indent))))
+
+
+;;;;; Pull-down menu
+
+(defvar slime-easy-menu
+ (let ((C '(slime-connected-p)))
+ `("SLIME"
+ [ "Edit Definition..." slime-edit-definition ,C ]
+ [ "Return From Definition" slime-pop-find-definition-stack ,C ]
+ [ "Complete Symbol" slime-complete-symbol ,C ]
+ [ "Show REPL" slime-switch-to-output-buffer ,C ]
+ "--"
+ ("Evaluation"
+ [ "Eval Defun" slime-eval-defun ,C ]
+ [ "Eval Last Expression" slime-eval-last-expression ,C ]
+ [ "Eval And Pretty-Print" slime-pprint-eval-last-expression ,C ]
+ [ "Eval Region" slime-eval-region ,C ]
+ [ "Interactive Eval..." slime-interactive-eval ,C ]
+ [ "Edit Lisp Value..." slime-edit-value ,C ]
+ [ "Call Defun" slime-call-defun ,C ])
+ ("Debugging"
+ [ "Macroexpand Once..." slime-macroexpand-1 ,C ]
+ [ "Macroexpand All..." slime-macroexpand-all ,C ]
+ [ "Create Trace Buffer" slime-redirect-trace-output ,C ]
+ [ "Toggle Trace..." slime-toggle-trace-fdefinition ,C ]
+ [ "Untrace All" slime-untrace-all ,C]
+ [ "Disassemble..." slime-disassemble-symbol ,C ]
+ [ "Inspect..." slime-inspect ,C ])
+ ("Compilation"
+ [ "Compile Defun" slime-compile-defun ,C ]
+ [ "Compile/Load File" slime-compile-and-load-file ,C ]
+ [ "Compile File" slime-compile-file ,C ]
+ [ "Compile Region" slime-compile-region ,C ]
+ "--"
+ [ "Next Note" slime-next-note t ]
+ [ "Previous Note" slime-previous-note t ]
+ [ "Remove Notes" slime-remove-notes t ]
+ [ "List Notes" slime-list-compiler-notes ,C ])
+ ("Cross Reference"
+ [ "Who Calls..." slime-who-calls ,C ]
+ [ "Who References... " slime-who-references ,C ]
+ [ "Who Sets..." slime-who-sets ,C ]
+ [ "Who Binds..." slime-who-binds ,C ]
+ [ "Who Macroexpands..." slime-who-macroexpands ,C ]
+ [ "Who Specializes..." slime-who-specializes ,C ]
+ [ "List Callers..." slime-list-callers ,C ]
+ [ "List Callees..." slime-list-callees ,C ]
+ [ "Next Location" slime-next-location t ])
+ ("Editing"
+ [ "Check Parens" check-parens t]
+ [ "Update Indentation" slime-update-indentation ,C]
+ [ "Select Buffer" slime-selector t])
+ ("Profiling"
+ [ "Toggle Profiling..." slime-toggle-profile-fdefinition ,C ]
+ [ "Profile Package" slime-profile-package ,C]
+ [ "Unprofile All" slime-unprofile-all ,C ]
+ [ "Show Profiled" slime-profiled-functions ,C ]
+ "--"
+ [ "Report" slime-profile-report ,C ]
+ [ "Reset Counters" slime-profile-reset ,C ])
+ ("Documentation"
+ [ "Describe Symbol..." slime-describe-symbol ,C ]
+ [ "Apropos..." slime-apropos ,C ]
+ [ "Apropos all..." slime-apropos-all ,C ]
+ [ "Apropos Package..." slime-apropos-package ,C ]
+ [ "Hyperspec..." slime-hyperspec-lookup t ])
+ "--"
+ [ "Interrupt Command" slime-interrupt ,C ]
+ [ "Abort Async. Command" slime-quit ,C ]
+ [ "Sync Package & Directory" slime-sync-package-and-default-directory ,C]
+ [ "Set Package in REPL" slime-repl-set-package ,C])))
+
+(defvar slime-repl-easy-menu
+ (let ((C '(slime-connected-p)))
+ `("REPL"
+ [ "Send Input" slime-repl-return ,C ]
+ [ "Close and Send Input " slime-repl-closing-return ,C ]
+ [ "Interrupt Lisp process" slime-interrupt ,C ]
+ "--"
+ [ "Previous Input" slime-repl-previous-input t ]
+ [ "Next Input" slime-repl-next-input t ]
+ [ "Goto Previous Prompt " slime-repl-previous-prompt t ]
+ [ "Goto Next Prompt " slime-repl-next-prompt t ]
+ [ "Clear Last Output" slime-repl-clear-output t ]
+ [ "Clear Buffer " slime-repl-clear-buffer t ]
+ [ "Kill Current Input" slime-repl-kill-input t ])))
+
+(defvar slime-sldb-easy-menu
+ (let ((C '(slime-connected-p)))
+ `("SLDB"
+ [ "Next Frame" sldb-down t ]
+ [ "Previous Frame" sldb-up t ]
+ [ "Toggle Frame Details" sldb-toggle-details t ]
+ [ "Next Frame (Details)" sldb-details-down t ]
+ [ "Previous Frame (Details)" sldb-details-up t ]
+ "--"
+ [ "Eval Expression..." slime-interactive-eval ,C ]
+ [ "Eval in Frame..." sldb-eval-in-frame ,C ]
+ [ "Eval in Frame (pretty print)..." sldb-pprint-eval-in-frame ,C ]
+ [ "Inspect In Frame..." sldb-inspect-in-frame ,C ]
+ [ "Inspect Condition Object" sldb-inspect-condition ,C ]
+ [ "Print Condition to REPL" sldb-print-condition t ]
+ "--"
+ [ "Restart Frame" sldb-restart-frame ,C ]
+ [ "Return from Frame..." sldb-return-from-frame ,C ]
+ ("Invoke Restart"
+ [ "Continue" sldb-continue ,C ]
+ [ "Abort" sldb-abort ,C ]
+ [ "Step" sldb-step ,C ]
+ [ "Step next" sldb-next ,C ]
+ [ "Step out" sldb-out ,C ]
+ )
+ "--"
+ [ "Quit (throw)" sldb-quit ,C ]
+ [ "Break With Default Debugger" sldb-break-with-default-debugger ,C ])))
+
+(easy-menu-define menubar-slime slime-mode-map "SLIME" slime-easy-menu)
+
+(defun slime-add-easy-menu ()
+ (easy-menu-add slime-easy-menu 'slime-mode-map))
+
+(add-hook 'slime-mode-hook 'slime-add-easy-menu)
+
+(defun slime-repl-add-easy-menu ()
+ (easy-menu-define menubar-slime-repl slime-repl-mode-map
+ "REPL" slime-repl-easy-menu)
+ (easy-menu-define menubar-slime slime-repl-mode-map
+ "SLIME" slime-easy-menu)
+ (easy-menu-add slime-repl-easy-menu 'slime-repl-mode-map))
+
+(add-hook 'slime-repl-mode-hook 'slime-repl-add-easy-menu)
+
+(defun slime-sldb-add-easy-menu ()
+ (easy-menu-define menubar-slime-sldb
+ sldb-mode-map "SLDB" slime-sldb-easy-menu)
+ (easy-menu-add slime-sldb-easy-menu 'sldb-mode-map))
+
+(add-hook 'sldb-mode-hook 'slime-sldb-add-easy-menu)
+
+
+;;;; Cheat Sheet
+
+(defvar slime-cheat-sheet-table
+ '((:title "Editing lisp code"
+ :map slime-mode-map
+ :bindings ((slime-eval-defun "Evaluate current top level form")
+ (slime-compile-defun "Compile current top level form")
+ (slime-interactive-eval "Prompt for form and eval it")
+ (slime-compile-and-load-file "Compile and load current file")
+ (slime-sync-package-and-default-directory "Synch default package and directory with current buffer")
+ (slime-next-note "Next compiler note")
+ (slime-previous-note "Previous compiler note")
+ (slime-remove-notes "Remove notes")
+ slime-hyperspec-lookup))
+ (:title "Completion"
+ :map slime-mode-map
+ :bindings (slime-indent-and-complete-symbol
+ slime-fuzzy-complete-symbol))
+ (:title "At the REPL"
+ :map slime-repl-mode-map
+ :bindings (slime-repl-clear-buffer
+ slime-describe-symbol))
+ (:title "Within SLDB buffers"
+ :map sldb-mode-map
+ :bindings ((sldb-default-action "Do 'whatever' with thing at point")
+ (sldb-toggle-details "Toggle frame details visualization")
+ (sldb-quit "Quit to REPL")
+ (sldb-abort "Invoke ABORT restart")
+ (sldb-continue "Invoke CONTINUE restart (if available)")
+ (sldb-show-source "Jump to frame's source code")
+ (sldb-eval-in-frame "Evaluate in frame at point")
+ (sldb-inspect-in-frame "Evaluate in frame at point and inspect result")))
+ (:title "Within the Inspector"
+ :map slime-inspector-mode-map
+ :bindings ((slime-inspector-next-inspectable-object "Jump to next inspectable object")
+ (slime-inspector-operate-on-point "Inspect object or execute action at point")
+ (slime-inspector-reinspect "Reinspect current object")
+ (slime-inspector-pop "Return to previous object")
+ (slime-inspector-copy-down "Send object at point to REPL")
+ (slime-inspector-quit "Quit")))
+ (:title "Finding Definitions"
+ :map slime-mode-map
+ :bindings (slime-edit-definition
+ slime-pop-find-definition-stack))))
+
+(defun slime-cheat-sheet ()
+ (interactive)
+ (switch-to-buffer-other-frame (get-buffer-create "*SLIME Cheat Sheet*"))
+ (setq buffer-read-only nil)
+ (delete-region (point-min) (point-max))
+ (goto-char (point-min))
+ (insert "SLIME: The Superior Lisp Interaction Mode for Emacs (minor-mode).\n\n")
+ (dolist (mode slime-cheat-sheet-table)
+ (let ((title (getf mode :title))
+ (mode-map (getf mode :map))
+ (mode-keys (getf mode :bindings)))
+ (insert title)
+ (insert ":\n")
+ (insert (make-string (1+ (length title)) ?-))
+ (insert "\n")
+ (let ((keys '())
+ (descriptions '()))
+ (dolist (func mode-keys)
+ ;; func is eithor the function name or a list (NAME DESCRIPTION)
+ (push (if (symbolp func)
+ (prin1-to-string func)
+ (second func))
+ descriptions)
+ (let ((all-bindings (where-is-internal (if (symbolp func)
+ func
+ (first func))
+ (symbol-value mode-map)))
+ (key-bindings '()))
+ (dolist (binding all-bindings)
+ (when (and (vectorp binding)
+ (integerp (aref binding 0)))
+ (push binding key-bindings)))
+ (push (mapconcat 'key-description key-bindings " or ") keys)))
+ (loop
+ with key-length = (apply 'max (mapcar 'length keys))
+ with desc-length = (apply 'max (mapcar 'length descriptions))
+ for key in (nreverse keys)
+ for desc in (nreverse descriptions)
+ do (insert desc)
+ do (insert (make-string (- desc-length (length desc)) ? ))
+ do (insert " => ")
+ do (insert (if (string= "" key)
+ "<not on any key>"
+ key))
+ do (insert "\n")
+ finally do (insert "\n")))))
+ (setq buffer-read-only t)
+ (goto-char (point-min)))
+
+
+;;;; Test suite
+
+(defstruct (slime-test (:conc-name slime-test.))
+ name fname args doc inputs fails-for)
+
+(defvar slime-tests '()
+ "Names of test functions.")
+
+(defvar slime-test-debug-on-error nil
+ "*When non-nil debug errors in test cases.")
+
+(defvar slime-total-tests nil
+ "Total number of tests executed during a test run.")
+
+(defvar slime-failed-tests nil
+ "Total number of failed tests during a test run.")
+
+(defvar slime-expected-failures nil
+ "Total number of expected failures during a test run")
+
+(defvar slime-test-buffer-name "*Tests*"
+ "The name of the buffer used to display test results.")
+
+
+;; dynamically bound during a single test
+(defvar slime-current-test)
+(defvar slime-unexpected-failures)
+
+
+;;;;; Execution engine
+
+(defun slime-run-tests ()
+ "Run the test suite.
+The results are presented in an outline-mode buffer, with the tests
+that succeeded initially folded away."
+ (interactive)
+ (assert (not (slime-busy-p)))
+ (slime-create-test-results-buffer)
+ (unwind-protect
+ (slime-execute-tests)
+ (pop-to-buffer slime-test-buffer-name)
+ (goto-char (point-min))
+ (hide-body)
+ ;; Expose failed tests
+ (dolist (o (overlays-in (point-min) (point-max)))
+ (when (overlay-get o 'slime-failed-test)
+ (goto-char (overlay-start o))
+ (show-subtree)))))
+
+(defun slime-run-one-test (name)
+ "Ask for the name of a test and then execute the test."
+ (interactive (list (slime-read-test-name)))
+ (let ((test (find name slime-tests :key #'slime-test.name)))
+ (assert test)
+ (let ((slime-tests (list test)))
+ (slime-run-tests))))
+
+(defun slime-read-test-name ()
+ (let ((alist (mapcar (lambda (test)
+ (list (symbol-name (slime-test.name test))))
+ slime-tests)))
+ (read (completing-read "Test: " alist nil t))))
+
+(defun slime-test-should-fail-p (test)
+ (member (slime-lisp-implementation-name)
+ (slime-test.fails-for test)))
+
+(defun slime-execute-tests ()
+ "Execute each test case with each input.
+Return the number of failed tests."
+ (save-window-excursion
+ (let ((slime-total-tests 0)
+ (slime-expected-passes 0)
+ (slime-unexpected-failures 0)
+ (slime-expected-failures 0))
+ (dolist (slime-current-test slime-tests)
+ (with-struct (slime-test. name (function fname) inputs)
+ slime-current-test
+ (slime-test-heading 1 "%s" name)
+ (dolist (input inputs)
+ (incf slime-total-tests)
+ (message "%s: %s" name input)
+ (slime-test-heading 2 "input: %s" input)
+ (if slime-test-debug-on-error
+ (let ((debug-on-error t)
+ (debug-on-quit t))
+ (apply function input))
+ (condition-case err
+ (apply function input)
+ (error
+ (cond ((slime-test-should-fail-p slime-current-test)
+ (incf slime-expected-failures)
+ (slime-test-failure "ERROR (expected)"
+ (format "%S" err)))
+ (t
+ (incf slime-unexpected-failures)
+ (slime-print-check-error err)))))))))
+ (let ((summary (cond ((and (zerop slime-expected-failures)
+ (zerop slime-unexpected-failures))
+ (format "All %S tests completed successfully."
+ slime-total-tests))
+ (t
+ (format "Failed on %S (%S expected) of %S tests."
+ (+ slime-expected-failures
+ slime-unexpected-failures)
+ slime-expected-failures
+ slime-total-tests)))))
+ (save-excursion
+ (with-current-buffer slime-test-buffer-name
+ (goto-char (point-min))
+ (insert summary "\n\n")))
+ (message "%s" summary)
+ slime-unexpected-failures))))
+
+(defun slime-batch-test (results-file)
+ "Run the test suite in batch-mode.
+Exits Emacs when finished. The exit code is the number of failed tests."
+ (let ((slime-test-debug-on-error nil))
+ (slime)
+ ;; Block until we are up and running.
+ (while (not (slime-connected-p))
+ (sit-for 1))
+ (slime-sync-to-top-level 5)
+ (switch-to-buffer "*scratch*")
+ (let ((failed-tests (slime-run-tests)))
+ (with-current-buffer slime-test-buffer-name
+ (slime-delete-hidden-outline-text)
+ (goto-char (point-min))
+ (insert "-*- outline -*-\n\n")
+ (write-file results-file))
+ (kill-emacs failed-tests))))
+
+
+;;;;; Results buffer creation and output
+
+(defun slime-create-test-results-buffer ()
+ "Create and initialize the buffer for test suite results."
+ (ignore-errors (kill-buffer slime-test-buffer-name))
+ (with-current-buffer (get-buffer-create slime-test-buffer-name)
+ (erase-buffer)
+ (outline-mode)
+ (set (make-local-variable 'outline-regexp) "\\*+")
+ (slime-set-truncate-lines)))
+
+(defun slime-delete-hidden-outline-text ()
+ "Delete the hidden parts of an outline-mode buffer."
+ (loop do (when (eq (get-char-property (point) 'invisible) 'outline)
+ (delete-region (point)
+ (next-single-char-property-change (point)
+ 'invisible)))
+ until (eobp)
+ do (goto-char (next-single-char-property-change (point) 'invisible))))
+
+(defun slime-test-heading (level format &rest args)
+ "Output a test suite heading.
+LEVEL gives the depth of nesting: 1 for top-level, 2 for a subheading, etc."
+ (with-current-buffer slime-test-buffer-name
+ (goto-char (point-max))
+ (insert (make-string level ?*)
+ " "
+ (apply 'format format args)
+ "\n")))
+
+(defun slime-test-failure (keyword string)
+ "Output a failure message from the test suite.
+KEYWORD names the type of failure and STRING describes the reason."
+ (with-current-buffer slime-test-buffer-name
+ (goto-char (point-max))
+ (let ((start (point)))
+ (insert keyword ": ")
+ (let ((overlay (make-overlay start (point))))
+ (overlay-put overlay 'slime-failed-test t)
+ (overlay-put overlay 'face 'bold)))
+ (insert string "\n")))
+
+(defun slime-test-message (string)
+ "Output a message from the test suite."
+ (with-current-buffer slime-test-buffer-name
+ (goto-char (point-max))
+ (insert string "\n")))
+
+
+;;;;; Macros for defining test cases
+
+(defmacro def-slime-test (name args doc inputs &rest body)
+ "Define a test case.
+NAME ::= SYMBOL | (SYMBOL (FAILS-FOR*)) is a symbol naming the test.
+ARGS is a lambda-list.
+DOC is a docstring.
+INPUTS is a list of argument lists, each tested separately.
+BODY is the test case. The body can use `slime-check' to test
+conditions (assertions)."
+ (multiple-value-bind (name fails-for) (etypecase name
+ (symbol (values name '()))
+ (cons name))
+ (let ((fname (intern (format "slime-test-%s" name))))
+ `(progn
+ (defun ,fname ,args
+ ,doc
+ (slime-sync)
+ ,@body)
+ (setq slime-tests
+ (append (remove* ',name slime-tests :key 'slime-test.name)
+ (list (make-slime-test :name ',name :fname ',fname
+ :fails-for ',fails-for
+ :inputs ,inputs))))))))
+
+(defmacro slime-check (test-name &rest body)
+ "Check a condition (assertion.)
+TEST-NAME can be a symbol, a string, or a (FORMAT-STRING . ARGS) list.
+BODY returns true if the check succeeds."
+ (let ((check-name (gensym "check-name-")))
+ `(let ((,check-name ,(typecase test-name
+ (symbol (symbol-name test-name))
+ (string test-name)
+ (cons `(format ,@test-name)))))
+ (if (progn ,@body)
+ (slime-print-check-ok ,check-name)
+ (cond ((slime-test-should-fail-p slime-current-test)
+ (incf slime-expected-failures)
+ (slime-test-failure "FAIL (expected)" ,check-name))
+ (t
+ (incf slime-unexpected-failures)
+ (slime-print-check-failed ,check-name)))
+ (when slime-test-debug-on-error
+ (debug (format "Check failed: %S" ,check-name)))))))
+
+(defun slime-print-check-ok (test-name)
+ (slime-test-message test-name))
+
+(defun slime-print-check-failed (test-name)
+ (slime-test-failure "FAILED" test-name))
+
+(defun slime-print-check-error (reason)
+ (slime-test-failure "ERROR" (format "%S" reason)))
+
+(put 'def-slime-test 'lisp-indent-function 4)
+(put 'slime-check 'lisp-indent-function 1)
+
+
+;;;;; Test case definitions
+
+;; Clear out old tests.
+(setq slime-tests nil)
+
+(defun slime-check-top-level (&optional test-name)
+ (slime-accept-process-output nil 0.001)
+ (slime-check "At the top level (no debugging or pending RPCs)"
+ (slime-at-top-level-p)))
+
+(defun slime-at-top-level-p ()
+ (and (not (sldb-get-default-buffer))
+ (null (slime-rex-continuations))))
+
+(defun slime-wait-condition (name predicate timeout)
+ (let ((end (time-add (current-time) (seconds-to-time timeout))))
+ (while (not (funcall predicate))
+ (cond ((time-less-p end (current-time))
+ (error "Timeout waiting for condition: %S" name))
+ (t
+ ;; XXX if a process-filter enters a recursive-edit, we
+ ;; hang forever
+ (save-excursion
+ (slime-accept-process-output nil 0.1)))))))
+
+(defun slime-sync-to-top-level (timeout)
+ (slime-wait-condition "top-level" #'slime-at-top-level-p timeout))
+
+;; XXX: unused function
+(defun slime-check-sldb-level (expected)
+ (let ((sldb-level (when-let (sldb (sldb-get-default-buffer))
+ (with-current-buffer sldb
+ sldb-level))))
+ (slime-check ("SLDB level (%S) is %S" expected sldb-level)
+ (equal expected sldb-level))))
+
+(defun slime-test-expect (name expected actual &optional test)
+ (when (stringp expected) (setq expected (substring-no-properties expected)))
+ (when (stringp actual) (setq actual (substring-no-properties actual)))
+ (slime-check ("%s:\nexpected: [%S]\n actual: [%S]" name expected actual)
+ (funcall (or test #'equal) expected actual)))
+
+(defun sldb-level ()
+ (when-let (sldb (sldb-get-default-buffer))
+ (with-current-buffer sldb
+ sldb-level)))
+
+(defun slime-sldb-level= (level)
+ (when-let (sldb (sldb-get-default-buffer))
+ (with-current-buffer sldb
+ (equal sldb-level level))))
+
+(def-slime-test narrowing
+ ()
+ "Check that narrowing is properly sustained."
+ '(())
+ (slime-check-top-level)
+ (let ((random-buffer-name (symbol-name (gensym)))
+ (defun-pos) (tmpbuffer))
+ (with-temp-buffer
+ (dotimes (i 100) (insert (format ";;; %d. line\n" i)))
+ (setq tmpbuffer (current-buffer))
+ (setq defun-pos (point))
+ (insert (concat "(defun __foo__ (x y)" "\n"
+ " 'nothing)" "\n"))
+ (dotimes (i 100) (insert (format ";;; %d. line\n" (+ 100 i))))
+ (slime-check "Checking that newly created buffer is not narrowed."
+ (not (slime-buffer-narrowed-p)))
+
+ (goto-char defun-pos)
+ (narrow-to-defun)
+ (slime-check "Checking that narrowing succeeded."
+ (slime-buffer-narrowed-p))
+
+ (slime-with-output-to-temp-buffer (random-buffer-name) nil
+ (slime-check ("Checking that we're in Slime's temp buffer `%s'" random-buffer-name)
+ (equal (buffer-name (current-buffer)) random-buffer-name))
+ (slime-temp-buffer-quit))
+ (kill-buffer random-buffer-name)
+ (slime-check ("Checking that we've got back from `%s'" random-buffer-name)
+ (and (eq (current-buffer) tmpbuffer)
+ (= (point) defun-pos)))
+
+ (slime-check "Checking that narrowing sustained after quitting Slime's temp buffer."
+ (slime-buffer-narrowed-p))
+
+ (let ((slime-buffer-package "SWANK")
+ (symbol '*buffer-package*))
+ (slime-edit-definition (symbol-name symbol))
+ (slime-check ("Checking that we've got M-. into swank.lisp." symbol)
+ (string= (file-name-nondirectory (buffer-file-name))
+ "swank.lisp"))
+ (slime-pop-find-definition-stack)
+ (slime-check ("Checking that we've got back.")
+ (and (eq (current-buffer) tmpbuffer)
+ (= (point) defun-pos)))
+
+ (slime-check "Checking that narrowing sustained after M-,"
+ (slime-buffer-narrowed-p)))
+ ))
+ (slime-check-top-level))
+
+
+(def-slime-test find-definition
+ (name buffer-package snippet)
+ "Find the definition of a function or macro in swank.lisp."
+ '(("read-from-emacs" "SWANK" "(defun read-from-emacs ")
+ ("swank::read-from-emacs" "CL-USER" "(defun read-from-emacs ")
+ ("swank:start-server" "CL-USER" "(defun start-server "))
+ (switch-to-buffer "*scratch*") ; not buffer of definition
+ (slime-check-top-level)
+ (let ((orig-buffer (current-buffer))
+ (orig-pos (point))
+ (enable-local-variables nil) ; don't get stuck on -*- eval: -*-
+ (slime-buffer-package buffer-package))
+ (slime-edit-definition name)
+ ;; Postconditions
+ (slime-check ("Definition of `%S' is in swank.lisp." name)
+ (string= (file-name-nondirectory (buffer-file-name)) "swank.lisp"))
+ (slime-check "Definition now at point." (looking-at snippet))
+ (slime-pop-find-definition-stack)
+ (slime-check "Returning from definition restores original buffer/position."
+ (and (eq orig-buffer (current-buffer))
+ (= orig-pos (point)))))
+ (slime-check-top-level))
+
+(def-slime-test complete-symbol
+ (prefix expected-completions)
+ "Find the completions of a symbol-name prefix."
+ '(("cl:compile" (("cl:compile" "cl:compile-file" "cl:compile-file-pathname"
+ "cl:compiled-function" "cl:compiled-function-p" "cl:compiler-macro"
+ "cl:compiler-macro-function")
+ "cl:compile"))
+ ("cl:foobar" (nil ""))
+ ("swank::compile-file" (("swank::compile-file"
+ "swank::compile-file-for-emacs"
+ "swank::compile-file-if-needed"
+ "swank::compile-file-pathname")
+ "swank::compile-file"))
+ ("cl:m-v-l" (nil "")))
+ (let ((completions (slime-simple-completions prefix)))
+ (slime-test-expect "Completion set" expected-completions completions)))
+
+(def-slime-test arglist
+ ;; N.B. Allegro apparently doesn't return the default values of
+ ;; optional parameters. Thus the regexp in the start-server
+ ;; expected value. In a perfect world we'd find a way to smooth
+ ;; over this difference between implementations--perhaps by
+ ;; convincing Franz to provide a function that does what we want.
+ (function-name expected-arglist)
+ "Lookup the argument list for FUNCTION-NAME.
+Confirm that EXPECTED-ARGLIST is displayed."
+ '(("swank::operator-arglist" "(swank::operator-arglist name package)")
+ ("swank::create-socket" "(swank::create-socket host port)")
+ ("swank::emacs-connected" "(swank::emacs-connected )")
+ ("swank::compile-string-for-emacs"
+ "(swank::compile-string-for-emacs string buffer position directory)")
+ ("swank::connection.socket-io"
+ "(swank::connection.socket-io \\(struct\\(ure\\)?\\|object\\|instance\\))")
+ ("cl:lisp-implementation-type" "(cl:lisp-implementation-type )")
+ ("cl:class-name"
+ "(cl:class-name \\(class\\|object\\|instance\\|structure\\))"))
+ (slime-check-top-level)
+ (let ((arglist (slime-eval `(swank:operator-arglist ,function-name
+ "swank"))))
+ (slime-test-expect "Argument list is as expected"
+ expected-arglist (downcase arglist)
+ #'string-match))
+ (slime-check-top-level))
+
+(def-slime-test (compile-defun ("allegro" "lispworks" "clisp"))
+ (program subform)
+ "Compile PROGRAM containing errors.
+Confirm that SUBFORM is correctly located."
+ '(("(defun cl-user::foo () (cl-user::bar))" (cl-user::bar))
+ ("(defun cl-user::foo ()
+ #\\space
+ ;;Sdf
+ (cl-user::bar))"
+ (cl-user::bar))
+ ("(defun cl-user::foo ()
+ #+(or)skipped
+ #| #||#
+ #||# |#
+ (cl-user::bar))"
+ (cl-user::bar))
+ ("(defun cl-user::foo ()
+ (list `(1 ,(random 10) 2 ,@(random 10) 3 ,(cl-user::bar))))"
+ (cl-user::bar))
+ ("(defun cl-user::foo ()
+ \"\\\" bla bla \\\"\"
+ (cl-user::bar))"
+ (cl-user::bar))
+ ("(defun cl-user::foo ()
+ #.*log-events*
+ (cl-user::bar))"
+ (cl-user::bar))
+ ("#.'(defun x () (/ 1 0))
+ (defun foo ()
+ (cl-user::bar))
+
+ "
+ (cl-user::bar)))
+ (slime-check-top-level)
+ (with-temp-buffer
+ (lisp-mode)
+ (insert program)
+ (setq slime-buffer-package ":swank")
+ (slime-compile-string (buffer-string) 1)
+ (setq slime-buffer-package ":cl-user")
+ (slime-sync-to-top-level 5)
+ (goto-char (point-max))
+ (slime-previous-note)
+ (slime-check error-location-correct
+ (equal (read (current-buffer))
+ subform)))
+ (slime-check-top-level))
+
+(def-slime-test async-eval-debugging (depth)
+ "Test recursive debugging of asynchronous evaluation requests."
+ '((1) (2) (3))
+ (slime-check-top-level)
+ (lexical-let ((depth depth)
+ (debug-hook-max-depth 0))
+ (let ((debug-hook
+ (lambda ()
+ (with-current-buffer (sldb-get-default-buffer)
+ (when (> sldb-level debug-hook-max-depth)
+ (setq debug-hook-max-depth sldb-level)
+ (if (= sldb-level depth)
+ ;; We're at maximum recursion - time to unwind
+ (sldb-quit)
+ ;; Going down - enter another recursive debug
+ ;; Recursively debug.
+ (slime-eval-async 'no-such-variable)))))))
+ (let ((sldb-hook (cons debug-hook sldb-hook)))
+ (slime-eval-async 'no-such-variable)
+ (slime-sync-to-top-level 5)
+ (slime-check-top-level)
+ (slime-check ("Maximum depth reached (%S) is %S."
+ debug-hook-max-depth depth)
+ (= debug-hook-max-depth depth))))))
+
+(def-slime-test unwind-to-previous-sldb-level (level2 level1)
+ "Test recursive debugging and returning to lower SLDB levels."
+ '((2 1) (4 2))
+ (slime-check-top-level)
+ (lexical-let ((level2 level2)
+ (level1 level1)
+ (state 'enter)
+ (max-depth 0))
+ (let ((debug-hook
+ (lambda ()
+ (with-current-buffer (sldb-get-default-buffer)
+ (setq max-depth (max sldb-level max-depth))
+ (ecase state
+ (enter
+ (cond ((= sldb-level level2)
+ (setq state 'leave)
+ (sldb-invoke-restart (sldb-first-abort-restart)))
+ (t
+ (slime-eval-async `(cl:aref cl:nil ,sldb-level)))))
+ (leave
+ (cond ((= sldb-level level1)
+ (setq state 'ok)
+ (sldb-quit))
+ (t
+ (sldb-invoke-restart (sldb-first-abort-restart))
+ ))))))))
+ (let ((sldb-hook (cons debug-hook sldb-hook)))
+ (slime-eval-async `(cl:aref cl:nil 0))
+ (slime-sync-to-top-level 15)
+ (slime-check-top-level)
+ (slime-check ("Maximum depth reached (%S) is %S." max-depth level2)
+ (= max-depth level2))
+ (slime-check ("Final state reached.")
+ (eq state 'ok))))))
+
+(defun sldb-first-abort-restart ()
+ (let ((case-fold-search t))
+ (position-if (lambda (x) (string-match "abort" (car x))) sldb-restarts)))
+
+(def-slime-test loop-interrupt-quit
+ ()
+ "Test interrupting a loop."
+ '(())
+ (slime-check-top-level)
+ (slime-eval-async '(cl:loop) (lambda (_) ) "CL-USER")
+ (slime-accept-process-output nil 1)
+ (slime-check "In eval state." (slime-busy-p))
+ (slime-interrupt)
+ (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5)
+ (with-current-buffer (sldb-get-default-buffer)
+ (sldb-quit))
+ (slime-sync-to-top-level 5)
+ (slime-check-top-level))
+
+(def-slime-test loop-interrupt-continue-interrupt-quit
+ ()
+ "Test interrupting a previously interrupted but continued loop."
+ '(())
+ (slime-check-top-level)
+ (slime-eval-async '(cl:loop) (lambda (_) ) "CL-USER")
+ (sleep-for 1)
+ (slime-wait-condition "running" #'slime-busy-p 5)
+ (slime-interrupt)
+ (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5)
+ (with-current-buffer (sldb-get-default-buffer)
+ (sldb-continue))
+ (slime-wait-condition "running" (lambda ()
+ (and (slime-busy-p)
+ (not (sldb-get-default-buffer)))) 5)
+ (slime-interrupt)
+ (slime-wait-condition "Second interrupt" (lambda () (slime-sldb-level= 1)) 5)
+ (with-current-buffer (sldb-get-default-buffer)
+ (sldb-quit))
+ (slime-sync-to-top-level 5)
+ (slime-check-top-level))
+
+(def-slime-test interactive-eval
+ ()
+ "Test interactive eval and continuing from the debugger."
+ '(())
+ (slime-check-top-level)
+ (lexical-let ((done nil))
+ (let ((sldb-hook (lambda () (sldb-continue) (setq done t))))
+ (slime-interactive-eval
+ "(progn(cerror \"foo\" \"restart\")(cerror \"bar\" \"restart\")(+ 1 2))")
+ (while (not done) (slime-accept-process-output))
+ (slime-sync-to-top-level 5)
+ (slime-check-top-level)
+ (let ((message (current-message)))
+ (slime-check "Minibuffer contains: \"3\""
+ (equal "=> 3 (#x3, #o3, #b11)" message))))))
+
+(def-slime-test interrupt-bubbling-idiot
+ ()
+ "Test interrupting a loop that sends a lot of output to Emacs."
+ '(())
+ (slime-accept-process-output nil 1)
+ (slime-check-top-level)
+ (slime-eval-async '(cl:loop :for i :from 0 :do (cl:progn (cl:print i)
+ (cl:finish-output)))
+ (lambda (_) )
+ "CL-USER")
+ (sleep-for 1)
+ (slime-interrupt)
+ (slime-wait-condition "Debugger visible"
+ (lambda ()
+ (and (slime-sldb-level= 1)
+ (get-buffer-window (sldb-get-default-buffer))))
+ 30)
+ (with-current-buffer (sldb-get-default-buffer)
+ (sldb-quit))
+ (slime-sync-to-top-level 5))
+
+(def-slime-test package-updating
+ (package-name nicknames)
+ "Test if slime-lisp-package is updated."
+ '(("COMMON-LISP" ("CL"))
+ ("KEYWORD" ("" "KEYWORD"))
+ ("COMMON-LISP-USER" ("CL-USER")))
+ (with-current-buffer (slime-output-buffer)
+ (let ((p (slime-eval
+ `(swank:listener-eval
+ ,(format
+ "(cl:setq cl:*print-case* :upcase)
+ (cl:setq cl:*package* (cl:find-package %S))
+ (cl:package-name cl:*package*)" package-name))
+ (slime-lisp-package))))
+ (slime-check ("slime-lisp-package is %S." package-name)
+ (equal (slime-lisp-package) package-name))
+ (slime-check ("slime-lisp-package-prompt-string is in %S." nicknames)
+ (member (slime-lisp-package-prompt-string) nicknames)))))
+
+(def-slime-test repl-test
+ (input result-contents)
+ "Test simple commands in the minibuffer."
+ '(("(+ 1 2)" "SWANK> (+ 1 2)
+3
+SWANK> ")
+ ("(princ 10)" "SWANK> (princ 10)
+10
+10
+SWANK> ")
+ ("(princ 10)(princ 20)" "SWANK> (princ 10)(princ 20)
+1020
+20
+SWANK> ")
+ ("(dotimes (i 10 77) (princ i) (terpri))"
+ "SWANK> (dotimes (i 10 77) (princ i) (terpri))
+0
+1
+2
+3
+4
+5
+6
+7
+8
+9
+77
+SWANK> "))
+ (with-current-buffer (slime-output-buffer)
+ (setf (slime-lisp-package-prompt-string) "SWANK"))
+ (kill-buffer (slime-output-buffer))
+ (with-current-buffer (slime-output-buffer)
+ (insert input)
+ (slime-test-expect "Buffer contains input"
+ (concat "SWANK> " input)
+ (buffer-string))
+ (call-interactively 'slime-repl-return)
+ (slime-sync-to-top-level 5)
+ (slime-test-expect "Buffer contains result"
+ result-contents (buffer-string))))
+
+(def-slime-test repl-return
+ (before after result-contents)
+ "Test if slime-repl-return sends the correct protion to Lisp even
+if point is not at the end of the line."
+ '(("(+ 1 2)" "" "SWANK> (+ 1 2)
+3
+SWANK> ")
+("(+ 1 " "2)" "SWANK> (+ 1 2)
+3
+SWANK> ")
+
+("(+ 1\n" "2)" "SWANK> (+ 1
+2)
+3
+SWANK> "))
+ (with-current-buffer (slime-output-buffer)
+ (setf (slime-lisp-package-prompt-string) "SWANK"))
+ (kill-buffer (slime-output-buffer))
+ (with-current-buffer (slime-output-buffer)
+ (insert before)
+ (save-excursion (insert after))
+ (slime-test-expect "Buffer contains input"
+ (concat "SWANK> " before after)
+ (buffer-string))
+ (call-interactively 'slime-repl-return)
+ (slime-sync-to-top-level 5)
+ (slime-test-expect "Buffer contains result"
+ result-contents (buffer-string))))
+
+(def-slime-test repl-read
+ (prompt input result-contents)
+ "Test simple commands in the minibuffer."
+ '(("(read-line)" "foo" "SWANK> (values (read-line))
+foo
+\"foo\"
+SWANK> ")
+ ("(read-char)" "1" "SWANK> (values (read-char))
+1
+#\\1
+SWANK> ")
+ ("(read)" "(+ 2 3
+4)" "SWANK> (values (read))
+\(+ 2 3
+4)
+\(+ 2 3 4)
+SWANK> "))
+ (slime-sync-to-top-level 2)
+ (with-current-buffer (slime-output-buffer)
+ (setf (slime-lisp-package-prompt-string) "SWANK"))
+ (kill-buffer (slime-output-buffer))
+ (with-current-buffer (slime-output-buffer)
+ (insert (format "(values %s)" prompt))
+ (call-interactively 'slime-repl-return)
+ (slime-wait-condition "reading" #'slime-reading-p 5)
+ (insert input)
+ (call-interactively 'slime-repl-return)
+ (slime-sync-to-top-level 5)
+ (slime-test-expect "Buffer contains result"
+ result-contents (buffer-string))))
+
+(def-slime-test repl-read-lines
+ (command inputs final-contents)
+ "Test reading multiple lines from the repl."
+ '(("(list (read-line) (read-line) (read-line))"
+ ("a" "b" "c")
+ "SWANK> (list (read-line) (read-line) (read-line))
+a
+b
+c
+\(\"a\" \"b\" \"c\")
+SWANK> "))
+ (when (slime-output-buffer)
+ (kill-buffer (slime-output-buffer)))
+ (with-current-buffer (slime-output-buffer)
+ (setf (slime-lisp-package-prompt-string) "SWANK")
+ (insert command)
+ (call-interactively 'slime-repl-return)
+ (dolist (input inputs)
+ (slime-wait-condition "reading" #'slime-reading-p 5)
+ (insert input)
+ (call-interactively 'slime-repl-return))
+ (slime-sync-to-top-level 5)
+ (slime-check "Buffer contains result"
+ (equal final-contents (buffer-string)))))
+
+(def-slime-test repl-type-ahead
+ (command input final-contents)
+ "Ensure that user input is preserved correctly.
+In particular, input inserted while waiting for a result."
+ '(("(sleep 1)" "foo" "SWANK> (sleep 1)
+NIL
+SWANK> foo"))
+ (when (slime-output-buffer)
+ (kill-buffer (slime-output-buffer)))
+ (setf (slime-lisp-package-prompt-string) "SWANK")
+ (with-current-buffer (slime-output-buffer)
+ (insert command)
+ (call-interactively 'slime-repl-return)
+ (insert input)
+ (slime-sync-to-top-level 5)
+ (slime-check "Buffer contains result"
+ (equal final-contents (buffer-string)))))
+
+(def-slime-test interactive-eval-output
+ (input result-contents visiblep)
+ "Test simple commands in the minibuffer."
+ '(("(+ 1 2)" ";;;; (+ 1 2) ...
+SWANK> " nil)
+ ("(princ 10)" ";;;; (princ 10) ...
+10
+SWANK> " t)
+ ("(princ \"����������������������������\")"
+ ";;;; (princ \"����������������������������\") ...
+����������������������������
+SWANK> " t))
+ (when (and (fboundp 'string-to-multibyte)
+ (with-current-buffer (process-buffer (slime-connection))
+ enable-multibyte-characters))
+ (setq input (funcall 'string-to-multibyte input))
+ (setq result-contents (funcall 'string-to-multibyte result-contents)))
+ (with-current-buffer (slime-output-buffer)
+ (setf (slime-lisp-package-prompt-string) "SWANK"))
+ (kill-buffer (slime-output-buffer))
+ (with-current-buffer (slime-output-buffer)
+ (slime-interactive-eval input)
+ (slime-sync-to-top-level 5)
+ (slime-test-expect "Buffer contains result"
+ result-contents (buffer-string))
+ (slime-test-expect "Buffer visible?"
+ visiblep
+ (not (not (get-buffer-window (current-buffer)))))))
+
+(def-slime-test break
+ ()
+ "Test if BREAK invokes SLDB."
+ '(())
+ (slime-accept-process-output nil 1)
+ (slime-check-top-level)
+ (slime-compile-string (prin1-to-string '(cl:defun cl-user::foo ()
+ (cl:break)))
+ 0)
+ (slime-sync-to-top-level 2)
+ (slime-eval-async '(cl-user::foo))
+ (slime-wait-condition "Debugger visible"
+ (lambda ()
+ (and (slime-sldb-level= 1)
+ (get-buffer-window (sldb-get-default-buffer))))
+ 5)
+ (with-current-buffer (sldb-get-default-buffer)
+ (sldb-quit))
+ (slime-accept-process-output nil 1)
+ (slime-sync-to-top-level 5))
+
+(def-slime-test interrupt-at-toplevel
+ ()
+ "Let's see what happens if we send a user interrupt at toplevel."
+ '(())
+ (slime-check-top-level)
+ (slime-interrupt)
+ (slime-wait-condition "Debugger visible"
+ (lambda ()
+ (and (slime-sldb-level= 1)
+ (get-buffer-window (sldb-get-default-buffer))))
+ 5)
+ (with-current-buffer (sldb-get-default-buffer)
+ (sldb-quit))
+ (slime-sync-to-top-level 5))
+
+(def-slime-test interrupt-in-blocking-read
+ ()
+ "Let's see what happens if we interrupt a blocking read operation."
+ '(())
+ (slime-check-top-level)
+ (when (slime-output-buffer)
+ (setf (slime-lisp-package-prompt-string) "SWANK")
+ (kill-buffer (slime-output-buffer)))
+ (with-current-buffer (slime-output-buffer)
+ (insert "(read-char)")
+ (call-interactively 'slime-repl-return))
+ (slime-wait-condition "reading" #'slime-reading-p 5)
+ (slime-interrupt)
+ (slime-wait-condition "Debugger visible"
+ (lambda ()
+ (and (slime-sldb-level= 1)
+ (get-buffer-window (sldb-get-default-buffer))))
+ 5)
+ (with-current-buffer (sldb-get-default-buffer)
+ (sldb-continue))
+ (slime-wait-condition "reading" #'slime-reading-p 5)
+ (with-current-buffer (slime-output-buffer)
+ (insert "X")
+ (call-interactively 'slime-repl-return)
+ (slime-sync-to-top-level 5)
+ (slime-test-expect "Buffer contains result"
+ "SWANK> (read-char)
+X
+#\\X
+SWANK> " (buffer-string))))
+
+(def-slime-test disconnect
+ ()
+ "Close the connetion.
+Confirm that the subprocess continues gracefully.
+Reconnect afterwards."
+ '(())
+ (slime-check-top-level)
+ (let* ((c (slime-connection))
+ (p (slime-inferior-process c)))
+ (with-current-buffer (process-buffer p)
+ (erase-buffer))
+ (delete-process c)
+ (assert (equal (process-status c) 'closed) nil "Connection not closed")
+ (slime-accept-process-output nil 0.1)
+ (assert (equal (process-status p) 'run) nil "Subprocess not running")
+ (with-current-buffer (process-buffer p)
+ (assert (< (buffer-size) 500) nil "Unusual output"))
+ (slime-inferior-connect p (slime-inferior-lisp-args p))
+ (lexical-let ((hook nil))
+ (setq hook (lambda ()
+ (remove-hook 'slime-connected-hook hook)))
+ (add-hook 'slime-connected-hook hook)
+ (while (member hook slime-connected-hook)
+ (sit-for 0.5)
+ (slime-accept-process-output nil 0.1)))
+ (slime-test-expect "We are connected again" p (slime-inferior-process))))
+
+
+;;;; Utilities
+
+;;;;; Misc.
+
+(defun slime-length= (seq n)
+ "Test for whether SEQ contains N number of elements. I.e. it's equivalent
+ to (= (LENGTH SEQ) N), but besides being more concise, it may also be more
+ efficiently implemented."
+ (etypecase seq
+ (list
+ (let ((list seq))
+ (setq list (nthcdr (1- n) list))
+ (and list (null (cdr list)))))
+ (sequence
+ (= (length seq) n))))
+
+(defun slime-length> (seq n)
+ "Return non-nil if (> (length LIST) N)."
+ (etypecase seq
+ (list (nthcdr n seq))
+ (seq (> (length seq) n))))
+
+(defun slime-split-string (string &optional separators omit-nulls)
+ "This is like `split-string' in Emacs22, but also works in
+Emacs20 and 21."
+ (let ((splits (split-string string separators)))
+ (if omit-nulls
+ (setq splits (remove "" splits))
+ ;; SPLIT-STRING in Emacs before 22.x automatically removed nulls
+ ;; at beginning and end, so we gotta add them here again.
+ (when (or (slime-emacs-20-p) (slime-emacs-21-p))
+ (when (find (elt string 0) separators)
+ (push "" splits))
+ (when (find (elt string (1- (length string))) separators)
+ (setq splits (append splits (list ""))))))
+ splits))
+
+;;;;; Buffer related
+
+(defun slime-buffer-narrowed-p (&optional buffer)
+ "Returns T if BUFFER (or the current buffer respectively) is narrowed."
+ (with-current-buffer (or buffer (current-buffer))
+ (let ((beg (point-min))
+ (end (point-max))
+ (total (buffer-size)))
+ (or (/= beg 1) (/= end (1+ total))))))
+
+
+;;;;; Extracting Lisp forms from the buffer or user
+
+(defun slime-defun-at-point ()
+ "Return the text of the defun at point."
+ (apply #'buffer-substring-no-properties
+ (slime-region-for-defun-at-point)))
+
+(defun slime-region-for-defun-at-point ()
+ "Return the start and end position of the toplevel form at point."
+ (save-excursion
+ (save-match-data
+ (end-of-defun)
+ (let ((end (point)))
+ (beginning-of-sexp)
+ (list (point) end)))))
+
+(defun slime-beginning-of-symbol ()
+ "Move point to the beginning of the current symbol."
+ (when (slime-point-moves-p
+ (while (slime-point-moves-p
+ (skip-syntax-backward "w_")
+ (when (eq (char-before) ?|)
+ (backward-char)))))
+ (when (eq (char-before) ?#) ; special case for things like "#<foo"
+ (forward-char))))
+
+(defun slime-end-of-symbol ()
+ "Move point to the end of the current symbol."
+ (while (slime-point-moves-p
+ (skip-syntax-forward "w_")
+ ;; | has the syntax as ", so we need to
+ ;; treat it manually rather than via syntax.
+ (when (looking-at "|")
+ (forward-char)))))
+
+(put 'slime-symbol 'end-op 'slime-end-of-symbol)
+(put 'slime-symbol 'beginning-op 'slime-beginning-of-symbol)
+
+(defun slime-symbol-start-pos ()
+ "Return the starting position of the symbol under point.
+The result is unspecified if there isn't a symbol under the point."
+ (save-excursion (slime-beginning-of-symbol) (point)))
+
+(defun slime-symbol-end-pos ()
+ (save-excursion (slime-end-of-symbol) (point)))
+
+(defun slime-symbol-name-at-point ()
+ "Return the name of the symbol at point, otherwise nil."
+ (save-restriction
+ ;; Don't be tricked into grabbing the REPL prompt.
+ (when (and (eq major-mode 'slime-repl-mode)
+ (>= (point) slime-repl-input-start-mark))
+ (narrow-to-region slime-repl-input-start-mark (point-max)))
+ (save-excursion
+ (let ((string (thing-at-point 'slime-symbol)))
+ (and string
+ ;; In Emacs20 (thing-at-point 'symbol) returns "" instead
+ ;; of nil when called from an empty (or
+ ;; narrowed-to-empty) buffer.
+ (not (equal string ""))
+ (substring-no-properties string))))))
+
+(defun slime-symbol-at-point ()
+ "Return the symbol at point, otherwise nil."
+ (let ((name (slime-symbol-name-at-point)))
+ (and name (intern name))))
+
+(defun slime-sexp-at-point ()
+ "Return the sexp at point as a string, otherwise nil."
+ (let ((string (thing-at-point 'sexp)))
+ (if string (substring-no-properties string) nil)))
+
+(defun slime-sexp-at-point-or-error ()
+ "Return the sexp at point as a string, othwise signal an error."
+ (or (slime-sexp-at-point)
+ (error "No expression at point.")))
+
+;;;; Portability library
+
+(when (featurep 'xemacs)
+ (require 'overlay))
+
+(defmacro slime-defun-if-undefined (name &rest rest)
+ ;; We can't decide at compile time whether NAME is properly
+ ;; bound. So we delay the decision to runtime to ensure some
+ ;; definition
+ `(unless (fboundp ',name)
+ (defun ,name ,@rest)))
+
+(put 'slime-defun-if-undefined 'lisp-indent-function 2)
+
+(defvar slime-accept-process-output-supports-floats
+ (ignore-errors (accept-process-output nil 0.0) t))
+
+(defun slime-accept-process-output (&optional process timeout)
+ "Like `accept-process-output' but the TIMEOUT argument can be a float."
+ (cond (slime-accept-process-output-supports-floats
+ (accept-process-output process timeout))
+ (t
+ (accept-process-output process
+ (if timeout (truncate timeout))
+ ;; Emacs 21 uses microsecs; Emacs 22 millisecs
+ (if timeout (truncate (* timeout 1000000)))))))
+
+(slime-defun-if-undefined next-single-char-property-change
+ (position prop &optional object limit)
+ (let ((limit (typecase limit
+ (null nil)
+ (marker (marker-position limit))
+ (t limit))))
+ (if (stringp object)
+ (or (next-single-property-change position prop object limit)
+ limit
+ (length object))
+ (with-current-buffer (or object (current-buffer))
+ (let ((initial-value (get-char-property position prop object))
+ (limit (or limit (point-max))))
+ (loop for pos = position then (next-char-property-change pos limit)
+ if (>= pos limit) return limit
+ if (not (eq initial-value
+ (get-char-property pos prop object)))
+ return pos))))))
+
+(slime-defun-if-undefined previous-single-char-property-change
+ (position prop &optional object limit)
+ (let ((limit (typecase limit
+ (null nil)
+ (marker (marker-position limit))
+ (t limit))))
+ (if (stringp object)
+ (or (previous-single-property-change position prop object limit)
+ limit
+ (length object))
+ (with-current-buffer (or object (current-buffer))
+ (let ((limit (or limit (point-min))))
+ (if (<= position limit)
+ limit
+ (let ((initial-value (get-char-property (1- position)
+ prop object)))
+ (loop for pos = position then
+ (previous-char-property-change pos limit)
+ if (<= pos limit) return limit
+ if (not (eq initial-value
+ (get-char-property (1- pos) prop object)))
+ return pos))))))))
+
+(slime-defun-if-undefined next-char-property-change (position &optional limit)
+ (let ((tmp (next-overlay-change position)))
+ (when tmp
+ (setq tmp (min tmp limit)))
+ (next-property-change position nil tmp)))
+
+(slime-defun-if-undefined previous-char-property-change
+ (position &optional limit)
+ (let ((tmp (previous-overlay-change position)))
+ (when tmp
+ (setq tmp (max tmp limit)))
+ (previous-property-change position nil tmp)))
+
+(slime-defun-if-undefined substring-no-properties (string &optional start end)
+ (let* ((start (or start 0))
+ (end (or end (length string)))
+ (string (substring string start end)))
+ (set-text-properties 0 (- end start) nil string)
+ string))
+
+(slime-defun-if-undefined match-string-no-properties (num &optional string)
+ (if (match-beginning num)
+ (if string
+ (substring-no-properties string (match-beginning num)
+ (match-end num))
+ (buffer-substring-no-properties (match-beginning num)
+ (match-end num)))))
+
+(slime-defun-if-undefined set-window-text-height (window height)
+ (let ((delta (- height (window-text-height window))))
+ (unless (zerop delta)
+ (let ((window-min-height 1))
+ (if (and window (not (eq window (selected-window))))
+ (save-selected-window
+ (select-window window)
+ (enlarge-window delta))
+ (enlarge-window delta))))))
+
+(slime-defun-if-undefined window-text-height (&optional window)
+ (1- (window-height window)))
+
+(slime-defun-if-undefined subst-char-in-string (fromchar tochar string
+ &optional inplace)
+ "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
+Unless optional argument INPLACE is non-nil, return a new string."
+ (let ((i (length string))
+ (newstr (if inplace string (copy-sequence string))))
+ (while (> i 0)
+ (setq i (1- i))
+ (if (eq (aref newstr i) fromchar)
+ (aset newstr i tochar)))
+ newstr))
+
+(slime-defun-if-undefined count-screen-lines
+ (&optional beg end count-final-newline window)
+ (unless beg
+ (setq beg (point-min)))
+ (unless end
+ (setq end (point-max)))
+ (if (= beg end)
+ 0
+ (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region (min beg end)
+ (if (and (not count-final-newline)
+ (= ?\n (char-before (max beg end))))
+ (1- (max beg end))
+ (max beg end)))
+ (goto-char (point-min))
+ ;; XXX make this xemacs compatible
+ (1+ (vertical-motion (buffer-size) window))))))
+
+(slime-defun-if-undefined seconds-to-time (seconds)
+ "Convert SECONDS (a floating point number) to a time value."
+ (list (floor seconds 65536)
+ (floor (mod seconds 65536))
+ (floor (* (- seconds (ffloor seconds)) 1000000))))
+
+(slime-defun-if-undefined time-less-p (t1 t2)
+ "Say whether time value T1 is less than time value T2."
+ (or (< (car t1) (car t2))
+ (and (= (car t1) (car t2))
+ (< (nth 1 t1) (nth 1 t2)))))
+
+(slime-defun-if-undefined time-add (t1 t2)
+ "Add two time values. One should represent a time difference."
+ (let ((high (car t1))
+ (low (if (consp (cdr t1)) (nth 1 t1) (cdr t1)))
+ (micro (if (numberp (car-safe (cdr-safe (cdr t1))))
+ (nth 2 t1)
+ 0))
+ (high2 (car t2))
+ (low2 (if (consp (cdr t2)) (nth 1 t2) (cdr t2)))
+ (micro2 (if (numberp (car-safe (cdr-safe (cdr t2))))
+ (nth 2 t2)
+ 0)))
+ ;; Add
+ (setq micro (+ micro micro2))
+ (setq low (+ low low2))
+ (setq high (+ high high2))
+
+ ;; Normalize
+ ;; `/' rounds towards zero while `mod' returns a positive number,
+ ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
+ (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
+ (setq micro (mod micro 1000000))
+ (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
+ (setq low (logand low 65535))
+
+ (list high low micro)))
+
+(slime-defun-if-undefined line-beginning-position (&optional n)
+ (save-excursion
+ (beginning-of-line n)
+ (point)))
+
+(slime-defun-if-undefined line-end-position (&optional n)
+ (save-excursion
+ (end-of-line n)
+ (point)))
+
+(slime-defun-if-undefined check-parens ()
+ "Verify that parentheses in the current buffer are balanced.
+If they are not, position point at the first syntax error found."
+ (interactive)
+ (let ((saved-point (point))
+ (state (parse-partial-sexp (point-min) (point-max) -1)))
+ (destructuring-bind (depth innermost-start last-terminated-start
+ in-string in-comment after-quote
+ minimum-depth comment-style
+ comment-or-string-start &rest _) state
+ (cond ((and (zerop depth)
+ (not in-string)
+ (or (not in-comment)
+ (and (eq comment-style nil)
+ (eobp)))
+ (not after-quote))
+ (goto-char saved-point)
+ (message "All parentheses appear to be balanced."))
+ ((plusp depth)
+ (goto-char innermost-start)
+ (error "Missing )"))
+ ((minusp depth)
+ (error "Extra )"))
+ (in-string
+ (goto-char comment-or-string-start)
+ (error "String not terminated"))
+ (in-comment
+ (goto-char comment-or-string-start)
+ (error "Comment not terminated"))
+ (after-quote
+ (error "After quote"))
+ (t (error "Shouldn't happen: parsing state: %S" state))))))
+
+(slime-defun-if-undefined read-directory-name (prompt
+ &optional dir default-dirname
+ mustmatch initial)
+ (unless dir
+ (setq dir default-directory))
+ (unless default-dirname
+ (setq default-dirname
+ (if initial (concat dir initial) default-directory)))
+ (let ((file (read-file-name prompt dir default-dirname mustmatch initial)))
+ (setq file (file-name-as-directory (expand-file-name file)))
+ (cond ((file-directory-p file)
+ file)
+ (t
+ (error "Not a directory: %s" file)))))
+
+(slime-defun-if-undefined check-coding-system (coding-system)
+ (or (eq coding-system 'binary)
+ (error "No such coding system: %S" coding-system)))
+
+(slime-defun-if-undefined process-coding-system (process)
+ '(binary . binary))
+
+(slime-defun-if-undefined set-process-coding-system
+ (process &optional decoding encoding))
+
+(unless (boundp 'temporary-file-directory)
+ (defvar temporary-file-directory
+ (file-name-as-directory
+ (cond ((memq system-type '(ms-dos windows-nt))
+ (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
+ ((memq system-type '(vax-vms axp-vms))
+ (or (getenv "TMPDIR") (getenv "TMP")
+ (getenv "TEMP") "SYS$SCRATCH:"))
+ (t
+ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
+ "The directory for writing temporary files."))
+
+(unless (fboundp 'with-temp-message)
+ (defmacro with-temp-message (message &rest body)
+ (let ((current-message (make-symbol "current-message"))
+ (temp-message (make-symbol "with-temp-message")))
+ `(let ((,temp-message ,message)
+ (,current-message))
+ (unwind-protect
+ (progn
+ (when ,temp-message
+ (setq ,current-message (current-message))
+ (message "%s" ,temp-message))
+ ,@body)
+ (and ,temp-message ,current-message
+ (message "%s" ,current-message)))))))
+
+(defun slime-emacs-20-p ()
+ (and (not (featurep 'xemacs))
+ (= emacs-major-version 20)))
+
+(defun slime-emacs-21-p ()
+ (and (not (featurep 'xemacs))
+ (= emacs-major-version 21)))
+
+(when (featurep 'xemacs)
+ (add-hook 'sldb-hook 'sldb-xemacs-emulate-point-entered-hook))
+
+(defun sldb-xemacs-emulate-point-entered-hook ()
+ (add-hook (make-local-variable 'post-command-hook)
+ 'sldb-xemacs-post-command-hook))
+
+(defun sldb-xemacs-post-command-hook ()
+ (when (get-text-property (point) 'point-entered)
+ (funcall (get-text-property (point) 'point-entered))))
+
+(slime-defun-if-undefined with-selected-window (window &rest body)
+ `(save-selected-window
+ (select-window ,window)
+ ,@body))
+
+;;; Stuff only available in XEmacs
+(slime-defun-if-undefined add-local-hook (hook function &optional append)
+ (make-local-hook hook)
+ (add-hook hook function append t))
+
+(slime-defun-if-undefined remove-local-hook (hook function)
+ (if (local-variable-p hook (current-buffer))
+ (remove-hook hook function t)))
+
+;;;; Some "nice" backward compatiblity bindings for lusers.
+
+(defvar slime-obsolete-commands
+ '(("\C-c\M-i" (slime repl) slime-fuzzy-complete-symbol)
+ ;; Don't shadow bindings in lisp-mode-map
+ ;;("\M-\C-a" (slime) slime-beginning-of-defun)
+ ;;("\M-\C-e" (slime) slime-end-of-defun)
+ ("\C-c\M-q" (slime) slime-reindent-defun)
+ ("\C-c\C-s" (slime) slime-complete-form)
+ ;; (nil nil slime-close-all-parens-in-sexp)
+ ))
+
+(defun slime-bind-obsolete-commands ()
+ (loop for (key maps command) in slime-obsolete-commands do
+ (dolist (m maps) (slime-bind-obsolete-command m key command))))
+
+(defun slime-bind-obsolete-command (map key command)
+ (let ((map (ecase map
+ (slime slime-mode-map)
+ (repl slime-repl-mode-map))))
+ (unless (lookup-key map key)
+ (define-key map key `(lambda (&rest _)
+ (interactive)
+ (slime-upgrade-notice ',command))))))
+
+(slime-bind-obsolete-commands)
+
+(defun slime-upgrade-notice (command)
+ (slime-timebomb (format "The command `%s' has been moved to contrib.
+Please consult the README file in the contrib directory for details.
+
+To fetch the contrib directoy use: cvs update -d"
+ command)
+ 15))
+
+;;;;; ... with gratuitous bloat
+
+(defun slime-timebomb (message timeout)
+ (with-current-buffer (generate-new-buffer "*warning*")
+ (insert message "\n\n")
+ (slime-timebomb-progress (point-marker) timeout)
+ (goto-char (point-min))
+ (pop-to-buffer (current-buffer))))
+
+(defun slime-timebomb-progress (mark timeout)
+ (let ((buffer (marker-buffer mark)))
+ (cond ((not (buffer-live-p buffer)))
+ ((zerop timeout) (kill-buffer buffer))
+ (t (with-current-buffer buffer
+ (save-excursion
+ (delete-region mark (point-max))
+ (goto-char mark)
+ (slime-timebomb-message timeout))
+ (run-with-timer 1 nil
+ 'slime-timebomb-progress mark (1- timeout)))))))
+
+(defun slime-timebomb-message (timeout)
+ (slime-insert-propertized
+ (list 'face (if (zerop (mod timeout 2)) 'highlight 'default))
+ (format "This message will destroy itself in %d seconds." timeout)))
+
+
+;;;; Finishing up
+
+(require 'bytecomp)
+(let ((byte-compile-warnings '()))
+ (mapc #'byte-compile
+ '(slime-alistify
+ slime-log-event
+ slime-events-buffer
+ slime-write-string
+ slime-output-buffer
+ slime-connection-output-buffer
+ slime-output-filter
+ slime-repl-show-maximum-output
+ slime-process-available-input
+ slime-dispatch-event
+ slime-net-filter
+ slime-net-have-input-p
+ slime-net-decode-length
+ slime-net-read
+ slime-print-apropos
+ slime-show-note-counts
+ slime-insert-propertized
+ slime-tree-insert)))
+
+(provide 'slime)
+(run-hooks 'slime-load-hook)
+
+;; Local Variables:
+;; outline-regexp: ";;;;+"
+;; indent-tabs-mode: nil
+;; coding: latin-1-unix!
+;; unibyte: t
+;; compile-command: "emacs -batch -L . -eval '(byte-compile-file \"slime.el\")' ; rm -v slime.elc"
+;; End:
+;;; slime.el ends here
Added: branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,541 @@
+;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;*"; -*-
+;;;
+;;; swank-abcl.lisp --- Armedbear CL specific code for SLIME.
+;;;
+;;; Adapted from swank-acl.lisp, Andras Simon, 2004
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require :collect) ;just so that it doesn't spoil the flying letters
+ (require :pprint))
+
+(defun sys::break (&optional (format-control "BREAK called")
+ &rest format-arguments)
+ (let ((*saved-backtrace* (backtrace-as-list-ignoring-swank-calls)))
+ (with-simple-restart (continue "Return from BREAK.")
+ (invoke-debugger
+ (sys::%make-condition 'simple-condition
+ (list :format-control format-control
+ :format-arguments format-arguments))))
+ nil))
+
+(defimplementation make-fn-streams (input-fn output-fn)
+ (let* ((output (ext:make-slime-output-stream output-fn))
+ (input (ext:make-slime-input-stream input-fn output)))
+ (values input output)))
+
+(defimplementation call-with-compilation-hooks (function)
+ (funcall function))
+
+;;; swank-mop
+
+;;dummies and definition
+
+(defclass standard-slot-definition ()())
+
+;(defun class-finalized-p (class) t)
+
+(defun slot-definition-documentation (slot) #+nil (documentation slot 't))
+(defun slot-definition-type (slot) t)
+(defun class-prototype (class))
+(defun generic-function-declarations (gf))
+(defun specializer-direct-methods (spec) (mop::class-direct-methods spec))
+
+(defun slot-definition-name (slot)
+ (mop::%slot-definition-name slot))
+
+(defun class-slots (class)
+ (mop::%class-slots class))
+
+(defun method-generic-function (method)
+ (mop::%method-generic-function method))
+
+(defun method-function (method)
+ (mop::%method-function method))
+
+(defun slot-boundp-using-class (class object slotdef)
+ (system::slot-boundp object (slot-definition-name slotdef)))
+
+(defun slot-value-using-class (class object slotdef)
+ (system::slot-value object (slot-definition-name slotdef)))
+
+(import-to-swank-mop
+ '( ;; classes
+ cl:standard-generic-function
+ standard-slot-definition ;;dummy
+ cl:method
+ cl:standard-class
+ ;; standard-class readers
+ mop::class-default-initargs
+ mop::class-direct-default-initargs
+ mop::class-direct-slots
+ mop::class-direct-subclasses
+ mop::class-direct-superclasses
+ mop::eql-specializer
+ mop::class-finalized-p
+ cl:class-name
+ mop::class-precedence-list
+ class-prototype ;;dummy
+ class-slots
+ specializer-direct-methods
+ ;; eql-specializer accessors
+ mop::eql-specializer-object
+ ;; generic function readers
+ mop::generic-function-argument-precedence-order
+ generic-function-declarations ;;dummy
+ mop::generic-function-lambda-list
+ mop::generic-function-methods
+ mop::generic-function-method-class
+ mop::generic-function-method-combination
+ mop::generic-function-name
+ ;; method readers
+ method-generic-function
+ method-function
+ mop::method-lambda-list
+ mop::method-specializers
+ mop::method-qualifiers
+ ;; slot readers
+ mop::slot-definition-allocation
+ slot-definition-documentation ;;dummy
+ mop::slot-definition-initargs
+ mop::slot-definition-initform
+ mop::slot-definition-initfunction
+ slot-definition-name
+ slot-definition-type ;;dummy
+ mop::slot-definition-readers
+ mop::slot-definition-writers
+ slot-boundp-using-class
+ slot-value-using-class
+ ))
+
+;;;; TCP Server
+
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+
+
+(defimplementation create-socket (host port)
+ (ext:make-server-socket port))
+
+
+(defimplementation local-port (socket)
+ (java:jcall (java:jmethod "java.net.ServerSocket" "getLocalPort") socket))
+
+
+(defimplementation close-socket (socket)
+ (ext:server-socket-close socket))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (declare (ignore buffering timeout external-format))
+ (ext:get-socket-stream (ext:socket-accept socket)))
+
+;;;; Unix signals
+
+(defimplementation call-without-interrupts (fn)
+ (funcall fn))
+
+;;there are too many to count
+(defimplementation getpid ()
+ 0)
+
+(defimplementation lisp-implementation-type-name ()
+ "armedbear")
+
+(defimplementation set-default-directory (directory)
+ (let ((dir (sys::probe-directory directory)))
+ (when dir (setf *default-pathname-defaults* dir))
+ (namestring dir)))
+
+
+;;;; Misc
+
+(defimplementation arglist (fun)
+ (cond ((symbolp fun)
+ (multiple-value-bind (arglist present) (sys::arglist fun)
+ (if present arglist :not-available)))
+ (t :not-available)))
+
+(defimplementation function-name (function)
+ (nth-value 2 (function-lambda-expression function)))
+
+(defimplementation macroexpand-all (form)
+ (macroexpand form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind &optional (sym symbol))
+ (or (documentation sym kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (maybe-push
+ :function (if (fboundp symbol)
+ (doc 'function)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ result)))
+
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:class
+ (describe (find-class symbol)))))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:class
+ (describe (find-class symbol)))))
+
+
+;;;; Debugger
+
+(defvar *sldb-topframe*)
+
+(defun backtrace-as-list-ignoring-swank-calls ()
+ (let ((list (ext:backtrace-as-list)))
+ (subseq list (1+ (or (position (intern "SWANK-DEBUGGER-HOOK" 'swank) list :key 'car) -1)))))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let ((*sldb-topframe* (car (backtrace-as-list-ignoring-swank-calls)) #+nil (excl::int-newest-frame)))
+ (funcall debugger-loop-fn)))
+
+(defun nth-frame (index)
+ (nth index (backtrace-as-list-ignoring-swank-calls)))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum)))
+ (subseq (backtrace-as-list-ignoring-swank-calls) start end)))
+
+(defimplementation print-frame (frame stream)
+ (write-string (string-trim '(#\space #\newline)
+ (prin1-to-string frame))
+ stream))
+
+(defimplementation frame-locals (index)
+ `(,(list :name "??" :id 0 :value "??")))
+
+
+(defimplementation frame-catch-tags (index)
+ (declare (ignore index))
+ nil)
+
+#+nil
+(defimplementation disassemble-frame (index)
+ (disassemble (debugger:frame-function (nth-frame index))))
+
+(defimplementation frame-source-location-for-emacs (index)
+ (list :error (format nil "Cannot find source for frame: ~A"
+ (nth-frame index))))
+
+#+nil
+(defimplementation eval-in-frame (form frame-number)
+ (debugger:eval-form-in-context
+ form
+ (debugger:environment-of-frame (nth-frame frame-number))))
+
+#+nil
+(defimplementation return-from-frame (frame-number form)
+ (let ((frame (nth-frame frame-number)))
+ (multiple-value-call #'debugger:frame-return
+ frame (debugger:eval-form-in-context
+ form
+ (debugger:environment-of-frame frame)))))
+
+;;; XXX doesn't work for frames with arguments
+#+nil
+(defimplementation restart-frame (frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (debugger:frame-retry frame (debugger:frame-function frame))))
+
+;;;; Compiler hooks
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename*)
+
+(in-package :swank-backend)
+
+(defun handle-compiler-warning (condition)
+ (let ((loc nil));(getf (slot-value condition 'excl::plist) :loc)))
+ (unless (member condition *abcl-signaled-conditions*) ; filter condition signaled more than once.
+ (push condition *abcl-signaled-conditions*)
+ (signal (make-condition
+ 'compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (format nil "~A" condition)
+ :location (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :position *buffer-start-position*)))
+ (loc
+ (destructuring-bind (file . pos) loc
+ (make-location
+ (list :file (namestring (truename file)))
+ (list :position (1+ pos)))))
+ (t
+ (make-location
+ (list :file *compile-filename*)
+ (list :position 1)))))))))
+
+(defvar *abcl-signaled-conditions*)
+
+(defimplementation swank-compile-file (filename load-p external-format)
+ (declare (ignore external-format))
+ (let ((jvm::*resignal-compiler-warnings* t)
+ (*abcl-signaled-conditions* nil))
+ (handler-bind ((warning #'handle-compiler-warning))
+ (let ((*buffer-name* nil)
+ (*compile-filename* filename))
+ (multiple-value-bind (fn warn fail) (compile-file filename)
+ (when (and load-p (not fail))
+ (load fn)))))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ (declare (ignore directory))
+ (let ((jvm::*resignal-compiler-warnings* t)
+ (*abcl-signaled-conditions* nil))
+ (handler-bind ((warning #'handle-compiler-warning))
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-string* string))
+ (funcall (compile nil (read-from-string
+ (format nil "(~S () ~A)" 'lambda string))))))))
+
+#|
+;;;; Definition Finding
+
+(defun find-fspec-location (fspec type)
+ (let ((file (excl::fspec-pathname fspec type)))
+ (etypecase file
+ (pathname
+ (let ((start (scm:find-definition-in-file fspec type file)))
+ (make-location (list :file (namestring (truename file)))
+ (if start
+ (list :position (1+ start))
+ (list :function-name (string fspec))))))
+ ((member :top-level)
+ (list :error (format nil "Defined at toplevel: ~A" fspec)))
+ (null
+ (list :error (format nil "Unkown source location for ~A" fspec))))))
+
+(defun fspec-definition-locations (fspec)
+ (let ((defs (excl::find-multiple-definitions fspec)))
+ (loop for (fspec type) in defs
+ collect (list fspec (find-fspec-location fspec type)))))
+
+(defimplementation find-definitions (symbol)
+ (fspec-definition-locations symbol))
+
+|#
+
+(defun source-location (symbol)
+ (when (pathnamep (ext:source-pathname symbol))
+ `(((,symbol)
+ (:location
+ (:file ,(namestring (ext:source-pathname symbol)))
+ (:position ,(or (ext:source-file-position symbol) 0) t)
+ (:snippet nil))))))
+
+
+(defimplementation find-definitions (symbol)
+ (source-location symbol))
+
+#|
+Uncomment this if you have patched xref.lisp, as in
+http://article.gmane.org/gmane.lisp.slime.devel/2425
+Also, make sure that xref.lisp is loaded by modifying the armedbear
+part of *sysdep-pathnames* in swank.loader.lisp.
+
+;;;; XREF
+(setq pxref:*handle-package-forms* '(cl:in-package))
+
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function name))))
+
+(defxref who-calls pxref:list-callers)
+(defxref who-references pxref:list-readers)
+(defxref who-binds pxref:list-setters)
+(defxref who-sets pxref:list-setters)
+(defxref list-callers pxref:list-callers)
+(defxref list-callees pxref:list-callees)
+
+(defun xref-results (symbols)
+ (let ((xrefs '()))
+ (dolist (symbol symbols)
+ (push (list symbol (cadar (source-location symbol))) xrefs))
+ xrefs))
+|#
+
+;;;; Inspecting
+
+(defclass abcl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+ (make-instance 'abcl-inspector))
+
+(defmethod inspect-for-emacs ((slot mop::slot-definition)
+ (inspector backend-inspector))
+ (declare (ignore inspector))
+ (values "A slot."
+ `("Name: " (:value ,(mop::%slot-definition-name slot))
+ (:newline)
+ "Documentation:" (:newline)
+ ,@(when (slot-definition-documentation slot)
+ `((:value ,(slot-definition-documentation slot)) (:newline)))
+ "Initialization:" (:newline)
+ " Args: " (:value ,(mop::%slot-definition-initargs slot)) (:newline)
+ " Form: " ,(if (mop::%slot-definition-initfunction slot)
+ `(:value ,(mop::%slot-definition-initform slot))
+ "#<unspecified>") (:newline)
+ " Function: " (:value ,(mop::%slot-definition-initfunction slot))
+ (:newline))))
+
+(defmethod inspect-for-emacs ((f function) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (values "A function."
+ `(,@(when (function-name f)
+ `("Name: "
+ ,(princ-to-string (function-name f)) (:newline)))
+ ,@(multiple-value-bind (args present)
+ (sys::arglist f)
+ (when present `("Argument list: " ,(princ-to-string args) (:newline))))
+ (:newline)
+ #+nil,@(when (documentation f t)
+ `("Documentation:" (:newline) ,(documentation f t) (:newline)))
+ ,@(when (function-lambda-expression f)
+ `("Lambda expression:"
+ (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline))))))
+
+#|
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+ (let* ((class (class-of o))
+ (slots (mop::class-slots class)))
+ (values (format nil "~A~% is a ~A" o class)
+ (mapcar (lambda (slot)
+ (let ((name (mop::slot-definition-name slot)))
+ (cons (princ-to-string name)
+ (slot-value o name))))
+ slots))))
+|#
+
+;;;; Multithreading
+
+(defimplementation startup-multiprocessing ()
+ #+nil(mp:start-scheduler))
+
+(defimplementation spawn (fn &key name)
+ (ext:make-thread (lambda () (funcall fn)) :name name))
+
+(defvar *thread-props-lock* (ext:make-thread-lock))
+
+(defvar *thread-props* (make-hash-table) ; should be a weak table
+ "A hashtable mapping threads to a plist.")
+
+(defvar *thread-id-counter* 0)
+
+(defimplementation thread-id (thread)
+ (ext:with-thread-lock (*thread-props-lock*)
+ (or (getf (gethash thread *thread-props*) 'id)
+ (setf (getf (gethash thread *thread-props*) 'id)
+ (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+ (find id (all-threads)
+ :key (lambda (thread)
+ (getf (gethash thread *thread-props*) 'id))))
+
+(defimplementation thread-name (thread)
+ (ext:thread-name thread))
+
+(defimplementation thread-status (thread)
+ (format nil "Thread is ~:[dead~;alive~]" (ext:thread-alive-p thread)))
+
+(defimplementation make-lock (&key name)
+ (ext:make-thread-lock))
+
+(defimplementation call-with-lock-held (lock function)
+ (ext:with-thread-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+ (ext:current-thread))
+
+(defimplementation all-threads ()
+ (copy-list (ext:mapcar-threads #'identity)))
+
+(defimplementation interrupt-thread (thread fn)
+ (ext:interrupt-thread thread fn))
+
+(defimplementation kill-thread (thread)
+ (ext:destroy-thread thread))
+
+(defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (ext:with-thread-lock (*thread-props-lock*)
+ (or (getf (gethash thread *thread-props*) 'mailbox)
+ (setf (getf (gethash thread *thread-props*) 'mailbox)
+ (ext:make-mailbox)))))
+
+(defimplementation send (thread object)
+ (ext:mailbox-send (mailbox thread) object))
+
+(defimplementation receive ()
+ (ext:mailbox-read (mailbox (ext:current-thread))))
+
+;;; Auto-flush streams
+
+;; XXX race conditions
+(defvar *auto-flush-streams* '())
+
+(defvar *auto-flush-thread* nil)
+
+(defimplementation make-stream-interactive (stream)
+ (setq *auto-flush-streams* (adjoin stream *auto-flush-streams*))
+ (unless *auto-flush-thread*
+ (setq *auto-flush-thread*
+ (ext:make-thread #'flush-streams
+ :name "auto-flush-thread"))))
+
+(defun flush-streams ()
+ (loop
+ (setq *auto-flush-streams*
+ (remove-if (lambda (x)
+ (not (and (open-stream-p x)
+ (output-stream-p x))))
+ *auto-flush-streams*))
+ (mapc #'finish-output *auto-flush-streams*)
+ (sleep 0.15)))
+
+(defimplementation quit-lisp ()
+ (ext:exit))
+
+;; WORKAROUND: call/initialize accessors at load time
+(let ((c (make-condition 'compiler-condition
+ :original-condition nil
+ :severity ':note :message "" :location nil))
+ (slots `(severity message short-message references location)))
+ (dolist (slot slots)
+ (funcall slot c)))
Added: branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,774 @@
+;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;* "; -*-
+;;;
+;;; swank-allegro.lisp --- Allegro CL specific code for SLIME.
+;;;
+;;; Created 2003
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require :sock)
+ (require :process))
+
+(import-from :excl *gray-stream-symbols* :swank-backend)
+
+;;; swank-mop
+
+(import-swank-mop-symbols :clos '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot t))
+
+
+;;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+(defimplementation create-socket (host port)
+ (socket:make-socket :connect :passive :local-port port
+ :local-host host :reuse-address t))
+
+(defimplementation local-port (socket)
+ (socket:local-port socket))
+
+(defimplementation close-socket (socket)
+ (close socket))
+
+(defimplementation accept-connection (socket &key external-format buffering
+ timeout)
+ (declare (ignore buffering timeout))
+ (let ((s (socket:accept-connection socket :wait t)))
+ (when external-format
+ (setf (stream-external-format s) external-format))
+ s))
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")
+ (:euc-jp "euc-jp" "euc-jp-unix")
+ (:us-ascii "us-ascii" "us-ascii-unix")
+ (:emacs-mule "emacs-mule" "emacs-mule-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (let ((e (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+ (and e (excl:crlf-base-ef
+ (excl:find-external-format (car e)
+ :try-variant t)))))
+
+(defimplementation format-sldb-condition (c)
+ (princ-to-string c))
+
+(defimplementation call-with-syntax-hooks (fn)
+ (funcall fn))
+
+;;;; Unix signals
+
+(defimplementation call-without-interrupts (fn)
+ (excl:without-interrupts (funcall fn)))
+
+(defimplementation getpid ()
+ (excl::getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "allegro")
+
+(defimplementation set-default-directory (directory)
+ (let* ((dir (namestring (truename (merge-pathnames directory)))))
+ (setf *default-pathname-defaults* (pathname (excl:chdir dir)))
+ dir))
+
+(defimplementation default-directory ()
+ (namestring (excl:current-directory)))
+
+;;;; Misc
+
+(defimplementation arglist (symbol)
+ (handler-case (excl:arglist symbol)
+ (simple-error () :not-available)))
+
+(defimplementation macroexpand-all (form)
+ (excl::walk form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind &optional (sym symbol))
+ (or (documentation sym kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (maybe-push
+ :function (if (fboundp symbol)
+ (doc 'function)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:class
+ (describe (find-class symbol)))))
+
+(defimplementation make-stream-interactive (stream)
+ (setf (interactive-stream-p stream) t))
+
+;;;; Debugger
+
+(defvar *sldb-topframe*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let ((*sldb-topframe* (find-topframe))
+ (excl::*break-hook* nil))
+ (funcall debugger-loop-fn)))
+
+(defimplementation sldb-break-at-start (fname)
+ ;; :print-before is kind of mis-used but we just want to stuff our break form
+ ;; somewhere. This does not work for setf, :before and :after methods, which
+ ;; need special syntax in the trace call, see ACL's doc/debugging.htm chapter 10.
+ (eval `(trace (,fname
+ :print-before
+ ((break "Function start breakpoint of ~A" ',fname)))))
+ `(:ok ,(format nil "Set breakpoint at start of ~S" fname)))
+
+(defun find-topframe ()
+ (let ((skip-frames 3))
+ (do ((f (excl::int-newest-frame) (next-frame f))
+ (i 0 (1+ i)))
+ ((= i skip-frames) f))))
+
+(defun next-frame (frame)
+ (let ((next (excl::int-next-older-frame frame)))
+ (cond ((not next) nil)
+ ((debugger:frame-visible-p next) next)
+ (t (next-frame next)))))
+
+(defun nth-frame (index)
+ (do ((frame *sldb-topframe* (next-frame frame))
+ (i index (1- i)))
+ ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum)))
+ (loop for f = (nth-frame start) then (next-frame f)
+ for i from start below end
+ while f
+ collect f)))
+
+(defimplementation print-frame (frame stream)
+ (debugger:output-frame stream frame :moderate))
+
+(defimplementation frame-locals (index)
+ (let ((frame (nth-frame index)))
+ (loop for i from 0 below (debugger:frame-number-vars frame)
+ collect (list :name (debugger:frame-var-name frame i)
+ :id 0
+ :value (debugger:frame-var-value frame i)))))
+
+(defimplementation frame-var-value (frame var)
+ (let ((frame (nth-frame frame)))
+ (debugger:frame-var-value frame var)))
+
+(defimplementation frame-catch-tags (index)
+ (declare (ignore index))
+ nil)
+
+(defimplementation disassemble-frame (index)
+ (disassemble (debugger:frame-function (nth-frame index))))
+
+(defimplementation frame-source-location-for-emacs (index)
+ (let* ((frame (nth-frame index))
+ (expr (debugger:frame-expression frame))
+ (fspec (first expr)))
+ (second (first (fspec-definition-locations fspec)))))
+
+(defimplementation eval-in-frame (form frame-number)
+ (let ((frame (nth-frame frame-number)))
+ ;; let-bind lexical variables
+ (let ((vars (loop for i below (debugger:frame-number-vars frame)
+ for name = (debugger:frame-var-name frame i)
+ if (symbolp name)
+ collect `(,name ',(debugger:frame-var-value frame i)))))
+ (debugger:eval-form-in-context
+ `(let* ,vars ,form)
+ (debugger:environment-of-frame frame)))))
+
+(defimplementation return-from-frame (frame-number form)
+ (let ((frame (nth-frame frame-number)))
+ (multiple-value-call #'debugger:frame-return
+ frame (debugger:eval-form-in-context
+ form
+ (debugger:environment-of-frame frame)))))
+
+(defimplementation restart-frame (frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (cond ((debugger:frame-retryable-p frame)
+ (apply #'debugger:frame-retry frame (debugger:frame-function frame)
+ (cdr (debugger:frame-expression frame))))
+ (t "Frame is not retryable"))))
+
+;;;; Compiler hooks
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename* nil)
+
+(defun compiler-note-p (object)
+ (member (type-of object) '(excl::compiler-note compiler::compiler-note)))
+
+(defun compiler-undefined-functions-called-warning-p (object)
+ (typep object 'excl:compiler-undefined-functions-called-warning))
+
+(deftype compiler-note ()
+ `(satisfies compiler-note-p))
+
+(defun signal-compiler-condition (&rest args)
+ (signal (apply #'make-condition 'compiler-condition args)))
+
+(defun handle-compiler-warning (condition)
+ (declare (optimize (debug 3) (speed 0) (space 0)))
+ (cond ((and (not *buffer-name*)
+ (compiler-undefined-functions-called-warning-p condition))
+ (handle-undefined-functions-warning condition))
+ (t
+ (signal-compiler-condition
+ :original-condition condition
+ :severity (etypecase condition
+ (warning :warning)
+ (compiler-note :note))
+ :message (format nil "~A" condition)
+ :location (location-for-warning condition)))))
+
+(defun location-for-warning (condition)
+ (let ((loc (getf (slot-value condition 'excl::plist) :loc)))
+ (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :position *buffer-start-position*)))
+ (loc
+ (destructuring-bind (file . pos) loc
+ (make-location
+ (list :file (namestring (truename file)))
+ (list :position (1+ pos)))))
+ (t
+ (list :error "No error location available.")))))
+
+(defun handle-undefined-functions-warning (condition)
+ (let ((fargs (slot-value condition 'excl::format-arguments)))
+ (loop for (fname . pos-file) in (car fargs) do
+ (loop for (pos file) in pos-file do
+ (signal-compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (format nil "Undefined function referenced: ~S"
+ fname)
+ :location (make-location (list :file file)
+ (list :position (1+ pos))))))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (handler-bind ((warning #'handle-compiler-warning)
+ ;;(compiler-note #'handle-compiler-warning)
+ )
+ (funcall function)))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil)
+ (*compile-filename* filename))
+ (compile-file *compile-filename* :load-after-compile load-p
+ :external-format external-format))))
+
+(defun call-with-temp-file (fn)
+ (let ((tmpname (system:make-temp-file-name)))
+ (unwind-protect
+ (with-open-file (file tmpname :direction :output :if-exists :error)
+ (funcall fn file tmpname))
+ (delete-file tmpname))))
+
+(defun compile-from-temp-file (string)
+ (call-with-temp-file
+ (lambda (stream filename)
+ (write-string string stream)
+ (finish-output stream)
+ (let ((binary-filename
+ (excl:without-redefinition-warnings
+ ;; Suppress Allegro's redefinition warnings; they are
+ ;; pointless when we are compiling via a temporary
+ ;; file.
+ (compile-file filename :load-after-compile t))))
+ (when binary-filename
+ (delete-file binary-filename))))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ ;; We store the source buffer in excl::*source-pathname* as a string
+ ;; of the form <buffername>;<start-offset>. Quite ugly encoding, but
+ ;; the fasl file is corrupted if we use some other datatype.
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-string* string)
+ (*default-pathname-defaults*
+ (if directory (merge-pathnames (pathname directory))
+ *default-pathname-defaults*)))
+ (compile-from-temp-file
+ (format nil "~S ~S~%~A"
+ `(in-package ,(package-name *package*))
+ `(eval-when (:compile-toplevel :load-toplevel)
+ (setq excl::*source-pathname*
+ ',(format nil "~A;~D" buffer position)))
+ string)))))
+
+;;;; Definition Finding
+
+(defun fspec-primary-name (fspec)
+ (etypecase fspec
+ (symbol fspec)
+ (list (fspec-primary-name (second fspec)))))
+
+;; If Emacs uses DOS-style eol conventions, \n\r are considered as a
+;; single character, but file-position counts them as two. Here we do
+;; our own conversion.
+(defun count-cr (file pos)
+ (let* ((bufsize 256)
+ (type '(unsigned-byte 8))
+ (buf (make-array bufsize :element-type type))
+ (cr-count 0))
+ (with-open-file (stream file :direction :input :element-type type)
+ (loop for bytes-read = (read-sequence buf stream) do
+ (incf cr-count (count (char-code #\return) buf
+ :end (min pos bytes-read)))
+ (decf pos bytes-read)
+ (when (<= pos 0)
+ (return cr-count))))))
+
+(defun find-definition-in-file (fspec type file top-level)
+ (let* ((part
+ (or (scm::find-definition-in-definition-group
+ fspec type (scm:section-file :file file)
+ :top-level top-level)
+ (scm::find-definition-in-definition-group
+ (fspec-primary-name fspec)
+ type (scm:section-file :file file)
+ :top-level top-level)))
+ (start (and part
+ (scm::source-part-start part)))
+ (pos (if start
+ (list :position (1+ (- start (count-cr file start))))
+ (list :function-name (string (fspec-primary-name fspec))))))
+ (make-location (list :file (namestring (truename file)))
+ pos)))
+
+(defun find-definition-in-buffer (filename)
+ (let ((pos (position #\; filename :from-end t)))
+ (make-location
+ (list :buffer (subseq filename 0 pos))
+ (list :position (parse-integer (subseq filename (1+ pos)))))))
+
+(defun find-fspec-location (fspec type file top-level)
+ (etypecase file
+ (pathname
+ (find-definition-in-file fspec type file top-level))
+ ((member :top-level)
+ (list :error (format nil "Defined at toplevel: ~A"
+ (fspec->string fspec))))
+ (string
+ (find-definition-in-buffer file))))
+
+(defun fspec->string (fspec)
+ (etypecase fspec
+ (symbol (let ((*package* (find-package :keyword)))
+ (prin1-to-string fspec)))
+ (list (format nil "(~A ~A)"
+ (prin1-to-string (first fspec))
+ (let ((*package* (find-package :keyword)))
+ (prin1-to-string (second fspec)))))))
+
+(defun fspec-definition-locations (fspec)
+ (cond
+ ((and (listp fspec)
+ (eql (car fspec) :top-level-form))
+ (destructuring-bind (top-level-form file &optional position) fspec
+ (list
+ (list (list nil fspec)
+ (make-location (list :buffer file)
+ (list :position position t))))))
+ ((and (listp fspec) (eq (car fspec) :internal))
+ (destructuring-bind (_internal next _n) fspec
+ (fspec-definition-locations next)))
+ (t
+ (let ((defs (excl::find-source-file fspec)))
+ (if (null defs)
+ (list
+ (list (list nil fspec)
+ (list :error
+ (format nil "Unknown source location for ~A"
+ (fspec->string fspec)))))
+ (loop for (fspec type file top-level) in defs
+ collect (list (list type fspec)
+ (find-fspec-location fspec type file top-level))))))))
+
+(defimplementation find-definitions (symbol)
+ (fspec-definition-locations symbol))
+
+;;;; XREF
+
+(defmacro defxref (name relation name1 name2)
+ `(defimplementation ,name (x)
+ (xref-result (xref:get-relation ,relation ,name1 ,name2))))
+
+(defxref who-calls :calls :wild x)
+(defxref calls-who :calls x :wild)
+(defxref who-references :uses :wild x)
+(defxref who-binds :binds :wild x)
+(defxref who-macroexpands :macro-calls :wild x)
+(defxref who-sets :sets :wild x)
+
+(defun xref-result (fspecs)
+ (loop for fspec in fspecs
+ append (fspec-definition-locations fspec)))
+
+;; list-callers implemented by groveling through all fbound symbols.
+;; Only symbols are considered. Functions in the constant pool are
+;; searched recursively. Closure environments are ignored at the
+;; moment (constants in methods are therefore not found).
+
+(defun map-function-constants (function fn depth)
+ "Call FN with the elements of FUNCTION's constant pool."
+ (do ((i 0 (1+ i))
+ (max (excl::function-constant-count function)))
+ ((= i max))
+ (let ((c (excl::function-constant function i)))
+ (cond ((and (functionp c)
+ (not (eq c function))
+ (plusp depth))
+ (map-function-constants c fn (1- depth)))
+ (t
+ (funcall fn c))))))
+
+(defun in-constants-p (fun symbol)
+ (map-function-constants fun
+ (lambda (c)
+ (when (eq c symbol)
+ (return-from in-constants-p t)))
+ 3))
+
+(defun function-callers (name)
+ (let ((callers '()))
+ (do-all-symbols (sym)
+ (when (fboundp sym)
+ (let ((fn (fdefinition sym)))
+ (when (in-constants-p fn name)
+ (push sym callers)))))
+ callers))
+
+(defimplementation list-callers (name)
+ (xref-result (function-callers name)))
+
+(defimplementation list-callees (name)
+ (let ((result '()))
+ (map-function-constants (fdefinition name)
+ (lambda (c)
+ (when (fboundp c)
+ (push c result)))
+ 2)
+ (xref-result result)))
+
+;;;; Profiling
+
+;; Per-function profiling based on description in
+;; http://www.franz.com/support/documentation/8.0/doc/runtime-analyzer.htm#dat…
+
+(defvar *profiled-functions* ())
+(defvar *profile-depth* 0)
+
+(defmacro with-redirected-y-or-n-p (&body body)
+ ;; If the profiler is restarted when the data from the previous
+ ;; session is not reported yet, the user is warned via Y-OR-N-P.
+ ;; As the CL:Y-OR-N-P question is (for some reason) not directly
+ ;; sent to the Slime user, the function CL:Y-OR-N-P is temporarily
+ ;; overruled.
+ `(let* ((pkg (find-package "common-lisp"))
+ (saved-pdl (excl::package-definition-lock pkg))
+ (saved-ynp (symbol-function 'cl:y-or-n-p)))
+
+ (setf (excl::package-definition-lock pkg) nil
+ (symbol-function 'cl:y-or-n-p) (symbol-function
+ (find-symbol "y-or-n-p-in-emacs"
+ "swank")))
+ (unwind-protect
+ (progn ,@body)
+
+ (setf (symbol-function 'cl:y-or-n-p) saved-ynp
+ (excl::package-definition-lock pkg) saved-pdl))))
+
+(defun start-acl-profiler ()
+ (with-redirected-y-or-n-p
+ (prof:start-profiler :type :time :count t
+ :start-sampling-p nil :verbose nil)))
+(defun acl-profiler-active-p ()
+ (not (eq (prof:profiler-status :verbose nil) :inactive)))
+
+(defun stop-acl-profiler ()
+ (prof:stop-profiler :verbose nil))
+
+(excl:def-fwrapper profile-fwrapper (&rest args)
+ ;; Ensures sampling is done during the execution of the function,
+ ;; taking into account recursion.
+ (declare (ignore args))
+ (cond ((zerop *profile-depth*)
+ (let ((*profile-depth* (1+ *profile-depth*)))
+ (prof:start-sampling)
+ (unwind-protect (excl:call-next-fwrapper)
+ (prof:stop-sampling))))
+ (t
+ (excl:call-next-fwrapper))))
+
+(defimplementation profile (fname)
+ (unless (acl-profiler-active-p)
+ (start-acl-profiler))
+ (excl:fwrap fname 'profile-fwrapper 'profile-fwrapper)
+ (push fname *profiled-functions*))
+
+(defimplementation profiled-functions ()
+ *profiled-functions*)
+
+(defimplementation unprofile (fname)
+ (excl:funwrap fname 'profile-fwrapper)
+ (setq *profiled-functions* (remove fname *profiled-functions*)))
+
+(defimplementation profile-report ()
+ (prof:show-flat-profile :verbose nil)
+ (when *profiled-functions*
+ (start-acl-profiler)))
+
+(defimplementation profile-reset ()
+ (when (acl-profiler-active-p)
+ (stop-acl-profiler)
+ (start-acl-profiler))
+ "Reset profiling counters.")
+
+;;;; Inspecting
+
+(defclass acl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+ (make-instance 'acl-inspector))
+
+(defmethod inspect-for-emacs ((f function) inspector)
+ inspector
+ (values "A function."
+ (append
+ (label-value-line "Name" (function-name f))
+ `("Formals" ,(princ-to-string (arglist f)) (:newline))
+ (let ((doc (documentation (excl::external-fn_symdef f) 'function)))
+ (when doc
+ `("Documentation:" (:newline) ,doc))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+ inspector
+ (values "A value." (allegro-inspect o)))
+
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
+ inspector
+ (values "A function." (allegro-inspect o)))
+
+(defmethod inspect-for-emacs ((o standard-object)
+ (inspector backend-inspector))
+ inspector
+ (values (format nil "~A is a standard-object." o) (allegro-inspect o)))
+
+(defun allegro-inspect (o)
+ (loop for (d dd) on (inspect::inspect-ctl o)
+ append (frob-allegro-field-def o d)
+ until (eq d dd)))
+
+(defun frob-allegro-field-def (object def)
+ (with-struct (inspect::field-def- name type access) def
+ (ecase type
+ ((:unsigned-word :unsigned-byte :unsigned-natural
+ :unsigned-long :unsigned-half-long
+ :unsigned-3byte)
+ (label-value-line name (inspect::component-ref-v object access type)))
+ ((:lisp :value)
+ (label-value-line name (inspect::component-ref object access)))
+ (:indirect
+ (destructuring-bind (prefix count ref set) access
+ (declare (ignore set prefix))
+ (loop for i below (funcall count object)
+ append (label-value-line (format nil "~A-~D" name i)
+ (funcall ref object i))))))))
+
+;;;; Multithreading
+
+(defimplementation initialize-multiprocessing (continuation)
+ (mp:start-scheduler)
+ (funcall continuation))
+
+(defimplementation spawn (fn &key name)
+ (mp:process-run-function name fn))
+
+(defvar *id-lock* (mp:make-process-lock :name "id lock"))
+(defvar *thread-id-counter* 0)
+
+(defimplementation thread-id (thread)
+ (mp:with-process-lock (*id-lock*)
+ (or (getf (mp:process-property-list thread) 'id)
+ (setf (getf (mp:process-property-list thread) 'id)
+ (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+ (find id mp:*all-processes*
+ :key (lambda (p) (getf (mp:process-property-list p) 'id))))
+
+(defimplementation thread-name (thread)
+ (mp:process-name thread))
+
+(defimplementation thread-status (thread)
+ (format nil "~A ~D" (mp:process-whostate thread)
+ (mp:process-priority thread)))
+
+(defimplementation make-lock (&key name)
+ (mp:make-process-lock :name name))
+
+(defimplementation call-with-lock-held (lock function)
+ (mp:with-process-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+ mp:*current-process*)
+
+(defimplementation all-threads ()
+ (copy-list mp:*all-processes*))
+
+(defimplementation interrupt-thread (thread fn)
+ (mp:process-interrupt thread fn))
+
+(defimplementation kill-thread (thread)
+ (mp:process-kill thread))
+
+(defvar *mailbox-lock* (mp:make-process-lock :name "mailbox lock"))
+
+(defstruct (mailbox (:conc-name mailbox.))
+ (mutex (mp:make-process-lock :name "process mailbox"))
+ (queue '() :type list))
+
+(defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (mp:with-process-lock (*mailbox-lock*)
+ (or (getf (mp:process-property-list thread) 'mailbox)
+ (setf (getf (mp:process-property-list thread) 'mailbox)
+ (make-mailbox)))))
+
+(defimplementation send (thread message)
+ (let* ((mbox (mailbox thread))
+ (mutex (mailbox.mutex mbox)))
+ (mp:process-wait-with-timeout
+ "yielding before sending" 0.1
+ (lambda ()
+ (mp:with-process-lock (mutex)
+ (< (length (mailbox.queue mbox)) 10))))
+ (mp:with-process-lock (mutex)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message))))))
+
+(defimplementation receive ()
+ (let* ((mbox (mailbox mp:*current-process*))
+ (mutex (mailbox.mutex mbox)))
+ (mp:process-wait "receive" #'mailbox.queue mbox)
+ (mp:with-process-lock (mutex)
+ (pop (mailbox.queue mbox)))))
+
+(defimplementation quit-lisp ()
+ (excl:exit 0 :quiet t))
+
+
+;;Trace implementations
+;;In Allegro 7.0, we have:
+;; (trace <name>)
+;; (trace ((method <name> <qualifier>? (<specializer>+))))
+;; (trace ((labels <name> <label-name>)))
+;; (trace ((labels (method <name> (<specializer>+)) <label-name>)))
+;; <name> can be a normal name or a (setf name)
+
+(defimplementation toggle-trace (spec)
+ (ecase (car spec)
+ ((setf)
+ (toggle-trace-aux spec))
+ (:defgeneric (toggle-trace-generic-function-methods (second spec)))
+ ((setf :defmethod :labels :flet)
+ (toggle-trace-aux (process-fspec-for-allegro spec)))
+ (:call
+ (destructuring-bind (caller callee) (cdr spec)
+ (toggle-trace-aux callee
+ :inside (list (process-fspec-for-allegro caller)))))))
+
+(defun tracedp (fspec)
+ (member fspec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (fspec &rest args)
+ (cond ((tracedp fspec)
+ (eval `(untrace ,fspec))
+ (format nil "~S is now untraced." fspec))
+ (t
+ (eval `(trace (,fspec ,@args)))
+ (format nil "~S is now traced." fspec))))
+
+(defun toggle-trace-generic-function-methods (name)
+ (let ((methods (mop:generic-function-methods (fdefinition name))))
+ (cond ((tracedp name)
+ (eval `(untrace ,name))
+ (dolist (method methods (format nil "~S is now untraced." name))
+ (excl:funtrace (mop:method-function method))))
+ (t
+ (eval `(trace (,name)))
+ (dolist (method methods (format nil "~S is now traced." name))
+ (excl:ftrace (mop:method-function method)))))))
+
+(defun process-fspec-for-allegro (fspec)
+ (cond ((consp fspec)
+ (ecase (first fspec)
+ ((setf) fspec)
+ ((:defun :defgeneric) (second fspec))
+ ((:defmethod) `(method ,@(rest fspec)))
+ ((:labels) `(labels ,(process-fspec-for-allegro (second fspec))
+ ,(third fspec)))
+ ((:flet) `(flet ,(process-fspec-for-allegro (second fspec))
+ ,(third fspec)))))
+ (t
+ fspec)))
+
+
+;;;; Weak hashtables
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak-keys t args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ (apply #'make-hash-table :values :weak args))
+
+(defimplementation hash-table-weakness (hashtable)
+ (cond ((excl:hash-table-weak-keys hashtable) :key)
+ ((eq (excl:hash-table-values hashtable) :weak) :value)))
+
+
+
+;;;; Character names
+
+(defimplementation character-completion-set (prefix matchp)
+ (loop for name being the hash-keys of excl::*name-to-char-table*
+ when (funcall matchp prefix name)
+ collect (string-capitalize name)))
Added: branches/trunk-reorg/thirdparty/slime/swank-backend.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-backend.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-backend.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1077 @@
+;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
+;;;
+;;; slime-backend.lisp --- SLIME backend interface.
+;;;
+;;; Created by James Bielman in 2003. Released into the public domain.
+;;;
+;;;; Frontmatter
+;;;
+;;; This file defines the functions that must be implemented
+;;; separately for each Lisp. Each is declared as a generic function
+;;; for which swank-<implementation>.lisp provides methods.
+
+(defpackage :swank-backend
+ (:use :common-lisp)
+ (:export #:sldb-condition
+ #:original-condition
+ #:compiler-condition
+ #:message
+ #:short-message
+ #:condition
+ #:severity
+ #:with-compilation-hooks
+ #:location
+ #:location-p
+ #:location-buffer
+ #:location-position
+ #:position-p
+ #:position-pos
+ #:print-output-to-string
+ #:quit-lisp
+ #:references
+ #:unbound-slot-filler
+ #:declaration-arglist
+ #:type-specifier-arglist
+ ;; inspector related symbols
+ #:inspector
+ #:backend-inspector
+ #:inspect-for-emacs
+ #:raw-inspection
+ #:fancy-inspection
+ #:label-value-line
+ #:label-value-line*
+ #:with-struct
+ ))
+
+(defpackage :swank-mop
+ (:use)
+ (:export
+ ;; classes
+ #:standard-generic-function
+ #:standard-slot-definition
+ #:standard-method
+ #:standard-class
+ #:eql-specializer
+ #:eql-specializer-object
+ ;; standard-class readers
+ #:class-default-initargs
+ #:class-direct-default-initargs
+ #:class-direct-slots
+ #:class-direct-subclasses
+ #:class-direct-superclasses
+ #:class-finalized-p
+ #:class-name
+ #:class-precedence-list
+ #:class-prototype
+ #:class-slots
+ #:specializer-direct-methods
+ ;; generic function readers
+ #:generic-function-argument-precedence-order
+ #:generic-function-declarations
+ #:generic-function-lambda-list
+ #:generic-function-methods
+ #:generic-function-method-class
+ #:generic-function-method-combination
+ #:generic-function-name
+ ;; method readers
+ #:method-generic-function
+ #:method-function
+ #:method-lambda-list
+ #:method-specializers
+ #:method-qualifiers
+ ;; slot readers
+ #:slot-definition-allocation
+ #:slot-definition-documentation
+ #:slot-definition-initargs
+ #:slot-definition-initform
+ #:slot-definition-initfunction
+ #:slot-definition-name
+ #:slot-definition-type
+ #:slot-definition-readers
+ #:slot-definition-writers
+ #:slot-boundp-using-class
+ #:slot-value-using-class
+ #:slot-makunbound-using-class
+ ;; generic function protocol
+ #:compute-applicable-methods-using-classes
+ #:finalize-inheritance))
+
+(in-package :swank-backend)
+
+
+;;;; Metacode
+
+(defparameter *interface-functions* '()
+ "The names of all interface functions.")
+
+(defparameter *unimplemented-interfaces* '()
+ "List of interface functions that are not implemented.
+DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
+
+(defmacro definterface (name args documentation &rest default-body)
+ "Define an interface function for the backend to implement.
+A function is defined with NAME, ARGS, and DOCUMENTATION. This
+function first looks for a function to call in NAME's property list
+that is indicated by 'IMPLEMENTATION; failing that, it looks for a
+function indicated by 'DEFAULT. If neither is present, an error is
+signaled.
+
+If a DEFAULT-BODY is supplied, then a function with the same body and
+ARGS will be added to NAME's property list as the property indicated
+by 'DEFAULT.
+
+Backends implement these functions using DEFIMPLEMENTATION."
+ (check-type documentation string "a documentation string")
+ (assert (every #'symbolp args) ()
+ "Complex lambda-list not supported: ~S ~S" name args)
+ (labels ((gen-default-impl ()
+ `(setf (get ',name 'default) (lambda ,args ,@default-body)))
+ (args-as-list (args)
+ (destructuring-bind (req opt key rest) (parse-lambda-list args)
+ `(,@req ,@opt
+ ,@(loop for k in key append `(,(kw k) ,k))
+ ,@(or rest '(())))))
+ (parse-lambda-list (args)
+ (parse args '(&optional &key &rest)
+ (make-array 4 :initial-element nil)))
+ (parse (args keywords vars)
+ (cond ((null args)
+ (reverse (map 'list #'reverse vars)))
+ ((member (car args) keywords)
+ (parse (cdr args) (cdr (member (car args) keywords)) vars))
+ (t (push (car args) (aref vars (length keywords)))
+ (parse (cdr args) keywords vars))))
+ (kw (s) (intern (string s) :keyword)))
+ `(progn
+ (defun ,name ,args
+ ,documentation
+ (let ((f (or (get ',name 'implementation)
+ (get ',name 'default))))
+ (cond (f (apply f ,@(args-as-list args)))
+ (t (error "~S not implementated" ',name)))))
+ (pushnew ',name *interface-functions*)
+ ,(if (null default-body)
+ `(pushnew ',name *unimplemented-interfaces*)
+ (gen-default-impl))
+ ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler…>
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (export ',name :swank-backend))
+ ',name)))
+
+(defmacro defimplementation (name args &body body)
+ (assert (every #'symbolp args) ()
+ "Complex lambda-list not supported: ~S ~S" name args)
+ `(progn
+ (setf (get ',name 'implementation) (lambda ,args ,@body))
+ (if (member ',name *interface-functions*)
+ (setq *unimplemented-interfaces*
+ (remove ',name *unimplemented-interfaces*))
+ (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
+ ',name))
+
+(defun warn-unimplemented-interfaces ()
+ "Warn the user about unimplemented backend features.
+The portable code calls this function at startup."
+ (warn "These Swank interfaces are unimplemented:~% ~A"
+ (sort (copy-list *unimplemented-interfaces*) #'string<)))
+
+(defun import-to-swank-mop (symbol-list)
+ (dolist (sym symbol-list)
+ (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
+ (when swank-mop-sym
+ (unintern swank-mop-sym :swank-mop))
+ (import sym :swank-mop)
+ (export sym :swank-mop))))
+
+(defun import-swank-mop-symbols (package except)
+ "Import the mop symbols from PACKAGE to SWANK-MOP.
+EXCEPT is a list of symbol names which should be ignored."
+ (do-symbols (s :swank-mop)
+ (unless (member s except :test #'string=)
+ (let ((real-symbol (find-symbol (string s) package)))
+ (assert real-symbol () "Symbol ~A not found in package ~A" s package)
+ (unintern s :swank-mop)
+ (import real-symbol :swank-mop)
+ (export real-symbol :swank-mop)))))
+
+(defvar *gray-stream-symbols*
+ '(:fundamental-character-output-stream
+ :stream-write-char
+ :stream-fresh-line
+ :stream-force-output
+ :stream-finish-output
+ :fundamental-character-input-stream
+ :stream-read-char
+ :stream-listen
+ :stream-unread-char
+ :stream-clear-input
+ :stream-line-column
+ :stream-read-char-no-hang
+ ;; STREAM-LINE-LENGTH is an extension to gray streams that's apparently
+ ;; supported by CMUCL, OpenMCL, SBCL and SCL.
+ #+(or cmu openmcl sbcl scl)
+ :stream-line-length))
+
+(defun import-from (package symbol-names &optional (to-package *package*))
+ "Import the list of SYMBOL-NAMES found in the package PACKAGE."
+ (dolist (name symbol-names)
+ (multiple-value-bind (symbol found) (find-symbol (string name) package)
+ (assert found () "Symbol ~A not found in package ~A" name package)
+ (import symbol to-package))))
+
+
+;;;; Utilities
+
+(defmacro with-struct ((conc-name &rest names) obj &body body)
+ "Like with-slots but works only for structs."
+ (flet ((reader (slot) (intern (concatenate 'string
+ (symbol-name conc-name)
+ (symbol-name slot))
+ (symbol-package conc-name))))
+ (let ((tmp (gensym "OO-")))
+ ` (let ((,tmp ,obj))
+ (symbol-macrolet
+ ,(loop for name in names collect
+ (typecase name
+ (symbol `(,name (,(reader name) ,tmp)))
+ (cons `(,(first name) (,(reader (second name)) ,tmp)))
+ (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
+ ,@body)))))
+
+
+;;;; TCP server
+
+(definterface create-socket (host port)
+ "Create a listening TCP socket on interface HOST and port PORT .")
+
+(definterface local-port (socket)
+ "Return the local port number of SOCKET.")
+
+(definterface close-socket (socket)
+ "Close the socket SOCKET.")
+
+(definterface accept-connection (socket &key external-format
+ buffering timeout)
+ "Accept a client connection on the listening socket SOCKET.
+Return a stream for the new connection.")
+
+(definterface add-sigio-handler (socket fn)
+ "Call FN whenever SOCKET is readable.")
+
+(definterface remove-sigio-handlers (socket)
+ "Remove all sigio handlers for SOCKET.")
+
+(definterface add-fd-handler (socket fn)
+ "Call FN when Lisp is waiting for input and SOCKET is readable.")
+
+(definterface remove-fd-handlers (socket)
+ "Remove all fd-handlers for SOCKET.")
+
+(definterface preferred-communication-style ()
+ "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
+ nil)
+
+(definterface set-stream-timeout (stream timeout)
+ "Set the 'stream 'timeout. The timeout is either the real number
+ specifying the timeout in seconds or 'nil for no timeout."
+ (declare (ignore stream timeout))
+ nil)
+
+;;; Base condition for networking errors.
+(define-condition network-error (simple-error) ())
+
+(definterface emacs-connected ()
+ "Hook called when the first connection from Emacs is established.
+Called from the INIT-FN of the socket server that accepts the
+connection.
+
+This is intended for setting up extra context, e.g. to discover
+that the calling thread is the one that interacts with Emacs."
+ nil)
+
+
+;;;; Unix signals
+
+(defconstant +sigint+ 2)
+
+(definterface call-without-interrupts (fn)
+ "Call FN in a context where interrupts are disabled."
+ (funcall fn))
+
+(definterface getpid ()
+ "Return the (Unix) process ID of this superior Lisp.")
+
+(definterface lisp-implementation-type-name ()
+ "Return a short name for the Lisp implementation."
+ (lisp-implementation-type))
+
+(definterface default-directory ()
+ "Return the default directory."
+ (directory-namestring (truename *default-pathname-defaults*)))
+
+(definterface set-default-directory (directory)
+ "Set the default directory.
+This is used to resolve filenames without directory component."
+ (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
+ (default-directory))
+
+(definterface call-with-syntax-hooks (fn)
+ "Call FN with hooks to handle special syntax."
+ (funcall fn))
+
+(definterface default-readtable-alist ()
+ "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
+ '())
+
+(definterface quit-lisp ()
+ "Exit the current lisp image.")
+
+
+;;;; Compilation
+
+(definterface call-with-compilation-hooks (func)
+ "Call FUNC with hooks to record compiler conditions.")
+
+(defmacro with-compilation-hooks ((&rest ignore) &body body)
+ "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
+ (declare (ignore ignore))
+ `(call-with-compilation-hooks (lambda () (progn ,@body))))
+
+(definterface swank-compile-string (string &key buffer position directory)
+ "Compile source from STRING. During compilation, compiler
+conditions must be trapped and resignalled as COMPILER-CONDITIONs.
+
+If supplied, BUFFER and POSITION specify the source location in Emacs.
+
+Additionally, if POSITION is supplied, it must be added to source
+positions reported in compiler conditions.
+
+If DIRECTORY is specified it may be used by certain implementations to
+rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
+source information.")
+
+(definterface swank-compile-file (filename load-p external-format)
+ "Compile FILENAME signalling COMPILE-CONDITIONs.
+If LOAD-P is true, load the file after compilation.
+EXTERNAL-FORMAT is a value returned by find-external-format or
+:default.")
+
+(deftype severity ()
+ '(member :error :read-error :warning :style-warning :note))
+
+;; Base condition type for compiler errors, warnings and notes.
+(define-condition compiler-condition (condition)
+ ((original-condition
+ ;; The original condition thrown by the compiler if appropriate.
+ ;; May be NIL if a compiler does not report using conditions.
+ :type (or null condition)
+ :initarg :original-condition
+ :accessor original-condition)
+
+ (severity :type severity
+ :initarg :severity
+ :accessor severity)
+
+ (message :initarg :message
+ :accessor message)
+
+ (short-message :initarg :short-message
+ :initform nil
+ :accessor short-message)
+
+ (references :initarg :references
+ :initform nil
+ :accessor references)
+
+ (location :initarg :location
+ :accessor location)))
+
+(definterface find-external-format (coding-system)
+ "Return a \"external file format designator\" for CODING-SYSTEM.
+CODING-SYSTEM is Emacs-style coding system name (a string),
+e.g. \"latin-1-unix\"."
+ (if (equal coding-system "iso-latin-1-unix")
+ :default
+ nil))
+
+(definterface guess-external-format (filename)
+ "Detect the external format for the file with name FILENAME.
+Return nil if the file contains no special markers."
+ ;; Look for a Emacs-style -*- coding: ... -*- or Local Variable: section.
+ (with-open-file (s filename :if-does-not-exist nil
+ :external-format (or (find-external-format "latin-1-unix")
+ :default))
+ (if s
+ (or (let* ((line (read-line s nil))
+ (p (search "-*-" line)))
+ (when p
+ (let* ((start (+ p (length "-*-")))
+ (end (search "-*-" line :start2 start)))
+ (when end
+ (%search-coding line start end)))))
+ (let* ((len (file-length s))
+ (buf (make-string (min len 3000))))
+ (file-position s (- len (length buf)))
+ (read-sequence buf s)
+ (let ((start (search "Local Variables:" buf :from-end t))
+ (end (search "End:" buf :from-end t)))
+ (and start end (< start end)
+ (%search-coding buf start end))))))))
+
+(defun %search-coding (str start end)
+ (let ((p (search "coding:" str :start2 start :end2 end)))
+ (when p
+ (incf p (length "coding:"))
+ (loop while (and (< p end)
+ (member (aref str p) '(#\space #\tab)))
+ do (incf p))
+ (let ((end (position-if (lambda (c) (find c '(#\space #\tab #\newline)))
+ str :start p)))
+ (find-external-format (subseq str p end))))))
+
+
+;;;; Streams
+
+(definterface make-fn-streams (input-fn output-fn)
+ "Return character input and output streams backended by functions.
+When input is needed, INPUT-FN is called with no arguments to
+return a string.
+When output is ready, OUTPUT-FN is called with the output as its
+argument.
+
+Output should be forced to OUTPUT-FN before calling INPUT-FN.
+
+The streams are returned as two values.")
+
+(definterface make-stream-interactive (stream)
+ "Do any necessary setup to make STREAM work interactively.
+This is called for each stream used for interaction with the user
+\(e.g. *standard-output*). An implementation could setup some
+implementation-specific functions to control output flushing at the
+like."
+ (declare (ignore stream))
+ nil)
+
+
+;;;; Documentation
+
+(definterface arglist (name)
+ "Return the lambda list for the symbol NAME. NAME can also be
+a lisp function object, on lisps which support this.
+
+The result can be a list or the :not-available keyword if the
+arglist cannot be determined."
+ (declare (ignore name))
+ :not-available)
+
+(defgeneric declaration-arglist (decl-identifier)
+ (:documentation
+ "Return the argument list of the declaration specifier belonging to the
+declaration identifier DECL-IDENTIFIER. If the arglist cannot be determined,
+the keyword :NOT-AVAILABLE is returned.
+
+The different SWANK backends can specialize this generic function to
+include implementation-dependend declaration specifiers, or to provide
+additional information on the specifiers defined in ANSI Common Lisp.")
+ (:method (decl-identifier)
+ (case decl-identifier
+ (dynamic-extent '(&rest vars))
+ (ignore '(&rest vars))
+ (ignorable '(&rest vars))
+ (special '(&rest vars))
+ (inline '(&rest function-names))
+ (notinline '(&rest function-name))
+ (optimize '(&any compilation-speed debug safety space speed))
+ (type '(type-specifier &rest args))
+ (ftype '(type-specifier &rest function-names))
+ (otherwise
+ (flet ((typespec-p (symbol) (member :type (describe-symbol-for-emacs symbol))))
+ (cond ((and (symbolp decl-identifier) (typespec-p decl-identifier))
+ '(&rest vars))
+ ((and (listp decl-identifier) (typespec-p (first decl-identifier)))
+ '(&rest vars))
+ (t :not-available)))))))
+
+(defgeneric type-specifier-arglist (typespec-operator)
+ (:documentation
+ "Return the argument list of the type specifier belonging to
+TYPESPEC-OPERATOR.. If the arglist cannot be determined, the keyword
+:NOT-AVAILABLE is returned.
+
+The different SWANK backends can specialize this generic function to
+include implementation-dependend declaration specifiers, or to provide
+additional information on the specifiers defined in ANSI Common Lisp.")
+ (:method (typespec-operator)
+ (declare (special *type-specifier-arglists*)) ; defined at end of file.
+ (typecase typespec-operator
+ (symbol (or (cdr (assoc typespec-operator *type-specifier-arglists*))
+ :not-available))
+ (t :not-available))))
+
+(definterface function-name (function)
+ "Return the name of the function object FUNCTION.
+
+The result is either a symbol, a list, or NIL if no function name is available."
+ (declare (ignore function))
+ nil)
+
+(definterface macroexpand-all (form)
+ "Recursively expand all macros in FORM.
+Return the resulting form.")
+
+(definterface compiler-macroexpand-1 (form &optional env)
+ "Call the compiler-macro for form.
+If FORM is a function call for which a compiler-macro has been
+defined, invoke the expander function using *macroexpand-hook* and
+return the results and T. Otherwise, return the original form and
+NIL."
+ (let ((fun (and (consp form) (compiler-macro-function (car form)))))
+ (if fun
+ (let ((result (funcall *macroexpand-hook* fun form env)))
+ (values result (not (eq result form))))
+ (values form nil))))
+
+(definterface compiler-macroexpand (form &optional env)
+ "Repetitively call `compiler-macroexpand-1'."
+ (labels ((frob (form expanded)
+ (multiple-value-bind (new-form newly-expanded)
+ (compiler-macroexpand-1 form env)
+ (if newly-expanded
+ (frob new-form t)
+ (values new-form expanded)))))
+ (frob form env)))
+
+(definterface describe-symbol-for-emacs (symbol)
+ "Return a property list describing SYMBOL.
+
+The property list has an entry for each interesting aspect of the
+symbol. The recognised keys are:
+
+ :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
+ :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
+
+The value of each property is the corresponding documentation string,
+or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
+slime-print-apropos in Emacs must know about them).
+
+Properties should be included if and only if they are applicable to
+the symbol. For example, only (and all) fbound symbols should include
+the :FUNCTION property.
+
+Example:
+\(describe-symbol-for-emacs 'vector)
+ => (:CLASS :NOT-DOCUMENTED
+ :TYPE :NOT-DOCUMENTED
+ :FUNCTION \"Constructs a simple-vector from the given objects.\")")
+
+(definterface describe-definition (name type)
+ "Describe the definition NAME of TYPE.
+TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
+
+Return a documentation string, or NIL if none is available.")
+
+
+;;;; Debugging
+
+(definterface install-debugger-globally (function)
+ "Install FUNCTION as the debugger for all threads/processes. This
+usually involves setting *DEBUGGER-HOOK* and, if the implementation
+permits, hooking into BREAK as well."
+ (setq *debugger-hook* function))
+
+(definterface call-with-debugging-environment (debugger-loop-fn)
+ "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
+
+This function is called recursively at each debug level to invoke the
+debugger loop. The purpose is to setup any necessary environment for
+other debugger callbacks that will be called within the debugger loop.
+
+For example, this is a reasonable place to compute a backtrace, switch
+to safe reader/printer settings, and so on.")
+
+(definterface call-with-debugger-hook (hook fun)
+ "Call FUN and use HOOK as debugger hook.
+
+HOOK should be called for both BREAK and INVOKE-DEBUGGER."
+ (let ((*debugger-hook* hook))
+ (funcall fun)))
+
+(define-condition sldb-condition (condition)
+ ((original-condition
+ :initarg :original-condition
+ :accessor original-condition))
+ (:report (lambda (condition stream)
+ (format stream "Condition in debugger code~@[: ~A~]"
+ (original-condition condition))))
+ (:documentation
+ "Wrapper for conditions that should not be debugged.
+
+When a condition arises from the internals of the debugger, it is not
+desirable to debug it -- we'd risk entering an endless loop trying to
+debug the debugger! Instead, such conditions can be reported to the
+user without (re)entering the debugger by wrapping them as
+`sldb-condition's."))
+
+(definterface compute-backtrace (start end)
+ "Return a list containing a backtrace of the condition current
+being debugged. The results are unspecified if this function is
+called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.
+
+START and END are zero-based indices constraining the number of frames
+returned. Frame zero is defined as the frame which invoked the
+debugger. If END is nil, return the frames from START to the end of
+the stack.")
+
+(definterface compute-sane-restarts (condition)
+ "This is an opportunity for Lisps such as CLISP to remove
+unwanted restarts from the output of CL:COMPUTE-RESTARTS,
+otherwise it should simply call CL:COMPUTE-RESTARTS, which is
+what the default implementation does."
+ (compute-restarts condition))
+
+(definterface print-frame (frame stream)
+ "Print frame to stream.")
+
+(definterface frame-source-location-for-emacs (frame-number)
+ "Return the source location for FRAME-NUMBER.")
+
+(definterface frame-catch-tags (frame-number)
+ "Return a list of XXX list of what? catch tags for a debugger
+stack frame. The results are undefined unless this is called
+within the dynamic contour of a function defined by
+DEFINE-DEBUGGER-HOOK.")
+
+(definterface frame-locals (frame-number)
+ "Return a list of XXX local variable designators define me
+for a debugger stack frame. The results are undefined unless
+this is called within the dynamic contour of a function defined
+by DEFINE-DEBUGGER-HOOK.")
+
+(definterface frame-var-value (frame var)
+ "Return the value of VAR in FRAME.
+FRAME is the number of the frame in the backtrace.
+VAR is the number of the variable in the frame.")
+
+(definterface disassemble-frame (frame-number)
+ "Disassemble the code for the FRAME-NUMBER.
+The output should be written to standard output.
+FRAME-NUMBER is a non-negative integer.")
+
+(definterface eval-in-frame (form frame-number)
+ "Evaluate a Lisp form in the lexical context of a stack frame
+in the debugger. The results are undefined unless called in the
+dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
+
+FRAME-NUMBER must be a positive integer with 0 indicating the
+frame which invoked the debugger.
+
+The return value is the result of evaulating FORM in the
+appropriate context.")
+
+(definterface return-from-frame (frame-number form)
+ "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
+produced by evaluating FORM in the frame context to its caller.
+
+Execute any clean-up code from unwind-protect forms above the frame
+during unwinding.
+
+Return a string describing the error if it's not possible to return
+from the frame.")
+
+(definterface restart-frame (frame-number)
+ "Restart execution of the frame FRAME-NUMBER with the same arguments
+as it was called originally.")
+
+(definterface format-sldb-condition (condition)
+ "Format a condition for display in SLDB."
+ (princ-to-string condition))
+
+(definterface condition-extras (condition)
+ "Return a list of extra for the debugger.
+The allowed elements are of the form:
+ (:SHOW-FRAME-SOURCE frame-number)
+ (:REFERENCES &rest refs)
+"
+ (declare (ignore condition))
+ '())
+
+(definterface activate-stepping (frame-number)
+ "Prepare the frame FRAME-NUMBER for stepping.")
+
+(definterface sldb-break-on-return (frame-number)
+ "Set a breakpoint in the frame FRAME-NUMBER.")
+
+(definterface sldb-break-at-start (symbol)
+ "Set a breakpoint on the beginning of the function for SYMBOL.")
+
+(definterface sldb-stepper-condition-p (condition)
+ "Return true if SLDB was invoked due to a single-stepping condition,
+false otherwise. "
+ (declare (ignore condition))
+ nil)
+
+(definterface sldb-step-into ()
+ "Step into the current single-stepper form.")
+
+(definterface sldb-step-next ()
+ "Step to the next form in the current function.")
+
+(definterface sldb-step-out ()
+ "Stop single-stepping temporarily, but resume it once the current function
+returns.")
+
+
+;;;; Definition finding
+
+(defstruct (:location (:type list) :named
+ (:constructor make-location
+ (buffer position &optional hints)))
+ buffer position
+ ;; Hints is a property list optionally containing:
+ ;; :snippet SOURCE-TEXT
+ ;; This is a snippet of the actual source text at the start of
+ ;; the definition, which could be used in a text search.
+ hints)
+
+(defstruct (:error (:type list) :named (:constructor)) message)
+(defstruct (:file (:type list) :named (:constructor)) name)
+(defstruct (:buffer (:type list) :named (:constructor)) name)
+(defstruct (:position (:type list) :named (:constructor)) pos)
+
+(definterface find-definitions (name)
+ "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
+
+NAME is a \"definition specifier\".
+
+DSPEC is a \"definition specifier\" describing the
+definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
+\(DEFVAR FOO).
+
+LOCATION is the source location for the definition.")
+
+(definterface buffer-first-change (filename)
+ "Called for effect the first time FILENAME's buffer is modified."
+ (declare (ignore filename))
+ nil)
+
+
+;;;; XREF
+
+(definterface who-calls (function-name)
+ "Return the call sites of FUNCTION-NAME (a symbol).
+The results is a list ((DSPEC LOCATION) ...).")
+
+(definterface calls-who (function-name)
+ "Return the call sites of FUNCTION-NAME (a symbol).
+The results is a list ((DSPEC LOCATION) ...).")
+
+(definterface who-references (variable-name)
+ "Return the locations where VARIABLE-NAME (a symbol) is referenced.
+See WHO-CALLS for a description of the return value.")
+
+(definterface who-binds (variable-name)
+ "Return the locations where VARIABLE-NAME (a symbol) is bound.
+See WHO-CALLS for a description of the return value.")
+
+(definterface who-sets (variable-name)
+ "Return the locations where VARIABLE-NAME (a symbol) is set.
+See WHO-CALLS for a description of the return value.")
+
+(definterface who-macroexpands (macro-name)
+ "Return the locations where MACRO-NAME (a symbol) is expanded.
+See WHO-CALLS for a description of the return value.")
+
+(definterface who-specializes (class-name)
+ "Return the locations where CLASS-NAME (a symbol) is specialized.
+See WHO-CALLS for a description of the return value.")
+
+;;; Simpler variants.
+
+(definterface list-callers (function-name)
+ "List the callers of FUNCTION-NAME.
+This function is like WHO-CALLS except that it is expected to use
+lower-level means. Whereas WHO-CALLS is usually implemented with
+special compiler support, LIST-CALLERS is usually implemented by
+groveling for constants in function objects throughout the heap.
+
+The return value is as for WHO-CALLS.")
+
+(definterface list-callees (function-name)
+ "List the functions called by FUNCTION-NAME.
+See LIST-CALLERS for a description of the return value.")
+
+
+;;;; Profiling
+
+;;; The following functions define a minimal profiling interface.
+
+(definterface profile (fname)
+ "Marks symbol FNAME for profiling.")
+
+(definterface profiled-functions ()
+ "Returns a list of profiled functions.")
+
+(definterface unprofile (fname)
+ "Marks symbol FNAME as not profiled.")
+
+(definterface unprofile-all ()
+ "Marks all currently profiled functions as not profiled."
+ (dolist (f (profiled-functions))
+ (unprofile f)))
+
+(definterface profile-report ()
+ "Prints profile report.")
+
+(definterface profile-reset ()
+ "Resets profile counters.")
+
+(definterface profile-package (package callers-p methods)
+ "Wrap profiling code around all functions in PACKAGE. If a function
+is already profiled, then unprofile and reprofile (useful to notice
+function redefinition.)
+
+If CALLERS-P is T names have counts of the most common calling
+functions recorded.
+
+When called with arguments :METHODS T, profile all methods of all
+generic functions having names in the given package. Generic functions
+themselves, that is, their dispatch functions, are left alone.")
+
+
+;;;; Inspector
+
+(defclass inspector ()
+ ()
+ (:documentation "Super class of inspector objects.
+
+Implementations should sub class in order to dispatch off of the
+inspect-for-emacs method."))
+
+(defclass backend-inspector (inspector) ())
+
+(definterface make-default-inspector ()
+ "Return an inspector object suitable for passing to inspect-for-emacs.")
+
+(defgeneric inspect-for-emacs (object inspector)
+ (:documentation
+ "Explain to Emacs how to inspect OBJECT.
+
+The argument INSPECTOR is an object representing how to get at
+the internals of OBJECT, it is usually an implementation specific
+class used simply for dispatching to the proper method.
+
+Returns two values: a string which will be used as the title of
+the inspector buffer and a list specifying how to render the
+object for inspection.
+
+Every element of the list must be either a string, which will be
+inserted into the buffer as is, or a list of the form:
+
+ (:value object &optional format) - Render an inspectable
+ object. If format is provided it must be a string and will be
+ rendered in place of the value, otherwise use princ-to-string.
+
+ (:newline) - Render a \\n
+
+ (:action label lambda &key (refresh t)) - Render LABEL (a text
+ string) which when clicked will call LAMBDA. If REFRESH is
+ non-NIL the currently inspected object will be re-inspected
+ after calling the lambda.
+
+ NIL - do nothing."))
+
+(defmethod inspect-for-emacs ((object t) (inspector t))
+ "Generic method for inspecting any kind of object.
+
+Since we don't know how to deal with OBJECT we simply dump the
+output of CL:DESCRIBE."
+ (declare (ignore inspector))
+ (values
+ "A value."
+ `("Type: " (:value ,(type-of object)) (:newline)
+ "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
+ (:newline) (:newline)
+ ,(with-output-to-string (desc) (describe object desc)))))
+
+;;; Utilities for inspector methods.
+;;;
+(defun label-value-line (label value &key (newline t))
+ "Create a control list which prints \"LABEL: VALUE\" in the inspector.
+If NEWLINE is non-NIL a `(:newline)' is added to the result."
+ (list* (princ-to-string label) ": " `(:value ,value)
+ (if newline '((:newline)) nil)))
+
+(defmacro label-value-line* (&rest label-values)
+ ` (append ,@(loop for (label value) in label-values
+ collect `(label-value-line ,label ,value))))
+
+(definterface describe-primitive-type (object)
+ "Return a string describing the primitive type of object."
+ (declare (ignore object))
+ "N/A")
+
+
+;;;; Multithreading
+;;;
+;;; The default implementations are sufficient for non-multiprocessing
+;;; implementations.
+
+(definterface initialize-multiprocessing (continuation)
+ "Initialize multiprocessing, if necessary and then invoke CONTINUATION.
+
+Depending on the impleimentaion, this function may never return."
+ (funcall continuation))
+
+(definterface spawn (fn &key name)
+ "Create a new thread to call FN.")
+
+(definterface thread-id (thread)
+ "Return an Emacs-parsable object to identify THREAD.
+
+Ids should be comparable with equal, i.e.:
+ (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)")
+
+(definterface find-thread (id)
+ "Return the thread for ID.
+ID should be an id previously obtained with THREAD-ID.
+Can return nil if the thread no longer exists.")
+
+(definterface thread-name (thread)
+ "Return the name of THREAD.
+
+Thread names are be single-line strings and are meaningful to the
+user. They do not have to be unique."
+ (declare (ignore thread))
+ "The One True Thread")
+
+(definterface thread-status (thread)
+ "Return a string describing THREAD's state."
+ (declare (ignore thread))
+ "")
+
+(definterface make-lock (&key name)
+ "Make a lock for thread synchronization.
+Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
+ (declare (ignore name))
+ :null-lock)
+
+(definterface call-with-lock-held (lock function)
+ "Call FUNCTION with LOCK held, queueing if necessary."
+ (declare (ignore lock)
+ (type function function))
+ (funcall function))
+
+(definterface make-recursive-lock (&key name)
+ "Make a lock for thread synchronization.
+Only one thread may hold the lock (via CALL-WITH-RECURSIVE-LOCK-HELD)
+at a time, but that thread may hold it more than once."
+ (cons nil (make-lock :name name)))
+
+(definterface call-with-recursive-lock-held (lock function)
+ "Call FUNCTION with LOCK held, queueing if necessary."
+ (if (eql (car lock) (current-thread))
+ (funcall function)
+ (call-with-lock-held (cdr lock)
+ (lambda ()
+ (unwind-protect
+ (progn
+ (setf (car lock) (current-thread))
+ (funcall function))
+ (setf (car lock) nil))))))
+
+(definterface current-thread ()
+ "Return the currently executing thread."
+ 0)
+
+(definterface all-threads ()
+ "Return a list of all threads.")
+
+(definterface thread-alive-p (thread)
+ "Test if THREAD is termintated."
+ (member thread (all-threads)))
+
+(definterface interrupt-thread (thread fn)
+ "Cause THREAD to execute FN.")
+
+(definterface kill-thread (thread)
+ "Kill THREAD."
+ (declare (ignore thread))
+ nil)
+
+(definterface send (thread object)
+ "Send OBJECT to thread THREAD.")
+
+(definterface receive ()
+ "Return the next message from current thread's mailbox.")
+
+(definterface toggle-trace (spec)
+ "Toggle tracing of the function(s) given with SPEC.
+SPEC can be:
+ (setf NAME) ; a setf function
+ (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method
+ (:defgeneric NAME) ; a generic function with all methods
+ (:call CALLER CALLEE) ; trace calls from CALLER to CALLEE.
+ (:labels TOPLEVEL LOCAL)
+ (:flet TOPLEVEL LOCAL) ")
+
+
+;;;; Weak datastructures
+
+(definterface make-weak-key-hash-table (&rest args)
+ "Like MAKE-HASH-TABLE, but weak w.r.t. the keys."
+ (apply #'make-hash-table args))
+
+(definterface make-weak-value-hash-table (&rest args)
+ "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
+ (apply #'make-hash-table args))
+
+(definterface hash-table-weakness (hashtable)
+ "Return nil or one of :key :value :key-or-value :key-and-value"
+ (declare (ignore hashtable))
+ nil)
+
+
+;;;; Character names
+
+(definterface character-completion-set (prefix matchp)
+ "Return a list of names of characters that match PREFIX."
+ ;; Handle the standard and semi-standard characters.
+ (loop for name in '("Newline" "Space" "Tab" "Page" "Rubout"
+ "Linefeed" "Return" "Backspace")
+ when (funcall matchp prefix name)
+ collect name))
+
+
+(defparameter *type-specifier-arglists*
+ '((and . (&rest type-specifiers))
+ (array . (&optional element-type dimension-spec))
+ (base-string . (&optional size))
+ (bit-vector . (&optional size))
+ (complex . (&optional type-specifier))
+ (cons . (&optional car-typespec cdr-typespec))
+ (double-float . (&optional lower-limit upper-limit))
+ (eql . (object))
+ (float . (&optional lower-limit upper-limit))
+ (function . (&optional arg-typespec value-typespec))
+ (integer . (&optional lower-limit upper-limit))
+ (long-float . (&optional lower-limit upper-limit))
+ (member . (&rest eql-objects))
+ (mod . (n))
+ (not . (type-specifier))
+ (or . (&rest type-specifiers))
+ (rational . (&optional lower-limit upper-limit))
+ (real . (&optional lower-limit upper-limit))
+ (satisfies . (predicate-symbol))
+ (short-float . (&optional lower-limit upper-limit))
+ (signed-byte . (&optional size))
+ (simple-array . (&optional element-type dimension-spec))
+ (simple-base-string . (&optional size))
+ (simple-bit-vector . (&optional size))
+ (simple-string . (&optional size))
+ (single-float . (&optional lower-limit upper-limit))
+ (simple-vector . (&optional size))
+ (string . (&optional size))
+ (unsigned-byte . (&optional size))
+ (values . (&rest typespecs))
+ (vector . (&optional element-type size))
+ ))
Added: branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,672 @@
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
+
+;;;; SWANK support for CLISP.
+
+;;;; Copyright (C) 2003, 2004 W. Jenkner, V. Sedach
+
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public License as
+;;;; published by the Free Software Foundation; either version 2 of
+;;;; the License, or (at your option) any later version.
+
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with this program; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;;;; MA 02111-1307, USA.
+
+;;; This is work in progress, but it's already usable. Many things
+;;; are adapted from other swank-*.lisp, in particular from
+;;; swank-allegro (I don't use allegro at all, but it's the shortest
+;;; one and I found Helmut Eller's code there enlightening).
+
+;;; This code will work better with recent versions of CLISP (say, the
+;;; last release or CVS HEAD) while it may not work at all with older
+;;; versions. It is reasonable to expect it to work on platforms with
+;;; a "SOCKET" package, in particular on GNU/Linux or Unix-like
+;;; systems, but also on Win32. This backend uses the portable xref
+;;; from the CMU AI repository and metering.lisp from CLOCC [1], which
+;;; are conveniently included in SLIME.
+
+;;; [1] http://cvs.sourceforge.net/viewcvs.py/clocc/clocc/src/tools/metering/
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;;(use-package "SOCKET")
+ (use-package "GRAY"))
+
+;;;; if this lisp has the complete CLOS then we use it, otherwise we
+;;;; build up a "fake" swank-mop and then override the methods in the
+;;;; inspector.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar *have-mop*
+ (and (find-package :clos)
+ (eql :external
+ (nth-value 1 (find-symbol (string ':standard-slot-definition)
+ :clos))))
+ "True in those CLISP images which have a complete MOP implementation."))
+
+#+#.(cl:if swank-backend::*have-mop* '(cl:and) '(cl:or))
+(progn
+ (import-swank-mop-symbols :clos '(:slot-definition-documentation))
+
+ (defun swank-mop:slot-definition-documentation (slot)
+ (clos::slot-definition-documentation slot)))
+
+#-#.(cl:if swank-backend::*have-mop* '(and) '(or))
+(defclass swank-mop:standard-slot-definition ()
+ ()
+ (:documentation
+ "Dummy class created so that swank.lisp will compile and load."))
+
+;; #+#.(cl:if (cl:find-package "LINUX") '(and) '(or))
+;; (progn
+;; (defmacro with-blocked-signals ((&rest signals) &body body)
+;; (ext:with-gensyms ("SIGPROCMASK" ret mask)
+;; `(multiple-value-bind (,ret ,mask)
+;; (linux:sigprocmask-set-n-save
+;; ,linux:SIG_BLOCK
+;; ,(do ((sigset (linux:sigset-empty)
+;; (linux:sigset-add sigset (the fixnum (pop signals)))))
+;; ((null signals) sigset)))
+;; (linux:check-res ,ret 'linux:sigprocmask-set-n-save)
+;; (unwind-protect
+;; (progn ,@body)
+;; (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil)))))
+
+;; (defimplementation call-without-interrupts (fn)
+;; (with-blocked-signals (#.linux:SIGINT) (funcall fn))))
+
+;; #+#.(cl:if (cl:find-package "LINUX") '(or) '(and))
+(defimplementation call-without-interrupts (fn)
+ (funcall fn))
+
+(let ((getpid (or (find-symbol "PROCESS-ID" :system)
+ ;; old name prior to 2005-03-01, clisp <= 2.33.2
+ (find-symbol "PROGRAM-ID" :system)
+ #+win32 ; integrated into the above since 2005-02-24
+ (and (find-package :win32) ; optional modules/win32
+ (find-symbol "GetCurrentProcessId" :win32)))))
+ (defimplementation getpid () ; a required interface
+ (cond
+ (getpid (funcall getpid))
+ #+win32 ((ext:getenv "PID")) ; where does that come from?
+ (t -1))))
+
+(defimplementation lisp-implementation-type-name ()
+ "clisp")
+
+(defimplementation set-default-directory (directory)
+ (setf (ext:default-directory) directory)
+ (namestring (setf *default-pathname-defaults* (ext:default-directory))))
+
+;;;; TCP Server
+
+(defimplementation create-socket (host port)
+ (declare (ignore host))
+ (socket:socket-server port))
+
+(defimplementation local-port (socket)
+ (socket:socket-server-port socket))
+
+(defimplementation close-socket (socket)
+ (socket:socket-server-close socket))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (declare (ignore buffering timeout))
+ (socket:socket-accept socket
+ :buffered nil ;; XXX should be t
+ :element-type 'character
+ :external-format external-format))
+
+;;;; Coding systems
+
+(defvar *external-format-to-coding-system*
+ '(((:charset "iso-8859-1" :line-terminator :unix)
+ "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+ ((:charset "iso-8859-1":latin-1)
+ "latin-1" "iso-latin-1" "iso-8859-1")
+ ((:charset "utf-8") "utf-8")
+ ((:charset "utf-8" :line-terminator :unix) "utf-8-unix")
+ ((:charset "euc-jp") "euc-jp")
+ ((:charset "euc-jp" :line-terminator :unix) "euc-jp-unix")
+ ((:charset "us-ascii") "us-ascii")
+ ((:charset "us-ascii" :line-terminator :unix) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (let ((args (car (rassoc-if (lambda (x)
+ (member coding-system x :test #'equal))
+ *external-format-to-coding-system*))))
+ (and args (apply #'ext:make-encoding args))))
+
+
+;;;; Swank functions
+
+(defimplementation arglist (fname)
+ (block nil
+ (or (ignore-errors
+ (let ((exp (function-lambda-expression fname)))
+ (and exp (return (second exp)))))
+ (ignore-errors
+ (return (ext:arglist fname)))
+ :not-available)))
+
+(defimplementation macroexpand-all (form)
+ (ext:expand-form form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ "Return a plist describing SYMBOL.
+Return NIL if the symbol is unbound."
+ (let ((result ()))
+ (flet ((doc (kind)
+ (or (documentation symbol kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push :variable (when (boundp symbol) (doc 'variable)))
+ (when (fboundp symbol)
+ (maybe-push
+ ;; Report WHEN etc. as macros, even though they may be
+ ;; implemented as special operators.
+ (if (macro-function symbol) :macro
+ (typecase (fdefinition symbol)
+ (generic-function :generic-function)
+ (function :function)
+ ;; (type-of 'progn) -> ext:special-operator
+ (t :special-operator)))
+ (doc 'function)))
+ (when (or (get symbol 'system::setf-function) ; e.g. #'(setf elt)
+ (get symbol 'system::setf-expander)); defsetf
+ (maybe-push :setf (doc 'setf)))
+ (when (or (get symbol 'system::type-symbol); cf. clisp/src/describe.lisp
+ (get symbol 'system::defstruct-description)
+ (get symbol 'system::deftype-expander))
+ (maybe-push :type (doc 'type))) ; even for 'structure
+ (when (find-class symbol nil)
+ (maybe-push :class (doc 'type)))
+ ;; Let this code work compiled in images without FFI
+ (let ((types (load-time-value
+ (and (find-package "FFI")
+ (symbol-value
+ (find-symbol "*C-TYPE-TABLE*" "FFI"))))))
+ ;; Use ffi::*c-type-table* so as not to suffer the overhead of
+ ;; (ignore-errors (ffi:parse-c-type symbol)) for 99.9% of symbols
+ ;; which are not FFI type names.
+ (when (and types (nth-value 1 (gethash symbol types)))
+ ;; Maybe use (case (head (ffi:deparse-c-type)))
+ ;; to distinguish struct and union types?
+ (maybe-push :alien-type :not-documented)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable (describe symbol))
+ (:macro (describe (macro-function symbol)))
+ (:function (describe (symbol-function symbol)))
+ (:class (describe (find-class symbol)))))
+
+(defun fspec-pathname (symbol)
+ (let ((path (documentation symbol 'sys::file))
+ lines)
+ (when (consp path)
+ (psetq path (car path)
+ lines (cdr path)))
+ (when (and path
+ (member (pathname-type path)
+ custom:*compiled-file-types* :test #'equal))
+ (setq path
+ (loop for suffix in custom:*source-file-types*
+ thereis (probe-file (make-pathname :defaults path
+ :type suffix)))))
+ (values path lines)))
+
+(defun fspec-location (fspec)
+ (multiple-value-bind (file lines)
+ (fspec-pathname fspec)
+ (cond (file
+ (multiple-value-bind (truename c) (ignore-errors (truename file))
+ (cond (truename
+ (make-location (list :file (namestring truename))
+ (if (consp lines)
+ (list* :line lines)
+ (list :function-name (string fspec)))))
+ (t (list :error (princ-to-string c))))))
+ (t (list :error (format nil "No source information available for: ~S"
+ fspec))))))
+
+(defimplementation find-definitions (name)
+ (list (list name (fspec-location name))))
+
+(defun trim-whitespace (string)
+ (string-trim #(#\newline #\space #\tab) string))
+
+(defvar *sldb-backtrace*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let* (;;(sys::*break-count* (1+ sys::*break-count*))
+ ;;(sys::*driver* debugger-loop-fn)
+ ;;(sys::*fasoutput-stream* nil)
+ (*sldb-backtrace*
+ (nthcdr 3 (member (sys::the-frame) (sldb-backtrace)))))
+ (funcall debugger-loop-fn)))
+
+(defun nth-frame (index)
+ (nth index *sldb-backtrace*))
+
+(defun sldb-backtrace ()
+ "Return a list ((ADDRESS . DESCRIPTION) ...) of frames."
+ (do ((frames '())
+ (last nil frame)
+ (frame (sys::the-frame) (sys::frame-up-1 frame 1))) ; 1 = "all frames"
+ ((eq frame last) (nreverse frames))
+ (unless (boring-frame-p frame)
+ (push frame frames))))
+
+(defun boring-frame-p (frame)
+ (member (frame-type frame) '(stack-value bind-var bind-env)))
+
+(defun frame-to-string (frame)
+ (with-output-to-string (s)
+ (sys::describe-frame s frame)))
+
+(defun frame-type (frame)
+ ;; FIXME: should bind *print-length* etc. to small values.
+ (frame-string-type (frame-to-string frame)))
+
+(defvar *frame-prefixes*
+ '(("frame binding variables" bind-var)
+ ("<1> #<compiled-function" compiled-fun)
+ ("<1> #<system-function" sys-fun)
+ ("<1> #<special-operator" special-op)
+ ("EVAL frame" eval)
+ ("APPLY frame" apply)
+ ("compiled tagbody frame" compiled-tagbody)
+ ("compiled block frame" compiled-block)
+ ("block frame" block)
+ ("nested block frame" block)
+ ("tagbody frame" tagbody)
+ ("nested tagbody frame" tagbody)
+ ("catch frame" catch)
+ ("handler frame" handler)
+ ("unwind-protect frame" unwind-protect)
+ ("driver frame" driver)
+ ("frame binding environments" bind-env)
+ ("CALLBACK frame" callback)
+ ("- " stack-value)
+ ("<1> " fun)
+ ("<2> " 2nd-frame)))
+
+(defun frame-string-type (string)
+ (cadr (assoc-if (lambda (pattern) (is-prefix-p pattern string))
+ *frame-prefixes*)))
+
+(defimplementation compute-backtrace (start end)
+ (let* ((bt *sldb-backtrace*)
+ (len (length bt)))
+ (subseq bt start (min (or end len) len))))
+
+;;; CLISP's REPL sets up an ABORT restart that kills SWANK. Here we
+;;; can omit that restart so that users don't select it by mistake.
+(defimplementation compute-sane-restarts (condition)
+ ;; The outermost restart is specified to be the last element of the
+ ;; list, hopefully that's our unwanted ABORT restart.
+ (butlast (compute-restarts condition)))
+
+(defimplementation print-frame (frame stream)
+ (let ((str (frame-to-string frame)))
+ ;; (format stream "~A " (frame-string-type str))
+ (write-string (extract-frame-line str)
+ stream)))
+
+(defun extract-frame-line (frame-string)
+ (let ((s frame-string))
+ (trim-whitespace
+ (case (frame-string-type s)
+ ((eval special-op)
+ (string-match "EVAL frame .*for form \\(.*\\)" s 1))
+ (apply
+ (string-match "APPLY frame for call \\(.*\\)" s 1))
+ ((compiled-fun sys-fun fun)
+ (extract-function-name s))
+ (t s)))))
+
+(defun extract-function-name (string)
+ (let ((1st (car (split-frame-string string))))
+ (or (string-match (format nil "^<1>[ ~%]*#<[-A-Za-z]* \\(.*\\)>")
+ 1st
+ 1)
+ (string-match (format nil "^<1>[ ~%]*\\(.*\\)") 1st 1)
+ 1st)))
+
+(defun split-frame-string (string)
+ (let ((rx (format nil "~%\\(~{~A~^\\|~}\\)"
+ (mapcar #'car *frame-prefixes*))))
+ (loop for pos = 0 then (1+ (regexp:match-start match))
+ for match = (regexp:match rx string :start pos)
+ if match collect (subseq string pos (regexp:match-start match))
+ else collect (subseq string pos)
+ while match)))
+
+(defun string-match (pattern string n)
+ (let* ((match (nth-value n (regexp:match pattern string))))
+ (if match (regexp:match-string string match))))
+
+(defimplementation format-sldb-condition (condition)
+ (trim-whitespace (princ-to-string condition)))
+
+(defimplementation eval-in-frame (form frame-number)
+ (sys::eval-at (nth-frame frame-number) form))
+
+(defimplementation frame-locals (frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (loop for i below (%frame-count-vars frame)
+ collect (list :name (%frame-var-name frame i)
+ :value (%frame-var-value frame i)
+ :id 0))))
+
+(defimplementation frame-var-value (frame var)
+ (%frame-var-value (nth-frame frame) var))
+
+;;; Interpreter-Variablen-Environment has the shape
+;;; NIL or #(v1 val1 ... vn valn NEXT-ENV).
+
+(defun %frame-count-vars (frame)
+ (cond ((sys::eval-frame-p frame)
+ (do ((venv (frame-venv frame) (next-venv venv))
+ (count 0 (+ count (/ (1- (length venv)) 2))))
+ ((not venv) count)))
+ ((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
+ (length (%parse-stack-values frame)))
+ (t 0)))
+
+(defun %frame-var-name (frame i)
+ (cond ((sys::eval-frame-p frame)
+ (nth-value 0 (venv-ref (frame-venv frame) i)))
+ (t (format nil "~D" i))))
+
+(defun %frame-var-value (frame i)
+ (cond ((sys::eval-frame-p frame)
+ (let ((name (venv-ref (frame-venv frame) i)))
+ (multiple-value-bind (v c) (ignore-errors (sys::eval-at frame name))
+ (if c
+ (format-sldb-condition c)
+ v))))
+ ((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
+ (let ((str (nth i (%parse-stack-values frame))))
+ (trim-whitespace (subseq str 2))))
+ (t (break "Not implemented"))))
+
+(defun frame-venv (frame)
+ (let ((env (sys::eval-at frame '(sys::the-environment))))
+ (svref env 0)))
+
+(defun next-venv (venv) (svref venv (1- (length venv))))
+
+(defun venv-ref (env i)
+ "Reference the Ith binding in ENV.
+Return two values: NAME and VALUE"
+ (let ((idx (* i 2)))
+ (if (< idx (1- (length env)))
+ (values (svref env idx) (svref env (1+ idx)))
+ (venv-ref (next-venv env) (- i (/ (1- (length env)) 2))))))
+
+(defun %parse-stack-values (frame)
+ (labels ((next (fp) (sys::frame-down-1 fp 1))
+ (parse (fp accu)
+ (let ((str (frame-to-string fp)))
+ (cond ((is-prefix-p "- " str)
+ (parse (next fp) (cons str accu)))
+ ((is-prefix-p "<1> " str)
+ ;;(when (eq (frame-type frame) 'compiled-fun)
+ ;; (pop accu))
+ (dolist (str (cdr (split-frame-string str)))
+ (when (is-prefix-p "- " str)
+ (push str accu)))
+ (nreverse accu))
+ (t (parse (next fp) accu))))))
+ (parse (next frame) '())))
+
+(defun is-prefix-p (pattern string)
+ (not (mismatch pattern string :end2 (min (length pattern)
+ (length string)))))
+
+(defimplementation frame-catch-tags (index)
+ (declare (ignore index))
+ nil)
+
+(defimplementation return-from-frame (index form)
+ (sys::return-from-eval-frame (nth-frame index) form))
+
+(defimplementation restart-frame (index)
+ (sys::redo-eval-frame (nth-frame index)))
+
+(defimplementation frame-source-location-for-emacs (index)
+ `(:error
+ ,(format nil "frame-source-location not implemented. (frame: ~A)"
+ (nth-frame index))))
+
+;;;; Profiling
+
+(defimplementation profile (fname)
+ (eval `(mon:monitor ,fname))) ;monitor is a macro
+
+(defimplementation profiled-functions ()
+ mon:*monitored-functions*)
+
+(defimplementation unprofile (fname)
+ (eval `(mon:unmonitor ,fname))) ;unmonitor is a macro
+
+(defimplementation unprofile-all ()
+ (mon:unmonitor))
+
+(defimplementation profile-report ()
+ (mon:report-monitoring))
+
+(defimplementation profile-reset ()
+ (mon:reset-all-monitoring))
+
+(defimplementation profile-package (package callers-p methods)
+ (declare (ignore callers-p methods))
+ (mon:monitor-all package))
+
+;;;; Handle compiler conditions (find out location of error etc.)
+
+(defmacro compile-file-frobbing-notes ((&rest args) &body body)
+ "Pass ARGS to COMPILE-FILE, send the compiler notes to
+*STANDARD-INPUT* and frob them in BODY."
+ `(let ((*error-output* (make-string-output-stream))
+ (*compile-verbose* t))
+ (multiple-value-prog1
+ (compile-file ,@args)
+ (handler-case
+ (with-input-from-string
+ (*standard-input* (get-output-stream-string *error-output*))
+ ,@body)
+ (sys::simple-end-of-file () nil)))))
+
+(defvar *orig-c-warn* (symbol-function 'system::c-warn))
+(defvar *orig-c-style-warn* (symbol-function 'system::c-style-warn))
+(defvar *orig-c-error* (symbol-function 'system::c-error))
+(defvar *orig-c-report-problems* (symbol-function 'system::c-report-problems))
+
+(defmacro dynamic-flet (names-functions &body body)
+ "(dynamic-flet ((NAME FUNCTION) ...) BODY ...)
+Execute BODY with NAME's function slot set to FUNCTION."
+ `(ext:letf* ,(loop for (name function) in names-functions
+ collect `((symbol-function ',name) ,function))
+ ,@body))
+
+(defvar *buffer-name* nil)
+(defvar *buffer-offset*)
+
+(defun compiler-note-location ()
+ "Return the current compiler location."
+ (let ((lineno1 sys::*compile-file-lineno1*)
+ (lineno2 sys::*compile-file-lineno2*)
+ (file sys::*compile-file-truename*))
+ (cond ((and file lineno1 lineno2)
+ (make-location (list ':file (namestring file))
+ (list ':line lineno1)))
+ (*buffer-name*
+ (make-location (list ':buffer *buffer-name*)
+ (list ':position *buffer-offset*)))
+ (t
+ (list :error "No error location available")))))
+
+(defun signal-compiler-warning (cstring args severity orig-fn)
+ (signal (make-condition 'compiler-condition
+ :severity severity
+ :message (apply #'format nil cstring args)
+ :location (compiler-note-location)))
+ (apply orig-fn cstring args))
+
+(defun c-warn (cstring &rest args)
+ (signal-compiler-warning cstring args :warning *orig-c-warn*))
+
+(defun c-style-warn (cstring &rest args)
+ (dynamic-flet ((sys::c-warn *orig-c-warn*))
+ (signal-compiler-warning cstring args :style-warning *orig-c-style-warn*)))
+
+(defun c-error (cstring &rest args)
+ (signal-compiler-warning cstring args :error *orig-c-error*))
+
+(defimplementation call-with-compilation-hooks (function)
+ (handler-bind ((warning #'handle-notification-condition))
+ (dynamic-flet ((system::c-warn #'c-warn)
+ (system::c-style-warn #'c-style-warn)
+ (system::c-error #'c-error))
+ (funcall function))))
+
+(defun handle-notification-condition (condition)
+ "Handle a condition caused by a compiler warning."
+ (signal (make-condition 'compiler-condition
+ :original-condition condition
+ :severity :warning
+ :message (princ-to-string condition)
+ :location (compiler-note-location))))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+ (with-compilation-hooks ()
+ (with-compilation-unit ()
+ (let ((fasl-file (compile-file filename
+ :external-format external-format)))
+ (when (and load-p fasl-file)
+ (load fasl-file))
+ nil))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ (declare (ignore directory))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-offset* position))
+ (funcall (compile nil (read-from-string
+ (format nil "(~S () ~A)" 'lambda string)))))))
+
+;;;; Portable XREF from the CMU AI repository.
+
+(setq pxref::*handle-package-forms* '(cl:in-package))
+
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function name))))
+
+(defxref who-calls pxref:list-callers)
+(defxref who-references pxref:list-readers)
+(defxref who-binds pxref:list-setters)
+(defxref who-sets pxref:list-setters)
+(defxref list-callers pxref:list-callers)
+(defxref list-callees pxref:list-callees)
+
+(defun xref-results (symbols)
+ (let ((xrefs '()))
+ (dolist (symbol symbols)
+ (push (list symbol (fspec-location symbol)) xrefs))
+ xrefs))
+
+(when (find-package :swank-loader)
+ (setf (symbol-function (intern "USER-INIT-FILE" :swank-loader))
+ (lambda ()
+ (let ((home (user-homedir-pathname)))
+ (and (ext:probe-directory home)
+ (probe-file (format nil "~A/.swank.lisp"
+ (namestring (truename home)))))))))
+
+;;; Don't set *debugger-hook* to nil on break.
+(ext:without-package-lock ()
+ (defun break (&optional (format-string "Break") &rest args)
+ (if (not sys::*use-clcs*)
+ (progn
+ (terpri *error-output*)
+ (apply #'format *error-output*
+ (concatenate 'string "*** - " format-string)
+ args)
+ (funcall ext:*break-driver* t))
+ (let ((condition
+ (make-condition 'simple-condition
+ :format-control format-string
+ :format-arguments args))
+ ;;(*debugger-hook* nil)
+ ;; Issue 91
+ )
+ (ext:with-restarts
+ ((continue
+ :report (lambda (stream)
+ (format stream (sys::text "Return from ~S loop")
+ 'break))
+ ()))
+ (with-condition-restarts condition (list (find-restart 'continue))
+ (invoke-debugger condition)))))
+ nil))
+
+;;;; Inspecting
+
+(defclass clisp-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector () (make-instance 'clisp-inspector))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (let* ((*print-array* nil) (*print-pretty* t)
+ (*print-circle* t) (*print-escape* t)
+ (*print-lines* custom:*inspect-print-lines*)
+ (*print-level* custom:*inspect-print-level*)
+ (*print-length* custom:*inspect-print-length*)
+ (sys::*inspect-all* (make-array 10 :fill-pointer 0 :adjustable t))
+ (tmp-pack (make-package (gensym "INSPECT-TMP-PACKAGE-")))
+ (*package* tmp-pack)
+ (sys::*inspect-unbound-value* (intern "#<unbound>" tmp-pack)))
+ (let ((inspection (sys::inspect-backend o)))
+ (values (format nil "~S~% ~A~{~%~A~}" o
+ (sys::insp-title inspection)
+ (sys::insp-blurb inspection))
+ (loop with count = (sys::insp-num-slots inspection)
+ for i below count
+ append (multiple-value-bind (value name)
+ (funcall (sys::insp-nth-slot inspection)
+ i)
+ `((:value ,name) " = " (:value ,value)
+ (:newline))))))))
+
+(defimplementation quit-lisp ()
+ #+lisp=cl (ext:quit)
+ #-lisp=cl (lisp:quit))
+
+;;;; Weak hashtables
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak :key args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ (apply #'make-hash-table :weak :value args))
+
+;;; Local Variables:
+;;; eval: (put 'compile-file-frobbing-notes 'lisp-indent-function 1)
+;;; eval: (put 'dynamic-flet 'common-lisp-indent-function 1)
+;;; End:
Added: branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2255 @@
+;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;+" -*-
+;;;
+;;; License: Public Domain
+;;;
+;;;; Introduction
+;;;
+;;; This is the CMUCL implementation of the `swank-backend' package.
+
+(in-package :swank-backend)
+
+(import-swank-mop-symbols :pcl '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot t))
+
+;;;; "Hot fixes"
+;;;
+;;; Here are necessary bugfixes to the oldest supported version of
+;;; CMUCL (currently 18e). Any fixes placed here should also be
+;;; submitted to the `cmucl-imp' mailing list and confirmed as
+;;; good. When a new release is made that includes the fixes we should
+;;; promptly delete them from here. It is enough to be compatible with
+;;; the latest release.
+
+(in-package :lisp)
+
+;;; `READ-SEQUENCE' with large sequences has problems in 18e. This new
+;;; definition works better.
+
+#-cmu19
+(progn
+ (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp)))
+ (when s
+ (setf (symbol-value s) nil)))
+
+ (defun read-into-simple-string (s stream start end)
+ (declare (type simple-string s))
+ (declare (type stream stream))
+ (declare (type index start end))
+ (unless (subtypep (stream-element-type stream) 'character)
+ (error 'type-error
+ :datum (read-char stream nil #\Null)
+ :expected-type (stream-element-type stream)
+ :format-control "Trying to read characters from a binary stream."))
+ ;; Let's go as low level as it seems reasonable.
+ (let* ((numbytes (- end start))
+ (total-bytes 0))
+ ;; read-n-bytes may return fewer bytes than requested, so we need
+ ;; to keep trying.
+ (loop while (plusp numbytes) do
+ (let ((bytes-read (system:read-n-bytes stream s start numbytes nil)))
+ (when (zerop bytes-read)
+ (return-from read-into-simple-string total-bytes))
+ (incf total-bytes bytes-read)
+ (incf start bytes-read)
+ (decf numbytes bytes-read)))
+ total-bytes))
+
+ (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp)))
+ (when s
+ (setf (symbol-value s) t)))
+
+ )
+
+(in-package :swank-backend)
+
+
+;;;; TCP server
+;;;
+;;; In CMUCL we support all communication styles. By default we use
+;;; `:SIGIO' because it is the most responsive, but it's somewhat
+;;; dangerous: CMUCL is not in general "signal safe", and you don't
+;;; know for sure what you'll be interrupting. Both `:FD-HANDLER' and
+;;; `:SPAWN' are reasonable alternatives.
+
+(defimplementation preferred-communication-style ()
+ :sigio)
+
+#-(or darwin mips)
+(defimplementation create-socket (host port)
+ (let* ((addr (resolve-hostname host))
+ (addr (if (not (find-symbol "SOCKET-ERROR" :ext))
+ (ext:htonl addr)
+ addr)))
+ (ext:create-inet-listener port :stream :reuse-address t :host addr)))
+
+;; There seems to be a bug in create-inet-listener on Mac/OSX and Irix.
+#+(or darwin mips)
+(defimplementation create-socket (host port)
+ (declare (ignore host))
+ (ext:create-inet-listener port :stream :reuse-address t))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
+
+(defimplementation close-socket (socket)
+ (let ((fd (socket-fd socket)))
+ (sys:invalidate-descriptor fd)
+ (ext:close-socket fd)))
+
+(defimplementation accept-connection (socket &key
+ external-format buffering timeout)
+ (declare (ignore timeout external-format))
+ (let ((buffering (or buffering :full)))
+ (make-socket-io-stream (ext:accept-tcp-connection socket) buffering)))
+
+;;;;; Sockets
+
+(defun socket-fd (socket)
+ "Return the filedescriptor for the socket represented by SOCKET."
+ (etypecase socket
+ (fixnum socket)
+ (sys:fd-stream (sys:fd-stream-fd socket))))
+
+(defun resolve-hostname (hostname)
+ "Return the IP address of HOSTNAME as an integer (in host byte-order)."
+ (let ((hostent (ext:lookup-host-entry hostname)))
+ (car (ext:host-entry-addr-list hostent))))
+
+(defun make-socket-io-stream (fd buffering)
+ "Create a new input/output fd-stream for FD."
+ (sys:make-fd-stream fd :input t :output t :element-type 'base-char
+ :buffering buffering))
+
+;;;;; Signal-driven I/O
+
+(defvar *sigio-handlers* '()
+ "List of (key . function) pairs.
+All functions are called on SIGIO, and the key is used for removing
+specific functions.")
+
+(defun set-sigio-handler ()
+ (sys:enable-interrupt :sigio (lambda (signal code scp)
+ (sigio-handler signal code scp))))
+
+(defun sigio-handler (signal code scp)
+ (declare (ignore signal code scp))
+ (mapc #'funcall (mapcar #'cdr *sigio-handlers*)))
+
+(defun fcntl (fd command arg)
+ "fcntl(2) - manipulate a file descriptor."
+ (multiple-value-bind (ok error) (unix:unix-fcntl fd command arg)
+ (unless ok (error "fcntl: ~A" (unix:get-unix-error-msg error)))))
+
+(defimplementation add-sigio-handler (socket fn)
+ (set-sigio-handler)
+ (let ((fd (socket-fd socket)))
+ (fcntl fd unix:f-setown (unix:unix-getpid))
+ (fcntl fd unix:f-setfl unix:fasync)
+ (push (cons fd fn) *sigio-handlers*)))
+
+(defimplementation remove-sigio-handlers (socket)
+ (let ((fd (socket-fd socket)))
+ (setf *sigio-handlers* (remove fd *sigio-handlers* :key #'car))
+ (sys:invalidate-descriptor fd)))
+
+;;;;; SERVE-EVENT
+
+(defimplementation add-fd-handler (socket fn)
+ (let ((fd (socket-fd socket)))
+ (sys:add-fd-handler fd :input (lambda (_) _ (funcall fn)))))
+
+(defimplementation remove-fd-handlers (socket)
+ (sys:invalidate-descriptor (socket-fd socket)))
+
+
+;;;; Stream handling
+;;; XXX: How come we don't use Gray streams in CMUCL too? -luke (15/May/2004)
+
+(defimplementation make-fn-streams (input-fn output-fn)
+ (let* ((output (make-slime-output-stream output-fn))
+ (input (make-slime-input-stream input-fn output)))
+ (values input output)))
+
+(defstruct (slime-output-stream
+ (:include lisp::lisp-stream
+ (lisp::misc #'sos/misc)
+ (lisp::out #'sos/out)
+ (lisp::sout #'sos/sout))
+ (:conc-name sos.)
+ (:print-function %print-slime-output-stream)
+ (:constructor make-slime-output-stream (output-fn)))
+ (output-fn nil :type function)
+ (buffer (make-string 8000) :type string)
+ (index 0 :type kernel:index)
+ (column 0 :type kernel:index)
+ (last-flush-time (get-internal-real-time) :type unsigned-byte))
+
+(defun %print-slime-output-stream (s stream d)
+ (declare (ignore d))
+ (print-unreadable-object (s stream :type t :identity t)))
+
+(defun sos/out (stream char)
+ (system:without-interrupts
+ (let ((buffer (sos.buffer stream))
+ (index (sos.index stream)))
+ (setf (schar buffer index) char)
+ (setf (sos.index stream) (1+ index))
+ (incf (sos.column stream))
+ (when (char= #\newline char)
+ (setf (sos.column stream) 0)
+ (force-output stream))
+ (when (= index (1- (length buffer)))
+ (finish-output stream)))
+ char))
+
+(defun sos/sout (stream string start end)
+ (system:without-interrupts
+ (loop for i from start below end
+ do (sos/out stream (aref string i)))))
+
+(defun log-stream-op (stream operation)
+ stream operation
+ #+(or)
+ (progn
+ (format sys:*tty* "~S @ ~D ~A~%" operation
+ (sos.index stream)
+ (/ (- (get-internal-real-time) (sos.last-flush-time stream))
+ (coerce internal-time-units-per-second 'double-float)))
+ (finish-output sys:*tty*)))
+
+(defun sos/misc (stream operation &optional arg1 arg2)
+ (declare (ignore arg1 arg2))
+ (case operation
+ (:finish-output
+ (log-stream-op stream operation)
+ (system:without-interrupts
+ (let ((end (sos.index stream)))
+ (unless (zerop end)
+ (let ((s (subseq (sos.buffer stream) 0 end)))
+ (setf (sos.index stream) 0)
+ (funcall (sos.output-fn stream) s))
+ (setf (sos.last-flush-time stream) (get-internal-real-time)))))
+ nil)
+ (:force-output
+ (log-stream-op stream operation)
+ (sos/misc-force-output stream)
+ nil)
+ (:charpos (sos.column stream))
+ (:line-length 75)
+ (:file-position nil)
+ (:element-type 'base-char)
+ (:get-command nil)
+ (:close nil)
+ (t (format *terminal-io* "~&~Astream: ~S~%" stream operation))))
+
+(defun sos/misc-force-output (stream)
+ (system:without-interrupts
+ (unless (or (zerop (sos.index stream))
+ (loop with buffer = (sos.buffer stream)
+ for i from 0 below (sos.index stream)
+ always (char= (aref buffer i) #\newline)))
+ (let ((last (sos.last-flush-time stream))
+ (now (get-internal-real-time)))
+ (when (> (/ (- now last)
+ (coerce internal-time-units-per-second 'double-float))
+ 0.1)
+ (finish-output stream))))))
+
+(defstruct (slime-input-stream
+ (:include string-stream
+ (lisp::in #'sis/in)
+ (lisp::misc #'sis/misc))
+ (:conc-name sis.)
+ (:print-function %print-slime-output-stream)
+ (:constructor make-slime-input-stream (input-fn sos)))
+ (input-fn nil :type function)
+ ;; We know our sibling output stream, so that we can force it before
+ ;; requesting input.
+ (sos nil :type slime-output-stream)
+ (buffer "" :type string)
+ (index 0 :type kernel:index))
+
+(defun sis/in (stream eof-errorp eof-value)
+ (finish-output (sis.sos stream))
+ (let ((index (sis.index stream))
+ (buffer (sis.buffer stream)))
+ (when (= index (length buffer))
+ (let ((string (funcall (sis.input-fn stream))))
+ (cond ((zerop (length string))
+ (return-from sis/in
+ (if eof-errorp
+ (error (make-condition 'end-of-file :stream stream))
+ eof-value)))
+ (t
+ (setf buffer string)
+ (setf (sis.buffer stream) buffer)
+ (setf index 0)))))
+ (prog1 (aref buffer index)
+ (setf (sis.index stream) (1+ index)))))
+
+(defun sis/misc (stream operation &optional arg1 arg2)
+ (declare (ignore arg2))
+ (ecase operation
+ (:file-position nil)
+ (:file-length nil)
+ (:unread (setf (aref (sis.buffer stream)
+ (decf (sis.index stream)))
+ arg1))
+ (:clear-input
+ (setf (sis.index stream) 0
+ (sis.buffer stream) ""))
+ (:listen (< (sis.index stream) (length (sis.buffer stream))))
+ (:charpos nil)
+ (:line-length nil)
+ (:get-command nil)
+ (:element-type 'base-char)
+ (:close nil)
+ (:interactive-p t)))
+
+
+;;;; Compilation Commands
+
+(defvar *previous-compiler-condition* nil
+ "Used to detect duplicates.")
+
+(defvar *previous-context* nil
+ "Previous compiler error context.")
+
+(defvar *buffer-name* nil
+ "The name of the Emacs buffer we are compiling from.
+NIL if we aren't compiling from a buffer.")
+
+(defvar *buffer-start-position* nil)
+(defvar *buffer-substring* nil)
+
+(defimplementation call-with-compilation-hooks (function)
+ (let ((*previous-compiler-condition* nil)
+ (*previous-context* nil)
+ (*print-readably* nil))
+ (handler-bind ((c::compiler-error #'handle-notification-condition)
+ (c::style-warning #'handle-notification-condition)
+ (c::warning #'handle-notification-condition))
+ (funcall function))))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+ (declare (ignore external-format))
+ (clear-xref-info filename)
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil)
+ (ext:*ignore-extra-close-parentheses* nil))
+ (multiple-value-bind (output-file warnings-p failure-p)
+ (compile-file filename)
+ (unless failure-p
+ ;; Cache the latest source file for definition-finding.
+ (source-cache-get filename (file-write-date filename))
+ (when load-p (load output-file)))
+ (values output-file warnings-p failure-p)))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ (declare (ignore directory))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-substring* string))
+ (with-input-from-string (stream string)
+ (ext:compile-from-stream
+ stream
+ :source-info `(:emacs-buffer ,buffer
+ :emacs-buffer-offset ,position
+ :emacs-buffer-string ,string))))))
+
+
+;;;;; Trapping notes
+;;;
+;;; We intercept conditions from the compiler and resignal them as
+;;; `SWANK:COMPILER-CONDITION's.
+
+(defun handle-notification-condition (condition)
+ "Handle a condition caused by a compiler warning."
+ (unless (eq condition *previous-compiler-condition*)
+ (let ((context (c::find-error-context nil)))
+ (setq *previous-compiler-condition* condition)
+ (setq *previous-context* context)
+ (signal-compiler-condition condition context))))
+
+(defun signal-compiler-condition (condition context)
+ (signal (make-condition
+ 'compiler-condition
+ :original-condition condition
+ :severity (severity-for-emacs condition)
+ :short-message (brief-compiler-message-for-emacs condition)
+ :message (long-compiler-message-for-emacs condition context)
+ :location (if (read-error-p condition)
+ (read-error-location condition)
+ (compiler-note-location context)))))
+
+(defun severity-for-emacs (condition)
+ "Return the severity of CONDITION."
+ (etypecase condition
+ ((satisfies read-error-p) :read-error)
+ (c::compiler-error :error)
+ (c::style-warning :note)
+ (c::warning :warning)))
+
+(defun read-error-p (condition)
+ (eq (type-of condition) 'c::compiler-read-error))
+
+(defun brief-compiler-message-for-emacs (condition)
+ "Briefly describe a compiler error for Emacs.
+When Emacs presents the message it already has the source popped up
+and the source form highlighted. This makes much of the information in
+the error-context redundant."
+ (princ-to-string condition))
+
+(defun long-compiler-message-for-emacs (condition error-context)
+ "Describe a compiler error for Emacs including context information."
+ (declare (type (or c::compiler-error-context null) error-context))
+ (multiple-value-bind (enclosing source)
+ (if error-context
+ (values (c::compiler-error-context-enclosing-source error-context)
+ (c::compiler-error-context-source error-context)))
+ (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
+ enclosing source condition)))
+
+(defun read-error-location (condition)
+ (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
+ (file (c::file-info-name finfo))
+ (pos (c::compiler-read-error-position condition)))
+ (cond ((and (eq file :stream) *buffer-name*)
+ (make-location (list :buffer *buffer-name*)
+ (list :position (+ *buffer-start-position* pos))))
+ ((and (pathnamep file) (not *buffer-name*))
+ (make-location (list :file (unix-truename file))
+ (list :position (1+ pos))))
+ (t (break)))))
+
+(defun compiler-note-location (context)
+ "Derive the location of a complier message from its context.
+Return a `location' record, or (:error REASON) on failure."
+ (if (null context)
+ (note-error-location)
+ (let ((file (c::compiler-error-context-file-name context))
+ (source (c::compiler-error-context-original-source context))
+ (path
+ (reverse (c::compiler-error-context-original-source-path context))))
+ (or (locate-compiler-note file source path)
+ (note-error-location)))))
+
+(defun note-error-location ()
+ "Pseudo-location for notes that can't be located."
+ (list :error "No error location available."))
+
+(defun locate-compiler-note (file source source-path)
+ (cond ((and (eq file :stream) *buffer-name*)
+ ;; Compiling from a buffer
+ (let ((position (+ *buffer-start-position*
+ (source-path-string-position
+ source-path *buffer-substring*))))
+ (make-location (list :buffer *buffer-name*)
+ (list :position position))))
+ ((and (pathnamep file) (null *buffer-name*))
+ ;; Compiling from a file
+ (make-location (list :file (unix-truename file))
+ (list :position
+ (1+ (source-path-file-position
+ source-path file)))))
+ ((and (eq file :lisp) (stringp source))
+ ;; No location known, but we have the source form.
+ ;; XXX How is this case triggered? -luke (16/May/2004)
+ ;; This can happen if the compiler needs to expand a macro
+ ;; but the macro-expander is not yet compiled. Calling the
+ ;; (interpreted) macro-expander triggers IR1 conversion of
+ ;; the lambda expression for the expander and invokes the
+ ;; compiler recursively.
+ (make-location (list :source-form source)
+ (list :position 1)))))
+
+(defun unix-truename (pathname)
+ (ext:unix-namestring (truename pathname)))
+
+
+;;;; XREF
+;;;
+;;; Cross-reference support is based on the standard CMUCL `XREF'
+;;; package. This package has some caveats: XREF information is
+;;; recorded during compilation and not preserved in fasl files, and
+;;; XREF recording is disabled by default. Redefining functions can
+;;; also cause duplicate references to accumulate, but
+;;; `swank-compile-file' will automatically clear out any old records
+;;; from the same filename.
+;;;
+;;; To enable XREF recording, set `c:*record-xref-info*' to true. To
+;;; clear out the XREF database call `xref:init-xref-database'.
+
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function name))))
+
+(defxref who-calls xref:who-calls)
+(defxref who-references xref:who-references)
+(defxref who-binds xref:who-binds)
+(defxref who-sets xref:who-sets)
+
+;;; More types of XREF information were added since 18e:
+;;;
+#+cmu19
+(progn
+ (defxref who-macroexpands xref:who-macroexpands)
+ ;; XXX
+ (defimplementation who-specializes (symbol)
+ (let* ((methods (xref::who-specializes (find-class symbol)))
+ (locations (mapcar #'method-location methods)))
+ (mapcar #'list methods locations))))
+
+(defun xref-results (contexts)
+ (mapcar (lambda (xref)
+ (list (xref:xref-context-name xref)
+ (resolve-xref-location xref)))
+ contexts))
+
+(defun resolve-xref-location (xref)
+ (let ((name (xref:xref-context-name xref))
+ (file (xref:xref-context-file xref))
+ (source-path (xref:xref-context-source-path xref)))
+ (cond ((and file source-path)
+ (let ((position (source-path-file-position source-path file)))
+ (make-location (list :file (unix-truename file))
+ (list :position (1+ position)))))
+ (file
+ (make-location (list :file (unix-truename file))
+ (list :function-name (string name))))
+ (t
+ `(:error ,(format nil "Unknown source location: ~S ~S ~S "
+ name file source-path))))))
+
+(defun clear-xref-info (namestring)
+ "Clear XREF notes pertaining to NAMESTRING.
+This is a workaround for a CMUCL bug: XREF records are cumulative."
+ (when c:*record-xref-info*
+ (let ((filename (truename namestring)))
+ (dolist (db (list xref::*who-calls*
+ #+cmu19 xref::*who-is-called*
+ #+cmu19 xref::*who-macroexpands*
+ xref::*who-references*
+ xref::*who-binds*
+ xref::*who-sets*))
+ (maphash (lambda (target contexts)
+ ;; XXX update during traversal?
+ (setf (gethash target db)
+ (delete filename contexts
+ :key #'xref:xref-context-file
+ :test #'equalp)))
+ db)))))
+
+
+;;;; Find callers and callees
+;;;
+;;; Find callers and callees by looking at the constant pool of
+;;; compiled code objects. We assume every fdefn object in the
+;;; constant pool corresponds to a call to that function. A better
+;;; strategy would be to use the disassembler to find actual
+;;; call-sites.
+
+(declaim (inline map-code-constants))
+(defun map-code-constants (code fn)
+ "Call FN for each constant in CODE's constant pool."
+ (check-type code kernel:code-component)
+ (loop for i from vm:code-constants-offset below (kernel:get-header-data code)
+ do (funcall fn (kernel:code-header-ref code i))))
+
+(defun function-callees (function)
+ "Return FUNCTION's callees as a list of functions."
+ (let ((callees '()))
+ (map-code-constants
+ (vm::find-code-object function)
+ (lambda (obj)
+ (when (kernel:fdefn-p obj)
+ (push (kernel:fdefn-function obj) callees))))
+ callees))
+
+(declaim (ext:maybe-inline map-allocated-code-components))
+(defun map-allocated-code-components (spaces fn)
+ "Call FN for each allocated code component in one of SPACES. FN
+receives the object as argument. SPACES should be a list of the
+symbols :dynamic, :static, or :read-only."
+ (dolist (space spaces)
+ (declare (inline vm::map-allocated-objects)
+ (optimize (ext:inhibit-warnings 3)))
+ (vm::map-allocated-objects
+ (lambda (obj header size)
+ (declare (type fixnum size) (ignore size))
+ (when (= vm:code-header-type header)
+ (funcall fn obj)))
+ space)))
+
+(declaim (ext:maybe-inline map-caller-code-components))
+(defun map-caller-code-components (function spaces fn)
+ "Call FN for each code component with a fdefn for FUNCTION in its
+constant pool."
+ (let ((function (coerce function 'function)))
+ (declare (inline map-allocated-code-components))
+ (map-allocated-code-components
+ spaces
+ (lambda (obj)
+ (map-code-constants
+ obj
+ (lambda (constant)
+ (when (and (kernel:fdefn-p constant)
+ (eq (kernel:fdefn-function constant)
+ function))
+ (funcall fn obj))))))))
+
+(defun function-callers (function &optional (spaces '(:read-only :static
+ :dynamic)))
+ "Return FUNCTION's callers. The result is a list of code-objects."
+ (let ((referrers '()))
+ (declare (inline map-caller-code-components))
+ ;;(ext:gc :full t)
+ (map-caller-code-components function spaces
+ (lambda (code) (push code referrers)))
+ referrers))
+
+(defun debug-info-definitions (debug-info)
+ "Return the defintions for a debug-info. This should only be used
+for code-object without entry points, i.e., byte compiled
+code (are theree others?)"
+ ;; This mess has only been tested with #'ext::skip-whitespace, a
+ ;; byte-compiled caller of #'read-char .
+ (check-type debug-info (and (not c::compiled-debug-info) c::debug-info))
+ (let ((name (c::debug-info-name debug-info))
+ (source (c::debug-info-source debug-info)))
+ (destructuring-bind (first) source
+ (ecase (c::debug-source-from first)
+ (:file
+ (list (list name
+ (make-location
+ (list :file (unix-truename (c::debug-source-name first)))
+ (list :function-name (string name))))))))))
+
+(defun code-component-entry-points (code)
+ "Return a list ((NAME LOCATION) ...) of function definitons for
+the code omponent CODE."
+ (let ((names '()))
+ (do ((f (kernel:%code-entry-points code) (kernel::%function-next f)))
+ ((not f))
+ (let ((name (kernel:%function-name f)))
+ (when (ext:valid-function-name-p name)
+ (push (list name (function-location f)) names))))
+ names))
+
+(defimplementation list-callers (symbol)
+ "Return a list ((NAME LOCATION) ...) of callers."
+ (let ((components (function-callers symbol))
+ (xrefs '()))
+ (dolist (code components)
+ (let* ((entry (kernel:%code-entry-points code))
+ (defs (if entry
+ (code-component-entry-points code)
+ ;; byte compiled stuff
+ (debug-info-definitions
+ (kernel:%code-debug-info code)))))
+ (setq xrefs (nconc defs xrefs))))
+ xrefs))
+
+(defimplementation list-callees (symbol)
+ (let ((fns (function-callees symbol)))
+ (mapcar (lambda (fn)
+ (list (kernel:%function-name fn)
+ (function-location fn)))
+ fns)))
+
+
+;;;; Resolving source locations
+;;;
+;;; Our mission here is to "resolve" references to code locations into
+;;; actual file/buffer names and character positions. The references
+;;; we work from come out of the compiler's statically-generated debug
+;;; information, such as `code-location''s and `debug-source''s. For
+;;; more details, see the "Debugger Programmer's Interface" section of
+;;; the CMUCL manual.
+;;;
+;;; The first step is usually to find the corresponding "source-path"
+;;; for the location. Once we have the source-path we can pull up the
+;;; source file and `READ' our way through to the right position. The
+;;; main source-code groveling work is done in
+;;; `swank-source-path-parser.lisp'.
+
+(defvar *debug-definition-finding* nil
+ "When true don't handle errors while looking for definitions.
+This is useful when debugging the definition-finding code.")
+
+(defvar *source-snippet-size* 256
+ "Maximum number of characters in a snippet of source code.
+Snippets at the beginning of definitions are used to tell Emacs what
+the definitions looks like, so that it can accurately find them by
+text search.")
+
+(defmacro safe-definition-finding (&body body)
+ "Execute BODY and return the source-location it returns.
+If an error occurs and `*debug-definition-finding*' is false, then
+return an error pseudo-location.
+
+The second return value is NIL if no error occurs, otherwise it is the
+condition object."
+ `(flet ((body () ,@body))
+ (if *debug-definition-finding*
+ (body)
+ (handler-case (values (progn ,@body) nil)
+ (error (c) (values `(:error ,(trim-whitespace (princ-to-string c)))
+ c))))))
+
+(defun trim-whitespace (string)
+ (string-trim #(#\newline #\space #\tab) string))
+
+(defun code-location-source-location (code-location)
+ "Safe wrapper around `code-location-from-source-location'."
+ (safe-definition-finding
+ (source-location-from-code-location code-location)))
+
+(defun source-location-from-code-location (code-location)
+ "Return the source location for CODE-LOCATION."
+ (let ((debug-fun (di:code-location-debug-function code-location)))
+ (when (di::bogus-debug-function-p debug-fun)
+ ;; Those lousy cheapskates! They've put in a bogus debug source
+ ;; because the code was compiled at a low debug setting.
+ (error "Bogus debug function: ~A" debug-fun)))
+ (let* ((debug-source (di:code-location-debug-source code-location))
+ (from (di:debug-source-from debug-source))
+ (name (di:debug-source-name debug-source)))
+ (ecase from
+ (:file
+ (location-in-file name code-location debug-source))
+ (:stream
+ (location-in-stream code-location debug-source))
+ (:lisp
+ ;; The location comes from a form passed to `compile'.
+ ;; The best we can do is return the form itself for printing.
+ (make-location
+ (list :source-form (with-output-to-string (*standard-output*)
+ (debug::print-code-location-source-form
+ code-location 100 t)))
+ (list :position 1))))))
+
+(defun location-in-file (filename code-location debug-source)
+ "Resolve the source location for CODE-LOCATION in FILENAME."
+ (let* ((code-date (di:debug-source-created debug-source))
+ (source-code (get-source-code filename code-date)))
+ (with-input-from-string (s source-code)
+ (make-location (list :file (unix-truename filename))
+ (list :position (1+ (code-location-stream-position
+ code-location s)))
+ `(:snippet ,(read-snippet s))))))
+
+(defun location-in-stream (code-location debug-source)
+ "Resolve the source location for a CODE-LOCATION from a stream.
+This only succeeds if the code was compiled from an Emacs buffer."
+ (unless (debug-source-info-from-emacs-buffer-p debug-source)
+ (error "The code is compiled from a non-SLIME stream."))
+ (let* ((info (c::debug-source-info debug-source))
+ (string (getf info :emacs-buffer-string))
+ (position (code-location-string-offset
+ code-location
+ string)))
+ (make-location
+ (list :buffer (getf info :emacs-buffer))
+ (list :position (+ (getf info :emacs-buffer-offset) position))
+ (list :snippet (with-input-from-string (s string)
+ (file-position s position)
+ (read-snippet s))))))
+
+;;;;; Function-name locations
+;;;
+(defun debug-info-function-name-location (debug-info)
+ "Return a function-name source-location for DEBUG-INFO.
+Function-name source-locations are a fallback for when precise
+positions aren't available."
+ (with-struct (c::debug-info- (fname name) source) debug-info
+ (with-struct (c::debug-source- info from name) (car source)
+ (ecase from
+ (:file
+ (make-location (list :file (namestring (truename name)))
+ (list :function-name (string fname))))
+ (:stream
+ (assert (debug-source-info-from-emacs-buffer-p (car source)))
+ (make-location (list :buffer (getf info :emacs-buffer))
+ (list :function-name (string fname))))
+ (:lisp
+ (make-location (list :source-form (princ-to-string (aref name 0)))
+ (list :position 1)))))))
+
+(defun debug-source-info-from-emacs-buffer-p (debug-source)
+ "Does the `info' slot of DEBUG-SOURCE contain an Emacs buffer location?
+This is true for functions that were compiled directly from buffers."
+ (info-from-emacs-buffer-p (c::debug-source-info debug-source)))
+
+(defun info-from-emacs-buffer-p (info)
+ (and info
+ (consp info)
+ (eq :emacs-buffer (car info))))
+
+
+;;;;; Groveling source-code for positions
+
+(defun code-location-stream-position (code-location stream)
+ "Return the byte offset of CODE-LOCATION in STREAM. Extract the
+toplevel-form-number and form-number from CODE-LOCATION and use that
+to find the position of the corresponding form.
+
+Finish with STREAM positioned at the start of the code location."
+ (let* ((location (debug::maybe-block-start-location code-location))
+ (tlf-offset (di:code-location-top-level-form-offset location))
+ (form-number (di:code-location-form-number location)))
+ (let ((pos (form-number-stream-position tlf-offset form-number stream)))
+ (file-position stream pos)
+ pos)))
+
+(defun form-number-stream-position (tlf-number form-number stream)
+ "Return the starting character position of a form in STREAM.
+TLF-NUMBER is the top-level-form number.
+FORM-NUMBER is an index into a source-path table for the TLF."
+ (multiple-value-bind (tlf position-map) (read-source-form tlf-number stream)
+ (let* ((path-table (di:form-number-translations tlf 0))
+ (source-path
+ (if (<= (length path-table) form-number) ; source out of sync?
+ (list 0) ; should probably signal a condition
+ (reverse (cdr (aref path-table form-number))))))
+ (source-path-source-position source-path tlf position-map))))
+
+(defun code-location-string-offset (code-location string)
+ "Return the byte offset of CODE-LOCATION in STRING.
+See CODE-LOCATION-STREAM-POSITION."
+ (with-input-from-string (s string)
+ (code-location-stream-position code-location s)))
+
+
+;;;; Finding definitions
+
+;;; There are a great many different types of definition for us to
+;;; find. We search for definitions of every kind and return them in a
+;;; list.
+
+(defimplementation find-definitions (name)
+ (append (function-definitions name)
+ (setf-definitions name)
+ (variable-definitions name)
+ (class-definitions name)
+ (type-definitions name)
+ (compiler-macro-definitions name)
+ (source-transform-definitions name)
+ (function-info-definitions name)
+ (ir1-translator-definitions name)))
+
+;;;;; Functions, macros, generic functions, methods
+;;;
+;;; We make extensive use of the compile-time debug information that
+;;; CMUCL records, in particular "debug functions" and "code
+;;; locations." Refer to the "Debugger Programmer's Interface" section
+;;; of the CMUCL manual for more details.
+
+(defun function-definitions (name)
+ "Return definitions for NAME in the \"function namespace\", i.e.,
+regular functions, generic functions, methods and macros.
+NAME can any valid function name (e.g, (setf car))."
+ (let ((macro? (and (symbolp name) (macro-function name)))
+ (special? (and (symbolp name) (special-operator-p name)))
+ (function? (and (ext:valid-function-name-p name)
+ (ext:info :function :definition name)
+ (if (symbolp name) (fboundp name) t))))
+ (cond (macro?
+ (list `((defmacro ,name)
+ ,(function-location (macro-function name)))))
+ (special?
+ (list `((:special-operator ,name)
+ (:error ,(format nil "Special operator: ~S" name)))))
+ (function?
+ (let ((function (fdefinition name)))
+ (if (genericp function)
+ (generic-function-definitions name function)
+ (list (list `(function ,name)
+ (function-location function)))))))))
+
+;;;;;; Ordinary (non-generic/macro/special) functions
+;;;
+;;; First we test if FUNCTION is a closure created by defstruct, and
+;;; if so extract the defstruct-description (`dd') from the closure
+;;; and find the constructor for the struct. Defstruct creates a
+;;; defun for the default constructor and we use that as an
+;;; approximation to the source location of the defstruct.
+;;;
+;;; For an ordinary function we return the source location of the
+;;; first code-location we find.
+;;;
+(defun function-location (function)
+ "Return the source location for FUNCTION."
+ (cond ((struct-closure-p function)
+ (struct-closure-location function))
+ ((c::byte-function-or-closure-p function)
+ (byte-function-location function))
+ (t
+ (compiled-function-location function))))
+
+(defun compiled-function-location (function)
+ "Return the location of a regular compiled function."
+ (multiple-value-bind (code-location error)
+ (safe-definition-finding (function-first-code-location function))
+ (cond (error (list :error (princ-to-string error)))
+ (t (code-location-source-location code-location)))))
+
+(defun function-first-code-location (function)
+ "Return the first code-location we can find for FUNCTION."
+ (and (function-has-debug-function-p function)
+ (di:debug-function-start-location
+ (di:function-debug-function function))))
+
+(defun function-has-debug-function-p (function)
+ (di:function-debug-function function))
+
+(defun function-code-object= (closure function)
+ (and (eq (vm::find-code-object closure)
+ (vm::find-code-object function))
+ (not (eq closure function))))
+
+
+(defun byte-function-location (fn)
+ "Return the location of the byte-compiled function FN."
+ (etypecase fn
+ ((or c::hairy-byte-function c::simple-byte-function)
+ (let* ((component (c::byte-function-component fn))
+ (debug-info (kernel:%code-debug-info component)))
+ (debug-info-function-name-location debug-info)))
+ (c::byte-closure
+ (byte-function-location (c::byte-closure-function fn)))))
+
+;;; Here we deal with structure accessors. Note that `dd' is a
+;;; "defstruct descriptor" structure in CMUCL. A `dd' describes a
+;;; `defstruct''d structure.
+
+(defun struct-closure-p (function)
+ "Is FUNCTION a closure created by defstruct?"
+ (or (function-code-object= function #'kernel::structure-slot-accessor)
+ (function-code-object= function #'kernel::structure-slot-setter)
+ (function-code-object= function #'kernel::%defstruct)))
+
+(defun struct-closure-location (function)
+ "Return the location of the structure that FUNCTION belongs to."
+ (assert (struct-closure-p function))
+ (safe-definition-finding
+ (dd-location (struct-closure-dd function))))
+
+(defun struct-closure-dd (function)
+ "Return the defstruct-definition (dd) of FUNCTION."
+ (assert (= (kernel:get-type function) vm:closure-header-type))
+ (flet ((find-layout (function)
+ (sys:find-if-in-closure
+ (lambda (x)
+ (let ((value (if (di::indirect-value-cell-p x)
+ (c:value-cell-ref x)
+ x)))
+ (when (kernel::layout-p value)
+ (return-from find-layout value))))
+ function)))
+ (kernel:layout-info (find-layout function))))
+
+(defun dd-location (dd)
+ "Return the location of a `defstruct'."
+ ;; Find the location in a constructor.
+ (function-location (struct-constructor dd)))
+
+(defun struct-constructor (dd)
+ "Return a constructor function from a defstruct definition.
+Signal an error if no constructor can be found."
+ (let ((constructor (or (kernel:dd-default-constructor dd)
+ (car (kernel::dd-constructors dd)))))
+ (when (or (null constructor)
+ (and (consp constructor) (null (car constructor))))
+ (error "Cannot find structure's constructor: ~S"
+ (kernel::dd-name dd)))
+ (coerce (if (consp constructor) (first constructor) constructor)
+ 'function)))
+
+;;;;;; Generic functions and methods
+
+(defun generic-function-definitions (name function)
+ "Return the definitions of a generic function and its methods."
+ (cons (list `(defgeneric ,name) (gf-location function))
+ (gf-method-definitions function)))
+
+(defun gf-location (gf)
+ "Return the location of the generic function GF."
+ (definition-source-location gf (pcl::generic-function-name gf)))
+
+(defun gf-method-definitions (gf)
+ "Return the locations of all methods of the generic function GF."
+ (mapcar #'method-definition (pcl::generic-function-methods gf)))
+
+(defun method-definition (method)
+ (list (method-dspec method)
+ (method-location method)))
+
+(defun method-dspec (method)
+ "Return a human-readable \"definition specifier\" for METHOD."
+ (let* ((gf (pcl:method-generic-function method))
+ (name (pcl:generic-function-name gf))
+ (specializers (pcl:method-specializers method))
+ (qualifiers (pcl:method-qualifiers method)))
+ `(method ,name ,@qualifiers ,(pcl::unparse-specializers specializers))))
+
+;; XXX maybe special case setters/getters
+(defun method-location (method)
+ (function-location (or (pcl::method-fast-function method)
+ (pcl:method-function method))))
+
+(defun genericp (fn)
+ (typep fn 'generic-function))
+
+;;;;;; Types and classes
+
+(defun type-definitions (name)
+ "Return `deftype' locations for type NAME."
+ (maybe-make-definition (ext:info :type :expander name) 'deftype name))
+
+(defun maybe-make-definition (function kind name)
+ "If FUNCTION is non-nil then return its definition location."
+ (if function
+ (list (list `(,kind ,name) (function-location function)))))
+
+(defun class-definitions (name)
+ "Return the definition locations for the class called NAME."
+ (if (symbolp name)
+ (let ((class (kernel::find-class name nil)))
+ (etypecase class
+ (null '())
+ (kernel::structure-class
+ (list (list `(defstruct ,name) (dd-location (find-dd name)))))
+ #+(or)
+ (conditions::condition-class
+ (list (list `(define-condition ,name)
+ (condition-class-location class))))
+ (kernel::standard-class
+ (list (list `(defclass ,name)
+ (class-location (find-class name)))))
+ ((or kernel::built-in-class
+ conditions::condition-class
+ kernel:funcallable-structure-class)
+ (list (list `(kernel::define-type-class ,name)
+ `(:error
+ ,(format nil "No source info for ~A" name)))))))))
+
+(defun class-location (class)
+ "Return the `defclass' location for CLASS."
+ (definition-source-location class (pcl:class-name class)))
+
+(defun find-dd (name)
+ "Find the defstruct-definition by the name of its structure-class."
+ (let ((layout (ext:info :type :compiler-layout name)))
+ (if layout
+ (kernel:layout-info layout))))
+
+(defun condition-class-location (class)
+ (let ((slots (conditions::condition-class-slots class))
+ (name (conditions::condition-class-name class)))
+ (cond ((null slots)
+ `(:error ,(format nil "No location info for condition: ~A" name)))
+ (t
+ ;; Find the class via one of its slot-reader methods.
+ (let* ((slot (first slots))
+ (gf (fdefinition
+ (first (conditions::condition-slot-readers slot)))))
+ (method-location
+ (first
+ (pcl:compute-applicable-methods-using-classes
+ gf (list (find-class name))))))))))
+
+(defun make-name-in-file-location (file string)
+ (multiple-value-bind (filename c)
+ (ignore-errors
+ (unix-truename (merge-pathnames (make-pathname :type "lisp")
+ file)))
+ (cond (filename (make-location `(:file ,filename)
+ `(:function-name ,(string string))))
+ (t (list :error (princ-to-string c))))))
+
+(defun source-location-form-numbers (location)
+ (c::decode-form-numbers (c::form-numbers-form-numbers location)))
+
+(defun source-location-tlf-number (location)
+ (nth-value 0 (source-location-form-numbers location)))
+
+(defun source-location-form-number (location)
+ (nth-value 1 (source-location-form-numbers location)))
+
+(defun resolve-file-source-location (location)
+ (let ((filename (c::file-source-location-pathname location))
+ (tlf-number (source-location-tlf-number location))
+ (form-number (source-location-form-number location)))
+ (with-open-file (s filename)
+ (let ((pos (form-number-stream-position tlf-number form-number s)))
+ (make-location `(:file ,(unix-truename filename))
+ `(:position ,(1+ pos)))))))
+
+(defun resolve-stream-source-location (location)
+ (let ((info (c::stream-source-location-user-info location))
+ (tlf-number (source-location-tlf-number location))
+ (form-number (source-location-form-number location)))
+ ;; XXX duplication in frame-source-location
+ (assert (info-from-emacs-buffer-p info))
+ (destructuring-bind (&key emacs-buffer emacs-buffer-string
+ emacs-buffer-offset) info
+ (with-input-from-string (s emacs-buffer-string)
+ (let ((pos (form-number-stream-position tlf-number form-number s)))
+ (make-location `(:buffer ,emacs-buffer)
+ `(:position ,(+ emacs-buffer-offset pos))))))))
+
+;; XXX predicates for 18e backward compatibilty. Remove them when
+;; we're 19a only.
+(defun file-source-location-p (object)
+ (when (fboundp 'c::file-source-location-p)
+ (c::file-source-location-p object)))
+
+(defun stream-source-location-p (object)
+ (when (fboundp 'c::stream-source-location-p)
+ (c::stream-source-location-p object)))
+
+(defun source-location-p (object)
+ (or (file-source-location-p object)
+ (stream-source-location-p object)))
+
+(defun resolve-source-location (location)
+ (etypecase location
+ ((satisfies file-source-location-p)
+ (resolve-file-source-location location))
+ ((satisfies stream-source-location-p)
+ (resolve-stream-source-location location))))
+
+(defun definition-source-location (object name)
+ (let ((source (pcl::definition-source object)))
+ (etypecase source
+ (null
+ `(:error ,(format nil "No source info for: ~A" object)))
+ ((satisfies source-location-p)
+ (resolve-source-location source))
+ (pathname
+ (make-name-in-file-location source name))
+ (cons
+ (destructuring-bind ((dg name) pathname) source
+ (declare (ignore dg))
+ (etypecase pathname
+ (pathname (make-name-in-file-location pathname (string name)))
+ (null `(:error ,(format nil "Cannot resolve: ~S" source)))))))))
+
+(defun setf-definitions (name)
+ (let ((function (or (ext:info :setf :inverse name)
+ (ext:info :setf :expander name)
+ (and (symbolp name)
+ (fboundp `(setf ,name))
+ (fdefinition `(setf ,name))))))
+ (if function
+ (list (list `(setf ,name)
+ (function-location (coerce function 'function)))))))
+
+
+(defun variable-location (symbol)
+ (multiple-value-bind (location foundp)
+ ;; XXX for 18e compatibilty. rewrite this when we drop 18e
+ ;; support.
+ (ignore-errors (eval `(ext:info :source-location :defvar ',symbol)))
+ (if (and foundp location)
+ (resolve-source-location location)
+ `(:error ,(format nil "No source info for variable ~S" symbol)))))
+
+(defun variable-definitions (name)
+ (if (symbolp name)
+ (multiple-value-bind (kind recorded-p) (ext:info :variable :kind name)
+ (if recorded-p
+ (list (list `(variable ,kind ,name)
+ (variable-location name)))))))
+
+(defun compiler-macro-definitions (symbol)
+ (maybe-make-definition (compiler-macro-function symbol)
+ 'define-compiler-macro
+ symbol))
+
+(defun source-transform-definitions (name)
+ (maybe-make-definition (ext:info :function :source-transform name)
+ 'c:def-source-transform
+ name))
+
+(defun function-info-definitions (name)
+ (let ((info (ext:info :function :info name)))
+ (if info
+ (append (loop for transform in (c::function-info-transforms info)
+ collect (list `(c:deftransform ,name
+ ,(c::type-specifier
+ (c::transform-type transform)))
+ (function-location (c::transform-function
+ transform))))
+ (maybe-make-definition (c::function-info-derive-type info)
+ 'c::derive-type name)
+ (maybe-make-definition (c::function-info-optimizer info)
+ 'c::optimizer name)
+ (maybe-make-definition (c::function-info-ltn-annotate info)
+ 'c::ltn-annotate name)
+ (maybe-make-definition (c::function-info-ir2-convert info)
+ 'c::ir2-convert name)
+ (loop for template in (c::function-info-templates info)
+ collect (list `(c::vop ,(c::template-name template))
+ (function-location
+ (c::vop-info-generator-function
+ template))))))))
+
+(defun ir1-translator-definitions (name)
+ (maybe-make-definition (ext:info :function :ir1-convert name)
+ 'c:def-ir1-translator name))
+
+
+;;;; Documentation.
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind)
+ (or (documentation symbol kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (multiple-value-bind (kind recorded-p)
+ (ext:info variable kind symbol)
+ (declare (ignore kind))
+ (if (or (boundp symbol) recorded-p)
+ (doc 'variable))))
+ (when (fboundp symbol)
+ (maybe-push
+ (cond ((macro-function symbol) :macro)
+ ((special-operator-p symbol) :special-operator)
+ ((genericp (fdefinition symbol)) :generic-function)
+ (t :function))
+ (doc 'function)))
+ (maybe-push
+ :setf (if (or (ext:info setf inverse symbol)
+ (ext:info setf expander symbol))
+ (doc 'setf)))
+ (maybe-push
+ :type (if (ext:info type kind symbol)
+ (doc 'type)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ (maybe-push
+ :alien-type (if (not (eq (ext:info alien-type kind symbol) :unknown))
+ (doc 'alien-type)))
+ (maybe-push
+ :alien-struct (if (ext:info alien-type struct symbol)
+ (doc nil)))
+ (maybe-push
+ :alien-union (if (ext:info alien-type union symbol)
+ (doc nil)))
+ (maybe-push
+ :alien-enum (if (ext:info alien-type enum symbol)
+ (doc nil)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (describe (ecase namespace
+ (:variable
+ symbol)
+ ((:function :generic-function)
+ (symbol-function symbol))
+ (:setf
+ (or (ext:info setf inverse symbol)
+ (ext:info setf expander symbol)))
+ (:type
+ (kernel:values-specifier-type symbol))
+ (:class
+ (find-class symbol))
+ (:alien-struct
+ (ext:info :alien-type :struct symbol))
+ (:alien-union
+ (ext:info :alien-type :union symbol))
+ (:alien-enum
+ (ext:info :alien-type :enum symbol))
+ (:alien-type
+ (ecase (ext:info :alien-type :kind symbol)
+ (:primitive
+ (let ((alien::*values-type-okay* t))
+ (funcall (ext:info :alien-type :translator symbol)
+ (list symbol))))
+ ((:defined)
+ (ext:info :alien-type :definition symbol))
+ (:unknown :unkown))))))
+
+;;;;; Argument lists
+
+(defimplementation arglist (fun)
+ (etypecase fun
+ (function (function-arglist fun))
+ (symbol (function-arglist (or (macro-function fun)
+ (symbol-function fun))))))
+
+(defun function-arglist (fun)
+ (let ((arglist
+ (cond ((eval:interpreted-function-p fun)
+ (eval:interpreted-function-arglist fun))
+ ((pcl::generic-function-p fun)
+ (pcl:generic-function-lambda-list fun))
+ ((c::byte-function-or-closure-p fun)
+ (byte-code-function-arglist fun))
+ ((kernel:%function-arglist (kernel:%function-self fun))
+ (handler-case (read-arglist fun)
+ (error () :not-available)))
+ ;; this should work both for compiled-debug-function
+ ;; and for interpreted-debug-function
+ (t
+ (handler-case (debug-function-arglist
+ (di::function-debug-function fun))
+ (di:unhandled-condition () :not-available))))))
+ (check-type arglist (or list (member :not-available)))
+ arglist))
+
+(defimplementation function-name (function)
+ (cond ((eval:interpreted-function-p function)
+ (eval:interpreted-function-name function))
+ ((pcl::generic-function-p function)
+ (pcl::generic-function-name function))
+ ((c::byte-function-or-closure-p function)
+ (c::byte-function-name function))
+ (t (kernel:%function-name (kernel:%function-self function)))))
+
+;;; A simple case: the arglist is available as a string that we can
+;;; `read'.
+
+(defun read-arglist (fn)
+ "Parse the arglist-string of the function object FN."
+ (let ((string (kernel:%function-arglist
+ (kernel:%function-self fn)))
+ (package (find-package
+ (c::compiled-debug-info-package
+ (kernel:%code-debug-info
+ (vm::find-code-object fn))))))
+ (with-standard-io-syntax
+ (let ((*package* (or package *package*)))
+ (read-from-string string)))))
+
+;;; A harder case: an approximate arglist is derived from available
+;;; debugging information.
+
+(defun debug-function-arglist (debug-function)
+ "Derive the argument list of DEBUG-FUNCTION from debug info."
+ (let ((args (di::debug-function-lambda-list debug-function))
+ (required '())
+ (optional '())
+ (rest '())
+ (key '()))
+ ;; collect the names of debug-vars
+ (dolist (arg args)
+ (etypecase arg
+ (di::debug-variable
+ (push (di::debug-variable-symbol arg) required))
+ ((member :deleted)
+ (push ':deleted required))
+ (cons
+ (ecase (car arg)
+ (:keyword
+ (push (second arg) key))
+ (:optional
+ (push (debug-variable-symbol-or-deleted (second arg)) optional))
+ (:rest
+ (push (debug-variable-symbol-or-deleted (second arg)) rest))))))
+ ;; intersperse lambda keywords as needed
+ (append (nreverse required)
+ (if optional (cons '&optional (nreverse optional)))
+ (if rest (cons '&rest (nreverse rest)))
+ (if key (cons '&key (nreverse key))))))
+
+(defun debug-variable-symbol-or-deleted (var)
+ (etypecase var
+ (di:debug-variable
+ (di::debug-variable-symbol var))
+ ((member :deleted)
+ '#:deleted)))
+
+(defun symbol-debug-function-arglist (fname)
+ "Return FNAME's debug-function-arglist and %function-arglist.
+A utility for debugging DEBUG-FUNCTION-ARGLIST."
+ (let ((fn (fdefinition fname)))
+ (values (debug-function-arglist (di::function-debug-function fn))
+ (kernel:%function-arglist (kernel:%function-self fn)))))
+
+;;; Deriving arglists for byte-compiled functions:
+;;;
+(defun byte-code-function-arglist (fn)
+ ;; There doesn't seem to be much arglist information around for
+ ;; byte-code functions. Use the arg-count and return something like
+ ;; (arg0 arg1 ...)
+ (etypecase fn
+ (c::simple-byte-function
+ (loop for i from 0 below (c::simple-byte-function-num-args fn)
+ collect (make-arg-symbol i)))
+ (c::hairy-byte-function
+ (hairy-byte-function-arglist fn))
+ (c::byte-closure
+ (byte-code-function-arglist (c::byte-closure-function fn)))))
+
+(defun make-arg-symbol (i)
+ (make-symbol (format nil "~A~D" (string 'arg) i)))
+
+;;; A "hairy" byte-function is one that takes a variable number of
+;;; arguments. `hairy-byte-function' is a type from the bytecode
+;;; interpreter.
+;;;
+(defun hairy-byte-function-arglist (fn)
+ (let ((counter -1))
+ (flet ((next-arg () (make-arg-symbol (incf counter))))
+ (with-struct (c::hairy-byte-function- min-args max-args rest-arg-p
+ keywords-p keywords) fn
+ (let ((arglist '())
+ (optional (- max-args min-args)))
+ ;; XXX isn't there a better way to write this?
+ ;; (Looks fine to me. -luke)
+ (dotimes (i min-args)
+ (push (next-arg) arglist))
+ (when (plusp optional)
+ (push '&optional arglist)
+ (dotimes (i optional)
+ (push (next-arg) arglist)))
+ (when rest-arg-p
+ (push '&rest arglist)
+ (push (next-arg) arglist))
+ (when keywords-p
+ (push '&key arglist)
+ (loop for (key _ __) in keywords
+ do (push key arglist))
+ (when (eq keywords-p :allow-others)
+ (push '&allow-other-keys arglist)))
+ (nreverse arglist))))))
+
+
+;;;; Miscellaneous.
+
+(defimplementation macroexpand-all (form)
+ (walker:macroexpand-all form))
+
+(defimplementation compiler-macroexpand-1 (form &optional env)
+ (ext:compiler-macroexpand-1 form env))
+
+(defimplementation compiler-macroexpand (form &optional env)
+ (ext:compiler-macroexpand form env))
+
+(defimplementation set-default-directory (directory)
+ (setf (ext:default-directory) (namestring directory))
+ ;; Setting *default-pathname-defaults* to an absolute directory
+ ;; makes the behavior of MERGE-PATHNAMES a bit more intuitive.
+ (setf *default-pathname-defaults* (pathname (ext:default-directory)))
+ (default-directory))
+
+(defimplementation default-directory ()
+ (namestring (ext:default-directory)))
+
+(defimplementation call-without-interrupts (fn)
+ (sys:without-interrupts (funcall fn)))
+
+(defimplementation getpid ()
+ (unix:unix-getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "cmucl")
+
+(defimplementation quit-lisp ()
+ (ext::quit))
+
+;;; source-path-{stream,file,string,etc}-position moved into
+;;; swank-source-path-parser
+
+
+;;;; Debugging
+
+(defvar *sldb-stack-top*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (unix:unix-sigsetmask 0)
+ (let* ((*sldb-stack-top* (or debug:*stack-top-hint* (di:top-frame)))
+ (debug:*stack-top-hint* nil)
+ (kernel:*current-level* 0))
+ (handler-bind ((di::unhandled-condition
+ (lambda (condition)
+ (error (make-condition
+ 'sldb-condition
+ :original-condition condition)))))
+ (unwind-protect
+ (progn
+ #+(or)(sys:scrub-control-stack)
+ (funcall debugger-loop-fn))
+ #+(or)(sys:scrub-control-stack)
+ ))))
+
+(defun frame-down (frame)
+ (handler-case (di:frame-down frame)
+ (di:no-debug-info () nil)))
+
+(defun nth-frame (index)
+ (do ((frame *sldb-stack-top* (frame-down frame))
+ (i index (1- i)))
+ ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum)))
+ (loop for f = (nth-frame start) then (frame-down f)
+ for i from start below end
+ while f
+ collect f)))
+
+(defimplementation print-frame (frame stream)
+ (let ((*standard-output* stream))
+ (handler-case
+ (debug::print-frame-call frame :verbosity 1 :number nil)
+ (error (e)
+ (ignore-errors (princ e stream))))))
+
+(defimplementation frame-source-location-for-emacs (index)
+ (code-location-source-location (di:frame-code-location (nth-frame index))))
+
+(defimplementation eval-in-frame (form index)
+ (di:eval-in-frame (nth-frame index) form))
+
+(defun frame-debug-vars (frame)
+ "Return a vector of debug-variables in frame."
+ (di::debug-function-debug-variables (di:frame-debug-function frame)))
+
+(defun debug-var-value (var frame location)
+ (let ((validity (di:debug-variable-validity var location)))
+ (ecase validity
+ (:valid (di:debug-variable-value var frame))
+ ((:invalid :unknown) (make-symbol (string validity))))))
+
+(defimplementation frame-locals (index)
+ (let* ((frame (nth-frame index))
+ (loc (di:frame-code-location frame))
+ (vars (frame-debug-vars frame)))
+ (loop for v across vars collect
+ (list :name (di:debug-variable-symbol v)
+ :id (di:debug-variable-id v)
+ :value (debug-var-value v frame loc)))))
+
+(defimplementation frame-var-value (frame var)
+ (let* ((frame (nth-frame frame))
+ (dvar (aref (frame-debug-vars frame) var)))
+ (debug-var-value dvar frame (di:frame-code-location frame))))
+
+(defimplementation frame-catch-tags (index)
+ (mapcar #'car (di:frame-catches (nth-frame index))))
+
+(defimplementation return-from-frame (index form)
+ (let ((sym (find-symbol (string 'find-debug-tag-for-frame)
+ :debug-internals)))
+ (if sym
+ (let* ((frame (nth-frame index))
+ (probe (funcall sym frame)))
+ (cond (probe (throw (car probe) (eval-in-frame form index)))
+ (t (format nil "Cannot return from frame: ~S" frame))))
+ "return-from-frame is not implemented in this version of CMUCL.")))
+
+(defimplementation activate-stepping (frame)
+ (set-step-breakpoints (nth-frame frame)))
+
+(defimplementation sldb-break-on-return (frame)
+ (break-on-return (nth-frame frame)))
+
+;;; We set the breakpoint in the caller which might be a bit confusing.
+;;;
+(defun break-on-return (frame)
+ (let* ((caller (di:frame-down frame))
+ (cl (di:frame-code-location caller)))
+ (flet ((hook (frame bp)
+ (when (frame-pointer= frame caller)
+ (di:delete-breakpoint bp)
+ (signal-breakpoint bp frame))))
+ (let* ((info (ecase (di:code-location-kind cl)
+ ((:single-value-return :unknown-return) nil)
+ (:known-return (debug-function-returns
+ (di:frame-debug-function frame)))))
+ (bp (di:make-breakpoint #'hook cl :kind :code-location
+ :info info)))
+ (di:activate-breakpoint bp)
+ `(:ok ,(format nil "Set breakpoint in ~A" caller))))))
+
+(defun frame-pointer= (frame1 frame2)
+ "Return true if the frame pointers of FRAME1 and FRAME2 are the same."
+ (sys:sap= (di::frame-pointer frame1) (di::frame-pointer frame2)))
+
+;;; The PC in escaped frames at a single-return-value point is
+;;; actually vm:single-value-return-byte-offset bytes after the
+;;; position given in the debug info. Here we try to recognize such
+;;; cases.
+;;;
+(defun next-code-locations (frame code-location)
+ "Like `debug::next-code-locations' but be careful in escaped frames."
+ (let ((next (debug::next-code-locations code-location)))
+ (flet ((adjust-pc ()
+ (let ((cl (di::copy-compiled-code-location code-location)))
+ (incf (di::compiled-code-location-pc cl)
+ vm:single-value-return-byte-offset)
+ cl)))
+ (cond ((and (di::compiled-frame-escaped frame)
+ (eq (di:code-location-kind code-location)
+ :single-value-return)
+ (= (length next) 1)
+ (di:code-location= (car next) (adjust-pc)))
+ (debug::next-code-locations (car next)))
+ (t
+ next)))))
+
+(defun set-step-breakpoints (frame)
+ (let ((cl (di:frame-code-location frame)))
+ (when (di:debug-block-elsewhere-p (di:code-location-debug-block cl))
+ (error "Cannot step in elsewhere code"))
+ (let* ((debug::*bad-code-location-types*
+ (remove :call-site debug::*bad-code-location-types*))
+ (next (next-code-locations frame cl)))
+ (cond (next
+ (let ((steppoints '()))
+ (flet ((hook (bp-frame bp)
+ (signal-breakpoint bp bp-frame)
+ (mapc #'di:delete-breakpoint steppoints)))
+ (dolist (code-location next)
+ (let ((bp (di:make-breakpoint #'hook code-location
+ :kind :code-location)))
+ (di:activate-breakpoint bp)
+ (push bp steppoints))))))
+ (t
+ (break-on-return frame))))))
+
+
+;; XXX the return values at return breakpoints should be passed to the
+;; user hooks. debug-int.lisp should be changed to do this cleanly.
+
+;;; The sigcontext and the PC for a breakpoint invocation are not
+;;; passed to user hook functions, but we need them to extract return
+;;; values. So we advice di::handle-breakpoint and bind the values to
+;;; special variables.
+;;;
+(defvar *breakpoint-sigcontext*)
+(defvar *breakpoint-pc*)
+
+;; XXX don't break old versions without fwrappers. Remove this one day.
+#+#.(cl:if (cl:find-package :fwrappers) '(and) '(or))
+(progn
+ (fwrappers:define-fwrapper bind-breakpoint-sigcontext (offset c sigcontext)
+ (let ((*breakpoint-sigcontext* sigcontext)
+ (*breakpoint-pc* offset))
+ (fwrappers:call-next-function)))
+ (fwrappers:set-fwrappers 'di::handle-breakpoint '())
+ (fwrappers:fwrap 'di::handle-breakpoint #'bind-breakpoint-sigcontext))
+
+(defun sigcontext-object (sc index)
+ "Extract the lisp object in sigcontext SC at offset INDEX."
+ (kernel:make-lisp-obj (vm:sigcontext-register sc index)))
+
+(defun known-return-point-values (sigcontext sc-offsets)
+ (let ((fp (system:int-sap (vm:sigcontext-register sigcontext
+ vm::cfp-offset))))
+ (system:without-gcing
+ (loop for sc-offset across sc-offsets
+ collect (di::sub-access-debug-var-slot fp sc-offset sigcontext)))))
+
+;;; CMUCL returns the first few values in registers and the rest on
+;;; the stack. In the multiple value case, the number of values is
+;;; stored in a dedicated register. The values of the registers can be
+;;; accessed in the sigcontext for the breakpoint. There are 3 kinds
+;;; of return conventions: :single-value-return, :unknown-return, and
+;;; :known-return.
+;;;
+;;; The :single-value-return convention returns the value in a
+;;; register without setting the nargs registers.
+;;;
+;;; The :unknown-return variant is used for multiple values. A
+;;; :unknown-return point consists actually of 2 breakpoints: one for
+;;; the single value case and one for the general case. The single
+;;; value breakpoint comes vm:single-value-return-byte-offset after
+;;; the multiple value breakpoint.
+;;;
+;;; The :known-return convention is used by local functions.
+;;; :known-return is currently not supported because we don't know
+;;; where the values are passed.
+;;;
+(defun breakpoint-values (breakpoint)
+ "Return the list of return values for a return point."
+ (flet ((1st (sc) (sigcontext-object sc (car vm::register-arg-offsets))))
+ (let ((sc (locally (declare (optimize (ext:inhibit-warnings 3)))
+ (alien:sap-alien *breakpoint-sigcontext* (* unix:sigcontext))))
+ (cl (di:breakpoint-what breakpoint)))
+ (ecase (di:code-location-kind cl)
+ (:single-value-return
+ (list (1st sc)))
+ (:known-return
+ (let ((info (di:breakpoint-info breakpoint)))
+ (if (vectorp info)
+ (known-return-point-values sc info)
+ (progn
+ ;;(break)
+ (list "<<known-return convention not supported>>" info)))))
+ (:unknown-return
+ (let ((mv-return-pc (di::compiled-code-location-pc cl)))
+ (if (= mv-return-pc *breakpoint-pc*)
+ (mv-function-end-breakpoint-values sc)
+ (list (1st sc)))))))))
+
+;; XXX: di::get-function-end-breakpoint-values takes 2 arguments in
+;; newer versions of CMUCL (after ~March 2005).
+(defun mv-function-end-breakpoint-values (sigcontext)
+ (let ((sym (find-symbol "FUNCTION-END-BREAKPOINT-VALUES/STANDARD" :di)))
+ (cond (sym (funcall sym sigcontext))
+ (t (di::get-function-end-breakpoint-values sigcontext)))))
+
+(defun debug-function-returns (debug-fun)
+ "Return the return style of DEBUG-FUN."
+ (let* ((cdfun (di::compiled-debug-function-compiler-debug-fun debug-fun)))
+ (c::compiled-debug-function-returns cdfun)))
+
+(define-condition breakpoint (simple-condition)
+ ((message :initarg :message :reader breakpoint.message)
+ (values :initarg :values :reader breakpoint.values))
+ (:report (lambda (c stream) (princ (breakpoint.message c) stream))))
+
+(defimplementation condition-extras (condition)
+ (typecase condition
+ (breakpoint
+ ;; pop up the source buffer
+ `((:show-frame-source 0)))
+ (t '())))
+
+(defun signal-breakpoint (breakpoint frame)
+ "Signal a breakpoint condition for BREAKPOINT in FRAME.
+Try to create a informative message."
+ (flet ((brk (values fstring &rest args)
+ (let ((msg (apply #'format nil fstring args))
+ (debug:*stack-top-hint* frame))
+ (break 'breakpoint :message msg :values values))))
+ (with-struct (di::breakpoint- kind what) breakpoint
+ (case kind
+ (:code-location
+ (case (di:code-location-kind what)
+ ((:single-value-return :known-return :unknown-return)
+ (let ((values (breakpoint-values breakpoint)))
+ (brk values "Return value: ~{~S ~}" values)))
+ (t
+ #+(or)
+ (when (eq (di:code-location-kind what) :call-site)
+ (call-site-function breakpoint frame))
+ (brk nil "Breakpoint: ~S ~S"
+ (di:code-location-kind what)
+ (di::compiled-code-location-pc what)))))
+ (:function-start
+ (brk nil "Function start breakpoint"))
+ (t (brk nil "Breakpoint: ~A in ~A" breakpoint frame))))))
+
+(defimplementation sldb-break-at-start (fname)
+ (let ((debug-fun (di:function-debug-function (coerce fname 'function))))
+ (cond ((not debug-fun)
+ `(:error ,(format nil "~S has no debug-function" fname)))
+ (t
+ (flet ((hook (frame bp &optional args cookie)
+ (declare (ignore args cookie))
+ (signal-breakpoint bp frame)))
+ (let ((bp (di:make-breakpoint #'hook debug-fun
+ :kind :function-start)))
+ (di:activate-breakpoint bp)
+ `(:ok ,(format nil "Set breakpoint in ~S" fname))))))))
+
+(defun frame-cfp (frame)
+ "Return the Control-Stack-Frame-Pointer for FRAME."
+ (etypecase frame
+ (di::compiled-frame (di::frame-pointer frame))
+ ((or di::interpreted-frame null) -1)))
+
+(defun frame-ip (frame)
+ "Return the (absolute) instruction pointer and the relative pc of FRAME."
+ (if (not frame)
+ -1
+ (let ((debug-fun (di::frame-debug-function frame)))
+ (etypecase debug-fun
+ (di::compiled-debug-function
+ (let* ((code-loc (di:frame-code-location frame))
+ (component (di::compiled-debug-function-component debug-fun))
+ (pc (di::compiled-code-location-pc code-loc))
+ (ip (sys:without-gcing
+ (sys:sap-int
+ (sys:sap+ (kernel:code-instructions component) pc)))))
+ (values ip pc)))
+ ((or di::bogus-debug-function di::interpreted-debug-function)
+ -1)))))
+
+(defun frame-registers (frame)
+ "Return the lisp registers CSP, CFP, IP, OCFP, LRA for FRAME-NUMBER."
+ (let* ((cfp (frame-cfp frame))
+ (csp (frame-cfp (di::frame-up frame)))
+ (ip (frame-ip frame))
+ (ocfp (frame-cfp (di::frame-down frame)))
+ (lra (frame-ip (di::frame-down frame))))
+ (values csp cfp ip ocfp lra)))
+
+(defun print-frame-registers (frame-number)
+ (let ((frame (di::frame-real-frame (nth-frame frame-number))))
+ (flet ((fixnum (p) (etypecase p
+ (integer p)
+ (sys:system-area-pointer (sys:sap-int p)))))
+ (apply #'format t "~
+CSP = ~X
+CFP = ~X
+IP = ~X
+OCFP = ~X
+LRA = ~X~%" (mapcar #'fixnum
+ (multiple-value-list (frame-registers frame)))))))
+
+
+(defimplementation disassemble-frame (frame-number)
+ "Return a string with the disassembly of frames code."
+ (print-frame-registers frame-number)
+ (terpri)
+ (let* ((frame (di::frame-real-frame (nth-frame frame-number)))
+ (debug-fun (di::frame-debug-function frame)))
+ (etypecase debug-fun
+ (di::compiled-debug-function
+ (let* ((component (di::compiled-debug-function-component debug-fun))
+ (fun (di:debug-function-function debug-fun)))
+ (if fun
+ (disassemble fun)
+ (disassem:disassemble-code-component component))))
+ (di::bogus-debug-function
+ (format t "~%[Disassembling bogus frames not implemented]")))))
+
+
+;;;; Inspecting
+
+(defclass cmucl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+ (make-instance 'cmucl-inspector))
+
+(defconstant +lowtag-symbols+
+ '(vm:even-fixnum-type
+ vm:function-pointer-type
+ vm:other-immediate-0-type
+ vm:list-pointer-type
+ vm:odd-fixnum-type
+ vm:instance-pointer-type
+ vm:other-immediate-1-type
+ vm:other-pointer-type)
+ "Names of the constants that specify type tags.
+The `symbol-value' of each element is a type tag.")
+
+(defconstant +header-type-symbols+
+ (labels ((suffixp (suffix string)
+ (and (>= (length string) (length suffix))
+ (string= string suffix :start1 (- (length string)
+ (length suffix)))))
+ (header-type-symbol-p (x)
+ (and (suffixp "-TYPE" (symbol-name x))
+ (not (member x +lowtag-symbols+))
+ (boundp x)
+ (typep (symbol-value x) 'fixnum))))
+ (remove-if-not #'header-type-symbol-p
+ (append (apropos-list "-TYPE" "VM")
+ (apropos-list "-TYPE" "BIGNUM"))))
+ "A list of names of the type codes in boxed objects.")
+
+(defimplementation describe-primitive-type (object)
+ (with-output-to-string (*standard-output*)
+ (let* ((lowtag (kernel:get-lowtag object))
+ (lowtag-symbol (find lowtag +lowtag-symbols+ :key #'symbol-value)))
+ (format t "lowtag: ~A" lowtag-symbol)
+ (when (member lowtag (list vm:other-pointer-type
+ vm:function-pointer-type
+ vm:other-immediate-0-type
+ vm:other-immediate-1-type
+ ))
+ (let* ((type (kernel:get-type object))
+ (type-symbol (find type +header-type-symbols+
+ :key #'symbol-value)))
+ (format t ", type: ~A" type-symbol))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+ (cond ((di::indirect-value-cell-p o)
+ (values (format nil "~A is a value cell." o)
+ `("Value: " (:value ,(c:value-cell-ref o)))))
+ ((alien::alien-value-p o)
+ (inspect-alien-value o))
+ (t
+ (cmucl-inspect o))))
+
+(defun cmucl-inspect (o)
+ (destructuring-bind (text labeledp . parts) (inspect::describe-parts o)
+ (values (format nil "~A~%" text)
+ (if labeledp
+ (loop for (label . value) in parts
+ append (label-value-line label value))
+ (loop for value in parts for i from 0
+ append (label-value-line i value))))))
+
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (let ((header (kernel:get-type o)))
+ (cond ((= header vm:function-header-type)
+ (values (format nil "~A is a function." o)
+ (append (label-value-line*
+ ("Self" (kernel:%function-self o))
+ ("Next" (kernel:%function-next o))
+ ("Name" (kernel:%function-name o))
+ ("Arglist" (kernel:%function-arglist o))
+ ("Type" (kernel:%function-type o))
+ ("Code" (kernel:function-code-header o)))
+ (list
+ (with-output-to-string (s)
+ (disassem:disassemble-function o :stream s))))))
+ ((= header vm:closure-header-type)
+ (values (format nil "~A is a closure" o)
+ (append
+ (label-value-line "Function" (kernel:%closure-function o))
+ `("Environment:" (:newline))
+ (loop for i from 0 below (1- (kernel:get-closure-length o))
+ append (label-value-line
+ i (kernel:%closure-index-ref o i))))))
+ ((eval::interpreted-function-p o)
+ (cmucl-inspect o))
+ (t
+ (call-next-method)))))
+
+(defmethod inspect-for-emacs ((o kernel:funcallable-instance)
+ (i backend-inspector))
+ (declare (ignore i))
+ (values
+ (format nil "~A is a funcallable-instance." o)
+ (append (label-value-line*
+ (:function (kernel:%funcallable-instance-function o))
+ (:lexenv (kernel:%funcallable-instance-lexenv o))
+ (:layout (kernel:%funcallable-instance-layout o)))
+ (nth-value 1 (cmucl-inspect o)))))
+
+(defmethod inspect-for-emacs ((o kernel:code-component) (_ backend-inspector))
+ (declare (ignore _))
+ (values (format nil "~A is a code data-block." o)
+ (append
+ (label-value-line*
+ ("code-size" (kernel:%code-code-size o))
+ ("entry-points" (kernel:%code-entry-points o))
+ ("debug-info" (kernel:%code-debug-info o))
+ ("trace-table-offset" (kernel:code-header-ref
+ o vm:code-trace-table-offset-slot)))
+ `("Constants:" (:newline))
+ (loop for i from vm:code-constants-offset
+ below (kernel:get-header-data o)
+ append (label-value-line i (kernel:code-header-ref o i)))
+ `("Code:" (:newline)
+ , (with-output-to-string (s)
+ (cond ((kernel:%code-debug-info o)
+ (disassem:disassemble-code-component o :stream s))
+ (t
+ (disassem:disassemble-memory
+ (disassem::align
+ (+ (logandc2 (kernel:get-lisp-obj-address o)
+ vm:lowtag-mask)
+ (* vm:code-constants-offset vm:word-bytes))
+ (ash 1 vm:lowtag-bits))
+ (ash (kernel:%code-code-size o) vm:word-shift)
+ :stream s))))))))
+
+(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (values (format nil "~A is a fdenf object." o)
+ (label-value-line*
+ ("name" (kernel:fdefn-name o))
+ ("function" (kernel:fdefn-function o))
+ ("raw-addr" (sys:sap-ref-32
+ (sys:int-sap (kernel:get-lisp-obj-address o))
+ (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
+
+(defmethod inspect-for-emacs ((o array) (inspector backend-inspector))
+ inspector
+ (if (typep o 'simple-array)
+ (call-next-method)
+ (values (format nil "~A is an array." o)
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:rank (array-rank o))
+ (:fill-pointer (kernel:%array-fill-pointer o))
+ (:fill-pointer-p (kernel:%array-fill-pointer-p o))
+ (:elements (kernel:%array-available-elements o))
+ (:data (kernel:%array-data-vector o))
+ (:displacement (kernel:%array-displacement o))
+ (:displaced-p (kernel:%array-displaced-p o))
+ (:dimensions (array-dimensions o))))))
+
+(defmethod inspect-for-emacs ((o simple-vector) (inspector backend-inspector))
+ inspector
+ (values (format nil "~A is a simple-vector." o)
+ (append
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:length (c::vector-length o)))
+ (loop for i below (length o)
+ append (label-value-line i (aref o i))))))
+
+(defun inspect-alien-record (alien)
+ (values
+ (format nil "~A is an alien value." alien)
+ (with-struct (alien::alien-value- sap type) alien
+ (with-struct (alien::alien-record-type- kind name fields) type
+ (append
+ (label-value-line*
+ (:sap sap)
+ (:kind kind)
+ (:name name))
+ (loop for field in fields
+ append (let ((slot (alien::alien-record-field-name field)))
+ (label-value-line slot (alien:slot alien slot)))))))))
+
+(defun inspect-alien-pointer (alien)
+ (values
+ (format nil "~A is an alien value." alien)
+ (with-struct (alien::alien-value- sap type) alien
+ (label-value-line*
+ (:sap sap)
+ (:type type)
+ (:to (alien::deref alien))))))
+
+(defun inspect-alien-value (alien)
+ (typecase (alien::alien-value-type alien)
+ (alien::alien-record-type (inspect-alien-record alien))
+ (alien::alien-pointer-type (inspect-alien-pointer alien))
+ (t (cmucl-inspect alien))))
+
+;;;; Profiling
+(defimplementation profile (fname)
+ (eval `(profile:profile ,fname)))
+
+(defimplementation unprofile (fname)
+ (eval `(profile:unprofile ,fname)))
+
+(defimplementation unprofile-all ()
+ (eval `(profile:unprofile))
+ "All functions unprofiled.")
+
+(defimplementation profile-report ()
+ (eval `(profile:report-time)))
+
+(defimplementation profile-reset ()
+ (eval `(profile:reset-time))
+ "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+ profile:*timed-functions*)
+
+(defimplementation profile-package (package callers methods)
+ (profile:profile-all :package package
+ :callers-p callers
+ #-cmu18e :methods #-cmu18e methods))
+
+
+;;;; Multiprocessing
+
+#+mp
+(progn
+ (defimplementation initialize-multiprocessing (continuation)
+ (mp::init-multi-processing)
+ (mp:make-process continuation :name "swank")
+ ;; Threads magic: this never returns! But top-level becomes
+ ;; available again.
+ (unless mp::*idle-process*
+ (mp::startup-idle-and-top-level-loops)))
+
+ (defimplementation spawn (fn &key name)
+ (mp:make-process fn :name (or name "Anonymous")))
+
+ (defvar *thread-id-counter* 0)
+
+ (defimplementation thread-id (thread)
+ (or (getf (mp:process-property-list thread) 'id)
+ (setf (getf (mp:process-property-list thread) 'id)
+ (incf *thread-id-counter*))))
+
+ (defimplementation find-thread (id)
+ (find id (all-threads)
+ :key (lambda (p) (getf (mp:process-property-list p) 'id))))
+
+ (defimplementation thread-name (thread)
+ (mp:process-name thread))
+
+ (defimplementation thread-status (thread)
+ (mp:process-whostate thread))
+
+ (defimplementation current-thread ()
+ mp:*current-process*)
+
+ (defimplementation all-threads ()
+ (copy-list mp:*all-processes*))
+
+ (defimplementation interrupt-thread (thread fn)
+ (mp:process-interrupt thread fn))
+
+ (defimplementation kill-thread (thread)
+ (mp:destroy-process thread))
+
+ (defvar *mailbox-lock* (mp:make-lock "mailbox lock"))
+
+ (defstruct (mailbox (:conc-name mailbox.))
+ (mutex (mp:make-lock "process mailbox"))
+ (queue '() :type list))
+
+ (defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (mp:with-lock-held (*mailbox-lock*)
+ (or (getf (mp:process-property-list thread) 'mailbox)
+ (setf (getf (mp:process-property-list thread) 'mailbox)
+ (make-mailbox)))))
+
+ (defimplementation send (thread message)
+ (let* ((mbox (mailbox thread))
+ (mutex (mailbox.mutex mbox)))
+ (mp:with-lock-held (mutex)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message))))))
+
+ (defimplementation receive ()
+ (let* ((mbox (mailbox mp:*current-process*))
+ (mutex (mailbox.mutex mbox)))
+ (mp:process-wait "receive" #'mailbox.queue mbox)
+ (mp:with-lock-held (mutex)
+ (pop (mailbox.queue mbox)))))
+
+ ) ;; #+mp
+
+
+
+;;;; GC hooks
+;;;
+;;; Display GC messages in the echo area to avoid cluttering the
+;;; normal output.
+;;;
+
+;; this should probably not be here, but where else?
+(defun background-message (message)
+ (funcall (find-symbol (string :background-message) :swank)
+ message))
+
+(defun print-bytes (nbytes &optional stream)
+ "Print the number NBYTES to STREAM in KB, MB, or GB units."
+ (let ((names '((0 bytes) (10 kb) (20 mb) (30 gb) (40 tb) (50 eb))))
+ (multiple-value-bind (power name)
+ (loop for ((p1 n1) (p2 n2)) on names
+ while n2 do
+ (when (<= (expt 2 p1) nbytes (1- (expt 2 p2)))
+ (return (values p1 n1))))
+ (cond (name
+ (format stream "~,1F ~A" (/ nbytes (expt 2 power)) name))
+ (t
+ (format stream "~:D bytes" nbytes))))))
+
+(defconstant gc-generations 6)
+
+#+gencgc
+(defun generation-stats ()
+ "Return a string describing the size distribution among the generations."
+ (let* ((alloc (loop for i below gc-generations
+ collect (lisp::gencgc-stats i)))
+ (sum (coerce (reduce #'+ alloc) 'float)))
+ (format nil "~{~3F~^/~}"
+ (mapcar (lambda (size) (/ size sum))
+ alloc))))
+
+(defvar *gc-start-time* 0)
+
+(defun pre-gc-hook (bytes-in-use)
+ (setq *gc-start-time* (get-internal-real-time))
+ (let ((msg (format nil "[Commencing GC with ~A in use.]"
+ (print-bytes bytes-in-use))))
+ (background-message msg)))
+
+(defun post-gc-hook (bytes-retained bytes-freed trigger)
+ (declare (ignore trigger))
+ (let* ((seconds (/ (- (get-internal-real-time) *gc-start-time*)
+ internal-time-units-per-second))
+ (msg (format nil "[GC done. ~A freed ~A retained ~A ~4F sec]"
+ (print-bytes bytes-freed)
+ (print-bytes bytes-retained)
+ #+gencgc(generation-stats)
+ #-gencgc""
+ seconds)))
+ (background-message msg)))
+
+(defun install-gc-hooks ()
+ (setq ext:*gc-notify-before* #'pre-gc-hook)
+ (setq ext:*gc-notify-after* #'post-gc-hook))
+
+(defun remove-gc-hooks ()
+ (setq ext:*gc-notify-before* #'lisp::default-gc-notify-before)
+ (setq ext:*gc-notify-after* #'lisp::default-gc-notify-after))
+
+(defvar *install-gc-hooks* t
+ "If non-nil install GC hooks")
+
+(defimplementation emacs-connected ()
+ (when *install-gc-hooks*
+ (install-gc-hooks)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;Trace implementations
+;;In CMUCL, we have:
+;; (trace <name>)
+;; (trace (method <name> <qualifier>? (<specializer>+)))
+;; (trace :methods t '<name>) ;;to trace all methods of the gf <name>
+;; <name> can be a normal name or a (setf name)
+
+(defun tracedp (spec)
+ (member spec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (spec &rest options)
+ (cond ((tracedp spec)
+ (eval `(untrace ,spec))
+ (format nil "~S is now untraced." spec))
+ (t
+ (eval `(trace ,spec ,@options))
+ (format nil "~S is now traced." spec))))
+
+(defimplementation toggle-trace (spec)
+ (ecase (car spec)
+ ((setf)
+ (toggle-trace-aux spec))
+ ((:defgeneric)
+ (let ((name (second spec)))
+ (toggle-trace-aux name :methods name)))
+ ((:defmethod)
+ (cond ((fboundp `(method ,@(cdr spec)))
+ (toggle-trace-aux `(method ,(cdr spec))))
+ ;; Man, is this ugly
+ ((fboundp `(pcl::fast-method ,@(cdr spec)))
+ (toggle-trace-aux `(pcl::fast-method ,@(cdr spec))))
+ (t
+ (error 'undefined-function :name (cdr spec)))))
+ ((:call)
+ (destructuring-bind (caller callee) (cdr spec)
+ (toggle-trace-aux (process-fspec callee)
+ :wherein (list (process-fspec caller)))))
+ ;; doesn't work properly
+ ;; ((:labels :flet) (toggle-trace-aux (process-fspec spec)))
+ ))
+
+(defun process-fspec (fspec)
+ (cond ((consp fspec)
+ (ecase (first fspec)
+ ((:defun :defgeneric) (second fspec))
+ ((:defmethod)
+ `(method ,(second fspec) ,@(third fspec) ,(fourth fspec)))
+ ((:labels) `(labels ,(third fspec) ,(process-fspec (second fspec))))
+ ((:flet) `(flet ,(third fspec) ,(process-fspec (second fspec))))))
+ (t
+ fspec)))
+
+;;; Weak datastructures
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak-p t args))
+
+;; Local Variables:
+;; pbook-heading-regexp: "^;;;\\(;+\\)"
+;; pbook-commentary-regexp: "^;;;\\($\\|[^;]\\)"
+;; End:
Added: branches/trunk-reorg/thirdparty/slime/swank-corman.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-corman.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-corman.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,580 @@
+;;;
+;;; swank-corman.lisp --- Corman Lisp specific code for SLIME.
+;;;
+;;; Copyright (C) 2004, 2005 Espen Wiborg (espenhw(a)grumblesmurf.org)
+;;;
+;;; License
+;;; =======
+;;; This software is provided 'as-is', without any express or implied
+;;; warranty. In no event will the author be held liable for any damages
+;;; arising from the use of this software.
+;;;
+;;; Permission is granted to anyone to use this software for any purpose,
+;;; including commercial applications, and to alter it and redistribute
+;;; it freely, subject to the following restrictions:
+;;;
+;;; 1. The origin of this software must not be misrepresented; you must
+;;; not claim that you wrote the original software. If you use this
+;;; software in a product, an acknowledgment in the product documentation
+;;; would be appreciated but is not required.
+;;;
+;;; 2. Altered source versions must be plainly marked as such, and must
+;;; not be misrepresented as being the original software.
+;;;
+;;; 3. This notice may not be removed or altered from any source
+;;; distribution.
+;;;
+;;; Notes
+;;; =====
+;;; You will need CCL 2.51, and you will *definitely* need to patch
+;;; CCL with the patches at
+;;; http://www.grumblesmurf.org/lisp/corman-patches, otherwise SLIME
+;;; will blow up in your face. You should also follow the
+;;; instructions on http://www.grumblesmurf.org/lisp/corman-slime.
+;;;
+;;; The only communication style currently supported is NIL.
+;;;
+;;; Starting CCL inside emacs (with M-x slime) seems to work for me
+;;; with Corman Lisp 2.51, but I have seen random failures with 2.5
+;;; (sometimes it works, other times it hangs on start or hangs when
+;;; initializing WinSock) - starting CCL externally and using M-x
+;;; slime-connect always works fine.
+;;;
+;;; Sometimes CCL gets confused and starts giving you random memory
+;;; access violation errors on startup; if this happens, try redumping
+;;; your image.
+;;;
+;;; What works
+;;; ==========
+;;; * Basic editing and evaluation
+;;; * Arglist display
+;;; * Compilation
+;;; * Loading files
+;;; * apropos/describe
+;;; * Debugger
+;;; * Inspector
+;;;
+;;; TODO
+;;; ====
+;;; * More debugger functionality (missing bits: restart-frame,
+;;; return-from-frame, disassemble-frame, activate-stepping,
+;;; toggle-trace)
+;;; * XREF
+;;; * Profiling
+;;; * More sophisticated communication styles than NIL
+;;;
+
+(in-package :swank-backend)
+
+;;; Pull in various needed bits
+(require :composite-streams)
+(require :sockets)
+(require :winbase)
+(require :lp)
+
+(use-package :gs)
+
+;; MOP stuff
+
+(defclass swank-mop:standard-slot-definition ()
+ ()
+ (:documentation "Dummy class created so that swank.lisp will compile and load."))
+
+(defun named-by-gensym-p (c)
+ (null (symbol-package (class-name c))))
+
+(deftype swank-mop:eql-specializer ()
+ '(satisfies named-by-gensym-p))
+
+(defun swank-mop:eql-specializer-object (specializer)
+ (with-hash-table-iterator (next-entry cl::*clos-singleton-specializers*)
+ (loop (multiple-value-bind (more key value)
+ (next-entry)
+ (unless more (return nil))
+ (when (eq specializer value)
+ (return key))))))
+
+(defun swank-mop:class-finalized-p (class)
+ (declare (ignore class))
+ t)
+
+(defun swank-mop:class-prototype (class)
+ (make-instance class))
+
+(defun swank-mop:specializer-direct-methods (obj)
+ (declare (ignore obj))
+ nil)
+
+(defun swank-mop:generic-function-argument-precedence-order (gf)
+ (generic-function-lambda-list gf))
+
+(defun swank-mop:generic-function-method-combination (gf)
+ (declare (ignore gf))
+ :standard)
+
+(defun swank-mop:generic-function-declarations (gf)
+ (declare (ignore gf))
+ nil)
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (declare (ignore slot))
+ (getf slot :documentation nil))
+
+(defun swank-mop:slot-definition-type (slot)
+ (declare (ignore slot))
+ t)
+
+(import-swank-mop-symbols :cl '(;; classes
+ :standard-slot-definition
+ :eql-specializer
+ :eql-specializer-object
+ ;; standard class readers
+ :class-default-initargs
+ :class-direct-default-initargs
+ :class-finalized-p
+ :class-prototype
+ :specializer-direct-methods
+ ;; gf readers
+ :generic-function-argument-precedence-order
+ :generic-function-declarations
+ :generic-function-method-combination
+ ;; method readers
+ ;; slot readers
+ :slot-definition-documentation
+ :slot-definition-type))
+
+;;;; swank implementations
+
+;;; Debugger
+
+(defvar *stack-trace* nil)
+(defvar *frame-trace* nil)
+
+(defstruct frame
+ name function address debug-info variables)
+
+(defimplementation call-with-debugging-environment (fn)
+ (let* ((real-stack-trace (cl::stack-trace))
+ (*stack-trace* (cdr (member 'cl:invoke-debugger real-stack-trace
+ :key #'car)))
+ (*frame-trace*
+ (let* ((db::*debug-level* (1+ db::*debug-level*))
+ (db::*debug-frame-pointer* (db::stash-ebp
+ (ct:create-foreign-ptr)))
+ (db::*debug-max-level* (length real-stack-trace))
+ (db::*debug-min-level* 1))
+ (cdr (member #'cl:invoke-debugger
+ (cons
+ (make-frame :function nil)
+ (loop for i from db::*debug-min-level*
+ upto db::*debug-max-level*
+ until (eq (db::get-frame-function i) cl::*top-level*)
+ collect
+ (make-frame :function (db::get-frame-function i)
+ :address (db::get-frame-address i))))
+ :key #'frame-function)))))
+ (funcall fn)))
+
+(defimplementation compute-backtrace (start end)
+ (subseq *stack-trace* start (min end (length *stack-trace*))))
+
+(defimplementation print-frame (frame stream)
+ (format stream "~S" frame))
+
+(defun get-frame-debug-info (frame)
+ (or (frame-debug-info frame)
+ (setf (frame-debug-info frame)
+ (db::prepare-frame-debug-info (frame-function frame)
+ (frame-address frame)))))
+
+(defimplementation frame-locals (frame-number)
+ (let* ((frame (elt *frame-trace* frame-number))
+ (info (get-frame-debug-info frame)))
+ (let ((var-list
+ (loop for i from 4 below (length info) by 2
+ collect `(list :name ',(svref info i) :id 0
+ :value (db::debug-filter ,(svref info i))))))
+ (let ((vars (eval-in-frame `(list ,@var-list) frame-number)))
+ (setf (frame-variables frame) vars)))))
+
+(defimplementation eval-in-frame (form frame-number)
+ (let ((frame (elt *frame-trace* frame-number)))
+ (let ((cl::*compiler-environment* (get-frame-debug-info frame)))
+ (eval form))))
+
+(defimplementation frame-catch-tags (index)
+ (declare (ignore index))
+ nil)
+
+(defimplementation frame-var-value (frame-number var)
+ (let ((vars (frame-variables (elt *frame-trace* frame-number))))
+ (when vars
+ (second (elt vars var)))))
+
+(defimplementation frame-source-location-for-emacs (frame-number)
+ (fspec-location (frame-function (elt *frame-trace* frame-number))))
+
+(defun break (&optional (format-control "Break") &rest format-arguments)
+ (with-simple-restart (continue "Return from BREAK.")
+ (let ();(*debugger-hook* nil))
+ (let ((condition
+ (make-condition 'simple-condition
+ :format-control format-control
+ :format-arguments format-arguments)))
+ ;;(format *debug-io* ";;; User break: ~A~%" condition)
+ (invoke-debugger condition))))
+ nil)
+
+;;; Socket communication
+
+(defimplementation create-socket (host port)
+ (sockets:start-sockets)
+ (sockets:make-server-socket :host host :port port))
+
+(defimplementation local-port (socket)
+ (sockets:socket-port socket))
+
+(defimplementation close-socket (socket)
+ (close socket))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (declare (ignore buffering timeout external-format))
+ (sockets:make-socket-stream (sockets:accept-socket socket)))
+
+;;; Misc
+
+(defimplementation preferred-communication-style ()
+ nil)
+
+(defimplementation getpid ()
+ ccl:*current-process-id*)
+
+(defimplementation lisp-implementation-type-name ()
+ "cormanlisp")
+
+(defimplementation quit-lisp ()
+ (sockets:stop-sockets)
+ (win32:exitprocess 0))
+
+(defimplementation set-default-directory (directory)
+ (setf (ccl:current-directory) directory)
+ (directory-namestring (setf *default-pathname-defaults*
+ (truename (merge-pathnames directory)))))
+
+(defimplementation default-directory ()
+ (directory-namestring (ccl:current-directory)))
+
+(defimplementation macroexpand-all (form)
+ (ccl:macroexpand-all form))
+
+;;; Documentation
+
+(defun fspec-location (fspec)
+ (when (symbolp fspec)
+ (setq fspec (symbol-function fspec)))
+ (let ((file (ccl::function-source-file fspec)))
+ (if file
+ (handler-case
+ (let ((truename (truename
+ (merge-pathnames file
+ ccl:*cormanlisp-directory*))))
+ (make-location (list :file (namestring truename))
+ (if (ccl::function-source-line fspec)
+ (list :line
+ (1+ (ccl::function-source-line fspec)))
+ (list :function-name (princ-to-string
+ (function-name fspec))))))
+ (error (c) (list :error (princ-to-string c))))
+ (list :error (format nil "No source information available for ~S"
+ fspec)))))
+
+(defimplementation find-definitions (name)
+ (list (list name (fspec-location name))))
+
+(defimplementation arglist (name)
+ (handler-case
+ (cond ((and (symbolp name)
+ (macro-function name))
+ (ccl::macro-lambda-list (symbol-function name)))
+ (t
+ (when (symbolp name)
+ (setq name (symbol-function name)))
+ (if (eq (class-of name) cl::the-class-standard-gf)
+ (generic-function-lambda-list name)
+ (ccl:function-lambda-list name))))
+ (error () :not-available)))
+
+(defimplementation function-name (fn)
+ (handler-case (getf (cl::function-info-list fn) 'cl::function-name)
+ (error () nil)))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind &optional (sym symbol))
+ (or (documentation sym kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (maybe-push
+ :function (if (fboundp symbol)
+ (doc 'function)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:class
+ (describe (find-class symbol)))))
+
+;;; Compiler
+
+(defvar *buffer-name* nil)
+(defvar *buffer-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename* nil)
+
+;; FIXME
+(defimplementation call-with-compilation-hooks (FN)
+ (handler-bind ((error (lambda (c)
+ (signal (make-condition
+ 'compiler-condition
+ :original-condition c
+ :severity :warning
+ :message (format nil "~A" c)
+ :location
+ (cond (*buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :position *buffer-position*)))
+ (*compile-filename*
+ (make-location
+ (list :file *compile-filename*)
+ (list :position 1)))
+ (t
+ (list :error "No location"))))))))
+ (funcall fn)))
+
+(defimplementation swank-compile-file (*compile-filename* load-p
+ external-format)
+ (declare (ignore external-format))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil))
+ (compile-file *compile-filename*)
+ (when load-p
+ (load (compile-file-pathname *compile-filename*))))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ (declare (ignore directory))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-position* position)
+ (*buffer-string* string))
+ (funcall (compile nil (read-from-string
+ (format nil "(~S () ~A)" 'lambda string)))))))
+
+;;;; Inspecting
+
+;; Hack to make swank.lisp load, at least
+(defclass file-stream ())
+
+(defclass corman-inspector (backend-inspector)
+ ())
+
+(defimplementation make-default-inspector ()
+ (make-instance 'corman-inspector))
+
+(defun comma-separated (list &optional (callback (lambda (v)
+ `(:value ,v))))
+ (butlast (loop for e in list
+ collect (funcall callback e)
+ collect ", ")))
+
+(defmethod inspect-for-emacs ((class standard-class)
+ (inspector backend-inspector))
+ (declare (ignore inspector))
+ (values "A class."
+ `("Name: " (:value ,(class-name class))
+ (:newline)
+ "Super classes: "
+ ,@(comma-separated (swank-mop:class-direct-superclasses class))
+ (:newline)
+ "Direct Slots: "
+ ,@(comma-separated
+ (swank-mop:class-direct-slots class)
+ (lambda (slot)
+ `(:value ,slot ,(princ-to-string (swank-mop:slot-definition-name slot)))))
+ (:newline)
+ "Effective Slots: "
+ ,@(if (swank-mop:class-finalized-p class)
+ (comma-separated
+ (swank-mop:class-slots class)
+ (lambda (slot)
+ `(:value ,slot ,(princ-to-string
+ (swank-mop:slot-definition-name slot)))))
+ '("#<N/A (class not finalized)>"))
+ (:newline)
+ ,@(when (documentation class t)
+ `("Documentation:" (:newline) ,(documentation class t) (:newline)))
+ "Sub classes: "
+ ,@(comma-separated (swank-mop:class-direct-subclasses class)
+ (lambda (sub)
+ `(:value ,sub ,(princ-to-string (class-name sub)))))
+ (:newline)
+ "Precedence List: "
+ ,@(if (swank-mop:class-finalized-p class)
+ (comma-separated (swank-mop:class-precedence-list class)
+ (lambda (class)
+ `(:value ,class ,(princ-to-string (class-name class)))))
+ '("#<N/A (class not finalized)>"))
+ (:newline))))
+
+(defmethod inspect-for-emacs ((slot cons) (inspector backend-inspector))
+ ;; Inspects slot definitions
+ (declare (ignore inspector))
+ (if (eq (car slot) :name)
+ (values "A slot."
+ `("Name: " (:value ,(swank-mop:slot-definition-name slot))
+ (:newline)
+ ,@(when (swank-mop:slot-definition-documentation slot)
+ `("Documentation:" (:newline)
+ (:value ,(swank-mop:slot-definition-documentation slot))
+ (:newline)))
+ "Init args: " (:value ,(swank-mop:slot-definition-initargs slot)) (:newline)
+ "Init form: " ,(if (swank-mop:slot-definition-initfunction slot)
+ `(:value ,(swank-mop:slot-definition-initform slot))
+ "#<unspecified>") (:newline)
+ "Init function: " (:value ,(swank-mop:slot-definition-initfunction slot))
+ (:newline)))
+ (call-next-method)))
+
+(defmethod inspect-for-emacs ((pathname pathnames::pathname-internal)
+ inspector)
+ (declare (ignore inspector))
+ (values (if (wild-pathname-p pathname)
+ "A wild pathname."
+ "A pathname.")
+ (append (label-value-line*
+ ("Namestring" (namestring pathname))
+ ("Host" (pathname-host pathname))
+ ("Device" (pathname-device pathname))
+ ("Directory" (pathname-directory pathname))
+ ("Name" (pathname-name pathname))
+ ("Type" (pathname-type pathname))
+ ("Version" (pathname-version pathname)))
+ (unless (or (wild-pathname-p pathname)
+ (not (probe-file pathname)))
+ (label-value-line "Truename" (truename pathname))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+ (cond ((cl::structurep o) (inspect-structure o))
+ (t (call-next-method))))
+
+(defun inspect-structure (o)
+ (values
+ (format nil "~A is a structure" o)
+ (let* ((template (cl::uref o 1))
+ (num-slots (cl::struct-template-num-slots template)))
+ (cond ((symbolp template)
+ (loop for i below num-slots
+ append (label-value-line i (cl::uref o (+ 2 i)))))
+ (t
+ (loop for i below num-slots
+ append (label-value-line (elt template (+ 6 (* i 5)))
+ (cl::uref o (+ 2 i)))))))))
+
+
+;;; Threads
+
+(require 'threads)
+
+(defstruct (mailbox (:conc-name mailbox.))
+ thread
+ (lock (make-instance 'threads:critical-section))
+ (queue '() :type list))
+
+(defvar *mailbox-lock* (make-instance 'threads:critical-section))
+(defvar *mailboxes* (list))
+
+(defmacro with-lock (lock &body body)
+ `(threads:with-synchronization (threads:cs ,lock)
+ ,@body))
+
+(defimplementation spawn (fun &key name)
+ (declare (ignore name))
+ (th:create-thread
+ (lambda ()
+ (handler-bind ((serious-condition #'invoke-debugger))
+ (unwind-protect (funcall fun)
+ (with-lock *mailbox-lock*
+ (setq *mailboxes* (remove cormanlisp:*current-thread-id*
+ *mailboxes* :key #'mailbox.thread))))))))
+
+(defimplementation thread-id (thread)
+ thread)
+
+(defimplementation find-thread (thread)
+ (if (thread-alive-p thread)
+ thread))
+
+(defimplementation thread-alive-p (thread)
+ (if (threads:thread-handle thread) t nil))
+
+(defimplementation current-thread ()
+ cormanlisp:*current-thread-id*)
+
+;; XXX implement it
+(defimplementation all-threads ()
+ '())
+
+;; XXX something here is broken
+(defimplementation kill-thread (thread)
+ (threads:terminate-thread thread 'killed))
+
+(defun mailbox (thread)
+ (with-lock *mailbox-lock*
+ (or (find thread *mailboxes* :key #'mailbox.thread)
+ (let ((mb (make-mailbox :thread thread)))
+ (push mb *mailboxes*)
+ mb))))
+
+(defimplementation send (thread message)
+ (let ((mbox (mailbox thread)))
+ (with-lock (mailbox.lock mbox)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message))))))
+
+(defimplementation receive ()
+ (let ((mbox (mailbox cormanlisp:*current-thread-id*)))
+ (loop
+ (with-lock (mailbox.lock mbox)
+ (when (mailbox.queue mbox)
+ (return (pop (mailbox.queue mbox)))))
+ (sleep 0.1))))
+
+
+;;; This is probably not good, but it WFM
+(in-package :common-lisp)
+
+(defvar *old-documentation* #'documentation)
+(defun documentation (thing &optional (type 'function))
+ (if (symbolp thing)
+ (funcall *old-documentation* thing type)
+ (values)))
+
+(defmethod print-object ((restart restart) stream)
+ (if (or *print-escape*
+ *print-readably*)
+ (print-unreadable-object (restart stream :type t :identity t)
+ (princ (restart-name restart) stream))
+ (when (functionp (restart-report-function restart))
+ (funcall (restart-report-function restart) stream))))
Added: branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,246 @@
+;;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-ecl.lisp --- SLIME backend for ECL.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+;;; Administrivia
+
+(in-package :swank-backend)
+
+(import-from :ext *gray-stream-symbols* :swank-backend)
+
+(swank-backend::import-swank-mop-symbols :clos
+ '(:eql-specializer
+ :eql-specializer-object
+ :generic-function-declarations
+ :specializer-direct-methods
+ :compute-applicable-methods-using-classes))
+
+
+;;;; TCP Server
+
+(require 'sockets)
+
+(defun resolve-hostname (name)
+ (car (sb-bsd-sockets:host-ent-addresses
+ (sb-bsd-sockets:get-host-by-name name))))
+
+(defimplementation create-socket (host port)
+ (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream
+ :protocol :tcp)))
+ (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
+ (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
+ (sb-bsd-sockets:socket-listen socket 5)
+ socket))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (sb-bsd-sockets:socket-name socket)))
+
+(defimplementation close-socket (socket)
+ (sb-bsd-sockets:socket-close socket))
+
+(defimplementation accept-connection (socket
+ &key external-format
+ buffering timeout)
+ (declare (ignore buffering timeout external-format))
+ (make-socket-io-stream (accept socket)))
+
+(defun make-socket-io-stream (socket)
+ (sb-bsd-sockets:socket-make-stream socket
+ :output t
+ :input t
+ :element-type 'base-char))
+
+(defun accept (socket)
+ "Like socket-accept, but retry on EAGAIN."
+ (loop (handler-case
+ (return (sb-bsd-sockets:socket-accept socket))
+ (sb-bsd-sockets:interrupted-error ()))))
+
+(defimplementation preferred-communication-style ()
+ (values nil))
+
+
+;;;; Unix signals
+
+(defimplementation getpid ()
+ (si:getpid))
+
+#+nil
+(defimplementation set-default-directory (directory)
+ (ext::chdir (namestring directory))
+ ;; Setting *default-pathname-defaults* to an absolute directory
+ ;; makes the behavior of MERGE-PATHNAMES a bit more intuitive.
+ (setf *default-pathname-defaults* (ext::getcwd))
+ (default-directory))
+
+#+nil
+(defimplementation default-directory ()
+ (namestring (ext:getcwd)))
+
+(defimplementation quit-lisp ()
+ (ext:quit))
+
+
+;;;; Compilation
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename*)
+
+(defun signal-compiler-condition (&rest args)
+ (signal (apply #'make-condition 'compiler-condition args)))
+
+(defun handle-compiler-warning (condition)
+ (signal-compiler-condition
+ :original-condition condition
+ :message (format nil "~A" condition)
+ :severity :warning
+ :location
+ (if *buffer-name*
+ (make-location (list :buffer *buffer-name*)
+ (list :position *buffer-start-position*))
+ ;; ;; compiler::*current-form*
+ ;; (if compiler::*current-function*
+ ;; (make-location (list :file *compile-filename*)
+ ;; (list :function-name
+ ;; (symbol-name
+ ;; (slot-value compiler::*current-function*
+ ;; 'compiler::name))))
+ (list :error "No location found.")
+ ;; )
+ )))
+
+(defimplementation call-with-compilation-hooks (function)
+ (handler-bind ((warning #'handle-compiler-warning))
+ (funcall function)))
+
+(defimplementation swank-compile-file (*compile-filename* load-p
+ external-format)
+ (declare (ignore external-format))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil))
+ (multiple-value-bind (fn warn fail)
+ (compile-file *compile-filename*)
+ (when load-p (unless fail (load fn)))))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ (declare (ignore directory))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-string* string))
+ (with-input-from-string (s string)
+ (compile-from-stream s :load t)))))
+
+(defun compile-from-stream (stream &rest args)
+ (let ((file (si::mkstemp "TMP:ECLXXXXXX")))
+ (with-open-file (s file :direction :output :if-exists :overwrite)
+ (do ((line (read-line stream nil) (read-line stream nil)))
+ ((not line))
+ (write-line line s)))
+ (unwind-protect
+ (apply #'compile-file file args)
+ (delete-file file))))
+
+
+;;;; Documentation
+
+(defimplementation arglist (name)
+ (or (functionp name) (setf name (symbol-function name)))
+ (if (functionp name)
+ (typecase name
+ (generic-function
+ (clos::generic-function-lambda-list name))
+ (function
+ (let ((fle (function-lambda-expression name)))
+ (case (car fle)
+ (si:lambda-block (caddr fle))
+ (t :not-available)))))
+ :not-available))
+
+(defimplementation function-name (f)
+ (si:compiled-function-name f))
+
+(defimplementation macroexpand-all (form)
+ ;;; FIXME! This is not the same as a recursive macroexpansion!
+ (macroexpand form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (dolist (type '(:VARIABLE :FUNCTION :CLASS))
+ (let ((doc (describe-definition symbol type)))
+ (when doc
+ (setf result (list* type doc result)))))
+ result))
+
+(defimplementation describe-definition (name type)
+ (case type
+ (:variable (documentation name 'variable))
+ (:function (documentation name 'function))
+ (:class (documentation name 'class))
+ (t nil)))
+
+;;; Debugging
+
+(import
+ '(si::*ihs-top*
+ si::*ihs-current*
+ si::*ihs-base*
+ si::*frs-base*
+ si::*frs-top*
+ si::*tpl-commands*
+ si::*tpl-level*
+ si::frs-top
+ si::ihs-top
+ si::sch-frs-base
+ si::set-break-env
+ si::set-current-ihs
+ si::tpl-commands))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (declare (type function debugger-loop-fn))
+ (let* ((*tpl-commands* si::tpl-commands)
+ (*ihs-top* (ihs-top 'call-with-debugging-environment))
+ (*ihs-current* *ihs-top*)
+ (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top))))
+ (*frs-top* (frs-top))
+ (*read-suppress* nil)
+ (*tpl-level* (1+ *tpl-level*)))
+ (set-break-env)
+ (set-current-ihs)
+ (funcall debugger-loop-fn)))
+
+;; (defimplementation call-with-debugger-hook (hook fun)
+;; (let ((*debugger-hook* hook))
+;; (funcall fun)))
+
+(defun nth-frame (n)
+ (cond ((>= n *ihs-top* ) nil)
+ (t (- *ihs-top* n))))
+
+(defimplementation compute-backtrace (start end)
+ (loop for i from start below end
+ for f = (nth-frame i)
+ while f
+ collect f))
+
+(defimplementation print-frame (frame stream)
+ (format stream "~A" (si::ihs-fname frame)))
+
+;;;; Inspector
+
+(defclass ecl-inspector (inspector)
+ ())
+
+(defimplementation make-default-inspector ()
+ (make-instance 'ecl-inspector))
+
+;;;; Definitions
+
+(defimplementation find-definitions (name) nil)
Added: branches/trunk-reorg/thirdparty/slime/swank-gray.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-gray.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-gray.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,168 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; swank-gray.lisp --- Gray stream based IO redirection.
+;;;
+;;; Created 2003
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(in-package :swank-backend)
+
+(defclass slime-output-stream (fundamental-character-output-stream)
+ ((output-fn :initarg :output-fn)
+ (buffer :initform (make-string 8000))
+ (fill-pointer :initform 0)
+ (column :initform 0)
+ (last-flush-time :initform (get-internal-real-time))
+ (lock :initform (make-recursive-lock :name "buffer write lock"))))
+
+(defmethod stream-write-char ((stream slime-output-stream) char)
+ (call-with-recursive-lock-held
+ (slot-value stream 'lock)
+ (lambda ()
+ (with-slots (buffer fill-pointer column) stream
+ (setf (schar buffer fill-pointer) char)
+ (incf fill-pointer)
+ (incf column)
+ (when (char= #\newline char)
+ (setf column 0)
+ (force-output stream))
+ (when (= fill-pointer (length buffer))
+ (finish-output stream)))))
+ char)
+
+(defmethod stream-line-column ((stream slime-output-stream))
+ (call-with-recursive-lock-held
+ (slot-value stream 'lock)
+ (lambda ()
+ (slot-value stream 'column))))
+
+(defmethod stream-line-length ((stream slime-output-stream))
+ 75)
+
+(defmethod stream-finish-output ((stream slime-output-stream))
+ (call-with-recursive-lock-held
+ (slot-value stream 'lock)
+ (lambda ()
+ (with-slots (buffer fill-pointer output-fn last-flush-time) stream
+ (let ((end fill-pointer))
+ (unless (zerop end)
+ (funcall output-fn (subseq buffer 0 end))
+ (setf fill-pointer 0)))
+ (setf last-flush-time (get-internal-real-time)))))
+ nil)
+
+(defmethod stream-force-output ((stream slime-output-stream))
+ (call-with-recursive-lock-held
+ (slot-value stream 'lock)
+ (lambda ()
+ (with-slots (last-flush-time fill-pointer) stream
+ (let ((now (get-internal-real-time)))
+ (when (> (/ (- now last-flush-time)
+ (coerce internal-time-units-per-second 'double-float))
+ 0.2)
+ (finish-output stream))))))
+ nil)
+
+(defmethod stream-fresh-line ((stream slime-output-stream))
+ (call-with-recursive-lock-held
+ (slot-value stream 'lock)
+ (lambda ()
+ (with-slots (column) stream
+ (cond ((zerop column) nil)
+ (t (terpri stream) t))))))
+
+(defclass slime-input-stream (fundamental-character-input-stream)
+ ((output-stream :initarg :output-stream)
+ (input-fn :initarg :input-fn)
+ (buffer :initform "") (index :initform 0)
+ (lock :initform (make-lock :name "buffer read lock"))))
+
+(defmethod stream-read-char ((s slime-input-stream))
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index output-stream input-fn) s
+ (when (= index (length buffer))
+ (when output-stream
+ (finish-output output-stream))
+ (let ((string (funcall input-fn)))
+ (cond ((zerop (length string))
+ (return-from stream-read-char :eof))
+ (t
+ (setf buffer string)
+ (setf index 0)))))
+ (assert (plusp (length buffer)))
+ (prog1 (aref buffer index) (incf index))))))
+
+(defmethod stream-listen ((s slime-input-stream))
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index) s
+ (< index (length buffer))))))
+
+(defmethod stream-unread-char ((s slime-input-stream) char)
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index) s
+ (decf index)
+ (cond ((eql (aref buffer index) char)
+ (setf (aref buffer index) char))
+ (t
+ (warn "stream-unread-char: ignoring ~S (expected ~S)"
+ char (aref buffer index)))))))
+ nil)
+
+(defmethod stream-clear-input ((s slime-input-stream))
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index) s
+ (setf buffer ""
+ index 0))))
+ nil)
+
+(defmethod stream-line-column ((s slime-input-stream))
+ nil)
+
+(defmethod stream-line-length ((s slime-input-stream))
+ 75)
+
+
+;;; CLISP extensions
+
+;; We have to define an additional method for the sake of the C
+;; function listen_char (see src/stream.d), on which SYS::READ-FORM
+;; depends.
+
+;; We could make do with either of the two methods below.
+
+(defmethod stream-read-char-no-hang ((s slime-input-stream))
+ (call-with-lock-held
+ (slot-value s 'lock)
+ (lambda ()
+ (with-slots (buffer index) s
+ (when (< index (length buffer))
+ (prog1 (aref buffer index) (incf index)))))))
+
+;; This CLISP extension is what listen_char actually calls. The
+;; default method would call STREAM-READ-CHAR-NO-HANG, so it is a bit
+;; more efficient to define it directly.
+
+(defmethod stream-read-char-will-hang-p ((s slime-input-stream))
+ (with-slots (buffer index) s
+ (= index (length buffer))))
+
+
+;;;
+(defimplementation make-fn-streams (input-fn output-fn)
+ (let* ((output (make-instance 'slime-output-stream
+ :output-fn output-fn))
+ (input (make-instance 'slime-input-stream
+ :input-fn input-fn
+ :output-stream output)))
+ (values input output)))
\ No newline at end of file
Added: branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,803 @@
+;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-lispworks.lisp --- LispWorks specific code for SLIME.
+;;;
+;;; Created 2003, Helmut Eller
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require "comm")
+ (import-from :stream *gray-stream-symbols* :swank-backend))
+
+(import-swank-mop-symbols :clos '(:slot-definition-documentation
+ :eql-specializer
+ :eql-specializer-object
+ :compute-applicable-methods-using-classes))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot t))
+
+(defun swank-mop:compute-applicable-methods-using-classes (gf classes)
+ (clos::compute-applicable-methods-from-classes gf classes))
+
+;; lispworks doesn't have the eql-specializer class, it represents
+;; them as a list of `(EQL ,OBJECT)
+(deftype swank-mop:eql-specializer () 'cons)
+
+(defun swank-mop:eql-specializer-object (eql-spec)
+ (second eql-spec))
+
+(when (fboundp 'dspec::define-dspec-alias)
+ (dspec::define-dspec-alias defimplementation (name args &rest body)
+ `(defmethod ,name ,args ,@body)))
+
+;;; TCP server
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+(defun socket-fd (socket)
+ (etypecase socket
+ (fixnum socket)
+ (comm:socket-stream (comm:socket-stream-socket socket))))
+
+(defimplementation create-socket (host port)
+ (multiple-value-bind (socket where errno)
+ #-(or lispworks4.1 (and macosx lispworks4.3))
+ (comm::create-tcp-socket-for-service port :address host)
+ #+(or lispworks4.1 (and macosx lispworks4.3))
+ (comm::create-tcp-socket-for-service port)
+ (cond (socket socket)
+ (t (error 'network-error
+ :format-control "~A failed: ~A (~D)"
+ :format-arguments (list where
+ (list #+unix (lw:get-unix-error errno))
+ errno))))))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (comm:get-socket-address (socket-fd socket))))
+
+(defimplementation close-socket (socket)
+ (comm::close-socket (socket-fd socket)))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (declare (ignore buffering timeout external-format))
+ (let* ((fd (comm::get-fd-from-socket socket)))
+ (assert (/= fd -1))
+ (make-instance 'comm:socket-stream :socket fd :direction :io
+ :element-type 'base-char)))
+
+(defun set-sigint-handler ()
+ ;; Set SIGINT handler on Swank request handler thread.
+ #-win32
+ (sys::set-signal-handler +sigint+
+ (make-sigint-handler mp:*current-process*)))
+
+;;; Coding Systems
+
+(defvar *external-format-to-coding-system*
+ '(((:latin-1 :eol-style :lf)
+ "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+ ((:latin-1)
+ "latin-1" "iso-latin-1" "iso-8859-1")
+ ((:utf-8) "utf-8")
+ ((:utf-8 :eol-style :lf) "utf-8-unix")
+ ((:euc-jp) "euc-jp")
+ ((:euc-jp :eol-style :lf) "euc-jp-unix")
+ ((:ascii) "us-ascii")
+ ((:ascii :eol-style :lf) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+;;; Unix signals
+
+(defun sigint-handler ()
+ (with-simple-restart (continue "Continue from SIGINT handler.")
+ (invoke-debugger "SIGINT")))
+
+(defun make-sigint-handler (process)
+ (lambda (&rest args)
+ (declare (ignore args))
+ (mp:process-interrupt process #'sigint-handler)))
+
+(defimplementation call-without-interrupts (fn)
+ (lw:without-interrupts (funcall fn)))
+
+(defimplementation getpid ()
+ #+win32 (win32:get-current-process-id)
+ #-win32 (system::getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "lispworks")
+
+(defimplementation set-default-directory (directory)
+ (namestring (hcl:change-directory directory)))
+
+;;;; Documentation
+
+(defimplementation arglist (symbol-or-function)
+ (let ((arglist (lw:function-lambda-list symbol-or-function)))
+ (etypecase arglist
+ ((member :dont-know)
+ :not-available)
+ (list
+ arglist))))
+
+(defimplementation function-name (function)
+ (nth-value 2 (function-lambda-expression function)))
+
+(defimplementation macroexpand-all (form)
+ (walker:walk-form form))
+
+(defun generic-function-p (object)
+ (typep object 'generic-function))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ "Return a plist describing SYMBOL.
+Return NIL if the symbol is unbound."
+ (let ((result '()))
+ (labels ((first-line (string)
+ (let ((pos (position #\newline string)))
+ (if (null pos) string (subseq string 0 pos))))
+ (doc (kind &optional (sym symbol))
+ (let ((string (documentation sym kind)))
+ (if string
+ (first-line string)
+ :not-documented)))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (maybe-push
+ :generic-function (if (and (fboundp symbol)
+ (generic-function-p (fdefinition symbol)))
+ (doc 'function)))
+ (maybe-push
+ :function (if (and (fboundp symbol)
+ (not (generic-function-p (fdefinition symbol))))
+ (doc 'function)))
+ (maybe-push
+ :setf (let ((setf-name (sys:underlying-setf-name `(setf ,symbol))))
+ (if (fboundp setf-name)
+ (doc 'setf))))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ result)))
+
+(defimplementation describe-definition (symbol type)
+ (ecase type
+ (:variable (describe-symbol symbol))
+ (:class (describe (find-class symbol)))
+ ((:function :generic-function) (describe-function symbol))
+ (:setf (describe-function (sys:underlying-setf-name `(setf ,symbol))))))
+
+(defun describe-function (symbol)
+ (cond ((fboundp symbol)
+ (format t "~%(~A~{ ~A~})~%~%~:[(not documented)~;~:*~A~]~%"
+ (string-downcase symbol)
+ (mapcar #'string-upcase
+ (lispworks:function-lambda-list symbol))
+ (documentation symbol 'function))
+ (describe (fdefinition symbol)))
+ (t (format t "~S is not fbound" symbol))))
+
+(defun describe-symbol (sym)
+ (format t "~A is a symbol in package ~A." sym (symbol-package sym))
+ (when (boundp sym)
+ (format t "~%~%Value: ~A" (symbol-value sym)))
+ (let ((doc (documentation sym 'variable)))
+ (when doc
+ (format t "~%~%Variable documentation:~%~A" doc)))
+ (when (fboundp sym)
+ (describe-function sym)))
+
+;;; Debugging
+
+(defclass slime-env (env:environment)
+ ((debugger-hook :initarg :debugger-hoook)))
+
+(defun slime-env (hook io-bindings)
+ (make-instance 'slime-env :name "SLIME Environment"
+ :io-bindings io-bindings
+ :debugger-hoook hook))
+
+(defmethod env-internals:environment-display-notifier
+ ((env slime-env) &key restarts condition)
+ (declare (ignore restarts))
+ (funcall (slot-value env 'debugger-hook) condition *debugger-hook*))
+
+(defmethod env-internals:environment-display-debugger ((env slime-env))
+ *debug-io*)
+
+(defimplementation call-with-debugger-hook (hook fun)
+ (let ((*debugger-hook* hook))
+ (env:with-environment ((slime-env hook '()))
+ (funcall fun))))
+
+(defvar *sldb-top-frame*)
+
+(defun interesting-frame-p (frame)
+ (cond ((or (dbg::call-frame-p frame)
+ (dbg::derived-call-frame-p frame)
+ (dbg::foreign-frame-p frame)
+ (dbg::interpreted-call-frame-p frame))
+ t)
+ ((dbg::catch-frame-p frame) dbg:*print-catch-frames*)
+ ((dbg::binding-frame-p frame) dbg:*print-binding-frames*)
+ ((dbg::handler-frame-p frame) dbg:*print-handler-frames*)
+ ((dbg::restart-frame-p frame) dbg:*print-restart-frames*)
+ ((dbg::open-frame-p frame) dbg:*print-open-frames*)
+ (t nil)))
+
+(defun nth-next-frame (frame n)
+ "Unwind FRAME N times."
+ (do ((frame frame (dbg::frame-next frame))
+ (i n (if (interesting-frame-p frame) (1- i) i)))
+ ((or (not frame)
+ (and (interesting-frame-p frame) (zerop i)))
+ frame)))
+
+(defun nth-frame (index)
+ (nth-next-frame *sldb-top-frame* index))
+
+(defun find-top-frame ()
+ "Return the most suitable top-frame for the debugger."
+ (or (do ((frame (dbg::debugger-stack-current-frame dbg::*debugger-stack*)
+ (nth-next-frame frame 1)))
+ ((or (null frame) ; no frame found!
+ (and (dbg::call-frame-p frame)
+ (eq (dbg::call-frame-function-name frame)
+ 'invoke-debugger)))
+ (nth-next-frame frame 1)))
+ ;; if we can't find a invoke-debugger frame, take any old frame at the top
+ (dbg::debugger-stack-current-frame dbg::*debugger-stack*)))
+
+(defimplementation call-with-debugging-environment (fn)
+ (dbg::with-debugger-stack ()
+ (let ((*sldb-top-frame* (find-top-frame)))
+ (funcall fn))))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum))
+ (backtrace '()))
+ (do ((frame (nth-frame start) (dbg::frame-next frame))
+ (i start))
+ ((or (not frame) (= i end)) (nreverse backtrace))
+ (when (interesting-frame-p frame)
+ (incf i)
+ (push frame backtrace)))))
+
+(defun frame-actual-args (frame)
+ (let ((*break-on-signals* nil))
+ (mapcar (lambda (arg)
+ (case arg
+ ((&rest &optional &key) arg)
+ (t
+ (handler-case (dbg::dbg-eval arg frame)
+ (error (e) (format nil "<~A>" arg))))))
+ (dbg::call-frame-arglist frame))))
+
+(defimplementation print-frame (frame stream)
+ (cond ((dbg::call-frame-p frame)
+ (format stream "~S ~S"
+ (dbg::call-frame-function-name frame)
+ (frame-actual-args frame)))
+ (t (princ frame stream))))
+
+(defun frame-vars (frame)
+ (first (dbg::frame-locals-format-list frame #'list 75 0)))
+
+(defimplementation frame-locals (n)
+ (let ((frame (nth-frame n)))
+ (if (dbg::call-frame-p frame)
+ (mapcar (lambda (var)
+ (destructuring-bind (name value symbol location) var
+ (declare (ignore name location))
+ (list :name symbol :id 0
+ :value value)))
+ (frame-vars frame)))))
+
+(defimplementation frame-var-value (frame var)
+ (let ((frame (nth-frame frame)))
+ (destructuring-bind (_n value _s _l) (nth var (frame-vars frame))
+ (declare (ignore _n _s _l))
+ value)))
+
+(defimplementation frame-catch-tags (index)
+ (declare (ignore index))
+ nil)
+
+(defimplementation frame-source-location-for-emacs (frame)
+ (let ((frame (nth-frame frame))
+ (callee (if (plusp frame) (nth-frame (1- frame)))))
+ (if (dbg::call-frame-p frame)
+ (let ((dspec (dbg::call-frame-function-name frame))
+ (cname (and (dbg::call-frame-p callee)
+ (dbg::call-frame-function-name callee))))
+ (if dspec
+ (frame-location dspec cname))))))
+
+(defimplementation eval-in-frame (form frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (dbg::dbg-eval form frame)))
+
+(defimplementation return-from-frame (frame-number form)
+ (let* ((frame (nth-frame frame-number))
+ (return-frame (dbg::find-frame-for-return frame)))
+ (dbg::dbg-return-from-call-frame frame form return-frame
+ dbg::*debugger-stack*)))
+
+(defimplementation restart-frame (frame-number)
+ (let ((frame (nth-frame frame-number)))
+ (dbg::restart-frame frame :same-args t)))
+
+;;; Definition finding
+
+(defun frame-location (dspec callee-name)
+ (let ((infos (dspec:find-dspec-locations dspec)))
+ (cond (infos
+ (destructuring-bind ((rdspec location) &rest _) infos
+ (declare (ignore _))
+ (let ((name (and callee-name (symbolp callee-name)
+ (string callee-name))))
+ (make-dspec-location rdspec location
+ `(:call-site ,name)))))
+ (t
+ (list :error (format nil "Source location not available for: ~S"
+ dspec))))))
+
+(defimplementation find-definitions (name)
+ (let ((locations (dspec:find-name-locations dspec:*dspec-classes* name)))
+ (loop for (dspec location) in locations
+ collect (list dspec (make-dspec-location dspec location)))))
+
+
+;;; Compilation
+
+(defmacro with-swank-compilation-unit ((location &rest options) &body body)
+ (lw:rebinding (location)
+ `(let ((compiler::*error-database* '()))
+ (with-compilation-unit ,options
+ ,@body
+ (signal-error-data-base compiler::*error-database* ,location)
+ (signal-undefined-functions compiler::*unknown-functions* ,location)))))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+ (with-swank-compilation-unit (filename)
+ (compile-file filename :load load-p :external-format external-format)))
+
+(defvar *within-call-with-compilation-hooks* nil
+ "Whether COMPILE-FILE was called from within CALL-WITH-COMPILATION-HOOKS.")
+
+(defvar *undefined-functions-hash* nil
+ "Hash table to map info about undefined functions to pathnames.")
+
+(lw:defadvice (compile-file compile-file-and-collect-notes :around)
+ (pathname &rest rest)
+ (multiple-value-prog1 (apply #'lw:call-next-advice pathname rest)
+ (when *within-call-with-compilation-hooks*
+ (maphash (lambda (unfun dspecs)
+ (dolist (dspec dspecs)
+ (let ((unfun-info (list unfun dspec)))
+ (unless (gethash unfun-info *undefined-functions-hash*)
+ (setf (gethash unfun-info *undefined-functions-hash*)
+ pathname)))))
+ compiler::*unknown-functions*))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (let ((compiler::*error-database* '())
+ (*undefined-functions-hash* (make-hash-table :test 'equal))
+ (*within-call-with-compilation-hooks* t))
+ (with-compilation-unit ()
+ (prog1 (funcall function)
+ (signal-error-data-base compiler::*error-database*)
+ (signal-undefined-functions compiler::*unknown-functions*)))))
+
+(defun map-error-database (database fn)
+ (loop for (filename . defs) in database do
+ (loop for (dspec . conditions) in defs do
+ (dolist (c conditions)
+ (funcall fn filename dspec c)))))
+
+(defun lispworks-severity (condition)
+ (cond ((not condition) :warning)
+ (t (etypecase condition
+ (error :error)
+ (style-warning :warning)
+ (warning :warning)))))
+
+(defun signal-compiler-condition (message location condition)
+ (check-type message string)
+ (signal
+ (make-instance 'compiler-condition :message message
+ :severity (lispworks-severity condition)
+ :location location
+ :original-condition condition)))
+
+(defun compile-from-temp-file (string filename)
+ (unwind-protect
+ (progn
+ (with-open-file (s filename :direction :output :if-exists :supersede)
+ (write-string string s)
+ (finish-output s))
+ (let ((binary-filename (compile-file filename :load t)))
+ (when binary-filename
+ (delete-file binary-filename))))
+ (delete-file filename)))
+
+(defun dspec-buffer-position (dspec offset)
+ (etypecase dspec
+ (cons (let ((name (dspec:dspec-primary-name dspec)))
+ (typecase name
+ ((or symbol string)
+ (list :function-name (string name)))
+ (t (list :position offset)))))
+ (null (list :position offset))
+ (symbol (list :function-name (string dspec)))))
+
+(defmacro with-fairly-standard-io-syntax (&body body)
+ "Like WITH-STANDARD-IO-SYNTAX but preserve *PACKAGE* and *READTABLE*."
+ (let ((package (gensym))
+ (readtable (gensym)))
+ `(let ((,package *package*)
+ (,readtable *readtable*))
+ (with-standard-io-syntax
+ (let ((*package* ,package)
+ (*readtable* ,readtable))
+ ,@body)))))
+
+#-(or lispworks4.1 lispworks4.2) ; no dspec:parse-form-dspec prior to 4.3
+(defun dspec-stream-position (stream dspec)
+ (with-fairly-standard-io-syntax
+ (loop (let* ((pos (file-position stream))
+ (form (read stream nil '#1=#:eof)))
+ (when (eq form '#1#)
+ (return nil))
+ (labels ((check-dspec (form)
+ (when (consp form)
+ (let ((operator (car form)))
+ (case operator
+ ((progn)
+ (mapcar #'check-dspec
+ (cdr form)))
+ ((eval-when locally macrolet symbol-macrolet)
+ (mapcar #'check-dspec
+ (cddr form)))
+ ((in-package)
+ (let ((package (find-package (second form))))
+ (when package
+ (setq *package* package))))
+ (otherwise
+ (let ((form-dspec (dspec:parse-form-dspec form)))
+ (when (dspec:dspec-equal dspec form-dspec)
+ (return pos)))))))))
+ (check-dspec form))))))
+
+(defun dspec-file-position (file dspec)
+ (let* ((*compile-file-pathname* (pathname file))
+ (*compile-file-truename* (truename *compile-file-pathname*))
+ (*load-pathname* *compile-file-pathname*)
+ (*load-truename* *compile-file-truename*))
+ (with-open-file (stream file)
+ (let ((pos
+ #-(or lispworks4.1 lispworks4.2)
+ (dspec-stream-position stream dspec)))
+ (if pos
+ (list :position (1+ pos) t)
+ (dspec-buffer-position dspec 1))))))
+
+(defun emacs-buffer-location-p (location)
+ (and (consp location)
+ (eq (car location) :emacs-buffer)))
+
+(defun make-dspec-location (dspec location &optional hints)
+ (etypecase location
+ ((or pathname string)
+ (multiple-value-bind (file err)
+ (ignore-errors (namestring (truename location)))
+ (if err
+ (list :error (princ-to-string err))
+ (make-location `(:file ,file)
+ (dspec-file-position file dspec)
+ hints))))
+ (symbol
+ `(:error ,(format nil "Cannot resolve location: ~S" location)))
+ ((satisfies emacs-buffer-location-p)
+ (destructuring-bind (_ buffer offset string) location
+ (declare (ignore _ string))
+ (make-location `(:buffer ,buffer)
+ (dspec-buffer-position dspec offset)
+ hints)))))
+
+(defun make-dspec-progenitor-location (dspec location)
+ (let ((canon-dspec (dspec:canonicalize-dspec dspec)))
+ (make-dspec-location
+ (if canon-dspec
+ (if (dspec:local-dspec-p canon-dspec)
+ (dspec:dspec-progenitor canon-dspec)
+ canon-dspec)
+ nil)
+ location)))
+
+(defun signal-error-data-base (database &optional location)
+ (map-error-database
+ database
+ (lambda (filename dspec condition)
+ (signal-compiler-condition
+ (format nil "~A" condition)
+ (make-dspec-progenitor-location dspec (or location filename))
+ condition))))
+
+(defun unmangle-unfun (symbol)
+ "Converts symbols like 'SETF::|\"CL-USER\" \"GET\"| to
+function names like \(SETF GET)."
+ (or (and (eq (symbol-package symbol)
+ (load-time-value (find-package :setf)))
+ (let ((slime-nregex::*regex-groupings* 0)
+ (slime-nregex::*regex-groups* (make-array 10))
+ (symbol-name (symbol-name symbol)))
+ (and (funcall (load-time-value
+ (compile nil (slime-nregex:regex-compile "^\"(.+)\" \"(.+)\"$")))
+ symbol-name)
+ (list 'setf
+ (intern (apply #'subseq symbol-name
+ (aref slime-nregex::*regex-groups* 2))
+ (find-package
+ (apply #'subseq symbol-name
+ (aref slime-nregex::*regex-groups* 1))))))))
+ symbol))
+
+(defun signal-undefined-functions (htab &optional filename)
+ (maphash (lambda (unfun dspecs)
+ (dolist (dspec dspecs)
+ (signal-compiler-condition
+ (format nil "Undefined function ~A" (unmangle-unfun unfun))
+ (make-dspec-progenitor-location dspec
+ (or filename
+ (gethash (list unfun dspec)
+ *undefined-functions-hash*)))
+ nil)))
+ htab))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ (declare (ignore directory))
+ (assert buffer)
+ (assert position)
+ (let* ((location (list :emacs-buffer buffer position string))
+ (tmpname (hcl:make-temp-file nil "lisp")))
+ (with-swank-compilation-unit (location)
+ (compile-from-temp-file
+ (with-output-to-string (s)
+ (let ((*print-radix* t))
+ (print `(eval-when (:compile-toplevel)
+ (setq dspec::*location* (list ,@location)))
+ s))
+ (write-string string s))
+ tmpname))))
+
+;;; xref
+
+(defmacro defxref (name function)
+ `(defimplementation ,name (name)
+ (xref-results (,function name))))
+
+(defxref who-calls hcl:who-calls)
+(defxref who-macroexpands hcl:who-calls) ; macros are in the calls table too
+(defxref calls-who hcl:calls-who)
+(defxref list-callers list-callers-internal)
+;; (defxref list-callees list-callees-internal)
+
+(defun list-callers-internal (name)
+ (let ((callers (make-array 100
+ :fill-pointer 0
+ :adjustable t)))
+ (hcl:sweep-all-objects
+ #'(lambda (object)
+ (when (and #+Harlequin-PC-Lisp (low:compiled-code-p object)
+ #-Harlequin-PC-Lisp (sys::callablep object)
+ (system::find-constant$funcallable name object))
+ (vector-push-extend object callers))))
+ ;; Delay dspec:object-dspec until after sweep-all-objects
+ ;; to reduce allocation problems.
+ (loop for object across callers
+ collect (if (symbolp object)
+ (list 'function object)
+ (or (dspec:object-dspec object) object)))))
+
+;; only for lispworks 4.2 and above
+#-lispworks4.1
+(progn
+ (defxref who-references hcl:who-references)
+ (defxref who-binds hcl:who-binds)
+ (defxref who-sets hcl:who-sets))
+
+(defimplementation who-specializes (classname)
+ (let ((methods (clos:class-direct-methods (find-class classname))))
+ (xref-results (mapcar #'dspec:object-dspec methods))))
+
+(defun xref-results (dspecs)
+ (flet ((frob-locs (dspec locs)
+ (cond (locs
+ (loop for (name loc) in locs
+ collect (list name (make-dspec-location name loc))))
+ (t `((,dspec (:error "Source location not available")))))))
+ (loop for dspec in dspecs
+ append (frob-locs dspec (dspec:dspec-definition-locations dspec)))))
+
+;;; Inspector
+(defclass lispworks-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+ (make-instance 'lispworks-inspector))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (lispworks-inspect o))
+
+(defmethod inspect-for-emacs ((o function)
+ (inspector backend-inspector))
+ (declare (ignore inspector))
+ (lispworks-inspect o))
+
+;; FIXME: slot-boundp-using-class in LW works with names so we can't
+;; use our method in swank.lisp.
+(defmethod inspect-for-emacs ((o standard-object)
+ (inspector backend-inspector))
+ (declare (ignore inspector))
+ (lispworks-inspect o))
+
+(defun lispworks-inspect (o)
+ (multiple-value-bind (names values _getter _setter type)
+ (lw:get-inspector-values o nil)
+ (declare (ignore _getter _setter))
+ (values "A value."
+ (append
+ (label-value-line "Type" type)
+ (loop for name in names
+ for value in values
+ append (label-value-line name value))))))
+
+;;; Miscellaneous
+
+(defimplementation quit-lisp ()
+ (lispworks:quit))
+
+;;; Tracing
+
+(defun parse-fspec (fspec)
+ "Return a dspec for FSPEC."
+ (ecase (car fspec)
+ ((:defmethod) `(method ,(cdr fspec)))))
+
+(defun tracedp (dspec)
+ (member dspec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (dspec)
+ (cond ((tracedp dspec)
+ (eval `(untrace ,dspec))
+ (format nil "~S is now untraced." dspec))
+ (t
+ (eval `(trace (,dspec)))
+ (format nil "~S is now traced." dspec))))
+
+(defimplementation toggle-trace (fspec)
+ (toggle-trace-aux (parse-fspec fspec)))
+
+;;; Multithreading
+
+(defimplementation initialize-multiprocessing (continuation)
+ (cond ((not mp::*multiprocessing*)
+ (push (list "Initialize SLIME" '() continuation)
+ mp:*initial-processes*)
+ (mp:initialize-multiprocessing))
+ (t (funcall continuation))))
+
+(defimplementation spawn (fn &key name)
+ (let ((mp:*process-initial-bindings*
+ (remove (find-package :cl)
+ mp:*process-initial-bindings*
+ :key (lambda (x) (symbol-package (car x))))))
+ (mp:process-run-function name () fn)))
+
+(defvar *id-lock* (mp:make-lock))
+(defvar *thread-id-counter* 0)
+
+(defimplementation thread-id (thread)
+ (mp:with-lock (*id-lock*)
+ (or (getf (mp:process-plist thread) 'id)
+ (setf (getf (mp:process-plist thread) 'id)
+ (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+ (find id (mp:list-all-processes)
+ :key (lambda (p) (getf (mp:process-plist p) 'id))))
+
+(defimplementation thread-name (thread)
+ (mp:process-name thread))
+
+(defimplementation thread-status (thread)
+ (format nil "~A ~D"
+ (mp:process-whostate thread)
+ (mp:process-priority thread)))
+
+(defimplementation make-lock (&key name)
+ (mp:make-lock :name name))
+
+(defimplementation call-with-lock-held (lock function)
+ (mp:with-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+ mp:*current-process*)
+
+(defimplementation all-threads ()
+ (mp:list-all-processes))
+
+(defimplementation interrupt-thread (thread fn)
+ (mp:process-interrupt thread fn))
+
+(defimplementation kill-thread (thread)
+ (mp:process-kill thread))
+
+(defimplementation thread-alive-p (thread)
+ (mp:process-alive-p thread))
+
+(defvar *mailbox-lock* (mp:make-lock))
+
+(defun mailbox (thread)
+ (mp:with-lock (*mailbox-lock*)
+ (or (getf (mp:process-plist thread) 'mailbox)
+ (setf (getf (mp:process-plist thread) 'mailbox)
+ (mp:make-mailbox)))))
+
+(defimplementation receive ()
+ (mp:mailbox-read (mailbox mp:*current-process*)))
+
+(defimplementation send (thread object)
+ (mp:mailbox-send (mailbox thread) object))
+
+;;; Some intergration with the lispworks environment
+
+(defun swank-sym (name) (find-symbol (string name) :swank))
+
+(defimplementation emacs-connected ()
+ (when (eq (eval (swank-sym :*communication-style*))
+ nil)
+ (set-sigint-handler))
+ ;; pop up the slime debugger by default
+ (let ((lw:*handle-warn-on-redefinition* :warn))
+ (defmethod env-internals:environment-display-notifier
+ (env &key restarts condition)
+ (declare (ignore restarts))
+ (funcall (swank-sym :swank-debugger-hook) condition *debugger-hook*))
+ (defmethod env-internals:environment-display-debugger (env)
+ *debug-io*)))
+
+(defimplementation make-stream-interactive (stream)
+ (unless (find-method #'stream:stream-soft-force-output nil `((eql ,stream))
+ nil)
+ (let ((lw:*handle-warn-on-redefinition* :warn))
+ (defmethod stream:stream-soft-force-output ((o (eql stream)))
+ (force-output o)))))
+
+(defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args)
+ (apply (swank-sym :y-or-n-p-in-emacs) msg args))
+
+
+;;;; Weak hashtables
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak-kind :key args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ (apply #'make-hash-table :weak-kind :value args))
Added: branches/trunk-reorg/thirdparty/slime/swank-loader.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-loader.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-loader.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,236 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; swank-loader.lisp --- Compile and load the Slime backend.
+;;;
+;;; Created 2003, James Bielman <jamesjb(a)jamesjb.com>
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+;; If you want customize the source- or fasl-directory you can set
+;; swank-loader:*source-directory* resp. swank-loader:*fasl-directory*
+;; before loading this files. (you also need to create the
+;; swank-loader package.)
+;; E.g.:
+;;
+;; (make-package :swank-loader)
+;; (defparameter swank-loader::*fasl-directory* "/tmp/fasl/")
+;; (load ".../swank-loader.lisp")
+
+(cl:defpackage :swank-loader
+ (:use :cl)
+ (:export :load-swank
+ :*source-directory*
+ :*fasl-directory*))
+
+(cl:in-package :swank-loader)
+
+(defvar *source-directory*
+ (make-pathname :name nil :type nil
+ :defaults (or *load-pathname* *default-pathname-defaults*))
+ "The directory where to look for the source.")
+
+(defparameter *sysdep-files*
+ (append
+ '("nregex")
+ #+cmu '("swank-source-path-parser" "swank-source-file-cache" "swank-cmucl")
+ #+scl '("swank-source-path-parser" "swank-source-file-cache" "swank-scl")
+ #+sbcl '("swank-source-path-parser" "swank-source-file-cache"
+ "swank-sbcl" "swank-gray")
+ #+openmcl '("metering" "swank-openmcl" "swank-gray")
+ #+lispworks '("swank-lispworks" "swank-gray")
+ #+allegro '("swank-allegro" "swank-gray")
+ #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
+ #+armedbear '("swank-abcl")
+ #+cormanlisp '("swank-corman" "swank-gray")
+ #+ecl '("swank-ecl" "swank-gray")
+ ))
+
+(defparameter *implementation-features*
+ '(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :cormanlisp
+ :armedbear :gcl :ecl :scl))
+
+(defparameter *os-features*
+ '(:macosx :linux :windows :mswindows :win32 :solaris :darwin :sunos :hpux
+ :unix))
+
+(defparameter *architecture-features*
+ '(:powerpc :ppc :x86 :x86-64 :amd64 :i686 :i586 :i486 :pc386 :iapx386
+ :sparc64 :sparc :hppa64 :hppa))
+
+(defun lisp-version-string ()
+ #+cmu (substitute-if #\_ (lambda (x) (find x " /"))
+ (lisp-implementation-version))
+ #+scl (lisp-implementation-version)
+ #+sbcl (lisp-implementation-version)
+ #+ecl (lisp-implementation-version)
+ #+openmcl (format nil "~d.~d"
+ ccl::*openmcl-major-version*
+ ccl::*openmcl-minor-version*)
+ #+lispworks (lisp-implementation-version)
+ #+allegro (format nil
+ "~A~A~A"
+ excl::*common-lisp-version-number*
+ (if (eq 'h 'H) "A" "M") ; ANSI vs MoDeRn
+ (if (member :64bit *features*) "-64bit" ""))
+ #+clisp (let ((s (lisp-implementation-version)))
+ (subseq s 0 (position #\space s)))
+ #+armedbear (lisp-implementation-version)
+ #+cormanlisp (lisp-implementation-version))
+
+(defun unique-directory-name ()
+ "Return a name that can be used as a directory name that is
+unique to a Lisp implementation, Lisp implementation version,
+operating system, and hardware architecture."
+ (flet ((first-of (features)
+ (loop for f in features
+ when (find f *features*) return it))
+ (maybe-warn (value fstring &rest args)
+ (cond (value)
+ (t (apply #'warn fstring args)
+ "unknown"))))
+ (let ((lisp (maybe-warn (first-of *implementation-features*)
+ "No implementation feature found in ~a."
+ *implementation-features*))
+ (os (maybe-warn (first-of *os-features*)
+ "No os feature found in ~a." *os-features*))
+ (arch (maybe-warn (first-of *architecture-features*)
+ "No architecture feature found in ~a."
+ *architecture-features*))
+ (version (maybe-warn (lisp-version-string)
+ "Don't know how to get Lisp ~
+ implementation version.")))
+ (format nil "~(~@{~a~^-~}~)" lisp version os arch))))
+
+(defun file-newer-p (new-file old-file)
+ "Returns true if NEW-FILE is newer than OLD-FILE."
+ (> (file-write-date new-file) (file-write-date old-file)))
+
+(defun slime-version-string ()
+ "Return a string identifying the SLIME version.
+Return nil if nothing appropriate is available."
+ (with-open-file (s (merge-pathnames "ChangeLog" *source-directory*)
+ :if-does-not-exist nil)
+ (and s (symbol-name (read s)))))
+
+(defun default-fasl-directory ()
+ (merge-pathnames
+ (make-pathname
+ :directory `(:relative ".slime" "fasl"
+ ,@(if (slime-version-string) (list (slime-version-string)))
+ ,(unique-directory-name)))
+ (user-homedir-pathname)))
+
+(defun binary-pathname (source-pathname binary-directory)
+ "Return the pathname where SOURCE-PATHNAME's binary should be compiled."
+ (let ((cfp (compile-file-pathname source-pathname)))
+ (merge-pathnames (make-pathname :name (pathname-name cfp)
+ :type (pathname-type cfp))
+ binary-directory)))
+
+(defun handle-loadtime-error (condition binary-pathname)
+ (pprint-logical-block (*error-output* () :per-line-prefix ";; ")
+ (format *error-output*
+ "~%Error while loading: ~A~%Condition: ~A~%Aborting.~%"
+ binary-pathname condition))
+ (when (equal (directory-namestring binary-pathname)
+ (directory-namestring (default-fasl-directory)))
+ (ignore-errors (delete-file binary-pathname)))
+ (abort))
+
+(defun compile-files-if-needed-serially (files fasl-directory load)
+ "Compile each file in FILES if the source is newer than
+its corresponding binary, or the file preceding it was
+recompiled."
+ (let ((needs-recompile nil))
+ (dolist (source-pathname files)
+ (let ((binary-pathname (binary-pathname source-pathname
+ fasl-directory)))
+ (handler-case
+ (progn
+ (when (or needs-recompile
+ (not (probe-file binary-pathname))
+ (file-newer-p source-pathname binary-pathname))
+ ;; need a to recompile source-pathname, so we'll
+ ;; need to recompile everything after this too.
+ (setq needs-recompile t)
+ (ensure-directories-exist binary-pathname)
+ (compile-file source-pathname :output-file binary-pathname
+ :print nil
+ :verbose t))
+ (when load
+ (load binary-pathname :verbose t)))
+ ;; Fail as early as possible
+ (serious-condition (c)
+ (handle-loadtime-error c binary-pathname)))))))
+
+#+(or cormanlisp ecl)
+(defun compile-files-if-needed-serially (files fasl-directory)
+ "Corman Lisp and ECL have trouble with compiled files."
+ (declare (ignore fasl-directory))
+ (dolist (file files)
+ (load file :verbose t)
+ (force-output)))
+
+(defun load-user-init-file ()
+ "Load the user init file, return NIL if it does not exist."
+ (load (merge-pathnames (user-homedir-pathname)
+ (make-pathname :name ".swank" :type "lisp"))
+ :if-does-not-exist nil))
+
+(defun load-site-init-file (directory)
+ (load (make-pathname :name "site-init" :type "lisp"
+ :defaults directory)
+ :if-does-not-exist nil))
+
+(defun source-files (names src-dir)
+ (mapcar (lambda (name)
+ (make-pathname :name (string-downcase name) :type "lisp"
+ :defaults src-dir))
+ names))
+
+(defun swank-source-files (src-dir)
+ (source-files `("swank-backend" ,@*sysdep-files* "swank")
+ src-dir))
+
+(defvar *fasl-directory* (default-fasl-directory)
+ "The directory where fasl files should be placed.")
+
+(defvar *contribs* '(swank-c-p-c swank-arglists swank-fuzzy
+ swank-fancy-inspector
+ swank-presentations swank-presentation-streams
+ #+(or asdf sbcl) swank-asdf
+ )
+ "List of names for contrib modules.")
+
+(defun append-dir (absolute name)
+ (merge-pathnames
+ (make-pathname :directory `(:relative ,name) :defaults absolute)
+ absolute))
+
+(defun contrib-src-dir (src-dir)
+ (append-dir src-dir "contrib"))
+
+(defun contrib-source-files (src-dir)
+ (source-files *contribs* (contrib-src-dir src-dir)))
+
+(defun load-swank (&key
+ (source-directory *source-directory*)
+ (fasl-directory *fasl-directory*)
+ (contrib-fasl-directory
+ (append-dir fasl-directory "contrib")))
+ (compile-files-if-needed-serially (swank-source-files source-directory)
+ fasl-directory t)
+ (compile-files-if-needed-serially (contrib-source-files source-directory)
+ contrib-fasl-directory nil))
+
+(load-swank)
+
+(setq swank::*swank-wire-protocol-version* (slime-version-string))
+(setq swank::*load-path*
+ (append swank::*load-path* (list (contrib-src-dir *source-directory*))))
+(swank-backend::warn-unimplemented-interfaces)
+(load-site-init-file *source-directory*)
+(load-user-init-file)
+(swank:run-after-init-hook)
Added: branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,985 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; openmcl-swank.lisp --- SLIME backend for OpenMCL.
+;;;
+;;; Copyright (C) 2003, James Bielman <jamesjb(a)jamesjb.com>
+;;;
+;;; This program is licensed under the terms of the Lisp Lesser GNU
+;;; Public License, known as the LLGPL, and distributed with OpenMCL
+;;; as the file "LICENSE". The LLGPL consists of a preamble and the
+;;; LGPL, which is distributed with OpenMCL as the file "LGPL". Where
+;;; these conflict, the preamble takes precedence.
+;;;
+;;; The LLGPL is also available online at
+;;; http://opensource.franz.com/preamble.html
+
+;;;
+;;; This is the beginning of a Slime backend for OpenMCL. It has been
+;;; tested only with OpenMCL version 0.14-030901 on Darwin --- I would
+;;; be interested in hearing the results with other versions.
+;;;
+;;; Additionally, reporting the positions of warnings accurately requires
+;;; a small patch to the OpenMCL file compiler, which may be found at:
+;;;
+;;; http://www.jamesjb.com/slime/openmcl-warning-position.diff
+;;;
+;;; Things that work:
+;;;
+;;; * Evaluation of forms with C-M-x.
+;;; * Compilation of defuns with C-c C-c.
+;;; * File compilation with C-c C-k.
+;;; * Most of the debugger functionality, except EVAL-IN-FRAME,
+;;; FRAME-SOURCE-LOCATION, and FRAME-CATCH-TAGS.
+;;; * Macroexpanding with C-c RET.
+;;; * Disassembling the symbol at point with C-c M-d.
+;;; * Describing symbol at point with C-c C-d.
+;;; * Compiler warnings are trapped and sent to Emacs using the buffer
+;;; position of the offending top level form.
+;;; * Symbol completion and apropos.
+;;;
+;;; Things that sort of work:
+;;;
+;;; * WHO-CALLS is implemented but is only able to return the file a
+;;; caller is defined in---source location information is not
+;;; available.
+;;;
+;;; Things that aren't done yet:
+;;;
+;;; * Cross-referencing.
+;;; * Due to unimplementation functionality the test suite does not
+;;; run correctly (it hangs upon entering the debugger).
+;;;
+
+(in-package :swank-backend)
+
+(import-from :ccl *gray-stream-symbols* :swank-backend)
+
+(require 'xref)
+
+;;; swank-mop
+
+(import-to-swank-mop
+ '( ;; classes
+ cl:standard-generic-function
+ ccl::standard-slot-definition
+ cl:method
+ cl:standard-class
+ ccl::eql-specializer
+ openmcl-mop:finalize-inheritance
+ ;; standard-class readers
+ openmcl-mop:class-default-initargs
+ openmcl-mop:class-direct-default-initargs
+ openmcl-mop:class-direct-slots
+ openmcl-mop:class-direct-subclasses
+ openmcl-mop:class-direct-superclasses
+ openmcl-mop:class-finalized-p
+ cl:class-name
+ openmcl-mop:class-precedence-list
+ openmcl-mop:class-prototype
+ openmcl-mop:class-slots
+ openmcl-mop:specializer-direct-methods
+ ;; eql-specializer accessors
+ openmcl-mop:eql-specializer-object
+ ;; generic function readers
+ openmcl-mop:generic-function-argument-precedence-order
+ openmcl-mop:generic-function-declarations
+ openmcl-mop:generic-function-lambda-list
+ openmcl-mop:generic-function-methods
+ openmcl-mop:generic-function-method-class
+ openmcl-mop:generic-function-method-combination
+ openmcl-mop:generic-function-name
+ ;; method readers
+ openmcl-mop:method-generic-function
+ openmcl-mop:method-function
+ openmcl-mop:method-lambda-list
+ openmcl-mop:method-specializers
+ openmcl-mop:method-qualifiers
+ ;; slot readers
+ openmcl-mop:slot-definition-allocation
+ ccl::slot-definition-documentation
+ openmcl-mop:slot-value-using-class
+ openmcl-mop:slot-definition-initargs
+ openmcl-mop:slot-definition-initform
+ openmcl-mop:slot-definition-initfunction
+ openmcl-mop:slot-definition-name
+ openmcl-mop:slot-definition-type
+ openmcl-mop:slot-definition-readers
+ openmcl-mop:slot-definition-writers
+ openmcl-mop:slot-boundp-using-class
+ openmcl-mop:slot-makunbound-using-class))
+
+(defun specializer-name (spec)
+ (etypecase spec
+ (cons spec)
+ (class (class-name spec))
+ (ccl::eql-specializer `(eql ,(ccl::eql-specializer-object spec)))))
+
+(defun swank-mop:compute-applicable-methods-using-classes (gf args)
+ (let* ((methods (ccl::%gf-methods gf))
+ (args-length (length args))
+ (bits (ccl::inner-lfun-bits gf))
+ arg-count res)
+ (when methods
+ (setq arg-count (length (ccl::%method-specializers (car methods))))
+ (unless (<= arg-count args-length)
+ (error "Too few args to ~s" gf))
+ (unless (or (logbitp ccl::$lfbits-rest-bit bits)
+ (logbitp ccl::$lfbits-restv-bit bits)
+ (logbitp ccl::$lfbits-keys-bit bits)
+ (<= args-length
+ (+ (ldb ccl::$lfbits-numreq bits) (ldb ccl::$lfbits-numopt bits))))
+ (error "Too many args to ~s" gf))
+ (let ((cpls (make-list arg-count)))
+ (declare (dynamic-extent cpls))
+ (do* ((args-tail args (cdr args-tail))
+ (cpls-tail cpls (cdr cpls-tail)))
+ ((null cpls-tail))
+ (setf (car cpls-tail)
+ (ccl::%class-precedence-list (car args-tail))))
+ (flet ((%method-applicable-p (method args cpls)
+ (do* ((specs (ccl::%method-specializers method) (ccl::%cdr specs))
+ (args args (ccl::%cdr args))
+ (cpls cpls (ccl::%cdr cpls)))
+ ((null specs) t)
+ (let ((spec (ccl::%car specs)))
+ (if (typep spec 'ccl::eql-specializer)
+ (unless (subtypep (ccl::%car args) (class-of (ccl::eql-specializer-object spec)))
+ (return nil))
+ (unless (ccl:memq spec (ccl::%car cpls))
+ (return nil)))))))
+ (dolist (m methods)
+ (if (%method-applicable-p m args cpls)
+ (push m res))))
+ (ccl::sort-methods res cpls (ccl::%gf-precedence-list gf))))))
+
+;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+(defimplementation create-socket (host port)
+ (ccl:make-socket :connect :passive :local-port port
+ :local-host host :reuse-address t))
+
+(defimplementation local-port (socket)
+ (ccl:local-port socket))
+
+(defimplementation close-socket (socket)
+ (close socket))
+
+(defimplementation accept-connection (socket &key external-format
+ buffering timeout)
+ (declare (ignore buffering timeout
+ #-openmcl-unicode-strings external-format))
+ #+openmcl-unicode-strings
+ (when external-format
+ (let ((keys (ccl::socket-keys socket)))
+ (setf (getf keys :external-format) external-format
+ (slot-value socket 'ccl::keys) keys)))
+ (ccl:accept-connection socket :wait t))
+
+#+openmcl-unicode-strings
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")))
+
+#+openmcl-unicode-strings
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+(defimplementation emacs-connected ()
+ (setq ccl::*interactive-abort-process* ccl::*current-process*))
+
+(defimplementation make-stream-interactive (stream)
+ (typecase stream
+ (ccl:fundamental-output-stream
+ (push stream ccl::*auto-flush-streams*))))
+
+;;; Unix signals
+
+(defimplementation call-without-interrupts (fn)
+ (ccl:without-interrupts (funcall fn)))
+
+(defimplementation getpid ()
+ (ccl::getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "openmcl")
+
+(defvar *break-in-sldb* t)
+
+(let ((ccl::*warn-if-redefine-kernel* nil))
+ (ccl::advise
+ cl::break
+ (if (and *break-in-sldb*
+ (find ccl::*current-process* (symbol-value (intern "*CONNECTIONS*" 'swank))
+ :key (intern "CONNECTION.REPL-THREAD" 'swank)))
+ (apply 'break-in-sldb ccl::arglist)
+ (:do-it)) :when :around :name sldb-break))
+
+(defun break-in-sldb (&optional string &rest args)
+ (let ((c (make-condition 'simple-condition
+ :format-control (or string "Break")
+ :format-arguments args)))
+ (let ((previous-f nil)
+ (previous-f2 nil))
+ (block find-frame
+ (map-backtrace
+ #'(lambda(frame-number p context lfun pc)
+ (declare (ignore frame-number context pc))
+ (when (eq previous-f2 'break-in-sldb)
+ (record-stack-top p)
+ (return-from find-frame))
+ (setq previous-f2 previous-f)
+ (setq previous-f (ccl::lfun-name lfun)))))
+ (restart-case (invoke-debugger c)
+ (continue () :report (lambda (stream) (write-string "Resume interrupted evaluation" stream)) t))
+ )))
+
+; In previous version the code that recorded the function that had an
+; error or which was interrupted was not thread safe. This code repairs that by
+; associating the frame pointer with a process via the *process-to-stack-top* hash.
+
+(defvar *process-to-stack-top* (make-hash-table :test 'eql))
+
+(defun record-stack-top (frame)
+ (setf (gethash (ccl::process-serial-number ccl::*current-process*) *process-to-stack-top* )
+ frame))
+
+(defun grab-stack-top ()
+ (let ((psn (ccl::process-serial-number ccl::*current-process*)))
+ (ccl::without-interrupts
+ (prog1
+ (gethash psn *process-to-stack-top*)
+ (setf (gethash psn *process-to-stack-top*) nil)))))
+
+(defmethod ccl::application-error :before (application condition error-pointer)
+ (declare (ignore application condition))
+ (record-stack-top error-pointer)
+ nil)
+
+;;; Evaluation
+
+(defimplementation arglist (fname)
+ (arglist% fname))
+
+(defmethod arglist% ((f symbol))
+ (ccl:arglist f))
+
+(defmethod arglist% ((f function))
+ (ccl:arglist (ccl:function-name f)))
+
+(defimplementation function-name (function)
+ (ccl:function-name function))
+
+;;; Compilation
+
+(defvar *buffer-offset* nil)
+(defvar *buffer-name* nil)
+
+(defun condition-source-position (condition)
+ "Return the position in the source file of a compiler condition."
+ (+ 1
+ (or *buffer-offset* 0)
+ ;; alanr sometimes returned stream position nil.
+ (or (ccl::compiler-warning-stream-position condition) 0)))
+
+
+(defun handle-compiler-warning (condition)
+ "Construct a compiler note for Emacs from a compiler warning
+condition."
+ (signal (make-condition
+ 'compiler-condition
+ :original-condition condition
+ :message (format nil "~A" condition)
+ :severity :warning
+ :location
+ (let ((position (condition-source-position condition)))
+ (if *buffer-name*
+ (make-location
+ (list :buffer *buffer-name*)
+ (list :position position t))
+ (if (ccl::compiler-warning-file-name condition)
+ (make-location
+ (list :file (namestring (truename (ccl::compiler-warning-file-name condition))))
+ (list :position position t))))))))
+
+(defun temp-file-name ()
+ "Return a temporary file name to compile strings into."
+ (ccl:%get-cstring (#_tmpnam (ccl:%null-ptr))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (handler-bind ((ccl::compiler-warning 'handle-compiler-warning))
+ (funcall function)))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+ (declare (ignore external-format))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil)
+ (*buffer-offset* nil))
+ (compile-file filename :load load-p))))
+
+(defimplementation frame-var-value (frame var)
+ (block frame-var-value
+ (map-backtrace
+ #'(lambda(frame-number p context lfun pc)
+ (when (= frame frame-number)
+ (return-from frame-var-value
+ (multiple-value-bind (total vsp parent-vsp)
+ (ccl::count-values-in-frame p context)
+ (loop for count below total
+ with varcount = -1
+ for (value nil name) = (multiple-value-list (ccl::nth-value-in-frame p count context lfun pc vsp parent-vsp))
+ when name do (incf varcount)
+ until (= varcount var)
+ finally (return value))
+ )))))))
+
+(defun xref-locations (relation name &optional (inverse nil))
+ (flet ((function-source-location (entry)
+ (multiple-value-bind (info name)
+ (ccl::edit-definition-p
+ (ccl::%db-key-from-xref-entry entry)
+ (if (eql (ccl::xref-entry-type entry)
+ 'macro)
+ 'function
+ (ccl::xref-entry-type entry)))
+ (cond ((not info)
+ (list :error
+ (format nil "No source info available for ~A"
+ (ccl::xref-entry-name entry))))
+ ((typep (caar info) 'ccl::method)
+ `(:location
+ (:file ,(remove-filename-quoting
+ (namestring (translate-logical-pathname
+ (cdr (car info))))))
+ (:method
+ ,(princ-to-string (ccl::method-name (caar info)))
+ ,(mapcar 'princ-to-string
+ (mapcar #'specializer-name
+ (ccl::method-specializers
+ (caar info))))
+ ,@(mapcar 'princ-to-string
+ (ccl::method-qualifiers (caar info))))
+ nil))
+ (t
+ (canonicalize-location (cdr (first info)) name))))))
+ (declare (dynamic-extent #'function-source-location))
+ (loop for xref in (if inverse
+ (ccl::get-relation relation name
+ :wild :exhaustive t)
+ (ccl::get-relation relation
+ :wild name :exhaustive t))
+ for function = (ccl::xref-entry-name xref)
+ collect `((function ,function)
+ ,(function-source-location xref)))))
+
+(defimplementation who-binds (name)
+ (xref-locations :binds name))
+
+(defimplementation who-macroexpands (name)
+ (xref-locations :macro-calls name t))
+
+(defimplementation who-references (name)
+ (remove-duplicates
+ (append (xref-locations :references name)
+ (xref-locations :sets name)
+ (xref-locations :binds name))
+ :test 'equal))
+
+(defimplementation who-sets (name)
+ (xref-locations :sets name))
+
+(defimplementation who-calls (name)
+ (remove-duplicates
+ (append
+ (xref-locations :direct-calls name)
+ (xref-locations :indirect-calls name)
+ (xref-locations :macro-calls name t))
+ :test 'equal))
+
+(defimplementation list-callees (name)
+ (remove-duplicates
+ (append
+ (xref-locations :direct-calls name t)
+ (xref-locations :macro-calls name nil))
+ :test 'equal))
+
+(defimplementation who-specializes (class)
+ (if (symbolp class) (setq class (find-class class)))
+ (remove-duplicates
+ (append (mapcar (lambda(m)
+ (let ((location (function-source-location (ccl::method-function m))))
+ (if (eq (car location) :error)
+ (setq location nil ))
+ `((method ,(ccl::method-name m)
+ ,(mapcar #'specializer-name (ccl::method-specializers m))
+ ,@(ccl::method-qualifiers m))
+ ,location)))
+ (ccl::%class.direct-methods class))
+ (mapcan 'who-specializes (ccl::%class-direct-subclasses class)))
+ :test 'equal))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ (declare (ignore directory))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-offset* position)
+ (filename (temp-file-name)))
+ (unwind-protect
+ (with-open-file (s filename :direction :output :if-exists :error)
+ (write-string string s))
+ (let ((binary-filename (compile-file filename :load t)))
+ (delete-file binary-filename)))
+ (delete-file filename))))
+
+;;; Profiling (alanr: lifted from swank-clisp)
+
+(defimplementation profile (fname)
+ (eval `(mon:monitor ,fname))) ;monitor is a macro
+
+(defimplementation profiled-functions ()
+ mon:*monitored-functions*)
+
+(defimplementation unprofile (fname)
+ (eval `(mon:unmonitor ,fname))) ;unmonitor is a macro
+
+(defimplementation unprofile-all ()
+ (mon:unmonitor))
+
+(defimplementation profile-report ()
+ (mon:report-monitoring))
+
+(defimplementation profile-reset ()
+ (mon:reset-all-monitoring))
+
+(defimplementation profile-package (package callers-p methods)
+ (declare (ignore callers-p methods))
+ (mon:monitor-all package))
+
+;;; Debugging
+
+(defun openmcl-set-debug-switches ()
+ (setq ccl::*fasl-save-definitions* nil)
+ (setq ccl::*fasl-save-doc-strings* t)
+ (setq ccl::*fasl-save-local-symbols* t)
+ (setq ccl::*ppc2-compiler-register-save-label* t)
+ (setq ccl::*save-arglist-info* t)
+ (setq ccl::*save-definitions* nil)
+ (setq ccl::*save-doc-strings* t)
+ (setq ccl::*save-local-symbols* t)
+ (ccl::start-xref))
+
+(defvar *sldb-stack-top* nil)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let* ((*debugger-hook* nil)
+ (*sldb-stack-top* (grab-stack-top))
+ (ccl::*signal-printing-errors* nil)) ; don't let error while printing error take us down
+ (funcall debugger-loop-fn)))
+
+(defun backtrace-context ()
+ (if (and (= ccl::*openmcl-major-version* 0)
+ (<= ccl::*openmcl-minor-version* 14)
+ (< ccl::*openmcl-revision* 2))
+ (ccl::%current-tcr)
+ nil))
+
+(defun map-backtrace (function &optional
+ (start-frame-number 0)
+ (end-frame-number most-positive-fixnum))
+ "Call FUNCTION passing information about each stack frame
+ from frames START-FRAME-NUMBER to END-FRAME-NUMBER."
+ (let ((context (backtrace-context))
+ (frame-number 0)
+ (top-stack-frame (or *sldb-stack-top*
+ (ccl::%get-frame-ptr))))
+ (do* ((p top-stack-frame (ccl::parent-frame p context))
+ (q (ccl::last-frame-ptr context)))
+ ((or (null p) (eq p q) (ccl::%stack< q p context))
+ (values))
+ (multiple-value-bind (lfun pc) (ccl::cfp-lfun p)
+ (when lfun
+ (if (and (>= frame-number start-frame-number)
+ (< frame-number end-frame-number))
+ (funcall function frame-number p context lfun pc))
+ (incf frame-number))))))
+
+;; May 13, 2004 alanr: use prin1 instead of princ so I see " around strings. Write ' in front of symbol names and lists.
+;; Sept 6, 2004 alanr: use builtin ccl::frame-supplied-args
+
+(defun frame-arguments (p context lfun pc)
+ "Returns a string representing the arguments of a frame."
+ (multiple-value-bind (args types names count nclosed)
+ (ccl::frame-supplied-args p lfun pc nil context)
+ (declare (ignore count nclosed))
+ (let ((result nil))
+ (loop named loop
+ for var = (cond
+ ((null args)
+ (return-from loop))
+ ((atom args)
+ (prog1
+ args
+ (setf args nil)))
+ (t (pop args)))
+ for type in types
+ for name in names
+ do
+ (when (or (symbolp var) (listp var)) (setq var (list 'quote var)))
+ (cond ((equal type "keyword")
+ (push (format nil "~S ~A"
+ (intern (symbol-name name) "KEYWORD")
+ (prin1-to-string var))
+ result))
+ (t (push (prin1-to-string var) result))))
+ (format nil "~{ ~A~}" (nreverse result)))))
+
+
+;; XXX should return something less stringy
+;; alanr May 13, 2004: put #<> around anonymous functions in the backtrace.
+
+(defimplementation compute-backtrace (start-frame-number end-frame-number)
+ (let (result)
+ (map-backtrace (lambda (frame-number p context lfun pc)
+ (declare (ignore frame-number))
+ (push (with-output-to-string (s)
+ (format s "(~A~A)"
+ (if (ccl::function-name lfun)
+ (ccl::%lfun-name-string lfun)
+ lfun)
+ (frame-arguments p context lfun pc)))
+ result))
+ start-frame-number end-frame-number)
+ (nreverse result)))
+
+(defimplementation print-frame (frame stream)
+ (princ frame stream))
+
+(defimplementation frame-locals (index)
+ (block frame-locals
+ (map-backtrace
+ (lambda (frame-number p context lfun pc)
+ (when (= frame-number index)
+ (multiple-value-bind (count vsp parent-vsp)
+ (ccl::count-values-in-frame p context)
+ (let (result)
+ (dotimes (i count)
+ (multiple-value-bind (var type name)
+ (ccl::nth-value-in-frame p i context lfun pc vsp parent-vsp)
+ (declare (ignore type))
+ (when name
+ (push (list
+ :name name
+ :id 0
+ :value var)
+ result))))
+ (return-from frame-locals (nreverse result)))))))))
+
+(defimplementation frame-catch-tags (index &aux my-frame)
+ (block frame-catch-tags
+ (map-backtrace
+ (lambda (frame-number p context lfun pc)
+ (declare (ignore pc lfun))
+ (if (= frame-number index)
+ (setq my-frame p)
+ (when my-frame
+ (return-from frame-catch-tags
+ (loop for catch = (ccl::%catch-top (ccl::%current-tcr)) then (ccl::next-catch catch)
+ while catch
+ for csp = (ccl::uvref catch 3) ; ppc32::catch-frame.csp-cell) defined in arch.lisp
+ for tag = (ccl::uvref catch 0) ; ppc32::catch-frame.catch-tag-cell)
+ until (ccl::%stack< p csp context)
+ when (ccl::%stack< my-frame csp context)
+ collect (cond
+ ((symbolp tag)
+ tag)
+ ((and (listp tag)
+ (typep (car tag) 'restart))
+ `(:restart ,(restart-name (car tag)))))))))))))
+
+(defimplementation disassemble-frame (the-frame-number)
+ (let ((function-to-disassemble nil))
+ (block find-frame
+ (map-backtrace
+ (lambda(frame-number p context lfun pc)
+ (declare (ignore p context pc))
+ (when (= frame-number the-frame-number)
+ (setq function-to-disassemble lfun)
+ (return-from find-frame)))))
+ (ccl::print-ppc-instructions
+ *standard-output*
+ (ccl::function-to-dll-header function-to-disassemble) nil)))
+
+;;;
+
+(defun canonicalize-location (file symbol)
+ (etypecase file
+ ((or string pathname)
+ (multiple-value-bind (truename c) (ignore-errors (namestring (truename file)))
+ (cond (c (list :error (princ-to-string c)))
+ (t (make-location (list :file (remove-filename-quoting truename))
+ (list :function-name (princ-to-string symbol)))))))))
+
+(defun remove-filename-quoting (string)
+ (if (search "\\" string)
+ (read-from-string (format nil "\"~a\"" string))
+ string))
+
+(defun maybe-method-location (type)
+ (when (typep type 'ccl::method)
+ `((method ,(ccl::method-name type)
+ ,(mapcar #'specializer-name (ccl::method-specializers type))
+ ,@(ccl::method-qualifiers type))
+ ,(function-source-location (ccl::method-function type)))))
+
+(defimplementation find-definitions (symbol)
+ (let* ((info (ccl::get-source-files-with-types&classes symbol)))
+ (loop for (type . file) in info
+ when (not (equal "l1-boot-3" (pathname-name file))) ; alanr: This is a bug - there's nothing in there
+ collect (or (maybe-method-location type)
+ (list (list type symbol)
+ (canonicalize-location file symbol))))))
+
+
+(defun function-source-location (function)
+ (multiple-value-bind (info name) (ccl::edit-definition-p function)
+ (cond ((not info) (list :error (format nil "No source info available for ~A" function)))
+ ((typep (caar info) 'ccl::method)
+ `(:location
+ (:file ,(remove-filename-quoting (namestring (translate-logical-pathname (cdr (car info))) )))
+ (:method ,(princ-to-string (ccl::method-name (caar info)))
+ ,(mapcar 'princ-to-string
+ (mapcar #'specializer-name
+ (ccl::method-specializers (caar info))))
+ ,@(mapcar 'princ-to-string (ccl::method-qualifiers (caar info))))
+ nil))
+ (t (canonicalize-location (cdr (first info)) name)))))
+
+(defimplementation frame-source-location-for-emacs (index)
+ "Return to Emacs the location of the source code for the
+function in a debugger frame. In OpenMCL, we are not able to
+find the precise position of the frame, but we do attempt to give
+at least the filename containing it."
+ (block frame-source-location-for-emacs
+ (map-backtrace
+ (lambda (frame-number p context lfun pc)
+ (declare (ignore p context pc))
+ (when (and (= frame-number index) lfun)
+ (return-from frame-source-location-for-emacs
+ (function-source-location lfun)))))))
+
+(defimplementation eval-in-frame (form index)
+ (block eval-in-frame
+ (map-backtrace
+ (lambda (frame-number p context lfun pc)
+ (when (= frame-number index)
+ (multiple-value-bind (count vsp parent-vsp)
+ (ccl::count-values-in-frame p context)
+ (let ((bindings nil))
+ (dotimes (i count)
+ (multiple-value-bind (var type name)
+ (ccl::nth-value-in-frame p i context lfun pc vsp parent-vsp)
+ (declare (ignore type))
+ (when name
+ (push (list name `',var) bindings))
+ ))
+ (return-from eval-in-frame
+ (eval `(let ,bindings
+ (declare (ignorable ,@(mapcar 'car bindings)))
+ ,form)))
+ )))))))
+
+(defimplementation return-from-frame (index form)
+ (let ((values (multiple-value-list (eval-in-frame form index))))
+ (map-backtrace
+ (lambda (frame-number p context lfun pc)
+ (declare (ignore context lfun pc))
+ (when (= frame-number index)
+ (ccl::apply-in-frame p #'values values))))))
+
+(defimplementation restart-frame (index)
+ (map-backtrace
+ (lambda (frame-number p context lfun pc)
+ (when (= frame-number index)
+ (ccl::apply-in-frame p lfun
+ (ccl::frame-supplied-args p lfun pc nil context))))))
+
+;;; Utilities
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind &optional (sym symbol))
+ (or (documentation sym kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (when (boundp symbol)
+ (doc 'variable)))
+ (maybe-push
+ :function (if (fboundp symbol)
+ (doc 'function)))
+ (maybe-push
+ :setf (let ((setf-function-name (ccl::setf-function-spec-name
+ `(setf ,symbol))))
+ (when (fboundp setf-function-name)
+ (doc 'function setf-function-name))))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (ecase namespace
+ (:variable
+ (describe symbol))
+ ((:function :generic-function)
+ (describe (symbol-function symbol)))
+ (:setf
+ (describe (ccl::setf-function-spec-name `(setf ,symbol))))
+ (:class
+ (describe (find-class symbol)))))
+
+(defimplementation toggle-trace (spec)
+ "We currently ignore just about everything."
+ (ecase (car spec)
+ (setf
+ (ccl::%trace spec))
+ (:defmethod
+ (ccl::%trace (second spec)))
+ (:defgeneric
+ (ccl::%trace (second spec)))
+ (:call
+ (toggle-trace (third spec)))
+ ;; mb: FIXME: shouldn't we warn that we're not doing anything for
+ ;; these two?
+ (:labels nil)
+ (:flet nil))
+ t)
+
+;;; XREF
+
+(defimplementation list-callers (symbol)
+ (loop for caller in (ccl::callers symbol)
+ append (multiple-value-bind (info name type specializers modifiers)
+ (ccl::edit-definition-p caller)
+ (loop for (nil . file) in info
+ collect (list (if (eq t type)
+ name
+ `(,type ,name ,specializers
+ ,@modifiers))
+ (canonicalize-location file name))))))
+;;; Macroexpansion
+
+(defvar *value2tag* (make-hash-table))
+
+(do-symbols (s (find-package 'arch))
+ (if (and (> (length (symbol-name s)) 7)
+ (string= (symbol-name s) "SUBTAG-" :end1 7)
+ (boundp s)
+ (numberp (symbol-value s))
+ (< (symbol-value s) 255))
+ (setf (gethash (symbol-value s) *value2tag*) s)))
+
+;;;; Inspection
+
+(defclass openmcl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+ (make-instance 'openmcl-inspector))
+
+(defimplementation describe-primitive-type (thing)
+ (let ((typecode (ccl::typecode thing)))
+ (if (gethash typecode *value2tag*)
+ (string (gethash typecode *value2tag*))
+ (string (nth typecode '(tag-fixnum tag-list tag-misc tag-imm))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (let* ((i (inspector::make-inspector o))
+ (count (inspector::compute-line-count i))
+ (lines
+ (loop
+ for l below count
+ for (value label) = (multiple-value-list
+ (inspector::line-n i l))
+ collect `(:value ,label ,(string-capitalize (format nil "~a" label)))
+ collect " = "
+ collect `(:value ,value)
+ collect '(:newline))))
+ (values (with-output-to-string (s)
+ (let ((*print-lines* 1)
+ (*print-right-margin* 80))
+ (pprint o s)))
+ lines)))
+
+(defmethod inspect-for-emacs :around ((o t) (inspector backend-inspector))
+ (if (or (uvector-inspector-p o)
+ (not (ccl:uvectorp o)))
+ (call-next-method)
+ (multiple-value-bind (title content)
+ (call-next-method)
+ (values
+ title
+ (append content
+ `((:newline)
+ (:value ,(make-instance 'uvector-inspector :object o)
+ "Underlying UVECTOR")))))))
+
+(defclass uvector-inspector ()
+ ((object :initarg :object)))
+
+(defgeneric uvector-inspector-p (object)
+ (:method ((object t)) nil)
+ (:method ((object uvector-inspector)) t))
+
+(defmethod inspect-for-emacs ((uv uvector-inspector)
+ (inspector backend-inspector))
+ (with-slots (object)
+ uv
+ (values (format nil "The UVECTOR for ~S." object)
+ (loop
+ for index below (ccl::uvsize object)
+ collect (format nil "~D: " index)
+ collect `(:value ,(ccl::uvref object index))
+ collect `(:newline)))))
+
+(defun closure-closed-over-values (closure)
+ (let ((howmany (nth-value 8 (ccl::function-args (ccl::closure-function closure)))))
+ (loop for n below howmany
+ collect
+ (let* ((value (ccl::%svref closure (+ 1 (- howmany n))))
+ (map (car (ccl::function-symbol-map (ccl::closure-function closure))))
+ (label (or (and map (svref map n)) n))
+ (cellp (ccl::closed-over-value-p value)))
+ (list label (if cellp (ccl::closed-over-value value) value))))))
+
+(defmethod inspect-for-emacs ((c ccl::compiled-lexical-closure) (inspector t))
+ (declare (ignore inspector))
+ (values
+ (format nil "A closure: ~a" c)
+ `(,@(if (arglist c)
+ (list "Its argument list is: "
+ (funcall (intern "INSPECTOR-PRINC" 'swank) (arglist c)))
+ ;; FIXME inspector-princ should load earlier
+ (list "A function of no arguments"))
+ (:newline)
+ ,@(when (documentation c t)
+ `("Documentation:" (:newline) ,(documentation c t) (:newline)))
+ ,(format nil "Closed over ~a values" (length (closure-closed-over-values c)))
+ (:newline)
+ ,@(loop for (name value) in (closure-closed-over-values c)
+ for count from 1
+ append
+ (label-value-line* ((format nil "~2,' d) ~a" count (string name)) value))))))
+
+
+
+
+;;; Multiprocessing
+
+(defvar *known-processes* '() ; FIXME: leakage. -luke
+ "Alist (ID . PROCESS MAILBOX) list of processes that we have handed
+out IDs for.")
+
+(defvar *known-processes-lock* (ccl:make-lock "*known-processes-lock*"))
+
+(defstruct (mailbox (:conc-name mailbox.))
+ (mutex (ccl:make-lock "thread mailbox"))
+ (semaphore (ccl:make-semaphore))
+ (queue '() :type list))
+
+(defimplementation spawn (fn &key name)
+ (ccl:process-run-function (or name "Anonymous (Swank)") fn))
+
+(defimplementation thread-id (thread)
+ (ccl::process-serial-number thread))
+
+(defimplementation find-thread (id)
+ (find id (ccl:all-processes) :key #'ccl::process-serial-number))
+
+(defimplementation thread-name (thread)
+ (ccl::process-name thread))
+
+(defimplementation thread-status (thread)
+ (format nil "~A" (ccl:process-whostate thread)))
+
+(defimplementation make-lock (&key name)
+ (ccl:make-lock name))
+
+(defimplementation call-with-lock-held (lock function)
+ (ccl:with-lock-grabbed (lock)
+ (funcall function)))
+
+(defimplementation current-thread ()
+ ccl:*current-process*)
+
+(defimplementation all-threads ()
+ (ccl:all-processes))
+
+(defimplementation kill-thread (thread)
+ (ccl:process-kill thread))
+
+;; September 5, 2004 alanr. record the frame interrupted
+(defimplementation interrupt-thread (thread fn)
+ (ccl:process-interrupt
+ thread
+ (lambda(&rest args)
+ (let ((previous-f nil))
+ (block find-frame
+ (map-backtrace
+ #'(lambda(frame-number p context lfun pc)
+ (declare (ignore frame-number context pc))
+ (when (eq previous-f 'ccl::%pascal-functions%)
+ (record-stack-top p)
+ (return-from find-frame))
+ (setq previous-f (ccl::lfun-name lfun)))))
+ (apply fn args)))))
+
+
+(defun mailbox (thread)
+ (ccl:with-lock-grabbed (*known-processes-lock*)
+ (let ((probe (rassoc thread *known-processes* :key #'car)))
+ (cond (probe (second (cdr probe)))
+ (t (let ((mailbox (make-mailbox)))
+ (setq *known-processes*
+ (acons (ccl::process-serial-number thread)
+ (list thread mailbox)
+ (remove-if
+ (lambda(entry)
+ (string= (ccl::process-whostate (second entry)) "Exhausted"))
+ *known-processes*)
+ ))
+ mailbox))))))
+
+(defimplementation send (thread message)
+ (assert message)
+ (let* ((mbox (mailbox thread))
+ (mutex (mailbox.mutex mbox)))
+ (ccl:with-lock-grabbed (mutex)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message)))
+ (ccl:signal-semaphore (mailbox.semaphore mbox)))))
+
+(defimplementation receive ()
+ (let* ((mbox (mailbox ccl:*current-process*))
+ (mutex (mailbox.mutex mbox)))
+ (ccl:wait-on-semaphore (mailbox.semaphore mbox))
+ (ccl:with-lock-grabbed (mutex)
+ (assert (mailbox.queue mbox))
+ (pop (mailbox.queue mbox)))))
+
+(defimplementation quit-lisp ()
+ (ccl::quit))
+
+;;; Weak datastructures
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak :key args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ (apply #'make-hash-table :weak :value args))
+
+(defimplementation hash-table-weakness (hashtable)
+ (ccl::hash-table-weak-p hashtable))
Added: branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1323 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; swank-sbcl.lisp --- SLIME backend for SBCL.
+;;;
+;;; Created 2003, Daniel Barlow <dan(a)metacircles.com>
+;;;
+;;; This code has been placed in the Public Domain. All warranties are
+;;; disclaimed.
+
+;;; Requires the SB-INTROSPECT contrib.
+
+;;; Administrivia
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (require 'asdf)
+ (require 'sb-bsd-sockets)
+ (require 'sb-introspect)
+ (require 'sb-posix)
+ (require 'sb-cltl2))
+
+(declaim (optimize (debug 2) (sb-c:insert-step-conditions 0)))
+
+(import-from :sb-gray *gray-stream-symbols* :swank-backend)
+
+;;; backwards compability tests
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; Generate a form suitable for testing for stepper support (0.9.17)
+ ;; with #+.
+ (defun sbcl-with-new-stepper-p ()
+ (if (find-symbol "ENABLE-STEPPING" "SB-IMPL")
+ '(:and)
+ '(:or)))
+ ;; Ditto for weak hash-tables
+ (defun sbcl-with-weak-hash-tables ()
+ (if (find-symbol "HASH-TABLE-WEAKNESS" "SB-EXT")
+ '(:and)
+ '(:or)))
+ ;; And for xref support (1.0.1)
+ (defun sbcl-with-xref-p ()
+ (if (find-symbol "WHO-CALLS" "SB-INTROSPECT")
+ '(:and)
+ '(:or)))
+ ;; ... for restart-frame support (1.0.2)
+ (defun sbcl-with-restart-frame ()
+ (if (find-symbol "FRAME-HAS-DEBUG-TAG-P" "SB-DEBUG")
+ '(:and)
+ '(:or))))
+
+;;; swank-mop
+
+(import-swank-mop-symbols :sb-mop '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (sb-pcl::documentation slot t))
+
+;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+ (cond
+ ;; fixme: when SBCL/win32 gains better select() support, remove
+ ;; this.
+ ((member :win32 *features*) nil)
+ ((member :sb-thread *features*) :spawn)
+ (t :fd-handler)))
+
+(defun resolve-hostname (name)
+ (car (sb-bsd-sockets:host-ent-addresses
+ (sb-bsd-sockets:get-host-by-name name))))
+
+(defimplementation create-socket (host port)
+ (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream
+ :protocol :tcp)))
+ (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
+ (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
+ (sb-bsd-sockets:socket-listen socket 5)
+ socket))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (sb-bsd-sockets:socket-name socket)))
+
+(defimplementation close-socket (socket)
+ (sb-sys:invalidate-descriptor (socket-fd socket))
+ (sb-bsd-sockets:socket-close socket))
+
+(defimplementation accept-connection (socket &key
+ external-format
+ buffering timeout)
+ (declare (ignore timeout))
+ (make-socket-io-stream (accept socket)
+ (or external-format :iso-latin-1-unix)
+ (or buffering :full)))
+
+(defvar *sigio-handlers* '()
+ "List of (key . fn) pairs to be called on SIGIO.")
+
+(defun sigio-handler (signal code scp)
+ (declare (ignore signal code scp))
+ (mapc (lambda (handler)
+ (funcall (the function (cdr handler))))
+ *sigio-handlers*))
+
+(defun set-sigio-handler ()
+ (sb-sys:enable-interrupt sb-unix:sigio (lambda (signal code scp)
+ (sigio-handler signal code scp))))
+
+(defun enable-sigio-on-fd (fd)
+ (sb-posix::fcntl fd sb-posix::f-setfl sb-posix::o-async)
+ (sb-posix::fcntl fd sb-posix::f-setown (getpid)))
+
+(defimplementation add-sigio-handler (socket fn)
+ (set-sigio-handler)
+ (let ((fd (socket-fd socket)))
+ (format *debug-io* "Adding sigio handler: ~S ~%" fd)
+ (enable-sigio-on-fd fd)
+ (push (cons fd fn) *sigio-handlers*)))
+
+(defimplementation remove-sigio-handlers (socket)
+ (let ((fd (socket-fd socket)))
+ (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car))
+ (sb-sys:invalidate-descriptor fd))
+ (close socket))
+
+(defimplementation add-fd-handler (socket fn)
+ (declare (type function fn))
+ (let ((fd (socket-fd socket)))
+ (format *debug-io* "; Adding fd handler: ~S ~%" fd)
+ (sb-sys:add-fd-handler fd :input (lambda (_)
+ _
+ (funcall fn)))))
+
+(defimplementation remove-fd-handlers (socket)
+ (sb-sys:invalidate-descriptor (socket-fd socket)))
+
+(defun socket-fd (socket)
+ (etypecase socket
+ (fixnum socket)
+ (sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket))
+ (file-stream (sb-sys:fd-stream-fd socket))))
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")
+ (:euc-jp "euc-jp" "euc-jp-unix")
+ (:us-ascii "us-ascii" "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+(defun make-socket-io-stream (socket external-format buffering)
+ (sb-bsd-sockets:socket-make-stream socket
+ :output t
+ :input t
+ :element-type 'character
+ :buffering buffering
+ #+sb-unicode :external-format
+ #+sb-unicode external-format
+ ))
+
+(defun accept (socket)
+ "Like socket-accept, but retry on EAGAIN."
+ (loop (handler-case
+ (return (sb-bsd-sockets:socket-accept socket))
+ (sb-bsd-sockets:interrupted-error ()))))
+
+(defimplementation call-without-interrupts (fn)
+ (declare (type function fn))
+ (sb-sys:without-interrupts (funcall fn)))
+
+(defimplementation getpid ()
+ (sb-posix:getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ "sbcl")
+
+
+;;;; Support for SBCL syntax
+
+;;; SBCL's source code is riddled with #! reader macros. Also symbols
+;;; containing `!' have special meaning. We have to work long and
+;;; hard to be able to read the source. To deal with #! reader
+;;; macros, we use a special readtable. The special symbols are
+;;; converted by a condition handler.
+
+(defun feature-in-list-p (feature list)
+ (etypecase feature
+ (symbol (member feature list :test #'eq))
+ (cons (flet ((subfeature-in-list-p (subfeature)
+ (feature-in-list-p subfeature list)))
+ (ecase (first feature)
+ (:or (some #'subfeature-in-list-p (rest feature)))
+ (:and (every #'subfeature-in-list-p (rest feature)))
+ (:not (destructuring-bind (e) (cdr feature)
+ (not (subfeature-in-list-p e)))))))))
+
+(defun shebang-reader (stream sub-character infix-parameter)
+ (declare (ignore sub-character))
+ (when infix-parameter
+ (error "illegal read syntax: #~D!" infix-parameter))
+ (let ((next-char (read-char stream)))
+ (unless (find next-char "+-")
+ (error "illegal read syntax: #!~C" next-char))
+ ;; When test is not satisfied
+ ;; FIXME: clearer if order of NOT-P and (NOT NOT-P) were reversed? then
+ ;; would become "unless test is satisfied"..
+ (when (let* ((*package* (find-package "KEYWORD"))
+ (*read-suppress* nil)
+ (not-p (char= next-char #\-))
+ (feature (read stream)))
+ (if (feature-in-list-p feature *features*)
+ not-p
+ (not not-p)))
+ ;; Read (and discard) a form from input.
+ (let ((*read-suppress* t))
+ (read stream t nil t))))
+ (values))
+
+(defvar *shebang-readtable*
+ (let ((*readtable* (copy-readtable nil)))
+ (set-dispatch-macro-character #\# #\!
+ (lambda (s c n) (shebang-reader s c n))
+ *readtable*)
+ *readtable*))
+
+(defun shebang-readtable ()
+ *shebang-readtable*)
+
+(defun sbcl-package-p (package)
+ (let ((name (package-name package)))
+ (eql (mismatch "SB-" name) 3)))
+
+(defun sbcl-source-file-p (filename)
+ (loop for (_ pattern) in (logical-pathname-translations "SYS")
+ thereis (pathname-match-p filename pattern)))
+
+(defun guess-readtable-for-filename (filename)
+ (if (sbcl-source-file-p filename)
+ (shebang-readtable)
+ *readtable*))
+
+(defvar *debootstrap-packages* t)
+
+(defun call-with-debootstrapping (fun)
+ (handler-bind ((sb-int:bootstrap-package-not-found
+ #'sb-int:debootstrap-package))
+ (funcall fun)))
+
+(defmacro with-debootstrapping (&body body)
+ `(call-with-debootstrapping (lambda () ,@body)))
+
+(defimplementation call-with-syntax-hooks (fn)
+ (cond ((and *debootstrap-packages*
+ (sbcl-package-p *package*))
+ (with-debootstrapping (funcall fn)))
+ (t
+ (funcall fn))))
+
+(defimplementation default-readtable-alist ()
+ (let ((readtable (shebang-readtable)))
+ (loop for p in (remove-if-not #'sbcl-package-p (list-all-packages))
+ collect (cons (package-name p) readtable))))
+
+;;; Utilities
+
+(defimplementation arglist (fname)
+ (sb-introspect:function-arglist fname))
+
+(defimplementation function-name (f)
+ (check-type f function)
+ (sb-impl::%fun-name f))
+
+(defmethod declaration-arglist ((decl-identifier (eql 'optimize)))
+ (flet ((ensure-list (thing) (if (listp thing) thing (list thing))))
+ (let* ((flags (sb-cltl2:declaration-information decl-identifier)))
+ (if flags
+ ;; Symbols aren't printed with package qualifiers, but the FLAGS would
+ ;; have to be fully qualified when used inside a declaration. So we
+ ;; strip those as long as there's no better way. (FIXME)
+ `(&any ,@(remove-if-not #'(lambda (qualifier)
+ (find-symbol (symbol-name (first qualifier)) :cl))
+ flags :key #'ensure-list))
+ (call-next-method)))))
+
+(defvar *buffer-name* nil)
+(defvar *buffer-offset*)
+(defvar *buffer-substring* nil)
+
+(defvar *previous-compiler-condition* nil
+ "Used to detect duplicates.")
+
+(defun handle-notification-condition (condition)
+ "Handle a condition caused by a compiler warning.
+This traps all compiler conditions at a lower-level than using
+C:*COMPILER-NOTIFICATION-FUNCTION*. The advantage is that we get to
+craft our own error messages, which can omit a lot of redundant
+information."
+ (let ((context (sb-c::find-error-context nil)))
+ (unless (eq condition *previous-compiler-condition*)
+ (setq *previous-compiler-condition* condition)
+ (signal-compiler-condition condition context))))
+
+(defun signal-compiler-condition (condition context)
+ (signal (make-condition
+ 'compiler-condition
+ :original-condition condition
+ :severity (etypecase condition
+ (sb-c:compiler-error :error)
+ (sb-ext:compiler-note :note)
+ (style-warning :style-warning)
+ (warning :warning)
+ (error :error))
+ :short-message (brief-compiler-message-for-emacs condition)
+ :references (condition-references (real-condition condition))
+ :message (long-compiler-message-for-emacs condition context)
+ :location (compiler-note-location context))))
+
+(defun real-condition (condition)
+ "Return the encapsulated condition or CONDITION itself."
+ (typecase condition
+ (sb-int:encapsulated-condition (sb-int:encapsulated-condition condition))
+ (t condition)))
+
+(defun condition-references (condition)
+ (if (typep condition 'sb-int:reference-condition)
+ (externalize-reference
+ (sb-int:reference-condition-references condition))))
+
+(defun compiler-note-location (context)
+ (if context
+ (locate-compiler-note
+ (sb-c::compiler-error-context-file-name context)
+ (compiler-source-path context)
+ (sb-c::compiler-error-context-original-source context))
+ (list :error "No error location available")))
+
+(defun locate-compiler-note (file source-path source)
+ (cond ((and (not (eq file :lisp)) *buffer-name*)
+ ;; Compiling from a buffer
+ (let ((position (+ *buffer-offset*
+ (source-path-string-position
+ source-path *buffer-substring*))))
+ (make-location (list :buffer *buffer-name*)
+ (list :position position))))
+ ((and (pathnamep file) (null *buffer-name*))
+ ;; Compiling from a file
+ (make-location (list :file (namestring file))
+ (list :position
+ (1+ (source-path-file-position
+ source-path file)))))
+ ((and (eq file :lisp) (stringp source))
+ ;; Compiling macro generated code
+ (make-location (list :source-form source)
+ (list :position 1)))
+ (t
+ (error "unhandled case in compiler note ~S ~S ~S" file source-path source))))
+
+(defun brief-compiler-message-for-emacs (condition)
+ "Briefly describe a compiler error for Emacs.
+When Emacs presents the message it already has the source popped up
+and the source form highlighted. This makes much of the information in
+the error-context redundant."
+ (let ((sb-int:*print-condition-references* nil))
+ (princ-to-string condition)))
+
+(defun long-compiler-message-for-emacs (condition error-context)
+ "Describe a compiler error for Emacs including context information."
+ (declare (type (or sb-c::compiler-error-context null) error-context))
+ (multiple-value-bind (enclosing source)
+ (if error-context
+ (values (sb-c::compiler-error-context-enclosing-source error-context)
+ (sb-c::compiler-error-context-source error-context)))
+ (let ((sb-int:*print-condition-references* nil))
+ (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]~A"
+ enclosing source condition))))
+
+(defun compiler-source-path (context)
+ "Return the source-path for the current compiler error.
+Returns NIL if this cannot be determined by examining internal
+compiler state."
+ (cond ((sb-c::node-p context)
+ (reverse
+ (sb-c::source-path-original-source
+ (sb-c::node-source-path context))))
+ ((sb-c::compiler-error-context-p context)
+ (reverse
+ (sb-c::compiler-error-context-original-source-path context)))))
+
+(defimplementation call-with-compilation-hooks (function)
+ (declare (type function function))
+ (handler-bind ((sb-c:fatal-compiler-error #'handle-file-compiler-termination)
+ (sb-c:compiler-error #'handle-notification-condition)
+ (sb-ext:compiler-note #'handle-notification-condition)
+ (style-warning #'handle-notification-condition)
+ (warning #'handle-notification-condition))
+ (funcall function)))
+
+(defun handle-file-compiler-termination (condition)
+ "Handle a condition that caused the file compiler to terminate."
+ (handle-notification-condition
+ (sb-int:encapsulated-condition condition)))
+
+(defvar *trap-load-time-warnings* nil)
+
+(defimplementation swank-compile-file (filename load-p external-format)
+ (handler-case
+ (let ((output-file (with-compilation-hooks ()
+ (compile-file filename
+ :external-format external-format))))
+ (when output-file
+ ;; Cache the latest source file for definition-finding.
+ (source-cache-get filename (file-write-date filename))
+ (when load-p
+ (load output-file))))
+ (sb-c:fatal-compiler-error () nil)))
+
+;;;; compile-string
+
+;;; We copy the string to a temporary file in order to get adequate
+;;; semantics for :COMPILE-TOPLEVEL and :LOAD-TOPLEVEL EVAL-WHEN forms
+;;; which the previous approach using
+;;; (compile nil `(lambda () ,(read-from-string string)))
+;;; did not provide.
+
+(sb-alien:define-alien-routine "tmpnam" sb-alien:c-string
+ (dest (* sb-alien:c-string)))
+
+(defun temp-file-name ()
+ "Return a temporary file name to compile strings into."
+ (concatenate 'string (tmpnam nil) ".lisp"))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ (let ((*buffer-name* buffer)
+ (*buffer-offset* position)
+ (*buffer-substring* string)
+ (filename (temp-file-name)))
+ (flet ((compile-it (fn)
+ (with-compilation-hooks ()
+ (with-compilation-unit
+ (:source-plist (list :emacs-buffer buffer
+ :emacs-directory directory
+ :emacs-string string
+ :emacs-position position))
+ (funcall fn (compile-file filename))))))
+ (with-open-file (s filename :direction :output :if-exists :error)
+ (write-string string s))
+ (unwind-protect
+ (if *trap-load-time-warnings*
+ (compile-it #'load)
+ (load (compile-it #'identity)))
+ (ignore-errors
+ (delete-file filename)
+ (delete-file (compile-file-pathname filename)))))))
+
+;;;; Definitions
+
+(defvar *debug-definition-finding* nil
+ "When true don't handle errors while looking for definitions.
+This is useful when debugging the definition-finding code.")
+
+(defparameter *definition-types*
+ '(:variable defvar
+ :constant defconstant
+ :type deftype
+ :symbol-macro define-symbol-macro
+ :macro defmacro
+ :compiler-macro define-compiler-macro
+ :function defun
+ :generic-function defgeneric
+ :method defmethod
+ :setf-expander define-setf-expander
+ :structure defstruct
+ :condition define-condition
+ :class defclass
+ :method-combination define-method-combination
+ :package defpackage
+ :transform :deftransform
+ :optimizer :defoptimizer
+ :vop :define-vop
+ :source-transform :define-source-transform)
+ "Map SB-INTROSPECT definition type names to Slime-friendly forms")
+
+(defimplementation find-definitions (name)
+ (loop for type in *definition-types* by #'cddr
+ for locations = (sb-introspect:find-definition-sources-by-name
+ name type)
+ append (loop for source-location in locations collect
+ (make-source-location-specification type name
+ source-location))))
+
+(defun make-source-location-specification (type name source-location)
+ (list (list* (getf *definition-types* type)
+ name
+ (sb-introspect::definition-source-description source-location))
+ (if *debug-definition-finding*
+ (make-definition-source-location source-location type name)
+ (handler-case
+ (make-definition-source-location source-location type name)
+ (error (e)
+ (list :error (format nil "Error: ~A" e)))))))
+
+(defun make-definition-source-location (definition-source type name)
+ (with-struct (sb-introspect::definition-source-
+ pathname form-path character-offset plist
+ file-write-date)
+ definition-source
+ (destructuring-bind (&key emacs-buffer emacs-position emacs-directory
+ emacs-string &allow-other-keys)
+ plist
+ (cond
+ (emacs-buffer
+ (let* ((*readtable* (guess-readtable-for-filename emacs-directory))
+ (pos (if form-path
+ (with-debootstrapping
+ (source-path-string-position form-path emacs-string))
+ character-offset))
+ (snippet (string-path-snippet emacs-string form-path pos)))
+ (make-location `(:buffer ,emacs-buffer)
+ `(:position ,(+ pos emacs-position))
+ `(:snippet ,snippet))))
+ ((not pathname)
+ `(:error ,(format nil "Source of ~A ~A not found"
+ (string-downcase type) name)))
+ (t
+ (let* ((namestring (namestring (translate-logical-pathname pathname)))
+ (pos (source-file-position namestring file-write-date form-path
+ character-offset))
+ (snippet (source-hint-snippet namestring file-write-date pos)))
+ (make-location `(:file ,namestring)
+ `(:position ,pos)
+ `(:snippet ,snippet))))))))
+
+(defun string-path-snippet (string form-path position)
+ (if form-path
+ ;; If we have a form-path, use it to derive a more accurate
+ ;; snippet, so that we can point to the individual form rather
+ ;; than just the toplevel form.
+ (multiple-value-bind (data end)
+ (let ((*read-suppress* t))
+ (read-from-string string nil nil :start position))
+ (declare (ignore data))
+ (subseq string position end))
+ string))
+
+(defun source-file-position (filename write-date form-path character-offset)
+ (let ((source (get-source-code filename write-date))
+ (*readtable* (guess-readtable-for-filename filename)))
+ (1+ (with-debootstrapping
+ (if form-path
+ (source-path-string-position form-path source)
+ (or character-offset 0))))))
+
+(defun source-hint-snippet (filename write-date position)
+ (let ((source (get-source-code filename write-date)))
+ (with-input-from-string (s source)
+ (read-snippet s position))))
+
+(defun function-source-location (function &optional name)
+ (declare (type function function))
+ (let ((location (sb-introspect:find-definition-source function)))
+ (make-definition-source-location location :function name)))
+
+(defun safe-function-source-location (fun name)
+ (if *debug-definition-finding*
+ (function-source-location fun name)
+ (handler-case (function-source-location fun name)
+ (error (e)
+ (list :error (format nil "Error: ~A" e))))))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ "Return a plist describing SYMBOL.
+Return NIL if the symbol is unbound."
+ (let ((result '()))
+ (flet ((doc (kind)
+ (or (documentation symbol kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (multiple-value-bind (kind recorded-p)
+ (sb-int:info :variable :kind symbol)
+ (declare (ignore kind))
+ (if (or (boundp symbol) recorded-p)
+ (doc 'variable))))
+ (when (fboundp symbol)
+ (maybe-push
+ (cond ((macro-function symbol) :macro)
+ ((special-operator-p symbol) :special-operator)
+ ((typep (fdefinition symbol) 'generic-function)
+ :generic-function)
+ (t :function))
+ (doc 'function)))
+ (maybe-push
+ :setf (if (or (sb-int:info :setf :inverse symbol)
+ (sb-int:info :setf :expander symbol))
+ (doc 'setf)))
+ (maybe-push
+ :type (if (sb-int:info :type :kind symbol)
+ (doc 'type)))
+ result)))
+
+(defimplementation describe-definition (symbol type)
+ (case type
+ (:variable
+ (describe symbol))
+ (:function
+ (describe (symbol-function symbol)))
+ (:setf
+ (describe (or (sb-int:info :setf :inverse symbol)
+ (sb-int:info :setf :expander symbol))))
+ (:class
+ (describe (find-class symbol)))
+ (:type
+ (describe (sb-kernel:values-specifier-type symbol)))))
+
+#+#.(swank-backend::sbcl-with-xref-p)
+(progn
+ (defmacro defxref (name)
+ `(defimplementation ,name (what)
+ (sanitize-xrefs
+ (mapcar #'source-location-for-xref-data
+ (,(find-symbol (symbol-name name) "SB-INTROSPECT")
+ what)))))
+ (defxref who-calls)
+ (defxref who-binds)
+ (defxref who-sets)
+ (defxref who-references)
+ (defxref who-macroexpands))
+
+(defun source-location-for-xref-data (xref-data)
+ (let ((name (car xref-data))
+ (source-location (cdr xref-data)))
+ (list name
+ (handler-case (make-definition-source-location source-location
+ 'function
+ name)
+ (error (e)
+ (list :error (format nil "Error: ~A" e)))))))
+
+(defimplementation list-callers (symbol)
+ (let ((fn (fdefinition symbol)))
+ (sanitize-xrefs
+ (mapcar #'function-dspec (sb-introspect:find-function-callers fn)))))
+
+(defimplementation list-callees (symbol)
+ (let ((fn (fdefinition symbol)))
+ (sanitize-xrefs
+ (mapcar #'function-dspec (sb-introspect:find-function-callees fn)))))
+
+(defun sanitize-xrefs (xrefs)
+ (remove-duplicates
+ (remove-if (lambda (f)
+ (member f (ignored-xref-function-names)))
+ (loop for entry in xrefs
+ for name = (car entry)
+ collect (if (and (consp name)
+ (member (car name)
+ '(sb-pcl::fast-method
+ sb-pcl::slow-method
+ sb-pcl::method)))
+ (cons (cons 'defmethod (cdr name))
+ (cdr entry))
+ entry))
+ :key #'car)
+ :test (lambda (a b)
+ (and (eq (first a) (first b))
+ (equal (second a) (second b))))))
+
+(defun ignored-xref-function-names ()
+ #-#.(swank-backend::sbcl-with-new-stepper-p)
+ '(nil sb-c::step-form sb-c::step-values)
+ #+#.(swank-backend::sbcl-with-new-stepper-p)
+ '(nil))
+
+(defun function-dspec (fn)
+ "Describe where the function FN was defined.
+Return a list of the form (NAME LOCATION)."
+ (let ((name (sb-kernel:%fun-name fn)))
+ (list name (safe-function-source-location fn name))))
+
+;;; macroexpansion
+
+(defimplementation macroexpand-all (form)
+ (let ((sb-walker:*walk-form-expand-macros-p* t))
+ (sb-walker:walk-form form)))
+
+
+;;; Debugging
+
+(defvar *sldb-stack-top*)
+
+(defimplementation install-debugger-globally (function)
+ (setq sb-ext:*invoke-debugger-hook* function))
+
+(defimplementation condition-extras (condition)
+ (cond #+#.(swank-backend::sbcl-with-new-stepper-p)
+ ((typep condition 'sb-impl::step-form-condition)
+ `((:show-frame-source 0)))
+ ((typep condition 'sb-int:reference-condition)
+ (let ((refs (sb-int:reference-condition-references condition)))
+ (if refs
+ `((:references ,(externalize-reference refs))))))))
+
+(defun externalize-reference (ref)
+ (etypecase ref
+ (null nil)
+ (cons (cons (externalize-reference (car ref))
+ (externalize-reference (cdr ref))))
+ ((or string number) ref)
+ (symbol
+ (cond ((eq (symbol-package ref) (symbol-package :test))
+ ref)
+ (t (symbol-name ref))))))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (declare (type function debugger-loop-fn))
+ (let* ((*sldb-stack-top* (or sb-debug:*stack-top-hint* (sb-di:top-frame)))
+ (sb-debug:*stack-top-hint* nil))
+ (handler-bind ((sb-di:debug-condition
+ (lambda (condition)
+ (signal (make-condition
+ 'sldb-condition
+ :original-condition condition)))))
+ (funcall debugger-loop-fn))))
+
+#+#.(swank-backend::sbcl-with-new-stepper-p)
+(progn
+ (defimplementation activate-stepping (frame)
+ (declare (ignore frame))
+ (sb-impl::enable-stepping))
+ (defimplementation sldb-stepper-condition-p (condition)
+ (typep condition 'sb-ext:step-form-condition))
+ (defimplementation sldb-step-into ()
+ (invoke-restart 'sb-ext:step-into))
+ (defimplementation sldb-step-next ()
+ (invoke-restart 'sb-ext:step-next))
+ (defimplementation sldb-step-out ()
+ (invoke-restart 'sb-ext:step-out)))
+
+(defimplementation call-with-debugger-hook (hook fun)
+ (let ((sb-ext:*invoke-debugger-hook* hook)
+ #+#.(swank-backend::sbcl-with-new-stepper-p)
+ (sb-ext:*stepper-hook*
+ (lambda (condition)
+ (typecase condition
+ (sb-ext:step-form-condition
+ (let ((sb-debug:*stack-top-hint* (sb-di::find-stepped-frame)))
+ (sb-impl::invoke-debugger condition)))))))
+ (handler-bind (#+#.(swank-backend::sbcl-with-new-stepper-p)
+ (sb-ext:step-condition #'sb-impl::invoke-stepper))
+ (funcall fun))))
+
+(defun nth-frame (index)
+ (do ((frame *sldb-stack-top* (sb-di:frame-down frame))
+ (i index (1- i)))
+ ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+ "Return a list of frames starting with frame number START and
+continuing to frame number END or, if END is nil, the last frame on the
+stack."
+ (let ((end (or end most-positive-fixnum)))
+ (loop for f = (nth-frame start) then (sb-di:frame-down f)
+ for i from start below end
+ while f
+ collect f)))
+
+(defimplementation print-frame (frame stream)
+ (sb-debug::print-frame-call frame stream))
+
+;;;; Code-location -> source-location translation
+
+;;; If debug-block info is avaibale, we determine the file position of
+;;; the source-path for a code-location. If the code was compiled
+;;; with C-c C-c, we have to search the position in the source string.
+;;; If there's no debug-block info, we return the (less precise)
+;;; source-location of the corresponding function.
+
+(defun code-location-source-location (code-location)
+ (let* ((dsource (sb-di:code-location-debug-source code-location))
+ (plist (sb-c::debug-source-plist dsource)))
+ (if (getf plist :emacs-buffer)
+ (emacs-buffer-source-location code-location plist)
+ (ecase (sb-di:debug-source-from dsource)
+ (:file (file-source-location code-location))
+ (:lisp (lisp-source-location code-location))))))
+
+;;; FIXME: The naming policy of source-location functions is a bit
+;;; fuzzy: we have FUNCTION-SOURCE-LOCATION which returns the
+;;; source-location for a function, and we also have FILE-SOURCE-LOCATION &co
+;;; which returns the source location for a _code-location_.
+;;;
+;;; Maybe these should be named code-location-file-source-location,
+;;; etc, turned into generic functions, or something. In the very
+;;; least the names should indicate the main entry point vs. helper
+;;; status.
+
+(defun file-source-location (code-location)
+ (if (code-location-has-debug-block-info-p code-location)
+ (source-file-source-location code-location)
+ (fallback-source-location code-location)))
+
+(defun fallback-source-location (code-location)
+ (let ((fun (code-location-debug-fun-fun code-location)))
+ (cond (fun (function-source-location fun))
+ (t (error "Cannot find source location for: ~A " code-location)))))
+
+(defun lisp-source-location (code-location)
+ (let ((source (prin1-to-string
+ (sb-debug::code-location-source-form code-location 100))))
+ (make-location `(:source-form ,source) '(:position 0))))
+
+(defun emacs-buffer-source-location (code-location plist)
+ (if (code-location-has-debug-block-info-p code-location)
+ (destructuring-bind (&key emacs-buffer emacs-position emacs-string
+ &allow-other-keys)
+ plist
+ (let* ((pos (string-source-position code-location emacs-string))
+ (snipped (with-input-from-string (s emacs-string)
+ (read-snippet s pos))))
+ (make-location `(:buffer ,emacs-buffer)
+ `(:position ,(+ emacs-position pos))
+ `(:snippet ,snipped))))
+ (fallback-source-location code-location)))
+
+(defun source-file-source-location (code-location)
+ (let* ((code-date (code-location-debug-source-created code-location))
+ (filename (code-location-debug-source-name code-location))
+ (source-code (get-source-code filename code-date)))
+ (with-input-from-string (s source-code)
+ (let* ((pos (stream-source-position code-location s))
+ (snippet (read-snippet s pos)))
+ (make-location `(:file ,filename)
+ `(:position ,(1+ pos))
+ `(:snippet ,snippet))))))
+
+(defun code-location-debug-source-name (code-location)
+ (sb-c::debug-source-name (sb-di::code-location-debug-source code-location)))
+
+(defun code-location-debug-source-created (code-location)
+ (sb-c::debug-source-created
+ (sb-di::code-location-debug-source code-location)))
+
+(defun code-location-debug-fun-fun (code-location)
+ (sb-di:debug-fun-fun (sb-di:code-location-debug-fun code-location)))
+
+(defun code-location-has-debug-block-info-p (code-location)
+ (handler-case
+ (progn (sb-di:code-location-debug-block code-location)
+ t)
+ (sb-di:no-debug-blocks () nil)))
+
+(defun stream-source-position (code-location stream)
+ (let* ((cloc (sb-debug::maybe-block-start-location code-location))
+ (tlf-number (sb-di::code-location-toplevel-form-offset cloc))
+ (form-number (sb-di::code-location-form-number cloc)))
+ (multiple-value-bind (tlf pos-map) (read-source-form tlf-number stream)
+ (let* ((path-table (sb-di::form-number-translations tlf 0))
+ (path (cond ((<= (length path-table) form-number)
+ (warn "inconsistent form-number-translations")
+ (list 0))
+ (t
+ (reverse (cdr (aref path-table form-number)))))))
+ (source-path-source-position path tlf pos-map)))))
+
+(defun string-source-position (code-location string)
+ (with-input-from-string (s string)
+ (stream-source-position code-location s)))
+
+;;; source-path-file-position and friends are in swank-source-path-parser
+
+(defun safe-source-location-for-emacs (code-location)
+ (if *debug-definition-finding*
+ (code-location-source-location code-location)
+ (handler-case (code-location-source-location code-location)
+ (error (c) (list :error (format nil "~A" c))))))
+
+(defimplementation frame-source-location-for-emacs (index)
+ (safe-source-location-for-emacs
+ (sb-di:frame-code-location (nth-frame index))))
+
+(defun frame-debug-vars (frame)
+ "Return a vector of debug-variables in frame."
+ (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame)))
+
+(defun debug-var-value (var frame location)
+ (ecase (sb-di:debug-var-validity var location)
+ (:valid (sb-di:debug-var-value var frame))
+ ((:invalid :unknown) ':<not-available>)))
+
+(defimplementation frame-locals (index)
+ (let* ((frame (nth-frame index))
+ (loc (sb-di:frame-code-location frame))
+ (vars (frame-debug-vars frame)))
+ (loop for v across vars collect
+ (list :name (sb-di:debug-var-symbol v)
+ :id (sb-di:debug-var-id v)
+ :value (debug-var-value v frame loc)))))
+
+(defimplementation frame-var-value (frame var)
+ (let* ((frame (nth-frame frame))
+ (dvar (aref (frame-debug-vars frame) var)))
+ (debug-var-value dvar frame (sb-di:frame-code-location frame))))
+
+(defimplementation frame-catch-tags (index)
+ (mapcar #'car (sb-di:frame-catches (nth-frame index))))
+
+(defimplementation eval-in-frame (form index)
+ (let ((frame (nth-frame index)))
+ (funcall (the function
+ (sb-di:preprocess-for-eval form
+ (sb-di:frame-code-location frame)))
+ frame)))
+
+#+#.(swank-backend::sbcl-with-restart-frame)
+(progn
+ (defimplementation return-from-frame (index form)
+ (let* ((frame (nth-frame index)))
+ (cond ((sb-debug:frame-has-debug-tag-p frame)
+ (let ((values (multiple-value-list (eval-in-frame form index))))
+ (sb-debug:unwind-to-frame-and-call frame
+ (lambda ()
+ (values-list values)))))
+ (t (format nil "Cannot return from frame: ~S" frame)))))
+
+ (defimplementation restart-frame (index)
+ (let* ((frame (nth-frame index)))
+ (cond ((sb-debug:frame-has-debug-tag-p frame)
+ (let* ((call-list (sb-debug::frame-call-as-list frame))
+ (fun (fdefinition (car call-list)))
+ (thunk (lambda ()
+ ;; Ensure that the thunk gets tail-call-optimized
+ (declare (optimize (debug 1)))
+ (apply fun (cdr call-list)))))
+ (sb-debug:unwind-to-frame-and-call frame thunk)))
+ (t (format nil "Cannot restart frame: ~S" frame))))))
+
+;; FIXME: this implementation doesn't unwind the stack before
+;; re-invoking the function, but it's better than no implementation at
+;; all.
+#-#.(swank-backend::sbcl-with-restart-frame)
+(progn
+ (defun sb-debug-catch-tag-p (tag)
+ (and (symbolp tag)
+ (not (symbol-package tag))
+ (string= tag :sb-debug-catch-tag)))
+
+ (defimplementation return-from-frame (index form)
+ (let* ((frame (nth-frame index))
+ (probe (assoc-if #'sb-debug-catch-tag-p
+ (sb-di::frame-catches frame))))
+ (cond (probe (throw (car probe) (eval-in-frame form index)))
+ (t (format nil "Cannot return from frame: ~S" frame)))))
+
+ (defimplementation restart-frame (index)
+ (let ((frame (nth-frame index)))
+ (return-from-frame index (sb-debug::frame-call-as-list frame)))))
+
+;;;;; reference-conditions
+
+(defimplementation format-sldb-condition (condition)
+ (let ((sb-int:*print-condition-references* nil))
+ (princ-to-string condition)))
+
+
+;;;; Profiling
+
+(defimplementation profile (fname)
+ (when fname (eval `(sb-profile:profile ,fname))))
+
+(defimplementation unprofile (fname)
+ (when fname (eval `(sb-profile:unprofile ,fname))))
+
+(defimplementation unprofile-all ()
+ (sb-profile:unprofile)
+ "All functions unprofiled.")
+
+(defimplementation profile-report ()
+ (sb-profile:report))
+
+(defimplementation profile-reset ()
+ (sb-profile:reset)
+ "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+ (sb-profile:profile))
+
+(defimplementation profile-package (package callers methods)
+ (declare (ignore callers methods))
+ (eval `(sb-profile:profile ,(package-name (find-package package)))))
+
+
+;;;; Inspector
+
+(defclass sbcl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+ (make-instance 'sbcl-inspector))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (cond ((sb-di::indirect-value-cell-p o)
+ (values "A value cell." (label-value-line*
+ (:value (sb-kernel:value-cell-ref o)))))
+ (t
+ (multiple-value-bind (text label parts) (sb-impl::inspected-parts o)
+ (if label
+ (values text (loop for (l . v) in parts
+ append (label-value-line l v)))
+ (values text (loop for value in parts for i from 0
+ append (label-value-line i value))))))))
+
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (let ((header (sb-kernel:widetag-of o)))
+ (cond ((= header sb-vm:simple-fun-header-widetag)
+ (values "A simple-fun."
+ (label-value-line*
+ (:name (sb-kernel:%simple-fun-name o))
+ (:arglist (sb-kernel:%simple-fun-arglist o))
+ (:self (sb-kernel:%simple-fun-self o))
+ (:next (sb-kernel:%simple-fun-next o))
+ (:type (sb-kernel:%simple-fun-type o))
+ (:code (sb-kernel:fun-code-header o)))))
+ ((= header sb-vm:closure-header-widetag)
+ (values "A closure."
+ (append
+ (label-value-line :function (sb-kernel:%closure-fun o))
+ `("Closed over values:" (:newline))
+ (loop for i below (1- (sb-kernel:get-closure-length o))
+ append (label-value-line
+ i (sb-kernel:%closure-index-ref o i))))))
+ (t (call-next-method o)))))
+
+(defmethod inspect-for-emacs ((o sb-kernel:code-component) (_ backend-inspector))
+ (declare (ignore _))
+ (values (format nil "~A is a code data-block." o)
+ (append
+ (label-value-line*
+ (:code-size (sb-kernel:%code-code-size o))
+ (:entry-points (sb-kernel:%code-entry-points o))
+ (:debug-info (sb-kernel:%code-debug-info o))
+ (:trace-table-offset (sb-kernel:code-header-ref
+ o sb-vm:code-trace-table-offset-slot)))
+ `("Constants:" (:newline))
+ (loop for i from sb-vm:code-constants-offset
+ below (sb-kernel:get-header-data o)
+ append (label-value-line i (sb-kernel:code-header-ref o i)))
+ `("Code:" (:newline)
+ , (with-output-to-string (s)
+ (cond ((sb-kernel:%code-debug-info o)
+ (sb-disassem:disassemble-code-component o :stream s))
+ (t
+ (sb-disassem:disassemble-memory
+ (sb-disassem::align
+ (+ (logandc2 (sb-kernel:get-lisp-obj-address o)
+ sb-vm:lowtag-mask)
+ (* sb-vm:code-constants-offset
+ sb-vm:n-word-bytes))
+ (ash 1 sb-vm:n-lowtag-bits))
+ (ash (sb-kernel:%code-code-size o) sb-vm:word-shift)
+ :stream s))))))))
+
+(defmethod inspect-for-emacs ((o sb-ext:weak-pointer) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (values "A weak pointer."
+ (label-value-line*
+ (:value (sb-ext:weak-pointer-value o)))))
+
+(defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (values "A fdefn object."
+ (label-value-line*
+ (:name (sb-kernel:fdefn-name o))
+ (:function (sb-kernel:fdefn-fun o)))))
+
+(defmethod inspect-for-emacs :around ((o generic-function)
+ (inspector backend-inspector))
+ (declare (ignore inspector))
+ (multiple-value-bind (title contents) (call-next-method)
+ (values title
+ (append
+ contents
+ (label-value-line*
+ (:pretty-arglist (sb-pcl::generic-function-pretty-arglist o))
+ (:initial-methods (sb-pcl::generic-function-initial-methods o))
+ )))))
+
+
+;;;; Multiprocessing
+
+#+(and sb-thread
+ #.(cl:if (cl:find-symbol "THREAD-NAME" "SB-THREAD") '(and) '(or)))
+(progn
+ (defvar *thread-id-counter* 0)
+
+ (defvar *thread-id-counter-lock*
+ (sb-thread:make-mutex :name "thread id counter lock"))
+
+ (defun next-thread-id ()
+ (sb-thread:with-mutex (*thread-id-counter-lock*)
+ (incf *thread-id-counter*)))
+
+ (defparameter *thread-id-map* (make-hash-table))
+
+ ;; This should be a thread -> id map but as weak keys are not
+ ;; supported it is id -> map instead.
+ (defvar *thread-id-map-lock*
+ (sb-thread:make-mutex :name "thread id map lock"))
+
+ (defimplementation spawn (fn &key name)
+ (sb-thread:make-thread fn :name name))
+
+ (defimplementation thread-id (thread)
+ (block thread-id
+ (sb-thread:with-mutex (*thread-id-map-lock*)
+ (loop for id being the hash-key in *thread-id-map*
+ using (hash-value thread-pointer)
+ do
+ (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
+ (cond ((null maybe-thread)
+ ;; the value is gc'd, remove it manually
+ (remhash id *thread-id-map*))
+ ((eq thread maybe-thread)
+ (return-from thread-id id)))))
+ ;; lazy numbering
+ (let ((id (next-thread-id)))
+ (setf (gethash id *thread-id-map*) (sb-ext:make-weak-pointer thread))
+ id))))
+
+ (defimplementation find-thread (id)
+ (sb-thread:with-mutex (*thread-id-map-lock*)
+ (let ((thread-pointer (gethash id *thread-id-map*)))
+ (if thread-pointer
+ (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
+ (if maybe-thread
+ maybe-thread
+ ;; the value is gc'd, remove it manually
+ (progn
+ (remhash id *thread-id-map*)
+ nil)))
+ nil))))
+
+ (defimplementation thread-name (thread)
+ ;; sometimes the name is not a string (e.g. NIL)
+ (princ-to-string (sb-thread:thread-name thread)))
+
+ (defimplementation thread-status (thread)
+ (if (sb-thread:thread-alive-p thread)
+ "RUNNING"
+ "STOPPED"))
+
+ (defimplementation make-lock (&key name)
+ (sb-thread:make-mutex :name name))
+
+ (defimplementation call-with-lock-held (lock function)
+ (declare (type function function))
+ (sb-thread:with-mutex (lock) (funcall function)))
+
+ (defimplementation make-recursive-lock (&key name)
+ (sb-thread:make-mutex :name name))
+
+ (defimplementation call-with-recursive-lock-held (lock function)
+ (declare (type function function))
+ (sb-thread:with-recursive-lock (lock) (funcall function)))
+
+ (defimplementation current-thread ()
+ sb-thread:*current-thread*)
+
+ (defimplementation all-threads ()
+ (sb-thread:list-all-threads))
+
+ (defimplementation interrupt-thread (thread fn)
+ (sb-thread:interrupt-thread thread fn))
+
+ (defimplementation kill-thread (thread)
+ (sb-thread:terminate-thread thread))
+
+ (defimplementation thread-alive-p (thread)
+ (sb-thread:thread-alive-p thread))
+
+ (defvar *mailbox-lock* (sb-thread:make-mutex :name "mailbox lock"))
+ (defvar *mailboxes* (list))
+ (declaim (type list *mailboxes*))
+
+ (defstruct (mailbox (:conc-name mailbox.))
+ thread
+ (mutex (sb-thread:make-mutex))
+ (waitqueue (sb-thread:make-waitqueue))
+ (queue '() :type list))
+
+ (defun mailbox (thread)
+ "Return THREAD's mailbox."
+ (sb-thread:with-mutex (*mailbox-lock*)
+ (or (find thread *mailboxes* :key #'mailbox.thread)
+ (let ((mb (make-mailbox :thread thread)))
+ (push mb *mailboxes*)
+ mb))))
+
+ (defimplementation send (thread message)
+ (let* ((mbox (mailbox thread))
+ (mutex (mailbox.mutex mbox)))
+ (sb-thread:with-mutex (mutex)
+ (setf (mailbox.queue mbox)
+ (nconc (mailbox.queue mbox) (list message)))
+ (sb-thread:condition-broadcast (mailbox.waitqueue mbox)))))
+
+ (defimplementation receive ()
+ (let* ((mbox (mailbox (current-thread)))
+ (mutex (mailbox.mutex mbox)))
+ (sb-thread:with-mutex (mutex)
+ (loop
+ (let ((q (mailbox.queue mbox)))
+ (cond (q (return (pop (mailbox.queue mbox))))
+ (t (sb-thread:condition-wait (mailbox.waitqueue mbox)
+ mutex))))))))
+
+
+ ;; Auto-flush streams
+
+ (defvar *auto-flush-interval* 0.15
+ "How often to flush interactive streams. This valu is passed
+ directly to cl:sleep.")
+
+ (defvar *auto-flush-lock* (make-recursive-lock :name "auto flush"))
+
+ (defvar *auto-flush-thread* nil)
+
+ (defvar *auto-flush-streams* '())
+
+ (defimplementation make-stream-interactive (stream)
+ (call-with-recursive-lock-held
+ *auto-flush-lock*
+ (lambda ()
+ (pushnew stream *auto-flush-streams*)
+ (unless *auto-flush-thread*
+ (setq *auto-flush-thread*
+ (sb-thread:make-thread #'flush-streams
+ :name "auto-flush-thread"))))))
+
+ (defun flush-streams ()
+ (loop
+ (call-with-recursive-lock-held
+ *auto-flush-lock*
+ (lambda ()
+ (setq *auto-flush-streams*
+ (remove-if (lambda (x)
+ (not (and (open-stream-p x)
+ (output-stream-p x))))
+ *auto-flush-streams*))
+ (mapc #'finish-output *auto-flush-streams*)))
+ (sleep *auto-flush-interval*)))
+
+ )
+
+(defimplementation quit-lisp ()
+ #+sb-thread
+ (dolist (thread (remove (current-thread) (all-threads)))
+ (ignore-errors (sb-thread:interrupt-thread
+ thread (lambda () (sb-ext:quit :recklessly-p t)))))
+ (sb-ext:quit))
+
+
+
+;;Trace implementations
+;;In SBCL, we have:
+;; (trace <name>)
+;; (trace :methods '<name>) ;to trace all methods of the gf <name>
+;; (trace (method <name> <qualifier>? (<specializer>+)))
+;; <name> can be a normal name or a (setf name)
+
+(defun toggle-trace-aux (fspec &rest args)
+ (cond ((member fspec (eval '(trace)) :test #'equal)
+ (eval `(untrace ,fspec))
+ (format nil "~S is now untraced." fspec))
+ (t
+ (eval `(trace ,@(if args `(:encapsulate nil) (list)) ,fspec ,@args))
+ (format nil "~S is now traced." fspec))))
+
+(defun process-fspec (fspec)
+ (cond ((consp fspec)
+ (ecase (first fspec)
+ ((:defun :defgeneric) (second fspec))
+ ((:defmethod) `(method ,@(rest fspec)))
+ ((:labels) `(labels ,(process-fspec (second fspec)) ,(third fspec)))
+ ((:flet) `(flet ,(process-fspec (second fspec)) ,(third fspec)))))
+ (t
+ fspec)))
+
+(defimplementation toggle-trace (spec)
+ (ecase (car spec)
+ ((setf)
+ (toggle-trace-aux spec))
+ ((:defmethod)
+ (toggle-trace-aux `(sb-pcl::fast-method ,@(rest (process-fspec spec)))))
+ ((:defgeneric)
+ (toggle-trace-aux (second spec) :methods t))
+ ((:call)
+ (destructuring-bind (caller callee) (cdr spec)
+ (toggle-trace-aux callee :wherein (list (process-fspec caller)))))))
+
+;;; Weak datastructures
+
+(defimplementation make-weak-key-hash-table (&rest args)
+ #+#.(swank-backend::sbcl-with-weak-hash-tables)
+ (apply #'make-hash-table :weakness :key args)
+ #-#.(swank-backend::sbcl-with-weak-hash-tables)
+ (apply #'make-hash-table args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+ #+#.(swank-backend::sbcl-with-weak-hash-tables)
+ (apply #'make-hash-table :weakness :value args)
+ #-#.(swank-backend::sbcl-with-weak-hash-tables)
+ (apply #'make-hash-table args))
+
+(defimplementation hash-table-weakness (hashtable)
+ #+#.(swank-backend::sbcl-with-weak-hash-tables)
+ (sb-ext:hash-table-weakness hashtable))
Added: branches/trunk-reorg/thirdparty/slime/swank-scl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-scl.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-scl.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2070 @@
+;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;+" -*-
+;;;
+;;; Scieneer Common Lisp code for SLIME.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+
+(in-package :swank-backend)
+
+
+
+;;; swank-mop
+
+(import-swank-mop-symbols :clos '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot t))
+
+
+;;;; TCP server
+;;;
+;;; SCL only supports the :spawn communication style.
+;;;
+
+(defimplementation preferred-communication-style ()
+ :spawn)
+
+(defimplementation create-socket (host port)
+ (let ((addr (resolve-hostname host)))
+ (ext:create-inet-listener port :stream :host addr :reuse-address t)))
+
+(defimplementation local-port (socket)
+ (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
+
+(defimplementation close-socket (socket)
+ (ext:close-socket (socket-fd socket)))
+
+(defimplementation accept-connection (socket
+ &key external-format buffering timeout)
+ (let ((external-format (or external-format :default))
+ (buffering (or buffering :full))
+ (fd (socket-fd socket)))
+ (loop
+ (let ((ready (sys:wait-until-fd-usable fd :input timeout)))
+ (unless ready
+ (error "Timeout accepting connection on socket: ~S~%" socket)))
+ (let ((new-fd (ignore-errors (ext:accept-tcp-connection fd))))
+ (when new-fd
+ (return (make-socket-io-stream new-fd external-format buffering)))))))
+
+(defimplementation set-stream-timeout (stream timeout)
+ (check-type timeout (or null real))
+ (if (fboundp 'ext::stream-timeout)
+ (setf (ext::stream-timeout stream) timeout)
+ (setf (slot-value (slot-value stream 'cl::stream) 'cl::timeout) timeout)))
+
+;;;;; Sockets
+
+(defun socket-fd (socket)
+ "Return the file descriptor for the socket represented by 'socket."
+ (etypecase socket
+ (fixnum socket)
+ (stream (sys:fd-stream-fd socket))))
+
+(defun resolve-hostname (hostname)
+ "Return the IP address of 'hostname as an integer (in host byte-order)."
+ (let ((hostent (ext:lookup-host-entry hostname)))
+ (car (ext:host-entry-addr-list hostent))))
+
+(defvar *external-format-to-coding-system*
+ '((:iso-8859-1
+ "latin-1" "latin-1-unix" "iso-latin-1-unix"
+ "iso-8859-1" "iso-8859-1-unix")
+ (:utf-8 "utf-8" "utf-8-unix")
+ (:euc-jp "euc-jp" "euc-jp-unix")))
+
+(defimplementation find-external-format (coding-system)
+ (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+ *external-format-to-coding-system*)))
+
+(defun make-socket-io-stream (fd external-format buffering)
+ "Create a new input/output fd-stream for 'fd."
+ (let* ((stream (sys:make-fd-stream fd :input t :output t
+ :element-type 'base-char
+ :buffering buffering
+ :external-format external-format)))
+ ;; Ignore character conversion errors. Without this the communication
+ ;; channel is prone to lockup if a character conversion error occurs.
+ (setf (cl::stream-character-conversion-error-value stream) #\?)
+ stream))
+
+
+;;;; Stream handling
+
+(defclass slime-input-stream (ext:character-input-stream)
+ ((buffer :initarg :buffer :type string)
+ (index :initarg :index :initform 0 :type fixnum)
+ (position :initarg :position :initform 0 :type integer)
+ (interactive :initarg :interactive :initform nil :type (member nil t))
+ (output-stream :initarg :output-stream :initform nil)
+ (input-fn :initarg :input-fn :type function)
+ ))
+
+(defun make-slime-input-stream (input-fn &optional output-stream)
+ (declare (function input-fn))
+ (make-instance 'slime-input-stream
+ :in-buffer (make-string 256)
+ :in-head 0 :in-tail 0
+ :out-buffer ""
+ :buffer "" :index 0
+ :input-fn input-fn
+ :output-stream output-stream))
+
+(defmethod print-object ((s slime-input-stream) stream)
+ (print-unreadable-object (s stream :type t)))
+
+;;; input-stream-p inherits from input-stream.
+;;; output-stream-p inherits nil.
+
+(defmethod ext:stream-listen ((stream slime-input-stream))
+ (let* ((buffer (slot-value stream 'buffer))
+ (index (slot-value stream 'index))
+ (length (length buffer)))
+ (declare (type string buffer)
+ (fixnum index length))
+ (< index length)))
+
+(defmethod close ((stream slime-input-stream) &key ((:abort abort) nil))
+ (declare (ignore abort))
+ (when (ext:stream-open-p stream)
+ (setf (ext:stream-open-p stream) nil)
+ (setf (ext:stream-in-buffer stream) " ")
+ t))
+
+(defmethod ext:stream-clear-input ((stream slime-input-stream))
+ (let* ((input-buffer (slot-value stream 'buffer))
+ (index (slot-value stream 'index))
+ (input-length (length input-buffer))
+ (available (- input-length index))
+ (position (slot-value stream 'position))
+ (new-position (+ position available)))
+ (declare (type kernel:index index available position new-position))
+ (setf (slot-value stream 'position) new-position))
+ (setf (slot-value stream 'buffer) "")
+ (setf (slot-value stream 'index) 0)
+ nil)
+
+;;; No 'stream-finish-output method.
+;;; No 'stream-force-output method.
+;;; No 'stream-clear-output method.
+
+;;; stream-element-type inherits from character-stream.
+
+;;; No 'stream-line-length method.
+;;; No 'stream-line-column method.
+
+;;; Add the remaining input to the current position.
+(defmethod file-length ((stream slime-input-stream))
+ (let* ((input-buffer (slot-value stream 'buffer))
+ (index (slot-value stream 'index))
+ (input-length (length input-buffer))
+ (available (- input-length index))
+ (position (slot-value stream 'position))
+ (file-length (+ position available)))
+ (declare (type kernel:index index available position file-length))
+ file-length))
+
+(defmethod ext:stream-file-position ((stream slime-input-stream)
+ &optional position)
+ (let ((current-position (slot-value stream 'position)))
+ (declare (type kernel:index current-position))
+ (cond (position
+ ;; Could make an attempt here, but just give up for now.
+ nil)
+ (t
+ current-position))))
+
+(defmethod interactive-stream-p ((stream slime-input-stream))
+ (slot-value stream 'interactive))
+
+;;; No 'file-string-length method.
+
+(defmethod ext:stream-read-chars ((stream slime-input-stream) buffer
+ start requested waitp)
+ (declare (type simple-string buffer)
+ (type kernel:index start requested))
+ (let* ((input-buffer (slot-value stream 'buffer))
+ (index (slot-value stream 'index))
+ (input-length (length input-buffer))
+ (available (- input-length index))
+ (copy (min available requested)))
+ (declare (string input-buffer)
+ (type kernel:index index available copy))
+ (cond ((plusp copy)
+ (dotimes (i copy)
+ (declare (type kernel:index i))
+ (setf (aref buffer (+ start i)) (aref input-buffer (+ index i))))
+ (setf (slot-value stream 'index) (+ index copy))
+ (incf (slot-value stream 'position) copy)
+ copy)
+ (waitp
+ (let ((output-stream (slot-value stream 'output-stream))
+ (input-fn (slot-value stream 'input-fn)))
+ (declare (type function input-fn))
+ (when output-stream
+ (force-output output-stream))
+ (let ((new-input (funcall input-fn)))
+ (cond ((zerop (length new-input))
+ -1)
+ (t
+ (setf (slot-value stream 'buffer) new-input)
+ (setf (slot-value stream 'index) 0)
+ (ext:stream-read-chars stream buffer
+ start requested waitp))))))
+ (t
+ 0))))
+
+;;; Slime output stream.
+
+(defclass slime-output-stream (ext:character-output-stream)
+ ((output-fn :initarg :output-fn :type function)
+ (column :initform 0 :type kernel:index)
+ (interactive :initform nil :type (member nil t))
+ (position :initform 0 :type integer)))
+
+(defun make-slime-output-stream (output-fn)
+ (declare (function output-fn))
+ (make-instance 'slime-output-stream
+ :in-buffer ""
+ :out-buffer (make-string 256)
+ :output-fn output-fn))
+
+(defmethod print-object ((s slime-output-stream) stream)
+ (print-unreadable-object (s stream :type t)))
+
+;;; Use default 'input-stream-p method for 'output-stream which returns 'nil.
+;;; Use default 'output-stream-p method for 'output-stream which returns 't.
+
+;;; No 'stream-listen method.
+
+(defmethod close ((stream slime-output-stream) &key ((:abort abort) nil))
+ (when (ext:stream-open-p stream)
+ (unless abort
+ (finish-output stream))
+ (setf (ext:stream-open-p stream) nil)
+ (setf (ext:stream-out-buffer stream) " ")
+ t))
+
+;;; No 'stream-clear-input method.
+
+(defmethod ext:stream-finish-output ((stream slime-output-stream))
+ nil)
+
+(defmethod ext:stream-force-output ((stream slime-output-stream))
+ nil)
+
+(defmethod ext:stream-clear-output ((stream slime-output-stream))
+ nil)
+
+;;; Use default 'stream-element-type method for 'character-stream which
+;;; returns 'base-char.
+
+(defmethod ext:stream-line-length ((stream slime-output-stream))
+ 80)
+
+(defmethod ext:stream-line-column ((stream slime-output-stream))
+ (slot-value stream 'column))
+
+(defmethod file-length ((stream slime-output-stream))
+ (slot-value stream 'position))
+
+(defmethod ext:stream-file-position ((stream slime-output-stream)
+ &optional position)
+ (declare (optimize (speed 3)))
+ (cond (position
+ (let* ((current-position (slot-value stream 'position))
+ (target-position (etypecase position
+ ((member :start) 0)
+ ((member :end) current-position)
+ (kernel:index position))))
+ (declare (type kernel:index current-position target-position))
+ (cond ((= target-position current-position)
+ t)
+ ((> target-position current-position)
+ (let ((output-fn (slot-value stream 'output-fn))
+ (fill-size (- target-position current-position)))
+ (declare (function output-fn))
+ (funcall output-fn (make-string fill-size
+ :initial-element #\space))
+ (setf (slot-value stream 'position) target-position))
+ t)
+ (t
+ nil))))
+ (t
+ (slot-value stream 'position))))
+
+(defmethod interactive-stream-p ((stream slime-output-stream))
+ (slot-value stream 'interactive))
+
+;;; Use the default 'character-output-stream 'file-string-length method.
+
+;;; stream-write-chars
+;;;
+;;; The stream out-buffer is typically large enough that there is little point
+;;; growing the stream output 'string large than the total size. For typical
+;;; usage this reduces consing. As the string grows larger then grow to
+;;; reduce the cost of copying strings around.
+;;;
+(defmethod ext:stream-write-chars ((stream slime-output-stream)
+ string start end waitp)
+ (declare (simple-string string)
+ (type kernel:index start end)
+ (ignore waitp))
+ (declare (optimize (speed 3)))
+ (unless (ext:stream-open-p stream)
+ (error 'kernel:simple-stream-error
+ :stream stream
+ :format-control "Stream closed."))
+ (let* ((string-length (length string))
+ (start (cond ((< start 0) 0)
+ ((> start string-length) string-length)
+ (t start)))
+ (end (cond ((< end start) start)
+ ((> end string-length) string-length)
+ (t end)))
+ (length (- end start))
+ (output-fn (slot-value stream 'output-fn)))
+ (declare (type kernel:index start end length)
+ (type function output-fn))
+ (unless (zerop length)
+ (funcall output-fn (subseq string start end))
+ (let ((last-newline (position #\newline string :from-end t
+ :start start :end end)))
+ (setf (slot-value stream 'column)
+ (if last-newline
+ (- end last-newline 1)
+ (let ((column (slot-value stream 'column)))
+ (declare (type kernel:index column))
+ (+ column (- end start))))))))
+ (- end start))
+
+;;;
+
+(defimplementation make-fn-streams (input-fn output-fn)
+ (let* ((output (make-slime-output-stream output-fn))
+ (input (make-slime-input-stream input-fn output)))
+ (values input output)))
+
+(defimplementation make-stream-interactive (stream)
+ (when (or (typep stream 'slime-input-stream)
+ (typep stream 'slime-output-stream))
+ (setf (slot-value stream 'interactive) t)))
+
+
+;;;; Compilation Commands
+
+(defvar *previous-compiler-condition* nil
+ "Used to detect duplicates.")
+
+(defvar *previous-context* nil
+ "Previous compiler error context.")
+
+(defvar *buffer-name* nil
+ "The name of the Emacs buffer we are compiling from.
+ Nil if we aren't compiling from a buffer.")
+
+(defvar *buffer-start-position* nil)
+(defvar *buffer-substring* nil)
+
+(defimplementation call-with-compilation-hooks (function)
+ (let ((*previous-compiler-condition* nil)
+ (*previous-context* nil)
+ (*print-readably* nil))
+ (handler-bind ((c::compiler-error #'handle-notification-condition)
+ (c::style-warning #'handle-notification-condition)
+ (c::warning #'handle-notification-condition))
+ (funcall function))))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+ (with-compilation-hooks ()
+ (let ((*buffer-name* nil)
+ (ext:*ignore-extra-close-parentheses* nil))
+ (multiple-value-bind (output-file warnings-p failure-p)
+ (compile-file filename :external-format external-format)
+ (unless failure-p
+ ;; Cache the latest source file for definition-finding.
+ (source-cache-get filename (file-write-date filename))
+ (when load-p (load output-file)))
+ (values output-file warnings-p failure-p)))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+ (declare (ignore directory))
+ (with-compilation-hooks ()
+ (let ((*buffer-name* buffer)
+ (*buffer-start-position* position)
+ (*buffer-substring* string))
+ (with-input-from-string (stream string)
+ (ext:compile-from-stream
+ stream
+ :source-info `(:emacs-buffer ,buffer
+ :emacs-buffer-offset ,position
+ :emacs-buffer-string ,string))))))
+
+
+;;;;; Trapping notes
+;;;
+;;; We intercept conditions from the compiler and resignal them as
+;;; `swank:compiler-condition's.
+
+(defun handle-notification-condition (condition)
+ "Handle a condition caused by a compiler warning."
+ (unless (eq condition *previous-compiler-condition*)
+ (let ((context (c::find-error-context nil)))
+ (setq *previous-compiler-condition* condition)
+ (setq *previous-context* context)
+ (signal-compiler-condition condition context))))
+
+(defun signal-compiler-condition (condition context)
+ (signal (make-condition
+ 'compiler-condition
+ :original-condition condition
+ :severity (severity-for-emacs condition)
+ :short-message (brief-compiler-message-for-emacs condition)
+ :message (long-compiler-message-for-emacs condition context)
+ :location (if (read-error-p condition)
+ (read-error-location condition)
+ (compiler-note-location context)))))
+
+(defun severity-for-emacs (condition)
+ "Return the severity of 'condition."
+ (etypecase condition
+ ((satisfies read-error-p) :read-error)
+ (c::compiler-error :error)
+ (c::style-warning :note)
+ (c::warning :warning)))
+
+(defun read-error-p (condition)
+ (eq (type-of condition) 'c::compiler-read-error))
+
+(defun brief-compiler-message-for-emacs (condition)
+ "Briefly describe a compiler error for Emacs.
+ When Emacs presents the message it already has the source popped up
+ and the source form highlighted. This makes much of the information in
+ the error-context redundant."
+ (princ-to-string condition))
+
+(defun long-compiler-message-for-emacs (condition error-context)
+ "Describe a compiler error for Emacs including context information."
+ (declare (type (or c::compiler-error-context null) error-context))
+ (multiple-value-bind (enclosing source)
+ (if error-context
+ (values (c::compiler-error-context-enclosing-source error-context)
+ (c::compiler-error-context-source error-context)))
+ (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
+ enclosing source condition)))
+
+(defun read-error-location (condition)
+ (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
+ (file (c::file-info-name finfo))
+ (pos (c::compiler-read-error-position condition)))
+ (cond ((and (eq file :stream) *buffer-name*)
+ (make-location (list :buffer *buffer-name*)
+ (list :position (+ *buffer-start-position* pos))))
+ ((and (pathnamep file) (not *buffer-name*))
+ (make-location (list :file (unix-truename file))
+ (list :position (1+ pos))))
+ (t (break)))))
+
+(defun compiler-note-location (context)
+ "Derive the location of a complier message from its context.
+ Return a `location' record, or (:error <reason>) on failure."
+ (if (null context)
+ (note-error-location)
+ (let ((file (c::compiler-error-context-file-name context))
+ (source (c::compiler-error-context-original-source context))
+ (path
+ (reverse (c::compiler-error-context-original-source-path context))))
+ (or (locate-compiler-note file source path)
+ (note-error-location)))))
+
+(defun note-error-location ()
+ "Pseudo-location for notes that can't be located."
+ (list :error "No error location available."))
+
+(defun locate-compiler-note (file source source-path)
+ (cond ((and (eq file :stream) *buffer-name*)
+ ;; Compiling from a buffer
+ (let ((position (+ *buffer-start-position*
+ (source-path-string-position
+ source-path *buffer-substring*))))
+ (make-location (list :buffer *buffer-name*)
+ (list :position position))))
+ ((and (pathnamep file) (null *buffer-name*))
+ ;; Compiling from a file
+ (make-location (list :file (unix-truename file))
+ (list :position
+ (1+ (source-path-file-position
+ source-path file)))))
+ ((and (eq file :lisp) (stringp source))
+ ;; No location known, but we have the source form.
+ ;; XXX How is this case triggered? -luke (16/May/2004)
+ ;; This can happen if the compiler needs to expand a macro
+ ;; but the macro-expander is not yet compiled. Calling the
+ ;; (interpreted) macro-expander triggers IR1 conversion of
+ ;; the lambda expression for the expander and invokes the
+ ;; compiler recursively.
+ (make-location (list :source-form source)
+ (list :position 1)))))
+
+(defun unix-truename (pathname)
+ (ext:unix-namestring (truename pathname)))
+
+
+
+;;; TODO
+(defimplementation who-calls (name) nil)
+(defimplementation who-references (name) nil)
+(defimplementation who-binds (name) nil)
+(defimplementation who-sets (name) nil)
+(defimplementation who-specializes (symbol) nil)
+(defimplementation who-macroexpands (name) nil)
+
+
+;;;; Find callers and callees
+;;;
+;;; Find callers and callees by looking at the constant pool of
+;;; compiled code objects. We assume every fdefn object in the
+;;; constant pool corresponds to a call to that function. A better
+;;; strategy would be to use the disassembler to find actual
+;;; call-sites.
+
+(declaim (inline map-code-constants))
+(defun map-code-constants (code fn)
+ "Call 'fn for each constant in 'code's constant pool."
+ (check-type code kernel:code-component)
+ (loop for i from vm:code-constants-offset below (kernel:get-header-data code)
+ do (funcall fn (kernel:code-header-ref code i))))
+
+(defun function-callees (function)
+ "Return 'function's callees as a list of functions."
+ (let ((callees '()))
+ (map-code-constants
+ (vm::find-code-object function)
+ (lambda (obj)
+ (when (kernel:fdefn-p obj)
+ (push (kernel:fdefn-function obj) callees))))
+ callees))
+
+(declaim (ext:maybe-inline map-allocated-code-components))
+(defun map-allocated-code-components (spaces fn)
+ "Call FN for each allocated code component in one of 'spaces. FN
+ receives the object as argument. 'spaces should be a list of the
+ symbols :dynamic, :static, or :read-only."
+ (dolist (space spaces)
+ (declare (inline vm::map-allocated-objects)
+ (optimize (ext:inhibit-warnings 3)))
+ (vm::map-allocated-objects
+ (lambda (obj header size)
+ (declare (type fixnum size) (ignore size))
+ (when (= vm:code-header-type header)
+ (funcall fn obj)))
+ space)))
+
+(declaim (ext:maybe-inline map-caller-code-components))
+(defun map-caller-code-components (function spaces fn)
+ "Call 'fn for each code component with a fdefn for 'function in its
+ constant pool."
+ (let ((function (coerce function 'function)))
+ (declare (inline map-allocated-code-components))
+ (map-allocated-code-components
+ spaces
+ (lambda (obj)
+ (map-code-constants
+ obj
+ (lambda (constant)
+ (when (and (kernel:fdefn-p constant)
+ (eq (kernel:fdefn-function constant)
+ function))
+ (funcall fn obj))))))))
+
+(defun function-callers (function &optional (spaces '(:read-only :static
+ :dynamic)))
+ "Return 'function's callers. The result is a list of code-objects."
+ (let ((referrers '()))
+ (declare (inline map-caller-code-components))
+ (map-caller-code-components function spaces
+ (lambda (code) (push code referrers)))
+ referrers))
+
+(defun debug-info-definitions (debug-info)
+ "Return the defintions for a debug-info. This should only be used
+ for code-object without entry points, i.e., byte compiled
+ code (are theree others?)"
+ ;; This mess has only been tested with #'ext::skip-whitespace, a
+ ;; byte-compiled caller of #'read-char .
+ (check-type debug-info (and (not c::compiled-debug-info) c::debug-info))
+ (let ((name (c::debug-info-name debug-info))
+ (source (c::debug-info-source debug-info)))
+ (destructuring-bind (first) source
+ (ecase (c::debug-source-from first)
+ (:file
+ (list (list name
+ (make-location
+ (list :file (unix-truename (c::debug-source-name first)))
+ (list :function-name (string name))))))))))
+
+(defun valid-function-name-p (name)
+ (or (symbolp name) (and (consp name)
+ (eq (car name) 'setf)
+ (symbolp (cadr name))
+ (not (cddr name)))))
+
+(defun code-component-entry-points (code)
+ "Return a list ((name location) ...) of function definitons for
+ the code omponent 'code."
+ (let ((names '()))
+ (do ((f (kernel:%code-entry-points code) (kernel::%function-next f)))
+ ((not f))
+ (let ((name (kernel:%function-name f)))
+ (when (valid-function-name-p name)
+ (push (list name (function-location f)) names))))
+ names))
+
+(defimplementation list-callers (symbol)
+ "Return a list ((name location) ...) of callers."
+ (let ((components (function-callers symbol))
+ (xrefs '()))
+ (dolist (code components)
+ (let* ((entry (kernel:%code-entry-points code))
+ (defs (if entry
+ (code-component-entry-points code)
+ ;; byte compiled stuff
+ (debug-info-definitions
+ (kernel:%code-debug-info code)))))
+ (setq xrefs (nconc defs xrefs))))
+ xrefs))
+
+(defimplementation list-callees (symbol)
+ (let ((fns (function-callees symbol)))
+ (mapcar (lambda (fn)
+ (list (kernel:%function-name fn)
+ (function-location fn)))
+ fns)))
+
+
+;;;; Resolving source locations
+;;;
+;;; Our mission here is to "resolve" references to code locations into
+;;; actual file/buffer names and character positions. The references
+;;; we work from come out of the compiler's statically-generated debug
+;;; information, such as `code-location''s and `debug-source''s. For
+;;; more details, see the "Debugger Programmer's Interface" section of
+;;; the SCL manual.
+;;;
+;;; The first step is usually to find the corresponding "source-path"
+;;; for the location. Once we have the source-path we can pull up the
+;;; source file and `READ' our way through to the right position. The
+;;; main source-code groveling work is done in
+;;; `swank-source-path-parser.lisp'.
+
+(defvar *debug-definition-finding* nil
+ "When true don't handle errors while looking for definitions.
+ This is useful when debugging the definition-finding code.")
+
+(defvar *source-snippet-size* 256
+ "Maximum number of characters in a snippet of source code.
+ Snippets at the beginning of definitions are used to tell Emacs what
+ the definitions looks like, so that it can accurately find them by
+ text search.")
+
+(defmacro safe-definition-finding (&body body)
+ "Execute 'body and return the source-location it returns.
+ If an error occurs and `*debug-definition-finding*' is false, then
+ return an error pseudo-location.
+
+ The second return value is 'nil if no error occurs, otherwise it is the
+ condition object."
+ `(flet ((body () ,@body))
+ (if *debug-definition-finding*
+ (body)
+ (handler-case (values (progn ,@body) nil)
+ (error (c) (values (list :error (princ-to-string c)) c))))))
+
+(defun code-location-source-location (code-location)
+ "Safe wrapper around `code-location-from-source-location'."
+ (safe-definition-finding
+ (source-location-from-code-location code-location)))
+
+(defun source-location-from-code-location (code-location)
+ "Return the source location for 'code-location."
+ (let ((debug-fun (di:code-location-debug-function code-location)))
+ (when (di::bogus-debug-function-p debug-fun)
+ ;; Those lousy cheapskates! They've put in a bogus debug source
+ ;; because the code was compiled at a low debug setting.
+ (error "Bogus debug function: ~A" debug-fun)))
+ (let* ((debug-source (di:code-location-debug-source code-location))
+ (from (di:debug-source-from debug-source))
+ (name (di:debug-source-name debug-source)))
+ (ecase from
+ (:file
+ (location-in-file name code-location debug-source))
+ (:stream
+ (location-in-stream code-location debug-source))
+ (:lisp
+ ;; The location comes from a form passed to `compile'.
+ ;; The best we can do is return the form itself for printing.
+ (make-location
+ (list :source-form (with-output-to-string (*standard-output*)
+ (debug::print-code-location-source-form
+ code-location 100 t)))
+ (list :position 1))))))
+
+(defun location-in-file (filename code-location debug-source)
+ "Resolve the source location for 'code-location in 'filename."
+ (let* ((code-date (di:debug-source-created debug-source))
+ (source-code (get-source-code filename code-date)))
+ (with-input-from-string (s source-code)
+ (make-location (list :file (unix-truename filename))
+ (list :position (1+ (code-location-stream-position
+ code-location s)))
+ `(:snippet ,(read-snippet s))))))
+
+(defun location-in-stream (code-location debug-source)
+ "Resolve the source location for a 'code-location from a stream.
+ This only succeeds if the code was compiled from an Emacs buffer."
+ (unless (debug-source-info-from-emacs-buffer-p debug-source)
+ (error "The code is compiled from a non-SLIME stream."))
+ (let* ((info (c::debug-source-info debug-source))
+ (string (getf info :emacs-buffer-string))
+ (position (code-location-string-offset
+ code-location
+ string)))
+ (make-location
+ (list :buffer (getf info :emacs-buffer))
+ (list :position (+ (getf info :emacs-buffer-offset) position))
+ (list :snippet (with-input-from-string (s string)
+ (file-position s position)
+ (read-snippet s))))))
+
+;;;;; Function-name locations
+;;;
+(defun debug-info-function-name-location (debug-info)
+ "Return a function-name source-location for 'debug-info.
+ Function-name source-locations are a fallback for when precise
+ positions aren't available."
+ (with-struct (c::debug-info- (fname name) source) debug-info
+ (with-struct (c::debug-source- info from name) (car source)
+ (ecase from
+ (:file
+ (make-location (list :file (namestring (truename name)))
+ (list :function-name (string fname))))
+ (:stream
+ (assert (debug-source-info-from-emacs-buffer-p (car source)))
+ (make-location (list :buffer (getf info :emacs-buffer))
+ (list :function-name (string fname))))
+ (:lisp
+ (make-location (list :source-form (princ-to-string (aref name 0)))
+ (list :position 1)))))))
+
+(defun debug-source-info-from-emacs-buffer-p (debug-source)
+ "Does the `info' slot of 'debug-source contain an Emacs buffer location?
+ This is true for functions that were compiled directly from buffers."
+ (info-from-emacs-buffer-p (c::debug-source-info debug-source)))
+
+(defun info-from-emacs-buffer-p (info)
+ (and info
+ (consp info)
+ (eq :emacs-buffer (car info))))
+
+
+;;;;; Groveling source-code for positions
+
+(defun code-location-stream-position (code-location stream)
+ "Return the byte offset of 'code-location in 'stream. Extract the
+ toplevel-form-number and form-number from 'code-location and use that
+ to find the position of the corresponding form.
+
+ Finish with 'stream positioned at the start of the code location."
+ (let* ((location (debug::maybe-block-start-location code-location))
+ (tlf-offset (di:code-location-top-level-form-offset location))
+ (form-number (di:code-location-form-number location)))
+ (let ((pos (form-number-stream-position tlf-offset form-number stream)))
+ (file-position stream pos)
+ pos)))
+
+(defun form-number-stream-position (tlf-number form-number stream)
+ "Return the starting character position of a form in 'stream.
+ 'tlf-number is the top-level-form number.
+ 'form-number is an index into a source-path table for the TLF."
+ (multiple-value-bind (tlf position-map) (read-source-form tlf-number stream)
+ (let* ((path-table (di:form-number-translations tlf 0))
+ (source-path
+ (if (<= (length path-table) form-number) ; source out of sync?
+ (list 0) ; should probably signal a condition
+ (reverse (cdr (aref path-table form-number))))))
+ (source-path-source-position source-path tlf position-map))))
+
+(defun code-location-string-offset (code-location string)
+ "Return the byte offset of 'code-location in 'string.
+ See 'code-location-stream-position."
+ (with-input-from-string (s string)
+ (code-location-stream-position code-location s)))
+
+
+;;;; Finding definitions
+
+;;; There are a great many different types of definition for us to
+;;; find. We search for definitions of every kind and return them in a
+;;; list.
+
+(defimplementation find-definitions (name)
+ (append (function-definitions name)
+ (setf-definitions name)
+ (variable-definitions name)
+ (class-definitions name)
+ (type-definitions name)
+ (compiler-macro-definitions name)
+ (source-transform-definitions name)
+ (function-info-definitions name)
+ (ir1-translator-definitions name)))
+
+;;;;; Functions, macros, generic functions, methods
+;;;
+;;; We make extensive use of the compile-time debug information that
+;;; SCL records, in particular "debug functions" and "code
+;;; locations." Refer to the "Debugger Programmer's Interface" section
+;;; of the SCL manual for more details.
+
+(defun function-definitions (name)
+ "Return definitions for 'name in the \"function namespace\", i.e.,
+ regular functions, generic functions, methods and macros.
+ 'name can any valid function name (e.g, (setf car))."
+ (let ((macro? (and (symbolp name) (macro-function name)))
+ (special? (and (symbolp name) (special-operator-p name)))
+ (function? (and (valid-function-name-p name)
+ (ext:info :function :definition name)
+ (if (symbolp name) (fboundp name) t))))
+ (cond (macro?
+ (list `((defmacro ,name)
+ ,(function-location (macro-function name)))))
+ (special?
+ (list `((:special-operator ,name)
+ (:error ,(format nil "Special operator: ~S" name)))))
+ (function?
+ (let ((function (fdefinition name)))
+ (if (genericp function)
+ (generic-function-definitions name function)
+ (list (list `(function ,name)
+ (function-location function)))))))))
+
+;;;;;; Ordinary (non-generic/macro/special) functions
+;;;
+;;; First we test if FUNCTION is a closure created by defstruct, and
+;;; if so extract the defstruct-description (`dd') from the closure
+;;; and find the constructor for the struct. Defstruct creates a
+;;; defun for the default constructor and we use that as an
+;;; approximation to the source location of the defstruct.
+;;;
+;;; For an ordinary function we return the source location of the
+;;; first code-location we find.
+;;;
+(defun function-location (function)
+ "Return the source location for FUNCTION."
+ (cond ((struct-closure-p function)
+ (struct-closure-location function))
+ ((c::byte-function-or-closure-p function)
+ (byte-function-location function))
+ (t
+ (compiled-function-location function))))
+
+(defun compiled-function-location (function)
+ "Return the location of a regular compiled function."
+ (multiple-value-bind (code-location error)
+ (safe-definition-finding (function-first-code-location function))
+ (cond (error (list :error (princ-to-string error)))
+ (t (code-location-source-location code-location)))))
+
+(defun function-first-code-location (function)
+ "Return the first code-location we can find for 'function."
+ (and (function-has-debug-function-p function)
+ (di:debug-function-start-location
+ (di:function-debug-function function))))
+
+(defun function-has-debug-function-p (function)
+ (di:function-debug-function function))
+
+(defun function-code-object= (closure function)
+ (and (eq (vm::find-code-object closure)
+ (vm::find-code-object function))
+ (not (eq closure function))))
+
+
+(defun byte-function-location (fn)
+ "Return the location of the byte-compiled function 'fn."
+ (etypecase fn
+ ((or c::hairy-byte-function c::simple-byte-function)
+ (let* ((component (c::byte-function-component fn))
+ (debug-info (kernel:%code-debug-info component)))
+ (debug-info-function-name-location debug-info)))
+ (c::byte-closure
+ (byte-function-location (c::byte-closure-function fn)))))
+
+;;; Here we deal with structure accessors. Note that `dd' is a
+;;; "defstruct descriptor" structure in SCL. A `dd' describes a
+;;; `defstruct''d structure.
+
+(defun struct-closure-p (function)
+ "Is 'function a closure created by defstruct?"
+ (or (function-code-object= function #'kernel::structure-slot-accessor)
+ (function-code-object= function #'kernel::structure-slot-setter)
+ (function-code-object= function #'kernel::%defstruct)))
+
+(defun struct-closure-location (function)
+ "Return the location of the structure that 'function belongs to."
+ (assert (struct-closure-p function))
+ (safe-definition-finding
+ (dd-location (struct-closure-dd function))))
+
+(defun struct-closure-dd (function)
+ "Return the defstruct-definition (dd) of FUNCTION."
+ (assert (= (kernel:get-type function) vm:closure-header-type))
+ (flet ((find-layout (function)
+ (sys:find-if-in-closure
+ (lambda (x)
+ (let ((value (if (di::indirect-value-cell-p x)
+ (c:value-cell-ref x)
+ x)))
+ (when (kernel::layout-p value)
+ (return-from find-layout value))))
+ function)))
+ (kernel:layout-info (find-layout function))))
+
+(defun dd-location (dd)
+ "Return the location of a `defstruct'."
+ ;; Find the location in a constructor.
+ (function-location (struct-constructor dd)))
+
+(defun struct-constructor (dd)
+ "Return a constructor function from a defstruct definition.
+Signal an error if no constructor can be found."
+ (let ((constructor (or (kernel:dd-default-constructor dd)
+ (car (kernel::dd-constructors dd)))))
+ (when (or (null constructor)
+ (and (consp constructor) (null (car constructor))))
+ (error "Cannot find structure's constructor: ~S"
+ (kernel::dd-name dd)))
+ (coerce (if (consp constructor) (first constructor) constructor)
+ 'function)))
+
+;;;;;; Generic functions and methods
+
+(defun generic-function-definitions (name function)
+ "Return the definitions of a generic function and its methods."
+ (cons (list `(defgeneric ,name) (gf-location function))
+ (gf-method-definitions function)))
+
+(defun gf-location (gf)
+ "Return the location of the generic function GF."
+ (definition-source-location gf (clos:generic-function-name gf)))
+
+(defun gf-method-definitions (gf)
+ "Return the locations of all methods of the generic function GF."
+ (mapcar #'method-definition (clos:generic-function-methods gf)))
+
+(defun method-definition (method)
+ (list (method-dspec method)
+ (method-location method)))
+
+(defun method-dspec (method)
+ "Return a human-readable \"definition specifier\" for METHOD."
+ (let* ((gf (clos:method-generic-function method))
+ (name (clos:generic-function-name gf))
+ (specializers (clos:method-specializers method))
+ (qualifiers (clos:method-qualifiers method)))
+ `(method ,name ,@qualifiers ,specializers #+nil (clos::unparse-specializers specializers))))
+
+;; XXX maybe special case setters/getters
+(defun method-location (method)
+ (function-location (clos:method-function method)))
+
+(defun genericp (fn)
+ (typep fn 'generic-function))
+
+;;;;;; Types and classes
+
+(defun type-definitions (name)
+ "Return `deftype' locations for type NAME."
+ (maybe-make-definition (ext:info :type :expander name) 'deftype name))
+
+(defun maybe-make-definition (function kind name)
+ "If FUNCTION is non-nil then return its definition location."
+ (if function
+ (list (list `(,kind ,name) (function-location function)))))
+
+(defun class-definitions (name)
+ "Return the definition locations for the class called NAME."
+ (if (symbolp name)
+ (let ((class (find-class name nil)))
+ (etypecase class
+ (null '())
+ (structure-class
+ (list (list `(defstruct ,name)
+ (dd-location (find-dd name)))))
+ (standard-class
+ (list (list `(defclass ,name)
+ (class-location (find-class name)))))
+ ((or built-in-class
+ kernel:funcallable-structure-class)
+ (list (list `(kernel::define-type-class ,name)
+ `(:error
+ ,(format nil "No source info for ~A" name)))))))))
+
+(defun class-location (class)
+ "Return the `defclass' location for CLASS."
+ (definition-source-location class (class-name class)))
+
+(defun find-dd (name)
+ "Find the defstruct-definition by the name of its structure-class."
+ (let ((layout (ext:info :type :compiler-layout name)))
+ (if layout
+ (kernel:layout-info layout))))
+
+(defun condition-class-location (class)
+ (let ((name (class-name class)))
+ `(:error ,(format nil "No location info for condition: ~A" name))))
+
+(defun make-name-in-file-location (file string)
+ (multiple-value-bind (filename c)
+ (ignore-errors
+ (unix-truename (merge-pathnames (make-pathname :type "lisp")
+ file)))
+ (cond (filename (make-location `(:file ,filename)
+ `(:function-name ,(string string))))
+ (t (list :error (princ-to-string c))))))
+
+(defun definition-source-location (object name)
+ `(:error ,(format nil "No source info for: ~A" object)))
+
+(defun setf-definitions (name)
+ (let ((function (or (ext:info :setf :inverse name)
+ (ext:info :setf :expander name))))
+ (if function
+ (list (list `(setf ,name)
+ (function-location (coerce function 'function)))))))
+
+
+(defun variable-location (symbol)
+ `(:error ,(format nil "No source info for variable ~S" symbol)))
+
+(defun variable-definitions (name)
+ (if (symbolp name)
+ (multiple-value-bind (kind recorded-p) (ext:info :variable :kind name)
+ (if recorded-p
+ (list (list `(variable ,kind ,name)
+ (variable-location name)))))))
+
+(defun compiler-macro-definitions (symbol)
+ (maybe-make-definition (compiler-macro-function symbol)
+ 'define-compiler-macro
+ symbol))
+
+(defun source-transform-definitions (name)
+ (maybe-make-definition (ext:info :function :source-transform name)
+ 'c:def-source-transform
+ name))
+
+(defun function-info-definitions (name)
+ (let ((info (ext:info :function :info name)))
+ (if info
+ (append (loop for transform in (c::function-info-transforms info)
+ collect (list `(c:deftransform ,name
+ ,(c::type-specifier
+ (c::transform-type transform)))
+ (function-location (c::transform-function
+ transform))))
+ (maybe-make-definition (c::function-info-derive-type info)
+ 'c::derive-type name)
+ (maybe-make-definition (c::function-info-optimizer info)
+ 'c::optimizer name)
+ (maybe-make-definition (c::function-info-ltn-annotate info)
+ 'c::ltn-annotate name)
+ (maybe-make-definition (c::function-info-ir2-convert info)
+ 'c::ir2-convert name)
+ (loop for template in (c::function-info-templates info)
+ collect (list `(c::vop ,(c::template-name template))
+ (function-location
+ (c::vop-info-generator-function
+ template))))))))
+
+(defun ir1-translator-definitions (name)
+ (maybe-make-definition (ext:info :function :ir1-convert name)
+ 'c:def-ir1-translator name))
+
+
+;;;; Documentation.
+
+(defimplementation describe-symbol-for-emacs (symbol)
+ (let ((result '()))
+ (flet ((doc (kind)
+ (or (documentation symbol kind) :not-documented))
+ (maybe-push (property value)
+ (when value
+ (setf result (list* property value result)))))
+ (maybe-push
+ :variable (multiple-value-bind (kind recorded-p)
+ (ext:info variable kind symbol)
+ (declare (ignore kind))
+ (if (or (boundp symbol) recorded-p)
+ (doc 'variable))))
+ (when (fboundp symbol)
+ (maybe-push
+ (cond ((macro-function symbol) :macro)
+ ((special-operator-p symbol) :special-operator)
+ ((genericp (fdefinition symbol)) :generic-function)
+ (t :function))
+ (doc 'function)))
+ (maybe-push
+ :setf (if (or (ext:info setf inverse symbol)
+ (ext:info setf expander symbol))
+ (doc 'setf)))
+ (maybe-push
+ :type (if (ext:info type kind symbol)
+ (doc 'type)))
+ (maybe-push
+ :class (if (find-class symbol nil)
+ (doc 'class)))
+ (maybe-push
+ :alien-type (if (not (eq (ext:info alien-type kind symbol) :unknown))
+ (doc 'alien-type)))
+ (maybe-push
+ :alien-struct (if (ext:info alien-type struct symbol)
+ (doc nil)))
+ (maybe-push
+ :alien-union (if (ext:info alien-type union symbol)
+ (doc nil)))
+ (maybe-push
+ :alien-enum (if (ext:info alien-type enum symbol)
+ (doc nil)))
+ result)))
+
+(defimplementation describe-definition (symbol namespace)
+ (describe (ecase namespace
+ (:variable
+ symbol)
+ ((:function :generic-function)
+ (symbol-function symbol))
+ (:setf
+ (or (ext:info setf inverse symbol)
+ (ext:info setf expander symbol)))
+ (:type
+ (kernel:values-specifier-type symbol))
+ (:class
+ (find-class symbol))
+ (:alien-struct
+ (ext:info :alien-type :struct symbol))
+ (:alien-union
+ (ext:info :alien-type :union symbol))
+ (:alien-enum
+ (ext:info :alien-type :enum symbol))
+ (:alien-type
+ (ecase (ext:info :alien-type :kind symbol)
+ (:primitive
+ (let ((alien::*values-type-okay* t))
+ (funcall (ext:info :alien-type :translator symbol)
+ (list symbol))))
+ ((:defined)
+ (ext:info :alien-type :definition symbol))
+ (:unknown :unknown))))))
+
+;;;;; Argument lists
+
+(defimplementation arglist (fun)
+ (etypecase fun
+ (function (function-arglist fun))
+ (symbol (function-arglist (or (macro-function fun)
+ (symbol-function fun))))))
+
+(defun function-arglist (fun)
+ (flet ((compiled-function-arglist (x)
+ (let ((args (kernel:%function-arglist x)))
+ (if args
+ (read-arglist x)
+ :not-available))))
+ (case (kernel:get-type fun)
+ (#.vm:closure-header-type
+ (compiled-function-arglist
+ (kernel:%closure-function fun)))
+ ((#.vm:function-header-type #.vm:closure-function-header-type)
+ (compiled-function-arglist fun))
+ (#.vm:funcallable-instance-header-type
+ (typecase fun
+ (kernel:byte-function
+ :not-available)
+ (kernel:byte-closure
+ :not-available)
+ (eval:interpreted-function
+ (eval:interpreted-function-arglist fun))
+ (otherwise
+ (clos::generic-function-lambda-list fun))))
+ (t
+ :non-available))))
+
+(defimplementation function-name (function)
+ (cond ((eval:interpreted-function-p function)
+ (eval:interpreted-function-name function))
+ ((typep function 'generic-function)
+ (clos:generic-function-name function))
+ ((c::byte-function-or-closure-p function)
+ (c::byte-function-name function))
+ (t (kernel:%function-name (kernel:%function-self function)))))
+
+;;; A simple case: the arglist is available as a string that we can
+;;; `read'.
+
+(defun read-arglist (fn)
+ "Parse the arglist-string of the function object FN."
+ (let ((string (kernel:%function-arglist
+ (kernel:%function-self fn)))
+ (package (find-package
+ (c::compiled-debug-info-package
+ (kernel:%code-debug-info
+ (vm::find-code-object fn))))))
+ (with-standard-io-syntax
+ (let ((*package* (or package *package*)))
+ (read-from-string string)))))
+
+;;; A harder case: an approximate arglist is derived from available
+;;; debugging information.
+
+(defun debug-function-arglist (debug-function)
+ "Derive the argument list of DEBUG-FUNCTION from debug info."
+ (let ((args (di::debug-function-lambda-list debug-function))
+ (required '())
+ (optional '())
+ (rest '())
+ (key '()))
+ ;; collect the names of debug-vars
+ (dolist (arg args)
+ (etypecase arg
+ (di::debug-variable
+ (push (di::debug-variable-symbol arg) required))
+ ((member :deleted)
+ (push ':deleted required))
+ (cons
+ (ecase (car arg)
+ (:keyword
+ (push (second arg) key))
+ (:optional
+ (push (debug-variable-symbol-or-deleted (second arg)) optional))
+ (:rest
+ (push (debug-variable-symbol-or-deleted (second arg)) rest))))))
+ ;; intersperse lambda keywords as needed
+ (append (nreverse required)
+ (if optional (cons '&optional (nreverse optional)))
+ (if rest (cons '&rest (nreverse rest)))
+ (if key (cons '&key (nreverse key))))))
+
+(defun debug-variable-symbol-or-deleted (var)
+ (etypecase var
+ (di:debug-variable
+ (di::debug-variable-symbol var))
+ ((member :deleted)
+ '#:deleted)))
+
+(defun symbol-debug-function-arglist (fname)
+ "Return FNAME's debug-function-arglist and %function-arglist.
+ A utility for debugging DEBUG-FUNCTION-ARGLIST."
+ (let ((fn (fdefinition fname)))
+ (values (debug-function-arglist (di::function-debug-function fn))
+ (kernel:%function-arglist (kernel:%function-self fn)))))
+
+;;; Deriving arglists for byte-compiled functions:
+;;;
+(defun byte-code-function-arglist (fn)
+ ;; There doesn't seem to be much arglist information around for
+ ;; byte-code functions. Use the arg-count and return something like
+ ;; (arg0 arg1 ...)
+ (etypecase fn
+ (c::simple-byte-function
+ (loop for i from 0 below (c::simple-byte-function-num-args fn)
+ collect (make-arg-symbol i)))
+ (c::hairy-byte-function
+ (hairy-byte-function-arglist fn))
+ (c::byte-closure
+ (byte-code-function-arglist (c::byte-closure-function fn)))))
+
+(defun make-arg-symbol (i)
+ (make-symbol (format nil "~A~D" (string 'arg) i)))
+
+;;; A "hairy" byte-function is one that takes a variable number of
+;;; arguments. `hairy-byte-function' is a type from the bytecode
+;;; interpreter.
+;;;
+(defun hairy-byte-function-arglist (fn)
+ (let ((counter -1))
+ (flet ((next-arg () (make-arg-symbol (incf counter))))
+ (with-struct (c::hairy-byte-function- min-args max-args rest-arg-p
+ keywords-p keywords) fn
+ (let ((arglist '())
+ (optional (- max-args min-args)))
+ ;; XXX isn't there a better way to write this?
+ ;; (Looks fine to me. -luke)
+ (dotimes (i min-args)
+ (push (next-arg) arglist))
+ (when (plusp optional)
+ (push '&optional arglist)
+ (dotimes (i optional)
+ (push (next-arg) arglist)))
+ (when rest-arg-p
+ (push '&rest arglist)
+ (push (next-arg) arglist))
+ (when keywords-p
+ (push '&key arglist)
+ (loop for (key _ __) in keywords
+ do (push key arglist))
+ (when (eq keywords-p :allow-others)
+ (push '&allow-other-keys arglist)))
+ (nreverse arglist))))))
+
+
+;;;; Miscellaneous.
+
+(defimplementation macroexpand-all (form)
+ (macroexpand form))
+
+(defimplementation set-default-directory (directory)
+ (setf (ext:default-directory) (namestring directory))
+ ;; Setting *default-pathname-defaults* to an absolute directory
+ ;; makes the behavior of MERGE-PATHNAMES a bit more intuitive.
+ (setf *default-pathname-defaults* (pathname (ext:default-directory)))
+ (default-directory))
+
+(defimplementation default-directory ()
+ (namestring (ext:default-directory)))
+
+(defimplementation call-without-interrupts (fn)
+ (funcall fn))
+
+(defimplementation getpid ()
+ (unix:unix-getpid))
+
+(defimplementation lisp-implementation-type-name ()
+ (if (eq ext:*case-mode* :upper) "scl" "scl-lower"))
+
+(defimplementation quit-lisp ()
+ (ext:quit))
+
+;;; source-path-{stream,file,string,etc}-position moved into
+;;; swank-source-path-parser
+
+
+;;;; Debugging
+
+(defvar *sldb-stack-top*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+ (let* ((*sldb-stack-top* (or debug:*stack-top-hint* (di:top-frame)))
+ (debug:*stack-top-hint* nil)
+ (kernel:*current-level* 0))
+ (handler-bind ((di::unhandled-condition
+ (lambda (condition)
+ (error (make-condition
+ 'sldb-condition
+ :original-condition condition)))))
+ (funcall debugger-loop-fn))))
+
+(defun frame-down (frame)
+ (handler-case (di:frame-down frame)
+ (di:no-debug-info () nil)))
+
+(defun nth-frame (index)
+ (do ((frame *sldb-stack-top* (frame-down frame))
+ (i index (1- i)))
+ ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+ (let ((end (or end most-positive-fixnum)))
+ (loop for f = (nth-frame start) then (frame-down f)
+ for i from start below end
+ while f
+ collect f)))
+
+(defimplementation print-frame (frame stream)
+ (let ((*standard-output* stream))
+ (handler-case
+ (debug::print-frame-call frame :verbosity 1 :number nil)
+ (error (e)
+ (ignore-errors (princ e stream))))))
+
+(defimplementation frame-source-location-for-emacs (index)
+ (code-location-source-location (di:frame-code-location (nth-frame index))))
+
+(defimplementation eval-in-frame (form index)
+ (di:eval-in-frame (nth-frame index) form))
+
+(defun frame-debug-vars (frame)
+ "Return a vector of debug-variables in frame."
+ (di::debug-function-debug-variables (di:frame-debug-function frame)))
+
+(defun debug-var-value (var frame location)
+ (let ((validity (di:debug-variable-validity var location)))
+ (ecase validity
+ (:valid (di:debug-variable-value var frame))
+ ((:invalid :unknown) (make-symbol (string validity))))))
+
+(defimplementation frame-locals (index)
+ (let* ((frame (nth-frame index))
+ (loc (di:frame-code-location frame))
+ (vars (frame-debug-vars frame)))
+ (loop for v across vars collect
+ (list :name (di:debug-variable-symbol v)
+ :id (di:debug-variable-id v)
+ :value (debug-var-value v frame loc)))))
+
+(defimplementation frame-var-value (frame var)
+ (let* ((frame (nth-frame frame))
+ (dvar (aref (frame-debug-vars frame) var)))
+ (debug-var-value dvar frame (di:frame-code-location frame))))
+
+(defimplementation frame-catch-tags (index)
+ (mapcar #'car (di:frame-catches (nth-frame index))))
+
+(defimplementation return-from-frame (index form)
+ (let ((sym (find-symbol (symbol-name '#:find-debug-tag-for-frame)
+ :debug-internals)))
+ (if sym
+ (let* ((frame (nth-frame index))
+ (probe (funcall sym frame)))
+ (cond (probe (throw (car probe) (eval-in-frame form index)))
+ (t (format nil "Cannot return from frame: ~S" frame))))
+ "return-from-frame is not implemented in this version of SCL.")))
+
+(defimplementation activate-stepping (frame)
+ (set-step-breakpoints (nth-frame frame)))
+
+(defimplementation sldb-break-on-return (frame)
+ (break-on-return (nth-frame frame)))
+
+;;; We set the breakpoint in the caller which might be a bit confusing.
+;;;
+(defun break-on-return (frame)
+ (let* ((caller (di:frame-down frame))
+ (cl (di:frame-code-location caller)))
+ (flet ((hook (frame bp)
+ (when (frame-pointer= frame caller)
+ (di:delete-breakpoint bp)
+ (signal-breakpoint bp frame))))
+ (let* ((info (ecase (di:code-location-kind cl)
+ ((:single-value-return :unknown-return) nil)
+ (:known-return (debug-function-returns
+ (di:frame-debug-function frame)))))
+ (bp (di:make-breakpoint #'hook cl :kind :code-location
+ :info info)))
+ (di:activate-breakpoint bp)
+ `(:ok ,(format nil "Set breakpoint in ~A" caller))))))
+
+(defun frame-pointer= (frame1 frame2)
+ "Return true if the frame pointers of FRAME1 and FRAME2 are the same."
+ (sys:sap= (di::frame-pointer frame1) (di::frame-pointer frame2)))
+
+;;; The PC in escaped frames at a single-return-value point is
+;;; actually vm:single-value-return-byte-offset bytes after the
+;;; position given in the debug info. Here we try to recognize such
+;;; cases.
+;;;
+(defun next-code-locations (frame code-location)
+ "Like `debug::next-code-locations' but be careful in escaped frames."
+ (let ((next (debug::next-code-locations code-location)))
+ (flet ((adjust-pc ()
+ (let ((cl (di::copy-compiled-code-location code-location)))
+ (incf (di::compiled-code-location-pc cl)
+ vm:single-value-return-byte-offset)
+ cl)))
+ (cond ((and (di::compiled-frame-escaped frame)
+ (eq (di:code-location-kind code-location)
+ :single-value-return)
+ (= (length next) 1)
+ (di:code-location= (car next) (adjust-pc)))
+ (debug::next-code-locations (car next)))
+ (t
+ next)))))
+
+(defun set-step-breakpoints (frame)
+ (let ((cl (di:frame-code-location frame)))
+ (when (di:debug-block-elsewhere-p (di:code-location-debug-block cl))
+ (error "Cannot step in elsewhere code"))
+ (let* ((debug::*bad-code-location-types*
+ (remove :call-site debug::*bad-code-location-types*))
+ (next (next-code-locations frame cl)))
+ (cond (next
+ (let ((steppoints '()))
+ (flet ((hook (bp-frame bp)
+ (signal-breakpoint bp bp-frame)
+ (mapc #'di:delete-breakpoint steppoints)))
+ (dolist (code-location next)
+ (let ((bp (di:make-breakpoint #'hook code-location
+ :kind :code-location)))
+ (di:activate-breakpoint bp)
+ (push bp steppoints))))))
+ (t
+ (break-on-return frame))))))
+
+
+;; XXX the return values at return breakpoints should be passed to the
+;; user hooks. debug-int.lisp should be changed to do this cleanly.
+
+;;; The sigcontext and the PC for a breakpoint invocation are not
+;;; passed to user hook functions, but we need them to extract return
+;;; values. So we advice di::handle-breakpoint and bind the values to
+;;; special variables.
+;;;
+(defvar *breakpoint-sigcontext*)
+(defvar *breakpoint-pc*)
+
+(defun sigcontext-object (sc index)
+ "Extract the lisp object in sigcontext SC at offset INDEX."
+ (kernel:make-lisp-obj (vm:ucontext-register sc index)))
+
+(defun known-return-point-values (sigcontext sc-offsets)
+ (let ((fp (system:int-sap (vm:ucontext-register sigcontext
+ vm::cfp-offset))))
+ (system:without-gcing
+ (loop for sc-offset across sc-offsets
+ collect (di::sub-access-debug-var-slot fp sc-offset sigcontext)))))
+
+;;; SCL returns the first few values in registers and the rest on
+;;; the stack. In the multiple value case, the number of values is
+;;; stored in a dedicated register. The values of the registers can be
+;;; accessed in the sigcontext for the breakpoint. There are 3 kinds
+;;; of return conventions: :single-value-return, :unknown-return, and
+;;; :known-return.
+;;;
+;;; The :single-value-return convention returns the value in a
+;;; register without setting the nargs registers.
+;;;
+;;; The :unknown-return variant is used for multiple values. A
+;;; :unknown-return point consists actually of 2 breakpoints: one for
+;;; the single value case and one for the general case. The single
+;;; value breakpoint comes vm:single-value-return-byte-offset after
+;;; the multiple value breakpoint.
+;;;
+;;; The :known-return convention is used by local functions.
+;;; :known-return is currently not supported because we don't know
+;;; where the values are passed.
+;;;
+(defun breakpoint-values (breakpoint)
+ "Return the list of return values for a return point."
+ (flet ((1st (sc) (sigcontext-object sc (car vm::register-arg-offsets))))
+ (let ((sc (locally (declare (optimize (ext:inhibit-warnings 3)))
+ (alien:sap-alien *breakpoint-sigcontext* (* unix:ucontext))))
+ (cl (di:breakpoint-what breakpoint)))
+ (ecase (di:code-location-kind cl)
+ (:single-value-return
+ (list (1st sc)))
+ (:known-return
+ (let ((info (di:breakpoint-info breakpoint)))
+ (if (vectorp info)
+ (known-return-point-values sc info)
+ (progn
+ ;;(break)
+ (list "<<known-return convention not supported>>" info)))))
+ (:unknown-return
+ (let ((mv-return-pc (di::compiled-code-location-pc cl)))
+ (if (= mv-return-pc *breakpoint-pc*)
+ (mv-function-end-breakpoint-values sc)
+ (list (1st sc)))))))))
+
+(defun mv-function-end-breakpoint-values (sigcontext)
+ (let ((sym (find-symbol (symbol-name '#:function-end-breakpoint-values/standard)
+ :debug-internals)))
+ (cond (sym (funcall sym sigcontext))
+ (t (di::get-function-end-breakpoint-values sigcontext)))))
+
+(defun debug-function-returns (debug-fun)
+ "Return the return style of DEBUG-FUN."
+ (let* ((cdfun (di::compiled-debug-function-compiler-debug-fun debug-fun)))
+ (c::compiled-debug-function-returns cdfun)))
+
+(define-condition breakpoint (simple-condition)
+ ((message :initarg :message :reader breakpoint.message)
+ (values :initarg :values :reader breakpoint.values))
+ (:report (lambda (c stream) (princ (breakpoint.message c) stream))))
+
+#+nil
+(defimplementation condition-extras ((c breakpoint))
+ ;; simply pop up the source buffer
+ `((:short-frame-source 0)))
+
+(defun signal-breakpoint (breakpoint frame)
+ "Signal a breakpoint condition for BREAKPOINT in FRAME.
+Try to create a informative message."
+ (flet ((brk (values fstring &rest args)
+ (let ((msg (apply #'format nil fstring args))
+ (debug:*stack-top-hint* frame))
+ (break 'breakpoint :message msg :values values))))
+ (with-struct (di::breakpoint- kind what) breakpoint
+ (case kind
+ (:code-location
+ (case (di:code-location-kind what)
+ ((:single-value-return :known-return :unknown-return)
+ (let ((values (breakpoint-values breakpoint)))
+ (brk values "Return value: ~{~S ~}" values)))
+ (t
+ #+(or)
+ (when (eq (di:code-location-kind what) :call-site)
+ (call-site-function breakpoint frame))
+ (brk nil "Breakpoint: ~S ~S"
+ (di:code-location-kind what)
+ (di::compiled-code-location-pc what)))))
+ (:function-start
+ (brk nil "Function start breakpoint"))
+ (t (brk nil "Breakpoint: ~A in ~A" breakpoint frame))))))
+
+#+nil
+(defimplementation sldb-break-at-start (fname)
+ (let ((debug-fun (di:function-debug-function (coerce fname 'function))))
+ (cond ((not debug-fun)
+ `(:error ,(format nil "~S has no debug-function" fname)))
+ (t
+ (flet ((hook (frame bp &optional args cookie)
+ (declare (ignore args cookie))
+ (signal-breakpoint bp frame)))
+ (let ((bp (di:make-breakpoint #'hook debug-fun
+ :kind :function-start)))
+ (di:activate-breakpoint bp)
+ `(:ok ,(format nil "Set breakpoint in ~S" fname))))))))
+
+(defun frame-cfp (frame)
+ "Return the Control-Stack-Frame-Pointer for FRAME."
+ (etypecase frame
+ (di::compiled-frame (di::frame-pointer frame))
+ ((or di::interpreted-frame null) -1)))
+
+(defun frame-ip (frame)
+ "Return the (absolute) instruction pointer and the relative pc of FRAME."
+ (if (not frame)
+ -1
+ (let ((debug-fun (di::frame-debug-function frame)))
+ (etypecase debug-fun
+ (di::compiled-debug-function
+ (let* ((code-loc (di:frame-code-location frame))
+ (component (di::compiled-debug-function-component debug-fun))
+ (pc (di::compiled-code-location-pc code-loc))
+ (ip (sys:without-gcing
+ (sys:sap-int
+ (sys:sap+ (kernel:code-instructions component) pc)))))
+ (values ip pc)))
+ ((or di::bogus-debug-function di::interpreted-debug-function)
+ -1)))))
+
+(defun frame-registers (frame)
+ "Return the lisp registers CSP, CFP, IP, OCFP, LRA for FRAME-NUMBER."
+ (let* ((cfp (frame-cfp frame))
+ (csp (frame-cfp (di::frame-up frame)))
+ (ip (frame-ip frame))
+ (ocfp (frame-cfp (di::frame-down frame)))
+ (lra (frame-ip (di::frame-down frame))))
+ (values csp cfp ip ocfp lra)))
+
+(defun print-frame-registers (frame-number)
+ (let ((frame (di::frame-real-frame (nth-frame frame-number))))
+ (flet ((fixnum (p) (etypecase p
+ (integer p)
+ (sys:system-area-pointer (sys:sap-int p)))))
+ (apply #'format t "~
+CSP = ~X
+CFP = ~X
+IP = ~X
+OCFP = ~X
+LRA = ~X~%" (mapcar #'fixnum
+ (multiple-value-list (frame-registers frame)))))))
+
+
+(defimplementation disassemble-frame (frame-number)
+ "Return a string with the disassembly of frames code."
+ (print-frame-registers frame-number)
+ (terpri)
+ (let* ((frame (di::frame-real-frame (nth-frame frame-number)))
+ (debug-fun (di::frame-debug-function frame)))
+ (etypecase debug-fun
+ (di::compiled-debug-function
+ (let* ((component (di::compiled-debug-function-component debug-fun))
+ (fun (di:debug-function-function debug-fun)))
+ (if fun
+ (disassemble fun)
+ (disassem:disassemble-code-component component))))
+ (di::bogus-debug-function
+ (format t "~%[Disassembling bogus frames not implemented]")))))
+
+
+;;;; Inspecting
+
+(defclass scl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+ (make-instance 'scl-inspector))
+
+(defconstant +lowtag-symbols+
+ '(vm:even-fixnum-type
+ vm:instance-pointer-type
+ vm:other-immediate-0-type
+ vm:list-pointer-type
+ vm:odd-fixnum-type
+ vm:function-pointer-type
+ vm:other-immediate-1-type
+ vm:other-pointer-type)
+ "Names of the constants that specify type tags.
+The `symbol-value' of each element is a type tag.")
+
+(defconstant +header-type-symbols+
+ (labels ((suffixp (suffix string)
+ (and (>= (length string) (length suffix))
+ (string= string suffix :start1 (- (length string)
+ (length suffix)))))
+ (header-type-symbol-p (x)
+ (and (suffixp (symbol-name '#:-type) (symbol-name x))
+ (not (member x +lowtag-symbols+))
+ (boundp x)
+ (typep (symbol-value x) 'fixnum))))
+ (remove-if-not #'header-type-symbol-p
+ (append (apropos-list (symbol-name '#:-type) :vm)
+ (apropos-list (symbol-name '#:-type) :bignum))))
+ "A list of names of the type codes in boxed objects.")
+
+(defimplementation describe-primitive-type (object)
+ (with-output-to-string (*standard-output*)
+ (let* ((lowtag (kernel:get-lowtag object))
+ (lowtag-symbol (find lowtag +lowtag-symbols+ :key #'symbol-value)))
+ (format t "lowtag: ~A" lowtag-symbol)
+ (when (member lowtag (list vm:other-pointer-type
+ vm:function-pointer-type
+ vm:other-immediate-0-type
+ vm:other-immediate-1-type
+ ))
+ (let* ((type (kernel:get-type object))
+ (type-symbol (find type +header-type-symbols+
+ :key #'symbol-value)))
+ (format t ", type: ~A" type-symbol))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+ (cond ((di::indirect-value-cell-p o)
+ (values (format nil "~A is a value cell." o)
+ `("Value: " (:value ,(c:value-cell-ref o)))))
+ ((alien::alien-value-p o)
+ (inspect-alien-value o))
+ (t
+ (scl-inspect o))))
+
+(defun scl-inspect (o)
+ (destructuring-bind (text labeledp . parts)
+ (inspect::describe-parts o)
+ (values (format nil "~A~%" text)
+ (if labeledp
+ (loop for (label . value) in parts
+ append (label-value-line label value))
+ (loop for value in parts for i from 0
+ append (label-value-line i value))))))
+
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (let ((header (kernel:get-type o)))
+ (cond ((= header vm:function-header-type)
+ (values (format nil "~A is a function." o)
+ (append (label-value-line*
+ ("Self" (kernel:%function-self o))
+ ("Next" (kernel:%function-next o))
+ ("Name" (kernel:%function-name o))
+ ("Arglist" (kernel:%function-arglist o))
+ ("Type" (kernel:%function-type o))
+ ("Code" (kernel:function-code-header o)))
+ (list
+ (with-output-to-string (s)
+ (disassem:disassemble-function o :stream s))))))
+ ((= header vm:closure-header-type)
+ (values (format nil "~A is a closure" o)
+ (append
+ (label-value-line "Function" (kernel:%closure-function o))
+ `("Environment:" (:newline))
+ (loop for i from 0 below (- (kernel:get-closure-length o)
+ (1- vm:closure-info-offset))
+ append (label-value-line
+ i (kernel:%closure-index-ref o i))))))
+ ((eval::interpreted-function-p o)
+ (scl-inspect o))
+ (t
+ (call-next-method)))))
+
+
+(defmethod inspect-for-emacs ((o kernel:code-component) (_ backend-inspector))
+ (declare (ignore _))
+ (values (format nil "~A is a code data-block." o)
+ (append
+ (label-value-line*
+ ("code-size" (kernel:%code-code-size o))
+ ("entry-points" (kernel:%code-entry-points o))
+ ("debug-info" (kernel:%code-debug-info o))
+ ("trace-table-offset" (kernel:code-header-ref
+ o vm:code-trace-table-offset-slot)))
+ `("Constants:" (:newline))
+ (loop for i from vm:code-constants-offset
+ below (kernel:get-header-data o)
+ append (label-value-line i (kernel:code-header-ref o i)))
+ `("Code:" (:newline)
+ , (with-output-to-string (s)
+ (cond ((kernel:%code-debug-info o)
+ (disassem:disassemble-code-component o :stream s))
+ (t
+ (disassem:disassemble-memory
+ (disassem::align
+ (+ (logandc2 (kernel:get-lisp-obj-address o)
+ vm:lowtag-mask)
+ (* vm:code-constants-offset vm:word-bytes))
+ (ash 1 vm:lowtag-bits))
+ (ash (kernel:%code-code-size o) vm:word-shift)
+ :stream s))))))))
+
+(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector backend-inspector))
+ (declare (ignore inspector))
+ (values (format nil "~A is a fdenf object." o)
+ (label-value-line*
+ ("name" (kernel:fdefn-name o))
+ ("function" (kernel:fdefn-function o))
+ ("raw-addr" (sys:sap-ref-32
+ (sys:int-sap (kernel:get-lisp-obj-address o))
+ (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
+
+(defmethod inspect-for-emacs ((o array) (inspector backend-inspector))
+ inspector
+ (cond ((kernel:array-header-p o)
+ (values (format nil "~A is an array." o)
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:rank (array-rank o))
+ (:fill-pointer (kernel:%array-fill-pointer o))
+ (:fill-pointer-p (kernel:%array-fill-pointer-p o))
+ (:elements (kernel:%array-available-elements o))
+ (:data (kernel:%array-data-vector o))
+ (:displacement (kernel:%array-displacement o))
+ (:displaced-p (kernel:%array-displaced-p o))
+ (:dimensions (array-dimensions o)))))
+ (t
+ (values (format nil "~A is an simple-array." o)
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:length (length o)))))))
+
+(defmethod inspect-for-emacs ((o simple-vector) (inspector backend-inspector))
+ inspector
+ (values (format nil "~A is a vector." o)
+ (append
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:length (c::vector-length o)))
+ (unless (eq (array-element-type o) 'nil)
+ (loop for i below (length o)
+ append (label-value-line i (aref o i)))))))
+
+(defun inspect-alien-record (alien)
+ (values
+ (format nil "~A is an alien value." alien)
+ (with-struct (alien::alien-value- sap type) alien
+ (with-struct (alien::alien-record-type- kind name fields) type
+ (append
+ (label-value-line*
+ (:sap sap)
+ (:kind kind)
+ (:name name))
+ (loop for field in fields
+ append (let ((slot (alien::alien-record-field-name field)))
+ (label-value-line slot (alien:slot alien slot)))))))))
+
+(defun inspect-alien-pointer (alien)
+ (values
+ (format nil "~A is an alien value." alien)
+ (with-struct (alien::alien-value- sap type) alien
+ (label-value-line*
+ (:sap sap)
+ (:type type)
+ (:to (alien::deref alien))))))
+
+(defun inspect-alien-value (alien)
+ (typecase (alien::alien-value-type alien)
+ (alien::alien-record-type (inspect-alien-record alien))
+ (alien::alien-pointer-type (inspect-alien-pointer alien))
+ (t (scl-inspect alien))))
+
+;;;; Profiling
+(defimplementation profile (fname)
+ (eval `(profile:profile ,fname)))
+
+(defimplementation unprofile (fname)
+ (eval `(profile:unprofile ,fname)))
+
+(defimplementation unprofile-all ()
+ (eval `(profile:unprofile))
+ "All functions unprofiled.")
+
+(defimplementation profile-report ()
+ (eval `(profile:report-time)))
+
+(defimplementation profile-reset ()
+ (eval `(profile:reset-time))
+ "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+ profile:*timed-functions*)
+
+(defimplementation profile-package (package callers methods)
+ (profile:profile-all :package package
+ :callers-p callers
+ #+nil :methods #+nil methods))
+
+
+;;;; Multiprocessing
+
+(defimplementation spawn (fn &key name)
+ (thread:thread-create fn :name (or name "Anonymous")))
+
+(defvar *thread-id-counter* 0)
+(defvar *thread-id-counter-lock* (thread:make-lock "Thread ID counter"))
+
+(defimplementation thread-id (thread)
+ (thread:with-lock-held (*thread-id-counter-lock*)
+ (or (getf (thread:thread-plist thread) 'id)
+ (setf (getf (thread:thread-plist thread) 'id)
+ (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+ (block find-thread
+ (thread:map-over-threads
+ #'(lambda (thread)
+ (when (eql (getf (thread:thread-plist thread) 'id) id)
+ (return-from find-thread thread))))))
+
+(defimplementation thread-name (thread)
+ (princ-to-string (thread:thread-name thread)))
+
+(defimplementation thread-status (thread)
+ (let ((dynamic-values (thread::thread-dynamic-values thread)))
+ (if (zerop dynamic-values) "Exited" "Running")))
+
+(defimplementation make-lock (&key name)
+ (thread:make-lock name))
+
+(defimplementation call-with-lock-held (lock function)
+ (declare (type function function))
+ (thread:with-lock-held (lock) (funcall function)))
+
+(defimplementation current-thread ()
+ thread:*thread*)
+
+(defimplementation all-threads ()
+ (let ((all-threads nil))
+ (thread:map-over-threads #'(lambda (thread) (push thread all-threads)))
+ all-threads))
+
+(defimplementation interrupt-thread (thread fn)
+ (thread:thread-interrupt thread #'(lambda ()
+ (sys:with-interrupts
+ (funcall fn)))))
+
+(defimplementation kill-thread (thread)
+ (thread:destroy-thread thread))
+
+(defimplementation thread-alive-p (thread)
+ (not (zerop (thread::thread-dynamic-values thread))))
+
+(defvar *mailbox-lock* (thread:make-lock "Mailbox lock"))
+
+(defstruct (mailbox)
+ (lock (thread:make-lock "Thread mailbox" :type :error-check
+ :interruptible nil)
+ :type thread:error-check-lock)
+ (queue '() :type list))
+
+(defun mailbox (thread)
+ "Return 'thread's mailbox."
+ (thread:with-lock-held (*mailbox-lock*)
+ (or (getf (thread:thread-plist thread) 'mailbox)
+ (setf (getf (thread:thread-plist thread) 'mailbox) (make-mailbox)))))
+
+(defimplementation send (thread message)
+ (let* ((mbox (mailbox thread))
+ (lock (mailbox-lock mbox)))
+ (sys:without-interrupts
+ (thread:with-lock-held (lock "Mailbox Send")
+ (setf (mailbox-queue mbox) (nconc (mailbox-queue mbox)
+ (list message)))))
+ (mp:process-wakeup thread)
+ message))
+
+(defimplementation receive ()
+ (let* ((mbox (mailbox thread:*thread*))
+ (lock (mailbox-lock mbox)))
+ (loop
+ (mp:process-wait-with-timeout "Mailbox read wait" 1
+ #'(lambda () (mailbox-queue mbox)))
+ (multiple-value-bind (message winp)
+ (sys:without-interrupts
+ (mp:with-lock-held (lock "Mailbox read")
+ (let ((queue (mailbox-queue mbox)))
+ (cond (queue
+ (setf (mailbox-queue mbox) (cdr queue))
+ (values (car queue) t))
+ (t
+ (values nil nil))))))
+ (when winp
+ (return message))))))
+
+
+
+(defimplementation emacs-connected ())
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;Trace implementations
+;; In SCL, we have:
+;; (trace <name>)
+;; (trace (method <name> <qualifier>? (<specializer>+)))
+;; (trace :methods t '<name>) ;;to trace all methods of the gf <name>
+;; <name> can be a normal name or a (setf name)
+
+(defun tracedp (spec)
+ (member spec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (spec &rest options)
+ (cond ((tracedp spec)
+ (eval `(untrace ,spec))
+ (format nil "~S is now untraced." spec))
+ (t
+ (eval `(trace ,spec ,@options))
+ (format nil "~S is now traced." spec))))
+
+(defimplementation toggle-trace (spec)
+ (ecase (car spec)
+ ((setf)
+ (toggle-trace-aux spec))
+ ((:defgeneric)
+ (let ((name (second spec)))
+ (toggle-trace-aux name :methods name)))
+ ((:defmethod)
+ nil)
+ ((:call)
+ (destructuring-bind (caller callee) (cdr spec)
+ (toggle-trace-aux (process-fspec callee)
+ :wherein (list (process-fspec caller)))))))
+
+(defun process-fspec (fspec)
+ (cond ((consp fspec)
+ (ecase (first fspec)
+ ((:defun :defgeneric) (second fspec))
+ ((:defmethod)
+ `(method ,(second fspec) ,@(third fspec) ,(fourth fspec)))
+ ;; this isn't actually supported
+ ((:labels) `(labels ,(process-fspec (second fspec)) ,(third fspec)))
+ ((:flet) `(flet ,(process-fspec (second fspec)) ,(third fspec)))))
+ (t
+ fspec)))
+
+;;; Weak datastructures
+
+;;; Not implemented in SCL.
+(defimplementation make-weak-key-hash-table (&rest args)
+ (apply #'make-hash-table :weak-p t args))
+
+;; Local Variables:
+;; pbook-heading-regexp: "^;;;\\(;+\\)"
+;; pbook-commentary-regexp: "^;;;\\($\\|[^;]\\)"
+;; End:
Added: branches/trunk-reorg/thirdparty/slime/swank-source-file-cache.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-source-file-cache.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-source-file-cache.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,118 @@
+;;;; Source-file cache
+;;;
+;;; To robustly find source locations in CMUCL and SBCL it's useful to
+;;; have the exact source code that the loaded code was compiled from.
+;;; In this source we can accurately find the right location, and from
+;;; that location we can extract a "snippet" of code to show what the
+;;; definition looks like. Emacs can use this snippet in a best-match
+;;; search to locate the right definition, which works well even if
+;;; the buffer has been modified.
+;;;
+;;; The idea is that if a definition previously started with
+;;; `(define-foo bar' then it probably still does.
+;;;
+;;; Whenever we see that the file on disk has the same
+;;; `file-write-date' as a location we're looking for we cache the
+;;; whole file inside Lisp. That way we will still have the matching
+;;; version even if the file is later modified on disk. If the file is
+;;; later recompiled and reloaded then we replace our cache entry.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+
+(in-package :swank-backend)
+
+(defvar *cache-sourcecode* t
+ "When true complete source files are cached.
+The cache is used to keep known good copies of the source text which
+correspond to the loaded code. Finding definitions is much more
+reliable when the exact source is available, so we cache it in case it
+gets edited on disk later.")
+
+(defvar *source-file-cache* (make-hash-table :test 'equal)
+ "Cache of source file contents.
+Maps from truename to source-cache-entry structure.")
+
+(defstruct (source-cache-entry
+ (:conc-name source-cache-entry.)
+ (:constructor make-source-cache-entry (text date)))
+ text date)
+
+(defimplementation buffer-first-change (filename)
+ "Load a file into the cache when the user modifies its buffer.
+This is a win if the user then saves the file and tries to M-. into it."
+ (unless (source-cached-p filename)
+ (ignore-errors
+ (source-cache-get filename (file-write-date filename))))
+ nil)
+
+(defun get-source-code (filename code-date)
+ "Return the source code for FILENAME as written on DATE in a string.
+If the exact version cannot be found then return the current one from disk."
+ (or (source-cache-get filename code-date)
+ (read-file filename)))
+
+(defun source-cache-get (filename date)
+ "Return the source code for FILENAME as written on DATE in a string.
+Return NIL if the right version cannot be found."
+ (when *cache-sourcecode*
+ (let ((entry (gethash filename *source-file-cache*)))
+ (cond ((and entry (equal date (source-cache-entry.date entry)))
+ ;; Cache hit.
+ (source-cache-entry.text entry))
+ ((or (null entry)
+ (not (equal date (source-cache-entry.date entry))))
+ ;; Cache miss.
+ (if (equal (file-write-date filename) date)
+ ;; File on disk has the correct version.
+ (let ((source (read-file filename)))
+ (setf (gethash filename *source-file-cache*)
+ (make-source-cache-entry source date))
+ source)
+ nil))))))
+
+(defun source-cached-p (filename)
+ "Is any version of FILENAME in the source cache?"
+ (if (gethash filename *source-file-cache*) t))
+
+(defun read-file (filename)
+ "Return the entire contents of FILENAME as a string."
+ (with-open-file (s filename :direction :input
+ :external-format (or (guess-external-format filename)
+ (find-external-format "latin-1")
+ :default))
+ (let ((string (make-string (file-length s))))
+ (read-sequence string s)
+ string)))
+
+;;;; Snippets
+
+(defvar *source-snippet-size* 256
+ "Maximum number of characters in a snippet of source code.
+Snippets at the beginning of definitions are used to tell Emacs what
+the definitions looks like, so that it can accurately find them by
+text search.")
+
+(defun read-snippet (stream &optional position)
+ "Read a string of upto *SOURCE-SNIPPET-SIZE* characters from STREAM.
+If POSITION is given, set the STREAM's file position first."
+ (when position
+ (file-position stream position))
+ #+SBCL (skip-comments-and-whitespace stream)
+ (read-upto-n-chars stream *source-snippet-size*))
+
+(defun skip-comments-and-whitespace (stream)
+ (case (peek-char nil stream)
+ ((#\Space #\Tab #\Newline #\Linefeed)
+ (read-char stream)
+ (skip-comments-and-whitespace stream))
+ (#\;
+ (read-line stream)
+ (skip-comments-and-whitespace stream))))
+
+(defun read-upto-n-chars (stream n)
+ "Return a string of upto N chars from STREAM."
+ (let* ((string (make-string n))
+ (chars (read-sequence string stream)))
+ (subseq string 0 chars)))
+
Added: branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,131 @@
+;;;; Source-paths
+
+;;; CMUCL/SBCL use a data structure called "source-path" to locate
+;;; subforms. The compiler assigns a source-path to each form in a
+;;; compilation unit. Compiler notes usually contain the source-path
+;;; of the error location.
+;;;
+;;; Compiled code objects don't contain source paths, only the
+;;; "toplevel-form-number" and the (sub-) "form-number". To get from
+;;; the form-number to the source-path we need the entire toplevel-form
+;;; (i.e. we have to read the source code). CMUCL has already some
+;;; utilities to do this translation, but we use some extended
+;;; versions, because we need more exact position info. Apparently
+;;; Hemlock is happy with the position of the toplevel-form; we also
+;;; need the position of subforms.
+;;;
+;;; We use a special readtable to get the positions of the subforms.
+;;; The readtable stores the start and end position for each subform in
+;;; hashtable for later retrieval.
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+
+;;; Taken from swank-cmucl.lisp, by Helmut Eller
+
+(in-package :swank-backend)
+
+;; Some test to ensure the required conformance
+(let ((rt (copy-readtable nil)))
+ (assert (or (not (get-macro-character #\space rt))
+ (nth-value 1 (get-macro-character #\space rt))))
+ (assert (not (get-macro-character #\\ rt))))
+
+(defun make-source-recorder (fn source-map)
+ "Return a macro character function that does the same as FN, but
+additionally stores the result together with the stream positions
+before and after of calling FN in the hashtable SOURCE-MAP."
+ (declare (type function fn))
+ (lambda (stream char)
+ (let ((start (file-position stream))
+ (values (multiple-value-list (funcall fn stream char)))
+ (end (file-position stream)))
+ ;;(format t "[~D ~{~A~^, ~} ~D ~D]~%" start values end (char-code char))
+ (unless (null values)
+ (push (cons start end) (gethash (car values) source-map)))
+ (values-list values))))
+
+(defun make-source-recording-readtable (readtable source-map)
+ "Return a source position recording copy of READTABLE.
+The source locations are stored in SOURCE-MAP."
+ (let* ((tab (copy-readtable readtable))
+ (*readtable* tab))
+ (dotimes (code 128)
+ (let ((char (code-char code)))
+ (multiple-value-bind (fn term) (get-macro-character char tab)
+ (when fn
+ (set-macro-character char (make-source-recorder fn source-map)
+ term tab)))))
+ (suppress-sharp-dot tab)
+ tab))
+
+(defun suppress-sharp-dot (readtable)
+ (when (get-macro-character #\# readtable)
+ (let ((sharp-dot (get-dispatch-macro-character #\# #\. readtable)))
+ (set-dispatch-macro-character #\# #\. (lambda (&rest args)
+ (let ((*read-suppress* t))
+ (apply sharp-dot args))
+ (if *read-suppress*
+ (values)
+ (list (gensym "#."))))
+ readtable))))
+
+(defun read-and-record-source-map (stream)
+ "Read the next object from STREAM.
+Return the object together with a hashtable that maps
+subexpressions of the object to stream positions."
+ (let* ((source-map (make-hash-table :test #'eq))
+ (*readtable* (make-source-recording-readtable *readtable* source-map))
+ (start (file-position stream))
+ (form (read stream))
+ (end (file-position stream)))
+ ;; ensure that at least FORM is in the source-map
+ (unless (gethash form source-map)
+ (push (cons start end) (gethash form source-map)))
+ (values form source-map)))
+
+(defun read-source-form (n stream)
+ "Read the Nth toplevel form number with source location recording.
+Return the form and the source-map."
+ (let ((*read-suppress* t))
+ (dotimes (i n)
+ (read stream)))
+ (let ((*read-suppress* nil)
+ (*read-eval* nil))
+ (read-and-record-source-map stream)))
+
+(defun source-path-stream-position (path stream)
+ "Search the source-path PATH in STREAM and return its position."
+ (check-source-path path)
+ (destructuring-bind (tlf-number . path) path
+ (multiple-value-bind (form source-map) (read-source-form tlf-number stream)
+ (source-path-source-position (cons 0 path) form source-map))))
+
+(defun check-source-path (path)
+ (unless (and (consp path)
+ (every #'integerp path))
+ (error "The source-path ~S is not valid." path)))
+
+(defun source-path-string-position (path string)
+ (with-input-from-string (s string)
+ (source-path-stream-position path s)))
+
+(defun source-path-file-position (path filename)
+ (with-open-file (file filename)
+ (source-path-stream-position path file)))
+
+(defun source-path-source-position (path form source-map)
+ "Return the start position of PATH from FORM and SOURCE-MAP. All
+subforms along the path are considered and the start and end position
+of the deepest (i.e. smallest) possible form is returned."
+ ;; compute all subforms along path
+ (let ((forms (loop for n in path
+ for f = form then (nth n f)
+ collect f)))
+ ;; select the first subform present in source-map
+ (loop for form in (reverse forms)
+ for positions = (gethash form source-map)
+ until (and positions (null (cdr positions)))
+ finally (destructuring-bind ((start . end)) positions
+ (return (values (1- start) end))))))
+
Added: branches/trunk-reorg/thirdparty/slime/swank.asd
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank.asd 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank.asd 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,48 @@
+;;; -*- lisp -*-
+
+;; ASDF system definition for loading the Swank server independently
+;; of Emacs.
+;;
+;; This is only useful if you want to start a Swank server in a Lisp
+;; processes that doesn't run under Emacs. Lisp processes created by
+;; `M-x slime' automatically start the server.
+
+;; Usage:
+;;
+;; (require :swank)
+;; (swank:create-swank-server PORT) => ACTUAL-PORT
+;;
+;; (PORT can be zero to mean "any available port".)
+;; Then the Swank server is running on localhost:ACTUAL-PORT. You can
+;; use `M-x slime-connect' to connect Emacs to it.
+;;
+;; This code has been placed in the Public Domain. All warranties
+;; are disclaimed.
+
+(defpackage :swank-loader
+ (:use :cl))
+
+(in-package :swank-loader)
+
+(defclass cl-script-file (asdf:source-file) ())
+
+(defmethod asdf:perform ((o asdf:compile-op) (f cl-script-file))
+ t)
+(defmethod asdf:perform ((o asdf:load-op) (f cl-script-file))
+ (mapcar #'load (asdf:input-files o f)))
+(defmethod asdf:output-files ((o asdf:compile-op) (f cl-script-file))
+ nil)
+(defmethod asdf:input-files ((o asdf:load-op) (c cl-script-file))
+ (list (asdf:component-pathname c)))
+(defmethod asdf:operation-done-p ((o asdf:compile-op) (c cl-script-file))
+ t)
+(defmethod asdf:source-file-type ((c cl-script-file) (s asdf:module))
+ "lisp")
+
+(asdf:defsystem :swank
+ :default-component-class cl-script-file
+ :components ((:file "swank-loader")))
+
+(defparameter *source-directory*
+ (asdf:component-pathname (asdf:find-system :swank)))
+
Added: branches/trunk-reorg/thirdparty/slime/swank.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,3198 @@
+;;; -*- outline-regexp:";;;;;*" indent-tabs-mode:nil coding:latin-1-unix -*-
+;;;
+;;; This code has been placed in the Public Domain. All warranties
+;;; are disclaimed.
+;;;
+;;;; swank.lisp
+;;;
+;;; This file defines the "Swank" TCP server for Emacs to talk to. The
+;;; code in this file is purely portable Common Lisp. We do require a
+;;; smattering of non-portable functions in order to write the server,
+;;; so we have defined them in `swank-backend.lisp' and implemented
+;;; them separately for each Lisp implementation. These extensions are
+;;; available to us here via the `SWANK-BACKEND' package.
+
+(defpackage :swank
+ (:use :common-lisp :swank-backend)
+ (:export #:startup-multiprocessing
+ #:start-server
+ #:create-server
+ #:ed-in-emacs
+ #:inspect-in-emacs
+ #:print-indentation-lossage
+ #:swank-debugger-hook
+ #:run-after-init-hook
+ #:inspect-for-emacs
+ #:inspect-slot-for-emacs
+ ;; These are user-configurable variables:
+ #:*communication-style*
+ #:*dont-close*
+ #:*log-events*
+ #:*log-output*
+ #:*use-dedicated-output-stream*
+ #:*dedicated-output-stream-port*
+ #:*configure-emacs-indentation*
+ #:*readtable-alist*
+ #:*globally-redirect-io*
+ #:*global-debugger*
+ #:*sldb-printer-bindings*
+ #:*swank-pprint-bindings*
+ #:*default-worker-thread-bindings*
+ #:*macroexpand-printer-bindings*
+ #:*record-repl-results*
+ #:*debug-on-swank-error*
+ ;; These are re-exported directly from the backend:
+ #:buffer-first-change
+ #:frame-source-location-for-emacs
+ #:restart-frame
+ #:sldb-step
+ #:sldb-break
+ #:sldb-break-on-return
+ #:profiled-functions
+ #:profile-report
+ #:profile-reset
+ #:unprofile-all
+ #:profile-package
+ #:default-directory
+ #:set-default-directory
+ #:quit-lisp))
+
+(in-package :swank)
+
+
+;;;; Top-level variables, constants, macros
+
+(defconstant cl-package (find-package :cl)
+ "The COMMON-LISP package.")
+
+(defconstant keyword-package (find-package :keyword)
+ "The KEYWORD package.")
+
+(defvar *canonical-package-nicknames*
+ `((:common-lisp-user . :cl-user))
+ "Canonical package names to use instead of shortest name/nickname.")
+
+(defvar *auto-abbreviate-dotted-packages* t
+ "Abbreviate dotted package names to their last component if T.")
+
+(defvar *swank-io-package*
+ (let ((package (make-package :swank-io-package :use '())))
+ (import '(nil t quote) package)
+ package))
+
+(defconstant default-server-port 4005
+ "The default TCP port for the server (when started manually).")
+
+(defvar *swank-debug-p* t
+ "When true, print extra debugging information.")
+
+(defvar *redirect-io* t
+ "When non-nil redirect Lisp standard I/O to Emacs.
+Redirection is done while Lisp is processing a request for Emacs.")
+
+(defvar *sldb-printer-bindings*
+ `((*print-pretty* . t)
+ (*print-level* . 4)
+ (*print-length* . 10)
+ (*print-circle* . t)
+ (*print-readably* . nil)
+ (*print-pprint-dispatch* . ,(copy-pprint-dispatch nil))
+ (*print-gensym* . t)
+ (*print-base* . 10)
+ (*print-radix* . nil)
+ (*print-array* . t)
+ (*print-lines* . 10)
+ (*print-escape* . t)
+ (*print-right-margin* . 70))
+ "A set of printer variables used in the debugger.")
+
+(defvar *default-worker-thread-bindings* '()
+ "An alist to initialize dynamic variables in worker threads.
+The list has the form ((VAR . VALUE) ...). Each variable VAR will be
+bound to the corresponding VALUE.")
+
+(defun call-with-bindings (alist fun)
+ "Call FUN with variables bound according to ALIST.
+ALIST is a list of the form ((VAR . VAL) ...)."
+ (let* ((rlist (reverse alist))
+ (vars (mapcar #'car rlist))
+ (vals (mapcar #'cdr rlist)))
+ (progv vars vals
+ (funcall fun))))
+
+(defmacro with-bindings (alist &body body)
+ "See `call-with-bindings'."
+ `(call-with-bindings ,alist (lambda () ,@body)))
+
+;;; The `DEFSLIMEFUN' macro defines a function that Emacs can call via
+;;; RPC.
+
+(defmacro defslimefun (name arglist &body rest)
+ "A DEFUN for functions that Emacs can call by RPC."
+ `(progn
+ (defun ,name ,arglist ,@rest)
+ ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler…>
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (export ',name :swank))))
+
+(defun missing-arg ()
+ "A function that the compiler knows will never to return a value.
+You can use (MISSING-ARG) as the initform for defstruct slots that
+must always be supplied. This way the :TYPE slot option need not
+include some arbitrary initial value like NIL."
+ (error "A required &KEY or &OPTIONAL argument was not supplied."))
+
+
+;;;; Hooks
+;;;
+;;; We use Emacs-like `add-hook' and `run-hook' utilities to support
+;;; simple indirection. The interface is more CLish than the Emacs
+;;; Lisp one.
+
+(defmacro add-hook (place function)
+ "Add FUNCTION to the list of values on PLACE."
+ `(pushnew ,function ,place))
+
+(defun run-hook (functions &rest arguments)
+ "Call each of FUNCTIONS with ARGUMENTS."
+ (dolist (function functions)
+ (apply function arguments)))
+
+(defvar *new-connection-hook* '()
+ "This hook is run each time a connection is established.
+The connection structure is given as the argument.
+Backend code should treat the connection structure as opaque.")
+
+(defvar *connection-closed-hook* '()
+ "This hook is run when a connection is closed.
+The connection as passed as an argument.
+Backend code should treat the connection structure as opaque.")
+
+(defvar *pre-reply-hook* '()
+ "Hook run (without arguments) immediately before replying to an RPC.")
+
+(defvar *after-init-hook* '()
+ "Hook run after user init files are loaded.")
+
+(defun run-after-init-hook ()
+ (run-hook *after-init-hook*))
+
+
+;;;; Connections
+;;;
+;;; Connection structures represent the network connections between
+;;; Emacs and Lisp. Each has a socket stream, a set of user I/O
+;;; streams that redirect to Emacs, and optionally a second socket
+;;; used solely to pipe user-output to Emacs (an optimization).
+;;;
+
+(defstruct (connection
+ (:conc-name connection.)
+ (:print-function print-connection))
+ ;; Raw I/O stream of socket connection.
+ (socket-io (missing-arg) :type stream :read-only t)
+ ;; Optional dedicated output socket (backending `user-output' slot).
+ ;; Has a slot so that it can be closed with the connection.
+ (dedicated-output nil :type (or stream null))
+ ;; Streams that can be used for user interaction, with requests
+ ;; redirected to Emacs.
+ (user-input nil :type (or stream null))
+ (user-output nil :type (or stream null))
+ (user-io nil :type (or stream null))
+ ;; A stream that we use for *trace-output*; if nil, we user user-output.
+ (trace-output nil :type (or stream null))
+ ;; A stream where we send REPL results.
+ (repl-results nil :type (or stream null))
+ ;; In multithreaded systems we delegate certain tasks to specific
+ ;; threads. The `reader-thread' is responsible for reading network
+ ;; requests from Emacs and sending them to the `control-thread'; the
+ ;; `control-thread' is responsible for dispatching requests to the
+ ;; threads that should handle them; the `repl-thread' is the one
+ ;; that evaluates REPL expressions. The control thread dispatches
+ ;; all REPL evaluations to the REPL thread and for other requests it
+ ;; spawns new threads.
+ reader-thread
+ control-thread
+ repl-thread
+ ;; Callback functions:
+ ;; (SERVE-REQUESTS <this-connection>) serves all pending requests
+ ;; from Emacs.
+ (serve-requests (missing-arg) :type function)
+ ;; (READ) is called to read and return one message from Emacs.
+ (read (missing-arg) :type function)
+ ;; (SEND OBJECT) is called to send one message to Emacs.
+ (send (missing-arg) :type function)
+ ;; (CLEANUP <this-connection>) is called when the connection is
+ ;; closed.
+ (cleanup nil :type (or null function))
+ ;; Cache of macro-indentation information that has been sent to Emacs.
+ ;; This is used for preparing deltas to update Emacs's knowledge.
+ ;; Maps: symbol -> indentation-specification
+ (indentation-cache (make-hash-table :test 'eq) :type hash-table)
+ ;; The list of packages represented in the cache:
+ (indentation-cache-packages '())
+ ;; The communication style used.
+ (communication-style nil :type (member nil :spawn :sigio :fd-handler))
+ ;; The coding system for network streams.
+ (coding-system ))
+
+(defun print-connection (conn stream depth)
+ (declare (ignore depth))
+ (print-unreadable-object (conn stream :type t :identity t)))
+
+(defvar *connections* '()
+ "List of all active connections, with the most recent at the front.")
+
+(defvar *emacs-connection* nil
+ "The connection to Emacs currently in use.")
+
+(defvar *swank-state-stack* '()
+ "A list of symbols describing the current state. Used for debugging
+and to detect situations where interrupts can be ignored.")
+
+(defun default-connection ()
+ "Return the 'default' Emacs connection.
+This connection can be used to talk with Emacs when no specific
+connection is in use, i.e. *EMACS-CONNECTION* is NIL.
+
+The default connection is defined (quite arbitrarily) as the most
+recently established one."
+ (first *connections*))
+
+(defslimefun state-stack ()
+ "Return the value of *SWANK-STATE-STACK*."
+ *swank-state-stack*)
+
+;; A conditions to include backtrace information
+(define-condition swank-error (error)
+ ((condition :initarg :condition :reader swank-error.condition)
+ (backtrace :initarg :backtrace :reader swank-error.backtrace))
+ (:report (lambda (condition stream)
+ (princ (swank-error.condition condition) stream))))
+
+(defun make-swank-error (condition)
+ (let ((bt (ignore-errors
+ (call-with-debugging-environment
+ (lambda () (backtrace 0 nil))))))
+ (make-condition 'swank-error :condition condition :backtrace bt)))
+
+(add-hook *new-connection-hook* 'notify-backend-of-connection)
+(defun notify-backend-of-connection (connection)
+ (declare (ignore connection))
+ (emacs-connected))
+
+
+;;;; Utilities
+
+;;;;; Helper macros
+
+(defmacro with-io-redirection ((connection) &body body)
+ "Execute BODY I/O redirection to CONNECTION.
+If *REDIRECT-IO* is true then all standard I/O streams are redirected."
+ `(maybe-call-with-io-redirection ,connection (lambda () ,@body)))
+
+(defun maybe-call-with-io-redirection (connection fun)
+ (if *redirect-io*
+ (call-with-redirected-io connection fun)
+ (funcall fun)))
+
+(defmacro with-connection ((connection) &body body)
+ "Execute BODY in the context of CONNECTION."
+ `(call-with-connection ,connection (lambda () ,@body)))
+
+(defun call-with-connection (connection fun)
+ (let ((*emacs-connection* connection))
+ (with-io-redirection (*emacs-connection*)
+ (call-with-debugger-hook #'swank-debugger-hook fun))))
+
+(defmacro without-interrupts (&body body)
+ `(call-without-interrupts (lambda () ,@body)))
+
+(defmacro destructure-case (value &rest patterns)
+ "Dispatch VALUE to one of PATTERNS.
+A cross between `case' and `destructuring-bind'.
+The pattern syntax is:
+ ((HEAD . ARGS) . BODY)
+The list of patterns is searched for a HEAD `eq' to the car of
+VALUE. If one is found, the BODY is executed with ARGS bound to the
+corresponding values in the CDR of VALUE."
+ (let ((operator (gensym "op-"))
+ (operands (gensym "rand-"))
+ (tmp (gensym "tmp-")))
+ `(let* ((,tmp ,value)
+ (,operator (car ,tmp))
+ (,operands (cdr ,tmp)))
+ (case ,operator
+ ,@(loop for (pattern . body) in patterns collect
+ (if (eq pattern t)
+ `(t ,@body)
+ (destructuring-bind (op &rest rands) pattern
+ `(,op (destructuring-bind ,rands ,operands
+ ,@body)))))
+ ,@(if (eq (caar (last patterns)) t)
+ '()
+ `((t (error "destructure-case failed: ~S" ,tmp))))))))
+
+(defmacro with-temp-package (var &body body)
+ "Execute BODY with VAR bound to a temporary package.
+The package is deleted before returning."
+ `(let ((,var (make-package (gensym "TEMP-PACKAGE-"))))
+ (unwind-protect (progn ,@body)
+ (delete-package ,var))))
+
+(defmacro do-symbols* ((var &optional (package '*package*) result-form) &body body)
+ "Just like do-symbols, but makes sure a symbol is visited only once."
+ (let ((seen-ht (gensym "SEEN-HT")))
+ `(let ((,seen-ht (make-hash-table :test #'eq)))
+ (do-symbols (,var ,package ,result-form)
+ (unless (gethash ,var ,seen-ht)
+ (setf (gethash ,var ,seen-ht) t)
+ ,@body)))))
+
+
+;;;;; Logging
+
+(defvar *log-events* nil)
+(defvar *log-output* *error-output*)
+(defvar *event-history* (make-array 40 :initial-element nil)
+ "A ring buffer to record events for better error messages.")
+(defvar *event-history-index* 0)
+(defvar *enable-event-history* t)
+
+(defun log-event (format-string &rest args)
+ "Write a message to *terminal-io* when *log-events* is non-nil.
+Useful for low level debugging."
+ (with-standard-io-syntax
+ (let ((*print-readably* nil)
+ (*print-pretty* nil)
+ (*package* *swank-io-package*))
+ (when *enable-event-history*
+ (setf (aref *event-history* *event-history-index*)
+ (format nil "~?" format-string args))
+ (setf *event-history-index*
+ (mod (1+ *event-history-index*) (length *event-history*))))
+ (when *log-events*
+ (apply #'format *log-output* format-string args)
+ (force-output *log-output*)))))
+
+(defun event-history-to-list ()
+ "Return the list of events (older events first)."
+ (let ((arr *event-history*)
+ (idx *event-history-index*))
+ (concatenate 'list (subseq arr idx) (subseq arr 0 idx))))
+
+(defun dump-event-history (stream)
+ (dolist (e (event-history-to-list))
+ (dump-event e stream)))
+
+(defun dump-event (event stream)
+ (cond ((stringp event)
+ (write-string (escape-non-ascii event) stream))
+ ((null event))
+ (t (format stream "Unexpected event: ~A~%" event))))
+
+(defun escape-non-ascii (string)
+ "Return a string like STRING but with non-ascii chars escaped."
+ (cond ((ascii-string-p string) string)
+ (t (with-output-to-string (out)
+ (loop for c across string do
+ (cond ((ascii-char-p c) (write-char c out))
+ (t (format out "\\x~4,'0X" (char-code c)))))))))
+
+(defun ascii-string-p (o)
+ (and (stringp o)
+ (every #'ascii-char-p o)))
+
+(defun ascii-char-p (c)
+ (<= (char-code c) 127))
+
+
+;;;;; Misc
+
+(defun length= (seq n)
+ "Test for whether SEQ contains N number of elements. I.e. it's equivalent
+ to (= (LENGTH SEQ) N), but besides being more concise, it may also be more
+ efficiently implemented."
+ (etypecase seq
+ (list (do ((i n (1- i))
+ (list seq (cdr list)))
+ ((or (<= i 0) (null list))
+ (and (zerop i) (null list)))))
+ (sequence (= (length seq) n))))
+
+(defun ensure-list (thing)
+ (if (listp thing) thing (list thing)))
+
+(defun recursively-empty-p (list)
+ "Returns whether LIST consists only of arbitrarily nested empty lists."
+ (cond ((not (listp list)) nil)
+ ((null list) t)
+ (t (every #'recursively-empty-p list))))
+
+(defun maybecall (bool fn &rest args)
+ "Call FN with ARGS if BOOL is T. Otherwise return ARGS as multiple values."
+ (if bool (apply fn args) (values-list args)))
+
+(defun exactly-one-p (&rest values)
+ "If exactly one value in VALUES is non-NIL, this value is returned.
+Otherwise NIL is returned."
+ (let ((found nil))
+ (dolist (v values)
+ (when v (if found
+ (return-from exactly-one-p nil)
+ (setq found v))))
+ found))
+
+
+;;;;; Symbols
+
+(defun symbol-status (symbol &optional (package (symbol-package symbol)))
+ "Returns one of
+
+ :INTERNAL if the symbol is _present_ in PACKAGE as an _internal_ symbol,
+
+ :EXTERNAL if the symbol is _present_ in PACKAGE as an _external_ symbol,
+
+ :INHERITED if the symbol is _inherited_ by PACKAGE through USE-PACKAGE,
+ but is not _present_ in PACKAGE,
+
+ or NIL if SYMBOL is not _accessible_ in PACKAGE.
+
+
+Be aware not to get confused with :INTERNAL and how \"internal
+symbols\" are defined in the spec; there is a slight mismatch of
+definition with the Spec and what's commonly meant when talking
+about internal symbols most times. As the spec says:
+
+ In a package P, a symbol S is
+
+ _accessible_ if S is either _present_ in P itself or was
+ inherited from another package Q (which implies
+ that S is _external_ in Q.)
+
+ You can check that with: (AND (SYMBOL-STATUS S P) T)
+
+
+ _present_ if either P is the /home package/ of S or S has been
+ imported into P or exported from P by IMPORT, or
+ EXPORT respectively.
+
+ Or more simply, if S is not _inherited_.
+
+ You can check that with: (LET ((STATUS (SYMBOL-STATUS S P)))
+ (AND STATUS
+ (NOT (EQ STATUS :INHERITED))))
+
+
+ _external_ if S is going to be inherited into any package that
+ /uses/ P by means of USE-PACKAGE, MAKE-PACKAGE, or
+ DEFPACKAGE.
+
+ Note that _external_ implies _present_, since to
+ make a symbol _external_, you'd have to use EXPORT
+ which will automatically make the symbol _present_.
+
+ You can check that with: (EQ (SYMBOL-STATUS S P) :EXTERNAL)
+
+
+ _internal_ if S is _accessible_ but not _external_.
+
+ You can check that with: (LET ((STATUS (SYMBOL-STATUS S P)))
+ (AND STATUS
+ (NOT (EQ STATUS :EXTERNAL))))
+
+
+ Notice that this is *different* to
+ (EQ (SYMBOL-STATUS S P) :INTERNAL)
+ because what the spec considers _internal_ is split up into two
+ explicit pieces: :INTERNAL, and :INHERITED; just as, for instance,
+ CL:FIND-SYMBOL does.
+
+ The rationale is that most times when you speak about \"internal\"
+ symbols, you're actually not including the symbols inherited
+ from other packages, but only about the symbols directly specific
+ to the package in question.
+"
+ (when package ; may be NIL when symbol is completely uninterned.
+ (check-type symbol symbol) (check-type package package)
+ (multiple-value-bind (present-symbol status)
+ (find-symbol (symbol-name symbol) package)
+ (and (eq symbol present-symbol) status))))
+
+(defun symbol-external-p (symbol &optional (package (symbol-package symbol)))
+ "True if SYMBOL is external in PACKAGE.
+If PACKAGE is not specified, the home package of SYMBOL is used."
+ (eq (symbol-status symbol package) :external))
+
+
+(defun classify-symbol (symbol)
+ "Returns a list of classifiers that classify SYMBOL according
+to its underneath objects (e.g. :BOUNDP if SYMBOL constitutes a
+special variable.) The list may contain the following classification
+keywords: :BOUNDP, :FBOUNDP, :GENERIC-FUNCTION, :CLASS, :MACRO,
+:SPECIAL-OPERATOR, and/or :PACKAGE"
+ (check-type symbol symbol)
+ (let (result)
+ (when (boundp symbol) (push :boundp result))
+ (when (fboundp symbol) (push :fboundp result))
+ (when (find-class symbol nil) (push :class result))
+ (when (macro-function symbol) (push :macro result))
+ (when (special-operator-p symbol) (push :special-operator result))
+ (when (find-package symbol) (push :package result))
+ (when (typep (ignore-errors (fdefinition symbol))
+ 'generic-function)
+ (push :generic-function result))
+ result))
+
+(defun symbol-classification->string (flags)
+ (format nil "~A~A~A~A~A~A~A"
+ (if (member :boundp flags) "b" "-")
+ (if (member :fboundp flags) "f" "-")
+ (if (member :generic-function flags) "g" "-")
+ (if (member :class flags) "c" "-")
+ (if (member :macro flags) "m" "-")
+ (if (member :special-operator flags) "s" "-")
+ (if (member :package flags) "p" "-")))
+
+
+;;;; TCP Server
+
+(defvar *use-dedicated-output-stream* nil
+ "When T swank will attempt to create a second connection to
+ Emacs which is used just to send output.")
+
+(defvar *dedicated-output-stream-port* 0
+ "Which port we should use for the dedicated output stream.")
+
+(defvar *communication-style* (preferred-communication-style))
+
+(defvar *dont-close* nil
+ "Default value of :dont-close argument to start-server and
+ create-server.")
+
+(defvar *dedicated-output-stream-buffering*
+ (if (eq *communication-style* :spawn) :full :none)
+ "The buffering scheme that should be used for the output stream.
+Valid values are :none, :line, and :full.")
+
+(defvar *coding-system* "iso-latin-1-unix")
+
+(defun start-server (port-file &key (style *communication-style*)
+ (dont-close *dont-close*)
+ (coding-system *coding-system*))
+ "Start the server and write the listen port number to PORT-FILE.
+This is the entry point for Emacs."
+ (flet ((start-server-aux ()
+ (setup-server 0 (lambda (port)
+ (announce-server-port port-file port))
+ style dont-close
+ (find-external-format-or-lose coding-system))))
+ (if (eq style :spawn)
+ (initialize-multiprocessing #'start-server-aux)
+ (start-server-aux))))
+
+(defun create-server (&key (port default-server-port)
+ (style *communication-style*)
+ (dont-close *dont-close*)
+ (coding-system *coding-system*))
+ "Start a SWANK server on PORT running in STYLE.
+If DONT-CLOSE is true then the listen socket will accept multiple
+connections, otherwise it will be closed after the first."
+ (setup-server port #'simple-announce-function style dont-close
+ (find-external-format-or-lose coding-system)))
+
+(defun find-external-format-or-lose (coding-system)
+ (or (find-external-format coding-system)
+ (error "Unsupported coding system: ~s" coding-system)))
+
+(defparameter *loopback-interface* "127.0.0.1")
+
+(defun setup-server (port announce-fn style dont-close external-format)
+ (declare (type function announce-fn))
+ (let* ((socket (create-socket *loopback-interface* port))
+ (port (local-port socket)))
+ (funcall announce-fn port)
+ (flet ((serve ()
+ (serve-connection socket style dont-close external-format)))
+ (ecase style
+ (:spawn
+ (spawn (lambda () (loop do (ignore-errors (serve)) while dont-close))
+ :name "Swank"))
+ ((:fd-handler :sigio)
+ (add-fd-handler socket (lambda () (serve))))
+ ((nil) (loop do (serve) while dont-close)))
+ port)))
+
+(defun serve-connection (socket style dont-close external-format)
+ (let ((closed-socket-p nil))
+ (unwind-protect
+ (let ((client (accept-authenticated-connection
+ socket :external-format external-format)))
+ (unless dont-close
+ (close-socket socket)
+ (setf closed-socket-p t))
+ (let ((connection (create-connection client style)))
+ (run-hook *new-connection-hook* connection)
+ (push connection *connections*)
+ (serve-requests connection)))
+ (unless (or dont-close closed-socket-p)
+ (close-socket socket)))))
+
+(defun accept-authenticated-connection (&rest args)
+ (let ((new (apply #'accept-connection args))
+ (success nil))
+ (unwind-protect
+ (let ((secret (slime-secret)))
+ (when secret
+ (set-stream-timeout new 20)
+ (let ((first-val (decode-message new)))
+ (unless (and (stringp first-val) (string= first-val secret))
+ (error "Incoming connection doesn't know the password."))))
+ (set-stream-timeout new nil)
+ (setf success t))
+ (unless success
+ (close new :abort t)))
+ new))
+
+(defun slime-secret ()
+ "Finds the magic secret from the user's home directory. Returns nil
+if the file doesn't exist; otherwise the first line of the file."
+ (with-open-file (in
+ (merge-pathnames (user-homedir-pathname) #p".slime-secret")
+ :if-does-not-exist nil)
+ (and in (read-line in nil ""))))
+
+(defun serve-requests (connection)
+ "Read and process all requests on connections."
+ (funcall (connection.serve-requests connection) connection))
+
+(defun announce-server-port (file port)
+ (with-open-file (s file
+ :direction :output
+ :if-exists :error
+ :if-does-not-exist :create)
+ (format s "~S~%" port))
+ (simple-announce-function port))
+
+(defun simple-announce-function (port)
+ (when *swank-debug-p*
+ (format *log-output* "~&;; Swank started at port: ~D.~%" port)
+ (force-output *log-output*)))
+
+(defun open-streams (connection)
+ "Return the 5 streams for IO redirection:
+DEDICATED-OUTPUT INPUT OUTPUT IO REPL-RESULTS"
+ (multiple-value-bind (output-fn dedicated-output)
+ (make-output-function connection)
+ (let ((input-fn
+ (lambda ()
+ (with-connection (connection)
+ (with-simple-restart (abort-read
+ "Abort reading input from Emacs.")
+ (read-user-input-from-emacs))))))
+ (multiple-value-bind (in out) (make-fn-streams input-fn output-fn)
+ (let ((out (or dedicated-output out)))
+ (let ((io (make-two-way-stream in out)))
+ (mapc #'make-stream-interactive (list in out io))
+ (let ((repl-results
+ (make-output-stream-for-target connection :repl-result)))
+ (values dedicated-output in out io repl-results))))))))
+
+(defun make-output-function (connection)
+ "Create function to send user output to Emacs.
+This function may open a dedicated socket to send output. It
+returns two values: the output function, and the dedicated
+stream (or NIL if none was created)."
+ (if *use-dedicated-output-stream*
+ (let ((stream (open-dedicated-output-stream
+ (connection.socket-io connection))))
+ (values (lambda (string)
+ (write-string string stream)
+ (force-output stream))
+ stream))
+ (values (lambda (string)
+ (with-connection (connection)
+ (with-simple-restart
+ (abort "Abort sending output to Emacs.")
+ (send-to-emacs `(:write-string ,string)))))
+ nil)))
+
+(defun make-output-function-for-target (connection target)
+ "Create a function to send user output to a specific TARGET in Emacs."
+ (lambda (string)
+ (with-connection (connection)
+ (with-simple-restart
+ (abort "Abort sending output to Emacs.")
+ (send-to-emacs `(:write-string ,string ,target))))))
+
+(defun make-output-stream-for-target (connection target)
+ "Create a stream that sends output to a specific TARGET in Emacs."
+ (nth-value 1 (make-fn-streams
+ (lambda ()
+ (error "Should never be called"))
+ (make-output-function-for-target connection target))))
+
+(defun open-dedicated-output-stream (socket-io)
+ "Open a dedicated output connection to the Emacs on SOCKET-IO.
+Return an output stream suitable for writing program output.
+
+This is an optimized way for Lisp to deliver output to Emacs."
+ (let ((socket (create-socket *loopback-interface*
+ *dedicated-output-stream-port*)))
+ (unwind-protect
+ (let ((port (local-port socket)))
+ (encode-message `(:open-dedicated-output-stream ,port) socket-io)
+ (let ((dedicated (accept-authenticated-connection
+ socket
+ :external-format
+ (or (ignore-errors
+ (stream-external-format socket-io))
+ :default)
+ :buffering *dedicated-output-stream-buffering*
+ :timeout 30)))
+ (close-socket socket)
+ (setf socket nil)
+ dedicated))
+ (when socket
+ (close-socket socket)))))
+
+(defvar *sldb-quit-restart* 'abort
+ "What restart should swank attempt to invoke when the user sldb-quits.")
+
+(defun handle-request (connection)
+ "Read and process one request. The processing is done in the extent
+of the toplevel restart."
+ (assert (null *swank-state-stack*))
+ (let ((*swank-state-stack* '(:handle-request)))
+ (with-connection (connection)
+ (with-simple-restart (abort "Return to SLIME's top level.")
+ (let ((*sldb-quit-restart* (find-restart 'abort)))
+ (read-from-emacs))))))
+
+(defun current-socket-io ()
+ (connection.socket-io *emacs-connection*))
+
+(defun close-connection (c &optional condition backtrace)
+ (format *log-output* "~&;; swank:close-connection: ~A~%" condition)
+ (let ((cleanup (connection.cleanup c)))
+ (when cleanup
+ (funcall cleanup c)))
+ (close (connection.socket-io c))
+ (when (connection.dedicated-output c)
+ (close (connection.dedicated-output c)))
+ (setf *connections* (remove c *connections*))
+ (run-hook *connection-closed-hook* c)
+ (when (and condition (not (typep condition 'end-of-file)))
+ (finish-output *log-output*)
+ (format *log-output* "~&;; Event history start:~%")
+ (dump-event-history *log-output*)
+ (format *log-output* ";; Event history end.~%~
+ ;; Backtrace:~%~{~A~%~}~
+ ;; Connection to Emacs lost. [~%~
+ ;; condition: ~A~%~
+ ;; type: ~S~%~
+ ;; encoding: ~A style: ~S dedicated: ~S]~%"
+ backtrace
+ (escape-non-ascii (safe-condition-message condition) )
+ (type-of condition)
+ (ignore-errors (stream-external-format (connection.socket-io c)))
+ (connection.communication-style c)
+ *use-dedicated-output-stream*)
+ (finish-output *log-output*)))
+
+(defvar *debug-on-swank-error* nil
+ "When non-nil internal swank errors will drop to a
+ debugger (not an sldb buffer). Do not set this to T unless you
+ want to debug swank internals.")
+
+(defmacro with-reader-error-handler ((connection) &body body)
+ (let ((con (gensym))
+ (blck (gensym)))
+ `(let ((,con ,connection))
+ (block ,blck
+ (handler-bind ((swank-error
+ (lambda (e)
+ (if *debug-on-swank-error*
+ (invoke-debugger e)
+ (return-from ,blck
+ (close-connection
+ ,con
+ (swank-error.condition e)
+ (swank-error.backtrace e)))))))
+ (progn ,@body))))))
+
+(defslimefun simple-break ()
+ (with-simple-restart (continue "Continue from interrupt.")
+ (call-with-debugger-hook
+ #'swank-debugger-hook
+ (lambda ()
+ (invoke-debugger
+ (make-condition 'simple-error
+ :format-control "Interrupt from Emacs")))))
+ nil)
+
+;;;;;; Thread based communication
+
+(defvar *active-threads* '())
+
+(defun read-loop (control-thread input-stream connection)
+ (with-reader-error-handler (connection)
+ (loop (send control-thread (decode-message input-stream)))))
+
+(defun dispatch-loop (socket-io connection)
+ (let ((*emacs-connection* connection))
+ (handler-bind ((error (lambda (e)
+ (if *debug-on-swank-error*
+ (invoke-debugger e)
+ (return-from dispatch-loop
+ (close-connection connection e))))))
+ (loop (dispatch-event (receive) socket-io)))))
+
+(defun repl-thread (connection)
+ (let ((thread (connection.repl-thread connection)))
+ (when (not thread)
+ (log-event "ERROR: repl-thread is nil"))
+ (assert thread)
+ (cond ((thread-alive-p thread)
+ thread)
+ (t
+ (setf (connection.repl-thread connection)
+ (spawn-repl-thread connection "new-repl-thread"))))))
+
+(defun find-worker-thread (id)
+ (etypecase id
+ ((member t)
+ (car *active-threads*))
+ ((member :repl-thread)
+ (repl-thread *emacs-connection*))
+ (fixnum
+ (find-thread id))))
+
+(defun interrupt-worker-thread (id)
+ (let ((thread (or (find-worker-thread id)
+ (repl-thread *emacs-connection*))))
+ (interrupt-thread thread #'simple-break)))
+
+(defun thread-for-evaluation (id)
+ "Find or create a thread to evaluate the next request."
+ (let ((c *emacs-connection*))
+ (etypecase id
+ ((member t)
+ (spawn-worker-thread c))
+ ((member :repl-thread)
+ (repl-thread c))
+ (fixnum
+ (find-thread id)))))
+
+(defun spawn-worker-thread (connection)
+ (spawn (lambda ()
+ (with-bindings *default-worker-thread-bindings*
+ (handle-request connection)))
+ :name "worker"))
+
+(defun spawn-repl-thread (connection name)
+ (spawn (lambda ()
+ (with-bindings *default-worker-thread-bindings*
+ (repl-loop connection)))
+ :name name))
+
+(defun dispatch-event (event socket-io)
+ "Handle an event triggered either by Emacs or within Lisp."
+ (log-event "DISPATCHING: ~S~%" event)
+ (destructure-case event
+ ((:emacs-rex form package thread-id id)
+ (let ((thread (thread-for-evaluation thread-id)))
+ (push thread *active-threads*)
+ (send thread `(eval-for-emacs ,form ,package ,id))))
+ ((:return thread &rest args)
+ (let ((tail (member thread *active-threads*)))
+ (setq *active-threads* (nconc (ldiff *active-threads* tail)
+ (cdr tail))))
+ (encode-message `(:return ,@args) socket-io))
+ ((:emacs-interrupt thread-id)
+ (interrupt-worker-thread thread-id))
+ (((:debug :debug-condition :debug-activate :debug-return)
+ thread &rest args)
+ (encode-message `(,(car event) ,(thread-id thread) ,@args) socket-io))
+ ((:read-string thread &rest args)
+ (encode-message `(:read-string ,(thread-id thread) ,@args) socket-io))
+ ((:y-or-n-p thread &rest args)
+ (encode-message `(:y-or-n-p ,(thread-id thread) ,@args) socket-io))
+ ((:read-aborted thread &rest args)
+ (encode-message `(:read-aborted ,(thread-id thread) ,@args) socket-io))
+ ((:emacs-return-string thread-id tag string)
+ (send (find-thread thread-id) `(take-input ,tag ,string)))
+ ((:eval thread &rest args)
+ (encode-message `(:eval ,(thread-id thread) ,@args) socket-io))
+ ((:emacs-return thread-id tag value)
+ (send (find-thread thread-id) `(take-input ,tag ,value)))
+ (((:write-string :presentation-start :presentation-end
+ :new-package :new-features :ed :%apply :indentation-update
+ :eval-no-wait :background-message :inspect)
+ &rest _)
+ (declare (ignore _))
+ (encode-message event socket-io))))
+
+(defun spawn-threads-for-connection (connection)
+ (macrolet ((without-debugger-hook (&body body)
+ `(call-with-debugger-hook nil (lambda () ,@body))))
+ (let* ((socket-io (connection.socket-io connection))
+ (control-thread (spawn (lambda ()
+ (without-debugger-hook
+ (dispatch-loop socket-io connection)))
+ :name "control-thread")))
+ (setf (connection.control-thread connection) control-thread)
+ (let ((reader-thread (spawn (lambda ()
+ (let ((go (receive)))
+ (assert (eq go 'accept-input)))
+ (without-debugger-hook
+ (read-loop control-thread socket-io
+ connection)))
+ :name "reader-thread"))
+ (repl-thread (spawn-repl-thread connection "repl-thread")))
+ (setf (connection.repl-thread connection) repl-thread)
+ (setf (connection.reader-thread connection) reader-thread)
+ (send reader-thread 'accept-input)
+ connection))))
+
+(defun cleanup-connection-threads (connection)
+ (let ((threads (list (connection.repl-thread connection)
+ (connection.reader-thread connection)
+ (connection.control-thread connection))))
+ (dolist (thread threads)
+ (when (and thread
+ (thread-alive-p thread)
+ (not (equal (current-thread) thread)))
+ (kill-thread thread)))))
+
+(defun repl-loop (connection)
+ (loop (handle-request connection)))
+
+(defun process-available-input (stream fn)
+ (loop while (input-available-p stream)
+ do (funcall fn)))
+
+(defun input-available-p (stream)
+ ;; return true iff we can read from STREAM without waiting or if we
+ ;; hit EOF
+ (let ((c (read-char-no-hang stream nil :eof)))
+ (cond ((not c) nil)
+ ((eq c :eof) t)
+ (t
+ (unread-char c stream)
+ t))))
+
+;;;;;; Signal driven IO
+
+(defun install-sigio-handler (connection)
+ (let ((client (connection.socket-io connection)))
+ (flet ((handler ()
+ (cond ((null *swank-state-stack*)
+ (with-reader-error-handler (connection)
+ (process-available-input
+ client (lambda () (handle-request connection)))))
+ ((eq (car *swank-state-stack*) :read-next-form))
+ (t (process-available-input client #'read-from-emacs)))))
+ (add-sigio-handler client #'handler)
+ (handler))))
+
+(defun deinstall-sigio-handler (connection)
+ (remove-sigio-handlers (connection.socket-io connection)))
+
+;;;;;; SERVE-EVENT based IO
+
+(defun install-fd-handler (connection)
+ (let ((client (connection.socket-io connection)))
+ (flet ((handler ()
+ (cond ((null *swank-state-stack*)
+ (with-reader-error-handler (connection)
+ (process-available-input
+ client (lambda () (handle-request connection)))))
+ ((eq (car *swank-state-stack*) :read-next-form))
+ (t
+ (process-available-input client #'read-from-emacs)))))
+ ;;;; handle sigint
+ ;;(install-debugger-globally
+ ;; (lambda (c h)
+ ;; (with-reader-error-handler (connection)
+ ;; (block debugger
+ ;; (with-connection (connection)
+ ;; (swank-debugger-hook c h)
+ ;; (return-from debugger))
+ ;; (abort)))))
+ (add-fd-handler client #'handler)
+ (handler))))
+
+(defun deinstall-fd-handler (connection)
+ (remove-fd-handlers (connection.socket-io connection)))
+
+;;;;;; Simple sequential IO
+
+(defun simple-serve-requests (connection)
+ (unwind-protect
+ (with-simple-restart (close-connection "Close SLIME connection")
+ (with-reader-error-handler (connection)
+ (loop
+ (handle-request connection))))
+ (close-connection connection)))
+
+(defun read-from-socket-io ()
+ (let ((event (decode-message (current-socket-io))))
+ (log-event "DISPATCHING: ~S~%" event)
+ (destructure-case event
+ ((:emacs-rex form package thread id)
+ (declare (ignore thread))
+ `(eval-for-emacs ,form ,package ,id))
+ ((:emacs-interrupt thread)
+ (declare (ignore thread))
+ '(simple-break))
+ ((:emacs-return-string thread tag string)
+ (declare (ignore thread))
+ `(take-input ,tag ,string))
+ ((:emacs-return thread tag value)
+ (declare (ignore thread))
+ `(take-input ,tag ,value)))))
+
+(defun send-to-socket-io (event)
+ (log-event "DISPATCHING: ~S~%" event)
+ (flet ((send (o)
+ (without-interrupts
+ (encode-message o (current-socket-io)))))
+ (destructure-case event
+ (((:debug-activate :debug :debug-return :read-string :read-aborted
+ :y-or-n-p :eval)
+ thread &rest args)
+ (declare (ignore thread))
+ (send `(,(car event) 0 ,@args)))
+ ((:return thread &rest args)
+ (declare (ignore thread))
+ (send `(:return ,@args)))
+ (((:write-string :new-package :new-features :debug-condition
+ :presentation-start :presentation-end
+ :indentation-update :ed :%apply :eval-no-wait
+ :background-message :inspect)
+ &rest _)
+ (declare (ignore _))
+ (send event)))))
+
+(defun initialize-streams-for-connection (connection)
+ (multiple-value-bind (dedicated in out io repl-results)
+ (open-streams connection)
+ (setf (connection.dedicated-output connection) dedicated
+ (connection.user-io connection) io
+ (connection.user-output connection) out
+ (connection.user-input connection) in
+ (connection.repl-results connection) repl-results)
+ connection))
+
+(defun create-connection (socket-io style)
+ (let ((success nil))
+ (unwind-protect
+ (let ((c (ecase style
+ (:spawn
+ (make-connection :socket-io socket-io
+ :read #'read-from-control-thread
+ :send #'send-to-control-thread
+ :serve-requests #'spawn-threads-for-connection
+ :cleanup #'cleanup-connection-threads))
+ (:sigio
+ (make-connection :socket-io socket-io
+ :read #'read-from-socket-io
+ :send #'send-to-socket-io
+ :serve-requests #'install-sigio-handler
+ :cleanup #'deinstall-sigio-handler))
+ (:fd-handler
+ (make-connection :socket-io socket-io
+ :read #'read-from-socket-io
+ :send #'send-to-socket-io
+ :serve-requests #'install-fd-handler
+ :cleanup #'deinstall-fd-handler))
+ ((nil)
+ (make-connection :socket-io socket-io
+ :read #'read-from-socket-io
+ :send #'send-to-socket-io
+ :serve-requests #'simple-serve-requests)))))
+ (setf (connection.communication-style c) style)
+ (initialize-streams-for-connection c)
+ (setf success t)
+ c)
+ (unless success
+ (close socket-io :abort t)))))
+
+
+;;;; IO to Emacs
+;;;
+;;; This code handles redirection of the standard I/O streams
+;;; (`*standard-output*', etc) into Emacs. The `connection' structure
+;;; contains the appropriate streams, so all we have to do is make the
+;;; right bindings.
+
+;;;;; Global I/O redirection framework
+;;;
+;;; Optionally, the top-level global bindings of the standard streams
+;;; can be assigned to be redirected to Emacs. When Emacs connects we
+;;; redirect the streams into the connection, and they keep going into
+;;; that connection even if more are established. If the connection
+;;; handling the streams closes then another is chosen, or if there
+;;; are no connections then we revert to the original (real) streams.
+;;;
+;;; It is slightly tricky to assign the global values of standard
+;;; streams because they are often shadowed by dynamic bindings. We
+;;; solve this problem by introducing an extra indirection via synonym
+;;; streams, so that *STANDARD-INPUT* is a synonym stream to
+;;; *CURRENT-STANDARD-INPUT*, etc. We never shadow the "current"
+;;; variables, so they can always be assigned to affect a global
+;;; change.
+
+(defvar *globally-redirect-io* nil
+ "When non-nil globally redirect all standard streams to Emacs.")
+
+;;;;; Global redirection setup
+
+(defvar *saved-global-streams* '()
+ "A plist to save and restore redirected stream objects.
+E.g. the value for '*standard-output* holds the stream object
+for *standard-output* before we install our redirection.")
+
+(defun setup-stream-indirection (stream-var &optional stream)
+ "Setup redirection scaffolding for a global stream variable.
+Supposing (for example) STREAM-VAR is *STANDARD-INPUT*, this macro:
+
+1. Saves the value of *STANDARD-INPUT* in `*SAVED-GLOBAL-STREAMS*'.
+
+2. Creates *CURRENT-STANDARD-INPUT*, initially with the same value as
+*STANDARD-INPUT*.
+
+3. Assigns *STANDARD-INPUT* to a synonym stream pointing to
+*CURRENT-STANDARD-INPUT*.
+
+This has the effect of making *CURRENT-STANDARD-INPUT* contain the
+effective global value for *STANDARD-INPUT*. This way we can assign
+the effective global value even when *STANDARD-INPUT* is shadowed by a
+dynamic binding."
+ (let ((current-stream-var (prefixed-var '#:current stream-var))
+ (stream (or stream (symbol-value stream-var))))
+ ;; Save the real stream value for the future.
+ (setf (getf *saved-global-streams* stream-var) stream)
+ ;; Define a new variable for the effective stream.
+ ;; This can be reassigned.
+ (proclaim `(special ,current-stream-var))
+ (set current-stream-var stream)
+ ;; Assign the real binding as a synonym for the current one.
+ (set stream-var (make-synonym-stream current-stream-var))))
+
+(defun prefixed-var (prefix variable-symbol)
+ "(PREFIXED-VAR \"FOO\" '*BAR*) => SWANK::*FOO-BAR*"
+ (let ((basename (subseq (symbol-name variable-symbol) 1)))
+ (intern (format nil "*~A-~A" (string prefix) basename) :swank)))
+
+(defvar *standard-output-streams*
+ '(*standard-output* *error-output* *trace-output*)
+ "The symbols naming standard output streams.")
+
+(defvar *standard-input-streams*
+ '(*standard-input*)
+ "The symbols naming standard input streams.")
+
+(defvar *standard-io-streams*
+ '(*debug-io* *query-io* *terminal-io*)
+ "The symbols naming standard io streams.")
+
+(defun init-global-stream-redirection ()
+ (when *globally-redirect-io*
+ (mapc #'setup-stream-indirection
+ (append *standard-output-streams*
+ *standard-input-streams*
+ *standard-io-streams*))))
+
+(add-hook *after-init-hook* 'init-global-stream-redirection)
+
+(defun globally-redirect-io-to-connection (connection)
+ "Set the standard I/O streams to redirect to CONNECTION.
+Assigns *CURRENT-<STREAM>* for all standard streams."
+ (dolist (o *standard-output-streams*)
+ (set (prefixed-var '#:current o)
+ (connection.user-output connection)))
+ ;; FIXME: If we redirect standard input to Emacs then we get the
+ ;; regular Lisp top-level trying to read from our REPL.
+ ;;
+ ;; Perhaps the ideal would be for the real top-level to run in a
+ ;; thread with local bindings for all the standard streams. Failing
+ ;; that we probably would like to inhibit it from reading while
+ ;; Emacs is connected.
+ ;;
+ ;; Meanwhile we just leave *standard-input* alone.
+ #+NIL
+ (dolist (i *standard-input-streams*)
+ (set (prefixed-var '#:current i)
+ (connection.user-input connection)))
+ (dolist (io *standard-io-streams*)
+ (set (prefixed-var '#:current io)
+ (connection.user-io connection))))
+
+(defun revert-global-io-redirection ()
+ "Set *CURRENT-<STREAM>* to *REAL-<STREAM>* for all standard streams."
+ (dolist (stream-var (append *standard-output-streams*
+ *standard-input-streams*
+ *standard-io-streams*))
+ (set (prefixed-var '#:current stream-var)
+ (getf *saved-global-streams* stream-var))))
+
+;;;;; Global redirection hooks
+
+(defvar *global-stdio-connection* nil
+ "The connection to which standard I/O streams are globally redirected.
+NIL if streams are not globally redirected.")
+
+(defun maybe-redirect-global-io (connection)
+ "Consider globally redirecting to a newly-established CONNECTION."
+ (when (and *globally-redirect-io* (null *global-stdio-connection*))
+ (setq *global-stdio-connection* connection)
+ (globally-redirect-io-to-connection connection)))
+
+(defun update-redirection-after-close (closed-connection)
+ "Update redirection after a connection closes."
+ (check-type closed-connection connection)
+ (when (eq *global-stdio-connection* closed-connection)
+ (if (and (default-connection) *globally-redirect-io*)
+ ;; Redirect to another connection.
+ (globally-redirect-io-to-connection (default-connection))
+ ;; No more connections, revert to the real streams.
+ (progn (revert-global-io-redirection)
+ (setq *global-stdio-connection* nil)))))
+
+(add-hook *new-connection-hook* 'maybe-redirect-global-io)
+(add-hook *connection-closed-hook* 'update-redirection-after-close)
+
+;;;;; Redirection during requests
+;;;
+;;; We always redirect the standard streams to Emacs while evaluating
+;;; an RPC. This is done with simple dynamic bindings.
+
+(defun call-with-redirected-io (connection function)
+ "Call FUNCTION with I/O streams redirected via CONNECTION."
+ (declare (type function function))
+ (let* ((io (connection.user-io connection))
+ (in (connection.user-input connection))
+ (out (connection.user-output connection))
+ (trace (or (connection.trace-output connection) out))
+ (*standard-output* out)
+ (*error-output* out)
+ (*trace-output* trace)
+ (*debug-io* io)
+ (*query-io* io)
+ (*standard-input* in)
+ (*terminal-io* io))
+ (funcall function)))
+
+(defun read-from-emacs ()
+ "Read and process a request from Emacs."
+ (apply #'funcall (funcall (connection.read *emacs-connection*))))
+
+(defun read-from-control-thread ()
+ (receive))
+
+(defun decode-message (stream)
+ "Read an S-expression from STREAM using the SLIME protocol."
+ (let ((*swank-state-stack* (cons :read-next-form *swank-state-stack*)))
+ (handler-bind ((error (lambda (c) (error (make-swank-error c)))))
+ (let* ((length (decode-message-length stream))
+ (string (make-string length))
+ (pos (read-sequence string stream)))
+ (assert (= pos length) ()
+ "Short read: length=~D pos=~D" length pos)
+ (log-event "READ: ~S~%" string)
+ (read-form string)))))
+
+(defun decode-message-length (stream)
+ (let ((buffer (make-string 6)))
+ (dotimes (i 6)
+ (setf (aref buffer i) (read-char stream)))
+ (parse-integer buffer :radix #x10)))
+
+(defun read-form (string)
+ (with-standard-io-syntax
+ (let ((*package* *swank-io-package*))
+ (read-from-string string))))
+
+(defvar *slime-features* nil
+ "The feature list that has been sent to Emacs.")
+
+(defun send-to-emacs (object)
+ "Send OBJECT to Emacs."
+ (funcall (connection.send *emacs-connection*) object))
+
+(defun send-oob-to-emacs (object)
+ (send-to-emacs object))
+
+(defun send-to-control-thread (object)
+ (send (connection.control-thread *emacs-connection*) object))
+
+(defun encode-message (message stream)
+ (let* ((string (prin1-to-string-for-emacs message))
+ (length (length string)))
+ (log-event "WRITE: ~A~%" string)
+ (let ((*print-pretty* nil))
+ (format stream "~6,'0x" length))
+ (write-string string stream)
+ ;;(terpri stream)
+ (finish-output stream)))
+
+(defun prin1-to-string-for-emacs (object)
+ (with-standard-io-syntax
+ (let ((*print-case* :downcase)
+ (*print-readably* nil)
+ (*print-pretty* nil)
+ (*package* *swank-io-package*))
+ (prin1-to-string object))))
+
+(defun force-user-output ()
+ (force-output (connection.user-io *emacs-connection*))
+ (finish-output (connection.user-output *emacs-connection*)))
+
+(defun clear-user-input ()
+ (clear-input (connection.user-input *emacs-connection*)))
+
+(defvar *read-input-catch-tag* 0)
+
+(defun intern-catch-tag (tag)
+ ;; fixnums aren't eq in ABCL, so we use intern to create tags
+ (intern (format nil "~D" tag) :swank))
+
+(defun read-user-input-from-emacs ()
+ (let ((tag (incf *read-input-catch-tag*)))
+ (force-output)
+ (send-to-emacs `(:read-string ,(current-thread) ,tag))
+ (let ((ok nil))
+ (unwind-protect
+ (prog1 (catch (intern-catch-tag tag)
+ (loop (read-from-emacs)))
+ (setq ok t))
+ (unless ok
+ (send-to-emacs `(:read-aborted ,(current-thread) ,tag)))))))
+
+(defun y-or-n-p-in-emacs (format-string &rest arguments)
+ "Like y-or-n-p, but ask in the Emacs minibuffer."
+ (let ((tag (incf *read-input-catch-tag*))
+ (question (apply #'format nil format-string arguments)))
+ (force-output)
+ (send-to-emacs `(:y-or-n-p ,(current-thread) ,tag ,question))
+ (catch (intern-catch-tag tag)
+ (loop (read-from-emacs)))))
+
+(defslimefun take-input (tag input)
+ "Return the string INPUT to the continuation TAG."
+ (throw (intern-catch-tag tag) input))
+
+(defun process-form-for-emacs (form)
+ "Returns a string which emacs will read as equivalent to
+FORM. FORM can contain lists, strings, characters, symbols and
+numbers.
+
+Characters are converted emacs' ?<char> notaion, strings are left
+as they are (except for espacing any nested \" chars, numbers are
+printed in base 10 and symbols are printed as their symbol-name
+converted to lower case."
+ (etypecase form
+ (string (format nil "~S" form))
+ (cons (format nil "(~A . ~A)"
+ (process-form-for-emacs (car form))
+ (process-form-for-emacs (cdr form))))
+ (character (format nil "?~C" form))
+ (symbol (concatenate 'string (when (eq (symbol-package form)
+ #.(find-package "KEYWORD"))
+ ":")
+ (string-downcase (symbol-name form))))
+ (number (let ((*print-base* 10))
+ (princ-to-string form)))))
+
+(defun eval-in-emacs (form &optional nowait)
+ "Eval FORM in Emacs."
+ (cond (nowait
+ (send-to-emacs `(:eval-no-wait ,(process-form-for-emacs form))))
+ (t
+ (force-output)
+ (let* ((tag (incf *read-input-catch-tag*))
+ (value (catch (intern-catch-tag tag)
+ (send-to-emacs
+ `(:eval ,(current-thread) ,tag
+ ,(process-form-for-emacs form)))
+ (loop (read-from-emacs)))))
+ (destructure-case value
+ ((:ok value) value)
+ ((:abort) (abort)))))))
+
+(defvar *swank-wire-protocol-version* nil
+ "The version of the swank/slime communication protocol.")
+
+(defslimefun connection-info ()
+ "Return a key-value list of the form:
+\(&key PID STYLE LISP-IMPLEMENTATION MACHINE FEATURES PACKAGE VERSION)
+PID: is the process-id of Lisp process (or nil, depending on the STYLE)
+STYLE: the communication style
+LISP-IMPLEMENTATION: a list (&key TYPE NAME VERSION)
+FEATURES: a list of keywords
+PACKAGE: a list (&key NAME PROMPT)
+VERSION: the protocol version"
+ (setq *slime-features* *features*)
+ `(:pid ,(getpid) :style ,(connection.communication-style *emacs-connection*)
+ :lisp-implementation (:type ,(lisp-implementation-type)
+ :name ,(lisp-implementation-type-name)
+ :version ,(lisp-implementation-version))
+ :machine (:instance ,(machine-instance)
+ :type ,(machine-type)
+ :version ,(machine-version))
+ :features ,(features-for-emacs)
+ :package (:name ,(package-name *package*)
+ :prompt ,(package-string-for-prompt *package*))
+ :version ,*swank-wire-protocol-version*))
+
+(defslimefun io-speed-test (&optional (n 5000) (m 1))
+ (let* ((s *standard-output*)
+ (*trace-output* (make-broadcast-stream s *log-output*)))
+ (time (progn
+ (dotimes (i n)
+ (format s "~D abcdefghijklm~%" i)
+ (when (zerop (mod n m))
+ (force-output s)))
+ (finish-output s)
+ (when *emacs-connection*
+ (eval-in-emacs '(message "done.")))))
+ (terpri *trace-output*)
+ (finish-output *trace-output*)
+ nil))
+
+
+;;;; Reading and printing
+
+(defmacro define-special (name doc)
+ "Define a special variable NAME with doc string DOC.
+This is like defvar, but NAME will not be initialized."
+ `(progn
+ (defvar ,name)
+ (setf (documentation ',name 'variable) ,doc)))
+
+(define-special *buffer-package*
+ "Package corresponding to slime-buffer-package.
+
+EVAL-FOR-EMACS binds *buffer-package*. Strings originating from a slime
+buffer are best read in this package. See also FROM-STRING and TO-STRING.")
+
+(define-special *buffer-readtable*
+ "Readtable associated with the current buffer")
+
+(defmacro with-buffer-syntax ((&rest _) &body body)
+ "Execute BODY with appropriate *package* and *readtable* bindings.
+
+This should be used for code that is conceptionally executed in an
+Emacs buffer."
+ (destructuring-bind () _
+ `(call-with-buffer-syntax (lambda () ,@body))))
+
+(defun call-with-buffer-syntax (fun)
+ (let ((*package* *buffer-package*))
+ ;; Don't shadow *readtable* unnecessarily because that prevents
+ ;; the user from assigning to it.
+ (if (eq *readtable* *buffer-readtable*)
+ (call-with-syntax-hooks fun)
+ (let ((*readtable* *buffer-readtable*))
+ (call-with-syntax-hooks fun)))))
+
+(defun to-string (object)
+ "Write OBJECT in the *BUFFER-PACKAGE*.
+The result may not be readable. Handles problems with PRINT-OBJECT methods
+gracefully."
+ (with-buffer-syntax ()
+ (let ((*print-readably* nil))
+ (handler-case
+ (prin1-to-string object)
+ (error ()
+ (with-output-to-string (s)
+ (print-unreadable-object (object s :type t :identity t)
+ (princ "<<error printing object>>" s))))))))
+
+(defun from-string (string)
+ "Read string in the *BUFFER-PACKAGE*"
+ (with-buffer-syntax ()
+ (let ((*read-suppress* nil))
+ (read-from-string string))))
+
+;; FIXME: deal with #\| etc. hard to do portably.
+(defun tokenize-symbol (string)
+ "STRING is interpreted as the string representation of a symbol
+and is tokenized accordingly. The result is returned in three
+values: The package identifier part, the actual symbol identifier
+part, and a flag if the STRING represents a symbol that is
+internal to the package identifier part. (Notice that the flag is
+also true with an empty package identifier part, as the STRING is
+considered to represent a symbol internal to some current package.)"
+ (let ((package (let ((pos (position #\: string)))
+ (if pos (subseq string 0 pos) nil)))
+ (symbol (let ((pos (position #\: string :from-end t)))
+ (if pos (subseq string (1+ pos)) string)))
+ (internp (not (= (count #\: string) 1))))
+ (values symbol package internp)))
+
+(defun tokenize-symbol-thoroughly (string)
+ "This version of TOKENIZE-SYMBOL handles escape characters."
+ (let ((package nil)
+ (token (make-array (length string) :element-type 'character
+ :fill-pointer 0))
+ (backslash nil)
+ (vertical nil)
+ (internp nil))
+ (loop for char across string
+ do (cond
+ (backslash
+ (vector-push-extend char token)
+ (setq backslash nil))
+ ((char= char #\\) ; Quotes next character, even within |...|
+ (setq backslash t))
+ ((char= char #\|)
+ (setq vertical t))
+ (vertical
+ (vector-push-extend char token))
+ ((char= char #\:)
+ (if package
+ (setq internp t)
+ (setq package token
+ token (make-array (length string)
+ :element-type 'character
+ :fill-pointer 0))))
+ (t
+ (vector-push-extend (casify-char char) token))))
+ (values token package (or (not package) internp))))
+
+(defun untokenize-symbol (package-name internal-p symbol-name)
+ "The inverse of TOKENIZE-SYMBOL.
+
+ (untokenize-symbol \"quux\" nil \"foo\") ==> \"quux:foo\"
+ (untokenize-symbol \"quux\" t \"foo\") ==> \"quux::foo\"
+ (untokenize-symbol nil nil \"foo\") ==> \"foo\"
+"
+ (cond ((not package-name) symbol-name)
+ (internal-p (cat package-name "::" symbol-name))
+ (t (cat package-name ":" symbol-name))))
+
+(defun casify-char (char)
+ "Convert CHAR accoring to readtable-case."
+ (ecase (readtable-case *readtable*)
+ (:preserve char)
+ (:upcase (char-upcase char))
+ (:downcase (char-downcase char))
+ (:invert (if (upper-case-p char)
+ (char-downcase char)
+ (char-upcase char)))))
+
+(defun parse-symbol (string &optional (package *package*))
+ "Find the symbol named STRING.
+Return the symbol and a flag indicating whether the symbols was found."
+ (multiple-value-bind (sname pname) (tokenize-symbol-thoroughly string)
+ (let ((package (cond ((string= pname "") keyword-package)
+ (pname (find-package pname))
+ (t package))))
+ (if package
+ (multiple-value-bind (symbol flag) (find-symbol sname package)
+ (values symbol flag sname package))
+ (values nil nil nil nil)))))
+
+(defun parse-symbol-or-lose (string &optional (package *package*))
+ (multiple-value-bind (symbol status) (parse-symbol string package)
+ (if status
+ (values symbol status)
+ (error "Unknown symbol: ~A [in ~A]" string package))))
+
+;; FIXME: interns the name
+(defun parse-package (string)
+ "Find the package named STRING.
+Return the package or nil."
+ (multiple-value-bind (name pos)
+ (if (zerop (length string))
+ (values :|| 0)
+ (let ((*package* *swank-io-package*))
+ (ignore-errors (read-from-string string))))
+ (and name
+ (or (symbolp name)
+ (stringp name))
+ (= (length string) pos)
+ (find-package name))))
+
+(defun unparse-name (string)
+ "Print the name STRING according to the current printer settings."
+ ;; this is intended for package or symbol names
+ (subseq (prin1-to-string (make-symbol string)) 2))
+
+(defun guess-package (string)
+ "Guess which package corresponds to STRING.
+Return nil if no package matches."
+ (or (find-package string)
+ (parse-package string)
+ (if (find #\! string) ; for SBCL
+ (guess-package (substitute #\- #\! string)))))
+
+(defvar *readtable-alist* (default-readtable-alist)
+ "An alist mapping package names to readtables.")
+
+(defun guess-buffer-readtable (package-name)
+ (let ((package (guess-package package-name)))
+ (or (and package
+ (cdr (assoc (package-name package) *readtable-alist*
+ :test #'string=)))
+ *readtable*)))
+
+
+;;;; Evaluation
+
+(defvar *pending-continuations* '()
+ "List of continuations for Emacs. (thread local)")
+
+(defun guess-buffer-package (string)
+ "Return a package for STRING.
+Fall back to the the current if no such package exists."
+ (or (and string (guess-package string))
+ *package*))
+
+(defun eval-for-emacs (form buffer-package id)
+ "Bind *BUFFER-PACKAGE* to BUFFER-PACKAGE and evaluate FORM.
+Return the result to the continuation ID.
+Errors are trapped and invoke our debugger."
+ (call-with-debugger-hook
+ #'swank-debugger-hook
+ (lambda ()
+ (let (ok result)
+ (unwind-protect
+ (let ((*buffer-package* (guess-buffer-package buffer-package))
+ (*buffer-readtable* (guess-buffer-readtable buffer-package))
+ (*pending-continuations* (cons id *pending-continuations*)))
+ (check-type *buffer-package* package)
+ (check-type *buffer-readtable* readtable)
+ ;; APPLY would be cleaner than EVAL.
+ ;;(setq result (apply (car form) (cdr form)))
+ (setq result (eval form))
+ (run-hook *pre-reply-hook*)
+ (finish-output)
+ (setq ok t))
+ (force-user-output)
+ (send-to-emacs `(:return ,(current-thread)
+ ,(if ok
+ `(:ok ,result)
+ `(:abort))
+ ,id)))))))
+
+(defvar *echo-area-prefix* "=> "
+ "A prefix that `format-values-for-echo-area' should use.")
+
+(defun format-values-for-echo-area (values)
+ (with-buffer-syntax ()
+ (let ((*print-readably* nil))
+ (cond ((null values) "; No value")
+ ((and (length= values 1) (integerp (car values)))
+ (let ((i (car values)))
+ (format nil "~A~D (#x~X, #o~O, #b~B)"
+ *echo-area-prefix* i i i i)))
+ (t (format nil "~a~{~S~^, ~}" *echo-area-prefix* values))))))
+
+(defslimefun interactive-eval (string)
+ (with-buffer-syntax ()
+ (let ((values (multiple-value-list (eval (from-string string)))))
+ (fresh-line)
+ (finish-output)
+ (format-values-for-echo-area values))))
+
+(defslimefun eval-and-grab-output (string)
+ (with-buffer-syntax ()
+ (let* ((s (make-string-output-stream))
+ (*standard-output* s)
+ (values (multiple-value-list (eval (from-string string)))))
+ (list (get-output-stream-string s)
+ (format nil "~{~S~^~%~}" values)))))
+
+(defun eval-region (string)
+ "Evaluate STRING.
+Return the results of the last form as a list and as secondary value the
+last form."
+ (with-input-from-string (stream string)
+ (let (- values)
+ (loop
+ (let ((form (read stream nil stream)))
+ (when (eq form stream)
+ (return (values values -)))
+ (setq - form)
+ (setq values (multiple-value-list (eval form)))
+ (finish-output))))))
+
+(defslimefun interactive-eval-region (string)
+ (with-buffer-syntax ()
+ (format-values-for-echo-area (eval-region string))))
+
+(defslimefun re-evaluate-defvar (form)
+ (with-buffer-syntax ()
+ (let ((form (read-from-string form)))
+ (destructuring-bind (dv name &optional value doc) form
+ (declare (ignore value doc))
+ (assert (eq dv 'defvar))
+ (makunbound name)
+ (prin1-to-string (eval form))))))
+
+(defvar *swank-pprint-bindings*
+ `((*print-pretty* . t)
+ (*print-level* . nil)
+ (*print-length* . nil)
+ (*print-circle* . t)
+ (*print-gensym* . t)
+ (*print-readably* . nil))
+ "A list of variables bindings during pretty printing.
+Used by pprint-eval.")
+
+(defun swank-pprint (list)
+ "Bind some printer variables and pretty print each object in LIST."
+ (with-buffer-syntax ()
+ (with-bindings *swank-pprint-bindings*
+ (cond ((null list) "; No value")
+ (t (with-output-to-string (*standard-output*)
+ (dolist (o list)
+ (pprint o)
+ (terpri))))))))
+
+(defslimefun pprint-eval (string)
+ (with-buffer-syntax ()
+ (swank-pprint (multiple-value-list (eval (read-from-string string))))))
+
+(defslimefun set-package (name)
+ "Set *package* to the package named NAME.
+Return the full package-name and the string to use in the prompt."
+ (let ((p (guess-package name)))
+ (assert (packagep p))
+ (setq *package* p)
+ (list (package-name p) (package-string-for-prompt p))))
+
+;;;;; Listener eval
+
+(defvar *listener-eval-function* 'repl-eval)
+
+(defslimefun listener-eval (string)
+ (funcall *listener-eval-function* string))
+
+(defvar *send-repl-results-function* 'send-repl-results-to-emacs)
+
+(defun repl-eval (string)
+ (clear-user-input)
+ (with-buffer-syntax ()
+ (track-package
+ (lambda ()
+ (multiple-value-bind (values last-form) (eval-region string)
+ (setq *** ** ** * * (car values)
+ /// // // / / values
+ +++ ++ ++ + + last-form)
+ (funcall *send-repl-results-function* values)))))
+ nil)
+
+(defun track-package (fun)
+ (let ((p *package*))
+ (unwind-protect (funcall fun)
+ (unless (eq *package* p)
+ (send-to-emacs (list :new-package (package-name *package*)
+ (package-string-for-prompt *package*)))))))
+
+(defun send-repl-results-to-emacs (values)
+ (fresh-line)
+ (finish-output)
+ (if (null values)
+ (send-to-emacs `(:write-string "; No value" :repl-result))
+ (dolist (v values)
+ (send-to-emacs `(:write-string ,(cat (prin1-to-string v) #\newline)
+ :repl-result)))))
+
+(defun cat (&rest strings)
+ "Concatenate all arguments and make the result a string."
+ (with-output-to-string (out)
+ (dolist (s strings)
+ (etypecase s
+ (string (write-string s out))
+ (character (write-char s out))))))
+
+(defun package-string-for-prompt (package)
+ "Return the shortest nickname (or canonical name) of PACKAGE."
+ (unparse-name
+ (or (canonical-package-nickname package)
+ (auto-abbreviated-package-name package)
+ (shortest-package-nickname package))))
+
+(defun canonical-package-nickname (package)
+ "Return the canonical package nickname, if any, of PACKAGE."
+ (let ((name (cdr (assoc (package-name package) *canonical-package-nicknames*
+ :test #'string=))))
+ (and name (string name))))
+
+(defun auto-abbreviated-package-name (package)
+ "Return an abbreviated 'name' for PACKAGE.
+
+N.B. this is not an actual package name or nickname."
+ (when *auto-abbreviate-dotted-packages*
+ (let ((last-dot (position #\. (package-name package) :from-end t)))
+ (when last-dot (subseq (package-name package) (1+ last-dot))))))
+
+(defun shortest-package-nickname (package)
+ "Return the shortest nickname (or canonical name) of PACKAGE."
+ (loop for name in (cons (package-name package) (package-nicknames package))
+ for shortest = name then (if (< (length name) (length shortest))
+ name
+ shortest)
+ finally (return shortest)))
+
+(defslimefun ed-in-emacs (&optional what)
+ "Edit WHAT in Emacs.
+
+WHAT can be:
+ A pathname or a string,
+ A list (PATHNAME-OR-STRING LINE [COLUMN]),
+ A function name (symbol or cons),
+ NIL.
+
+Returns true if it actually called emacs, or NIL if not."
+ (flet ((pathname-or-string-p (thing)
+ (or (pathnamep thing) (typep thing 'string))))
+ (let ((target
+ (cond ((and (listp what) (pathname-or-string-p (first what)))
+ (cons (canonicalize-filename (car what)) (cdr what)))
+ ((pathname-or-string-p what)
+ (canonicalize-filename what))
+ ((symbolp what) what)
+ ((consp what) what)
+ (t (return-from ed-in-emacs nil)))))
+ (cond
+ (*emacs-connection* (send-oob-to-emacs `(:ed ,target)))
+ ((default-connection)
+ (with-connection ((default-connection))
+ (send-oob-to-emacs `(:ed ,target))))
+ (t nil)))))
+
+(defslimefun inspect-in-emacs (what)
+ "Inspect WHAT in Emacs."
+ (flet ((send-it ()
+ (with-buffer-syntax ()
+ (reset-inspector)
+ (send-oob-to-emacs `(:inspect ,(inspect-object what))))))
+ (cond
+ (*emacs-connection*
+ (send-it))
+ ((default-connection)
+ (with-connection ((default-connection))
+ (send-it))))
+ what))
+
+(defslimefun value-for-editing (form)
+ "Return a readable value of FORM for editing in Emacs.
+FORM is expected, but not required, to be SETF'able."
+ ;; FIXME: Can we check FORM for setfability? -luke (12/Mar/2005)
+ (with-buffer-syntax ()
+ (prin1-to-string (eval (read-from-string form)))))
+
+(defslimefun commit-edited-value (form value)
+ "Set the value of a setf'able FORM to VALUE.
+FORM and VALUE are both strings from Emacs."
+ (with-buffer-syntax ()
+ (eval `(setf ,(read-from-string form)
+ ,(read-from-string (concatenate 'string "`" value))))
+ t))
+
+(defun background-message (format-string &rest args)
+ "Display a message in Emacs' echo area.
+
+Use this function for informative messages only. The message may even
+be dropped, if we are too busy with other things."
+ (when *emacs-connection*
+ (send-to-emacs `(:background-message
+ ,(apply #'format nil format-string args)))))
+
+
+;;;; Debugger
+
+(defun swank-debugger-hook (condition hook)
+ "Debugger function for binding *DEBUGGER-HOOK*.
+Sends a message to Emacs declaring that the debugger has been entered,
+then waits to handle further requests from Emacs. Eventually returns
+after Emacs causes a restart to be invoked."
+ (declare (ignore hook))
+ (cond (*emacs-connection*
+ (debug-in-emacs condition))
+ ((default-connection)
+ (with-connection ((default-connection))
+ (debug-in-emacs condition)))))
+
+(defvar *global-debugger* t
+ "Non-nil means the Swank debugger hook will be installed globally.")
+
+(add-hook *new-connection-hook* 'install-debugger)
+(defun install-debugger (connection)
+ (declare (ignore connection))
+ (when *global-debugger*
+ (install-debugger-globally #'swank-debugger-hook)))
+
+;;;;; Debugger loop
+;;;
+;;; These variables are dynamically bound during debugging.
+;;;
+(defvar *swank-debugger-condition* nil
+ "The condition being debugged.")
+
+(defvar *sldb-level* 0
+ "The current level of recursive debugging.")
+
+(defvar *sldb-initial-frames* 20
+ "The initial number of backtrace frames to send to Emacs.")
+
+(defvar *sldb-restarts* nil
+ "The list of currenlty active restarts.")
+
+(defvar *sldb-stepping-p* nil
+ "True during execution of a step command.")
+
+(defun debug-in-emacs (condition)
+ (let ((*swank-debugger-condition* condition)
+ (*sldb-restarts* (compute-sane-restarts condition))
+ (*package* (or (and (boundp '*buffer-package*)
+ (symbol-value '*buffer-package*))
+ *package*))
+ (*sldb-level* (1+ *sldb-level*))
+ (*sldb-stepping-p* nil)
+ (*swank-state-stack* (cons :swank-debugger-hook *swank-state-stack*)))
+ (force-user-output)
+ (call-with-debugging-environment
+ (lambda ()
+ (with-bindings *sldb-printer-bindings*
+ (sldb-loop *sldb-level*))))))
+
+(defun sldb-loop (level)
+ (unwind-protect
+ (catch 'sldb-enter-default-debugger
+ (send-to-emacs
+ (list* :debug (current-thread) level
+ (debugger-info-for-emacs 0 *sldb-initial-frames*)))
+ (loop (catch 'sldb-loop-catcher
+ (with-simple-restart (abort "Return to sldb level ~D." level)
+ (send-to-emacs (list :debug-activate (current-thread)
+ level))
+ (handler-bind ((sldb-condition #'handle-sldb-condition))
+ (read-from-emacs))))))
+ (send-to-emacs `(:debug-return
+ ,(current-thread) ,level ,*sldb-stepping-p*))))
+
+(defun handle-sldb-condition (condition)
+ "Handle an internal debugger condition.
+Rather than recursively debug the debugger (a dangerous idea!), these
+conditions are simply reported."
+ (let ((real-condition (original-condition condition)))
+ (send-to-emacs `(:debug-condition ,(current-thread)
+ ,(princ-to-string real-condition))))
+ (throw 'sldb-loop-catcher nil))
+
+(defun safe-condition-message (condition)
+ "Safely print condition to a string, handling any errors during
+printing."
+ (let ((*print-pretty* t))
+ (handler-case
+ (format-sldb-condition condition)
+ (error (cond)
+ ;; Beware of recursive errors in printing, so only use the condition
+ ;; if it is printable itself:
+ (format nil "Unable to display error condition~@[: ~A~]"
+ (ignore-errors (princ-to-string cond)))))))
+
+(defun debugger-condition-for-emacs ()
+ (list (safe-condition-message *swank-debugger-condition*)
+ (format nil " [Condition of type ~S]"
+ (type-of *swank-debugger-condition*))
+ (condition-extras *swank-debugger-condition*)))
+
+(defun format-restarts-for-emacs ()
+ "Return a list of restarts for *swank-debugger-condition* in a
+format suitable for Emacs."
+ (let ((*print-right-margin* most-positive-fixnum))
+ (loop for restart in *sldb-restarts*
+ collect (list (princ-to-string (restart-name restart))
+ (princ-to-string restart)))))
+
+
+;;;;; SLDB entry points
+
+(defslimefun sldb-break-with-default-debugger ()
+ "Invoke the default debugger by returning from our debugger-loop."
+ (throw 'sldb-enter-default-debugger nil))
+
+(defslimefun backtrace (start end)
+ "Return a list ((I FRAME) ...) of frames from START to END.
+I is an integer describing and FRAME a string."
+ (loop for frame in (compute-backtrace start end)
+ for i from start
+ collect (list i (with-output-to-string (stream)
+ (handler-case
+ (print-frame frame stream)
+ (t ()
+ (format stream "[error printing frame]")))))))
+
+(defslimefun debugger-info-for-emacs (start end)
+ "Return debugger state, with stack frames from START to END.
+The result is a list:
+ (condition ({restart}*) ({stack-frame}*) (cont*))
+where
+ condition ::= (description type [extra])
+ restart ::= (name description)
+ stack-frame ::= (number description)
+ extra ::= (:references and other random things)
+ cont ::= continutation
+condition---a pair of strings: message, and type. If show-source is
+not nil it is a frame number for which the source should be displayed.
+
+restart---a pair of strings: restart name, and description.
+
+stack-frame---a number from zero (the top), and a printed
+representation of the frame's call.
+
+continutation---the id of a pending Emacs continuation.
+
+Below is an example return value. In this case the condition was a
+division by zero (multi-line description), and only one frame is being
+fetched (start=0, end=1).
+
+ ((\"Arithmetic error DIVISION-BY-ZERO signalled.
+Operation was KERNEL::DIVISION, operands (1 0).\"
+ \"[Condition of type DIVISION-BY-ZERO]\")
+ ((\"ABORT\" \"Return to Slime toplevel.\")
+ (\"ABORT\" \"Return to Top-Level.\"))
+ ((0 \"(KERNEL::INTEGER-/-INTEGER 1 0)\"))
+ (4))"
+ (list (debugger-condition-for-emacs)
+ (format-restarts-for-emacs)
+ (backtrace start end)
+ *pending-continuations*))
+
+(defun nth-restart (index)
+ (nth index *sldb-restarts*))
+
+(defslimefun invoke-nth-restart (index)
+ (invoke-restart-interactively (nth-restart index)))
+
+(defslimefun sldb-abort ()
+ (invoke-restart (find 'abort *sldb-restarts* :key #'restart-name)))
+
+(defslimefun sldb-continue ()
+ (continue))
+
+(defslimefun throw-to-toplevel ()
+ "Invoke the ABORT-REQUEST restart abort an RPC from Emacs.
+If we are not evaluating an RPC then ABORT instead."
+ (let ((restart (find-restart *sldb-quit-restart*)))
+ (cond (restart (invoke-restart restart))
+ (t (format nil
+ "Restart not found: ~a"
+ *sldb-quit-restart*)))))
+
+(defslimefun invoke-nth-restart-for-emacs (sldb-level n)
+ "Invoke the Nth available restart.
+SLDB-LEVEL is the debug level when the request was made. If this
+has changed, ignore the request."
+ (when (= sldb-level *sldb-level*)
+ (invoke-nth-restart n)))
+
+(defun wrap-sldb-vars (form)
+ `(let ((*sldb-level* ,*sldb-level*))
+ ,form))
+
+(defslimefun eval-string-in-frame (string index)
+ (to-string (eval-in-frame (wrap-sldb-vars (from-string string))
+ index)))
+
+(defslimefun pprint-eval-string-in-frame (string index)
+ (swank-pprint
+ (multiple-value-list
+ (eval-in-frame (wrap-sldb-vars (from-string string)) index))))
+
+(defslimefun frame-locals-for-emacs (index)
+ "Return a property list ((&key NAME ID VALUE) ...) describing
+the local variables in the frame INDEX."
+ (mapcar (lambda (frame-locals)
+ (destructuring-bind (&key name id value) frame-locals
+ (list :name (prin1-to-string name) :id id
+ :value (to-string value))))
+ (frame-locals index)))
+
+(defslimefun frame-catch-tags-for-emacs (frame-index)
+ (mapcar #'to-string (frame-catch-tags frame-index)))
+
+(defslimefun sldb-disassemble (index)
+ (with-output-to-string (*standard-output*)
+ (disassemble-frame index)))
+
+(defslimefun sldb-return-from-frame (index string)
+ (let ((form (from-string string)))
+ (to-string (multiple-value-list (return-from-frame index form)))))
+
+(defslimefun sldb-break (name)
+ (with-buffer-syntax ()
+ (sldb-break-at-start (read-from-string name))))
+
+(defmacro define-stepper-function (name backend-function-name)
+ `(defslimefun ,name (frame)
+ (cond ((sldb-stepper-condition-p *swank-debugger-condition*)
+ (setq *sldb-stepping-p* t)
+ (,backend-function-name))
+ ((find-restart 'continue)
+ (activate-stepping frame)
+ (setq *sldb-stepping-p* t)
+ (continue))
+ (t
+ (error "Not currently single-stepping, and no continue restart available.")))))
+
+(define-stepper-function sldb-step sldb-step-into)
+(define-stepper-function sldb-next sldb-step-next)
+(define-stepper-function sldb-out sldb-step-out)
+
+
+;;;; Compilation Commands.
+
+(defvar *compiler-notes* '()
+ "List of compiler notes for the last compilation unit.")
+
+(defun clear-compiler-notes ()
+ (setf *compiler-notes* '()))
+
+(defun canonicalize-filename (filename)
+ (namestring (truename filename)))
+
+(defslimefun compiler-notes-for-emacs ()
+ "Return the list of compiler notes for the last compilation unit."
+ (reverse *compiler-notes*))
+
+(defun measure-time-interval (fn)
+ "Call FN and return the first return value and the elapsed time.
+The time is measured in microseconds."
+ (declare (type function fn))
+ (let ((before (get-internal-real-time)))
+ (values
+ (funcall fn)
+ (* (- (get-internal-real-time) before)
+ (/ 1000000 internal-time-units-per-second)))))
+
+(defun record-note-for-condition (condition)
+ "Record a note for a compiler-condition."
+ (push (make-compiler-note condition) *compiler-notes*))
+
+(defun make-compiler-note (condition)
+ "Make a compiler note data structure from a compiler-condition."
+ (declare (type compiler-condition condition))
+ (list* :message (message condition)
+ :severity (severity condition)
+ :location (location condition)
+ :references (references condition)
+ (let ((s (short-message condition)))
+ (if s (list :short-message s)))))
+
+(defun swank-compiler (function)
+ (clear-compiler-notes)
+ (multiple-value-bind (result usecs)
+ (with-simple-restart (abort "Abort SLIME compilation.")
+ (handler-bind ((compiler-condition #'record-note-for-condition))
+ (measure-time-interval function)))
+ ;; WITH-SIMPLE-RESTART returns (values nil t) if its restart is invoked;
+ ;; unfortunately the SWANK protocol doesn't support returning multiple
+ ;; values, so we gotta convert it explicitely to a list in either case.
+ (if (and (not result) (eq usecs 't))
+ (list nil nil)
+ (list (to-string result)
+ (format nil "~,2F" (/ usecs 1000000.0))))))
+
+(defslimefun compile-file-for-emacs (filename load-p)
+ "Compile FILENAME and, when LOAD-P, load the result.
+Record compiler notes signalled as `compiler-condition's."
+ (with-buffer-syntax ()
+ (let ((*compile-print* nil))
+ (swank-compiler
+ (lambda ()
+ (swank-compile-file filename load-p
+ (or (guess-external-format filename)
+ :default)))))))
+
+(defslimefun compile-string-for-emacs (string buffer position directory)
+ "Compile STRING (exerpted from BUFFER at POSITION).
+Record compiler notes signalled as `compiler-condition's."
+ (with-buffer-syntax ()
+ (swank-compiler
+ (lambda ()
+ (let ((*compile-print* nil) (*compile-verbose* t))
+ (swank-compile-string string :buffer buffer :position position
+ :directory directory))))))
+
+(defun file-newer-p (new-file old-file)
+ "Returns true if NEW-FILE is newer than OLD-FILE."
+ (> (file-write-date new-file) (file-write-date old-file)))
+
+(defun requires-compile-p (source-file)
+ (let ((fasl-file (probe-file (compile-file-pathname source-file))))
+ (or (not fasl-file)
+ (file-newer-p source-file fasl-file))))
+
+(defslimefun compile-file-if-needed (filename loadp)
+ (cond ((requires-compile-p filename)
+ (compile-file-for-emacs filename loadp))
+ (loadp
+ (load (compile-file-pathname filename))
+ nil)))
+
+
+;;;; Loading
+
+(defslimefun load-file (filename)
+ (to-string (load filename)))
+
+(defslimefun load-file-set-package (filename &optional package)
+ (load-file filename)
+ (if package
+ (set-package package)))
+
+
+;;;;; swank-require
+
+(defslimefun swank-require (module &optional filename)
+ "Load the module MODULE."
+ (require module (or filename (module-filename module)))
+ nil)
+
+(defvar *find-module* 'find-module
+ "Pluggable function to locate modules.
+The function receives a module name as argument and should return
+the filename of the module (or nil if the file doesn't exist).")
+
+(defun module-filename (module)
+ "Return the filename for the module MODULE."
+ (or (funcall *find-module* module)
+ (error "Can't locate module: ~s" module)))
+
+;;;;;; Simple *find-module* function.
+
+(defun merged-directory (dirname defaults)
+ (pathname-directory
+ (merge-pathnames
+ (make-pathname :directory `(:relative ,dirname) :defaults defaults)
+ defaults)))
+
+(defvar *load-path*
+ (list (make-pathname :directory (merged-directory "contrib" *load-truename*)
+ :name nil :type nil :version nil
+ :defaults *load-truename*))
+ "A list of directories to search for modules.")
+
+(defun module-canditates (name dir)
+ (list (compile-file-pathname (make-pathname :name name :defaults dir))
+ (make-pathname :name name :type "lisp" :defaults dir)))
+
+(defun find-module (module)
+ (let ((name (string-downcase module)))
+ (some (lambda (dir) (some #'probe-file (module-canditates name dir)))
+ *load-path*)))
+
+
+;;;; Macroexpansion
+
+(defvar *macroexpand-printer-bindings*
+ '((*print-circle* . nil)
+ (*print-pretty* . t)
+ (*print-escape* . t)
+ (*print-lines* . nil)
+ (*print-level* . nil)
+ (*print-length* . nil)))
+
+(defun apply-macro-expander (expander string)
+ (with-buffer-syntax ()
+ (with-bindings *macroexpand-printer-bindings*
+ (prin1-to-string (funcall expander (from-string string))))))
+
+(defslimefun swank-macroexpand-1 (string)
+ (apply-macro-expander #'macroexpand-1 string))
+
+(defslimefun swank-macroexpand (string)
+ (apply-macro-expander #'macroexpand string))
+
+(defslimefun swank-macroexpand-all (string)
+ (apply-macro-expander #'macroexpand-all string))
+
+(defslimefun swank-compiler-macroexpand-1 (string)
+ (apply-macro-expander #'compiler-macroexpand-1 string))
+
+(defslimefun swank-compiler-macroexpand (string)
+ (apply-macro-expander #'compiler-macroexpand string))
+
+(defslimefun disassemble-symbol (name)
+ (with-buffer-syntax ()
+ (with-output-to-string (*standard-output*)
+ (let ((*print-readably* nil))
+ (disassemble (fdefinition (from-string name)))))))
+
+
+;;;; Simple completion
+
+(defslimefun simple-completions (string buffer-package)
+ "Return a list of completions for the string STRING."
+ (let ((strings (all-completions string buffer-package #'prefix-match-p)))
+ (list strings (longest-common-prefix strings))))
+
+(defun all-completions (string buffer-package test)
+ (multiple-value-bind (name pname intern) (tokenize-symbol string)
+ (let* ((extern (and pname (not intern)))
+ (pack (cond ((equal pname "") keyword-package)
+ ((not pname) (guess-buffer-package buffer-package))
+ (t (guess-package pname))))
+ (test (lambda (sym) (funcall test name (unparse-symbol sym))))
+ (syms (and pack (matching-symbols pack extern test))))
+ (format-completion-set (mapcar #'unparse-symbol syms) intern pname))))
+
+(defun matching-symbols (package external test)
+ (let ((test (if external
+ (lambda (s)
+ (and (symbol-external-p s package)
+ (funcall test s)))
+ test))
+ (result '()))
+ (do-symbols (s package)
+ (when (funcall test s)
+ (push s result)))
+ (remove-duplicates result)))
+
+(defun unparse-symbol (symbol)
+ (let ((*print-case* (case (readtable-case *readtable*)
+ (:downcase :upcase)
+ (t :downcase))))
+ (unparse-name (symbol-name symbol))))
+
+(defun prefix-match-p (prefix string)
+ "Return true if PREFIX is a prefix of STRING."
+ (not (mismatch prefix string :end2 (min (length string) (length prefix)))))
+
+(defun longest-common-prefix (strings)
+ "Return the longest string that is a common prefix of STRINGS."
+ (if (null strings)
+ ""
+ (flet ((common-prefix (s1 s2)
+ (let ((diff-pos (mismatch s1 s2)))
+ (if diff-pos (subseq s1 0 diff-pos) s1))))
+ (reduce #'common-prefix strings))))
+
+(defun format-completion-set (strings internal-p package-name)
+ "Format a set of completion strings.
+Returns a list of completions with package qualifiers if needed."
+ (mapcar (lambda (string) (untokenize-symbol package-name internal-p string))
+ (sort strings #'string<)))
+
+
+;;;; Simple arglist display
+
+(defslimefun operator-arglist (name package)
+ (ignore-errors
+ (let ((args (arglist (parse-symbol name (guess-buffer-package package))))
+ (*print-escape* nil))
+ (cond ((eq args :not-available) nil)
+ (t (format nil "(~a ~/pprint-fill/)" name args))))))
+
+
+;;;; Documentation
+
+(defslimefun apropos-list-for-emacs (name &optional external-only
+ case-sensitive package)
+ "Make an apropos search for Emacs.
+The result is a list of property lists."
+ (let ((package (if package
+ (or (parse-package package)
+ (error "No such package: ~S" package)))))
+ ;; The MAPCAN will filter all uninteresting symbols, i.e. those
+ ;; who cannot be meaningfully described.
+ (mapcan (listify #'briefly-describe-symbol-for-emacs)
+ (sort (remove-duplicates
+ (apropos-symbols name external-only case-sensitive package))
+ #'present-symbol-before-p))))
+
+(defun briefly-describe-symbol-for-emacs (symbol)
+ "Return a property list describing SYMBOL.
+Like `describe-symbol-for-emacs' but with at most one line per item."
+ (flet ((first-line (string)
+ (let ((pos (position #\newline string)))
+ (if (null pos) string (subseq string 0 pos)))))
+ (let ((desc (map-if #'stringp #'first-line
+ (describe-symbol-for-emacs symbol))))
+ (if desc
+ (list* :designator (to-string symbol) desc)))))
+
+(defun map-if (test fn &rest lists)
+ "Like (mapcar FN . LISTS) but only call FN on objects satisfying TEST.
+Example:
+\(map-if #'oddp #'- '(1 2 3 4 5)) => (-1 2 -3 4 -5)"
+ (apply #'mapcar
+ (lambda (x) (if (funcall test x) (funcall fn x) x))
+ lists))
+
+(defun listify (f)
+ "Return a function like F, but which returns any non-null value
+wrapped in a list."
+ (lambda (x)
+ (let ((y (funcall f x)))
+ (and y (list y)))))
+
+(defun present-symbol-before-p (x y)
+ "Return true if X belongs before Y in a printed summary of symbols.
+Sorted alphabetically by package name and then symbol name, except
+that symbols accessible in the current package go first."
+ (declare (type symbol x y))
+ (flet ((accessible (s)
+ ;; Test breaks on NIL for package that does not inherit it
+ (eq (find-symbol (symbol-name s) *buffer-package*) s)))
+ (let ((ax (accessible x)) (ay (accessible y)))
+ (cond ((and ax ay) (string< (symbol-name x) (symbol-name y)))
+ (ax t)
+ (ay nil)
+ (t (let ((px (symbol-package x)) (py (symbol-package y)))
+ (if (eq px py)
+ (string< (symbol-name x) (symbol-name y))
+ (string< (package-name px) (package-name py)))))))))
+
+(let ((regex-hash (make-hash-table :test #'equal)))
+ (defun compiled-regex (regex-string)
+ (or (gethash regex-string regex-hash)
+ (setf (gethash regex-string regex-hash)
+ (if (zerop (length regex-string))
+ (lambda (s) (check-type s string) t)
+ (compile nil (slime-nregex:regex-compile regex-string)))))))
+
+(defun make-regexp-matcher (string case-sensitive)
+ (let* ((case-modifier (if case-sensitive #'string #'string-upcase))
+ (regex (compiled-regex (funcall case-modifier string))))
+ (lambda (symbol)
+ (funcall regex (funcall case-modifier symbol)))))
+
+(defun apropos-symbols (string external-only case-sensitive package)
+ (let ((packages (or package (remove (find-package :keyword)
+ (list-all-packages))))
+ (matcher (make-regexp-matcher string case-sensitive))
+ (result))
+ (with-package-iterator (next packages :external :internal)
+ (loop (multiple-value-bind (morep symbol) (next)
+ (cond ((not morep) (return))
+ ((and (if external-only (symbol-external-p symbol) t)
+ (funcall matcher symbol))
+ (push symbol result))))))
+ result))
+
+(defun call-with-describe-settings (fn)
+ (let ((*print-readably* nil))
+ (funcall fn)))
+
+(defmacro with-describe-settings ((&rest _) &body body)
+ (declare (ignore _))
+ `(call-with-describe-settings (lambda () ,@body)))
+
+(defun describe-to-string (object)
+ (with-describe-settings ()
+ (with-output-to-string (*standard-output*)
+ (describe object))))
+
+(defslimefun describe-symbol (symbol-name)
+ (with-buffer-syntax ()
+ (describe-to-string (parse-symbol-or-lose symbol-name))))
+
+(defslimefun describe-function (name)
+ (with-buffer-syntax ()
+ (let ((symbol (parse-symbol-or-lose name)))
+ (describe-to-string (or (macro-function symbol)
+ (symbol-function symbol))))))
+
+(defslimefun describe-definition-for-emacs (name kind)
+ (with-buffer-syntax ()
+ (with-describe-settings ()
+ (with-output-to-string (*standard-output*)
+ (describe-definition (parse-symbol-or-lose name) kind)))))
+
+(defslimefun documentation-symbol (symbol-name &optional default)
+ (with-buffer-syntax ()
+ (multiple-value-bind (sym foundp) (parse-symbol symbol-name)
+ (if foundp
+ (let ((vdoc (documentation sym 'variable))
+ (fdoc (documentation sym 'function)))
+ (or (and (or vdoc fdoc)
+ (concatenate 'string
+ fdoc
+ (and vdoc fdoc '(#\Newline #\Newline))
+ vdoc))
+ default))
+ default))))
+
+
+;;;; Package Commands
+
+(defslimefun list-all-package-names (&optional nicknames)
+ "Return a list of all package names.
+Include the nicknames if NICKNAMES is true."
+ (mapcar #'unparse-name
+ (if nicknames
+ (mapcan #'package-names (list-all-packages))
+ (mapcar #'package-name (list-all-packages)))))
+
+
+;;;; Tracing
+
+;; Use eval for the sake of portability...
+(defun tracedp (fspec)
+ (member fspec (eval '(trace))))
+
+(defslimefun swank-toggle-trace (spec-string)
+ (let ((spec (from-string spec-string)))
+ (cond ((consp spec) ; handle complicated cases in the backend
+ (toggle-trace spec))
+ ((tracedp spec)
+ (eval `(untrace ,spec))
+ (format nil "~S is now untraced." spec))
+ (t
+ (eval `(trace ,spec))
+ (format nil "~S is now traced." spec)))))
+
+(defslimefun untrace-all ()
+ (untrace))
+
+(defslimefun redirect-trace-output (target)
+ (setf (connection.trace-output *emacs-connection*)
+ (make-output-stream-for-target *emacs-connection* target))
+ nil)
+
+
+;;;; Undefing
+
+(defslimefun undefine-function (fname-string)
+ (let ((fname (from-string fname-string)))
+ (format nil "~S" (fmakunbound fname))))
+
+
+;;;; Profiling
+
+(defun profiledp (fspec)
+ (member fspec (profiled-functions)))
+
+(defslimefun toggle-profile-fdefinition (fname-string)
+ (let ((fname (from-string fname-string)))
+ (cond ((profiledp fname)
+ (unprofile fname)
+ (format nil "~S is now unprofiled." fname))
+ (t
+ (profile fname)
+ (format nil "~S is now profiled." fname)))))
+
+
+;;;; Source Locations
+
+(defslimefun find-definitions-for-emacs (name)
+ "Return a list ((DSPEC LOCATION) ...) of definitions for NAME.
+DSPEC is a string and LOCATION a source location. NAME is a string."
+ (multiple-value-bind (sexp error)
+ (ignore-errors (values (from-string name)))
+ (unless error
+ (loop for (dspec loc) in (find-definitions sexp)
+ collect (list (to-string dspec) loc)))))
+
+(defun alistify (list key test)
+ "Partition the elements of LIST into an alist. KEY extracts the key
+from an element and TEST is used to compare keys."
+ (declare (type function key))
+ (let ((alist '()))
+ (dolist (e list)
+ (let* ((k (funcall key e))
+ (probe (assoc k alist :test test)))
+ (if probe
+ (push e (cdr probe))
+ (push (cons k (list e)) alist))))
+ alist))
+
+(defun location-position< (pos1 pos2)
+ (cond ((and (position-p pos1) (position-p pos2))
+ (< (position-pos pos1)
+ (position-pos pos2)))
+ (t nil)))
+
+(defun partition (list test key)
+ (declare (type function test key))
+ (loop for e in list
+ if (funcall test (funcall key e)) collect e into yes
+ else collect e into no
+ finally (return (values yes no))))
+
+(defstruct (xref (:conc-name xref.)
+ (:type list))
+ dspec location)
+
+(defun location-valid-p (location)
+ (eq (car location) :location))
+
+(defun xref-buffer (xref)
+ (location-buffer (xref.location xref)))
+
+(defun xref-position (xref)
+ (location-buffer (xref.location xref)))
+
+(defun group-xrefs (xrefs)
+ "Group XREFS, a list of the form ((DSPEC LOCATION) ...) by location.
+The result is a list of the form ((LOCATION . ((DSPEC . LOCATION) ...)) ...)."
+ (multiple-value-bind (resolved errors)
+ (partition xrefs #'location-valid-p #'xref.location)
+ (let ((alist (alistify resolved #'xref-buffer #'equal)))
+ (append
+ (loop for (buffer . list) in alist
+ collect (cons (second buffer)
+ (mapcar (lambda (xref)
+ (cons (to-string (xref.dspec xref))
+ (xref.location xref)))
+ (sort list #'location-position<
+ :key #'xref-position))))
+ (if errors
+ (list (cons "Unresolved"
+ (mapcar (lambda (xref)
+ (cons (to-string (xref.dspec xref))
+ (xref.location xref)))
+ errors))))))))
+
+(defslimefun xref (type symbol-name)
+ (let ((symbol (parse-symbol-or-lose symbol-name *buffer-package*)))
+ (group-xrefs
+ (ecase type
+ (:calls (who-calls symbol))
+ (:calls-who (calls-who symbol))
+ (:references (who-references symbol))
+ (:binds (who-binds symbol))
+ (:sets (who-sets symbol))
+ (:macroexpands (who-macroexpands symbol))
+ (:specializes (who-specializes symbol))
+ (:callers (list-callers symbol))
+ (:callees (list-callees symbol))))))
+
+
+;;;; Inspecting
+
+(defun common-seperated-spec (list &optional (callback (lambda (v)
+ `(:value ,v))))
+ (butlast
+ (loop
+ for i in list
+ collect (funcall callback i)
+ collect ", ")))
+
+(defun inspector-princ (list)
+ "Like princ-to-string, but don't rewrite (function foo) as #'foo.
+Do NOT pass circular lists to this function."
+ (let ((*print-pprint-dispatch* (copy-pprint-dispatch)))
+ (set-pprint-dispatch '(cons (member function)) nil)
+ (princ-to-string list)))
+
+(defmethod inspect-for-emacs ((object cons) inspector)
+ (declare (ignore inspector))
+ (if (consp (cdr object))
+ (inspect-for-emacs-list object)
+ (inspect-for-emacs-simple-cons object)))
+
+(defun inspect-for-emacs-simple-cons (cons)
+ (values "A cons cell."
+ (label-value-line*
+ ('car (car cons))
+ ('cdr (cdr cons)))))
+
+(defun inspect-for-emacs-list (list)
+ (let ((maxlen 40))
+ (multiple-value-bind (length tail) (safe-length list)
+ (flet ((frob (title list)
+ (let (lines)
+ (loop for i from 0 for rest on list do
+ (if (consp (cdr rest)) ; e.g. (A . (B . ...))
+ (push (label-value-line i (car rest)) lines)
+ (progn ; e.g. (A . NIL) or (A . B)
+ (push (label-value-line i (car rest) :newline nil) lines)
+ (when (cdr rest)
+ (push '((:newline)) lines)
+ (push (label-value-line ':tail () :newline nil) lines))
+ (loop-finish)))
+ finally
+ (setf lines (reduce #'append (nreverse lines) :from-end t)))
+ (values title (append '("Elements:" (:newline)) lines)))))
+
+ (cond ((not length) ; circular
+ (frob "A circular list."
+ (cons (car list)
+ (ldiff (cdr list) list))))
+ ((and (<= length maxlen) (not tail))
+ (frob "A proper list." list))
+ (tail
+ (frob "An improper list." list))
+ (t
+ (frob "A proper list." list)))))))
+
+;; (inspect-for-emacs-list '#1=(a #1# . #1# ))
+
+(defun safe-length (list)
+ "Similar to `list-length', but avoid errors on improper lists.
+Return two values: the length of the list and the last cdr.
+NIL is returned if the list is circular."
+ (do ((n 0 (+ n 2)) ;Counter.
+ (fast list (cddr fast)) ;Fast pointer: leaps by 2.
+ (slow list (cdr slow))) ;Slow pointer: leaps by 1.
+ (nil)
+ (cond ((null fast) (return (values n nil)))
+ ((not (consp fast)) (return (values n fast)))
+ ((null (cdr fast)) (return (values (1+ n) (cdr fast))))
+ ((and (eq fast slow) (> n 0)) (return nil))
+ ((not (consp (cdr fast))) (return (values (1+ n) (cdr fast)))))))
+
+(defvar *slime-inspect-contents-limit* nil "How many elements of
+ a hash table or array to show by default. If table has more than
+ this then offer actions to view more. Set to nil for no limit." )
+
+(defmethod inspect-for-emacs ((ht hash-table) inspector)
+ (declare (ignore inspector))
+ (values (prin1-to-string ht)
+ (append
+ (label-value-line*
+ ("Count" (hash-table-count ht))
+ ("Size" (hash-table-size ht))
+ ("Test" (hash-table-test ht))
+ ("Rehash size" (hash-table-rehash-size ht))
+ ("Rehash threshold" (hash-table-rehash-threshold ht)))
+ (let ((weakness (hash-table-weakness ht)))
+ (when weakness
+ `("Weakness: " (:value ,weakness) (:newline))))
+ (unless (zerop (hash-table-count ht))
+ `((:action "[clear hashtable]" ,(lambda () (clrhash ht))) (:newline)
+ "Contents: " (:newline)))
+ (if (and *slime-inspect-contents-limit*
+ (>= (hash-table-count ht) *slime-inspect-contents-limit*))
+ (inspect-bigger-piece-actions ht (hash-table-count ht))
+ nil)
+ (loop for key being the hash-keys of ht
+ for value being the hash-values of ht
+ repeat (or *slime-inspect-contents-limit* most-positive-fixnum)
+ append `((:value ,key) " = " (:value ,value)
+ " " (:action "[remove entry]"
+ ,(let ((key key))
+ (lambda () (remhash key ht))))
+ (:newline))))))
+
+(defun inspect-bigger-piece-actions (thing size)
+ (append
+ (if (> size *slime-inspect-contents-limit*)
+ (list (inspect-show-more-action thing)
+ '(:newline))
+ nil)
+ (list (inspect-whole-thing-action thing size)
+ '(:newline))))
+
+(defun inspect-whole-thing-action (thing size)
+ `(:action ,(format nil "Inspect all ~a elements."
+ size)
+ ,(lambda()
+ (let ((*slime-inspect-contents-limit* nil))
+ (swank::inspect-object thing)))))
+
+(defun inspect-show-more-action (thing)
+ `(:action ,(format nil "~a elements shown. Prompt for how many to inspect..."
+ *slime-inspect-contents-limit* )
+ ,(lambda()
+ (let ((*slime-inspect-contents-limit*
+ (progn (format t "How many elements should be shown? ") (read))))
+ (swank::inspect-object thing)))))
+
+(defmethod inspect-for-emacs ((array array) inspector)
+ (declare (ignore inspector))
+ (values "An array."
+ (append
+ (label-value-line*
+ ("Dimensions" (array-dimensions array))
+ ("Its element type is" (array-element-type array))
+ ("Total size" (array-total-size array))
+ ("Adjustable" (adjustable-array-p array)))
+ (when (array-has-fill-pointer-p array)
+ (label-value-line "Fill pointer" (fill-pointer array)))
+ '("Contents:" (:newline))
+ (if (and *slime-inspect-contents-limit*
+ (>= (array-total-size array) *slime-inspect-contents-limit*))
+ (inspect-bigger-piece-actions array (length array))
+ nil)
+ (loop for i below (or *slime-inspect-contents-limit* (array-total-size array))
+ append (label-value-line i (row-major-aref array i))))))
+
+(defmethod inspect-for-emacs ((char character) inspector)
+ (declare (ignore inspector))
+ (values "A character."
+ (append
+ (label-value-line*
+ ("Char code" (char-code char))
+ ("Lower cased" (char-downcase char))
+ ("Upper cased" (char-upcase char)))
+ (if (get-macro-character char)
+ `("In the current readtable ("
+ (:value ,*readtable*) ") it is a macro character: "
+ (:value ,(get-macro-character char)))))))
+
+(defvar *inspectee*)
+(defvar *inspectee-parts*)
+(defvar *inspectee-actions*)
+(defvar *inspector-stack* '())
+(defvar *inspector-history* (make-array 10 :adjustable t :fill-pointer 0))
+(declaim (type vector *inspector-history*))
+(defvar *inspect-length* 30)
+(defvar *default-inspector* (make-default-inspector))
+
+(defun reset-inspector ()
+ (setq *inspectee* nil
+ *inspector-stack* nil
+ *inspectee-parts* (make-array 10 :adjustable t :fill-pointer 0)
+ *inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0)
+ *inspector-history* (make-array 10 :adjustable t :fill-pointer 0)))
+
+;; FIXME: Unused?
+(defun valid-function-name-p (form)
+ (or (and (not (null form))
+ (not (eq form t))
+ (symbolp form))
+ (and (consp form)
+ (second form)
+ (not (third form))
+ (eq (first form) 'setf))))
+
+(defslimefun init-inspector (string)
+ (with-buffer-syntax ()
+ (reset-inspector)
+ (inspect-object (eval (read-from-string string)))))
+
+(defun print-part-to-string (value)
+ (let ((string (to-string value))
+ (pos (position value *inspector-history*)))
+ (if pos
+ (format nil "#~D=~A" pos string)
+ string)))
+
+(defun inspector-content-for-emacs (specs)
+ (loop for part in specs collect
+ (etypecase part
+ (null ; XXX encourages sloppy programming
+ nil)
+ (string part)
+ (cons (destructure-case part
+ ((:newline)
+ (string #\newline))
+ ((:value obj &optional str)
+ (value-part-for-emacs obj str))
+ ((:action label lambda &key (refreshp t))
+ (action-part-for-emacs label lambda refreshp)))))))
+
+(defun assign-index (object vector)
+ (let ((index (fill-pointer vector)))
+ (vector-push-extend object vector)
+ index))
+
+(defun value-part-for-emacs (object string)
+ (list :value
+ (or string (print-part-to-string object))
+ (assign-index object *inspectee-parts*)))
+
+(defun action-part-for-emacs (label lambda refreshp)
+ (list :action label (assign-index (list lambda refreshp)
+ *inspectee-actions*)))
+
+(defun inspect-object (object &optional (inspector *default-inspector*))
+ (push (setq *inspectee* object) *inspector-stack*)
+ (unless (find object *inspector-history*)
+ (vector-push-extend object *inspector-history*))
+ (let ((*print-pretty* nil) ; print everything in the same line
+ (*print-circle* t)
+ (*print-readably* nil))
+ (multiple-value-bind (title content) (inspect-for-emacs object inspector)
+ (list :title title
+ :type (to-string (type-of object))
+ :content (inspector-content-for-emacs content)))))
+
+(defslimefun inspector-nth-part (index)
+ (aref *inspectee-parts* index))
+
+(defslimefun inspect-nth-part (index)
+ (with-buffer-syntax ()
+ (inspect-object (inspector-nth-part index))))
+
+(defslimefun inspector-call-nth-action (index &rest args)
+ (destructuring-bind (action-lambda refreshp)
+ (aref *inspectee-actions* index)
+ (apply action-lambda args)
+ (if refreshp
+ (inspect-object (pop *inspector-stack*))
+ ;; tell emacs that we don't want to refresh the inspector buffer
+ nil)))
+
+(defslimefun inspector-pop ()
+ "Drop the inspector stack and inspect the second element. Return
+nil if there's no second element."
+ (with-buffer-syntax ()
+ (cond ((cdr *inspector-stack*)
+ (pop *inspector-stack*)
+ (inspect-object (pop *inspector-stack*)))
+ (t nil))))
+
+(defslimefun inspector-next ()
+ "Inspect the next element in the *inspector-history*."
+ (with-buffer-syntax ()
+ (let ((position (position *inspectee* *inspector-history*)))
+ (cond ((= (1+ position) (length *inspector-history*))
+ nil)
+ (t (inspect-object (aref *inspector-history* (1+ position))))))))
+
+(defslimefun inspector-reinspect ()
+ (inspect-object *inspectee*))
+
+(defslimefun quit-inspector ()
+ (reset-inspector)
+ nil)
+
+(defslimefun describe-inspectee ()
+ "Describe the currently inspected object."
+ (with-buffer-syntax ()
+ (describe-to-string *inspectee*)))
+
+(defslimefun pprint-inspector-part (index)
+ "Pretty-print the currently inspected object."
+ (with-buffer-syntax ()
+ (swank-pprint (list (inspector-nth-part index)))))
+
+(defslimefun inspect-in-frame (string index)
+ (with-buffer-syntax ()
+ (reset-inspector)
+ (inspect-object (eval-in-frame (from-string string) index))))
+
+(defslimefun inspect-current-condition ()
+ (with-buffer-syntax ()
+ (reset-inspector)
+ (inspect-object *swank-debugger-condition*)))
+
+(defslimefun inspect-frame-var (frame var)
+ (with-buffer-syntax ()
+ (reset-inspector)
+ (inspect-object (frame-var-value frame var))))
+
+
+;;;; Thread listing
+
+(defvar *thread-list* ()
+ "List of threads displayed in Emacs. We don't care a about
+synchronization issues (yet). There can only be one thread listing at
+a time.")
+
+(defslimefun list-threads ()
+ "Return a list ((NAME DESCRIPTION) ...) of all threads."
+ (setq *thread-list* (all-threads))
+ (loop for thread in *thread-list*
+ for name = (thread-name thread)
+ collect (list (if (symbolp name) (symbol-name name) name)
+ (thread-status thread)
+ (thread-id thread))))
+
+(defslimefun quit-thread-browser ()
+ (setq *thread-list* nil))
+
+(defun nth-thread (index)
+ (nth index *thread-list*))
+
+(defslimefun debug-nth-thread (index)
+ (let ((connection *emacs-connection*))
+ (interrupt-thread (nth-thread index)
+ (lambda ()
+ (with-connection (connection)
+ (simple-break))))))
+
+(defslimefun kill-nth-thread (index)
+ (kill-thread (nth-thread index)))
+
+(defslimefun start-swank-server-in-thread (index port-file-name)
+ "Interrupt the INDEXth thread and make it start a swank server.
+The server port is written to PORT-FILE-NAME."
+ (interrupt-thread (nth-thread index)
+ (lambda ()
+ (start-server port-file-name :style nil))))
+
+;;;; Class browser
+
+(defun mop-helper (class-name fn)
+ (let ((class (find-class class-name nil)))
+ (if class
+ (mapcar (lambda (x) (to-string (class-name x)))
+ (funcall fn class)))))
+
+(defslimefun mop (type symbol-name)
+ "Return info about classes using mop.
+
+ When type is:
+ :subclasses - return the list of subclasses of class.
+ :superclasses - return the list of superclasses of class."
+ (let ((symbol (parse-symbol symbol-name *buffer-package*)))
+ (ecase type
+ (:subclasses
+ (mop-helper symbol #'swank-mop:class-direct-subclasses))
+ (:superclasses
+ (mop-helper symbol #'swank-mop:class-direct-superclasses)))))
+
+
+;;;; Automatically synchronized state
+;;;
+;;; Here we add hooks to push updates of relevant information to
+;;; Emacs.
+
+;;;;; *FEATURES*
+
+(defun sync-features-to-emacs ()
+ "Update Emacs if any relevant Lisp state has changed."
+ ;; FIXME: *slime-features* should be connection-local
+ (unless (eq *slime-features* *features*)
+ (setq *slime-features* *features*)
+ (send-to-emacs (list :new-features (features-for-emacs)))))
+
+(defun features-for-emacs ()
+ "Return `*slime-features*' in a format suitable to send it to Emacs."
+ *slime-features*)
+
+(add-hook *pre-reply-hook* 'sync-features-to-emacs)
+
+
+;;;;; Indentation of macros
+;;;
+;;; This code decides how macros should be indented (based on their
+;;; arglists) and tells Emacs. A per-connection cache is used to avoid
+;;; sending redundant information to Emacs -- we just say what's
+;;; changed since last time.
+;;;
+;;; The strategy is to scan all symbols, pick out the macros, and look
+;;; for &body-arguments.
+
+(defvar *configure-emacs-indentation* t
+ "When true, automatically send indentation information to Emacs
+after each command.")
+
+(defslimefun update-indentation-information ()
+ (perform-indentation-update *emacs-connection* t)
+ nil)
+
+;; This function is for *PRE-REPLY-HOOK*.
+(defun sync-indentation-to-emacs ()
+ "Send any indentation updates to Emacs via CONNECTION."
+ (when *configure-emacs-indentation*
+ (let ((fullp (need-full-indentation-update-p *emacs-connection*)))
+ (perform-indentation-update *emacs-connection* fullp))))
+
+(defun need-full-indentation-update-p (connection)
+ "Return true if the whole indentation cache should be updated.
+This is a heuristic to avoid scanning all symbols all the time:
+instead, we only do a full scan if the set of packages has changed."
+ (set-difference (list-all-packages)
+ (connection.indentation-cache-packages connection)))
+
+(defun perform-indentation-update (connection force)
+ "Update the indentation cache in CONNECTION and update Emacs.
+If FORCE is true then start again without considering the old cache."
+ (let ((cache (connection.indentation-cache connection)))
+ (when force (clrhash cache))
+ (let ((delta (update-indentation/delta-for-emacs cache force)))
+ (setf (connection.indentation-cache-packages connection)
+ (list-all-packages))
+ (unless (null delta)
+ (send-to-emacs (list :indentation-update delta))))))
+
+(defun update-indentation/delta-for-emacs (cache &optional force)
+ "Update the cache and return the changes in a (SYMBOL . INDENT) list.
+If FORCE is true then check all symbols, otherwise only check symbols
+belonging to the buffer package."
+ (let ((alist '()))
+ (flet ((consider (symbol)
+ (let ((indent (symbol-indentation symbol)))
+ (when indent
+ (unless (equal (gethash symbol cache) indent)
+ (setf (gethash symbol cache) indent)
+ (push (cons (string-downcase symbol) indent) alist))))))
+ (if force
+ (do-all-symbols (symbol)
+ (consider symbol))
+ (do-symbols (symbol *buffer-package*)
+ ;; We're really just interested in the symbols of *BUFFER-PACKAGE*,
+ ;; and *not* all symbols that are _present_ (cf. SYMBOL-STATUS.)
+ (when (eq (symbol-package symbol) *buffer-package*)
+ (consider symbol)))))
+ alist))
+
+(defun package-names (package)
+ "Return the name and all nicknames of PACKAGE in a fresh list."
+ (cons (package-name package) (copy-list (package-nicknames package))))
+
+(defun cl-symbol-p (symbol)
+ "Is SYMBOL a symbol in the COMMON-LISP package?"
+ (eq (symbol-package symbol) cl-package))
+
+(defun known-to-emacs-p (symbol)
+ "Return true if Emacs has special rules for indenting SYMBOL."
+ (cl-symbol-p symbol))
+
+(defun symbol-indentation (symbol)
+ "Return a form describing the indentation of SYMBOL.
+The form is to be used as the `common-lisp-indent-function' property
+in Emacs."
+ (if (and (macro-function symbol)
+ (not (known-to-emacs-p symbol)))
+ (let ((arglist (arglist symbol)))
+ (etypecase arglist
+ ((member :not-available)
+ nil)
+ (list
+ (macro-indentation arglist))))
+ nil))
+
+(defun macro-indentation (arglist)
+ (if (well-formed-list-p arglist)
+ (position '&body (remove '&optional (clean-arglist arglist)))
+ nil))
+
+(defun clean-arglist (arglist)
+ "Remove &whole, &enviroment, and &aux elements from ARGLIST."
+ (cond ((null arglist) '())
+ ((member (car arglist) '(&whole &environment))
+ (clean-arglist (cddr arglist)))
+ ((eq (car arglist) '&aux)
+ '())
+ (t (cons (car arglist) (clean-arglist (cdr arglist))))))
+
+(defun well-formed-list-p (list)
+ "Is LIST a proper list terminated by NIL?"
+ (typecase list
+ (null t)
+ (cons (well-formed-list-p (cdr list)))
+ (t nil)))
+
+(defun print-indentation-lossage (&optional (stream *standard-output*))
+ "Return the list of symbols whose indentation styles collide incompatibly.
+Collisions are caused because package information is ignored."
+ (let ((table (make-hash-table :test 'equal)))
+ (flet ((name (s) (string-downcase (symbol-name s))))
+ (do-all-symbols (s)
+ (setf (gethash (name s) table)
+ (cons s (symbol-indentation s))))
+ (let ((collisions '()))
+ (do-all-symbols (s)
+ (let* ((entry (gethash (name s) table))
+ (owner (car entry))
+ (indent (cdr entry)))
+ (unless (or (eq s owner)
+ (equal (symbol-indentation s) indent)
+ (and (not (fboundp s))
+ (null (macro-function s))))
+ (pushnew owner collisions)
+ (pushnew s collisions))))
+ (if (null collisions)
+ (format stream "~&No worries!~%")
+ (format stream "~&Symbols with collisions:~%~{ ~S~%~}"
+ collisions))))))
+
+(add-hook *pre-reply-hook* 'sync-indentation-to-emacs)
+
+;;; swank.lisp ends here
Added: branches/trunk-reorg/thirdparty/slime/test-all.sh
===================================================================
--- branches/trunk-reorg/thirdparty/slime/test-all.sh 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/test-all.sh 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,14 @@
+#!/bin/sh
+
+# This code has been placed in the Public Domain. All warranties
+# are disclaimed.
+
+trap EXIT
+
+for emacs in xemacs ; do # emacs-20.7 emacs-21.3.50 xemacs ; do
+ for lisp in 'cmucl -noinit' sbcl lispworks-personal-4300 'clisp -K full' acl5; do
+ echo testing: $emacs $lisp dribble.$emacs_$lisp result.$emacs_$lisp
+ test.sh $emacs "$lisp" "dribble.${emacs}_${lisp}" "result.${emacs}_${lisp}"
+ done
+done
+
\ No newline at end of file
Property changes on: branches/trunk-reorg/thirdparty/slime/test-all.sh
___________________________________________________________________
Name: svn:executable
+ *
Added: branches/trunk-reorg/thirdparty/slime/test.sh
===================================================================
--- branches/trunk-reorg/thirdparty/slime/test.sh 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/test.sh 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,82 @@
+#!/bin/sh
+
+# Run the SLIME test suite inside screen, saving the results to a file.
+
+# This script's exit status is the number of tests failed. If no tests
+# fail then no output is printed. If at least one test fails then a
+# one-line summary is printed.
+
+# If something unexpected fails, you might get an exit code like 127
+# or 255 instead. Sorry.
+
+# This code has been placed in the Public Domain. All warranties
+# are disclaimed.
+
+function usage () {
+ echo "Usage: $name [-v] [-r] <emacs> <lisp>"
+ exit 1
+}
+
+name=$0
+
+while getopts vr opt; do
+ case $opt in
+ v) verbose=true;;
+ r) dump_results=true;;
+ *) usage;;
+ esac
+done
+
+shift $((OPTIND - 1))
+[ $# = 2 ] || usage
+
+emacs=$1; lisp=$2;
+
+# Move the code into a directory in /tmp, so that we can compile it
+# for the current lisp.
+
+slimedir=$(dirname $name)
+testdir=/tmp/slime-test.$$
+results=$testdir/results
+dribble=$testdir/dribble
+statusfile=$testdir/status
+
+test -d $testdir && rm -r $testdir
+
+trap "rm -r $testdir" EXIT # remove temporary directory on exit
+
+mkdir $testdir
+cp -r $slimedir/*.{el,lisp} ChangeLog $slimedir/contrib $testdir
+mkfifo $dribble
+
+session=slime-screen.$$
+
+screen -S $session -m -D bash -c "$emacs -nw -q -no-site-file --no-site-file \
+ --eval '(setq debug-on-quit t)' \
+ --eval '(setq max-lisp-eval-depth 1000)' \
+ --eval '(setq load-path (cons \"$testdir\" load-path))' \
+ --eval '(require (quote slime))' \
+ --eval '(setq inferior-lisp-program \"$lisp\")' \
+ --eval '(slime-batch-test \"$results\")' > $dribble;\
+ echo \$? > $statusfile" &
+
+screenpid=$!
+
+if [ "$verbose" = true ]; then
+ cat $dribble &
+else
+ cat $dribble > /dev/null &
+fi;
+
+trap "screen -S $session -X quit" SIGINT
+wait $screenpid
+
+if [ -f "$statusfile" ]; then
+ [ "$dump_results" = true ] && cat $results;
+ echo $(cat $statusfile) "test(s) failed."
+else
+ # Tests crashed
+ echo crashed
+fi
+
+exit $status
Property changes on: branches/trunk-reorg/thirdparty/slime/test.sh
___________________________________________________________________
Name: svn:executable
+ *
Added: branches/trunk-reorg/thirdparty/slime/xref.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/xref.lisp 2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/xref.lisp 2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2891 @@
+;;; -*- Mode: LISP; Package: XREF; Syntax: Common-lisp; -*-
+;;; Mon Jan 21 16:21:20 1991 by Mark Kantrowitz <mkant(a)GLINDA.OZ.CS.CMU.EDU>
+;;; xref.lisp
+
+;;; ****************************************************************
+;;; List Callers: A Static Analysis Cross Referencing Tool for Lisp
+;;; ****************************************************************
+;;;
+;;; The List Callers system is a portable Common Lisp cross referencing
+;;; utility. It grovels over a set of files and compiles a database of the
+;;; locations of all references for each symbol used in the files.
+;;; List Callers is similar to the Symbolics Who-Calls and the
+;;; Xerox Masterscope facilities.
+;;;
+;;; When you change a function or variable definition, it can be useful
+;;; to know its callers, in order to update each of them to the new
+;;; definition. Similarly, having a graphic display of the structure
+;;; (e.g., call graph) of a program can help make undocumented code more
+;;; understandable. This static code analyzer facilitates both capabilities.
+;;; The database compiled by xref is suitable for viewing by a graphical
+;;; browser. (Note: the reference graph is not necessarily a DAG. Since many
+;;; graphical browsers assume a DAG, this will lead to infinite loops.
+;;; Some code which is useful in working around this problem is included,
+;;; as well as a sample text-indenting outliner and an interface to Bates'
+;;; PSGraph Postscript Graphing facility.)
+;;;
+;;; Written by Mark Kantrowitz, July 1990.
+;;;
+;;; Address: School of Computer Science
+;;; Carnegie Mellon University
+;;; Pittsburgh, PA 15213
+;;;
+;;; Copyright (c) 1990. All rights reserved.
+;;;
+;;; See general license below.
+;;;
+
+;;; ****************************************************************
+;;; General License Agreement and Lack of Warranty *****************
+;;; ****************************************************************
+;;;
+;;; This software is distributed in the hope that it will be useful (both
+;;; in and of itself and as an example of lisp programming), but WITHOUT
+;;; ANY WARRANTY. The author(s) do not accept responsibility to anyone for
+;;; the consequences of using it or for whether it serves any particular
+;;; purpose or works at all. No warranty is made about the software or its
+;;; performance.
+;;;
+;;; Use and copying of this software and the preparation of derivative
+;;; works based on this software are permitted, so long as the following
+;;; conditions are met:
+;;; o The copyright notice and this entire notice are included intact
+;;; and prominently carried on all copies and supporting documentation.
+;;; o No fees or compensation are charged for use, copies, or
+;;; access to this software. You may charge a nominal
+;;; distribution fee for the physical act of transferring a
+;;; copy, but you may not charge for the program itself.
+;;; o If you modify this software, you must cause the modified
+;;; file(s) to carry prominent notices (a Change Log)
+;;; describing the changes, who made the changes, and the date
+;;; of those changes.
+;;; o Any work distributed or published that in whole or in part
+;;; contains or is a derivative of this software or any part
+;;; thereof is subject to the terms of this agreement. The
+;;; aggregation of another unrelated program with this software
+;;; or its derivative on a volume of storage or distribution
+;;; medium does not bring the other program under the scope
+;;; of these terms.
+;;; o Permission is granted to manufacturers and distributors of
+;;; lisp compilers and interpreters to include this software
+;;; with their distribution.
+;;;
+;;; This software is made available AS IS, and is distributed without
+;;; warranty of any kind, either expressed or implied.
+;;;
+;;; In no event will the author(s) or their institutions be liable to you
+;;; for damages, including lost profits, lost monies, or other special,
+;;; incidental or consequential damages arising out of or in connection
+;;; with the use or inability to use (including but not limited to loss of
+;;; data or data being rendered inaccurate or losses sustained by third
+;;; parties or a failure of the program to operate as documented) the
+;;; program, even if you have been advised of the possibility of such
+;;; damanges, or for any claim by any other party, whether in an action of
+;;; contract, negligence, or other tortious action.
+;;;
+;;; The current version of this software and a variety of related utilities
+;;; may be obtained by anonymous ftp from ftp.cs.cmu.edu in the directory
+;;; user/ai/lang/lisp/code/tools/xref/
+;;;
+;;; Please send bug reports, comments, questions and suggestions to
+;;; mkant(a)cs.cmu.edu. We would also appreciate receiving any changes
+;;; or improvements you may make.
+;;;
+;;; If you wish to be added to the Lisp-Utilities(a)cs.cmu.edu mailing list,
+;;; send email to Lisp-Utilities-Request(a)cs.cmu.edu with your name, email
+;;; address, and affiliation. This mailing list is primarily for
+;;; notification about major updates, bug fixes, and additions to the lisp
+;;; utilities collection. The mailing list is intended to have low traffic.
+;;;
+
+;;; ********************************
+;;; Change Log *********************
+;;; ********************************
+;;;
+;;; 27-FEB-91 mk Added insert arg to psgraph-xref to allow the postscript
+;;; graphs to be inserted in Scribe documents.
+;;; 21-FEB-91 mk Added warning if not compiled.
+;;; 07-FEB-91 mk Fixed bug in record-callers with regard to forms at
+;;; toplevel.
+;;; 21-JAN-91 mk Added file xref-test.lisp to test xref.
+;;; 16-JAN-91 mk Added definition WHO-CALLS to parallel the Symbolics syntax.
+;;; 16-JAN-91 mk Added macroexpansion capability to record-callers. Also
+;;; added parameter *handle-macro-forms*, defaulting to T.
+;;; 16-JAN-91 mk Modified print-caller-tree and related functions
+;;; to allow the user to specify root nodes. If the user
+;;; doesn't specify them, it will default to all root
+;;; nodes, as before.
+;;; 16-JAN-91 mk Added parameter *default-graphing-mode* to specify
+;;; the direction of the graphing. Either :call-graph,
+;;; where the children of a node are those functions called
+;;; by the node, or :caller-graph where the children of a
+;;; node are the callers of the node. :call-graph is the
+;;; default.
+;;; 16-JAN-91 mk Added parameter *indent-amount* to control the indentation
+;;; in print-indented-tree.
+;;; 16-JUL-90 mk Functions with argument lists of () were being ignored
+;;; because of a (when form) wrapped around the body of
+;;; record-callers. Then intent of (when form) was as an extra
+;;; safeguard against infinite looping. This wasn't really
+;;; necessary, so it has been removed.
+;;; 16-JUL-90 mk PSGraph-XREF now has keyword arguments, instead of
+;;; optionals.
+;;; 16-JUL-90 mk Added PRINT-CLASS-HIERARCHY to use psgraph to graph the
+;;; CLOS class hierarchy. This really doesn't belong here,
+;;; and should be moved to psgraph.lisp as an example of how
+;;; to use psgraph.
+;;; 16-JUL-90 mk Fixed several caller patterns. The pattern for member
+;;; had an error which caused many references to be missed.
+;;; 16-JUL-90 mk Added ability to save/load processed databases.
+;;; 5-JUL-91 mk Fixed warning of needing compilation to occur only when the
+;;; source is loaded.
+;;; 20-SEP-93 mk Added fix from Peter Norvig to allow Xref to xref itself.
+;;; The arg to macro-function must be a symbol.
+
+;;; ********************************
+;;; To Do **************************
+;;; ********************************
+;;;
+;;; Verify that:
+;;; o null forms don't cause it to infinite loop.
+;;; o nil matches against null argument lists.
+;;; o declarations and doc are being ignored.
+;;;
+;;; Would be nice if in addition to showing callers of a function, it
+;;; displayed the context of the calls to the function (e.g., the
+;;; immediately surrounding form). This entails storing entries of
+;;; the form (symbol context*) in the database and augmenting
+;;; record-callers to keep the context around. The only drawbacks is
+;;; that it would cons a fair bit. If we do this, we should store
+;;; additional information as well in the database, such as the caller
+;;; pattern type (e.g., variable vs. function).
+;;;
+;;; Write a translator from BNF (at least as much of BNF as is used
+;;; in CLtL2), to the format used here.
+;;;
+;;; Should automatically add new patterns for new functions and macros
+;;; based on their arglists. Probably requires much more than this
+;;; simple code walker, so there isn't much we can do.
+;;;
+;;; Defmacro is a problem, because it often hides internal function
+;;; calls within backquote and quote, which we normally ignore. If
+;;; we redefine QUOTE's pattern so that it treats the arg like a FORM,
+;;; we'll probably get them (though maybe the syntax will be mangled),
+;;; but most likely a lot of spurious things as well.
+;;;
+;;; Define an operation for Defsystem which will run XREF-FILE on the
+;;; files of the system. Or yet simpler, when XREF sees a LOAD form
+;;; for which the argument is a string, tries to recursively call
+;;; XREF-FILE on the specified file. Then one could just XREF-FILE
+;;; the file which loads the system. (This should be a program
+;;; parameter.)
+;;;
+;;; Have special keywords which the user may place in a file to have
+;;; XREF-FILE ignore a region.
+;;;
+;;; Should we distinguish flet and labels from defun? I.e., note that
+;;; flet's definitions are locally defined, instead of just lumping
+;;; them in with regular definitions.
+;;;
+;;; Add patterns for series, loop macro.
+;;;
+;;; Need to integrate the variable reference database with the other
+;;; databases, yet maintain separation. So we can distinguish all
+;;; the different types of variable and function references, without
+;;; multiplying databases.
+;;;
+;;; Would pay to comment record-callers and record-callers* in more
+;;; depth.
+;;;
+;;; (&OPTIONAL &REST &KEY &AUX &BODY &WHOLE &ALLOW-OTHER-KEYS &ENVIRONMENT)
+
+;;; ********************************
+;;; Notes **************************
+;;; ********************************
+;;;
+;;; XREF has been tested (successfully) in the following lisps:
+;;; CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
+;;; Macintosh Allegro Common Lisp (1.3.2)
+;;; ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 3/30/90)
+;;; Lucid CL (Version 2.1 6-DEC-87)
+;;;
+;;; XREF has been tested (unsuccessfully) in the following lisps:
+;;; Ibuki Common Lisp (01/01, October 15, 1987)
+;;; - if interpreted, runs into stack overflow
+;;; - does not compile (tried ibcl on Suns, PMAXes and RTs)
+;;; seems to be due to a limitation in the c compiler.
+;;;
+;;; XREF needs to be tested in the following lisps:
+;;; Symbolics Common Lisp (8.0)
+;;; Lucid Common Lisp (3.0, 4.0)
+;;; KCL (June 3, 1987 or later)
+;;; AKCL (1.86, June 30, 1987 or later)
+;;; TI (Release 4.1 or later)
+;;; Golden Common Lisp (3.1 IBM-PC)
+;;; VAXLisp (2.0, 3.1)
+;;; HP Common Lisp (same as Lucid?)
+;;; Procyon Common Lisp
+
+
+;;; ****************************************************************
+;;; Documentation **************************************************
+;;; ****************************************************************
+;;;
+;;; XREF analyzes a user's program, determining which functions call a
+;;; given function, and the location of where variables are bound/assigned
+;;; and used. The user may retrieve this information for either a single
+;;; symbol, or display the call graph of portions of the program
+;;; (including the entire program). This allows the programmer to debug
+;;; and document the program's structure.
+;;;
+;;; XREF is primarily intended for analyzing large programs, where it is
+;;; difficult, if not impossible, for the programmer to grasp the structure
+;;; of the whole program. Nothing precludes using XREF for smaller programs,
+;;; where it can be useful for inspecting the relationships between pieces
+;;; of the program and for documenting the program.
+;;;
+;;; Two aspects of the Lisp programming language greatly simplify the
+;;; analysis of Lisp programs:
+;;; o Lisp programs are naturally represented as data.
+;;; Successive definitions from a file are easily read in
+;;; as list structure.
+;;; o The basic syntax of Lisp is uniform. A list program
+;;; consists of a set of nested forms, where each form is
+;;; a list whose car is a tag (e.g., function name) that
+;;; specifies the structure of the rest of the form.
+;;; Thus Lisp programs, when represented as data, can be considered to be
+;;; parse trees. Given a grammar of syntax patterns for the language, XREF
+;;; recursively descends the parse tree for a given definition, computing
+;;; a set of relations that hold for the definition at each node in the
+;;; tree. For example, one kind of relation is that the function defined
+;;; by the definition calls the functions in its body. The relations are
+;;; stored in a database for later examination by the user.
+;;;
+;;; While XREF currently only works for programs written in Lisp, it could
+;;; be extended to other programming languages by writing a function to
+;;; generate parse trees for definitions in that language, and a core
+;;; set of patterns for the language's syntax.
+;;;
+;;; Since XREF normally does a static syntactic analysis of the program,
+;;; it does not detect references due to the expansion of a macro definition.
+;;; To do this in full generality XREF would have to have knowledge about the
+;;; semantics of the program (e.g., macros which call other functions to
+;;; do the expansion). This entails either modifying the compiler to
+;;; record the relationships (e.g., Symbolics Who-Calls Database) or doing
+;;; a walk of loaded code and macroexpanding as needed (PCL code walker).
+;;; The former is not portable, while the latter requires that the code
+;;; used by macros be loaded and in working order. On the other hand, then
+;;; we would need no special knowledge about macros (excluding the 24 special
+;;; forms of Lisp).
+;;;
+;;; Parameters may be set to enable macro expansion in XREF. Then XREF
+;;; will expand any macros for which it does not have predefined patterns.
+;;; (For example, most Lisps will implement dolist as a macro. Since XREF
+;;; has a pattern defined for dolist, it will not call macroexpand-1 on
+;;; a form whose car is dolist.) For this to work properly, the code must
+;;; be loaded before being processed by XREF, and XREF's parameters should
+;;; be set so that it processes forms in their proper packages.
+;;;
+;;; If macro expansion is disabled, the default rules for handling macro
+;;; references may not be sufficient for some user-defined macros, because
+;;; macros allow a variety of non-standard syntactic extensions to the
+;;; language. In this case, the user may specify additional templates in
+;;; a manner similar to that in which the core Lisp grammar was specified.
+;;;
+
+
+;;; ********************************
+;;; User Guide *********************
+;;; ********************************
+;;; -----
+;;; The following functions are called to cross reference the source files.
+;;;
+;;; XREF-FILES (&rest files) [FUNCTION]
+;;; Grovels over the lisp code located in source file FILES, using
+;;; xref-file.
+;;;
+;;; XREF-FILE (filename &optional clear-tables verbose) [Function]
+;;; Cross references the function and variable calls in FILENAME by
+;;; walking over the source code located in the file. Defaults type of
+;;; filename to ".lisp". Chomps on the code using record-callers and
+;;; record-callers*. If CLEAR-TABLES is T (the default), it clears the
+;;; callers database before processing the file. Specify CLEAR-TABLES as
+;;; nil to append to the database. If VERBOSE is T (the default), prints
+;;; out the name of the file, one progress dot for each form processed,
+;;; and the total number of forms.
+;;;
+;;; -----
+;;; The following functions display information about the uses of the
+;;; specified symbol as a function, variable, or constant.
+;;;
+;;; LIST-CALLERS (symbol) [FUNCTION]
+;;; Lists all functions which call SYMBOL as a function (function
+;;; invocation).
+;;;
+;;; LIST-READERS (symbol) [FUNCTION]
+;;; Lists all functions which refer to SYMBOL as a variable
+;;; (variable reference).
+;;;
+;;; LIST-SETTERS (symbol) [FUNCTION]
+;;; Lists all functions which bind/set SYMBOL as a variable
+;;; (variable mutation).
+;;;
+;;; LIST-USERS (symbol) [FUNCTION]
+;;; Lists all functions which use SYMBOL as a variable or function.
+;;;
+;;; WHO-CALLS (symbol &optional how) [FUNCTION]
+;;; Lists callers of symbol. HOW may be :function, :reader, :setter,
+;;; or :variable."
+;;;
+;;; WHAT-FILES-CALL (symbol) [FUNCTION]
+;;; Lists names of files that contain uses of SYMBOL
+;;; as a function, variable, or constant.
+;;;
+;;; SOURCE-FILE (symbol) [FUNCTION]
+;;; Lists the names of files in which SYMBOL is defined/used.
+;;;
+;;; LIST-CALLEES (symbol) [FUNCTION]
+;;; Lists names of functions and variables called by SYMBOL.
+;;;
+;;; -----
+;;; The following functions may be useful for viewing the database and
+;;; debugging the calling patterns.
+;;;
+;;; *LAST-FORM* () [VARIABLE]
+;;; The last form read from the file. Useful for figuring out what went
+;;; wrong when xref-file drops into the debugger.
+;;;
+;;; *XREF-VERBOSE* t [VARIABLE]
+;;; When T, xref-file(s) prints out the names of the files it looks at,
+;;; progress dots, and the number of forms read.
+;;;
+;;; *TYPES-TO-IGNORE* (quote (:lisp :lisp2)) [VARIABLE]
+;;; Default set of caller types (as specified in the patterns) to ignore
+;;; in the database handling functions. :lisp is CLtL 1st edition,
+;;; :lisp2 is additional patterns from CLtL 2nd edition.
+;;;
+;;; *HANDLE-PACKAGE-FORMS* () [VARIABLE]
+;;; When non-NIL, and XREF-FILE sees a package-setting form like
+;;; IN-PACKAGE, sets the current package to the specified package by
+;;; evaluating the form. When done with the file, xref-file resets the
+;;; package to its original value. In some of the displaying functions,
+;;; when this variable is non-NIL one may specify that all symbols from a
+;;; particular set of packages be ignored. This is only useful if the
+;;; files use different packages with conflicting names.
+;;;
+;;; *HANDLE-FUNCTION-FORMS* t [VARIABLE]
+;;; When T, XREF-FILE tries to be smart about forms which occur in
+;;; a function position, such as lambdas and arbitrary Lisp forms.
+;;; If so, it recursively calls record-callers with pattern 'FORM.
+;;; If the form is a lambda, makes the caller a caller of
+;;; :unnamed-lambda.
+;;;
+;;; *HANDLE-MACRO-FORMS* t [VARIABLE]
+;;; When T, if the file was loaded before being processed by XREF, and
+;;; the car of a form is a macro, it notes that the parent calls the
+;;; macro, and then calls macroexpand-1 on the form.
+;;;
+;;; *DEFAULT-GRAPHING-MODE* :call-graph [VARIABLE]
+;;; Specifies whether we graph up or down. If :call-graph, the children
+;;; of a node are the functions it calls. If :caller-graph, the
+;;; children of a node are the functions that call it.
+;;;
+;;; *INDENT-AMOUNT* 3 [VARIABLE]
+;;; Number of spaces to indent successive levels in PRINT-INDENTED-TREE.
+;;;
+;;; DISPLAY-DATABASE (&optional database types-to-ignore) [FUNCTION]
+;;; Prints out the name of each symbol and all its callers. Specify
+;;; database :callers (the default) to get function call references,
+;;; :file to the get files in which the symbol is called, :readers to get
+;;; variable references, and :setters to get variable binding and
+;;; assignments. Ignores functions of types listed in types-to-ignore.
+;;;
+;;; PRINT-CALLER-TREES (&key (mode *default-graphing-mode*) [FUNCTION]
+;;; (types-to-ignore *types-to-ignore*)
+;;; compact root-nodes)
+;;; Prints the calling trees (which may actually be a full graph and not
+;;; necessarily a DAG) as indented text trees using
+;;; PRINT-INDENTED-TREE. MODE is :call-graph for trees where the children
+;;; of a node are the functions called by the node, or :caller-graph for
+;;; trees where the children of a node are the functions the node calls.
+;;; TYPES-TO-IGNORE is a list of funcall types (as specified in the
+;;; patterns) to ignore in printing out the database. For example,
+;;; '(:lisp) would ignore all calls to common lisp functions. COMPACT is
+;;; a flag to tell the program to try to compact the trees a bit by not
+;;; printing trees if they have already been seen. ROOT-NODES is a list
+;;; of root nodes of trees to display. If ROOT-NODES is nil, tries to
+;;; find all root nodes in the database.
+;;;
+;;; MAKE-CALLER-TREE (&optional (mode *default-graphing-mode*) [FUNCTION]
+;;; (types-to-ignore *types-to-ignore*)
+;;; compact)
+;;; Outputs list structure of a tree which roughly represents the
+;;; possibly cyclical structure of the caller database.
+;;; If mode is :call-graph, the children of a node are the functions
+;;; it calls. If mode is :caller-graph, the children of a node are the
+;;; functions that call it.
+;;; If compact is T, tries to eliminate the already-seen nodes, so
+;;; that the graph for a node is printed at most once. Otherwise it will
+;;; duplicate the node's tree (except for cycles). This is usefull
+;;; because the call tree is actually a directed graph, so we can either
+;;; duplicate references or display only the first one.
+;;;
+;;; DETERMINE-FILE-DEPENDENCIES (&optional database) [FUNCTION]
+;;; Makes a hash table of file dependencies for the references listed in
+;;; DATABASE. This function may be useful for automatically resolving
+;;; file references for automatic creation of a system definition
+;;; (defsystem).
+;;;
+;;; PRINT-FILE-DEPENDENCIES (&optional database) [FUNCTION]
+;;; Prints a list of file dependencies for the references listed in
+;;; DATABASE. This function may be useful for automatically computing
+;;; file loading constraints for a system definition tool.
+;;;
+;;; WRITE-CALLERS-DATABASE-TO-FILE (filename) [FUNCTION]
+;;; Saves the contents of the current callers database to a file. This
+;;; file can be loaded to restore the previous contents of the
+;;; database. (For large systems it can take a long time to crunch
+;;; through the code, so this can save some time.)
+;;;
+;;; -----
+;;; The following macros define new function and macro call patterns.
+;;; They may be used to extend the static analysis tool to handle
+;;; new def forms, extensions to Common Lisp, and program defs.
+;;;
+;;; DEFINE-PATTERN-SUBSTITUTION (name pattern) [MACRO]
+;;; Defines NAME to be equivalent to the specified pattern. Useful for
+;;; making patterns more readable. For example, the LAMBDA-LIST is
+;;; defined as a pattern substitution, making the definition of the
+;;; DEFUN caller-pattern simpler.
+;;;
+;;; DEFINE-CALLER-PATTERN (name pattern &optional caller-type) [MACRO]
+;;; Defines NAME as a function/macro call with argument structure
+;;; described by PATTERN. CALLER-TYPE, if specified, assigns a type to
+;;; the pattern, which may be used to exclude references to NAME while
+;;; viewing the database. For example, all the Common Lisp definitions
+;;; have a caller-type of :lisp or :lisp2, so that you can exclude
+;;; references to common lisp functions from the calling tree.
+;;;
+;;; DEFINE-VARIABLE-PATTERN (name &optional caller-type) [MACRO]
+;;; Defines NAME as a variable reference of type CALLER-TYPE. This is
+;;; mainly used to establish the caller-type of the variable.
+;;;
+;;; DEFINE-CALLER-PATTERN-SYNONYMS (source destinations) [MACRO]
+;;; For defining function caller pattern syntax synonyms. For each name
+;;; in DESTINATIONS, defines its pattern as a copy of the definition
+;;; of SOURCE. Allows a large number of identical patterns to be defined
+;;; simultaneously. Must occur after the SOURCE has been defined.
+;;;
+;;; -----
+;;; This system includes pattern definitions for the latest
+;;; common lisp specification, as published in Guy Steele,
+;;; Common Lisp: The Language, 2nd Edition.
+;;;
+;;; Patterns may be either structures to match, or a predicate
+;;; like symbolp/numberp/stringp. The pattern specification language
+;;; is similar to the notation used in CLtL2, but in a more lisp-like
+;;; form:
+;;; (:eq name) The form element must be eq to the symbol NAME.
+;;; (:test test) TEST must be true when applied to the form element.
+;;; (:typep type) The form element must be of type TYPE.
+;;; (:or pat1 pat2 ...) Tries each of the patterns in left-to-right order,
+;;; until one succeeds.
+;;; Equivalent to { pat1 | pat2 | ... }
+;;; (:rest pattern) The remaining form elements are grouped into a
+;;; list which is matched against PATTERN.
+;;; (:optional pat1 ...) The patterns may optionally match against the
+;;; form element.
+;;; Equivalent to [ pat1 ... ].
+;;; (:star pat1 ...) The patterns may match against the patterns
+;;; any number of times, including 0.
+;;; Equivalent to { pat1 ... }*.
+;;; (:plus pat1 ...) The patterns may match against the patterns
+;;; any number of times, but at least once.
+;;; Equivalent to { pat1 ... }+.
+;;; &optional, &key, Similar in behavior to the corresponding
+;;; &rest lambda-list keywords.
+;;; FORM A random lisp form. If a cons, assumes the
+;;; car is a function or macro and tries to
+;;; match the args against that symbol's pattern.
+;;; If a symbol, assumes it's a variable reference.
+;;; :ignore Ignores the corresponding form element.
+;;; NAME The corresponding form element should be
+;;; the name of a new definition (e.g., the
+;;; first arg in a defun pattern is NAME.
+;;; FUNCTION, MACRO The corresponding form element should be
+;;; a function reference not handled by FORM.
+;;; Used in the definition of apply and funcall.
+;;; VAR The corresponding form element should be
+;;; a variable definition or mutation. Used
+;;; in the definition of let, let*, etc.
+;;; VARIABLE The corresponding form element should be
+;;; a variable reference.
+;;;
+;;; In all other pattern symbols, it looks up the symbols pattern substitution
+;;; and recursively matches against the pattern. Automatically destructures
+;;; list structure that does not include consing dots.
+;;;
+;;; Among the pattern substitution names defined are:
+;;; STRING, SYMBOL, NUMBER Appropriate :test patterns.
+;;; LAMBDA-LIST Matches against a lambda list.
+;;; BODY Matches against a function body definition.
+;;; FN Matches against #'function, 'function,
+;;; and lambdas. This is used in the definition
+;;; of apply, funcall, and the mapping patterns.
+;;; and others...
+;;;
+;;; Here's some sample pattern definitions:
+;;; (define-caller-pattern defun
+;;; (name lambda-list
+;;; (:star (:or documentation-string declaration))
+;;; (:star form))
+;;; :lisp)
+;;; (define-caller-pattern funcall (fn (:star form)) :lisp)
+;;;
+;;; In general, the system is intelligent enough to handle any sort of
+;;; simple funcall. One only need specify the syntax for functions and
+;;; macros which use optional arguments, keyword arguments, or some
+;;; argument positions are special, such as in apply and funcall, or
+;;; to indicate that the function is of the specified caller type.
+;;;
+;;;
+;;; NOTES:
+;;;
+;;; XRef assumes syntactically correct lisp code.
+;;;
+;;; This is by no means perfect. For example, let and let* are treated
+;;; identically, instead of differentiating between serial and parallel
+;;; binding. But it's still a useful tool. It can be helpful in
+;;; maintaining code, debugging problems with patch files, determining
+;;; whether functions are multiply defined, and help you remember where
+;;; a function is defined or called.
+;;;
+;;; XREF runs best when compiled.
+
+;;; ********************************
+;;; References *********************
+;;; ********************************
+;;;
+;;; Xerox Interlisp Masterscope Program:
+;;; Larry M Masinter, Global program analysis in an interactive environment
+;;; PhD Thesis, Stanford University, 1980.
+;;;
+;;; Symbolics Who-Calls Database:
+;;; User's Guide to Symbolics Computers, Volume 1, Cambridge, MA, July 1986
+;;; Genera 7.0, pp 183-185.
+;;;
+
+;;; ********************************
+;;; Example ************************
+;;; ********************************
+;;;
+;;; Here is an example of running XREF on a short program.
+;;; [In Scribe documentation, give a simple short program and resulting
+;;; XREF output, including postscript call graphs.]
+#|
+<cl> (xref:xref-file "/afs/cs/user/mkant/Lisp/Graph-Dag/graph-dag.lisp")
+Cross-referencing file /afs/cs/user/mkant/Lisp/Graph-Dag/graph-dag.lisp.
+................................................
+48 forms processed.
+<cl> (xref:display-database :readers)
+
+*DISPLAY-CUTOFF-DEPTH* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE CALCULATE-POSITION-IN-LEVEL.
+*OFFSET-FROM-EDGE-OF-PANE* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE.
+*WITHIN-LEVEL-SPACING* is referenced by BREADTH CALCULATE-POSITION-INFO.
+*DIRECTION* is referenced by CREATE-POSITION-INFO.
+*LINK-OFFSET* is referenced by OFFSET-OF-LINK-FROM-ATTACHMENT-POINT.
+*ROOT-IS-SEQUENCE* is referenced by GRAPH.
+*LEVEL-SPACING* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE.
+*ORIENTATION* is referenced by BREADTH CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE CALCULATE-POSITION-IN-LEVEL.
+*DEFAULT-GRAPH-POSITION* is referenced by CREATE-POSITION-INFO.
+*GRAPHING-CUTOFF-DEPTH* is referenced by CREATE-NODE-STRUCTURE.
+*LIST-OF-NODES* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE CREATE-NODE FIND-NODE.
+*GRAPH-TYPE* is referenced by CREATE-NODE-STRUCTURE.
+<cl> (xref:print-caller-trees :root-nodes '(display-graph))
+
+Rooted calling trees:
+ DISPLAY-GRAPH
+ CREATE-POSITION-INFO
+ CALCULATE-POSITION-INFO
+ CALCULATE-POSITION
+ NODE-POSITION-ALREADY-SET-FLAG
+ NODE-LEVEL-ALREADY-SET-FLAG
+ CALCULATE-POSITION-IN-LEVEL
+ NODE-CHILDREN
+ NODE-LEVEL
+ CALCULATE-POSITION
+ NEW-CALCULATE-BREADTH
+ NODE-CHILDREN
+ BREADTH
+ OPPOSITE-DIMENSION
+ NODE-HEIGHT
+ NODE-WIDTH
+ NEW-CALCULATE-BREADTH
+ NODE-PARENTS
+ OPPOSITE-DIMENSION
+ NODE-HEIGHT
+ NODE-WIDTH
+ OPPOSITE-POSITION
+ NODE-Y
+ NODE-X
+ NODE-LEVEL
+ CALCULATE-LEVEL-POSITION
+ NODE-LEVEL
+ NODE-POSITION
+ NODE-X
+ NODE-Y
+ DIMENSION
+ NODE-WIDTH
+ NODE-HEIGHT
+ CALCULATE-LEVEL-POSITION-BEFORE
+ NODE-LEVEL
+ NODE-POSITION
+ NODE-X
+ NODE-Y
+ NODE-WIDTH
+ NODE-HEIGHT
+ DIMENSION
+ NODE-WIDTH
+ NODE-HEIGHT
+|#
+
+;;; ****************************************************************
+;;; List Callers ***************************************************
+;;; ****************************************************************
+
+(defpackage :pxref
+ (:use :common-lisp)
+ (:export #:list-callers
+ #:list-users
+ #:list-readers
+ #:list-setters
+ #:what-files-call
+ #:who-calls
+ #:list-callees
+ #:source-file
+ #:clear-tables
+ #:define-pattern-substitution
+ #:define-caller-pattern
+ #:define-variable-pattern
+ #:define-caller-pattern-synonyms
+ #:clear-patterns
+ #:*last-form*
+ #:*xref-verbose*
+ #:*handle-package-forms*
+ #:*handle-function-forms*
+ #:*handle-macro-forms*
+ #:*types-to-ignore*
+ #:*last-caller-tree*
+ #:*default-graphing-mode*
+ #:*indent-amount*
+ #:xref-file
+ #:xref-files
+ #:write-callers-database-to-file
+ #:display-database
+ #:print-caller-trees
+ #:make-caller-tree
+ #:print-indented-tree
+ #:determine-file-dependencies
+ #:print-file-dependencies
+ #:psgraph-xref
+ ))
+
+(in-package "PXREF")
+
+;;; Warn user if they're loading the source instead of compiling it first.
+;(eval-when (compile load eval)
+; (defvar compiled-p nil))
+;(eval-when (compile load)
+; (setq compiled-p t))
+;(eval-when (load eval)
+; (unless compiled-p
+; (warn "This file should be compiled before loading for best results.")))
+(eval-when (eval)
+ (warn "This file should be compiled before loading for best results."))
+
+
+;;; ********************************
+;;; Primitives *********************
+;;; ********************************
+(defun lookup (symbol environment)
+ (dolist (frame environment)
+ (when (member symbol frame)
+ (return symbol))))
+
+(defun car-eq (list item)
+ (and (consp list)
+ (eq (car list) item)))
+
+;;; ********************************
+;;; Callers Database ***************
+;;; ********************************
+(defvar *file-callers-database* (make-hash-table :test #'equal)
+ "Contains name and list of file callers (files which call) for that name.")
+(defvar *callers-database* (make-hash-table :test #'equal)
+ "Contains name and list of callers (function invocation) for that name.")
+(defvar *readers-database* (make-hash-table :test #'equal)
+ "Contains name and list of readers (variable use) for that name.")
+(defvar *setters-database* (make-hash-table :test #'equal)
+ "Contains name and list of setters (variable mutation) for that name.")
+(defvar *callees-database* (make-hash-table :test #'equal)
+ "Contains name and list of functions and variables it calls.")
+(defun callers-list (name &optional (database :callers))
+ (case database
+ (:file (gethash name *file-callers-database*))
+ (:callees (gethash name *callees-database*))
+ (:callers (gethash name *callers-database*))
+ (:readers (gethash name *readers-database*))
+ (:setters (gethash name *setters-database*))))
+(defsetf callers-list (name &optional (database :callers)) (caller)
+ `(setf (gethash ,name (case ,database
+ (:file *file-callers-database*)
+ (:callees *callees-database*)
+ (:callers *callers-database*)
+ (:readers *readers-database*)
+ (:setters *setters-database*)))
+ ,caller))
+
+(defun list-callers (symbol)
+ "Lists all functions which call SYMBOL as a function (function invocation)."
+ (callers-list symbol :callers))
+(defun list-readers (symbol)
+ "Lists all functions which refer to SYMBOL as a variable
+ (variable reference)."
+ (callers-list symbol :readers))
+(defun list-setters (symbol)
+ "Lists all functions which bind/set SYMBOL as a variable
+ (variable mutation)."
+ (callers-list symbol :setters))
+(defun list-users (symbol)
+ "Lists all functions which use SYMBOL as a variable or function."
+ (values (list-callers symbol)
+ (list-readers symbol)
+ (list-setters symbol)))
+(defun who-calls (symbol &optional how)
+ "Lists callers of symbol. HOW may be :function, :reader, :setter,
+ or :variable."
+ ;; would be nice to have :macro and distinguish variable
+ ;; binding from assignment. (i.e., variable binding, assignment, and use)
+ (case how
+ (:function (list-callers symbol))
+ (:reader (list-readers symbol))
+ (:setter (list-setters symbol))
+ (:variable (append (list-readers symbol)
+ (list-setters symbol)))
+ (otherwise (append (list-callers symbol)
+ (list-readers symbol)
+ (list-setters symbol)))))
+(defun what-files-call (symbol)
+ "Lists names of files that contain uses of SYMBOL
+ as a function, variable, or constant."
+ (callers-list symbol :file))
+(defun list-callees (symbol)
+ "Lists names of functions and variables called by SYMBOL."
+ (callers-list symbol :callees))
+
+(defvar *source-file* (make-hash-table :test #'equal)
+ "Contains function name and source file for that name.")
+(defun source-file (symbol)
+ "Lists the names of files in which SYMBOL is defined/used."
+ (gethash symbol *source-file*))
+(defsetf source-file (name) (value)
+ `(setf (gethash ,name *source-file*) ,value))
+
+(defun clear-tables ()
+ (clrhash *file-callers-database*)
+ (clrhash *callers-database*)
+ (clrhash *callees-database*)
+ (clrhash *readers-database*)
+ (clrhash *setters-database*)
+ (clrhash *source-file*))
+
+
+;;; ********************************
+;;; Pattern Database ***************
+;;; ********************************
+;;; Pattern Types
+(defvar *pattern-caller-type* (make-hash-table :test #'equal))
+(defun pattern-caller-type (name)
+ (gethash name *pattern-caller-type*))
+(defsetf pattern-caller-type (name) (value)
+ `(setf (gethash ,name *pattern-caller-type*) ,value))
+
+;;; Pattern Substitutions
+(defvar *pattern-substitution-table* (make-hash-table :test #'equal)
+ "Stores general patterns for function destructuring.")
+(defun lookup-pattern-substitution (name)
+ (gethash name *pattern-substitution-table*))
+(defmacro define-pattern-substitution (name pattern)
+ "Defines NAME to be equivalent to the specified pattern. Useful for
+ making patterns more readable. For example, the LAMBDA-LIST is
+ defined as a pattern substitution, making the definition of the
+ DEFUN caller-pattern simpler."
+ `(setf (gethash ',name *pattern-substitution-table*)
+ ',pattern))
+
+;;; Function/Macro caller patterns:
+;;; The car of the form is skipped, so we don't need to specify
+;;; (:eq function-name) like we would for a substitution.
+;;;
+;;; Patterns must be defined in the XREF package because the pattern
+;;; language is tested by comparing symbols (using #'equal) and not
+;;; their printreps. This is fine for the lisp grammer, because the XREF
+;;; package depends on the LISP package, so a symbol like 'xref::cons is
+;;; translated automatically into 'lisp::cons. However, since
+;;; (equal 'foo::bar 'baz::bar) returns nil unless both 'foo::bar and
+;;; 'baz::bar are inherited from the same package (e.g., LISP),
+;;; if package handling is turned on the user must specify package
+;;; names in the caller pattern definitions for functions that occur
+;;; in packages other than LISP, otherwise the symbols will not match.
+;;;
+;;; Perhaps we should enforce the definition of caller patterns in the
+;;; XREF package by wrapping the body of define-caller-pattern in
+;;; the XREF package:
+;;; (defmacro define-caller-pattern (name value &optional caller-type)
+;;; (let ((old-package *package*))
+;;; (setf *package* (find-package "XREF"))
+;;; (prog1
+;;; `(progn
+;;; (when ',caller-type
+;;; (setf (pattern-caller-type ',name) ',caller-type))
+;;; (when ',value
+;;; (setf (gethash ',name *caller-pattern-table*)
+;;; ',value)))
+;;; (setf *package* old-package))))
+;;; Either that, or for the purpose of pattern testing we should compare
+;;; printreps. [The latter makes the primitive patterns like VAR
+;;; reserved words.]
+(defvar *caller-pattern-table* (make-hash-table :test #'equal)
+ "Stores patterns for function destructuring.")
+(defun lookup-caller-pattern (name)
+ (gethash name *caller-pattern-table*))
+(defmacro define-caller-pattern (name pattern &optional caller-type)
+ "Defines NAME as a function/macro call with argument structure
+ described by PATTERN. CALLER-TYPE, if specified, assigns a type to
+ the pattern, which may be used to exclude references to NAME while
+ viewing the database. For example, all the Common Lisp definitions
+ have a caller-type of :lisp or :lisp2, so that you can exclude
+ references to common lisp functions from the calling tree."
+ `(progn
+ (when ',caller-type
+ (setf (pattern-caller-type ',name) ',caller-type))
+ (when ',pattern
+ (setf (gethash ',name *caller-pattern-table*)
+ ',pattern))))
+
+;;; For defining variables
+(defmacro define-variable-pattern (name &optional caller-type)
+ "Defines NAME as a variable reference of type CALLER-TYPE. This is
+ mainly used to establish the caller-type of the variable."
+ `(progn
+ (when ',caller-type
+ (setf (pattern-caller-type ',name) ',caller-type))))
+
+;;; For defining synonyms. Means much less space taken up by the patterns.
+(defmacro define-caller-pattern-synonyms (source destinations)
+ "For defining function caller pattern syntax synonyms. For each name
+ in DESTINATIONS, defines its pattern as a copy of the definition of SOURCE.
+ Allows a large number of identical patterns to be defined simultaneously.
+ Must occur after the SOURCE has been defined."
+ `(let ((source-type (pattern-caller-type ',source))
+ (source-pattern (gethash ',source *caller-pattern-table*)))
+ (when source-type
+ (dolist (dest ',destinations)
+ (setf (pattern-caller-type dest) source-type)))
+ (when source-pattern
+ (dolist (dest ',destinations)
+ (setf (gethash dest *caller-pattern-table*)
+ source-pattern)))))
+
+(defun clear-patterns ()
+ (clrhash *pattern-substitution-table*)
+ (clrhash *caller-pattern-table*)
+ (clrhash *pattern-caller-type*))
+
+;;; ********************************
+;;; Cross Reference Files **********
+;;; ********************************
+(defvar *last-form* ()
+ "The last form read from the file. Useful for figuring out what went wrong
+ when xref-file drops into the debugger.")
+
+(defvar *xref-verbose* t
+ "When T, xref-file(s) prints out the names of the files it looks at,
+ progress dots, and the number of forms read.")
+
+;;; This needs to first clear the tables?
+(defun xref-files (&rest files)
+ "Grovels over the lisp code located in source file FILES, using xref-file."
+ ;; If the arg is a list, use it.
+ (when (listp (car files)) (setq files (car files)))
+ (dolist (file files)
+ (xref-file file nil))
+ (values))
+
+(defvar *handle-package-forms* nil ;'(lisp::in-package)
+ "When non-NIL, and XREF-FILE sees a package-setting form like IN-PACKAGE,
+ sets the current package to the specified package by evaluating the
+ form. When done with the file, xref-file resets the package to its
+ original value. In some of the displaying functions, when this variable
+ is non-NIL one may specify that all symbols from a particular set of
+ packages be ignored. This is only useful if the files use different
+ packages with conflicting names.")
+
+(defvar *normal-readtable* (copy-readtable nil)
+ "Normal, unadulterated CL readtable.")
+
+(defun xref-file (filename &optional (clear-tables t) (verbose *xref-verbose*))
+ "Cross references the function and variable calls in FILENAME by
+ walking over the source code located in the file. Defaults type of
+ filename to \".lisp\". Chomps on the code using record-callers and
+ record-callers*. If CLEAR-TABLES is T (the default), it clears the callers
+ database before processing the file. Specify CLEAR-TABLES as nil to
+ append to the database. If VERBOSE is T (the default), prints out the
+ name of the file, one progress dot for each form processed, and the
+ total number of forms."
+ ;; Default type to "lisp"
+ (when (and (null (pathname-type filename))
+ (not (probe-file filename)))
+ (cond ((stringp filename)
+ (setf filename (concatenate 'string filename ".lisp")))
+ ((pathnamep filename)
+ (setf filename (merge-pathnames filename
+ (make-pathname :type "lisp"))))))
+ (when clear-tables (clear-tables))
+ (let ((count 0)
+ (old-package *package*)
+ (*readtable* *normal-readtable*))
+ (when verbose
+ (format t "~&Cross-referencing file ~A.~&" filename))
+ (with-open-file (stream filename :direction :input)
+ (do ((form (read stream nil :eof) (read stream nil :eof)))
+ ((eq form :eof))
+ (incf count)
+ (when verbose
+ (format *standard-output* ".")
+ (force-output *standard-output*))
+ (setq *last-form* form)
+ (record-callers filename form)
+ ;; Package Magic.
+ (when (and *handle-package-forms*
+ (consp form)
+ (member (car form) *handle-package-forms*))
+ (eval form))))
+ (when verbose
+ (format t "~&~D forms processed." count))
+ (setq *package* old-package)
+ (values)))
+
+(defvar *handle-function-forms* t
+ "When T, XREF-FILE tries to be smart about forms which occur in
+ a function position, such as lambdas and arbitrary Lisp forms.
+ If so, it recursively calls record-callers with pattern 'FORM.
+ If the form is a lambda, makes the caller a caller of :unnamed-lambda.")
+
+(defvar *handle-macro-forms* t
+ "When T, if the file was loaded before being processed by XREF, and the
+ car of a form is a macro, it notes that the parent calls the macro,
+ and then calls macroexpand-1 on the form.")
+
+(defvar *callees-database-includes-variables* nil)
+
+(defun record-callers (filename form
+ &optional pattern parent (environment nil)
+ funcall)
+ "RECORD-CALLERS is the main routine used to walk down the code. It matches
+ the PATTERN against the FORM, possibly adding statements to the database.
+ PARENT is the name defined by the current outermost definition; it is
+ the caller of the forms in the body (e.g., FORM). ENVIRONMENT is used
+ to keep track of the scoping of variables. FUNCALL deals with the type
+ of variable assignment and hence how the environment should be modified.
+ RECORD-CALLERS handles atomic patterns and simple list-structure patterns.
+ For complex list-structure pattern destructuring, it calls RECORD-CALLERS*."
+; (when form)
+ (unless pattern (setq pattern 'FORM))
+ (cond ((symbolp pattern)
+ (case pattern
+ (:IGNORE
+ ;; Ignores the rest of the form.
+ (values t parent environment))
+ (NAME
+ ;; This is the name of a new definition.
+ (push filename (source-file form))
+ (values t form environment))
+ ((FUNCTION MACRO)
+ ;; This is the name of a call.
+ (cond ((and *handle-function-forms* (consp form))
+ ;; If we're a cons and special handling is on,
+ (when (eq (car form) 'lambda)
+ (pushnew filename (callers-list :unnamed-lambda :file))
+ (when parent
+ (pushnew parent (callers-list :unnamed-lambda
+ :callers))
+ (pushnew :unnamed-lambda (callers-list parent
+ :callees))))
+ (record-callers filename form 'form parent environment))
+ (t
+ ;; If we're just a regular function name call.
+ (pushnew filename (callers-list form :file))
+ (when parent
+ (pushnew parent (callers-list form :callers))
+ (pushnew form (callers-list parent :callees)))
+ (values t parent environment))))
+ (VAR
+ ;; This is the name of a new variable definition.
+ ;; Includes arglist parameters.
+ (when (and (symbolp form) (not (keywordp form))
+ (not (member form lambda-list-keywords)))
+ (pushnew form (car environment))
+ (pushnew filename (callers-list form :file))
+ (when parent
+; (pushnew form (callers-list parent :callees))
+ (pushnew parent (callers-list form :setters)))
+ (values t parent environment)))
+ (VARIABLE
+ ;; VAR reference
+ (pushnew filename (callers-list form :file))
+ (when (and parent (not (lookup form environment)))
+ (pushnew parent (callers-list form :readers))
+ (when *callees-database-includes-variables*
+ (pushnew form (callers-list parent :callees))))
+ (values t parent environment))
+ (FORM
+ ;; A random form (var or funcall).
+ (cond ((consp form)
+ ;; Get new pattern from TAG.
+ (let ((new-pattern (lookup-caller-pattern (car form))))
+ (pushnew filename (callers-list (car form) :file))
+ (when parent
+ (pushnew parent (callers-list (car form) :callers))
+ (pushnew (car form) (callers-list parent :callees)))
+ (cond ((and new-pattern (cdr form))
+ ;; Special Pattern and there's stuff left
+ ;; to be processed. Note that we check if
+ ;; a pattern is defined for the form before
+ ;; we check to see if we can macroexpand it.
+ (record-callers filename (cdr form) new-pattern
+ parent environment :funcall))
+ ((and *handle-macro-forms*
+ (symbolp (car form)) ; pnorvig 9/9/93
+ (macro-function (car form)))
+ ;; The car of the form is a macro and
+ ;; macro processing is turned on. Macroexpand-1
+ ;; the form and try again.
+ (record-callers filename
+ (macroexpand-1 form)
+ 'form parent environment
+ :funcall))
+ ((null (cdr form))
+ ;; No more left to be processed. Note that
+ ;; this must occur after the macros clause,
+ ;; since macros can expand into more code.
+ (values t parent environment))
+ (t
+ ;; Random Form. We assume it is a function call.
+ (record-callers filename (cdr form)
+ '((:star FORM))
+ parent environment :funcall)))))
+ (t
+ (when (and (not (lookup form environment))
+ (not (numberp form))
+ ;; the following line should probably be
+ ;; commented out?
+ (not (keywordp form))
+ (not (stringp form))
+ (not (eq form t))
+ (not (eq form nil)))
+ (pushnew filename (callers-list form :file))
+ ;; ??? :callers
+ (when parent
+ (pushnew parent (callers-list form :readers))
+ (when *callees-database-includes-variables*
+ (pushnew form (callers-list parent :callees)))))
+ (values t parent environment))))
+ (otherwise
+ ;; Pattern Substitution
+ (let ((new-pattern (lookup-pattern-substitution pattern)))
+ (if new-pattern
+ (record-callers filename form new-pattern
+ parent environment)
+ (when (eq pattern form)
+ (values t parent environment)))))))
+ ((consp pattern)
+ (case (car pattern)
+ (:eq (when (eq (second pattern) form)
+ (values t parent environment)))
+ (:test (when (funcall (eval (second pattern)) form)
+ (values t parent environment)))
+ (:typep (when (typep form (second pattern))
+ (values t parent environment)))
+ (:or (dolist (subpat (rest pattern))
+ (multiple-value-bind (processed parent environment)
+ (record-callers filename form subpat
+ parent environment)
+ (when processed
+ (return (values processed parent environment))))))
+ (:rest ; (:star :plus :optional :rest)
+ (record-callers filename form (second pattern)
+ parent environment))
+ (otherwise
+ (multiple-value-bind (d p env)
+ (record-callers* filename form pattern
+ parent (cons nil environment))
+ (values d p (if funcall environment env))))))))
+
+(defun record-callers* (filename form pattern parent environment
+ &optional continuation
+ in-optionals in-keywords)
+ "RECORD-CALLERS* handles complex list-structure patterns, such as
+ ordered lists of subpatterns, patterns involving :star, :plus,
+ &optional, &key, &rest, and so on. CONTINUATION is a stack of
+ unprocessed patterns, IN-OPTIONALS and IN-KEYWORDS are corresponding
+ stacks which determine whether &rest or &key has been seen yet in
+ the current pattern."
+ ;; form must be a cons or nil.
+; (when form)
+ (if (null pattern)
+ (if (null continuation)
+ (values t parent environment)
+ (record-callers* filename form (car continuation) parent environment
+ (cdr continuation)
+ (cdr in-optionals)
+ (cdr in-keywords)))
+ (let ((pattern-elt (car pattern)))
+ (cond ((car-eq pattern-elt :optional)
+ (if (null form)
+ (values t parent environment)
+ (multiple-value-bind (processed par env)
+ (record-callers* filename form (cdr pattern-elt)
+ parent environment
+ (cons (cdr pattern) continuation)
+ (cons (car in-optionals) in-optionals)
+ (cons (car in-keywords) in-keywords))
+ (if processed
+ (values processed par env)
+ (record-callers* filename form (cdr pattern)
+ parent environment continuation
+ in-optionals in-keywords)))))
+ ((car-eq pattern-elt :star)
+ (if (null form)
+ (values t parent environment)
+ (multiple-value-bind (processed par env)
+ (record-callers* filename form (cdr pattern-elt)
+ parent environment
+ (cons pattern continuation)
+ (cons (car in-optionals) in-optionals)
+ (cons (car in-keywords) in-keywords))
+ (if processed
+ (values processed par env)
+ (record-callers* filename form (cdr pattern)
+ parent environment continuation
+ in-optionals in-keywords)))))
+ ((car-eq pattern-elt :plus)
+ (record-callers* filename form (cdr pattern-elt)
+ parent environment
+ (cons (cons (cons :star (cdr pattern-elt))
+ (cdr pattern))
+ continuation)
+ (cons (car in-optionals) in-optionals)
+ (cons (car in-keywords) in-keywords)))
+ ((car-eq pattern-elt :rest)
+ (record-callers filename form pattern-elt parent environment))
+ ((eq pattern-elt '&optional)
+ (record-callers* filename form (cdr pattern)
+ parent environment continuation
+ (cons t in-optionals)
+ (cons (car in-keywords) in-keywords)))
+ ((eq pattern-elt '&rest)
+ (record-callers filename form (second pattern)
+ parent environment))
+ ((eq pattern-elt '&key)
+ (record-callers* filename form (cdr pattern)
+ parent environment continuation
+ (cons (car in-optionals) in-optionals)
+ (cons t in-keywords)))
+ ((null form)
+ (when (or (car in-keywords) (car in-optionals))
+ (values t parent environment)))
+ ((consp form)
+ (multiple-value-bind (processed parent environment)
+ (record-callers filename (if (car in-keywords)
+ (cadr form)
+ (car form))
+ pattern-elt
+ parent environment)
+ (cond (processed
+ (record-callers* filename (if (car in-keywords)
+ (cddr form)
+ (cdr form))
+ (cdr pattern)
+ parent environment
+ continuation
+ in-optionals in-keywords))
+ ((or (car in-keywords)
+ (car in-optionals))
+ (values t parent environment)))))))))
+
+
+;;; ********************************
+;;; Misc Utilities *****************
+;;; ********************************
+(defvar *types-to-ignore*
+ '(:lisp ; CLtL 1st Edition
+ :lisp2 ; CLtL 2nd Edition additional patterns
+ )
+ "Default set of caller types (as specified in the patterns) to ignore
+ in the database handling functions. :lisp is CLtL 1st edition,
+ :lisp2 is additional patterns from CLtL 2nd edition.")
+
+(defun display-database (&optional (database :callers)
+ (types-to-ignore *types-to-ignore*))
+ "Prints out the name of each symbol and all its callers. Specify database
+ :callers (the default) to get function call references, :fill to the get
+ files in which the symbol is called, :readers to get variable references,
+ and :setters to get variable binding and assignments. Ignores functions
+ of types listed in types-to-ignore."
+ (maphash #'(lambda (name callers)
+ (unless (or (member (pattern-caller-type name)
+ types-to-ignore)
+ ;; When we're doing fancy package crap,
+ ;; allow us to ignore symbols based on their
+ ;; packages.
+ (when *handle-package-forms*
+ (member (symbol-package name)
+ types-to-ignore
+ :key #'find-package)))
+ (format t "~&~S is referenced by~{ ~S~}."
+ name callers)))
+ (ecase database
+ (:file *file-callers-database*)
+ (:callers *callers-database*)
+ (:readers *readers-database*)
+ (:setters *setters-database*))))
+
+(defun write-callers-database-to-file (filename)
+ "Saves the contents of the current callers database to a file. This
+ file can be loaded to restore the previous contents of the
+ database. (For large systems it can take a long time to crunch
+ through the code, so this can save some time.)"
+ (with-open-file (stream filename :direction :output)
+ (format stream "~&(clear-tables)")
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (source-file '~S) '~S)"
+ x y))
+ *source-file*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :file) '~S)"
+ x y))
+ *file-callers-database*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :callers) '~S)"
+ x y))
+ *callers-database*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :callees) '~S)"
+ x y))
+ *callees-database*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :readers) '~S)"
+ x y))
+ *readers-database*)
+ (maphash #'(lambda (x y)
+ (format stream "~&(setf (callers-list '~S :setters) '~S)"
+ x y))
+ *setters-database*)))
+
+
+;;; ********************************
+;;; Print Caller Trees *************
+;;; ********************************
+;;; The following function is useful for reversing a caller table into
+;;; a callee table. Possibly later we'll extend xref to create two
+;;; such database hash tables. Needs to include vars as well.
+(defun invert-hash-table (table &optional (types-to-ignore *types-to-ignore*))
+ "Makes a copy of the hash table in which (name value*) pairs
+ are inverted to (value name*) pairs."
+ (let ((target (make-hash-table :test #'equal)))
+ (maphash #'(lambda (key values)
+ (dolist (value values)
+ (unless (member (pattern-caller-type key)
+ types-to-ignore)
+ (pushnew key (gethash value target)))))
+ table)
+ target))
+
+;;; Resolve file references for automatic creation of a defsystem file.
+(defun determine-file-dependencies (&optional (database *callers-database*))
+ "Makes a hash table of file dependencies for the references listed in
+ DATABASE. This function may be useful for automatically resolving
+ file references for automatic creation of a system definition (defsystem)."
+ (let ((file-ref-ht (make-hash-table :test #'equal)))
+ (maphash #'(lambda (key values)
+ (let ((key-file (source-file key)))
+ (when key
+ (dolist (value values)
+ (let ((value-file (source-file value)))
+ (when value-file
+ (dolist (s key-file)
+ (dolist (d value-file)
+ (pushnew d (gethash s file-ref-ht))))))))))
+ database)
+ file-ref-ht))
+
+(defun print-file-dependencies (&optional (database *callers-database*))
+ "Prints a list of file dependencies for the references listed in DATABASE.
+ This function may be useful for automatically computing file loading
+ constraints for a system definition tool."
+ (maphash #'(lambda (key value) (format t "~&~S --> ~S" key value))
+ (determine-file-dependencies database)))
+
+;;; The following functions demonstrate a possible way to interface
+;;; xref to a graphical browser such as psgraph to mimic the capabilities
+;;; of Masterscope's graphical browser.
+
+(defvar *last-caller-tree* nil)
+
+(defvar *default-graphing-mode* :call-graph
+ "Specifies whether we graph up or down. If :call-graph, the children
+ of a node are the functions it calls. If :caller-graph, the children
+ of a node are the functions that call it.")
+
+(defun gather-tree (parents &optional already-seen
+ (mode *default-graphing-mode*)
+ (types-to-ignore *types-to-ignore*) compact)
+ "Extends the tree, copying it into list structure, until it repeats
+ a reference (hits a cycle)."
+ (let ((*already-seen* nil)
+ (database (case mode
+ (:call-graph *callees-database*)
+ (:caller-graph *callers-database*))))
+ (declare (special *already-seen*))
+ (labels
+ ((amass-tree
+ (parents &optional already-seen)
+ (let (result this-item)
+ (dolist (parent parents)
+ (unless (member (pattern-caller-type parent)
+ types-to-ignore)
+ (pushnew parent *already-seen*)
+ (if (member parent already-seen)
+ (setq this-item nil) ; :ignore
+ (if compact
+ (multiple-value-setq (this-item already-seen)
+ (amass-tree (gethash parent database)
+ (cons parent already-seen)))
+ (setq this-item
+ (amass-tree (gethash parent database)
+ (cons parent already-seen)))))
+ (setq parent (format nil "~S" parent))
+ (when (consp parent) (setq parent (cons :xref-list parent)))
+ (unless (eq this-item :ignore)
+ (push (if this-item
+ (list parent this-item)
+ parent)
+ result))))
+ (values result ;(reverse result)
+ already-seen))))
+ (values (amass-tree parents already-seen)
+ *already-seen*))))
+
+(defun find-roots-and-cycles (&optional (mode *default-graphing-mode*)
+ (types-to-ignore *types-to-ignore*))
+ "Returns a list of uncalled callers (roots) and called callers (potential
+ cycles)."
+ (let ((uncalled-callers nil)
+ (called-callers nil)
+ (database (ecase mode
+ (:call-graph *callers-database*)
+ (:caller-graph *callees-database*)))
+ (other-database (ecase mode
+ (:call-graph *callees-database*)
+ (:caller-graph *callers-database*))))
+ (maphash #'(lambda (name value)
+ (declare (ignore value))
+ (unless (member (pattern-caller-type name)
+ types-to-ignore)
+ (if (gethash name database)
+ (push name called-callers)
+ (push name uncalled-callers))))
+ other-database)
+ (values uncalled-callers called-callers)))
+
+(defun make-caller-tree (&optional (mode *default-graphing-mode*)
+ (types-to-ignore *types-to-ignore*) compact)
+ "Outputs list structure of a tree which roughly represents the possibly
+ cyclical structure of the caller database.
+ If mode is :call-graph, the children of a node are the functions it calls.
+ If mode is :caller-graph, the children of a node are the functions that
+ call it.
+ If compact is T, tries to eliminate the already-seen nodes, so that
+ the graph for a node is printed at most once. Otherwise it will duplicate
+ the node's tree (except for cycles). This is usefull because the call tree
+ is actually a directed graph, so we can either duplicate references or
+ display only the first one."
+ ;; Would be nice to print out line numbers and whenever we skip a duplicated
+ ;; reference, print the line number of the full reference after the node.
+ (multiple-value-bind (uncalled-callers called-callers)
+ (find-roots-and-cycles mode types-to-ignore)
+ (multiple-value-bind (trees already-seen)
+ (gather-tree uncalled-callers nil mode types-to-ignore compact)
+ (setq *last-caller-tree* trees)
+ (let ((more-trees (gather-tree (set-difference called-callers
+ already-seen)
+ already-seen
+ mode types-to-ignore compact)))
+ (values trees more-trees)))))
+
+(defvar *indent-amount* 3
+ "Number of spaces to indent successive levels in PRINT-INDENTED-TREE.")
+
+(defun print-indented-tree (trees &optional (indent 0))
+ "Simple code to print out a list-structure tree (such as those created
+ by make-caller-tree) as indented text."
+ (when trees
+ (dolist (tree trees)
+ (cond ((and (listp tree) (eq (car tree) :xref-list))
+ (format t "~&~VT~A" indent (cdr tree)))
+ ((listp tree)
+ (format t "~&~VT~A" indent (car tree))
+ (print-indented-tree (cadr tree) (+ indent *indent-amount*)))
+ (t
+ (format t "~&~VT~A" indent tree))))))
+
+(defun print-caller-trees (&key (mode *default-graphing-mode*)
+ (types-to-ignore *types-to-ignore*)
+ compact
+ root-nodes)
+ "Prints the calling trees (which may actually be a full graph and not
+ necessarily a DAG) as indented text trees using PRINT-INDENTED-TREE.
+ MODE is :call-graph for trees where the children of a node are the
+ functions called by the node, or :caller-graph for trees where the
+ children of a node are the functions the node calls. TYPES-TO-IGNORE
+ is a list of funcall types (as specified in the patterns) to ignore
+ in printing out the database. For example, '(:lisp) would ignore all
+ calls to common lisp functions. COMPACT is a flag to tell the program
+ to try to compact the trees a bit by not printing trees if they have
+ already been seen. ROOT-NODES is a list of root nodes of trees to
+ display. If ROOT-NODES is nil, tries to find all root nodes in the
+ database."
+ (multiple-value-bind (rooted cycles)
+ (if root-nodes
+ (values (gather-tree root-nodes nil mode types-to-ignore compact))
+ (make-caller-tree mode types-to-ignore compact))
+ (when rooted
+ (format t "~&Rooted calling trees:")
+ (print-indented-tree rooted 2))
+ (when cycles
+ (when rooted
+ (format t "~2%"))
+ (format t "~&Cyclic calling trees:")
+ (print-indented-tree cycles 2))))
+
+
+;;; ********************************
+;;; Interface to PSGraph ***********
+;;; ********************************
+#|
+;;; Interface to Bates' PostScript Graphing Utility
+(load "/afs/cs/user/mkant/Lisp/PSGraph/psgraph")
+
+(defparameter *postscript-output-directory* "")
+(defun psgraph-xref (&key (mode *default-graphing-mode*)
+ (output-directory *postscript-output-directory*)
+ (types-to-ignore *types-to-ignore*)
+ (compact t)
+ (shrink t)
+ root-nodes
+ insert)
+ ;; If root-nodes is a non-nil list, uses that list as the starting
+ ;; position. Otherwise tries to find all roots in the database.
+ (multiple-value-bind (rooted cycles)
+ (if root-nodes
+ (values (gather-tree root-nodes nil mode types-to-ignore compact))
+ (make-caller-tree mode types-to-ignore compact))
+ (psgraph-output (append rooted cycles) output-directory shrink insert)))
+
+(defun psgraph-output (list-of-trees directory shrink &optional insert)
+ (let ((psgraph:*fontsize* 9)
+ (psgraph:*second-fontsize* 7)
+; (psgraph:*boxkind* "fill")
+ (psgraph:*boxgray* "0") ; .8
+ (psgraph:*edgewidth* "1")
+ (psgraph:*edgegray* "0"))
+ (labels ((stringify (thing)
+ (cond ((stringp thing) (string-downcase thing))
+ ((symbolp thing) (string-downcase (symbol-name thing)))
+ ((and (listp thing) (eq (car thing) :xref-list))
+ (stringify (cdr thing)))
+ ((listp thing) (stringify (car thing)))
+ (t (string thing)))))
+ (dolist (item list-of-trees)
+ (let* ((fname (stringify item))
+ (filename (concatenate 'string directory
+ (string-trim '(#\: #\|) fname)
+ ".ps")))
+ (format t "~&Creating PostScript file ~S." filename)
+ (with-open-file (*standard-output* filename
+ :direction :output
+ :if-does-not-exist :create
+ :if-exists :supersede)
+ ;; Note that the #'eq prints the DAG as a tree. If
+ ;; you replace it with #'equal, it will print it as
+ ;; a DAG, which I think is slightly ugly.
+ (psgraph:psgraph item
+ #'caller-tree-children #'caller-info shrink
+ insert #'eq)))))))
+
+(defun caller-tree-children (tree)
+ (when (and tree (listp tree) (not (eq (car tree) :xref-list)))
+ (cadr tree)))
+
+(defun caller-tree-node (tree)
+ (when tree
+ (cond ((and (listp tree) (eq (car tree) :xref-list))
+ (cdr tree))
+ ((listp tree)
+ (car tree))
+ (t
+ tree))))
+
+(defun caller-info (tree)
+ (let ((node (caller-tree-node tree)))
+ (list node)))
+|#
+#|
+;;; Code to print out graphical trees of CLOS class hierarchies.
+(defun print-class-hierarchy (&optional (start-class 'anything)
+ (file "classes.ps"))
+ (let ((start (find-class start-class)))
+ (when start
+ (with-open-file (*standard-output* file :direction :output)
+ (psgraph:psgraph start
+ #'clos::class-direct-subclasses
+ #'(lambda (x)
+ (list (format nil "~A" (clos::class-name x))))
+ t nil #'eq)))))
+
+|#
+
+
+;;; ****************************************************************
+;;; Cross Referencing Patterns for Common Lisp *********************
+;;; ****************************************************************
+(clear-patterns)
+
+;;; ********************************
+;;; Pattern Substitutions **********
+;;; ********************************
+(define-pattern-substitution integer (:test #'integerp))
+(define-pattern-substitution rational (:test #'rationalp))
+(define-pattern-substitution symbol (:test #'symbolp))
+(define-pattern-substitution string (:test #'stringp))
+(define-pattern-substitution number (:test #'numberp))
+(define-pattern-substitution lambda-list
+ ((:star var)
+ (:optional (:eq &optional)
+ (:star (:or var
+ (var (:optional form (:optional var))))))
+ (:optional (:eq &rest) var)
+ (:optional (:eq &key) (:star (:or var
+ ((:or var
+ (keyword var))
+ (:optional form (:optional var)))))
+ (:optional &allow-other-keys))
+ (:optional (:eq &aux)
+ (:star (:or var
+ (var (:optional form)))))))
+(define-pattern-substitution test form)
+(define-pattern-substitution body
+ ((:star (:or declaration documentation-string))
+ (:star form)))
+(define-pattern-substitution documentation-string string)
+(define-pattern-substitution initial-value form)
+(define-pattern-substitution tag symbol)
+(define-pattern-substitution declaration ((:eq declare)(:rest :ignore)))
+(define-pattern-substitution destination form)
+(define-pattern-substitution control-string string)
+(define-pattern-substitution format-arguments
+ ((:star form)))
+(define-pattern-substitution fn
+ (:or ((:eq quote) function)
+ ((:eq function) function)
+ function))
+
+;;; ********************************
+;;; Caller Patterns ****************
+;;; ********************************
+
+;;; Types Related
+(define-caller-pattern coerce (form :ignore) :lisp)
+(define-caller-pattern type-of (form) :lisp)
+(define-caller-pattern upgraded-array-element-type (:ignore) :lisp2)
+(define-caller-pattern upgraded-complex-part-type (:ignore) :lisp2)
+
+;;; Lambdas and Definitions
+(define-variable-pattern lambda-list-keywords :lisp)
+(define-variable-pattern lambda-parameters-limit :lisp)
+(define-caller-pattern lambda (lambda-list (:rest body)) :lisp)
+
+(define-caller-pattern defun
+ (name lambda-list
+ (:star (:or documentation-string declaration))
+ (:star form))
+ :lisp)
+
+;;; perhaps this should use VAR, instead of NAME
+(define-caller-pattern defvar
+ (var (:optional initial-value (:optional documentation-string)))
+ :lisp)
+(define-caller-pattern defparameter
+ (var initial-value (:optional documentation-string))
+ :lisp)
+(define-caller-pattern defconstant
+ (var initial-value (:optional documentation-string))
+ :lisp)
+
+(define-caller-pattern eval-when
+ (:ignore ; the situations
+ (:star form))
+ :lisp)
+
+;;; Logical Values
+(define-variable-pattern nil :lisp)
+(define-variable-pattern t :lisp)
+
+;;; Predicates
+(define-caller-pattern typep (form form) :lisp)
+(define-caller-pattern subtypep (form form) :lisp)
+
+(define-caller-pattern null (form) :lisp)
+(define-caller-pattern symbolp (form) :lisp)
+(define-caller-pattern atom (form) :lisp)
+(define-caller-pattern consp (form) :lisp)
+(define-caller-pattern listp (form) :lisp)
+(define-caller-pattern numberp (form) :lisp)
+(define-caller-pattern integerp (form) :lisp)
+(define-caller-pattern rationalp (form) :lisp)
+(define-caller-pattern floatp (form) :lisp)
+(define-caller-pattern realp (form) :lisp2)
+(define-caller-pattern complexp (form) :lisp)
+(define-caller-pattern characterp (form) :lisp)
+(define-caller-pattern stringp (form) :lisp)
+(define-caller-pattern bit-vector-p (form) :lisp)
+(define-caller-pattern vectorp (form) :lisp)
+(define-caller-pattern simple-vector-p (form) :lisp)
+(define-caller-pattern simple-string-p (form) :lisp)
+(define-caller-pattern simple-bit-vector-p (form) :lisp)
+(define-caller-pattern arrayp (form) :lisp)
+(define-caller-pattern packagep (form) :lisp)
+(define-caller-pattern functionp (form) :lisp)
+(define-caller-pattern compiled-function-p (form) :lisp)
+(define-caller-pattern commonp (form) :lisp)
+
+;;; Equality Predicates
+(define-caller-pattern eq (form form) :lisp)
+(define-caller-pattern eql (form form) :lisp)
+(define-caller-pattern equal (form form) :lisp)
+(define-caller-pattern equalp (form form) :lisp)
+
+;;; Logical Operators
+(define-caller-pattern not (form) :lisp)
+(define-caller-pattern or ((:star form)) :lisp)
+(define-caller-pattern and ((:star form)) :lisp)
+
+;;; Reference
+
+;;; Quote is a problem. In Defmacro & friends, we'd like to actually
+;;; look at the argument, 'cause it hides internal function calls
+;;; of the defmacro.
+(define-caller-pattern quote (:ignore) :lisp)
+
+(define-caller-pattern function ((:or fn form)) :lisp)
+(define-caller-pattern symbol-value (form) :lisp)
+(define-caller-pattern symbol-function (form) :lisp)
+(define-caller-pattern fdefinition (form) :lisp2)
+(define-caller-pattern boundp (form) :lisp)
+(define-caller-pattern fboundp (form) :lisp)
+(define-caller-pattern special-form-p (form) :lisp)
+
+;;; Assignment
+(define-caller-pattern setq ((:star var form)) :lisp)
+(define-caller-pattern psetq ((:star var form)) :lisp)
+(define-caller-pattern set (form form) :lisp)
+(define-caller-pattern makunbound (form) :lisp)
+(define-caller-pattern fmakunbound (form) :lisp)
+
+;;; Generalized Variables
+(define-caller-pattern setf ((:star form form)) :lisp)
+(define-caller-pattern psetf ((:star form form)) :lisp)
+(define-caller-pattern shiftf ((:plus form) form) :lisp)
+(define-caller-pattern rotatef ((:star form)) :lisp)
+(define-caller-pattern define-modify-macro
+ (name
+ lambda-list
+ fn
+ (:optional documentation-string))
+ :lisp)
+(define-caller-pattern defsetf
+ (:or (name name (:optional documentation-string))
+ (name lambda-list (var)
+ (:star (:or declaration documentation-string))
+ (:star form)))
+ :lisp)
+(define-caller-pattern define-setf-method
+ (name lambda-list
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp)
+(define-caller-pattern get-setf-method (form) :lisp)
+(define-caller-pattern get-setf-method-multiple-value (form) :lisp)
+
+
+;;; Function invocation
+(define-caller-pattern apply (fn form (:star form)) :lisp)
+(define-caller-pattern funcall (fn (:star form)) :lisp)
+
+
+;;; Simple sequencing
+(define-caller-pattern progn ((:star form)) :lisp)
+(define-caller-pattern prog1 (form (:star form)) :lisp)
+(define-caller-pattern prog2 (form form (:star form)) :lisp)
+
+;;; Variable bindings
+(define-caller-pattern let
+ (((:star (:or var (var &optional form))))
+ (:star declaration)
+ (:star form))
+ :lisp)
+(define-caller-pattern let*
+ (((:star (:or var (var &optional form))))
+ (:star declaration)
+ (:star form))
+ :lisp)
+(define-caller-pattern compiler-let
+ (((:star (:or var (var form))))
+ (:star form))
+ :lisp)
+(define-caller-pattern progv
+ (form form (:star form)) :lisp)
+(define-caller-pattern flet
+ (((:star (name lambda-list
+ (:star (:or declaration
+ documentation-string))
+ (:star form))))
+ (:star form))
+ :lisp)
+(define-caller-pattern labels
+ (((:star (name lambda-list
+ (:star (:or declaration
+ documentation-string))
+ (:star form))))
+ (:star form))
+ :lisp)
+(define-caller-pattern macrolet
+ (((:star (name lambda-list
+ (:star (:or declaration
+ documentation-string))
+ (:star form))))
+ (:star form))
+ :lisp)
+(define-caller-pattern symbol-macrolet
+ (((:star (var form))) (:star declaration) (:star form))
+ :lisp2)
+
+;;; Conditionals
+(define-caller-pattern if (test form (:optional form)) :lisp)
+(define-caller-pattern when (test (:star form)) :lisp)
+(define-caller-pattern unless (test (:star form)) :lisp)
+(define-caller-pattern cond ((:star (test (:star form)))) :lisp)
+(define-caller-pattern case
+ (form
+ (:star ((:or symbol
+ ((:star symbol)))
+ (:star form))))
+ :lisp)
+(define-caller-pattern typecase (form (:star (symbol (:star form))))
+ :lisp)
+
+;;; Blocks and Exits
+(define-caller-pattern block (name (:star form)) :lisp)
+(define-caller-pattern return-from (function (:optional form)) :lisp)
+(define-caller-pattern return ((:optional form)) :lisp)
+
+;;; Iteration
+(define-caller-pattern loop ((:star form)) :lisp)
+(define-caller-pattern do
+ (((:star (:or var
+ (var (:optional form (:optional form)))))) ; init step
+ (form (:star form)) ; end-test result
+ (:star declaration)
+ (:star (:or tag form))) ; statement
+ :lisp)
+(define-caller-pattern do*
+ (((:star (:or var
+ (var (:optional form (:optional form))))))
+ (form (:star form))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern dolist
+ ((var form (:optional form))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern dotimes
+ ((var form (:optional form))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+
+;;; Mapping
+(define-caller-pattern mapcar (fn form (:star form)) :lisp)
+(define-caller-pattern maplist (fn form (:star form)) :lisp)
+(define-caller-pattern mapc (fn form (:star form)) :lisp)
+(define-caller-pattern mapl (fn form (:star form)) :lisp)
+(define-caller-pattern mapcan (fn form (:star form)) :lisp)
+(define-caller-pattern mapcon (fn form (:star form)) :lisp)
+
+;;; The "Program Feature"
+(define-caller-pattern tagbody ((:star (:or tag form))) :lisp)
+(define-caller-pattern prog
+ (((:star (:or var (var (:optional form)))))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern prog*
+ (((:star (:or var (var (:optional form)))))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern go (tag) :lisp)
+
+;;; Multiple Values
+(define-caller-pattern values ((:star form)) :lisp)
+(define-variable-pattern multiple-values-limit :lisp)
+(define-caller-pattern values-list (form) :lisp)
+(define-caller-pattern multiple-value-list (form) :lisp)
+(define-caller-pattern multiple-value-call (fn (:star form)) :lisp)
+(define-caller-pattern multiple-value-prog1 (form (:star form)) :lisp)
+(define-caller-pattern multiple-value-bind
+ (((:star var)) form
+ (:star declaration)
+ (:star form))
+ :lisp)
+(define-caller-pattern multiple-value-setq (((:star var)) form) :lisp)
+(define-caller-pattern nth-value (form form) :lisp2)
+
+;;; Dynamic Non-Local Exits
+(define-caller-pattern catch (tag (:star form)) :lisp)
+(define-caller-pattern throw (tag form) :lisp)
+(define-caller-pattern unwind-protect (form (:star form)) :lisp)
+
+;;; Macros
+(define-caller-pattern macro-function (form) :lisp)
+(define-caller-pattern defmacro
+ (name
+ lambda-list
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp)
+(define-caller-pattern macroexpand (form (:optional :ignore)) :lisp)
+(define-caller-pattern macroexpand-1 (form (:optional :ignore)) :lisp)
+(define-variable-pattern *macroexpand-hook* :lisp)
+
+;;; Destructuring
+(define-caller-pattern destructuring-bind
+ (lambda-list form
+ (:star declaration)
+ (:star form))
+ :lisp2)
+
+;;; Compiler Macros
+(define-caller-pattern define-compiler-macro
+ (name lambda-list
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp2)
+(define-caller-pattern compiler-macro-function (form) :lisp2)
+(define-caller-pattern compiler-macroexpand (form (:optional :ignore)) :lisp2)
+(define-caller-pattern compiler-macroexpand-1 (form (:optional :ignore)) :lisp2)
+
+;;; Environments
+(define-caller-pattern variable-information (form &optional :ignore)
+ :lisp2)
+(define-caller-pattern function-information (fn &optional :ignore) :lisp2)
+(define-caller-pattern declaration-information (form &optional :ignore) :lisp2)
+(define-caller-pattern augment-environment (form &key (:star :ignore)) :lisp2)
+(define-caller-pattern define-declaration
+ (name
+ lambda-list
+ (:star form))
+ :lisp2)
+(define-caller-pattern parse-macro (name lambda-list form) :lisp2)
+(define-caller-pattern enclose (form &optional :ignore) :lisp2)
+
+
+;;; Declarations
+(define-caller-pattern declare ((:rest :ignore)) :lisp)
+(define-caller-pattern proclaim ((:rest :ignore)) :lisp)
+(define-caller-pattern locally ((:star declaration) (:star form)) :lisp)
+(define-caller-pattern declaim ((:rest :ignore)) :lisp2)
+(define-caller-pattern the (form form) :lisp)
+
+;;; Symbols
+(define-caller-pattern get (form form (:optional form)) :lisp)
+(define-caller-pattern remprop (form form) :lisp)
+(define-caller-pattern symbol-plist (form) :lisp)
+(define-caller-pattern getf (form form (:optional form)) :lisp)
+(define-caller-pattern remf (form form) :lisp)
+(define-caller-pattern get-properties (form form) :lisp)
+
+(define-caller-pattern symbol-name (form) :lisp)
+(define-caller-pattern make-symbol (form) :lisp)
+(define-caller-pattern copy-symbol (form (:optional :ignore)) :lisp)
+(define-caller-pattern gensym ((:optional :ignore)) :lisp)
+(define-variable-pattern *gensym-counter* :lisp2)
+(define-caller-pattern gentemp ((:optional :ignore :ignore)) :lisp)
+(define-caller-pattern symbol-package (form) :lisp)
+(define-caller-pattern keywordp (form) :lisp)
+
+;;; Packages
+(define-variable-pattern *package* :lisp)
+(define-caller-pattern make-package ((:rest :ignore)) :lisp)
+(define-caller-pattern in-package ((:rest :ignore)) :lisp)
+(define-caller-pattern find-package ((:rest :ignore)) :lisp)
+(define-caller-pattern package-name ((:rest :ignore)) :lisp)
+(define-caller-pattern package-nicknames ((:rest :ignore)) :lisp)
+(define-caller-pattern rename-package ((:rest :ignore)) :lisp)
+(define-caller-pattern package-use-list ((:rest :ignore)) :lisp)
+(define-caller-pattern package-used-by-list ((:rest :ignore)) :lisp)
+(define-caller-pattern package-shadowing-symbols ((:rest :ignore)) :lisp)
+(define-caller-pattern list-all-packages () :lisp)
+(define-caller-pattern delete-package ((:rest :ignore)) :lisp2)
+(define-caller-pattern intern (form &optional :ignore) :lisp)
+(define-caller-pattern find-symbol (form &optional :ignore) :lisp)
+(define-caller-pattern unintern (form &optional :ignore) :lisp)
+
+(define-caller-pattern export ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+(define-caller-pattern unexport ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+(define-caller-pattern import ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+(define-caller-pattern shadowing-import ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+(define-caller-pattern shadow ((:or symbol ((:star symbol)))
+ &optional :ignore) :lisp)
+
+(define-caller-pattern use-package ((:rest :ignore)) :lisp)
+(define-caller-pattern unuse-package ((:rest :ignore)) :lisp)
+(define-caller-pattern defpackage (name (:rest :ignore)) :lisp2)
+(define-caller-pattern find-all-symbols (form) :lisp)
+(define-caller-pattern do-symbols
+ ((var (:optional form (:optional form)))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern do-external-symbols
+ ((var (:optional form (:optional form)))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern do-all-symbols
+ ((var (:optional form))
+ (:star declaration)
+ (:star (:or tag form)))
+ :lisp)
+(define-caller-pattern with-package-iterator
+ ((name form (:plus :ignore))
+ (:star form))
+ :lisp2)
+
+;;; Modules
+(define-variable-pattern *modules* :lisp)
+(define-caller-pattern provide (form) :lisp)
+(define-caller-pattern require (form &optional :ignore) :lisp)
+
+
+;;; Numbers
+(define-caller-pattern zerop (form) :lisp)
+(define-caller-pattern plusp (form) :lisp)
+(define-caller-pattern minusp (form) :lisp)
+(define-caller-pattern oddp (form) :lisp)
+(define-caller-pattern evenp (form) :lisp)
+
+(define-caller-pattern = (form (:star form)) :lisp)
+(define-caller-pattern /= (form (:star form)) :lisp)
+(define-caller-pattern > (form (:star form)) :lisp)
+(define-caller-pattern < (form (:star form)) :lisp)
+(define-caller-pattern <= (form (:star form)) :lisp)
+(define-caller-pattern >= (form (:star form)) :lisp)
+
+(define-caller-pattern max (form (:star form)) :lisp)
+(define-caller-pattern min (form (:star form)) :lisp)
+
+(define-caller-pattern - (form (:star form)) :lisp)
+(define-caller-pattern + (form (:star form)) :lisp)
+(define-caller-pattern * (form (:star form)) :lisp)
+(define-caller-pattern / (form (:star form)) :lisp)
+(define-caller-pattern 1+ (form) :lisp)
+(define-caller-pattern 1- (form) :lisp)
+
+(define-caller-pattern incf (form form) :lisp)
+(define-caller-pattern decf (form form) :lisp)
+
+(define-caller-pattern conjugate (form) :lisp)
+
+(define-caller-pattern gcd ((:star form)) :lisp)
+(define-caller-pattern lcm ((:star form)) :lisp)
+
+(define-caller-pattern exp (form) :lisp)
+(define-caller-pattern expt (form form) :lisp)
+(define-caller-pattern log (form (:optional form)) :lisp)
+(define-caller-pattern sqrt (form) :lisp)
+(define-caller-pattern isqrt (form) :lisp)
+
+(define-caller-pattern abs (form) :lisp)
+(define-caller-pattern phase (form) :lisp)
+(define-caller-pattern signum (form) :lisp)
+(define-caller-pattern sin (form) :lisp)
+(define-caller-pattern cos (form) :lisp)
+(define-caller-pattern tan (form) :lisp)
+(define-caller-pattern cis (form) :lisp)
+(define-caller-pattern asin (form) :lisp)
+(define-caller-pattern acos (form) :lisp)
+(define-caller-pattern atan (form &optional form) :lisp)
+(define-variable-pattern pi :lisp)
+
+(define-caller-pattern sinh (form) :lisp)
+(define-caller-pattern cosh (form) :lisp)
+(define-caller-pattern tanh (form) :lisp)
+(define-caller-pattern asinh (form) :lisp)
+(define-caller-pattern acosh (form) :lisp)
+(define-caller-pattern atanh (form) :lisp)
+
+;;; Type Conversions and Extractions
+(define-caller-pattern float (form (:optional form)) :lisp)
+(define-caller-pattern rational (form) :lisp)
+(define-caller-pattern rationalize (form) :lisp)
+(define-caller-pattern numerator (form) :lisp)
+(define-caller-pattern denominator (form) :lisp)
+
+(define-caller-pattern floor (form (:optional form)) :lisp)
+(define-caller-pattern ceiling (form (:optional form)) :lisp)
+(define-caller-pattern truncate (form (:optional form)) :lisp)
+(define-caller-pattern round (form (:optional form)) :lisp)
+
+(define-caller-pattern mod (form form) :lisp)
+(define-caller-pattern rem (form form) :lisp)
+
+(define-caller-pattern ffloor (form (:optional form)) :lisp)
+(define-caller-pattern fceiling (form (:optional form)) :lisp)
+(define-caller-pattern ftruncate (form (:optional form)) :lisp)
+(define-caller-pattern fround (form (:optional form)) :lisp)
+
+(define-caller-pattern decode-float (form) :lisp)
+(define-caller-pattern scale-float (form form) :lisp)
+(define-caller-pattern float-radix (form) :lisp)
+(define-caller-pattern float-sign (form (:optional form)) :lisp)
+(define-caller-pattern float-digits (form) :lisp)
+(define-caller-pattern float-precision (form) :lisp)
+(define-caller-pattern integer-decode-float (form) :lisp)
+
+(define-caller-pattern complex (form (:optional form)) :lisp)
+(define-caller-pattern realpart (form) :lisp)
+(define-caller-pattern imagpart (form) :lisp)
+
+(define-caller-pattern logior ((:star form)) :lisp)
+(define-caller-pattern logxor ((:star form)) :lisp)
+(define-caller-pattern logand ((:star form)) :lisp)
+(define-caller-pattern logeqv ((:star form)) :lisp)
+
+(define-caller-pattern lognand (form form) :lisp)
+(define-caller-pattern lognor (form form) :lisp)
+(define-caller-pattern logandc1 (form form) :lisp)
+(define-caller-pattern logandc2 (form form) :lisp)
+(define-caller-pattern logorc1 (form form) :lisp)
+(define-caller-pattern logorc2 (form form) :lisp)
+
+(define-caller-pattern boole (form form form) :lisp)
+(define-variable-pattern boole-clr :lisp)
+(define-variable-pattern boole-set :lisp)
+(define-variable-pattern boole-1 :lisp)
+(define-variable-pattern boole-2 :lisp)
+(define-variable-pattern boole-c1 :lisp)
+(define-variable-pattern boole-c2 :lisp)
+(define-variable-pattern boole-and :lisp)
+(define-variable-pattern boole-ior :lisp)
+(define-variable-pattern boole-xor :lisp)
+(define-variable-pattern boole-eqv :lisp)
+(define-variable-pattern boole-nand :lisp)
+(define-variable-pattern boole-nor :lisp)
+(define-variable-pattern boole-andc1 :lisp)
+(define-variable-pattern boole-andc2 :lisp)
+(define-variable-pattern boole-orc1 :lisp)
+(define-variable-pattern boole-orc2 :lisp)
+
+(define-caller-pattern lognot (form) :lisp)
+(define-caller-pattern logtest (form form) :lisp)
+(define-caller-pattern logbitp (form form) :lisp)
+(define-caller-pattern ash (form form) :lisp)
+(define-caller-pattern logcount (form) :lisp)
+(define-caller-pattern integer-length (form) :lisp)
+
+(define-caller-pattern byte (form form) :lisp)
+(define-caller-pattern byte-size (form) :lisp)
+(define-caller-pattern byte-position (form) :lisp)
+(define-caller-pattern ldb (form form) :lisp)
+(define-caller-pattern ldb-test (form form) :lisp)
+(define-caller-pattern mask-field (form form) :lisp)
+(define-caller-pattern dpb (form form form) :lisp)
+(define-caller-pattern deposit-field (form form form) :lisp)
+
+;;; Random Numbers
+(define-caller-pattern random (form (:optional form)) :lisp)
+(define-variable-pattern *random-state* :lisp)
+(define-caller-pattern make-random-state ((:optional form)) :lisp)
+(define-caller-pattern random-state-p (form) :lisp)
+
+;;; Implementation Parameters
+(define-variable-pattern most-positive-fixnum :lisp)
+(define-variable-pattern most-negative-fixnum :lisp)
+(define-variable-pattern most-positive-short-float :lisp)
+(define-variable-pattern least-positive-short-float :lisp)
+(define-variable-pattern least-negative-short-float :lisp)
+(define-variable-pattern most-negative-short-float :lisp)
+(define-variable-pattern most-positive-single-float :lisp)
+(define-variable-pattern least-positive-single-float :lisp)
+(define-variable-pattern least-negative-single-float :lisp)
+(define-variable-pattern most-negative-single-float :lisp)
+(define-variable-pattern most-positive-double-float :lisp)
+(define-variable-pattern least-positive-double-float :lisp)
+(define-variable-pattern least-negative-double-float :lisp)
+(define-variable-pattern most-negative-double-float :lisp)
+(define-variable-pattern most-positive-long-float :lisp)
+(define-variable-pattern least-positive-long-float :lisp)
+(define-variable-pattern least-negative-long-float :lisp)
+(define-variable-pattern most-negative-long-float :lisp)
+(define-variable-pattern least-positive-normalized-short-float :lisp2)
+(define-variable-pattern least-negative-normalized-short-float :lisp2)
+(define-variable-pattern least-positive-normalized-single-float :lisp2)
+(define-variable-pattern least-negative-normalized-single-float :lisp2)
+(define-variable-pattern least-positive-normalized-double-float :lisp2)
+(define-variable-pattern least-negative-normalized-double-float :lisp2)
+(define-variable-pattern least-positive-normalized-long-float :lisp2)
+(define-variable-pattern least-negative-normalized-long-float :lisp2)
+(define-variable-pattern short-float-epsilon :lisp)
+(define-variable-pattern single-float-epsilon :lisp)
+(define-variable-pattern double-float-epsilon :lisp)
+(define-variable-pattern long-float-epsilon :lisp)
+(define-variable-pattern short-float-negative-epsilon :lisp)
+(define-variable-pattern single-float-negative-epsilon :lisp)
+(define-variable-pattern double-float-negative-epsilon :lisp)
+(define-variable-pattern long-float-negative-epsilon :lisp)
+
+;;; Characters
+(define-variable-pattern char-code-limit :lisp)
+(define-variable-pattern char-font-limit :lisp)
+(define-variable-pattern char-bits-limit :lisp)
+(define-caller-pattern standard-char-p (form) :lisp)
+(define-caller-pattern graphic-char-p (form) :lisp)
+(define-caller-pattern string-char-p (form) :lisp)
+(define-caller-pattern alpha-char-p (form) :lisp)
+(define-caller-pattern upper-case-p (form) :lisp)
+(define-caller-pattern lower-case-p (form) :lisp)
+(define-caller-pattern both-case-p (form) :lisp)
+(define-caller-pattern digit-char-p (form (:optional form)) :lisp)
+(define-caller-pattern alphanumericp (form) :lisp)
+
+(define-caller-pattern char= ((:star form)) :lisp)
+(define-caller-pattern char/= ((:star form)) :lisp)
+(define-caller-pattern char< ((:star form)) :lisp)
+(define-caller-pattern char> ((:star form)) :lisp)
+(define-caller-pattern char<= ((:star form)) :lisp)
+(define-caller-pattern char>= ((:star form)) :lisp)
+
+(define-caller-pattern char-equal ((:star form)) :lisp)
+(define-caller-pattern char-not-equal ((:star form)) :lisp)
+(define-caller-pattern char-lessp ((:star form)) :lisp)
+(define-caller-pattern char-greaterp ((:star form)) :lisp)
+(define-caller-pattern char-not-greaterp ((:star form)) :lisp)
+(define-caller-pattern char-not-lessp ((:star form)) :lisp)
+
+(define-caller-pattern char-code (form) :lisp)
+(define-caller-pattern char-bits (form) :lisp)
+(define-caller-pattern char-font (form) :lisp)
+(define-caller-pattern code-char (form (:optional form form)) :lisp)
+(define-caller-pattern make-char (form (:optional form form)) :lisp)
+(define-caller-pattern characterp (form) :lisp)
+(define-caller-pattern char-upcase (form) :lisp)
+(define-caller-pattern char-downcase (form) :lisp)
+(define-caller-pattern digit-char (form (:optional form form)) :lisp)
+(define-caller-pattern char-int (form) :lisp)
+(define-caller-pattern int-char (form) :lisp)
+(define-caller-pattern char-name (form) :lisp)
+(define-caller-pattern name-char (form) :lisp)
+(define-variable-pattern char-control-bit :lisp)
+(define-variable-pattern char-meta-bit :lisp)
+(define-variable-pattern char-super-bit :lisp)
+(define-variable-pattern char-hyper-bit :lisp)
+(define-caller-pattern char-bit (form form) :lisp)
+(define-caller-pattern set-char-bit (form form form) :lisp)
+
+;;; Sequences
+(define-caller-pattern complement (fn) :lisp2)
+(define-caller-pattern elt (form form) :lisp)
+(define-caller-pattern subseq (form form &optional form) :lisp)
+(define-caller-pattern copy-seq (form) :lisp)
+(define-caller-pattern length (form) :lisp)
+(define-caller-pattern reverse (form) :lisp)
+(define-caller-pattern nreverse (form) :lisp)
+(define-caller-pattern make-sequence (form form &key form) :lisp)
+
+(define-caller-pattern concatenate (form (:star form)) :lisp)
+(define-caller-pattern map (form fn form (:star form)) :lisp)
+(define-caller-pattern map-into (form fn (:star form)) :lisp2)
+
+(define-caller-pattern some (fn form (:star form)) :lisp)
+(define-caller-pattern every (fn form (:star form)) :lisp)
+(define-caller-pattern notany (fn form (:star form)) :lisp)
+(define-caller-pattern notevery (fn form (:star form)) :lisp)
+
+(define-caller-pattern reduce (fn form &key (:star form)) :lisp)
+(define-caller-pattern fill (form form &key (:star form)) :lisp)
+(define-caller-pattern replace (form form &key (:star form)) :lisp)
+(define-caller-pattern remove (form form &key (:star form)) :lisp)
+(define-caller-pattern remove-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern remove-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern delete (form form &key (:star form)) :lisp)
+(define-caller-pattern delete-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern delete-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern remove-duplicates (form &key (:star form)) :lisp)
+(define-caller-pattern delete-duplicates (form &key (:star form)) :lisp)
+(define-caller-pattern substitute (form form form &key (:star form)) :lisp)
+(define-caller-pattern substitute-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern substitute-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubstitute (form form form &key (:star form)) :lisp)
+(define-caller-pattern nsubstitute-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubstitute-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern find (form form &key (:star form)) :lisp)
+(define-caller-pattern find-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern find-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern position (form form &key (:star form)) :lisp)
+(define-caller-pattern position-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern position-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern count (form form &key (:star form)) :lisp)
+(define-caller-pattern count-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern count-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern mismatch (form form &key (:star form)) :lisp)
+(define-caller-pattern search (form form &key (:star form)) :lisp)
+(define-caller-pattern sort (form fn &key (:star form)) :lisp)
+(define-caller-pattern stable-sort (form fn &key (:star form)) :lisp)
+(define-caller-pattern merge (form form form fn &key (:star form)) :lisp)
+
+;;; Lists
+(define-caller-pattern car (form) :lisp)
+(define-caller-pattern cdr (form) :lisp)
+(define-caller-pattern caar (form) :lisp)
+(define-caller-pattern cadr (form) :lisp)
+(define-caller-pattern cdar (form) :lisp)
+(define-caller-pattern cddr (form) :lisp)
+(define-caller-pattern caaar (form) :lisp)
+(define-caller-pattern caadr (form) :lisp)
+(define-caller-pattern cadar (form) :lisp)
+(define-caller-pattern caddr (form) :lisp)
+(define-caller-pattern cdaar (form) :lisp)
+(define-caller-pattern cdadr (form) :lisp)
+(define-caller-pattern cddar (form) :lisp)
+(define-caller-pattern cdddr (form) :lisp)
+(define-caller-pattern caaaar (form) :lisp)
+(define-caller-pattern caaadr (form) :lisp)
+(define-caller-pattern caadar (form) :lisp)
+(define-caller-pattern caaddr (form) :lisp)
+(define-caller-pattern cadaar (form) :lisp)
+(define-caller-pattern cadadr (form) :lisp)
+(define-caller-pattern caddar (form) :lisp)
+(define-caller-pattern cadddr (form) :lisp)
+(define-caller-pattern cdaaar (form) :lisp)
+(define-caller-pattern cdaadr (form) :lisp)
+(define-caller-pattern cdadar (form) :lisp)
+(define-caller-pattern cdaddr (form) :lisp)
+(define-caller-pattern cddaar (form) :lisp)
+(define-caller-pattern cddadr (form) :lisp)
+(define-caller-pattern cdddar (form) :lisp)
+(define-caller-pattern cddddr (form) :lisp)
+
+(define-caller-pattern cons (form form) :lisp)
+(define-caller-pattern tree-equal (form form &key (:star fn)) :lisp)
+(define-caller-pattern endp (form) :lisp)
+(define-caller-pattern list-length (form) :lisp)
+(define-caller-pattern nth (form form) :lisp)
+
+(define-caller-pattern first (form) :lisp)
+(define-caller-pattern second (form) :lisp)
+(define-caller-pattern third (form) :lisp)
+(define-caller-pattern fourth (form) :lisp)
+(define-caller-pattern fifth (form) :lisp)
+(define-caller-pattern sixth (form) :lisp)
+(define-caller-pattern seventh (form) :lisp)
+(define-caller-pattern eighth (form) :lisp)
+(define-caller-pattern ninth (form) :lisp)
+(define-caller-pattern tenth (form) :lisp)
+
+(define-caller-pattern rest (form) :lisp)
+(define-caller-pattern nthcdr (form form) :lisp)
+(define-caller-pattern last (form (:optional form)) :lisp)
+(define-caller-pattern list ((:star form)) :lisp)
+(define-caller-pattern list* ((:star form)) :lisp)
+(define-caller-pattern make-list (form &key (:star form)) :lisp)
+(define-caller-pattern append ((:star form)) :lisp)
+(define-caller-pattern copy-list (form) :lisp)
+(define-caller-pattern copy-alist (form) :lisp)
+(define-caller-pattern copy-tree (form) :lisp)
+(define-caller-pattern revappend (form form) :lisp)
+(define-caller-pattern nconc ((:star form)) :lisp)
+(define-caller-pattern nreconc (form form) :lisp)
+(define-caller-pattern push (form form) :lisp)
+(define-caller-pattern pushnew (form form &key (:star form)) :lisp)
+(define-caller-pattern pop (form) :lisp)
+(define-caller-pattern butlast (form (:optional form)) :lisp)
+(define-caller-pattern nbutlast (form (:optional form)) :lisp)
+(define-caller-pattern ldiff (form form) :lisp)
+(define-caller-pattern rplaca (form form) :lisp)
+(define-caller-pattern rplacd (form form) :lisp)
+
+(define-caller-pattern subst (form form form &key (:star form)) :lisp)
+(define-caller-pattern subst-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern subst-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubst (form form form &key (:star form)) :lisp)
+(define-caller-pattern nsubst-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubst-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern sublis (form form &key (:star form)) :lisp)
+(define-caller-pattern nsublis (form form &key (:star form)) :lisp)
+(define-caller-pattern member (form form &key (:star form)) :lisp)
+(define-caller-pattern member-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern member-if-not (fn form &key (:star form)) :lisp)
+
+(define-caller-pattern tailp (form form) :lisp)
+(define-caller-pattern adjoin (form form &key (:star form)) :lisp)
+(define-caller-pattern union (form form &key (:star form)) :lisp)
+(define-caller-pattern nunion (form form &key (:star form)) :lisp)
+(define-caller-pattern intersection (form form &key (:star form)) :lisp)
+(define-caller-pattern nintersection (form form &key (:star form)) :lisp)
+(define-caller-pattern set-difference (form form &key (:star form)) :lisp)
+(define-caller-pattern nset-difference (form form &key (:star form)) :lisp)
+(define-caller-pattern set-exclusive-or (form form &key (:star form)) :lisp)
+(define-caller-pattern nset-exclusive-or (form form &key (:star form)) :lisp)
+(define-caller-pattern subsetp (form form &key (:star form)) :lisp)
+
+(define-caller-pattern acons (form form form) :lisp)
+(define-caller-pattern pairlis (form form (:optional form)) :lisp)
+(define-caller-pattern assoc (form form &key (:star form)) :lisp)
+(define-caller-pattern assoc-if (fn form) :lisp)
+(define-caller-pattern assoc-if-not (fn form) :lisp)
+(define-caller-pattern rassoc (form form &key (:star form)) :lisp)
+(define-caller-pattern rassoc-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern rassoc-if-not (fn form &key (:star form)) :lisp)
+
+;;; Hash Tables
+(define-caller-pattern make-hash-table (&key (:star form)) :lisp)
+(define-caller-pattern hash-table-p (form) :lisp)
+(define-caller-pattern gethash (form form (:optional form)) :lisp)
+(define-caller-pattern remhash (form form) :lisp)
+(define-caller-pattern maphash (fn form) :lisp)
+(define-caller-pattern clrhash (form) :lisp)
+(define-caller-pattern hash-table-count (form) :lisp)
+(define-caller-pattern with-hash-table-iterator
+ ((name form) (:star form)) :lisp2)
+(define-caller-pattern hash-table-rehash-size (form) :lisp2)
+(define-caller-pattern hash-table-rehash-threshold (form) :lisp2)
+(define-caller-pattern hash-table-size (form) :lisp2)
+(define-caller-pattern hash-table-test (form) :lisp2)
+(define-caller-pattern sxhash (form) :lisp)
+
+;;; Arrays
+(define-caller-pattern make-array (form &key (:star form)) :lisp)
+(define-variable-pattern array-rank-limit :lisp)
+(define-variable-pattern array-dimension-limit :lisp)
+(define-variable-pattern array-total-size-limit :lisp)
+(define-caller-pattern vector ((:star form)) :lisp)
+(define-caller-pattern aref (form (:star form)) :lisp)
+(define-caller-pattern svref (form form) :lisp)
+(define-caller-pattern array-element-type (form) :lisp)
+(define-caller-pattern array-rank (form) :lisp)
+(define-caller-pattern array-dimension (form form) :lisp)
+(define-caller-pattern array-dimensions (form) :lisp)
+(define-caller-pattern array-total-size (form) :lisp)
+(define-caller-pattern array-in-bounds-p (form (:star form)) :lisp)
+(define-caller-pattern array-row-major-index (form (:star form)) :lisp)
+(define-caller-pattern row-major-aref (form form) :lisp2)
+(define-caller-pattern adjustable-array-p (form) :lisp)
+
+(define-caller-pattern bit (form (:star form)) :lisp)
+(define-caller-pattern sbit (form (:star form)) :lisp)
+
+(define-caller-pattern bit-and (form form (:optional form)) :lisp)
+(define-caller-pattern bit-ior (form form (:optional form)) :lisp)
+(define-caller-pattern bit-xor (form form (:optional form)) :lisp)
+(define-caller-pattern bit-eqv (form form (:optional form)) :lisp)
+(define-caller-pattern bit-nand (form form (:optional form)) :lisp)
+(define-caller-pattern bit-nor (form form (:optional form)) :lisp)
+(define-caller-pattern bit-andc1 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-andc2 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-orc1 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-orc2 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-not (form (:optional form)) :lisp)
+
+(define-caller-pattern array-has-fill-pointer-p (form) :lisp)
+(define-caller-pattern fill-pointer (form) :lisp)
+(define-caller-pattern vector-push (form form) :lisp)
+(define-caller-pattern vector-push-extend (form form (:optional form)) :lisp)
+(define-caller-pattern vector-pop (form) :lisp)
+(define-caller-pattern adjust-array (form form &key (:star form)) :lisp)
+
+;;; Strings
+(define-caller-pattern char (form form) :lisp)
+(define-caller-pattern schar (form form) :lisp)
+(define-caller-pattern string= (form form &key (:star form)) :lisp)
+(define-caller-pattern string-equal (form form &key (:star form)) :lisp)
+(define-caller-pattern string< (form form &key (:star form)) :lisp)
+(define-caller-pattern string> (form form &key (:star form)) :lisp)
+(define-caller-pattern string<= (form form &key (:star form)) :lisp)
+(define-caller-pattern string>= (form form &key (:star form)) :lisp)
+(define-caller-pattern string/= (form form &key (:star form)) :lisp)
+(define-caller-pattern string-lessp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-greaterp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-not-greaterp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-not-lessp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-not-equal (form form &key (:star form)) :lisp)
+
+(define-caller-pattern make-string (form &key (:star form)) :lisp)
+(define-caller-pattern string-trim (form form) :lisp)
+(define-caller-pattern string-left-trim (form form) :lisp)
+(define-caller-pattern string-right-trim (form form) :lisp)
+(define-caller-pattern string-upcase (form &key (:star form)) :lisp)
+(define-caller-pattern string-downcase (form &key (:star form)) :lisp)
+(define-caller-pattern string-capitalize (form &key (:star form)) :lisp)
+(define-caller-pattern nstring-upcase (form &key (:star form)) :lisp)
+(define-caller-pattern nstring-downcase (form &key (:star form)) :lisp)
+(define-caller-pattern nstring-capitalize (form &key (:star form)) :lisp)
+(define-caller-pattern string (form) :lisp)
+
+;;; Structures
+(define-caller-pattern defstruct
+ ((:or name (name (:rest :ignore)))
+ (:optional documentation-string)
+ (:plus :ignore))
+ :lisp)
+
+;;; The Evaluator
+(define-caller-pattern eval (form) :lisp)
+(define-variable-pattern *evalhook* :lisp)
+(define-variable-pattern *applyhook* :lisp)
+(define-caller-pattern evalhook (form fn fn &optional :ignore) :lisp)
+(define-caller-pattern applyhook (fn form fn fn &optional :ignore) :lisp)
+(define-caller-pattern constantp (form) :lisp)
+
+;;; Streams
+(define-variable-pattern *standard-input* :lisp)
+(define-variable-pattern *standard-output* :lisp)
+(define-variable-pattern *error-output* :lisp)
+(define-variable-pattern *query-io* :lisp)
+(define-variable-pattern *debug-io* :lisp)
+(define-variable-pattern *terminal-io* :lisp)
+(define-variable-pattern *trace-output* :lisp)
+(define-caller-pattern make-synonym-stream (symbol) :lisp)
+(define-caller-pattern make-broadcast-stream ((:star form)) :lisp)
+(define-caller-pattern make-concatenated-stream ((:star form)) :lisp)
+(define-caller-pattern make-two-way-stream (form form) :lisp)
+(define-caller-pattern make-echo-stream (form form) :lisp)
+(define-caller-pattern make-string-input-stream (form &optional form form) :lisp)
+(define-caller-pattern make-string-output-stream (&key (:star form)) :lisp)
+(define-caller-pattern get-output-stream-string (form) :lisp)
+
+(define-caller-pattern with-open-stream
+ ((var form)
+ (:star declaration)
+ (:star form))
+ :lisp)
+
+(define-caller-pattern with-input-from-string
+ ((var form &key (:star form))
+ (:star declaration)
+ (:star form))
+ :lisp)
+
+(define-caller-pattern with-output-to-string
+ ((var (:optional form))
+ (:star declaration)
+ (:star form))
+ :lisp)
+(define-caller-pattern streamp (form) :lisp)
+(define-caller-pattern open-stream-p (form) :lisp2)
+(define-caller-pattern input-stream-p (form) :lisp)
+(define-caller-pattern output-stream-p (form) :lisp)
+(define-caller-pattern stream-element-type (form) :lisp)
+(define-caller-pattern close (form (:rest :ignore)) :lisp)
+(define-caller-pattern broadcast-stream-streams (form) :lisp2)
+(define-caller-pattern concatenated-stream-streams (form) :lisp2)
+(define-caller-pattern echo-stream-input-stream (form) :lisp2)
+(define-caller-pattern echo-stream-output-stream (form) :lisp2)
+(define-caller-pattern synonym-stream-symbol (form) :lisp2)
+(define-caller-pattern two-way-stream-input-stream (form) :lisp2)
+(define-caller-pattern two-way-stream-output-stream (form) :lisp2)
+(define-caller-pattern interactive-stream-p (form) :lisp2)
+(define-caller-pattern stream-external-format (form) :lisp2)
+
+;;; Reader
+(define-variable-pattern *read-base* :lisp)
+(define-variable-pattern *read-suppress* :lisp)
+(define-variable-pattern *read-eval* :lisp2)
+(define-variable-pattern *readtable* :lisp)
+(define-caller-pattern copy-readtable (&optional form form) :lisp)
+(define-caller-pattern readtablep (form) :lisp)
+(define-caller-pattern set-syntax-from-char (form form &optional form form) :lisp)
+(define-caller-pattern set-macro-character (form fn &optional form) :lisp)
+(define-caller-pattern get-macro-character (form (:optional form)) :lisp)
+(define-caller-pattern make-dispatch-macro-character (form &optional form form)
+ :lisp)
+(define-caller-pattern set-dispatch-macro-character
+ (form form fn (:optional form)) :lisp)
+(define-caller-pattern get-dispatch-macro-character
+ (form form (:optional form)) :lisp)
+(define-caller-pattern readtable-case (form) :lisp2)
+(define-variable-pattern *print-readably* :lisp2)
+(define-variable-pattern *print-escape* :lisp)
+(define-variable-pattern *print-pretty* :lisp)
+(define-variable-pattern *print-circle* :lisp)
+(define-variable-pattern *print-base* :lisp)
+(define-variable-pattern *print-radix* :lisp)
+(define-variable-pattern *print-case* :lisp)
+(define-variable-pattern *print-gensym* :lisp)
+(define-variable-pattern *print-level* :lisp)
+(define-variable-pattern *print-length* :lisp)
+(define-variable-pattern *print-array* :lisp)
+(define-caller-pattern with-standard-io-syntax
+ ((:star declaration)
+ (:star form))
+ :lisp2)
+
+(define-caller-pattern read (&optional form form form form) :lisp)
+(define-variable-pattern *read-default-float-format* :lisp)
+(define-caller-pattern read-preserving-whitespace
+ (&optional form form form form) :lisp)
+(define-caller-pattern read-delimited-list (form &optional form form) :lisp)
+(define-caller-pattern read-line (&optional form form form form) :lisp)
+(define-caller-pattern read-char (&optional form form form form) :lisp)
+(define-caller-pattern unread-char (form (:optional form)) :lisp)
+(define-caller-pattern peek-char (&optional form form form form) :lisp)
+(define-caller-pattern listen ((:optional form)) :lisp)
+(define-caller-pattern read-char-no-hang ((:star form)) :lisp)
+(define-caller-pattern clear-input ((:optional form)) :lisp)
+(define-caller-pattern read-from-string (form (:star form)) :lisp)
+(define-caller-pattern parse-integer (form &rest :ignore) :lisp)
+(define-caller-pattern read-byte ((:star form)) :lisp)
+
+(define-caller-pattern write (form &key (:star form)) :lisp)
+(define-caller-pattern prin1 (form (:optional form)) :lisp)
+(define-caller-pattern print (form (:optional form)) :lisp)
+(define-caller-pattern pprint (form (:optional form)) :lisp)
+(define-caller-pattern princ (form (:optional form)) :lisp)
+(define-caller-pattern write-to-string (form &key (:star form)) :lisp)
+(define-caller-pattern prin1-to-string (form) :lisp)
+(define-caller-pattern princ-to-string (form) :lisp)
+(define-caller-pattern write-char (form (:optional form)) :lisp)
+(define-caller-pattern write-string (form &optional form &key (:star form)) :lisp)
+(define-caller-pattern write-line (form &optional form &key (:star form)) :lisp)
+(define-caller-pattern terpri ((:optional form)) :lisp)
+(define-caller-pattern fresh-line ((:optional form)) :lisp)
+(define-caller-pattern finish-output ((:optional form)) :lisp)
+(define-caller-pattern force-output ((:optional form)) :lisp)
+(define-caller-pattern clear-output ((:optional form)) :lisp)
+(define-caller-pattern print-unreadable-object
+ ((form form &key (:star form))
+ (:star declaration)
+ (:star form))
+ :lisp2)
+(define-caller-pattern write-byte (form form) :lisp)
+(define-caller-pattern format
+ (destination
+ control-string
+ (:rest format-arguments))
+ :lisp)
+
+(define-caller-pattern y-or-n-p (control-string (:star form)) :lisp)
+(define-caller-pattern yes-or-no-p (control-string (:star form)) :lisp)
+
+;;; Pathnames
+(define-caller-pattern wild-pathname-p (form &optional form) :lisp2)
+(define-caller-pattern pathname-match-p (form form) :lisp2)
+(define-caller-pattern translate-pathname (form form form &key (:star form))
+ :lisp2)
+
+(define-caller-pattern logical-pathname (form) :lisp2)
+(define-caller-pattern translate-logical-pathname (form &key (:star form)) :lisp2)
+(define-caller-pattern logical-pathname-translations (form) :lisp2)
+(define-caller-pattern load-logical-pathname-translations (form) :lisp2)
+(define-caller-pattern compile-file-pathname (form &key form) :lisp2)
+
+(define-caller-pattern pathname (form) :lisp)
+(define-caller-pattern truename (form) :lisp)
+(define-caller-pattern parse-namestring ((:star form)) :lisp)
+(define-caller-pattern merge-pathnames ((:star form)) :lisp)
+(define-variable-pattern *default-pathname-defaults* :lisp)
+(define-caller-pattern make-pathname ((:star form)) :lisp)
+(define-caller-pattern pathnamep (form) :lisp)
+(define-caller-pattern pathname-host (form) :lisp)
+(define-caller-pattern pathname-device (form) :lisp)
+(define-caller-pattern pathname-directory (form) :lisp)
+(define-caller-pattern pathname-name (form) :lisp)
+(define-caller-pattern pathname-type (form) :lisp)
+(define-caller-pattern pathname-version (form) :lisp)
+(define-caller-pattern namestring (form) :lisp)
+(define-caller-pattern file-namestring (form) :lisp)
+(define-caller-pattern directory-namestring (form) :lisp)
+(define-caller-pattern host-namestring (form) :lisp)
+(define-caller-pattern enough-namestring (form (:optional form)) :lisp)
+(define-caller-pattern user-homedir-pathname (&optional form) :lisp)
+(define-caller-pattern open (form &key (:star form)) :lisp)
+(define-caller-pattern with-open-file
+ ((var form (:rest :ignore))
+ (:star declaration)
+ (:star form))
+ :lisp)
+
+(define-caller-pattern rename-file (form form) :lisp)
+(define-caller-pattern delete-file (form) :lisp)
+(define-caller-pattern probe-file (form) :lisp)
+(define-caller-pattern file-write-date (form) :lisp)
+(define-caller-pattern file-author (form) :lisp)
+(define-caller-pattern file-position (form (:optional form)) :lisp)
+(define-caller-pattern file-length (form) :lisp)
+(define-caller-pattern file-string-length (form form) :lisp2)
+(define-caller-pattern load (form &key (:star form)) :lisp)
+(define-variable-pattern *load-verbose* :lisp)
+(define-variable-pattern *load-print* :lisp2)
+(define-variable-pattern *load-pathname* :lisp2)
+(define-variable-pattern *load-truename* :lisp2)
+(define-caller-pattern make-load-form (form) :lisp2)
+(define-caller-pattern make-load-form-saving-slots (form &optional form)
+ :lisp2)
+(define-caller-pattern directory (form &key (:star form)) :lisp)
+
+;;; Errors
+(define-caller-pattern error (form (:star form)) :lisp)
+(define-caller-pattern cerror (form form (:star form)) :lisp)
+(define-caller-pattern warn (form (:star form)) :lisp)
+(define-variable-pattern *break-on-warnings* :lisp)
+(define-caller-pattern break (&optional form (:star form)) :lisp)
+(define-caller-pattern check-type (form form (:optional form)) :lisp)
+(define-caller-pattern assert
+ (form
+ (:optional ((:star var))
+ (:optional form (:star form))))
+ :lisp)
+(define-caller-pattern etypecase (form (:star (symbol (:star form)))) :lisp)
+(define-caller-pattern ctypecase (form (:star (symbol (:star form)))) :lisp)
+(define-caller-pattern ecase
+ (form
+ (:star ((:or symbol ((:star symbol)))
+ (:star form))))
+ :lisp)
+(define-caller-pattern ccase
+ (form
+ (:star ((:or symbol ((:star symbol)))
+ (:star form))))
+ :lisp)
+
+;;; The Compiler
+(define-caller-pattern compile (form (:optional form)) :lisp)
+(define-caller-pattern compile-file (form &key (:star form)) :lisp)
+(define-variable-pattern *compile-verbose* :lisp2)
+(define-variable-pattern *compile-print* :lisp2)
+(define-variable-pattern *compile-file-pathname* :lisp2)
+(define-variable-pattern *compile-file-truename* :lisp2)
+(define-caller-pattern load-time-value (form (:optional form)) :lisp2)
+(define-caller-pattern disassemble (form) :lisp)
+(define-caller-pattern function-lambda-expression (fn) :lisp2)
+(define-caller-pattern with-compilation-unit (((:star :ignore)) (:star form))
+ :lisp2)
+
+;;; Documentation
+(define-caller-pattern documentation (form form) :lisp)
+(define-caller-pattern trace ((:star form)) :lisp)
+(define-caller-pattern untrace ((:star form)) :lisp)
+(define-caller-pattern step (form) :lisp)
+(define-caller-pattern time (form) :lisp)
+(define-caller-pattern describe (form &optional form) :lisp)
+(define-caller-pattern describe-object (form &optional form) :lisp2)
+(define-caller-pattern inspect (form) :lisp)
+(define-caller-pattern room ((:optional form)) :lisp)
+(define-caller-pattern ed ((:optional form)) :lisp)
+(define-caller-pattern dribble ((:optional form)) :lisp)
+(define-caller-pattern apropos (form (:optional form)) :lisp)
+(define-caller-pattern apropos-list (form (:optional form)) :lisp)
+(define-caller-pattern get-decoded-time () :lisp)
+(define-caller-pattern get-universal-time () :lisp)
+(define-caller-pattern decode-universal-time (form &optional form) :lisp)
+(define-caller-pattern encode-universal-time
+ (form form form form form form &optional form) :lisp)
+(define-caller-pattern get-internal-run-time () :lisp)
+(define-caller-pattern get-internal-real-time () :lisp)
+(define-caller-pattern sleep (form) :lisp)
+
+(define-caller-pattern lisp-implementation-type () :lisp)
+(define-caller-pattern lisp-implementation-version () :lisp)
+(define-caller-pattern machine-type () :lisp)
+(define-caller-pattern machine-version () :lisp)
+(define-caller-pattern machine-instance () :lisp)
+(define-caller-pattern software-type () :lisp)
+(define-caller-pattern software-version () :lisp)
+(define-caller-pattern short-site-name () :lisp)
+(define-caller-pattern long-site-name () :lisp)
+(define-variable-pattern *features* :lisp)
+
+(define-caller-pattern identity (form) :lisp)
+
+;;; Pretty Printing
+(define-variable-pattern *print-pprint-dispatch* :lisp2)
+(define-variable-pattern *print-right-margin* :lisp2)
+(define-variable-pattern *print-miser-width* :lisp2)
+(define-variable-pattern *print-lines* :lisp2)
+(define-caller-pattern pprint-newline (form &optional form) :lisp2)
+(define-caller-pattern pprint-logical-block
+ ((var form &key (:star form))
+ (:star form))
+ :lisp2)
+(define-caller-pattern pprint-exit-if-list-exhausted () :lisp2)
+(define-caller-pattern pprint-pop () :lisp2)
+(define-caller-pattern pprint-indent (form form &optional form) :lisp2)
+(define-caller-pattern pprint-tab (form form form &optional form) :lisp2)
+(define-caller-pattern pprint-fill (form form &optional form form) :lisp2)
+(define-caller-pattern pprint-linear (form form &optional form form) :lisp2)
+(define-caller-pattern pprint-tabular (form form &optional form form form) :lisp2)
+(define-caller-pattern formatter (control-string) :lisp2)
+(define-caller-pattern copy-pprint-dispatch (&optional form) :lisp2)
+(define-caller-pattern pprint-dispatch (form &optional form) :lisp2)
+(define-caller-pattern set-pprint-dispatch (form form &optional form form)
+ :lisp2)
+
+;;; CLOS
+(define-caller-pattern add-method (fn form) :lisp2)
+(define-caller-pattern call-method (form form) :lisp2)
+(define-caller-pattern call-next-method ((:star form)) :lisp2)
+(define-caller-pattern change-class (form form) :lisp2)
+(define-caller-pattern class-name (form) :lisp2)
+(define-caller-pattern class-of (form) :lisp2)
+(define-caller-pattern compute-applicable-methods (fn (:star form)) :lisp2)
+(define-caller-pattern defclass (name &rest :ignore) :lisp2)
+(define-caller-pattern defgeneric (name lambda-list &rest :ignore) :lisp2)
+(define-caller-pattern define-method-combination
+ (name lambda-list ((:star :ignore))
+ (:optional ((:eq :arguments) :ignore))
+ (:optional ((:eq :generic-function) :ignore))
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp2)
+(define-caller-pattern defmethod
+ (name (:star symbol) lambda-list
+ (:star (:or declaration documentation-string))
+ (:star form))
+ :lisp2)
+(define-caller-pattern ensure-generic-function (name &key (:star form)) :lisp2)
+(define-caller-pattern find-class (form &optional form form) :lisp2)
+(define-caller-pattern find-method (fn &rest :ignore) :lisp2)
+(define-caller-pattern function-keywords (&rest :ignore) :lisp2)
+(define-caller-pattern generic-flet (((:star (name lambda-list))) (:star form))
+ :lisp2)
+(define-caller-pattern generic-labels
+ (((:star (name lambda-list))) (:star form))
+ :lisp2)
+(define-caller-pattern generic-function (lambda-list) :lisp2)
+(define-caller-pattern initialize-instance (form &key (:star form)) :lisp2)
+(define-caller-pattern invalid-method-error (fn form (:star form)) :lisp2)
+(define-caller-pattern make-instance (fn (:star form)) :lisp2)
+(define-caller-pattern make-instances-obsolete (fn) :lisp2)
+(define-caller-pattern method-combination-error (form (:star form)) :lisp2)
+(define-caller-pattern method-qualifiers (fn) :lisp2)
+(define-caller-pattern next-method-p () :lisp2)
+(define-caller-pattern no-applicable-method (fn (:star form)) :lisp2)
+(define-caller-pattern no-next-method (fn (:star form)) :lisp2)
+(define-caller-pattern print-object (form form) :lisp2)
+(define-caller-pattern reinitialize-instance (form (:star form)) :lisp2)
+(define-caller-pattern remove-method (fn form) :lisp2)
+(define-caller-pattern shared-initialize (form form (:star form)) :lisp2)
+(define-caller-pattern slot-boundp (form form) :lisp2)
+(define-caller-pattern slot-exists-p (form form) :lisp2)
+(define-caller-pattern slot-makeunbound (form form) :lisp2)
+(define-caller-pattern slot-missing (fn form form form &optional form) :lisp2)
+(define-caller-pattern slot-unbound (fn form form) :lisp2)
+(define-caller-pattern slot-value (form form) :lisp2)
+(define-caller-pattern update-instance-for-different-class
+ (form form (:star form)) :lisp2)
+(define-caller-pattern update-instance-for-redefined-class
+ (form form (:star form)) :lisp2)
+(define-caller-pattern with-accessors
+ (((:star :ignore)) form
+ (:star declaration)
+ (:star form))
+ :lisp2)
+(define-caller-pattern with-added-methods
+ ((name lambda-list) form
+ (:star form))
+ :lisp2)
+(define-caller-pattern with-slots
+ (((:star :ignore)) form
+ (:star declaration)
+ (:star form))
+ :lisp2)
+
+;;; Conditions
+(define-caller-pattern signal (form (:star form)) :lisp2)
+(define-variable-pattern *break-on-signals* :lisp2)
+(define-caller-pattern handler-case (form (:star (form ((:optional var))
+ (:star form))))
+ :lisp2)
+(define-caller-pattern ignore-errors ((:star form)) :lisp2)
+(define-caller-pattern handler-bind (((:star (form form)))
+ (:star form))
+ :lisp2)
+(define-caller-pattern define-condition (name &rest :ignore) :lisp2)
+(define-caller-pattern make-condition (form &rest :ignore) :lisp2)
+(define-caller-pattern with-simple-restart
+ ((name form (:star form)) (:star form)) :lisp2)
+(define-caller-pattern restart-case
+ (form
+ (:star (form form (:star form))))
+ :lisp2)
+(define-caller-pattern restart-bind
+ (((:star (name fn &key (:star form))))
+ (:star form))
+ :lisp2)
+(define-caller-pattern with-condition-restarts
+ (form form
+ (:star declaration)
+ (:star form))
+ :lisp2)
+(define-caller-pattern compute-restarts (&optional form) :lisp2)
+(define-caller-pattern restart-name (form) :lisp2)
+(define-caller-pattern find-restart (form &optional form) :lisp2)
+(define-caller-pattern invoke-restart (form (:star form)) :lisp2)
+(define-caller-pattern invoke-restart-interactively (form) :lisp2)
+(define-caller-pattern abort (&optional form) :lisp2)
+(define-caller-pattern continue (&optional form) :lisp2)
+(define-caller-pattern muffle-warning (&optional form) :lisp2)
+(define-caller-pattern store-value (form &optional form) :lisp2)
+(define-caller-pattern use-value (form &optional form) :lisp2)
+(define-caller-pattern invoke-debugger (form) :lisp2)
+(define-variable-pattern *debugger-hook* :lisp2)
+(define-caller-pattern simple-condition-format-string (form) :lisp2)
+(define-caller-pattern simple-condition-format-arguments (form) :lisp2)
+(define-caller-pattern type-error-datum (form) :lisp2)
+(define-caller-pattern type-error-expected-type (form) :lisp2)
+(define-caller-pattern package-error-package (form) :lisp2)
+(define-caller-pattern stream-error-stream (form) :lisp2)
+(define-caller-pattern file-error-pathname (form) :lisp2)
+(define-caller-pattern cell-error-name (form) :lisp2)
+(define-caller-pattern arithmetic-error-operation (form) :lisp2)
+(define-caller-pattern arithmetic-error-operands (form) :lisp2)
+
+;;; For ZetaLisp Flavors
+(define-caller-pattern send (form fn (:star form)) :flavors)
1
0