From 934d0fb7a49828696ac0ea306f135938ccf2a694 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Fri, 12 Jan 2024 11:42:22 -0800 Subject: [PATCH] Move charset management to externalformat (addresses #1454) (#1455) * Move charset management to externalformat (addresses #1454) Removed IMCHARSET from IMAGEOPS declaration, added FORMATCHARSETFN to EXTERNALFORMAT, put XCCS charset handling in the XCCS externalformat. * XCCS, fixed a glitch * UNICODE: Remove merge conflict * Fix typo CLFUNCALL, MAKEFILE NEW and BCOMPL (versions didn't match) --------- Co-authored-by: Larry Masinter --- lispusers/COURIERIMAGESTREAM | 118 ++++++++-------- lispusers/COURIERIMAGESTREAM.LCOM | Bin 32491 -> 32177 bytes lispusers/DSPSCALE | 141 ++++++++----------- lispusers/DSPSCALE.LCOM | Bin 0 -> 26215 bytes sources/CLSTREAMS | 166 +++++++++++------------ sources/CLSTREAMS.LCOM | Bin 36167 -> 34982 bytes sources/EXTERNALFORMAT | 65 +++++---- sources/EXTERNALFORMAT.LCOM | Bin 10951 -> 11045 bytes sources/FILEIO | 141 ++++++++++--------- sources/FILEIO.LCOM | Bin 44875 -> 44943 bytes sources/IMAGEIO | 88 +++++------- sources/IMAGEIO.LCOM | Bin 35438 -> 35123 bytes sources/XCCS | 217 +++++++++++++++--------------- sources/XCCS.LCOM | Bin 3145 -> 2957 bytes 14 files changed, 451 insertions(+), 485 deletions(-) create mode 100644 lispusers/DSPSCALE.LCOM diff --git a/lispusers/COURIERIMAGESTREAM b/lispusers/COURIERIMAGESTREAM index 8b87138b..0adbb64f 100644 --- a/lispusers/COURIERIMAGESTREAM +++ b/lispusers/COURIERIMAGESTREAM @@ -1,19 +1,18 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "20-Jul-88 10:15:36" |{MCS:MCS:STANFORD}COURIERIMAGESTREAM.;7| 49756 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (VARS COURIERIMAGESTREAMCOMS) - (FNS \BITBLT.COURIER \SCALEDBITBLT.COURIER \COURIER.OPENIMAGESTREAM) +(FILECREATED " 8-Dec-2023 21:36:09" {WMEDLEY}COURIERIMAGESTREAM.;2 49263 - previous date%: "16-Sep-87 17:41:23" |{MCS:MCS:STANFORD}COURIERIMAGESTREAM.;5|) + :EDIT-BY rmk + :CHANGES-TO (FNS \INITCOURIERIMAGESTREAM) + (VARS COURIERIMAGESTREAMCOMS) + + :PREVIOUS-DATE "20-Jul-88 10:15:36" {WMEDLEY}COURIERIMAGESTREAM.;1) -(* " -Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University. All rights reserved. -") (PRETTYCOMPRINT COURIERIMAGESTREAMCOMS) -(RPAQQ COURIERIMAGESTREAMCOMS +(RPAQQ COURIERIMAGESTREAMCOMS ((* * ImageOp Functions) (FNS \BACKCOLOR.COURIER \BITBLT.COURIER \BLTSHADE.COURIER \BOTTOMMARGIN.COURIER \CHARSET.COURIER \CHARWIDTH.COURIER \CHARWIDTHY.COURIER \CLIPPINGREGION.COURIER @@ -28,16 +27,16 @@ Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University. \YPOSITION.COURIER \OUTCHAR.COURIER) (* * Courier Server Functions) (FNS \COURIER.BACKCOLOR \COURIER.BITBLT \COURIER.BLTSHADE \COURIER.BOTTOMMARGIN - \COURIER.CHARSET \COURIER.CHARWIDTH \COURIER.CHARWIDTHY \COURIER.CLIPPINGREGION - \COURIER.CLOSEIMAGESTREAM \COURIER.COLOR \COURIER.DEFAULTSTATE \COURIER.DRAWARC - \COURIER.DRAWCIRCLE \COURIER.DRAWCURVE \COURIER.DRAWELLIPSE \COURIER.DRAWLINE - \COURIER.DRAWPOINT \COURIER.DRAWPOLYGON \COURIER.FILLCIRCLE \COURIER.FILLPOLYGON - \COURIER.FONT \COURIER.FONTTYPE \COURIER.LEFTMARGIN \COURIER.LINEFEED \COURIER.MOVETO - \COURIER.NEWPAGE \COURIER.OPERATION \COURIER.OPENIMAGESTREAM \COURIER.OUTCHAR - \COURIER.POPSTATE \COURIER.PUSHSTATE \COURIER.RESET \COURIER.RIGHTMARGIN \COURIER.ROTATE - \COURIER.SCALE \COURIER.SCALEDBITBLT \COURIER.SCALE2 \COURIER.SPACEFACTOR - \COURIER.STRINGWIDTH \COURIER.TERPRI \COURIER.TOPMARGIN \COURIER.TRANSLATE - \COURIER.XPOSITION \COURIER.YPOSITION) + \COURIER.CHARWIDTH \COURIER.CHARWIDTHY \COURIER.CLIPPINGREGION \COURIER.CLOSEIMAGESTREAM + \COURIER.COLOR \COURIER.DEFAULTSTATE \COURIER.DRAWARC \COURIER.DRAWCIRCLE + \COURIER.DRAWCURVE \COURIER.DRAWELLIPSE \COURIER.DRAWLINE \COURIER.DRAWPOINT + \COURIER.DRAWPOLYGON \COURIER.FILLCIRCLE \COURIER.FILLPOLYGON \COURIER.FONT + \COURIER.FONTTYPE \COURIER.LEFTMARGIN \COURIER.LINEFEED \COURIER.MOVETO \COURIER.NEWPAGE + \COURIER.OPERATION \COURIER.OPENIMAGESTREAM \COURIER.OUTCHAR \COURIER.POPSTATE + \COURIER.PUSHSTATE \COURIER.RESET \COURIER.RIGHTMARGIN \COURIER.ROTATE \COURIER.SCALE + \COURIER.SCALEDBITBLT \COURIER.SCALE2 \COURIER.SPACEFACTOR \COURIER.STRINGWIDTH + \COURIER.TERPRI \COURIER.TOPMARGIN \COURIER.TRANSLATE \COURIER.XPOSITION + \COURIER.YPOSITION) (* * etc.) (FNS \INITCOURIERIMAGESTREAM READSTREAMHANDLE WRITESTREAMHANDLE) (INITVARS \COURIERIMAGEOPS \NULLFDEV IMAGESTREAMALST) @@ -398,11 +397,6 @@ Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University. (* ; "Edited 24-Mar-87 20:54 by cdl") `(RETURN ,(IMAGEOP 'IMBOTTOMMARGIN IMAGESTREAM IMAGESTREAM YPOSITION]) -(\COURIER.CHARSET - [LAMBDA (COURIERSTREAM PROGRAM PROCEDURE IMAGESTREAM CHARACTERSET) - (* ; "Edited 24-Mar-87 20:54 by cdl") - `(RETURN ,(IMAGEOP 'IMCHARSET IMAGESTREAM IMAGESTREAM CHARACTERSET]) - (\COURIER.CHARWIDTH [LAMBDA (COURIERSTREAM PROGRAM PROCEDURE IMAGESTREAM CHARCODE) (* ; "Edited 24-Mar-87 20:55 by cdl") @@ -658,7 +652,8 @@ Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University. (DEFINEQ (\INITCOURIERIMAGESTREAM - [LAMBDA NIL (* ; "Edited 3-Sep-87 09:59 by cdl") + [LAMBDA NIL (* ; "Edited 8-Dec-2023 21:35 by rmk") + (* ; "Edited 3-Sep-87 09:59 by cdl") (SETQ \COURIERIMAGEOPS (create IMAGEOPS IMAGETYPE _ 'COURIER IMCLOSEFN _ (FUNCTION \CLOSEFN.COURIER) @@ -694,7 +689,6 @@ Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University. IMCLIPPINGREGION _ (FUNCTION \CLIPPINGREGION.COURIER) IMOPERATION _ (FUNCTION \OPERATION.COURIER) IMSPACEFACTOR _ (FUNCTION \SPACEFACTOR.COURIER) - IMCHARSET _ (FUNCTION \CHARSET.COURIER) IMROTATE _ (FUNCTION \ROTATE.COURIER) IMDRAWARC _ (FUNCTION \DRAWARC.COURIER) IMTRANSLATE _ (FUNCTION \TRANSLATE.COURIER) @@ -722,7 +716,7 @@ Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University. (RPAQ? IMAGESTREAMALST NIL) -(PUTPROPS STREAMHANDLE COURIERDEF (READSTREAMHANDLE WRITESTREAMHANDLE)) +(PUTPROPS STREAMHANDLE COURIERDEF (READSTREAMHANDLE WRITESTREAMHANDLE)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \COURIERIMAGEOPS \NULLFDEV IMAGESTREAMALST) @@ -731,7 +725,7 @@ Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University. (DECLARE%: EVAL@COMPILE (RECORD COURIERIMAGEDATA (CIS.COURIERSTREAM CIS.IMAGESTREAM CIS.FONT CIS.LOCALFONTS?) - CIS.LOCALFONTS? _ T) + CIS.LOCALFONTS? _ T) ) ) @@ -973,40 +967,38 @@ Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation & Stanford University. (\INITCOURIERIMAGESTREAM) (COURIER.START.SERVER) -(PUTPROPS COURIERIMAGESTREAM COPYRIGHT ("Xerox Corporation & Stanford University" 1985 1986 1987 1988) -) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3228 21422 (\BACKCOLOR.COURIER 3238 . 3509) (\BITBLT.COURIER 3511 . 4553) ( -\BLTSHADE.COURIER 4555 . 5235) (\BOTTOMMARGIN.COURIER 5237 . 5518) (\CHARSET.COURIER 5520 . 5794) ( -\CHARWIDTH.COURIER 5796 . 6200) (\CHARWIDTHY.COURIER 6202 . 6609) (\CLIPPINGREGION.COURIER 6611 . 6893 -) (\CLOSEFN.COURIER 6895 . 7154) (\COLOR.COURIER 7156 . 7419) (\COURIERIMAGESTREAM.BOUT 7421 . 7695) ( -\DEFAULTSTATE.COURIER 7697 . 7980) (\DRAWARC.COURIER 7982 . 8399) (\DRAWCIRCLE.COURIER 8401 . 8724) ( -\DRAWCURVE.COURIER 8726 . 9036) (\DRAWELLIPSE.COURIER 9038 . 9496) (\DRAWLINE.COURIER 9498 . 9887) ( -\DRAWPOINT.COURIER 9889 . 10205) (\DRAWPOLYGON.COURIER 10207 . 10523) (\FILLCIRCLE.COURIER 10525 . -10842) (\FILLPOLYGON.COURIER 10844 . 11128) (\FONT.COURIER 11130 . 11537) (\LEFTMARGIN.COURIER 11539 - . 11816) (\LINEFEED.COURIER 11818 . 12088) (\MOVETO.COURIER 12090 . 12353) (\NEWPAGE.COURIER 12355 . -12616) (\OPENIMAGESTREAM.COURIER 12618 . 15192) (\OPERATION.COURIER 15194 . 15469) (\POPSTATE.COURIER -15471 . 15746) (\PUSHSTATE.COURIER 15748 . 16025) (\RESET.COURIER 16027 . 16360) (\RIGHTMARGIN.COURIER - 16362 . 16641) (\ROTATE.COURIER 16643 . 16923) (\SCALE.COURIER 16925 . 17188) (\SCALEDBITBLT.COURIER -17190 . 18470) (\SCALE2.COURIER 18472 . 18747) (\SPACEFACTOR.COURIER 18749 . 19025) ( -\STRINGWIDTH.COURIER 19027 . 19433) (\TERPRI.COURIER 19435 . 19770) (\TOPMARGIN.COURIER 19772 . 20047) - (\TRANSLATE.COURIER 20049 . 20330) (\XPOSITION.COURIER 20332 . 20607) (\YPOSITION.COURIER 20609 . -20884) (\OUTCHAR.COURIER 20886 . 21420)) (21460 35552 (\COURIER.BACKCOLOR 21470 . 21730) ( -\COURIER.BITBLT 21732 . 22252) (\COURIER.BLTSHADE 22254 . 22649) (\COURIER.BOTTOMMARGIN 22651 . 22925) - (\COURIER.CHARSET 22927 . 23197) (\COURIER.CHARWIDTH 23199 . 23465) (\COURIER.CHARWIDTHY 23467 . -23735) (\COURIER.CLIPPINGREGION 23737 . 24009) (\COURIER.CLOSEIMAGESTREAM 24011 . 24630) ( -\COURIER.COLOR 24632 . 24884) (\COURIER.DEFAULTSTATE 24886 . 25132) (\COURIER.DRAWARC 25134 . 25508) ( -\COURIER.DRAWCIRCLE 25510 . 25850) (\COURIER.DRAWCURVE 25852 . 26194) (\COURIER.DRAWELLIPSE 26196 . -26666) (\COURIER.DRAWLINE 26668 . 27034) (\COURIER.DRAWPOINT 27036 . 27376) (\COURIER.DRAWPOLYGON -27378 . 27726) (\COURIER.FILLCIRCLE 27728 . 28056) (\COURIER.FILLPOLYGON 28058 . 28380) (\COURIER.FONT - 28382 . 28630) (\COURIER.FONTTYPE 28632 . 28865) (\COURIER.LEFTMARGIN 28867 . 29137) ( -\COURIER.LINEFEED 29139 . 29399) (\COURIER.MOVETO 29401 . 29691) (\COURIER.NEWPAGE 29693 . 29917) ( -\COURIER.OPERATION 29919 . 30187) (\COURIER.OPENIMAGESTREAM 30189 . 31050) (\COURIER.OUTCHAR 31052 . -31332) (\COURIER.POPSTATE 31334 . 31572) (\COURIER.PUSHSTATE 31574 . 31814) (\COURIER.RESET 31816 . -32036) (\COURIER.RIGHTMARGIN 32038 . 32310) (\COURIER.ROTATE 32312 . 32578) (\COURIER.SCALE 32580 . -32832) (\COURIER.SCALEDBITBLT 32834 . 33366) (\COURIER.SCALE2 33368 . 33670) (\COURIER.SPACEFACTOR -33672 . 33938) (\COURIER.STRINGWIDTH 33940 . 34206) (\COURIER.TERPRI 34208 . 34430) ( -\COURIER.TOPMARGIN 34432 . 34700) (\COURIER.TRANSLATE 34702 . 35010) (\COURIER.XPOSITION 35012 . 35280 -) (\COURIER.YPOSITION 35282 . 35550)) (35570 39599 (\INITCOURIERIMAGESTREAM 35580 . 39043) ( -READSTREAMHANDLE 39045 . 39428) (WRITESTREAMHANDLE 39430 . 39597))))) + (FILEMAP (NIL (3073 21267 (\BACKCOLOR.COURIER 3083 . 3354) (\BITBLT.COURIER 3356 . 4398) ( +\BLTSHADE.COURIER 4400 . 5080) (\BOTTOMMARGIN.COURIER 5082 . 5363) (\CHARSET.COURIER 5365 . 5639) ( +\CHARWIDTH.COURIER 5641 . 6045) (\CHARWIDTHY.COURIER 6047 . 6454) (\CLIPPINGREGION.COURIER 6456 . 6738 +) (\CLOSEFN.COURIER 6740 . 6999) (\COLOR.COURIER 7001 . 7264) (\COURIERIMAGESTREAM.BOUT 7266 . 7540) ( +\DEFAULTSTATE.COURIER 7542 . 7825) (\DRAWARC.COURIER 7827 . 8244) (\DRAWCIRCLE.COURIER 8246 . 8569) ( +\DRAWCURVE.COURIER 8571 . 8881) (\DRAWELLIPSE.COURIER 8883 . 9341) (\DRAWLINE.COURIER 9343 . 9732) ( +\DRAWPOINT.COURIER 9734 . 10050) (\DRAWPOLYGON.COURIER 10052 . 10368) (\FILLCIRCLE.COURIER 10370 . +10687) (\FILLPOLYGON.COURIER 10689 . 10973) (\FONT.COURIER 10975 . 11382) (\LEFTMARGIN.COURIER 11384 + . 11661) (\LINEFEED.COURIER 11663 . 11933) (\MOVETO.COURIER 11935 . 12198) (\NEWPAGE.COURIER 12200 . +12461) (\OPENIMAGESTREAM.COURIER 12463 . 15037) (\OPERATION.COURIER 15039 . 15314) (\POPSTATE.COURIER +15316 . 15591) (\PUSHSTATE.COURIER 15593 . 15870) (\RESET.COURIER 15872 . 16205) (\RIGHTMARGIN.COURIER + 16207 . 16486) (\ROTATE.COURIER 16488 . 16768) (\SCALE.COURIER 16770 . 17033) (\SCALEDBITBLT.COURIER +17035 . 18315) (\SCALE2.COURIER 18317 . 18592) (\SPACEFACTOR.COURIER 18594 . 18870) ( +\STRINGWIDTH.COURIER 18872 . 19278) (\TERPRI.COURIER 19280 . 19615) (\TOPMARGIN.COURIER 19617 . 19892) + (\TRANSLATE.COURIER 19894 . 20175) (\XPOSITION.COURIER 20177 . 20452) (\YPOSITION.COURIER 20454 . +20729) (\OUTCHAR.COURIER 20731 . 21265)) (21305 35125 (\COURIER.BACKCOLOR 21315 . 21575) ( +\COURIER.BITBLT 21577 . 22097) (\COURIER.BLTSHADE 22099 . 22494) (\COURIER.BOTTOMMARGIN 22496 . 22770) + (\COURIER.CHARWIDTH 22772 . 23038) (\COURIER.CHARWIDTHY 23040 . 23308) (\COURIER.CLIPPINGREGION 23310 + . 23582) (\COURIER.CLOSEIMAGESTREAM 23584 . 24203) (\COURIER.COLOR 24205 . 24457) ( +\COURIER.DEFAULTSTATE 24459 . 24705) (\COURIER.DRAWARC 24707 . 25081) (\COURIER.DRAWCIRCLE 25083 . +25423) (\COURIER.DRAWCURVE 25425 . 25767) (\COURIER.DRAWELLIPSE 25769 . 26239) (\COURIER.DRAWLINE +26241 . 26607) (\COURIER.DRAWPOINT 26609 . 26949) (\COURIER.DRAWPOLYGON 26951 . 27299) ( +\COURIER.FILLCIRCLE 27301 . 27629) (\COURIER.FILLPOLYGON 27631 . 27953) (\COURIER.FONT 27955 . 28203) +(\COURIER.FONTTYPE 28205 . 28438) (\COURIER.LEFTMARGIN 28440 . 28710) (\COURIER.LINEFEED 28712 . 28972 +) (\COURIER.MOVETO 28974 . 29264) (\COURIER.NEWPAGE 29266 . 29490) (\COURIER.OPERATION 29492 . 29760) +(\COURIER.OPENIMAGESTREAM 29762 . 30623) (\COURIER.OUTCHAR 30625 . 30905) (\COURIER.POPSTATE 30907 . +31145) (\COURIER.PUSHSTATE 31147 . 31387) (\COURIER.RESET 31389 . 31609) (\COURIER.RIGHTMARGIN 31611 + . 31883) (\COURIER.ROTATE 31885 . 32151) (\COURIER.SCALE 32153 . 32405) (\COURIER.SCALEDBITBLT 32407 + . 32939) (\COURIER.SCALE2 32941 . 33243) (\COURIER.SPACEFACTOR 33245 . 33511) (\COURIER.STRINGWIDTH +33513 . 33779) (\COURIER.TERPRI 33781 . 34003) (\COURIER.TOPMARGIN 34005 . 34273) (\COURIER.TRANSLATE +34275 . 34583) (\COURIER.XPOSITION 34585 . 34853) (\COURIER.YPOSITION 34855 . 35123)) (35143 39211 ( +\INITCOURIERIMAGESTREAM 35153 . 38655) (READSTREAMHANDLE 38657 . 39040) (WRITESTREAMHANDLE 39042 . +39209))))) STOP diff --git a/lispusers/COURIERIMAGESTREAM.LCOM b/lispusers/COURIERIMAGESTREAM.LCOM index a29d6e28d5d321ed441046a877c53c8f1ff7d4a7..8005ebe6a3085fc75d85b89bae4ee6b32f204d27 100644 GIT binary patch delta 2469 zcma)7YfxKd8lF%J&4Dd+fkGPypJ_`&ZPJqjk`TG{Ku*YkLlSZhmq3692oTDxP+D3_ zMXNhI+MQ|pwmRK$Z~DXPSQO)IS4XT?XIICqvyA?-tBXHG9o>t&v+JenjPDyFwKM+k z&y(kSzV~}?-*?`8`i*Asrl!Q`7Cn+rG>pXmcaU87JhGK1t(#h@%H0mIoX z+q|`cA~FkK%5g?At_zBSD!Q40IZf_ppUKKwZOm$M+3YU9!oZA%zVXqC*hsXWjgO(x zY+IA)mc`Iq<=J^XZ!KlqZ3ivoE}O$;;SH>JGP-`UZzwW07@gYXg1;yQLo9}lJT0=! zz8}(THXB%fSMb$~ib?e| zqsOOES{q845xO)*`&@yb*edy36q6epgUMKVQ^WL#$?3$dxu`(V-mBl+K?(jAYBG2gIug=8(=xXvNGSp_1`o9i1>MS3B3E0 zbI7tXb@21eH<0yby^C0ry_nd40r9CVONhfi{T1S-oW~F&`VL6Tt;}2t?yo}_;TU>32cP3MPxR=OMybY8(BnuAz47s zuL`i37Jxu;Id1%{n5tZB*9ExF3ee{&TS!5X!u?~%UC8$Aq()uaN%_w2q65^#LnW2S z7D^~GW&Z2kw7#+XJmQ3L9C5|?dvy13sTaE+U)i&bF5&AtpMz187THnLQU+%XFrEp# zwcH8!nEK%{vw}Ncm|wvI&+jwPfxq%EB3`s$>0EZ zbo>pwm-K0OGRV%{4&7xLkmC~JszV3YoULfKt>S&eFDqV0e8qJog)_qEd^P;xt}Ya| zR#L#XE3Y6vSoJcZTpibN=W4DaeXHhajCOMW*A(j}DHA{_p7(Nqyj!=HwIFRnG{9*;`L9C<@OqEdv%uPE+npM-OwjCZgw&Yd=Mt*qj=8)UW$XHseRdpwG$GMlp^ zsf5-Q9(Xmc&|zU=oQ^_^tSTyg(&jpUOHdNgiQNhjH8-W)24^~R8*OD}EUeTCvS__! zVk>81H7NKL`L>f*JNgU?Z9=f_maPS|q_?e#@lVx_8@5q>I9=U}ir9oB2M1@ORM56R zfc2ek|3x}y3b;=@h$d|T+zk1UHFVJ0qUOL$9Wt_vPFini$$`5& zC1h`Ob|CHycO#w(hY?r8qAt;47EYFGrluvN5aXb^OMtsATha1~uBM!I8>&af{}8m$ zb~k6O>mI*PMJ?9do`OHGcK71JlAaLad=EX=_j^bY4p3T;9vDE>MhGV&loH-AtVVSD zwL)vwQ<9qSzsVm^7~U{GgW}%2qVG%+TWd`dWJOI{H22n{yNkVzh#&Tv5p(+}%q-!# znQCDDCAh5bCvhQxdC`94$D^ct5bZ>)8lapW8R$bibV3KZK^jeq(E^wmB*)ETJK&>1 zn!k0ZNCH?fcADL#L5WXC5AcnEJC#ae=riHgAs&GZM?K?!Z5ql`Xeizfh)u1K=PWO(z$X7EpD;7T(!kjgPz8Dvisz^N&Eb=RjTEz4m__@#mEaQQGb z;NOSa5gVtem}e9Cn_(0DYdRZRkCdXeJZ*-BBldL89}t6r3geSIaW@MaosYZrqvW%@ zFCP|li6Vqg~pgHi`hh*(`&3+or3+JT+$7z)f}8iJ0{~`Jo^Hyr!^qk zPJ0{i9y2Fy9{Pt2=`S+=p2;blOvAe1tvm@1XV#KhCL7Ulc(U@NAqDdw;9&t7F0InZz0YfeGxG)?`1@9RX51<>yUZ!pGLe^ z(FLXg6Ee!>X9Z0%F7ZWy^&2^)_ASJxDg#heW=BSW z-z%%l-rc5GO1brv8*p-?{3_yh+N5z`PvoCmqPL)HR+t>HOTJDhf@CFuh1oTbbjuepI} zQz0fY&M7FcQvD{@Y&W7&1Ab>Cs5GN!@T?}C3|`Rw3GoTtA5n_xD^W^ZG33z9OUB!X zkD71>BIZvJ?UtK}oOP4-aKhRE>9xHm4A#DhSYEe@_`AAaB0g82Ky)>1BNjJaN8C;; zN&KPlHidte|1*WZZhHl>&z{)N&t%!nuLKr^wtd~K{#rlf@T1p~;|)YzGu^;{Hsk7v zL`w$+&1wA=;s>pi(51G`10hVw5bLgSocWiFsEhr}!0rmV1$&3; zyi209V|ulTrIb#u!$GI4vzT|4u06$UVL`jdclf;6O;x+Sh3RnTF9eE;Od1ySd41TS zBw>HjsD%%@^9OVW9Sa6*yi3sT&*}9nD2co$;CjGCXGkr>i?)4Rt&s&q{AL`Ct-+ir zdrUWRM#?yJoKseF)bmrVu7&s5vGvn+1!u>TSi#?RTtXb|>_>dNa{#fTYZ&p#F5-8) zNN?*V?w9gltJ{eztEU?=+|!5nPEQb#1%RFp&No^$`JbuoA>$fMhh;4%0x z=+4`>p<24|$zovc^&i>S9bS*b;JMz;G>*aFdI!ix(NB0p6KzgglSFib6w zM&BQHA=?=(1|RChBh<_9Egy$#D2Bl7%mQb;nYbaJIBFEaT|DOAN;k!d2OuzrAj6Yj_AQQwQyH*GsGdN(=Rh*pAX zhOWZ&44tND)dgRyJPeP{2?h1&VuVun_Jn zP=Vz`4KTT=M0RyCg80=U#l96OgU6Sspf{GNpm#>jfcqjnNrusLyKH^59^MaEp!V6Q z3Ko~m$X;EhLZ^-=3(lDSPSCALE.;10| 55021 - changes to%: (FNS \TRANSLATE.SCALED CHARWIDTH! CHARWIDTHY! FONTPROP! STRINGWIDTH! - INITSCALEDIMAGESTREAM \FILLPOLYGON.SCALED DSPSCALE.DASHING - OPENIMAGESTREAM.SCALED \BACKCOLOR.SCALED \BITBLT.SCALED \BLTSHADE.SCALED - \BOTTOMMARGIN.SCALED \BOUT.SCALED \CHARSET.SCALED \CHARWIDTH.SCALED - \CHARWIDTHY.SCALED \CLIPPINGREGION.SCALED \CLOSEFN.SCALED \COLOR.SCALED - \DEFAULTSTATE.SCALED \DRAWARC.SCALED \DRAWCIRCLE.SCALED \DRAWCURVE.SCALED - \DRAWELLIPSE.SCALED \DRAWLINE.SCALED \DRAWPOINT.SCALED \DRAWPOLYGON.SCALED - \FILLCIRCLE.SCALED \FONT.SCALED \LEFTMARGIN.SCALED \LINEFEED.SCALED - \MOVETO.SCALED \NEWPAGE.SCALED \OPERATION.SCALED \POPSTATE.SCALED - \PUSHSTATE.SCALED \RESET.SCALED \RIGHTMARGIN.SCALED \ROTATE.SCALED - \SCALE.SCALED \SCALEDBITBLT.SCALED \SPACEFACTOR.SCALED \STRINGWIDTH.SCALED - \TERPRI.SCALED \TOPMARGIN.SCALED \XPOSITION.SCALED \YPOSITION.SCALED - \OUTCHAR.SCALED CENTERPRINTINREGION! CURSORPOSITION! BITBLT! BITMAPBIT! - BLTSHADE! DSPBACKUP! DSPBOTTOMMARGIN! DSPCLIPPINGREGION! DRAWBETWEEN! - DRAWARC! DRAWCIRCLE! DRAWCURVE! DRAWELLIPSE! DRAWLINE! DRAWPOINT! - DRAWPOLYGON! DRAWTO! FILLCIRCLE! FILLPOLYGON! DSPLEFTMARGIN! DSPLINEFEED! - GETPOSITION! MOVETO! MOVETOUPPERLEFT! DSPRIGHTMARGIN! DSPSCALE! RELDRAWTO! - RELMOVETO! SCALEDBITBLT! STRINGREGION! DSPSPACEFACTOR! DSPTRANSLATE! - DSPTOPMARGIN! DSPUNITS! DSPXOFFSET! DSPXPOSITION! DSPYOFFSET! DSPYPOSITION! - DSPSCALE.BRUSH DSPSCALE.POINTS DSPSCALE.REGION DSPSCALE.NUMBER - DSPSCALE.POSITION DSPSCALE.XPOSITION DSPSCALE.YPOSITION DSPSCALE.WIDTH - DSPUNSCALE.REGION DSPUNSCALE.POSITION DSPUNSCALE.NUMBER DSPUNSCALE.CHARACTER - ) - (VARS DSPSCALECOMS) +(FILECREATED " 8-Dec-2023 21:32:41" {WMEDLEY}DSPSCALE.;3 52572 - previous date%: "19-Jul-88 10:00:47" |{MCS:MCS:STANFORD}DSPSCALE.;6|) + :EDIT-BY rmk + :CHANGES-TO (FNS INITSCALEDIMAGESTREAM \CHARSET.SCALED) + (VARS DSPSCALECOMS) + (RECORDS SCALEDIMAGEDATA CONVERT) + (MACROS DSPUNSCALE.XPOSITION DSPUNSCALE.YPOSITION) + + :PREVIOUS-DATE "19-Jul-88 13:36:39" {WMEDLEY}DSPSCALE.;1) -(* " -Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserved. -") (PRETTYCOMPRINT DSPSCALECOMS) -(RPAQQ DSPSCALECOMS +(RPAQQ DSPSCALECOMS ((LOCALVARS . T) (* * SCALED ImageStream ImageOp Functions) (FNS INITSCALEDIMAGESTREAM OPENIMAGESTREAM.SCALED) (FNS \BACKCOLOR.SCALED \BITBLT.SCALED \BLTSHADE.SCALED \BOTTOMMARGIN.SCALED \BOUT.SCALED - \CHARSET.SCALED \CHARWIDTH.SCALED \CHARWIDTHY.SCALED \CLIPPINGREGION.SCALED - \CLOSEFN.SCALED \COLOR.SCALED \DEFAULTSTATE.SCALED \DRAWARC.SCALED \DRAWCIRCLE.SCALED - \DRAWCURVE.SCALED \DRAWELLIPSE.SCALED \DRAWLINE.SCALED \DRAWPOINT.SCALED - \DRAWPOLYGON.SCALED \FILLCIRCLE.SCALED \FILLPOLYGON.SCALED \FONT.SCALED - \LEFTMARGIN.SCALED \LINEFEED.SCALED \MOVETO.SCALED \NEWPAGE.SCALED \OPERATION.SCALED - \POPSTATE.SCALED \PUSHSTATE.SCALED \RESET.SCALED \RIGHTMARGIN.SCALED \ROTATE.SCALED - \SCALE.SCALED \SCALEDBITBLT.SCALED \SPACEFACTOR.SCALED \STRINGWIDTH.SCALED - \TERPRI.SCALED \TOPMARGIN.SCALED \TRANSLATE.SCALED \XPOSITION.SCALED \YPOSITION.SCALED - \OUTCHAR.SCALED) + \CHARWIDTH.SCALED \CHARWIDTHY.SCALED \CLIPPINGREGION.SCALED \CLOSEFN.SCALED + \COLOR.SCALED \DEFAULTSTATE.SCALED \DRAWARC.SCALED \DRAWCIRCLE.SCALED \DRAWCURVE.SCALED + \DRAWELLIPSE.SCALED \DRAWLINE.SCALED \DRAWPOINT.SCALED \DRAWPOLYGON.SCALED + \FILLCIRCLE.SCALED \FILLPOLYGON.SCALED \FONT.SCALED \LEFTMARGIN.SCALED \LINEFEED.SCALED + \MOVETO.SCALED \NEWPAGE.SCALED \OPERATION.SCALED \POPSTATE.SCALED \PUSHSTATE.SCALED + \RESET.SCALED \RIGHTMARGIN.SCALED \ROTATE.SCALED \SCALE.SCALED \SCALEDBITBLT.SCALED + \SPACEFACTOR.SCALED \STRINGWIDTH.SCALED \TERPRI.SCALED \TOPMARGIN.SCALED + \TRANSLATE.SCALED \XPOSITION.SCALED \YPOSITION.SCALED \OUTCHAR.SCALED) (* * Self Scaling DSP* Functions) (FNS CENTERPRINTINREGION! CHARWIDTH! CHARWIDTHY! CURSORPOSITION! BITBLT! BITMAPBIT! BLTSHADE! DSPBACKUP! DSPBOTTOMMARGIN! DSPCLIPPINGREGION! DRAWBETWEEN! DRAWARC! DRAWCIRCLE! @@ -86,11 +64,11 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve (DEFINEQ (INITSCALEDIMAGESTREAM - [LAMBDA NIL (* ; "Edited 19-Jul-88 10:59 by cdl") + [LAMBDA NIL (* ; "Edited 19-Jul-88 10:59 by cdl") (DECLARE (GLOBALVARS \DISPLAYIMAGEOPS)) [if (NULL \NULLFDEV) then (SETQ \NULLFDEV (create FDEV - CLOSEFILE _ (FUNCTION NILL] + CLOSEFILE _ (FUNCTION NILL] (SETQ \SCALEDIMAGEOPS (create IMAGEOPS IMAGETYPE _ 'SCALED IMCLOSEFN _ (FUNCTION \CLOSEFN.SCALED) @@ -126,7 +104,6 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve IMDRAWPOLYGON _ (FUNCTION \DRAWPOLYGON.SCALED) IMFILLPOLYGON _ (FUNCTION \FILLPOLYGON.SCALED) IMSCALEDBITBLT _ (FUNCTION \SCALEDBITBLT.SCALED) - IMCHARSET _ (FUNCTION \CHARSET.SCALED) IMROTATE _ (FUNCTION \ROTATE.SCALED) IMDRAWARC _ (FUNCTION \DRAWARC.SCALED) IMTRANSLATE _ (FUNCTION \TRANSLATE.SCALED) @@ -208,11 +185,6 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve (with SCALEDIMAGEDATA (with STREAM STREAM IMAGEDATA) (BOUT IMAGESTREAM BYTE]) -(\CHARSET.SCALED - [LAMBDA (STREAM CHARACTERSET) (* cdl "26-Jan-87 08:49") - (with SCALEDIMAGEDATA (with STREAM STREAM IMAGEDATA) - (IMAGEOP 'IMCHARSET IMAGESTREAM IMAGESTREAM CHARACTERSET]) - (\CHARWIDTH.SCALED [LAMBDA (STREAM CHARCODE) (* cdl "26-Jan-87 09:50") (with SCALEDIMAGEDATA (with STREAM STREAM IMAGEDATA) @@ -975,11 +947,11 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve ) (DECLARE%: EVAL@COMPILE -[PUTPROPS DSPUNSCALE.XPOSITION MACRO ((VALUE STREAM) - (DSPUNSCALE.NUMBER VALUE STREAM 'X] +(PUTPROPS DSPUNSCALE.XPOSITION MACRO ((VALUE STREAM) + (DSPUNSCALE.NUMBER VALUE STREAM 'X))) -[PUTPROPS DSPUNSCALE.YPOSITION MACRO ((VALUE STREAM) - (DSPUNSCALE.NUMBER VALUE STREAM 'Y] +(PUTPROPS DSPUNSCALE.YPOSITION MACRO ((VALUE STREAM) + (DSPUNSCALE.NUMBER VALUE STREAM 'Y))) ) (* * etc.) @@ -1022,39 +994,38 @@ Copyright (c) 1985, 1986, 1987, 1988 by Stanford University. All rights reserve (MOVD? 'DSPUNITS! 'DSPUNITS) (INITSCALEDIMAGESTREAM) -(PUTPROPS DSPSCALE COPYRIGHT ("Stanford University" 1985 1986 1987 1988)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5589 11142 (INITSCALEDIMAGESTREAM 5599 . 9099) (OPENIMAGESTREAM.SCALED 9101 . 11140)) ( -11143 28693 (\BACKCOLOR.SCALED 11153 . 11396) (\BITBLT.SCALED 11398 . 12265) (\BLTSHADE.SCALED 12267 - . 13022) (\BOTTOMMARGIN.SCALED 13024 . 13479) (\BOUT.SCALED 13481 . 13690) (\CHARSET.SCALED 13692 . -13938) (\CHARWIDTH.SCALED 13940 . 14287) (\CHARWIDTHY.SCALED 14289 . 14638) (\CLIPPINGREGION.SCALED -14640 . 15093) (\CLOSEFN.SCALED 15095 . 15356) (\COLOR.SCALED 15358 . 15593) (\DEFAULTSTATE.SCALED -15595 . 15850) (\DRAWARC.SCALED 15852 . 16481) (\DRAWCIRCLE.SCALED 16483 . 17072) (\DRAWCURVE.SCALED -17074 . 17493) (\DRAWELLIPSE.SCALED 17495 . 18291) (\DRAWLINE.SCALED 18293 . 18940) (\DRAWPOINT.SCALED - 18942 . 19372) (\DRAWPOLYGON.SCALED 19374 . 19797) (\FILLCIRCLE.SCALED 19799 . 20297) ( -\FILLPOLYGON.SCALED 20299 . 20639) (\FONT.SCALED 20641 . 20873) (\LEFTMARGIN.SCALED 20875 . 21326) ( -\LINEFEED.SCALED 21328 . 21769) (\MOVETO.SCALED 21771 . 22097) (\NEWPAGE.SCALED 22099 . 22332) ( -\OPERATION.SCALED 22334 . 22581) (\POPSTATE.SCALED 22583 . 22830) (\PUSHSTATE.SCALED 22832 . 23081) ( -\RESET.SCALED 23083 . 23333) (\RIGHTMARGIN.SCALED 23335 . 23788) (\ROTATE.SCALED 23790 . 24042) ( -\SCALE.SCALED 24044 . 24367) (\SCALEDBITBLT.SCALED 24369 . 25278) (\SPACEFACTOR.SCALED 25280 . 25727) -(\STRINGWIDTH.SCALED 25729 . 26084) (\TERPRI.SCALED 26086 . 26338) (\TOPMARGIN.SCALED 26340 . 26789) ( -\TRANSLATE.SCALED 26791 . 27161) (\XPOSITION.SCALED 27163 . 27612) (\YPOSITION.SCALED 27614 . 28063) ( -\OUTCHAR.SCALED 28065 . 28691)) (28734 43771 (CENTERPRINTINREGION! 28744 . 29003) (CHARWIDTH! 29005 . -29238) (CHARWIDTHY! 29240 . 29475) (CURSORPOSITION! 29477 . 29921) (BITBLT! 29923 . 30533) (BITMAPBIT! - 30535 . 30764) (BLTSHADE! 30766 . 31298) (DSPBACKUP! 31300 . 31536) (DSPBOTTOMMARGIN! 31538 . 31871) -(DSPCLIPPINGREGION! 31873 . 32206) (DRAWBETWEEN! 32208 . 32591) (DRAWARC! 32593 . 33074) (DRAWCIRCLE! -33076 . 33451) (DRAWCURVE! 33453 . 33741) (DRAWELLIPSE! 33743 . 34305) (DRAWLINE! 34307 . 34782) ( -DRAWPOINT! 34784 . 35071) (DRAWPOLYGON! 35073 . 35366) (DRAWTO! 35368 . 35680) (FILLCIRCLE! 35682 . -35971) (FILLPOLYGON! 35973 . 36161) (FONTPROP! 36163 . 36501) (DSPLEFTMARGIN! 36503 . 36830) ( -DSPLINEFEED! 36832 . 37147) (GETPOSITION! 37149 . 37334) (MOVETO! 37336 . 37550) (MOVETOUPPERLEFT! -37552 . 37785) (DSPRIGHTMARGIN! 37787 . 38117) (DSPSCALE! 38119 . 38915) (RELDRAWTO! 38917 . 39231) ( -RELMOVETO! 39233 . 39449) (SCALEDBITBLT! 39451 . 40089) (STRINGREGION! 40091 . 40316) (STRINGWIDTH! -40318 . 40560) (DSPSPACEFACTOR! 40562 . 40886) (DSPTRANSLATE! 40888 . 41389) (DSPTOPMARGIN! 41391 . -41715) (DSPUNITS! 41717 . 42443) (DSPXOFFSET! 42445 . 42780) (DSPXPOSITION! 42782 . 43106) ( -DSPYOFFSET! 43108 . 43443) (DSPYPOSITION! 43445 . 43769)) (43812 53676 (DSPSCALE.BRUSH 43822 . 44648) -(DSPSCALE.DASHING 44650 . 45198) (DSPSCALE.POINTS 45200 . 46255) (DSPSCALE.REGION 46257 . 46955) ( -DSPSCALE.NUMBER 46957 . 47912) (DSPSCALE.POSITION 47914 . 48339) (DSPSCALE.XPOSITION 48341 . 48862) ( -DSPSCALE.YPOSITION 48864 . 49385) (DSPSCALE.WIDTH 49387 . 49607) (DSPUNSCALE.REGION 49609 . 50309) ( -DSPUNSCALE.POSITION 50311 . 50734) (DSPUNSCALE.NUMBER 50736 . 52070) (DSPUNSCALE.CHARACTER 52072 . -53674))))) + (FILEMAP (NIL (3514 8995 (INITSCALEDIMAGESTREAM 3524 . 6952) (OPENIMAGESTREAM.SCALED 6954 . 8993)) ( +8996 26298 (\BACKCOLOR.SCALED 9006 . 9249) (\BITBLT.SCALED 9251 . 10118) (\BLTSHADE.SCALED 10120 . +10875) (\BOTTOMMARGIN.SCALED 10877 . 11332) (\BOUT.SCALED 11334 . 11543) (\CHARWIDTH.SCALED 11545 . +11892) (\CHARWIDTHY.SCALED 11894 . 12243) (\CLIPPINGREGION.SCALED 12245 . 12698) (\CLOSEFN.SCALED +12700 . 12961) (\COLOR.SCALED 12963 . 13198) (\DEFAULTSTATE.SCALED 13200 . 13455) (\DRAWARC.SCALED +13457 . 14086) (\DRAWCIRCLE.SCALED 14088 . 14677) (\DRAWCURVE.SCALED 14679 . 15098) ( +\DRAWELLIPSE.SCALED 15100 . 15896) (\DRAWLINE.SCALED 15898 . 16545) (\DRAWPOINT.SCALED 16547 . 16977) +(\DRAWPOLYGON.SCALED 16979 . 17402) (\FILLCIRCLE.SCALED 17404 . 17902) (\FILLPOLYGON.SCALED 17904 . +18244) (\FONT.SCALED 18246 . 18478) (\LEFTMARGIN.SCALED 18480 . 18931) (\LINEFEED.SCALED 18933 . 19374 +) (\MOVETO.SCALED 19376 . 19702) (\NEWPAGE.SCALED 19704 . 19937) (\OPERATION.SCALED 19939 . 20186) ( +\POPSTATE.SCALED 20188 . 20435) (\PUSHSTATE.SCALED 20437 . 20686) (\RESET.SCALED 20688 . 20938) ( +\RIGHTMARGIN.SCALED 20940 . 21393) (\ROTATE.SCALED 21395 . 21647) (\SCALE.SCALED 21649 . 21972) ( +\SCALEDBITBLT.SCALED 21974 . 22883) (\SPACEFACTOR.SCALED 22885 . 23332) (\STRINGWIDTH.SCALED 23334 . +23689) (\TERPRI.SCALED 23691 . 23943) (\TOPMARGIN.SCALED 23945 . 24394) (\TRANSLATE.SCALED 24396 . +24766) (\XPOSITION.SCALED 24768 . 25217) (\YPOSITION.SCALED 25219 . 25668) (\OUTCHAR.SCALED 25670 . +26296)) (26339 41376 (CENTERPRINTINREGION! 26349 . 26608) (CHARWIDTH! 26610 . 26843) (CHARWIDTHY! +26845 . 27080) (CURSORPOSITION! 27082 . 27526) (BITBLT! 27528 . 28138) (BITMAPBIT! 28140 . 28369) ( +BLTSHADE! 28371 . 28903) (DSPBACKUP! 28905 . 29141) (DSPBOTTOMMARGIN! 29143 . 29476) ( +DSPCLIPPINGREGION! 29478 . 29811) (DRAWBETWEEN! 29813 . 30196) (DRAWARC! 30198 . 30679) (DRAWCIRCLE! +30681 . 31056) (DRAWCURVE! 31058 . 31346) (DRAWELLIPSE! 31348 . 31910) (DRAWLINE! 31912 . 32387) ( +DRAWPOINT! 32389 . 32676) (DRAWPOLYGON! 32678 . 32971) (DRAWTO! 32973 . 33285) (FILLCIRCLE! 33287 . +33576) (FILLPOLYGON! 33578 . 33766) (FONTPROP! 33768 . 34106) (DSPLEFTMARGIN! 34108 . 34435) ( +DSPLINEFEED! 34437 . 34752) (GETPOSITION! 34754 . 34939) (MOVETO! 34941 . 35155) (MOVETOUPPERLEFT! +35157 . 35390) (DSPRIGHTMARGIN! 35392 . 35722) (DSPSCALE! 35724 . 36520) (RELDRAWTO! 36522 . 36836) ( +RELMOVETO! 36838 . 37054) (SCALEDBITBLT! 37056 . 37694) (STRINGREGION! 37696 . 37921) (STRINGWIDTH! +37923 . 38165) (DSPSPACEFACTOR! 38167 . 38491) (DSPTRANSLATE! 38493 . 38994) (DSPTOPMARGIN! 38996 . +39320) (DSPUNITS! 39322 . 40048) (DSPXOFFSET! 40050 . 40385) (DSPXPOSITION! 40387 . 40711) ( +DSPYOFFSET! 40713 . 41048) (DSPYPOSITION! 41050 . 41374)) (41417 51281 (DSPSCALE.BRUSH 41427 . 42253) +(DSPSCALE.DASHING 42255 . 42803) (DSPSCALE.POINTS 42805 . 43860) (DSPSCALE.REGION 43862 . 44560) ( +DSPSCALE.NUMBER 44562 . 45517) (DSPSCALE.POSITION 45519 . 45944) (DSPSCALE.XPOSITION 45946 . 46467) ( +DSPSCALE.YPOSITION 46469 . 46990) (DSPSCALE.WIDTH 46992 . 47212) (DSPUNSCALE.REGION 47214 . 47914) ( +DSPUNSCALE.POSITION 47916 . 48339) (DSPUNSCALE.NUMBER 48341 . 49675) (DSPUNSCALE.CHARACTER 49677 . +51279))))) STOP diff --git a/lispusers/DSPSCALE.LCOM b/lispusers/DSPSCALE.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..6e784d6fb420747bbd665ac060caf9642a74f5d6 GIT binary patch literal 26215 zcmdU2>u+4gbtjjSEN?88k_lH*QfH(*x^yjiAAHA6_U`T_cctat_3lz49ig_RRZLm5 z<=RS{pec|RXn}qx`at4*EKs08ilTtcKtP_|4?%(EgW&>goqwQzfW8$)fu_GRXU@#r z2VY|BpkKIi=gyru=gfJ{IWxmTBV1{9!pkeIc6hnfS&7us-JpIoSPj*sR%a0Q+O2-~ zl6txq28}^bYbUB}K|fTb;&eV=pdRXIHV7N)l3KjnxP9w#xmd2Ka%s6zUY;#oQiV&m z?!Erzo$cF0b?*%{`h)9hVWS;x{^9f6ciw*Ut8d?a>+LT#`rUp#XooXjs7$MTtfSK0 za%Ew;RJ^2azIEI7bZhICH(tH{_UD#WtJ50jZyT*OAkZHGnl*I?Bdx5r+scP&W@hG+ z8oqKLkYtWAcWL@S80~|Bnk&yOl+|+BXbmpcHq~3N-&M=?X3zn2mj{t5KrRpA<*mC&ait@TmY3+qv@(N`YcjbIR{depfV_6BH?UkmEJNPoEAVbX4N zqke19iaOMrRBlS;v|8@=!fUN)y?+^fVa7{Km#=(v`|{$VDpi&%^UIZ`ODexN>ZR#? z=5z$b;{3c?ZY<^tZB-~MOjX$F6DTEBYYo2*u z=BX4sPJcg~+^zn5D&8>ubYZflzn>f{EY7PNt#&(H4caq7Z&fWU7$BNqYqdF03nfc$ zHD59BuD2S4rkY!DuV&}tpUoECyK*`9S!v$B0*6(K%8WFxbhoJ6g>X!>6;S6Hh-|Rl z9$XGLAfKI}y%P1-g26M>D);8t_}JLXM4Z2VZ|om+;nPf{smal>JGC`3PdzDgrO=T= zQwlXHRHg7mDLgNQWhp!(1to>2rSK^!T#&*OQaCyKbpm!2gLF*Z=A>{;3MZs+QVMw~ z*gj874KUVxGj&!9Q&M|wcLMP4oQ+)a*k zTJ3yczFbl_JS7x$`)a;a$<}SG1m=sg3g5QX+|ryWKpwdUf_MYA;rdLiJs>@(=H?eo z%|^7c0=1~-=9Wy&rmZQe8;xFYy&J)F8NI3IW&xQInf?I!%)Y3U)r~Fyja9;6-RQ3O zoAKJxthzDi1)YA|@1Qux;|0CCbUM2PmC}p+E@u~k43h>L4hY${3&06xv)zr_o2yaB z*3Sbo#v@S={Cc6Y32Jr@xYgUOZnxE0?S-q*qqdV-U{`}FuSe~uXKO1!j|i%@&8Dp` z13z1BYfHcnx)^=y=C-~F9An*9mVjc^4SNAu6=_$2!DzsJXa}3BvH+a=a4n#_>H`N* zWdS(VqQM|qTZ0B}xsT_8+92vCYUh9zv|hK@vZKrbCAMo!WL2pEo3-d#IEZYcGEnJ+ z*SqiwY#ns*jrfdIiogRi)Nck2+pfH1rm5cQ)!~?!QOb*EmclkBpzqZiE=)9sEzy%& zU+-OWjpu<6O?4YinC*EE7*WMa7&dI>ERgDvRfkde5X$h#++fhGUvGY+{f?X!Ztf5Ma74?l{6WYll@!9N#pZSI=k<51BXstBD zYpMhu)}maRFPZ}J>T1{td#(CRFYE+s@I2v9mcXdo61>R;a3dGMfLtJsbKeGyt|E>T z(~SXJ^)TuxFq~~xYr(Z5u9NR-(fR;21{`89d1E{+cxxGb5_`4!Go5HK0|n3s>h-YS z?<(T4jOwyrt4TzpFyujVA&xfkkd}_;rV8oBGb*X5OS065!S|ZMCmOGQVr(pT=9`ZN zXD;TW$(N=k9!&i4d*c()*|Rru+n@M!b?d?phgYVGY*e*n)lO6O1ew~O&G65&KN?=0 zdUo{VVSCCNC>Sx_dGbetd4_E3!DHHN zYoJHbX*S~gw4s}@RsZ~`_25`@l0CxFyZ<$=s~^4-P36Xau=UM5J5NPtqp5Lv+`4c< zfB(|i5gv2z{qOr@aJ|4Q9k|K$vMPfq#IL@n$|Pw}vOLqO3@7bI+|^REU~XRPlrfoQ zaG4ejRh}c20zQ-JEQ9III;31#Qh3u{AE+|4(Xuf~SRTzQ78&$P5l?StRa@rt1zQlL~nqLWI&*X zQWD{YnH2;yS+oYQFM(1@5oqpCTOP;Q+H%Ca{LkgU(S|>ZXU>c_$78&@_=Dznu$^n2 zHogYbgM|QE&CpliG~>rCtsT6i;?@$BQUgrxdM{L%9bytFIicPxFL6MZH1)6$bQINuv2tT4h=>z`Q%(j#oD`>A_(8Qf z4svN))y;1P?aZ6)lf+X6tk9EGf&|#A&iYy{ga?Wlme_=;!n)5^Ia*fW^+-dXmIq?n z3{Oa?TvBcfe~rAnxAYW9dWP=^$`GR_t4f#=VHm(GVE}^~B-xKM>f zN2o%b!*2x}z*_-f$g=`)2O)$7*?QYYgL(erfH`wX;ovs9#GlByy(#^C1{ca?gQq+O z6g}lJAXgof-f_QGfc9a%0Hzxkdo!+sLHx7@w~4r~0)6pH$co2&VEJpf<|k-uga<(Qh0e2aX&6?#Hgkfy-ZOW^fpn= z$ZSgAhb!jIDpZ|jvJ6FUA@(evf!(VSMGuQFD&1;BtZ7~CVHG`5GQL0*Vqz#mOz1#O z%mWjxjrl&YJJF{0BATI;I2hX}v}wdD&LS>gVdZ4&K5mNnYiA)C?6M&kBD9)dU@j70 ztW?!itlMY}#WGAT#BYO0$9E^vS)WKr7h?Okri$+h$k@IwV5ZGu4;_)}A5eo4ZzO^W zf@_wfMZFe8N&BKCY~dQ5<110m2pYUls%dp>&3>YH4Fo#5JAt0^31qk?NvGWj1HpH#MKC-*97YRjnJzSaFJ}Nw8v0I0!Ope3z(Un!zM>r{jg0Q!4k+FY?%8KIG z*@kS^uB;Di!1kHnb3VFB)g$P7^ZSum?~I_mo8arMPD55v9$%L&IkK$Mb9-B*nvZ$C zVQ}?j@lY1V4-5<7B}KI{jkS;KdXj)TWLzd4sdnQ#)#KaieU`U*0^&%^TRSYwGnOJ7 z2U^}H!}AV{M%W%8;o+mO&)Vp81`640BVjAgigMKfJ&Sl!L|}%wN@-eJI8W?utd!4> zVu&WRA^PR3(?s4z!1gJ;&r0WMfP1)=jtvD$OjJgtz`V(G#pZY)S(zb%9a2`3xk&-x z5Qq;Bjd&{e`3R%-4n1lttC=<8v*1Uwltl(%cgFl;Y-nVZY@`?oF|&|Ia4B<1pOIY? zP~eEj_L$hL@1vZapjrR;l~X+b>~PTa6a@A;XdlMCLMR-Padk2zEjXMb@yDLQtlH=w zR{6n$^NHC1B{QE!#~?U^e4IF|7fJ0ccvCEWBmQ6(e6*h?Gx=_*g6KRYHB{;UL2lrA z?$jxSymWQ|`4XMO`Dii(85w>{XvLZT81wC88K23JpO3~ef?bl^90c&P z>NT)!116Fir4ZP|PL>IQ+BPg>I>H?$C`VQ0P6?P0e9^0=Htwx$KjOmy3fK?oZP5>>zk0cs0p zLf2V4mDa!ZRSbiDOxUp_PlFwnr{Q4!wVk^(8ury;&^U2qH0-d4;ig1lU3dwmCM#Q| zz)ZPd`_#klu!Hm3pH_$ea^mj4{u}m8RBdjoyd=3XB(FU)$6<8rjOrjY%_)^yJ&=N9>o-PMwh?1_+6}2@ z^FkZev4aR3)yxiUA`_*nCaS}C0-l=q4?H4H-isoXFR=wnVXv7tvOjgw$^yy$fCKJh zc89$5KfT(LTNrDib)P-vJqI(@#OBg^u)3R{oxWiVxz0m9QO@^Qwh|>tWb&pkRBA$-BT5 z>AZ_wxmUa}OxbKKDyie-i6?MNs!R%F3+I4;c!EhNYCa!`u@P z!5jyWbXJ_=8#*gqnsdBmdD1D zm=GO|o=kGvLA@s*`}u8?&Gz!!a268z?OhoA3&3V~#y0G{7k^`KFOk6juVy{nFQoPk zewkFZzui)7nK#ig_m9T*l!S0Z1U#uMwXrjEp0;$`Fp;hROGD7Nb!-)oakOBYH_@|x{4LyYNp*AA-s1WPiu@AF>6aASv zb`V>sHj;Kou{MW~ekp=Ih#btmNji}6wv_)(upkUKvmpOi)s(W;6_!dIro}$}wC45d znBg9QiCl`?Vdv>t*+0IYWsT|D1X{kXb;HFtN>s(+S<1^+I|QINd0QhwT4n>hXBQ?h z1rt>c2$=OIxxN)TpdiQ9eA|>z^0d~c5Lf1KI`&o6*=CZnWg3dT+=t(L(iFaHes|8B zxJNY+9&q6hgaKtZHLJCWxW_JJfK9uxkO3lZ@(mm-9MLtWaLJH`ee#A7RSR@M++~-z zc1U@9)Sc=9N=NeJ-9Wy(?E2SU{DuX~923g~ic`@<#)(zVk-%XWI=BXFTogWrC#N5IFact;z+%pJGDBzB}SW`!{p1(xaZ1;otG1 zy1LV1ai^1QI1SDZcl-z49*1F?4~&MmyLDlM8#Jq1+|7sQpCkg~P_CE(g@eURDXnuB zL}}|M9P#kpVaew`d47trd1L(*<`0a?O(BCgu&mF#Dr~jm0=z^`fCeoab%`u17bF9% zg|`>B$vZic$!rkUH?+HQSfgo&e+0W}RD|bwC3FHh-$PVAsP_?8+fPhh_Z^-mAQjQX zg#Risy?*QrAnF z@a`>MICt(I#Q(8bXNR>%e!EIMvURlM_>ulmVvW2*K!Xq>8-SM7qhQWIx?V*`M&)%LU50_RLlLxtrp9~es?`}WB6u|4_pv6W08o3+r4W@2kDn{J`fVHbkv{sgTx z9z6Fl^x2r!SLbvwM`y|Ivg$fFYUVb#&W&1I=k>eE;l$4D=u9!EpQ_{Lix;c8-1zsa zIdeMo+~`Vfv*~?Rnf#8dMyq7okU6zxmSYZ!UQC#4{8)uCD)3yrV1)_(n`o*xPw^MK zec=b+VqZXqTHxX@5Wa}kI}Mz6&ukz9%o89{sEjEvuclQO_U57)V-Udn(A8d2fotV( zIoa6D$8=t4VkhDYBqkml-`cuxrZmyqtiJmj!|@-sauW~otsyGUk8+z=Wa3c!pRMM@ zzuKB?=6=*{%=elZ8!H3yzKd;BV}e-eo9EN)GX|0GU~wV*xx)_6Pj z<3Ar>(Csgfk6}_>=SEj^Uw-$e&D;;;)VXs0idiHv{{FEctMT%M1-FR81{|n)m!R_e z#rPZOd`so{8;||X3qAcYVj3q<7z(b-8X}#(UuhP{;F?##HP{fbeM~P4cW#WTe=;1e zOnw_&@!xm;XtcG{sy%p&NeE7=ir_YLU-qQw3T=)WC@ByKs_@yKg4RIt2z`(|`qs_2Srz@H{>sidz=!UhH{Ums6&Yod_hEG^RMTN%=~0P~$2`xYNp8 z28&1=BF80=W5V(QmLHA}syUu@%rLUo9z(mC^E0$|<_L?_Y}qkm>}#zJ|(RdiW^}BJs^_7&~ z>RWzgy`>!&y}~+Yl$Tcn4Sz5VRw~9~tcFz(x`N^nG)yI5c$uhVK1)=_lo*y4o22YE z)V}IWx)HIl^0ALNKbs-W9xZ z`l{f3q1O#wcp+A)3Waurkf^>`ct+7}!Oy5?1c=t_ue^G@fB&u9ue`2wIeJsAeD#f6 z_wU?$<83ru!R2(>m;BOhgN)1V%s1(~!4kJHrfy)&XWkGQyJ#(ad!?(f7w_zHRc1bU z*J1o}%goC|^`(v8RVaM5W9)*+eEPaaU6Z)lLDx~9O?JBL3ca>S)Wi;y=k?8@@srnC zmx;zMfy}rlGIh~p{N~I&Zi zd!;l4<>Nn`V@{>5$CdgrlhroBkR$qrX4#&(}(ZTh4Pl-+ho4|;nc6_~To zBb9lN85Ql;EqdVnM^w`63LLm>cCXL_rMKLM1}>W&CwQ>i1OTkdduuc#^L&wXrkG%i zAbF)!HWpoYDNNmm)}|M6;K63vY(nXx(Q-mf<{Eb9Fp9@S+>;;Y$4J(&>9;mGte;Hu z7p-itlgb_rc(idoD%)3vgWC6gU$t-l-tBG6MoGPkuQYNd5@sJIE<2J{y14 zJ{!NtJ_{_?P|R4!F}>2O1=%%Y-y1E&KXM~Ujo-J_nenM>sj`+HX?_%zzu?#KH zE%>@Gqr$8;w>NO2(P}%Y88f_lv%J??!Onz<8E~Mm@WOh83-$^e$t%(2xf+OMYcn;4 zTQKhTZ<`ZA1g)E4)32Q}X)6`fI@v8nbyVU0JvuXS>)!VE?OXRVI~6WXH%<0vxHsNV zrD4&-cvMXG!{kZUIu2!7N#dMruklNfNU%w^X4pZdF4#D_*7%Y#(}RYrBk+zVOlmY5 zng2Hd(+D3Am&cMP*(a$JX>sDIWd%MRpFLsb>^6cE_9Kn3$s<6v z1`#B}&#>+;Tf2%D`?FudHMjaWvlT01dHc>@a_iS7=V>p|k)D#@>>@zBH5Z}D;N0Cl w$&{tt8Vd`?<%H&woc=F4C2ctzhXkR_VxpP>96C5K=jOGl^Jc>^pgxlKe~Hikaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;41| 67657 +(FILECREATED " 8-Dec-2023 15:46:10" |{WMEDLEY}CLSTREAMS.;43| 66631 - :CHANGES-TO (SETFS FILE-STREAM-POSITION) - (VARS CLSTREAMSCOMS) - (FUNCTIONS OPEN CL:CLOSE CL:STREAM-EXTERNAL-FORMAT CL:STREAM-ELEMENT-TYPE - CL:INPUT-STREAM-P CL:OUTPUT-STREAM-P XCL:OPEN-STREAM-P FILE-STREAM-POSITION - CL:MAKE-SYNONYM-STREAM XCL:SYNONYM-STREAM-P XCL:SYNONYM-STREAM-SYMBOL - XCL:FOLLOW-SYNONYM-STREAMS CL:MAKE-BROADCAST-STREAM XCL:BROADCAST-STREAM-P - XCL:BROADCAST-STREAM-STREAMS CL:MAKE-CONCATENATED-STREAM - XCL:CONCATENATED-STREAM-P XCL:CONCATENATED-STREAM-STREAMS - CL:MAKE-TWO-WAY-STREAM XCL:TWO-WAY-STREAM-P XCL:TWO-WAY-STREAM-OUTPUT-STREAM - XCL:TWO-WAY-STREAM-INPUT-STREAM CL:MAKE-ECHO-STREAM XCL:ECHO-STREAM-P - XCL:ECHO-STREAM-INPUT-STREAM XCL:ECHO-STREAM-OUTPUT-STREAM - CL:MAKE-STRING-INPUT-STREAM MAKE-CONCATENATED-STRING-INPUT-STREAM - %MAKE-INITIAL-STRING-STREAM-CONTENTS CL:WITH-OPEN-STREAM - CL:WITH-INPUT-FROM-STRING CL:WITH-OUTPUT-TO-STRING CL:WITH-OPEN-FILE - CL:MAKE-STRING-OUTPUT-STREAM MAKE-FILL-POINTER-OUTPUT-STREAM - CL:GET-OUTPUT-STREAM-STRING \\STRING-STREAM-OUTCHARFN - \\ADJUSTABLE-STRING-STREAM-OUTCHARFN %NEW-FILE PREDICT-NAME INTERLISP-ACCESS - %BROADCAST-STREAM-DEVICE-CHARSETFN %CONCATENATED-STREAM-DEVICE-CHARSETFN - %SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM) - (FNS %TWO-WAY-STREAM-PEEKCCODEFN) + :EDIT-BY |rmk| - :PREVIOUS-DATE "19-Jul-2022 22:58:32" -|{DSK}kaplan>local>medley3.5>working-medley>sources>CLSTREAMS.;40|) + :CHANGES-TO (FUNCTIONS %BROADCAST-STREAM-DEVICE-CHARSETFN %CONCATENATED-STREAM-DEVICE-CHARSETFN + ) + (FNS %SYNONYM-STREAM-DEVICE-CHARSETFN %TWO-WAY-STREAM-DEVICE-CHARSETFN) + :PREVIOUS-DATE "20-Jul-2022 00:03:06" |{WMEDLEY}CLSTREAMS.;41|) -; Copyright (c) 1985-1988, 1990-1991 by Venue & Xerox Corporation. (PRETTYCOMPRINT CLSTREAMSCOMS) @@ -717,11 +698,12 @@ ) ) -(CL:DEFUN %BROADCAST-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE) +(CL:DEFUN %BROADCAST-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE DONTMARKFILE) + (* \; "Edited 8-Dec-2023 15:43 by rmk") (* |;;| "charset function for broadcast streams. Not clear what the value should be, so we arbitrarily return the value of the last stream.") - (FOR S IN (FETCH (STREAM F1) OF STREAM) DO (SETQ $$VAL (ACCESS-CHARSET S NEWVALUE)))) + (FOR S IN (FETCH (STREAM F1) OF STREAM) DO (SETQ $$VAL (ACCESS-CHARSET S NEWVALUE DONTMARKFILE)))) (DEFINEQ (%BROADCAST-STREAM-OUTCHARFN @@ -811,14 +793,15 @@ (\\EOF.ACTION STREAM)))) ) -(CL:DEFUN %CONCATENATED-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE) +(CL:DEFUN %CONCATENATED-STREAM-DEVICE-CHARSETFN (STREAM NEWVALUE DONTMARKFILE) + (* \; "Edited 8-Dec-2023 15:46 by rmk") (* |;;| "the charset method for concatenated stream devices") (LET ((STREAMS (FETCH (STREAM F1) OF STREAM))) (IF STREAMS THEN (ACCESS-CHARSET (CAR STREAMS) - NEWVALUE) + NEWVALUE DONTMARKFILE) ELSE 0))) (DEFINEQ @@ -881,9 +864,14 @@ (lambda (stream attribute value device) (* |hdj| "19-Mar-86 17:17") (* |;;;| "The SETFILEINFO method for the synonym-stream device.") (setfileinfo (%synonym-stream-device-get-stream stream) attribute value)) ) -(%synonym-stream-device-charsetfn -(lambda (stream newvalue) (* \; "Edited 11-Sep-87 16:01 by bvm:") (* |;;| "The charset method for the synonym-stream device.") (access-charset (%synonym-stream-device-get-stream stream) newvalue)) -) +(%SYNONYM-STREAM-DEVICE-CHARSETFN + (LAMBDA (STREAM NEWVALUE DONTMARKFILE) (* \; "Edited 8-Dec-2023 15:40 by rmk") + (* \; "Edited 11-Sep-87 16:01 by bvm:") + + (* |;;| "The charset method for the synonym-stream device.") + + (ACCESS-CHARSET (%SYNONYM-STREAM-DEVICE-GET-STREAM STREAM) + NEWVALUE DONTMARKFILE))) (%SYNONYM-STREAM-DEVICE-CLOSEFILE (LAMBDA (STREAM) (* \; "Edited 18-Dec-87 12:17 by sye") @@ -1095,9 +1083,14 @@ (lambda (|stream| |noErrorFlg?|) (* |smL| "14-Aug-85 16:46") (* |;;;| "The PEEKBIN method for the two-way-stream device") (\\peekbin (|fetch| f1 |of| |stream|) |noErrorFlg?|)) ) -(%two-way-stream-device-charsetfn -(lambda (stream newvalue) (* \; "Edited 11-Sep-87 16:00 by bvm:") (* |;;| "The charset method for two-way streams. Unclear what this is supposed to mean--let's apply it only to the input side (in which case newvalue is senseless)") (access-charset (|fetch| (stream f1) |of| stream) newvalue)) -) +(%TWO-WAY-STREAM-DEVICE-CHARSETFN + (LAMBDA (STREAM NEWVALUE DONTMARKFILE) (* \; "Edited 8-Dec-2023 15:41 by rmk") + (* \; "Edited 11-Sep-87 16:00 by bvm:") + + (* |;;| "The charset method for two-way streams. Unclear what this is supposed to mean--let's apply it only to the input side (in which case newvalue is senseless)") + + (ACCESS-CHARSET (|fetch| (STREAM F1) |of| STREAM) + NEWVALUE DONTMARKFILE))) ) @@ -1367,58 +1360,57 @@ ) (PUTPROPS CLSTREAMS FILETYPE CL:COMPILE-FILE) -(PUTPROPS CLSTREAMS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1991)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (7779 16754 (OPEN 7779 . 16754)) (16756 17682 (CL:CLOSE 16756 . 17682)) (17684 17762 ( -CL:STREAM-EXTERNAL-FORMAT 17684 . 17762)) (17764 17831 (CL:STREAM-ELEMENT-TYPE 17764 . 17831)) (17833 -18067 (CL:INPUT-STREAM-P 17833 . 18067)) (18069 18305 (CL:OUTPUT-STREAM-P 18069 . 18305)) (18307 18444 - (XCL:OPEN-STREAM-P 18307 . 18444)) (18446 18513 (FILE-STREAM-POSITION 18446 . 18513)) (18565 20069 ( -CL:MAKE-SYNONYM-STREAM 18565 . 20069)) (20071 20160 (XCL:SYNONYM-STREAM-P 20071 . 20160)) (20162 20300 - (XCL:SYNONYM-STREAM-SYMBOL 20162 . 20300)) (20302 20580 (XCL:FOLLOW-SYNONYM-STREAMS 20302 . 20580)) ( -20582 21067 (CL:MAKE-BROADCAST-STREAM 20582 . 21067)) (21069 21212 (XCL:BROADCAST-STREAM-P 21069 . -21212)) (21214 21429 (XCL:BROADCAST-STREAM-STREAMS 21214 . 21429)) (21431 22015 ( -CL:MAKE-CONCATENATED-STREAM 21431 . 22015)) (22017 22116 (XCL:CONCATENATED-STREAM-P 22017 . 22116)) ( -22118 22331 (XCL:CONCATENATED-STREAM-STREAMS 22118 . 22331)) (22333 24074 (CL:MAKE-TWO-WAY-STREAM -22333 . 24074)) (24076 24213 (XCL:TWO-WAY-STREAM-P 24076 . 24213)) (24215 24360 ( -XCL:TWO-WAY-STREAM-OUTPUT-STREAM 24215 . 24360)) (24362 24506 (XCL:TWO-WAY-STREAM-INPUT-STREAM 24362 - . 24506)) (24508 26055 (CL:MAKE-ECHO-STREAM 24508 . 26055)) (26057 26186 (XCL:ECHO-STREAM-P 26057 . -26186)) (26188 26326 (XCL:ECHO-STREAM-INPUT-STREAM 26188 . 26326)) (26328 26467 ( -XCL:ECHO-STREAM-OUTPUT-STREAM 26328 . 26467)) (26469 27196 (CL:MAKE-STRING-INPUT-STREAM 26469 . 27196) -) (27198 27691 (MAKE-CONCATENATED-STRING-INPUT-STREAM 27198 . 27691)) (27693 27853 ( -%MAKE-INITIAL-STRING-STREAM-CONTENTS 27693 . 27853)) (27855 28285 (CL:WITH-OPEN-STREAM 27855 . 28285)) - (28287 29516 (CL:WITH-INPUT-FROM-STRING 28287 . 29516)) (29518 30020 (CL:WITH-OUTPUT-TO-STRING 29518 - . 30020)) (30022 30676 (CL:WITH-OPEN-FILE 30022 . 30676)) (30900 32426 ( -MAKE-FILL-POINTER-OUTPUT-STREAM 30900 . 32426)) (32428 33149 (CL:GET-OUTPUT-STREAM-STRING 32428 . -33149)) (33151 33630 (\\STRING-STREAM-OUTCHARFN 33151 . 33630)) (33632 35487 ( -\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 33632 . 35487)) (35516 35598 (%NEW-FILE 35516 . 35598)) (35600 -35745 (PREDICT-NAME 35600 . 35745)) (35781 35932 (INTERLISP-ACCESS 35781 . 35932)) (36021 36756 ( -%BROADCAST-STREAM-DEVICE-BOUT 36031 . 36254) (%BROADCAST-STREAM-DEVICE-CLOSEFILE 36256 . 36495) ( -%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 36497 . 36754)) (36758 37085 (%BROADCAST-STREAM-DEVICE-CHARSETFN -36758 . 37085)) (37086 37881 (%BROADCAST-STREAM-OUTCHARFN 37096 . 37879)) (37920 39979 ( -%CONCATENATED-STREAM-DEVICE-BIN 37930 . 38335) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 38337 . 38650) ( -%CONCATENATED-STREAM-DEVICE-EOFP 38652 . 39016) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 39018 . 39493) ( -%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 39495 . 39977)) (39980 42610 (%CONCATENATED-STREAM-INCCODEFN -39990 . 40860) (%CONCATENATED-STREAM-PEEKCCODEFN 40862 . 41734) (%CONCATENATED-STREAM-BACKCCODEFN -41736 . 42608)) (42612 42943 (%CONCATENATED-STREAM-DEVICE-CHARSETFN 42612 . 42943)) (42944 43475 ( -%ECHO-STREAM-DEVICE-BIN 42954 . 43161) (%ECHO-STREAM-INCCODEFN 43163 . 43473)) (43510 43735 ( -%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 43510 . 43735)) (43736 46372 (%SYNONYM-STREAM-DEVICE-BIN -43746 . 43934) (%SYNONYM-STREAM-DEVICE-BOUT 43936 . 44137) (%SYNONYM-STREAM-DEVICE-EOFP 44139 . 44330) - (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 44332 . 44570) (%SYNONYM-STREAM-DEVICE-GETFILEINFO 44572 . 44809) - (%SYNONYM-STREAM-DEVICE-PEEKBIN 44811 . 45034) (%SYNONYM-STREAM-DEVICE-READP 45036 . 45147) ( -%SYNONYM-STREAM-DEVICE-BACKFILEPTR 45149 . 45295) (%SYNONYM-STREAM-DEVICE-SETFILEINFO 45297 . 45546) ( -%SYNONYM-STREAM-DEVICE-CHARSETFN 45548 . 45784) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 45786 . 46370)) ( -46400 46639 (%SYNONYM-STREAM-DEVICE-GET-STREAM 46410 . 46637)) (46683 49626 (%SYNONYM-STREAM-OUTCHARFN - 46693 . 47639) (%SYNONYM-STREAM-INCCODEFN 47641 . 48170) (%SYNONYM-STREAM-PEEKCCODEFN 48172 . 48979) -(%SYNONYM-STREAM-BACKCCODEFN 48981 . 49624)) (49660 51663 (%TWO-WAY-STREAM-BACKCCODEFN 49670 . 50071) -(%TWO-WAY-STREAM-INCCODEFN 50073 . 50468) (%TWO-WAY-STREAM-OUTCHARFN 50470 . 51162) ( -%TWO-WAY-STREAM-PEEKCCODEFN 51164 . 51661)) (51664 55989 (%TWO-WAY-STREAM-DEVICE-BIN 51674 . 51847) ( -%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 51849 . 52040) (%TWO-WAY-STREAM-DEVICE-BOUT 52042 . 52214) ( -%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 52216 . 52406) (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 52408 . 53270) ( -%TWO-WAY-STREAM-DEVICE-CLOSEFILE 53272 . 54695) (%TWO-WAY-STREAM-DEVICE-EOFP 54697 . 54873) ( -%TWO-WAY-STREAM-DEVICE-READP 54875 . 55068) (%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 55070 . 55206) ( -%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 55208 . 55437) (%TWO-WAY-STREAM-DEVICE-PEEKBIN 55439 . 55652) ( -%TWO-WAY-STREAM-DEVICE-CHARSETFN 55654 . 55987)) (56029 56254 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE -56029 . 56254)) (56256 56375 (%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 56256 . 56375)) (56813 57356 ( -%INITIALIZE-STANDARD-STREAMS 56813 . 57356)) (57357 67383 (%INITIALIZE-CLSTREAM-TYPES 57367 . 67381))) + (FILEMAP (NIL (6184 15159 (OPEN 6184 . 15159)) (15161 16087 (CL:CLOSE 15161 . 16087)) (16089 16167 ( +CL:STREAM-EXTERNAL-FORMAT 16089 . 16167)) (16169 16236 (CL:STREAM-ELEMENT-TYPE 16169 . 16236)) (16238 +16472 (CL:INPUT-STREAM-P 16238 . 16472)) (16474 16710 (CL:OUTPUT-STREAM-P 16474 . 16710)) (16712 16849 + (XCL:OPEN-STREAM-P 16712 . 16849)) (16851 16918 (FILE-STREAM-POSITION 16851 . 16918)) (16970 18474 ( +CL:MAKE-SYNONYM-STREAM 16970 . 18474)) (18476 18565 (XCL:SYNONYM-STREAM-P 18476 . 18565)) (18567 18705 + (XCL:SYNONYM-STREAM-SYMBOL 18567 . 18705)) (18707 18985 (XCL:FOLLOW-SYNONYM-STREAMS 18707 . 18985)) ( +18987 19472 (CL:MAKE-BROADCAST-STREAM 18987 . 19472)) (19474 19617 (XCL:BROADCAST-STREAM-P 19474 . +19617)) (19619 19834 (XCL:BROADCAST-STREAM-STREAMS 19619 . 19834)) (19836 20420 ( +CL:MAKE-CONCATENATED-STREAM 19836 . 20420)) (20422 20521 (XCL:CONCATENATED-STREAM-P 20422 . 20521)) ( +20523 20736 (XCL:CONCATENATED-STREAM-STREAMS 20523 . 20736)) (20738 22479 (CL:MAKE-TWO-WAY-STREAM +20738 . 22479)) (22481 22618 (XCL:TWO-WAY-STREAM-P 22481 . 22618)) (22620 22765 ( +XCL:TWO-WAY-STREAM-OUTPUT-STREAM 22620 . 22765)) (22767 22911 (XCL:TWO-WAY-STREAM-INPUT-STREAM 22767 + . 22911)) (22913 24460 (CL:MAKE-ECHO-STREAM 22913 . 24460)) (24462 24591 (XCL:ECHO-STREAM-P 24462 . +24591)) (24593 24731 (XCL:ECHO-STREAM-INPUT-STREAM 24593 . 24731)) (24733 24872 ( +XCL:ECHO-STREAM-OUTPUT-STREAM 24733 . 24872)) (24874 25601 (CL:MAKE-STRING-INPUT-STREAM 24874 . 25601) +) (25603 26096 (MAKE-CONCATENATED-STRING-INPUT-STREAM 25603 . 26096)) (26098 26258 ( +%MAKE-INITIAL-STRING-STREAM-CONTENTS 26098 . 26258)) (26260 26690 (CL:WITH-OPEN-STREAM 26260 . 26690)) + (26692 27921 (CL:WITH-INPUT-FROM-STRING 26692 . 27921)) (27923 28425 (CL:WITH-OUTPUT-TO-STRING 27923 + . 28425)) (28427 29081 (CL:WITH-OPEN-FILE 28427 . 29081)) (29305 30831 ( +MAKE-FILL-POINTER-OUTPUT-STREAM 29305 . 30831)) (30833 31554 (CL:GET-OUTPUT-STREAM-STRING 30833 . +31554)) (31556 32035 (\\STRING-STREAM-OUTCHARFN 31556 . 32035)) (32037 33892 ( +\\ADJUSTABLE-STRING-STREAM-OUTCHARFN 32037 . 33892)) (33921 34003 (%NEW-FILE 33921 . 34003)) (34005 +34150 (PREDICT-NAME 34005 . 34150)) (34186 34337 (INTERLISP-ACCESS 34186 . 34337)) (34426 35161 ( +%BROADCAST-STREAM-DEVICE-BOUT 34436 . 34659) (%BROADCAST-STREAM-DEVICE-CLOSEFILE 34661 . 34900) ( +%BROADCAST-STREAM-DEVICE-FORCEOUTPUT 34902 . 35159)) (35163 35625 (%BROADCAST-STREAM-DEVICE-CHARSETFN +35163 . 35625)) (35626 36421 (%BROADCAST-STREAM-OUTCHARFN 35636 . 36419)) (36460 38519 ( +%CONCATENATED-STREAM-DEVICE-BIN 36470 . 36875) (%CONCATENATED-STREAM-DEVICE-CLOSEFILE 36877 . 37190) ( +%CONCATENATED-STREAM-DEVICE-EOFP 37192 . 37556) (%CONCATENATED-STREAM-DEVICE-PEEKBIN 37558 . 38033) ( +%CONCATENATED-STREAM-DEVICE-BACKFILEPTR 38035 . 38517)) (38520 41150 (%CONCATENATED-STREAM-INCCODEFN +38530 . 39400) (%CONCATENATED-STREAM-PEEKCCODEFN 39402 . 40274) (%CONCATENATED-STREAM-BACKCCODEFN +40276 . 41148)) (41152 41618 (%CONCATENATED-STREAM-DEVICE-CHARSETFN 41152 . 41618)) (41619 42150 ( +%ECHO-STREAM-DEVICE-BIN 41629 . 41836) (%ECHO-STREAM-INCCODEFN 41838 . 42148)) (42185 42410 ( +%SYNONYM-STREAM-DEVICE-GET-INDIRECT-STREAM 42185 . 42410)) (42411 45240 (%SYNONYM-STREAM-DEVICE-BIN +42421 . 42609) (%SYNONYM-STREAM-DEVICE-BOUT 42611 . 42812) (%SYNONYM-STREAM-DEVICE-EOFP 42814 . 43005) + (%SYNONYM-STREAM-DEVICE-FORCEOUTPUT 43007 . 43245) (%SYNONYM-STREAM-DEVICE-GETFILEINFO 43247 . 43484) + (%SYNONYM-STREAM-DEVICE-PEEKBIN 43486 . 43709) (%SYNONYM-STREAM-DEVICE-READP 43711 . 43822) ( +%SYNONYM-STREAM-DEVICE-BACKFILEPTR 43824 . 43970) (%SYNONYM-STREAM-DEVICE-SETFILEINFO 43972 . 44221) ( +%SYNONYM-STREAM-DEVICE-CHARSETFN 44223 . 44652) (%SYNONYM-STREAM-DEVICE-CLOSEFILE 44654 . 45238)) ( +45268 45507 (%SYNONYM-STREAM-DEVICE-GET-STREAM 45278 . 45505)) (45551 48494 (%SYNONYM-STREAM-OUTCHARFN + 45561 . 46507) (%SYNONYM-STREAM-INCCODEFN 46509 . 47038) (%SYNONYM-STREAM-PEEKCCODEFN 47040 . 47847) +(%SYNONYM-STREAM-BACKCCODEFN 47849 . 48492)) (48528 50531 (%TWO-WAY-STREAM-BACKCCODEFN 48538 . 48939) +(%TWO-WAY-STREAM-INCCODEFN 48941 . 49336) (%TWO-WAY-STREAM-OUTCHARFN 49338 . 50030) ( +%TWO-WAY-STREAM-PEEKCCODEFN 50032 . 50529)) (50532 55054 (%TWO-WAY-STREAM-DEVICE-BIN 50542 . 50715) ( +%TWO-WAY-STREAM-DEVICE-INPUTSTREAM 50717 . 50908) (%TWO-WAY-STREAM-DEVICE-BOUT 50910 . 51082) ( +%TWO-WAY-STREAM-DEVICE-OUTPUTSTREAM 51084 . 51274) (%TWO-WAY-STREAM-DEVICE-OUTCHARFN 51276 . 52138) ( +%TWO-WAY-STREAM-DEVICE-CLOSEFILE 52140 . 53563) (%TWO-WAY-STREAM-DEVICE-EOFP 53565 . 53741) ( +%TWO-WAY-STREAM-DEVICE-READP 53743 . 53936) (%TWO-WAY-STREAM-DEVICE-BACKFILEPTR 53938 . 54074) ( +%TWO-WAY-STREAM-DEVICE-FORCEOUTPUT 54076 . 54305) (%TWO-WAY-STREAM-DEVICE-PEEKBIN 54307 . 54520) ( +%TWO-WAY-STREAM-DEVICE-CHARSETFN 54522 . 55052)) (55094 55319 (%FILL-POINTER-STREAM-DEVICE-CLOSEFILE +55094 . 55319)) (55321 55440 (%FILL-POINTER-STREAM-DEVICE-GETFILEPTR 55321 . 55440)) (55878 56421 ( +%INITIALIZE-STANDARD-STREAMS 55878 . 56421)) (56422 66448 (%INITIALIZE-CLSTREAM-TYPES 56432 . 66446))) )) STOP diff --git a/sources/CLSTREAMS.LCOM b/sources/CLSTREAMS.LCOM index dd0d79cf18f333a568542bb68f89d002838b4e02..abd34786da2533148c4d4a8648b3462af7b178c9 100644 GIT binary patch delta 528 zcmX>;i)qNQYOn0Q+{0a->*PY-B7N@7WBN)6B`RQo`B zOqDdbG~7IWT%Chl9Yb7QFcg`Xfel7;guZc&f|;3_v7v&MtBYrdu2ZB!O;K)kje?c4 zhohgnYp`yJKbL}rTd1FNh^N0_@MK0_smTs0T$2yAt4?m@mj|;qiHJ?MPvH{MRImyN zat-tJ4-M9J0Xjl~Yhr*nH=2!%hMTXl{c&eDv@n}|#cwZ&-aN(Mjg{X>!NuP%#Md#% z8{`dz$-1%PtOhI$49t_ig{W{lTdN+>4>R^^&ZAmyI1O3Xmzn{#8I zuwf`GERbSV0xOG85NG$;>EQ@eI{8An*5<7#=b4xdEe$ufr{4fEj5a4_31T-u1#G~C R0$H#<>kBMpSo}PFxBwe)ks$y8 delta 935 zcmb_b&rcIU6sFTI$^vSjqzW_)3pB0Lvfa`aR&6NTEnQmLZFj+v7_ezq)39{0rT(G> zF5XN;-_3&u514o|*^>tkdhv??fbrm6Z(byE781q8BXjs>@_qBZm-pVx{xkIH1=`E+ zaIAm6srxyW<1oweY=~zg4E8c*V|}BlYZYwNFoWsVRzgW{Uu!nBdLy=0+R#h2m~NCy zdTd>*=-R_jARN1I)Yq!DJN{!P)-am&vet+R8AUCK@dYJtbu!rUVJ0~JH{}i&;=_|X z8zngyA-5n)8PT64P+@SZT5Dk@xtPh|lOcgXfM}J{rdA>HN#)op$T2?JYk3GHttuuk z^Zz2PqE=3)DjbPM!coi%sd#oyRQzfVdlgYl!c%*H&r-ag;6Gg;MJn(eO~QmdXTvZv z(r2ULv)u)+JWe>Yhau+3+VJx$1BBikAAkeL5V@8OxWGv{5sl$VaF`r>VTI~~dz8nb zUQ#@CUw4D8-2;c>80_*+glTxxo*<#}tQ&HPVdywB2(!t4IFQCJ&K{{= zWT{_@4APNlU;fq(NCai zM?_LaVW!+~j^6%BSr*jDk+Gz^E#s;_J-F(X7gf2ClTQp73pshYAkC#z@{N|XT2sRw qT-55u11uQz4WnM#tQs|jyy>a11rZCP7EBSCW-SQ%d~{aI(7yo)hYTM8 diff --git a/sources/EXTERNALFORMAT b/sources/EXTERNALFORMAT index 4815f6cc..68c556aa 100644 --- a/sources/EXTERNALFORMAT +++ b/sources/EXTERNALFORMAT @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Dec-2023 23:57:52" {WMEDLEY}EXTERNALFORMAT.;82 37884 +(FILECREATED "12-Jan-2024 10:59:18" {DSK}larry>il>medley>sources>EXTERNALFORMAT.;3 38380 - :EDIT-BY rmk + :EDIT-BY "lmm" - :CHANGES-TO (MACROS \CHECKEOLC) - (FNS \CHECKEOLC.CRLF) + :CHANGES-TO (FNS \BACKCCODE) - :PREVIOUS-DATE "23-Oct-2023 17:07:12" {WMEDLEY}EXTERNALFORMAT.;79) + :PREVIOUS-DATE " 8-Dec-2023 22:02:21" {DSK}larry>il>medley>sources>EXTERNALFORMAT.;1) (PRETTYCOMPRINT EXTERNALFORMATCOMS) @@ -69,12 +68,14 @@  "Extra fields for use of particular formats. Possibly to hold standardized translation tables") (EF2 POINTER) (FORMATBYTESTRINGFN POINTER) (* ; "Translates an internal string into a string containing the bytes that represent that string in this format") + (FORMATCHARSETFN POINTER) (* ; + "If present, apply by \GENERIC.CHARSET") )) ) -(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2) - FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER) +(/DECLAREDATATYPE 'EXTERNALFORMAT + '(FLAG (BITS 2) + FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER) '((EXTERNALFORMAT 0 (FLAGBITS . 0)) (EXTERNALFORMAT 0 (BITS . 17)) (EXTERNALFORMAT 0 (FLAGBITS . 48)) @@ -86,16 +87,17 @@ (EXTERNALFORMAT 10 POINTER) (EXTERNALFORMAT 12 POINTER) (EXTERNALFORMAT 14 POINTER) - (EXTERNALFORMAT 16 POINTER)) - '18) + (EXTERNALFORMAT 16 POINTER) + (EXTERNALFORMAT 18 POINTER)) + '20) (* "END EXPORTED DEFINITIONS") ) -(/DECLAREDATATYPE 'EXTERNALFORMAT '(FLAG (BITS 2) - FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER) +(/DECLAREDATATYPE 'EXTERNALFORMAT + '(FLAG (BITS 2) + FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER) '((EXTERNALFORMAT 0 (FLAGBITS . 0)) (EXTERNALFORMAT 0 (BITS . 17)) (EXTERNALFORMAT 0 (FLAGBITS . 48)) @@ -107,8 +109,9 @@ (EXTERNALFORMAT 10 POINTER) (EXTERNALFORMAT 12 POINTER) (EXTERNALFORMAT 14 POINTER) - (EXTERNALFORMAT 16 POINTER)) - '18) + (EXTERNALFORMAT 16 POINTER) + (EXTERNALFORMAT 18 POINTER)) + '20) (ADDTOVAR SYSTEMRECLST (DATATYPE EXTERNALFORMAT ((EOLVALID FLAG) @@ -122,7 +125,8 @@ (FORMATBYTESTREAMFN POINTER) (EF1 POINTER) (EF2 POINTER) - (FORMATBYTESTRINGFN POINTER))) + (FORMATBYTESTRINGFN POINTER) + (FORMATCHARSETFN POINTER))) ) (DEFINEQ @@ -185,7 +189,8 @@ (MAKE-EXTERNALFORMAT [LAMBDA (NAME INCCODEFN PEEKCCODEFN BACKCCODEFN OUTCHARFN FORMATBYTESTREAMFN EOL UNSTABLE - FORMATBYTESTRINGFN DEFAULT) (* ; "Edited 3-Jul-2022 00:35 by rmk") + FORMATBYTESTRINGFN DEFAULT FORMATCHARSETFN) (* ; "Edited 8-Dec-2023 22:02 by rmk") + (* ; "Edited 3-Jul-2022 00:35 by rmk") (* ; "Edited 10-Sep-2021 19:47 by rmk:") (* ;; "Compiled creator for EXTERNALFORMAT so that declaration (EXPORTS.ALL) is not needed. If EOL is not specified, then EOLVALID is also NIL. Fills in missing functions from DEFAULT if given. If DEFAULT is T, use *DEFAULT-EXTERNALFORMAT*.") @@ -225,7 +230,8 @@ EOLVALID _ EOL EOL _ (OR EOL LF.EOLC) UNSTABLE _ UNSTABLE - FORMATBYTESTRINGFN _ FORMATBYTESTRINGFN]) + FORMATBYTESTRINGFN _ FORMATBYTESTRINGFN + FORMATCHARSETFN _ (OR FORMATCHARSETFN (FUNCTION NILL]) (\EXTERNALFORMAT.DEFPRINT [LAMBDA (EXTERNALFORMAT STREAM) (* ; "Edited 2-Jul-2022 11:40 by rmk") @@ -357,7 +363,8 @@ STREAM]) (\BACKCCODE - [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 19-Jul-2022 15:55 by rmk") + [LAMBDA (STREAM BYTECOUNTVAR BYTECOUNTVAL) (* ; "Edited 12-Jan-2024 10:58 by lmm") + (* ; "Edited 19-Jul-2022 15:55 by rmk") (* ; "Edited 30-Jun-2022 10:00 by rmk") (* ; "Edited 14-Aug-2021 00:26 by rmk:") @@ -373,7 +380,7 @@ *BYTECOUNTER*)) (CL:WHEN CODE (OR (FIXP CODE) - (CLFUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM) + (CL:FUNCALL (ffetch (STREAM PEEKCCODEFN) of STREAM) STREAM)))] ELSEIF (SETQ CODE (CL:FUNCALL (ffetch (STREAM BACKCCODEFN) of STREAM) STREAM)) @@ -720,13 +727,13 @@ (\CREATE.THROUGH.EXTERNALFORMAT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6547 13182 (\EXTERNALFORMAT 6557 . 10335) (MAKE-EXTERNALFORMAT 10337 . 12709) ( -\EXTERNALFORMAT.DEFPRINT 12711 . 13180)) (13183 16224 (\INSTALL.EXTERNALFORMAT 13193 . 14642) ( -\REMOVE.EXTERNALFORMAT 14644 . 15475) (FIND-FORMAT 15477 . 16222)) (16225 16637 (SYSTEM-EXTERNALFORMAT - 16235 . 16635)) (16986 32303 (\OUTCHAR 16996 . 18213) (\INCCODE 18215 . 19368) (\BACKCCODE 19370 . -20939) (\BACKCCODE.EOLC 20941 . 23131) (\PEEKCCODE 23133 . 23458) (\PEEKCCODE.EOLC 23460 . 23839) ( -\INCCODE.EOLC 23841 . 25640) (\FORMATBYTESTREAM 25642 . 27777) (\FORMATBYTESTRING 27779 . 29238) ( -\CHECKEOLC.CRLF 29240 . 32301)) (33585 35821 (\NULLDEVICE 33595 . 35497) (\NULL.OPENFILE 35499 . 35819 -)) (35961 37788 (\CREATE.THROUGH.EXTERNALFORMAT 35971 . 36757) (\THROUGHIN 36759 . 37179) ( -\THROUGHBACKCCODE 37181 . 37448) (\THROUGHOUTCHARFN 37450 . 37786))))) + (FILEMAP (NIL (6735 13568 (\EXTERNALFORMAT 6745 . 10523) (MAKE-EXTERNALFORMAT 10525 . 13095) ( +\EXTERNALFORMAT.DEFPRINT 13097 . 13566)) (13569 16610 (\INSTALL.EXTERNALFORMAT 13579 . 15028) ( +\REMOVE.EXTERNALFORMAT 15030 . 15861) (FIND-FORMAT 15863 . 16608)) (16611 17023 (SYSTEM-EXTERNALFORMAT + 16621 . 17021)) (17372 32799 (\OUTCHAR 17382 . 18599) (\INCCODE 18601 . 19754) (\BACKCCODE 19756 . +21435) (\BACKCCODE.EOLC 21437 . 23627) (\PEEKCCODE 23629 . 23954) (\PEEKCCODE.EOLC 23956 . 24335) ( +\INCCODE.EOLC 24337 . 26136) (\FORMATBYTESTREAM 26138 . 28273) (\FORMATBYTESTRING 28275 . 29734) ( +\CHECKEOLC.CRLF 29736 . 32797)) (34081 36317 (\NULLDEVICE 34091 . 35993) (\NULL.OPENFILE 35995 . 36315 +)) (36457 38284 (\CREATE.THROUGH.EXTERNALFORMAT 36467 . 37253) (\THROUGHIN 37255 . 37675) ( +\THROUGHBACKCCODE 37677 . 37944) (\THROUGHOUTCHARFN 37946 . 38282))))) STOP diff --git a/sources/EXTERNALFORMAT.LCOM b/sources/EXTERNALFORMAT.LCOM index 8d78d3c8dea8f7953ea916e0a3e15de9c9f6c250..54acfb73df6046396e7f90b500a8abf7d58b83fd 100644 GIT binary patch delta 948 zcmah{L2nX47-gYQyHE;v>2h)>@2NMSxqoUC{efhpO?|t*;eXJZTKDn7fLU?|4 zBP{TO1c+Cn(~8J5z%py?*1dYOR)zKkFhK8S%q_cM|nxqE)LlYdZ=2 znHqa2a=;+;lS)7eiYYu|;7*sR8LC2k187FCSB_FdWV5MovqY zG_|Z{2zabIh?7jbjTdwIiPGdi^VzXJM!yyE##aX>ea^CyW&aX?RNd_ z`R#5GU$?8&A>Ok;zC7zc8tmb`R;y8+_xnzKLtTi+!V1wC_Bw)W49vMgC6~#UL5zcL z@nmfM&ajCx(L;W2|?(YcG z_-QcEId-hrZAg@Gz%@UN#26F-fyyH>itoEVT!?mSi3iLLuRCu!EEb#BV^QD9cz<~E zT3Cc5E_teWDO<9Ub$gPhGhS*S*~qzlOVt--=;{sa$;N`4JRW}=j*UtpQ4o8q0;z;v zg|O3WcJ|$alvR@O!H7wr&est;!Jk4hPOw3W#}jN2FS9I}Jz@j+D(f4Sp;$2T#95Bx bfW1*Ekbnt%=QV*}BuV@|89;ZAIT!UE+H3eS delta 865 zcmZuvOHUI~6z=o^ap;3q)FLq+29+7&)S0={&U9eWaUQfXoxwhM7+jdPlBPu-vd|Di z;?Bf{yefrPYdUPB54EYnzBS!;J&O;~*b3~bGpEz_|UUrb?#N+VU`fMy_ju2j%uRTD_* zM(b~B>)Bej-Dq!ipWoE*+KubWZPLrGI}V&L&15nR4b4ZJWY~XtiW0-otX*;}qhjeb z%Os>8&5D+ldNppV5+FrYWza0MRO9b1!p2GmXw4|*@`t+^6FLIBocs;5brfM&s-A~vbRQL0{zdXr?^aAi70uFUc&1G zX+IGx25~pM69yX)-WwTaI0*a8W7Mfxh8LWm9kzVZiy(5y}pr}1Sj$#pCdo0 z2&{#gRdIFaj0lR*i)58vM3#FH|9juVNGK-?crtn~mJ=nI1rc;1CyIDIehGhw?&7)F z@2tebv;|_k!CZc2`ujCS^$dO};E#jB#)zAqc!w%zZ hmc!TBL|P;QezQ1oHTUZtxeHoU{U7WI<&RE;sb3`>+?fCX diff --git a/sources/FILEIO b/sources/FILEIO index 4082743e..cdb7ff6b 100644 --- a/sources/FILEIO +++ b/sources/FILEIO @@ -1,18 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Aug-2023 08:47:31" {WMEDLEY}FILEIO.;119 162381 +(FILECREATED " 8-Dec-2023 15:17:12" {WMEDLEY}FILEIO.;124 163555 :EDIT-BY rmk - :CHANGES-TO (FNS \DO.PARAMS.AT.OPEN PUTSTREAMPROP GETSTREAMPROP) + :CHANGES-TO (FNS \GENERIC.CHARSET CHARSET ACCESS-CHARSET) - :PREVIOUS-DATE "11-Oct-2022 11:34:00" {WMEDLEY}FILEIO.;118) + :PREVIOUS-DATE " 7-Dec-2023 23:54:02" {WMEDLEY}FILEIO.;121) -(* ; " -Copyright (c) 1981-1993, 1999, 2020-2022 by Venue & Xerox Corporation. -") - (PRETTYCOMPRINT FILEIOCOMS) (RPAQQ FILEIOCOMS @@ -2383,37 +2379,36 @@ update the map") STREAM]) (CHARSET - [LAMBDA (STREAM NEWVALUE) (* ; "Edited 11-Sep-87 16:22 by bvm:") + [LAMBDA (STREAM NEWVALUE DONTMARKFILE) (* ; "Edited 8-Dec-2023 15:04 by rmk") + (* ; "Edited 11-Sep-87 16:22 by bvm:") - (* ;; "Public access to a stream's CHARSET. If NEWVALUE is given, changes the charset (which for output streams can write a charset shift). We invoke the stream's device's get/set charset method on the stream, and also invoke the IMCHARSET image operation (which is where file streams get to write a charset shift).") - - (* ;; "If CHARACTERSET is either 255 or T, set the stream so that it's non run-coded, i.e., you read 2 bytes for each character read.") + (* ;; "Public access to a stream's CHARSET. If NEWVALUE is given, changes the charset (which for output streams can write a charset shift, depending on the external format, unless DONTMARKFILE). ACCESS-CHARSET recurses through any commonlisp meta-streams, eventually reaches \GENERIC.CHARSET, which then applies the format's FORMATCHARSETFN. ") (SETQ STREAM (\GETSTREAM STREAM)) (COND - ((EQ NEWVALUE NSCHARSETSHIFT) (* ; "Coerce 255 to T for uniformity") + ((EQ NEWVALUE NSCHARSETSHIFT) (* ; "Coerce 255 to T for uniformity") (SETQ NEWVALUE T)) ([NOT (OR (EQ NEWVALUE NIL) (EQ NEWVALUE T) (AND (>= NEWVALUE 0) (< NEWVALUE \MAXCHARSET] (\ILLEGAL.ARG NEWVALUE))) - (LET [(OLDVAL (ACCESS-CHARSET STREAM (if (EQ NEWVALUE T) - then NSCHARSETSHIFT - else NEWVALUE] - (* ; "First modify the stream's slot") + (LET ((OLDVAL (ACCESS-CHARSET STREAM (if (EQ NEWVALUE T) + then NSCHARSETSHIFT + else NEWVALUE) + DONTMARKFILE))) (* ; "First modify the stream's slot") (if (EQ OLDVAL NSCHARSETSHIFT) then (SETQ OLDVAL T)) - (if (AND NEWVALUE (NEQ OLDVAL NEWVALUE)) - then (* ; - "Now invoke the imageop if anything interesting happened") - (IMAGEOP 'IMCHARSET STREAM STREAM NEWVALUE)) OLDVAL]) (ACCESS-CHARSET - [LAMBDA (STREAM NEWVALUE) (* ; "Edited 11-Sep-87 15:46 by bvm:") + [LAMBDA (STREAM NEWVALUE DONTMARKFILE) (* ; "Edited 8-Dec-2023 15:05 by rmk") + (* ; "Edited 11-Sep-87 15:46 by bvm:") + + (* ;; "Unless DONTMARKSTREAM, if STREAM is open for output, the external format function may modify the backing file as well as the stream, e.g. put in XCCS shifting bytes.") + (FDEVOP 'CHARSETFN (fetch (STREAM DEVICE) of STREAM) - STREAM NEWVALUE]) + STREAM NEWVALUE DONTMARKFILE]) (GETEOFPTR [LAMBDA (FILE) (* rmk%: "21-OCT-83 11:19") @@ -2673,12 +2668,29 @@ update the map") (\BACKCCODE.EOLC STRM)))])]) (\GENERIC.CHARSET - [LAMBDA (STREAM NEWVALUE) (* ; "Edited 11-Sep-87 16:20 by bvm:") + [LAMBDA (STREAM NEWVALUE DONTMARKSTREAM) (* ; "Edited 8-Dec-2023 15:17 by rmk") + (* ; "Edited 11-Sep-87 16:20 by bvm:") -(* ;;; "sets or returns the current numeric character set for this stream. This never writes anything on a stream, it just tells the stream what to think.") +(* ;;; "sets or returns the current numeric character set for this stream. This applies the stream's FORMATCHARSETFN if it has one, and (if MARKSTREAM) that may change an output backing stream in some way (e.g. write XCCS charset shift bytes). Otherwise, this just sets the charset stream parameter to influence subsequent reading and writing behavior. Charset doesn't exist in some formats (e.g. UTF-8), the format function would be a noop in that case.") - (PROG1 (ffetch (STREAM CHARSET) of (\DTEST STREAM 'STREAM)) - (AND NEWVALUE (freplace (STREAM CHARSET) of STREAM with NEWVALUE)))]) + (\DTEST STREAM 'STREAM) + (LET ((EFORMAT (ffetch (STREAM EXTERNALFORMAT) of STREAM)) + OLDVALUE) + (if (AND EFORMAT (fetch (EXTERNALFORMAT FORMATCHARSETFN) of EFORMAT)) + then (APPLY* (fetch (EXTERNALFORMAT FORMATCHARSETFN) of EFORMAT) + STREAM NEWVALUE DONTMARKSTREAM) + else (SETQ OLDVALUE (ffetch (STREAM CHARSET) of STREAM)) + (CL:WHEN NEWVALUE + (freplace (STREAM CHARSET) of STREAM with NEWVALUE) + (CL:UNLESS (OR DONTMARKSTREAM (EQ NEWVALUE OLDVALUE) + (NOT (\IOMODEP STREAM 'OUTPUT T))) + (\BOUT STREAM NSCHARSETSHIFT) + (if (OR (EQ CHARSET T) + (EQ CHARSET NSCHARSETSHIFT)) + then (\BOUT STREAM NSCHARSETSHIFT) + (\BOUT STREAM 0) + else (\BOUT STREAM CHARSET)))) + OLDVALUE]) ) (DEFINEQ @@ -2717,11 +2729,12 @@ update the map") (T PATHNAME?)))) ) -(DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE) +(DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE MARKSTREAM) `((OPENLAMBDA (STRM) (FDEVOP 'CHARSETFN (fetch (STREAM DEVICE) of STRM) STRM - ,NEWVALUE)) + ,NEWVALUE + ,MARKSTREAM)) ,STREAM)) (* "END EXPORTED DEFINITIONS") @@ -3101,42 +3114,40 @@ update the map") (ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP) ) -(PUTPROPS FILEIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1989 -1990 1991 1992 1993 1999 2020 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (27821 31937 (STREAMPROP 27831 . 28265) (GETSTREAMPROP 28267 . 29016) (PUTSTREAMPROP -29018 . 31785) (STREAMP 31787 . 31935)) (31980 35359 (\DEFPRINT.BY.NAME 31990 . 33142) ( -\STREAM.DEFPRINT 33144 . 35052) (\FDEV.DEFPRINT 35054 . 35357)) (35617 40658 (\GETACCESS 35627 . 36081 -) (\SETACCESS 36083 . 40656)) (60884 66853 (\DEFINEDEVICE 60894 . 63210) (\GETDEVICEFROMNAME 63212 . -63685) (\GETDEVICEFROMHOSTNAME 63687 . 64731) (\REMOVEDEVICE 64733 . 65856) (\REMOVEDEVICE.NAMES 65858 - . 66851)) (66893 92425 (\CLOSEFILE 66903 . 67728) (\DELETEFILE 67730 . 68024) (\DEVICEEVENT 68026 . -69796) (\GENERATEFILES 69798 . 70745) (\GENERATENEXTFILE 70747 . 71398) (\GENERATEFILEINFO 71400 . -71861) (\GETFILENAME 71863 . 72252) (\GENERIC.OUTFILEP 72254 . 72724) (\OPENFILE 72726 . 75304) ( -\DO.PARAMS.AT.OPEN 75306 . 77835) (\RENAMEFILE 77837 . 78261) (\REVALIDATEFILE 78263 . 80865) ( -\PAGED.REVALIDATEFILELST 80867 . 82425) (\PAGED.REVALIDATEFILES 82427 . 84146) (\PAGED.REVALIDATEFILE -84148 . 86431) (\BUFFERED.REVALIDATEFILE 86433 . 88719) (\BUFFERED.REVALIDATEFILELST 88721 . 89905) ( -\PRINT-REVALIDATION-RESULT 89907 . 90749) (\TRUNCATEFILE 90751 . 91142) (\FILE-CONFLICT 91144 . 92423) -) (92461 97124 (\GENERATENOFILES 92471 . 94567) (\NULLFILEGENERATOR 94569 . 94813) (\NOFILESNEXTFILEFN - 94815 . 96806) (\NOFILESINFOFN 96808 . 97122)) (97243 99151 (\FILE.NOT.OPEN 97253 . 97766) ( -\FILE.WONT.OPEN 97768 . 98096) (\ILLEGAL.DEVICEOP 98098 . 98380) (\IS.NOT.RANDACCESSP 98382 . 98828) ( -\STREAM.NOT.OPEN 98830 . 99149)) (99286 101584 (\FDEVINSTANCE 99296 . 101582)) (102786 110160 (CNDIR -102796 . 104101) (DIRECTORYNAME 104103 . 108286) (DIRECTORYNAMEP 108288 . 108904) (HOSTNAMEP 108906 . -109713) (\ADD.CONNECTED.DIR 109715 . 110158)) (110205 138478 (\BACKFILEPTR 110215 . 110403) ( -\BACKPEEKBIN 110405 . 110766) (\BACKBIN 110768 . 111119) (BIN 111121 . 111338) (\BIN 111340 . 111617) -(\BINS 111619 . 111905) (BOUT 111907 . 112269) (\BOUT 112271 . 112586) (\BOUTS 112588 . 112899) ( -COPYBYTES 112901 . 116233) (COPYCHARS 116235 . 119901) (COPYFILE 119903 . 120967) (\COPYOPENFILE -120969 . 124168) (\INFER.FILE.TYPE 124170 . 125124) (EOFP 125126 . 125423) (FORCEOUTPUT 125425 . -125672) (\FLUSH.OPEN.STREAMS 125674 . 126030) (CHARSET 126032 . 127696) (ACCESS-CHARSET 127698 . -127915) (GETEOFPTR 127917 . 128167) (GETFILEINFO 128169 . 131362) (\TYPE.FROM.FILETYPE 131364 . 131834 -) (\FILETYPE.FROM.TYPE 131836 . 132015) (GETFILEPTR 132017 . 132269) (SETFILEINFO 132271 . 136377) ( -SETFILEPTR 136379 . 138098) (BOUT16 138100 . 138285) (BIN16 138287 . 138476)) (138581 143897 ( -\GENERIC.BINS 138591 . 138871) (\GENERIC.BOUTS 138873 . 139138) (\GENERIC.RENAMEFILE 139140 . 140971) -(\GENERIC.OPENP 140973 . 142288) (\GENERIC.READP 142290 . 143442) (\GENERIC.CHARSET 143444 . 143895)) -(143898 144237 (\MAP-OPEN-STREAMS 143908 . 144235)) (146029 148109 (\EOF.ACTION 146039 . 146290) ( -\EOSERROR 146292 . 146485) (\GETEOFPTR 146487 . 146669) (\INCFILEPTR 146671 . 147021) (\PEEKBIN 147023 - . 147214) (\SETCLOSEDFILELENGTH 147216 . 147550) (\SETEOFPTR 147552 . 147740) (\SETFILEPTR 147742 . -148107)) (148110 148652 (\FIXPOUT 148120 . 148420) (\FIXPIN 148422 . 148650)) (148653 149219 (\BOUTEOL - 148663 . 149217)) (152115 161979 (\BUFFERED.BIN 152125 . 152977) (\BUFFERED.PEEKBIN 152979 . 153761) -(\BUFFERED.BOUT 153763 . 154623) (\BUFFERED.BINS 154625 . 158310) (\BUFFERED.BOUTS 158312 . 160113) ( -\BUFFERED.COPYBYTES 160115 . 161977))))) + (FILEMAP (NIL (27732 31848 (STREAMPROP 27742 . 28176) (GETSTREAMPROP 28178 . 28927) (PUTSTREAMPROP +28929 . 31696) (STREAMP 31698 . 31846)) (31891 35270 (\DEFPRINT.BY.NAME 31901 . 33053) ( +\STREAM.DEFPRINT 33055 . 34963) (\FDEV.DEFPRINT 34965 . 35268)) (35528 40569 (\GETACCESS 35538 . 35992 +) (\SETACCESS 35994 . 40567)) (60795 66764 (\DEFINEDEVICE 60805 . 63121) (\GETDEVICEFROMNAME 63123 . +63596) (\GETDEVICEFROMHOSTNAME 63598 . 64642) (\REMOVEDEVICE 64644 . 65767) (\REMOVEDEVICE.NAMES 65769 + . 66762)) (66804 92336 (\CLOSEFILE 66814 . 67639) (\DELETEFILE 67641 . 67935) (\DEVICEEVENT 67937 . +69707) (\GENERATEFILES 69709 . 70656) (\GENERATENEXTFILE 70658 . 71309) (\GENERATEFILEINFO 71311 . +71772) (\GETFILENAME 71774 . 72163) (\GENERIC.OUTFILEP 72165 . 72635) (\OPENFILE 72637 . 75215) ( +\DO.PARAMS.AT.OPEN 75217 . 77746) (\RENAMEFILE 77748 . 78172) (\REVALIDATEFILE 78174 . 80776) ( +\PAGED.REVALIDATEFILELST 80778 . 82336) (\PAGED.REVALIDATEFILES 82338 . 84057) (\PAGED.REVALIDATEFILE +84059 . 86342) (\BUFFERED.REVALIDATEFILE 86344 . 88630) (\BUFFERED.REVALIDATEFILELST 88632 . 89816) ( +\PRINT-REVALIDATION-RESULT 89818 . 90660) (\TRUNCATEFILE 90662 . 91053) (\FILE-CONFLICT 91055 . 92334) +) (92372 97035 (\GENERATENOFILES 92382 . 94478) (\NULLFILEGENERATOR 94480 . 94724) (\NOFILESNEXTFILEFN + 94726 . 96717) (\NOFILESINFOFN 96719 . 97033)) (97154 99062 (\FILE.NOT.OPEN 97164 . 97677) ( +\FILE.WONT.OPEN 97679 . 98007) (\ILLEGAL.DEVICEOP 98009 . 98291) (\IS.NOT.RANDACCESSP 98293 . 98739) ( +\STREAM.NOT.OPEN 98741 . 99060)) (99197 101495 (\FDEVINSTANCE 99207 . 101493)) (102697 110071 (CNDIR +102707 . 104012) (DIRECTORYNAME 104014 . 108197) (DIRECTORYNAMEP 108199 . 108815) (HOSTNAMEP 108817 . +109624) (\ADD.CONNECTED.DIR 109626 . 110069)) (110116 138395 (\BACKFILEPTR 110126 . 110314) ( +\BACKPEEKBIN 110316 . 110677) (\BACKBIN 110679 . 111030) (BIN 111032 . 111249) (\BIN 111251 . 111528) +(\BINS 111530 . 111816) (BOUT 111818 . 112180) (\BOUT 112182 . 112497) (\BOUTS 112499 . 112810) ( +COPYBYTES 112812 . 116144) (COPYCHARS 116146 . 119812) (COPYFILE 119814 . 120878) (\COPYOPENFILE +120880 . 124079) (\INFER.FILE.TYPE 124081 . 125035) (EOFP 125037 . 125334) (FORCEOUTPUT 125336 . +125583) (\FLUSH.OPEN.STREAMS 125585 . 125941) (CHARSET 125943 . 127302) (ACCESS-CHARSET 127304 . +127832) (GETEOFPTR 127834 . 128084) (GETFILEINFO 128086 . 131279) (\TYPE.FROM.FILETYPE 131281 . 131751 +) (\FILETYPE.FROM.TYPE 131753 . 131932) (GETFILEPTR 131934 . 132186) (SETFILEINFO 132188 . 136294) ( +SETFILEPTR 136296 . 138015) (BOUT16 138017 . 138202) (BIN16 138204 . 138393)) (138498 145152 ( +\GENERIC.BINS 138508 . 138788) (\GENERIC.BOUTS 138790 . 139055) (\GENERIC.RENAMEFILE 139057 . 140888) +(\GENERIC.OPENP 140890 . 142205) (\GENERIC.READP 142207 . 143359) (\GENERIC.CHARSET 143361 . 145150)) +(145153 145492 (\MAP-OPEN-STREAMS 145163 . 145490)) (147347 149427 (\EOF.ACTION 147357 . 147608) ( +\EOSERROR 147610 . 147803) (\GETEOFPTR 147805 . 147987) (\INCFILEPTR 147989 . 148339) (\PEEKBIN 148341 + . 148532) (\SETCLOSEDFILELENGTH 148534 . 148868) (\SETEOFPTR 148870 . 149058) (\SETFILEPTR 149060 . +149425)) (149428 149970 (\FIXPOUT 149438 . 149738) (\FIXPIN 149740 . 149968)) (149971 150537 (\BOUTEOL + 149981 . 150535)) (153433 163297 (\BUFFERED.BIN 153443 . 154295) (\BUFFERED.PEEKBIN 154297 . 155079) +(\BUFFERED.BOUT 155081 . 155941) (\BUFFERED.BINS 155943 . 159628) (\BUFFERED.BOUTS 159630 . 161431) ( +\BUFFERED.COPYBYTES 161433 . 163295))))) STOP diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM index 7740733908bd89ba27c9d0e7df527a4fc0be712e..64e52f7aa57407dd1bbc0aba737a4e4a0916913c 100644 GIT binary patch delta 753 zcmZvZ&2G~`5XbE#RBAwN5(*p;Ftr3qDmkj1xDGxbZ{jsJIB{e-fCg2X9+#Em1o08%6M0m8aTT4>qB?(FQ$e||Ij^=IVmugKQo3=~+! zZLs`2p94;iI8owq?;f!&KA(X&1LDyupOb{VBybEocnNW*KNMza)}j)xsgvsI0(b;%QYk zaLK~R!3v2wNzOA6?9mq|`8;q7IYAJD4SLo%4loA!7c>J>)xve%tl6wWDjZ-OqnPJ| z-}L1O&vnj3^u{y~idk{W$hsYZLGbC-g;RB!qN2ew_na~(Pf%p_;=@Br(v*yvUjKd9 z9~AwlHkE4ngZ`G6@cNw}YiNJlAE5otH#8Y$b$32f=>iw*xt9WFh5cWtKo!r@T5wOi z)_JocolhRo*bbRdIpmpXK@~VK4W*8Z8U__|`RZmc9j$44GqFHl56i0?o7#VqD=w{heaFzV~brJ9#2U`_nsHRm$ d4irv!@;nf!Dp3<)H~^BEX}|u!#VWcH{{utE&JF+o delta 755 zcmZ{h&5P4O7{=4E2wSAIek}O?8c>=;Lni6AnIO`k%{GCy3H@|Igl!w8TAPx#uqeyo zX+Z>C!k#?|9;HRlQx9IOBK`;J*;8TvfOTdoxZv(Ue#tQNJnxhDefg9B`h$PfIH#;8 z$ml^rkrfqWO;4tE741Gs$OwxN78K>*siNvhO-Hf-P2X*KkNcgj+Xi>D?+jP?(XxWgpo%OPnH>(gA>TYl3!cDm2`ramFJ-_ey8^ey*698ciG0=!5GfddC5S57!*-t{}lcM96!k1 diff --git a/sources/IMAGEIO b/sources/IMAGEIO index 05347d4e..77770c5a 100644 --- a/sources/IMAGEIO +++ b/sources/IMAGEIO @@ -1,16 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Oct-2021 19:09:48" {DSK}kaplan>Local>medley3.5>my-medley>sources>IMAGEIO.;7 80279 +(FILECREATED " 8-Dec-2023 21:42:20" {WMEDLEY}IMAGEIO.;8 79284 - changes to%: (FNS \NOIMAGE.DSPFONT) + :EDIT-BY rmk - previous date%: "25-Sep-2021 20:58:07" -{DSK}kaplan>Local>medley3.5>my-medley>sources>IMAGEIO.;5) + :CHANGES-TO (FNS \IMAGEIOINIT) + (RECORDS IMAGEOPS) + :PREVIOUS-DATE "30-Oct-2021 19:09:48" {WMEDLEY}IMAGEIO.;7) -(* ; " -Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT IMAGEIOCOMS) @@ -701,9 +699,10 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation. (DEFINEQ (\IMAGEIOINIT - [LAMBDA NIL (* rrb "17-Sep-86 15:09") - (DECLARE (GLOBALVARS \NOIMAGEOPS)) (* ; - "most of the functions are filled with NILL from the record declaration for IMAGEOPS") + [LAMBDA NIL (* ; "Edited 8-Dec-2023 21:38 by rmk") + (* rrb "17-Sep-86 15:09") + (DECLARE (GLOBALVARS \NOIMAGEOPS)) (* ; + "most of the functions are filled with NILL from the record declaration for IMAGEOPS") (SETQ \NOIMAGEOPS (create IMAGEOPS IMAGETYPE _ NIL IMXPOSITION _ [FUNCTION (LAMBDA (STREAM POS) @@ -719,8 +718,8 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation. (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE)) [COND - (N (\UNIMPIMAGEOP STREAM - 'DSPYPOSITION])] + (N (\UNIMPIMAGEOP STREAM 'DSPYPOSITION]) + ] IMFONT _ (FUNCTION \NOIMAGE.DSPFONT) IMLEFTMARGIN _ (FUNCTION ZERO) IMRIGHTMARGIN _ [FUNCTION (LAMBDA (STREAM N) @@ -739,18 +738,6 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation. IMSTRINGWIDTH _ [FUNCTION (LAMBDA (STREAM STR RDTBL) (NCHARS STR RDTBL RDTBL] IMCHARWIDTH _ [FUNCTION (LAMBDA NIL 1] - IMCHARSET _ [FUNCTION (LAMBDA (STREAM CHARSET) - - (* ;; "If we had another illegal character set value, then we could simply fix it so that the character set didn't match anything, which would cause the character set shift to be put out on the next character") - - (COND - ((\IOMODEP STREAM 'OUTPUT T) - (\BOUT STREAM NSCHARSETSHIFT) - (COND - ((EQ CHARSET T) - (\BOUT STREAM NSCHARSETSHIFT) - (\BOUT STREAM 0)) - (T (\BOUT STREAM CHARSET] IMDRAWPOLYGON _ (FUNCTION NILL) IMDRAWPOINT _ (FUNCTION NILL]) @@ -948,8 +935,9 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation. IMNEWPAGE IMMOVETO IMSCALE IMTERPRI IMTOPMARGIN IMBOTTOMMARGIN IMSPACEFACTOR IMFONTCREATE IMOPERATION IMCOLOR IMSTRINGWIDTH IMCHARWIDTH IMCHARWIDTHY IMBACKCOLOR IMBITMAPSIZE IMCLIPPINGREGION IMRESET IMDRAWPOLYGON IMFILLPOLYGON IMSCALEDBITBLT - IMWRITEPIXEL IMCHARSET IMROTATE IMDRAWARC IMTRANSLATE IMSCALE2 IMPUSHSTATE - IMPOPSTATE IMDEFAULTSTATE IMDRAWPOINT IMBLTCHAR IMXOFFSET IMYOFFSET) + IMWRITEPIXEL (NIL POINTER (* ; "Was IMCHARSET")) + IMROTATE IMDRAWARC IMTRANSLATE IMSCALE2 IMPUSHSTATE IMPOPSTATE IMDEFAULTSTATE + IMDRAWPOINT IMBLTCHAR IMXOFFSET IMYOFFSET) IMCLOSEFN _ (FUNCTION NILL) IMTERPRI _ [FUNCTION (LAMBDA (STREAM) (\OUTCHAR STREAM (CHARCODE EOL] @@ -980,7 +968,6 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation. (BITMAPHEIGHT BITMAP)))) (\ILLEGAL.ARG DIMENSION] IMWRITEPIXEL _ (FUNCTION NILL) - IMCHARSET _ (FUNCTION NILL) IMXPOSITION _ (FUNCTION NILL) IMYPOSITION _ (FUNCTION NILL) IMFONT _ (FUNCTION NILL) @@ -1143,8 +1130,9 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation. IMNEWPAGE IMMOVETO IMSCALE IMTERPRI IMTOPMARGIN IMBOTTOMMARGIN IMSPACEFACTOR IMFONTCREATE IMOPERATION IMCOLOR IMSTRINGWIDTH IMCHARWIDTH IMCHARWIDTHY IMBACKCOLOR IMBITMAPSIZE IMCLIPPINGREGION IMRESET IMDRAWPOLYGON IMFILLPOLYGON IMSCALEDBITBLT - IMWRITEPIXEL IMCHARSET IMROTATE IMDRAWARC IMTRANSLATE IMSCALE2 IMPUSHSTATE - IMPOPSTATE IMDEFAULTSTATE IMDRAWPOINT IMBLTCHAR IMXOFFSET IMYOFFSET)) + IMWRITEPIXEL (NIL POINTER (* ; "Was IMCHARSET")) + IMROTATE IMDRAWARC IMTRANSLATE IMSCALE2 IMPUSHSTATE IMPOPSTATE IMDEFAULTSTATE + IMDRAWPOINT IMBLTCHAR IMXOFFSET IMYOFFSET)) ) (DECLARE%: DONTEVAL@LOAD DOCOPY @@ -1516,27 +1504,25 @@ Copyright (c) 1983-1991, 1993-1994, 1999, 2021 by Venue & Xerox Corporation. (ADDTOVAR LAMA IMAGESTREAMP) ) -(PUTPROPS IMAGEIO COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 -1993 1994 1999 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3343 12100 (IMAGESTREAMP 3353 . 4185) (IMAGESTREAMTYPE 4187 . 4400) (IMAGESTREAMTYPEP -4402 . 5037) (OPENIMAGESTREAM 5039 . 9993) (\GOOD.DASHLST 9995 . 12098)) (12135 14432 (DRAWDASHEDLINE -12145 . 14430)) (14433 21773 (DSPBACKCOLOR 14443 . 14815) (DSPBOTTOMMARGIN 14817 . 15202) (DSPCOLOR -15204 . 15568) (DSPCLIPPINGREGION 15570 . 16275) (DSPRESET 16277 . 16557) (DSPFONT 16559 . 16923) ( -DSPLEFTMARGIN 16925 . 17306) (DSPLINEFEED 17308 . 17608) (DSPOPERATION 17610 . 17987) (DSPRIGHTMARGIN -17989 . 18372) (DSPTOPMARGIN 18374 . 18753) (DSPSCALE 18755 . 19122) (DSPSPACEFACTOR 19124 . 19517) ( -DSPXPOSITION 19519 . 19824) (DSPYPOSITION 19826 . 20131) (DSPROTATE 20133 . 20428) (DSPPUSHSTATE 20430 - . 20676) (DSPPOPSTATE 20678 . 20921) (DSPDEFAULTSTATE 20923 . 21175) (DSPSCALE2 21177 . 21468) ( -DSPTRANSLATE 21470 . 21771)) (21774 30575 (DSPNEWPAGE 21784 . 22476) (DRAWBETWEEN 22478 . 23180) ( -DRAWCIRCLE 23182 . 23678) (DRAWARC 23680 . 24197) (DRAWCURVE 24199 . 24876) (DRAWELLIPSE 24878 . 25664 -) (DRAWLINE 25666 . 26056) (DRAWPOLYGON 26058 . 26513) (DRAWPOINT 26515 . 26934) (FILLPOLYGON 26936 . -27502) (DRAWTO 27504 . 27922) (FILLCIRCLE 27924 . 28147) (MOVETO 28149 . 28513) (RELDRAWTO 28515 . -29432) (BITMAPIMAGESIZE 29434 . 29605) (SCALEDBITBLT 29607 . 30573)) (30576 37615 (\DRAWPOINT.GENERIC -30586 . 30933) (\DRAWPOLYGON.GENERIC 30935 . 33243) (\DRAWCIRCLE.GENERIC 33245 . 34903) ( -\DRAWELLIPSE.GENERIC 34905 . 37613)) (37616 43413 (\IMAGEIOINIT 37626 . 41759) (\NOIMAGE.DSPFONT 41761 - . 43247) (\UNIMPIMAGEOP 43249 . 43411)) (43536 46660 (INSURE.BRUSH 43546 . 44920) (BRUSHP 44922 . -45712) (\POSSIBLECOLOR 45714 . 46265) (NEGSHADE 46267 . 46658)) (47216 47900 (DASHINGP 47226 . 47556) -(INSURE.DASHING 47558 . 47898)) (58546 79092 (\DisplayEventFn 58556 . 59066) (\DISPLAYINIT 59068 . -64651) (\4DISPLAYINIT 64653 . 69354) (\8DISPLAYINIT 69356 . 74059) (\24DISPLAYINIT 74061 . 78833) ( -\DISPLAYSTREAMTYPEBPP 78835 . 79090))))) + (FILEMAP (NIL (3234 11991 (IMAGESTREAMP 3244 . 4076) (IMAGESTREAMTYPE 4078 . 4291) (IMAGESTREAMTYPEP +4293 . 4928) (OPENIMAGESTREAM 4930 . 9884) (\GOOD.DASHLST 9886 . 11989)) (12026 14323 (DRAWDASHEDLINE +12036 . 14321)) (14324 21664 (DSPBACKCOLOR 14334 . 14706) (DSPBOTTOMMARGIN 14708 . 15093) (DSPCOLOR +15095 . 15459) (DSPCLIPPINGREGION 15461 . 16166) (DSPRESET 16168 . 16448) (DSPFONT 16450 . 16814) ( +DSPLEFTMARGIN 16816 . 17197) (DSPLINEFEED 17199 . 17499) (DSPOPERATION 17501 . 17878) (DSPRIGHTMARGIN +17880 . 18263) (DSPTOPMARGIN 18265 . 18644) (DSPSCALE 18646 . 19013) (DSPSPACEFACTOR 19015 . 19408) ( +DSPXPOSITION 19410 . 19715) (DSPYPOSITION 19717 . 20022) (DSPROTATE 20024 . 20319) (DSPPUSHSTATE 20321 + . 20567) (DSPPOPSTATE 20569 . 20812) (DSPDEFAULTSTATE 20814 . 21066) (DSPSCALE2 21068 . 21359) ( +DSPTRANSLATE 21361 . 21662)) (21665 30466 (DSPNEWPAGE 21675 . 22367) (DRAWBETWEEN 22369 . 23071) ( +DRAWCIRCLE 23073 . 23569) (DRAWARC 23571 . 24088) (DRAWCURVE 24090 . 24767) (DRAWELLIPSE 24769 . 25555 +) (DRAWLINE 25557 . 25947) (DRAWPOLYGON 25949 . 26404) (DRAWPOINT 26406 . 26825) (FILLPOLYGON 26827 . +27393) (DRAWTO 27395 . 27813) (FILLCIRCLE 27815 . 28038) (MOVETO 28040 . 28404) (RELDRAWTO 28406 . +29323) (BITMAPIMAGESIZE 29325 . 29496) (SCALEDBITBLT 29498 . 30464)) (30467 37506 (\DRAWPOINT.GENERIC +30477 . 30824) (\DRAWPOLYGON.GENERIC 30826 . 33134) (\DRAWCIRCLE.GENERIC 33136 . 34794) ( +\DRAWELLIPSE.GENERIC 34796 . 37504)) (37507 42451 (\IMAGEIOINIT 37517 . 40797) (\NOIMAGE.DSPFONT 40799 + . 42285) (\UNIMPIMAGEOP 42287 . 42449)) (42574 45698 (INSURE.BRUSH 42584 . 43958) (BRUSHP 43960 . +44750) (\POSSIBLECOLOR 44752 . 45303) (NEGSHADE 45305 . 45696)) (46254 46938 (DASHINGP 46264 . 46594) +(INSURE.DASHING 46596 . 46936)) (57676 78222 (\DisplayEventFn 57686 . 58196) (\DISPLAYINIT 58198 . +63781) (\4DISPLAYINIT 63783 . 68484) (\8DISPLAYINIT 68486 . 73189) (\24DISPLAYINIT 73191 . 77963) ( +\DISPLAYSTREAMTYPEBPP 77965 . 78220))))) STOP diff --git a/sources/IMAGEIO.LCOM b/sources/IMAGEIO.LCOM index af9055d94ce31fceee27ff98fbc146ba4735737f..8a1433603849ad4c2c9ab035745b127408cc931d 100644 GIT binary patch delta 650 zcmaKpzi-n(6vyR=$wPri2tfsUG9Wn!TRz*dFP93*iO=l`$ByhPAyt=n;`jtf z%EM{#7c+i5+J98cZV}jAw6cV8INFx@Xg!XhiZD%6gRRjsIsQy`Q){St#A4dbXuxSG z9iF+y|7?Tbvax#y2n`uGIzyQ5?EvYn1<5MS4W5D?B{`^7x8m!IOG~7m(fcf2&y7%y z78jK(%l{6?FMlY9sOI4ET1QhZR5lMR%k_ly#24?;(z4qE5@J>F1A@Rp*o8h=rH6scj8lC7dQM3;qja0Ti;YJBXA_4YV`!)5?}Cj#S=gAJq3%k)9xAdaU-uWt;(PCuL)Cq+a2hUqP14N4zs@#d7kH>6HLgd|0_`B@@%eV z)y+!NEc<2^I1v?`_JqP?z?zOUT~b%Dt#KHSji3W;fa;`o*I&PTN1AeFOQ_BEL0;DsCPOU~A#Pq6*oTJr@Af=@-mX`r4{(FXi z=DK!KU$+{+pQ6!peA1b~CYP_wM7jWmo%kaplan>Local>medley3.5>working-medley>sources>XCCS.;54 13309 +(FILECREATED " 9-Dec-2023 11:42:55" {WMEDLEY}XCCS.;66 14365 - :CHANGES-TO (FNS \XCCSBACKCCODE) + :EDIT-BY rmk - :PREVIOUS-DATE "19-Jul-2022 14:56:54" -{DSK}kaplan>Local>medley3.5>working-medley>sources>XCCS.;53) + :CHANGES-TO (FNS \XCCSCHARSETFN) + + :PREVIOUS-DATE " 8-Dec-2023 15:34:50" {WMEDLEY}XCCS.;65) (PRETTYCOMPRINT XCCSCOMS) (RPAQQ XCCSCOMS - [(FNS ACCESS-CHARSET) - (FNS \XCCSINCCODE \XCCSPEEKCCODE \XCCSOUTCHAR \XCCSBACKCCODE \XCCSFORMATBYTESTREAM) + [(FNS \XCCSINCCODE \XCCSPEEKCCODE \XCCSOUTCHAR \XCCSBACKCCODE \XCCSFORMATBYTESTREAM + \XCCSCHARSETFN) (FNS \CREATE.XCCS.EXTERNALFORMAT) (FNS \NSIN.24BITENCODING.ERROR) (INITVARS (*SIGNAL-24BIT-NSENCODING-ERROR*)) (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS (\NORUNCODE 255) (NSCHARSETSHIFT 255)) - (MACROS \RUNCODED) - (OPTIMIZERS ACCESS-CHARSET))) + (MACROS \RUNCODED))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\CREATE.XCCS.EXTERNALFORMAT]) (DEFINEQ -(ACCESS-CHARSET - [LAMBDA (STREAM NEWVALUE) (* ; "Edited 11-Sep-87 15:46 by bvm:") - (FDEVOP 'CHARSETFN (fetch (STREAM DEVICE) of STREAM) - STREAM NEWVALUE]) -) -(DEFINEQ - (\XCCSINCCODE - [LAMBDA (STREAM COUNTP) (* ; "Edited 6-Aug-2021 15:57 by rmk:") + [LAMBDA (STREAM COUNTP) (* ; "Edited 8-Dec-2023 15:28 by rmk") + (* ; "Edited 6-Aug-2021 15:57 by rmk:") -(* ;;; "Returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8.") +(* ;;; "Returns a 16 bit character code. SHIFTEDCSET is STREAM's char set left shifted 8.") -(* ;;; -"If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of bytes read.") +(* ;;; "If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to the number of bytes read.") -(* ;;; "This doesn't do EOL conversion, \INCHAR does that") +(* ;;; "This doesn't do EOL conversion, \INCHAR does that") (DECLARE (USEDFREE *BYTECOUNTER*)) - (LET (NUMBYTES (CSET (ACCESS-CHARSET STREAM)) - (CHAR (\BIN STREAM))) (* ; - "Error on EOF unless ENDOFSTREAMOP does something else.") + (\DTEST STREAM 'STREAM) + (LET (NUMBYTES (CSET (ffetch (STREAM CHARSET) of STREAM)) + (CHAR (\BIN STREAM))) (* ; + "Error on EOF unless ENDOFSTREAMOP does something else.") - (* ;; " NUMBYTES tracks the number of \BINs. ") + (* ;; " NUMBYTES tracks the number of \BINs. ") (IF (EQ CHAR NSCHARSETSHIFT) - THEN (* ; - "Shifting character sets, toss CHAR") - (SETQ CSET (\BIN STREAM)) - (IF (NEQ NSCHARSETSHIFT CSET) - THEN (* ; - "Shift to new runcode CSET: SH CS CH") - (ACCESS-CHARSET STREAM CSET) - (SETQ CHAR (\BIN STREAM)) - (SETQ NUMBYTES 3) - ELSEIF (EQ 0 (\BIN STREAM)) - THEN (* ; "SH SH CSH CS CH where CSH is 0") + THEN (* ; + "Shifting character sets, toss CHAR") + (SETQ CSET (\BIN STREAM)) + (IF (NEQ NSCHARSETSHIFT CSET) + THEN (* ; + "Shift to new runcode CSET: SH CS CH") + (SETQ CHAR (\BIN STREAM)) + (SETQ NUMBYTES 3) + (freplace (STREAM CHARSET) of STREAM with CSET) + ELSEIF (EQ 0 (\BIN STREAM)) + THEN (* ; "SH SH CSH CS CH where CSH is 0") - (* ;; - "The high-order character set byte must be 0, because we don't support obese characters (24 bit)") + (* ;; + "The high-order character set byte must be 0, because we don't support obese characters (24 bit)") - (SETQ CSET (\BIN STREAM)) - (SETQ CHAR (\BIN STREAM)) (* ; "To align with below") - (SETQ NUMBYTES 5) - (ACCESS-CHARSET STREAM \NORUNCODE) - ELSE (\NSIN.24BITENCODING.ERROR STREAM)) + (SETQ CSET (\BIN STREAM)) + (SETQ CHAR (\BIN STREAM)) (* ; "To align with below") + (SETQ NUMBYTES 5) + (freplace (STREAM CHARSET) of STREAM with \NORUNCODE) + ELSE (\NSIN.24BITENCODING.ERROR STREAM)) - (* ;; "The stream now knows the new character set, runcoded or not.") + (* ;; "The stream now knows the new character set, runcoded or not.") ELSEIF (EQ CSET \NORUNCODE) - THEN (* ; "2-bytes") - (SETQ CSET CHAR) - (SETQ CHAR (\BIN STREAM)) - (SETQ NUMBYTES 2) + THEN (* ; "2-bytes") + (SETQ CSET CHAR) + (SETQ CHAR (\BIN STREAM)) + (SETQ NUMBYTES 2) ELSE + (* ;; "Runcoded CSET and CHAR") - (* ;; "Runcoded CSET and CHAR") - - (SETQ NUMBYTES 1)) + (SETQ NUMBYTES 1)) (CL:WHEN COUNTP (SETQ *BYTECOUNTER* NUMBYTES)) - (CL:WHEN CHAR (* ; - "Typically NIL if ENDOFSTREAMOP returned NIL at EOF ") + (CL:WHEN CHAR (* ; + "Typically NIL if ENDOFSTREAMOP returned NIL at EOF ") (LOGOR (UNFOLD CSET 256) CHAR))]) (\XCCSPEEKCCODE - [LAMBDA (STREAM NOERROR) (* ; "Edited 21-Jun-2021 23:44 by rmk:") + [LAMBDA (STREAM NOERROR) (* ; "Edited 8-Dec-2023 15:32 by rmk") + (* ; "Edited 21-Jun-2021 23:44 by rmk:") - (* ;; - "Modeled on \XCCSINCCODE, but peeks at the last byte in the sequence, leaves the stream unchanged") + (* ;; + "Modeled on \XCCSINCCODE, but peeks at the last byte in the sequence, leaves the stream unchanged") - (LET ((CSET (ACCESS-CHARSET STREAM)) + (\DTEST STREAM 'STREAM) + (LET ((CSET (ffetch (STREAM CHARSET) of STREAM)) (CHAR (\PEEKBIN STREAM NOERROR))) - (* ;; - "Returns a 16 bit character code. Doesn't do EOL conversion--\PEEKCCODE does that. ") + (* ;; "Returns a 16 bit character code. Doesn't do EOL conversion--\PEEKCCODE does that. ") - (* ;; "We don't change the charset in the stream, put the file ptr back the way it was.") + (* ;; "We don't change the charset in the stream, put the file ptr back the way it was.") (CL:WHEN CHAR (IF (EQ CHAR NSCHARSETSHIFT) - THEN (\BIN STREAM) (* ; "Read the peeked shifting byte") - (SETQ CSET (\BIN STREAM)) (* ; "Consume the char shift byte") - (IF (NEQ CSET NSCHARSETSHIFT) - THEN + THEN (\BIN STREAM) (* ; "Read the peeked shifting byte") + (SETQ CSET (\BIN STREAM)) (* ; "Consume the char shift byte") + (IF (NEQ CSET NSCHARSETSHIFT) + THEN + (* ;; + "Shift to new runcode CSET: SH CS CH. We have to BIN what we peeked, BIN, and peek again") - (* ;; - "Shift to new runcode CSET: SH CS CH. We have to BIN what we peeked, BIN, and peek again") + (SETQ CHAR (\PEEKBIN STREAM NOERROR)) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + ELSEIF (EQ 0 (\BIN STREAM)) + THEN (* ; "SH SH CSH CS CH where CSH is 0") - (SETQ CHAR (\PEEKBIN STREAM NOERROR)) - (\BACKFILEPTR STREAM) - (\BACKFILEPTR STREAM) - ELSEIF (EQ 0 (\BIN STREAM)) - THEN (* ; "SH SH CSH CS CH where CSH is 0") + (* ;; + "Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error") - (* ;; - "Note: no eof error check on this \BIN -- an eof in the middle of a charset shift is an error") - - (SETQ CSET (\BIN STREAM)) - (SETQ CHAR (\PEEKBIN STREAM NOERROR)) - (\BACKFILEPTR STREAM) - (\BACKFILEPTR STREAM) - (\BACKFILEPTR STREAM) - (\BACKFILEPTR STREAM) - ELSE (\NSIN.24BITENCODING.ERROR STREAM)) + (SETQ CSET (\BIN STREAM)) + (SETQ CHAR (\PEEKBIN STREAM NOERROR)) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + ELSE (\NSIN.24BITENCODING.ERROR STREAM)) ELSEIF (EQ CSET \NORUNCODE) - THEN (* ; "2 byte runs, BIN/PEEK/BACK") - (SETQ CSET CHAR) - (\BIN STREAM) - (SETQ CHAR (\PEEKBIN STREAM NOERROR)) (* ; "One BACKFILEPTR seems OK") - (\BACKFILEPTR STREAM)) + THEN (* ; "2 byte runs, BIN/PEEK/BACK") + (SETQ CSET CHAR) + (\BIN STREAM) + (SETQ CHAR (\PEEKBIN STREAM NOERROR)) (* ; "One BACKFILEPTR seems OK") + (\BACKFILEPTR STREAM)) - (* ;; "No need to back up for the runcoded case") + (* ;; "No need to back up for the runcoded case") (CL:WHEN CHAR (LOGOR (UNFOLD CSET 256) @@ -179,12 +172,13 @@ (\BOUT STREAM (\CHAR8CODE CHARCODE]) (\XCCSBACKCCODE - [LAMBDA (STREAM COUNTP) (* ; "Edited 19-Jul-2022 17:12 by rmk") + [LAMBDA (STREAM COUNTP) (* ; "Edited 8-Dec-2023 15:34 by rmk") + (* ; "Edited 19-Jul-2022 17:12 by rmk") (* ; "Edited 13-Aug-2021 14:08 by rmk:") (DECLARE (USEDFREE *BYTECOUNTER*)) (LET ((BYTE (AND (\BACKFILEPTR STREAM) (\PEEKBIN STREAM))) - (CSET (ACCESS-CHARSET STREAM))) + (CSET (fetch (STREAM CHARSET) of STREAM))) (CL:WHEN BYTE (* ;; "The immediately preceding byte must be a character byte. If it is a byte in a runcode, then we are done, even if the byte before is part of a shift sequence.") @@ -209,24 +203,44 @@ [LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 16:47 by rmk:") (REPLACE (STREAM CHARSET) OF BYTESTREAM WITH (FETCH (STREAM CHARSET) OF STREAM]) + +(\XCCSCHARSETFN + [LAMBDA (STREAM CHARSET DONTMARKSTREAM) (* ; "Edited 9-Dec-2023 11:18 by rmk") + + (* ;; "This differs from \GENERIC.CHARSET in that it actually writes the shifting bytes into an output stream, unless DONTMARKSTREAM. It will do write the shifts, even if it just replicates the situation that is already there (presumably CHARSET = the old CHARSET). The client should test and avoid calling if useless shifts are not desired.") + + (LET [(CSET (ffetch (STREAM CHARSET) of (\DTEST STREAM 'STREAM] + (CL:WHEN CHARSET + (CL:WHEN (EQ CHARSET T) + (SETQ CHARSET \NORUNCODE)) + (CL:UNLESS (EQ CHARSET CSET) + (freplace (STREAM CHARSET) of STREAM with CHARSET) + (CL:UNLESS DONTMARKSTREAM + (CL:WHEN (\IOMODEP STREAM 'OUTPUT T) + (\BOUT STREAM NSCHARSETSHIFT) + (if (EQ CHARSET \NORUNCODE) + then (\BOUT STREAM \NORUNCODE) + (\BOUT STREAM 0) + else (\BOUT STREAM CHARSET)))))) + CSET]) ) (DEFINEQ (\CREATE.XCCS.EXTERNALFORMAT - [LAMBDA (NAME EOL) (* ; "Edited 30-Jun-2022 18:08 by rmk") + [LAMBDA (NAME EOL) (* ; "Edited 7-Dec-2023 23:03 by rmk") + (* ; "Edited 30-Jun-2022 18:08 by rmk") (* ; "Edited 10-Sep-2021 19:49 by rmk:") (* ;;; "Create the :XCCS external format. Stream's EOL overrides the (vacuous) default here") - (CL:UNLESS NAME (SETQ NAME :XCCS)) - (CL:UNLESS EOL - (SETQ EOL 'LF)) - (MAKE-EXTERNALFORMAT NAME (FUNCTION \XCCSINCCODE) + (MAKE-EXTERNALFORMAT (OR NAME :XCCS) + (FUNCTION \XCCSINCCODE) (FUNCTION \XCCSPEEKCCODE) (FUNCTION \XCCSBACKCCODE) (FUNCTION \XCCSOUTCHAR) (FUNCTION \XCCSFORMATBYTESTREAM) - EOL T NIL]) + (OR EOL 'LF) + T NIL NIL (FUNCTION \XCCSCHARSETFN]) ) (DEFINEQ @@ -267,13 +281,6 @@ \NORUNCODE))) ) -(DEFOPTIMIZER ACCESS-CHARSET (STREAM &OPTIONAL NEWVALUE) - `((OPENLAMBDA (STRM) - (FDEVOP 'CHARSETFN (fetch (STREAM DEVICE) of STRM) - STRM - ,NEWVALUE)) - ,STREAM)) - (* "END EXPORTED DEFINITIONS") ) @@ -282,8 +289,8 @@ (\CREATE.XCCS.EXTERNALFORMAT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1023 1252 (ACCESS-CHARSET 1033 . 1250)) (1253 10546 (\XCCSINCCODE 1263 . 4035) ( -\XCCSPEEKCCODE 4037 . 6573) (\XCCSOUTCHAR 6575 . 8795) (\XCCSBACKCCODE 8797 . 10217) ( -\XCCSFORMATBYTESTREAM 10219 . 10544)) (10547 11222 (\CREATE.XCCS.EXTERNALFORMAT 10557 . 11220)) (11223 - 12054 (\NSIN.24BITENCODING.ERROR 11233 . 12052))))) + (FILEMAP (NIL (886 11846 (\XCCSINCCODE 896 . 3875) (\XCCSPEEKCCODE 3877 . 6546) (\XCCSOUTCHAR 6548 . +8768) (\XCCSBACKCCODE 8770 . 10314) (\XCCSFORMATBYTESTREAM 10316 . 10641) (\XCCSCHARSETFN 10643 . +11844)) (11847 12620 (\CREATE.XCCS.EXTERNALFORMAT 11857 . 12618)) (12621 13452 ( +\NSIN.24BITENCODING.ERROR 12631 . 13450))))) STOP diff --git a/sources/XCCS.LCOM b/sources/XCCS.LCOM index 69739bf85d7cdd3b4ad85712dffafecaa7a53bad..697a264a84b6f05eb71c99bbdcb1ba6e7a6afbe6 100644 GIT binary patch literal 2957 zcma)8O>7%Q6yCTY1*1x)6#^=#o(xFqN;ck&?Kq}_9ec;|koE3%cT*CSOJj%DsS{U8 zdqPOuDskWdm5{h|Ln3lgiT2_vLP8*Mk-}_Nb zUKcjc)`i8h!mc}T$z`=gw!k4R?0|cg@ZB_A@;EaCR<({SSDDX2%V&~Fl{C~)EZ`=j zVLofFx3YR(p9M{;6!c25mTTZcbl2O^+d`qwK5lZ;;wztD+3DTgZmsWpuw1M8 zx%W$@4DOc4Ds;V~Yn8m7PQu#u`bbIZ=Jl-`>pSmOV3iKm8qD)~P`9Cj+UrY}1&5X7 za=A3LuiwGjpQXH%&ipSYPBt2}!fdGs6>f?kTU~+e&0A1GqwEFlX9EY+y6r=9($ox8 zT#sK9&XS)s5xYs#v|?qpP$}k5fvT7ZH43{{b4(5uvz%02(7|46R#yVE0?EzQHK?F&1n7pfxQHo7D1g&g-h$HS*7Mt0&ba@pm4al+|m`Dr^+ z!68S{tuGUba@Z}FBnw|jOo?`Xo7`J8U=VuvqY-XC487PjrIT-ylM@?*a6kI&z7>hT zNnZC~Bew_9ft6Tv?7F7U!D;Gmk^Y{LX5Dkc{uN{6*O`z?$RtGNYh(8! zk!oYO_Xbi$KEc3fZy;v|8_`TMCl#K$6@Gr6`TdVcMg3O|_Cy{qSoh#BIZCl7qh9Ldo{84#D)k*{h`URQkWi$mWMJ`3=iIJ-xi(D^3kt^}re=+=yz$X~?i!zSi3Ag$e z*!|6aThkFWA2*(+*#6nggVyxT6z<@6AZSrh$(Y^<3|-K#TFJ`q{Rpy2Y6f}qC7du zh&q^#9Wn-A7T180_vU>O7(;8C8x4b1}zC1UzxEhy&p?G4ZPeFv8db33b7B%1-VKbrpUEflOxdcXmG-Ka8}xX;vb6yIyc)= z=A3ktSW7!qrLi97;j%9l5Ui{$Nm<*Et5Q}L6{?UaWlEWHzw6Np8#1YEp#Nw= zRJSB0p#*8YkX`HC0c-)*w_3e+XX^%R_3psV-P^Z&+t`#)`+==M5UkXkrt4wz1!Oc% z$Z*ePSFes1K$X3O1SWP;PR1BafF>tn#N_lC(#JZJ@Q#zolLda*YN^SYmV&)%nnfRs_l47)GKh%i`Wc- zYR8SB-w^dcuA=THt9gzOtC6so!E|!yLJEF)spT*eZw&8q(eBk#06-H8LR9m27$KT_-kG*yr_gvd(&UySole$t7{D=EI4j zq!mI4iCb?R011J_5pg6+bD6%1lYgmvZ?e$jN4BXK%CJT8GXqBtiP5;xB%BqjAvMKbYHI-D|Jz z&RL!2YI|;{wcc)hoX==;A9eP(H+S!(#md}4=iYv^buf3!F#ODWnwlE9E31~2*(9v( zx1!4=Xl|_T-f11YQ-T$Cu#6rWhEt)iiDpzAmIY@G&SWx4SYN%1W)3@o%F&V3zw-9K zJ12pX&u5EJG8TwEPyKY@fLyixAum!;ay`0aIt@QvLHviTR!dr;q^bW0-1(G541@Z9 z8ZGjC8bGNsE6FZofn=4O0wyS6(+`%2)u1@Zf*)W?)Kd_%*etVx6p7JcHo||52{dr>+CS!qTY41_`9izXIi|$EWV_}^rgvK`}E{!MTcel zK1hyucTP9kaqHq`9UitP56e1iogBTZ!%u8}{^t?#^LqQV9j{-!e0W8Fg#q=siF&`T zaryXX+aGqxmy69;yS3vf^KtEIB8GseuwwhBoyn&PnqWI0^v*RA3NF?UybUa>LKiX$#F6z(~ zfc~h9&4&Vv!wSdmEr#E~Mpx{IpTjpp@i!QFN3S#Vy5WJ_k?0u&)f}uaK4A3a1|C)% zLdqO3n>HxQbMQspD-5137Ki3Tx@Wb%>cY&RY$4m<%PYMx3*y+Sa2f$ma~>U5dThpd zZJ_kNk7Ec(`@+f54Snm;l*qf^&fQ0RzR(Y^>Nwmwd2j`@j|ZcxuW$W+?tXVGobgml zh*R6*^UKs9e-0`-dQB%!_yMfw)4%vAL7p((Cl9Vgs`Yj9WI8^vU^4yYrD1tY=mLWb z{Q^bnjq<$_3y0XvMx*Eebu7>jU%ss(fNX&1&CW)7KGUm#LO=IMsiyxp^pjpthysiu zdR$T*%O&{{E?JvoT*8q&ep!4+%0H%yn!sW(k2Ov$Zwt|*%jBz_znfEG`aU+FCdlzi zJEzU5jRfxCw_9V2F?pt+Ijqu$GP{>m$gpR(5T;y63rYkHu7%uNb-X$WIJ0sx7o2Z_ zEbtHv-=})U^*rG?$@h{i3cDF`y%NP`Fa)B7$nf`_-oggNCYG>3+{@CO#hPWfP3jb{ zDU`;0e`Isxg2?Nbtf^2Zi!?oW8~U#zO3aQC09341wh`4| zJ{0VyPCk_AGiWZ9iC!|L02X_7N=%UedmNERjz_O4zE)Yd?wj)nO_~#b+V&&vPje1t z?^hx=5u0$o?J!t$UTRzX$$;>6;7=}Ekj$y+wavSLeMM`x*;&VK3wAqq;o#ohUS}V> zAlC0-gAoMFhEsPvYzu)IjT2_L=aQQ@dkY}*24%2INS*0gBL6vneRu}&Zs9_P0VjD@Z!_gTU_-a7Ku>-?#mqDhtT*nJQ zHXPdzh#jEb72EL|>|Lgi)3lTXvh9b>lfPhA1HOv7>%{OJ?Ce6}3NATrVAjps6wMpL oGc{lgyPq3mIivzo#SzB1c=>a{N#RdK@BJ4hlk{9o63e820Ltkb=l}o!