From 208d160a1bf334912f362cf258c375b55544cd2b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 18 Jan 2007 12:20:57 +0000 Subject: [PATCH] MrEd-less reading of WXME files (work in progress, but it's mostly there) svn: r5393 --- collects/mred/private/snipfile.ss | 41 +- collects/mred/wxme.ss | 7 + collects/mred/wxme/comment.ss | 20 + collects/mred/wxme/compiled/wxme.dep | 1 + collects/mred/wxme/compiled/wxme.zo | Bin 0 -> 22143 bytes collects/mred/wxme/nested.ss | 29 ++ collects/mred/wxme/number.ss | 23 ++ collects/mred/wxme/scheme.ss | 23 ++ collects/mred/wxme/text.ss | 18 + collects/mred/wxme/wxme.ss | 595 +++++++++++++++++++++++++++ collects/mred/wxme/xml.ss | 52 +++ collects/mred/wxmecompat.ss | 39 ++ collects/mred/wxmefile.ss | 6 + 13 files changed, 844 insertions(+), 10 deletions(-) create mode 100644 collects/mred/wxme.ss create mode 100644 collects/mred/wxme/comment.ss create mode 100644 collects/mred/wxme/compiled/wxme.dep create mode 100644 collects/mred/wxme/compiled/wxme.zo create mode 100644 collects/mred/wxme/nested.ss create mode 100644 collects/mred/wxme/number.ss create mode 100644 collects/mred/wxme/scheme.ss create mode 100644 collects/mred/wxme/text.ss create mode 100644 collects/mred/wxme/wxme.ss create mode 100644 collects/mred/wxme/xml.ss create mode 100644 collects/mred/wxmecompat.ss create mode 100644 collects/mred/wxmefile.ss diff --git a/collects/mred/private/snipfile.ss b/collects/mred/private/snipfile.ss index ed990c4969..db4e61ae4f 100644 --- a/collects/mred/private/snipfile.ss +++ b/collects/mred/private/snipfile.ss @@ -15,18 +15,39 @@ ;; snip-class% and editor-data-class% loaders + (define (ok-string-element? m) + (and (string? m) + (regexp-match? #rx"^[-a-zA-Z0-9_. ]+$" m) + (not (string=? m "..")) + (not (string=? m ".")))) + + (define (ok-lib-path? m) + (and (pair? m) + (eq? 'lib (car m)) + (pair? (cdr m)) + (list? m) + (andmap ok-string-element? (cdr m)))) + (let ([load-one (lambda (str id %) - (let ([m (with-handlers ([void (lambda (x) #f)]) + (let ([m (with-handlers ([exn:fail:read? (lambda (x) #f)]) (and (regexp-match #rx"^[(].*[)]$" str) - (read (open-input-string str))))]) - (if (and (list? m) - (eq? 'lib (car m)) - (andmap string? (cdr m))) - (let ([result (dynamic-require m id)]) - (if (is-a? result %) - result - (error 'load-class "not a ~a% instance" id))) + (let* ([p (open-input-string str)] + [m (read p)]) + (and (eof-object? (read p)) + m))))]) + (if (or (ok-lib-path? m) + (and (list? m) + (= (length m) 2) + (ok-lib-path? (car m) + (ok-lib-path? (cadr m))))) + (let ([m (if (ok-lib-path? m) + m + (car m))]) + (let ([result (dynamic-require m id)]) + (if (is-a? result %) + result + (error 'load-class "not a ~a% instance" id)))) #f)))]) ;; install the getters: (wx:set-snip-class-getter @@ -233,7 +254,7 @@ (let ([p (open-input-file filename)]) (port-count-lines! p) (let ([p (cond - [(regexp-match-peek #rx#"^WXME01[0-9][0-9] ## " p) + [(regexp-match-peek #rx#"^(?:#reader(lib\"wxme[.]ss\"\"mred\"))?WXME01[0-9][0-9] ## " p) (let ([t (make-object text%)]) (send t insert-port p 'standard) (close-input-port p) diff --git a/collects/mred/wxme.ss b/collects/mred/wxme.ss new file mode 100644 index 0000000000..fe0aac6944 --- /dev/null +++ b/collects/mred/wxme.ss @@ -0,0 +1,7 @@ + +(module wxme mzscheme + (require "wxme/wxme.ss") + + (provide (rename wxme:read read) + (rename wxme:read-syntax read-syntax))) + diff --git a/collects/mred/wxme/comment.ss b/collects/mred/wxme/comment.ss new file mode 100644 index 0000000000..514cb95ad2 --- /dev/null +++ b/collects/mred/wxme/comment.ss @@ -0,0 +1,20 @@ + +(module comment mzscheme + (require (lib "class.ss") + (lib "string.ss") + "../wxmefile.ss" + "nested.ss") + + (provide reader) + + (define reader + (new (class nested-reader% + (define/override (read-snip text? vers stream) + (let ([s (super read-snip text? vers stream)]) + (if text? + (apply bytes-append + (map (lambda (s) + (bytes-append #"; " s #"\n")) + (regexp-split #rx#"\n" s))) + s))) + (super-new))))) diff --git a/collects/mred/wxme/compiled/wxme.dep b/collects/mred/wxme/compiled/wxme.dep new file mode 100644 index 0000000000..d945c8dcaf --- /dev/null +++ b/collects/mred/wxme/compiled/wxme.dep @@ -0,0 +1 @@ +("369.5" (collects . #"mzlib/port.ss") (collects . #"mzlib/string.ss") (collects . #"mzlib/kw.ss") (collects . #"mzlib/class.ss")) diff --git a/collects/mred/wxme/compiled/wxme.zo b/collects/mred/wxme/compiled/wxme.zo new file mode 100644 index 0000000000000000000000000000000000000000..d7b7b291c776cc9372ff31102e311ce1cd01e7c1 GIT binary patch literal 22143 zcmc(Hd32n`wP&kZ-Kt(>$+p~WOS0XYR;wk;mNywJdEc-tFkrxIOKMrdQn%=C+pYyqR|ZzN%Zd?!8rY>sEcA`yRv6<*RC!{Yj_O<>+)qok>@yv+LZt<+=^J7Ts;S z!@9e5PwL*({X#dY`@Qb}>8v>wIgL5Hb9_0GoJVqA&iQH1?{co>{9}$mn8hryK&%k! z#jT=E92bv?m&F_6S7Jo`NAX|8Ct`-aLVvyfHvJL(gZiiRuj${>U)29b|6lc=>g~DJ zx$ARp%{`QRB)2d3f!wEaKg_+7do?%DU^i44mKd51I}LXjS`EhxrwuO~&KrJgxM29L z;rE9BY4|6DFq(~aqr+HhTw&a3yw%uhJZik(_+8^G#-AA9GycZ-2jicN|7bMiS@LG( z&C9FETb#E#Z&Tj(yqoiac@O11miO=TKFqtCmoH1?b#kY?MYhR%A zg7uvBy!FS{pIhIv4qC^ozqS6Y^&{&)SpS#xpRAu+_4(%fnfY_`7v`7ed-EIeSLd(G z-u-y!YxlPW+x?qEeqXz{6TlzZ*&7T+yld2hb}#+f8jggHwnZ9M zfz3U>BYv&$dX?3*O~u}}ZeKX;5AO>5BU*_>mUEX@q}>kQ21!zNFaDT(3CSTy?FYQ4CG;N zBPooq}?8&5*a+1h;yM0{&Z^YjhY04>LhKGqpW|_CUD;&{sQ+!al3pIkh zsOb-cyMlqRH%#RE1HRU7f4gzsyxvgPF<-=Ar*L%zz>I*eyEYtd>h5Zte?ZJPO3BZV zCB%GDDi*AVOhH|l61~5@D-r|)+q=STzEDCH!gU?NAaI3MAx#!cx@t+WHN1thsM*8* z&@TR=5PG%xJ2@}l4@dm%UiD}vcRu6~AMK8Wy=zF#HgYM--=Qg7ib301=~BNpr;<(E zQ)zF&*W=GABEe3{bgBjw-N(=;@KMP$t)P|9np+$pranIaA2b_Qbg}EjNSw>G@72 z%Z{!-h*A^zMpj2EyGaQ@6bgnCO5yMGwM8~{bOqX#s+L*4M{McgYZ3_k< z4JtC2+Q)Y@V}xkQfGa055rdbFd%AMz4CtWq>enwT6)c|-n=?MzOp zbKALI$ah>5$|f~dDR*mcDA?ObDXN^936(0VnNX$ItEg$0rsYJJKM>*hQ%!SO9yqsX zir&=&mD$8P&dGHQo3?R8(;LQmkDsU2%q-_7^_%*#ozy<{)45)yk8erkA5Uazsy9Sesx7Qcx+)RlcUvDq;d1vs5#ze2b+us8gG;Kjv zqG(gjoDh~EOavj$(`q?4xXXHdAz#nQt?sg(V94(cw{@cS79|LN6yB-UB=7OQ9z5si ziy$j!sX2@h84O2`Gm;HGCsq5K zQaZ9JHSn9egTdZ~d4w0mjdSOw&xQ{E;efvT`=GfQk08dwkHv624;}aT9F=OZ_P66lm7^mR>~YZWX>{Ck3?l%AyB&d} zJ+1x_NKuj`S{UEwe>(dBTv z0V2M`=(Z!$=||7V_5n6%SDSxpyC2g5YZQzeV?jYzAWYA}d;GgQ*0Tux;Vr4&`@`$h zVyKoOWqxesSukN;@Dt5OKw$`}$7nXQT-t(11CeH8;ChW(OjFt#vtFBijk9KDXb#ue zl0K6$p9+Kf*eM5`-p%R)ix6We5(0T!bEk ztq98y)+1~~*pASKZ~&nKVH1K2!GO?-;6^A%s6y}|v?I(z=tgiNco1$xID~KzVJE_V zgnbBm5$-^^9pN^FJqWiV+=6g3!fu2B!c7QW2y+n{5SAh=L8wPqj8KPAi{M45L0E(k zL8wM3MyNzEBD5gvLI@)4K)4QJ4Z`&Zs}ULzRw1lJup`(I<{%V-boqvmuM7D%V%8av zC(lzPRb*0;O+`g2nx&#b70pnQRYhhM*;O=0MYB~jQ$+RCI@mZd1{%h#ar#Z+}I$mn|vG z6Gz1{`GR4YeBcv#+F<#hbkg>&h)&oZ$pd&XZ_<`yd&)Rr+ZrpGwEa{JmLpm6s;ovZ6^admaTHP6*jZOm+gVp(PSISE zQ>fd0rn2ZzsF_wi%y4G2ENMC8q7thLBMUG9_5B2M85$TG8RjvR3{4Ep3@r?;4D%Vz zU|7Jgkl{>*vlz~1Sj2D+LmNXo!?_ISF)U_S0=Q6FvBB0mvF6Pt`W*bs$*LTy`_VEey9Z+{SP_ z!y6dxV7QavE`}`(Z)A8A!`%#TW_Sz3TN&>0?W9Zxs(DN(#G5cG0`;Uc1`lPJh3Vzb_ltw7gFA0tQYTzX<>+Y` zus@1nhm^w}YJ$zO4)#t3?3yarC~nwWo3Z{k!Va*&ewqzCYYx`^0@xU}urC(F23rc7 zq8|1|4QvPp?3?AVx2ok9OJOMtl07hF4#HU33j^k67%MwrVC;hN=7%wJ00z&kFmmpI z@pBW5jS?6{Juqg1g{781^Y<^uD~n~Ruh6hx^p;H6ew=Uq%(iY~xTxT4wacYqw-$R` z|BOeM@uFEd9}D!i|e#_u@={B@e-H0o@abr;Y{b7 z!ufsS{DE-(P&ogMaQ;X*e=M9o5ze=S^KIe$sc^m{oIexJp9|+Ng!7le`72?eo<%;l zXP=;FW9V5edd4w&#xZ)vaiuF+1fAn7bdKXiT3q8Y*J_knoc~rh-xbdHg!6)MzAv2j z>YexLo%idV59pl_>YWeinXd5X(sdPdje;&O=;9c3aa`d_J_6G@3v_W@?J|2cI!w-o z_0C81&PVmmZ|a?o>79@3oloeU-_kozDGGw0OTh#vh=YPfpdgVfcbOMyEf}0n>YbFLz6g$CUFc+ z;&`#kyjY{M!1;{c`K;dgoZk7o-uWH9^SgTI3wq~^dgn`e=gWHM8NKtY-uXSf^PJxK zir!MNe)kzyp&+BMa;awQye=x``ESZsrR75%8+h@kwd9kQvlViodvqi&j+Y?!Uj1-2 z@+y%xHaa5uuEI2&wEaA{e9Vle7sROB{ITr`{hk9QpSGN-me&uDUK$@OExkC=a;99a z0j!YT0n6UAWtKb6xm^}vxZ|A1ZMoWVW|3?XC-A&RdWVJK>fjKktA;6BHhz_wYy=sD zpS7H=mX8Vd$mrPkr3u?x!d}pF)NDhmW*lxo)!3&F{Puv~9IB9!~ zyI)Nv@dYugdjFRrJ8^Af)Vpscd*`Z<#nzAT;zc$p#D~+4byXWobT?t9C zQf_b$$4B5VNpt5U_WNYqN1^?13)%<_sqzcCJbV}ANMzr)BXXkGue2b}tg4V3hqJM2 z6s#&NOsjajt3A>w?jB1qY$RP>6wVRGSt&Qhv*8>A&Y3gQaCZ8;4tGYx-Qy{wql|P+ zNkJhUWu#Sd<4887<3O6hkv?y*qXQmGardPZ+A&5uo{n~m(N@ciquJ12nu_*B67A&_ z+HppENka=6c`>TSFI|TJDXp6!e>W8Fn7@ho^PC(p(BQlvF1w+iPss_}efl_U+D_%E z{@M#^eAWY#z0f|>KFesgry=8{=6p*IUHdFGcI~s1>ie#64VbVSAx&t2=GbT3i|lj6 z*QO}Sr}Xp@;T~4c-B`XART#8&_5wpr?Po1#7Rw!_G0UYG=8HHf^P@>+mdzE3$>%Yn zbjT}fwn1m#&P_}}!_fo{RiFVQei{LohTjsTO7Dt+SfX$Z3WJT)3WM4jq81a!Wva*2 z;I}q$xGHL|IkJ{v-k_273XQB#GpKypM)O7w_)`vEW48zQT87h-2TR)HqN2>lt-%nE zM$-z+o0nOj+usp!^uXrs3Z#{qJ2$gbB-lH>P;qf)p%9If>BUM)GK;kaBM~@)KetV$ z3@%N7B#kh;JrfxbHnq&uE-JdFmYPbvMiv)?sPEN({yaUEm>#%kwK?cZPTJEj`}+P$ zn5RmXXim&=Uy|r)s6q4>Kz%{P+-VY?iX}o?g_ER6la;5Wm?y39R6hB-yAB8F>_)RG zobK3gd^9mzl-0$_MDWNh{WL{9oE((WLsLZd)qLsF6>3y|8>8~v|B)}v;H5l`h?z6h zF^*cjI=X#_!^)!BK&@luPk*d=!g(?oc9UOg!uCSmfcovhG*5Hwr0rL{Mh=!IZGx;= zjCFNkoGv(m9encQAa^;ABItP5(WMS1e2yL*RCo2_a0aCs;@l7x;i;ZD6FJqQ>Hf44 zSGkEfKJ2+@C4N1W;#a#T;k^1~ZneDd_wp{9O^NiVbVA_0JkOS*JeZR_u z(G%rda!Vz1%U}vk&n=f5hoE3rR}i>q&~prmT|dV`K4=(UQ_q7-v`j$)sEsr4{U6eVo?5D$K_y zAnr*naHDE{)9eCEY5ymvRV`P

j}gs+ep9kI=y^T_Iy9YX{@gbIIPAo=fHen6XGc zfJKOzL8kM-Fo>>@_Y3On2(bsr1bdo2)tY(!R}v@MFQ@k5xYdM#ABoo5zmnGOOK%N7 zlC723X?^=w61}#oh>t{B0{5mQfMk-&%7!nnL4xEG8zfdj+8~hZr8jogG<1tp_Z@9;kS{#k@&g`D4 z8?$?ojQna;`5S4P{EbvwWXthU$8mUn-q|64x-w-{TK60Rx84&Fx+W%LetxSDPD(z3 zb#%24CnxtQ4~z>JY8O;sM2EvT`t=1In)6VdfX5RH3~jb>I!l+$9CR={#dKzou-d78 z){Gfi<6-Ze!LC5lp5u5(rX?*@R;zm0;p^$@K9Q}34xBnqZGk4X81GXsyANgCr^I=m zqHyzarL9QVj*g`EDZ}8_1rb-9gEXpW;iKMhOHV_Pn4#JwMJHHAlv?!otjF z9UW;E6TAp_`vQ^7dI_A`qmB-iWUK-jpN3%8ERC`rTsG^ZH8-R2B;l#Y8SN*YAH{`> zP&W?p+cWDI6)E)T&l8kXW>R9eYm~qkz}+TqFD^NChcnU5otwQ(0%chy%0%n%$>Uam zkNnn|_~y(}_%aGGvM-_!^XIGDxEA3*9KyYV_Jo~s0;Wv+wKaohpwHL0g$u8Z|8U6f z4}9qs7A&}S3$5Kp{a?C)1dCdIZAZRJ7G=Z#*JV+*7XCbo(neW=4QZN^m<32v(n@BL zd9oyTD6MQ3=_Sh&X=z0h1f=yMSu{HV*-BoEfNW)_5RjN>lAD{%ftZ*_(jIGL8l6Zi zJ(%n|yE<^Wl;_g)wP)&+FR=K)#Ze)@&W0p;IL64D{CaX#{A$d*ucfWPU;B#Nx;w3{ zyOV9D+(_M(^7JP8xIS&MS8g%(T9YT647G10cLpPBXOQ$-^Bgvuu^FJXbGi+Lol%TU z>67l^qzyDcy9W4`fCc`jA**V7B(W(W2UeO zJD&8b4U^U#PfF*j(YljqnsD+fZtFx^TPMEaw))cA>PxoOT#?v>9IBG{HOUK8eWYX) zR>SX!&4jpDOtA!UyizIaqvSpw688xUt4fB~l&X7C{nBN7LDu?<((ALlk0s^Je$-=W zv?iRoJF4WP_3~|VYBXvtTI}NMFdA?%GIax%jpR>ggI_j?2)=M4242;)BHGXwSwHo+-ZF`r`f*w@KqqIZAKKw0li8S_T zst1)TwB5ssN_oyHziXu)&>kwb=Kz>lCQAp0=pqrjA3Sw2<$%Yfppi*(V!6cqV((eE zI^sg^=E}XS_Tpr+kK){jQBrD}lD&(nLxU7I^PuN!f z#!7;ETMX0XA#}J}^4@Bc2^nBQDr70P2MI#T>$H;qG#LdU<DBllIVIJVd$U&)o{$r-fgAXgQy>1h+ADi5KucnGez#(wqiZ>BzcSUrS4 zO;3J2RqAy;oh>O8aYFG3m*Oe#Juy&jRmI*QL8p-^9#zQD=St6Td}xFcWk?Kyb~n>L ztK?(b1rybRINme$ql<4z@lAnu)uPtDXDgr#6)wv^+uksVUQ3nBVj3@=Y0IM%8vE?4 zwl__7yGuNdf%|=veXdGTo?ASj<*5|qdBnH0Je8unGI2`FQz^}_ z0e%i~Y9UhMDFGyv4bg#%Aj*>>if$h|K~#-LzE&*1Pi6)qRucm1m&^H}k9?9|(vfnx z06*iLT8I=71EDNQVWd$~4vb4Y@~H*#AP^?!7b@vUm0X6B6)3sPBY(C~J~D$C!i|^9 zQlLf~6>>frL*tcR>STpnfS*JL>>i}hI8Pn@JawpAiK(Nk4tEdf5D`;{34Je{Hg%Z3 z#MDtGBidAp*-T9xb<&O5o#qY`_0!4yw0`k16tR@^7_!*%AYUFpGhO0orO2~X3d%jx zEuPWxREqLE;#ndG>PJR&3y3CUwZ@}Q7BDkKjJ$>T!uz>u{G zu}M!EIilu4ZreQa{aSf}mJ+PCnoMv?p0;}Njr}T zj>(n>b!P4qB)L`ITk`OhJia9laLFTF@(`EHnNKSi zDspkT#Kjkmi_!W07{%Ag$MRI?`AP{iGV=wJWbfIAb*ZyoGEC?^mkii!c1`sZyJV3( z=8nS%B0^Rrq~IzeN3#ob-06`IZ;;O$hz>TmV`L%IzJSP?KmS^i&m$Sf z<(kQzydLuxZ#1x_$g8y9rA7a8XssV&A-m$Oz@%>qdu@imS* zc#Cnjc4(u{DWI0sFzkn+Qyx-`(jgZlpTvUBB6w{XK zC3W^9T4m~&*=MuY)hlsaf;$yBgqW~BnAd-?WCD+C>MjqE9eB-474@qi;RbN*A$_BK z{}uT|Vg5+M7$ysPZU3iC;kp&HkBNS; z0Vn8&Xq|UJ&rZijqk>l`d zJN9~)99UXkLtuX#gT(fuTy+LNX?s#cF^FjEKvxXtSM#Lpw3xI#jqs$9O|fb!PPYu7 z6a#LqJA@w>#DM(9r0pF<_vWTm_oPi==0w^PH=BtK3sY>MX}bw*_)e}zp8B0UPYa{Q z1|AB0vnifHP(G{{KJ6%oaHZB*x^;<5ClikIUM65yE@rBHoclr_U9=3?jI%Y?rIbbDqq*2S_6|e zBIxy<eI=SBq2M7ZvdauN>lqSVM#=1$non>Ntpe|i&~__>KKsI?5&aT#N}*+&=t z-ZKrP?=7cnE`t_at2K>(YRkhMMwZ{0OMHh-+i^-z8=D#X7KU3HZezHe+bjIb+6!1J z+0-n+W|r-Fwl?Ru#CMfFZBr>&mUGN^gIHToJih6bf_hSdcoeXy|Y+-mK!SpoWxiCTt@Zg*nh zO*=-W=gLA-)8;7V-yh`tmYg0u?R)#J?A58o{T*7yD+V#Vb`8uqFvZP9s}ODk;o);~ zAnEg>T->Wlxn%Eg6DWe@BnM@h8wBHDdhA6-X!=?`I6fvr$KVj-W+xY6ls^9ATt z>FyxjyH4A@sM2_WJUmFdW_f)Y-)QaJ3cj5&dgPVZ4qTsng7!fftXp(V)@6Ckys~mS z|5EQ#|2ZbE(3rSVW8zX`;=zDuv3(x-hAfuyIfukqA-*TXIlQ54qQ5z_3%UCY2{HX<8{h`_XVaX@9yw7ZF zZ+~TphfJ?Ip^h$xdMgdOM_1736D_FqGh?N^(sCnet+#w+##$d8a+ORD#@r>7L&F|0 z1r`f!j>wpd4GoSa7lD{s1cub^huXm^f)CAPZ{}Cj%)8Xgb<~VzB2C8PE(AA%XBZoS z1`lln=7hTXveNn5)=%b=$Chb~nv&ZltQfak9gMl6 zsjTm*EO%PgIhEx}%j)HNWzo+@Xlrgln--cOiq)8zutnCwZSU)*yn`x_*LwCAwn0^& z%)_+t8TE!<_Jwdy8~bS<%h%cQqOj}0Ua!x4a;^7{#okp1YaRO+d0cdB^Eu-H-fXX} zwa~tWenyQsIkgsU`cPtWa=9ze^>#G!EH&~&e9%h1LZ&2ISxH!)kzzi)%w(vogj1fb zQZ*02KyEqfk%w?gboC&;vqq%*5;&#DLsp6(NM9nPH{AlH53$doggORSksHFZ^BaZQ z%Z}m1YmLjurhPe2R?91IpkBS@12V(sS;%A5Ry5-*+5c?>u!+tGE{Chq^arEN)hC`^ z)DnKk)m>@&JAICB(pEse$PVPVYD|B~)#C*l66)dT;Dl{09CEhD&Dbiv26N=u+(CNM zp#<-DFdaV7x}$}X6gcMlr}{%ztK+52LU$Hz1N#rzJI=p zRcT#BjehjB^x{RhG8E;k1A7(aECQG8DxTAFW`(>{$#0eHvYoP8Y%d_3wwi5EBYqa) zIi#OQ_znV2nrzQlE%0T##G8#t-tb|Q5oA6p!J8jY=U%4q1|j1#4ni&;V%-M^U!xWCaq7&h zeJJ*h-uy>FRPySvRNDbq_8b6Ps~X_)z$ICphusOEKv}X?{un_e&^=A9TK5CpFKE-F zyeN3B?PJ^b4Mo<2xI+(TOHX{zVk@OViOE5ImkcjB)AaVN#QNPv)xT}9{K23TIndnG z25iHBof{h{`FN1elz68+tkB6o_9-0^$#-N?By_`E}dn{K= zMv)|@X(w&ic<`*H_91jysf^g&XUdB99~51n(^GHyFozl8kwIOx`Xqx}nR$CF_hbC- zb7|iz+UMHm>cNeheJ+ebS2T5Cmpbhui)Px9-L%KoIJBde%+#TshUQwwcBunGt)O;r zhZCc-l`GxI93G-{)hbHIV|0L2n>s+MO&lOq@c~lpYCM(2D0yj29U);sE~T2Ibf!}y z=OZ~b0{hrY=SXl=FQA8GBRERJkA>=oI!&sk(OP#llezEgbK9)@rTh&VU zNSuXMy$UaYvdHR`$jq20>k=ZXW|7rFWOcIGUT`@fu^LEhe2nDfmGdu+leB8Ru{6JV zEd+J>(rCKZ_p&l^wHF59^<7Lan8xDcw8eEnxb&tTa4FF)(nMRKrW)9@SZ1?|_K$`< zqmpf9rfjQHvRwq(#v$2~35@-ci8zgR{;J} z-O!f@OwgBG+Mq8hpe}q~**n-w69d*-QnFC8j;9iQ=s}%_sm^Jt^CB%;s?yMAHjvdP z)aW>XEWYf=0n1iuZ{R&@!W(#hB1BE*4|6ANujdX#sm-w4string/utf-8 (apply bytes-append (reverse accum))) + (loop (cons s accum))))))) + (super-new))))) diff --git a/collects/mred/wxme/wxme.ss b/collects/mred/wxme/wxme.ss new file mode 100644 index 0000000000..b44af9ea13 --- /dev/null +++ b/collects/mred/wxme/wxme.ss @@ -0,0 +1,595 @@ + +(module wxme mzscheme + (require (lib "port.ss") + (lib "string.ss") + (lib "kw.ss") + (lib "class.ss")) + + (define (expect rx port who msg) + (let ([m (regexp-match rx port)]) + (unless m + (error who "bad WXME stream; ~a" msg)) + (car m))) + + (define (decode who port snip-filter) + (expect #rx#"^WXME" port who "does not start with \"WXME\"") + (expect #rx#"^01" port who "unrecognized format (not \"01\")") + (let ([vers (string->number + (bytes->string/latin-1 + (expect #rx#"^0[1-8]" port who "unrecognized version")))]) + (unless (vers . < . 4) + (expect #rx#"^ ##[ \r\n]" port who "missing \" ## \" tag in the expected place")) + (let ([header (read-header who port vers snip-filter)]) + (port->decoded-port who port vers header)))) + + (define-struct header (classes data-classes styles snip-filter skip-unknown? snips-to-go stream)) + (define (header-plain-text? h) + (not (header-snip-filter h))) + + (define (read-header who port vers snip-filter) + (let* ([classes (read-snip-class-list who port vers)] + [data-classes (read-data-class-list who port vers)] + [header (make-header classes + data-classes + (make-hash-table) + snip-filter + (unknown-extensions-skip-enabled) + 0 + #f)]) + (set-header-stream! header (make-object stream% who port vers header)) + (let ([cnt (read-editor who port vers header)]) + (set-header-snips-to-go! header cnt)) + header)) + + (define (read-editor who port vers header) + (discard-headers/footers who port vers) + (read-styles who port vers (header-styles header)) + (read-class-headers who port vers header) + (read-integer who port vers "snip count")) + + (define (read-editor-footers who port vers header) + (discard-headers/footers who port vers)) + + (define (read-nested-editor who port vers header) + (let ([cnt (read-editor who port vers header)]) + (let loop ([cnt cnt][accum null]) + (if (zero? cnt) + (begin + (read-editor-footers who port vers header) + (if (header-plain-text? header) + (apply bytes-append (reverse accum)) + (snip-results->port 'nested-editor + (let ([results (reverse accum)]) + (lambda () + (and (pair? results) + (begin0 + (car results) + (set! results (cdr results))))))))) + (loop (sub1 cnt) + (cons (read-snip who port vers header) + accum)))))) + + (define-struct snip-class (name version required? manager)) + + (define (read-snip-class-list who port vers) + (let ([cnt (read-integer who port vers "snip-class count")]) + (list->vector + (let loop ([i 0]) + (if (= i cnt) + null + (cons + (let ([name (read-a-string who port vers "snip-class name")]) + (make-snip-class name + (read-integer who port vers "snip-class version") + (begin (read-integer who port vers "snip-class required?") + ;; required? value isn't actually used; only a few + ;; built-in classes are required + (member name '(#"wxtext" #"wxtab" #"wxmedia"))) + #f)) + (loop (add1 i)))))))) + + (define-struct data-class (name required? manager)) + + (define (read-data-class-list who port vers) + (let ([cnt (read-integer who port vers "data-class count")]) + (list->vector + (let loop ([i 0]) + (if (= i cnt) + null + (cons + (let ([name (read-a-string who port vers "data-class name")]) + (make-data-class name + (equal? name #"wxloc") + #f)) + (loop (add1 i)))))))) + + (define (discard-headers/footers who port vers) + (let ([cnt (read-fixed-integer who port vers "header/footer extension count")]) + (let loop ([i 0]) + (unless (= i cnt) + (let ([len (read-fixed-integer who port vers "header/footer extension length")]) + (skip-data port vers len) + (loop (add1 i))))))) + + (define (read-styles who port vers styles) + (let ([id (read-integer who port vers "style-list id")]) + (hash-table-get styles id + (lambda () + (let ([cnt (read-integer who port vers "style count")]) + (let loop ([i 1]) + (unless (= i cnt) + (unless ((read-integer who port vers "base-style id") . < . i) + (read-error who "integer less than current index" "base-style id" port)) + (read-a-string who port vers "style name") + (if (zero? (read-integer who port vers "style is-join?")) + (begin + (read-integer who port vers "style family") + (read-a-string who port vers "style face") + (read-inexact who port vers "style size multiply") + (read-integer who port vers "style size addition") + (read-integer who port vers "style weight on") + (read-integer who port vers "style weight off") + (read-integer who port vers "style slant on") + (read-integer who port vers "style slant off") + (unless (vers . < . 5) + (read-integer who port vers "style smoothing on") + (read-integer who port vers "style smoothing off")) + (read-integer who port vers "style underlined on") + (read-integer who port vers "style underlined off") + (unless (vers . < . 6) + (read-integer who port vers "style size-in-pixels on") + (read-integer who port vers "style size-in-pixels off")) + (unless (vers . < . 3) + (read-integer who port vers "style transparent on") + (read-integer who port vers "style transparent off")) + (read-inexact who port vers "style foreground multiply red") + (read-inexact who port vers "style foreground multiply green") + (read-inexact who port vers "style foreground multiply blue") + (read-inexact who port vers "style background multiply red") + (read-inexact who port vers "style background multiply green") + (read-inexact who port vers "style background multiply blue") + (read-integer who port vers "style foreground addition red") + (read-integer who port vers "style foreground addition green") + (read-integer who port vers "style foreground addition blue") + (read-integer who port vers "style background addition red") + (read-integer who port vers "style background addition green") + (read-integer who port vers "style background addition blue") + (read-integer who port vers "style alignment on") + (read-integer who port vers "style alignment off")) + (unless ((read-integer who port vers "shift-style id") . < . i) + (read-error who "integer less than current index" "shift-style id" port))) + (loop (add1 i))))) + (hash-table-put! styles id id))))) + + (define (read-class-headers who port vers header) + (let ([cnt (read-fixed-integer who port vers "class-header count")]) + (let loop ([i 0]) + (unless (= i cnt) + (let ([pos (read-integer who port vers "class-header class index")] + [len (read-fixed-integer who port vers "class-header length")]) + (let ([class (find-class pos header who port vers)]) + (if (and class + (object? (snip-class-manager class))) + (send (snip-class-manager class) read-header (snip-class-version class) (header-stream header)) + (skip-data port vers len))) + (loop (add1 i))))))) + + (define (read-snip who port vers header) + (let ([pos (read-integer who port vers "snip class index")]) + (let ([class (find-class pos header who port vers)]) + (let ([len (and (or (not class) + (not (snip-class-required? class))) + (read-fixed-integer who port vers "snip length"))]) + (if class + (let ([style (read-integer who port vers "snip style index")] + [m (snip-class-manager class)] + [cvers (snip-class-version class)]) + (let ([s (if (procedure? m) + (m who port vers cvers header) + (send m read-snip + (header-plain-text? header) + cvers + (header-stream header)))]) + (read-buffer-data who port vers header) + (if (bytes? s) + s + (let ([s ((header-snip-filter header) s)]) + (lambda (src line col pos) + (if (readable? s) + ((readable-ref s) s src line col pos) + s)))))) + (begin + (skip-data port vers len) + #"")))))) + + (define (read-buffer-data who port vers header) + (let loop () + (let ([pos (read-integer who port vers "data-class index")]) + (unless (zero? pos) + (let ([data-class (find-data-class pos header who port vers)]) + (let ([len (and (or (not data-class) + (not (data-class-required? data-class))) + (read-fixed-integer who port vers "data length"))]) + (if data-class + ((data-class-manager data-class) who port vers header) + (skip-data port vers len)))) + (loop))))) + + ;; ---------------------------------------- + + (define (read-raw-string who port vers what) + (let ([v (cond + [(vers . >= . 8) (plain-read port)] + [else (read-integer who port vers what)])]) + (unless (and (integer? v) + (exact? v) + (v . >= . 0)) + (read-error who "non-negative exact integer for string length" what port)) + (let ([s (cond + [(vers . >= . 8) (plain-read port)] + [else (read-bytes v port)])]) + (cond + [(bytes? s) + (unless (= (bytes-length s) v) + (read-error who "byte string whose length matches an integer count" what port)) + s] + [(and (list? s) + (andmap bytes? s)) + (let ([s (apply bytes-append s)]) + (unless (= (bytes-length s) v) + (read-error who "list of byte strings whose total length matches an integer count" what port)) + s)] + [else + (read-error who "byte string or byte-string list" what port)])))) + + (define (read-a-string who port vers what) + (let ([s (read-raw-string who port vers what)]) + (subbytes s 0 (sub1 (bytes-length s))))) + + (define (read-integer who port vers what) + (cond + [(vers . >= . 8) + (let ([v (plain-read port)]) + (unless (and (integer? v) + (exact? v) + (<= (- (expt 2 31)) v (expt 2 31))) + (read-error who "exact integer between [-2^31,2^31]" what port)) + v)] + [else + (let ([b (read-byte port)]) + (cond + [(not (zero? (bitwise-and b #x80))) + (cond + [(not (zero? (bitwise-and b #x40))) + (cond + [(bitwise-and b #x01) + (let ([b (read-byte port)]) + ;; convert to signed: + (if (b . > . 127) + (- b 256) + b))] + [(not (zero? (bitwise-and b #x02))) + (integer-bytes->integer (read-bytes 2 port) #t #t)] + [else + (integer-bytes->integer (read-bytes 4 port) #t #t)])] + [else + (bitwise-ior (arithmetic-shift (bitwise-and #x3F b) 8) + (read-byte port))])] + [else b]))])) + + (define (read-fixed-integer who port vers what) + (cond + [(vers . >= . 8) + (read-integer who port vers what)] + [else + (integer-bytes->integer (read-bytes 4 port) + #t + (if (vers . > . 1) + #t + (system-big-endian?)))])) + + (define (read-inexact who port vers what) + (cond + [(vers . >= . 8) + (let ([v (plain-read port)]) + (unless (and (number? v) + (real? v)) + (read-error who "real number" what port)) + v)] + [else + (floating-point-bytes->real (read-bytes 8 port) + (if (vers . > . 1) + #t + (system-big-endian?)))])) + + + (define (read-error who expected what port) + (error who "WXME format problem while reading for ~a (expected ~a) from port: ~v" + what expected port)) + + (define (skip-data port vers len) + (if (vers . >= . 8) + (let loop ([len len]) + (unless (zero? len) + (plain-read port) + (loop (sub1 len)))) + (read-bytes len port))) + + ;; ---------------------------------------- + + (define-values (prop:readable readable? readable-ref) + (make-struct-type-property 'readable)) + + (define-struct nested (content-port)) + (define-struct image (filename data w h dx dy)) + + (define (find-class pos header who port vers) + (define classes (header-classes header)) + (unless (< -1 pos (vector-length classes)) + (read-error who "integer less than class-list length" "class index" port)) + (let ([class (vector-ref classes pos)]) + (unless (snip-class-manager class) + (set-snip-class-manager! + class + (let ([name (snip-class-name class)]) + (cond + [(member name '(#"wxtext" #"wxtab")) + (lambda (who port vers cvers header) + (read-integer who port vers "string-snip flags") + (let ([s (read-raw-string who port vers "string-snip content")]) + (cond + [(= cvers 1) (string->bytes/utf-8 (bytes->string/latin-1 s))] + [(= cvers 2) + ;; UTF-32! + (unless (zero? (remainder (bytes-length s) 4)) + (read-error who "size of read byte string is not a multiple of 4" "string-snip content" port)) + (let loop ([pos 0][accum null]) + (if (= pos (bytes-length s)) + (string->bytes/utf-8 (apply string (reverse accum))) + (loop (+ pos 4) + (cons (integer-bytes->integer (subbytes s pos (+ pos 4))) + accum))))] + [(cvers . > . 2) s])))] + [(equal? name #"wxmedia") + (lambda (who port vers cvers header) + (read-integer who port vers "nested-editor type") + (read-integer who port vers "nested-editor border") + (read-integer who port vers "nested-editor left margin") + (read-integer who port vers "nested-editor top margin") + (read-integer who port vers "nested-editor right margin") + (read-integer who port vers "nested-editor bottom margin") + (read-integer who port vers "nested-editor left inset") + (read-integer who port vers "nested-editor top inset") + (read-integer who port vers "nested-editor right inset") + (read-integer who port vers "nested-editor bottom inset") + (read-inexact who port vers "nested-editor min width") + (read-inexact who port vers "nested-editor max width") + (read-inexact who port vers "nested-editor min height") + (read-inexact who port vers "nested-editor max height") + (when (cvers . > . 1) + (read-integer who port vers "nested-editor tight-fit?")) + (when (cvers . > . 2) + (read-integer who port vers "nested-editor alignment")) + (let ([n (read-nested-editor who port vers header)]) + (if (header-plain-text? header) + n + (make-nested n))))] + [(equal? name #"wximage") + (lambda (who port vers cvers header) + (let ([filename (read-a-string who port vers "image-snip filename")] + [type (read-integer who port vers "image-snip type")] + [w (read-inexact who port vers "image-snip width")] + [h (read-inexact who port vers "image-snip height")] + [dx (read-inexact who port vers "image-snip x-offset")] + [dy (read-inexact who port vers "image-snip y-offset")] + [rel? (read-integer who port vers "image-snip relative?")]) + (let ([data + (and (and (equal? filename #"") + (cvers . > . 1) + (not (zero? type))) + ;; inlined image + (apply + bytes-append + (let ([len (read-fixed-integer who port vers "image-snip image length")]) + (let loop ([i 0]) + (if (= i len) + null + (cons + (read-a-string who port vers "image-snip image content") + (loop (add1 i))))))))]) + (if (header-plain-text? header) + #"." + (make-image (if data #f filename) data w h dx dy)))))] + [else + ;; Load a manager for this snip class? + (let ([lib (string->lib-path (bytes->string/latin-1 name))]) + (if lib + (let ([mgr (dynamic-require lib 'reader)]) + mgr) + (if (header-skip-unknown? header) + #f + (error who "cannot load snip-class reader: ~s" name))))])))) + class)) + + (define (find-data-class pos header who port vers) + (define data-classes (header-data-classes header)) + (unless (< -1 pos (vector-length data-classes)) + (read-error who "integer less than data-class-list length" "data-class index" port)) + (let ([data-class (vector-ref data-classes pos)]) + (unless (data-class-manager data-class) + (set-data-class-manager! + data-class + (case (data-class-name data-class) + [(#"wxloc") + (lambda (who port vers header) + (read-inexact who port vers "location x") + (read-inexact who port vers "location y"))] + [else + ;; Load a manager for this data class? + (error who "cannot load data-class managers, yet")]))) + data-class)) + + (define stream% + (class object% + (init-field who port vers header) + + (public [rfi read-fixed-integer]) + (define (rfi what) + (read-fixed-integer who port vers what)) + + (public [ri read-integer]) + (define (ri what) + (read-integer who port vers what)) + + (public [rix read-inexact]) + (define (rix what) + (read-inexact who port vers what)) + + (define/public (read-raw-bytes what) + (read-raw-string who port vers what)) + (define/public (read-bytes what) + (read-a-string who port vers what)) + + (public [rne read-nested-editor]) + (define (rne) + (read-nested-editor who port vers header)) + + (super-new))) + + ;; ---------------------------------------- + + (define lib-mapping (make-hash-table 'equal)) + + (define (ok-string-element? m) + (and (string? m) + (regexp-match? #rx"^[-a-zA-Z0-9_. ]+$" m) + (not (string=? m "..")) + (not (string=? m ".")))) + + (define (ok-lib-path? m) + (and (pair? m) + (eq? 'lib (car m)) + (pair? (cdr m)) + (list? m) + (andmap ok-string-element? (cdr m)))) + + (define (register-lib-mapping! str target) + (let ([lib (with-handlers ([exn:fail? (lambda (x) #f)]) + (read (open-input-string target)))]) + (unless (ok-lib-path? lib) + (error 'register-lib-mapping! "given target is not a valid lib path: ~s" target)) + (hash-table-put! lib-mapping str lib))) + + (define (string->lib-path str) + (or (let ([m (and (regexp-match #rx"^[(].*[)]$" str) + (let* ([p (open-input-string str)] + [m (read p)]) + (and (eof-object? (read p)) + m)))]) + (and (and (list? m) + (= (length m) 2) + (ok-lib-path? (car m) + (ok-lib-path? (cadr m)))) + (cadr m))) + (hash-table-get lib-mapping str #f))) + + ;; ---------------------------------------- + + (define plain-params + (parameterize ([current-readtable #f] + [read-accept-reader #f] + [read-case-sensitive #t] + [read-accept-graph #f] + [read-accept-box #f] + [read-accept-bar-quote #t] + [read-decimal-as-inexact #t] + [read-accept-dot #t] + [read-accept-quasiquote #f] + [read-accept-compiled #f]) + (current-parameterization))) + + (define (plain-read port) + (call-with-parameterization + plain-params + (lambda () + (with-handlers ([exn:fail:read? (lambda () 'no-good)]) + (read port))))) + + ;; ---------------------------------------- + + (define (port->decoded-port who port vers header) + (snip-results->port + (object-name port) + (lambda () + (let ([snips-to-go (header-snips-to-go header)]) + (cond + [(zero? snips-to-go) #f] + [else + (set-header-snips-to-go! header (sub1 snips-to-go)) + (read-snip who port vers header)]))))) + + (define (snip-results->port name next-item!) + (define-values (r w) (make-pipe)) + (define (read-proc buffer) + (if (char-ready? r) + (read-bytes-avail! buffer r) + (let ([s (next-item!)]) + (cond + [(not s) + (close-output-port w) + eof] + [(bytes? s) + (write-bytes s w) + (read-proc buffer)] + [else s])))) + (make-input-port/read-to-peek + name + read-proc + #f + void)) + + ;; ---------------------------------------- + + (define unknown-extensions-skip-enabled (make-parameter #f)) + + (define/kw (decode-wxme-stream port #:optional [snip-filter (lambda (x) x)]) + ;; read optional #reader header: + (regexp-match/fail-without-reading #rx#"^#reader[(]lib\"wxme.ss\"\"mred\"[)]" port) + ;; decode: + (decode 'read-bytes port snip-filter)) + + (define (do-read port who read) + (let ([port (decode who port #t)]) + (let ([v (read port)]) + (let ([v2 (let loop () + (let ([v2 (read port)]) + (if (special-comment? v2) + (loop) + v2)))]) + (if (eof-object? v) + null + `(begin + ,@(list v v2 (let loop ([accum null]) + (let ([v (read port)]) + (cond + [(eof-object? v) (reverse accum)] + [(special-comment? v) (loop accum)] + [else (loop (cons v accum))])))))))))) + + (define (wxme:read port) + (do-read port 'read read)) + + (define (wxme:read-syntax source-name-v port) + (do-read port 'read-syntax + (lambda (port) + (read-syntax source-name-v port)))) + + (provide register-lib-mapping! + unknown-extensions-skip-enabled + decode-wxme-stream + (struct nested (content-port)) + (struct image (filename data w h dx dy)) + prop:readable + wxme:read + wxme:read-syntax)) + diff --git a/collects/mred/wxme/xml.ss b/collects/mred/wxme/xml.ss new file mode 100644 index 0000000000..c261fd530a --- /dev/null +++ b/collects/mred/wxme/xml.ss @@ -0,0 +1,52 @@ + +(module xml mzscheme + (require (lib "class.ss") + (lib "xml.ss" "xml") + (lib "list.ss") + "../wxmefile.ss" + "nested.ss") + + (provide reader) + + (define reader + (new (class nested-reader% + (inherit read-nested-snip) + (define/override (read-snip text? vers stream) + (let ([elim-whitespace? (zero? (send stream read-integer "elim-whitespace?"))]) + (read-nested-snip text? vers stream elim-whitespace?))) + + (define/override (generate-special nested src line col pos) + (let* ([port (nested-content-port nested)] + [xml (read-xml port)] + [xexpr (xml->xexpr (document-element xml))] + [clean-xexpr (if (readable-nested-data nested) + (eliminate-whitespace-in-empty-tags xexpr) + xexpr)]) + (list 'quasiquote clean-xexpr))) + + (super-new)))) + + ;; FIXME! Copied from xml-snip-helpers.ss verbatim + (define (eliminate-whitespace-in-empty-tags xexpr) + (cond + [(and (pair? xexpr) + (symbol? (car xexpr))) + (list* (car xexpr) + (cadr xexpr) + (map eliminate-whitespace-in-empty-tags + (eliminate-whitespace-in-list (cddr xexpr))))] + [else xexpr])) + (define (eliminate-whitespace-in-list xexprs) + (cond + [(andmap (lambda (x) (or (not (string? x)) + (string-whitespace? x))) + xexprs) + (filter (lambda (x) (not (string? x))) xexprs)] + [else xexprs])) + (define (string-whitespace? str) + (let loop ([i (string-length str)]) + (cond + [(zero? i) #t] + [(char-whitespace? (string-ref str (- i 1))) + (loop (- i 1))] + [else #f])))) diff --git a/collects/mred/wxmecompat.ss b/collects/mred/wxmecompat.ss new file mode 100644 index 0000000000..b13c0817b1 --- /dev/null +++ b/collects/mred/wxmecompat.ss @@ -0,0 +1,39 @@ + +(module wxmecompat mzscheme + (require "wxmefile.ss") + + (register-lib-mapping! + "(lib \"comment-snip.ss\" \"framework\")" + "(lib \"comment.ss\" \"mred\" \"wxme\")") + + (register-lib-mapping! + "drscheme:number" + "(lib \"number.ss\" \"mred\" \"wxme\")") + (register-lib-mapping! + "(lib \"number-snip.ss\" \"drscheme\" \"private\")" + "(lib \"number.ss\" \"mred\" \"wxme\")") + + (register-lib-mapping! + "drscheme:xml-snip" + "(lib \"xml.ss\" \"mred\" \"wxme\")") + (register-lib-mapping! + "(lib \"xml-snipclass.ss\" \"xml\")" + "(lib \"xml.ss\" \"mred\" \"wxme\")") + + (register-lib-mapping! + "drscheme:scheme-snip" + "(lib \"scheme.ss\" \"mred\" \"wxme\")") + (register-lib-mapping! + "(lib \"scheme-snipclass.ss\" \"xml\")" + "(lib \"scheme.ss\" \"mred\" \"wxme\")") + + (register-lib-mapping! + "text-box%" + "(lib \"text.ss\" \"mred\" \"wxme\")") + (register-lib-mapping! + "(lib \"text-snipclass.ss\" \"xml\")" + "(lib \"text.ss\" \"mred\" \"wxme\")") + + (register-lib-mapping! + "(lib \"cache-image-snip.ss\" \"mrlib\")" + "(lib \"image.ss\" \"mred\" \"wxme\")")) diff --git a/collects/mred/wxmefile.ss b/collects/mred/wxmefile.ss new file mode 100644 index 0000000000..54c071ca60 --- /dev/null +++ b/collects/mred/wxmefile.ss @@ -0,0 +1,6 @@ + +(module wxmefile mzscheme + (require "wxme/wxme.ss") + (provide (all-from-except "wxme/wxme.ss" + wxme:read + wxme:read-syntax)))