From bad19ab45fe4d249fbc9ddd3a8e0ebae6314735f Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 24 Jun 2023 15:48:21 -0700 Subject: [PATCH 01/37] PDFSTREAM: first implementation Makes PS file, then applies separate utility (if available) to convert PS to PDF --- library/PDFSTREAM | 228 +++++++++++++++++++++++++++++++++++++++++ library/PDFSTREAM.LCOM | Bin 0 -> 4918 bytes 2 files changed, 228 insertions(+) create mode 100644 library/PDFSTREAM create mode 100644 library/PDFSTREAM.LCOM diff --git a/library/PDFSTREAM b/library/PDFSTREAM new file mode 100644 index 00000000..24fdd70a --- /dev/null +++ b/library/PDFSTREAM @@ -0,0 +1,228 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "24-Jun-2023 15:27:04" {WMEDLEY}PDFSTREAM.;35 12465 + + :EDIT-BY rmk + + :PREVIOUS-DATE "24-Jun-2023 15:01:28" {WMEDLEY}PDFSTREAM.;34) + + +(PRETTYCOMPRINT PDFSTREAMCOMS) + +(RPAQQ PDFSTREAMCOMS + ([ADDVARS [PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION + TITLE] + [PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT] + (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC] + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES EXPORTS.ALL (LOADCOMP) + POSTSCRIPTSTREAM)) + (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + (INITVARS (PDFCONVERTER 'ps2pdf)) + (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) + (VARS (DEFAULTPRINTERTYPE 'PDF)) + (GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) + (FNS PDF-INIT OPEN-PDF-STREAM CLOSE-PDF-STREAM PDF-CONVERT) + (P (PDF-INIT)))) + +(ADDTOVAR PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))) + +(ADDTOVAR PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT)))) + +(ADDTOVAR IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD EXPORTS.ALL (LOADCOMP) + POSTSCRIPTSTREAM) +) +(DEFINEQ + +(PDFFILEP + [LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk") + (* ; "Edited 5-Mar-93 21:40 by rmk:") + (* ; "Edited 14-Jan-93 10:56 by jds") + (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) + '("PDF") + :TEST + (FUNCTION STRING-EQUAL)) + (CL:WHEN (STREAMP FILE) + (SETFILEPTR FILE 0) + (PROG1 (AND (EQ (BIN FILE) + (CHARCODE %%)) + (EQ (BIN FILE) + (CHARCODE P)) + (EQ (BIN FILE) + (CHARCODE D)) + (EQ (BIN FILE) + (CHARCODE F))) + (SETFILEPTR FILE 0)))]) + +(PDF.HARDCOPYW + [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) (* ; "Edited 23-Jun-2023 13:28 by rmk") + (* ; "Edited 6-Mar-2023 22:43 by rmk") + (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY FILE))) + (PDF-CONVERT (POSTSCRIPT.HARDCOPYW PSTTMP FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + FILE]) + +(PDF.TEXT + [LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 23-Jun-2023 13:23 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION + ROTATION ,(NOT (NOT + POSTSCRIPT.TEXTFILE.LANDSCAPE + ]) + +(PDF.TEDIT + [LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (LET ((TSTREAM (OPENTEXTSTREAM FILE))) + (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF) + (CLOSEF TSTREAM]) +) + +(RPAQ? PDFCONVERTER 'ps2pdf) + +(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSTMPFILENAME " " PDFTMPFILENAME " 2> " ERRORFILE) + (pstopdf " " PSTMPFILENAME " -o " PDFTMPFILENAME " 2> " ERRORFILE)) + +(RPAQQ DEFAULTPRINTERTYPE PDF) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) +) +(DEFINEQ + +(PDF-INIT + [LAMBDA NIL (* ; "Edited 23-Jun-2023 11:23 by rmk") + + (* ;; "Seems OK to make callers see this as PDF, even though the implementation is postscript. The pdf stream is opened as a temporary postscript stream, and the closefn then uses an operating-system utility to convert it to the original target file-name.") + + (SETQ \PDFIMAGEOPS (create IMAGEOPS using \POSTSCRIPTIMAGEOPS IMAGETYPE _ 'PDF IMCLOSEFN _ + (FUNCTION CLOSE-PDF-STREAM]) + +(OPEN-PDF-STREAM + [LAMBDA (FILE OPTIONS) (* ; "Edited 24-Jun-2023 14:49 by rmk") + + (* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.") + + (* ;; "We have to stash the original filename someplace. We could put it in the tmp filename and then parse it out, but then we would have to worry about how unix filenames might parse against our {, }, etc. ") + + (* ;; + "Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.") + + (* ;; "") + + (if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST] + then + (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie that and give it a PDF extension so it thinks that we are heading to a PDF printer.") + + (OPENPOSTSCRIPTSTREAM FILE OPTIONS) + else (CL:UNLESS (OR (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER"))) + PDF-CONVERTER-TEMPLATES)) + (ERROR "POSTSCRIPT-to-PDF converter is not specified")) + (LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE) + "-" + (RAND) + ".ps") + OPTIONS))) + (replace (STREAM IMAGEOPS) of PSSTREAM with \PDFIMAGEOPS) + + (* ;; "Hopefully the postscript implementation functions won't notice that we did a shift to get the IMAGETYPE and IMCLOSEFN") + + (replace (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) + of PSSTREAM) with FILE) + PSSTREAM]) + +(CLOSE-PDF-STREAM + [LAMBDA (PSSTREAM) (* ; "Edited 24-Jun-2023 13:57 by rmk") + + (* ;; "PSSTREAM is a tmp/ postscript rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") + + (* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename") + + (* ;; "We have to back up to the ordinary POSTSCRIPT close, so that we don't loop through here") + + (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) + (PDF-CONVERT (CLOSEF PSSTREAM) + (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) of PSSTREAM]) + +(PDF-CONVERT + [LAMBDA (PSTMPFILENAME TARGETPDFNAME DONTDELETE) (* ; "Edited 24-Jun-2023 15:01 by rmk") + (* ; "Edited 16-Jul-2022 13:06 by rmk") + (* ; "Edited 8-Jul-2022 10:20 by rmk") + (* ; "Edited 7-May-2022 22:40 by rmk") + (* ; "Edited 7-Oct-2021 11:15 by rmk:") + + (* ;; "PSTMPFILENAME is the name of a closed PS file in a Unix tmp directory. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to TARGETPDFNAME. ") + + (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") + + (CL:UNLESS (INFILEP PSTMPFILENAME) + (ERROR "NO PS FILE TO CONVERT")) + (LET ((PDFTMPFILENAME (PACKFILENAME 'EXTENSION 'pdf 'BODY PSTMPFILENAME)) + (ERRORFILENAME (PACKFILENAME 'EXTENSION 'error 'BODY PSTMPFILENAME)) + COMPLETIONCODE) + + (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") + + (* ;; "We have to map the filenames down to Unix conventions: (not host, slashes, etc.") + + [SETQ COMPLETIONCODE (PROCESS-COMMAND + (CONCATLIST (SUBLIS `[(PSTMPFILENAME \, (SLASHIT (PACKFILENAME + 'HOST NIL + 'BODY PSTMPFILENAME) + )) + (PDFTMPFILENAME \, (SLASHIT (PACKFILENAME + 'HOST NIL + 'BODY + PDFTMPFILENAME))) + (ERRORFILENAME \, (SLASHIT (PACKFILENAME + 'HOST NIL + 'BODY ERRORFILENAME] + (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV + "MEDLEY-PDFCONVERTER" + ))) + PDF-CONVERTER-TEMPLATES] + + (* ;; "Now use Medley names") + + (CLOSEF? PSTMPFILENAME) + (CL:UNLESS DONTDELETE (DELFILE PSTMPFILENAME)) + (CLOSEF? ERRORFILENAME) + (CL:WHEN (INFILEP ERRORFILENAME) + (CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILENAME 'LENGTH) + (CL:UNLESS DONTDELETE (DELFILE ERRORFILENAME))) + 0) + (ERROR "Cannot create PDF file for " TARGETPDFNAME))) + (CL:WHEN (IGREATERP COMPLETIONCODE 0) + (ERROR "Cannot create PDF file for " TARGETPDFNAME)) + (RENAMEFILE PDFTMPFILENAME TARGETPDFNAME]) +) + +(PDF-INIT) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (2668 5002 (PDFFILEP 2678 . 3592) (PDF.HARDCOPYW 3594 . 4021) (PDF.TEXT 4023 . 4631) ( +PDF.TEDIT 4633 . 5000)) (5378 12426 (PDF-INIT 5388 . 5957) (OPEN-PDF-STREAM 5959 . 8062) ( +CLOSE-PDF-STREAM 8064 . 8979) (PDF-CONVERT 8981 . 12424))))) +STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..2e961a9b83102bacf88ed999d18897340b244af5 GIT binary patch literal 4918 zcmb_fU2hxL5vA-VX^Ez23bzGpE0(j?Z6QoIYQk(D@lT^z~~?9Wf>1ZchqQX}R~ja%Itb(atPud4Eyue8pIg^{*?nev2}t@v?+%w`8|vY{4+FJms8yz^OX`tUi!6*6m zYY-bdmCD;CXwn)9bnop{W+Q(*3DmpqFoYw)59o9}!X+D%cyXXoP3>Ju;!J0gG)%O0 zXJ~1|0R`O-jpN{u1_T|F3^%vcH#%#G3QKng%*#Zl8E6OqMX71L&@6TN8jSW@ADS{m zKee?QXA1hh7&z->OP>{Q+w`JySblXoJ|C#>ePSNMA$KchA4+akV|j>9?j5$6+| zS_kns4>Tix5dic=v60hQ`hSUaR;WlW84|G8TqHr zPEO?B=B6`oblkV?!Y$)WO$m;Ns1)kvG*0J!X&iV@oG3)ONBNO#oPm8cgv9)2i!h=} zjgfh>euyWSv+q@|^TwU)-}3}q0O~GGMD(z6yGM_qw15}G>fXRyufa}~Ys|h9OyL-h zOHkJfI`qxY?iM|Ln5aK~BM7nz_9hY^3`r~?-sRFu!CEQ6yeWe1wAm zrSKo>3@DVCiCCl36x{V(nt$r+cuwvv!c6$6v8NC?4%lw3u8kVj`7|hE6b)LN;P)jI zA~O2^paB+U0y7YPoJJHPaJYxa!f+xsq2H0 zn#7M^voV`8$qanpMIDgujBNM~NsK5r!Vf_az5pstDHJESpR{NZk;a@Xi?d$7ca@?oNT*_T!x@_%!uls~fugd6YQ9Ggj=*gh6oV;oL} z7;m7PSVp#y$6t&JT+`yJfWz+tatCcn z(s-h>4E{EsGr8S998UO-3R9!orfh$VHn}~oWO>h~IT8rmEb_A%g0hQzWG7b82L(zo z=ps2=MF{l=>#;s~Z4V*bZ1kBJ_BcX~i9X#zY52H@@QwOrPtS1Qp3S6<5aM>b8$pCz zKq<-J_4+hJiblzpgU@)1PrI$%d=4;_IRn|n@^b3+%@klIGj?$Yn+DWvn+cshEmy1a z6?Je-QDsrvGoxOQ5Ut4b$}x^}9=3BPM`s+Mj#o?6&8!7IMd?mYv6q9CieUAlGu&No zdpMIgw}^3HsbERR>#)qkhI3WYAQHSb-!TK~l{WJhTkn+=bXwjZ#Zm zgH21ko+Py4v{xJ%}x{4`uOCa>f?=mGs!0Arh%G7eyZ@jrw;sR#C`%4BuDTk0**vCgEuE} zsF8kdB*w^>=5Y7h5gq^OHa z4~!Dy`5f8chWzPP?(14%v&wnH zxuwpgyuD%D*UM5{0W41N4~-ZHHcFN0r(;|OLH_?izwPX+T0FB1`IG4PBkZf156W$d z{qH=yjfM;?XqofS0`jL2vSgkOPbr1vgtH~>Zq6%5Fn5E1w3Ux096w;vlpc742bNNA za7U`;JaCX#Hj|i0f~lSOka|AGymjTsTIB?S`1K7M=PbNsk9A_%!aS_yv{X2J6*;2% EUwiL|*8l(j literal 0 HcmV?d00001 From f6a9b88b34c16ffe185be4fe867180b6ebe26ef2 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 24 Jun 2023 15:49:18 -0700 Subject: [PATCH 02/37] POSTSCRIPTSTREAM: Adds extra field to postscript data for PDFSTREAM filename --- library/POSTSCRIPTSTREAM | 895 +++++++++++++++++----------------- library/POSTSCRIPTSTREAM.LCOM | Bin 91396 -> 91382 bytes 2 files changed, 448 insertions(+), 447 deletions(-) diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM index 6d5a1729..80df2d18 100644 --- a/library/POSTSCRIPTSTREAM +++ b/library/POSTSCRIPTSTREAM @@ -1,9 +1,12 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP") -(FILECREATED "21-Jun-2021 20:29:32"  -{DSK}kaplan>Local>medley3.5>git-medley>library>POSTSCRIPTSTREAM.;11 259283 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - previous date%: "12-Jun-2021 19:14:50" -{DSK}kaplan>Local>medley3.5>git-medley>library>POSTSCRIPTSTREAM.;10) +(FILECREATED "24-Jun-2023 14:49:45" {WMEDLEY}POSTSCRIPTSTREAM.;13 258994 + + :EDIT-BY rmk + + :CHANGES-TO (FNS CLOSEPOSTSCRIPTSTREAM) + + :PREVIOUS-DATE "23-Jun-2023 12:05:56" {WMEDLEY}POSTSCRIPTSTREAM.;12) (* ; " @@ -14,7 +17,7 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RPAQQ POSTSCRIPTSTREAMCOMS [ - (* ;; "PostScript printer support for Medley") + (* ;; "PostScript printer support for Medley") (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM)) (INITRECORDS \POSTSCRIPTDATA) @@ -38,14 +41,14 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (ZAPFCHANCERY . ZC) (ZAPFDINGBATS . ZD))) - (* ;; "Font-reading code") + (* ;; "Font-reading code") (FNS PSCFONT.READFONT PSCFONT.SPELLFILE PSCFONT.COERCEFILE PSCFONTFROMCACHE.SPELLFILE PSCFONTFROMCACHE.COERCEFILE PSCFONT.WRITEFONT READ-AFM-FILE CONVERT-AFM-FILES POSTSCRIPT.GETFONTID POSTSCRIPT.FONTCREATE \POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS POSTSCRIPT.FONTSAVAILABLE) (COMS - (* ;; "Until macro in FONT is exported") + (* ;; "Until macro in FONT is exported") (MACROS \FSETCHARWIDTH)) (FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM) @@ -57,7 +60,7 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen \PS.SCALEREGION \SCALEDBITBLT.PSC \SETPOS.PSC \SETXFORM.PSC \STRINGWIDTH.PSC \SWITCHFONTS.PSC \TERPRI.PSC) - (* ;; "DIG operations: ") + (* ;; "DIG operations: ") (FNS \BITBLT.PSC \BLTSHADE.PSC \CHARWIDTH.PSC \CREATECHARSET.PSC \DRAWARC.PSC \DRAWCIRCLE.PSC \DRAWCURVE.PSC \DRAWELLIPSE.PSC \DRAWLINE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC @@ -67,19 +70,18 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen \DSPTOPMARGIN.PSC \DSPTRANSLATE.PSC \DSPXPOSITION.PSC \DSPYPOSITION.PSC \FILLCIRCLE.PSC \FILLPOLYGON.PSC \FIXLINELENGTH.PSC \MOVETO.PSC \NEWPAGE.PSC) (COMS - (* ;; "Character-output, plus special-cases:") + (* ;; "Character-output, plus special-cases:") (FNS \POSTSCRIPT.CHANGECHARSET \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG \POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN \POSTSCRIPT.ACCENTPAIR) - (* ;; - "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") + (* ;; "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") (FNS \PSC.SPACEDISP \PSC.SPACEWID \PSC.SYMBOLS) - (* ;; - "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") + (* ;; + "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") (FNS \POSTSCRIPT.NSHASH) (VARS (*POSTSCRIPT-UNACCENTED-FONTS* '(Dancer ZapfDingbats "Dancer" "ZapfDingbats")) @@ -176,7 +178,7 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (CREATECHARSET \CREATECHARSET.PSC] (INITVARS (POSTSCRIPT.PAGETYPE 'LETTER)) - (* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk") + (* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk") [APPENDVARS (POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) NIL @@ -213,57 +215,59 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RECORD PSCFONT (FID IL-FONTID FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTHS)) (DATATYPE \POSTSCRIPTDATA - ((POSTSCRIPTACCENTED FLAG) (* ; - "T if we're to do NS-to-PS translations on characters in the current font.") - POSTSCRIPTFONT (* ; - "The fontdescriptor of the current font") - POSTSCRIPTX (* ; "The current X") - POSTSCRIPTY (* ; "... and Y") - POSTSCRIPTLEFTMARGIN (* ; "The margins") + ((POSTSCRIPTACCENTED FLAG) (* ; + "T if we're to do NS-to-PS translations on characters in the current font.") + POSTSCRIPTFONT (* ; + "The fontdescriptor of the current font") + POSTSCRIPTX (* ; "The current X") + POSTSCRIPTY (* ; "... and Y") + POSTSCRIPTLEFTMARGIN (* ; "The margins") POSTSCRIPTRIGHTMARGIN POSTSCRIPTBOTTOMMARGIN POSTSCRIPTTOPMARGIN POSTSCRIPTLINESPACING - (* ; "Line to line spacing") - POSTSCRIPTCOLOR (* ; - "Color (or grey shade) in effect; 0.0=black, 1.0=white.") - POSTSCRIPTSCALE (* ; "Scale of the stream") - POSTSCRIPTOPERATION (* ; - "Default operation (PAINT, REPLACE, ...)") - POSTSCRIPTCLIPPINGREGION (* ; - "The current region available to be written into") - POSTSCRIPTPAGENUM (* ; "Current page number") - POSTSCRIPTHEADING (* ; "The heading") - POSTSCRIPTHEADINGFONT (* ; "Font for the heading") - POSTSCRIPTSPACEFACTOR (* ; - "Expansion factor for spaces (see DSPSPACEFACTOR)") - POSTSCRIPTSPACEWIDTH (* ; - "The width of a space in the current font") - POSTSCRIPTLANDSCAPE (* ; - "non-NIL for paper in 'landscape' mode") - POSTSCRIPTCHARSTOSHOW (* ; - "non-NIL if the string (PostScript-type string) of chars has already been started") - POSTSCRIPTFONTCHANGEDFLG (* ; "Font has changed") - POSTSCRIPTMOVEFLG (* ; "Need to move") - POSTSCRIPTWIDTHS (* ; - "The widths vector of the current font") - POSTSCRIPTTRANSX (* ; "Translation in X") - POSTSCRIPTTRANSY (* ; "... and Y") - POSTSCRIPTPENDINGXFORM (* ; - "A userspace to devicespace transform is pending") - POSTSCRIPTPAGEREGION (* ; "The whole page") - POSTSCRIPTPAGEBLANK (* ; "This page is blank flag") - POSTSCRIPTSCALEHACK (* ; - "For \PS.SCALEHACK since DSPSCALE doesn't change the scale of the stream") - POSTSCRIPTTEMPARRAY (* ; - "For converting FIXP to string of digit chars") - POSTSCRIPTXFORMSTACK (* ; "The stack of transformations. DSPPUSHSTATE pushes one onto this, DSPPOPSTATE uses it to reset values.") - POSTSCRIPTROTATION (* ; - "Rotation value currently in effect.") - POSTSCRIPTPENDINGROTATION (* ; - "Rotation to take effect at next SETXFORM.") - POSTSCRIPTFONTSUSED (* ; "List of FONTIDs of the fonts that've been used before. This is used to control the re-encoding of fonts for accented-character rendering.") - (POSTSCRIPTNSCHARSET BYTE) (* ; - "Current NSCHARSET--widths are in POSTSCRIPTWIDTHS") - (POSTSCRIPTNATURALSPACEWIDTH WORD) (* ; - "Width of the space in the current font, used to compute the scaled space width.") + (* ; "Line to line spacing") + POSTSCRIPTCOLOR (* ; + "Color (or grey shade) in effect; 0.0=black, 1.0=white.") + POSTSCRIPTSCALE (* ; "Scale of the stream") + POSTSCRIPTOPERATION (* ; + "Default operation (PAINT, REPLACE, ...)") + POSTSCRIPTCLIPPINGREGION (* ; + "The current region available to be written into") + POSTSCRIPTPAGENUM (* ; "Current page number") + POSTSCRIPTHEADING (* ; "The heading") + POSTSCRIPTHEADINGFONT (* ; "Font for the heading") + POSTSCRIPTSPACEFACTOR (* ; + "Expansion factor for spaces (see DSPSPACEFACTOR)") + POSTSCRIPTSPACEWIDTH (* ; + "The width of a space in the current font") + POSTSCRIPTLANDSCAPE (* ; + "non-NIL for paper in 'landscape' mode") + POSTSCRIPTCHARSTOSHOW (* ; + "non-NIL if the string (PostScript-type string) of chars has already been started") + POSTSCRIPTFONTCHANGEDFLG (* ; "Font has changed") + POSTSCRIPTMOVEFLG (* ; "Need to move") + POSTSCRIPTWIDTHS (* ; + "The widths vector of the current font") + POSTSCRIPTTRANSX (* ; "Translation in X") + POSTSCRIPTTRANSY (* ; "... and Y") + POSTSCRIPTPENDINGXFORM (* ; + "A userspace to devicespace transform is pending") + POSTSCRIPTPAGEREGION (* ; "The whole page") + POSTSCRIPTPAGEBLANK (* ; "This page is blank flag") + POSTSCRIPTSCALEHACK (* ; + "For \PS.SCALEHACK since DSPSCALE doesn't change the scale of the stream") + POSTSCRIPTTEMPARRAY (* ; + "For converting FIXP to string of digit chars") + POSTSCRIPTXFORMSTACK (* ; "The stack of transformations. DSPPUSHSTATE pushes one onto this, DSPPOPSTATE uses it to reset values.") + POSTSCRIPTROTATION (* ; + "Rotation value currently in effect.") + POSTSCRIPTPENDINGROTATION (* ; + "Rotation to take effect at next SETXFORM.") + POSTSCRIPTFONTSUSED (* ; "List of FONTIDs of the fonts that've been used before. This is used to control the re-encoding of fonts for accented-character rendering.") + (POSTSCRIPTNSCHARSET BYTE) (* ; + "Current NSCHARSET--widths are in POSTSCRIPTWIDTHS") + (POSTSCRIPTNATURALSPACEWIDTH WORD) (* ; + "Width of the space in the current font, used to compute the scaled space width.") + POSTSCRIPTTARGETINFO (* ; + "For use of other imagetypes (like PDF) that might piggy-back on postscript.") ) POSTSCRIPTX _ 0 POSTSCRIPTY _ 0 POSTSCRIPTTRANSX _ 0 POSTSCRIPTTRANSY _ 0 POSTSCRIPTSPACEFACTOR _ 1 POSTSCRIPTPAGENUM _ 0 POSTSCRIPTSCALEHACK _ 1 POSTSCRIPTTEMPARRAY @@ -271,28 +275,28 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen POSTSCRIPTROTATION _ 0 POSTSCRIPTCOLOR _ 0.0) (RECORD POSTSCRIPTXFORM ( - (* ;; "Holds the transformation state as saved by DSPPUSHSTATE. Used by DSPPOPSTATE to restore the tranformation state.") + (* ;; "Holds the transformation state as saved by DSPPUSHSTATE. Used by DSPPOPSTATE to restore the tranformation state.") - PSXCLIP (* ; "Clipping region") - PSXPAGE (* ; "Page region") - PSXX (* ; "X position?") - PSXY (* ; "Y position?") - PSXLEFT (* ; "Left margin") - PSXRIGHT (* ; "Right margin") - PSXTOP (* ; "Top margin") - PSXBOTTOM (* ; "Bottom Margin") - PSXTRANX (* ; "X-translation in effect") - PSXTRANY (* ; "Y-translation in effect") - PSXLAND (* ; "Landscape?") - PSXXFORMPEND (* ; "Are there transforms pending? ") - )) + PSXCLIP (* ; "Clipping region") + PSXPAGE (* ; "Page region") + PSXX (* ; "X position?") + PSXY (* ; "Y position?") + PSXLEFT (* ; "Left margin") + PSXRIGHT (* ; "Right margin") + PSXTOP (* ; "Top margin") + PSXBOTTOM (* ; "Bottom Margin") + PSXTRANX (* ; "X-translation in effect") + PSXTRANY (* ; "Y-translation in effect") + PSXLAND (* ; "Landscape?") + PSXXFORMPEND (* ; "Are there transforms pending? ") + )) ) (/DECLAREDATATYPE '\POSTSCRIPTDATA '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - BYTE WORD) + BYTE WORD POINTER) '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) (\POSTSCRIPTDATA 0 POINTER) (\POSTSCRIPTDATA 2 POINTER) @@ -328,15 +332,16 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (\POSTSCRIPTDATA 62 POINTER) (\POSTSCRIPTDATA 64 POINTER) (\POSTSCRIPTDATA 66 (BITS . 7)) - (\POSTSCRIPTDATA 67 (BITS . 15))) - '68) + (\POSTSCRIPTDATA 67 (BITS . 15)) + (\POSTSCRIPTDATA 68 POINTER)) + '70) ) (/DECLAREDATATYPE '\POSTSCRIPTDATA '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - BYTE WORD) + BYTE WORD POINTER) '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) (\POSTSCRIPTDATA 0 POINTER) (\POSTSCRIPTDATA 2 POINTER) @@ -372,8 +377,9 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (\POSTSCRIPTDATA 62 POINTER) (\POSTSCRIPTDATA 64 POINTER) (\POSTSCRIPTDATA 66 (BITS . 7)) - (\POSTSCRIPTDATA 67 (BITS . 15))) - '68) + (\POSTSCRIPTDATA 67 (BITS . 15)) + (\POSTSCRIPTDATA 68 POINTER)) + '70) (DEFINEQ (POSTSCRIPT.INIT @@ -486,24 +492,24 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ) (ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT) - (PSC . TEXT) - (PSF . BINARY) - (PSCFONT . BINARY) - (POSTSCRIPT . TEXT)) + (PSC . TEXT) + (PSF . BINARY) + (PSCFONT . BINARY) + (POSTSCRIPT . TEXT)) (ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) - (AVANTGARDE-DEMI . AD) - (BECKMAN . BM) - (BOOKMAN-LIGHT . BL) - (BOOKMAN-DEMI . BD) - (COURIER . CO) - (HELVETICA-NARROW . HN) - (NEWCENTURYSCHLBK . NC) - (PALATINO . PA) - (TIMES . TS) - (ZAPFCHANCERY-MEDIUM . ZM) - (ZAPFCHANCERY . ZC) - (ZAPFDINGBATS . ZD)) + (AVANTGARDE-DEMI . AD) + (BECKMAN . BM) + (BOOKMAN-LIGHT . BL) + (BOOKMAN-DEMI . BD) + (COURIER . CO) + (HELVETICA-NARROW . HN) + (NEWCENTURYSCHLBK . NC) + (PALATINO . PA) + (TIMES . TS) + (ZAPFCHANCERY-MEDIUM . ZM) + (ZAPFCHANCERY . ZC) + (ZAPFDINGBATS . ZD)) @@ -1112,11 +1118,11 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (DECLARE%: EVAL@COMPILE (PUTPROPS \FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) - (\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) - of (\GETCHARSETINFO (\CHARSET CHARCODE) - FONTDESC)) - (\CHAR8CODE CHARCODE) - WIDTH))) + (\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO + (\CHARSET CHARCODE) + FONTDESC)) + (\CHAR8CODE CHARCODE) + WIDTH))) ) (DEFINEQ @@ -1260,11 +1266,11 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen STREAM]) (CLOSEPOSTSCRIPTSTREAM - [LAMBDA (STREAM) (* ; "Edited 8-Mar-93 10:31 by jds") - (POSTSCRIPT.ENDPAGE STREAM) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Trailer" :EOL) - (* BOUT STREAM (CHARCODE ^D)) - ]) + [LAMBDA (STREAM) (* ; "Edited 24-Jun-2023 13:48 by rmk") + (* ; "Edited 8-Mar-93 10:31 by jds") + (POSTSCRIPT.ENDPAGE STREAM) (* BOUT STREAM (CHARCODE ^D)) + (* ; "Should this be the lsat byte?") + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Trailer" :EOL]) ) (RPAQ? *POSTSCRIPT-FILE-TYPE* 'BINARY) @@ -3537,210 +3543,210 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RPAQQ *POSTSCRIPT-NS-TRANSLATIONS* ( - (* ;; "Mapping of NS characters to Postscript renderings.") + (* ;; "Mapping of NS characters to Postscript renderings.") - (* ;; "First few are for control-codes in old Press fonts (Timesroman, etc.); not strictly NS, but undefined therein so should be OK.") + (* ;; "First few are for control-codes in old Press fonts (Timesroman, etc.); not strictly NS, but undefined therein so should be OK.") ("^S" NIL "2,320") - (* ; "pressfont em dash") + (* ; "pressfont em dash") ("^V" NIL "2,261") - (* ; "pressfont en dash") + (* ; "pressfont en dash") ("^G" NIL "0,140") ("0,244" NIL "2,250") - (* ; "generic currency symbol") + (* ; "generic currency symbol") ("0,251" NIL "2,140") - (* ; "left single quote") + (* ; "left single quote") ("0,254" SYMBOL "2,254") - (* ; "left arrow") + (* ; "left arrow") ("0,255" SYMBOL "2,255") - (* ; "uparrow") + (* ; "uparrow") ("0,256" SYMBOL "2,256") - (* ; "right arrow") + (* ; "right arrow") ("0,257" SYMBOL "2,257") - (* ; "down arrow") + (* ; "down arrow") ("0,260" SYMBOL "2,260") - (* ; "degree") + (* ; "degree") ("0,261" SYMBOL "2,261") - (* ; "+/-") + (* ; "+/-") ("0,264" SYMBOL "2,264") - (* ; "times") + (* ; "times") ("0,267" NIL "2,264") - (* ; "Center-dot") + (* ; "Center-dot") ("0,270" SYMBOL "2,270") - (* ; "divide") + (* ; "divide") ("0,271" NIL "2,047") - (* ; "right single quote") + (* ; "right single quote") ("0,274" FUNCTION " f14 ") - (* ; "1/4") + (* ; "1/4") ("0,275" FUNCTION " f12 ") - (* ; "1/2") + (* ; "1/2") ("0,276" FUNCTION " f34 ") - (* ; "3/4") + (* ; "3/4") ("0,322" SYMBOL "2,342") - (* ; "registered") + (* ; "registered") ("0,323" SYMBOL "2,343") - (* ; "copyright") + (* ; "copyright") ("0,324" SYMBOL "2,344") - (* ; "tm") + (* ; "tm") ("0,334" FUNCTION " f18 ") - (* ; "1/8") + (* ; "1/8") ("0,335" FUNCTION " f38 ") - (* ; "3/8") + (* ; "3/8") ("0,336" FUNCTION " f58 ") - (* ; "5/8") + (* ; "5/8") ("0,337" FUNCTION " f78 ") - (* ; "7/8") + (* ; "7/8") ("0,342" NIL "2,235") - (* ; "Eth (slashed D?)") + (* ; "Eth (slashed D?)") ("0,354" NIL "2,237") - (* ; "Thorn") + (* ; "Thorn") ("0,363" NIL "2,236") - (* ; "eth") + (* ; "eth") ("0,374" NIL "2,240") - (* ; "thorn") + (* ; "thorn") ("41,172" DINGBAT "0,110") - (* ; "filled star") + (* ; "filled star") ("42,42" DINGBAT "0,161") - (* ; "ballot-box") + (* ; "ballot-box") ("42,61" APPLY* "0,161" \PSC.SYMBOLS \PSC.SPACEWID NIL) - (* ; "Checked ballot-box") + (* ; "Checked ballot-box") ("357,44" NIL "2,261") - (* ; "n dash") + (* ; "n dash") ("357,45" NIL "2,320") - (* ; "m dash") + (* ; "m dash") ("357,55" APPLY* "M" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "M quad") + (* ; "M quad") ("357,54" APPLY* "N" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "N quad") + (* ; "N quad") ("357,56" APPLY* "1" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "FIGURE quad") + (* ; "FIGURE quad") ("357,57" APPLY* ("M" 0.2) \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "This space (1/5M)") + (* ; "This space (1/5M)") ("357,60" NIL "2,262") - (* ; "dagger") + (* ; "dagger") ("357,61" NIL "2,263") - (* ; "double dagger") + (* ; "double dagger") ("357,062" SYMBOL "2,361") - (* ; "angleright") + (* ; "angleright") ("357,063" SYMBOL "2,341") - (* ; "angleleft") + (* ; "angleleft") ("357,70" SYMBOL "2,315") - (* ; "perpendicular") + (* ; "perpendicular") ("357,101" NIL "2,275") - (* ; "per mil o/oo") + (* ; "per mil o/oo") ("357,104" ACCENTPAIR "<" NIL "/") - (* ; "not less than") + (* ; "not less than") ("357,105" ACCENTPAIR ">" "/") - (* ; "not greater than") + (* ; "not greater than") ("357,110" SYMBOL "2,312") - (* ; "parallel") + (* ; "parallel") ("357,111" SYMBOL "2,315") - (* ; "not parallel") + (* ; "not parallel") ("357,112" SYMBOL "2,316") - (* ; "element") + (* ; "element") ("357,113" SYMBOL "2,317") - (* ; "notelement") + (* ; "notelement") ("357,114" SYMBOL "2,047") - (* ; "suchthat") + (* ; "suchthat") ("357,115" SYMBOL "2,334") - (* ; "implied by, double arrow left") + (* ; "implied by, double arrow left") ("357,116" SYMBOL "2,333") - (* ; "iff, double arrow") + (* ; "iff, double arrow") ("357,117" SYMBOL "2,336") - (* ; "implies, double arrow right") + (* ; "implies, double arrow right") ("357,120" SYMBOL "2,253") - (* ; "double arrow") + (* ; "double arrow") ("357,121" SYMBOL "2,333") - (* ; "double arrow") + (* ; "double arrow") ("357,122" SYMBOL "2,333") - (* ; "l/r arrow") + (* ; "l/r arrow") ("357,126" SYMBOL "2,307") - (* ; "intersection") + (* ; "intersection") ("357,127" SYMBOL "2,310") - (* ; "union") + (* ; "union") ("357,130" SYMBOL "2,312") - (* ; "reflexsuperset") + (* ; "reflexsuperset") ("357,131" SYMBOL "2,315") - (* ; "reflexsubset") + (* ; "reflexsubset") ("357,132" SYMBOL "2,311") - (* ; "propersuperset") + (* ; "propersuperset") ("357,133" SYMBOL "2,314") - (* ; "propersubset") + (* ; "propersubset") ("357,137" SYMBOL "2,313") - (* ; "notsubset") + (* ; "notsubset") ("357,141" SYMBOL "2,306") - (* ; "emptyset") + (* ; "emptyset") ("357,142" SYMBOL "2,305") - (* ; "circleplus") + (* ; "circleplus") ("357,144" SYMBOL "2,304") - (* ; "circlemultiply") + (* ; "circlemultiply") ("357,146" NIL "2,267") - (* ; "bullet") + (* ; "bullet") ("357,147" SYMBOL "2,260") - (* ; - "center circle (composition), lowered degree") + (* ; + "center circle (composition), lowered degree") ("357,152" SYMBOL "2,330") - (* ; "logicalnot") + (* ; "logicalnot") ("357,154" SYMBOL "2,320") - (* ; "angle") + (* ; "angle") ("357,160" SYMBOL "2,136") - (* ; "perpendicular") + (* ; "perpendicular") ("357,161" SYMBOL "2,265") - (* ; "proportional") + (* ; "proportional") ("357,162" SYMBOL "2,272") - (* ; "equivalence") + (* ; "equivalence") ("357,165" SYMBOL "2,362") - (* ; "integral") + (* ; "integral") ("357,167" SYMBOL "2,273") - (* ; "approxequal") + (* ; "approxequal") ("357,170" SYMBOL "2,100") - (* ; "congruent") + (* ; "congruent") ("357,172" SYMBOL "2,345") - (* ; "summation") + (* ; "summation") ("357,173" SYMBOL "2,325") - (* ; "product") + (* ; "product") ("357,174" SYMBOL "2,326") - (* ; "radical") + (* ; "radical") ("357,242" SYMBOL "2,246") - (* ; "florin") + (* ; "florin") ("357,260" SYMBOL "2,351") - (* ; "Ceiling, left ") + (* ; "Ceiling, left ") ("357,261" SYMBOL "2,371") - (* ; "Ceiling, right") + (* ; "Ceiling, right") ("357,262" SYMBOL "2,353") - (* ; "Floor, left ") + (* ; "Floor, left ") ("357,263" SYMBOL "2,373") - (* ; "Floor, right") + (* ; "Floor, right") ("357,264" SYMBOL "2,44") - (* ; "exists") + (* ; "exists") ("357,265" SYMBOL "2,42") - (* ; "forall") + (* ; "forall") ("357,266" SYMBOL "2,331") - (* ; "logicaland") + (* ; "logicaland") ("357,267" SYMBOL "2,332") - (* ; "logicalor") + (* ; "logicalor") ("357,271" SYMBOL "2,321") - (* ; "gradient") + (* ; "gradient") ("357,272" SYMBOL "2,266") - (* ; "partialdiff") + (* ; "partialdiff") ("357,313" SYMBOL "2,252") - (* ; "spade") + (* ; "spade") ("357,317" DINGBAT "0,63") - (* ; "check") + (* ; "check") ("357,375" FUNCTION " f13 ") - (* ; "1/3") + (* ; "1/3") ("357,376" FUNCTION " f23 ") - (* ; "2/3") + (* ; "2/3") ("361,041" ACCENT "0,4" A) ("361,042" ACCENT "0,1" A) ("361,043" ACCENT "0,2" A) ("361,044" ACCENT "0,6" A) ("361,045" ACCENTPAIR A "0,305") - (* ; "A-macron") + (* ; "A-macron") ("361,046" ACCENTPAIR A "0,306") - (* ; "A-breve") + (* ; "A-breve") ("361,047" ACCENT "0,3" A) ("361,050" ACCENT "0,5" A) ("361,055" ACCENT "0,7" C) @@ -3748,15 +3754,15 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ("361,061" ACCENT "0,10" E) ("361,062" ACCENT "0,11" E) ("361,063" ACCENTPAIR E "0,305") - (* ; "E-macron") + (* ; "E-macron") ("361,065" ACCENT "0,12" E) ("361,066" ACCENTPAIR E NIL "0,316") - (* ; "E-ogonek") + (* ; "E-ogonek") ("361,076" ACCENT "0,17" I) ("361,077" ACCENT "0,14" I) ("361,100" ACCENT "0,15" I) ("361,102" ACCENTPAIR I "0,305") - (* ; "I-macron") + (* ; "I-macron") ("361,104" ACCENT "0,16" I) ("361,114" ACCENT "0,20" N) ("361,117" ACCENT "0,24" O) @@ -3764,31 +3770,31 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ("361,121" ACCENT "0,22" O) ("361,122" ACCENT "0,25" O) ("361,123" ACCENTPAIR O "0,305") - (* ; "O-macron") + (* ; "O-macron") ("361,124" ACCENT "0,23" O) ("361,134" ACCENT "0,26" S) ("361,137" ACCENT "0,32" U) ("361,140" ACCENT "0,27" U) ("361,141" ACCENT "0,30" U) ("361,143" ACCENTPAIR U "0,305") - (* ; "U-macron") + (* ; "U-macron") ("361,145" ACCENT "0,31" U) ("361,155" ACCENT "0,33" Y) ("361,160" ACCENT "0,34" Z) ("361,165" ACCENTPAIR Y "0,305") - (* ; "Y-macron") + (* ; "Y-macron") ("361,166" ACCENTPAIR "0,341" "0,305") - (* ; "AE-macron") + (* ; "AE-macron") ("361,167" ACCENTPAIR "0,352" "0,305") - (* ; "OE-macron") + (* ; "OE-macron") ("361,241" ACCENT "0,204" a) ("361,242" ACCENT "0,201" a) ("361,243" ACCENT "0,202" a) ("361,244" ACCENT "0,206" a) ("361,245" ACCENTPAIR a "0,305") - (* ; "a-macron") + (* ; "a-macron") ("361,246" ACCENTPAIR a "0,306") - (* ; "a-breve") + (* ; "a-breve") ("361,247" ACCENT "0,203" a) ("361,250" ACCENT "0,205" a) ("361,255" ACCENT "0,207" c) @@ -3796,17 +3802,17 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ("361,261" ACCENT "0,210" e) ("361,262" ACCENT "0,211" e) ("361,263" ACCENTPAIR e "0,305") - (* ; "e-macron") + (* ; "e-macron") ("361,265" ACCENT "0,212" e) ("361,266" ACCENTPAIR e NIL "0,316") - (* ; "e-ogonek") + (* ; "e-ogonek") ("361,267" ACCENTPAIR e "0,317") - (* ; "e-caron") + (* ; "e-caron") ("361,276" ACCENT "0,217" i) ("361,277" ACCENT "0,214" i) ("361,300" ACCENT "0,215" i) ("361,302" ACCENTPAIR "0,365" "0,305") - (* ; "i-macron") + (* ; "i-macron") ("361,304" ACCENT "0,216" i) ("361,314" ACCENT "0,220" n) ("361,317" ACCENT "0,224" o) @@ -3814,246 +3820,246 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ("361,321" ACCENT "0,222" o) ("361,322" ACCENT "0,225" o) ("361,323" ACCENTPAIR o "0,305") - (* ; "o-macron") + (* ; "o-macron") ("361,324" ACCENT "0,223" o) ("361,334" ACCENT "0,226" s) ("361,337" ACCENT "0,232" u) ("361,340" ACCENT "0,227" u) ("361,341" ACCENT "0,230" u) ("361,343" ACCENTPAIR u "0,305") - (* ; "u-macron") + (* ; "u-macron") ("361,344" ACCENTPAIR u "0,306") - (* ; "u-breve") + (* ; "u-breve") ("361,345" ACCENT "0,231" u) ("361,355" ACCENT "0,233" y) ("361,360" ACCENT "0,234" z) ("361,365" ACCENTPAIR y "0,305") - (* ; "y-macron") + (* ; "y-macron") ("361,366" ACCENTPAIR "0,361" "0,305") - (* ; "ae-macron") + (* ; "ae-macron") ("361,367" ACCENTPAIR "0,372" "0,305") - (* ; "oe-macron") + (* ; "oe-macron") ("361,371" ACCENTPAIR a "0,317") - (* ; "a-caron") + (* ; "a-caron") ("361,375" ACCENTPAIR g "0,317") - (* ; "g-caron") + (* ; "g-caron") - (* ;; "Special code assignments for Dictionary of Old English, UToronto:") + (* ;; "Special code assignments for Dictionary of Old English, UToronto:") ("361,370" ACCENTPAIR a ("0,305" "0,306")) - (* ; "a - breve-macron") + (* ; "a - breve-macron") ("361,372" ACCENTPAIR e "0,306") - (* ; "e-breve") + (* ; "e-breve") ("361,373" ACCENTPAIR e "0,305" "0,56") - (* ; "e macron underdot") + (* ; "e macron underdot") ("361,374" ACCENTPAIR e ("0,305" "0,306")) - (* ; "e - breve-macron") + (* ; "e - breve-macron") ("361,376" ACCENTPAIR "0,365" "0,306") - (* ; "i-breve") + (* ; "i-breve") ("362,242" ACCENTPAIR "0,365" "0,317") - (* ; "i-caron") + (* ; "i-caron") ("362,241" ACCENTPAIR "0,365" ("0,305" "0,306")) - (* ; " i - breve-macron") + (* ; " i - breve-macron") ("362,243" ACCENTPAIR n "0,305") - (* ; "n-macron") + (* ; "n-macron") ("362,244" ACCENTPAIR m "0,305") - (* ; "m-macron") + (* ; "m-macron") ("362,245" ACCENTPAIR o "0,317") - (* ; "o-caron") + (* ; "o-caron") ("362,246" ACCENTPAIR o "0,306") - (* ; "o-breve") + (* ; "o-breve") ("362,247" ACCENTPAIR o ("0,305" "0,306")) - (* ; "o - breve-macron") + (* ; "o - breve-macron") ("362,250" ACCENTPAIR o "0,305" "0,56") - (* ; "o-macron underdot") + (* ; "o-macron underdot") ("362,251" ACCENTPAIR o "0,316") - (* ; "o-ogonek") + (* ; "o-ogonek") ("362,252" ACCENTPAIR u "0,317") - (* ; "u-caron") + (* ; "u-caron") ("362,253" ACCENTPAIR u ("0,305" "0,306")) - (* ; "u - breve-macron") + (* ; "u - breve-macron") ("362,254" ACCENTPAIR y "0,306") - (* ; "y-breve") + (* ; "y-breve") ("362,256" ACCENTPAIR y "0,317") - (* ; "y-caron") + (* ; "y-caron") ("362,255" ACCENTPAIR y ("0,305" "0,306")) - (* ; "y - breve-macron") - (* ; "235 = Eth") - (* ; "236 = eth") - (* ; "237 = Thorn") - (* ; "240 = thorn") + (* ; "y - breve-macron") + (* ; "235 = Eth") + (* ; "236 = eth") + (* ; "237 = Thorn") + (* ; "240 = thorn") - (* ;; "NS Greek characters") + (* ;; "NS Greek characters") ("46,101" SYMBOL "2,101") - (* ; "Alpha") + (* ; "Alpha") ("46,102" SYMBOL "2,102") - (* ; "Beta") + (* ; "Beta") ("46,103" SYMBOL 0) - (* ; "--empty--") + (* ; "--empty--") ("46,104" SYMBOL "2,107") - (* ; "Gamma") + (* ; "Gamma") ("46,105" SYMBOL "2,104") - (* ; "Delta") + (* ; "Delta") ("46,106" SYMBOL "2,105") - (* ; "Epsilon") + (* ; "Epsilon") ("46,107" SYMBOL 0) - (* ; "Stigma") + (* ; "Stigma") ("46,110" SYMBOL 0) - (* ; "Digamma") + (* ; "Digamma") ("46,111" SYMBOL "2,132") - (* ; "Zeta") + (* ; "Zeta") ("46,112" SYMBOL "2,110") - (* ; "Eta") + (* ; "Eta") ("46,113" SYMBOL "2,121") - (* ; "Theta") + (* ; "Theta") ("46,114" SYMBOL "2,111") - (* ; "Iota") + (* ; "Iota") ("46,115" SYMBOL "2,113") - (* ; "Kappa") + (* ; "Kappa") ("46,116" SYMBOL "2,114") - (* ; "Lambda") + (* ; "Lambda") ("46,117" SYMBOL "2,115") - (* ; "Mu") + (* ; "Mu") ("46,120" SYMBOL "2,116") - (* ; "Nu") + (* ; "Nu") ("46,121" SYMBOL "2,130") - (* ; "Xi") + (* ; "Xi") ("46,122" SYMBOL "2,117") - (* ; "Omicron") + (* ; "Omicron") ("46,123" SYMBOL "2,120") - (* ; "Pi") + (* ; "Pi") ("46,124" SYMBOL 0) - (* ; "Koppa") + (* ; "Koppa") ("46,125" SYMBOL "2,122") - (* ; "Rho") + (* ; "Rho") ("46,126" SYMBOL "2,123") - (* ; "Sigma") + (* ; "Sigma") ("46,127" SYMBOL 0) - (* ; "--empty--") + (* ; "--empty--") ("46,130" SYMBOL "2,124") - (* ; "Tau") + (* ; "Tau") ("46,131" SYMBOL "2,125") - (* ; "Upsilon") + (* ; "Upsilon") ("46,132" SYMBOL "2,106") - (* ; "Phi") + (* ; "Phi") ("46,133" SYMBOL "2,103") - (* ; "Chi") + (* ; "Chi") ("46,134" SYMBOL "2,131") - (* ; "Psi") + (* ; "Psi") ("46,135" SYMBOL "2,132") - (* ; "Omega") + (* ; "Omega") ("46,141" SYMBOL "2,141") - (* ; "alpha") + (* ; "alpha") ("46,142" SYMBOL "2,142") - (* ; "beta") + (* ; "beta") ("46,143" SYMBOL 0) - (* ; "(md beta)") + (* ; "(md beta)") ("46,144" SYMBOL "2,147") - (* ; "gamma") + (* ; "gamma") ("46,145" SYMBOL "2,144") - (* ; "delta") + (* ; "delta") ("46,146" SYMBOL "2,145") - (* ; "epsilon") + (* ; "epsilon") ("46,147" SYMBOL "2,126") - (* ; "stigma") + (* ; "stigma") ("46,150" SYMBOL 0) - (* ; "digamma") + (* ; "digamma") ("46,151" SYMBOL "2,172") - (* ; "zeta") + (* ; "zeta") ("46,152" SYMBOL "2,150") - (* ; "eta") + (* ; "eta") ("46,153" SYMBOL "2,161") - (* ; "theta") + (* ; "theta") ("46,154" SYMBOL "2,151") - (* ; "iota") + (* ; "iota") ("46,155" SYMBOL "2,153") - (* ; "kappa") + (* ; "kappa") ("46,156" SYMBOL "2,154") - (* ; "lambda") + (* ; "lambda") ("46,157" SYMBOL "2,155") - (* ; "mu") + (* ; "mu") ("46,160" SYMBOL "2,156") - (* ; "nu") + (* ; "nu") ("46,161" SYMBOL "2,170") - (* ; "xi") + (* ; "xi") ("46,162" SYMBOL "2,157") - (* ; "omicron") + (* ; "omicron") ("46,163" SYMBOL "2,160") - (* ; "pi") + (* ; "pi") ("46,164" SYMBOL 0) - (* ; "(koppa)") + (* ; "(koppa)") ("46,165" SYMBOL "2,162") - (* ; "rho") + (* ; "rho") ("46,166" SYMBOL "2,163") - (* ; "sigma") + (* ; "sigma") ("46,167" SYMBOL "2,126") - (* ; "(fl sigma)") + (* ; "(fl sigma)") ("46,170" SYMBOL "2,164") - (* ; "tau") + (* ; "tau") ("46,171" SYMBOL "2.165") - (* ; "upsilon") + (* ; "upsilon") ("46,172" SYMBOL "2,146") - (* ; "phi") + (* ; "phi") ("46,173" SYMBOL "2,143") - (* ; "chi") + (* ; "chi") ("46,174" SYMBOL "2,171") - (* ; "psi") + (* ; "psi") ("46,175" SYMBOL "2,167") - (* ; "omega") + (* ; "omega") - (* ;; "NS Miscellaneous symbols") + (* ;; "NS Miscellaneous symbols") ("041,142" SYMBOL "2,271") - (* ; "notequal") + (* ; "notequal") ("041,145" SYMBOL "2,243") - (* ; "lessequal") + (* ; "lessequal") ("041,146" SYMBOL "2,263") - (* ; "greaterequal") + (* ; "greaterequal") ("041,147" SYMBOL "2,245") - (* ; "infinity") + (* ; "infinity") ("041,150" SYMBOL "2,134") - (* ; "therefore") + (* ; "therefore") ("041,155" SYMBOL "2,262") - (* ; "second") + (* ; "second") ("356,055" SYMBOL "2,055") - (* ; "minus") + (* ; "minus") ("356,106" SYMBOL "2,340") - (* ; "lozenge") + (* ; "lozenge") ("356,163" SYMBOL "2,351") - (* ; "topleftbracket") + (* ; "topleftbracket") ("356,164" SYMBOL "2,353") - (* ; "bottomleftbracket") + (* ; "bottomleftbracket") ("356,165" SYMBOL "2,352") - (* ; "centerbracket") + (* ; "centerbracket") ("356,166" SYMBOL "2,371") - (* ; "toprightbracket") + (* ; "toprightbracket") ("356,167" SYMBOL "2,373") - (* ; "bottomrightbracket") + (* ; "bottomrightbracket") ("356,176" SYMBOL "2,176") - (* ; "similar") + (* ; "similar") ("356,314" SYMBOL "2,251") - (* ; "heart") + (* ; "heart") ("356,340" SYMBOL "2,374") - (* ; "toprightbracce") + (* ; "toprightbracce") ("356,341" SYMBOL "2,357") - (* ; "braceextend") + (* ; "braceextend") ("356,342" SYMBOL "2,375") - (* ; "centerrightbracce") + (* ; "centerrightbracce") ("356,343" SYMBOL "2,376") - (* ; "bottomrightbracce") + (* ; "bottomrightbracce") ("356,344" SYMBOL "2,354") - (* ; "topleftbracce") + (* ; "topleftbracce") ("356,345" SYMBOL "2,356") - (* ; "bottomleftbracce") + (* ; "bottomleftbracce") ("356,346" SYMBOL "2,355") - (* ; "centerleftbracce") + (* ; "centerleftbracce") ("356,355" SYMBOL "2,363") - (* ; "integraltop") + (* ; "integraltop") ("356,356" SYMBOL "2,365") - (* ; "integralbottom") + (* ; "integralbottom") ("356,357" SYMBOL "2,364") - (* ; "integralcenter"))) + (* ; "integralcenter"))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS *POSTSCRIPT-NS-HASH*) @@ -4063,35 +4069,30 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (PUTPROPS \POSTSCRIPT.FRACTION MACRO ((STREAM STRING) - (* ;; "Handle printing of a fraction, given a string that's the name of the PS function (defined in \POSTSCRIPT.JOB.SETUP) that prints it. You must put spaces around the name.") + (* ;; "Handle printing of a fraction, given a string that's the name of the PS function (defined in \POSTSCRIPT.JOB.SETUP) that prints it. You must put spaces around the name.") - (POSTSCRIPT.SHOWACCUM STREAM) - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch POSTSCRIPTRIGHTMARGIN - of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch POSTSCRIPTX - of IMAGEDATA) - CHARWID] - [COND - ((NOT (ffetch POSTSCRIPTCHARSTOSHOW of - IMAGEDATA)) - (COND - ((ffetch POSTSCRIPTPENDINGXFORM of - IMAGEDATA) - (\SETXFORM.PSC STREAM IMAGEDATA))) - (COND - ((ffetch POSTSCRIPTFONTCHANGEDFLG - of IMAGEDATA) - (* ; - "If font was changed then switch before printing") - (\SWITCHFONTS.PSC STREAM IMAGEDATA))) - (COND - ((ffetch POSTSCRIPTMOVEFLG of IMAGEDATA) - (* ; "likewise for position") - (\SETPOS.PSC STREAM IMAGEDATA] - (POSTSCRIPT.OUTSTR STREAM STRING))) + (POSTSCRIPT.SHOWACCUM STREAM) + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch POSTSCRIPTRIGHTMARGIN of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch POSTSCRIPTX of IMAGEDATA) + CHARWID] + [COND + ((NOT (ffetch POSTSCRIPTCHARSTOSHOW of IMAGEDATA)) + (COND + ((ffetch POSTSCRIPTPENDINGXFORM of IMAGEDATA) + (\SETXFORM.PSC STREAM IMAGEDATA))) + (COND + ((ffetch POSTSCRIPTFONTCHANGEDFLG of IMAGEDATA) + (* ; + "If font was changed then switch before printing") + (\SWITCHFONTS.PSC STREAM IMAGEDATA))) + (COND + ((ffetch POSTSCRIPTMOVEFLG of IMAGEDATA) + (* ; "likewise for position") + (\SETPOS.PSC STREAM IMAGEDATA] + (POSTSCRIPT.OUTSTR STREAM STRING))) ) ) @@ -4106,14 +4107,14 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RPAQ \POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK "Always ask whether to print in Landscape or Portrait Orientation" - ) - ("Landscape" T + ) + ("Landscape" T "Default printing to Landscape Orientation" - ) - ("Portrait" 'NIL + ) + ("Portrait" 'NIL "Default printing to Portrait Orientation" - )) - TITLE _ "Default Orientation" CENTERFLG _ T)) + )) + TITLE _ "Default Orientation" CENTERFLG _ T)) (RPAQ PS.BITMAPARRAY (READARRAY-FROM-LIST 16 (QUOTE BYTE) 0 (QUOTE (48 49 50 51 52 53 54 55 56 57 65 66 67 68 69 70 NIL)))) @@ -4235,11 +4236,11 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen " pop pop moveto end } def " "%%%%EndProlog" "%%%%BeginSetup")) (RPAQQ SlopeMenuItems ((Italic 'ITALIC "This is an Italic Slope font") - (Regular 'REGULAR "This is a Regular Slope font"))) + (Regular 'REGULAR "This is a Regular Slope font"))) (RPAQQ WeightMenuItems ((Bold 'BOLD "This is a Bold Weight font") - (Medium 'MEDIUM "This is a Medium Weight font") - (Light 'LIGHT "This is a Light Weight font"))) + (Medium 'MEDIUM "This is a Medium Weight font") + (Light 'LIGHT "This is a Light Weight font"))) (ADDTOVAR BackgroundMenuCommands ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE (MENU @@ -4283,9 +4284,9 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (RPAQ? POSTSCRIPT.TEXTURE.SCALE 4) (RPAQ? POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) - 'MAIKO) - "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") - (T "{DSK}POSTSCRIPT>")))) + 'MAIKO) + "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") + (T "{DSK}POSTSCRIPT>")))) (RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE 72) (DEFINEQ @@ -4310,36 +4311,36 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen ) (ADDTOVAR PRINTERTYPES ((POSTSCRIPT) - (CANPRINT (POSTSCRIPT)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION - TITLE)))) + (CANPRINT (POSTSCRIPT)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION + TITLE)))) (ADDTOVAR POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) - (HELVETICAD . HELVETICA) - (TIMESROMAN . TIMES) - (TIMESROMAND . TIMES) - (COURIER . COURIER) - (GACHA . COURIER) - (CLASSIC . NEWCENTURYSCHLBK) - (MODERN . HELVETICA) - (CREAM . HELVETICA) - (TERMINAL . COURIER) - (LOGO . HELVETICA) - (OPTIMA . PALATINO) - (TITAN . COURIER)) + (HELVETICAD . HELVETICA) + (TIMESROMAN . TIMES) + (TIMESROMAND . TIMES) + (COURIER . COURIER) + (GACHA . COURIER) + (CLASSIC . NEWCENTURYSCHLBK) + (MODERN . HELVETICA) + (CREAM . HELVETICA) + (TERMINAL . COURIER) + (LOGO . HELVETICA) + (OPTIMA . PALATINO) + (TITAN . COURIER)) (ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) - (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT)))) + (EXTENSION (PS PSC PSF)) + (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT)))) (ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC))) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) (RPAQ? POSTSCRIPT.PAGETYPE 'LETTER) @@ -4351,14 +4352,14 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen (APPENDTOVAR POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2)) - (LEGAL (0 0 8.5 14) - NIL - (-0.1 -0.1 8.7 14.2)) - (NOTE (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2))) + NIL + (-0.1 -0.1 8.7 11.2)) + (LEGAL (0 0 8.5 14) + NIL + (-0.1 -0.1 8.7 14.2)) + (NOTE (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST @@ -4386,38 +4387,38 @@ Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documen "Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets" 1989 1990 1991 1992 1993 1994 1995 1997 1998 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (22629 29733 (POSTSCRIPT.INIT 22639 . 29731)) (30777 65561 (PSCFONT.READFONT 30787 . -32695) (PSCFONT.SPELLFILE 32697 . 33275) (PSCFONT.COERCEFILE 33277 . 34849) ( -PSCFONTFROMCACHE.SPELLFILE 34851 . 35836) (PSCFONTFROMCACHE.COERCEFILE 35838 . 37490) ( -PSCFONT.WRITEFONT 37492 . 38507) (READ-AFM-FILE 38509 . 44380) (CONVERT-AFM-FILES 44382 . 45594) ( -POSTSCRIPT.GETFONTID 45596 . 46991) (POSTSCRIPT.FONTCREATE 46993 . 59392) ( -\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 59394 . 61791) (POSTSCRIPT.FONTSAVAILABLE 61793 . 65559)) (66110 -75256 (OPENPOSTSCRIPTSTREAM 66120 . 74922) (CLOSEPOSTSCRIPTSTREAM 74924 . 75254)) (75301 81122 ( -POSTSCRIPT.HARDCOPYW 75311 . 78660) (POSTSCRIPT.TEDIT 78662 . 79142) (POSTSCRIPT.TEXT 79144 . 79435) ( -POSTSCRIPTFILEP 79437 . 80073) (MAKEEPSFILE 80075 . 81120)) (81123 126009 (POSTSCRIPT.BITMAPSCALE -81133 . 83589) (POSTSCRIPT.CLOSESTRING 83591 . 84125) (POSTSCRIPT.ENDPAGE 84127 . 84998) ( -POSTSCRIPT.OUTSTR 85000 . 86021) (POSTSCRIPT.PUTBITMAPBYTES 86023 . 94494) (POSTSCRIPT.PUTCOMMAND -94496 . 95545) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95547 . 100995) (POSTSCRIPT.SHOWACCUM 100997 . 103235) ( -POSTSCRIPT.STARTPAGE 103237 . 105816) (\POSTSCRIPTTAB 105818 . 106689) (\PS.BOUTFIXP 106691 . 108041) -(\PS.SCALEHACK 108043 . 110872) (\PS.SCALEREGION 110874 . 111434) (\SCALEDBITBLT.PSC 111436 . 115736) -(\SETPOS.PSC 115738 . 116200) (\SETXFORM.PSC 116202 . 118021) (\STRINGWIDTH.PSC 118023 . 118477) ( -\SWITCHFONTS.PSC 118479 . 124636) (\TERPRI.PSC 124638 . 126007)) (126044 181764 (\BITBLT.PSC 126054 . -126607) (\BLTSHADE.PSC 126609 . 130891) (\CHARWIDTH.PSC 130893 . 131660) (\CREATECHARSET.PSC 131662 . -133360) (\DRAWARC.PSC 133362 . 135842) (\DRAWCIRCLE.PSC 135844 . 138253) (\DRAWCURVE.PSC 138255 . -142276) (\DRAWELLIPSE.PSC 142278 . 144755) (\DRAWLINE.PSC 144757 . 147107) (\DRAWPOINT.PSC 147109 . -147697) (\DRAWPOLYGON.PSC 147699 . 150813) (\DSPBOTTOMMARGIN.PSC 150815 . 151380) ( -\DSPCLIPPINGREGION.PSC 151382 . 152825) (\DSPCOLOR.PSC 152827 . 153668) (\DSPFONT.PSC 153670 . 157880) - (\DSPLEFTMARGIN.PSC 157882 . 158451) (\DSPLINEFEED.PSC 158453 . 159029) (\DSPPUSHSTATE.PSC 159031 . -160794) (\DSPPOPSTATE.PSC 160796 . 163305) (\DSPRESET.PSC 163307 . 163953) (\DSPRIGHTMARGIN.PSC 163955 - . 164527) (\DSPROTATE.PSC 164529 . 165552) (\DSPSCALE.PSC 165554 . 166485) (\DSPSCALE2.PSC 166487 . -167306) (\DSPSPACEFACTOR.PSC 167308 . 168280) (\DSPTOPMARGIN.PSC 168282 . 168999) (\DSPTRANSLATE.PSC -169001 . 171575) (\DSPXPOSITION.PSC 171577 . 172176) (\DSPYPOSITION.PSC 172178 . 172750) ( -\FILLCIRCLE.PSC 172752 . 175398) (\FILLPOLYGON.PSC 175400 . 179316) (\FIXLINELENGTH.PSC 179318 . -180812) (\MOVETO.PSC 180814 . 181565) (\NEWPAGE.PSC 181567 . 181762)) (181820 204972 ( -\POSTSCRIPT.CHANGECHARSET 181830 . 182634) (\POSTSCRIPT.OUTCHARFN 182636 . 195493) ( -\POSTSCRIPT.PRINTSLUG 195495 . 197462) (\POSTSCRIPT.SPECIALOUTCHARFN 197464 . 199896) (\UPDATE.PSC -199898 . 201121) (\POSTSCRIPT.ACCENTFN 201123 . 202065) (\POSTSCRIPT.ACCENTPAIR 202067 . 204970)) ( -205070 206715 (\PSC.SPACEDISP 205080 . 205359) (\PSC.SPACEWID 205361 . 205980) (\PSC.SYMBOLS 205982 . -206713)) (206824 209815 (\POSTSCRIPT.NSHASH 206834 . 209813)) (254855 255569 (POSTSCRIPTSEND 254865 . -255567))))) + (FILEMAP (NIL (22912 30016 (POSTSCRIPT.INIT 22922 . 30014)) (30996 65780 (PSCFONT.READFONT 31006 . +32914) (PSCFONT.SPELLFILE 32916 . 33494) (PSCFONT.COERCEFILE 33496 . 35068) ( +PSCFONTFROMCACHE.SPELLFILE 35070 . 36055) (PSCFONTFROMCACHE.COERCEFILE 36057 . 37709) ( +PSCFONT.WRITEFONT 37711 . 38726) (READ-AFM-FILE 38728 . 44599) (CONVERT-AFM-FILES 44601 . 45813) ( +POSTSCRIPT.GETFONTID 45815 . 47210) (POSTSCRIPT.FONTCREATE 47212 . 59611) ( +\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 59613 . 62010) (POSTSCRIPT.FONTSAVAILABLE 62012 . 65778)) (66335 +75659 (OPENPOSTSCRIPTSTREAM 66345 . 75147) (CLOSEPOSTSCRIPTSTREAM 75149 . 75657)) (75704 81525 ( +POSTSCRIPT.HARDCOPYW 75714 . 79063) (POSTSCRIPT.TEDIT 79065 . 79545) (POSTSCRIPT.TEXT 79547 . 79838) ( +POSTSCRIPTFILEP 79840 . 80476) (MAKEEPSFILE 80478 . 81523)) (81526 126412 (POSTSCRIPT.BITMAPSCALE +81536 . 83992) (POSTSCRIPT.CLOSESTRING 83994 . 84528) (POSTSCRIPT.ENDPAGE 84530 . 85401) ( +POSTSCRIPT.OUTSTR 85403 . 86424) (POSTSCRIPT.PUTBITMAPBYTES 86426 . 94897) (POSTSCRIPT.PUTCOMMAND +94899 . 95948) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95950 . 101398) (POSTSCRIPT.SHOWACCUM 101400 . 103638) ( +POSTSCRIPT.STARTPAGE 103640 . 106219) (\POSTSCRIPTTAB 106221 . 107092) (\PS.BOUTFIXP 107094 . 108444) +(\PS.SCALEHACK 108446 . 111275) (\PS.SCALEREGION 111277 . 111837) (\SCALEDBITBLT.PSC 111839 . 116139) +(\SETPOS.PSC 116141 . 116603) (\SETXFORM.PSC 116605 . 118424) (\STRINGWIDTH.PSC 118426 . 118880) ( +\SWITCHFONTS.PSC 118882 . 125039) (\TERPRI.PSC 125041 . 126410)) (126447 182167 (\BITBLT.PSC 126457 . +127010) (\BLTSHADE.PSC 127012 . 131294) (\CHARWIDTH.PSC 131296 . 132063) (\CREATECHARSET.PSC 132065 . +133763) (\DRAWARC.PSC 133765 . 136245) (\DRAWCIRCLE.PSC 136247 . 138656) (\DRAWCURVE.PSC 138658 . +142679) (\DRAWELLIPSE.PSC 142681 . 145158) (\DRAWLINE.PSC 145160 . 147510) (\DRAWPOINT.PSC 147512 . +148100) (\DRAWPOLYGON.PSC 148102 . 151216) (\DSPBOTTOMMARGIN.PSC 151218 . 151783) ( +\DSPCLIPPINGREGION.PSC 151785 . 153228) (\DSPCOLOR.PSC 153230 . 154071) (\DSPFONT.PSC 154073 . 158283) + (\DSPLEFTMARGIN.PSC 158285 . 158854) (\DSPLINEFEED.PSC 158856 . 159432) (\DSPPUSHSTATE.PSC 159434 . +161197) (\DSPPOPSTATE.PSC 161199 . 163708) (\DSPRESET.PSC 163710 . 164356) (\DSPRIGHTMARGIN.PSC 164358 + . 164930) (\DSPROTATE.PSC 164932 . 165955) (\DSPSCALE.PSC 165957 . 166888) (\DSPSCALE2.PSC 166890 . +167709) (\DSPSPACEFACTOR.PSC 167711 . 168683) (\DSPTOPMARGIN.PSC 168685 . 169402) (\DSPTRANSLATE.PSC +169404 . 171978) (\DSPXPOSITION.PSC 171980 . 172579) (\DSPYPOSITION.PSC 172581 . 173153) ( +\FILLCIRCLE.PSC 173155 . 175801) (\FILLPOLYGON.PSC 175803 . 179719) (\FIXLINELENGTH.PSC 179721 . +181215) (\MOVETO.PSC 181217 . 181968) (\NEWPAGE.PSC 181970 . 182165)) (182223 205375 ( +\POSTSCRIPT.CHANGECHARSET 182233 . 183037) (\POSTSCRIPT.OUTCHARFN 183039 . 195896) ( +\POSTSCRIPT.PRINTSLUG 195898 . 197865) (\POSTSCRIPT.SPECIALOUTCHARFN 197867 . 200299) (\UPDATE.PSC +200301 . 201524) (\POSTSCRIPT.ACCENTFN 201526 . 202468) (\POSTSCRIPT.ACCENTPAIR 202470 . 205373)) ( +205473 207118 (\PSC.SPACEDISP 205483 . 205762) (\PSC.SPACEWID 205764 . 206383) (\PSC.SYMBOLS 206385 . +207116)) (207227 210218 (\POSTSCRIPT.NSHASH 207237 . 210216)) (254693 255407 (POSTSCRIPTSEND 254703 . +255405))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index f41c947a45e2183f232c47ac0eea3d28cc179820..bf3a121e359188d0dbf053eaea242e9aab15fe9e 100644 GIT binary patch delta 3655 zcma(Udr;Kpah8YRPe2iQgM1tycPPi*aU5{SCaKeDCz@z7eI;$xNhgWTWSrD#G?TX4RPjlC5XA>d_uIpUY3#K3$L??U z+ud&;-+tfTcmEW7>saiwwJmIEqseDwT8&DQls3D=YW7-9eyfEkbo$bkEyJZcjjo(& z^+tWQQD328O2yid4WolYp#e5B%oJ>_v(0L8SOec&DL;VhC(Bh#Qs~O(XjT|2v__3a z!NQ?`Yla>l4R0zkGPA?wv$|bAzt8NoyZt^t?%l=)(XOrC;b3#^sMTr(8whU3eIL0& zg+hh?ulU~q{HMcAS5Z}6t!GB7#qKX{46yKq$CzX^H=CSIR$r;##gsOu@6oQRn9=RE zcGz9*zETTj4U;xEbe&Oy(Hj&@`eM_e!TxYC{PnuosO7|{1kk;a74=6OqEF;d;sC-co)KBh!x!cCU&lOIS?}lVtydP& z{)7SY)Hq3L{9e6JBGnF5#0$UV* zpS~_E?F@iPe)>ic${o0YY2lt#P=bVZ63q%CN8Uf#GW*GUSA$+cS368zA5%)Q=kwqK z$?mlKBMk28hAjEy=d}-2+ixbzAKgpY-2*Xl;ATGB9lI%Z-P;39j=Hr18D+QnCCOy5 z%vz}L19p4xQIlDe0!E(~#YIu~S9{0@U`v9siReDn6_Z}%(!H)vu@X;u!Mo|Om9AHoL zgm}OP=izu-`#6Fc<^xuW|8zbvC5cYcumsqJ{Deenh6S{?cLA+I0vQV?5c9nVDoZ5O z(+QBtUrhw;dp?y&0=-EPMCwQqQN;@h?N|tSNciQ2#T-%qCk;w>JRZNzT6jM42ltg`BNg~&jJ@t!QM20bID39w3PMXIgMk?;nW2gq zs`36{;-wOM&A#aq*VFmVYOtdC$!ZV}k-|vH`Hm6rUgmBi==hWo@CD$7HI(&jHTdvJ z{Adl}gUr)bf_TeKMWv{t3~j3ee8c(aIx0+KJ;k-V zp1S{ZJ#^w)WdpR#lN5}xF@C%Ol>D^@$inN&1j-~0TOZoYv@AFIx#+b;4hD?q-E21MFs=eb0FI{-CEUbvCV4+bEY53d3-)BN`tEq=Cr z7*1&7jeT`Bco))JAP(0w9F3J z_3}|~X0#TWL*0;%R(Etm;lnlVUIn?aqIo6$NjF6u+e2;J+Cu>j_t44vLl2#&gkDgh zg^I|SH)q8O(!+fM2qwQ3SH_<#UDkwDKqpRGERPAA=& zJ?GwYfA^f^7g>D%mSVwLza-v!yTBpfl)2gU)Oy zHW%pCqDI}>ziFVSHyjfC`$V-Ey}i<3`&>z2C_Ff1c_ui}8|<^V`a6TYmQCSMZ}?eb zUV){%XLGL7v&eOj^1NRAq<4L>*<>;sb?9v{{2%w>tpkHYnP#!YZD@P38j3@tYS6bVqK%2UVb!k2%t#x}U<|lBYBV`NYW;@-0VVzMwJc z#R^YA!lH;~yT>K!6|EICqP|d6XW~y94C1N{s13Kog*DLc+|IVaLmVN zRZ&_|lOwKMCkk@LO+LQ!<|>qL-RzW?UW%91W1LI>*hZ8ejo~=!D};1e8m~sf&&Rp> z!FVUiwl4!HXD93DN$AQmktna6(4oaM!705p!Cl8sa=C4iC%n?0DvwXbVrzDid*S_O zr)nOyE=`s4)~z7QVUm3O($su8;QQp0uRVC0TOYVlrqA&FcFgcP zSntQnV>2FXS-#3f+4WUdgdobhXIIDvW*7ahKTh~2$PD?|Y<_%;*W;J`HlNcgRazyh zsKe#CJeMpd&Y5Gp9;aKf`!H2OUO(5sUWtGu805rULmYmP#K(sBWI>~ReJ&15WndWq zse2AWahzy0Jpr16Ms@*!qfG4k5s=EZ0*9H39*42_0iBhSvjX|zTq?6ia8#k;2^5lP zO3)W*@h58P10KmP3WY^lt-w_CAe1PGd7@-*lF*>BR#r+LTq#l3ja0Kw=0O~0@xq9g z70w40HpfQXY~Or{=j%To_%2pO0P|*0i*7|yRcr1-2E&v-QA+QY# zU>E`aSU|IE3jvQA+rJR-{Ic1FfNRe}i)ieOq6|^M_u!r=GR{QNR&0+3Jap`2G>vIu zXlz#ujZMXnGyh^T9#>R`K(5CYLlQe60G@L;DiFXM3wS8l;aKV=#gQ701KeHgLLAX6 zT0)T5mvA3@mlC3TDcMdfB?fDkk=nJ4#_lMpHJ@2RJe7KHrqaB~H1g7`sJ|-8ypqQDuOy%I(#cskoiaL;P7@3wLH3FS zc_5OpBZJhb42qDWCh{+;2|1=Fq<f6k*yxV?iVJ{%j;?S`!&}E9$PIHWrZaWC1_J>Yl#M;qJj;Z)X@A zcy;pQZ7Br&Lb6v2DJrT}@|p2`dEbN(f#0sEFF6;)tYjCOVX>Sw9?Q-?4gAvjy4#2E z-q9jr+RSPjz>Av#1w?p^zHCMcl}etdNR;LMt70G*x2n6D#m* zF1~_N+E_tJ{Go!*Y_g4V*Rht`I;)i|E7v&FRG@bo2$WukXNfIz(1?0Jmn5L60(CTao+)WGqPGISWvy_q#ZEf z1bo-9vKn&zN*&%7hibryru#KuLseP}W>i~iX}_JXCFZMKr1}(f%tf_LtpmJonN$Y> ztfr<#U&!960Xw@@$L}*1>83UAaufU0Zu+EUd1(K>V=rFs5( zTE}14lW~EMkZnGy*-@Wzi2Q)pIkWg_Iey@$1h4sNsf`lgYlHPj)H^HzzFOF{M0G6< z5b_rRS}F{~^R_ooLAN!4bD^N#(iaL3vWo%8VAmUHbEGtY7Gb(ZTIOAiRNKpqfbT+< z(L@e+Hh~&@2b+l9;%4I7(aej5FSXTdw3#+c)_P9nzr4UqsSj^Nu_D;{O!r_vGN}vq zZ4up07oO4s8z2os{BZ-Q(*6x>@%r;5d!5(n^I4l+b~ipE5IM1dmaL=&GH}91MGd#W z>W5cunXI2o?w?O{SM0g1^^BOMj^iLNS8P6Yx3l)q~VL?Yvy_m3wOt^l3W;!20n?Zq~ax7p{cc1ZZTdbg|-@F^s) N--Vz!Qosrd{{k^-4o(07 From 58196b4011e72113e1115954191e71da1a62d5cd Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 24 Jun 2023 15:49:31 -0700 Subject: [PATCH 03/37] HARDCOPY: fixes printer menu --- sources/HARDCOPY | 141 ++++++++++++++++++++++++------------------ sources/HARDCOPY.LCOM | Bin 47158 -> 47249 bytes 2 files changed, 80 insertions(+), 61 deletions(-) diff --git a/sources/HARDCOPY b/sources/HARDCOPY index f252f932..09eaff6e 100644 --- a/sources/HARDCOPY +++ b/sources/HARDCOPY @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Oct-2022 18:47:42" {DSK}larry>ilisp>medley>sources>HARDCOPY.;2 103854 +(FILECREATED "22-Jun-2023 17:31:38" {WMEDLEY}HARDCOPY.;11 104907 - :CHANGES-TO (FNS HARDCOPYIMAGEW.TOPRINTER) + :EDIT-BY rmk - :PREVIOUS-DATE "20-Jul-2022 17:14:14" {DSK}larry>ilisp>medley>sources>HARDCOPY.;1) + :CHANGES-TO (FNS MakeMenuOfPrinters) + + :PREVIOUS-DATE " 3-Mar-2023 23:49:09" {WMEDLEY}HARDCOPY.;10) (* ; " @@ -46,7 +48,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (INITVARS (TEXTDEFAULTTABS (LIST 20320)) (TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765))) (* ; - "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches") + "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") (GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION) (FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE)) (COMS (FNS \BLTSHADE.GENERICPRINTER) @@ -62,7 +64,9 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. \HDCPYDSPPRINTCHAR \SLOWHDCPYBLTCHAR \CHANGECHARSET.HDCPYDISPLAY) [DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) - (IMICASPERPT 35] + (IMICASPERPT 35) + (DEFAULTTAB 36] + (* ; "screen-points: 1/2 inch") (DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT] [COMS (* ; @@ -168,20 +172,24 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (DEFINEQ (MakeMenuOfPrinters - [LAMBDA (MENUTITLE) (* ; "Edited 29-May-93 14:18 by rmk:") - (* ; "Edited 11-Jul-90 13:35 by jds") + [LAMBDA (MENUTITLE) (* ; "Edited 22-Jun-2023 17:30 by rmk") + (* ; "Edited 29-May-93 14:18 by rmk:") + (* ; "Edited 11-Jul-90 13:35 by jds") (DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) (CREATE MENU ITEMS _ (APPEND (FOR P INSIDE DEFAULTPRINTINGHOST COLLECT (LIST (COND - ((LISTP P) - (IF (CADDR P) - THEN (CONCAT (CADR P) - " " - (CADDR P)) - ELSE (CADR P))) - (T P)) - (KWOTE P))) + ((LISTP P) + (IF (CADDR P) + THEN (CONCAT (CADR P) + " " + (CADDR P)) + ELSE (CADR P))) + (T (CL:IF (OR (NULL P) + (ZEROP (NCHARS P))) + "(Default printer)" + P))) + (KWOTE P))) (LIST (LIST "Other..." (KWOTE 'OTHER) "You will be prompted for a printer"))) TITLE _ MENUTITLE @@ -686,7 +694,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. -(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches") +(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -729,7 +737,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (CLOSEF IMAGESTREAM])]) (COPY.TEXT.TO.IMAGE - [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 20-Jul-2022 17:14 by rmk") + [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 3-Mar-2023 23:46 by rmk") + (* ; "Edited 20-Jul-2022 17:14 by rmk") (* ; "Edited 8-Oct-2021 22:23 by rmk:") (* ; "Edited 10-Apr-95 21:23 by rmk:") @@ -741,7 +750,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (FONTARRAY (FONTMAPARRAY FONTS)) (MAXFONT (ARRAYSIZE FONTARRAY)) (INSTRM (GETSTREAM INFILE 'INPUT)) - DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP] + DEFTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP] (* ;;  "RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch") @@ -775,17 +784,19 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (\OUTCHAR IMAGESTREAM (CHARCODE ^T)) (RETURN)) - (* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream. Should really be a property of the stream or imagetype, or defined in terms of standard scale") + (* ;; "DEFAULTTAB is now a constant defined here as 36 = 1/2 inch. Maybe that should be scaled by the stream's scale factor vis a vis points, not related to the current font. If you are tabbing for alignment, you wouldn't want it to be ragged based on what font one line is in compare to another. TEXTDEFAULTTAB is a hack that should be removed.") [SETQ FC (IF TABS THEN (OR (CAR (NTH TABS FC)) (ERROR "Undefined absolute tab number" FC)) - ELSE (TIMES FC (OR DEFAULTTAB - (SETQ DEFAULTTAB - (TIMES 8 (CHARWIDTH (CHARCODE SPACE) - (FONTCREATE (ELT FONTARRAY 1) - NIL NIL NIL IMAGESTREAM] + ELSE (TIMES FC (OR DEFTAB (SETQ DEFTAB + (TIMES 8 + (CHARWIDTH (CHARCODE SPACE) + (FONTCREATE (ELT FONTARRAY + 1) + NIL NIL NIL + IMAGESTREAM] (DSPXPOSITION FC IMAGESTREAM)) (NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F)) (* ; "EOS after ^F") @@ -912,15 +923,23 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (RPAQQ IMICASPERPT 35) +(RPAQQ DEFAULTTAB 36) + (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) - (IMICASPERPT 35)) + (IMICASPERPT 35) + (DEFAULTTAB 36)) ) (* "END EXPORTED DEFINITIONS") ) + + + +(* ; "screen-points: 1/2 inch") + (DECLARE%: DONTCOPY DOEVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED") (DEFMACRO \MICASTOPTS (MICAS) @@ -1083,40 +1102,40 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1999 2018 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6168 10934 (HARDCOPY.SOMEHOW 6178 . 7536) (HARDCOPYIMAGEW 7538 . 7690) ( -HARDCOPYIMAGEW.TOFILE 7692 . 8000) (HARDCOPYIMAGEW.TOPRINTER 8002 . 9249) (HARDCOPYREGION.TOFILE 9251 - . 9549) (HARDCOPYREGION.TOPRINTER 9551 . 10173) (COPY.WINDOW.TO.BITMAP 10175 . 10932)) (11006 21556 ( -MakeMenuOfPrinters 11016 . 12241) (PRINTERS.WHENSELECTEDFN 12243 . 13985) (MakeMenuOfImageTypes 13987 - . 14505) (GetNewPrinterFromUser 14507 . 14935) (PopUpWindowAndGetAtom 14937 . 16322) ( -PopUpWindowAndGetList 16324 . 17890) (NewPrinter 17892 . 18840) (GetPrinterName 18842 . 19122) ( -GetImageFile 19124 . 21411) (FetchDefaultPrinter 21413 . 21554)) (21591 22129 ( -ExtensionForPrintFileType 21601 . 21794) (PRINTFILETYPE.FROM.EXTENSION 21796 . 22127)) (22184 38568 ( -DEFAULTPRINTER 22194 . 22354) (CAN.PRINT.DIRECTLY 22356 . 22512) (CONVERT.FILE.TO.TYPE.FOR.PRINTER -22514 . 23558) (EMPRESS 23560 . 23873) (HARDCOPYW 23875 . 26835) (LISTFILES1 26837 . 27010) ( -PRINTER.BITMAPFILE 27012 . 27259) (PRINTER.BITMAPSCALE 27261 . 27526) (PRINTER.SCRATCH.FILE 27528 . -27651) (PRINTERPROP 27653 . 27836) (PRINTERSTATUS 27838 . 28027) (PRINTERTYPE 28029 . 30338) ( -PRINTERNAME 30340 . 30642) (PRINTFILEPROP 30644 . 30835) (PRINTFILETYPE 30837 . 32781) ( -\EXPECTED.FILE.TYPE 32783 . 33565) (SEND.FILE.TO.PRINTER 33567 . 38566)) (38569 43551 (PRINTERDEVICE -38579 . 43549)) (44366 52124 (TEXTTOIMAGEFILE 44376 . 46566) (COPY.TEXT.TO.IMAGE 46568 . 52122)) ( -52125 53260 (\BLTSHADE.GENERICPRINTER 52135 . 53258)) (53388 72140 (MAKEHARDCOPYSTREAM 53398 . 54402) -(UNMAKEHARDCOPYSTREAM 54404 . 55088) (HARDCOPYSTREAMTYPE 55090 . 55369) (\CHARWIDTH.HDCPYDISPLAY 55371 - . 55802) (\DSPFONT.HDCPYDISPLAY 55804 . 57209) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57211 . 57788) ( -\DSPXPOSITION.HDCPYDISPLAY 57790 . 58051) (\DSPYPOSITION.HDCPYDISPLAY 58053 . 58314) ( -\STRINGWIDTH.HDCPYDISPLAY 58316 . 58823) (\STRINGWIDTH.HCPYDISPLAYAUX 58825 . 61157) (\HDCPYBLTCHAR -61159 . 63694) (\HDCPYDISPLAY.FIX.XPOS 63696 . 64116) (\HDCPYDISPLAY.FIX.YPOS 64118 . 64538) ( -\HDCPYDISPLAYINIT 64540 . 65317) (\HDCPYDSPPRINTCHAR 65319 . 67479) (\SLOWHDCPYBLTCHAR 67481 . 70984) -(\CHANGECHARSET.HDCPYDISPLAY 70986 . 72138)) (72550 72691 (\MICASTOPTS 72550 . 72691)) (72862 103159 ( -MAKEHARDCOPYMODESTREAM 72872 . 74781) (UNMAKEHARDCOPYMODESTREAM 74783 . 75861) (\BLTSHADE.HCPYMODE -75863 . 76310) (\BITBLT.HCPYMODE 76312 . 76934) (\BRUSHCONVERT.HCPYMODE 76936 . 77173) ( -\CHANGECHARSET.HCPYMODE 77175 . 78942) (\DASHINGCONVERT.HCPYMODE 78944 . 79207) (\CHARWIDTH.HCPYMODE -79209 . 79496) (\DRAWLINE.HCPYMODE 79498 . 79810) (\DRAWCURVE.HCPYMODE 79812 . 80241) ( -\DRAWCIRCLE.HCPYMODE 80243 . 80638) (\DRAWELLIPSE.HCPYMODE 80640 . 81152) (\DSPFONT.HCPYMODE 81154 . -82310) (\DSPLEFTMARGIN.HCPYMODE 82312 . 82896) (\DSPLINEFEED.HCPYMODE 82898 . 83308) ( -\DSPRIGHTMARGIN.HCPYMODE 83310 . 83939) (\DSPSPACEFACTOR.HCPYMODE 83941 . 84462) ( -\DSPXPOSITION.HCPYMODE 84464 . 85045) (\DSPYPOSITION.HCPYMODE 85047 . 85452) (\MOVETO.HCPYMODE 85454 - . 85606) (\FONTCREATE.HCPYMODE.PRESS 85608 . 86620) (\CREATECHARSET.HCPYMODE.PRESS 86622 . 87593) ( -\FONTCREATE.HCPYMODE.INTERPRESS 87595 . 88629) (\CREATECHARSET.HCPYMODE.INTERPRESS 88631 . 89619) ( -\STRINGWIDTH.HCPYMODE 89621 . 90055) (\HCPYMODEBLTCHAR 90057 . 93026) (\HCPYMODEDISPLAYINIT 93028 . -95959) (\HCPYMODEDSPPRINTCHAR 95961 . 98142) (\SLOWHCPYMODEBLTCHAR 98144 . 101658) (\SFFixY.HCPYMODE -101660 . 103157))))) + (FILEMAP (NIL (6322 11088 (HARDCOPY.SOMEHOW 6332 . 7690) (HARDCOPYIMAGEW 7692 . 7844) ( +HARDCOPYIMAGEW.TOFILE 7846 . 8154) (HARDCOPYIMAGEW.TOPRINTER 8156 . 9403) (HARDCOPYREGION.TOFILE 9405 + . 9703) (HARDCOPYREGION.TOPRINTER 9705 . 10327) (COPY.WINDOW.TO.BITMAP 10329 . 11086)) (11160 22017 ( +MakeMenuOfPrinters 11170 . 12702) (PRINTERS.WHENSELECTEDFN 12704 . 14446) (MakeMenuOfImageTypes 14448 + . 14966) (GetNewPrinterFromUser 14968 . 15396) (PopUpWindowAndGetAtom 15398 . 16783) ( +PopUpWindowAndGetList 16785 . 18351) (NewPrinter 18353 . 19301) (GetPrinterName 19303 . 19583) ( +GetImageFile 19585 . 21872) (FetchDefaultPrinter 21874 . 22015)) (22052 22590 ( +ExtensionForPrintFileType 22062 . 22255) (PRINTFILETYPE.FROM.EXTENSION 22257 . 22588)) (22645 39029 ( +DEFAULTPRINTER 22655 . 22815) (CAN.PRINT.DIRECTLY 22817 . 22973) (CONVERT.FILE.TO.TYPE.FOR.PRINTER +22975 . 24019) (EMPRESS 24021 . 24334) (HARDCOPYW 24336 . 27296) (LISTFILES1 27298 . 27471) ( +PRINTER.BITMAPFILE 27473 . 27720) (PRINTER.BITMAPSCALE 27722 . 27987) (PRINTER.SCRATCH.FILE 27989 . +28112) (PRINTERPROP 28114 . 28297) (PRINTERSTATUS 28299 . 28488) (PRINTERTYPE 28490 . 30799) ( +PRINTERNAME 30801 . 31103) (PRINTFILEPROP 31105 . 31296) (PRINTFILETYPE 31298 . 33242) ( +\EXPECTED.FILE.TYPE 33244 . 34026) (SEND.FILE.TO.PRINTER 34028 . 39027)) (39030 44012 (PRINTERDEVICE +39040 . 44010)) (44847 53086 (TEXTTOIMAGEFILE 44857 . 47047) (COPY.TEXT.TO.IMAGE 47049 . 53084)) ( +53087 54222 (\BLTSHADE.GENERICPRINTER 53097 . 54220)) (54350 73102 (MAKEHARDCOPYSTREAM 54360 . 55364) +(UNMAKEHARDCOPYSTREAM 55366 . 56050) (HARDCOPYSTREAMTYPE 56052 . 56331) (\CHARWIDTH.HDCPYDISPLAY 56333 + . 56764) (\DSPFONT.HDCPYDISPLAY 56766 . 58171) (\DSPRIGHTMARGIN.HDCPYDISPLAY 58173 . 58750) ( +\DSPXPOSITION.HDCPYDISPLAY 58752 . 59013) (\DSPYPOSITION.HDCPYDISPLAY 59015 . 59276) ( +\STRINGWIDTH.HDCPYDISPLAY 59278 . 59785) (\STRINGWIDTH.HCPYDISPLAYAUX 59787 . 62119) (\HDCPYBLTCHAR +62121 . 64656) (\HDCPYDISPLAY.FIX.XPOS 64658 . 65078) (\HDCPYDISPLAY.FIX.YPOS 65080 . 65500) ( +\HDCPYDISPLAYINIT 65502 . 66279) (\HDCPYDSPPRINTCHAR 66281 . 68441) (\SLOWHDCPYBLTCHAR 68443 . 71946) +(\CHANGECHARSET.HDCPYDISPLAY 71948 . 73100)) (73603 73744 (\MICASTOPTS 73603 . 73744)) (73915 104212 ( +MAKEHARDCOPYMODESTREAM 73925 . 75834) (UNMAKEHARDCOPYMODESTREAM 75836 . 76914) (\BLTSHADE.HCPYMODE +76916 . 77363) (\BITBLT.HCPYMODE 77365 . 77987) (\BRUSHCONVERT.HCPYMODE 77989 . 78226) ( +\CHANGECHARSET.HCPYMODE 78228 . 79995) (\DASHINGCONVERT.HCPYMODE 79997 . 80260) (\CHARWIDTH.HCPYMODE +80262 . 80549) (\DRAWLINE.HCPYMODE 80551 . 80863) (\DRAWCURVE.HCPYMODE 80865 . 81294) ( +\DRAWCIRCLE.HCPYMODE 81296 . 81691) (\DRAWELLIPSE.HCPYMODE 81693 . 82205) (\DSPFONT.HCPYMODE 82207 . +83363) (\DSPLEFTMARGIN.HCPYMODE 83365 . 83949) (\DSPLINEFEED.HCPYMODE 83951 . 84361) ( +\DSPRIGHTMARGIN.HCPYMODE 84363 . 84992) (\DSPSPACEFACTOR.HCPYMODE 84994 . 85515) ( +\DSPXPOSITION.HCPYMODE 85517 . 86098) (\DSPYPOSITION.HCPYMODE 86100 . 86505) (\MOVETO.HCPYMODE 86507 + . 86659) (\FONTCREATE.HCPYMODE.PRESS 86661 . 87673) (\CREATECHARSET.HCPYMODE.PRESS 87675 . 88646) ( +\FONTCREATE.HCPYMODE.INTERPRESS 88648 . 89682) (\CREATECHARSET.HCPYMODE.INTERPRESS 89684 . 90672) ( +\STRINGWIDTH.HCPYMODE 90674 . 91108) (\HCPYMODEBLTCHAR 91110 . 94079) (\HCPYMODEDISPLAYINIT 94081 . +97012) (\HCPYMODEDSPPRINTCHAR 97014 . 99195) (\SLOWHCPYMODEBLTCHAR 99197 . 102711) (\SFFixY.HCPYMODE +102713 . 104210))))) STOP diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM index fa59fbbe6feefd39fadfdeb781be606d9a11ef7a..ace4369d8e170d5b702c796e511ecb2f70613252 100644 GIT binary patch delta 739 zcmaiy&rcIU6vx}CfGm(`EGi|jFB=0}k}W&4{XrKcEZr>ywm;|(Nr@&l?JCvMl5IH= z17}Z~G4bxj#7MGqg+#q@_o5g73S;nKyou9#P!khgCiCXyz4?6S&CJmWdio7LS=%MD zxV+sEi9}?OBn1;i4)Y-JmFDJFt!`GK*#I7P)>67==%q(DTFq^%Vz%azYEFx1vZdfG z#sT1XLjG`wtb}63qCPr{rV*Z@byVrPPbkBj z!+XA;zx1Ww<#OM3G4uE4i>rNfYPhxQ>0GNK@noFM>})IU^lw+ z;KY$reV)Tf!>GRTR%<7(R$KZBiUC(8*fFn^z$CCqUE)O^?)33uqNh+9pj+fo4VG+|$=vcXfY ZeVx%}>>&N{YK-pLeh%yeI4Ch z!}UV^1A;vLLR^D16|4e+T*Ey5LxXi)fR0g6GBVKhD$Rigrn!}&2@okMaN%)`7}nr3 zoV=Z}fyvl>vL#b8h?>Xb52QA~XZp$^e2$fYfiZyr2;{+}pd-uV@7%?KDa@PX_wV;f zVPaz3B+SH^4^rU+t=}=9540h%=d+Pv+!pU^XRUM$2lBE-ej4I~%<467hlcTaymuE|+z1KBjR6s#4vHXmGD%`{nQ ftMKH84Z@SBY|xwhd5g^CyBlPgL6UzrOkoEAp$5dg From c4554894b3a91fcd615d863080ebb1aaa917307b Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sun, 25 Jun 2023 17:16:27 -0700 Subject: [PATCH 04/37] PDFSTREAM: define PDF fonts as POSTSCRIPT fonts --- library/PDFSTREAM | 18 +++++++++++------- library/PDFSTREAM.LCOM | Bin 4918 -> 5006 bytes 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 24fdd70a..0e786e58 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Jun-2023 15:27:04" {WMEDLEY}PDFSTREAM.;35 12465 +(FILECREATED "25-Jun-2023 16:41:34" {WMEDLEY}PDFSTREAM.;36 12655 :EDIT-BY rmk - :PREVIOUS-DATE "24-Jun-2023 15:01:28" {WMEDLEY}PDFSTREAM.;34) + :CHANGES-TO (FNS PDF-INIT) + + :PREVIOUS-DATE "24-Jun-2023 15:27:04" {WMEDLEY}PDFSTREAM.;35) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -114,12 +116,14 @@ (DEFINEQ (PDF-INIT - [LAMBDA NIL (* ; "Edited 23-Jun-2023 11:23 by rmk") + [LAMBDA NIL (* ; "Edited 25-Jun-2023 16:41 by rmk") + (* ; "Edited 23-Jun-2023 11:23 by rmk") (* ;; "Seems OK to make callers see this as PDF, even though the implementation is postscript. The pdf stream is opened as a temporary postscript stream, and the closefn then uses an operating-system utility to convert it to the original target file-name.") (SETQ \PDFIMAGEOPS (create IMAGEOPS using \POSTSCRIPTIMAGEOPS IMAGETYPE _ 'PDF IMCLOSEFN _ - (FUNCTION CLOSE-PDF-STREAM]) + (FUNCTION CLOSE-PDF-STREAM))) + (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]) (OPEN-PDF-STREAM [LAMBDA (FILE OPTIONS) (* ; "Edited 24-Jun-2023 14:49 by rmk") @@ -222,7 +226,7 @@ (PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2668 5002 (PDFFILEP 2678 . 3592) (PDF.HARDCOPYW 3594 . 4021) (PDF.TEXT 4023 . 4631) ( -PDF.TEDIT 4633 . 5000)) (5378 12426 (PDF-INIT 5388 . 5957) (OPEN-PDF-STREAM 5959 . 8062) ( -CLOSE-PDF-STREAM 8064 . 8979) (PDF-CONVERT 8981 . 12424))))) + (FILEMAP (NIL (2702 5036 (PDFFILEP 2712 . 3626) (PDF.HARDCOPYW 3628 . 4055) (PDF.TEXT 4057 . 4665) ( +PDF.TEDIT 4667 . 5034)) (5412 12616 (PDF-INIT 5422 . 6147) (OPEN-PDF-STREAM 6149 . 8252) ( +CLOSE-PDF-STREAM 8254 . 9169) (PDF-CONVERT 9171 . 12614))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index 2e961a9b83102bacf88ed999d18897340b244af5..8d53ee8000c9f69483c0df611aa1a0b6cde20b23 100644 GIT binary patch delta 284 zcmdm{)~7xpLfBN-t29s7$iT>0!O+ag#L&vvWMZ}flbPnkkD?PdNeBnHxaoTOd4?!t z<|!!oxVbABnNGYbVUDcL(8>UaER;04G~7IWT%Chl9Yb7Q6qJmR6+z6Ntiz~iZ>C^q zWM*orVCCxK8KUbHsZf-gtzhNs;ppe?8mt@Qub{!@<`=90vsqKYDj>);%+o(KSl0z; z@?>#F^UW(5+n5>6C+o9n`K2=e0hr(du>=@2OpO%W{QW`#g8V`5(Q|ZhaRKUgc2zJm lQSgH}&j{#P6LWkc|qPvslmY0stD$MZo|7 delta 194 zcmeBE-=;PpLfAytt29s7$iT>0!O+yo$lS`%aALLrqv^ysdct}6B^jA{=?a;73QBIF zK0XRYCKK;UD4}XGFt#!>QqttoaP#zWbq;cM3~_at+{0*YsbFYiVrHsf Date: Sun, 2 Jul 2023 18:25:41 -0700 Subject: [PATCH 05/37] PDFSTREAM: fix convert template --- library/PDFSTREAM | 17 ++++++++--------- library/PDFSTREAM.LCOM | Bin 5006 -> 4987 bytes 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 0e786e58..48291023 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,12 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Jun-2023 16:41:34" {WMEDLEY}PDFSTREAM.;36 12655 +(FILECREATED " 2-Jul-2023 17:00:18" {WMEDLEY}PDFSTREAM.;37 12671 :EDIT-BY rmk - :CHANGES-TO (FNS PDF-INIT) - - :PREVIOUS-DATE "24-Jun-2023 15:27:04" {WMEDLEY}PDFSTREAM.;35) + :PREVIOUS-DATE "25-Jun-2023 16:41:34" {WMEDLEY}PDFSTREAM.;36) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -105,8 +103,9 @@ (RPAQ? PDFCONVERTER 'ps2pdf) -(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSTMPFILENAME " " PDFTMPFILENAME " 2> " ERRORFILE) - (pstopdf " " PSTMPFILENAME " -o " PDFTMPFILENAME " 2> " ERRORFILE)) +(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSTMPFILENAME " " PDFTMPFILENAME " 2> " ERRORFILENAME) + (pstopdf " " PSTMPFILENAME " -o " PDFTMPFILENAME " 2> " + ERRORFILENAME)) (RPAQQ DEFAULTPRINTERTYPE PDF) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -226,7 +225,7 @@ (PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2702 5036 (PDFFILEP 2712 . 3626) (PDF.HARDCOPYW 3628 . 4055) (PDF.TEXT 4057 . 4665) ( -PDF.TEDIT 4667 . 5034)) (5412 12616 (PDF-INIT 5422 . 6147) (OPEN-PDF-STREAM 6149 . 8252) ( -CLOSE-PDF-STREAM 8254 . 9169) (PDF-CONVERT 9171 . 12614))))) + (FILEMAP (NIL (2668 5002 (PDFFILEP 2678 . 3592) (PDF.HARDCOPYW 3594 . 4021) (PDF.TEXT 4023 . 4631) ( +PDF.TEDIT 4633 . 5000)) (5428 12632 (PDF-INIT 5438 . 6163) (OPEN-PDF-STREAM 6165 . 8268) ( +CLOSE-PDF-STREAM 8270 . 9185) (PDF-CONVERT 9187 . 12630))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index 8d53ee8000c9f69483c0df611aa1a0b6cde20b23..97a1344cf9b7705a55cb49e1c75d5e95e7d68cd7 100644 GIT binary patch delta 224 zcmeBE|E)G5TtvZ0*Q+!~*T}%gSi#WT%D}+N$arG5fs?tW0+*7JB~UUCB57o7WoTw) zVy>i+RFs;WpIeZblbWKCT2W9`tZJo@mtT^RnU}7RnWv!S7V6`pU}QP*u7m}Kep4eQ zO)d>LPajw3AXmo_R~H2(OcxkhOx9&oP&HRDG%_JKXtwzi00+*7J36i9#m4UI9p}CSm zQc-Gher`c#PHKumYDGa&v8t6qfQy^1r=MqtLS~+Vl8>9af|2ROyAsOCh8tQL0Fi}~ zCYOerr;n?1kgH>etBb Date: Mon, 17 Jul 2023 23:04:38 -0700 Subject: [PATCH 06/37] PDFSTREAM: Fix logic around closing the postscript sub-stream --- library/PDFSTREAM | 23 ++++++++++++++--------- library/PDFSTREAM.LCOM | Bin 4987 -> 5072 bytes 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 48291023..d96b6716 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Jul-2023 17:00:18" {WMEDLEY}PDFSTREAM.;37 12671 +(FILECREATED "17-Jul-2023 22:33:21" {WMEDLEY}PDFSTREAM.;38 12982 :EDIT-BY rmk - :PREVIOUS-DATE "25-Jun-2023 16:41:34" {WMEDLEY}PDFSTREAM.;36) + :CHANGES-TO (FNS CLOSE-PDF-STREAM) + + :PREVIOUS-DATE " 2-Jul-2023 17:00:18" {WMEDLEY}PDFSTREAM.;37) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -158,7 +160,8 @@ PSSTREAM]) (CLOSE-PDF-STREAM - [LAMBDA (PSSTREAM) (* ; "Edited 24-Jun-2023 13:57 by rmk") + [LAMBDA (PSSTREAM) (* ; "Edited 17-Jul-2023 22:32 by rmk") + (* ; "Edited 24-Jun-2023 13:57 by rmk") (* ;; "PSSTREAM is a tmp/ postscript rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") @@ -166,9 +169,11 @@ (* ;; "We have to back up to the ordinary POSTSCRIPT close, so that we don't loop through here") - (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) - (PDF-CONVERT (CLOSEF PSSTREAM) - (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) of PSSTREAM]) + (CL:WHEN (EQ \PDFIMAGEOPS (fetch (STREAM IMAGEOPS) of PSSTREAM)) + (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) + (PDF-CONVERT (CLOSEF PSSTREAM) + (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) + of PSSTREAM))))]) (PDF-CONVERT [LAMBDA (PSTMPFILENAME TARGETPDFNAME DONTDELETE) (* ; "Edited 24-Jun-2023 15:01 by rmk") @@ -225,7 +230,7 @@ (PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2668 5002 (PDFFILEP 2678 . 3592) (PDF.HARDCOPYW 3594 . 4021) (PDF.TEXT 4023 . 4631) ( -PDF.TEDIT 4633 . 5000)) (5428 12632 (PDF-INIT 5438 . 6163) (OPEN-PDF-STREAM 6165 . 8268) ( -CLOSE-PDF-STREAM 8270 . 9185) (PDF-CONVERT 9187 . 12630))))) + (FILEMAP (NIL (2710 5044 (PDFFILEP 2720 . 3634) (PDF.HARDCOPYW 3636 . 4063) (PDF.TEXT 4065 . 4673) ( +PDF.TEDIT 4675 . 5042)) (5470 12943 (PDF-INIT 5480 . 6205) (OPEN-PDF-STREAM 6207 . 8310) ( +CLOSE-PDF-STREAM 8312 . 9496) (PDF-CONVERT 9498 . 12941))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index 97a1344cf9b7705a55cb49e1c75d5e95e7d68cd7..dde4ea6f6487716270c554883fd9f388b38c664d 100644 GIT binary patch delta 384 zcmZvX%}T>S6or#b2?1AH++G4|BaCDwu}NlSOeQgsCLuFc1Q$i^qV&fa5qt`<T7dP&a3B59hn*yl*~l-5;-E8y((^5HW}egizC@1kZ*>>gb?qxcy^d zn;L`?SA(;%e||Zh4o3Y8=-*Du>kSHil5vLeAVgdg%}Yb^9>=j~CiR+MeJYr$fOpQT+^2r#WBHLSZ@Hk{@e q7u+x6T+~1hECW6#lXi8bG&O?14*1)$>R1rQ9WP>8&gXZ^tNH=eC}KSN!lVf@X?^5ZCYXl!GT+_bOA1+ z8xdTBV^`qB6a_nQe7^tu=WYLM?`5z9s-8ZKRjN}1#9_M5sIeI7&yE5~rkw^>Kad)X z*vxcfT-U|TbTTW)#Sq2gtiIo6sHXF~vbsfCK@NIRgw0b;(_{><=FR>;r$uE&Itapu zdntEw?nB1%RWv&w)OH9M_rqL0I!8Sjfh8&LhjA}c{bsuMS$~b|K*9`j@dVLcy^ELI zTZ$kE;_{?*I565s{6O{Mvp!FAkT$$1&Un!LHV7_~ILk9H4U@bPyPzhryvgZ;=$kO? Ry2m_DGFZQS_0js2z5zYmS5W`} From 781709e4e1a63577476f4e86d5b42e99596856ce Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Tue, 12 Sep 2023 13:49:56 -0700 Subject: [PATCH 07/37] PDF Stream: slight generalization --- library/PDFSTREAM | 99 +++++++++++++++++++++++------------------ library/PDFSTREAM.LCOM | Bin 5072 -> 5235 bytes 2 files changed, 55 insertions(+), 44 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index d96b6716..aee1b3fd 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Jul-2023 22:33:21" {WMEDLEY}PDFSTREAM.;38 12982 +(FILECREATED "24-Jul-2023 10:37:31" {WMEDLEY}PDFSTREAM.;44 13139 :EDIT-BY rmk - :CHANGES-TO (FNS CLOSE-PDF-STREAM) + :CHANGES-TO (VARS PDFSTREAMCOMS) + (FNS PDF.HARDCOPYW CLOSE-PDF-STREAM PS-TO-PDF PDF-CONVERT) - :PREVIOUS-DATE " 2-Jul-2023 17:00:18" {WMEDLEY}PDFSTREAM.;37) + :PREVIOUS-DATE "19-Jul-2023 09:28:33" {WMEDLEY}PDFSTREAM.;40) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -27,15 +28,18 @@ (FONTCREATE POSTSCRIPT.FONTCREATE) (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) (CREATECHARSET \CREATECHARSET.PSC] - (DECLARE%: EVAL@COMPILE DONTCOPY (FILES EXPORTS.ALL (LOADCOMP) - POSTSCRIPTSTREAM)) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS) + EXPORTS.ALL) + (FILES (LOADCOMP) + POSTSCRIPTSTREAM)) (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) (INITVARS (PDFCONVERTER 'ps2pdf)) (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) (VARS (DEFAULTPRINTERTYPE 'PDF)) (GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) - (FNS PDF-INIT OPEN-PDF-STREAM CLOSE-PDF-STREAM PDF-CONVERT) - (P (PDF-INIT)))) + (FNS PDF-INIT OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF) + (P (MOVD? 'CL:IDENTITY 'TRUEFILENAME) + (PDF-INIT)))) (ADDTOVAR PRINTERTYPES ((PDF) (CANPRINT (PDF)) @@ -55,7 +59,11 @@ (CREATECHARSET \CREATECHARSET.PSC))) (DECLARE%: EVAL@COMPILE DONTCOPY -(FILESLOAD EXPORTS.ALL (LOADCOMP) +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) + + +(FILESLOAD (LOADCOMP) POSTSCRIPTSTREAM) ) (DEFINEQ @@ -81,10 +89,11 @@ (SETFILEPTR FILE 0)))]) (PDF.HARDCOPYW - [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) (* ; "Edited 23-Jun-2023 13:28 by rmk") + [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 23-Jun-2023 13:28 by rmk") (* ; "Edited 6-Mar-2023 22:43 by rmk") (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY FILE))) - (PDF-CONVERT (POSTSCRIPT.HARDCOPYW PSTTMP FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + (PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) FILE]) (PDF.TEXT @@ -105,9 +114,8 @@ (RPAQ? PDFCONVERTER 'ps2pdf) -(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSTMPFILENAME " " PDFTMPFILENAME " 2> " ERRORFILENAME) - (pstopdf " " PSTMPFILENAME " -o " PDFTMPFILENAME " 2> " - ERRORFILENAME)) +(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSFILE " " PDFFILE " 2> " ERRORFILE) + (pstopdf " " PSFILE " -o " PDFFILE " 2> " ERRORFILE)) (RPAQQ DEFAULTPRINTERTYPE PDF) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -160,7 +168,8 @@ PSSTREAM]) (CLOSE-PDF-STREAM - [LAMBDA (PSSTREAM) (* ; "Edited 17-Jul-2023 22:32 by rmk") + [LAMBDA (PSSTREAM) (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 17-Jul-2023 22:32 by rmk") (* ; "Edited 24-Jun-2023 13:57 by rmk") (* ;; "PSSTREAM is a tmp/ postscript rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") @@ -171,25 +180,29 @@ (CL:WHEN (EQ \PDFIMAGEOPS (fetch (STREAM IMAGEOPS) of PSSTREAM)) (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) - (PDF-CONVERT (CLOSEF PSSTREAM) + (RENAMEFILE (PS-TO-PDF (CLOSEF PSSTREAM)) (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) of PSSTREAM))))]) -(PDF-CONVERT - [LAMBDA (PSTMPFILENAME TARGETPDFNAME DONTDELETE) (* ; "Edited 24-Jun-2023 15:01 by rmk") +(PS-TO-PDF + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Jul-2023 22:30 by rmk") + (* ; "Edited 24-Jun-2023 15:01 by rmk") (* ; "Edited 16-Jul-2022 13:06 by rmk") (* ; "Edited 8-Jul-2022 10:20 by rmk") (* ; "Edited 7-May-2022 22:40 by rmk") (* ; "Edited 7-Oct-2021 11:15 by rmk:") - (* ;; "PSTMPFILENAME is the name of a closed PS file in a Unix tmp directory. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to TARGETPDFNAME. ") + (* ;; "PSFILE is the name of a closed PS file on a DSK/UNIX device. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to PDFFILE. ") (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") - (CL:UNLESS (INFILEP PSTMPFILENAME) + (SETQ PSFILE (TRUEFILENAME PSFILE)) + (SETQ PDFFILE (if PDFFILE + then (TRUEFILENAME PDFFILE) + else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE))) + (CL:UNLESS (INFILEP PSFILE) (ERROR "NO PS FILE TO CONVERT")) - (LET ((PDFTMPFILENAME (PACKFILENAME 'EXTENSION 'pdf 'BODY PSTMPFILENAME)) - (ERRORFILENAME (PACKFILENAME 'EXTENSION 'error 'BODY PSTMPFILENAME)) + (LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE)) COMPLETIONCODE) (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") @@ -197,17 +210,13 @@ (* ;; "We have to map the filenames down to Unix conventions: (not host, slashes, etc.") [SETQ COMPLETIONCODE (PROCESS-COMMAND - (CONCATLIST (SUBLIS `[(PSTMPFILENAME \, (SLASHIT (PACKFILENAME - 'HOST NIL - 'BODY PSTMPFILENAME) - )) - (PDFTMPFILENAME \, (SLASHIT (PACKFILENAME - 'HOST NIL - 'BODY - PDFTMPFILENAME))) - (ERRORFILENAME \, (SLASHIT (PACKFILENAME - 'HOST NIL - 'BODY ERRORFILENAME] + (CONCATLIST (SUBLIS `[(PSFILE \, (SLASHIT (PACKFILENAME 'HOST NIL + 'BODY PSFILE))) + (PDFFILE \, (SLASHIT (PACKFILENAME 'HOST NIL + 'BODY PDFFILE))) + (ERRORFILE \, (SLASHIT (PACKFILENAME + 'HOST NIL 'BODY + ERRORFILE] (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER" ))) @@ -215,22 +224,24 @@ (* ;; "Now use Medley names") - (CLOSEF? PSTMPFILENAME) - (CL:UNLESS DONTDELETE (DELFILE PSTMPFILENAME)) - (CLOSEF? ERRORFILENAME) - (CL:WHEN (INFILEP ERRORFILENAME) - (CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILENAME 'LENGTH) - (CL:UNLESS DONTDELETE (DELFILE ERRORFILENAME))) + (CLOSEF? PSFILE) + (CL:UNLESS DONTDELETE (DELFILE PSFILE)) + (CLOSEF? ERRORFILE) + (CL:WHEN (INFILEP ERRORFILE) + (CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILE 'LENGTH) + (CL:UNLESS DONTDELETE (DELFILE ERRORFILE))) 0) - (ERROR "Cannot create PDF file for " TARGETPDFNAME))) + (ERROR "Cannot create PDF file for " PDFFILE))) (CL:WHEN (IGREATERP COMPLETIONCODE 0) - (ERROR "Cannot create PDF file for " TARGETPDFNAME)) - (RENAMEFILE PDFTMPFILENAME TARGETPDFNAME]) + (ERROR "Cannot create PDF file for " PDFFILE)) + PDFFILE]) ) +(MOVD? 'CL:IDENTITY 'TRUEFILENAME) + (PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2710 5044 (PDFFILEP 2720 . 3634) (PDF.HARDCOPYW 3636 . 4063) (PDF.TEXT 4065 . 4673) ( -PDF.TEDIT 4675 . 5042)) (5470 12943 (PDF-INIT 5480 . 6205) (OPEN-PDF-STREAM 6207 . 8310) ( -CLOSE-PDF-STREAM 8312 . 9496) (PDF-CONVERT 9498 . 12941))))) + (FILEMAP (NIL (2929 5370 (PDFFILEP 2939 . 3853) (PDF.HARDCOPYW 3855 . 4389) (PDF.TEXT 4391 . 4999) ( +PDF.TEDIT 5001 . 5368)) (5718 13064 (PDF-INIT 5728 . 6453) (OPEN-PDF-STREAM 6455 . 8558) ( +CLOSE-PDF-STREAM 8560 . 9864) (PS-TO-PDF 9866 . 13062))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index dde4ea6f6487716270c554883fd9f388b38c664d..cba1e2e5d4305d08b30acc0f71437b9ca21dc404 100644 GIT binary patch delta 1650 zcmb7E&yU+g6wVKXHr7J3YO7KSsZSBr+JdB>v7N*|bl0&biK%0|wv*jRt<)~Npf06Z zrHh1Ap-3D!v+@B6Bn}*U;8qq+9QKGfAR%$)Z-A;d4i#@a*=8eD2`)2l=9_u*y>H%o zzpX!$zt}oY_4>OX->*}ZYCu#=YgyXSzBrVp=L5V_q(-;P};jK*8w_+i58xK~fonArn}l6o5Q4Y>CJ{rcS=ob}ykG-|MW z_YfV5H}yFqeAFP8Mrw*AcRimu=q+U~p87X!a`foRimn6Eh-PNDif_(FcARi#f`k(e z5(VULknjCBwmbwU3`Q(Y6|kb1jl6J})LkTjVGwg6k7`=9ZE0E!9&HVn>$CBvN1tCP z>FV+C#V?C1r|};jmQP-pT`v?0#XC3@HecoAFO9!`XbAHTUtef!R`{F`^CPM_=}H`^ z7G%SOm<9HLaa}+&&uFaa;s?5@nnB@K6eeln#9ovlaU1lak$t<;tDkZL%WX??1O!l` z$Y-e+22SWQh(HAv$6<_5WY;PeH&KrKH4lL(;idw`MyXIJ3%)xA`^WNUPl}g6;3OBr z<|<$Bl(G*i>*ckzV)k9-ouZxnR9VlSSFX**;&$h;m{0n7++zIxYCrdrhuwKBHc$4S zem&tX?R@*h+kg7inYCTb9XxsdcR{9R3(|O)tHjj;YR-cK+S2pzW-(Ay(`9}h95o2^ zSjufL=!Tf6Z9oH;5!!Sv?FLY4EbfrjVxOQmapI76vrW`C|;D(U9&%4>H^8*(?s&+tRr z9Y)wO*me}gY0|KLpSKUxKLJ_dFfSJc7S$#COm=k6FG|@T=PqZH>ZR=UYI99e6ujE= z!;bCeO(`2zZ${F~+a#WjKpuo6cLU^`!w}nz<6EA~g49dLh>E?liLEHdKUZ&;M!9k| zsPT`O+w?jvPYW4KRz7%mIN`$N$MQOs(5_Ejek=Rt{97CUlMnV3Y@c4>rHT}IzVr|N CwvD;~ delta 1481 zcma)6OOM<{5S|A@jFnAxNq7i|wivX^SYjsbwmtS3DZ3uKXQmUsaQ7}7M4|+CfrNxv zO@f5PVg3Th2M*l1aAP?l?S%^x2Yx|*0|*Imq-;-iJXsE0+SS$dRn_;oy8r6@e&y@; zE)uJI{fh@(s!<&%b#&dK-`v;cx~+oJCjI3hu^f#$bkK$mXNMn6A0FL%aCiWRUmndK zZ8_itv0&ZAA9aOHnH$2r&!HWR#!yYs>-E}jaQ89d&gM28qPJD0GvWdBUdJ4g`OyB4 z_OhT3w{;r`9oQ5c=5yH{-h|o1&%p5}ZZu}1D`V&=qez_TO9dxM*&dH~Mc2m?&<487 zQFDl$h4sybZXItmzO5_B$%~^smdfK_nkUb_HK^5U^*gxKcAn4IUweQ2q?YELe1EC8 zll}0*<*Nqdax9>r8)Yveq-a?1K@tloyp$&r+i=0qvSw>MuK*n1Ryqk#@ZvBDnB;Nf z#Xf@s2(UDb(_E;?4Reo{my%&}>f(s=<4F1pkqkIuq??YJ#JB>(bBw4!RH(nvY}RVc z?6=mH>`Ck8#*2;Y@7CMdHRasKCpoWT`LtMhwyikx_jg*kfB1d*J>kW+Tz}l+MWj+j zl+Kg;e||U39d6-1x&F+4Qu^0x9cmLu3wAjrpq5^825MSQt+|05Sx^R`yvQ!Mc{GY~ zk_n)JTU3yk3+cCkYW5PNX{UZN&>=}5x8Q)5n`aou6HBvqfng?Yk5fM>Y+V2J+pCksyK77 zy2t5H+^f~Z{e>##Q`$IYlnww3kL3hAwjjH`{_32VW`ZU{Kd!<3h@&4M~#v0pC;#7*B8wAkFo?LjX zu4MmQ2(qs(o Date: Sat, 23 Sep 2023 16:20:30 -0700 Subject: [PATCH 08/37] PDFSTREAM uses AFTERCLOSE streamprop so doesn't require change to POSTSCRIPTSTREAM --- library/PDFSTREAM | 221 +- library/PDFSTREAM.LCOM | Bin 5235 -> 4189 bytes library/POSTSCRIPTSTREAM | 4424 --------------------------------- library/POSTSCRIPTSTREAM.LCOM | Bin 91382 -> 0 bytes 4 files changed, 95 insertions(+), 4550 deletions(-) delete mode 100644 library/POSTSCRIPTSTREAM delete mode 100644 library/POSTSCRIPTSTREAM.LCOM diff --git a/library/PDFSTREAM b/library/PDFSTREAM index aee1b3fd..8d882dd8 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,45 +1,57 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Jul-2023 10:37:31" {WMEDLEY}PDFSTREAM.;44 13139 +(FILECREATED "23-Sep-2023 15:38:55" {WMEDLEY}PDFSTREAM.;48 10752 :EDIT-BY rmk - :CHANGES-TO (VARS PDFSTREAMCOMS) - (FNS PDF.HARDCOPYW CLOSE-PDF-STREAM PS-TO-PDF PDF-CONVERT) + :CHANGES-TO (FNS OPEN-PDF-STREAM PS-TO-PDF) - :PREVIOUS-DATE "19-Jul-2023 09:28:33" {WMEDLEY}PDFSTREAM.;40) + :PREVIOUS-DATE "23-Sep-2023 15:31:33" {WMEDLEY}PDFSTREAM.;47) (PRETTYCOMPRINT PDFSTREAMCOMS) (RPAQQ PDFSTREAMCOMS - ([ADDVARS [PRINTERTYPES ((PDF) - (CANPRINT (PDF)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION - TITLE] - [PRINTFILETYPES (PDF (TEST PDFFILEP) - (EXTENSION (PDF)) - (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT] - (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC] - (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS) - EXPORTS.ALL) - (FILES (LOADCOMP) - POSTSCRIPTSTREAM)) - (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + ((FILES (SYSLOAD) + POSTSCRIPTSTREAM) + [COMS (* ; "Hook into hardcopy interface") + (ADDVARS [PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION + ROTATION TITLE] + [PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT] + (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) + (VARS (DEFAULTPRINTERTYPE 'PDF)) + (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] + + (* ;; "") + + + (* ;; "Implementation of PDF streams") + (INITVARS (PDFCONVERTER 'ps2pdf)) + (* ; "Mac with ghostscript?") (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) - (VARS (DEFAULTPRINTERTYPE 'PDF)) - (GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) - (FNS PDF-INIT OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF) - (P (MOVD? 'CL:IDENTITY 'TRUEFILENAME) - (PDF-INIT)))) + (GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) + (FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF))) + +(FILESLOAD (SYSLOAD) + POSTSCRIPTSTREAM) + + + +(* ; "Hook into hardcopy interface") + (ADDTOVAR PRINTERTYPES ((PDF) (CANPRINT (PDF)) @@ -57,85 +69,42 @@ (FONTCREATE POSTSCRIPT.FONTCREATE) (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) (CREATECHARSET \CREATECHARSET.PSC))) -(DECLARE%: EVAL@COMPILE DONTCOPY -(FILESLOAD (FROM LOADUPS) - EXPORTS.ALL) +(ADDTOVAR VARS (DEFAULTPRINTERTYPE 'PDF)) + +(ADDTOVAR FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + +(ADDTOVAR P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT)) -(FILESLOAD (LOADCOMP) - POSTSCRIPTSTREAM) -) -(DEFINEQ -(PDFFILEP - [LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk") - (* ; "Edited 5-Mar-93 21:40 by rmk:") - (* ; "Edited 14-Jan-93 10:56 by jds") - (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) - '("PDF") - :TEST - (FUNCTION STRING-EQUAL)) - (CL:WHEN (STREAMP FILE) - (SETFILEPTR FILE 0) - (PROG1 (AND (EQ (BIN FILE) - (CHARCODE %%)) - (EQ (BIN FILE) - (CHARCODE P)) - (EQ (BIN FILE) - (CHARCODE D)) - (EQ (BIN FILE) - (CHARCODE F))) - (SETFILEPTR FILE 0)))]) +(* ;; "") -(PDF.HARDCOPYW - [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) (* ; "Edited 24-Jul-2023 10:37 by rmk") - (* ; "Edited 23-Jun-2023 13:28 by rmk") - (* ; "Edited 6-Mar-2023 22:43 by rmk") - (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY FILE))) - (PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) - FILE]) -(PDF.TEXT - [LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 23-Jun-2023 13:23 by rmk") - (* ; "Edited 7-Mar-2023 08:39 by rmk") - (TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION - ROTATION ,(NOT (NOT - POSTSCRIPT.TEXTFILE.LANDSCAPE - ]) -(PDF.TEDIT - [LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk") - (* ; "Edited 7-Mar-2023 08:39 by rmk") - (LET ((TSTREAM (OPENTEXTSTREAM FILE))) - (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF) - (CLOSEF TSTREAM]) -) + +(* ;; "Implementation of PDF streams") + (RPAQ? PDFCONVERTER 'ps2pdf) + + +(* ; "Mac with ghostscript?") + + (ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSFILE " " PDFFILE " 2> " ERRORFILE) (pstopdf " " PSFILE " -o " PDFFILE " 2> " ERRORFILE)) - -(RPAQQ DEFAULTPRINTERTYPE PDF) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS PDFCONVERTER \PDFIMAGEOPS PDF-CONVERTER-TEMPLATES) +(GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) ) (DEFINEQ -(PDF-INIT - [LAMBDA NIL (* ; "Edited 25-Jun-2023 16:41 by rmk") - (* ; "Edited 23-Jun-2023 11:23 by rmk") - - (* ;; "Seems OK to make callers see this as PDF, even though the implementation is postscript. The pdf stream is opened as a temporary postscript stream, and the closefn then uses an operating-system utility to convert it to the original target file-name.") - - (SETQ \PDFIMAGEOPS (create IMAGEOPS using \POSTSCRIPTIMAGEOPS IMAGETYPE _ 'PDF IMCLOSEFN _ - (FUNCTION CLOSE-PDF-STREAM))) - (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]) - (OPEN-PDF-STREAM - [LAMBDA (FILE OPTIONS) (* ; "Edited 24-Jun-2023 14:49 by rmk") + [LAMBDA (FILE OPTIONS) (* ; "Edited 23-Sep-2023 15:38 by rmk") + (* ; "Edited 22-Sep-2023 11:04 by rmk") + (* ; "Edited 24-Jun-2023 14:49 by rmk") (* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.") @@ -148,44 +117,45 @@ (if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST] then - (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie that and give it a PDF extension so it thinks that we are heading to a PDF printer.") + (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.") (OPENPOSTSCRIPTSTREAM FILE OPTIONS) else (CL:UNLESS (OR (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER"))) PDF-CONVERTER-TEMPLATES)) (ERROR "POSTSCRIPT-to-PDF converter is not specified")) + (SETQ FILE (OR (AND (NEQ FILE T) + (OUTFILEP FILE)) + (ERROR "PDF target file not found" FILE))) (LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE) "-" (RAND) ".ps") OPTIONS))) - (replace (STREAM IMAGEOPS) of PSSTREAM with \PDFIMAGEOPS) - - (* ;; "Hopefully the postscript implementation functions won't notice that we did a shift to get the IMAGETYPE and IMCLOSEFN") - - (replace (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) - of PSSTREAM) with FILE) + (STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM))) + (STREAMPROP PSSTREAM 'PDFTARGETINFO FILE) PSSTREAM]) (CLOSE-PDF-STREAM - [LAMBDA (PSSTREAM) (* ; "Edited 24-Jul-2023 10:37 by rmk") + [LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk") + (* ; "Edited 24-Jul-2023 10:37 by rmk") (* ; "Edited 17-Jul-2023 22:32 by rmk") (* ; "Edited 24-Jun-2023 13:57 by rmk") - (* ;; "PSSTREAM is a tmp/ postscript rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") + (* ;; "PSSTREAM is a postscript (maybe in tmp) rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") (* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename") - (* ;; "We have to back up to the ordinary POSTSCRIPT close, so that we don't loop through here") - - (CL:WHEN (EQ \PDFIMAGEOPS (fetch (STREAM IMAGEOPS) of PSSTREAM)) - (replace (STREAM IMAGEOPS) of PSSTREAM with \POSTSCRIPTIMAGEOPS) - (RENAMEFILE (PS-TO-PDF (CLOSEF PSSTREAM)) - (fetch (\POSTSCRIPTDATA POSTSCRIPTTARGETINFO) of (fetch (STREAM IMAGEDATA) - of PSSTREAM))))]) + (STREAMPROP PSSTREAM 'AFTERCLOSE NIL) (* ; + "Maybe just remove only CLOSE-PDF-STREAMfrom the list?") + (LET ((TARGETINFO (STREAMPROP PSSTREAM 'PDFTARGETINFO NIL))) + (CL:IF TARGETINFO + (RENAMEFILE (PS-TO-PDF PSSTREAM) + TARGETINFO) + PSSTREAM)]) (PS-TO-PDF - [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Jul-2023 22:30 by rmk") + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Sep-2023 15:30 by rmk") + (* ; "Edited 23-Jul-2023 22:30 by rmk") (* ; "Edited 24-Jun-2023 15:01 by rmk") (* ; "Edited 16-Jul-2022 13:06 by rmk") (* ; "Edited 8-Jul-2022 10:20 by rmk") @@ -207,20 +177,24 @@ (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") - (* ;; "We have to map the filenames down to Unix conventions: (not host, slashes, etc.") + (* ;; + "We have to map the filenames down to Unix conventions: (not pseudohost or host, slashes, etc.") - [SETQ COMPLETIONCODE (PROCESS-COMMAND - (CONCATLIST (SUBLIS `[(PSFILE \, (SLASHIT (PACKFILENAME 'HOST NIL - 'BODY PSFILE))) - (PDFFILE \, (SLASHIT (PACKFILENAME 'HOST NIL - 'BODY PDFFILE))) - (ERRORFILE \, (SLASHIT (PACKFILENAME - 'HOST NIL 'BODY - ERRORFILE] - (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV + [SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS + `((PSFILE \, (SLASHIT (TRUEFILENAME + PSFILE) + NIL T)) + (PDFFILE \, (SLASHIT (TRUEFILENAME + PDFFILE) + NIL T)) + (ERRORFILE \, (SLASHIT (TRUEFILENAME + ERRORFILE) + NIL T))) + (ASSOC (OR PDFCONVERTER + (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER" - ))) - PDF-CONVERTER-TEMPLATES] + ))) + PDF-CONVERTER-TEMPLATES] (* ;; "Now use Medley names") @@ -236,12 +210,7 @@ (ERROR "Cannot create PDF file for " PDFFILE)) PDFFILE]) ) - -(MOVD? 'CL:IDENTITY 'TRUEFILENAME) - -(PDF-INIT) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2929 5370 (PDFFILEP 2939 . 3853) (PDF.HARDCOPYW 3855 . 4389) (PDF.TEXT 4391 . 4999) ( -PDF.TEDIT 5001 . 5368)) (5718 13064 (PDF-INIT 5728 . 6453) (OPEN-PDF-STREAM 6455 . 8558) ( -CLOSE-PDF-STREAM 8560 . 9864) (PS-TO-PDF 9866 . 13062))))) + (FILEMAP (NIL (3630 10729 (OPEN-PDF-STREAM 3640 . 5818) (CLOSE-PDF-STREAM 5820 . 7107) (PS-TO-PDF 7109 + . 10727))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index cba1e2e5d4305d08b30acc0f71437b9ca21dc404..ba009eae5b2a9602d4822a9e6fbe44635eea02e4 100644 GIT binary patch literal 4189 zcmds4OK;mo5S9}ZXxRoxP_zdhf&qa5Q~@d?C0UOYi7An?iBKd%Qceu?5I^WxiERmz z`UrwtdhAbVdrpDgQXuF2rREQ`{brY@DBEe8Ll3PE((LTa?Ci{ZGb_z@`mXQjeb;kz z*Y5{(J+yjvtqq4%*H4_tbK_8@>ycyGiPiPau)9|5kWnowipCat5KA1JRI{eX=|nfH zW{r$Sr`GB;8Y*e(-uQSjI!gCxd_pQcyFYMj&)I(d<lzg=Lku&VN%Dj-9+zh)AaZWb$XkYzv0As5|F0!{rH^6A@A`O%G3!XXUh$Sv2G)v z=i_N~YPEO8uUS^k#-wAn6fLAGg>e=omkjukxB>ievB6m^Q|X75Qt8se5!=$cy&dv*A6CQ)KxzHS6Sxkgl2J zL{Sh?y-mR|;d_TvYh_H+put@$2?k`W(a?7v=o?Pr_*WMQ5J>)i~I`8BgIDuMiQY(|0N=*>DN^AIe#$G(X zIX|A`l{{VZ9HBzBZ^PTCVbWR6A7oChjjK4nFSE*LRb{-aeK4u?jZ+!Ai zI-RFe8qI|CY?AJc4o2y|s*qujDsjoOxnn@axl88tREP#w(P??1l5|wk%DT+0NN17e z-2W^~XHyiz)paDhUZu$KtpPd{`VBIl0|QuI%DYimacY`pGSeue0Q+TSVJUOnK!G3; z$Rz3{upMG_h{6zuyJV6b_=)X6!~sGKJ|WxUdoo$3l}|5~N|)tDc1zZ)%iq5&{jn%& zL9Ktng}r-8N)_>Qq2RS^D^g7W>u@Auw<=iHdDi9<>u_~-^&y}37VwHt3k~tLEnVuq zkiV~`G5P)54GBe|(tRPBuOGkpNg!Gx__h1^&5wn(byb*s`R8XP&1_aFiH0JToKgUx zc8alj^OUL~%8n<(YMONdu$UI$GEt5o1U$`Z2DJViGTN0I=wqi_$i# z2vkj3La6q3PPqT< zO;e0nK0)@R1K3i@tfRU7t%QNOd13qEMy>h*92G-~Fh;Z9#4{W7GD)@>%MqR}e5@P+ z;KbODLhIhWWiDyr$r6(mZ^vF>*=1TZN~v5XjrB?Uf^LzzIUYa3t71N;!=35=-gxqq zSLyU%XD?MDs#vzYWknDdKA_EShiLDb24~okq%fek6S5`g04Dw|eh_kwWyzKosRCSjy+^%9K1$l2fw zM*+M7p-|!`Xl?jp_hDn%jX0?qMwf`QfF^_%RdRYknI2I%kbWSfD}ulq5vWqwGeOE@ z+yS1QGV;ZPc(P~n{LFg>r}ojD<*Tz8j0G1W3a?^o%W^&OfGq@Vc?Yu66kcjk>?HKn z(z1e}i*U#!D|k6uLoX>Lo3wkw0Aqp^&T->M9%vCECJJegSI=XDa6mrHoJB3LP6Y*J z;~Cg#D%ldNKk zeImQXWM%^7r=|hQojv+?G(V(AhvV6Nwl^J3=66&Db}VkIT=#Ez;Ydp~na#(-B5505 z(6u~qHk9%=20M6BFT+0p5zI6BKmY2==R4e%4|xIYzr(nqAF)+>iZns&UA) z`8(IGlT~%v#X(N1?{4;O9Q0%{&rh2F^=xr|uTR+8oOp>pisHS`XcR`NYGABk&Z9VO z=!ggC=mh76<83OR-E20ibhv*3(Qe+^v03=~57O{08j;<$+db+lKhTZg9xYz{iTb07 zH``V$9@VT}FG*PyBlRenrgf@~XEOG~)MK4T(QH>Gx=#H#QM*C3lQw)92724Q0?$^j z?`-wk?Y9{M=Eb3G-&su@$G^UO4?pAUY{AtBmD*N|Ql;fqosiot_u5-z0E(&Ig01^g zH65x1u0}gE_FvvM^QNkaWx;G4#&bHn1?`4 zb*pvJx`er?9z*pw)p{CJfUP>v2#J7P3inSA&ky#`<`2+qQ=+zUAes)PBQI2AZ=|CH zeVc}Xo_f4J2eGkHsk~c&Car-$cW0wA8F<5yuik%;Ash&PK*x1T9^KxgI7)RoN`hFI zB!-SA?Q=lXaWWRe4^4gnrR-j*;N_qTpJoQ zK!q@%7jGxj%@~YgFoDy2T-m6+Gw?)D=qA6hd>^xt&#v+BL;M+?S=$z|R5}W#I7eJh zELysV=Xs(TdNUu8$BIpyMB3AA2q>PJ1X%fFK(SO7p=h*a(`w^ZYgL2bRT%1)ab{R% z;2k|XJQTT&q!V#-$lJCJ0gVZ62SN;Va~vg8uP_dLCyEsa_EB~v8>d$m4Q!lAHVZ~q9Xki5Ec4=lv+kpTGvI0?J z7Xw|kyYxAJ1^Ear{xSX*S1d5k;gl`0P`N-(6{#lG(N%N-+%Z=9i@9>}}5OJ8j%iYKPx!W|IS1lPE z-1R50X?IgBRw$SW*#!YbvylfT=}`jbBezF^&@E_6B?-dbv1$6Lr=uy^n_#HmQDa+y zb9UM2txg#=?DMF%q&ModR>9vA7DIj{NBnrn^eSm+HH|}%JO?$5k);5Y;11e!soFd{ zuTlq%MwMLre93Zr{mI3Pvrk^k50B?xG|mp6Vy@k$YN2G~;#896!Rg6g=8KE@f{xDV z6|CJdqNT~D!?Nu%OC!5vEqBE# z;?2c{nID4!B3MMR`;H=C5%Y_E5H|HI31f1k=&LV*g@o?fo_Z{(a9X>0Xd-ae2?8N#^D+u z*O5w7MC5eJEZ`up4KbjE*66}}c7|w^z17RL6$s(uj=M>ysR@J-B9!=RklRs3k&-SgC@G7BtUY44cwa3f9tOvoxG9665f7 zrFv7wvhvm{m%Ul(l~-d@HrMgTvOyo-m}!I)sV0RvT09QNjeI&FGl-fW4*(|ka^B)?IYq0gR`0i8W*IQ6PD6EaC*2CA%&ft zJBTzfs>hTE8L@jUN0_D9ad9eJsAkU1UJE53r2Y?-(3I>p$b%0c$_XntET^Z!2}xU*<30r_LXx`^L0JjE!C zDUn|U@6C0^4A!oMF|CbiL+TGW#tMhcJZ2d+C8gfry;RG>ri$#8PjIBH`%Upb(eVHP diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM deleted file mode 100644 index 80df2d18..00000000 --- a/library/POSTSCRIPTSTREAM +++ /dev/null @@ -1,4424 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - -(FILECREATED "24-Jun-2023 14:49:45" {WMEDLEY}POSTSCRIPTSTREAM.;13 258994 - - :EDIT-BY rmk - - :CHANGES-TO (FNS CLOSEPOSTSCRIPTSTREAM) - - :PREVIOUS-DATE "23-Jun-2023 12:05:56" {WMEDLEY}POSTSCRIPTSTREAM.;12) - - -(* ; " -Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets. -") - -(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS) - -(RPAQQ POSTSCRIPTSTREAMCOMS - [ - (* ;; "PostScript printer support for Medley") - - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM)) - (INITRECORDS \POSTSCRIPTDATA) - (FNS POSTSCRIPT.INIT) - (ADDVARS (DEFAULTFILETYPELIST (PS . TEXT) - (PSC . TEXT) - (PSF . BINARY) - (PSCFONT . BINARY) - (POSTSCRIPT . TEXT)) - (*DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) - (AVANTGARDE-DEMI . AD) - (BECKMAN . BM) - (BOOKMAN-LIGHT . BL) - (BOOKMAN-DEMI . BD) - (COURIER . CO) - (HELVETICA-NARROW . HN) - (NEWCENTURYSCHLBK . NC) - (PALATINO . PA) - (TIMES . TS) - (ZAPFCHANCERY-MEDIUM . ZM) - (ZAPFCHANCERY . ZC) - (ZAPFDINGBATS . ZD))) - - (* ;; "Font-reading code") - - (FNS PSCFONT.READFONT PSCFONT.SPELLFILE PSCFONT.COERCEFILE PSCFONTFROMCACHE.SPELLFILE - PSCFONTFROMCACHE.COERCEFILE PSCFONT.WRITEFONT READ-AFM-FILE CONVERT-AFM-FILES - POSTSCRIPT.GETFONTID POSTSCRIPT.FONTCREATE \POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS - POSTSCRIPT.FONTSAVAILABLE) - (COMS - (* ;; "Until macro in FONT is exported") - - (MACROS \FSETCHARWIDTH)) - (FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM) - (INITVARS (*POSTSCRIPT-FILE-TYPE* 'BINARY)) - (FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPT.TEXT POSTSCRIPTFILEP MAKEEPSFILE) - (FNS POSTSCRIPT.BITMAPSCALE POSTSCRIPT.CLOSESTRING POSTSCRIPT.ENDPAGE POSTSCRIPT.OUTSTR - POSTSCRIPT.PUTBITMAPBYTES POSTSCRIPT.PUTCOMMAND POSTSCRIPT.SET-FAKE-LANDSCAPE - POSTSCRIPT.SHOWACCUM POSTSCRIPT.STARTPAGE \POSTSCRIPTTAB \PS.BOUTFIXP \PS.SCALEHACK - \PS.SCALEREGION \SCALEDBITBLT.PSC \SETPOS.PSC \SETXFORM.PSC \STRINGWIDTH.PSC - \SWITCHFONTS.PSC \TERPRI.PSC) - - (* ;; "DIG operations: ") - - (FNS \BITBLT.PSC \BLTSHADE.PSC \CHARWIDTH.PSC \CREATECHARSET.PSC \DRAWARC.PSC \DRAWCIRCLE.PSC - \DRAWCURVE.PSC \DRAWELLIPSE.PSC \DRAWLINE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC - \DSPBOTTOMMARGIN.PSC \DSPCLIPPINGREGION.PSC \DSPCOLOR.PSC \DSPFONT.PSC - \DSPLEFTMARGIN.PSC \DSPLINEFEED.PSC \DSPPUSHSTATE.PSC \DSPPOPSTATE.PSC \DSPRESET.PSC - \DSPRIGHTMARGIN.PSC \DSPROTATE.PSC \DSPSCALE.PSC \DSPSCALE2.PSC \DSPSPACEFACTOR.PSC - \DSPTOPMARGIN.PSC \DSPTRANSLATE.PSC \DSPXPOSITION.PSC \DSPYPOSITION.PSC \FILLCIRCLE.PSC - \FILLPOLYGON.PSC \FIXLINELENGTH.PSC \MOVETO.PSC \NEWPAGE.PSC) - (COMS - (* ;; "Character-output, plus special-cases:") - - (FNS \POSTSCRIPT.CHANGECHARSET \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG - \POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN - \POSTSCRIPT.ACCENTPAIR) - - (* ;; "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") - - (FNS \PSC.SPACEDISP \PSC.SPACEWID \PSC.SYMBOLS) - - (* ;; - "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") - - (FNS \POSTSCRIPT.NSHASH) - (VARS (*POSTSCRIPT-UNACCENTED-FONTS* '(Dancer ZapfDingbats "Dancer" "ZapfDingbats")) - *POSTSCRIPT-NS-TRANSLATIONS*) - (GLOBALVARS *POSTSCRIPT-NS-HASH*)) - (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \POSTSCRIPT.FRACTION)) - (VARS (\POSTSCRIPT.ORIENTATION.MENU (create MENU ITEMS _ '(("Landscape" T - "Print this file/document/image in Landscape Orientation" - ) - ("Portrait" 'NIL - "Print this file/document/image in Portrait Orientation" - )) - TITLE _ "Orientation" CENTERFLG _ T MENUOFFSET _ - (create POSITION XCOORD _ -1 YCOORD _ 0) - CHANGEOFFSETFLG _ 'Y)) - (\POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK - "Always ask whether to print in Landscape or Portrait Orientation" - ) - ("Landscape" T - "Default printing to Landscape Orientation" - ) - ("Portrait" 'NIL - "Default printing to Portrait Orientation" - )) - TITLE _ "Default Orientation" CENTERFLG _ - T)) - PS.BITMAPARRAY \POSTSCRIPT.JOB.SETUP SlopeMenuItems WeightMenuItems) - [ADDVARS (BackgroundMenuCommands ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE - (MENU - \POSTSCRIPT.ORIENTATION.OPTIONS.MENU - )) - - "Select the default Orientation for PostScript output" - (SUBITEMS ("Ask" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE - 'ASK) - - "Always ask whether to print in Landscape or Portrait Orientation" - ) - ("Landscape" '(SETQ - POSTSCRIPT.PREFER.LANDSCAPE - T) - - "Default printing to Landscape Orientation" - ) - ("Portrait" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE - NIL) - - "Default printing to Portrait Orientation" - ] - (VARS (BackgroundMenu NIL)) - (CONSTANTS (GOLDEN.RATIO 1.618034) - (\PS.SCALE0 100) - (\PS.TEMPARRAYLEN 20)) - (INITVARS (POSTSCRIPT.BITMAP.SCALE 1) - (POSTSCRIPT.EOL 'CR) - (POSTSCRIPT.IMAGESIZEFACTOR 1) - (POSTSCRIPT.PREFER.LANDSCAPE NIL) - (POSTSCRIPT.TEXTFILE.LANDSCAPE NIL) - (POSTSCRIPT.DEFAULT.PAGEREGION '(4800 4800 52800 70800)) - (POSTSCRIPT.TEXTURE.SCALE 4) - [POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) - 'MAIKO) - "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") - (T "{DSK}POSTSCRIPT>"] - (\POSTSCRIPT.MAX.WILD.FONTSIZE 72)) - [COMS (FNS POSTSCRIPTSEND) - (ADDVARS (PRINTERTYPES ((POSTSCRIPT) - (CANPRINT (POSTSCRIPT)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR - REGION ROTATION TITLE] - [ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) - (HELVETICAD . HELVETICA) - (TIMESROMAN . TIMES) - (TIMESROMAND . TIMES) - (COURIER . COURIER) - (GACHA . COURIER) - (CLASSIC . NEWCENTURYSCHLBK) - (MODERN . HELVETICA) - (CREAM . HELVETICA) - (TERMINAL . COURIER) - (LOGO . HELVETICA) - (OPTIMA . PALATINO) - (TITAN . COURIER)) - [PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) - (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT] - (IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC] - (INITVARS (POSTSCRIPT.PAGETYPE 'LETTER)) - - (* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk") - - [APPENDVARS (POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2)) - (LEGAL (0 0 8.5 14) - NIL - (-0.1 -0.1 8.7 14.2)) - (NOTE (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2] - (GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST - POSTSCRIPT.PREFER.LANDSCAPE POSTSCRIPT.TEXTFILE.LANDSCAPE POSTSCRIPT.TEXTURE.SCALE - POSTSCRIPTFONTDIRECTORIES \POSTSCRIPT.JOB.SETUP \POSTSCRIPT.MAX.WILD.FONTSIZE - \POSTSCRIPT.ORIENTATION.MENU \POSTSCRIPTIMAGEOPS POSTSCRIPT.PAGETYPE - POSTSCRIPT.PAGEREGIONS) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (POSTSCRIPT.INIT))) - (PROP (FILETYPE MAKEFILE-ENVIRONMENT) - POSTSCRIPTSTREAM) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) - (NLAML) - (LAMA - POSTSCRIPT.PUTCOMMAND - ]) - - - -(* ;; "PostScript printer support for Medley") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RECORD FONTID (FONTIDNAME FONTXFACTOR FONTOBLIQUEFACTOR)) - -(RECORD PSCFONT (FID IL-FONTID FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTHS)) - -(DATATYPE \POSTSCRIPTDATA - ((POSTSCRIPTACCENTED FLAG) (* ; - "T if we're to do NS-to-PS translations on characters in the current font.") - POSTSCRIPTFONT (* ; - "The fontdescriptor of the current font") - POSTSCRIPTX (* ; "The current X") - POSTSCRIPTY (* ; "... and Y") - POSTSCRIPTLEFTMARGIN (* ; "The margins") - POSTSCRIPTRIGHTMARGIN POSTSCRIPTBOTTOMMARGIN POSTSCRIPTTOPMARGIN POSTSCRIPTLINESPACING - (* ; "Line to line spacing") - POSTSCRIPTCOLOR (* ; - "Color (or grey shade) in effect; 0.0=black, 1.0=white.") - POSTSCRIPTSCALE (* ; "Scale of the stream") - POSTSCRIPTOPERATION (* ; - "Default operation (PAINT, REPLACE, ...)") - POSTSCRIPTCLIPPINGREGION (* ; - "The current region available to be written into") - POSTSCRIPTPAGENUM (* ; "Current page number") - POSTSCRIPTHEADING (* ; "The heading") - POSTSCRIPTHEADINGFONT (* ; "Font for the heading") - POSTSCRIPTSPACEFACTOR (* ; - "Expansion factor for spaces (see DSPSPACEFACTOR)") - POSTSCRIPTSPACEWIDTH (* ; - "The width of a space in the current font") - POSTSCRIPTLANDSCAPE (* ; - "non-NIL for paper in 'landscape' mode") - POSTSCRIPTCHARSTOSHOW (* ; - "non-NIL if the string (PostScript-type string) of chars has already been started") - POSTSCRIPTFONTCHANGEDFLG (* ; "Font has changed") - POSTSCRIPTMOVEFLG (* ; "Need to move") - POSTSCRIPTWIDTHS (* ; - "The widths vector of the current font") - POSTSCRIPTTRANSX (* ; "Translation in X") - POSTSCRIPTTRANSY (* ; "... and Y") - POSTSCRIPTPENDINGXFORM (* ; - "A userspace to devicespace transform is pending") - POSTSCRIPTPAGEREGION (* ; "The whole page") - POSTSCRIPTPAGEBLANK (* ; "This page is blank flag") - POSTSCRIPTSCALEHACK (* ; - "For \PS.SCALEHACK since DSPSCALE doesn't change the scale of the stream") - POSTSCRIPTTEMPARRAY (* ; - "For converting FIXP to string of digit chars") - POSTSCRIPTXFORMSTACK (* ; "The stack of transformations. DSPPUSHSTATE pushes one onto this, DSPPOPSTATE uses it to reset values.") - POSTSCRIPTROTATION (* ; - "Rotation value currently in effect.") - POSTSCRIPTPENDINGROTATION (* ; - "Rotation to take effect at next SETXFORM.") - POSTSCRIPTFONTSUSED (* ; "List of FONTIDs of the fonts that've been used before. This is used to control the re-encoding of fonts for accented-character rendering.") - (POSTSCRIPTNSCHARSET BYTE) (* ; - "Current NSCHARSET--widths are in POSTSCRIPTWIDTHS") - (POSTSCRIPTNATURALSPACEWIDTH WORD) (* ; - "Width of the space in the current font, used to compute the scaled space width.") - POSTSCRIPTTARGETINFO (* ; - "For use of other imagetypes (like PDF) that might piggy-back on postscript.") - ) - POSTSCRIPTX _ 0 POSTSCRIPTY _ 0 POSTSCRIPTTRANSX _ 0 POSTSCRIPTTRANSY _ 0 - POSTSCRIPTSPACEFACTOR _ 1 POSTSCRIPTPAGENUM _ 0 POSTSCRIPTSCALEHACK _ 1 POSTSCRIPTTEMPARRAY - _ (ARRAY \PS.TEMPARRAYLEN 'BYTE 0 0) - POSTSCRIPTROTATION _ 0 POSTSCRIPTCOLOR _ 0.0) - -(RECORD POSTSCRIPTXFORM ( - (* ;; "Holds the transformation state as saved by DSPPUSHSTATE. Used by DSPPOPSTATE to restore the tranformation state.") - - PSXCLIP (* ; "Clipping region") - PSXPAGE (* ; "Page region") - PSXX (* ; "X position?") - PSXY (* ; "Y position?") - PSXLEFT (* ; "Left margin") - PSXRIGHT (* ; "Right margin") - PSXTOP (* ; "Top margin") - PSXBOTTOM (* ; "Bottom Margin") - PSXTRANX (* ; "X-translation in effect") - PSXTRANY (* ; "Y-translation in effect") - PSXLAND (* ; "Landscape?") - PSXXFORMPEND (* ; "Are there transforms pending? ") - )) -) - -(/DECLAREDATATYPE '\POSTSCRIPTDATA - '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - BYTE WORD POINTER) - '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) - (\POSTSCRIPTDATA 0 POINTER) - (\POSTSCRIPTDATA 2 POINTER) - (\POSTSCRIPTDATA 4 POINTER) - (\POSTSCRIPTDATA 6 POINTER) - (\POSTSCRIPTDATA 8 POINTER) - (\POSTSCRIPTDATA 10 POINTER) - (\POSTSCRIPTDATA 12 POINTER) - (\POSTSCRIPTDATA 14 POINTER) - (\POSTSCRIPTDATA 16 POINTER) - (\POSTSCRIPTDATA 18 POINTER) - (\POSTSCRIPTDATA 20 POINTER) - (\POSTSCRIPTDATA 22 POINTER) - (\POSTSCRIPTDATA 24 POINTER) - (\POSTSCRIPTDATA 26 POINTER) - (\POSTSCRIPTDATA 28 POINTER) - (\POSTSCRIPTDATA 30 POINTER) - (\POSTSCRIPTDATA 32 POINTER) - (\POSTSCRIPTDATA 34 POINTER) - (\POSTSCRIPTDATA 36 POINTER) - (\POSTSCRIPTDATA 38 POINTER) - (\POSTSCRIPTDATA 40 POINTER) - (\POSTSCRIPTDATA 42 POINTER) - (\POSTSCRIPTDATA 44 POINTER) - (\POSTSCRIPTDATA 46 POINTER) - (\POSTSCRIPTDATA 48 POINTER) - (\POSTSCRIPTDATA 50 POINTER) - (\POSTSCRIPTDATA 52 POINTER) - (\POSTSCRIPTDATA 54 POINTER) - (\POSTSCRIPTDATA 56 POINTER) - (\POSTSCRIPTDATA 58 POINTER) - (\POSTSCRIPTDATA 60 POINTER) - (\POSTSCRIPTDATA 62 POINTER) - (\POSTSCRIPTDATA 64 POINTER) - (\POSTSCRIPTDATA 66 (BITS . 7)) - (\POSTSCRIPTDATA 67 (BITS . 15)) - (\POSTSCRIPTDATA 68 POINTER)) - '70) -) - -(/DECLAREDATATYPE '\POSTSCRIPTDATA - '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - BYTE WORD POINTER) - '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) - (\POSTSCRIPTDATA 0 POINTER) - (\POSTSCRIPTDATA 2 POINTER) - (\POSTSCRIPTDATA 4 POINTER) - (\POSTSCRIPTDATA 6 POINTER) - (\POSTSCRIPTDATA 8 POINTER) - (\POSTSCRIPTDATA 10 POINTER) - (\POSTSCRIPTDATA 12 POINTER) - (\POSTSCRIPTDATA 14 POINTER) - (\POSTSCRIPTDATA 16 POINTER) - (\POSTSCRIPTDATA 18 POINTER) - (\POSTSCRIPTDATA 20 POINTER) - (\POSTSCRIPTDATA 22 POINTER) - (\POSTSCRIPTDATA 24 POINTER) - (\POSTSCRIPTDATA 26 POINTER) - (\POSTSCRIPTDATA 28 POINTER) - (\POSTSCRIPTDATA 30 POINTER) - (\POSTSCRIPTDATA 32 POINTER) - (\POSTSCRIPTDATA 34 POINTER) - (\POSTSCRIPTDATA 36 POINTER) - (\POSTSCRIPTDATA 38 POINTER) - (\POSTSCRIPTDATA 40 POINTER) - (\POSTSCRIPTDATA 42 POINTER) - (\POSTSCRIPTDATA 44 POINTER) - (\POSTSCRIPTDATA 46 POINTER) - (\POSTSCRIPTDATA 48 POINTER) - (\POSTSCRIPTDATA 50 POINTER) - (\POSTSCRIPTDATA 52 POINTER) - (\POSTSCRIPTDATA 54 POINTER) - (\POSTSCRIPTDATA 56 POINTER) - (\POSTSCRIPTDATA 58 POINTER) - (\POSTSCRIPTDATA 60 POINTER) - (\POSTSCRIPTDATA 62 POINTER) - (\POSTSCRIPTDATA 64 POINTER) - (\POSTSCRIPTDATA 66 (BITS . 7)) - (\POSTSCRIPTDATA 67 (BITS . 15)) - (\POSTSCRIPTDATA 68 POINTER)) - '70) -(DEFINEQ - -(POSTSCRIPT.INIT - [LAMBDA NIL (* ; "Edited 14-May-2018 10:48 by rmk:") - (* ; "Edited 4-Feb-93 21:08 by jds") - (DECLARE (GLOBALVARS \POSTSCRIPT.CHARTYPE)) - - (* ;; "Add POSTSCRIPT font descriptions to the active font profile.") - - [MAPC - [CL:REMOVE-DUPLICATES (NCONC (for FD in FONTDEFS - join (for FP in (CDR (ASSOC 'FONTPROFILE - (CDR FD))) - collect (CAR FP))) - '(FONT7 FONT6 FONT5 FONT4 FONT3 FONT2 FONT1 BOLDFONT LITTLEFONT - BIGFONT PRETTYCOMFONT COMMENTFONT USERFONT SYSTEMFONT - CLISPFONT LAMBDAFONT CHANGEFONT DEFAULTFONT] - (FUNCTION (LAMBDA (CLASS) - (LET - (COPYFD OLDPSCFD) - (if (BOUNDP CLASS) - then - (SETQ CLASS (EVALV CLASS)) - (if (TYPEP CLASS 'FONTCLASS) - then (SETQ COPYFD (OR (fetch (FONTCLASS INTERPRESSFD) of CLASS) - (fetch (FONTCLASS PRESSFD) of CLASS) - (fetch (FONTCLASS DISPLAYFD) of CLASS))) - (if (SETQ OLDPSCFD (ASSOC 'POSTSCRIPT (fetch (FONTCLASS - OTHERFDS) - of CLASS))) - then [if (NOT (CDR OLDPSCFD)) - then (RPLACD OLDPSCFD (if (LISTP COPYFD) - then COPYFD - else (FONTUNPARSE - COPYFD] - else (push (fetch (FONTCLASS OTHERFDS) of CLASS) - (CONS 'POSTSCRIPT (if (LISTP COPYFD) - then COPYFD - else (FONTUNPARSE COPYFD] - [FOR FD IN FONTDEFS - DO (FOR FP IN (CDR (ASSOC 'FONTPROFILE (CDR FD))) - DO (COND - ((ASSOC 'POSTSCRIPT (CL:NTHCDR 5 FP)) - - (* ;; "There's already a postscript spec, so leave it be.") - - ) - (T (NCONC1 FP `(POSTSCRIPT ,(OR (CL:FIFTH FP) - (CL:FOURTH FP) - (CL:THIRD FP] - - (* ;; "Eliminate any existing postscript fonts, to start with a clean slate if reinitializing.") - - (FOR FD IN (FONTSAVAILABLE '* '* '* '* 'POSTSCRIPT) - DO (APPLY (FUNCTION SETFONTDESCRIPTOR) - FD)) - (SETQ POSTSCRIPTFONTCACHE NIL) - (SETQ \POSTSCRIPT.CHARTYPE (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT T)) - - (* ;; "\POSTSCRIPT.OUTCHARFN uses this array to quickly determine whether a character needs any special processing -- T means yes") - - (for x from (CHARCODE SP) to 126 unless (FMEMB x (CHARCODE (%( %) \))) - do (CL:SETF (CL:AREF \POSTSCRIPT.CHARTYPE x) - NIL)) - - (* ;; "RMK: Maybe the following is equivalent to alot of the stuff above??") - - (FONTPROFILE.ADDDEVICE 'POSTSCRIPT 'INTERPRESS) - (SETQ \POSTSCRIPTIMAGEOPS (create IMAGEOPS - IMAGETYPE _ 'POSTSCRIPT - IMCLOSEFN _ (FUNCTION CLOSEPOSTSCRIPTSTREAM) - IMXPOSITION _ (FUNCTION \DSPXPOSITION.PSC) - IMYPOSITION _ (FUNCTION \DSPYPOSITION.PSC) - IMMOVETO _ (FUNCTION \MOVETO.PSC) - IMFONT _ (FUNCTION \DSPFONT.PSC) - IMLEFTMARGIN _ (FUNCTION \DSPLEFTMARGIN.PSC) - IMRIGHTMARGIN _ (FUNCTION \DSPRIGHTMARGIN.PSC) - IMLINEFEED _ (FUNCTION \DSPLINEFEED.PSC) - IMDRAWLINE _ (FUNCTION \DRAWLINE.PSC) - IMDRAWCURVE _ (FUNCTION \DRAWCURVE.PSC) - IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.PSC) - IMDRAWELLIPSE _ (FUNCTION \DRAWELLIPSE.PSC) - IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.PSC) - IMBLTSHADE _ (FUNCTION \BLTSHADE.PSC) - IMBITBLT _ (FUNCTION \BITBLT.PSC) - IMSCALEDBITBLT _ (FUNCTION \SCALEDBITBLT.PSC) - IMNEWPAGE _ (FUNCTION \NEWPAGE.PSC) - IMSCALE _ (FUNCTION \DSPSCALE.PSC) - IMSCALE2 _ (FUNCTION \DSPSCALE2.PSC) - IMCOLOR _ (FUNCTION \DSPCOLOR.PSC) - IMTERPRI _ (FUNCTION \TERPRI.PSC) - IMTOPMARGIN _ (FUNCTION \DSPTOPMARGIN.PSC) - IMBOTTOMMARGIN _ (FUNCTION \DSPBOTTOMMARGIN.PSC) - IMSPACEFACTOR _ (FUNCTION \DSPSPACEFACTOR.PSC) - IMFONTCREATE _ 'POSTSCRIPT - IMCLIPPINGREGION _ (FUNCTION \DSPCLIPPINGREGION.PSC) - IMRESET _ (FUNCTION \DSPRESET.PSC) - IMDRAWPOLYGON _ (FUNCTION \DRAWPOLYGON.PSC) - IMFILLPOLYGON _ (FUNCTION \FILLPOLYGON.PSC) - IMSTRINGWIDTH _ (FUNCTION \STRINGWIDTH.PSC) - IMCHARWIDTH _ (FUNCTION \CHARWIDTH.PSC) - IMDRAWARC _ (FUNCTION \DRAWARC.PSC) - IMROTATE _ (FUNCTION \DSPROTATE.PSC) - IMTRANSLATE _ (FUNCTION \DSPTRANSLATE.PSC) - IMDRAWPOINT _ (FUNCTION \DRAWPOINT.PSC) - IMPUSHSTATE _ (FUNCTION \DSPPUSHSTATE.PSC) - IMPOPSTATE _ (FUNCTION \DSPPOPSTATE.PSC))) - (SETQ *POSTSCRIPT-NS-HASH* (HARRAY 255)) - (\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*]) -) - -(ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT) - (PSC . TEXT) - (PSF . BINARY) - (PSCFONT . BINARY) - (POSTSCRIPT . TEXT)) - -(ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) - (AVANTGARDE-DEMI . AD) - (BECKMAN . BM) - (BOOKMAN-LIGHT . BL) - (BOOKMAN-DEMI . BD) - (COURIER . CO) - (HELVETICA-NARROW . HN) - (NEWCENTURYSCHLBK . NC) - (PALATINO . PA) - (TIMES . TS) - (ZAPFCHANCERY-MEDIUM . ZM) - (ZAPFCHANCERY . ZC) - (ZAPFDINGBATS . ZD)) - - - -(* ;; "Font-reading code") - -(DEFINEQ - -(PSCFONT.READFONT - [LAMBDA (FONTFILENAME) (* ; "Edited 5-Oct-93 17:19 by rmk:") - (* ; "Edited 1-Sep-89 10:55 by jds") - - (* ;; "Read one of Matt Heffron's .PSC files, to get postscript font metrics. First check to see if incore cache as information indexed under the file's name.") - - (LET (FID W [S (OPENSTREAM FONTFILENAME 'INPUT NIL '((SEQUENTIAL T] - (PF (create PSCFONT))) - [replace (PSCFONT FID) of PF with (SETQ FID (READ S (FIND-READTABLE "INTERLISP"] - - (* ;; "Read until we hit a 255 byte, marking the end of the font-id section.") - - (CL:DO NIL - ((EQ (BIN S) - 255)) - - (* ;; "Body of the loop is empty, the test does all of the work") - - ) - (replace (PSCFONT IL-FONTID) of PF with (CAR FID)) - (replace (PSCFONT FIRSTCHAR) of PF with (\WIN S)) - (replace (PSCFONT LASTCHAR) of PF with (\WIN S)) - (replace (PSCFONT ASCENT) of PF with (\WIN S)) - (replace (PSCFONT DESCENT) of PF with (\WIN S)) - (replace (PSCFONT WIDTHS) of PF with (SETQ W (ARRAY 256 'SMALLPOSP 0 0))) - (for C from 0 to 255 do (SETA W C (\WIN S))) - (CLOSEF S) - - (* ;; - "PATCH JDS 9/1/89: The afm font reader made fonts too tall. This should fix things pro tem.") - - (replace (PSCFONT ASCENT) of PF with (- 1000 (fetch (PSCFONT DESCENT) - OF PF))) - (PUSH POSTSCRIPTFONTCACHE (CONS (L-CASE (FILENAMEFIELD FONTFILENAME 'NAME)) - (CREATE PSCFONT USING PF))) - PF]) - -(PSCFONT.SPELLFILE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 5-Oct-93 22:15 by rmk:") - (* ; "Edited 5-Oct-92 15:23 by jds") - - (* ;; - "Find the font file for a postscript font. Does the display-name conversion as well, for DOS.") - - (CL:WHEN POSTSCRIPTFONTDIRECTORIES - (\FINDFONTFILE (OR (CDR (FASSOC FAMILY POSTSCRIPT.FONT.ALIST)) - FAMILY) - SIZE FACE 0 DEVICE 0 POSTSCRIPTFONTDIRECTORIES '(PSCFONT PF PSC)))]) - -(PSCFONT.COERCEFILE - [LAMBDA (FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION DEVICE) - (* ; "Edited 5-Oct-93 16:28 by rmk:") - - (* ;; -"This coerces the WEIGHT and SLOPE incrementally back to REGULAR in order to find a matching file.") - - (COND - ((AND (NEQ EXPANSION 'REGULAR) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT SLOPE 'REGULAR) - ROTATION DEVICE))) - ((AND (EQ SLOPE 'ITALIC) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ EXPANSION 'REGULAR) - (EQ SLOPE 'ITALIC) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR 'REGULAR) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (NEQ EXPANSION 'REGULAR) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE 'REGULAR) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (EQ SLOPE 'ITALIC) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (NEQ EXPANSION 'REGULAR) - (EQ SLOPE 'ITALIC) - (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR 'REGULAR) - ROTATION DEVICE]) - -(PSCFONTFROMCACHE.SPELLFILE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 5-Oct-93 17:54 by rmk:") - (* ; "Edited 5-Oct-92 15:23 by jds") - - (* ;; "Tries to find postscript font information in the cache, indexed by the name-field of the fontfile. ") - - (LET [(CACHE (CDR (ASSOC (L-CASE (FILENAMEFIELD (\FONTFILENAME (OR (CDR (FASSOC FAMILY - POSTSCRIPT.FONT.ALIST - )) - FAMILY) - SIZE FACE 'PSCFONT 0) - 'NAME)) - POSTSCRIPTFONTCACHE] - (IF CACHE - THEN (CREATE PSCFONT USING CACHE]) - -(PSCFONTFROMCACHE.COERCEFILE - [LAMBDA (FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION DEVICE) - (* ; "Edited 5-Oct-93 17:00 by rmk:") - - (* ;; "This coerces the WEIGHT and SLOPE incrementally back to REGULAR in order to find a matching font in the cache.") - - (COND - ((AND (NEQ EXPANSION 'REGULAR) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT SLOPE 'REGULAR) - ROTATION DEVICE))) - ((AND (EQ SLOPE 'ITALIC) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ EXPANSION 'REGULAR) - (EQ SLOPE 'ITALIC) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR 'REGULAR) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (NEQ EXPANSION 'REGULAR) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE 'REGULAR) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (EQ SLOPE 'ITALIC) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR EXPANSION) - ROTATION DEVICE))) - ((AND (NEQ WEIGHT 'MEDIUM) - (NEQ EXPANSION 'REGULAR) - (EQ SLOPE 'ITALIC) - (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR 'REGULAR) - ROTATION DEVICE]) - -(PSCFONT.WRITEFONT - [LAMBDA (FONTFILENAME PF) (* ; - "Edited 5-Aug-93 16:28 by sybalskY:MV:ENVOS") - - (* ;; "Given a PSCFONT data structure, write it out as a properly-named xxx.PSCFONT file, for later reading.") - - NIL - (LET ([S (OPENSTREAM FONTFILENAME 'OUTPUT NIL '((TYPE BINARY) - (SEQUENTIAL T] - (W (fetch (PSCFONT WIDTHS) of PF)) - (*READTABLE* (FIND-READTABLE "INTERLISP"))) - (PRIN3 (fetch (PSCFONT FID) of PF) - S) - (BOUT S 0) - (BOUT S 255) - (\WOUT S (fetch (PSCFONT FIRSTCHAR) of PF)) - (\WOUT S (fetch (PSCFONT LASTCHAR) of PF)) - (\WOUT S (fetch (PSCFONT ASCENT) of PF)) - (\WOUT S (fetch (PSCFONT DESCENT) of PF)) - (for C from 0 to 255 do (\WOUT S (ELT W C))) - (CLOSEF S) - FONTFILENAME]) - -(READ-AFM-FILE - [LAMBDA (FILE BOLDNESS ITALICNESS) (* ; - "Edited 5-Aug-93 16:37 by sybalskY:MV:ENVOS") - - (* ;; - "Read an Adobe-version-3 AFM file, and extract the metrics from it for making a PSCFONT file.") - - (LET ((IFILE (OPENSTREAM FILE 'INPUT)) - (PSCFONT (create PSCFONT)) - (FCHAR 1000) - (LCHAR 0) - (W (ARRAY 256 'SMALLPOSP 0 0)) - TOKEN WEIGHT SLOPE HEIGHT CMCOUNT FBBOX) - (with PSCFONT PSCFONT (repeatuntil (STRING-EQUAL "FontName" (RSTRING IFILE)) - do (READCCODE IFILE)) - (repeatwhile (STRING-EQUAL "" (SETQ TOKEN (RSTRING IFILE))) - do (READCCODE IFILE)) - [COND - ((NOT (AND (BOUNDP 'WeightMenu) - (type? MENU WeightMenu))) - (SETQ WeightMenu (create MENU - ITEMS _ WeightMenuItems - MENUFONT _ (FONTCREATE 'HELVETICA 12] - [COND - ((NOT (AND (BOUNDP 'SlopeMenu) - (type? MENU SlopeMenu))) - (SETQ SlopeMenu (create MENU - ITEMS _ SlopeMenuItems - MENUFONT _ (FONTCREATE 'HELVETICA 12] - (OR (SETQ WEIGHT BOLDNESS) - (printout T T "Font WEIGHT for " PSCFONT ": " (SETQ WEIGHT (MENU WeightMenu)) - T)) - (OR (SETQ SLOPE ITALICNESS) - (printout T T "Font SLOPE for " PSCFONT ": " (SETQ SLOPE (MENU SlopeMenu)) - T)) - (SETQ FID (LIST TOKEN WEIGHT SLOPE 'REGULAR)) - [SETQ IL-FONTID (COND - ((AND (EQ SLOPE 'REGULAR) - (EQ WEIGHT 'MEDIUM)) - TOKEN) - (T (POSTSCRIPT.GETFONTID FID WEIGHT SLOPE 'REGULAR] - [repeatuntil (STRING-EQUAL "StartCharMetrics" TOKEN) - do (SETQ TOKEN (RSTRING IFILE)) - (COND - [(STRING-EQUAL "FontBBox" TOKEN) - (SETQ FBBOX (LIST (READ IFILE) - (READ IFILE) - (READ IFILE) - (READ IFILE))) - - (* ;; "The Ascender and Descender properties from the AFM file are currently ignored, and the values from the FontBBox are used, SCALED to the height of the font.") - - (SETQ DESCENT (IABS (CADR FBBOX))) - (SETQ ASCENT (CADDDR FBBOX)) - (SETQ HEIGHT (IPLUS ASCENT DESCENT)) - [SETQ DESCENT (FIXR (FTIMES DESCENT (/ 1000 HEIGHT] - (SETQ ASCENT (FIXR (FTIMES ASCENT (/ 1000 HEIGHT] - (T (READCCODE IFILE] - (SETQ CMCOUNT (RATOM IFILE)) - (repeatuntil (EQ (CHARCODE EOL) - (READCCODE IFILE)) do) - (SETQ WIDTHS W) - (for CC from 1 to CMCOUNT - do (LET (CCODE) - (repeatuntil (EQ 'C (RATOM IFILE)) do) - (SETQ CCODE (READ IFILE)) - (RATOMS 'WX IFILE) - (SETQ CWIDTH (READ IFILE)) - [COND - ((CL:PLUSP CCODE) (* ; - "This character appears in the standard encoding, so just use the charcode.") - (COND - ((ILESSP CCODE FCHAR) - (SETQ FCHAR CCODE))) - (COND - ((IGREATERP CCODE LCHAR) - (SETQ LCHAR CCODE))) - (SETA W CCODE CWIDTH)) - (T (* ; "A character not in the standard encoding; look it up to see if it's one we need (eth & thorn are brought into the CS-0 codespace for UToronto's work).") - (repeatuntil (EQ 'N (RATOM IFILE)) do - - (* ;; - "Skip to the N entry, which gives the Adobe-standard name.") -) - (SETQ CNAME (RATOM IFILE)) - (* ; "GET THE NAME") - (SETQ CCODE (LISTGET *POSTSCRIPT-EXTRA-CHARACTERS* CNAME)) - (COND - (CCODE (COND - ((ILESSP CCODE FCHAR) - (SETQ FCHAR CCODE))) - (COND - ((IGREATERP CCODE LCHAR) - (SETQ LCHAR CCODE))) - (SETA W CCODE CWIDTH] - (repeatuntil (EQ (CHARCODE EOL) - (READCCODE IFILE)) do))) - (SETQ FIRSTCHAR FCHAR) - (SETQ LASTCHAR LCHAR)) - (CLOSEF IFILE) - PSCFONT]) - -(CONVERT-AFM-FILES - [LAMBDA (FILE-LIST) (* ; - "Edited 5-Aug-93 16:47 by sybalskY:MV:ENVOS") - (for FL in FILE-LIST do (LET ((FNAME (pop FL)) - FONT FILENAME) - (for AFM-FILE in FL as WEIGHT - in '(MEDIUM MEDIUM BOLD BOLD) as SLOPE - in '(REGULAR ITALIC REGULAR ITALIC) - do (SETQ FONT (READ-AFM-FILE AFM-FILE WEIGHT - SLOPE)) - (SETQ FILENAME (\FONTFILENAME - FNAME 1 (LIST WEIGHT SLOPE - 'REGULAR) - 'PSCFONT 0)) - (PSCFONT.WRITEFONT FILENAME FONT]) - -(POSTSCRIPT.GETFONTID - [LAMBDA (FID WEIGHT SLOPE EXPANSION) (* ; - "Edited 20-Nov-92 15:04 by sybalsky:mv:envos") - (LET (FONTID) - (SETQ FONTID (create FONTID - FONTIDNAME _ (CAR FID) - FONTXFACTOR _ 1.0 - FONTOBLIQUEFACTOR _ 0.0)) - [if (AND (NEQ (CADDR FID) - SLOPE) - (EQ SLOPE 'ITALIC)) - then (replace (FONTID FONTOBLIQUEFACTOR) of FONTID - with (CONSTANT (TAN 7.0] - (if (AND (NEQ (CADR FID) - WEIGHT) - (EQ WEIGHT 'BOLD)) - then (* ; "Fake bold by slight expansion.") - (replace (FONTID FONTXFACTOR) of FONTID with 1.1)) - [if (NEQ EXPANSION 'REGULAR) - then (replace (FONTID FONTXFACTOR) of FONTID - with (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) - (if (EQ EXPANSION 'COMPRESSED) - then (CONSTANT (QUOTIENT 1.0 GOLDEN.RATIO)) - else GOLDEN.RATIO] - FONTID]) - -(POSTSCRIPT.FONTCREATE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 29-Oct-93 16:39 by rmk:") - (* ; "Edited 3-Feb-93 17:22 by jds") - (LET (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD - FACECHANGED (WEIGHT (CAR FACE)) - (SLOPE (CADR FACE)) - (EXPANSION (CADDR FACE))) - - (* ;; - "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.") - - [COND - [(EQ SIZE 1) - - (* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info") - - (COND - ((SETQ PSCFD (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) - - (* ;; "Check in-core cache for exact match first") - - (SETQ FACECHANGED NIL)) - ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) - - (* ;; "Check file for exact match next") - - (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) - (SETQ FACECHANGED NIL)) - ((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION - ROTATION DEVICE)) - - (* ;; "Then check cache for coerced match") - - (SETQ FACECHANGED T)) - ((SETQ FULLNAME (PSCFONT.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION - DEVICE)) - - (* ;; "Check file for coerced match") - - (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) - (SETQ FACECHANGED T))) - (COND - (PSCFD (SETQ ASCENT (FIXR (TIMES (fetch (PSCFONT ASCENT) of PSCFD) - 0.1))) - (SETQ DESCENT (FIXR (TIMES (fetch (PSCFONT DESCENT) of PSCFD) - 0.1))) - (COND - (FACECHANGED (replace (PSCFONT IL-FONTID) of PSCFD - with (POSTSCRIPT.GETFONTID (fetch (PSCFONT - FID) - of PSCFD) - WEIGHT SLOPE EXPANSION] - ((SETQ UNITFONT (FONTCREATE FAMILY 1 FACE ROTATION DEVICE T)) - (SETQ PSCFD (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) of UNITFONT) - 'PSCFONT)) - - (* ;; "Scale the ASCENT and DESCENT") - - (SETQ ASCENT (FIXR (TIMES SIZE (fetch (PSCFONT ASCENT) of PSCFD) - 0.1))) - (SETQ DESCENT (FIXR (TIMES SIZE (fetch (PSCFONT DESCENT) of PSCFD) - 0.1))) - (SETQ SCALEFONTP T)) - (T - (* ;; "Here for fonts that only come in specific sizes. Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.") - - (COND - ([SETQ PSCFD (COND - ((PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) - ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION - DEVICE)) - (PSCFONT.READFONT FULLNAME] - (SETQ ASCENT (fetch (PSCFONT ASCENT) of PSCFD)) - (SETQ DESCENT (fetch (PSCFONT DESCENT) of PSCFD)) - (SETQ SCALEFONTP NIL] - (COND - (PSCFD - (* ;; "Set up the Charset descriptions and Widths vectors for character set 0:") - - (SETQ FD - (create FONTDESCRIPTOR - OTHERDEVICEFONTPROPS _ (LIST 'PSCFONT PSCFD) - FONTSCALE _ 100 - FONTDEVICE _ DEVICE - FONTFAMILY _ FAMILY - FONTSIZE _ SIZE - FONTFACE _ FACE - ROTATION _ 0 - \SFHeight _ (IPLUS ASCENT DESCENT) - \SFAscent _ ASCENT - \SFDescent _ DESCENT)) - (SETQ WIDTHSBLOCK (fetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO 0 FD))) - (SETQ FIXPWIDTHS (fetch (PSCFONT WIDTHS) of PSCFD)) - [COND - [SCALEFONTP (for CH from 0 to 255 - do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE - (ELT FIXPWIDTHS - CH) - 0.1] - (T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH - (ELT FIXPWIDTHS CH] - (SETQ PSCWIDTHSBLOCK (\CREATECSINFOELEMENT)) - - (* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.") - - (for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH - (\FGETWIDTH WIDTHSBLOCK CH))) - [LET [(TMP (COND - (FULLNAME (\FONTINFOFROMFILENAME FULLNAME DEVICE)) - (UNITFONT (fetch FONTDEVICESPEC of UNITFONT] - - (* ;; "If face got coerced (possibly in recursive call for unit font) then set FONTDEVICESPEC to describe what we really got") - - (COND - ((AND TMP (NEQ FAMILY (CAR TMP))) - (replace FONTDEVICESPEC of FD with (LIST (CAR TMP) - SIZE - (COPY FACE) - 0 DEVICE] - [LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION - DEVICE)) - (DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD - ROTATION DEVICE))) - - (* ;; - "Now run thru the mapping table, filling in the new font from whatever source is specified:") - - [MAPHASH *POSTSCRIPT-NS-HASH* - (FUNCTION (LAMBDA (MAPPING CODE) - (DESTRUCTURING-BIND - (KIND CODE2 BASECHAR) - MAPPING - - (* ;; - "Depending on what kind of item it is, process it:") - - (SELECTQ KIND - (NIL - (* ;; - "Translating an NS character to a PSC char in CS 0.") - - (\FSETCHARWIDTH FD CODE (\FGETWIDTH - PSCWIDTHSBLOCK - (\CHAR8CODE - CODE2)))) - (SYMBOL [AND SYMWIDTHS (\FSETCHARWIDTH - FD CODE (ELT SYMWIDTHS - (\CHAR8CODE - CODE2]) - (DINGBAT [AND DINGWIDTHS (\FSETCHARWIDTH - FD CODE (ELT DINGWIDTHS - (\CHAR8CODE - CODE2]) - (FUNCTION - (* ;; - "This is fake and only works for the fractions. Need a better case.") - - [\FSETCHARWIDTH - FD CODE - (IPLUS (\FGETWIDTH PSCWIDTHSBLOCK 164) - (FIXR (FTIMES 1.3 - (\FGETWIDTH - PSCWIDTHSBLOCK - (CHARCODE 1]) - (ACCENT (* ; - "CODE2 is the rendering character but width comes from width of basechar") - (\FSETCHARWIDTH FD CODE (\FGETWIDTH - PSCWIDTHSBLOCK - BASECHAR))) - (ACCENTPAIR - - (* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent") - - (\FSETCHARWIDTH FD CODE (\FGETWIDTH - PSCWIDTHSBLOCK - CODE2))) - (PROGN - - (* ;; "Skip APPLY*'s on this pass, waiting until normal characters get set up, so that widths of other NS characters are available. Also skip anything else") - - NIL] - - (* ;; "Now do APPLY*'s. MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)") - - (MAPHASH *POSTSCRIPT-NS-HASH* (FUNCTION (LAMBDA (MAPPING CODE) - (CL:WHEN (EQ (CAR MAPPING) - 'APPLY*) - (\FSETCHARWIDTH - FD CODE (APPLY* (CADDDR - MAPPING - ) - FD - (CADR MAPPING)) - ))] - FD) - (T NIL]) - -(\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS - [LAMBDA (TYPE FD ROTATION DEVICE) (* ; "Edited 5-Oct-93 18:21 by rmk:") - - (* ;; "Returns the scaled widths for a unit font of type TYPE (SYMBOL or ZAPFDINGBATS) compatible with FD. A separate function so that the unit widths can be easily cached.") - - (LET [TYPEFONT WIDTHS NEWWIDTHS (SIZE (FETCH FONTSIZE OF FD)) - (FONTFILE (OR (PSCFONT.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR FONTFACE) - OF FD) - ROTATION DEVICE) - (PSCFONT.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) - ROTATION DEVICE] - [SETQ TYPEFONT (COND - ((PSCFONTFROMCACHE.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR - FONTFACE) - OF FD) - ROTATION DEVICE)) - ((SETQ FONTFILE (PSCFONT.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR - FONTFACE) - OF FD) - ROTATION DEVICE)) - (PSCFONT.READFONT FONTFILE)) - ((PSCFONTFROMCACHE.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) - ROTATION DEVICE)) - ((SETQ FONTFILE (PSCFONT.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) - ROTATION DEVICE)) - (PSCFONT.READFONT FONTFILE] - (CL:WHEN (AND TYPEFONT (SETQ WIDTHS (FETCH (PSCFONT WIDTHS) OF TYPEFONT))) - (SETQ NEWWIDTHS (ARRAY 256 'SMALLPOSP 0 0)) - - (* ;; "Have to copy because of scaling") - - [FOR CH FROM 0 TO 255 DO (SETA NEWWIDTHS CH - (FIXR (TIMES SIZE (ELT WIDTHS CH) - 0.1] - NEWWIDTHS)]) - -(POSTSCRIPT.FONTSAVAILABLE - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 12-Jan-88 13:04 by Matt Heffron") - - (* ;; "the filtering code was borrowed from Richard Burton's \SEARCHINTERPRESSFONTS. Note that without it [HELVETICA * (MEDIUM REGULAR REGULAR)] would pick up [HELVETICA-NARROW * (MEDIUM REGULAR REGULAR)] as well.") - - (LET - ((PATTERN (\FONTFILENAME (OR (CDR (ASSOC FAMILY POSTSCRIPT.FONT.ALIST)) - FAMILY) - SIZE FACE 'PSCFONT)) - [INVERSE.ALIST (for PAIR in POSTSCRIPT.FONT.ALIST collect (CONS (CDR PAIR) - (CAR PAIR] - FONTSAVAILABLE) - (SETQ FONTSAVAILABLE - (for FD in [for DIRECTORY in POSTSCRIPTFONTDIRECTORIES - join (for FILE in (DIRECTORY (CONCAT DIRECTORY PATTERN)) - collect (LET* ((RAWFD (\FONTINFOFROMFILENAME FILE DEVICE) - ) - (RAWNAME (CAR RAWFD))) - (RPLACA RAWFD - (OR (CDR (ASSOC RAWNAME - INVERSE.ALIST)) - RAWNAME] - when (AND (OR (EQ FAMILY '*) - (EQ FAMILY (CAR FD))) - (OR (EQ SIZE '*) - (EQ SIZE (CADR FD)) - (EQ (CADR FD) - 1)) - (OR (EQ FACE '*) - (EQUAL FACE (CADDR FD)) - (EQUAL [CDR (ASSOC FACE '((MRR MEDIUM REGULAR REGULAR) - (STANDARD MEDIUM REGULAR REGULAR) - (MIR MEDIUM ITALIC REGULAR) - (ITALIC MEDIUM ITALIC REGULAR) - (BRR BOLD REGULAR REGULAR) - (BOLD BOLD REGULAR REGULAR) - (BIR BOLD ITALIC REGULAR) - (BOLDITALIC BOLD ITALIC REGULAR] - (CADDR FD))) - (NOT (MEMBER FD $$VAL))) collect FD)) - (if (EQ SIZE '*) - then - -(* ;;; "If SIZE was wildcarded, then provide list of pointsizes for Postscript scaled fonts (those with a 1 point descriptor file)") - - (for FD in FONTSAVAILABLE - join (if (EQ 1 (CADR FD)) - then (CONS FD (for NF - in (for S from 2 to - \POSTSCRIPT.MAX.WILD.FONTSIZE - collect (LET ((NFD (COPY FD))) - (RPLACA (CDR NFD) - S) - NFD)) - unless (MEMBER NF FONTSAVAILABLE) collect - NF)) - else (LIST FD))) - else FONTSAVAILABLE]) -) - - - -(* ;; "Until macro in FONT is exported") - -(DECLARE%: EVAL@COMPILE - -(PUTPROPS \FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) - (\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO - (\CHARSET CHARCODE) - FONTDESC)) - (\CHAR8CODE CHARCODE) - WIDTH))) -) -(DEFINEQ - -(OPENPOSTSCRIPTSTREAM - [LAMBDA (FILE OPTIONS) (* ; "Edited 12-Jun-2021 19:14 by rmk:") - (* ; - "Edited 31-May-93 12:42 by sybalsky:mv:envos") - (* ; "Edited 23-Dec-92 01:17 by jds") - - (* ;; "RMK: Note: At open, this does a lot of printing using generic functions which invoke the generic \OUTCHARFN of the stream. We set that up as BOUT. But after the stream is open, we install the \POSTSCRIPT.OUTCHARFN, below. We also have to make sure that other internal printing that may want to use generic functions (PRIN1, PRIN3...) for convenience, doesn't cycle through the postscript outcharfn.") - - (LET [[STREAM (OPENSTREAM (PACKFILENAME 'BODY FILE 'EXTENSION 'PS) - 'OUTPUT NIL `((TYPE ,*POSTSCRIPT-FILE-TYPE*) - (SEQUENTIAL T] - (IMAGEDATA (create \POSTSCRIPTDATA)) - PAPER IMAGESIZEFACTOR CLIP REG (BBOX (LISTGET OPTIONS 'BOUNDINGBOX] - (replace (STREAM IMAGEDATA) of STREAM with IMAGEDATA) - (replace (STREAM IMAGEOPS) of STREAM with \POSTSCRIPTIMAGEOPS) - (replace (STREAM OUTCHARFN) OF STREAM WITH (FUNCTION BOUT)) - - (* ;; "Bounding box is for encapsulated postscript. The bounding box is in Medley's postscript-coordinate system, so we have to scale it back to default postscript since it will be interpreted outside of the operators specified below. CEIL and FLOOR to make sure that we don't leave anything out. We may also want to change the header to have the EPSF qualifier") - - (printout STREAM "%%!PS-Adobe-2.0" T %# (CL:WHEN BBOX - (PRINTOUT STREAM "%%%%BoundingBox: " - (CL:FLOOR (CAR BBOX) - \PS.SCALE0) - " " - (CL:FLOOR (CADR BBOX) - \PS.SCALE0) - " " - (CL:CEILING (CADDR BBOX) - \PS.SCALE0) - " " - (CL:CEILING (CADDDR BBOX) - \PS.SCALE0) - T)) - "%%%%Title: " - (MKSTRING (OR (LISTGET OPTIONS 'DOCUMENT.NAME) - FILE)) - T "%%%%Creator: PostScript Driver Copyright (C) 1988-1992 Venue and others" T - "%%%%CreationDate: " (DATE) - T %# (COND - ((EQ 'LPT (FILENAMEFIELD STREAM 'HOST)) - - (* ;; "Put current user's name on break page only if going to LPT for immediate printing. Presumably the print-spooler itself should know what the user's system login-name is, but that may not be the case for all printers in all environments.") - - (PRINTOUT NIL "%%%%For: " (MKSTRING USERNAME) - T))) - "%%%%EndComments" T) - (for X in \POSTSCRIPT.JOB.SETUP do (POSTSCRIPT.OUTSTR STREAM X) - (\BOUTEOL STREAM)) - (SETQ PAPER (OR (CDR (CL:ASSOC (SETQ PAPER (OR (LISTGET OPTIONS 'PAGETYPE) - (LISTGET OPTIONS 'PAPERTYPE) - POSTSCRIPT.PAGETYPE)) - POSTSCRIPT.PAGEREGIONS :TEST #'STRING-EQUAL)) - (ERROR "Unknown PostScript page type" PAPER))) - - (* ;; "Set the paper size:") - - (PRINTOUT STREAM (L-CASE (OR (LISTGET OPTIONS 'PAGETYPE) - (LISTGET OPTIONS 'PAPERTYPE) - POSTSCRIPT.PAGETYPE)) - T) - (COND - ((NOT (AND [SETQ IMAGESIZEFACTOR (NUMBERP (LISTGET OPTIONS 'IMAGESIZEFACTOR] - (CL:PLUSP IMAGESIZEFACTOR))) - (SETQ IMAGESIZEFACTOR 1))) - [COND - ((AND (NUMBERP POSTSCRIPT.IMAGESIZEFACTOR) - (CL:PLUSP POSTSCRIPT.IMAGESIZEFACTOR)) - (SETQ IMAGESIZEFACTOR (TIMES IMAGESIZEFACTOR POSTSCRIPT.IMAGESIZEFACTOR] - (printout STREAM "/imagesizefactor " IMAGESIZEFACTOR " def" T) - (printout STREAM "%%%%EndSetup" T) - (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with \PS.SCALE0) - (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA - with (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) - IMAGESIZEFACTOR) - (CAR PAPER))) - - (* ;; - "Initial clipping region can be specified separately from the page size, default is to page size.") - - [replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA - with (SETQ CLIP (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) - IMAGESIZEFACTOR) - (OR (CADR PAPER) - (CAR PAPER] - - (* ;; "If a REGION parameter was supplied, it establishes the initial margins.") - - (SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION)) - (INTERSECTREGIONS REG CLIP)) - (CREATEREGION 3600 3600 54000 72000))) - (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - with (fetch (REGION LEFT) of REG)) - (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA - with (fetch (REGION BOTTOM) of REG)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA - with (PLUS (fetch (REGION BOTTOM) of REG) - (fetch (REGION HEIGHT) of REG) - -1)) - (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - with (PLUS (fetch (REGION LEFT) of REG) - (fetch (REGION WIDTH) of REG) - -1)) - (\DSPFONT.PSC STREAM (FONTCREATE (OR [CAR (MKLIST (LISTGET OPTIONS 'FONTS] - DEFAULTFONT) - NIL NIL NIL STREAM)) - (\SWITCHFONTS.PSC STREAM IMAGEDATA) - [COND - ((replace (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA - with (LISTGET OPTIONS 'HEADING)) - (replace (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) of IMAGEDATA - with (COND - ((LISTGET OPTIONS 'HEADINGFONT) - (FONTCREATE (LISTGET OPTIONS 'HEADINGFONT) - NIL NIL NIL STREAM)) - (T (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA] - - (* ;; "Decide if it's landscape: if (LANDSCAPE T) appears in OPTIONS, it is. IF ROTATION isn't DEFAULT, it is.") - - (COND - ([COND - ((CL:GETF OPTIONS 'LANDSCAPE NIL)) - ((EQL (CL:GETF OPTIONS 'ROTATION 'DEFAULT) - 'DEFAULT) - (COND - ((EQL POSTSCRIPT.PREFER.LANDSCAPE 'ASK) - (MENU \POSTSCRIPT.ORIENTATION.MENU)) - (T POSTSCRIPT.PREFER.LANDSCAPE))) - (T (CL:GETF OPTIONS 'ROTATION] - (POSTSCRIPT.SET-FAKE-LANDSCAPE STREAM 90))) - - (* ;; "Now we are ready for callers to use generic functions--see note above. The special external format ensures that e.g. COPYCHARS won't do COPYBYTES when copying from a text file to a PS stream.") - - (\EXTERNALFORMAT STREAM (CREATE EXTERNALFORMAT - NAME _ 'POSTSCRIPT - OUTCHARFN _ (FUNCTION \POSTSCRIPT.OUTCHARFN) - EOL _ (FETCH (STREAM EOLCONVENTION) OF STREAM))) - (POSTSCRIPT.STARTPAGE STREAM) - STREAM]) - -(CLOSEPOSTSCRIPTSTREAM - [LAMBDA (STREAM) (* ; "Edited 24-Jun-2023 13:48 by rmk") - (* ; "Edited 8-Mar-93 10:31 by jds") - (POSTSCRIPT.ENDPAGE STREAM) (* BOUT STREAM (CHARCODE ^D)) - (* ; "Should this be the lsat byte?") - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Trailer" :EOL]) -) - -(RPAQ? *POSTSCRIPT-FILE-TYPE* 'BINARY) -(DEFINEQ - -(POSTSCRIPT.HARDCOPYW - [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) - (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (ALLOW.BUTTON.EVENTS) - (LET* ((STREAM (OPENPOSTSCRIPTSTREAM FILE (LIST 'DOCUMENT.NAME TITLE 'ROTATION Landscape? - 'IMAGESIZEFACTOR SCALEFACTOR))) - (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (SCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA)) - SCALE) - [COND - [REGION (SETQ REGION (COPY REGION)) (* ; "In case we need to change it.") - [COND - ((< (fetch BITMAPWIDTH of BITMAP) - (+ (fetch (REGION LEFT) of REGION) - (fetch (REGION WIDTH) of REGION))) - (replace (REGION WIDTH) of REGION with (- (fetch BITMAPWIDTH - of BITMAP) - (fetch (REGION - LEFT) - of REGION] - (COND - ((< (fetch BITMAPHEIGHT of BITMAP) - (+ (fetch (REGION BOTTOM) of REGION) - (fetch (REGION HEIGHT) of REGION))) - (replace (REGION HEIGHT) of REGION - with (- (fetch BITMAPHEIGHT of BITMAP) - (fetch (REGION BOTTOM) of REGION] - (T (SETQ REGION (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (fetch BITMAPWIDTH of BITMAP) - HEIGHT _ (fetch BITMAPHEIGHT of BITMAP] - (SETQ SCALE (TIMES POSTSCRIPT.BITMAP.SCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) - of IMAGEDATA))) - (BITBLT BITMAP (fetch (REGION LEFT) of REGION) - (fetch (REGION BOTTOM) of REGION) - STREAM - (PLUS (fetch (REGION LEFT) of SCLIP) - (QUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of SCLIP) - (TIMES SCALE (fetch (REGION WIDTH) of REGION))) - 2)) - (PLUS (fetch (REGION BOTTOM) of SCLIP) - (QUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of SCLIP) - (TIMES SCALE (fetch (REGION HEIGHT) of REGION))) - 2)) - (fetch (REGION WIDTH) of REGION) - (fetch (REGION HEIGHT) of REGION) - 'INPUT - 'REPLACE) - (CLOSEF STREAM) - (FULLNAME STREAM]) - -(POSTSCRIPT.TEDIT - [LAMBDA (FILE PFILE) (* ; "Edited 18-Sep-91 18:16 by jds") - - (* ;; "Make a PS file from a TEdit document. If FILE is a string, make it into a symbol for the file-name. If it's a STREAM, use that stream.") - - [COND - ((STRINGP FILE) - (SETQ FILE (MKATOM FILE] - (SETQ FILE (OPENTEXTSTREAM FILE)) - (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL NIL 'POSTSCRIPT) - (CLOSEF? FILE) - PFILE]) - -(POSTSCRIPT.TEXT - [LAMBDA (FILE PSCFILE FONTS HEADING TABS) (* ; "Edited 23-Apr-89 11:31 by TAL") - (TEXTTOIMAGEFILE FILE PSCFILE 'POSTSCRIPT FONTS HEADING TABS - `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION ROTATION ,(NOT (NOT POSTSCRIPT.TEXTFILE.LANDSCAPE]) - -(POSTSCRIPTFILEP - [LAMBDA (FILE) (* ; "Edited 5-Mar-93 21:40 by rmk:") - (* ; "Edited 14-Jan-93 10:56 by jds") - (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) - '("PS" "PSC" "PSF") - :TEST - (FUNCTION STRING-EQUAL)) - (PROGN (SETFILEPTR FILE 0) - (PROG1 (AND (EQ (BIN FILE) - (CHARCODE %%)) - (EQ (BIN FILE) - (CHARCODE !))) - (SETFILEPTR FILE 0]) - -(MAKEEPSFILE - [LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 7-Apr-94 14:48 by rmk:") - - (* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file. The lower-left corner of the image box will be at 0,0 on the page.") - - (LET* [(STREAM (OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT)) - (IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN) - IMAGEOBJ STREAM)) - (BOUNDINGBOX (LIST 0 0 (FETCH XSIZE OF IMAGEBOX) - (FETCH YSIZE OF IMAGEBOX] - [SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT - `(BOUNDINGBOX (0 0 ,(FETCH XSIZE OF IMAGEBOX) - ,(FETCH YSIZE OF IMAGEBOX] - (MOVETO (FETCH XKERN OF IMAGEBOX) - (FETCH YDESC OF IMAGEBOX) - STREAM) - (APPLY* (IMAGEOBJPROP IMAGEOBJ 'DISPLAYFN) - IMAGEOBJ STREAM) - (CLOSEF STREAM]) -) -(DEFINEQ - -(POSTSCRIPT.BITMAPSCALE - [LAMBDA (WIDTH HEIGHT) (* ; "Edited 29-Apr-98 08:46 by rmk:") - (* ; - "Edited 20-Nov-92 14:52 by sybalsky:mv:envos") - (LET* ([PAGEREGION (\PS.SCALEREGION (/ 72 POSTSCRIPT.BITMAP.SCALE) - (CADR (FASSOC POSTSCRIPT.PAGETYPE POSTSCRIPT.PAGEREGIONS] - (LONGEDGE (MAX (fetch (REGION WIDTH) of PAGEREGION) - (fetch (REGION HEIGHT) of PAGEREGION))) - (SHORTEDGE (MIN (fetch (REGION WIDTH) of PAGEREGION) - (fetch (REGION HEIGHT) of PAGEREGION))) - [MINDIMP (MIN (FQUOTIENT LONGEDGE (SETQ HEIGHT (TIMES HEIGHT POSTSCRIPT.BITMAP.SCALE))) - (FQUOTIENT SHORTEDGE (SETQ WIDTH (TIMES WIDTH POSTSCRIPT.BITMAP.SCALE] - (MINDIML (MIN (FQUOTIENT SHORTEDGE HEIGHT) - (FQUOTIENT LONGEDGE WIDTH))) - (PPL (if (EQ POSTSCRIPT.PREFER.LANDSCAPE 'ASK) - then (MENU \POSTSCRIPT.ORIENTATION.MENU) - else POSTSCRIPT.PREFER.LANDSCAPE)) - MINDIM OTHERDIM SF1 SF2) - (if PPL - then (SETQ MINDIM MINDIML) - (SETQ OTHERDIM MINDIMP) - else (SETQ MINDIM MINDIMP) - (SETQ OTHERDIM MINDIML)) - (SETQ SF1 (if (GREATERP MINDIM 1) - then 1 - elseif (GREATERP MINDIM 0.75) - then 0.75 - elseif (GREATERP MINDIM 0.5) - then 0.5 - elseif (GREATERP MINDIM 0.25) - then 0.25 - else MINDIM)) - (SETQ SF2 (if (GREATERP OTHERDIM 1) - then 1 - elseif (GREATERP OTHERDIM 0.75) - then 0.75 - elseif (GREATERP OTHERDIM 0.5) - then 0.5 - elseif (GREATERP OTHERDIM 0.25) - then 0.25 - else OTHERDIM)) - (if (AND (LESSP SF1 1) - (LESSP SF1 SF2)) - then (CONS SF2 (NOT PPL)) - else (CONS SF1 PPL]) - -(POSTSCRIPT.CLOSESTRING - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (COND - ((fetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (POSTSCRIPT.OUTSTR STREAM ") ") - (replace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL) - T) - (T NIL]) - -(POSTSCRIPT.ENDPAGE - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (POSTSCRIPT.SHOWACCUM STREAM) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) - (COND - ((NOT (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA) - (POSTSCRIPT.PUTCOMMAND STREAM "grestore savepage restore "))) - (POSTSCRIPT.PUTCOMMAND STREAM "showpage" :EOL))) - - (* ;; -"Force re-encoding of fonts, because the restore wipes out any you encoded while writing this page.") - - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of IMAGEDATA with NIL]) - -(POSTSCRIPT.OUTSTR - [LAMBDA (STREAM X) (* ; "Edited 14-Jul-89 14:05 by Matt Heffron") - (DECLARE (LOCALVARS . T)) - (COND - ((FIXP X) (* ; "Common case, speed helps") - (\PS.BOUTFIXP STREAM X)) - [(STRINGP X) (* ; "Other common case") - (COND - [(ffetch (STRINGP FATSTRINGP) of X) - (for c infatstring X do (BOUT STREAM (\CHAR8CODE c] - (T (\BOUTS STREAM (ffetch (STRINGP BASE) of X) - (ffetch (STRINGP OFFST) of X) - (ffetch (STRINGP LENGTH) of X] - [(LITATOM X) - (for c inatom X do (BOUT STREAM (\CHAR8CODE c] - ((ZEROP X) - (BOUT STREAM (CHARCODE 0))) - (T [COND - ((TYPEP X 'RATIO) - (SETQ X (FLOAT X] - (for c in (CHCON X) do (BOUT STREAM (\CHAR8CODE c]) - -(POSTSCRIPT.PUTBITMAPBYTES - [LAMBDA (STREAM BITMAP DELIMFLG) - (DECLARE (GLOBALVARS PS.BITMAPARRAY) - (LOCALVARS . T)) (* ; "Edited 12-Jun-2021 15:17 by rmk:") - (LET* - ((WIDTH (fetch BITMAPWIDTH of BITMAP)) - (HEIGHT (fetch BITMAPHEIGHT of BITMAP)) - (BMBASE (fetch BITMAPBASE of BITMAP)) - (BYTESPERROW (LRSH (IPLUS WIDTH 7) - 3)) - (BYTEOFFSETPERROW (LSH (fetch BITMAPRASTERWIDTH of BITMAP) - 1)) - (PS.BITMAPARRAYBASE (fetch (ARRAYP BASE) of PS.BITMAPARRAY))) - (COND - (DELIMFLG (LET ((POS 0) - BYTE) - (BOUT STREAM (CHARCODE SPACE)) - (BOUT STREAM (CHARCODE <)) - (\BOUTEOL STREAM) - (for R from (SUB1 HEIGHT) to 0 by -1 as ROWOFFSET - from (ITIMES (SUB1 HEIGHT) - BYTEOFFSETPERROW) by (IMINUS BYTEOFFSETPERROW) - do (for B from 1 to BYTESPERROW as BYTEOFFSET - from ROWOFFSET by 1 - do (COND - ((IGEQ POS 254) - (\BOUTEOL STREAM) - (SETQ POS 0))) - (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) - [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH BYTE 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 BYTE))) - (SETQ POS (IPLUS POS 2))) - (\BOUTEOL STREAM) - (SETQ POS 0)) - (BOUT STREAM (CHARCODE SPACE)) - (BOUT STREAM (CHARCODE >)) - (\BOUTEOL STREAM))) - (T - (LET* - ((PRVBM (BITMAPCREATE WIDTH 1)) - (PRVBASE (fetch BITMAPBASE of PRVBM))) - (for R from 0 to (SUB1 HEIGHT) as ROWOFFSET - from (ITIMES (SUB1 HEIGHT) - BYTEOFFSETPERROW) by (IMINUS BYTEOFFSETPERROW) - do - (LET ((POS 0) - (BYTEOFFSET ROWOFFSET) - (B 1) - (PRVO 0) - BYTE REPC) - [while (ILEQ B BYTESPERROW) - do (SETQ REPC - (for BB from B to BYTESPERROW as BO from BYTEOFFSET - by 1 as PO from PRVO by 1 - while (EQ (\GETBASEBYTE BMBASE BO) - (\GETBASEBYTE PRVBASE PO)) count T)) - (COND - [(IGEQ REPC 3) - (SETQ B (IPLUS B REPC)) - (SETQ BYTEOFFSET (IPLUS BYTEOFFSET REPC)) - (SETQ PRVO (IPLUS PRVO REPC)) - (while (CL:PLUSP (SETQ REPC (IDIFFERENCE REPC 1))) - do (COND - ((IGEQ POS 251) - (\BOUTEOL STREAM) - (SETQ POS 0))) - (BOUT STREAM (CHARCODE B)) - (BOUT STREAM (CHARCODE 3)) - [COND - ((IGEQ REPC 256) - (BOUT STREAM (CHARCODE F)) - (BOUT STREAM (CHARCODE F))) - (T [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH REPC 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 REPC] - (SETQ REPC (IDIFFERENCE REPC 256)) - (SETQ POS (IPLUS POS 4] - (T (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) - (SETQ REPC - (for BB from B to BYTESPERROW as BO from - BYTEOFFSET - by 1 while (EQ (\GETBASEBYTE BMBASE BO) - BYTE) count T)) - (COND - [(IGEQ REPC 3) - (SETQ B (IPLUS B REPC)) - (SETQ BYTEOFFSET (IPLUS BYTEOFFSET REPC)) - (SETQ PRVO (IPLUS PRVO REPC)) - (while (CL:PLUSP (SETQ REPC (IDIFFERENCE REPC 1))) - do (COND - ((IGEQ POS 249) - (\BOUTEOL STREAM) - (SETQ POS 0))) - (BOUT STREAM (CHARCODE B)) - (BOUT STREAM (CHARCODE 2)) - [COND - ((IGEQ REPC 256) - (BOUT STREAM (CHARCODE F)) - (BOUT STREAM (CHARCODE F))) - (T [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH REPC 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 REPC] - [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH BYTE 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 BYTE))) - (SETQ REPC (IDIFFERENCE REPC 256)) - (SETQ POS (IPLUS POS 4] - (T (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) - (COND - ((IGEQ POS 251) - (\BOUTEOL STREAM) - (SETQ POS 0))) - [COND - ((FMEMB BYTE '(178 179 180)) - - (* ;; "BYTE is B2, B3, or B4; quote it") - - (BOUT STREAM (CHARCODE B)) - (BOUT STREAM (CHARCODE 4)) - (SETQ POS (IPLUS POS 2] - [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE - (LOGAND 15 (LRSH BYTE 4] - (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE (LOGAND 15 BYTE) - )) - (SETQ B (IPLUS B 1)) - (SETQ BYTEOFFSET (IPLUS BYTEOFFSET 1)) - (SETQ PRVO (IPLUS PRVO 1)) - (SETQ POS (IPLUS POS 2] - (\BOUTEOL STREAM)) - (\MOVEBYTES BMBASE ROWOFFSET PRVBASE 0 BYTESPERROW]) - -(POSTSCRIPT.PUTCOMMAND - [LAMBDA S.STRS (* ; "Edited 12-Jun-2021 15:14 by rmk:") - (LET* ((STREAM (ARG S.STRS 1)) - (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - S#S) - (freplace (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA with NIL) - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (POSTSCRIPT.SHOWACCUM STREAM))) - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) - (\SETXFORM.PSC STREAM IMAGEDATA))) - (for STR# from 2 to S.STRS do (COND - ((EQ (SETQ S#S (ARG S.STRS STR#)) - :EOL) - (\BOUTEOL STREAM)) - (T (POSTSCRIPT.OUTSTR STREAM S#S]) - -(POSTSCRIPT.SET-FAKE-LANDSCAPE - [LAMBDA (STREAM ROTATION) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - - (* ;; "Set up for (or disable) fake landscaping") - - (* ;; - "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") - - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLAND (COND - ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) - 90) - (T 0))) - LAND C0 P0 C P ML MB MR MT) - (COND - ((AND ROTATION (NEQ (SETQ LAND (NOT (ZEROP ROTATION))) - (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA))) - (POSTSCRIPT.SHOWACCUM STREAM) - (\DSPTRANSLATE.PSC STREAM 0 0) - (SETQ C0 (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA)) - (SETQ P0 (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA)) - (SETQ C (create REGION - WIDTH _ (fetch (REGION HEIGHT) of C0) - HEIGHT _ (fetch (REGION WIDTH) of C0))) - (SETQ P (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (fetch (REGION HEIGHT) of P0) - HEIGHT _ (fetch (REGION WIDTH) of P0))) - [COND - (LAND (replace (REGION LEFT) of C with (fetch (REGION BOTTOM) - of C0)) - [replace (REGION BOTTOM) of C with - (- (fetch (REGION WIDTH) - of P0) - (+ (fetch (REGION LEFT) - of C0) - (fetch (REGION WIDTH) - of C0] - (SETQ ML (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) - ) - (SETQ MB (- (fetch (REGION WIDTH) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of - IMAGEDATA - ) - 1)) - (SETQ MR (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA)) - (SETQ MT (- (fetch (REGION WIDTH) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - ) - 1))) - (T [replace (REGION LEFT) of C with (- (fetch (REGION HEIGHT) - of P0) - (+ (fetch (REGION BOTTOM) - of C0) - (fetch (REGION HEIGHT) - of C0] - (replace (REGION BOTTOM) of C with (fetch (REGION LEFT) - of C0)) - (SETQ ML (- (fetch (REGION HEIGHT) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - 1)) - (SETQ MB (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA)) - (SETQ MR (- (fetch (REGION HEIGHT) of P0) - (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) - 1)) - (SETQ MT (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA] - (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with - C) - (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA with P) - (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with ML) - (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA with MB) - (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA with MR) - (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA with MT) - (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA with LAND) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) - (\DSPRESET.PSC STREAM))) - OLAND]) - -(POSTSCRIPT.SHOWACCUM - [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 15:16 by rmk:") - - (* ;; - "Send commands to SHOW the accumulated characters. Uses S (= SHOW) for regular characters.") - - (* ;; "Uses WIDTHSHOW if the space-factor isn't 1") - - (* ;; "Uses ASHOW if a KERN value is on STREAM's properties") - - (* ;; "USES AWIDTHSHOW if both space-factor != 1 and there's a KERN value.") - - (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM)) - KERN) - (COND - ((fetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (SETQ KERN (STREAMPROP STREAM 'KERN)) - [COND - [(EQP (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA) - 1) - (COND - (KERN (POSTSCRIPT.OUTSTR STREAM (CONCAT ") " KERN " 0 3 -1 roll ashow"))) - (T (POSTSCRIPT.OUTSTR STREAM ") S"] - (T (POSTSCRIPT.OUTSTR STREAM ") ") - (POSTSCRIPT.OUTSTR STREAM (DIFFERENCE (ffetch (\POSTSCRIPTDATA - POSTSCRIPTSPACEWIDTH) - of IMAGEDATA) - (ffetch (\POSTSCRIPTDATA - POSTSCRIPTNATURALSPACEWIDTH - ) of IMAGEDATA))) - (COND - (KERN (POSTSCRIPT.OUTSTR STREAM (CONCAT " 0 " (CHARCODE SPACE) - " " KERN " 0 " - " 6 -1 roll awidthshow"))) - (T (POSTSCRIPT.OUTSTR STREAM (CONSTANT (CONCAT " 0 " (CHARCODE SPACE) - " 4 -1 roll widthshow"] - (\BOUTEOL STREAM) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL]) - -(POSTSCRIPT.STARTPAGE - [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 14:52 by rmk:") - - (* ;; "Start up a new page in a Postscript document.") - - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - NEW-PAGE) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) - (* ; "shouldnt need this") - (SETQ NEW-PAGE (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGENUM) of IMAGEDATA))) - (* ; "Page number goes up by 1") - - (* ;; "Print the %"Document structuring%" info for the page, then the initial page setup") - - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Page: " NEW-PAGE " " NEW-PAGE :EOL - "%%%%BeginPageSetup" :EOL "/savepage save def" :EOL (FQUOTIENT 1 \PS.SCALE0) - " imagesizefactor mul dup scale" :EOL "%%%%EndPageSetup" :EOL) - (\SETXFORM.PSC STREAM IMAGEDATA T) - - (* ;; "Lisp depends on the current font being carried over from page to page, but in postscript there is no current font at the beginning of a page, so force a setfont.") - - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T) - (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA with T) - (* ; "nothing printed yet...") - (COND - ((fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA) - - (* ;; "Here we handle headings.") - - (LET [(FONT (\DSPFONT.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) - of IMAGEDATA] - (\DSPRESET.PSC STREAM) - (POSTSCRIPT.OUTSTR STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) - of IMAGEDATA)) - (RELMOVETO (CONSTANT (TIMES 72 \PS.SCALE0)) - 0 STREAM) (* ; "Skip an inch before page number") - (POSTSCRIPT.OUTSTR STREAM "Page ") - (POSTSCRIPT.OUTSTR STREAM NEW-PAGE) - (\TERPRI.PSC STREAM) (* ; "Skip 2 lines") - (\TERPRI.PSC STREAM) - (\DSPFONT.PSC STREAM FONT))) - (T (\DSPRESET.PSC STREAM]) - -(\POSTSCRIPTTAB - [LAMBDA (POSTSCRIPTDATA) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (LET [(TABSPACE (TIMES 8 (ffetch FONTAVGCHARWIDTH of (ffetch (\POSTSCRIPTDATA - POSTSCRIPTFONT) - of POSTSCRIPTDATA] - (IDIFFERENCE TABSPACE (IREMAINDER (IDIFFERENCE (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) - of POSTSCRIPTDATA) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) - of POSTSCRIPTDATA)) - TABSPACE]) - -(\PS.BOUTFIXP - [LAMBDA (STREAM N) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - - (* ;; "BOUT the decimal representation of N to STREAM using temp storage from the imagedata. Done this way for speed.") - - (DECLARE (LOCALVARS . T)) - [COND - ((MINUSP N) - (BOUT STREAM (CHARCODE -)) - (SETQ N (IMINUS N] - (COND - [(LESSP N 10) - (BOUT STREAM (IPLUS N (CHARCODE 0] - [(LESSP N 1000000000) - (LET ([BASE (fetch (ARRAYP BASE) of (fetch (\POSTSCRIPTDATA POSTSCRIPTTEMPARRAY) - of (fetch (STREAM IMAGEDATA) - of STREAM] - (i (SUB1 \PS.TEMPARRAYLEN))) - [for old i by -1 do (\PUTBASEBYTE BASE i (IPLUS (IREMAINDER N 10) - (CHARCODE 0))) - repeatwhile (NEQ 0 (SETQ N (IQUOTIENT N 10] - (\BOUTS STREAM BASE i (IDIFFERENCE \PS.TEMPARRAYLEN i] - (T (* ; "Just in case we get a bignum") - (for c in (CHCON N) do (BOUT STREAM (\CHAR8CODE c]) - -(\PS.SCALEHACK - [LAMBDA (STREAM SCALEFACTOR) (* ; - "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA)) - FACTOR) - (COND - ((AND (NUMBERP SCALEFACTOR) - (NOT (EQP OLDSCALE SCALEFACTOR))) - (POSTSCRIPT.SHOWACCUM STREAM) - (SETQ FACTOR (/ OLDSCALE SCALEFACTOR)) - [for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA) - (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) - of IMAGEDATA)) - do (change (fetch (REGION LEFT) of REG) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (REGION BOTTOM) of REG) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (REGION WIDTH) of REG) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (REGION HEIGHT) of REG) - (FIXR (CL:* DATUM FACTOR] - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) - (FIXR (CL:* DATUM FACTOR))) - (replace (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA with - SCALEFACTOR) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T))) - OLDSCALE]) - -(\PS.SCALEREGION - [LAMBDA (SCALE REGION) (* ; "Edited 5-Apr-89 16:15 by TAL") - (* ; "Scales a region") - (create REGION - LEFT _ (FIXR (TIMES SCALE (fetch (REGION LEFT) of REGION))) - BOTTOM _ (FIXR (TIMES SCALE (fetch (REGION BOTTOM) of REGION))) - WIDTH _ (FIXR (TIMES SCALE (fetch (REGION WIDTH) of REGION))) - HEIGHT _ (FIXR (TIMES SCALE (fetch (REGION HEIGHT) of REGION]) - -(\SCALEDBITBLT.PSC - [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT - SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM - SCALE) (* ; "Edited 8-May-2018 19:33 by rmk:") - (* ; "Edited 8-May-2018 15:05 by rmk:") - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - - (* ;; "Postscript can only handle OPERATION REPLACE and PAINT. SOURCETYPE = TEXTURE is converted to BLTSHADE before getting here (so the TEXTURE argument can be ignored). If the destination region lies completely outside the clipping region we do nothing, otherwise we output the whole thing and let the printer clip. Could be more clever.") - - (OR (NUMBERP SCALE) - (SETQ SCALE 1)) - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (SCALE1 (TIMES SCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA))) - (SCALE2 (TIMES SCALE1 (OR (NUMBERP POSTSCRIPT.BITMAP.SCALE) - 1))) - DESTREGION - (BITMAPWIDTH (fetch BITMAPWIDTH of SOURCEBITMAP)) - (BITMAPHEIGHT (fetch BITMAPHEIGHT of SOURCEBITMAP)) - TEMPBM) - [COND - ((NULL DESTINATIONLEFT) - (SETQ DESTINATIONLEFT (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA] - [COND - ((NULL DESTINATIONBOTTOM) - (SETQ DESTINATIONBOTTOM (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA] - (COND - ((OR (NULL WIDTH) - (NULL HEIGHT)) - (SETQ WIDTH BITMAPWIDTH) - (SETQ HEIGHT BITMAPHEIGHT))) - (COND - ((GREATERP WIDTH BITMAPWIDTH) - (SETQ WIDTH BITMAPWIDTH))) - (COND - ((GREATERP HEIGHT BITMAPHEIGHT) - (SETQ HEIGHT BITMAPHEIGHT))) - [SETQ DESTREGION (INTERSECTREGIONS (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA) - (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM (TIMES SCALE1 WIDTH - ) - (TIMES SCALE1 HEIGHT] - (COND - ((AND DESTREGION (OR (NULL CLIPPINGREGION) - (REGIONSINTERSECTP DESTREGION CLIPPINGREGION))) - [COND - ((AND (EQ SOURCELEFT 0) - (EQ SOURCEBOTTOM 0) - (EQP WIDTH BITMAPWIDTH) - (EQP HEIGHT BITMAPHEIGHT)) (* ; - "Avoid copy if sending entire bitmap") - (SETQ TEMPBM SOURCEBITMAP)) - (T (SETQ TEMPBM (BITMAPCREATE WIDTH HEIGHT 1)) - (BITBLT SOURCEBITMAP SOURCELEFT SOURCEBOTTOM TEMPBM 0 0 WIDTH HEIGHT SOURCETYPE - 'REPLACE] - (POSTSCRIPT.PUTCOMMAND STREAM "/bitbltsave save def " DESTINATIONLEFT " " - DESTINATIONBOTTOM " translate " (TIMES SCALE2 WIDTH) - " " - (TIMES SCALE2 HEIGHT) - " scale " WIDTH " " HEIGHT (COND - ((EQ OPERATION 'PAINT) - " true") - (T - (* ;; - "RMK: For REPLACE, was %"false%", but then white was black.") - - " true")) - " thebitimage" :EOL) - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEMPBM NIL) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "bitbltsave restore" :EOL) - (\MOVETO.PSC STREAM DESTINATIONLEFT DESTINATIONBOTTOM) - T) - (T NIL]) - -(\SETPOS.PSC - [LAMBDA (STREAM IMAGEDATA) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - " " - (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) - " M ") - (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) - -(\SETXFORM.PSC -(LAMBDA (STREAM IMAGEDATA NORESTORE) (* ; "Edited 28-Dec-94 17:59 by jds") (* ;; "Write transforms into the PS file to make what it prints match what we think it should print.") (LET ((CLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) (COND ((NOT NORESTORE) (POSTSCRIPT.OUTSTR STREAM "grestore "))) (POSTSCRIPT.PUTCOMMAND STREAM "gsave" :EOL) (* ;; "Scaling") (COND ((NOT (EQP (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) 1)) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) " dup scale" :EOL))) (* ;; "Landscape mode (as in POSTSCRIPT.PREFER.LANDSCAPE, not as in TEdit doing landscaping)") (COND ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) (POSTSCRIPT.OUTSTR STREAM " 90 rotate 0 -61200 imagesizefactor div translate "))) (* ;; "Any rotation that is in effect.") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA) " rotate " :EOL) (* ;; "Any translations that are in effect.") (COND ((NOT (AND (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA)) (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA)))) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) " " (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) " translate" :EOL))) (* ;; "Clipping region:") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (REGION HEIGHT) of CLIP) " " (fetch (REGION WIDTH) of CLIP) " " (fetch (REGION LEFT) of CLIP) " " (fetch (REGION BOTTOM) of CLIP) " CLP" :EOL) (* ;; "And force recaching of location and font.") (replace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T) (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T))) -) - -(\STRINGWIDTH.PSC - [LAMBDA (STREAM STR RDTBL) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) - (\STRINGWIDTH.GENERIC STR (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA) - RDTBL - (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA]) - -(\SWITCHFONTS.PSC - [LAMBDA (STREAM POSTSCRIPTDATA) (* ; "Edited 23-May-93 12:04 by rmk:") - (* ; "Edited 11-May-93 02:11 by jds") - - (* ;; "Actually emit the PS commands to change the font. If the new font hasn't been used (on this page) before, re-encode it to support accented characters.") - - (LET* [(FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of POSTSCRIPTDATA)) - (FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR - OTHERDEVICEFONTPROPS - ) of FONT) - 'PSCFONT] - [COND - [(LISTP FONTID) - [COND - ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of POSTSCRIPTDATA))) - ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) - *POSTSCRIPT-UNACCENTED-FONTS*)) - (T - (* ;; - "This font hasn't been used on this page yet. Re-encode it to include accented characters.") - - (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of - FONTID) - " /" - (CONCAT (fetch (FONTID FONTIDNAME) of FONTID) - "-Acnt") - " encodefont" :EOL) - (CL:PUSH (fetch (FONTID FONTIDNAME) of FONTID) - (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF POSTSCRIPTDATA] - (COND - ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) - *POSTSCRIPT-UNACCENTED-FONTS*) - (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA - WITH NIL) - (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of FONTID) - " findfont [" - (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) - (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " 0 " - (TIMES (fetch (FONTID FONTOBLIQUEFACTOR) of FONTID) - (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " " - (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " 0 0] makefont setfont" :EOL)) - (T (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA - WITH T) - (POSTSCRIPT.PUTCOMMAND STREAM "/" (CONCAT (fetch (FONTID FONTIDNAME) - of FONTID) - "-Acnt") - " findfont [" - (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) - (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " 0 " - (TIMES (fetch (FONTID FONTOBLIQUEFACTOR) of FONTID) - (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " " - (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) - 100) - " 0 0] makefont setfont" :EOL] - (T [COND - ((MEMB FONTID (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of - POSTSCRIPTDATA - ))) - ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*)) - (T - (* ;; - "This font hasn't been used on this page yet. Re-encode it to include accented characters.") - - (POSTSCRIPT.PUTCOMMAND STREAM "/" FONTID " /" (CONCAT FONTID "-Acnt") - " encodefont" :EOL) - (CL:PUSH FONTID (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF - POSTSCRIPTDATA - ] - (COND - ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*) - (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA - with NIL) - (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) - of FONT) - 100) - " /" FONTID " F" :EOL)) - (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA - with T) - (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) - of FONT) - 100) - " /" - (CONCAT FONTID "-Acnt") - " F" :EOL] - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of POSTSCRIPTDATA with - NIL]) - -(\TERPRI.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (NEWY (PLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of IMAGEDATA] - (COND - ([LESSP NEWY (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of - IMAGEDATA - ) - (fetch (FONTDESCRIPTOR \SFDescent) of (ffetch - (\POSTSCRIPTDATA - POSTSCRIPTFONT) - of IMAGEDATA] - (DSPNEWPAGE STREAM)) - (T (replace (STREAM CHARPOSITION) of STREAM with 0) - (\MOVETO.PSC STREAM (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) - of IMAGEDATA) - NEWY))) - NIL]) -) - - - -(* ;; "DIG operations: ") - -(DEFINEQ - -(\BITBLT.PSC - [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT - SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM) - (* ; "Edited 7-Apr-89 19:53 by TAL") - (\SCALEDBITBLT.PSC SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT - DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION - CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM 1]) - -(\BLTSHADE.PSC - [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - - (* ;; "Maybe we should do something with OPERATION") - - (LET ((RGN (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT)) - (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - TEXTUREBM TEXTUREWIDTH LEFT BOTTOM WIDTH HEIGHT) - [COND - [CLIPPINGREGION (SETQ RGN (INTERSECTREGIONS RGN CLIPPINGREGION (fetch ( - \POSTSCRIPTDATA - - POSTSCRIPTCLIPPINGREGION - ) of - IMAGEDATA] - (T (SETQ RGN (INTERSECTREGIONS RGN (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA] - (COND - (RGN (SETQ LEFT (fetch (REGION LEFT) of RGN)) - (SETQ BOTTOM (fetch (REGION BOTTOM) of RGN)) - (SETQ WIDTH (CL:1- (fetch (REGION WIDTH) of RGN))) - (SETQ HEIGHT (CL:1- (fetch (REGION HEIGHT) of RGN))) - [COND - ((FIXP TEXTURE) - (SETQ TEXTURE (SELECT TEXTURE ((BLACKSHADE -1) - 0.0) - (WHITESHADE 1.0) - TEXTURE] - [COND - ((AND (FLOATP TEXTURE) - (<= 0.0 TEXTURE 1.0)) - (POSTSCRIPT.PUTCOMMAND STREAM HEIGHT " " WIDTH " " LEFT " " BOTTOM " " - TEXTURE " R" :EOL)) - ((OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) - (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) - (SETQ TEXTUREWIDTH 16) - (BLTSHADE TEXTURE TEXTUREBM)) - ((BITMAPP TEXTURE) - (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) - (fetch BITMAPHEIGHT of TEXTUREBM))) - (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) - (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE] - (COND - (TEXTUREBM (POSTSCRIPT.PUTCOMMAND STREAM "gsave newpath ") - (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale " (QUOTIENT LEFT 100.0) - " " - (QUOTIENT BOTTOM 100.0) - " M " - (SETQ WIDTH (QUOTIENT WIDTH 100.0)) - " 0 rlineto 0 " - (QUOTIENT HEIGHT 100.0) - " rlineto " - (MINUS WIDTH) - " 0 rlineto closepath" :EOL) - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) - (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " - (LSH (fetch BITMAPRASTERWIDTH of TEXTUREBM) - 1) - " 0 " - (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) - 100.0)) - " findresolution " TEXTUREWIDTH " div div ceiling " - POSTSCRIPT.TEXTURE.SCALE " mul setpattern eofill" :EOL "grestore" - :EOL))) - (\MOVETO.PSC STREAM DESTINATIONLEFT DESTINATIONBOTTOM) - T) - (T NIL]) - -(\CHARWIDTH.PSC - [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-May-93 11:19 by rmk:") - (COND - ((EQ CHARCODE (CHARCODE SPACE)) - (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of (ffetch (STREAM IMAGEDATA) - of STREAM))) - ((\FGETCHARWIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of (ffetch (STREAM - IMAGEDATA - ) - of STREAM)) - CHARCODE]) - -(\CREATECHARSET.PSC - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC NOSLUG?) - (* ; "Edited 8-May-93 22:55 by rmk:") - (LET* ((CSINFO (CREATE CHARSETINFO - OFFSETS _ NIL)) - (WIDTHS (FETCH (CHARSETINFO WIDTHS) OF CSINFO))) - (REPLACE (CHARSETINFO IMAGEWIDTHS) OF CSINFO WITH WIDTHS) - - (* ;; "Make imagewidths point to widths. Shouldn't matter to anyone, since imagewidths really has to do with bitmaps etc. But...") - - (CL:UNLESS (EQ CHARSET 0) - - (* ;; "For all charsets other than 0, initialize widths with width of black box=average char width. We know that the AVGCHARWIDTH field of the FONTDESC will eventually be the width of A, but that might not be filled in when this is executed inside POSTSCRIPT.FONTCREATE--it's only after the return to FONTCREATE itself that this gets filled in. However, we do know that charset 0 is all set up before any other characters are dealt with.") - - (FOR I (AVGCHARWIDTH _ (CHARWIDTH (CHARCODE A) - FONTDESC)) FROM 0 TO 255 - FIRST (CL:WHEN (EQ 0 AVGCHARWIDTH) - - (* ;; - "This is what \AVGCHARWIDTH in FONT does, but we don't have it here. Just to be extremely safe.") - - [SETQ AVGCHARWIDTH (MAX 1 (FIXR (FTIMES 0.6 (FONTPROP FONTDESC - 'HEIGHT]) - DO (\FSETWIDTH WIDTHS I AVGCHARWIDTH))) - CSINFO]) - -(\DRAWARC.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH COLOR) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH)) - ((LISTP BRUSH) - (COND - ((NEQ (fetch BRUSHSHAPE of BRUSH) - 'ROUND) - (printout T T - "[In \DRAWARC.PSC: Non-ROUND BRUSH not supported.] -[Using ROUND BRUSH]" T))) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T (* ; - "If FUNCTIONAL BRUSH big trouble!") - (printout T T - "[In \DRAWARC.PSC: Functional BRUSH not supported.] -[Using ROUND 1 point BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - (* ; - "COLOR is specified in POSTSCRIPT setgray notation.") - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ")) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) - (* ; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") - )) - (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " - CENTERX " " CENTERY " " RADIUS " " STARTANGLE " " (+ STARTANGLE NDEGREES) - " arc stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM CENTERX CENTERY]) - -(\DRAWCIRCLE.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH COLOR) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH)) - ((LISTP BRUSH) - (COND - ((NEQ (fetch BRUSHSHAPE of BRUSH) - 'ROUND) - (printout T T - "[In \DRAWCIRCLE.PSC: Non-ROUND BRUSH not supported.] -[Using ROUND BRUSH]" T))) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T (* ; - "If FUNCTIONAL BRUSH big trouble!") - (printout T T - "[In \DRAWCIRCLE.PSC: Functional BRUSH not supported.] -[Using (ROUND 1) BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - (* ; - "COLOR is specified in POSTSCRIPT setgray notation.") - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ")) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) - (* ; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") - )) - (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " - CENTERX " " CENTERY " " RADIUS " 0 360 arc stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM CENTERX CENTERY]) - -(\DRAWCURVE.PSC - [LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH SHAPE COLOR PSPLINE XA YA DXA DYA N PREVX PREVY PREV-DX3 PREV-DY3) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH) - (SETQ SHAPE 'ROUND)) - ((LISTP BRUSH) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ SHAPE (fetch BRUSHSHAPE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T - (* ;; "If FUNCTIONAL BRUSH then BIG trouble!") - - (printout T T - "[In \DRAWCURVE.PSC: Functional BRUSH not supported.] -[Using (ROUND 1) BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) - (SETQ SHAPE 'ROUND] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - - (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") - - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ") - - (* ;; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") -) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) - (SETQ PSPLINE (PARAMETRICSPLINE KNOTS CLOSED NIL)) - (SETQ N (pop PSPLINE)) - (SETQ XA (pop PSPLINE)) - (SETQ YA (pop PSPLINE)) - (SETQ DXA (pop PSPLINE)) - (SETQ DYA (pop PSPLINE)) - (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE - (ROUND " 1 setlinecap 1 setlinejoin ") - (SQUARE " 2 setlinecap 0 setlinejoin ") - " 0 setlinecap 0 setlinejoin ") - WIDTH " setlinewidth " (SETQ PREVX (ELT XA 1)) - " " - (SETQ PREVY (ELT YA 1)) - " M" :EOL) - (SETQ PREV-DX3 (FQUOTIENT (ELT DXA 1) - 3.0)) - (SETQ PREV-DY3 (FQUOTIENT (ELT DYA 1) - 3.0)) - (for C from 2 to N do (POSTSCRIPT.PUTCOMMAND - STREAM - (FPLUS PREVX PREV-DX3) - " " - (FPLUS PREVY PREV-DY3) - " " - (FDIFFERENCE (SETQ PREVX (ELT XA C)) - (SETQ PREV-DX3 (FQUOTIENT (ELT DXA C) - 3.0))) - " " - (FDIFFERENCE (SETQ PREVY (ELT YA C)) - (SETQ PREV-DY3 (FQUOTIENT (ELT DYA C) - 3.0))) - " " PREVX " " PREVY " curveto" :EOL)) - (POSTSCRIPT.PUTCOMMAND STREAM "stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM PREVX PREVY)) - NIL]) - -(\DRAWELLIPSE.PSC - [LAMBDA (STREAM CENTERX CENTERY MINORRADIUS MAJORRADIUS ORIENTATION BRUSH DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH COLOR) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH)) - ((LISTP BRUSH) - (COND - ((NEQ (fetch BRUSHSHAPE of BRUSH) - 'ROUND) - (printout T T - "[In \DRAWELLIPSE.PSC: Non-ROUND BRUSH not supported.] -[Using ROUND BRUSH]" T))) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T (* ; - "If FUNCTIONAL BRUSH, big trouble!") - (printout T T - "[In \DRAWELLIPSE.PSC: Functional BRUSH not supported.] -[Using (ROUND 1) BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - (* ; - "COLOR is specified in POSTSCRIPT setgray notation.") - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ") - - (* ;; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") -) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) - (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " - CENTERX " " CENTERY " " MAJORRADIUS " " MINORRADIUS " " ORIENTATION - " 0 360 ellipse stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM CENTERX CENTERY]) - -(\DRAWLINE.PSC - [LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) - (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - - (* ;; "DRAWLINE method for postscript streams.") - - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - [COND - ((NOT (NUMBERP WIDTH)) - - (* ;; "The WIDTH = NIL should have been handled before here, but just in case!") - - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] - [COND - ((NOT (ZEROP WIDTH)) - (COND - ((LESSP X2 X1) - - (* ;; "For Syntelligence, make all lines move from left to right, to defeat a bug in SPARCPrinter PS decoder.") - - (\DRAWLINE.PSC STREAM X2 Y2 X1 Y1 WIDTH OPERATION COLOR DASHING)) - ((NOT (OR (FLOATP COLOR) - (LISTP DASHING))) (* ; "Simple case, no dash or gray") - (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " L" :EOL)) - (T (* ; - "COLOR is interpreted as gray factor") - (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " " - (OR (FLOATP COLOR) - "0") - " [") - (for D in (LISTP DASHING) do - - (* ;; - "Interlisp DASHING is in terms of BRUSH units, so multiply by the brush size.") - - (POSTSCRIPT.PUTCOMMAND STREAM - (TIMES D WIDTH) - " ")) - (POSTSCRIPT.PUTCOMMAND STREAM "] L1" :EOL] - (replace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X2) - (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y2) - (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) - -(\DRAWPOINT.PSC - [LAMBDA (STREAM X Y BRUSH OPERATION) (* ; "Edited 30-Mar-90 17:53 by Matt Heffron") - - (* ;; "draw a point on the stream ") - - (if (BITMAPP BRUSH) - then (LET ((WIDTH (fetch BITMAPWIDTH of BRUSH)) - (HEIGHT (fetch BITMAPHEIGHT of BRUSH))) - (BITBLT BRUSH 0 0 STREAM (- X (IQUOTIENT WIDTH 2)) - (- Y (IQUOTIENT HEIGHT 2)) - WIDTH HEIGHT OPERATION)) - else (\DRAWLINE.PSC STREAM X Y X Y BRUSH OPERATION]) - -(\DRAWPOLYGON.PSC - [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING)(* ; - "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") - (LET ((LASTPOINT (CAR (LAST POINTS))) - (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - WIDTH SHAPE COLOR) - [COND - ((NUMBERP BRUSH) - (SETQ WIDTH BRUSH) - (SETQ SHAPE 'ROUND)) - ((LISTP BRUSH) - (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) - (SETQ SHAPE (fetch BRUSHSHAPE of BRUSH)) - (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) - (T - (* ;; "If FUNCTIONAL BRUSH then BIG trouble!") - - (printout T T - "[In \DRAWPOLYGON.PSC: Functional BRUSH not supported.] -[Using (ROUND 1) BRUSH]" T) - (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) - (SETQ SHAPE 'ROUND] - (COND - ((NOT (ZEROP WIDTH)) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (COND - ((FLOATP COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") - - (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") - - )) - (COND - ((LISTP DASHING) - (POSTSCRIPT.OUTSTR STREAM " [") - (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) - " ") - - (* ;; - "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") -) - (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) - (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE - (ROUND " 1 setlinecap 1 setlinejoin ") - (SQUARE " 2 setlinecap 0 setlinejoin ") - " 0 setlinecap 0 setlinejoin ") - WIDTH " setlinewidth " (fetch (POSITION XCOORD) of (CAR POINTS)) - " " - (fetch (POSITION YCOORD) of (CAR POINTS)) - " M" :EOL) - (for P in (CDR POINTS) do (POSTSCRIPT.PUTCOMMAND STREAM - (fetch (POSITION XCOORD) of P) - " " - (fetch (POSITION YCOORD) of P) - " lineto" :EOL)) - (COND - (CLOSED (POSTSCRIPT.PUTCOMMAND STREAM " closepath"))) - (POSTSCRIPT.PUTCOMMAND STREAM " stroke" :EOL "grestore" :EOL))) - (\MOVETO.PSC STREAM (fetch (POSITION XCOORD) of LASTPOINT) - (fetch (POSITION YCOORD) of LASTPOINT]) - -(\DSPBOTTOMMARGIN.PSC - [LAMBDA (STREAM YPOSITION) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of (fetch (STREAM IMAGEDATA) - of STREAM)) - (COND - (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) - of (fetch (STREAM IMAGEDATA) of STREAM) with YPOSITION))))]) - -(\DSPCLIPPINGREGION.PSC - [LAMBDA (STREAM REGION) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) - (COND - ([AND REGION (NOT (AND (EQP (fetch (REGION LEFT) of OLDCLIP) - (fetch (REGION LEFT) of REGION)) - (EQP (fetch (REGION BOTTOM) of OLDCLIP) - (fetch (REGION BOTTOM) of REGION)) - (EQP (fetch (REGION WIDTH) of OLDCLIP) - (fetch (REGION WIDTH) of REGION)) - (EQP (fetch (REGION HEIGHT) of OLDCLIP) - (fetch (REGION HEIGHT) of REGION] - (POSTSCRIPT.SHOWACCUM STREAM) - (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with - REGION) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) - (\FIXLINELENGTH.PSC STREAM IMAGEDATA))) - OLDCLIP]) - -(\DSPCOLOR.PSC - [LAMBDA (STREAM COLOR) (* ; "Edited 14-Jan-93 17:14 by jds") - - (* ;; - "Postscript %"color%" setter -- really sets gray shade for now. 0.0 = black, 1.0 = white.") - - (POSTSCRIPT.SHOWACCUM STREAM) - (PROG1 (FETCH (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) - OF STREAM)) - (COND - ((AND (NUMBERP COLOR) - (<= 0 COLOR 1)) - (REPLACE (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) - OF STREAM) WITH COLOR) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL COLOR " setgray ")) - (COLOR (\ILLEGAL.ARG COLOR))))]) - -(\DSPFONT.PSC - [LAMBDA (STREAM FONT) (* ; - "Edited 26-May-93 01:06 by sybalsky:mv:envos") - (* ; "Edited 11-May-93 02:11 by jds") - (* ; "Edited 19-Jan-93 17:17 by jds") - - (* ;; "Change fonts on the PostScript stream STREAM to be FONT.") - - (* ;; "Doesn't actually write the font-change command to the stream (it saves doing that until the font is actually needed, so that multiple font changes don't yield larger PS files).") - - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDFONT (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA)) - NEWFONT FONTID) - (COND - ((AND FONT (SETQ NEWFONT (OR (\COERCEFONTDESC FONT STREAM) - (FONTCOPY OLDFONT FONT))) - (type? FONTDESCRIPTOR NEWFONT) - (NEQ NEWFONT OLDFONT)) - - (* ;; "OK, it's a good font.") - - (POSTSCRIPT.SHOWACCUM STREAM) (* ; - " Write out any accumulated characters.") - - (* ;; "Change the font in the Lisp stream:") - - (replace (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA with NEWFONT) - - (* ;; "and now update all font-dependent fields in the imagedata, EXCEPT POSTSCRIPTSPACEWIDTH and POSTSCRIPTNATURALSPACEWIDTH. These latter 2 must stay as-is up thru the actual writing of characters by SHOWACCUM, so") - - (\POSTSCRIPT.CHANGECHARSET IMAGEDATA 0) - (\DSPLINEFEED.PSC STREAM (IMINUS (fetch (FONTDESCRIPTOR \SFHeight) of - NEWFONT))) - [replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA - with (FIXR (TIMES (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) - of IMAGEDATA) - (replace (\POSTSCRIPTDATA POSTSCRIPTNATURALSPACEWIDTH) - of IMAGEDATA with (\FGETWIDTH (fetch - (\POSTSCRIPTDATA - POSTSCRIPTWIDTHS) - of IMAGEDATA) - (CHARCODE SPACE] - (\FIXLINELENGTH.PSC STREAM IMAGEDATA) - [SETQ FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR - - OTHERDEVICEFONTPROPS - ) of - NEWFONT - ) - 'PSCFONT] - (COND - ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) - *POSTSCRIPT-UNACCENTED-FONTS*) - (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF IMAGEDATA WITH NIL)) - (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA with - T))) - - (* ;; "Remember to actually write a change command") - - (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with - T))) - OLDFONT]) - -(\DSPLEFTMARGIN.PSC - [LAMBDA (STREAM XPOSITION) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - (COND - (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - with XPOSITION) - (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) - -(\DSPLINEFEED.PSC - [LAMBDA (STREAM LINELEADING) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of (fetch (STREAM IMAGEDATA) - of STREAM)) - (COND - (LINELEADING (replace (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) - of (fetch (STREAM IMAGEDATA) of STREAM) with LINELEADING)) - ))]) - -(\DSPPUSHSTATE.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (push (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA) - (create POSTSCRIPTXFORM - PSXCLIP _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA)) - PSXPAGE _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of - IMAGEDATA)) - PSXLEFT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - PSXRIGHT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - ) - PSXTOP _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - PSXBOTTOM _ (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of - IMAGEDATA - ) - PSXTRANX _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) - PSXTRANY _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) - PSXLAND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) - PSXXFORMPEND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) - of IMAGEDATA]) - -(\DSPPOPSTATE.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:15 by sybalsky:mv:envos") - (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (XFORM (pop (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA] - (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXCLIP) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXPAGE) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXBOTTOM) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXTOP) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXLEFT) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXRIGHT) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXLAND) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA - with (fetch (POSTSCRIPTXFORM PSXXFORMPEND) of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with - (fetch ( - POSTSCRIPTXFORM - PSXTRANX) - of XFORM)) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with - (fetch ( - POSTSCRIPTXFORM - PSXTRANY) - of XFORM]) - -(\DSPRESET.PSC - [LAMBDA (STREAM) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (replace (STREAM CHARPOSITION) of STREAM with 0) - (\MOVETO.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - (FONTPROP (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA) - 'ASCENT]) - -(\DSPRIGHTMARGIN.PSC - [LAMBDA (STREAM XPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) - (COND - (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA - with XPOSITION) - (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) - -(\DSPROTATE.PSC - [LAMBDA (STREAM ROTATION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - - (* ;; "rotate the postscript stream by ROTATION") - - (* ;; - "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") - - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OROT (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA)) - LAND C0 P0 C P ML MB MR MT) - (COND - ((AND ROTATION (NEQ ROTATION (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) - of IMAGEDATA))) - (POSTSCRIPT.SHOWACCUM STREAM) - (replace (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA with ROTATION) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) - (\DSPRESET.PSC STREAM))) - OROT]) - -(\DSPSCALE.PSC - [LAMBDA (STREAM SCALE) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) - NSCALE) - (COND - ((AND NIL - - (* ;; "Changing SCALE is not implemented. According to IRM.") - - (NUMBERP SCALE) - (CL:PLUSP SCALE)) - (SETQ NSCALE (QUOTIENT SCALE OSCALE)) - - (* ;; - "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") - - (POSTSCRIPT.PUTCOMMAND STREAM " " NSCALE " " NSCALE " scale" :EOL) - (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with SCALE))) - OSCALE]) - -(\DSPSCALE2.PSC - [LAMBDA (STREAM X-SCALE Y-SCALE) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - - (* ;; "SETS X AND Y SCALE ") - - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) - NSCALE) - (COND - ((AND X-SCALE (NUMBERP X-SCALE) - (CL:PLUSP X-SCALE)) - (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - - (* ;; - "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") - - (POSTSCRIPT.PUTCOMMAND STREAM " " X-SCALE " " Y-SCALE " scale" :EOL))) - T]) - -(\DSPSPACEFACTOR.PSC - [LAMBDA (STREAM FACTOR) (* ; - "Edited 26-May-93 01:18 by sybalsky:mv:envos") - (DECLARE (LOCALVARS . T)) - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDFACTOR (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA))) - [COND - ((AND (NUMBERP FACTOR) - (NOT (EQUAL FACTOR OLDFACTOR))) - (POSTSCRIPT.SHOWACCUM STREAM) - (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA with FACTOR) - (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA - with (FIXR (TIMES FACTOR (ffetch (\POSTSCRIPTDATA - POSTSCRIPTNATURALSPACEWIDTH) - of IMAGEDATA] - OLDFACTOR]) - -(\DSPTOPMARGIN.PSC - [LAMBDA (STREAM YPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch (STREAM IMAGEDATA) - of STREAM)) - (COND - (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch - (STREAM IMAGEDATA) - of STREAM) - with YPOSITION))))]) - -(\DSPTRANSLATE.PSC - [LAMBDA (STREAM TX TY) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (MDX (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) - TX)) - (MDY (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) - TY))) - (COND - ((NOT (AND (ZEROP MDX) - (ZEROP MDY))) - (POSTSCRIPT.SHOWACCUM STREAM) - (for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) - of IMAGEDATA) - (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) - of IMAGEDATA)) do (CL:INCF (fetch (REGION - LEFT) - of REG) - MDX) - (CL:INCF (fetch (REGION - BOTTOM) - of REG) - MDY)) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - MDX) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) - MDY) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) - MDX) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) - MDX) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) - MDY) - (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) - MDY) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with TX) - (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with TY) - (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T]) - -(\DSPXPOSITION.PSC - [LAMBDA (STREAM XPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - OLDX) - (PROG1 (SETQ OLDX (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) - [COND - ((AND XPOSITION (NOT (EQUAL XPOSITION OLDX))) - (\MOVETO.PSC STREAM XPOSITION (fetch (\POSTSCRIPTDATA POSTSCRIPTY) - of IMAGEDATA])]) - -(\DSPYPOSITION.PSC - [LAMBDA (STREAM YPOSITION) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - OLDY) - (PROG1 (SETQ OLDY (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA)) - (COND - ((AND YPOSITION (NOT (EQUAL YPOSITION OLDY))) - (\MOVETO.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - YPOSITION))))]) - -(\FILLCIRCLE.PSC - [LAMBDA (STREAM CENTERX CENTERY RADIUS TEXTURE) (* ; "Edited 30-Mar-90 17:59 by Matt Heffron") - (LET (TEXTUREBM TEXTUREWIDTH) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (if (FIXP TEXTURE) - then (if (ZEROP TEXTURE) - then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") - elseif (OR (EQL TEXTURE 65535) - (EQL TEXTURE -1)) - then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") - )) - (if (FLOATP TEXTURE) - then - - (* ;; - "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") - - (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") - elseif (OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) - then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) - (SETQ TEXTUREWIDTH 16) - (BLTSHADE TEXTURE TEXTUREBM) - elseif (BITMAPP TEXTURE) - then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) - (fetch BITMAPHEIGHT of TEXTUREBM))) - (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) - (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) - (POSTSCRIPT.PUTCOMMAND STREAM " " CENTERX " " CENTERY " " RADIUS " 0 360 arc" :EOL) - (if TEXTUREBM - then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) - (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch - BITMAPRASTERWIDTH - of TEXTUREBM) - 1) - " 0 " - (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) - 100.0)) - " findresolution " TEXTUREWIDTH " div div ceiling " - POSTSCRIPT.TEXTURE.SCALE " mul setpattern eofill" :EOL "grestore" :EOL) - else (POSTSCRIPT.PUTCOMMAND STREAM " eofill" :EOL "grestore" :EOL)) - (\MOVETO.PSC STREAM CENTERX CENTERY]) - -(\FILLPOLYGON.PSC - [LAMBDA (STREAM KNOTS TEXTURE OPERATION WINDNUMBER) - (* ; - "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") - (DECLARE (SPECVARS FILL.WRULE)) - - (* ;; "OPERATION is ignored here") - - (LET ((LASTPOINT (CAR (LAST KNOTS))) - TEXTUREBM TEXTUREWIDTH) - (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") - (if (NOT (OR (ZEROP WINDNUMBER) - (EQL WINDNUMBER 1))) - then (SETQ WINDNUMBER FILL.WRULE)) - (if (FIXP TEXTURE) - then (if (ZEROP TEXTURE) - then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") - elseif (OR (EQL TEXTURE 65535) - (EQL TEXTURE -1)) - then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") - )) - (if (FLOATP TEXTURE) - then - - (* ;; - "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") - - (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") - elseif (OR (TEXTUREP TEXTURE) - (NULL TEXTURE)) - then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) - (SETQ TEXTUREWIDTH 16) - (BLTSHADE TEXTURE TEXTUREBM) - elseif (BITMAPP TEXTURE) - then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) - (fetch BITMAPHEIGHT of TEXTUREBM))) - (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) - (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) - (POSTSCRIPT.PUTCOMMAND STREAM (fetch (POSITION XCOORD) of (CAR KNOTS)) - " " - (fetch (POSITION YCOORD) of (CAR KNOTS)) - " M" :EOL) - (for K in (CDR KNOTS) do (POSTSCRIPT.PUTCOMMAND STREAM (fetch - (POSITION XCOORD) - of K) - " " - (fetch (POSITION YCOORD) of K) - " lineto" :EOL)) - (POSTSCRIPT.PUTCOMMAND STREAM " closepath" :EOL) - (if TEXTUREBM - then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") - (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) - (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch - BITMAPRASTERWIDTH - of TEXTUREBM) - 1) - " 0 " - (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) - 100.0)) - " findresolution " TEXTUREWIDTH " div div ceiling " - POSTSCRIPT.TEXTURE.SCALE " mul setpattern")) - (POSTSCRIPT.PUTCOMMAND STREAM (if (ZEROP WINDNUMBER) - then " fill" - else " eofill") - :EOL "grestore" :EOL) - (\MOVETO.PSC STREAM (fetch (POSITION XCOORD) of LASTPOINT) - (fetch (POSITION YCOORD) of LASTPOINT]) - -(\FIXLINELENGTH.PSC - [LAMBDA (STREAM IMAGEDATA) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - - (* ;; "Called by margin, font or rotation change to update the LINELENGTH field in the stream.") - - (LET [(TMP (MIN MAX.SMALLP (FIX (QUOTIENT (DIFFERENCE (fetch (\POSTSCRIPTDATA - POSTSCRIPTRIGHTMARGIN) - of IMAGEDATA) - (ffetch (\POSTSCRIPTDATA - POSTSCRIPTLEFTMARGIN) - of IMAGEDATA)) - (fetch FONTAVGCHARWIDTH of (ffetch - (\POSTSCRIPTDATA - POSTSCRIPTFONT) - of IMAGEDATA] - (replace (STREAM LINELENGTH) of STREAM with (COND - ((GREATERP TMP 1) - TMP) - (T 10]) - -(\MOVETO.PSC - [LAMBDA (STREAM X Y) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) - (COND - ([NOT (AND (EQP X (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) - (EQP Y (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA] - (POSTSCRIPT.SHOWACCUM STREAM) - (freplace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X) - (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y) - (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T]) - -(\NEWPAGE.PSC - [LAMBDA (STREAM) (* ; "Edited 5-Apr-89 17:31 by TAL") - (POSTSCRIPT.ENDPAGE STREAM) - (POSTSCRIPT.STARTPAGE STREAM]) -) - - - -(* ;; "Character-output, plus special-cases:") - -(DEFINEQ - -(\POSTSCRIPT.CHANGECHARSET - [LAMBDA (PSDATA CHARSET) (* ; "Edited 29-Apr-93 13:51 by rmk:") - - (* ;; -"Called when the character set information cached in a display stream doesn't correspond to CHARSET") - - (PROG* ((FONT (ffetch POSTSCRIPTFONT of PSDATA)) - (CSINFO (\GETCHARSETINFO CHARSET FONT))) - - (* ;; "since the call to \getcharsetinfo has NOSLUG? = NIL, we know that we will get a reasonable character set back") - - (UNINTERRUPTABLY - (freplace POSTSCRIPTWIDTHS of PSDATA with (ffetch (CHARSETINFO WIDTHS) - of CSINFO)) - (freplace POSTSCRIPTNSCHARSET of PSDATA with CHARSET))]) - -(\POSTSCRIPT.OUTCHARFN - [LAMBDA (STREAM CHAR) (* ; "Edited 23-May-93 12:00 by rmk:") - (* ; "Edited 4-May-93 02:20 by jds") - (* ; "Edited 3-Feb-93 00:45 by jds") - -(* ;;; "Output a character to be printed.") - -(* ;;; "Change font if necessary, do newline if at right margin, check for special chars and do appropriate thing, quote char and/or start postscript string if necessary.") - -(* ;;; "This is called a lot, so the code is unrolled for efficiency.") - - (DECLARE (GLOBALVARS \POSTSCRIPT.CHARTYPE) - (LOCALVARS . T)) - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (XPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) - (FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA)) - CHARWID NEWXPOS MAPPING) - (CL:UNLESS (EQ (\CHARSET CHAR) - (ffetch POSTSCRIPTNSCHARSET of IMAGEDATA)) - - (* ;; "Switch character set so that we get the right char width.") - - (\POSTSCRIPT.CHANGECHARSET IMAGEDATA (\CHARSET CHAR))) - [SETQ CHARWID (SELCHARQ CHAR - (SPACE (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of - IMAGEDATA - )) - (\FGETWIDTH (ffetch (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) of - IMAGEDATA - ) - (\CHAR8CODE CHAR] - - (* ;; "POSTSCRIPTACCENTED true if font has accented rendering characters in it; otherwise, a c-set 0 special font (SYMBOL, ZAPFDINGBATS...)") - - [COND - [[OR (NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA)) - (AND (ILEQ CHAR 254) - (NOT (CL:AREF \POSTSCRIPT.CHARTYPE CHAR] - - (* ;; "OR is NIL if char is special in any way: Either font isn't supposed to be treated as an NS font (e.g. ZapfDingbats, which uses all the legal char positions for its own), or char itself is in cset 0 and ordinary") - - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - CHARWID] - (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with - T)) - (COND - [(ILESSP CHAR (CHARCODE " ")) - (BOUT STREAM (CHARCODE \)) - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - [(IGEQ CHAR 127) - (BOUT STREAM (CHARCODE \)) - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - (T (SELCHARQ CHAR - ((%( %) \) - (BOUT STREAM (CHARCODE \)) - (BOUT STREAM CHAR)) - (BOUT STREAM CHAR] - [(SETQ MAPPING (GETHASH CHAR *POSTSCRIPT-NS-HASH*)) - (* ; - "Special character that's taken care of by the NS mapping.") - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) - CHARWID] - (SELECTQ (CAR MAPPING) - (NIL - (* ;; "just a remap within the lower 256. But the code in (CDR MAPPING) is in charset 2 to prevent recursion") - - (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING))) - (SYMBOL - (* ;; "Its in the SYMBOL font. Symbol is specified as %"2,xxx%" rather than %"0,xxx%" to defeat translations to symbol that go to matching character codes.") - - (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) - 'SYMBOL)) - (ACCENT (* ; "Special accent mapping we did") - (\POSTSCRIPT.ACCENTFN STREAM (CADR MAPPING))) - (ACCENTPAIR (* ; - "Given base char & accent, overlap them.") - (\POSTSCRIPT.ACCENTPAIR STREAM (CADR MAPPING) - (CADDR MAPPING) - (CADDDR MAPPING))) - (DINGBAT (* ; "A Zapf dingbat") - (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) - 'ZAPFDINGBATS)) - (APPLY* (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - - (* ;; "User function can call any stream operations it wants. At the end, we guarantee that baseline hasn't changed and that xpos is where the widthset it would be.") - - [freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA - with (PROG1 (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) OF - IMAGEDATA - ) - (APPLY* (CADDR MAPPING) - STREAM - (CADR MAPPING)))]) - (FUNCTION (* ; "Done as special PS code.") - (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - (POSTSCRIPT.OUTSTR STREAM (CADR MAPPING))) - (\ILLEGAL.ARG (CAR MAPPING] - (T (* ; "Special char") - (SELCHARQ CHAR - ((EOL LF) - (\TERPRI.PSC STREAM) - - (* ;; - "Set NEWXPOS to current value here and in FF to preserve value after external resetting.") - - (SETQ NEWXPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA))) - (FF (DSPNEWPAGE STREAM) - (SETQ NEWXPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA))) - (TAB (SETQ NEWXPOS (IPLUS XPOS (\POSTSCRIPTTAB IMAGEDATA))) - [COND - ((IGREATERP NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) - of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) - of IMAGEDATA) - (\POSTSCRIPTTAB IMAGEDATA] - (\MOVETO.PSC STREAM NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) - of IMAGEDATA))) - ("357,140" (* ; " Ballot box, checked") - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) - of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) - of IMAGEDATA) - CHARWID] - (LET ((OLDFONT (\DSPFONT.PSC STREAM))) - (POSTSCRIPT.SHOWACCUM STREAM) - (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch - (FONTDESCRIPTOR - FONTSIZE) - of OLDFONT) - (fetch (FONTDESCRIPTOR - FONTFACE) - of OLDFONT))) - (\UPDATE.PSC STREAM IMAGEDATA) - (POSTSCRIPT.OUTSTR STREAM " bboxchk ") - (\DSPFONT.PSC STREAM OLDFONT))) - (PROGN [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) - of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) - of IMAGEDATA) - CHARWID] - (COND - ((IGEQ CHAR 255) - - (* ;; "If it's 255 or above and we don't know anything about it, print the black box. Width vector will determine width of box, to maintain consistency.") - - (\POSTSCRIPT.PRINTSLUG STREAM CHAR)) - (T (SETQ CHAR (\CHAR8CODE CHAR)) - (COND - ((NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) - of IMAGEDATA)) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) - of IMAGEDATA with T))) - (BOUT STREAM (CHARCODE \)) - (SELCHARQ CHAR - ((%( %) \) - (BOUT STREAM CHAR)) - (PROGN [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - (freplace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with NEWXPOS) - CHAR]) - -(\POSTSCRIPT.PRINTSLUG - [LAMBDA (STREAM CHAR) (* ; "Edited 9-May-93 21:55 by rmk:") - (* ; "Edited 4-May-93 02:20 by jds") - (* ; "Edited 3-Feb-93 00:45 by jds") - -(* ;;; "Internal function to display a black box for a missing character. Width is taken from widths vector, so that box and charwidth are always consistent. Caller (\POSTSCRIPT.OUTCHARFN) is responsible for guaranteeing proper caching of widths vector and for measurement and position updating, although \DRAWLINE.PSC also updates position.") - - (DECLARE (LOCALVARS . T)) - (LET ((IMAGEDATA (FETCH (STREAM IMAGEDATA) OF STREAM))) - (\BLTSHADE.PSC BLACKSHADE STREAM (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF - IMAGEDATA - ) - (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA) - (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) OF IMAGEDATA) - (\CHAR8CODE CHAR)) - (FETCH (FONTDESCRIPTOR \SFAscent) OF (FETCH (\POSTSCRIPTDATA - POSTSCRIPTFONT) - OF IMAGEDATA)) - 'PAINT) - (\MOVETO.PSC STREAM (IPLUS (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF IMAGEDATA) - (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) - OF IMAGEDATA) - (\CHAR8CODE CHAR))) - (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA]) - -(\POSTSCRIPT.SPECIALOUTCHARFN - [LAMBDA (STREAM CHAR FAMILY) (* ; "Edited 23-May-93 13:31 by rmk:") - (* ; "Edited 4-May-93 02:20 by jds") - (* ; "Edited 3-Feb-93 00:45 by jds") - -(* ;;; "Internal function to output a special character to be printed, changing font if necessary. Width processing is carried out at higher level. If FAMILY is given, switches to that font (SYMBOL, ZAPFDINGBATS) before printing, then switches back.") - - (DECLARE (LOCALVARS . T)) - (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDFONT (AND FAMILY (\DSPFONT.PSC STREAM] - (CL:WHEN OLDFONT - (\DSPFONT.PSC STREAM (LIST FAMILY (fetch (FONTDESCRIPTOR FONTSIZE) of - OLDFONT) - (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT)))) - (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T)) - [COND - [(ILESSP CHAR (CHARCODE " ")) - (BOUT STREAM (CHARCODE \)) - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - [(IGEQ CHAR 127) - (BOUT STREAM (CHARCODE \)) - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 3 (LRSH CHAR 6] - [BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 (LRSH CHAR 3] - (BOUT STREAM (IPLUS (CHARCODE 0) - (LOGAND 7 CHAR] - (T (SELCHARQ CHAR - ((%( %) \) - (BOUT STREAM (CHARCODE \)) - (BOUT STREAM CHAR)) - (BOUT STREAM CHAR] - (CL:WHEN OLDFONT (\DSPFONT.PSC STREAM OLDFONT)) - CHAR]) - -(\UPDATE.PSC - [LAMBDA (STREAM IMAGEDATA) (* ; - "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") - - (* ;; "Make any outstanding font, scale, location updates, prepatory to something that might depend heavily on it. (e.g. before starting to output characters, or making a scale change)") - (* ; - "This code was originally in \POSTSCRIPT.OUTCHAR &c, and is here for commonality.") - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) - (\SETXFORM.PSC STREAM IMAGEDATA))) - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA) - (* ; - "If font was changed then switch before printing") - (\SWITCHFONTS.PSC STREAM IMAGEDATA))) - (COND - ((ffetch (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA) - (* ; "likewise for position") - (\SETPOS.PSC STREAM IMAGEDATA]) - -(\POSTSCRIPT.ACCENTFN - [LAMBDA (STREAM CHAR) (* ; "Edited 28-Apr-93 16:35 by rmk:") - (* ; "Edited 3-Feb-93 01:05 by jds") - -(* ;;; "Output an accented character to be printed. .") - -(* ;;;; "Need to inc CHARPOSITION of STREAM") - - (DECLARE (LOCALVARS . T)) - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) - (COND - ((NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA)) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T))) - (BOUT STREAM (CHARCODE "\")) - (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) - -3) do (BOUT STREAM CH)) - CHAR]) - -(\POSTSCRIPT.ACCENTPAIR - [LAMBDA (STREAM CHAR ACCENTS UNDER-ACCENTS) (* ; - "Edited 17-Aug-93 17:02 by sybalskY:MV:ENVOS") - (* ; "Edited 3-Feb-93 01:29 by jds") - -(* ;;; "Output an accented character to be printed. .") - -(* ;;;; "Prints the character as \xxx, with 3 octal digits, to avoid tripping up on EOLs and other postscript-special characters.") - - (DECLARE (LOCALVARS . T)) - (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA))) - (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - (BOUT STREAM (CHARCODE %()) - (BOUT STREAM (CHARCODE "\")) - (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) - -3) do (BOUT STREAM CH)) - (BOUT STREAM (CHARCODE %))) - (BOUT STREAM (CHARCODE %()) - (for ACCENT inside ACCENTS do (BOUT STREAM (CHARCODE "\")) - (for CH - instring (SUBSTRING (CONCAT "000" - (OCTALSTRING - ACCENT)) - -3) - do (BOUT STREAM CH))) - (POSTSCRIPT.PUTCOMMAND STREAM ") (") - (for ACCENT inside UNDER-ACCENTS - do (BOUT STREAM (CHARCODE "\")) - (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING ACCENT)) - -3) do (BOUT STREAM CH))) - (BOUT STREAM (CHARCODE %))) - (COND - (NIL (OR (IEQP ACCENT (CHARCODE "0,313")) - (IEQP ACCENT (CHARCODE "0,316"))) (* ; - "Cedilla and ogonek are under-accents, so don't raise them for capital letters.") - (POSTSCRIPT.PUTCOMMAND STREAM " 0 ")) - ((ILESSP CHAR (CHARCODE a)) (* ; - "upper case, so adjust offset for accent") - (POSTSCRIPT.PUTCOMMAND STREAM " " (/ (fetch \SFAscent of FONT) - 3.0) - " ")) - (T (POSTSCRIPT.PUTCOMMAND STREAM " 0 "))) - (POSTSCRIPT.PUTCOMMAND STREAM " " (FONTPROP FONT 'SIZE) - " ") - (POSTSCRIPT.PUTCOMMAND STREAM " accentor ") - CHAR]) -) - - - -(* ;; "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") - -(DEFINEQ - -(\PSC.SPACEDISP - [LAMBDA (STREAM WIDTH) (* ; "Edited 28-Sep-93 13:50 by jds") - (POSTSCRIPT.PUTCOMMAND STREAM (\PSC.SPACEWID (DSPFONT NIL STREAM) - WIDTH) - " 0 rmoveto "]) - -(\PSC.SPACEWID - [LAMBDA (FONTDESC CHAR) (* ; "Edited 28-Sep-93 13:41 by jds") - - (* ;; "Spacing character with a special width (e.g. M space, thin (1/5-M) space...") - - (* ;; "If CHAR is a list, it's (CHARCODE FACTOR), and we return a width of FACTOR * (CHARWIDTH CHARCODE). Otherwise, we just return the width of CHARCODE.") - - (COND - [(LISTP CHAR) - (FIXR (FTIMES (CADR CHAR) - (CHARWIDTH (CHARCODE.DECODE (CAR CHAR)) - FONTDESC] - (T (CHARWIDTH (CHARCODE.DECODE CHAR) - FONTDESC]) - -(\PSC.SYMBOLS - [LAMBDA (STREAM CHAR) (* ; "Edited 2-Nov-94 17:01 by jds") - (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) - (OLDFONT (\DSPFONT.PSC STREAM))) - (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch (FONTDESCRIPTOR FONTSIZE) - of OLDFONT) - (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT))) - (POSTSCRIPT.SHOWACCUM STREAM) - (\UPDATE.PSC STREAM IMAGEDATA) - (COND - ((EQUAL CHAR "0,161") - (POSTSCRIPT.OUTSTR STREAM " bboxchk "))) - (\DSPFONT.PSC STREAM OLDFONT]) -) - - - -(* ;; "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") - -(DEFINEQ - -(\POSTSCRIPT.NSHASH - [LAMBDA (MAPPING-LIST) (* ; - "Edited 30-Jul-93 14:46 by sybalskY:MV:ENVOS") - (* ; "Edited 4-May-93 02:21 by jds") - (* ; "Edited 3-Feb-93 00:33 by jds") - (for MAPPING in MAPPING-LIST unless (EQ (CAR MAPPING) - '*) - do (* ; - "Skip comments in the mapping list.") - (LET [(CHARCODE (CHARCODE.DECODE (CAR MAPPING] - - (* ;; "Fill in the translation entry for this character:") - - (PUTHASH CHARCODE - [DESTRUCTURING-BIND - (KIND CODE2 BASECHAR UNDERACCENTS) - (SETQ MAPPING (CDR MAPPING)) - (CONS KIND (SELECTQ KIND - ((SYMBOL NIL DINGBAT) - (CONS (CHARCODE.DECODE CODE2))) - (FUNCTION (CONS CODE2)) - ((ACCENT ACCENTPAIR) - (LIST (CHARCODE.DECODE CODE2) - (CHARCODE.DECODE BASECHAR) - (AND UNDERACCENTS (CHARCODE.DECODE UNDERACCENTS)) - )) - (APPLY* (* ; - "Apply setup function to coerce argument data") - - (* ;; "MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN SETUPFN) PRINTFN gets applied to stream and result of applying SETUPFN to DATA. WIDTHFN gets applied to coerced data and fontdescriptor") - - (LIST (APPLY* (OR (CAR (CDDDDR MAPPING)) - (FUNCTION CL:IDENTITY)) - (CADR MAPPING)) - (CADDR MAPPING) - (CADDDR MAPPING))) - (ERROR "UNRECOGNIZED POSTSCRIPT CHARACTER TYPE" MAPPING] - *POSTSCRIPT-NS-HASH*) - - (* ;; "If this character is in the lower 127, we need to mark it for special handling in \POSTSCRIPT.CHARTYPE, by putting a T in the array at the charcode's position:") - - (CL:WHEN (<= CHARCODE 254) - (CL:SETF (CL:AREF \POSTSCRIPT.CHARTYPE CHARCODE) - T))]) -) - -(RPAQQ *POSTSCRIPT-UNACCENTED-FONTS* (Dancer ZapfDingbats "Dancer" "ZapfDingbats")) - -(RPAQQ *POSTSCRIPT-NS-TRANSLATIONS* - ( - (* ;; "Mapping of NS characters to Postscript renderings.") - - - (* ;; "First few are for control-codes in old Press fonts (Timesroman, etc.); not strictly NS, but undefined therein so should be OK.") - - ("^S" NIL "2,320") - (* ; "pressfont em dash") - ("^V" NIL "2,261") - (* ; "pressfont en dash") - ("^G" NIL "0,140") - ("0,244" NIL "2,250") - (* ; "generic currency symbol") - ("0,251" NIL "2,140") - (* ; "left single quote") - ("0,254" SYMBOL "2,254") - (* ; "left arrow") - ("0,255" SYMBOL "2,255") - (* ; "uparrow") - ("0,256" SYMBOL "2,256") - (* ; "right arrow") - ("0,257" SYMBOL "2,257") - (* ; "down arrow") - ("0,260" SYMBOL "2,260") - (* ; "degree") - ("0,261" SYMBOL "2,261") - (* ; "+/-") - ("0,264" SYMBOL "2,264") - (* ; "times") - ("0,267" NIL "2,264") - (* ; "Center-dot") - ("0,270" SYMBOL "2,270") - (* ; "divide") - ("0,271" NIL "2,047") - (* ; "right single quote") - ("0,274" FUNCTION " f14 ") - (* ; "1/4") - ("0,275" FUNCTION " f12 ") - (* ; "1/2") - ("0,276" FUNCTION " f34 ") - (* ; "3/4") - ("0,322" SYMBOL "2,342") - (* ; "registered") - ("0,323" SYMBOL "2,343") - (* ; "copyright") - ("0,324" SYMBOL "2,344") - (* ; "tm") - ("0,334" FUNCTION " f18 ") - (* ; "1/8") - ("0,335" FUNCTION " f38 ") - (* ; "3/8") - ("0,336" FUNCTION " f58 ") - (* ; "5/8") - ("0,337" FUNCTION " f78 ") - (* ; "7/8") - ("0,342" NIL "2,235") - (* ; "Eth (slashed D?)") - ("0,354" NIL "2,237") - (* ; "Thorn") - ("0,363" NIL "2,236") - (* ; "eth") - ("0,374" NIL "2,240") - (* ; "thorn") - ("41,172" DINGBAT "0,110") - (* ; "filled star") - ("42,42" DINGBAT "0,161") - (* ; "ballot-box") - ("42,61" APPLY* "0,161" \PSC.SYMBOLS \PSC.SPACEWID NIL) - (* ; "Checked ballot-box") - ("357,44" NIL "2,261") - (* ; "n dash") - ("357,45" NIL "2,320") - (* ; "m dash") - ("357,55" APPLY* "M" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "M quad") - ("357,54" APPLY* "N" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "N quad") - ("357,56" APPLY* "1" \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "FIGURE quad") - ("357,57" APPLY* ("M" 0.2) - \PSC.SPACEDISP \PSC.SPACEWID NIL) - (* ; "This space (1/5M)") - ("357,60" NIL "2,262") - (* ; "dagger") - ("357,61" NIL "2,263") - (* ; "double dagger") - ("357,062" SYMBOL "2,361") - (* ; "angleright") - ("357,063" SYMBOL "2,341") - (* ; "angleleft") - ("357,70" SYMBOL "2,315") - (* ; "perpendicular") - ("357,101" NIL "2,275") - (* ; "per mil o/oo") - ("357,104" ACCENTPAIR "<" NIL "/") - (* ; "not less than") - ("357,105" ACCENTPAIR ">" "/") - (* ; "not greater than") - ("357,110" SYMBOL "2,312") - (* ; "parallel") - ("357,111" SYMBOL "2,315") - (* ; "not parallel") - ("357,112" SYMBOL "2,316") - (* ; "element") - ("357,113" SYMBOL "2,317") - (* ; "notelement") - ("357,114" SYMBOL "2,047") - (* ; "suchthat") - ("357,115" SYMBOL "2,334") - (* ; "implied by, double arrow left") - ("357,116" SYMBOL "2,333") - (* ; "iff, double arrow") - ("357,117" SYMBOL "2,336") - (* ; "implies, double arrow right") - ("357,120" SYMBOL "2,253") - (* ; "double arrow") - ("357,121" SYMBOL "2,333") - (* ; "double arrow") - ("357,122" SYMBOL "2,333") - (* ; "l/r arrow") - ("357,126" SYMBOL "2,307") - (* ; "intersection") - ("357,127" SYMBOL "2,310") - (* ; "union") - ("357,130" SYMBOL "2,312") - (* ; "reflexsuperset") - ("357,131" SYMBOL "2,315") - (* ; "reflexsubset") - ("357,132" SYMBOL "2,311") - (* ; "propersuperset") - ("357,133" SYMBOL "2,314") - (* ; "propersubset") - ("357,137" SYMBOL "2,313") - (* ; "notsubset") - ("357,141" SYMBOL "2,306") - (* ; "emptyset") - ("357,142" SYMBOL "2,305") - (* ; "circleplus") - ("357,144" SYMBOL "2,304") - (* ; "circlemultiply") - ("357,146" NIL "2,267") - (* ; "bullet") - ("357,147" SYMBOL "2,260") - (* ; - "center circle (composition), lowered degree") - ("357,152" SYMBOL "2,330") - (* ; "logicalnot") - ("357,154" SYMBOL "2,320") - (* ; "angle") - ("357,160" SYMBOL "2,136") - (* ; "perpendicular") - ("357,161" SYMBOL "2,265") - (* ; "proportional") - ("357,162" SYMBOL "2,272") - (* ; "equivalence") - ("357,165" SYMBOL "2,362") - (* ; "integral") - ("357,167" SYMBOL "2,273") - (* ; "approxequal") - ("357,170" SYMBOL "2,100") - (* ; "congruent") - ("357,172" SYMBOL "2,345") - (* ; "summation") - ("357,173" SYMBOL "2,325") - (* ; "product") - ("357,174" SYMBOL "2,326") - (* ; "radical") - ("357,242" SYMBOL "2,246") - (* ; "florin") - ("357,260" SYMBOL "2,351") - (* ; "Ceiling, left ") - ("357,261" SYMBOL "2,371") - (* ; "Ceiling, right") - ("357,262" SYMBOL "2,353") - (* ; "Floor, left ") - ("357,263" SYMBOL "2,373") - (* ; "Floor, right") - ("357,264" SYMBOL "2,44") - (* ; "exists") - ("357,265" SYMBOL "2,42") - (* ; "forall") - ("357,266" SYMBOL "2,331") - (* ; "logicaland") - ("357,267" SYMBOL "2,332") - (* ; "logicalor") - ("357,271" SYMBOL "2,321") - (* ; "gradient") - ("357,272" SYMBOL "2,266") - (* ; "partialdiff") - ("357,313" SYMBOL "2,252") - (* ; "spade") - ("357,317" DINGBAT "0,63") - (* ; "check") - ("357,375" FUNCTION " f13 ") - (* ; "1/3") - ("357,376" FUNCTION " f23 ") - (* ; "2/3") - ("361,041" ACCENT "0,4" A) - ("361,042" ACCENT "0,1" A) - ("361,043" ACCENT "0,2" A) - ("361,044" ACCENT "0,6" A) - ("361,045" ACCENTPAIR A "0,305") - (* ; "A-macron") - ("361,046" ACCENTPAIR A "0,306") - (* ; "A-breve") - ("361,047" ACCENT "0,3" A) - ("361,050" ACCENT "0,5" A) - ("361,055" ACCENT "0,7" C) - ("361,060" ACCENT "0,13" E) - ("361,061" ACCENT "0,10" E) - ("361,062" ACCENT "0,11" E) - ("361,063" ACCENTPAIR E "0,305") - (* ; "E-macron") - ("361,065" ACCENT "0,12" E) - ("361,066" ACCENTPAIR E NIL "0,316") - (* ; "E-ogonek") - ("361,076" ACCENT "0,17" I) - ("361,077" ACCENT "0,14" I) - ("361,100" ACCENT "0,15" I) - ("361,102" ACCENTPAIR I "0,305") - (* ; "I-macron") - ("361,104" ACCENT "0,16" I) - ("361,114" ACCENT "0,20" N) - ("361,117" ACCENT "0,24" O) - ("361,120" ACCENT "0,21" O) - ("361,121" ACCENT "0,22" O) - ("361,122" ACCENT "0,25" O) - ("361,123" ACCENTPAIR O "0,305") - (* ; "O-macron") - ("361,124" ACCENT "0,23" O) - ("361,134" ACCENT "0,26" S) - ("361,137" ACCENT "0,32" U) - ("361,140" ACCENT "0,27" U) - ("361,141" ACCENT "0,30" U) - ("361,143" ACCENTPAIR U "0,305") - (* ; "U-macron") - ("361,145" ACCENT "0,31" U) - ("361,155" ACCENT "0,33" Y) - ("361,160" ACCENT "0,34" Z) - ("361,165" ACCENTPAIR Y "0,305") - (* ; "Y-macron") - ("361,166" ACCENTPAIR "0,341" "0,305") - (* ; "AE-macron") - ("361,167" ACCENTPAIR "0,352" "0,305") - (* ; "OE-macron") - ("361,241" ACCENT "0,204" a) - ("361,242" ACCENT "0,201" a) - ("361,243" ACCENT "0,202" a) - ("361,244" ACCENT "0,206" a) - ("361,245" ACCENTPAIR a "0,305") - (* ; "a-macron") - ("361,246" ACCENTPAIR a "0,306") - (* ; "a-breve") - ("361,247" ACCENT "0,203" a) - ("361,250" ACCENT "0,205" a) - ("361,255" ACCENT "0,207" c) - ("361,260" ACCENT "0,213" e) - ("361,261" ACCENT "0,210" e) - ("361,262" ACCENT "0,211" e) - ("361,263" ACCENTPAIR e "0,305") - (* ; "e-macron") - ("361,265" ACCENT "0,212" e) - ("361,266" ACCENTPAIR e NIL "0,316") - (* ; "e-ogonek") - ("361,267" ACCENTPAIR e "0,317") - (* ; "e-caron") - ("361,276" ACCENT "0,217" i) - ("361,277" ACCENT "0,214" i) - ("361,300" ACCENT "0,215" i) - ("361,302" ACCENTPAIR "0,365" "0,305") - (* ; "i-macron") - ("361,304" ACCENT "0,216" i) - ("361,314" ACCENT "0,220" n) - ("361,317" ACCENT "0,224" o) - ("361,320" ACCENT "0,221" o) - ("361,321" ACCENT "0,222" o) - ("361,322" ACCENT "0,225" o) - ("361,323" ACCENTPAIR o "0,305") - (* ; "o-macron") - ("361,324" ACCENT "0,223" o) - ("361,334" ACCENT "0,226" s) - ("361,337" ACCENT "0,232" u) - ("361,340" ACCENT "0,227" u) - ("361,341" ACCENT "0,230" u) - ("361,343" ACCENTPAIR u "0,305") - (* ; "u-macron") - ("361,344" ACCENTPAIR u "0,306") - (* ; "u-breve") - ("361,345" ACCENT "0,231" u) - ("361,355" ACCENT "0,233" y) - ("361,360" ACCENT "0,234" z) - ("361,365" ACCENTPAIR y "0,305") - (* ; "y-macron") - ("361,366" ACCENTPAIR "0,361" "0,305") - (* ; "ae-macron") - ("361,367" ACCENTPAIR "0,372" "0,305") - (* ; "oe-macron") - ("361,371" ACCENTPAIR a "0,317") - (* ; "a-caron") - ("361,375" ACCENTPAIR g "0,317") - (* ; "g-caron") - - (* ;; "Special code assignments for Dictionary of Old English, UToronto:") - - ("361,370" ACCENTPAIR a ("0,305" "0,306")) - (* ; "a - breve-macron") - ("361,372" ACCENTPAIR e "0,306") - (* ; "e-breve") - ("361,373" ACCENTPAIR e "0,305" "0,56") - (* ; "e macron underdot") - ("361,374" ACCENTPAIR e ("0,305" "0,306")) - (* ; "e - breve-macron") - ("361,376" ACCENTPAIR "0,365" "0,306") - (* ; "i-breve") - ("362,242" ACCENTPAIR "0,365" "0,317") - (* ; "i-caron") - ("362,241" ACCENTPAIR "0,365" ("0,305" "0,306")) - (* ; " i - breve-macron") - ("362,243" ACCENTPAIR n "0,305") - (* ; "n-macron") - ("362,244" ACCENTPAIR m "0,305") - (* ; "m-macron") - ("362,245" ACCENTPAIR o "0,317") - (* ; "o-caron") - ("362,246" ACCENTPAIR o "0,306") - (* ; "o-breve") - ("362,247" ACCENTPAIR o ("0,305" "0,306")) - (* ; "o - breve-macron") - ("362,250" ACCENTPAIR o "0,305" "0,56") - (* ; "o-macron underdot") - ("362,251" ACCENTPAIR o "0,316") - (* ; "o-ogonek") - ("362,252" ACCENTPAIR u "0,317") - (* ; "u-caron") - ("362,253" ACCENTPAIR u ("0,305" "0,306")) - (* ; "u - breve-macron") - ("362,254" ACCENTPAIR y "0,306") - (* ; "y-breve") - ("362,256" ACCENTPAIR y "0,317") - (* ; "y-caron") - ("362,255" ACCENTPAIR y ("0,305" "0,306")) - (* ; "y - breve-macron") - (* ; "235 = Eth") - (* ; "236 = eth") - (* ; "237 = Thorn") - (* ; "240 = thorn") - - (* ;; "NS Greek characters") - - ("46,101" SYMBOL "2,101") - (* ; "Alpha") - ("46,102" SYMBOL "2,102") - (* ; "Beta") - ("46,103" SYMBOL 0) - (* ; "--empty--") - ("46,104" SYMBOL "2,107") - (* ; "Gamma") - ("46,105" SYMBOL "2,104") - (* ; "Delta") - ("46,106" SYMBOL "2,105") - (* ; "Epsilon") - ("46,107" SYMBOL 0) - (* ; "Stigma") - ("46,110" SYMBOL 0) - (* ; "Digamma") - ("46,111" SYMBOL "2,132") - (* ; "Zeta") - ("46,112" SYMBOL "2,110") - (* ; "Eta") - ("46,113" SYMBOL "2,121") - (* ; "Theta") - ("46,114" SYMBOL "2,111") - (* ; "Iota") - ("46,115" SYMBOL "2,113") - (* ; "Kappa") - ("46,116" SYMBOL "2,114") - (* ; "Lambda") - ("46,117" SYMBOL "2,115") - (* ; "Mu") - ("46,120" SYMBOL "2,116") - (* ; "Nu") - ("46,121" SYMBOL "2,130") - (* ; "Xi") - ("46,122" SYMBOL "2,117") - (* ; "Omicron") - ("46,123" SYMBOL "2,120") - (* ; "Pi") - ("46,124" SYMBOL 0) - (* ; "Koppa") - ("46,125" SYMBOL "2,122") - (* ; "Rho") - ("46,126" SYMBOL "2,123") - (* ; "Sigma") - ("46,127" SYMBOL 0) - (* ; "--empty--") - ("46,130" SYMBOL "2,124") - (* ; "Tau") - ("46,131" SYMBOL "2,125") - (* ; "Upsilon") - ("46,132" SYMBOL "2,106") - (* ; "Phi") - ("46,133" SYMBOL "2,103") - (* ; "Chi") - ("46,134" SYMBOL "2,131") - (* ; "Psi") - ("46,135" SYMBOL "2,132") - (* ; "Omega") - ("46,141" SYMBOL "2,141") - (* ; "alpha") - ("46,142" SYMBOL "2,142") - (* ; "beta") - ("46,143" SYMBOL 0) - (* ; "(md beta)") - ("46,144" SYMBOL "2,147") - (* ; "gamma") - ("46,145" SYMBOL "2,144") - (* ; "delta") - ("46,146" SYMBOL "2,145") - (* ; "epsilon") - ("46,147" SYMBOL "2,126") - (* ; "stigma") - ("46,150" SYMBOL 0) - (* ; "digamma") - ("46,151" SYMBOL "2,172") - (* ; "zeta") - ("46,152" SYMBOL "2,150") - (* ; "eta") - ("46,153" SYMBOL "2,161") - (* ; "theta") - ("46,154" SYMBOL "2,151") - (* ; "iota") - ("46,155" SYMBOL "2,153") - (* ; "kappa") - ("46,156" SYMBOL "2,154") - (* ; "lambda") - ("46,157" SYMBOL "2,155") - (* ; "mu") - ("46,160" SYMBOL "2,156") - (* ; "nu") - ("46,161" SYMBOL "2,170") - (* ; "xi") - ("46,162" SYMBOL "2,157") - (* ; "omicron") - ("46,163" SYMBOL "2,160") - (* ; "pi") - ("46,164" SYMBOL 0) - (* ; "(koppa)") - ("46,165" SYMBOL "2,162") - (* ; "rho") - ("46,166" SYMBOL "2,163") - (* ; "sigma") - ("46,167" SYMBOL "2,126") - (* ; "(fl sigma)") - ("46,170" SYMBOL "2,164") - (* ; "tau") - ("46,171" SYMBOL "2.165") - (* ; "upsilon") - ("46,172" SYMBOL "2,146") - (* ; "phi") - ("46,173" SYMBOL "2,143") - (* ; "chi") - ("46,174" SYMBOL "2,171") - (* ; "psi") - ("46,175" SYMBOL "2,167") - (* ; "omega") - - (* ;; "NS Miscellaneous symbols") - - ("041,142" SYMBOL "2,271") - (* ; "notequal") - ("041,145" SYMBOL "2,243") - (* ; "lessequal") - ("041,146" SYMBOL "2,263") - (* ; "greaterequal") - ("041,147" SYMBOL "2,245") - (* ; "infinity") - ("041,150" SYMBOL "2,134") - (* ; "therefore") - ("041,155" SYMBOL "2,262") - (* ; "second") - ("356,055" SYMBOL "2,055") - (* ; "minus") - ("356,106" SYMBOL "2,340") - (* ; "lozenge") - ("356,163" SYMBOL "2,351") - (* ; "topleftbracket") - ("356,164" SYMBOL "2,353") - (* ; "bottomleftbracket") - ("356,165" SYMBOL "2,352") - (* ; "centerbracket") - ("356,166" SYMBOL "2,371") - (* ; "toprightbracket") - ("356,167" SYMBOL "2,373") - (* ; "bottomrightbracket") - ("356,176" SYMBOL "2,176") - (* ; "similar") - ("356,314" SYMBOL "2,251") - (* ; "heart") - ("356,340" SYMBOL "2,374") - (* ; "toprightbracce") - ("356,341" SYMBOL "2,357") - (* ; "braceextend") - ("356,342" SYMBOL "2,375") - (* ; "centerrightbracce") - ("356,343" SYMBOL "2,376") - (* ; "bottomrightbracce") - ("356,344" SYMBOL "2,354") - (* ; "topleftbracce") - ("356,345" SYMBOL "2,356") - (* ; "bottomleftbracce") - ("356,346" SYMBOL "2,355") - (* ; "centerleftbracce") - ("356,355" SYMBOL "2,363") - (* ; "integraltop") - ("356,356" SYMBOL "2,365") - (* ; "integralbottom") - ("356,357" SYMBOL "2,364") - (* ; "integralcenter"))) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS *POSTSCRIPT-NS-HASH*) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(PUTPROPS \POSTSCRIPT.FRACTION MACRO ((STREAM STRING) - - (* ;; "Handle printing of a fraction, given a string that's the name of the PS function (defined in \POSTSCRIPT.JOB.SETUP) that prints it. You must put spaces around the name.") - - (POSTSCRIPT.SHOWACCUM STREAM) - [COND - ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) - (ffetch POSTSCRIPTRIGHTMARGIN of IMAGEDATA)) - (\TERPRI.PSC STREAM) - (SETQ NEWXPOS (IPLUS (ffetch POSTSCRIPTX of IMAGEDATA) - CHARWID] - [COND - ((NOT (ffetch POSTSCRIPTCHARSTOSHOW of IMAGEDATA)) - (COND - ((ffetch POSTSCRIPTPENDINGXFORM of IMAGEDATA) - (\SETXFORM.PSC STREAM IMAGEDATA))) - (COND - ((ffetch POSTSCRIPTFONTCHANGEDFLG of IMAGEDATA) - (* ; - "If font was changed then switch before printing") - (\SWITCHFONTS.PSC STREAM IMAGEDATA))) - (COND - ((ffetch POSTSCRIPTMOVEFLG of IMAGEDATA) - (* ; "likewise for position") - (\SETPOS.PSC STREAM IMAGEDATA] - (POSTSCRIPT.OUTSTR STREAM STRING))) -) -) - -(RPAQ \POSTSCRIPT.ORIENTATION.MENU - (create MENU ITEMS _ '(("Landscape" T "Print this file/document/image in Landscape Orientation" - ) - ("Portrait" 'NIL - "Print this file/document/image in Portrait Orientation")) - TITLE _ "Orientation" CENTERFLG _ T MENUOFFSET _ - (create POSITION XCOORD _ -1 YCOORD _ 0) - CHANGEOFFSETFLG _ 'Y)) - -(RPAQ \POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK - "Always ask whether to print in Landscape or Portrait Orientation" - ) - ("Landscape" T - "Default printing to Landscape Orientation" - ) - ("Portrait" 'NIL - "Default printing to Portrait Orientation" - )) - TITLE _ "Default Orientation" CENTERFLG _ T)) - -(RPAQ PS.BITMAPARRAY (READARRAY-FROM-LIST 16 (QUOTE BYTE) 0 (QUOTE (48 49 50 51 52 53 54 55 56 57 65 -66 67 68 69 70 NIL)))) - - -(RPAQQ \POSTSCRIPT.JOB.SETUP - ("/bdef {bind def} bind def" "/ldef {load def} bdef" "/S /show ldef" "/M /moveto ldef" - "/DR {transform round exch round exch itransform} bdef" - "/L {gsave newpath setlinewidth 0 setlinecap" - " M lineto currentpoint stroke grestore M} bdef" - "/L1 {gsave newpath 0 setdash setgray setlinewidth 0 setlinecap" - " M lineto currentpoint stroke grestore M} bdef" - "/F {findfont exch scalefont setfont} bdef" - "/CLP {newpath M dup 0 rlineto exch 0 exch rlineto" - " neg 0 rlineto closepath clip newpath} bdef" - "/R {gsave setgray newpath M dup 0 rlineto exch 0 exch" - " rlineto neg 0 rlineto closepath eofill grestore} bdef" "/ellipsedict 9 dict def" - "ellipsedict /mtrx matrix put" "/ellipse" " { ellipsedict begin" " /endangle exch def" - " /startangle exch def" " /orientation exch def" " /minorrad exch def" - " /majorrad exch def" " /y exch def" " /x exch def" - " /savematrix mtrx currentmatrix def" " x y translate" " orientation rotate" - " majorrad minorrad scale" " 0 0 1 startangle endangle arc" " savematrix setmatrix" - " end } bdef" "/concatprocs" " {/proc2 exch cvlit def" " /proc1 exch cvlit def" - " /newproc proc1 length proc2 length add array def" " newproc 0 proc1 putinterval" - " newproc proc1 length proc2 putinterval" " newproc cvx" " } bdef" - "/resmatrix matrix def" "/findresolution" " {72 0 resmatrix defaultmatrix dtransform" - " /yres exch def /xres exch def" " xres dup mul yres dup mul add sqrt" " } bdef" - "/thebitimage" " {/maskp exch def" " /bihgt exch def" " /biwid exch def" - " /byte 1 string def" " /strbufl biwid 8 div ceiling cvi def" - " /strbuf strbufl string def" - " maskp not{{1 exch sub} currenttransfer concatprocs settransfer} if" " biwid bihgt" - " maskp { true } { 1 } ifelse" " [biwid 0 0 bihgt 0 0]" " {/col 0 def" - " {currentfile byte readhexstring pop 0 get" " dup 16#B2 eq {pop" - " currentfile byte readhexstring pop 0 get 1 add" - " currentfile byte readhexstring pop pop /nbyte byte 0 get def" - " { strbuf col nbyte put /col col 1 add def} repeat}" - " {dup 16#B3 eq {pop /col col" " currentfile byte readhexstring pop" - " 0 get add 1 add def}" " {16#B4 eq {currentfile byte readhexstring pop pop} if" - " strbuf col byte 0 get put /col col 1 add def} ifelse" " } ifelse" - " col strbufl ge { exit } if } loop" " strbuf }" - " maskp { imagemask } { image } ifelse" " } bdef" "/setuserscreendict 22 dict def" - "setuserscreendict begin" " /tempctm matrix def" " /temprot matrix def" - " /tempscale matrix def" "end" "/setuserscreen" " {setuserscreendict begin" - " /spotfunction exch def" " /screenangle exch def" " /cellsize exch def" - " /m tempctm currentmatrix def" " /rm screenangle temprot rotate def" - " /sm cellsize dup tempscale scale def" - " sm rm m m concatmatrix m concatmatrix pop" - " 1 0 m dtransform /y1 exch def /x1 exch def" - " /veclength x1 dup mul y1 dup mul add sqrt def" - " /frequency findresolution veclength div def" " /newscreenangle y1 x1 atan def" - " m 2 get m 1 get mul m 0 get m 3 get mul sub" - " 0 gt { { neg } /spotfunction load concatprocs" - " /spotfunction exch def } if" - " frequency newscreenangle /spotfunction load setscreen" " end" " } bdef" - "/setpatterndict 18 dict def" "setpatterndict begin" " /bitison" - " {/ybit exch def /xbit exch def" - " /bytevalue bstring ybit bwidth mul xbit 8 idiv add get def" - " /mask 1 7 xbit 8 mod sub bitshift def" " bytevalue mask and 0 ne" " } bdef" - "end" "/bitpatternspotfunction" " {setpatterndict begin" " /y exch def /x exch def" - " /xindex x 1 add 2 div bpside mul 1 sub cvi def" - " /yindex y 1 add 2 div bpside mul 1 sub cvi def" " xindex yindex bitison" - " {/onbits onbits 1 add def 1}" " {/offbits offbits 1 add def 0} ifelse" " end" - " } bdef" "/setpattern" " {setpatterndict begin" " /cellsz exch def" - " /angle exch def" " /bwidth exch def" " /bpside exch def" " /bstring exch def" - " /onbits 0 def /offbits 0 def" - " cellsz angle /bitpatternspotfunction load setuserscreen" " {} settransfer" - " offbits offbits onbits add div setgray" " end" " } bdef" - "%% - - - - - Fraction-setting code, to support NS fonts better - - - - -" - "/fractiondict 20 dict def" "/fractionshow " "{ fractiondict begin" "/denom exch def " - "/num exch def " "/regfont currentfont def" - "/fractfont currentfont [.65 0 0 .6 0 0] makefont def " "gsave newpath 0 0 moveto " - "(1) true charpath flattenpath pathbbox " "/height exch def pop pop pop" " grestore" - "0 .4 height mul rmoveto" "fractfont setfont num show" - "0 .4 height mul neg rmoveto regfont setfont (\244) show" - "fractfont setfont denom show regfont setfont end } bdef" - "/f14 { (1) (4) fractionshow } bdef" "/f12 { (1) (2) fractionshow } bdef" - "/f34 { (3) (4) fractionshow } bdef" "/f18 { (1) (8) fractionshow } bdef" - "/f38 { (3) (8) fractionshow } bdef" "/f58 { (5) (8) fractionshow } bdef" - "/f78 { (7) (8) fractionshow } bdef" "/f13 { (1) (3) fractionshow } bdef" - "/f23 { (2) (3) fractionshow } bdef" "/bboxdict 20 dict def" - "/bboxchk { bboxdict begin" "/regfont currentfont def" - "/chkfont currentfont [1.25 0 0 1.25 0 0] makefont def " "gsave newpath 0 0 moveto " - "(\161) true charpath flattenpath pathbbox " "/height exch def pop pop pop " - " grestore " " currentpoint " " .2 height mul .3 height mul rmoveto" - "chkfont setfont (\063) show" " moveto" " regfont setfont" "(\161) show end } bdef" - "/rencdict 15 dict def" "/encodefont { rencdict begin" "/newname exch def" - "/oldfont exch def" "/newcodes [" "8#001 /Aacute" "8#002 /Acircumflex" - "8#003 /Adieresis" "8#004 /Agrave" "8#005 /Aring" "8#006 /Atilde" "8#007 /Ccedilla" - "8#010 /Eacute" "8#011 /Ecircumflex" "8#012 /Edieresis" "8#013 /Egrave" "8#014 /Iacute" - "8#015 /Icircumflex" "8#016 /Idieresis" "8#017 /Igrave" "8#020 /Ntilde" "8#021 /Oacute" - "8#022 /Ocircumflex" "8#023 /Odieresis" "8#024 /Ograve" "8#025 /Otilde" "8#026 /Scaron" - "8#027 /Uacute" "8#030 /Ucircumflex" "8#031 /Udieresis" "8#032 /Ugrave" - "8#033 /Ydieresis" "8#034 /Zcaron" "8#177 /periodinferior" "8#201 /aacute" - "8#202 /acircumflex" "8#203 /adieresis" "8#204 /agrave" "8#205 /aring" "8#206 /atilde" - "8#207 /ccedilla" "8#210 /eacute" "8#211 /ecircumflex" "8#212 /edieresis" - "8#213 /egrave" "8#214 /iacute" "8#215 /icircumflex" "8#216 /idieresis" "8#217 /igrave" - "8#220 /ntilde" "8#221 /oacute" "8#222 /ocircumflex" "8#223 /odieresis" "8#224 /ograve" - "8#225 /otilde" "8#226 /scaron" "8#227 /uacute" "8#230 /ucircumflex" "8#231 /udieresis" - "8#232 /ugrave" "8#233 /ydieresis" "8#234 /zcaron" "8#235 /Eth" "8#236 /eth" - "8#237 /Thorn" "8#240 /thorn" " ] def" - "/olddict oldfont findfont def /newfont olddict maxlength dict def" - "olddict { exch dup /FID ne { dup /Encoding eq" - "{ exch dup length array copy newfont 3 1 roll put }" - "{ exch newfont 3 1 roll put } ifelse }" " { pop pop } ifelse } forall" - "newfont /FontName newname put" "newcodes aload pop" - "newcodes length 2 idiv { newfont /Encoding get 3 1 roll put } repeat " - "newname newfont definefont pop end } def" " /accentdict 10 dict def " - " /accentor { accentdict begin /scaler exch def /delta exch def " - "/unders exch def /accents exch def /mainch exch def /scrt (X) def" - " /w1 mainch stringwidth pop def " " currentpoint mainch show currentpoint 4 2 roll " - "accents { /ch exch def 2 copy moveto " " scrt 0 ch put " - " /w2 scrt stringwidth pop def " - " w1 w2 sub 2 div delta rmoveto scrt show " - " /delta delta 150 scaler mul 9 div add def" " } forall " - "unders { /ch exch def 2 copy moveto " " scrt 0 ch put " - " /w2 scrt stringwidth pop def " - " ch 46 eq { w1 w2 sub 2 div -175 scaler mul 9 div rmoveto scrt show 0 175 rmoveto }" - " { w1 w2 sub 2 div 0 rmoveto scrt show } ifelse " " } forall " - " pop pop moveto end } def " "%%%%EndProlog" "%%%%BeginSetup")) - -(RPAQQ SlopeMenuItems ((Italic 'ITALIC "This is an Italic Slope font") - (Regular 'REGULAR "This is a Regular Slope font"))) - -(RPAQQ WeightMenuItems ((Bold 'BOLD "This is a Bold Weight font") - (Medium 'MEDIUM "This is a Medium Weight font") - (Light 'LIGHT "This is a Light Weight font"))) - -(ADDTOVAR BackgroundMenuCommands - ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE (MENU - \POSTSCRIPT.ORIENTATION.OPTIONS.MENU - )) - "Select the default Orientation for PostScript output" - (SUBITEMS ("Ask" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE 'ASK) - "Always ask whether to print in Landscape or Portrait Orientation") - ("Landscape" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE T) - "Default printing to Landscape Orientation") - ("Portrait" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE NIL) - "Default printing to Portrait Orientation")))) - -(RPAQQ BackgroundMenu NIL) -(DECLARE%: EVAL@COMPILE - -(RPAQQ GOLDEN.RATIO 1.618034) - -(RPAQQ \PS.SCALE0 100) - -(RPAQQ \PS.TEMPARRAYLEN 20) - - -(CONSTANTS (GOLDEN.RATIO 1.618034) - (\PS.SCALE0 100) - (\PS.TEMPARRAYLEN 20)) -) - -(RPAQ? POSTSCRIPT.BITMAP.SCALE 1) - -(RPAQ? POSTSCRIPT.EOL 'CR) - -(RPAQ? POSTSCRIPT.IMAGESIZEFACTOR 1) - -(RPAQ? POSTSCRIPT.PREFER.LANDSCAPE NIL) - -(RPAQ? POSTSCRIPT.TEXTFILE.LANDSCAPE NIL) - -(RPAQ? POSTSCRIPT.DEFAULT.PAGEREGION '(4800 4800 52800 70800)) - -(RPAQ? POSTSCRIPT.TEXTURE.SCALE 4) - -(RPAQ? POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) - 'MAIKO) - "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") - (T "{DSK}POSTSCRIPT>")))) - -(RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE 72) -(DEFINEQ - -(POSTSCRIPTSEND - - [LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 20-Nov-95 11:29 by ") - - (* ; "Edited 20-Nov-95 11:26 by ") - - - - (* ;; "This is the send function for generic POSTSCRIPT printers. It branches on the architecture-specific function. The theory is that the send method is really a property of the operating system, not a property of specific postscript printers. These functions are contained in separate library files (or defined by user).") - - - - (SELECTQ (MKATOM (UNIX-GETPARM "ARCH")) - - (dos (DOSPRINT HOST FILE PRINTOPTIONS)) - - (UnixPrint HOST FILE PRINTOPTIONS]) -) - -(ADDTOVAR PRINTERTYPES ((POSTSCRIPT) - (CANPRINT (POSTSCRIPT)) - (STATUS TRUE) - (PROPERTIES NILL) - (SEND POSTSCRIPTSEND) - (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) - (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION - TITLE)))) - -(ADDTOVAR POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) - (HELVETICAD . HELVETICA) - (TIMESROMAN . TIMES) - (TIMESROMAND . TIMES) - (COURIER . COURIER) - (GACHA . COURIER) - (CLASSIC . NEWCENTURYSCHLBK) - (MODERN . HELVETICA) - (CREAM . HELVETICA) - (TERMINAL . COURIER) - (LOGO . HELVETICA) - (OPTIMA . PALATINO) - (TITAN . COURIER)) - -(ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) - (EXTENSION (PS PSC PSF)) - (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT)))) - -(ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) - (FONTCREATE POSTSCRIPT.FONTCREATE) - (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC))) - -(RPAQ? POSTSCRIPT.PAGETYPE 'LETTER) - - - -(* ;; -"NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk" -) - - -(APPENDTOVAR POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2)) - (LEGAL (0 0 8.5 14) - NIL - (-0.1 -0.1 8.7 14.2)) - (NOTE (0 0 8.5 11) - NIL - (-0.1 -0.1 8.7 11.2))) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST - POSTSCRIPT.PREFER.LANDSCAPE POSTSCRIPT.TEXTFILE.LANDSCAPE POSTSCRIPT.TEXTURE.SCALE - POSTSCRIPTFONTDIRECTORIES \POSTSCRIPT.JOB.SETUP \POSTSCRIPT.MAX.WILD.FONTSIZE - \POSTSCRIPT.ORIENTATION.MENU \POSTSCRIPTIMAGEOPS POSTSCRIPT.PAGETYPE POSTSCRIPT.PAGEREGIONS) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(POSTSCRIPT.INIT) -) - -(PUTPROPS POSTSCRIPTSTREAM FILETYPE :TCOMPL) - -(PUTPROPS POSTSCRIPTSTREAM MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP")) -(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS - -(ADDTOVAR NLAMA ) - -(ADDTOVAR NLAML ) - -(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) -) -(PUTPROPS POSTSCRIPTSTREAM COPYRIGHT ( -"Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets" - 1989 1990 1991 1992 1993 1994 1995 1997 1998 2018 2021)) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (22912 30016 (POSTSCRIPT.INIT 22922 . 30014)) (30996 65780 (PSCFONT.READFONT 31006 . -32914) (PSCFONT.SPELLFILE 32916 . 33494) (PSCFONT.COERCEFILE 33496 . 35068) ( -PSCFONTFROMCACHE.SPELLFILE 35070 . 36055) (PSCFONTFROMCACHE.COERCEFILE 36057 . 37709) ( -PSCFONT.WRITEFONT 37711 . 38726) (READ-AFM-FILE 38728 . 44599) (CONVERT-AFM-FILES 44601 . 45813) ( -POSTSCRIPT.GETFONTID 45815 . 47210) (POSTSCRIPT.FONTCREATE 47212 . 59611) ( -\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 59613 . 62010) (POSTSCRIPT.FONTSAVAILABLE 62012 . 65778)) (66335 -75659 (OPENPOSTSCRIPTSTREAM 66345 . 75147) (CLOSEPOSTSCRIPTSTREAM 75149 . 75657)) (75704 81525 ( -POSTSCRIPT.HARDCOPYW 75714 . 79063) (POSTSCRIPT.TEDIT 79065 . 79545) (POSTSCRIPT.TEXT 79547 . 79838) ( -POSTSCRIPTFILEP 79840 . 80476) (MAKEEPSFILE 80478 . 81523)) (81526 126412 (POSTSCRIPT.BITMAPSCALE -81536 . 83992) (POSTSCRIPT.CLOSESTRING 83994 . 84528) (POSTSCRIPT.ENDPAGE 84530 . 85401) ( -POSTSCRIPT.OUTSTR 85403 . 86424) (POSTSCRIPT.PUTBITMAPBYTES 86426 . 94897) (POSTSCRIPT.PUTCOMMAND -94899 . 95948) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95950 . 101398) (POSTSCRIPT.SHOWACCUM 101400 . 103638) ( -POSTSCRIPT.STARTPAGE 103640 . 106219) (\POSTSCRIPTTAB 106221 . 107092) (\PS.BOUTFIXP 107094 . 108444) -(\PS.SCALEHACK 108446 . 111275) (\PS.SCALEREGION 111277 . 111837) (\SCALEDBITBLT.PSC 111839 . 116139) -(\SETPOS.PSC 116141 . 116603) (\SETXFORM.PSC 116605 . 118424) (\STRINGWIDTH.PSC 118426 . 118880) ( -\SWITCHFONTS.PSC 118882 . 125039) (\TERPRI.PSC 125041 . 126410)) (126447 182167 (\BITBLT.PSC 126457 . -127010) (\BLTSHADE.PSC 127012 . 131294) (\CHARWIDTH.PSC 131296 . 132063) (\CREATECHARSET.PSC 132065 . -133763) (\DRAWARC.PSC 133765 . 136245) (\DRAWCIRCLE.PSC 136247 . 138656) (\DRAWCURVE.PSC 138658 . -142679) (\DRAWELLIPSE.PSC 142681 . 145158) (\DRAWLINE.PSC 145160 . 147510) (\DRAWPOINT.PSC 147512 . -148100) (\DRAWPOLYGON.PSC 148102 . 151216) (\DSPBOTTOMMARGIN.PSC 151218 . 151783) ( -\DSPCLIPPINGREGION.PSC 151785 . 153228) (\DSPCOLOR.PSC 153230 . 154071) (\DSPFONT.PSC 154073 . 158283) - (\DSPLEFTMARGIN.PSC 158285 . 158854) (\DSPLINEFEED.PSC 158856 . 159432) (\DSPPUSHSTATE.PSC 159434 . -161197) (\DSPPOPSTATE.PSC 161199 . 163708) (\DSPRESET.PSC 163710 . 164356) (\DSPRIGHTMARGIN.PSC 164358 - . 164930) (\DSPROTATE.PSC 164932 . 165955) (\DSPSCALE.PSC 165957 . 166888) (\DSPSCALE2.PSC 166890 . -167709) (\DSPSPACEFACTOR.PSC 167711 . 168683) (\DSPTOPMARGIN.PSC 168685 . 169402) (\DSPTRANSLATE.PSC -169404 . 171978) (\DSPXPOSITION.PSC 171980 . 172579) (\DSPYPOSITION.PSC 172581 . 173153) ( -\FILLCIRCLE.PSC 173155 . 175801) (\FILLPOLYGON.PSC 175803 . 179719) (\FIXLINELENGTH.PSC 179721 . -181215) (\MOVETO.PSC 181217 . 181968) (\NEWPAGE.PSC 181970 . 182165)) (182223 205375 ( -\POSTSCRIPT.CHANGECHARSET 182233 . 183037) (\POSTSCRIPT.OUTCHARFN 183039 . 195896) ( -\POSTSCRIPT.PRINTSLUG 195898 . 197865) (\POSTSCRIPT.SPECIALOUTCHARFN 197867 . 200299) (\UPDATE.PSC -200301 . 201524) (\POSTSCRIPT.ACCENTFN 201526 . 202468) (\POSTSCRIPT.ACCENTPAIR 202470 . 205373)) ( -205473 207118 (\PSC.SPACEDISP 205483 . 205762) (\PSC.SPACEWID 205764 . 206383) (\PSC.SYMBOLS 206385 . -207116)) (207227 210218 (\POSTSCRIPT.NSHASH 207237 . 210216)) (254693 255407 (POSTSCRIPTSEND 254703 . -255405))))) -STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM deleted file mode 100644 index bf3a121e359188d0dbf053eaea242e9aab15fe9e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 91382 zcmeFa3v^u9c^*15fJh1wApnG78m8%^F-3z60bw2hK}NRcU}k_BU}nw;1CRto2?jZk z@E8Fs2>H>(x3-%{b61-#+x0VXvtlQ9n=*fTC>oHh1097G|IQI{WO$|Nj5olS+?d3+djGY%blKEsQwU z;i8=!w@1@fI9r%ZPvo+tV%R!7k+xHl_HeEyd)O|etw{f|mX;psA&F{}>68_Y#(T$} zTJDYZM`KnbemZ{YbbKIe^@K02Jb8JcGFP@%maVY$6KC`3R4zUJk%uY^7guLjKm6XJ zQ<^L#C$h!K(j@xI_x*SzcFbxCM`K2R1E&Wfr~CWE*6N(w-`s~TuU>iJw3W;`rF3mC z)&kx(GL_3&WePOFSyN1y;e8E8Y*d2Y14((jHXMylaAFhQYbYZ|1s-yaUy*t>r9n;QLo5lORvS`%TEHda89oyd%>$lXK1}*Lu zdB^tGOq$GB(TWUMc7NpLkcDKNlcy*dyHLv6lUTvh z@ncrgZ?!cA0`2{wv(|dN9BdCZwfFDgr5g`*{d_qXd^W$eH#gt?*vE25p9?i@{dJ+E z<6P5cvRj8U=clX4cyX*_g;tgqnb+uQ;EVh_oq5~(e?XV_-|e(=#+R-JKBkg0t^bM| zZCrL*_fTSc&sLXCHgDadlcAZmDi20y?CYB8aBE6QTe)eYYyEAZ%_B~SgNI+?cfD=B zlYhJ2mffBEss}LOrjK8}Rl(Oz@z?54U4I`vwn&$qA^O*~dEDtVGJ;$8IaCtd+DpH| z`R?xdZvJfU_xIRU)Jl%{sA1CoG-VrxPtYaj#Ca>O`AP zbm&B!DS)xK1=t0^JV-B|Navk1>E6^-F_%pOU6lx6t2Y3Wo&v-)KMg2w zVsg5ewuXkHwV;eX`Z&J2-)xc1gFJDHC2MFfY88Metf7IJO2p$T5gRbzrGe#!qJydi zK2;j`4@u(WDa<)2lCyooxk(z8b@CKm%sJ zfbE!wm}E|sGDhw|9Jv$r*`fp5N-6^JQfm#fRr44yAaW-huSYC5x3wpd(vp^qM#&gT zvanhgfTXj9Q8N?YfE|)6I=Sglr@%D_PvJ9UBt|CYpWm9smrAvh@)^lowpc{36X{VP z6)75w8xw2|4#;bAMO;*+$cT@RA+G_ zE6pSLBGgJcIo%=fDCIErk4hzML^q3b22SBi3hA>&Y!t~D!iR8^6zCZ&ujHP@dYI3H z_y`o@tff@D0SuoeFPWW4;*inW4#d?;q;r^-lFE!>;54CT#V8G)@}?%vsA^FfJ+g8j zx}~>>44yJZ(&?0B_N$d3a>tmS_$gVBTzbTpjq^tnKqr^m$4}xz=nzgi@;oT3Fb#;3 zCAvUzK`c?TbN<{oh?0g>bUX&i#-%~5cr0rDWOI`~jdXP2F>@F(ob=;X6f~nTw&P5jyD;gc(XQ8+v{7)W4{t$0@-af4jUJVVhMu#!x- zp2c5`F-xRv#43*92V4X54pg1+RKd;@)oQL56)`n?%nIJUCm0AOm=v04qVry&h2}wR z(Z6o_*B)-lX1J6QEYnQq4`!^&t(}d(&4$K;2eYA2#`^P&b%Ro7(wFu>gfywPSmu{L za8vmyMS z|C2xJul{j=L+S&&&vak9Hw#WE+COOJdXvOuM*-#Z1de3WxfED}n4DBF0RyM#q}bp) zz<4lyFc7h5nJfTcaQLZSdJqmCjD=GKhsPW?HecivP$Df$1h}!3w+U60Xi>9;;?yMV z&UnNp4FJgM=_#cjp2E(;d9@~w8GEBt1YD$nYKAgyDY_&J&W16Xu$I^;z!l76ma^w5 zfx~3yv$<(-n8&c{cQKLlbU4AkU7@X}ggv~NTI5Gw{{8zn{(u9|?AV@&Qc!hmb+Gpb=Oj;&Vt7$|N0g%_D4gqiPQquVHq?4Wi@-sdiT&0j? zS2WK4t_UVgCL(5)a##>dK-4-b94;~5b(0c|;A8iu_;BoOz5|nyl!Jm@lO7R9 zgm|A|tK{!&P#vz40w?3E6Znqq=V)E!a$V);G_Sw;&T7Ku9+UN5epcQEVpsQ#_eds~Z7MY>*35q&^okM13YGfx1lEqoCA5Q%&VSYes>@L0D#|@>Udd38XTho~y8)U6St)2$lf)ar&f+PWbihsuo%Ve_fVk&~y~Y~V;Yd$8Zlj=AHAKzgV8z_jSP zz?SMAU`BK%hNhDM7OEV$UuU`_z*oC?WMsn0GvM#@rdmm%-aODCQHXJ<>F_F~5||4H z19$nL2=9|cIWnB~p!LIDq4r=PQ{IRLGa>w+|C2xJul{j=HQ1)Tc1pu*OrsxMM?w0~ zsB|u^|0xA{-AxBL(GV~-p0@u1ad`3mE<>C~d)xp$jfxEz)UenCMh%NSsMM&~15b@g zJvh~%^nU=XzOxhANg=ltyg(Nf7P4M|g3#uqz@E3)G z5WCK_I&G@lL9(U>s&rOoI-E{j1xdFGQ^u_%x4QW`MFuC@GFj&kzkcRmb*9TXs2d{b zHgpa_#C2$W8>B7KY>*#KGB>7Dpv%%ZYBS0GxKxNu_DSK>SY|iL?a6!_GM*A;ilkAzzzBdPplIiq=U*Ef&E; zDQb~u^+{(uT|mvaMLREMHmC?v-s0akB`exDg2@8VtM%=++sSk z8;7Cn9PDhVUOFnRRqs7Dz4zDl4$-^Q{f50mF7F(o-g~O{W1H_=;NInv7kHG_tor3? zQ0cQrx!z;yQMDSLY28fRX%9Wz!%VBci)_B&wDKep6VZLJnhmMvozE8pS$`t`^Vy)T z#hmuRsw~KJJj6T?8=9ogNpAgL?i$cZIBsZaf)JuFI)`8Tl5_YU;`dd0E&hovM?DY+ zj(@=$fP9iv8Q42c8^7~A{7I@lmj>$!e_DnkGpvVtYglq;I@Fg`_U~-`-_n05cd+Vo zEVYN)ov>rw{N&ZZr`p>(q`pkZ#`jd~BeFpR)~lW_9j`h^7H@uG%sKMfM!$39{CaPr zwwF#+&qmLlc=ybajl)#+Q>ghd=g9bLpLC8~&pAiV9v8`lwB_L)aKeDaVW`RuV5DR6 z+2aSL1_>XA05%mA9)j+aK$w85AwXT0Hk^bwZ^DLP7jkh_kQ5}rRMk2OI)$?!{|9)L zJU|YqHVC-x^*9J2y2^)4A3B87rEI$D-kOW))Vr#DHeQ6Rt!>hmBRe06h2zDjo}-0k_4UHO$=Ws-9V_QvcT%8 z6!aI8ib9a1+D6fWSs;8R3^cT44Y~z`E?Y-;;AMo+(U8^ zjHJHn2qfrU*AYmfy{?IQ_IDk@l1bP7CT6st327*G8-(&9Tw0r5T}#f-uIA^~Ru?W^ z30rZ@Q+Q-$d2M)jj#1}t<^j< z{69+sY_4hRo&yI+)4o0576kAmGS=x}NOvu}L}?claYAwYkBkXsEQFrVhn~xYo?ZWy zKu-izoR-meWPYT-hHEDsCv9eTYQPnFG9&0P^=?Eyww~3a1Ssl0~21YKs6+7EzpY0e2xAct{0_{zE^V^3D-~O|2YzMaPDSSIW z&l`I?K)l>HoYofuPHUT@Al`Gf^J$X&_E86&)B*4CJL)1^R-L@JdbW#t3H&AX()H$g z(S7h2yznc$`e!>{hzLz}#&_J2qL820Gh^%k#&MU z3zmCzShdcsK zKwCIfNRr+bTU~b2unk)T9Q5ftfC+;dFjkSi*zVgOJhPImHr&b}n+QA%HwCdVgR+`W z50&f$(aZqKCBT46D05$HM|)E!vwb+L_GR|l8NDyFv@geA42*$x1hTIC#6ht^Iga7( zGE99yqvmm;lWCqN9M4nMWS(s4U;>fM&@V<0T@uz1#+0ml1dYSLfPiEdsLmy7vdG?_ zhw06pE2^_fh%J>a(L$hOU^bluxuuNu1}wHDAmBoSfaCzCr3$;ntSKn5sR$(yX1Hn| zyxK*b{T^6;^K$NER_I$@P>u};hXJo?alYMVFYSO|`c-Iqk|_~tKlbVQneOVkZDd{8 zI+(CC*)devOC0TE8wVDs&O4avd7kS3Q(uJ(TO)KQE|mWnw|We(5B?3m z33y+<6NrC){k>vS*u@+5-Ot-x7JS7&NXZTPv)if*k5&r|Er03#G!O6OJ_BhHYr69+HVq3lIZB8fN z#Z6xbcy0do1G%mJyQ5U~anTe1d0 z?hBH&29@a~VF&V1fGN@-7Kp}VWW_NoMN6toyE#Sq5h$Zy5(0nHtOkFRE-RQ4G z7(R}r0MTp3KpWF<6r?KsM!-MvFW5``9@~FMJ6@5(G+4%Au$FT%Ah=UTnvB9|d^8w5 zh+P!Rgju=W7v93q zV2MGv&TNl1sySNUdU~t3LG!J5G{~G*$mM+b>2dHpj9ngiI#DA&zQ8bYPa%JE^GL3c z886fUViBknmR@>n{ZDg%R#9v!mWq+EMGg^m6H|iV%$3XoN{_mO6M?^h&h(CX1Z1De z_0E%548T#}29)P*nqX(vHvx-UmxJ*#;^}|Fb@o@f4O3oKGIk1;e zwQ=fd%4#!ckCQ19?`41=%{gnPSp6OY4HwzH5EHyx!#bkVFoIUc0V`1;t2MlyJTX9b z3K@y>$mAr6JI^Xok7SAVS;?mbho*#yM`dO-jVF=88LttmDu`BKHYx^3L_ZeoNr>&p z-R1`&2ZR6RogfG6%^Mi+wkMhxv#xiQgO7y9gWbQI-P)U(?>_&r%+Y5cIQi~aM|*fL zoI|8mnFKKV+WYTu+H$<%nP6D|amt3nf+7OiTb=G8h$UF9AIifntJyhpu%m5EeOOr9<%w3f`AQ1Fpk32z+dxA z$+zTx3(g#^iq>c6D@=53oK@9-%XW^2f;(TOze_tC32l4SJ&c@C@O!^K%z&gTB##^K zbdEX}f6`{Bb9ClN)d_DMaE@TCVUTLh;n2+CtG6yYM~=>ftLy(KeQ&4JQ>MP3ewgQ` z5^9gW%{k#5zquK8dW4W_4LK(u-EWn}Ueqci>J&gsJ! zA9mtRTW@s+JG#ZaW=KuPr^g_>dPv|4#`e(6>8dld)#02*XG1fCRVN;riLd_~=k(E; zq3ZfgcXIx90YHZ=g4y&w4yH1n&JU+yAPW&S6Ejg@43!s!n3wBCKs_`ja6rCj6S--a z)}xC8toP|C)S9ith`Te;a^61IcQ%_#u^}CstwjMoV3do)h`)rSak41~fY58l@W3$2 zBQWU4_3Dg(^iweEHsnQ`=c@)HyIW;Ua$0~|dt#V@4niPY{j^5DHybH7XuI$f2q zTk$a7%;LTJ_qtL)EgaOp=ye!x52*?&48+uJ$?H4 zRN*YyfI7u z6xp>51!Cd^dDe-*T>%j&&hr_Y=Uw_R*ujtTF)VU!_2FQp%qjKkD}#LDHid6cT3cM? z0f?4PhE!rO^X{#tNiH(S$-~$sV_yLO%(5c)!(SnQYa?v5uTB`fS7jQ^QAiF^3pkrv zSA(OW6gZIj=uAj=R3<3H{J2s-5oxHhp_0?giP!^^YD2finN!tpc-Ut&N+dCBlgPS4 z)r$a~OJ)Rm0G&zHJ=ct25bmo<*`cx_e${n}ppm-3_0R<+(^ zMim%8Nzes9z@gXd|N%2xur$9>Bl!ayhy3ZVc5Pv0 zIR%$tDu`hGUIA4uu3T9wU0PkZyk@0V7d|kzY9&`Le|VJ)C#;?%2$xesL%oqxV9?IM zj$+Q5U4|p{+Wg$=m2eA8xM5^XqnTV-tH=vLVTAENxJJ+q1l{xlYfr8=yz3ny4@E*?OJpRMbr+Q>h@BsI)ZZjb^<{T7w zD*b)^-uCj+&gR?7i#wmLj#c)rAE<BL^{`ceMNulL5l za}?Uz&tEFW4v*?)HSKx0O0Om#r7FhS9{W^b@#ZftJ%6@4*2ebf~Pdcd2 z8RuDraIQn8GL`ZxLOJDw{EeN_`VzSFHml;9*3K?9u9>zkKtb5bt+oyTcHZu)Zh6Z72|#o5EK zTN)F7mtQ|>ztSN@j9EgOBFWAh4C`pm;ScBwYRyv!711IH{*wbwg+_KL>ZV*No zMxy~>0%;GhN79P{;9T}%gPIT^jPgnVz|h+iOCn;_6=8@^77%26G60ZTSKg1FRe2nE zRpBbOA`zqpJf|~(c@(CD2vMc*$&!izRjZ1m@>iMo4&@&dL+kX!1UbmT2p#W4Faalt z2QuP0EnIl7t4AVl1F?;alCK~eLq;J;G8O>ljsV{X=t$s1%xC@#d(4ou zqY<7FIy8a-irplst3(I_|4GmAgLrI;IHE}zAZGFdR)}K=(o2)mKvyJOgH^|nPlSoh zbCN`B{w+ng0xpScyrkt)LnPoezY_jH1(8|x$=(9tVwc9PAz)vl9yHe@>4`pLGh$^G z27;fknTD;5ejB+9dreOI{g@d`p2VbQAn*mvL>m&bM7Eyhvya!3HaJ$Q4n&zaN!~cQ zd{D^`A-)88R#ys=sV`@Cp9iw`FqpHI99W;Zf{sn??q%w z<-Ujv_SKGz5L-VfoKEM;t8^nBi93=1~Jt&HBp!gR!^vnr_Ea3bGo1P*;Q>TzGQ!iMcBae}C@r z*-L9;ZA4Y3mY0@SKDca>!g5W$(jwoXKrRl&)5t4j$ z7Ey~kU zqBwdXIeMRypNoNy>O|RI0D&s&y%!Y&Qefjel46YF3XHrDX0ae;@D>ORiS%=i5{M06 zi%GyH4fIF?!G^_9JaA}>BG!PEYVLI5*(chk)_VL9YS_c%*bs9uCY>uL4f#ZoVA1?Q zi$q{v-+cd&~3Z)E#2L4=;3%#Gdd431~BlCALw4iUN4?c%|#0$em zmo}35A}Xf>gTw%a^;V5dUWqm}!CK9yQ~RR+ba%ntiy6t{P63X7!+TPy0SRN0Kb5yAA?q_B7xs{oZ zb!SHF+&F_ofU^ug3v}iluThU<_q8euf6Q(KTS0>+OrRbg#IIuQDViHB~U75u#KP<{@WKgK(yRX~v{sVZGfBftfplsA`f>0Ea(OaG)SaIuq%S zl#;O4PiAViU!OoH!GcPo2FR0#=sBCuK_G;cm4_l8pi;~@6MzHY2iarEA>%E65E@Sr zngoPYI5t{5R!sx(y{{cBSIO{!<7wp-|LF>eFrfX*xn>HSB5_3JEq-$AM z&_RlGr9DKUi@c4}M`09vY!mt95!)02s59!-vrRrKzZTIMEqz763r3L#i$Tbm;Ej*l;m>*F3=nG#8-qKh!ei7!YHj5D}f^G8DfZ{!d|C^TQibQ_HVdraxEvR3QvtNBh z-1vs-<^g$PFv@VUs_Q4_@m&B`#&;PsJQ%XZ1^)d22y+%@v{UqL4VZ5LKPLGxeYKO~ zXY+XK%z47L2w$0B`5-YiaI%0V;EC0_D`0}=tShr0m}7oNXZUAR7DpyCXZ1uNg?E=8 zU@eEW4%y|H^*Kb^;Dv50Gnous+HY6w^4CLci#xx{IUoOe=w~abos9{b49U%skG;^e z^y+ng)^_08@l2(eyS#C}I=*z{k+Ii4c{T7Ka%3?5OoFU;xp4h2628}bY&+n8exb=$ z{j_&Bt5t20Et+^1mY?I5<{ZSSvBb{Cdlv2X;k&ZGzi&J6$kzjVpUwV$=<7|^BIu(> ztC^)6=W?%YK9>LVcm^Z*_;}`P*AipyDE{1D-1$wrd{@)P0hxf$R}+jy|Q9sp`ppFzUz|AY2W3`mU`?-;};$qdxmIQO8bu@E@#qzylxCPd40J!O&s z_XUU;$VmWpJcPCetp^@p;Z?7S`bJ<*XGsuTh#t609DZM8upqvQ*wXr0^@UTaa|m|z z7N%H@4+)0A3k*O6i_||22%9+yvH+SedlKV@J_*=3>p&w#R@~_`@FoUwWlj@SeP^tTc=V8YCe4-+T7>UY5yqp5*d|HfztHnTyD`D|lB(a!X zdKLfA{c(HKJur6dB$vvsk1si0?M<*taSqpc<2-*Z;^l(E+2GN|O^NcybLrg>Q&;5PmU5hv^wnF2hT&&V(0lZv2zV-#Q0h+Z=ea zGY0x8Q5jY%Qi(|dW_x(=Zzd`ux?p7e5LPf;w}N4B1sw{@iot*st2Ez0zgKUS$DHo3 zfs*5iSZr_ZcKV&Zo15V=C;BzV+Sz!U6UQ9HVdsOd?yovg{6wqkf8xZ=kN?v*`grJT z{%PfJegvN%{UJUd(___5k9FJW8CKKtgD;(9RW^2h1AjMnzJk9`LkVT9W?Vi8>k*>$ zc*7AM!eWpC8h&Vp;RhQ`HNN`&6K`^B9Ti_|2Xii0%} zl%X_iaeR#`BD}_Y;hAeiVcj7Kw^vd)Ni7Oyr&7SK zl7c3W>%&rpej%lWpOr>c5Nl&m1oJ^9pvS^uWRj}DkudP7J%LbQ4usFrEIekFthOJ5-Ld)3_}KQ5&t#cYtd4E>e>ST$ z?T|iDSVLld=i6oKg$1k#~LK{M+X*%lnqk8ZV}$%-ahLL+_! z$At`oToGL#mI@<=t-8DG-SuXRL|#)Yf-Ex3cP>D{bdJP>tiZ)aFgo+7`j#GSX0=98 z*^2yL3qotB96i=*l(mooPMu`n4rZ9lS%$3qFn(Y>NkR*-lK3CFqm!Xa5$rAGOiB8I z?v?Zjv^I`P`FT3T7SNhNlfesq7OYN4VAOVh`!BaBB0BuZ%K48jJ~My*kqeJLHq$!O zHq!wxWN$TRLGy3zx9@6tdY@3c^E>Bto1M*X3!_y{ES60cYP;*YsuO*d*~YRfl49ZH zbBpC1$*Ay$0-bkvKR>qda31olgVlV9GD+A4X*{Iwn#c!nL^->-==!pKWy2`@{`5;wvySbOTfiO%6mObdvEN!7ugw>GJeV7kP<~zGos?Zr# zDW?@4T2kz^Ats7ScED&sB|AIsRmri=uu3g-_E*&mUVZ&@B&)?XL|9x_c=PUqI)O53 zVlExNWXECK8C zz!KHw5kFCvM|@IEe+0wp@*vZ#%L96<%_D2zy1WMOVE6l)_Y#9ulLf^{ZPpveIVg~M zFRTKG{2sI3GHS?Rjgw_Q!CV%!@(P+~Iq+{oB&@+PZrA7H2s=?fZAg5l;V>&y`G%F< zc#Ft9vV17{#IENgYdvKOM-rKBEAv9~Wg(5S8~00L#o~t2oRi{D`P06(d|vLDr^-N% zM7%P)GcznU;%@okEqjn0;z6+x2Xgh+Lzja9sn4X?F46{QI{h#Jsm9hM>Ly$c8z2SF zflPVoA%?73Ths$0L9h!f3RL28ETpx%QmI%UTqv*2lT-#;W;722bnBv7Us*r5C0(@G zRFa7*^%h1P8dAnWpx6n&?BEb7Y0>9=v`!l$|Lm7JEwt#Dr9D_OHSjV)X376fGW!%ntq*1C- z!Tz=Y{v|SUUxmDOq4TIt#3ixay>T|7k`nW+J=iQjRA-CUdHImFnBYBb?9N1%x3sFy z1WH2OP1+<6JCO)OKNOC_V8Ca@6$L4028)jp%_=5R47SNsqka!Yp@e9V3j>&mbWUkn zBCunruS0<#{6mTmX+tJa3($)_q-`Kikm>>()l>pA>0>R%r$I9;VpxLb{x1e)eUPNtm3@irzzc7Gg@o{l?NDNS z&#Rd~eN{r5a99)awgfw%1apQ|w}3tck{v^5zp@tu-=clB40?rrhS1*RDl@|Nv z7ZP@*{|4u_@rkr=ZakuiLm_*H&byiIV)Gv^hW9`*HnLt(r%f_P|52l z5;HfAmxE&x_TXT3JOujIc*3LqnKHZ_l1o1)J*s{~sxb`6efiBgzuBL^N9Su|SM{?` z=WB9T<+td3O%bd7dv(61iBI zxRQWeL=qrZC4s%e338;61Z>VEfxRaQ+Gx}d5rUim^x|JYE7z{p2hcqd4$u%Z22tS+ z%w=M*t21DMQ063M@B;!E64uj}F+i@`deH`^kE~s&>5nvwb!{7rFA9BXT|Gi@wf!|v zR7D$DbHewet}P?9n*JgbE44PS!HFhHt+rkRG8}r;+FG}#%nf*;^#4pskr9Av4*okP{Rc*GuX&v$@!(pd@$`0k6sKQrk^_j_uc=onK?#7^BEK z@;S;Ehw}hLTE3$!6xbJrr9o_`fC}UuPq2^e$_b!xr=UzoqC=kn`T)4XyMCZ)Z3Sr6rj@zK--nQ`IzIoQ%_AAMN$aJQ^8 z&qCti8d|8E@6duwn@fm?!EN04lc%zqt6uKn0ybT&8LxVis){9)a-J*bJ?DWT?;AZ7 zYy0xj#Y5GkAiRFy-O)n|EOh`22ea?TiU-J#Wa*W5dyk;W7n+|{iKge~pHKaoY7n}( zubS2m%@D)v$Sc{=)>qgtit+Lz zWoGHNN4vgQ9_`{R&iGyEC^rrb=!xQHoxA={G$i7+FP*t}Byl4L5) zV_|y%I?=`jK{0Z&a|ygYk4goD<>T&Z^oO-()}E1V6jJ@g6yi|M9T?h=#MS`t2`DUQR$>F%+s(ZF zM5AKQclMBYp>8iJlWeSE9kxRrnS+L{JpRLSV#G2kPb#dSF_|C2Ns)j~0mf-17)ukR zGfl63B;kWit}=VO3&wsjaPZc{ziu$8RY~*d;&Y?EZ%_m|o49gBK6tR^oGDx7?eH(u z_okXWDt~%A6S*9M*Lz!7`a|8BG_`6WJty6=^N~^N&n|ST(+g3TR36 z8@?$G91RHx31ay>Fop)R^g*99^i)B@L#9)R-2le~T=X0KOI)57vbO_d4kiFa#mA!v zj!^hDf!*yc2kmXSuX%H%96ZCs%H~4~P~-(Fs2?sfKnh5-K%i=0%Lm7{6Wz~@Wjhnq zyy{}(g1z{MC>5Be`*D>#&9A^ym%GXX0;$n?nL0yPGQiQ*;63(IUC-Xo@(sFs)9(m; z)t!{#d|6G(Dg7}rZvN}NSB9vjpp7deHLiiYtUxZWW^u{ zIipw#eEn5X7}vx(B*1vZjoj`)af5djK92cno4&BIOak=5I%2PaJqH zY>mLp4pNSAuYGBG4Qckidk_h5{89?4I&2|_G=*VnZu!y*obwPE963OVx*<`=QVlZ} zMs-4eq|)er)OvDuiCb7#=GM67e%MA507otEl+r}XhpopKmdjMddIUK@`MP_OvQw`V zx@)&yVVNkMlD#=ATJ{4`)b<(yx~86h>$Q4i(;MI`#E6BFxiY@cx0rKr5{r{x!`U z@@U6s=V;gH!O`xe{r3^h5!RvZ0$)#1a5^mE?#7N@KYLc0d zgob>tARf^o8@h~vGg!i7@)1N!OpH>bHi?YlU5bn>zE;x}tGHp1jZu zsfjB~A?w>(S&D1!L*$7X4p97m#>U$Rm$NhzB#P|sZ~tV=XzRv-%xJ5!0P5oX`A;(X zkA0<9u>E*|mF(C7c1T4-s-Zj&wu)#Xa09l_T(y#!7u5nk zeN)IEsri0t@Ac=U_P0_=6@i?21&Q;D6BlL3YT|&Ujd5ulmUe(XB0G%1me5~K#1&$_ z7$dnzL%be?fTD2;2^~C<4pXaRs@KO5+(3=dAYli!iy_yc_!SLb4pO8}-~&8S zmk0XBF9ITBNXP<>@abXz<0b0lN-h(JKtW4yG*3k~fLcIAM1uJ0662$4QaC%E1nZ%a zqd*u>uc)1q|60Yv&8#1BFPi+T3J->4n3#3V&~V z;qPsDp1_ZVPi##9XkhpT{QYhmqik&&9At1N9}6SYGo$Xe0CQoJGXCOk6O+*-1gIkp zBdCH?%1w<@OaYHx#RDuErE8>rka(kkf4C1g==}tz-dUc9($W`PTm{YwR6E-5S8#hf za9sfScxQ7Oa;y=A)~(oLuaA2noL0!sEe3%j0zg~7!%CcImtdi~^wAuQ0}+PzH^&Qn z=|zKm{&-mK6>d!e>5^Q1BK^9k6rY6^I+pb7LnQZx-CgLEVB`bl&| zgefi}!G201@GG{Cxi-M;SPHUl${|(*V4TAFwbBQQ##hQfO2NxAJTXCuTa zTykhp*p3Ky8L;C$#MTH0Gesrn9$uH}iD{(q4V*rQv`5YUv>aqyi8%4q-QPSC3O+LeTIAaL&#+=WF`gAX$sHenuKYU&1tD)sh;fr( zatZTl>QPeZmppvxr9?vlr@CS8g-A;53=^^5PQpW~}^@vy~-oxU`0uUM)Q!*oZ6nh<&%ClF1tH?}C5CJg5BiUuxVtEJiv{hJH z?v-znW464qW?gye^5vD)wYhTNqYtz^GIfP;s8Q!pyoW;Hhl$H2zj+?v6RWcyMha9* z9hM>lSO4abr+5I%vz>z=j!I9s4V>ps-+E_HfNcs+;ND5FS#ZcrQ{qRtP zp_TzRm}~LD4Kk512=XXSQ{$rabwOTi5VCFt^jHwQOBmYZ+`0uv%CV}Kt%=s}86{4Yu}A^N4Try4xm5wsu$Y7MlI zu9$3e&#ZUKeh7d;1nLh0FwB?VG0fa-@DL$$=qU)2#W_OO^}T!7!rv*a>Ezt8dC=lL)B*l<}}H8G|_ihNc?G3yed)@K4D zv`}7@(leb5w+ia1%Yb4`Q6q|p6mh|KDIiIkF9W`m9poL>=2*_*o0~t8z~w*(|B`FN zL$X^^@E&CAIXElN`N_g9=K=n8PE^jGMX3XY7^F$XAu566P*rM3Q3W?TsFQ{*nN ziYFZtMkNw1lE4lS#czOP3d7kL=*B_+>{0@5neXm_+W`N<)`EUx@P*-D@>if|yo-Nt zBP5ZYq7VyEO$PM1$vU5gZZfIP%I*RXiapSHh?b3^G z%x{2kMK9_oqo5ZDpig0NABXft5)fE$g6vZS6Tp(Fgxh&xazO_A3N~pX5=wQh1q31` zV7+cfRSrPMVqgclQYown$~c>JUwUfw0}xq2mcfo0^ec2FUAq+Hu!1BvAX&!{KgU>| z02u^n5%9kl2`Z=}-NwVeY*&*9j)9}$3dtj) z8cQ{(0wR{BIJYBoA@8WeTuK=)PA!aRXfU9I6=jNDT1%PY8!>ktn$yVPwDm(Hnsg54 zHn_m#2cS%M<9>~BLV);j-1If(Ot@?>qW)%K+2cOn0UP|T9|0TurzVyN{6QU-_`Amj ziy@&f!(vWYOU$x&kB^uo=SBm1(#4aF0ZWA7g^GEf0>XfUqB&2?mdEfGdh1 zqlwwMN@d~l6+{F2@68Syr}c-RaDPyi*!T7y8uAdKX@VW7J3wRlji*7cx|Ai9bS#dm z*Uf2#T-=(5n?3Y$=jbPDO+(uU+VdR!cv7{%e}TsMZkO;32GX!VzE^X*7h70r_OH{B znx&b}g4FDH?Bvaju0%3r4~tTBKbKq$d~vk(uBOe{Xj{`}U&54Iner^-@G7m@+#A%T zUbpr#sl@vslu<&;+@B za|}pBMXEJl$1C59Ekz6wR{BHIDkZ#v_n)Cxh3CYkXF? z#=8>vu{S)I38mTIxeX&I@_0KKkQUa2hHM}+-MCkcXf230ZGPzlU}WM2{>9~2aW zUykCb0Ae*yrRoE`a4j5J#Zxt~Kh|bPcq3l{VNfX)Bp=L!qDx{7#ta2;l;M^rhKVO4 z*%p3T*GfzhVzY1t8Ix&NM+9;tqbH`rV~iTGK#=572e;#rAnB)GZpS1+N>6N^U%p4g z7`0=OA#q7;A7^k$V47;R%mmb3Cdq(bKP;P6DvEVa-kuoE8W53)i)n1VthyxCpfMf* z)OI~pMep2VZ>YF(N)v4(s)=|X_cU-}0cusoW?0nQu-OEzOGUq*m-Dr$)< zzZ0Igu~>mM;30S9UL1_BXY7p&*`OU{Y0<`m*-#J;dh!s?0tAwio;)7FBR{K*%_GVc zS11zO4fevpS~A>-98L)dUw{snXa)p$9-YkacVKTA$J_G=g+mYd3qTsdZUeZ$8Bf@< z_`yM;dqrz!4FZVTEbOYIqtRg|c);^%n9nJ(0{rL21!0)Vz{#H;Wa z-^7JpOSlod>Z@Vn+9|<5LN$txqRrlTUC?Y8Z&E?XgcCHV*(ApIm`rx!XS(p%r z9T?Iya8Csk&|9qm^wGv^1bz5ax`$AvhxGB@>|hC4L(j(W@Zm|HrE(S?V;`!tpU4-h zS%XH0ef+>1*~bU|;4aw5>v{BysnTnts3O!?KALyKwvk>%xo4YEHaUJ1y9gN*n27+cnvLBsj$d zpU#kB{m*2U@VC0;I$R$`(85bN0oc=QHcifQ4UPgC$FPwEP%E8!Iw>RRbV|;N4@~sI z=m8}i#f$*YQNpm?CZ$$g z6UZCt@)`g(jvwY7cjgRmY-`>?kveKBVZv%E-O14=qtRNZUJoYEHHPuW$+pPdfo^2y zJ@!VYhIC|LEE@u680e{fO)eqhF9gW>wd~IcH3Gn1Ahl~>i@9G8^skI&>wf@L3 zQW3^5FnyWy@%a9OZ$QtV^I380=u7I9bum;`4^e)YFRRBr>UW>|)r`Cj!*)XD_o?5o z`t4`;af*~i|5WDb?&;3cgo?YlgO3iMCKA|>?^w2f6 z$Q->U3#Y9vtG@dNp<^0E7Pym5R>TcPwTlS(3dQoP6V@2Z`2r-i9+&0@>Nq{EyoIu% z&eK(d-jI184|b}s90GNd-JJk|XAP$tO4Zu%$RQo_4sRr`Ynj3k@ zR3XgW%wVV5DsE0FcpkSrDhiD(Lu+TgVR#={aMsl$rB=;CMxfEC&1(>K0-~4NTChK= z&1w+7p;6$U`t5WlTfhsQr)=?eJ;Y>e>8(2AcQXM5Hwzs`N*`8zNCRBqg?%q;z7uL7 zLw=282MtRNSZ@^SqyFeLLP0u=c8#wF@aP2D_W!8yz&-;H?E7zs2RJIF56VLA|HDSW zM5lGze7%(YUYbh_HGjJ-j#=tw-C&}biFWs@BkiQVvqP^FFlK&+`$7RdEQo3>`Rt;ufb@EnM8;9FgLCsrZ0;a*lT1i()RZHR(0nsmOHT zfQ2@)2LeOf=u}xm8f!ag&zZE%Rq5iY9T%eZ0qu{E9>&G8*B5(pQtXcK@f*% zgD4Ih_tN_!(R?+CR7UpEweO&p+#uGkee& zhn8fK_2&#KS`4j$6t%Z8oDNOf8(ntxd%q10m~5?P(a{j+2I|x&B4SkhOj zVx-@kdHE8!y}Q~IO|?oin3-D}Keo8@Ybo6P^F`*{Kf`*b_0AOerhX+wuBl25c5xr- zB*f^2XJh^G6gT-&%J41y-AdatDG{lxkBB%gk=l5V%;O6xQpO8S*RPG2aYbBpY+5;$ z{%&fqoLMYq>zzvLNgUDR8_KrK#)7H&)A4kx%6CP*-0&0?*&~0d@)Q-z&i519#M!kv zI5wDEe}}xLwon;Ldd@CnU~TMj_T2Lhw?E?7ZuXN=P|KjJg>EFU(?wC^%H)ox;4q%qRl%b~6 za0;=)nKY|`RxbErNB(}+!Fo0YXK^p3x@(KTml+q4^tKH50NCm+(K#3ojim4F#1!Ac z{I3vsM_U>|u}}xq;Pv zWSE!~z=%Oi3i6Fj3Je&-Vptl)K;9YPz$}68%mtaTItxlU z=E@}>hq!Skrp)CQEb~ga)(VGd(a1DDE!>Xma6fWY+;h z=jTqMH=j`aHy)8|91#atW^hTy+X8X@Ci{Ls8^Z!AKuMQY2xNvcuq41;O9JpngI;0; z73hUMw`$8*Hc3!NifXHK1q%@DmC!rN4Ii^-fZ8~SeFUpfKKd~ZbK`g5C(Cn!nf0Fg zF@~qL02hYaKz+(v9*aSslsxFgxPdTGJ;a5Xeb{v3Cy%tS<=SwtSt{T#8)uLW2ZYN2 z#4w_u-b_1ka&YdqpjROOdF<9&dkKcXwc2)O+gWbn#fLOSC#Q)dSD{Mw+1qiJR;T+Zs12s-= zLn$;wU<}>;jC$Z?eFV4=>*KzFIB;@(=4O}Tz-?Gc4#QFs!4ie{^xGA=x^z+sk*NVr zk1{o=W4C0?DsYg;K=`asiQ)^&tK~147ylXbE}-z8HFbll7ca*+hkm86nkfvAV{S}L z6%i$0MO-JTI?tHa5Yym_C1OY+Ap0?h3lShcK=vQohwVT6#&%$<#mlWjoRC0lz~^Phz-ZArWk~ao^Wnf>kLBA%s=w1 zUH*3F>%)6@eyy6Zzb%SY3hwYJ1oiv5%=U2=wc&i`>wy4J$6M`k<#oEo@VDd^XZwFa z`j@j~Hy+7s?|bbRW!kHm?azVB%n+IL7XQf9v$7VQEtyuPJzgqbR_G_D|MCF1M z;Pz6RZr#Jhl1+ah@&4&XQ_8FCH8Z@Y%y?(WZnG;rJO9$I9NYO7yK-UY7rhSc^*>J7 z>#x|11^Fcx5box$8;>>@+}fYWDf^oBuPD#5jRRH6WcERbihrz1evu2f*Q>Waq^sj< zK2)cBp7@d`wmZ3cYg!j~*7SDu)_ZjkR-TcqtJcVrx0|V>=cva@D31%#JDacG+RtOz z*-%n0w>s65(Y*ehT#&oE`ud;QmHj(k#hSJ3Y;@@tXb$<2tFQlF<=&l*x9C+9#y^Do ze}N`*$nq2%e&F3Yi@^B{`JH-PCd`e)z?>-|N8wq8|B9HD@~u*AIV=)P@)F) zyN49WYBMMuzmE(msPAiO{D#Uc`?Y_Wu%*)X|AKZdu8_FRE_8Pa?V#VF9rRV&L0`K1 z{SPGUtKa|Ukd;9`#CJQKgiuH&fUpfA{7JtQsE-UACn>Iob&}*^V&2H`>Lfss?=qB= zB$lnSvK%CnD&qx%N?SwFh5H$VU53%j1EPbltMt8K5D3j2!5}cb3HAs4S4Gi%9|O3L zz-%($w+rDaz%?M*6ezX^0JO~(ak6eP?W*FyzQ%Z!F=?FK?2ON(P(Ma3@2lcu$Y)lB z+P!f_zg)4eR7@wccFqHkF%W}>z^+dMgd+O&1UbDmC<0K8fhaTE)OAWGxwo%C;zVN` zP~1RVo}7Ub1}F}-t2iDMM#?;(TqXjxQWBs}B!O58k|5!xF(VX*!F+>XPwlr_LKxdY z$W?0;z=NQ)YP0a#^LBA0g-|TR_GAf~A*_Qp@hoN?XrL30Ly$5uRYN=Zgh|F}1p-a@IDCiFOk zpfLtX-#)>y`)?qdzEjfECI8i3~0+4)Ef!zHA_Me0;CeCePbGUtr}@^ zL7s5zcc{~9mLHK)YC8ahU6<8hOK7r#X-sd4>W`zIOuE7*pUq7}kWfpwuwRjMxt{WtljB!f7~S(~ld#C+fqb<4QS5!hX72y2Lf}<<`>2ubdHQZu zfSDm%EF=6r*WY*}U{pUlBO{ndGE**14TGhi&|EMU&_Rh2)H6A0=TrgED8Csm=3iPGZxdh- z8T-Q`2Qu7pMb-ueoG{RUh7d6eftS(~y;4+yidm=XK}P78L31|?pNs%s58s7wwa*C5 zP^?HoaUyTHT=x{}mJ0zX{F&PUx(K@icZcyB-@xsxz6xs9aC^PeflIhMoVM3C-|2LH z77-dcuy{X3zh6U0i-gn49jw2K8|#m8Qjc?Z{`$4Ct#N}APClF4YWn!qz@O==m09~W z#4i1i)KTKWeY_93D^3Y75`3)b%VXE)e`+jveJpfM&w<3x80US-E!;i(-)R!A-ny^p z%em*~e<~Mz4go;?*)fs*wPbh{*wnx%4qM&;J1NEav$i0A|q@`TP$6Y3K|E0ODX4JO~hnTvUO8 zI2aTk4A2NB?m`2w1iCkK93&3(je{h9x+0H*Vsq;ZH4ciE>5YTPLp6>VY+cN8(0woh zgmzVU(Pd-$mNbrDO0yQ-)y<9UXt+nx)JOt=QWB7+>VcY{7$G!jPIWz~^`>5fT3A)O zpcdSM2DR{hH9@T!3y`6FrJtX|ycoN~Wv2jw2T4|#J&$-K*l4?>Z`gy7AKdJvOLNO> zE2~HjvX2{n*|iP7?5Rf5S7PQEl!Hcx6Bz+@1i%w*7Rg#EjEEcW4#)==!}g#RXl@Pv zOGyxjFgHtOOGS}n5v`!T&|O)U73d~9Au%uNU?H0ry0Hj?s3spzZ5$pP3S330UW1M) zV3QD6iZ&o)DiS8IKDj~>RM-m6*T5xVm`o+=Mb93@dp%6Ql$$mV!cR-YFEU1n)!D`% zOLB;Uf#*F~6Zt+MOM0M4t9_|72VBL>vIQJ=k5><0P*cyKYUslU$nGF-$bf<5nU&;MO=6UM@@INbWXH}!Sy&7lJFbsAelym`%gd* zQbVg0;HC{Wo;L=lD7LBt6he}%>af$1B&#}dtS2(d8i!65DYoE42^rPVf5a6^Wa4L+ICEc6L!mHK_?uBSPm}rNQ zYSUKpd|Pl@2Os@Z^=jZdvR&!g&TMG9eYPbR1W}U<&2$7o&Nv;RnbzR*WFq&R)2XDD zzh3@)StWk~F|v4b&v&nXfEn4HPdjaRSa4K0u3vYXZM;)gE^w24`RRSCEv^n7lGYm! zkh5bbxV4v`ufZ*HY3#mMa)@LvND>nM&wS=(b9HyTA7?Kh`pxmm>o+&w${FqV?;oG( zt}e_Rq|jWy1IxJ3xvRHA01=Q{05FII1`Cs(n7{^!K%}6jQy;?!Fj!q4WHz;V@G_{) z0(P#+!nPzFW74`*gRlkToQCoYx@H_0Dw~36Bs&Qn8PHS-R3g~Y2C+<6iO3_9^R5U6 z7)nc7z$7a93F;olc%Z@p%$q7q0P2hufD^DcU4bNz-%dhwWziV1^}VtZG$tBMW5<%r z(vd8kRNE+!#N* z=Axhkf!IXRe)wVI!$ogGg;r0`aqGu_95*$uTv;n!T3xujW?iOH&8_N4sn+AbjrqB9 zW$wd-)d0V9_C)%D(^mS7olDTGX)an)fWz$m)I)PUkt#7XB9Bhx^k-}f7T0)VWgZrn zB==+sSqxiR*HlO82c3wOUX=bn8s5`qM&H!aE~Vf^z}hBhUdv_ z9xwoeDYIdrjF4v%8nYrRWZG*bF*cN zuuB)y(C(o%R2!lX@%xo;uj~*KpyhIWvRZT<NnUtf9C46F3B|4{Kxn&^5k7y$ zuv9`}(X7+d!h)&b4OEV~)xtqiYO~RT4v-uj6Ef4JurLLC`r#>OGOZ7Zeu>vpAKss$ zLx0wHFekBbK$CeBMn)UPGrge*1U{Zl7fbY@MsKtb6AZC4G|xPLiW0>b)s=eNct@Wi zxQt4`h|;ZC+nC)NRJ73mGu%6ZQTFES0^K`K@l3ss@~Aa4a}xNjXpaIQ8UT!xO1@j- z>486vZ#;LO)CIZ&Nh^Wsdt@C zWxdC_PaSi?FjB#eVhGlvHdbb>;HhrG?o_@1@x* zb5~AlOkf-lzY@~1 zFX>MM5bphZPtBH3SaWNa`i@z%%Vq20Y^AcY)(ia_>djqRvW_AUzVXr4<0>Nj74PFU zuTB(2OAYTXoV@V6-cTmz=YSn9UnZ2g@;JQwEO$^>EO7Kh#a$69Zgphb*S z<;PQa{l(d}D^^%C!&Xb!%nuW}VB#KVIkiI=k=nS@vS&2s4BI&#Kut~7hZ0iqNYWM` zP3n=P8fhAkdSn8WKVCu|$mf~6!w5&(mroa_te#6CWpH^iKeT|90PQ^EesfPahfM%S z!^^n$U=q|c6ZUKKz}+w!oO`gma_OljA!T}yFFPgF?$)=Q)diF=Af~MWN_-V}H80=} zzZQjmVgGjQPWsd>{axY%!B~NSnz6#>yFeH4^&umS5%{_U=Iy<-U z#Qd83j2-4OOvAI6mY!H$d1|>##mSW?pQKHUZ5IaDge$U;(2NUqvZ&%}bI@ayrC}(eW;r=QT^MDodMDAp^53SWw_OAVt!59zst`+J?CH8XO3=_pbiN|l zds<{);jTXT6!V_}+@lIh>VEuXP-qO(Z^Ta1 z4>Jph`=eOMfu{1}yqz6)XrX_id}Zk)4^EXP9?UslBOb)^JjhJvgWfxEZz>pn?Earf zmBv5v5Z+LvZ!W#ptMXpL&8TG_<-C2a?`$@g>f`=M!E!Q6b%cdw*4|~0NPdQ*78lsC zfC_vzBr_y+^4>%p*aeYanc2vvC^AzeYjR?WSVU3^q63-~ED6a+SV(8AuX?HM9wx3$ zhRw)ETX~|-HfP`9Xt_vgSuNa|+Ei-E-MAKvU1_#xF1+t`r-G-e&z5y`Kv z#8U2ns0BnOBndL}AT~u%b~}e`uj`haGfJW*vm!zLJPkpMp3ouYjK4>>L>BJ=nsl{A zyd8q-xE<9LF;KN4+TgIJ3nfr-XwHHqNQp*dOOjAWN@}DJef-=&MggG(tzioUBYB)` zk)AXd3<+73Xr+<71;e8Ap#((USMWBFTvTb{Gvo?_%zf%FL0uoGU1Ks&Jf7@450Dxs zf?*VWgN75BUMw7MRV8!6S+bs-n_a#F!f9a*Od9-17KFtB`Fdsc$vI*jE`zj%NOr_jq7)=`B zq?%G(U94Vg^hs|rF^LJvJ#x{^tq1VC((ko&9v>OR{W3q5mX-IOFCl zz2zJ`1%-&{5{f?H%o2ZE7Pb%R(ZGU5iS*E$E}Y3uI0Xz2ngL@fJzr){_JFWNw*TbB?sS&;D7w!52653j4i3e3fpnag`%A`_Qx6}_9jQPWnB-Mrx znl&>G=%PFFQ90Zm8bA3?yrZ@q^xV6a4brCL32M-gjGlHYBW?HYh30U~6Uk#G#ry6} z$t`u)m)>SXE#&;SdsB8%*sWjolHIk?98ulJK;ygnOW7W5w|+U?z%GR?aDTX6zvhr? zmm3Q0-ABX$s`N|iK877|b!lzC6e4`rm4R{ku7xdRRqchBds2 z^q|Q}fQuHQ<0l~0>CcfE!!QHEg4)L7DBd=1b?k*ra77uAPEx}pER??q;0MpiW? z+T(At9*m@}jEsycBku^RnwK%Y%yzwH>cUAu=fqX7Zu~XPp!Rp{ynl4dy}jeU3uk-Z zJzfiW{(BD_9&l@cD~les7oOHj95$R+?~&QFlFhscE(I(boCD!L02dstnN8gb zIf_ecgVwQR5z8ID)}+btTT?OiYH$$EB!GY_0+Y}O9DmK9#kS5q!OmK9K~8n?P^ zHb6M8+}XDeWW`bZ^JO9HfnsnUS7`%vuDD{GY|>S8C&`3Cck$1^N8kbP!U-!G@WKFp z?i@vp(*VZw2g8oa0$IF6Y(q_4x#%;d(cZsy}=#x_{%2pMU(Yyp`87la5A z&Z=`TkDb9;<=$?ZwH(w)1vC@xI-w4pi$!Xs%4oT4-bds|IqZ?b_KM9_4tbnI9xG(A zXd7xPqrN_REJ6&azBa4A{_s zwK&FHBVs%9U^KAd5W2RK!Sm7xcaqRS6so|%Fm{CE6epy6s~L_%;ZdG^c~6N%zY_2s zI~kf#K3-im%Y_0RLx5^#!_;MPE~OB(0)_Cd!W(PEa@fC*L{u;?y~+rd`u${vj6DL% zR_oDHa2^islM@SVx=K2YR$z9kaII4O6@S|^=GO5uXjM)h^Eew#w{Rjx$$jhUQtQ3K zI7tD6q672R1slIhs3SlH3JZiN@x;X&^XVssW@6)HLuB|IesMGvJ_QXVt!Tc#1Db&4 z`xX`$oyXEcw3WM~dHU=d?8UTj!7u|wd*ti@J5g=+Fx}SM0Lot=>=h4@SGa;uxxIdQ z^xRt}Ii*Kcn>tP%d^)L##NbJU?iJjLoa3Hc zQ#MV+jtor@b9!N2{7>%Nja!*jyi1Tc@8??RM=yn*h#5l% z9D+)u*ime?nOuTJiyE>?un4!LI_nkn{Az~HT{phDkBiA-Ofoxwh>g@gY*X5GF%7!F$yn!n&gmPHG)* z(EHbZf+hBasiMKm$*}rKK0bqI@eSbKO*6l0Ryc=g7WeMES;Lc*DegwZDYBqDN_>gL zUa%sgi|0i_=jekW7k34NQ*lc@<}wKUV&xovbjbJ7Cs-4 za7{sJDX>hvSZ*>W3rZ~^hmp};TrMYCoSfxO2vzVwkPv))31}g?wDqhzoZCeSfH}UAh%|=EHG0(xtJO$7-CB0dUnNx=Y0`rzZBhwF(Ir_zO-WWK;>+p zfXDs&2lUN;D#ho7P@Wu;6_`e%3=F3-0s=)Sf?cE{!lfc2k;xe`f(}yz`hC$0MmXwy zMTlYa@pvS)FE1%VuMirDAWii`jU@W7_Q%WWU2s2A0m4kplS~?xry83(ri{d-qDUHP z0uH{G@wMn;6Gm#4cUwYP5}z#60BQ73Ennm@-+Y@C)D=`?s^)qk=&n1PKAp6iN3#E*X*H#2&rYv$ToIPuC)+?U1 zSu+a(0(1VE(6Qk}Bd3XcEak~y$1!DqvYz z&|1)eFn88st~l%P#{C!56cD7QxbI@hz&D?C1^T%=k_zF+-0Mg`HY7|LC!eM)GT^!p2=#m0w-gwif5gQ2$qgTK+*uxlpyqgvLFMyEd(v55TdY!XwMYp zTE}#_XG?R@jM{{b+M?l{!ipx;NG@`uE)x4MV*UfpZ7q4AHj$S*$pO5xEsWHWE`$w7 z4BIFYYTS6J0bOO4N;A8}Yw@fw?{r*yo0?IYVl5SRM)F~!>c}J+n9zw;mc^F~tlHr$ zF}H1d%R$SKD$z_@x}(NqwA4i*Jm?^IuLF9kI*Q{2zcOLLDq`s{cd!Gj`D|enmdJy` zAipi4)KMs^_hH&_@lt^tQj;x5OHaE{YGsOIEQU_4iG>8UtkAof(p>M{=Qf3r6`_dU z))eM?Z#sH!B8$PYWw+bX2@DBe%iUt$?pBcr<8EnQ2y9lkO)PCWTzXtnm~%*%YYKBF zHc3tL0LvAd4ij9|dL~4_p-Sq|8|~1_b?&1PGujj29q};t(gV8bo5)!1r3VzzZ>cc$ zb|K^@(JmXgz2c@rd&^IYZGxPZZH_uUcG&7&tiT0ayQ??dnw-NMae4n|`sJwAFJ&5S zDqQ$RObxso)1HiNNE}hU^zXvtQM4PaR`tb#8+tqfUAiYY=H!}rdBel!Gn{6gV&k=5 zUEX)EUp4Ru>qg$s1$A%@Yg!*ciQb!eAwkWMzwCaF+`g09ZAZ$KjKSeuQP@}M@l361 zn+TV;-5TC&93|7@V>LWwUdUnXQjgm>9~^SkYcTY%yL}ts)$N4mu9pa+>q=DAiFyhR z=QwF8(s6l4Z*|gJsFs_CHrFLwk0xBbn{<+pOK{P)=|!$3*2pC`?-=vETP5#ti1-5u z84jBchq*x2M=BTW)SAD&K56+o{sCw0(mbAoVqe4ddZ zoGRVe?rZV^m{oGC_kPg`XVVrAwl{1Wn+~gd(d7HuW(TicUfhZ^ga#+5ggW>@y8g-iP%Usr1b z1|Sz5TX1NEeu`DOzfP?H5r8-Ax( zt9lkDa?&(utW znd_Uat5aRU?PfmZ_fK?>(M<{5zm#MD)r5+q1d548=QC> znV9YFsX7~vFt>no6j4+yWtd|pZ&Im0ta6vbA-K)TwB>O)$Qt_6*-i0Vkc#KSoK8_4 zK&{fV!sBpiu$h|%xX@=@Nq%_M=ShanuWIXZxG*vJ%wfcv%;RuCwQ$McXVK#XK600X z29%F^>KR<}SaeCk3j@@WT#!f)gX4AT6Zvrp^54bwnwH1O?_KmkgHm>7(4q6FPfzCg zhCU}5C+EwCd~?3GG(LyxFbkD>D;6&pxMWkD&WYhc^t@h8s@ZI`s2avZkqe+JL4}hO-1|(f6a9vF4HXx!am2Gr51X~i z<%Gb}qIkun4V~$4V9tcX&6YNNrp7_?Fu3-yz^&VQ?a#o46yrL?`=$;hH*>M54VOE~ zW8O=7f~Y*=7DVHZ-moe-I=+99gYu_>&g;d-%Z-4@VP$oIJc$u-*8Em2F7!B=_L-ax z9ilxKT{l-e5gj9Z&6{{(f>p9H$R2VctjfBX@2(WpgXt&RNqqVP|86rm6Gr(UOpZmn zRg#v385p)o$dk6a8aEP+$>OKhTGhB#6>nf2W38BYXA4|rDePs1V@m!KWl`t`DVO&O zXvvQ!`@o$K#yGl^8a?hekkhKVUgJ)fX(8(!+;-6xyhJ0jStCi`R72zyT4{+WtCiRm zvMzOxEZ-Co-&(%8(-N|_$Gv6eHmt4`i0hM^;i(DXh8EZU;R)D2-pQD%SS+HihmmdAAk44ZI%1yZo0Vw z+e@EO)64K6h*Gm`f}}-tVW1|nW>tyw7*Rn*Y1)8xyp++rq(Htyd(^axgxuDk&qo?X zuWc43rl0lIs=~#xH9`!_UqR=#q@1sp*Vw$rqpNF&D1J1zP)>bsodq7_Mae?Upu~VJ zHwwLE0%8X{#j}NVy98{MxU`0o54k*N>aYZJyk?18Q|-^Af3-hT9_397?z;7x#vJ$& z-uyGHb@(Kd0?oBUGz<2Z8LoSKNm~k+Sa0$>Am>U)q*IJZ${1auFHbd;XBCTN!zR6k z9O&Lt!MYHjOUlB8crse!#^7Yd!fnZa4m@X*ce8p;XW_||qJF1{qM=ct9-^Z)lRj?! zEiTZ7J*MzuG@bI!^5`bv(@F=S8jOI${}LB8g-0#lf%G=e$-8S-RrcVp;22aV-qgGv z$~+^ku#S{&=zb9%fD9I<>WeNc2;&Bj(Ewa|ZGQ^+@`Zhxsd@!ke^3^yx0u=*Qi~ER znK3Tq&PP~Gumf((IbzRU#WncMJ)>7;4|CbZV*Y37Q*<9N#^J#%kc*5 zWMAi@WDK78>zZ!zu1-ijAQ1?B8h}+>=J?_Q z8N!s8tH--V7ui(M;}$#+xSFker})_uPW$(wz`uSKRNHdW%wNUgWO6{S-lQmD!J8GHBOr36yd^?l{ecD7eV{T|#K1PGM)q&bEWR=S%Es$z$t$L~#k3BxRTRG)$gDrIicN zqp=Z2af5Y^>}+sLpuX?_#t1U^t_pt-<2SfmPdd8j8pgYo+2IGM)T&#i^~Mov-<2-d zg4KaV`i{q)IBb!=qZL@8XU@0btu^mJn5<%q=S#dblLe*eA$yN4OkIb=;tGdhGA-Sf zH~1Y55_+^hgC^-sFpaRof~5Vd5XI+;1rVp5FW>N-+ym>rJFleqPq_5gqq+a>BM2O(kv(&7ygPP zh3khAi6H0a9wz*qfDV$wMN=)af!vaCJ|!!0CBGRVk@T|d+`JHiIjGI6?Re3(zXm&M zeGcr(tOHApz?hwc1cE#Tw-^A1D6B%jWEx#OG20Jz))X|Zt;D~*RIjt7WJgN&Fp(q!d?1N0=FJuX=Qw%PreFyaIbP9idfQ=H) z5g#1$uU|2UzVWMYx_-(r-+CaZW-N2X9>M|2{F9N-(J3$8ITmZ!DwcoqkMX#<7FsVQ z^l_q}6T0w!(UxvZfG-ep=mI?ZWk`{R5|NDX07b~(6aghi9PN5sk8650L|Vw|?frr~ zT=!ztE@CfkQA)cmY{htL29em}IXL!mflzfP71gUjF$^IQpzz>)Clr7XKmtI+Poa9K zs2+XiadZ9t?7@f*}p*79g5Tr>8)@ zB@37^d+Q=d>>aA3j^U#o>U8ZM5i7mn>pwcC|1rz&6??xRLEE2U{p=laZ%BHauA=6Jwg6JciXNkA#b%X3w=lpvq`WVm>Mv2=2 zEn(E6fk{$JKIcq^fY&_u6lh=rc<6!;(Gms+U>3WaY6*Dig7urV1m-&|E7LL!0r7Kl z8)Wvx682-8rX}zpbg)4tVk~Qm2$a+o5y`_5M~UgR;t`Vjps6;9XbH?m6|9$8W6Q=M zrX@6O#54p5HA75GXe?q-)L6tI2FpoasiP$fXbBtB5Dj5t8xnG937gasE7B4+rXgCw zO$!9H{ASw1J=c=gT%}=LaV>enRr))k{kYQKZk0mZY{fPpFSf!v{;KN{`WJCg>Sy8! z11B@|NaB4IYCgIStJvh%dWDv9YlM4;SZJ3|5$0yW-4gkAO3%kxVD%Qw8#vv;mEBv0 zYvM73G&#ib0io7r+`o62=l8VQZh)|lM@TGqbe<$jP44gEAK@i65GjW8DJFa0)8pcc zcwV%H`uOGj>qzF#VbveM2AT(cfyZ^Rr?`w19=A9m1Wu+qk~9wd#UDPfw^J3p4- zBRN6u<#DwiP0}=2@Ms}kU2H=dV1bhXMNAR_Z{lF$FdfE~-}IXzEg6PxY4@6ad-ltG zR4<@a9e{`!v-iD!+|zYx`M!@iumJgmj9&?p7a9>B^x<8cgpCUaYYNQMzpUU8dlRB_ zu&#t`;b~0k1MJAaO5%iCR$G3zLFhWbEp0IwN>BeQ-w(K9>sT08U8z6Okcoi8qQky`)eNPy~KhS7fHeukH59k%IxhuTaRXlXBdvg5zqg-XL#ja zNW3b9tiqmIfRKbVvQ*_QlOL)JMtRbDNT%=_`9yK0Gu3noV{0Z#S{ZE+tMY3&P(}DP z5|UUloD}*xkqD$St+9#=wEIMtyeSfiXTnoLwCa5)K@dYVN!6J(<%_dABs<2E&9kY* zgggIsz8xE^_kq2DWABOJ8p0pWx6^z1v4lJ3_D?q;UQ*8gJU{fZLHf;TFhUS$#r$`P-8E+|pjk#&EcUq;^_{Ji*VW^7~*GclQK8 zpUm&04A={N-6Rmm@?)IXe?TH1%Wbl4ler_MT}GU1o9ib2`z~30dVe5|&tsqd83XCv zviPLDLacJvG(NvGi%-lg)Ugvy(Sf`!$xAq&&nJB#)Cw`QGkpLP7Ma#Q_lKUqmc(!yBER_UxygCh`#dqiR(GF@_i&<548WJ-4z-T4Ajt^Vk zs^D{0{oC1fkX*-yKW-=E`2*Q?5XwD?P%^ui;O?m?WLi=~a-Y9qP8Rz57zw@u%+%5n zRNdr*aeJR5nC!PmN#hF1D8Q^|h5MWrK#`vrX~4{9&f0EA&(t(ONS=1QVf{N&Csq#6 zU@_;#Av$&+<_-%=&G_lBw&8$xjRoF{r{U)~`@^;h@+@KN3D+_`1dk?h7>;8>yn|Tc zq}Ji}zu-o`r5_NJ3Q-)fvc<%_!gdwIw=qx^KQdyVM0CTHn}pzW5#$Rj%NHX zW?1BU9Cy4b(s)_pq_3I+@oUrv%=)9mgRzSSZ86sR_{P0o);w-;*zT$%5UG1#;}k|| z4Jc#eXhv_Z5xiE!Q%y#=N9Lm&2(=CFX#oH?I}lb8%TADu8*hLR8REGNu2613HHoy+ z!J4@L=;0&$@d#6%N00jaW57SKZSd&PA^$+?s7H^GDC*Iphe&3E<818a^`Tje|GobM Dvr3l+ From 68ed78a9f9de571a3b54a07dacd145657acb4043 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 23 Sep 2023 16:23:46 -0700 Subject: [PATCH 09/37] UNIXUTILS: moved PROCESS-COMMAND and SLASHIT from GITFNS and PSEUDOHOST resp. PROCESS-COMMAND executes a command in process-stream, like ShellCommand, but returns a completion code and not what happens in the shell. SLASHIT is an approximation (doesn't deal with versions) of converting a Medley file name to its Unix equivalent, to use in commands --- library/UNIXUTILS | 76 +++++++++++++++++++++++++++++++++------- library/UNIXUTILS.DFASL | Bin 2671 -> 3617 bytes 2 files changed, 64 insertions(+), 12 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index d841eb58..89140a37 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,21 +1,30 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Jan-2023 20:36:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;7 5091 +(FILECREATED "23-Sep-2023 15:30:26" {WMEDLEY}UNIXUTILS.;7 7943 - :CHANGES-TO (FNS ShellBrowser ShellBrowse ShellOpen) - (VARS UNIXUTILSCOMS) - (FUNCTIONS ShellWhich) + :EDIT-BY rmk - :PREVIOUS-DATE "18-Jan-2023 13:22:28" {DSK}frank>il>medley>gmedley>greetfiles>UNIXUTILS.;1 -) + :CHANGES-TO (FNS SLASHIT) + + :PREVIOUS-DATE "22-Sep-2023 15:28:19" {WMEDLEY}UNIXUTILS.;6) (PRETTYCOMPRINT UNIXUTILSCOMS) -(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser) - (INITVARS (ShellBrowser)) - (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse))) +(RPAQQ UNIXUTILSCOMS + ((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND") + (FILES (FROM LOADUPS) + EXPORTS.ALL)) + (GLOBALVARS ShellBrowser) + (INITVARS (ShellBrowser)) + (FUNCTIONS ShellCommand ShellWhich) + (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT) + (PROPS (UNIXUTILS FILETYPE)))) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) +) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS ShellBrowser) @@ -106,8 +115,51 @@ " >>/tmp/ShellBrowser-warnings-$$.txt"))) T) else NIL]) + +(PROCESS-COMMAND + [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") + + (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") + + (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) + (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) + of PS)) + 0))) DO (BLOCK) FINALLY (RETURN CODE]) + +(SLASHIT + [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk") + + (* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.") + + (* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.") + + (* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ") + + (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) + 0] + [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) + COLLECT (SELCHARQ C + ((< >) + (SETQ LASTDIRPOS I) + (CHARCODE /)) + (/ (SETQ LASTDIRPOS I) + C) + C] + (CL:WHEN (AND LCASEDIRS LASTDIRPOS) + (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) + (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) + (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) + "")))) + (CL:IF (OR (EQ DIRPOS 1) + NOHOST) + SLASHED + (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) + SLASHED))]) ) + +(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (764 1137 (ShellCommand 764 . 1137)) (1139 1538 (ShellWhich 1139 . 1538)) (1539 5068 ( -ShellBrowser 1549 . 4072) (ShellBrowse 4074 . 5066))))) + (FILEMAP (NIL (902 1275 (ShellCommand 902 . 1275)) (1277 1676 (ShellWhich 1277 . 1676)) (1677 7865 ( +ShellBrowser 1687 . 4210) (ShellBrowse 4212 . 5204) (PROCESS-COMMAND 5206 . 5819) (SLASHIT 5821 . 7863 +))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index a54d15618cebee43dd29a9284e9e2eea91636473..e4054f2c91bcabc25700afb1f4b3b3cf68a664d8 100644 GIT binary patch delta 1507 zcmZuxO-vg{6rP#&A3r6gp(;YOxIgL-VhuKNT0xY0Suc3;de`-?gAqw7B&G(N5?oRR z5oD;4TD6vlvjpv=L@M_dk*bjp38B|WJ@!COJyhzo9D3;~eKWXK6-8RjyqWjj_r87a z&HJ-uyZz=nbt6e7rYWP#=c>c+YT;hd%v}}3J>lL!DAL#4(-%HlKPZ`6U~0OU3tTSc zCKhs60_McRwbGS|#jXI@fx|*>b~0BAFt@InUnF$z(S2O@IJVolUGc>fS(DOAAIOc$ z1xbs_Mlz*p3fCFBB^#+x#}?p-JK56jR89}hl>(`>AuFaSf_YNXV<#r=LGUykn}DTj zFl{7Z_iBa|%cM*Y8;e z1#=$@WR0ej2FJ$E25~Aa&&$y5%BxHNrLj0YS(+#LfE-k@yeQEX3`3a313AR3We?aE*Zz|zg-em z?SA(wSg}Xl7RWp9ju*2SxYk`vS?PF2Pn_AJLHjp%6bJ2qXY+I%11eSj2X@AO>`4QY zc5hGn7-$jKuHZ&`3A^Y=2$45w7SoUIy!Wrj{1;&G6%Age!6Ka>r@<5rN;KFF5k01r zP8lYvR|ET7aY(Tg{X#pvVOM=s9J1f2+g3w_g%?=iAgLcv2KNnJT&=%O#n0&cC^)<1 zxMW#$K0;f%=+fH^SrcW+R9>P>e(tbN=&bFopDb_Du(K(2MC$+rO*a$#DMB4{?9hS= ze9w!1L|8uDQcoxnAqYg0G7;MaIT@qj=Mef92w_5HL|%3_NpF5{y68=N80_Pg|=L_yT8ZtZTZWd!^A;<@8-|1HD62IBeS4gEo}y8>c2 z6OE=-qv=4~(2{RGTubKLF7D~&!mp2Ze~x=!!2GZGrD|d&|D%{tpA?QB3>OldI9ClP z3P(K9rD}4GQ{tz6wQvkKD+ASGf3%<$o^X$0u7kRHAvstk9=553O@n%PoK{R_eMX2= z{`a{mFfI61H zpD6G69fo3N2B5`NeTXR>P?TZ+n%m!FSF2oHzj1Oi1uhM;q016XvzTJO&d$0Ohwe_Z z3ol(lgt^&H1z1+_GP>(*qDG#bS{FGLe<-jpcU3IrKF<{cQ*)(Ra6pVWUcnyr>U^n; e#fKEaFdhWjO3y+cHP+^-$R-xL!@?Xqefke@d%&9j delta 554 zcmZ1|^Il|vhLTILcdboEer~E=T2W$Nwq0h9U2bYhPHLrHI+UJhsOfEJq3e~Hr)y+j zWUOFhU}bD(WoW?V<{0dwkd~Q~s*qfinpl#Wq7a^%l9yVXl31yuU}&KL)KQvPR0-5z zWUK?#W@Nf?*;YnImdUr7!eg0dOzmNI^9!CS0%ULpXQbxjI2GlW7pHR1n9Mk13e$`p z5o{Ju?J=(=?Ci-KnZ+69C!b`F0g`Gg&x{ObOzIKP3iS*3^mEY-2=Whcbq>**X~@FB zz&K+<54*FEe{g7!E68Rb>S1;_Gn{P4>da^|xrxFH~-%r=a-`UYe z*WG`n;p9iGA&jPz&DrFITo{3#;fx6g3GxW_^ER0?Q( Date: Sat, 23 Sep 2023 16:30:47 -0700 Subject: [PATCH 10/37] GITFNS: PROCESS-COMMAND moved to UNIXUTILS, cleanups from previous (unexamined) PR The other PR will be cleaned out --- lispusers/GITFNS | 324 +++++++++++++++++++++++++----------------- lispusers/GITFNS.LCOM | Bin 48971 -> 49899 bytes 2 files changed, 195 insertions(+), 129 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 0dbc6b1b..af78e808 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}GITFNS.;469 119763 +(FILECREATED "23-Sep-2023 13:02:15" {WMEDLEY}GITFNS.;483 124031 - :CHANGES-TO (FNS GIT-MAKE-PROJECT) + :EDIT-BY rmk - :PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}GITFNS.;468) + :CHANGES-TO (FNS CDGITDIR) + + :PREVIOUS-DATE "22-Sep-2023 12:08:14" {WMEDLEY}GITFNS.;482) (PRETTYCOMPRINT GITFNSCOMS) @@ -47,6 +49,7 @@ (INITVARS (GIT-MERGE-COMPARES T) (GIT-CDBROWSER-SEPARATE-DIRECTIONS T)) (COMMANDS gwc bbc prc cob b? cdg cdw) + (FNS PRC-COMMAND) (* ;; "") @@ -65,7 +68,7 @@ (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY - GIT-FETCH) + GIT-FETCH GIT-PR-BRANCHES) (* ;; "Differences") @@ -77,8 +80,8 @@ (* ;; "Branches") (FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES - GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME - GIT-LONG-NAME) + GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-PULL-REQUESTS + GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES) (* ;; "My branches") @@ -98,7 +101,7 @@ (FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN - GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES) + GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE) (INITVARS (FROMGITN 0)) (* ;; "") @@ -106,8 +109,8 @@ (* ;; "Utilities") - (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND - GIT-RESULT-TO-LINES STRIPLOCAL) + (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES + STRIPLOCAL) (PROPS (GITFNS FILETYPE)))) @@ -314,7 +317,8 @@ PROJECT))]) (GIT-PUT-PROJECT-FIELD - [LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 11-Mar-2023 23:00 by rmk") + [LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 10-Jun-2023 21:48 by rmk") + (* ; "Edited 11-Mar-2023 23:00 by rmk") (* ; "Edited 7-Jul-2022 11:25 by rmk") (* ; "Edited 13-May-2022 10:40 by rmk") (* ; "Edited 9-May-2022 20:02 by rmk") @@ -322,24 +326,17 @@ (* ;; "Replaces the value of a project field with NEWVALUE. The project record is DONTCOPY, to avoid potential name conflicts, so this provides a functional interface. One use: augment EXCLUSIONS with a list of temporary debug and testing files that you don't want to see in the various file listings") - (CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT) - THEN PROJECT - ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT) - GIT-DEFAULT-PROJECT) - GIT-PROJECTS)) - ELSEIF NOERROR - THEN NIL - ELSE (ERROR "NOT A GIT-PROJECT" PROJECT))) - (SELECTQ FIELD - (PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) - (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) - (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE)) - (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE)) - (DEFAULTSUBDIRS - (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE)) - (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE)) - (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE)) - PROJECT))]) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (SELECTQ FIELD + (PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) + (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) + (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE)) + (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE)) + (DEFAULTSUBDIRS + (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE)) + (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE)) + (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE)) + PROJECT]) (GIT-PROJECT-PATH [LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk") @@ -478,29 +475,7 @@ (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment") - (LET ((RB REMOTEBRANCH) - (DR DRAFTS) - (PRS)) - (IF PROJECT - THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) - ELSEIF (GIT-GET-PROJECT RB NIL T) - THEN (SETQ PROJECT RB) - (SETQ RB NIL) - ELSEIF (GIT-GET-PROJECT DRAFTS NIL T) - THEN (SETQ PROJECT DRAFTS) - (SETQ DRFTS NIL)) - (CL:WHEN (MEMB (U-CASE RB) - '(DRAFT DRAFTS)) - (SETQ RB NIL) - (SETQ DR T)) - (GIT-FETCH PROJECT) - (SETQ PRS (GIT-PULL-REQUESTS T DR PROJECT)) - (IF PRS - THEN (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT PRS) - "Pull requests"))) - (GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT) - RB NIL PROJECT)) - ELSE "No open pull requests"))) + (PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT)) (DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT) @@ -553,6 +528,46 @@ (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST) (OR SUBDIR ""))) T)) +(DEFINEQ + +(PRC-COMMAND + [LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 28-Jul-2023 09:03 by rmk") + (LET (PRS PRMENU) + (IF PROJECT + THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + ELSEIF (GIT-GET-PROJECT REMOTEBRANCH NIL T) + THEN (SETQ PROJECT REMOTEBRANCH) + (SETQ REMOTEBRANCH NIL) + ELSEIF (GIT-GET-PROJECT DRAFTS NIL T) + THEN (SETQ PROJECT DRAFTS) + (SETQ DRAFTS NIL)) + (CL:WHEN (MEMB (U-CASE REMOTEBRANCH) + '(DRAFT DRAFTS)) + (SETQ REMOTEBRANCH NIL) + (SETQ DRAFTS T)) + (GIT-FETCH PROJECT) + (SETQ PRS (GIT-PULL-REQUESTS T DRAFTS PROJECT)) + (CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu)) + (for PR in PRS when (OR (STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR) + NIL NIL NIL NIL FILEDIRCASEARRAY) + (STRPOS REMOTEBRANCH (fetch PRNAME of PR) + NIL NIL NIL NIL FILEDIRCASEARRAY)) collect PR + finally (CL:WHEN $$VAL (SETQ PRS $$VAL)) + (SETQ REMOTEBRANCH NIL))) + (IF PRS + THEN (CL:UNLESS REMOTEBRANCH + (SETQ PRS (GIT-PRC-BRANCHES DRAFTS PROJECT PRS)) + (SETQ PRMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS) + " pull requests") + NIL)) + (SETQ REMOTEBRANCH (MENU PRMENU))) + (if (EQ 'PinMenu REMOTEBRANCH) + then (ADDMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS) + " pull requests"))) + elseif REMOTEBRANCH + then (GIT-PR-COMPARE REMOTEBRANCH PROJECT)) + ELSE "No open pull requests"]) +) @@ -1004,6 +1019,35 @@ (GIT-FETCH [LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:32 by rmk") (GIT-COMMAND "git fetch" T NIL PROJECT]) + +(GIT-PR-BRANCHES + [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") + (* ; "Edited 4-Aug-2022 18:55 by rmk") + (* ; "Edited 9-Jul-2022 19:01 by rmk") + (* ; "Edited 16-May-2022 19:44 by rmk") + (CL:UNLESS PRS + (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) + (CL:WHEN PRS + (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) + NIL T PROJECT))) + (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) + (EQUALS _ (CADR RELATIONS)) IN PRS + COLLECT (SETQ PRNAME (fetch PRNAME of PR)) + (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) + " " + (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] + THEN (CONCAT PRNAME " > " REL) + ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] + THEN (CONCAT PRNAME " = " REL) + ELSE PRNAME))) + (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) + (CONCAT LABEL " (draft)") + LABEL) + (GITORIGIN PRNAME) + (CONCAT " " (FETCH PRDESCRIPTION OF PR) + " #" + (FETCH PRNUMBER OF PR] + T)))]) ) @@ -1321,41 +1365,24 @@ THEN (ERROR "Unknown branch" BRANCH]) (GIT-PICK-BRANCH - [LAMBDA (BRANCHES TITLE) (* ; "Edited 18-May-2022 13:44 by rmk") - (CL:WHEN (MKLIST BRANCHES) - (MENU (CREATE MENU - TITLE _ (OR TITLE 'Branches) - ITEMS _ BRANCHES - MENUFONT _ DEFAULTFONT)))]) + [LAMBDA (BRANCHES TITLE) (* ; "Edited 6-Jul-2023 22:31 by rmk") + (* ; "Edited 30-Jun-2023 16:58 by rmk") + (* ; "Edited 18-May-2022 13:44 by rmk") + (MENU (GIT-BRANCH-MENU BRANCHES (OR TITLE (CONCAT (LENGTH BRANCHES) + " branches"]) -(GIT-PRC-MENU - [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") - (* ; "Edited 4-Aug-2022 18:55 by rmk") - (* ; "Edited 9-Jul-2022 19:01 by rmk") - (* ; "Edited 16-May-2022 19:44 by rmk") - (CL:UNLESS PRS - (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) - (CL:WHEN PRS - (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) - NIL T PROJECT))) - (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) - (EQUALS _ (CADR RELATIONS)) IN PRS - COLLECT (SETQ PRNAME (fetch PRNAME of PR)) - (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) - " " - (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] - THEN (CONCAT PRNAME " > " REL) - ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] - THEN (CONCAT PRNAME " = " REL) - ELSE PRNAME))) - (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) - (CONCAT LABEL " (draft)") - LABEL) - (GITORIGIN PRNAME) - (CONCAT " " (FETCH PRDESCRIPTION OF PR) - " #" - (FETCH PRNUMBER OF PR] - T)))]) +(GIT-BRANCH-MENU + [LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 6-Jul-2023 22:31 by rmk") + (* ; "Edited 30-Jun-2023 16:58 by rmk") + (* ; "Edited 18-May-2022 13:44 by rmk") + (CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES)) + (CL:WHEN PIN? + [SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu]) + (CREATE MENU + TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES) + " branches")) + ITEMS _ BRANCHES + MENUFONT _ DEFAULTFONT))]) (GIT-PULL-REQUESTS [LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 8-Aug-2022 13:12 by rmk") @@ -1402,6 +1429,35 @@ (* ;; "Allows short-hand reference to branch: rmk40 will return rmk40--xyz") (FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B]) + +(GIT-PRC-BRANCHES + [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") + (* ; "Edited 4-Aug-2022 18:55 by rmk") + (* ; "Edited 9-Jul-2022 19:01 by rmk") + (* ; "Edited 16-May-2022 19:44 by rmk") + (CL:UNLESS PRS + (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) + (CL:WHEN PRS + (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) + NIL T PROJECT))) + (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) + (EQUALS _ (CADR RELATIONS)) IN PRS + COLLECT (SETQ PRNAME (fetch PRNAME of PR)) + (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) + " " + (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] + THEN (CONCAT PRNAME " > " REL) + ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] + THEN (CONCAT PRNAME " = " REL) + ELSE PRNAME))) + (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) + (CONCAT LABEL " (draft)") + LABEL) + (GITORIGIN PRNAME) + (CONCAT " " (FETCH PRDESCRIPTION OF PR) + " #" + (FETCH PRNUMBER OF PR] + T)))]) ) @@ -1664,7 +1720,8 @@ (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Sep-2022 14:41 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 10-Jun-2023 17:28 by rmk") + (* ; "Edited 12-Sep-2022 14:41 by rmk") (* ; "Edited 20-Jul-2022 21:18 by rmk") (* ; "Edited 22-May-2022 22:47 by rmk") (* ; "Edited 9-May-2022 15:14 by rmk") @@ -1683,10 +1740,11 @@ (SETQ MAPPINGS (CADDR DIRS)) (IF DIRS THEN (TERPRI T) - (SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) + [SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) (CADR DIRS) '(> < ~= -* *-) - '*>*.*)) + '*>*.* + (GIT-GET-PROJECT PROJECT 'EXCLUSIONS] (* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading versions.") @@ -1754,6 +1812,10 @@ (GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) + (* ;; "Edited 17-Jun-2023 22:54 by rmk") + + (* ;; "Edited 10-Jun-2023 21:32 by rmk") + (* ;; "Edited 20-Jul-2022 21:18 by rmk") (* ;; "Edited 25-Jun-2022 21:37 by rmk") @@ -1793,7 +1855,13 @@ (GITSUBDIR SUBDIR T PROJECT) (OR SELECT '(> < ~= -* *-)) NIL - (FETCH EXCLUSIONS OF PROJECT) + (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) + collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E + 'DIRECTORY) + 1 NIL T T FILEDIRCASEARRAY)) + (CL:IF DPOS + (SUBSTRING E (ADD1 DPOS)) + E)) NIL NIL NIL FIXDIRECTORYDATES)) [FOR CDE IN (FETCH CDENTRIES OF CDVAL) DO (CL:WHEN (FETCH INFO1 OF CDE) @@ -2067,6 +2135,11 @@ " " FILE) (CONCAT (GIT-SHORT-BRANCH-NAME BRANCH2) " " FILE]) + +(GIT-PR-COMPARE + [LAMBDA (RB PROJECT) (* ; "Edited 6-Jul-2023 22:22 by rmk") + (GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT) + RB NIL PROJECT]) ) (RPAQ? FROMGITN 0) @@ -2083,11 +2156,13 @@ (DEFINEQ (CDGITDIR - [LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:34 by rmk") + [LAMBDA (PROJECT) (* ; "Edited 23-Sep-2023 13:01 by rmk") + (* ; "Edited 8-Jul-2022 10:34 by rmk") (* ; "Edited 7-Jul-2022 09:36 by rmk") (* ; "Edited 7-May-2022 22:41 by rmk") (* ; "Edited 2-Nov-2021 21:12 by rmk:") - (CONCAT "cd " [SLASHIT (STRIPHOST (TRUEFILENAME (FETCH GITHOST OF PROJECT] + (CONCAT "cd " (SLASHIT (TRUEFILENAME (FETCH GITHOST OF PROJECT)) + NIL T) " && "]) (GIT-COMMAND @@ -2198,16 +2273,6 @@ (ERROR (CONCAT "Command failed: " CMD))) NIL]) -(PROCESS-COMMAND - [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") - - (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") - - (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) - (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) - of PS)) - 0))) DO (BLOCK) FINALLY (RETURN CODE]) - (GIT-RESULT-TO-LINES [LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk") @@ -2234,32 +2299,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 . -13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435 - . 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915 - . 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS -28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420) -(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR -34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME - 36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE -38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH -40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) ( -GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) ( -GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) ( -GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524 -) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT -60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 . -66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727) - (GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487) -) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) ( -GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE -75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR -79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) ( -GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 . -106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) ( -GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND -111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE -114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL -119031 . 119694))))) + (FILEMAP (NIL (4053 20503 (GIT-CLONEP 4063 . 5326) (GIT-INIT 5328 . 5958) (GIT-MAKE-PROJECT 5960 . +13561) (GIT-GET-PROJECT 13563 . 15488) (GIT-PUT-PROJECT-FIELD 15490 . 17131) (GIT-PROJECT-PATH 17133 + . 18177) (FIND-ANCESTOR-DIRECTORY 18179 . 18528) (GIT-FIND-CLONE 18530 . 19611) (GIT-MAINBRANCH 19613 + . 20008) (GIT-MAINBRANCH? 20010 . 20501)) (25911 28038 (PRC-COMMAND 25921 . 28036)) (28094 30882 ( +ALLSUBDIRS 28104 . 29390) (MEDLEYSUBDIRS 29392 . 30085) (GITSUBDIRS 30087 . 30880)) (30883 35673 ( +TOGIT 30893 . 32299) (FROMGIT 32301 . 33282) (GIT-DELETE-FILE 33284 . 34130) (MYMEDLEY-DELETE-FILES +34132 . 35671)) (35674 38677 (MYMEDLEYSUBDIR 35684 . 36140) (GITSUBDIR 36142 . 36585) (STRIPDIR 36587 + . 36958) (STRIPHOST 36960 . 37200) (STRIPNAME 37202 . 37955) (STRIPWHERE 37957 . 38675)) (38678 40580 + (GFILE4MFILE 38688 . 39051) (MFILE4GFILE 39053 . 39622) (GIT-REPO-FILENAME 39624 . 40578)) (40629 +52459 (GIT-COMMIT 40639 . 41465) (GIT-PUSH 41467 . 42111) (GIT-PULL 42113 . 42725) (GIT-APPROVAL 42727 + . 43076) (GIT-GET-FILE 43078 . 45043) (GIT-FILE-EXISTS? 45045 . 45319) (GIT-REMOTE-UPDATE 45321 . +46045) (GIT-REMOTE-ADD 46047 . 46354) (GIT-FILE-DATE 46356 . 47287) (GIT-FILE-HISTORY 47289 . 49223) ( +GIT-PRINT-FILE-HISTORY 49225 . 50275) (GIT-FETCH 50277 . 50449) (GIT-PR-BRANCHES 50451 . 52457)) ( +52489 63082 (GIT-BRANCH-DIFF 52499 . 58839) (GIT-COMMIT-DIFFS 58841 . 59394) (GIT-BRANCH-RELATIONS +59396 . 63080)) (63127 76230 (GIT-BRANCH-NUM 63137 . 63710) (GIT-CHECKOUT 63712 . 64771) ( +GIT-WHICH-BRANCH 64773 . 65071) (GIT-MAKE-BRANCH 65073 . 67286) (GIT-BRANCHES 67288 . 69556) ( +GIT-BRANCH-EXISTS? 69558 . 70262) (GIT-PICK-BRANCH 70264 . 70754) (GIT-BRANCH-MENU 70756 . 71459) ( +GIT-PULL-REQUESTS 71461 . 73607) (GIT-SHORT-BRANCH-NAME 73609 . 73900) (GIT-LONG-NAME 73902 . 74219) ( +GIT-PRC-BRANCHES 74221 . 76228)) (76260 79595 (GIT-MY-CURRENT-BRANCH 76270 . 76640) (GIT-MY-BRANCHP +76642 . 77147) (GIT-MY-NEXT-BRANCH 77149 . 77643) (GIT-MY-BRANCHES 77645 . 79593)) (79641 83593 ( +GIT-ADD-WORKTREE 79651 . 81135) (GIT-REMOVE-WORKTREE 81137 . 82067) (GIT-LIST-WORKTREES 82069 . 82873) + (WORKTREEDIR 82875 . 83591)) (83641 115865 (GIT-GET-DIFFERENT-FILES 83651 . 90075) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 90077 . 96422) (GIT-WORKING-COMPARE-DIRECTORIES 96424 . 101848) ( +GIT-COMPARE-WORKTREE 101850 . 105828) (GITCDOBJBUTTONFN 105830 . 110320) (GIT-CD-LABELFN 110322 . +111404) (GIT-CD-MENUFN 111406 . 113846) (GIT-WORKING-COMPARE-FILES 113848 . 114468) ( +GIT-BRANCHES-COMPARE-FILES 114470 . 115634) (GIT-PR-COMPARE 115636 . 115863)) (115935 123964 (CDGITDIR + 115945 . 116632) (GIT-COMMAND 116634 . 118192) (GITORIGIN 118194 . 118891) (GIT-INITIALS 118893 . +119197) (GIT-COMMAND-TO-FILE 119199 . 122688) (GIT-RESULT-TO-LINES 122690 . 123297) (STRIPLOCAL 123299 + . 123962))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 70a03829d00b118f34c2abc5a07bf8e489c6c231..2cd16571189cb902aa72f57dcb5414f1d7517575 100644 GIT binary patch delta 3805 zcmaJ^TWlN073D5v8>TH=54v^~S-zrel@v^7ALK5{1PYhrQlvz3X+Er|P0dOsZ3?pW zw9^C$z&7Y3{U{oBk*0=|6n26ph$UAFL)2($Z-IXFqaOkKKnwJvD3GEk@?)bY8nl4Z zJF`oXa)R<>cjnIA*}0E%?&WVDupfWR{_>Pl5WR)!l2_ma5qL4o31L34Hvd>XD0;x* z+OdjD{;-l3-LA<8m=R_XDYCKi+MyFxr(maG?NhLe37Q96b z+>S)Huze#BgmZcIOiC*iym34nT!PSHvJmEiXxG~F$Jn6I_%)L~SoeVK+culc9@&de z+pJBgTp)vcKQt+e}%c z$L7|rzu}zWc?mK~DjUr!*;o=nGQ`qaR?R8JB*;OCs|lr)E*45r3_<}U9@M8|=~5x3 zp)33W!005kLJ@=zOwj@Fhg@EpP-Dfcl2Ot9jjMfYyXv`o%p21(86_Ksa6IU6=Rm@Z zkOLlH88utNA&0{Pq(EpLfny%xc_mRKVh-|ZMk}h;RTCfsi7j3%rW8~qpI4?mz#QJg z*zCQ)M4N{qwYh!7!|xrcM`pW>+N^DJ$n<@evDvR!tFJ0_jWx`;ED{X|dAy1W#@sAx zM5)r85~Zg-6={}|H@0j)jWj(vMf`pR4P*ky7!Qy8cvk#6kW~UNjLXrY6DMyFu{Il z^Ou>CUu=F7sk{;;pQzh<=-n{tg3OVqd2@LZkerfN0rMUT#e7aHfFSU#Aumgy#N#wJ zyv$Q2)Ae3cCP@&}vN5Fyd_aP5^K&BnS%h%!FFRT$N<}QYH!k8A@J~0^m27$5mn;O+u2GXzf97r;Hc% z<%Rw_kEiA47Bba^E5Q3P9nCT3EC^`3E4v7bOVtHfx^nR%a?|pa>gwfH7w`xI*Jp%+ z@L8cGfSYEomBSv7LrJGwSZV~0>>b{RVQ87$C>FoTHpW7!0YVjkVPhjov+w_;3`W!P zw%~6&yXEUp%he&v(H=)Ol}76jqb`_TnOQhjtF9tNl62^dY`B{sl;SXzeG>HLf=60r z5mu3k{msf+ZD7{+el_}fq@C^vl&|7_ZO8DwoiNhhFO1bO=>kIQE*K&!Q}D`9E4iGS zjSJ}Vpxojbl08W^9ZzHl0magJ3}q%)1W|w&y6j}NIGt0Ezd+*Tmpd&1J_K&J3+NA{ z370Umu0C*|E+K7f$JgU&{PqmjwV!a(4&Up)yV=)petDzExw@ORb;V5d?v6C=FK#hO z{SWgm9slDT6;3jfEJMwwsEyGl#d7y9{qn^d^$)0|HZWk}u7y6)q+rV% zA_6ZKkLI`RjV&P%XzdZOI;G7_7dRP;D!K-v#1YMmf>atLAt#vDKe^o9&tpv^ zq3uY0{raVkDghBHbLY=jSE>u=s;eN1!HzisCb&(%LP!A9Ljnjv$r|%GHt8T1_okJo zn#NEO#I(kINYd}D57!lr!@Kbq#g3xE%L0s!jrvAO{6r}TZm#3=s~(ggY#x^J0dU8# zIha|gLZMpqpocgN{dsH_5R!sFh!grF69UDVg~~yE2_ga+Tn;2QLI3XJ8!-t?{9(Bf z0#Hm9)0h~jgDyOyq{$EokXAb~=1@%5F|p!=9*K`ZpI*Afi6%W|)cm;GBGLjR07LX} zQ6f@7A6|Zh6-E8E`4e6C(omOPS^oGiGiFRZabt^-GBm61^m5&iEoMMJzarM#Db;(r zUmLVHo!U?z)__pp*&=0gKT+l^KH#FQU+u5pB1K;acb@g%e>AqYK57jdPfY+jok(FWAoJ( z_p|oqhnll|z{ocDX$NWpXTP%b;6K`dk+WM5=vjxfQJq~C>I2#-d(-|Mrpy_duQ}A8 zITtZZ7#S0l`Fm(TOAXkveQN)S<}3S++Dn>`!MEmP%RYl*Cqw~}lxps;zpW1rx5j~cm+~y7FnPoQ5_UoskszDkDmF3O#3EtyLWza0AWyhVd*>D|pgh3Ijp?ub zVJ9nNpoo`nTjQ? zN(wr6Gk(mBoZ0eG?c9zoPJj94ai8_6b_w=?dlVjj99)^_I+_!3lbbvA4{x5-|8-M2 zjQ{6wPJE2Lsdq}tPZsm43VLQe&N%e7b*H{{>4<)JeOUi=eV1-u8vMaVOrQAvqx#v6 vfrBmctj1S=cH=lIUE6T!cQ<4l?YecWaq`w%d%8P3h2PFK2OGZINB8^>tE;Ty delta 3325 zcmZu!YitzP72cU8HY{L_G1y%Q93~FkbyzZwo!Ljy#IrNA_Tt^0WoC@yCc!oAg56M? zcuQV_xT38ZrBVvIRfzyK6{<=}RAhUx)TW}_O0B92Rh6o!s#LWSN~EfaTG3xs`Xlt* zJ3DJb>L0Un&bf0Q-#y>C*B^f~eEU=W{CKY-CQ4KD30agC5HndZolT}MyzscKW#SMK z|AgzOuso7!oQ&ieI5E)MZL69e-_G_SG0P3`wB zxI`DUbiR*EzQSL{R18b6Kp?rl8# zR3S?86WgNC@?3}?3SS$lE_>6_o0Tuo()Z{qohQh5CZ0Olvw_N(RXPnNt2~COsF@%b zRg73gGhfC4n2&?qQL1<#Cm}aKHG6EjRtHIiGwZ^1r8iNr9yx;!;%rANj*+11#-$_Q z;2YI14z44=Ioi_@r+(7id!mC6tut8Yqa8yl;d4veljPqozR`DkhABt6QJ!PF#z5Re zuFPNMeoLON_fIMcZC2YU3>V6vAcRG$Jd7AAVg?K|=h)+}<$$av!LZAQPLoxFHL{d} zB10Ucj0&EG1re4rq5?4k2|YDm1GiR-W5sC@;5ZVzE`Y3PD6l^&h$u|WR`Dt0 zE(#z-K$b-E!RhbIBKXY(2t)?Ff>*TYYZ}2htQYC4x@HC9Ym$|hZm8&n5!iBut%QO7 zp*xmK$*5wfu9p}uS!U6iKp4==m~Ya^jh6@3@&D})lRv%uabM`e=D2uuDfE{T+x=Tx z#mz%Yp(gqBE6NNd7&l$58k?DIvUgFfa$C7Bdsmg`mbdYoy^H6#8Ak5@CJMOx9sj4= zR&V3OE4S_5$*yL3Wux6S9X;~=(!DXeYu}Njdu8fwi@lrt;Z=E|*M{&)_*>lMK+_gh zc5f>klbe1^HV;-`xO;Vp<5@>8h3Vk`9A|Z zOP>j?O7=DF0efFzbUGSkJ_{#88`FHz3PqTT@ZUy|{eH-{mSo-uM<`!ci*HhTsE!t=q zB_N81eZ0ybO_N%uLSd>km7WGw!*1|trK+jGM>3rXxRh-3u2{gal$51ly^>PE#fBIu zc&v@b%56!ODC-(q&uripQrPutd8c778*`^#eH5NdfTpBrhvP3M-RgJ^XJf!b4QIdu zjMKzb#;KW9(7f}klvh`w-vQoo2DLgKKrlrW8vx8wx zRY=$CdtD8uj36LDGLp)tUIf%+2BqK+tx0NaaZzQ&q+CRuN{Q*0G&6ew6-h~JoO}Hr zJC7SCR)ixTvSvCGD}WeOi)Y*bwu?U|@r>bEgRMSTtI>v{)13m=8i%XffYf$9r%=HY zgnZ$0luI|Bx%{7vortDkxh^?*Ini0cc!q6~x32A4kf6eN4LGc{6owZ$KE!S94xQ{g z)IsC?uJ`O|ekJ_nXR0%I-)^p_s^;QH{s}XEY+ZApgQKaW;knXb)*f;Oaz)!1MPMbI zJ|5m8O6>e-r9j6?NiUmpI?6kI1o9LCnup})K@MDzQxB~7SK`3(m*D7P-%#+3l8Ko= z#v^b;8%XN<;4E%~QOx3D>ss_+3v$B|_<&b`MyudocIZus!jx#Ija!)2bGGAw-;&I_ zwgOrjxzp$+Z(Z+bOkew?gLv{xe1#qIM^eNcW+$b$l=BPJ*<@x0X##@LOzc- zCGy=xm#N1`3dTsHbyOG^|{%)5O3Y!$Up1- zNNouKY(Yf8+`ftR zBesN&WNUCYf7tm%(efY`b8--Itdi|ne$5!zbij1lb~9xqrV~ z;{YAuZU~jrI5OvJFP^T|zgic_;`^T;VJWS--?F?61ib}+Ao~F0e=g-Ym^)RQg;V$W MiZ_1$^WB~Q1DwlL7ytkO From 9ed64485918da24cf046851856e46beffef377bd Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 23 Sep 2023 16:32:03 -0700 Subject: [PATCH 11/37] PSEUDOHOSTS: Moved SLASHIT to UNIXUTILS, also includes minor change in previous (unexamined) PR, to be removed --- lispusers/PSEUDOHOSTS | 97 +++++++++++++++---------------------- lispusers/PSEUDOHOSTS.LCOM | Bin 8570 -> 8250 bytes 2 files changed, 40 insertions(+), 57 deletions(-) diff --git a/lispusers/PSEUDOHOSTS b/lispusers/PSEUDOHOSTS index 981afb63..ad69e0ed 100644 --- a/lispusers/PSEUDOHOSTS +++ b/lispusers/PSEUDOHOSTS @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Jul-2023 09:17:48" {WMEDLEY}PSEUDOHOSTS.;153 27674 +(FILECREATED "22-Sep-2023 15:29:50" {WMEDLEY}PSEUDOHOSTS.;158 26638 :EDIT-BY rmk - :CHANGES-TO (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE) - (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL) + :CHANGES-TO (FNS PSEUDOHOST SLASHIT CONTRACT.PH) (VARS PSEUDOHOSTSCOMS) - :PREVIOUS-DATE "18-Jul-2023 13:12:35" {WMEDLEY}PSEUDOHOSTS.;152) + :PREVIOUS-DATE "26-Jul-2023 12:34:37" {WMEDLEY}PSEUDOHOSTS.;155) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -21,7 +20,7 @@ (* ;; "Internals") - (FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT GETHOSTINFO.PH) + (FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH) (FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH) @@ -42,6 +41,8 @@ (PSEUDOHOST [LAMBDA (HOST PREFIX) + (* ;; "Edited 22-Sep-2023 15:29 by rmk") + (* ;; "Edited 25-Jun-2022 17:00 by rmk") (* ;; "Edited 24-Feb-2022 23:56 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.") @@ -81,7 +82,7 @@ (SELECTQ TARGETHOST ((DSK CORE) (SETQ PREFIX (UNSLASHIT PREFIX))) - (UNIX (SETQ PREFIX (SLASHIT PREFIX))) + (UNIX (SETQ PREFIX (SLASHIT PREFIX))) NIL) (SETQ TARGETDEVICE (OR (\GETDEVICEFROMHOSTNAME TARGETHOST) (ERROR "UNKNOWN TARGET HOST" TARGETHOST))) @@ -153,26 +154,32 @@ (FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))]) (TRUEFILENAME - [LAMBDA (FILE) (* ; "Edited 26-Jan-2022 23:33 by rmk") + [LAMBDA (FILE) (* ; "Edited 26-Jul-2023 07:53 by rmk") + (* ; "Edited 26-Jan-2022 23:33 by rmk") (* ; "Edited 25-Jan-2022 08:47 by rmk") - (LET (FILENAME DEVICE) - (IF (STREAMP FILE) - THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE)) - (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) - ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) - (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) - (CL:IF (TYPE? PHDEVICE DEVICE) - (EXPAND.PH FILENAME DEVICE) - FILENAME)]) + (if (LISTP FILE) + then (for F in FILE collect (TRUEFILENAME F)) + else (LET (FILENAME DEVICE) + (IF (STREAMP FILE) + THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE)) + (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) + ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) + (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) + (CL:IF (TYPE? PHDEVICE DEVICE) + (EXPAND.PH FILENAME DEVICE) + FILENAME)]) (PSEUDOFILENAME - [LAMBDA (FILE) (* ; "Edited 29-Jan-2022 23:08 by rmk") + [LAMBDA (FILE) (* ; "Edited 26-Jul-2023 12:34 by rmk") + (* ; "Edited 29-Jan-2022 23:08 by rmk") (* ; "Edited 28-Jan-2022 09:06 by rmk") - (FOR D PN (FILENAME _ (IF (STREAMP FILE) - THEN (FETCH (STREAM FULLFILENAME) OF FILE) - ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES - WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) - DO (RETURN PN) FINALLY (RETURN FILENAME]) + (if (LISTP FILE) + then (for F in FILE collect (PSEUDOFILENAME F)) + else (FOR D PN (FILENAME _ (IF (STREAMP FILE) + THEN (FETCH (STREAM FULLFILENAME) OF FILE) + ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES + WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) + DO (RETURN PN) FINALLY (RETURN FILENAME]) ) @@ -209,6 +216,8 @@ (CONTRACT.PH [LAMBDA (NAME PHDEV) + (* ;; "Edited 22-Sep-2023 14:30 by rmk") + (* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then") (* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.") @@ -234,7 +243,7 @@ (SETQ CONNECTOR (CADDR PM)) [SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/) - THEN (SLASHIT SUFFIX) + THEN (SLASHIT SUFFIX) ELSE (UNSLASHIT SUFFIX]) (RETURN (PACK* '{ (CADR PM) "}" @@ -244,31 +253,6 @@ (RETURN NAME)))]) -(SLASHIT - [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk") - (* ; "Edited 3-Jan-2022 11:44 by rmk") - (* ; "Edited 22-Dec-2021 20:18 by rmk") - (* ; "Edited 2-Nov-2021 22:54 by rmk:") - (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) - 0] - [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) - COLLECT (SELCHARQ C - ((< >) - (SETQ LASTDIRPOS I) - (CHARCODE /)) - (/ (SETQ LASTDIRPOS I) - C) - C] - (CL:WHEN (AND LCASEDIRS LASTDIRPOS) - (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) - (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) - (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) - "")))) - (CL:IF (EQ DIRPOS 1) - SLASHED - (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) - SLASHED))]) - (UNSLASHIT [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:09 by rmk") (* ; "Edited 22-Dec-2021 20:18 by rmk") @@ -527,13 +511,12 @@ EXPORTS.ALL) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1397 9433 (PSEUDOHOST 1407 . 6966) (PSEUDOHOSTP 6968 . 7481) (PSEUDOHOSTS 7483 . 7844) -(TARGETHOST 7846 . 8120) (TRUEFILENAME 8122 . 8809) (PSEUDOFILENAME 8811 . 9431)) (9461 17000 ( -EXPAND.PH 9471 . 10724) (CONTRACT.PH 10726 . 13391) (SLASHIT 13393 . 14961) (UNSLASHIT 14963 . 16709) -(GETHOSTINFO.PH 16711 . 16998)) (17001 25021 (OPENFILE.PH 17011 . 18084) (GETFILENAME.PH 18086 . 18375 -) (DIRECTORYNAMEP.PH 18377 . 19001) (CLOSEFILE.PH 19003 . 19470) (REOPENFILE.PH 19472 . 20037) ( -DELETEFILE.PH 20039 . 20323) (OPENP.PH 20325 . 20620) (UNREGISTERFILE.PH 20622 . 21164) ( -REGISTERFILE.PH 21166 . 21700) (GENERATEFILES.PH 21702 . 22746) (GETFILEINFO.PH 22748 . 23050) ( -SETFILEINFO.PH 23052 . 23251) (NEXTFILEFN.PH 23253 . 23799) (FILEINFOFN.PH 23801 . 24076) ( -RENAMEFILE.PH 24078 . 25019))))) + (FILEMAP (NIL (1315 9921 (PSEUDOHOST 1325 . 6930) (PSEUDOHOSTP 6932 . 7445) (PSEUDOHOSTS 7447 . 7808) +(TARGETHOST 7810 . 8084) (TRUEFILENAME 8086 . 9048) (PSEUDOFILENAME 9050 . 9919)) (9949 15964 ( +EXPAND.PH 9959 . 11212) (CONTRACT.PH 11214 . 13925) (UNSLASHIT 13927 . 15673) (GETHOSTINFO.PH 15675 . +15962)) (15965 23985 (OPENFILE.PH 15975 . 17048) (GETFILENAME.PH 17050 . 17339) (DIRECTORYNAMEP.PH +17341 . 17965) (CLOSEFILE.PH 17967 . 18434) (REOPENFILE.PH 18436 . 19001) (DELETEFILE.PH 19003 . 19287 +) (OPENP.PH 19289 . 19584) (UNREGISTERFILE.PH 19586 . 20128) (REGISTERFILE.PH 20130 . 20664) ( +GENERATEFILES.PH 20666 . 21710) (GETFILEINFO.PH 21712 . 22014) (SETFILEINFO.PH 22016 . 22215) ( +NEXTFILEFN.PH 22217 . 22763) (FILEINFOFN.PH 22765 . 23040) (RENAMEFILE.PH 23042 . 23983))))) STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM index 1560bf8fc0806e974871bbd164b002cb48e9fd20..2a4c82ce9a98ba9aabd8e65b586f9979219cb67d 100644 GIT binary patch delta 859 zcma))O=#0#7{`;=*_!D{p>#60^)WDM4=ruJ`f)K?^0v)PlhCA_Xq`-3a5%M8MPXp^ z?8Wg4-b6hLLRl$(;LX!+UOapEw3{FveA5r;V1hY>=gt3l-sk!K^ZZ`@tUTX{@_fo| zwNreC7a%JY`9e|3?A?~S`6Mvh5iwg7#A2qv!HrJq=Dj=Z?VVN=T94bE`zu9oTvXTX zitT!^eHXY=-85mkI-O2)(A;`JN{+iWD|1OEQ8G-V)sX5TJqAacPbS-43FU#8Wg(9@ z=|!$&xznv(Q*|qb2byhpHC6M{P6dCb6EV_KPOUxM8DsK3iICgdU7@9ZA@DBTl|V=9 zhK9fa5&SVMwdx-PD1iZ);in`}TPG=sR)YInL$RUOFYz^m2KWP0Lfo`(|Q0y#TQ0*S}3XSr4m z9E;G&pp&=sFJQu+hlYRO$Q+kA&uBSqXmbR_r>)vWdS*NHF-@vWb`C^E89S_$q!BUn0?qcp0bflST4UuI>>#C_} XcGV%)0D~K#;2zE5_Yfn=U*W@Fa?8^R delta 887 zcmZvb%WD%+6vk(gV&n9|1f!IaHpgg70!^BEQX$HnI06fQ zqX*gr;Io;mh-c_99*k%w8K;aUR9m;pZqk)YW5}J9O}tIVdj6s31c~Dt^bGz^pP~6( zzwdcqg98;!8VUjjQs5C-auI>i+Qfl6@1rO>2z359MV=R-{4wwSG4QGtF!!68N+W-% znH3-E2IJMSI!ndU89)_Bw$!AfgP4M8!q}Xu;YB9k6GVKqBLq1pyF`A`Azp|X&`1gJ z>DD1|8T_;(Dhc3Ngp~)Ctla;^pn(X}o{;8*vL~U9rf3%rb@pWZx___DVCl;(&PPUd zya75@e^Ov|UuEY96%$85u`RbGE3QY(^B&%*%pp7>*Tmz5-Th9(-&Z!}vTnE_sW~R* zKo%52ClDJwQk-CO;q3rL`IbFP@{M_W{+kP5gQtCZP;SR}*f2eXAG3*}bMt$L! zV4+H5uUU-}w||Ug@aKqtKlKZ}48&BVm~sh`zX6dum{;tgL%IQnBY9Fd9T~)TBQO5| Dc^uyj From bf2e34841b8076067f32d3a9578914e94f516e18 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Sat, 23 Sep 2023 22:56:54 -0700 Subject: [PATCH 12/37] PDFSTREAM: wrapped FULLNAME around TRUEFILENAME --- library/PDFSTREAM | 14 +++++++------- library/PDFSTREAM.LCOM | Bin 4189 -> 4201 bytes 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 8d882dd8..9ec59d23 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2023 15:38:55" {WMEDLEY}PDFSTREAM.;48 10752 +(FILECREATED "23-Sep-2023 22:54:26" {WMEDLEY}PDFSTREAM.;49 10763 :EDIT-BY rmk - :CHANGES-TO (FNS OPEN-PDF-STREAM PS-TO-PDF) + :CHANGES-TO (FNS PS-TO-PDF OPEN-PDF-STREAM) - :PREVIOUS-DATE "23-Sep-2023 15:31:33" {WMEDLEY}PDFSTREAM.;47) + :PREVIOUS-DATE "23-Sep-2023 15:38:55" {WMEDLEY}PDFSTREAM.;48) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -154,7 +154,7 @@ PSSTREAM)]) (PS-TO-PDF - [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Sep-2023 15:30 by rmk") + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Sep-2023 22:54 by rmk") (* ; "Edited 23-Jul-2023 22:30 by rmk") (* ; "Edited 24-Jun-2023 15:01 by rmk") (* ; "Edited 16-Jul-2022 13:06 by rmk") @@ -166,7 +166,7 @@ (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") - (SETQ PSFILE (TRUEFILENAME PSFILE)) + (SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE))) (SETQ PDFFILE (if PDFFILE then (TRUEFILENAME PDFFILE) else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE))) @@ -211,6 +211,6 @@ PDFFILE]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3630 10729 (OPEN-PDF-STREAM 3640 . 5818) (CLOSE-PDF-STREAM 5820 . 7107) (PS-TO-PDF 7109 - . 10727))))) + (FILEMAP (NIL (3630 10740 (OPEN-PDF-STREAM 3640 . 5818) (CLOSE-PDF-STREAM 5820 . 7107) (PS-TO-PDF 7109 + . 10738))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index ba009eae5b2a9602d4822a9e6fbe44635eea02e4..78e86fb0fceb4ca18f4e5b00d85ca718d47ab46c 100644 GIT binary patch delta 642 zcmZ8f%WB&|6tx7UsnK@_X-gEBU;x}&I4LIKy-ahvi7mgJzzP{eBwQZDL zr`h7Cxo1D2AAvc6@3wC&>~tciT2?EytxY52vi)L>T4wDne_0n>kB1L>y{*IT9<62h z@R>CiFwI0}c_FK~l;C~{*)*yF7yKV`1EjK8X~21eV`)}6uQCPBd=Q{*P1r$FC@r%C zaL4WLut;?0EDTXMDv?^-i7Lx^T%};4i$qmPY>HePupoq<91#Zd1C-;~sFEPZq{`21 zDle;3FwcQ5Vtta+4cFbY!8p4onfD**@Qxf)ZyN!G40W80yFf(rHw7>3j8f$d4f)O{ zMbUoiKYz+SP?X2!glzEk^ONBmOprd!$lcu7N0~Sv|9^BBaY6fjy42Q6m_erNdXhFdxQvnMCQEHq8cU@QGdv^=9tqSZsns=jC^2lx(*dnl%?R8N zVXD*|m((HRbsL;VE7D8W$wV%>c7A^G4rgQcp?|9<0`A`T_n2^>`gb>jWcIcH GW# Date: Mon, 25 Sep 2023 11:34:51 -0700 Subject: [PATCH 13/37] Fix latest issues with docker build (and Release+Docker builds) for Medley (#1326) * fix buildRealeaseInclDocker.yml to pass secrets via inherits rather than explicitly. Attempt to fix issue with GITHUB_TOEN not being passed to buildRelease.yml * In buildDocker.yml, fix up calculation of medley and maiko release to accomodate new naming scheme for medley deb files * Update Dockerfile_medley with new deb file naming convention --- .github/workflows/Dockerfile_medley | 4 ++-- .github/workflows/buildDocker.yml | 4 +++- .github/workflows/buildReleaseInclDocker.yml | 7 ++----- 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/.github/workflows/Dockerfile_medley b/.github/workflows/Dockerfile_medley index 9f2af48a..cd78d73b 100644 --- a/.github/workflows/Dockerfile_medley +++ b/.github/workflows/Dockerfile_medley @@ -57,8 +57,8 @@ RUN apt-get update \ echo "x86_64"; \ fi \ ) \ - && deb="medley-full-${MEDLEY_RELEASE#medley-}" \ - && deb=${deb}_${MAIKO_RELEASE#maiko-}-linux-${p}.deb \ + && deb="medley-full-linux-${p}-${MEDLEY_RELEASE#medley-}" \ + && deb=${deb}_${MAIKO_RELEASE#maiko-}.deb \ && apt-get install -y /tmp/${deb} \ && chown --recursive root:root /usr/local/interlisp \ && (if [ -n "$(which unminimize)" ]; then (yes | unminimize); fi) diff --git a/.github/workflows/buildDocker.yml b/.github/workflows/buildDocker.yml index 13fea618..c7e07ad5 100644 --- a/.github/workflows/buildDocker.yml +++ b/.github/workflows/buildDocker.yml @@ -160,7 +160,7 @@ jobs: - name: Get info about Miako and Medley releases id: release_info run: | - regex="^[^0-9]*\([^_]*\)_\([^-]*-[^-]*\)-\([^-]*\)-\([^.]*\).*\$" + regex="^medley-full-[^-]*-[^-]*-\([^_]*\)_\(.*\).deb\$" ls -1 release_debs | head -n 1 > debname.tmp medley_release="medley-$(sed -e "s/${regex}/\1/" debname.tmp)" maiko_release="maiko-$(sed -e "s/${regex}/\2/" debname.tmp)" @@ -168,6 +168,8 @@ jobs: echo "MEDLEY_RELEASE=${medley_release}" >> ${GITHUB_ENV} echo "MAIKO_RELEASE=${maiko_release}" >> ${GITHUB_ENV} + # regex="^[^0-9]*\([^_]*\)_\([^-]*-[^-]*\)-\([^-]*\)-\([^.]*\).*\$" + # Set repo env variables - name: Set repo/docker env variables id: repo_env diff --git a/.github/workflows/buildReleaseInclDocker.yml b/.github/workflows/buildReleaseInclDocker.yml index 5049109c..2f108c15 100644 --- a/.github/workflows/buildReleaseInclDocker.yml +++ b/.github/workflows/buildReleaseInclDocker.yml @@ -95,8 +95,7 @@ jobs: with: draft: ${{ needs.inputs.outputs.draft }} force: ${{ needs.inputs.outputs.force }} - secrets: - OIO_SSH_KEY: ${{ secrets.OIO_SSH_KEY }} + secrets: inherit ###################################################################################### @@ -108,9 +107,7 @@ jobs: with: draft: ${{ needs.inputs.outputs.draft }} force: ${{ needs.inputs.outputs.force }} - secrets: - DOCKER_USERNAME: ${{ secrets.DOCKER_USERNAME }} - DOCKER_PASSWORD: ${{ secrets.DOCKER_PASSWORD }} + secrets: inherit ###################################################################################### From af912247b32faa4844c287e6a43ab6a570927c8c Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 25 Sep 2023 20:32:17 -0700 Subject: [PATCH 14/37] Restore POSTSCRIPTSTREAM --- library/POSTSCRIPTSTREAM | 4423 +++++++++++++++++++++++++++++++++ library/POSTSCRIPTSTREAM.LCOM | Bin 0 -> 91396 bytes 2 files changed, 4423 insertions(+) create mode 100644 library/POSTSCRIPTSTREAM create mode 100644 library/POSTSCRIPTSTREAM.LCOM diff --git a/library/POSTSCRIPTSTREAM b/library/POSTSCRIPTSTREAM new file mode 100644 index 00000000..6d5a1729 --- /dev/null +++ b/library/POSTSCRIPTSTREAM @@ -0,0 +1,4423 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP") +(FILECREATED "21-Jun-2021 20:29:32"  +{DSK}kaplan>Local>medley3.5>git-medley>library>POSTSCRIPTSTREAM.;11 259283 + + previous date%: "12-Jun-2021 19:14:50" +{DSK}kaplan>Local>medley3.5>git-medley>library>POSTSCRIPTSTREAM.;10) + + +(* ; " +Copyright (c) 1989-1995, 1997-1998, 2018, 2021 by Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets. +") + +(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS) + +(RPAQQ POSTSCRIPTSTREAMCOMS + [ + (* ;; "PostScript printer support for Medley") + + (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM)) + (INITRECORDS \POSTSCRIPTDATA) + (FNS POSTSCRIPT.INIT) + (ADDVARS (DEFAULTFILETYPELIST (PS . TEXT) + (PSC . TEXT) + (PSF . BINARY) + (PSCFONT . BINARY) + (POSTSCRIPT . TEXT)) + (*DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) + (AVANTGARDE-DEMI . AD) + (BECKMAN . BM) + (BOOKMAN-LIGHT . BL) + (BOOKMAN-DEMI . BD) + (COURIER . CO) + (HELVETICA-NARROW . HN) + (NEWCENTURYSCHLBK . NC) + (PALATINO . PA) + (TIMES . TS) + (ZAPFCHANCERY-MEDIUM . ZM) + (ZAPFCHANCERY . ZC) + (ZAPFDINGBATS . ZD))) + + (* ;; "Font-reading code") + + (FNS PSCFONT.READFONT PSCFONT.SPELLFILE PSCFONT.COERCEFILE PSCFONTFROMCACHE.SPELLFILE + PSCFONTFROMCACHE.COERCEFILE PSCFONT.WRITEFONT READ-AFM-FILE CONVERT-AFM-FILES + POSTSCRIPT.GETFONTID POSTSCRIPT.FONTCREATE \POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS + POSTSCRIPT.FONTSAVAILABLE) + (COMS + (* ;; "Until macro in FONT is exported") + + (MACROS \FSETCHARWIDTH)) + (FNS OPENPOSTSCRIPTSTREAM CLOSEPOSTSCRIPTSTREAM) + (INITVARS (*POSTSCRIPT-FILE-TYPE* 'BINARY)) + (FNS POSTSCRIPT.HARDCOPYW POSTSCRIPT.TEDIT POSTSCRIPT.TEXT POSTSCRIPTFILEP MAKEEPSFILE) + (FNS POSTSCRIPT.BITMAPSCALE POSTSCRIPT.CLOSESTRING POSTSCRIPT.ENDPAGE POSTSCRIPT.OUTSTR + POSTSCRIPT.PUTBITMAPBYTES POSTSCRIPT.PUTCOMMAND POSTSCRIPT.SET-FAKE-LANDSCAPE + POSTSCRIPT.SHOWACCUM POSTSCRIPT.STARTPAGE \POSTSCRIPTTAB \PS.BOUTFIXP \PS.SCALEHACK + \PS.SCALEREGION \SCALEDBITBLT.PSC \SETPOS.PSC \SETXFORM.PSC \STRINGWIDTH.PSC + \SWITCHFONTS.PSC \TERPRI.PSC) + + (* ;; "DIG operations: ") + + (FNS \BITBLT.PSC \BLTSHADE.PSC \CHARWIDTH.PSC \CREATECHARSET.PSC \DRAWARC.PSC \DRAWCIRCLE.PSC + \DRAWCURVE.PSC \DRAWELLIPSE.PSC \DRAWLINE.PSC \DRAWPOINT.PSC \DRAWPOLYGON.PSC + \DSPBOTTOMMARGIN.PSC \DSPCLIPPINGREGION.PSC \DSPCOLOR.PSC \DSPFONT.PSC + \DSPLEFTMARGIN.PSC \DSPLINEFEED.PSC \DSPPUSHSTATE.PSC \DSPPOPSTATE.PSC \DSPRESET.PSC + \DSPRIGHTMARGIN.PSC \DSPROTATE.PSC \DSPSCALE.PSC \DSPSCALE2.PSC \DSPSPACEFACTOR.PSC + \DSPTOPMARGIN.PSC \DSPTRANSLATE.PSC \DSPXPOSITION.PSC \DSPYPOSITION.PSC \FILLCIRCLE.PSC + \FILLPOLYGON.PSC \FIXLINELENGTH.PSC \MOVETO.PSC \NEWPAGE.PSC) + (COMS + (* ;; "Character-output, plus special-cases:") + + (FNS \POSTSCRIPT.CHANGECHARSET \POSTSCRIPT.OUTCHARFN \POSTSCRIPT.PRINTSLUG + \POSTSCRIPT.SPECIALOUTCHARFN \UPDATE.PSC \POSTSCRIPT.ACCENTFN + \POSTSCRIPT.ACCENTPAIR) + + (* ;; + "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") + + (FNS \PSC.SPACEDISP \PSC.SPACEWID \PSC.SYMBOLS) + + (* ;; + "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") + + (FNS \POSTSCRIPT.NSHASH) + (VARS (*POSTSCRIPT-UNACCENTED-FONTS* '(Dancer ZapfDingbats "Dancer" "ZapfDingbats")) + *POSTSCRIPT-NS-TRANSLATIONS*) + (GLOBALVARS *POSTSCRIPT-NS-HASH*)) + (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \POSTSCRIPT.FRACTION)) + (VARS (\POSTSCRIPT.ORIENTATION.MENU (create MENU ITEMS _ '(("Landscape" T + "Print this file/document/image in Landscape Orientation" + ) + ("Portrait" 'NIL + "Print this file/document/image in Portrait Orientation" + )) + TITLE _ "Orientation" CENTERFLG _ T MENUOFFSET _ + (create POSITION XCOORD _ -1 YCOORD _ 0) + CHANGEOFFSETFLG _ 'Y)) + (\POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK + "Always ask whether to print in Landscape or Portrait Orientation" + ) + ("Landscape" T + "Default printing to Landscape Orientation" + ) + ("Portrait" 'NIL + "Default printing to Portrait Orientation" + )) + TITLE _ "Default Orientation" CENTERFLG _ + T)) + PS.BITMAPARRAY \POSTSCRIPT.JOB.SETUP SlopeMenuItems WeightMenuItems) + [ADDVARS (BackgroundMenuCommands ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE + (MENU + \POSTSCRIPT.ORIENTATION.OPTIONS.MENU + )) + + "Select the default Orientation for PostScript output" + (SUBITEMS ("Ask" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE + 'ASK) + + "Always ask whether to print in Landscape or Portrait Orientation" + ) + ("Landscape" '(SETQ + POSTSCRIPT.PREFER.LANDSCAPE + T) + + "Default printing to Landscape Orientation" + ) + ("Portrait" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE + NIL) + + "Default printing to Portrait Orientation" + ] + (VARS (BackgroundMenu NIL)) + (CONSTANTS (GOLDEN.RATIO 1.618034) + (\PS.SCALE0 100) + (\PS.TEMPARRAYLEN 20)) + (INITVARS (POSTSCRIPT.BITMAP.SCALE 1) + (POSTSCRIPT.EOL 'CR) + (POSTSCRIPT.IMAGESIZEFACTOR 1) + (POSTSCRIPT.PREFER.LANDSCAPE NIL) + (POSTSCRIPT.TEXTFILE.LANDSCAPE NIL) + (POSTSCRIPT.DEFAULT.PAGEREGION '(4800 4800 52800 70800)) + (POSTSCRIPT.TEXTURE.SCALE 4) + [POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) + 'MAIKO) + "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") + (T "{DSK}POSTSCRIPT>"] + (\POSTSCRIPT.MAX.WILD.FONTSIZE 72)) + [COMS (FNS POSTSCRIPTSEND) + (ADDVARS (PRINTERTYPES ((POSTSCRIPT) + (CANPRINT (POSTSCRIPT)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR + REGION ROTATION TITLE] + [ADDVARS (POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) + (HELVETICAD . HELVETICA) + (TIMESROMAN . TIMES) + (TIMESROMAND . TIMES) + (COURIER . COURIER) + (GACHA . COURIER) + (CLASSIC . NEWCENTURYSCHLBK) + (MODERN . HELVETICA) + (CREAM . HELVETICA) + (TERMINAL . COURIER) + (LOGO . HELVETICA) + (OPTIMA . PALATINO) + (TITAN . COURIER)) + [PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) + (EXTENSION (PS PSC PSF)) + (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT] + (IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC] + (INITVARS (POSTSCRIPT.PAGETYPE 'LETTER)) + + (* ;; "NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk") + + [APPENDVARS (POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2)) + (LEGAL (0 0 8.5 14) + NIL + (-0.1 -0.1 8.7 14.2)) + (NOTE (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2] + (GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST + POSTSCRIPT.PREFER.LANDSCAPE POSTSCRIPT.TEXTFILE.LANDSCAPE POSTSCRIPT.TEXTURE.SCALE + POSTSCRIPTFONTDIRECTORIES \POSTSCRIPT.JOB.SETUP \POSTSCRIPT.MAX.WILD.FONTSIZE + \POSTSCRIPT.ORIENTATION.MENU \POSTSCRIPTIMAGEOPS POSTSCRIPT.PAGETYPE + POSTSCRIPT.PAGEREGIONS) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (POSTSCRIPT.INIT))) + (PROP (FILETYPE MAKEFILE-ENVIRONMENT) + POSTSCRIPTSTREAM) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA + POSTSCRIPT.PUTCOMMAND + ]) + + + +(* ;; "PostScript printer support for Medley") + +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RECORD FONTID (FONTIDNAME FONTXFACTOR FONTOBLIQUEFACTOR)) + +(RECORD PSCFONT (FID IL-FONTID FIRSTCHAR LASTCHAR ASCENT DESCENT WIDTHS)) + +(DATATYPE \POSTSCRIPTDATA + ((POSTSCRIPTACCENTED FLAG) (* ; + "T if we're to do NS-to-PS translations on characters in the current font.") + POSTSCRIPTFONT (* ; + "The fontdescriptor of the current font") + POSTSCRIPTX (* ; "The current X") + POSTSCRIPTY (* ; "... and Y") + POSTSCRIPTLEFTMARGIN (* ; "The margins") + POSTSCRIPTRIGHTMARGIN POSTSCRIPTBOTTOMMARGIN POSTSCRIPTTOPMARGIN POSTSCRIPTLINESPACING + (* ; "Line to line spacing") + POSTSCRIPTCOLOR (* ; + "Color (or grey shade) in effect; 0.0=black, 1.0=white.") + POSTSCRIPTSCALE (* ; "Scale of the stream") + POSTSCRIPTOPERATION (* ; + "Default operation (PAINT, REPLACE, ...)") + POSTSCRIPTCLIPPINGREGION (* ; + "The current region available to be written into") + POSTSCRIPTPAGENUM (* ; "Current page number") + POSTSCRIPTHEADING (* ; "The heading") + POSTSCRIPTHEADINGFONT (* ; "Font for the heading") + POSTSCRIPTSPACEFACTOR (* ; + "Expansion factor for spaces (see DSPSPACEFACTOR)") + POSTSCRIPTSPACEWIDTH (* ; + "The width of a space in the current font") + POSTSCRIPTLANDSCAPE (* ; + "non-NIL for paper in 'landscape' mode") + POSTSCRIPTCHARSTOSHOW (* ; + "non-NIL if the string (PostScript-type string) of chars has already been started") + POSTSCRIPTFONTCHANGEDFLG (* ; "Font has changed") + POSTSCRIPTMOVEFLG (* ; "Need to move") + POSTSCRIPTWIDTHS (* ; + "The widths vector of the current font") + POSTSCRIPTTRANSX (* ; "Translation in X") + POSTSCRIPTTRANSY (* ; "... and Y") + POSTSCRIPTPENDINGXFORM (* ; + "A userspace to devicespace transform is pending") + POSTSCRIPTPAGEREGION (* ; "The whole page") + POSTSCRIPTPAGEBLANK (* ; "This page is blank flag") + POSTSCRIPTSCALEHACK (* ; + "For \PS.SCALEHACK since DSPSCALE doesn't change the scale of the stream") + POSTSCRIPTTEMPARRAY (* ; + "For converting FIXP to string of digit chars") + POSTSCRIPTXFORMSTACK (* ; "The stack of transformations. DSPPUSHSTATE pushes one onto this, DSPPOPSTATE uses it to reset values.") + POSTSCRIPTROTATION (* ; + "Rotation value currently in effect.") + POSTSCRIPTPENDINGROTATION (* ; + "Rotation to take effect at next SETXFORM.") + POSTSCRIPTFONTSUSED (* ; "List of FONTIDs of the fonts that've been used before. This is used to control the re-encoding of fonts for accented-character rendering.") + (POSTSCRIPTNSCHARSET BYTE) (* ; + "Current NSCHARSET--widths are in POSTSCRIPTWIDTHS") + (POSTSCRIPTNATURALSPACEWIDTH WORD) (* ; + "Width of the space in the current font, used to compute the scaled space width.") + ) + POSTSCRIPTX _ 0 POSTSCRIPTY _ 0 POSTSCRIPTTRANSX _ 0 POSTSCRIPTTRANSY _ 0 + POSTSCRIPTSPACEFACTOR _ 1 POSTSCRIPTPAGENUM _ 0 POSTSCRIPTSCALEHACK _ 1 POSTSCRIPTTEMPARRAY + _ (ARRAY \PS.TEMPARRAYLEN 'BYTE 0 0) + POSTSCRIPTROTATION _ 0 POSTSCRIPTCOLOR _ 0.0) + +(RECORD POSTSCRIPTXFORM ( + (* ;; "Holds the transformation state as saved by DSPPUSHSTATE. Used by DSPPOPSTATE to restore the tranformation state.") + + PSXCLIP (* ; "Clipping region") + PSXPAGE (* ; "Page region") + PSXX (* ; "X position?") + PSXY (* ; "Y position?") + PSXLEFT (* ; "Left margin") + PSXRIGHT (* ; "Right margin") + PSXTOP (* ; "Top margin") + PSXBOTTOM (* ; "Bottom Margin") + PSXTRANX (* ; "X-translation in effect") + PSXTRANY (* ; "Y-translation in effect") + PSXLAND (* ; "Landscape?") + PSXXFORMPEND (* ; "Are there transforms pending? ") + )) +) + +(/DECLAREDATATYPE '\POSTSCRIPTDATA + '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + BYTE WORD) + '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) + (\POSTSCRIPTDATA 0 POINTER) + (\POSTSCRIPTDATA 2 POINTER) + (\POSTSCRIPTDATA 4 POINTER) + (\POSTSCRIPTDATA 6 POINTER) + (\POSTSCRIPTDATA 8 POINTER) + (\POSTSCRIPTDATA 10 POINTER) + (\POSTSCRIPTDATA 12 POINTER) + (\POSTSCRIPTDATA 14 POINTER) + (\POSTSCRIPTDATA 16 POINTER) + (\POSTSCRIPTDATA 18 POINTER) + (\POSTSCRIPTDATA 20 POINTER) + (\POSTSCRIPTDATA 22 POINTER) + (\POSTSCRIPTDATA 24 POINTER) + (\POSTSCRIPTDATA 26 POINTER) + (\POSTSCRIPTDATA 28 POINTER) + (\POSTSCRIPTDATA 30 POINTER) + (\POSTSCRIPTDATA 32 POINTER) + (\POSTSCRIPTDATA 34 POINTER) + (\POSTSCRIPTDATA 36 POINTER) + (\POSTSCRIPTDATA 38 POINTER) + (\POSTSCRIPTDATA 40 POINTER) + (\POSTSCRIPTDATA 42 POINTER) + (\POSTSCRIPTDATA 44 POINTER) + (\POSTSCRIPTDATA 46 POINTER) + (\POSTSCRIPTDATA 48 POINTER) + (\POSTSCRIPTDATA 50 POINTER) + (\POSTSCRIPTDATA 52 POINTER) + (\POSTSCRIPTDATA 54 POINTER) + (\POSTSCRIPTDATA 56 POINTER) + (\POSTSCRIPTDATA 58 POINTER) + (\POSTSCRIPTDATA 60 POINTER) + (\POSTSCRIPTDATA 62 POINTER) + (\POSTSCRIPTDATA 64 POINTER) + (\POSTSCRIPTDATA 66 (BITS . 7)) + (\POSTSCRIPTDATA 67 (BITS . 15))) + '68) +) + +(/DECLAREDATATYPE '\POSTSCRIPTDATA + '(FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + BYTE WORD) + '((\POSTSCRIPTDATA 0 (FLAGBITS . 0)) + (\POSTSCRIPTDATA 0 POINTER) + (\POSTSCRIPTDATA 2 POINTER) + (\POSTSCRIPTDATA 4 POINTER) + (\POSTSCRIPTDATA 6 POINTER) + (\POSTSCRIPTDATA 8 POINTER) + (\POSTSCRIPTDATA 10 POINTER) + (\POSTSCRIPTDATA 12 POINTER) + (\POSTSCRIPTDATA 14 POINTER) + (\POSTSCRIPTDATA 16 POINTER) + (\POSTSCRIPTDATA 18 POINTER) + (\POSTSCRIPTDATA 20 POINTER) + (\POSTSCRIPTDATA 22 POINTER) + (\POSTSCRIPTDATA 24 POINTER) + (\POSTSCRIPTDATA 26 POINTER) + (\POSTSCRIPTDATA 28 POINTER) + (\POSTSCRIPTDATA 30 POINTER) + (\POSTSCRIPTDATA 32 POINTER) + (\POSTSCRIPTDATA 34 POINTER) + (\POSTSCRIPTDATA 36 POINTER) + (\POSTSCRIPTDATA 38 POINTER) + (\POSTSCRIPTDATA 40 POINTER) + (\POSTSCRIPTDATA 42 POINTER) + (\POSTSCRIPTDATA 44 POINTER) + (\POSTSCRIPTDATA 46 POINTER) + (\POSTSCRIPTDATA 48 POINTER) + (\POSTSCRIPTDATA 50 POINTER) + (\POSTSCRIPTDATA 52 POINTER) + (\POSTSCRIPTDATA 54 POINTER) + (\POSTSCRIPTDATA 56 POINTER) + (\POSTSCRIPTDATA 58 POINTER) + (\POSTSCRIPTDATA 60 POINTER) + (\POSTSCRIPTDATA 62 POINTER) + (\POSTSCRIPTDATA 64 POINTER) + (\POSTSCRIPTDATA 66 (BITS . 7)) + (\POSTSCRIPTDATA 67 (BITS . 15))) + '68) +(DEFINEQ + +(POSTSCRIPT.INIT + [LAMBDA NIL (* ; "Edited 14-May-2018 10:48 by rmk:") + (* ; "Edited 4-Feb-93 21:08 by jds") + (DECLARE (GLOBALVARS \POSTSCRIPT.CHARTYPE)) + + (* ;; "Add POSTSCRIPT font descriptions to the active font profile.") + + [MAPC + [CL:REMOVE-DUPLICATES (NCONC (for FD in FONTDEFS + join (for FP in (CDR (ASSOC 'FONTPROFILE + (CDR FD))) + collect (CAR FP))) + '(FONT7 FONT6 FONT5 FONT4 FONT3 FONT2 FONT1 BOLDFONT LITTLEFONT + BIGFONT PRETTYCOMFONT COMMENTFONT USERFONT SYSTEMFONT + CLISPFONT LAMBDAFONT CHANGEFONT DEFAULTFONT] + (FUNCTION (LAMBDA (CLASS) + (LET + (COPYFD OLDPSCFD) + (if (BOUNDP CLASS) + then + (SETQ CLASS (EVALV CLASS)) + (if (TYPEP CLASS 'FONTCLASS) + then (SETQ COPYFD (OR (fetch (FONTCLASS INTERPRESSFD) of CLASS) + (fetch (FONTCLASS PRESSFD) of CLASS) + (fetch (FONTCLASS DISPLAYFD) of CLASS))) + (if (SETQ OLDPSCFD (ASSOC 'POSTSCRIPT (fetch (FONTCLASS + OTHERFDS) + of CLASS))) + then [if (NOT (CDR OLDPSCFD)) + then (RPLACD OLDPSCFD (if (LISTP COPYFD) + then COPYFD + else (FONTUNPARSE + COPYFD] + else (push (fetch (FONTCLASS OTHERFDS) of CLASS) + (CONS 'POSTSCRIPT (if (LISTP COPYFD) + then COPYFD + else (FONTUNPARSE COPYFD] + [FOR FD IN FONTDEFS + DO (FOR FP IN (CDR (ASSOC 'FONTPROFILE (CDR FD))) + DO (COND + ((ASSOC 'POSTSCRIPT (CL:NTHCDR 5 FP)) + + (* ;; "There's already a postscript spec, so leave it be.") + + ) + (T (NCONC1 FP `(POSTSCRIPT ,(OR (CL:FIFTH FP) + (CL:FOURTH FP) + (CL:THIRD FP] + + (* ;; "Eliminate any existing postscript fonts, to start with a clean slate if reinitializing.") + + (FOR FD IN (FONTSAVAILABLE '* '* '* '* 'POSTSCRIPT) + DO (APPLY (FUNCTION SETFONTDESCRIPTOR) + FD)) + (SETQ POSTSCRIPTFONTCACHE NIL) + (SETQ \POSTSCRIPT.CHARTYPE (CL:MAKE-ARRAY 256 :INITIAL-ELEMENT T)) + + (* ;; "\POSTSCRIPT.OUTCHARFN uses this array to quickly determine whether a character needs any special processing -- T means yes") + + (for x from (CHARCODE SP) to 126 unless (FMEMB x (CHARCODE (%( %) \))) + do (CL:SETF (CL:AREF \POSTSCRIPT.CHARTYPE x) + NIL)) + + (* ;; "RMK: Maybe the following is equivalent to alot of the stuff above??") + + (FONTPROFILE.ADDDEVICE 'POSTSCRIPT 'INTERPRESS) + (SETQ \POSTSCRIPTIMAGEOPS (create IMAGEOPS + IMAGETYPE _ 'POSTSCRIPT + IMCLOSEFN _ (FUNCTION CLOSEPOSTSCRIPTSTREAM) + IMXPOSITION _ (FUNCTION \DSPXPOSITION.PSC) + IMYPOSITION _ (FUNCTION \DSPYPOSITION.PSC) + IMMOVETO _ (FUNCTION \MOVETO.PSC) + IMFONT _ (FUNCTION \DSPFONT.PSC) + IMLEFTMARGIN _ (FUNCTION \DSPLEFTMARGIN.PSC) + IMRIGHTMARGIN _ (FUNCTION \DSPRIGHTMARGIN.PSC) + IMLINEFEED _ (FUNCTION \DSPLINEFEED.PSC) + IMDRAWLINE _ (FUNCTION \DRAWLINE.PSC) + IMDRAWCURVE _ (FUNCTION \DRAWCURVE.PSC) + IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.PSC) + IMDRAWELLIPSE _ (FUNCTION \DRAWELLIPSE.PSC) + IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.PSC) + IMBLTSHADE _ (FUNCTION \BLTSHADE.PSC) + IMBITBLT _ (FUNCTION \BITBLT.PSC) + IMSCALEDBITBLT _ (FUNCTION \SCALEDBITBLT.PSC) + IMNEWPAGE _ (FUNCTION \NEWPAGE.PSC) + IMSCALE _ (FUNCTION \DSPSCALE.PSC) + IMSCALE2 _ (FUNCTION \DSPSCALE2.PSC) + IMCOLOR _ (FUNCTION \DSPCOLOR.PSC) + IMTERPRI _ (FUNCTION \TERPRI.PSC) + IMTOPMARGIN _ (FUNCTION \DSPTOPMARGIN.PSC) + IMBOTTOMMARGIN _ (FUNCTION \DSPBOTTOMMARGIN.PSC) + IMSPACEFACTOR _ (FUNCTION \DSPSPACEFACTOR.PSC) + IMFONTCREATE _ 'POSTSCRIPT + IMCLIPPINGREGION _ (FUNCTION \DSPCLIPPINGREGION.PSC) + IMRESET _ (FUNCTION \DSPRESET.PSC) + IMDRAWPOLYGON _ (FUNCTION \DRAWPOLYGON.PSC) + IMFILLPOLYGON _ (FUNCTION \FILLPOLYGON.PSC) + IMSTRINGWIDTH _ (FUNCTION \STRINGWIDTH.PSC) + IMCHARWIDTH _ (FUNCTION \CHARWIDTH.PSC) + IMDRAWARC _ (FUNCTION \DRAWARC.PSC) + IMROTATE _ (FUNCTION \DSPROTATE.PSC) + IMTRANSLATE _ (FUNCTION \DSPTRANSLATE.PSC) + IMDRAWPOINT _ (FUNCTION \DRAWPOINT.PSC) + IMPUSHSTATE _ (FUNCTION \DSPPUSHSTATE.PSC) + IMPOPSTATE _ (FUNCTION \DSPPOPSTATE.PSC))) + (SETQ *POSTSCRIPT-NS-HASH* (HARRAY 255)) + (\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*]) +) + +(ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT) + (PSC . TEXT) + (PSF . BINARY) + (PSCFONT . BINARY) + (POSTSCRIPT . TEXT)) + +(ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) + (AVANTGARDE-DEMI . AD) + (BECKMAN . BM) + (BOOKMAN-LIGHT . BL) + (BOOKMAN-DEMI . BD) + (COURIER . CO) + (HELVETICA-NARROW . HN) + (NEWCENTURYSCHLBK . NC) + (PALATINO . PA) + (TIMES . TS) + (ZAPFCHANCERY-MEDIUM . ZM) + (ZAPFCHANCERY . ZC) + (ZAPFDINGBATS . ZD)) + + + +(* ;; "Font-reading code") + +(DEFINEQ + +(PSCFONT.READFONT + [LAMBDA (FONTFILENAME) (* ; "Edited 5-Oct-93 17:19 by rmk:") + (* ; "Edited 1-Sep-89 10:55 by jds") + + (* ;; "Read one of Matt Heffron's .PSC files, to get postscript font metrics. First check to see if incore cache as information indexed under the file's name.") + + (LET (FID W [S (OPENSTREAM FONTFILENAME 'INPUT NIL '((SEQUENTIAL T] + (PF (create PSCFONT))) + [replace (PSCFONT FID) of PF with (SETQ FID (READ S (FIND-READTABLE "INTERLISP"] + + (* ;; "Read until we hit a 255 byte, marking the end of the font-id section.") + + (CL:DO NIL + ((EQ (BIN S) + 255)) + + (* ;; "Body of the loop is empty, the test does all of the work") + + ) + (replace (PSCFONT IL-FONTID) of PF with (CAR FID)) + (replace (PSCFONT FIRSTCHAR) of PF with (\WIN S)) + (replace (PSCFONT LASTCHAR) of PF with (\WIN S)) + (replace (PSCFONT ASCENT) of PF with (\WIN S)) + (replace (PSCFONT DESCENT) of PF with (\WIN S)) + (replace (PSCFONT WIDTHS) of PF with (SETQ W (ARRAY 256 'SMALLPOSP 0 0))) + (for C from 0 to 255 do (SETA W C (\WIN S))) + (CLOSEF S) + + (* ;; + "PATCH JDS 9/1/89: The afm font reader made fonts too tall. This should fix things pro tem.") + + (replace (PSCFONT ASCENT) of PF with (- 1000 (fetch (PSCFONT DESCENT) + OF PF))) + (PUSH POSTSCRIPTFONTCACHE (CONS (L-CASE (FILENAMEFIELD FONTFILENAME 'NAME)) + (CREATE PSCFONT USING PF))) + PF]) + +(PSCFONT.SPELLFILE + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 5-Oct-93 22:15 by rmk:") + (* ; "Edited 5-Oct-92 15:23 by jds") + + (* ;; + "Find the font file for a postscript font. Does the display-name conversion as well, for DOS.") + + (CL:WHEN POSTSCRIPTFONTDIRECTORIES + (\FINDFONTFILE (OR (CDR (FASSOC FAMILY POSTSCRIPT.FONT.ALIST)) + FAMILY) + SIZE FACE 0 DEVICE 0 POSTSCRIPTFONTDIRECTORIES '(PSCFONT PF PSC)))]) + +(PSCFONT.COERCEFILE + [LAMBDA (FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION DEVICE) + (* ; "Edited 5-Oct-93 16:28 by rmk:") + + (* ;; +"This coerces the WEIGHT and SLOPE incrementally back to REGULAR in order to find a matching file.") + + (COND + ((AND (NEQ EXPANSION 'REGULAR) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT SLOPE 'REGULAR) + ROTATION DEVICE))) + ((AND (EQ SLOPE 'ITALIC) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ EXPANSION 'REGULAR) + (EQ SLOPE 'ITALIC) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR 'REGULAR) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (NEQ EXPANSION 'REGULAR) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE 'REGULAR) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (EQ SLOPE 'ITALIC) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (NEQ EXPANSION 'REGULAR) + (EQ SLOPE 'ITALIC) + (PSCFONT.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR 'REGULAR) + ROTATION DEVICE]) + +(PSCFONTFROMCACHE.SPELLFILE + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 5-Oct-93 17:54 by rmk:") + (* ; "Edited 5-Oct-92 15:23 by jds") + + (* ;; "Tries to find postscript font information in the cache, indexed by the name-field of the fontfile. ") + + (LET [(CACHE (CDR (ASSOC (L-CASE (FILENAMEFIELD (\FONTFILENAME (OR (CDR (FASSOC FAMILY + POSTSCRIPT.FONT.ALIST + )) + FAMILY) + SIZE FACE 'PSCFONT 0) + 'NAME)) + POSTSCRIPTFONTCACHE] + (IF CACHE + THEN (CREATE PSCFONT USING CACHE]) + +(PSCFONTFROMCACHE.COERCEFILE + [LAMBDA (FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION DEVICE) + (* ; "Edited 5-Oct-93 17:00 by rmk:") + + (* ;; "This coerces the WEIGHT and SLOPE incrementally back to REGULAR in order to find a matching font in the cache.") + + (COND + ((AND (NEQ EXPANSION 'REGULAR) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT SLOPE 'REGULAR) + ROTATION DEVICE))) + ((AND (EQ SLOPE 'ITALIC) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ EXPANSION 'REGULAR) + (EQ SLOPE 'ITALIC) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST WEIGHT 'REGULAR 'REGULAR) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (NEQ EXPANSION 'REGULAR) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM SLOPE 'REGULAR) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (EQ SLOPE 'ITALIC) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR EXPANSION) + ROTATION DEVICE))) + ((AND (NEQ WEIGHT 'MEDIUM) + (NEQ EXPANSION 'REGULAR) + (EQ SLOPE 'ITALIC) + (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE (LIST 'MEDIUM 'REGULAR 'REGULAR) + ROTATION DEVICE]) + +(PSCFONT.WRITEFONT + [LAMBDA (FONTFILENAME PF) (* ; + "Edited 5-Aug-93 16:28 by sybalskY:MV:ENVOS") + + (* ;; "Given a PSCFONT data structure, write it out as a properly-named xxx.PSCFONT file, for later reading.") + + NIL + (LET ([S (OPENSTREAM FONTFILENAME 'OUTPUT NIL '((TYPE BINARY) + (SEQUENTIAL T] + (W (fetch (PSCFONT WIDTHS) of PF)) + (*READTABLE* (FIND-READTABLE "INTERLISP"))) + (PRIN3 (fetch (PSCFONT FID) of PF) + S) + (BOUT S 0) + (BOUT S 255) + (\WOUT S (fetch (PSCFONT FIRSTCHAR) of PF)) + (\WOUT S (fetch (PSCFONT LASTCHAR) of PF)) + (\WOUT S (fetch (PSCFONT ASCENT) of PF)) + (\WOUT S (fetch (PSCFONT DESCENT) of PF)) + (for C from 0 to 255 do (\WOUT S (ELT W C))) + (CLOSEF S) + FONTFILENAME]) + +(READ-AFM-FILE + [LAMBDA (FILE BOLDNESS ITALICNESS) (* ; + "Edited 5-Aug-93 16:37 by sybalskY:MV:ENVOS") + + (* ;; + "Read an Adobe-version-3 AFM file, and extract the metrics from it for making a PSCFONT file.") + + (LET ((IFILE (OPENSTREAM FILE 'INPUT)) + (PSCFONT (create PSCFONT)) + (FCHAR 1000) + (LCHAR 0) + (W (ARRAY 256 'SMALLPOSP 0 0)) + TOKEN WEIGHT SLOPE HEIGHT CMCOUNT FBBOX) + (with PSCFONT PSCFONT (repeatuntil (STRING-EQUAL "FontName" (RSTRING IFILE)) + do (READCCODE IFILE)) + (repeatwhile (STRING-EQUAL "" (SETQ TOKEN (RSTRING IFILE))) + do (READCCODE IFILE)) + [COND + ((NOT (AND (BOUNDP 'WeightMenu) + (type? MENU WeightMenu))) + (SETQ WeightMenu (create MENU + ITEMS _ WeightMenuItems + MENUFONT _ (FONTCREATE 'HELVETICA 12] + [COND + ((NOT (AND (BOUNDP 'SlopeMenu) + (type? MENU SlopeMenu))) + (SETQ SlopeMenu (create MENU + ITEMS _ SlopeMenuItems + MENUFONT _ (FONTCREATE 'HELVETICA 12] + (OR (SETQ WEIGHT BOLDNESS) + (printout T T "Font WEIGHT for " PSCFONT ": " (SETQ WEIGHT (MENU WeightMenu)) + T)) + (OR (SETQ SLOPE ITALICNESS) + (printout T T "Font SLOPE for " PSCFONT ": " (SETQ SLOPE (MENU SlopeMenu)) + T)) + (SETQ FID (LIST TOKEN WEIGHT SLOPE 'REGULAR)) + [SETQ IL-FONTID (COND + ((AND (EQ SLOPE 'REGULAR) + (EQ WEIGHT 'MEDIUM)) + TOKEN) + (T (POSTSCRIPT.GETFONTID FID WEIGHT SLOPE 'REGULAR] + [repeatuntil (STRING-EQUAL "StartCharMetrics" TOKEN) + do (SETQ TOKEN (RSTRING IFILE)) + (COND + [(STRING-EQUAL "FontBBox" TOKEN) + (SETQ FBBOX (LIST (READ IFILE) + (READ IFILE) + (READ IFILE) + (READ IFILE))) + + (* ;; "The Ascender and Descender properties from the AFM file are currently ignored, and the values from the FontBBox are used, SCALED to the height of the font.") + + (SETQ DESCENT (IABS (CADR FBBOX))) + (SETQ ASCENT (CADDDR FBBOX)) + (SETQ HEIGHT (IPLUS ASCENT DESCENT)) + [SETQ DESCENT (FIXR (FTIMES DESCENT (/ 1000 HEIGHT] + (SETQ ASCENT (FIXR (FTIMES ASCENT (/ 1000 HEIGHT] + (T (READCCODE IFILE] + (SETQ CMCOUNT (RATOM IFILE)) + (repeatuntil (EQ (CHARCODE EOL) + (READCCODE IFILE)) do) + (SETQ WIDTHS W) + (for CC from 1 to CMCOUNT + do (LET (CCODE) + (repeatuntil (EQ 'C (RATOM IFILE)) do) + (SETQ CCODE (READ IFILE)) + (RATOMS 'WX IFILE) + (SETQ CWIDTH (READ IFILE)) + [COND + ((CL:PLUSP CCODE) (* ; + "This character appears in the standard encoding, so just use the charcode.") + (COND + ((ILESSP CCODE FCHAR) + (SETQ FCHAR CCODE))) + (COND + ((IGREATERP CCODE LCHAR) + (SETQ LCHAR CCODE))) + (SETA W CCODE CWIDTH)) + (T (* ; "A character not in the standard encoding; look it up to see if it's one we need (eth & thorn are brought into the CS-0 codespace for UToronto's work).") + (repeatuntil (EQ 'N (RATOM IFILE)) do + + (* ;; + "Skip to the N entry, which gives the Adobe-standard name.") +) + (SETQ CNAME (RATOM IFILE)) + (* ; "GET THE NAME") + (SETQ CCODE (LISTGET *POSTSCRIPT-EXTRA-CHARACTERS* CNAME)) + (COND + (CCODE (COND + ((ILESSP CCODE FCHAR) + (SETQ FCHAR CCODE))) + (COND + ((IGREATERP CCODE LCHAR) + (SETQ LCHAR CCODE))) + (SETA W CCODE CWIDTH] + (repeatuntil (EQ (CHARCODE EOL) + (READCCODE IFILE)) do))) + (SETQ FIRSTCHAR FCHAR) + (SETQ LASTCHAR LCHAR)) + (CLOSEF IFILE) + PSCFONT]) + +(CONVERT-AFM-FILES + [LAMBDA (FILE-LIST) (* ; + "Edited 5-Aug-93 16:47 by sybalskY:MV:ENVOS") + (for FL in FILE-LIST do (LET ((FNAME (pop FL)) + FONT FILENAME) + (for AFM-FILE in FL as WEIGHT + in '(MEDIUM MEDIUM BOLD BOLD) as SLOPE + in '(REGULAR ITALIC REGULAR ITALIC) + do (SETQ FONT (READ-AFM-FILE AFM-FILE WEIGHT + SLOPE)) + (SETQ FILENAME (\FONTFILENAME + FNAME 1 (LIST WEIGHT SLOPE + 'REGULAR) + 'PSCFONT 0)) + (PSCFONT.WRITEFONT FILENAME FONT]) + +(POSTSCRIPT.GETFONTID + [LAMBDA (FID WEIGHT SLOPE EXPANSION) (* ; + "Edited 20-Nov-92 15:04 by sybalsky:mv:envos") + (LET (FONTID) + (SETQ FONTID (create FONTID + FONTIDNAME _ (CAR FID) + FONTXFACTOR _ 1.0 + FONTOBLIQUEFACTOR _ 0.0)) + [if (AND (NEQ (CADDR FID) + SLOPE) + (EQ SLOPE 'ITALIC)) + then (replace (FONTID FONTOBLIQUEFACTOR) of FONTID + with (CONSTANT (TAN 7.0] + (if (AND (NEQ (CADR FID) + WEIGHT) + (EQ WEIGHT 'BOLD)) + then (* ; "Fake bold by slight expansion.") + (replace (FONTID FONTXFACTOR) of FONTID with 1.1)) + [if (NEQ EXPANSION 'REGULAR) + then (replace (FONTID FONTXFACTOR) of FONTID + with (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) + (if (EQ EXPANSION 'COMPRESSED) + then (CONSTANT (QUOTIENT 1.0 GOLDEN.RATIO)) + else GOLDEN.RATIO] + FONTID]) + +(POSTSCRIPT.FONTCREATE + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 29-Oct-93 16:39 by rmk:") + (* ; "Edited 3-Feb-93 17:22 by jds") + (LET (UNITFONT FULLNAME SCALEFONTP PSCFD ASCENT DESCENT FIXPWIDTHS PSCWIDTHSBLOCK WIDTHSBLOCK FD + FACECHANGED (WEIGHT (CAR FACE)) + (SLOPE (CADR FACE)) + (EXPANSION (CADDR FACE))) + + (* ;; + "Ignore rotations, it is **MUCH** easier to rotate the Postscript stream user space coordinates.") + + [COND + [(EQ SIZE 1) + + (* ;; "Since a 1 point font is ridiculously small, and it is the standard size for Postscript font info, a 1 point font is presumed to be the unit size Postscript font info") + + (COND + ((SETQ PSCFD (PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) + + (* ;; "Check in-core cache for exact match first") + + (SETQ FACECHANGED NIL)) + ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) + + (* ;; "Check file for exact match next") + + (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) + (SETQ FACECHANGED NIL)) + ((SETQ PSCFD (PSCFONTFROMCACHE.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION + ROTATION DEVICE)) + + (* ;; "Then check cache for coerced match") + + (SETQ FACECHANGED T)) + ((SETQ FULLNAME (PSCFONT.COERCEFILE FAMILY SIZE WEIGHT SLOPE EXPANSION ROTATION + DEVICE)) + + (* ;; "Check file for coerced match") + + (SETQ PSCFD (PSCFONT.READFONT FULLNAME)) + (SETQ FACECHANGED T))) + (COND + (PSCFD (SETQ ASCENT (FIXR (TIMES (fetch (PSCFONT ASCENT) of PSCFD) + 0.1))) + (SETQ DESCENT (FIXR (TIMES (fetch (PSCFONT DESCENT) of PSCFD) + 0.1))) + (COND + (FACECHANGED (replace (PSCFONT IL-FONTID) of PSCFD + with (POSTSCRIPT.GETFONTID (fetch (PSCFONT + FID) + of PSCFD) + WEIGHT SLOPE EXPANSION] + ((SETQ UNITFONT (FONTCREATE FAMILY 1 FACE ROTATION DEVICE T)) + (SETQ PSCFD (LISTGET (fetch (FONTDESCRIPTOR OTHERDEVICEFONTPROPS) of UNITFONT) + 'PSCFONT)) + + (* ;; "Scale the ASCENT and DESCENT") + + (SETQ ASCENT (FIXR (TIMES SIZE (fetch (PSCFONT ASCENT) of PSCFD) + 0.1))) + (SETQ DESCENT (FIXR (TIMES SIZE (fetch (PSCFONT DESCENT) of PSCFD) + 0.1))) + (SETQ SCALEFONTP T)) + (T + (* ;; "Here for fonts that only come in specific sizes. Their info is not scaled like built-in Postscript fonts, it is already correct for this pointsize.") + + (COND + ([SETQ PSCFD (COND + ((PSCFONTFROMCACHE.SPELLFILE FAMILY SIZE FACE ROTATION DEVICE)) + ((SETQ FULLNAME (PSCFONT.SPELLFILE FAMILY SIZE FACE ROTATION + DEVICE)) + (PSCFONT.READFONT FULLNAME] + (SETQ ASCENT (fetch (PSCFONT ASCENT) of PSCFD)) + (SETQ DESCENT (fetch (PSCFONT DESCENT) of PSCFD)) + (SETQ SCALEFONTP NIL] + (COND + (PSCFD + (* ;; "Set up the Charset descriptions and Widths vectors for character set 0:") + + (SETQ FD + (create FONTDESCRIPTOR + OTHERDEVICEFONTPROPS _ (LIST 'PSCFONT PSCFD) + FONTSCALE _ 100 + FONTDEVICE _ DEVICE + FONTFAMILY _ FAMILY + FONTSIZE _ SIZE + FONTFACE _ FACE + ROTATION _ 0 + \SFHeight _ (IPLUS ASCENT DESCENT) + \SFAscent _ ASCENT + \SFDescent _ DESCENT)) + (SETQ WIDTHSBLOCK (fetch (CHARSETINFO WIDTHS) of (\GETCHARSETINFO 0 FD))) + (SETQ FIXPWIDTHS (fetch (PSCFONT WIDTHS) of PSCFD)) + [COND + [SCALEFONTP (for CH from 0 to 255 + do (\FSETWIDTH WIDTHSBLOCK CH (FIXR (TIMES SIZE + (ELT FIXPWIDTHS + CH) + 0.1] + (T (for CH from 0 to 255 do (\FSETWIDTH WIDTHSBLOCK CH + (ELT FIXPWIDTHS CH] + (SETQ PSCWIDTHSBLOCK (\CREATECSINFOELEMENT)) + + (* ;; "PSCWIDTHSBLOCK preserves the scaled widths from the original postscript metrics, not the NS mapping of them, which goes into WIDTHSBLOCK.") + + (for CH from 0 to 255 do (\FSETWIDTH PSCWIDTHSBLOCK CH + (\FGETWIDTH WIDTHSBLOCK CH))) + [LET [(TMP (COND + (FULLNAME (\FONTINFOFROMFILENAME FULLNAME DEVICE)) + (UNITFONT (fetch FONTDEVICESPEC of UNITFONT] + + (* ;; "If face got coerced (possibly in recursive call for unit font) then set FONTDEVICESPEC to describe what we really got") + + (COND + ((AND TMP (NEQ FAMILY (CAR TMP))) + (replace FONTDEVICESPEC of FD with (LIST (CAR TMP) + SIZE + (COPY FACE) + 0 DEVICE] + [LET ((SYMWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'SYMBOL FD ROTATION + DEVICE)) + (DINGWIDTHS (\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 'ZAPFDINGBATS FD + ROTATION DEVICE))) + + (* ;; + "Now run thru the mapping table, filling in the new font from whatever source is specified:") + + [MAPHASH *POSTSCRIPT-NS-HASH* + (FUNCTION (LAMBDA (MAPPING CODE) + (DESTRUCTURING-BIND + (KIND CODE2 BASECHAR) + MAPPING + + (* ;; + "Depending on what kind of item it is, process it:") + + (SELECTQ KIND + (NIL + (* ;; + "Translating an NS character to a PSC char in CS 0.") + + (\FSETCHARWIDTH FD CODE (\FGETWIDTH + PSCWIDTHSBLOCK + (\CHAR8CODE + CODE2)))) + (SYMBOL [AND SYMWIDTHS (\FSETCHARWIDTH + FD CODE (ELT SYMWIDTHS + (\CHAR8CODE + CODE2]) + (DINGBAT [AND DINGWIDTHS (\FSETCHARWIDTH + FD CODE (ELT DINGWIDTHS + (\CHAR8CODE + CODE2]) + (FUNCTION + (* ;; + "This is fake and only works for the fractions. Need a better case.") + + [\FSETCHARWIDTH + FD CODE + (IPLUS (\FGETWIDTH PSCWIDTHSBLOCK 164) + (FIXR (FTIMES 1.3 + (\FGETWIDTH + PSCWIDTHSBLOCK + (CHARCODE 1]) + (ACCENT (* ; + "CODE2 is the rendering character but width comes from width of basechar") + (\FSETCHARWIDTH FD CODE (\FGETWIDTH + PSCWIDTHSBLOCK + BASECHAR))) + (ACCENTPAIR + + (* ;; "CODE2 and BASECHAR are overprinted, width is taken from CODE2 (the real character), basechar is the accent") + + (\FSETCHARWIDTH FD CODE (\FGETWIDTH + PSCWIDTHSBLOCK + CODE2))) + (PROGN + + (* ;; "Skip APPLY*'s on this pass, waiting until normal characters get set up, so that widths of other NS characters are available. Also skip anything else") + + NIL] + + (* ;; "Now do APPLY*'s. MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN). WIDTHFN gets applied to FD and DATA (coerced by INITFN)") + + (MAPHASH *POSTSCRIPT-NS-HASH* (FUNCTION (LAMBDA (MAPPING CODE) + (CL:WHEN (EQ (CAR MAPPING) + 'APPLY*) + (\FSETCHARWIDTH + FD CODE (APPLY* (CADDDR + MAPPING + ) + FD + (CADR MAPPING)) + ))] + FD) + (T NIL]) + +(\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS + [LAMBDA (TYPE FD ROTATION DEVICE) (* ; "Edited 5-Oct-93 18:21 by rmk:") + + (* ;; "Returns the scaled widths for a unit font of type TYPE (SYMBOL or ZAPFDINGBATS) compatible with FD. A separate function so that the unit widths can be easily cached.") + + (LET [TYPEFONT WIDTHS NEWWIDTHS (SIZE (FETCH FONTSIZE OF FD)) + (FONTFILE (OR (PSCFONT.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR FONTFACE) + OF FD) + ROTATION DEVICE) + (PSCFONT.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) + ROTATION DEVICE] + [SETQ TYPEFONT (COND + ((PSCFONTFROMCACHE.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR + FONTFACE) + OF FD) + ROTATION DEVICE)) + ((SETQ FONTFILE (PSCFONT.SPELLFILE TYPE 1 (FETCH (FONTDESCRIPTOR + FONTFACE) + OF FD) + ROTATION DEVICE)) + (PSCFONT.READFONT FONTFILE)) + ((PSCFONTFROMCACHE.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) + ROTATION DEVICE)) + ((SETQ FONTFILE (PSCFONT.SPELLFILE 'SYMBOL 1 '(MEDIUM REGULAR REGULAR) + ROTATION DEVICE)) + (PSCFONT.READFONT FONTFILE] + (CL:WHEN (AND TYPEFONT (SETQ WIDTHS (FETCH (PSCFONT WIDTHS) OF TYPEFONT))) + (SETQ NEWWIDTHS (ARRAY 256 'SMALLPOSP 0 0)) + + (* ;; "Have to copy because of scaling") + + [FOR CH FROM 0 TO 255 DO (SETA NEWWIDTHS CH + (FIXR (TIMES SIZE (ELT WIDTHS CH) + 0.1] + NEWWIDTHS)]) + +(POSTSCRIPT.FONTSAVAILABLE + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 12-Jan-88 13:04 by Matt Heffron") + + (* ;; "the filtering code was borrowed from Richard Burton's \SEARCHINTERPRESSFONTS. Note that without it [HELVETICA * (MEDIUM REGULAR REGULAR)] would pick up [HELVETICA-NARROW * (MEDIUM REGULAR REGULAR)] as well.") + + (LET + ((PATTERN (\FONTFILENAME (OR (CDR (ASSOC FAMILY POSTSCRIPT.FONT.ALIST)) + FAMILY) + SIZE FACE 'PSCFONT)) + [INVERSE.ALIST (for PAIR in POSTSCRIPT.FONT.ALIST collect (CONS (CDR PAIR) + (CAR PAIR] + FONTSAVAILABLE) + (SETQ FONTSAVAILABLE + (for FD in [for DIRECTORY in POSTSCRIPTFONTDIRECTORIES + join (for FILE in (DIRECTORY (CONCAT DIRECTORY PATTERN)) + collect (LET* ((RAWFD (\FONTINFOFROMFILENAME FILE DEVICE) + ) + (RAWNAME (CAR RAWFD))) + (RPLACA RAWFD + (OR (CDR (ASSOC RAWNAME + INVERSE.ALIST)) + RAWNAME] + when (AND (OR (EQ FAMILY '*) + (EQ FAMILY (CAR FD))) + (OR (EQ SIZE '*) + (EQ SIZE (CADR FD)) + (EQ (CADR FD) + 1)) + (OR (EQ FACE '*) + (EQUAL FACE (CADDR FD)) + (EQUAL [CDR (ASSOC FACE '((MRR MEDIUM REGULAR REGULAR) + (STANDARD MEDIUM REGULAR REGULAR) + (MIR MEDIUM ITALIC REGULAR) + (ITALIC MEDIUM ITALIC REGULAR) + (BRR BOLD REGULAR REGULAR) + (BOLD BOLD REGULAR REGULAR) + (BIR BOLD ITALIC REGULAR) + (BOLDITALIC BOLD ITALIC REGULAR] + (CADDR FD))) + (NOT (MEMBER FD $$VAL))) collect FD)) + (if (EQ SIZE '*) + then + +(* ;;; "If SIZE was wildcarded, then provide list of pointsizes for Postscript scaled fonts (those with a 1 point descriptor file)") + + (for FD in FONTSAVAILABLE + join (if (EQ 1 (CADR FD)) + then (CONS FD (for NF + in (for S from 2 to + \POSTSCRIPT.MAX.WILD.FONTSIZE + collect (LET ((NFD (COPY FD))) + (RPLACA (CDR NFD) + S) + NFD)) + unless (MEMBER NF FONTSAVAILABLE) collect + NF)) + else (LIST FD))) + else FONTSAVAILABLE]) +) + + + +(* ;; "Until macro in FONT is exported") + +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \FSETCHARWIDTH MACRO (OPENLAMBDA (FONTDESC CHARCODE WIDTH) + (\FSETWIDTH (ffetch (CHARSETINFO WIDTHS) + of (\GETCHARSETINFO (\CHARSET CHARCODE) + FONTDESC)) + (\CHAR8CODE CHARCODE) + WIDTH))) +) +(DEFINEQ + +(OPENPOSTSCRIPTSTREAM + [LAMBDA (FILE OPTIONS) (* ; "Edited 12-Jun-2021 19:14 by rmk:") + (* ; + "Edited 31-May-93 12:42 by sybalsky:mv:envos") + (* ; "Edited 23-Dec-92 01:17 by jds") + + (* ;; "RMK: Note: At open, this does a lot of printing using generic functions which invoke the generic \OUTCHARFN of the stream. We set that up as BOUT. But after the stream is open, we install the \POSTSCRIPT.OUTCHARFN, below. We also have to make sure that other internal printing that may want to use generic functions (PRIN1, PRIN3...) for convenience, doesn't cycle through the postscript outcharfn.") + + (LET [[STREAM (OPENSTREAM (PACKFILENAME 'BODY FILE 'EXTENSION 'PS) + 'OUTPUT NIL `((TYPE ,*POSTSCRIPT-FILE-TYPE*) + (SEQUENTIAL T] + (IMAGEDATA (create \POSTSCRIPTDATA)) + PAPER IMAGESIZEFACTOR CLIP REG (BBOX (LISTGET OPTIONS 'BOUNDINGBOX] + (replace (STREAM IMAGEDATA) of STREAM with IMAGEDATA) + (replace (STREAM IMAGEOPS) of STREAM with \POSTSCRIPTIMAGEOPS) + (replace (STREAM OUTCHARFN) OF STREAM WITH (FUNCTION BOUT)) + + (* ;; "Bounding box is for encapsulated postscript. The bounding box is in Medley's postscript-coordinate system, so we have to scale it back to default postscript since it will be interpreted outside of the operators specified below. CEIL and FLOOR to make sure that we don't leave anything out. We may also want to change the header to have the EPSF qualifier") + + (printout STREAM "%%!PS-Adobe-2.0" T %# (CL:WHEN BBOX + (PRINTOUT STREAM "%%%%BoundingBox: " + (CL:FLOOR (CAR BBOX) + \PS.SCALE0) + " " + (CL:FLOOR (CADR BBOX) + \PS.SCALE0) + " " + (CL:CEILING (CADDR BBOX) + \PS.SCALE0) + " " + (CL:CEILING (CADDDR BBOX) + \PS.SCALE0) + T)) + "%%%%Title: " + (MKSTRING (OR (LISTGET OPTIONS 'DOCUMENT.NAME) + FILE)) + T "%%%%Creator: PostScript Driver Copyright (C) 1988-1992 Venue and others" T + "%%%%CreationDate: " (DATE) + T %# (COND + ((EQ 'LPT (FILENAMEFIELD STREAM 'HOST)) + + (* ;; "Put current user's name on break page only if going to LPT for immediate printing. Presumably the print-spooler itself should know what the user's system login-name is, but that may not be the case for all printers in all environments.") + + (PRINTOUT NIL "%%%%For: " (MKSTRING USERNAME) + T))) + "%%%%EndComments" T) + (for X in \POSTSCRIPT.JOB.SETUP do (POSTSCRIPT.OUTSTR STREAM X) + (\BOUTEOL STREAM)) + (SETQ PAPER (OR (CDR (CL:ASSOC (SETQ PAPER (OR (LISTGET OPTIONS 'PAGETYPE) + (LISTGET OPTIONS 'PAPERTYPE) + POSTSCRIPT.PAGETYPE)) + POSTSCRIPT.PAGEREGIONS :TEST #'STRING-EQUAL)) + (ERROR "Unknown PostScript page type" PAPER))) + + (* ;; "Set the paper size:") + + (PRINTOUT STREAM (L-CASE (OR (LISTGET OPTIONS 'PAGETYPE) + (LISTGET OPTIONS 'PAPERTYPE) + POSTSCRIPT.PAGETYPE)) + T) + (COND + ((NOT (AND [SETQ IMAGESIZEFACTOR (NUMBERP (LISTGET OPTIONS 'IMAGESIZEFACTOR] + (CL:PLUSP IMAGESIZEFACTOR))) + (SETQ IMAGESIZEFACTOR 1))) + [COND + ((AND (NUMBERP POSTSCRIPT.IMAGESIZEFACTOR) + (CL:PLUSP POSTSCRIPT.IMAGESIZEFACTOR)) + (SETQ IMAGESIZEFACTOR (TIMES IMAGESIZEFACTOR POSTSCRIPT.IMAGESIZEFACTOR] + (printout STREAM "/imagesizefactor " IMAGESIZEFACTOR " def" T) + (printout STREAM "%%%%EndSetup" T) + (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with \PS.SCALE0) + (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA + with (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) + IMAGESIZEFACTOR) + (CAR PAPER))) + + (* ;; + "Initial clipping region can be specified separately from the page size, default is to page size.") + + [replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA + with (SETQ CLIP (\PS.SCALEREGION (/ (TIMES 72 \PS.SCALE0) + IMAGESIZEFACTOR) + (OR (CADR PAPER) + (CAR PAPER] + + (* ;; "If a REGION parameter was supplied, it establishes the initial margins.") + + (SETQ REG (OR (AND (SETQ REG (LISTGET OPTIONS 'REGION)) + (INTERSECTREGIONS REG CLIP)) + (CREATEREGION 3600 3600 54000 72000))) + (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA + with (fetch (REGION LEFT) of REG)) + (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA + with (fetch (REGION BOTTOM) of REG)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA + with (PLUS (fetch (REGION BOTTOM) of REG) + (fetch (REGION HEIGHT) of REG) + -1)) + (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA + with (PLUS (fetch (REGION LEFT) of REG) + (fetch (REGION WIDTH) of REG) + -1)) + (\DSPFONT.PSC STREAM (FONTCREATE (OR [CAR (MKLIST (LISTGET OPTIONS 'FONTS] + DEFAULTFONT) + NIL NIL NIL STREAM)) + (\SWITCHFONTS.PSC STREAM IMAGEDATA) + [COND + ((replace (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA + with (LISTGET OPTIONS 'HEADING)) + (replace (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) of IMAGEDATA + with (COND + ((LISTGET OPTIONS 'HEADINGFONT) + (FONTCREATE (LISTGET OPTIONS 'HEADINGFONT) + NIL NIL NIL STREAM)) + (T (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA] + + (* ;; "Decide if it's landscape: if (LANDSCAPE T) appears in OPTIONS, it is. IF ROTATION isn't DEFAULT, it is.") + + (COND + ([COND + ((CL:GETF OPTIONS 'LANDSCAPE NIL)) + ((EQL (CL:GETF OPTIONS 'ROTATION 'DEFAULT) + 'DEFAULT) + (COND + ((EQL POSTSCRIPT.PREFER.LANDSCAPE 'ASK) + (MENU \POSTSCRIPT.ORIENTATION.MENU)) + (T POSTSCRIPT.PREFER.LANDSCAPE))) + (T (CL:GETF OPTIONS 'ROTATION] + (POSTSCRIPT.SET-FAKE-LANDSCAPE STREAM 90))) + + (* ;; "Now we are ready for callers to use generic functions--see note above. The special external format ensures that e.g. COPYCHARS won't do COPYBYTES when copying from a text file to a PS stream.") + + (\EXTERNALFORMAT STREAM (CREATE EXTERNALFORMAT + NAME _ 'POSTSCRIPT + OUTCHARFN _ (FUNCTION \POSTSCRIPT.OUTCHARFN) + EOL _ (FETCH (STREAM EOLCONVENTION) OF STREAM))) + (POSTSCRIPT.STARTPAGE STREAM) + STREAM]) + +(CLOSEPOSTSCRIPTSTREAM + [LAMBDA (STREAM) (* ; "Edited 8-Mar-93 10:31 by jds") + (POSTSCRIPT.ENDPAGE STREAM) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Trailer" :EOL) + (* BOUT STREAM (CHARCODE ^D)) + ]) +) + +(RPAQ? *POSTSCRIPT-FILE-TYPE* 'BINARY) +(DEFINEQ + +(POSTSCRIPT.HARDCOPYW + [LAMBDA (FILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (ALLOW.BUTTON.EVENTS) + (LET* ((STREAM (OPENPOSTSCRIPTSTREAM FILE (LIST 'DOCUMENT.NAME TITLE 'ROTATION Landscape? + 'IMAGESIZEFACTOR SCALEFACTOR))) + (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (SCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA)) + SCALE) + [COND + [REGION (SETQ REGION (COPY REGION)) (* ; "In case we need to change it.") + [COND + ((< (fetch BITMAPWIDTH of BITMAP) + (+ (fetch (REGION LEFT) of REGION) + (fetch (REGION WIDTH) of REGION))) + (replace (REGION WIDTH) of REGION with (- (fetch BITMAPWIDTH + of BITMAP) + (fetch (REGION + LEFT) + of REGION] + (COND + ((< (fetch BITMAPHEIGHT of BITMAP) + (+ (fetch (REGION BOTTOM) of REGION) + (fetch (REGION HEIGHT) of REGION))) + (replace (REGION HEIGHT) of REGION + with (- (fetch BITMAPHEIGHT of BITMAP) + (fetch (REGION BOTTOM) of REGION] + (T (SETQ REGION (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (fetch BITMAPWIDTH of BITMAP) + HEIGHT _ (fetch BITMAPHEIGHT of BITMAP] + (SETQ SCALE (TIMES POSTSCRIPT.BITMAP.SCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) + of IMAGEDATA))) + (BITBLT BITMAP (fetch (REGION LEFT) of REGION) + (fetch (REGION BOTTOM) of REGION) + STREAM + (PLUS (fetch (REGION LEFT) of SCLIP) + (QUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of SCLIP) + (TIMES SCALE (fetch (REGION WIDTH) of REGION))) + 2)) + (PLUS (fetch (REGION BOTTOM) of SCLIP) + (QUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of SCLIP) + (TIMES SCALE (fetch (REGION HEIGHT) of REGION))) + 2)) + (fetch (REGION WIDTH) of REGION) + (fetch (REGION HEIGHT) of REGION) + 'INPUT + 'REPLACE) + (CLOSEF STREAM) + (FULLNAME STREAM]) + +(POSTSCRIPT.TEDIT + [LAMBDA (FILE PFILE) (* ; "Edited 18-Sep-91 18:16 by jds") + + (* ;; "Make a PS file from a TEdit document. If FILE is a string, make it into a symbol for the file-name. If it's a STREAM, use that stream.") + + [COND + ((STRINGP FILE) + (SETQ FILE (MKATOM FILE] + (SETQ FILE (OPENTEXTSTREAM FILE)) + (TEDIT.FORMAT.HARDCOPY FILE PFILE T NIL NIL NIL 'POSTSCRIPT) + (CLOSEF? FILE) + PFILE]) + +(POSTSCRIPT.TEXT + [LAMBDA (FILE PSCFILE FONTS HEADING TABS) (* ; "Edited 23-Apr-89 11:31 by TAL") + (TEXTTOIMAGEFILE FILE PSCFILE 'POSTSCRIPT FONTS HEADING TABS + `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION ROTATION ,(NOT (NOT POSTSCRIPT.TEXTFILE.LANDSCAPE]) + +(POSTSCRIPTFILEP + [LAMBDA (FILE) (* ; "Edited 5-Mar-93 21:40 by rmk:") + (* ; "Edited 14-Jan-93 10:56 by jds") + (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) + '("PS" "PSC" "PSF") + :TEST + (FUNCTION STRING-EQUAL)) + (PROGN (SETFILEPTR FILE 0) + (PROG1 (AND (EQ (BIN FILE) + (CHARCODE %%)) + (EQ (BIN FILE) + (CHARCODE !))) + (SETFILEPTR FILE 0]) + +(MAKEEPSFILE + [LAMBDA (IMAGEOBJ FILENAME) (* ; "Edited 7-Apr-94 14:48 by rmk:") + + (* ;; "Puts IMAGEOBJ on a 1-page encapsulated postscript file. The lower-left corner of the image box will be at 0,0 on the page.") + + (LET* [(STREAM (OPENIMAGESTREAM `{NODIRCORE}SCRATCH 'POSTSCRIPT)) + (IMAGEBOX (APPLY* (IMAGEOBJPROP IMAGEOBJ 'IMAGEBOXFN) + IMAGEOBJ STREAM)) + (BOUNDINGBOX (LIST 0 0 (FETCH XSIZE OF IMAGEBOX) + (FETCH YSIZE OF IMAGEBOX] + [SETQ STREAM (OPENIMAGESTREAM FILENAME 'POSTSCRIPT + `(BOUNDINGBOX (0 0 ,(FETCH XSIZE OF IMAGEBOX) + ,(FETCH YSIZE OF IMAGEBOX] + (MOVETO (FETCH XKERN OF IMAGEBOX) + (FETCH YDESC OF IMAGEBOX) + STREAM) + (APPLY* (IMAGEOBJPROP IMAGEOBJ 'DISPLAYFN) + IMAGEOBJ STREAM) + (CLOSEF STREAM]) +) +(DEFINEQ + +(POSTSCRIPT.BITMAPSCALE + [LAMBDA (WIDTH HEIGHT) (* ; "Edited 29-Apr-98 08:46 by rmk:") + (* ; + "Edited 20-Nov-92 14:52 by sybalsky:mv:envos") + (LET* ([PAGEREGION (\PS.SCALEREGION (/ 72 POSTSCRIPT.BITMAP.SCALE) + (CADR (FASSOC POSTSCRIPT.PAGETYPE POSTSCRIPT.PAGEREGIONS] + (LONGEDGE (MAX (fetch (REGION WIDTH) of PAGEREGION) + (fetch (REGION HEIGHT) of PAGEREGION))) + (SHORTEDGE (MIN (fetch (REGION WIDTH) of PAGEREGION) + (fetch (REGION HEIGHT) of PAGEREGION))) + [MINDIMP (MIN (FQUOTIENT LONGEDGE (SETQ HEIGHT (TIMES HEIGHT POSTSCRIPT.BITMAP.SCALE))) + (FQUOTIENT SHORTEDGE (SETQ WIDTH (TIMES WIDTH POSTSCRIPT.BITMAP.SCALE] + (MINDIML (MIN (FQUOTIENT SHORTEDGE HEIGHT) + (FQUOTIENT LONGEDGE WIDTH))) + (PPL (if (EQ POSTSCRIPT.PREFER.LANDSCAPE 'ASK) + then (MENU \POSTSCRIPT.ORIENTATION.MENU) + else POSTSCRIPT.PREFER.LANDSCAPE)) + MINDIM OTHERDIM SF1 SF2) + (if PPL + then (SETQ MINDIM MINDIML) + (SETQ OTHERDIM MINDIMP) + else (SETQ MINDIM MINDIMP) + (SETQ OTHERDIM MINDIML)) + (SETQ SF1 (if (GREATERP MINDIM 1) + then 1 + elseif (GREATERP MINDIM 0.75) + then 0.75 + elseif (GREATERP MINDIM 0.5) + then 0.5 + elseif (GREATERP MINDIM 0.25) + then 0.25 + else MINDIM)) + (SETQ SF2 (if (GREATERP OTHERDIM 1) + then 1 + elseif (GREATERP OTHERDIM 0.75) + then 0.75 + elseif (GREATERP OTHERDIM 0.5) + then 0.5 + elseif (GREATERP OTHERDIM 0.25) + then 0.25 + else OTHERDIM)) + (if (AND (LESSP SF1 1) + (LESSP SF1 SF2)) + then (CONS SF2 (NOT PPL)) + else (CONS SF1 PPL]) + +(POSTSCRIPT.CLOSESTRING + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (COND + ((fetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (POSTSCRIPT.OUTSTR STREAM ") ") + (replace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL) + T) + (T NIL]) + +(POSTSCRIPT.ENDPAGE + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (POSTSCRIPT.SHOWACCUM STREAM) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) + (COND + ((NOT (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA) + (POSTSCRIPT.PUTCOMMAND STREAM "grestore savepage restore "))) + (POSTSCRIPT.PUTCOMMAND STREAM "showpage" :EOL))) + + (* ;; +"Force re-encoding of fonts, because the restore wipes out any you encoded while writing this page.") + + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of IMAGEDATA with NIL]) + +(POSTSCRIPT.OUTSTR + [LAMBDA (STREAM X) (* ; "Edited 14-Jul-89 14:05 by Matt Heffron") + (DECLARE (LOCALVARS . T)) + (COND + ((FIXP X) (* ; "Common case, speed helps") + (\PS.BOUTFIXP STREAM X)) + [(STRINGP X) (* ; "Other common case") + (COND + [(ffetch (STRINGP FATSTRINGP) of X) + (for c infatstring X do (BOUT STREAM (\CHAR8CODE c] + (T (\BOUTS STREAM (ffetch (STRINGP BASE) of X) + (ffetch (STRINGP OFFST) of X) + (ffetch (STRINGP LENGTH) of X] + [(LITATOM X) + (for c inatom X do (BOUT STREAM (\CHAR8CODE c] + ((ZEROP X) + (BOUT STREAM (CHARCODE 0))) + (T [COND + ((TYPEP X 'RATIO) + (SETQ X (FLOAT X] + (for c in (CHCON X) do (BOUT STREAM (\CHAR8CODE c]) + +(POSTSCRIPT.PUTBITMAPBYTES + [LAMBDA (STREAM BITMAP DELIMFLG) + (DECLARE (GLOBALVARS PS.BITMAPARRAY) + (LOCALVARS . T)) (* ; "Edited 12-Jun-2021 15:17 by rmk:") + (LET* + ((WIDTH (fetch BITMAPWIDTH of BITMAP)) + (HEIGHT (fetch BITMAPHEIGHT of BITMAP)) + (BMBASE (fetch BITMAPBASE of BITMAP)) + (BYTESPERROW (LRSH (IPLUS WIDTH 7) + 3)) + (BYTEOFFSETPERROW (LSH (fetch BITMAPRASTERWIDTH of BITMAP) + 1)) + (PS.BITMAPARRAYBASE (fetch (ARRAYP BASE) of PS.BITMAPARRAY))) + (COND + (DELIMFLG (LET ((POS 0) + BYTE) + (BOUT STREAM (CHARCODE SPACE)) + (BOUT STREAM (CHARCODE <)) + (\BOUTEOL STREAM) + (for R from (SUB1 HEIGHT) to 0 by -1 as ROWOFFSET + from (ITIMES (SUB1 HEIGHT) + BYTEOFFSETPERROW) by (IMINUS BYTEOFFSETPERROW) + do (for B from 1 to BYTESPERROW as BYTEOFFSET + from ROWOFFSET by 1 + do (COND + ((IGEQ POS 254) + (\BOUTEOL STREAM) + (SETQ POS 0))) + (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) + [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH BYTE 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 BYTE))) + (SETQ POS (IPLUS POS 2))) + (\BOUTEOL STREAM) + (SETQ POS 0)) + (BOUT STREAM (CHARCODE SPACE)) + (BOUT STREAM (CHARCODE >)) + (\BOUTEOL STREAM))) + (T + (LET* + ((PRVBM (BITMAPCREATE WIDTH 1)) + (PRVBASE (fetch BITMAPBASE of PRVBM))) + (for R from 0 to (SUB1 HEIGHT) as ROWOFFSET + from (ITIMES (SUB1 HEIGHT) + BYTEOFFSETPERROW) by (IMINUS BYTEOFFSETPERROW) + do + (LET ((POS 0) + (BYTEOFFSET ROWOFFSET) + (B 1) + (PRVO 0) + BYTE REPC) + [while (ILEQ B BYTESPERROW) + do (SETQ REPC + (for BB from B to BYTESPERROW as BO from BYTEOFFSET + by 1 as PO from PRVO by 1 + while (EQ (\GETBASEBYTE BMBASE BO) + (\GETBASEBYTE PRVBASE PO)) count T)) + (COND + [(IGEQ REPC 3) + (SETQ B (IPLUS B REPC)) + (SETQ BYTEOFFSET (IPLUS BYTEOFFSET REPC)) + (SETQ PRVO (IPLUS PRVO REPC)) + (while (CL:PLUSP (SETQ REPC (IDIFFERENCE REPC 1))) + do (COND + ((IGEQ POS 251) + (\BOUTEOL STREAM) + (SETQ POS 0))) + (BOUT STREAM (CHARCODE B)) + (BOUT STREAM (CHARCODE 3)) + [COND + ((IGEQ REPC 256) + (BOUT STREAM (CHARCODE F)) + (BOUT STREAM (CHARCODE F))) + (T [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH REPC 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 REPC] + (SETQ REPC (IDIFFERENCE REPC 256)) + (SETQ POS (IPLUS POS 4] + (T (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) + (SETQ REPC + (for BB from B to BYTESPERROW as BO from + BYTEOFFSET + by 1 while (EQ (\GETBASEBYTE BMBASE BO) + BYTE) count T)) + (COND + [(IGEQ REPC 3) + (SETQ B (IPLUS B REPC)) + (SETQ BYTEOFFSET (IPLUS BYTEOFFSET REPC)) + (SETQ PRVO (IPLUS PRVO REPC)) + (while (CL:PLUSP (SETQ REPC (IDIFFERENCE REPC 1))) + do (COND + ((IGEQ POS 249) + (\BOUTEOL STREAM) + (SETQ POS 0))) + (BOUT STREAM (CHARCODE B)) + (BOUT STREAM (CHARCODE 2)) + [COND + ((IGEQ REPC 256) + (BOUT STREAM (CHARCODE F)) + (BOUT STREAM (CHARCODE F))) + (T [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH REPC 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 REPC] + [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH BYTE 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 BYTE))) + (SETQ REPC (IDIFFERENCE REPC 256)) + (SETQ POS (IPLUS POS 4] + (T (SETQ BYTE (\GETBASEBYTE BMBASE BYTEOFFSET)) + (COND + ((IGEQ POS 251) + (\BOUTEOL STREAM) + (SETQ POS 0))) + [COND + ((FMEMB BYTE '(178 179 180)) + + (* ;; "BYTE is B2, B3, or B4; quote it") + + (BOUT STREAM (CHARCODE B)) + (BOUT STREAM (CHARCODE 4)) + (SETQ POS (IPLUS POS 2] + [BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE + (LOGAND 15 (LRSH BYTE 4] + (BOUT STREAM (\GETBASEBYTE PS.BITMAPARRAYBASE (LOGAND 15 BYTE) + )) + (SETQ B (IPLUS B 1)) + (SETQ BYTEOFFSET (IPLUS BYTEOFFSET 1)) + (SETQ PRVO (IPLUS PRVO 1)) + (SETQ POS (IPLUS POS 2] + (\BOUTEOL STREAM)) + (\MOVEBYTES BMBASE ROWOFFSET PRVBASE 0 BYTESPERROW]) + +(POSTSCRIPT.PUTCOMMAND + [LAMBDA S.STRS (* ; "Edited 12-Jun-2021 15:14 by rmk:") + (LET* ((STREAM (ARG S.STRS 1)) + (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + S#S) + (freplace (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA with NIL) + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (POSTSCRIPT.SHOWACCUM STREAM))) + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) + (\SETXFORM.PSC STREAM IMAGEDATA))) + (for STR# from 2 to S.STRS do (COND + ((EQ (SETQ S#S (ARG S.STRS STR#)) + :EOL) + (\BOUTEOL STREAM)) + (T (POSTSCRIPT.OUTSTR STREAM S#S]) + +(POSTSCRIPT.SET-FAKE-LANDSCAPE + [LAMBDA (STREAM ROTATION) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + + (* ;; "Set up for (or disable) fake landscaping") + + (* ;; + "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") + + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLAND (COND + ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) + 90) + (T 0))) + LAND C0 P0 C P ML MB MR MT) + (COND + ((AND ROTATION (NEQ (SETQ LAND (NOT (ZEROP ROTATION))) + (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA))) + (POSTSCRIPT.SHOWACCUM STREAM) + (\DSPTRANSLATE.PSC STREAM 0 0) + (SETQ C0 (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA)) + (SETQ P0 (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA)) + (SETQ C (create REGION + WIDTH _ (fetch (REGION HEIGHT) of C0) + HEIGHT _ (fetch (REGION WIDTH) of C0))) + (SETQ P (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (fetch (REGION HEIGHT) of P0) + HEIGHT _ (fetch (REGION WIDTH) of P0))) + [COND + (LAND (replace (REGION LEFT) of C with (fetch (REGION BOTTOM) + of C0)) + [replace (REGION BOTTOM) of C with + (- (fetch (REGION WIDTH) + of P0) + (+ (fetch (REGION LEFT) + of C0) + (fetch (REGION WIDTH) + of C0] + (SETQ ML (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + ) + (SETQ MB (- (fetch (REGION WIDTH) of P0) + (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of + IMAGEDATA + ) + 1)) + (SETQ MR (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA)) + (SETQ MT (- (fetch (REGION WIDTH) of P0) + (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA + ) + 1))) + (T [replace (REGION LEFT) of C with (- (fetch (REGION HEIGHT) + of P0) + (+ (fetch (REGION BOTTOM) + of C0) + (fetch (REGION HEIGHT) + of C0] + (replace (REGION BOTTOM) of C with (fetch (REGION LEFT) + of C0)) + (SETQ ML (- (fetch (REGION HEIGHT) of P0) + (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + 1)) + (SETQ MB (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA)) + (SETQ MR (- (fetch (REGION HEIGHT) of P0) + (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + 1)) + (SETQ MT (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA] + (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with + C) + (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA with P) + (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA with ML) + (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA with MB) + (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA with MR) + (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA with MT) + (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA with LAND) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) + (\DSPRESET.PSC STREAM))) + OLAND]) + +(POSTSCRIPT.SHOWACCUM + [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 15:16 by rmk:") + + (* ;; + "Send commands to SHOW the accumulated characters. Uses S (= SHOW) for regular characters.") + + (* ;; "Uses WIDTHSHOW if the space-factor isn't 1") + + (* ;; "Uses ASHOW if a KERN value is on STREAM's properties") + + (* ;; "USES AWIDTHSHOW if both space-factor != 1 and there's a KERN value.") + + (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM)) + KERN) + (COND + ((fetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (SETQ KERN (STREAMPROP STREAM 'KERN)) + [COND + [(EQP (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA) + 1) + (COND + (KERN (POSTSCRIPT.OUTSTR STREAM (CONCAT ") " KERN " 0 3 -1 roll ashow"))) + (T (POSTSCRIPT.OUTSTR STREAM ") S"] + (T (POSTSCRIPT.OUTSTR STREAM ") ") + (POSTSCRIPT.OUTSTR STREAM (DIFFERENCE (ffetch (\POSTSCRIPTDATA + POSTSCRIPTSPACEWIDTH) + of IMAGEDATA) + (ffetch (\POSTSCRIPTDATA + POSTSCRIPTNATURALSPACEWIDTH + ) of IMAGEDATA))) + (COND + (KERN (POSTSCRIPT.OUTSTR STREAM (CONCAT " 0 " (CHARCODE SPACE) + " " KERN " 0 " + " 6 -1 roll awidthshow"))) + (T (POSTSCRIPT.OUTSTR STREAM (CONSTANT (CONCAT " 0 " (CHARCODE SPACE) + " 4 -1 roll widthshow"] + (\BOUTEOL STREAM) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with NIL]) + +(POSTSCRIPT.STARTPAGE + [LAMBDA (STREAM) (* ; "Edited 12-Jun-2021 14:52 by rmk:") + + (* ;; "Start up a new page in a Postscript document.") + + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + NEW-PAGE) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) + (* ; "shouldnt need this") + (SETQ NEW-PAGE (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGENUM) of IMAGEDATA))) + (* ; "Page number goes up by 1") + + (* ;; "Print the %"Document structuring%" info for the page, then the initial page setup") + + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "%%%%Page: " NEW-PAGE " " NEW-PAGE :EOL + "%%%%BeginPageSetup" :EOL "/savepage save def" :EOL (FQUOTIENT 1 \PS.SCALE0) + " imagesizefactor mul dup scale" :EOL "%%%%EndPageSetup" :EOL) + (\SETXFORM.PSC STREAM IMAGEDATA T) + + (* ;; "Lisp depends on the current font being carried over from page to page, but in postscript there is no current font at the beginning of a page, so force a setfont.") + + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T) + (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEBLANK) of IMAGEDATA with T) + (* ; "nothing printed yet...") + (COND + ((fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) of IMAGEDATA) + + (* ;; "Here we handle headings.") + + (LET [(FONT (\DSPFONT.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADINGFONT) + of IMAGEDATA] + (\DSPRESET.PSC STREAM) + (POSTSCRIPT.OUTSTR STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTHEADING) + of IMAGEDATA)) + (RELMOVETO (CONSTANT (TIMES 72 \PS.SCALE0)) + 0 STREAM) (* ; "Skip an inch before page number") + (POSTSCRIPT.OUTSTR STREAM "Page ") + (POSTSCRIPT.OUTSTR STREAM NEW-PAGE) + (\TERPRI.PSC STREAM) (* ; "Skip 2 lines") + (\TERPRI.PSC STREAM) + (\DSPFONT.PSC STREAM FONT))) + (T (\DSPRESET.PSC STREAM]) + +(\POSTSCRIPTTAB + [LAMBDA (POSTSCRIPTDATA) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (LET [(TABSPACE (TIMES 8 (ffetch FONTAVGCHARWIDTH of (ffetch (\POSTSCRIPTDATA + POSTSCRIPTFONT) + of POSTSCRIPTDATA] + (IDIFFERENCE TABSPACE (IREMAINDER (IDIFFERENCE (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) + of POSTSCRIPTDATA) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) + of POSTSCRIPTDATA)) + TABSPACE]) + +(\PS.BOUTFIXP + [LAMBDA (STREAM N) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + + (* ;; "BOUT the decimal representation of N to STREAM using temp storage from the imagedata. Done this way for speed.") + + (DECLARE (LOCALVARS . T)) + [COND + ((MINUSP N) + (BOUT STREAM (CHARCODE -)) + (SETQ N (IMINUS N] + (COND + [(LESSP N 10) + (BOUT STREAM (IPLUS N (CHARCODE 0] + [(LESSP N 1000000000) + (LET ([BASE (fetch (ARRAYP BASE) of (fetch (\POSTSCRIPTDATA POSTSCRIPTTEMPARRAY) + of (fetch (STREAM IMAGEDATA) + of STREAM] + (i (SUB1 \PS.TEMPARRAYLEN))) + [for old i by -1 do (\PUTBASEBYTE BASE i (IPLUS (IREMAINDER N 10) + (CHARCODE 0))) + repeatwhile (NEQ 0 (SETQ N (IQUOTIENT N 10] + (\BOUTS STREAM BASE i (IDIFFERENCE \PS.TEMPARRAYLEN i] + (T (* ; "Just in case we get a bignum") + (for c in (CHCON N) do (BOUT STREAM (\CHAR8CODE c]) + +(\PS.SCALEHACK + [LAMBDA (STREAM SCALEFACTOR) (* ; + "Edited 20-Nov-92 15:11 by sybalsky:mv:envos") + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA)) + FACTOR) + (COND + ((AND (NUMBERP SCALEFACTOR) + (NOT (EQP OLDSCALE SCALEFACTOR))) + (POSTSCRIPT.SHOWACCUM STREAM) + (SETQ FACTOR (/ OLDSCALE SCALEFACTOR)) + [for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA) + (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) + of IMAGEDATA)) + do (change (fetch (REGION LEFT) of REG) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (REGION BOTTOM) of REG) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (REGION WIDTH) of REG) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (REGION HEIGHT) of REG) + (FIXR (CL:* DATUM FACTOR] + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (change (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) + (FIXR (CL:* DATUM FACTOR))) + (replace (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA with + SCALEFACTOR) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T))) + OLDSCALE]) + +(\PS.SCALEREGION + [LAMBDA (SCALE REGION) (* ; "Edited 5-Apr-89 16:15 by TAL") + (* ; "Scales a region") + (create REGION + LEFT _ (FIXR (TIMES SCALE (fetch (REGION LEFT) of REGION))) + BOTTOM _ (FIXR (TIMES SCALE (fetch (REGION BOTTOM) of REGION))) + WIDTH _ (FIXR (TIMES SCALE (fetch (REGION WIDTH) of REGION))) + HEIGHT _ (FIXR (TIMES SCALE (fetch (REGION HEIGHT) of REGION]) + +(\SCALEDBITBLT.PSC + [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT + SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM + SCALE) (* ; "Edited 8-May-2018 19:33 by rmk:") + (* ; "Edited 8-May-2018 15:05 by rmk:") + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + + (* ;; "Postscript can only handle OPERATION REPLACE and PAINT. SOURCETYPE = TEXTURE is converted to BLTSHADE before getting here (so the TEXTURE argument can be ignored). If the destination region lies completely outside the clipping region we do nothing, otherwise we output the whole thing and let the printer clip. Could be more clever.") + + (OR (NUMBERP SCALE) + (SETQ SCALE 1)) + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (SCALE1 (TIMES SCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA))) + (SCALE2 (TIMES SCALE1 (OR (NUMBERP POSTSCRIPT.BITMAP.SCALE) + 1))) + DESTREGION + (BITMAPWIDTH (fetch BITMAPWIDTH of SOURCEBITMAP)) + (BITMAPHEIGHT (fetch BITMAPHEIGHT of SOURCEBITMAP)) + TEMPBM) + [COND + ((NULL DESTINATIONLEFT) + (SETQ DESTINATIONLEFT (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA] + [COND + ((NULL DESTINATIONBOTTOM) + (SETQ DESTINATIONBOTTOM (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA] + (COND + ((OR (NULL WIDTH) + (NULL HEIGHT)) + (SETQ WIDTH BITMAPWIDTH) + (SETQ HEIGHT BITMAPHEIGHT))) + (COND + ((GREATERP WIDTH BITMAPWIDTH) + (SETQ WIDTH BITMAPWIDTH))) + (COND + ((GREATERP HEIGHT BITMAPHEIGHT) + (SETQ HEIGHT BITMAPHEIGHT))) + [SETQ DESTREGION (INTERSECTREGIONS (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA) + (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM (TIMES SCALE1 WIDTH + ) + (TIMES SCALE1 HEIGHT] + (COND + ((AND DESTREGION (OR (NULL CLIPPINGREGION) + (REGIONSINTERSECTP DESTREGION CLIPPINGREGION))) + [COND + ((AND (EQ SOURCELEFT 0) + (EQ SOURCEBOTTOM 0) + (EQP WIDTH BITMAPWIDTH) + (EQP HEIGHT BITMAPHEIGHT)) (* ; + "Avoid copy if sending entire bitmap") + (SETQ TEMPBM SOURCEBITMAP)) + (T (SETQ TEMPBM (BITMAPCREATE WIDTH HEIGHT 1)) + (BITBLT SOURCEBITMAP SOURCELEFT SOURCEBOTTOM TEMPBM 0 0 WIDTH HEIGHT SOURCETYPE + 'REPLACE] + (POSTSCRIPT.PUTCOMMAND STREAM "/bitbltsave save def " DESTINATIONLEFT " " + DESTINATIONBOTTOM " translate " (TIMES SCALE2 WIDTH) + " " + (TIMES SCALE2 HEIGHT) + " scale " WIDTH " " HEIGHT (COND + ((EQ OPERATION 'PAINT) + " true") + (T + (* ;; + "RMK: For REPLACE, was %"false%", but then white was black.") + + " true")) + " thebitimage" :EOL) + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEMPBM NIL) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "bitbltsave restore" :EOL) + (\MOVETO.PSC STREAM DESTINATIONLEFT DESTINATIONBOTTOM) + T) + (T NIL]) + +(\SETPOS.PSC + [LAMBDA (STREAM IMAGEDATA) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + " " + (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) + " M ") + (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) + +(\SETXFORM.PSC +(LAMBDA (STREAM IMAGEDATA NORESTORE) (* ; "Edited 28-Dec-94 17:59 by jds") (* ;; "Write transforms into the PS file to make what it prints match what we think it should print.") (LET ((CLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with NIL) (COND ((NOT NORESTORE) (POSTSCRIPT.OUTSTR STREAM "grestore "))) (POSTSCRIPT.PUTCOMMAND STREAM "gsave" :EOL) (* ;; "Scaling") (COND ((NOT (EQP (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) 1)) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALEHACK) of IMAGEDATA) " dup scale" :EOL))) (* ;; "Landscape mode (as in POSTSCRIPT.PREFER.LANDSCAPE, not as in TEdit doing landscaping)") (COND ((fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) (POSTSCRIPT.OUTSTR STREAM " 90 rotate 0 -61200 imagesizefactor div translate "))) (* ;; "Any rotation that is in effect.") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA) " rotate " :EOL) (* ;; "Any translations that are in effect.") (COND ((NOT (AND (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA)) (ZEROP (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA)))) (POSTSCRIPT.PUTCOMMAND STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) " " (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) " translate" :EOL))) (* ;; "Clipping region:") (POSTSCRIPT.PUTCOMMAND STREAM " " (fetch (REGION HEIGHT) of CLIP) " " (fetch (REGION WIDTH) of CLIP) " " (fetch (REGION LEFT) of CLIP) " " (fetch (REGION BOTTOM) of CLIP) " CLP" :EOL) (* ;; "And force recaching of location and font.") (replace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T) (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with T))) +) + +(\STRINGWIDTH.PSC + [LAMBDA (STREAM STR RDTBL) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) + (\STRINGWIDTH.GENERIC STR (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA) + RDTBL + (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA]) + +(\SWITCHFONTS.PSC + [LAMBDA (STREAM POSTSCRIPTDATA) (* ; "Edited 23-May-93 12:04 by rmk:") + (* ; "Edited 11-May-93 02:11 by jds") + + (* ;; "Actually emit the PS commands to change the font. If the new font hasn't been used (on this page) before, re-encode it to support accented characters.") + + (LET* [(FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of POSTSCRIPTDATA)) + (FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR + OTHERDEVICEFONTPROPS + ) of FONT) + 'PSCFONT] + [COND + [(LISTP FONTID) + [COND + ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of POSTSCRIPTDATA))) + ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) + *POSTSCRIPT-UNACCENTED-FONTS*)) + (T + (* ;; + "This font hasn't been used on this page yet. Re-encode it to include accented characters.") + + (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of + FONTID) + " /" + (CONCAT (fetch (FONTID FONTIDNAME) of FONTID) + "-Acnt") + " encodefont" :EOL) + (CL:PUSH (fetch (FONTID FONTIDNAME) of FONTID) + (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF POSTSCRIPTDATA] + (COND + ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) + *POSTSCRIPT-UNACCENTED-FONTS*) + (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA + WITH NIL) + (POSTSCRIPT.PUTCOMMAND STREAM "/" (fetch (FONTID FONTIDNAME) of FONTID) + " findfont [" + (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) + (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " 0 " + (TIMES (fetch (FONTID FONTOBLIQUEFACTOR) of FONTID) + (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " " + (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " 0 0] makefont setfont" :EOL)) + (T (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF POSTSCRIPTDATA + WITH T) + (POSTSCRIPT.PUTCOMMAND STREAM "/" (CONCAT (fetch (FONTID FONTIDNAME) + of FONTID) + "-Acnt") + " findfont [" + (TIMES (fetch (FONTID FONTXFACTOR) of FONTID) + (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " 0 " + (TIMES (fetch (FONTID FONTOBLIQUEFACTOR) of FONTID) + (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " " + (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) of FONT) + 100) + " 0 0] makefont setfont" :EOL] + (T [COND + ((MEMB FONTID (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) of + POSTSCRIPTDATA + ))) + ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*)) + (T + (* ;; + "This font hasn't been used on this page yet. Re-encode it to include accented characters.") + + (POSTSCRIPT.PUTCOMMAND STREAM "/" FONTID " /" (CONCAT FONTID "-Acnt") + " encodefont" :EOL) + (CL:PUSH FONTID (FFETCH (\POSTSCRIPTDATA POSTSCRIPTFONTSUSED) OF + POSTSCRIPTDATA + ] + (COND + ((MEMB FONTID *POSTSCRIPT-UNACCENTED-FONTS*) + (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA + with NIL) + (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) + of FONT) + 100) + " /" FONTID " F" :EOL)) + (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of POSTSCRIPTDATA + with T) + (POSTSCRIPT.PUTCOMMAND STREAM (TIMES (fetch (FONTDESCRIPTOR FONTSIZE) + of FONT) + 100) + " /" + (CONCAT FONTID "-Acnt") + " F" :EOL] + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of POSTSCRIPTDATA with + NIL]) + +(\TERPRI.PSC + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (NEWY (PLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of IMAGEDATA] + (COND + ([LESSP NEWY (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of + IMAGEDATA + ) + (fetch (FONTDESCRIPTOR \SFDescent) of (ffetch + (\POSTSCRIPTDATA + POSTSCRIPTFONT) + of IMAGEDATA] + (DSPNEWPAGE STREAM)) + (T (replace (STREAM CHARPOSITION) of STREAM with 0) + (\MOVETO.PSC STREAM (ffetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) + of IMAGEDATA) + NEWY))) + NIL]) +) + + + +(* ;; "DIG operations: ") + +(DEFINEQ + +(\BITBLT.PSC + [LAMBDA (SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT + SOURCETYPE OPERATION TEXTURE CLIPPINGREGION CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM) + (* ; "Edited 7-Apr-89 19:53 by TAL") + (\SCALEDBITBLT.PSC SOURCEBITMAP SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT + DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION + CLIPPEDSOURCELEFT CLIPPEDSOURCEBOTTOM 1]) + +(\BLTSHADE.PSC + [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + + (* ;; "Maybe we should do something with OPERATION") + + (LET ((RGN (CREATEREGION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT)) + (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + TEXTUREBM TEXTUREWIDTH LEFT BOTTOM WIDTH HEIGHT) + [COND + [CLIPPINGREGION (SETQ RGN (INTERSECTREGIONS RGN CLIPPINGREGION (fetch ( + \POSTSCRIPTDATA + + POSTSCRIPTCLIPPINGREGION + ) of + IMAGEDATA] + (T (SETQ RGN (INTERSECTREGIONS RGN (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA] + (COND + (RGN (SETQ LEFT (fetch (REGION LEFT) of RGN)) + (SETQ BOTTOM (fetch (REGION BOTTOM) of RGN)) + (SETQ WIDTH (CL:1- (fetch (REGION WIDTH) of RGN))) + (SETQ HEIGHT (CL:1- (fetch (REGION HEIGHT) of RGN))) + [COND + ((FIXP TEXTURE) + (SETQ TEXTURE (SELECT TEXTURE ((BLACKSHADE -1) + 0.0) + (WHITESHADE 1.0) + TEXTURE] + [COND + ((AND (FLOATP TEXTURE) + (<= 0.0 TEXTURE 1.0)) + (POSTSCRIPT.PUTCOMMAND STREAM HEIGHT " " WIDTH " " LEFT " " BOTTOM " " + TEXTURE " R" :EOL)) + ((OR (TEXTUREP TEXTURE) + (NULL TEXTURE)) + (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) + (SETQ TEXTUREWIDTH 16) + (BLTSHADE TEXTURE TEXTUREBM)) + ((BITMAPP TEXTURE) + (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) + (fetch BITMAPHEIGHT of TEXTUREBM))) + (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) + (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE] + (COND + (TEXTUREBM (POSTSCRIPT.PUTCOMMAND STREAM "gsave newpath ") + (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale " (QUOTIENT LEFT 100.0) + " " + (QUOTIENT BOTTOM 100.0) + " M " + (SETQ WIDTH (QUOTIENT WIDTH 100.0)) + " 0 rlineto 0 " + (QUOTIENT HEIGHT 100.0) + " rlineto " + (MINUS WIDTH) + " 0 rlineto closepath" :EOL) + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) + (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " + (LSH (fetch BITMAPRASTERWIDTH of TEXTUREBM) + 1) + " 0 " + (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) + 100.0)) + " findresolution " TEXTUREWIDTH " div div ceiling " + POSTSCRIPT.TEXTURE.SCALE " mul setpattern eofill" :EOL "grestore" + :EOL))) + (\MOVETO.PSC STREAM DESTINATIONLEFT DESTINATIONBOTTOM) + T) + (T NIL]) + +(\CHARWIDTH.PSC + [LAMBDA (STREAM CHARCODE) (* ; "Edited 8-May-93 11:19 by rmk:") + (COND + ((EQ CHARCODE (CHARCODE SPACE)) + (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of (ffetch (STREAM IMAGEDATA) + of STREAM))) + ((\FGETCHARWIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of (ffetch (STREAM + IMAGEDATA + ) + of STREAM)) + CHARCODE]) + +(\CREATECHARSET.PSC + [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC NOSLUG?) + (* ; "Edited 8-May-93 22:55 by rmk:") + (LET* ((CSINFO (CREATE CHARSETINFO + OFFSETS _ NIL)) + (WIDTHS (FETCH (CHARSETINFO WIDTHS) OF CSINFO))) + (REPLACE (CHARSETINFO IMAGEWIDTHS) OF CSINFO WITH WIDTHS) + + (* ;; "Make imagewidths point to widths. Shouldn't matter to anyone, since imagewidths really has to do with bitmaps etc. But...") + + (CL:UNLESS (EQ CHARSET 0) + + (* ;; "For all charsets other than 0, initialize widths with width of black box=average char width. We know that the AVGCHARWIDTH field of the FONTDESC will eventually be the width of A, but that might not be filled in when this is executed inside POSTSCRIPT.FONTCREATE--it's only after the return to FONTCREATE itself that this gets filled in. However, we do know that charset 0 is all set up before any other characters are dealt with.") + + (FOR I (AVGCHARWIDTH _ (CHARWIDTH (CHARCODE A) + FONTDESC)) FROM 0 TO 255 + FIRST (CL:WHEN (EQ 0 AVGCHARWIDTH) + + (* ;; + "This is what \AVGCHARWIDTH in FONT does, but we don't have it here. Just to be extremely safe.") + + [SETQ AVGCHARWIDTH (MAX 1 (FIXR (FTIMES 0.6 (FONTPROP FONTDESC + 'HEIGHT]) + DO (\FSETWIDTH WIDTHS I AVGCHARWIDTH))) + CSINFO]) + +(\DRAWARC.PSC + [LAMBDA (STREAM CENTERX CENTERY RADIUS STARTANGLE NDEGREES BRUSH DASHING) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH COLOR) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH)) + ((LISTP BRUSH) + (COND + ((NEQ (fetch BRUSHSHAPE of BRUSH) + 'ROUND) + (printout T T + "[In \DRAWARC.PSC: Non-ROUND BRUSH not supported.] +[Using ROUND BRUSH]" T))) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T (* ; + "If FUNCTIONAL BRUSH big trouble!") + (printout T T + "[In \DRAWARC.PSC: Functional BRUSH not supported.] +[Using ROUND 1 point BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + (* ; + "COLOR is specified in POSTSCRIPT setgray notation.") + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ")) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) + (* ; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") + )) + (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " + CENTERX " " CENTERY " " RADIUS " " STARTANGLE " " (+ STARTANGLE NDEGREES) + " arc stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM CENTERX CENTERY]) + +(\DRAWCIRCLE.PSC + [LAMBDA (STREAM CENTERX CENTERY RADIUS BRUSH DASHING) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH COLOR) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH)) + ((LISTP BRUSH) + (COND + ((NEQ (fetch BRUSHSHAPE of BRUSH) + 'ROUND) + (printout T T + "[In \DRAWCIRCLE.PSC: Non-ROUND BRUSH not supported.] +[Using ROUND BRUSH]" T))) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T (* ; + "If FUNCTIONAL BRUSH big trouble!") + (printout T T + "[In \DRAWCIRCLE.PSC: Functional BRUSH not supported.] +[Using (ROUND 1) BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + (* ; + "COLOR is specified in POSTSCRIPT setgray notation.") + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ")) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL) + (* ; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") + )) + (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " + CENTERX " " CENTERY " " RADIUS " 0 360 arc stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM CENTERX CENTERY]) + +(\DRAWCURVE.PSC + [LAMBDA (STREAM KNOTS CLOSED BRUSH DASHING) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH SHAPE COLOR PSPLINE XA YA DXA DYA N PREVX PREVY PREV-DX3 PREV-DY3) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH) + (SETQ SHAPE 'ROUND)) + ((LISTP BRUSH) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ SHAPE (fetch BRUSHSHAPE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T + (* ;; "If FUNCTIONAL BRUSH then BIG trouble!") + + (printout T T + "[In \DRAWCURVE.PSC: Functional BRUSH not supported.] +[Using (ROUND 1) BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) + (SETQ SHAPE 'ROUND] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + + (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") + + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ") + + (* ;; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") +) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) + (SETQ PSPLINE (PARAMETRICSPLINE KNOTS CLOSED NIL)) + (SETQ N (pop PSPLINE)) + (SETQ XA (pop PSPLINE)) + (SETQ YA (pop PSPLINE)) + (SETQ DXA (pop PSPLINE)) + (SETQ DYA (pop PSPLINE)) + (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE + (ROUND " 1 setlinecap 1 setlinejoin ") + (SQUARE " 2 setlinecap 0 setlinejoin ") + " 0 setlinecap 0 setlinejoin ") + WIDTH " setlinewidth " (SETQ PREVX (ELT XA 1)) + " " + (SETQ PREVY (ELT YA 1)) + " M" :EOL) + (SETQ PREV-DX3 (FQUOTIENT (ELT DXA 1) + 3.0)) + (SETQ PREV-DY3 (FQUOTIENT (ELT DYA 1) + 3.0)) + (for C from 2 to N do (POSTSCRIPT.PUTCOMMAND + STREAM + (FPLUS PREVX PREV-DX3) + " " + (FPLUS PREVY PREV-DY3) + " " + (FDIFFERENCE (SETQ PREVX (ELT XA C)) + (SETQ PREV-DX3 (FQUOTIENT (ELT DXA C) + 3.0))) + " " + (FDIFFERENCE (SETQ PREVY (ELT YA C)) + (SETQ PREV-DY3 (FQUOTIENT (ELT DYA C) + 3.0))) + " " PREVX " " PREVY " curveto" :EOL)) + (POSTSCRIPT.PUTCOMMAND STREAM "stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM PREVX PREVY)) + NIL]) + +(\DRAWELLIPSE.PSC + [LAMBDA (STREAM CENTERX CENTERY MINORRADIUS MAJORRADIUS ORIENTATION BRUSH DASHING) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH COLOR) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH)) + ((LISTP BRUSH) + (COND + ((NEQ (fetch BRUSHSHAPE of BRUSH) + 'ROUND) + (printout T T + "[In \DRAWELLIPSE.PSC: Non-ROUND BRUSH not supported.] +[Using ROUND BRUSH]" T))) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T (* ; + "If FUNCTIONAL BRUSH, big trouble!") + (printout T T + "[In \DRAWELLIPSE.PSC: Functional BRUSH not supported.] +[Using (ROUND 1) BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + (* ; + "COLOR is specified in POSTSCRIPT setgray notation.") + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ") + + (* ;; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") +) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) + (POSTSCRIPT.PUTCOMMAND STREAM WIDTH " setlinewidth 1 setlinecap 1 setlinejoin " + CENTERX " " CENTERY " " MAJORRADIUS " " MINORRADIUS " " ORIENTATION + " 0 360 ellipse stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM CENTERX CENTERY]) + +(\DRAWLINE.PSC + [LAMBDA (STREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR DASHING) + (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + + (* ;; "DRAWLINE method for postscript streams.") + + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + [COND + ((NOT (NUMBERP WIDTH)) + + (* ;; "The WIDTH = NIL should have been handled before here, but just in case!") + + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA] + [COND + ((NOT (ZEROP WIDTH)) + (COND + ((LESSP X2 X1) + + (* ;; "For Syntelligence, make all lines move from left to right, to defeat a bug in SPARCPrinter PS decoder.") + + (\DRAWLINE.PSC STREAM X2 Y2 X1 Y1 WIDTH OPERATION COLOR DASHING)) + ((NOT (OR (FLOATP COLOR) + (LISTP DASHING))) (* ; "Simple case, no dash or gray") + (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " L" :EOL)) + (T (* ; + "COLOR is interpreted as gray factor") + (POSTSCRIPT.PUTCOMMAND STREAM X2 " " Y2 " " X1 " " Y1 " " WIDTH " " + (OR (FLOATP COLOR) + "0") + " [") + (for D in (LISTP DASHING) do + + (* ;; + "Interlisp DASHING is in terms of BRUSH units, so multiply by the brush size.") + + (POSTSCRIPT.PUTCOMMAND STREAM + (TIMES D WIDTH) + " ")) + (POSTSCRIPT.PUTCOMMAND STREAM "] L1" :EOL] + (replace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X2) + (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y2) + (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with NIL]) + +(\DRAWPOINT.PSC + [LAMBDA (STREAM X Y BRUSH OPERATION) (* ; "Edited 30-Mar-90 17:53 by Matt Heffron") + + (* ;; "draw a point on the stream ") + + (if (BITMAPP BRUSH) + then (LET ((WIDTH (fetch BITMAPWIDTH of BRUSH)) + (HEIGHT (fetch BITMAPHEIGHT of BRUSH))) + (BITBLT BRUSH 0 0 STREAM (- X (IQUOTIENT WIDTH 2)) + (- Y (IQUOTIENT HEIGHT 2)) + WIDTH HEIGHT OPERATION)) + else (\DRAWLINE.PSC STREAM X Y X Y BRUSH OPERATION]) + +(\DRAWPOLYGON.PSC + [LAMBDA (STREAM POINTS CLOSED BRUSH DASHING)(* ; + "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") + (LET ((LASTPOINT (CAR (LAST POINTS))) + (IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + WIDTH SHAPE COLOR) + [COND + ((NUMBERP BRUSH) + (SETQ WIDTH BRUSH) + (SETQ SHAPE 'ROUND)) + ((LISTP BRUSH) + (SETQ WIDTH (fetch BRUSHSIZE of BRUSH)) + (SETQ SHAPE (fetch BRUSHSHAPE of BRUSH)) + (SETQ COLOR (fetch BRUSHCOLOR of BRUSH))) + (T + (* ;; "If FUNCTIONAL BRUSH then BIG trouble!") + + (printout T T + "[In \DRAWPOLYGON.PSC: Functional BRUSH not supported.] +[Using (ROUND 1) BRUSH]" T) + (SETQ WIDTH (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) + (SETQ SHAPE 'ROUND] + (COND + ((NOT (ZEROP WIDTH)) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (COND + ((FLOATP COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM COLOR " setgray ") + + (* ;; "COLOR is specified in POSTSCRIPT setgray notation.") + + )) + (COND + ((LISTP DASHING) + (POSTSCRIPT.OUTSTR STREAM " [") + (for D in DASHING do (POSTSCRIPT.PUTCOMMAND STREAM (TIMES D WIDTH) + " ") + + (* ;; + "Since Interlisp DASHING are in terms of BRUSH units, we must multiply by the brush size.") +) + (POSTSCRIPT.PUTCOMMAND STREAM "] 0 setdash" :EOL))) + (POSTSCRIPT.PUTCOMMAND STREAM (SELECTQ SHAPE + (ROUND " 1 setlinecap 1 setlinejoin ") + (SQUARE " 2 setlinecap 0 setlinejoin ") + " 0 setlinecap 0 setlinejoin ") + WIDTH " setlinewidth " (fetch (POSITION XCOORD) of (CAR POINTS)) + " " + (fetch (POSITION YCOORD) of (CAR POINTS)) + " M" :EOL) + (for P in (CDR POINTS) do (POSTSCRIPT.PUTCOMMAND STREAM + (fetch (POSITION XCOORD) of P) + " " + (fetch (POSITION YCOORD) of P) + " lineto" :EOL)) + (COND + (CLOSED (POSTSCRIPT.PUTCOMMAND STREAM " closepath"))) + (POSTSCRIPT.PUTCOMMAND STREAM " stroke" :EOL "grestore" :EOL))) + (\MOVETO.PSC STREAM (fetch (POSITION XCOORD) of LASTPOINT) + (fetch (POSITION YCOORD) of LASTPOINT]) + +(\DSPBOTTOMMARGIN.PSC + [LAMBDA (STREAM YPOSITION) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of (fetch (STREAM IMAGEDATA) + of STREAM)) + (COND + (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) + of (fetch (STREAM IMAGEDATA) of STREAM) with YPOSITION))))]) + +(\DSPCLIPPINGREGION.PSC + [LAMBDA (STREAM REGION) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDCLIP (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA))) + (COND + ([AND REGION (NOT (AND (EQP (fetch (REGION LEFT) of OLDCLIP) + (fetch (REGION LEFT) of REGION)) + (EQP (fetch (REGION BOTTOM) of OLDCLIP) + (fetch (REGION BOTTOM) of REGION)) + (EQP (fetch (REGION WIDTH) of OLDCLIP) + (fetch (REGION WIDTH) of REGION)) + (EQP (fetch (REGION HEIGHT) of OLDCLIP) + (fetch (REGION HEIGHT) of REGION] + (POSTSCRIPT.SHOWACCUM STREAM) + (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA with + REGION) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) + (\FIXLINELENGTH.PSC STREAM IMAGEDATA))) + OLDCLIP]) + +(\DSPCOLOR.PSC + [LAMBDA (STREAM COLOR) (* ; "Edited 14-Jan-93 17:14 by jds") + + (* ;; + "Postscript %"color%" setter -- really sets gray shade for now. 0.0 = black, 1.0 = white.") + + (POSTSCRIPT.SHOWACCUM STREAM) + (PROG1 (FETCH (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) + OF STREAM)) + (COND + ((AND (NUMBERP COLOR) + (<= 0 COLOR 1)) + (REPLACE (\POSTSCRIPTDATA POSTSCRIPTCOLOR) OF (FETCH (STREAM IMAGEDATA) + OF STREAM) WITH COLOR) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL COLOR " setgray ")) + (COLOR (\ILLEGAL.ARG COLOR))))]) + +(\DSPFONT.PSC + [LAMBDA (STREAM FONT) (* ; + "Edited 26-May-93 01:06 by sybalsky:mv:envos") + (* ; "Edited 11-May-93 02:11 by jds") + (* ; "Edited 19-Jan-93 17:17 by jds") + + (* ;; "Change fonts on the PostScript stream STREAM to be FONT.") + + (* ;; "Doesn't actually write the font-change command to the stream (it saves doing that until the font is actually needed, so that multiple font changes don't yield larger PS files).") + + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDFONT (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA)) + NEWFONT FONTID) + (COND + ((AND FONT (SETQ NEWFONT (OR (\COERCEFONTDESC FONT STREAM) + (FONTCOPY OLDFONT FONT))) + (type? FONTDESCRIPTOR NEWFONT) + (NEQ NEWFONT OLDFONT)) + + (* ;; "OK, it's a good font.") + + (POSTSCRIPT.SHOWACCUM STREAM) (* ; + " Write out any accumulated characters.") + + (* ;; "Change the font in the Lisp stream:") + + (replace (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA with NEWFONT) + + (* ;; "and now update all font-dependent fields in the imagedata, EXCEPT POSTSCRIPTSPACEWIDTH and POSTSCRIPTNATURALSPACEWIDTH. These latter 2 must stay as-is up thru the actual writing of characters by SHOWACCUM, so") + + (\POSTSCRIPT.CHANGECHARSET IMAGEDATA 0) + (\DSPLINEFEED.PSC STREAM (IMINUS (fetch (FONTDESCRIPTOR \SFHeight) of + NEWFONT))) + [replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA + with (FIXR (TIMES (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) + of IMAGEDATA) + (replace (\POSTSCRIPTDATA POSTSCRIPTNATURALSPACEWIDTH) + of IMAGEDATA with (\FGETWIDTH (fetch + (\POSTSCRIPTDATA + POSTSCRIPTWIDTHS) + of IMAGEDATA) + (CHARCODE SPACE] + (\FIXLINELENGTH.PSC STREAM IMAGEDATA) + [SETQ FONTID (fetch (PSCFONT IL-FONTID) of (LISTGET (fetch (FONTDESCRIPTOR + + OTHERDEVICEFONTPROPS + ) of + NEWFONT + ) + 'PSCFONT] + (COND + ((MEMB (fetch (FONTID FONTIDNAME) of FONTID) + *POSTSCRIPT-UNACCENTED-FONTS*) + (FREPLACE (\POSTSCRIPTDATA POSTSCRIPTACCENTED) OF IMAGEDATA WITH NIL)) + (T (freplace (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA with + T))) + + (* ;; "Remember to actually write a change command") + + (replace (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA with + T))) + OLDFONT]) + +(\DSPLEFTMARGIN.PSC + [LAMBDA (STREAM XPOSITION) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + (COND + (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA + with XPOSITION) + (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) + +(\DSPLINEFEED.PSC + [LAMBDA (STREAM LINELEADING) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) of (fetch (STREAM IMAGEDATA) + of STREAM)) + (COND + (LINELEADING (replace (\POSTSCRIPTDATA POSTSCRIPTLINESPACING) + of (fetch (STREAM IMAGEDATA) of STREAM) with LINELEADING)) + ))]) + +(\DSPPUSHSTATE.PSC + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:12 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (push (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA) + (create POSTSCRIPTXFORM + PSXCLIP _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA)) + PSXPAGE _ (COPY (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of + IMAGEDATA)) + PSXLEFT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + PSXRIGHT _ (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA + ) + PSXTOP _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + PSXBOTTOM _ (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of + IMAGEDATA + ) + PSXTRANX _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) + PSXTRANY _ (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) + PSXLAND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA) + PSXXFORMPEND _ (fetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) + of IMAGEDATA]) + +(\DSPPOPSTATE.PSC + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:15 by sybalsky:mv:envos") + (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (XFORM (pop (fetch (\POSTSCRIPTDATA POSTSCRIPTXFORMSTACK) of IMAGEDATA] + (replace (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXCLIP) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXPAGE) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXBOTTOM) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXTOP) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXLEFT) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXRIGHT) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTLANDSCAPE) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXLAND) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA + with (fetch (POSTSCRIPTXFORM PSXXFORMPEND) of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with + (fetch ( + POSTSCRIPTXFORM + PSXTRANX) + of XFORM)) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with + (fetch ( + POSTSCRIPTXFORM + PSXTRANY) + of XFORM]) + +(\DSPRESET.PSC + [LAMBDA (STREAM) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (replace (STREAM CHARPOSITION) of STREAM with 0) + (\MOVETO.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + (FONTPROP (fetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA) + 'ASCENT]) + +(\DSPRIGHTMARGIN.PSC + [LAMBDA (STREAM XPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) + (COND + (XPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA + with XPOSITION) + (\FIXLINELENGTH.PSC STREAM IMAGEDATA))))]) + +(\DSPROTATE.PSC + [LAMBDA (STREAM ROTATION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + + (* ;; "rotate the postscript stream by ROTATION") + + (* ;; + "we only know 90 degrees of rotation for now (0 means portrait, anything else is landscape).") + + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OROT (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA)) + LAND C0 P0 C P ML MB MR MT) + (COND + ((AND ROTATION (NEQ ROTATION (fetch (\POSTSCRIPTDATA POSTSCRIPTROTATION) + of IMAGEDATA))) + (POSTSCRIPT.SHOWACCUM STREAM) + (replace (\POSTSCRIPTDATA POSTSCRIPTROTATION) of IMAGEDATA with ROTATION) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T) + (\DSPRESET.PSC STREAM))) + OROT]) + +(\DSPSCALE.PSC + [LAMBDA (STREAM SCALE) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) + NSCALE) + (COND + ((AND NIL + + (* ;; "Changing SCALE is not implemented. According to IRM.") + + (NUMBERP SCALE) + (CL:PLUSP SCALE)) + (SETQ NSCALE (QUOTIENT SCALE OSCALE)) + + (* ;; + "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") + + (POSTSCRIPT.PUTCOMMAND STREAM " " NSCALE " " NSCALE " scale" :EOL) + (replace (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA with SCALE))) + OSCALE]) + +(\DSPSCALE2.PSC + [LAMBDA (STREAM X-SCALE Y-SCALE) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + + (* ;; "SETS X AND Y SCALE ") + + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OSCALE (fetch (\POSTSCRIPTDATA POSTSCRIPTSCALE) of IMAGEDATA)) + NSCALE) + (COND + ((AND X-SCALE (NUMBERP X-SCALE) + (CL:PLUSP X-SCALE)) + (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + + (* ;; + "NSCALE is the adjustment for the fact that the scale operator takes RELATIVE scale changes.") + + (POSTSCRIPT.PUTCOMMAND STREAM " " X-SCALE " " Y-SCALE " scale" :EOL))) + T]) + +(\DSPSPACEFACTOR.PSC + [LAMBDA (STREAM FACTOR) (* ; + "Edited 26-May-93 01:18 by sybalsky:mv:envos") + (DECLARE (LOCALVARS . T)) + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDFACTOR (fetch (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA))) + [COND + ((AND (NUMBERP FACTOR) + (NOT (EQUAL FACTOR OLDFACTOR))) + (POSTSCRIPT.SHOWACCUM STREAM) + (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEFACTOR) of IMAGEDATA with FACTOR) + (replace (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of IMAGEDATA + with (FIXR (TIMES FACTOR (ffetch (\POSTSCRIPTDATA + POSTSCRIPTNATURALSPACEWIDTH) + of IMAGEDATA] + OLDFACTOR]) + +(\DSPTOPMARGIN.PSC + [LAMBDA (STREAM YPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (PROG1 (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch (STREAM IMAGEDATA) + of STREAM)) + (COND + (YPOSITION (replace (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of (fetch + (STREAM IMAGEDATA) + of STREAM) + with YPOSITION))))]) + +(\DSPTRANSLATE.PSC + [LAMBDA (STREAM TX TY) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (MDX (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA) + TX)) + (MDY (DIFFERENCE (fetch (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA) + TY))) + (COND + ((NOT (AND (ZEROP MDX) + (ZEROP MDY))) + (POSTSCRIPT.SHOWACCUM STREAM) + (for REG in (LIST (fetch (\POSTSCRIPTDATA POSTSCRIPTCLIPPINGREGION) + of IMAGEDATA) + (fetch (\POSTSCRIPTDATA POSTSCRIPTPAGEREGION) + of IMAGEDATA)) do (CL:INCF (fetch (REGION + LEFT) + of REG) + MDX) + (CL:INCF (fetch (REGION + BOTTOM) + of REG) + MDY)) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + MDX) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA) + MDY) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTLEFTMARGIN) of IMAGEDATA) + MDX) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA) + MDX) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTBOTTOMMARGIN) of IMAGEDATA) + MDY) + (CL:INCF (fetch (\POSTSCRIPTDATA POSTSCRIPTTOPMARGIN) of IMAGEDATA) + MDY) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSX) of IMAGEDATA with TX) + (replace (\POSTSCRIPTDATA POSTSCRIPTTRANSY) of IMAGEDATA with TY) + (replace (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA with T]) + +(\DSPXPOSITION.PSC + [LAMBDA (STREAM XPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + OLDX) + (PROG1 (SETQ OLDX (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) + [COND + ((AND XPOSITION (NOT (EQUAL XPOSITION OLDX))) + (\MOVETO.PSC STREAM XPOSITION (fetch (\POSTSCRIPTDATA POSTSCRIPTY) + of IMAGEDATA])]) + +(\DSPYPOSITION.PSC + [LAMBDA (STREAM YPOSITION) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + OLDY) + (PROG1 (SETQ OLDY (fetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA)) + (COND + ((AND YPOSITION (NOT (EQUAL YPOSITION OLDY))) + (\MOVETO.PSC STREAM (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + YPOSITION))))]) + +(\FILLCIRCLE.PSC + [LAMBDA (STREAM CENTERX CENTERY RADIUS TEXTURE) (* ; "Edited 30-Mar-90 17:59 by Matt Heffron") + (LET (TEXTUREBM TEXTUREWIDTH) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (if (FIXP TEXTURE) + then (if (ZEROP TEXTURE) + then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") + elseif (OR (EQL TEXTURE 65535) + (EQL TEXTURE -1)) + then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") + )) + (if (FLOATP TEXTURE) + then + + (* ;; + "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") + + (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") + elseif (OR (TEXTUREP TEXTURE) + (NULL TEXTURE)) + then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) + (SETQ TEXTUREWIDTH 16) + (BLTSHADE TEXTURE TEXTUREBM) + elseif (BITMAPP TEXTURE) + then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) + (fetch BITMAPHEIGHT of TEXTUREBM))) + (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) + (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) + (POSTSCRIPT.PUTCOMMAND STREAM " " CENTERX " " CENTERY " " RADIUS " 0 360 arc" :EOL) + (if TEXTUREBM + then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) + (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch + BITMAPRASTERWIDTH + of TEXTUREBM) + 1) + " 0 " + (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) + 100.0)) + " findresolution " TEXTUREWIDTH " div div ceiling " + POSTSCRIPT.TEXTURE.SCALE " mul setpattern eofill" :EOL "grestore" :EOL) + else (POSTSCRIPT.PUTCOMMAND STREAM " eofill" :EOL "grestore" :EOL)) + (\MOVETO.PSC STREAM CENTERX CENTERY]) + +(\FILLPOLYGON.PSC + [LAMBDA (STREAM KNOTS TEXTURE OPERATION WINDNUMBER) + (* ; + "Edited 20-Nov-92 15:17 by sybalsky:mv:envos") + (DECLARE (SPECVARS FILL.WRULE)) + + (* ;; "OPERATION is ignored here") + + (LET ((LASTPOINT (CAR (LAST KNOTS))) + TEXTUREBM TEXTUREWIDTH) + (POSTSCRIPT.PUTCOMMAND STREAM :EOL "gsave newpath ") + (if (NOT (OR (ZEROP WINDNUMBER) + (EQL WINDNUMBER 1))) + then (SETQ WINDNUMBER FILL.WRULE)) + (if (FIXP TEXTURE) + then (if (ZEROP TEXTURE) + then (SETQ TEXTURE 1.0) (* ; "The setgray version of white") + elseif (OR (EQL TEXTURE 65535) + (EQL TEXTURE -1)) + then (SETQ TEXTURE 0.0) (* ; "The setgray version of black") + )) + (if (FLOATP TEXTURE) + then + + (* ;; + "If TEXTURE is a FLOATP, then it is specified in PostScript setgray notation.") + + (POSTSCRIPT.PUTCOMMAND STREAM TEXTURE " setgray ") + elseif (OR (TEXTUREP TEXTURE) + (NULL TEXTURE)) + then (SETQ TEXTUREBM (BITMAPCREATE 16 16 1)) + (SETQ TEXTUREWIDTH 16) + (BLTSHADE TEXTURE TEXTUREBM) + elseif (BITMAPP TEXTURE) + then (SETQ TEXTUREWIDTH (MIN (fetch BITMAPWIDTH of TEXTUREBM) + (fetch BITMAPHEIGHT of TEXTUREBM))) + (SETQ TEXTUREBM (BITMAPCREATE TEXTUREWIDTH TEXTUREWIDTH 1)) + (BITBLT TEXTURE 0 0 TEXTUREBM 0 0 TEXTUREWIDTH TEXTUREWIDTH 'INPUT 'REPLACE)) + (POSTSCRIPT.PUTCOMMAND STREAM (fetch (POSITION XCOORD) of (CAR KNOTS)) + " " + (fetch (POSITION YCOORD) of (CAR KNOTS)) + " M" :EOL) + (for K in (CDR KNOTS) do (POSTSCRIPT.PUTCOMMAND STREAM (fetch + (POSITION XCOORD) + of K) + " " + (fetch (POSITION YCOORD) of K) + " lineto" :EOL)) + (POSTSCRIPT.PUTCOMMAND STREAM " closepath" :EOL) + (if TEXTUREBM + then (POSTSCRIPT.PUTCOMMAND STREAM "100 100 scale ") + (POSTSCRIPT.PUTBITMAPBYTES STREAM TEXTUREBM T) + (POSTSCRIPT.PUTCOMMAND STREAM TEXTUREWIDTH " " (LSH (fetch + BITMAPRASTERWIDTH + of TEXTUREBM) + 1) + " 0 " + (TIMES 72 (QUOTIENT (DSPSCALE NIL STREAM) + 100.0)) + " findresolution " TEXTUREWIDTH " div div ceiling " + POSTSCRIPT.TEXTURE.SCALE " mul setpattern")) + (POSTSCRIPT.PUTCOMMAND STREAM (if (ZEROP WINDNUMBER) + then " fill" + else " eofill") + :EOL "grestore" :EOL) + (\MOVETO.PSC STREAM (fetch (POSITION XCOORD) of LASTPOINT) + (fetch (POSITION YCOORD) of LASTPOINT]) + +(\FIXLINELENGTH.PSC + [LAMBDA (STREAM IMAGEDATA) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + + (* ;; "Called by margin, font or rotation change to update the LINELENGTH field in the stream.") + + (LET [(TMP (MIN MAX.SMALLP (FIX (QUOTIENT (DIFFERENCE (fetch (\POSTSCRIPTDATA + POSTSCRIPTRIGHTMARGIN) + of IMAGEDATA) + (ffetch (\POSTSCRIPTDATA + POSTSCRIPTLEFTMARGIN) + of IMAGEDATA)) + (fetch FONTAVGCHARWIDTH of (ffetch + (\POSTSCRIPTDATA + POSTSCRIPTFONT) + of IMAGEDATA] + (replace (STREAM LINELENGTH) of STREAM with (COND + ((GREATERP TMP 1) + TMP) + (T 10]) + +(\MOVETO.PSC + [LAMBDA (STREAM X Y) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + (LET ((IMAGEDATA (ffetch (STREAM IMAGEDATA) of STREAM))) + (COND + ([NOT (AND (EQP X (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) + (EQP Y (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA] + (POSTSCRIPT.SHOWACCUM STREAM) + (freplace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with X) + (freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA with Y) + (freplace (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA with T]) + +(\NEWPAGE.PSC + [LAMBDA (STREAM) (* ; "Edited 5-Apr-89 17:31 by TAL") + (POSTSCRIPT.ENDPAGE STREAM) + (POSTSCRIPT.STARTPAGE STREAM]) +) + + + +(* ;; "Character-output, plus special-cases:") + +(DEFINEQ + +(\POSTSCRIPT.CHANGECHARSET + [LAMBDA (PSDATA CHARSET) (* ; "Edited 29-Apr-93 13:51 by rmk:") + + (* ;; +"Called when the character set information cached in a display stream doesn't correspond to CHARSET") + + (PROG* ((FONT (ffetch POSTSCRIPTFONT of PSDATA)) + (CSINFO (\GETCHARSETINFO CHARSET FONT))) + + (* ;; "since the call to \getcharsetinfo has NOSLUG? = NIL, we know that we will get a reasonable character set back") + + (UNINTERRUPTABLY + (freplace POSTSCRIPTWIDTHS of PSDATA with (ffetch (CHARSETINFO WIDTHS) + of CSINFO)) + (freplace POSTSCRIPTNSCHARSET of PSDATA with CHARSET))]) + +(\POSTSCRIPT.OUTCHARFN + [LAMBDA (STREAM CHAR) (* ; "Edited 23-May-93 12:00 by rmk:") + (* ; "Edited 4-May-93 02:20 by jds") + (* ; "Edited 3-Feb-93 00:45 by jds") + +(* ;;; "Output a character to be printed.") + +(* ;;; "Change font if necessary, do newline if at right margin, check for special chars and do appropriate thing, quote char and/or start postscript string if necessary.") + +(* ;;; "This is called a lot, so the code is unrolled for efficiency.") + + (DECLARE (GLOBALVARS \POSTSCRIPT.CHARTYPE) + (LOCALVARS . T)) + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (XPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA)) + (FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA)) + CHARWID NEWXPOS MAPPING) + (CL:UNLESS (EQ (\CHARSET CHAR) + (ffetch POSTSCRIPTNSCHARSET of IMAGEDATA)) + + (* ;; "Switch character set so that we get the right char width.") + + (\POSTSCRIPT.CHANGECHARSET IMAGEDATA (\CHARSET CHAR))) + [SETQ CHARWID (SELCHARQ CHAR + (SPACE (ffetch (\POSTSCRIPTDATA POSTSCRIPTSPACEWIDTH) of + IMAGEDATA + )) + (\FGETWIDTH (ffetch (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) of + IMAGEDATA + ) + (\CHAR8CODE CHAR] + + (* ;; "POSTSCRIPTACCENTED true if font has accented rendering characters in it; otherwise, a c-set 0 special font (SYMBOL, ZAPFDINGBATS...)") + + [COND + [[OR (NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTACCENTED) of IMAGEDATA)) + (AND (ILEQ CHAR 254) + (NOT (CL:AREF \POSTSCRIPT.CHARTYPE CHAR] + + (* ;; "OR is NIL if char is special in any way: Either font isn't supposed to be treated as an NS font (e.g. ZapfDingbats, which uses all the legal char positions for its own), or char itself is in cset 0 and ordinary") + + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + CHARWID] + (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with + T)) + (COND + [(ILESSP CHAR (CHARCODE " ")) + (BOUT STREAM (CHARCODE \)) + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + [(IGEQ CHAR 127) + (BOUT STREAM (CHARCODE \)) + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + (T (SELCHARQ CHAR + ((%( %) \) + (BOUT STREAM (CHARCODE \)) + (BOUT STREAM CHAR)) + (BOUT STREAM CHAR] + [(SETQ MAPPING (GETHASH CHAR *POSTSCRIPT-NS-HASH*)) + (* ; + "Special character that's taken care of by the NS mapping.") + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA) + CHARWID] + (SELECTQ (CAR MAPPING) + (NIL + (* ;; "just a remap within the lower 256. But the code in (CDR MAPPING) is in charset 2 to prevent recursion") + + (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING))) + (SYMBOL + (* ;; "Its in the SYMBOL font. Symbol is specified as %"2,xxx%" rather than %"0,xxx%" to defeat translations to symbol that go to matching character codes.") + + (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) + 'SYMBOL)) + (ACCENT (* ; "Special accent mapping we did") + (\POSTSCRIPT.ACCENTFN STREAM (CADR MAPPING))) + (ACCENTPAIR (* ; + "Given base char & accent, overlap them.") + (\POSTSCRIPT.ACCENTPAIR STREAM (CADR MAPPING) + (CADDR MAPPING) + (CADDDR MAPPING))) + (DINGBAT (* ; "A Zapf dingbat") + (\POSTSCRIPT.SPECIALOUTCHARFN STREAM (CADR MAPPING) + 'ZAPFDINGBATS)) + (APPLY* (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + + (* ;; "User function can call any stream operations it wants. At the end, we guarantee that baseline hasn't changed and that xpos is where the widthset it would be.") + + [freplace (\POSTSCRIPTDATA POSTSCRIPTY) of IMAGEDATA + with (PROG1 (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) OF + IMAGEDATA + ) + (APPLY* (CADDR MAPPING) + STREAM + (CADR MAPPING)))]) + (FUNCTION (* ; "Done as special PS code.") + (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + (POSTSCRIPT.OUTSTR STREAM (CADR MAPPING))) + (\ILLEGAL.ARG (CAR MAPPING] + (T (* ; "Special char") + (SELCHARQ CHAR + ((EOL LF) + (\TERPRI.PSC STREAM) + + (* ;; + "Set NEWXPOS to current value here and in FF to preserve value after external resetting.") + + (SETQ NEWXPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA))) + (FF (DSPNEWPAGE STREAM) + (SETQ NEWXPOS (fetch (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA))) + (TAB (SETQ NEWXPOS (IPLUS XPOS (\POSTSCRIPTTAB IMAGEDATA))) + [COND + ((IGREATERP NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) + of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) + of IMAGEDATA) + (\POSTSCRIPTTAB IMAGEDATA] + (\MOVETO.PSC STREAM NEWXPOS (ffetch (\POSTSCRIPTDATA POSTSCRIPTY) + of IMAGEDATA))) + ("357,140" (* ; " Ballot box, checked") + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) + of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) + of IMAGEDATA) + CHARWID] + (LET ((OLDFONT (\DSPFONT.PSC STREAM))) + (POSTSCRIPT.SHOWACCUM STREAM) + (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch + (FONTDESCRIPTOR + FONTSIZE) + of OLDFONT) + (fetch (FONTDESCRIPTOR + FONTFACE) + of OLDFONT))) + (\UPDATE.PSC STREAM IMAGEDATA) + (POSTSCRIPT.OUTSTR STREAM " bboxchk ") + (\DSPFONT.PSC STREAM OLDFONT))) + (PROGN [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch (\POSTSCRIPTDATA POSTSCRIPTRIGHTMARGIN) + of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch (\POSTSCRIPTDATA POSTSCRIPTX) + of IMAGEDATA) + CHARWID] + (COND + ((IGEQ CHAR 255) + + (* ;; "If it's 255 or above and we don't know anything about it, print the black box. Width vector will determine width of box, to maintain consistency.") + + (\POSTSCRIPT.PRINTSLUG STREAM CHAR)) + (T (SETQ CHAR (\CHAR8CODE CHAR)) + (COND + ((NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) + of IMAGEDATA)) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) + of IMAGEDATA with T))) + (BOUT STREAM (CHARCODE \)) + (SELCHARQ CHAR + ((%( %) \) + (BOUT STREAM CHAR)) + (PROGN [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + (freplace (\POSTSCRIPTDATA POSTSCRIPTX) of IMAGEDATA with NEWXPOS) + CHAR]) + +(\POSTSCRIPT.PRINTSLUG + [LAMBDA (STREAM CHAR) (* ; "Edited 9-May-93 21:55 by rmk:") + (* ; "Edited 4-May-93 02:20 by jds") + (* ; "Edited 3-Feb-93 00:45 by jds") + +(* ;;; "Internal function to display a black box for a missing character. Width is taken from widths vector, so that box and charwidth are always consistent. Caller (\POSTSCRIPT.OUTCHARFN) is responsible for guaranteeing proper caching of widths vector and for measurement and position updating, although \DRAWLINE.PSC also updates position.") + + (DECLARE (LOCALVARS . T)) + (LET ((IMAGEDATA (FETCH (STREAM IMAGEDATA) OF STREAM))) + (\BLTSHADE.PSC BLACKSHADE STREAM (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF + IMAGEDATA + ) + (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA) + (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) OF IMAGEDATA) + (\CHAR8CODE CHAR)) + (FETCH (FONTDESCRIPTOR \SFAscent) OF (FETCH (\POSTSCRIPTDATA + POSTSCRIPTFONT) + OF IMAGEDATA)) + 'PAINT) + (\MOVETO.PSC STREAM (IPLUS (FETCH (\POSTSCRIPTDATA POSTSCRIPTX) OF IMAGEDATA) + (\FGETWIDTH (FFETCH (\POSTSCRIPTDATA POSTSCRIPTWIDTHS) + OF IMAGEDATA) + (\CHAR8CODE CHAR))) + (FETCH (\POSTSCRIPTDATA POSTSCRIPTY) OF IMAGEDATA]) + +(\POSTSCRIPT.SPECIALOUTCHARFN + [LAMBDA (STREAM CHAR FAMILY) (* ; "Edited 23-May-93 13:31 by rmk:") + (* ; "Edited 4-May-93 02:20 by jds") + (* ; "Edited 3-Feb-93 00:45 by jds") + +(* ;;; "Internal function to output a special character to be printed, changing font if necessary. Width processing is carried out at higher level. If FAMILY is given, switches to that font (SYMBOL, ZAPFDINGBATS) before printing, then switches back.") + + (DECLARE (LOCALVARS . T)) + (LET* [(IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDFONT (AND FAMILY (\DSPFONT.PSC STREAM] + (CL:WHEN OLDFONT + (\DSPFONT.PSC STREAM (LIST FAMILY (fetch (FONTDESCRIPTOR FONTSIZE) of + OLDFONT) + (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT)))) + (CL:UNLESS (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T)) + [COND + [(ILESSP CHAR (CHARCODE " ")) + (BOUT STREAM (CHARCODE \)) + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + [(IGEQ CHAR 127) + (BOUT STREAM (CHARCODE \)) + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 3 (LRSH CHAR 6] + [BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 (LRSH CHAR 3] + (BOUT STREAM (IPLUS (CHARCODE 0) + (LOGAND 7 CHAR] + (T (SELCHARQ CHAR + ((%( %) \) + (BOUT STREAM (CHARCODE \)) + (BOUT STREAM CHAR)) + (BOUT STREAM CHAR] + (CL:WHEN OLDFONT (\DSPFONT.PSC STREAM OLDFONT)) + CHAR]) + +(\UPDATE.PSC + [LAMBDA (STREAM IMAGEDATA) (* ; + "Edited 20-Nov-92 15:13 by sybalsky:mv:envos") + + (* ;; "Make any outstanding font, scale, location updates, prepatory to something that might depend heavily on it. (e.g. before starting to output characters, or making a scale change)") + (* ; + "This code was originally in \POSTSCRIPT.OUTCHAR &c, and is here for commonality.") + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTPENDINGXFORM) of IMAGEDATA) + (\SETXFORM.PSC STREAM IMAGEDATA))) + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTFONTCHANGEDFLG) of IMAGEDATA) + (* ; + "If font was changed then switch before printing") + (\SWITCHFONTS.PSC STREAM IMAGEDATA))) + (COND + ((ffetch (\POSTSCRIPTDATA POSTSCRIPTMOVEFLG) of IMAGEDATA) + (* ; "likewise for position") + (\SETPOS.PSC STREAM IMAGEDATA]) + +(\POSTSCRIPT.ACCENTFN + [LAMBDA (STREAM CHAR) (* ; "Edited 28-Apr-93 16:35 by rmk:") + (* ; "Edited 3-Feb-93 01:05 by jds") + +(* ;;; "Output an accented character to be printed. .") + +(* ;;;; "Need to inc CHARPOSITION of STREAM") + + (DECLARE (LOCALVARS . T)) + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM))) + (COND + ((NOT (ffetch (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA)) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (freplace (\POSTSCRIPTDATA POSTSCRIPTCHARSTOSHOW) of IMAGEDATA with T))) + (BOUT STREAM (CHARCODE "\")) + (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) + -3) do (BOUT STREAM CH)) + CHAR]) + +(\POSTSCRIPT.ACCENTPAIR + [LAMBDA (STREAM CHAR ACCENTS UNDER-ACCENTS) (* ; + "Edited 17-Aug-93 17:02 by sybalskY:MV:ENVOS") + (* ; "Edited 3-Feb-93 01:29 by jds") + +(* ;;; "Output an accented character to be printed. .") + +(* ;;;; "Prints the character as \xxx, with 3 octal digits, to avoid tripping up on EOLs and other postscript-special characters.") + + (DECLARE (LOCALVARS . T)) + (LET* ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (FONT (ffetch (\POSTSCRIPTDATA POSTSCRIPTFONT) of IMAGEDATA))) + (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + (BOUT STREAM (CHARCODE %()) + (BOUT STREAM (CHARCODE "\")) + (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING CHAR)) + -3) do (BOUT STREAM CH)) + (BOUT STREAM (CHARCODE %))) + (BOUT STREAM (CHARCODE %()) + (for ACCENT inside ACCENTS do (BOUT STREAM (CHARCODE "\")) + (for CH + instring (SUBSTRING (CONCAT "000" + (OCTALSTRING + ACCENT)) + -3) + do (BOUT STREAM CH))) + (POSTSCRIPT.PUTCOMMAND STREAM ") (") + (for ACCENT inside UNDER-ACCENTS + do (BOUT STREAM (CHARCODE "\")) + (for CH instring (SUBSTRING (CONCAT "000" (OCTALSTRING ACCENT)) + -3) do (BOUT STREAM CH))) + (BOUT STREAM (CHARCODE %))) + (COND + (NIL (OR (IEQP ACCENT (CHARCODE "0,313")) + (IEQP ACCENT (CHARCODE "0,316"))) (* ; + "Cedilla and ogonek are under-accents, so don't raise them for capital letters.") + (POSTSCRIPT.PUTCOMMAND STREAM " 0 ")) + ((ILESSP CHAR (CHARCODE a)) (* ; + "upper case, so adjust offset for accent") + (POSTSCRIPT.PUTCOMMAND STREAM " " (/ (fetch \SFAscent of FONT) + 3.0) + " ")) + (T (POSTSCRIPT.PUTCOMMAND STREAM " 0 "))) + (POSTSCRIPT.PUTCOMMAND STREAM " " (FONTPROP FONT 'SIZE) + " ") + (POSTSCRIPT.PUTCOMMAND STREAM " accentor ") + CHAR]) +) + + + +(* ;; "Spacing-character (M-quad, etc.) and ballot-box-check &c special-case functions") + +(DEFINEQ + +(\PSC.SPACEDISP + [LAMBDA (STREAM WIDTH) (* ; "Edited 28-Sep-93 13:50 by jds") + (POSTSCRIPT.PUTCOMMAND STREAM (\PSC.SPACEWID (DSPFONT NIL STREAM) + WIDTH) + " 0 rmoveto "]) + +(\PSC.SPACEWID + [LAMBDA (FONTDESC CHAR) (* ; "Edited 28-Sep-93 13:41 by jds") + + (* ;; "Spacing character with a special width (e.g. M space, thin (1/5-M) space...") + + (* ;; "If CHAR is a list, it's (CHARCODE FACTOR), and we return a width of FACTOR * (CHARWIDTH CHARCODE). Otherwise, we just return the width of CHARCODE.") + + (COND + [(LISTP CHAR) + (FIXR (FTIMES (CADR CHAR) + (CHARWIDTH (CHARCODE.DECODE (CAR CHAR)) + FONTDESC] + (T (CHARWIDTH (CHARCODE.DECODE CHAR) + FONTDESC]) + +(\PSC.SYMBOLS + [LAMBDA (STREAM CHAR) (* ; "Edited 2-Nov-94 17:01 by jds") + (LET ((IMAGEDATA (fetch (STREAM IMAGEDATA) of STREAM)) + (OLDFONT (\DSPFONT.PSC STREAM))) + (\DSPFONT.PSC STREAM (LIST 'ZAPFDINGBATS (fetch (FONTDESCRIPTOR FONTSIZE) + of OLDFONT) + (fetch (FONTDESCRIPTOR FONTFACE) of OLDFONT))) + (POSTSCRIPT.SHOWACCUM STREAM) + (\UPDATE.PSC STREAM IMAGEDATA) + (COND + ((EQUAL CHAR "0,161") + (POSTSCRIPT.OUTSTR STREAM " bboxchk "))) + (\DSPFONT.PSC STREAM OLDFONT]) +) + + + +(* ;; "The mapping of NS characters to Postscript renderings, both as an AList and as a hashtable") + +(DEFINEQ + +(\POSTSCRIPT.NSHASH + [LAMBDA (MAPPING-LIST) (* ; + "Edited 30-Jul-93 14:46 by sybalskY:MV:ENVOS") + (* ; "Edited 4-May-93 02:21 by jds") + (* ; "Edited 3-Feb-93 00:33 by jds") + (for MAPPING in MAPPING-LIST unless (EQ (CAR MAPPING) + '*) + do (* ; + "Skip comments in the mapping list.") + (LET [(CHARCODE (CHARCODE.DECODE (CAR MAPPING] + + (* ;; "Fill in the translation entry for this character:") + + (PUTHASH CHARCODE + [DESTRUCTURING-BIND + (KIND CODE2 BASECHAR UNDERACCENTS) + (SETQ MAPPING (CDR MAPPING)) + (CONS KIND (SELECTQ KIND + ((SYMBOL NIL DINGBAT) + (CONS (CHARCODE.DECODE CODE2))) + (FUNCTION (CONS CODE2)) + ((ACCENT ACCENTPAIR) + (LIST (CHARCODE.DECODE CODE2) + (CHARCODE.DECODE BASECHAR) + (AND UNDERACCENTS (CHARCODE.DECODE UNDERACCENTS)) + )) + (APPLY* (* ; + "Apply setup function to coerce argument data") + + (* ;; "MAPPING is of the form ('APPLY* DATA PRINTFN WIDTHFN SETUPFN) PRINTFN gets applied to stream and result of applying SETUPFN to DATA. WIDTHFN gets applied to coerced data and fontdescriptor") + + (LIST (APPLY* (OR (CAR (CDDDDR MAPPING)) + (FUNCTION CL:IDENTITY)) + (CADR MAPPING)) + (CADDR MAPPING) + (CADDDR MAPPING))) + (ERROR "UNRECOGNIZED POSTSCRIPT CHARACTER TYPE" MAPPING] + *POSTSCRIPT-NS-HASH*) + + (* ;; "If this character is in the lower 127, we need to mark it for special handling in \POSTSCRIPT.CHARTYPE, by putting a T in the array at the charcode's position:") + + (CL:WHEN (<= CHARCODE 254) + (CL:SETF (CL:AREF \POSTSCRIPT.CHARTYPE CHARCODE) + T))]) +) + +(RPAQQ *POSTSCRIPT-UNACCENTED-FONTS* (Dancer ZapfDingbats "Dancer" "ZapfDingbats")) + +(RPAQQ *POSTSCRIPT-NS-TRANSLATIONS* + ( + (* ;; "Mapping of NS characters to Postscript renderings.") + + + (* ;; "First few are for control-codes in old Press fonts (Timesroman, etc.); not strictly NS, but undefined therein so should be OK.") + + ("^S" NIL "2,320") + (* ; "pressfont em dash") + ("^V" NIL "2,261") + (* ; "pressfont en dash") + ("^G" NIL "0,140") + ("0,244" NIL "2,250") + (* ; "generic currency symbol") + ("0,251" NIL "2,140") + (* ; "left single quote") + ("0,254" SYMBOL "2,254") + (* ; "left arrow") + ("0,255" SYMBOL "2,255") + (* ; "uparrow") + ("0,256" SYMBOL "2,256") + (* ; "right arrow") + ("0,257" SYMBOL "2,257") + (* ; "down arrow") + ("0,260" SYMBOL "2,260") + (* ; "degree") + ("0,261" SYMBOL "2,261") + (* ; "+/-") + ("0,264" SYMBOL "2,264") + (* ; "times") + ("0,267" NIL "2,264") + (* ; "Center-dot") + ("0,270" SYMBOL "2,270") + (* ; "divide") + ("0,271" NIL "2,047") + (* ; "right single quote") + ("0,274" FUNCTION " f14 ") + (* ; "1/4") + ("0,275" FUNCTION " f12 ") + (* ; "1/2") + ("0,276" FUNCTION " f34 ") + (* ; "3/4") + ("0,322" SYMBOL "2,342") + (* ; "registered") + ("0,323" SYMBOL "2,343") + (* ; "copyright") + ("0,324" SYMBOL "2,344") + (* ; "tm") + ("0,334" FUNCTION " f18 ") + (* ; "1/8") + ("0,335" FUNCTION " f38 ") + (* ; "3/8") + ("0,336" FUNCTION " f58 ") + (* ; "5/8") + ("0,337" FUNCTION " f78 ") + (* ; "7/8") + ("0,342" NIL "2,235") + (* ; "Eth (slashed D?)") + ("0,354" NIL "2,237") + (* ; "Thorn") + ("0,363" NIL "2,236") + (* ; "eth") + ("0,374" NIL "2,240") + (* ; "thorn") + ("41,172" DINGBAT "0,110") + (* ; "filled star") + ("42,42" DINGBAT "0,161") + (* ; "ballot-box") + ("42,61" APPLY* "0,161" \PSC.SYMBOLS \PSC.SPACEWID NIL) + (* ; "Checked ballot-box") + ("357,44" NIL "2,261") + (* ; "n dash") + ("357,45" NIL "2,320") + (* ; "m dash") + ("357,55" APPLY* "M" \PSC.SPACEDISP \PSC.SPACEWID NIL) + (* ; "M quad") + ("357,54" APPLY* "N" \PSC.SPACEDISP \PSC.SPACEWID NIL) + (* ; "N quad") + ("357,56" APPLY* "1" \PSC.SPACEDISP \PSC.SPACEWID NIL) + (* ; "FIGURE quad") + ("357,57" APPLY* ("M" 0.2) + \PSC.SPACEDISP \PSC.SPACEWID NIL) + (* ; "This space (1/5M)") + ("357,60" NIL "2,262") + (* ; "dagger") + ("357,61" NIL "2,263") + (* ; "double dagger") + ("357,062" SYMBOL "2,361") + (* ; "angleright") + ("357,063" SYMBOL "2,341") + (* ; "angleleft") + ("357,70" SYMBOL "2,315") + (* ; "perpendicular") + ("357,101" NIL "2,275") + (* ; "per mil o/oo") + ("357,104" ACCENTPAIR "<" NIL "/") + (* ; "not less than") + ("357,105" ACCENTPAIR ">" "/") + (* ; "not greater than") + ("357,110" SYMBOL "2,312") + (* ; "parallel") + ("357,111" SYMBOL "2,315") + (* ; "not parallel") + ("357,112" SYMBOL "2,316") + (* ; "element") + ("357,113" SYMBOL "2,317") + (* ; "notelement") + ("357,114" SYMBOL "2,047") + (* ; "suchthat") + ("357,115" SYMBOL "2,334") + (* ; "implied by, double arrow left") + ("357,116" SYMBOL "2,333") + (* ; "iff, double arrow") + ("357,117" SYMBOL "2,336") + (* ; "implies, double arrow right") + ("357,120" SYMBOL "2,253") + (* ; "double arrow") + ("357,121" SYMBOL "2,333") + (* ; "double arrow") + ("357,122" SYMBOL "2,333") + (* ; "l/r arrow") + ("357,126" SYMBOL "2,307") + (* ; "intersection") + ("357,127" SYMBOL "2,310") + (* ; "union") + ("357,130" SYMBOL "2,312") + (* ; "reflexsuperset") + ("357,131" SYMBOL "2,315") + (* ; "reflexsubset") + ("357,132" SYMBOL "2,311") + (* ; "propersuperset") + ("357,133" SYMBOL "2,314") + (* ; "propersubset") + ("357,137" SYMBOL "2,313") + (* ; "notsubset") + ("357,141" SYMBOL "2,306") + (* ; "emptyset") + ("357,142" SYMBOL "2,305") + (* ; "circleplus") + ("357,144" SYMBOL "2,304") + (* ; "circlemultiply") + ("357,146" NIL "2,267") + (* ; "bullet") + ("357,147" SYMBOL "2,260") + (* ; + "center circle (composition), lowered degree") + ("357,152" SYMBOL "2,330") + (* ; "logicalnot") + ("357,154" SYMBOL "2,320") + (* ; "angle") + ("357,160" SYMBOL "2,136") + (* ; "perpendicular") + ("357,161" SYMBOL "2,265") + (* ; "proportional") + ("357,162" SYMBOL "2,272") + (* ; "equivalence") + ("357,165" SYMBOL "2,362") + (* ; "integral") + ("357,167" SYMBOL "2,273") + (* ; "approxequal") + ("357,170" SYMBOL "2,100") + (* ; "congruent") + ("357,172" SYMBOL "2,345") + (* ; "summation") + ("357,173" SYMBOL "2,325") + (* ; "product") + ("357,174" SYMBOL "2,326") + (* ; "radical") + ("357,242" SYMBOL "2,246") + (* ; "florin") + ("357,260" SYMBOL "2,351") + (* ; "Ceiling, left ") + ("357,261" SYMBOL "2,371") + (* ; "Ceiling, right") + ("357,262" SYMBOL "2,353") + (* ; "Floor, left ") + ("357,263" SYMBOL "2,373") + (* ; "Floor, right") + ("357,264" SYMBOL "2,44") + (* ; "exists") + ("357,265" SYMBOL "2,42") + (* ; "forall") + ("357,266" SYMBOL "2,331") + (* ; "logicaland") + ("357,267" SYMBOL "2,332") + (* ; "logicalor") + ("357,271" SYMBOL "2,321") + (* ; "gradient") + ("357,272" SYMBOL "2,266") + (* ; "partialdiff") + ("357,313" SYMBOL "2,252") + (* ; "spade") + ("357,317" DINGBAT "0,63") + (* ; "check") + ("357,375" FUNCTION " f13 ") + (* ; "1/3") + ("357,376" FUNCTION " f23 ") + (* ; "2/3") + ("361,041" ACCENT "0,4" A) + ("361,042" ACCENT "0,1" A) + ("361,043" ACCENT "0,2" A) + ("361,044" ACCENT "0,6" A) + ("361,045" ACCENTPAIR A "0,305") + (* ; "A-macron") + ("361,046" ACCENTPAIR A "0,306") + (* ; "A-breve") + ("361,047" ACCENT "0,3" A) + ("361,050" ACCENT "0,5" A) + ("361,055" ACCENT "0,7" C) + ("361,060" ACCENT "0,13" E) + ("361,061" ACCENT "0,10" E) + ("361,062" ACCENT "0,11" E) + ("361,063" ACCENTPAIR E "0,305") + (* ; "E-macron") + ("361,065" ACCENT "0,12" E) + ("361,066" ACCENTPAIR E NIL "0,316") + (* ; "E-ogonek") + ("361,076" ACCENT "0,17" I) + ("361,077" ACCENT "0,14" I) + ("361,100" ACCENT "0,15" I) + ("361,102" ACCENTPAIR I "0,305") + (* ; "I-macron") + ("361,104" ACCENT "0,16" I) + ("361,114" ACCENT "0,20" N) + ("361,117" ACCENT "0,24" O) + ("361,120" ACCENT "0,21" O) + ("361,121" ACCENT "0,22" O) + ("361,122" ACCENT "0,25" O) + ("361,123" ACCENTPAIR O "0,305") + (* ; "O-macron") + ("361,124" ACCENT "0,23" O) + ("361,134" ACCENT "0,26" S) + ("361,137" ACCENT "0,32" U) + ("361,140" ACCENT "0,27" U) + ("361,141" ACCENT "0,30" U) + ("361,143" ACCENTPAIR U "0,305") + (* ; "U-macron") + ("361,145" ACCENT "0,31" U) + ("361,155" ACCENT "0,33" Y) + ("361,160" ACCENT "0,34" Z) + ("361,165" ACCENTPAIR Y "0,305") + (* ; "Y-macron") + ("361,166" ACCENTPAIR "0,341" "0,305") + (* ; "AE-macron") + ("361,167" ACCENTPAIR "0,352" "0,305") + (* ; "OE-macron") + ("361,241" ACCENT "0,204" a) + ("361,242" ACCENT "0,201" a) + ("361,243" ACCENT "0,202" a) + ("361,244" ACCENT "0,206" a) + ("361,245" ACCENTPAIR a "0,305") + (* ; "a-macron") + ("361,246" ACCENTPAIR a "0,306") + (* ; "a-breve") + ("361,247" ACCENT "0,203" a) + ("361,250" ACCENT "0,205" a) + ("361,255" ACCENT "0,207" c) + ("361,260" ACCENT "0,213" e) + ("361,261" ACCENT "0,210" e) + ("361,262" ACCENT "0,211" e) + ("361,263" ACCENTPAIR e "0,305") + (* ; "e-macron") + ("361,265" ACCENT "0,212" e) + ("361,266" ACCENTPAIR e NIL "0,316") + (* ; "e-ogonek") + ("361,267" ACCENTPAIR e "0,317") + (* ; "e-caron") + ("361,276" ACCENT "0,217" i) + ("361,277" ACCENT "0,214" i) + ("361,300" ACCENT "0,215" i) + ("361,302" ACCENTPAIR "0,365" "0,305") + (* ; "i-macron") + ("361,304" ACCENT "0,216" i) + ("361,314" ACCENT "0,220" n) + ("361,317" ACCENT "0,224" o) + ("361,320" ACCENT "0,221" o) + ("361,321" ACCENT "0,222" o) + ("361,322" ACCENT "0,225" o) + ("361,323" ACCENTPAIR o "0,305") + (* ; "o-macron") + ("361,324" ACCENT "0,223" o) + ("361,334" ACCENT "0,226" s) + ("361,337" ACCENT "0,232" u) + ("361,340" ACCENT "0,227" u) + ("361,341" ACCENT "0,230" u) + ("361,343" ACCENTPAIR u "0,305") + (* ; "u-macron") + ("361,344" ACCENTPAIR u "0,306") + (* ; "u-breve") + ("361,345" ACCENT "0,231" u) + ("361,355" ACCENT "0,233" y) + ("361,360" ACCENT "0,234" z) + ("361,365" ACCENTPAIR y "0,305") + (* ; "y-macron") + ("361,366" ACCENTPAIR "0,361" "0,305") + (* ; "ae-macron") + ("361,367" ACCENTPAIR "0,372" "0,305") + (* ; "oe-macron") + ("361,371" ACCENTPAIR a "0,317") + (* ; "a-caron") + ("361,375" ACCENTPAIR g "0,317") + (* ; "g-caron") + + (* ;; "Special code assignments for Dictionary of Old English, UToronto:") + + ("361,370" ACCENTPAIR a ("0,305" "0,306")) + (* ; "a - breve-macron") + ("361,372" ACCENTPAIR e "0,306") + (* ; "e-breve") + ("361,373" ACCENTPAIR e "0,305" "0,56") + (* ; "e macron underdot") + ("361,374" ACCENTPAIR e ("0,305" "0,306")) + (* ; "e - breve-macron") + ("361,376" ACCENTPAIR "0,365" "0,306") + (* ; "i-breve") + ("362,242" ACCENTPAIR "0,365" "0,317") + (* ; "i-caron") + ("362,241" ACCENTPAIR "0,365" ("0,305" "0,306")) + (* ; " i - breve-macron") + ("362,243" ACCENTPAIR n "0,305") + (* ; "n-macron") + ("362,244" ACCENTPAIR m "0,305") + (* ; "m-macron") + ("362,245" ACCENTPAIR o "0,317") + (* ; "o-caron") + ("362,246" ACCENTPAIR o "0,306") + (* ; "o-breve") + ("362,247" ACCENTPAIR o ("0,305" "0,306")) + (* ; "o - breve-macron") + ("362,250" ACCENTPAIR o "0,305" "0,56") + (* ; "o-macron underdot") + ("362,251" ACCENTPAIR o "0,316") + (* ; "o-ogonek") + ("362,252" ACCENTPAIR u "0,317") + (* ; "u-caron") + ("362,253" ACCENTPAIR u ("0,305" "0,306")) + (* ; "u - breve-macron") + ("362,254" ACCENTPAIR y "0,306") + (* ; "y-breve") + ("362,256" ACCENTPAIR y "0,317") + (* ; "y-caron") + ("362,255" ACCENTPAIR y ("0,305" "0,306")) + (* ; "y - breve-macron") + (* ; "235 = Eth") + (* ; "236 = eth") + (* ; "237 = Thorn") + (* ; "240 = thorn") + + (* ;; "NS Greek characters") + + ("46,101" SYMBOL "2,101") + (* ; "Alpha") + ("46,102" SYMBOL "2,102") + (* ; "Beta") + ("46,103" SYMBOL 0) + (* ; "--empty--") + ("46,104" SYMBOL "2,107") + (* ; "Gamma") + ("46,105" SYMBOL "2,104") + (* ; "Delta") + ("46,106" SYMBOL "2,105") + (* ; "Epsilon") + ("46,107" SYMBOL 0) + (* ; "Stigma") + ("46,110" SYMBOL 0) + (* ; "Digamma") + ("46,111" SYMBOL "2,132") + (* ; "Zeta") + ("46,112" SYMBOL "2,110") + (* ; "Eta") + ("46,113" SYMBOL "2,121") + (* ; "Theta") + ("46,114" SYMBOL "2,111") + (* ; "Iota") + ("46,115" SYMBOL "2,113") + (* ; "Kappa") + ("46,116" SYMBOL "2,114") + (* ; "Lambda") + ("46,117" SYMBOL "2,115") + (* ; "Mu") + ("46,120" SYMBOL "2,116") + (* ; "Nu") + ("46,121" SYMBOL "2,130") + (* ; "Xi") + ("46,122" SYMBOL "2,117") + (* ; "Omicron") + ("46,123" SYMBOL "2,120") + (* ; "Pi") + ("46,124" SYMBOL 0) + (* ; "Koppa") + ("46,125" SYMBOL "2,122") + (* ; "Rho") + ("46,126" SYMBOL "2,123") + (* ; "Sigma") + ("46,127" SYMBOL 0) + (* ; "--empty--") + ("46,130" SYMBOL "2,124") + (* ; "Tau") + ("46,131" SYMBOL "2,125") + (* ; "Upsilon") + ("46,132" SYMBOL "2,106") + (* ; "Phi") + ("46,133" SYMBOL "2,103") + (* ; "Chi") + ("46,134" SYMBOL "2,131") + (* ; "Psi") + ("46,135" SYMBOL "2,132") + (* ; "Omega") + ("46,141" SYMBOL "2,141") + (* ; "alpha") + ("46,142" SYMBOL "2,142") + (* ; "beta") + ("46,143" SYMBOL 0) + (* ; "(md beta)") + ("46,144" SYMBOL "2,147") + (* ; "gamma") + ("46,145" SYMBOL "2,144") + (* ; "delta") + ("46,146" SYMBOL "2,145") + (* ; "epsilon") + ("46,147" SYMBOL "2,126") + (* ; "stigma") + ("46,150" SYMBOL 0) + (* ; "digamma") + ("46,151" SYMBOL "2,172") + (* ; "zeta") + ("46,152" SYMBOL "2,150") + (* ; "eta") + ("46,153" SYMBOL "2,161") + (* ; "theta") + ("46,154" SYMBOL "2,151") + (* ; "iota") + ("46,155" SYMBOL "2,153") + (* ; "kappa") + ("46,156" SYMBOL "2,154") + (* ; "lambda") + ("46,157" SYMBOL "2,155") + (* ; "mu") + ("46,160" SYMBOL "2,156") + (* ; "nu") + ("46,161" SYMBOL "2,170") + (* ; "xi") + ("46,162" SYMBOL "2,157") + (* ; "omicron") + ("46,163" SYMBOL "2,160") + (* ; "pi") + ("46,164" SYMBOL 0) + (* ; "(koppa)") + ("46,165" SYMBOL "2,162") + (* ; "rho") + ("46,166" SYMBOL "2,163") + (* ; "sigma") + ("46,167" SYMBOL "2,126") + (* ; "(fl sigma)") + ("46,170" SYMBOL "2,164") + (* ; "tau") + ("46,171" SYMBOL "2.165") + (* ; "upsilon") + ("46,172" SYMBOL "2,146") + (* ; "phi") + ("46,173" SYMBOL "2,143") + (* ; "chi") + ("46,174" SYMBOL "2,171") + (* ; "psi") + ("46,175" SYMBOL "2,167") + (* ; "omega") + + (* ;; "NS Miscellaneous symbols") + + ("041,142" SYMBOL "2,271") + (* ; "notequal") + ("041,145" SYMBOL "2,243") + (* ; "lessequal") + ("041,146" SYMBOL "2,263") + (* ; "greaterequal") + ("041,147" SYMBOL "2,245") + (* ; "infinity") + ("041,150" SYMBOL "2,134") + (* ; "therefore") + ("041,155" SYMBOL "2,262") + (* ; "second") + ("356,055" SYMBOL "2,055") + (* ; "minus") + ("356,106" SYMBOL "2,340") + (* ; "lozenge") + ("356,163" SYMBOL "2,351") + (* ; "topleftbracket") + ("356,164" SYMBOL "2,353") + (* ; "bottomleftbracket") + ("356,165" SYMBOL "2,352") + (* ; "centerbracket") + ("356,166" SYMBOL "2,371") + (* ; "toprightbracket") + ("356,167" SYMBOL "2,373") + (* ; "bottomrightbracket") + ("356,176" SYMBOL "2,176") + (* ; "similar") + ("356,314" SYMBOL "2,251") + (* ; "heart") + ("356,340" SYMBOL "2,374") + (* ; "toprightbracce") + ("356,341" SYMBOL "2,357") + (* ; "braceextend") + ("356,342" SYMBOL "2,375") + (* ; "centerrightbracce") + ("356,343" SYMBOL "2,376") + (* ; "bottomrightbracce") + ("356,344" SYMBOL "2,354") + (* ; "topleftbracce") + ("356,345" SYMBOL "2,356") + (* ; "bottomleftbracce") + ("356,346" SYMBOL "2,355") + (* ; "centerleftbracce") + ("356,355" SYMBOL "2,363") + (* ; "integraltop") + ("356,356" SYMBOL "2,365") + (* ; "integralbottom") + ("356,357" SYMBOL "2,364") + (* ; "integralcenter"))) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS *POSTSCRIPT-NS-HASH*) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \POSTSCRIPT.FRACTION MACRO ((STREAM STRING) + + (* ;; "Handle printing of a fraction, given a string that's the name of the PS function (defined in \POSTSCRIPT.JOB.SETUP) that prints it. You must put spaces around the name.") + + (POSTSCRIPT.SHOWACCUM STREAM) + [COND + ((IGREATERP (SETQ NEWXPOS (IPLUS XPOS CHARWID)) + (ffetch POSTSCRIPTRIGHTMARGIN + of IMAGEDATA)) + (\TERPRI.PSC STREAM) + (SETQ NEWXPOS (IPLUS (ffetch POSTSCRIPTX + of IMAGEDATA) + CHARWID] + [COND + ((NOT (ffetch POSTSCRIPTCHARSTOSHOW of + IMAGEDATA)) + (COND + ((ffetch POSTSCRIPTPENDINGXFORM of + IMAGEDATA) + (\SETXFORM.PSC STREAM IMAGEDATA))) + (COND + ((ffetch POSTSCRIPTFONTCHANGEDFLG + of IMAGEDATA) + (* ; + "If font was changed then switch before printing") + (\SWITCHFONTS.PSC STREAM IMAGEDATA))) + (COND + ((ffetch POSTSCRIPTMOVEFLG of IMAGEDATA) + (* ; "likewise for position") + (\SETPOS.PSC STREAM IMAGEDATA] + (POSTSCRIPT.OUTSTR STREAM STRING))) +) +) + +(RPAQ \POSTSCRIPT.ORIENTATION.MENU + (create MENU ITEMS _ '(("Landscape" T "Print this file/document/image in Landscape Orientation" + ) + ("Portrait" 'NIL + "Print this file/document/image in Portrait Orientation")) + TITLE _ "Orientation" CENTERFLG _ T MENUOFFSET _ + (create POSITION XCOORD _ -1 YCOORD _ 0) + CHANGEOFFSETFLG _ 'Y)) + +(RPAQ \POSTSCRIPT.ORIENTATION.OPTIONS.MENU (create MENU ITEMS _ '(("Ask" 'ASK + "Always ask whether to print in Landscape or Portrait Orientation" + ) + ("Landscape" T + "Default printing to Landscape Orientation" + ) + ("Portrait" 'NIL + "Default printing to Portrait Orientation" + )) + TITLE _ "Default Orientation" CENTERFLG _ T)) + +(RPAQ PS.BITMAPARRAY (READARRAY-FROM-LIST 16 (QUOTE BYTE) 0 (QUOTE (48 49 50 51 52 53 54 55 56 57 65 +66 67 68 69 70 NIL)))) + + +(RPAQQ \POSTSCRIPT.JOB.SETUP + ("/bdef {bind def} bind def" "/ldef {load def} bdef" "/S /show ldef" "/M /moveto ldef" + "/DR {transform round exch round exch itransform} bdef" + "/L {gsave newpath setlinewidth 0 setlinecap" + " M lineto currentpoint stroke grestore M} bdef" + "/L1 {gsave newpath 0 setdash setgray setlinewidth 0 setlinecap" + " M lineto currentpoint stroke grestore M} bdef" + "/F {findfont exch scalefont setfont} bdef" + "/CLP {newpath M dup 0 rlineto exch 0 exch rlineto" + " neg 0 rlineto closepath clip newpath} bdef" + "/R {gsave setgray newpath M dup 0 rlineto exch 0 exch" + " rlineto neg 0 rlineto closepath eofill grestore} bdef" "/ellipsedict 9 dict def" + "ellipsedict /mtrx matrix put" "/ellipse" " { ellipsedict begin" " /endangle exch def" + " /startangle exch def" " /orientation exch def" " /minorrad exch def" + " /majorrad exch def" " /y exch def" " /x exch def" + " /savematrix mtrx currentmatrix def" " x y translate" " orientation rotate" + " majorrad minorrad scale" " 0 0 1 startangle endangle arc" " savematrix setmatrix" + " end } bdef" "/concatprocs" " {/proc2 exch cvlit def" " /proc1 exch cvlit def" + " /newproc proc1 length proc2 length add array def" " newproc 0 proc1 putinterval" + " newproc proc1 length proc2 putinterval" " newproc cvx" " } bdef" + "/resmatrix matrix def" "/findresolution" " {72 0 resmatrix defaultmatrix dtransform" + " /yres exch def /xres exch def" " xres dup mul yres dup mul add sqrt" " } bdef" + "/thebitimage" " {/maskp exch def" " /bihgt exch def" " /biwid exch def" + " /byte 1 string def" " /strbufl biwid 8 div ceiling cvi def" + " /strbuf strbufl string def" + " maskp not{{1 exch sub} currenttransfer concatprocs settransfer} if" " biwid bihgt" + " maskp { true } { 1 } ifelse" " [biwid 0 0 bihgt 0 0]" " {/col 0 def" + " {currentfile byte readhexstring pop 0 get" " dup 16#B2 eq {pop" + " currentfile byte readhexstring pop 0 get 1 add" + " currentfile byte readhexstring pop pop /nbyte byte 0 get def" + " { strbuf col nbyte put /col col 1 add def} repeat}" + " {dup 16#B3 eq {pop /col col" " currentfile byte readhexstring pop" + " 0 get add 1 add def}" " {16#B4 eq {currentfile byte readhexstring pop pop} if" + " strbuf col byte 0 get put /col col 1 add def} ifelse" " } ifelse" + " col strbufl ge { exit } if } loop" " strbuf }" + " maskp { imagemask } { image } ifelse" " } bdef" "/setuserscreendict 22 dict def" + "setuserscreendict begin" " /tempctm matrix def" " /temprot matrix def" + " /tempscale matrix def" "end" "/setuserscreen" " {setuserscreendict begin" + " /spotfunction exch def" " /screenangle exch def" " /cellsize exch def" + " /m tempctm currentmatrix def" " /rm screenangle temprot rotate def" + " /sm cellsize dup tempscale scale def" + " sm rm m m concatmatrix m concatmatrix pop" + " 1 0 m dtransform /y1 exch def /x1 exch def" + " /veclength x1 dup mul y1 dup mul add sqrt def" + " /frequency findresolution veclength div def" " /newscreenangle y1 x1 atan def" + " m 2 get m 1 get mul m 0 get m 3 get mul sub" + " 0 gt { { neg } /spotfunction load concatprocs" + " /spotfunction exch def } if" + " frequency newscreenangle /spotfunction load setscreen" " end" " } bdef" + "/setpatterndict 18 dict def" "setpatterndict begin" " /bitison" + " {/ybit exch def /xbit exch def" + " /bytevalue bstring ybit bwidth mul xbit 8 idiv add get def" + " /mask 1 7 xbit 8 mod sub bitshift def" " bytevalue mask and 0 ne" " } bdef" + "end" "/bitpatternspotfunction" " {setpatterndict begin" " /y exch def /x exch def" + " /xindex x 1 add 2 div bpside mul 1 sub cvi def" + " /yindex y 1 add 2 div bpside mul 1 sub cvi def" " xindex yindex bitison" + " {/onbits onbits 1 add def 1}" " {/offbits offbits 1 add def 0} ifelse" " end" + " } bdef" "/setpattern" " {setpatterndict begin" " /cellsz exch def" + " /angle exch def" " /bwidth exch def" " /bpside exch def" " /bstring exch def" + " /onbits 0 def /offbits 0 def" + " cellsz angle /bitpatternspotfunction load setuserscreen" " {} settransfer" + " offbits offbits onbits add div setgray" " end" " } bdef" + "%% - - - - - Fraction-setting code, to support NS fonts better - - - - -" + "/fractiondict 20 dict def" "/fractionshow " "{ fractiondict begin" "/denom exch def " + "/num exch def " "/regfont currentfont def" + "/fractfont currentfont [.65 0 0 .6 0 0] makefont def " "gsave newpath 0 0 moveto " + "(1) true charpath flattenpath pathbbox " "/height exch def pop pop pop" " grestore" + "0 .4 height mul rmoveto" "fractfont setfont num show" + "0 .4 height mul neg rmoveto regfont setfont (\244) show" + "fractfont setfont denom show regfont setfont end } bdef" + "/f14 { (1) (4) fractionshow } bdef" "/f12 { (1) (2) fractionshow } bdef" + "/f34 { (3) (4) fractionshow } bdef" "/f18 { (1) (8) fractionshow } bdef" + "/f38 { (3) (8) fractionshow } bdef" "/f58 { (5) (8) fractionshow } bdef" + "/f78 { (7) (8) fractionshow } bdef" "/f13 { (1) (3) fractionshow } bdef" + "/f23 { (2) (3) fractionshow } bdef" "/bboxdict 20 dict def" + "/bboxchk { bboxdict begin" "/regfont currentfont def" + "/chkfont currentfont [1.25 0 0 1.25 0 0] makefont def " "gsave newpath 0 0 moveto " + "(\161) true charpath flattenpath pathbbox " "/height exch def pop pop pop " + " grestore " " currentpoint " " .2 height mul .3 height mul rmoveto" + "chkfont setfont (\063) show" " moveto" " regfont setfont" "(\161) show end } bdef" + "/rencdict 15 dict def" "/encodefont { rencdict begin" "/newname exch def" + "/oldfont exch def" "/newcodes [" "8#001 /Aacute" "8#002 /Acircumflex" + "8#003 /Adieresis" "8#004 /Agrave" "8#005 /Aring" "8#006 /Atilde" "8#007 /Ccedilla" + "8#010 /Eacute" "8#011 /Ecircumflex" "8#012 /Edieresis" "8#013 /Egrave" "8#014 /Iacute" + "8#015 /Icircumflex" "8#016 /Idieresis" "8#017 /Igrave" "8#020 /Ntilde" "8#021 /Oacute" + "8#022 /Ocircumflex" "8#023 /Odieresis" "8#024 /Ograve" "8#025 /Otilde" "8#026 /Scaron" + "8#027 /Uacute" "8#030 /Ucircumflex" "8#031 /Udieresis" "8#032 /Ugrave" + "8#033 /Ydieresis" "8#034 /Zcaron" "8#177 /periodinferior" "8#201 /aacute" + "8#202 /acircumflex" "8#203 /adieresis" "8#204 /agrave" "8#205 /aring" "8#206 /atilde" + "8#207 /ccedilla" "8#210 /eacute" "8#211 /ecircumflex" "8#212 /edieresis" + "8#213 /egrave" "8#214 /iacute" "8#215 /icircumflex" "8#216 /idieresis" "8#217 /igrave" + "8#220 /ntilde" "8#221 /oacute" "8#222 /ocircumflex" "8#223 /odieresis" "8#224 /ograve" + "8#225 /otilde" "8#226 /scaron" "8#227 /uacute" "8#230 /ucircumflex" "8#231 /udieresis" + "8#232 /ugrave" "8#233 /ydieresis" "8#234 /zcaron" "8#235 /Eth" "8#236 /eth" + "8#237 /Thorn" "8#240 /thorn" " ] def" + "/olddict oldfont findfont def /newfont olddict maxlength dict def" + "olddict { exch dup /FID ne { dup /Encoding eq" + "{ exch dup length array copy newfont 3 1 roll put }" + "{ exch newfont 3 1 roll put } ifelse }" " { pop pop } ifelse } forall" + "newfont /FontName newname put" "newcodes aload pop" + "newcodes length 2 idiv { newfont /Encoding get 3 1 roll put } repeat " + "newname newfont definefont pop end } def" " /accentdict 10 dict def " + " /accentor { accentdict begin /scaler exch def /delta exch def " + "/unders exch def /accents exch def /mainch exch def /scrt (X) def" + " /w1 mainch stringwidth pop def " " currentpoint mainch show currentpoint 4 2 roll " + "accents { /ch exch def 2 copy moveto " " scrt 0 ch put " + " /w2 scrt stringwidth pop def " + " w1 w2 sub 2 div delta rmoveto scrt show " + " /delta delta 150 scaler mul 9 div add def" " } forall " + "unders { /ch exch def 2 copy moveto " " scrt 0 ch put " + " /w2 scrt stringwidth pop def " + " ch 46 eq { w1 w2 sub 2 div -175 scaler mul 9 div rmoveto scrt show 0 175 rmoveto }" + " { w1 w2 sub 2 div 0 rmoveto scrt show } ifelse " " } forall " + " pop pop moveto end } def " "%%%%EndProlog" "%%%%BeginSetup")) + +(RPAQQ SlopeMenuItems ((Italic 'ITALIC "This is an Italic Slope font") + (Regular 'REGULAR "This is a Regular Slope font"))) + +(RPAQQ WeightMenuItems ((Bold 'BOLD "This is a Bold Weight font") + (Medium 'MEDIUM "This is a Medium Weight font") + (Light 'LIGHT "This is a Light Weight font"))) + +(ADDTOVAR BackgroundMenuCommands + ("PS Orientation" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE (MENU + \POSTSCRIPT.ORIENTATION.OPTIONS.MENU + )) + "Select the default Orientation for PostScript output" + (SUBITEMS ("Ask" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE 'ASK) + "Always ask whether to print in Landscape or Portrait Orientation") + ("Landscape" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE T) + "Default printing to Landscape Orientation") + ("Portrait" '(SETQ POSTSCRIPT.PREFER.LANDSCAPE NIL) + "Default printing to Portrait Orientation")))) + +(RPAQQ BackgroundMenu NIL) +(DECLARE%: EVAL@COMPILE + +(RPAQQ GOLDEN.RATIO 1.618034) + +(RPAQQ \PS.SCALE0 100) + +(RPAQQ \PS.TEMPARRAYLEN 20) + + +(CONSTANTS (GOLDEN.RATIO 1.618034) + (\PS.SCALE0 100) + (\PS.TEMPARRAYLEN 20)) +) + +(RPAQ? POSTSCRIPT.BITMAP.SCALE 1) + +(RPAQ? POSTSCRIPT.EOL 'CR) + +(RPAQ? POSTSCRIPT.IMAGESIZEFACTOR 1) + +(RPAQ? POSTSCRIPT.PREFER.LANDSCAPE NIL) + +(RPAQ? POSTSCRIPT.TEXTFILE.LANDSCAPE NIL) + +(RPAQ? POSTSCRIPT.DEFAULT.PAGEREGION '(4800 4800 52800 70800)) + +(RPAQ? POSTSCRIPT.TEXTURE.SCALE 4) + +(RPAQ? POSTSCRIPTFONTDIRECTORIES (LIST (COND ((EQ (MACHINETYPE) + 'MAIKO) + "{dsk}/USR/LOCAL/LDE/FONTS/POSTSCRIPT/") + (T "{DSK}POSTSCRIPT>")))) + +(RPAQ? \POSTSCRIPT.MAX.WILD.FONTSIZE 72) +(DEFINEQ + +(POSTSCRIPTSEND + + [LAMBDA (HOST FILE PRINTOPTIONS) (* ; "Edited 20-Nov-95 11:29 by ") + + (* ; "Edited 20-Nov-95 11:26 by ") + + + + (* ;; "This is the send function for generic POSTSCRIPT printers. It branches on the architecture-specific function. The theory is that the send method is really a property of the operating system, not a property of specific postscript printers. These functions are contained in separate library files (or defined by user).") + + + + (SELECTQ (MKATOM (UNIX-GETPARM "ARCH")) + + (dos (DOSPRINT HOST FILE PRINTOPTIONS)) + + (UnixPrint HOST FILE PRINTOPTIONS]) +) + +(ADDTOVAR PRINTERTYPES ((POSTSCRIPT) + (CANPRINT (POSTSCRIPT)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (POSTSCRIPT.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION + TITLE)))) + +(ADDTOVAR POSTSCRIPT.FONT.ALIST (HELVETICA . HELVETICA) + (HELVETICAD . HELVETICA) + (TIMESROMAN . TIMES) + (TIMESROMAND . TIMES) + (COURIER . COURIER) + (GACHA . COURIER) + (CLASSIC . NEWCENTURYSCHLBK) + (MODERN . HELVETICA) + (CREAM . HELVETICA) + (TERMINAL . COURIER) + (LOGO . HELVETICA) + (OPTIMA . PALATINO) + (TITAN . COURIER)) + +(ADDTOVAR PRINTFILETYPES (POSTSCRIPT (TEST POSTSCRIPTFILEP) + (EXTENSION (PS PSC PSF)) + (CONVERSION (TEXT POSTSCRIPT.TEXT TEDIT POSTSCRIPT.TEDIT)))) + +(ADDTOVAR IMAGESTREAMTYPES (POSTSCRIPT (OPENSTREAM OPENPOSTSCRIPTSTREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) + +(RPAQ? POSTSCRIPT.PAGETYPE 'LETTER) + + + +(* ;; +"NIL means initial clipping is same as paper size. Don't know why the other regions were specified--rmk" +) + + +(APPENDTOVAR POSTSCRIPT.PAGEREGIONS (LETTER (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2)) + (LEGAL (0 0 8.5 14) + NIL + (-0.1 -0.1 8.7 14.2)) + (NOTE (0 0 8.5 11) + NIL + (-0.1 -0.1 8.7 11.2))) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS DEFAULTPRINTINGHOST POSTSCRIPT.BITMAP.SCALE POSTSCRIPT.EOL POSTSCRIPT.FONT.ALIST + POSTSCRIPT.PREFER.LANDSCAPE POSTSCRIPT.TEXTFILE.LANDSCAPE POSTSCRIPT.TEXTURE.SCALE + POSTSCRIPTFONTDIRECTORIES \POSTSCRIPT.JOB.SETUP \POSTSCRIPT.MAX.WILD.FONTSIZE + \POSTSCRIPT.ORIENTATION.MENU \POSTSCRIPTIMAGEOPS POSTSCRIPT.PAGETYPE POSTSCRIPT.PAGEREGIONS) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(POSTSCRIPT.INIT) +) + +(PUTPROPS POSTSCRIPTSTREAM FILETYPE :TCOMPL) + +(PUTPROPS POSTSCRIPTSTREAM MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP")) +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) +) +(PUTPROPS POSTSCRIPTSTREAM COPYRIGHT ( +"Venue This program or documentation contains confidential information and trade secrets of Venue. Reverse engineering, reverse compiling and disassembling of object code are prohibited. Use of this program or documentation is governed by written agreement with Venue. Use of copyright notice is precautionary and does not imply publication or disclosure of trade secrets" + 1989 1990 1991 1992 1993 1994 1995 1997 1998 2018 2021)) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (22629 29733 (POSTSCRIPT.INIT 22639 . 29731)) (30777 65561 (PSCFONT.READFONT 30787 . +32695) (PSCFONT.SPELLFILE 32697 . 33275) (PSCFONT.COERCEFILE 33277 . 34849) ( +PSCFONTFROMCACHE.SPELLFILE 34851 . 35836) (PSCFONTFROMCACHE.COERCEFILE 35838 . 37490) ( +PSCFONT.WRITEFONT 37492 . 38507) (READ-AFM-FILE 38509 . 44380) (CONVERT-AFM-FILES 44382 . 45594) ( +POSTSCRIPT.GETFONTID 45596 . 46991) (POSTSCRIPT.FONTCREATE 46993 . 59392) ( +\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 59394 . 61791) (POSTSCRIPT.FONTSAVAILABLE 61793 . 65559)) (66110 +75256 (OPENPOSTSCRIPTSTREAM 66120 . 74922) (CLOSEPOSTSCRIPTSTREAM 74924 . 75254)) (75301 81122 ( +POSTSCRIPT.HARDCOPYW 75311 . 78660) (POSTSCRIPT.TEDIT 78662 . 79142) (POSTSCRIPT.TEXT 79144 . 79435) ( +POSTSCRIPTFILEP 79437 . 80073) (MAKEEPSFILE 80075 . 81120)) (81123 126009 (POSTSCRIPT.BITMAPSCALE +81133 . 83589) (POSTSCRIPT.CLOSESTRING 83591 . 84125) (POSTSCRIPT.ENDPAGE 84127 . 84998) ( +POSTSCRIPT.OUTSTR 85000 . 86021) (POSTSCRIPT.PUTBITMAPBYTES 86023 . 94494) (POSTSCRIPT.PUTCOMMAND +94496 . 95545) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95547 . 100995) (POSTSCRIPT.SHOWACCUM 100997 . 103235) ( +POSTSCRIPT.STARTPAGE 103237 . 105816) (\POSTSCRIPTTAB 105818 . 106689) (\PS.BOUTFIXP 106691 . 108041) +(\PS.SCALEHACK 108043 . 110872) (\PS.SCALEREGION 110874 . 111434) (\SCALEDBITBLT.PSC 111436 . 115736) +(\SETPOS.PSC 115738 . 116200) (\SETXFORM.PSC 116202 . 118021) (\STRINGWIDTH.PSC 118023 . 118477) ( +\SWITCHFONTS.PSC 118479 . 124636) (\TERPRI.PSC 124638 . 126007)) (126044 181764 (\BITBLT.PSC 126054 . +126607) (\BLTSHADE.PSC 126609 . 130891) (\CHARWIDTH.PSC 130893 . 131660) (\CREATECHARSET.PSC 131662 . +133360) (\DRAWARC.PSC 133362 . 135842) (\DRAWCIRCLE.PSC 135844 . 138253) (\DRAWCURVE.PSC 138255 . +142276) (\DRAWELLIPSE.PSC 142278 . 144755) (\DRAWLINE.PSC 144757 . 147107) (\DRAWPOINT.PSC 147109 . +147697) (\DRAWPOLYGON.PSC 147699 . 150813) (\DSPBOTTOMMARGIN.PSC 150815 . 151380) ( +\DSPCLIPPINGREGION.PSC 151382 . 152825) (\DSPCOLOR.PSC 152827 . 153668) (\DSPFONT.PSC 153670 . 157880) + (\DSPLEFTMARGIN.PSC 157882 . 158451) (\DSPLINEFEED.PSC 158453 . 159029) (\DSPPUSHSTATE.PSC 159031 . +160794) (\DSPPOPSTATE.PSC 160796 . 163305) (\DSPRESET.PSC 163307 . 163953) (\DSPRIGHTMARGIN.PSC 163955 + . 164527) (\DSPROTATE.PSC 164529 . 165552) (\DSPSCALE.PSC 165554 . 166485) (\DSPSCALE2.PSC 166487 . +167306) (\DSPSPACEFACTOR.PSC 167308 . 168280) (\DSPTOPMARGIN.PSC 168282 . 168999) (\DSPTRANSLATE.PSC +169001 . 171575) (\DSPXPOSITION.PSC 171577 . 172176) (\DSPYPOSITION.PSC 172178 . 172750) ( +\FILLCIRCLE.PSC 172752 . 175398) (\FILLPOLYGON.PSC 175400 . 179316) (\FIXLINELENGTH.PSC 179318 . +180812) (\MOVETO.PSC 180814 . 181565) (\NEWPAGE.PSC 181567 . 181762)) (181820 204972 ( +\POSTSCRIPT.CHANGECHARSET 181830 . 182634) (\POSTSCRIPT.OUTCHARFN 182636 . 195493) ( +\POSTSCRIPT.PRINTSLUG 195495 . 197462) (\POSTSCRIPT.SPECIALOUTCHARFN 197464 . 199896) (\UPDATE.PSC +199898 . 201121) (\POSTSCRIPT.ACCENTFN 201123 . 202065) (\POSTSCRIPT.ACCENTPAIR 202067 . 204970)) ( +205070 206715 (\PSC.SPACEDISP 205080 . 205359) (\PSC.SPACEWID 205361 . 205980) (\PSC.SYMBOLS 205982 . +206713)) (206824 209815 (\POSTSCRIPT.NSHASH 206834 . 209813)) (254855 255569 (POSTSCRIPTSEND 254865 . +255567))))) +STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..f41c947a45e2183f232c47ac0eea3d28cc179820 GIT binary patch literal 91396 zcmeFa3v^uPeIGb8ph$`qAOM768m8&1F-3z6F~U3mf{ZNB#moRRz|7nc1|SKF5)5)6 z;V}YO5b~pGwziu`vuB$g+x0VXb7Cj$xPY`$D(~>Pc8Sw`eRWm z)_*2;`piHyZ1sjOuRM8Wp*mNwR+g=>b>Jt`eYvqX0KFdmmkWnT%N5y z^yFNnI``ptWZ7nYvrPbNh4?k3L%9G{PM6NVhp2Q0akspsnkNe*lJ$)vT zI1}&3J67l1m(G3Y%Ieko&sZ1BnaT4b&O{+nDyOUk3}s|0pSR3GM__^AR&3yOY$$GBS)Kd9!pc)ud35-g1L0`Qn{13Pnm99n5C4(PZU6BD z-i$|b#oVOb-=7$;&ZLJ9^yaLXmChA1#d6LmS~)9f4d*5cb_vOTOP1%j6_^eL0xiRp zC-4*4`K8)?@&KjmyXo&M?Yre~TKj09U8PQ=JNT>sGX146QkCtQ)(31 zOl~wgX`PB%=`xnu#-<&NtFm*s^kmi=IOP>32K~(v{a#rt=4%!mbc>F+_Qv}y^`=3K zyG7pd*1AcP`6^k_0n6@>o*J@{OmOlvCF7htMah`;A^PdJMoRcSZ8`Zg20xOtbi;`Ib-TwvJ>kOxKX{^|8(sT3KFXUZZP)FYxbl_U-Hc9$nsdx6{TMU%VFhs7lVX z{Yz@Jam8udONs5hTirUjXX`CG8JcOY@nCeu{_dGhx2BY|S6Vi@*WVu6JnD2hc=#25 z*W1^-__xPx+0(VZb`S$@`Pj8vRebFff35!1_4m=^0qL?UME|-sPdHshMsVw1hf0E5 z`{*|~-_tYS!=KIl{{B4m{u|t&Qju-mdKZ1%dYADkZa_8v)BNS|axlR47v4hk-bR0_ z|3lU42;JixsyN*@zj!V9t%F>H|8U#)Q>}MN|6PHaN`!P`k525>2}>vT>%;+_xJM`2 zbfR4+I(4E;C%SdwkWTdI#9^IC>%iC;D~bs7@TyiC&#Jp%W){;z6BwNGFmy zF{~3Yok-|JUMI$MqNo$+bz(v%CUxR5ow%qI7j)vRPGogrL?_PZ#E?!5>O`a_YkQ0L zB&W|E<#cyiqxmZj&#Z(L^Q#ze0mh6dg2Do0T>*pwd z*~QFRJAXC`fCl8?Ocm1rV+jke3xIi$UObU0IA=3`>8VmamjeAzCV;Kp07!Zo5Yzm$ z6h3Hjx|FeohGO-gj6V7VzPjIRkt=|RaY|)tXfS3Kfheq@fw)Q}5-JfNFyN(u<%VK| zss=t)8ut%L;?!x(c_EWN7a7h^(x|Lcr}1LWIq!^&fXc8=4dGKbXIkf+!ju3Vl`x`7 zd@a);r+}6?bE=#*at9K~ov_c998h3V5r~&6YM8B>$AJNnJK=aeV!64kJ&}@@v}`m= z#!!-l)w&2Iohy!-nfM0mkbKF>Pmel9t~q!bpCKbLGBN-B)(pN>s-2S0Nab^-5_+A; zi~^}h(O|-uU~6zdzM~8pGc#hRCY=eX1|&><4m*>RPN4v7o>T4P^gZ}+r)1{F@KK;m zOA|S19>o`-R?5li4uMB0hp~T5Dq$nKS)2pP3L7qSu7r&u86dPSa+5UZ87!~lp2B*V z&x7~~6ymI8Py3Lip;aMF?IL0N@q zK$INO1(FM5iJG1F=O#du6+exUdVNIPvmeI-ogrE@XXpDe`3xw~Nh>}WwXhY13K9;%nE(ijo5P6X zq@S>2pc%b>t=OP%s4*No>P5jyD;68zXQ8;F{Unos@aYoY@n>WCJT zs+b?+30v8C!bUcpt9ol^<8O1JvEZRxD3rDS zJZs&cl$rFU{SP5csx4OdrH>q{-dgMk-Brln-0U7NNPkSl)e1{5J-Ys#gIRt(y&<&R z@|XM@3ch?uhR>st3c*|m|L6bYkNT^B+~1J;z@D=`m+#4e6N>c@TKT?|&8QgLQcd7U zE|X7#C5X#O1rsoEnof!hz5|R0(+2}li_RR-4G!}-R{bs}lAaDH`L{c?)snP_7t@RU$jjfl zAJqbwCxX88m3o(9(7=}-K%o3|ZX!c?DF=cCWQnP7!l%qf^Cw&vq5#ZN*bJuuTJ1Qx}ReWl`9REpVz$p=DTW1 zn|n+(cKI237l>WmH{LIm8^^iecG+7qM!*&MkH7yjs_*%oryo$gBY9M{eEJ>gMcmRi ze%c(srW$g2yE6t-u`xG#8rw!eIj?RMII&4CNRh@|&=8H8padE+X^(H1KxtJDR7uZt01I&od#L#pSz(SP+_v=h|1o&zfkBm$>1qS>PZ>p6P z>dgZU5``Ftnhvi*DuKCRFmRU-its*Jlq17w4_ZIm9qI@MvXzZ^FdM@E`9Jxi{^}q1 zSA%WZYo|55#x(lDbqu5rjY{Xz`kz*S*WGl06HNhA^J)9<5Qi7|zZh|j7T2w`aqQ58P^GIj)9G~SDoDCjm@;l7xz)|jDl$0P zp3OOj`Sml0YBSx=A>9y3x1nPhMt4})PnIdW?EZTW-E6)NfX2(6(*6r)^SxiY68v09>jK~c;~DIO2h zgV!pzHuvOJYMStxx_RK>J*?N4IS*-AAB`Gvq|5~CFqRMQ3$z%FRUJnN_G__@ee2k| zSNO9UA0pD@?<*>lHOfw7r?Kge!~#h|8Vs zE?1uJO5qRJ7AwpD@D|gdJva;%=TO&y+T~-?TJ_#r*L#0`?-0E^J#W}Mby;p&qFNmu%Su%tmHQS<*ospgyV*$CI}(=qI2Z6 zFFHs55q@8#*W#b(a?}HH;P@B30mvswm4UtEwDUW^!=I$;b7`=l@TX-sGQ)bPw}vHm zrc-@MwRLCX|Catk`9n3QbEzZL;e;LQ<|nQNKH1UUDfMMSHom7?AC(OvuwM0a`9#e* zx_I;RW6sgnHu{~T7uNflwY_|@b}n}AK_?7Y9EPgwAVxYSpFMs^YLM_@2w+n|;UVZw34{r_8Uoa1X~QXq^CoNvb|Du> z1xY~?OjWH@pi?*t@_&F=$phq&YJ-65UXOziqN{w!^r1sIQ_dAiFkBF6b{}L7kTVQI z+-9^%kf`bW1XRGRb~tnY{SR1!P`pZJKPgntaOMEu7r%Z0rIJ9YN@y_&B;vchHvy(; zLPlaGpv&-JRb*7elaP3kq*El|eYl?7H$rJ%o%R1AU~)i#C}%mU#nCrOXP2#<6%QJOYlj-(`t)Gz;=s(3X|j$L!AP;E@Ia}2y)&!1qp2m zva3O~6gD^EalZ-l;bvn-bUFs~t^}4eTUiLnMvAbrpp}J6!6}r8*fUl9n8udGro z5V90w3rMk|8o0cbba&yf1^FQt7H6NF3m<>n2}{wM3T7F2b7DN zvSI55C8Y$NAzKXz$S#>GAkt$bFS0&V>m#8X#C<;r_!~^F50Mrj#4~ZM6b4{69+sY`$gdEe8*hrhR+9JqX}SWUSN4knVbJiPA1A;)LS( z9~l$OSPZ>T2tA(fMNZY(1-2 z31QR^N$zpp^6BG5MD^;Os{|(gM-nZ%>J|giDAofLiDL}NLvmG9o)~lGiBY{q%zotX z(g3KWz@CowKvFmio?gPI=aUs6$KjpL?wS&{eGak@EMFt2WVCe z3>_pmU@|r<40(W-Xt$0-n2ba}XMtKq7E|gpkuZlMWhjVQXn4p{hlP7g0GEgJPHG%k zfFkATg5=R7ES9uZwhT4LNB8dm@7H1P$p)XvhAsr39Rnkm+lrrSx6gHsgIoH>i-C@o zeTD5K#c%)FH?{*?Zz+DeFwYx%J3zeLH=MSw2b{KcMM1pxT-Vbi`HfHqUDN^Z@H^@v zS5cijR6EyAy#)S}dg*?1z34vp3ts#cUj1{OFGhu?y7A^l60LDJ`8PKUPd~t|#_zNh zq;=R%7X=a0ZU9YV#mPFspA{Pb<5`!*{32+NC|L;j%SdBLOl*{Nz5XHq3Mv6U^cP^u z$I+vmNvm)Py@y)8j0_|{lPOU z*=p0R46=#9!*ELw8#5@Y`SeiPP7=)wpj-wFsD`rlwsm&2gtFU5a%x}ZzMa+kGDrJz z?CXIs(2hXX4WBqDHYg`B++BvL4=Aimz2ibB(>zT$o~NzJ0@>2R1R|BCUyL5QB&;Fy zmaKdP;^ALFK(Y%|=MptpWbenh27%T6qMLhgc1ldTs03~?V`?p4=lfVIrniZ^sR0v$A*K$fY-D*-)^^;cEB(F zDzrVRv_ej`p#Qg9}vWoy_&TK=uErufoNxkz(bG z*Fqm+zDeM@V)|-D%2QIRS0uB&=Ja3`Unz!)LA*vdyK8|@OZWV$jpPzWxX{W5fsbsx z*BIT_TaAZ{m4C*q9>eQ{f5UGA-dFDg;-6oCNNftbd85AP1)Ix)ulNTkxgmdcdu`#- zT9KjUFTJ1U;a%KE5lC=Gm}#)})k+uG_B0vaCA(mFXM;Jf40r9VRTjVg7A7-pfaR<> zN4^e2JAh)?-8t=Fzq?kwwRA%m;u%N-9INX{ZRSvA`v^hsMdy&56d8J8rdvJ;+-qlH zV~9m+oz77wd~>tc>2{8O!-lovQHJB@cYQqoh7gR~(e-a0Tt9BMdIz_18+jG~!@=sU zYRiqK8{d+Zf*cQuZS}6VJ6(7eH+?bSwfWx<=C@kMD_@YocKvi(5K8c%b8O@Oq;o8| zvw6fh#HDz!#ddd*m3BQnU0pS?X><;y(!3FPj@_q@&|7)xIag@0x@YGQfXFHEnLxH| z`F0BIl}-4q~1;&ICvt%18i2`(Ym#LQs)L+c>}ww}}nG;DdNrkTNdyN#rF% zkQe}+CP_UF8QBD=+$KVL07pN62O|O9hud+~XS`*QmQk>rJRZcJ-w6g&*Mnz3UAKhc6Icomy;dBwG5y9ss?u*1{3HK@y~OYF);rqqiWH{7 zG7f{aoQna$oifs76h`CY-AEXW5-byDlZ^K&`m+(qrp?ng_IsVNa~iJa5wkJF~F~Sk#70?6xSG-nphgB)L$h z;54WoCOV0S^Y3JGzNpKAy^N}jQ&(43pFw+^Op$mm1N>;tSu@4z_c&;{=;N2QF z5S@k*v^ox0i6U98;q~N+0lHJjNSsF|CrR9SPLX;fOSI2PJ}o#jB}_ajGoxudi44wo zjaXGdv;wnHF*qXnv1Cs|Y)9@kKL|M({Lk+KIoN34z<9SK*}|B0y}J^8Bs3oE`Q6;s zzU+L@g^y;BJp;kXcgH$A!u#MHBDE?cfZ5;C{}!h`&l{czhV>t(Y&a|^BA}zq=?Q{Z zg4O!r0_?K(IEN2)c9Q(1YwK>ObG~P$`(sY$F-Yj~hJWpJD}Ry`%Ae#5c&B~PInuHP zfq3U*HlI-tu)!$CQM?xTYkn#Dmi%wQnPWB4`s{p}iH?nPs`_u)&aqH%=PUGgX=fv; zZI60}krN7j@3)5;kaUOSapPUiF~{Oh+U#2Z8Nc&(~s_A=&pYz zQgcp%Ks&kqvJ*Qt(~s_)2)_7;lW5s`n={ziBknarYC1kO2HDkv0$(t;2WQUIoT05w z=L|X-GCe?;+ zjWegJ;qatc1w;jLe+}`ol9mEdH|hC)IHaXVi4}DN!g*YA%4|$iJ+0X!1d4t zr7}6VGK@mvsRtSbU8Jhu#YPnvKT19*36>`Z}Kni>*L8UsWDX3p2BeaoG2?R70Dfi=FX1S7DdGg7*D$Y87I)_&K#YH@mj5vYdt&F%?8Hey@NkmsYN>l`pR@Tv@Zys|z2PTeVUvS3bN- zh7(qA3WUq)p`pI$X)tJKVMj4%%`U@ndTk!w(%}Oz;f9eljb?ITttu}7g%QU8;2J?c z5OmWItUbBf@XAxmm4)Repai1Ppz!|t?<z>3iPDun_#v4d}~V}#3xb+22Ogihk1TJ zcNk(GKCV4n#F+hEmBp?HYgKUsRmT4vFz&46x`t|kq55S)yqF)0xrnUbiSt}_!iFOJpRMb zr*?F2@F4fFZZjb^<{T1uD*b)!o{q}W&gR=Ii#wmHja6IM4^~4v8(m1LTGa!RAWhlt zsWEP~>%>0p`ceMNulL5la}?TYH9YV+q`O_o(8Twyth9u9^1F zLqXWat+oy>x3yQ6|LqRHlD~SUT{?2wgI#-dG8F7O;H8~*@Q%Tkp1k!^*F8EnNSTti ze@wlp((0RF zw~FU_UU}i#>%S@Ww*y^=^+w!$P#W=yGQY~HosGl1+FJ4RR&ht=CHxunn$M0^FYwrE zV_f%LQW+lBDzUfb?miIu6{qVD106N_DA@}@a;HgD<(+VlUlUMoAOgkde&|ME=S5Tn zgMU$B`8QIaCxu?ES*tb8s9 z2TsZ@v!~l2xMiP%+#rlFj79^%1kxU0kE9m^z`5+j1~nl-80D1#fT6c3l|{s;E5Z<; zEFj4CWB?$wp}ZeGtMUZ!s=`%lMIuNIcur>m^C(OQ5u!@rlO+`gs#X!A^|WC z8j=x&(2>B2n9ssl_Lw1QM>9MlbZ8U<6uU`MSBVe={*#{J2l3bxmqe2?K+NO^tPsZ# zq?abAfv!ln2CI%Cp9mA1=M;(7{9B4}1zZx@cuC8phDg9`ekJ^YiXyX$$le0sVwcCQ zAz)vl9yHe@nTd$88L_eo1Hn(&Ov6@2zm435y(Xvpe$0#|Phrxt5cq;-q78{zB3n=M z*~e>18yqWD2ck@zByXHtKB(k}5MP2kYbXWD)R0GJ4t2c@kh5uh9yXcY`J~>gD^B>` zJ9#h(+G+LmKnT{O`#4d79;_fRLF)&z7LbWVXQ(IIF1iQ=uh7NHKr9X==ovVilNuMT z{JrU89Isngw>K=P_ad^Ta$iIS`)WtVh#xk39&?5xpq!>aNr9rTKPXX%kJa{%;yd`5 zk?>u07A5y$uQQ$!a%?ABP*;IHlum-^Wm7E@PJ=Onh1KvhjJv>%W9u9J(7da?5AekE z1~H!=2MPR04@zf6T+l$iIq7L4i3ecDcPiG8J(WQ3OlN{PF3+t!bp<3Q4laV|%sq}I z)D__e7M`4aV(#j~-=BMY_VSuo8&Q?1<)!774=$VJ@D)_F);@e?4rFsQegHB)ya7_Y zdOPU@%{`Bm;#%{j5GIEMWH7{tM#w$J+>G5knvd8l9|D5;HaWxsq4)&}8JNFe8$bey z`4U(dwa#RmJdwxr%d$yDcu%g*BIMC3tfah^ivTF4N#=4+lh?42V zlak>HN%P-fwwmpca3&qmmaItP`={l%`}+K|sjZ(}tcYCxMJ1_!v4xvm+AAbNPAYf4 z@`#-Zra&W)1;;?|jHmGDm6xlbZ@vUW7UW2l&ZAQN7Ygz~_>YjLSzbW-+s7G&13*?t&5#*598%vQGQ(Jh9Q=t) zDNkOnufU+{VO*qdz!Xfi8dNGpNJlC4r4fnAvuSim7hz2kLX0jUI4W!>%9*Z15#k)T#}ZI zf((qj4>q!(Yw#9G4~Y(Rj}j;kUW-WpDh&Zi9Klw`&_ZyWixQn#NYLHs!n5ySQfoba zNI2|a@^Xl~=#$PB(}{edNXlq_phfa9ukVP$_YndXf=)06KNcYGLLr-B-N2tKLZbK6 zH_z|je`E_URu}Z`^ugz`k9cAD=+Z_qUqt0pV9*;tx8AC;{VNfwCU~p+bZTGHpYAT$ zLl}~BuxDc3gPS~X2A*5*OfGU^(yHFS^YlLa+_$5$YWM)`c@h>-{~!=SZJJL^nJcL? zb{9pC@u<6qtQsF2wSo$Di3ow`f~TP4KINmuPtPQ?)llx< zwvLWHi3L38pIe#vSa;^S&W|%l1USp`vp{F=@jCT5c5j<9_s8r;u@y9E z!UXE^L3RrhZFui;SPv2k5uoBybvi&f`YJAZ*_KOH~5-h0HYk)ij$f0wEJfuTdS$Qbo z0s6(PGXXdN=8)Z&9J1u%2O;96?8(G#O(#_?R?%~t!KJF<5+M9a*q6rbA)~^m|P() z)Y8pQ)|S@$`6S-_H2$3u~W9`R67fI6dIBM;>x z`Rfs#(b880ykHc0uozUW2@V-bGx6)oHM=4J69cyGkKoJ^ODqZS>HQI8fH2@+u;~2} zu*oDEmISzRsS5g1B~)E-%iIQBF;^uCJ0*NbiI2B{LJhstL1*kuJ6p~)fYM1AYzLEy zSR?CrNgjRrZAsn|yxk>pzU$}$))91wF+U*t(HFiHjHa<@{GukDAR|@;;pC|S#fw0k zzM(5p`3;9%s2jGRem%~9^%V)@8)};e<%z*4!^xVipPa{c0azK|Wzh2A&YBna_X8lz zIoQ-r(YH0>!~y)6s z>}#Q)t)_Q2CTy}QH%mVHV$0I2&-$~r1J8|Tt9!W18y9NhOE(@Fd+ig~0{=cw*3-`< z$&{B1*Z(5vd(B6;1ODe1TWr-&N7o*;st06?CZB^D=y-Kc9VffS_uD-NDR{TgCr*p0JW;mAj$XtL3=0;q{a+h95R$t7CLU6 zd(hNa2%L9PjbF$RqGh_CGRd0zBIFI^F#w|;LR*8@{r9sZt51c1BQU44s2)tenHZV0 zaQJO0FgLIMp*jG$b6unQ3ZHj~d4M)J_&X&%Gam3zMb4n%*| z3|YrV_iLW(8A)shu4k+JZhY%o-+ES+gqHr}bBq*aUj&{XhOx)|;yi46Ur1KPDkE8a zke5>+olm8abX6KiaV0GN0ZA<8mR`mG^MBmY@)lUWc9DPO*T$Ee?v551sW^vjZa!6g zz4+Q@{LS|J!kBaTs~BLi;I!dWzE!>VFTSeYjU4Z(SPk8H!Rdj$2XHw%x7XJH@xeF! zHm3_}1ke&r_hSClmu9+a*KWlRdUNwoK-};G9&F!`8q=O z=~bFDnXoPpEgzq6Uv#>c7CVl1IEUdcdM)&C$0Z=;V#i(Gu$nn~bMxew)B9CuOHO=s zXTySV%Z-_nHRl+<`B=^A#ZPa|If0)Owe>%8PIkhArrP3!37%X>PvIM4DuiE5(Ghw^ z$jk83t25!nn;ZY6`nS%Z*ER>+!}id5s0fDIqs`_aT zTS13nv|=zI#j1O5px2dm<$j#00m=pV|W9@9b-AP~$5-|F~ zSNGSP7=B{4^*?bE=Ewi(8+|;KH~+NyH$Q^UkNpszkLj@*rpLPN^bD)%`N5aYv8o$8 zzk$D-J731%r=gKDRx=@=gY^i}dc5HX4`VUN8Vx_R!|;O*rW#-S{>eAFwGNKK7`}aR zT-0smjtv^k^nA}1Sk$kz-CGkVD=;d{*Dtv6a!OIzyy*avuMs5gioC$ zK-NkE#J@_YE(eKVlq}Mja4G@TKv0HKwN z)E9)^pk)=O%;e>}nH4U-yNq8Y#$(zOG=Lrpi;+pH05^_a!5iAu(48wJI*SqV@=83$fSOi&Q*z))T z{9_{+oq1IKfnIE8wMNk2iu_&+LhGj-BCC4!vKCUn!*dcd4rZ8aTZXK{Fn(Z3NkR*- zlK3C_rjyl63G6N8Oey+-B9`Z$;X@^?dBfp2Es5QSoWevv-AL! zBF2W4?#Fycve4D7QpK*AN;z$C*OFqV9RX5QvJ(~zD%sU_k4lbpg;i>ytG}jZ@Y?I2 zC0Q-DA!6jR_M2@9piZESx`555bS&a-Nph=K90h3aIBjWf=kigG1Hd%oHDONU)Kh(1 zfXjxwCR~1;LPyuPg;`)j9$2FKJmM!B@`z8W>yKb~Lmp(h4S7IM^?76(+>qDg9qfx= z_g-SK>aw61sn2=?IR`~G?}Lfpkl%gQTSg5TtZ_2aCz#8ER$f8#EC>Egh=esb#vS@x z9A%H{rwxhkG`wepD&Mej8*devM~)9ApV;-hWUZ%7;Yc#OZDn6fy)2|rZsR^FtXkYq znsZW|D}UP8me0!_^Hf>Lk%(7j-)4rzMi4Gv@MRB@Lp&(v;y|w6dgyWxAdQ(6=tbH9 zO=lhkAl2BKMBRkTVGyLiImB~3^$B4=z;J=1D38 zl{1=$0lIb3tgoz}+md2h3@piBm3j*!s13`%U}HhQWf*A!_4A9ouH+45yGfEV^JW## z+DUC6SWAzGa?B(dGIaW1Kn5&*6vxJQ7f z&K9ln@?mQ+$$Q+`oyi<;X;q&Il%)8cv`Zd#A`ymuC>(?JfX|{U22#$993LZ^RqUl0 zY?Iwa;~tDb3DG1M)-V&9ywbEpVbs!C2caqIh7={r-HgH>B{@3i4DV_pqWz7oJhG2= zJK3mtg$!HBRHPvfw0}b$B%lp>P-Qpd;d6y70vP55JkimnB@Gr47b%SE< zfJ@A&aW>S_lo*{)im4MWkqHQ$GNhH!HDxK=k|@abuvKqR^5j!htMb$p3-%CINLE>t z4unj0+Yh*sRZ6f`$^i@XpV&svJ+ZKC^p0s{3u>HadNq~6X8QO6#0?Ce}vtQW< zf^X5j`OlNpJ^|;8_N$jdwdw);=I4`kwf_d^w)2U!Z*DxIi9;cKhU6zuJ=oD1%I56q zfj>o)e^W!^PcDTPcfOp1DCwE?|Cr3?s$IEPJN78^)om@7y*{2tJjgv`ZS8L)EsY|U zmmmN@Sdo^3_?8^u>_FB~oC^^&!mvt{-zo|@NaaRa0e-Ya=%{>cQg$}kJ9 zu~ss$6$}6*RP|#0B1AS>g+l#XkB-3`QNF5bqUYcfu#fRbZ4F4b2cMb0ZpYgplpM>6 znEeyig6~sgpvt+f09?2Fje$yDPm`FrWxNs`lNbnxYU3f$x5g75{m+!)<&a$ZdFfI0 z8&Zv7P43Izqx1Lp^Y`j}P3)?E_Un92?yCF)I$u-7D*qmxuW4eHe^Te4^uITv^CK$X zhMByy0S!&z;@aB04D6@j)N-+$VDUpa#a%8JDeb|3Q52KO%m99lAw)7{SYC@ z2|zFY1+;RFY<&RTBjErIL1PdV-o#uc4kJ4Q76@fdQU*UDfK_25Z5apTs;?JoVh73E zg}VMo!`RTa$@pT>r#93h1Xtf*6Gc_5iD@SsQ5xDZLaXa9N`X`B^O~G!qSWf^H6g>H zN3E}Qd&=B^2TK3Xq!bwexb^^mtaRJ~S1CMxC}{`fEGBK3p9wiZVRF5sPBWW}eF{o~ zHxclf>@Kz4Pvn^aXSp_KDnLGL*a40-S9;duL(mM$Hxr3B&i1MiL=R$!?USU8w_KUO?IP9;mP zbl7_ZO}@D2IhAO6e*T5@uc-#1OZ#gX{jlfKf!fF?M%%uUzjRNnaH*{}lE3*$N{_Y` zZhn$7RIBcECO7g*ZnW(cHjHAt{78jay6w^KFH}amIg2xX7dpy~!^8OVwhS(!;)RC2q)fB1h7H&bd1MY6whH(U%ZU-o zs65_EL1QvMgvTNQog$3W$}pBDNN1W}`$)nET3luJb~lXuWZ>YfhkxB*Qfrdt)5YgT zeczx6ayD`QhzXzWcjdC+U3CP=zEIlZ{^8#$Ofyj#Tf8}CpJA{Q2S zHV4M;YWa-#$!#9jZ$HUh>1sy5+@tyk*u1I0U1a^nm9pwbJqi#pzH_0gS2_jrPY{Db z<PhfDq(^+`NPcJ8fOTe66yypon(6v;eL$N|e?B-58n1t8p3$dVsrVUQRB<9#oUw zz@3t#NBvo+uuKhkI8g#cU_v5^Mrjne_%^g8FY5Z>KkOmT|NI_S@?hntia&Iw#t+Uu&otAD!dbYyJlC!+XJw| z7MLk74{+5}SFn~z<32!!5NLp31C;fE>u(`xZZKdgf*>#qIV@vPItExK^DU#9VrC+j z0jrGNgBNf4{fF;M|635CPgrh%g&At6C5e+S0UV3t1U^NgMl9B)ZbB!{LiA?d4XM!uoVD@AobkmEJ4f#a=u0kOxg1ahEXoSsAzO<4j= zCIhtu$q}&g%|L9>X4PfIAqV8@aR?DPLAHN&mFVio`YaH{^;xH9j&PrSd3g}7WQKz2L8MK9ic0&R0?dTI zq*l}0|3BgV14n>X+Bg<$hB@TX&e5*X?$JY|Jxi_k63!vS3*w1|B8E7|6V&)_@KyW3 z6=v|YITYOxdxC`9bS*KGxWJlZCM2OD-z$hmw8(~TX5b8#@R)oA(GnA*6t+#mq=bVG(&3Q%2LSswqBOvn)?uWqJ{$$|DUk&_QT~Y!vu*U z`};dSabUD<<6w5QO<4eS^ZxuNS^dc9y zX7jMw1k^@agX|Kf%ON6oYS5+ zkLczweHnunmU!R@X68?>jlpbw%jWS&hNNYL-!#T4X&L`FAL9b`O;WO0e3>()^H$oG zHG537q%~WGHxal2+h?v?&CZKzfuFu923Av{{CK1K1WC>x9#v}}?7 zRz)xn0#2}<1IPnrs=$n)kGZuK>vDDFDtuPf=BbEeF1i5E(8+K=pfZT%^BPfyaS&~) zG%-MOCKA?AFcOssnH$j(Bt%p>B+@~W9$i@#X^X;7u=Htp4lXro^Jo)=b!OO_pahKw zzZ9N;eg{s|n0*KUcg~V-9wtK~cS`{nsAXvbV zUA1;T4?a+c1gqUm2AEzrVyjsAwigTEhUW?VSop-&MS}*0Z^Ga2#xcs)roll5XY#Qy zLOna`ehV-cHYwvT{x&fgO+kP<;xK|LI_3P-D8&@;=v6$xl2N)w`UeR<8u&;1frH*p zaOz!^c_=M?k;YXNtw61_<30tqw*$`#03Yw#lYty-1aWq&w%F_Ak_e{_@^gzp;D`Xw z1K(jK&T~t!P+j^+9>#%)$@`n*MZN)}#^HBgqZJ`W`8?hLJ(Kk$3+CbVP(HZY9BfN+Sv^wvM?r!0cEGvTw>GRs&$1!uj>m z2MWzs&O%DT%Q8GMRnGF76w{f}i40tFXi?aX2p1c$<2}UIhz&DECFmYrmzjxar11@$ zK996V+XnB4zI(qAtB_*c7aFO=+dnbAe!OMt?=`vRO=T$_wDXzV;tpIm{vAY+pA!ir zp1xt26){q(K@Rzg$uV9r$rx>G*;o=xFIaZ8ZGE&7WL$}$@wMIGJQ4~%GXh%V`ufkX zVm&#Y6FkWsAB3*_I|c(wUb$eCnk{LjtF|VeW-UO6&|1vEEL^ zxf`}bXg?Fn7;H7&T`9~7AQvP%9Qr8=Ag(h36Ak>N4W#`7P@_L+N{s480mVyFf>q!u z)jL42yb*7aEP_FMG$- zqt2sv55>U`6PHVV^E|>QR%btq6sVR4EJX;e@y#PoEng-)JX^KyOM+b zEqzA{zV-+Q0dmeWin%iw1C6Za*W!a4WFlb@lTmXD2xS^l~-9+%_;0DNY6K+6YLPTX8@WTf^ zNHL24#YiSZzZ3&igNHkU7NkI}gBH>ila20~^-kFj0WgR_{XqbR`SLr48ND*!(c|^- zVrt^74_rVz$oC6_$RmOT_+uh-wl6)61euS>(|LX({FFI6O$ESoNS;R$H`U`W?nauX z$gUt<&eQLp#g79PKY_5p1d07{$hY1w+}4nPtg>+4M51b^QIOu@|tz%)(-j&SNi za->@}vL;|kuip=llL}s^cva7?|2jdPwxn~oo_P7I2I9pY788w&@Vj}ATxRI^dH(wX z|0N$AE^DtP$5cp>&xj~yUEd;RL@|*fF8D45Bx(0$ zz?ZU_DBleqfF(^bm8(vN$URoiW5a$0Zx_v3O!Q6 zk#Rca07dZOSa7|x)_=;33&DMg+yz$gq+`OUM8ZW9*a4#W4RA~`IhzCB1n8e#O294i zMLuvF;9uBU&~F^RF#JpY3iOP3@$YSfB+^q1VgahjfF9Rc7c$UIrqo&4T>wI{2bvF& zuMF`ph70$7QVxSG^m}C(1>mb)deIF44lu6hMICY!^x^>YDGcrtklsiF0t-%%eTrZL zSQ3?SRWD2~$UtAgCQU>_sm`^4K%@k$*X^jv0q9r^>_GP`g*8E$V3Y34Ppy6cA`8ee z*fE2Cg|4JKnBp8`kmLp=>lotaII9yNgCH#e{ud`f1y!W0dH9#@Y6`$H5VSF_5knf2 zGDRVYYJ~VCf|V##rbOvMC{$D-c|=TOsU}rG#Ih9Uc7!hE9SxXEDdWYdg%J%626V8Z zOtDMrDN}qS=FUTN8abS?erQCK$-~?Rx0(C^l<98VuMtiN5I=!yzs8&im+eIe;2bP_ z+~+%BgWvrlV1xhE#1er&XuuMG_t;=DBot;?%n9p>S@!Pn5wqmnXh2W8g|aySib25J zyyX95Ot7})!EqH3_JcFQ;PDM`MG<5)F*{eSE?l{aXh8q1*F z9wIbNumg1mXiUHHH0V{AvV@Y3#c_?gIjxXOSkrK`hhFYH{lu(kX!}5Wo~IvAsuuXq z&=}wC5}v_81{TQoXm0n?0hXHms|=)O8K$!!HTxYqb#tRTnM&KkqSS2Vl52r4jJDm? zvKb$3Z`q6_O}UjR&oU0L(wfb^L0#%~Yaf$J{HIk^RCvw$+lV?1CUcoLl&r}YrMg1d zG$K1`qfK~4G(Yz-V9w?xgu`|z0R`2(grY8y+{0aDAau`@nnP@O4cWepE=%MSOcH-} zly6I3#6Y%zDa=Pnc0^|tztCd|^G2ox{m1}8!v%`2h%$$Ye8rKnl>#*cnHje7NPtS> z2JFuU0g{qRk+_I$R_UWk4s=-lt?POWsF;S>aU8wT)gYUEkw|>~vfe-jyYj9St4lwT z+G>YrlW&9FM?`YFh|>3nCH;#nkjtkQD@hx{AO7U!;T-+V=F+k$K}197;HmbYwK5k1 zlpx4st@(0wVA}Hm#Y$pTa`Mxo2$gFP20C~Gol~+G65%);1r&c6bNR!1H9K8h#k0oq z;+<)8Rt#>DtNPi+;1igMyTswm^QDdLxdX0I>CHQ@GyZ&bj1GA4AQ1lN#QqjfcQw!h zdEy#Hv+Qz>qkgXOC?wsf;IqUvJ||q`UCF}O8=lLg(roYCh7lBbyd4bk@wbCwht1=c zRj%3VVS)sElSQdhG^_A-A$j}18*XB^%-uBdVcB3dq^0Tc2A6`}n5{VZL3^Bx!J1H1 zvt3F+{5LPD^VKzai$XHKOB-T$yb)+#YByJ19P!=W4(38LQ($eB+zt>!m?;RaR2D8L z!hWWc1VKB4syJ+@1ZF|9FA0zj3W~umNAXkuv6`n+^#NYE7LKgqshZdyYqKM~k?(^r zs1%Br59UG9C2p-+Of!xxFoiZGq@x$P4!x40_rZ4WWcWWM4A6P~!SSb;U*A$R0n9E|Q~?2U`LpdDms(Z&P0 zP!JA!@(|7e1d@}UJRZa&KdX$*qskRmC=%NZ_QJthvfPLqP6-KLgbtW!1_XE>oy_ug zU~d@5+w%y8Ll5~2KpMer1Gvo@PuQ~f!9k%*M(bw{0*Lx7?5g@KLouf2mJppcrL3)0 zl&G=d=Xu4MF4VN8tb02GfVOWWYVa7}#O+>7xE{Rbt6}2~D#1TOHHwa+-QIXz&>e;B zCeW12=QE>rK7w6n?FtQjaN3Q-j!%gv7iJ6YbOUgp+z^lA9{eII&WD_fP;lzv9 z#jmGodGSu|vS3dtZKR8B*JS^Z;1m~pDocj-Ka*X;-`bMvaD5Cx3oqjYU{ABzG&##P zISOPP!$uN7t#sN-TX*nl8FcE>#143{s(+6CB-TV+yhgcuJV1W#r)P>*3B2#QS zM-V;MpAa(M0a?h483mrBgkiZ&O09+_kT*2sH34iKKg>Js%o*U=*1drub<|bDgw<8L zlcP;WqxDd|5lo(M4&zUdZIQbJ-N?>+?Ts!C>BzuXHU!Qv&{N}@Vv3>Fum74m8oRmp z+RE4x;K}z787B(f)lD!`TO&ql`;lR!5{zMB`ZDR`@%;zifSy0+v*Om#m((fiW~izj zV*D^)QIC7o?|${G8F?Ls?WD?&sNb;q?PvFKij+qGROXqU>8>+`ipYuxx52==o`2~a zG+U)60k@j?kCA0c-EM_Gp+1ZB&~>%Q9K9|Jr>!BYvHK>WW12)3xRXs*!gWUViwOA& zUG>o*tTC4JMM!KtF3kS>{4Ml5PYL6rZPc9&_7(+=gSCo zsU@aB94J*AfS>TF_JKT74dkgcH}a6FLYTXm!7jB`+?-JG0E^QD8Q%aFsG6gyZ@jf%3)Kp(UdGZJEx2Xu>;7UaUrJ7BZgmikNnQTA)6Q;*r+X zx|3tThWH+x%hCSDINybPz_PGu@a973|4t1-8Ucu=yD@g5rMbhH_ZBijEy`QS{KC;m z{}F_wyH843-0h~_fmwkvxyie)F?VsQghi0833%j9x_{LaV{-dNu-I8l1rh@YB;kO#Gpm`yHAO0B zlsA36NGgz&I~iCd@)`4Xtfn@$k37ROk!#O=Z&S~N>`5D!2CEc;IJ(sS`YU{^1(W2E zs_ycEO^h#_A&Exl+^{_+ol-rNdUG;}dm1UedwygTpFgCkLKcwf+x_fQ3MmgKp-h0F zo|9lB=*}0aK(b}1?kLGdOt`QONpLM>>qJRdHIbncC1DamzLp5WNFqkEa-v*pFjzTJ zCgg#zbfOf!i(bX|q{G^YQq=tb1t`HU?juXHp%i|}N~-=`O^T>~(l4tIR=Uj7`?DtT1ZO&mS-cQB%swd}2*M2UBS&$STpw2tglN0Vbz{Q=; zQ7OKMiVvzM=UCT0DCQDdlU~DJicAL%SZF7EATY$uPL)NZv9^;2%^*pD(Rh=%3>258 z9^#Y0wjmF@vLO$R>+{|?%^4SCS;H{?Oo z(~w8txbD4o#+NkXdm6vL0aUp>vj>fFQb`usc+Q}r#n75aQTv+1>Cm*j(QW6x_uJ5b z$=2EUcLlw@2-wyOT7{eX6Dw$k1g)}S{gV1 ze1ZA)PqW@>y(>+=sb5Z$YpPO%UD}U2Nilli*;s!(%}u_THhfEex7z+pT0|=ABO=aA zrZ?Uz^Z25Ql<{KAv)9KfxFW7LHm#gWe>c5Y$u3rMjZUSFB#!9u4P{$)W5Lw?>3F&| z<-4L@Zg`4{?2$iJd5Vf<=lh9l;_P}I92-oozf)dQU#JWvJ!cm(ur_u%d+vFM+aK|3 zH~YyLsAbUALN^jv@^>H_V(~8}yKR4|zJ>QTHu2z>T_toBe4TWt{7XsH@A{XLsNPo! zrIqVmx~qRIR8|@T>}HtHr(Ze8#C33UU6*%YXnWZtQhAb?a-6oMEO%obth=(&o zvs6}$V7&N}=(zIcY|z#L%o3O~)N~q7Ayzn(W_8fY1z+sQ-_JT&&!*rU?xj?BZ4vk~ z<06vYmf;=%Tcag92jiiUM9xi2@h!~%5|MYbr2!NR4NwhUk8dT2_Gt!BUr8_ReCaHr z6Ao)=H{1a2h8fxoo6v3#K|AqxQ_yZ$pxv+m?VhQ&UmuqE+Ag#k-gvJVG`zS+{kA;! zY`!uMXg7XALAz&$0qWpI-vrtT^+zMsTa>>UbZr%ww-tSW4Cw7e&#~}3Dr49MM>&vgn z5?uzN!7TVp56l9J`%3|uTsRxub->X1xs&M4Clvq9N8}nuBmkBfT$1s&KwQ7cz8}!W zu|Nt?(xnvwnc)m932@hv06fy5ml#0>dSTD4+VYi6>fRoRMRl%V0fM~}dPlk8WA+SC zn*gzoU^U7|Kh9xp{0{tNc}_61(Q`k}@U$M_!f+d?PkGB@F$k2B2fY|K5C&?5xG=L1 zn@;@XkruXG8xA&01srDM46@;Xa2bFYMikVWX-7^D&ixkj3gkbJ-CA!i!4SA!+s~9q`SI*Ws|TjP zeh``!4#ta#(E8>E@os}~4r_*i8Yj1@6dEEhhVFhwJ#eZq0$hmoai2#VIJrJ^vs-cC zHY_EFVJV4ViNbsO?TTDoIw^(7)BvYPnHn^(TQX)9ILKold{(GL@df48@)yjD{|tH; zQ25T8y1~_pmt&kmztUID6o$t!HzuY^h?1`&u9H-qXH08|X>g@7F{BWX{TRfB2#_Bj z`;YA-_Md%YJFs=Y&Wg9wGac=rWNtgqbpp2Me>l94_;k{6_(B~t9Ug46=ykY_+S_K7 zfmf@D4acpPIE0IyaBf!X3_{P$Kk}Si`F8ee!~1rAt(LXFEs9kN?(j(j_4~Q(_6ZfW z;X?LnfdEj)+w4m9b-Kpzx8xRQ`+q_Dmvdt`9?5R+f9)4#+H2YE(AbSP0EQ?WH!|x`&G;TmC}g{nL%6lvmwnW_VB8@ve~F zZdZGE{)JsVzVj<~_2SMidL7#9f1I?}U$Ger@=Gov+|6G%A8kIk)tbyJ`|4EhnA{TJ4*KU1CSI5+RaDhjbBEo{_Dq z*2q@2_fSXAQ;*e90T-fo?YVZVmB+HPp`=`Hb*d$!dHp;2Aa`}`^*^(#tvg@AnjP5L z=+-aL9P%UAUjM!7Jv$q3)vG3qe+c>iGn(AJvk|T3vfPs_??#udxgApZ&nCxl>Un0a zy}r8q*YDris5GBnY5IcxNdAhV5;dsby`(@^n?dRLePmEkecyrRZ>Zj~U;7tHTPl73 zFKFlD3W?k7LU*Uo4*Ct+L0_RA^u=r6|3K2d_WgejSsCO*e7D0X2!&Jv2-^_CpYltA zB4pS&NpVH2QzQ=)^G1eOrvQq4m!X^@v225td!?#(Ou<%*GVDU-_Cc@IFwK@1uKyNCn`MfB?l za(Zi01fUuRQD(Mj=#)%yZ(o7LiN-ddxPiDlISVHYP#kJkaXcuDlzBk8OayGDBtV@= z0xQf>v-t$&#-mr(#nS}&o99# z!Mp~?IMTbL*udj;mP?@5w2EF`PDMc!H9A!wSdn@A85p+i1NnlRr4$tQD&J690%k!O z(3Uf(Hxk@ymV_V#NF`AF#x(F+HPhsRJmJ{yP^Z-`KO&{ncK`~zA*;!j&}0YGnBEdK z9!EWybcIbJm!F0pp`LJIzame^+7TRndcPo$>5U`FVdaIOnD%W0ecT4<6X~&W#s&Rv zit1Ruz%jHj~88QHf0RRXjfWAQzSY1hA zDJ6mBk_6BWCxBP@7Z9C)Nu^;x5txPe-bP^Ecsn)~gmHDd1faPt$FH<7y64pW%WO}ZXbabw{(rJV)D+?I3> z{3cGNM>sW8;5-4W$A(c z@4ugK;q4yL9%k8^nb z+3RCl;|3+1dM>}!^08}yKhssKv-WFG0*=1 zFpI9p=YIf5LuV)ekN~sbL4XA0q6!2gz@YeGfJQJ07aD*i(7l=CAaS5?93=766?q&K zn_Fk7aZs#GZyZD(s&T|&>tc?B?t>8^w5!64E*sOgq;d38nzh)jZf;~p!#$FwMiKy& zl7KW-57hj`D4|hvsvAMAH}x9S!m82*wcr*ssD<~d32N0?fDGj;{rnW>#n>G#I|UFt zNV3A*1;iu4M%x{I!ybhE;ASsho?Bj9Sw(V?ecbTNu5I{bPc@Rh5;Mo395gzd$Oxz- z0G@J$!zQFKB5u4pARk-|+lyA9xi$PRr$8XW+$^0dmqe09w1W0RcV$^tpoi#$bja22I`4LYWPO+s8L+JKCyNSM6(474xM$#D$xQdx&3pnf^ zuO7ajuAV{F(3df9RMt8_whW;WHZiWCejute=JkSU7b5r)F43Z>+m+7t;Z-qd{GQ)C zRy1w+V!A%YASdbC5@Ubj+<}6yNC)qc3l{d9QODiG*lzy5XlaeUiB$C>x=!RuxbO&$ zn(k`poLC)$>v1k5;WyYpGK~uNpM)Nyj#eqcO&e@HZwydTY*hy+gd|(lVW%TWR(0f9 zPh^%g4xK7eY{7>TGOD8mhe(5s>SAa}A;bvy@fwj`9TPvA;vqM2>JP^oI$6CR@PJz( zz-de1R2VBux-XxDSFIJ?2hn&i*#RTfmaRSW?ZIgseDssGYk}{`cBN}ObD`;u*#r3? zh?;z8rZWg~#_0^rv;|)v6S?P|E+wt}^~&ceD)|eDk;R*PzGwXd%*gJ1%4x^Lf}_H5 z{kq$1<6XLPk((4MPw!W4adqgBwBER%oE<~Kt$qA_9d40JWB0a^LnM1al92F!k%FF1eGH?(U=4YY+0^I3%b-3B*tsqX+mdjMN$XM#!WN8kn#wcinsH#LTpFU0 z+$4BpKvN}9iDF9|#4=qaB9BbYyCN81C@p0Hlc?k;sCxqAfeH&SZ>l%}s54pwPQc!D z1(G~|I|b2|MPtO)_sYu9m}oGK9ZND#r$iDTiZDP9bsU+u-^!vl0LSB4pB7#+UTyv( zi~U(Q-mIHoudb=(g%6chDd;DpsA-4%2>{5jScP$$t|vH+Q;|F02h3WsCkpr!K+4L> zRr)3zT>#T8#@h=M_sPj=Sk_2$WBlxzi-Iz0O_c11A2vQ*^d?kj_4b~ye*DLAQ}fEz zwescFg)3{;6&lsts*aRuJr3Mhn5$IhK1^5*@H=l$WbQv>WzO39B)yvEqBRXT%GW9y%BGQx z*i-pQS{hnT0t{Afscc19VU3y?iTN;shhf}mIWa9|j7cI^tC#2P6x9bRo*)FCx2O5i zrM@DMj$h9WU7Y4)G&oxGjrIn5r9=ZW;6M-naNzr#!zs|&mlisM1Cuz*CcJ6nwT!9 zviV^ePcemplAXsro(RwvfoKfRleq$7PUHK^cp!Nwj%+c72-AH9&?-{}6kVVJnnjdH zeYN`Jr^rknr)88KHG->R`c~&=D->auE~cT~Lu;ruL^Oy6Yan@uN1h zjlE3DQN|KJ#$JiesaS3qNHh84>yQe|*b})tX;m>Jate9MTEkPzYYSD}$#Z#i#adYA z6J#x1wdOt~A&Y4S3wCP4DZ{z~G7Bt~P*^nUG_|l`DtZHzV{Wx_kd*ptw4ehdN5_QB zG$|}h!JdA2%9+gQL!w{e^%TMT({$+1`3~kJHV$YqZ^FoE!+54Qlz_m;GnrDE9@OZK z7Gi=Sc82De=TA|h7^AvUZyWE3D1ytV1dJ%%inWc|twBW_4KTxfBN%00-Y(L;;}p-- z`zViEGczZF?@IP40HOiFNU7wzC7vGmeWKZq!=2GPgQQL8`BwVSa@+&_&D;B<~n<^W@!9d`ep`ZB4iXur`Aqd zSE^54wXR;7ySy-4?YlgCb?)jJjR}k+;#cDNXh@u7+Io;;n`g>UTAAH6s4q=+%d9Ar zWPPU|xv7szYq)%6_A+o--(~%20K$EL@2T0!No#KHa^$!*yIip@%~q=`YkknKq2Ao( zCF>Xh;Ts=qJ+30cU-dp-^Xf!VwAS(N!pRH2>kVaceh%2-$`wMXE04p=&vFNK)dELP zRNPge;#TLDD|4Xap169_y0n4|Rc5bZpq8CqxVpw8re|v&Vf5E#FI8RS?3-fY{_y%n zEYWcLq(&CK>DlGWpdK&GUU@u?*I$}lyK03cGi50o2uGeJCL%k0fpN(WD+ps*$DvsYfP2`Qs(jfqb61JB)CokwT_8W%XVLDTB+C z`Jol01Zd|O_nUjed29kW8eYM@2a}+tnXq4*2kwT^;M@b1mCH{(2`SS9eAy|XcDKIe ztS+F00Wob2P~xk&t9b!;__Zqh3;Va@chaYB>F*LB2*wHo)QlB2-vzpWuMZi?kD_Rj zzf8&J@L}q6F=66jb3WyOs7J*IY{(j17Es$@<{@9B#>8rR~q0i+^^(yELB`%(S}(v}Ud0^xWgK zPgNEFLnjP9x>fvh>RTprm74d`d<5pg=y&@T$hSVI4XRjOF3uV+ACMe#h9jU?rb<@1 z3dCNRTYf6HHuvOJ>)hPJ6Z32CGj^EEFb&UMUV376<*DTg6{l97e3CXXwp|!plW!#I z6MOLnlaB-pMktwyh({mw^7+{9B$n5 zUV!viwn=Z;+#E7KA7R%pKp|;q8_|sZ$TyO2rfxfuN&0@h?!0r~{GPjm4<_KT%Zql~ zmZ+~lVyl0PSkf6Vei3%2U}ONE;hdK#MmS_8Y=#GM&u2V=_AX7^4`B`91ZMzhLYOgO zPa{$nBs27$R*wlWfV0r)>Z&%}bI@y)Wnd_yW;r!MT^MDodMDAp^53SWw_OAVt!59z zst`+J?CFL&O3)A?I$x3Oy{)pZa91CEiuum~?oov$bwB_Z>JO2Qd z=K*FqAMoCRdsD&qWB30=x;*}q58@3a`sVUOUX_OkH=~w$lneIx$hllT9pU~+!E!1_ zb%cdw*4|~0NPdQ*Ru|Z?fC_vzBr_y+^4>%p*hP_Fnc2vvC^A!JYjR?WSVU3^q63-~ zED6a+SV(8AuX?HM9$_B6_bAZG*=Q@3=(Ek)H#k}@l3G?Pw^Ex*Ex8-lg0U;j7R`nC zz3x=-bVY1gM^|108H$@myH@uhU01>a8VEgDR>Tje?qyPSoomX5SW1MNqmY%@sMD$n zkp%%>xtt?eSiO)4g#`%fCrB*i4v1PnWI~c4GY?`@1ZB7L$o9H!%{!wcS~4pV)GyEw zwCD*PV$S$`bW3FM4xmX_Tf|#ARLAY8rig*6mCy!%B3qJ#I#N<6 zeTeXL6Bz}B7PN+~5R4RXvPF8*WH2OTQKFS*@)it>&W92Zd0)ZXKyp!~mCukX2r>l= z{u0#naoTkz^TgxH&hr4NaUvK-(Kl!~f$7D<@m5tbC!8hg$+_9(t00^f*1)8}k7Pku z43Mu^XP=xS*5L|BTZn`g{{CFVveGNd?^&~!mRCLq>g&Udy}@Cie0A;#k|$UnoLfcU zb7FrUUzn@(^{qa+6mG?rK(G(EAmp|&Gaeu%c*i5Odi$Zg8;aoWNdR#gV{c!7Bx>=W zp$PnAq7eo@9Ny5Y-5LcrZB{)Y)p4Z^=Hia}rhQ~^AFT@P^FD8(StdOPAC%wtUBqk{L$VD@^5y0O%idyl->u_n@ROy zo=0Q)sR&&uLSiIuBiIN94TrG*4u4zkwBiq34|DpaM)am%wCf8q3M(FYf=XN_O4~*{K@lzcIJ`cL6NbOF06kc zX}NbVyxnjB=x*2498tqdZ#N<~tI@-4_!f3e(53bLvUlvRg|`_I!bab2NNfkTTfZD; zVAn!(jv77&HWa&0J`~xz7jj^#U0zDpE#I!GIi&g-gi-o!UTTi0;bUNHx_eXjAm66& zHX~|T#jO|{VQt^*engt%I>mA8k6LqF&lBKNpg0CqtjTv|{Lq@? zCW>PiGfc7JXT5S0=p8CgtCxsv;Mw7{Efh9I4|YvZ#FCD711Uzu?5y|k$04Af2LTQB z0do1S=T_0l9w+&EFBvYHg}togLRGilG9xpxiY>K0{x|Ev zNMdDVWLz0}M}(HCYTmQ>Yqp^+vl5Q?ox@bUm0>rv_iU@tRvlmB*$1{rzR%X+e&ZE>7|ql(SiVMDUQqxfpdmBq3Gs#W7wSIq_p$CW$( z_JJ%WihsT;WU5~b?%|efpw1Q7Y?Dp8YVIUYFz7D+`S%Ds;59d4B?Dd<;BP!|kC)<( z1U3FOI66u=j#Gn|)dD9i6Nk)nICYt9-D*1@H#4@uTE|E>!xah047eafh;UY2fO%~C z%_{fnrdi7wj8s4~;TjX_;3Zh3R;rAa%jSJVew@P|D{QaWT<4G{Ipm2#7EA6BLys2i zX%2iEfv3&;MS`V(koh?S#!r>*v_edp$QQ(J`7&Dgukt?Y2(p~{6Jfqbi4|+wPlN-7 zL8=H#6I*+PC;tCg;ux= z%*Z0{ekn8wVyGyB^$3T&K}tiv97IB)pa=&rrpZ>YVMI3^46GD~M^azp!`1f++*i|r zi*2-xY?V3iFk+lE*IQvNG>@bpIcSpUdaf`-%dxP6+jUA~zkC?sEX!oYfDH{;i(_2Z zj@XVp7!7PVgs!b*@NzW5ohEb;g(`3`j2)pk!{O(_YKD_ec$6o9{alGezY_2sI~kf# zK3-on%Y_1+K!9py!_;MP12`u${v3@ZZ4R_oDH za2^frkrNATx=K1|R$z9kaAQ*Z6@S~~X zoYJGJO`W6;J{?_NR^CVi3e*!y3>b#0YMnM4oakdT%b*W|$hhBO(rPi{7?hj=aUas~ z(;zfFf_GH>0?wf*Y9{xwc&8F+!LH#oZX(o^%`BKVu_Jn0V(>IV_X=(@&T$21_j4`uqnAQY#EhW>4nZYS z>?pR{Os>G9MGe^`SVU4%o%M=(em%p!ts8Ie;m)xblgthvVxx3Cvdl3g3#>0L@|uPt zbeW!QH*xQq#eJ2m&D<{gnCKa@k(ElxE^IA+>=mM(L9U+R?G*xit{nqEE0<~J6M#?P z*9|v^Q9*@VqF&*28$05O{Q=lF@Maj;EHc1h;*PK$Xva8DC0dyGbdS+}pzY9g`gn@G}!{jN4SG@OhT&S5f*YJR=m zX2f%dG=e--CxTu#sh5*k#d~K-HXP3^cp}_GBV^aQzMjbycdyzbSaV%Fd~8GnkwwU%2$EH4%EaaAMa+a-*POG{G&nzTL_OPx-Y+|3ShWe$y- zeL8EJWw!}PC2JyTs0bC>4P>%G_f(3i8!Tc{&!ycNAwo=X9)gD{7>W&>t??*v8F~(` zHyP;6q=rLdt^vGRCTNJvP%*@yqV&R0r@X;uU~^TTBvoQAz!TOf#>eDAhWQ|mXQUA~ zCWm2x${vHXnc1?yO!?%_X{2C?DV6Kl6%$_WMWp>wbR))uh(Y<%ih%)@vw;Gh^zR+g zH~Xm+UkXBba{g6d8i_J6oXQ9Y6rl)qk%|bHiikueXT%6POcCh!MK2k=sP`2ihSA64 z{nLGUBoTUr&_D!fsuyY`(SLP+ysX{@_ahY`%+x%|ltr^Jgv}jOMq(n>vX+Td0|y_% zcwXsZ6Gm#4*H%JV5}z#60BQqvqfrf28?a)T}x)0rRQAY3yG zJ-gprHjC=5wu2B$o=XZdLH40l7D^c%udN8mOj+bwID6LOtXDj1vt||o z1m^rRp<}~|Mots?4$70kj$_II$+uIUewk64LP(#5z9J`&rVJFDvPeIP!8l;cptYa_ zVeY)eTyfsvjr%XADIiEqao@$1fp5On3iNY#Bo)Gsxi^u1Y)F_gPCiXp#vA9GrmRK( zn>PJ#I`m`MG)-|Xn$YE)22*OsH+O;lyxWk~A0z#=WzU<4@rO1UKXk}|x3x87|A@Y; z?La#H20>-AnykRdSgYcBry}B@V-b)vfD9yvDxfULz-|jciz$RCY$4h+g}K%-9q!rE zTr{ILp`*5FIH$0p2{n?79I1=M{)?FZ0NbD$d7w6tmpjP;yt6Hg)R8Vk1V?z z%aAJ3Oj^35#$>eAMIk)sAa}0=daF8$;}pL#VZkb5=`eS&1FZRMVHB3ggTf%cEuqv= zD602i+HmnwfgDnkEk{dFyHILniee0!POXWB1huTtyPDEm@7(7$g^?AZh~Cx|=6Y{B zdT%0&!Lnty+tLXP317?IV&3jnkqP5&Xd+hQ(8_i0qY)0;6W|^3F!#~}y6J6XEcem_is-jg7<;=AvQ4zh zMsBazc4%+;X|YX^)3VJ`r^gOky^9sNfNOX4rdyM9cq1kMs#pHWm%Mj&qt&XuTyR5=N1#jh1jn3QGcUJ1d_Ko%<{36#>($jg_vUp2 zkFaj!XGK5p58{2(N zJ^-^yZuQ2N5T*7>*y_a)x4+ApX05)VSf$qaDm?Mob!gu_wq z@9+Zk8=UaJHSbV~wpSdT_(Ptw{lzmM72;R3>#Grec{r%c!lnI>udB5IgOUOm9~6NA zDF6O_*&4p@?+-|;P=m#mwr;-}&F2OkWNG2j4%Cxs=9>*{Kus1fZTOvCuj*Nt$Vt=a zF*$`85!UskY1JGo1ty@9C-r4UT7II`Pg_&Pk5(X@tQx}1S;CnS8zXFq${%#nemK!I)Z_AoLcPk2$Q&ZY2D6Uf4VUvvi!LeP^(cufKQ-!`{p>d_ z^X5#~a$(MAUS1_}aNcN|Jxp9YwoplElnAI$USF;RSKuK@PQa4j&ga!-vZ4IwsE?nD zZj|{Nv&}A=z;6W{+s?p2JTMVOd@$$zv-Rk6RuRvYpDOjut)bYVJsX^O8=08x?x{K( zk1)4@bQDokEoE?NZk1sU7go8;;Sk(rW!myM9ApiB>FlQXEl9=lVNR#04xm=)S>bUw zHQ3Be16=4ct|ULa>hmN+=U26LIb4_+eC9CXZRT+}pjxdpo$8;T|J^Q`@ccH*-O6ZCsBzR6%Ea zfY5J|*-gvb^E0}>IUc(!TB^@FpJ0Yd=4iLpHt$hF1A+>5Du>F${x$Mb@b6 zkx5Xmz%1xRy_!_B*=SKU40j?IKv#kaCnvb~nOrCAjdu+d7q4-|vr7+~waev%z|x|4 z#ib3M>2F}pgu>01HhiYWLGm!T_OZaN+j{NKz=ag!I>h^?4kb5pv8WA~JIQ0-OL>B* zJmMBaSm2QVWx$wcW~Q9TksN%%w~-weNzpQS7@arqO4Y8Ta=eEqx#M& zM0I;@t4L!rdn;vn;Ko|c(7rl(pBRRYEJD-!5Ri8gT0YoucSPGza4!Z^BN-KWPfnR# z-`}|K^2W|mc+G&zjOiV_jo%{gKQ&5>{OHDQiNRBRe3h4fN>H5e_K(*@v2yw}&f9`q z+!7Qgi@D-@_Q`*6V4NV)R&*T1A^qx!PYuDCkrF5v z(Pi~97~hkAj@O|2mK3qNkst)G=#YF0&*c!A8R2q~#~1J4kc|;RX?uu~jJy*_6M?|? z2&+yDjQ!+qnLg9&>Vu*j<1vfdjcWu6!@oW_{TH^t%9)hSnvs^_H^0AfCEmNdcP!`D zcKO1UA!xV%RFqG?cRR$1THvM2a_%IG58_1PwUha09Rbj+qI&Ljm#fjc$}Ot**CX7G z$F({pihN&B@#9c`B9;{>aqdOPA{kz{tgjpR3clHC-d4OkyF%!6gvGKA^xG{6Qoh8A znI=EdCY}}i-bRb^soOD)rhoNADIgXXoGc#!p(*}t2z>nfrQ0d@FWhu<4Yrp)S*Dla zVGyMz&;&_~>e4_>X3eS+=`mP>iqfs5t|WotwamcN3|ZAm#_FK@7Uk4ING4gvaTZlRp|-Z=|A#*31Lm_dmFTW%D3$ppj> zc8X^U>vjp)C~;{GCm(Wo&eUNE=6KB#x2D>kNB?Snraa1R3+|@%o5mdY5#IbWtabP# zlmg9-L!b)wml>{mdr4agmsoG|J0RyuN2F7XNy->FqAyQ1lxG!-B)TTOh8*bLQ^C3r zpi9cagm^MqF%e&hluR@M)#PPz^@F;eUw>n!=-&??HMS=;YlEt15eNSa1xg6K`r>4`rV0R#->2 zHgvxT4?xBNQ}sm`7KE_{WHbO*-q@c)zIQ_u{4XH(mmCP8Ia_1u~ zCfEUYex0mv~S}*P<4MZ}6GzZ(9Tjq=hi_Vv;$!$#T5GI@#BGD9L~) z{<@}{ysHyZ4@d+8-$vwV!=iDw3nsDJj6bMz_QK+w<78fRfcpJ|t2w^7K!z~oT)-zk3bgwy`LDDbae1l6vbG&6jT_Ud+_2Qu^_-Vi__3KJS{2|mB4#0oV19|g+ zuze@2@{=^k3Ln7RHC~W>@VxA3Yvg69yu>orgR zg#Qe0hW*XT zS8r03u;9%K&k+!mQr;3FX8ynoa7DK~4qPRIAYM<_a~<*2O65D8e)hd^@>$${Uclul z2Fk1*UefZzvi9-Bd4&lXXu2*!a|0w55Oa?7t zf|E@@z8MoQS92Geq16)7bMF6CH|GEdr2L=vD(ctspQ+pS(Yf&eFgk9G;K5Y^B|LWe z;SIffSK+ya3|%NwXN@}gPxafD`imv@wdApNKBBmUO!BSEd>SUtq0-6)=+W2+qqxC3 zN8&ZOB~ah@e`5rhdsl_Ohw&R+t|uK`bPeO($?Wh0RBF{N(|Y5GweLz7Y{BZlB7Mi> zP8_yK-_r`L&@<=T@Yb4lAWT*<#`7iKnt6cI^pL&B7N)MlVR41SFqxL_$}N6JgM=RK z&!9S`87F9e6MI*~AmvM$Us8%NwjWsvFEJy?3TV zdgsR2K%U}m3^>Ik0EEY}-S^+Eue7~mCA#a-PN)e^l1>~ZE6swkapA8xQn-E?kqB~e z;bFqx3Ft66Tr|}(8^|pQ=Tov0SMr+?5=k%H&dm!Un1kB9+Kv}p`)jbH*5|;k%sQ~t z2#ncDNFc~laEk$8h{7raOs3Jr6SMnZXH7xl+DiP}OP*Ft)dLL|dV-)M$v*f~mL9j&YCShVkHz533m1n`_n;j~n@fOl#f;_VOZBmoAKOO|dIuOEMP9 z_5q-GE(6!jT~4b-Gmq**M<~k0Ci@_h_)A$r>lA~_Y2N{TJDtLx9$=${bHoQH{OcDC zqHp~woUWg8%(os0s>#S)aezpFGXG>yb9BlpcY(zkwuNX%!h4>9<@c1K807CEv0G)mWNEjR{RcQ1!2Ju)4s2~9{c?%FtrqffP-jW5(g}rkT zB=!!~QOEF64|TeBk6@JE@bw=Z)Bl*|_lkp`k$dgWuzvQAxHlv{PFGQW!S1l6 z3P5o#&FR~Mp-9a*P$IyPRIuLw=K~P^1Tr4}@<#`7&I$3$1BSxUV^4uZ@MdubVXnEytMvHKe(6oGGMS+NZC~7QX5QF6;uhh{J2DF5YX^4ifu?-2iw1iD+i4|!H8`BUiVcP-$Ex(zz zaL={mHCJgES6oZpaFza!Xg{v>w_BwUH(Rj{$cwG;j=$)7g#JZbl=_)?!obN4J(74I zg_@6U!YVfTwO*m6+#2EDAr{)@Q-rx$aJNK$oze4g7Fhj?<_(%a5gyE7T3`gS#)&Kk%Ubz<%uL>cn zuxAz^B-e~ARe8(g`|6TWp0pnFB)mbYP+aLuHJ!rPnu(HDvKqvy{2C5a5q^zaBbE#& zg}zQC0+~u{tl|RgK8Gc5ibUd>%ajnUde0>YVyGrrIJ2gFaaM<9$5^s?qLi3R=ig4H zV?*OUuorObJrTyZ{iCULdapi~OUK;)>E`Ksk_M}C)1#(})o)AL*wtPLew3iYs9PJ^gopB-0-Ser`J($JaJ$KJ1Q}-wX z_5xowzXKBZ7$^20kfXbv5Eh_OM;%>AIQ-2*k^XeKzg?XJt<`n ztK2n1&+kmo6VnED>_oF~AZ1JP63(aUNgoLH67=0UQx9`kM4$7iR6S|@{S#C6n7ko* z&K_Dx%H3?~%u9kgUY~`~;`>wfXa_ay#)K(44GGD5V6>7r$A_(NRq*Mk{_Vs$$eZKC zAGh=D{DH(d2<4u1C`nsPaQ9Rck|?Pmxi4Nb-3onuj0E2SX4Ys4s%}!fxPvbcO!ix3 zn{kCCWne@3X!Hzeqe@9lt%HbI-=DavW$L_=2VL_?M zJpI)+9PqBOz+3S&`~qix*j7ObC2T$6TBe8K(IgJTaV&^;5KElYI=ucD+(@PLJz`QJ ziX&FGn3z}Cu44E$2CCvmMhujQZkTfOkZFa80@ZxX7;nVUjQ_>tiCmB4j#ot*uWFq1 zRZ}2-gZhA3f0TGIcG;jU##$e5-TP(D;}(bQu1W%ty7x6sVU*T@GDePO^!6ITYehWO zWQ2QUKDvQW+u)uS0C2MdVHL6L1lhRp1_+TMp3C40 Date: Wed, 27 Sep 2023 10:41:01 -0700 Subject: [PATCH 15/37] Add cygwin build & install script to buildRealease action; remove old Windows docker build / install (#1337) * Add cygwin-sdl build to buildLoadup workflow; add installer for cygwin-sdl on windows * Change how buildLoadup computes latest maiko release to accomodate draft releases * Fix call to gh release list for maiko * Debugging call to gh release list for maiko * Debugging call to gh release list for maiko #2 * Debugging call to gh release list for maiko #3 * Debugging call to gh release list for maiko #4 * Debugging call to gh release list for maiko #5 * Debugging call to gh release list for maiko #6 * Change maiko downloads to accoiunt for draft releases * Change maiko downloads to account for draft releases #2 * Specify shell (powershell) for Download cygwin installler * Few cleanup items on cygwin-install * Update ShellWhich to use command -v instead of which because which returns to much crap on cygwin and command -v is more portable overall * Switch from using medley-loadup & -runtime tars to medley-full-*.tgz so we get full release incl notecards; delete maiko on install and replace with cygwin maiko * Make sure Notecards doesn't try to load its HASH fileon PostGreet - for apps.sysout * Add xdg-utils to cygwin install to support ShellBrowser * Odds and ends on cygwin build * Redo medley.iss install script to use tar from Windows rather than cygwin tar because cygwin tar was messing up ACLs in windows. Needed to change creation of medley.bat accordingly. * Remove junk lines from buildLoadup.yml * Restore accidently deleted line to buildLoadup.yml * Fix multiple issues with cygwin_installer filename; arrange to remove placeholder.txt from the release assets at the end of cygwin installer * Change name of job from windows_installer to cygwin_installer * Fix missing GH_TOKEN is removal of placeholder.txt; fix naming of output file in medley.iss * Fiddling with getting cygwin-installer name right * Redoing merge of medley.sh/medley.command to handle the Darwin plus Cygwin cases; is medley.iss recreate symbolic links surrounding the medley.sh script * Fix typos/syntrax errors in medley.sh/medley.command --- .github/workflows/buildLoadup.yml | 99 ++++++++--- greetfiles/APPS-INIT | 21 ++- greetfiles/APPS-INIT.LCOM | Bin 9009 -> 9040 bytes installers/cygwin/.gitignore | 6 + installers/cygwin/Medley.ico | Bin 0 -> 159126 bytes installers/cygwin/editpath/EditPath.iss | 165 ++++++++++++++++++ installers/cygwin/editpath/EditPath.md | 118 +++++++++++++ installers/cygwin/editpath/README.TXT | 3 + installers/cygwin/editpath/i386/EditPath.exe | Bin 0 -> 116224 bytes .../cygwin/editpath/x86_64/EditPath.exe | Bin 0 -> 134144 bytes installers/cygwin/makeflix.iss | 128 ++++++++++++++ installers/cygwin/medley.iss | 85 +++++++++ installers/cygwin/medley_logo.bmp | Bin 0 -> 54054 bytes installers/cygwin/medley_logo.png | Bin 0 -> 10272 bytes installers/cygwin/medley_logo_small.bmp | Bin 0 -> 13254 bytes .../downloads_page/medley_downloads.html | 6 +- installers/downloads_page/medley_downloads.md | 13 +- library/UNIXUTILS | 16 +- library/UNIXUTILS.DFASL | Bin 2671 -> 2667 bytes scripts/medley/medley.command | 8 +- 20 files changed, 612 insertions(+), 56 deletions(-) create mode 100644 installers/cygwin/.gitignore create mode 100644 installers/cygwin/Medley.ico create mode 100644 installers/cygwin/editpath/EditPath.iss create mode 100644 installers/cygwin/editpath/EditPath.md create mode 100644 installers/cygwin/editpath/README.TXT create mode 100644 installers/cygwin/editpath/i386/EditPath.exe create mode 100644 installers/cygwin/editpath/x86_64/EditPath.exe create mode 100644 installers/cygwin/makeflix.iss create mode 100644 installers/cygwin/medley.iss create mode 100644 installers/cygwin/medley_logo.bmp create mode 100644 installers/cygwin/medley_logo.png create mode 100644 installers/cygwin/medley_logo_small.bmp diff --git a/.github/workflows/buildLoadup.yml b/.github/workflows/buildLoadup.yml index 635d0a8a..5020c147 100644 --- a/.github/workflows/buildLoadup.yml +++ b/.github/workflows/buildLoadup.yml @@ -128,6 +128,8 @@ jobs: combined_release_tag: ${{ steps.job_outputs.outputs.COMBINED_RELEASE_TAG }} medley_release_tag: ${{ steps.job_outputs.outputs.MEDLEY_RELEASE_TAG }} medley_short_release_tag: ${{ steps.job_outputs.outputs.MEDLEY_SHORT_RELEASE_TAG }} + debs_filename_base: ${{ steps.debs.outputs.DEBS_FILENAME_BASE }} + maiko_release_tag: ${{ steps.job_outputs.outputs.MAIKO_RELEASE_TAG }} artifacts_filename_template: ${{ steps.job_outputs.outputs.ARTIFACTS_FILENAME_TEMPLATE }} release_url: ${{ steps.push.outputs.html_url }} @@ -154,7 +156,7 @@ jobs: id: tag uses: ./../actions/release-tag-action - # Get Maiko release information, retrieves the name of the latest + # Get Maiko release information, retrieves the name of the latest (draft) # release. Used to download the correct Maiko release # Find latest release (draft or normal) - name: Get maiko release information @@ -176,7 +178,6 @@ jobs: echo "maiko_tag=${tag}" >> ${GITHUB_OUTPUT} env: GITHUB_TOKEN: ${{ secrets.MAIKO_TOKEN }} - # Setup environment variables & establish job outputs - name: Setup Environment Variables run: | @@ -198,6 +199,7 @@ jobs: echo "COMBINED_RELEASE_TAG=${COMBINED_RELEASE_TAG}" >> ${GITHUB_OUTPUT} echo "MEDLEY_RELEASE_TAG=${MEDLEY_RELEASE_TAG}" >> ${GITHUB_OUTPUT} echo "MEDLEY_SHORT_RELEASE_TAG=${MEDLEY_SHORT_RELEASE_TAG}" >> ${GITHUB_OUTPUT} + echo "MAIKO_RELEASE_TAG=${MAIKO_RELEASE_TAG}" >> $GITHUB_OUTPUT; echo "ARTIFACTS_FILENAME_TEMPLATE=${ARTIFACTS_FILENAME_TEMPLATE}" >> ${GITHUB_OUTPUT} # Setup some needed dirs in workspace @@ -337,6 +339,17 @@ jobs: omitNameDuringUpdate: true omitPrereleaseDuringUpdate: true + - name: Rename medley tar for the x86_64 platform + run: | + cd ${{ env.TARS_DIR }} + mv medley-full-linux-x86_64-*.tgz medley.tgz + + - name: Save medley tar for use in cygwin installers + uses: actions/upload-artifact@v3 + with: + name: medley-tar + path: | + ${{ env.TARS_DIR }}/medley.tgz # JOB: macos_installer ############################################################## @@ -371,8 +384,7 @@ jobs: echo "MACOS_DIR=${MACOS_DIR}" >>${GITHUB_ENV} echo "ARTIFACTS_DIR=${MACOS_DIR}/artifacts" >>${GITHUB_ENV} echo "TARBALL_DIR=${MACOS_DIR}/tmp/tarballs" >>${GITHUB_ENV} - echo "MEDLEY_RELEASE_TAG=${{ needs.loadup.outputs.medley_release_tag }}" \ - >>${GITHUB_ENV} + echo "MEDLEY_RELEASE_TAG=${{ needs.loadup.outputs.medley_release_tag }}" >>${GITHUB_ENV} echo "ARTIFACTS_FILENAME_TEMPLATE=${{ needs.loadup.outputs.artifacts_filename_template }}" >>${GITHUB_ENV} # Create tarball dir @@ -410,23 +422,23 @@ jobs: -# JOB: windows_installer ############################################################# +# JOB: cygwin_installer ############################################################# # # Create the Windows installer, push it up to the release on github and # update the downloads page on OIO # - windows_installer: + cygwin_installer: - runs-on: windows-latest + runs-on: windows-2022 - needs: [inputs, sentry, loadup] + needs: [inputs, sentry, loadup, linux_installer] if: | needs.sentry.outputs.release_not_built == 'true' || needs.inputs.outputs.force == 'true' outputs: - windows_installer_filename: ${{ steps.jobout.outputs.INSTALLER_FILENAME }} + cygwin_installer: ${{ steps.compile_iss.outputs.CYGWIN_INSTALLER }} steps: @@ -446,21 +458,57 @@ jobs: echo "MEDLEY_SHORT_RELEASE_TAG=$msrt" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append $aft="${{ needs.loadup.outputs.artifacts_filename_template }}" echo "ARTIFACTS_FILENAME_TEMPLATE=$aft" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append + $debs="${{ needs.loadup.outputs.debs_filename_base }}" + echo "DEBS_FILENAME_BASE=$debs" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append + + # Retrieve medley tars from artifact store + - name: Retrieve medley tar + uses: actions/download-artifact@v3 + with: + name: medley-tar + path: installers/cygwin/ + + # Download maiko cygwin build + - name: Retrieve maiko cygwin build + shell: powershell + env: + GH_TOKEN: ${{ secrets.MAIKO_TOKEN }} + run: | + gh release download ${{ needs.loadup.outputs.maiko_release_tag }} --repo interlisp/maiko --pattern ${{ needs.loadup.outputs.maiko_release_tag }}-cygwin.x86_64.tgz --output installers\cygwin\maiko-cygwin.x86_64.tgz + + # Download cygwin installer to be included by medley.iss + - name: Download cygwin installer + id: cygwin + shell: powershell + run: | + wget https://cygwin.com/setup-x86_64.exe -OutFile installers\cygwin\setup-x86_64.exe # Download vnc viewer - - name: Download vncviewer - shell: powershell - run: | - $url = "https://online.interlisp.org/downloads/vncviewer64-1.12.0.exe" - $output = "installers\win\vncviewer64-1.12.0.exe" - (New-Object System.Net.WebClient).DownloadFile($url, $output) + #- name: Download vncviewer + # shell: powershell + # run: | + # $url = "https://sourceforge.net/projects/tigervnc/files/stable/1.12.0/vncviewer64-1.12.0.exe" + # $output = "installers\win\vncviewer64-1.12.0.exe" + # (New-Object System.Net.WebClient).DownloadFile($url, $output) # Run iscc.exe to compile the installer - - name: Compile medley.iss + #- name: Compile medley.iss + # shell: powershell + # run: | + # iscc installers\win\medley.iss + # $filename="medley-install_${env:COMBINED_RELEASE_TAG}_x64.exe" + # echo "INSTALLER_FILENAME=$filename" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append + + # Run iscc.exe to compile the installer + - name: Compile cygwin_medley.iss + id: compile_iss shell: powershell run: | - iscc installers\win\medley.iss - + $Env:CYGWIN_INSTALLER_BASE="medley-full-cygwin-x86_64-${env:COMBINED_RELEASE_TAG}" + $CYGWIN_INSTALLER="${Env:CYGWIN_INSTALLER_BASE}.exe" + echo "CYGWIN_INSTALLER=$CYGWIN_INSTALLER" | Out-File -FilePath $Env:GITHUB_ENV -Encoding utf8 -Append + echo "CYGWIN_INSTALLER=$CYGWIN_INSTALLER" | Out-File -FilePath $Env:GITHUB_OUTPUT -Encoding utf8 -Append + iscc installers\cygwin\medley.iss # Upload windows installer to release - name: Upload windows installer to release @@ -468,7 +516,7 @@ jobs: uses: ncipollo/release-action@v1 with: allowUpdates: true - artifacts: installers/win/medley-*.exe + artifacts: installers/cygwin/${{ env.CYGWIN_INSTALLER }} tag: ${{ env.MEDLEY_RELEASE_TAG }} token: ${{ secrets.GITHUB_TOKEN }} omitBodyDuringUpdate: true @@ -487,7 +535,7 @@ jobs: runs-on: ubuntu-latest - needs: [inputs, sentry, loadup, linux_installer, macos_installer, windows_installer] + needs: [inputs, sentry, loadup, linux_installer, macos_installer, cygwin_installer] if: | needs.sentry.outputs.release_not_built == 'true' || needs.inputs.outputs.force == 'true' @@ -503,6 +551,8 @@ jobs: echo "MEDLEY_RELEASE_TAG=${mrt}" >>${GITHUB_ENV} msrt="${{ needs.loadup.outputs.medley_short_release_tag }}" echo "MEDLEY_SHORT_RELEASE_TAG=${msrt}" >>${GITHUB_ENV} + cyginst="${{ needs.cygwin_installer.outputs.cygwin_installer }}" + echo "CYGWIN_INSTALLER=${cyginst}" >>${GITHUB_ENV} # Checkout latest commit - name: Checkout Medley @@ -514,7 +564,7 @@ jobs: # So this will be the final update before creating downloads page # and we can use its url for the page - run: echo "placeholder" >placeholder.txt - - name: Upload windows installer to release + - name: Upload windows placeholder.txt to release id: pushph uses: ncipollo/release-action@v1 with: @@ -552,6 +602,7 @@ jobs: -e "s/@@@MEDLEY.SHORT.RELEASE.TAG@@@/${MEDLEY_SHORT_RELEASE_TAG}/g" \ -e "s/@@@COMBINED.RELEASE.TAG@@@/${COMBINED_RELEASE_TAG}/g" \ -e "s~@@@DOWNLOAD_URL@@@~${download_url}~g" \ + -e "s~@@@CYGWIN.INSTALLER@@@~${CYGWIN_INSTALLER}~g" \ < "${local_template}" > "${local_filename}" # Create sftp instruction file echo "-rm ${remote_filepath}.oldold" > batch @@ -566,6 +617,12 @@ jobs: env: SSH_KEY: ${{ secrets.OIO_SSH_KEY }} + # Remove placeholder.txt + - name: Remove placeholder.txt + run: | + gh release delete-asset ${{ env.MEDLEY_RELEASE_TAG }} placeholder.txt --yes + env: + GH_TOKEN: ${{ secrets.GITHUB_TOKEN }} # JOB: complete ##################################################################### diff --git a/greetfiles/APPS-INIT b/greetfiles/APPS-INIT index 462c7eda..8c83e70e 100644 --- a/greetfiles/APPS-INIT +++ b/greetfiles/APPS-INIT @@ -1,12 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Jan-2023 12:44:20" {DSK}frank>il>medley>gmedley>greetfiles>APPS-INIT.;9 21022 +(FILECREATED "16-Jun-2023 17:20:09" {DSK}frank>il>medley>gmedley>greetfiles>APPS-INIT.;11 21130 - :CHANGES-TO (VARS APPS-INITCOMS) - (FNS Apps.DoInit) + :CHANGES-TO (FNS Apps.DoInit) - :PREVIOUS-DATE "19-Jan-2023 11:57:40" {DSK}frank>il>medley>gmedley>greetfiles>APPS-INIT.;8 -) + :PREVIOUS-DATE "19-Jan-2023 12:44:20" +{DSK}frank>il>medley>gmedley>greetfiles>APPS-INIT.;10) (PRETTYCOMPRINT APPS-INITCOMS) @@ -170,7 +169,11 @@ (* ;; " create the Documentation and ROOMS, Notecards Activation Buttons, if needed") - (Apps.CreateButtons T]) + (Apps.CreateButtons T) + + (* ;; " Make sure Notecards doesn't try to load its HASH file in NC.PostGreet") + + (SETTOPVAL '\NC.SourceAccessFlg NIL]) (Apps.CreateButtons [LAMBDA (DoDocsToo) (* ; "Edited 13-Dec-2022 12:51 by frank") @@ -373,8 +376,8 @@ (BKSYSBUF " ") ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1146 20888 (Apps.InitNotecards 1156 . 5018) (Apps.DoInit 5020 . 8119) ( -Apps.CreateButtons 8121 . 16945) (Apps.CreateLabel 16947 . 17757) (Apps.ActivateCLOS 17759 . 19108) ( -Apps.ActivateRooms 19110 . 19961) (Apps.ShowDoc 19963 . 20112) (XCL-USER::EXEC_INTERLISP 20114 . 20886 + (FILEMAP (NIL (1109 20996 (Apps.InitNotecards 1119 . 4981) (Apps.DoInit 4983 . 8227) ( +Apps.CreateButtons 8229 . 17053) (Apps.CreateLabel 17055 . 17865) (Apps.ActivateCLOS 17867 . 19216) ( +Apps.ActivateRooms 19218 . 20069) (Apps.ShowDoc 20071 . 20220) (XCL-USER::EXEC_INTERLISP 20222 . 20994 ))))) STOP diff --git a/greetfiles/APPS-INIT.LCOM b/greetfiles/APPS-INIT.LCOM index bfa75964bf8c4f7bcad539b3fecd2b622e7d4d19..67ca0727b00a31fdb89f21bdc9f5145f599640b8 100644 GIT binary patch delta 255 zcmdn!cEN2zgn*f@S81NEk%5u1f}y#Uk-@|ae@R0_O$8+*16{8~sEm=3m8pT1fx*P{ zqQS`GdU|?F3Mq*tsVP|1n9I)=EqC@2}CTW4ipsiZKm&QjFSP{GL1 z(AYqM%gWiq(a+sASU1Ff@=Qj9$$E^OlP@t^F&P?c=4C2nXAIul%<07_lgiOIwae+f%X1tmiZgoKfim4StoiSfh>qQS`G zdU|?F3Mq*tsVP|1n=5H@X}Ed%xH<>9I)=Eq02QIzW@Ticq%ipaqot;$f{~$tk&yzI zm9vMVpSx?YZiv5vMwnwzu!3ViK(MZ-pJ#}(zi+VS6C= z#B|epa&K~zdviKOdIh^H#202`iT^fc2{u!N%2#VEx)vux;HE*ebgbX#FxFNAa|2DF(P$VZb1*Y81jf#F zuupd#>@}1FJN@4+-C9o2;7CTF1qp5j5a(eA zHa0fM`F`+p-VH}wT;Rm9!{F-b3cfDZ5a{U)v0hdX;_VD!{;m+|>i|iewAV^F|fK#VVLCP@|NOx1iO#`yM)FI1jJLLLq zha7Kpxa7Yb%7b=5U6?jBozj7}(>l-PKl?BDQX;6@t1(z=7Kuu956ciLdRap^KR+K|yNjkJuW6my z?;$*X{5E{}{=4w$hmYaok3WVlK6xL$`t$?%=F3mv`)@vjZ@&2ke)#4~`02;*;OC!y zf?t065&rV)&+yxCzrpYS_&faj-~T3(0wtpigit~;KruiuKruiuKruiuKrtY|K(K&q zCM-cLKVLumGjY!^te~0jjrYu8midA3FhWk^Z%lSG0(tk$gdvz|UDP^W8d9wSX2Lt( zGlQ9-bt5-Mc>fz{!r%2`YZmXG888I1na&N^$Pt#2ikbB{1jE}b>?ztuDt6C6c!Pri z0|HS30s{iPoa;pTI|Jbj4)9{oIbvaM;7~tH{sss8Stq4&<+Ph`kOP;{st4mW(Nlcdh&-?jK6!PEgc01Fj-6% zioagOEb<)8vas5{d$+ZS1Pg%X*4Fy$>_M&$jdbR8ULBL+QR7gd z)im)O9PH!Via9>YNNpL<-y5A7XHhc9{aMaF9gioBrpezB(qA%|*ZKS%>2cqQZ}bf>2rL{%ojONu~vua>#Hx*o@$>v4@0n`Jl4$;!&gZI)H?nx^^& zpTGR!y>a7e4_D5p`w{9+NpDBOG$skEyS%)-e7t;oSnTQ2;W5n$^zkw<7FDyjQDV;GdB-!1 zIebc!kI6}=Lv4J@%QF`9`TLZfjCUSv5!qUuC8~tKQEWCA-ti8f@=UNra$ieMQ$IIr zB94O`OYTgDmu->U-55nolx< zClkNHKBji|BE+M11bG$#R088c;^J4tV}b+JS1ww(QihbZoCEGRxcA(cRJk7$W;^osEJx`1=i(ii3vB2GtwefEg-w}j>wfE5+d zdNl5==$rvwZ-Oo2)>5pTG(+aL@&M`<_{CbOxD7K%{qB(@%0J^z+vafXT z#Ub{+>!WC#{z5+-P3glVy2||w;+r|G^g&+Qxp4#iCH>LNZSz6c(2hRFg@ksj0TKg?D5BXn6UaEy<|2 zXvx|YYuBz_xe|AT$YAI5Ms8BPaRa+eua3oIPgxVsBRtD*9Z2?+CSJK%b}d`9X!)Y$ z3zjcJS+JB-xwLKJd3C+ER62hLCl_AkE*zCSDvFym-HCqwEWSVq_&dTMKq9=QO+@W# z1b^4NlQ??C4bTL~pwTRzg>QA3hR0e^QM<;JMKaGLUFk9Bva-$-|BM7}oym1rlgToO z*atF__&DWIEirzZ9oH+b$G&NbL6>AM;lzevxN?>1u!i!5e1@lv}iL!Tbf> z|D3r?P}UwFBno&=hTWN-fP>Vzl7D88-*oWI_TQz;6&)S*)f%?8_V&lm)?!9X{+nuZ z_G@Wv9TkPG+te+jDB;HiZ~O`3P4uV)v6+hNHxROMuL^eCV!!Q1mA#v`?7|*MQao|b z448b99q+5)nczUP)vJVLF?*q z6xGct!Yy@*Vt`_RVt`_RVt`_RVt`^`CK(Vl42L>LF+eduF+eduF+edevkVaPeBjh2 zpg_Eh9G&L_oW{@dF&AG~E?qPaRxH77#R^!xaw*8HSO6Q=EQ3ur--p~fw9ClAwr$%$ zRdzXO$}NZOIM2s+#r2@Cyb_GmWWY>&8|>2B1S%>jpsB73+qZ8Ao$aciw?iE)jI_!5 zJ`4>FVfRiM*gHDkhrPjiurt~U2TZn+^L@DBTpuSaWWmNj5$sKs!Olz*_M51J3tbuK z``7{p7~0^t#|+$dtHLpy^W(U!G5GG5gAiMJoa?D^`Qc%j_5#E=~u*$;k=a z-Q2+UxIOs0IpMq>P7vv311#@j5aM?N;=HXPmgxYItfLSW~%2RXMS6F*6?O3zGrgi9=3K4&+}*g_68rRzh<{4zyg(gqE5TsI9JmuG)O)slNmrjTO*PTLt}1B{+}AWw_E&1;br6fJ2|5 zySp3b@~DUYjt1!M>4EDwr^k)HdKez+fq?;>&*N$@+#2o!?30Dt*LvW^D{XLRqz_)X zIS6-d4#R^NufRi`@8hN0H*ubiyYTA$yYTSUJMhLEZ@{|`@4-87y$(UZGAsgS8&8mrW$x9hI48^1YxtoPu^&C+ zp*O^gIoo(xK9(1U#mHdjGr;3zSt{IHq6o;>mL*4>#eHon4U z0}s=aW@Kb!h#M&yYL~?0nT7ab`A^izt`TB749CM{OK|B)l*^D(aZkee3`^w4 zVutXr%owHh_4QTt^|kdyZs&)_;)SEn*TzopnFc~;N}pL~!F^nhy3@<}yhl6*g~esX z#f8PiWw;dNe`Ypv;tJh5M;s52&dbiWyDU$At?@Ce4& z@Gv=_;n1}!#4lUPCx98iWCq}d-}&M94>ObA`SnLAzPM^m9`iMQX9j@KQ;{Dr`YZrv zIA7CG$mPsf1^CI~Pw#?wN|a}ZA0}UV?@muGz^NTLLgX}r6yt`*aGhDf6DYt>!5&`n z<|Oj5{pwlLAAWv@iucSF_ab;1&3|STM(C+bK7Ae@Y9*tHyGv44HXog|mF_tka9Dmm z9?A!J=}S<9hllHpyk;nu5h7*O%J$VWGTgdf0v^v9DiuWI2{7Lkn{hOPuZ|(eP_5DI z;t4bl>l!L3cz*Dh5qMHtJH$wqk>{-H4-5IZR^YzJ+Io+$kY}`%XBQ6}`MKJXuzsn` z(($rj!NS#MGgYe)tBN)?&o@*@t9gpf+qA5&s_s3{A}TpXU^2C-vh#D<)u$MHkPH*p$LD4;7ofx>L)B zYmGdnAI~-M@f9FGeGPN)Ou0Oj6klTbk(Ay$QY(?4Dc8rQ6kn)6m)m%A@dz4<6G%K$ z?Io0iM|}G7))5ejaAqw9~Oiu8`6RRsRFS*X$Qg% z9X-oIK<)`##6LZub%K%_+wZ*oOcDg&Zi@QD@@8DbS=ak9u7rQh$J5%fjKr0vL>|lE zpTGx&G!l5G5MeBDyL#bAjoMpxYX>{hB=wZ=_a_KHWXk;5H3&ay)ZRvviawGu5y^PG zrjp)S9**MpX)`tt43OCMDA2zl6sj5EXTn;QWPYZUAEN#=a1y9c_=bnup9)XSPMU|O zr|)EYelWho>d#Z*sZi6vm(2!rN%|+E9z^gnjv3C0wh8g@_xB1vq}e4pza%%rY?1^8 z(8cTX#CXh%j~+oeM(mE9IKkO)kG8`JScnb88u?3|36VEG9Uk*7V*4=HW9~jY7;7X| zPdGaOCrczJukld^2_y3K;(T!=-5qG%io71<~!n=cy+Q4!qh?ZoDIg(q~XU` zj}d}jv4!C;6^{_~8NaHO&)+XE4@6n)vdhm5hZ!z|?;>xxKT!v$M0Sv%SPvQrXUf zLK=Kcb9v$5dm!qMRQwo;!_#$4+hHFrSWbxc4oPLZ5FSg>{6y{W5EzE&C#pk=XLq$bVMHPPv`e@&&=90>l^fLY~f5bDDT3wKjhU+D= z*(10sa6e46eRwjEe5#0?Zod37DMd-gi8)zo%6Z-Vtp(|0IWo!5l;X>K@zQl@ zoVP>(kMIi^^qrp#L?nc#XNvLVtGP{X+m5&wN0f=p zV&R`Fezd4Qa=-+?GNW%p!um6gpP{sU4g{|xxz5fuYqm*WNQlBko@4tP#R}*xLLsGJ z=mp+*eg;pkS6AVPSrT zDuvV6P`t(T;|cPo#Ylx`e0*J*DLlkrJB~K~9uc)ZLjK=)18PI38zb;O2zipf1HgcAGoV;Z9N^4xzY|mcj^zME>>2Ooup@j36 zsBGP;vQ=dh8sv58Q_GNrlDME17r()mulNEM>zO!Zt-qh1${u2swY|>Rs>XITu_MG; zOWs@;N8V}jM&Fs?x>179nkF03ku~~f2L;ks6VbI~^uJ^Ymi}m4IB%JzZy+(|jufmT zV}UbG{!4re4u-+_1?Eh2%kG1_plVVr!}A6FY7|D+vPZkba3Ph#k) zixdMC0~7-k0~7-k0~7-k0~7-k0~7-k1JllcxG!R;^ArOV0~7-k0~7-k0~7-k0~7-k z1LGMW))}~rn=aov1B?^n*BKyOE?G#dGcX?(FJ265md^*7)yqM4?IPH^ZZY5@mas)u z7L+zF1(nT9VLPrfpdh~uloYnX4z+DSQ&|OuDyzX%eKlBU;hF z(^SFJN)8;XX}HFKIUHjs!x0-D@Y<~iZhN+a%N~7j->(Z^2hG6WMh@7x-T<-gfDf_e zza|g_Fn4;FO~RL?2Rw1Q%R);DiO>D?d2k=m19! z*no%AZg6w4hoeW2f`{u-z=2rc=k5Y*FDGDoABAXd8;J7R53#=cAdzJcXV?cJ+}8&18eMCEf1QE!lSd&l;sm6{u;F|H8_p(1Lcy6p$WFy|22zutkNP_hAbhvOX9dfhIL2hm?6kf~+9A*WTxSl|Dbu~1XrjzRlw3eSI*Ar-}Duixa zQ(&mQ0&q4Pz|SLKpaa(q=e=Damw>CmiZ1F4 z;%SJc2_NAv30JKZeah2uP3W`a8<++X`7(KC`X!0428-Fl#rF4RczF@?vXeXd)&pYI zzNK~+arx;JOX3)F*26J2)n4Zy9v7kalGR}PuKFmY7UW;bzeIkpnqQdV8Y=;p#q8x1 z-b$DGfz&6S;kOE!>#R&>jjzezYOpey$}CJ%id=7{B7RcpB=bd|JzR>?$0Nbllmb5m zN8ZZP|s#Gns!0@Kr3xS97jAjz-|hiunr`abziR zSf)JXSy83Q!B`UbYH6-PsUm*W)ir0gGVn80&PS=l2dT^%{SKATdvW^3J5L(2l%$!k zNE$Arxkn%#h4fw+mya|LoThsO;!#MygmKL#Uz3PO#o5Fqz*nwk;+f1dXEJdcw@(Y5 zUH#%ukAho!TLiygp^t13|vE`v!<82B_PfGv>UH`nBxJBNSV$o&Pit#s~c zS`6>mgB9TK=cDK{Rt^a!K(v|7UfW`fT{hcGUtejp!&tsL9+%+^Ohqw>$mYhxOssv06EmY{!52#@vZ*maBCcnlUj$!GO^G6D3ta2~C7f*T zob6&_!V#P^hF>_gIr5B2PP!^alP7hW9iSZD)KZgZ&7GZ4;3&Ij;qv8{vzKS_K_}v| zrKORm{MFRdk8Z?)FkjNu_xGQXp2`Wk{h1^#F=?^Z+>kE_Q!`?|O^UCdpD%7GoIPQZ z@K%CF#G^Q=dwN{hX5Oj4lN6c;=g8aBBuqcciAOQOrhzY(p-~EV(nR57w2`IQIKX%m zpQla(Uo1mMvCpry60ar_`KmKFnNUH+hM2s-W=gK)?*e2I+hUN+?;AOM zJq<32d`ZwRtQTTmAqvi{J9->7;Grgl;LG4y;0n-J-Ly$ojBIhwL0m>Ng-cTQ$o7-t z^#G1*U@u9kC-i=%aA7egHa!Nhy|JC9>KPLg6N{Um5U`#`?^(Xymh!qe_}R=jDXwm5 zkyJk7^nC$LeHV_7kqXAYBXYK>r^i5svWC_=l?cJWj@n|YTPCU&F!}qV$7Qlp$Hg>o z%FoZvt`a4=F*y_B66j|VforPys=t1?*g8Rp-SPBDQ}OjLq9haOHyMv>%6cye*Tv0i zm6Y@)_wr4^*Nou0q-}unWR8{ZqD&LunsPaWe2rtDd!opgAqtAXxf#SIR=_tNksIUY6F;UEtqeQ)tahJaG=Stii02_Gmq z9$nqC3JNl&@TQUNuOUAFLcO057t27KTp~vF&ixE_Ce|G?nDm?fiE!~TE8561lo4O2 zfMZ0bUEM)xaSv^_+K&V~3a$#8rDp ze?r>HKnMEJO-$(cL(!MngYQl7%?YtXIaf87ZAgPF2p7fn@$tsZM`70mVre*jsUaR# z8*CsQE*}kJM+++}{99R=Y1+l(r^pHTPe_PQOo%_jhiliw`PW$Nva!a)NA{Qz<59X^ zLvLC}LtR}1vDMYpHZ<}{{W;IECZRO>{TQwwnv-Z;wFjl-%geZ6EHs2^jH2co_Xb>^ zgYz$tq8#GkVzc$d;X0%*9bXJ#Tw^Gk&ul-%lfzn*dc!IX7v>YA`o%ejRkm?_jp1rK zxm*UPAs-ca>B2e6nK)dvd)9JCMstn^VtNN8@YNKhz_%>(q+kV!#pR%eW1?|nG*_&Y zMc3&h@YNitG}V@sSp8~Dj1?RuouSO&E?2?wXW?ApxC9q5pSY!VR%2sR6Kz5w2dM9H`iguo4GL8$zvnj)2_jBEM) zx$}uXAq#MuGZ*JIA!S7-zaQiI5+aAVxh7uV{b6&o;*|A^p{%H=fK#K4io)uRN8Q~$ zJ#ow7izW1PTs(^4t0wUr0go$B!xzhkfkJ0sm7W*{U@51QbdHdmVxc$9<8TS;7m1}N zHmSb8p}rBP52?poraD}Hx?at(4Gz_EgDZF(hf72}R_xurpF7rW@4kJzS1p&^?&r&| zCNKu*AF30?!?lgWC8XrUeWfbPSFc`!zfqB~oS=a{0h+PP0h8fNFkv9BN;6Bce8-*G z_bp?7O~y2dcod;uTwIg!QM!94flEYsoH1NjPZX>7@z^EIFPJF^<|JeBC>;lrxC?O| zs2~=m!x{p)C#woXZK1i?QwWy`y)Q@o5?g_s1dQ>w2FPqYa!jP`+ag#lVdg%LFT^$F z41PQo{xg9~dBvl!VV);{EMlQEJ|1TdSAg8og@UqR?s{zU;(yCIL0lD@s%AR`MO$ME zoh|&dh&QuGM;Q>K3P{nHi%CpM!v8t`wlA8~)VI<&tG)8}N{lJjAH*XPxI$K#+|& z_VPv{c8t*@9#F=XczqVQ#=Q4(a>y&8*wy(o_J$u zi!+C=1T*MNFo&K*Gw6-ghu%11Gk`wwXb8QDyP!9T4!vhAp(b_@l*b)}vUq1`h+#le z;(lmPw1SRA26QD^LC+a0C`$`~u9SVylVSsHDfZBj>HyuTw$PJ)5IQrDKx>98^rr2H z{&P++lzj{avX8@1&T$yb_kwHrp3s)fgpOP`G!-VnK%O`B7KOvLidd*FItLBam!YpB z1={P1V4xuvt~Q*9>kS$3LVYR>H(!LC-Q{qlrv+|a?S>myd*OwV>+oWGF5K%bfR}rV z;m*}oczvV^9=+HDuix&4hc6AlyDxRZyLY?bt-Ay8`2JOR`~C>ImeN}fZo&O~FT&ls zcj5m1m*K&K2k_Qwci_!8@c8BLBQJiZC&TtYe@(c72(usc)bI&%WBqKgh?;nrmOTo#nC5Ol}_6zS6|&xY3+Ngms0i?D7qp zY(s--3kmB+eWydZ8kU9bMR-=Bw~NlpS=7Jx31MsgV}kEtm^i;JjYWx?H2 z7CbDskZS<$wKM`Rt1WPFw*mNA%YpB1Iq<`cwRbB7+irtUJ9!ARm&bMfaNR!#1Mog% zL9X)`j_dvrYy3qVP=wRCMd4b1vCc{mcUTD$am~NvV=927T{-LiIoQI%g9qWTqYZc+ zu_f303v{!GaL@g~_TjAe7w&TaqWup-AkzmTLz$2q6$oeIPD5N=93&+r0S-lnJSfV`fa1JNC@(w*HD#Bero0Hs z%gX^j;3d}v#3^i`w)g@xm1RLkRSwkR_1fB6z(Kvx)?5#5ZEbLUuoL?G`(d!Z7p`8t z3O8@wgj=_6!Amc_1o!T|2rs{k<<-kC!K<&nN|sxX9zBA0AKrt$I$ScAoIk_&rALpW@#i`SJ03-{-1;2 zlIDR!b_8U%2}=7^ihpUDnwk43{%3|)X`lL^ z#((-D3xV=hMy69ZbAPV$|4;$+G}?a}etTNBK-=8gd*DBce;Znr0A42Zihvz0&$a$Y zg`X8Lq3nA`{SQ*%cjbPmApWTN{NnG=l?K1*X=$_QX}wPh{%<5w4aqB?*6I$<$% zK0B?rqWNXP;wpHKXUh^DWsOrZc& zk(TEZzXc7~oOM4|Cla#2$>$S4+0}EI*&+Z{q=mvi6KVbb2>-5!CzR({e_EO96V`Wt zW}Pw<3hq669|EKUvo&Qk$i^!NL{UJ%QqM1+FazDx}cy7~gh~>fwo4zaZyPsS98L_J- z#IG`R`?mfKR`QQRaH?~BDgrOfbBA~{`ti(MRb$Hy`ES8rNCb(BTFdR9uWnf zh*MHLa5~ek6yA~ejdw?h04w5@6c3zb{FT}k@$m_%nIgc7IQ9JDucFzAz$xw&gm)=k)m0cOrMB0WEk{D(?~zjS1(_=R3| z>1p^1RF=`wMmF)r^1I2glEfgCV|-7){z${Wx3|C-P}wv`0i~XV z<(c5eS0p+DUvub$P6D#PtST`tU^x{gJw>L4azJ zmZ{*U(IiFpbA`XjJ4+y?k(O+ly+|%NC!Z_)B0nUo)MjwML5hzIKRGI=qB$oWwY>yB zUAlgAETbPa&7S^<#Lt%~c5YrTGb$V94ag)S+|`-aJT3sw5B@D&^myF3LnMA?ZohB@ zOe20x&1y-V=>@K=tHQpE`8rkHuwD`8rxCwEHZ0N-K;ai=U>f;fykNY{o3nHUPZZ0A zeSfa>=fGI8$}-;zszyVG93b6XhiC*Im76 ze5HE9oH@%!E7c0hwhggC<ikUWD=6P4w1m_Vq**9(SP|6X;H|gdW^_@tM7G`p}14YQP@I2(p8WNKYsUXFzd; z4U|M5g0eU#XpXmrwgd*WChmrgq}|YYW;eQLKxgtksLnbCHMvnxQ;-a8DGtz;Y72F# zuF!VY1==%?Kv#w{bY&ia_RJH|aoz*EFStQ>mIw5vJHkMY8*c7Ue<2Xsv%GQhfet+O z#|KKlB%{V4ye*`if7(a77eu(J)*Y z3&U0MaJ?o8O7qS_XZcxZueboUl_k(nT@C}4DbU$e4Oi>V!ASjCxYc|PZZw^T!RBHZ zX)S=89hYFZs|xyid*J5PZn!cu2*cN|z|D~%7`Z+SFTC&q+`M@cUg{}@yZx2$+LbDJ z?P@i=eys*>_t(M8SL)!6;X1f`>k8a{;Tmq&;qL7bc>Uf8JiK=ex9jl!1KeJ}3AbKmPb5{P7QefS-Q)1N{8Q zAMp4S{QT1&;kRFZhF^dE75@6$pW(OPeuKaN^*8w2-~I;w_{ZPj_kaA2Ok4k{JKne3 z(_%2#sc)^PCH$yun>7M6FQoemoj1@t#H@Ye%~#I~oHyL=7WlDYN;+ngWCvY}>XC=eaQ4f3Bjm)NR!^ z&RLq`ZWousR`N7M=K@s8@THuoFlaRG$SYTdSh_SrdPq@mae|Zl=>3fI4<5V{gcDAz zv#sjxuJ@JWoLBU&dFjQL1Bx`-R{QeyuFD>3hQx(!Ti7o=eAKFnPu;d?&fesbyc2pl z3Y%p2rR87ky%?)P-m}Ilw=6q4}CSi@`mJ%f$c?pEf6 zuI6H<(d^=~&Ls8TY#wL}P$usk-7PlVWdwWNj~qK_$puVaG1$0q*@7i2*RJ0%_6&Y^ zQ#a4F-d{L$VBdNIdT5FkHXq?o$oExG%;ly`75lcOi>P>qrJDXF;?w{@&9;# zYti!izhjDn{;8f&X)J$b(Y*Oqs|Efa-m+2N-Y2J^IHx5dC1-xlH=wy>|AIL^E&u*@ zci70weUEn29pCu6CR_jS2N*vNIGQUy`u+QRD{tpLGJ0!%xYGxvU%&9kXwGdXJHvmn z^@yOt_q5yF5B%G$!fXz`{MJX0Xb*3fX~wFp?ERmg-&Cl7{aX6TKc{^^FJpm<<{XU@ z!pDyv%=upXmBlIZ=3Z=&|L4UYQ~nj7l>M*QjfeFXIx@d?PVsWPUApzQ_0nIWPcIES z^CabWeG>%>_O%a{=Y|~ouia`Nr5xWJ{%NE^GW^(XJa^M44b4>p-YH*Q`=8Gh;bHTZ zZQkoL|0@Z4KTB!X`R7&Tk;4^#_}j0#>Ot?k8?^t>s{Na8*J~=+mEHUx9&N2J8*I4U z`UdTvoBC6pYJZyS#OI%BLYqZ#Qe{zP0e~gOtCp?ysC1c=~s&m86`R zchpj&yDfN4O0cWzLfx=iWtO+wJFjQ9=P%Y(x&Gdh-&va(cjuH?r$nS%&H35m@%lXG zfBh}R>Yu+Ce!q1^?9jToDglO{e`CG);;EG3)hWOK`>&tNB8P_-bbe>5P6X{umiv!e z-~9d5YJyt$gYD&o`Em)1RF*&kVYkE_}0X z_uF&AU!AL_pR#O2xYB~!Cq7p_^#BGPk7}C+&s`gOyFLELxeGnjxBp!}JSyN}@6r5% z-;;75&iTjx6n8JZZ{^ix2r+UB-**%*tozYHB%A;QLg#v&4&B9b z)`q4Gecv*t_wDQjG~z#!u;{|$0Ro$NOCuTSPyfE4|9XiKyNtb zM}u@fQ^;i+Ku(}3Tx9Nqk|2F3#`&X5^-0`lX$;NnRexEyTL zpghGJ3NxdjJSzrTQyif=%>|k>J)kv{sHb^CW2O(ZWCcJM*2y{xPC;Lu9}E-(K>wu> z=r4(c{_-Rku1SXc>`W-l&xEpz8BkM_1vTYGP*Yt2-IW>8Q-k%d@=I6;D}#ZmH0Y|$ zg@)QH=&CP*fw~+RX~=-YcaYqxT=f z#~;1}pM3H$eEIP^STFhne*ES$`0A@K;m7a3f}el<7JmBUAK;gtetUG^yy zo8|nD*J3P4KgI$ub0t}h>eYnIkJl9US`dS$e5UD9|h9OwL1=@2mY3t z8WZiSG)@nfZ`izf-h3k$uY*?m_v@@4cYW=u zl`EIP!o`ahFJHcL<+#hFA8Sb=jH0iTH_h^He2y@?XNY}f|nMgdKp5lzc!rn(S=k$GqR48#WI2XATzkc+yPY~JE1607b-&ypeEc9s=`gM zKTU`1QzPm;O{cLhEy@g<B!mVXMm3c{fIVgz&+MnHQ}9CThzhQ87$7%Yp%`ceYqW@SQQZYEsH&w-+gIZ#=c z0ma2dP+e9873Jkni}k0biacm7JqwN1B~V{=8Lm{PKyOVJ^wefUbA2VWH&()MT^fwE z0mmztT_Gcl7I@{s@2m^(V3}^^d>* zjjT`o>tFvuZKY&38PK3)k_@P6XsF>&Dp6Hc*HBkgS5;M==yo;YiAv@NkC5W9YvTJ= z)l^mdb4o}_p-*_fl9KW^gRsg5Lh1|cCc0mV?jIBsa-o*IzoEo_g8NmKgYePiMRlC} z3vDIcucSiXYkRsH?=L8?t*WZ7uFTmZ;eIt$`;>F3IS8dZAtE9o+}GFFT1UeD8oT_< z>dTAB`@=n5m(N?UVE$$a5vHcjuBb21E*?<9&M-FC z+N3}zgji8iQ#A;wsH-YSOGr4ay>`uJ1(DAt z6(Q$nO5^WWvP~~8F1}ctpJ>CmU)6$pf6k80ildJmJE*vnk`Jppw}140vy%lyMdkR< zj&d01ftrd-Irn}J6>7@b40lgL!c$$w->>XkSVc%h>V8gu)l@f{Mv=>d7hF6de7~A9 zJv6td5D7WYG9QftH5LEM^>q#P_4Q@r@81^_Yc++9OP4M`Mg%x5 z-BwjYjjJoFX7&!wF-TrfdClc8Gw%Hwit@5stm5(X<*G~e$|^+U6FC-AnVEkP;g?^C zjt;d`;oXn%pz3n54g*|Q=;L(ch?Ds?WhDhUCH;`X@+wS5HD?U<^aRyb$to}&1CS8m zclJ`rIhK=)^C3GsAH-6Cu~nOFp(I4K()>ACggF}8SFhe4aK5M>{V%MlZ@?6dnM-|^$MIu~WitG%5o$!bSFz8ls;S23 zWmn*xHS-rNm^Ww9 z!W98g(Wkw3J32br83+ZG?{*C}1$lW{S(&*oZz;~3wtj;gimaIQ%yCD=teT=cDT<2X zk#K#P_zv!!)KN48vsu@o{2I>y(M~nTEfzO!J9YKwSPWuJ2A(80M}{`+XVAdKYCCxB z(E#s#>JWOw7*4ucLgW!`h&`eX3CFfWva33ran*v;&T4S#h(08G&>+!k7r5A4!->NV z5aPBMPI=fssE-pQG514Mum_w8ISK(Re+Uf;hTuRyhz<3Ir07txeVY^$0ZDODkd&AR z>0UaJ=eq+kee@vR*95Zt4In?*0^7G*P|DW9Hm)`lhgo1>z5!I8G=Urp}2l6BAA>*_=TsmnDr4f7J z(rJ6Bj@k`nQFc%re*jA2k3vC$7gQu1hN@&YNQn-H%!DvVPdp9vG1gEYw+H+G9iaY< zGt{Jcz=gDUC`k(>+qq?#C!sVu3F=diLPNScv|sRohD<+f`~togNQK_&^U&Q;3|&o?Fw~F(eGQkOuel6{+Oe(M zTmUb0;1~^T+hV~9-QC^L-Hz`9ux&fiQwIZmJuuSO1TPG>!gYK%FfxqeHLzWKr@so@ zwe|4g)eg9Oy$fEw(Fyl&67K~@;MH6GaQDTV*tW&@122!j+xLdx?fci^-3K?xF&VGi zzXz|qdKX@Q?Ew(&+sBVygU4^a4o}{B4aZizL%tt)^5MH=+m?7g@CC13`w97u;D>L& zfgGaH#O5v|DZO3unXs@U` zblX{0R##nDS6y3ET^Va35G;`vW134&OLI+G3*ojjDL5pUd2qk&e%p^OxMFPQ9(As?tgN)8w5;^pDY^k)3KqPPm$rF#7&$~|CWVBM zfo1Mnzf%lcbckui1oH#rV)U8DG>3%BvXYXECFe>?lFe21xEBQcL>F2*b__c^Lpuh; zkjA}-=5W3RgG)-qF)eXH)jkqW_8^=;pWtT4b!_Z#zI{~vd+LvAaZd|*Ys`plZ0~3% z{*C8dxE`Rttz5UYHcQmGcmy098#59*$h*3G+Iem(4N2G)1=9Z32E}|mI*uXLJVl|nvt4m{@8C-u& zjE#tN#F6exdqlW3Ha7IB>fl6U$7Od^JuWCrgGHS^=oBI0y< z1qrL6wK4w~KQ3dMuBO)BthyFLKRT;CbPTX4q;Z@hO(*iPLxsFnoe~)v<8CDsiv-u4 zOuf4%{MZQ(w-eUddIow#uC>Fp936IIaJybMp$m~@N_(qyc=YlEEp)~)gi3JQLC7?o`o&lX(5 z9@&(*+zM2j>bf>mfGRgVVTXik-6iwp60&CV){tt%*I8ZD*3s3`T3yqQTHIMzMrdAv zlgQ%SSW}%4mBXdg7!l~Uu8s&l9tc}^MUXA_+N@ilDTJ5LN@JXF?;;Dcj_T@Bx8$Mt z1V*|wrtrTyJ^$rq-x~7I`eF9 zZf-$#xV2EEj>CW&wiNs07B8O=H=&a15-v0~b@d3<=4Iym9*Hs&Zpn>E4WlCJKI+{6 zaR#2IElIh3{uvB(Ex&vm_nE<9fF+nA<9`5P9N5S=0?b6~ z4_CloYX#X?*w)erU2V#mU>N%hZw~jv3pZ}S z?cPdwX|MrazSaVFhCAWG3te#M#vr_S3;PUj_QA_9-GJ9`_re=Ej`+=2Zo$2KcgZot zZ#=jMZ@m6GJbw5xewXzMj)l1g@4fXZeEcq+!|$;^!m%(C{`d)wCw>pU{Ok#Q zi{oI(F)-hK4S)RcJ90enuRr5Bm|y-hItJ#iK=l)1VxOciD4`gb2?nq-%wXVu(n2@4 z7!&#woF8DaSS%*7^FKnHqRQy{SC-w{sv^Vym`~H@+z<|Jj%?lP`^K7M#H14t4N4RgP?(XX!=2TZ z)X>q>)iW`Z#y!K#II(x2zauX@ucA1Ql(W``X40n~I_ZB$nwo-ws)GE+4V%_)T5Twm z&*V*X!#(jB^u87ZkewYZy8_$uy3!#h-J9=o%j)Ru?Iru8yUGrjn3+u?;aggoduC>w z!|__Aq=#9VNCBNMW3aUF$L`X=Q-Q=kKyIy$c<5$4!IaAN#nOV+(B9b8*hp+eyEVmn zZ)t8|YiGCL4maEVhCKIlb5;w+JE1!R{cYZ+ybD|pxJNq8=OPZ=xlBmDhdK8?x&^Bh z9do43OP_n5>x_4#@6Ye*N9n_@)!UqV-qM^*xTEe5uhbFu0Q&xmyrkLY&*#5?1IAu& zUvFPuZ%0Mp5pe{V@nvo8zUJIGwlqH&8lE;P;Tc69;@s2sVb+KUh(DiuhPl>KIklts zv4>hfKww^(hbcE?f=9Zcb$nAx8}^~Kw6xWG8*%+-&`ox@SCdN_Hnz0&)p_g^bT?|F z8y<|vt*&k)|JiXzc=#EXn0|<)&yfZ(`02(8%{@p_cVAy$N4f)z&hwu^C(+I|%mA~02$R(~Tp))K}dZ+y8!P|N(Fl|*K?0`Ci z9MA&)1NsngP#I1iQia5$s$`#X_~D%paoiYUT@A?N{(bwv*47q|A7H>?dn-8N>$@84&L41abJyrN6&FVCw*IiC+j} z`9egn4@88ALVSEY;3vnB=Bf%A?iz63Lmj`z)P!7LEgYX}2p3qpAV1Iu@`CB)I91|1 z%z^-2DE{B}t~{#E>&o9IjT6VI6Fbl6t zY; zIJ8|8LR(QBbQDBTewo#IiBMmZ3XMhQp|&I&DoYEYyW%{^%TuAX@(SFo#yAyKSs<^; zg|3D|XsIcL-l~hxe=7re>vEv4@fr*@=R$vT0jOGwD8I{*mOLmgFQ?*DG}hNbYeNOJ z<6P9X)>cq-b)wH@3-q^Pe{xqNC|hs9cxM^TN3DiQML7)gcEM znUOY_8tH(!5uA&v?tn?`f1bbJjsBK>)O=L@g%2|mgP@rhgNKu&urS#Ra}Sh&Ed`vH z`T!nL^HO#2{h49-!JG;{n4iGDW%R9_zYp(Y|ML5bBu2#yeDr-SeDVRt8GHYI>|6c; z{P=?>I1lwB`0U5;!)HJJ5q$Q^PvF-dKY`z1tcuS*`xJitt6#!z(Z}+ie)$RZE&l?( z{QOt&)$hK*d8q$_u`0fTKa+W=fBGXe5A{F(o%XN%Z}hMH%U}M2CFGkc=xT2lI|JVY z2KXeA)NZ}0<#BnG(1-Ox@wtpxX+kVYLPA2Ulo_&4b@*Wk?O5&hkgccZUJhfuI3YPR z3k#2_zlF!zI_6q&_5nj^qh1yoC2PhBWJrhzGj#@(#l?m8pta)g7`Z)z zDDt-X_2cmQe0EUx0s+t{sRNC*(6}aj*ho#_ckdB^$Lq%7^H~f@babSsORtY^@v%W3 zHLM}O_{=MPIEl4o^f8sLjsb;!L`2!&nR;&ZJac0jF{>9;8d{%XFZ?;|>azdUS6|(? zZKvPrariXOh=$^JVdT#3+qa94zV7hGt~cH|$yz-QC#DfiW`1;XVF8(0SkR%2=P=kD z4wlz7lv7L>;w&g{qm!sXZivpU0fFd@mP6x==9B&f4-c0uTQQD|L*QC*xWN&1q)5#w zi5u{p+wQOLMhW1oo*3#%epqB$Csm|~(JU;?<@&RcmNjaF=?c9fzdJIComE68NBdI( zR>UB8uyp}1^wvNL&c5^|&IrD~o`>IDkr^zBCNWPsFQ(xEVTP6}cL#sA`Nvl0d=BK_g8PYUOcM?#rp~Ow(dM4vu9V|k*)Ua_sUoDU3^Bvul2U3A-FrKBuf#Jq zZrE_?;-WbYpC4L>6%PJk9k%%Rky4erQodW^n5B!)%)G1U>OeH$ZFDbcRU6&AS#tMDP$0h_fSf--NB9*u$ zIDG#dTeoiAa>&yQpEzD##SiXhS@1`I_+i1JF`;LpFi)@s=3VUhQ`LaRuzF6RgUU(^AB^;dMwgUDkgSp_dM3C_~2PwoW8^$Ekv#v z-Q3u2Ek?~I6h2*4W`RQ#=SlmF#eO;?lC%${QU-^Emm(gAozRC*H@(c) zzk^-Rr_b1^82IKmGd1-XHKDJsHrziT;3SG)fWNR>g@awQ6xMtl1B1P>ZJH}DqNtPN z2X}Xhl~fAG3p4X7uV!9NOHM7TR^U@$L^(@Tnr~n%O%O>G3fJL9s_Xux&2Krsb*O{7 zucq_Cqj@Zm8pWuV0-hbAa2~CM^X~R<6M25C&x!n!2NV;t3fj(fqjVEuaaJ)x#==H3 zPcN$vpUVmi!)JhhlxkL|XLNSJh(i}EO~J9FD2KP6T#`?8s*HPn@TD1juHchek261_ zp>d|NZ5J5h*NrFq;P`QUEj2qk*+J_wPt&rvxCR`C(?t@3qM#7B6Zw=Lk9A54`;k_a zvTA+&w{P0?!V52KdI7%m+;g4-gx1M{!n90E&VP5cI06nUfRa+8R^DuW(dL^xE?Pb% zTti}>mf1FOh*HaZV1L`r!2fFozPUZ8_LSQh_}eo;#_`y=wc}$4gpRZfp^`U!OvqKpsypK>l2)HcZ6WiH-PK26L{}B0o&IJME*_? zb=naEPaJ_TzeB)0}DhL862QDdGS~kj21NSpZy1W`Ps#l^)?9*g6A=wEVE<^^>Lu27NS1!aloUxKk|>Qnrw z*sGnX7<)C<2bxk&LRY#66^n+9@sYTzN*w2-$M`&qV|?Wo&p};UAdc^aLPa_U8nVNn z5&cUV^Dy50wHUaa!-AGP9Mdb5g1lG;WmgiQD*qx>=3jzah3U{xmIuu@GoYh13A!pS zL0k1T=&VD(k%l}NY$*nu>IFDg651Qfpsl$Ux?9QtT_B;Oy%l=y*1C~b_Qd`=-_+k>+!+khw#z&Fh=~71^5)>z&v^Kgj$p5ryu+S`gUOa zmyh0uUw-@{j=TLBe*W{H!{`6_F?{|TItI*_IPUhlfBr4}{&%0lAHJf;-v03WFERcL ziEH|2_!`&6A?x9gxTgPw>)?FT$KIZ0?Ga@cI|FtG{>~W?(qU}Lo}7v{pl&29F)2BT zyik&pqWSB`5_4j2V@xuGw7$n(KUS0=X@JDX(93WsSG*1|QKV295h-NHnPZKV^40^z z3BzI5gapZjA%jwQ94TK<8Y5XZF{UfVZ@4jRj#auIEMas9g)!8$AuJJEQ6wjFs8pUiTixqOvS59MXL@%*0ro5%4rLIUpW8G5Ffncewo;X*KtozH#fI;+}?SUxdtq;I6SG>3`^CNla2D-?bON+d-ikIfE8uL>L+@s$5fQ3 zLUSkwo3TRS8jH3tiJ%NODJT&At~OM(j>3a_QG8Vsp1h6|vW|Nm_t?KijVLNa9EvZM zJezjibA5U1)>pUgWv)Z52zK!K9>Ubv@UTibtW*}@dop04x1o^=V{WFK@rN_o)_z$;XTlQ5kK)gdlxjP(cMT z#~4m+O_vU_SI$6@0DCgo_(vTCLUS-q`T*eyi6Yxb$+WVB! zyb>02Pv3{4Ox4y|8nTjoi7m0ZEcHripmMQ|WMf-fwfyGF_7xd#o<>V7;o)OP-O%$z zFWEh%E7gADC{AK0`uwY?Fk5PMcWk5?ry{nCPwuT-)wigvzDK=c84@u=&)jG-N@qu` zg@K6$SWghL^s*urC!wz0^gO7)QW$2gS5%ZBnbgrnDPO6!;iUEBZPmoM@p$)SDBsc? zg;f1z!V0pyl^GvVVt$&r1$D#-ETOPvW1&~s0XBbGG)t`31anIzH|5CgkQquSedKlH zVpgKl0QwSmPh}4`>>=ZlkUckp?H98P_>9Jc!SiQNl^9 zMQJ2@MYz27$}6vIJ3*WePMu4QWNbtyutX@>po$PhunUP-7Fre&b=_eG zGbo5{yMDsrPmGXUH>Pf^>Ld;6&N62PlX=hug%Nb%LL(M^`5*ut>4jbSqf_0SRc;1>u5Yz&+>Oe2h;7PLAlBbNLO#)3oH?XnV<9+DqxDx7KqmQk;< zj>Hu>w@xr8ri)lCEsA>UG`1!#TkNfou%J6%sWeJX4vl3@BkHw^v>8y@uVH}A7dLHs zanlPgZGP!2DaOOYgEuatVH6b==clgtkTQVij}aVZ5R=IMZ99*=eFEL+P|i3y?RVNw zUM?I%p|bj(?SI9TL~!=(cy-4voV!Qn@9kp?BZOE+g%N9P;?Z{&qlpMO!tih*HmD=< zJ^kCZ6|lc+XTZ+D-w^}PvTxgtWoN+7z{VIL1eq)r!o$Pi zq9_33#Vj0e4uniu7-UG9kRNvzF3T8@niLI17eb*RO#(RI8`nZfhr*omfZc|G^XuS- z_yCkeAB57Fqfirj2&!do<60<3p)UR~RK$BhX~Id2ZRiEJ(BG7-_t|#o9Z+Cg!`{qy zC|^=C&ODss0b^9$LVCTE(hCfzN@GG*1_x@=nNWl4pHyUtp)@-NZe>S6?NtemH^)Nr z^;jsoioT-x$xvIA4rTcnxYkJyl;13b+R|L8uPlZ;rRmUBnE`FJ#c;1C3+^>wJVRXX zyr=Ox^febzW6t&Ubx>DR39WUd(9w+Rm*1@iTnP=ZArJRDTA{zS42I>EFe*feK>|;_oL=DRJ#`j5nwm8-fQo_N;q2 z1~`$B8gtfawJ1C z{Q1+LeE`4t>?iPxPk#oVeDVo=VH|&^V+wxtPk+L7%K!C` z@Sk7*8+`rs*VGvFU;p}7EDd%sXCU4#b_VPW*cq@hU}wOR0hs{Tz_b*x%<__r{3nz6 zT%p#^EHLb^U-6M_1kv)lvZxD6%H7ViQ>H{&UbCV9qEaXH{u_qFMCvoZrzwt$lZkEM zi#Mb(`LZk;dkshro!H~zm_c#rtaF)Tp#c-SZX&c6uMMpH^dK435 z6BGApGzMV(@fqO9OA`C_XyYx@R`?Se)E~1p&WNuaZ?V>YL-rFJ9W9YWOLz%=%j>^^ z{FMpF>RjGF?*#Pf@zpl?S-<^9qnjF$do^krUpszhh>ApN+I0u5+kVh)6a-hRksGXX zypZ&V`}yI^&yPWNr;e^0KVFZo8#m%lm-^8wbL@NxofyePirt6SU%wgfP5Nuc2L}ep zEA$|`z4OrxF+6(R)kB;C-=x1jn{~SDoM%w&8}K!)>baSjxw+}Nx!Gyl&(6$bK1=-Z zGHTWCY-&&MT%RSrrgYcyR>NtXYH#f@>vb7`C`j;!?_Pqrn3_|w{Hb8;rz zeZ;Xgu3Yj}d?SV)&eQJ&c#O9GCgNM>uC_mMwPq>fdnYEHPfEmjt9Zmia)QvhqT*G~ zSmP(J8sEF>0TopN<0?#(2n!E;60Pu&A1i!af5PhV8?_e7X_eM#w}Iam#Fwnje567v zeBBcKcwUv2{@UJS&TisW-9YATg|F?i<_Gbu@>e(Bs;T0}*fJOE_oUYNx;|@u;(3*t zIa;)HTJ7ANc1GQT_^Z-C&KiHI?MZnTaY;&)Qscg`dAf?TDtxJr6+gQECHzQSzVq^S z9OpKPzg%0zSp`3FaWUR?(=+6eM;?0k*wfnJKVHIq`vyHhhzejnI5a+|tKvVs{)~(9 z@;RN2b8pQ=vowF>jqMXNORic){V5fnZ)oowqL&oJP(o_;U~yYRkX89YlQ2Br&G1)K z|H}k~7%QohKb~aV83_-GJd`{uy zLC=hCy>ViRAu@G^XN#ZsDEC7sPA7}X%1X=2%SubjI;VBZ<4e5Hr{Q{lsTXsa$poxc zc}olZ!({4;P5tBJr8223R(S0`mT>YS_N<#tTTXxR`5x+b?AZ8}W(ptO)A!|F7#V1K zW-P-d|N1lu3#QD?Z7wZx8GgiRR=pF`&7md5moHz=I=0e-FVYf!Hu$))2Pi5oEK~k>nWZwF&G0S8pFazF#CS9AM~Jv{IY-Xcc6D}kb`2PQ z4o+9vwi^>RIpd~xQPuR&5dQQU8W<>UrL9hmyIbC^ zf3hO}DjrA9n>WAw^5$)uH*do|kq~_+fmYq3zmrZogqEup)A`J*^mp5h^F1lqv<+i% z`T8~Mp)B!@tqmHVM-Gz3a1T2lKH~ngC$vp) z@+Q`lQmVd`3UD6n>pO_-Bs&L3cM|rJlIR$$OgAFU;qFB literal 0 HcmV?d00001 diff --git a/installers/cygwin/editpath/EditPath.iss b/installers/cygwin/editpath/EditPath.iss new file mode 100644 index 00000000..b70d571d --- /dev/null +++ b/installers/cygwin/editpath/EditPath.iss @@ -0,0 +1,165 @@ +; Copyright (C) 2021-2023 by Bill Stewart (bstewart at iname.com) +; +; This program is free software; you can redistribute it and/or modify it under +; the terms of the GNU Lesser General Public License as published by the Free +; Software Foundation; either version 3 of the License, or (at your option) any +; later version. +; +; This program is distributed in the hope that it will be useful, but WITHOUT +; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more +; details. +; +; You should have received a copy of the GNU Lesser General Public License +; along with this program. If not, see https://www.gnu.org/licenses/. + +; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script +; demonstrating use of PathMgr.dll. +; +; This script uses PathMgr.dll in the following ways: +; * Copies PathMgr.dll to the target machine (required for uninstall) +; * Defines a task in [Tasks] that should modify the Path +; * Imports the AddDirToPath() DLL function at setup time +; * Imports the RemoveDirFromPath() DLL function at uninstall time +; * Stores task state as custom setting using RegisterPreviousData() +; * Retrieves task state custom setting during setup and uninstall initialize +; * At post install, adds app dir to Path if task selected +; * At uninstall, removes dir from Path if custom setting present +; * Unloads and deletes DLL and removes app dir at uninstall deinitialize + +#if Ver < EncodeVer(6,0,0,0) + #error This script requires Inno Setup 6 or later +#endif + +[Setup] +AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842} +AppName=EditPath +AppVersion=4.0.4.0 +UsePreviousAppDir=false +DefaultDirName={autopf}\EditPath +Uninstallable=true +OutputDir=. +OutputBaseFilename=EditPath_Setup +ArchitecturesInstallIn64BitMode=x64 +PrivilegesRequired=none +PrivilegesRequiredOverridesAllowed=dialog + +[Files] +; Install PathMgr.dll for use with both setup and uninstall; use +; uninsneveruninstall flag because DeinitializeSetup() will delete after +; unloading the DLL; install the 32-bit version of PathMgr.dll because both +; setup and uninstall executables are 32-bit +Source: "i386\PathMgr.dll"; DestDir: "{app}"; Flags: uninsneveruninstall + +; Other files to install on target system +Source: "i386\EditPath.exe"; DestDir: "{app}"; Check: not Is64BitInstallMode() +Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode() +Source: "EditPath.md"; DestDir: "{app}" + +[Tasks] +Name: modifypath; Description: "&Add to Path" + +[Code] +const + MODIFY_PATH_TASK_NAME = 'modifypath'; // Specify name of task + +var + PathIsModified: Boolean; // Cache task selection from previous installs + ApplicationUninstalled: Boolean; // Has application been uninstalled? + +// Import AddDirToPath() at setup time ('files:' prefix) +function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD; + external 'AddDirToPath@files:PathMgr.dll stdcall setuponly'; + +// Import RemoveDirFromPath() at uninstall time ('{app}\' prefix) +function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD; + external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly'; + +// Wrapper for AddDirToPath() DLL function +function AddDirToPath(const DirName: string): DWORD; +var + PathType, AddType: DWORD; +begin + // PathType = 0 - use system Path + // PathType = 1 - use user Path + // AddType = 0 - add to end of Path + // AddType = 1 - add to beginning of Path + if IsAdminInstallMode() then + PathType := 0 + else + PathType := 1; + AddType := 0; + result := DLLAddDirToPath(DirName, PathType, AddType); +end; + +// Wrapper for RemoveDirFromPath() DLL function +function RemoveDirFromPath(const DirName: string): DWORD; +var + PathType: DWORD; +begin + // PathType = 0 - use system Path + // PathType = 1 - use user Path + if IsAdminInstallMode() then + PathType := 0 + else + PathType := 1; + result := DLLRemoveDirFromPath(DirName, PathType); +end; + +procedure RegisterPreviousData(PreviousDataKey: Integer); +begin + // Store previous or current task selection as custom user setting + if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then + SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true'); +end; + +function InitializeSetup(): Boolean; +begin + result := true; + // Was task selected during a previous install? + PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true'; +end; + +function InitializeUninstall(): Boolean; +begin + result := true; + // Was task selected during a previous install? + PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true'; + ApplicationUninstalled := false; +end; + +procedure CurStepChanged(CurStep: TSetupStep); +begin + if CurStep = ssPostInstall then + begin + // Add app directory to Path at post-install step if task selected + if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then + AddDirToPath(ExpandConstant('{app}')); + end; +end; + +procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep); +begin + if CurUninstallStep = usUninstall then + begin + // Remove app directory from path during uninstall if task was selected; + // use variable because we can't use WizardIsTaskSelected() at uninstall + if PathIsModified then + RemoveDirFromPath(ExpandConstant('{app}')); + end + else if CurUninstallStep = usPostUninstall then + begin + ApplicationUninstalled := true; + end; +end; + +procedure DeinitializeUninstall(); +begin + if ApplicationUninstalled then + begin + // Unload and delete PathMgr.dll and remove app dir when uninstalling + UnloadDLL(ExpandConstant('{app}\PathMgr.dll')); + DeleteFile(ExpandConstant('{app}\PathMgr.dll')); + RemoveDir(ExpandConstant('{app}')); + end; +end; diff --git a/installers/cygwin/editpath/EditPath.md b/installers/cygwin/editpath/EditPath.md new file mode 100644 index 00000000..29a716c2 --- /dev/null +++ b/installers/cygwin/editpath/EditPath.md @@ -0,0 +1,118 @@ +# EditPath + +EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path. + +# Author + +Bill Stewart - bstewart at iname dot com + +# License + +EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details. + +# Download + +https://github.com/Bill-Stewart/PathMgr/releases/ + +# Background + +The system Path is found in the following location in the Windows registry: + +Root: `HKEY_LOCAL_MACHINE` +Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment` +Value name: `Path` + +The current user Path is found in the following location in the registry: + +Root: `HKEY_CURRENT_USER` +Subkey: `Environment` +Value name: `Path` + +In both cases, the `Path` value is (or should be) the registry type `REG_EXPAND_SZ`, which means that it is a string that can contain values surrounded by `%` characters that Windows will automatically expand to environment variable values. (For example, `%SystemRoot%` will be expanded to `C:\Windows` on most systems.) + +The `Path` value contains a `;`-delimited list of directory names that the system should search for executables, library files, scripts, etc. Windows appends the content of the current user Path to the system Path and expands the environment variable references. The resulting string is set as the `Path` environment variable for processes. + +EditPath provides a command-line interface for managing the `Path` value in the system location (in `HKEY_LOCAL_MACHINE`) and the current user location (in `HKEY_CURRENT_USER`). + +# Usage + +The following describes the command-line usage for the program. Parameters are case-sensitive. + +**EditPath** [_options_] _type_ _action_ + +You must specify only one of the following _type_ parameters: + +| _type_ | Abbreviation | Description +| ------- | ------------ | ----------- +| **--system** | **-s** | Specifies the system Path +| **--user** | **-u** | Specifies the user Path + +You must specify only one of the following _action_ parameters: + +| _action_ | Abbreviation | Description +| -------- | ------------ | ----------- +| **--list** | **-l** | Lists directories in Path +| **--test "**_dirname_**"** | **-t "**_dirname_**"** | Tests if directory exists in Path +| **--add "**_dirname_**"** | **-a "**_dirname_**"** | Adds directory to Path +| **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path + +The following parameters are optional: + +| _options_ | Abbreviation | Description +| --------- | ------------ | ----------- +| **--quiet** | **-q** | Suppresses result messages +| **--expand** | **-x** | Expands environment variables (**--list** only) +| **--beginning** | **-b** | Adds to beginning of Path (**--add** only) + +# Exit Codes + +The following table lists typical exit codes when not using **--test** (**-t**). + +| Exit Code | Description +| --------- | ----------- +| 0 | No errors +| 2 | The Path value is not present in the registry +| 3 | The specified directory does not exist in the Path +| 5 | Access is denied +| 87 | Incorrect parameter(s) +| 183 | The specified directory already exists in the Path + +The following table lists typical exit codes when using **--test** (**-t**). + +| Exit Code | Description +| --------- | ----------- +| 1 | The specified directory exists in the unexpanded Path +| 2 | The specified directory exists in the expanded Path +| 3 | The specified directory does not exist in the Path + +# Remarks + +* Anything on the command line after **--test**, **--add**, or **--remove** is considered to be the argument for the parameter. To avoid ambiguity, specify the _action_ parameter last on the command line. + +* Uexpanded vs. expanded refers to whether the environment variable references (i.e., names between `%` characters) are expanded after retrieving the Path value from the registry. For example, `%SystemRoot%` is unexpanded but `C:\Windows` is expanded. + +* The **--add** (**-a**) parameter checks whether the specified directory exists in both the unexpanded and expanded copies of the Path before adding the directory. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--add C:\TestApp` will return exit code 183 (i.e., the directory already exists in the Path) because `%TESTAPP%` expands to `C:\TestApp`. + +* The **--remove** (**-r**) parameter does not expand environment variable references. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--remove "C:\TestApp"` will return exit code 3 (i.e., the directory does not exist in the Path) because **--remove** does not expand `%TESTAPP%` to `C:\TestApp`. For the command to succeed, you would have to specify `--remove "%TESTAPP%"` instead. + +* The program will exit with error code 87 if a parameter (or an argument to a parameter) is missing or not valid, if mutually exclusive parameters are specified, etc. + +* The program will exit with error code 5 if the current user does not have permission to update the Path value in the registry (for example, if you try to update the system Path using a standard user account or an unelevated administrator account). + +# Examples + +1. `EditPath --expand --system --list` + + This command outputs the directories in the system Path, with environment variables expanded. You can also write this command as `EditPath -x -s -l`. + +2. `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"` + + Adds the specified directory name to the user Path. + +3. `EditPath -s -r "C:\Program Files\MyApp\bin"` + + Removes the specified directory from the system Path. + +4. `EditPath -s --test "C:\Program Files (x86)\MyApp\bin"` + + Returns an exit code of 3 if the specified directory is not in the system Path, 1 if the specified directory is in the unexpanded copy of the system Path, or 2 if the specified directory is in the expanded copy of the system Path. diff --git a/installers/cygwin/editpath/README.TXT b/installers/cygwin/editpath/README.TXT new file mode 100644 index 00000000..c922ee30 --- /dev/null +++ b/installers/cygwin/editpath/README.TXT @@ -0,0 +1,3 @@ +Editpath installed here is extracted from Release 1.04 from https://github.com/Bill-Stewart/PathMgr. + + diff --git a/installers/cygwin/editpath/i386/EditPath.exe b/installers/cygwin/editpath/i386/EditPath.exe new file mode 100644 index 0000000000000000000000000000000000000000..7e9f2837504767033a8d79a3426170aceffabc60 GIT binary patch literal 116224 zcmeFadwf*I*#~|$*(6I?I13~Yxke3@2xy|%5<_&kEXD}B5)x3PQj1$eD+s$lH3@-} zXokb;)?#a0`<4`~ecM{GQVf@BE;b87HGtJ{sRTrwuxJ;EVZq4$zR#R<_D0b6{rukF zf4{)lGnZ#(o_Xe(XP$ZHa%SG^laeJ#GUEw{C8+^#`m>AQZ~m!9bpKJ?`%7E;{PW5N z(~N&!IeXDV%d?j*Tk@l2KlpL>4}b9Jqf6Y`4?LK?%=2jWLyu-pyQ?(&$4eGIcwN7K z={b7VPKPATFr~#6)FH{qeND-O8+S-jSBfO%440&~On}(%v=OLXb0=wdn-D_yi@$6= z5FV-*{!Ahr{ZM-R=`YQbXOb3@%WjfRwQE8Dn_nmJ$?7G+&U}+Jmk_(m-*xT>SGf^K zbrcBg#5+<6Em5{4Ex2ys58OY1m*^nso{D!Po|r#7Latk;0WP=#5gmAj;%UVb^Jhmb zuX|wmatb1v5@~w-tET*>&YDeeR{F^X9LOs2CBOb>C%A{Sa*taO2wF<%cpujR^p{=W zw|v|G)45YYK!%@64YZQ%HDpV}k$f1plrC|K0?DTY~@n z1b=&i|44$rBf)$0Yd2CHV6a{1X!V6BGQC68!cA|Fi^uae{wFg5R0opPk^Jo8Z4M!M`BE zzc9hSD8c_of`4g(-<{xJmEf;P@K-1JYZCl*3I6p7eqVxrLxTVL1pf;O{*4L#7Zdz{ zNbvtT!M{1dza_!nkl^2$;BQRuzn$RUmEhl-;BQOtzn|c5Pw;mn_)jGGd4fNf;O|QC zhZ6kKjS2lZ!EZ_MTjTsKF|v`IiT;gkZFcE*WALNJl(A1#hgB`JRTt&$w@Z>-`+cNh z-Ac%`Y>vWB?*8<1CH>?DrnBw_8)C9^Z23*;c#uE+rp0`2I1_~{AMvuqa>8ynqo)ErbW`A$`{@xdJ_FfE!OZ|=>6e#64 zF3KKkm&z73*4w3p;k<<`yCJ8;F0opIs_#HathO!cd>_t+HUZEc4LuTdb`ZeaW0dSf zG?Yi3rwCxD00>4yyC`(waY`17hW13A&~L*Hrv!i*P8~A~h1x%+WY%b?jY2nz(2Qtk z7KLV?AlTv2(Cnx)hXB?KfHBd~aTMAmLW$&h!4oL7?i0#vVl;FTg<3zQPd4P8W`8%5|N(a@z7n$=0L?r7*L z3f&??D``0(TFZ@2;zoFrg0L4GA`(M!C8yilE@E3Le9~$PK zBDg>6{>=^5!oNlLH#7u=f2ZzmY8_n&H*@gIs0>i#ah+>rM<;&612ZFis_@W;mEXVOwhVlC>-9(E|dk@xo? zXty0f?fizv;Ql+@`HlA~Z(A2K8{_;pJ>l@Y*iKi!6J-U`eQcj{%w*cN?_}+M&)F7a zum7PxZr{~qm%O6Md1VnKKrQhEpOQ;mRO_F_FQw&kSS>kX;k}b2$uHn3KXl#ASHyQ+ zE#K{Xfd#J~CP^-TEise{sfe2>RckFV(+|A0#7NtZ5M;RqN$f=V6EA6y#7Yl%Yl)4v zcM;?`4U(9NAc>PSNMfW#UPtwIOAufw0?bhZ7ze}>3U#c1#Ov^FA5O8KL0r20jtvz1 zycYYyV_wI`?RgZtTZ?@WI6MBJ#r}Dj*Rgr~G>ZL`7Q2Pgipg%PW9M?OqjCFOiuG!- zZ&TV`TH3vCucK}IBNV$ti+!Kcin(H|4I)eH8`FFLb zE{Y0iQ9Y6>TF2#wUww`m$~(mj*vHY1hTjVRV)6^nR=X|YvP4`1BCbA>bQwr@Lrl7? zNX&4=WW~f}M^axY<#*?YTT>c`VZ8KtpCggt^$HoYfvVU1D@m$rnRKhXc9ltz#@#B{ zIO%uTF8o#y<+ia%Hzm)AU5{T z6#^^?0_+hax&Ql75ms8xTG$7yT?r*Eo2u|6P2ag<{1#y7zABK%g4<`DK|ULh59vAZ zHY^*8$yDtpkf~C%fIRLQYNmbg zWT|$)yKj9XLc;r5b0B5=+i4u?CF zl886tH&Q71CL##*!*Tr8hY;MN_RBzk7>}wRMLq?<9^=vPP(?l-?oLQMX$KWiT{MQu zber=J2l_*S6`m9kr4$VpzKPXE*}{>wjZy@X@^`aC^%Tdi{I#T&?JW!OuCKwOju4*# zR_**DK&y+cq;zu4N+esCnGer4Cw_p*^S{s&qCz(*MHDIl`_qenXRF#zKv6q1{umfP zQGn1OKY^<8C2)79B6FPywXi1@?;(S zmju39fR7_^xn>hQ4TJ{d(P6aoHapzNgQEG(&quMpyPjf5*T0Q4{B)t~2MQtA{3(PL zP}MTpzLy&D8RQih;nU*KgnFD4<2zrDIFg4tIjr?mKK~l}LLf6z!>8dTDu0SM>yA|{ z7NQdTJ+NF%-$Vh@_6}sOaoL&)n9hJdV}h=`NymYAWy3|fJ3k3mR6|)UHc(lJ4 zRC5jzWlPTAyfF7hbIx!6n>_M!jXFp;$Gh|@yX4)1{)~LO&s=Rs|FTPe#j_001U#SM z`7@pe@mz=JD4yTrxgXCMJO}Y?#B&dxtMDAa^D8{1c!uNoC!P&>X5tx)$B*Y}Jh$Po z;c3EChi5XLbUZuoti@A^$BaiUKEg_lsKp(uq(dz}!Aef3#hjIJwfGb(Ii(f{SxHbW z?qVffYH^5_gw*05R?^d=7XO=-{97$P#!8N<#hjft6f9`in?^5ebj7lA~(z$E@UIwfHku@|jv3U?l;y_&==V zKWgz=R&rJ?KF3PVsl{KhlCO*cwT9Dw(LT1EnD(g~ZI={0Gw}4s^FAUg@t%$+8PB`$ zuf*Gq=WDok;du=1oAI23yBW{Ja8JN<8t$EV9)$ZkJOQ}3;<+F0F?c?Kdo!MU;Jyma zQMmtzrxfntcn-q-A|ACko0Vj%#lu<2aJ4v#m1L>K8LT8jEw-@|n_6sTC04cA!b&V^ zv6+>aRSQc8bw;t0QEKrpRx(U29>Pk7sKtX=$sn~@W+k#(+?SQ~Rg2SDNt#-m%u13) zBGA?Z+M498mO9E}Br6%I77t}5L)GHJtYolSJdl+PREztwlKyIOIx9(6i&I%is#=`H zN|NL^EG|*<2v#yeExv-4T%i_cvXV@-cmOLIpceOICH>UmKCGmVTAad4Qq*Eoq%gfb zptQHL56`}M|M#^HR6fV+wuHSE>EU&$b!m6rb-U-B5hYTTvI9rQn0A@=Da~oh@lftQ z(>qG1?cBkmk6407E7F5_hwu(5O}47Q(ZX{F;h5Lyg1pf3FC_r)@O0(lwA_QHJxF_W zoCRSPB(fZxl#YPP&yQ9Nr3~hEz6+@m?fZnln)9@3QF*^|zF1zr1X>ypl9xz{7-gS3 zC@+~|>5!Mqws3jLeU_lSWT7P_ubz?KA+MgD&gIqjr3dBJ3klQgssr-sWO?O0!Zy2e z8&r%^w&z?k##YIliJ4K8tQ-rXs=G|@qjKz4Q>)3}#FNjp z%S+6yD8AK#;#+MfzBLQQw`R*r9%&sTFLAf#$xA9)C(5hMeqiLc03*K*82Ph+kw05r z{fK{zyxQ&0lUG;xCn}8=&nxmu)4`_Bq_Zzk$;s4SPzLZP=9<#93 zE{}Pn)hUm0w=R&!RJ1OYa~C$-<=jV_opP?bd4Zf;(Y#b?w5@uj^Ewj-LL2h6QNA|H z*LInFZIrK#^0iUEwr|Y$gDBpMM{0m^%zU_7)$jS zOZ6D5*W)+xUqS)bCFS%|uU^XOtzO?yj&f|Zdywf}(>q{&o4G$)ART?kb5`%zs5kwg z|5(s}?o-ZBlWo%KA+oL5CJ#uG2b9=|y}=Bf+d`sOXR>C|tIImr*j1wWiAhW~bXaUpr4+Z<}Tb3V9-H@+1Z_7mz^FMjYNL512NTke%20 z6Qqk2p`6cIIi#S?YqnISncnIA`?+w~eRb}x&e;H}8d}h{I^CV&H0>&Ao4YzSJUaV* z7(_?s;n&DOxiENj-#+`RQtK@C63>N}Im|C_ZDRW#YBb>wJytoMeD+Ul-`PLjFOrnc zaVi(g^4gtfi@JZxZ=7yAX6tkM515r!BV?jQu4%{HUJ^Lv-3o`K=HG-P z=RR2TX*K??yeQW~g_YE$=H4SoyEz9n`T+h`? zqggp=4je|c+?I(J_juGgr0fa@uAvz5|6D7XSUiL5=UOGWJn7_s%VV;SHRs$DH=L0D z81t1bRvBXRyO`g__ON~VjkUYo1K2w*)_%tIswZu7?mMgvvnELUuv!^X0T?kGE9VPV zj|TX#(sfxk5B1tj-dQG3^6j3}^45~DytO5F*Sr>zRZ zqQoTctRyP&Kk^$T7v(qNN-WiiR7Vw#^xUwogIzdx2!u0zVEQn(O%$vgCms=Hr$@@R z=YEj;p{Z>j7f85XmfyG&8Q*phburMO8i_xBzDM-)^q{nNiF|)9*tH^w?fRn z)c5R*MqM$AG@X5sNQpENQpV&LWb=_9S|x}K{j9P_OulL{d)D~WTb`^O@3}4ajC<6& z)af;iat&DoZoAlY@twNc!k&Pxeq%nNj#T_+uR;vW4k@kXbNjDsQ<}`9iI3U+J)ZP6 z=gAzi@`}K}lumOKw=BDQGX0Jaze6SmGHQ0aZE9*wqdUDW4KXOhb4IP~scs6_$*QMI ztqiI_)~E%h2S(Qv^B5F^+o!#FR4x|%dAF->a?&-pK#b%=0-Sp8|KG}3|Y#Wl?#KG6)Pu4 ztr(`9G`X)+PCBvvbn;4fj&kxl?orCgA+XDgk>6-r)2yHf7dt?97}t&mrNCf%rwBWY zYe%vaNQIxZ_+l(58wZf31+w5pI9x1CQ-VZIwVzVfQhV4vgui_{94=^I)}Mcc5vHJh zWr{l04C6s#Vge0*FyElT_v3psc(a<^8@Mj7LazF1@PmsvLWe*8^}!#9s*9@k*`Y03 z>wO4kjvo0hWuj{t_82}D1yDz!-7vzwBL9w+h1kp<%%?}gT!A@k%4X!Dd8H)x=+>0Y zpt7korIB9pm~)y-+DO5_qw>(djDkn$>CDK+C$i}oEp(gbQZ~Zt)0YR`qxj>fplcJM zZ=~(ZS3vvOM40>dFmQEs(IONfxd%7+FfH0dqh7;Ca?!{am}I0I+)$lsMCV;=M31O0 zqIyW~j0XF6jA-XIdUVusr?nT~5kKJb!|{H7e4xbzM;F_pR$An($wc3+X&^q#Q>rKA zwdNJCO_Wj#LDHrCNYv1MJXy`b5XyKW}jJ>Ds%x@PZfrZvZCd|Gpyejz|i zXZSgc`kgi8MT!to*ke)v#5=v0M9oOFj+(E_>oj?%>Ja=-2o4nX67j5nzbqp2yG)1p zqkzF$4%*V2VM5MzHqF-AOv94+gKX)Sw|hGpX*J&r=$07SKme>+jCL?f4hW=@J*Uy+ zS~F=1MAw%->g6CL1kYXw_1QT&Y(~yF6>m_6P0JaBCy#x~PJ3YtRhmrfLc>4z?%jLt zc+<&bcHrRy=`57nrZnc&nb=Vne*evO7j>nd((=|M%Z@&9Y5I^7 zz-0L>2C`%FI%Wqu)>&_8;%4P5)9Mp6C1U&Pn(GE=jq9CkdM%s(3j7|GZ^Tb8=14SQ z0!w`Wj+$v* zQJ;%adVT$VbibJOd+2vWY$$gm@VcVb=#HD>tlDrLIHn-`&4=mUjSN?9kAQ^OYbn!7%$!4q!g!n(tk^!_!wFykvl&-)vu$LoZAu0@M z1l%;N%OOf!D&&r%C!9HBAPmGSu>2Wah^1W#8oxw&ljsNfx3XO@OsBM_!dAI_5o$(`IuNoEd7nIkDuSWdnY`Wn@2OY^Ax1KKtX5u#8Z(3B2bO@`Db=@1 z9OMqy9fJ!YubEuiJHO_eQXmQ(A>H>Jd=T827$mE=_o!tdv_rBws|PZ& zjWiO^pxWJ4GQzkmtK9HMv$x zb_N0>Qb}_Tm=-g!sw>$UY9;;vnu|dSVO;312dxIvBM6NjX|@PIVLURs*t-gpU`c+O z7F!i?)h!~c&xo1QTkix@u(^k@ zK`qk2hc4CL<$@Sc)AXK?@s_m|-j`#pN+nVSlGs53$ba@9qzdsDNPwXCrKxGjpb|;y zA(Shd(i2ESdeJt#~FFhQX;8R*n>yn8-Zcg%C9g{U{Vu#4fRZtq7p2jBR z(3qpNm0@@Pt zYckzD(v!k=1^N;$1@El>+?U@Nm2g^n^&nd`6ZDt&pxCNOdi_~T!C86zLZU!-)q>h^ z)qOsq>mp1&SbJ`;AXI6kH}R++bx{A;#&=xP??u6OBO)cFY6d<2OOo z^sz&^7my!~8yMAk9ll5=rBJ76an;jUjP*XTpYNrhE{7xdV_;?$11fS1`E6@*)4akt14mBbs`Et!~ zi66Sf_>v^Lae-g1S%*OA4?=0k5YiBHQvTuoUgY6NF7}m+K^+N4&ViYr zkE`H}+x(g-kd(K(X16Dc@K9~a;}B0)&Fx~3cLjvo1%>heWMwZL1^V$U>g>&|vtci= z<=2ivJq+`QK0ocjw6?lvBPMi`dr0YG>~H!P^+~8Fo{4-Lh~&f0i1vLQUS}$eaW7{> z+E(^p!iVPF_c6<&R))%nP)Cm$+TN2$g0M@6C!yc67Nt;fUyV7YR$`yoN+ykX=ALkQLA_R3b#9M6IcT7!XhxqL$5hau# zD(ziES6Jm*n;2|v>Ru|=iuM!Due1R#HmU~>#wUCDy* zYL#}Dm-31OU^SFq#0Sz~*&Uc5hS?P868lbq@5dnvH90~jjVhR}@Ebcp@H9XyM!F~_ zBq%_M+QahGZy+g1?dcDoe_{5*QahhQkdBGxTID*k;E7eKYAW9{Qj!Y%D{MNKpn&}d zfqY6e2WC_MqYV5p?Son1jWJ$Gl7jXsGdmc7@h*ZcNuDOrj2HM?PW3~^+bFABsG#Ij zu{+Jc2r0pgb7^1<@}B`JDh7eK_QwMd1TiXfHSBk(!oH%-jFnKbJ585Gu6iGdBqOPK zQ-9hO00NQzbZA&?e=0>E>|rg`Rr*6As2l+r8j~_M*8;I0otj}nR*eFp6S5>@LMEz( zenj#~8!61XA*!^TERK_Xs?EEs%P&w;$l`cC_yk5qW7gGI8Dk=;wV@@D#wP;bx|W*5 z?sU*)7%&2?F$DvuFF)UtkubjcQT}AKZ}3rCb=wN|sv6{kNrRo%=a}J4C%8Y#RZ$XZ z{SEt#Xgm@Vy!TiLIc>q11Bn52#C!-UaMdIiY&FIVE~1w{@lTSit=jzUCVl?q36-)7 zanmO>y%2Jd{w>D84@FsI@rWr4GsdcE@bjfmL@tr#eMNZ*^Tk8u?7YZ9AM&*N8f8Xn zEA%ny&4OBXL_moc$J#L@Zb#FG`S{PMTd*Jm_*#fh48i@`c`*E7beW%i0=b*W!kTb^ z2pB15+F6&*wC_d7Mn7ri`>3D9&b0|IZG7uu7)_u-TQCbeH!a6PxOg(eu#%C(pNFp# z6K3L*bJ|?NGe|@t1%I4kWyJarWHB176>Ms_{RV8I&2ulp3jqgC^k#gIBKR*M+QE!h zvEaTA8cvgw(3wJ5?Pww`3-bT@6DZ*oAj{6|J5EWGZJ25b04S)BQ|vQ{6+p3F__}l!p9;oFqHzph5to^sE+0t%s(%I{`zBN5yk2*8e@Rd zrwB&JwSNls^`FW(HOBGdi59S;b))po|m%QhIh(9u=dhfFZ=p}l8zffY4-!Q5kL$~mU7WnJh# zFe%ON@|y2~1*96`v6an6Wn*a_l@DYe`hcA!Q`%byrI|Hp0i$T9me%zKylidP^Us6WQct^v)d-3z-FHE)Fm@jveyf(T?bHN3gFW(~O%SLE!kokQW9VVj4 zUxF7gU)Dq>rPBu?uX!mLfZq$;z}t+b{!o!HV>F&!jE-TjN~Gok{7w0&ssyh)I&2e!mR{1Z~Hp&>>MvYXI(SobgUtMIUiKKSUBC;0Sx8B}Avg>^s zoZH5IX@`lMFUGQT1geh?g%w+Z;lG&_6M1PCi?l4R`KB!HMHZNo4+8fHrTrvo!$;c? zNRwcG2dWyQd1{vJ2fL!;H%Q*$E3=u}IEOIR+*8;d=5~HLDziIj> zx}h*8tVNVhm}0QVB4)InOuiI7H#)Cai_LNvPj8W`?qb1S_4);X7kd45-rJJot#eG? zNj7D*m8Rv>&6w$_w^>!2I==@hRarX9gD4v@fXchzfGBV!{Y`71Z z>oqa8sWw)I9nNNT04qD8tU|5QvA2NqoFjoWzvBquFIHCMSIf9}3apUrt&R=^1(CJq z9z+R3cR`C&%i75ve;Nc8;;$WJq5Duce9mzMjgS3Xs^f&b)uvqN=T1>B*r4k=VA--@ zMMh0m%TDkHte_!pQ|I-RnaJ29qaY~lBOn(#eWHw@nnZ1>tt3-3<7Cl4fFz~VF<7Eu zfHe z2y^BuG;B@n>dbcU-J#q=sNK&2z`Bk4-RS*(xb|?xxHqY``c@lgmh23XPEXyYmL1{m zVazNzyZU32MWTAQKpJ%xK;4UA2BH)u$u*-9rc}0DD*7vxT*7*ggBLp5t1|hYK~llP zqD9}d5)TWeH_5d@(PVlRMMhQA3>?Q2wFhbl^?>+b02nIoHH${b-Q&FjG(5teP80c2 zd-m|hz%HF6O%sswR#2D*GZQdmot$ij@m_GsWIbza!=B%z4$6H8n@%VKR9ny<<%vQx zyu39@2@y|(Y@V^b=Q2y=(l>V>jIqQjUQm$w7sh95cl6)NQ>LovR10tiO#Ntwi3#n1 zNSv&5s%2b$^@C`0obr~Skx%gLkk4q853pA5=zw8xv<9M<1z8fDehE#1I%1^=%Z%PB zVTQV{(7X1f<2(8zIv`KMswQiex27~fRI^T=iQPMphrPnXHc0lm0pS}lKuck#MH?1a zcVb@$9wa{?KKeKbP>fj-OC!aikS44K^=G@b3#|Ku@6Kc0u@W<8B*a z={Q+f+YA`i{U&Dql79B@O~StOuOggA=L&RL*4kN*0Mc&^|4)TK13NK*UWv(@VNq_D z+yfyVNxe=|tvT}6+bI~Ey_CnT*esNWMOV4z9;B;lpJbBP-US!Xk?{<{GYZc&IQyqg zv69?;E-jER+^ev<22T!!ud)btmT-$aVQ<8mhQ`m(PlA`IzdC({K1BK+4k2uvf^iCC zlTGnwVC1`Ksu-1j*oSoy^)_=dCIUm$futIS_bGl$!AGka1T|M z>W*@~SX&nM9^jJ?n#8p|ijK4Q?P13l+5FmYV09XRnZGu?I<=b2)8o9$FX<<&U4GS1 zi_VyES@>CC)k{Ay`Xj)w72C)^iJt&s|Ev577?rJtOvgl>oDOmpvQ%iW zv7?6=e@bIUiTM4WbQsw^LVm-B%`7ya@QYYIA#DZJ8w4Q?nkJ5EsGmB*i6KTURKliZ z!}GiKePyjCWzt#6ogB_M%a)r9&aM31hp`5usW#TYA#As$T59mEcEV73*o>(gR6eDm z4LU8>SK$uNZnL6nr8nww0DS*=!Lye+P25}h zMl42%0aqM1el{_EN4hZ{!_iy%H~>B?F}*hb(`ROmHB3AfM-T26kUdn4nK%s zOway8b^b_?4`;RkK^jOJ3~hV?~1UHwhY#APU8_VVu%P z1E^I$LjT+p)Dh>?DJ?GsQifom@iQcbf6_PDaW4cN{}F^IX%5<0{t&PJ`w^zoB{P>sG(tI!^xo;vlhBW{n z-AFuI7A$D1Os&Qw(KB?-1>%y`15s9?gU9M zgy&wPOQL>@-vkQi@g5QX%%$;Y4AvIToDDj%WVBE?^FBDEQYD?*Um!opTs zh#ww@7SoTyEb0m~TZtVan3k|S(>nzRmcMKCG%B9Tqv0N+PyxFsRU)BIAU4Gs=mW)w zDH{N&RAKn+N5r#IRbc??R;qw#y7DK|$!OgSkv2Mx__IGFfbWMeOw<;%^3>%SYO>Nn zcb`33M`@L-F9yB~T}${1Q|y=+F7HPm!NQcK@T};IE#N`!1d3RgNM%#aY^0tvu>_oN z@lH8HQ!vPyed;|{^>!P(!{$>Sw-NdXv8lIP*&SBw>T!q zsVl4jn(yRegJC@NMSF`056sCpz=KPkg6zGq)*QA+`6^@CJ*3H6^VkQqk#2&L?dm+0*ooiYfw&7R8{B*Ka!A#WxSFw%SC>`^h zKoSd~)Js=q41Q3jTc~}~wH-{)Lp+I)pb1mFa*J}@>`qngu$Tksrl491e~{VY_`}Ag z*fjpoSO&erO6+7+%gw}5YY9iubftNRQE}wxxk9{ySo|yjy^}nB_)?JZb=Y*UKo}u7 z@hkTu0<%q}!{QmHCbN%nTLpSao_>P-6A_KgmYAOdQjX~uPg3Ym(Gy+Nm$un4K*eD$Rlm<#J$xrUYZ$l$s_;>p2(EO1!!?hnSrKk?k0IdZm6(q8x z()cDCE$J{o4b8o2c$=PasXVcu^*3!GG)SEEj}a$CQ>>Nws3);7=>gmNlp=Cz^yKfbK00G~?4FZlN6yWH^|8Bqy5q=#m9dP`2 zdXy)Rd>ahkRXD9BbVaMKE_A+(Dm3gN6h~o2Orr~kY1Et$6-1gIOC;FG4dN}MF(5)9 zIJ`a@xlpPJQo9XOtkAL|O@%uNeZ+H$48M+3%%;;wt~n&2Px*1Zm~eG9b(qN{j;*)_ zp%wi!p`c(^jB>WopoZiyeKA-_KhUxCv7@*Z3nNvBwU3|OVmhd$-nEQmkT+u_D>t)c z7WP5lL&AGzmzq(BAX>vjFqz$HWxb2hmWz;5Ee064)-;gI0{X~Lt`X%Th#HNq%Eq8V zBp@#wCgC7kc*rl(6A;P{%mA{e8Fd~)+nEEjftGKWNYg1A zC2*w(S?k=XxE$nen-2$j96<>5SQQC^1(KEQWf-J|RV+Foj8jH%lM&g>hChjQ=sY#K z3H#pP;vglJj?>fOJ<{Z;x zD-J|Wu@+7-uSiwlnQSH;6uZqN296l3omOA0=j$uiYtZS!;T2grSIf1Z0cnk6?uPt| zoj)d!gV!hHDzU@rlSFY+;=_S4th;cPW#urC2v@mS3h%Him$7?)mBl@HI~Lf49&NW` zK>?;LFwe^UsPJG&BibtWItDGGfVQjC=bcLD3zR2>UT_F?Q)k(j6MDfDLN7pwjg$eW z6^9|<5t@M*NyYA&a`aXVcuDNcnr5PrX^NFPlC`kdyrK^>1EYY(Xo^clRg6~<8y?G> zU|Pa=%|$D?Yb6dS4;oF19c$&gp(x>i)L`Y}iRBjW^kFoxw4x2`NustS3}TwTrb)eO zG@DwUfd+k+WICxT@U11c2CxJG2}2x_4#i@3S@ehIDo=_Vquefxtlj5 zh={xz#J5S6eKlTi;3$C)^XAX7r0omz!LS|TR}vRfe~JwDNNVsGjK>GWkdKWSpmX6= zGud+ZcuI3IFavoh3oKuw3f^_1$Lg|c09sTjApK_mR1(minfNwHRiSHGl?zr+D&I{w zAkW+e!j)Z&Gpifrw|JlE0e8_^9so&!TdBP--?d45@W|d$+JRI+I6~>Nf|Y{&Pt>X~ zyZ6E?lrgn$U?}9)>(q=`S7wT6TRKFt6iJmGSNuM|bg+bGI|woeXmXr)?|N8Xt7V2Rlwg51NjY%gF61>|0jlye>d zkv1&FUWhatJxd2({8gQ!BeAF)REm_bdJrT zWI&`9<*RnW2^}vcGlJLUZ)+eyD|!g1!f5laxl8`YEI$4zCaNP8AzSmiG~P z(DdiByn#L0bk?c0u*xjgt_39OaG#Lbry(EdAcCf9<6J!*Q(B(m{RK%J);<;jJ67)8 z9+5kNTM7u$2HB6TTl~N2L{SUyhpZMO|D|c8GK&z#0SL$~O{jx@5I!H`{P0Muj>t9D zC>z_&zl7dOJG=y4gqln{)%&8?4x^DKH84-?sjWf-*ED+WM2f3LTd(=b25LiUw|l2a zwt~=doT2j3^rN5!GgF+g7Y_ow#I*tW7u%5NufZK&iX46MCpwF*|%OBYtXe)c91227-)L~GT}$I;R0qSR5zyh z;E!h}1eCh`BI}qI{f6A0j?YbK$3{uZ5I3(Sg8piUPtV%G`lp~&1m!+D$}rywgq!)Z zr_uY1+^~K~?mpp6a-fc}vJ&VL|GVnR*5xYNgXSZ?b`|Y~>pyUPBTXWhRp}l3O5lSo zx0o8Zogcu9(ia9slHoyJX{ITV2|PgCOaF!=FM(vtme@J4&T(xO&ac!FO8AT9EkFGu zc(>C;1gYM_E?Cj_qw8r-z;3fDMdX0I)&f>pRAGD&QwE=F&3LVqquFiHN3&XVRP1r? zr?JEw_<$=7C1f1re}~bt1*5D|G)<`5so_j=@G$l$@jpVK$B;dK1;Y<)f#?UYDaRRx z8jX7{-iCu^@tby_Cb5>IIDoNPF$HWkl5P=6VMxtH7O`nJ8|wmF;7GVbLn$g2Rlxc> zIefe?3F)Gxf-O)la`5kAr7X6@*!-wQG?BC7a#YYcoJo%8o&XJwYX5qs5Fqj8mqVNbfN;W+MB#lZug2*Wo377_$$ zn%9MIqLhp6eDVu=P+tLl21~}QyWB`{7KnicrMv_wqjQ)@8AEv!AaG&^WwNA(ycOW9 zTY)XoM7crOQ>cks_}O1lX-4kXB58~iHzVkMKB3o6Muljdv`g12Vppe3d+(v z3iUNma9?92dkP>>@zb2V5;*x5OGdW2>h5@<`Ch+som+@P%|XnS?E{Du7p^V1L69@T?cpp^_rbTT)@ zcc4G|Q*8Tj5gGm(tf(u$jgE+9L2rQ-7B_!d^gZlkK*0>s$qtk@G=jd)yD{f=@`sG3 zq|;)<1tN6g2=0g1C!3LvJ0Nf34^aOTV9wf|ya;LI=A(#*Ilr8;6jXxW$>&78ls?f9 zT>#4?J+qwrF2G?pPve81hj_>BJh7BU;ad4l{vo3EDC9@GUoj_R-N<1?w4?|;f(J)} zMfpP_UaW5+uNVeHJn-SfV`8y|u2Q!_V2kAwv>6ERcXUzSSc3_yvd68#cpcoi*t}Q@ z-{d2)xbzn>`|+{zv3XqV%0~o0sy~&7V|mKOu%{od6I|Ph&szirl`obS!Pp>i#R$am zvXgyPiX%zrcIzBHP~lQb`P(QO)z1HJ z`DT2Az2fr>+6wqk*)wtMct3v{)zXTeCWa*qHx1w434FgDAMoSKIDYze|5FL@KZ^6C zJ;nJqe_dHm9UafG&<0b9zlQT(Xk=r{KeoE#ND>`hj_mMf&9l}yLYBrlM+i3`Lk$oba9x%wRVrl3-nJMxPAROM7Q%9C^WW%g1;fXU6j`7pNW3( z#sMdC*!OcG1+N@m4LsZf$J6A&J!JgXpsPD8@Ez<6gTf{SM*DCiDO=bZ0$2FnOhy{QfAQ@V^}AUyPN*(MAa3slOXu zA+P)?)x@*-^QYA4u7>QD*w0-DU&Cf{ttVFpxqRdbl4}FGB=qr3&y%Z-!ZwmCkHTIc zmz`WMl4}9E{y?s!!ukgn^$oZ6TNRI9v@PmRvi@eB=s}D@d*` za@i{23XvNwehrLl~mEzQoYOKYmtl z*P!iEw_QS$-T1R`c#{)Z#qT@C{c|=Hg8S!aHW<5dDjJm9H*z}L$v;A-@f>Byzqb?Q zjUoDQ%}Z5O^chD(e*X{16>&UXyYj%vYbfWq10uhJbi4G17Q)9kje%OtPecguxQq%t z8yMz_RH){~3_($X_mz z&)WEb@%i1wV$G|3Rw@4nV3A1XJvcJXUq+(NJ3)X#PfykD*wNuEPS&RUpvn2$jT zMVp~CEE_%kHM~{~9e+LcZ!8;v9qKFkk579K?!IuZOl94)-ie8<8MlS{zz2!LHQ^6@ zdT?iicYaUl-Qe014V8iXF_fr;evI#c4FNuo@kk##)KK&4=|ehWE>0pvZ!x-m4swC| zs)TSZnO~#f-j|PrgYO3K02gtNEk@H8+3ERd`WepK_ON%?&Bp=+*4<3_AV)cXRL3cp zW!GHT{GlXO=Ezk9>;8<5Eqz z=W1L#M)apJ+BQgGcHBy8guSkZHR6oWXzJ4Lv>l?{lpQo)qjE0oLoSc$1YBia6Q<1N z^VJUBT zVJ0<-TRSh!*P@l8Wr;Qi712Qn$TNihRRyojhq+n&G1hJ!3|R%;>8ls%~aMMHVrThfQ3_S z?vdZXi4RJ?xQz4?Nxndr$F#GE+Nfgec+pf=;uD#^e={(U^(J+Wz)ik4O*Xv8<88uw zbnMz#FMR(fN?_gS_oXv%qv2`37DzU1t^rd{9pj&xL*=h|LU5oby`fEnX9p%V1U1)X zYeIbH$pm$pF9>BmT~Cq2x-StvC<63?L31{^l-Iu)Av*RwQG5BZs00@9Do!vno0`>N zuO;+`*9XzWXl(JV!%QN@n7|F#JLp$t0ML| zkb#HBqZh^fkThX}Lj5pUl${o%97d0SVlebRF@t@&ts0q}eF@1+sAGvOlW;&aMCULl#QQYcdJtH|PHkR-U&vnKKf?^&r#`+} zwJyFE*g&2c3{yUy1V$AuL`(9Nux>P|*mn$DK)5s;aLM`zH@Hw6;reSMoI8~O#(*dF zmJmFy??4M&`Axj_BkE@cS+t2LVWY|G@j_frMw{UxHlDPaWEkoTog^F>3-`Cn>t&*T z*t4y77ab>;syNZmxLU*o&WPUS)R&Q7lyKk3>jX*_jBXz8jhOB}di9BSwRZkC`g;b^ z8j=_bwiBWGR~Uv2VgU1RO+P2nM(*2;{ujGRJif{O(nI*{$z?ghFZ~ERdqh*~I7C1# z_1b>)mIm669${ibKhw_VVEcdtTY{h|(H2J=_7fZk+#>b~imB89;KB~k% z#oRMwT>d8paoo!&KfMcJpwWDcDEe(BF?Z;m!{%Is#@<(g#IC~UNi5?2VYpQvxnYJw zCS(2}hNZ~77qdhCN>D2D9hiy(_pu8w&Zme=3J?f&;&lWA&;JYh#}0%QU{%c?rim=Q zJ#K>Fm`@?vd`7fKYeIW0csjm4h#5PP8RzEVNhIx+U(dQIcn54voQZVblAe;E@02&&ZoL4S;;z1oq;O=m&iW z!}0%2(s;0^D&~R-7TS)aVO|Se4!6nZ_hs|xsD5m#8Kr6R40qMk?fI5gAo8xM61oe< z#VVnc#2ubW92YV0-FewOg#f!A2g0iQdgs8X!Jj*i_Mu_IR_L@;q>52Q`0*()TOB@M zHQi>?#tX<_x?5)tYD$N8_%O1Gjl!mQO?SR+%$keZ#OeXU_zR(}r{lg4_mzQC@Q0>J z-|Ech=)M?i)9&OMilXri5q{tz~hQHe6a$iEJ~9Y z|Nqtx`(PtYl#TCGL{C;|_^475wg)xJYs2u57tWgZ;Z%5*b~aSuOSEe~sh8ILQbfVA zRClbU^=pcH@<}7=$A-hLIov-&y!&R6{vji-S~z~>E>w7t_BE98k3)dVYgg(JPg28Z z=Y|_d7-MfrLms*Yy=ewb?|1Y!t*wy%2K}9{zo9=0xG}oFUH2c<--q1F zmOheB!T!hrGkrWuAes%2-Y3$a6`AF}eb))H$4 z--3@06~PDBo%$4k6X7S<9wlskBd{4E&JdQGnvN$mY=r#ba}UwP8!o^3dEgRvt&E|+ zL7}3>Y3!6-)l)GAZ(ObAor8lGA=0&+;vQ;ePbA9}WJy5Ip4>AC6uEoNo3YJq2iAVT zqux@jb-m^W-hL24x{ig<`_(p9j4DhaBrAugnS>Xv%46-C;dusDwgSnm$;Jc|{6|yF zPN6c=KB7`v{eofGy46-h%c@la)J*a=kOx<@w+50`Y;2o~4Kx(&ebz~f52yJjSe-E4 zL_s2TYc+*SYl-RtXe;tUGtPjch>j zGfTh@2}Td#t7y4aWnYrhYUC8nC^pZCopk$xpM&?E+4?(YyX_a`9}`U$+xx|QQyZsf z{Ah3z@YLZLP9~hzrlkTOvh7J8>*8)ca}~N5d6gnE@JSwd@t1re1(Fx-hU2$-co)y6 zaPlJDxHPKvC6FLy+>JjI{3r+#6B&0Tm){*98FyS-tHY~b#3ipz(+}g-z@b5S<00Zs zL~9Ta1EP}zatt1E8L9oK{@ZEb7VB9taB(Q9{fH#mB>&TMafrngtM(%jX>f1G!^PD< zHou?8!^IIXHb44)O#B)W$z!aqkn&cByVh}aPMO76kj3#Iy2H>vXEDyCVoiv@^%J1& zq2sZKaHA>IAew*U=GJQ|MJb(`NPbgbTLjyNqjBkx-^pNe-|8z*$P#V?cyDO5w**K z9^RwcW>L*_xZe{T1-krGx;E3^drez4v>;J6@q_x6;zqjzFqyu?um2;+-_BRPiqy%l zI?-j3xc?Am$aIgBT)Lj`4cyF>(VL;Xr3R+mn!*I{x5D+~b};O--^K}Zk_a6bW@ z?|(#}|6mp%XrbME3DRW8c;kulGc*C{{*Cnc?f)Xb(%$ncMa#f$ZgLN%pAq=+WOM%t zZ9YtQzwgoAxQ~Uu<<@4;F`L5CvFfWK>D7stJyhi9A2#lVXfbKw6P^#yxd3bxFE{fq zaLb_5YN5T&Ulbf&eF!?<(qGbAI|j9erN5@Nc5(&DWg(aS1-Pstmf&bw*bpR_lU!}T zf@?OpvMI$}a``C50=TgD2W&Udjmp>vT#eUeGaNoRI=|L##CC1k2p>%oA`GoMv+=z* zXxJ)FE@kG?Mo0UYO;ke-2K;G!N^DGh5O7K;Y59PLJdAy!>+yL%#ekgdPg#nkefmS) zBVz&0lVikZoEYObbb>jecAz*}$TQ<3;{+-XVdr5?$~fuG564HwiERERB3XAh^AXe& z`x-$EzT>et5vt2CY!2hce9%!-@@UleI=U8O#SVYWvZ({&9P4o6vwE8-tSrCLwZ3hW z4@ArVJe;`@na}4fr1(XKZ2}X2TK*?WTOFsU8``{OL9Dqx2_&4{hhJRJS+f(6`MX~? ziEC?g{#rM!U(m&xU2BfZQe7DrtB-YMCu;V~HDv&=KAG*#s6J_P%hf0I+#{<``rP9? z7a#(%mm^Ucr0#`Oai93zK0VAzVYnU&cZ?VL;t!#$a#Tu73iZ3&FQsejp% zDQ}(K@3elmUX~{nh?@c<2z_yfO&-1#f^S%0iMfw*UY6I-#vs1VaVpY{QC~6DHAq4F zxCZVT^`$D$lYyp&a zLk?NQyfwndf4&V1Y+B6n?-h=q3@WepsWl@1LJepcJ^)hHh%hP)_bS$i9GLl6P~ma^ z((iGk;KiKx5f|4#wELG1i0=jBm`xGQeLO?eWlk0*>5;i{JB%&mjYRB4t~8}K@i-_IRQT2POMWqhN6E%HcW3VfjSqb zEH*8g>YU!e&pjF$NMbL`iMw!3&7$K)4Ky3$-`j~kIzFb$#6y-^a2oK547#ClY6jo_ zCd!SRg8}~Z8M87gj)E&4scyMJ+6WyI2im4s!n3TtxW+|U8h_LJJ*)zB8DdAOT&rTx zfp^VBnxA_{st%i4P0h!@fVmQLE*w?uffv(d18@WZUQ=Dvh`uDbM{1u&L>@LpBuq9E zOhf|g-$mxo#IbMI$%mm6iL!`N+U+iCnGGR4pU6sgNLQxv(NALxgIdDcnl6mWZ^O(0 zY7HSwJ8$(BYNaSheIH*VEyHp#ZYUuywgCI+Y7NhI;%0ks4Tz`@aizHKBT_s45|9vY zfK3dc-kEe~_*bYhb{Yi6isG_pOEHz3q3!rp?b*1-LxcP``jJy3kF znJ(|dd3A|PFedlj-dnWIw4`o0de%(TNKcj!zk}KtrcH|AuZp^FF$gZqLFrbXYK_NK+r$Jw#Xd2l*%nq%W=PBz*w9~!u4Ww41M=iF5kCC20^#QTJrgh&b<~UuNu+jPx z?H>kH(4O;3tJoplgFP_H@l^VH9SAP^RfhVc=v2QvFFI8UPRR}Sg;!c}0rCYvak|gV zw*wsp>r|13*YoFF1QmNkThrckH1`0g%b0`GRW|g;P6}MJRLepphC+3b#k&Aspe3Xu zEQI{%`!k;`Mx(UAaRiR!xs%kX3$!7D;u|(YU2*ce5vA)E9veVkgI^UY2=-*v3snT) zB832;TA8@mj~Bc6-Dn(q(a+2@Jwav0v`QSnH=UWmWj7r_X_F0wDMbx*a0L6e?tTZd z_yz3j;@4ou62EF4eqO=SArF0tpOzqgE}p{A6$c4#JMLE;&mqI;g zaF#+_TZ*!b0aCALEd6K`)`O3rE<{$M7j_tnommSINa=mNy zz|)3KOZo-&Td3mG#aMIHu5HE1k%|J0Yov{vXjyUE88fcHX|V+|bp6UZmA)VG#d<)r z*fa=BVb(H^qdj|RKsS^E{%d3sX)Rj6&@0kcVDt(yz`@+p^ofxD{4Iw4ypbx}Iw641C>lT83L5c8)H*-0k)Qz)(GqO{~{O=&~yt&o9u(VsshTaSuN@iD2rUrol9v16Cr zF>b8;nsG^gf`qAPk&$#%06fZ~ODIxYt$MBoJ-s!*! zF5UE1B;H;8CcK3ZMt?-Dw}34jM_{Fx*|yGMsdK!q5Bd6c{-P&boPV;%oeME&^9e&o zC?eX>UPZ?dPV0q&)P*TQgjT|UN-ZjaRP$OoD{>m6JI-Z0dO+KkM0!CsxppGRfV&lm za&qmjQ6<6jg@WL28T*frp*u}{Z!_>6Jx+vOA+i^Z8tA9n`Lza%MdemaK4el7)r^^p zgiXPD5If8F$H(AyG(H1JLT}LRGx(5*`xUJa!7sGW5xHExj&wh%QOBmbIFh&*V0_$O z4bw3H9;5(9`@0k!S<3s8>Yl-f8^{uZpinTcr*E{nzWN~W5KOGO2(1|0Dz1)6=uQ`& zO$5{GXb*SZ+DFX8W8iyhugQdf-d6O17r-H{$8l&4s0L&?)e6mkgTOCl3= z@lzL&QCXMZBmP_Ds?z{Tq|TR-MDR8-2K5b`!pCd?#h$8OWg1WV-l^(|<2~t$=y4{% z(uEr}P;USgMMZx4F)auxvPcLPREYH!i&TiU9{fPen(wL^# zH&J9+j|kjc#7hud=Xe{tw{dTLq>x4v!cabKzLvK--X1G3!k33K33mYUzoL=-j=jhk zMBjp^5zkJ^g=?Q^=}#Y5RAd^`%FoAWg*rIYLE_sQv*-|>UMGBld;l^rvH5#lC~YTg zSQ~oIv6n=IK^$Vga8bYTAzBBVo0UAnm>~-OG zQLNpJU$jx9wN542DBi|Qt%=gnCHwfSQ4b#rDc<=J(&-hIYmNZ{#0bXtA@2+AEWXwc z5&9ec8#UT!)adtAi!}&B;kb*3Xmd5u=23#$Y(P~L)I0>C-ftsYeiz&UH~&L>ViBoS zL_Q^s5Oyjh9*H2JwoWTTI*OpaBFHH96-pTTLu{$(l<*S-q0~F6)Pr!7UQW%5KlH3y zJ7)@p7lfmI^6w%%w)bCuX-Az(OAJOw?Z)t-H;T9s+F+U=@Vy@<*6mutr;Jc+GYIn| zLTd_wqU1Y4P}dXG|HIyQz*TW={Vt7Z#zb#o?#)e;7}KLM8k1;Df(1)#C}2gT9f}@$ zQ>ju^M6macfCUSRARs7G6crT3f`Soij@T6`itzqx&&)Xo)Z8TZ-tT?y_gr)K*)x0g zs=Lf?v!_&v)q`Wbiy$Zx29s%8;asN&z7G)5H0b+oqI&6e6?^GQs=4C?-`CRWTV+(p z#lrK|mV5Rg7ets9Vy!sV@8^rnmjA&b7{4^bu*LMIqR#0IbmUD0bC^-_)wY73s3<(Y zl=BIHLV|0HLA7hxtTTEysZT|gB2D`lqRt4zf@)m`E5;oqgIQ=co@{KPmsrux=qaRD zD7vFouGbhKNGVn#|FlHFwzeX>Rd9Bz=M`)Bbq4BtedWg9=yMlXkR z1)7JFEE#WL)B5RyQsgQe63M0a2a$sQugi3G2|BydD6ifVdyJ-Z^HM80Z-{0XdR`3+ zZUU=Wf_aJ5PZiB?u;h6NnlUIv*l`mVpq&VSS_XVG9_L8^8Ad75g-BXaTG~Jzktd)J zDwDh!LgZqhAHG&1S4e!PYgWssJ4kzc$N_mR$ggRAHw;7|pk?x)yvR{a7zJYiWlBAs z-7<0)=MJ;7$R17Q=o=A$-EO(K26S&!rAdz!{??23xiWgHwk+ywbX5(WdL_DL=ok(V zjcTRg!_6C~dq{DmR2u~GygvByGxas4Y1bT~*Is-q6=096yoZe`c{;F-y15U|0~{i zPV#Bc{^s|u(X0{Q*T(ml!2oZQmnAoBYmdkGHu+2QwVJ+Qz+a8leVq!K7T>XJw03~` z?R!2G3ED*Jw{U>i5qd4R7DX=s?SHB5^&uqEADH2|00;)D&^Y}_WA!(&;~PE)(zFTQ zFnR$#DmlF2mx2V*n4qZ6s8IA`4ENqz;JGu!Ae?QLT9sPi0J+XkLY% zMm2_LN8Q$RT*ZOcHPxt8MP~)_Nc|NaFUI#b2JwI=ODT6y#{*IRHc&kf)gFs+NykGVqL5yP+dF0j*nhX?N^Vy}i~i#0sn zf@WA->5>^4W0;KJOES_#ylTwDAhV=)Io>hM(@*R?^sSU_JN3GHth1EADm1yMW7&im z@MU{m*OaZ`K#gX-xLK=N4PUXVKo6x;W8Mw{fZS@Bsx!4% zy$rOUg^FIU>=}VLSB;PpW=9T!O{-BV*YZRK-sD2D;ufz+gLBv)OG<-(a$InZG}CCh zvSIPfClI`eoPc3*m`t+y%I0kI>kVzr-`wfGTi6`!UX0&hfV^1(Q@Ztvpu`$^O4dh% z|C01Yov-V!#z0E!dya8p!FSGUTE5=k3#LrNR|&nXv1}wwtEWlxlOzq#M>UXVoKBug zFN)kC$%Ar*&3eUrnIsQnWZ3f@{;nZo>%M5-qETKD<>|I2cN$ywx+X*TSWhPWTFqwo z4U$|cPi1m?^O7wX=M-W!EK7RnyzB9F9)Tu1`a`em7U}$vl+M-CC~`c~S!@jR>h7J8 zUOY4K>iJ4Y9X^~=iBNp=We}`efyLty4~68&7hJTYe6b$|gK1#Su&!y#upD5> zY4jeOT*@2ArlVS}Yl`hq%xYQnEL>lmf~XiZ?14NGZgdIxpMY(pWXQWRTbwCRc*gpZ?QJ&Ilh-kZ}=-d{z(Ow0A-eLOn30NjB8g!GfXPg;xJ z5fSH~Xb{NtBFbf}jE3nY7i01LO}V1Nkkm+FPrMI+Vu4zbSp_2#=*Lp3v-YAo z>kabqL*!U|yN>aDBDPd}Neh9zv~)g|>1c3U%33>MSdhYVryT0x5usP-RX1rF#VSF( zNV77{%cx4YK?z}ZbKJ2S44b@wZ*wBeP=m1&`%ox9%MKq~8fjE&EZh51DwvYyhuLU+ z@FPx-f&3w}UVB8Pnv7@^vLE%TCZbsib6kY-4~|UvUCDf{`DW`B6gI5l)O-gqQ1Nwr z7?>9^_L5GTkZVm)SAQyz-SM%O?j@i?S*bYAKy3)jE02|6=9^Ct&*RI z)taPWx!g$krIg!SWz*4vXP-U}X6 z9)5T=(G&9$7cf%KPjU@^+W?I!u}1{#mx}fzjjz|fyE6>u+C_guHRF*rj5WRSkEK&B z=QrB(L*jpl=T-P+OMIk6*%B6$9nDZ?xhlckR;Xa2s=x@JoW-ZxqPRtj7%#~&q*;+u z4FkUb8c@Y|;q9=t5e(ka!@+HAJIcdonCZcMQ;W#n1M2K>@|I?}1F}Q*RX5O6#xW5& zvh`cI`%OD#3 zT4v8&QG@W#qf85rC@9uCAQ<#S+P&LoHbo@pm}D-}PW?g3A(SGb-RQb>FXxN?BW1A24Y zJ#qk)sFh}_p2Hn(<)H1;gcs@ef)Kg^>n6qAeAtWHQHq_5+Ta>mYLFO_S?D(qziVCK zEb!E?dzRNVd=m`zmY-MEnpShz=oOk`Kgsxo@P*MKzXFo|rTy~c_E8O@HS9OS^alGH znm(Mj8_@(HdGO?CC5yS*?Eq;crIbD%is(#UQUf{gY#xmGz!SDg(J+P|%)+0aZ;1$L z)g1CU;#@=DlDF6}$9LBGh9Leo+?WjufzAs|$EzCI@P!EPT0A=OLKu3I-%346(U0JM zB;KW1EEj0B;qc6@j%d9Y6jBAfp=e2S8|*lEp{|!BqEg`%Rktx_-n1KG4ue~&GR6^q zk>=2yTfY^WJ-F6?yav`aObqBP*;m@%jOP!l!}B12A0YD6a6I~{+7}nGcE&`b9w22P z?>^zhN6WCL?=HA&`YgtJH#`>`#~lj!k!8ZE`HOwm}Ph&gr9yYc)^bF43~xvQ6U=Uc#P@~*;dpq}xF z`jcSW0#d)syEsk9yIUhPZ5b8c7HQBNM*9op4o|2S8az?>M7wj4zJ9X3c|97eUF<7a zTi@22d%u7@N~(7ceM6sJC>gpz)I3B*8>NM8;;tY!Te9(PL~m&0h?l0E=czc)SEm@% zqqQ}qIbUUqU{p<>EfI`df?!;sEbCH6Uw+;A!r=&iY)4uBPf(FRiM14ZqfGD$a@(8WYmdlV~U{d(46iW^(0qk*ewIT=OyC)|m2 z#n$|hXr}ptB3e@6ck$*@6HBfP(CpKoQq&}lgDHV^NppG<&X9#KX~r>s^cTgLk7g*Y zus<}fmEyK;g@%~FoIjLtL@7Ti{XM)_D%lU;dR6Q<8s^v8Pfwv*&8q$&$eXlw)wX}I zEp}65E~0x_?Gd7dt7r2H%>aSJ;<(`q@3>0&RgnjY#Y;v>@%jAUfyQ)P3k_*C9F-YT zCi?)(Hj;1fCVUZwwd?Xd>6&9HV2Be#x_tt^K@TNR>!VvGpjDiqbh2LdaaD+OV~ilW z!rlG=;cX4YG7neG()?9u1wHhE_gY48fq2Eb>2nYfn`^KigjbZ<=Vk8f^ICZJ`L$&f zIO1KL1)l5|%6^&b-&VqrsvNIO_HQdbwz=kYa{p;SH|XC2*6n{1P)jv{PU!D7fPXf) z66xO{vMY^_{^w+=DZOvxEzRn+=x$mkC!0R|a<*P74Ow zv&T+iFgMcxP{117T>n1H(=3#D%9^2-WJ9w#aSonj4*4&HK3k| zt;S(MCcsdU4`{o~xYp#+D2(|U0K*xvoDjPM*?_APc<9U89T%pMz!CTyoB!=VRfWR< zS1!2nlsR#T73kT*muRU(d>`ORI`)8!CNzWwk{PHP!5@XVgArmtBk=SXhNB0rO%dLq zfgE4p$_&)3U=I~_L;S}rIEK0lyLp123*_*ipJ*&%b_e%Ku%`;wd}RgclsG?uu97YT zaXt!|UWny{f3_Iw$e1>uX(z1Alvz{O+yG}xjnmH+XYO!pOSZl{!q`%5)5bC=R%$E@ zr?LldnZ7mt)xh>aiZrwZr^yiTaFDq?t~I9vrx8o(s@2sB^g1An^IStoIaL)58=SEW z?ZrP^kyFo+yb;z=jt?P6L)#jFjsa588VB?D1|H`#DLwdJZ-jclVw|&elIhamYtU@} zUq2q_=Yh19N(iSGmqND5lMfTU9N{SRF_2S(bBjJ5rF84~eI@J1xl76;5|8#G*Zp~Z zIy#T@YA@2KVQzmihkq~4di{^2*&oRjIy?U$%cMp=lgjbaH0QMDI`hfLKpCHN1J~G` ztGV`Y5jj|@-?$EyN)?w$oeYXyxHgbvXe-lD>fE+kuI)k7fS!EcRK{l+xE6X`60ZGK zG*M61r^)oaY!@p?!u9l%IZC!@kFxu;7(E33ldQtBuzmC`qO-}5GJm$C6Jl|#@-!ap zVdJOW8>WZv;fjM(&O_8*YSg`cd>f}^wG?G38@RI$RdM=j*wrzzW5R|hbL8Z~soHck)OCj7*; z2L)#w{BJL0Y7csiWm2wnr9jH@Pof~T6O12j{lVHRwa=Hp=4**FUvV8Kg*7aVTw^jQ^7O_z^OM>Fwy+Y% z=h{Q3wN5fl1$*Qb&I?k?*vXuv7R!@bO57?jMJ#TGc*A!T)VVEXjdP~PZIDUyWdpgm zE^FL6Q+Pbyvf^CVu+?LLyufW8&bfcgx((Yud}Ru$Tp=B|n)oRq)xu1XEylLuJnJLc zYMg$~2<5x{+*VRnKb55X;fWmDt%0sQqNel?27?B3a>v1Gs9(;w{nQC}xffw7xa#U* z1K5_O^a8HZmRICa%C(YaESoM(IlZ}Lu&vyou`X|Xi}TKn`01w!*D;(^8b3SvDParg zCHp8+=$>Ix&qODIQhvZrn=f1Ayo=1c2kdPlsIk4JehOQkOEOEKkM|BPzNhbG%>IbO zX~ou*p6yS{q1-O#T05QV!8+so3~C@Nb-#{}cRwk2hEXnuxypb2ziI<-8+Z zzl<|$mA#|0v!k;;&Xw?HICD^`T}6-_m&4SK9-jJP&*Q?)%TXl-N;F?Un7hi!#aqQO zbzvTpJUmrSx-h2ascJ}%!@N9H?i@=WS2fYq%Gp*I#&w5PH){vAn|n78&u(55ajn>x zM=}0P3E-OA3}u095U#hl52{8=O7)fl$_V#*r6&vLH>oAiu-@c0;4t7xZ4fR6Ttjef zXjnf>WsX}FT%MKsk|i)fZ2dm@pOZw{vr45S*|2Io>~k=mzEm+kTV z_@9%H)8@ZdhqIiYqI@-M3vroKcs{P%f36;vxOZ+)r*eJsXLq)!vf!Qn}-? zy03oLl?{FZ|5C;puf>!~6iY)PfT5kM+GY8zZnyy7QD#UIoT~ zTbTB8adJW(Gtkjl)LZQkM**&t91vCUTgca~W&d3fu?%z=x|%vTdKg$cI$OC;c2B-dq{ycF1Dyk1sAAcWv{}>uCpNG>h5Ci zZslZvdey_gMr{ROR9>$Q^K$ldbW$0p+}$w_OwSvDDAaz=fd7dmsN9`ZYH3i|MCEDf z;I6W=?XB{#ad&iOi8xNvSDTX&qw@uz$x9{<(5k<)Ck0{1I*`LYh2>su-ox3$(L~6{ zVTNpYz+11HIXklG@~x3_`0YZzugk;jG4Rv8n}Lg9Y|xfoYij@-TRB-f+IzWpc~A@8 zJ&sE6v^B7GQF%Cj;%NXAx%e1ZIU88H+j}{wAQ|9gZG56P4ct|DhPlH!4Pw0oTe~AU z?42DaBYhO!g8tv1e2-dpGjLR^RrXeDC4T$%2H^LBmfw?j8Ay>3@6{JghiHwfKg!<( zH;rZE;M75$KTzuZCymMTn5qdze@#%@jPO)2$7s8k+$Q8+OfNjs*yk3v8nL+N%yINX z%|*EMq>}m*gG38QdIq{9z7c3V-ggCS?emyR+tXqx@^i`3wU%_atTvB(De?HZZw8JN z;CLL_Sv=j8UV|A43<@sO;+jbR+MFZkq^}
N0ib%Ha58wh6#XA9>EHx+I)u zn-SN&T%0{z)T%*f(s25isyz@m+)C}mmpC10<>9GqFrih|;Ch&qqle09qK!)11TdQD z=&5^12!2-Xo?fo}5a}UN)N8jYAztq8Xy?dy{cYuVQmE976M-yGuLf}ua~K+VGUgz3 z;@x><4Dq0lms-^aE!DwRPAX=k3zZBY!bZ3|dWu*wB}U-5z0@uqDy^ZQH{URJadh^S z`uYQ1tkCkdc1M$W1jh$Q7NUo(Et+NG`Pj!@rIKUdejgWiCo9iExMyXr5*WSEI+a-S zC2J<7#1Jn}S1-?A#xm6*MuW8HvYP!=R$`ok{T^s6+8`>QGe^ck8Y;nj4&jyblz2)O z<(QmWx~qXMHdbmarnr(xny6JOW@+N(;i_`B)uIejd7y==y(CkWyA!$*p1PnBR*s&~ z-2|NpwQ7jpyHu%L^beh6~U1pRByNcz`$<;Q5EC=W(r#LURq+tJ;{nY%qw!_|XtqRMc!a+mvD zA~xp&xj5iHtRrO!k!iUQpy?`dvP5K{iaUP@V=<&4>3W#zu~>2$?dc*kFTpp2|1$iM@OibFD}3%tPKVDU zFstFi(}O1TG6(zwvcmhj?*5jJcr+-(ju%^Ka?d#UMYtwM_132T!P`e1%oH1mG zS&M7VKr#&6)QEmwBl_5Ossa7Gjp$R;hV)zDTA%)#O=+~k4F38?*UkRklr(y2^eN)> zgPRT4gkMkv80zVVK)xYhe9va&HS|@ob#6hEJ^x8PhyF}z|4*pR*S)Dt=l=B04;EyA za|4{W{T^!$zZ*&)b~B;Rel(?zejZJK|G}C*?lp$m!?o#YM<4W5(dPqgsa+pO`h0*3 zbsLQ9p*GaXbRroIG$Nzk{it8x0W@Gle;Q`dn??*DP9wdHXxxMmG~RMB`A!&2s)_x` z%4Q_l`wS;cx!J@tDUH)Al3 zTWn5t(+85r>>*@5eJH{)X0^bK{1y%)=QZZ!9&Jv(YsZl91`D!TWJLkN{uH3stmZ zkrO3ExzUED-juq`hr;75DQtr^MMk^O{AfE`wpvAVV;pGtS_hi3(Ua!IdQfPhA1zM; zoi)z1F3y{hG z-4@VjuX$wbv6yTog_DP082S4L;e0kZ2QDJ(fFQ!WjvYHFeOn^!+?hr@QqpMGu3fZ0bsFWS&ZmQW zVkm!CG9ArGr>N{{v^aYPtvIxhV)sT-+`f6VD{n3BDO^u^nKNl$?h-n-Zy9Cf$IzMl zINFQw(?{be`#=We7pKzclgU(eWDAuYPo{OrIh3*|mohUlDJv_B^7duXp+i}8AU6;G zAv&IuL&bUf>FD9Zbo#&nI(amgP84TR$=NI_K2|_S3Xf7zQ4y7%ETmtHi>RcegwB`l zql>3bQ5mk!pFK^b7Y@*`SB_HIg?zer@f6%eD!+Jvu3fuEcW&RJd-v{9b!8>hR9DiY zM~`@}R;mF0-}`U<=9}Ca_;(?!^_#6)VdI&96I!=^`IY7`{@ZlkY5nqRFE(%f#=j}e zJD~H@i!Z*S_q6&;6yNy=#Ch?hm-L>3e}#@D&MR;Hn`EX=W$V23+P@-`_%9%WtphT@ z8x4A<-T~aW4!A1+u3o>Y`$e)iAanf&$GdZ*Aut*sQP4p#d-$-Xs;auG5!|f0xh;yt zd9D4;8ip!97;b9e+O?b4v~(Umtg5=Jy@@;gVB0c+DoM__#@bvHm3^xIo4j&1Km^roe-(DXwA{TT@_w32gf@~zo*or)N z>Mu@Itz+1@X8ecmcKEzwhc<0K9p#s|VCKxX{_*yx{eq6Lvz%rUnVYg|NH5tw7riZ5 zF`Kp@EYHX+%}6aTEl>aM-5rUUbKiQq_lOZApjS=Jg9kMaf|0u)Bii(QL zinG_w&bhgHfJCRN>VZ}sVQHDGS0aIb9tSBq**muB);aa_* zn4+1I{E})qI^+5+|88r+(IZEXY9uOx(AjHkdJP{wV)(xDs;bh=(mk1bDVWKeuM#J?rRuM@!!4sch22x(|`Ez+-p@; zdovmK?qTIJkp5aSC?8rnj?32`Idb^OamHpMe4J!L_s(XtH5m*#H4sM#q~s!Pk!8K) ze0U+{^TU86Oyu;bQ=oEEBfNX}bIT3-n=u{MOHh(?Bb!=Dd?g?5PW|j~_Tj@&<`&2> ziBl&5IJ@^-dFTE@o-)8$1%zHYN{U`-iH3)>vX9)lb(*CSz^a`*b?Tm`G@+MHFG(Uf z6UkK&^tvI}s~L;k(3CpH!ZZL#q}h?#c2MqhtzHjn9zLjfD9UU3*>cE-s!40-((jng z@mr_#2^|+CZzYz3j$&sa4@j|%s?L^Xl@RJv!yzsk1^u3k#1OKMqo$1R4^>u+FBhU z2(;?pp#ujF>@P#|E9rGPqn&$b=;>pHhYv$81||UokDn?^H11=Qi|Y9y=s+e(F*fvg z|22nJ?}uJBT037Z|G+vV^z`ZC;$x>F%kksv1f1HCVepF$((B5Y zd8(9jzj)F32bWML130ZE0!pX8OZ(VHmIrp$*$8^YA3PL)D4MHWMX!rNXFsqCDVFFk zEiI`H%RB#KW3%rX{!Rt zkMRiLd|3O44XtNs?K*uA^+JBbX-^AJT+)~j^yStb-16d%87{gm>%prbrbtz6X3&Ov2KpLa404$cbA z%5wkcUE}4SS(uOIpP(b;5yHsj%q}2s)08Q8LLTLLYNZZvQah`+nV* ziHVNm#(@NWDi!O+8VNw62@BZ;1_cEMHqh&`TJ2;FiJYC?w(j1!XZOy8C3XQmle8e| zRZ=EtR$5ZZwss2&+O%m?Amn+V)k|&V+BvB5a7*v-O%b~Wo2z;4RFG5ob@IkB>LYqt#1N?$JZFYfw-?klod) zhc!w)e^G5E1Je>P4*x#m#`*B!!}6SEwIt2XmT>8Cb$5>m3UVvgr(^YVa7b`WNK6dw z;195g4++-$}c%Xp%taid&f*p$918x5K*~$t(D=SMJR%4;#I4fw! z2ZKfK-5R!!oL=ylklNKH*u}-U91ni2oqzuMC(ECH{s~mZTH*j$jU9*oabpFc-0Fu9 z`Qas0fe8YnU3qBaE7YZYUG41ZR;{;XDW z3qsNB^3Oj3@MkF~jkUC7D(oboavnY8ZC02R(_^TuZPN7nZr?xGv+9A)J`x?K1yT&% z$5@VmMB*4X#v&I)ST9Alv&cq*PP6A;z(YtYPqkiqUbN$-)_v~2oO3z3xyN(wNE!)& z@Fy}PlTxZjMK5%CI8|A80n)j0B?mGA95S$_h2x^HPe+OUM8B5#2tta9K;toa*!nt9 zILbcr<6>FQNya5ifRIJp;>MmVkLc(<>F>T?Aol}rO7133a9qEM>+2l;ujuHJkx#ED zB_$^EFNuGNiOI={$%%<_ettaqQ$ubfiCd{RKhwQP=f;kjn(CVBwCWv6N!1xO)jMjEaCLnL+VfEKkAoa}N2;(A zhynN?be_Tghy}Fe65JY}*R?^29A4W}cV4Y`ep~On>?!A&dUS$*mgoe@+VOPJvvU%2 zrO)i}ztaxLu@WG!DyK@h5ZAvG&hvPNa6xd&JYIvHS@h=dzU%b`bsx}`ejL?_JchnT zBPYB8V+!&zmw@? z`etMRbsZf*14i}7hjIImVLwyqJ;^`-tcMv(0nGWPC8qdj|( z>EzyI;crCtw*6>=cOUZc>_?V1rsVH4g8B|qQUBo+sK2>8^|F{mqf{PbYp)`|Ne(pG z#g)8$JTb@jPYQE?pMoqq(3FXN#T;MstS&y>bYA4KD34> zXyQ^cnt-`Hj~H_bh#5ov>&KFR5a#NF0!bZ@T{tj@=eFIB0ycZn^r-`A$<#p2hAHOoOlZmcQM6`?G>4Zs1Lv5>3&A|zl;}|uj`_m5(=91#g*`1^YE2=t z-DzEfEhWIMTVzKGvoVhs=}DUxdQsA%$rK)=re)D83d3C8sx4j=vfYoC?wCYztDPuj zy$9`F?M|zA2GZ{206MV2i4G!8UgBgrw!@b?3=gKxBZ8>Ys4(hg9!y=#!>Nb$RO;&( zNxw{pq_NJyG{9*N4fR+=qb4pTPycB&+HW=41g@qrK@l{0`eL#OiXoejSaO)Uj$CJK zpny4XP?`}DL38Iu(2N;#Xx5y$G;`i^nm2C&EnYZ> zmM@({t5&Y0^-IEO$Fg8ry=oOLNDreW(Q|3TrVvV9A53d@hSARCa9X=&Ip*nB(ayL9 zl#)J|qL!?qjVssC^wnu%K5tXpYT6LLjyCXI-iD20E-zurW=h$2S(g%1YQu*%_PZQ2GWswr3sX?AS(! zQg%{7Y6=ym@1n@Pp|oP}LW?K{4WN{hD9rM&g@+tJN*_2dq^eI|wOlx0v{N`aX7JDjzb4jx{yRJ(!$S<-{ObfFr-cN+``73EB4>nzzW>HQ|0@5;$dJ&WH~z-8@n3>D zVZp)wc>S-Vv+}L~GI~S=(BJ-jbkTNBN)i(vjs9lO2?>7x?T?noQJ&zzCTZwAKdh*@ zbL%lknlshFpv}kYIKq>lx|-YTY1l8nuCBJWQi6MxI0Rf>Fyn*w+kCu63|&awvq~wJ z5~CtT!GBZ>r0e&j**E!rdql|l?|r-EUL_Bna34?5&?j+U=3jO0+_@u?!?62-eTNSm zIdU#BDy&VL?|v+2d>wkNj4z~=@bA~3Q`y?u4gn1Qr9;c-o_nt4SA7Nym^H1ukdFALJR14UzT6s+YTAn@s;L3ELpyM$q!ANJom-)Hvf3%3lp;=;GdC^u}k{x zVjW~lRo+wN2ma(un>@b!a81U|o40S@zL}Bw!%yp0fB%V>nOS)Q{&F{0rl8pGoNBDC zZU5#=j+C7MU}XPH+11pHj1T*mnVFrtSIO!#$QFeBvI-Tl{TRQ0^L4jRY&&uM#CgEU zGiQFySlP7CAc0?d6$;2I=%+!Y9{>K$lghTC{yPKg6Qw6l{t5!0wCrnQD)Fz=3ZQiA zSp}W`V_Pf(`nGLnN=l1QoH4LlWxKv;Kfv_Jz1rHkM-qMm9f1E(D}T?=%C_Zf z&OB3c22gyW7*+s*VXyQZ%=}LY`GpD?6cj253uyHp(;_uJbDM8*X(`5VizNal4jsDs z#aDyD|Iwqm$0QJWK;eI*(>K4yZ_D&8DLH)xquTmB)C@wvdcPOc4U*=y2U>USVl+$0a-;L%=5;A>#Ph)iXG(f0OeCAC4 z{#`Bm$npyf$5uk9M|xA)4GE0-@{xpL{!r3(yabGL5jXM3(fN8(ZkFhs>GKezIqgx3@n2Ikol3p34iIT}!U~_8Swqa^<3bLPjT^Lx=u# zoZP1}L@5LTdr!~f-s|09Kdt?(C#gsFT$Uc|9G82M1=yQ8DScfh9+wsRLv}tS6&`Ke zcD!g?(Wa}{D;4}3c!zhA^~mng8L`eTE)yoX#-(R;7wBWh>f~1v(cW|7W=~Iheg2j% zY8MwD3%f4S>$Yx9+nTtxd#4ejMlt`fus`HK1r<06PN5uF_;>=}?dmNZe@hJc$>O94UGNwHX3Ki$H;N!<19v6k3=dU9l&2? ze+gL-0RDvC<6SH&D{Hm&Z*Kr-81W>+I7{iaU)lWPfc!?| z$H!TYx2vsv)Bs5s6rRYw zPJVt@|32KQzEgd_`hG=qbwx!r{;R92svlNAtg5~*+wb?$b$62z(~=T*CZ)mQ3?M&0 zbuoVbZ0CJ6VeY5lzdG%H()Ig)7C%XlPpbz0uIlSa)e`;_dIf(x2voWm=3oDF=brcCmLG`>eOavRW!CXM(znK?G2v97Ji#qAC9p7cKT?$eQan{^?R5naiD zbUW&8)0Kvg|A{O;f2OvE7W7@evGl`03u@Qfiax=69v}5r)Azqv(vQZr)P3l9`s5ck zYCpt{zBKltFNgVJjM$xiGIOI&!~LnRSzj_9)t7pkn3CxjV;YU|;ZdW<&_GA*WNr5g z4Z*nZNQ~o-bi@ums$Xb=j}iHJVN6&xj$GA4$x0J4iTA%~@-$ZMe)`NxeRmv}3hxXyvR5*;aE z3&x+P^`|8v11NIdV44*&0%OB?zhfER?^q~}4aZFzMbQ`+PMJH7LU>#_#DNygRMFHW z4j31|LOWVN*PnJS#dz>qM_RVV4)1h$(h7|AF2Q>n>o69)c7r>m zMf=n49f5Rkg9{ys_oV&XCsHBa?dULk3UxG_Lf?!IqplbS{$>oufvrMmkYgD2u$fLq z4j2y}A4Owar_(R$Ib`g%kj4beCzpxAWFNScM)Vqe(S& zJ-OnY4!2p`$!lIRg@uLCjG0qu+RT|0fwAC4OCo9R{JFGn*?d~EcrLBNnD3_L(`mDBw0qAy3Z4@~;j4DglGPh9_8Uv< zv`2CIK&9St7OFV7ezL}D@MN?XG93}7AMCpkbpH15+-swo&v0c2&kr^FE$2QNT zT#PZFOrK5#o90no(n2cQF`sg_$I_uav6QuA10BHoAekxaalM|3(&8vDIf?eBC1N}{ z3GZp7QbAfO#)WrKA>IWk+r5TnW`)u0OpIUi*l%Fm@^1^IO5AjXG}XH&_E94b9=gfKXR@!_L%wix5YrKMDUCX>oA zK766Hm~LI(Pq!~*(q(y!`1+MA;{6Zw)OqenRBHb#|7Hbz`&Z?f65{)Qm%oM_I%V>t zzyGxtE@p=M`n}y+|CPEwEJD;wU%z+%8Y)EvPM-MYTYs39e#B`ZlPA9Yx_(Hb^Nmk~ zrBTy;C%*kg*QeZPGMjlY>FyI?LzM5N_ul&HwmjI>(7U@);66a}9%H}CpdN=r9ibhx#5?ufx&`AvrF@OQ2YHF&Sh_jiCP7J_2nxq^?1 zJNVtXqs2Xt1CSf4+qcJW+rE8!()@7Wcfa{~Cl44hvIIKDm5R&2^C-zTp% zeeJc+`VIai%>V5+9}F&dD4{-vt-~EHkcYHv+U}!)og}nYYG}*~SI9Eg9T*L0)pp~} z;-grKiSeJarOCg|eQhXk(Zj?Tfl!&3&dQuCDs;B89BtXE-N7?)Kt1#8ufLutI#!zU z-D|%LH7TgolUcTx;H)R}XtTBli{s*sp1_de84x&@dp6;N&jz#149r<@Wpqxc3I(?= zfAr`U8*}60)}FwiEW@$l;@n${oAw*VGV6`0>NqR7^#vmab}NnB1yml-M9m4Ui}zjo z`m@2nRjizx49=3t*j(E59oS;i?p<+fi%%DyJi&v(Cyt#smYcu$lfebtn-{?5(o1D6 z-veK^ON`s)ar`vc0$BhUAN+LC0hSq{wY8E~I^5=8#qQeWakAv}$&-S!Px(p zR&J8Z;DP2{m-%?4UpOa5Ur(RpL14!HV!#0@jaX`tK`P22!j<3dJk;@R(RH zsr=3(oxTpkhxc5XYPb7R4G+>n>Qg>h8{4B~f^P%l2^hn4nE+fJUk6u<;T@K2aU7p< z0f^^MrKct>Zjbr^xccKMb&n>vMGM^82U+4ZOb3($vk$foxOz}2Jaj!9Bdu%Q@i2-6fj@l$ZYGZ9mcx? zx8jk`R$|0=EY^}UjKL7314c3dV}L7!Rur~y1u$PNZnn`_b8`t_MhCuxTUS?pMRTP* zrCjq{IoS7sW^UHk_4yi&b;nLifHm%G)~xYZvv%#8wH|Arb}3s)*ophNVk?`%T!n zcc0#U`i#8uuuhksC0zXX5-@7`@KHSKJz~^Zi7B&W>Fb_gu#< z^n1N=fuNOHi>~GS6kK_DQQQ^g1}6U)WWG|v>2~Fl8&Z6?suC~B2zc5cg?pbGB^9QOSSsw#aZ@syF@x$DFN*zWuI*qu}OT+sx0S$D5j)Hf`iL2R8EY zR1mm~{|x?+1?2pATi>5mUoWmPF35hJ?DIGwU-LMj@Y_iK?VsTXN!(nY`N9zYbvqy( z7(_b#p3mcg9pNnDlyO1g4UZJi8yEb%r#XGqZydETw4x7tTGOX}?dX&K&h*6qHFf$0 z`?m}lPhEz(PXr||AS{^Wl z*7)?JxBz2{^0B08h(9A>0?onN&yWCLniuFwmcgURf37(#3mZh!=MSM3(~M~$)_C$B zE30OWq|lYaY06yer-F5wtEUX2wIL?79%FQ?XPD7C?7Ol)Y$U}^A4MA@EGRs9JjS!s zG%whm<^(y>yeRCQvfP^H%u`eN6i*5X@~64M9<(&njn-hSE;@1oZ4bAh&9hasd4VHs zT&||rC{K!=??VX-11M=lAT3>OODkf=(=v?REl3Lx`>w>UbED`@p0ql_n-0t#K_{2n zQRY$~+Pli1j>kGt{#N)~Ceyxc0d#R^0JS#_qRyj2soU5P>Sc>Hop#}3O{eMj5E|8l5Ja{COUWGTJOiiBB9HLZ6dD{%(?h1vv}w~R zB0Pdt&ce9doS8H;YCbKPH=huT^qx86$6uo8@ zZCJC6w#2Wb?XgQ}L()oG6qiDAYuBR6j;G|<7}~vg6K%!VTw?Ni+Pq~uZBI<3-6=b; z-%1MBY^G6ud=zDG51~VeA(WFGK{>l3=+N#NbQEDlsTjLUpFvr>=F`dDv*}dQGCH?= z8SUM+jtbJZP!4GAOUD=;#^#RgNfP_C%*+nM*x5YFIIxs<xLN+lSlJCnD9au3JQp@JCNm%W+tb2d?K{w6w@zmZM?|5!mR#@yD@ z@xvRaq#zz^J>%#QT+Xq0I(Tdo6=B@(OyOqA%}Jnw>@>vOA15|M?SBwYVDmy@T&*#y(vNFPA48luDbnEtQv1YWYx|-0z5VZj652ZGEqOYFt zr?xgxt6RSK;u8ryF;J~`uy6Lq_mJZAJNzmU} z?eNOW|NOGiJ;w6YzUitvIqdJ+@|EVk@rQLmeC8{~7b6MM9}jq8iPQ~m#}>^e*67{f z)5h^@YpSbmRaMv2+;W@HqPZtd8i0O$p1J*PVTiAn@05j$etX;H)tBF|uBjD=7Dq3B z`z>4Mh53HzA2K_{|Lu3${5|OT);At-bl%!QdM&@EMlb%BZ@+rCRbbTi9ava&WO|#B z+3(G*uC2v_&?^4P2>S8A``gK=`;L262vkztOWrU3Myu93_vwd$pVB1u|LM#+O7e6F&`O2O7`MKF5env*# z!NMh8w?xj+j+8#A)y4M@U%oQ-M1FoY1ES|0Dm>O!#8-0AsI6PK>f(o(scdr210g@> zP` z#eWp`kzL7ou}JO$52TzpzrnA8x{u6(pcjARXBNeGZ(q0!6pnwcG;mtgBYpZ~%*X1- z-(u2k+~xb11;T~%7tVyfv8h@sJD-dOf*$=XLk4|nc@dj_+`n+){^huUo?mZ4d_DPx z0zrw71zB4R4F~leV72b-rAwvDO#Ag6K7!-x!4M!ks*vgjj{n0?KmItdSMS~fe)+72 z5pR;yi2h*Xp`-QVfAYzXpZxgakKMa>@6zS_@4IyA(}@0HAn3>c_~Va1`S8Q8T|0FG zO83s+cWz7{2#w-@{PBl?t{ppe>eS zXU^|k>YifH&Yofcw1Mz?yLdmZO!hNnAIoP%c!=zy8!W$bidIVy(|hJWW(U|4puF$+ zuYK;PvNMKL`l*JzVXp#u{nSsf=H!e1j?{6mGkrP81M5rt>FZ%$^z$e$8asXrxlJBL zL(E;s#N3X0jP<2qHr{062shrBRQ5Jx?}V>3x=tWV2REAF;z1a6CSM;f@|)~SE7aX+ zg-+^XQUNvfJ>aAqO}XGDH?l&#xI;e z8&*2et~ujrZMZwFjhalcvjb^4_WoQE1A3cXXz2zuE!yHn5y_r3Gi4&p-R42dc3>?@ zjEm@p7GO|8$N2_o$w3;T~DIDyA zJwRP}KhVWw?7omj`K};)uTZk`jwCnVFtYSpOre3nh(*?t)G^a4wxlqRZ%amKUbe< z&a7-YxIc&T^KvOazkrVC?n56po6a20p;P;@Kk1P?I(_H>l^i=r=MEny>~=(Fu_oo$ z;$u{N`ZQfSmPyx2vgppaeN>G-Ov{Ro(&bZU>B_IgboatRx_Z8Zemh%6<-cA)|MWbe zIY!qmU!W@*4Ph>y?%cd4`l@$%&(f+I!Z`SUV*QG(g;JmVu5W8=!JB{oE3ma5`-i%s zb{5Y!`2&4W=W%12{()#tR%4!fESd)k9qqw4zo6NG%X+P*n6dHs59qZfZ5Z|>g=R$&GC)yk`wb9hw! z;6e2Rh2ELhXKq`!eed1_nVBgm2dBLhC{~&?&FV+!qA7eIc?56Wv^8t*p5#5r$(bqn z?rv8f)!!F07?`1lg!QFD-%8gNi#MfZ@!A1I+?%uJ%`=L8VhsW0<9L_O`Yu|Ske!~E zmc|kHr0jQ(Qs_ym4eEuRFNKHBpP!bUE+VGw*^|ECH(a47%=1X1cVXI;5etqKWv6Fw z%&fgx<-XwxJ;aZVjg{%0@gKP$F&n+JL)qEb)-HLUca%a8{*ai_QanxNkHZ%%Vc-V& z=7b%&zR*L`m*WMEmhJb*!)!^>u_Fb$lF%*7K6G-e$9+9|gN6-}=-sTJ{r0G$YbUSq zvI8uXC<+Wfy4@E9>+2s48a7mkck71^g?FTg$4*>Z{_;6(`hxBN(}CJ}z2EP13M+f? zn)97wOFMnY@wD^?m=03n-7_@o(sy1#@r`Q*%ldWt@ZJ5#0)!*tS#e4VN&p!LY@C$TldVT`9phxe~m%V${- zD-9om5^QQ#qJ)-cINse#ym@-}=3NXlR^GgOv+}lbdbfZ7OE>%Xd)Tl4C07iOVVQ@Q zx0kP%*JLkm@5#Pi-pc7@3HX-i82zhC_|M%Jh5!ntwF2vfU;DG0=`s`W)@_ABQ>8S7!e7^O(uhZ=4y8 z8aWd46646p)1I6I#*;hR);6wz~L%H55>Cf5I=HGcBBO%eJNtmPzqT!oPuJ<;M#-cg$L4_NH03D3Vj63 zp?o=F8htfp26cq%U@@CI*({-NR7?*e90oT`4?gCWeMh9meS@W zp%k}x2E{I)MVppH(Ap()Y0IjGv~~3yisAW}=oPdlelbm(x0>d!SWj5%L2K5=(uTM= z?2i#oTQ+XMKKC0aAtr`)#&4u;ykAEA2HKgifiiY&pzYhX5tcj>cFm%+)MUb78>ObD zQx5jhDA+lb_Gd)WA+&>!?VL_UyQAm?u8Y%VQc3zO+8;lgGB+=y%w5=1BXtdB?uf_U z8}XQ%*-U4!Mml@@b~=D{)V!}o=APYjWLFv;L0g;m)8B)(ZF)|k)E3UhT5Pn13vw6G z-b1UX5c4#Jne*vX?n?SKYbo8xolobp7K?WA!GmkCXT}=JL%TXZe=X)|utz`UXmSq6 zQz6>O#}BQgW0+$(btn#VH*r{h9ZSC+jHTj&bySkQg^nGGr&9$R>2&^jDlOQ6Htc3P zSFnlp7sgUvVGQLQT~FD^F}HMlD;>bxP677y$lI4rMOkQ5=Oxjp9BFTly~mPhUvUzh zJGPsCgFKo;>*zAt`DF(asO)GW+PvH8!qH^x$-k4X7VV(xCsOFv>D`#W$)cRSnb0?f zj$~u+j|2O~{vY`V^Qa*IAQfe2QQ?szggu$D$NzCUdh#Uwdg>@)*&$uPyw1&&IdtP} z4rm^r8z+y@&C>_z7Uq9$oGGB2rAO$_*<8Adc^^$tA>BA$B-+?zzn-Og7YnGOtcWTv zlu+rp3)nN{GF`m#8{xHFx~ln&u>6JY+`2)PcW=?Pn|J8ut=njG-=W)g?oib|xcm3$ zZpD47xL=9y2Jp87?$g7XN~)}?rb^5o-LI*os@i(0u6aOMol6fM)>2Jf{a~kmyi6|`LlN2tM1*q29s%Si2D_l2G|HU z7{B1ao*lpVq(vUXJzi2&A>oI<|Bts`Y5Dfs&0l)qhflw~S5sS6QwGgvF=NS~>{)n(BAnk?v0zn&uX}8_iB`ten1R zSpey3s;g_>d8bzBpVP;G)~wZOv9WP+xPM}-j9=O2ohm{9NI&nC)LD3e-owLv=85f= zm#b<7h4

^fhCK%q}g-+PgPncgCLclP3uFd9_vVz9-SIJ=*)j-RDd3ihtJe>+cHshP9RbjGX+B;ePQ>Ka-p)1^@Ne1^phim7#BZU^a5nuI+w4MmFG%4GC-S zRn@%yx}XpIwxI!5CPRk}GqVnATU#sPgZ}G+eh(!t;r(5lYB%E$!AO6@3Ye2E$~J*n zl~WF7{d@0k1WaEE!u=j)%B!>u{MLnh;J%X6pX}=woc}xLQiC%aUI;fExa9sa8Ed58!t&-u3Ed@ZimO@j!z3JTtR@rnH3+ zh#@{hW_M=xop)#78QOQZJM$xsDI+PRTm$isI8j&pBk_;KKjMT%@sGqm0!_yS@sGqm zO8tcVY37iW_(um3MFUI3KN|3SLq#WGf$TpMy86@NABFehVH^JV(?euX`v0;+|Nn){ z!vseu=kIt`#2#Y$JD&JQ;vb2BB>oW|#fyK0&&8tz@sGqma#LW#BAeljC5KQ7>(B3t ze#6PlgJ#VZtzc2Rds5GAwi+?2kk@!cSO#CD9k4Al07LJL3R4~SXHRr=R z^Wq;lnva9c{K{Ac;vb2BqwK6)OIb_($R&iGM^F%b}0NKZ-sdM`oN~ z3JLL#{5mu=7T2R;7_`srg%o7yqbG<}#MDnW@sGqm68}j2Bk_;KKNA1wH~B{5AJKF8 zcl;xICl{<%^IpoA>)co2w9sdnxoS3M^O!Ej+_fw8e9Cx9hPjWI4erbg+#HviHal-g z5^|FUoecfDCnDXGk?yHT_r*x}bflZe*2a-XeM!Jj`T}fgW2~`eUF#SK@YaO3O>0>Lnz!twZA0d!lPOyTZw=i=te_2S z(GAor*?q{owzkzF{~oQWBiG3EFW4o>q&gRIWXGPnbG32KP1N0TvP<>?xh|gd*0FtM zvyglj^pw#DxsG*|cAzD%TY+>L(eKUfxpT7pT_?K*ovlL4MxE;eW=xjsA?h_F9&Xa)c^nh literal 0 HcmV?d00001 diff --git a/installers/cygwin/editpath/x86_64/EditPath.exe b/installers/cygwin/editpath/x86_64/EditPath.exe new file mode 100644 index 0000000000000000000000000000000000000000..6e79f1619a498340d624beee62d1c77a3e78b83e GIT binary patch literal 134144 zcmeF4d3==B)%a(UObAPufCS@8(4dKehPoxjUwVH4F)Tsa8|F4nkp`)G}>Uv_}zecZi2mUpB z#$}h!FP=N^noH+hbXD=}i>|)f+inrx#y!%_Vb=$NmjI*%U9LvA>k>(9al1a~;=A1K`lnYC{(GOfy)IYjK0r$%ZdWU)eb?uh z(42)KGNsQ7A!$3=DP5|V>|-vuD0C4~p^J;QTtd1x`AhrMxLmEr%+r8P$4UkyDCcX3 zgj1gyhWVJe8cy|*zN)rIXp$u$72L)1=Sy71!d25hU()5%DD6%$DQH)X^dGU5v|;#X(HgBkJjGvc!{;%8*UCuhVbWW-O*h#!*?KO!T3XhwWwMto>S zJU1i$?X?->pAr8kBmQ1S{H=`m=8X8u8S(WQ@nLE`XT<-Q5&vyQ{H~1n@{IUR z8S#dU_=1f1)fw?%M*RGY_^gch85!}(8Sx1j@e?!R$7IBh$cP`B5g(ZmADR)*&4_<1 zQa<^KkJ+6O|0pB=UPk<_jQHjsh`*eXzy1f}&t~MW{DJtx8To(Ai2t@<+%Pw+O?IBZ zEuJ^Fx?IaVJJ3^-VMH$}=>n*+dh~yYdYeU=c}KY-d)(d|&n6t%=?)E*f1~AJd2Dj9 z#favIDQ-7n^VnZujo2&Ey|J!IHV(NUOhTk*|)r zJ}C=|o@aU>k=cBYBwL%7%EcAbv3YREMja)ZwM ziO%cPv3ecr(vWct*{$=&>pWZM{W_-F>(zOMI8DTuUzL9eyD1x(0O<3yc!)db>Wjb%tN2-OnI`0IXw@~M;(s_+K?*N^*Oy^a7tje|Myl*g5W&CvBBRcOs zowrTrJ)~o=>evbmc?hN}%2~#_qopN(s@gCUboJ>XqT$f z)_JpaUa!vkQ0MjOywh|Z3mzGUQ}Ve~ShtLRPSdF}?PlrJdq}O)srQlEqEjCtb&O73LGVBwTn#{6 z1GJKwqfe1q(POKapYy`88EI$NbG) z_4Uj`_4Q;UUjg$EYG#-(AwGj?H4Z6- zCc?A!C+onLf^OZ(y@DewXXTIi{}=Q%>yAN1JWBW)0-o-BIr?s*`QH_Y90cQP-B zHmdu#vAka!rS`W+(8e4}v_xKZub))zj{QW}n@3r9|FUQGD_dc=Q#Lj>@-isYxMPPa z+f;U*mwc33&eH#O$A5 z59HZE#*VamucLsuo+=FU6KYu@wNyzh<}Uj<0X&9Cuq7SeGeLiZGfne9ITZB1`7$1Ftlmw~6+Zka{_E<4zae1N z_tEJoLhc0!3rG^qw}*TlkN2F4(+fI#S9$(UNz=3cD7OoO9cK?!Jw(5G?j=L3xEB{u z!OUtZK*iNBBw`Th`ATR%%JsCg*;svtU=Yd~zcn_rvHETm@u(~#QhlL{`WmY*P=P$( zYAF-TW-gm=7*@WIWc!K7Tp+TXpxF+EdhOelDNA4w9N814NMrRVsleOROz~R^k0Zju zV2TvkVn6t>ls|(A-8`9Aea=U7QV7{I%jV478+!qKX`^HlwW0(DN`fP`Z^psK} zQaw-#dYca7zg76nA(RnxauVp=K!AStd?mDwRNoGOD>P1ZWEo-m=qCk{=LtF;dGTwR zQB>ihWDi0?id`wiyiF@57R|qz7_#?1xPu;DE@g!<1_Apgk4SxCf^_U$%QJ-#lY8D7 zGUEoyzmnL*U`vPR3^J%x>N|-bLq8Wo&YnW0vC-roLn7lY`TOhqZplBIe3^5RY8R=l z&`=uw;$RxS4ZLGTR^c8ZiUjUNM-~!LGGi1yvj1`_by_g16~=-}8alKjA1y7Sg$E;V zXt`QyzUM@T`C0!Z_`Mr^`@jd70|aKqNh*AmgpE-uJpNyxdkSIZSF#x+@kaDM?QVn5{8YabPuR+ZfzLh9n~l}(g-cY+i3~A(7*IcSFy`AZ=gY- z01S_#p<=_T9o8MNW(>0pb7FVEJjf|IXSVX`PbRC25_K))iN& z8WTzFmQ-6HH6oJMD`|b2L^+|1U1l8sfIG?-HQQu zJhdo#7fIg>AZ-z(EpX_a7qCV!niKN^=J4>ph1xxf>6b%rA+HPC%6F3Nn%?bc^xmoH zT_N?C3&kpgV&y``Qb{Y8v{Fec*7VkxNNSO!76_z5M3VCOH$428Oltqkq4s8|ozDF- z-g{v5d7$WD+8vj#HE!oq?|r0gciVu__}y)cNbNGW5ozOZr+ar>R%l4D)|3P|e`nV2 zwj2OdJcoFWVRjmk?WY=Tc5e7+9T`9*JCxrNP*8aWbok6@-qfJ#jkhrj;m_BiSc+lt zsyjO4Vn;U}O3tuoI+j_xKf}x32ToClmeZdv}0NXsx@~sBB;G5pAa0 zyC~Hjt%RoOI&@pU-L3BMjG#B%zr~F`vC(O?@{X#}?HiQMOF-|{{zk-ft-DV!_+V|& zyX3{7_u5^6U%QEaF=840GTfW$#%~gD9`xt#_rmIoj$XDqg^|?bIi<{ zSR<;>8~5(Bv9T|m1N~ogg${z6fwFd0|3vS~9QVYNbF#w7$JTJ~_|~-~4aqXfv>!84 zeeMRhG?d$G#0SQ*`RBc(HLb!(b!9T&E&1-WObRCSP4AY)eLMR7;YT`HOz=|$+h!k)HRTwr z7f|7J=M)KE#p9vwO|VjmGYEMo5;8WTGje)q0w^F(Ma zXs(To68?XBjw?2jHOVrhF`As94^ z6dJ|K%%?{EQT9V)b<=vHp#$w|1X$4YtS4$uBW!wJB1pUTegNox^c(Qxcm^#`3!p)> zuFvw^MaZoCdh0vC-f~r+_u-jeCx=7fi8alMT zdDG${Mn@|$Nt=txT<&>_8tA7O8qDr2f8`6;t*tlL`ZvDgkG#`YA009{8Ka3Ut|W4VM11>u1X!m*Lsxc8>x`O^5-^Mzbz4QZZ`19;pz8Sumic1air2v+_`AV&Kz}>OKl@)8 zaZ+O;F}`cPXKt5JS-a2tx2#KL@kV<1$hu|rrM_rwiQ9;t>2`*EjHo~(IwISCM;1y; zBqk;HNQtVn5>xgr@hBzgmSMIb)Y)D?$|e z&h!2B{0oxAOwdC%FvQPhm@gaV>-FY3#w9F^u|WZIo9ze8Tx-l;YgG1m&wRUiYs2us z?6u?=(HSM9?LD6{rCOH#v;?WJD*!$C-eb?8I@)}&L>5J9jVk^(nqLTw5Le7o!lZnb z*z5Y}W!CuCjOoD2wUy?X^Dl%7L=G5{R(EjeDLypBXEIS4PpPugZ*HoO{@5Kbw*tC& z`1m@gWu|MgG(F}~PtwC&8M??z<3+qmL& z`n|y@WA3$N%(qm--+>eONJkR*80q+Q zX*3Q|Xsivk#P&2}TQhTEqMR@=R|G;_x1!4kCvMIX#p z^^9W<`At?DZFUum;$4|*RCX;sO}<&VmbEA9zO@7&ip#zk770X~RK#!YdP+AOC@Hqb zv6OUpZkMp#e*_1`cg3t#)A}h)Bp*fp@5ARO{|$V;0A}C#{D$_^@u~kId=mPlTSnO2 z7%s7{&?T2X$r1U>}9CIVGsHE5xs$&Jm-0P^xgJdXd z9Vw7bt4Po)T#_$(vOq^WYO>I!5x|O6g4Tm7m^KNuJ~twj_(BW|!E}yobVvgfy&=!F zNbS+$dbA%v;5N0g^1_*NHdvt#R5kn3$I@330ZNA~>~$>~1gOz#FQJaKwxyMnyf@6v zM%8hlG01@C-J$)ANJFoyVF;44*FKGMQWs4JU=_nm$$jXXwtqXp>nQn*{o6}QR^Tt| zG|a`w>M$#VIjjt>>eccvSZA(FInK;ocv^z0l|IBm2(NDqjJ(!p-s)Wr4PAi0%i^Xx zDBji)!EtU^7<um>3KX{3ufEw2 zew~7^{2-JU^esi5hL1toGFgzKc2_o|fhVfbBj4@Hzxbtn@yFsf$_14R?O3^}AaNWn zf&zxvrL>hqT_)p}I`67=;`56a&c%b(B3n?;!RNSUIt>fDSkT3SE*5l28MVprc^Q2y zYQwWW*A**qMmX6*KzLWZ zURT~~uN#ms_tKP;@LNCoK-8fceg@jpc&bY&#X`nRlvhVPToAX9g85|plf&Vsak!x& z(2o;_tAQP1fAvPcas6PR!w1$#XWahsq13m_=Uw%hAbJppCg;-L`nx}WpCK+baW~c} z7aOu7$>>5{J_&i#3cut2c{Rb<2@f&j{-R=(h*X6zmfEh<)%M|2f2!vj1oBO}bdj87 zLYM^E)f9s+r(R}+HB;8U!eeLkDJNN{nk21Z?7h|oWDxmqn_cyZBA?>7W7V{R)j-W* zvHs&B9AQ+x6&^S~-qTKRL>6ofc@PNUp+-lCj7QI3bUL!2ocX}KTGwx0-LOT`f1RF( zW3EJ6%G}A(u>I%YnHn}RXGO9G>nh(3pCUs=!@8%K1qdX?>WFW&m)H?(%a%w-M~Srv zE;EqhhS|{)8|oy?m$_wj7-pZE2m3J1WVkdxI`ctsW37mqxOe&f2w@{K!4>w22zeJj zzG3Fl+c$$|R}kD1{AP9a>+hlg^r04$1Ib{XWA{8u8-$I>!d`dyrz&I@8Kx)?l=Ic& z$fd#PX+=hKDhAD~i$)oduZq3PZ<2Ci*|r&NJ*SGvyb+H;=OQ*pMK6V=pi)7RR;tTw ziJc>8PEcq{)gIu>RcyhhfC6D9bJ*}_(p^!S|=}Hz8CW%C;gG<-GR#Y7k4Oopm(o+jBjOi z?Ot>ShOWY)-tza=SGFyx2L6m_AdA`(LaVZU(HPwGZna+U!<4?02ZjeA%hsxP+GwYJ z$@_%yG0`jiQS?dEUyNqJI-C&+dFri8O8WejpLuU>0+!MAE@vN!0JB*fsEqLz`yc4` zfZ1)7;o<9BobLqHjOa+FFFHZ2dM8@eCu<@-Wuqe|z{A*9VcCG}L`Fa}EN1&oR)Y9W zw;N@9Xhl@y17ev9qNV*Nh}dPhLCa^y2H^2HBirp#96sfueOfbNge|t0a7=cc?I%U!F!jv2He~6sn`Q2ZTCk`w zWqoAoYiX)>S%(p+Vsq?vMN?<~R<8Fp-AKY-`rwLJ`^m?jViW`OdC=?)GT&16+awK_ z&;`c>SJM;^4HktE@}LOWkSuSdd*S^=uqb&t(CI=l1S;#2pg+3b3)KjBQgRIupbBcf-Y)*rJbjePVax8ByFT zn^pVd-hT8@>l<$q+vUox+3jt*oM2;h1zX#$P^n*QfB|(7#g7l30}@cZKj?kC!>;vI%9Po~|W3I23WOQ`wf=u5Fal&pG3suRnj zKven_G>d{)W>;hNtsLlag-?Rv=XrR9RI~AYbK%!5+KLzow4SdCMXyA=eIjZ{rRz;&$|gRIX#HH}!(6M> zLgdTr&_E<<&bK&CMWh}?AWfvE&Hrse$h7%C`g`Ypa%$sS5{oNxxQvSO1Wa^HqjRvb zWsax21n>fwSn%myfGj=h6Jmg#{P6t$VSm8w@1^_!r-2)KQd2T1N)*WyJ-^Eza1C{2 zkU33$Fkj3qEXMzgCCu_~Xnpew4I^Z=htBh^D!lD$HaQCa=9RUqs5$5SPrvnDVuh(I zYGK9fH`!L)?I>$8q$Z#Zz6qLrL6(3CoBE`G!A_~Qd?_tqQ-2Jn)tlQ830U>J;)P|> zwC;0i-Ii$|=$7Au7KZtSW8q;HHOCv^j9vCsm}3c*mC{A4{;5-)HOxbtC87Q8Vjr;z zWice$e-q8)y2O=+yDVP#z)*K`4AN9S_&D=ht*sP6&k<}OfLdqJZtp8y&%VxBu>e1L@5sbBzycOaG%6;x3{Kfs>@xL1v|e=+Hr z^L^*1_%9)E?qmJG0e@E~If!Rk>jgZgb9Ans53lKU*~R(r80G(&08{cO(G{{4C*2mit36?8fho zd3=>$FWJgiP>Yx>Lv%xLeIw&vZyk{`n8$B2yP8`U9sV2xNS>aBV`z71Y{2Z5Z@p|`6NqIW zgoln&$&qggoA;u={O)zZmddY|v?^OQ&VC+xd;|WlPAt(b{9*XSpj*l+O}9UK?Ppm< z>Y1=l`y&WNQjQngb7D@s@dX1Mo!RSK1HqZN+i`EamXf4&jz2YG@r-N5{W3T zmXw_GZqTWY&(lTEaBIO_+weCAqIH-|A^cwne`G@0D~AKhy=$?@h+g1sku{9y@lTY) z=oTDkM)YjA!7dE*F*@XYSo!$lyY#9@In_Q-{QOe?v?heM{5i%)9 z$($`R(1@>qRIfcH*~Z5AjO^or9l3%FyItB>vc)b1MsbDOp#rb8Pd|OdN>-WuoEKEo z5WmKW5^~%q7vOI|Jvfs|+3S1kH@YMdPYT#Ps{pF}=GQQiBb@qgNILR8O(*@o@rP6i zmp%vkD}RX6kSDAV-(Pe{gBH4Y6zpTbRa_!S5OI(w<526P95COPUt}+R#QxTJ`kUs} z5MPKK4^*7COacs-_A=lnt?c#QI-f+p`I;nZFF|^Ff7v=CIyuf4KA}J~H1AtEA1!{4 zpbsZrRd)DjQTz#aWI+2HpLiRpBUrtsM{|xb@M177a-PB;S)Wy3`N87nMD{wq$I>(f z(O+H+{Z4t&s{O~Zev&P{q<~1ck4MNzneYW{l|SfQ$ULKGP{kc_Zv{E&U)C{B5d=mk*!Sob!;@IhwP^p+Xrf&%7Z1c z_1WK81~#F;yBn)pA0X~+`Xm228S{<^Qlu}Z)=OECrcSLNMvPOzKjCTvXU^~CG7`{F zrl9wTdDw{~R~=gajF|nW(-lxl3h3VskUj|i3NflQbd`Qx<;5xJKlQ8feyMT>Roc(J zCjC@PoSo9|=SJ+c#8K-3dn7EP#lu?Q(my(XHw68zd=H|JRy;q#U|}f#s$>7qv1+y3 z;5k&s&eX9Y9h;_O|3xg-YJ%Plzb}TH!-z7aJd~G7Ja;mekb=>Ly+(vhqW$g7tjg2Z za+~*4wiB5R_+-Ac7l0#He?;z6|JjEF)eB{RsILJr~5#Zu{HS8HiPb7#=q=8wQGi z{ssYvY^SJGsjiRvt%{82-Gj+^A0&7PlW_$m<7!OC)_}PfQ?kAr2SLEB!D!8AtgU(Wk$Oyq_2ZR=UK;|jglegE(To7n$s@QV2 zQB|;bm`KIHje|G1jJq0eu7XCS zwE)>w$X-*b&DvQ!^HS@wr?KfFz|$nZzLE?AUrL>70t8V(6m&gpE}-+s2UKQlZF zDd5ip(VFGz#6Bu)I785`P}Mtppv$OUX6X`|j53C0?Sbe-D33lLB=zet=(D?Fy`D!P zzAoU9*_sLMv%Jx}$Vfo01X8q@Vfl2&6j`D^A*yOFU{P9)O##ixp=L!nVYQtwyrApP zU^QHwc)6{KRA>lveWwwfSil*N4D|hFowDm7ocJ*Z1C(sh%mq8OK+i6B!@1POln~Zq z)Wi&5G&wnzjdTQSmhrS0OYb9_X&}K7f;|3ILy+%6%%Cgx*hS)OXMA6xEm`Uwn=Bv< z&Se8B-+>xYM1jZC+V_=W!?BHFQ zzu-4w0onH7hh}Jm{{CkCe1ny}>54N0v?xsY8nmiZ`oZxh4VK+W3s7)ukqo?b>G|w5 zwCOuf0(4;#M(CILh)q@&8wuU7FHm9$9g)IboujL-5j3nKMld`?E%@xGh9Hv9j@(e>3VRIeIGRG*d2&*vf0ZhI zmnuCS@l(KY91Z~uF{~-Y_Ujz-Q1;yxdn_}|= ze2ZF8-QqfBp!dch%!;vt78G+`wUobd{$}u3Fg7bxG1e2x<0@*i4c^Z&m0dmJ=L@zx zCw=XCLxl}XoVN>7BXy z&ZUYk%u@+R$y}HGg#{|k-BTxCq~e2!>r)sliM2)Mk}_j`CrgLu>2zu$ojS!`Yh8M< z5$P!QMZR_~DybX)A$ND5r(>rfG=~%!7Wxog@5Nk=bQIK8ey~I@BGV2}>}x%iY{A_Y zK%nE;3f0QK{IC39ptRZb_i+ZlRJNY+Z7eGDYo(aje-^#i=l4DWqC<+*wlnS5SAMo+ zhi3P*#S>&r%y+R68L?Zkgh`$z1133A?k)dG!tM~^(5d|G2cw(>qYM^Cxt%Q4w69+70N0E!!uqWXRD;WpQ0PmB}Q`pF|B)Q4h#$(Pj{wD7v*{ZVVMV4 zN_>OFvqBfj^=%c-4i)vh?(~5+?s=U)iIj0<);;eNUzLh4!|U85bR(ZWT%X>DAxM-S z%Yjuy`X9^@;br>HSwa{b*(sf$I6~&RbxWejcV%FSFzXg+5ijODSvna*F9w zE=vY9stqq39O|eH=QTQ>2Se;!bq)kCz4sBkCx{NVN-qN4K;_5Iye&`p#HHQDCrv)> zqkR?xF1v@}|KGIV_TOn=ofl#caX`Rw`z_Wpa(+n12iA)8fx!kz+I7HyX2 z%`Z{aj0aZ6qn{?NjE4yZmsX%YM|oEjn6E0wmR%05^ePp`J&pr#!cS>yKWPDahzjnu zA7{_WunxJE>)?h}Wkllcc}I`mja?-2vDawp=H}ih*-AgFSbPK?#`$^drd+4|{E_P3 z+o&&;8!xm8sBtge$NrFNjfM`Vp;#I9Uy(-xU22)sww*>66%@Hb1!+m~83kPZk<-Z6 zZPeAKc}=waV0qT{CFyc5OEbs%nniHw!o0^2M&U6~@3#&VPL$&m6vl>fi;N>?x16NR zpzBjrHFPJdx`AM#sw1dsda9~(6jY+BvxwPsRKl%=%>mLd# zQP)ah_Lu59wB_0MMY4-We3Y!~aDwS|J?%izMVEp~)U}7*G5haQm!6ZF$3%WTs4j=Z zI3iUeX5jUycFx$9Y-b8V#a4{nsunQm@cfN0`7l*Jav0@+wr&??6Nw%in)mlrXyzdI*HvL1j^A_UnuvOBcdS9VJHilPu z3_(Yw44t4fsy7J|1%#(JMhb-5M*n~%i6d^LimN1_9icl zz+SFkIR)Z*PGGGrPe;Mn--<+yRL_Ez^l2{t zEzikBE{&cOXN`CIvm)Hoc{H`WD?Elg*+Gk((#{DHnmWWuu!gkTj}BL@4|0+^a@wg+ z<~U2eR&MF<>IJP^1*pTbjj()L>?uWRa_WmaiB*Eml>cfz+3yLm7u73BwX8}4sC+Zu z^B?MFvA>s>F3lgxgF<5a{+!M9fP_#T5a(jC&*6#QA~@N<3;p36M(!jX#ioU_78E2;SrFU%(+ zUCc^T>f_{lejxvODENKlpZS6O#Xpcg=ezQ?InZU8uP~Xek!hoijTs*&C(|^7Ms!6h z{SnJRZVp>DMe1Dqtl~A88FIH+BY(bJ8SeK<(wpiFQq_O{QL_3^2pXPNN@2Sg*6GxK z7PW6QOrw|!%jWbU*3@EidVy6_U}kqr%8}|jCdu-fFTBF?g^ZIgHf80jSbvqsS0)qS z_bGOHZ@p4y`6^@qx^#QD7Y4>ai*$2BU;`ezfaNb`#5oJ^@kfWefUT>R6vH?oSZ__s z2tb?b09 zHyUE^P%NQu(RhhN58&^4W|5pqS*Fei|heAH#_WxjIrpFv>Ic45Z~mB4!{IW;F3|TN zV_>IYQkOWCJ%w|DS~1$BaMIUM`f%mx)ABk3m-0Qia}S#S!30^EIIq3#_19xW^IRS6~Ws~q_)7aj0A?ZBUFPKZtQn~O^FVt(N@ zf$8Q%LZC8s-T3;-kLHc7H;)xa1`eN>nHy69KXyf4TsLyf_@IEB)-nX(tGMSh2R7uy0AjHInRgnT)^>Ef5$p#6lcrLib!Kso~v%+^`QNg zdB!OTxkQK+BabYCwCp8$o4){#ZPpT-ugK~Z#Moyfv|5GoBdet%m-nVu_|K`t4}h}= z3{&CW_X+mZy{o0TEfELDJ=+rNpJ*1TymUeN^b;4y#TKn3om!JL(D~F<}1nKEB}3 z{4(jnC8VnUpNbih@Um4H9`zguhnmH<5Z4>zEi)|Z9?IH{oQcraarASBG$ZK>u;*$C zDQ{hsXa8oG>pD0ze<%UlpDY#%pcVHtIYnAx)rkVTNxP2qRQ`tq?4neGgD9{iQ6QGD zz0G~Q6&|1;9;;K{(=SqKMX8EIw(KvnDn;Y55W;aqZ@*C^Ji} zH#`A%y({LG91-I5OLYsefK~E^ob(&xw{l91HhW0D`L4h0d8SdZD}1IuQtxs{9%-Q& zYzR4~`lUVG<8pDPfqimW)ya88!(7|57!X+k70c!_P*)Gm5E-jH=V~7BF`u zVQL;a#~-OH7T=LlD&ObtOUOo)_R_Cp?k*^5tbTMGZFrmI9Y4)-ay|rJ^<4j6l5XcS zQ-p4^Qy)Fy9AaYX+>?WB7{9}?ZjvEfBLg2h(cw#@>YRe>4im}>rUm}086^ethYLl> z2p!O(-ri9#1@PiTUHx7-=w~lx%fv}q z8KvSkUHZQ2e&vSnbR%-LuxB4YOve#iK;m^>)!uY;y4*s<>NCuP+l;a`U6L*))RH6B z*W$sNC!gWULW@vx2J(;vfIj^9x+0uo5cD%Ywf&Odcezb%aTh!CKIZ!QdA!|7O*@r> z{W|s&sn>{HRPYTJmt$iZ9ll~Pf!H86EooyCIbG~>Gta&iO~R_$G19mT);AfAcaRxOU|b)1Qy*`nWFNa{$lA7i7n|MPLhP}XGlA);ALUGUBp znn#|N6jyjllF8EeHIbQDQ@%TPg!Cht|DU(vq`m>*j9t|tGBcY0f~4i-xm-0X-8IX4 zlT}I0`@%;trC#}|pyq-7G(M8j4XJnqqW_#|x+X$k{} z%boec^>z>9dm#QoX@?^yX?L2X$;1anUvdhz}6bJSiwqjlR2j^CNm)vX3_V+q-`AUv=d>FazO)h2YUA+`wKH0WF4>?h(o4 zy}1ZE#WpdMYg;#7ChyI%Mdy3M-4h2b^^CNP*U~)&B+nmAooXvz(q!&Lk%iH7Mj4TJ zDE!rR`x(*G2z1RKBsDxk4e-9@@paP%9b#+dh_{4iMQL~rCy2Zg90Sq0w!dmYp10Xl zWw@Fmw-LTX@1R)o{d%Fo;B`=6<=gY|li$<|BxZS_Y$xUw5?RbEtqF~UCKNld@~ipy z0+8*zSBqPWDir^z;(@Y{4fn!+WyLllVQO9rJ*Zulm>g;MNN84lQu0m-WccDxIZdc< z-^zyH(c;o}Hnf*eL>)v#VC=Ftiign5?zvo2**0X0ZUW524cZ?|!FHt^I*g@pdCF)0 z2pKevw?~a)-c@2_$=nrV1-Hwne8upd_N5(BwaI0Y5Q|EYgt&6;^ZufA_F(%##ZcTQ zvijfL*ZdY-TD|m5=}!aqT&BtJe$4xNgf9s|L+`IaVUaX;kAE0MWlWdcye_x_cXy;Xj>9%Qq8LU7Sk5J~~@raR&~3r-Rp% zEFIK4Ve^S`$lHELo>Pfb&!=OYi;5RsK>(go&86LnOz;OcAKMl{yy}0TJ1^;G__DQNzF_cQ~5B5sAeF_x+k9^$Y*f{p7nx^^utt335SLFE@qb|%hlrdmywr^REy3wdqPoZu<5PkhU* z$o`JNZ1EziCFS)G${cV|c}1g=tT0)hb;y?2z7wCDFfYCX9~odZ-wp#NUN{6q>^~`M z@9T{exyYL#m;pOy?V-MPQ{DQ|vWhzYxu|HoSb%zJ9*$$|E zzz!wLJmblMRzC((3!dx?V^KmwruYd| zqWL#tOIOb)<_CowG!C}!rW~8eD@en|zWH|eZ3RN=PEP|Ypa1HUA3^j0I9QbAAH)h|X&g$4FjBbS9Qrq9CEj8PvW#lm% zxa$(>X}VuyM*ip*>?eL8|H1Fi*H@!{0TAZl0DIQ0X!3o$7V6+bdn2L_p8LWFD>a)V z`+(JFHmmwWMr~$>bcRnN|M>6Aw~qinJ>62Ar^_e!VTH4|-ci>jZ@H^&Y_qPLje0iQ zJL*0V=$1gVzRSw5oXb*VbuJ0;^dgI%=h}bZlEGek+fs)4=)9kYpU-@KDU5_<$+z!- z9_VgXF0n$N*;~G84Q@-99o5NL`P#Q1FZ}DPa^HQ2oU`6yzf5b1Ij@(-;Gg!M;z!RU zxM837o8^5K#onpwf%wBK>?3KF6^$6_G$Q*gEhwdOTIP*rk?QhN;ihM0R?X}K;z;@c z&oYO4>>CKfv^JLwdNcO+rT_i$oACGl6@E7}eBgHws9;MgY}V0J2b)R<-^NXXFLaVl zG^xZN#!vB&9sExI(D}mO`{o~=Kl%SMf8=+TSNxNDADLH`c~6P=$kxE5{9e=BB37Qq zT_PUL#8u_6r+)kkF|W8N2Lz&H&i$9XE4HmBFYfc++3Gxu?E9jtCU3X*PUmUYFW70@ zVjl~8v1FA^8M8o3mCRF_dVQqiHSY_V0?+%RprOIjPWs8{JM&ZakI|gnx9m+tML#FM zb07JRex?H1@EvTn+eZO~iaBgtBh`oY8+W686^#>5Qs@BnM)tE=B*n(G@UB6za(KoL zXn8i9H2dM35t@_o@RO*x=;922j=~4>!Dr()Ax96+z{wf!WqbF8`uXVm+>BB>FO|O; z!hH`vJ;j`g+rE7P>H3e@SC(qT8J`Z%?_SZ3a+vJiL@?_4hU31hf$ky&U&kYAjqYjD zv28kbi;jJ&V@*2dLEBKSLC5aad5t=DfX@4wjvcLISL#@`jsOdY#W$1c*bAM4n3 z%2pCY=7MCKo;rP^}3efI`);04bibflvBi$t7FINm`lgx_kpNo&&!I|59ruu zI`*WFeWYU@I%ezG79HEJV=*0jQ^&s1vCS%${~R;hzJ=4=_Ph9`l=*rkNsgs-(UVC_ z>3o7L7=I_djOMT4Fp)jIS+L{El$^JZ7XD4rey7qr71WWK&YUlj!ynZlX_22I5Vgme zC3#Rt@uO@l;2g;RcmtK3P9-Vc?l1q(SmosH^*$Z`jPrW&W27{b=$!LcgQVR1a~fDK z4fHe#=KAjXZ_3u|*NU`E z71Y@o`mEuxefQ_V68UjGe!o$E645Z9>{VYcCp%}4iJ-_CFgmFZSC%{hUld=1K9Z>ijUFz+$NBH1MFXc zB&Yi%jDJoyS9hNvj(Qv`1hh1smc~=j(dn+1XAJF(OKI(6xG#euY5IvFdNBLTCz_??NA~upMsSEPQ4L~N%8$|dzPs`)% z5#xu*F{u!em8v1F&ZKqY?HsG-tL&zPu{L`{KXW>y~7BZCR`NMYl>o z69+m0-x^WJn98H2Ka5bdjDL8fJz685Zx^X*?P=7=dJ%{;9!uKK52=OOjFJlIR=eyK zvv-Vm@4U^^shlNa^@`VBu0^BA$yaD1{ajSYFL^B~5NP6&$7 zfYquw&+2TTWW8JwTv|yh%~uHhrsOUCQmXXcD$CcUJrbt99=G?_7zqR#4&+~GOpkcQ zIoC4tVxh#~9yA52A{Cd-6^YmBdHg92bSdwvB#ct88G#cE>4 z?omL(CxI%)IHV5YRM^M8=B#O$0OzE(9sAk4aj{DDc!7)J(texGpq+%Tm6L7O^m1Xq zKZ(sSyVWo!m9nW^3>ZYB9SSGm^?l)5iWMh{bxLy-tD02Id%^tP&GQhQUbA5}=eZ=~ zUQ7_iokNuwbxS*`{Z5%AGOmlpj#I;{c#7Zo%nI!%_OZ;SSY^wzZno57tOkwr`tMyfo8e}(0_6X?V|93k`Y=-3JT&TC{L z!0tgpr>G@iTs=Q;Vrt4Pv%6t6^_xi!Tz&$_G^RnmsTXNP!04qpD&RCG1`qWpRjpOt zyC`-edc#5^8Y(GP{zi;2+FwAMikTiPkzKi@n^jWPr@#I6>~9iU>Abbc{C9;!C~vX9 zUP_uMiG}u8zY}utQUZ9L30^H?HL&qOV#4Nfno?g$dNY*W?NCzl>y!UT^6O&+)leqy z*CsgAd+YhsF-~rOH4K0;!)FCsU>S8AYyj=Yr`M=?UFF$)p2#QW_J1VcC9p#RocRT4 zYHCc21t-R~RKE4^(^?*X3avv^XdNVIb+|5NZzwT0rBG`An46Po<}j^hCW)Fszh*5N z235A$E~t{GXSTH^yT9`3WcME@sOL?X>RaSWo-=I|cm}PAyh<1}*URf|i8n5%|6DA_ z_4+p!PN@4cWrOD90;oD&0lnv@8mvn-I8hpusS_ID5JvSc@&0CFeo($VRo;^-pOq*d z9tr=_m`^>Y`jiZd{U2suI=NEwO~$`9Nq{F&PR?%9V+5V?p92M`(;4H?^n`pUq3{E# z!V6P{!&11zbveJh49t=g%#0MwG!1j9E5#v<``bAN-aXBBJDY0?QTCkI^+o6q_nTbp~7~4z59cJ z`-)TXhGLC>rY{ES34RIO|5T1I+nQ=J|ifkbNX9!Y6i@2wXn`*f1@X;!esyK;Z^>s{@Ohw=K6`9>M%Xm;5@qFbuJtXz3bkrc6K zoW9+OVdaqWXQ?(Xl{S-oyEX+gIR!IG!=(DwUq>YE>n`P=*1t98ZIYcJx_W4;%1>7& zyV^_8>FO_mYvE|T)7SHpeLYV4iu{(-i}&1)<+Zl*)5Sy0Ps(sKerZppXXMGRmTi~# zUDyjT4#;@^judwKd1I=Eq5W1vXw*6^y z6toDo$gdZ@38c`k4;AcagVbA|lR_%d(FZ3yAo`$cmFR=e1TNX$ETP2nNqb9DBHbdv_tAoo-)|YVWciZ11=I+mrjh`)Uu5j_REJRE6a!OEvcGqsh*FMbKf6 zd!WqH24$CGvoxp$L|C-T$4nOo&2_1gZBkM!%h<)hyp)2uF9q`(4TD|7TcVM#+zsAK zqtnG*XCKt3=AFJ4U*J-Jfo`t357PtM^7a=^CekO|KE;l&-f)dL6N^@iyI}0=!J~t3+U~6Sy&obNZBZ?}^#G(hJh2b-w5A+pWQ zN+wIyi8FFrmc&#`65}FdN0!1%VtEo%*hs7(2^r}wmawX$BTF?$-SScPkZ)$%eZmcX ze!~WzqxnMp`1sO_NmD0x%XPq-Ql5$9>E}rGvNI?b3dRc?39vCSdUwFR+scKkW=C^; zQN8aUbO+tpDE0dy>v$S!Rt`U58;Fi=_bpv4tHyX}gpUKq{DxGySh)K?s^-aH(sIs- zo>IrzZRk@^S`k zoBeMhs+spVH+9e7r6=nH*4Xx*8Dz-40o`t;)9wMWW5He8ttP{_td6@%&%5P)sf_kV zsP>UrX<#Wl{^DC-huz?y$&bIA5OPfD{6#J}AV)%Hz`kNrfAm#Le znyfw_)W6ZYkHg*MJMz3!-5nFgL}M|iRdb6M@oRB}taFMljn2x8Z0}Q1E@-Q7V>SWZ zx=D-nYa69?;8g}D9*Ypkw(@_b5Mpa;NE<#N`>#v1{;@pM989A_dX3q5qt15Q%c%v7 z*;z?Q?Bx2ddDEgXRfYMKS)M4QOfsT55u@6{`<4LpM zy@Bq!Pxy#M0{QRDSJcx<{`#B(?h#aPBtb$}Y`dPxTjf-N9GD(+T~+bNsoUyc@bU(LV|MhDaP zClu_Y3K2JbA3BKRm(=)jj$9F8*cx`p zsgs9k5w{C;o?r4BtM3;Vu($bD{xhKKM4pI8)yf~pK&Q^LXA`q03wD<0cPXG5_ooA$ zLChYlfqtF>^8Qyk&_H5PWheU2E{v%P&q%?}|4lmVRm6aOR$zN}D%itPut(mN4m+9{ zu(t{9Gr;zIuDi60S?zRbWWUM_i1GT+Xg`i&v8e1zp(@>LO%<4lB2UraOkxypNde_% zJ5d+-MXJCZccvFuPK*L?Lt_tMQQ)`90J|L}%<-4v zIh)Nnq+LAmC~_!rt9r(_;l#Zwsx_~aCw=h#BG1w*`B)gx$_<(ec`pZyYWDV^rRmE{ z*!WaGj)$2H!t#rA)knGJ)dj~LzWe_PT*ByqOsr%zXAegMLK!(fLy8tMsB+0t#P#;-#xr-bV)E z!0cXZW$sJc-S-v87KdA5JKg#@~ zld1X=?>ET!^r!#QZ+pH8dxU_wntI<)yH74jr`>C~Cxv#SzMFP!6wr92(Ja-!Pkx!C zQ{snEpcMOXic*Q6b4$_c6A@f89?8DR@TThf{r|AO-%EYZ?7Keh!w;AJ*aPHWG5^Ac z!(+CW9&xHf-gdP2bHalN54c#RdslI21~R8@KPBvmZsz{3M{rwK$o+s5$8VKis<#T? zB1wG8$G20bbKiiUew~$PzlO5mtwHXpVt?(de0#~u=ta(#$(E(*IRa@xY?RVXo?;!l zU&jvAv3GQAgpNJ0%iW}7m*N7WmPQ?`#92t}=Q?(Sj)ipWLtV=PV)n4v(o4@#EwbG9 zjOS}b4uJ{+J>Rg+K1?!9&&hmgGKkG0`qY|=8Z11k7Mv|~s#&=IgA%MUX!T9Bz*-qd z=Ogs%YOG%8BOW@+^8Axhk-n_?`(f5KvMHmV#Qfv+ST=(?JcAz6#e$;$q=>f}$C=W9 z%&dg|`)#_Q%_e5A+(DPoe<`3D{Z!i-#Oz;cpr5CJmf%oNX_4!R*;i_ynJJ*3_fuve zV)khos5}Mq{B7wqJx9zw3?O`)`A;n;a_9N*xzHkEm*{>b-YZkWKaBL|x5+tJZ65(W z)_ZefqfUsievkecZURRvEv^_n5l}Qv$hccHR=m zDGiz%f@8cc-?G+a8%lb8%i7pvK6h+!XxP|-Q2yBR(CD!(q47PJNr_ssH8^GfXEt*A z4W&EUd(PH%>hvL`=cshG#__IfZEpQC#9}B5Uh#QvYmXf*I-#-88$N({)VwQebIP1w zK`7!^5Io#8jvXl1k_+p~H?{DKLUm1>LIWdvyxv={_I6S)gkCJj!&>A7WTso4Y6|yHTYjAu0e8#7?WU?D+JASvngLNPuStkhvYYgkw zl2SZ6M)VG~HnBHfAXUp%5}rVT=vuKyn^Y4@OBqDOt0$3iiKrXBL`nlzld4RvLs+^# zEbBX{k!J_U+aRSZ3TiMTqLcEB$Ujs$4%^gLjXVBS78X;GIaT+TbW&p8z&c*PSzZry zYAZilGD1Yt?9H;I5fA!;$AowN)`$`gh9!Gr4r!NTXe~YaODR)q1P<yQg720 zRKQayQjZJvC{-H@_$1#4D-JJ4sux$26WX6u_m(fZyncxENxblK5~WJk#fw=;$=co9 zgn^3vxPW(Ewkhu~=fS2S$$hv;wl2=K$1DK;8^rK(mSSL2>>yWVCeAzlJC(<1ZU%2#C*rqjnfZvMtQOcgfcq2Oo*75#Sgqg#B z&rY%Gm`&xrN8R=uD9HWs8X`nUeBvLA0l7bGaP%7K2n8!-g9kQ7U#rV<2iRWW`Ga?&-{0t6*PQ$Hh7y)pot#&?HG}{$du^R99maz zQb$k8s;#;vZ(a%ihs;0J;&*@CArD${!EpOR);l6&?O((7TLtB+YjV6dZq%VXZ={0| zzuDw%dX|9CnRBdNl!{uWCf)}e-Dlzrk>3LW&7SdK5jiz$L8V*>tYKQ&N1+xS2CuaS z_%UWl_0gq86cn5}I9eis5FZP;;Rwm|S8w@U3fT&22xcX5d;R z*t&a}99nph5OjcX7{Coh!37b+rE<&2TyQJgR}>c%cid4iG0jF?!rXBGf1h*jow*E9 z*8AK3pU->X%=6rH&-0w;Jm)$4J@?}0U=B04y#g9JgPX-#jmY2zpx6t9O!1JZ4vf@x z=psZ+wv80ibKC8ZT&+QHN@OAUTPWK-w-Vo9&@_+Of_uu@B`>*`P{cA8up+)QIiKHLc zMcpqTe*~s9R?&Dqu~@uc9cw{}XZZao*bWf`wmR2Qu-G`!pyB5gsmsx5vYTR!;e$3U zK18|3^2_}i0^#NSq#A{CwAL{^7sLgIJUfgc!Np<}EgrZR;|rlQm!x-Vv)SUo@c0UY*VTz366?h{0NhFOnmAhy;HxYpn0iZ@Bu&vwOYev)|;2Q#bsIZlat z&}4PObZv~DTMe@w_%mAV_RV4~A9M>m>SlAmC8-u(eq3!W!rTH6x&%IVPj24IJ@6Oz zK$Cm@BkuKYx+hm{+asy!fgXuf@p9dEiHL}_5!bE$0r$XzuJsSNNQ@F|9cxuMZh>?C z^EZZePR!|CKT{=!mk(ojVZUuR0CxLr&1Z%E_5VkAmUg%z|xWnYY#bL43a&?pK#nRGtBl&dpdo z|D)$Bh|l-kmk^WbCJ&6wM{B|4{ep5mUSJnjWp2=TE_>uh3(G^!P%uYo=vfm?jLKX8FQ0jJY8nj z1;ltt4BKVkcU$nw#jnw>jcpvmil({D;iDwm7E8wi+ayBfbKH!5R))V3E; z8@$f~ppETB{KmSWeVT^VFPA`v7Pxl7UYy-V!hx%pW;k$l1U+K7xNG|_ahJ!w?j}*B;N>E+HuU&!;c^0Srk{vd9!E{n0kupYO{o-vC5CNI_S;Wr9FY80ku%aoExxRz< zXNsHK@QZo5Z6Cly+i&rkg87oT;17@`*^Ux;bAdO;ZyVbX{EmS_nO_@m-&i%tHUL+N zwpH=F&pG|Y^$u0U_zv%ToyW15p7ZI@2CHl+Zy3C;OD7%uczBI+c*MqCF8vJkm(BWxN)aq_uwEgMBuiMQ>?bSOi-)Xy&A1tzj0 zrdl++=_Vx@Uj`Kn@CXF3mW_;!r#h!$06cM@6l1fP7C0C27to|9#Z5KQS0JZ$2|tJ^ zUPV&)7OWHCeLzuI1(=eBlXTeCg@Bf1Gi?y=Y`5_Ua=&3N+U)wf+yZS^0uv9+aWl{Z zy%OH%hzB#8T)?Xou;U->-1LF`J+3&gN7OfAQiZZ4M>#%HaOT}2b4p2G_?SDt-!Z8- zzW~aR31fC| z$SXo8okZvw4oz~#ID#YgIgOx&QpBIk5eIX`DF{WYYKl97i_y41S?;$T%L&89+ja%U zcG2PbsETYC$c|mYI&N)j8}cnYr-4N=@p!0N33gu&;J(^v{J2Wkv~KE#L%94FUOX-8 zTEy{D7!0JRLqM8b?F5FYrVR8o*X_YNuH9u^qf%p>DC|iX&2ZD097PS~rm55r#reqm zTBzZ2FGUUGI72HC>YjwXFV=!Pt80!F?|?a8KaMv6p{#{bP_!uu7uVyFwCPoIf-{m- z30B|)drFKv%#5ltqgKoarie$+<>EMd7Qyc$*epjDliN$=PG<6Bob=6hnlPAX4YYO1UYSfpED>d^@r04ygf@&*tMg$xQq+Q zCS%MAKAWOSP|pc&LoAe#r#ZnRLmwjG5_ft*(^sBmSZ%6)N;JT@q(Eg1?R(Z z48R4-%?E3L?BZ=d1}3!+1Iu&!AliaJTPFlVrRA(t+D*^A@Lnl2)`1SS5NWEnJxuX6 z=7Nwafa0dPeQmXSY>jx^T^In{?6>_5fF0T>obWc<#yx2rWr%CHj)RQ@Ox~DX^Ugw& z?JtvM)jUSM_hKca&J?QY)q{1+p}w4*sR%_?#ZDdvHRJ{&20{G1X$16a8j6eHlqv59 zAO&HLQD~l!M>dm6XyeaJ?flvcn3og+&d%B9u7Pi(N3fgDYqID^vhiwBo47GHFIwA8 zY>Xh>KkAl@uaydJOq*$@#dkyOlFuMlP-mt~vQxRZG3A(!=kf9Fu3$@z#$qu>-Q@*3 z96>N1Xu=nPZP3^8zMCkFkp_#YDVfHTzY;7@9zT6qXBy~2Fkwx8+MD_bC87 zl-u=YNHM;hhC}fEbgL{>L9itYPiL63um-4UfsV7V0jSOO%b-uPT>%{D_wZ{sk-N^g zcFTa1QET!z$i>JF*_nx|YU0YJIy*(!!eBSBm-g+bcXqg`){1U zeILG$deHX}E_&fYwgda|*SMdW+PT?_DYmVUJX8epC>PhVb<`^`n$|a3vgzDthQ_%Y zWI^M6m&do#px$KKS7_GiA%vUG1aU5p0fpx71F*w$0XXmQ$zAl%8`<2X$w`tlIZ2Wx zCrOx`Bw=!rgvm(~CMU(-#lTF8&xdYf%UeDBDYpNLcQWC9PrUys<~OLZ7=l-YWcW}8 z4=Q*_&U+CDU=nyUAq%$<6C|!mWxvl!tRL*NtsrHs0E1t4Nw#$pc(nW;f`vThbr)s5 zDIbQFj@YI)lE}(Opyc%ivA>3o&tkOS#I*Sh@#cEF{pInI_P(0MlIm^pY820w0ZHI2k|J}V3`mm$tcV1SqGRb;x0 zIV9dMhD~maMp07e0}AoroM}EXm$-+!Fg#sADcojaor%W*?zyIgud@+)yb&eZ_ImZM3WI;6Ey^OUCJll_@re4Z3%F^@6_{=z-Pj=yt z*6FHv=PFbzC)hGEA3F1pqV6S zCP|x9%&67+H<=o9cg_0#P#_KuAh^h=173IpB*#=$icw@L4@6xMtW7v|d8DH}P$u~B zd7?I(>j6*mrE1{7Y~-oEb(!EghgqR*K!v%0sT3wBukP%JpzB6h6qgya>Q#t_q#bt4 zP-;*#N(A!^lv-<7=;GJcP-^?R)H;F!`alE>l97SYq8PlO1u!2AYXY}ikfMS(e9WZt zsi$zOZ zeACaE7b7pZrqdFVV>&D$MW#JK{=|OJYz$6={lJEzU_)#>{K6KN_#Csas>j7`W*Meg z7MpRGZRQ@DT&5qu*??`prZypK*YThro*92p&iHEl3w(51+BXxmH`&Vs8#{-|KEHWT z6bvdfZ0t-IsDC`FAoIb4Aur0=O}qwP=2CSKMkHHVO+9*}7v-YxDG*_Vxu#bTavc+C z!b_Ju&|&5(qn;+X$VM~_f#eBs@c1zv&)bj@(`eDoooe|d&2FdSQ z7i|l_PhS{A8jJx3fl?}F2*?~ewLKJ?j$-s7Dqa?lQcB;_exTe3=b-$dnW%iUALvU( zKPpP_EVGeYcD!XyUL!?i#nY5Lqd~o&9)ZMVeHWT0p)%s4P^6v6_JdDPOnkxhdmKo3 z3E_7eoE2$jRlo5bBQ(RJdKa3U6ees$onH~{as{;E;%vwn3mxER4Afo={no=mAH1#G)cYPy*RP`zGVTt-QsT0hrDe8>GW1_@E*sysPg9+gSoVW(PUt=us$X^7-b|o{EQ^gBmi~KmS?(GVqUz!_j0)0i?NV8j{cHi;aLFe z^CHn4i(zG&OlYozAe_{V@o{=EhijqCmC&kUEFDl9q;7M(6zwA!8vO}DY$ zU)(4ad-Rj+(cGlN9x*Hk!>|Cmd^q>%mUzHiqaiv5UHEi4TOS^UHa1Y6hps*fs}bT& zN+{0$mrG%3(oA6!s(B;3h@&NVaH%H5AoA9q58r=JI4_3-@IBa-TTaS%H=JF<9Yi zV#X?N7}K9`!R<7kZNeAwVhed*ydO_=<5?pNr1$TJUS624@o*POVsRH+(M68PHh()- ztSn#@nQUtdwg}>34_ZZR@SyB4{)RCq?M@`xW0aA(HAWd_Vk%?RJ)@4``B{FnDG>2R zQJJR-tS#wzD``IzZqI z?!sGm7|_;nlg$lV9*drZe2!C!e-lY0B>$-PUlR|R#zGm6Q}*Ejl1?s(m*j-U74b9C z%|yatd~8m4C-SeP8;^7y?Pl#Wydv6TkuJvSAM-moqzpI~Nzx{&sKR8b6y=dl`LzXR z5g{LIBa?UZ#Jfkt3*PYs1?l@7u=g7uijsqcx!^;F^;~dPpoy|gE!nE+n^0NTj_OAP zMH-gpXLq1?6;{g@p}Z;J-54%+?0K6`!Yakrd664_t*mW1+)Dfd=eyxdOK=xYpV-aL z6lH38Fx9*tY<~U_Z@Rll-~YWMkLo?s!TR2MNXN!ymh|Ix?fGVL!UYdqNpEdZpl^!h7iJu|Mz< z30-sLgfM`2aK%HZIBkccYdpVoJu=8xzP1_EKC^j1&v6V2nCz^?fjP`B(G$TaW6^*{<)AUeIElwc{Bde&l)R2PU`AwG!HC?|qbtVC%F~X6DozW#(KF29(Kj)3XUP&g>v#uCec!3mXuVT z%aXgr4OmtYU7Ttwi3`9LrOXPIjs^ULcIpOp-rkhR@NFPuYZORZU9$TUO)%PN(c=w4 zd7&-MM1Pl!{w@b?DF)191g9!5huk)-H7N5T9;gIjGTrtUNRjDRAnIa6t|ce+hf?{W z>|)WHN1^P{xIhVs$4yU}gVmx1WRkk5V<<`tq|g_mtdkw=k-ka1pO!lctIv9 zn8iY0`IWE+ix#WhYc2O5_#&ANW+uGyk?ioCLqiew2G%&7i!f*KCSH>iH^1kbZp;V@ z1y3iz6DwS$ENFDzDU~tt*qR647``M`*lliRfQ-enl=2NRz~&W~_MAi_#*!)g+zg8V zBg2Y`W#_wGR2>B82ag|7t~EtDa0#+F+#WLRtpL`0;yHO*WHRMR0oP5Pq%uW$Lgz`) zxm2F!`i;Wi7M>6EiU)22L1-RB0MT&y@xmRZY~1|D4@dLMuh)QsGVXnf`h?@=(b%zk z>U8{SXS`Skj|Md{J(++T+%KSoX(9$9Dkkm0L}4Lb>0nv~KG2Q5C~{BG4}(FVePVw6 z6r<@7_~BX@S4;C_@{)1k7cWgURaO=2s<@PqS$g~3gFK4+VW8}3cy zZ1gFX4UKres)}MFD4clu$6ZrR5Md;x$gDAK!f4MTv&Qr)NV{&kKc>w z!fm^xKZh8wU}{HqP_Hmk7l8<+&NU2c1n8Y7{>&ks-~t97ru;aFga{szNM*9Gsb=5Z z%ziw}gj7Ai0&?N}ctHp5*p8##j&XX9=NK?1#TgGzB=w;$>a>VBBw1e$l0$(0CSM33 zb+i3B-;Pe$$q~#z(_gSQHEhq8BDnN7UGg!7Q)mF0XJ;7VQooTZ-Y8a zI~sGFDu0&Fj|V?;d8L;uFFaSQF0U&vgHp?@O1O1-xgZtMm*L$Wcz{8SQm_(`+?mR8 zY4P`WU?#K{Ve62BG^G%{cjdEXHB0#=&l;Ybf@s)5n8Uw*!hB*)9YrRCL ziY8E7tAN677J9zL?<7_DsiVg2l)^KQNw83cnIA~k`7&hM%(qHUTg|U5T!Ylr>E}2~ z*H|5)d>QB0oa#GE;f&)Y2!e+3l)6;^d_m*&8gw2$3OlT=bh3CsSr&XxJsgFd< z;eK8c&a`?J9w*}*C$p~<#{}HkG2Or8SpNS>r!EUlw;5IriaAX1)Xq9S9XgzS;Ow#N zBS$afoLp=IeDAwh8JCmfDH&4=Vfia0kl0*BNJ*PxddIS;iMn`n(tOsqS>tA!LCu;pYx-%E z7N0h4F<28EVbF|d`MK}s%{7fQ{X)Y(Z(cTw|J->A4Ww5)uBY`!e z&kz=XxEkt+*gE`as1GQ#6a(G{nKpnTt-?564Jg79D-5w4Qy@|eLmH*Yjl~J!JRwae zcrhja1|tP6{xrCXz?D%>l|%f&I|xwXs}=EMKquwb3G()#p5#VecYo+gORYg)QoDnwt!NVc@zy=%f;3Z30meKfL|S`V^DHs>q#lUo=7u9PPL>)xXidbS!%sm5B}ia z7-4Ly#U*D8P$&X{u}qD`FKd`fI+UUjR<>Lp$oec^4jS;)p!5Uq$MQsj58JC$c6_fh zLL;G3t|1mlOO{ttnSUe5_22s^C1hhvRF7g8$+4xW z`6w+&>FIx}%0FAGWN%WMjf4gN{q!w-ENNTkyOEr3Ny{xgy?;{HoP>3{omBb#?=A0_ z;a*ZcEHw(p)H>L%)OM7v6AtBAW!-g?>Dh|7H{qJXtyhGo6;gZ4?YmTSx!#wQN3Abz zjU;*Am-#7u!~13#8iButO26+Z)3ZF>3YL_LdnqlAP|5vQ^0idy%O6s4e^Pqtl9n2w zohU1Ylb|n6TPzprO|2;@VQc$pr;>;D9R@0H;mS(05z3;hd%ackWl3e}87y^;MX;9Z zBU!G}+H^@X|Ez{tr=v_XUdHAG`Mn4=#TzVC*dN=x4;jWxr}TIM!Z8i)C#MN-CF ztQn=XYY1w-mL%aTZa<~4;x(LGYsFcYb7%Pmr!S3tf}lmF=N8MN6^o=?VnbkOY)4Wl z2Foc+Bec>+iaZMQL@XY4MFWNk?mU(Z0M6Wa%r%l4Dq@ysCzSTodbFyfS+c)oi!DCt z)4+~+tjD$B<+NY+_)odx390pvo=1_~<4L^)r@$IzU9$bhh_Ne|cQ``%E{{bNOHh}p zWM4*DJGQgntjmj+*V!pEt{&jWsT%Od<*$^qHJvh^Ylhf7Q}YxOS^5nP%7t?f1zyS= zNs(1)Pn7azxh?jxi>rEl&eEe}C7$|EXQK zlGAG{Yg4h$m(9Dy8l-YmTWAzYhVOHWzWyQpbd+N)-qc9{m7A#MlCkqtnVxG8MURSuiTG{)Eb!DnqEm?J3{XtE>u-K zeWm^MZygY#8*XSFX>1)e0$i-iznS2T9sj>ktGSo+LjC3zl-qP(uh7Bjq&7VS^`2Ku zq+Xiqi8KO}dJ^mOmGOFS@Q}uVT(h}#WGgP-uSsnRkLIsr`%6zW!Y~{z;!A$szS*l2+JgY=q?~?U}OP{AmZtpsej*8vT%Y zobs}I`{(_DB6aEIsPxZ&SATydPucxIahqZdRV6=3frLXp!qt>_W^AUsrP`v|{4eRk zzN%-Zh_EoUfo`GUq8(-;7m2jkFSn?hWfscruX0^ej;UPNv$|Haf+w%!bQRXEJVQbw zH36aF{)Um75dTO`c!Va>Xh6rL35*Dj)*2#1Bf>S2QF?uZ!HA$ReW*?wqzMg|2i8M+ zYvn+VF+{8J*Xwnmf&NA&iU~D_X#6!%;h{#{^EZMh(&(?#MM{Bz5kcrXL`ulM{}8PK z5d;&xA!3NZKTLzZBT^Hn^9NLh@l?HcRJbuTOsmlv4A^TTTMZc3B`UAsU!q}JL%3G= znbMq4AFa_d#Gv&L>a2|nG=%C|GLBcSnzVo7%xrLNQ>jk~a_AavBs?GUVjRa|reeX7w~6ROi`hxqFhnnsN@NT-fD-O|$2NRbe) zT1C&E=0dLc5*zM_q*2GL{2-rB$pP6X|6P)gdBLy>}%$ zvaz)x+m4VzftAZquf1VQZ#1t!Rc(5cjR(weiy|rBf%GQP#>f!?NKd8*j4oS#h-D_r6E+AH*0kS)CiUX=|t z9%>o>RflNq2Y5zE16nKD->P6k6_BU&jk0{N+js~$87gUFR$+sqq^~ryX;O@y<0$+T zh~wfVWUTrMRc%%=$2POPUpYN^RC|T0*?dUmYlXH_1*+6rj>Gs&8CUMVYD=%$bS5bj zGFe~Cx-iRREwhpz)}f-ecdOF7rz+9AD35nh9`B+&-en!mEUrV3=6D+|FXRH6^}>9r z*iw~_N=|TXomVBDY89wjbK4SS(-ecrXySEv0~ z`B(E-(^aoX)jL+sw^%9Us#BfnT&+TNPF1Eldn-|$po&z-_zKlwovoGYNi)>{GRk&^ z3(-}0J^bIbx1O#QZKB_(>lMU<>MvFT<=cwC43Y35;k4AJXN--E7fbI zEEL@<(4i7JKtB%9kArMeHi}+)Ls#`)qk8wy?m?gRpwD{HXFbHPhxqjnzpBmaqWx3! zWVS1XzXH`|riA?!RO|0$^rcQiv2%48^XP4{6j4Xi*Xn$$?Mjltm}uGry5t%RLf*dYkjSzFAG=rTEo(0 zSEp?qzcigGag=*63rkB!9aa{uq^HiSlBSwQ3FG(%*rsSVtD@a}740V4&mgp)Mzo*J zD^leXXbTj+3f;d6-(vfpY3Z-o<}(tA&cNrvmu%1EaoeBtPhUUyHYRfk!(F^W##szPs} zk9-S#ZtqU+mUI-Zh%{KZHbfZ8s@jLYOfYKPcE)^eBtFG0us&UL4 zc&=lk*i~um^=p;rHS}-A+HmHfjAayksP(GoQMspFvtA9VK9}3m05xY-IVrR+6Gw@w z&YO}Z*LP28Ud3}N(Wfc4X;+c#Y}S)SA~}8Tn}w}?ZP6*~rngmJ_C{rT19hc%D0pz( znZ-lR_NU0I$frQI8Ps2M-BQB;E>w?4tnE_ar7o+=uM{s^MLxxbo4!U(G3INEF<(=R z`I^F>o5G%(!k(LoF<;FRZN-+|M9+@GHUZ5x{U`12M4Snl2k!`P&cB>~u`!4uQ)%_% zMDe!I{y5$s1fP;3G0iOQFeglyjhol70m|3zyAwt2vCd_0#tpBwJe;EwQ@cfpQ*H*+#>() zI6nuXOYk9Br^*NX;!W5Ea9(p72tNY2AK)RZBgFyd^&}0}mePPT{IWLIe}Ja|R?}e4 z3fvwr1HKS=Cg2tLr@#vV*JCZI0$!=b=kPAUHw4aS@!qM6dbPfgb}r1uzXh0eCv#fkqf# z0M7xegw_Aq!0iFw!~@5vz%_tL@ae!)05`#B0?!9b!CWPq!vWuFN^}ai2VgXOKJYj| zn`YPx0d5aC1HK4&D&QgbO0|(LVB617?}0l4CcxJOo&vZTUIRQ6kk^jt0cZF&d~@I$ zz(FlQ58MxMF}xmlI$*uekze3V0MEcr1J3J2<*{D00JuHi4*12uGXd9N>n59Vz)G!& zaybrQAiN2<9`HN(d%#lxo!g*HfqMW}Ym5CT4dMXS$GT4~;Jp4b6uu#c1D=C#4m=+) z6$cW$fiuj4*8$G~bnSrh0`37g9exb(6u@8L6M*x2PZdY#9k@N z5YVk7(P7{ofd25g90xE9J|B1vplc`Oi{k*!hA-qefZ6ax90#ykXF`L3v;e2WR|TE| zSj!n6xCU?nd_xWg%!Y3XJO{9PSDZ=)ZVwoNHJtvyc`auu{0NQ@_y|4@IIq*Z4Zj$; z2GFh>(JJ8ffX%u?X5fy1%iwPUPY2`|tv&_r2l%NwWP2ZF4cHA{1Ka~J4Za@mbin8y zs5`*p0C&Or0nY(U>k0jH9Kc=hMh*wO3_k|ABgSdh;S+!t0=Dl3opU(gBrnJeJOywo z{9)jkfH&b!aeP3#zL-Y=w+H+T{wnY|z<2r~9&iny5x$7S0q4Tg2Pg}`E%23qX98Y< zw+CJb_(p%!5#Wx169*u_z*7Kk!#CtOfVzRG7r^y^?t_qb;2wZuykUF5;{cZrM!Nw# z9q@f0)E(eW02jf>0nZ0)?F)MY?g+RDegVe^dMd{&z+m{j z!1aKW;SU4n^P>mhPXW&X>>Gsg1?~qp5B?_bRKP><_c#vV2U_T)E@T6&h;^7s!0iD) zgKr4j5ik(GIdDB-GJIR$DS(UM@u4Y72iy(s20RDw7kE$Lg@EPoaF91}d%*YMgMc>y z>=25!6}Thda`@RC2e9H$)N>98oD81^Tr&*1fnN_i z6Yw#7CU9(mkqdk_a1X#|@TWLDjOY(N>M7&HiC#Cr=7DPfBO+n*A0oei$KY!L&jEbL z2%8740Stz3&T#-=iGogm+XF6vcLC04OIt*vZUT1%jDrsW&hQYt5qJ)ueGKjaXXpk$ z4LF}ijf9^KoX@2G2EPD!AzGMGXX1301M#ufaBn&0FMJ~ACEc(+!4?lJ{`CpU?luzjsrLgJ`;E<;5zth;F*BG z!sh@l1T3F`wjH=VU<3Gk;7tHK!JB}400zPr0@nkMhc5!20(b?UJ_a8^kBQI;aE3$S zn*i4XUV(4PaR94KLVkhU1IELL08at@9zF$lI^Zt&IlyxOFT3D>44ertAOVKPMVH3f#U<-gWn6B zz9jk<{xI-VzzguX!1Dncra%wCn*gqwiLwTs4tNs2h~og-&qDduhs=OF_)5U_fZEx( z$2ef6uaI|+0~i2bm%{<4!Z!z=0(c6(E%1E6RbL~&z|#Sfzd?RE4&ViNBgX;cuY8OF z9tXG_K7r!{cAkrN1Gop^&+rR4K498Bc#Z?eU&ToWo&w10GTVVOoC<%K!vQ~82$_KM z`U`&@szL+s1pMJUlrQjf!1q!iGjI*yba*%5DS$)2M|}gX2W+qi@&k_pr!L03SC>G3;C_IgErV?XcLdCXUj;lL@ZB`nFmMf^2|g2eAz9(X?Bq*WLX08atbtwz~%e85cjN}s?U0PTN-2hK1Rz9w*nH{lxsF9dA+6Uqy? zBj9BCw!l*WQ_`V#;F*9Y)}WpP&j;+X7VQ{t55QjQpa7jQ?wUhsv${Q!r<7Xgn0 zTnJAM!3S^+d?nzSfVuGY!1Dp`z}E!M=lEZP*8u0U{7vEO0q67lz2KVw=QI7o;adWa z1Dpfz2s{_5XS*L4X*>957=uL>Mw9Vz=ped9tGP2^oCF2 zaKPrrkOpvGM;Qp8%i)0Q;PZj=J6Nv6S84>E09MUGzJS{UPKB=toYzYZ!`B6#16cV4 z(&IRQUhv+){Q&!)f}D&4eg!`pcq*X(8PqA@yrwY=KAXb31kvcX+XB}EKD+>%0Zw^nBjLvY*8s-DCjd_Y{P-f$1>OWO9)2;00~Wxi11|(@ zdvsvB=Z+b3AUb|GxcL>tOe zg&jrM0)#zPg`Gp#c7&DYuFB!}WcbP?DP9d3)|Fv%8FrDOrwoH-I6{WgWw=;|n`L-d zhQG-0fegz{meQ*(!&)+IEW`FP^pK&C4D~V`E5q3`OqJnU8SaqbK^dNr;Z+&llVQ0j zk{tFjtR=&`GHfox&NA#PL!AucWH?)fX)@d>!-FzBFGG_I@5#_UQA)p_3>{_IUxo%5 zPLbh48K%i_vkVW*@R|%C%dpZ^iT`^tY%aqdGW3z5UWRcpoGHUaGF&Uey)w*~;U6+o zY^(xoj$KU|){~)fzrB3zCPN>q`+E6$f(*Zw;Zm!3|FK_5&;PMsNe}$F@uaNQ{)JTgM3b;l#+9O9{qL||WkT@+seb@PujDi5vm)9uBsd;5n*YMn;} zYR!*WJC6u8dKe-CwULn$eIKL0!5F1?4G)fRl0sDH50sE7g8|Qz%XF?may%(idYoPa z3VDmgMa^93D`-bSOc}rE@f{L>WU$tx;SuJ<>Mgt~e_a>aW9*gieqG2T62&AfR+) zqqA10HI@?Y%qCDWI=N~6qf3cSo`#WSkhn+bjG-MzLR%62LW8uOLi`PoPeDB+%=Zxr zOK>vVfov(#b#J4tlfT{=WzZtns2#!jMVMPe#IPuRm#A=&A4ni72H)u$iVEqk^9qj% z4d<%HVbX>32wXXbM};L+Hd5$N9m*A|WT=~e_>d?Vw{)iqcq?3(f%@8c z1cz`9Qexne`k)jdg4H3gz+viZHb(West!7j5OvB~obGfEj}A3Ng!2&<=^_0{zKLc> z?{ARL&4}30sbomP)Vb>P87b8qiOfwKE`@QzQjm1rTPtdbI+k3sJ4T4SaZ!5d^;$#6 zsNi6c7KgY+#Hd1gYlkQ`Q+k)pO*!r0)uYez}}h$EUN1enhrH4f6@g;_eS zf0XgFX5xZR!OEzAP_(~3RK9@tFXhTpdBm%S>1B1m&6r-=16C?WaR4e;Rm>T&tQA)d zq3M83mkn3}Fdxtsun6!KKzs112v`rW5}+esWx)P`RRHyXuL5G28dnuC6%at>Y^X9A zdvjvNoD{ArBYaF5;nT_pUrNhzvY~o!TCUq>*-*_ImTS**Hk8JOC%dP=;hGIYc8l-gnhi*HZcnZF*DP0@ zKRyXsjDN>+#rb>STFu`Z*J}RSax_p$3^2{=x{`?G_qbh$0 zG%vOc?O1`LdR3#K@TxS*_!f2S)q!-eA5-n7ovHR`uJleDAJPEV0Dr$_PtttRi#}-G z2m9-u^kIjA^k$m?`l!<&Y6M@qV=&d}sHFyOK~%R(C^hIFL9Kh>x>q1I^Bh6WZqDS~ z*@axXcBk(BT&cHDXX@9tFZGXdCf{NGXsBNg8a=EBX-Bw_e_($a64RHWqj2)c+mDq?W1eQ43BZnPxUi;~BM(Uh^nDSA>%@}1g)eCK#m@Dw+SOzBAhQ+gpB zXX3u{qA_3hrtt5*$*{G(V{iO_}FO-+a}dzK`ocOC|%(983w=Xr8dB zKP4_2MDwNxQ!+M9=gkkINfSrVq;Cy0d-fIx&xS`tYK>&DQ64dC;AI4xTmO&gcS z(&9CvDD&H~v~N{3?Oz{DT>{2aXYEvS8Inj{!xG6QB#C;3CQx@>3iTNN6%CA9i~( zkydV-O6%56q#u^frLC)G(AEvJY2m_Dnzk^V7N)JErArpmvQ>*|dD=2svLuauT9!u3 z(pJ-o3GI=n!aZ;&Dk@RzCH9cE!j1lmhPKH+p>S4ojGZgjSZ!JS##;czWKEK@M1cDcq#2d z__^aNY0rTSI-I+O&Yjsv`Nw{w{8JmTR=<}v@65tldM54Oy_>T4?WRMAcGH2ZY`{Zw zYVTgk&E8MPj~=CS2M*Ag<5_e%cQ;+QxSMiM9HC=5$LZwBlazNRhknjINf$0$pv!st z=*ro%l#lDn7tc}NF9+!7YsV@7m&0`B%31g;RB+`Nx^d$M-6{N??%usiMGqd(qoN1& z?AbGZzp7{#{y+Sw;o!idfq&Octl?m9Z};zVp&B(Rzgnf@zs={J8kMV8tWxETe^Z`! zz^78him$4AlYhkVoqs``ij^v6AhyU4Km^SHOuT`)9){Tb>A0;WI0VlF+pHuKq^eZHW)Wk>xQb$_d`wDCO&qU-zk8*1mmN z`?9hC_RX4}RO2;!yG=I~KHwrT;=D1h8~iWHbL+*gBLd;v1ADlOzaBmM3fHgqwB&bc zyk^&VUxC7h<*|}TrJpM!0wdv!kw&<_ec(L%_J>QFHmSyIulMYi1wMH@cV?KKtRzX< ziad8-Tp6KV#%{&;LqDk1xIvS~wQJWKFedw}Y13-{>+J#i1s|bjxy&Rsx8r!XSmieoXusd@)qo82UjE4`ubOjqFU%N7tteJHr6`NA-SE2)bd_J17ea_+I z?9SY~ckjWyi#IOLxV^f&#OL9|$7Xqirp?M`PG&wafxh(?%>Uu=@x#ZDFc)?Y?&TLW z>Ds+tUvs{YF(qe8@k?2=@bPt7@WoF@jvqUI+$3=kj4s}&-KlTietq{9Jbaj!nYS}@ zr(9^VH7Z7QbCX#=bLKBUe2m%Lzkm1M-Mccg`~q872$WR-yFtd(SyRlBOU*1#bo2CK z;BxF3voX8-_wE&Jc)vUN+_?Sd@slS{iZN0Q`}XaJWe%CAMVOzw`(V7E(7InW`p`+<`cT$hhxW%9y`U<%!L2WFr&K{Gv4ph1AHDq z93hZmMdm8Y`I7DMm(2~1!X0BK=gyu5mop{-?%vNT(71XrAI_KHBwHh^S}A*8F@SNE~@zCw-}p{up7BL zb?Vev;m?ALVD$Uy4293LXUqmY!js3$YSfr9`^StKlds}a@P%%7LPAc?iBqS*3Y@@0 z;&>`&LB>b!S+`K`&z?M$_<$4VY*cFYf&Kdz3VGymzrLVde1hb5AI$;36Q_>l)F$%7Df>0yMu=g95}E)AH}bf*RL6M4G9V7PUIXt3c1)Z3uN%r*^}!$ zx&&sSd42*ukV(oID|%?`_lHvVBVUiqdj7SbPC$IZxpTR>C(c2ZQ>WMqcXoM(rduG& z>&X+rMwSTH{dhFch1ZNoX&o+^`k&p9_ZPkBjju4!9yz# zE#f9u$=8**i*@|tb0t2^%gk!|g3r1I2JX87dBEiEOX7XeurF3LpDpeuFkYO43Ne@NfMEpLv6i zk6d1mhzm?EwCHi;)5ga}6_Y0*V(i|m297`O5t^16~LKwN81&Dq>B4nCW@XH8(4bD8_ZqZVw=UGz7cB6v)pEW#N5Y}dgoc90#l?*qS1ez@>U3cN zkSIKS_)j}F?cA{`eQxmBn2}~D{GKF)!hK@f+jo8^eDwEYC&GmXx!L z7r1ul4Ti;Wal;GLeEd61h@Y@He(_@5!4KRj{*zoND68nn6Yji3*4P?Z9^`9+!JtRJ9xM9!)xW*q)ZR}x z<}_#!a|0)KS!fO6UYIk+0y%cj={x9jJc3a2^=pUraQN{PoCf>(F&FldPEnBxN-|^vNi+&_N%nPj8wH@R)2oi}u-$6cEV8Z!Q@^%qsB=}S){|Y)G zvphwr@w^zvOQZX&eS0tM&B{8Jg_#V?AOymXFi2*lG>=NY_`ODm#j*=0;mVa9$PDl& zJJz)DT=ms_l-Q-hr<{&pq^JlyO31_7w>Tw58FG4DEnjevaSanr$Rcj>U{97uO!P|o zxvvW3dEjly-v)xeo40X&lf(atkBW_q-rTTZ-8%l?!2j#kZQQtSJs ze`;sJi&S`_3ePVC&s6b=>mc!olXJ)0MgPG`?3MmU5C1py0E?9zY*j&(dLgd=B%Js0 z9O2{Om3_QoU#?T_<9*TT6KdPN6}21Cj3Rqgr~boUrNFSNG%lznjWE=tjvYV6{#y&` zH0TTR@@`F|``00VpLW>iX+!^N;X&`W^`Z~3pZ9*JAo|2PkQ%#S53lP``UnT&>U9gF zCNBQeyyr0L&__oNdPGuVk4S3Ndki%NZ00$Nn)e?|tp<*z?gL!O*QX0Px_DA&cW>(9 z>p@*TylJ41C;9nyCD%Y_$kvTKqC3$*V<++))tP)^ooPsr3k{3zLNP`c@(c8&*qDCQ zwYQdB`wk;lZv%Dm8A$`QkrXsUOJhcc(5MJKMaLMi$M+UZG`vS~evN7Th^}IfZ_%jk z^uriW8Z^b7d{cVUkV)OhIJrA%r+ZMy+_)y0h? z-Aa5R3wwCO*9Ozr)kc~!sXNV`uCNWEltE;-FH7mQT*C5G;jS#TACV0i_;=$Q>uYdH;tnm8^_XtWyWYRLyPhC!9XDp@g=^Mx}a}&jWl};GUQ$ped znl>$grY0rP%$Z3vb?OZIa>h)WHfsURn)MaU`FaK|m^XvITey(Y<|fkm`4cGhyYJ|$ z?GtJ4qM5XORXlA;n?T=hnn;^ACejbzFTg(CceH8gSG0NiOqxD-8Le3OJxxj7D)#eM zEls86E0@u7-pgCQLhR+G|G1hquU$b~wrrvO%O=zD)k(A;`-Eq=C(?nHUs2BLIkbQ4 z*K}sqdKyVHN7JsGR%(DvnYV&^j2yM7HF+PsO5Y}rgX+qY5jt_1pa z*VnXi-`BKx&)2m5&|=EKe%_AE9h9BDfKI~iL)e)^ODOC3D$0XDux~S+%-l)Gk8GoT zr`Ay3$u)E}JB@xjzM8I|Sx<%MH`5&)npwK}h}ic#x_cKLJ+Mpc`JLRA3A){M^5_9N zowJM19zP=X`mm5uY@bi;@tr$KSFp!-`|@tOmVZI)?O`ci?CGHmLF@3}?q*MF_3xyS zoEWch_~#6gC&y2y_0RYGlBdQey!Xai|1|yNIv7QTVuQO<;&ZB+NFE9^6&r z2mPp3t0EhI@O{SZ+l7UNw==f1X}>JB<;PK8UIoR{m#4Wh2StCEw1b0!T&v7ImVX)! zEBoj3uW!l7_@IlIm)E7c4>{V~03m1Tve*PK3e`ZC;^^XGrgSXi!$ zyP$u19T||bpe}<4s`Oo}Y{*}O_U}BXPv@OE^D`KHY}d7qryl^FOHSmhG8qM(5_`VGTD|VsQGW=bP(<>_#!ip68xmCUW!OYCj zdoSdjQy84i%{!lcXoFo>PX9R^%V1WbT>gswZdI9^o;iB-Ijk<9gA-ZEJ%9f2{%v+$ zWcfu7LRBvsel=<{fdfu_pXXQ zVr*>Yue=1ucJTDU&6^n+XF>nFT>iJ3&PyLTZfq>JW5$dbH*PGu(PKwv?cUnh zjpc{^N+z6<0SO`_qfSIcMP*#Sdq=UK7Hzi=8<+L#m0i1bjbk@qSAE;iF}to^yY}m^*REZ?di57}7qfm^?hYDk2ezZ( zfX&ZMXe-DE54Om!6ygx$h}A~p z5Ow-~5xR(o7@y!4i>HCER_yzds z0s` zt;tl^5{FWge=hgmMSt$@6x}JhUv&RoQPI77Mffc$dRX+N=*h#P`?CK2oZNDE!@8{- z)@|Cb6&@Iz+<#hP{5iJiK87&&x8k>G>-`Nk@Bdx;4TAmFBG7Luy1Ai9qAz7u@bW<@ z|NppuO9LuXeQ`y;*d@d9GPIH4a|M={uAf$vpjeiVlcXsBA1D;@zpe+l=>8J$QsS-cekgJ{oW+6&OT16gBKU8f(M`YVS3in)QvPu3lZqV?bBx+{cqV2YJvytPc+uIEdUr zov3$kH|mLX;r>|1?H`ISnrXYyuo!2GiNcz&)|d3UUKAYVOVPvoP%qywavFg1Ab7dj z;ILQ<2pK|JoCgWj4WkIdFp3$8FMZ=6Y|Mz!6gviIFam4i>_=@%9^HWAN4e6%G4P}M z(xQ>BSS#*F@i+_OjWZyFlDx=!mKO!ZyW{*vcM4AKLm~49P}J966uWc~MXdCv5z9g- zYF#Le{SoWWlU-?Ue0NHo)q}o_?}xQvobQ;A^BrGHYr{(?51>U@7v4P6m*RO{I6egL zsM6A;xgl5=4x~xbMqwQ|kk;_J@YlhVHZzts;RS7pKZMf!?}Krs!${v^t#>ZYZ7joD z@DIxkv~^J|?N~pK4la+NLo1E6f9(j$!P$<+eaBN1ukqA;;6!SLb>QZMunz2>K<=Rv z@jk#Q+!~_~LZXWd;or<;i?`iauZzwwPJMzYw zux`>K(oRYvJGwJL3vuW;}ne-jj zd{-@)LhHYsLW>v9p)WHg(5&q^*O5A%HuC!K=JB*;<7DJ#9?pEsqa8bE(S#X`De=4Y zG#4*tTDoKjr7e}ta`5?$jjNZ?+8&B(Das4XVz7FfNTUUrP9b4D0 z6=yjz7fqxStEW*G)|k(1pF&4g&7$lLU(?C;vuW?zC3I-#6573fIUT@xkj%|#xK5*! zTbEMy#tpP<>pH9lZ@@W?Ep%k-7OV@eryQIG$=~rkP1`+@Qt;xpExa~-WGQVszJg9? zeo5K;=hGSZ%Ll)seFqoQX`Bbi%2|o^VXQS{efUK7R@#3uoqopJ@UMrKlL_HhkEGM} zvm2-|ZwoEmu%EW?$fS(SJ%p(v9XXImcnFV99?qf@M-J2ZgIFIvwTCX8-b;C>j}aDU zus(d8F6LsLI4_S1&Sz3S)`x$|%cb9c-A{$TWYVwl8u86**Tne`%+z`BNi=HzCx5;i z`}seWYkd6Z_gefj;)L;|M!xya4qQx27(M3g8tNl;FD=6KX`{!~`e&pxecY%K4mDpo zDRsoj@uNn({kl5D3SUu{n>T&R=n-$f(W;F5%w{z&CjC*0TRwgC$aibDFO(OXii1B^ z2-?RO-ec`oS=7VQ8b4EX?^<%)yYJR)$4}$%ErdLkp6nJ+rdVj7-nkbtlw%?}KiAjy!pGZKLAu39%)q)wGKiEefpDYUB0WzvC}2z1{59Q$KL&1KQ`3 z&}ONTW6tnBS?1>l2Ey6Dzv6c8aXgBN^`DD*8-JTwy%%UP!^9ea$TB}VE2n(#o<&!F z1O4pl9z4Gkr00MB`RDT|PvmX>qI$PpeU3a;$t>$jq^y#8px65cbC)hXei}=P=fU7a z*2VNX^?R_)>^NnSDwA_T-BW0vA09Zc>WZwTOMf_xMOk(ya&xnOpHt4IH_NPAQ?;b5 z(7rg*&#iUd(rqB+^-Q#!$aU_%8%^u?0Ij0sjT@1&q%u~QxqRKKuG+C}=?}T*a?hOR z#o*H?PM^p+Jm=#cM|d_b9IH!J%I0(rG_1RB>9)vI=a4Ljg+syz>$x9bnc>X3R?5mk zTjkRw+qOlXxp3~x8IiKc^u8mXxa@!W{I|^;H%j&)(iPSWZJA}R(keA3GLjc?v4DSC zBz^wezQgqz?3dG((uT};ek&;W?arMi5Ae!E)ZfQ14peD1KPGbfFPFsX>$x+$2+Xvf zbUz@K5lbx$*Sim`v^3JTL-9;I3qD%~GPtPz< zPfydGr{?_bY1n$n(3tH}QG9MET5{V?Z{7b%Pv}`$DG&*V@u>>W0?2I6Z^wpSEZhn48o`O;#hPH-9L_{nME4cH_lHZWNeLK$E61?N;BVMG1 z)MsOMuV{ptiFAt*55pQ}#4ylW(hbr3^ld!%$Izh}zku-a+3j04%xQ%70JQ4$l;_We z4PPW^pFTG0IV40MGN6Cg#h@OFjrT1-u507QZAlPxRq$KEZ^B(ees$r)!;$ViRk}k$ zhUh~=g8jSBo40sz>f*U=8hP~_*iWP@a;xO{dBAWGGp$9>!66|-Lf8c~YuK=1@zZD?)F38#NfSc-c z|6hC80an$Ot^Z_9jLGC>#+1oK6HVf%8BKId%u6!*f;BkC7`xbF7X(ph8j+%ah$tdW zKtQ@8h>8kG6SxfMTsqdB2pCO{rlW|;esV*zR5S=d~?=i-+jtjYwxqp;oM!; zUjK-hW{gxr3NZ@_2{8`|3kwM|58-8>6IPOJB`W^#;lf3W78}mJ+1Ofc?g&8~Ei^FT zpG1@sB%UixrA5wic{}IdY<$@ITuHJN7V?s`7G_aKmQ42WVaq*wT4!7m zXsL6HcuToYkkt$?N@pc=Q&Rj1(v+)iINh#&d_zi{t*hlC8Hw)SuchBIzcjzyYS~}; z-B$KV#VTXt_^B0N%wje4v--X93neP|kUg$iEu)oH-eRa-1_6JBVq$iQl>@uP=ZPfA z3VE5H$pV_^@wRThxw%=|=eVHAA8K+jPAK-pIH8nxQ|Gt8W^S)8ZJC@)hWO3x!22Lb zx=&Bb#kgR9rrAu|aY2ZHM_SSu7yRqc8R)0~1G?$W!G}ZVqW3oo(QA|``iwTgfPXN4 z%b3L&IBqFE=9pf;39B(+yp`nl`8oYQr_Y)WQ>z)6zmj8fwzDvL;#>@$x`enB^I)`a z5f&OUR*R7djEzlTZn_l9ZDwPcHP4&=2#e)ruw3yYR#~ltwe@NQS?gn?#WV!iPDjWJ zeMH)R54RPw;Y|Jww#L{(-%kfyYk1l%!|b)wVB;|Z+nmN=z1LU-I)4uz`gn>ME890u zg=5fUtnpwx75ZrguNi|dhY8rpF}mOlldywvS9Us0MdW$|>~ft2m$i#Io@D~hwTrOD zehEC?7&|3kF1C1@z-5gE9PDl2vDO^^j>{3kvAWPr#)xy7hu!WAu-n@Ry8=uQ;bwsd zuN92TZi|C~cJL>FMqv12Y~$FScap6XcO_!Sa)icMAb778a^0ukWWYkC`>#O8b{mvL zEJ48@=CP}AWS=drB-rBPiT3!^z!6`~bilCr^yysaBKdSqTgDewbt7 zjCq#pvBcI5=0C25t*t%g+xlY${XFf~ZHBo^FdWye#d?P|aCTk~R~J_VZRWV#mW|lx z<^^w0FKqSQihykaj49)WU>|RU1Oy=_C=fxR+mI5u5uqX55f!oxvC%<@i||9#!60mn zOhjZ@7+=}Zh>r+I+U^+a;n>{%_?_4t8;7|4`;nG-fbmum>9d)Hf@n7=;vA4qFa>42 zE0oEu$WPmV<2+V;h+}st8<3gog_CLSICXFvE~afm#=ad;rNlx>T}M(lM#r(aqQeKJ zI4v6$P8>V)L~5=-4rE0jxiAE2jJuLn%vda$o+!xlKt^sLW3~9Bl;d<~a{`fdG#vS= za2!$WMu9R0Sp_l3E7*mTlrK_6aLg?XB}b!Bs*0wsXC(5Oltt0VD~dre$NkP8+l?&c zUZ@mFNLMA|MBaX!QSHaEtQ06t>_=Ylew-J+po&ObrqAe&++bWTh{dg(7+j_7wd}p9 zI=T;+PQ>Hti9_@iO-A|YB-}iciaSMds5_O6yQPOYE}AZl3FaM5M|L)2#n4Z*wDbs0 zUdTb=@glGfFU5knRh*8WOBJZNkc*m&S<-l5)umiiU(UhBOP4@r3~&(=s&3zwd`9c) z>%k6&^cLXzL;E&(Y;I!wt3sQYn7r1p<6{*)_MnN0;i3-D&c9-rk>Rgk#|k6E7sWg7 z8Oh4n@D-gfTCGynkE2nhCWfzc`g7lQ=Y*7X%SzYQjiWZpUVG(b>*%Achs2h(nqL}8 zP=AR5FSFy-x~jVRhK8!;#=n2rf*Wl}mtV}>Uh{FVwzOX3 zv-R3LOJD8uUVTHO^l6dN;r}=`*3-$luZ@GdgUvf#y1ixp!W$L$1-l6Cpk9{W(4fN~ z`+2{vf3S0lJ3z;x!u8!8+~4)6Z)~JPXr1`e2rYH;MvSLaY9U_cw-1>=~&XNXX94DB1cazj{%Bi8KN75Rz`A&{DqlaqDa-MZ?&uuUB;Bq~K} z<#*T=5R_0*kfo6LQ&V&Dj`>+uNl!-0Na_8?R(>0ofS`yI1qBL0WY5VzR`h|yuYH0H z_Uzfy%I`2~!93+<3KS^w6D)Ry0G{JfwDWobd_2_ZvvMdnVMsuufD zW-0|*^;i63en>=UNN8wSSXe?rLU6*N0%r%Y6266|QlOQ;q3_(#(krE>PB9=?QgU)Z z!R6a_TN|6S_NUYg3bgV!IsIi}>1D}Du1pN1oVXmdy3OS_&7gn||E`Z_ovyxJR!$MY zfAO51b6u0J{^>Jj>hi}<=dyQ>~h&z$Jb-(Tk0-0rcppgf9%*Xy=Pxx(2sj% zW%tS>ZHN9Xmi#*PA4dT#KOM4S_4LLJA3bNs`KwpYZJVh7&EzS9Ux&t0ps7aveh~bB z|G&Y5za2Jw_~?IpG-QMblG9HAci)ejrpw=}*Wg}*2M-=JXwblcUwkoe;K+9RzoURI zf6tyhdwuxfmtPJTK#@V8e(`C0{S;`&-?Qh3q%ZsT@Bb+&w(ZO6JCY9n=-AlZG1@Mo zv@x0&t7D&b{5qC+%4Vy5p2)=M1Aa904E$PFDcAC=JraNUTgxwok~LISBR)?e&Ha7S zY4!0weQIh%8s0~vzuj-n({@{b#pJCgSb%LHE^n9C=Uvj|>6)DGGtzMfP0ntxX3Z&E zE%rj6oIhd*+LNSR@A%8P=%WYDuS`+M7NneMT9f|97V7JI0*;B{ulm zcuRb3V2PQFr(^jl1B{)q6cc7F#E_ZR7(dSnvy7M)TVuhZd04c>2&T)7G23uCj0xVy zL1$R6u*B+B)(ABD3V|zz!Ovy}LRXALxXl>E+D?IoogvoR+F*v$c&zZ?T0(~zjA{8T ze4Iuhkp3Qal%k@}Z0js^(dI2}prCu5((ECg?vj}%S>)7gT@EU?wZ2HV{jr*qRBL^18(umEA+ za}mnepwT|YhzeSQW8Z6Q&PNV6|xA_m(MR02-eq6_>xSvr!R>kzL>cVgXg$FZ;rFH zrtrI^i~+h-!~^xk_hvpYunxo`OGnJH+JxoSPME#g7mftlvv&5z@^t}N;<5v)J$5l3 zs1y62_FO->5gwad;O6cM?=5cdb>Ae#2;Jc3gDsof;p545gg&0w=Fh&Uw>`rBwjnAY zQ1T%;5bTUyJGOG|pfC1vO<}?gf2{M4KsfuLF` zIQ>MFnO;ySy^(pu56ZkioIMhRV)~4n7k(p}{%BSKeMZ>tJYEoi()>`IIJy(33wPnj zu}I{x51Pq7Z2{LL7BiL7kEBp_0H-te;bQK7oXAZ^=E*o@pG_cd63!E7tf)8@SMnlJ zrre1u)Kg78Hz{-V#6gs^-+A*`3d+xriyeE$4dBKY?&(fqkHpQ$UlaMlaYJwqSV^oQxsKLgv6In#gl z2%9-4u-Z_!*B8v_@XA|lj{%mKv}-%W@)B-4FP_=qb=TH|+$!rv46sV|8@#E$_Qnk^ zJ^IOT_KUBbS09stu5k0Bmapl-Pg_=-Ei+r~;_=43=U?@BK)+_mNm%;Q@@*(DU2kmW z?0VLHb+>w z?<`-TU|75OBUWx&eay#(PgC<&X7_gtif^5~CEO0^C{b)@%lmduQrO(wG-mubEnn5& zKRI?s%~*8eRzRnVE%%ptM^F5=g>U$KBTvz@hs&Jr6!{PMQ1G?r8$EH1mhY~f-oS4> zRi`U%skZ44_^{_?U48v0jBdWf`(atve78>@y{`wp_l^Fb_dfq(*yv%p`kM7d3~R3X zO3l}`>qj5;(d)x5&Cp(?G97(QeTNTgzOB|*)1^z-u3dZorT1S*JUrqBP&%t%BL%%{r6R0N9_&KUwtZ7itDYUr{N=1%AjVY+M}h{1z&Y7SDsc^R&$`S zwz9gi_O^Djdeo?^m80|@=#RR(jKgDe^RTqCw6?TdWoc!#%G%OOySYkD;*``e`lXlf zuRAXpf+C#OvTK&|#;?_ReY^a&=DgG$kO~p8W(55=<*oMO7O!2j(YrJ0F=^ZB=)fH< ziC-qouT#$v^YB-;(+7_?Lcd8i_ISY22-bUUg8HVu~-CC+r=pG_@o zu+n-tR@zw*&)OPxHZ}-eJP5wFoR8t0&l;OmFt?`^%1aF6L z;JS4j9JWt}eZ+L`o5Rz^4k4Q?k-MFJ1kR!Ko#Kps(>I_$(?`10n)8BgW4aVSXNn-R^@u!CMe6=3hbsaX8u+ z&Yr>W3fu|$dLSe$0#T8XjE@nG*j-VKb03Ah;o(S#-i3W4UPg2j5>lg(njD3=efvO{ zM=)v@k`Bd#gKapJlmaDVX{Zv`Av<*w^4Sh9N?4ELG&h{!{^_KRC{5Xn>}Ypl;cg?g zEMsaM3PJjTXvW@%=G@F~oTZPnA}$WO^rIGWHPR2Kp)ffKg=}k!c>0IgwoOs)SGR=~ z^u=adSe50CjQs65#(A1!>0UUM6@&|!{;0_E!sSd~sa>3x7s8ksA;@97x}YG8^E8an z&p8_9(P$iF8@VJu3`Lw{Ih7yDxtmD(Uq|3VUIb37cA!)di=x74oKo$=nSz}-r;1`5 zb~i4nVvv0-0y)RRp*+45iW1H(mFz(-=XO+#>ydLL1;v?cQ|BDSDWy8LM@G>>965au z7mLzxjrF;nzXRoL=U>X(i%ZA%v&|cavg7fL$)A85#Ru^7i9}SLN#p!YCX^ZJyj~>= z6^#9nn=QrvD9Fo!svr-=icB0UECgdRGsb@jj-Nb<3#X2QZigu2yiVmwB`VGyyFFuBfl47Zied)q^+`Xbg&81@0mX+e%#WKbW zDaVzcu7S&PapU?m(ESB>swz-hU4>hfcTib%n{DnpxP9ji>h3b#yNl|Yd#JfrOWXi~ z9dHj18fsBnSC3lGAKhzcL|tPu>KpEZ-nqE{pb-rZoBzpnddI)Lpnb7w-zB=ccaGgoG-Si6S$`i3rD z8l~%3j0^H@3q5;oqgYv|lr(ogvh z9Bt=J7&m_Wq`CGVG&ZW`slT(Ne~9*3;`&`~wglsl4)gx&)zF;6qQWLLt9DZy71uvJ zyB!Jr+Cw})cA89S|m|Vs`lJSoOcnPTml83NGGX9akQEG7) z(*oDfMjA88_(y77CmH`p#y=8pOf5)CT3iDe|41yC@sDKuBcka@ zB;y~+_($4yLhESe6Sidhqemf%9(zQ_KYGmghJ5H>V1btZOzLXCE#n_){NrgGG5KT9 zBuL)=@3KSt{|jlKCU}s zmcVL)Y-&7~BnTx<{P|`X|47C^lJSpZ{399vNV^DgG(H zq~M$~{*fj=sf>Rl@Ta(->Yt})>A}f7PqRSFSRyxM{3HC%UTv)Z_+0nCK5bi!6U+EV zGX9Z_f0PUv|47C^dfIQL&N&(XNXHnDi8-%{GcV&GNoYP2*vy?4ECU(;NX9=>N6J(K zFYy^^eKutLBVssFy@}nhnMk>TCkI3{3G2a`ER|gc^=!~ z=*aj-_|5T)?A15+pDyQd_l?Ke+()r5#s&K`&1P!xAC>WsWc(u;|47C^lJSrDR%}Z$ z{*e}+rKqV%#y^trk96>fWc(u;|47C^`b7XF8ULv5PwIcf9{Wl%{!vHG8r6S6uI`^| z*Es%iF8Zk=eb1!rr^@(8GX9Z_es@sDKuBN_il z#y_eR_(n4Rk!U&m`|yuM>*Ph~>#JKSIbB4q$3}~2v-ExocpiheTu$u0{f21y^rw@I z*xUI(U~{H7n>o_nE5Hlr-d(fz5~x#9d)*z|=zghLVH$O7#JL>pw3fCcpw_AObuV zQJWD=uz;FPu@Fni(?jCvkI(2e^d-}0tb?f02b6pc!^pD)%P@!hKe9G+xVNB1|4_V2 z9<9#dJY$Y|Qd!GbrV(XLCEgL3&piu{_0Hk9AwD7JN{ycWya%m1CiAEnwY189M(+Mh z>Kyn=DpS0P7|G)J*}(&u9$od-%@UoBqgqH8LvxNXA$dV!P-80tUCs<2EsBQ zOIri*DO<#IDc2oCDQUt_cge~Nu!4HcsHZ#I&2xDjqK>V{#MO7Fgs8Ky<0rJ1uNKl>qO~lWnQKXWvuDQgT^RyM>Nr)VJ+3$=+>w+FQN7&4*L;IX<1@ n+O&7O^$FrLBt4T8c~(3p=Cp^n($;&}sl!#>9)r3f@;Ck;QRZIb literal 0 HcmV?d00001 diff --git a/installers/cygwin/makeflix.iss b/installers/cygwin/makeflix.iss new file mode 100644 index 00000000..d74615b3 --- /dev/null +++ b/installers/cygwin/makeflix.iss @@ -0,0 +1,128 @@ +; -- makeflix.iss -- +; fgh 2016-08-19 + +#define x86_or_x64 "x86" +#define version "1.0.1" + +#if x86_or_x64 == "x86" +#define exe_dir "Win32" +#else +#define exe_dir "x64" +#endif + +[Setup] +ArchitecturesAllowed={#x86_or_x64} +AppName=Makeflix +AppVersion={#version} +AppPublisher=Lellan, Inc. +AppPublisherURL=http://www.lellan.com/ +AppCopyright=Copyright (C) 2012-2017 Lellan, Inc. +DefaultDirName={pf}\Lellan\Makeflix +DefaultGroupName=Lellan +UninstallDisplayIcon={app}\makeflix.exe +Compression=lzma2 +SolidCompression=yes +; "ArchitecturesInstallIn64BitMode=x64" requests that the install be +; done in "64-bit mode" on x64, meaning it should use the native +; 64-bit Program Files directory and the 64-bit view of the registry. +ArchitecturesInstallIn64BitMode=x64 +; Source Dir is lellan/toolchain/makeflix/windows +SourceDir="..\" +OutputDir="deploy" +OutputBaseFilename="makeflix_v{#version}_{#x86_or_x64}" +SetupIconFile="..\images\Lellan_Logo_20130221.ico" +LicenseFile="..\deploy\EULA.rtf" +DisableWelcomePage=no + +[Files] +Source: "makeflix\{#exe_dir}\Release\makeflix.exe"; DestDir: "{app}"; DestName: "makeflix.exe"; Flags: ignoreversion +Source: "deploy\DLLs\{#x86_or_x64}\Qt5Core.dll"; DestDir: "{app}"; Flags: ignoreversion +Source: "deploy\DLLs\{#x86_or_x64}\Qt5Gui.dll"; DestDir: "{app}"; Flags: ignoreversion +Source: "deploy\DLLs\{#x86_or_x64}\Qt5Widgets.dll"; DestDir: "{app}"; Flags: ignoreversion +Source: "deploy\DLLs\{#x86_or_x64}\Qt5Network.dll"; DestDir: "{app}"; Flags: ignoreversion +Source: "deploy\DLLs\{#x86_or_x64}\platforms\qwindows.dll"; DestDir: "{app}\platforms"; Flags: ignoreversion +Source: "deploy\gstreamer\{#x86_or_x64}\*"; DestDir: "{app}\gstreamer"; Flags: recursesubdirs ignoreversion +Source: "deploy\vc_redist\vc_redist.{#x86_or_x64}.exe"; DestDir: "{tmp}"; Flags: deleteafterinstall +Source: "deploy\bonjour\Bonjour.{#x86_or_x64}.msi"; DestDir: "{tmp}" ; Flags: deleteafterinstall + +Source: "..\deploy\Makeflix_Open_Source_Libraries.pdf"; DestDir: "{app}" + +[Icons] +Name: "{group}\Makeflix"; Filename: "{app}\makeflix.exe" +Name: "{group}\Uninstall Makeflix"; Filename: "{uninstallexe}" + + +[Run] +#define VCmsg "Installing Microsoft Visual C++ Redistributable ..." +Filename: "{tmp}\vc_redist{#x86_or_x64}.exe"; StatusMsg: "{#VCmsg}"; Check: not VCinstalled +#define BonjourMsg "Installing Apple Bonjour support ..." +Filename: "msiexec"; Parameters: "/i {tmp}\Bonjour.{#x86_or_x64}.msi"; StatusMsg: "{#BonjourMsg}"; Check: not BonjourInstalled + +[Registry] +Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "(Default)"; ValueData: "{app}\makeflix.exe"; Flags: uninsdeletekey +Root: HKLM; Subkey: "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\makeflix.exe"; ValueType: string; ValueName: "Path"; ValueData: "{app}\gstreamer\bin"; Flags: uninsdeletekey + +[Code] +function VCinstalled: Boolean; + // By Michael Weiner + // Function for Inno Setup Compiler + // 13 November 2015 + // Modified by Frank G Halasz to handle WOW case + // 23 August 2016 + // Returns True if Microsoft Visual C++ Redistributable is installed, otherwise False. + // The programmer may set the year of redistributable to find; see below. + var + names: TArrayOfString; + i: Integer; + dName, key, year, platfm: String; + begin + // Year of redistributable to find; leave null to find installation for any year. + year := '2015'; + Result := False; + if Is64BitInstallMode then + begin + platfm := 'x64'; + key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall'; + end + else if not IsWin64 then + begin + platfm := 'x86'; + key := 'Software\Microsoft\Windows\CurrentVersion\Uninstall'; + end + else + begin + platfm := 'x86'; + key := 'Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall'; + end; + // Get an array of all of the uninstall subkey names. + if RegGetSubkeyNames(HKEY_LOCAL_MACHINE, key, names) then + // Uninstall subkey names were found. + begin + i := 0 + while ((i < GetArrayLength(names)) and (Result = False)) do + // The loop will end as soon as one instance of a Visual C++ redistributable is found. + begin + // For each uninstall subkey, look for a DisplayName value. + // If not found, then the subkey name will be used instead. + if not RegQueryStringValue(HKEY_LOCAL_MACHINE, key + '\' + names[i], 'DisplayName', dName) then + dName := names[i]; + // See if the value contains both of the strings below. + Result := (Pos(Trim('Visual C++ ' + year),dName) * Pos('Redistributable',dName) * Pos(platfm, dName) <> 0) + i := i + 1; + end; + end; + end; + + function BonjourInstalled: Boolean; + // Returns True if Apple Bonjour is installed, otherwise False. + // Ignores date/version of Bonjour. + begin + Result := False; + // If this key exists, then + // bonjour services must already be installed + if RegKeyExists(HKEY_LOCAL_MACHINE, 'SYSTEM\CurrentControlSet\Services\Bonjour Service') then + // Uninstall subkey names were found. + begin + Result := True; + end; + end; diff --git a/installers/cygwin/medley.iss b/installers/cygwin/medley.iss new file mode 100644 index 00000000..91cad4e5 --- /dev/null +++ b/installers/cygwin/medley.iss @@ -0,0 +1,85 @@ +;############################################################################### +;# +;# medley.iss - Inno Setup compiler script for creating a Windows +;# installer for cygwin and Medley on cygwin +;# +;# 2023-06-03 Frank Halasz +;# +;# Copyright 2023 Interlisp.org +;# +;############################################################################### + +#define x86_or_x64 "x64" +#if GetEnv('COMBINED_RELEASE_TAG') != "" +#define VERSION=GetEnv('COMBINED_RELEASE_TAG') +#else +#define VERSION="local" +#endif + +#if GetEnv('CYGWIN_INSTALLER_BASE') != "" +#define OUTFILE=GetEnv('CYGWIN_INSTALLER_BASE') +#else +#define OUTFILE="medley-full-cygwin-x86_64-local" +#endif + +[Setup] +PrivilegesRequired=lowest +ArchitecturesAllowed={#x86_or_x64} +AppName=Medley +AppVersion={#version} +AppPublisher=Interlisp.org +AppPublisherURL=https://interlisp.org/ +AppCopyright=Copyright (C) 2023 Interlisp.org +DefaultDirName={%USERPROFILE}\il +DefaultGroupName=Medley +Compression=lzma2 +SolidCompression=yes +; "ArchitecturesInstallIn64BitMode=x64" requests that the install be +; done in "64-bit mode" on x64, meaning it should use the native +; 64-bit Program Files directory and the 64-bit view of the registry. +ArchitecturesInstallIn64BitMode=x64 +OutputDir="." +OutputBaseFilename={#OUTFILE} +SetupIconFile="Medley.ico" +DisableWelcomePage=no +MissingRunOnceIdsWarning=no +DisableProgramGroupPage=yes +WizardImageFile=medley_logo.bmp +WizardSmallImageFile=medley_logo_small.bmp +WizardImageStretch=no +UninstallDisplayIcon="{app}\Medley.ico" +UninstallFilesDir={app}\uninstall +UsePreviousAppDir=no + +[Dirs] +Name: "{app}\install"; Permissions: everyone-full +Name: "{app}\uninstall"; Permissions: everyone-full +Name: "{app}\cygwin"; Permissions: everyone-full + +[Files] +Source: "setup-x86_64.exe"; DestDir: "{app}\cygwin"; DestName: "setup-x86_64.exe"; Flags: ignoreversion +Source: "maiko-cygwin.x86_64.tgz"; DestDir: "{app}\install"; DestName: "maiko-cygwin.x86_64.tgz"; Flags: ignoreversion +Source: "medley.tgz"; DestDir: "{app}\install"; DestName: "medley.tgz"; Flags: ignoreversion +Source: "..\win\editpath\x86_64\EditPath.exe"; DestDir: "{app}\uninstall"; DestName: "EditPath.exe"; Flags: ignoreversion +Source: "Medley.ico"; DestDir: "{app}"; DestName: "Medley.ico"; Flags: ignoreversion + +[Icons] +Name: "{group}\Medley\Uninstall_Medley"; Filename: "{uninstallexe}" +; Name: "{group}\Medley\Medley"; Filename: "powershell"; Parameters: "-NoExit -File {app}\medley.ps1 --help"; IconFilename: "{app}\Medley.ico" + +[Run] +Filename: "{app}\cygwin\setup-x86_64.exe"; Parameters: "--quiet-mode --no-admin --wait --no-shortcuts --no-write-registry --verbose --root {app} --site http://www.gtlib.gatech.edu/pub/cygwin/ --only-site --local-package-dir {app}\cygwin --packages nano,xdg-utils"; StatusMsg: "Installing Cygwin ..." +Filename: "{app}\bin\bash"; Parameters: "-login -c 'sed -i -e s/^none/#none/ /etc/fstab && echo none / cygdrive binary,posix=0,user 0 0 >>/etc/fstab'"; Flags: runhidden +Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\medley.tgz"; Flags: runhidden; StatusMsg: "Installing Medley ..." +Filename: "powershell"; Parameters: "remove-item -force -recurse {app}\maiko"; Flags: runhidden; StatusMsg: "Installing Maiko ..." +Filename: "tar"; Parameters: "-x -z -C {app} -f {app}\install\maiko-cygwin.x86_64.tgz"; Flags: runhidden; StatusMsg: "Installing Maiko ..." +; Recreate medley symbolic links (lost in tars) +Filename: "{app}\bin\bash"; Parameters: "-login -c 'cd /medley/scripts/medley && ln -s medley.command medley.sh && cd ../.. && ln -s /medley/scripts/medley/medley.sh medley'"; Flags: runhidden +; Create medley.bat +Filename: "powershell"; Parameters: "write-output \""{app}\bin\bash -login -c '/medley/scripts/medley/medley.sh %*'\"" | out-file medley.bat -Encoding ascii"; WorkingDir: "{app}"; Flags: runhidden; StatusMsg: "Creating medley.bat ..." +Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --add {app}"; Flags: runhidden; StatusMsg: "Adding to PATH ..." +Filename: "powershell"; Parameters: "remove-item -recurse -force {app}\install"; Flags: runhidden; StatusMsg: "Cleaning up ..." + +[UninstallRun] +Filename: "{app}\uninstall\EditPath.exe"; Parameters: "--user --remove {app}"; Flags: runhidden + diff --git a/installers/cygwin/medley_logo.bmp b/installers/cygwin/medley_logo.bmp new file mode 100644 index 0000000000000000000000000000000000000000..9efbe3af85d96a9cf986caa18c870c352c517bff GIT binary patch literal 54054 zcmeI*1+Xkddj??K-QC?K5Znpw?(Xgo++A~V3GVI=A-KD{yE}wGPyViSb?AfGee}^KmRMrpg%|#}7Rus_FTUuai{5F?*Cf9}q^@4g%BggYO9{INUUefHUBUwiE}&4vnp{PBl7O1xvtFTVKV zbI(2Z^UptrI=}q#%bRb$dHe0RUw!q}CgtgO-+dQf4`cY|n{UD$f4yj&FTecqufP5p zZ^jEZpLyn)|E?%@lTJO=_|s26{mwh@gw->tS6_Yg&O7ha`*qh{_s~NRefHUBh8-G& z4aCyj0}niK?X}n5efQml8s`!_ZOg@7cipAC-FM&pKU*jV9B{zgbI*O@g%?`Ys-rSB z9c{VgmUGQD*HlwYHTmR|>vX{d7uLE+<_tk+jP@S1Ds6ZqKhtCV~sWb<)6j8mR)w)6HYh*gH_*Kr=511 z9+5h{?(e6ce!9#u%j~)5o?sbo#tZn@nz@+!zb0kA`R3bdtF6%83aD`M$tN2dU;x9) zE3Z7`j5E$T=bU<9Y_Y|({N$5QhV5YWW}bOw1EzHtpbDF9wizJRTKPDPCN7Z7nC+1! z-i@!|21_ovWG!r%l=iL4xZ{qy-g@hub=Fx3cj~F9uD<%}(@ZlBhGPq8O0|3Mz1ND( zJMX;k;1#T6AckDPSUNiV+m;;=*gMaPLJo>=`j7{eHS^wG~e z^GtUPY}Q$4g#@f7R6r?r7FuYbufP5}+`*>&1SbdtIpCaWrkSky8E2ef43}Pd>GI1j zKkc;B9((Mu>O;tW`|UT`WRrOmUiTL#aR=mLFY%F!H{N(dgX51sK7#&xQXtk)ZHIgA zxo4JHX3;EYz5e>^E3LGWjibBUZo3W6_uY42ukW$P9s%A{OfkiXBaR3#meIaA>7Jmio= z!d~!{JijSai|rI%icZKf9~HtZvM2qC2cCg$RtbIzG)qKQBYHh_Ulu|%nUMPnpfR7l%w z%XQhM2x>4*%!n*MKpsA z+BkW1&_M^83v5g>$s`z25IWu^vg_&_>#x6l?47~C8e|Hz^@t7Y7KZI<5q+Z|-#|5N1fv*cm|^G@7G%Q>H)O3uL&=?0R#_z~OM1s@ zXu_5#OsDQ&yvRhTH+2gQS$E}OgSaF$NJ&J=A2u2htbjzvh&8Q0j)5*TL)Wko6q2xs zV8b-sIrPv&ZMX0iTV}M;Mx(0v8FW$F9pHthgvAUq%s|zQQ?t!Bn;C7t{q_`5 zGVaG8e>7PIY_x`N7;2o3JH}5Pq9di9=3KLb2%zbwpML43mj^;ez&3#dtAR!cXClF7gblli?g~gqX8SOoM;d7)<`34YKD1!J>Rfi& zWqJwNU=L!^mRFlR12hNBhuue_dFB55@5f0j5i7$OR$OsK^)J8t@<4jlx5cE0Dt27J zh8~#@=;(FB&=iS7bY{3sm}W!Rpq~S$2^y`}sT{nLc84yoO?T`v$iyv!vT6$U!h{n} zxb@ashwkeBH67?;$C--(=M?^>Qe_H+GjAz)mMDMN=1xnu1!$z;ao>ISF(+|U6KCMt zK3)&lV75?DZ7XgK*hXuHFb?U?C6`>{jy;ZFsUNVR1!Bc|+5*-Pa!lDB+P+uZF+8+J z4$xvCPdD9k{DB$=8)}mMg)LAyG#Ic!?vP5y9CHlGg5fi5sM9J$-j&X@A#A|B?revv zuDXg{gF1vPv)#NRHXsvsH62v;*K)xvy)o@H=Q?16Tn;{>oSJ3pqV^h9lY&QWux&FV zv6xnXrj7KTQd}(pGaR>Wh3iHhpp|#5HpzL0I?G<+Y zQ%^l*88_HqgPnHTi4y=ruq(BXpzsC&?%*MyWy2bbG2kAw3j_+ib2RaOz$8={JSFhB zrQJkejC!QH}gCg_lk9F!|BLsc8HzT_%b(&p;4KuYPgeiH* znP4n&Hs;79kIY@O)>>-?L0{@>^ljsHu|Z1GTjF7FTx_Ut4CS{4K^b*)5fVf^rc$rN?Nlm*9~EVK}YjpY&KmO zgBqbg2J4_LQ|PNkAeLGi?Sj4_o1W@~G2+ zma#sJsA^$kF@B5qHzW=*`319h_9_d-pw^?bvO1hUTodfC4otkfF7S5F6aEU`nDTll zyJg&)(~lFcYT-%d)hU7vhCdZi!mr2;d~l6wX6#-Xhq5F%Br=wX(3S`0IH5M4&34X6}dv*7Cqeb>my+1IOqP zRChQwe-w@v>C0M?K^l!Xv*Yy=N8{=VZ*iFtlwt=wX?#9(`&gMv(CZjryrWqyaDqwo zr0yCRe~}7E?~yw)@i?VVIpvfSPdt&bO z&#W`WjKHP{Hge`@0asXI1zBt@asxg_P7LuQL{UUD1tWN#qbt%FB#vTG0%5KReNVA0 zG;$v{I7`Kw_=kD0RpT2sJ5hUpR9}=$HRkXOFT4<^gQ<$QYRBL?EoEkkIK#6F0K?6q zeIYgjvyXUMxEb{luwh%tk?=@IiVJ@GGF9J6B7^~vBxSf(S&35sPMzJBm2BpYKvJ9O3Wgv?^@uHwCFhC3N+tCnZ zvp0kd5)DXrV?vNZYg{h$PiO(TfDNF+h+KQBM>*cu6jQFhSm<@JfmPZd@^b&9*>c!n zhlz%_E>jxC1{XRbOAIcg-w;XcAh|Axh}DF`l|+=dgJCv=4X<-Qil&inXpNId)j)cI zdvZBo1Je*bi@QcmnP4&jFtK>En=k5O!?qe~sG(#Un03>I4O<>IQiC^@DH&`~sLX;& zz^g1ApO$cRr6FvfDPAN^f;YyY033-iE+wIQeTW-PKdZ|db4Y<^RXdr zEA&ZolK_xkoc`dps#=HcM_VIy@zqw=p(@{yOOvu_nj{5-)X-4|8}yUG2Ok{yj0e?1 zF<>;MtWpvJHb@H0KaR7OzM%pwg3Ll|IX~Kw%SWGK*N`9)8)Q~&%7uhy17Jy|H@o&a z9~+ph#bKt^EtZrdrKMM`iM3MxG1XSqp%NPu%OE3Svouvv+F++-uz{09FNM(kXgGre z+~SSYhJXz}O*sy=7BX?rupvPRSBXs#TV4Sqc6S_bH(%sq zqxi@r-Em^XbtwK~@tT#`u+EMRQka8SVQOJ<><$)+W;58Ji{gRQCteYhRROUi>HrLq zMSa6hB8FAV-GL+3!UiPBo6?t%Uzjz$g~(tN@xugc&_$_g?&Bo7TN5{)dtMr6zq6Sz8>QacHEXh9&FfQ6zAa4!%mlnrtOD%8i05ZY6U zC9RS+>o3SLDELk@*pN+1uVBEc&)oqDjAHQ91(pR-A=?u+C_;wEailwHi3Go!4q$jn?&A^|I5QTCpu$RG{;1|Hchr|cDPbl6 z!&8C=Wwqv}reH?nDK>B(VI%A%Xus;yTW};65Yq$mA&G*%O~w&nIx-AcrF^PD`V`O9 zEt~E|+V7{>$V`nni6|LuC!=q~S0G1ykjT_eD|o7oJ1I8YM17v~pss}a8gXBVuV*fF zXKXnYGWGlXrvZlo8$KCP%P(4doE_6e9WD!0t2;K?gG2x&q?H^w*dUd7=Fyi{N!*B` zxTxEE|E<8E911@_yRTnhL)b$2L)5s|e$S8t_^AX;*PJ}M%qx{Y89}6yNG?E9NZ1{e z3X-C-=76~)7ni%ntm#pd`F?>7`adp*E{NVSLIkHe-?$#J4tfhuNT~usFVvNS_%CA} zB<%~$v-@byv}pDh2I3%3(}ka*Z2v|X>(Etg!UKJVaV^gZA-HP_O3(Jr!bu-7Wo_Dt zj{LCGnSnskbYb!Ju+buom_OVgys0=jauSaZ%n23M~qYDEyRD4s5w}%T+K+}sfmh>|tjgF^R-wH5| zxkLmCtt6$FY7>tb`pVL zgT!YU<+RrJNBtBVSgtRb$Op!?(lz1ShEhp8a<0<*{OZ!b-LFii!RUC!tv|77hf=~_ z+oas!ppu~-U$>3y;~TO`g+;_|#n;%gLTm;T4=8!j_Z)ObrA&w68m-;rh?7&QJ7%5l zJ4q?Qb*oy$5GX__@Fy{b37KiF)Svwn8&dj>oK1wRaeXW!VAx{*lLvlF3^_i6B_E-6 zUpy|}biwb(WvVGDZS-&lrU-XoQ?!te;jPpw&bc8!T&KRP#z(4-7iBevvm0KdZiU8q zVCZ1F(@5+N=^@$nA8xqebSGA;DR0rvqyh3=>v3=o+oTGqY;S?wH{V89bb7!K`wyp}x4hfngeCO33<%G}Qt{!r>+wh=hSSW)&b76bT*r ziP5?sq*Cz2M#{JtFxVg<#0q_{7!f7i(cEPIOMwoHmca&MNzCANv|Dix#(QRMNf57i zot{aJVS=G7066y-GCd*oqw7K- z*1;R5yR`T6t_KD-EF&91j+SMVu7lQ2qhQ6PdDw;-Y}l%d1#$ z$OxsQI>8M#8FFxF^K9o}LwEQO93n0?qgG$;r#T^JLA8cws+Mrf1j(2Z6j5erYPkf8 zuy&=M=3oQ5j0f9cZaC&pwWDy8bsP_98?($(uTY2F#JdO-VnrTo%3jJqMQF2K*r4!J z+No0I4K-~!W5e3Hj0=lT-=pTK>709@I5y&E1{>&$OXC|<2s9;J$e^@9f^AO2bdZ*M zpnZ`qcaSO72f~m%m9?IO4clDe2duI+n8|5J;o5oL&>d|gSR!7L%81WUP+gEp`r@=P zM^YxW+`|~k_zN2}Vb)*MMG#pwCT-s=EL|CctZXyIMv%*B$E+aM!!p`gzUe_^P*5@F z3^uGh^$#Q{0MdZji45MfpaN9D294C7Rq%6s$0gK zTpJ8OnC@gm2jvIC^+i>d#iaeP0w%?t#qQ)McfboxbGE8_Y`QQQt#HWkX8Kjqv5Y$@ zHrNqP8Q7J4jPbt|!Nxf&I1TUJhFO?)%og#lf16KKf|H4L1>sK;dS$<#YIk!BBggPq9|c zAn>{~Oakq+gBx(NSwll*gBSp@g_#2qT}W!WULv7ovlE46Q22iw;{7r%I05Vh;=uN& z+tYIzEnJaa6s@3-bsihc6AlLo9xIZY(WZ;5go4)GO2PmSRmNwoCU=%7AwKUBM#N&} z1r-@*1>3V|4e&Aj7;oVTK`-ZDn7tSaI7^2uT{eqxvFH$TfyioRJHUutz|mB$s`Vfd+1C=#JPGQMC)2E{+Iw9vhrRmehjl z9c9yH@Ru@L?FEbl zOo!=vdtuxw~jGHAD zjayPY8LO>!`0qCZev*)?^sVPLvrVo)KlYc1%GR>SkjXcC`| z-KoR+CWC0LaXR4wRIn_OVxLW;LZ{*;Q?vD-{TdtWLAoNMFcYNR#f>KA%WUB%O)2}Kv z(zl8)by~9_Y&6$h`c}uT`!zN=f+&ZS4Lr80VrF))2cU z8XJM!v`zB5){0@^#0rHZRLhg*sH~yKGP-MJs13c_UTp9QaFSFOhCr#-Rzp+nRW7&! zZN!GeB%U0Gd8TkZNtWn9Y^dOrd({fAKpU~a_r)j77nByBQc+s@`Bm+Rf`hDEjZ6_q zujE&a-XW@Dq@!-91HM9gvB6m<+LadGAx>8ws`9Ww+vG|TU*N73hG?Y-w#G9i1D^DC zCm687vF~GO9L2tn)?5*OVhdENNpy1jnk&NJQcO+1?xOuo zDg|rBPFk(aSQS2{M z1h_>QGdHXL6tm!a>?^(j8@wEX^{rS#oFsyq{@U?MYMXknt}7YP`WDjBej8@R4jxi0W}`bK8)bAGlF8>|>9 za1yj?6;3nu5mPiX9*zr`$uH7wS+DZ6Wrw=1T3Hr{RGCcUnV&suWELdnXB)90&O%Lf zK%iC;2xB8uVgsRt;NglxKBvg^mRyHBRjnf%Q1VZuo}8I`4;z^U$@$qvY}ECAN!mm~ z2Ykdd)8cC+@+uu7a84~#xFckG*DdnFXgkt-qZLM$<)j*ZFb$zlV)(qi-wYfen5Mr!reC61<%S>sxG4U-`#4 z@N^vMk(~UTz_Miu2Ix$;FRJAfERI>! z!$uKoIEcqN;5!vL#eq#cf$PaPi>Ma0YR1#(wfZd^8{`@QJ0qD>LPA0h8?|WE=zRw^ zc@G>kb`YR$z#^ydva#XVW6+(rPiqz5WpX0E!{3F@S(E<$sJ~!C#-J~5)per!!Vj-( zeXaGbJ&d)OEls0gzN*kA?JwGeZRM~@si=UZq98$N}^rl?!E zyyX0_vg^iS2NGSnVJ@)2uVu?~ARunt;=>5xP(!As*V&l9b5&$gA=V~#@3d5rqNal< zJ!}+N+cwsrT}bkDgu&NQ>K4gePMk^7aMH~e{4(_=@bJVI8C$@H&-E1f8fy6bsZM*? zD6+Qgt-~rTsDDyc<$rRm(@&hW_c`da_@9f32_J2%Tf+ZwAeGA@&4Pura!R+o6YsUw z#ubnO?ti0@Hq1L+`MvkzcVv({L+4A3BwE3u>o!iL*HqhAAYg;7>MOoJ?$=5Y+dbfb N1KK{qUW4fh{4ahnDiHtx literal 0 HcmV?d00001 diff --git a/installers/cygwin/medley_logo.png b/installers/cygwin/medley_logo.png new file mode 100644 index 0000000000000000000000000000000000000000..24c466b676ca8b5674232599cded655a7c15d39f GIT binary patch literal 10272 zcmZ{~WmKEb6E=*yyF+j8Vc-tkXtPs)}Xs8 z>AS-QX8-%Z131`_VV&e2@?Si(T)ujEo4Z-Vd3$?v+c`V9TbjFCbGx|NWS@ysz`@bM zDa*-dgK|!D?OKWEntyKa_rhBd#Doe5qeU}phZpfGY3H!S^TsIGDZgJ34kGKy0>vn( z5fx_$523N+$q;E20cr3)V^tgwlj;l-*&F=A4b(38T*}c zKh-SzB@`e5X~69L3$y;KSn?V#m0Wj7MDiN!Ax{?S1x94zAfDUX(twV=iQGT!p2x8g z*z%PsDu$xp@c6%uvEC68$+MYjXDE~ycX-Xt&Jy`iggCCYCV&4<5)A3ZL8j?OeyHiS zWRKNk_IC(2X#A>HH7jz_ix_8jV~~3Ph7A+`ZD+lVabUE`yRzbfF^oEti+!yUavmWJqrd(Zj;r47TTRx72Nj%%E-Q!U9?G=j2r)z1+@G+g6 zYvfC;=I?K*JUa9ZzPI)Q8Eh&cY#+_rCncZ%7Ji7bP-g%~V3Iai48|74uXP9b`Q998 zfa`VZj7E>`^}a{jNX_2q@EDj|Ot{pB^j zA$>NlVvS9KV^<}X*C3FNs4QYtL8#!-A(B^yBQA?AVnr|L)7Btjg8w}|sm-Q*6dZ6Z zuE5XpZqkxfMHlwFlp;hPp-D@BWRKt1WU(p4?c;j?i5h3J$9&e)8xDp?yqdm;8BM?2 z-^b)h_gjgQW(EYATj{5iP{*RnP!esvZTAE|gTiOS>bM&tTW9C56FDM-d67j#35*ek zy1n^?CzI)7=bijhuiV`a76vWOxwiRp3IPEUVJO(YKW-!>Byj3CFun`mP|-XPG*u42 zJ6+)qc)IDl33&XM?!J>Cv{&jPuN>QnHnY6EoboO%N2TDyRMPVJ1n%zuB<`TZX*{-;yCc;$bl|C?s_ zs*goQTnw%2eILBy(vu4dhasAuAEI#Tf52=m1QX0>Hj|0J+jz~tIhYCygg!AzF~Iz! z7-5Ib@3j1$f|4>$B0+j@V%*y;K%Na(JL5ag{koq^eR%<^ikx-^!u_f{?(Oa9dMq;L z_Q?scJexPHlhg=2i2z^kgKL|=&-(=L4#%vT(Hp~(m*E~&n&+mWag~5EGtGcpGkHx$ zc`D?z++g?Ru*w~zgkQ%ccm?c|*m@}eg$3|jnKg|&-1szA4 zvqzeo*V@f2VS}KpV~V++pdiSa*NW@}lOW9N{#Tm1AKh7y*D(qG86}fWL#}W_{m(7hL6d2dD z6tbqt$)nAbl`*4WQxF|fcwXrdF)6dlW|V2NnFK*^|L1M?GWu|~BE%QH#08GnA}h60 zv>BJ+RZMc&9IawRPhoxkUl3J%bLvjnGcmKtpZtob$0TlIXoisj92=)9aBU;Q9A-76 z-2nky^VC=BdZmo_U*W~SMftGF%SG7z<3(HS-*5a7Od0%xkm?+1(>8ySeeS0a9+?G| zH@fW#od1UB+2eps2@&<$o*wCGuqEMHV-uk;Y!~=!ZV-@@XJ$$rY)NpU4l^EXal`e} z&*4v^$Wxi@Ds#nsO;^BUt`+!Urr8$fOX5LU*#9+BxTdQrSycC6yOsbu*+V3WOC2@L z4X9P!sA;1P#N5q=|Na)9AE;2#fr*Q{KEHbPES;FsGtF(->u76jsVxDK9>4wdt!6@5&#Vi)lhsW+d(BT=I#2G+ zrhz_meMjgS5c?*8(E&fHK;*&~Z%8EszsFf{z$%IxhH4zQH4N&e|b34D4s|^g7SLaqk`6A~CcS zFRncyG~xL{_ZX=CzJD}6yhCc}miU7TKpb!;}8KKoUL|)&oY8 z!-nE(P$${J)N2UZPDbZ$`)hN?f*#U_WbO*Y>EjBdl=^Fz&-K^&AL@M|!#UM~%4;eG zkLp)k;_!gCVLX`t z)9|)`eQeQnvsR)-CYPGP)-}xp^ z;cmQ)#nK)~_RI0M)!@3ld?<{k7Mpij`LXiy-h9O$ES2J7bQ-ElFA)8c|NLICP7nxr zToYfGqK!r|B!Ii=_ckmaFLVIo01gHn~%CitE789)seLF)N{+3cd}^R5y|` zmShu89s4baKOcU%v@k_ILeSxq;2~FcdWePhi>L3>rq|~A-W0Rp+Ij=$56u4K?ianh z=axqlU{lYSaEnyYaKJ_}6lk@+Q`Nlv!H2S7kM8@VzA%(J%~m|teQ+jN4yCPf(5`hU z_<+K_5O3b(p3E5)G}5i&AUJAX1U`QzAOQ%@@8sm`Y&e0k)b2Q-u?0C1l_`|fBb*{9 z)^l&%pGYfMM!K|{@)3Pf;F&JIL!SM=BQ+2 zI;n=o4@*4iHnn#HVtpRvVu<_w_WYwS+`lPcN8vcpCiip@*`4m2%yBDCxz@A6z~^L+ zYKaLaz#@AdhY7c&apOs~7Hmpi!e*431RlFsOjMDae~~-9G34~ko<3d*ufLV+L^xkp zXE#S%uMZIAeQ?FdVPo8hgv{=&I@9c@>>?()`}yU>g{IF*ps(JSa-<-&gKL=hP5bRi zjPtyP+T4)Wwh`G?)5e_k5!lw_ z$IRs87?E8r@7Fr0e)5Dm@Y4XRt9-RH*pIRh3m_n|$&{Wy@b zsNd7&a`-E6ORQW(C4$AAkjQscslJkrBIi&^OUqZ=vE@RJ@BEc+R$ zxmtoRAG{;%y!C1ONq)|$QSACP@V=Os{{5QoWOJ{YZF7z)4}3CZFu~W8KeEN4TY4_ z9JSXyUT5kHJ-J&~yv*teg8`*Gign2hQo@rmck0ZgN-u>J#(c%ECEBPZj8~jR=#55? z1XHQ)dh@7&e~J^sVwQ7v(Y^jzW9K}im97-&ymgk1rng+T1xAeux2$JQ9Qs9830K=h ze2pkeKLQZy8b=|s?xb?9j|ot6i-#;Eaa4brzjxo!c0x+F4UcAqMXlro$=Pfge%(Hj z40y7djutv`)AJvvibO4qsQ9p_JS^oRkB#ll^7nyE93yJJc0C0M|B>V%@m$t(%#(d} zU2SiB1d&>PjGa@;8%OWGq{;VgF_9?=c1X5x*Lc8FzT!($&7Zmh?GrZ-i_qfpX&h<) z>$8=^TgPp3515Y~n`SoYOwulJ8gs)r#xL}N4BH$T9?7;m#*Q;HrVOf0N3y(|2k7?( zs=U-(xzP8$tDbNwW7<~nREOPq%=sEP$P_!rY$?H2KM+Svz{{;IPjv13 zj30tH5R5Z*X<9Zt>|#^D?J&!!nQeQqTWi$17?}<}8izGZ15Ek@7g?e`q2#;W1H6LByogH@8RX@&EwiX|ne3&XD0ksCDz4g$M@;!r z8J8ko%1bn9Y1_b(blTJ8 zcn#)z5=;7j|I0dGgfYv#htsVT{;-i0uDoco({?W}ZDoDL{smku}SHX-l(Gsi~XW@Q;UoxBO4;Ev+BX-!nhd;IG&x8(9 z;On2H^DR}EuVj6XprRa_?pj4gRC)x%Sr|h)6f{KK5r5X+n$)hSSixjsQ-@r94_>I-0`g*N*hJF%46m6I!w>BmnyJr2zT({>BxXG>suI4A@G~?Y3}o^ zm>x)Blhb#8uvpDy=UQaG?KFA$z;J{!2ZGP0wUx$wf|hi5wqTXt20;i63+M7RZXpMn zA5mWA2DupVBcMn4PZ$3XtG(-Jmpne4+CLuJ*L#Xzp=iabL_4})BQ@Bl_w0S?5nOJO zWv_pwteibMb0K$SYlmak_sBL~J3;M4#9}dCUo64Cz}yt*L{=AcjQghYN=Yx?X^Wkc zI1tt0fQNjEoAc?>%QV+=f)~xuYy<6t=&!Thu9)PGFdx-NDlj}LCKk_kw( ztW1%T|EkiRf`^ldPe=wXuCi{sX)i3Nt5d6&S`vyGRgqT)*;PQIjP4&nO6By(ZmHd6VWT8D5 zhx42V)~&ouMB~i7uDZN7k0AEF)R|OUx@YGj%+qUFIosm_oFUMd$wigqzfOUkjVQt- zE|#PFy+4fhamLMSB!c-9c0S^79Sx@Uj`kuPw=&QZ^@Bz!`s;8ZRISMROU%F4OY}N8 zF7tyhFB}R+MV%vRKKDO}(2uPxhC=OjR*CVSv@oJEW{&n`$;d zUi63S30kG>K{>5h0AoAOl@S5m4bw=cYWd4VmmpA54tTs}U z6~A}uvi>2zeALtEwRp_iL6;VLdN172kYWrhO|-w-~#E>s9QE&n|4 zekSoLtnKoZbW6ZzYL% zxv3R?N;}al_d9XyKuPiUtBK%X$23NWALc7jks+tI0bUd|9bd21Ir_5%N&W6h_rwYv zz7`A8&0K`758ha90GK6G(+q=K)qB~F#RRk!A&X0yEgA3xR_^zpRr$r%%HuRwMcn0g&wcY#B@o^3 zs0of=d3YRG5i(-FaI09eo1pY?G+sj3L==WU0_mdN{!L^hX9)ii(sXXi)ll^^P!6q+ z7Lvw8rH`?5EQ@T?!-#&$WLN$<3OctT;w_H2gAXJt+}L2~+rb;4wzG4+?wr9Ti!2!t zi*P+h;V)^++;ndm9GH?=1j? z-ZFIMa+~35Z)wOy3jpWk6pvx7P^lqhYN+{R$lK`ffaMjv8T*SO0Ktp(CnCMHA0V=9 zUzvqV88H9G(;bJzgrz9!y+U7oHQJjW@1+I&UZbl5*SyD}e1UaXQ9!W?I)*Bi%-n>u z3g#x3%sC{5o12(*y?jXwR}0MB^mpH~iN0N*X!2y9AZ{Xk!^N+Y5yzy8sX3v=vAw4+ zBKUl48-uT(F_9~lKAH+8D36+1T+Fy_RvC4tNmf2upf?zFl21L)BR2)mwxangh6BZ}z~l)n>ps*C&2NMT-6f3ZS_LkMH7ahs z>s@}0wo^rn9b=fy&CL*p+4B%75+6~GMRFUG!gOVqN~dLnu!J3QC9g6%l$42tr3zc@D?dL>Wg*h9u168Ow#dLP436?-}e8=6x#D}!Ags~oYW%~vs`~nw(&d`^vroXi!SLe5Cn%xnVVX!O9dv1VWvhhWy;CuwbKSitZ`)g!P`R)Uhk^UsC_#1JuX z#slJ&D8GE=XAf%w9}grN`0jJj9(etbz<9>{gJ4ForPLeyBB=|46kCRxa2O1a!mi2@ zC#Y1|9+u$#F(kS718Cv!$P2}B6;YhVd^P9iT)Tg+JQo~04+3)Lw2Vq>b;J4? zmUQ&d#PTu07&E`O?5Eo&xq2soy4VSQ*207$`GnU`f=X^XC3aD*?(&5=mHFRx7i%rz zPxW#IxT%w^)|D;O<0`F0={ES4AsEM65q8!;F;gzr_RP&>NT8eweCx9q`R1aVy`N+{1zA3c7=-O4WHdvaxfu2=j&kL9rEls{vkevG>sYIcI^Z z&!C8ll<9l@oloy4uoXPU?iRDbe%GXCiVL^7V2hyZS}%v1AX8b49r;qq3sf^fx3_M& z_()TF-wSs%($HsccT)P7ef#8gop*Gi*PbI?`UtCG4>alQZ}LyiFMCESd1p%`32fw;zZ8uOZH5_pc+?g~@kmShx z@%W}Nu2I2HBJp-%?zCl1CP?<~mBDW30w>t$$k)9GJ)Yj({g6(>Ll zlN;FIMcq7N(<`O)cDgLE{N1oE?x~b?LSaDQK3NxFI136C=*Z(=ra>|KaN+V3xiyV` zDOWqg7YydfjlWh*-4$Gj>mPmDdBdtC;las}-^0BGydYPxsk*#hcaagt_)5oN(%6F= zVhnr*a5XG*GhYwCY30|enfsyR-rP4vp*`$ilM&r{n)8ox zpWBeFT}nFZAN!w8^Ci<$9)|5Bcv(>m+Ru{92c1>5f8m6goUXdOp%(sE3t(3gw3!P|JI0d(EiG2ZNh;Y{;RRSI_Wjv6`nU)2X3%VS z)Sj+>{iJj|RVd7nQwHYpl9KC!|0zY^JLYBBF_amy`q8_2mZ;$xM2ioB0RQRIv2qz; z7r8@e2$uFw%p0fYn@n^Asg>j0}0(orMwr-Ux_ zda#Wcq^-)IfR{Uh7o~jTf){WKjTaP55I*-DMssH+?j9hYy4Ndt-$fgQ6c~c`s1FF} zi9SIJ1<_vqgNSs4S6;;MNt67q`TO3?IAXr;;&vo>t_mbsW`5uGP9_S}0Off|%g|b7 zpQYbTb}@NcVx&%@kpwyyQb9n`{C5_i{Eo;8#+XzVRH*3Isn{cTGbBY(NKFy8TfL^q z>*%m@hUPh1sg}efIT{>whV}`T5NrKAsKtO+qtXvIT(%OPfPUY9*{C1tS+G+ru- z#lw3a-ypfL17*{52kHf)G$?AIwrCYjGfR`93OQYe7eH;|`f8EprgUT>nv1$NY`?|8 zxVF0f|wLoo^tp9)CiXPox87><$g zM#Ue{hu5V)OHQyZ((mv02!&4tQ3&beC#XrUm3w2<41q=&0VB z7s&>c?3{Nk3TzASy$!-Z-!vJ_3-29}R3D)~2*_9z){q$~x4xLc&D62;UJ2R!>0O|z zIJG&`bm&Yib5#)RJ^>#;o*gq@@v;aHtm>h9I1l#PpyQaGG2Rb*Q9@ND>p?-UhWO~h z*kB%t{kuz?ZEK{X5MhCp67UF4>b?@Cz){FG{mlyXKCb?sLNs;q^C$qfrFl*QKlZ9t zAa-?dK7tllsm|d--OOU=j?z<6Fq0~25hs)^_WI2+7Ul?ZF4uZsr@;0*Z-a1$`{v~= z^Ga_p`Q({bZx7YEEkX9Y(m;xnjFZAk0!hCR*^n_v`=R4T#fw>mdULg=JkoVvRojS0G6Z#Qc zqokG0W#cDj>W4@lE<_KHga~X`mykX4oaIR9z|)C`UWmZ~-{(h_5IRO2^r-3OagC6) z%-)uU)#y>t(6#d*<9jqF8-H<-Gc$>DJWQvLi!n|f(-4ePW|_FNZ1y~5Q-b@8#TeDk zEgZDKHBYr3jzL;hsl5u95nF&f>Uu-pz~{;mT+wd`4vaWZasjMPo*^?f-N=}|J2uj@ z8a(=1Ja?YYhATB8>rSIdyk#)WG1+xF@74u{P6W9o)Yu3 zPUm|ROKG^EKi*&vU#^k$!cSUaVb{&5GiZ)oUarzbmx^RWqlx_@fh*0K0f8?@M*k3i zxKx$IP}?8Zw=(kGMtFNOh_$HchvN41K42a0P1>VYCZ6H6@m@x0#YZW{#I-%lXUd{! z(1xb0j;|)?B3mKI+*w(zu3qm^KrTLt5G*xet_0y&5xVCexO&5Dkiho+8(<$#?#aX( z;(_M&#Vv{F4A64Wv0yaJue_fFqI6l8qdAb0K0!ppTMOc9=rD*pft1nx^DJ6TC$YMH zB5UXuqiR!Bn+K&PpBr47u(f>d)eb`Mc2mZojw->NXtN_+my3~hXi_lb9)MD3u|0H7 zqY8p@+&{-~%-G3Ie$`fK&Hw#alzC7;yoA?6U$w1PIy|?ZT@n-}Q>QI$jWM%-`N_Wk mRS=lq88 z$@S~kPo6y4ZoD@?a^y(HGIR6h%}kp&Z{Dm~vnYFN>^fq^i1FjcA31VF#OZr#(+wLo zFgCzh43;ikYH?YdIC0|My?g0+MdYSWpYGAAQ>WUuZ~vtq)UB~?+qQqCL=*&8-eV8K zAnAu}GaOoAOw!MsIU`jJ6kK6qrmc8m(zc>MWy%z>5ya7>N4v6}Mf7FGIwDS=4$arE zUrPz^H*MOa7Ks(uHGKGRn%1Wy7!c60W5+N305twzzI^##DLH-m^xCy+@7}$e!w(+V zRuDNM^fDpbHea=B6(9=4)4~?cBL@ z+!A1kIdI@Wcu}&y^y9*X3$$b~&_J;b{vSo_^jT$vdx<$fMKH&(j zh^Ya2{`|Q~Gtd%lU%Yr>fNh8!jo-h2PoEkVFe!NaU^|mN@~$x!@FIPsVo>;>q?9ZGz6I8h^pu~U(F;qyXSEyMS&xiq7x=l-7?pp?m6XL4yMYeN` zbDl~MkeI1(!6@O zj0%}x7j{6j(!)$)r4aIDK%eV)_x$60|0>e5EFZI9MbYZYeNOggOq=#Vzoz2tb1Q&`98rvLd$^osyE0 zv17+dHnjk!O0CXRh$0ODHM7(ja5ZMk7$!>t0V-s|7UMyK1}VtQ1vsS672e{-i`5g; z4A>)Zs*vk|chZG!}YGX%aLstJS1o;J|@g3G^&mVhPpX$PajjTo@-{ zfc)?kn7NfUPqX=ft+^rqyyroW9zBE@ewb_?L7F${-@iYf%oF}GTpC0U(P9%}$X3Rg z`=-rAkxG+g{YyTQ4;8RS_6hWre3TsHD5i;ZI7cZL?ML!(2U1k+VxYo9)S6U_GKXTIB*)gtM^WS`mz)S= zoeRZtj+vQHlQUAUq%kWbfIm9ofrGCaW*Rzj>ULzoEgbco4v2ghb6o&9-L`GpMvWTb%t~X)suZqdKTY67h&5;PxtHOGt{{{WAnwe; zpcCmAA+u;qrNkHh8O0Z?imaOJw_#E+}Wzq_=i=OjoDpAy= zNfZ4DB$8rAysV)K=i^7;zI|CL%5uPoo;`cALS$RFZfz-NHXzZuoz0XT-~o@1pWugU z=gyto(&q~Pbf&SOc^?j{#95WW1_ zfKYMC#}7`|u3eiUa18_S$f0PXMNV{rZj_SWe)46{=6@atjY;NW6mL zaI5kqDO5hzvW12(0ce=XIu?&jdL40DCw@JXXu?cRKa{#nP`N6xe}!u>O3}i*%mt67 zK{WM@Y_C`ckARt1sAc|+QQ=0pC;cCEX=(VduwE>>m3e?smU2x&iYr`6q}VGfGKV8W zKgFP79BwU}=955&aGS5RhAZ4RZ8D00s!yLj*imH?gYrgIQi3sjGzgg^WFX+QSChAp zAP1V76S(i)SQMW#qY{CQr2aP_N0B~^M(l>Wff~%giI@~qY0!ijB13@%l%MDeA`#7U z@RyaL2_}OId!0XET)2rxDjeZtOXs(8DD{0F&eam*%QBeBQj@Fz8-CzI+~uSq&<5;f zmsHV56RzI%@qu%~t*_w#B);kaII8e|govO8zvE!I%r9hq=uiq0p9ro`CLbJ-rgY#C z<6|EAlQWgjVnvDR+A4EB9 zs}%_dz*Fi~f~$}ZM`fGqWlna)K|zad*RGv$t5&TPeC!A62QZD2)r7}h)bChrDLC|l zj)E5wtVP*LNvf&}SK_GPH74gc;&%WC2nPjYKtfp*LOyg0Hu5_JfJ141IL>-kNVIff zpu0$9&@a$6@w=!{ifQ1PV4Z*}dxBQwgXnSK1XO8$z!gUWeaVgA4ZN$ui8ku3kgWna zVcCQq$xTo!j#9u%Aqdkjl7qAcqg;}HU;$}!C_+}QYThe=BrrjeD;H>-#Sd2C93K-- zy+Iu7>ej8>ph1JijT`%!4YUA^ATB3ehkWPlAP(m|E;NwR;*rG<2yq70`(n{HYSgGv zty;C})vMR6S+icfdVfhtty;C})T!g!1>R5@L1IcBKGU`;=xr81?D-oge*G8fAxhB_ z=a^VTALN{%LSeZo1@9Ep>deKn`;n%LVtv9oc4UgqQRp&GGbZykZ$C0${jO$;etcKy v$kso;FC+7?riiONf>ebn#e7s@u=Cien2$VyRD~+Vd{kku^VsUg$;W>HLV4lA literal 0 HcmV?d00001 diff --git a/installers/downloads_page/medley_downloads.html b/installers/downloads_page/medley_downloads.html index 4e81d85d..b2ba6e6c 100644 --- a/installers/downloads_page/medley_downloads.html +++ b/installers/downloads_page/medley_downloads.html @@ -38,6 +38,9 @@

Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines

+

  • WINDOWS 10/11 (Single install based on cygwin - Docker install deprecated)

    + +

    Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for Windows x64 machines

  • macOS 11 (Big Sur) and later - for both Intel and Apple Silicon

    • -

  • WINDOWS 10/11 (Medley running within Cygwin)

    - -

    Not available

    • diff --git a/installers/downloads_page/medley_downloads.md b/installers/downloads_page/medley_downloads.md index cd87f574..d2df64d1 100644 --- a/installers/downloads_page/medley_downloads.md +++ b/installers/downloads_page/medley_downloads.md @@ -34,6 +34,10 @@ [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for ARM64 machines](@@@DOWNLOAD_URL@@@/medley-full-wsl-aarch64-@@@COMBINED.RELEASE.TAG@@@.tgz) + * ## WINDOWS 10/11 (Single install based on cygwin - Docker install deprecated) + + [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@ for Windows x64 machines](@@@DOWNLOAD_URL@@@/@@@CYGWIN.INSTALLER@@@) + * ## macOS 11 (Big Sur) and later - for both Intel and Apple Silicon * ### DMG Installer @@ -43,12 +47,3 @@ * ### ZIP Installer [Release @@@MEDLEY.SHORT.RELEASE.TAG@@@](@@@DOWNLOAD_URL@@@/medley-full-macos-universal-@@@COMBINED.RELEASE.TAG@@@.zip) - - * ## WINDOWS 10/11 (Medley running within Cygwin) - - Not available - - - - - diff --git a/library/UNIXUTILS b/library/UNIXUTILS index d841eb58..ab7a4619 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,12 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Jan-2023 20:36:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;7 5091 +(FILECREATED "16-Jun-2023 13:30:18" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;11 4989 - :CHANGES-TO (FNS ShellBrowser ShellBrowse ShellOpen) - (VARS UNIXUTILSCOMS) - (FUNCTIONS ShellWhich) + :CHANGES-TO (FUNCTIONS ShellWhich) - :PREVIOUS-DATE "18-Jan-2023 13:22:28" {DSK}frank>il>medley>gmedley>greetfiles>UNIXUTILS.;1 + :PREVIOUS-DATE "18-Jan-2023 20:36:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;8 ) @@ -34,14 +32,14 @@ (CL:DEFUN ShellWhich (Cmd) (* ; "Edited 18-Jan-2023 13:19 by FGH") [CL:WITH-OPEN-STREAM (S (OPENSTREAM '{NODIRCORE} 'BOTH)) - (ShellCommand (CONCAT "which " Cmd) + (ShellCommand (CONCAT "command -v " Cmd) S) (COND ((EQ (GETEOFPTR S) 0) NIL) (T (SETFILEPTR S 0) - (MKSTRING (READ S]) + (RSTRING S]) (DEFINEQ (ShellBrowser @@ -108,6 +106,6 @@ else NIL]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (764 1137 (ShellCommand 764 . 1137)) (1139 1538 (ShellWhich 1139 . 1538)) (1539 5068 ( -ShellBrowser 1549 . 4072) (ShellBrowse 4074 . 5066))))) + (FILEMAP (NIL (664 1037 (ShellCommand 664 . 1037)) (1039 1436 (ShellWhich 1039 . 1436)) (1437 4966 ( +ShellBrowser 1447 . 3970) (ShellBrowse 3972 . 4964))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index a54d15618cebee43dd29a9284e9e2eea91636473..98d669df6bdcd66023b1dd50ed0be00ebe277f64 100644 GIT binary patch delta 314 zcmaDa@>*m>e}vd$_|KeL`J>b$vX8Lo8=Z?O~7c z4Fj=FK?Gt&fSRxtquIDEaKHnMVM0RU^-UDW^p delta 311 zcmaDY@?K;@ETj3vcrh;vU9ZGET_Xb{V+A7vD`PV&Ljx{1$6z0Yw9K4Th2)~t#FEq$ zh49prywu{9#7Z3nLkk6>gY20C7S^oTX{xia>iyAb}dG}*e0NP z9WxawW-8>&jGY|Ap~jf8xtYV6(Xf1GY9m+0O!?xOv5_F{&K`~-Av0r5XNu^|Ojier Zu=(gZI|jRo&P*4WS Date: Sun, 1 Oct 2023 23:52:40 -0700 Subject: [PATCH 16/37] UNIXUTILS: Added UNIX-FILE-NAME Produces a Unix filename corresponding to a Medley file name (slashes, version number). For use in ShellCommand an PROCESS-COMMAND. --- library/UNIXUTILS | 56 +++++++++++++++++++++++++++++++++++----- library/UNIXUTILS.DFASL | Bin 3617 -> 4894 bytes 2 files changed, 49 insertions(+), 7 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 89140a37..6eb41003 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2023 15:30:26" {WMEDLEY}UNIXUTILS.;7 7943 +(FILECREATED " 1-Oct-2023 20:52:23" {WMEDLEY}UNIXUTILS.;9 10573 :EDIT-BY rmk - :CHANGES-TO (FNS SLASHIT) + :CHANGES-TO (FNS UNIX-FILE-NAME) + (VARS UNIXUTILSCOMS) - :PREVIOUS-DATE "22-Sep-2023 15:28:19" {WMEDLEY}UNIXUTILS.;6) + :PREVIOUS-DATE "23-Sep-2023 15:30:26" {WMEDLEY}UNIXUTILS.;7) (PRETTYCOMPRINT UNIXUTILSCOMS) @@ -18,7 +19,7 @@ (GLOBALVARS ShellBrowser) (INITVARS (ShellBrowser)) (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT) + (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) (PROPS (UNIXUTILS FILETYPE)))) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -155,11 +156,52 @@ SLASHED (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) SLASHED))]) + +(UNIX-FILE-NAME + [LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk") + + (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") + + (CL:WHEN (\GETSTREAM FILE ACCESS T) + (SETQ FILE (OR (FULLNAME FILE) + FILE))) (* ; "Might catch NODIRCORE") + (CL:WHEN FILE + (SETQ FILE (TRUEFILENAME FILE)) + (CL:UNLESS (STREAMP FILE) + [SETQ FILE (\GETFILENAME FILE (SELECTQ ACCESS + (OUTPUT 'NEW) + (INPUT 'OLD) + (NIL (SETQ ACCESS 'INPUT) + 'OLD) + (\ILLEGAL.ARG ACCESS]) + [SELECTQ (FILENAMEFIELD FILE 'HOST) + (UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"]) + (DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION] + (SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE))) + (CL:IF (AND VERSION (IGREATERP VERSION 1)) + (CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION) + "." + "") + "~" VERSION "~") + FILE))) + (CL:WHEN (AND COPY (EQ ACCESS 'INPUT)) + (RESETLST + (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") + [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE]) + (COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY) + "-" + (IDATE) + "-" + (RAND) + (CL:IF (FILENAMEFIELD FILE 'EXTENSION) + (CONCAT "." (FILENAMEFIELD FILE 'EXTENSION)) + "")))))])]) ) (PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (902 1275 (ShellCommand 902 . 1275)) (1277 1676 (ShellWhich 1277 . 1676)) (1677 7865 ( -ShellBrowser 1687 . 4210) (ShellBrowse 4212 . 5204) (PROCESS-COMMAND 5206 . 5819) (SLASHIT 5821 . 7863 -))))) + (FILEMAP (NIL (963 1336 (ShellCommand 963 . 1336)) (1338 1737 (ShellWhich 1338 . 1737)) (1738 10495 ( +ShellBrowser 1748 . 4271) (ShellBrowse 4273 . 5265) (PROCESS-COMMAND 5267 . 5880) (SLASHIT 5882 . 7924 +) (UNIX-FILE-NAME 7926 . 10493))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index e4054f2c91bcabc25700afb1f4b3b3cf68a664d8..22cbcae65f7748ed6f87b60492e8d91a30190992 100644 GIT binary patch delta 1940 zcmZuyU2GIp6ux(6|GL|jMKO{M!lFVW=@hz4Ly8f1*qz-DOlQ`eS=vpiq%Erj3MC6o zK#E&X6Jj<}9J|gfNTM-5n26FE;}6ncVj{-qix0*Z6B82?UmzM^@tiX)KgR6lo^!wR z-E+>p=iEE*thuytCiiS_)Sj5EjaHM-?;o!wM{CvLW7U1hWVd3C9#c|VQt4!B%l4ks z_Eb8WS8d~dnmu`V-|&gfWOowS6C>3ckW=Z-r6oN*SKe<(JmjY3Z7XLR?PXIRRPwr^ zDW=-5x%=gghyO3mY-8>Djz@U!!Z&h(r}Ew#jrgXrIiQ<4rC72YE$eI&`2b_wn`wlz zhGmyan&)!-H{?Qhue&3d<+^(&sIJ?!jPs*B431h&%Tx?2s~Sqd5_$Kxpu=~$+d}Jj z#T^L!@u1GZt+=yFE~L8MQuyUHLx3~Fr+KS*jt9hE#-ztZg^OYLR`~Ds+8H366O(Qwxa}l|PvgXljTTPe+dn<*2AtyxB$|+ow8?sP%|donop3kdUEdRa<*V zOvP!zj3f@b&FGArN~PT=V##*j&qeUVC6RLnV(R(}vP|4Lp-a+#@=i&L78@vpOw%FyJwo}s00vbHu z@EXzQ5jjoj%#@F~=h_~vPcaECuGfH?HTWrZQEc^^5y1GGjJiJtHuiR=1;ya`zUj;e zTg<$Bg)<)-VPsi&I-|aTl$%WwA9vh8U9C1%A~wi8A}x}PGFE2{JuXin2&p&cGUK6x zKLdfWc%Ki=SMQ;%BEUoa(NA@YeL$d}rpKb+Z#ld4)zC>P#oSEr@tL z6W{sPQtGfWQC_(|aG0@mL|MfSk{nawWAI~A0GoDGNwYO4ZA*<{_Iw6R{<6cw7 zXm1v&(fs=`zkwz+6sac?iLpeYNSz1DGl@}Y(KnO`BTfX|u)CV?uud&LznX9#B7_FN zP20k_kN|RaAk)4`N}S1zvcI}vY-U@9JF*VS!Ol>5M64EqEm_x`fadE@;loXtHhBN z&>cbeG!#rfw;Q2Jcxv{-Q`6N4LtWVcqmuR-51hneo!Wft(2>oDs{6*PCzJ$!A)tSt zYI{_ptT9NMN4zEr(^7&K@o<_aPB$h-ZS$qx;N38Tgim12OEu5 zN4|S+&5>6dPPOUOWHqH&&O=2_s3|$A&7=}DYC1HpTZO-AR<*g&s8zROOdvBs(^+3} z8Zwu~j&xeGx918V(YTnQkHzTN|Ey_Glp)jqE@t73>Fv6s(~HHWd~r@$D3@&0u&2?a z327WudQCDQN86GPdHPK{2PXX~*^_yX!c&NNZC5f1CCh|>*Ks9%wp6wW5w2i`)`otZ z$^jvOoXd|ZW|Nob?cwJW%M2$z&OGoY1n?G9UBn9D9r}Ct*GT;tBfP-)CdSvWz8j3f zc7H0U!{w{UJFjqSC$x#mBdp)>Ub_J!r`tBxH5`j!Yl Date: Sun, 1 Oct 2023 23:54:23 -0700 Subject: [PATCH 17/37] PDF-STREAM: added SEE-PDF A little stub that (on a mac) does a shell command to open Preview on the Unix-named file corresponding to a medley name (Also added back some key functions that got lost in a bad edit) --- library/PDFSTREAM | 94 +++++++++++++++++++++++++++++++++-------- library/PDFSTREAM.LCOM | Bin 4201 -> 5191 bytes 2 files changed, 77 insertions(+), 17 deletions(-) diff --git a/library/PDFSTREAM b/library/PDFSTREAM index 9ec59d23..1534669e 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2023 22:54:26" {WMEDLEY}PDFSTREAM.;49 10763 +(FILECREATED " 1-Oct-2023 20:53:05" {WMEDLEY}PDFSTREAM.;54 13917 :EDIT-BY rmk - :CHANGES-TO (FNS PS-TO-PDF OPEN-PDF-STREAM) + :CHANGES-TO (FNS SEE-PDF) - :PREVIOUS-DATE "23-Sep-2023 15:38:55" {WMEDLEY}PDFSTREAM.;48) + :PREVIOUS-DATE " 1-Oct-2023 15:29:33" {WMEDLEY}PDFSTREAM.;53) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -15,7 +15,7 @@ ((FILES (SYSLOAD) POSTSCRIPTSTREAM) [COMS (* ; "Hook into hardcopy interface") - (ADDVARS [PRINTERTYPES ((PDF) + [ADDVARS [PRINTERTYPES ((PDF) (CANPRINT (PDF)) (STATUS TRUE) (PROPERTIES NILL) @@ -29,10 +29,10 @@ (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) (FONTCREATE POSTSCRIPT.FONTCREATE) (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) - (CREATECHARSET \CREATECHARSET.PSC))) - (VARS (DEFAULTPRINTERTYPE 'PDF)) - (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) - (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] + (CREATECHARSET \CREATECHARSET.PSC] + (VARS (DEFAULTPRINTERTYPE 'PDF)) + (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] (* ;; "") @@ -43,7 +43,8 @@ (* ; "Mac with ghostscript?") (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) (GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) - (FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF))) + (FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF) + (FNS SEE-PDF))) (FILESLOAD (SYSLOAD) POSTSCRIPTSTREAM) @@ -70,11 +71,56 @@ (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) (CREATECHARSET \CREATECHARSET.PSC))) -(ADDTOVAR VARS (DEFAULTPRINTERTYPE 'PDF)) +(RPAQQ DEFAULTPRINTERTYPE PDF) +(DEFINEQ -(ADDTOVAR FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) +(PDFFILEP + [LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk") + (* ; "Edited 5-Mar-93 21:40 by rmk:") + (* ; "Edited 14-Jan-93 10:56 by jds") + (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) + '("PDF") + :TEST + (FUNCTION STRING-EQUAL)) + (CL:WHEN (STREAMP FILE) + (SETFILEPTR FILE 0) + (PROG1 (AND (EQ (BIN FILE) + (CHARCODE %%)) + (EQ (BIN FILE) + (CHARCODE P)) + (EQ (BIN FILE) + (CHARCODE D)) + (EQ (BIN FILE) + (CHARCODE F))) + (SETFILEPTR FILE 0)))]) -(ADDTOVAR P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT)) +(PDF.HARDCOPYW + [LAMBDA (PDFFILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 23-Jun-2023 13:28 by rmk") + (* ; "Edited 6-Mar-2023 22:43 by rmk") + (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY PDFFILE))) + (PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP BITMAP SCALEFACTOR REGION Landscape? TITLE) + PDFFILE]) + +(PDF.TEXT + [LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 1-Oct-2023 15:24 by rmk") + (* ; "Edited 23-Jun-2023 13:23 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION + ROTATION ,(NOT (NOT + POSTSCRIPT.TEXTFILE.LANDSCAPE + ]) + +(PDF.TEDIT + [LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (LET ((TSTREAM (OPENTEXTSTREAM FILE))) + (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF) + (CLOSEF TSTREAM]) +) + +(FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT) @@ -154,7 +200,8 @@ PSSTREAM)]) (PS-TO-PDF - [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 23-Sep-2023 22:54 by rmk") + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 1-Oct-2023 15:18 by rmk") + (* ; "Edited 23-Sep-2023 22:54 by rmk") (* ; "Edited 23-Jul-2023 22:30 by rmk") (* ; "Edited 24-Jun-2023 15:01 by rmk") (* ; "Edited 16-Jul-2022 13:06 by rmk") @@ -167,11 +214,11 @@ (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") (SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE))) + (CL:UNLESS (INFILEP PSFILE) + (ERROR "NO PS FILE TO CONVERT")) (SETQ PDFFILE (if PDFFILE then (TRUEFILENAME PDFFILE) else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE))) - (CL:UNLESS (INFILEP PSFILE) - (ERROR "NO PS FILE TO CONVERT")) (LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE)) COMPLETIONCODE) @@ -210,7 +257,20 @@ (ERROR "Cannot create PDF file for " PDFFILE)) PDFFILE]) ) +(DEFINEQ + +(SEE-PDF + [LAMBDA (PDFFILE) (* ; "Edited 1-Oct-2023 20:47 by rmk") + (* ; "Edited 26-Sep-2023 16:52 by rmk") + + (* ;; "Good for Mac, not sure about Windows etc.") + + (ShellCommand (CONCAT "open -a Preview " (UNIX-FILE-NAME (PACKFILENAME 'BODY PDFFILE 'EXTENSION + 'PDF) + 'INPUT]) +) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3630 10740 (OPEN-PDF-STREAM 3640 . 5818) (CLOSE-PDF-STREAM 5820 . 7107) (PS-TO-PDF 7109 - . 10738))))) + (FILEMAP (NIL (3078 5692 (PDFFILEP 3088 . 4002) (PDF.HARDCOPYW 4004 . 4602) (PDF.TEXT 4604 . 5321) ( +PDF.TEDIT 5323 . 5690)) (6136 13355 (OPEN-PDF-STREAM 6146 . 8324) (CLOSE-PDF-STREAM 8326 . 9613) ( +PS-TO-PDF 9615 . 13353)) (13356 13894 (SEE-PDF 13366 . 13892))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index 78e86fb0fceb4ca18f4e5b00d85ca718d47ab46c..12da811e8efa8c3c6eefca52341c9e2ffa8b2f75 100644 GIT binary patch delta 1567 zcmZuxO^@4D6t$;nXPUOOBf+K%xH76psO_nb*m)I@q8eqZODd+z-QertaB=v}b% z{NROdo3;bC>3fcEdf$I}ukzd$G_=)KtK&PKZ`&F?IU63F9*>Vk!vPGx9-lqG<3mZQ z&Y~EOPC$$MX$q@H4a3l2u>S)0zxB?J)@n54B&A_N38xWgZ^bpar+%>ExnMaR>%nAK z1%3W%3w&14-6ZdqdW09io4^q@Vt2&x%5z!`#3>$Q;79F7GXWFCv;_)R6h#fbz*cF9 z=2SFtDx2$K`pOBeivIj=@JwzBV0348{vLL0cK!}_(d>L3yLdL=@cNe0Y@4VMkCO_Y zS;Z5+E8+2-ecgH5T<^Q_PVqH%Y=T$Ncd2|%SewJxGl-HP%PUMM{umuojyr1 zbl`JZa`1pY<}@plJi~2ZdC=65uhx>ZjcS_|QJAy6M>Tnd-S{E_Cx~4?2JpSc$+_>DQb& ze!2*Cs%#guEJvrwj0c`Wm}k4R;8=hzD%heZ%$}>e*X!sROf8RJ+n|yNZhv^^JZmCzH8E2&^(9^%Kf4ug7!N|@I Z%x%oDhH&J+hvt$dnp8LMPky~Q{SRk6VcGxy delta 466 zcmX@E@ls(zxQLOlZg6UWu91O}v4WA2m8pr9k=ev-eNPihO$9C`WLZNaD?<}2V*@3H zq@vX1{M>@foYWMB)QWKx?i7~<-pfMOTSC6gC2%5#`lDi|7=n;B0IVN|e3*yA7I>Ibq=H#h`ngs-N8 zRX~tyn5Tbeu&xWxL{tL}O|6VAtV~To1~QpgY&K%8WoCEW%G|V(;os!@9HJsgOb(n3 zK(HzwM1q<7ff6?vMK|x{RAyANRB#On@()rlu~6{z1Gzgu!Nfozz|q+o#PM_Vb)Ec= zYlfh)iGq{AOQeF4r9weUnu3wZvOMw9S9`1sOL>3#u~lJG!`p_=hg2vo From 877c6fbf17c588a74c39b31875a93b8ded8fd571 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Mon, 2 Oct 2023 12:36:39 -0700 Subject: [PATCH 18/37] Pick up master changes --- library/UNIXUTILS | 120 ++++------------------------------------ library/UNIXUTILS.DFASL | Bin 4894 -> 2667 bytes 2 files changed, 12 insertions(+), 108 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 6eb41003..ab7a4619 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,31 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 1-Oct-2023 20:52:23" {WMEDLEY}UNIXUTILS.;9 10573 +(FILECREATED "16-Jun-2023 13:30:18" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;11 4989 - :EDIT-BY rmk + :CHANGES-TO (FUNCTIONS ShellWhich) - :CHANGES-TO (FNS UNIX-FILE-NAME) - (VARS UNIXUTILSCOMS) - - :PREVIOUS-DATE "23-Sep-2023 15:30:26" {WMEDLEY}UNIXUTILS.;7) + :PREVIOUS-DATE "18-Jan-2023 20:36:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;8 +) (PRETTYCOMPRINT UNIXUTILSCOMS) -(RPAQQ UNIXUTILSCOMS - ((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND") - (FILES (FROM LOADUPS) - EXPORTS.ALL)) - (GLOBALVARS ShellBrowser) - (INITVARS (ShellBrowser)) - (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) - (PROPS (UNIXUTILS FILETYPE)))) -(DECLARE%: EVAL@COMPILE DONTCOPY - -(FILESLOAD (FROM LOADUPS) - EXPORTS.ALL) -) +(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser) + (INITVARS (ShellBrowser)) + (FUNCTIONS ShellCommand ShellWhich) + (FNS ShellBrowser ShellBrowse))) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS ShellBrowser) @@ -44,14 +32,14 @@ (CL:DEFUN ShellWhich (Cmd) (* ; "Edited 18-Jan-2023 13:19 by FGH") [CL:WITH-OPEN-STREAM (S (OPENSTREAM '{NODIRCORE} 'BOTH)) - (ShellCommand (CONCAT "which " Cmd) + (ShellCommand (CONCAT "command -v " Cmd) S) (COND ((EQ (GETEOFPTR S) 0) NIL) (T (SETFILEPTR S 0) - (MKSTRING (READ S]) + (RSTRING S]) (DEFINEQ (ShellBrowser @@ -116,92 +104,8 @@ " >>/tmp/ShellBrowser-warnings-$$.txt"))) T) else NIL]) - -(PROCESS-COMMAND - [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") - - (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") - - (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) - (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) - of PS)) - 0))) DO (BLOCK) FINALLY (RETURN CODE]) - -(SLASHIT - [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk") - - (* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.") - - (* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.") - - (* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ") - - (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) - 0] - [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) - COLLECT (SELCHARQ C - ((< >) - (SETQ LASTDIRPOS I) - (CHARCODE /)) - (/ (SETQ LASTDIRPOS I) - C) - C] - (CL:WHEN (AND LCASEDIRS LASTDIRPOS) - (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) - (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) - (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) - "")))) - (CL:IF (OR (EQ DIRPOS 1) - NOHOST) - SLASHED - (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) - SLASHED))]) - -(UNIX-FILE-NAME - [LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk") - - (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") - - (CL:WHEN (\GETSTREAM FILE ACCESS T) - (SETQ FILE (OR (FULLNAME FILE) - FILE))) (* ; "Might catch NODIRCORE") - (CL:WHEN FILE - (SETQ FILE (TRUEFILENAME FILE)) - (CL:UNLESS (STREAMP FILE) - [SETQ FILE (\GETFILENAME FILE (SELECTQ ACCESS - (OUTPUT 'NEW) - (INPUT 'OLD) - (NIL (SETQ ACCESS 'INPUT) - 'OLD) - (\ILLEGAL.ARG ACCESS]) - [SELECTQ (FILENAMEFIELD FILE 'HOST) - (UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"]) - (DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION] - (SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE))) - (CL:IF (AND VERSION (IGREATERP VERSION 1)) - (CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION) - "." - "") - "~" VERSION "~") - FILE))) - (CL:WHEN (AND COPY (EQ ACCESS 'INPUT)) - (RESETLST - (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") - [RESETSAVE (GETFILEPTR FILE) - `(PROGN (SETFILEPTR ,FILE OLDVALUE]) - (COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY) - "-" - (IDATE) - "-" - (RAND) - (CL:IF (FILENAMEFIELD FILE 'EXTENSION) - (CONCAT "." (FILENAMEFIELD FILE 'EXTENSION)) - "")))))])]) ) - -(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (963 1336 (ShellCommand 963 . 1336)) (1338 1737 (ShellWhich 1338 . 1737)) (1738 10495 ( -ShellBrowser 1748 . 4271) (ShellBrowse 4273 . 5265) (PROCESS-COMMAND 5267 . 5880) (SLASHIT 5882 . 7924 -) (UNIX-FILE-NAME 7926 . 10493))))) + (FILEMAP (NIL (664 1037 (ShellCommand 664 . 1037)) (1039 1436 (ShellWhich 1039 . 1436)) (1437 4966 ( +ShellBrowser 1447 . 3970) (ShellBrowse 3972 . 4964))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index 22cbcae65f7748ed6f87b60492e8d91a30190992..98d669df6bdcd66023b1dd50ed0be00ebe277f64 100644 GIT binary patch delta 680 zcma)1O=}ZT6rDH8Bu(NX)<~>S^RQ}5+bNk$Qeu$cIGKDj(@DroT7&_K$s`8z0nwCJ z5kEk1G0@g$Wv&#V_zPSp_!GKx)1TnRg&P;HtZ%9t!G(_t_uR{Q=brQS%Gb!w+{K(; zest~5uy1ACqsHKFw%g10tya(4%69(rUEz!=2tj=~9yKl8?)EI)99fO~RtpQu{K|O1 zC*lba3t~o$XM}VxFX`&vwEU>sYHTf1I;M0ByL>vGd=Q2A2Okjfk|TBr<`q@lhul@Ag{AybJC4U&0rWd3pwQM*#Wa^ z)QWYjoZJUY#=h$alaD?LY2=6RGMXY6{85tePd-i}hC$#;x@CI`V%lG%(xEj;tt&dO zmUQDP)$^OHYc5W@xTYJml2%xtIH)T|zN9Mj+IjbEK{1p{o=&GB7N85CT+w97U=S4# zHHZCvW6;9<24?1**UV&b>5%O(^c4@iA-9JaC{Rbti6a^kO2`WYSLp}u#$}_AR&EpVSEG)nVw4MexA$AYUo79n*6RYLlNy)q5?TI(;-RH;0zW{cQ(HQ^$ literal 4894 zcmahNTWlOxb!PVI^&{)BrO{H_O`9~xWY)DE14)b7+1;^s?Ae*^%xq#8m(-58S=;M} z);3N^jGT~)f<`os6EnBCh$18qQj2R43Q1biKa3Fk^rPj655yNA7**l}359dcUB{a= z0?WE{9`|wH=iXfr!h;z-k(rsA9j}zCiJ67@*@gMU%QMx)+{{AtOeyg)&=VI<<<+dN z4lO-b86T~VRL}Pm4Q;UKXu6$z_ISjun|h{N8ksMRB@!L7d1hYje5SK2(fQ1Y?#>gP zU6EeJ*7=UR)9i)mv61sf6CDYdJu?a-;EJQQCEeYTyKi`F(o-`6{GGiwG$Pd6DiXN? zk*FYv-VL{9eq5G^_S%hAQK}u)Nod!j68kpc+ymEC`xK2eu3X*pSsM zl@?0}yj7%x3QA@`=~F$oK{FiH(lxt)6G6PJqonl*8UD0ls}a$2gBOg2N@Ym^)rBwY zX-(Ra>RSXpii&T&gd~g76 zNmpkU=StP5fe9^J6( zbKHfS0n%Y=WO@wn2$|(ndHhTn)w<#OdJWtS&Z{#Rp!*(_8HBTS#m;FCa9hwkJcbM< zuX14mXna(N9e^oeRL>bIsEr_-cU|(_*uzrjhWq&cPDWv!$q+WDrUl`No27}5ua_#) z$KGT`ilF`jX_p4JZ%;*cN85W*rY-tVQ4+V^HJWlknKPM^E9Ogo47xzstAFq~O5qiB!wh09B1^ZfjdcaWXmCQk|k@$d1{@dO^HsThTZLIe?No zklH}?3xbH5ozYFZXn`X|{C9nQ9mjoX&^1!9Ak{M&GfPoVsZLl2FdJ>vK`&z&@jVWN zX4S}=z1$vVVIR{XV8)Q6^rg-0kaz^#*bKT%3$vsKCUv|rGBr9jk{F*(JSdz9qOty6 ziNrZE1S&KcrXfQiRCKw|WW5jp(o=A7w3dijxuyu^@NmJgaz$gHGYu#2-?eaV+fQc2 z<6AP7(#W*DFiS;q4vrM)$Yrq!BoE+bs^|v;1(Y--Bb?U5hVI+@*g8wX?$4s%22&7% zd!8jF|8EdN2qsBYEM(mH5Pl-2WCY7Hx2CiYaDUo#auEO;FBm3N=ZtBoOHvmcZ}W(* z#Rq80<778*CU&lu%khoJ0iU>^Lvcj|k0XpCLP0F;eh>KiIy=I7FiRs;zM^W&Q2w1B zkR~*oKZ)>hfW!F#5Lh$%j-kBR7(Nd`q!uXPk2s(WeX66Hy@0hcxd8~ljA=l`3L^H3 zMJ!GU;d2l785^#568oCyXQ#m}hrlgtWF0Emnsgbw_|{7>2sde5$wgbEytR^kx|wN->B@7hpuTGFW!$Db?CZA2rb^|u48OI)f)Bf;a^=JAVj0MyR4Pt`>zmT zKW}e>gmpWd$!80Slk23$AF5$21}REi&bN%c_Fm(?6hS@LSQS67vgA3Itgz~7mMpNO z!jkQ1R&YhZw6PU6Qo%;M8z&!QOFmrmQx*%c81#)M#NPB=|9o|!gz!~>6LKkm@V7iS zaBjX-otgt;<^1%yv!2_OSS*do@+fuJ7oc369iJcY-0-=vv+~SrY5FTr3jY#IF|>`#zHupXj>&VZIt26lnVjM{tlG_DN7=o| zu1aiLRDcn%bE>X~rabphqNk^QermS8uK!l$#gXdt`1IL1`Ou-{{JHtE=ZZ&0Jy%K` zF%i@VJP0N)&(F`!ooH{5fXNXC5X{->t@)ndRvK@W#JZ-!dtX_u=^0R->Fn%+Yvm1B zD%f0Gh&v%jUvuSn z`Al%DuB7-RvceC1KKj1SG)by2@=#(rC7D&QNCeVQ<_DnYzeaHk9aa$b!MQC3a`E%E z8txNnTZ*+UhXoM5R>Z?lA0(^~Vj~+`XHY4_=(bxth$yTES8~e}lOMJo^p$Ux@08!w zT3bUYgIK3q-rV?-*;09K=XCU%8NC8v&(3w@cBS0~upL3O<&xR*u6|w5KYiy)z8oLE zX-t0b-o|fpp=Oan>Xx!Huw34h2egkSKfK*PIY43)tAAkfLptZhl{_y8gx%66cYv~- zUg?jfCbh|rXhlEqz-b{cjhK<}>LzMbHzIH=bD$eQrb~F2{;u1viG43<*v6M1S zmUx4QHTo?DWg_+CcSM1cMtK(h@+&EYLS$!+J{w2wM-M1#3OT?f_Nc^LHW?T(L!4@=`Rl`KDAjoK^~`>bi@ZMfO-*dP)-7af&iqXD06gE?r{yvm(a zEgNpQ6drzjy-;ujl?*;ts2ce3g69j62XC=s0r3+-@*eTtrST2~Ni(|e?>rX%2rh2M z9q^UVtEqYxnZIUT_<0AIP57kToq)tO+UI=)dGu_~aLNeI9)=FKJKG?Frt4~-q9@_z zeHbsB{JK=Y+h~(x72!~Rcq0(tHLU9>i64*%?!{;C!_)o+v;e)Q5!(i=K^=s4iS|Lt z&w&CLuYD1hSeay(w3pabCf_!()7Gc2Of9IDQH z5Z{o(ee(d3>nKF#0ooh__4xCH_NuSyyad1J<0bfJt;*kFn&5k&x*wyf#`jnSjr9tf z!p}138phZ|S6yJ$8CK<{dVi3N@;*L{{T95NGXMlMe4`&H&eg*}h}1#?Zj)i6{w`3W z@9%B?iLu#zc$tSsPoKdX&~|VEO3Y~}G07YZat{t&p1c17I%o=ljE1Q-91-%ck#df|wCII`O8yN__$C5>*#-U#5+LCNAS6ZH z)z60T2a+c80vQ>fD4+Og2iENV>VaJ#T>I6-#@q9%j~!rN1Z|sY4 Date: Mon, 2 Oct 2023 12:39:25 -0700 Subject: [PATCH 19/37] PDFSTREAM: First implementation (#1260) * PDFSTREAM: first implementation Makes PS file, then applies separate utility (if available) to convert PS to PDF * POSTSCRIPTSTREAM: Adds extra field to postscript data for PDFSTREAM filename * HARDCOPY: fixes printer menu * PDFSTREAM: define PDF fonts as POSTSCRIPT fonts * PDFSTREAM: fix convert template * PDFSTREAM: Fix logic around closing the postscript sub-stream * PDF Stream: slight generalization * PDFSTREAM uses AFTERCLOSE streamprop so doesn't require change to POSTSCRIPTSTREAM * UNIXUTILS: moved PROCESS-COMMAND and SLASHIT from GITFNS and PSEUDOHOST resp. PROCESS-COMMAND executes a command in process-stream, like ShellCommand, but returns a completion code and not what happens in the shell. SLASHIT is an approximation (doesn't deal with versions) of converting a Medley file name to its Unix equivalent, to use in commands * GITFNS: PROCESS-COMMAND moved to UNIXUTILS, cleanups from previous (unexamined) PR The other PR will be cleaned out * PSEUDOHOSTS: Moved SLASHIT to UNIXUTILS, also includes minor change in previous (unexamined) PR, to be removed * PDFSTREAM: wrapped FULLNAME around TRUEFILENAME * Restore POSTSCRIPTSTREAM * UNIXUTILS: Added UNIX-FILE-NAME Produces a Unix filename corresponding to a Medley file name (slashes, version number). For use in ShellCommand an PROCESS-COMMAND. * PDF-STREAM: added SEE-PDF A little stub that (on a mac) does a shell command to open Preview on the Unix-named file corresponding to a medley name (Also added back some key functions that got lost in a bad edit) * Pick up master changes --------- Co-authored-by: Larry Masinter --- library/PDFSTREAM | 276 +++++++++++++++++++++++++++++++ library/PDFSTREAM.LCOM | Bin 0 -> 5191 bytes lispusers/GITFNS | 324 ++++++++++++++++++++++--------------- lispusers/GITFNS.LCOM | Bin 48971 -> 49899 bytes lispusers/PSEUDOHOSTS | 97 +++++------ lispusers/PSEUDOHOSTS.LCOM | Bin 8570 -> 8250 bytes sources/HARDCOPY | 141 +++++++++------- sources/HARDCOPY.LCOM | Bin 47158 -> 47249 bytes 8 files changed, 591 insertions(+), 247 deletions(-) create mode 100644 library/PDFSTREAM create mode 100644 library/PDFSTREAM.LCOM diff --git a/library/PDFSTREAM b/library/PDFSTREAM new file mode 100644 index 00000000..1534669e --- /dev/null +++ b/library/PDFSTREAM @@ -0,0 +1,276 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 1-Oct-2023 20:53:05" {WMEDLEY}PDFSTREAM.;54 13917 + + :EDIT-BY rmk + + :CHANGES-TO (FNS SEE-PDF) + + :PREVIOUS-DATE " 1-Oct-2023 15:29:33" {WMEDLEY}PDFSTREAM.;53) + + +(PRETTYCOMPRINT PDFSTREAMCOMS) + +(RPAQQ PDFSTREAMCOMS + ((FILES (SYSLOAD) + POSTSCRIPTSTREAM) + [COMS (* ; "Hook into hardcopy interface") + [ADDVARS [PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION + ROTATION TITLE] + [PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT] + (IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC] + (VARS (DEFAULTPRINTERTYPE 'PDF)) + (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) + (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] + + (* ;; "") + + + (* ;; "Implementation of PDF streams") + + (INITVARS (PDFCONVERTER 'ps2pdf)) + (* ; "Mac with ghostscript?") + (ALISTS (PDF-CONVERTER-TEMPLATES ps2pdf pstopdf)) + (GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) + (FNS OPEN-PDF-STREAM CLOSE-PDF-STREAM PS-TO-PDF) + (FNS SEE-PDF))) + +(FILESLOAD (SYSLOAD) + POSTSCRIPTSTREAM) + + + +(* ; "Hook into hardcopy interface") + + +(ADDTOVAR PRINTERTYPES ((PDF) + (CANPRINT (PDF)) + (STATUS TRUE) + (PROPERTIES NILL) + (SEND POSTSCRIPTSEND) + (BITMAPSCALE POSTSCRIPT.BITMAPSCALE) + (BITMAPFILE (PDF.HARDCOPYW FILE BITMAP SCALEFACTOR REGION ROTATION TITLE)))) + +(ADDTOVAR PRINTFILETYPES (PDF (TEST PDFFILEP) + (EXTENSION (PDF)) + (CONVERSION (TEXT PDF.TEXT TEDIT PDF.TEDIT)))) + +(ADDTOVAR IMAGESTREAMTYPES (PDF (OPENSTREAM OPEN-PDF-STREAM) + (FONTCREATE POSTSCRIPT.FONTCREATE) + (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) + (CREATECHARSET \CREATECHARSET.PSC))) + +(RPAQQ DEFAULTPRINTERTYPE PDF) +(DEFINEQ + +(PDFFILEP + [LAMBDA (FILE) (* ; "Edited 23-Jun-2023 14:43 by rmk") + (* ; "Edited 5-Mar-93 21:40 by rmk:") + (* ; "Edited 14-Jan-93 10:56 by jds") + (OR (CL:MEMBER (UNPACKFILENAME.STRING FILE 'EXTENSION) + '("PDF") + :TEST + (FUNCTION STRING-EQUAL)) + (CL:WHEN (STREAMP FILE) + (SETFILEPTR FILE 0) + (PROG1 (AND (EQ (BIN FILE) + (CHARCODE %%)) + (EQ (BIN FILE) + (CHARCODE P)) + (EQ (BIN FILE) + (CHARCODE D)) + (EQ (BIN FILE) + (CHARCODE F))) + (SETFILEPTR FILE 0)))]) + +(PDF.HARDCOPYW + [LAMBDA (PDFFILE BITMAP SCALEFACTOR REGION Landscape? TITLE) + (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 23-Jun-2023 13:28 by rmk") + (* ; "Edited 6-Mar-2023 22:43 by rmk") + (LET ((PSTTMP (PACKFILENAME 'EXTENSION 'TMPPS 'BODY PDFFILE))) + (PS-TO-PDF (POSTSCRIPT.HARDCOPYW PSTTMP BITMAP SCALEFACTOR REGION Landscape? TITLE) + PDFFILE]) + +(PDF.TEXT + [LAMBDA (FILE PDFFILE FONTS HEADING TABS) (* ; "Edited 1-Oct-2023 15:24 by rmk") + (* ; "Edited 23-Jun-2023 13:23 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (TEXTTOIMAGEFILE FILE PDFFILE 'PDF FONTS HEADING TABS `(REGION ,POSTSCRIPT.DEFAULT.PAGEREGION + ROTATION ,(NOT (NOT + POSTSCRIPT.TEXTFILE.LANDSCAPE + ]) + +(PDF.TEDIT + [LAMBDA (FILE PDFFILE) (* ; "Edited 23-Jun-2023 13:22 by rmk") + (* ; "Edited 7-Mar-2023 08:39 by rmk") + (LET ((TSTREAM (OPENTEXTSTREAM FILE))) + (TEDIT.FORMAT.HARDCOPY FILE PDFFILE T NIL NIL NIL 'PDF) + (CLOSEF TSTREAM]) +) + +(FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT) + + + +(* ;; "") + + + + +(* ;; "Implementation of PDF streams") + + +(RPAQ? PDFCONVERTER 'ps2pdf) + + + +(* ; "Mac with ghostscript?") + + +(ADDTOVAR PDF-CONVERTER-TEMPLATES (ps2pdf " " PSFILE " " PDFFILE " 2> " ERRORFILE) + (pstopdf " " PSFILE " -o " PDFFILE " 2> " ERRORFILE)) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS PDFCONVERTER PDF-CONVERTER-TEMPLATES) +) +(DEFINEQ + +(OPEN-PDF-STREAM + [LAMBDA (FILE OPTIONS) (* ; "Edited 23-Sep-2023 15:38 by rmk") + (* ; "Edited 22-Sep-2023 11:04 by rmk") + (* ; "Edited 24-Jun-2023 14:49 by rmk") + + (* ;; "Open a temporary PS file, but set it up so that at closing it gets converted to PDF using an operating-system utility (if available), and then gets renamed to the original intended filename.") + + (* ;; "We have to stash the original filename someplace. We could put it in the tmp filename and then parse it out, but then we would have to worry about how unix filenames might parse against our {, }, etc. ") + + (* ;; + "Simplest thing for now is to just add an extra field at the end of the \POSTSCRIPTDATA record.") + + (* ;; "") + + (if [AND NIL (EQ 'LPT (FILENAMEFIELD FILE 'HOST] + then + (* ;; "If FILE is on the LPT device, we could just ssume that it can be printed directly, no point in converting. But then we would alo have to lie and give it a PDF extension so it thinks that we are heading to a PDF printer.") + + (OPENPOSTSCRIPTSTREAM FILE OPTIONS) + else (CL:UNLESS (OR (ASSOC (OR PDFCONVERTER (MKATOM (UNIX-GETENV "MEDLEY-PDFCONVERTER"))) + PDF-CONVERTER-TEMPLATES)) + (ERROR "POSTSCRIPT-to-PDF converter is not specified")) + (SETQ FILE (OR (AND (NEQ FILE T) + (OUTFILEP FILE)) + (ERROR "PDF target file not found" FILE))) + (LET ((PSSTREAM (OPENPOSTSCRIPTSTREAM (CONCAT "{UNIX}/tmp/medley-pdf-" (IDATE) + "-" + (RAND) + ".ps") + OPTIONS))) + (STREAMPROP PSSTREAM 'AFTERCLOSE (CONS (FUNCTION CLOSE-PDF-STREAM))) + (STREAMPROP PSSTREAM 'PDFTARGETINFO FILE) + PSSTREAM]) + +(CLOSE-PDF-STREAM + [LAMBDA (PSSTREAM) (* ; "Edited 22-Sep-2023 11:18 by rmk") + (* ; "Edited 24-Jul-2023 10:37 by rmk") + (* ; "Edited 17-Jul-2023 22:32 by rmk") + (* ; "Edited 24-Jun-2023 13:57 by rmk") + + (* ;; "PSSTREAM is a postscript (maybe in tmp) rendition of what is intended to end up as a pdf. If we are going directly to a printer, we can probably just pass it along without worrying about conversion. In fact, in that case we probably should not have bothered even setting up the PDF stream.") + + (* ;; "But for a file we execute the PDFCONVERTER as a shell command to make a pdf, and then we rename it to the intended filename") + + (STREAMPROP PSSTREAM 'AFTERCLOSE NIL) (* ; + "Maybe just remove only CLOSE-PDF-STREAMfrom the list?") + (LET ((TARGETINFO (STREAMPROP PSSTREAM 'PDFTARGETINFO NIL))) + (CL:IF TARGETINFO + (RENAMEFILE (PS-TO-PDF PSSTREAM) + TARGETINFO) + PSSTREAM)]) + +(PS-TO-PDF + [LAMBDA (PSFILE PDFFILE DONTDELETE) (* ; "Edited 1-Oct-2023 15:18 by rmk") + (* ; "Edited 23-Sep-2023 22:54 by rmk") + (* ; "Edited 23-Jul-2023 22:30 by rmk") + (* ; "Edited 24-Jun-2023 15:01 by rmk") + (* ; "Edited 16-Jul-2022 13:06 by rmk") + (* ; "Edited 8-Jul-2022 10:20 by rmk") + (* ; "Edited 7-May-2022 22:40 by rmk") + (* ; "Edited 7-Oct-2021 11:15 by rmk:") + + (* ;; "PSFILE is the name of a closed PS file on a DSK/UNIX device. This function uses the PDFCONVERTER utility to convert that to a parallel pdf file, which is then renamed to PDFFILE. ") + + (* ;; "DONTDELETE is just for debugging, keeps the /tmp/ files") + + (SETQ PSFILE (FULLNAME (TRUEFILENAME PSFILE))) + (CL:UNLESS (INFILEP PSFILE) + (ERROR "NO PS FILE TO CONVERT")) + (SETQ PDFFILE (if PDFFILE + then (TRUEFILENAME PDFFILE) + else (PACKFILENAME 'EXTENSION 'pdf 'BODY PSFILE))) + (LET ((ERRORFILE (PACKFILENAME 'EXTENSION 'error 'BODY PSFILE)) + COMPLETIONCODE) + + (* ;; "PROCESS-COMMAND is currently from GITFNS. Not sure whether ShellCommand in UNIXUTILS is appropriate.") + + (* ;; + "We have to map the filenames down to Unix conventions: (not pseudohost or host, slashes, etc.") + + [SETQ COMPLETIONCODE (PROCESS-COMMAND (CONCATLIST (SUBLIS + `((PSFILE \, (SLASHIT (TRUEFILENAME + PSFILE) + NIL T)) + (PDFFILE \, (SLASHIT (TRUEFILENAME + PDFFILE) + NIL T)) + (ERRORFILE \, (SLASHIT (TRUEFILENAME + ERRORFILE) + NIL T))) + (ASSOC (OR PDFCONVERTER + (MKATOM (UNIX-GETENV + "MEDLEY-PDFCONVERTER" + ))) + PDF-CONVERTER-TEMPLATES] + + (* ;; "Now use Medley names") + + (CLOSEF? PSFILE) + (CL:UNLESS DONTDELETE (DELFILE PSFILE)) + (CLOSEF? ERRORFILE) + (CL:WHEN (INFILEP ERRORFILE) + (CL:WHEN (IGREATERP (PROG1 (GETFILEINFO ERRORFILE 'LENGTH) + (CL:UNLESS DONTDELETE (DELFILE ERRORFILE))) + 0) + (ERROR "Cannot create PDF file for " PDFFILE))) + (CL:WHEN (IGREATERP COMPLETIONCODE 0) + (ERROR "Cannot create PDF file for " PDFFILE)) + PDFFILE]) +) +(DEFINEQ + +(SEE-PDF + [LAMBDA (PDFFILE) (* ; "Edited 1-Oct-2023 20:47 by rmk") + (* ; "Edited 26-Sep-2023 16:52 by rmk") + + (* ;; "Good for Mac, not sure about Windows etc.") + + (ShellCommand (CONCAT "open -a Preview " (UNIX-FILE-NAME (PACKFILENAME 'BODY PDFFILE 'EXTENSION + 'PDF) + 'INPUT]) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (3078 5692 (PDFFILEP 3088 . 4002) (PDF.HARDCOPYW 4004 . 4602) (PDF.TEXT 4604 . 5321) ( +PDF.TEDIT 5323 . 5690)) (6136 13355 (OPEN-PDF-STREAM 6146 . 8324) (CLOSE-PDF-STREAM 8326 . 9613) ( +PS-TO-PDF 9615 . 13353)) (13356 13894 (SEE-PDF 13366 . 13892))))) +STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..12da811e8efa8c3c6eefca52341c9e2ffa8b2f75 GIT binary patch literal 5191 zcmds5&u`o28J1IY-Lz$B4jYCXiWdZeNh_#|lw`^3P>T{Nn3HitM{>WUy_^yH@0oQ7spXB|f2tWwB$EMuzTB z*1B0WYh+g2jas|f(5R$M=9i1vMKY!N6&8K@$-uEa=j5y3Ud&FHHw0=pl@IAl=y zuu(5lapxf8pj~UUO;e-OWs;qg{9&x)A1T_zVplj zt^9*L_#TVNs2vzhYCE)jJtUVcXH-mx`2aw0wUsZ{I_qm89yY6qe7#Pvs!ZX;~F zQ8VBv{H=XolxpQ7yyoBs)V5p2l1o+MZkY;kp-|ZCJj1h40xcjQs`3e8N ze82Nt7Io<2(apT3fjh$iS`a>)u zqk$TNyINVit{hvT-SdN!Pn7EcTo0l+9t7lKYwX6TSC{JKjjyJw$#{_*qFbZTIl_Tx zniTac&*@ve*bmV+sO!c9i??S%)b|R7A8msst&W85!Cv9GV|9DBbN?L=oYbSmGyqlixs|pR$wZH~9Y$ z|CG<{ZI#%n*mnmwM@mmJntKt?^F+n7hBiVTIGp0pkFA&!0msvnAXauCq1ZSJ9Boq@ ztFpS&H5jfTQTJ3aBQqUqc0Qeo-OAEqDRbCcGf{RXLEc65RjT4cT(x2EuiQ=mVf<-Y&9y0pNzi&scJF}a= zDQ{lgmtj?2rwYYCMk;Q%?!V20mQ*3vrZ_K;^M^m>DK*kjZA8MT)i+QL{eTP;co6mt zq+2y44BI@W-W@ck=MQ^UOf4i18Kq{OT%oXilbkRFmg)!Oj}$==2tf^+1`R&8Vt+u! zKDfYrsvkK(_Y)4U+2Z)dR)`_FhYWyS@{|v?0TQwLxRzvwOsN+g);w`SjOwv72t05p zg9pcD6L{pbL7KYlcx`4F z?w!}1%<3r@4X&afQVBq=kS9Eduov!c0Q8;K9nKr^&!O@ zn^jDGpE8!-fMAKY93qbsWqtQ+^?R)jQ_p`qQh1at-LKW)_49B4B4}4IzILB~`{!KW zdRLD9=3l=ql*}gRD;x>q@^uO{WI$_daA?+=gfL6kP4j?&E^Z6LOrQ`AbOSO0EX9h4 zpypb($6&AvTON|p0!Bl>=R^@8HyAMTjaDrs0|>>Kj3zGsQ5S7MytzfYnTI?09`eDn zqGPbT0W9r!VSpvFN!$#(lT}bux)YY|%(YNOIdwq|Sex&|dqqP=D{~uOvsRSw?H-51 zHcco8XLuAJ!!KOvVEhcXIi@ihfMyQT;L&ET*o~?%n`8hKq>7u6JGtwdRZ5o2`I7c? zQiqT}nT4|` zhol|P=bzz=WIdi^l^j+9qq`pei-i`@9-jmo1ToC^h1b9rPjE z)N4d@s>tVG#1c)7iiF8Y2)vaAviefZ2V*;mB}Ea@))UM1ud&V)lvA$ z3-L)rzuW0nf~cnqRaq{kk~^1eDm@?-9 zD$2%JWzWeUoV7F2qO3xZqDr|ErB&42%f&@M>lwb$=VxpJt=3?f%N4J4hi;r! zY@YK{Cl)Icge87R{SU?y`eL>|r)TH$)p|8q&KB!Kt%!3hzAw1$-@vNsBwDQ2b2*Vp zN1orcJb5=ZWlYQl-o?xK>p_WQd0VZ&Cbu&60;}?$=lI4{XlI~*7vhU0#60$48Lmh9 zqsjjXif=pi--dJUeg7M{-dqxQpc+-l^#ii_kAbO9J>Db{u^g;(1id1 literal 0 HcmV?d00001 diff --git a/lispusers/GITFNS b/lispusers/GITFNS index 0dbc6b1b..af78e808 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Mar-2023 09:08:48" {WMEDLEY}GITFNS.;469 119763 +(FILECREATED "23-Sep-2023 13:02:15" {WMEDLEY}GITFNS.;483 124031 - :CHANGES-TO (FNS GIT-MAKE-PROJECT) + :EDIT-BY rmk - :PREVIOUS-DATE "11-Mar-2023 23:12:35" {WMEDLEY}GITFNS.;468) + :CHANGES-TO (FNS CDGITDIR) + + :PREVIOUS-DATE "22-Sep-2023 12:08:14" {WMEDLEY}GITFNS.;482) (PRETTYCOMPRINT GITFNSCOMS) @@ -47,6 +49,7 @@ (INITVARS (GIT-MERGE-COMPARES T) (GIT-CDBROWSER-SEPARATE-DIRECTIONS T)) (COMMANDS gwc bbc prc cob b? cdg cdw) + (FNS PRC-COMMAND) (* ;; "") @@ -65,7 +68,7 @@ (FNS GIT-COMMIT GIT-PUSH GIT-PULL GIT-APPROVAL GIT-GET-FILE GIT-FILE-EXISTS? GIT-REMOTE-UPDATE GIT-REMOTE-ADD GIT-FILE-DATE GIT-FILE-HISTORY GIT-PRINT-FILE-HISTORY - GIT-FETCH) + GIT-FETCH GIT-PR-BRANCHES) (* ;; "Differences") @@ -77,8 +80,8 @@ (* ;; "Branches") (FNS GIT-BRANCH-NUM GIT-CHECKOUT GIT-WHICH-BRANCH GIT-MAKE-BRANCH GIT-BRANCHES - GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-PRC-MENU GIT-PULL-REQUESTS GIT-SHORT-BRANCH-NAME - GIT-LONG-NAME) + GIT-BRANCH-EXISTS? GIT-PICK-BRANCH GIT-BRANCH-MENU GIT-PULL-REQUESTS + GIT-SHORT-BRANCH-NAME GIT-LONG-NAME GIT-PRC-BRANCHES) (* ;; "My branches") @@ -98,7 +101,7 @@ (FNS GIT-GET-DIFFERENT-FILES GIT-BRANCHES-COMPARE-DIRECTORIES GIT-WORKING-COMPARE-DIRECTORIES GIT-COMPARE-WORKTREE GITCDOBJBUTTONFN GIT-CD-LABELFN GIT-CD-MENUFN - GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES) + GIT-WORKING-COMPARE-FILES GIT-BRANCHES-COMPARE-FILES GIT-PR-COMPARE) (INITVARS (FROMGITN 0)) (* ;; "") @@ -106,8 +109,8 @@ (* ;; "Utilities") - (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE PROCESS-COMMAND - GIT-RESULT-TO-LINES STRIPLOCAL) + (FNS CDGITDIR GIT-COMMAND GITORIGIN GIT-INITIALS GIT-COMMAND-TO-FILE GIT-RESULT-TO-LINES + STRIPLOCAL) (PROPS (GITFNS FILETYPE)))) @@ -314,7 +317,8 @@ PROJECT))]) (GIT-PUT-PROJECT-FIELD - [LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 11-Mar-2023 23:00 by rmk") + [LAMBDA (PROJECT FIELD NEWVALUE) (* ; "Edited 10-Jun-2023 21:48 by rmk") + (* ; "Edited 11-Mar-2023 23:00 by rmk") (* ; "Edited 7-Jul-2022 11:25 by rmk") (* ; "Edited 13-May-2022 10:40 by rmk") (* ; "Edited 9-May-2022 20:02 by rmk") @@ -322,24 +326,17 @@ (* ;; "Replaces the value of a project field with NEWVALUE. The project record is DONTCOPY, to avoid potential name conflicts, so this provides a functional interface. One use: augment EXCLUSIONS with a list of temporary debug and testing files that you don't want to see in the various file listings") - (CL:WHEN (SETQ PROJECT (IF (TYPE? GIT-PROJECT PROJECT) - THEN PROJECT - ELSEIF (CDR (ASSOC (OR (U-CASE PROJECT) - GIT-DEFAULT-PROJECT) - GIT-PROJECTS)) - ELSEIF NOERROR - THEN NIL - ELSE (ERROR "NOT A GIT-PROJECT" PROJECT))) - (SELECTQ FIELD - (PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) - (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) - (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE)) - (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE)) - (DEFAULTSUBDIRS - (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE)) - (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE)) - (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE)) - PROJECT))]) + (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + (SELECTQ FIELD + (PROJECTNAME (REPLACE PROJECTNAME OF PROJECT WITH NEWVALUE)) + (WHOST (REPLACE WHOST OF PROJECT WITH NEWVALUE)) + (GITHOST (REPLACE GITHOST OF PROJECT WITH NEWVALUE)) + (EXCLUSIONS (REPLACE EXCLUSIONS OF PROJECT WITH NEWVALUE)) + (DEFAULTSUBDIRS + (REPLACE DEFAULTSUBDIRS OF PROJECT WITH NEWVALUE)) + (CLONEPATH (REPLACE CLONEPATH OF PROJECT WITH NEWVALUE)) + (MAINBRANCH (REPLACE MAINBRANCH OF PROJECT WITH NEWVALUE)) + PROJECT]) (GIT-PROJECT-PATH [LAMBDA (PROJECTNAME PROJECTPATH) (* ; "Edited 8-May-2022 15:10 by rmk") @@ -478,29 +475,7 @@ (* ;; "Compares REMOTEBRANCH against the main orign branch, for pull-request assessment") - (LET ((RB REMOTEBRANCH) - (DR DRAFTS) - (PRS)) - (IF PROJECT - THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) - ELSEIF (GIT-GET-PROJECT RB NIL T) - THEN (SETQ PROJECT RB) - (SETQ RB NIL) - ELSEIF (GIT-GET-PROJECT DRAFTS NIL T) - THEN (SETQ PROJECT DRAFTS) - (SETQ DRFTS NIL)) - (CL:WHEN (MEMB (U-CASE RB) - '(DRAFT DRAFTS)) - (SETQ RB NIL) - (SETQ DR T)) - (GIT-FETCH PROJECT) - (SETQ PRS (GIT-PULL-REQUESTS T DR PROJECT)) - (IF PRS - THEN (CL:WHEN (OR RB (SETQ RB (GIT-PICK-BRANCH (GIT-PRC-MENU DR PROJECT PRS) - "Pull requests"))) - (GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT) - RB NIL PROJECT)) - ELSE "No open pull requests"))) + (PRC-COMMAND REMOTEBRANCH DRAFTS PROJECT)) (DEFCOMMAND cob (BRANCH NEXTTITLESTRING PROJECT) @@ -553,6 +528,46 @@ (SLASHIT (/CNDIR (CONCAT (GIT-GET-PROJECT PROJECT 'WHOST) (OR SUBDIR ""))) T)) +(DEFINEQ + +(PRC-COMMAND + [LAMBDA (REMOTEBRANCH DRAFTS PROJECT) (* ; "Edited 28-Jul-2023 09:03 by rmk") + (LET (PRS PRMENU) + (IF PROJECT + THEN (SETQ PROJECT (GIT-GET-PROJECT PROJECT)) + ELSEIF (GIT-GET-PROJECT REMOTEBRANCH NIL T) + THEN (SETQ PROJECT REMOTEBRANCH) + (SETQ REMOTEBRANCH NIL) + ELSEIF (GIT-GET-PROJECT DRAFTS NIL T) + THEN (SETQ PROJECT DRAFTS) + (SETQ DRAFTS NIL)) + (CL:WHEN (MEMB (U-CASE REMOTEBRANCH) + '(DRAFT DRAFTS)) + (SETQ REMOTEBRANCH NIL) + (SETQ DRAFTS T)) + (GIT-FETCH PROJECT) + (SETQ PRS (GIT-PULL-REQUESTS T DRAFTS PROJECT)) + (CL:WHEN (AND REMOTEBRANCH (NEQ REMOTEBRANCH 'PinMenu)) + (for PR in PRS when (OR (STRPOS REMOTEBRANCH (fetch PRDESCRIPTION of PR) + NIL NIL NIL NIL FILEDIRCASEARRAY) + (STRPOS REMOTEBRANCH (fetch PRNAME of PR) + NIL NIL NIL NIL FILEDIRCASEARRAY)) collect PR + finally (CL:WHEN $$VAL (SETQ PRS $$VAL)) + (SETQ REMOTEBRANCH NIL))) + (IF PRS + THEN (CL:UNLESS REMOTEBRANCH + (SETQ PRS (GIT-PRC-BRANCHES DRAFTS PROJECT PRS)) + (SETQ PRMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS) + " pull requests") + NIL)) + (SETQ REMOTEBRANCH (MENU PRMENU))) + (if (EQ 'PinMenu REMOTEBRANCH) + then (ADDMENU (GIT-BRANCH-MENU PRS (CONCAT (LENGTH PRS) + " pull requests"))) + elseif REMOTEBRANCH + then (GIT-PR-COMPARE REMOTEBRANCH PROJECT)) + ELSE "No open pull requests"]) +) @@ -1004,6 +1019,35 @@ (GIT-FETCH [LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:32 by rmk") (GIT-COMMAND "git fetch" T NIL PROJECT]) + +(GIT-PR-BRANCHES + [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") + (* ; "Edited 4-Aug-2022 18:55 by rmk") + (* ; "Edited 9-Jul-2022 19:01 by rmk") + (* ; "Edited 16-May-2022 19:44 by rmk") + (CL:UNLESS PRS + (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) + (CL:WHEN PRS + (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) + NIL T PROJECT))) + (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) + (EQUALS _ (CADR RELATIONS)) IN PRS + COLLECT (SETQ PRNAME (fetch PRNAME of PR)) + (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) + " " + (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] + THEN (CONCAT PRNAME " > " REL) + ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] + THEN (CONCAT PRNAME " = " REL) + ELSE PRNAME))) + (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) + (CONCAT LABEL " (draft)") + LABEL) + (GITORIGIN PRNAME) + (CONCAT " " (FETCH PRDESCRIPTION OF PR) + " #" + (FETCH PRNUMBER OF PR] + T)))]) ) @@ -1321,41 +1365,24 @@ THEN (ERROR "Unknown branch" BRANCH]) (GIT-PICK-BRANCH - [LAMBDA (BRANCHES TITLE) (* ; "Edited 18-May-2022 13:44 by rmk") - (CL:WHEN (MKLIST BRANCHES) - (MENU (CREATE MENU - TITLE _ (OR TITLE 'Branches) - ITEMS _ BRANCHES - MENUFONT _ DEFAULTFONT)))]) + [LAMBDA (BRANCHES TITLE) (* ; "Edited 6-Jul-2023 22:31 by rmk") + (* ; "Edited 30-Jun-2023 16:58 by rmk") + (* ; "Edited 18-May-2022 13:44 by rmk") + (MENU (GIT-BRANCH-MENU BRANCHES (OR TITLE (CONCAT (LENGTH BRANCHES) + " branches"]) -(GIT-PRC-MENU - [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") - (* ; "Edited 4-Aug-2022 18:55 by rmk") - (* ; "Edited 9-Jul-2022 19:01 by rmk") - (* ; "Edited 16-May-2022 19:44 by rmk") - (CL:UNLESS PRS - (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) - (CL:WHEN PRS - (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) - NIL T PROJECT))) - (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) - (EQUALS _ (CADR RELATIONS)) IN PRS - COLLECT (SETQ PRNAME (fetch PRNAME of PR)) - (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) - " " - (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] - THEN (CONCAT PRNAME " > " REL) - ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] - THEN (CONCAT PRNAME " = " REL) - ELSE PRNAME))) - (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) - (CONCAT LABEL " (draft)") - LABEL) - (GITORIGIN PRNAME) - (CONCAT " " (FETCH PRDESCRIPTION OF PR) - " #" - (FETCH PRNUMBER OF PR] - T)))]) +(GIT-BRANCH-MENU + [LAMBDA (BRANCHES TITLE PIN?) (* ; "Edited 6-Jul-2023 22:31 by rmk") + (* ; "Edited 30-Jun-2023 16:58 by rmk") + (* ; "Edited 18-May-2022 13:44 by rmk") + (CL:WHEN (SETQ BRANCHES (MKLIST BRANCHES)) + (CL:WHEN PIN? + [SETQ BRANCHES (APPEND BRANCHES '((" Pin menu" 'PinMenu]) + (CREATE MENU + TITLE _ (OR TITLE (CONCAT (LENGTH BRANCHES) + " branches")) + ITEMS _ BRANCHES + MENUFONT _ DEFAULTFONT))]) (GIT-PULL-REQUESTS [LAMBDA (ALLINFO INCLUDEDRAFTS PROJECT) (* ; "Edited 8-Aug-2022 13:12 by rmk") @@ -1402,6 +1429,35 @@ (* ;; "Allows short-hand reference to branch: rmk40 will return rmk40--xyz") (FIND B IN (GIT-BRANCHES WHERE PROJECT EXCLUDEMERGED) SUCHTHAT (STRPOS BRANCH B]) + +(GIT-PRC-BRANCHES + [LAMBDA (DRAFT PROJECT PRS) (* ; "Edited 8-Aug-2022 18:15 by rmk") + (* ; "Edited 4-Aug-2022 18:55 by rmk") + (* ; "Edited 9-Jul-2022 19:01 by rmk") + (* ; "Edited 16-May-2022 19:44 by rmk") + (CL:UNLESS PRS + (SETQ PRS (GIT-PULL-REQUESTS T DRAFT PROJECT))) + (CL:WHEN PRS + (LET ((RELATIONS (GIT-BRANCH-RELATIONS (FOR PR IN PRS COLLECT (GITORIGIN (CADDR PR))) + NIL T PROJECT))) + (SORT [FOR PR REL LABEL PRNAME (SUPERSETS _ (CAR RELATIONS)) + (EQUALS _ (CADR RELATIONS)) IN PRS + COLLECT (SETQ PRNAME (fetch PRNAME of PR)) + (SETQ LABEL (CONCAT "#" (fetch (PULLREQUEST PRNUMBER) of PR) + " " + (IF [SETQ REL (CAR (CDR (SASSOC PRNAME SUPERSETS] + THEN (CONCAT PRNAME " > " REL) + ELSEIF [SETQ REL (CAR (CDR (SASSOC PRNAME EQUALS] + THEN (CONCAT PRNAME " = " REL) + ELSE PRNAME))) + (LIST (CL:IF (EQ 'DRAFT (FETCH PRSTATUS OF PR)) + (CONCAT LABEL " (draft)") + LABEL) + (GITORIGIN PRNAME) + (CONCAT " " (FETCH PRDESCRIPTION OF PR) + " #" + (FETCH PRNUMBER OF PR] + T)))]) ) @@ -1664,7 +1720,8 @@ (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 12-Sep-2022 14:41 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 10-Jun-2023 17:28 by rmk") + (* ; "Edited 12-Sep-2022 14:41 by rmk") (* ; "Edited 20-Jul-2022 21:18 by rmk") (* ; "Edited 22-May-2022 22:47 by rmk") (* ; "Edited 9-May-2022 15:14 by rmk") @@ -1683,10 +1740,11 @@ (SETQ MAPPINGS (CADDR DIRS)) (IF DIRS THEN (TERPRI T) - (SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) + [SETQ CDVALUE (COMPAREDIRECTORIES (CAR DIRS) (CADR DIRS) '(> < ~= -* *-) - '*>*.*)) + '*>*.* + (GIT-GET-PROJECT PROJECT 'EXCLUSIONS] (* ;; "We know that both sides come from Unix/unversioned, even if they have been copied into versioned FROMGIT, so we make a pass to remove the misleading versions.") @@ -1754,6 +1812,10 @@ (GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) + (* ;; "Edited 17-Jun-2023 22:54 by rmk") + + (* ;; "Edited 10-Jun-2023 21:32 by rmk") + (* ;; "Edited 20-Jul-2022 21:18 by rmk") (* ;; "Edited 25-Jun-2022 21:37 by rmk") @@ -1793,7 +1855,13 @@ (GITSUBDIR SUBDIR T PROJECT) (OR SELECT '(> < ~= -* *-)) NIL - (FETCH EXCLUSIONS OF PROJECT) + (for E DPOS in (GIT-GET-PROJECT PROJECT 'EXCLUSIONS) + collect (SETQ DPOS (STRPOS SUBDIR (FILENAMEFIELD E + 'DIRECTORY) + 1 NIL T T FILEDIRCASEARRAY)) + (CL:IF DPOS + (SUBSTRING E (ADD1 DPOS)) + E)) NIL NIL NIL FIXDIRECTORYDATES)) [FOR CDE IN (FETCH CDENTRIES OF CDVAL) DO (CL:WHEN (FETCH INFO1 OF CDE) @@ -2067,6 +2135,11 @@ " " FILE) (CONCAT (GIT-SHORT-BRANCH-NAME BRANCH2) " " FILE]) + +(GIT-PR-COMPARE + [LAMBDA (RB PROJECT) (* ; "Edited 6-Jul-2023 22:22 by rmk") + (GIT-BRANCHES-COMPARE-DIRECTORIES (GIT-MAINBRANCH PROJECT) + RB NIL PROJECT]) ) (RPAQ? FROMGITN 0) @@ -2083,11 +2156,13 @@ (DEFINEQ (CDGITDIR - [LAMBDA (PROJECT) (* ; "Edited 8-Jul-2022 10:34 by rmk") + [LAMBDA (PROJECT) (* ; "Edited 23-Sep-2023 13:01 by rmk") + (* ; "Edited 8-Jul-2022 10:34 by rmk") (* ; "Edited 7-Jul-2022 09:36 by rmk") (* ; "Edited 7-May-2022 22:41 by rmk") (* ; "Edited 2-Nov-2021 21:12 by rmk:") - (CONCAT "cd " [SLASHIT (STRIPHOST (TRUEFILENAME (FETCH GITHOST OF PROJECT] + (CONCAT "cd " (SLASHIT (TRUEFILENAME (FETCH GITHOST OF PROJECT)) + NIL T) " && "]) (GIT-COMMAND @@ -2198,16 +2273,6 @@ (ERROR (CONCAT "Command failed: " CMD))) NIL]) -(PROCESS-COMMAND - [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") - - (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") - - (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) - (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) - of PS)) - 0))) DO (BLOCK) FINALLY (RETURN CODE]) - (GIT-RESULT-TO-LINES [LAMBDA (FILE ALL) (* ; "Edited 16-Jul-2022 22:21 by rmk") @@ -2234,32 +2299,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3979 20805 (GIT-CLONEP 3989 . 5252) (GIT-INIT 5254 . 5884) (GIT-MAKE-PROJECT 5886 . -13487) (GIT-GET-PROJECT 13489 . 15414) (GIT-PUT-PROJECT-FIELD 15416 . 17433) (GIT-PROJECT-PATH 17435 - . 18479) (FIND-ANCESTOR-DIRECTORY 18481 . 18830) (GIT-FIND-CLONE 18832 . 19913) (GIT-MAINBRANCH 19915 - . 20310) (GIT-MAINBRANCH? 20312 . 20803)) (27232 30020 (ALLSUBDIRS 27242 . 28528) (MEDLEYSUBDIRS -28530 . 29223) (GITSUBDIRS 29225 . 30018)) (30021 34811 (TOGIT 30031 . 31437) (FROMGIT 31439 . 32420) -(GIT-DELETE-FILE 32422 . 33268) (MYMEDLEY-DELETE-FILES 33270 . 34809)) (34812 37815 (MYMEDLEYSUBDIR -34822 . 35278) (GITSUBDIR 35280 . 35723) (STRIPDIR 35725 . 36096) (STRIPHOST 36098 . 36338) (STRIPNAME - 36340 . 37093) (STRIPWHERE 37095 . 37813)) (37816 39718 (GFILE4MFILE 37826 . 38189) (MFILE4GFILE -38191 . 38760) (GIT-REPO-FILENAME 38762 . 39716)) (39767 49589 (GIT-COMMIT 39777 . 40603) (GIT-PUSH -40605 . 41249) (GIT-PULL 41251 . 41863) (GIT-APPROVAL 41865 . 42214) (GIT-GET-FILE 42216 . 44181) ( -GIT-FILE-EXISTS? 44183 . 44457) (GIT-REMOTE-UPDATE 44459 . 45183) (GIT-REMOTE-ADD 45185 . 45492) ( -GIT-FILE-DATE 45494 . 46425) (GIT-FILE-HISTORY 46427 . 48361) (GIT-PRINT-FILE-HISTORY 48363 . 49413) ( -GIT-FETCH 49415 . 49587)) (49619 60212 (GIT-BRANCH-DIFF 49629 . 55969) (GIT-COMMIT-DIFFS 55971 . 56524 -) (GIT-BRANCH-RELATIONS 56526 . 60210)) (60257 72489 (GIT-BRANCH-NUM 60267 . 60840) (GIT-CHECKOUT -60842 . 61901) (GIT-WHICH-BRANCH 61903 . 62201) (GIT-MAKE-BRANCH 62203 . 64416) (GIT-BRANCHES 64418 . -66686) (GIT-BRANCH-EXISTS? 66688 . 67392) (GIT-PICK-BRANCH 67394 . 67722) (GIT-PRC-MENU 67724 . 69727) - (GIT-PULL-REQUESTS 69729 . 71875) (GIT-SHORT-BRANCH-NAME 71877 . 72168) (GIT-LONG-NAME 72170 . 72487) -) (72519 75854 (GIT-MY-CURRENT-BRANCH 72529 . 72899) (GIT-MY-BRANCHP 72901 . 73406) ( -GIT-MY-NEXT-BRANCH 73408 . 73902) (GIT-MY-BRANCHES 73904 . 75852)) (75900 79852 (GIT-ADD-WORKTREE -75910 . 77394) (GIT-REMOVE-WORKTREE 77396 . 78326) (GIT-LIST-WORKTREES 78328 . 79132) (WORKTREEDIR -79134 . 79850)) (79900 111109 (GIT-GET-DIFFERENT-FILES 79910 . 86334) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 86336 . 92493) (GIT-WORKING-COMPARE-DIRECTORIES 92495 . 97321) ( -GIT-COMPARE-WORKTREE 97323 . 101301) (GITCDOBJBUTTONFN 101303 . 105793) (GIT-CD-LABELFN 105795 . -106877) (GIT-CD-MENUFN 106879 . 109319) (GIT-WORKING-COMPARE-FILES 109321 . 109941) ( -GIT-BRANCHES-COMPARE-FILES 109943 . 111107)) (111179 119696 (CDGITDIR 111189 . 111749) (GIT-COMMAND -111751 . 113309) (GITORIGIN 113311 . 114008) (GIT-INITIALS 114010 . 114314) (GIT-COMMAND-TO-FILE -114316 . 117805) (PROCESS-COMMAND 117807 . 118420) (GIT-RESULT-TO-LINES 118422 . 119029) (STRIPLOCAL -119031 . 119694))))) + (FILEMAP (NIL (4053 20503 (GIT-CLONEP 4063 . 5326) (GIT-INIT 5328 . 5958) (GIT-MAKE-PROJECT 5960 . +13561) (GIT-GET-PROJECT 13563 . 15488) (GIT-PUT-PROJECT-FIELD 15490 . 17131) (GIT-PROJECT-PATH 17133 + . 18177) (FIND-ANCESTOR-DIRECTORY 18179 . 18528) (GIT-FIND-CLONE 18530 . 19611) (GIT-MAINBRANCH 19613 + . 20008) (GIT-MAINBRANCH? 20010 . 20501)) (25911 28038 (PRC-COMMAND 25921 . 28036)) (28094 30882 ( +ALLSUBDIRS 28104 . 29390) (MEDLEYSUBDIRS 29392 . 30085) (GITSUBDIRS 30087 . 30880)) (30883 35673 ( +TOGIT 30893 . 32299) (FROMGIT 32301 . 33282) (GIT-DELETE-FILE 33284 . 34130) (MYMEDLEY-DELETE-FILES +34132 . 35671)) (35674 38677 (MYMEDLEYSUBDIR 35684 . 36140) (GITSUBDIR 36142 . 36585) (STRIPDIR 36587 + . 36958) (STRIPHOST 36960 . 37200) (STRIPNAME 37202 . 37955) (STRIPWHERE 37957 . 38675)) (38678 40580 + (GFILE4MFILE 38688 . 39051) (MFILE4GFILE 39053 . 39622) (GIT-REPO-FILENAME 39624 . 40578)) (40629 +52459 (GIT-COMMIT 40639 . 41465) (GIT-PUSH 41467 . 42111) (GIT-PULL 42113 . 42725) (GIT-APPROVAL 42727 + . 43076) (GIT-GET-FILE 43078 . 45043) (GIT-FILE-EXISTS? 45045 . 45319) (GIT-REMOTE-UPDATE 45321 . +46045) (GIT-REMOTE-ADD 46047 . 46354) (GIT-FILE-DATE 46356 . 47287) (GIT-FILE-HISTORY 47289 . 49223) ( +GIT-PRINT-FILE-HISTORY 49225 . 50275) (GIT-FETCH 50277 . 50449) (GIT-PR-BRANCHES 50451 . 52457)) ( +52489 63082 (GIT-BRANCH-DIFF 52499 . 58839) (GIT-COMMIT-DIFFS 58841 . 59394) (GIT-BRANCH-RELATIONS +59396 . 63080)) (63127 76230 (GIT-BRANCH-NUM 63137 . 63710) (GIT-CHECKOUT 63712 . 64771) ( +GIT-WHICH-BRANCH 64773 . 65071) (GIT-MAKE-BRANCH 65073 . 67286) (GIT-BRANCHES 67288 . 69556) ( +GIT-BRANCH-EXISTS? 69558 . 70262) (GIT-PICK-BRANCH 70264 . 70754) (GIT-BRANCH-MENU 70756 . 71459) ( +GIT-PULL-REQUESTS 71461 . 73607) (GIT-SHORT-BRANCH-NAME 73609 . 73900) (GIT-LONG-NAME 73902 . 74219) ( +GIT-PRC-BRANCHES 74221 . 76228)) (76260 79595 (GIT-MY-CURRENT-BRANCH 76270 . 76640) (GIT-MY-BRANCHP +76642 . 77147) (GIT-MY-NEXT-BRANCH 77149 . 77643) (GIT-MY-BRANCHES 77645 . 79593)) (79641 83593 ( +GIT-ADD-WORKTREE 79651 . 81135) (GIT-REMOVE-WORKTREE 81137 . 82067) (GIT-LIST-WORKTREES 82069 . 82873) + (WORKTREEDIR 82875 . 83591)) (83641 115865 (GIT-GET-DIFFERENT-FILES 83651 . 90075) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 90077 . 96422) (GIT-WORKING-COMPARE-DIRECTORIES 96424 . 101848) ( +GIT-COMPARE-WORKTREE 101850 . 105828) (GITCDOBJBUTTONFN 105830 . 110320) (GIT-CD-LABELFN 110322 . +111404) (GIT-CD-MENUFN 111406 . 113846) (GIT-WORKING-COMPARE-FILES 113848 . 114468) ( +GIT-BRANCHES-COMPARE-FILES 114470 . 115634) (GIT-PR-COMPARE 115636 . 115863)) (115935 123964 (CDGITDIR + 115945 . 116632) (GIT-COMMAND 116634 . 118192) (GITORIGIN 118194 . 118891) (GIT-INITIALS 118893 . +119197) (GIT-COMMAND-TO-FILE 119199 . 122688) (GIT-RESULT-TO-LINES 122690 . 123297) (STRIPLOCAL 123299 + . 123962))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 70a03829d00b118f34c2abc5a07bf8e489c6c231..2cd16571189cb902aa72f57dcb5414f1d7517575 100644 GIT binary patch delta 3805 zcmaJ^TWlN073D5v8>TH=54v^~S-zrel@v^7ALK5{1PYhrQlvz3X+Er|P0dOsZ3?pW zw9^C$z&7Y3{U{oBk*0=|6n26ph$UAFL)2($Z-IXFqaOkKKnwJvD3GEk@?)bY8nl4Z zJF`oXa)R<>cjnIA*}0E%?&WVDupfWR{_>Pl5WR)!l2_ma5qL4o31L34Hvd>XD0;x* z+OdjD{;-l3-LA<8m=R_XDYCKi+MyFxr(maG?NhLe37Q96b z+>S)Huze#BgmZcIOiC*iym34nT!PSHvJmEiXxG~F$Jn6I_%)L~SoeVK+culc9@&de z+pJBgTp)vcKQt+e}%c z$L7|rzu}zWc?mK~DjUr!*;o=nGQ`qaR?R8JB*;OCs|lr)E*45r3_<}U9@M8|=~5x3 zp)33W!005kLJ@=zOwj@Fhg@EpP-Dfcl2Ot9jjMfYyXv`o%p21(86_Ksa6IU6=Rm@Z zkOLlH88utNA&0{Pq(EpLfny%xc_mRKVh-|ZMk}h;RTCfsi7j3%rW8~qpI4?mz#QJg z*zCQ)M4N{qwYh!7!|xrcM`pW>+N^DJ$n<@evDvR!tFJ0_jWx`;ED{X|dAy1W#@sAx zM5)r85~Zg-6={}|H@0j)jWj(vMf`pR4P*ky7!Qy8cvk#6kW~UNjLXrY6DMyFu{Il z^Ou>CUu=F7sk{;;pQzh<=-n{tg3OVqd2@LZkerfN0rMUT#e7aHfFSU#Aumgy#N#wJ zyv$Q2)Ae3cCP@&}vN5Fyd_aP5^K&BnS%h%!FFRT$N<}QYH!k8A@J~0^m27$5mn;O+u2GXzf97r;Hc% z<%Rw_kEiA47Bba^E5Q3P9nCT3EC^`3E4v7bOVtHfx^nR%a?|pa>gwfH7w`xI*Jp%+ z@L8cGfSYEomBSv7LrJGwSZV~0>>b{RVQ87$C>FoTHpW7!0YVjkVPhjov+w_;3`W!P zw%~6&yXEUp%he&v(H=)Ol}76jqb`_TnOQhjtF9tNl62^dY`B{sl;SXzeG>HLf=60r z5mu3k{msf+ZD7{+el_}fq@C^vl&|7_ZO8DwoiNhhFO1bO=>kIQE*K&!Q}D`9E4iGS zjSJ}Vpxojbl08W^9ZzHl0magJ3}q%)1W|w&y6j}NIGt0Ezd+*Tmpd&1J_K&J3+NA{ z370Umu0C*|E+K7f$JgU&{PqmjwV!a(4&Up)yV=)petDzExw@ORb;V5d?v6C=FK#hO z{SWgm9slDT6;3jfEJMwwsEyGl#d7y9{qn^d^$)0|HZWk}u7y6)q+rV% zA_6ZKkLI`RjV&P%XzdZOI;G7_7dRP;D!K-v#1YMmf>atLAt#vDKe^o9&tpv^ zq3uY0{raVkDghBHbLY=jSE>u=s;eN1!HzisCb&(%LP!A9Ljnjv$r|%GHt8T1_okJo zn#NEO#I(kINYd}D57!lr!@Kbq#g3xE%L0s!jrvAO{6r}TZm#3=s~(ggY#x^J0dU8# zIha|gLZMpqpocgN{dsH_5R!sFh!grF69UDVg~~yE2_ga+Tn;2QLI3XJ8!-t?{9(Bf z0#Hm9)0h~jgDyOyq{$EokXAb~=1@%5F|p!=9*K`ZpI*Afi6%W|)cm;GBGLjR07LX} zQ6f@7A6|Zh6-E8E`4e6C(omOPS^oGiGiFRZabt^-GBm61^m5&iEoMMJzarM#Db;(r zUmLVHo!U?z)__pp*&=0gKT+l^KH#FQU+u5pB1K;acb@g%e>AqYK57jdPfY+jok(FWAoJ( z_p|oqhnll|z{ocDX$NWpXTP%b;6K`dk+WM5=vjxfQJq~C>I2#-d(-|Mrpy_duQ}A8 zITtZZ7#S0l`Fm(TOAXkveQN)S<}3S++Dn>`!MEmP%RYl*Cqw~}lxps;zpW1rx5j~cm+~y7FnPoQ5_UoskszDkDmF3O#3EtyLWza0AWyhVd*>D|pgh3Ijp?ub zVJ9nNpoo`nTjQ? zN(wr6Gk(mBoZ0eG?c9zoPJj94ai8_6b_w=?dlVjj99)^_I+_!3lbbvA4{x5-|8-M2 zjQ{6wPJE2Lsdq}tPZsm43VLQe&N%e7b*H{{>4<)JeOUi=eV1-u8vMaVOrQAvqx#v6 vfrBmctj1S=cH=lIUE6T!cQ<4l?YecWaq`w%d%8P3h2PFK2OGZINB8^>tE;Ty delta 3325 zcmZu!YitzP72cU8HY{L_G1y%Q93~FkbyzZwo!Ljy#IrNA_Tt^0WoC@yCc!oAg56M? zcuQV_xT38ZrBVvIRfzyK6{<=}RAhUx)TW}_O0B92Rh6o!s#LWSN~EfaTG3xs`Xlt* zJ3DJb>L0Un&bf0Q-#y>C*B^f~eEU=W{CKY-CQ4KD30agC5HndZolT}MyzscKW#SMK z|AgzOuso7!oQ&ieI5E)MZL69e-_G_SG0P3`wB zxI`DUbiR*EzQSL{R18b6Kp?rl8# zR3S?86WgNC@?3}?3SS$lE_>6_o0Tuo()Z{qohQh5CZ0Olvw_N(RXPnNt2~COsF@%b zRg73gGhfC4n2&?qQL1<#Cm}aKHG6EjRtHIiGwZ^1r8iNr9yx;!;%rANj*+11#-$_Q z;2YI14z44=Ioi_@r+(7id!mC6tut8Yqa8yl;d4veljPqozR`DkhABt6QJ!PF#z5Re zuFPNMeoLON_fIMcZC2YU3>V6vAcRG$Jd7AAVg?K|=h)+}<$$av!LZAQPLoxFHL{d} zB10Ucj0&EG1re4rq5?4k2|YDm1GiR-W5sC@;5ZVzE`Y3PD6l^&h$u|WR`Dt0 zE(#z-K$b-E!RhbIBKXY(2t)?Ff>*TYYZ}2htQYC4x@HC9Ym$|hZm8&n5!iBut%QO7 zp*xmK$*5wfu9p}uS!U6iKp4==m~Ya^jh6@3@&D})lRv%uabM`e=D2uuDfE{T+x=Tx z#mz%Yp(gqBE6NNd7&l$58k?DIvUgFfa$C7Bdsmg`mbdYoy^H6#8Ak5@CJMOx9sj4= zR&V3OE4S_5$*yL3Wux6S9X;~=(!DXeYu}Njdu8fwi@lrt;Z=E|*M{&)_*>lMK+_gh zc5f>klbe1^HV;-`xO;Vp<5@>8h3Vk`9A|Z zOP>j?O7=DF0efFzbUGSkJ_{#88`FHz3PqTT@ZUy|{eH-{mSo-uM<`!ci*HhTsE!t=q zB_N81eZ0ybO_N%uLSd>km7WGw!*1|trK+jGM>3rXxRh-3u2{gal$51ly^>PE#fBIu zc&v@b%56!ODC-(q&uripQrPutd8c778*`^#eH5NdfTpBrhvP3M-RgJ^XJf!b4QIdu zjMKzb#;KW9(7f}klvh`w-vQoo2DLgKKrlrW8vx8wx zRY=$CdtD8uj36LDGLp)tUIf%+2BqK+tx0NaaZzQ&q+CRuN{Q*0G&6ew6-h~JoO}Hr zJC7SCR)ixTvSvCGD}WeOi)Y*bwu?U|@r>bEgRMSTtI>v{)13m=8i%XffYf$9r%=HY zgnZ$0luI|Bx%{7vortDkxh^?*Ini0cc!q6~x32A4kf6eN4LGc{6owZ$KE!S94xQ{g z)IsC?uJ`O|ekJ_nXR0%I-)^p_s^;QH{s}XEY+ZApgQKaW;knXb)*f;Oaz)!1MPMbI zJ|5m8O6>e-r9j6?NiUmpI?6kI1o9LCnup})K@MDzQxB~7SK`3(m*D7P-%#+3l8Ko= z#v^b;8%XN<;4E%~QOx3D>ss_+3v$B|_<&b`MyudocIZus!jx#Ija!)2bGGAw-;&I_ zwgOrjxzp$+Z(Z+bOkew?gLv{xe1#qIM^eNcW+$b$l=BPJ*<@x0X##@LOzc- zCGy=xm#N1`3dTsHbyOG^|{%)5O3Y!$Up1- zNNouKY(Yf8+`ftR zBesN&WNUCYf7tm%(efY`b8--Itdi|ne$5!zbij1lb~9xqrV~ z;{YAuZU~jrI5OvJFP^T|zgic_;`^T;VJWS--?F?61ib}+Ao~F0e=g-Ym^)RQg;V$W MiZ_1$^WB~Q1DwlL7ytkO diff --git a/lispusers/PSEUDOHOSTS b/lispusers/PSEUDOHOSTS index 981afb63..ad69e0ed 100644 --- a/lispusers/PSEUDOHOSTS +++ b/lispusers/PSEUDOHOSTS @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Jul-2023 09:17:48" {WMEDLEY}PSEUDOHOSTS.;153 27674 +(FILECREATED "22-Sep-2023 15:29:50" {WMEDLEY}PSEUDOHOSTS.;158 26638 :EDIT-BY rmk - :CHANGES-TO (RECORDS PHDEVICE PHGENFILESTATE TARGETDEVICE) - (MACROS PSEUDOHOST.NAME PSEUDOHOST.TARGETVAL) + :CHANGES-TO (FNS PSEUDOHOST SLASHIT CONTRACT.PH) (VARS PSEUDOHOSTSCOMS) - :PREVIOUS-DATE "18-Jul-2023 13:12:35" {WMEDLEY}PSEUDOHOSTS.;152) + :PREVIOUS-DATE "26-Jul-2023 12:34:37" {WMEDLEY}PSEUDOHOSTS.;155) (PRETTYCOMPRINT PSEUDOHOSTSCOMS) @@ -21,7 +20,7 @@ (* ;; "Internals") - (FNS EXPAND.PH CONTRACT.PH SLASHIT UNSLASHIT GETHOSTINFO.PH) + (FNS EXPAND.PH CONTRACT.PH UNSLASHIT GETHOSTINFO.PH) (FNS OPENFILE.PH GETFILENAME.PH DIRECTORYNAMEP.PH CLOSEFILE.PH REOPENFILE.PH DELETEFILE.PH OPENP.PH UNREGISTERFILE.PH REGISTERFILE.PH GENERATEFILES.PH GETFILEINFO.PH SETFILEINFO.PH NEXTFILEFN.PH FILEINFOFN.PH RENAMEFILE.PH) @@ -42,6 +41,8 @@ (PSEUDOHOST [LAMBDA (HOST PREFIX) + (* ;; "Edited 22-Sep-2023 15:29 by rmk") + (* ;; "Edited 25-Jun-2022 17:00 by rmk") (* ;; "Edited 24-Feb-2022 23:56 by rmk: Expand prefix so that it is rooted in a real host and not a previously defined pseudohost.") @@ -81,7 +82,7 @@ (SELECTQ TARGETHOST ((DSK CORE) (SETQ PREFIX (UNSLASHIT PREFIX))) - (UNIX (SETQ PREFIX (SLASHIT PREFIX))) + (UNIX (SETQ PREFIX (SLASHIT PREFIX))) NIL) (SETQ TARGETDEVICE (OR (\GETDEVICEFROMHOSTNAME TARGETHOST) (ERROR "UNKNOWN TARGET HOST" TARGETHOST))) @@ -153,26 +154,32 @@ (FETCH (FDEV DEVICENAME) OF (FETCH (PHDEVICE TARGETDEV) OF (\GETDEVICEFROMNAME HOST))))]) (TRUEFILENAME - [LAMBDA (FILE) (* ; "Edited 26-Jan-2022 23:33 by rmk") + [LAMBDA (FILE) (* ; "Edited 26-Jul-2023 07:53 by rmk") + (* ; "Edited 26-Jan-2022 23:33 by rmk") (* ; "Edited 25-Jan-2022 08:47 by rmk") - (LET (FILENAME DEVICE) - (IF (STREAMP FILE) - THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE)) - (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) - ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) - (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) - (CL:IF (TYPE? PHDEVICE DEVICE) - (EXPAND.PH FILENAME DEVICE) - FILENAME)]) + (if (LISTP FILE) + then (for F in FILE collect (TRUEFILENAME F)) + else (LET (FILENAME DEVICE) + (IF (STREAMP FILE) + THEN (SETQ FILENAME (FETCH (STREAM FULLFILENAME) OF FILE)) + (SETQ DEVICE (FETCH (STREAM DEVICE) OF FILE)) + ELSE (SETQ FILENAME (\ADD.CONNECTED.DIR FILE)) + (SETQ DEVICE (\GETDEVICEFROMNAME FILENAME))) + (CL:IF (TYPE? PHDEVICE DEVICE) + (EXPAND.PH FILENAME DEVICE) + FILENAME)]) (PSEUDOFILENAME - [LAMBDA (FILE) (* ; "Edited 29-Jan-2022 23:08 by rmk") + [LAMBDA (FILE) (* ; "Edited 26-Jul-2023 12:34 by rmk") + (* ; "Edited 29-Jan-2022 23:08 by rmk") (* ; "Edited 28-Jan-2022 09:06 by rmk") - (FOR D PN (FILENAME _ (IF (STREAMP FILE) - THEN (FETCH (STREAM FULLFILENAME) OF FILE) - ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES - WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) - DO (RETURN PN) FINALLY (RETURN FILENAME]) + (if (LISTP FILE) + then (for F in FILE collect (PSEUDOFILENAME F)) + else (FOR D PN (FILENAME _ (IF (STREAMP FILE) + THEN (FETCH (STREAM FULLFILENAME) OF FILE) + ELSE (\ADD.CONNECTED.DIR FILE))) IN \FILEDEVICES + WHEN (TYPE? PHDEVICE D) UNLESS (EQ FILENAME (SETQ PN (CONTRACT.PH FILENAME D))) + DO (RETURN PN) FINALLY (RETURN FILENAME]) ) @@ -209,6 +216,8 @@ (CONTRACT.PH [LAMBDA (NAME PHDEV) + (* ;; "Edited 22-Sep-2023 14:30 by rmk") + (* ;; "Edited 30-Jan-2022 00:20 by rmk: the smallest pseudoname for NAME. If the NAME was constructed by expanding, then") (* ;; "Finds the smallest pseudoname for NAME. The PHDEV is used only to find its targetdev, that's where we scan for matching prefixes. This is so we can find the lowest matching pseudohost in the target's prefix map. If the hosts are defined as {DSK}...{H1}...{H2}, DSK knows the prefixes that lead to H1 and H2, picks the longest matching prefix and replaces it by the corresponding host.") @@ -234,7 +243,7 @@ (SETQ CONNECTOR (CADDR PM)) [SETQ SUFFIX (CONCAT CONNECTOR (IF (EQ CONNECTOR '/) - THEN (SLASHIT SUFFIX) + THEN (SLASHIT SUFFIX) ELSE (UNSLASHIT SUFFIX]) (RETURN (PACK* '{ (CADR PM) "}" @@ -244,31 +253,6 @@ (RETURN NAME)))]) -(SLASHIT - [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:08 by rmk") - (* ; "Edited 3-Jan-2022 11:44 by rmk") - (* ; "Edited 22-Dec-2021 20:18 by rmk") - (* ; "Edited 2-Nov-2021 22:54 by rmk:") - (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) - 0] - [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) - COLLECT (SELCHARQ C - ((< >) - (SETQ LASTDIRPOS I) - (CHARCODE /)) - (/ (SETQ LASTDIRPOS I) - C) - C] - (CL:WHEN (AND LCASEDIRS LASTDIRPOS) - (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) - (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) - (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) - "")))) - (CL:IF (EQ DIRPOS 1) - SLASHED - (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) - SLASHED))]) - (UNSLASHIT [LAMBDA (X LCASEDIRS) (* ; "Edited 26-Jan-2022 15:09 by rmk") (* ; "Edited 22-Dec-2021 20:18 by rmk") @@ -527,13 +511,12 @@ EXPORTS.ALL) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1397 9433 (PSEUDOHOST 1407 . 6966) (PSEUDOHOSTP 6968 . 7481) (PSEUDOHOSTS 7483 . 7844) -(TARGETHOST 7846 . 8120) (TRUEFILENAME 8122 . 8809) (PSEUDOFILENAME 8811 . 9431)) (9461 17000 ( -EXPAND.PH 9471 . 10724) (CONTRACT.PH 10726 . 13391) (SLASHIT 13393 . 14961) (UNSLASHIT 14963 . 16709) -(GETHOSTINFO.PH 16711 . 16998)) (17001 25021 (OPENFILE.PH 17011 . 18084) (GETFILENAME.PH 18086 . 18375 -) (DIRECTORYNAMEP.PH 18377 . 19001) (CLOSEFILE.PH 19003 . 19470) (REOPENFILE.PH 19472 . 20037) ( -DELETEFILE.PH 20039 . 20323) (OPENP.PH 20325 . 20620) (UNREGISTERFILE.PH 20622 . 21164) ( -REGISTERFILE.PH 21166 . 21700) (GENERATEFILES.PH 21702 . 22746) (GETFILEINFO.PH 22748 . 23050) ( -SETFILEINFO.PH 23052 . 23251) (NEXTFILEFN.PH 23253 . 23799) (FILEINFOFN.PH 23801 . 24076) ( -RENAMEFILE.PH 24078 . 25019))))) + (FILEMAP (NIL (1315 9921 (PSEUDOHOST 1325 . 6930) (PSEUDOHOSTP 6932 . 7445) (PSEUDOHOSTS 7447 . 7808) +(TARGETHOST 7810 . 8084) (TRUEFILENAME 8086 . 9048) (PSEUDOFILENAME 9050 . 9919)) (9949 15964 ( +EXPAND.PH 9959 . 11212) (CONTRACT.PH 11214 . 13925) (UNSLASHIT 13927 . 15673) (GETHOSTINFO.PH 15675 . +15962)) (15965 23985 (OPENFILE.PH 15975 . 17048) (GETFILENAME.PH 17050 . 17339) (DIRECTORYNAMEP.PH +17341 . 17965) (CLOSEFILE.PH 17967 . 18434) (REOPENFILE.PH 18436 . 19001) (DELETEFILE.PH 19003 . 19287 +) (OPENP.PH 19289 . 19584) (UNREGISTERFILE.PH 19586 . 20128) (REGISTERFILE.PH 20130 . 20664) ( +GENERATEFILES.PH 20666 . 21710) (GETFILEINFO.PH 21712 . 22014) (SETFILEINFO.PH 22016 . 22215) ( +NEXTFILEFN.PH 22217 . 22763) (FILEINFOFN.PH 22765 . 23040) (RENAMEFILE.PH 23042 . 23983))))) STOP diff --git a/lispusers/PSEUDOHOSTS.LCOM b/lispusers/PSEUDOHOSTS.LCOM index 1560bf8fc0806e974871bbd164b002cb48e9fd20..2a4c82ce9a98ba9aabd8e65b586f9979219cb67d 100644 GIT binary patch delta 859 zcma))O=#0#7{`;=*_!D{p>#60^)WDM4=ruJ`f)K?^0v)PlhCA_Xq`-3a5%M8MPXp^ z?8Wg4-b6hLLRl$(;LX!+UOapEw3{FveA5r;V1hY>=gt3l-sk!K^ZZ`@tUTX{@_fo| zwNreC7a%JY`9e|3?A?~S`6Mvh5iwg7#A2qv!HrJq=Dj=Z?VVN=T94bE`zu9oTvXTX zitT!^eHXY=-85mkI-O2)(A;`JN{+iWD|1OEQ8G-V)sX5TJqAacPbS-43FU#8Wg(9@ z=|!$&xznv(Q*|qb2byhpHC6M{P6dCb6EV_KPOUxM8DsK3iICgdU7@9ZA@DBTl|V=9 zhK9fa5&SVMwdx-PD1iZ);in`}TPG=sR)YInL$RUOFYz^m2KWP0Lfo`(|Q0y#TQ0*S}3XSr4m z9E;G&pp&=sFJQu+hlYRO$Q+kA&uBSqXmbR_r>)vWdS*NHF-@vWb`C^E89S_$q!BUn0?qcp0bflST4UuI>>#C_} XcGV%)0D~K#;2zE5_Yfn=U*W@Fa?8^R delta 887 zcmZvb%WD%+6vk(gV&n9|1f!IaHpgg70!^BEQX$HnI06fQ zqX*gr;Io;mh-c_99*k%w8K;aUR9m;pZqk)YW5}J9O}tIVdj6s31c~Dt^bGz^pP~6( zzwdcqg98;!8VUjjQs5C-auI>i+Qfl6@1rO>2z359MV=R-{4wwSG4QGtF!!68N+W-% znH3-E2IJMSI!ndU89)_Bw$!AfgP4M8!q}Xu;YB9k6GVKqBLq1pyF`A`Azp|X&`1gJ z>DD1|8T_;(Dhc3Ngp~)Ctla;^pn(X}o{;8*vL~U9rf3%rb@pWZx___DVCl;(&PPUd zya75@e^Ov|UuEY96%$85u`RbGE3QY(^B&%*%pp7>*Tmz5-Th9(-&Z!}vTnE_sW~R* zKo%52ClDJwQk-CO;q3rL`IbFP@{M_W{+kP5gQtCZP;SR}*f2eXAG3*}bMt$L! zV4+H5uUU-}w||Ug@aKqtKlKZ}48&BVm~sh`zX6dum{;tgL%IQnBY9Fd9T~)TBQO5| Dc^uyj diff --git a/sources/HARDCOPY b/sources/HARDCOPY index f252f932..09eaff6e 100644 --- a/sources/HARDCOPY +++ b/sources/HARDCOPY @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Oct-2022 18:47:42" {DSK}larry>ilisp>medley>sources>HARDCOPY.;2 103854 +(FILECREATED "22-Jun-2023 17:31:38" {WMEDLEY}HARDCOPY.;11 104907 - :CHANGES-TO (FNS HARDCOPYIMAGEW.TOPRINTER) + :EDIT-BY rmk - :PREVIOUS-DATE "20-Jul-2022 17:14:14" {DSK}larry>ilisp>medley>sources>HARDCOPY.;1) + :CHANGES-TO (FNS MakeMenuOfPrinters) + + :PREVIOUS-DATE " 3-Mar-2023 23:49:09" {WMEDLEY}HARDCOPY.;10) (* ; " @@ -46,7 +48,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (INITVARS (TEXTDEFAULTTABS (LIST 20320)) (TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765))) (* ; - "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches") + "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") (GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION) (FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE)) (COMS (FNS \BLTSHADE.GENERICPRINTER) @@ -62,7 +64,9 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. \HDCPYDSPPRINTCHAR \SLOWHDCPYBLTCHAR \CHANGECHARSET.HDCPYDISPLAY) [DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) - (IMICASPERPT 35] + (IMICASPERPT 35) + (DEFAULTTAB 36] + (* ; "screen-points: 1/2 inch") (DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT] [COMS (* ; @@ -168,20 +172,24 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (DEFINEQ (MakeMenuOfPrinters - [LAMBDA (MENUTITLE) (* ; "Edited 29-May-93 14:18 by rmk:") - (* ; "Edited 11-Jul-90 13:35 by jds") + [LAMBDA (MENUTITLE) (* ; "Edited 22-Jun-2023 17:30 by rmk") + (* ; "Edited 29-May-93 14:18 by rmk:") + (* ; "Edited 11-Jul-90 13:35 by jds") (DECLARE (GLOBALVARS DEFAULTPRINTINGHOST)) (CREATE MENU ITEMS _ (APPEND (FOR P INSIDE DEFAULTPRINTINGHOST COLLECT (LIST (COND - ((LISTP P) - (IF (CADDR P) - THEN (CONCAT (CADR P) - " " - (CADDR P)) - ELSE (CADR P))) - (T P)) - (KWOTE P))) + ((LISTP P) + (IF (CADDR P) + THEN (CONCAT (CADR P) + " " + (CADDR P)) + ELSE (CADR P))) + (T (CL:IF (OR (NULL P) + (ZEROP (NCHARS P))) + "(Default printer)" + P))) + (KWOTE P))) (LIST (LIST "Other..." (KWOTE 'OTHER) "You will be prompted for a printer"))) TITLE _ MENUTITLE @@ -686,7 +694,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. -(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches") +(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -729,7 +737,8 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (CLOSEF IMAGESTREAM])]) (COPY.TEXT.TO.IMAGE - [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 20-Jul-2022 17:14 by rmk") + [LAMBDA (INFILE IMAGESTREAM FONTS TABS) (* ; "Edited 3-Mar-2023 23:46 by rmk") + (* ; "Edited 20-Jul-2022 17:14 by rmk") (* ; "Edited 8-Oct-2021 22:23 by rmk:") (* ; "Edited 10-Apr-95 21:23 by rmk:") @@ -741,7 +750,7 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (FONTARRAY (FONTMAPARRAY FONTS)) (MAXFONT (ARRAYSIZE FONTARRAY)) (INSTRM (GETSTREAM INFILE 'INPUT)) - DEFAULTTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP] + DEFTAB C FC (EOSP (GETFILEINFO INSTRM 'ENDOFSTREAMOP] (* ;;  "RMK: EOS function changed to NILL from ZERO. 0 in low-order bits is OK in UNICODE, when we switch") @@ -775,17 +784,19 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (\OUTCHAR IMAGESTREAM (CHARCODE ^T)) (RETURN)) - (* ;; "TEXTDEFAULTTABS is a hack, since it depends on the units of the stream. Should really be a property of the stream or imagetype, or defined in terms of standard scale") + (* ;; "DEFAULTTAB is now a constant defined here as 36 = 1/2 inch. Maybe that should be scaled by the stream's scale factor vis a vis points, not related to the current font. If you are tabbing for alignment, you wouldn't want it to be ragged based on what font one line is in compare to another. TEXTDEFAULTTAB is a hack that should be removed.") [SETQ FC (IF TABS THEN (OR (CAR (NTH TABS FC)) (ERROR "Undefined absolute tab number" FC)) - ELSE (TIMES FC (OR DEFAULTTAB - (SETQ DEFAULTTAB - (TIMES 8 (CHARWIDTH (CHARCODE SPACE) - (FONTCREATE (ELT FONTARRAY 1) - NIL NIL NIL IMAGESTREAM] + ELSE (TIMES FC (OR DEFTAB (SETQ DEFTAB + (TIMES 8 + (CHARWIDTH (CHARCODE SPACE) + (FONTCREATE (ELT FONTARRAY + 1) + NIL NIL NIL + IMAGESTREAM] (DSPXPOSITION FC IMAGESTREAM)) (NIL (\OUTCHAR IMAGESTREAM (CHARCODE ^F)) (* ; "EOS after ^F") @@ -912,15 +923,23 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (RPAQQ IMICASPERPT 35) +(RPAQQ DEFAULTTAB 36) + (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) (IHALFMICASPERPT 17) - (IMICASPERPT 35)) + (IMICASPERPT 35) + (DEFAULTTAB 36)) ) (* "END EXPORTED DEFINITIONS") ) + + + +(* ; "screen-points: 1/2 inch") + (DECLARE%: DONTCOPY DOEVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED") (DEFMACRO \MICASTOPTS (MICAS) @@ -1083,40 +1102,40 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1999 2018 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6168 10934 (HARDCOPY.SOMEHOW 6178 . 7536) (HARDCOPYIMAGEW 7538 . 7690) ( -HARDCOPYIMAGEW.TOFILE 7692 . 8000) (HARDCOPYIMAGEW.TOPRINTER 8002 . 9249) (HARDCOPYREGION.TOFILE 9251 - . 9549) (HARDCOPYREGION.TOPRINTER 9551 . 10173) (COPY.WINDOW.TO.BITMAP 10175 . 10932)) (11006 21556 ( -MakeMenuOfPrinters 11016 . 12241) (PRINTERS.WHENSELECTEDFN 12243 . 13985) (MakeMenuOfImageTypes 13987 - . 14505) (GetNewPrinterFromUser 14507 . 14935) (PopUpWindowAndGetAtom 14937 . 16322) ( -PopUpWindowAndGetList 16324 . 17890) (NewPrinter 17892 . 18840) (GetPrinterName 18842 . 19122) ( -GetImageFile 19124 . 21411) (FetchDefaultPrinter 21413 . 21554)) (21591 22129 ( -ExtensionForPrintFileType 21601 . 21794) (PRINTFILETYPE.FROM.EXTENSION 21796 . 22127)) (22184 38568 ( -DEFAULTPRINTER 22194 . 22354) (CAN.PRINT.DIRECTLY 22356 . 22512) (CONVERT.FILE.TO.TYPE.FOR.PRINTER -22514 . 23558) (EMPRESS 23560 . 23873) (HARDCOPYW 23875 . 26835) (LISTFILES1 26837 . 27010) ( -PRINTER.BITMAPFILE 27012 . 27259) (PRINTER.BITMAPSCALE 27261 . 27526) (PRINTER.SCRATCH.FILE 27528 . -27651) (PRINTERPROP 27653 . 27836) (PRINTERSTATUS 27838 . 28027) (PRINTERTYPE 28029 . 30338) ( -PRINTERNAME 30340 . 30642) (PRINTFILEPROP 30644 . 30835) (PRINTFILETYPE 30837 . 32781) ( -\EXPECTED.FILE.TYPE 32783 . 33565) (SEND.FILE.TO.PRINTER 33567 . 38566)) (38569 43551 (PRINTERDEVICE -38579 . 43549)) (44366 52124 (TEXTTOIMAGEFILE 44376 . 46566) (COPY.TEXT.TO.IMAGE 46568 . 52122)) ( -52125 53260 (\BLTSHADE.GENERICPRINTER 52135 . 53258)) (53388 72140 (MAKEHARDCOPYSTREAM 53398 . 54402) -(UNMAKEHARDCOPYSTREAM 54404 . 55088) (HARDCOPYSTREAMTYPE 55090 . 55369) (\CHARWIDTH.HDCPYDISPLAY 55371 - . 55802) (\DSPFONT.HDCPYDISPLAY 55804 . 57209) (\DSPRIGHTMARGIN.HDCPYDISPLAY 57211 . 57788) ( -\DSPXPOSITION.HDCPYDISPLAY 57790 . 58051) (\DSPYPOSITION.HDCPYDISPLAY 58053 . 58314) ( -\STRINGWIDTH.HDCPYDISPLAY 58316 . 58823) (\STRINGWIDTH.HCPYDISPLAYAUX 58825 . 61157) (\HDCPYBLTCHAR -61159 . 63694) (\HDCPYDISPLAY.FIX.XPOS 63696 . 64116) (\HDCPYDISPLAY.FIX.YPOS 64118 . 64538) ( -\HDCPYDISPLAYINIT 64540 . 65317) (\HDCPYDSPPRINTCHAR 65319 . 67479) (\SLOWHDCPYBLTCHAR 67481 . 70984) -(\CHANGECHARSET.HDCPYDISPLAY 70986 . 72138)) (72550 72691 (\MICASTOPTS 72550 . 72691)) (72862 103159 ( -MAKEHARDCOPYMODESTREAM 72872 . 74781) (UNMAKEHARDCOPYMODESTREAM 74783 . 75861) (\BLTSHADE.HCPYMODE -75863 . 76310) (\BITBLT.HCPYMODE 76312 . 76934) (\BRUSHCONVERT.HCPYMODE 76936 . 77173) ( -\CHANGECHARSET.HCPYMODE 77175 . 78942) (\DASHINGCONVERT.HCPYMODE 78944 . 79207) (\CHARWIDTH.HCPYMODE -79209 . 79496) (\DRAWLINE.HCPYMODE 79498 . 79810) (\DRAWCURVE.HCPYMODE 79812 . 80241) ( -\DRAWCIRCLE.HCPYMODE 80243 . 80638) (\DRAWELLIPSE.HCPYMODE 80640 . 81152) (\DSPFONT.HCPYMODE 81154 . -82310) (\DSPLEFTMARGIN.HCPYMODE 82312 . 82896) (\DSPLINEFEED.HCPYMODE 82898 . 83308) ( -\DSPRIGHTMARGIN.HCPYMODE 83310 . 83939) (\DSPSPACEFACTOR.HCPYMODE 83941 . 84462) ( -\DSPXPOSITION.HCPYMODE 84464 . 85045) (\DSPYPOSITION.HCPYMODE 85047 . 85452) (\MOVETO.HCPYMODE 85454 - . 85606) (\FONTCREATE.HCPYMODE.PRESS 85608 . 86620) (\CREATECHARSET.HCPYMODE.PRESS 86622 . 87593) ( -\FONTCREATE.HCPYMODE.INTERPRESS 87595 . 88629) (\CREATECHARSET.HCPYMODE.INTERPRESS 88631 . 89619) ( -\STRINGWIDTH.HCPYMODE 89621 . 90055) (\HCPYMODEBLTCHAR 90057 . 93026) (\HCPYMODEDISPLAYINIT 93028 . -95959) (\HCPYMODEDSPPRINTCHAR 95961 . 98142) (\SLOWHCPYMODEBLTCHAR 98144 . 101658) (\SFFixY.HCPYMODE -101660 . 103157))))) + (FILEMAP (NIL (6322 11088 (HARDCOPY.SOMEHOW 6332 . 7690) (HARDCOPYIMAGEW 7692 . 7844) ( +HARDCOPYIMAGEW.TOFILE 7846 . 8154) (HARDCOPYIMAGEW.TOPRINTER 8156 . 9403) (HARDCOPYREGION.TOFILE 9405 + . 9703) (HARDCOPYREGION.TOPRINTER 9705 . 10327) (COPY.WINDOW.TO.BITMAP 10329 . 11086)) (11160 22017 ( +MakeMenuOfPrinters 11170 . 12702) (PRINTERS.WHENSELECTEDFN 12704 . 14446) (MakeMenuOfImageTypes 14448 + . 14966) (GetNewPrinterFromUser 14968 . 15396) (PopUpWindowAndGetAtom 15398 . 16783) ( +PopUpWindowAndGetList 16785 . 18351) (NewPrinter 18353 . 19301) (GetPrinterName 19303 . 19583) ( +GetImageFile 19585 . 21872) (FetchDefaultPrinter 21874 . 22015)) (22052 22590 ( +ExtensionForPrintFileType 22062 . 22255) (PRINTFILETYPE.FROM.EXTENSION 22257 . 22588)) (22645 39029 ( +DEFAULTPRINTER 22655 . 22815) (CAN.PRINT.DIRECTLY 22817 . 22973) (CONVERT.FILE.TO.TYPE.FOR.PRINTER +22975 . 24019) (EMPRESS 24021 . 24334) (HARDCOPYW 24336 . 27296) (LISTFILES1 27298 . 27471) ( +PRINTER.BITMAPFILE 27473 . 27720) (PRINTER.BITMAPSCALE 27722 . 27987) (PRINTER.SCRATCH.FILE 27989 . +28112) (PRINTERPROP 28114 . 28297) (PRINTERSTATUS 28299 . 28488) (PRINTERTYPE 28490 . 30799) ( +PRINTERNAME 30801 . 31103) (PRINTFILEPROP 31105 . 31296) (PRINTFILETYPE 31298 . 33242) ( +\EXPECTED.FILE.TYPE 33244 . 34026) (SEND.FILE.TO.PRINTER 34028 . 39027)) (39030 44012 (PRINTERDEVICE +39040 . 44010)) (44847 53086 (TEXTTOIMAGEFILE 44857 . 47047) (COPY.TEXT.TO.IMAGE 47049 . 53084)) ( +53087 54222 (\BLTSHADE.GENERICPRINTER 53097 . 54220)) (54350 73102 (MAKEHARDCOPYSTREAM 54360 . 55364) +(UNMAKEHARDCOPYSTREAM 55366 . 56050) (HARDCOPYSTREAMTYPE 56052 . 56331) (\CHARWIDTH.HDCPYDISPLAY 56333 + . 56764) (\DSPFONT.HDCPYDISPLAY 56766 . 58171) (\DSPRIGHTMARGIN.HDCPYDISPLAY 58173 . 58750) ( +\DSPXPOSITION.HDCPYDISPLAY 58752 . 59013) (\DSPYPOSITION.HDCPYDISPLAY 59015 . 59276) ( +\STRINGWIDTH.HDCPYDISPLAY 59278 . 59785) (\STRINGWIDTH.HCPYDISPLAYAUX 59787 . 62119) (\HDCPYBLTCHAR +62121 . 64656) (\HDCPYDISPLAY.FIX.XPOS 64658 . 65078) (\HDCPYDISPLAY.FIX.YPOS 65080 . 65500) ( +\HDCPYDISPLAYINIT 65502 . 66279) (\HDCPYDSPPRINTCHAR 66281 . 68441) (\SLOWHDCPYBLTCHAR 68443 . 71946) +(\CHANGECHARSET.HDCPYDISPLAY 71948 . 73100)) (73603 73744 (\MICASTOPTS 73603 . 73744)) (73915 104212 ( +MAKEHARDCOPYMODESTREAM 73925 . 75834) (UNMAKEHARDCOPYMODESTREAM 75836 . 76914) (\BLTSHADE.HCPYMODE +76916 . 77363) (\BITBLT.HCPYMODE 77365 . 77987) (\BRUSHCONVERT.HCPYMODE 77989 . 78226) ( +\CHANGECHARSET.HCPYMODE 78228 . 79995) (\DASHINGCONVERT.HCPYMODE 79997 . 80260) (\CHARWIDTH.HCPYMODE +80262 . 80549) (\DRAWLINE.HCPYMODE 80551 . 80863) (\DRAWCURVE.HCPYMODE 80865 . 81294) ( +\DRAWCIRCLE.HCPYMODE 81296 . 81691) (\DRAWELLIPSE.HCPYMODE 81693 . 82205) (\DSPFONT.HCPYMODE 82207 . +83363) (\DSPLEFTMARGIN.HCPYMODE 83365 . 83949) (\DSPLINEFEED.HCPYMODE 83951 . 84361) ( +\DSPRIGHTMARGIN.HCPYMODE 84363 . 84992) (\DSPSPACEFACTOR.HCPYMODE 84994 . 85515) ( +\DSPXPOSITION.HCPYMODE 85517 . 86098) (\DSPYPOSITION.HCPYMODE 86100 . 86505) (\MOVETO.HCPYMODE 86507 + . 86659) (\FONTCREATE.HCPYMODE.PRESS 86661 . 87673) (\CREATECHARSET.HCPYMODE.PRESS 87675 . 88646) ( +\FONTCREATE.HCPYMODE.INTERPRESS 88648 . 89682) (\CREATECHARSET.HCPYMODE.INTERPRESS 89684 . 90672) ( +\STRINGWIDTH.HCPYMODE 90674 . 91108) (\HCPYMODEBLTCHAR 91110 . 94079) (\HCPYMODEDISPLAYINIT 94081 . +97012) (\HCPYMODEDSPPRINTCHAR 97014 . 99195) (\SLOWHCPYMODEBLTCHAR 99197 . 102711) (\SFFixY.HCPYMODE +102713 . 104210))))) STOP diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM index fa59fbbe6feefd39fadfdeb781be606d9a11ef7a..ace4369d8e170d5b702c796e511ecb2f70613252 100644 GIT binary patch delta 739 zcmaiy&rcIU6vx}CfGm(`EGi|jFB=0}k}W&4{XrKcEZr>ywm;|(Nr@&l?JCvMl5IH= z17}Z~G4bxj#7MGqg+#q@_o5g73S;nKyou9#P!khgCiCXyz4?6S&CJmWdio7LS=%MD zxV+sEi9}?OBn1;i4)Y-JmFDJFt!`GK*#I7P)>67==%q(DTFq^%Vz%azYEFx1vZdfG z#sT1XLjG`wtb}63qCPr{rV*Z@byVrPPbkBj z!+XA;zx1Ww<#OM3G4uE4i>rNfYPhxQ>0GNK@noFM>})IU^lw+ z;KY$reV)Tf!>GRTR%<7(R$KZBiUC(8*fFn^z$CCqUE)O^?)33uqNh+9pj+fo4VG+|$=vcXfY ZeVx%}>>&N{YK-pLeh%yeI4Ch z!}UV^1A;vLLR^D16|4e+T*Ey5LxXi)fR0g6GBVKhD$Rigrn!}&2@okMaN%)`7}nr3 zoV=Z}fyvl>vL#b8h?>Xb52QA~XZp$^e2$fYfiZyr2;{+}pd-uV@7%?KDa@PX_wV;f zVPaz3B+SH^4^rU+t=}=9540h%=d+Pv+!pU^XRUM$2lBE-ej4I~%<467hlcTaymuE|+z1KBjR6s#4vHXmGD%`{nQ ftMKH84Z@SBY|xwhd5g^CyBlPgL6UzrOkoEAp$5dg From f765676ec40db72a2abfa35b227c2a1d0087b4be Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 2 Oct 2023 12:56:57 -0700 Subject: [PATCH 20/37] UNIXUTILS: Add UNIX-FILE-NAME etc on top of previous ShellWhich update--should resynch --- library/UNIXUTILS | 113 ++++++++++++++++++++++++++++++++++++---- library/UNIXUTILS.DFASL | Bin 2667 -> 4896 bytes 2 files changed, 104 insertions(+), 9 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index ab7a4619..0758f19f 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,19 +1,30 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Jun-2023 13:30:18" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;11 4989 +(FILECREATED " 2-Oct-2023 12:54:58" {WMEDLEY}UNIXUTILS.;10 10535 + + :EDIT-BY rmk :CHANGES-TO (FUNCTIONS ShellWhich) - :PREVIOUS-DATE "18-Jan-2023 20:36:10" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;8 -) + :PREVIOUS-DATE " 1-Oct-2023 20:52:23" {WMEDLEY}UNIXUTILS.;9) (PRETTYCOMPRINT UNIXUTILSCOMS) -(RPAQQ UNIXUTILSCOMS ((GLOBALVARS ShellBrowser) - (INITVARS (ShellBrowser)) - (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse))) +(RPAQQ UNIXUTILSCOMS + ((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND") + (FILES (FROM LOADUPS) + EXPORTS.ALL)) + (GLOBALVARS ShellBrowser) + (INITVARS (ShellBrowser)) + (FUNCTIONS ShellCommand ShellWhich) + (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) + (PROPS (UNIXUTILS FILETYPE)))) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) +) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS ShellBrowser) @@ -104,8 +115,92 @@ " >>/tmp/ShellBrowser-warnings-$$.txt"))) T) else NIL]) + +(PROCESS-COMMAND + [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") + + (* ;; "This sets up an asynchronous process and waits until it returns with an exit code. Typically 0 means success.") + + (CL:WITH-OPEN-STREAM (PS (CREATE-PROCESS-STREAM CMD)) + (BIND CODE WHILE (EQ T (SETQ CODE (OR (SUBRCALL UNIX-HANDLECOMM 7 (fetch (STREAM F1) + of PS)) + 0))) DO (BLOCK) FINALLY (RETURN CODE]) + +(SLASHIT + [LAMBDA (X LCASEDIRS NOHOST) (* ; "Edited 23-Sep-2023 15:27 by rmk") + + (* ;; "It would also be nice to use the generic unpackfilename/packfilename tools. But packfilename sticks in brackets again, and sticks a dot on when removing the version.") + + (* ;; "Perhaps this should be a per file-device operation that maps device names into the local file system.") + + (* ;; "This is a first approximation to a utility that converts a filename X on a host whose files physically reside in the local Unix file system into the strings that shell commands can use to reference that file. For now, this just involves replacing directory brackets with /, removing the host, and perhaps lower-casing the directory. It probably should be extended to deal with version number translation, for now it just keeps the ; version. ") + + (LET [LASTDIRPOS SLASHED (DIRPOS (ADD1 (OR (STRPOS "}" X) + 0] + [SETQ SLASHED (CONCATCODES (FOR I C FROM DIRPOS WHILE (SETQ C (NTHCHARCODE X I)) + COLLECT (SELCHARQ C + ((< >) + (SETQ LASTDIRPOS I) + (CHARCODE /)) + (/ (SETQ LASTDIRPOS I) + C) + C] + (CL:WHEN (AND LCASEDIRS LASTDIRPOS) + (SETQ LASTDIRPOS (ADD1 (IDIFFERENCE LASTDIRPOS DIRPOS))) + (SETQ SLASHED (CONCAT (L-CASE (SUBSTRING SLASHED 1 LASTDIRPOS)) + (OR (SUBSTRING SLASHED (ADD1 LASTDIRPOS)) + "")))) + (CL:IF (OR (EQ DIRPOS 1) + NOHOST) + SLASHED + (CONCAT (SUBSTRING X 1 (SUB1 DIRPOS)) + SLASHED))]) + +(UNIX-FILE-NAME + [LAMBDA (FILE ACCESS COPY) (* ; "Edited 1-Oct-2023 20:52 by rmk") + + (* ;; "Tries to return the string that would reference FILE in a Unix shell, for the use of PROCESS-COMMAND and ShellCommand. If VERSION is 1, it assumes that the Unix file is doesn't have the Medley version convention. If FILE does not have a corresponding Unix name, COPY is non-NIL, and ACCESS is INPUT, FILE will be copied to a unix tmp file (with COPY in its name) and that name will be returned.") + + (CL:WHEN (\GETSTREAM FILE ACCESS T) + (SETQ FILE (OR (FULLNAME FILE) + FILE))) (* ; "Might catch NODIRCORE") + (CL:WHEN FILE + (SETQ FILE (TRUEFILENAME FILE)) + (CL:UNLESS (STREAMP FILE) + [SETQ FILE (\GETFILENAME FILE (SELECTQ ACCESS + (OUTPUT 'NEW) + (INPUT 'OLD) + (NIL (SETQ ACCESS 'INPUT) + 'OLD) + (\ILLEGAL.ARG ACCESS]) + [SELECTQ (FILENAMEFIELD FILE 'HOST) + (UNIX [SUBSTRING FILE (ADD1 (CONSTANT (NCHARS "{UNIX}"]) + (DSK (LET [(VERSION (FILENAMEFIELD FILE 'VERSION] + (SETQ FILE (SLASHIT (PACKFILENAME 'HOST NIL 'VERSION NIL 'BODY FILE))) + (CL:IF (AND VERSION (IGREATERP VERSION 1)) + (CONCAT FILE (CL:IF (FILENAMEFIELD FILE 'EXTENSION) + "." + "") + "~" VERSION "~") + FILE))) + (CL:WHEN (AND COPY (EQ ACCESS 'INPUT)) + (RESETLST + (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") + [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE]) + (COPYFILE FILE (CONCAT "{UNIX}/tmp/medley-" (L-CASE COPY) + "-" + (IDATE) + "-" + (RAND) + (CL:IF (FILENAMEFIELD FILE 'EXTENSION) + (CONCAT "." (FILENAMEFIELD FILE 'EXTENSION)) + "")))))])]) ) + +(PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (664 1037 (ShellCommand 664 . 1037)) (1039 1436 (ShellWhich 1039 . 1436)) (1437 4966 ( -ShellBrowser 1447 . 3970) (ShellBrowse 3972 . 4964))))) + (FILEMAP (NIL (927 1300 (ShellCommand 927 . 1300)) (1302 1699 (ShellWhich 1302 . 1699)) (1700 10457 ( +ShellBrowser 1710 . 4233) (ShellBrowse 4235 . 5227) (PROCESS-COMMAND 5229 . 5842) (SLASHIT 5844 . 7886 +) (UNIX-FILE-NAME 7888 . 10455))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index 98d669df6bdcd66023b1dd50ed0be00ebe277f64..e9cb27338f7ba39d2606d35dfbdcd0bd0f7fceb3 100644 GIT binary patch delta 2816 zcmaJ@U5p!76~1@IfBPG6yAhGKG%g}7gxH(?qah8!v-WsByW^RuXPnq*VYQn$^~O%! z-6qgz8@z#_R$!63lPq(?7PW|{N|a>zQOMsmZv-KD=|c(+JRo@K%OVwC%Q`PWsJ^(cJimPQaM938MMu-^JddxrOmvh=_<)g!%3S~*>h!> z^1b+b)@wbUZ7j#Ff|*urI|0k{ijnb`1hb%Nd#(g41KEO^hcT?1N~UPpK=!C5%Pcr{ zQqj5YHl(8v#pRZqHEc16V!K+Y*C&@7-+rkA(;bhx09&@M*g4GsX+LHsf&LPPl2?77 zK~Mott|WHBk_bwjvZeNTF83};UTg4?41S4Hc)7KE<^Lz2t&4Mn~Lhfi&0Le+Lvk?LHIyET|NN4$$uecRyC<5M0-+ zCP-{b)?$C&ha zQRZUa{d)MLiKXwtg4aayWs$6lr8$wbL{bsSVelBToq}cBSj8Sn-jwR7#*rcMiu=7t zn~%6VyWY-@Na$Y1azYkU0?qwUoIT(DvPirnmdc^=dPMyv?hB&sAg9 zW1-EHss2q0CCX%p!u*LW(|AQ_lJrQ@$EAd*$1t=>-AvE$uy>IXs498Jc7Wr4>v^>Q zTo3-iB>~Z%`Ie-DslJ&aIxT-5+>Tu3oR+ zs@~QH2Er+WM05RbUp-*<*AH#YMc*)^7l1sxb;-C{A8r9TjHKCr-t51vU()kW-MWyk z#%8Y@&D#5SuD+KG_i@_w4W&J^THQ#@Xdl$>-<+<^P~aq*o~hj@N8f1YFHlG{yP?&# zfU`Q;o{pw!TI~bUm?jz2Eey%wX$em-*CcEZ-EcUajD{eSB(M44xT+bdambf2>8eB%TKZkR}$pN$r$OwxSCZU?^wIIqCKL;&f z+%Fp+N-2w!i#L62W9d>0Y%}$E! zFH_7(-^!fp9|Lg-4;aqqj?b8}!e^ z#vXzj{j4V8Cl;&5Viq9}i05L*q)m$i1>zA&jrt+wTcjhfv5VN-IK=i*+7|}@j2L8V zdxM8=jQGDJ`|bF8r{mue8g%MUUaw#7#eMup)N%N}IEBM1>^6b`#A>aGrG{AYlXbU5 zX}OCJn?M2HJ!v3wP&9S`I`F+RW%#$z zz0euxHFMBwk~#P#4&!gkYdyAtwK_L^`qYcVrz*$mm9vQ$z78NlC>p%jiYkMcdBj^| zVM=9`iCM;A|DD^1!+GqXqgOPJYDPw6VT-uUe}IecAn~^c#9tr;WV{cIBuBFWQGOFF z_fjD!&r#;Jq9gIsjTaO3%C{=@_=(2yDbQiqviT~<8zEv9zv$3ojB$7s$zqpy2KL+A Qd0f)Fja@-cTOWV?Umt7@Qvd(} delta 551 zcma)$Uu)A~6vlIsw6S#;Lo0fr9BfC(+53mctZ=#>T8?OZMcD@}d2wn&W4(FWbJiq77<*$Xks~4SM>G6#_ zgN@ki4%?e|&0gQ!h&%mw*IfVAN3^g?^TA+yxE7OcuOE}OVcfnKcL<%+7PmLG;%reT zRG-&p=V>`#wF38VS#{X!w0CE?oN#$e#(F*-Kj`%E-3I`feG->JV%Mc}&dHQP`btcb z!oU3Ylk%hg%ABFX0jlh?6oJYN`Adp8%iB!|)*sY8WB{s@fs_}adTcB{G3D5U5*S9TKtNBRTw@e5It7g?x4y5}@E^36$ zddpiX9Ux&3vNwUSkJ-`b5^x&+G2@UjiiUf!HL&n)bpdGpOqx7Hvj+t From 1e847ec274fc5e3bd799128f79b4f38a6c126f94 Mon Sep 17 00:00:00 2001 From: Frank Halasz Date: Sun, 8 Oct 2023 19:34:43 -0700 Subject: [PATCH 21/37] Add ShellOpen (and ShellOpener) to UNIXUTILS; fix small bug in UNIX-FILE-NAME (#1341) * Add ShellOpener and ShellOpen to UNIXUTILS - used to open a file using the generic opener on this machine. Adapted ShellBrowse and ShellBrowser accordingly; fixed bug in UNIX-FILE-NAME where it fails if file does not exist and COPY is non-NIL and access is INPUT * Add return of error strings to ShellOpen --- library/UNIXUTILS | 189 +++++++++++++++++++++++++++++----------- library/UNIXUTILS.DFASL | Bin 4896 -> 6443 bytes 2 files changed, 137 insertions(+), 52 deletions(-) diff --git a/library/UNIXUTILS b/library/UNIXUTILS index 0758f19f..2150c55e 100644 --- a/library/UNIXUTILS +++ b/library/UNIXUTILS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Oct-2023 12:54:58" {WMEDLEY}UNIXUTILS.;10 10535 +(FILECREATED " 8-Oct-2023 15:06:52" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;15 14696 - :EDIT-BY rmk + :CHANGES-TO (FNS ShellOpen UNIX-FILE-NAME ShellBrowser ShellBrowse ShellOpener) + (VARS UNIXUTILSCOMS) - :CHANGES-TO (FUNCTIONS ShellWhich) - - :PREVIOUS-DATE " 1-Oct-2023 20:52:23" {WMEDLEY}UNIXUTILS.;9) + :PREVIOUS-DATE " 8-Oct-2023 02:35:47" {DSK}frank>il>medley>gmedley>library>UNIXUTILS.;14 +) (PRETTYCOMPRINT UNIXUTILSCOMS) @@ -15,10 +15,11 @@ ((DECLARE%: EVAL@COMPILE DONTCOPY (* ; "For PROCESS-COMMAND") (FILES (FROM LOADUPS) EXPORTS.ALL)) - (GLOBALVARS ShellBrowser) - (INITVARS (ShellBrowser)) + (GLOBALVARS ShellBrowser ShellOpener) + (INITVARS (ShellBrowser) + (ShellOpener)) (FUNCTIONS ShellCommand ShellWhich) - (FNS ShellBrowser ShellBrowse PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) + (FNS ShellBrowser ShellBrowse ShellOpener ShellOpen PROCESS-COMMAND SLASHIT UNIX-FILE-NAME) (PROPS (UNIXUTILS FILETYPE)))) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -27,11 +28,13 @@ ) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS ShellBrowser) +(GLOBALVARS ShellBrowser ShellOpener) ) (RPAQ? ShellBrowser ) +(RPAQ? ShellOpener ) + (CL:DEFUN ShellCommand (Cmd &OPTIONAL (Output T)) (CL:WITH-OPEN-STREAM (s (CREATE-PROCESS-STREAM Cmd)) (CL:TAGBODY [SETFILEINFO s 'ENDOFSTREAMOP #'(CL:LAMBDA (s) @@ -55,50 +58,44 @@ (ShellBrowser [LAMBDA NIL (* ; "Edited 18-Jan-2023 20:30 by FGH") - (OR ShellBrowser (SETQ ShellBrowser (LET (CMDPATH) - (if (STRPOS "darwin" (OR (UNIX-GETENV "OSTYPE") - (UNIX-GETENV "PATH"))) - then - (* ;; " MacOS") - "open" - elseif (SETQ CMDPATH (ShellWhich "wslview")) - then - (* ;; "windows with WSL") + (* ;; "Figure out the browser to use for the ShellOpen/ShellBrowse functions. ") - CMDPATH - elseif (SETQ CMDPATH (ShellWhich "xdg-open")) - then - (* ;; "Linux systems with xdg-utils installed ") + (* ;; " Ordinarily, this would be the same as the generic ShellOpener.") - CMDPATH - elseif (SETQ CMDPATH (ShellWhich "git")) - then - (* ;; " Systems with git installed") + (* ;; " But if a generic ShellOpener is not found, then there are some additional") - (CONCAT CMDPATH " web--browse") - (* ; "") - elseif (SETQ CMDPATH (ShellWhich "lynx")) - then - (* ;; " Systems with lynx installed") + (* ;; " possibilities that will work for http/https URLs. If one of these exists return it.") - (LET (CMDPATH2) - (if (SETQ CMDPATH2 (ShellWhich "xterm")) - then (CONCAT CMDPATH2 " -e " CMDPATH) - else (LIST CMDPATH))) - else - (* ;; - " Out of ideas - just return a dummy function") + (OR ShellBrowser (SETQ ShellBrowser + (if (NOT (STREQUAL (ShellOpener) + "true")) + then ShellOpener + else (LET (CMDPATH) + (if (SETQ CMDPATH (ShellWhich "git")) + then + (* ;; " Systems with git installed") - "true"]) + CMDPATH + elseif (SETQ CMDPATH (ShellWhich "lynx")) + then + (* ;; " Systems with lynx installed") + + (LET (CMDPATH2) + (if (SETQ CMDPATH2 (ShellWhich "xterm")) + then (CONCAT CMDPATH2 " -e " CMDPATH) + else (LIST CMDPATH))) + else + (* ;; " Out of ideas - just return a dummy function") + + "true"]) (ShellBrowse [LAMBDA (URL) (* ; "Edited 18-Jan-2023 20:32 by FGH") (* ;; " Open the web page specified by URL using an external browser via shell call") - (* ;; - " URL must start with http:// or https:// (case ireelevant) or this function will just return NIL.") + (* ;; " URL must start with http:// or https:// or file:/// (case ireelevant) or this function will just return NIL.") (* ;; " Returns T otherwise.") @@ -106,15 +103,102 @@ (if (OR (EQ (STRPOS "http://" (L-CASE URL)) 1) (EQ (STRPOS "https://" (L-CASE URL)) + 1) + (EQ (STRPOS "file:///" (L-CASE URL)) + 1)) + then (ShellOpen URL) + else NIL]) + +(ShellOpener + [LAMBDA NIL + + (* ;; "Find an %"opener%" that will open files (and URLs) using the appropriate/default app on this machine") + + (OR ShellOpener (SETQ ShellOpener (LET (CMDPATH) + (if (SETQ CMDPATH (ShellWhich "wslview")) + then + (* ;; "windows with WSL") + + CMDPATH + elseif (SETQ CMDPATH (ShellWhich "cygstart")) + then + (* ;; "windows with cygwin") + + CMDPATH + elseif (SETQ CMDPATH (ShellWhich "xdg-open")) + then + (* ;; "Linux systems with xdg-utils installed ") + + CMDPATH + elseif (SETQ CMDPATH (ShellWhich "open")) + then + (* ;; " MacOS open") + + CMDPATH + else + (* ;; + " Out of ideas - just return a dummy function") + + "true"]) + +(ShellOpen + [LAMBDA (FilenameOrURL) + + (* ;; "Open the file or URL using the generic %"opener%" for this machine via a shell call.") + + (* ;; " If FilenameOrURL starts with %"http://%" or %"https://%" or %"file:///%", then we use (ShellBrowser) as") + + (* ;; " the %"opener%" (which includes some browsers on a machine without a generic opener).") + + (* ;; + " Otherwise FilenameOrURL is assumed to be a filename and will be opened using (ShellOpener).") + + (* ;; " Returns T is all goes well; returns an error string if all does not go well") + + (SETQ FilenameOrURL (MKSTRING FilenameOrURL)) + (if (OR (EQ (STRPOS "http://" (L-CASE FilenameOrURL)) + 1) + (EQ (STRPOS "https://" (L-CASE FilenameOrURL)) + 1) + (EQ (STRPOS "file://" (L-CASE FilenameOrURL)) 1)) then (LET ((BROWSER (ShellBrowser))) - (if (LISTP BROWSER) - then (CHAT 'SHELL NIL (CONCAT (CAR BROWSER) - " '" URL "'")) - else (ShellCommand (CONCAT BROWSER " '" URL "'" - " >>/tmp/ShellBrowser-warnings-$$.txt"))) - T) - else NIL]) + (if (NOT (STREQUAL BROWSER "true")) + then (if (LISTP BROWSER) + then (CHAT 'SHELL NIL (CONCAT (CAR BROWSER) + " '" FilenameOrURL "'")) + else (ShellCommand (CONCAT BROWSER " '" FilenameOrURL "'" + " >>/tmp/ShellBrowser-warnings-$$.txt")) + T) + else (CONCAT "Unable to find a browser to open: " FilenameOrURL))) + else + (LET ((OPENER (ShellOpener)) + (UNIXFILE (UNIX-FILE-NAME FilenameOrURL 'INPUT T))) + (if (NOT UNIXFILE) + then (CONCAT "File not found: " FilenameOrURL) + elseif (NOT (STREQUAL OPENER "true")) + then (CL:WITH-OPEN-STREAM + (SHELLSTREAM (OPENSTREAM (CONCAT "{CORE}SHELLOUT" (RAND)) + 'BOTH)) + (ShellCommand (CONCAT OPENER " '" UNIXFILE "'" + " >>/tmp/ShellOpener-warnings-$$.txt") + SHELLSTREAM) + (if (EQ (GETFILEPTR SHELLSTREAM) + 0) + then T + else (LET* ((OUTSTRING (ALLOCSTRING (GETFILEPTR SHELLSTREAM) + " "))) + (CL:WITH-OPEN-STREAM (STRINGSTREAM (OPENSTRINGSTREAM OUTSTRING + 'OUTPUT)) + (SETFILEPTR SHELLSTREAM 0) + (CL:TAGBODY [SETFILEINFO SHELLSTREAM 'ENDOFSTREAMOP + #'(CL:LAMBDA (s) + (GO OUT] + (CL:LOOP (PRINTCCODE (READCCODE SHELLSTREAM) + STRINGSTREAM)) + OUT)) + OUTSTRING))) + else (CONCAT "Unable to find a file opener to open: " FilenameOrURL]) (PROCESS-COMMAND [LAMBDA (CMD) (* ; "Edited 17-Jul-2022 08:17 by rmk") @@ -183,7 +267,8 @@ "") "~" VERSION "~") FILE))) - (CL:WHEN (AND COPY (EQ ACCESS 'INPUT)) + (CL:WHEN (AND COPY (EQ ACCESS 'INPUT) + FILE) (RESETLST (CL:WHEN (\GETSTREAM FILE 'INPUT T) (* ; "Hope is randaccess") [RESETSAVE (GETFILEPTR FILE) @@ -200,7 +285,7 @@ (PUTPROPS UNIXUTILS FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTCOPY - (FILEMAP (NIL (927 1300 (ShellCommand 927 . 1300)) (1302 1699 (ShellWhich 1302 . 1699)) (1700 10457 ( -ShellBrowser 1710 . 4233) (ShellBrowse 4235 . 5227) (PROCESS-COMMAND 5229 . 5842) (SLASHIT 5844 . 7886 -) (UNIX-FILE-NAME 7888 . 10455))))) + (FILEMAP (NIL (1144 1517 (ShellCommand 1144 . 1517)) (1519 1916 (ShellWhich 1519 . 1916)) (1917 14618 +(ShellBrowser 1927 . 3675) (ShellBrowse 3677 . 4362) (ShellOpener 4364 . 6052) (ShellOpen 6054 . 9357) + (PROCESS-COMMAND 9359 . 9972) (SLASHIT 9974 . 12016) (UNIX-FILE-NAME 12018 . 14616))))) STOP diff --git a/library/UNIXUTILS.DFASL b/library/UNIXUTILS.DFASL index e9cb27338f7ba39d2606d35dfbdcd0bd0f7fceb3..8cfdae7d1b4ad2fefc52a2506d71c8d3a74f770c 100644 GIT binary patch delta 3294 zcma(TZERE5_1*XU6+0nLFv*g!?rorCUhFh|CY1Xyd`lFpTQQ99xY>TF8(zc1bO|*mZYgDV)Iro`R z2tR6B_uO;tx##-)6fli$eX=hEHNg;effcXqaWEEA~PZs^bKybU<7U~LgbcKTM{;;M#$fh01O{I=+ zm3PR%ou5b-WW2GJU+L@$?0o%agb;=Pf&}RwNF!;d?~{!k6=CzD;n6bb+1dD^bS_=k z3AiH`?^R-b?aa3guu6W~TgV?hoG!GmHS1U%eN23FqXcK}0X5zmR=*WaXsnL;Oo~L8 z5>s>}nUnzU9Wk`Y1!So|228NA)L8=I&PAhQSw9_+dUiFSjDAIp>SLo(4+t@z7fr+W zs4!eKcAWT9p|yvEMb=9HE{&5`8nS&9RLl#8_wi(GH#q7aO~mzRM1PzqHbEffbA~gb z#4-f-R61`DH;vq*lf%Rbf+}P2m|u-Y!m58D&J_BoT_+>7-_cY% zPSC&cQ9Uu3j19LhvH(5m=ph06mScXkN_uO9Ku_CogehN5XVaayj$`^vZ@BuXrEd zyEw!V#e>Xelni~*RZ)F*KVtQ`cm+|UmtBpeItef)L9U;MNL45?J(^GzZS=Gw$%+Fk z(8&UuSb!%{(-YBM$*@|@e70FuH^Y2RRtGiV*l!xPV&OB&K|sl{`ppt7c3@k#tW>F3n`gU z*>({Fk1m*0WD#}-&c4T&C6>kA$`8R?c&7BM0XKj5y`)>eAc-DvlL>0^|*>PpL**nU6qXn6C3=$bE}^U7I{)!xej zVJDam94O}i%(nHhK!^oeSfHK-Bn_kNBg|(XDM#-KfO+`31KYr|V^cGJMApH6^7zc* zVyaNAH4W#{!?WMXrjJ6T+sy?BM1(ZZs})VVzkH~#O!5k>A)-}EJTWhD<9qntJ0x9^ zXTWkHGjzdSCwhlyqxI=5u2GKJ{pZh6C&o= z*_(*()}jesNLBri;#_Jj9WP)>wL4dq)FR}j4kNjm6|ux_u`Gg*EbIf2XiJ1+r9LG7 z%_9DpokHv?>qPJ?=0orbYen#q#qxc;7a0ueNPC7Ar&)0?JEgKZtB%igTSfU`#XeN9 zoaF}+O1M#C2N1piV(m(7G^roLorY2I!U3r=4KMmC=ki5)IuBE(OGdigT(IHA(-`wT zOBxTe&R4!v+2K$~@YF0Nc;z3s^?Wwdc)8cYIG0=a3UH0x&*I?cK4B>ft4M$1s4p!k zna0edd+9*WswFPND@YahOeQA!_Z|38!mffGSx;N z@}$$&&vtdQL?_cKSwU)MdOcHXS(5n81)*y2Z80aD<(7B_(`cMc%}q?D8$!_>ZOv zxomFcu)n!^Tk%+N74U9!nT9BD6vy0L7go&Y^aD>r$&^SrUr!3+@}zUYq!V${A>(z^ zSal*2Pef1ha)iJm^{=MUlFX$hpd^cVcmw68$HER+@M*3JtT-i4M0&N3gFhHk0;dSqptNb0PYVo03*eUv1p8m-b zY_BXA5^J}oVLQD2q z-v=I;*1>ts{vlFM^X>VkEDC+GYCX0H;hZ2Mpr!$@DubMa;nHa?xPV4vdcEqa#76&H z^~BdUeXdw=dIv?`HBbJ>;#Ae~gUSPbGLn9sy{>-hY7e{cjxUakWpk zuJv(n_nQ_L!oyf}_co5c#^skcWs_$j_f>`Gr)kM87z^N(@xs*8g=_B4l|X%_IYLbds5(hp2Zf!08~*cR9k3hoGXxMOlU zA-*)0%Zdkz*}=)|u-KCyA09l^A_hdT&JSgaBK2rtE}EO}rMS zkW1B6g95ly2(5AeBE&Shd&aDMAR_)y2%`r4t57dK<}7E-rkRIMZExjDM8c}AA4&LA z+i!uGb=vf7>DBsxk(5m7h7vKhkeH3*kafy*MiP3uH>Fq@(Vr=F1={cpdjzSNcgRh< z@8f6!IU!J$rfX6{kH`tBOD8cr9E>U5@P@MO9=!vXKFfY6thQd3U>5626%qmiCyQa0iNo)*KotP!sb|KqBkb<m+^cnFwi5C%X71b_SrfstLT9(SE zKo+H}NaYijX`i0V77tDUm^(B+Jz|+v;#9V8NRo!w9o+|Q9vPeLwoKRb@Q9RuH9Nl3 zGM!Tsx!1?CQz3Ap&<0rPVd^c@p{I>ZQmFxHc(6D%HV#*;ZMiMS@!HC!PA@A)m^Fq~ z^Od_xJuYCwRU@PdOY26cJgTCy9s5>Mh}HAvVv~w5Rj!$Z(JGg&Go|;Xl@!N8DTLls zg0%7U1_>61A5X%Bp7dRE=$Lz&NE4)x0XthHE*l0Zgow9=%rw(_CZvd*R_e%%hdIo# zvFquEGOJn_lEK8Djw^|T^Ppv}7oW!`JnMX;mWi5&ERz?Tbtfk9aKAA4_gFchMWB8STAL2ShqeXw|Vb;{AhTHyBYrY zGUBku`?KqPnRWRt{>vLgF}$fR?f;ep?dX3jZ?KHl+4mZ-e1fw116Y1u*NEEjcXds* zw^j%)<(c6v{CC}81#OwCC3_7#;M=_FDz!Qfm@N)hlq&Pg_A0*Mduscge%KN8MATs5 z?I>G*dakU6=%%Lh(HGpI_Zkq>0TGY~|LOZ=_QrA}z7cq4evPP{@JQRXu{nH?NfXoT+*x{*yZ7$>3ms+|umAu6 From 270fee89e3861742ccd2d1fb248daaef510a713e Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Thu, 12 Oct 2023 13:19:59 -0700 Subject: [PATCH 22/37] Fix for typo; issue #1347 --- scripts/medley/medley_utils.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/medley/medley_utils.sh b/scripts/medley/medley_utils.sh index a0043620..d971cf35 100644 --- a/scripts/medley/medley_utils.sh +++ b/scripts/medley/medley_utils.sh @@ -97,7 +97,7 @@ check_file_readable() { check_dir_writeable_or_creatable() { local msg_core="\"$2\" given as the value of the \"$1\" flag" - if [[ -e "$%2" ]]; + if [[ -e "$2" ]]; then if [[ ! -d "$2" ]]; then From d92aa6395a9019fc1602ecb367143eaf09dd6d4e Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Sat, 14 Oct 2023 06:39:13 -0700 Subject: [PATCH 23/37] Manager (Lispusers) grow anchor, icon, and fix typo. (#1346) * File See operations use full path to loaded file. Add Manager.WINDOW-ANCHOR to fix corner from which MANAGER-MAIN-WINDOW grows, and (attempt) to keep it on-screen. * Improved handling of the ICONW for MANAGER-MAIN-WINDOW. * Fix typo in MasterScope functions (multiple occurrences: LOADBFLG should be LOADDBFLG). Changed to CL compiler by default (not need to go to submenu). This is my preference, so I should remove it before setting pull request. * Manual cleanup of multiple "Edited" comments in 4 FNS. Reverted: Changed to CL compiler by default (not need to go to submenu). (From commit f60c6362) * Update MANAGER.TEDIT documentation file. Fix error in previous commit. (Changes that I thought were there, were not.) Cleanup COMMON-MAKE COMS so it can be handled by the file package, and add .LCOM file to the repo. --- installers/win/editpath/EditPath.iss | 330 +++++++++++++-------------- installers/win/editpath/EditPath.md | 236 +++++++++---------- lispusers/COMMON-MAKE | 57 ++--- lispusers/COMMON-MAKE.LCOM | Bin 0 -> 7420 bytes lispusers/MANAGER | 287 ++++++++++++----------- lispusers/MANAGER.DFASL | Bin 48815 -> 49586 bytes lispusers/MANAGER.TEDIT | Bin 39941 -> 40966 bytes scripts/medley/medley.cmd | 6 +- 8 files changed, 466 insertions(+), 450 deletions(-) create mode 100644 lispusers/COMMON-MAKE.LCOM diff --git a/installers/win/editpath/EditPath.iss b/installers/win/editpath/EditPath.iss index 0312dcaa..b70d571d 100644 --- a/installers/win/editpath/EditPath.iss +++ b/installers/win/editpath/EditPath.iss @@ -1,165 +1,165 @@ -; Copyright (C) 2021-2023 by Bill Stewart (bstewart at iname.com) -; -; This program is free software; you can redistribute it and/or modify it under -; the terms of the GNU Lesser General Public License as published by the Free -; Software Foundation; either version 3 of the License, or (at your option) any -; later version. -; -; This program is distributed in the hope that it will be useful, but WITHOUT -; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more -; details. -; -; You should have received a copy of the GNU Lesser General Public License -; along with this program. If not, see https://www.gnu.org/licenses/. - -; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script -; demonstrating use of PathMgr.dll. -; -; This script uses PathMgr.dll in the following ways: -; * Copies PathMgr.dll to the target machine (required for uninstall) -; * Defines a task in [Tasks] that should modify the Path -; * Imports the AddDirToPath() DLL function at setup time -; * Imports the RemoveDirFromPath() DLL function at uninstall time -; * Stores task state as custom setting using RegisterPreviousData() -; * Retrieves task state custom setting during setup and uninstall initialize -; * At post install, adds app dir to Path if task selected -; * At uninstall, removes dir from Path if custom setting present -; * Unloads and deletes DLL and removes app dir at uninstall deinitialize - -#if Ver < EncodeVer(6,0,0,0) - #error This script requires Inno Setup 6 or later -#endif - -[Setup] -AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842} -AppName=EditPath -AppVersion=4.0.4.0 -UsePreviousAppDir=false -DefaultDirName={autopf}\EditPath -Uninstallable=true -OutputDir=. -OutputBaseFilename=EditPath_Setup -ArchitecturesInstallIn64BitMode=x64 -PrivilegesRequired=none -PrivilegesRequiredOverridesAllowed=dialog - -[Files] -; Install PathMgr.dll for use with both setup and uninstall; use -; uninsneveruninstall flag because DeinitializeSetup() will delete after -; unloading the DLL; install the 32-bit version of PathMgr.dll because both -; setup and uninstall executables are 32-bit -Source: "i386\PathMgr.dll"; DestDir: "{app}"; Flags: uninsneveruninstall - -; Other files to install on target system -Source: "i386\EditPath.exe"; DestDir: "{app}"; Check: not Is64BitInstallMode() -Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode() -Source: "EditPath.md"; DestDir: "{app}" - -[Tasks] -Name: modifypath; Description: "&Add to Path" - -[Code] -const - MODIFY_PATH_TASK_NAME = 'modifypath'; // Specify name of task - -var - PathIsModified: Boolean; // Cache task selection from previous installs - ApplicationUninstalled: Boolean; // Has application been uninstalled? - -// Import AddDirToPath() at setup time ('files:' prefix) -function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD; - external 'AddDirToPath@files:PathMgr.dll stdcall setuponly'; - -// Import RemoveDirFromPath() at uninstall time ('{app}\' prefix) -function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD; - external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly'; - -// Wrapper for AddDirToPath() DLL function -function AddDirToPath(const DirName: string): DWORD; -var - PathType, AddType: DWORD; -begin - // PathType = 0 - use system Path - // PathType = 1 - use user Path - // AddType = 0 - add to end of Path - // AddType = 1 - add to beginning of Path - if IsAdminInstallMode() then - PathType := 0 - else - PathType := 1; - AddType := 0; - result := DLLAddDirToPath(DirName, PathType, AddType); -end; - -// Wrapper for RemoveDirFromPath() DLL function -function RemoveDirFromPath(const DirName: string): DWORD; -var - PathType: DWORD; -begin - // PathType = 0 - use system Path - // PathType = 1 - use user Path - if IsAdminInstallMode() then - PathType := 0 - else - PathType := 1; - result := DLLRemoveDirFromPath(DirName, PathType); -end; - -procedure RegisterPreviousData(PreviousDataKey: Integer); -begin - // Store previous or current task selection as custom user setting - if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then - SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true'); -end; - -function InitializeSetup(): Boolean; -begin - result := true; - // Was task selected during a previous install? - PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true'; -end; - -function InitializeUninstall(): Boolean; -begin - result := true; - // Was task selected during a previous install? - PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true'; - ApplicationUninstalled := false; -end; - -procedure CurStepChanged(CurStep: TSetupStep); -begin - if CurStep = ssPostInstall then - begin - // Add app directory to Path at post-install step if task selected - if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then - AddDirToPath(ExpandConstant('{app}')); - end; -end; - -procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep); -begin - if CurUninstallStep = usUninstall then - begin - // Remove app directory from path during uninstall if task was selected; - // use variable because we can't use WizardIsTaskSelected() at uninstall - if PathIsModified then - RemoveDirFromPath(ExpandConstant('{app}')); - end - else if CurUninstallStep = usPostUninstall then - begin - ApplicationUninstalled := true; - end; -end; - -procedure DeinitializeUninstall(); -begin - if ApplicationUninstalled then - begin - // Unload and delete PathMgr.dll and remove app dir when uninstalling - UnloadDLL(ExpandConstant('{app}\PathMgr.dll')); - DeleteFile(ExpandConstant('{app}\PathMgr.dll')); - RemoveDir(ExpandConstant('{app}')); - end; -end; +; Copyright (C) 2021-2023 by Bill Stewart (bstewart at iname.com) +; +; This program is free software; you can redistribute it and/or modify it under +; the terms of the GNU Lesser General Public License as published by the Free +; Software Foundation; either version 3 of the License, or (at your option) any +; later version. +; +; This program is distributed in the hope that it will be useful, but WITHOUT +; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +; FOR A PARTICULAR PURPOSE. See the GNU General Lesser Public License for more +; details. +; +; You should have received a copy of the GNU Lesser General Public License +; along with this program. If not, see https://www.gnu.org/licenses/. + +; Sample Inno Setup (https://www.jrsoftware.org/isinfo.php) script +; demonstrating use of PathMgr.dll. +; +; This script uses PathMgr.dll in the following ways: +; * Copies PathMgr.dll to the target machine (required for uninstall) +; * Defines a task in [Tasks] that should modify the Path +; * Imports the AddDirToPath() DLL function at setup time +; * Imports the RemoveDirFromPath() DLL function at uninstall time +; * Stores task state as custom setting using RegisterPreviousData() +; * Retrieves task state custom setting during setup and uninstall initialize +; * At post install, adds app dir to Path if task selected +; * At uninstall, removes dir from Path if custom setting present +; * Unloads and deletes DLL and removes app dir at uninstall deinitialize + +#if Ver < EncodeVer(6,0,0,0) + #error This script requires Inno Setup 6 or later +#endif + +[Setup] +AppId={{A17D2D05-C729-4F2A-9CC7-E04906C5A842} +AppName=EditPath +AppVersion=4.0.4.0 +UsePreviousAppDir=false +DefaultDirName={autopf}\EditPath +Uninstallable=true +OutputDir=. +OutputBaseFilename=EditPath_Setup +ArchitecturesInstallIn64BitMode=x64 +PrivilegesRequired=none +PrivilegesRequiredOverridesAllowed=dialog + +[Files] +; Install PathMgr.dll for use with both setup and uninstall; use +; uninsneveruninstall flag because DeinitializeSetup() will delete after +; unloading the DLL; install the 32-bit version of PathMgr.dll because both +; setup and uninstall executables are 32-bit +Source: "i386\PathMgr.dll"; DestDir: "{app}"; Flags: uninsneveruninstall + +; Other files to install on target system +Source: "i386\EditPath.exe"; DestDir: "{app}"; Check: not Is64BitInstallMode() +Source: "x86_64\EditPath.exe"; DestDir: "{app}"; Check: Is64BitInstallMode() +Source: "EditPath.md"; DestDir: "{app}" + +[Tasks] +Name: modifypath; Description: "&Add to Path" + +[Code] +const + MODIFY_PATH_TASK_NAME = 'modifypath'; // Specify name of task + +var + PathIsModified: Boolean; // Cache task selection from previous installs + ApplicationUninstalled: Boolean; // Has application been uninstalled? + +// Import AddDirToPath() at setup time ('files:' prefix) +function DLLAddDirToPath(DirName: string; PathType, AddType: DWORD): DWORD; + external 'AddDirToPath@files:PathMgr.dll stdcall setuponly'; + +// Import RemoveDirFromPath() at uninstall time ('{app}\' prefix) +function DLLRemoveDirFromPath(DirName: string; PathType: DWORD): DWORD; + external 'RemoveDirFromPath@{app}\PathMgr.dll stdcall uninstallonly'; + +// Wrapper for AddDirToPath() DLL function +function AddDirToPath(const DirName: string): DWORD; +var + PathType, AddType: DWORD; +begin + // PathType = 0 - use system Path + // PathType = 1 - use user Path + // AddType = 0 - add to end of Path + // AddType = 1 - add to beginning of Path + if IsAdminInstallMode() then + PathType := 0 + else + PathType := 1; + AddType := 0; + result := DLLAddDirToPath(DirName, PathType, AddType); +end; + +// Wrapper for RemoveDirFromPath() DLL function +function RemoveDirFromPath(const DirName: string): DWORD; +var + PathType: DWORD; +begin + // PathType = 0 - use system Path + // PathType = 1 - use user Path + if IsAdminInstallMode() then + PathType := 0 + else + PathType := 1; + result := DLLRemoveDirFromPath(DirName, PathType); +end; + +procedure RegisterPreviousData(PreviousDataKey: Integer); +begin + // Store previous or current task selection as custom user setting + if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then + SetPreviousData(PreviousDataKey, MODIFY_PATH_TASK_NAME, 'true'); +end; + +function InitializeSetup(): Boolean; +begin + result := true; + // Was task selected during a previous install? + PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true'; +end; + +function InitializeUninstall(): Boolean; +begin + result := true; + // Was task selected during a previous install? + PathIsModified := GetPreviousData(MODIFY_PATH_TASK_NAME, '') = 'true'; + ApplicationUninstalled := false; +end; + +procedure CurStepChanged(CurStep: TSetupStep); +begin + if CurStep = ssPostInstall then + begin + // Add app directory to Path at post-install step if task selected + if PathIsModified or WizardIsTaskSelected(MODIFY_PATH_TASK_NAME) then + AddDirToPath(ExpandConstant('{app}')); + end; +end; + +procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep); +begin + if CurUninstallStep = usUninstall then + begin + // Remove app directory from path during uninstall if task was selected; + // use variable because we can't use WizardIsTaskSelected() at uninstall + if PathIsModified then + RemoveDirFromPath(ExpandConstant('{app}')); + end + else if CurUninstallStep = usPostUninstall then + begin + ApplicationUninstalled := true; + end; +end; + +procedure DeinitializeUninstall(); +begin + if ApplicationUninstalled then + begin + // Unload and delete PathMgr.dll and remove app dir when uninstalling + UnloadDLL(ExpandConstant('{app}\PathMgr.dll')); + DeleteFile(ExpandConstant('{app}\PathMgr.dll')); + RemoveDir(ExpandConstant('{app}')); + end; +end; diff --git a/installers/win/editpath/EditPath.md b/installers/win/editpath/EditPath.md index bce1768a..29a716c2 100644 --- a/installers/win/editpath/EditPath.md +++ b/installers/win/editpath/EditPath.md @@ -1,118 +1,118 @@ -# EditPath - -EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path. - -# Author - -Bill Stewart - bstewart at iname dot com - -# License - -EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details. - -# Download - -https://github.com/Bill-Stewart/PathMgr/releases/ - -# Background - -The system Path is found in the following location in the Windows registry: - -Root: `HKEY_LOCAL_MACHINE` -Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment` -Value name: `Path` - -The current user Path is found in the following location in the registry: - -Root: `HKEY_CURRENT_USER` -Subkey: `Environment` -Value name: `Path` - -In both cases, the `Path` value is (or should be) the registry type `REG_EXPAND_SZ`, which means that it is a string that can contain values surrounded by `%` characters that Windows will automatically expand to environment variable values. (For example, `%SystemRoot%` will be expanded to `C:\Windows` on most systems.) - -The `Path` value contains a `;`-delimited list of directory names that the system should search for executables, library files, scripts, etc. Windows appends the content of the current user Path to the system Path and expands the environment variable references. The resulting string is set as the `Path` environment variable for processes. - -EditPath provides a command-line interface for managing the `Path` value in the system location (in `HKEY_LOCAL_MACHINE`) and the current user location (in `HKEY_CURRENT_USER`). - -# Usage - -The following describes the command-line usage for the program. Parameters are case-sensitive. - -**EditPath** [_options_] _type_ _action_ - -You must specify only one of the following _type_ parameters: - -| _type_ | Abbreviation | Description -| ------- | ------------ | ----------- -| **--system** | **-s** | Specifies the system Path -| **--user** | **-u** | Specifies the user Path - -You must specify only one of the following _action_ parameters: - -| _action_ | Abbreviation | Description -| -------- | ------------ | ----------- -| **--list** | **-l** | Lists directories in Path -| **--test "**_dirname_**"** | **-t "**_dirname_**"** | Tests if directory exists in Path -| **--add "**_dirname_**"** | **-a "**_dirname_**"** | Adds directory to Path -| **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path - -The following parameters are optional: - -| _options_ | Abbreviation | Description -| --------- | ------------ | ----------- -| **--quiet** | **-q** | Suppresses result messages -| **--expand** | **-x** | Expands environment variables (**--list** only) -| **--beginning** | **-b** | Adds to beginning of Path (**--add** only) - -# Exit Codes - -The following table lists typical exit codes when not using **--test** (**-t**). - -| Exit Code | Description -| --------- | ----------- -| 0 | No errors -| 2 | The Path value is not present in the registry -| 3 | The specified directory does not exist in the Path -| 5 | Access is denied -| 87 | Incorrect parameter(s) -| 183 | The specified directory already exists in the Path - -The following table lists typical exit codes when using **--test** (**-t**). - -| Exit Code | Description -| --------- | ----------- -| 1 | The specified directory exists in the unexpanded Path -| 2 | The specified directory exists in the expanded Path -| 3 | The specified directory does not exist in the Path - -# Remarks - -* Anything on the command line after **--test**, **--add**, or **--remove** is considered to be the argument for the parameter. To avoid ambiguity, specify the _action_ parameter last on the command line. - -* Uexpanded vs. expanded refers to whether the environment variable references (i.e., names between `%` characters) are expanded after retrieving the Path value from the registry. For example, `%SystemRoot%` is unexpanded but `C:\Windows` is expanded. - -* The **--add** (**-a**) parameter checks whether the specified directory exists in both the unexpanded and expanded copies of the Path before adding the directory. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--add C:\TestApp` will return exit code 183 (i.e., the directory already exists in the Path) because `%TESTAPP%` expands to `C:\TestApp`. - -* The **--remove** (**-r**) parameter does not expand environment variable references. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--remove "C:\TestApp"` will return exit code 3 (i.e., the directory does not exist in the Path) because **--remove** does not expand `%TESTAPP%` to `C:\TestApp`. For the command to succeed, you would have to specify `--remove "%TESTAPP%"` instead. - -* The program will exit with error code 87 if a parameter (or an argument to a parameter) is missing or not valid, if mutually exclusive parameters are specified, etc. - -* The program will exit with error code 5 if the current user does not have permission to update the Path value in the registry (for example, if you try to update the system Path using a standard user account or an unelevated administrator account). - -# Examples - -1. `EditPath --expand --system --list` - - This command outputs the directories in the system Path, with environment variables expanded. You can also write this command as `EditPath -x -s -l`. - -2. `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"` - - Adds the specified directory name to the user Path. - -3. `EditPath -s -r "C:\Program Files\MyApp\bin"` - - Removes the specified directory from the system Path. - -4. `EditPath -s --test "C:\Program Files (x86)\MyApp\bin"` - - Returns an exit code of 3 if the specified directory is not in the system Path, 1 if the specified directory is in the unexpanded copy of the system Path, or 2 if the specified directory is in the expanded copy of the system Path. +# EditPath + +EditPath is a Windows console (text-based, command-line) program for managing the system Path and user Path. + +# Author + +Bill Stewart - bstewart at iname dot com + +# License + +EditPath.exe is covered by the GNU Lesser Public License (LPGL). See the file `LICENSE` for details. + +# Download + +https://github.com/Bill-Stewart/PathMgr/releases/ + +# Background + +The system Path is found in the following location in the Windows registry: + +Root: `HKEY_LOCAL_MACHINE` +Subkey: `SYSTEM\CurrentControlSet\Control\Session Manager\Environment` +Value name: `Path` + +The current user Path is found in the following location in the registry: + +Root: `HKEY_CURRENT_USER` +Subkey: `Environment` +Value name: `Path` + +In both cases, the `Path` value is (or should be) the registry type `REG_EXPAND_SZ`, which means that it is a string that can contain values surrounded by `%` characters that Windows will automatically expand to environment variable values. (For example, `%SystemRoot%` will be expanded to `C:\Windows` on most systems.) + +The `Path` value contains a `;`-delimited list of directory names that the system should search for executables, library files, scripts, etc. Windows appends the content of the current user Path to the system Path and expands the environment variable references. The resulting string is set as the `Path` environment variable for processes. + +EditPath provides a command-line interface for managing the `Path` value in the system location (in `HKEY_LOCAL_MACHINE`) and the current user location (in `HKEY_CURRENT_USER`). + +# Usage + +The following describes the command-line usage for the program. Parameters are case-sensitive. + +**EditPath** [_options_] _type_ _action_ + +You must specify only one of the following _type_ parameters: + +| _type_ | Abbreviation | Description +| ------- | ------------ | ----------- +| **--system** | **-s** | Specifies the system Path +| **--user** | **-u** | Specifies the user Path + +You must specify only one of the following _action_ parameters: + +| _action_ | Abbreviation | Description +| -------- | ------------ | ----------- +| **--list** | **-l** | Lists directories in Path +| **--test "**_dirname_**"** | **-t "**_dirname_**"** | Tests if directory exists in Path +| **--add "**_dirname_**"** | **-a "**_dirname_**"** | Adds directory to Path +| **--remove "**_dirname_**"** | **-r "**_dirname_**"** | Removes directory from Path + +The following parameters are optional: + +| _options_ | Abbreviation | Description +| --------- | ------------ | ----------- +| **--quiet** | **-q** | Suppresses result messages +| **--expand** | **-x** | Expands environment variables (**--list** only) +| **--beginning** | **-b** | Adds to beginning of Path (**--add** only) + +# Exit Codes + +The following table lists typical exit codes when not using **--test** (**-t**). + +| Exit Code | Description +| --------- | ----------- +| 0 | No errors +| 2 | The Path value is not present in the registry +| 3 | The specified directory does not exist in the Path +| 5 | Access is denied +| 87 | Incorrect parameter(s) +| 183 | The specified directory already exists in the Path + +The following table lists typical exit codes when using **--test** (**-t**). + +| Exit Code | Description +| --------- | ----------- +| 1 | The specified directory exists in the unexpanded Path +| 2 | The specified directory exists in the expanded Path +| 3 | The specified directory does not exist in the Path + +# Remarks + +* Anything on the command line after **--test**, **--add**, or **--remove** is considered to be the argument for the parameter. To avoid ambiguity, specify the _action_ parameter last on the command line. + +* Uexpanded vs. expanded refers to whether the environment variable references (i.e., names between `%` characters) are expanded after retrieving the Path value from the registry. For example, `%SystemRoot%` is unexpanded but `C:\Windows` is expanded. + +* The **--add** (**-a**) parameter checks whether the specified directory exists in both the unexpanded and expanded copies of the Path before adding the directory. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--add C:\TestApp` will return exit code 183 (i.e., the directory already exists in the Path) because `%TESTAPP%` expands to `C:\TestApp`. + +* The **--remove** (**-r**) parameter does not expand environment variable references. For example, if the environment variable `TESTAPP` is set to `C:\TestApp` and `%TESTAPP%` is in the Path, specifying `--remove "C:\TestApp"` will return exit code 3 (i.e., the directory does not exist in the Path) because **--remove** does not expand `%TESTAPP%` to `C:\TestApp`. For the command to succeed, you would have to specify `--remove "%TESTAPP%"` instead. + +* The program will exit with error code 87 if a parameter (or an argument to a parameter) is missing or not valid, if mutually exclusive parameters are specified, etc. + +* The program will exit with error code 5 if the current user does not have permission to update the Path value in the registry (for example, if you try to update the system Path using a standard user account or an unelevated administrator account). + +# Examples + +1. `EditPath --expand --system --list` + + This command outputs the directories in the system Path, with environment variables expanded. You can also write this command as `EditPath -x -s -l`. + +2. `EditPath --user --add "%LOCALAPPDATA%\Programs\MyApp"` + + Adds the specified directory name to the user Path. + +3. `EditPath -s -r "C:\Program Files\MyApp\bin"` + + Removes the specified directory from the system Path. + +4. `EditPath -s --test "C:\Program Files (x86)\MyApp\bin"` + + Returns an exit code of 3 if the specified directory is not in the system Path, 1 if the specified directory is in the unexpanded copy of the system Path, or 2 if the specified directory is in the expanded copy of the system Path. diff --git a/lispusers/COMMON-MAKE b/lispusers/COMMON-MAKE index c3576f56..2b08b145 100644 --- a/lispusers/COMMON-MAKE +++ b/lispusers/COMMON-MAKE @@ -1,27 +1,26 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "11-Dec-87 14:48:16" {DSK}COMMON-MAKE.;5 15290 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (VARS COMMON-MAKECOMS) - (FNS COMMON-FILE-COMMAND COMMON-MAKEFILE) - (PROPS (COMMON-MAKE MAKEFILE-ENVIRONMENT)) +(FILECREATED "13-Oct-2023 16:40:48" {LU}COMMON-MAKE.;2 14315 - previous date%: "11-Dec-87 12:53:46" {DSK}COMMON-MAKE.;1) + :EDIT-BY "mth" + :CHANGES-TO (VARS COMMON-MAKECOMS) + + :PREVIOUS-DATE "11-Dec-87 14:48:16" {LU}COMMON-MAKE.;1) -(* " -Copyright (c) 1987 by Unisys Corp.. All rights reserved. -") (PRETTYCOMPRINT COMMON-MAKECOMS) -(RPAQQ COMMON-MAKECOMS ((* FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES) +(RPAQQ COMMON-MAKECOMS [ + (* ;; "FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES") + (FNS COMMON-FILE-COMMAND COMMON-MAKEFILE) (PROP MAKEFILE-ENVIRONMENT COMMON-MAKE) - (EDITHIST COMMON-MAKE))) + (DECLARE%: DONTCOPY (ALISTS (EDITHISTALIST COMMON-MAKE]) -(* FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES) +(* ;; "FUNCTIONS TO HANDLE WRITING STANDARD COMMONLISP SOURCE FILES") (DEFINEQ @@ -227,30 +226,20 @@ Copyright (c) 1987 by Unisys Corp.. All rights reserved. (CLOSEF *STANDARD-OUTPUT*]) ) -(PUTPROPS COMMON-MAKE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP")) +(PUTPROPS COMMON-MAKE MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP")) (DECLARE%: DONTCOPY -(ADDTOVAR EDITHISTALIST (COMMON-MAKE ("11-Dec-87 12:54:22" DJVB {DSK}COMMON-MAKE.;1 - (COMMON-FILE-COMMAND COMMON-MAKEFILE)) - ("11-Dec-87 13:35:35" DJVB {DSK}COMMON-MAKE.;2 ( - COMMON-FILE-COMMAND - - COMMON-MAKEFILE - ) - (GETTING DETAILS RIGHT)) - ("11-Dec-87 13:40:48" DJVB {DSK}COMMON-MAKE.;3 ( - COMMON-FILE-COMMAND - )) - ("11-Dec-87 14:09:04" DJVB {DSK}COMMON-MAKE.;4 ( - COMMON-FILE-COMMAND - )) - ("11-Dec-87 14:48:44" DJVB {DSK}COMMON-MAKE.;5 ( - COMMON-FILE-COMMAND - ) - (FIXED FILE COMMENTS AND CL:DEFVAR ET AL)))) +(ADDTOVAR EDITHISTALIST + (COMMON-MAKE ("11-Dec-87 12:54:22" DJVB {DSK}COMMON-MAKE.;1 (COMMON-FILE-COMMAND + COMMON-MAKEFILE)) + ("11-Dec-87 13:35:35" DJVB {DSK}COMMON-MAKE.;2 (COMMON-FILE-COMMAND + COMMON-MAKEFILE) + (GETTING DETAILS RIGHT)) + ("11-Dec-87 13:40:48" DJVB {DSK}COMMON-MAKE.;3 (COMMON-FILE-COMMAND)) + ("11-Dec-87 14:09:04" DJVB {DSK}COMMON-MAKE.;4 (COMMON-FILE-COMMAND)) + ("11-Dec-87 14:48:44" DJVB {DSK}COMMON-MAKE.;5 (COMMON-FILE-COMMAND) + (FIXED FILE COMMENTS AND CL:DEFVAR ET AL)))) ) -(PUTPROPS COMMON-MAKE COPYRIGHT ("Unisys Corp." 1987)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (829 13460 (COMMON-FILE-COMMAND 839 . 9055) (COMMON-MAKEFILE 9057 . 13458))))) + (FILEMAP (NIL (722 13353 (COMMON-FILE-COMMAND 732 . 8948) (COMMON-MAKEFILE 8950 . 13351))))) STOP -ÿ \ No newline at end of file diff --git a/lispusers/COMMON-MAKE.LCOM b/lispusers/COMMON-MAKE.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..75503d9846e569ae249f1d77c22be09df76eb79b GIT binary patch literal 7420 zcmcIp-H#kc5x?C_uycu=TiZCvk(kcJKJTrv*39he$E>5|=5}ZA#y2~?o|*Ofh?B#) zGw})A7aW6v5PnG{9uOe>grX1$Bn0?{^#$|511ESv@Wd;B1d@5-5%H_)nVnht5IlfC zcB;FptE#K3s;jHZUAN~2Znfw6Zq*BVQk)z(opoo`6`B{sZs>c_KociJ*XhR2ivLLW ziW9lQ(3j@s%0!_9wAk$m&8Su7*6pgPn>ArH+LqDQZB3N5t=${%?OeaQEp~4TO?=BA ze!C<4eHm2y&boW{oVkQvJDaMTZN1jEEKSV4bL;A4vg7+=2LyUU0D1hgXU}S4`^s%F zIEYS5Tlx=j>TRoakX*vBYDQhO-L4l`S2l!pvRCyc~gZaDy> zCD9&)?nO@yqiPqbfo6J1v>I7ZU?zZO215vAszS9Y% z0BDJU?{r)OYohCg1el^nA6>}MTkZL)XqdJbgmJtPyM1c41V|Fl6z-(~0S)0?q;FkR z1|c@S+VR4U?^dYK5?C7nH8F_Syof+kI6Th~PE3>xFmRZ?(Mr3TDNqM9lS4!{;M5f&|cTlhBdHSulWYv5ZKUAKd;B|1zQ3)R$`iZ>w83|*)Nvsj}M4ck1+4Puh2CoEl5q8RFT!fsU#2hq`^!7qPg7s%<>K1xgD0-d7dA4)FBKBRPxiUf zJ6~K_7{8iKeqQzQ@A+b3;d~LJ3*X%(a_0-o=_!Ku*NT_MKT9b6^nM|jFlE%z(I?jx z=eHE$&yM#M@XLNO=|}sAiO~JRGiu=O{laWIcK80wKhoYqZzMDCrK5WN!^ADGch2>&uO|wVj!uIUm*T%=U3#G!d^2JiAB*pB5xnswQ zvk(3TGuzbm<@5KX_WRrn<3HTn zkuNgi(lL38=x;90K6ol+{ADsF*5PO8GIom7sR_@;!W7fRV%kplEf$O8d$g?2%d)cG z%?cLuv8?cd77kcYWkQ@*gMZ0_(iur-!k}E-ERTPl?%d`5iEhX1q|y_QivB7Is8;dn zMA)QVV42W;CeMQu@|$ZD<2VVoWVL*c=szdVvLJ-?_X*M``)rlVjF-;*MJi-8aqMx2 zXgn|V?b`Cgz2}q|dh%hq<6}un#U-gvWS+47-GuGl`HXTqNBPr)1`D+?eopFzQNXg@ zmHKy*LFEIqjz4AuFJ%P(H=?rCk7?w!{hdWCsi5oPA&d^(7+{_5M2J;bc4v<}pPb6LSoRI{lx}`AbG; zDQ_NmYx;t0Oz<;nLKy#kVmkmo%)k#a@J0r{lYyfI{8jQz{p3LV+?%%S7iH@JS@sqa zc}t~}JDacV%Qm~gzd;_QTUs(S`Fi62%d>lDl%kY>Y<3^avt>%v9=|~Qu(|Ss1WB$W zTHKef7dKxY|Cak7?!AUcs=$v&gX_<*J&%v^38>D&;Vu6fS9f=k)sz;Y$w2*V=BsW^RN}?V^Y}!*xG@9U` zxHcNLa4$MOt_#y@FdCMf;+RHWBG!4#eDwtVf2eM~0CHt|Ix91LkT`LYX60 zYw48sMo3j5S&nQCSz~TqO`jIRY))aD4HFwYVC~~NbwL;=rO`P?*q%IjqcJ6xfwX=K z8=IpPrcX1{8`GNAEi*^f#u{>D?5V+)RnMU|aW&!XZ-RBU?gn(9qfl?<2Orsq`V_%B zQt$jsJ#TjwR-YTR8cen)!@d&>tB(CXz}_qicIdZLEL?8T3f;cE=ptQbbtbJ^i!qay z0jE&Pv!=LWPjV|YjHbe>o3zp7TD7UQ!&1;sjyzajrAq~Fm4@9kLf@aiTmP`J{`kYGfL6<>DNi3ZFRmp@zOVJLBJHR?7i(isd~+_a2(t05vchB?<^;Hp=7OC9&lbPjHlWI)4cEpSIb z)$5ZXT^GZ^lL798Havt$SwyPaRdlS3js=gwE)1N|>AMJIa7o%o8HOGT5{Z+-YKN=- zM$)R+Qcg8xiTvok+Fu`Eo7V;HX%`p4DFcMS%m`PXe!^q4Aq1+(B>${ z*wd7-?;CVeR71V7y>rgYO zBhn2cH*B|k_mbCv@6;RQpR(gSUSHJVwlI3fXXVvV>rlw6zFZ+(4!6r&=N7 z*I->lp(6(yDCe-vr~#CDGO{)JbysF>Q=J+qMH5Fn4`v;Dia+V1)7x(|aT8wAmCVzm zP({p5a#tmG$O|9&AQ7Udv@`$N&#e@F#)8U_MquJ80$x{he%df_u9w;Dj!(hJ~~h^P3F=v?7J2qqD2 zp>>?#Oe|2C>-w$+JS;*}0avkn1D(yLiSnk1*W_?@EfyPcDB{owA{nB1NtTKc6gHC> ziwO;@MibT~Do9)cJFU5=we>)bA~9OSQRT%E6zT=5+8l)lTa*LOUxF7S(ES&jlzVG9 z@mfM#!WT(~c4x6ns;#mH??fnR8i*O?bPw^R;UzFc!Au(l$TKMLV+l%EsCJTekc3fn zm2}|flp}H(F+eO8k=JflhQY`Sx>Xo^>~>QdzEWX^wfL#OMUWL6wg3s3Ll(^bvgkb`HHq6~QTT z=mCSr%W^Y+IQ+y+VRUqKobzxiy!}bl zA16!>73T*SBw=>~B1)ybDo5m(f`AIdQH<-zD%E%KtkA7aOalIiGpWrMg ziqo%z$W5po-$>mH`IPIEyG|Ygd^cE)*Qg7=PX`shd8mqgO;jpmn5tM_Atb~B<@d0J zVJ9Aj?EI5xz{yP-4)~!Va{FFK`iN2qCBy*_;iK!W3|Bc)(1tIGnKdlC$R4`0U5XAd zl>IETgK?YPx>PvK4b~O^NEHP3PkpWc2ZQS<g}9eukfaO;KADmatt>medley>LISPUSERS>MANAGER.;2 111145 +(FILECREATED "13-Oct-2023 16:41:52" {LU}MANAGER.;3 112648 + + :EDIT-BY "mth" :CHANGES-TO (FNS Manager.DO.COMMAND) + (VARS MANAGERCOMS MANAGER-FILE-OPERATIONS-COMMANDS) - :PREVIOUS-DATE "10-Feb-2022 22:17:51" {DSK}matt>medley>LISPUSERS>MANAGER.;1) + :PREVIOUS-DATE "10-Oct-2023 11:27:25" {LU}MANAGER.;1) -(* ; " -Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation. -") - (PRETTYCOMPRINT MANAGERCOMS) (RPAQQ MANAGERCOMS @@ -52,11 +51,12 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation. (* ;; "") (SPECVARS Manager.ACTIVEFLG MANAGER-CASES MANAGER-ADDTOFILES?) - (GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG + (GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADDBFLG SAVEDBFLG MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS - MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE BackgroundMenuCommands - BackgroundMenu) + MANAGER-MAIN-MENU-ITEMS MANAGER-ACTIVITY-WINDOW-TITLE MANAGER-MAIN-WINDOW + MANAGER-MAIN-ICONW Manager.WINDOW-ANCHOR MANAGER.BM MANAGER.BM.MASK + BackgroundMenuCommands BackgroundMenu) (VARS *UNMANAGED-TYPES* MANAGER-ACTIVITY-WINDOW-TITLE (MANAGER-CASES) (MANAGER-ADDTOFILES?) MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS @@ -64,28 +64,33 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation. MANAGER-MAIN-MENU-ITEMS MANAGER.BM MANAGER.BM.MASK) (INITVARS (Manager.ACTIVEFLG NIL) (Manager.SORTFILELSTFLG T) + (Manager.WINDOW-ANCHOR 'ANCHOR-BL) (Manager.MENUROWS 20) (Manager.DATASPACE NIL) (MANAGER-WINDOWS NIL) (MANAGER-MAIN-WINDOW NIL) + (MANAGER-MAIN-ICONW (ICONW MANAGER.BM MANAGER.BM.MASK + (create POSITION XCOORD _ 0 YCOORD _ 0) + T)) (MANAGER-OPEN-WINDOWS NIL) (MANAGER-FILE-MENU NIL) (MANAGER-FILELST-MENU NIL) (MANAGER-FILE-OPERATIONS-MENU NIL) (MANAGER-FILE-FILE-RELATION-MENU NIL) (MANAGER-MARKED-SHADE BOLDMENUFONT)) - (FILES FILEBROWSER) - (* ; "for SEE command") + (FILES DATABASEFNS FILEBROWSER (FROM LISPUSERS) + COMMON-MAKE) + (* ; "FILEBROWSER for SEE command") (FNS MANAGER MANAGER.RESET Manager.ADDADV Manager.ADDTOFILES? Manager.ALTERMARKING - Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT Manager.WINDOW - Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE Manager.COLLECTCOMS - Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE Manager.HIGHLIGHTED - Manager.INSUREHIGHLIGHTS Manager.FILECHANGES Manager.FILELSTCHANGED? + Manager.ANCHORED-SET-POSITION Manager.DO.COMMAND Manager.HIGHLIGHT Manager.PROMPT + Manager.WINDOW Manager.insurefilehighlights Manager.CHANGED? Manager.CHECKFILE + Manager.COLLECTCOMS Manager.COMS.WSF Manager.COMSOPEN Manager.COMSUPDATE + Manager.HIGHLIGHTED Manager.INSUREHIGHLIGHTS Manager.FILECHANGES Manager.FILELSTCHANGED? Manager.FILESUBTYPES Manager.GET.ENVIRONMENT Manager.GETFILE Manager.INTITLE? Manager.MAIN.WSF Manager.MAINCLOSE Manager.MAINMENUITEMS Manager.MAINOPEN Manager.MAINUPDATE Manager.MAKEFILE.ADV Manager.MENUCOLUMNS Manager.MENUHASITEM Manager.MENUITEMS Manager.REMOVE.DUPLICATE.ADVICE Manager.RESETSUBITEMS - Manager.SORT.COMS Manager.SORTBYCOLUMN) + Manager.SET-ANCHOR Manager.SORT.COMS Manager.SORTBYCOLUMN) (ADVISE ADDFILE ADDTOFILES? MAKEFILE MARKASCHANGED UNMARKASCHANGED UPDATEFILES ADDTOCOMS DELFROMCOMS \ADDTOFILEBLOCK/ADDNEWCOM LOAD LOADFNS (MARKASCHANGED :IN DEFAULT.EDITDEFA0001)) @@ -181,10 +186,11 @@ Copyright (c) 1986-1987, 1900, 2022 by Xerox Corporation. ) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADBFLG SAVEDBFLG +(GLOBALVARS LAMBDAFONT DEFAULTFONT MENUFONT BOLDMENUFONT MANAGER-WINDOWS LOADDBFLG SAVEDBFLG MANAGER-ITEM-OPERATION-COMMANDS MANAGER-ITEM-FILE-RELATION-COMMANDS MANAGER-FILE-OPERATIONS-COMMANDS MANAGER-FILE-FILE-RELATION-COMMANDS MANAGER-MAIN-MENU-ITEMS - MANAGER-ACTIVITY-WINDOW-TITLE BackgroundMenuCommands BackgroundMenu) + MANAGER-ACTIVITY-WINDOW-TITLE MANAGER-MAIN-WINDOW MANAGER-MAIN-ICONW Manager.WINDOW-ANCHOR + MANAGER.BM MANAGER.BM.MASK BackgroundMenuCommands BackgroundMenu) ) (RPAQQ *UNMANAGED-TYPES* (EXPRESSIONS FILES FIELDS FILEVARS-ARE-NOW-OK)) @@ -368,6 +374,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB ("Edit FILELST" 'EDIT "Edit the variable which lists the files noticed by the file package"))) ("Advice" 'SHOWADVICE "Display the list of advised or traced fns and functions.") + ("Set Window Anchor" 'ANCHOR-BL + "Set the anchor corner for window growth to Bottom Left (default)" + (SUBITEMS (" Top Left " 'ANCHOR-TL "Set the anchor corner to Top Left") + (" Top Right " 'ANCHOR-TR "Set the anchor corner to Top Right") + (" Bottom Left " 'ANCHOR-BL "Set the anchor corner to Bottom Left") + (" Bottom Right " 'ANCHOR-BR "Set the anchor corner to Bottom Right"))) ("Quit" 'QUIT "Shut down all manager windows" (SUBITEMS ("Quit" 'QUIT "Shut down all manager windows" ) @@ -385,6 +397,8 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (RPAQ? Manager.SORTFILELSTFLG T) +(RPAQ? Manager.WINDOW-ANCHOR 'ANCHOR-BL) + (RPAQ? Manager.MENUROWS 20) (RPAQ? Manager.DATASPACE NIL) @@ -393,6 +407,9 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (RPAQ? MANAGER-MAIN-WINDOW NIL) +(RPAQ? MANAGER-MAIN-ICONW (ICONW MANAGER.BM MANAGER.BM.MASK (create POSITION XCOORD _ 0 YCOORD _ 0) + T)) + (RPAQ? MANAGER-OPEN-WINDOWS NIL) (RPAQ? MANAGER-FILE-MENU NIL) @@ -405,11 +422,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (RPAQ? MANAGER-MARKED-SHADE BOLDMENUFONT) -(FILESLOAD FILEBROWSER) +(FILESLOAD DATABASEFNS FILEBROWSER (FROM LISPUSERS) + COMMON-MAKE) -(* ; "for SEE command") +(* ; "FILEBROWSER for SEE command") (DEFINEQ @@ -522,11 +540,30 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (Manager.HIGHLIGHT ITEM MENU MARKING?))) finally (Manager.MAINUPDATE UPDATEFILES]) +(Manager.ANCHORED-SET-POSITION + [LAMBDA (IW IH) (* ; "Edited 10-Oct-2023 11:22 by mth") + (LET (WREGION XPOS YPOS TEMP) + (SETQ WREGION (WINDOWPROP MANAGER-MAIN-WINDOW 'REGION)) + (SETQ YPOS (fetch (REGION BOTTOM) of WREGION)) + (if (FMEMB Manager.WINDOW-ANCHOR '(ANCHOR-TL ANCHOR-TR)) + then (SETQ YPOS (- (+ YPOS (fetch (REGION HEIGHT) of WREGION)) + IH))) + (SETQ TEMP (+ YPOS IH)) + (if (>= TEMP SCREENHEIGHT) + then (SETQ YPOS (- SCREENHEIGHT 1))) + (SETQ XPOS (fetch (REGION LEFT) of WREGION)) + (if (FMEMB Manager.WINDOW-ANCHOR '(ANCHOR-TR ANCHOR-BR)) + then (SETQ XPOS (- (+ XPOS (fetch (REGION WIDTH) of WREGION)) + IW))) + (SETQ TEMP (+ XPOS IW)) + (if (>= TEMP SCREENWIDTH) + then (SETQ XPOS (- SCREENWIDTH 1))) + (create POSITION + XCOORD _ XPOS + YCOORD _ YPOS]) + (Manager.DO.COMMAND - [LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 15-Sep-2022 23:35 by Matt Heffron") - (* ; "Edited 15-Sep-2022 23:32 by Matt Heffron") - (* ; "Edited 15-Sep-2022 23:19 by Matt Heffron") - (* ; "Edited 18-Nov-87 14:30 by raf") + [LAMBDA (COMMAND ITEM COMSTYPE FILE MENU) (* ; "Edited 13-Oct-2023 16:28 by mth") (if (EQ COMSTYPE 'FILEVARS) then (SETQ COMSTYPE 'VARS) (* ; "The Manager currently does unnatural things with the FILEVARS type, this is a hack to compensate for it. E.g., editing a FILEVARS = editing the VARS, etc.") ) @@ -719,15 +756,22 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (Manager.HIGHLIGHT FILE MENU))) else (* ; "single item") (UNMARKASCHANGED ITEM COMSTYPE))) - (SEE (FB.FASTSEE.ONEFILE - NIL FILE (LET [(W (CREATEW NIL (CONCAT "Seeing " FILE - "..."] - (DSPSCROLL 'ON W) - (WINDOWPROP W 'PAGEFULLFN - 'FB.SEEFULLFN) - (TTYDISPLAYSTREAM W) - W))) - (TEDIT-SEE (TEDIT-SEE FILE)) + (SEE (LET ((FULLNAME (OR (CDAR (GETPROP FILE 'FILEDATES)) + FILE))) + + (* ;; + "I'm assuming that the CAR of the FILEDATES list is the most recent...") + + (FB.FASTSEE.ONEFILE + NIL FULLNAME + (LET [(W (CREATEW NIL (CONCAT "Seeing " FULLNAME + "..."] + (DSPSCROLL 'ON W) + (WINDOWPROP W 'PAGEFULLFN 'FB.SEEFULLFN) + (TTYDISPLAYSTREAM W) + W)))) + (TEDIT-SEE (TEDIT-SEE (OR (CDAR (GETPROP FILE 'FILEDATES)) + FILE))) (LOAD (printout T .FONT LAMBDAFONT "Loading file " FILE "." .FONT DEFAULTFONT T) @@ -748,18 +792,20 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB then NIL else (LIST COMMAND] (printout T .FONT DEFAULTFONT T))) - (COMMON-MAKEFILE - (FILESLOAD 'COMMON-MAKEFILE) - (if FILE - then (printout T .FONT LAMBDAFONT - "Writing CommonLisp source into " FILE - ".LSP" .FONT DEFAULTFONT T) - (PRINT (USER::COMMON-MAKEFILE FILE) - T) - else (CL:FORMAT T + (COMMON-MAKEFILE (if FILE + then (printout T .FONT LAMBDAFONT + "Writing CommonLisp source into " + FILE ".LSP" .FONT + DEFAULTFONT T) + (PRINT (COMMON-MAKEFILE FILE) + T) + else (CL:FORMAT T "~&CommonLispify must be selected separately for each file" - ))) + ))) ((LIST HARDCOPY) (LISTFILES1 FILE)) + ((ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR) ( + Manager.SET-ANCHOR + COMMAND)) (CLEANUP (printout T .FONT LAMBDAFONT "Cleanup..." .FONT DEFAULTFONT T) @@ -821,68 +867,42 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (* ;; "DATABASEFNS stuff") - (DB - (FILESLOAD 'DATABASEFNS) - (CL:FORMAT T + (DB (CL:FORMAT T "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a" - SAVEDBFLG LOADBFLG)) + SAVEDBFLG LOADDBFLG)) (DBFILE - (FILESLOAD 'DATABASEFNS) (CL:FORMAT T "~&The DATABASE prop for ~a is: ~a" FILE (GETPROP FILE 'DATABASE)) (CL:FORMAT T "~&Global DataBaseFNS Flags:~%%SAVEDBFLG = ~a, LOADDBFLG = ~a" - SAVEDBFLG LOADBFLG)) + SAVEDBFLG LOADDBFLG)) (DBON - (FILESLOAD 'DATABASEFNS) - (SETQ LOADBFLG 'ON) + (SETQ LOADDBFLG 'ON) (SETQ SAVEDBFLG 'ON)) (DBOFF - (FILESLOAD 'DATABASEFNS) - (SETQ LOADBFLG 'OFF) - (SETQ SAVEDBFLG 'OFF)) + (SETQ LOADDBFLG 'NO) + (SETQ SAVEDBFLG 'NO)) (DBASK - (FILESLOAD 'DATABASEFNS) - (SETQ LOADBFLG 'ASK) + (SETQ LOADDBFLG 'ASK) (SETQ SAVEDBFLG 'ASK)) - (DBLOADON - (FILESLOAD 'DATABASEFNS) - (SETQ LOADBFLG 'ON)) - (DBSAVEON - (FILESLOAD 'DATABASEFNS) - (SETQ SAVEDBFLG 'ON)) - (DBLOADOFF - (FILESLOAD 'DATABASEFNS) - (SETQ LOADBFLG 'OFF)) - (DBSAVEOFF - (FILESLOAD 'DATABASEFNS) - (SETQ SAVEDBFLG 'OFF)) - (DBLOADASK - (FILESLOAD 'DATABASEFNS) - (SETQ LOADBFLG 'ASK)) - (DBSAVEASK - (FILESLOAD 'DATABASEFNS) - (SETQ SAVEDBFLG 'ASK)) - (DBFILEON - (FILESLOAD 'DATABASEFNS) - (PUTPROP FILE 'DATABASE 'ON)) - (DBFILEOFF - (FILESLOAD 'DATABASEFNS) - (PUTPROP FILE 'DATABASE 'OFF)) - (DBFILEASK - (FILESLOAD 'DATABASEFNS) - (PUTPROP FILE 'DATABASE 'ASK)) + (DBLOADON (SETQ LOADDBFLG 'YES)) + (DBSAVEON (SETQ SAVEDBFLG 'YES)) + (DBLOADOFF (SETQ LOADDBFLG 'NO)) + (DBSAVEOFF (SETQ SAVEDBFLG 'NO)) + (DBLOADASK (SETQ LOADDBFLG 'ASK)) + (DBSAVEASK (SETQ SAVEDBFLG 'ASK)) + (DBFILEON (PUTPROP FILE 'DATABASE 'YES)) + (DBFILEOFF (PUTPROP FILE 'DATABASE 'NO)) + (DBFILEASK (PUTPROP FILE 'DATABASE 'ASK)) (DUMPDB (printout T .FONT LAMBDAFONT "Dumping the Masterscope Database for file " FILE .FONT DEFAULTFONT T) - (FILESLOAD 'DATABASEFNS) (DUMPDB FILE)) (LOADDB (printout T .FONT LAMBDAFONT "Loading the Masterscope Database for file " FILE .FONT DEFAULTFONT T) - (FILESLOAD 'DATABASEFNS) (LOADDB FILE)) (COMPILE (printout T .FONT LAMBDAFONT "Compiling..." .FONT @@ -1372,7 +1392,7 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB FILE]) (Manager.MAINOPEN - [LAMBDA (POSITION) (* ; "Edited 17-Aug-87 13:59 by raf") + [LAMBDA (POSITION) (* ; "Edited 10-Oct-2023 11:23 by mth") (* ;;; "Builds the manager main (FILELST) menu at the indicated position.") @@ -1387,31 +1407,30 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (ADDMENU MANAGER-FILE-MENU (SETQ MANAGER-MAIN-WINDOW - (CREATEW (with POSITION - (with MENU MANAGER-FILE-MENU (SETQ IW (MIN (WIDTHIFWINDOW IMAGEWIDTH) - SCREENWIDTH)) + (CREATEW (with POSITION (with MENU MANAGER-FILE-MENU (SETQ IW (MIN (WIDTHIFWINDOW + IMAGEWIDTH) + SCREENWIDTH)) (* ;  "width of file menu. Actually unlikely to be wider than screenwidth (!)") - (SETQ IH (MIN (HEIGHTIFWINDOW IMAGEHEIGHT T) - SCREENHEIGHT)) + (SETQ IH (MIN (HEIGHTIFWINDOW IMAGEHEIGHT T) + SCREENHEIGHT)) (* ;  "height of window; could possibly be higher than screen if lots of files") - (if (POSITIONP POSITION) - then (* ; + (if (POSITIONP POSITION) + then (* ;  "gave an initial position for the manager file menu") - POSITION - elseif (WINDOWP MANAGER-MAIN-WINDOW) - then (* ; + POSITION + elseif (WINDOWP MANAGER-MAIN-WINDOW) + then (* ;  "if there was a window, put the new one in the same place (and close the old one)") - (PROG1 (with REGION (WINDOWPROP MANAGER-MAIN-WINDOW - 'REGION) - (create POSITION - XCOORD _ LEFT - YCOORD _ BOTTOM)) - (CLOSEW MANAGER-MAIN-WINDOW)) - else (* ; + (PROG1 (Manager.ANCHORED-SET-POSITION IW IH) + + (* ;; "(with REGION (WINDOWPROP MANAGER-MAIN-WINDOW (QUOTE REGION)) (create POSITION XCOORD _ LEFT YCOORD _ BOTTOM))") + + (CLOSEW MANAGER-MAIN-WINDOW)) + else (* ;  "let user say where to put the menu") - (GETBOXPOSITION IW IH))) + (GETBOXPOSITION IW IH))) (create REGION LEFT _ XCOORD WIDTH _ IW @@ -1434,17 +1453,18 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (* ;; "Shrink to the manager icon, and remember to update when the expanding") [WINDOWPROP MANAGER-MAIN-WINDOW 'ICONFN (FUNCTION (LAMBDA (WIN OICON) - (LET ((IW (if (NULL OICON) - then (ICONW MANAGER.BM - MANAGER.BM.MASK - ) - else OICON))) - [WINDOWPROP IW 'EXPANDFN - (FUNCTION (LAMBDA NIL - ( - Manager.MAINUPDATE - NIL] - IW] + (SETQ MANAGER-MAIN-ICONW + (if (NULL OICON) + then (OR MANAGER-MAIN-ICONW + (ICONW MANAGER.BM + MANAGER.BM.MASK)) + else OICON)) + [WINDOWPROP MANAGER-MAIN-ICONW + 'EXPANDFN + (FUNCTION (LAMBDA NIL + (Manager.MAINUPDATE + NIL] + MANAGER-MAIN-ICONW] (SETQ Manager.ACTIVEFLG T) (Manager.MAINUPDATE T]) @@ -1545,6 +1565,12 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (CONCAT "Creates a " TYPE " submenu for the file " FILE]) +(Manager.SET-ANCHOR + [LAMBDA (NEWANCHOR) (* ; "Edited 10-Oct-2023 11:24 by mth") + (if (AND (FMEMB NEWANCHOR '(ANCHOR-TL ANCHOR-TR ANCHOR-BL ANCHOR-BR)) + (NEQ Manager.WINDOW-ANCHOR NEWANCHOR)) + then (SETQ Manager.WINDOW-ANCHOR NEWANCHOR]) + (Manager.SORT.COMS [LAMBDA (A B) (* ; "Edited 18-Nov-87 15:12 by raf") @@ -1746,20 +1772,21 @@ Will load DataBaseFNS if necessary" (SUBITEMS ("All" 'DB (ADDTOVAR LAMA ) ) -(PUTPROPS MANAGER COPYRIGHT ("Xerox Corporation" 1986 1987 1900 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (24415 101274 (MANAGER 24425 . 25224) (MANAGER.RESET 25226 . 26740) (Manager.ADDADV -26742 . 28095) (Manager.ADDTOFILES? 28097 . 28375) (Manager.ALTERMARKING 28377 . 29987) ( -Manager.DO.COMMAND 29989 . 61755) (Manager.HIGHLIGHT 61757 . 62054) (Manager.PROMPT 62056 . 62369) ( -Manager.WINDOW 62371 . 63004) (Manager.insurefilehighlights 63006 . 64077) (Manager.CHANGED? 64079 . -64628) (Manager.CHECKFILE 64630 . 65729) (Manager.COLLECTCOMS 65731 . 67169) (Manager.COMS.WSF 67171 - . 69841) (Manager.COMSOPEN 69843 . 74581) (Manager.COMSUPDATE 74583 . 75675) (Manager.HIGHLIGHTED -75677 . 75983) (Manager.INSUREHIGHLIGHTS 75985 . 76543) (Manager.FILECHANGES 76545 . 76844) ( -Manager.FILELSTCHANGED? 76846 . 77174) (Manager.FILESUBTYPES 77176 . 77814) (Manager.GET.ENVIRONMENT -77816 . 80354) (Manager.GETFILE 80356 . 82670) (Manager.INTITLE? 82672 . 83350) (Manager.MAIN.WSF -83352 . 85996) (Manager.MAINCLOSE 85998 . 87108) (Manager.MAINMENUITEMS 87110 . 88187) ( -Manager.MAINOPEN 88189 . 93565) (Manager.MAINUPDATE 93567 . 94203) (Manager.MAKEFILE.ADV 94205 . 95241 -) (Manager.MENUCOLUMNS 95243 . 96047) (Manager.MENUHASITEM 96049 . 96406) (Manager.MENUITEMS 96408 . -96653) (Manager.REMOVE.DUPLICATE.ADVICE 96655 . 98261) (Manager.RESETSUBITEMS 98263 . 99500) ( -Manager.SORT.COMS 99502 . 100034) (Manager.SORTBYCOLUMN 100036 . 101272))))) + (FILEMAP (NIL (25676 102848 (MANAGER 25686 . 26485) (MANAGER.RESET 26487 . 28001) (Manager.ADDADV +28003 . 29356) (Manager.ADDTOFILES? 29358 . 29636) (Manager.ALTERMARKING 29638 . 31248) ( +Manager.ANCHORED-SET-POSITION 31250 . 32353) (Manager.DO.COMMAND 32355 . 62991) (Manager.HIGHLIGHT +62993 . 63290) (Manager.PROMPT 63292 . 63605) (Manager.WINDOW 63607 . 64240) ( +Manager.insurefilehighlights 64242 . 65313) (Manager.CHANGED? 65315 . 65864) (Manager.CHECKFILE 65866 + . 66965) (Manager.COLLECTCOMS 66967 . 68405) (Manager.COMS.WSF 68407 . 71077) (Manager.COMSOPEN 71079 + . 75817) (Manager.COMSUPDATE 75819 . 76911) (Manager.HIGHLIGHTED 76913 . 77219) ( +Manager.INSUREHIGHLIGHTS 77221 . 77779) (Manager.FILECHANGES 77781 . 78080) (Manager.FILELSTCHANGED? +78082 . 78410) (Manager.FILESUBTYPES 78412 . 79050) (Manager.GET.ENVIRONMENT 79052 . 81590) ( +Manager.GETFILE 81592 . 83906) (Manager.INTITLE? 83908 . 84586) (Manager.MAIN.WSF 84588 . 87232) ( +Manager.MAINCLOSE 87234 . 88344) (Manager.MAINMENUITEMS 88346 . 89423) (Manager.MAINOPEN 89425 . 94818 +) (Manager.MAINUPDATE 94820 . 95456) (Manager.MAKEFILE.ADV 95458 . 96494) (Manager.MENUCOLUMNS 96496 + . 97300) (Manager.MENUHASITEM 97302 . 97659) (Manager.MENUITEMS 97661 . 97906) ( +Manager.REMOVE.DUPLICATE.ADVICE 97908 . 99514) (Manager.RESETSUBITEMS 99516 . 100753) ( +Manager.SET-ANCHOR 100755 . 101074) (Manager.SORT.COMS 101076 . 101608) (Manager.SORTBYCOLUMN 101610 + . 102846))))) STOP diff --git a/lispusers/MANAGER.DFASL b/lispusers/MANAGER.DFASL index 8190ca09c2e914159ba5bffc9e0da3b8a2e6ff0d..86a097ba1c110af437f549799478dcb48252f016 100644 GIT binary patch literal 49586 zcmd_Td3;pIl`r1+-j=$x(h{h*Z3*Ee$;=c|D zhDXAq!{a0U>F_SZhd-F;`EYxrBeEgdRe$}J#i_ic{*iRwSbAspiYx1q{bO}&E?;wH z_=>C7t-WI1Rcne{BB_L8aKTze26pxxTn+Frz=wCBOv!=>&2w$>n@>%iu$K<|@V7hn zQzD^?3X9Q2@)Gjd*5qRo5euhl1;X6^5Kcls#JHRqdC&mTo>=??CD-L zIT5-dJT|7AENYH-MVZ-NFnL^J0-cejHZ;=YL{Yq>JKB|qr#b}?^9he>VWz zrC3t+`U!(SKWacr&Wn12z-L82K3H{D+*}CfDC6v?Qx~#8{@ij)%|NLSf4@2O?~JY| zSiF|X7B%cSIZ?Uh+F4vTDg;o*ein(PjmboFd$gmcCE3v}k$VjLY3<7sNyFeZfWiOD&y~tHNBNxU*7jvX?Sq^KK4`yp5 z%Q&*+2$nJusqP%;UIoo$FBH%n0IisT-KAoS!u4cp1umJ7QU+yRFDjSpO-bSg1#QeO zl(+W)w9-Y{9*K9gK zP57(Y&7Deib(=10No10e#>fASp%1;QUMc+;+K4?>c0)zQMH>3%O+B}1=qopzp9_6OL+H_q-kjC9LFwu{ z<)>&0Kg|sFj{AI{kkG(+Jw9KL^u<6GLZ4*l{9d0g`cuSZ1mv#otbfxtjD$CT@$b`a zoP-9x;0ybr|BlpwFhZL5FMjwf#TQ@l7vGXHEML4n^KoDE%bULGi%aTV=k-+hVuIQK z*yam-Nx}Sodfd3X?tK(+wr{&oYWW5Z9O(EVF~_@lcHG}hd|k~Q_bTSpSjP{W|Mj}3 z72lorFR3v2zI^3TUxSq4yFYx?*Su&^bMwRl&o4G{g5@?TSN?qOpFCbPdE9|&*WR}$ z-2$z6R7Tpv69qT)B)g*+YC#!RG7u*xmiO%239UFhmPxyM^zg25-{4@lKhrm~8|t#C z)j;5%oCq`xru&9^_5oW~#7&?n5sh^8bWTpJY98OaZ*_QZV00|pH?%W6lI~YM9d8HE z#smsdJ&ly7Byb64Le6nJesbjJJ{rFTQV zbtYyP+dVlk@D7Vr1o;IffKtmV>&^^}x`d5{4-B9;ccjC+hlQ}d1APb4)5Ali&i&P<9wad-RQkGkyEhK$#v2@9o=}CUcaxr^3yBV||T% zqiGTK2BF>DI60AO9vIy>*mqEJ1Jn4(NP1{2+}<}jmL5s<5AREd!GnD}kTbk%uy6P1 z>at#;d2qOIXFksGz^?F6x<5TS+Bb3#g=S+c*@+AevbgNF$%)I}Wl;tVI;fQVfgX*F z?g_i(7c^t)YMY$6L?XvWu?9SlL9G*@jEy<8^D-1?1%qLsB_{mqS7 zx=maj8ASV!qS?^6_&0YW3=GM_uWxL?^ir{lZr3gs9|%jfv`kK1k-};*hfb)Nvsq_g z#8CE24gRYdt*E(C771*)3+HaQw`!`OW|!u=y8WHD(~N#0YtPYWhA=kV)y>00E5?+^ za!odp4(GL0c-P4A-aOXK3Bp3@@w76@e*x2h%v5A!lAbBv6>{P)K9v$l&8y^j0 zYBHPy9(E!-m4z`Cl?uZ_>|kLCy>en1lEQt2m0>7SM@ltIh7}lp>7j90LW~3n$Y^L8 zQYn~~Rlu{86Bl+2j}5@AWYFj=V~PQTNmfXWd6Wgn8%|&v9Wgv%P`qabiq+vAFj(#M z*iOjWH9piY<6I`D(eU`t*uWrUTzY33RRj7GLs__E_<-AD#fFHEWbfoe{fr{mW`n4V z%I$$MRCPuP6qrFG1#i0;%ZL$bxM{xHnMm`hE~ZlsESe^o31gc;$}q-MbH7LJXzR zodaWG$pb@#i^d;qjzdFeVw&*I{=Sicz8x@n9>@&zXQ+MY49hVR9wPtl41-c~8Yl|y z>+9cxB|Hl$jO^SG26xdHr(((8Nb|;c6BMv(%{0oKRO>`51pFv8LX6R|k-mP>4Z-&^ zOkExuttW$3$b8j1Ftl^{KsYkgpBaV*hG{Und~%|JQyGZwV?4B!ks%Bl8TSV?!|svc z17H;l+s5IsG2yNBuCee+qqw1c3e3*vrwlq`8mG|WdlWi!al)pyxBv**>02+CaqbJNlYS}uM&WQH7>;BOcgZZyir z4L!m+3sV^ipaVnX{k>|~S{0_@Aq*Z(!CYbbAL`%`)Et-|WgrT(Yh#K`{mSG-xnX~3xC3Kph%i*PEZjMg z9veGIl{H5}Ko}Y}^2v$1R0fA)B|Dm@PKOTJv` zR?)l1genwl>>C`X9*sFIl#^{bplXGO^f2oNF&ow9kbXdBAp`7j7QzAIDsZ z*;(c=7e_%;qB+?F`q=K$!PvIhJ3NGf_F)3d&oVlOWd>AdktuH9c$_$A0m78ll3xe= zNryC4~!mhN$=LqPEc0}4iz#5JBh^E|DRV#-9LlBa8D1Csq(Zxp6<|Ae6zh`n{ z-B}0+hx<7j%7pMXh{4r?rr~`D^B6kNl+Q zQUSM}{X#wRN!(lI6Up4(H?qgg7ii*oyLl2uWkly??Hh$~lA&SjFkWv2)I?yGZ!#FR zOit7=J0)8#r;A$zX%Scx;~zE86|LKcD0;5EZldH3DD&o&?SOLiIdcljH-*B=M6JZ2lKG}J zj$p$?W_WqpCg^Aq+}^-U3heF-)IIR1iQ*32SEb( z3i4Xg#T+Efh(U{~5lkNL!8VmNhgQtBA!@}MP${v^ox4)5b{0G<-mz@+1Vp{YjHON3&hzw&=M;%99(}~9nqRC^IA1cX;*@TGL z!+8SCaH2)v0pkqFAPbk~&s}a?&&%7MP|bd86Hga_9qSXRPSx)FhiT)H3c>n?M$VfB z^~^$^olDc|+*X@q>k@e*)3g$RZGLQ)pe7e{>dvv0+oxz1+Cf>7G?Z_MowIDLOU`Ly z&EZ2v!=h*9Zh8CMzY)u97FM8N(G;5=co(MFEGFD{ZF|j?@a}D|=#i3~-DF=*!Ub@2 zC9!!6q})}Jp}xU`A5hCYEE{g$jzW>>mt!mxfSj;r;Bm)az~t9)E3?FlzdBN|UqMqQ z-JhGc3YuckCJ6G&7)xnDdPI+do(So&SC*n9!{fU%o_$E_2~@=tshxdenVj9ZRCM*u zNOw#})0KpPHsP%-!=hZE+7J`2N()V1WEjMj%2Tvy*$jKJJ6sE!8x?P>tJk`llAcnV z(?A7R-nh)OY0nyyv>vfKYV3vm$}JEUJSmVCyp-6r`gVwX*$Mr3c$7N0n6mQv4K)D) zYVuW6<{+jHksKnJN5_V#CFj)@<(_S1hUrg=71LisWE^W}sO74Y*Yg<@Bc{evDekD8u_?t6|Ztd=f<f7GQ z-M9+O0&=`9pR3(fITU85F&8zP*Ku$sJ_M^H*H!(RteagG;ikkogO&%xOrt(LQJNo% zZ7H31W?>+ac{@W{Xqam_CWU|AVk=0kt)|Vy7-Z&;g2s^nvv~cLae?Ja!%TNBw2w_#tMFrAfBodd_1zR$Ja-gc2lYxU_hH#8guW`gzYB&)*TzqBjg_fB z43>AKR`#X*1=)L(BLlk!Ft5Vw z4lidl$A=(GW$izT*Ad7ORJ%)#g^s}(Eml}$l+idiH~^#OzWTF^U)`1VN`=XMWaOX- zGFD@?EMsH?0a&iM?%Jy{c4iU3rDc2sqi-a!RoFoNpEA$Jyn)3waI(TM7;&DG z_c62xCMcBB1-vZ-qy0i1c852ipj*R{xGYg%Y7?XIth)HlijjWWi@wGVTp#|89TxH{#kAAYj&J~$^zi85@PSbn#9)whjj?9)3*@JU_oj0uOBRG` z$okAHo_oEI4KXmVi@Bo46~01yo? z1#mfdP$yBrEW>K_64RoiX)J5FR+J`{4FDqx>bs(1JgIN)=}g3%un$+Sn+bV}TV5xC zV`O$GQ%L|CuG>Cti+lByjR$m`HlG@9y+-7GiNhW;9{c;SM~}7~9UXxEMw*wcOCFll z!jM#N%aqp%3rYKip=6>ju~L>UI1t{G-p6KQ6Nq><2jA*rSe7NbHop^&?`Z?3A?yk6 zRz+nOPN$Ef2S(EGA5T+zVRy_dY^L#)^3E-qHj6n67Kt28bw-;+-ey;3FUtb#JVX|6 zNF*C035k}sM5Mj3IU+}L@m6BSgn13h5l9JV&(AJFa*^t0I7ullvMmhVGqEANDtl>m zb+#^hN%r#W;_RaA#o2K7B7jskV&@54I~X|akl>Vb4Mkgo!2L3w;0z=H9PcsI$1`nK}0Xap;c$nV9f94wc|vMTvq%G4$NUCiG_ zV(70@WI-S+)RX^$wlkTE^Q=8$H#H@bUCoHKw)q5VGv7I-Z1=ISg+y1&-wXL$!`}<| zTb(^$3K9XgB70T#Y9Z#D?6ui-IR+HmnCdQ+QE84w(jX4|lbqs_hMGLS5>O6CNp>v) z?txB>IoV`EBf5hS3NwZsV&>Zu>}6jAO;7*+dF5(=uux}taZ^142^>8g_ASbgBz56IN^%i z8Db-*<-A$0FfKl&wGf%BXHyb(^CmeLCCu#Q$9sKms%3VZ9LYvpu3D0>r&Ery<|EBj z3kJ={a%xX~yd%}q70o3|fjK&aE+tx`&v)x7(Gbsh)yZ{*B;h<9Pub>Y*$~By)Uh$% zmF&RilXjfvVndRtf3Bjq$028TrJ-_ha+usyKG%2>*OW-6q@KAW*b*rtT+igq!Z5q3 z1UT1Jxmvhq3PtP#b*?=GE&8UXovPrB=vV~9EGmb8J?ip^fDWtY&CfBj+{J*jTzKR|AP`#PAkcCy$pQsZge{R8$79?-jh4V0gKMDcgVu48%NL z0ul4n#GO+wB$Kukdl|1q#9_*YlugL_XY+c&)?5KNLecG>T z;_6U}NL{&qAsm}Ks16u5R}-7dem~v=xOD{CnWFF$Bt`BeCOID{0H~iUzC}RF;Sxlb zws20>-WTD&c5-5AYOHSrO07(}Tm$SJ!5lxNX0W|3sK{{(dj~S*6(+zB-tmcm;iki+ zhR0Z>NL?IY;d8O-9kd`Dd{C#yWYW*GDJX${aMcaO(*YTuuSWpUN~4Adr8_X|ZQ!h@ zL_=4^mg7iz$N0b?jk!XCoQ}Zp+|tzMcHE1p+ZajoV3jEcCRUz>yhZl#sWFQATddtK zt-2eby2J<+2(*?^ejvR9dPLtK%+otzVILn7r5*Es0b0l&;6^(*A=TX#y`d+PkO^0M zpjZX9^gSmrktzk0F9`Tiv!Syn+Z}fcGy1Pf7>>zsZD=-XR^xc?FtoIRF|0!dWFc_? z=RZe=_w9o+FKxCD=Tv1Sgtmg_1!S&woi!g_P9|GOHEOFVkAxo)Q549e&e zb_FZp0vu}G9BoQq>A4Q!vS#QtSd1nbWNaa#ygA8N3F^1?XdEAf7bE|Kt~_T)s>TvrfL?99uHz9&KK38y=CG;?@h)3Ml8)pm#> zpS*288o!eV;ZLnjJ;uOvMab5`d_tXQ(92zU_q-Udu|6B>67F{i_ucF`&_v1oa+Q^q)0f-64zV+XGnMi9283akqd;Rj`@dbEs=n-fKN z`tD=Ro~sC1F=xxs)+19FTAO!X+3@*CD&<8pryyJ72xHE?TqF%sH{-sWBSQH? zGbDH?Denf7%(YH1yVNN{m$HfcgZEq{Ln_ib>AipC%DN!Tw;eJoJnbKf)QU@jE2F>L9Hf>d`; zON%Yi)M~NyJ`)g|#%beou zLZ<}1S&G$<^yX-h-{&`jR96)2O{Yv!0VTgB{4FN@Yex#Cxli)tQ3*cH;NbxjTLDc# zDL)u%k&qb$wZv^<>nb0j#mknpM>=7Y?!p~Q%+TD)JPKnZ_OGD~LK4`@3Oz?-p$2_>JfhFT85NNs^KRaHL#H!m zDlRXGE5GfvZpyLH&Br>X=C|i@&{pA`qf^Zd307}1lISh3w(ZvsXHH#i$_8KEZGxxf z4?Ir*E0WRs(DybZ8Z{KRPftDE#*(I6(Kzfzr@-bc;#AtIOFTv1ak|%BLteps9j?>X zgI~~=j>kAG?RYP1 zvEPrXmd-2ssDb+(`0u$lnBIvJR6~#=^D&yB+l{K=CcG~nFp;qF3A zFrOi|5()lRcD+0v(Z>V8Ul8f+Ol(qHGA8+&mQJKsE(JtHt7LlA}!V1xkE6*n4 zB1!dqMcKSlh7o5m(THtH$xfaK$@4zpflbpc-`(F^*<00HeNM*9#C}obo0eaDx_3dv z;$R*N?IA10>Za$%UbatN)?nnr&6)15a@c z(UR&|tRz0vhQB8k0JXmlWYJ~&Q zP|(|Y_e!`qo@$S$QfZPCHp;4d>-1hm+i z))I-g#Z>8!bZtmww-N3yvkiPs^7kqJK9fylJF-!RU*zwfAQx6;dIC2~L8j9SH&I*4la2p(kM<;f$LV*`1~@a?j%p?j0@giK&EptSvRq~{!u=9RMMRc z{bcUwe=yOfddXk|3eLhzI6vMj8+xlw$DcVFdM0jdIWt(C8Bi(LYBCrg(F(rdV!xgk z4J5Me9$a)Vybo7RYZILjkaxMxOVGK|ZtX=N)v*tkOO~zZ$CN-F)t(CO4@qpVE8+Tmtjs z@?l*9O=0CfaxvbV50#($U12=YL&SIHBRE+;;TDqoH47nHm-MS$tmov@cSw3~xekwG zJ=S5RfBIzEt1kB6R8yDT?P6^HHCy3i+4U}}862D6=v z16s^XVQ{i^+|=TUo{eU-l;=Sc&=$5W=;a8m#exAT@ zq$i^3lckoMq5fPMO8!AIu<9mL$t!NAtC^{{JTLD?hRXsz{E^0IPL@2GCtXS&b~9f{ zNVgs(2jUD)pDfwyLM)#N(UVcb4!P5%rQsaFD+lHPp6>$BEW7yUZrR1T@n1Wm?Bc(T zyZli67w16o2RS64aUtr6M4KctprY0^O7T4#Sr60G#kab7)-cbEHqFb39xrZ>OM99I zC|>Voyy9&$Rv};9uu5^j7}RvA5c^M^Of4yWy=a{;hdAEgR<0!y8X$;<`48vqVzM zd}l~$tKw+o3xBjety*BKsa^1AZV?O5F2e9-@arzjIYr<`!z3idg!6@lnQcsMPX_NW z7|+oM&z$r!_gZ^`2&gHnhJEQZkwn09;smsa0OK!9D zZ#;EFKE$s=E6Z^S4D{zKJSPL)ZgU-tyKI_u+cI#Cn+SdmoA8!ntvTL?$uO6x+jMEb zc4?2Di}3t-xBFCgafNi@i)IOOvhedRy1n_?^4lRl-k{4*?hTo`&yhy%?Vkm3vM@LP z|NF`;_%pYj+w$v^Uy*mno8GWwXrq`0T*a>-?Us`IO_Uf6dmJRhK;0 zaC^{+yJcOdy~YyxW4g#$;X+)g5F7IZyTY6!r=45>T*#8ub7Efbq@Cmcb3%N|E&ZGj z_ZWz$W?+8*oUu2~85^B5_Odx+FPJmdF|ntrwQ)#_nG&t`JyU6-q4Vf2@BXFM$)@ejqjBi`uj;=PXBptKCZVZ z!&P~-x>E;CZJ)|x)9I-`6FX_3r#jt6x$0dMrFz;_Rfe@uJBbbfV>3CLxnBnZ^@G#5 zG?Y)rLq11ssB5uFDaNaX#!MPCX3}CucExH|ne!)g#)*~~BxU=&Yn3s6H8{n9E7mhL za^lk%!75>y3&Gu>>_*kW2-%HeT*f-*4;niy?vu(+BD}tAxaM*(M~QF8ifynA6^b=4 zB3?u*;(|UZTTOK>k+?XHthh=j_B}1Z%aB@#LvJuE%d1$aiuE{_@j_Zri>LyzI$t3G z+_rEwA{hFaV6i_W!G9JkIJJYy%IjY<<+ud@OoG;bNbrv(=!kF95RF@kh5K+$uf%?m z0L1;ETc}habPp56$7e__v_vf)DGO<~T_q{ps#WxxJw)vc5`Dyry+nf6cO)CFbDB-9 zdn|vRmrbqSf??jza~S4*ml*y@V*j48Qm=Vm_W)jIklFso3;wr59>5?cZ9OZWjqa z@lSGii~l88TJd+h*uV9Hf9?VNDT9KySUZczw6hp{A}c&xJVCfE67*_YthFT^w_zza zifK@1mlSW1Z1!W4tx`BeHf`kmMM{KMk6OvWgyHkQnatVsB+|vjB{OtRnY77D?I8L?Y_;vTzr`VV3pT2FY2+ zM512q!PPLx+~r=dFc%E|XAU;Viuk?+WWj013bLSz0HHppB0!J@Kki|e^n%(ggdLMu zOT>RLLx3A4C--QaO%l*C#vZQ&W;;A`0OoB{o?)6A_$izz$lwBs3zS4970b zaT*nJK{*mt)ST+X-Ukjb3*5zs38=Gpk{HH&A$)D)UWFv`}SN0a#04se=snD+%Fm9{5w{sX9SAVWwD{2^hb6!4HCtAkWC+Sgk}1duf{_=-eW)?OyEF42p_S81`a| zackK%HgFn8`24h)YvAQ-ULD z8$@hKU@Kk1f8b^N9D_0n{J-U4c-#v<>;>=eU_FuLPXjTIjBUiM9Tha&@gCBH z!MqJ9=b%J5_%}1Vj8lJ?hpENGzs?J;@q(U!@T*iH232K*Zbwxask!r7E}O$vqEL0d z!C1n65ej8)6H;=#z%)VWcnXd4DGv|1Q1LwG#op(kd_U@2%%cpV(@0I7n?0nx9$=f7 zeZ3dF#tUBR!BV@hss))&!lcm30odN0W&cYKgG~uRV(qVcusWusf$WnY)-PvY<>k|& zT{kA-4@6WkTl-%MvY+%aKjLB6S%7#{MliU~gWUw|B{*7$t4KIZ%g+JWH!zu4TRlis zNSNR2YI~Je)*=s9Cx8*qW&OX5W$>>Ulv&j}EkR3;ids{QmC`J)4=wFOVF2qW0i<9{ z`;bA7TDF_Txqy?UwH4LjaeQ41Sjx51!`4-T#{Q}VscF~`NN^dEi%76aJOCZKlFj!Y zj1~HQKO!t+Rnw4czArIW==XhrK_Sog9D{o$_>2ee5eB7JK5vlv%pl#v#4X+WxRwt+ z+U4|-O#1^R(p#9s+#@S;Fru^@ha%hv!TfjlsnFh9E5Rj#$>su!%9I_GSX*Mb3Jd)x zD}56BE=!c1{LnXm7iVT=PLS6>%wY(9j6uN=qQud~)jpxatSwz>8{)iduMkkZZXhIt zuJ;gJDM9OXi9Ih@!aNQW(m3x21dxT&yub7SKF6StFz>es@J|w)1PKnjJ4pCA!a>)c zghbp=IO+R&G8x$&NeS+kSVv~$d3y=)O$pvCh&EIH%~SbDh)zPhDiD-^wv5Mls>yyp zf)s^5Ikq?Na)Gr;iV6qCHO<4 zm-5S1kbGEzWJ%v~3BH;uzx=DjK!8`Ww@Kpv^m40|5vt0yi-qL!Q_RBHPiJ>Y47D+m zT&^5UiXQVyd4yRQdvA81WI5!Oa!^`4*&(r`UX~$dIV7>WvU}vw>m_p7YJu+|oOD6? zY6)6@DZzyv>;eYa8pYXdNG$s?vk2<4*Rt2h<6l8Sf%r0!!CUq{y!pkuiM;$ZvkPmM zJ^24uOK^}`n7e^N=9UjUc$GehG49S}#hFGc#*Y zLXJ=jq)`EeL60jZ=mSG?ttBpL!;)GCr437}vcfUNKSz#2^{g(hl&~zJ_;+%!#UIZ~ zZHw>L#oPOH_=-7xNk#Dun#gI~_d@|+n_VuCl>+Yjo&;IE?^_ZSoj4f7SD@sE2_lL( z6s=E5@ReKvMLIHs;35tOUC1f(OO1+l>*}e4SqOKP#)NZ7fI?3nDCrT6z+R7HQLA@KYigLrmaLCFlet_%zEEnI2H_KP15;j1|@j^fTKI32tIg=Ey*T!7UQ3 zVo;{bLMnNdWGiHoTK7v(Wjcd*39RoGiQU2A7bM7m=6g*x^Oir6@WWIW2Gvb z&kQF8N(HKvQ=kI%0SSJe0MAPBj~V=u1n-fcwMK%sO3;2of|N&=bZEh10=x%7KlK4i z)PDazFji!ZpGpjS$xj`H?B^dB07o$3js|`eK$$?;!mna%r39@Ufb(?*1;F8I!CE3g zodE@zL*0QzI3E;PYn8_$WfH3juEbJO^OwJSzp-Um`wHXzddo zz%4lpHv7b?5P)V6Kr2EFA&^mm1$QKsinikmW`MMQ0n2irr=tZS4az1~EbFOmQRiIwv@1Mx8)5>2CDu+_d`f~2X?4Int?5->) ze;-@Ucc(!6CbJ*l^C9`QUghsM`AcrH{)yr5@b`88{)hac3t2ne38{t$AGua-5Pq2Go7Ab4niXAN=xq3++|h(J7T@Ovrs_4NX_0S=jRU?vVbG^@m0mt>U7 zoa(4+6b>8Hbj_w8`GDUMx$z$cmU+*c&&Ryu9OdnB3v_7thQZ+-@M)6opRGkc9*;KD1u+j1^Hck0Vi+N^B*TcCvd+Y8Q#5}8Z?^W2$B zzYmvU`I&{7Q7N+YcP1w+VUE&A>Hf+4bPLX^4;~x^;qY7}={LdO>Y?RqMEPQhc4rMMVdNq2%SC%7z9GIj1;B~QYKS%j_<&&t*hAB*rHs;;!x32`N0+2W+Q z2o>+zj9Cd6?{ugu*AwC9#}X(k`T{(G)x-U$gg=8Z z+zZ#{QY{aq`;8~uupXA`7h%3Acfq8++1W)^=xiC{MLxJx%ukj)!Dmfs@EB6v!R~fe z5YE^ftx)hhxLAYxULgVb0-r;^^%D3Ld=48Az_?*QfJ?sODwRH~l!*eD00}Pq3h+|o zV)j~;)*?~^q|*T`QVY>$2C(p74PfDS^8m$1l;ke_eN%WLs8|HQg$IYnaSvZzfr%?8 zAT!qhWKvduJ`5OVa*}pgei|AwFU|jEUYh@BGt-`$oUn<|e;*n!0(WTY zMohcJ-vDxC9Qff#4VA=quG}H-{KOA!j zXy;<7H zDxUA(CMO!Bx9%Gsf@?eV7b>4$8-i#3ad=)pl+MG%19xEJJY)3G#hv&F1H3T6tH#jI zaN|KK*@vctk2?8^LtYjT3sl1giCo;BVbUZHr3t)pv3y8GB)yT-II+TORdO4>t&=DG7dAwA zh4N)TkIY0Gk9Houg(s&%fM9`#%o&zS^|*lZGrlZ!T>DmhxbNK8bt^SDi+b&dEgrjy z_!(Wf_A54nLRsu2n=FTbK(AyS1X)*9ge@NOVN3C75sxosYH&~ctXp-NI$V%bVjI+N zL9gv&xgX&D$U-dd;K_+G2OaRJxdzEBdJWQF;L=%6YWAz9f57tVt9=PRmc6VilevKh zj!4mSH|UwCSf)l!8u10EjX28veuvlmprzf z3XE+!8oNKk81g}dW#zSUT-qN0x@!9U({Zgd&Q-xn0NBW_snZ~D_6O|Q_ug$LIDHq9 zke&XT?B(UzCBf_x3;$m_dBUn~AWGx&W4eK4)Q~VRA*wIwXM8T*Mv%@#N@wv?Dim(%NwjNC! znc8CANGj#--PU7?sSDc3pKL8_OHZ|JH5i`^mo~KGRXqu`n!)ws$IYer2l5i>)8iRw zNF4zMhKJpO7Q}(Ir8um{9<)DLAS`5DoOo5#4K!4-kc)Qvu-fsCa6M@sx{UP;aW(2x z$W7PMu4IxYEoA4?)}?PH*QvN=Y=+>6&=BZM-xo5^H5_fYlN};$VU88XKN@#V#I5IX z@9&=Y^O@7PpY)x`YYuyhoJVFRa|%5F2w|Iv%TG6WTPrMo;uC=q-&9k=x~ak{?6BrQ z;9Wl&EWV|~&fr1{TY1`GnJRr;5UssMxyvRO*dGea zDH=@bYe!0@Nj}F0t!82{z_&MSDG#%kwGPvBiGEW9?xlvqrVBqjc_JVn5A>EF z&D_(_8zQHk+LvSR-pU#L-7|~7*W`7mwPjq*7faUu?RZE} zY-*Wr!RLkG^FX#9yj+XJmdfuRF7&@8zXzpuw0hc)9?GtLKbz(7jeHzh&$bGwskVac z>93&-u#eh(Osrg|50~c;8E+h)XowgQ=!=1mA2x0`PBq2ga3cdJFY1m!VJZsa&bIPn z$?_vp3$2^mYae;IBUAH2+oNrX<3fsah^pFFIh_pI+d|V*U(M)cakOL!RD*Kk ziv%C(fsYeTZ@3U%jFd`~0^I?AVe7hanv|8Twu_KjHY3#}1o=Fl1IEEccyn`nJv|Y~ z_2m>i;utwwtHZ{Ko!W;mTy~yI>5d6Ucf?K83PkYJ+NK=J zLw~)!ghZ`p|Jgae8@ElKC=sNo1`A@kqSN2-bVeQKP(llbs$T}a!n4VJ6xI2YOeoU3 zpxWMIz0hhuZ`?&ZbJFV1T?kzmytybQqXOIR+vTjEeD68xT9Y=Fb?K{$2eZ04N>Q<%fCRC$6 zM_D;vNtp)OZbFT|dM!mjeU+BVdzF@YaRxb3#7phym*VLT^*%<1*p!Vmv?cTux%gR7 zeJ^MxiDI3S{i{^haY|LMbk_Q0Ds|eTo6V4L=j?^*A;JE+9uBwv6CM(llIw3PcHT}| z_FrxWOS!Oj8($7cP&KGZ30{wKgV>PmNi=uJ$tUXuj*+wk=ksW??+RD~?`A zJDO#q#&WBRw3*^0BdcQ&|hXRmB$|=qQvh=K5+-M zRN_95xWe{$bF*%K+|43oo5;GA!D}UW3xn55@T#or->B;bzpP(<|CY<*qfyx}S$uzy z%VMUB&)k+>r6|{pN}B!ioqT*IrEf71;!i|d^c26i7bsyb7v6M})eet! zXIw(H9SFsrym!?aE9{ciqpkPKbjsQgfxJ<2Rz@gR8YnWEexue|MS9-yhY-_l&se3& z1)m7a_f6F%7l@KtmaIt_w;1!23+!zRrl-CYPxRJmE;MJ28*b}eRMWp`TJf9v%Twp& z)%Ap_n#iFt;YDYmtwx9Q?GnB(w~P5)VRLr%`)7LIf+sGnaO|6nyed|CLdF zQZab(n>~*^iTU58 zS2nq=e?X!*ZRM(8BK}&^{2L@VO@y~f@DmKm=^cv(0f(9ILT2%|>f+_zlCx8wxTVC? zrPek;mE-_?nSOAWgRnvX>RjjzeiFIQEbVh#d)2(q<>v>(( zoLUfhqQMoSQ}r4-J#}#&0!pV-^Jm9Q$Ba-n2!A{oYf}kykBONUK_I>ti*yAG4cwRr zf@XZz8hxZvN3_4mXyygD^QLOY5x+I3c20X&ZX9!IdqkSbKFq1nzGIkghh#(r@I4f` z7whF7tP@hUsEDy;LtIALKe|HR{K<;bOgI1cM83sZ>rx8}Nr zqust8UiF$9v}sns1swdM!Z~b3$ca5255=sl6;^>s^|xDWFUzWYKK^KH+wwDawqU^v;OJOI))@DY8G3#MbIQJJ{<{j9dOL~0+ox3$5zS(K&X_X9<~$mz`U6(N7z zx#?*8k*R8HYYb3{1~bVJsx7CfE;JmmP(A;NQ+Im)J5P1Qy2fZ-&e3}mw!^&2-hs-_ zwQyr){rv(db|p0^-FhY8Z#`f7unTVAcr~O~VOuym`CD}IK|Z71+zE5zMP>p07zM=P zNZv58t3@=Z?G8Oj(m2c5cLK#+r0E<)X$R8Oqo#AC!v&%f)CGR0GSqsPh`Ypc+xfBW zKox^xx@Rz!o?rI-p;it&zcemYrwELja558hvmsof{zIEpKIQizSVt3STyTm9J>&=?KR+S1U4W>&RsdA|tR)%+6(brQ@7&zeVyUX6% zDrvV$tN81e=);c6(^=0M(p%BrGkHReMp;YqDk?6ccj~)4pse_*Rt>|!%l)dpvGLfg z0~NMEPis?$dzrdQ2n@1byY>39c3WLoRUYYGQpt%6Rz{{01yNR50rL!+r!m%4gi4bz zroo%_(b&Vukc2?TUCBxbok&&%s;#N5aLx-;PO{S4RN>6)NY<<%;tDI23@2+z?6G9{ zu4H&ma#49@CA7t4)nu|dxnMbLKldgVhz$s)pJX{){$gP+W}jrGjgFnVo0-vRa#E~- zdj|GAx#G~2jCM6eZQZx1RmIVNxhjqjd)mh*J92BU3zUyU6bONN;Jn!6#!h6yKe2?u&c|% zx=Kp3?|}%NOBkz&c;k9Kt>yOseBd_Zm#!B0H>dV zq0Tt*1d?*T%Xv3?`2<8T-V9S+yqnbCtGNPh2KX({hYg5{Y(un5szOikMcI;U*-m(X z&z4~CH|NhhTQuXXthgOJXsgM)9#<CQqvAU|giiIY{8$wYHqj%uE1_C+C_%R4y& zZ{T>O7}ml`lqvit6vv1+8(cx@IXcm|Z0vFtL>eKGeZIQMiA$RLhE`zPeE_?;Jk@cC zX7SzF7M4$qr-$|rj0_LS*#IjdlsZQByBCdySKkAXqY<4Pz<%A9jBU?feP%l#d>3s# z6K{Y$s`WGpkJX%sKOb+!;<)Who&Y-C`h05~>)|#)6Rs*e-I@#6BKHjYl;S9!ZbQeY zUmx^~4@^`fEXmzLPVDnL<%p;>BwJ7uD5(9S^-&A9@10xg)7?nFnqjdkCiSHW-KjiZ z+QPo8ppU(G4UZK1udS2vSK*WD(vqvF)%n*^b+q5G8lmhg!A7kL>DN!4=ds*oav7X2 zGzfD6NnxZT)f??H3|5NC9mV-CH{^>tAzcRV zOZOPPU2XAabV7pX=NrYLKHWXPy7$djTmM#^Ik(cVxOqDWQMay!$LVT)9>+pF*;TKr zPaTE!zneyK8%3M@K6q}POBiY@Rz#c7%8(c-2$)W>V3q3qTXhwEsnpN@rAWDAaTlQl zQjc;%1@dJTd_F7H&C9f#<&duTy2&)I>R6R5&)X@yAKE%lTOVRuvDand&a=N`@Z{Ow zA8)V-6lxfR6Jz{gKOcMcu;Y8S;YV9P79r3cLcj>Mu;*CMRR4B?zi89x7y}q?afHQ8 zEKl+t#-xOGw88gBE*#Da*G|Wun=$fE$DWVHVRusNOM@OfXs{ycu5S9I@1q`Vceg&( zU^UoA7eDE{qx)F*l=kmMo1crjl*JGh%H-)%CSg|&c;Q+s31(399ArsMsOb-~5zeA# zVn*Z8;WYPkQwelEK5Q$;E6z2(ARub6h*nMZe*fHtp1DSoSfs5{;Ud4>kg@hMC>9JW zP2LhawMD7nh@INU)4TRz34T2X;QJE^I+fh~^d~zN$y)GRFnU8G+OeTKcBwF*TqFT2 z!<+L`f?R!`K6GliIwWOnl_*}Bv$!;&Jwx~NY4^1P+0|0|FPWA0;eTXM?j!hK$>mnZ z@oEj>{;gV#A0+H`d$V;k4*SbB~cgL>=vhGUtTM-6&IutaP}4ScnaxHj8X`^?l|1jh z*l@z+5o-l|2xdqX6YgGnfl)9jIiZz^383CRyMg{LNyYFfC+suG2Sx(;Y6QLk!v1*x z-vgLK==q;#s%n6~Q+yHgqwjawM>k6FZjBw+2iesL(STupwM!x$W4ZY1a($zo=U*#3 zi@ra~E|JG^eLR?5EN@4$i$9oM%sXRJf&T2`cFE~~DTc4Yu$VU%6BPuvnldJIqtf?B zz14FsKj$`YwCnn>hJr&^hwM51o(OvYoly}A!0wNoNO7{NJz1rB zlU0g>laLs_D`i8jd@>nIRxZcN;@)H>)*INQoR*z|({yNGbCxaT`7*6K4bM(tsa)2_I-*oSTdP>Gxza13&E_#lK9Ztv2U^4MT({rVL zHD`f6RY5*wU&NFC;k@u1Gr<|o1g-eoPes_@ljqczOyGV_;%MwnQt(0^fbM|IhA=kE zV+~WQn1g6eou5##9MFRILjOS6j#vx}^&a9T2` zzD?!K?J{qL;f31GHw*G;QRA1;LTM!SMqTnh>?^v)uiPAr+>jMENsmLXHS`CH@fBU)>F#stDnNE&itG<7+SFthPCUh0ko6&mJwa zZekOXG3}2(*nZa8t5;hCCAv)jL8Ds9LM*UWk|m2}r&7Of3B5xNzYhiGv^x3!UZ|B8 z>R{lG%jDtcSv~t0=Rf-?J&l0Rw3sR4VRNYLu6(0H%=ri6X|jTQJX1GiHC*>`MWn}wSBs8}Npf6c`NInIqb zf1RCTVx^pWE;p_i4Ndk!`M4iE1K_Ke*oA?=u#h?J>;E26ec!bDBUqG5C7-(VqD7u7lQUtjKR6~V)B-WA{%K; z@Y}Ob^B==D$l8r+J@KDI-<@Os?z`S#rDQv|Drq>h5}JZ?=CQ&#+ssiz&}&D0D#kq< z#&NLAp*&*`sEpx6q4_8rL&UAd%*oE93 zOVuKd2OvJ*;#hdWUiSNweZna6#oTC%j=R^z7*q(`8e(+qQ(urF>}PM($3*}LH1%|K zK>?}JC>8&ob(!cBY8GGp$Z?`vO zW2H=}v~fb=9BY@oGuAFf;Net;6*ixg`UvHdTt>Kk;Be+d166ft0*aU-e2-bbC(RCh z46$=?PXQSMl=@&ry|^fQF^ufT*+R4Lh8qG-K$*=W-NR4Cn zup(4Z5vr^R%}<7(O)d#sXiZ(03|ClH$(0r+v+3kY1Z-?3mRD|DKAl`LnOv4!zI@v< z(6AiXmu*`zoebOC!qZcK#Gc>}ikNyT8N%SGLgPAex`az5$Xd!uj1C%oF*<1Oa?ZEQ zrTbd3hlodr*jf#!ccS*d{W3T%AX72R6-7?b6^!D#PnxI zlkVa_e%_p%iIE1j07DeuVJ!w7fvp`_VKm9WKTFg2u_iHU#rpsAFoI$43LhEUY6EWmjC&)rPugC?v z{bh;0m$5va_aO#HB=!J;4-AmW$8#VEQr5x-9OKX7Ex;=ZjJVvrB_T!S2^$kDO&#q;*S5c|iKDVqV zz4X74S#aiV`;1L)LATw#f!Hqj5M!T`o8N0ECzj&2@(8w|-7CoWZ2Z9f^pM&l&FAI? zLyw#BbIkr3`Pw~>7r=oJY?ipzYiHL>f&>2r^BDzrZ>I z@E$auQFFkGi=mmAAAu8$o}oE$<059j+%3;x$0rUa&NGo`;m^iM(7VedE&~Qe`$k98 zdv^@xRRewvR)#xatkpZ-{WC7P1Sg4)~a>e1}loM46aVwz4Xt*&5i;ssK0M8oI zAgx$D+k`v&#xkQGCb(=^GdHGDfflDc>I7#NKF5$}cMtytkcs1umXYDTc~!)==XGyG z*bHw$v+093k9RwCFLC+*vo8N*)q+73>`JSP2d}1&!GThAs1LFw3?C}tK6rrWPlw@R z12=g{i3}>u+%q&g^P_N*Bhu-ubIXWa=RGWw@NrvJLhN9F6# z;(~5Nhm8Bj;1MX1fRRWou=U&kpjFH^IRy257xnK5mV&1QuU>uETV(zbvtsjaU@@E! z{UcdX7ObF~`M2{jb58VME{GnUaGILCr2a4wz(G8`G#Dh*HGW}yVVGU?C)BB!{Skpt z=gRg|41birALH-G?v4Dj0W!qqmHbUDS@ITO#+Gu~Cs%0LNkl;nq_Uk| zd6@KGig}rVm(3Q{Ur8de+sEY>UzIVhw1Ltmr0;*tDntMaUUCVa{`Ct$^N>cj7H?Mo zXPtu2XIHxILfuPm_Byq|;```a7==<+vdpD@j!L*Frxj9uZ8Tb5k=lNv1{01|%M}p5 z@zkmkaNmCy0a9?mKjs%dHdoPe)Kv1!s+w}bLr1pFh2qy~KAK^q$4DsJpAj|>I+!mK z)gFcx^Q*GK9O%$z7!7u^OT+yOOQ(BwmV c41(YtVDN@+9v5m?nNjL{0t6MVeDlr!4}m#s%>V!Z literal 48815 zcmd^odtjW!b?<)PzVy~g7RHu^y*6NMW68!C5=;`bl2+DAt6fm#;j6BxO{MqOu3NiqU3lHq8?L@?!`0UoHAhl$MQ?+3jipEWdk?J+ zuUi`i{AhaLF3=>oR)?>;YQxoQH>|y?=+%cOPMVhvdGNQ#`6-rAMTNoWLU{>!Ok?7K z@v`PvJlfb9jdVqu;>kwSGjZ>DXjQ5!l4y!_Hr2)w9o=24CdNZog-3_>*AAo)qz9z- z`%IvixNp3mxjWI=6-y>2P8dhbOMo!c6m59BwU5T-Q zf%kY&bz=BzQRKgHn1Quzx6Gn!~UUKjk$0NgCalB)A3E&TaWSuHs)>cN4k zS#fjaoCDc^d(=auJFjIe4x1RSTzBmZ#u-67cyeCyi*(fy@JyjFODdj>G==aM1b=jN zCOfW{$~T@L741-&v?EufbJv|<`|n~F;mZb5F5z*Xj>l#x{1gUTg)Qj%Dtp#EG9 z-aM}Ybe@f}Jrc7)CGF>g^!#h?5_$U}Aj@q?7oX>4g?cf!SfKunB=!#W?nw{VHAT82 zDGX6*d(Sr%?yI>a^7b^~LhTlu)S^?#^L$ak9?OLV>@>jU+hD0=XP4DL&GC(r{8fdulJz9PW^qTBo0D85*3IJi;{vetZL1ezP! z4S;j{Gt$)5l@z$t4Z>xmb|HJs<6RiIl0(R7kWP+vN?X5w;-f7q3Pad+N*Kj2Ky%|fZ+$sRnI_z^M3I=gq>(?xupO^Le| zb80m4qoyBR_X)*!$34p`EPQ`)^)XMql;OE2e9Y6dcyUwH_y-?fYQ+hb+ofFj^V~Xd zqF~~L7fMch@7{DX^v98j6DG7I|EBI_R}`bGpgqzCElTvA<=y-Hp(2JyGih7n9NHc3 z9T*7rWqJqqKz9@c6bO710ly=`JV@y7A34v&pw2luc7{psDkV*{h%KB04L zf7l{on1w8YN;?|1KsMNEwbZZe8WmVIYMdBvZDjpl6E9ScX?U&=AIhc&`h}dj{@uMJ zP-V68&>8clmEHwW*b$#uY}dqi_6-)R2=WVz1ErQ%+Lg(U*n|y-4`$JuyVBu3Lqb^Z z!QMmY>7hZZlng@n@`}1*zv%ABC>Av*HNbm3=6q>t%C3_0oo?US4!mA2v$P}GpKbOl(8`f``2Kpmg+qqZ*FH7 zN@oLA60NKa>uYMjB4&JTWB~0yf@VYG;@{kjkR6mIQ158g>ZKwZ-R|8sJ`k2{Zk`yw zDus2EgHEWJvstHM#8CE04gRYdt+1&z#3N~x(BKE^mBLGoZC z=~uxK9vST&9UBQ_YO**7JnW71D+^;PDiMZ**uiQm+Bq?P8Ir=igq2|^Qb$U)Rt8sK z{G|uSU=y$;NKi&Y^Poz>oambmPmC{042@=CfU(f%EMpY|29vCi8s(G)$QzDh8XdNH z!b0)3X((2QcfqvN@3NhcwR>!^PsX`SOe5j3!O`phWL&yGjj92Cu|-)pF?7&wu_B9z zM6zdMylz?%Y_kDWM&)*P6jhy80tIFPk%G5vjHSfbnQXV3uVy;Zys87nt$Rr8E`wxd zd0WeO=Hp&*37r5Tgbj7l_B>Z9Av}q)3rR5lfnL>gBW@C zfO7M4Ab#r&F2EdNGD zEt7oVgF|Bj=os|eaCUSQ3I&9evc$v*za?3GlFu#upWi$tRKdTwcVNuvVzUDp(h9q4 zS18@JBz&by9c0D<%>@J{&9;DQN;}Gj*@1dp`v&mXd?C^;JD7D8nsT%mntFH?V@K8u zcE6d>iN}}Ph@JKVMf+`dVMexldAMn)Zw!JQQ-cUl8;8F!-jr+veQbB>U|84p4Gp58 z{gA%-Sw=>o<3eu}hPM00<-|D)5Kb^)5&reDPmC9Zo6;kF!&&sdO>_~6j;0zrV+|O5 ztLLPgS@yH47>f?Q+b2#0$*l#zI*`Uv&c+#NipHZ@@4;lQ2~Hlu2Zfhy)fr;0Sj0VEQ0&ql>L^kdKtDzi487!z_dYLwyv*B8^@LF}OO|IJEyz9zzEk zlO0<*S{KQh8DkNvl0!;SZyrrDARua3c{H8V)J0m;TC^UP)U${~JFP;}Dr%eVk{Z~2 z?L!Bg_VTqSH>0%{OI%)CiEMx@&p^A-mX>@{0lS@jLOt?H+-v0%y}!M8c(0u=*vQ2m z=C&mgotL$D1j0#%hGhhBdn2gpQ)}%YgW8?MmsHDguFT9Q{Wk}jBoOU}OGp@9KT;&#&%g8o=nElUf}C=F7> z2GdbJlu_q2Wbwim~Ft)ioFGu z62s7iD`n4}1+y})eyxm9MGwJdwXb(?o)+g#q#c#pn}|Z!zEamb6b)k6awj#&K+%GS zFsY-CBlf!8Wd>0rvEK@n19qZz$4plAthG<}r3c>V(M$VfBb!$1#$f9YrcB{=Ww1~WsX<7-uZY%apQIpF# zbvrC&_bFP1MmSa^4ci;W(JTYsvI`pc9DMmQC(rIE=E3II&;4653+6E3e@#1JI{PN< zfVtLR!|>;n@a7GF=#gS)(Z1i2a6ud*h;QA7N?#Kh>>W7tPBjZ-S#9_22o#AvIZ!|W z$O(HI9(()+t^7J}WtRBJua6Y$=WooU`Z%MwQ-OB47HU{|=2%2Nz{7uisD;5TN!(wWAGS>JZ5xf_Y?gh+1-9T~Y3A3n%PO zQmojW>LX*LLxN9rGRN2{BL70=PHO_Irz|6?YxT6MMg!i)rXkK4y}ymJ3Tes+H#ImK zN#9CY)}5A$aASOfg_h@ZtVX?eyd*ysdm=jT%)me*^R^{&o3Mi5m=ykbjeQ6;^;vBu zmIzD5@iz=-t;OrFjSDPa5{|kGjMEUFU%HzPvosvH|7NUTfsX61u(b&!P3nPxVX1KJ0sQWog1N9B$XiYb z?y$2caF!E7R-Ss!jO{a2^EtDwo)}+XnQ^Jnh=hv3f_fl3dT6QW8nTex(gFKV3de3z zc=d}^k^n5t(Rh=D=1J7%NN1`x(iyFV*|0X*Hhnw_Nkz+3h(cR70fm;lU&QnR2K%zd!<%p5r2y(#`h(MvwO0bS7COt%|5#h zZ3wqQ2X0Oe?-?6`QVhY|JT#0drH6+`V601rm$RB9Wc!d_H@o=NooTmJ*lUM}4~ZaSHCD?qMy%Jsa@BQjy%u9<2JzdP$A&Tb zhQs@Y`m?(oT9(72yJwIQ*w9N4V$}Af#Uz9E?nn0v=j_f7!?uM;v>c76pnHX^K_e+^bsXLhON6o7jdaJm>SWm`;k9emUM1!@ zR7Q&tbMcCOLnEUDhgKr0e{8V77tJk`t1#bmjMPff;WUgpP=_2YMHkaZOgq9sm~q1+ z1F*ZoAO?f1ZH%>cUO;{dM@=1*B@03|WPRoq&y7$iM*2Yp6in6O73iZ(?|xQ!Sj1Ov zcw~RNFWZar1l-;QO*Slo#36PA0HWcg04@g)=_D$cWmt`@v|4l|jb#njiqfQFeYRvl zU1wB`Cv{ET9r0KrHi7EYlAWix<#hr$MrL<1l?0&S+U;YvxLZ%LdZXjC`P6XhHX`Rs zoHUT}*w>2PTql(IIoD&{H4-BVo#Tj7HUf3Pe3!82{rM$C? zrp;o`f<+=1q&lLFB5!lca#!Y7O`MQpm_-}o$%aT=qU9|fX>VwX$RSI-6)=6Zbfco?(*DfB+PHXUdJ9R0tWlrA+|-;Krf9T zrEGf2#EB9_`bb|bvYs$K`lZW|8ooc~w_<*Bc z)Ws61?#`%_CYzkCpO1AlL>ISv}3uA z4M|r0or>bvx*WBXhH~QMtf^Ibr|~4NF`i6GJukBHNu-PHiu}4MjEr`H~%A1`LQLaW~XTp|D+A8c%ycQCNRW{^S zycy%cdR@4~DF7#88r#<36_!M#l7uIbJ!s88_R!yl`v_)Cn6_#zy+AeGKzpRIGbxoV z0FQv3yQO&xaIW1BI~?EDg%;3(jC~@AIXU@`r#)%Zq7)HnazXy57&ccUo68hN z3gS9Nva=~gakT~!h4$?XIqoF@sGltxMW=!+6@|K_nX{Dkvq;vp6XTbrMtg@b&&VW3 zt-600v*w^0miF181;}l{8ZVPbAda4Qcf*4g-y9(|QW68IZe!Vgxz6OY$y)fJppMEk znzu?<0(}slo0z>8Qh5fV71qQql!!B0 zo#nL=a$Vv-YmP~)WO7{EcRoYR%>INn#C}tWVDu0elUFnX6D`j7<~I- zvmP51H5e1GA1!2NxpfUrNOg5aH+4tiGMh;c6sbs-zUQf;l_h>XOI_N>w+UX*)Kt`XiD_99Pdr;%1Xk#3UxeW-HHbGOs@-AL4 zV+#>wO-a6DAkfkw-~i#S8MxDm?o`h8kq_Rd$I$%=s3noSa9qPai7uA#{pQ4Y)m+!B z9vHv!P2Ae@d;~Q)>1#_J%N)sWIo9%_E(vTs7Q2Jzolmb$J;1IL;nG6>71 zk{xXu!BwdaRNO1<>DVT)X~65ZtYG98|%9mb(3^%=?>L(R7yx62Q7h71MYy> zZx_j7T+AHL8ry{NaUaj>pN$hI%Ye~yredvGFKoO0SliKv_gE%$v-Hg4nI|ej{x;7aCuTw6kT;pKL$YekA+E9c||0lP|@C6~?yH2YRZWs0bIty@Fx#Mq_7)pu~B+ zZE|HYRiDO%YH&=^4|=-GCd6NT&+r5w<9hjuuhm zA($L^@W>4oiYQ4Vrv#RA8t@k8u0(&;pud)QOR&O_KHFI6^Z2aM=x2=f+4mTJk-y*N z?+g5W>Zo6u`xIaHNbnO3rsQT?1r!3Uh+GVnZWEO?#*GdO-E=%LIj=pBgLVk#9Gh&a zkF$Cck$6wpeA7ICBy)PLRW|tQE-QF?UiNVU7?F(L_q@A4-k_nFd1mt7HkLHiipJ4y ze9qL#s3V(mZ-=~fixV+IT!ABX-3u_-{FtwMD{_T9cw2_aO*YGj4G`BV=xjrDTM&vLb z&6}BcZUrBK1$?Xt@$s~9J&s)ACav9ntrI6p1;^K{hI^1rzRNd7;UK+v{FLYOR(GD> z-FUK*4flb~J!L&1wr2pjJzJmg#GWx@&-n0vh0kvxdsw?$`Ehc2!|8dEhD?UjU#VZR zP2J1l+-{zlH>r6THR$myA#{}|Q(eud`ba}#6JGF#UkSJvw0q}?jPRqAN>*{!tCiim zRi+Oy#jE7+xHhp>WC>zhtWNhf0m-8FP-mm-BX9tQhS(S3FRt5`5=CtQ+ z?AH^c1&OR@vy9NvtPFERoeCYZF{sA~7sG9KE^UQVp*=R_Vnx)ox!aQH2q}f9LJc-h zSAMlN&r$8JIjW!EELQPdo2>>e|0fIe^mZ@*E4#!h?GN;+MREBbUpVO@JE<+7&iwLi z`tsxQVQu>C!tDM(eN#SEe(pDg@uaSX?#M@Qs_Z43?Bs7)2+>-kmwm{_y7@Q6x>-lY z@h;)YWYbmXfn}*(=!7UHs)BC5>A@d8*_=I8?BPZOI31@Rb(?&j7r;#Dl-7 zQzhGN_}UA?zZLMTx1Hw-JI{LN*_@ZNo8i)+U?+W_JXQP)SE>~M(9XJufOZv%zZGL} z>QwPx*bvL7L!8d24T6kmQBwTy1%U6&&H=pN2A)y&7N_il4N)__>}z8-D->U8gUmoO z&p}dXLuiX?i)6AYVXZbPdbykRusXTuZ|pp4S#W-f=H)|Q7yUl=#O%&1`ly|4&Ff_w z?b;l(SfnUp<=T2YHd$qbVePrgMt0@q4|i=&+0Yx5Q%SBB$%%F9RM8SUM~@{gPB)T{ zIjdawD@h5Rznni)tMyhh1h4BJS`^i(DPj{c*k&huC^BXPA zDg04u9CJNR$E5J7KBf15hxcjo^KHsl+`I0w~Eb$yQh z`(IkhEp~UMf5X<9Q5U`{XV@L+{gqu--dsMV9mvA@WA&Ez8#eGe$f3#v3f!GHbtw3S zkc`_%@=GLX>eDPQc*^U@|2G1>?#*EK+rW8R!c>0QrlbE~5W<=NE(r0l*Dd8euM6Sm ze-|v}IvdB*ynfLRVT~+B!K`>=aK`uFAe>YG)(bJJExq#7^QE=2kUiZSj{f)CLb$}P z$pvThIViIQ*#b76H9OffdcHbsU2w|tgk8kj^HJrC@cejt=9^aW$%7V-hx10!)MT#} zJ7JYQ*x4L1)ru3v`;;~M-_oQAO}AO^yScp$9!2*@ak%HB(D zb0ij*sJkV%XF`Hv!42S47cABC`Yr+114)(#!-^q9`NfcZl>qdyVDau(q1(Sn30^N) zaGC{`mDkJJBD*EHSc1m4CCCjyulNwG;BJ7ISlD`AaRM0ng@ZfvJ-bk;Lg;@np+bUx z<)98dBZbluyh>93h(Llq^oK4YZgwg92i#bij*Tx1?19`od2pM9#D)4@xGfBlxDGei z+O+XwaS zo%*&#AJ^)mijT5?)yH4y<8%5rs*f&xT%iwb`h_U0ly*-qgFi)E2C*3^26RdK2LhM= zB?% zlB2r=(tJf*T>ze_V_y_qlY5&aUdcpp3tHsXwn%Hs+(l0A!e22cv4#IA>>-;?vf-Z+ z30e3IQx{6`EQ8{bwD6B0&Szc4#g4a6Hr@q5WtPxf_-PmaLkvoD7ygbLyvq%~(}ms3 z5n9NT8f=|Hx0;38u_Wbfpt;aKDka-^g)3crT6xy3jIqp8kb4W@3Vy~Ip|Ri< zoZJQ9c7xnzAs-Zc#f80Bf}SS@gWHP*+KWjrz>pzQvd> zP$##haRj<9nV`o)NxBS4AslSPc2P$>g7XE~3v8DJ@ef^!Q;^o-6_tDia=N>)Db)e@ z8aO>HaI(uDRHxKEcn|&`yayVS30xeISKTTdl;B?pL8k1U2RUrbgap4N`PX!!@J8_g z98|6lr?SD{M^Z_95F1d8O;%i<$zAHb%r7UM~VVm?E=)f7%C)aTq+ni zEs8+m82;9?s<*H#vkPV!-E04xcMId@4Ce z_cbokS~s|qK^c+0LIzn~(~0$}*boffA2`{(Y$XZ^@87zxPeOTh_E06qpExMJlP;L{ zEm2OmDDQKFcet`0mW&4SvIgJ>$myA&B+K`BPvvKP{SkLlRytL@6_si-l@aD=lqq zj=PzUxIuR|G<7y4teoyD#_2s=u)%>=x-B=gtBJMQC250;N?Bjp+Fb6&R=cp;)z<^S z_$S6P_*DjFMm7Fef}Vet;2$zpN;6c>30~tN#tMnX?=Z;NyWHSA-QchbyA9Rhk$7Eq zz)w0bcozy9va0#01WCVnlLRj#fQSU6Sb_?m9Vpp6zhJB^Vm#V`j8#^ZY@R<80Cu*A zXJ^P5p2rx=V=A9?0bF&=!+B3(-$#I&y?lgq%!S`7Z>FBB@~$G8W_z*p7G^H{#EqQm zDCxqP4m&~!`WAjFjxqZ$B}n;Zu8`o3jJ-mF-4fIlUsG;Af>IA@D8^G zQlyKrQU^o%zc>Kp97kMimH#bB@WN*Su$6xU;R4%Bf<%0gC7qVw=L8N803`ewiT27A zT>bzdo{->OfH0E@2_AI;_7UJuBvxmMD`(6agC^DG4jLhd1fUH%6vl4M$#K%M zx4T)$#Y)0DH%l$Ekg)39F3F-}kN5&k?ow(Y?4Q!Vkyzt%_$htbK~(x>7xwpZna$UZK9DIcwMXX2Rc_tQq7x)TV z@BtaQ!+}hNEZw+Uf**G?jylK-Ina%x0-!}o>4j^#3M#zVfh+ixu8UMZ6_^6b9+qA( zDR9QSCH7GU4@xknS>8n?%#w8Ru`pd8UBfKfCCdV7K`d^tuxaj&$D2i170g3qQ3pOx z<3@2Tv9E$EDuo|{e@yfu=!5q$7?9xmiJt3?TNx`%66|JdM1rjh%Fqf@MjO{juz<1a z5e$5TLCF?)iovV|A9jPRqAm}%NUTT1X@FAR^LYtgA+aVgEJJOAaC&Fip8`}QJ->%^ z|1TXV|4$|86>Zu79b$Y~f@c}zlHhg;8e%B)>o|W}f|S*Uw6%W`0Tv5)KX(AkzjOdhog_p-H7O-I-I}{y0P?u!ya3d@ z7^++VSqT?o)f`EsqV4$H5g?6!hZ!T-ooK)sx@`jHi;6AL&g2#z+{KkZIddvdsyc0z z;CG?I`nx(K{7j3Xlh`&%cv>n+Jn}Xr#d?L?jr$#93~H`yV0<_SX{tiXbylb=a$QT{ zFJg+QK^~54&vzvFfMR(MA6JYK=GioI7IY`n*3SBSZ zlrh&Iks=6S|myq&$Ikhwr57~4#xa55zZpUyP2uy`O9(R;Xs;x%$0e|23z{;ucmYc~jK2IjXA_8@=X&EKQ^ zwHxehJZLMpKf-tpQLlDFTw=T`t3Kl#*4>rcle;m;5#_lj_b!2f27W7_cM=EbHlASk zG=HDw@0a<@wl=;kVRRL{Om*ih{K?4mRCR-Z>uA|w+r`iZ0Ed1BZ#Hlp06!1nj6ywO z<2Jtdec-1f>gvQm5c)9O136$;9KOSWYf|b2x!Bfbu^lAvaQL=L{7MN@xg@DBrAFXd zFij_7`Yi<9{+B!Rvf>JbZEUPV8d2r{Zhd&;4I?T4pRklvAI54yePDk<`s5Q%{B{m$s z+;JEYetY~5p0HaZGEjMMNV8<0@|Uzk;V=@Y+s z@sqQ$_T!eRx}(i=KBjzDitn$i5%*Za1_v{^Ws7frT*zIWy5tmwDgkF-2xZ9+CdLekY4Y%LR`^5 z!iiu~Jbj9jY{vZA#P~A$#g*)~|I3*lp^=Ig{myK3!?V!AY3v(B2UlrD{3y@Zer1Nj zKb;uA?(lMmBFp1-cK4z1zA?BV!aa4zd*euYfA26pR{&2`;$bA+3-9sLP@u5ze(Ye> z!HcMbk3jhKz(cuI%SCB_CkWTNhot(2xOMIhLe;S^g|Bowr(kCP7rcP}7jaqe44ftA zCkvW_Av<+DQf=XA_h0a5*b~<}2G7HJ8XWTqRmd0oDDvGP0Wf8?<=YoG{j<1KEKX4A zjY|0{SOX-uU@XA%k&D?wD6LtfENVm7u1F1>a{vP`T7ZGS%L5eePm(+E`&QwBN8v0D z9tjT(jlmy)I{6YOO+ae7#wGas&|y-Tc#tMH1#X@d^Nv|DaP2ldm;dEiF;C5k$yucN zPv9D+I;aK3{tsF8@xLFusLqr*1xeagxY`8Cq|6UC3|emDByDAW8u~Xc%?BTNPCnni zO;1Cwm_+D`^B8u3!c5`6OEkc+t;H@_q-Sdb+cBVOtR8mA;pO z<-G^qa@4E3<04(6BX)W%P;|g60e#L7z@ZX3UqIx@g-moN73cqLWiY=zF@CY*``-2R zYe^{c3!pXucU5q$IoQ8cvfpLr#DFfO+kG1re)LGB85ZfJ$^+a*4fR7BYdwsQPmIqG zugL%8D^lP=bEQ-c->}4YMrP4qw7}Q+;pO&7IUJb*ayX@(emEjy&bS1H%Xb+peS=O{ zZjeUAM;*t@4ljpu<8 z-=`4aFQ_i`!HEquaNk5dWtPJHX0-Pso+fL45>{xA;g<;V!tWe(b3h}(w%5q2S2R_uFcT}MNcHw zB`Zi>+<4DX9X8wG31U%wgtuUy@$raKq~Tb{kz07EEreoN;b!Z)=s8?%1P+{6^5nR5 zGTZPyxC`GGrX|74MUDB?QS&09j-Nc0d&fn13&;X7*=Tr)7U-2M+;a0>RS`CLsERGc z6J0#xnyJP`@mUumGqrM2oWusyZ$gi$w6^n#YXD1P_>N*RaW8n(y2;8c=9if9$4mvC zWqiGXb_8#|;nP=hCB8;{S!X7*i3hw$(PNwRs98&%Dv~kN)YjSFEYdv zhTXH$Gjj53y>BrVxy8J)pW@Ba3c@U6>$JB;x{~eU8$fQSf_|LL>VaPzbmP)ICSs1i zM`S7$0S_3bZN<|F>Cj%~Dpt5pyK|AIy==n2TPU{}`DjV92Sj4x zq<=(-+2xtq{8;8pMcCWo-Ek~_baI=qofVhslRJ*bCl|JnKiOKww(j|+QExegxU#+# zujBb^aR%rTL>dG|6X zyOEyvX)vofckxj}D~tD%gr+rU+(9(*tXf>?;DS| zPtLDzMZ^pazYnbK#FDjtHx|+pvRdYA@Oc1y9?Z$X)F z{W#s&0*@aVc$ra;5(-lhhtFlvT`C>m7KqPXVui*$@z$? z+F3c344FGaQ0I~K}OkYb<``w z`_xgNbk|4ulHDOo9dd`TQaU4aOGirFfMXnfV?GJ*H{*?;C5yQexQP8K8HOw}6@ z(-j@Q`cGukV-F>?aHzW0;456Ke1M{wZ?+?=NY8@#<~HMrR`YSocnJmjzl_0Wgs*PfhV2A}& zvMf<0oqLnyB8^pLh|GHpPk*h!>yx+KGI;x|_#YE;b#-2OMZiSO?MP;4+5O3~Q=a>J zs_yTpI_0@rDZWVvW017*RcK3wp3EanfWUHzWJqYM+!=b(a)$)kP&MZ*JngMU-lnFJ z21v4Qq6(B%_JNLLPE&i1_RK%gGk@|nrR+vjqursbjIX3jgKRgUMqk~QBA~uXOXa;v zOMP(~Ia0)v?dX@Hsf2nvBSUP-wbZx8_0+z&%AmeyK5tDDFX)u)gZLxszG&%{zocg! zZ(DS$H6-jg`@D4s|5?k)#n<8Ff{KsXS>$~^W!a~a@2R6@!rrvxo3dAF*0b<)5|jh; z1=y1AjyEM_Kg&A0!lls_jI(NgZNd6$Zt zzEDFO3A5Sef#Lo>z zdKD>bjEh$&Xsv)XegRlxtAw7-$)=V;moPrB=H3u7;r;5E7B@}TPClc48^P8QD#3`!Qy*PSfZbaD9h+;T;^d_>aBXSqjY9_Dt7 z`D_aa@x`OfdTYX1Un7KdrdndnU8NF?Gw7AVzYk~lNh~ShW*kd?^_(v8_&itf^eE4% z=~31+otii)n}cS#HS5@u&pIC_ALAcmJvH;q9j7E#W%wgJoM z)?Jo@8n-B5_Ni0Gft%5Uo+TVwEh0C{zSu$nobgnEpa#YX+75)`Pu{y~jTL5b>#^3m zWjbYTh(O*bIV&R+EAa=|0Pd7jCdx#o|3RnhVWYZHL=>7FYKzo>KhQ&FsmG^6Glhs+!25QgY^blST*g2bl12 zASBj;>0O>ZCg*GKc}rf|uD|Rh#FQnkUQl`En@@RF&>WAXTHr-+<~;5#g927=DPF0v zxxIktY|r`JcNM97>gZzOUDZe*6~2EJ)D`x~VHz3Q62pTeUO9+_9bHHi9Gm8C44qr&~00x*viUyq>Y4<%^!N$?nhay-d1&Y-k`t{%)keV3HO z{!{up3Gou~`_>on?L}3;Hi>F%{E$&ENN^l^={_k+0qyy|B>6F%?4cN$ZSi{2=I!@Fk4yZoUUd5Zw!F03)1`^oEt7os~ zMfnp4f}T8E$@KNS`5Z}sXF~aQMzBeb9#Tv6U9*U3FO`$_Ym_Np!b%@xn=hDrV3w9j zjAHLWJ~bsKF@vpcTL8MORnrIZt5|WBx1|djz*+e<&$Px^t;cm$b9zDKp?X`0PS$DU z)a2!P2q>LS&zl)D)nW;C3*o;_w6v)NdcPGjC4xYlKNji=78+Eu$T=O+ zzN;+F{5hO0R<)zcXUwUcvn8Ez%%$y7wo!^xqq%vAZ<}O91@Wa5c!=xS#;BK+EnaTX zH(f^kDJ6pM?Uyt1<;8sTSe>9}%FT1#z*Q8(g#~5dMgj7*I$iS-X6l|e8ECB6rdb6q ze(=W%XS5X|Z_6iQp%!CDh2ghSeeDL@%P=Y*kKNzew*2fJZJFwAXT*Etw`}K#f1#S3 zuhP=w=4s3Ms;rj#fz@KPR+`-?cMj{I9>j(n$ykXhcoSVMradS~vtzs548zH8aLtPvlJI@rsZy=DqP)`_aky#*P+1 z#p|s}hEQ#erh4Aui1S>i`NWMp{eoVkI$~`@wAOJgABF8u>E-WcRCca~8=Jzni7>D$ zsX?jjYQDE!EPdDs&wacT)1w;U`eI4+t=F#Xh6K^R?18y)iM4=!fCA!3BySj)^F=hM zX8nRin$9vkKrt6-no8wPdV_=8yVP4j+MX}uV-2bB`fVb%h~>89V>bh($JG|@;JaFI z{|!E5v#{KHa!VncRE}(c6q@cp)Vq-A)1m|V#OXVyU}L>WX>LBP!uM&r*sYc*d8nrv zh88g$RD}I4;w}{CvOA3%dunRLQ)qvEJDHeHLU)#(NR~}*Qs<%PPdCP~rpjOumDgq! z6)+ljcP==dTyS)<#@IPOSyl7dBobx*7vi9uc%T1r9rvnd9PHtL=J4j;jrlIDJTrJgxy;D+Ez)kRlt1J z%k*JJ<>~cvhICi-+a^xR(L3YPyozo)-h##<)7S&bh@EcLFg*6$qv{(QkKLNBFnxJi zoBB-5)K)@Z5KFsp{&>5op2#YX_AIO9#04uOQ;C8oD~zD^EU=!Iv8Ezal7umhjVOEfwDKM6&t{BCaq($#AlU#2!zE?@WgGCKs1g zRzh1$R!t=5Cl@S-?dR^~0cQG?MEribSbI-smmunu4 z$!KR|RQD~+S5$HI)u`eKv8R1JPx}~RPb@&?mIcUipu3J;`F*;HoRLJaZo*R}LDW1{ zoaZE+zKeZwXB=)yK^ML%wEkMmS)fbr%W*%(hx08_hnp$@xY)VgZr>-Y&BMwyow*Gn zbS`16Lg1;RMZz+27f-!<;?46t9vTFP%DDnPCg;8WU5G5VyyV+o5*W-?y)_rOTEL^7 zoyktQ>jyWUi6-H4IW|k5o`wXqD_lZ|Z_-z#owU!@N zASvU!oDrm>RzMWQnqaDnb!`>;?$%sEI|DqV=feiYM7EKaJU#SSUzjV-mE!9xfgHZ` z<$6xf6;69AEy6C3Z#8+>bFjNI+L6<4v`WzjvPK_Cz6^%Q`p$ zH*q{t45M*SIEk_f|9gsK#9JF&1=4eL=5LtT<@84yAdo#CY`?E;>>a!U+wNKH=JHg> zVVcGF;3JRn5%Kikf$Z?mpqvdbBJ5IYYiv6jO*-X+kzIV50K{N;m+^0yWfqN%Qgd zocuaAG;@KxdcLBgHExh<-@QgD4mrq4EAmEy=VP$86Igo@umhZMlQ@}YuTkt8TT~&v z3?Ad(Z|Uu7i$ALq(ldeW+r^=On`xTHbNgO>uJ!K_G+Jp`+)A$DkHzEk^FU!Oh0j=xWH*Ygd3N~b)=V`OE21rEWk`$^1WbomuuAmev3^b9N;c3pMamV4dk!s7 zSB)>>1P-EM8tCGM;;nM9*?rx@4P^72>R9Kr^FfW#Z1Wzhm&^ z+20?mHwYA}AMmnev7cXWiXGpz4d37Tu?T_o5&}l3OS+GDPxi3^muxxH!T^R_3}G=7 z%ago^F)3jkZSb|?gu{8^nyJ`h(?;Hzmd9ISusf;srCtvn)Eg0XJ~(yC^HG9)geYur14*QntYV``rKx4hmbt`p>T1C^yA_x{ab2r28dvp#Hu{C&Z zvbG%0LWuT+)Gg$;vsmi3>Y0N&oKq0{Nm(`^(QlW zYDCNvx;g%wwREsI*PpXw**VT&#j@tFvkz;agNsuw_=XfV7UYX2L445!Um(E7uUaf_ z3VP>K`+T2am#NwZ*Y41DWbPwNN>e0xgzNx9=(dGI^#m*NN4)UDN zi6zr>M{e;hkmnP6b>Z>{ssKN|lzAMnw^O$uJzwsbKlj3NZo@^puI#EQ5_H{1iJ+e< zVN;{kD?&k7^sz^r_%w|57aNle2{C&VC9B$#Rhl??Xg2I~c`YJKxm4Y?cG`d)t(TmNaD@}Ks; zQ%*6CjO~(hd_3AHhx$05kKnjuBhJN+%0-LtTPDWq@J;4He0);Aor%x4Vss{*jT-&7 zmK=?A@>>J*W@}bk&rz}DF&<+$({dKmgbzBLEyw3mzVEFn;8S)yT)7_33(q0r&r-&> z;v+&8Vc+J>?0WZS3(Nh_pB!tsgP|w#0CaC-CWK{;JYGM!N?n?rUZl@w0$a8iE!a1C z%yMgD@VVyZVx)if-f+$-qxK&9_-qCU$QEH%Os z@LtKU9!WVphS)I*)Uw>1Fc#uSV}UxUm4mUDxyt}IWF6_Pvr9)au>vfef<=six-RcU zn%?m9iauiavCurIy87vC>Uhdl+GePZHw(@gs->;8x$5K`Dx}DUqN&!tfIEsqT3p`l zhqlkxUb9K@;Ue~@)udXRFR>YIUEe33a!O=(O4+J8aSPL1RTVp@d3N|3CDwQ8Tll!_ z(%j``3@tY<#$wz)AMI{j%if3wJKFXq52@8qRn#U_vaIEDFBVB%^`EH-!Oao=rsmwwgAt-)fo<%1{vtPAYfxn*R=BH2#Vk6}V| zsCBkCIHzgI_ci9lX`=)Ko7c$0s|V`Lv`%G1dSn2f!?C3OE=vu&Gk@jZ;{7m%qMq5h zOV<}Q_8C>w7S+`LtypST^tu^efvTSN6{wyNG`BV$620&Jamxv~So6Qq)>CP10nGVP zCmAQQ0Oo;B9>>zp=%tiVeBX2|YeA?{1=wLLw3=xbRH+M^(S6^v8q0DP)kcYCZr;M^ zmzwx^d7V6bfy?=}n+A8^LNmqJb8SnQTKe;#YlVf|2B+g3vswwlk zT!NP+y4xF~o%p6JzbQ*o1wPKYrLHsC1BDfPy;NY~N~aT_A|g8$@SAM%#l6BDg__w{ zI5#tXmyHD3*M^n|=vSSi^qtQA@udQRql z(vl9$*=Ej0o5vF4j>f$k>~c8IA|vw}j{RAmj-!0x57iWWb`fW{Lq1*6@BNAJ4mQ(1 zz;7;Mw+DM7cY%4bPfWfTKfRXRXBl@g)|to_PmRtvDH!96OKj;6D*=t#vq7_W1UmFL-f_U5AZ zo$~6f?zD4d- ziw-$X#y7guXrQoB6SbL{dvyE$T}br(f^wrNmc3J&w zo?#tTsEF|RY~IM4Qrezqi9i2%OZ+=$;}Fbp$}EF*B^IT7Wu;l!{*z;q?@m^>{`h#? zuio3X_c`oYWw3*l!G>05XEor;_U^SD-6sfQ^^$wnAmVDtK7MKD!FVT zd0BG#@|~A~hULJ1+0JEC$*{RIJT>`c_5^=W#N@-t5O}i+jq8;Y81vZZl_m|#U``rF z!JIS+;iQ(ht-+@(3*`~xu2`{7FOBfW)TC=}fSUl+o~`BM>`RmcHu z^0hxM<}pjGe1~10y=ZQ+qN)1*PGc$P2<}Kg=JEbHUykPC$S(aH8h;=>;4hW5 zPq@L8c(>B^WFrEo}Xiz8@?)GMec%kpjz?LqMw-eZjt1FU?w?w>*1Qg z&){Qj?5Et|?`V)KaDREfzA4@18}yCpvA>)mz+YYsw8ndLtK~7ATPBYIfir2E_!sO~ z1|pr}oDp$qsql+QTfNZGaj720(^wiU=-SEiIhICPwT2E$wwxP#KZ_Cnaj<3L*B`o_ zG5d$~P1lJ-+Ww(#rVU0lt)6fD*6Q1pxwlY6_(RnB%>gc+{2?v^JzrrJPh%qv-xJ5A zBL@3UIbJDWh=*^V^zhJaxXM4ge@G8SgOuP?^79q>8IYfU#E9m|-OcvxKlvU#vEBg|2Z`gC;->I0wtwyGzxZ@~_CR`2t%mv?aA`}U z+s=5D*$+#7u-gcSL$E61N-f;1NCG|$IX;h3zzBa5yT=A`S$Rl4Zx7h6;oiQq3%d=l zjG6;hTp~@!jJxp{bq~&o8*Uha*1c{AyYVdGt;kvUb2pHnHt{!LM@G{7b`9iJ zWAnuLif{+asd}}$Z`uWO+_I+;HNPFq8{Y1a=`F`sKD)$BYeC>DcdvCvKP>m;rSV(s z#$RJMK8_in(xsN)niT!kxHv=N{Q;gx;JQP4HamjqnpT|)?F7bYr_F|!Ql*Vp-jTdg z(T#!Ttau4@=76&GE}? zck`98!2?5kZU05e2e|8KJJ+AddlnBAh1FF9e3H0ifeBX6jSZdx`i8Rro-w3BT9G)K z33v34W?X*o;*!U@xiO6hwD`zTpENV@c`fqHt|6DKUmKY?-Dn;j+Lu>FczwF=bqJg0 zyk{nT@TBo(hwe(7|8>3r|C{9hg3h$MS8!{36TBWp2YVq~!th@b?uGY-zH}JwEpUs5 zl*pjc%-w@CGv5fGH6oo}JGYF;#WqE9a^Bw_fme1R>V91v|Ala?@A8TJ<>T7oGH+u- zPBc9L2R-pPY(HvPt)szSja^m_K|Rk#%_Sl{ok(Sg*QeSw<{>UseQKw-B6H#q-zcy% zt3IKbIjj2MV?sW6?`>@Al=@@k53ls_kU&~%nBDWAmLCf1xc-1TK{G7_0woyddUHR+ zxAJ#be$^G52?kbir&&e`Fed5$DlGsC?!)aT90m~*KnxCkTRHrn(kL^!iJ87Dm8N7h zpSD3BVah9Rii&dC7xDbF1!NJMSF-Kj3Q+z}Y9Z_s`2Hdd@hGUF@1JEVq;Uj@HUaa) z)?N~FX~*s+0ngj79r`N8|G9<2E<{rNpR)=7{BK^s7v5w6><0g*a?9*?(M@YLL%bp+ ze{?R4LMdzYJ)8D9Dq*8MrjY!Vb5pD|i`4epXko&pw_LyAo7yc&zz6=j2q0b0<`+LY zSJ89SlzFCCO*x_W=+3!N{3gxEK`lMTLec(=Fk|_2AAuG_R(+#v7uR|EHJi#SSEhx zetVyD{>MBdho-sfu9e@*qyOLgoc%icykGI5gWG?QOc%EVTZ4^}j*@kYN^V?KQnRQ; z1Mmt!XlJbux5RdehInerNIE&RMl{D#shy%FmQD<1;wcdu>J!1CzEpfv)W-(nspOD| zMx!MyF`)53-Y0r?iVi><66xNph#>sxt!g+HxC0S(RP`nYD;IUdw&>FBI)YmclE4bkREsH5%n z&Pc}^5e{|*L&45SLu=<67PY>urKPQPZA=ji-GO?Z*bXp@oNAxEKB$3g?zyMRRi7)&x z&!A{dq=!L2m97+-q!>*lGI5RvX@*37a&Ry?L_vt>U@Wsy3Y-x=$y6#inilEgU|b9& zN8_or1M%(g0ntA))Jtl|1`?T_f?3!sT2<2B8EtKZ#o29YkJ_yGB5ID0F z2?=ZIxWYe>*oLHq&Dn22hTcCO?C7klDrrx_vq?(we9i+gHke4HMPG6#4l)pB%T^|* z%|i*nIYodXHkQH_&N3I3qp16Q{2Zu8N!LaGX zCplbl2p=SKAJTUqwo?*I#bf<2$Qq)=ZiCqHk3JF8WDzdfFVb66BSYI@@}4+cgTt6n zMq`LvQ!Uc*-sDgpY)cfOuP~F0l?U%3qLUcf2F*u@L~ILkeAOaSiF~HHvx_ZXLI9}G zxya@ylopf%q=O1yTVlkFjfQK|_KX>}kI6B^XM2pSFK0;S*R`|e^Q2)ozxJ7^S#a3* ztDBeqVWp6z^xRtpD5OJ;&tNwLg3L;CGTq z`l5J8j~qlu^|kNl&u@R~ukNKUiibb5C-=}V@uR<|=!fI+i~f4V(2oltonO~zl;HwD z^UFnFj}#ZR9Up7_yJ_PAidQ@lG{%}Lge!=zYl_44RV0ijC|+>|z8WWl>o$%@UxCJH z;|Y$pjJ_%i6>o9S11g5`0LLo|dd@dKZ%BTYEWe(dS5*g#ysK9Ic$($J*MwJ0dCFPN zW$jOd{Q<8>u$=g+@CQ~+mb08?`%5drjZ;geSAF4Udw2xc zJu*yqbY!GkhhHBF->t*1k2FTqJ7}KYqry1o3nZSKB{52`nKqP0MmT==PYn0xS%%1g z?k>Z1`|Rv_$aCPfF2ntW+1U$_=fK@}8Llgj(R<`;2IyQlNns-2hnTZ7KjZKc{xc5$ zO~V*-UHPvZ{=k?qMsz6rH#Z&{)ATDovvJHlWf+%%e#PHBIp$h=b?*r1UyCsAW!+t{ zNko8`QP$npXWFN`D}wL@cYoN|N#QFzt}&O_Fp3cV8%K|B{GQ}hdUdq>;mUSN|LSOI ztxxibT;1~G#=lwmXa7E-=)24Oli*dlnRI#A|9^-+u{GTOalA*oJ9d_qt*d&A!ZRE{ z;8jY&=^^`AkHZJZsOoWqv4a06{YO(L`K`w&?A25U`DA70t198DW(e(2ZvNOR7Osf6 zG1e1DYh-vQDz|}nFRIk4l9ohYAKE27BbiKch-!A^5sI2gWC$EfWmQs=78)jLK`j&c ziF(Ye9n)fTYod26+9YU23=a<^WW`O5h=F8`YIbVbrBT`a)cA8}WoNIl@a`x~>;;6+ zC+5Uu(XoFzs#81SlKEXP{lxke7EN2pDDjg8a3_Jb>399RubcEP63(Wd14p6k{C@e; zij|x0%AC#Yc;mBGD^_l{^ZVsb-#T&ROaF7`I|t+2PrP;Fn4RC5gP%M3(SKb(bMV{A zAD%ez_GUZ3Gk-n!){!GKGY1czyy?V=lgI4*X11RI&4Zws#2e8xZMbh{^!MIgbJr+j zIr*8Y6>mcpGtJm$=Z>LpAqDW*`O)|J&32qgb5iF}_19(NXX4xv37pB#572_kjj;vq z1Q_YE@zXfBVd5P8+z)S1x3u}=YBZ6f9Y#Y`xVZ?&)u>7iFe#>T&cRU__;g! zUUa*gTpZ74Ptw8d3-2v+n>3xW_-ZF?vN-q=E&aH%_-Q!(b!G7*n0~VL({TD5%(ADk z5YiT*WX4mT&Ck|4=k>h$gXhbRQ@qOT^z#;%T~o1?iFRl6^A?}_MMW9oDzo`{ zix*TVTn;}^w5&qWEYIe*aPrlktbUDU$Is5`OzMh6KxfS7@`~u}yghIPyylj4f@^zt5z{Byf)33bT z7qVzNWm#FiB4o+pr-Of>o$VGxhBR9hrhTY!tHte%faOv?sbL7oc`&GtaKNb`F10Jp03zoIQ-L9>2iBg zR|K!v@V={}$Z+_ltI`-Reso=MUC{%sW$r9~rDD9a%ohYr*Wz)b-0q*QQt0r;S9Y&} zEYQKBpG|Lib!Dd?0oCKmPCt#n-#qs8YBX?JX|(E5!*IH z`Q)*uM&(OCuUpksLf0Q-!9;U#%1X@-r%)pX5(tTmMmHPn4G3L7cPsYEnar| znYlfye&1z0aMhFnEX;=Aa=U)xz>Qfrhrf*7{OVPYzWU;8zRN!J(3ML*?C{SW;jwQl zEn8RSyKHgO7pMNz;h#mj#=cQjR#w{OnQZb-O*#D29ZjC1fC508b)%GP-&y-iJ1 zQ&SHA+_mAJP+94V$AN3~?(_cE{8LDK=i#@>sF1jFyFDc+WE9C4=(m@e!1SDzpa;sY zmoKnqE>6*eJy*+Ews;B$d#=`93Pp2oxxx{@EL_8Cg@Zl!sxF0=rEbM)DGT<-2H% z=aLxC)2mgNLgO^baDkudQfP6lzu>336oCDQ<;VPHtX5qL;9fKRpI@LK5uq+c9vs_@ zx)gb6n)b|tTRmn<-IK#_4%}V~w>4V_3m3@2tsW09Ju6C2pE5))zwwwiAj*n8Mtcr! z@Az$mb9oGZ4$ZyeQQ%5n^%z|_xYdmFmYy>FIW$*~M-b0jY~ zq0ObI4I__!mR)lB&4IIQX5{iSBZh)(Zaub_ms%x2VAVkQ{ndHvFC%!{I@Og z7P&on>!PI1rAOmi}VFsXX?aIIt_S%A23xM0mVjO!m1wdF%;XP(1X_ zcRYFYGj%s|^_v5CY4*&uwOPL8$zyZjCJR5dx<4n7)&BHlKeqBS8-=l;97+~oPF#V3 zH5y05q@`^{i^j5OP%MqXHJVG}_rzdgAeI`~DQL(Iqgrb2&>DQR&-d|MS%0iIzDC4% z^u~uXJP%5A`jZ2gf~1kR^Z+IiG2BLjX*3IoF|zuBcxTqJJQ^C9Q`Z)A3A6u&-~87)oXmy|5$?1&Zy780a*&1;e1IUOL)Z zwgu!Jye0q=RGao9u2`ni1i$B@J$?$22)RK`9?2F7=BH9qi6n251!tr=?!l`ss~M9)bvKr9M*%SH730? z$MhiSPqciaXDBWYj{Zc`lRS7(v_{k010j^yrhGP-DPO=apJke!1uH7m^av*VChk%# zAHgu{f#VE0-^|$V3vFpUN^(+@>P^R8`!iVY_^v$i(bQGWDnOVfJt8zhIoER zFgK+y$tPhyST_9nm;cCk^|e=@MR}!Rd&_)@SId@`U5)bU{dWoa{DBRx)dfo3WlLY% z?+t6%3uPiu>@F)KdcS(}k$o$x!kBFFg^Cf^hxGl`o7=aa_|fy>%&T7xo&t~O;eY4u z{Nc>!-U>*8DGx)wb9df!X7I$c1p~cvhqj+N@gofb3iQq$dU)o;RRI}pOy*yb?!w7w zW5G1QQW)RyRJSW!hqnBr3U9u|Agdp(flx#z>ggVN)0^(4A|0fU|~`hmWO{aG;3J6r)6 z;+hZ9V_3ihF+CrJ3m8kh5=`lPxO}plczB^dJtW^@Fz+~poI4#O|;KJomv%X;YRCt}M$a|wMYX~N$>i_xuB4NUmzQoXsn-8Y+rEq54d@yqngIak4 z8NK;nRuj*B)9nKjfEV39P^$7D-9B)@?2*)aUV4T4Tb*$(7P zR4?_2xPi_KLQ9IVSQ0&^SkC~uQfl!ZdSBe+w@{*s`wF_<@9&6LHe>Mtbu;h>TxeBl z??@_z1(X8aj)vw&tcl3b(#ACPn0BUVt-=~!u^<-@IaY5{8y`&3RYQ*`wk=LbNHa1x zY)V>EtP$X5V$wMp(F);Id@#0+n)rzfn7779b7Sbv0IlAjkmzh~jSX#q5a|D<x>8M%0;Z)sgkQ{t4gr67W4s< z-7v+2nCt$J?wc~Fc&f_QpH)3uyKy*XthYCr;{Fa6c-A*Zg00={ZSAy5xswvc>IIt} zUfmroh|cZAT5Fi$5kV~X-TBElB*7|8dXs55L@RU6s+cznAC$a`5EIWb&24BS((?l{efrdvRv;U=p!jIdS9&VgWL{<)1MiReg3sToT_ z794+V!xn@kd6v_Zq4j`H4kX;{3iRkcxp>YcmZZ4a`*Z78~?(L_E zU7}OgPLS~Pdmr;L1at^;e%Hj!r8H1NbjqqJOkm>gO9ev^%S({(#NJXFOG7qHj6nR~ ztX|c_AZTo&A3P+FgoGpjkZ`mA+w?KE>8>#SCA}0R)T1D!%df8HFrkp2{t}&RNVwU@ zVM3uEFNGmG60&L2T?%5QPJkgqN2gBU9*RZsXb62vI@u8AEyg|5vNr)b(tm6a zrfDlfG@Wvcy*TL9m1E?E{Ns}K`V%fm)Xy(2wOoaew&#PF&o&}>y(Bt?`UoXqELqN= zm5s(S?>FPQ6RPZ!J^u~E{;~;7!1PY+P#df&>4?+B4ArZsP0^#E21g9Li$;0EhBxt` z`OnLxH7!)^XkX761r6{7s$v}j4e>tAxo}law5UIjLMw3)zZ?jA4l?Lua1+psgefG| ze8--$AqtBg3IDycI0YvXXad4EUm%+sagj=F*_z2ScR-uJ%=s#+^D%31fa+*#0?m3G z%R4`pe`YTKoZML6*|_=Xnsbf6veSJS`G6lR46~%PLv2%qo;q)M(;mZE?hS_m z47E{MCMGAw0Cm!3=x&DE==#KiMHJRax6Xpv=myK(Ma0cXH(2K`BFO-?(KXcLq-%rP z=xV5wt_^CVySrlHJ05Yq&Pg{=fw^xn9t6}z7f_eCeLUc#yQ^a1tAK8D%8RhZ*Cx-q zbLbjhJ3H>mp=$(-#<73O!R^}DPXSuzq^q@X(zQWt@@lA)t_^CpLvR%%oOA;*F-BlO zt#u+71GfnRQVQ9iyP`Z&L{QT|XDwYbDd^O_BB_o83 zVGSYaKCXpF%6lh0fD&C3`b;3W#ItZ((tYgRlh2$xyJ7K?R}A%#p8@*Sb2CRS%zVoR z-TS9+zVxkMo;-J9=BFA;bOHVAU!FX>V&*Sw(A8hM^UzbWCr%%FCDu7Z;y?B>B7t_zC~U#1Ir8OGskw^Q8M!kpkxNl7p4{$mzAy} zGca8nbQRVdNvM_bD2b++8_7EcEI$NooW?7lrWZJJKz^uIK73|YJ@6ybht3_~9a^;2S`Le1925JWdr^&Bd$G*z-P|nU9p1L_0MzmS zV%%-G(8?_E1Po`x&Hm+`6IXyBzyV_}+)|x3v$HSSxl!YNE?lD(?|CQvfYJE+k2N+2 zx75Pr@_X}JwVQT4^#&s6;2Pij%a@NFTptH6hi2o6tA=-cNQ z_v8D|ow#_8aBQ=>@BQ-R%#ky*r~c!@$eS;Ha^?bX#Ej`!2!pgD7naEFf$k7|C4uM*>RZyy^aS%5qG z%qz)5KT`aFdltAIqpz%5c6%;z+;Z zrn3)Mn~86|+z5Mm_7;75*aDevHQ)!_cmW*StN=}ktK0neG1tQPmR@d>G>9L4RR@LJ z`+zZF#}PlqjR6-LnSa$pxTwNw@_TZB zjjtj6Pae-Qi7T$~n*2Wh5Voo98uNHO!dr3R^OJiSC-wXMW7wt^Fmd}P4-id>o7`Ux zniGiU#s2Tfsir=XMcQl;Yrm>Bnjirij1&g2JNaFN@4i{FZ8^2>v>@$&>r-QFm-)MQ*! zzcJ8U<;0o%fD2*YT+?J8eq*~lyTtes?9etJlb;E(UQB)#$b2*TnGoy6)XxH$Z<^m8 zT~OKnzNhj-fijD2o%cui3p+;k&)n^oyyO`8U(;UtZSyPCD(#|qNM5c=2lrq;&~{=G z&1xsCSyX*c51&$CwougpL`0%it-GdojE`a5j3y#!%uEi_p}k8>b3rmg2TbvZS`726 zDNJ6DU?sLZ$_NczIhBQzep-2O5Ah^BNevBV#Q}4Yx#uC|8Cs*mvEqYr)bNtl-%^Vk zt?XGG=VL!;BwwQCj)`VF-aOy=h}vK@YChNVpXOhu zWU>0Zr0D#e4_~zUPXC&mHG5hX|k5Q~2@YyU(0^ z`q&-{@O>;i^eVjWExh!{PhUK@``E=5D{Ff{^ibpHyp7HtgT%jj;jI%d-+k!5jhQgv zZM}w{9X)z+;qHqUPQ3Ne(}(W6@3Ud*9oTvfKl}L#(4W2k#EEl10{)lYtlq=XBX5&@ z_v2`iqri`Nvw9FmkDR>X+;hhv-^SPe@gdN6_99%Q7d;o`AL#GsNo3=pzoR$dGQCm0 zTqgbB>`|C_A@N1h{?)oyu~35dxGFSW_8xT4Lg53hB8k6D+P_-&Eh zW)DN*ck2zA;Lmv7%ji_`%T505#b!?<8-JNB|EqOxW3`H}>0c(xf3wG-@O$*8&m!sM zW^c^2kEDZ>lO%ujX=LLy|H61?kcU1S(53mCy$}#uIBkTDvqi=j-X|1)-4iJWtVjSq zVG!OGQTprN2;;B*@@#nGfBnsIg#CunU-w8Df6bHO@WfA^r}$k;f88q~{KDt!!v3=p z6Tlk>6o1__;rK-&>>p#i$zS(QB;FVHO1$x);;(xs62JTg!rue_T7R(Ovoy4Qy#&Bx zw?Fk%H2xk!;`!kAm-f^Ab+6?ka?Lg<2QUt6*ZulSjykidglUCZk^iGf6{`8%V z&#}KOw#?rPD*Y*L)}vSYk_YZFBUmr0e&YPM*#etyry28K-u`1Qg@1m>zp!lx<1N&) zq7{Dj<$cr-QY&mT@f{hxD4KgF=-4>+JJLC=w7|EWmQrJlVkZ`&I+rLGqIB;_qIcWC zPOLEeI8Geq#S`Xg>@5Syp4b4kdjer+kM)JrK@Zv_(mAyI$7V%qx*|sXNv^UaHLDWG~b}?~{aq z^&H<$Gm`ZoVxK*RNM~qGCUg(Su^>Is11riUzc?Y7zx8@l6}zDEx{&15RVBeWoozdk zX>Bo5y$4HS=*(R54qkqV1j5{qJ`I--;Y$z4dlP`mUawqsYu|Rvi$H2ia7w0-NB%Z+ zxAL*jI5oN>Qs34Q#tWVQoA<0hbfQ@{)*`oeJja?))k}WaxPPv>C>*O<_?cra%5jWi zb{?FQW?^=YV;OU3S^%>QrWXPmYB!SuF*|#aSmnc^bt`e!?u}D3dt~gRnx@+MgwK9Ti-hR^jE&eIJG0{ zWy0Ne`NcD5O3ogA`su%89n{XKkAmjG`*s6&;opHfC-sv%q|jqIIeOpri)XfUqwdtO`xguT{uXW26s zXYQ_{irRI`Wdtb90;%6Lz2jk=$AJq^Ge+Tx?p^-w7yyc&6SvogxlWBMJ7Cq?`ihrP6nL(BSq)A^NH|3Uo7B! zui;*)ou9_7Tv=tqNq%CLo72rOqPvZtuFWRd(V9ATXL;nR^0uaqzbQ z-YFkxeyb=G5=`U1&Sg3CYtuORBG({xgvpPJboNNmJuheXEhIpA%=2 zBtH{l^n?F-_+{ZVN!Cw%;lr^XJc)RD_=zt*_UJVSOq`S7)PC#-?>$1i&6?0k!g-1}keDM3)lQm}gYxLyY-uX7xP zj~yfE#AC+@b>%JE7$`|XG~5ED??O_0Q?g{p6OMMEKzq4Il{UMp%_v%VYxfClKJSUs zno`;}%4b?ZPrA73k|Ob#jfzE^b1pR&ht1yklDp;KCa)Ay?U@mNQiyy@_{@FqNOu}9 zArHfd4EEDQkAe8w_|WzQF4Cg$9Bjpv9P8bN3xVX_ zM1Aq$I9)UZf*cFt`>+R|&N9R51`g;GTjL`s402(2Ej)e%S%&-&8*7!L$^kbThoi(C zB@C=*Pg>ZAc4QNpHVM)43OYxDzSYTRwI#QVV9PHZd_d~U%qlb%V_3Xg0*fzFNNEwr z>15=YbPX4U?t!FR3j(&+m}G0gOp6+)-`EWdD#@{L5Io_b=pwImq%4~wm|@SvlQeg zzBAey?ZU9!-6c>IUJ4#;Wf{Wclg6!W^6)x!njD=mh)d<*T{>ZKg%>=^JVuYs^P}7$ zO*k^dXWSvH)6s*-q)E|b$7*zKZ(+DGG7u@f{H_BCsMbV59gOshY(n)O^kV>rW!s!9}6_*97*ASq{y7~)< zQOXb|pjnq`$|0)g4mUbWg$k_nFm6oKdk(vj!-5u5tr7IrK|2uFh)@#O%;4TWhEqAD z0E{LgFda_LAX4O@xRVbzyDj>YOMVu~N>4PQtW2hME|Lj^G>QqN6oDvVsIsFvLZ8QA z9{vcgXs2Bks2TeB2D%gqBTP!f20#JQVrBy=Mh9`yNIoCZN%Xk9#eH>pQ>QjTq&2Ml zfRYu|L&(@vnIP?O%i_QYNdRBw!E;rVbEPULLWtyGvM%$>q3p@ zlb^^Oj@5TK;8KSX2sBJp6_qex*|U}lW!206kXnCd zkz9)%s%xp@r6|tRBFLTPOa+7xqe-fq$y|~h-XSlkspU|cVb!@177IuXyCXx$^H0f2 zbXO(iAxU1gCgGnlmjEyCe8dSL`l?6OIFxrO;ye(*A+>A`I004)QK=dOd~C{Ers%Kg!*M{k3zG_> zN@Q=i2W6nqZLt)JD!47rIB_$X6gQ^@WvwBuQzgS%IyZG_WO%JQlqGdtwnkfUn2#;x z^39^LcsjS?MBHo=WE9(6C;XD9C)Ze~?LZnX(a75JI2F#w11NL(d>%TZhty!#8cmK2 z;Lg@KyA`%=lLtyycQ7W!;H79Ls<|~>O4+A!B+ak!AwITQG@3kPP1-x!+B@x}C?}&8 zFp%6r`B!X7qU?8Ep(*P@5yXVt$D>`J5V9gFDd`9{i1pXsP;>o;^~g01i5(Dt)KGm6 zD+BQ%Jv0N@zmtkDdHxioEuVoU8{L~xg~d|6TZJDbFqcR}ocw4rW-$uNT!350*pVq? zJG*XVMl|85K=awMF?&`jjt(51Ys{v~p{?s$)-^&Wa>4D$DiB*uVRG>VC=NJ6@q+dx z2@vbsPKOCoQf*Hr`e1@SU}I?T>+%OnhULl1WTHV-*SN11g|X?{q9=jVmxtr9p}NkN zItAs~%1bM2F`I&DhDKUAT}@cDv8fsVyGR=35YZXz>};#YQBbmmmk!8f3(9}xF_aCq zqIw*lDiR{da)Bn{vyAV!s*Sn}imfaOxPT{fSw{j%XFxwY(+hRG=_n+~W%hB9F}Xd* zN$E$%M$({?gzC8o-=YgNI?*{z$08^C(dI`Y@Nvf1Q#nc*3yH%GZ6*AM>u;1EsvC5{ zaJZ|D3iQs+oVKcZE=m=2ji9xV!fSJ+D-zyF!Kq<| z)(F+0@E~SliqO{5i7TI5Et7mqTH0oka9b5hdYC?3%fkyuEovu2QM5I5k+N2`ZEp{D zqMhB*-Fho^z~tq+D9i>$97XE2uoxVcG=O_z@jbP6sa=?g_u~&Q$EUUkwW-J^Y6BfSaTNg0eiIf|$+}=M1V27iX7qno*}DNW%5u z&@hd*u`Lz-D7xq#;N%ecYkgEqn^{(R4Xlb<2lhfB>MEz=JtGNJCT87C9bKDf*%^Uo z4qc0;Wg^W(6N9qXM`Ee6i)=z=9c5!;WR)tEEKConEh`#0Q3H-pm*3JJ+;^b1nPsr` z+F;b?(n^zCmM*g0359Pl5*A^_E4M9__(Fd*pYN-0XTL4-iDBm#Q{W-2_umX?MCMTNOE?9~F+W zDmBdHP0Z@XY_h4&yE4CW*<=&AF~Xg0kwF_0_E)FLSR+T4d8q8A%r3JEDkrV8l?`>d zy5aho4XRvJo%@bROWVgIRpIXT=4d^NjjCYyHayyrP$)5s?JqDT z8$;EGe&k?T9Rg41`yr($x@_oM7Nxy5ls;X+si-KP=Fc|;uid&2dCy%UZ(&9Q)64&AILR@)DBN3{TL$wTD zaE?=h&`3eyq7w+$ze}e_VZo&eC6Byx+;Wq3s)5IqjIKjvf!#^%RK%sC5JNU*6T=dj z2Cn4zoM|`=yGb{ZCj!a-AJs=JBacFj468)E`TBJ-4P~ENR+*+5%^TDcnZX#wOVOM* zJCuXeid21gHIgJ7j^xyx5iXItTh#}*ThxUYTrZLxl=pLA80Usk$w_5YO!#OmqrKUO zqCt*k*_)e0LQBe}gBp1mv|n~BTcJWY)I-gNfmu2+kwzg=8{h(lyjhtvrd9#9@;ESs zq!!RXY_O*<){pU3*2b(RkONJ_-e50y(L5Q55gAp=sZ`){OP67?3{J&|QRs4kIb;sk zq0FPg)#8jaci(sRX?IO+DeV1 zV0Uv@70vR{dv$enO(oeMUQ5k7^wU(OMHPU3(3{7Z(a2RDnDBHQjSy6#Y-Q4(rXSfxI((xW{wQ5(j{;_bm`mn!FwK3$ND z+oe>&NJ)rNXM_g}(2gO&TauY%2BXa=vS@@#`I1d8nMEiU%AJsWP%W4HvN1;$wxAl9 zVCK48EiR2NQ){u)EJ$E9-6%oN00)&~PJx;rYR-ha4sxw42H%G;SimLA&TEk-R5Le6 zyMkSy$NC{%(A%cYHI2ncmy+vMdBra}z{o9pDsR=IMJ-)TqNe)#nj5ZPSH12A8p>j? z(~>&IVmTY~I4T=S<#THLZHvc;NmDg+ib75gib`^1(`bELt6ApAd$euNq)v}kty!Fz zyq)g3LHiHpK+2#et47T`xxTcm&P9S#;XD98Lq}8AfjFK81Lz5y>$;Y^%-m|Glp^Pl zDQq1}EX-qnEvmI#Er4f0)KO~vrG8>?ZL(f^`->g+A%E}{i6s* zUAYO{(AFGni?%kj34gF77>d>l+^6mHRSKTsK<|m-t`;>ntgjUQYEdn2s#z!2-@FcA zevYf@b_AQ-+HUO>{@c3I%&w2Lq5~EQR|@3a4u$FLCgvDcYwrS~Xe)~UXb7WuZ4C`@ z@8(E-S35-M;%^L&bOC@~5MxQ=nrhJyY>761LbSAnBOR>*ZKRH7^ps?fu8!!fk+yCb zy}K15OkCuS_F!u#W{E^cq_Mj>*ddTe?Gf|q_6T>=TaalS5X8n!ghMUB?4IA*MQik_8MS@|NQ<_VCbbW$^=x%KVf1@`uhPt_bE2Zs%r~-+ig_(+WDR z^jwkbjO=mdGL$`zwi7KQyp)7{*m&5r!JspT<_~=fF+#%elco5Fs7O~;h4CR5!Y`B!d9g45AQVNyHAKdT zFz$)LTpH_Xb>%WfC`Ca>BwPG;Ba;1?yUet1g8*}hU>RJ=t|QJTd%=hw0>_*2U&;aI z1XyPWkli_7YdcYhKeUISWMc+Y0&$|~p!D~o4$8$Vxrc*1MP5Qd7!3g^&N~FK5pntK z08*OQoZF+Uv4?;V3vlAGu{hMy7P>|Hz{d(X0XYmYbN_vI3_>s?EeZ*mqac?>It2aw zB*oJJ1TT9mn{Xjf9JFcQ_``NmM3R6eZPI^ZHh^~PQz~x zK{Rwez^j{cqay^-$kEoJ3(?5&#vEPNBb3AH4vP^NN1EpV@@kvI)={M8jZ&8_heH=) zyV)LsEVsiBfbU(t@dNo@P9Z`7htdRa_#OcqxrYF}RYj*L0dfkWI{`Fp4S^Sa;Wr~N zF}*d5_M+$qqD_wLkedqk-zVCX1muYnVuD_^s`U33I{=z3{=*N<-Qfsi#+-cMkdMS_ zv~wrG-PwTKvjIfd)PSNmJd^-IdkE6eQPdG&wLJuxrOOV06-shyuuHCJD($35oO|p5 z%0X;?{!zt4lRX4Q`GahL!-pw^KRbj2KwRj*!%jH`+57Xc&)sN-`aTJF{#q%^PBV zZMV)VsiTI<%jIkH(%3U^i2LRZ5tuhb_k1B-W%Guh0A?wZPg|FxPR|=+eqD~u%cWty m5IDYLK1uJGH^g`53t@a=-ViU%7s92hgHQj9>${))-v0%-*lOee literal 39941 zcmeHw4|G)5dFPWnHX~xeNFk})*ybT*TXI1L{0~D4Gt!JSW9uK1#(&l!Fp@@Sf;1z~ zj1V%|OfWX!Yz%m_+oauW?8Z)7Wt-$|PZy^IOMo3arzh>UJ!!Yc0RiFE*(3yrYeRyC z_V<1F-uLc%Gb2%Fvu$_#KyTjrzI(ra_s_fE_wKzfo;1?N-J@m)ppA)4Pd_r4HS(%%DCU0{8MfB-qy}rtqnUVSmDv*L z>sHng>e$|J2^9c{sALsz7&wLFqE6WNS85X;6hSu>IBiKUaVYyyN^V#(Mh5Y7w_ z4W-gZ1KA*1XHRM<&f+BohtjDn@eC6fil_Th>A_gCCtg<`?ToZGfhXHw6@(U)D0!k6 z8Di!LbkC+tnadnZfjPt-WQ7Le7IW}Qvp5+umCW>{bnNLqQ#nt{Y-*kNG6Y;5ghGIaf5prf<4uDm^sVj?N2 z7`Z@WkOj&mGG=co83!4NvZXB7J72KRuk>43l@qQMhqfo{4gnkr*;BUuI_FJ*i|bY)cfOuW1z-D-YgDqLWB& zhUOzlGqwrVt}7>%8Y9i2=FTp*JOiLUS2?YsP+3q3kPb5as&XS{tTsxb+F=-D+L3eJ zX$hl-;k?tbjpdB5ObsSw&W8dG9P}X zFHh2$^3m`6Yw4UXXUxE+y%_tU;VlFgUU%7x#|m*l{kLkD{Fq#Cy=Y)Rng+dVA4D zcMoT?sU&rB=+~%uW)oQg$I`C$%I%x_=!{97w75l+wmOQ8Intl#=|}gB4s~c~AR+oN z>Q4t!G3w-~x6Yv5zhQjADA9FsTsvB}ZjG)PFb)d(jiV3I5o0q@)4A%`T{BQ~(AIB$ zB|hV-wu#>>W0nN@7$xZjEzjlY=_%W8pZJB1I>ZBB*bJNYM zdOozf={ehO>xU1m-trGWJ^a(Nf4~0Fw$;NnpY?zI!)@PruYBt4Pd|3y(6()#we5EJ zkAHvLJ?~9TojrT`d%(PB>vQ<{p>13K;p`MTSzK+~qVYNY`nJ#f#!Xjlx_R~KKi^H% zbWN|I*PRk-K~tpuf&l3gPFAYi&M+**M`do(wCD;zQI3ae8d;&aVwi~q1mNZ{f_ zWW0Vl7qZ)&9AjL37$#0GJ~qZtKFfMeZa4h%Ck$h)xi9y$Ru7i-`s&e2O$=d{?GH3+ z^{wV5BXHw8dlv7WXV&a@)VG>1PXwxhZLft7tf}7TsBgExEtwa1bI}_M&FWn4WsT1* zrZ2FfF?_3kzgd-Y@Tscy)mH_>)!_r?qW%77wDPH1d~*9ucYfp8SLd1LzE2mho75H< zy?ksNxXZ_h(M#JfN)^)0=bE4UjT;#0=2L3;4N>RZ3d_eSxZa$@@ zZO{1%^C=CN2uwboFxTC@dTo#d7BzULv^adOl*26~KKjxU~emyg1@`yIoW zJMTG>=PO!0U?OuX4lu@1-xyQj+b{CG?B=sjV)FTz2Lv^D|AuDpoRA=2A7(};cRjEW z|CIWMR?qqJ`OG)qP|!hk;|KQi^mzvOa@^|}td9d@h98*VBxJV@c*f%pdCYKx5p1^& zYj)&g__;8yW2#i1M)U{c>mU28AHM!ZJ5#CH^IiUByKPvX{EOq?I<$--^LK|Q=z{gx zuzBl=3x}T?Vhmb|ILL0}oBK|D@9?<9NCew$d?a}S)L1|gQXCkeL^q5)_Q}()zp(=l zRg>u#{q+V)beK*qjIi4=LR?XGoPRBg=3}A{D{+iDE9utiN(=G96KsX| z8Su%o8!(mL$9I^!T$o>1eM4)~534_*#^9<48we&2Cq^gWxVE0O4k+DNqbHpbUEAZT zd`un{1^5@h$BH8$nupM!=FpQXPceZEVha>iVjz|t7&R&40H=O9$w5&&_5d&6 ziu`iav@g~ZUt-3$_QZ#>CPI)*r!O@ykQ$-DLuLTsWJDV%mO$ZEga{f2;<03OXjOSx zXFO~6#`|K!1KCw(S3_G%d-D>`FM$+q9sReeHnpaU~#449kaAX!5uGEN@ zbeh3fHdY^lfe(faPIFrz2#WHeqpd|;m6rvAL6Y?L^0H7bg0wQE13S_km4piN^d{1X>7YOm{E3+Z z2oZA{*cs-f&~y2^;Y1d!=;!t&h~o~!rWC~`Dl%@3m^lJ99H;Gx;Z+2LM;WB!kXle7 zKnl@i7`6k|1TlA;4#m5(!)Zi~9W+&xxH;aJbq1QG1qwy0YDN;-{uCsnYQb@-zP{R- z<4(*qhN^{nfbi0b#=kEdUP8#Tz=057fx{V!R;|?;^0T1@2tyyG%Nf_M-?rM#ag7pW;0WXrpLT0n8u=pLSW1rZn-1G4CT`=*0W$oS6|o9_Cl zZ$6=7KN{VsgDURxt}XB3DWV`_J{DcUjpIGf*>pEdTM->iUKdo_;hWaO8qW!ft_>|A zsI)^n($3FuhNo?L3F`9`v?OH9OB8%_<`MWSPP+5GTp?=;k1Ky&yPP$+??{Vwn}5IR!jKR*+DpJu6E(|mKLDv6>$U? zU9b1;91;@+&FbDV1o{M2lg#TqO;DoXfO1+lU7LbNcmA8Fa`|+LC=M500lez^faFg5 zT2aiWb$L|;(^(&^=;c>*JE+K|vwyInmM`mcJu+hHq-#Yh9qmFzDxLBQeRBovAfaRE zOmUnSN$Jex=7tKoI~aW7DQa%pDJ|P!JHIs$(47DZdEXb%(2e)K{n6aYt*;ER9j5p_ zLPe-5xaaq_26w%-m;1>l_#MK9+IcJY?f3Y1?YhKvc!J*_RMf8U?D3TX`son0<0*c3 zaG?Se_U{CRJ#2?5es6H0;-;0GeA~h8G14OX1iv#tS0;{}s1KyYm5Y|f0xIk<-+~sh zgQ@DnMy3b4l)M^$YzGC!i&ew$C_9|Q4TYdejSGEs)kCs>u%IPnUsztfNA?dJ_Xn?d zJwrxmNm<3B>PxbJ*!cON&+CDY%Fvv&@5#>zXh~UF1yKHUdN00& z-;Tq{!VIWJ-E}613QXY_!~KkHjuR5n3=a+o{~5RCWeNdq7ABLY5zR77#|LAZ$)8GO z!Mrs-lAl9)UNlpHQo^(Ek0m!j2sqmrvkxRu ztcFaFNmXSuK`NDOhMVfl2kVNtW9-55G_)+{XTd~pJvq-(Xb>m9W};6{oB}~mf&|DU zykaQ@CzI}|3Kg&{@pPRQUXXzX-F%!g*3*+pv-^peR}IafKx?$Ut)1rDbyCsUK?y7V zprR8+(fKh2dnO+0OduH>7=1hrNicniu0$y(Y08{c;AFo3c+ch~CS3HM%@&-aDwuDD z3OmSkt3Nejw#Tylm|K^j>mjSB5=}A2I{6+nS+?9Lo*Mv{dT1YZHcEx0Z49gQh*)<@oZc)J*ryJ z3QbjTg|WDIq;Op~dRs)pc-jy*ZVF)`Jf&6a+cGrqQPeDI%7y1AIm1T850gJd(CTW# zMw{ZvcskLeM>$yxJACxA(c_$zsGg4P1s{ojSOlta>A&p-AGQBV>1vZKDX1jvkOyV` zAF_rs2tZ9mr5zqR^)m_Q02J9_9DoxFiW@Jakc zwVeYhto7{-*B`l>HI>O1i=Dtpt@bXcS!u_09Rro*b}J zURlOIZ*!QSlCA{}hX7P`T~H~ngnGlx^^{i7-5_h~oZX)xXJ67)P{_tLOUO&U1Em4< zdO8cbHk4qBE_#Ru#l1KSc@^~f8w{;oC<+Sdq>D)0U**%CTl?V-f;#CU61PA>iK>vd zEb{zsDGD|ekvOZhaDT?~A`<7z<%H~X-o1Y$DOg%~tE+?e&CR0==y%Hjb6XrdYHlw1H!Aq|o$_yd>XfJ94Gb0lchK2c;R(`H(nbHpdhebv!kq-ytr8>noRdsP zhj&+b+c~|9{+CZnxQqTvl|EDP)#>zp_@t@i)ZrT;3Lh@|FG#RkejQ$njt<{++P}lx zIse#67yXw?{g@Bqt@gR)2fX51Z?)S#n~wUQ1bp!X=;-u&k$$ds--OBZtx}ynL-6@~ zOhMlX_xQrhR}6AY z`*|oJ=@Xo1zMb*3>+}iE#~IHG3y$FylcZC%$Cguvn<@p%kD;sr=#HH;Erv-g$rrWpPId@`maA%- zU(Is+Glu_QEzzOjw3_3#`q4w<6Xzx;C4Fm#+v-Q30-Z^VzM9{*`p^>=U)>IXpPJk% zB+}ms;>0x$_Y5=|LLJa$)BAX zpP1?;_*TFL{XczW_1EW3G5yn?OVnQp`iBm_^}UOupnt|w>B-UHRnQ0g?8T>ZliSXC zD!e(#7xXPX&v<<2b5c$nei9`3VER@)5iec{A<9>z!P!(-fa~q|q=K{j8*IM50Gmh1 zZ}-qIVIdufDd^kqKQLePm4$>Y#FyaW$j6S2 zO{lKSSXIEzGhw4q8+&)uc~JRUSTi3xHg?3^`@YY6>5}0q#P`TD3?69-TunYU8a+}& zSYwy5AfGa@)xdhs?=o)B$AT}g${zafk9q3Lk*eZYP+qiWk)B6gf1h5VM~|3$7X3mE zn5N%(d-92k=Z9{<*oj`zvz>tz!xzH-&c$;FFQ1zhe92b7l!K>ZUw-%RzOnu%lNTjc zSW;kru=em5fgSwG+YR2@Eiam(e=SI^yR@jd$Nf*N3XXmyORPrQ2mn;%nrfvr{+(0_%#M?0ztVuij( zJJwX`dDJywqtT;PfkjsBfo0So>+ z-@w9rtZ1@Fu7_0SPG5MBomcQB{KP+A@ot9~xW|PRd?)NI)|Jh-7*_Btgw^<3^y~}5 z3ckm#V`$0Ll;`6&-*6{t>6Z+fuf!Urxu<>+VVCXC5mxX$`s~VAhJJK<0@$4Ya~-Iq z`~5cGqt6Ck+xwdz_M2wAz*Y;a;Cr;=#$ET7{T!6dod5afQA_vxZN5i4dUt)dtklA; zsS;Spw<@@6?{C7#H_iG*6_u!^`*RxKs#UwPKRQj=kKasKXk_a<0d;w{6{{^yHebRT z!W9)LoNaw4ESP;^^DTyzc0OG;b>6oluxz89*XDb)(!0p(^X6ftzQB5Fyn&h*?7TK# z%3BDl_yQaB25vF!yc*w9V7KREC0}5@JH3G_Ew9G6J)i>4>= zVio+-6c26hD4OV$u&2$aEt7bY6wBd}TR{R0@8Rn4N$6N98adp~|WErpDi2wRZjE@18h3EpTJxMeGx}W0(Jaa{c4)0e8)- zM3ZpK_92w{{=BKF%Wq9?9@%pI_^};=A9)b_5Y7b6D});w`NU0%ANdda4jnvBvH&-d zI{5oPdq?sk?*X_IH(lI)5}R$M(D) z`n!*LWY2|)iu|1rsep?X!^4!6*)2IIGhhJItN_MMFGb(XETX^Cxj{nEE4*tnOzrhFb8$0~R z$0tvYoI7{o#F6oj9X$Ao%t!oyI|7>LE}l3s`R%t39vqkXNWbX%i2jVm&eav zUmfrYoRZVx=MNlP4qPK>=IIAm3I6!-iyw<0ZiR!23md1(Pb8+Z#990##*1GUzl8$j zG4|lXyF;`A>OWC;c~%ZB#K{4-z{U|jU(;^ie~P{Sm-qeX!jLgnJq1O3@P)(szwrF6 znB-En$M}eiW18Wx@4$!8RNuH4dnwNSlpOI&euS&^RQD2YfsJE+d%_0}RMNy5;Jh|X z!Y!P$d)|SH*A}npzu+}|Hcqt%p(34anls__cSyn@--C zoaos+FpAmB55@+Dc@B-WQe@LWsyjA-b^k!<>@jzlJO#5RmdOm$mIyI3GdkFv8lcq< zjdFVgGZ^o4OrMt2tois@q>xA^czap#!iGoxGtf56%i7hH>1JL7p-u0W)E#rGuU6(@ zst0Po4I*J+J;%M%jAVU?*sJF-Gg+GN4c&urES5=h!-`_D0X7Zhdo}S}<}PYH_+`S$ zldhCLX`5Cxz~$=3j40Yhmud%3?M4CNotN4mmp7x#48?mAfC~ptOzFoADr^4;l{vZRKs1u_16rsG+SRhzr^hxZs|d@aAT6(`J}&F5R{78#`xu$3`=UiyejM z#fj83i@4ZPc+Qzf4Su5Up!2&<&fqr#uDF{Aens6p@UwCG{EE7H(66YQ2YyA}Jn$>( z=0U%rZXWm*b@RZF>{8IpllCm==FMWy3F`sia)ZEc2Au86x!pYQ<9s{pQk=$X4?dtD zyLk?rtU%z$Zk~<9m4y>--uB;_oaW;qa28GB=50H!a7ba{gqt_=qjf+0>aj1s(HtB4 z(FKd<7`u5RXaC~(?;if*q2E53+LW|#!p*yQ7Gv+jho5@#-c;%_W;{Iw{n*U|ZW6fh z(SxbflNOF`HvjVR6UWCva~p6;fx9B@Isg4NpZwuCWZC}6(7DH?n}_lvn@RU@T;z~$ zp0uYEC*3^QlifVKpg={sdEm!xo&zV{Jn&;Tk8o;Dfbj$2=7Ar(d4y9d0}Scrfgihh zgj4GS4C&^9AG>*slXLtHOLyVsF;1=(kT|j@yLpV0D+X*F+w*$A0a+By9BwdlmG)$u zT0OvnF~+ey8ON#Vl;f*%Y0n}!Ze#EJIjKD5_?P&RHWKF-NDIf+`x6AcQX2Nrcv#~{ zNXF$#y)GPAxc^G|a;rXBqva!hbTIDy#;^-#^UKwTgIYe)&*oPj-tNTNG;@vNof^); z@5-u17tW?hs_~KIvxA>N;B4V+eilx;dAfcIXG%8@^;7AvP>{md{B_~xY5J+*x=}+o zxOu3bbdb$_YTd?yKN4=9#?M;4ar+&You-8;N=^sA1s#>u zeh1E`S^0cL(}a!F?P&lPB$O?S&99=;x65zi9Q-OOPCk`$;B0;b<|D^v2S0(p*}^fu zZ%kMSTv&b9OgQEj^&|P598Pq6U%+I2VVv@9Z5-3&PED<+Q9~$MKLt*%sd#=*f^UeJm1n{`T=*n6KB(8IGqGYt=(h&6wb78Hb1rM#`k>z z)9tBnH5Sh1r`F{xuxM&HxjN@|3up6FYjhS^G&P)DsZ)rbTCal%(|qXVr&jG0(ogAL zsQmJAg7$=kz(oOm7TUsDI#{cB3h*m{v-nx-dkXNgR{7XCn;*guyw;}>Kj3)9kBzhW zQTW1}E2y8f`lkRtOLd#3B})OE;3t~6JXU8zZH#2sAh2%S4EHh{Z<;8;A?U3&dI@xadkE5LEK;Vx-|A>>D7y z!ovh*{Da~Gh$7I!Bo3a?wiFr_vHr+j*My{krOE0Q;(9xzyxs9N3anZ}1Ocm-D2|{@ zh&AvryjZ4hG6}nh^-(Sv5F2u*qg7DQUM#++T|nf5D5bo;0*ZF!=#JAwU0M&%J1as@ z`YO~_W#WL5%tZ^tt~M8^b+5k4-wQ>PR|qNBZJ9Ns5Y;WS%Gw|VLGRvkQG%#`zQ!Vg*iePSWhon+NK0s zO%R$Es?j6^+F*w6<^G$i%I_b>UIqiSAq54qxYC&livSvb!v#|i()4YpIChJnnn^pd zQ0i_-x=DN%i=tfgIV@BzindbFHS!x^W_w#_g!VwGEqfI7)|YpZIJ~g~v5?<=LLuOzQz|K0VpC#EJSl8X zYFT?WsE=0RYcberl*CM(e{+*i;ZSPsaz_!OL%Rp7g`ZqM z3MfY!)weYV8{1mD>gH~^>SM0xYt1m4XevEAckW!C9)yY)Gx5wJ7}M+OX;a5L)f$} zv#4B{`-JU%RT>kChNz3A$_jB21(-+m=wkIpe;hrAnEhmv zT#D7XToovbbNdyVWhKJ%5W*Zu(L;gECD@6P1ve)thg=9OH(Ie-Kx)_>RYdIm%so%w zfe^JfL0*hv(4~<%xfzV40W-0sj@(E}y%-YT6vPHQfLohI72qUN@Pi>3>TKwU)Q5PH zG;zu}%*ldTA3CJ^VF^LH(T!?aRJWu>bP^3{5mfbLM&}zD?!X(uf!3x_CoAjDNv7oi z1Z3z>ff;k;Y(=^C^kbi9G`{Qz?dT)6!!~Q`nz8@25TaH-gm@pKrA)D=t{3}r4Jf?T zfJQdQ(pXrHYRj)#cz8yNTkpa|hh^R_d#RIdn>z|SopWHM9cnkGlr0Ws$p-5}6?V7T`b+xZ`NSE!#z@xiyvbG7o&h^1xd4t zD>6nEE|-DKh|vReXjNJ>=9-m`)2k9LcE#Imj-+9D4f6Ilgf%lCHNJpqax z!_d88TtfoHdbiM4>Qq!)Qi)!epcmK}2AZn>!Guk*uRNJ(5Fft7M^4ezTUFcaPGIl( zA$)(+l;1$5!RR8l^1{kW%y0lBpim2!s|AZRg`4r$Mbe;!n4N*n&b9{Zyhi(Ip}#{% zgApP1E$IJcjiF}HkIe}NXoCWXAo>M*^XxLd<2!vcOqFa!Prw~Knakc|OH>B)+ut^vdU=KZI@=DU8x?GZtSVpJ|G~mX3XbD8HO<*w46@u%K$(UVaF3~K!$x(xPFdCsJC~6QhQB@6Hcqcyo+iIKSZeeN7B*C^iB!lULtJtkY zY0(f3JTcZ#UCL6?r7V3Y(7CiT+!1YkfX4pfBeUqtu+Jm9)Z3_Oh;8XmJu&r}KJkb# zI_%tsAD#?NV-Xrtkxkh4a^t#Lm}#T!Axz&EWQBXkq_b{Gsg7yY#x}q`!TrEc14vZB_&s(9+aUPweP zS~}i6oWR4xdN$X>E}CfWhCnovw_#|R$goR{*2JIAwfioz3H5cS` zUsR$-d_Y3n3wwx<{9`V=_n2X6y_j#sD`q^cR<0`TKq;+C12bV(`Q>PmQMFysUb%151a1nkzh`E#;VA4ccha#V z7Pfh)@1@2rnhG9HN@u$ns(y9l9m`kBeo^))9if)C2SatiXnS*{0o_JjAoyUUA;ea) zgcr&R1$YdPu_P2q3}NvBOv%QOPs1APaR@wZn2D02>|&sATa;EhQ2BHLC$pk^n!Vi= zk=LqQE0ziUoX^Y_IhrT!s6WL9k@V%+820o;L`4o5<*^7nb9!~x!$9UL)7?L2&LM28^G`K5<`mq5DP0_ctRS_0Zmy1Vj z#&kO#61QVFP<-!}oM7qX&{Kv!^o<>pFi1h?q6!F~K^K)Codx$QR6OG2+jccsAqRN; zkWtT2(P4MeI2C!RD@3%w8e-TYQ_Mufg)GA%+#{-q*bPbefAloI{AXc_iSz2n93WFSUl zWKSwf!K8jm^2imev?4|5^Wxas3u9q0S4!gvgl7p;Qq8E3eS{bWY}{vy z=d2ooNPoUJ(M$O-VNsPfWa0wCpb)W>8sVO!)`^jl7(gM7s&x7wj30Pn+yd;S#YAp@x;HSxl7Civ; zU@ONrX{;@pHu2=9HWEYFRt~7h1hI??fN&XLpiaAG(9laY#pTPbE?ciJ>e(ShqaswM zuzP)CrJ_ACb5#&Qt%m}UF4@nae7YbPk4xzRBP1b8ogoeuU>rk&x1_SEECQYAvM53& z>yjpyXkyd~#X2 z>-crxH8stV&Mvd2rajOUBCo*2RXbiQMgCpLY{rCM3>O;Pnj>wI*2XroCeRV6k2IK7 zRrp_Pa+DZe0Oeh5F2D2MTC;|}j(*Sb73RJ7t-xIk=T&q&0?lo04|JL}>!KJgHiTN? zNQ8p5ChA~^#B@f9Il@EjT_6-`MK>0yM^vhA$B)gPywSYBv`0JagKI|I@mm9zRs>kATF+IVK=x*T?GsW!z{n|F7wWN z%oQtF;-^-muL*|&L6}pROWt%nLPA7aTY(@D@~*tgy!WoV%)3|UdAmXncX388LnOKH z9`mld?=kOLwoH((Mb1KnOzG=PxI!olB>A`UD^z}5p8r;8XoUZY8r?r%q1D!M=X$L% z&k)_LoO*%pqRxEWP3V$0jXCsljR&WaHw)z{>C)&h3z@036q#l`lt9G7D7|LJw1#nq zhA&JzUlf_8aB_{Fp=(=uwc6fA6qL3zWYQVwd1f-Jo<~`gb|Lo6YNtBmS>xG~mAvF? z_SE+iBj~_~ONS3pCoMaF<3n1{FH*bCiZ6jZS6%i@WY*M7(jGDcVz_vtZ)Okny3`?%k)TehXtuyit2eO>3jmPmQamS{G0%a z7yu1mIN|>5Jp1|C{XyO=;yO_=Y{0Cx2 z@;|GSBHfvfVn$VWwVr|iEjoaTmyMxk;f6qfrIeJYI&`8u+*tKIe60hxsp$Z2w>ls% zMLn@oDTqs6mav|Ju*-D-Nt)CFD9GzS`hjdq-09B}hnU^w2JjYVtC5Y+wA z!;F4+(WO$AxZke>pxN9HrWw(8R0J|(UORBeM>V5K=T3n2Zoors06)Z(29(87LkSSj zvyhHSH(;?2Akn*Y0IV>t@dK4Fk*d{6kvJQ50JR`WWt9P?2)hBl?FKmNFlDK6r*Hs> z3#D>!$?M2w2ej)nFyJdObpTbcMFe1lP{C+OI6?qbJd}cMtx^zxk#u4pl@DL2JVfMU z_~Ud|5=ZYxRIF;iPm+REZd6pPBtZqC=3t4hbI!O^SfWrCk}c#;;dmZUiiDnm0FL4$ z01MAU1xb{z^8iXPLj1W-lmMJsPqBE`6dkjs=$8u#v!?LRn!@396q2;0ayA;2 z%kD!8(r`Sn3#OP|m&sYVG|ra7cw)8`B@fS<;!kEvVf^l_DgIWbcq(1;)yMzre**>- BUG@L~ diff --git a/scripts/medley/medley.cmd b/scripts/medley/medley.cmd index 9fdbeef5..82881fdf 100644 --- a/scripts/medley/medley.cmd +++ b/scripts/medley/medley.cmd @@ -1,3 +1,3 @@ -@echo off -powershell medley.ps1 %* - +@echo off +powershell medley.ps1 %* + From adc27d968428dd274c25aa8a9fdb2e3049c8cde9 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 16 Oct 2023 14:45:29 -0700 Subject: [PATCH 24/37] MEDLEYDIR: Pack DSK as the default HOST on the value of (UNIX-GETENV "MEDLEYDIR") (#1282) Co-authored-by: Larry Masinter --- sources/MEDLEYDIR | 27 +++++++++++++++++---------- sources/MEDLEYDIR.LCOM | Bin 4904 -> 4956 bytes 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/sources/MEDLEYDIR b/sources/MEDLEYDIR index 33de3b4a..226dc83b 100644 --- a/sources/MEDLEYDIR +++ b/sources/MEDLEYDIR @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Jul-2023 16:13:10" {DSK}frank>il>medley>gmedley>sources>MEDLEYDIR.;2 9970 +(FILECREATED "19-Jul-2023 08:57:43" {WMEDLEY}MEDLEYDIR.;22 10362 - :CHANGES-TO (VARS MEDLEY-INIT-VARS) + :EDIT-BY rmk - :PREVIOUS-DATE "22-Apr-2023 11:53:53" {DSK}frank>il>medley>gmedley>sources>MEDLEYDIR.;1 -) + :CHANGES-TO (FNS MEDLEYDIR) + + :PREVIOUS-DATE "17-Jul-2023 16:13:10" {WMEDLEY}MEDLEYDIR.;21) (PRETTYCOMPRINT MEDLEYDIRCOMS) @@ -95,16 +96,22 @@ NIL]) (MEDLEYDIR - [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 18-Oct-2022 17:49 by lmm") + [LAMBDA (DIRNAME FILENAME OUTPUT NOERROR) (* ; "Edited 29-Jun-2023 22:48 by rmk") + (* ; "Edited 18-Oct-2022 17:49 by lmm") (* ; "Edited 5-Mar-2022 12:43 by larry") (* ; "Edited 2-Dec-2021 20:23 by kaplan") + + (* ;; "RMK: MEDLEYDIR defaults to DSK") + (COND ((NULL DIRNAME) (if (OR (NOT (BOUNDP 'MEDLEYDIR)) (NOT MEDLEYDIR)) - then (OR (SETQ MEDLEYDIR (DIRECTORYNAME (OR (UNIX-GETENV "MEDLEYDIR") - T))) - (DIRECTORYNAME T)) + then [SETQ MEDLEYDIR (DIRECTORYNAME (if (SETQ MEDLEYDIR (UNIX-GETENV "MEDLEYDIR")) + then (DIRECTORYNAME (PACKFILENAME 'BODY MEDLEYDIR + 'HOST + 'DSK)) + else (DIRECTORYNAME T] elseif (STRPOS "/" MEDLEYDIR) then (SETQ MEDLEYDIR (DIRECTORYNAME MEDLEYDIR)) else MEDLEYDIR)) @@ -199,6 +206,6 @@ (ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1469 7896 (MEDLEY-INIT-VARS 1479 . 4957) (MEDLEYDIR 4959 . 6914) (MEDLEYSUBSTDIR 6916 - . 7894))))) + (FILEMAP (NIL (1432 8288 (MEDLEY-INIT-VARS 1442 . 4920) (MEDLEYDIR 4922 . 7306) (MEDLEYSUBSTDIR 7308 + . 8286))))) STOP diff --git a/sources/MEDLEYDIR.LCOM b/sources/MEDLEYDIR.LCOM index 89fb6db2a8cadaa001351a1652de95b1a0446e2e..b857b1da26c6a3d1e3373b10eaa7cb6a611c80a9 100644 GIT binary patch delta 923 zcmZuw&2G~`5Kg5kA`wRs_gsdsJ1KSEWLc$=6ycCek&Tu`A2B_gS-v_(`1 zg+~BIf-^VHL`XaX&%ljG;00K_QsPA2!|crN_s!4F&iCy<+nB#7g=(pQX%NSxD>H&^Qux(E|&Hkmp1}li@1%4gx;F;N|JjFR931C z7Pp;9s`oG%zk$_g)x0JTrN~FAxbKC_{MRth;z^i)g5-NgJjOkp?J+1LEvscC=*fggYw z4C1ADBl3fuS8H=HT|>k78npd(-tI^!SRwO>VPS90hd_@P7R8%<#%1%i$HZb zdo|URwWw4z(Dj@nsmUYm9fB&=Ra>sEF-#3%6m|@l5tw&RFPM` zGt~XAXLm&BDb=&7Qku2otYv0v(#;G`(_x1P&=^{N7(vZ?6mM70`*shCHv4s_G&LEB z7vtjU#$d1UI?hFfVBKJ7pmw5as8&_iIxge ej2Ickr^7Q+grR}#Bz`~^^C3QZd;YxeyYL@^{N&02 delta 814 zcma)4O>5gg5VdItk#2!P+uN{*#6HMqS6{XWqC(o*N^MCbd`-heD726I~^4QB4n7mKkQ|&CJ`!en0wr^zqEmgws_j5RpiLRUJz@ zQ4rM7D4Sj;X*`B(1_=0TJAD4`|2IHJb-wn@=~648W<>4$L-h%| zAEg^;wKNfU-RhWbn}$NY)1p9XMV;6l}JIF(HC^Ip2zd zbwy(Leqt=L)qE5$j2_LuR=M@JYPP2w?pG>%Pd6_n6?VA7e0o{fHOdNio7p@_ZvCSo zvw4$n`TPB!H;g|G0xtlf$Y47GwIVM#cg-FJB5PoIu4P6*Bz5~H24T_PCM<*F7V7y- zbLkHpYjO#W6$!$Q*YDbH1Xw2JQbLrSt(b_=cbzk#O(W_K0E^9kVy(H;plT3Cf$xQ& z;GL3G!sf#RP@ApN@}^V@v~r-9Im%N0>!4OwWk7BQi`D1??!G0AlX*N^X7ek=v?72E r=82r2aF36%0;uElC}R92KwYoxxJ)_(EmlagNist`DBAih_k;Tln5fyT From f6c91ee11cff3f1130476b2dfd1b0ca662c1503f Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 16 Oct 2023 15:35:17 -0700 Subject: [PATCH 25/37] FONTPROFILE: specvars declaration for cleanliness (#1351) --- sources/FONTPROFILE | 144 ++++++++++++++++++--------------------- sources/FONTPROFILE.LCOM | Bin 13480 -> 13263 bytes 2 files changed, 68 insertions(+), 76 deletions(-) diff --git a/sources/FONTPROFILE b/sources/FONTPROFILE index 5c73f082..91fba126 100644 --- a/sources/FONTPROFILE +++ b/sources/FONTPROFILE @@ -1,19 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "13-Apr-2023 08:40:30" {DSK}larry>il>medley>sources>FONTPROFILE.;2 35652 +(FILECREATED "23-Jul-2023 20:42:48" {WMEDLEY}FONTPROFILE.;4 34903 - :EDIT-BY "lmm" + :EDIT-BY rmk - :CHANGES-TO (ALISTS (FONTDEFS HUGE) - (FONTDEFS BIG) - (FONTDEFS MEDIUM) - (FONTDEFS STANDARD) - (FONTDEFS BIGGER) - (FONTDEFS NS) - (FONTDEFS BIGGERNS)) - (VARS FONTPROFILECOMS) + :CHANGES-TO (FNS FONTSET) - :PREVIOUS-DATE " 6-Sep-2021 19:11:32" {DSK}larry>il>medley>sources>FONTPROFILE.;1) + :PREVIOUS-DATE "13-Apr-2023 08:40:30" {WMEDLEY}FONTPROFILE.;3) (PRETTYCOMPRINT FONTPROFILECOMS) @@ -459,7 +452,9 @@ (DEFINEQ (FONTSET - [LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jun-88 10:46 by jds") + [LAMBDA (NAME CHANGE-WINDOWS?) (* ; "Edited 23-Jul-2023 20:42 by rmk") + (* ; "Edited 23-Jun-88 10:46 by jds") + (DECLARE (SPECVARS NAME)) (COND [NAME (LET @@ -470,10 +465,10 @@ (* ;; "Looks up NAME on FONTSLST and sets apropriate parameters. entries are added to fontslst by FONTNAME.") (for X in FONTVARS when (AND (CL:SYMBOLP (CAR X)) - (NEQ (CAR X) - '*) - (NEQ (CAR X) - (CADR X))) do (SETTOPVAL (CAR X))) + (NEQ (CAR X) + '*) + (NEQ (CAR X) + (CADR X))) do (SETTOPVAL (CAR X))) [MAPC (CDR TEM) (FUNCTION (LAMBDA (X) (/SETTOPVAL (CAR X) @@ -481,60 +476,57 @@ [PROG (BASICCLASSES) (for X in FONTPROFILE do (PROG (SEEN (NAME (CAR X)) - (FONTS X)) - LP [COND - ((MEMB (CAR FONTS) - SEEN) - (ERROR "Circular font profile specification" X)) - (T (push SEEN (CAR FONTS] - [SETQ FONTS (CDR (COND - ((OR (NULL (CADR FONTS)) - (LISTP (CADR FONTS))) + (FONTS X)) + LP [COND + ((MEMB (CAR FONTS) + SEEN) + (ERROR "Circular font profile specification" X)) + (T (push SEEN (CAR FONTS] + [SETQ FONTS (CDR (COND + ((OR (NULL (CADR FONTS)) + (LISTP (CADR FONTS))) (*) (* ; - "This skips over the now-defunct NIL or list-of-escape sequence") - (CDR FONTS)) - (T FONTS] - (COND - ((OR (NLISTP FONTS) - (LITATOM (CAR FONTS)))(* ; - "Indirect thru another's font spec") - (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS)) - ((NIL DEFAULTFONT) + "This skips over the now-defunct NIL or list-of-escape sequence") + (CDR FONTS)) + (T FONTS] + (COND + ((OR (NLISTP FONTS) + (LITATOM (CAR FONTS))) (* ; "Indirect thru another's font spec") + (AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS)) + ((NIL DEFAULTFONT) (* ; - "Don't let DEFAULTFONT loop thru itself") - (AND (NOT (MEMB 'DEFAULTFONT SEEN - )) - 'DEFAULTFONT)) - (CAR FONTS)) - FONTPROFILE)) - (GO LP))) - (T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS - 'DISPLAY] + "Don't let DEFAULTFONT loop thru itself") + (AND (NOT (MEMB 'DEFAULTFONT SEEN)) + 'DEFAULTFONT)) + (CAR FONTS)) + FONTPROFILE)) + (GO LP))) + (T [push BASICCLASSES (SETQ FONTS (FONTCLASS NAME FONTS 'DISPLAY] (* ; - "Now we have a font class datastructure") - )) - (AND NAME (/SETTOPVAL NAME FONTS)) + "Now we have a font class datastructure") + )) + (AND NAME (/SETTOPVAL NAME FONTS)) - (* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.") + (* ;; "NIL for the class-name means just establish the font-correspondences but don't connect them up with a pretty class name.") - )) + )) (AND BASICCLASSES (FONTMAPARRAY BASICCLASSES 'DISPLAY] [for X in FONTVARS when (NEQ (CAR X) - '*) + '*) do (COND - ((LISTP (CAR X)) - (EVAL (CAR X))) - [(CADDR X) - (SET (CAR X) - (FONTCREATE (OR (GETTOPVAL (CAR X)) - (EVAL (CADR X)) - DEFAULTFONT) - NIL NIL NIL 'DISPLAY] - (T (OR (GETTOPVAL (CAR X)) - (AND (CADR X) - (SET (CAR X) - (EVAL (CADR X] + ((LISTP (CAR X)) + (EVAL (CAR X))) + [(CADDR X) + (SET (CAR X) + (FONTCREATE (OR (GETTOPVAL (CAR X)) + (EVAL (CADR X)) + DEFAULTFONT) + NIL NIL NIL 'DISPLAY] + (T (OR (GETTOPVAL (CAR X)) + (AND (CADR X) + (SET (CAR X) + (EVAL (CADR X] (CL:WHEN CHANGE-WINDOWS? (CL:WHEN (NEQ OLDDEFAULT (FONTCREATE DEFAULTFONT NIL NIL NIL 'DISPLAY)) (for X in (OPENWINDOWS) when (EQ OLDDEFAULT (DSPFONT NIL X)) @@ -543,25 +535,25 @@ (SETQ MaxValueLeftMargin (ITIMES 35 (STRINGWIDTH 'A DEFAULTFONT))) (MAPC CACHEDMENUS 'SET) [for W in (OPENWINDOWS) do [COND - [(OR (EQ (WINDOWPROP W 'RESHAPEFN) - 'DONT) - (WINDOWPROP W 'MAINWINDOW] - (T - (* ;; - "don't reshape if can't or if this window is attached to another.") + [(OR (EQ (WINDOWPROP W 'RESHAPEFN) + 'DONT) + (WINDOWPROP W 'MAINWINDOW] + (T + (* ;; + "don't reshape if can't or if this window is attached to another.") - (SHAPEW W (WINDOWREGION W] - (COND - ((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN) - (FUNCTION \TEDIT.PROCIDLEFN)) - (WINDOWPROP W 'REPAINTFN)) - (REDISPLAYW W]) + (SHAPEW W (WINDOWREGION W] + (COND + ((AND (NEQ (WINDOWPROP W 'WINDOWENTRYFN) + (FUNCTION \TEDIT.PROCIDLEFN)) + (WINDOWPROP W 'REPAINTFN)) + (REDISPLAYW W]) (* ;; "Set the new font profile name, and return the old one, so he can restore later.") (PROG1 FONTNAME (SETQ FONTNAME NAME] (T (* ; - "He passed in NIL, so return font profile name in effect.") + "He passed in NIL, so return font profile name in effect.") FONTNAME]) (FONTPROFILE @@ -700,6 +692,6 @@ (SETSEPR '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26) 1 FILERDTBL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (21780 33364 (FONTSET 21790 . 28131) (FONTPROFILE 28133 . 30482) (FONTPROFILE.ADDDEVICE -30484 . 33362)) (33600 35499 (FONTMAPARRAY 33610 . 35497))))) + (FILEMAP (NIL (21437 32615 (FONTSET 21447 . 27382) (FONTPROFILE 27384 . 29733) (FONTPROFILE.ADDDEVICE +29735 . 32613)) (32851 34750 (FONTMAPARRAY 32861 . 34748))))) STOP diff --git a/sources/FONTPROFILE.LCOM b/sources/FONTPROFILE.LCOM index 5281a5228656fcfba79843c01269e26ff7d77302..c9d4f666ef8ef587d7b93ef9126e6df7c158c5e4 100644 GIT binary patch delta 378 zcmZ3Hc|LtYc)gLau2*S}u91O}v4W9-m5Gs+iKUW)hEj5VZb4>FYKlUBo`RA>b-1sq zi;rt$txa)$X;E@&v7MX0Ur0cZzniCztDd!qrUI7|vPp)fR>l@q24+eMNkyq}qf#ph zii%aO6hL}|T|*Qy^AzfpeB9g>khSXR=_x6sB$fcJMl}=YIwNx{BMT)>E)9^i&Oxq@ zA+9b8C>BG#U_sc)3dSau2FB(JR<16dA-YbH3Priu3Rcb@j(+a0!MY*-3L0E)e!(!e zYARR-1i6NJ`iBPVx&W=6Y|khuk3Ue1H_v6#U}fZ*e2o1%ketU6#K^VzBgb}a0172( AfB*mh delta 604 zcmb7B%TB^T6b%b}G-0p1n@J2Mrlb!*98Hr#htdd?bPB{J!UUSMloVJHWB36VCj5kn zOBVisdzXHNiJ#!0hE#Vh&$(yLJ#)|N=+S@ZtrSf%rm>{Tss?fy7i6p{2t+i9!l@sy zAw&~EaBI@5yUTGDGCk9^^BHjxF+X>oeh6x5jQDo(IonwbB>c; z!=;dDpz1Wa7Pno}wVe)?Onw0#-hz@u*>u~s0?Ij76s)QLZ&%s8q{MV8vwq)uOJ_t- UitDGt?D}Iro62mC4xUdx0p1s{1poj5 From 2072deb6aea31464004a398817f52b5436c76a49 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 16 Oct 2023 15:37:09 -0700 Subject: [PATCH 26/37] GITFNS: preserves casing of pseudohost prefix-paths of medley projects (#1344) Also, minor edit to GITFNS.TEDIT, but now also includes a Tedit timestamp. --- lispusers/GITFNS | 103 +++++++++++++++++++++-------------------- lispusers/GITFNS.LCOM | Bin 49899 -> 49907 bytes lispusers/GITFNS.TEDIT | 82 +++++--------------------------- 3 files changed, 63 insertions(+), 122 deletions(-) diff --git a/lispusers/GITFNS b/lispusers/GITFNS index af78e808..29ea33db 100644 --- a/lispusers/GITFNS +++ b/lispusers/GITFNS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Sep-2023 13:02:15" {WMEDLEY}GITFNS.;483 124031 +(FILECREATED " 1-Oct-2023 19:33:26" {WMEDLEY}GITFNS.;489 124166 :EDIT-BY rmk - :CHANGES-TO (FNS CDGITDIR) + :CHANGES-TO (FNS GIT-MAKE-PROJECT) - :PREVIOUS-DATE "22-Sep-2023 12:08:14" {WMEDLEY}GITFNS.;482) + :PREVIOUS-DATE " 1-Oct-2023 19:27:42" {WMEDLEY}GITFNS.;488) (PRETTYCOMPRINT GITFNSCOMS) @@ -16,7 +16,7 @@ (* ;; "Set up") (FILES (SYSLOAD FROM LISPUSERS) - COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS) + COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS UNIXUTILS) (* ;; "") @@ -119,7 +119,7 @@ (FILESLOAD (SYSLOAD FROM LISPUSERS) - COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS) + COMPAREDIRECTORIES COMPARESOURCES COMPARETEXT PSEUDOHOSTS UNIXUTILS) @@ -133,15 +133,15 @@ (DEFINEQ (GIT-CLONEP - [LAMBDA (HOST/DIR NOERROR CHECKANCESTORS) (* ; "Edited 12-May-2022 11:44 by rmk") + [LAMBDA (HOST/DIR NOERROR CHECKANCESTORS) (* ; "Edited 1-Oct-2023 18:09 by rmk") + (* ; "Edited 12-May-2022 11:44 by rmk") (* ; "Edited 8-May-2022 16:24 by rmk") (* ;; "If CHECKANCESTORS, looks back up the directory chain to see if perhaps the .git is somewhere higher up.") - (IF [AND HOST/DIR (LET ((D (SLASHIT (TRUEFILENAME (PACKFILENAME.STRING 'BODY HOST/DIR + (IF [AND HOST/DIR (LET [(D (SLASHIT (TRUEFILENAME (PACKFILENAME.STRING 'BODY HOST/DIR 'HOST - 'DSK)) - T))) + 'DSK] (IF (DIRECTORYNAMEP (CONCAT D "/.git/")) THEN D ELSEIF (AND CHECKANCESTORS (FIND-ANCESTOR-DIRECTORY @@ -167,6 +167,7 @@ (GIT-MAKE-PROJECT [LAMBDA (PROJECTNAME CLONEPATH WORKINGPATH EXCLUSIONS DEFAULTSUBDIRS) + (* ; "Edited 1-Oct-2023 19:33 by rmk") (* ; "Edited 30-Mar-2023 09:06 by rmk") (* ; "Edited 5-Feb-2023 12:43 by rmk") (* ; "Edited 1-Feb-2023 16:55 by rmk") @@ -208,7 +209,7 @@ (GIT-CLONEP (MEDLEYDIR (L-CASE PROJECTNAME) NIL NIL T) T) - (GIT-CLONEP (MEDLEYDIR (CONCAT "../" PROJECTNAME) + (GIT-CLONEP (MEDLEYDIR (CONCAT "../" (L-CASE PROJECTNAME)) NIL NIL T) T) (GIT-CLONEP (DIRECTORYNAME (CONCAT MEDLEYDIR "../git-" (L-CASE @@ -219,12 +220,11 @@ (ERROR (CONCAT "Can't find a clone directory for " PROJECTNAME)) (PRINTOUT T "Note: Can't find a clone directory for " PROJECTNAME T))) - elseif (GIT-CLONEP (SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY + elseif (GIT-CLONEP [SLASHIT (PACKFILENAME 'HOST 'DSK 'DIRECTORY (UNPACKFILENAME.STRING (TRUEFILENAME CLONEPATH) 'DIRECTORY - 'RETURN)) - T) + 'RETURN] T T) else (ERROR (CONCAT "Can't find the clone directory " CLONEPATH " for " PROJECTNAME] @@ -265,7 +265,7 @@ (DIRECTORYNAME (TRUEFILENAME WORKINGPATH) T))) [SETQ WORKINGPATH (if WP - then (UNSLASHIT WP T) + then (UNSLASHIT WP) elseif WORKINGPATH then (ERROR (CONCAT "Can't find the working directory " (AND (EQ WORKINGPATH T) @@ -1720,7 +1720,8 @@ (LIST DIR1 DIR2 MAPPINGS))]) (GIT-BRANCHES-COMPARE-DIRECTORIES - [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 10-Jun-2023 17:28 by rmk") + [LAMBDA (BRANCH1 BRANCH2 LOCAL PROJECT) (* ; "Edited 26-Sep-2023 22:40 by rmk") + (* ; "Edited 10-Jun-2023 17:28 by rmk") (* ; "Edited 12-Sep-2022 14:41 by rmk") (* ; "Edited 20-Jul-2022 21:18 by rmk") (* ; "Edited 22-May-2022 22:47 by rmk") @@ -1791,10 +1792,9 @@ (TERPRI T) (IF (FETCH (CDVALUE CDENTRIES) OF CDVALUE) THEN (SETQ LAST-BRANCH-CDVALUE CDVALUE) - (CDBROWSER CDVALUE (CONCAT "Comparing " (L-CASE (FETCH PROJECTNAME - OF PROJECT) - T) - " " SHORT1 " and " SHORT2 " " + (CDBROWSER CDVALUE (CONCAT (L-CASE (FETCH PROJECTNAME OF PROJECT) + T) + " " SHORT1 " vs " SHORT2 " " (LENGTH (FETCH (CDVALUE CDENTRIES) OF CDVALUE)) " files") (LIST SHORT1 SHORT2) @@ -1812,6 +1812,8 @@ (GIT-WORKING-COMPARE-DIRECTORIES [LAMBDA (SUBDIRS SELECT EXCLUDEDFILES FIXDIRECTORYDATES UPDATE PROJECT) + (* ;; "Edited 26-Sep-2023 22:41 by rmk") + (* ;; "Edited 17-Jun-2023 22:54 by rmk") (* ;; "Edited 10-Jun-2023 21:32 by rmk") @@ -1880,9 +1882,8 @@ (SETQ $$VAL (CDMERGE $$VAL)) [SETQ SUBDIRS (CONCATLIST (FOR SUBDIR IN SUBDIRS COLLECT (CONCAT SUBDIR " "]) [FOR CDVAL TITLE IN $$VAL AS SUBDIR INSIDE SUBDIRS - DO (SETQ TITLE (CONCAT "Comparing " WPROJ " and " BRANCH2 " " SUBDIR - " " (LENGTH (fetch (CDVALUE CDENTRIES) - of CDVAL)) + DO (SETQ TITLE (CONCAT WPROJ " vs. " BRANCH2 " " SUBDIR " " + (LENGTH (fetch (CDVALUE CDENTRIES) of CDVAL)) " files")) [CDBROWSER CDVAL TITLE `(,WPROJ ,BRANCH2) `(BRANCH1 ,WPROJ BRANCH2 ,BRANCH2 SUBDIR ,SUBDIR LABELFN @@ -2299,33 +2300,33 @@ (PUTPROPS GITFNS FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4053 20503 (GIT-CLONEP 4063 . 5326) (GIT-INIT 5328 . 5958) (GIT-MAKE-PROJECT 5960 . -13561) (GIT-GET-PROJECT 13563 . 15488) (GIT-PUT-PROJECT-FIELD 15490 . 17131) (GIT-PROJECT-PATH 17133 - . 18177) (FIND-ANCESTOR-DIRECTORY 18179 . 18528) (GIT-FIND-CLONE 18530 . 19611) (GIT-MAINBRANCH 19613 - . 20008) (GIT-MAINBRANCH? 20010 . 20501)) (25911 28038 (PRC-COMMAND 25921 . 28036)) (28094 30882 ( -ALLSUBDIRS 28104 . 29390) (MEDLEYSUBDIRS 29392 . 30085) (GITSUBDIRS 30087 . 30880)) (30883 35673 ( -TOGIT 30893 . 32299) (FROMGIT 32301 . 33282) (GIT-DELETE-FILE 33284 . 34130) (MYMEDLEY-DELETE-FILES -34132 . 35671)) (35674 38677 (MYMEDLEYSUBDIR 35684 . 36140) (GITSUBDIR 36142 . 36585) (STRIPDIR 36587 - . 36958) (STRIPHOST 36960 . 37200) (STRIPNAME 37202 . 37955) (STRIPWHERE 37957 . 38675)) (38678 40580 - (GFILE4MFILE 38688 . 39051) (MFILE4GFILE 39053 . 39622) (GIT-REPO-FILENAME 39624 . 40578)) (40629 -52459 (GIT-COMMIT 40639 . 41465) (GIT-PUSH 41467 . 42111) (GIT-PULL 42113 . 42725) (GIT-APPROVAL 42727 - . 43076) (GIT-GET-FILE 43078 . 45043) (GIT-FILE-EXISTS? 45045 . 45319) (GIT-REMOTE-UPDATE 45321 . -46045) (GIT-REMOTE-ADD 46047 . 46354) (GIT-FILE-DATE 46356 . 47287) (GIT-FILE-HISTORY 47289 . 49223) ( -GIT-PRINT-FILE-HISTORY 49225 . 50275) (GIT-FETCH 50277 . 50449) (GIT-PR-BRANCHES 50451 . 52457)) ( -52489 63082 (GIT-BRANCH-DIFF 52499 . 58839) (GIT-COMMIT-DIFFS 58841 . 59394) (GIT-BRANCH-RELATIONS -59396 . 63080)) (63127 76230 (GIT-BRANCH-NUM 63137 . 63710) (GIT-CHECKOUT 63712 . 64771) ( -GIT-WHICH-BRANCH 64773 . 65071) (GIT-MAKE-BRANCH 65073 . 67286) (GIT-BRANCHES 67288 . 69556) ( -GIT-BRANCH-EXISTS? 69558 . 70262) (GIT-PICK-BRANCH 70264 . 70754) (GIT-BRANCH-MENU 70756 . 71459) ( -GIT-PULL-REQUESTS 71461 . 73607) (GIT-SHORT-BRANCH-NAME 73609 . 73900) (GIT-LONG-NAME 73902 . 74219) ( -GIT-PRC-BRANCHES 74221 . 76228)) (76260 79595 (GIT-MY-CURRENT-BRANCH 76270 . 76640) (GIT-MY-BRANCHP -76642 . 77147) (GIT-MY-NEXT-BRANCH 77149 . 77643) (GIT-MY-BRANCHES 77645 . 79593)) (79641 83593 ( -GIT-ADD-WORKTREE 79651 . 81135) (GIT-REMOVE-WORKTREE 81137 . 82067) (GIT-LIST-WORKTREES 82069 . 82873) - (WORKTREEDIR 82875 . 83591)) (83641 115865 (GIT-GET-DIFFERENT-FILES 83651 . 90075) ( -GIT-BRANCHES-COMPARE-DIRECTORIES 90077 . 96422) (GIT-WORKING-COMPARE-DIRECTORIES 96424 . 101848) ( -GIT-COMPARE-WORKTREE 101850 . 105828) (GITCDOBJBUTTONFN 105830 . 110320) (GIT-CD-LABELFN 110322 . -111404) (GIT-CD-MENUFN 111406 . 113846) (GIT-WORKING-COMPARE-FILES 113848 . 114468) ( -GIT-BRANCHES-COMPARE-FILES 114470 . 115634) (GIT-PR-COMPARE 115636 . 115863)) (115935 123964 (CDGITDIR - 115945 . 116632) (GIT-COMMAND 116634 . 118192) (GITORIGIN 118194 . 118891) (GIT-INITIALS 118893 . -119197) (GIT-COMMAND-TO-FILE 119199 . 122688) (GIT-RESULT-TO-LINES 122690 . 123297) (STRIPLOCAL 123299 - . 123962))))) + (FILEMAP (NIL (4081 20660 (GIT-CLONEP 4091 . 5419) (GIT-INIT 5421 . 6051) (GIT-MAKE-PROJECT 6053 . +13718) (GIT-GET-PROJECT 13720 . 15645) (GIT-PUT-PROJECT-FIELD 15647 . 17288) (GIT-PROJECT-PATH 17290 + . 18334) (FIND-ANCESTOR-DIRECTORY 18336 . 18685) (GIT-FIND-CLONE 18687 . 19768) (GIT-MAINBRANCH 19770 + . 20165) (GIT-MAINBRANCH? 20167 . 20658)) (26068 28195 (PRC-COMMAND 26078 . 28193)) (28251 31039 ( +ALLSUBDIRS 28261 . 29547) (MEDLEYSUBDIRS 29549 . 30242) (GITSUBDIRS 30244 . 31037)) (31040 35830 ( +TOGIT 31050 . 32456) (FROMGIT 32458 . 33439) (GIT-DELETE-FILE 33441 . 34287) (MYMEDLEY-DELETE-FILES +34289 . 35828)) (35831 38834 (MYMEDLEYSUBDIR 35841 . 36297) (GITSUBDIR 36299 . 36742) (STRIPDIR 36744 + . 37115) (STRIPHOST 37117 . 37357) (STRIPNAME 37359 . 38112) (STRIPWHERE 38114 . 38832)) (38835 40737 + (GFILE4MFILE 38845 . 39208) (MFILE4GFILE 39210 . 39779) (GIT-REPO-FILENAME 39781 . 40735)) (40786 +52616 (GIT-COMMIT 40796 . 41622) (GIT-PUSH 41624 . 42268) (GIT-PULL 42270 . 42882) (GIT-APPROVAL 42884 + . 43233) (GIT-GET-FILE 43235 . 45200) (GIT-FILE-EXISTS? 45202 . 45476) (GIT-REMOTE-UPDATE 45478 . +46202) (GIT-REMOTE-ADD 46204 . 46511) (GIT-FILE-DATE 46513 . 47444) (GIT-FILE-HISTORY 47446 . 49380) ( +GIT-PRINT-FILE-HISTORY 49382 . 50432) (GIT-FETCH 50434 . 50606) (GIT-PR-BRANCHES 50608 . 52614)) ( +52646 63239 (GIT-BRANCH-DIFF 52656 . 58996) (GIT-COMMIT-DIFFS 58998 . 59551) (GIT-BRANCH-RELATIONS +59553 . 63237)) (63284 76387 (GIT-BRANCH-NUM 63294 . 63867) (GIT-CHECKOUT 63869 . 64928) ( +GIT-WHICH-BRANCH 64930 . 65228) (GIT-MAKE-BRANCH 65230 . 67443) (GIT-BRANCHES 67445 . 69713) ( +GIT-BRANCH-EXISTS? 69715 . 70419) (GIT-PICK-BRANCH 70421 . 70911) (GIT-BRANCH-MENU 70913 . 71616) ( +GIT-PULL-REQUESTS 71618 . 73764) (GIT-SHORT-BRANCH-NAME 73766 . 74057) (GIT-LONG-NAME 74059 . 74376) ( +GIT-PRC-BRANCHES 74378 . 76385)) (76417 79752 (GIT-MY-CURRENT-BRANCH 76427 . 76797) (GIT-MY-BRANCHP +76799 . 77304) (GIT-MY-NEXT-BRANCH 77306 . 77800) (GIT-MY-BRANCHES 77802 . 79750)) (79798 83750 ( +GIT-ADD-WORKTREE 79808 . 81292) (GIT-REMOVE-WORKTREE 81294 . 82224) (GIT-LIST-WORKTREES 82226 . 83030) + (WORKTREEDIR 83032 . 83748)) (83798 116000 (GIT-GET-DIFFERENT-FILES 83808 . 90232) ( +GIT-BRANCHES-COMPARE-DIRECTORIES 90234 . 96585) (GIT-WORKING-COMPARE-DIRECTORIES 96587 . 101983) ( +GIT-COMPARE-WORKTREE 101985 . 105963) (GITCDOBJBUTTONFN 105965 . 110455) (GIT-CD-LABELFN 110457 . +111539) (GIT-CD-MENUFN 111541 . 113981) (GIT-WORKING-COMPARE-FILES 113983 . 114603) ( +GIT-BRANCHES-COMPARE-FILES 114605 . 115769) (GIT-PR-COMPARE 115771 . 115998)) (116070 124099 (CDGITDIR + 116080 . 116767) (GIT-COMMAND 116769 . 118327) (GITORIGIN 118329 . 119026) (GIT-INITIALS 119028 . +119332) (GIT-COMMAND-TO-FILE 119334 . 122823) (GIT-RESULT-TO-LINES 122825 . 123432) (STRIPLOCAL 123434 + . 124097))))) STOP diff --git a/lispusers/GITFNS.LCOM b/lispusers/GITFNS.LCOM index 2cd16571189cb902aa72f57dcb5414f1d7517575..8ff816d39ec057e0aae83b2fd5d8a0c31866e6bd 100644 GIT binary patch delta 2315 zcmZuyO>7%Q6!zL})0i}>)E?R*!Rw-ygkX1PW_QMG^(Py9lWgO7-L>7cs8UrDC$S1~ z>ZC2Cq>+#+l?zaf1W5GM11dsD1j7X(N+raJ3#ezHH!36~#H|8}x9i>5NxO&H`FZnx zzW2R1f8I#^b0hKo)LtMdcX~NRHOhdPS;n%I-@2$3%|S@2TMnt2HK+>B+H~Xf#rkWt z8K}Ln*jzf4g)yg+nzSbDRLOHs+PMnU7eF1Y77EZ-aqHn8^C`+qbuc+F>J;ppXIm9J z4_hq;?#Pq^JMlWz3Foq^0N-kE5V9rDKJB>Gaw?CCp3p-@R;RumB_n@OK7HX8B^FBz ze>pxE!*4hkgQ3q~_XdN!6+ixr0Ne9i54Z_(eb2t<3<`P2!vJ0HY|)yuOP~wLxy77S z0mkI+1XFaGPYfwUE++OWv~?q4DhZ8od4Jnq!9RVQ%Rjd73+9O(pRfIzjK{WH4c}za zAMUKj?hgkZ)PwcciMQ8d{|LWD^sk~T5|s>O1_DvvuAFi`6z%yDOpLdC1v zK6CsmfT5c(IZ>{7PH_wjf+;Cva|O4ICmMrulcx&~I;5MKCx~iknnpm+=-`&@B4$$r zjz*f(p-#OMi_R$=Eu?Z5YS#@N%GHrbNH+kdCASPZ#cAh&YS94`n*1rbZ_R*nRtYWU zDKJCpS`ZVQqHn$gjOb5whGs|z8WlVOjT#~d4#O_uU5ZL01S$IEXDA8^sJ^Bl!rgmO zpcEb71T8iOsMub~bFe+29)y?x!3>2np+_DN!|e8eV9qz^jp!RGK1x^yLJ$ezo9+<} zChdH|K8v@3p!u-AOcCCYd-|4r2Krqf>Nf`7%333?=ckzkN8SC%PctHo1Q>DiXK{kQ zl_!89cLT069;6QGleSM)tpYHP`YJZEhH2p?injx{QD(rJXIH9T5h(hx5hYN}UiV55 ztWeEtTOm|*Lc`97wZlMNRe^I3>XiQ{pkBj2A{Fd2-1panVoRHCG;!pb09D-vhAHGb zyIwpflAs<}K}Sc_tBvNx`odfamzn|U5fzwj$e(xZ$0*QJdak})pIc}&YbsEI@}Ww~ zb(!ox6weSz`cv2<&-WirVxjs92&1j{`is+h7k0#B+j2qod3DFI-dK7CJ)t{g-d=U2Y*9tDE)2M+9x4P=l$Avi*q5o7|n)4@{Ud(?g%onkxu6Tq=c zh4^xvwU)2lRj`3}V=5R*G#1}H1V>XKC^ofP4Fr-oidksd2Fe`UfNvt#L6e)9wh&pL z)7bj_;^o*)qkM4D$%kRek5`ZN>H)!o!Q{i$p*S;T|8?~kHId!z0tn$v0>^?2@kNmF zlwx^AcysF42I8FtkZ)b*eL&EZ3XNG%ldbQr%a?nx*EwgZ6{pZDeKypagyhD0<*Q5m F{{zqzJZt~} delta 2308 zcmZuy-H#Jh6z{YP>yFEY$cjMxI80pFb!nM<@64TPBe1jWuv_TPlxfRH#E^B{T`Ia= zTRxPPZDK;gqvV>%1I9!R(Wr#A_#zsje}M79#2Ab(n)qNsLVVCSJu~glE;0}I^W1aK z{r!ID%wHE{e_o8eePo!jc%iZsrz&MYSW2ZSqF+9xHrW`+%9>5w(NauRpkA4)y}DF= zrBa5<>r3^4%KlO=2farViG%{>+0%I7p*{^|Odj2z&Dm+swu*KJ z6uRkQVJ*WW7$ntHM#PH}B*I(AAeHy*!&$dfh-c6No~J#pqAAtH*e@@GM8%KNC&MpD zkw|Rfi|j%Kzloq-5c&RL@liDOs0p^`xgHoQi0?OTd0J6p+rjj;(;kTJOY?Qj8c({LptdN(}MZZbSUNZcDKA z*!s^W@5s@}I;-Y~BKyq;tC6oK2K-Sqn1302Yc=xEMAzWKyyLg#>bp|L`QX5n zCN*HUm(N-03~*D2yp=xq9B>0i1-q1Sr`40-Z2KKZOJoY|xTPI6iYYm&Jgz zq$a){d|WKaeX~0Vq zZZOWpukw~Af#X&l{bwjDg!fGFky*zNI}ePsF$o`$=-fjMqXP*wXb1^K5u&Q%fvWOA z(P@YeW!I5lZK-%g+$kSBOsUq zYqA1}hOoD@f)K_+5D6h`&Z)?hoypn9{9=K(w~q*Q@bptCD*ugn&pm+I2D-{2Wlg#s zGG``{xvfnNCf&?2U}h3Bg@f2@5J-*jfE#2#VIL}4Ibb@TE!s#rQ#*%fQiDJ&l&Rp^ z#ggX$rF!=jKuM3%fU50FC^`r(A#{dzW5n+|FcB_F|c!9F%jl`l;&TLL8?m0cE#>;vwShhOIzR#Y$qK zdb+x>SgThQpd9Tx9w}GF&Y_X0!G$vvmza2SXot)&5_CYQ(fVx2nHz4bk4E~^L1w?S ze!?#)(zF<=Uy^{QkPMloS*XR0`jLxMkoNzXk}u)QG0jv%P6hc=Xv*7e4?bQBd`uFlU_>XpU0N&^^1 z+@0f#P1Imp2sBAy(zBfOGzDt%&Y0l1Bdtt4XHD9<{YWT+K+YU$nlP&NxND37ZtH=bRILR*D8_u15ZiU2_vBwA&{yxd{n-HxWINxZTEn`uujp z{^j#udB5MsJ~C=D8lq>Q;yaicMlaZgPJ`r`v9eAZt9>ZPZUNTJ*4gEcrKZt~3K$G6 zYD;g7!1Hl1XwnA(d%U9qih=1G(qO1+JCnO`^Ca@xf!;65SQP!V=2$>N!nn~TOizmU zF6{b2*tnwPSdbPRRT1JZV;=czgdgUPpHCqn9Lq(U5bQWAuSWbJU?yYWW&3^jCfVh71$=3Tfi$nhbvX(pa diff --git a/lispusers/GITFNS.TEDIT b/lispusers/GITFNS.TEDIT index 64a88d10..42526590 100644 --- a/lispusers/GITFNS.TEDIT +++ b/lispusers/GITFNS.TEDIT @@ -15,7 +15,7 @@ where CLONEPATH specifies the local path to the clone e.g. {dsk}...>git-medley WORKINGPATH is optionally the local path to a corresponding Medley-residential working directory (e.g. {dsk}...>working-medley>) -When the project has a working path: +When the project has a WORKINGPATH: EXCLUSIONS is a list of files and directories to be excluded from comparisons (including what its .gitignore specifies) DEFAULTSUBDIRS is a list of subdirectories to be use in working-path comparisons when directories are not otherwise specified. For convenience, if CLONEPATH is NIL or T (and not a path), then a sequence of probes based on PROJECTNAME attempts to find a clone directory (with a .git subdirectory): @@ -76,73 +76,13 @@ In addition to the commands for comparing and viewing files, the menu for this b If the master/main branch is the current branch then the menu has no commands to change the clone directory. The browser will show those files that have been updated from a recent merge, and they can individually be copied from the git branch to realign the two source trees with incremented Medley version numbers. If the comparison is with a different branch, say the user's current staging branch, copying files from the working Medley to the git clone or deleting git files will set git up for future commits. Note that the menu item for deleting Medley files will cause all versions to be removed, not just the latest one, to avoid the possibility that an earlier one is revealed. Deletion for Medley files is also accomplished by renaming to a {Wprojectname} subdirectory so that they can be recovered if a deletion is in error. Files in the git-clone are removed from the file system immediately, since git provides its own recovery mechanism for those files. GITFNS does not (yet?) include functions for commits, pushes, or merge for updating the remote repository. Those have to be done outside of Medley through the usual github interfaces, as guided by the information provided by the comparisons. -(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))).È.È4 ÈÈ4 ÈÈ4ÈÈ4ÈÈ4ÈÈ4ÈÈ4È È4ÈÈ.È.ŠŠ8.ŠŠ8JÈÈ PAGEHEADING RUNNINGHEADTERMINAL -MODERN -TIMESROMAN$TERMINALMODERN -MODERN MODERN -MODERN - HRULE.GETFNMODERN -  HRULE.GETFNMODERN -  HRULE.GETFNMODERN -   HRULE.GETFNMODERN   HRULE.GETFNMODERN   -1 - -R - Íé - -; -¹@, - - "  &  \  -X - p  6 , -  -) -  -)  -+      5      -@ &   -I 7 -  o - E . -8 > I - -  -Y  € - -$ -;  -} -( -) 9 -! -0 -4  c -  - 5  vB  -1OLJ -'' - -œ -)2 -+ -  - -    Z !  œ -5H - - 5 -5 ->$N ! M - §‹A -@ -4 - -@Ô -â   k 6.  R   < 9   -' -Y" ( ? “F  - - -ìË -ò1Sýzº \ No newline at end of file +(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL)))))1$4È$È4È $È1È$4 È$È4 È$È4È$È4È$È4È$È4È$È1È$1ŠŠ8$1ŠŠ8$JÈ$È PAGEHEADING RUNNINGHEAD1È$ TERMINAL_Q(DEFAULTFONT 1 (TERMINAL 12) (TERMINAL 8) (TERMINAL 8) (POSTSCRIPT (TERMINAL 8))) MODERN +TERMINAL +MODERNMODERN +MODERN  +TIMESROMAN$MODERN + HRULE.GETFN  HRULE.GETFN  HRULE.GETFN   HRULE.GETFN  HRULE.GETFN 1R Íé;¹@ +, "  &  \  +X + p 6 , ) ) +      5     @ &  I 7  o E .8 > I Y  €$; }() 9!04  c  5  vB 1OLJ''œ)2+     Z !  œ5H 55>$N ! M §‹A@4 +@Ôâ   k 6.  R   < 9  'Y"(? “F ìËò1Rþzº \ No newline at end of file From a219ea03e50bada9bed9cb8c336d3e82c8b90f3d Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 16 Oct 2023 15:54:34 -0700 Subject: [PATCH 27/37] Improve check for closed stream in \UFSCloseFile. (#1334) Check if the (STREAM ACCESS) bits are NIL, indicating a closed stream, and if so do not attempt to close the file again Co-authored-by: Nick Briggs Co-authored-by: Larry Masinter --- sources/UFS | 85 +++++++++++++++++++++++++++++++---------------- sources/UFS.LCOM | Bin 36959 -> 36882 bytes 2 files changed, 56 insertions(+), 29 deletions(-) diff --git a/sources/UFS b/sources/UFS index 9097604b..a7455a02 100644 --- a/sources/UFS +++ b/sources/UFS @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Mar-2022 11:29:33" {DSK}kaplan>Local>medley3.5>my-medley>sources>UFS.;32 78036 +(FILECREATED "16-Sep-2023 09:22:55" {DSK}briggs>Projects>medley>sources>UFS.;2 78813 - :PREVIOUS-DATE "28-Mar-2022 22:09:43" -{DSK}kaplan>Local>medley3.5>my-medley>sources>UFS.;31) + :EDIT-BY "briggs" + :CHANGES-TO (FNS \UFSCloseFile) + + :PREVIOUS-DATE "29-Mar-2022 11:29:33" {DSK}briggs>Projects>medley>sources>UFS.;1) -(* ; " -Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT UFSCOMS) @@ -291,8 +290,38 @@ Copyright (c) 1988-1995, 2000, 2021-2022 by Venue & Xerox Corporation. ) (\UFSCloseFile -(LAMBDA (STREAMFILE) (* ; "Edited 30-Mar-90 10:39 by nm") (* ; "return stream") (* ;;; "Closes the specified stream.") (* * WITH.MONITOR \UFStopMonitor) (* ;;; "Write out and dispense with buffers for this stream.") (\CLEARMAP STREAMFILE) (PROG ((DEVICE (fetch (STREAM DEVICE) of STREAMFILE)) (CDATE 0) (ERRNO (CREATECELL \FIXP)) (UNIXNAME (fetch (UFSSTREAM UNIXNAME) of STREAMFILE))) (if (NULL UNIXNAME) then (* ; "Already closed! Somebody's trying to close us twice.") (RETURN NIL)) (if (DIRTYABLE STREAMFILE) then (* ; "Open for output") (FDEVOP (QUOTE TRUNCATEFILE) DEVICE STREAMFILE) (SETQ CDATE (fetch (UFSSTREAM CDATE) of STREAMFILE))) (RETURN (if (\UFSCloseFile-C UNIXNAME (fetch (UFSSTREAM FILEID) of STREAMFILE) CDATE ERRNO) then (replace (UFSSTREAM FILEID) of STREAMFILE with NIL) (replace (UFSSTREAM CDATE) of STREAMFILE with NIL) (* ; "Clear open-file state") STREAMFILE else (\UFSError (fetch (STREAM FULLFILENAME) of STREAMFILE) ERRNO))))) -) + [LAMBDA (STREAMFILE) (* ; "Edited 16-Sep-2023 09:21 by briggs") + (* ; "Edited 30-Mar-90 10:39 by nm") + (* ; "return stream") + +(* ;;; "Closes the specified stream.") + + (* * WITH.MONITOR \UFStopMonitor) + +(* ;;; "Write out and dispense with buffers for this stream.") + + (\CLEARMAP STREAMFILE) + (PROG ((DEVICE (fetch (STREAM DEVICE) of STREAMFILE)) + (CDATE 0) + (ERRNO (CREATECELL \FIXP)) + (UNIXNAME (fetch (UFSSTREAM UNIXNAME) of STREAMFILE))) + (if (OR (NULL UNIXNAME) + (NULL (fetch (STREAM ACCESS) of STREAMFILE))) + then (* ; + "Already closed! Somebody's trying to close us twice.") + (RETURN NIL)) + (if (DIRTYABLE STREAMFILE) + then (* ; "Open for output") + (FDEVOP 'TRUNCATEFILE DEVICE STREAMFILE) + (SETQ CDATE (fetch (UFSSTREAM CDATE) of STREAMFILE))) + (RETURN (if (\UFSCloseFile-C UNIXNAME (fetch (UFSSTREAM FILEID) of STREAMFILE) + CDATE ERRNO) + then (replace (UFSSTREAM FILEID) of STREAMFILE with NIL) + (replace (UFSSTREAM CDATE) of STREAMFILE with NIL) + (* ; "Clear open-file state") + STREAMFILE + else (\UFSError (fetch (STREAM FULLFILENAME) of STREAMFILE) + ERRNO]) (\UFSGetFileName (LAMBDA (FILENAME RECOG DEV) (* ; "Edited 24-Feb-89 16:20 by bvm") (* ;; "Recognize filename, return full name") (\UFS.FULLNAME (\UFS.RECOGNIZE.FILE FILENAME RECOG DEV) DEV T)) @@ -1126,26 +1155,24 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap (ADDTOVAR LAMA ) ) -(PUTPROPS UFS COPYRIGHT ("Venue & Xerox Corporation" 1988 1989 1990 1991 1992 1993 1994 1995 2000 2021 - 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8950 10503 (\UFSCreateDevice 8960 . 9325) (\UFS.CREATE.DEVICE 9327 . 10183) ( -\UFSOpenDevice 10185 . 10362) (\UFSCloseDevice 10364 . 10501)) (14766 50339 (\UFSOpenFile 14776 . -18070) (\UFS.OPENP 18072 . 18569) (\UFS.RECOGNIZE.FILE 18571 . 19324) (\UFS.DIRECTORY.NAME 19326 . -20069) (\UFSCloseFile 20071 . 21047) (\UFSGetFileName 21049 . 21248) (\UFSDeleteFile 21250 . 21790) ( -\UFSRenameFile 21792 . 22957) (\UFSReadPages 22959 . 24094) (\UFSWritePages 24096 . 25316) ( -\UFSTruncateFile 25318 . 26815) (\UFSDirectoryNameP 26817 . 27871) (\UFSEventFn 27873 . 28535) ( -\UFSGetFileInfo 28537 . 30819) (\UFS.CREATE.PROPS 30821 . 31174) (\UFSSetFileInfo 31176 . 32405) ( -\UFSGenerateFiles 32407 . 39287) (\UFS.NEXTFILEFN 39289 . 46927) (\UFS.FILEINFOFN 46929 . 48378) ( -\UFS.VALID.PROPP 48380 . 48672) (\UFS.REGISTER.GFS 48674 . 48929) (\UFS.UNREGISTER.GFS 48931 . 49514) -(\UFS.ABORT.DIRECTORY 49516 . 49864) (\UFS.ABORT.CL-DIRECTORY 49866 . 50153) (\UFS.CLEANUP.GFS.TABLE -50155 . 50337)) (50374 57058 (\UFSMakeUnixFormatName 50384 . 51405) (\UFSParseNameString 51407 . 51781 -) (\UFSParse-Directory 51783 . 52324) (\UFS.PARSE.BODY 52326 . 52871) (\UFS.ADJUST.HOST 52873 . 53032) - (\UFS.FULLNAME 53034 . 54242) (\UFS.ADD.HOST.FIELD 54244 . 54604) (\UFS.REMOVE.HOST.FIELD 54606 . -56276) (\UFS.HANDLE.RELATIVEDIRECTORY 56278 . 57056)) (57874 58487 (CHDIR 57884 . 58485)) (58559 59545 - (\DEVICEFILE.EOSERROR 58569 . 59543)) (59618 60855 (\UNVISIBLE.PAGED.REVALIDATEFILELST 59628 . 60473) - (\UNVISIBLE.FLUSH.OPEN.STREAMS 60475 . 60853)) (60888 62514 (\UFSError 60898 . 62512)) (62558 64973 ( -\UFSGetFileType 62568 . 63169) (\UFSSetFileType 63171 . 63768) (\UFSeol 63770 . 64971)) (73620 74744 ( -\UFSGetPrintFileType 73630 . 74042) (\UFSGetFileTypeConfirm 74044 . 74492) (\UFSPrintTypeMenu 74494 . -74742)) (74774 77612 (\UFStoOtherCopyMess 74784 . 76462) (\UFStoOtherRenameMess 76464 . 77610))))) + (FILEMAP (NIL (8909 10462 (\UFSCreateDevice 8919 . 9284) (\UFS.CREATE.DEVICE 9286 . 10142) ( +\UFSOpenDevice 10144 . 10321) (\UFSCloseDevice 10323 . 10460)) (14725 51227 (\UFSOpenFile 14735 . +18029) (\UFS.OPENP 18031 . 18528) (\UFS.RECOGNIZE.FILE 18530 . 19283) (\UFS.DIRECTORY.NAME 19285 . +20028) (\UFSCloseFile 20030 . 21935) (\UFSGetFileName 21937 . 22136) (\UFSDeleteFile 22138 . 22678) ( +\UFSRenameFile 22680 . 23845) (\UFSReadPages 23847 . 24982) (\UFSWritePages 24984 . 26204) ( +\UFSTruncateFile 26206 . 27703) (\UFSDirectoryNameP 27705 . 28759) (\UFSEventFn 28761 . 29423) ( +\UFSGetFileInfo 29425 . 31707) (\UFS.CREATE.PROPS 31709 . 32062) (\UFSSetFileInfo 32064 . 33293) ( +\UFSGenerateFiles 33295 . 40175) (\UFS.NEXTFILEFN 40177 . 47815) (\UFS.FILEINFOFN 47817 . 49266) ( +\UFS.VALID.PROPP 49268 . 49560) (\UFS.REGISTER.GFS 49562 . 49817) (\UFS.UNREGISTER.GFS 49819 . 50402) +(\UFS.ABORT.DIRECTORY 50404 . 50752) (\UFS.ABORT.CL-DIRECTORY 50754 . 51041) (\UFS.CLEANUP.GFS.TABLE +51043 . 51225)) (51262 57946 (\UFSMakeUnixFormatName 51272 . 52293) (\UFSParseNameString 52295 . 52669 +) (\UFSParse-Directory 52671 . 53212) (\UFS.PARSE.BODY 53214 . 53759) (\UFS.ADJUST.HOST 53761 . 53920) + (\UFS.FULLNAME 53922 . 55130) (\UFS.ADD.HOST.FIELD 55132 . 55492) (\UFS.REMOVE.HOST.FIELD 55494 . +57164) (\UFS.HANDLE.RELATIVEDIRECTORY 57166 . 57944)) (58762 59375 (CHDIR 58772 . 59373)) (59447 60433 + (\DEVICEFILE.EOSERROR 59457 . 60431)) (60506 61743 (\UNVISIBLE.PAGED.REVALIDATEFILELST 60516 . 61361) + (\UNVISIBLE.FLUSH.OPEN.STREAMS 61363 . 61741)) (61776 63402 (\UFSError 61786 . 63400)) (63446 65861 ( +\UFSGetFileType 63456 . 64057) (\UFSSetFileType 64059 . 64656) (\UFSeol 64658 . 65859)) (74508 75632 ( +\UFSGetPrintFileType 74518 . 74930) (\UFSGetFileTypeConfirm 74932 . 75380) (\UFSPrintTypeMenu 75382 . +75630)) (75662 78500 (\UFStoOtherCopyMess 75672 . 77350) (\UFStoOtherRenameMess 77352 . 78498))))) STOP diff --git a/sources/UFS.LCOM b/sources/UFS.LCOM index 7b04472082a49cea107ffd41f131dace76dc319b..0fe75a9ec5ac282416171ff630ef002e2a7ecee8 100644 GIT binary patch delta 575 zcma)(%}T>S6oqZ+#^^#&&~|kh5ZXmbW@6i9kYbulw3zmLpW z2VM{SBS3Is@y*lKX6OZBaW@$B`(d#j`1@XW6c(fN*uojfNPsZ;^1>Qb2vrmWyMZ@0 z>+W@q`d+w9q208(dEkehEmB}0LhPpFz;}ymHjALw83_pK7jLYfjFh&^4l^4%GhAi~ zf}hvq{zDH1O~WcsW|dvJv@P;Ju0%l14Wqiwxa`&-ZCCjucm`;_!CK{7lgpMs07P`T z(h1)BB!Dp`I#pE!(q9E0Mi;U9$N1G^>@vDeqS@z}wchlUcn^DX(Nl8gOvUf1EC~Dn z^xPzZY=Wvmd!4z4X)?}1>`jLmjfznh{b2F0+-)$UB5=rfRK}{7{}c=3DNn$*SPNF( WmFPURl#tRH>FF+2J5E%~j`RwFIH3Cg delta 696 zcma))--^>f6vnaaRixmZ?Bc~Cpd_#f$t2k(QGz8+w3?dGG*w{{VmoNqX(mh>c8h3V zzzeZA-nl-*K7e<=hOgpem#ynR@aD&v19QIfeKQ|VJKs+`AD*rODUTYWAPphVb=NRm z)DuAxXLL~&1kZt%AcF8_kUoBUucWMi`I^77$RKQ%dXmsezUh&{lgjb zY|S_jz)i-%bQou;GT>TV%Kj;ZkgGYa`KQu;o8xTbiQJWR-GX$&(-?uSnU|%rZT9TT-oduA zOb7?T6byUwdGFRvSCYGDU-#msmXd6ejN>E){!rk@$@B5>!NUpvJyTpZ81BF`%;*XD tlvR}F%Yv37=#Fi-a5x;Th2DbyKF2Xym@O Date: Tue, 17 Oct 2023 21:34:17 -0700 Subject: [PATCH 28/37] pull (non-working) TCP files to obsolete (#1283) --- obsolete/tcp/TCP | 1 + obsolete/tcp/TCPCHAT | 1 + obsolete/tcp/TCPCONFIG | 1 + obsolete/tcp/TCPDEBUG | 1 + obsolete/tcp/TCPDOMAIN | 1 + obsolete/tcp/TCPEXPORTS | 1 + obsolete/tcp/TCPFTP | 1 + obsolete/tcp/TCPFTPSRV | 1 + obsolete/tcp/TCPHTE | 1 + {library => obsolete/tcp}/TCPIP.TEDIT | Bin obsolete/tcp/TCPLLAR | 1 + obsolete/tcp/TCPLLICMP | 1 + obsolete/tcp/TCPLLIP | 1 + obsolete/tcp/TCPNAMES | 1 + obsolete/tcp/TCPOPS | 212 ++++++++++++++++++++++++++ obsolete/tcp/TCPTFTP | 1 + obsolete/tcp/TCPUDP | 1 + 17 files changed, 227 insertions(+) create mode 100644 obsolete/tcp/TCP create mode 100644 obsolete/tcp/TCPCHAT create mode 100644 obsolete/tcp/TCPCONFIG create mode 100644 obsolete/tcp/TCPDEBUG create mode 100644 obsolete/tcp/TCPDOMAIN create mode 100644 obsolete/tcp/TCPEXPORTS create mode 100644 obsolete/tcp/TCPFTP create mode 100644 obsolete/tcp/TCPFTPSRV create mode 100644 obsolete/tcp/TCPHTE rename {library => obsolete/tcp}/TCPIP.TEDIT (100%) create mode 100644 obsolete/tcp/TCPLLAR create mode 100644 obsolete/tcp/TCPLLICMP create mode 100644 obsolete/tcp/TCPLLIP create mode 100644 obsolete/tcp/TCPNAMES create mode 100644 obsolete/tcp/TCPOPS create mode 100644 obsolete/tcp/TCPTFTP create mode 100644 obsolete/tcp/TCPUDP diff --git a/obsolete/tcp/TCP b/obsolete/tcp/TCP new file mode 100644 index 00000000..49a212eb --- /dev/null +++ b/obsolete/tcp/TCP @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "17-Aug-90 12:01:50" {DSK}ETHERNET>TCP>NEW>TCP.;5 98103 changes to%: (FILES TCPLLIP) (FNS \TCP.DELETE.TCB) previous date%: "13-Feb-89 21:04:17" {DSK}ETHERNET>TCP>NEW>TCP.;3) (* " Copyright (c) 1983, 1984, 1985, 1986, 1901, 1900, 1987, 1988, 1989, 1990 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPCOMS) (RPAQQ TCPCOMS [(COMS (* ;; "Transmission Control Protocol. RFC 793, September 1981") ) (COMS (DECLARE%: EVAL@LOAD (FILES (SYSLOAD) TCPLLIP)) (GLOBALVARS \TCP.LOCK \TCP.CONTROL.BLOCKS \TCP.CHECKSUMS.ON \TCP.PSEUDOHEADER \TCP.MSL \TCP.DEFAULT.USER.TIMEOUT \TCP.DEFAULT.RECEIVE.WINDOW \TCP.DEVICE \TCP.MASTER.SOCKET)) (COMS (* ;; "DoD Internet addresses") (FNS SET.IP.ADDRESS STRING.TO.IP.ADDRESS IP.ADDRESS.TO.STRING \LOCAL.IP.ADDRESS)) [COMS (* ;; "TCP segments") (DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "control bits for TCP.CTRL field of TCP header") (EXPORT (CONSTANTS \TCP.CTRL.ACK \TCP.CTRL.FIN \TCP.CTRL.PSH \TCP.CTRL.RST \TCP.CTRL.SYN \TCP.CTRL.URG) (* ;; "option definitions") (CONSTANTS \TCPOPT.END \TCPOPT.NOP \TCPOPT.MAXSEG) (* ;; "TCP protocol number for IP level dispatch") (CONSTANTS \TCP.PROTOCOL) (* ;; "TCP header length in bytes (= 4 * min data offset)") (CONSTANTS \TCP.HEADER.LENGTH) (* ;;  "minimum offset of data from segment in 32-bit words (= header length / 4)") (CONSTANTS \TCP.MIN.DATA.OFFSET) (* ;; "default maximum segment size") (CONSTANTS \TCP.DEFAULT.MAXSEG) (* ;; "TCP segment") (RECORDS TCPSEGMENT] (COMS (* ;; "TCP sequence numbers") (DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "macros for comparing TCP sequence numbers") (MACROS \32BIT.EQ \32BIT.LT \32BIT.LEQ \32BIT.GT \32BIT.GEQ) (* ;; "fast multiply by 3 -- evaluates its argument twice") (MACROS \3TIMES)) (FNS \TCP.SELECT.ISS)) (COMS (* ;; "TCP control blocks") (DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "TCP control block") (EXPORT (RECORDS TCP.CONTROL.BLOCK TCPSTREAM)) (* ;; "TCP stream") ) (INITRECORDS TCP.CONTROL.BLOCK TCPSTREAM) (* ;; "global lock for TCP-related mutual exclusion") (INITVARS (\TCP.LOCK (CREATE.MONITORLOCK))) (* ;; "list of TCP control blocks for connection lookup") (INITVARS (\TCP.CONTROL.BLOCKS NIL)) (FNS \TCP.CREATE.TCB \TCP.SELECT.PORT \TCP.LOOKUP.TCB \TCP.DELETE.TCB \TCP.NOSOCKETFN \TCP.PORTCOMPARE)) (COMS (* ;; "TCP checksums") (DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "pseudo-header for checksum calculation") (RECORDS TCP.PSEUDOHEADER) (CONSTANTS \TCP.PSEUDOHEADER.LENGTH) (MACROS \16BIT.COMPLEMENT \16BIT.1C.PLUS)) (INITRECORDS TCP.PSEUDOHEADER) (INITVARS (\TCP.PSEUDOHEADER NIL)) (* ;; "this variable controls whether checksums are performed on incoming segments") (INITVARS (\TCP.CHECKSUMS.ON NIL)) (* ;; "checksum routines") (FNS \COMPUTE.CHECKSUM \TCP.CHECKSUM.INCOMING \TCP.CHECKSUM.OUTGOING)) (COMS (DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "constants for retransmission timeout calculation") (* ;; "initial retransmission timeout") (CONSTANTS \TCP.INITIAL.RTO) (* ;; "upper and lower bounds on retransmission timeout") (CONSTANTS (\TCP.UBOUND 5000) (\TCP.LBOUND 1000))) (* ;; "maximum segment lifetime") (INITVARS (\TCP.MSL 5000)) (INITVARS (\TCP.DEFAULT.USER.TIMEOUT 60000) (\TCP.DEFAULT.RECEIVE.WINDOW 4096) (\TCP.DEVICE NIL)) (* ;; "TCP protocol routines") (FNS \TCP.ACK# \TCP.PACKET.FILTER \TCP.SETUP.SEGMENT \TCP.RELEASE.SEGMENT \TCP.CONNECTION \TCP.FIX.INCOMING.SEGMENT \TCP.DATA.LENGTH \TCP.SYN.OR.FIN \TCP.INPUT \TCP.INPUT.INITIAL \TCP.INPUT.UNSYNC \TCP.INPUT.LISTEN \TCP.INPUT.SYN.SENT \TCP.CHECK.WINDOW \TCP.CHECK.RESET \TCP.CHECK.SECURITY \TCP.CHECK.NO.SYN \TCP.CHECK.ACK \TCP.HANDLE.ACK \TCP.HANDLE.URG \TCP.QUEUE.INPUT \TCP.HANDLE.FIN \TCP.OUR.FIN.IS.ACKED \TCP.SIGNAL.URGENT.DATA \TCP.PROCESS \TCP.TEMPLATE \TCP.SETUP.SEGMENT.OPTIONS \TCP.SEND.CONTROL \TCP.SEND.ACK \TCP.SEND.RESET \TCP.FIX.OUTGOING.SEGMENT \TCP.SEND.DATA \TCP.SEND.SEGMENT \TCP.NEW.TEMPLATE \TCP.START.PROBE.TIMER \TCP.RETRANSMIT \TCP.START.TIME.WAIT \TCP.CONNECTION.DROPPED \TCP.CHECK.OPTIONS \TCP.PROCESS.OPTIONS)) (COMS (* ;; "support for ICMP messages that affect TCP connections") (DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "ICMP protocol number for IP level dispatch") (CONSTANTS \ICMP.PROTOCOL) (* ;;  "number of 32 bit words in ICMP message before start of original datagram") (CONSTANTS \ICMP.32BIT.WORDS) (* ;; "relevant ICMP message types") (CONSTANTS \ICMP.DESTINATION.UNREACHABLE \ICMP.SOURCE.QUENCH)) (FNS \TCP.HANDLE.ICMP)) (COMS (* ;; "TCP stream routines") (FNS TCP.OPEN TCP.OTHER.STREAM \TCP.BOUTS \TCP.OTHER.BIN \TCP.OTHER.BOUT \TCP.BIN \TCP.BACKFILEPTR \TCP.GETNEXTBUFFER \TCP.GET.SEGMENT \TCP.PEEKBIN \TCP.GETFILEPTR \TCP.READP \TCP.EOFP TCP.URGENTP TCP.URGENT.EVENT \TCP.BOUT \TCP.FLUSH \TCP.FORCEOUTPUT TCP.URGENT.MARK \TCP.FILL.IN.SEGMENT \TCP.CLOSE \TCP.RESETCLOSE TCP.CLOSE.SENDER TCP.DESTADDRESS TCP.STOP)) (COMS (* ;; "well-known ports for network standard functions") (CONSTANTS * \TCP.ASSIGNED.PORTS)) (COMS (* ;; "Stub for debugging") (INITVARS (\TCP.DEBUGGABLE) (TCPTRACEFLG)) (GLOBALVARS \TCP.DEBUGGABLE TCPTRACEFLG) (FNS PPTCB \TCP.TRACE.SEGMENT \TCP.TRACE.TRANSITION)) (COMS (* ;; "TCP initialization") (FNS \TCP.INIT) (P (\TCP.INIT]) (* ;; "Transmission Control Protocol. RFC 793, September 1981") (DECLARE%: EVAL@LOAD (FILESLOAD (SYSLOAD) TCPLLIP) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \TCP.LOCK \TCP.CONTROL.BLOCKS \TCP.CHECKSUMS.ON \TCP.PSEUDOHEADER \TCP.MSL \TCP.DEFAULT.USER.TIMEOUT \TCP.DEFAULT.RECEIVE.WINDOW \TCP.DEVICE \TCP.MASTER.SOCKET) ) (* ;; "DoD Internet addresses") (DEFINEQ (SET.IP.ADDRESS (LAMBDA NIL (* ejs%: "28-Dec-84 18:45") (* set local IP address manually) (PROG ((ADDR (\IP.READ.STRING.ADDRESS (PROMPTFORWORD "Enter IP address:" (\IP.ADDRESS.TO.STRING (OR (CAR \IP.LOCAL.ADDRESSES) 0)))))) (SETQ \IP.LOCAL.ADDRESSES (LIST ADDR)))) ) (STRING.TO.IP.ADDRESS (LAMBDA (STR) (* ecc "14-May-84 15:01") (APPLY (FUNCTION IP\Make\Address) (to 4 bind (I _ 0) OFFSET collect (SETQ OFFSET (ADD1 I)) (MKATOM (SUBSTRING STR OFFSET (AND (SETQ I (STRPOS "." STR OFFSET)) (SUB1 I))))))) ) (IP.ADDRESS.TO.STRING (LAMBDA (IPADDR) (* ecc "14-May-84 14:32") (PROG ((A (LOADBYTE IPADDR 24 8)) (B (LOADBYTE IPADDR 16 8)) (C (LOADBYTE IPADDR 8 8)) (D (LOADBYTE IPADDR 0 8))) (RETURN (CONCAT A "." B "." C "." D)))) ) (\LOCAL.IP.ADDRESS (LAMBDA NIL (* ejs%: "28-Dec-84 18:45") (* return our IP address (or the first if we're multi-homed)) (if (NULL \IP.LOCAL.ADDRESSES) then (ERROR "You must set \IP.LOCAL.ADDRESSES to a list of our local IP addresses")) (CAR \IP.LOCAL.ADDRESSES)) ) ) (* ;; "TCP segments") (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (RPAQQ \TCP.CTRL.ACK 16) (RPAQQ \TCP.CTRL.FIN 1) (RPAQQ \TCP.CTRL.PSH 8) (RPAQQ \TCP.CTRL.RST 4) (RPAQQ \TCP.CTRL.SYN 2) (RPAQQ \TCP.CTRL.URG 32) (CONSTANTS \TCP.CTRL.ACK \TCP.CTRL.FIN \TCP.CTRL.PSH \TCP.CTRL.RST \TCP.CTRL.SYN \TCP.CTRL.URG) ) (DECLARE%: EVAL@COMPILE (RPAQQ \TCPOPT.END 0) (RPAQQ \TCPOPT.NOP 1) (RPAQQ \TCPOPT.MAXSEG 2) (CONSTANTS \TCPOPT.END \TCPOPT.NOP \TCPOPT.MAXSEG) ) (DECLARE%: EVAL@COMPILE (RPAQQ \TCP.PROTOCOL 6) (CONSTANTS \TCP.PROTOCOL) ) (DECLARE%: EVAL@COMPILE (RPAQQ \TCP.HEADER.LENGTH 20) (CONSTANTS \TCP.HEADER.LENGTH) ) (DECLARE%: EVAL@COMPILE (RPAQQ \TCP.MIN.DATA.OFFSET 5) (CONSTANTS \TCP.MIN.DATA.OFFSET) ) (DECLARE%: EVAL@COMPILE (RPAQQ \TCP.DEFAULT.MAXSEG 536) (CONSTANTS \TCP.DEFAULT.MAXSEG) ) (DECLARE%: EVAL@COMPILE (ACCESSFNS TCPSEGMENT ((TCPHEADER (\IPDATABASE DATUM))) (BLOCKRECORD TCPHEADER ((TCP.SRC.PORT WORD) (TCP.DST.PORT WORD) (TCP.SEQ FIXP) (TCP.ACK FIXP) (TCP.DATA.OFFSET BITS 4) (TCP.MBZ BITS 6) (TCP.CTRL BITS 6) (TCP.WINDOW WORD) (TCP.CHECKSUM WORD) (TCP.URG.PTR WORD))) [ACCESSFNS TCPSEGMENT ((TCP.DATA.LENGTH (fetch (IP IPHEADERCHECKSUM) of DATUM) (replace (IP IPHEADERCHECKSUM) of DATUM with NEWVALUE)) (TCP.SRC.ADDR (fetch (IP IPSOURCEADDRESS) of DATUM) (replace (IP IPSOURCEADDRESS) of DATUM with NEWVALUE)) (TCP.DST.ADDR (fetch (IP IPDESTINATIONADDRESS) of DATUM) (replace (IP IPDESTINATIONADDRESS) of DATUM with NEWVALUE)) (TCP.HEADER.LENGTH (LLSH (fetch TCP.DATA.OFFSET of DATUM) 2)) (TCP.CONTENTS (\ADDBASE (fetch TCPHEADER of DATUM) (UNFOLD (fetch TCP.DATA.OFFSET of DATUM) WORDSPERCELL))) (TCP.OPTIONS (\ADDBASE (fetch TCPHEADER of DATUM) (UNFOLD \TCP.MIN.DATA.OFFSET WORDSPERCELL]) ) (* "END EXPORTED DEFINITIONS") ) (* ;; "TCP sequence numbers") (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (PUTPROPS \32BIT.EQ MACRO ((A B) (IEQP A B))) (PUTPROPS \32BIT.LT MACRO ((A B) (ILESSP (IDIFFERENCE A B) 0))) (PUTPROPS \32BIT.LEQ MACRO ((A B) (ILEQ (IDIFFERENCE A B) 0))) (PUTPROPS \32BIT.GT MACRO ((A B) (IGREATERP (IDIFFERENCE A B) 0))) (PUTPROPS \32BIT.GEQ MACRO ((A B) (IGEQ (IDIFFERENCE A B) 0))) ) (DECLARE%: EVAL@COMPILE (PUTPROPS \3TIMES MACRO ((N) (IPLUS (LLSH N 1) N))) ) ) (DEFINEQ (\TCP.SELECT.ISS (LAMBDA NIL (* ecc "16-May-84 11:40") (* select an initial send sequence number -- use the time of day to make sure we won't repeat after a crash) (LOGAND (DAYTIME) 65535)) ) ) (* ;; "TCP control blocks") (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (DATATYPE TCP.CONTROL.BLOCK ((TCB.LOCK POINTER) (* monitor lock for synchronizing  access) (TCB.STATE POINTER) (* one of CLOSED LISTEN SYN.SENT  SYN.RECEIVED ESTABLISHED FIN.WAIT.1  FIN.WAIT.2 CLOSE.WAIT CLOSING  LAST.ACK TIME.WAIT) (TCB.SND.STREAM POINTER) (* user's send stream) (TCB.SND.SEGMENT POINTER) (* current output packet being  filled) (TCB.RCV.STREAM POINTER) (* user's receive stream) (TCB.RCV.SEGMENT POINTER) (* current input packet being read) (TCB.2MSL.TIMER POINTER) (* 2*MSL quiet time) (TCB.MAXSEG POINTER) (* maximum segment size) (TCB.CLOSEDFLG POINTER) (* T if user has initiated close  (no more data to send)) (TCB.FINSEQ POINTER) (* one past the sequence number of  the FIN we sent) (TCB.ACKFLG POINTER) (* when to ACK peer%: NOW or LATER) (TCB.TEMPLATE POINTER) (* TCP header template) (TCB.PH POINTER) (* TCP pseudo-header for  checksumming) (TCB.SRC.PORT WORD) (* local port) (TCB.DST.PORT WORD) (* remote port) (TCB.DST.HOST FIXP) (* remote host address) (TCB.INPUT.QUEUE POINTER) (* queue of received segments to be  read) (TCB.REXMT.QUEUE POINTER) (* queue of unacked segments to be  retransmitted) (TCB.SND.UNA FIXP) (* first unacknowledged sequence  number) (TCB.SND.NXT FIXP) (* next sequence number to be sent) (TCB.SND.UP FIXP) (* send urgent pointer) (TCB.SND.WL1 FIXP) (* segment sequence number used for  last window update) (TCB.SND.WL2 FIXP) (* segment acknowledgment number  used for last window update) (TCB.ISS FIXP) (* initial send sequence number) (TCB.SND.WND WORD) (* send window) (TCB.RCV.WND WORD) (* receive window) (TCB.RCV.NXT FIXP) (* next sequence number expected) (TCB.RCV.UP FIXP) (* receive urgent pointer) (TCB.IRS FIXP) (* initial receive sequence number) (TCB.USER.TIMEOUT POINTER) (* in milliseconds) (TCB.ESTABLISHED POINTER) (* processes waiting for this event  are notified when the connection  becomes established) (TCB.SND.EVENT POINTER) (* processes waiting for this event  are notified when the send window  opens up) (TCB.RCV.EVENT POINTER) (* processes waiting for this event  are notified when data is received) (TCB.URGENT.EVENT POINTER) (* processes waiting for this event  are notified when urgent data is  received) (TCB.FINACKED.EVENT POINTER)(* processes waiting for this event  are notified when our FIN has been  acked) (TCB.MODE POINTER) (* ACTIVE or PASSIVE) (TCB.RTFLG POINTER) (* T if round trip time being  measured) (TCB.RTSEQ POINTER) (* sequence number being timed) (TCB.RTTIMER POINTER) (* round trip timer) (TCB.SRTT POINTER) (* smoothed round trip time) (TCB.RTO POINTER) (* retransmission timeout based on  smoothed round trip time) (TCB.PROBE.TIMER POINTER) (* timer for delayed ACKs and window  probes) (TCB.IPSOCKET POINTER) (* Pointer to open IP socket for  this connection) (TCB.PROCESS POINTER) (* TCP monitor process for this  connection) (TCB.SENT.ZERO FLAG) (* Sent a zero allocation last time) (TCB.OUTPUT.HELD FLAG) (* True if output window shut) (TCB.NO.IDLE.PROBING FLAG) (* True if we don't probe when  nothing to output) (NIL BITS 5) (TCB.OUR.MAXSEG WORD) (TCB.LAST.SENT.RCV.WND WORD)(* The value of the last rcv window  we sent) ) TCB.LOCK _ (CREATE.MONITORLOCK) TCB.STATE _ 'CLOSED TCB.RCV.WND _ \TCP.DEFAULT.RECEIVE.WINDOW TCB.USER.TIMEOUT _ \TCP.DEFAULT.USER.TIMEOUT TCB.ESTABLISHED _ ( CREATE.EVENT ) TCB.SND.EVENT _ (CREATE.EVENT) TCB.RCV.EVENT _ (CREATE.EVENT) TCB.URGENT.EVENT _ (CREATE.EVENT) TCB.FINACKED.EVENT _ (CREATE.EVENT) TCB.MAXSEG _ \TCP.DEFAULT.MAXSEG TCB.OUR.MAXSEG _ \TCP.DEFAULT.MAXSEG TCB.SRTT _ \TCP.INITIAL.RTO TCB.RTO _ \TCP.INITIAL.RTO) (ACCESSFNS TCPSTREAM ((TCB (fetch (STREAM F1) of DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (BYTECOUNT (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE)) (ACCESS (fetch (STREAM ACCESS) of DATUM) (replace (STREAM ACCESS) of DATUM with NEWVALUE)) (ORIGINAL.COFFSET (fetch (STREAM FW6) of DATUM) (replace (STREAM FW6) of DATUM with NEWVALUE))) (CREATE (create STREAM DEVICE _ \TCP.DEVICE))) ) (/DECLAREDATATYPE 'TCP.CONTROL.BLOCK '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD FIXP POINTER POINTER FIXP FIXP FIXP FIXP FIXP FIXP WORD WORD FIXP FIXP FIXP POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG FLAG (BITS 5) WORD WORD) '((TCP.CONTROL.BLOCK 0 POINTER) (TCP.CONTROL.BLOCK 2 POINTER) (TCP.CONTROL.BLOCK 4 POINTER) (TCP.CONTROL.BLOCK 6 POINTER) (TCP.CONTROL.BLOCK 8 POINTER) (TCP.CONTROL.BLOCK 10 POINTER) (TCP.CONTROL.BLOCK 12 POINTER) (TCP.CONTROL.BLOCK 14 POINTER) (TCP.CONTROL.BLOCK 16 POINTER) (TCP.CONTROL.BLOCK 18 POINTER) (TCP.CONTROL.BLOCK 20 POINTER) (TCP.CONTROL.BLOCK 22 POINTER) (TCP.CONTROL.BLOCK 24 POINTER) (TCP.CONTROL.BLOCK 26 (BITS . 15)) (TCP.CONTROL.BLOCK 27 (BITS . 15)) (TCP.CONTROL.BLOCK 28 FIXP) (TCP.CONTROL.BLOCK 30 POINTER) (TCP.CONTROL.BLOCK 32 POINTER) (TCP.CONTROL.BLOCK 34 FIXP) (TCP.CONTROL.BLOCK 36 FIXP) (TCP.CONTROL.BLOCK 38 FIXP) (TCP.CONTROL.BLOCK 40 FIXP) (TCP.CONTROL.BLOCK 42 FIXP) (TCP.CONTROL.BLOCK 44 FIXP) (TCP.CONTROL.BLOCK 46 (BITS . 15)) (TCP.CONTROL.BLOCK 47 (BITS . 15)) (TCP.CONTROL.BLOCK 48 FIXP) (TCP.CONTROL.BLOCK 50 FIXP) (TCP.CONTROL.BLOCK 52 FIXP) (TCP.CONTROL.BLOCK 54 POINTER) (TCP.CONTROL.BLOCK 56 POINTER) (TCP.CONTROL.BLOCK 58 POINTER) (TCP.CONTROL.BLOCK 60 POINTER) (TCP.CONTROL.BLOCK 62 POINTER) (TCP.CONTROL.BLOCK 64 POINTER) (TCP.CONTROL.BLOCK 66 POINTER) (TCP.CONTROL.BLOCK 68 POINTER) (TCP.CONTROL.BLOCK 70 POINTER) (TCP.CONTROL.BLOCK 72 POINTER) (TCP.CONTROL.BLOCK 74 POINTER) (TCP.CONTROL.BLOCK 76 POINTER) (TCP.CONTROL.BLOCK 78 POINTER) (TCP.CONTROL.BLOCK 80 POINTER) (TCP.CONTROL.BLOCK 82 POINTER) (TCP.CONTROL.BLOCK 82 (FLAGBITS . 0)) (TCP.CONTROL.BLOCK 82 (FLAGBITS . 16)) (TCP.CONTROL.BLOCK 82 (FLAGBITS . 32)) (TCP.CONTROL.BLOCK 82 (BITS . 52)) (TCP.CONTROL.BLOCK 84 (BITS . 15)) (TCP.CONTROL.BLOCK 85 (BITS . 15))) '86) (* "END EXPORTED DEFINITIONS") ) (/DECLAREDATATYPE 'TCP.CONTROL.BLOCK '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD FIXP POINTER POINTER FIXP FIXP FIXP FIXP FIXP FIXP WORD WORD FIXP FIXP FIXP POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG FLAG (BITS 5) WORD WORD) '((TCP.CONTROL.BLOCK 0 POINTER) (TCP.CONTROL.BLOCK 2 POINTER) (TCP.CONTROL.BLOCK 4 POINTER) (TCP.CONTROL.BLOCK 6 POINTER) (TCP.CONTROL.BLOCK 8 POINTER) (TCP.CONTROL.BLOCK 10 POINTER) (TCP.CONTROL.BLOCK 12 POINTER) (TCP.CONTROL.BLOCK 14 POINTER) (TCP.CONTROL.BLOCK 16 POINTER) (TCP.CONTROL.BLOCK 18 POINTER) (TCP.CONTROL.BLOCK 20 POINTER) (TCP.CONTROL.BLOCK 22 POINTER) (TCP.CONTROL.BLOCK 24 POINTER) (TCP.CONTROL.BLOCK 26 (BITS . 15)) (TCP.CONTROL.BLOCK 27 (BITS . 15)) (TCP.CONTROL.BLOCK 28 FIXP) (TCP.CONTROL.BLOCK 30 POINTER) (TCP.CONTROL.BLOCK 32 POINTER) (TCP.CONTROL.BLOCK 34 FIXP) (TCP.CONTROL.BLOCK 36 FIXP) (TCP.CONTROL.BLOCK 38 FIXP) (TCP.CONTROL.BLOCK 40 FIXP) (TCP.CONTROL.BLOCK 42 FIXP) (TCP.CONTROL.BLOCK 44 FIXP) (TCP.CONTROL.BLOCK 46 (BITS . 15)) (TCP.CONTROL.BLOCK 47 (BITS . 15)) (TCP.CONTROL.BLOCK 48 FIXP) (TCP.CONTROL.BLOCK 50 FIXP) (TCP.CONTROL.BLOCK 52 FIXP) (TCP.CONTROL.BLOCK 54 POINTER) (TCP.CONTROL.BLOCK 56 POINTER) (TCP.CONTROL.BLOCK 58 POINTER) (TCP.CONTROL.BLOCK 60 POINTER) (TCP.CONTROL.BLOCK 62 POINTER) (TCP.CONTROL.BLOCK 64 POINTER) (TCP.CONTROL.BLOCK 66 POINTER) (TCP.CONTROL.BLOCK 68 POINTER) (TCP.CONTROL.BLOCK 70 POINTER) (TCP.CONTROL.BLOCK 72 POINTER) (TCP.CONTROL.BLOCK 74 POINTER) (TCP.CONTROL.BLOCK 76 POINTER) (TCP.CONTROL.BLOCK 78 POINTER) (TCP.CONTROL.BLOCK 80 POINTER) (TCP.CONTROL.BLOCK 82 POINTER) (TCP.CONTROL.BLOCK 82 (FLAGBITS . 0)) (TCP.CONTROL.BLOCK 82 (FLAGBITS . 16)) (TCP.CONTROL.BLOCK 82 (FLAGBITS . 32)) (TCP.CONTROL.BLOCK 82 (BITS . 52)) (TCP.CONTROL.BLOCK 84 (BITS . 15)) (TCP.CONTROL.BLOCK 85 (BITS . 15))) '86) (* ;; "global lock for TCP-related mutual exclusion") (RPAQ? \TCP.LOCK (CREATE.MONITORLOCK)) (* ;; "list of TCP control blocks for connection lookup") (RPAQ? \TCP.CONTROL.BLOCKS NIL) (DEFINEQ (\TCP.CREATE.TCB (LAMBDA (DST.HOST DST.PORT SRC.PORT MODE OUR.MAXSEG) (* ejs%: "27-May-86 14:39") (* create a new TCB and the input and output streams that go with it) (WITH.FAST.MONITOR \TCP.LOCK (PROG ((TCB (create TCP.CONTROL.BLOCK TCB.DST.HOST _ DST.HOST TCB.DST.PORT _ DST.PORT TCB.SRC.PORT _ (if (ZEROP SRC.PORT) then (\TCP.SELECT.PORT) else SRC.PORT) TCB.INPUT.QUEUE _ (create SYSQUEUE) TCB.REXMT.QUEUE _ (create SYSQUEUE) TCB.MODE _ MODE TCB.OUR.MAXSEG _ (OR OUR.MAXSEG \TCP.DEFAULT.MAXSEG)))) (replace (STREAM STRMBOUTFN) of (replace TCB.RCV.STREAM of TCB with (create TCPSTREAM ACCESS _ (QUOTE INPUT) TCB _ TCB BYTECOUNT _ 0)) with (FUNCTION \TCP.OTHER.BOUT)) (replace (STREAM STRMBINFN) of (replace TCB.SND.STREAM of TCB with (create TCPSTREAM ACCESS _ (QUOTE APPEND) TCB _ TCB BYTECOUNT _ 0)) with (FUNCTION \TCP.OTHER.BIN)) (\TCP.START.PROBE.TIMER TCB) (push \TCP.CONTROL.BLOCKS TCB) (* put it on the global list of TCBs so it can be found by \TCP.LOOKUP.TCB) (replace TCB.IPSOCKET of TCB with (\IP.OPEN.SOCKET \TCP.PROTOCOL TCB)) (* Tell IP about it) (RETURN TCB)))) ) (\TCP.SELECT.PORT (LAMBDA NIL (* ecc " 7-May-84 17:23") (* find a port unique among all TCP connections on this host) (PROG ((PORT (LOGAND (DAYTIME) 65535))) (until (for TCB in \TCP.CONTROL.BLOCKS always (NEQ PORT (fetch TCB.SRC.PORT of TCB))) do (add PORT 1)) (RETURN PORT))) ) (\TCP.LOOKUP.TCB (LAMBDA (DST.HOST DST.PORT SRC.PORT NOWILDCARDFLG) (* ejs%: "21-Mar-86 18:40") (* Find a TCB that matches the specified addresses. If NOWILDCARDFLG is non-NIL we match against a partially specified TCB if no fully specified one was found.) (WITH.FAST.MONITOR \TCP.LOCK (bind WILDCARD for TCB in \TCP.CONTROL.BLOCKS do (if (EQ SRC.PORT (fetch TCB.SRC.PORT of TCB)) then (* only check further if the local ports match) (if (AND (IEQP DST.HOST (fetch TCB.DST.HOST of TCB)) (EQ DST.PORT (fetch TCB.DST.PORT of TCB))) then (* a full match) (RETURN TCB) elseif (AND (NOT NOWILDCARDFLG) (NULL WILDCARD) (OR (ZEROP (fetch TCB.DST.HOST of TCB)) (IEQP DST.HOST (fetch TCB.DST.HOST of TCB))) (OR (ZEROP (fetch TCB.DST.PORT of TCB)) (EQ DST.PORT (fetch TCB.DST.PORT of TCB)))) then (* a wildcard match) (SETQ WILDCARD TCB))) finally (RETURN (if NOWILDCARDFLG then NIL else WILDCARD))))) ) (\TCP.DELETE.TCB [LAMBDA (TCB) (* ; "Edited 25-Aug-88 18:39 by bvm") (WITH.FAST.MONITOR \TCP.LOCK (\TCP.TRACE.TRANSITION TCB 'CLOSED) (replace TCB.STATE of TCB with 'CLOSED) (\FLUSH.PACKET.QUEUE (fetch TCB.INPUT.QUEUE of TCB)) (\FLUSH.PACKET.QUEUE (fetch TCB.REXMT.QUEUE of TCB)) (SETQ \TCP.CONTROL.BLOCKS (DREMOVE TCB \TCP.CONTROL.BLOCKS)) (\IP.CLOSE.SOCKET (fetch TCB.IPSOCKET of TCB) \TCP.PROTOCOL T) (replace TCB.IPSOCKET of TCB with NIL) [LET [(WHENCLOSEDFN (PROCESSPROP (THIS.PROCESS) 'WHENCLOSEDFN] (COND (WHENCLOSEDFN (CL:FUNCALL WHENCLOSEDFN (fetch TCB.RCV.STREAM of TCB) (fetch TCB.SND.STREAM of TCB] (* ; "break circular links") (replace TCB.SND.STREAM of TCB with NIL) (replace TCB.RCV.STREAM of TCB with NIL) (* ;  "wake up anyone waiting for events to occur") (NOTIFY.EVENT (fetch TCB.ESTABLISHED of TCB)) (NOTIFY.EVENT (fetch TCB.SND.EVENT of TCB)) (NOTIFY.EVENT (fetch TCB.RCV.EVENT of TCB)) (NOTIFY.EVENT (fetch TCB.URGENT.EVENT of TCB)) (NOTIFY.EVENT (fetch TCB.FINACKED.EVENT of TCB]) (\TCP.NOSOCKETFN (LAMBDA (IP) (* ejs%: " 1-Feb-86 18:12") (* * Called when no TCP port corresponding to IP packet is found. We try again, allowing for wildcards) (LET* ((PROTOCOLCHAIN (\IP.FIND.PROTOCOL \TCP.PROTOCOL \IP.PROTOCOLS)) (IPSOCKET (fetch (IPSOCKET IPSLINK) of PROTOCOLCHAIN))) (while IPSOCKET do (COND ((\TCP.PORTCOMPARE IP IPSOCKET T) (APPLY* (ffetch (IPSOCKET IPSINPUTFN) of IPSOCKET) IP IPSOCKET) (RETURN)) (T (SETQ IPSOCKET (fetch (IPSOCKET IPSLINK) of IPSOCKET)))) finally (COND ((NOT (BITTEST (fetch TCP.CTRL of IP) \TCP.CTRL.RST)) (COND ((BITTEST (fetch TCP.CTRL of IP) \TCP.CTRL.ACK) (\TCP.SEND.RESET IP (fetch TCP.ACK of IP) 0 \TCP.CTRL.RST)) (T (\TCP.SEND.RESET IP 0 (IPLUS (fetch TCP.SEQ of IP) (fetch TCP.DATA.LENGTH of IP)) (LOGOR \TCP.CTRL.ACK \TCP.CTRL.RST))))) (T (\RELEASE.ETHERPACKET IP)))))) ) (\TCP.PORTCOMPARE (LAMBDA (SEGMENT IPSOCKET WILDCARDFLG) (* ejs%: "13-Apr-85 17:44") (* Find a TCB that matches the specified addresses. If NOWILDCARDFLG is non-NIL we match against a partially specified TCB if no fully specified one was found.) (WITH.FAST.MONITOR \TCP.LOCK (PROG ((DST.HOST (fetch (TCPSEGMENT TCP.SRC.ADDR) of SEGMENT)) (DST.PORT (fetch (TCPSEGMENT TCP.SRC.PORT) of SEGMENT)) (SRC.PORT (fetch (TCPSEGMENT TCP.DST.PORT) of SEGMENT)) (TCB (fetch (IPSOCKET IPSOCKET) of IPSOCKET))) (COND ((AND TCB (EQ SRC.PORT (fetch TCB.SRC.PORT of TCB))) (* only check further if the local ports match) (COND ((AND (IEQP DST.HOST (fetch TCB.DST.HOST of TCB)) (EQ DST.PORT (fetch TCB.DST.PORT of TCB))) (* a full match) (RETURN IPSOCKET)) ((AND WILDCARDFLG (OR (ZEROP (fetch TCB.DST.HOST of TCB)) (IEQP DST.HOST (fetch TCB.DST.HOST of TCB))) (OR (ZEROP (fetch TCB.DST.PORT of TCB)) (EQ DST.PORT (fetch TCB.DST.PORT of TCB)))) (* a wildcard match) (RETURN IPSOCKET)))))))) ) ) (* ;; "TCP checksums") (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (DATATYPE TCP.PSEUDOHEADER ((PH.SRC.ADDR FIXP) (PH.DST.ADDR FIXP) (NIL BYTE) (PH.PROTOCOL BYTE) (PH.LENGTH WORD)) PH.PROTOCOL _ \TCP.PROTOCOL) ) (/DECLAREDATATYPE 'TCP.PSEUDOHEADER '(FIXP FIXP BYTE BYTE WORD) '((TCP.PSEUDOHEADER 0 FIXP) (TCP.PSEUDOHEADER 2 FIXP) (TCP.PSEUDOHEADER 4 (BITS . 7)) (TCP.PSEUDOHEADER 4 (BITS . 135)) (TCP.PSEUDOHEADER 5 (BITS . 15))) '6) (DECLARE%: EVAL@COMPILE (RPAQQ \TCP.PSEUDOHEADER.LENGTH 12) (CONSTANTS \TCP.PSEUDOHEADER.LENGTH) ) (DECLARE%: EVAL@COMPILE [PUTPROPS \16BIT.COMPLEMENT MACRO ((X) (LOGXOR X (MASK.1'S 0 16] [PUTPROPS \16BIT.1C.PLUS MACRO ((X Y) (* compute the one's complement sum of X and Y without creating FIXP boxes --  the sum modulo |2^16| plus an end-around carry) (PROG ((DELTA (IDIFFERENCE MAX.SMALLP Y))) (RETURN (if (ILEQ X DELTA) then (IPLUS X Y) else (IDIFFERENCE X DELTA] ) ) (/DECLAREDATATYPE 'TCP.PSEUDOHEADER '(FIXP FIXP BYTE BYTE WORD) '((TCP.PSEUDOHEADER 0 FIXP) (TCP.PSEUDOHEADER 2 FIXP) (TCP.PSEUDOHEADER 4 (BITS . 7)) (TCP.PSEUDOHEADER 4 (BITS . 135)) (TCP.PSEUDOHEADER 5 (BITS . 15))) '6) (RPAQ? \TCP.PSEUDOHEADER NIL) (* ;; "this variable controls whether checksums are performed on incoming segments") (RPAQ? \TCP.CHECKSUMS.ON NIL) (* ;; "checksum routines") (DEFINEQ (\COMPUTE.CHECKSUM (LAMBDA (BASE LENGTH DONTCOMPLEMENTFLG) (* ecc "25-May-84 18:47") (* TCP/IP protocol checksum is the 16-bit 1's complement of the 1's complement sum of the 16-bit words) (PROG ((CHECKSUM 0) (N (SUB1 (LRSH LENGTH 1)))) (for I from 0 to N do (SETQ CHECKSUM (\16BIT.1C.PLUS CHECKSUM (\GETBASE BASE I)))) (if (ODDP LENGTH) then (* if LENGTH is odd, the last byte must be padded on the right by a zero byte) (SETQ CHECKSUM (\16BIT.1C.PLUS CHECKSUM (LLSH (\GETBASEBYTE BASE (SUB1 LENGTH)) 8)))) (RETURN (if DONTCOMPLEMENTFLG then (* if DONTCOMPLEMENTFLG is non-NIL just return the 1's complement sum) CHECKSUM else (\16BIT.COMPLEMENT CHECKSUM))))) ) (\TCP.CHECKSUM.INCOMING (LAMBDA (SEGMENT) (* ecc "16-May-84 11:53") (* computes the TCP checksum and returns T or NIL depending on whether it matches the checksum in the header) (PROG ((LENGTH (IPLUS (fetch TCP.HEADER.LENGTH of SEGMENT) (\TCP.DATA.LENGTH SEGMENT))) (SEGMENT.CHECKSUM (fetch TCP.CHECKSUM of SEGMENT)) CHECKSUM OK) (WITH.FAST.MONITOR \TCP.LOCK (* need to lock this because we're using \TCP.PSEUDOHEADER) (replace PH.SRC.ADDR of \TCP.PSEUDOHEADER with (fetch TCP.SRC.ADDR of SEGMENT)) (replace PH.DST.ADDR of \TCP.PSEUDOHEADER with (fetch TCP.DST.ADDR of SEGMENT)) (replace PH.LENGTH of \TCP.PSEUDOHEADER with LENGTH) (replace TCP.CHECKSUM of SEGMENT with 0) (* checksum field must be 0 while we are computing checksum) (SETQ CHECKSUM (\16BIT.COMPLEMENT (\16BIT.1C.PLUS (\COMPUTE.CHECKSUM \TCP.PSEUDOHEADER \TCP.PSEUDOHEADER.LENGTH T) (\COMPUTE.CHECKSUM (fetch TCPHEADER of SEGMENT) LENGTH T))))) (SETQ OK (EQ CHECKSUM SEGMENT.CHECKSUM)) (if (AND (NOT OK) (MEMB (QUOTE CHECKSUM) TCPTRACEFLG)) then (printout TCPTRACEFILE .TAB0 0 "[bad checksum " CHECKSUM "]" T)) (RETURN OK))) ) (\TCP.CHECKSUM.OUTGOING (LAMBDA (TCB SEGMENT) (* ecc "16-May-84 11:53") (* compute checksum and place in header) (PROG ((LENGTH (IPLUS (fetch TCP.HEADER.LENGTH of SEGMENT) (\TCP.DATA.LENGTH SEGMENT))) (PH (if TCB then (fetch TCB.PH of TCB) else \TCP.PSEUDOHEADER))) (WITH.FAST.MONITOR \TCP.LOCK (* need to lock this in case we're using \TCP.PSEUDOHEADER) (replace PH.SRC.ADDR of PH with (fetch TCP.SRC.ADDR of SEGMENT)) (replace PH.DST.ADDR of PH with (fetch TCP.DST.ADDR of SEGMENT)) (replace PH.LENGTH of PH with LENGTH) (replace TCP.CHECKSUM of SEGMENT with 0) (* checksum field must be 0 while we are computing checksum) (replace TCP.CHECKSUM of SEGMENT with (\16BIT.COMPLEMENT (\16BIT.1C.PLUS (\COMPUTE.CHECKSUM PH \TCP.PSEUDOHEADER.LENGTH T) (\COMPUTE.CHECKSUM (fetch TCPHEADER of SEGMENT) LENGTH T))))))) ) ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (RPAQQ \TCP.INITIAL.RTO 1000) (CONSTANTS \TCP.INITIAL.RTO) ) (DECLARE%: EVAL@COMPILE (RPAQQ \TCP.UBOUND 5000) (RPAQQ \TCP.LBOUND 1000) (CONSTANTS (\TCP.UBOUND 5000) (\TCP.LBOUND 1000)) ) ) (* ;; "maximum segment lifetime") (RPAQ? \TCP.MSL 5000) (RPAQ? \TCP.DEFAULT.USER.TIMEOUT 60000) (RPAQ? \TCP.DEFAULT.RECEIVE.WINDOW 4096) (RPAQ? \TCP.DEVICE NIL) (* ;; "TCP protocol routines") (DEFINEQ (\TCP.ACK# (LAMBDA (TCB) (* ejs%: " 7-Jun-85 13:18") (* * Returns the byte id for the next ACK) (* (LET* ((STREAM (fetch TCB.RCV.STREAM of TCB)) (BUFFER (fetch TCB.RCV.SEGMENT of TCB))) (COND (BUFFER (IPLUS (fetch TCP.SEQ of BUFFER) (fetch (STREAM COFFSET) of STREAM))) ((SETQ BUFFER (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB))) (IMIN (fetch TCB.RCV.NXT of TCB) (fetch TCP.SEQ of BUFFER))) (T (fetch TCB.RCV.NXT of TCB))))) (fetch TCB.RCV.NXT of TCB)) ) (\TCP.PACKET.FILTER (LAMBDA (SEGMENT PROTOCOL) (* ecc " 7-May-84 17:27") (* packet filter used by IP code to dispatch packets by protocol) (SELECTC PROTOCOL (\TCP.PROTOCOL (ERSETQ (\TCP.INPUT SEGMENT)) T) (\ICMP.PROTOCOL (ERSETQ (\TCP.HANDLE.ICMP SEGMENT)) T) NIL)) ) (\TCP.SETUP.SEGMENT (LAMBDA (SRC.HOST SRC.PORT DST.HOST DST.PORT) (* ejs%: " 1-Jan-01 10:28") (* allocate a new TCP segment and set up its header) (PROG ((SEGMENT (\IP.SETUPIP (\ALLOCATE.ETHERPACKET) DST.HOST NIL \TCP.MASTER.SOCKET (QUOTE FREE)))) (add (fetch (IP IPTOTALLENGTH) of SEGMENT) \TCP.HEADER.LENGTH) (replace TCP.SRC.PORT of SEGMENT with SRC.PORT) (replace TCP.DST.PORT of SEGMENT with DST.PORT) (replace TCP.DATA.OFFSET of SEGMENT with \TCP.MIN.DATA.OFFSET) (replace TCP.MBZ of SEGMENT with 0) (RETURN SEGMENT))) ) (\TCP.RELEASE.SEGMENT (LAMBDA (SEGMENT) (* ecc " 7-May-84 17:28") (* release a TCP segment -- it had better not be on anyone's queue) (CHECK (OR (NULL (fetch QLINK of SEGMENT)) (SHOULDNT "releasing queued segment"))) (\RELEASE.ETHERPACKET SEGMENT)) ) (\TCP.CONNECTION (LAMBDA (DST.HOST DST.PORT SRC.PORT MODE OPTIONS) (* ; "Edited 23-May-88 19:14 by Snow") (* ;; "open a TCP connection and return the TCB or NIL if the connection fails") (PROG (SPECIFIED TCB ISS TCP.PROCESS) (SELECTQ MODE (ACTIVE) (PASSIVE) (ERROR "TCP open mode must be ACTIVE or PASSIVE")) (if (NULL DST.HOST) then (SETQ DST.HOST 0)) (if (NULL DST.PORT) then (SETQ DST.PORT 0)) (if (NULL SRC.PORT) then (SETQ SRC.PORT 0)) (SETQ SPECIFIED (NOT (OR (ZEROP DST.HOST) (ZEROP DST.PORT)))) (if (AND (EQ MODE (QUOTE ACTIVE)) (NOT SPECIFIED)) then (ERROR "foreign socket unspecified")) (* ;; "Check for conflict with existing connections. ACTIVE open only conflicts with other fully specified connections. PASSIVE open conflicts with fully specified connections if the open is fully specifed, and with partially specified connections if the open is partially specified") (if (SETQ TCB (OR (AND (OR (EQ MODE (QUOTE ACTIVE)) SPECIFIED) (\TCP.LOOKUP.TCB DST.HOST DST.PORT SRC.PORT T)) (AND (EQ MODE (QUOTE PASSIVE)) (NOT SPECIFIED) (SETQ TCB (\TCP.LOOKUP.TCB DST.HOST DST.PORT SRC.PORT NIL)) (OR (ZEROP (fetch TCB.DST.HOST of TCB)) (ZEROP (fetch TCB.DST.PORT of TCB))) TCB))) then (COND ((type? TCP.CONTROL.BLOCK TCB) (COND ((FMEMB (fetch TCB.STATE of TCB) (QUOTE (CLOSED CLOSE.WAIT TIME.WAIT FIN.WAIT.1 FIN.WAIT.2))) (\TCP.DELETE.TCB TCB)) (T (ERROR "TCP connection already exists")))) (T (ERROR "TCP connection already exists")))) (SETQ TCB (\TCP.CREATE.TCB DST.HOST DST.PORT SRC.PORT MODE (OR (LISTGET OPTIONS (QUOTE MAXSEG)) \TCP.DEFAULT.MAXSEG))) (replace TCB.NO.IDLE.PROBING of TCB with (LISTGET OPTIONS (QUOTE NO.IDLE.PROBING))) (SELECTQ MODE (ACTIVE (WITH.MONITOR \TCP.LOCK (SETQ ISS (\TCP.SELECT.ISS)) (replace TCB.ISS of TCB with ISS)) (\TCP.TEMPLATE TCB (COND ((LISTGET OPTIONS (QUOTE MAXSEG)) OPTIONS) (T (APPEND OPTIONS (BQUOTE (MAXSEG %, \TCP.DEFAULT.MAXSEG)))))) (replace TCB.SND.UNA of TCB with ISS) (replace TCB.SND.NXT of TCB with ISS) (replace TCB.SND.UP of TCB with ISS) (\TCP.TRACE.TRANSITION TCB (QUOTE SYN.SENT)) (replace TCB.STATE of TCB with (QUOTE SYN.SENT)) (SETQ TCP.PROCESS (ADD.PROCESS (BQUOTE (\TCP.PROCESS %, TCB)) (QUOTE NAME) (QUOTE TCP) (QUOTE WHENCLOSEDFN) (LISTGET OPTIONS (QUOTE WHENCLOSEDFN)))) (* ; "initiate the three-way handshake to establish the connection") (\TCP.FLUSH (fetch TCB.SND.STREAM of TCB) \TCP.CTRL.SYN) (* ; "wait until established") (WITH.MONITOR (fetch TCB.LOCK of TCB) (RESETLST (RESETSAVE NIL (BQUOTE (AND RESETSTATE (DEL.PROCESS %, TCP.PROCESS)))) (until (NEQ (fetch TCB.STATE of TCB) (QUOTE SYN.SENT)) do (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB) (fetch TCB.ESTABLISHED of TCB)))))) (PASSIVE (\TCP.TRACE.TRANSITION TCB (QUOTE LISTEN)) (replace TCB.STATE of TCB with (QUOTE LISTEN)) (SETQ TCP.PROCESS (ADD.PROCESS (BQUOTE (\TCP.PROCESS %, TCB)) (QUOTE NAME) (QUOTE TCP) (QUOTE WHENCLOSEDFN) (LISTGET OPTIONS (QUOTE WHENCLOSEDFN)))) (* ; "wait until established") (WITH.MONITOR (fetch TCB.LOCK of TCB) (RESETLST (RESETSAVE NIL (BQUOTE (AND RESETSTATE (DEL.PROCESS %, TCP.PROCESS)))) (until (NEQ (fetch TCB.STATE of TCB) (QUOTE LISTEN)) do (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB) (fetch TCB.ESTABLISHED of TCB)))))) (SHOULDNT)) (RETURN (if (NEQ (fetch TCB.STATE of TCB) (QUOTE CLOSED)) then TCB else NIL)))) ) (\TCP.FIX.INCOMING.SEGMENT (LAMBDA (SEGMENT FLAGS) (* ecc "16-May-84 11:56") (PROG NIL (if (AND (BITTEST FLAGS \TCP.CTRL.SYN) (BITTEST FLAGS \TCP.CTRL.FIN)) then (RETURN NIL)) (* calculate the length of the segment data and place it in a fixed position in the header for fast access -- note that the TCP.DATA.LENGTH field isn't a true part of the TCP header; it overlays the IP level checksum which is no longer needed) (replace TCP.DATA.LENGTH of SEGMENT with (\TCP.DATA.LENGTH SEGMENT)) (* return T or NIL depending on whether checksum is correct) (RETURN (OR (NOT \TCP.CHECKSUMS.ON) (\TCP.CHECKSUM.INCOMING SEGMENT))))) ) (\TCP.DATA.LENGTH (LAMBDA (SEGMENT) (* ejs%: "21-Jun-85 17:04") (* data length = total segment length - (IP header length + TCP header length)) (IDIFFERENCE (fetch (IP IPTOTALLENGTH) of SEGMENT) (IPLUS (UNFOLD (fetch (IP IPHEADERLENGTH) of SEGMENT) BYTESPERCELL) (UNFOLD (fetch TCP.DATA.OFFSET of SEGMENT) BYTESPERCELL)))) ) (\TCP.SYN.OR.FIN (LAMBDA (FLAGS NOERRORFLG) (* ecc " 1-May-84 17:10") (* SYN and FIN occupy sequence number space so we have to include them in the "length" of the segment) (SELECTC (LOGAND FLAGS (LOGOR \TCP.CTRL.SYN \TCP.CTRL.FIN)) (0 0) (\TCP.CTRL.SYN 1) (\TCP.CTRL.FIN 1) (if NOERRORFLG then 0 else (SHOULDNT "both SYN and FIN")))) ) (\TCP.INPUT (LAMBDA (SEGMENT TCB) (* ejs%: "20-Jun-85 13:06") (* handle an incoming TCP segment -- pages |65-76| of RFC 793) (PROG ((SEQ (fetch TCP.SEQ of SEGMENT)) (ACK (fetch TCP.ACK of SEGMENT)) (FLAGS (fetch TCP.CTRL of SEGMENT)) UNA QUEUEDFLG) (if (NOT (\TCP.INPUT.INITIAL TCB SEGMENT SEQ ACK FLAGS)) then (\TCP.RELEASE.SEGMENT SEGMENT) (RETURN)) (WITH.MONITOR (fetch TCB.LOCK of TCB) (PROG NIL (* handle unsynchronized states) (if (NOT (\TCP.INPUT.UNSYNC TCB SEGMENT SEQ ACK FLAGS)) then (GO DROPIT)) (* first check sequence number) (if (NOT (\TCP.CHECK.WINDOW TCB SEGMENT FLAGS)) then (GO DROPIT)) (* second check the RST bit) (if (NOT (\TCP.CHECK.RESET TCB SEGMENT SEQ ACK FLAGS)) then (GO DROPIT)) (* third check security and precedence) (if (NOT (\TCP.CHECK.SECURITY TCB SEGMENT FLAGS)) then (GO DROPIT)) (* fourth check the SYN bit) (if (NOT (\TCP.CHECK.NO.SYN TCB SEGMENT FLAGS)) then (GO DROPIT)) (if (NOT (\TCP.CHECK.OPTIONS TCB SEGMENT FLAGS)) then (GO DROPIT)) (* fifth check the ACK field) (if (NOT (\TCP.CHECK.ACK TCB SEGMENT FLAGS)) then (GO DROPIT)) (if (EQ (fetch TCB.STATE of TCB) (QUOTE SYN.RECEIVED)) then (if (AND (\32BIT.LEQ (fetch TCB.SND.UNA of TCB) ACK) (\32BIT.LEQ ACK (fetch TCB.SND.NXT of TCB))) then (* our SYN has been acked) (\TCP.TRACE.TRANSITION TCB (QUOTE ESTABLISHED)) (replace TCB.STATE of TCB with (QUOTE ESTABLISHED)) (replace TCB.DST.HOST of TCB with (fetch (TCPSEGMENT TCP.SRC.ADDR) of SEGMENT)) (replace TCB.DST.PORT of TCB with (fetch (TCPSEGMENT TCP.SRC.PORT) of SEGMENT)) (NOTIFY.EVENT (fetch TCB.ESTABLISHED of TCB)) (* continue processing in ESTABLISHED state) else (\TCP.SEND.CONTROL TCB ACK NIL \TCP.CTRL.RST) (GO DROPIT))) (if (NOT (\TCP.HANDLE.ACK TCB SEGMENT SEQ ACK FLAGS)) then (GO DROPIT)) (SELECTQ (fetch TCB.STATE of TCB) (FIN.WAIT.1 (if (\TCP.OUR.FIN.IS.ACKED TCB) then (\TCP.TRACE.TRANSITION TCB (QUOTE FIN.WAIT.2)) (replace TCB.STATE of TCB with (QUOTE FIN.WAIT.2)) (NOTIFY.EVENT (fetch TCB.FINACKED.EVENT of TCB)))) ((ESTABLISHED FIN.WAIT.2 CLOSE.WAIT) NIL) (CLOSING (if (\TCP.OUR.FIN.IS.ACKED TCB) then (\TCP.START.TIME.WAIT TCB) (NOTIFY.EVENT (fetch TCB.FINACKED.EVENT of TCB)) else (GO DROPIT))) (LAST.ACK (if (\TCP.OUR.FIN.IS.ACKED TCB) then (\TCP.TRACE.TRANSITION TCB (QUOTE CLOSED)) (replace TCB.STATE of TCB with (QUOTE CLOSED)) (NOTIFY.EVENT (fetch TCB.FINACKED.EVENT of TCB)) (RETURN) else (GO DROPIT))) (TIME.WAIT (\TCP.SEND.ACK TCB) (GO DROPIT)) (SHOULDNT)) (* sixth check the URG bit) (\TCP.HANDLE.URG TCB SEGMENT SEQ ACK FLAGS) (* seventh process the segment text) (SELECTQ (fetch TCB.STATE of TCB) ((ESTABLISHED FIN.WAIT.1 FIN.WAIT.2) (SETQ QUEUEDFLG (\TCP.QUEUE.INPUT TCB SEGMENT SEQ))) ((CLOSE.WAIT CLOSING LAST.ACK TIME.WAIT)) (SHOULDNT)) (* eighth check the FIN bit) (\TCP.HANDLE.FIN TCB SEGMENT SEQ ACK FLAGS) (if QUEUEDFLG then (RETURN)) DROPIT (\TCP.RELEASE.SEGMENT SEGMENT))))) ) (\TCP.INPUT.INITIAL (LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 17:27") (* handle segment for non-existent TCB -- page 65 of RFC 793) (PROG NIL (\TCP.TRACE.SEGMENT (QUOTE RECV) SEGMENT) (if (NOT (\TCP.FIX.INCOMING.SEGMENT SEGMENT FLAGS)) then (* bad checksum) (RETURN NIL)) (if (OR (NULL TCB) (EQ (fetch TCB.STATE of TCB) (QUOTE CLOSED))) then (* an incoming segment not containing a RST causes a RST to be sent in response) (if TCPTRACEFLG then (printout TCPTRACEFILE .TAB0 0 "[no such TCP connection]")) (if (NOT (BITTEST FLAGS \TCP.CTRL.RST)) then (* send a RST) (if (BITTEST FLAGS \TCP.CTRL.ACK) then (\TCP.SEND.RESET SEGMENT ACK) else (\TCP.SEND.RESET SEGMENT 0 (IPLUS SEQ (fetch TCP.DATA.LENGTH of SEGMENT) (\TCP.SYN.OR.FIN FLAGS))))) (RETURN NIL)) (RETURN T))) ) (\TCP.INPUT.UNSYNC (LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ejs%: "21-Mar-86 20:03") (* handle segment for TCB in LISTEN or SYN.SENT state -- pages |65-68| of RFC 793) (SELECTQ (fetch TCB.STATE of TCB) (LISTEN (\TCP.INPUT.LISTEN TCB SEGMENT SEQ ACK FLAGS) NIL) (SYN.SENT (\TCP.INPUT.SYN.SENT TCB SEGMENT SEQ ACK FLAGS) (\TCP.CHECK.OPTIONS TCB SEGMENT FLAGS) NIL) T)) ) (\TCP.INPUT.LISTEN (LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ejs%: "22-Jun-85 03:14") (* handle segment for TCB in LISTEN state -- pages |65-66| of RFC 793) (PROG (ISS) (* first check for a RST) (if (BITTEST FLAGS \TCP.CTRL.RST) then (RETURN NIL)) (* second check for an ACK) (if (BITTEST FLAGS \TCP.CTRL.ACK) then (* any acknowledgment is bad if it arrives on a connection still in the LISTEN state) (\TCP.SEND.RESET SEGMENT ACK) (RETURN NIL)) (* third check for a SYN) (if (BITTEST FLAGS \TCP.CTRL.SYN) then (if (NOT (\TCP.CHECK.SECURITY TCB SEGMENT FLAGS)) then (RETURN NIL)) (replace TCB.RCV.NXT of TCB with (ADD1 SEQ)) (replace TCB.IRS of TCB with SEQ) (SETQ ISS (\TCP.SELECT.ISS)) (replace TCB.ISS of TCB with ISS) (replace TCB.SND.NXT of TCB with ISS) (replace TCB.SND.UNA of TCB with ISS) (replace TCB.SND.UP of TCB with ISS) (\TCP.TRACE.TRANSITION TCB (QUOTE SYN.RECEIVED)) (replace TCB.STATE of TCB with (QUOTE SYN.RECEIVED)) (* fill in foreign socket in case it was only partially specified) (replace TCB.DST.HOST of TCB with (fetch TCP.SRC.ADDR of SEGMENT)) (replace TCB.DST.PORT of TCB with (fetch TCP.SRC.PORT of SEGMENT)) (\TCP.TEMPLATE TCB) (* send a SYN, ACK segment using \TCP.FLUSH because SYN occupies sequence number space) (\TCP.FLUSH (fetch TCB.SND.STREAM of TCB) \TCP.CTRL.SYN) (* NOTE%: we never queue data that arrives in a SYN segment, we just ACK the SYN and require the data to be retransmitted)) (RETURN NIL))) ) (\TCP.INPUT.SYN.SENT (LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 12:13") (* handle segment for TCB in SYN.SENT state -- pages |66-68| of RFC 793) (PROG NIL (* first check the ACK bit) (if (BITTEST FLAGS \TCP.CTRL.ACK) then (if (OR (\32BIT.LEQ ACK (fetch TCB.ISS of TCB)) (\32BIT.GT ACK (fetch TCB.SND.NXT of TCB))) then (* ACK is unacceptable) (if (NOT (BITTEST FLAGS \TCP.CTRL.RST)) then (\TCP.SEND.CONTROL TCB ACK NIL \TCP.CTRL.RST)) (RETURN NIL))) (* second check the RST bit) (if (BITTEST FLAGS \TCP.CTRL.RST) then (if (BITTEST FLAGS \TCP.CTRL.ACK) then (* if the ACK was acceptable then signal the user) (\TCP.CONNECTION.DROPPED TCB "reset")) (RETURN NIL)) (* third check the security and precedence) (if (NOT (\TCP.CHECK.SECURITY TCB SEGMENT FLAGS)) then (RETURN NIL)) (* fourth check the SYN bit) (if (BITTEST FLAGS \TCP.CTRL.SYN) then (replace TCB.RCV.NXT of TCB with (ADD1 SEQ)) (replace TCB.IRS of TCB with SEQ) (if (AND (BITTEST FLAGS \TCP.CTRL.ACK) (\32BIT.GEQ ACK (fetch TCB.SND.UNA of TCB))) then (* new ACK information) (replace TCB.SND.UNA of TCB with ACK)) (replace TCP.CTRL of SEGMENT with (SETQ FLAGS (BITCLEAR FLAGS \TCP.CTRL.SYN))) (if (\32BIT.GT (fetch TCB.SND.UNA of TCB) (fetch TCB.ISS of TCB)) then (* our SYN has been acked) (\TCP.TRACE.TRANSITION TCB (QUOTE ESTABLISHED)) (replace TCB.STATE of TCB with (QUOTE ESTABLISHED)) (* send an ACK segment) (\TCP.SEND.ACK TCB (QUOTE NOW)) (NOTIFY.EVENT (fetch TCB.ESTABLISHED of TCB)) else (* we can just let our original SYN segment be retransmitted) (\TCP.TRACE.TRANSITION TCB (QUOTE SYN.RECEIVED)) (replace TCB.STATE of TCB with (QUOTE SYN.RECEIVED)) (* send an ACK segment) (\TCP.SEND.ACK TCB (QUOTE NOW))) (* NOTE%: we never queue data that arrives in a SYN segment, we just ACK the SYN and require the data to be retransmitted)) (* drop the segment and return) (RETURN NIL))) ) (\TCP.CHECK.WINDOW (LAMBDA (TCB SEGMENT FLAGS) (* ecc "16-May-84 16:29") (* check segment length against receive window -- page 69 of RFC 793) (PROG ((LEN (fetch TCP.DATA.LENGTH of SEGMENT)) (SEQ (fetch TCP.SEQ of SEGMENT)) (RCV.NXT (fetch TCB.RCV.NXT of TCB)) (WND (fetch TCB.RCV.WND of TCB)) TOP) (SETQ TOP (IPLUS SEQ LEN (\TCP.SYN.OR.FIN FLAGS))) (if (ZEROP LEN) then (if (ZEROP WND) then (if (\32BIT.EQ SEQ RCV.NXT) then (RETURN T)) else (if (AND (\32BIT.LEQ RCV.NXT SEQ) (\32BIT.LT SEQ (IPLUS RCV.NXT WND))) then (RETURN T))) else (if (NOT (ZEROP WND)) then (if (OR (AND (\32BIT.LEQ RCV.NXT SEQ) (\32BIT.LT SEQ (IPLUS RCV.NXT WND))) (AND (\32BIT.LT RCV.NXT TOP) (\32BIT.LEQ TOP (IPLUS RCV.NXT WND)))) then (RETURN T)))) (if (NOT (BITTEST FLAGS \TCP.CTRL.RST)) then (* send an ACK in reply) (\TCP.SEND.ACK TCB (QUOTE NOW))) (RETURN NIL))) ) (\TCP.CHECK.RESET (LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 12:07") (* check the RST bit -- page 70 of RFC 793) (PROG NIL (if (BITTEST FLAGS \TCP.CTRL.RST) then (SELECTQ (fetch TCB.STATE of TCB) (SYN.RECEIVED (if (EQ (fetch TCB.MODE of TCB) (QUOTE PASSIVE)) then (\TCP.TRACE.TRANSITION TCB (QUOTE LISTEN)) (replace TCB.STATE of TCB with (QUOTE LISTEN)) else (\TCP.CONNECTION.DROPPED TCB "refused")) (\FLUSH.PACKET.QUEUE (fetch TCB.REXMT.QUEUE of TCB)) (\TCP.SEND.CONTROL TCB ACK NIL \TCP.CTRL.RST)) ((ESTABLISHED FIN.WAIT.1 FIN.WAIT.2 CLOSE.WAIT) (\TCP.CONNECTION.DROPPED TCB "reset")) ((CLOSING LAST.ACK TIME.WAIT) (\TCP.TRACE.TRANSITION TCB (QUOTE CLOSED)) (replace TCB.STATE of TCB with (QUOTE CLOSED))) (SHOULDNT)) (RETURN NIL) else (RETURN T)))) ) (\TCP.CHECK.SECURITY (LAMBDA (TCB SEGMENT FLAGS) (* ecc "16-May-84 12:06") (* returns T or NIL depending on whether security and precedence are OK; sends RST if necessary) (* not implemented) T) ) (\TCP.CHECK.NO.SYN (LAMBDA (TCB SEGMENT FLAGS) (* ecc "16-May-84 12:07") (* check the SYN bit -- page 71 of RFC 793) (PROG NIL (CHECK (OR (NOT (BITTEST FLAGS \TCP.CTRL.RST)) (SHOULDNT "RST bit set"))) (if (NOT (BITTEST FLAGS \TCP.CTRL.SYN)) then (RETURN T)) (if (BITTEST FLAGS \TCP.CTRL.ACK) then (\TCP.SEND.CONTROL TCB (fetch TCP.ACK of SEGMENT) NIL \TCP.CTRL.RST) else (\TCP.SEND.CONTROL TCB 0 (IPLUS (fetch TCP.ACK of SEGMENT) (fetch TCP.DATA.LENGTH of SEGMENT) 1) (LOGOR \TCP.CTRL.ACK \TCP.CTRL.RST))) (\TCP.CONNECTION.DROPPED TCB "reset") (RETURN NIL))) ) (\TCP.CHECK.ACK (LAMBDA (TCB SEGMENT FLAGS) (* ecc "16-May-84 12:08") (* check the ACK field -- page 72 of RFC 793) (PROG NIL (CHECK (OR (NOT (BITTEST FLAGS (LOGOR \TCP.CTRL.SYN \TCP.CTRL.RST))) (SHOULDNT "SYN or RST bit set"))) (RETURN (BITTEST FLAGS \TCP.CTRL.ACK)))) ) (\TCP.HANDLE.ACK (LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ejs%: "22-Jun-85 00:35") (* ACK processing -- pages |72-73| of RFC 793) (PROG (EVENT) (if (\32BIT.GT ACK (fetch TCB.SND.NXT of TCB)) then (* this segment acks something we haven't sent yet) (\TCP.SEND.ACK TCB (QUOTE NOW)) (RETURN NIL)) (if (AND (fetch TCB.RTFLG of TCB) (\32BIT.GT ACK (fetch TCB.RTSEQ of TCB))) then (* calculate smoothed round trip time) (replace TCB.RTFLG of TCB with NIL) (replace TCB.SRTT of TCB with (FOLDLO (PLUS (ITIMES 7 (fetch TCB.SRTT of TCB)) (CLOCKDIFFERENCE (fetch TCB.RTTIMER of TCB))) 8)) (replace TCB.RTTIMER of TCB with (SETUPTIMER 0 (fetch TCB.RTTIMER of TCB))) (replace TCB.RTO of TCB with (IMIN \TCP.UBOUND (IMAX \TCP.LBOUND (FOLDLO (ITIMES 3 (fetch TCB.SRTT of TCB)) 2))))) (if (\32BIT.GT ACK (fetch TCB.SND.UNA of TCB)) then (* new ACK information) (replace TCB.SND.UNA of TCB with ACK) (SETQ EVENT T)) (if (OR (\32BIT.GT SEQ (fetch TCB.SND.WL1 of TCB)) (AND (\32BIT.EQ SEQ (fetch TCB.SND.WL1 of TCB)) (\32BIT.GEQ ACK (fetch TCB.SND.WL2 of TCB)))) then (* update send window) (replace TCB.SND.WND of TCB with (fetch TCP.WINDOW of SEGMENT)) (replace TCB.SND.WL1 of TCB with SEQ) (replace TCB.SND.WL2 of TCB with ACK) (SETQ EVENT T)) (if EVENT then (NOTIFY.EVENT (fetch TCB.SND.EVENT of TCB))) (RETURN T))) ) (\TCP.HANDLE.URG (LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 12:10") (* check the URG bit -- pages |73-74| of RFC 793) (PROG (UP) (if (BITTEST FLAGS \TCP.CTRL.URG) then (SELECTQ (fetch TCB.STATE of TCB) ((ESTABLISHED FIN.WAIT.1 FIN.WAIT.2) (SETQ UP (IPLUS SEQ (fetch TCP.URG.PTR of SEGMENT))) (if (\32BIT.GT UP (fetch TCB.RCV.UP of TCB)) then (replace TCB.RCV.UP of TCB with UP) (if (\32BIT.GT UP (fetch TCB.RCV.NXT of TCB)) then (* urgent pointer is in advance of the data consumed) (\TCP.SIGNAL.URGENT.DATA TCB)))) ((CLOSE.WAIT CLOSING LAST.ACK TIME.WAIT) NIL) (SHOULDNT))))) ) (\TCP.QUEUE.INPUT (LAMBDA (TCB SEGMENT SEQ) (* ejs%: "18-Dec-86 17:39") (* Put the segment in its proper position in the input queue according to its sequence number range. Returns T if the segment was queued, NIL if it was a duplicate. Segments are queued by increasing left endpoint of their sequence number range. If the entire sequence number range has been seen or is covered by segments already in the queue, the segment is a duplicate. Otherwise, it covers some gap in the queue, so it is placed in its proper position. Note that a later segment that covers gaps on both sides will also be queued, resulting in duplicates in the queue. Therefore \TCP.GET.SEGMENT must be prepared to skip over duplicates.) (CHECK (OR (NULL (fetch QLINK of SEGMENT)) (SHOULDNT "input segment already queued"))) (CHECK (\TCP.CHECK.INPUT.QUEUE TCB)) (UNINTERRUPTABLY (PROG ((QUEUE (fetch TCB.INPUT.QUEUE of TCB)) (RCV.NXT (fetch TCB.RCV.NXT of TCB)) (LEN (fetch TCP.DATA.LENGTH of SEGMENT)) (FLAGS (fetch TCP.CTRL of SEGMENT)) TOP CURRENT CURSEQ NEXT) (if (EQ 0 LEN) then (* this segment has no data) (GO DROPITANDPROBE)) (SETQ TOP (IPLUS SEQ LEN)) (if (\32BIT.LEQ TOP RCV.NXT) then (* this segment is a duplicate) (GO DROPITANDPROBE)) (SETQ CURRENT (fetch SYSQUEUEHEAD of QUEUE)) (SETQ NEXT (fetch SYSQUEUETAIL of QUEUE)) (if (OR (NULL CURRENT) (\32BIT.GEQ SEQ (fetch TCP.SEQ of NEXT))) then (* the segment goes at the tail of the queue -- we check this first since this is the expected case) (\ENQUEUE QUEUE SEGMENT) elseif (\32BIT.LT SEQ (SETQ CURSEQ (fetch TCP.SEQ of CURRENT))) then (* the segment goes at the head of the queue) (replace QLINK of SEGMENT with CURRENT) (replace SYSQUEUEHEAD of QUEUE with SEGMENT) else (* * Search for this segment's proper position in the queue. The invariant upon entering this loop is%: segment.seq >= current.seq) (do (if (\32BIT.LEQ TOP (IPLUS CURSEQ (fetch TCP.DATA.LENGTH of CURRENT))) then (* * segment.seq <= current.seq + current.length. The packet is totally subsumed by a previously received packet, and thus, is a duplicate and is dropped) (GO DROPITANDPROBE)) (SETQ NEXT (fetch QLINK of CURRENT)) (SETQ CURSEQ (fetch TCP.SEQ of NEXT)) (if (\32BIT.LT SEQ CURSEQ) then (* * current.seq <= segment.seq < next.seq. Insert the segment between current and next) (replace QLINK of SEGMENT with NEXT) (replace QLINK of CURRENT with SEGMENT) (RETURN)) (SETQ CURRENT NEXT))) (* * Note that we have a zero window allocation at this point. When we free up the window (in \TCP.GET.SEGMENT) %, we'll know to send a gratuitous ACK to our partner to let it know the window's once again open.) (replace TCB.RCV.WND of TCB with (IMAX 0 (IDIFFERENCE (fetch TCB.RCV.WND of TCB) LEN))) (replace TCB.LAST.SENT.RCV.WND of TCB with (IMAX 0 (IDIFFERENCE (fetch TCB.LAST.SENT.RCV.WND of TCB) LEN))) (COND ((OR (EQ 0 (fetch TCB.LAST.SENT.RCV.WND of TCB)) (EQ 0 (fetch TCB.RCV.WND of TCB))) (replace TCB.SENT.ZERO of TCB with T))) (while (AND (\32BIT.LEQ SEQ RCV.NXT) (\32BIT.LT RCV.NXT TOP)) do (* advance RCV.NXT) (replace TCB.RCV.NXT of TCB with (SETQ RCV.NXT TOP)) (if (SETQ SEGMENT (fetch QLINK of SEGMENT)) then (SETQ TOP (IPLUS (SETQ SEQ (fetch TCP.SEQ of SEGMENT)) (fetch TCP.DATA.LENGTH of SEGMENT))))) (if (BITTEST FLAGS \TCP.CTRL.PSH) then (\TCP.SEND.ACK TCB (QUOTE NOW)) else (\TCP.SEND.ACK TCB)) (NOTIFY.EVENT (fetch TCB.RCV.EVENT of TCB)) (RETURN T) DROPITANDPROBE (* * Here when we think we should let the other side know immediately about our condition (e.g. a duplicate packet was received)) (\TCP.SEND.ACK TCB (QUOTE NOW)) DROPIT (* * Here when we have nothing to do, but it's not worth informing our TCP partner) (RETURN NIL)))) ) (\TCP.HANDLE.FIN (LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ejs%: "11-Aug-86 22:29") (* check the FIN bit -- pages |75-76| of RFC 793) (PROG (TOP) (if (BITTEST FLAGS \TCP.CTRL.FIN) then (SETQ TOP (IPLUS SEQ (fetch TCP.DATA.LENGTH of SEGMENT))) (* check whether we've received all the data before the FIN) (if (\32BIT.GEQ (fetch TCB.RCV.NXT of TCB) TOP) then (if (\32BIT.EQ (fetch TCB.RCV.NXT of TCB) TOP) then (* advance RCV.NXT over the FIN) (add (fetch TCB.RCV.NXT of TCB) 1)) (SELECTQ (fetch TCB.STATE of TCB) ((SYN.RECEIVED ESTABLISHED) (\TCP.TRACE.TRANSITION TCB (QUOTE CLOSE.WAIT)) (replace TCB.STATE of TCB with (QUOTE CLOSE.WAIT))) (FIN.WAIT.1 (if (\TCP.OUR.FIN.IS.ACKED TCB) then (\TCP.START.TIME.WAIT TCB) (NOTIFY.EVENT (fetch TCB.FINACKED.EVENT of TCB)) else (\TCP.TRACE.TRANSITION TCB (QUOTE CLOSING)) (replace TCB.STATE of TCB with (QUOTE CLOSING)))) (FIN.WAIT.2 (\TCP.START.TIME.WAIT TCB)) ((CLOSE.WAIT CLOSING LAST.ACK) NIL) (TIME.WAIT (\TCP.START.TIME.WAIT TCB)) (SHOULDNT)) (NOTIFY.EVENT (fetch TCB.RCV.EVENT of TCB))) (* acknowledge the FIN) (\TCP.SEND.ACK TCB (QUOTE NOW))))) ) (\TCP.OUR.FIN.IS.ACKED (LAMBDA (TCB) (* ecc "16-May-84 12:15") (* check whether our FIN's sequence number (recorded in the TCB.FINSEQ field) has been acknowledged) (\32BIT.GEQ (fetch TCB.SND.UNA of TCB) (OR (fetch TCB.FINSEQ of TCB) (SHOULDNT "FIN not sent")))) ) (\TCP.SIGNAL.URGENT.DATA (LAMBDA (TCB) (* ecc " 7-May-84 12:19") (NOTIFY.EVENT (fetch TCB.URGENT.EVENT of TCB)) (if TCPTRACEFLG then (printout TCPTRACEFILE .TAB0 0 "[Urgent TCP data has arrived]" T))) ) (\TCP.PROCESS (LAMBDA (TCB) (* ejs%: "11-Aug-86 21:57") (* process to handle retransmission and timeouts for TCP connection) (RESETSAVE NIL (LIST (FUNCTION \TCP.DELETE.TCB) TCB)) (PROCESSPROP (THIS.PROCESS) (QUOTE INFOHOOK) (FUNCTION (LAMBDA NIL (PPTCB TCB)))) (replace TCB.PROCESS of TCB with (THIS.PROCESS)) (WITH.MONITOR (fetch TCB.LOCK of TCB) (bind SEGMENT PACKETQUEUE REXMTQUEUE EVENT (IPSOCKET _ (fetch TCB.IPSOCKET of TCB)) first (SETQ PACKETQUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET)) (SETQ REXMTQUEUE (fetch TCB.REXMT.QUEUE of TCB)) (SETQ EVENT (fetch (IPSOCKET IPSEVENT) of IPSOCKET)) while (NEQ (fetch TCB.STATE of TCB) (QUOTE CLOSED)) do (COND ((AND (fetch TCB.RTFLG of TCB) (fetch TCB.PROBE.TIMER of TCB) (IGREATERP (CLOCKDIFFERENCE (fetch TCB.RTTIMER of TCB)) (fetch TCB.USER.TIMEOUT of TCB))) (* timeout has expired without other end responding) (\TCP.CONNECTION.DROPPED TCB "not responding")) ((AND (EQ (fetch TCB.STATE of TCB) (QUOTE TIME.WAIT)) (TIMEREXPIRED? (fetch TCB.2MSL.TIMER of TCB))) (* 2MSL has expired) (\TCP.TRACE.TRANSITION TCB (QUOTE CLOSED)) (replace TCB.STATE of TCB with (QUOTE CLOSED))) ((\TCP.RETRANSMIT TCB) NIL) ((OR (EQ (fetch TCB.ACKFLG of TCB) (QUOTE NOW)) (AND (EQ (fetch TCB.STATE of TCB) (QUOTE ESTABLISHED)) (fetch TCB.PROBE.TIMER of TCB) (TIMEREXPIRED? (fetch TCB.PROBE.TIMER of TCB))) (AND (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB)) (\32BIT.GT (fetch TCP.SEQ of (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB))) (fetch TCB.RCV.NXT of TCB)))) (* an ACK needs to be sent either because the protocol routines requested it or because we need to fill a gap in the input queue) (\TCP.SEND.CONTROL TCB (fetch TCB.SND.NXT of TCB) (\TCP.ACK# TCB) \TCP.CTRL.ACK)) ((AND (\32BIT.GT (fetch TCB.SND.NXT of TCB) (IPLUS (fetch TCB.SND.WL1 of TCB) (fetch TCB.SND.WND of TCB))) (fetch TCB.PROBE.TIMER of TCB) (TIMEREXPIRED? (fetch TCB.PROBE.TIMER of TCB))) (* a probe needs to be sent to open the window) (\TCP.SEND.CONTROL TCB (IPLUS (fetch TCB.SND.NXT of TCB) (fetch TCB.SND.WND of TCB)) (\TCP.ACK# TCB) \TCP.CTRL.ACK))) (COND ((SETQ SEGMENT (\DEQUEUE PACKETQUEUE)) (add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET) -1) (\TCP.INPUT SEGMENT TCB)) (T (COND ((EQ (COND ((OR (fetch TCB.OUTPUT.HELD of TCB) (fetch SYSQUEUEHEAD of REXMTQUEUE) (\32BIT.GT (fetch TCB.SND.NXT of TCB) (IPLUS (fetch TCB.SND.WL1 of TCB) (fetch TCB.SND.WND of TCB)))) (* Something on the retransmit queue. Be agressive.) (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB) EVENT (fetch TCB.RTO of TCB))) (T (* Nothing to do. Be lazy) (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB) EVENT (fetch TCB.PROBE.TIMER of TCB) (NOT (NULL (fetch TCB.PROBE.TIMER of TCB)))))) EVENT) (COND ((SETQ SEGMENT (\DEQUEUE PACKETQUEUE)) (add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET) -1) (\TCP.INPUT SEGMENT TCB)))))))))) ) (\TCP.TEMPLATE (LAMBDA (TCB OPTIONS) (* ejs%: "21-Jun-85 16:40") (* set up segment for sending control information and pseudo-header for checksumming) (LET ((SEGMENT (fetch TCB.TEMPLATE of TCB))) (if SEGMENT then (replace TCP.DST.ADDR of SEGMENT with (fetch TCB.DST.HOST of TCB)) (replace TCP.DST.PORT of SEGMENT with (fetch TCB.DST.PORT of TCB)) else (SETQ SEGMENT (\TCP.SETUP.SEGMENT (\LOCAL.IP.ADDRESS) (fetch TCB.SRC.PORT of TCB) (fetch TCB.DST.HOST of TCB) (fetch TCB.DST.PORT of TCB)))) (if OPTIONS then (\TCP.SETUP.SEGMENT.OPTIONS SEGMENT OPTIONS)) (replace TCB.TEMPLATE of TCB with SEGMENT) (if (NULL (fetch TCB.PH of TCB)) then (replace TCB.PH of TCB with (create TCP.PSEUDOHEADER))) SEGMENT)) ) (\TCP.SETUP.SEGMENT.OPTIONS (LAMBDA (SEGMENT OPTIONS) (* ejs%: "28-Jul-86 13:31") (* * Add options to a freshly setup segment. OPTIONS is in PLIST format) (LET ((OPTIONSBASE (fetch TCP.OPTIONS of SEGMENT)) (OPTIONSOFFSET 0) DIDPLACEOPTION) (COND ((IGREATERP (fetch (IP IPTOTALLENGTH) of SEGMENT) (CONSTANT (IPLUS \TCP.HEADER.LENGTH \IPOVLEN))) (ERROR "Tried to add options to a segment with TCP data already in place" SEGMENT))) (for OPTIONVALUETAIL on OPTIONS by (CDDR OPTIONVALUETAIL) do (SELECTQ (CAR OPTIONVALUETAIL) (MAXSEG (LET ((VALUE (CADR OPTIONVALUETAIL))) (COND ((SMALLP VALUE) (\PUTBASEBYTE OPTIONSBASE OPTIONSOFFSET \TCPOPT.MAXSEG) (\PUTBASEBYTE OPTIONSBASE (add OPTIONSOFFSET 1) 4) (\PUTBASEBYTE OPTIONSBASE (add OPTIONSOFFSET 1) (LOGAND (MASK.1'S 0 BITSPERBYTE) (LRSH VALUE BITSPERBYTE))) (\PUTBASEBYTE OPTIONSBASE (add OPTIONSOFFSET 1) (LOGAND VALUE (MASK.1'S 0 BITSPERBYTE))) (SETQ DIDPLACEOPTION T))))) NIL)) (COND (DIDPLACEOPTION (\PUTBASEBYTE OPTIONSBASE (add OPTIONSOFFSET 1) \TCPOPT.END))) (until (EQ 0 (IMOD OPTIONSOFFSET 4)) do (\PUTBASEBYTE OPTIONSBASE (add OPTIONSOFFSET 1) \TCPOPT.END)) (add (fetch (IP IPTOTALLENGTH) of SEGMENT) OPTIONSOFFSET) (add (fetch TCP.DATA.OFFSET of SEGMENT) (FOLDHI OPTIONSOFFSET BYTESPERCELL)))) ) (\TCP.SEND.CONTROL (LAMBDA (TCB SEQ ACK FLAGS) (* ejs%: "18-Dec-86 17:29") (* send a control segment with the specified sequence number and ACK information) (PROG ((SEGMENT (OR (fetch TCB.TEMPLATE of TCB) (\TCP.NEW.TEMPLATE TCB)))) (if (NULL FLAGS) then (SETQ FLAGS 0)) (CHECK (OR (NOT (BITTEST FLAGS (LOGOR \TCP.CTRL.SYN \TCP.CTRL.FIN))) (SHOULDNT "SYN or FIN"))) (while (fetch EPTRANSMITTING of SEGMENT) do (BLOCK)) (replace TCP.SEQ of SEGMENT with SEQ) (if ACK then (replace TCP.ACK of SEGMENT with ACK) (SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.ACK)) else (replace TCP.ACK of SEGMENT with 0)) (replace TCP.CTRL of SEGMENT with FLAGS) (replace TCB.SENT.ZERO of TCB with (EQ 0 (replace TCP.WINDOW of SEGMENT with (replace TCB.LAST.SENT.RCV.WND of TCB with (fetch TCB.RCV.WND of TCB))))) (\TCP.SEND.SEGMENT TCB SEGMENT FLAGS) (\TCP.NEW.TEMPLATE TCB))) ) (\TCP.SEND.ACK (LAMBDA (TCB WHEN) (* ejs%: "17-Dec-86 16:43") (* set TCB.ACKFLG to tell the \TCP.PROCESS that an ACK needs to be sent -- NOW means send the ack immediately, LATER means delay in the hope that it can be piggybacked on an outgoing data segment) (COND ((EQ WHEN (QUOTE NOW)) (\TCP.SEND.CONTROL TCB (fetch TCB.SND.NXT of TCB) (\TCP.ACK# TCB) \TCP.CTRL.ACK)) (T (replace TCB.ACKFLG of TCB with (OR WHEN (QUOTE LATER)))))) ) (\TCP.SEND.RESET (LAMBDA (ORIG SEQ ACK FLAGS) (* ejs%: " 7-Jun-85 12:58") (* like \TCP.SEND.CONTROL but always sends RST and can be used without a TCB) (PROG (SEGMENT) (SETQ SEGMENT (\TCP.SETUP.SEGMENT (\LOCAL.IP.ADDRESS) (fetch TCP.DST.PORT of ORIG) (fetch TCP.SRC.ADDR of ORIG) (fetch TCP.SRC.PORT of ORIG))) (replace TCP.SEQ of SEGMENT with SEQ) (if ACK then (replace TCP.ACK of SEGMENT with ACK) (OR FLAGS (SETQ FLAGS (LOGOR \TCP.CTRL.RST \TCP.CTRL.ACK))) else (replace TCP.ACK of SEGMENT with 0) (OR FLAGS (SETQ FLAGS \TCP.CTRL.RST))) (replace TCP.CTRL of SEGMENT with FLAGS) (replace TCP.WINDOW of SEGMENT with 0) (replace EPREQUEUE of SEGMENT with (QUOTE FREE)) (\TCP.SEND.SEGMENT NIL SEGMENT FLAGS))) ) (\TCP.FIX.OUTGOING.SEGMENT (LAMBDA (TCB SEGMENT FLAGS) (* ejs%: "18-Dec-86 17:29") (* fill in control bits, ACK and window information, and start round trip timer) (if (BITTEST FLAGS \TCP.CTRL.ACK) then (replace TCP.ACK of SEGMENT with (fetch TCB.RCV.NXT of TCB)) else (replace TCP.ACK of SEGMENT with 0)) (replace TCP.CTRL of SEGMENT with FLAGS) (* set control bits) (replace TCP.WINDOW of SEGMENT with (replace TCB.LAST.SENT.RCV.WND of TCB with (fetch TCB.RCV.WND of TCB))) (if (NULL (fetch TCB.RTFLG of TCB)) then (* time round trip response to this segment) (replace TCB.RTFLG of TCB with T) (replace TCB.RTSEQ of TCB with (fetch TCP.SEQ of SEGMENT)) (replace TCB.RTTIMER of TCB with (SETUPTIMER 0 (fetch TCB.RTTIMER of TCB))))) ) (\TCP.SEND.DATA (LAMBDA (TCB SEGMENT LENGTH FLAGS) (* wjy "13-Dec-85 14:30") (* * This function is used to send a TCP data segment for the first time. Subsequent retransmissions are done directly through \TCP.SEND.SEGMENT) (* * NOTE%: This function MUST be called with the TCB.LOCK already locked!) (PROG (SEQ TOP) (CHECK (OR (EQ LENGTH (\TCP.DATA.LENGTH SEGMENT)) (SHOULDNT "bad segment length"))) (CHECK (OR (ILEQ LENGTH (fetch TCB.MAXSEG of TCB)) (SHOULDNT "segment > max segment size"))) (if (NEQ (fetch TCB.STATE of TCB) (QUOTE SYN.SENT)) then (* ACK in all synchronized states) (SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.ACK))) (SETQ SEQ (fetch TCB.SND.NXT of TCB)) (* assign sequence number) (if (fetch TCB.ACKFLG of TCB) then (SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.ACK))) (SETQ TOP (IPLUS SEQ LENGTH (\TCP.SYN.OR.FIN FLAGS))) (CHECK (OR (\32BIT.GEQ TOP (fetch TCB.SND.NXT of TCB)) (SHOULDNT "bad sequence numbers"))) (replace TCP.SEQ of SEGMENT with SEQ) (if (BITTEST FLAGS \TCP.CTRL.URG) then (replace TCB.SND.UP of TCB with TOP)) (if (\32BIT.GT (fetch TCB.SND.UP of TCB) SEQ) then (* there's urgent data to send) (SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.URG)) (replace TCP.URG.PTR of SEGMENT with (IDIFFERENCE (fetch TCB.SND.UP of TCB) SEQ)) else (* no urgent data) (* drag the urgent pointer along at the left edge of the window) (replace TCB.SND.UP of TCB with (fetch TCB.SND.UNA of TCB))) (if (BITTEST FLAGS \TCP.CTRL.FIN) then (* remember the sequence number of the FIN so we can tell when it's been acked) (CHECK (OR (EQ (fetch TCB.STATE of TCB) (QUOTE FIN.WAIT.1)) (EQ (fetch TCB.STATE of TCB) (QUOTE LAST.ACK)) (SHOULDNT "bad state for FIN"))) (replace TCB.FINSEQ of TCB with TOP)) (replace TCB.SND.NXT of TCB with TOP) (do (* try to send segment) (SELECTQ (fetch TCB.STATE of TCB) (LISTEN (ERROR "TCP connection not established")) ((SYN.SENT SYN.RECEIVED ESTABLISHED FIN.WAIT.1 CLOSE.WAIT LAST.ACK) (if (OR (ZEROP LENGTH) (ZEROP (fetch TCB.SND.WL1 of TCB)) (\32BIT.LEQ TOP (IPLUS (fetch TCB.SND.UNA of TCB) (fetch TCB.SND.WND of TCB))) (\32BIT.GT (fetch TCB.SND.UP of TCB) (fetch TCB.SND.UNA of TCB))) then (* go ahead and send it) (CHECK (OR (ZEROP LENGTH) (ZEROP (fetch TCB.SND.WL1 of TCB)) (\32BIT.LEQ TOP (IPLUS (fetch TCB.SND.UNA of TCB) (fetch TCB.SND.WND of TCB))))) (replace TCB.OUTPUT.HELD of TCB with NIL) (* advance SND.NXT) (\TCP.FIX.OUTGOING.SEGMENT TCB SEGMENT FLAGS) (replace EPREQUEUE of SEGMENT with (fetch TCB.REXMT.QUEUE of TCB)) (replace EPUSERFIELD of SEGMENT with (CLOCK0 (CREATECELL \FIXP))) (\TCP.SEND.SEGMENT TCB SEGMENT FLAGS) (RETURN) else (* block until we can send it) (replace TCB.OUTPUT.HELD of TCB with T) (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB) (fetch TCB.SND.EVENT of TCB)))) ((FIN.WAIT.2 CLOSING TIME.WAIT) (ERROR "TCP connection closing")) (CLOSED (ERROR "TCP connection closed")) (SHOULDNT))))) ) (\TCP.SEND.SEGMENT (LAMBDA (TCB SEGMENT FLAGS) (* ejs%: "28-Dec-84 18:06") (* common routine to transmit a TCP segment) (\TCP.CHECKSUM.OUTGOING TCB SEGMENT) (\TCP.TRACE.SEGMENT (QUOTE SEND) SEGMENT) (if TCB then (if (BITTEST FLAGS \TCP.CTRL.ACK) then (replace TCB.ACKFLG of TCB with NIL)) (\TCP.START.PROBE.TIMER TCB)) (\IP.TRANSMIT SEGMENT)) ) (\TCP.NEW.TEMPLATE (LAMBDA (TCB) (* ejs%: "29-Dec-84 13:05") (replace TCB.TEMPLATE of TCB with NIL) (\TCP.TEMPLATE TCB))) (\TCP.START.PROBE.TIMER (LAMBDA (TCB) (* ejs%: "12-Aug-86 10:35") (replace TCB.PROBE.TIMER of TCB with (COND ((AND (fetch TCB.NO.IDLE.PROBING of TCB) (EQ (fetch TCB.STATE of TCB) (QUOTE ESTABLISHED))) NIL) (T (COND ((NULL (fetch TCB.PROBE.TIMER of TCB)) (LET ((IPSOCKET (fetch TCB.IPSOCKET of TCB))) (COND (IPSOCKET (NOTIFY.EVENT (fetch (IPSOCKET IPSEVENT) of IPSOCKET))))))) (SETUPTIMER (ITIMES 4 (fetch TCB.RTO of TCB)) (fetch TCB.PROBE.TIMER of TCB)))))) ) (\TCP.RETRANSMIT (LAMBDA (TCB) (* ejs%: " 3-Jun-85 07:58") (* find the first unacknowledged segment and retransmit it) (PROG ((QUEUE (fetch TCB.REXMT.QUEUE of TCB)) (UNA (fetch TCB.SND.UNA of TCB)) CURRENT CURSEQ NEXT PREV REST FIRSTSEG MINSEQ FLAGS) (UNINTERRUPTABLY (* detach the list of segments to be retransmitted so we don't interfere with the driver) (SETQ NEXT (fetch SYSQUEUEHEAD of QUEUE)) (replace SYSQUEUEHEAD of QUEUE with NIL) (replace SYSQUEUETAIL of QUEUE with NIL)) (while (SETQ CURRENT NEXT) do (SETQ NEXT (fetch QLINK of CURRENT)) (replace QLINK of CURRENT with NIL) (if (\32BIT.LEQ (IPLUS (SETQ CURSEQ (fetch TCP.SEQ of CURRENT)) (\TCP.DATA.LENGTH CURRENT) (\TCP.SYN.OR.FIN (fetch TCP.CTRL of CURRENT))) UNA) then (* this segment has already been acked) (\TCP.RELEASE.SEGMENT CURRENT) elseif (NULL FIRSTSEG) then (* this is the first unacked segment we've encountered) (SETQ FIRSTSEG CURRENT) (SETQ MINSEQ CURSEQ) elseif (\32BIT.LT CURSEQ MINSEQ) then (* this is the lowest sequence number seen so so far; put the previous contender back on the REST queue) (replace QLINK of FIRSTSEG with REST) (SETQ REST FIRSTSEG) (SETQ FIRSTSEG CURRENT) (SETQ MINSEQ CURSEQ) else (* this is an unacked segment but later than one we've already seen; just add it to the REST queue) (replace QLINK of CURRENT with REST) (SETQ REST CURRENT))) (UNINTERRUPTABLY (* set the retransmit queue to be the REST queue we've accumulated) (if (SETQ CURRENT REST) then (* find tail of REST queue) (while (SETQ NEXT (fetch QLINK of CURRENT)) do (SETQ CURRENT NEXT))) (replace SYSQUEUEHEAD of QUEUE with REST) (replace SYSQUEUETAIL of QUEUE with CURRENT)) (if FIRSTSEG then (if (IGEQ (CLOCKDIFFERENCE (fetch EPUSERFIELD of FIRSTSEG)) (fetch TCB.RTO of TCB)) then (SETQ FLAGS (fetch TCP.CTRL of FIRSTSEG)) (\TCP.FIX.OUTGOING.SEGMENT TCB FIRSTSEG FLAGS) (replace EPREQUEUE of FIRSTSEG with (fetch TCB.REXMT.QUEUE of TCB)) (CLOCK0 (fetch EPUSERFIELD of FIRSTSEG)) (\TCP.SEND.SEGMENT TCB FIRSTSEG FLAGS) (RETURN T) else (\ENQUEUE (fetch TCB.REXMT.QUEUE of TCB) FIRSTSEG) (RETURN NIL)) else (RETURN NIL)))) ) (\TCP.START.TIME.WAIT (LAMBDA (TCB) (* ecc "16-Apr-84 17:58") (* start 2MSL timer) (replace TCB.2MSL.TIMER of TCB with (SETUPTIMER (ITIMES 2 \TCP.MSL) (fetch TCB.2MSL.TIMER of TCB))) (\TCP.TRACE.TRANSITION TCB (QUOTE TIME.WAIT)) (replace TCB.STATE of TCB with (QUOTE TIME.WAIT))) ) (\TCP.CONNECTION.DROPPED (LAMBDA (TCB MSG) (* ejs%: "29-Jan-85 16:06") (if TCPTRACEFLG then (printout TCPTRACEFILE .TAB0 0 "[TCP connection " (OR MSG "dropped") "]" T)) (\TCP.TRACE.TRANSITION TCB (QUOTE CLOSED)) (replace TCB.STATE of TCB with (QUOTE CLOSED)) (AND (OPENP (fetch TCB.RCV.STREAM of TCB) (QUOTE INPUT)) (CLOSEF (fetch TCB.RCV.STREAM of TCB))) (AND (OPENP (fetch TCB.SND.STREAM of TCB) (QUOTE OUTPUT)) (CLOSEF (fetch TCB.SND.STREAM of TCB))) (NOTIFY.EVENT (fetch TCB.RCV.EVENT of TCB))) ) (\TCP.CHECK.OPTIONS (LAMBDA (TCB SEGMENT FLAGS) (* ejs%: "21-Mar-86 20:04") (* * Do TCP header options processing) (COND ((IGREATERP (fetch (TCPSEGMENT TCP.DATA.OFFSET) of SEGMENT) \TCP.MIN.DATA.OFFSET) (\TCP.PROCESS.OPTIONS TCB SEGMENT FLAGS)) (T T))) ) (\TCP.PROCESS.OPTIONS (LAMBDA (TCB SEGMENT FLAGS) (* ejs%: "20-Jun-85 16:08") (* * Process the options in a TCP header) (bind (OPTIONBASE _ (fetch (TCPSEGMENT TCP.OPTIONS) of SEGMENT)) (OPTIONOFFSET _ 0) OPTION eachtime (SETQ OPTION (\GETBASEBYTE OPTIONBASE OPTIONOFFSET)) until (EQ OPTION \TCPOPT.END) do (SELECTC OPTION (\TCPOPT.END (HELP "Unexpected \TCPOPT.END processing TCP options")) (\TCPOPT.NOP (add OPTIONOFFSET 1)) (\TCPOPT.MAXSEG (COND ((BITTEST FLAGS \TCP.CTRL.SYN) (replace TCB.MAXSEG of TCB with (IMIN \TCP.DEFAULT.MAXSEG (LOGOR (LLSH (\GETBASEBYTE OPTIONBASE (IPLUS OPTIONOFFSET 2)) BITSPERBYTE) (\GETBASEBYTE OPTIONBASE (IPLUS OPTIONOFFSET 3))))))) (add OPTIONOFFSET (\GETBASEBYTE OPTIONBASE (ADD1 OPTIONOFFSET)))) (RETURN))) T) ) ) (* ;; "support for ICMP messages that affect TCP connections") (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (RPAQQ \ICMP.PROTOCOL 1) (CONSTANTS \ICMP.PROTOCOL) ) (DECLARE%: EVAL@COMPILE (RPAQQ \ICMP.32BIT.WORDS 2) (CONSTANTS \ICMP.32BIT.WORDS) ) (DECLARE%: EVAL@COMPILE (RPAQQ \ICMP.DESTINATION.UNREACHABLE 3) (RPAQQ \ICMP.SOURCE.QUENCH 4) (CONSTANTS \ICMP.DESTINATION.UNREACHABLE \ICMP.SOURCE.QUENCH) ) ) (DEFINEQ (\TCP.HANDLE.ICMP (LAMBDA (ICMP SEGMENT) (* ejs%: " 3-Jun-85 07:41") (* handle ICMP messages) (PROG (MSG TCB) (if (NEQ (fetch (ICMP ICMPTYPE) of ICMP) \ICMP.DESTINATION.UNREACHABLE) then (RETURN)) (SETQ MSG (SELECTQ (fetch (ICMP ICMPCODE) of ICMP) (0 "net unreachable") (1 "host unreachable") (2 "protocol unreachable") (3 "port unreachable") (4 "fragmentation needed and DF set") (5 "source route failed") "destination unreachable (unknown code)")) (SETQ TCB (\TCP.LOOKUP.TCB (fetch TCP.DST.ADDR of SEGMENT) (fetch TCP.DST.PORT of SEGMENT) (fetch TCP.SRC.PORT of SEGMENT))) (if (OR (NULL TCB) (EQ (fetch TCB.STATE of TCB) (QUOTE CLOSED))) then (RETURN)) (\RELEASE.ETHERPACKET ICMP) (\TCP.CONNECTION.DROPPED TCB MSG))) ) ) (* ;; "TCP stream routines") (DEFINEQ (TCP.OPEN (LAMBDA (DST.HOST DST.PORT SRC.PORT MODE ACCESS NOERRORFLG OPTIONS) (* ejs%: "21-Mar-86 17:38") (PROG (TCB DST.HOST.NUMBER) (SELECTQ ACCESS (INPUT) (APPEND) (OUTPUT (SETQ ACCESS (QUOTE APPEND))) (LISPERROR "ILLEGAL ARG" ACCESS)) (COND ((ATOM DST.HOST) (COND ((AND (NOT (SETQ DST.HOST.NUMBER (DODIP.HOSTP DST.HOST))) (EQ MODE (QUOTE ACTIVE))) (ERROR "Unknown TCP/IP host: " DST.HOST)))) ((FIXP DST.HOST) (SETQ DST.HOST.NUMBER DST.HOST)) (T (ERROR "Illegal TCP/IP host: " DST.HOST))) (SETQ TCB (\TCP.CONNECTION DST.HOST.NUMBER DST.PORT SRC.PORT MODE OPTIONS)) (RETURN (if (NULL TCB) then (if NOERRORFLG then NIL else (ERROR "TCP connection failed")) else (SELECTQ ACCESS (INPUT (fetch TCB.RCV.STREAM of TCB)) (APPEND (fetch TCB.SND.STREAM of TCB)) (SHOULDNT)))))) ) (TCP.OTHER.STREAM (LAMBDA (STREAM) (* ecc "14-May-84 16:52") (PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM))) (if (NOT (type? TCP.CONTROL.BLOCK TCB)) then (ERROR "no TCP control block")) (RETURN (SELECTQ (fetch (TCPSTREAM ACCESS) of STREAM) (INPUT (fetch TCB.SND.STREAM of TCB)) (APPEND (fetch TCB.RCV.STREAM of TCB)) (SHOULDNT))))) ) (\TCP.BOUTS (LAMBDA (STREAM BASE OFF NBYTES) (* ejs%: "27-May-86 15:09") (PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM))) (RETURN (\BUFFERED.BOUTS (fetch (TCP.CONTROL.BLOCK TCB.SND.STREAM) of TCB) BASE OFF NBYTES)))) ) (\TCP.OTHER.BIN (LAMBDA (STREAM) (* ejs%: "27-May-86 14:40") (\BIN (TCP.OTHER.STREAM STREAM)))) (\TCP.OTHER.BOUT (LAMBDA (STREAM BYTE) (* ejs%: "27-May-86 14:19") (BOUT (TCP.OTHER.STREAM STREAM) BYTE))) (\TCP.BIN (LAMBDA (STREAM) (* ecc " 3-May-84 13:55") (do (if (ILESSP (fetch COFFSET of STREAM) (fetch CBUFSIZE of STREAM)) then (RETURN (\GETBASEBYTE (fetch CPPTR of STREAM) (PROG1 (fetch COFFSET of STREAM) (add (fetch COFFSET of STREAM) 1)))) elseif (NULL (\TCP.GET.SEGMENT STREAM)) then (RETURN (STREAMOP (QUOTE ENDOFSTREAMOP) STREAM STREAM))))) ) (\TCP.BACKFILEPTR (LAMBDA (STREAM) (* ejs%: "15-Sep-85 23:25") (COND ((AND (fetch CPPTR of STREAM) (IGEQ (fetch COFFSET of STREAM) (fetch (TCPSTREAM ORIGINAL.COFFSET) of STREAM))) (add (fetch COFFSET of STREAM) -1)) (T (\IS.NOT.RANDACCESSP STREAM)))) ) (\TCP.GETNEXTBUFFER (LAMBDA (STREAM WHATFOR NOERRORFLG) (* ejs%: "27-May-86 14:45") (BLOCK) (SELECTQ WHATFOR (READ (COND ((NEQ STREAM (fetch (TCP.CONTROL.BLOCK TCB.RCV.STREAM) of (fetch (TCPSTREAM TCB) of STREAM))) (SETQ STREAM (TCP.OTHER.STREAM STREAM)))) (\TCP.GET.SEGMENT STREAM NOERRORFLG)) (WRITE (COND ((NEQ STREAM (fetch (TCP.CONTROL.BLOCK TCB.SND.STREAM) of (fetch (TCPSTREAM TCB) of STREAM))) (SETQ STREAM (TCP.OTHER.STREAM STREAM)))) (\TCP.FLUSH STREAM) (\TCP.FILL.IN.SEGMENT STREAM)) (SHOULDNT))) ) (\TCP.GET.SEGMENT (LAMBDA (STREAM NOERRORFLG) (* ejs%: "18-Dec-86 17:33") (* * Get the next segment from the input stream. Return T if successful; otherwise, an error code. Call the user-specified error handler to get a code, if necessary) (PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM)) SEGMENT SEQ LEN OLDSEGMENT OLDSEQ OLDLEN OLDTOP SUCCESS OFFSET LAST.BYTE) (if (OR (NULL TCB) (AND (NEQ (fetch TCB.STATE of TCB) (QUOTE CLOSED)) (NEQ STREAM (fetch TCB.RCV.STREAM of TCB)))) then (ERROR "not TCP input stream")) (WITH.MONITOR (fetch TCB.LOCK of TCB) (SETQ OLDSEGMENT (fetch TCB.RCV.SEGMENT of TCB)) (CHECK (OR (NULL OLDSEGMENT) (EQ (fetch TCP.DATA.LENGTH of OLDSEGMENT) (fetch CBUFSIZE of STREAM)) (SHOULDNT "inconsistent stream buffer size"))) (UNINTERRUPTABLY (COND ((fetch CPPTR of STREAM) (SETQ LAST.BYTE (\GETBASEBYTE (fetch CPPTR of STREAM) (fetch COFFSET of STREAM))))) (replace TCB.RCV.SEGMENT of TCB with NIL) (replace CPPTR of STREAM with NIL) (replace CBUFSIZE of STREAM with 0) (replace COFFSET of STREAM with 0)) (if OLDSEGMENT then (* remember sequence number range of previous segment so we can adjust for overlap) (SETQ OLDTOP (IPLUS (SETQ OLDSEQ (fetch TCP.SEQ of OLDSEGMENT)) (SETQ OLDLEN (fetch TCP.DATA.LENGTH of OLDSEGMENT)))) (replace TCB.RCV.WND of TCB with (IMIN \TCP.DEFAULT.RECEIVE.WINDOW (IPLUS (fetch TCB.RCV.WND of TCB) OLDLEN))) (add (fetch (TCPSTREAM BYTECOUNT) of STREAM) OLDLEN) (\TCP.RELEASE.SEGMENT OLDSEGMENT) (SETQ OLDSEGMENT T)) (* look at first segment in input queue to see if it overlaps the sequence number range we're expecting; there may be duplicates that must be skipped over) (do ((CHECK (\TCP.CHECK.INPUT.QUEUE TCB)) (COND ((AND (SETQ SEGMENT (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB))) (\32BIT.LT (SETQ SEQ (fetch TCP.SEQ of SEGMENT)) (fetch TCB.RCV.NXT of TCB))) (* this segment is within the range of contiguous sequence numbers received so far, because its sequence number is less than RCV.NXT) (\DEQUEUE (fetch TCB.INPUT.QUEUE of TCB)) (SETQ LEN (fetch TCP.DATA.LENGTH of SEGMENT)) (COND ((AND OLDSEGMENT (\32BIT.LEQ (IPLUS SEQ LEN) OLDTOP)) (* this segment is a duplicate) (\TCP.RELEASE.SEGMENT SEGMENT)) (T (* this segment overlaps with the range of sequence numbers we're expecting) (CHECK (OR (NOT OLDSEGMENT) (\32BIT.LEQ SEQ OLDTOP) (SHOULDNT "gap in input queue"))) (UNINTERRUPTABLY (replace CPPTR of STREAM with (fetch TCP.CONTENTS of SEGMENT)) (* eliminate overlap) (SETQ OFFSET (replace (TCPSTREAM ORIGINAL.COFFSET) of STREAM with (replace COFFSET of STREAM with (COND (OLDSEGMENT (IDIFFERENCE OLDLEN (IDIFFERENCE SEQ OLDSEQ))) (T 0))))) (COND (LAST.BYTE (\PUTBASEBYTE (fetch CPPTR of STREAM) (SUB1 OFFSET) LAST.BYTE))) (add (fetch (TCPSTREAM BYTECOUNT) of STREAM) (IMINUS OFFSET)) (replace CBUFSIZE of STREAM with LEN) (replace TCB.RCV.SEGMENT of TCB with SEGMENT)) (SETQ SUCCESS T) (RETURN)))) (T (SELECTQ (fetch TCB.STATE of TCB) ((LISTEN SYN.SENT SYN.RECEIVED) (* wait until established) (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB) (fetch TCB.ESTABLISHED of TCB))) ((ESTABLISHED FIN.WAIT.1 FIN.WAIT.2) (* wait for next segment) (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB) (fetch TCB.RCV.EVENT of TCB)) (SELECTQ (fetch TCB.STATE of TCB) ((CLOSED CLOSING LAST.ACK) (RELEASE.MONITORLOCK (fetch TCB.LOCK of TCB)) (COND (NOERRORFLG (RETURN NIL)) (T (RETURN (SETQ SUCCESS (\EOF.ACTION STREAM)))))) NIL)) ((CLOSED CLOSE.WAIT CLOSING LAST.ACK TIME.WAIT) (* return NIL to punt to ENDOFSTREAMOP in \TCP.BIN) (RELEASE.MONITORLOCK (fetch TCB.LOCK of TCB)) (COND (NOERRORFLG (RETURN NIL)) (T (RETURN (SETQ SUCCESS (\EOF.ACTION STREAM)))))) (SHOULDNT))))))) (if (fetch TCB.SENT.ZERO of TCB) then (\TCP.SEND.ACK TCB (QUOTE NOW)) (BLOCK)) (RETURN SUCCESS))) ) (\TCP.PEEKBIN (LAMBDA (STREAM NOERRORFLG) (* ecc " 3-May-84 13:55") (do (if (ILESSP (fetch COFFSET of STREAM) (fetch CBUFSIZE of STREAM)) then (RETURN (\GETBASEBYTE (fetch CPPTR of STREAM) (fetch COFFSET of STREAM))) elseif (NULL (\TCP.GET.SEGMENT STREAM)) then (RETURN (if NOERRORFLG then NIL else (STREAMOP (QUOTE ENDOFSTREAMOP) STREAM STREAM)))))) ) (\TCP.GETFILEPTR (LAMBDA (STREAM) (* ejs%: "10-Jun-85 14:07") (IPLUS (fetch (STREAM COFFSET) of STREAM) (fetch (TCPSTREAM BYTECOUNT) of STREAM))) ) (\TCP.READP (LAMBDA (STREAM) (* ejs%: " 7-Jun-85 13:39") (PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM))) (if (OR (NULL TCB) (AND (NEQ (fetch TCB.STATE of TCB) (QUOTE CLOSED)) (NEQ STREAM (fetch TCB.RCV.STREAM of TCB)))) then (ERROR "not TCP input stream") else (RETURN (OR (ILESSP (fetch COFFSET of STREAM) (fetch CBUFSIZE of STREAM)) (AND (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB)) T)))))) ) (\TCP.EOFP (LAMBDA (STREAM) (* ejs%: "13-Apr-85 16:15") (* check whether EOF has been reached on stream -- may block waiting for next segment) (PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM))) (if (NULL TCB) then (ERROR "not TCP stream") elseif (AND (NEQ (QUOTE CLOSED) (fetch TCB.STATE of TCB)) (EQ STREAM (fetch TCB.SND.STREAM of TCB))) then (RETURN T) (* Always at EOF of outgoing stream.) elseif (OR (ILESSP (fetch COFFSET of STREAM) (fetch CBUFSIZE of STREAM)) (NOT (NULL (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB))))) then (* there is still data left to read) (RETURN NIL) else (RETURN (SELECTQ (fetch TCB.STATE of TCB) (ESTABLISHED NIL) ((LISTEN SYN.SENT SYN.RECEIVED FIN.WAIT.1 FIN.WAIT.2) (* can't tell without waiting for next segment) (NULL (\TCP.GET.SEGMENT STREAM T))) ((CLOSE.WAIT CLOSING LAST.ACK TIME.WAIT CLOSED) (* no more data can be forthcoming) T) (SHOULDNT)))))) ) (TCP.URGENTP (LAMBDA (STREAM) (* ecc " 7-May-84 14:27") (* check if current point in receive stream is before receive urgent pointer) (PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM))) (if (OR (NULL TCB) (NEQ STREAM (fetch TCB.RCV.STREAM of TCB))) then (ERROR "not TCP input stream")) (RETURN (AND (fetch TCB.RCV.SEGMENT of TCB) (\32BIT.GT (fetch TCB.RCV.UP of TCB) (IPLUS (fetch TCP.SEQ of (fetch TCB.RCV.SEGMENT of TCB)) (fetch COFFSET of STREAM))))))) ) (TCP.URGENT.EVENT (LAMBDA (STREAM) (* edited%: "22-May-84 18:10") (* return the urgent data event so that a user process can wait for it) (fetch TCB.URGENT.EVENT of (fetch (TCPSTREAM TCB) of STREAM))) ) (\TCP.BOUT (LAMBDA (STREAM CHAR) (* ecc " 3-May-84 13:55") (do (if (ILESSP (fetch COFFSET of STREAM) (fetch CBUFSIZE of STREAM)) then (\PUTBASEBYTE (fetch CPPTR of STREAM) (fetch COFFSET of STREAM) CHAR) (add (fetch COFFSET of STREAM) 1) (RETURN) else (\TCP.FLUSH STREAM) (\TCP.FILL.IN.SEGMENT STREAM)))) ) (\TCP.FLUSH (LAMBDA (STREAM FLAGS) (* ; "Edited 4-Dec-87 12:11 by scp") (* Force out current output segment. If FLAGS is non-nil, send a segment with those flags even if we have to create a new one) (PROG ((TCB (fetch TCB of STREAM)) SEGMENT LENGTH) (if (OR (NULL TCB) (AND (NEQ (fetch TCB.STATE of TCB) (QUOTE CLOSED)) (NEQ STREAM (fetch TCB.SND.STREAM of TCB)))) then (ERROR "not TCP output stream")) (SETQ LENGTH (fetch COFFSET of STREAM)) (WITH.FAST.MONITOR (fetch TCB.LOCK of TCB) (if (OR (AND (SETQ SEGMENT (fetch TCB.SND.SEGMENT of TCB)) (NOT (ZEROP LENGTH))) (AND FLAGS (SETQ SEGMENT (\TCP.FILL.IN.SEGMENT STREAM (COND ((EQ (fetch TCB.STATE of TCB) (QUOTE SYN.SENT)) (BQUOTE (MAXSEG %, (OR (fetch TCB.OUR.MAXSEG of TCB) \TCP.DEFAULT.MAXSEG)))) ((EQ (fetch TCB.STATE of TCB) (QUOTE SYN.RECEIVED)) (BQUOTE (MAXSEG %, (OR (fetch TCB.OUR.MAXSEG of TCB) \TCP.DEFAULT.MAXSEG))))))))) then (if (NULL FLAGS) then (SETQ FLAGS 0)) (CHECK (OR (NOT (ZEROP LENGTH)) (NOT (ZEROP (\TCP.SYN.OR.FIN FLAGS))) (SHOULDNT "sending empty segment"))) (if (AND (IGREATERP LENGTH 0) (ILESSP LENGTH (fetch TCB.OUR.MAXSEG of TCB))) then (* PSH this segment to make sure it gets through to the remote process) (SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.PSH))) (UNINTERRUPTABLY (replace TCB.SND.SEGMENT of TCB with NIL) (replace CBUFSIZE of STREAM with 0) (replace COFFSET of STREAM with 0) (replace CPPTR of STREAM with NIL) (add (fetch (TCPSTREAM BYTECOUNT) of STREAM) LENGTH)) (add (fetch (IP IPTOTALLENGTH) of SEGMENT) LENGTH) (\TCP.SEND.DATA TCB SEGMENT LENGTH FLAGS))))) ) (\TCP.FORCEOUTPUT (LAMBDA (STREAM WAITFLG) (* ejs%: "27-May-86 14:36") (* just call \TCP.FLUSH with no flags -- to implement WAITFLG we should wait for SND.UNA to overtake the current SND.NXT) (COND ((NEQ STREAM (fetch (TCP.CONTROL.BLOCK TCB.SND.STREAM) of (fetch (TCPSTREAM TCB) of STREAM))) (\TCP.FLUSH (fetch (TCP.CONTROL.BLOCK TCB.SND.STREAM) of (fetch (TCPSTREAM TCB) of STREAM)))) (T (\TCP.FLUSH STREAM)))) ) (TCP.URGENT.MARK (LAMBDA (STREAM) (* ecc " 7-May-84 14:17") (* mark the current point in the output stream as the end of urgent data) (\TCP.FLUSH STREAM \TCP.CTRL.URG)) ) (\TCP.FILL.IN.SEGMENT (LAMBDA (STREAM OPTIONS) (* ejs%: "22-Jun-85 03:18") (* * set up a new segment to be filled by the output stream. OPTIONS, if supplied, is in PLIST format) (PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM)) SEGMENT) (SETQ SEGMENT (\TCP.SETUP.SEGMENT (\LOCAL.IP.ADDRESS) (fetch TCB.SRC.PORT of TCB) (fetch TCB.DST.HOST of TCB) (fetch TCB.DST.PORT of TCB))) (COND (OPTIONS (\TCP.SETUP.SEGMENT.OPTIONS SEGMENT OPTIONS))) (UNINTERRUPTABLY (replace TCB.SND.SEGMENT of TCB with SEGMENT) (replace CPPTR of STREAM with (fetch TCP.CONTENTS of SEGMENT)) (replace COFFSET of STREAM with 0) (replace CBUFSIZE of STREAM with (fetch TCB.MAXSEG of TCB)) (replace CBUFMAXSIZE of STREAM with (fetch TCB.MAXSEG of TCB))) (RETURN SEGMENT))) ) (\TCP.CLOSE (LAMBDA (STREAM) (* ejs%: "29-Jan-85 17:19") (PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM))) (if (OR (NULL TCB) (FMEMB (fetch TCB.STATE of TCB) (QUOTE (CLOSED TIME.WAIT)))) then (RETURN)) (if (NOT (fetch TCB.CLOSEDFLG of TCB)) then (TCP.CLOSE.SENDER (fetch TCB.SND.STREAM of TCB))) (if (EQ STREAM (fetch TCB.RCV.STREAM of TCB)) then (while (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB)) do (* gobble remaining segments from remote end) (\TCP.GET.SEGMENT STREAM))))) ) (\TCP.RESETCLOSE (LAMBDA (STREAM) (* ejs%: "27-May-86 11:55") (\TCP.CLOSE STREAM))) (TCP.CLOSE.SENDER (LAMBDA (STREAM) (* ecc " 7-May-84 13:44") (PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM))) (if (OR (NULL TCB) (EQ (fetch TCB.STATE of TCB) (QUOTE CLOSED)) (fetch TCB.CLOSEDFLG of TCB)) then (RETURN)) (WITH.MONITOR (fetch TCB.LOCK of TCB) (replace TCB.CLOSEDFLG of TCB with T) (SELECTQ (fetch TCB.STATE of TCB) ((LISTEN SYN.SENT) (\TCP.CONNECTION.DROPPED TCB "closed")) ((SYN.RECEIVED ESTABLISHED) (\TCP.TRACE.TRANSITION TCB (QUOTE FIN.WAIT.1)) (replace TCB.STATE of TCB with (QUOTE FIN.WAIT.1)) (\TCP.FLUSH STREAM \TCP.CTRL.FIN)) (CLOSE.WAIT (\TCP.TRACE.TRANSITION TCB (QUOTE LAST.ACK)) (replace TCB.STATE of TCB with (QUOTE LAST.ACK)) (* There is an inconsistency in the spec about this transition%: the description of the CLOSE operation says to go to the CLOSING state, while the diagram shows a transition to the LAST.ACK state. Since the LAST.ACK state avoids the 2MSL wait, we use it.) (\TCP.FLUSH STREAM \TCP.CTRL.FIN)) NIL) (while (NOT (OR (EQ (fetch TCB.STATE of TCB) (QUOTE CLOSED)) (\TCP.OUR.FIN.IS.ACKED TCB))) do (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB) (fetch TCB.FINACKED.EVENT of TCB)))))) ) (TCP.DESTADDRESS (LAMBDA (STREAM) (* ejs%: "27-May-86 11:53") (\IP.ADDRESS.TO.STRING (fetch (TCP.CONTROL.BLOCK TCB.DST.HOST) of (fetch (TCPSTREAM TCB) of STREAM)))) ) (TCP.STOP (LAMBDA NIL (* ejs%: "28-Dec-84 18:02") (MAPC \TCP.CONTROL.BLOCKS (FUNCTION \TCP.DELETE.TCB)) (SETQ \TCP.CONTROL.BLOCKS NIL) (\IP.DELETE.PROTOCOL \TCP.PROTOCOL)) ) ) (* ;; "well-known ports for network standard functions") (RPAQQ \TCP.ASSIGNED.PORTS (\TCP.ECHO.PORT \TCP.SINK.PORT \TCP.SYSTAT.PORT \TCP.DAYTIME.PORT \TCP.NETSTAT.PORT \TCP.FAUCET.PORT \TCP.FTP.PORT \TCP.TELNET.PORT \TCP.SMTP.PORT \TCP.TIME.PORT \TCP.NAME.PORT \TCP.WHOIS.PORT \TCP.NAMESERVER.PORT \TCP.FINGER.PORT \TCP.TTYLINK.PORT \TCP.SUPDUP.PORT \TCP.HOSTNAMES.PORT \TCP.UNIXEXEC.PORT \TCP.UNIXLOGIN.PORT \TCP.UNIXSHELL.PORT)) (DECLARE%: EVAL@COMPILE (RPAQQ \TCP.ECHO.PORT 7) (RPAQQ \TCP.SINK.PORT 9) (RPAQQ \TCP.SYSTAT.PORT 11) (RPAQQ \TCP.DAYTIME.PORT 13) (RPAQQ \TCP.NETSTAT.PORT 15) (RPAQQ \TCP.FAUCET.PORT 19) (RPAQQ \TCP.FTP.PORT 21) (RPAQQ \TCP.TELNET.PORT 23) (RPAQQ \TCP.SMTP.PORT 25) (RPAQQ \TCP.TIME.PORT 37) (RPAQQ \TCP.NAME.PORT 42) (RPAQQ \TCP.WHOIS.PORT 43) (RPAQQ \TCP.NAMESERVER.PORT 53) (RPAQQ \TCP.FINGER.PORT 79) (RPAQQ \TCP.TTYLINK.PORT 87) (RPAQQ \TCP.SUPDUP.PORT 95) (RPAQQ \TCP.HOSTNAMES.PORT 101) (RPAQQ \TCP.UNIXEXEC.PORT 512) (RPAQQ \TCP.UNIXLOGIN.PORT 513) (RPAQQ \TCP.UNIXSHELL.PORT 514) (CONSTANTS \TCP.ECHO.PORT \TCP.SINK.PORT \TCP.SYSTAT.PORT \TCP.DAYTIME.PORT \TCP.NETSTAT.PORT \TCP.FAUCET.PORT \TCP.FTP.PORT \TCP.TELNET.PORT \TCP.SMTP.PORT \TCP.TIME.PORT \TCP.NAME.PORT \TCP.WHOIS.PORT \TCP.NAMESERVER.PORT \TCP.FINGER.PORT \TCP.TTYLINK.PORT \TCP.SUPDUP.PORT \TCP.HOSTNAMES.PORT \TCP.UNIXEXEC.PORT \TCP.UNIXLOGIN.PORT \TCP.UNIXSHELL.PORT) ) (* ;; "Stub for debugging") (RPAQ? \TCP.DEBUGGABLE ) (RPAQ? TCPTRACEFLG ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \TCP.DEBUGGABLE TCPTRACEFLG) ) (DEFINEQ (PPTCB (LAMBDA (TCB FILE) (* ejs%: " 5-Feb-85 16:47") (DECLARE (GLOBALVARS \TCP.DEBUGGABLE)) (COND (\TCP.DEBUGGABLE (printout FILE "TCP connection from " %# (\IP.PRINT.ADDRESS (\LOCAL.IP.ADDRESS) FILE) ":" (fetch TCB.SRC.PORT of TCB) " to " %# (\IP.PRINT.ADDRESS (fetch TCB.DST.HOST of TCB) FILE) ":" (fetch TCB.DST.PORT of TCB) " " (fetch TCB.STATE of TCB) T) (printout FILE " iss " (fetch TCB.ISS of TCB) " window " (fetch TCB.SND.UNA of TCB) ".." (IPLUS (fetch TCB.SND.UNA of TCB) (fetch TCB.SND.WND of TCB)) " next " (fetch TCB.SND.NXT of TCB)) (if (fetch TCB.FINSEQ of TCB) then (printout FILE " fin " (fetch TCB.FINSEQ of TCB))) (printout FILE " rto " (fetch TCB.RTO of TCB) T) (printout FILE " irs " (fetch TCB.IRS of TCB) " next " (fetch TCB.RCV.NXT of TCB) " window " (fetch TCB.RCV.NXT of TCB) ".." (IPLUS (fetch TCB.RCV.NXT of TCB) (fetch TCB.RCV.WND of TCB)) T) (\TCP.PRINT.SEGMENT.QUEUE "retransmit queue" (fetch TCB.REXMT.QUEUE of TCB) FILE) (\TCP.PRINT.SEGMENT.QUEUE "input queue" (fetch TCB.INPUT.QUEUE of TCB) FILE)))) ) (\TCP.TRACE.SEGMENT (LAMBDA (CALLER SEGMENT) (* ejs%: " 5-Feb-85 16:50") (DECLARE (GLOBALVARS \TCP.DEBUGGABLE TCPTRACEFLG)) (if (AND \TCP.DEBUGGABLE (MEMB CALLER TCPTRACEFLG)) then (printout TCPTRACEFILE .TAB0 0 %# (\TCP.PRINT.ELAPSED.TIME TCPTRACEFILE) CALLER ": " %# (TCP.PRINT.SEGMENT SEGMENT TCPTRACEFILE NIL (MEMB (QUOTE CONTENTS) TCPTRACEFLG))))) ) (\TCP.TRACE.TRANSITION (LAMBDA (TCB NEWSTATE) (* ejs%: " 5-Feb-85 16:51") (DECLARE (GLOBALVARS \TCP.DEBUGGABLE)) (if (AND \TCP.DEBUGGABLE (MEMB (QUOTE TRANSITION) TCPTRACEFLG) (NEQ (fetch TCB.STATE of TCB) NEWSTATE)) then (printout TCPTRACEFILE .TAB0 0 %# (\TCP.PRINT.ELAPSED.TIME TCPTRACEFILE) (fetch TCB.SRC.PORT of TCB) "/" (fetch TCB.DST.PORT of TCB) ": " (fetch TCB.STATE of TCB) " ---> " NEWSTATE))) ) ) (* ;; "TCP initialization") (DEFINEQ (\TCP.INIT (LAMBDA NIL (* ; "Edited 11-Aug-88 14:32 by atm") (COND ((NULL \TCP.DEVICE) (SETQ \TCP.DEVICE (create FDEV FDBINABLE _ T FDBOUTABLE _ T BUFFERED _ T CLOSEFILE _ (FUNCTION \TCP.CLOSE) REGISTERFILE _ (FUNCTION \ADD-OPEN-STREAM) UNREGISTERFILE _ (FUNCTION \GENERIC-UNREGISTER-STREAM) OPENP _ (FUNCTION \GENERIC.OPENP) BIN _ (FUNCTION \BUFFERED.BIN) BOUT _ (FUNCTION \BUFFERED.BOUT) BLOCKIN _ (FUNCTION \BUFFERED.BINS) BLOCKOUT _ (FUNCTION \TCP.BOUTS) PEEKBIN _ (FUNCTION \BUFFERED.PEEKBIN) READP _ (FUNCTION \TCP.READP) FORCEOUTPUT _ (FUNCTION \TCP.FORCEOUTPUT) GETNEXTBUFFER _ (FUNCTION \TCP.GETNEXTBUFFER) BACKFILEPTR _ (FUNCTION \TCP.BACKFILEPTR) GETFILEPTR _ (FUNCTION \TCP.GETFILEPTR) EOFP _ (FUNCTION \TCP.EOFP) DEVICENAME _ (QUOTE TCP) EVENTFN _ (FUNCTION NILL))) (\DEFINEDEVICE (QUOTE TCP) \TCP.DEVICE))) (SETQ \TCP.LOCK (CREATE.MONITORLOCK)) (COND ((NULL \TCP.PSEUDOHEADER) (SETQ \TCP.PSEUDOHEADER (create TCP.PSEUDOHEADER)))) (OR \IPFLG (\IPINIT)) (\IP.ADD.PROTOCOL \TCP.PROTOCOL (FUNCTION \TCP.PORTCOMPARE) (FUNCTION \TCP.NOSOCKETFN) NIL (FUNCTION \TCP.HANDLE.ICMP)) (SETQ \TCP.MASTER.SOCKET (\IP.FIND.PROTOCOL \TCP.PROTOCOL))) ) ) (\TCP.INIT) (PUTPROPS TCP COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1901 1900 1987 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (8342 9364 (SET.IP.ADDRESS 8352 . 8622) (STRING.TO.IP.ADDRESS 8624 . 8865) ( IP.ADDRESS.TO.STRING 8867 . 9091) (\LOCAL.IP.ADDRESS 9093 . 9362)) (14232 14439 (\TCP.SELECT.ISS 14242 . 14437)) (28588 34348 (\TCP.CREATE.TCB 28598 . 29684) (\TCP.SELECT.PORT 29686 . 29968) ( \TCP.LOOKUP.TCB 29970 . 30867) (\TCP.DELETE.TCB 30869 . 32537) (\TCP.NOSOCKETFN 32539 . 33367) ( \TCP.PORTCOMPARE 33369 . 34346)) (36215 38810 (\COMPUTE.CHECKSUM 36225 . 36891) ( \TCP.CHECKSUM.INCOMING 36893 . 37989) (\TCP.CHECKSUM.OUTGOING 37991 . 38808)) (39315 77802 (\TCP.ACK# 39325 . 39782) (\TCP.PACKET.FILTER 39784 . 40055) (\TCP.SETUP.SEGMENT 40057 . 40587) ( \TCP.RELEASE.SEGMENT 40589 . 40843) (\TCP.CONNECTION 40845 . 44136) (\TCP.FIX.INCOMING.SEGMENT 44138 . 44766) (\TCP.DATA.LENGTH 44768 . 45096) (\TCP.SYN.OR.FIN 45098 . 45438) (\TCP.INPUT 45440 . 48309) (\TCP.INPUT.INITIAL 48311 . 49094) (\TCP.INPUT.UNSYNC 49096 . 49466) (\TCP.INPUT.LISTEN 49468 . 50911) (\TCP.INPUT.SYN.SENT 50913 . 52778) (\TCP.CHECK.WINDOW 52780 . 53628) (\TCP.CHECK.RESET 53630 . 54398 ) (\TCP.CHECK.SECURITY 54400 . 54600) (\TCP.CHECK.NO.SYN 54602 . 55166) (\TCP.CHECK.ACK 55168 . 55443) (\TCP.HANDLE.ACK 55445 . 56750) (\TCP.HANDLE.URG 56752 . 57345) (\TCP.QUEUE.INPUT 57347 . 61011) ( \TCP.HANDLE.FIN 61013 . 62109) (\TCP.OUR.FIN.IS.ACKED 62111 . 62378) (\TCP.SIGNAL.URGENT.DATA 62380 . 62586) (\TCP.PROCESS 62588 . 65394) (\TCP.TEMPLATE 65396 . 66104) (\TCP.SETUP.SEGMENT.OPTIONS 66106 . 67362) (\TCP.SEND.CONTROL 67364 . 68215) (\TCP.SEND.ACK 68217 . 68655) (\TCP.SEND.RESET 68657 . 69371) (\TCP.FIX.OUTGOING.SEGMENT 69373 . 70111) (\TCP.SEND.DATA 70113 . 72955) (\TCP.SEND.SEGMENT 72957 . 73305) (\TCP.NEW.TEMPLATE 73307 . 73432) (\TCP.START.PROBE.TIMER 73434 . 73897) (\TCP.RETRANSMIT 73899 . 75994) (\TCP.START.TIME.WAIT 75996 . 76281) (\TCP.CONNECTION.DROPPED 76283 . 76787) ( \TCP.CHECK.OPTIONS 76789 . 77047) (\TCP.PROCESS.OPTIONS 77049 . 77800)) (78261 78997 (\TCP.HANDLE.ICMP 78271 . 78995)) (79035 93181 (TCP.OPEN 79045 . 79822) (TCP.OTHER.STREAM 79824 . 80161) (\TCP.BOUTS 80163 . 80384) (\TCP.OTHER.BIN 80386 . 80485) (\TCP.OTHER.BOUT 80487 . 80597) (\TCP.BIN 80599 . 80952) (\TCP.BACKFILEPTR 80954 . 81210) (\TCP.GETNEXTBUFFER 81212 . 81725) (\TCP.GET.SEGMENT 81727 . 85444) (\TCP.PEEKBIN 85446 . 85802) (\TCP.GETFILEPTR 85804 . 85955) (\TCP.READP 85957 . 86354) (\TCP.EOFP 86356 . 87244) (TCP.URGENTP 87246 . 87703) (TCP.URGENT.EVENT 87705 . 87911) (\TCP.BOUT 87913 . 88223) (\TCP.FLUSH 88225 . 89779) (\TCP.FORCEOUTPUT 89781 . 90199) (TCP.URGENT.MARK 90201 . 90375) ( \TCP.FILL.IN.SEGMENT 90377 . 91122) (\TCP.CLOSE 91124 . 91604) (\TCP.RESETCLOSE 91606 . 91693) ( TCP.CLOSE.SENDER 91695 . 92828) (TCP.DESTADDRESS 92830 . 93000) (TCP.STOP 93002 . 93179)) (94939 96765 (PPTCB 94949 . 95990) (\TCP.TRACE.SEGMENT 95992 . 96350) (\TCP.TRACE.TRANSITION 96352 . 96763)) ( 96802 97966 (\TCP.INIT 96812 . 97964))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPCHAT b/obsolete/tcp/TCPCHAT new file mode 100644 index 00000000..0c4735fc --- /dev/null +++ b/obsolete/tcp/TCPCHAT @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "12-Jun-90 16:10:42" {DSK}local>lde>lispcore>library>TCPCHAT.;3 11300 changes to%: (FILES TCP) (VARS TCPCHATCOMS) previous date%: "15-Feb-90 13:09:03" {DSK}local>lde>lispcore>library>TCPCHAT.;2) (* ; " Copyright (c) 1985, 1986, 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPCHATCOMS) (RPAQQ TCPCHATCOMS [(FNS TCPCHAT.BIN TCPCHAT.HOST.FILTER TCPCHAT.NEGOTIATE TCPCHAT.OPEN TCPCHAT.OPTION.COMMAND TCPCHAT.OPTION.INPUT TCPCHAT.OPTION.OUTPUT TCPCHAT.OPTION.TRACE TCPCHAT.TERMINAL.TYPE) (VARS TCPCHAT.TELNET.TTY.TYPES TELNET.OPTIONS) (INITVARS (TCPCHAT.TRACEFLG) (TCPCHAT.TRACEFILE)) (FILES (SYSLOAD) TCP CHAT) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES CHATDECLS) (COMS (CONSTANTS * TELNET.COMMANDS) (CONSTANTS * TELNET.MARKS)) (RECORDS TELNET.OPTION TELNET.OPTIONSTATE) (GLOBALVARS TCPCHAT.TELNET.TTY.TYPES TELNET.OPTIONS TELNET.MARKS)) (DECLARE%: DONTEVAL@LOAD DOCOPY (* ;; "Tell Chat we exist ") (ADDVARS (CHAT.PROTOCOLTYPES (TCP . TCPCHAT.HOST.FILTER)) (CHAT.PROTOCOL.ABBREVS (N . TCP) (T . TCP]) (DEFINEQ (TCPCHAT.BIN (LAMBDA (STREAM) (* ; "Edited 7-Jul-88 18:03 by atm") (bind CHAR while (AND (EQ (SETQ CHAR (\BUFFERED.BIN STREAM)) TELNET.IAC) (NEQ (SETQ CHAR (\BUFFERED.BIN STREAM)) TELNET.IAC)) do (TCPCHAT.NEGOTIATE CHAR STREAM) finally (RETURN CHAR))) ) (TCPCHAT.HOST.FILTER (LAMBDA (HOST) (* ; "Edited 12-Apr-88 17:14 by bvm") (COND ((AND \IPFLG (DODIP.HOSTP HOST)) (LIST HOST (FUNCTION TCPCHAT.OPEN))))) ) (TCPCHAT.NEGOTIATE (LAMBDA (COMMAND STREAM) (* ; "Edited 7-Jul-88 18:03 by atm") (TCPCHAT.OPTION.INPUT (TCP.OTHER.STREAM STREAM) COMMAND (\BUFFERED.BIN STREAM))) ) (TCPCHAT.OPEN (LAMBDA (HOST) (* ; "Edited 17-Apr-87 10:06 by jrb:") (PROG ((STREAM (TCP.OPEN (DODIP.HOSTP HOST) \TCP.TELNET.PORT NIL (QUOTE ACTIVE) (QUOTE INPUT))) (OSTYPE (OR (AND (GETHASH (U-CASE HOST) \IP.HOSTNAMES) (fetch (HOSTS.TXT.ENTRY HTE.OS.TYPE) of (GETHASH (U-CASE HOST) \IP.HOSTNAMES))) (GETHOSTINFO HOST (QUOTE OSTYPE)))) OUTPUTSTREAM) (COND (STREAM (replace (STREAM BINABLE) of STREAM with NIL) (* ; "Can't run microcoded") (replace (STREAM STRMBINFN) of STREAM with (FUNCTION TCPCHAT.BIN)) (STREAMPROP STREAM (QUOTE SETDISPLAYTYPE) (FUNCTION NILL)) (COND ((EQ OSTYPE (QUOTE INTERLISP)) (RETURN (CONS STREAM (TCP.OTHER.STREAM STREAM))))) (* ; "(STREAMPROP STREAM (QUOTE SETDISPLAYTYPE) (FUNCTION TCPCHAT.TERMINAL.TYPE))") (SETQ OUTPUTSTREAM (TCP.OTHER.STREAM STREAM)) (STREAMPROP OUTPUTSTREAM (QUOTE OPTIONSTATES) (for OPTION in TELNET.OPTIONS collect (create TELNET.OPTIONSTATE OPTION _ (fetch (TELNET.OPTION OPTION) of OPTION)))) (TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.DO TELNET.ECHO) (TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.DO TELNET.SUPPRESS.GOAHEAD) (TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.WILL TELNET.SUPPRESS.GOAHEAD) (COND ((NEQ OSTYPE (QUOTE UNIX)) (TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.DO TELNET.BINARY) (TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.WILL TELNET.BINARY))) (RETURN (CONS STREAM OUTPUTSTREAM)))))) ) (TCPCHAT.OPTION.COMMAND (LAMBDA (OUTPUTSTREAM COMMAND OPTION TRACECAPTION) (* ; "Edited 24-Aug-87 16:58 by scp") (LET ((OPTIONSTATE (FASSOC OPTION (STREAMPROP OUTPUTSTREAM (QUOTE OPTIONSTATES)))) GO.AHEAD.WITH.COMMAND) (COND ((NULL OPTIONSTATE) (SETQ GO.AHEAD.WITH.COMMAND T)) (T (SELECTC COMMAND (TELNET.DO (COND ((NEQ (fetch (TELNET.OPTIONSTATE DOING) of OPTIONSTATE) (QUOTE YES)) (SETQ GO.AHEAD.WITH.COMMAND T) (replace (TELNET.OPTIONSTATE DOING) of OPTIONSTATE with (QUOTE YES))))) (TELNET.WILL (COND ((NEQ (fetch (TELNET.OPTIONSTATE WILLING) of OPTIONSTATE) (QUOTE YES)) (SETQ GO.AHEAD.WITH.COMMAND T) (replace (TELNET.OPTIONSTATE WILLING) of OPTIONSTATE with (QUOTE YES))))) (TELNET.DONT (COND ((NEQ (fetch (TELNET.OPTIONSTATE DOING) of OPTIONSTATE) (QUOTE NO)) (SETQ GO.AHEAD.WITH.COMMAND T) (replace (TELNET.OPTIONSTATE DOING) of OPTIONSTATE with (QUOTE NO))))) (TELNET.WONT (COND ((NEQ (fetch (TELNET.OPTIONSTATE WILLING) of OPTIONSTATE) (QUOTE NO)) (SETQ GO.AHEAD.WITH.COMMAND T) (replace (TELNET.OPTIONSTATE WILLING) of OPTIONSTATE with (QUOTE NO))))) NIL))) (COND (GO.AHEAD.WITH.COMMAND (BOUT OUTPUTSTREAM TELNET.IAC) (BOUT OUTPUTSTREAM COMMAND) (BOUT OUTPUTSTREAM OPTION) (FORCEOUTPUT OUTPUTSTREAM) (TCPCHAT.OPTION.TRACE COMMAND OPTION (OR TRACECAPTION (QUOTE SEND))))))) ) (TCPCHAT.OPTION.INPUT (LAMBDA (OUTPUTSTREAM COMMAND OPTION) (* ; "Edited 16-Apr-87 13:30 by jrb:") (LET ((OPTIONRECORD (FASSOC OPTION TELNET.OPTIONS))) (COND (OPTIONRECORD (SELECTC COMMAND (TELNET.DO (TCPCHAT.OPTION.TRACE (QUOTE DO) OPTION (QUOTE RECV)) (TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (fetch (TELNET.OPTION ON.DO) of OPTIONRECORD) OPTION)) (TELNET.DONT (TCPCHAT.OPTION.TRACE (QUOTE DONT) OPTION (QUOTE RECV)) (TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (fetch (TELNET.OPTION ON.DONT) of OPTIONRECORD) OPTION)) (TELNET.WILL (TCPCHAT.OPTION.TRACE (QUOTE WILL) OPTION (QUOTE RECV)) (TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (fetch (TELNET.OPTION ON.WILL) of OPTIONRECORD) OPTION)) (TELNET.WONT (TCPCHAT.OPTION.TRACE (QUOTE WONT) OPTION (QUOTE RECV)) (TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (fetch (TELNET.OPTION ON.WONT) of OPTIONRECORD) OPTION)) (TELNET.SB (TCPCHAT.OPTION.TRACE (QUOTE SB) OPTION (QUOTE RECV)) (TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (fetch (TELNET.OPTION ON.SB) of OPTIONRECORD) OPTION)) COMMAND)) (T (TCPCHAT.OPTION.TRACE COMMAND OPTION) (TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (QUOTE WONT) OPTION))))) ) (TCPCHAT.OPTION.OUTPUT (LAMBDA (OUTPUTSTREAM COMMAND OPTION) (* ; "Edited 17-Apr-87 16:34 by jrb:") (LET (CMDNUM) (COND ((NULL COMMAND)) ((SETQ CMDNUM (CDR (FASSOC COMMAND (BQUOTE ((WILL \, TELNET.WILL) (WONT \, TELNET.WONT) (DO \, TELNET.DO) (DONT \, TELNET.DONT)))))) (TCPCHAT.OPTION.COMMAND OUTPUTSTREAM CMDNUM OPTION (QUOTE SENDBACK))) (T (APPLY* COMMAND (TCP.OTHER.STREAM OUTPUTSTREAM)))))) ) (TCPCHAT.OPTION.TRACE (LAMBDA (COMMAND OPTION PREFIX) (* ejs%: "22-Apr-85 16:41") (DECLARE (GLOBALVARS TCPCHAT.TRACEFLG TCPCHAT.TRACEFILE)) (COND (TCPCHAT.TRACEFLG (COND ((SMALLP COMMAND) (SETQ COMMAND (SELECTC COMMAND (TELNET.DO (QUOTE DO)) (TELNET.DONT (QUOTE DONT)) (TELNET.WILL (QUOTE WILL)) (TELNET.WONT (QUOTE WONT)) COMMAND)))) (printout TCPCHAT.TRACEFILE PREFIX ": " COMMAND " ") (PRINTCONSTANT OPTION TELNET.MARKS TCPCHAT.TRACEFILE) (TERPRI TCPCHAT.TRACEFILE)))) ) (TCPCHAT.TERMINAL.TYPE (LAMBDA (INPUTSTREAM) (* ; "Edited 20-Apr-87 13:42 by jrb:") (LET ((COMMAND)) (SELECTC (\BUFFERED.BIN INPUTSTREAM) (TELNET.SEND (* ; "OK, should be followed by IAC SE") (IF TCPCHAT.TRACEFLG THEN (printout TCPCHAT.TRACEFILE "REQUEST IS SEND")) (IF (EQ (SETQ COMMAND (\BUFFERED.BIN INPUTSTREAM)) TELNET.IAC) THEN (IF TCPCHAT.TRACEFLG THEN (printout TCPCHAT.TRACEFILE " IAC")) ELSE (IF TCPCHAT.TRACEFLG THEN (printout " EXPECTED IAC, GOT " COMMAND))) (IF (EQ (SETQ COMMAND (\BUFFERED.BIN INPUTSTREAM)) TELNET.SE) THEN (IF TCPCHAT.TRACEFLG THEN (printout TCPCHAT.TRACEFILE " SE")) ELSE (IF TCPCHAT.TRACEFLG THEN (printout " EXPECTED SE, GOT " COMMAND))) (IF TCPCHAT.TRACEFLG THEN (TERPRI TCPCHAT.TRACEFILE)) (LET* ((OUTPUTSTREAM (TCP.OTHER.STREAM INPUTSTREAM)) (DISPLAYTYPE (OR (CDR (FASSOC (fetch (CHATDISPLAYTYPE DPYNAME) of (STREAMPROP INPUTSTREAM (QUOTE DISPLAYTYPE))) TCPCHAT.TELNET.TTY.TYPES)) (CDR (FASSOC (fetch (CHATDISPLAYTYPE DPYNAME) of (STREAMPROP OUTPUTSTREAM (QUOTE DISPLAYTYPE))) TCPCHAT.TELNET.TTY.TYPES))))) (BOUT OUTPUTSTREAM TELNET.IAC) (BOUT OUTPUTSTREAM TELNET.SB) (BOUT OUTPUTSTREAM TELNET.TERMINAL.TYPE) (BOUT OUTPUTSTREAM TELNET.IS) (PRIN1 DISPLAYTYPE OUTPUTSTREAM) (BOUT OUTPUTSTREAM TELNET.IAC) (BOUT OUTPUTSTREAM TELNET.SE) (FORCEOUTPUT OUTPUTSTREAM) (COND (TCPCHAT.TRACEFLG (printout TCPCHAT.TRACEFILE "SEND(BACK) IAC SB TERMINAL-TYPE IS " DISPLAYTYPE " IAC SE" T))))) (TELNET.IS (* ; "We told them we couldn't handle this - or would have had they asked...") (IF TCPCHAT.TRACEFLG THEN (printout TCPCHAT.TRACEFILE "REQUEST IS IS, which is an error: rest of command is:" T)) (WHILE (NEQ (SETQ COMMAND (\BUFFERED.BIN INPUTSTREAM)) TELNET.SE) DO (IF TCPCHAT.TRACEFLG THEN (PRIN1 (CHARACTER COMMAND) TCPCHAT.TRACEFILE))) (IF TCPCHAT.TRACEFLG THEN (printout TCPCHAT.TRACEFILE " SE" T))) (IF TCPCHAT.TRACEFLG THEN (printout TCPCHAT.TRACEFILE "REQUEST IS " COMMAND ", which is an error" T))))) ) ) (RPAQQ TCPCHAT.TELNET.TTY.TYPES ((DM2500 . DATAMEDIA-2500) (VT100 . DEC-VT100))) (RPAQQ TELNET.OPTIONS ((94 WONT WONT DONT DONT) (0 WILL WONT NIL DONT) (1 WONT WONT DO DO) (3 WILL WILL NIL NIL) (5 WONT WONT DONT DONT) (6 WILL NIL NIL NIL) (24 WILL NIL DONT NIL TCPCHAT.TERMINAL.TYPE))) (RPAQ? TCPCHAT.TRACEFLG ) (RPAQ? TCPCHAT.TRACEFILE ) (FILESLOAD (SYSLOAD) TCP CHAT) (DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD CHATDECLS) (RPAQQ TELNET.COMMANDS ((TELNET.SE 240) (TELNET.SB 250) (TELNET.WILL 251) (TELNET.WONT 252) (TELNET.DO 253) (TELNET.DONT 254) (TELNET.IAC 255) (TELNET.SEND 1) (TELNET.IS 0))) (DECLARE%: EVAL@COMPILE (RPAQQ TELNET.SE 240) (RPAQQ TELNET.SB 250) (RPAQQ TELNET.WILL 251) (RPAQQ TELNET.WONT 252) (RPAQQ TELNET.DO 253) (RPAQQ TELNET.DONT 254) (RPAQQ TELNET.IAC 255) (RPAQQ TELNET.SEND 1) (RPAQQ TELNET.IS 0) (CONSTANTS (TELNET.SE 240) (TELNET.SB 250) (TELNET.WILL 251) (TELNET.WONT 252) (TELNET.DO 253) (TELNET.DONT 254) (TELNET.IAC 255) (TELNET.SEND 1) (TELNET.IS 0)) ) (RPAQQ TELNET.MARKS ((TELNET.BINARY 0) (TELNET.ECHO 1) (TELNET.SUPPRESS.GOAHEAD 3) (TELNET.STATUS 5) (TELNET.TIMING.MARK 6) (TELNET.TERMINAL.TYPE 24))) (DECLARE%: EVAL@COMPILE (RPAQQ TELNET.BINARY 0) (RPAQQ TELNET.ECHO 1) (RPAQQ TELNET.SUPPRESS.GOAHEAD 3) (RPAQQ TELNET.STATUS 5) (RPAQQ TELNET.TIMING.MARK 6) (RPAQQ TELNET.TERMINAL.TYPE 24) (CONSTANTS (TELNET.BINARY 0) (TELNET.ECHO 1) (TELNET.SUPPRESS.GOAHEAD 3) (TELNET.STATUS 5) (TELNET.TIMING.MARK 6) (TELNET.TERMINAL.TYPE 24)) ) (DECLARE%: EVAL@COMPILE (RECORD TELNET.OPTION (OPTION ON.DO ON.DONT ON.WILL ON.WONT ON.SB)) (RECORD TELNET.OPTIONSTATE (OPTION WILLING DOING)) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TCPCHAT.TELNET.TTY.TYPES TELNET.OPTIONS TELNET.MARKS) ) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (ADDTOVAR CHAT.PROTOCOLTYPES (TCP . TCPCHAT.HOST.FILTER)) (ADDTOVAR CHAT.PROTOCOL.ABBREVS (N . TCP) (T . TCP)) ) (PUTPROPS TCPCHAT COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1430 8610 (TCPCHAT.BIN 1440 . 1698) (TCPCHAT.HOST.FILTER 1700 . 1857) ( TCPCHAT.NEGOTIATE 1859 . 2027) (TCPCHAT.OPEN 2029 . 3387) (TCPCHAT.OPTION.COMMAND 3389 . 4679) ( TCPCHAT.OPTION.INPUT 4681 . 5785) (TCPCHAT.OPTION.OUTPUT 5787 . 6188) (TCPCHAT.OPTION.TRACE 6190 . 6667) (TCPCHAT.TERMINAL.TYPE 6669 . 8608))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPCONFIG b/obsolete/tcp/TCPCONFIG new file mode 100644 index 00000000..257f8dd5 --- /dev/null +++ b/obsolete/tcp/TCPCONFIG @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP") (FILECREATED "12-Jun-90 16:11:50" {DSK}local>lde>lispcore>library>TCPCONFIG.;2 18742 changes to%: (VARS TCPCONFIGCOMS) previous date%: "18-Apr-88 21:05:32" {DSK}local>lde>lispcore>library>TCPCONFIG.;1) (* ; " Copyright (c) 1985, 1986, 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPCONFIGCOMS) (RPAQQ TCPCONFIGCOMS ((PROP MAKEFILE-ENVIRONMENT TCPCONFIG) (DECLARE%: EVAL@COMPILE DONTCOPY (COMS (RECORDS IPINIT)) (GLOBALVARS \IP.LOCAL.NETWORKS \IP.DEFAULT.GATEWAY \IP.INIT.FILE \IP.SUBNET.MASKS \PROCESS.AFTEREXIT.EVENT \PROC.READY \AR.IP.TO.10MB.ALIST)) (COMS (* TCP configuration module) (EXPORT (RECORDS IPINIT)) (INITVARS (\IP.DEFAULT.CONFIGURATION (create IPINIT)) (\IPFLG NIL)) (FILES TCPLLIP) (FNS TCP.CONFIGURE TCP.LIMITCHARS \TCPCONFIG.RESETFN \TCPCONFIG.QUITFN TCP.ALPHA.LIMITCHARS \TCPCONFIG.APPLYFN)))) (PUTPROPS TCPCONFIG MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP")) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE (RECORD IPINIT (LOCAL.ADDRESSES LOCAL.NETWORKS DEFAULT.GATEWAY HTE.FILE HOSTNAME SUBNETMASK DOMAIN.SERVERS LOCAL.DOMAIN LOCAL.NSHOSTNUMBER)) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \IP.LOCAL.NETWORKS \IP.DEFAULT.GATEWAY \IP.INIT.FILE \IP.SUBNET.MASKS \PROCESS.AFTEREXIT.EVENT \PROC.READY \AR.IP.TO.10MB.ALIST) ) ) (* TCP configuration module) (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (RECORD IPINIT (LOCAL.ADDRESSES LOCAL.NETWORKS DEFAULT.GATEWAY HTE.FILE HOSTNAME SUBNETMASK DOMAIN.SERVERS LOCAL.DOMAIN LOCAL.NSHOSTNUMBER)) ) (* "END EXPORTED DEFINITIONS") (RPAQ? \IP.DEFAULT.CONFIGURATION (create IPINIT)) (RPAQ? \IPFLG NIL) (FILESLOAD TCPLLIP) (DEFINEQ (TCP.CONFIGURE [LAMBDA NIL (DECLARE (GLOBALVARS \IP.DEFAULT.CONFIGURATION)) (* ; "Edited 18-Mar-88 15:41 by bvm") (LET* ((CONFIG (OR (AND (INFILEP '{DSK}IP.INIT) (\IP.READ.INIT.FILE '{DSK}IP.INIT)) \IP.DEFAULT.CONFIGURATION (create IPINIT))) (TCP.FREEMENU (FREEMENU `((PROPS FONT (GACHA 12 BOLD)) ((PROPS BOX 2) (LABEL " " TYPE DISPLAY) (LABEL "Apply!" TYPE MOMENTARY SELECTEDFN \TCPCONFIG.APPLYFN) (LABEL " " TYPE DISPLAY) (LABEL "Reset!" TYPE MOMENTARY SELECTEDFN \TCPCONFIG.RESETFN) (LABEL " " TYPE DISPLAY) (LABEL "Quit!" TYPE MOMENTARY SELECTEDFN \TCPCONFIG.QUITFN) (LABEL " " TYPE DISPLAY)) ((LABEL "" TYPE DISPLAY)) ((LABEL " Host Name:" TYPE EDITSTART MESSAGE "Enter the name of this host" LINKS (EDIT HOST.NAME)) (LABEL ,(OR (fetch (IPINIT HOSTNAME) of CONFIG) "") FONT (GACHA 12) TYPE EDIT ID HOST.NAME LIMITCHARS TCP.ALPHA.LIMITCHARS)) ((LABEL " Host Address:" TYPE EDITSTART MESSAGE "Enter the IP address of this host. Format: 13.0.10.5" LINKS (EDIT ADDRESS)) (LABEL ,(OR (CAR (fetch (IPINIT LOCAL.ADDRESSES) of CONFIG)) "") FONT (GACHA 12) TYPE EDIT ID ADDRESS LIMITCHARS TCP.LIMITCHARS)) ((LABEL "Network Address:" TYPE EDITSTART MESSAGE "Enter the IP address of the local network. Format: 13.0.0.0 Leave the host address fields 0." LINKS (EDIT NETWORK.ADDRESS)) (LABEL ,(OR (CAAR (fetch (IPINIT LOCAL.NETWORKS) of CONFIG)) "") FONT (GACHA 12) TYPE EDIT ID NETWORK.ADDRESS LIMITCHARS TCP.LIMITCHARS)) ((LABEL " Subnet mask:" TYPE EDITSTART MESSAGE "Enter the subnet mask. Format: 13.255.252.0 If the bitwise-AND of this address and any destination IP address is not equal to the bitwise-AND of this address and the host's local IP address, the destination IP address will be considered to be on another (sub)network" LINKS (EDIT SUBNET.MASK)) (LABEL ,(OR (CAR (fetch (IPINIT SUBNETMASK) of CONFIG)) "") FONT (GACHA 12) TYPE EDIT ID SUBNET.MASK LIMITCHARS TCP.LIMITCHARS)) ((LABEL "Default Gateway:" TYPE EDITSTART MESSAGE "Enter the IP address of the default gateway for this host. Format 13.0.10.34" LINKS (EDIT DEFAULT.GATEWAY)) (LABEL ,(OR (fetch (IPINIT DEFAULT.GATEWAY) of CONFIG) "") FONT (GACHA 12) TYPE EDIT ID DEFAULT.GATEWAY LIMITCHARS TCP.ALPHA.LIMITCHARS)) ((LABEL " Local Domain:" TYPE EDITSTART MESSAGE "Enter the name of the Internet domain in which this host resides" LINKS (EDIT LOCAL.DOMAIN)) (LABEL ,(OR (fetch (IPINIT LOCAL.DOMAIN) of CONFIG) "") FONT (GACHA 12) TYPE EDIT ID LOCAL.DOMAIN LIMITCHARS TCP.ALPHA.LIMITCHARS)) ((LABEL " Domain servers:" TYPE EDITSTART MESSAGE "Enter the IP addresses of the local domain servers. Format 13.0.10.21 12.0.15.22 ..." LINKS (EDIT DOMAIN.SERVERS)) (LABEL ,(if (fetch (IPINIT DOMAIN.SERVERS) of CONFIG) then (for ADDRESS in (fetch (IPINIT DOMAIN.SERVERS ) of CONFIG) bind (STRING _ "") do (SETQ STRING (CONCAT STRING ADDRESS " ")) finally (RETURN (SUBSTRING STRING 1 -2))) else "") FONT (GACHA 12) TYPE EDIT ID DOMAIN.SERVERS LIMITCHARS TCP.ALPHA.LIMITCHARS)) ((LABEL " Hosts.txt file:" TYPE EDITSTART MESSAGE "Enter the name of the Hosts.txt file to be used for translating IP hostnames to IP host addresses." LINKS (EDIT HOSTS.FILE)) (LABEL ,(OR (fetch (IPINIT HTE.FILE) of CONFIG) "") FONT (GACHA 12) TYPE EDIT ID HOSTS.FILE LIMITCHARS TCP.ALPHA.LIMITCHARS))) "TCP Configuration")) (REG (WINDOWPROP TCP.FREEMENU 'REGION)) (WIDTH (fetch (REGION WIDTH) of REG)) (HEIGHT (fetch (REGION HEIGHT) of REG))) (WINDOWPROP TCP.FREEMENU 'MINSIZE (CONS WIDTH HEIGHT)) (WINDOWPROP TCP.FREEMENU 'MAXSIZE (CONS 65535 HEIGHT)) (MOVEW TCP.FREEMENU (GETBOXPOSITION WIDTH HEIGHT)) (OPENW TCP.FREEMENU) NIL]) (TCP.LIMITCHARS [LAMBDA (ITEM WINDOW CHARACTER) (* ; "Edited 20-Jan-88 15:37 by Snow") (* ;; "allows numbers or periods until a CR then skips to the next item in the menu.") (COND ((FMEMB CHARACTER '(0 1 2 3 4 5 6 7 8 9 %.)) T) ((EQ (CHARACTER (CHARCODE EOL)) CHARACTER) (FM.SKIPNEXT WINDOW)) (T NIL]) (\TCPCONFIG.RESETFN (LAMBDA (ITEM WINDOW BUTTONS) (* ; "Edited 18-Jan-88 18:32 by Briggs") (AND (GETPROMPTWINDOW WINDOW) (CLEARW (GETPROMPTWINDOW WINDOW))) (FM.RESETMENU WINDOW)) ) (\TCPCONFIG.QUITFN (LAMBDA (ITEM WINDOW BUTTONS) (* ; "Edited 18-Jan-88 15:40 by Briggs") (FM.ENDEDIT WINDOW) (CLOSEW WINDOW)) ) (TCP.ALPHA.LIMITCHARS [LAMBDA (ITEM WINDOW CHAR) (* ; "Edited 20-Jan-88 15:32 by Snow") (* ;; "This function will allow all characters until a CR then call Fm.Skipnext to move on to the next entry in the table.") (IF (EQ (CHARACTER (CHARCODE CR)) CHAR) THEN (FM.SKIPNEXT WINDOW) ELSE T]) (\TCPCONFIG.APPLYFN [LAMBDA (ITEM WINDOW BUTTONS) (* ; "Edited 18-Mar-88 18:37 by bvm") (* ;; "Before reseting any of the parameters, verify their validity") (FM.ENDEDIT WINDOW) (PROG ((STATE (FM.GETSTATE WINDOW)) (FMPROMPTWINDOW (GETPROMPTWINDOW WINDOW 3)) (CONFIG (create IPINIT LOCAL.NSHOSTNUMBER _ \MY.NSHOSTNUMBER)) IPADDRESS SCRATCH) (* ;; "Before reseting any of the parameters, verify their validity") (CLEARW FMPROMPTWINDOW) (* ;; "So we don't have to check later...") (if (NOT (OR \10MBLOCALNDB \3MBLOCALNDB)) then (printout FMPROMPTWINDOW "This machine doesn't appear to be on any networks!") (RETURN)) (* ;; "") (* ;; "Host name is required") (* ;; "") (SETQ SCRATCH (LISTGET STATE 'HOST.NAME)) (if (STRING-EQUAL SCRATCH "") then (printout FMPROMPTWINDOW "Host name is required!") (FM.EDITITEM (FM.GETITEM 'HOST.NAME NIL WINDOW) WINDOW) (RETURN)) (replace (IPINIT HOSTNAME) of CONFIG with SCRATCH) (* ;; "") (* ;; " Verify host address") (* ;; "") (SETQ SCRATCH (LISTGET STATE 'ADDRESS)) (if (STRING-EQUAL SCRATCH "") then (printout FMPROMPTWINDOW "Host address is required!") (FM.EDITITEM (FM.GETITEM 'ADDRESS NIL WINDOW) WINDOW) (RETURN) elseif (OR (NULL (SETQ IPADDRESS (\IP.READ.STRING.ADDRESS SCRATCH))) (ZEROP (\IPNETADDRESS IPADDRESS))) then (printout FMPROMPTWINDOW "Malformed host address: " SCRATCH) (FM.EDITITEM (FM.GETITEM 'ADDRESS NIL WINDOW) WINDOW) (RETURN)) (replace (IPINIT LOCAL.ADDRESSES) of CONFIG with (LIST (\IP.ADDRESS.TO.STRING IPADDRESS))) (* ;; "") (* ;; "Verify network address. The list is an alist keyed by network address, and containing the atom 10 or 3 indicating the kind of network. We assume the host is only on one network.") (* ;; "") (SETQ SCRATCH (LISTGET STATE 'NETWORK.ADDRESS)) (if (STRING-EQUAL SCRATCH "") then (printout FMPROMPTWINDOW "Network address is required!") (FM.EDITITEM (FM.GETITEM 'NETWORK.ADDRESS NIL WINDOW) WINDOW) (RETURN) elseif (OR (NULL (SETQ IPADDRESS (\IP.READ.STRING.ADDRESS SCRATCH))) (ZEROP (\IPNETADDRESS IPADDRESS))) then (printout FMPROMPTWINDOW "Malformed network address: " SCRATCH) (FM.EDITITEM (FM.GETITEM 'NETWORK.ADDRESS NIL WINDOW) WINDOW) (RETURN)) [replace (IPINIT LOCAL.NETWORKS) of CONFIG with (LIST (CONS (\IP.ADDRESS.TO.STRING IPADDRESS) (if \10MBLOCALNDB then 10 else 3] (* ;; "") (* ;; " Verify subnet mask") (* ;; "") (SETQ SCRATCH (LISTGET STATE 'SUBNET.MASK)) (if (STRING-EQUAL SCRATCH "") then (printout FMPROMPTWINDOW "Subnet mask is required!") (FM.EDITITEM (FM.GETITEM 'SUBNET.MASK NIL WINDOW) WINDOW) (RETURN) elseif (OR (NULL (SETQ IPADDRESS (\IP.READ.STRING.ADDRESS SCRATCH))) (ZEROP (\IPNETADDRESS IPADDRESS))) then (printout FMPROMPTWINDOW "Malformed subnet mask: " SCRATCH) (FM.EDITITEM (FM.GETITEM 'SUBNET.MASK NIL WINDOW) WINDOW) (RETURN)) (replace (IPINIT SUBNETMASK) of CONFIG with (LIST (\IP.ADDRESS.TO.STRING IPADDRESS))) (* ;; "") (* ;; "Verify default gateway, may be empty if none.") (* ;; "") (SETQ SCRATCH (LISTGET STATE 'DEFAULT.GATEWAY)) (if (STRING-EQUAL SCRATCH "") then (SETQ IPADDRESS NIL) elseif (NOT (SETQ IPADDRESS (\IP.READ.STRING.ADDRESS SCRATCH))) then (printout FMPROMPTWINDOW "Malformed default gateway address: " SCRATCH) (FM.EDITITEM (FM.GETITEM 'DEFAULT.GATEWAY NIL WINDOW) WINDOW) (RETURN)) (replace (IPINIT DEFAULT.GATEWAY) of CONFIG with (AND IPADDRESS ( \IP.ADDRESS.TO.STRING IPADDRESS))) (* ;; "") (* ;; "Local domain. May be empty.") (* ;; "") (SETQ SCRATCH (LISTGET STATE 'LOCAL.DOMAIN)) (if (STRING-EQUAL SCRATCH "") then (SETQ SCRATCH NIL)) (replace (IPINIT LOCAL.DOMAIN) of CONFIG with SCRATCH) (* ;; "") (* ;; "Verify domain server address(es) are well formed.") (* ;; "") (SETQ SCRATCH (LISTGET STATE 'DOMAIN.SERVERS)) (if (STRING-EQUAL SCRATCH "") then (SETQ IPADDRESS NIL) else [SETQ IPADDRESS (bind (END _ 0) (BITTABLE _ (MAKEBITTABLE (LIST (CHARCODE SPACE)) T)) (START _ NIL) eachtime [SETQ START (STRPOSL BITTABLE SCRATCH (ADD1 (OR END 65534] (SETQ END (STRPOS " " SCRATCH START)) until (NULL START) collect (\IP.READ.STRING.ADDRESS (SUBSTRING SCRATCH (OR START 1) END] (if (FMEMB NIL IPADDRESS) then (printout FMPROMPTWINDOW "Malformed domain server addresses: " SCRATCH ) (FM.EDITITEM (FM.GETITEM 'DOMAIN.SERVERS NIL WINDOW) WINDOW) (RETURN))) [replace (IPINIT DOMAIN.SERVERS) of CONFIG with (AND IPADDRESS (for ADDR in IPADDRESS collect ( \IP.ADDRESS.TO.STRING ADDR] (* ;; "") (* ;; "Hosts.txt file (may not yet exist)") (* ;; "") (SETQ SCRATCH (LISTGET STATE 'HOSTS.FILE)) (if (if (NOT (STRING-EQUAL SCRATCH "")) elseif (NOT *IP-DEFAULT-HOSTS-FILE*) then (* ;  "If there's a site default, we can leave this empty for flexibility") (FM.CHANGESTATE (FM.GETITEM 'HOSTS.FILE NIL WINDOW) (SETQ SCRATCH "{DSK}HOSTS.TXT") WINDOW) T) then (replace (IPINIT HTE.FILE) of CONFIG with SCRATCH)) (* ;; "") (* ;; "write the information back on the IP.INIT file") (* ;; "") (printout FMPROMPTWINDOW "Writing {dsk}ip.init... ") [LET ((*UPPER-CASE-FILE-NAMES* NIL)) (CL:WITH-OPEN-FILE (STREAM '{DSK}IP.INIT :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) (PRIN2 CONFIG STREAM (FIND-READTABLE "INTERLISP"] (printout FMPROMPTWINDOW "done.") (* ;; "") (* ;; "See if they want to restart TCP with the new configuration.") (* ;; "") (COND ((AND \IPFLG (MOUSECONFIRM "Restart TCP with the new values?" NIL FMPROMPTWINDOW T)) (* ;  "tcp is running and they want it restarted.") (PRINTOUT FMPROMPTWINDOW T "Restarting...") (STOPIP) (SETQ \IP.DEFAULT.CONFIGURATION NIL) (\IPINIT) (* ;; "let the user know we are done.") (PRINTOUT FMPROMPTWINDOW "done."]) ) (PUTPROPS TCPCONFIG COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2032 18633 (TCP.CONFIGURE 2042 . 7956) (TCP.LIMITCHARS 7958 . 8375) (\TCPCONFIG.RESETFN 8377 . 8561) (\TCPCONFIG.QUITFN 8563 . 8695) (TCP.ALPHA.LIMITCHARS 8697 . 9098) (\TCPCONFIG.APPLYFN 9100 . 18631))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPDEBUG b/obsolete/tcp/TCPDEBUG new file mode 100644 index 00000000..1b0b73dd --- /dev/null +++ b/obsolete/tcp/TCPDEBUG @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "23-Aug-90 17:10:14" {DSK}TCP>TCPDEBUG.;2 27328 changes to%: (VARS TCPDEBUGCOMS) previous date%: "15-Feb-89 13:41:39" {DSK}TCP>TCPDEBUG.;1) (* ; " Copyright (c) 1985, 1986, 1987, 1989, 1990 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPDEBUGCOMS) (RPAQQ TCPDEBUGCOMS ((COMS (* ;; "standard TCP small servers") (FNS TCP.SINK.SERVER TCP.TELNET.SERVER \TCP.SINK.PROCESS TCP.ECHO.SERVER \TCP.ECHO.PROCESS)) (COMS (* ;; "TCP tracing and debugging info") (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) TCP) (CONSTANTS LIGHTGRAYSHADE)) (GLOBALVARS TCPTRACEFLG TCPTRACEFILE TCPTRACEMENU \TCP.ELAPSED.TIME \TCP.DEBUGGABLE) (INITVARS TCPTRACEFLG TCPTRACEFILE TCPTRACEMENU \TCP.ELAPSED.TIME NETTRACETITLEREG) (VARS (\TCP.DEBUGGABLE T)) (BITMAPS NETTRACEICON NETTRACEMASK) (FILES (SYSLOAD) TCP) (FNS TCP.PRINT.SEGMENT \TCP.PRINT.OPTIONS \TCP.PRINT.ELAPSED.TIME \TCP.PRINT.SEGMENT.QUEUE TCPTRACE \TCPTRACEMENU.ITEMFN \TCPTRACEMENU.DISPLAYFN TCP.DRIBBLE)) (COMS (* ;; "miscellaneous TCP debugging") (GLOBALVARS \TCP.LOSSAGE \TCP.LOOPBACK.QUEUE \TCP.LOOPBACK.EVENT \TCP.MASTER.SOCKET) (INITVARS \TCP.LOSSAGE \TCP.LOOPBACK.QUEUE \TCP.LOOPBACK.EVENT) (FNS TCP.DEBUG TCP.WATCHER DUMMY\IP\Transmit\Packet \TCP.CHECK.INPUT.QUEUE TCP.FAUCET TCP.ECHOTEST TCP.QUIET.ECHOTEST TCP.SINKTEST GENERATE.RANDOM.CHARS COPYBYTESTREAM TCP.COPYTOWINDOW TEST.CHECKSUM)))) (* ;; "standard TCP small servers") (DEFINEQ (TCP.SINK.SERVER [LAMBDA (PORT) (* ecc "14-May-84 16:32") (bind STREAM do (if (SETQ STREAM (TCP.OPEN NIL NIL (OR PORT \TCP.SINK.PORT) 'PASSIVE 'INPUT T)) then (ADD.PROCESS `(\TCP.SINK.PROCESS %, STREAM) 'NAME "TCP Sink"]) (TCP.TELNET.SERVER [LAMBDA NIL (* ejs%: "20-Jun-85 12:38") (LET ((INSTREAM (TCP.OPEN NIL NIL \TCP.TELNET.PORT 'PASSIVE 'INPUT)) OUTSTREAM) (COND (INSTREAM (SETQ OUTSTREAM (TCP.OTHER.STREAM INSTREAM)) (ADD.PROCESS (LIST '\TCP.ECHO.PROCESS (KWOTE INSTREAM) (KWOTE OUTSTREAM)) 'NAME "Telnet echo") (ADD.PROCESS '(TCP.TELNET.SERVER)) (GENERATE.RANDOM.CHARS OUTSTREAM]) (\TCP.SINK.PROCESS [LAMBDA (STREAM) (* ejs%: " 7-Jun-85 13:11") (RESETSAVE NIL (LIST (FUNCTION CLOSEF) STREAM)) (replace (STREAM ENDOFSTREAMOP) of STREAM with (FUNCTION NILL)) (until (EOFP STREAM) do (BIN STREAM]) (TCP.ECHO.SERVER [LAMBDA (PORT) (* ecc "14-May-84 16:35") (bind STREAM do (if (SETQ STREAM (TCP.OPEN NIL NIL (OR PORT \TCP.ECHO.PORT) 'PASSIVE 'INPUT T)) then (ADD.PROCESS `(\TCP.ECHO.PROCESS %, STREAM %, (TCP.OTHER.STREAM STREAM)) 'NAME "TCP Echo"]) (\TCP.ECHO.PROCESS [LAMBDA (INSTR OUTSTR) (* ejs%: "25-Mar-86 18:07") (RESETSAVE NIL (LIST (FUNCTION CLOSEF) INSTR)) (RESETSAVE NIL (LIST (FUNCTION CLOSEF) OUTSTR)) (bind C until (OR (NOT (OPENP INSTR 'INPUT)) (EOFP INSTR)) do [COND [(CAR (NLSETQ (READP INSTR))) (SETQ C (CAR (NLSETQ (BIN INSTR] (T (FORCEOUTPUT OUTSTR) (SETQ C (CAR (NLSETQ (BIN INSTR] [COND (C (NLSETQ (BOUT OUTSTR C] (if (OR (NOT (NLSETQ (READP INSTR))) (NOT (OPENP INSTR 'INPUT)) (EOFP INSTR)) then (NLSETQ (FORCEOUTPUT OUTSTR]) ) (* ;; "TCP tracing and debugging info") (DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) TCP) (DECLARE%: EVAL@COMPILE (RPAQQ LIGHTGRAYSHADE 1025) (CONSTANTS LIGHTGRAYSHADE) ) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TCPTRACEFLG TCPTRACEFILE TCPTRACEMENU \TCP.ELAPSED.TIME \TCP.DEBUGGABLE) ) (RPAQ? TCPTRACEFLG NIL) (RPAQ? TCPTRACEFILE NIL) (RPAQ? TCPTRACEMENU NIL) (RPAQ? \TCP.ELAPSED.TIME NIL) (RPAQ? NETTRACETITLEREG NIL) (RPAQQ \TCP.DEBUGGABLE T) (RPAQQ NETTRACEICON #*(72 72)AOOOOOOOOOOOOOOOL@@@COOOOOOOOOOOOOOON@@@G@@@@@@@@@@@@@@@G@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@F@@@@@@@@@@@@@@@C@@@G@@@@@@@@@@@@@@@G@@@COOOOOOOOOOOOOOON@@@AOOOOOOOOOOOOOOOL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@F@@@DIBDL@@@@@@@@@@@F@@@DIBDL@@@@@@@@@@@F@@@DIBDL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@F@@@@@@@L@@@@@L@@@@@F@@@@@@@L@@@@@N@@@@@F@@@@@@@L@@@@@K@@@@@GH@@@@@CLCOOOOIH@@@@F@@@@@@@LGOOOOHL@@@@F@@@@@@@LD@@@@@F@@@@F@@@@@@@LD@@@@@C@@@@GOOOOOOOLD@@@@@A@@@@F@@@@@@@LD@@@@@B@@@@F@@@@@@@LD@@@@@D@@@@F@@@@@@@LGOOOOHH@@@@GH@@@@@CL@@@@@I@@@@@F@@@@@@@L@@@@@J@@@@@F@@@@@@@L@@@@@L@@@@@F@@@@@@@L@@@@@H@@@@@GH@@@@@CL@@@@@@@@@@@F@@@@@@@L@@@@@@@@@@@F@@@@@@@L@@@@@@@@@@@F@@@@@@@L@@@@@@@@@@@GOOOOOOOL@@D@@@@@@@@F@@@@@@@L@@L@@@@@@@@F@@@@@@@L@AL@@@@@@@@F@@@@@@@L@BL@@@@@@@@GH@@@@@CL@DOOOOOH@@@F@@@@@@@L@HOOOOOH@@@F@@@@@@@LA@@@@@AH@@@F@@@@@@@LB@@@@@AH@@@GOOOOOOOLD@@@@@AH@@@F@@@@@@@LB@@@@@AH@@@F@@@D@@@LA@@@@@AH@@@F@@@D@@@L@HOOOOO@@@@F@@@@@@@L@DL@@@@@@@@F@@@D@@@L@BL@@@@@@@@F@@@D@@@L@AL@@@@@@@@F@@@@@@@L@@H@@@@@@@@F@@@D@@@L@@@@@@@@@@@F@@@D@@@L@@@@@@@@@@@F@@@@@@@L@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@F@@@@@@@L@@@@@@@@@@@F@@@@@@@L@@@@@@@@@@@F@@@@@@@L@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@ ) (RPAQQ NETTRACEMASK #*(72 72)AOOOOOOOOOOOOOOOL@@@COOOOOOOOOOOOOOON@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@GOOOOOOOOOOOOOOOO@@@COOOOOOOOOOOOOOON@@@AOOOOOOOOOOOOOOOL@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@L@@@@@GOOOOOOOL@@@@@N@@@@@GOOOOOOOL@@@@@O@@@@@GOOOOOOOLCOOOOOH@@@@GOOOOOOOLGOOOOOL@@@@GOOOOOOOLGOOOOON@@@@GOOOOOOOLGOOOOOO@@@@GOOOOOOOLGOOOOOO@@@@GOOOOOOOLGOOOOON@@@@GOOOOOOOLGOOOOOL@@@@GOOOOOOOLGOOOOOH@@@@GOOOOOOOL@@@@@O@@@@@GOOOOOOOL@@@@@N@@@@@GOOOOOOOL@@@@@L@@@@@GOOOOOOOL@@@@@H@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@D@@@@@@@@GOOOOOOOL@@L@@@@@@@@GOOOOOOOL@AL@@@@@@@@GOOOOOOOL@CL@@@@@@@@GOOOOOOOL@GOOOOOH@@@GOOOOOOOL@OOOOOOH@@@GOOOOOOOLAOOOOOOH@@@GOOOOOOOLCOOOOOOH@@@GOOOOOOOLGOOOOOOH@@@GOOOOOOOLCOOOOOOH@@@GOOOOOOOLAOOOOOOH@@@GOOOOOOOL@OOOOOO@@@@GOOOOOOOL@GL@@@@@@@@GOOOOOOOL@CL@@@@@@@@GOOOOOOOL@AL@@@@@@@@GOOOOOOOL@@H@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@GOOOOOOOL@@@@@@@@@@@ ) (FILESLOAD (SYSLOAD) TCP) (DEFINEQ (TCP.PRINT.SEGMENT [LAMBDA (SEGMENT FILE NOFROMTOFLG DATAFLG) (* ejs%: "20-Jun-85 16:06") (PROG ((SEPR "") (COMMA ",") (SEQ (fetch TCP.SEQ of SEGMENT)) (LEN (\TCP.DATA.LENGTH SEGMENT)) (FLAGS (fetch TCP.CTRL of SEGMENT)) TOP BASE) (if (NOT NOFROMTOFLG) then (printout FILE "from " %# (\IP.PRINT.ADDRESS (fetch TCP.SRC.ADDR of SEGMENT) FILE) ":" (fetch TCP.SRC.PORT of SEGMENT) " to " %# (\IP.PRINT.ADDRESS (fetch TCP.DST.ADDR of SEGMENT) FILE) ":" (fetch TCP.DST.PORT of SEGMENT) T)) (printout FILE SEQ) [SETQ TOP (SUB1 (IPLUS SEQ LEN (\TCP.SYN.OR.FIN FLAGS T] (if (\32BIT.LT SEQ TOP) then (printout FILE ".." TOP)) (printout FILE "/" (fetch TCP.ACK of SEGMENT) " [") (if (BITTEST FLAGS \TCP.CTRL.URG) then (printout FILE SEPR "URG") (SETQ SEPR COMMA)) (if (BITTEST FLAGS \TCP.CTRL.ACK) then (printout FILE SEPR "ACK") (SETQ SEPR COMMA)) (if (BITTEST FLAGS \TCP.CTRL.PSH) then (printout FILE SEPR "PSH") (SETQ SEPR COMMA)) (if (BITTEST FLAGS \TCP.CTRL.RST) then (printout FILE SEPR "RST") (SETQ SEPR COMMA)) (if (BITTEST FLAGS \TCP.CTRL.SYN) then (printout FILE SEPR "SYN") (SETQ SEPR COMMA)) (if (BITTEST FLAGS \TCP.CTRL.FIN) then (printout FILE SEPR "FIN") (SETQ SEPR COMMA)) (printout FILE "] window = " (fetch TCP.WINDOW of SEGMENT) " checksum = " (fetch TCP.CHECKSUM of SEGMENT) " length = " LEN T) (if (IGREATERP (fetch TCP.DATA.OFFSET of SEGMENT) \TCP.MIN.DATA.OFFSET) then (\TCP.PRINT.OPTIONS SEGMENT FILE)) (if (AND DATAFLG (NOT (ZEROP LEN))) then (printout FILE "Contents:") (SETQ BASE (fetch TCP.CONTENTS of SEGMENT)) (for (I _ 0) to (SUB1 LEN) do (PRIN1 (CHARACTER (\GETBASEBYTE BASE I)) FILE)) (TERPRI FILE]) (\TCP.PRINT.OPTIONS [LAMBDA (SEGMENT FILE) (* ejs%: "20-Jun-85 13:22") (* * Process the options in a TCP header) (printout FILE "Options: ") (bind (OPTIONBASE _ (fetch (TCPSEGMENT TCP.OPTIONS) of SEGMENT)) (OPTIONOFFSET _ 0) OPTION eachtime (SETQ OPTION (\GETBASEBYTE OPTIONBASE OPTIONOFFSET)) until (EQ OPTION \TCPOPT.END) do (SELECTC OPTION (\TCPOPT.END (printout FILE "end") (add OPTIONOFFSET 1)) (\TCPOPT.NOP (printout FILE "nop") (add OPTIONOFFSET 1)) (\TCPOPT.MAXSEG [printout FILE "maxseg: " (LOGOR (LLSH (\GETBASEBYTE OPTIONBASE (IPLUS OPTIONOFFSET 2)) BITSPERBYTE) (\GETBASEBYTE OPTIONBASE (IPLUS OPTIONOFFSET 3] (add OPTIONOFFSET (\GETBASEBYTE OPTIONBASE (ADD1 OPTIONOFFSET)))) (RETURN)) (printout FILE " "]) (\TCP.PRINT.ELAPSED.TIME [LAMBDA (FILE) (* ecc "23-Apr-84 12:32") (if (MEMB 'TIME TCPTRACEFLG) then (PROG ((NOW (SETUPTIMER 0 NIL 'MILLISECONDS)) INTERVAL) (SETQ INTERVAL (IDIFFERENCE NOW (OR \TCP.ELAPSED.TIME NOW))) (SETQ \TCP.ELAPSED.TIME NOW) (printout FILE (IQUOTIENT INTERVAL 1000) "." |.I3..T| (IMOD INTERVAL 1000) " "]) (\TCP.PRINT.SEGMENT.QUEUE [LAMBDA (CALLER QUEUE FILE) (* ecc "18-Apr-84 14:38") (PROG ((SEGMENT (fetch SYSQUEUEHEAD of QUEUE))) (printout FILE .TAB0 0 CALLER ":" T) (while SEGMENT do (TCP.PRINT.SEGMENT SEGMENT FILE T) (SETQ SEGMENT (fetch QLINK of SEGMENT]) (TCPTRACE [LAMBDA NIL (* ; "Edited 15-Apr-87 15:22 by jrb:") (PROG (MW) (if (WINDOWP TCPTRACEFILE) then (TOTOPW TCPTRACEFILE) (RETURN)) (SETQ TCPTRACEFILE (CREATEW)) [WINDOWADDPROP TCPTRACEFILE 'CLOSEFN (FUNCTION (LAMBDA (WINDOW) (if (EQ WINDOW TCPTRACEFILE) then (SETQ TCPTRACEFLG NIL) (SETQ TCPTRACEFILE T] (DSPFONT (FONTCREATE 'GACHA 8) TCPTRACEFILE) (DSPSCROLL T TCPTRACEFILE) [if (NOT (type? MENU TCPTRACEMENU)) then (SETQ TCPTRACEMENU (create MENU TITLE _ "TCP Trace Window" ITEMS _ '(("Incoming" RECV "Trace incoming segments") ("Time" TIME "Print elapsed time between events") ("Transitions" TRANSITION "Trace connection state transitions") ("Outgoing" SEND "Trace outgoing segments") ("Contents" CONTENTS "Print contents of segments when tracing" ) ("Checksums" CHECKSUM "Trace segments with bad checksums")) MENUROWS _ 2 CENTERFLG _ T WHENSELECTEDFN _ (FUNCTION \TCPTRACEMENU.ITEMFN))) else (FOR ITEM IN (FETCH (MENU ITEMS) OF TCPTRACEMENU) DO (IF (MEMB (CADR ITEM) TCPTRACEFLG) THEN (SHADEITEM ITEM TCPTRACEMENU LIGHTGRAYSHADE) ELSE (SHADEITEM ITEM TCPTRACEMENU WHITESHADE] (ATTACHMENU TCPTRACEMENU TCPTRACEFILE 'TOP) [SETQ MW (CAR (WINDOWPROP TCPTRACEFILE 'ATTACHEDWINDOWS] (WINDOWADDPROP MW 'REPAINTFN (FUNCTION \TCPTRACEMENU.DISPLAYFN)) (WINDOWADDPROP MW 'RESHAPEFN (FUNCTION \TCPTRACEMENU.DISPLAYFN]) (\TCPTRACEMENU.ITEMFN [LAMBDA (ITEM MENU MOUSEKEY) (* ecc "23-Apr-84 13:37") (PROG (FLG) (if (NULL ITEM) then (RETURN)) (SETQ FLG (CADR ITEM)) (if (MEMB FLG TCPTRACEFLG) then (SHADEITEM ITEM MENU WHITESHADE) (SETQ TCPTRACEFLG (DREMOVE FLG TCPTRACEFLG)) else (SHADEITEM ITEM MENU LIGHTGRAYSHADE) (SETQ TCPTRACEFLG (CONS FLG TCPTRACEFLG]) (\TCPTRACEMENU.DISPLAYFN [LAMBDA (WINDOW) (* ecc "23-Apr-84 13:49") (PROG [(MENU (CAR (WINDOWPROP WINDOW 'MENU] (for ITEM in (fetch ITEMS of MENU) when (MEMB (CADR ITEM) TCPTRACEFLG) do (SHADEITEM ITEM MENU LIGHTGRAYSHADE]) (TCP.DRIBBLE [LAMBDA (FORM FILE) (* ecc "18-Apr-84 14:39") (if (NULL FILE) then (SETQ FILE '{DSK}TCP.Transcript)) (RESETLST (RESETSAVE TCPTRACEFILE (OPENFILE FILE 'OUTPUT)) (RESETSAVE TCPTRACEFLG T) (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) TCPTRACEFILE)) (PRINT FORM TCPTRACEFILE) (TERPRI TCPTRACEFILE) (EVAL FORM]) ) (* ;; "miscellaneous TCP debugging") (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \TCP.LOSSAGE \TCP.LOOPBACK.QUEUE \TCP.LOOPBACK.EVENT \TCP.MASTER.SOCKET) ) (RPAQ? \TCP.LOSSAGE NIL) (RPAQ? \TCP.LOOPBACK.QUEUE NIL) (RPAQ? \TCP.LOOPBACK.EVENT NIL) (DEFINEQ (TCP.DEBUG [LAMBDA (ON?) (* edited%: "21-May-84 13:56") (if ON? then (TCP.STOP) (if (NOT (DEFINEDP 'REAL\IP\Transmit\Packet)) then (MOVD 'IP\Transmit\Packet 'REAL\IP\Transmit\Packet)) (MOVD 'DUMMY\IP\Transmit\Packet 'IP\Transmit\Packet) (if (NULL \TCP.LOOPBACK.EVENT) then (SETQ \TCP.LOOPBACK.EVENT (CREATE.EVENT))) (if (NULL \TCP.LOOPBACK.QUEUE) then (SETQ \TCP.LOOPBACK.QUEUE (create SYSQUEUE))) [if (NOT (FIND.PROCESS 'TCP.WATCHER)) then (ADD.PROCESS '(TCP.WATCHER] else (if (DEFINEDP 'REAL\IP\Transmit\Packet) then (MOVD 'REAL\IP\Transmit\Packet 'IP\Transmit\Packet)) (DEL.PROCESS 'TCP.WATCHER) (\TCP.INIT]) (TCP.WATCHER [LAMBDA NIL (* ecc " 3-May-84 11:10") (* process to handle software loopback  of segments) (RESETSAVE NIL (LIST (FUNCTION \FLUSH.PACKET.QUEUE) \TCP.LOOPBACK.QUEUE)) (bind SEGMENT do (SETQ SEGMENT (\DEQUEUE \TCP.LOOPBACK.QUEUE)) (if SEGMENT then (\TCP.PACKET.FILTER SEGMENT \TCP.PROTOCOL) else (AWAIT.EVENT \TCP.LOOPBACK.EVENT]) (DUMMY\IP\Transmit\Packet [LAMBDA (EPKT) (* ejs%: " 5-Jan-85 16:57") (* Software loopback.) (PROG ([OK (NOT (AND \TCP.LOSSAGE (EQ (RAND 1 \TCP.LOSSAGE) 1] SEGMENT) (CHECK (OR (NULL (fetch QLINK of EPKT)) (SHOULDNT "transmitting queued segment"))) (if OK then (SETQ SEGMENT (\ALLOCATE.ETHERPACKET)) (\BLT (\IPDATABASE SEGMENT) (\IPDATABASE EPKT) (FOLDHI (ADD1 (fetch (IP IPTOTALLENGTH) of EPKT)) BYTESPERWORD))) (if (EQ (fetch EPREQUEUE of EPKT) 'FREE) then (\RELEASE.ETHERPACKET EPKT) elseif (type? SYSQUEUE (fetch EPREQUEUE of EPKT)) then (\ENQUEUE (fetch EPREQUEUE of EPKT) EPKT)) (if OK then (\ENQUEUE \TCP.LOOPBACK.QUEUE SEGMENT) (NOTIFY.EVENT \TCP.LOOPBACK.EVENT]) (\TCP.CHECK.INPUT.QUEUE [LAMBDA (TCB) (* edited%: "22-May-84 15:32") (* perform consistency check on the  input queue) (PROG ((QUEUE (fetch TCB.INPUT.QUEUE of TCB)) CURSEG SEQ1 TOP1 NEXTSEG SEQ2 TOP2) (SETQ CURSEG (fetch SYSQUEUEHEAD of QUEUE)) LOOP (if (NULL CURSEG) then (RETURN T)) (SETQ SEQ1 (fetch TCP.SEQ of CURSEG)) (SETQ TOP1 (IPLUS SEQ1 (fetch TCP.DATA.LENGTH of CURSEG))) (if (AND (\32BIT.LEQ SEQ1 (fetch TCB.RCV.NXT of TCB)) (\32BIT.GT TOP1 (fetch TCB.RCV.NXT of TCB))) then (SHOULDNT "incorrect RCV.NXT") (RETURN NIL)) (SETQ NEXTSEG (fetch QLINK of CURSEG)) (if (NULL NEXTSEG) then (RETURN T)) (SETQ SEQ2 (fetch TCP.SEQ of NEXTSEG)) (SETQ TOP2 (IPLUS SEQ2 (fetch TCP.DATA.LENGTH of NEXTSEG))) (if (\32BIT.LT SEQ2 SEQ1) then (SHOULDNT "input queue out of order") (RETURN NIL)) (SETQ CURSEG NEXTSEG) (GO LOOP]) (TCP.FAUCET [LAMBDA (HOST PORT NLINES) (* ejs%: "20-Jun-85 12:20") (PROG [(STREAM (if HOST then (TCP.OPEN HOST (OR PORT \TCP.SINK.PORT) NIL 'ACTIVE 'OUTPUT) else (TCP.OPEN NIL NIL (OR PORT \TCP.SINK.PORT) 'PASSIVE 'OUTPUT] (RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF) STREAM)) (GENERATE.RANDOM.CHARS STREAM NLINES]) (TCP.ECHOTEST [LAMBDA (HOST NLINES) (* ecc "14-May-84 17:07") (PROG [(STREAM (TCP.OPEN HOST \TCP.ECHO.PORT NIL 'ACTIVE 'OUTPUT] (ADD.PROCESS (BQUOTE (TCP.COPYTOWINDOW %, (TCP.OTHER.STREAM STREAM)) 'NAME "TCP Echo Tester")) (GENERATE.RANDOM.CHARS STREAM NLINES) (TCP.CLOSE.SENDER STREAM]) (TCP.QUIET.ECHOTEST [LAMBDA (HOST NLINES) (* ecc "25-May-84 13:24") (PROG [(STREAM (TCP.OPEN HOST \TCP.ECHO.PORT NIL 'ACTIVE 'OUTPUT] (ADD.PROCESS (BQUOTE (\TCP.SINK.PROCESS %, (TCP.OTHER.STREAM STREAM)) 'NAME "TCP Echo Tester")) (GENERATE.RANDOM.CHARS STREAM NLINES) (TCP.CLOSE.SENDER STREAM]) (TCP.SINKTEST [LAMBDA (PORT VISIBLEFLG) (* ecc "14-May-84 17:28") (TCP.COPYTOWINDOW (TCP.OPEN NIL NIL (OR PORT \TCP.SINK.PORT) 'PASSIVE 'INPUT) VISIBLEFLG]) (GENERATE.RANDOM.CHARS [LAMBDA (STREAM NLINES) (* ejs%: " 7-Jun-85 12:34") (bind (N _ 0) while (NEQ N NLINES) do (add N 1) (printout STREAM "This is byte number " (GETFILEPTR STREAM) "." T) (BLOCK]) (COPYBYTESTREAM [LAMBDA (INSTR OUTSTR VISIBLEFLG) (* ejs%: " 7-Jun-85 13:44") (if VISIBLEFLG then (bind (N _ 1) (C _ NIL) while (OPENP INSTR 'INPUT) do (SETQ C (BIN INSTR)) (printout OUTSTR N ": " C) (if (AND (ILEQ C 127) (IGEQ C 32)) then (printout OUTSTR " (" %# (BOUT OUTSTR C) ")")) (TERPRI OUTSTR) (add N 1)) else (bind C while (AND (OPENP INSTR 'INPUT) (NOT (EOFP INSTR))) do (COND ((SETQ C (BIN INSTR)) (BOUT OUTSTR C]) (TCP.COPYTOWINDOW [LAMBDA (STREAM VISIBLEFLG) (* ejs%: "13-Apr-85 16:01") (RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF?) STREAM)) (PROG ((WIN (CREATEW NIL "Stream Output"))) (DSPSCROLL T WIN) (COPYBYTESTREAM STREAM WIN VISIBLEFLG) (printout WIN .TAB0 0 "[End of stream]"]) (TEST.CHECKSUM [LAMBDA (STR STR2) (* ecc "24-Apr-84 13:11") (if (NULL STR2) then (\COMPUTE.CHECKSUM (\ADDBASE (fetch (STRINGP BASE) of STR) (fetch (STRINGP OFFST) of STR)) (fetch (STRINGP LENGTH) of STR)) else (\16BIT.COMPLEMENT (\16BIT.1C.PLUS (\COMPUTE.CHECKSUM (\ADDBASE (fetch (STRINGP BASE) of STR) (fetch (STRINGP OFFST) of STR)) (fetch (STRINGP LENGTH) of STR) T) (\COMPUTE.CHECKSUM (\ADDBASE (fetch (STRINGP BASE) of STR2) (fetch (STRINGP OFFST) of STR2)) (fetch (STRINGP LENGTH) of STR2) T]) ) (PUTPROPS TCPDEBUG COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2530 5441 (TCP.SINK.SERVER 2540 . 2955) (TCP.TELNET.SERVER 2957 . 3546) ( \TCP.SINK.PROCESS 3548 . 3874) (TCP.ECHO.SERVER 3876 . 4356) (\TCP.ECHO.PROCESS 4358 . 5439)) (8951 18060 (TCP.PRINT.SEGMENT 8961 . 11702) (\TCP.PRINT.OPTIONS 11704 . 13026) (\TCP.PRINT.ELAPSED.TIME 13028 . 13561) (\TCP.PRINT.SEGMENT.QUEUE 13563 . 13945) (TCPTRACE 13947 . 16678) (\TCPTRACEMENU.ITEMFN 16680 . 17190) (\TCPTRACEMENU.DISPLAYFN 17192 . 17578) (TCP.DRIBBLE 17580 . 18058)) (18333 27228 ( TCP.DEBUG 18343 . 19261) (TCP.WATCHER 19263 . 19916) (DUMMY\IP\Transmit\Packet 19918 . 21136) ( \TCP.CHECK.INPUT.QUEUE 21138 . 22505) (TCP.FAUCET 22507 . 23175) (TCP.ECHOTEST 23177 . 23587) ( TCP.QUIET.ECHOTEST 23589 . 24006) (TCP.SINKTEST 24008 . 24288) (GENERATE.RANDOM.CHARS 24290 . 24690) ( COPYBYTESTREAM 24692 . 25563) (TCP.COPYTOWINDOW 25565 . 25990) (TEST.CHECKSUM 25992 . 27226))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPDOMAIN b/obsolete/tcp/TCPDOMAIN new file mode 100644 index 00000000..1e9b8354 --- /dev/null +++ b/obsolete/tcp/TCPDOMAIN @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "12-Jun-90 16:18:18" {DSK}local>lde>lispcore>library>TCPDOMAIN.;3 66928 changes to%: (VARS TCPDOMAINCOMS) previous date%: "28-Feb-89 18:35:51" {DSK}local>lde>lispcore>library>TCPDOMAIN.;2) (* ; " Copyright (c) 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPDOMAINCOMS) (RPAQQ TCPDOMAINCOMS ((COMS (* ;; "TCP/IP Domain resolver implementation. RFC882, RFC883, RFC973") ) (COMS (* ;; "UDP protocol functions") (DECLARE%: DONTCOPY (EXPORT (CONSTANTS (\UDPDOMAIN.WDS 6)) (RECORDS DOMAIN.HEADER))) (INITVARS (\UDPDOMAIN.IPSOCKET)) (GLOBALVARS \UDPDOMAIN.IPSOCKET) (FILES (SYSLOAD) TCPUDP) (FNS \UDPDOM.PROCESS.RESPONSE \UDPDOM.QUERY \UDPDOM.IPSOCKET)) (COMS (* ;; "Protocol independent functions") [DECLARE%: DONTCOPY (EXPORT (CONSTANTS * DOMAIN.OPCODES) (CONSTANTS * DOMAIN.RCODES) (CONSTANTS * DOMAIN.RRTYPES) (CONSTANTS * DOMAIN.CLASSTYPES) (CONSTANTS (\DOMAIN.PORT 53] (INITVARS (\DOMAIN.DEFAULT.SERVER)) (GLOBALVARS \DOMAIN.DEFAULT.SERVER) (FNS \DOMAIN.NAME \DOMAIN.PACK.NAME.LIST \DOMAIN.PARSE.NAME \DOMAIN.RCODE.ERROR \DOMAIN.PROCESS.REDIRECT \DOMAIN.PROCESS.RESPONSE \DOMAIN.PROCESS.RR \DOMAIN.READ.ADDRESS \DOMAIN.READ.NAME.FROM.STREAM \DOMAIN.READ.STRING.FROM.STREAM \DOMAIN.SEARCH.FOR.CANONICAL.NAME \DOMAIN.SKIP.NAME.IN.STREAM \DOMAIN.SKIP.QUESTION \DOMAIN.SKIP.RR)) (COMS (* ;; "Functions to maintain the domain tree structure") (RECORDS DOMAIN.TREE.NODE DOMAIN.SERVER) (INITRECORDS DOMAIN.TREE.NODE) (FNS USTRINGHASHBITS) (INITVARS (\DOMAIN.ROOT (create DOMAIN.TREE.NODE NAME _ "")) (\DOMAIN.NAMESERVERS (HASHARRAY 50 1.2 (FUNCTION USTRINGHASHBITS) (FUNCTION STRING-EQUAL))) (\DOMAIN.UNKNOWN.DOMAINS) (\DOMAIN.GC.INTERVAL 600000) (\DOMAIN.GC.TIMER (SETUPTIMER \DOMAIN.GC.INTERVAL))) (GLOBALVARS \DOMAIN.ROOT \DOMAIN.NAMESERVERS \DOMAIN.UNKNOWN.DOMAINS \DOMAIN.GC.TIMER \DOMAIN.GC.INTERVAL) (FNS \DOMAIN.ADD.NEW.DOMAIN \DOMAIN.ADD.NAMESERVER \DOMAIN.AUGMENT.TREE \DOMAIN.CHOOSE.BEST.SERVERS \DOMAIN.FIND.DOMAIN.IN.TREE \DOMAIN.INIT \DOMAIN.INSERT.IN.TREE \DOMAIN.PATH \DOMAIN.SEARCH.RESOURCE.LIST \DOMAIN.DELETE.NAMESERVER \DOMAIN.AROUND.EXIT \DOMAIN.DELETE.TREE \DOMAIN.BACKGROUND \DOMAIN.GC.NAMESERVERS \DOMAIN.SORT.BY.SVC.TIME) (ADDVARS (BACKGROUNDFNS \DOMAIN.BACKGROUND))) (COMS (* ;; "Programmer's interface") (INITVARS (DOMAIN.TRACE.FLG) (DOMAIN.TRACE.FILE) (INTERNET.LOCAL.DOMAIN)) (GLOBALVARS DOMAIN.TRACE.FLG DOMAIN.TRACE.FILE INTERNET.LOCAL.DOMAIN) (FNS DOMAIN.INIT DOMAIN.LOOKUP.ADDRESS DOMAIN.LOOKUP.NAMESERVER DOMAIN.LOOKUP.OSTYPE DOMAIN.LOOKUP DOMAIN.GRAPH DOMAIN.NAME.EQUAL DOMAIN.TRACE DOMAIN.TRACEWINDOW.BUTTONFN)) (P (DOMAIN.INIT)))) (* ;; "TCP/IP Domain resolver implementation. RFC882, RFC883, RFC973") (* ;; "UDP protocol functions") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (RPAQQ \UDPDOMAIN.WDS 6) (CONSTANTS (\UDPDOMAIN.WDS 6)) ) (DECLARE%: EVAL@COMPILE (BLOCKRECORD DOMAIN.HEADER ((ID WORD) (RESPONSEFLG FLAG) (OPCODE BITS 4) (AUTHORITYFLG FLAG) (TRUNCATEDFLG FLAG) (WANTRECURSEFLG FLAG) (CANRECURSEFLG FLAG) (NIL BITS 3) (RESPONSECODE BITS 4) (QDCOUNT WORD) (ANCOUNT WORD) (NSCOUNT WORD) (ARCOUNT WORD))) ) (* "END EXPORTED DEFINITIONS") ) (RPAQ? \UDPDOMAIN.IPSOCKET ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \UDPDOMAIN.IPSOCKET) ) (FILESLOAD (SYSLOAD) TCPUDP) (DEFINEQ (\UDPDOM.PROCESS.RESPONSE [LAMBDA (DOMAIN.PATH RESPONSE) (* ejs%: " 5-Nov-86 13:38") (* * This function parses a query reponse packet) (LET ((RESPONSEBASE (fetch (UDP UDPCONTENTS) of RESPONSE))) (COND ((NEQ 0 (fetch (DOMAIN.HEADER ANCOUNT) of RESPONSEBASE)) (* * The response packet has the information we requested) (PROG1 (\DOMAIN.PROCESS.RESPONSE (\MAKEBASEBYTESTREAM RESPONSEBASE 0 (IDIFFERENCE (fetch (UDP UDPLENGTH) of RESPONSE) \UDPOVLEN) 'INPUT)) (\RELEASE.ETHERPACKET RESPONSE))) ((OR (NEQ 0 (fetch (DOMAIN.HEADER NSCOUNT) of RESPONSEBASE)) (NEQ 0 (fetch (DOMAIN.HEADER ARCOUNT) of RESPONSEBASE))) (* * The server we asked didn't know, but did tell us the name of a server  which might know) (PROG1 (\DOMAIN.PROCESS.REDIRECT (\MAKEBASEBYTESTREAM RESPONSEBASE 0 (IDIFFERENCE (fetch (UDP UDPLENGTH) of RESPONSE) \UDPOVLEN) 'INPUT)) (\RELEASE.ETHERPACKET RESPONSE))) (T (\RELEASE.ETHERPACKET RESPONSE) 'FAILED]) (\UDPDOM.QUERY [LAMBDA (DOMAIN TYPE CLASS SERVER) (* ejs%: " 5-Nov-86 13:40") (* * Make a domain query. Argument semantics should be self-evident if you've  read RFC882 and RFC883. Returns a list of answers, or atoms to indicate  failure--USE.TCP, etc) (LET* ((QUERY (\ALLOCATE.ETHERPACKET)) (ID (RAND 1 65534)) ANSWER DOMAINBASE) (* * Do basic QUERY initialization) (UDP.SETUP QUERY (OR SERVER \DOMAIN.DEFAULT.SERVER) \DOMAIN.PORT ID (\UDPDOM.IPSOCKET)) (SETQ DOMAINBASE (fetch (UDP UDPCONTENTS) of QUERY)) (* * Format header section) (replace (DOMAIN.HEADER ID) of DOMAINBASE with ID) (replace (DOMAIN.HEADER RESPONSEFLG) of DOMAINBASE with NIL) (replace (DOMAIN.HEADER AUTHORITYFLG) of DOMAINBASE with NIL) (replace (DOMAIN.HEADER TRUNCATEDFLG) of DOMAINBASE with NIL) (replace (DOMAIN.HEADER WANTRECURSEFLG) of DOMAINBASE with NIL) (replace (DOMAIN.HEADER CANRECURSEFLG) of DOMAINBASE with NIL) (replace (DOMAIN.HEADER OPCODE) of DOMAINBASE with DOMAIN.QUERY) (replace (DOMAIN.HEADER RESPONSECODE) of DOMAINBASE with 0) (replace (DOMAIN.HEADER QDCOUNT) of DOMAINBASE with 1) (replace (DOMAIN.HEADER ANCOUNT) of DOMAINBASE with 0) (replace (DOMAIN.HEADER NSCOUNT) of DOMAINBASE with 0) (replace (DOMAIN.HEADER ARCOUNT) of DOMAINBASE with 0) (UDP.INCREMENT.LENGTH QUERY (UNFOLD \UDPDOMAIN.WDS BYTESPERWORD)) (* * Add Query) [COND ((AND (NOT (NULL DOMAIN)) (NLISTP DOMAIN)) (SETQ DOMAIN (\DOMAIN.PARSE.NAME DOMAIN] (for NAME in DOMAIN do (UDP.APPEND.BYTE QUERY (NCHARS NAME)) (UDP.APPEND.STRING QUERY (MKSTRING NAME)) finally (UDP.APPEND.BYTE QUERY 0)) (UDP.APPEND.WORD QUERY TYPE) (UDP.APPEND.WORD QUERY CLASS) (* * Do the query) (bind RESPONSE RESPONSEBASE for I from 1 to \MAXETHERTRIES do (COND [(SETQ RESPONSE (UDP.EXCHANGE (\UDPDOM.IPSOCKET) QUERY 10000)) (SETQ RESPONSEBASE (fetch (UDP UDPCONTENTS) of RESPONSE)) (COND [(AND (EQ (fetch (DOMAIN.HEADER ID) of RESPONSEBASE) ID) (fetch (DOMAIN.HEADER RESPONSEFLG) of RESPONSEBASE)) (COND ((AND (fetch (DOMAIN.HEADER TRUNCATEDFLG) of RESPONSEBASE) (EQ (fetch (DOMAIN.HEADER ANCOUNT) of RESPONSEBASE) 0) (EQ (fetch (DOMAIN.HEADER NSCOUNT) of RESPONSEBASE) 0) (EQ (fetch (DOMAIN.HEADER RESPONSECODE) of RESPONSEBASE) RCODE.OK)) (SETQ ANSWER 'USE.TCP) (\RELEASE.ETHERPACKET RESPONSE) (GO $$OUT)) ((NEQ (fetch (DOMAIN.HEADER RESPONSECODE) of RESPONSEBASE) RCODE.OK) (SETQ ANSWER (\DOMAIN.RCODE.ERROR (fetch (DOMAIN.HEADER RESPONSECODE) of RESPONSEBASE))) (COND (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE) (printout DOMAIN.TRACE.FILE "Error on query: " ANSWER))) (\RELEASE.ETHERPACKET RESPONSE) (GO $$OUT)) (T (SETQ ANSWER (\UDPDOM.PROCESS.RESPONSE DOMAIN RESPONSE)) (GO $$OUT] (T (\RELEASE.ETHERPACKET RESPONSE] (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE) (printout DOMAIN.TRACE.FILE "Query to " (\IP.ADDRESS.TO.STRING (fetch (IP IPDESTINATIONADDRESS ) of QUERY) ) " timed out."))) finally (\RELEASE.ETHERPACKET QUERY) (RETURN ANSWER]) (\UDPDOM.IPSOCKET [LAMBDA NIL (* ejs%: "12-Apr-86 20:39") [COND ((NULL \UDPDOMAIN.IPSOCKET) (SETQ \UDPDOMAIN.IPSOCKET (UDP.OPEN.SOCKET))) ((NOT (\IP.FIND.SOCKET (fetch (IPSOCKET IPSOCKET) of \UDPDOMAIN.IPSOCKET) (\IP.FIND.PROTOCOL \UDP.PROTOCOL))) (SETQ \UDPDOMAIN.IPSOCKET (UDP.OPEN.SOCKET NIL 'ACCEPT] \UDPDOMAIN.IPSOCKET]) ) (* ;; "Protocol independent functions") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (RPAQQ DOMAIN.OPCODES ((DOMAIN.QUERY 0) (DOMAIN.IQUERY 1) (DOMAIN.CQUERYM 2) (DOMAIN.CQUERYU 3))) (DECLARE%: EVAL@COMPILE (RPAQQ DOMAIN.QUERY 0) (RPAQQ DOMAIN.IQUERY 1) (RPAQQ DOMAIN.CQUERYM 2) (RPAQQ DOMAIN.CQUERYU 3) (CONSTANTS (DOMAIN.QUERY 0) (DOMAIN.IQUERY 1) (DOMAIN.CQUERYM 2) (DOMAIN.CQUERYU 3)) ) (RPAQQ DOMAIN.RCODES ((RCODE.OK 0) (RCODE.FORMATERROR 1) (RCODE.SERVERFAILED 2) (RCODE.NAMEERROR 3) (RCODE.NOTIMPLEMENTED 4) (RCODE.REFUSED 5))) (DECLARE%: EVAL@COMPILE (RPAQQ RCODE.OK 0) (RPAQQ RCODE.FORMATERROR 1) (RPAQQ RCODE.SERVERFAILED 2) (RPAQQ RCODE.NAMEERROR 3) (RPAQQ RCODE.NOTIMPLEMENTED 4) (RPAQQ RCODE.REFUSED 5) (CONSTANTS (RCODE.OK 0) (RCODE.FORMATERROR 1) (RCODE.SERVERFAILED 2) (RCODE.NAMEERROR 3) (RCODE.NOTIMPLEMENTED 4) (RCODE.REFUSED 5)) ) (RPAQQ DOMAIN.RRTYPES ((RRTYPE.A 1) (RRTYPE.NS 2) (RRTYPE.MD 3) (RRTYPE.MF 4) (RRTYPE.CNAME 5) (RRTYPE.SOA 6) (RRTYPE.MB 7) (RRTYPE.MG 8) (RRTYPE.MR 9) (RRTYPE.NULL 10) (RRTYPE.WKS 11) (RRTYPE.PTR 12) (RRTYPE.HINFO 13) (RRTYPE.MINFO 14) (RRTYPE.MX 15))) (DECLARE%: EVAL@COMPILE (RPAQQ RRTYPE.A 1) (RPAQQ RRTYPE.NS 2) (RPAQQ RRTYPE.MD 3) (RPAQQ RRTYPE.MF 4) (RPAQQ RRTYPE.CNAME 5) (RPAQQ RRTYPE.SOA 6) (RPAQQ RRTYPE.MB 7) (RPAQQ RRTYPE.MG 8) (RPAQQ RRTYPE.MR 9) (RPAQQ RRTYPE.NULL 10) (RPAQQ RRTYPE.WKS 11) (RPAQQ RRTYPE.PTR 12) (RPAQQ RRTYPE.HINFO 13) (RPAQQ RRTYPE.MINFO 14) (RPAQQ RRTYPE.MX 15) (CONSTANTS (RRTYPE.A 1) (RRTYPE.NS 2) (RRTYPE.MD 3) (RRTYPE.MF 4) (RRTYPE.CNAME 5) (RRTYPE.SOA 6) (RRTYPE.MB 7) (RRTYPE.MG 8) (RRTYPE.MR 9) (RRTYPE.NULL 10) (RRTYPE.WKS 11) (RRTYPE.PTR 12) (RRTYPE.HINFO 13) (RRTYPE.MINFO 14) (RRTYPE.MX 15)) ) (RPAQQ DOMAIN.CLASSTYPES ((CLASSTYPE.IN 1) (CLASSTYPE.CSNET 2) (CLASSTYPE.CHAOS 3))) (DECLARE%: EVAL@COMPILE (RPAQQ CLASSTYPE.IN 1) (RPAQQ CLASSTYPE.CSNET 2) (RPAQQ CLASSTYPE.CHAOS 3) (CONSTANTS (CLASSTYPE.IN 1) (CLASSTYPE.CSNET 2) (CLASSTYPE.CHAOS 3)) ) (DECLARE%: EVAL@COMPILE (RPAQQ \DOMAIN.PORT 53) (CONSTANTS (\DOMAIN.PORT 53)) ) (* "END EXPORTED DEFINITIONS") ) (RPAQ? \DOMAIN.DEFAULT.SERVER ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \DOMAIN.DEFAULT.SERVER) ) (DEFINEQ (\DOMAIN.NAME [LAMBDA (DOMAIN.TREE.NODE) (* ejs%: "13-Apr-86 15:38") (* * Generate a list of domain names along the path to the root of the domain  tree) (COND ((NULL (fetch (DOMAIN.TREE.NODE SUPERDOMAIN) of DOMAIN.TREE.NODE)) NIL) (T (LET [(SUFFIX (\DOMAIN.NAME (fetch (DOMAIN.TREE.NODE SUPERDOMAIN) of DOMAIN.TREE.NODE ] (COND (SUFFIX (CONCAT (fetch (DOMAIN.TREE.NODE NAME) of DOMAIN.TREE.NODE) "." SUFFIX)) (T (fetch (DOMAIN.TREE.NODE NAME) of DOMAIN.TREE.NODE]) (\DOMAIN.PACK.NAME.LIST [LAMBDA (LIST) (* ejs%: "12-Apr-86 20:29") (COND ((LISTP LIST) (LET [(DOMAIN.NAME (ALLOCSTRING (IPLUS (SUB1 (LENGTH LIST)) (for NAME in LIST sum (NCHARS NAME] [bind (I _ 1) for NAME in LIST do (RPLSTRING DOMAIN.NAME I NAME) (add I (NCHARS NAME)) (COND ((ILESSP I (NCHARS DOMAIN.NAME)) (RPLCHARCODE DOMAIN.NAME I (CHARCODE %.)) (add I 1] DOMAIN.NAME)) (T (ALLOCSTRING 0]) (\DOMAIN.PARSE.NAME [LAMBDA (NAME) (* ejs%: "12-Apr-86 18:11") (* * This function parses a domain name  (e.g. SUMEX.STANFORD.EDU)%, and returns a list of domain labels  (SUMEX STANFORD EDU)) (bind (SCRATCHSTRING _ (CONSTANT (ALLOCSTRING 63))) NAMELIST (LENGTH _ 0) for CHAR instring (MKSTRING NAME) do (COND [(EQ CHAR (CHARCODE %.)) (COND ((NEQ 0 LENGTH) [SETQ NAMELIST (NCONC1 NAMELIST (CONCAT (SUBSTRING SCRATCHSTRING 1 LENGTH] (SETQ LENGTH 0] ((IGREATERP LENGTH 63) (ERROR "Domain name too long" SCRATCHSTRING)) (T (RPLCHARCODE SCRATCHSTRING (add LENGTH 1) CHAR))) finally (RETURN (COND [(NEQ LENGTH 0) (NCONC1 NAMELIST (CONCAT (SUBSTRING SCRATCHSTRING 1 LENGTH] (T NAMELIST]) (\DOMAIN.RCODE.ERROR [LAMBDA (CODE) (* ejs%: "12-Apr-86 19:15") (SELECTC CODE (RCODE.OK 'OK) (RCODE.FORMATERROR 'FORMAT.ERROR) (RCODE.SERVERFAILED 'SERVER.FAILED) (RCODE.NAMEERROR 'NAME.ERROR) (RCODE.NOTIMPLEMENTED 'NOT.IMPLEMENTED) (RCODE.REFUSED 'REFUSED) NIL]) (\DOMAIN.PROCESS.REDIRECT [LAMBDA (STREAM) (* ejs%: "12-Apr-86 21:04") (* * Skip past the header and query section to get to the answer section) (* * Past ID and flags in header) (\WIN STREAM) (\WIN STREAM) (LET ((%#QUESTIONS (\WIN STREAM)) (%#ANSWERS (\WIN STREAM)) (%#NSERVERS (\WIN STREAM)) (%#ADDITIONAL (\WIN STREAM))) (* * Past questions) (for I from 1 to %#QUESTIONS do (\DOMAIN.SKIP.QUESTION STREAM)) (* * Collect answers) (for I from 1 to %#ANSWERS collect (\DOMAIN.SKIP.RR STREAM)) (* * Collect rest) (APPEND (for I from 1 to %#NSERVERS collect (\DOMAIN.PROCESS.RR STREAM)) (for I from 1 to %#ADDITIONAL collect (\DOMAIN.PROCESS.RR STREAM]) (\DOMAIN.PROCESS.RESPONSE [LAMBDA (STREAM) (* ejs%: "12-Apr-86 19:58") (* * Skip past the header and query section to get to the answer section) (* * Past ID and flags in header) (\WIN STREAM) (\WIN STREAM) (LET ((%#QUESTIONS (\WIN STREAM)) (%#ANSWERS (\WIN STREAM))) (* * Past rest of header) (\WIN STREAM) (\WIN STREAM) (* * Past questions) (for I from 1 to %#QUESTIONS do (\DOMAIN.SKIP.QUESTION STREAM)) (* * Collect answers) (for I from 1 to %#ANSWERS collect (\DOMAIN.PROCESS.RR STREAM]) (\DOMAIN.PROCESS.RR [LAMBDA (STREAM) (* ejs%: "13-Apr-86 17:09") (* * Process a resource record beginning at the current point in the stream) (LET ((NAME (\DOMAIN.READ.NAME.FROM.STREAM STREAM)) (TYPE (\WIN STREAM)) (CLASS (\WIN STREAM)) (TTL (\MAKENUMBER (\WIN STREAM) (\WIN STREAM))) (RDLEN (\WIN STREAM)) ANSWER) [SETQ ANSWER `(NAME %, NAME TYPE %, TYPE CLASS %, CLASS TTL %, TTL DATA %, (SELECTC TYPE (RRTYPE.A (\DOMAIN.READ.ADDRESS STREAM CLASS (FOLDLO RDLEN BYTESPERCELL ))) ((LIST RRTYPE.CNAME RRTYPE.NS) (\DOMAIN.READ.NAME.FROM.STREAM STREAM)) (RRTYPE.HINFO (CONS (\DOMAIN.READ.STRING.FROM.STREAM STREAM) (\DOMAIN.READ.STRING.FROM.STREAM STREAM))) (PROGN (for I from 1 to RDLEN do (BIN STREAM)) NIL] [COND (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE (printout DOMAIN.TRACE.FILE "Answer received: " ANSWER] ANSWER]) (\DOMAIN.READ.ADDRESS [LAMBDA (STREAM CLASS %#ADDRESSES) (* ejs%: "12-Apr-86 20:56") (SELECTC CLASS (CLASSTYPE.IN [COND ((EQ %#ADDRESSES 0) NIL) [(NEQ %#ADDRESSES 1) (for I from 1 to %#ADDRESSES collect (\MAKENUMBER (\WIN STREAM) (\WIN STREAM] (T (\MAKENUMBER (\WIN STREAM) (\WIN STREAM]) NIL]) (\DOMAIN.READ.NAME.FROM.STREAM [LAMBDA (STREAM) (* ejs%: "12-Apr-86 20:54") (bind NAMELEN NAMELST until (EQ 0 (SETQ NAMELEN (BIN STREAM))) do [COND [(EQ 3 (LRSH NAMELEN 6)) (* * Process a pointer redirection) (LET ((CONTINUATIONADDR (create WORD HIBYTE _ (LOGAND NAMELEN (MASK.1'S 0 6)) LOBYTE _ (BIN STREAM))) (STREAMPTR (GETFILEPTR STREAM))) (SETFILEPTR STREAM CONTINUATIONADDR) (RETURN (PROG1 (COND (NAMELST (CONCAT (\DOMAIN.PACK.NAME.LIST (DREVERSE NAMELST)) "." (\DOMAIN.READ.NAME.FROM.STREAM STREAM))) (T (\DOMAIN.READ.NAME.FROM.STREAM STREAM))) (SETFILEPTR STREAM STREAMPTR] (T (* * Normal name segment) (LET ((NAME (ALLOCSTRING NAMELEN))) (\BINS STREAM (fetch (STRINGP BASE) of NAME) (fetch (STRINGP OFFST) of NAME) NAMELEN) (push NAMELST NAME] finally (RETURN (\DOMAIN.PACK.NAME.LIST (DREVERSE NAMELST]) (\DOMAIN.READ.STRING.FROM.STREAM [LAMBDA (STREAM) (* ejs%: "13-Apr-86 02:33") (LET* ((NAMELEN (BIN STREAM)) (STRING (ALLOCSTRING NAMELEN))) (for I from 1 to NAMELEN do (RPLCHARCODE STRING I (BIN STREAM))) STRING]) (\DOMAIN.SEARCH.FOR.CANONICAL.NAME [LAMBDA (NAME RRLST) (* ejs%: "14-Nov-86 14:44") (bind FOUNDIT DATA for RR in RRLST thereis (AND (EQ RRTYPE.CNAME (LISTGET RR 'TYPE)) (DOMAIN.NAME.EQUAL (LISTGET RR 'NAME) NAME) (SETQ FOUNDIT T)) finally (RETURN (AND FOUNDIT (LISTGET RR 'DATA]) (\DOMAIN.SKIP.NAME.IN.STREAM [LAMBDA (STREAM) (* ejs%: "12-Apr-86 21:06") (bind NAMELEN NAMELST until (EQ 0 (SETQ NAMELEN (BIN STREAM))) do (COND ((EQ 3 (LRSH NAMELEN 6)) (* * Process a pointer redirection) (BIN STREAM)) (T (* * Normal name segment) (for I from 1 to NAMELEN do (BIN STREAM]) (\DOMAIN.SKIP.QUESTION [LAMBDA (STREAM) (* ejs%: "12-Apr-86 21:06") (* * Skip over a question section--composed of compressed name, QTYPE, and  QCLASS fields) (\DOMAIN.SKIP.NAME.IN.STREAM STREAM) (\WIN STREAM) (\WIN STREAM]) (\DOMAIN.SKIP.RR [LAMBDA (STREAM) (* ejs%: "12-Apr-86 21:10") (* * Skip a resource record beginning at the current point in the stream) (* * Name) (\DOMAIN.SKIP.NAME.IN.STREAM STREAM) (* * Type) (\WIN STREAM) (* * Class) (\WIN STREAM) (* * Time to Live) (\WIN STREAM) (\WIN STREAM) (* * RDATA Length) (for I from 0 to (\WIN STREAM) do (BIN STREAM]) ) (* ;; "Functions to maintain the domain tree structure") (DECLARE%: EVAL@COMPILE (DATATYPE DOMAIN.TREE.NODE ((NAME POINTER) (* The name of this domain) (SUBDOMAINS POINTER) (* List of domains inferior to this  one) (SUPERDOMAIN POINTER) (* The domain of which this domain  is a part) (NAMESERVERS POINTER) (* The list of designated name  servers for this domain) )) (RECORD DOMAIN.SERVER (NAME ADDRESSES EXPIRATION.DATE FOR.DOMAINS AVG.SVC.TIME) AVG.SVC.TIME _ 0) ) (/DECLAREDATATYPE 'DOMAIN.TREE.NODE '(POINTER POINTER POINTER POINTER) '((DOMAIN.TREE.NODE 0 POINTER) (DOMAIN.TREE.NODE 2 POINTER) (DOMAIN.TREE.NODE 4 POINTER) (DOMAIN.TREE.NODE 6 POINTER)) '8) (/DECLAREDATATYPE 'DOMAIN.TREE.NODE '(POINTER POINTER POINTER POINTER) '((DOMAIN.TREE.NODE 0 POINTER) (DOMAIN.TREE.NODE 2 POINTER) (DOMAIN.TREE.NODE 4 POINTER) (DOMAIN.TREE.NODE 6 POINTER)) '8) (DEFINEQ (USTRINGHASHBITS [LAMBDA (STRING) (* ejs%: " 5-Nov-86 13:20") (for C inthinstring (MKSTRING STRING) bind (HASHBITS _ 0) do [SETQ HASHBITS (IPLUS16 (ELT UPPERCASEARRAY C) (IPLUS16 (SETQ HASHBITS (IPLUS16 HASHBITS (LLSH (LOGAND HASHBITS 4095) 2))) (LLSH (LOGAND HASHBITS 255) 8] finally (RETURN HASHBITS]) ) (RPAQ? \DOMAIN.ROOT (create DOMAIN.TREE.NODE NAME _ "")) (RPAQ? \DOMAIN.NAMESERVERS (HASHARRAY 50 1.2 (FUNCTION USTRINGHASHBITS) (FUNCTION STRING-EQUAL))) (RPAQ? \DOMAIN.UNKNOWN.DOMAINS ) (RPAQ? \DOMAIN.GC.INTERVAL 600000) (RPAQ? \DOMAIN.GC.TIMER (SETUPTIMER \DOMAIN.GC.INTERVAL)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \DOMAIN.ROOT \DOMAIN.NAMESERVERS \DOMAIN.UNKNOWN.DOMAINS \DOMAIN.GC.TIMER \DOMAIN.GC.INTERVAL) ) (DEFINEQ (\DOMAIN.ADD.NEW.DOMAIN [LAMBDA (NODE DOMAIN NAMESERVER ADDRESSES TTL) (* ejs%: "25-Apr-86 12:25") (* * Add DOMAIN as a subdomain of NODE, with name service by NAMESERVER, at  addresses ADDRESSES, with expiration TTL seconds from now) (LET ((SUBDOMAIN (create DOMAIN.TREE.NODE SUPERDOMAIN _ NODE NAME _ DOMAIN))) (push (fetch (DOMAIN.TREE.NODE SUBDOMAINS) of NODE) SUBDOMAIN) [COND (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE) (printout DOMAIN.TRACE.FILE "Adding " DOMAIN " as subdomain of " (\DOMAIN.NAME NODE] (COND (NAMESERVER (* Add name server information to  new subdomain) (COND (DOMAIN.TRACE.FLG (printout DOMAIN.TRACE.FILE " with name server " NAMESERVER)) ) (\DOMAIN.ADD.NAMESERVER SUBDOMAIN NAMESERVER ADDRESSES TTL]) (\DOMAIN.ADD.NAMESERVER [LAMBDA (NODE NAMESERVER ADDRESSES TTL) (* ejs%: "25-Apr-86 12:34") (* * Function called to add name server information to a node in the domain  tree. If ADDRESSES is NIL, this function will query the internet to resolve  the information) (COND (NAMESERVER (LET [(DOMAIN.SERVER (OR (GETHASH NAMESERVER \DOMAIN.NAMESERVERS) (PUTHASH NAMESERVER (create DOMAIN.SERVER NAME _ NAMESERVER ADDRESSES _ ADDRESSES EXPIRATION.DATE _ (IPLUS (IDATE) (OR (NUMBERP TTL) 3600))) \DOMAIN.NAMESERVERS] [COND ([AND (NULL ADDRESSES) (NULL (SETQ ADDRESSES (fetch (DOMAIN.SERVER ADDRESSES) of DOMAIN.SERVER] (SETQ ADDRESSES (replace (DOMAIN.SERVER ADDRESSES) of DOMAIN.SERVER with (OR ADDRESSES (DOMAIN.LOOKUP.ADDRESS NAMESERVER NIL T] (COND [ADDRESSES (COND ((NOT (for SERVER in (fetch (DOMAIN.TREE.NODE NAMESERVERS) of NODE) thereis (STRING-EQUAL SERVER NAMESERVER))) [COND (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE) (printout DOMAIN.TRACE.FILE "Adding " NAMESERVER " as new name server for " (\DOMAIN.NAME NODE] (push (fetch (DOMAIN.TREE.NODE NAMESERVERS) of NODE) NAMESERVER) (push (fetch (DOMAIN.SERVER FOR.DOMAINS) of DOMAIN.SERVER) NODE] (T (PUTHASH NAMESERVER NIL \DOMAIN.NAMESERVERS]) (\DOMAIN.AUGMENT.TREE [LAMBDA (RRLST) (* ejs%: "14-Nov-86 14:30") (* * RRLST is a list of RRTYPE.NS and/or RRTYPE.A records.  Build up our model of the internet domain tree by processing the information  in RRLST) (bind NAMESERVER for RR in RRLST do (COND ((EQ (LISTGET RR 'TYPE) RRTYPE.NS) (SETQ NAMESERVER (LISTGET RR 'DATA)) (\DOMAIN.INSERT.IN.TREE (LISTGET RR 'NAME) NAMESERVER (\DOMAIN.SEARCH.RESOURCE.LIST RRLST NAMESERVER RRTYPE.A NIL) (LISTGET RR 'TTL]) (\DOMAIN.CHOOSE.BEST.SERVERS [LAMBDA (DOMAIN) (* ejs%: " 1-May-86 17:15") (* * This function chooses the best servers for a query to resolve DOMAIN) (LET* [(PATH (COND ((AND (NLISTP DOMAIN) DOMAIN) (DREVERSE (\DOMAIN.PARSE.NAME DOMAIN))) (T DOMAIN))) (BEST.CHOICE (bind NEXT (CURRENT _ \DOMAIN.ROOT) for NAME in PATH while [SETQ NEXT (for SUBDOMAIN in (fetch ( DOMAIN.TREE.NODE SUBDOMAINS) of CURRENT) thereis (STRING-EQUAL NAME (fetch (DOMAIN.TREE.NODE NAME) of SUBDOMAIN ] do (SETQ CURRENT NEXT) finally (RETURN CURRENT] [while BEST.CHOICE do (COND ((fetch (DOMAIN.TREE.NODE NAMESERVERS) of BEST.CHOICE ) (RETURN)) (T (SETQ BEST.CHOICE (fetch (DOMAIN.TREE.NODE SUPERDOMAIN) of BEST.CHOICE] [COND ((EQ BEST.CHOICE \DOMAIN.ROOT) (* Here we have a problem. Is the request for a subdomain of ROOT  (e.g. COM, GOV, EDU, etc)%, or for a local name in our own domain?) (COND [(AND (EQLENGTH PATH 1) (for SUBDOMAIN in (fetch (DOMAIN.TREE.NODE SUBDOMAINS) of \DOMAIN.ROOT) thereis (STRING-EQUAL (CAR PATH) (fetch (DOMAIN.TREE.NODE NAME) of SUBDOMAIN] (T (* Heuristic%: If the domain doesn't appear to be a subdomain of the root,  assume that the local domain server will know it.  If we're wrong, the local name server will tell us) (SETQ BEST.CHOICE NIL] (COND [(NULL BEST.CHOICE) (COND ((OR (EQLENGTH PATH 1) (NULL (fetch (DOMAIN.TREE.NODE NAMESERVERS) of \DOMAIN.ROOT))) (COND (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE) (printout DOMAIN.TRACE.FILE "Best choice for " DOMAIN " is our local server: " \DOMAIN.DEFAULT.SERVER))) (SORT (MKLIST \DOMAIN.DEFAULT.SERVER) (FUNCTION \DOMAIN.SORT.BY.SVC.TIME))) (T (COND (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE) (printout DOMAIN.TRACE.FILE "Best choice for " DOMAIN " is the root server"))) (SORT (fetch (DOMAIN.TREE.NODE NAMESERVERS) of \DOMAIN.ROOT) (FUNCTION \DOMAIN.SORT.BY.SVC.TIME] (T [COND (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE) (printout DOMAIN.TRACE.FILE "Best choice(s) for " DOMAIN ": " (fetch (DOMAIN.TREE.NODE NAMESERVERS) of BEST.CHOICE] (SORT (fetch (DOMAIN.TREE.NODE NAMESERVERS) of BEST.CHOICE) (FUNCTION \DOMAIN.SORT.BY.SVC.TIME]) (\DOMAIN.FIND.DOMAIN.IN.TREE [LAMBDA (NAME) (* ejs%: "13-Apr-86 01:25") (COND ((STREQUAL NAME "") \DOMAIN.ROOT) (T (LET ([PATH (COND ((LISTP NAME) (REVERSE NAME)) (T (DREVERSE (\DOMAIN.PARSE.NAME NAME] (CURRENT \DOMAIN.ROOT)) (bind NEXT for NODE on PATH do (COND ([NOT (SETQ NEXT (for SUBDOMAIN in (fetch (DOMAIN.TREE.NODE SUBDOMAINS) of CURRENT) thereis (STRING-EQUAL (CAR NODE) (fetch (DOMAIN.TREE.NODE NAME) of SUBDOMAIN ] (RETURN (CONS CURRENT NODE))) (T (SETQ CURRENT NEXT))) finally (RETURN CURRENT]) (\DOMAIN.INIT [LAMBDA (EVENT) (* ejs%: " 1-May-86 15:46") (SETQ \DOMAIN.DEFAULT.SERVER (bind NAME for SERVER in (fetch (IPINIT DOMAIN.SERVERS) of \IP.DEFAULT.CONFIGURATION ) as SERVER# from 1 collect (SETQ NAME (CONCAT "Local-Domain-Server-" SERVER#)) (PUTHASH NAME (create DOMAIN.SERVER NAME _ NAME EXPIRATION.DATE _ MAX.FIXP ADDRESSES _ (LIST (\IP.READ.STRING.ADDRESS SERVER))) \DOMAIN.NAMESERVERS) NAME]) (\DOMAIN.INSERT.IN.TREE [LAMBDA (DOMAIN NAMESERVER ADDRESSES TTL) (* ejs%: "25-Apr-86 12:21") (* * Given information from an RRTYPE.NS record, add an entry to the domain  tree) (LET ((PARTIAL.PATH (\DOMAIN.FIND.DOMAIN.IN.TREE DOMAIN))) (COND ((type? DOMAIN.TREE.NODE PARTIAL.PATH) (* Found it) (\DOMAIN.ADD.NAMESERVER PARTIAL.PATH NAMESERVER ADDRESSES TTL)) ((EQLENGTH PARTIAL.PATH 2) (* Only one away from previous  knowledge?) (\DOMAIN.ADD.NEW.DOMAIN (CAR PARTIAL.PATH) (CADR PARTIAL.PATH) NAMESERVER ADDRESSES TTL)) (T (* Some number of domains between our deepest knowledge and the desired  domain) (\DOMAIN.ADD.NEW.DOMAIN (CAR PARTIAL.PATH) (CADR PARTIAL.PATH)) (\DOMAIN.INSERT.IN.TREE DOMAIN NAMESERVER ADDRESSES TTL]) (\DOMAIN.PATH [LAMBDA (DOMAIN.TREE.NODE) (* ejs%: "13-Apr-86 14:44") (* * Generate a list of domain names along the path to the root of the domain  tree) (COND ((NULL (fetch (DOMAIN.TREE.NODE SUPERDOMAIN) of DOMAIN.TREE.NODE)) NIL) (T (CONS (fetch (DOMAIN.TREE.NODE NAME) of DOMAIN.TREE.NODE) (\DOMAIN.PATH (fetch (DOMAIN.TREE.NODE SUPERDOMAIN) of DOMAIN.TREE.NODE]) (\DOMAIN.SEARCH.RESOURCE.LIST [LAMBDA (RRLST NAME TYPE OK.TO.RETURN.NAME) (* ejs%: "14-Nov-86 14:40") (LET [(ANSWER (bind DATA for RR in RRLST collect (SETQ DATA (LISTGET RR 'DATA)) (COND ((AND DATA (EQ TYPE RRTYPE.A) OK.TO.RETURN.NAME) (LISTGET RR 'NAME)) (T DATA)) when (AND (EQ TYPE (LISTGET RR 'TYPE)) (DOMAIN.NAME.EQUAL (LISTGET RR 'NAME) NAME] (COND (ANSWER) (T (LET [(CANONICAL.NAME (bind FOUNDIT DATA for RR in RRLST thereis (AND (EQ RRTYPE.CNAME (LISTGET RR 'TYPE)) (DOMAIN.NAME.EQUAL (LISTGET RR 'NAME) NAME) (SETQ FOUNDIT T)) finally (RETURN (AND FOUNDIT (LISTGET RR 'DATA] (COND (CANONICAL.NAME (\DOMAIN.SEARCH.RESOURCE.LIST RRLST CANONICAL.NAME TYPE OK.TO.RETURN.NAME]) (\DOMAIN.DELETE.NAMESERVER [LAMBDA (NAMESERVER) (* ejs%: "13-Apr-86 18:35") (LET ((DOMAIN.SERVER (GETHASH NAMESERVER \DOMAIN.NAMESERVERS))) (COND (DOMAIN.SERVER [bind NAMESERVERS for DOMAIN in (fetch (DOMAIN.SERVER FOR.DOMAINS) of DOMAIN.SERVER) do (SETQ NAMESERVERS (fetch (DOMAIN.TREE.NODE NAMESERVERS) of DOMAIN)) (bind for NAME in NAMESERVERS when (STRING-EQUAL NAME NAMESERVER) do (replace (DOMAIN.TREE.NODE NAMESERVERS) of DOMAIN with (DREMOVE NAME NAMESERVERS] (PUTHASH NAMESERVER NIL \DOMAIN.NAMESERVERS]) (\DOMAIN.AROUND.EXIT [LAMBDA (EVENT) (* ejs%: "13-Apr-86 18:30") (SELECTQ EVENT ((NIL AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM) (\DOMAIN.DELETE.TREE)) NIL]) (\DOMAIN.DELETE.TREE [LAMBDA NIL (* ejs%: "13-Apr-86 17:39") (* * Undoes circularity in pointers between levels of the tree) (bind (OPEN _ (LIST \DOMAIN.ROOT)) CLOSED CURRENT while OPEN do (SETQ CURRENT (pop OPEN)) (SETQ OPEN (APPEND (fetch (DOMAIN.TREE.NODE SUBDOMAINS) of CURRENT) OPEN)) (replace (DOMAIN.TREE.NODE SUBDOMAINS) of CURRENT with NIL) (replace (DOMAIN.TREE.NODE NAME) of CURRENT with NIL) (replace (DOMAIN.TREE.NODE NAMESERVERS) of CURRENT with NIL) (replace (DOMAIN.TREE.NODE SUPERDOMAIN) of CURRENT with NIL)) [MAPHASH \DOMAIN.NAMESERVERS (FUNCTION (LAMBDA (DOMAIN.SERVER NAME) (replace (DOMAIN.SERVER FOR.DOMAINS) of DOMAIN.SERVER with NIL] (CLRHASH \DOMAIN.NAMESERVERS) NIL]) (\DOMAIN.BACKGROUND [LAMBDA NIL (* ejs%: "13-Apr-86 18:24") (COND ((TIMEREXPIRED? \DOMAIN.GC.TIMER) (\DOMAIN.GC.NAMESERVERS) (SETQ \DOMAIN.GC.TIMER (SETUPTIMER \DOMAIN.GC.INTERVAL \DOMAIN.GC.TIMER]) (\DOMAIN.GC.NAMESERVERS [LAMBDA NIL (* ; "Edited 11-Feb-89 12:36 by akw:") (* * This function maps over the name server hash array, and removes old  servers which have timed out) (LET ((TIME (IDATE))) (DECLARE (SPECVARS TIME)) [MAPHASH \DOMAIN.NAMESERVERS (FUNCTION (LAMBDA (DOMAIN.SERVER NAME) (DECLARE (USEDFREE TIME)) (COND ((MEMBER NAME (fetch (IPINIT DOMAIN.SERVERS) of \IP.DEFAULT.CONFIGURATION )) T) ((ILESSP (fetch (DOMAIN.SERVER EXPIRATION.DATE) of DOMAIN.SERVER) TIME) (COND (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE) (printout DOMAIN.TRACE.FILE "Name server " NAME " has expired; deleting..."))) (\DOMAIN.DELETE.NAMESERVER NAME] NIL]) (\DOMAIN.SORT.BY.SVC.TIME [LAMBDA (NAME1 NAME2) (* ejs%: "13-Apr-86 18:14") (LET ((R1 (GETHASH NAME1 \DOMAIN.NAMESERVERS)) (R2 (GETHASH NAME2 \DOMAIN.NAMESERVERS))) (ILESSP (OR (fetch (DOMAIN.SERVER AVG.SVC.TIME) of R1) 0) (OR (fetch (DOMAIN.SERVER AVG.SVC.TIME) of R2) 0]) ) (ADDTOVAR BACKGROUNDFNS \DOMAIN.BACKGROUND) (* ;; "Programmer's interface") (RPAQ? DOMAIN.TRACE.FLG ) (RPAQ? DOMAIN.TRACE.FILE ) (RPAQ? INTERNET.LOCAL.DOMAIN ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DOMAIN.TRACE.FLG DOMAIN.TRACE.FILE INTERNET.LOCAL.DOMAIN) ) (DEFINEQ (DOMAIN.INIT [LAMBDA NIL (* ; "Edited 15-Feb-88 17:26 by Snow") (* ;; "Called to initialize the domain service for this host") (DECLARE (GLOBALVARS \DOMAIN.DEFAULT.SERVER INTERNET.LOCAL.DOMAIN)) (if (NOT \IP.DEFAULT.CONFIGURATION) then (PROMPTPRINT "Internet domain code is loaded, but disabled.") else (LET [(LOCAL.DOMAIN.SERVERS (fetch (IPINIT DOMAIN.SERVERS) of \IP.DEFAULT.CONFIGURATION )) (LOCAL.DOMAIN (MKSTRING (fetch (IPINIT LOCAL.DOMAIN) of \IP.DEFAULT.CONFIGURATION ] (COND ((AND LOCAL.DOMAIN.SERVERS LOCAL.DOMAIN) (SETQ \DOMAIN.DEFAULT.SERVER (for ADDR inside LOCAL.DOMAIN.SERVERS collect (MKSTRING ADDR))) (SETQ INTERNET.LOCAL.DOMAIN LOCAL.DOMAIN) (for NAMESERVER in LOCAL.DOMAIN.SERVERS do (\DOMAIN.INSERT.IN.TREE LOCAL.DOMAIN (MKSTRING NAMESERVER) (LIST (DODIP.HOSTP NAMESERVER)) MAX.FIXP))) (T (PROMPTPRINT "Internet domain code is loaded, but disabled."]) (DOMAIN.LOOKUP.ADDRESS [LAMBDA (NAME SERVER DONT.GET.OSTYPE) (* ; "Edited 15-Feb-89 15:14 by welch") (* * Programmer's interface to lookup IP Internet host name using the domain  system) (bind (OPEN _ (OR (MKLIST SERVER) (\DOMAIN.CHOOSE.BEST.SERVERS NAME))) CANONICAL.NAME CLOSED ADDRESSES THIS.SERVER ANSWER OSTYPE (ATOMIC-NAME _ (MKATOM (U-CASE NAME))) while OPEN do (SETQ THIS.SERVER (pop OPEN)) (push CLOSED THIS.SERVER) (SETQ ANSWER (DOMAIN.LOOKUP NAME RRTYPE.A THIS.SERVER)) (COND ((SETQ ADDRESSES (\DOMAIN.SEARCH.RESOURCE.LIST ANSWER NAME RRTYPE.A)) (\DOMAIN.AUGMENT.TREE ANSWER) [SETQ OSTYPE (COND (DONT.GET.OSTYPE NIL) (T (DOMAIN.LOOKUP.OSTYPE NAME] (PUTHASH ATOMIC-NAME (create HOSTS.TXT.ENTRY HTE.TYPE _ 'HOST HTE.ADDRESSES _ ADDRESSES HTE.NAMES _ (LIST ATOMIC-NAME) HTE.OS.TYPE _ OSTYPE) \IP.HOSTNAMES) (RETURN ADDRESSES)) (ANSWER (COND ([SETQ CANONICAL.NAME (MKATOM (U-CASE (  \DOMAIN.SEARCH.FOR.CANONICAL.NAME NAME ANSWER] (SETQ ADDRESSES (DOMAIN.LOOKUP.ADDRESS CANONICAL.NAME SERVER)) (PUTHASH ATOMIC-NAME (GETHASH CANONICAL.NAME \IP.HOSTNAMES ) \IP.HOSTNAMES) (RETURN ADDRESSES)) (T (\DOMAIN.AUGMENT.TREE ANSWER) (SETQ OPEN (APPEND (for NEXT.SERVER in (  \DOMAIN.SEARCH.RESOURCE.LIST ANSWER '* RRTYPE.A T) when (NOT (MEMBER NEXT.SERVER CLOSED)) collect NEXT.SERVER) OPEN]) (DOMAIN.LOOKUP.NAMESERVER [LAMBDA (NAME SERVER) (* ejs%: "25-Apr-86 12:55") (* * Programmer's interface to lookup IP Internet host name using the domain  system) (bind (OPEN _ (OR (MKLIST SERVER) (\DOMAIN.CHOOSE.BEST.SERVERS NAME))) CLOSED NAMESERVERS THIS.SERVER ANSWER while OPEN do (SETQ THIS.SERVER (pop OPEN)) (push CLOSED THIS.SERVER) (SETQ ANSWER (DOMAIN.LOOKUP NAME RRTYPE.NS THIS.SERVER)) (COND ((SETQ NAMESERVERS (\DOMAIN.SEARCH.RESOURCE.LIST ANSWER NAME RRTYPE.NS)) (\DOMAIN.AUGMENT.TREE ANSWER) (RETURN NAMESERVERS)) (ANSWER (\DOMAIN.AUGMENT.TREE ANSWER) (SETQ OPEN (APPEND (for NEXT.SERVER in (\DOMAIN.SEARCH.RESOURCE.LIST ANSWER '* RRTYPE.A T) when (NOT (MEMBER NEXT.SERVER CLOSED)) collect NEXT.SERVER) OPEN]) (DOMAIN.LOOKUP.OSTYPE [LAMBDA (NAME SERVER) (* ejs%: "14-Nov-86 14:46") (* * Programmer's interface to lookup IP Internet host name using the domain  system) (bind (OPEN _ (OR (MKLIST SERVER) (\DOMAIN.CHOOSE.BEST.SERVERS NAME))) CANONICAL.NAME CLOSED CPU.OSTYPES THIS.SERVER ANSWER while OPEN do (SETQ THIS.SERVER (pop OPEN)) (push CLOSED THIS.SERVER) (SETQ ANSWER (DOMAIN.LOOKUP NAME RRTYPE.HINFO THIS.SERVER)) (COND [(SETQ CPU.OSTYPES (\DOMAIN.SEARCH.RESOURCE.LIST ANSWER NAME RRTYPE.HINFO)) (\DOMAIN.AUGMENT.TREE ANSWER) (RETURN (MKATOM (U-CASE (CDAR CPU.OSTYPES] (ANSWER (COND ((SETQ CANONICAL.NAME (\DOMAIN.SEARCH.FOR.CANONICAL.NAME NAME ANSWER)) (RETURN (DOMAIN.LOOKUP.OSTYPE CANONICAL.NAME SERVER))) (T (\DOMAIN.AUGMENT.TREE ANSWER) (SETQ OPEN (APPEND (for NEXT.SERVER in (\DOMAIN.SEARCH.RESOURCE.LIST ANSWER '* RRTYPE.A T) when (NOT (MEMBER NEXT.SERVER CLOSED)) collect NEXT.SERVER) OPEN]) (DOMAIN.LOOKUP [LAMBDA (NAME TYPE SERVER) (* ; "Edited 15-Feb-88 17:24 by Snow") (* ;;; "Programmer's interface to lookup IP Internet host name using the domain system") (PROG ((DOMAIN.PATH (\DOMAIN.PARSE.NAME NAME)) (RETRYCOUNT 0) ANSWER ADDRESS TIMINGFLG START.TIME) (OR TYPE (SETQ TYPE RRTYPE.A)) [COND [(LISTP SERVER) (SETQ ADDRESS (COND [(LISTP (CAR SERVER)) (* ;  "Handles a list of DOMAIN.SERVER records") (CAR (fetch (DOMAIN.SERVER ADDRESSES) of (CAR SERVER] (T (* ; "Handles a list of addresses") (CAR SERVER] (SERVER (* ; "Handles a single address") (SETQ ADDRESS SERVER)) (T (SETQ SERVER \DOMAIN.DEFAULT.SERVER) (SETQ ADDRESS (CAR SERVER] [COND ((STRINGP ADDRESS) (SETQ ADDRESS (CAR (fetch (DOMAIN.SERVER ADDRESSES) of (SETQ TIMINGFLG (GETHASH ADDRESS \DOMAIN.NAMESERVERS ] (COND (DOMAIN.TRACE.FLG (FRESHLINE DOMAIN.TRACE.FILE) (PRIN1 "Type " DOMAIN.TRACE.FILE) (PRINTCONSTANT TYPE DOMAIN.RRTYPES DOMAIN.TRACE.FILE) (printout DOMAIN.TRACE.FILE " query to " (COND ((NUMBERP SERVER) (\IP.ADDRESS.TO.STRING SERVER)) (T SERVER)) " for " NAME T))) LOOP (add RETRYCOUNT 1) [COND (TIMINGFLG (SETQ START.TIME (IDATE] [SETQ ANSWER (COND ((NULL ANSWER) (\UDPDOM.QUERY DOMAIN.PATH TYPE CLASSTYPE.IN ADDRESS)) ((EQ ANSWER 'USE.TCP) (\TCPDOM.QUERY DOMAIN.PATH TYPE CLASSTYPE.IN ADDRESS] [COND (TIMINGFLG (replace (DOMAIN.SERVER AVG.SVC.TIME) of TIMINGFLG with (IDIFFERENCE (IDATE) START.TIME] (COND ((LITATOM ANSWER) (SELECTQ ANSWER (NIL (COND ((LISTP SERVER) (SETQ SERVER (CDR SERVER)) [SETQ ADDRESS (CAR (fetch (DOMAIN.SERVER ADDRESSES) of (CAR SERVER] (SETQ RETRYCOUNT 0) (GO LOOP)) (T (RETURN ANSWER)))) (NAME.ERROR (RETURN NIL)) (USE.TCP (COND ((EQ RETRYCOUNT 1) (GO LOOP)) (T (RETURN NIL)))) (RETURN ANSWER))) (T (RETURN ANSWER]) (DOMAIN.GRAPH [LAMBDA (WINDOW) (* ; "Edited 19-Mar-87 16:58 by FS") (LET ((OPENLIST (LIST \DOMAIN.ROOT)) NODELST) (bind NODE while OPENLIST do (SETQ NODE (pop OPENLIST)) (push NODELST (create GRAPHNODE NODELABEL _ (COND ((NULL (fetch (DOMAIN.TREE.NODE SUPERDOMAIN) of NODE)) "*ROOT*") (T (fetch (DOMAIN.TREE.NODE NAME) of NODE))) NODEID _ NODE TONODES _ (fetch (DOMAIN.TREE.NODE SUBDOMAINS) of NODE))) (SETQ OPENLIST (APPEND (fetch (DOMAIN.TREE.NODE SUBDOMAINS) of NODE) OPENLIST))) (SHOWGRAPH (LAYOUTGRAPH NODELST (LIST \DOMAIN.ROOT) 'HORIZONTAL) WINDOW (FUNCTION (LAMBDA (NODE W) (COND (NODE (INSPECT (fetch (GRAPHNODE NODEID) of NODE))) (T (DOMAIN.GRAPH W]) (DOMAIN.NAME.EQUAL [LAMBDA (NAME1 NAME2) (* ejs%: "13-Apr-86 17:23") (COND ((OR (EQ NAME1 '*) (EQ NAME2 '*)) T) (T (OR (LISTP NAME1) (SETQ NAME1 (\DOMAIN.PARSE.NAME NAME1))) (OR (LISTP NAME2) (SETQ NAME2 (\DOMAIN.PARSE.NAME NAME2))) (COND ((OR (AND (NULL NAME1) NAME2) (AND (NULL NAME2) NAME1)) NIL) (T (for X in NAME1 as Y in NAME2 always (STRING-EQUAL X Y]) (DOMAIN.TRACE [LAMBDA (MODE) (* ejs%: "13-Apr-86 16:12") [COND ((WINDOWP DOMAIN.TRACE.FILE) (OPENW DOMAIN.TRACE.FILE)) (T (SETQ DOMAIN.TRACE.FILE (CREATEW NIL "Domain Trace File")) (DSPSCROLL 'ON DOMAIN.TRACE.FILE) (DSPFONT '(GACHA 8) DOMAIN.TRACE.FILE) (WINDOWPROP DOMAIN.TRACE.FILE 'BUTTONEVENTFN (FUNCTION DOMAIN.TRACEWINDOW.BUTTONFN)) (WINDOWPROP DOMAIN.TRACE.FILE 'CLOSEFN (FUNCTION (LAMBDA NIL (SETQ DOMAIN.TRACE.FLG NIL) (SETQ DOMAIN.TRACE.FILE] (SETQ DOMAIN.TRACE.FLG MODE]) (DOMAIN.TRACEWINDOW.BUTTONFN [LAMBDA (WINDOW) (* ejs%: "13-Apr-86 15:49") (COND ((MOUSESTATE (NOT UP)) (SETQ DOMAIN.TRACE.FLG (SELECTQ DOMAIN.TRACE.FLG (NIL T) (T NIL) NIL)) (printout WINDOW T "[Tracing " (SELECTQ DOMAIN.TRACE.FLG (T "on") "off") "]" T]) ) (DOMAIN.INIT) (PUTPROPS TCPDOMAIN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (4891 12420 (\UDPDOM.PROCESS.RESPONSE 4901 . 6651) (\UDPDOM.QUERY 6653 . 11968) ( \UDPDOM.IPSOCKET 11970 . 12418)) (15354 27202 (\DOMAIN.NAME 15364 . 16190) (\DOMAIN.PACK.NAME.LIST 16192 . 17169) (\DOMAIN.PARSE.NAME 17171 . 18511) (\DOMAIN.RCODE.ERROR 18513 . 18946) ( \DOMAIN.PROCESS.REDIRECT 18948 . 19944) (\DOMAIN.PROCESS.RESPONSE 19946 . 20717) (\DOMAIN.PROCESS.RR 20719 . 22311) (\DOMAIN.READ.ADDRESS 22313 . 22999) (\DOMAIN.READ.NAME.FROM.STREAM 23001 . 24730) ( \DOMAIN.READ.STRING.FROM.STREAM 24732 . 25048) (\DOMAIN.SEARCH.FOR.CANONICAL.NAME 25050 . 25758) ( \DOMAIN.SKIP.NAME.IN.STREAM 25760 . 26267) (\DOMAIN.SKIP.QUESTION 26269 . 26599) (\DOMAIN.SKIP.RR 26601 . 27200)) (28554 29256 (USTRINGHASHBITS 28564 . 29254)) (29754 50847 (\DOMAIN.ADD.NEW.DOMAIN 29764 . 30996) (\DOMAIN.ADD.NAMESERVER 30998 . 34156) (\DOMAIN.AUGMENT.TREE 34158 . 35305) ( \DOMAIN.CHOOSE.BEST.SERVERS 35307 . 39679) (\DOMAIN.FIND.DOMAIN.IN.TREE 39681 . 40954) (\DOMAIN.INIT 40956 . 41749) (\DOMAIN.INSERT.IN.TREE 41751 . 42869) (\DOMAIN.PATH 42871 . 43387) ( \DOMAIN.SEARCH.RESOURCE.LIST 43389 . 45139) (\DOMAIN.DELETE.NAMESERVER 45141 . 46218) ( \DOMAIN.AROUND.EXIT 46220 . 46475) (\DOMAIN.DELETE.TREE 46477 . 48201) (\DOMAIN.BACKGROUND 48203 . 48489) (\DOMAIN.GC.NAMESERVERS 48491 . 50427) (\DOMAIN.SORT.BY.SVC.TIME 50429 . 50845)) (51144 66800 ( DOMAIN.INIT 51154 . 52770) (DOMAIN.LOOKUP.ADDRESS 52772 . 56193) (DOMAIN.LOOKUP.NAMESERVER 56195 . 57556) (DOMAIN.LOOKUP.OSTYPE 57558 . 59197) (DOMAIN.LOOKUP 59199 . 62699) (DOMAIN.GRAPH 62701 . 64901) (DOMAIN.NAME.EQUAL 64903 . 65527) (DOMAIN.TRACE 65529 . 66257) (DOMAIN.TRACEWINDOW.BUTTONFN 66259 . 66798))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPEXPORTS b/obsolete/tcp/TCPEXPORTS new file mode 100644 index 00000000..f700b47b --- /dev/null +++ b/obsolete/tcp/TCPEXPORTS @@ -0,0 +1 @@ +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (LISPXPRIN1 "EXPORTS GATHERED FROM {ERIS}Library>TCP*.; ON 11-Sep-89 16:08:46" T) (LISPXTERPRI T) (RPAQQ \TCP.CTRL.ACK 16) (RPAQQ \TCP.CTRL.FIN 1) (RPAQQ \TCP.CTRL.PSH 8) (RPAQQ \TCP.CTRL.RST 4) (RPAQQ \TCP.CTRL.SYN 2) (RPAQQ \TCP.CTRL.URG 32) (CONSTANTS \TCP.CTRL.ACK \TCP.CTRL.FIN \TCP.CTRL.PSH \TCP.CTRL.RST \TCP.CTRL.SYN \TCP.CTRL.URG) (RPAQQ \TCPOPT.END 0) (RPAQQ \TCPOPT.NOP 1) (RPAQQ \TCPOPT.MAXSEG 2) (CONSTANTS \TCPOPT.END \TCPOPT.NOP \TCPOPT.MAXSEG) (RPAQQ \TCP.PROTOCOL 6) (CONSTANTS \TCP.PROTOCOL) (RPAQQ \TCP.HEADER.LENGTH 20) (CONSTANTS \TCP.HEADER.LENGTH) (RPAQQ \TCP.MIN.DATA.OFFSET 5) (CONSTANTS \TCP.MIN.DATA.OFFSET) (RPAQQ \TCP.DEFAULT.MAXSEG 536) (CONSTANTS \TCP.DEFAULT.MAXSEG) (ACCESSFNS TCPSEGMENT ((TCPHEADER (\IPDATABASE DATUM))) (BLOCKRECORD TCPHEADER ((TCP.SRC.PORT WORD) ( TCP.DST.PORT WORD) (TCP.SEQ FIXP) (TCP.ACK FIXP) (TCP.DATA.OFFSET BITS 4) (TCP.MBZ BITS 6) (TCP.CTRL BITS 6) (TCP.WINDOW WORD) (TCP.CHECKSUM WORD) (TCP.URG.PTR WORD))) (ACCESSFNS TCPSEGMENT (( TCP.DATA.LENGTH (fetch (IP IPHEADERCHECKSUM) of DATUM) (replace (IP IPHEADERCHECKSUM) of DATUM with NEWVALUE)) (TCP.SRC.ADDR (fetch (IP IPSOURCEADDRESS) of DATUM) (replace (IP IPSOURCEADDRESS) of DATUM with NEWVALUE)) (TCP.DST.ADDR (fetch (IP IPDESTINATIONADDRESS) of DATUM) (replace (IP IPDESTINATIONADDRESS) of DATUM with NEWVALUE)) (TCP.HEADER.LENGTH (LLSH (fetch TCP.DATA.OFFSET of DATUM) 2)) (TCP.CONTENTS (\ADDBASE (fetch TCPHEADER of DATUM) (UNFOLD (fetch TCP.DATA.OFFSET of DATUM) WORDSPERCELL))) (TCP.OPTIONS (\ADDBASE (fetch TCPHEADER of DATUM) (UNFOLD \TCP.MIN.DATA.OFFSET WORDSPERCELL)))))) (DATATYPE TCP.CONTROL.BLOCK ((TCB.LOCK POINTER) (* ; "monitor lock for synchronizing access") ( TCB.STATE POINTER) (* ; "one of CLOSED LISTEN SYN.SENT SYN.RECEIVED ESTABLISHED FIN.WAIT.1 FIN.WAIT.2 CLOSE.WAIT CLOSING LAST.ACK TIME.WAIT" ) (TCB.SND.STREAM POINTER) (* ; "user's send stream") (TCB.SND.SEGMENT POINTER) (* ; "current output packet being filled") (TCB.RCV.STREAM POINTER) (* ; "user's receive stream") ( TCB.RCV.SEGMENT POINTER) (* ; "current input packet being read") (TCB.2MSL.TIMER POINTER) (* ; "2*MSL quiet time") (TCB.MAXSEG POINTER) (* ; "maximum segment size") (TCB.CLOSEDFLG POINTER) (* ; "T if user has initiated close (no more data to send)") (TCB.FINSEQ POINTER) (* ; "one past the sequence number of the FIN we sent") (TCB.ACKFLG POINTER) (* ; "when to ACK peer: NOW or LATER") (TCB.TEMPLATE POINTER) (* ; "TCP header template") (TCB.PH POINTER) (* ; "TCP pseudo-header for checksumming") (TCB.SRC.PORT WORD) (* ; "local port") (TCB.DST.PORT WORD) (* ; "remote port") (TCB.DST.HOST FIXP) (* ; "remote host address") (TCB.INPUT.QUEUE POINTER) (* ; "queue of received segments to be read") (TCB.REXMT.QUEUE POINTER) (* ; "queue of unacked segments to be retransmitted") (TCB.SND.UNA FIXP) (* ; "first unacknowledged sequence number") (TCB.SND.NXT FIXP) (* ; "next sequence number to be sent") ( TCB.SND.UP FIXP) (* ; "send urgent pointer") (TCB.SND.WL1 FIXP) (* ; "segment sequence number used for last window update") (TCB.SND.WL2 FIXP) (* ; "segment acknowledgment number used for last window update") (TCB.ISS FIXP) (* ; "initial send sequence number") (TCB.SND.WND WORD) (* ; "send window") (TCB.RCV.WND WORD) (* ; "receive window") (TCB.RCV.NXT FIXP) (* ; "next sequence number expected") (TCB.RCV.UP FIXP) (* ; "receive urgent pointer") (TCB.IRS FIXP) (* ; "initial receive sequence number") (TCB.USER.TIMEOUT POINTER) (* ; "in milliseconds") (TCB.ESTABLISHED POINTER) (* ; "processes waiting for this event are notified when the connection becomes established") ( TCB.SND.EVENT POINTER) (* ; "processes waiting for this event are notified when the send window opens up") (TCB.RCV.EVENT POINTER) (* ; "processes waiting for this event are notified when data is received") (TCB.URGENT.EVENT POINTER ) (* ; "processes waiting for this event are notified when urgent data is received") ( TCB.FINACKED.EVENT POINTER) (* ; "processes waiting for this event are notified when our FIN has been acked") (TCB.MODE POINTER) (* ; "ACTIVE or PASSIVE") (TCB.RTFLG POINTER) (* ; "T if round trip time being measured") (TCB.RTSEQ POINTER) (* ; "sequence number being timed") (TCB.RTTIMER POINTER) (* ; "round trip timer") (TCB.SRTT POINTER) (* ; "smoothed round trip time") (TCB.RTO POINTER) (* ; "retransmission timeout based on smoothed round trip time") (TCB.PROBE.TIMER POINTER) (* ; "timer for delayed ACKs and window probes") (TCB.IPSOCKET POINTER) (* ; "Pointer to open IP socket for this connection") (TCB.PROCESS POINTER) (* ; "TCP monitor process for this connection") (TCB.SENT.ZERO FLAG) (* ; "Sent a zero allocation last time") (TCB.OUTPUT.HELD FLAG) (* ; "True if output window shut") ( TCB.NO.IDLE.PROBING FLAG) (* ; "True if we don't probe when nothing to output") (NIL BITS 5) ( TCB.OUR.MAXSEG WORD) (TCB.LAST.SENT.RCV.WND WORD) (* ; "The value of the last rcv window we sent")) TCB.LOCK _ (CREATE.MONITORLOCK) TCB.STATE _ (QUOTE CLOSED) TCB.RCV.WND _ \TCP.DEFAULT.RECEIVE.WINDOW TCB.USER.TIMEOUT _ \TCP.DEFAULT.USER.TIMEOUT TCB.ESTABLISHED _ (CREATE.EVENT) TCB.SND.EVENT _ ( CREATE.EVENT) TCB.RCV.EVENT _ (CREATE.EVENT) TCB.URGENT.EVENT _ (CREATE.EVENT) TCB.FINACKED.EVENT _ ( CREATE.EVENT) TCB.MAXSEG _ \TCP.DEFAULT.MAXSEG TCB.OUR.MAXSEG _ \TCP.DEFAULT.MAXSEG TCB.SRTT _ \TCP.INITIAL.RTO TCB.RTO _ \TCP.INITIAL.RTO) (ACCESSFNS TCPSTREAM ((TCB (fetch (STREAM F1) of DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (BYTECOUNT (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE)) (ACCESS (fetch ( STREAM ACCESS) of DATUM) (replace (STREAM ACCESS) of DATUM with NEWVALUE)) (ORIGINAL.COFFSET (fetch ( STREAM FW6) of DATUM) (replace (STREAM FW6) of DATUM with NEWVALUE))) (CREATE (create STREAM DEVICE _ \TCP.DEVICE))) (PUTPROP (QUOTE TCP) (QUOTE IMPORTDATE) (IDATE " 6-Sep-89 17:01:28")) (PUTPROP (QUOTE TCPCHAT) (QUOTE IMPORTDATE) (IDATE " 7-Jul-88 18:21:44")) (RECORD IPINIT (LOCAL.ADDRESSES LOCAL.NETWORKS DEFAULT.GATEWAY HTE.FILE HOSTNAME SUBNETMASK DOMAIN.SERVERS LOCAL.DOMAIN LOCAL.NSHOSTNUMBER)) (PUTPROP (QUOTE TCPCONFIG) (QUOTE IMPORTDATE) (IDATE "18-Apr-88 21:05:32")) (PUTPROP (QUOTE TCPDEBUG) (QUOTE IMPORTDATE) (IDATE "16-Apr-87 15:16:27")) (RPAQQ \UDPDOMAIN.WDS 6) (CONSTANTS (\UDPDOMAIN.WDS 6)) (BLOCKRECORD DOMAIN.HEADER ((ID WORD) (RESPONSEFLG FLAG) (OPCODE BITS 4) (AUTHORITYFLG FLAG) ( TRUNCATEDFLG FLAG) (WANTRECURSEFLG FLAG) (CANRECURSEFLG FLAG) (NIL BITS 3) (RESPONSECODE BITS 4) ( QDCOUNT WORD) (ANCOUNT WORD) (NSCOUNT WORD) (ARCOUNT WORD))) (RPAQQ DOMAIN.OPCODES ((DOMAIN.QUERY 0) (DOMAIN.IQUERY 1) (DOMAIN.CQUERYM 2) (DOMAIN.CQUERYU 3))) (RPAQQ DOMAIN.QUERY 0) (RPAQQ DOMAIN.IQUERY 1) (RPAQQ DOMAIN.CQUERYM 2) (RPAQQ DOMAIN.CQUERYU 3) (CONSTANTS (DOMAIN.QUERY 0) (DOMAIN.IQUERY 1) (DOMAIN.CQUERYM 2) (DOMAIN.CQUERYU 3)) (RPAQQ DOMAIN.RCODES ((RCODE.OK 0) (RCODE.FORMATERROR 1) (RCODE.SERVERFAILED 2) (RCODE.NAMEERROR 3) ( RCODE.NOTIMPLEMENTED 4) (RCODE.REFUSED 5))) (RPAQQ RCODE.OK 0) (RPAQQ RCODE.FORMATERROR 1) (RPAQQ RCODE.SERVERFAILED 2) (RPAQQ RCODE.NAMEERROR 3) (RPAQQ RCODE.NOTIMPLEMENTED 4) (RPAQQ RCODE.REFUSED 5) (CONSTANTS (RCODE.OK 0) (RCODE.FORMATERROR 1) (RCODE.SERVERFAILED 2) (RCODE.NAMEERROR 3) ( RCODE.NOTIMPLEMENTED 4) (RCODE.REFUSED 5)) (RPAQQ DOMAIN.RRTYPES ((RRTYPE.A 1) (RRTYPE.NS 2) (RRTYPE.MD 3) (RRTYPE.MF 4) (RRTYPE.CNAME 5) ( RRTYPE.SOA 6) (RRTYPE.MB 7) (RRTYPE.MG 8) (RRTYPE.MR 9) (RRTYPE.NULL 10) (RRTYPE.WKS 11) (RRTYPE.PTR 12) (RRTYPE.HINFO 13) (RRTYPE.MINFO 14) (RRTYPE.MX 15))) (RPAQQ RRTYPE.A 1) (RPAQQ RRTYPE.NS 2) (RPAQQ RRTYPE.MD 3) (RPAQQ RRTYPE.MF 4) (RPAQQ RRTYPE.CNAME 5) (RPAQQ RRTYPE.SOA 6) (RPAQQ RRTYPE.MB 7) (RPAQQ RRTYPE.MG 8) (RPAQQ RRTYPE.MR 9) (RPAQQ RRTYPE.NULL 10) (RPAQQ RRTYPE.WKS 11) (RPAQQ RRTYPE.PTR 12) (RPAQQ RRTYPE.HINFO 13) (RPAQQ RRTYPE.MINFO 14) (RPAQQ RRTYPE.MX 15) (CONSTANTS (RRTYPE.A 1) (RRTYPE.NS 2) (RRTYPE.MD 3) (RRTYPE.MF 4) (RRTYPE.CNAME 5) (RRTYPE.SOA 6) ( RRTYPE.MB 7) (RRTYPE.MG 8) (RRTYPE.MR 9) (RRTYPE.NULL 10) (RRTYPE.WKS 11) (RRTYPE.PTR 12) ( RRTYPE.HINFO 13) (RRTYPE.MINFO 14) (RRTYPE.MX 15)) (RPAQQ DOMAIN.CLASSTYPES ((CLASSTYPE.IN 1) (CLASSTYPE.CSNET 2) (CLASSTYPE.CHAOS 3))) (RPAQQ CLASSTYPE.IN 1) (RPAQQ CLASSTYPE.CSNET 2) (RPAQQ CLASSTYPE.CHAOS 3) (CONSTANTS (CLASSTYPE.IN 1) (CLASSTYPE.CSNET 2) (CLASSTYPE.CHAOS 3)) (RPAQQ \DOMAIN.PORT 53) (CONSTANTS (\DOMAIN.PORT 53)) (PUTPROP (QUOTE tcpdomain) (QUOTE IMPORTDATE) (IDATE "15-Feb-88 17:40:22")) (PUTPROP (QUOTE tcpexports) (QUOTE IMPORTDATE) (IDATE " 6-Sep-89 17:23:47")) (ACCESSFNS TCPDATASTREAM ((TCPCONTROLDEVICE (fetch (STREAM F3) of DATUM) (replace (STREAM F3) of DATUM with NEWVALUE)) (SEENEOS (fetch (STREAM F4) of DATUM) (replace (STREAM F4) of DATUM with NEWVALUE)) ( TCPFTPCON (fetch (STREAM F5) of DATUM) (replace (STREAM F5) of DATUM with NEWVALUE)))) (RECORD TCPFTPCON (TCPIN TCPOUT DATASTREAM BUSY? IDLETIMER GENERATEFILESDIRECTORY)) (PUTPROP (QUOTE TCPFTP) (QUOTE IMPORTDATE) (IDATE "11-Sep-89 15:22:47")) (PUTPROP (QUOTE tcpftpsrv) (QUOTE IMPORTDATE) (IDATE "24-Aug-87 18:26:25")) (PUTPROP (QUOTE TCPHTE) (QUOTE IMPORTDATE) (IDATE "24-May-88 17:06:10")) (ACCESSFNS AR ((ARBASE (LOCF (fetch (ETHERPACKET EPBODY) of DATUM)))) (BLOCKRECORD ARBASE (( ARHARDWARESPACE WORD) (ARPROTOCOLSPACE WORD) (ARHARDWARELEN BYTE) (ARPROTOCOLLEN BYTE) (AROPCODE WORD) (AR1STWORD WORD)) (ACCESSFNS AR1STWORD ((ARCONTENTS (LOCF DATUM)))))) (ACCESSFNS ARETHER ((ARETHERBASE (fetch (AR ARCONTENTS) of DATUM))) (BLOCKRECORD ARETHERBASE (( ARLCLHDW0 WORD) (ARLCLHDW1 WORD) (ARLCLHDW2 WORD) (ARLCLPTCL FIXP) (ARFRNHDW0 WORD) (ARFRNHDW1 WORD) ( ARFRNHDW2 WORD) (ARFRNPTCL FIXP)) (ACCESSFNS ARLCLHDW0 ((ARSENDERHDW (\LOADNSHOSTNUMBER (LOCF DATUM)) (\STORENSHOSTNUMBER (LOCF DATUM) NEWVALUE)))) (ACCESSFNS ARFRNHDW0 ((ARTARGETHDW (\LOADNSHOSTNUMBER ( LOCF DATUM)) (\STORENSHOSTNUMBER (LOCF DATUM) NEWVALUE)))))) (ACCESSFNS AREXPETHER ((ARETHERBASE (fetch (AR ARCONTENTS) of DATUM))) (BLOCKRECORD ARETHERBASE (( ARLCLHDW WORD) (ARLCLPTCL FIXP) (ARFRNHDW WORD) (ARFRNPTCL FIXP)))) (DATATYPE ARENTRY ((RECENT FLAG) (SEARCHING FLAG) (IPADDRESS POINTER) (ETHERADDRESS POINTER) (TIMER POINTER)) TIMER _ (NCREATE (QUOTE FIXP))) (RPAQQ \AR.HARDWARE.SPACE.ETHERNET 1) (RPAQQ \AR.ETHERNET.ADDRESS.LENGTH 6) (RPAQQ \AR.IP.ADDRESS.LENGTH 4) (RPAQQ \AR.REQUEST 1) (RPAQQ \AR.RESPONSE 2) (RPAQQ \AR.ETHER.PACKET.LENGTH 28) (CONSTANTS (\AR.HARDWARE.SPACE.ETHERNET 1) (\AR.ETHERNET.ADDRESS.LENGTH 6) (\AR.IP.ADDRESS.LENGTH 4) ( \AR.REQUEST 1) (\AR.RESPONSE 2) (\AR.ETHER.PACKET.LENGTH 28)) (PUTPROP (QUOTE TCPLLAR) (QUOTE IMPORTDATE) (IDATE " 6-Sep-89 15:50:14")) (ACCESSFNS ICMPADMASK ((ICMPADMASKBASE (fetch (ICMP ICMPCONTENTS) of DATUM))) (BLOCKRECORD ICMPADMASKBASE ((ICMPADMASKID WORD) (ICMPADMASKSEQNO WORD) (ICMPADMASKADMASK FIXP)))) (ACCESSFNS ICMP ((ICMPBASE (\IPDATABASE DATUM))) (BLOCKRECORD ICMPBASE ((ICMPTYPE BYTE) (ICMPCODE BYTE ) (ICMPCHECKSUM WORD) (ICMPDATASTART WORD))) (ACCESSFNS ICMP ((ICMPCONTENTS (LOCF (fetch (ICMP ICMPDATASTART) of DATUM)))))) (ACCESSFNS ICMPECHO ((ICMPECHOBASE (fetch (ICMP ICMPCONTENTS) of DATUM))) (BLOCKRECORD ICMPECHOBASE (( ICMPECHOID WORD) (ICMPECHOSEQNO WORD) (ICMPECHODATA BYTE)))) (ACCESSFNS ICMPDESTUN ((ICMPECHOBASE (fetch (ICMP ICMPCONTENTS) of DATUM))) (BLOCKRECORD ICMPECHOBASE ((NIL FIXP) (ICMPIPSTART WORD))) (ACCESSFNS ICMPDESTUN ((ICMPIPHEADER (LOCF (fetch (ICMPDESTUN ICMPIPSTART) of DATUM)))))) (ACCESSFNS ICMPREDIRECT ((ICMPREDIRECTBASE (fetch (ICMP ICMPCONTENTS) of DATUM))) (BLOCKRECORD ICMPREDIRECTBASE ((ICMPGATEWAY FIXP) (ICMPIPSTART WORD))) (ACCESSFNS ICMPREDIRECT ((ICMPIPHEADER (LOCF (fetch (ICMPREDIRECT ICMPIPSTART) of DATUM)))))) (RPAQQ ICMPTYPES ((\ICMP.ECHO.REPLY 0) (\ICMP.DEST.UNREACHABLE 3) (\ICMP.SOURCE.QUENCH 4) ( \ICMP.REDIRECT 5) (\ICMP.ECHO 8) (\ICMP.TIME.EXCEEDED 11) (\ICMP.PARAMETER.PROBLEM 12) ( \ICMP.TIMESTAMP 13) (\ICMP.TIMESTAMP.REPLY 14) (\ICMP.INFO.REQUEST 15) (\ICMP.INFO.REPLY 16) ( \ICMP.ADDRESS.MASK.REQUEST 17) (\ICMP.ADDRESS.MASK.REPLY 18))) (RPAQQ \ICMP.ECHO.REPLY 0) (RPAQQ \ICMP.DEST.UNREACHABLE 3) (RPAQQ \ICMP.SOURCE.QUENCH 4) (RPAQQ \ICMP.REDIRECT 5) (RPAQQ \ICMP.ECHO 8) (RPAQQ \ICMP.TIME.EXCEEDED 11) (RPAQQ \ICMP.PARAMETER.PROBLEM 12) (RPAQQ \ICMP.TIMESTAMP 13) (RPAQQ \ICMP.TIMESTAMP.REPLY 14) (RPAQQ \ICMP.INFO.REQUEST 15) (RPAQQ \ICMP.INFO.REPLY 16) (RPAQQ \ICMP.ADDRESS.MASK.REQUEST 17) (RPAQQ \ICMP.ADDRESS.MASK.REPLY 18) (CONSTANTS (\ICMP.ECHO.REPLY 0) (\ICMP.DEST.UNREACHABLE 3) (\ICMP.SOURCE.QUENCH 4) (\ICMP.REDIRECT 5) (\ICMP.ECHO 8) (\ICMP.TIME.EXCEEDED 11) (\ICMP.PARAMETER.PROBLEM 12) (\ICMP.TIMESTAMP 13) ( \ICMP.TIMESTAMP.REPLY 14) (\ICMP.INFO.REQUEST 15) (\ICMP.INFO.REPLY 16) (\ICMP.ADDRESS.MASK.REQUEST 17 ) (\ICMP.ADDRESS.MASK.REPLY 18)) (RPAQQ ICMPUNREACHABLES ((\ICMP.NET.UNREACHABLE 0) (\ICMP.HOST.UNREACHABLE 1) ( \ICMP.PROTOCOL.UNREACHABLE 2) (\ICMP.PORT.UNREACHABLE 3) (\ICMP.CANT.FRAGMENT 4) (\ICMP.SOURCE.ROUTE 5 ))) (RPAQQ \ICMP.NET.UNREACHABLE 0) (RPAQQ \ICMP.HOST.UNREACHABLE 1) (RPAQQ \ICMP.PROTOCOL.UNREACHABLE 2) (RPAQQ \ICMP.PORT.UNREACHABLE 3) (RPAQQ \ICMP.CANT.FRAGMENT 4) (RPAQQ \ICMP.SOURCE.ROUTE 5) (CONSTANTS (\ICMP.NET.UNREACHABLE 0) (\ICMP.HOST.UNREACHABLE 1) (\ICMP.PROTOCOL.UNREACHABLE 2) ( \ICMP.PORT.UNREACHABLE 3) (\ICMP.CANT.FRAGMENT 4) (\ICMP.SOURCE.ROUTE 5)) (RPAQQ ICMPREDIRECTS ((\ICMP.REDIRECT.NET 0) (\ICMP.REDIRECT.HOST 1) (\ICMP.REDIRECT.SVC.AND.NET 2) ( \ICMP.REDIRECT.SVC.AND.HOST 3))) (RPAQQ \ICMP.REDIRECT.NET 0) (RPAQQ \ICMP.REDIRECT.HOST 1) (RPAQQ \ICMP.REDIRECT.SVC.AND.NET 2) (RPAQQ \ICMP.REDIRECT.SVC.AND.HOST 3) (CONSTANTS (\ICMP.REDIRECT.NET 0) (\ICMP.REDIRECT.HOST 1) (\ICMP.REDIRECT.SVC.AND.NET 2) ( \ICMP.REDIRECT.SVC.AND.HOST 3)) (RPAQQ ICMPTIMEXS ((\ICMP.TRANSIT.TIME.EXCEEDED 0) (\ICMP.FRAGMENT.TIME.EXCEEDED 1))) (RPAQQ \ICMP.TRANSIT.TIME.EXCEEDED 0) (RPAQQ \ICMP.FRAGMENT.TIME.EXCEEDED 1) (CONSTANTS (\ICMP.TRANSIT.TIME.EXCEEDED 0) (\ICMP.FRAGMENT.TIME.EXCEEDED 1)) (RPAQQ \ICMPOVLEN 4) (CONSTANTS \ICMPOVLEN) (RPAQQ \ICMP.PROTOCOL 1) (CONSTANTS \ICMP.PROTOCOL) (PUTPROPS ICMPLENGTH MACRO (LAMBDA (ICMP) (IDIFFERENCE (fetch (IP IPTOTALLENGTH) of ICMP) (LLSH (fetch (IP IPHEADERLENGTH) of ICMP) 2)))) (PUTPROP (QUOTE TCPLLICMP) (QUOTE IMPORTDATE) (IDATE " 6-Sep-89 16:28:51")) (ACCESSFNS IP ((IPBASE (LOCF (fetch (ETHERPACKET EPBODY) of DATUM)))) (BLOCKRECORD IPBASE ((IPVERSION BITS 4) (* ; "Protocol version") (IPHEADERLENGTH BITS 4) (* ; "Head length, in cells") (IPSERVICE BYTE ) (* ; "Service type") (IPTOTALLENGTH WORD) (* ; "Packet length, in bytes") (IPID WORD) (* ; "Packet id") (NIL BITS 1) (IPDONTFRAGMENT FLAG) (* ; "Don't fragment me") (IPMOREFRAGMENTS FLAG) (* ; "Last fragment") (IPFRAGMENTOFFSET BITS 13) (* ; "Fragment position") (IPTIMETOLIVE BYTE) (* ; "Hop limiter") (IPPROTOCOL BYTE) (* ; "Client protocol") (IPHEADERCHECKSUM WORD) (* ; "Header-only checksum") (IPSOURCEADDRESS FIXP) (IPDESTINATIONADDRESS FIXP) (IPOPTIONSSTART BYTE) (* ; "Options or data start here")) (ACCESSFNS IPSERVICE ((IPSERVICEBASE (LOCF DATUM))) (BLOCKRECORD IPSERVICEBASE ((IPPRECEDENCE BITS 3) (IPDELAY FLAG) (IPTHROUGHPUT FLAG) (IPRELIABILITY FLAG) (NIL BITS 2)))) (* ; "Replace is not supported on any of the following because there is ambiguity about the address class." ) (ACCESSFNS IPDESTINATIONADDRESS ((IPDESTBASE (LOCF DATUM))) (ACCESSFNS IPDESTBASE ((IPDESTINATIONNET (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (fetch (IPADDRESS CLASSANET) of DATUM)) ( (EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (fetch (IPADDRESS CLASSBNET) of DATUM)) (T (* ; "Class C or error") (fetch (IPADDRESS CLASSCNET) of DATUM)))) (IPDESTINATIONHOST (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (fetch (IPADDRESS CLASSAHOST) of DATUM)) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (fetch (IPADDRESS CLASSBHOST) of DATUM)) (T (* ; "Class C or error") (fetch (IPADDRESS CLASSCHOST) of DATUM))))))) (ACCESSFNS IPSOURCEADDRESS (( IPSOURCEBASE (LOCF DATUM))) (ACCESSFNS IPSOURCEBASE ((IPSOURCENET (COND ((EQ \IP.CLASS.A (fetch ( IPADDRESS CLASSA) of DATUM)) (fetch (IPADDRESS CLASSANET) of DATUM)) ((EQ \IP.CLASS.B (fetch ( IPADDRESS CLASSB) of DATUM)) (fetch (IPADDRESS CLASSBNET) of DATUM)) (T (fetch (IPADDRESS CLASSCNET) of DATUM)))) (IPSOURCEHOST (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (fetch ( IPADDRESS CLASSAHOST) of DATUM)) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (fetch ( IPADDRESS CLASSBHOST) of DATUM)) (T (fetch (IPADDRESS CLASSCHOST) of DATUM)))))))) (TYPE? (type? ETHERPACKET DATUM))) (DATATYPE IPSOCKET ((PROTOCOL BYTE) (IPSLINK POINTER) (* ; "Other sockets of this protocol type") (NIL BYTE) (IPSQUEUE POINTER) (* ; "Queue of packets for this protocol") (IPSQUEUELENGTH WORD) (* ; "Count of packets of input queue") (IPSQUEUEALLOC WORD) (* ; "Max count allowed") ( IPSDESTSOCKETCOMPAREFN POINTER) (* ; "Call this to compare dest protocol socket to this socket") ( IPSOCKET POINTER) (* ; "This socket") (IPSINPUTFN POINTER) (* ; "Call to hand packet to protocol") ( IPSEVENT POINTER) (* ; "Notify me when a packet arrives") (IPSNOSOCKETFN POINTER) (* ; "Call this when no socket found") (IPSICMPFN POINTER) (* ; "Call this when an ICMP packet is received on this protocol")) IPSQUEUE _ (create SYSQUEUE) IPSQUEUEALLOC _ \IP.MAX.EPKTS.ON.QUEUE IPSEVENT _ (CREATE.EVENT) IPSINPUTFN _ (FUNCTION \IP.DEFAULT.INPUTFN) IPSICMPFN _ (FUNCTION \RELEASE.ETHERPACKET)) (BLOCKRECORD IPADDRESS ((ADDRESS FIXP)) (* ;; "Class A nets: high bit is 0") (BLOCKRECORD IPADDRESS (( CLASSA BITS 1) (CLASSANET BITS 7) (CLASSAHOST BITS 24))) (* ;; "Class B nets: high 2 bits are 10") ( BLOCKRECORD IPADDRESS ((CLASSB BITS 2))) (BLOCKRECORD IPADDRESS ((CLASSBNET BITS 16) (CLASSBHOST BITS 16))) (* ;; "Class C nets: high 3 bits are 110") (BLOCKRECORD IPADDRESS ((CLASSC BITS 3))) ( BLOCKRECORD IPADDRESS ((CLASSCNETB1 BITS 8) (CLASSCNETB2 BITS 8) (CLASSCNETB3 BITS 8) (CLASSCHOST BITS 8))) (* ; "I wish I could say just net bits 24, host bits 8, but BLOCKRECORD barfs") (BLOCKRECORD IPADDRESS ((CLASSCNETHI BITS 16))) (ACCESSFNS IPADDRESS ((CLASSCNET (\MAKENUMBER (FETCH CLASSCNETB1 OF DATUM) (LOGOR (LLSH (FETCH CLASSCNETB2 OF DATUM) 8) (FETCH CLASSCNETB3 OF DATUM))) (PROGN (REPLACE CLASSCNETHI OF DATUM WITH (LRSH NEWVALUE 8)) (REPLACE CLASSCNETB3 OF DATUM WITH (LOGAND NEWVALUE 255)) DATUM))))) (RPAQQ \IPOVLEN 20) (RPAQQ \MAX.IPDATALENGTH 556) (RPAQQ \IP.PROTOCOLVERSION 4) (RPAQQ \IP.MAX.EPKTS.ON.QUEUE 16) (RPAQQ \IP.DEFAULT.TIME.TO.LIVE 120) (RPAQQ \IP.WAKEUP.INTERVAL 15000) (CONSTANTS \IPOVLEN \MAX.IPDATALENGTH \IP.PROTOCOLVERSION \IP.MAX.EPKTS.ON.QUEUE \IP.DEFAULT.TIME.TO.LIVE \IP.WAKEUP.INTERVAL) (RPAQQ IPPACKETTYPES ((\EPT.IP 2048) (\EPT.AR 2054) (\EET.IP 513) (\EPT.CHAOS 2052))) (RPAQQ \EPT.IP 2048) (RPAQQ \EPT.AR 2054) (RPAQQ \EET.IP 513) (RPAQQ \EPT.CHAOS 2052) (CONSTANTS (\EPT.IP 2048) (\EPT.AR 2054) (\EET.IP 513) (\EPT.CHAOS 2052)) (RPAQQ ICMPUNREACHABLES ((\ICMP.NET.UNREACHABLE 0) (\ICMP.HOST.UNREACHABLE 1) ( \ICMP.PROTOCOL.UNREACHABLE 2) (\ICMP.PORT.UNREACHABLE 3) (\ICMP.CANT.FRAGMENT 4) (\ICMP.SOURCE.ROUTE 5 ))) (RPAQQ \ICMP.NET.UNREACHABLE 0) (RPAQQ \ICMP.HOST.UNREACHABLE 1) (RPAQQ \ICMP.PROTOCOL.UNREACHABLE 2) (RPAQQ \ICMP.PORT.UNREACHABLE 3) (RPAQQ \ICMP.CANT.FRAGMENT 4) (RPAQQ \ICMP.SOURCE.ROUTE 5) (CONSTANTS (\ICMP.NET.UNREACHABLE 0) (\ICMP.HOST.UNREACHABLE 1) (\ICMP.PROTOCOL.UNREACHABLE 2) ( \ICMP.PORT.UNREACHABLE 3) (\ICMP.CANT.FRAGMENT 4) (\ICMP.SOURCE.ROUTE 5)) (PUTPROPS \IPDATABASE MACRO (LAMBDA (IP) (* ; "Returns the LOCF of the start of the data in the packet") (\ADDBASE (fetch (IP IPBASE) of IP) (UNFOLD (fetch (IP IPHEADERLENGTH) of IP) 2)))) (PUTPROPS \IPDATALENGTH MACRO (LAMBDA (IP) (IDIFFERENCE (fetch (IP IPTOTALLENGTH) of IP) (LLSH (fetch (IP IPHEADERLENGTH) of IP) 2)))) (RPAQQ IPADDRESSTYPES ((\IP.CLASS.A 0) (\IP.CLASS.A.BYTESPEC (BYTE 1 31)) (\IP.CLASS.A.NET.BYTESPEC ( BYTE 8 24)) (\IP.CLASS.A.HOST.BYTESPEC (BYTE 24 0)) (\IP.CLASS.B 2) (\IP.CLASS.B.BYTESPEC (BYTE 2 30)) (\IP.CLASS.B.NET.BYTESPEC (BYTE 16 16)) (\IP.CLASS.B.HOST.BYTESPEC (BYTE 16 0)) (\IP.CLASS.C 6) ( \IP.CLASS.C.BYTESPEC (BYTE 3 29)) (\IP.CLASS.C.NET.BYTESPEC (BYTE 24 8)) (\IP.CLASS.C.HOST.BYTESPEC ( BYTE 8 0)))) (RPAQQ \IP.CLASS.A 0) (RPAQ \IP.CLASS.A.BYTESPEC (BYTE 1 31)) (RPAQ \IP.CLASS.A.NET.BYTESPEC (BYTE 8 24)) (RPAQ \IP.CLASS.A.HOST.BYTESPEC (BYTE 24 0)) (RPAQQ \IP.CLASS.B 2) (RPAQ \IP.CLASS.B.BYTESPEC (BYTE 2 30)) (RPAQ \IP.CLASS.B.NET.BYTESPEC (BYTE 16 16)) (RPAQ \IP.CLASS.B.HOST.BYTESPEC (BYTE 16 0)) (RPAQQ \IP.CLASS.C 6) (RPAQ \IP.CLASS.C.BYTESPEC (BYTE 3 29)) (RPAQ \IP.CLASS.C.NET.BYTESPEC (BYTE 24 8)) (RPAQ \IP.CLASS.C.HOST.BYTESPEC (BYTE 8 0)) (CONSTANTS (\IP.CLASS.A 0) (\IP.CLASS.A.BYTESPEC (BYTE 1 31)) (\IP.CLASS.A.NET.BYTESPEC (BYTE 8 24)) ( \IP.CLASS.A.HOST.BYTESPEC (BYTE 24 0)) (\IP.CLASS.B 2) (\IP.CLASS.B.BYTESPEC (BYTE 2 30)) ( \IP.CLASS.B.NET.BYTESPEC (BYTE 16 16)) (\IP.CLASS.B.HOST.BYTESPEC (BYTE 16 0)) (\IP.CLASS.C 6) ( \IP.CLASS.C.BYTESPEC (BYTE 3 29)) (\IP.CLASS.C.NET.BYTESPEC (BYTE 24 8)) (\IP.CLASS.C.HOST.BYTESPEC ( BYTE 8 0))) (RPAQQ IPPROTOCOLTYPES ((\ICMP.PROTOCOL 1) (\TCP.PROTOCOL 6) (\UDP.PROTOCOL 17))) (RPAQQ \ICMP.PROTOCOL 1) (RPAQQ \TCP.PROTOCOL 6) (RPAQQ \UDP.PROTOCOL 17) (CONSTANTS (\ICMP.PROTOCOL 1) (\TCP.PROTOCOL 6) (\UDP.PROTOCOL 17)) (RECORD AssemblyRecord (Packet FirstHole Fragments Timeout) Packet _ (\ALLOCATE.ETHERPACKET) FirstHole _ 0) (RECORD FragmentRecord (Start Length LastFragment)) (RECORD FragmentID (AssemblyRecord SourceAddress ID Protocol . DestinationAddress)) (RPAQQ IPOPTIONTYPES ((IPOPT.END 0) (IPOPT.NOP 1) (IPOPT.SECURITY 2) (IPOPT.LSRR 3) (IPOPT.TIMESTAMP 4 ) (IPOPT.RECRT 7) (IPOPT.STREAMID 8) (IPOPT.SSSR 9))) (RPAQQ IPOPT.END 0) (RPAQQ IPOPT.NOP 1) (RPAQQ IPOPT.SECURITY 2) (RPAQQ IPOPT.LSRR 3) (RPAQQ IPOPT.TIMESTAMP 4) (RPAQQ IPOPT.RECRT 7) (RPAQQ IPOPT.STREAMID 8) (RPAQQ IPOPT.SSSR 9) (CONSTANTS (IPOPT.END 0) (IPOPT.NOP 1) (IPOPT.SECURITY 2) (IPOPT.LSRR 3) (IPOPT.TIMESTAMP 4) ( IPOPT.RECRT 7) (IPOPT.STREAMID 8) (IPOPT.SSSR 9)) (RPAQ IP.OPTION.NUMBER.BYTESPEC (BYTE 5 0)) (CONSTANTS (IP.OPTION.NUMBER.BYTESPEC (BYTE 5 0))) (PUTPROPS \IP.GET.BYTE DMACRO (LAMBDA (IP BYTE INHEADER) (* ;; "Retrieve a byte from an IP packet. If INHEADER is T, BYTE is an offset from the start of the packet, else it's an offset from the start of the IP data section" ) (\GETBASEBYTE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTE))) (PUTPROPS \IP.GET.CELL DMACRO (LAMBDA (IP CELL INHEADER) (* ;; "Retrieve a cell from an IP packet. If INHEADER is not NIL, the cell is written to the header portion of the IP packet, else it's written to the data portion. CELL is the offset, in 16-bit units" ) (\GETBASEFIXP (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) CELL))) (PUTPROPS \IP.GET.STRING DMACRO (LAMBDA (IP BYTEOFFSET NCHARS INHEADER) (* ;; "Retrieve a string from an IP packet. If INHEADER is T, BYTEOFFSET is an offset from the start of the packet, else it's an offset from the start of the IP data section" ) (\GETBASESTRING (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTEOFFSET NCHARS)) ) (PUTPROPS \IP.GET.WORD DMACRO (LAMBDA (IP WORD INHEADER) (* ;; "Retrieve a word from an IP packet. If INHEADER is T, WORD is an offset from the start of the packet, else it's an offset from the start of the IP data section" ) (\GETBASE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) WORD))) (PUTPROPS \IP.PUT.BYTE DMACRO (LAMBDA (IP BYTE VALUE INHEADER) (* ;; "Store a byte in an IP packet. If INHEADER is T, BYTE is an offset from the start of the packet, else it's an offset from the start of the IP data section" ) (\PUTBASEBYTE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTE VALUE))) (PUTPROPS \IP.PUT.CELL DMACRO (LAMBDA (IP CELL VALUE INHEADER) (* ;; "Store a cell in an IP packet. If INHEADER is not NIL, the cell is written to the header portion of the IP packet, else it's written to the data portion. CELL is the offset, in 16-bit units" ) (\PUTBASEFIXP (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) CELL VALUE))) (PUTPROPS \IP.PUT.STRING DMACRO (LAMBDA (IP BYTEOFFSET STRING INHEADER) (* ;; "Store a string ib an IP packet. If INHEADER is T, BYTEOFFSET is an offset from the start of the packet, else it's an offset from the start of the IP data section" ) (\PUTBASESTRING (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTEOFFSET STRING)) ) (PUTPROPS \IP.PUT.WORD DMACRO (LAMBDA (IP WORD VALUE INHEADER) (* ;; "Store a word in an IP packet. If INHEADER is T, WORD is an offset from the start of the packet, else it's an offset from the start of the IP data section" ) (\PUTBASE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) WORD VALUE))) (PUTPROP (QUOTE TCPLLIP) (QUOTE IMPORTDATE) (IDATE "11-Sep-89 15:24:32")) (PUTPROP (QUOTE TCPNAMES) (QUOTE IMPORTDATE) (IDATE " 2-Jun-88 20:58:40")) (RECORD TFTPCON (UDPSOCKET DESTSOCKET STREAM HOST)) (ACCESSFNS TFTP ((TFTPBASE (fetch (UDP UDPCONTENTS) of DATUM))) (BLOCKRECORD TFTPBASE ((OPCODE WORD) ( BLOCK# WORD))) (ACCESSFNS TFTP ((TFTPCONTENTS (\ADDBASE (fetch (UDP UDPCONTENTS) of DATUM) (FOLDHI \TFTPOVLEN BYTESPERWORD))))) (BLOCKRECORD TFTPBASE ((NIL WORD) (ERRORCODE WORD)))) (ACCESSFNS TFTPSTREAM ((TFTPCON (fetch (STREAM F1) of DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (LASTPACKETIN (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE)))) (RPAQQ \TFTPOVLEN 4) (RPAQQ \TFTP.SOCKET 69) (CONSTANTS (\TFTPOVLEN 4) (\TFTP.SOCKET 69)) (RPAQQ TFTPOPCODES ((\TFTP.RRQ 1) (\TFTP.WRQ 2) (\TFTP.DATA 3) (\TFTP.ACK 4) (\TFTP.ERROR 5))) (RPAQQ \TFTP.RRQ 1) (RPAQQ \TFTP.WRQ 2) (RPAQQ \TFTP.DATA 3) (RPAQQ \TFTP.ACK 4) (RPAQQ \TFTP.ERROR 5) (CONSTANTS (\TFTP.RRQ 1) (\TFTP.WRQ 2) (\TFTP.DATA 3) (\TFTP.ACK 4) (\TFTP.ERROR 5)) (PUTPROP (QUOTE TCPTFTP) (QUOTE IMPORTDATE) (IDATE " 1-Jul-87 10:54:35")) (ACCESSFNS UDP ((UDPBASE (\IPDATABASE DATUM))) (BLOCKRECORD UDPBASE ((UDPSOURCEPORT WORD) (UDPDESTPORT WORD) (UDPLENGTH WORD) (UDPCHECKSUM WORD))) (ACCESSFNS UDP ((UDPCONTENTS (\ADDBASE (\IPDATABASE DATUM ) (FOLDHI \UDPOVLEN BYTESPERWORD)))))) (RPAQQ \UDPOVLEN 8) (CONSTANTS (\UDPOVLEN 8)) (PUTPROP (QUOTE TCPUDP) (QUOTE IMPORTDATE) (IDATE " 6-Jan-89 16:37:41")) (PUTPROP (QUOTE TCPEXPORTS) (QUOTE FILEDATES) (QUOTE (("11-Sep-89 16:22:57" . "{ERIS}Library>TCPEXPORTS.;8")))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPFTP b/obsolete/tcp/TCPFTP new file mode 100644 index 00000000..519099e2 --- /dev/null +++ b/obsolete/tcp/TCPFTP @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "12-Jun-90 16:23:19" {DSK}local>lde>lispcore>library>TCPFTP.;3 50122 changes to%: (VARS TCPFTPCOMS) previous date%: "20-Jun-89 19:47:44" {DSK}local>lde>lispcore>library>TCPFTP.;2) (* ; " Copyright (c) 1985, 1986, 1900, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPFTPCOMS) (RPAQQ TCPFTPCOMS [[COMS (* ;; "FNS from Larry's Interlisp-10 LISPUSERS package") (FNS ARPACMD FTPHELP CMDREADCODE CMDREAD DISCARDLINE GETLINE \TCPFTP.INPUT TELNET.EOL) (INITVARS (\TCPFTP.ARPACMD.LOCK (CREATE.MONITORLOCK "ARPACMD Lock"))) (GLOBALVARS \TCPFTP.ARPACMD.LOCK) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA FTPHELP] (COMS (* ;; "FNS for the Interlisp-D streams facility") (FNS \TCPFTP.CONTROL.CLOSED \TCPFTP.GET.OSTYPE \TCPFTP.EVENTFN \TCPFTP.HOSTNAMEP \GET.TCPFTP.CONNECTION \TCPFTP.OPEN.CONNECTION \TCPFTP.ASSURE.CLEANUP \TCPFTP.CLEANUP \TCPFTP.RELEASE.CONNECTION \TCPFTP.LOGIN \TCPFTP.DELETEFILE \TCPFTP.DIRECTORYNAMEP \TCPFTP.ENDOFSTREAMOP \TCPFTP.GENERATEFILES \TCPFTP.GENERATENEXTFILE \TCPFTP.GETFILENAME \TCPFTP.GETFILEINFO \TCPFTP.SETFILEINFO \TCPFTP.RENAMEFILE \TCPFTP.CONNECT \TCPFTP.OPENFILE \TCPFTP.CLOSE \TCPFTP.FLUSH \TCPFTP.INIT SET.TCP.EOL.CONVENTION) (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TCPDATASTREAM TCPFTPCON))) (ADDVARS (TCPFTP.DEFAULT.FILETYPES (NIL . TEXT) (DFASL . BINARY) (dfasl . BINARY) (LCOM . BINARY) (lcom . BINARY) (DCOM . BINARY) (dcom . BINARY) (LISP . TEXT) (lisp . TEXT) (LSP . TEXT) (lsp . TEXT) (RST . BINARY) (rst . BINARY) (BIN . BINARY) (bin . BINARY))) (INITVARS (TCP.DEFAULTFILETYPE 'BINARY) (TCP.USE.STANDARD.EOL T) (\TCPFTP.DEVICES) (\TCPFTP.CLEANUP.PROCESS)) (GLOBALVARS \TCPFTP.DEVICES \TCPFTP.CLEANUP.PROCESS TCP.DEFAULTFILETYPE TCP.USE.STANDARD.EOL)) (COMS (* ;; "Data connection handling") (FNS \TCP.BYE \TCPFTP.MAYBE.ABORT \TCPFTP.DATA.CLOSED \TCPFTP.OPEN.DATA.CONNECTION \TCPFTP.PORT.STRING \TCPFTP.SPAWN.DATACONNECTION \TCPFTP.READ.UNTIL.EOF \TCPFTP.TRANSFER.COMPLETE \TCPFTP.WAIT.FOR.DATACONNECTION \TCPFTP.DELETE.CONNECTION) (INITVARS (\TCPFTP.DATACONNECTION.LOCK (CREATE.MONITORLOCK "TCPFTP Data Connection Lock")) (\TCPFTP.CONNECTION.LOCK (CREATE.MONITORLOCK "TCPFTP Connection Lock")) (\TCPFTP.IDLE.TIMEOUT (TIMES 10 60 1000))) (GLOBALVARS \TCPFTP.DATACONNECTION.LOCK \TCPFTP.CONNECTION.LOCK \TCPFTP.IDLE.TIMEOUT)) (FILES (SYSLOAD) TCPNAMES TCP) (P (\TCPFTP.INIT)) (VARS TCPFTP.DEFAULT.FILETYPES) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) (* ;; "FNS from Larry's Interlisp-10 LISPUSERS package") (DEFINEQ (ARPACMD (LAMBDA (TCPFTPCON CMD ARG WANT DISCARD WANTARG) (* ejs%: "15-Nov-86 15:09") (* lmm "16-OCT-78 02:57") (DECLARE (GLOBALVARS \TCPFTP.ARPACMD.LOCK)) (WITH.MONITOR \TCPFTP.ARPACMD.LOCK (LET ((INC (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (OUTC (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))) (RESETLST (RESETSAVE NIL (BQUOTE (COND (RESETSTATE (AND (OPENP %, INC (QUOTE INPUT)) (CLOSEF %, INC)) (AND (OPENP %, OUTC (QUOTE OUTPUT)) (CLOSEF %, OUTC)))))) (PROG NIL (COND (CMD (COND (FTPDEBUGFLG (printout FTPDEBUGLOG CMD) (COND (ARG (printout FTPDEBUGLOG " " ARG))))) (PRIN3 CMD OUTC) (COND (ARG (PRIN3 " " OUTC) (PRIN3 ARG OUTC))) (TELNET.EOL OUTC) (FORCEOUTPUT OUTC) (* flush) (COND (FTPDEBUGFLG (TERPRI FTPDEBUGLOG))))) LP (COND (FTPDEBUGFLG (printout FTPDEBUGLOG "< "))) (SETQ CMD (\TCPFTP.INPUT INC)) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG CMD " "))) (COND ((EQMEMB CMD WANTARG) (AND (EQ (BIN INC) (CHARCODE -)) (FTPHELP CMD)) (RETURN CMD))) (COND ((EQ (BIN INC) (CHARCODE -)) (do (DISCARDLINE INC) repeatuntil (EQ (\TCPFTP.INPUT INC) CMD)))) (COND ((EQMEMB CMD WANT) (DISCARDLINE INC) (RETURN CMD)) ((EQMEMB CMD DISCARD) (DISCARDLINE INC) (GO LP))) (SELECTQ (AND (FIXP CMD) (IQUOTIENT CMD 100)) ((2 3) (FTPHELP CMD)) ((4 5) (ERROR (GETLINE INC T))) NIL) (DISCARDLINE INC) (GO LP)))))) ) (FTPHELP (LAMBDA (ARG) (* ejs%: "29-Jan-85 17:02") (ERROR ARG " unrecognized response from remote FTP server")) ) (CMDREADCODE (LAMBDA (IN) (* lmm "31-MAY-78 00:45") (PACK* (CMDREAD IN) (CMDREAD IN) (CMDREAD IN)))) (CMDREAD (LAMBDA (IN) (* ejs%: "12-Jan-85 14:28") ((LAMBDA (CH) (COND (FTPDEBUGFLG (BOUT CH FTPDEBUGLOG))) CH) (BIN IN))) ) (DISCARDLINE (LAMBDA (IN) (* ejs%: " 3-Feb-86 16:16") (* lmm "31-MAY-78 00:45") (DECLARE (GLOBALVARS FTPDEBUGFLG FTPDEBUGLOG)) (COND (FTPDEBUGFLG (\BACKFILEPTR IN) (bind CH until (FMEMB (SETQ CH (BIN IN)) (CONSTANT (LIST (CHARCODE LF) (CHARCODE NULL)))) do (BOUT FTPDEBUGLOG CH) finally (TERPRI FTPDEBUGLOG))) (T (until (FMEMB (BIN IN) (CONSTANT (LIST (CHARCODE LF) (CHARCODE NULL)))))))) ) (GETLINE (LAMBDA (IN FLG) (* ejs%: "12-Jan-85 14:40") (* lmm "31-MAY-78 00:46") (bind CH (STRING _ (ALLOCSTRING 80)) for POS from 1 while (NEQ (SETQ CH (BIN IN)) (CHARCODE LF)) do (COND ((LEQ POS 80) (RPLCHARCODE STRING POS CH))) finally (RETURN (SUBSTRING STRING 1 (SUB1 POS))))) ) (\TCPFTP.INPUT (LAMBDA (STREAM) (* ; "Edited 17-Nov-88 15:16 by cdl") (DECLARE (GLOBALVARS FTPDEBUGFLG FTPDEBUGLOG)) (LET (CCODE (RESULT 0)) (to 3 do (SETQ CCODE (BIN STREAM)) (if (AND (GEQ CCODE (CHARCODE 0)) (LEQ CCODE (CHARCODE 9))) then (SETQ RESULT (PLUS (TIMES RESULT 10) (DIFFERENCE CCODE (CHARCODE 0))))) repeatuntil (OR (EQ CCODE (CHARCODE SPACE)) (EQ CCODE (CHARCODE -)) (EQ CCODE 0)) finally (if (EQ CCODE (CHARCODE -)) then (if FTPDEBUGFLG then (printout FTPDEBUGLOG T "< " RESULT)) (DISCARDLINE STREAM) (\TCPFTP.INPUT STREAM))) RESULT)) ) (TELNET.EOL (LAMBDA (STREAM) (* ejs%: " 5-Jan-85 18:44") (BOUT STREAM (CHARCODE CR)) (BOUT STREAM (CHARCODE LF)) (FORCEOUTPUT STREAM)) ) ) (RPAQ? \TCPFTP.ARPACMD.LOCK (CREATE.MONITORLOCK "ARPACMD Lock")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \TCPFTP.ARPACMD.LOCK) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA FTPHELP) ) (* ;; "FNS for the Interlisp-D streams facility") (DEFINEQ (\TCPFTP.CONTROL.CLOSED (LAMBDA (INSTREAM OUTSTREAM) (* ejs%: "28-Jul-86 14:30") (LET* ((DEVICE (fetch (STREAM DEVICE) of INSTREAM)) (TCPFTPCON (for CONN in (fetch (FDEV DEVICEINFO) of DEVICE) thereis (EQ (fetch (TCPFTPCON TCPIN) of CONN) INSTREAM)))) (COND (TCPFTPCON (replace (STREAM ACCESS) of INSTREAM with (replace (STREAM ACCESS) of OUTSTREAM with NIL)) (replace (FDEV DEVICEINFO) of DEVICE with (DREMOVE TCPFTPCON (fetch (FDEV DEVICEINFO) of DEVICE))))))) ) (\TCPFTP.GET.OSTYPE [LAMBDA (DEVICE) (* ; "Edited 12-May-89 14:10 by welch") (LET* ((HOST (fetch (FDEV DEVICENAME) of DEVICE)) ENTRY) (GETHOSTINFO HOST 'OSTYPE]) (\TCPFTP.EVENTFN (LAMBDA (FDEV FLG) (* ejs%: "23-Apr-85 18:56") (* * Called when a major event happens) (SELECTQ FLG ((BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS) (bind TCPIN TCPOUT DATASTREAM for TCPFTPCON in (fetch (FDEV DEVICEINFO) of FDEV) do (SETQ TCPIN (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (SETQ TCPOUT (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) (SETQ DATASTREAM (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON)) (COND ((OPENP TCPIN (QUOTE INPUT)) (CLOSEF TCPIN))) (COND ((OPENP TCPOUT (QUOTE OUTPUT)) (CLOSEF TCPOUT))) (COND ((OPENP DATASTREAM) (CLOSEF DATASTREAM))))) NIL)) ) (\TCPFTP.HOSTNAMEP [LAMBDA (HOST DEVICE) (* ejs%: "24-Mar-86 14:36") (DECLARE (GLOBALVARS \TCP.DEVICE \TCPFTP.DEVICES)) (PROG ((SERVER (OR (DODIP.HOSTP HOST) (\IP.READ.STRING.ADDRESS HOST))) FULLHOSTNAME FILINGNAME) (RETURN (COND ((NOT SERVER) NIL) ((\GETDEVICEFROMNAME (SETQ FULLHOSTNAME (MKATOM (U-CASE HOST))) T T)) (T (SETQ FILINGNAME (PACK* HOST " Filing")) (\DEFINEDEVICE FULLHOSTNAME (SETQ DEVICE (create FDEV using \TCP.DEVICE DEVICENAME _ FULLHOSTNAME OPENFILE _ (FUNCTION \TCPFTP.OPENFILE) RENAMEFILE _ (FUNCTION \TCPFTP.RENAMEFILE) REOPENFILE _ (FUNCTION NILL) GETFILEINFO _ (FUNCTION \TCPFTP.GETFILEINFO) SETFILEINFO _ (FUNCTION \TCPFTP.SETFILEINFO) GETEOFPTR _ (FUNCTION \TCPFTP.GETEOFPTR ) DELETEFILE _ (FUNCTION \TCPFTP.DELETEFILE) HOSTNAMEP _ (FUNCTION NILL) GETFILENAME _ (FUNCTION \TCPFTP.GETFILENAME) DIRECTORYNAMEP _ (FUNCTION \TCPFTP.DIRECTORYNAMEP ) GENERATEFILES _ (FUNCTION \TCPFTP.GENERATEFILES) EVENTFN _ (FUNCTION NILL) DEVICEINFO _ NIL))) (push \TCPFTP.DEVICES DEVICE) DEVICE]) (\GET.TCPFTP.CONNECTION (LAMBDA (DEVICE) (* ejs%: " 4-Jun-85 17:54") (LET ((CONNECTIONS (fetch (FDEV DEVICEINFO) of DEVICE)) TCPFTPCON INSTREAM OUTSTREAM) (WITH.MONITOR \TCPFTP.CONNECTION.LOCK (COND ((SETQ TCPFTPCON (for TCPFTPCON in CONNECTIONS thereis (NULL (fetch (TCPFTPCON BUSY?) of TCPFTPCON)))) (COND ((AND (SETQ INSTREAM (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (SETQ OUTSTREAM (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) (OPENP INSTREAM (QUOTE INPUT)) (OPENP OUTSTREAM (QUOTE OUTPUT)) (NOT (EOFP INSTREAM))) (while (READP INSTREAM) do (BIN INSTREAM)) (replace (TCPFTPCON BUSY?) of TCPFTPCON with T) TCPFTPCON) (T (\TCPFTP.DELETE.CONNECTION TCPFTPCON DEVICE) (\TCPFTP.OPEN.CONNECTION DEVICE)))) (T (\TCPFTP.OPEN.CONNECTION DEVICE)))))) ) (\TCPFTP.OPEN.CONNECTION (LAMBDA (DEVICE) (* ; "Edited 24-Apr-87 16:09 by FS") (LET* ((HOST (DODIP.HOSTP (fetch (FDEV DEVICENAME) of DEVICE))) (TCPFTPCON (create TCPFTPCON BUSY? _ T)) (INSTREAM (TCP.OPEN HOST \TCP.FTP.PORT NIL (QUOTE ACTIVE) (QUOTE INPUT) NIL (QUOTE (WHENCLOSEDFN \TCPFTP.CONTROL.CLOSED)))) (OUTSTREAM (COND (INSTREAM (TCP.OTHER.STREAM INSTREAM))))) (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (CON DEV) (COND (RESETSTATE (COND ((AND (EQ (\TCPFTP.GET.OSTYPE DEV) (QUOTE UNIX)) (READP (fetch (TCPFTPCON TCPIN) of CON))) (\TCPFTP.INPUT (fetch (TCPFTPCON TCPIN) of CON)))) (ARPACMD CON "QUIT" NIL (QUOTE (221 500))) (\TCPFTP.DELETE.CONNECTION CON DEV))))) TCPFTPCON DEVICE)) (COND (INSTREAM (replace (STREAM ENDOFSTREAMOP) of INSTREAM with (FUNCTION (LAMBDA (STREAM) (ZERO)))) (replace (STREAM DEVICE) of INSTREAM with DEVICE) (replace (STREAM DEVICE) of OUTSTREAM with DEVICE) (replace (TCPFTPCON TCPIN) of TCPFTPCON with INSTREAM) (replace (TCPFTPCON TCPOUT) of TCPFTPCON with OUTSTREAM) (SELECTQ (\TCPFTP.INPUT INSTREAM) (220 (COND (FTPDEBUGFLG (printout FTPDEBUGLOG T "< 220 ") (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)))) (\TCPFTP.LOGIN DEVICE TCPFTPCON) (push (fetch (FDEV DEVICEINFO) of DEVICE) TCPFTPCON) TCPFTPCON) (PROGN (\TCPFTP.DELETE.CONNECTION TCPFTPCON DEVICE) NIL))))))) ) (\TCPFTP.ASSURE.CLEANUP (LAMBDA NIL (* ejs%: "27-Apr-85 14:08") (* * Spawn a cleanup function if necessary) (COND ((AND (PROCESSP \TCPFTP.CLEANUP.PROCESS) (NOT (PROCESS.FINISHEDP \TCPFTP.CLEANUP.PROCESS)))) (T (SETQ \TCPFTP.CLEANUP.PROCESS (ADD.PROCESS (QUOTE (\TCPFTP.CLEANUP)) (QUOTE RESTARTABLE) (QUOTE NO)))))) ) (\TCPFTP.CLEANUP (LAMBDA NIL (* ejs%: "28-Jul-86 12:26") (DECLARE (GLOBALVARS \TCPFTP.IDLE.TIMEOUT \TCPFTP.DEVICES \TCPFTP.CONNECTION.LOCK)) (LET ((INTERVAL (QUOTIENT \TCPFTP.IDLE.TIMEOUT 4)) CONNECTIONSP) (repeatwhile (NOT (ZEROP CONNECTIONSP)) do (SETQ CONNECTIONSP 0) (for DEVICE in \TCPFTP.DEVICES do (for CONNECTION in (APPEND (fetch (FDEV DEVICEINFO) of DEVICE)) do (add CONNECTIONSP 1) (WITH.MONITOR \TCPFTP.CONNECTION.LOCK (NLSETQ (COND ((AND (NULL (fetch (TCPFTPCON BUSY?) of CONNECTION)) (TIMEREXPIRED? (fetch (TCPFTPCON IDLETIMER) of CONNECTION))) (CLOSEF? (fetch (TCPFTPCON TCPIN) of CONNECTION)) (CLOSEF? (fetch (TCPFTPCON TCPOUT) of CONNECTION)) (COND ((fetch (TCPFTPCON DATASTREAM) of CONNECTION) (CLOSEF? (fetch (TCPFTPCON DATASTREAM) of CONNECTION)))) (add CONNECTIONSP -1) (\TCPFTP.DELETE.CONNECTION CONNECTION DEVICE T)) ((OR (NOT (OPENP (fetch (TCPFTPCON TCPIN) of CONNECTION) (QUOTE INPUT))) (NEQ (QUOTE ESTABLISHED) (fetch (TCP.CONTROL.BLOCK TCB.STATE) of (fetch (TCPSTREAM TCB) of (fetch (TCPFTPCON TCPIN) of CONNECTION))))) (add CONNECTIONSP -1) (\TCPFTP.DELETE.CONNECTION CONNECTION DEVICE))))) (BLOCK))) (COND ((NOT (ZEROP CONNECTIONSP)) (BLOCK INTERVAL)))))) ) (\TCPFTP.RELEASE.CONNECTION (LAMBDA (TCPFTPCON) (* jmh "11-Oct-85 13:43") (COND (TCPFTPCON (replace (TCPFTPCON BUSY?) of TCPFTPCON with NIL) (replace (TCPFTPCON DATASTREAM) of TCPFTPCON with NIL) (replace (TCPFTPCON IDLETIMER) of TCPFTPCON with (SETUPTIMER \TCPFTP.IDLE.TIMEOUT)) (\TCPFTP.ASSURE.CLEANUP)))) ) (\TCPFTP.LOGIN (LAMBDA (DEVICE TCPFTPCON) (* ; "Edited 24-Apr-87 16:17 by FS") (* * Log us in) (PROG ((OSTYPE (\TCPFTP.GET.OSTYPE DEVICE)) (HOST (fetch (FDEV DEVICENAME) of DEVICE)) (LOGINRETRYCOUNT 0) INFO) RETRY (SETQ INFO (\INTERNAL/GETPASSWORD HOST)) (* * Loop through this label if the server rejected the our name) (COND ((OR (NULL INFO) (EQ 0 (NCHARS (CAR INFO))) (EQ 0 (NCHARS (CDR INFO)))) (* Need to login. Can't send Unix hosts a string of no chars as name or password!) (LOGIN HOST) (GO RETRY))) RETRY1 (* * Loop through this label if the server rejected something else) (SELECTQ (ARPACMD TCPFTPCON "USER" (COND ((AND (EQ OSTYPE (QUOTE UNIX)) (EQ (CAR INFO) (U-CASE (CAR INFO))) (EQ LOGINRETRYCOUNT 0)) (L-CASE (CAR INFO))) (T (CAR INFO))) (QUOTE (202 230 331 332 500 503 530))) ((230 202) (* We're logged in) (RETURN T)) (331 (* Needs a password) (SELECTQ (ARPACMD TCPFTPCON "PASS" (\DECRYPT.PWD (CDR INFO)) (QUOTE (230 331 332 530))) (230 (RETURN T)) (332 (SELECTQ (ARPACMD TCPFTPCON "ACCT" (PROMPTFORWORD (CONCAT "Account for logging into " HOST)) (QUOTE (230 202 530))) (230 (RETURN T)) (GO RETRY1))) ((331 530) (LOGIN HOST) (add LOGINRETRYCOUNT 1) (GO RETRY)) (FTPHELP))) (332 (SELECTQ (ARPACMD TCPFTPCON "ACCT" (PROMPTFORWORD (CONCAT "Account for logging into " HOST)) (QUOTE (230 202 530))) (230 (RETURN T)) (GO RETRY1))) (503 (COND ((EQ OSTYPE (QUOTE UNIX)) (* ;; "Well, the sequence of events to get here was probably that the D-machine sent an illegal name/password pair, such that the name was not a registered user on the Unix machine. There's a bug in the Unix FTP server which causes it to send a 530 error--illegal user name--immediately after it sent a 331 to prompt us for the password. This is blatantly in violation of the FTP specification, which states that only 100 class errors can have multiple responses. Now we're out of sync with the server, and need somehow to reinitialize our state") (\PEEKBIN (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (\TCPFTP.INPUT (fetch (TCPFTPCON TCPIN) of TCPFTPCON)))) (GO RETRY1)) ((500 530) (* No such user?) (LOGIN HOST) (add LOGINRETRYCOUNT 1) (GO RETRY)) (FTPHELP)))) ) (\TCPFTP.DELETEFILE (LAMBDA (NAME DEVICE) (* ejs%: " 7-Apr-86 11:52") (* * FTP delete request) (LET* ((TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE)) (OSTYPE (\TCPFTP.GET.OSTYPE DEVICE)) (CODE (CAR (NLSETQ (ARPACMD TCPFTPCON "DELE" (REPACKFILENAME.STRING (PACKFILENAME.STRING (QUOTE HOST) NIL (QUOTE BODY) NAME) OSTYPE) (QUOTE (200 226 250 450 550))))))) (\TCPFTP.RELEASE.CONNECTION TCPFTPCON) (SELECTQ CODE ((250 226 200) NAME) NIL))) ) (\TCPFTP.DIRECTORYNAMEP (LAMBDA (HOST/DIR DEVICE) (* ejs%: "27-Apr-85 14:04") (LET ((TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE))) (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (TCPFTPCON) (\TCPFTP.RELEASE.CONNECTION TCPFTPCON) (COND (RESETSTATE (AND (OPENP (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (CLOSEF (fetch (TCPFTPCON TCPIN) of TCPFTPCON))) (replace (TCPFTPCON TCPIN) of TCPFTPCON with NIL) (AND (OPENP (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) (CLOSEF (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))) (replace (TCPFTPCON TCPOUT) of TCPFTPCON with NIL))))) TCPFTPCON)) (\TCPFTP.CONNECT DEVICE TCPFTPCON (FILENAMEFIELD HOST/DIR (QUOTE DIRECTORY)))))) ) (\TCPFTP.ENDOFSTREAMOP (LAMBDA (STREAM SILENTLY) (* ejs%: " 3-Feb-85 17:01") (\TCPFTP.TRANSFER.COMPLETE STREAM) (OR SILENTLY (\EOSERROR STREAM))) ) (\TCPFTP.GENERATEFILES [LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS) (* ; "Edited 12-May-89 14:00 by welch") (* * FTP directory request) (LET* ((TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE)) (OSTYPE (\TCPFTP.GET.OSTYPE DEVICE)) DATASTREAMEVENT DATASTREAM CODE) (SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION TCPFTPCON 'INPUT)) (BLOCK) [SETQ CODE (CAR (NLSETQ (ARPACMD TCPFTPCON "NLST" [COND [(EQ OSTYPE 'UNIX) (COND ((AND (EQ (FILENAMEFIELD PATTERN 'VERSION) '*) (EQ (FILENAMEFIELD PATTERN 'EXTENSION) '*) (EQ (FILENAMEFIELD PATTERN 'NAME) '*)) (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'VERSION NIL 'EXTENSION NIL 'NAME "*" 'BODY PATTERN) 'UNIX)) ((EQ (FILENAMEFIELD PATTERN 'VERSION) '*) (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'VERSION NIL 'BODY PATTERN) 'UNIX)) (T (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'BODY PATTERN) 'UNIX] (T (COND ((EQ OSTYPE 'INTERLISP) (PACKFILENAME.STRING 'HOST NIL 'BODY PATTERN)) (T (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'BODY PATTERN) OSTYPE] 150] (SELECTQ CODE (150 (* * Here we go) (COND ((SETQ DATASTREAM (\TCPFTP.WAIT.FOR.DATACONNECTION DEVICE TCPFTPCON DATASTREAMEVENT 'INPUT)) (replace (TCPFTPCON GENERATEFILESDIRECTORY) of TCPFTPCON with (FILENAMEFIELD PATTERN 'DIRECTORY)) (create FILEGENOBJ NEXTFILEFN _ (FUNCTION \TCPFTP.GENERATENEXTFILE) FILEINFOFN _ (FUNCTION NILL) GENFILESTATE _ TCPFTPCON)) (T (ERROR "Couldn't open data connection to remote TCPFTP server")))) (PROGN (DEL.PROCESS (CAR DATASTREAMEVENT)) (\TCPFTP.RELEASE.CONNECTION TCPFTPCON) (\NULLFILEGENERATOR]) (\TCPFTP.GENERATENEXTFILE [LAMBDA (TCPFTPCON NAMEONLY) (* ; "Edited 8-Mar-89 22:54 by akw:") (PROG ((DATASTREAM (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON)) [OSTYPE (\TCPFTP.GET.OSTYPE (fetch (STREAM DEVICE) of (fetch (TCPFTPCON TCPIN) of TCPFTPCON] [FILENAMERDTBL (DEFERREDCONSTANT (PROG [(R (COPYREADTABLE 'ORIG] (SETBRK NIL NIL R) (SETSYNTAX '%% 'OTHER R) (SETSEPR '(13 10 31) NIL R) (RETURN R] CODE NAME) LOOP (RETURN (COND [[AND (OPENP DATASTREAM 'INPUT) (NOT (EOFP DATASTREAM)) (SETQ NAME (CAR (NLSETQ (READ DATASTREAM FILENAMERDTBL] (COND ((AND (OR (EQ OSTYPE 'TOPS-20) (EQ OSTYPE 'TOPS20)) (STRPOS "? Not found" NAME NIL NIL NIL NIL UPPERCASEARRAY)) (NLSETQ (until (EOFP DATASTREAM) do (READ DATASTREAM FILENAMERDTBL) )) (AND (OPENP DATASTREAM) (CLOSEF DATASTREAM)) (SELECTQ [SETQ CODE (ARPACMD TCPFTPCON NIL NIL '(226 250] ((250 226) (AND (OPENP DATASTREAM) (CLOSEF DATASTREAM)) (\TCPFTP.RELEASE.CONNECTION TCPFTPCON) NIL) (FTPHELP CODE))) ((AND (EQ OSTYPE 'UNIX) (STREQUAL ":" (SUBSTRING NAME -1))) (replace (TCPFTPCON GENERATEFILESDIRECTORY) of TCPFTPCON with (REPACKFILENAME.STRING (SUBSTRING NAME 1 -2) 'INTERLISP)) (GO LOOP)) (NAMEONLY (REPACKFILENAME.STRING NAME 'INTERLISP)) (T (if (STRPOS "*" (fetch (TCPFTPCON GENERATEFILESDIRECTORY) of TCPFTPCON)) then (PACKFILENAME.STRING 'HOST (fetch (FDEV DEVICENAME) of (fetch (STREAM DEVICE) of (fetch (TCPFTPCON TCPIN) of TCPFTPCON) )) 'BODY (REPACKFILENAME.STRING NAME 'INTERLISP)) else (PACKFILENAME.STRING 'HOST (fetch (FDEV DEVICENAME) of (fetch (STREAM DEVICE) of (fetch (TCPFTPCON TCPIN) of TCPFTPCON))) 'DIRECTORY (fetch (TCPFTPCON GENERATEFILESDIRECTORY) of TCPFTPCON) 'BODY (REPACKFILENAME.STRING NAME 'INTERLISP] (T (AND (OPENP DATASTREAM) (CLOSEF DATASTREAM)) (SELECTQ [SETQ CODE (ARPACMD TCPFTPCON NIL NIL '(226 250] ((250 226) (AND (OPENP DATASTREAM) (CLOSEF DATASTREAM)) (\TCPFTP.RELEASE.CONNECTION TCPFTPCON) NIL) (FTPHELP CODE]) (\TCPFTP.GETFILENAME [LAMBDA (NAME RECOG DEVICE) (* ; "Edited 12-May-89 13:35 by welch") (* * FTP directory request) (COND ((EQ RECOG 'NEW) NAME) (T (PROG ((TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE)) (OSTYPE (\TCPFTP.GET.OSTYPE DEVICE)) DATASTREAMEVENT DATASTREAM CODE GENERATOR ALLPOSSIBILITIES) (SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION TCPFTPCON 'INPUT)) (BLOCK) [SETQ CODE (CAR (NLSETQ (ARPACMD TCPFTPCON "NLST" (COND ((EQ OSTYPE 'INTERLISP) (PACKFILENAME.STRING 'HOST NIL 'BODY NAME)) (T (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'BODY NAME) OSTYPE))) 150] (RETURN (SELECTQ CODE (150 (* * Here we go) (COND ((AND (SETQ DATASTREAM (\TCPFTP.WAIT.FOR.DATACONNECTION DEVICE TCPFTPCON DATASTREAMEVENT 'INPUT)) (SETQ GENERATOR (create FILEGENOBJ NEXTFILEFN _ (FUNCTION \TCPFTP.GENERATENEXTFILE ) FILEINFOFN _ (FUNCTION NILL) GENFILESTATE _ TCPFTPCON))) (replace (TCPFTPCON GENERATEFILESDIRECTORY) of TCPFTPCON with (FILENAMEFIELD NAME 'DIRECTORY)) (SETQ ALLPOSSIBILITIES (bind FILE while (SETQ FILE ( \GENERATENEXTFILE GENERATOR)) collect FILE)) (MKATOM (CAR ALLPOSSIBILITIES))) (T (ERROR "Couldn't open data connection to remote TCPFTP server." )))) (PROGN (DEL.PROCESS (CAR DATASTREAMEVENT)) (\TCPFTP.RELEASE.CONNECTION TCPFTPCON) NIL]) (\TCPFTP.GETFILEINFO (LAMBDA (STREAM ATTRIB DEVICE) (* ejs%: "20-Mar-86 21:01") (COND ((type? STREAM STREAM) (STREAMPROP STREAM ATTRIB)) ((EQ ATTRIB (QUOTE EOL)) (QUOTE CRLF)))) ) (\TCPFTP.SETFILEINFO (LAMBDA (STREAM ATTRIB VALUE DEVICE) (* ejs%: " 9-Nov-85 14:20") (STREAMPROP STREAM ATTRIB VALUE))) (\TCPFTP.RENAMEFILE (LAMBDA (OLDDEVICE OLDNAME NEWDEVICE NEWNAME) (* ; "Edited 15-Jun-88 13:41 by atm") (* * FTP delete request) (COND ((NEQ OLDDEVICE NEWDEVICE) (\GENERIC.RENAMEFILE OLDDEVICE OLDNAME NEWDEVICE NEWNAME)) (T (LET ((OSTYPE (\TCPFTP.GET.OSTYPE OLDDEVICE)) (TCPFTPCON (\GET.TCPFTP.CONNECTION OLDDEVICE)) CODE) (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (CON) (\TCPFTP.RELEASE.CONNECTION CON))) TCPFTPCON)) (PROG NIL RETRY (SETQ CODE (CAR (NLSETQ (ARPACMD TCPFTPCON "RNFR" (REPACKFILENAME.STRING (PACKFILENAME.STRING (QUOTE HOST) NIL (QUOTE BODY) OLDNAME) OSTYPE) (QUOTE (350 450 550)))))) (SELECTQ CODE (350 (SETQ CODE (CAR (NLSETQ (ARPACMD TCPFTPCON "RNTO" (REPACKFILENAME.STRING (PACKFILENAME.STRING (QUOTE HOST) NIL (QUOTE BODY) NEWNAME) OSTYPE) (QUOTE (200 250 553)))))) (SELECTQ CODE ((200 250) (RETURN NEWNAME)) NIL)) (PROGN (SETQ OLDNAME (LISPERROR "FILE NOT FOUND" OLDNAME T)) (GO RETRY))))))))) ) (\TCPFTP.CONNECT (LAMBDA (DEVICE TCPFTPCON DIRECTORY) (* ejs%: "24-Jun-85 17:10") (LET ((DIRECTORYNAME (REPACKFILENAME.STRING (PACKFILENAME.STRING (QUOTE DIRECTORY) DIRECTORY) (\TCPFTP.GET.OSTYPE DEVICE)))) (COND ((NEQ 0 (NCHARS DIRECTORYNAME)) (SELECTQ (ARPACMD TCPFTPCON "CWD" DIRECTORYNAME (QUOTE (200 250 450 550))) ((200 250) T) NIL)) (T (* The user specified no connect directory. We'll have to assume he or she meant his or her own login directory, whose name we can't even accurately guess. Thus, we leave it at this) T)))) ) (\TCPFTP.OPENFILE [LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* ; "Edited 22-Mar-89 22:31 by welch") (DECLARE (GLOBALVARS TCP.DEFAULTFILETYPE TCP.USE.STANDARD.EOL TCPFTP.EOL.CONVENTION TCPFTP.DEFAULT.FILETYPES)) (LET* ((HOST (fetch (FDEV DEVICENAME) of DEVICE)) (OSTYPE (\TCPFTP.GET.OSTYPE DEVICE)) [FILENAME (COND ((EQ OSTYPE 'INTERLISP) (PACKFILENAME.STRING 'HOST NIL 'BODY NAME)) (T (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'BODY NAME) OSTYPE] (FILENAME.EXTENSION (FILENAMEFIELD FILENAME 'EXTENSION)) (TCPFTPCON (\GET.TCPFTP.CONNECTION DEVICE)) (TYPE (OR (CADR (FASSOC 'TYPE PARAMETERS)) (CDR (FASSOC FILENAME.EXTENSION TCPFTP.DEFAULT.FILETYPES)) (CDR (FASSOC (U-CASE FILENAME.EXTENSION) TCPFTP.DEFAULT.FILETYPES)) TCP.DEFAULTFILETYPE)) DATASTREAMEVENT DATASTREAM CODE FTPCMD STREAMDEV) (SELECTQ TYPE (TEXT (ARPACMD TCPFTPCON "TYPE" "A N" 200)) (ARPACMD TCPFTPCON "TYPE" "L 8" 200)) (SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION TCPFTPCON (COND ((EQ ACCESS 'OUTPUT) 'APPEND) (T ACCESS)) T)) (BLOCK) (PROG NIL LOOP (SETQ FTPCMD (SELECTQ ACCESS (INPUT '"RETR") (OUTPUT '"STOR") (APPEND '"APPE") (ERROR "ACCESS must be one of INPUT, OUTPUT, or APPEND" ACCESS))) [SETQ CODE (CAR (NLSETQ (ARPACMD TCPFTPCON FTPCMD FILENAME '(125 150 226 250 425 426 450 451 550] (SELECTQ CODE ((125 150) (* * Here we go) (COND ([SETQ DATASTREAM (\TCPFTP.WAIT.FOR.DATACONNECTION DEVICE TCPFTPCON DATASTREAMEVENT (COND ((EQ ACCESS 'OUTPUT) 'APPEND) (T ACCESS] (replace (STREAM ENDOFSTREAMOP) of DATASTREAM with (FUNCTION \TCPFTP.ENDOFSTREAMOP)) (replace (STREAM FULLFILENAME) of DATASTREAM with NAME) [replace (STREAM EOLCONVENTION) of DATASTREAM with (COND (TCP.USE.STANDARD.EOL CRLF.EOLC) (T (OR TCPFTP.EOL.CONVENTION (SELECTQ OSTYPE (UNIX LF.EOLC) (TOPS-20 CRLF.EOLC) CR.EOLC] (STREAMPROP DATASTREAM 'TYPE TYPE) (replace (TCPDATASTREAM TCPFTPCON) of DATASTREAM with TCPFTPCON ) (SETQ STREAMDEV (fetch (STREAM DEVICE) of DATASTREAM)) (replace (FDEV GETFILENAME) of STREAMDEV with (FUNCTION NILL)) (replace (FDEV GETFILEINFO) of STREAMDEV with (FUNCTION \TCPFTP.GETFILEINFO)) (STREAMADDPROP DATASTREAM 'AFTERCLOSE (FUNCTION \TCPFTP.TRANSFER.COMPLETE)) (STREAMADDPROP DATASTREAM 'BEFORECLOSE (FUNCTION \TCPFTP.READ.UNTIL.EOF) ) (RETURN DATASTREAM)) (T (ERROR "Couldn't open data connection to remote TCPFTP server")))) (425 (* The foreign port is busy) (PROMPTPRINT "TCPFTP: Please wait; the remote ftp server is busy.") (DEL.PROCESS (CAR DATASTREAMEVENT)) (DISMISS 5000) [SETQ DATASTREAMEVENT (\TCPFTP.SPAWN.DATACONNECTION TCPFTPCON (COND ((EQ ACCESS 'OUTPUT) 'APPEND) (T ACCESS] (BLOCK) (GO LOOP)) ((450 550) (DEL.PROCESS (CAR DATASTREAMEVENT)) (\TCPFTP.RELEASE.CONNECTION TCPFTPCON) NIL) (FTPHELP CODE]) (\TCPFTP.CLOSE (LAMBDA (DEVICE) (* ejs%: "23-Apr-85 18:41") (* * This needs work) (PROG ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))) (AND (OPENP (fetch (TCPFTPCON TCPOUT) of DEVINFO) (QUOTE OUTPUT)) (CLOSEF (fetch (TCPFTPCON TCPOUT) of DEVINFO))) (AND (OPENP (fetch (TCPFTPCON TCPIN) of DEVINFO) (QUOTE INPUT)) (CLOSEF (fetch (TCPFTPCON TCPIN) of DEVINFO))))) ) (\TCPFTP.FLUSH (LAMBDA (DEVICE) (* ejs%: "23-Apr-85 18:56") (* * This needs work) (PROG ((INSTREAM (fetch (TCPFTPCON TCPIN) of (fetch (FDEV DEVICEINFO) of DEVICE)))) (COND ((READP INSTREAM) (until (NOT (READP INSTREAM)) do (BIN INSTREAM)))))) ) (\TCPFTP.INIT (LAMBDA NIL (* ejs%: "10-Apr-85 19:25") (\DEFINEDEVICE NIL (create FDEV DEVICENAME _ (QUOTE TCPFTP) HOSTNAMEP _ (FUNCTION \TCPFTP.HOSTNAMEP) EVENTFN _ (FUNCTION \TCPFTP.EVENTFN)))) ) (SET.TCP.EOL.CONVENTION [LAMBDA (EOLTYPE) (* ; "Edited 22-Mar-89 22:31 by welch") (* ; "Sets the EOL convention to use") (DECLARE (GLOBALVARS TCP.USE.STANDARD.EOL TCPFTP.EOL.CONVENTION)) (SELECTQ EOLTYPE (CR (SETQ TCP.USE.STANDARD.EOL NIL) (SETQ TCPFTP.EOL.CONVENTION CR.EOLC)) (LF (SETQ TCP.USE.STANDARD.EOL NIL) (SETQ TCPFTP.EOL.CONVENTION LF.EOLC)) (CRLF (SETQ TCP.USE.STANDARD.EOL NIL) (SETQ TCPFTP.EOL.CONVENTION CRLF.EOLC)) (OS (SETQ TCP.USE.STANDARD.EOL NIL) (SETQ TCPFTP.EOL.CONVENTION NIL)) (SETQ TCP.USE.STANDARD.EOL T]) ) (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (ACCESSFNS TCPDATASTREAM ((TCPCONTROLDEVICE (fetch (STREAM F3) of DATUM) (replace (STREAM F3) of DATUM with NEWVALUE)) (SEENEOS (fetch (STREAM F4) of DATUM) (replace (STREAM F4) of DATUM with NEWVALUE)) (TCPFTPCON (fetch (STREAM F5) of DATUM) (replace (STREAM F5) of DATUM with NEWVALUE)))) (RECORD TCPFTPCON (TCPIN TCPOUT DATASTREAM BUSY? IDLETIMER GENERATEFILESDIRECTORY)) ) (* "END EXPORTED DEFINITIONS") ) (ADDTOVAR TCPFTP.DEFAULT.FILETYPES (NIL . TEXT) (DFASL . BINARY) (dfasl . BINARY) (LCOM . BINARY) (lcom . BINARY) (DCOM . BINARY) (dcom . BINARY) (LISP . TEXT) (lisp . TEXT) (LSP . TEXT) (lsp . TEXT) (RST . BINARY) (rst . BINARY) (BIN . BINARY) (bin . BINARY)) (RPAQ? TCP.DEFAULTFILETYPE 'BINARY) (RPAQ? TCP.USE.STANDARD.EOL T) (RPAQ? \TCPFTP.DEVICES ) (RPAQ? \TCPFTP.CLEANUP.PROCESS ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \TCPFTP.DEVICES \TCPFTP.CLEANUP.PROCESS TCP.DEFAULTFILETYPE TCP.USE.STANDARD.EOL) ) (* ;; "Data connection handling") (DEFINEQ (\TCP.BYE (LAMBDA (HOST) (* ejs%: "15-Nov-86 15:05") (LET* ((DEVICE (\GETDEVICEFROMNAME HOST NIL T)) (CONNECTIONS (AND DEVICE (fetch (FDEV DEVICEINFO) of DEVICE)))) (bind INSTREAM for TCPFTPCON in CONNECTIONS do (SETQ INSTREAM (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (while (AND (OPENP INSTREAM (QUOTE INPUT)) (READP INSTREAM)) do (BIN INSTREAM)) (NLSETQ (ARPACMD TCPFTPCON "QUIT" NIL (QUOTE (221 500)))) (CLOSEF? (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON)) (CLOSEF? INSTREAM) (CLOSEF? (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) T) (replace (FDEV DEVICEINFO) of DEVICE with NIL))) ) (\TCPFTP.MAYBE.ABORT [LAMBDA (DATASTREAM) (* ; "Edited 18-Mar-89 13:43 by welch") (LET* ((TCPFTPCON (fetch (TCPDATASTREAM TCPFTPCON) of DATASTREAM)) (TCPOUTSTREAM (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))) (STREAMPROP DATASTREAM 'BEFORECLOSE NIL) (COND ((AND (NOT (fetch (TCPDATASTREAM SEENEOS) of DATASTREAM)) (OPENP DATASTREAM 'INPUT)) (TCP.CLOSE.SENDER (TCP.OTHER.STREAM DATASTREAM)) (BLOCK) (BOUT TCPOUTSTREAM 244) (BOUT TCPOUTSTREAM 242) (TCP.URGENT.MARK TCPOUTSTREAM) (ARPACMD TCPFTPCON "ABOR" NIL '(226 426 250]) (\TCPFTP.DATA.CLOSED (LAMBDA (INSTREAM OUTSTREAM) (* ejs%: "28-Jul-86 14:03") (LET* ((STREAM (OR INSTREAM OUTSTREAM))) (replace (STREAM ACCESS) of STREAM with NIL))) ) (\TCPFTP.OPEN.DATA.CONNECTION (LAMBDA (TCPFTPCON ACCESS EVENT FOR.FILE.TRANSFER) (* ejs%: "26-Sep-86 18:27") (DECLARE (GLOBALVARS \TCPFTP.DATACONNECTION.LOCK)) (* * Tell the FTP control connection on what port we're expecting the data connection to made, and try up to five times to accept a connection. Each time, select a new port (this hopefully a workaround to a Unix bug in which ports sometimes tend to appear busy for 2 minute timeout intervals)) (WITH.MONITOR \TCPFTP.DATACONNECTION.LOCK (bind PORT STREAM for I from 1 to 5 do (SETQ PORT (\TCP.SELECT.PORT)) (ARPACMD TCPFTPCON "PORT" (\TCPFTP.PORT.STRING PORT) (QUOTE (200))) (SETQ STREAM (TCP.OPEN NIL NIL PORT (QUOTE PASSIVE) ACCESS NIL (COND (FOR.FILE.TRANSFER (CONSTANT (BQUOTE (MAXSEG %, BYTESPERPAGE WHENCLOSEDFN \TCPFTP.DATA.CLOSED))))))) (COND (STREAM (replace (TCPFTPCON DATASTREAM) of TCPFTPCON with STREAM) (RETURN))) finally (* * We give up. Place a NIL in the datastream field so the client who was trying to accept the data connection will realize we couldn't succeed) (replace (TCPFTPCON DATASTREAM) of TCPFTPCON with NIL)) (AND (TYPENAMEP EVENT (QUOTE EVENT)) (NOTIFY.EVENT EVENT)) (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON))) ) (\TCPFTP.PORT.STRING (LAMBDA (PORT) (* ejs%: "26-Apr-85 11:54") (* * Returns "h1,h2,h3,h4,p1,p3" corresponding to bytes of local IP host and PORT for port command) (LET ((IPADDRESS (\LOCAL.IP.ADDRESS))) (CONCAT (LOADBYTE IPADDRESS 24 8) "," (LOADBYTE IPADDRESS 16 8) "," (LOADBYTE IPADDRESS 8 8) "," (LOADBYTE IPADDRESS 0 8) "," (LOADBYTE PORT 8 8) "," (LOADBYTE PORT 0 8)))) ) (\TCPFTP.SPAWN.DATACONNECTION (LAMBDA (TCPFTPCON ACCESS FOR.FILE.TRANSFER) (* ejs%: "26-Sep-86 19:21") (* * Called from TCPFTP device methods like \TCPFTP.OPENFILE. Spawns a process to wait for the server program to open a data connection to us. Returns a CONS consisting of the spawned process handle and an event which will be notified when the server has connected to us. This function MUST be called prior to any TCPFTP operations which would cause the server to try to open a data connection to us (otherwise, the server might try to open the connection before we're prepared to accept it)) (LET* ((EVENT (CREATE.EVENT)) (PROCESS (ADD.PROCESS (BQUOTE (\TCPFTP.OPEN.DATA.CONNECTION (QUOTE %, TCPFTPCON) (QUOTE %, ACCESS) %, EVENT %, FOR.FILE.TRANSFER))))) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (PROCESS INSTREAM OUTSTREAM) (DEL.PROCESS PROCESS) (* CLOSEF? INSTREAM) (* CLOSEF? OUTSTREAM) NIL)) PROCESS (fetch (TCPFTPCON TCPIN) of TCPFTPCON) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))) (CONS PROCESS EVENT))) ) (\TCPFTP.READ.UNTIL.EOF [LAMBDA (DATASTREAM) (* ; "Edited 20-Jun-89 19:41 by welch") (* ;;; "This function is used to avoid possible deadlock in the case where the stream is opened and closed immediately. ") (PROG ((TCB (fetch (TCPSTREAM TCB) of DATASTREAM)) (TCPFTPCON (fetch (TCPDATASTREAM TCPFTPCON) of DATASTREAM))) (WITH.MONITOR \TCPFTP.DATACONNECTION.LOCK (if (NOT (EOFP DATASTREAM)) then (while (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB)) do (\TCP.GET.SEGMENT DATASTREAM)) (* ;; "read to the end of the file.") (while (NOT (EOFP DATASTREAM)) do (BIN DATASTREAM))))]) (\TCPFTP.TRANSFER.COMPLETE [LAMBDA (DATASTREAM) (* ; "Edited 24-May-89 14:12 by welch") (LET ((TCPFTPCON (fetch (TCPDATASTREAM TCPFTPCON) of DATASTREAM))) (STREAMPROP DATASTREAM 'AFTERCLOSE NIL) (COND ((AND TCPFTPCON (NOT (fetch (TCPDATASTREAM SEENEOS) of DATASTREAM))) [COND ((OPENP DATASTREAM 'INPUT) (TCP.CLOSE.SENDER (TCP.OTHER.STREAM DATASTREAM] (replace (TCPDATASTREAM SEENEOS) of DATASTREAM with T) (replace (TCPDATASTREAM TCPCONTROLDEVICE) of DATASTREAM with NIL) (replace (TCPDATASTREAM TCPFTPCON) of DATASTREAM with NIL) (\TCPFTP.RELEASE.CONNECTION TCPFTPCON]) (\TCPFTP.WAIT.FOR.DATACONNECTION (LAMBDA (DEVICE TCPFTPCON PROCESS.AND.EVENT ACCESS) (* ejs%: "26-Sep-86 18:30") (* * EVENT is a cons of PROCESS and a real event. PROCESS is the process trying to open the connection; EVENT is an event which is notified when the process succeeds or fails to open the connection to the server) (LET (STREAM) (AWAIT.EVENT (CDR PROCESS.AND.EVENT) 120000) (COND ((NULL (SETQ STREAM (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON))) (* * A NIL in this field means the local client code was unable to open the connection to the server program.) NIL) ((OPENP STREAM ACCESS) (replace (TCPDATASTREAM TCPCONTROLDEVICE) of STREAM with DEVICE) STREAM)))) ) (\TCPFTP.DELETE.CONNECTION (LAMBDA (TCPFTPCON DEVICE SENDBYE) (* ejs%: "15-Nov-86 15:09") (LET ((INSTREAM (fetch (TCPFTPCON TCPIN) of TCPFTPCON))) (COND (SENDBYE (NLSETQ (ARPACMD TCPFTPCON "BYE" NIL (QUOTE (221 500)))))) (COND (INSTREAM (DEL.PROCESS (fetch (TCP.CONTROL.BLOCK TCB.PROCESS) of (fetch (TCPSTREAM TCB) of INSTREAM))))) (replace (FDEV DEVICEINFO) of DEVICE with (DREMOVE TCPFTPCON (fetch (FDEV DEVICEINFO) of DEVICE))))) ) ) (RPAQ? \TCPFTP.DATACONNECTION.LOCK (CREATE.MONITORLOCK "TCPFTP Data Connection Lock")) (RPAQ? \TCPFTP.CONNECTION.LOCK (CREATE.MONITORLOCK "TCPFTP Connection Lock")) (RPAQ? \TCPFTP.IDLE.TIMEOUT (TIMES 10 60 1000)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \TCPFTP.DATACONNECTION.LOCK \TCPFTP.CONNECTION.LOCK \TCPFTP.IDLE.TIMEOUT) ) (FILESLOAD (SYSLOAD) TCPNAMES TCP) (\TCPFTP.INIT) (RPAQQ TCPFTP.DEFAULT.FILETYPES ((NIL . TEXT) (DFASL . BINARY) (dfasl . BINARY) (LCOM . BINARY) (lcom . BINARY) (DCOM . BINARY) (dcom . BINARY) (LISP . TEXT) (lisp . TEXT) (LSP . TEXT) (lsp . TEXT) (RST . BINARY) (rst . BINARY) (BIN . BINARY) (bin . BINARY) (TXT . TEXT) (txt . TEXT) (TEXT . TEXT) (text . TEXT) (c . TEXT) (h . TEXT) (o . BINARY) (TEDIT . BINARY) (tedit . BINARY) (DISPLAYFONT . BINARY) (WD . BINARY))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (PUTPROPS TCPFTP COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1900 1987 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (4143 7185 (ARPACMD 4153 . 5446) (FTPHELP 5448 . 5565) (CMDREADCODE 5567 . 5671) ( CMDREAD 5673 . 5800) (DISCARDLINE 5802 . 6196) (GETLINE 6198 . 6484) (\TCPFTP.INPUT 6486 . 7041) ( TELNET.EOL 7043 . 7183)) (7526 40072 (\TCPFTP.CONTROL.CLOSED 7536 . 8004) (\TCPFTP.GET.OSTYPE 8006 . 8252) (\TCPFTP.EVENTFN 8254 . 8834) (\TCPFTP.HOSTNAMEP 8836 . 11823) (\GET.TCPFTP.CONNECTION 11825 . 12570) (\TCPFTP.OPEN.CONNECTION 12572 . 13893) (\TCPFTP.ASSURE.CLEANUP 13895 . 14215) (\TCPFTP.CLEANUP 14217 . 15408) (\TCPFTP.RELEASE.CONNECTION 15410 . 15723) (\TCPFTP.LOGIN 15725 . 17870) ( \TCPFTP.DELETEFILE 17872 . 18309) (\TCPFTP.DIRECTORYNAMEP 18311 . 18965) (\TCPFTP.ENDOFSTREAMOP 18967 . 19118) (\TCPFTP.GENERATEFILES 19120 . 22881) (\TCPFTP.GENERATENEXTFILE 22883 . 27772) ( \TCPFTP.GETFILENAME 27774 . 30946) (\TCPFTP.GETFILEINFO 30948 . 31131) (\TCPFTP.SETFILEINFO 31133 . 31257) (\TCPFTP.RENAMEFILE 31259 . 32187) (\TCPFTP.CONNECT 32189 . 32726) (\TCPFTP.OPENFILE 32728 . 38498) (\TCPFTP.CLOSE 38500 . 38868) (\TCPFTP.FLUSH 38870 . 39118) (\TCPFTP.INIT 39120 . 39320) ( SET.TCP.EOL.CONVENTION 39322 . 40070)) (41953 48826 (\TCP.BYE 41963 . 42548) (\TCPFTP.MAYBE.ABORT 42550 . 43295) (\TCPFTP.DATA.CLOSED 43297 . 43468) (\TCPFTP.OPEN.DATA.CONNECTION 43470 . 44677) ( \TCPFTP.PORT.STRING 44679 . 45060) (\TCPFTP.SPAWN.DATACONNECTION 45062 . 46078) ( \TCPFTP.READ.UNTIL.EOF 46080 . 46897) (\TCPFTP.TRANSFER.COMPLETE 46899 . 47705) ( \TCPFTP.WAIT.FOR.DATACONNECTION 47707 . 48384) (\TCPFTP.DELETE.CONNECTION 48386 . 48824))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPFTPSRV b/obsolete/tcp/TCPFTPSRV new file mode 100644 index 00000000..1e95bbcd --- /dev/null +++ b/obsolete/tcp/TCPFTPSRV @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "13-Sep-90 15:07:59" {DSK}TCP>TCPFTPSRV.;6 55339 changes to%: (FNS TCPFTP.SERVER.MERGE.PATHNAMES TCPFTP.SERVER.PATH TCPFTP.SERVER.LIST TCPFTP.SERVER.RETRIEVE) previous date%: "11-Sep-90 13:34:33" {DSK}TCP>TCPFTPSRV.;5) (* ; " Copyright (c) 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPFTPSRVCOMS) (RPAQQ TCPFTPSRVCOMS ((FNS TCPFTP.SERVER TCPFTP.SERVER.ABORTED TCPFTP.SERVER.ACCOUNT TCPFTP.SERVER.APPEND TCPFTP.SERVER.CLOSE.DATA.CONNECTION TCPFTP.SERVER.COMMAND.LOOP TCPFTP.SERVER.CONNECTED.INFO TCPFTP.SERVER.DELETE TCPFTP.SERVER.DIRECTORY TCPFTP.SERVER.EXIT TCPFTP.SERVER.IDLE.INFO TCPFTP.SERVER.LIST TCPFTP.SERVER.MERGE.PATHNAMES TCPFTP.SERVER.MODE TCPFTP.SERVER.OPEN.DATA.CONNECTION TCPFTP.SERVER.PARSE.PORT TCPFTP.SERVER.PASSWORD TCPFTP.SERVER.PATH TCPFTP.SERVER.PORT TCPFTP.SERVER.PROCESS TCPFTP.SERVER.RENAME.FROM TCPFTP.SERVER.RENAME.TO TCPFTP.SERVER.RESPONSE TCPFTP.SERVER.RETRIEVE TCPFTP.SERVER.RETURN.FILE TCPFTP.SERVER.STORE TCPFTP.SERVER.STRUCTURE TCPFTP.SERVER.TYPE TCPFTP.SERVER.USER TCPFTP.SERVER.VERBOSE.LIST TCPFTP.SERVER.WAIT.FOR.IDLE TCPFTP.UNIX.LS.DATE) (INITVARS (TCPFTP.SERVER.HERALD.STRING "Venue Medley FTP Service 1.0 at your service") (TCPFTP.SERVER.USE.TOPS20.SYNTAX NIL) (TCPFTP.SERVER.RETRYCOUNT 5)) (GLOBALVARS TCPFTP.SERVER.HERALD.STRING TCPFTP.SERVER.USE.TOPS20.SYNTAX TCPFTP.SERVER.RETRYCOUNT) (FILES (SYSLOAD) TCPFTP))) (DEFINEQ (TCPFTP.SERVER [LAMBDA (PORT DEFAULT.FILE.PATH) (* ; "Edited 24-Aug-87 17:57 by scp") (* * This is the TCP-based FTP server top-level) (ADD.PROCESS `(TCPFTP.SERVER.PROCESS ,PORT ,DEFAULT.FILE.PATH) 'RESTARTABLE 'HARDRESET]) (TCPFTP.SERVER.ABORTED [LAMBDA (INSTREAM OUTSTREAM) (* ejs%: "20-Mar-86 19:53") (TCPFTP.SERVER.EXIT INSTREAM OUTSTREAM]) (TCPFTP.SERVER.ACCOUNT [LAMBDA (TCPFTPCON RDTBL) (* edited%: "21-Mar-86 11:40") (* * This function parses USER commands) (LET ((ACCT (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL))) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG ACCT T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (TCPFTP.SERVER.RESPONSE 230 "You sure are formal!" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.APPEND [LAMBDA (TCPFTPCON RDTBL USERPORT TYPE DEFAULT.PATH) (* ejs%: "24-Mar-86 14:07") (* * This function parses USER commands) (LET* [(FILENAME (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (PACKED.FILENAME (TCPFTP.SERVER.MERGE.PATHNAMES FILENAME DEFAULT.PATH T)) (TRUENAME (CAR (NLSETQ (OR (INFILEP PACKED.FILENAME) (OUTFILEP PACKED.FILENAME] (COND (FTPDEBUGFLG (printout FTPDEBUGLOG FILENAME T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (COND [TRUENAME (LET [(FILESTREAM (CAR (NLSETQ (OPENSTREAM TRUENAME 'APPEND NIL `((TYPE %, TYPE] (COND [FILESTREAM (TCPFTP.SERVER.RESPONSE 150 (CONCAT "Opening data connection for append to " (FULLNAME FILESTREAM)) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) (LET ((DATASTREAM (TCPFTP.SERVER.OPEN.DATA.CONNECTION TCPFTPCON USERPORT T ))) (COND (DATASTREAM [replace (STREAM ENDOFSTREAMOP) of DATASTREAM with (FUNCTION (LAMBDA (STREAM) (ERROR!] (RESETLST (RESETSAVE (COND ((EQ TYPE 'BINARY) (COPYBYTES DATASTREAM FILESTREAM)) (T (COPYCHARS DATASTREAM FILESTREAM ))) (LIST [FUNCTION (LAMBDA (FILESTREAM TCPFTPCON) (CLOSEF? FILESTREAM) (  TCPFTP.SERVER.CLOSE.DATA.CONNECTION TCPFTPCON) (TCPFTP.SERVER.RESPONSE 226 "Data transfer complete" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON] FILESTREAM TCPFTPCON] (T (TCPFTP.SERVER.RESPONSE 450 (CONCAT "Couldn't open file " TRUENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON] (T (TCPFTP.SERVER.RESPONSE 550 (CONCAT "Unable to create output filename - " PACKED.FILENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.CLOSE.DATA.CONNECTION [LAMBDA (TCPFTPCON) (* ejs%: "20-Mar-86 17:53") (LET ((DATASTREAM (fetch (TCPFTPCON DATASTREAM) of TCPFTPCON)) (EVENT (fetch (TCPFTPCON BUSY?) of TCPFTPCON))) (CLOSEF? DATASTREAM) (replace (TCPFTPCON DATASTREAM) of TCPFTPCON with NIL) (replace (TCPFTPCON BUSY?) of TCPFTPCON with NIL) (NOTIFY.EVENT EVENT) T]) (TCPFTP.SERVER.COMMAND.LOOP [LAMBDA (CONTROL.INPUT.STREAM CONTROL.OUTPUT.STREAM PATH) (* ; "Edited 31-Aug-90 17:15 by gadener") (DECLARE (SPECVARS TCPFTPCON COMMAND)) (LET ([COMMAND.RDTBL (DEFERREDCONSTANT (PROG [(R (COPYREADTABLE 'ORIG] (SETBRK NIL NIL R) (SETSYNTAX '%% 'OTHER R) (SETSEPR '(13 10 31 32) NIL R) (RETURN R] (TCPFTPCON (create TCPFTPCON TCPIN _ CONTROL.INPUT.STREAM TCPOUT _ CONTROL.OUTPUT.STREAM)) (TYPE TCP.DEFAULTFILETYPE) RENAME.FROM.FILE LAST.COMMAND USERPORT) (OR PATH (SETQ PATH "{DSK}")) (while (AND (OPENP CONTROL.INPUT.STREAM 'INPUT) (OPENP CONTROL.OUTPUT.STREAM 'OUTPUT) (NOT (EOFP CONTROL.INPUT.STREAM))) first [PROCESSPROP (THIS.PROCESS) 'NAME (CONCAT "FTP#" (\IP.ADDRESS.TO.STRING (fetch (TCP.CONTROL.BLOCK TCB.DST.HOST) of (fetch (TCPSTREAM TCB) of CONTROL.INPUT.STREAM ] do (LET [(COMMAND (U-CASE (CAR (NLSETQ (READ CONTROL.INPUT.STREAM COMMAND.RDTBL] [COND ((AND (OPENP CONTROL.INPUT.STREAM 'INPUT) (NOT (EOFP CONTROL.INPUT.STREAM))) (COND ([NOT (FMEMB COMMAND '(QUIT REIN ABOR NOOP NIL] (BIN CONTROL.INPUT.STREAM] (* Advance past the space preceding  the argument) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG T "> " COMMAND " "))) (SELECTQ COMMAND (USER (TCPFTP.SERVER.USER TCPFTPCON COMMAND.RDTBL)) (PASS (TCPFTP.SERVER.PASSWORD TCPFTPCON COMMAND.RDTBL)) (ACCT (TCPFTP.SERVER.ACCOUNT TCPFTPCON COMMAND.RDTBL)) (CWD (SETQ PATH (OR (TCPFTP.SERVER.PATH TCPFTPCON COMMAND.RDTBL PATH) PATH))) (PWD (TCPFTP.SERVER.RESPONSE 250 (CONCAT "Default pathname is " PATH) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))) (PORT (SETQ USERPORT (OR (TCPFTP.SERVER.PORT TCPFTPCON COMMAND.RDTBL) USERPORT))) (TYPE (SETQ TYPE (OR (TCPFTP.SERVER.TYPE TCPFTPCON COMMAND.RDTBL) TYPE))) (MODE (TCPFTP.SERVER.MODE TCPFTPCON COMMAND.RDTBL)) (STRU (TCPFTP.SERVER.STRUCTURE TCPFTPCON COMMAND.RDTBL)) (* ;; "Depending on the COMMAND (LIST -> verbose), TCPFTP.SERVER.LIST will return a verbose listing or a simple list of file names ") ((NLST LIST) (* ;  "Depending on the COMMAND, TCPFTP.SERVER.LIST will return") (TCPFTP.SERVER.LIST TCPFTPCON COMMAND.RDTBL USERPORT PATH COMMAND)) (RETR (TCPFTP.SERVER.RETRIEVE TCPFTPCON COMMAND.RDTBL USERPORT TYPE PATH)) (STOR (TCPFTP.SERVER.STORE TCPFTPCON COMMAND.RDTBL USERPORT TYPE PATH )) (APPE (TCPFTP.SERVER.APPEND TCPFTPCON COMMAND.RDTBL USERPORT TYPE PATH)) (DELE (TCPFTP.SERVER.DELETE TCPFTPCON COMMAND.RDTBL PATH)) (RNFR (SETQ RENAME.FROM.FILE (TCPFTP.SERVER.RENAME.FROM TCPFTPCON COMMAND.RDTBL PATH))) (RNTO (COND ((EQ LAST.COMMAND 'RNFR) (TCPFTP.SERVER.RENAME.TO TCPFTPCON COMMAND.RDTBL PATH RENAME.FROM.FILE)) (T (TCPFTP.SERVER.RESPONSE 503 "I need a RNFR command immediately preceding a RNTO command." CONTROL.OUTPUT.STREAM)))) (REIN (DISCARDLINE CONTROL.INPUT.STREAM) (TCPFTP.SERVER.WAIT.FOR.IDLE TCPFTPCON) (TCPFTP.SERVER.RESPONSE 220 "Go ahead" CONTROL.OUTPUT.STREAM)) (QUIT (DISCARDLINE CONTROL.INPUT.STREAM) (TCPFTP.SERVER.WAIT.FOR.IDLE TCPFTPCON) (TCPFTP.SERVER.RESPONSE 221 "It's been real" CONTROL.OUTPUT.STREAM) (RETURN)) (NOOP (TCPFTP.SERVER.RESPONSE 200 "I'm still here" CONTROL.OUTPUT.STREAM)) (NIL (* Error reading from control stream) (ERROR!)) (PROGN (DISCARDLINE CONTROL.INPUT.STREAM) (TCPFTP.SERVER.RESPONSE 502 (CONCAT "Unrecognized command " COMMAND) CONTROL.OUTPUT.STREAM))) (SETQ LAST.COMMAND COMMAND]) (TCPFTP.SERVER.CONNECTED.INFO [LAMBDA (PROCESS BUTTON) (* ejs%: "21-Mar-86 17:07") [PROMPTPRINT "TCPFTP server connected to " (IPHOSTNAME (fetch (TCP.CONTROL.BLOCK TCB.DST.HOST) of (fetch (TCPSTREAM TCB) of CONTROL.INPUT.STREAM ] (COND ((EQ BUTTON 'MIDDLE) (COND ((AND (BOUNDP 'TCPFTPCON) (fetch (TCPFTPCON BUSY?) of TCPFTPCON)) (printout PROMPTWINDOW T " Server is busy; last command was " (OR (AND (BOUNDP 'COMMAND) COMMAND) "???"))) ((AND (BOUNDP COMMAND) COMMAND) (printout PROMPTWINDOW T " Last command was " COMMAND]) (TCPFTP.SERVER.DELETE [LAMBDA (TCPFTPCON RDTBL DEFAULT.PATH) (* ejs%: " 7-Apr-86 11:42") (* * This function parses USER commands) (LET* ((FILENAME (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (PACKED.FILENAME (TCPFTP.SERVER.MERGE.PATHNAMES FILENAME DEFAULT.PATH T T)) TRUENAME) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG FILENAME T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (COND [PACKED.FILENAME (COND ([SETQ TRUENAME (CAR (NLSETQ (DELFILE PACKED.FILENAME] (TCPFTP.SERVER.RESPONSE 250 (CONCAT "Deleted " (COND (TCPFTP.SERVER.USE.TOPS20.SYNTAX (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'BODY TRUENAME) 'TOPS-20)) (T TRUENAME))) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))) (T (TCPFTP.SERVER.RESPONSE 450 (CONCAT "Couldn't delete file " TRUENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON] (T (TCPFTP.SERVER.RESPONSE 550 (CONCAT "File not found - " PACKED.FILENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.DIRECTORY [LAMBDA (TCPFTPCON RDTBL USERPORT DEFAULT.PATH COMMAND) (* ; "Edited 30-Aug-90 17:47 by gadener") (* * This function parses USER commands) (LET* [(PATH (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (FILES (CAR (NLSETQ (DIRECTORY (TCPFTP.SERVER.MERGE.PATHNAMES PATH DEFAULT.PATH T] (COND (FTPDEBUGFLG (printout FTPDEBUGLOG PATH T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (TCPFTP.SERVER.RESPONSE 150 (CONCAT "Opening data connection for directory of " PATH " [" (LENGTH FILES) " file name(s)]") (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) (LET ((DATASTREAM (TCPFTP.SERVER.OPEN.DATA.CONNECTION TCPFTPCON USERPORT))) (COND (DATASTREAM (for FILE in FILES do (PRIN1 [COND (TCPFTP.SERVER.USE.TOPS20.SYNTAX (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'BODY FILE) 'TOPS-20)) (T (TCPFTP.SERVER.RETURN.FILE FILE DEFAULT.PATH 'INFO] DATASTREAM) (TERPRI DATASTREAM) finally (  TCPFTP.SERVER.CLOSE.DATA.CONNECTION TCPFTPCON)) (TCPFTP.SERVER.RESPONSE 226 "Data transfer complete" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON ]) (TCPFTP.SERVER.EXIT [LAMBDA (CONTROL.INPUT.STREAM CONTROL.OUTPUT.STREAM) (* ejs%: "20-Mar-86 19:52") (CLOSEF? CONTROL.OUTPUT.STREAM) (CLOSEF? CONTROL.INPUT.STREAM]) (TCPFTP.SERVER.IDLE.INFO [LAMBDA (PROCESS BUTTON) (* ejs%: "21-Mar-86 16:58") (PROMPTPRINT "Idle TCPFTP server"]) (TCPFTP.SERVER.LIST [LAMBDA (TCPFTPCON RDTBL USERPORT DEFAULT.PATH COMMAND) (* ; "Edited 13-Sep-90 14:41 by gadener") (* * This function parses USER commands) (LET* ((PATH (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) [FILES (CAR (NLSETQ (DIRECTORY (TCPFTP.SERVER.MERGE.PATHNAMES PATH DEFAULT.PATH T] (NFILES (LENGTH FILES))) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG PATH T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (TCPFTP.SERVER.RESPONSE 150 (CONCAT "Opening data connection for directory " DEFAULT.PATH " [" NFILES " file name(s)]") (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) (LET ((DATASTREAM (TCPFTP.SERVER.OPEN.DATA.CONNECTION TCPFTPCON USERPORT))) (COND (DATASTREAM (for FILE in FILES do (PRIN1 (COND (TCPFTP.SERVER.USE.TOPS20.SYNTAX (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'BODY FILE) 'TOPS-20)) (T (TCPFTP.SERVER.RETURN.FILE FILE DEFAULT.PATH COMMAND))) DATASTREAM) (TERPRI DATASTREAM) finally (  TCPFTP.SERVER.CLOSE.DATA.CONNECTION TCPFTPCON)) (TCPFTP.SERVER.RESPONSE 226 "Data transfer complete" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON ]) (TCPFTP.SERVER.MERGE.PATHNAMES [LAMBDA (NAME DEFAULT.PATH NODEVICE.IF.LOCAL NOVERSION.IF.LOCAL DIRFLG) (* ; "Edited 13-Sep-90 14:16 by gadener") (LET* ((NAMEFIELDS (UNPACKFILENAME.STRING NAME NIL DIRFLG)) (DEFAULTFIELDS (UNPACKFILENAME.STRING DEFAULT.PATH NIL DIRFLG)) [HOST (OR (LISTGET NAMEFIELDS 'HOST) (LISTGET DEFAULTFIELDS 'HOST] [HOSTSPECIFIED (NOT (NULL (LISTGET NAMEFIELDS 'HOST] DIRECTORY1) (PACKFILENAME.STRING 'HOST HOST 'DEVICE [COND ((AND NODEVICE.IF.LOCAL (EQ HOST 'DSK)) NIL) ((OR (LISTGET NAMEFIELDS 'DEVICE) (COND (HOSTSPECIFIED NIL) (T (LISTGET DEFAULTFIELDS 'DEVICE] 'DIRECTORY [COND ((LISTGET NAMEFIELDS 'DIRECTORY)) ([COND [(SETQ DIRECTORY1 (LISTGET NAMEFIELDS 'SUBDIRECTORY] ((SETQ DIRECTORY1 (LISTGET NAMEFIELDS 'RELATIVEDIRECTORY] (CL:CONCATENATE 'STRING (LISTGET DEFAULTFIELDS 'DIRECTORY) ">" DIRECTORY1)) (HOSTSPECIFIED NIL) (T (LISTGET DEFAULTFIELDS 'DIRECTORY] 'NAME (OR (LISTGET NAMEFIELDS 'NAME) (LISTGET DEFAULTFIELDS 'NAME)) 'EXTENSION (OR (LISTGET NAMEFIELDS 'EXTENSION) (LISTGET DEFAULTFIELDS 'EXTENSION)) 'VERSION (COND ((AND NOVERSION.IF.LOCAL (EQ HOST 'DSK)) NIL) (T (OR (LISTGET NAMEFIELDS 'VERSION) (LISTGET DEFAULTFIELDS 'VERSION]) (TCPFTP.SERVER.MODE [LAMBDA (TCPFTPCON RDTBL) (* edited%: "21-Mar-86 15:38") (* * This function parses USER commands) (LET ((MODE (READ (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (RESPONSE.STRING) (ERRORFLG)) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG MODE T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (SELECTQ MODE (S (SETQ RESPONSE.STRING "Now in stream mode")) (PROGN (SETQ RESPONSE.STRING (CONCAT "Unsupported mode - " MODE)) (SETQ ERRORFLG T))) (COND (ERRORFLG (TCPFTP.SERVER.RESPONSE 504 RESPONSE.STRING (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) NIL) (T (TCPFTP.SERVER.RESPONSE 200 RESPONSE.STRING (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.OPEN.DATA.CONNECTION [LAMBDA (TCPFTPCON USERPORT FORINPUT) (* ejs%: "11-Apr-86 16:09") (* * This function handles opening data connections and marking said tcp  connections as busy) (bind (TCB _ (fetch (TCPSTREAM TCB) of (fetch (TCPFTPCON TCPIN) of TCPFTPCON))) DATASTREAM for RETRIES from 0 to TCPFTP.SERVER.RETRYCOUNT until (SETQ DATASTREAM (TCP.OPEN (COND (USERPORT (CAR USERPORT)) (T (fetch (TCP.CONTROL.BLOCK TCB.DST.HOST) of TCB))) (COND (USERPORT (CDR USERPORT)) (T (fetch (TCP.CONTROL.BLOCK TCB.DST.PORT) of TCB))) (SUB1 (fetch (TCP.CONTROL.BLOCK TCB.SRC.PORT) of TCB)) 'ACTIVE (COND (FORINPUT 'INPUT) (T 'OUTPUT)) T)) finally (RETURN (COND (DATASTREAM (replace (TCPFTPCON DATASTREAM) of TCPFTPCON with DATASTREAM ) (replace (TCPFTPCON BUSY?) of TCPFTPCON with (CREATE.EVENT )) (* TELNET standard EOL convention on  DATASTREAMS) (SETFILEINFO DATASTREAM 'EOL 'CRLF) DATASTREAM) (T (TCPFTP.SERVER.RESPONSE 426 "Couldn't open data connection" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) NIL]) (TCPFTP.SERVER.PARSE.PORT [LAMBDA (PSTRING) (* ; "Edited 28-May-87 18:00 by jop") (* ;;; "Parse a port string, in the form 'h1,h2,h3,h4,p1,p2' , where the hx are bytes from an internet host address, and the px are bytes from a 16-bit TCP port number") (LET ((IPADDRESS (CREATECELL \FIXP)) (TCPPORT 0)) (bind (BYTECOUNTER _ 0) (ACCUMULATOR _ 0) ERRORFLG for CH instring PSTRING do (COND ((EQ CH (CHARCODE %,)) (COND ((IGREATERP BYTECOUNTER 3) (SETQ TCPPORT (IPLUS (ITIMES TCPPORT 256) ACCUMULATOR))) (T (\PUTBASEBYTE IPADDRESS BYTECOUNTER ACCUMULATOR))) (SETQ ACCUMULATOR 0) (add BYTECOUNTER 1)) [(AND (ILEQ CH (CHARCODE 9)) (IGEQ CH (CHARCODE 0))) (SETQ ACCUMULATOR (IPLUS (IDIFFERENCE CH (CHARCODE 0)) (ITIMES ACCUMULATOR 10))) (COND ((IGREATERP ACCUMULATOR 255) (SETQ ERRORFLG T) (GO $$OUT] (T (SETQ ERRORFLG T) (GO $$OUT))) finally (COND (ERRORFLG (RETURN NIL)) (T (COND ((NEQ BYTECOUNTER 5) (RETURN NIL)) (T (RETURN (CONS IPADDRESS (IPLUS (ITIMES TCPPORT 256) ACCUMULATOR]) (TCPFTP.SERVER.PASSWORD [LAMBDA (TCPFTPCON RDTBL) (* edited%: "21-Mar-86 11:39") (* * This function parses USER commands) (LET ((PASS (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL))) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG PASS T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (TCPFTP.SERVER.RESPONSE 230 "OK, so you're logged in. Now what?" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.PATH [LAMBDA (TCPFTPCON COMMAND.RDTBL OLDPATH) (* ; "Edited 13-Sep-90 13:37 by gadener") (LET* ((PATH (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) COMMAND.RDTBL)) (TRUEPATH (TCPFTP.SERVER.MERGE.PATHNAMES PATH OLDPATH NIL T 'RETURN)) (* ;; "The last argument, RETURN, makes sure that even though a directory was specified as /a/b/c, we really meant /a/b/c") ) (IF TRUEPATH THEN (TCPFTP.SERVER.RESPONSE 250 (CONCAT "Default pathname now " TRUEPATH) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) TRUEPATH else (TCPFTP.SERVER.RESPONSE 501 (CONCAT "Couldn't interpret " NEWPATH " as a pathname") (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) NIL]) (TCPFTP.SERVER.PORT [LAMBDA (TCPFTPCON RDTBL) (* edited%: "21-Mar-86 11:41") (LET* ((PORTSTRING (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (PARSEDPORT (TCPFTP.SERVER.PARSE.PORT PORTSTRING))) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG PORTSTRING T))) (COND (PARSEDPORT (TCPFTP.SERVER.RESPONSE 200 (CONCAT "User port now " PORTSTRING) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) PARSEDPORT) (T (TCPFTP.SERVER.RESPONSE 501 (CONCAT "Couldn't parse port specification " PORTSTRING) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) NIL]) (TCPFTP.SERVER.PROCESS [LAMBDA (PORT DEFAULT.FILE.PATH) (* ; "Edited 24-Aug-87 17:55 by scp") (* * This is the TCP-based FTP server top-level) (PROCESSPROP (THIS.PROCESS) 'INFOHOOK (FUNCTION TCPFTP.SERVER.IDLE.INFO)) (LET* ((CONTROL.INPUT.STREAM (TCP.OPEN NIL NIL (OR PORT \TCP.FTP.PORT) 'PASSIVE 'INPUT)) (CONTROL.OUTPUT.STREAM (TCP.OTHER.STREAM CONTROL.INPUT.STREAM))) (* EOL convention -> TELNET Standard) (SETFILEINFO CONTROL.OUTPUT.STREAM 'EOL 'CRLF) (* Say hello quickly) (TCPFTP.SERVER.RESPONSE 220 TCPFTP.SERVER.HERALD.STRING CONTROL.OUTPUT.STREAM) (* Spawn a new server) (ADD.PROCESS (LIST (FUNCTION TCPFTP.SERVER) PORT (KWOTE DEFAULT.FILE.PATH)) 'RESTARTABLE 'HARDRESET) (* Now that we're "established,"  errors are fatal) (PROCESSPROP (THIS.PROCESS) 'RESTARTABLE 'NO) (PROCESSPROP (THIS.PROCESS) 'INFOHOOK (FUNCTION TCPFTP.SERVER.CONNECTED.INFO)) (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (CONTROL.INPUT.STREAM CONTROL.OUTPUT.STREAM) (COND (RESETSTATE (TCPFTP.SERVER.ABORTED CONTROL.INPUT.STREAM CONTROL.OUTPUT.STREAM)) (T (TCPFTP.SERVER.EXIT CONTROL.INPUT.STREAM CONTROL.OUTPUT.STREAM] CONTROL.INPUT.STREAM CONTROL.OUTPUT.STREAM)) (TCPFTP.SERVER.COMMAND.LOOP CONTROL.INPUT.STREAM CONTROL.OUTPUT.STREAM DEFAULT.FILE.PATH]) (TCPFTP.SERVER.RENAME.FROM [LAMBDA (TCPFTPCON RDTBL DEFAULT.PATH) (* ejs%: "24-Mar-86 14:16") (* * This function parses RNFR commands) (LET* [(FILENAME (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (PACKED.FILENAME (TCPFTP.SERVER.MERGE.PATHNAMES FILENAME DEFAULT.PATH T)) (TRUENAME (CAR (NLSETQ (INFILEP PACKED.FILENAME] (COND (FTPDEBUGFLG (printout FTPDEBUGLOG FILENAME T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (COND (TRUENAME (TCPFTP.SERVER.RESPONSE 350 (CONCAT "About to rename " (COND (TCPFTP.SERVER.USE.TOPS20.SYNTAX (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'BODY TRUENAME) 'TOPS-20)) (T TRUENAME))) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) TRUENAME) (T (TCPFTP.SERVER.RESPONSE 550 (CONCAT "File not found - " PACKED.FILENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) NIL]) (TCPFTP.SERVER.RENAME.TO [LAMBDA (TCPFTPCON RDTBL DEFAULT.PATH FROM.FILE) (* ejs%: "24-Mar-86 14:34") (* * This function parses RNTO commands) (LET* [(FILENAME (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (PACKED.FILENAME (TCPFTP.SERVER.MERGE.PATHNAMES FILENAME DEFAULT.PATH T)) (TRUENAME (CAR (NLSETQ (OUTFILEP PACKED.FILENAME] (COND (FTPDEBUGFLG (printout FTPDEBUGLOG FILENAME T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (COND (TRUENAME (RENAMEFILE FROM.FILE TRUENAME) (TCPFTP.SERVER.RESPONSE 250 (CONCAT "Renamed " (COND (TCPFTP.SERVER.USE.TOPS20.SYNTAX (REPACKFILENAME.STRING ( PACKFILENAME.STRING 'HOST NIL 'BODY FROM.FILE) 'TOPS-20)) (T FROM.FILE)) " to " (COND (TCPFTP.SERVER.USE.TOPS20.SYNTAX (REPACKFILENAME.STRING ( PACKFILENAME.STRING 'HOST NIL 'BODY TRUENAME) 'TOPS-20)) (T TRUENAME))) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))) (T (TCPFTP.SERVER.RESPONSE 553 (CONCAT "Couldn't make an output file named " PACKED.FILENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.RESPONSE [LAMBDA (CODE STRING STREAM) (* edited%: "21-Mar-86 11:44") (RESETFORM (RADIX 10) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG "> " CODE " " STRING T))) (printout STREAM CODE " " STRING T)) (FORCEOUTPUT STREAM]) (TCPFTP.SERVER.RETRIEVE [LAMBDA (TCPFTPCON RDTBL USERPORT TYPE DEFAULT.PATH) (* ; "Edited 13-Sep-90 14:59 by gadener") (* * This function parses USER commands) (LET* [(FILENAME (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (PACKED.FILENAME (TCPFTP.SERVER.MERGE.PATHNAMES FILENAME DEFAULT.PATH T)) (TRUENAME (CAR (NLSETQ (INFILEP PACKED.FILENAME] (COND (FTPDEBUGFLG (printout FTPDEBUGLOG FILENAME T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (COND [TRUENAME (LET [(FILESTREAM (CAR (NLSETQ (OPENSTREAM TRUENAME 'INPUT 'OLD `((TYPE %, TYPE] (COND [FILESTREAM (TCPFTP.SERVER.RESPONSE 150 (CONCAT "Opening " TYPE " data connection for " (COND (TCPFTP.SERVER.USE.TOPS20.SYNTAX (REPACKFILENAME.STRING (FULLNAME FILESTREAM) 'TOPS-20)) (T (FULLNAME FILESTREAM))) " (" [\IP.ADDRESS.TO.STRING (OR (CAR USERPORT) (fetch (TCP.CONTROL.BLOCK TCB.DST.HOST) of (fetch (TCPSTREAM TCB) of (fetch (TCPFTPCON TCPIN) of TCPFTPCON] "," [OR (CDR USERPORT) (fetch (TCP.CONTROL.BLOCK TCB.DST.PORT) of (fetch (TCPSTREAM TCB) of (fetch (TCPFTPCON TCPIN) of TCPFTPCON] ") (" (OR (GETFILEINFO FILESTREAM 'LENGTH) 0) " bytes).") (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) (LET ((DATASTREAM (TCPFTP.SERVER.OPEN.DATA.CONNECTION TCPFTPCON USERPORT))) (COND (DATASTREAM (LET [(RESULT (NLSETQ (COND ((EQ TYPE 'BINARY) (COPYBYTES FILESTREAM DATASTREAM)) (T (COPYCHARS FILESTREAM DATASTREAM] (CLOSEF? FILESTREAM) (TCPFTP.SERVER.CLOSE.DATA.CONNECTION TCPFTPCON) (COND (RESULT (TCPFTP.SERVER.RESPONSE 226 "Data transfer complete" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON))) (T (TCPFTP.SERVER.RESPONSE 426 "Couldn't complete retrieve operation" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON] (T (TCPFTP.SERVER.RESPONSE 450 (CONCAT "Couldn't open file " TRUENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON] (T (TCPFTP.SERVER.RESPONSE 550 (CONCAT "File not found - " PACKED.FILENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.RETURN.FILE [LAMBDA (FILE DEFAULT.PATH COMMAND) (* ; "Edited 31-Aug-90 17:57 by gadener") (* ;; "If COMMAND is LIST , it will return a verbose listing of the file and some of its properties. If the command is NLIST, it will just return the filename with extension and version. ") (* ;; "Note that since the D-mahines don't have a true directory structure, it will return the relative pathname to the file , in relation to DEFAULT.PATH.") (LET* [(DEFAULT.PATH.STRING.LENGTH (NCHARS DEFAULT.PATH)) (PATH (SUBSTRING FILE (PLUS 1 DEFAULT.PATH.STRING.LENGTH))) (TAB (CHARACTER (CHARCODE TAB] (COND ((EQUAL COMMAND 'LIST) (CONCAT (GETFILEINFO FILE 'TYPE) TAB (GETFILEINFO FILE 'LENGTH) TAB (GETFILEINFO FILE 'WRITEDATE) TAB (GETFILEINFO FILE 'AUTHOR) TAB PATH)) (T PATH]) (TCPFTP.SERVER.STORE [LAMBDA (TCPFTPCON RDTBL USERPORT TYPE DEFAULT.PATH) (* ejs%: "24-Mar-86 15:27") (* * This function parses USER commands) (LET* [(FILENAME (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (PACKED.FILENAME (TCPFTP.SERVER.MERGE.PATHNAMES FILENAME DEFAULT.PATH T)) (TRUENAME (CAR (NLSETQ (OUTFILEP PACKED.FILENAME] (COND (FTPDEBUGFLG (printout FTPDEBUGLOG FILENAME T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (COND [TRUENAME (LET [(FILESTREAM (CAR (NLSETQ (OPENSTREAM TRUENAME 'OUTPUT 'NEW `((TYPE %, TYPE] (COND [FILESTREAM (TCPFTP.SERVER.RESPONSE 150 (CONCAT "Opening data connection for store of " (FULLNAME FILESTREAM)) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) (LET ((DATASTREAM (TCPFTP.SERVER.OPEN.DATA.CONNECTION TCPFTPCON USERPORT T ))) (COND (DATASTREAM [replace (STREAM ENDOFSTREAMOP) of DATASTREAM with (FUNCTION (LAMBDA (STREAM) (ERROR!] (RESETLST (RESETSAVE (COND ((EQ TYPE 'BINARY) (COPYBYTES DATASTREAM FILESTREAM)) (T (COPYCHARS DATASTREAM FILESTREAM ))) (LIST [FUNCTION (LAMBDA (FILESTREAM TCPFTPCON) (CLOSEF? FILESTREAM) (  TCPFTP.SERVER.CLOSE.DATA.CONNECTION TCPFTPCON) (TCPFTP.SERVER.RESPONSE 226 "Data transfer complete" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON] FILESTREAM TCPFTPCON] (T (TCPFTP.SERVER.RESPONSE 450 (CONCAT "Couldn't open file " TRUENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON] (T (TCPFTP.SERVER.RESPONSE 550 (CONCAT "Unable to create output filename - " PACKED.FILENAME) (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.STRUCTURE [LAMBDA (TCPFTPCON RDTBL) (* edited%: "21-Mar-86 14:08") (* * This function parses USER commands) (LET ((STRUCTURE (READ (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (RESPONSE.STRING) (ERRORFLG)) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG STRUCTURE T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (SELECTQ STRUCTURE (F (SETQ RESPONSE.STRING "Now in stream mode")) (PROGN (SETQ RESPONSE.STRING (CONCAT "Unsupported mode - " STRUCTURE)) (SETQ ERRORFLG T))) (COND (ERRORFLG (TCPFTP.SERVER.RESPONSE 504 RESPONSE.STRING (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) NIL) (T (TCPFTP.SERVER.RESPONSE 200 RESPONSE.STRING (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.TYPE [LAMBDA (TCPFTPCON RDTBL) (* ejs%: "24-Mar-86 15:26") (* * This function parses USER commands) (LET* ((MAJOR.TYPE (READ (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) [MINOR.TYPE (LET [(TERM.CHAR (BIN (fetch (TCPFTPCON TCPIN) of TCPFTPCON] (COND ((EQ TERM.CHAR (CHARCODE SPACE)) (READ (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL)) (T (SELECTQ MAJOR.TYPE (A 'N) (L 8) NIL] (RESPONSE.STRING) (ERRORFLG)) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG MAJOR.TYPE " " MINOR.TYPE T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (SELECTQ MAJOR.TYPE (A (SELECTQ MINOR.TYPE (N (SETQ RESPONSE.STRING "Type is now standard ASCII")) (PROGN (SETQ RESPONSE.STRING (CONCAT "ASCII subtype " MINOR.TYPE " not recognized")) (SETQ ERRORFLG T)))) (E (SETQ RESPONSE.STRING "EBCDIC not supported") (SETQ ERRORFLG T)) (I (SETQ RESPONSE.STRING "Type is now 8-bit binary")) (L (COND ((NEQ MINOR.TYPE 8) (SETQ RESPONSE.STRING (CONCAT "Binary byte size " MINOR.TYPE " not supported")) (SETQ ERRORFLG T)) (T (SETQ RESPONSE.STRING "Type is now 8-bit binary")))) NIL) (COND (ERRORFLG (TCPFTP.SERVER.RESPONSE 504 RESPONSE.STRING (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) NIL) (T (TCPFTP.SERVER.RESPONSE 200 RESPONSE.STRING (fetch (TCPFTPCON TCPOUT) of TCPFTPCON)) (SELECTQ MAJOR.TYPE (A 'TEXT) 'BINARY]) (TCPFTP.SERVER.USER [LAMBDA (TCPFTPCON RDTBL) (* edited%: "21-Mar-86 11:39") (* * This function parses USER commands) (LET ((USER (RSTRING (fetch (TCPFTPCON TCPIN) of TCPFTPCON) RDTBL))) (COND (FTPDEBUGFLG (printout FTPDEBUGLOG USER T))) (DISCARDLINE (fetch (TCPFTPCON TCPIN) of TCPFTPCON)) (TCPFTP.SERVER.RESPONSE 230 "Hi, there!" (fetch (TCPFTPCON TCPOUT) of TCPFTPCON]) (TCPFTP.SERVER.VERBOSE.LIST [LAMBDA (FILE STREAM) (* edited%: "26-Mar-86 11:32") (printout STREAM (COND (TCPFTP.SERVER.USE.TOPS20.SYNTAX (REPACKFILENAME.STRING (PACKFILENAME.STRING 'HOST NIL 'BODY (FULLNAME FILE)) 'TOPS-20)) (T (FULLNAME FILE))) ";P775252;AFORYOURSELF," (FOLDHI (OR (GETFILEINFO FILE 'SIZE) 0) 4) "," (GETFILEINFO FILE 'CREATIONDATE) "," (GETFILEINFO FILE 'WRITEDATE) T]) (TCPFTP.SERVER.WAIT.FOR.IDLE [LAMBDA (TCPFTPCON) (* ejs%: "20-Mar-86 16:39") (bind BUSY? while (SETQ BUSY? (fetch (TCPFTPCON BUSY?) of TCPFTPCON)) do (AWAIT.EVENT BUSY?]) (TCPFTP.UNIX.LS.DATE [LAMBDA (FILE) (* edited%: "21-Mar-86 13:38") (LET* [(CREATIONDATE (GETFILEINFO FILE 'CREATIONDATE)) (MONTHPOS (STRPOS "-" CREATIONDATE)) (YEARPOS (STRPOS "-" CREATIONDATE (ADD1 MONTHPOS))) (TIMEPOS (ADD1 (STRPOS " " CREATIONDATE] (CONCAT (SUBSTRING CREATIONDATE (ADD1 MONTHPOS) (SUB1 YEARPOS)) " " (SUBSTRING CREATIONDATE 1 (SUB1 MONTHPOS)) " " (SUBSTRING CREATIONDATE TIMEPOS -4]) ) (RPAQ? TCPFTP.SERVER.HERALD.STRING "Venue Medley FTP Service 1.0 at your service") (RPAQ? TCPFTP.SERVER.USE.TOPS20.SYNTAX NIL) (RPAQ? TCPFTP.SERVER.RETRYCOUNT 5) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TCPFTP.SERVER.HERALD.STRING TCPFTP.SERVER.USE.TOPS20.SYNTAX TCPFTP.SERVER.RETRYCOUNT) ) (FILESLOAD (SYSLOAD) TCPFTP) (PUTPROPS TCPFTPSRV COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1782 54890 (TCPFTP.SERVER 1792 . 2089) (TCPFTP.SERVER.ABORTED 2091 . 2263) ( TCPFTP.SERVER.ACCOUNT 2265 . 2817) (TCPFTP.SERVER.APPEND 2819 . 6531) ( TCPFTP.SERVER.CLOSE.DATA.CONNECTION 6533 . 7031) (TCPFTP.SERVER.COMMAND.LOOP 7033 . 13702) ( TCPFTP.SERVER.CONNECTED.INFO 13704 . 14690) (TCPFTP.SERVER.DELETE 14692 . 16577) ( TCPFTP.SERVER.DIRECTORY 16579 . 18921) (TCPFTP.SERVER.EXIT 18923 . 19115) (TCPFTP.SERVER.IDLE.INFO 19117 . 19282) (TCPFTP.SERVER.LIST 19284 . 21609) (TCPFTP.SERVER.MERGE.PATHNAMES 21611 . 23718) ( TCPFTP.SERVER.MODE 23720 . 24743) (TCPFTP.SERVER.OPEN.DATA.CONNECTION 24745 . 27732) ( TCPFTP.SERVER.PARSE.PORT 27734 . 30442) (TCPFTP.SERVER.PASSWORD 30444 . 31090) (TCPFTP.SERVER.PATH 31092 . 32075) (TCPFTP.SERVER.PORT 32077 . 32886) (TCPFTP.SERVER.PROCESS 32888 . 35079) ( TCPFTP.SERVER.RENAME.FROM 35081 . 36653) (TCPFTP.SERVER.RENAME.TO 36655 . 39136) ( TCPFTP.SERVER.RESPONSE 39138 . 39457) (TCPFTP.SERVER.RETRIEVE 39459 . 44526) ( TCPFTP.SERVER.RETURN.FILE 44528 . 45581) (TCPFTP.SERVER.STORE 45583 . 49232) (TCPFTP.SERVER.STRUCTURE 49234 . 50287) (TCPFTP.SERVER.TYPE 50289 . 52577) (TCPFTP.SERVER.USER 52579 . 53118) ( TCPFTP.SERVER.VERBOSE.LIST 53120 . 54036) (TCPFTP.SERVER.WAIT.FOR.IDLE 54038 . 54285) ( TCPFTP.UNIX.LS.DATE 54287 . 54888))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPHTE b/obsolete/tcp/TCPHTE new file mode 100644 index 00000000..dda05d9a --- /dev/null +++ b/obsolete/tcp/TCPHTE @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP") (FILECREATED "12-Jun-90 17:31:06" {DSK}local>lde>lispcore>library>TCPHTE.;3 5753 changes to%: (VARS TCPHTECOMS) previous date%: "11-Feb-89 11:06:54" {DSK}local>lde>lispcore>library>TCPHTE.;2) (* ; " Copyright (c) 1985, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPHTECOMS) (RPAQQ TCPHTECOMS ((PROP MAKEFILE-ENVIRONMENT TCPHTE) (RECORDS HOSTS.TXT.ENTRY) (FNS \HTE.PARSE.ENTRY \HTE.READ.FILE \HTE.READ; \HTE.READLINE) (INITVARS (HOSTS.TEXT.DIRECTORIES) (\HTE.RDTBL)) (DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS \HTE.RDTBL \IP.HOSTNAMES) (RECORDS HTELINE)))) (PUTPROPS TCPHTE MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP")) (DECLARE%: EVAL@COMPILE (DATATYPE HOSTS.TXT.ENTRY (HTE.TYPE HTE.ADDRESSES HTE.NAMES HTE.MACHINE.TYPE HTE.OS.TYPE HTE.PROTOCOLS)) ) (/DECLAREDATATYPE 'HOSTS.TXT.ENTRY '(POINTER POINTER POINTER POINTER POINTER POINTER) '((HOSTS.TXT.ENTRY 0 POINTER) (HOSTS.TXT.ENTRY 2 POINTER) (HOSTS.TXT.ENTRY 4 POINTER) (HOSTS.TXT.ENTRY 6 POINTER) (HOSTS.TXT.ENTRY 8 POINTER) (HOSTS.TXT.ENTRY 10 POINTER)) '12) (DEFINEQ (\HTE.PARSE.ENTRY [LAMBDA (ENTRY) (* ; "Edited 11-Feb-89 11:04 by akw:") (DECLARE (GLOBALVARS NETWORKOSTYPES)) (LET* [[NAMES (for NAME in (fetch (HTELINE NAMES) of ENTRY) collect (MKATOM (U-CASE NAME] (OSTYPE (CAR (fetch (HTELINE OS.TYPE) of ENTRY)) (MKATOM (U-CASE))) (HTE.ENTRY (create HOSTS.TXT.ENTRY HTE.TYPE _ (CAR (fetch (HTELINE TYPE) of ENTRY)) HTE.ADDRESSES _ (for X in (fetch (HTELINE ADDRESSES) of ENTRY) collect (\IP.READ.STRING.ADDRESS X)) HTE.NAMES _ NAMES HTE.MACHINE.TYPE _ [MKATOM (U-CASE (CAR (fetch (HTELINE MACHINE.TYPE ) of ENTRY] HTE.OS.TYPE _ [AND OSTYPE (SETQ OSTYPE (MKATOM (U-CASE OSTYPE] HTE.PROTOCOLS _ (for PROTOENTRY in (fetch (HTELINE PROTOCOLS ) of ENTRY) bind SLASH when (SETQ SLASH (STRPOS '/ PROTOENTRY)) collect (CONS (SUBATOM PROTOENTRY 1 (SUB1 SLASH)) (SUBATOM PROTOENTRY (ADD1 SLASH] (for NAME in NAMES do (PUTHASH NAME HTE.ENTRY \IP.HOSTNAMES]) (\HTE.READ.FILE (LAMBDA (FILE WANTEDTYPES) (* ; "Edited 24-May-88 16:57 by bvm") (DECLARE (GLOBALVARS \IP.HOSTNAMES \TCP.LAST.HOSTS.FILE.DATE \TCP.LAST.HOSTS.FILE.READ)) (OR WANTEDTYPES (SETQ WANTEDTYPES (QUOTE (HOST)))) (CL:WITH-OPEN-FILE (STREAM FILE) (LET ((FILENAME (FULLNAME STREAM)) (DATE (GETFILEINFO STREAM (QUOTE ICREATIONDATE))) ENTRY) (PRINTOUT PROMPTWINDOW T "Reading " FILENAME " of " (GDATE DATE (DATEFORMAT NO.SECONDS))) (CLRHASH \IP.HOSTNAMES) (until (EOFP STREAM) when (AND (SETQ ENTRY (\HTE.READLINE STREAM WANTEDTYPES)) (FMEMB (CAR (fetch (HTELINE TYPE) of ENTRY)) WANTEDTYPES)) do (\HTE.PARSE.ENTRY ENTRY)) (SETQ \TCP.LAST.HOSTS.FILE.DATE DATE) (SETQ \TCP.LAST.HOSTS.FILE.READ FILENAME)))) ) (\HTE.READ; (LAMBDA (FL RDTBL) (* ; "Edited 24-May-88 14:45 by bvm") (until (SELCHARQ (READCCODE FL) ((CR LF EOL) T) NIL)) NIL) ) (\HTE.READLINE (LAMBDA (STREAM WANTEDTYPES) (* ; "Edited 24-May-88 16:57 by bvm") (while (EQ (PEEKCCODE STREAM T) (CHARCODE ";")) do (\HTE.READ; STREAM)) (AND (NOT (EOFP STREAM)) (for FIELD# from 1 bind FIELDCONTENTS DONE (RDTBL _ (COND (\HTE.RDTBL) (T (SETQ \HTE.RDTBL (COPYREADTABLE (QUOTE ORIG))) (SETSEPR (CHARCODE (SPACE TAB %,)) NIL \HTE.RDTBL) (SETBRK (CHARCODE (":" ";" CR LF)) NIL \HTE.RDTBL) (READTABLEPROP \HTE.RDTBL (QUOTE CASEINSENSITIVE) T) \HTE.RDTBL))) until DONE collect (SETQ FIELDCONTENTS (until (SELCHARQ (SKIPSEPRCODES STREAM RDTBL) (":" (* ; "End of field") (READCCODE STREAM) T) (";" (* ; "end of line") (\HTE.READ; STREAM) (SETQ DONE T)) ((CR LF) (* ; "end of line--consume the terminator") (READCCODE STREAM) (SETQ DONE T)) (NIL (* ; "Eof") (SETQ DONE T)) NIL) collect (* ; "Read up to the next field delimiter") (if (EQ FIELD# 1) then (* ; "Canonicalize the type field") (READ STREAM RDTBL) else (RSTRING STREAM RDTBL)))) (if (AND (EQ FIELD# 1) WANTEDTYPES (NOT (FMEMB (CAR FIELDCONTENTS) WANTEDTYPES))) then (* ; "Don't care about this line") (OR DONE (\HTE.READ; STREAM)) (RETURN NIL)) FIELDCONTENTS))) ) ) (RPAQ? HOSTS.TEXT.DIRECTORIES ) (RPAQ? \HTE.RDTBL ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \HTE.RDTBL \IP.HOSTNAMES) ) (DECLARE%: EVAL@COMPILE (RECORD HTELINE (TYPE ADDRESSES NAMES MACHINE.TYPE OS.TYPE PROTOCOLS)) ) ) (PUTPROPS TCPHTE COPYRIGHT ("Venue & Xerox Corporation" 1985 1987 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1360 5370 (\HTE.PARSE.ENTRY 1370 . 3378) (\HTE.READ.FILE 3380 . 4095) (\HTE.READ; 4097 . 4230) (\HTE.READLINE 4232 . 5368))))) STOP \ No newline at end of file diff --git a/library/TCPIP.TEDIT b/obsolete/tcp/TCPIP.TEDIT similarity index 100% rename from library/TCPIP.TEDIT rename to obsolete/tcp/TCPIP.TEDIT diff --git a/obsolete/tcp/TCPLLAR b/obsolete/tcp/TCPLLAR new file mode 100644 index 00000000..12e028d3 --- /dev/null +++ b/obsolete/tcp/TCPLLAR @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "17-Aug-90 12:32:20" {DSK}ETHERNET>TCP>NEW>TCPLLAR.;3 22788 changes to%: (FNS \AR.DAEMON \AR.ENTER.RESOLUTION \AR.NOTE.RESOLUTION \AR.UPDATE.RESOLUTION \PRINTAR SPUTASSOC \AR.TRANSLATE.TO.10MB \AR.REQUEST.IP.TO.10MB \AR.REQUEST.IP.TO.3MB \AR.RESOLVE \AR.TRANSLATE.TO.3MB \HANDLE.RAW.AR) previous date%: " 6-Jan-89 15:18:06" {DSK}ETHERNET>TCP>NEW>TCPLLAR.;2) (* " Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPLLARCOMS) (RPAQQ TCPLLARCOMS [(COMS (* ;;; "IP Ethernet address translation module") [DECLARE%: DONTCOPY (EXPORT (RECORDS AR ARETHER AREXPETHER ARENTRY) (CONSTANTS (\AR.HARDWARE.SPACE.ETHERNET 1) (\AR.ETHERNET.ADDRESS.LENGTH 6) (\AR.IP.ADDRESS.LENGTH 4) (\AR.REQUEST 1) (\AR.RESPONSE 2) (\AR.ETHER.PACKET.LENGTH 28] (INITRECORDS ARENTRY) (INITVARS (\AR.IP.TO.10MB.ALIST (CONS)) (\AR.SEARCH.TIMEOUT.INTERVAL 300000) (\AR.VALID.TIMEOUT.INTERVAL 600000)) (GLOBALVARS \AR.IP.TO.10MB.ALIST \AR.SEARCH.TIMEOUT.INTERVAL \AR.VALID.TIMEOUT.INTERVAL) (FNS \AR.DAEMON \AR.ENTER.RESOLUTION \AR.NOTE.RESOLUTION \AR.UPDATE.RESOLUTION \PRINTAR SPUTASSOC \AR.TRANSLATE.TO.10MB \AR.REQUEST.IP.TO.10MB \AR.REQUEST.IP.TO.3MB \AR.RESOLVE \AR.TRANSLATE.TO.3MB \HANDLE.RAW.AR) (ADDVARS (\PACKET.PRINTERS (2054 . \PRINTAR]) (* ;;; "IP Ethernet address translation module") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (ACCESSFNS AR [(ARBASE (LOCF (fetch (ETHERPACKET EPBODY) of DATUM] [BLOCKRECORD ARBASE ((ARHARDWARESPACE WORD) (ARPROTOCOLSPACE WORD) (ARHARDWARELEN BYTE) (ARPROTOCOLLEN BYTE) (AROPCODE WORD) (AR1STWORD WORD)) (ACCESSFNS AR1STWORD ((ARCONTENTS (LOCF DATUM]) (ACCESSFNS ARETHER ((ARETHERBASE (fetch (AR ARCONTENTS) of DATUM))) [BLOCKRECORD ARETHERBASE ((ARLCLHDW0 WORD) (ARLCLHDW1 WORD) (ARLCLHDW2 WORD) (ARLCLPTCL FIXP) (ARFRNHDW0 WORD) (ARFRNHDW1 WORD) (ARFRNHDW2 WORD) (ARFRNPTCL FIXP)) [ACCESSFNS ARLCLHDW0 ((ARSENDERHDW (\LOADNSHOSTNUMBER (LOCF DATUM)) (\STORENSHOSTNUMBER (LOCF DATUM) NEWVALUE] (ACCESSFNS ARFRNHDW0 ((ARTARGETHDW (\LOADNSHOSTNUMBER (LOCF DATUM)) (\STORENSHOSTNUMBER (LOCF DATUM) NEWVALUE]) (ACCESSFNS AREXPETHER ((ARETHERBASE (fetch (AR ARCONTENTS) of DATUM))) (BLOCKRECORD ARETHERBASE ((ARLCLHDW WORD) (ARLCLPTCL FIXP) (ARFRNHDW WORD) (ARFRNPTCL FIXP)))) (DATATYPE ARENTRY ((RECENT FLAG) (SEARCHING FLAG) (IPADDRESS POINTER) (ETHERADDRESS POINTER) (TIMER POINTER)) TIMER _ (NCREATE 'FIXP)) ) (/DECLAREDATATYPE 'ARENTRY '(FLAG FLAG POINTER POINTER POINTER) '((ARENTRY 0 (FLAGBITS . 0)) (ARENTRY 0 (FLAGBITS . 16)) (ARENTRY 0 POINTER) (ARENTRY 2 POINTER) (ARENTRY 4 POINTER)) '6) (DECLARE%: EVAL@COMPILE (RPAQQ \AR.HARDWARE.SPACE.ETHERNET 1) (RPAQQ \AR.ETHERNET.ADDRESS.LENGTH 6) (RPAQQ \AR.IP.ADDRESS.LENGTH 4) (RPAQQ \AR.REQUEST 1) (RPAQQ \AR.RESPONSE 2) (RPAQQ \AR.ETHER.PACKET.LENGTH 28) (CONSTANTS (\AR.HARDWARE.SPACE.ETHERNET 1) (\AR.ETHERNET.ADDRESS.LENGTH 6) (\AR.IP.ADDRESS.LENGTH 4) (\AR.REQUEST 1) (\AR.RESPONSE 2) (\AR.ETHER.PACKET.LENGTH 28)) ) (* "END EXPORTED DEFINITIONS") ) (/DECLAREDATATYPE 'ARENTRY '(FLAG FLAG POINTER POINTER POINTER) '((ARENTRY 0 (FLAGBITS . 0)) (ARENTRY 0 (FLAGBITS . 16)) (ARENTRY 0 POINTER) (ARENTRY 2 POINTER) (ARENTRY 4 POINTER)) '6) (RPAQ? \AR.IP.TO.10MB.ALIST (CONS)) (RPAQ? \AR.SEARCH.TIMEOUT.INTERVAL 300000) (RPAQ? \AR.VALID.TIMEOUT.INTERVAL 600000) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \AR.IP.TO.10MB.ALIST \AR.SEARCH.TIMEOUT.INTERVAL \AR.VALID.TIMEOUT.INTERVAL) ) (DEFINEQ (\AR.DAEMON [LAMBDA NIL (* ejs%: "25-Jun-85 18:47") (for ARENTRY in \AR.IP.TO.10MB.ALIST do (\AR.UPDATE.RESOLUTION ARENTRY) (BLOCK]) (\AR.ENTER.RESOLUTION [LAMBDA (IPADDRESS ETHERADDRESS ONLY-IF-PRESENT-P) (* ; "Edited 21-Dec-88 20:10 by Briggs") (* * Enter a new resolution in the AR table, or update an existing resolution) (LET [(OLDENTRY (find ENTRY in \AR.IP.TO.10MB.ALIST suchthat (EQUAL IPADDRESS (fetch (ARENTRY IPADDRESS) of ENTRY] (COND (OLDENTRY (freplace (ARENTRY TIMER) of OLDENTRY with (SETUPTIMER \AR.VALID.TIMEOUT.INTERVAL (ffetch (ARENTRY TIMER) of OLDENTRY))) (freplace (ARENTRY ETHERADDRESS) of OLDENTRY with ETHERADDRESS) (freplace (ARENTRY RECENT) of OLDENTRY with T) (freplace (ARENTRY SEARCHING) of OLDENTRY with NIL) OLDENTRY) ((NOT ONLY-IF-PRESENT-P) (CAR (push \AR.IP.TO.10MB.ALIST (create ARENTRY IPADDRESS _ IPADDRESS ETHERADDRESS _ ETHERADDRESS TIMER _ (SETUPTIMER \AR.VALID.TIMEOUT.INTERVAL) RECENT _ T]) (\AR.NOTE.RESOLUTION [LAMBDA (AR) (* ; "Edited 21-Dec-88 20:11 by Briggs") (* ;;; "Use the information in the AR to update any existing entry in the cache, and if this was a response (presumably to our query) add the new information.") [COND ((NOT (AND (EQ (fetch (ARETHER ARLCLHDW0) of AR) 0) (EQ (fetch (ARETHER ARLCLHDW1) of AR) 0) (EQ (fetch (ARETHER ARLCLHDW2) of AR) 0))) (\AR.ENTER.RESOLUTION (fetch (ARETHER ARLCLPTCL) of AR) (fetch (ARETHER ARSENDERHDW) of AR) (NOT (MEMBER (fetch (ARETHER ARFRNPTCL) of AR) \IP.LOCAL.ADDRESSES] (COND ([AND (EQ (fetch (AR AROPCODE) of AR) \AR.RESPONSE) (NOT (AND (EQ (fetch (ARETHER ARFRNHDW0) of AR) 0) (EQ (fetch (ARETHER ARFRNHDW1) of AR) 0) (EQ (fetch (ARETHER ARFRNHDW2) of AR) 0] (\AR.ENTER.RESOLUTION (fetch (ARETHER ARFRNPTCL) of AR) (fetch (ARETHER ARTARGETHDW) of AR]) (\AR.UPDATE.RESOLUTION [LAMBDA (ARENTRY) (* ; "Edited 21-Dec-88 18:27 by Briggs") (* ;;; "Called when a resolution is no longer recent. Does ARP requests to update our cache. Eventually, the entry is marked invalid and is removed") (COND [(TIMEREXPIRED? (fetch (ARENTRY TIMER) of ARENTRY)) (COND ((ffetch (ARENTRY RECENT) of ARENTRY) (freplace (ARENTRY RECENT) of ARENTRY with NIL) (freplace (ARENTRY SEARCHING) of ARENTRY with T) (freplace (ARENTRY TIMER) of ARENTRY with (SETUPTIMER \AR.SEARCH.TIMEOUT.INTERVAL (ffetch (ARENTRY TIMER) of ARENTRY))) (* ;;  "ask the system in the table to respond to avoid clogging the net with broadcasts") (\AR.REQUEST.IP.TO.10MB (ffetch (ARENTRY IPADDRESS) of ARENTRY) (ffetch (ARENTRY ETHERADDRESS) of ARENTRY))) ((ffetch (ARENTRY SEARCHING) of ARENTRY) (SETQ \AR.IP.TO.10MB.ALIST (DREMOVE ARENTRY \AR.IP.TO.10MB.ALIST] ((ffetch (ARENTRY SEARCHING) of ARENTRY) (\AR.REQUEST.IP.TO.10MB (ffetch (ARENTRY IPADDRESS) of ARENTRY) (ffetch (ARENTRY ETHERADDRESS) of ARENTRY]) (\PRINTAR [LAMBDA (AR CALLER FILE) (* ejs%: " 2-Jun-85 13:58") (PROG NIL (SELECTC (fetch (ETHERPACKET EPTYPE) of AR) (\EPT.AR NIL) (3 (RETURN)) (RETURN)) (COND ((AND (EQ (fetch (AR ARHARDWARESPACE) of AR) \AR.HARDWARE.SPACE.ETHERNET) (EQ (fetch (AR ARHARDWARELEN) of AR) \AR.ETHERNET.ADDRESS.LENGTH) (EQ (fetch (AR ARPROTOCOLSPACE) of AR) \EPT.IP) (EQ (fetch (AR ARPROTOCOLLEN) of AR) \AR.IP.ADDRESS.LENGTH)) (printout FILE CALLER ": Address resolution " (SELECTC (fetch (AR AROPCODE) of AR) (\AR.REQUEST "request.") (\AR.RESPONSE "response.") "unknown opcode.") T "Sender's protocol address is " (\IP.ADDRESS.TO.STRING (fetch (ARETHER ARLCLPTCL) of AR)) "." T "Sender's hardware address is " (fetch (ARETHER ARSENDERHDW) of AR) "." T) (SELECTC (fetch (AR AROPCODE) of AR) (\AR.REQUEST (printout FILE "Sender desires hardware address for " (\IP.ADDRESS.TO.STRING (fetch (ARETHER ARFRNPTCL) of AR)) T)) (\AR.RESPONSE (printout FILE "Sender says hardware address for " (\IP.ADDRESS.TO.STRING (fetch (ARETHER ARFRNPTCL) of AR)) T " is " (fetch (ARETHER ARTARGETHDW) of AR) T)) NIL))) (TERPRI FILE]) (SPUTASSOC [LAMBDA (KEY VAL ALIST) (* ejs%: "27-Dec-84 17:52") (PROG (OLDENTRY) [COND ([SETQ OLDENTRY (for ENTRY in ALIST thereis (EQUAL KEY (CAR ENTRY] (RPLACD OLDENTRY VAL)) (T (NCONC1 ALIST (CONS KEY VAL] (RETURN VAL]) (\AR.TRANSLATE.TO.10MB [LAMBDA (IPADDRESS DONTPROBE) (* ; "Edited 21-Dec-88 20:11 by Briggs") (* ;;; "Translate an IPADDRESS to a 10MBHOSTNUMBER, or initiate request and fail for now") (COND ((\IP.BROADCAST.ADDRESS IPADDRESS) BROADCASTNSHOSTNUMBER) [(bind FOUNDIT find ENTRY in \AR.IP.TO.10MB.ALIST suchthat (AND (EQUAL IPADDRESS (fetch (ARENTRY IPADDRESS) of ENTRY)) (SETQ FOUNDIT T)) finally (COND (FOUNDIT (RETURN (ffetch (ARENTRY ETHERADDRESS ) of ENTRY] ((NOT DONTPROBE) (\AR.REQUEST.IP.TO.10MB IPADDRESS) NIL]) (\AR.REQUEST.IP.TO.10MB [LAMBDA (IPADDRESS PDH) (* ; "Edited 21-Dec-88 18:31 by Briggs") (* ;;; "Request an address translation, either from the specified host, or by broadcasting the request.") (PROG ((AR (\ALLOCATE.ETHERPACKET))) (replace (AR ARHARDWARESPACE) of AR with \AR.HARDWARE.SPACE.ETHERNET) (replace (AR ARPROTOCOLSPACE) of AR with \EPT.IP) (replace (AR ARHARDWARELEN) of AR with \AR.ETHERNET.ADDRESS.LENGTH) (replace (AR ARPROTOCOLLEN) of AR with \AR.IP.ADDRESS.LENGTH) (replace (AR AROPCODE) of AR with \AR.REQUEST) (replace (ARETHER ARSENDERHDW) of AR with \MY.NSHOSTNUMBER) (replace (ARETHER ARLCLPTCL) of AR with (ffetch (NDB NDBIPHOST#) of \10MBLOCALNDB)) (replace (ARETHER ARFRNPTCL) of AR with IPADDRESS) (replace (ETHERPACKET EPTYPE) of AR with \EPT.AR) (ENCAPSULATE.ETHERPACKET \10MBLOCALNDB AR (OR PDH BROADCASTNSHOSTNUMBER) \AR.ETHER.PACKET.LENGTH \EPT.AR) (COND ((EQ IPTRACEFLG T) (PRINTPACKET AR 'PUT IPTRACEFILE)) (IPTRACEFLG (PRIN1 (COND (PDH "!") (T "^")) IPTRACEFILE))) (TRANSMIT.ETHERPACKET \10MBLOCALNDB AR]) (\AR.REQUEST.IP.TO.3MB [LAMBDA (IPADDRESS) (* ejs%: " 2-Jan-85 17:12") (* * Broadcast a request for an address translation) (PROG ((AR (\ALLOCATE.ETHERPACKET))) (replace (AR ARHARDWARESPACE) of AR with \AR.HARDWARE.SPACE.ETHERNET) (replace (AR ARPROTOCOLSPACE) of AR with \EET.IP) (replace (AR ARHARDWARELEN) of AR with 2) (replace (AR ARPROTOCOLLEN) of AR with \AR.IP.ADDRESS.LENGTH) (replace (AR AROPCODE) of AR with \AR.REQUEST) (replace (AREXPETHER ARLCLHDW) of AR with (LOGAND \LOCALPUPNETHOST (MASK.1'S 0 8))) (replace (AREXPETHER ARLCLPTCL) of AR with (ffetch (NDB NDBIPHOST#) of \3MBLOCALNDB)) (replace (AREXPETHER ARFRNPTCL) of AR with IPADDRESS) (ENCAPSULATE.ETHERPACKET \3MBLOCALNDB AR 0 20 \EPT.AR) (COND (IPTRACEFLG (PRINTPACKET AR 'PUT IPTRACEFILE))) (TRANSMIT.ETHERPACKET \3MBLOCALNDB AR]) (\AR.RESOLVE [LAMBDA (AR) (* ; "Edited 6-Jan-89 14:50 by Briggs") (* ;;; "Try to respond to an address resolution request. Release the packet if we can't") (DECLARE (GLOBALVARS \10MBLOCALNDB \MY.NSHOSTNUMBER)) (LET* ((TargetProtocolAddress (fetch (ARETHER ARFRNPTCL) of AR)) (TargetHardwareAddress (COND ((MEMBER TargetProtocolAddress \IP.LOCAL.ADDRESSES) (\AR.ENTER.RESOLUTION TargetProtocolAddress \MY.NSHOSTNUMBER) \MY.NSHOSTNUMBER) ([AND \IP.GATEWAY.FLG (LET* ((SUBNETMASK (CDR (SASSOC (fetch NDBIPHOST# of \10MBLOCALNDB) \IP.SUBNET.MASKS))) (MASKEDTARGET (LOGAND TargetProtocolAddress SUBNETMASK))) (COND ([AND SUBNETMASK (NOT (EQP MASKEDTARGET (LOGAND (fetch NDBIPHOST# of \10MBLOCALNDB) SUBNETMASK] (for ADDRPAIR in \IP.ROUTING.TABLE when (LISTP ADDRPAIR) thereis (EQP MASKEDTARGET (CAR ADDRPAIR] \MY.NSHOSTNUMBER))) (SenderHardwareAddress (fetch (ARETHER ARSENDERHDW) of AR))) (COND (TargetHardwareAddress (swap (fetch (ARETHER ARLCLPTCL) of AR) (fetch (ARETHER ARFRNPTCL) of AR)) (replace (ARETHER ARTARGETHDW) of AR with (fetch (ARETHER ARSENDERHDW ) of AR)) (replace (ARETHER ARSENDERHDW) of AR with TargetHardwareAddress) (replace (ARETHER ARLCLPTCL) of AR with TargetProtocolAddress) (replace (AR AROPCODE) of AR with \AR.RESPONSE) (ENCAPSULATE.ETHERPACKET \10MBLOCALNDB AR SenderHardwareAddress \AR.ETHER.PACKET.LENGTH \EPT.AR) [COND (IPTRACEFLG (COND ((EQ IPTRACEFLG T) (PRINTPACKET AR 'PUT IPTRACEFILE)) (T (PRIN1 "!" IPTRACEFILE] (TRANSMIT.ETHERPACKET \10MBLOCALNDB AR)) (T (\RELEASE.ETHERPACKET AR]) (\AR.TRANSLATE.TO.3MB [LAMBDA (IPADDRESS) (* ejs%: "27-Jun-85 12:43") (COND ((\IP.BROADCAST.ADDRESS IPADDRESS) 0) (T (LDB (BYTE 8 0) IPADDRESS]) (\HANDLE.RAW.AR [LAMBDA (AR TYPE) (* ejs%: " 2-Jun-85 14:12") (PROG ((NDB (ffetch (ETHERPACKET EPNETWORK) of AR))) (SELECTQ (ffetch (NDB NETTYPE) of NDB) (10 (COND ((NEQ TYPE \EPT.AR) (RETURN)))) (3 (RETURN)) (ERROR "Unknown net type" (fetch (NDB NETTYPE) of NDB))) [COND ((AND (EQ (fetch (AR ARHARDWARESPACE) of AR) \AR.HARDWARE.SPACE.ETHERNET) (EQ (fetch (AR ARHARDWARELEN) of AR) \AR.ETHERNET.ADDRESS.LENGTH) (EQ (fetch (AR ARPROTOCOLSPACE) of AR) \EPT.IP) (EQ (fetch (AR ARPROTOCOLLEN) of AR) \AR.IP.ADDRESS.LENGTH)) [COND (IPTRACEFLG (COND ((EQ IPTRACEFLG T) (PRINTPACKET AR 'ARGET IPTRACEFILE)) (T (PRIN1 "*" IPTRACEFILE] (\AR.NOTE.RESOLUTION AR) (COND ((EQ (fetch (AR AROPCODE) of AR) \AR.REQUEST) (\AR.RESOLVE AR)) (T (\RELEASE.ETHERPACKET AR] (RETURN T]) ) (ADDTOVAR \PACKET.PRINTERS (2054 . \PRINTAR)) (PUTPROPS TCPLLAR COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (5949 22633 (\AR.DAEMON 5959 . 6223) (\AR.ENTER.RESOLUTION 6225 . 7972) ( \AR.NOTE.RESOLUTION 7974 . 9329) (\AR.UPDATE.RESOLUTION 9331 . 10916) (\PRINTAR 10918 . 13356) ( SPUTASSOC 13358 . 13700) (\AR.TRANSLATE.TO.10MB 13702 . 14709) (\AR.REQUEST.IP.TO.10MB 14711 . 16270) (\AR.REQUEST.IP.TO.3MB 16272 . 17510) (\AR.RESOLVE 17512 . 20996) (\AR.TRANSLATE.TO.3MB 20998 . 21232) (\HANDLE.RAW.AR 21234 . 22631))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPLLICMP b/obsolete/tcp/TCPLLICMP new file mode 100644 index 00000000..62f1f4bb --- /dev/null +++ b/obsolete/tcp/TCPLLICMP @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "17-Aug-90 12:34:42" {DSK}ETHERNET>TCP>NEW>TCPLLICMP.;2 20237 changes to%: (FNS PRINTICMP \ICMP.HANDLE.REDIRECT \ICMP.INPUT) previous date%: " 6-Jan-89 16:38:06" {DSK}ETHERNET>TCP>NEW>TCPLLICMP.;1) (* " Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPLLICMPCOMS) (RPAQQ TCPLLICMPCOMS [(COMS (* * ICMP functions) (DECLARE%: DONTCOPY (EXPORT (RECORDS ICMPADMASK ICMP ICMPECHO ICMPDESTUN ICMPREDIRECT) (CONSTANTS * ICMPTYPES) (CONSTANTS * ICMPUNREACHABLES) (CONSTANTS * ICMPREDIRECTS) (CONSTANTS \ICMPOVLEN) (CONSTANTS \ICMP.PROTOCOL) (MACROS ICMPLENGTH))) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS IP.FROM.ICMP)) (INITVARS * ICMPTIMEXS) (INITVARS (\ICMP.ECHO.REPLY.QUEUE (NCREATE 'SYSQUEUE)) (\ICMP.ECHO.REPLY.EVENT (CREATE.EVENT "ICMP Echo reply")) (\ICMP.ECHOING)) (GLOBALVARS \ICMP.ECHO.REPLY.QUEUE \ICMP.ECHO.REPLY.EVENT \ICMP.ECHOING) (FNS PRINTICMP \ICMP.DEST.UNREACHABLE \ICMP.REDIRECT \ICMP.ECHO.TEST \ICMP.HANDLE.ECHO.REPLY \ICMP.HANDLE.REDIRECT \ICMP.INPUT \ICMP.REPLY.TO.ECHO \ICMP.SETUPICMP \ICMP.TIME.EXCEEDED \ICMP.TRANSMIT) (FNS ICMP.HANDLE.ADDRESS.MASK \ICMP.INPUT \ICMP.REQUEST.ADDRESS.MASK) (ADDVARS (IPPRINTMACROS (1 . PRINTICMP]) (* * ICMP functions) (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (ACCESSFNS ICMPADMASK ((ICMPADMASKBASE (fetch (ICMP ICMPCONTENTS) of DATUM))) (BLOCKRECORD ICMPADMASKBASE ((ICMPADMASKID WORD) (ICMPADMASKSEQNO WORD) (ICMPADMASKADMASK FIXP)))) (ACCESSFNS ICMP ((ICMPBASE (\IPDATABASE DATUM))) (BLOCKRECORD ICMPBASE ((ICMPTYPE BYTE) (ICMPCODE BYTE) (ICMPCHECKSUM WORD) (ICMPDATASTART WORD))) [ACCESSFNS ICMP ((ICMPCONTENTS (LOCF (fetch (ICMP ICMPDATASTART) of DATUM]) (ACCESSFNS ICMPECHO ((ICMPECHOBASE (fetch (ICMP ICMPCONTENTS) of DATUM))) (BLOCKRECORD ICMPECHOBASE ((ICMPECHOID WORD) (ICMPECHOSEQNO WORD) (ICMPECHODATA BYTE)))) (ACCESSFNS ICMPDESTUN ((ICMPECHOBASE (fetch (ICMP ICMPCONTENTS) of DATUM))) (BLOCKRECORD ICMPECHOBASE ((NIL FIXP) (ICMPIPSTART WORD))) [ACCESSFNS ICMPDESTUN ((ICMPIPHEADER (LOCF (fetch (ICMPDESTUN ICMPIPSTART) of DATUM]) (ACCESSFNS ICMPREDIRECT ((ICMPREDIRECTBASE (fetch (ICMP ICMPCONTENTS) of DATUM))) (BLOCKRECORD ICMPREDIRECTBASE ((ICMPGATEWAY FIXP) (ICMPIPSTART WORD))) [ACCESSFNS ICMPREDIRECT ((ICMPIPHEADER (LOCF (fetch (ICMPREDIRECT ICMPIPSTART) of DATUM]) ) (RPAQQ ICMPTYPES ((\ICMP.ECHO.REPLY 0) (\ICMP.DEST.UNREACHABLE 3) (\ICMP.SOURCE.QUENCH 4) (\ICMP.REDIRECT 5) (\ICMP.ECHO 8) (\ICMP.TIME.EXCEEDED 11) (\ICMP.PARAMETER.PROBLEM 12) (\ICMP.TIMESTAMP 13) (\ICMP.TIMESTAMP.REPLY 14) (\ICMP.INFO.REQUEST 15) (\ICMP.INFO.REPLY 16) (\ICMP.ADDRESS.MASK.REQUEST 17) (\ICMP.ADDRESS.MASK.REPLY 18))) (DECLARE%: EVAL@COMPILE (RPAQQ \ICMP.ECHO.REPLY 0) (RPAQQ \ICMP.DEST.UNREACHABLE 3) (RPAQQ \ICMP.SOURCE.QUENCH 4) (RPAQQ \ICMP.REDIRECT 5) (RPAQQ \ICMP.ECHO 8) (RPAQQ \ICMP.TIME.EXCEEDED 11) (RPAQQ \ICMP.PARAMETER.PROBLEM 12) (RPAQQ \ICMP.TIMESTAMP 13) (RPAQQ \ICMP.TIMESTAMP.REPLY 14) (RPAQQ \ICMP.INFO.REQUEST 15) (RPAQQ \ICMP.INFO.REPLY 16) (RPAQQ \ICMP.ADDRESS.MASK.REQUEST 17) (RPAQQ \ICMP.ADDRESS.MASK.REPLY 18) (CONSTANTS (\ICMP.ECHO.REPLY 0) (\ICMP.DEST.UNREACHABLE 3) (\ICMP.SOURCE.QUENCH 4) (\ICMP.REDIRECT 5) (\ICMP.ECHO 8) (\ICMP.TIME.EXCEEDED 11) (\ICMP.PARAMETER.PROBLEM 12) (\ICMP.TIMESTAMP 13) (\ICMP.TIMESTAMP.REPLY 14) (\ICMP.INFO.REQUEST 15) (\ICMP.INFO.REPLY 16) (\ICMP.ADDRESS.MASK.REQUEST 17) (\ICMP.ADDRESS.MASK.REPLY 18)) ) (RPAQQ ICMPUNREACHABLES ((\ICMP.NET.UNREACHABLE 0) (\ICMP.HOST.UNREACHABLE 1) (\ICMP.PROTOCOL.UNREACHABLE 2) (\ICMP.PORT.UNREACHABLE 3) (\ICMP.CANT.FRAGMENT 4) (\ICMP.SOURCE.ROUTE 5))) (DECLARE%: EVAL@COMPILE (RPAQQ \ICMP.NET.UNREACHABLE 0) (RPAQQ \ICMP.HOST.UNREACHABLE 1) (RPAQQ \ICMP.PROTOCOL.UNREACHABLE 2) (RPAQQ \ICMP.PORT.UNREACHABLE 3) (RPAQQ \ICMP.CANT.FRAGMENT 4) (RPAQQ \ICMP.SOURCE.ROUTE 5) (CONSTANTS (\ICMP.NET.UNREACHABLE 0) (\ICMP.HOST.UNREACHABLE 1) (\ICMP.PROTOCOL.UNREACHABLE 2) (\ICMP.PORT.UNREACHABLE 3) (\ICMP.CANT.FRAGMENT 4) (\ICMP.SOURCE.ROUTE 5)) ) (RPAQQ ICMPREDIRECTS ((\ICMP.REDIRECT.NET 0) (\ICMP.REDIRECT.HOST 1) (\ICMP.REDIRECT.SVC.AND.NET 2) (\ICMP.REDIRECT.SVC.AND.HOST 3))) (DECLARE%: EVAL@COMPILE (RPAQQ \ICMP.REDIRECT.NET 0) (RPAQQ \ICMP.REDIRECT.HOST 1) (RPAQQ \ICMP.REDIRECT.SVC.AND.NET 2) (RPAQQ \ICMP.REDIRECT.SVC.AND.HOST 3) (CONSTANTS (\ICMP.REDIRECT.NET 0) (\ICMP.REDIRECT.HOST 1) (\ICMP.REDIRECT.SVC.AND.NET 2) (\ICMP.REDIRECT.SVC.AND.HOST 3)) ) (DECLARE%: EVAL@COMPILE (RPAQQ \ICMPOVLEN 4) (CONSTANTS \ICMPOVLEN) ) (DECLARE%: EVAL@COMPILE (RPAQQ \ICMP.PROTOCOL 1) (CONSTANTS \ICMP.PROTOCOL) ) (DECLARE%: EVAL@COMPILE [PUTPROPS ICMPLENGTH MACRO (LAMBDA (ICMP) (IDIFFERENCE (fetch (IP IPTOTALLENGTH) of ICMP) (LLSH (fetch (IP IPHEADERLENGTH) of ICMP) 2] ) (* "END EXPORTED DEFINITIONS") ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE [PUTPROPS IP.FROM.ICMP MACRO (OPENLAMBDA (PKT) (* ;; "Returns a pointer to the 'Internet header + 64 bits' found in an ICMP packet, offset so that it looks like an IP record. I.e., add to the base the size of the IP header + ICMP header") (\ADDBASE PKT (+ (UNFOLD (fetch (IP IPHEADERLENGTH) of PKT) WORDSPERCELL) (CONSTANT (+ (FOLDHI \ICMPOVLEN BYTESPERWORD) 2] ) ) (RPAQQ ICMPTIMEXS ((\ICMP.TRANSIT.TIME.EXCEEDED 0) (\ICMP.FRAGMENT.TIME.EXCEEDED 1))) (RPAQ? \ICMP.TRANSIT.TIME.EXCEEDED 0) (RPAQ? \ICMP.FRAGMENT.TIME.EXCEEDED 1) (RPAQ? \ICMP.ECHO.REPLY.QUEUE (NCREATE 'SYSQUEUE)) (RPAQ? \ICMP.ECHO.REPLY.EVENT (CREATE.EVENT "ICMP Echo reply")) (RPAQ? \ICMP.ECHOING ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \ICMP.ECHO.REPLY.QUEUE \ICMP.ECHO.REPLY.EVENT \ICMP.ECHOING) ) (DEFINEQ (PRINTICMP [LAMBDA (ICMP FILE) (* ; "Edited 13-Sep-88 11:35 by bvm") (LET ((*PRINT-BASE* 10) (TYPE (fetch (ICMP ICMPTYPE) of ICMP)) (CODE (fetch (ICMP ICMPCODE) of ICMP))) (PRINTCONSTANT TYPE ICMPTYPES FILE "\ICMP.") (SPACES 1 FILE) (SELECTC TYPE (\ICMP.REDIRECT (PRINTCONSTANT CODE ICMPREDIRECTS FILE "\ICMP.REDIRECT.") (PRINTOUT FILE " " (\IP.ADDRESS.TO.STRING (fetch (ICMPREDIRECT ICMPGATEWAY) of ICMP)))) (\ICMP.DEST.UNREACHABLE (PRINTCONSTANT CODE ICMPUNREACHABLES FILE "\ICMP.")) (PRIN3 CODE FILE)) (TERPRI FILE]) (\ICMP.DEST.UNREACHABLE (LAMBDA (PACKET CODE) (* ejs%: " 2-Feb-86 11:35") (* * Returns an ICMP unreachable packet of proper code to sender) (PROG ((ICMP (\ALLOCATE.ETHERPACKET)) NWORDS) (\IP.SETUPIP ICMP (fetch (IP IPSOURCEADDRESS) of PACKET) 0 (\IP.FIND.PROTOCOL \ICMP.PROTOCOL)) (\ICMP.SETUPICMP ICMP \ICMP.DEST.UNREACHABLE CODE) (SETQ NWORDS (IPLUS (FOLDHI 64 BITSPERWORD) (UNFOLD (fetch (IP IPHEADERLENGTH) of PACKET) WORDSPERCELL))) (\BLT (fetch (ICMPDESTUN ICMPIPHEADER) of ICMP) (fetch (IP IPBASE) of PACKET) NWORDS) (add (fetch (IP IPTOTALLENGTH) of ICMP) (UNFOLD NWORDS BYTESPERWORD)) (\ICMP.TRANSMIT ICMP) (\RELEASE.ETHERPACKET PACKET))) ) (\ICMP.REDIRECT (LAMBDA (PACKET CODE) (* ejs%: " 2-Feb-86 12:13") (* * Returns an ICMP unreachable packet of proper code to sender) (PROG ((ICMP (\ALLOCATE.ETHERPACKET)) NWORDS) (\IP.SETUPIP ICMP (fetch (IP IPSOURCEADDRESS) of PACKET) 0 (\IP.FIND.PROTOCOL \ICMP.PROTOCOL)) (\ICMP.SETUPICMP ICMP \ICMP.REDIRECT CODE) (SETQ NWORDS (IPLUS (FOLDHI 64 BITSPERWORD) (UNFOLD (fetch (IP IPHEADERLENGTH) of PACKET) WORDSPERCELL) WORDSPERCELL)) (replace (ICMPREDIRECT ICMPGATEWAY) of ICMP with (OR \IP.DEFAULT.GATEWAY 0)) (\BLT (fetch (ICMPREDIRECT ICMPIPHEADER) of ICMP) (fetch (IP IPBASE) of PACKET) NWORDS) (add (fetch (IP IPTOTALLENGTH) of ICMP) (UNFOLD NWORDS BYTESPERWORD)) (\ICMP.TRANSMIT ICMP) (\RELEASE.ETHERPACKET PACKET))) ) (\ICMP.ECHO.TEST (LAMBDA (IPADDRESS ECHOSTREAM DATALENGTH) (* ejs%: "12-May-86 18:01") (* * An ICMP echo tester) (while (\QUEUEHEAD \ICMP.ECHO.REPLY.QUEUE) do (\RELEASE.ETHERPACKET (\DEQUEUE \ICMP.ECHO.REPLY.QUEUE))) (RESETVAR \ICMP.ECHOING T (PROG (ICMP (IPSOCKET (\IP.FIND.PROTOCOL \ICMP.PROTOCOL))) (for SEQUENCE from 0 do ((SETQ ICMP (\ALLOCATE.ETHERPACKET)) (\IP.SETUPIP ICMP (DODIP.HOSTP IPADDRESS) 0 IPSOCKET) (\ICMP.SETUPICMP ICMP \ICMP.ECHO 0) (replace (ICMPECHO ICMPECHOID) of ICMP with 0) (replace (ICMPECHO ICMPECHOSEQNO) of ICMP with SEQUENCE) (add (fetch (IP IPTOTALLENGTH) of ICMP) 4) (AND (NUMBERP DATALENGTH) (add (fetch (IP IPTOTALLENGTH) of ICMP) DATALENGTH)) (printout ECHOSTREAM "!") (\ICMP.TRANSMIT ICMP) (AWAIT.EVENT \ICMP.ECHO.REPLY.EVENT \ETHERTIMEOUT) (COND ((SETQ ICMP (\DEQUEUE \ICMP.ECHO.REPLY.QUEUE)) (COND ((IGREATERP (fetch (ICMPECHO ICMPECHOSEQNO) of ICMP) SEQUENCE) (printout T "ICMP echo out of sequence" T) (PRINTPACKET ICMP (QUOTE GET) ECHOSTREAM) (RETURN ICMP)) (T (printout ECHOSTREAM "+") (\RELEASE.ETHERPACKET ICMP)))) (T (printout ECHOSTREAM ".")))))))) ) (\ICMP.HANDLE.ECHO.REPLY (LAMBDA (ICMP) (* ejs%: "28-Dec-84 09:02") (COND (\ICMP.ECHOING (\ENQUEUE \ICMP.ECHO.REPLY.QUEUE ICMP) (NOTIFY.EVENT \ICMP.ECHO.REPLY.EVENT)) (T (\RELEASE.ETHERPACKET ICMP)))) ) (\ICMP.HANDLE.REDIRECT [LAMBDA (ICMP) (* ; "Edited 24-Aug-88 16:16 by bvm") (* ;;; "Called when a gateway tells us a better route to the destination. There is a code for type of redirect, but it's not obviously meaningful ") (LET* ((NDB (fetch EPNETWORK of ICMP)) (GATEWAY (fetch (ICMPREDIRECT ICMPGATEWAY) of ICMP)) (DESTADDRESS (fetch (IP IPDESTINATIONADDRESS) of (IP.FROM.ICMP ICMP))) (DESTNET (\IPNETADDRESS DESTADDRESS))) (* ;; "Store the new route in the routing table") (COND [(= DESTNET (fetch (NDB NDBIPNET#) of NDB)) (LET* ((SOURCEADDRESS (fetch (NDB NDBIPHOST#) of NDB)) (SUBNETMASK (CDR (SASSOC SOURCEADDRESS \IP.SUBNET.MASKS))) (DESTSUBNET (LOGAND DESTADDRESS SUBNETMASK))) (* ;; "The dest net is a local net. Either we fouled up in our routing, or the dest net is really a subnet") (COND ((NOT (= DESTSUBNET (LOGAND SOURCEADDRESS SUBNETMASK))) (* ;  "Yes, this is a redirect for a subnet, if such is possible") (SPUTASSOC DESTSUBNET GATEWAY \IP.ROUTING.TABLE] (T (* ; "Non-local net") (SPUTASSOC DESTNET GATEWAY \IP.ROUTING.TABLE))) (* ;; "If it's a 10MB network, see if we have the 10MB address of this gateway, and if not, request the address") (SELECTQ (fetch (NDB NETTYPE) of NDB) (10 (COND ((NOT (\AR.TRANSLATE.TO.10MB GATEWAY T)) (\AR.TRANSLATE.TO.10MB GATEWAY)))) NIL) (\RELEASE.ETHERPACKET ICMP]) (\ICMP.INPUT [LAMBDA (ICMP) (* ; "Edited 25-Aug-88 11:51 by bvm") (* ;;; "ICMP packet received") (COND ((\IP.CHECKSUM.OK (\IPCHECKSUM ICMP (fetch (ICMP ICMPBASE) of ICMP) (\IPDATALENGTH ICMP))) (SELECTC (fetch (ICMP ICMPTYPE) of ICMP) (\ICMP.ECHO.REPLY (\ICMP.HANDLE.ECHO.REPLY ICMP)) (\ICMP.ECHO (\ICMP.REPLY.TO.ECHO ICMP)) (\ICMP.DEST.UNREACHABLE (* ; "Some packet couldn't reach its destination. Tell the protocol that sent the packet (found in the enclosed header)") [LET* [(SEGMENT (IP.FROM.ICMP ICMP)) (PROTOCOL (\IP.FIND.PROTOCOL (fetch (IP IPPROTOCOL) of SEGMENT] (COND (PROTOCOL (CL:FUNCALL (fetch (IPSOCKET IPSICMPFN) of PROTOCOL) ICMP SEGMENT PROTOCOL]) (\ICMP.REDIRECT (\ICMP.HANDLE.REDIRECT ICMP)) (\ICMP.ADDRESS.MASK.REPLY (ICMP.HANDLE.ADDRESS.MASK ICMP)) (\RELEASE.ETHERPACKET ICMP))) (T (AND IPTRACEFLG (PRINTPACKET ICMP 'ICMPGET IPTRACEFILE "[dropping packet--bad ICMP checksum]"]) (\ICMP.REPLY.TO.ECHO (LAMBDA (ICMP) (* ejs%: "12-May-86 17:34") (* * Reply to an echo request) (swap (fetch (IP IPSOURCEADDRESS) of ICMP) (fetch (IP IPDESTINATIONADDRESS) of ICMP)) (replace (ICMP ICMPTYPE) of ICMP with \ICMP.ECHO.REPLY) (replace EPREQUEUE of ICMP with (QUOTE FREE)) (\ICMP.TRANSMIT ICMP)) ) (\ICMP.SETUPICMP (LAMBDA (ICMP TYPE CODE) (* ejs%: "27-Dec-84 19:00") (replace (ICMP ICMPTYPE) of ICMP with TYPE) (replace (ICMP ICMPCODE) of ICMP with CODE) (add (fetch (IP IPTOTALLENGTH) of ICMP) \ICMPOVLEN)) ) (\ICMP.TIME.EXCEEDED (LAMBDA (PACKET CODE) (* ejs%: " 3-Feb-86 11:00") (* * Returns an ICMP unreachable packet of proper code to sender) (PROG ((ICMP (\ALLOCATE.ETHERPACKET)) NWORDS) (\IP.SETUPIP ICMP (fetch (IP IPSOURCEADDRESS) of PACKET) 0 (\IP.FIND.PROTOCOL \ICMP.PROTOCOL)) (\ICMP.SETUPICMP ICMP \ICMP.TIME.EXCEEDED CODE) (SETQ NWORDS (IPLUS (FOLDHI 64 BITSPERWORD) (UNFOLD (fetch (IP IPHEADERLENGTH) of PACKET) WORDSPERCELL))) (\BLT (fetch (ICMPDESTUN ICMPIPHEADER) of ICMP) (fetch (IP IPBASE) of PACKET) NWORDS) (add (fetch (IP IPTOTALLENGTH) of ICMP) (UNFOLD NWORDS BYTESPERWORD)) (\ICMP.TRANSMIT ICMP))) ) (\ICMP.TRANSMIT (LAMBDA (ICMP) (* ejs%: "31-Dec-84 14:27") (* * Checksum and transmit an ICMP packet) (\IP.SET.CHECKSUM ICMP (fetch (ICMP ICMPBASE) of ICMP) (\IPDATALENGTH ICMP) (LOCF (fetch (ICMP ICMPCHECKSUM) of ICMP))) (\IP.TRANSMIT ICMP)) ) ) (DEFINEQ (ICMP.HANDLE.ADDRESS.MASK (LAMBDA (ICMP) (* ; "Edited 22-Mar-88 18:49 by eweaver") (* ;; "Called when an address-mask-reply icmp comes in.") (LET* ((FROM (fetch (IP IPSOURCEADDRESS) of ICMP)) (DESTADDR (fetch (IP IPDESTINATIONADDRESS) of ICMP)) (LOCALADDR (COND ((AND \3MBLOCALNDB (EQ (fetch NDBIPHOST# of \3MBLOCALNDB) DESTADDR)) DESTADDR) ((AND \10MBLOCALNDB (EQ (fetch NDBIPHOST# of \10MBLOCALNDB) DESTADDR)) DESTADDR))) (MASK (fetch (ICMPADMASK ICMPADMASKADMASK) of ICMP))) (* ;; (CL:FORMAT PROMPTWINDOW "ICMP AdMask from ~a mask ~a" (\IP.ADDRESS.TO.STRING FROM) (\IP.ADDRESS.TO.STRING MASK))) (COND ((NULL \IP.DEFAULT.GATEWAY) (SETQ \IP.DEFAULT.GATEWAY FROM))) (COND ((NULL (SASSOC DESTADDR \IP.SUBNET.MASKS)) (CL:PUSH (CONS DESTADDR MASK) \IP.SUBNET.MASKS))))) ) (\ICMP.INPUT [LAMBDA (ICMP) (* ; "Edited 25-Aug-88 11:51 by bvm") (* ;;; "ICMP packet received") (COND ((\IP.CHECKSUM.OK (\IPCHECKSUM ICMP (fetch (ICMP ICMPBASE) of ICMP) (\IPDATALENGTH ICMP))) (SELECTC (fetch (ICMP ICMPTYPE) of ICMP) (\ICMP.ECHO.REPLY (\ICMP.HANDLE.ECHO.REPLY ICMP)) (\ICMP.ECHO (\ICMP.REPLY.TO.ECHO ICMP)) (\ICMP.DEST.UNREACHABLE (* ; "Some packet couldn't reach its destination. Tell the protocol that sent the packet (found in the enclosed header)") [LET* [(SEGMENT (IP.FROM.ICMP ICMP)) (PROTOCOL (\IP.FIND.PROTOCOL (fetch (IP IPPROTOCOL) of SEGMENT] (COND (PROTOCOL (CL:FUNCALL (fetch (IPSOCKET IPSICMPFN) of PROTOCOL) ICMP SEGMENT PROTOCOL]) (\ICMP.REDIRECT (\ICMP.HANDLE.REDIRECT ICMP)) (\ICMP.ADDRESS.MASK.REPLY (ICMP.HANDLE.ADDRESS.MASK ICMP)) (\RELEASE.ETHERPACKET ICMP))) (T (AND IPTRACEFLG (PRINTPACKET ICMP 'ICMPGET IPTRACEFILE "[dropping packet--bad ICMP checksum]"]) (\ICMP.REQUEST.ADDRESS.MASK (LAMBDA NIL (* ; "Edited 8-Jan-88 15:15 by eweaver") (* ;; "Broadcast a request for the subnet mask. The reply is handled asynchronously by") (* ;; " \handle-icmp-address-mask.") (LET ((ICMP (\ALLOCATE.ETHERPACKET)) (IPSOCKET (\IP.FIND.PROTOCOL \ICMP.PROTOCOL))) (\IP.SETUPIP ICMP 0 0 IPSOCKET) (\ICMP.SETUPICMP ICMP \ICMP.ADDRESS.MASK.REQUEST 0) (replace (ICMPADMASK ICMPADMASKID) of ICMP with 0) (replace (ICMPADMASK ICMPADMASKSEQNO) of ICMP with 0) (add (fetch (IP IPTOTALLENGTH) of ICMP) 4) (\ICMP.TRANSMIT ICMP))) ) ) (ADDTOVAR IPPRINTMACROS (1 . PRINTICMP)) (PUTPROPS TCPLLICMP COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (9098 17355 (PRINTICMP 9108 . 9918) (\ICMP.DEST.UNREACHABLE 9920 . 10573) ( \ICMP.REDIRECT 10575 . 11304) (\ICMP.ECHO.TEST 11306 . 12407) (\ICMP.HANDLE.ECHO.REPLY 12409 . 12615) (\ICMP.HANDLE.REDIRECT 12617 . 14564) (\ICMP.INPUT 14566 . 15953) (\ICMP.REPLY.TO.ECHO 15955 . 16266) (\ICMP.SETUPICMP 16268 . 16484) (\ICMP.TIME.EXCEEDED 16486 . 17103) (\ICMP.TRANSMIT 17105 . 17353)) ( 17356 20085 (ICMP.HANDLE.ADDRESS.MASK 17366 . 18138) (\ICMP.INPUT 18140 . 19527) ( \ICMP.REQUEST.ADDRESS.MASK 19529 . 20083))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPLLIP b/obsolete/tcp/TCPLLIP new file mode 100644 index 00000000..b5ec716b --- /dev/null +++ b/obsolete/tcp/TCPLLIP @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP") (FILECREATED "30-Aug-90 13:46:39" {DSK}TCP>TCPLLIP.;3 151757 changes to%: (VARS TCPLLIPCOMS) previous date%: "29-Aug-90 16:28:12" {DSK}TCP>TCPLLIP.;2) (* ; " Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPLLIPCOMS) (RPAQQ TCPLLIPCOMS ((PROP MAKEFILE-ENVIRONMENT TCPLLIP) (COMS (* ;; "IP definitions and addressing") (DECLARE%: DONTCOPY (EXPORT (RECORDS IP IPSOCKET IPADDRESS) (CONSTANTS \IPOVLEN \MAX.IPDATALENGTH \IP.PROTOCOLVERSION \IP.MAX.EPKTS.ON.QUEUE \IP.DEFAULT.TIME.TO.LIVE \IP.WAKEUP.INTERVAL) (CONSTANTS * IPPACKETTYPES) (CONSTANTS * ICMPUNREACHABLES) (MACROS \IPDATABASE \IPDATALENGTH))) (ADDVARS (*IP-PROTOCOL-NAME-FROM-NUMBER* (17 . "UDP") (6 . "TCP") (1 . "ICMP"))) (GLOBALVARS *IP-PROTOCOL-NAME-FROM-NUMBER*) (* ;; "value in sysout is too small. This is 512-(indexf (fetch epencapsulation))-2. 489 is more correct, but let's leave a word of slop for off-by-ones") (VARS (\10MBPACKETLENGTH 488)) (* ;; "Make it easier to see queuelength without opening up q.") (FNS \SYSQUEUE.DEFPRINT \IPSOCKET.DEFPRINT) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (DEFPRINT 'IPSOCKET '\IPSOCKET.DEFPRINT)) (P (DEFPRINT 'SYSQUEUE '\SYSQUEUE.DEFPRINT] (INITVARS (IPTRACETIME) (IPONLYTYPES) (IPIGNORETYPES) (IPPRINTMACROS) (IPTRACEFLG) (IPTRACEFILE) (\IP.INIT.FILE) (\IP.DEFAULT.CONFIGURATION) (\IP.HOSTNAMES (HASHARRAY 40 1.1)) (\IP.HOSTNUMBERS) (INTERNET.LOCAL.DOMAIN)) (INITRECORDS IP IPSOCKET IPADDRESS) (GLOBALVARS IPTRACEFILE IPTRACEFLG IPIGNORETYPES IPONLYTYPES IPPRINTMACROS \IP.HOSTNAMES \IP.INIT.FILE INTERNET.LOCAL.DOMAIN \IP.DEFAULT.CONFIGURATION \IP.HOSTNUMBERS) (FILES (SYSLOAD) TCPHTE TCPLLICMP TCPLLAR) (ADDVARS (\PACKET.PRINTERS (2048 . PRINTIP))) (FNS \CANONICALIZE.IP.HOSTNAME DODIP.HOSTP IPHOSTADDRESS IPHOSTNAME IPTRACE IPTRACEWINDOW.BUTTONFN PRINTIP PRINTIPDATA \IPADDRESSCLASS \IPEVENTFN \IPHOSTADDRESS \IPNETADDRESS \IP.ADDRESS.TO.STRING \IP.BROADCAST.ADDRESS \IP.LEGAL.ADDRESS \IP.MAKE.BROADCAST.ADDRESS \IP.PRINT.ADDRESS \IP.READ.STRING.ADDRESS \DOMAIN.NAME.QUALIFY.FULLY)) (COMS (* ;; "Startup and shutdown") (INITVARS (*IP-DEFAULT-HOSTS-FILE*) (TCP.ALWAYS.READ.HOSTS.FILE T) (\TCP.LAST.HOSTS.FILE.DATE) (\TCP.LAST.HOSTS.FILE.READ) (\IPFLG) (\IP.READY) (\IP.READY.EVENT (CREATE.EVENT "IP Ready")) (\IP.WAKEUP.TIMER) (IPTRACEFLG) (\IP.WAKEUP.EVENT (CREATE.EVENT "IP Wakeup"))) (GLOBALVARS \IPFLG \IP.READY \IP.READY.EVENT \IP.WAKEUP.TIMER \IP.WAKEUP.EVENT TCP.ALWAYS.READ.HOSTS.FILE \TCP.LAST.HOSTS.FILE.DATE \TCP.LAST.HOSTS.FILE.READ *IP-DEFAULT-HOSTS-FILE*) (FNS STOPIP \IPINIT \IPLISTENER \IP.REINITIALIZE.FROM.SCRATCH \IP.RESTART.FROM.CONFIGURATION \IP.MAYBE.READ.HOSTS.TXT \IP.READ.INIT.FILE \IP.PROMPT.FOR.FILE.NAME) (ADDVARS (RESTARTETHERFNS \IPEVENTFN))) (COMS (* ;; "Early IP reception functions") (DECLARE%: DONTCOPY (EXPORT (CONSTANTS * IPADDRESSTYPES))) (INITVARS (\IP.LOCAL.ADDRESSES) (\IP.SUBNET.MASKS) (\IP.GATEWAY.FLG)) (VARS (\IP.ADDRESS.BOX (\CREATECELL \FIXP))) (GLOBALVARS \IP.LOCAL.ADDRESSES \IP.SUBNET.MASKS \IP.GATEWAY.FLG \IP.ADDRESS.BOX) (MACROS \IP.FIX.DEST.HOST \IP.FIX.DEST.NET \IP.FIX.SOURCE.HOST \IP.FIX.SOURCE.NET) (FNS \HANDLE.RAW.IP \FORWARD.IP \IP.LOCAL.DESTINATION \IPCHECKSUM \IP.CHECKSUM.OK \IP.SET.CHECKSUM)) (COMS (* ;; "Protocol Distribution") (DECLARE%: DONTCOPY (EXPORT (CONSTANTS * IPPROTOCOLTYPES))) (INITVARS (\IP.PROTOCOLS)) (GLOBALVARS \IP.PROTOCOLS) (FNS \IP.HAND.TO.PROTOCOL \IP.DEFAULT.INPUTFN \IP.DEFAULT.NOSOCKETFN \IP.ADD.PROTOCOL \IP.DELETE.PROTOCOL \IP.FIND.PROTOCOL \IP.FIND.PROTOCOL.SOCKET \IP.FIND.SOCKET \IP.OPEN.SOCKET \IP.CLOSE.SOCKET)) (COMS (* ;; "Fragmentation Handling") (DECLARE%: DONTCOPY (EXPORT (RECORDS AssemblyRecord FragmentRecord FragmentID))) (INITVARS (\IP.FRAGMENT.LIST) (\IP.FRAGMENT.LOCK (CREATE.MONITORLOCK "IP Fragment Processing Lock"))) (GLOBALVARS \IP.FRAGMENT.LIST \IP.FRAGMENT.LOCK) (CONSTANTS (\IP.FRAGMENTATION.UNIT 8)) (FNS \HANDLE.RAW.IP.FRAGMENT \IP.NEW.FRAGMENT.LST \IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER \IP.ADD.FRAGMENT \IP.FIND.MATCHING.FRAGMENTS \IP.FRAGMENTED.PACKET \IP.CHECK.REASSEMBLY.TIMEOUTS \IP.DELETE.FRAGMENT \IP.PRINT.FRAGMENT)) (COMS (* ;; "Option Processing") [DECLARE%: DONTCOPY (EXPORT (CONSTANTS * IPOPTIONTYPES) (CONSTANTS (IP.OPTION.NUMBER.BYTESPEC (BYTE 5 0] (FNS \IP.PROCESS.OPTIONS \IP.OPTION.RECORD.ROUTE \IP.OPTION.STRICT.SOURCE.ROUTE \IP.OPTION.TIMESTAMP)) (COMS (* ;; "Packet Transmission and routing") (INITVARS (\IP.ROUTING.TABLE (CONS)) (\IP.DEFAULT.GATEWAY) (\IP.LOCAL.NETWORKS) (\IP.GATEWAY.FORWARDING.FUNCTIONS)) (GLOBALVARS \IP.ROUTING.TABLE \IP.DEFAULT.GATEWAY \IP.LOCAL.NETWORKS \IP.GATEWAY.FORWARDING.FUNCTIONS) (FNS \IP.SETUPIP \IP.TRANSMIT \IP.ROUTE.PACKET) (FNS IP.GET IP.SEND IP.PACKET.WATCHER) (MACROS IP.SEND)) (COMS (* ;; "Client functions for building packets") (FNS \IP.APPEND.BYTE \IP.APPEND.CELL \IP.APPEND.STRING \IP.APPEND.WORD \IP.GET.BYTE \IP.GET.CELL \IP.GET.STRING \IP.GET.WORD \IP.PUT.BYTE \IP.PUT.CELL \IP.PUT.STRING \IP.PUT.WORD) (MACROS \IP.GET.BYTE \IP.GET.CELL \IP.GET.STRING \IP.GET.WORD \IP.PUT.BYTE \IP.PUT.CELL \IP.PUT.STRING \IP.PUT.WORD)) (P (MOVD? 'NILL 'IP.DEFAULT.CONFIGURATION)) (DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS \IP.LOCAL.NETWORKS \IP.DEFAULT.GATEWAY \IP.INIT.FILE \IP.SUBNET.MASKS \PROCESS.AFTEREXIT.EVENT \PROC.READY \AR.IP.TO.10MB.ALIST)))) (PUTPROPS TCPLLIP MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP")) (* ;; "IP definitions and addressing") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (ACCESSFNS IP [(IPBASE (LOCF (fetch (ETHERPACKET EPBODY) of DATUM] [BLOCKRECORD IPBASE ((IPVERSION BITS 4) (* ; "Protocol version") (IPHEADERLENGTH BITS 4) (* ; "Head length, in cells") (IPSERVICE BYTE) (* ; "Service type") (IPTOTALLENGTH WORD) (* ; "Packet length, in bytes") (IPID WORD) (* ; "Packet id") (NIL BITS 1) (IPDONTFRAGMENT FLAG) (* ; "Don't fragment me") (IPMOREFRAGMENTS FLAG)(* ; "Last fragment") (IPFRAGMENTOFFSET BITS 13) (* ; "Fragment position") (IPTIMETOLIVE BYTE) (* ; "Hop limiter") (IPPROTOCOL BYTE) (* ; "Client protocol") (IPHEADERCHECKSUM WORD) (* ; "Header-only checksum") (IPSOURCEADDRESS FIXP) (IPDESTINATIONADDRESS FIXP) (IPOPTIONSSTART BYTE) (* ; "Options or data start here") ) [ACCESSFNS IPSERVICE ((IPSERVICEBASE (LOCF DATUM))) (BLOCKRECORD IPSERVICEBASE ((IPPRECEDENCE BITS 3) (IPDELAY FLAG) (IPTHROUGHPUT FLAG) (IPRELIABILITY FLAG) (NIL BITS 2] [ACCESSFNS IPDESTINATIONADDRESS ((IPDESTBASE (LOCF DATUM))) (ACCESSFNS IPDESTBASE ([IPDESTINATIONNET (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (fetch (IPADDRESS CLASSANET) of DATUM)) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (fetch (IPADDRESS CLASSBNET) of DATUM)) ((EQ \IP.CLASS.C (fetch (IPADDRESS CLASSC) of DATUM)) (fetch (IPADDRESS CLASSCNET) of DATUM)) (T (ERROR "Illegal address class" DATUM))) (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (replace (IPADDRESS CLASSANET) of DATUM with NEWVALUE)) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (replace (IPADDRESS CLASSBNET) of DATUM with NEWVALUE)) ((EQ \IP.CLASS.C (fetch (IPADDRESS CLASSC) of DATUM)) (replace (IPADDRESS CLASSCNET) of DATUM with NEWVALUE)) (T (ERROR "Illegal address class" DATUM] (IPDESTINATIONHOST (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (fetch (IPADDRESS CLASSAHOST) of DATUM)) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (fetch (IPADDRESS CLASSBHOST) of DATUM)) ((EQ \IP.CLASS.C (fetch (IPADDRESS CLASSC) of DATUM)) (fetch (IPADDRESS CLASSCHOST) of DATUM)) (T (ERROR "Illegal address class" DATUM))) (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (replace (IPADDRESS CLASSAHOST) of DATUM with NEWVALUE)) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (replace (IPADDRESS CLASSBHOST) of DATUM with NEWVALUE)) ((EQ \IP.CLASS.C (fetch (IPADDRESS CLASSC) of DATUM)) (replace (IPADDRESS CLASSCHOST) of DATUM with NEWVALUE)) (T (ERROR "Illegal address class" DATUM] (ACCESSFNS IPSOURCEADDRESS ((IPSOURCEBASE (LOCF DATUM))) (ACCESSFNS IPSOURCEBASE ([IPSOURCENET (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (fetch (IPADDRESS CLASSANET) of DATUM)) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (fetch (IPADDRESS CLASSBNET) of DATUM)) ((EQ \IP.CLASS.C (fetch (IPADDRESS CLASSC) of DATUM)) (fetch (IPADDRESS CLASSCNET) of DATUM)) (T (ERROR "Illegal address class" DATUM))) (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (replace (IPADDRESS CLASSANET ) of DATUM with NEWVALUE )) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (replace (IPADDRESS CLASSBNET ) of DATUM with NEWVALUE )) ((EQ \IP.CLASS.C (fetch (IPADDRESS CLASSC) of DATUM)) (replace (IPADDRESS CLASSCNET ) of DATUM with NEWVALUE )) (T (ERROR "Illegal address class" DATUM] (IPSOURCEHOST (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (fetch (IPADDRESS CLASSAHOST) of DATUM)) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (fetch (IPADDRESS CLASSBHOST) of DATUM)) ((EQ \IP.CLASS.C (fetch (IPADDRESS CLASSC) of DATUM)) (fetch (IPADDRESS CLASSCHOST) of DATUM)) (T (ERROR "Illegal address class" DATUM))) (COND ((EQ \IP.CLASS.A (fetch (IPADDRESS CLASSA) of DATUM)) (replace (IPADDRESS CLASSAHOST) of DATUM with NEWVALUE )) ((EQ \IP.CLASS.B (fetch (IPADDRESS CLASSB) of DATUM)) (replace (IPADDRESS CLASSBHOST) of DATUM with NEWVALUE )) ((EQ \IP.CLASS.C (fetch (IPADDRESS CLASSC) of DATUM)) (replace (IPADDRESS CLASSCHOST) of DATUM with NEWVALUE )) (T (ERROR "Illegal address class" DATUM] (TYPE? (type? ETHERPACKET DATUM))) (DATATYPE IPSOCKET ((PROTOCOL BYTE) (IPSLINK POINTER) (* ;  "Other sockets of this protocol type") (NIL BYTE) (IPSQUEUE POINTER) (* ;  "Queue of packets for this protocol") (IPSQUEUELENGTH WORD) (* ; "Count of packets of input queue") (IPSQUEUEALLOC WORD) (* ; "Max count allowed") (IPSDESTSOCKETCOMPAREFN POINTER) (* ;  "Call this to compare dest protocol socket to this socket") (IPSOCKET POINTER) (* ; "This socket") (IPSINPUTFN POINTER) (* ; "Call to hand packet to protocol") (IPSEVENT POINTER) (* ; "Notify me when a packet arrives") (IPSNOSOCKETFN POINTER) (* ; "Call this when no socket found") (IPSICMPFN POINTER) (* ;  "Call this when an ICMP packet is received on this protocol") ) IPSQUEUE _ (create SYSQUEUE) IPSQUEUEALLOC _ \IP.MAX.EPKTS.ON.QUEUE IPSEVENT _ (CREATE.EVENT) IPSINPUTFN _ (FUNCTION \IP.DEFAULT.INPUTFN) IPSICMPFN _ (FUNCTION \RELEASE.ETHERPACKET)) (BLOCKRECORD IPADDRESS ((ADDRESS FIXP)) (* ;; "Class A nets: high bit is 0") (BLOCKRECORD IPADDRESS ((CLASSA BITS 1) (CLASSANET BITS 7) (CLASSAHOST BITS 24))) (* ;; "Class B nets: high 2 bits are 10") (BLOCKRECORD IPADDRESS ((CLASSB BITS 2))) (BLOCKRECORD IPADDRESS ((CLASSBNET BITS 16) (CLASSBHOST BITS 16))) (* ;; "Class C nets: high 3 bits are 110") (BLOCKRECORD IPADDRESS ((CLASSC BITS 3))) (BLOCKRECORD IPADDRESS ((CLASSCNETB1 BITS 8) (CLASSCNETB2 BITS 8) (CLASSCNETB3 BITS 8) (CLASSCHOST BITS 8))) (* ;  "I wish I could say just net bits 24, host bits 8, but BLOCKRECORD barfs") (BLOCKRECORD IPADDRESS ((CLASSCNETHI BITS 16))) [ACCESSFNS IPADDRESS ((CLASSCNET (\MAKENUMBER (FETCH CLASSCNETB1 OF DATUM) (LOGOR (LLSH (FETCH CLASSCNETB2 OF DATUM) 8) (FETCH CLASSCNETB3 OF DATUM))) (PROGN (REPLACE CLASSCNETHI OF DATUM WITH (LRSH NEWVALUE 8)) (REPLACE CLASSCNETB3 OF DATUM WITH (LOGAND NEWVALUE 255)) DATUM]) ) (/DECLAREDATATYPE 'IPSOCKET '(BYTE POINTER BYTE POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER) '((IPSOCKET 0 (BITS . 7)) (IPSOCKET 0 POINTER) (IPSOCKET 2 (BITS . 7)) (IPSOCKET 2 POINTER) (IPSOCKET 4 (BITS . 15)) (IPSOCKET 5 (BITS . 15)) (IPSOCKET 6 POINTER) (IPSOCKET 8 POINTER) (IPSOCKET 10 POINTER) (IPSOCKET 12 POINTER) (IPSOCKET 14 POINTER) (IPSOCKET 16 POINTER)) '18) (DECLARE%: EVAL@COMPILE (RPAQQ \IPOVLEN 20) (RPAQQ \MAX.IPDATALENGTH 556) (RPAQQ \IP.PROTOCOLVERSION 4) (RPAQQ \IP.MAX.EPKTS.ON.QUEUE 16) (RPAQQ \IP.DEFAULT.TIME.TO.LIVE 120) (RPAQQ \IP.WAKEUP.INTERVAL 15000) (CONSTANTS \IPOVLEN \MAX.IPDATALENGTH \IP.PROTOCOLVERSION \IP.MAX.EPKTS.ON.QUEUE \IP.DEFAULT.TIME.TO.LIVE \IP.WAKEUP.INTERVAL) ) (RPAQQ IPPACKETTYPES ((\EPT.IP 2048) (\EPT.AR 2054) (\EET.IP 513) (\EPT.CHAOS 2052))) (DECLARE%: EVAL@COMPILE (RPAQQ \EPT.IP 2048) (RPAQQ \EPT.AR 2054) (RPAQQ \EET.IP 513) (RPAQQ \EPT.CHAOS 2052) (CONSTANTS (\EPT.IP 2048) (\EPT.AR 2054) (\EET.IP 513) (\EPT.CHAOS 2052)) ) (RPAQQ ICMPUNREACHABLES ((\ICMP.NET.UNREACHABLE 0) (\ICMP.HOST.UNREACHABLE 1) (\ICMP.PROTOCOL.UNREACHABLE 2) (\ICMP.PORT.UNREACHABLE 3) (\ICMP.CANT.FRAGMENT 4) (\ICMP.SOURCE.ROUTE 5))) (DECLARE%: EVAL@COMPILE (RPAQQ \ICMP.NET.UNREACHABLE 0) (RPAQQ \ICMP.HOST.UNREACHABLE 1) (RPAQQ \ICMP.PROTOCOL.UNREACHABLE 2) (RPAQQ \ICMP.PORT.UNREACHABLE 3) (RPAQQ \ICMP.CANT.FRAGMENT 4) (RPAQQ \ICMP.SOURCE.ROUTE 5) (CONSTANTS (\ICMP.NET.UNREACHABLE 0) (\ICMP.HOST.UNREACHABLE 1) (\ICMP.PROTOCOL.UNREACHABLE 2) (\ICMP.PORT.UNREACHABLE 3) (\ICMP.CANT.FRAGMENT 4) (\ICMP.SOURCE.ROUTE 5)) ) (DECLARE%: EVAL@COMPILE [PUTPROPS \IPDATABASE MACRO (LAMBDA (IP) (* ejs%: "26-Dec-84 17:50") (* Returns the LOCF of the start of  the data in the packet) (\ADDBASE (fetch (IP IPBASE) of IP) (UNFOLD (fetch (IP IPHEADERLENGTH) of IP) 2] [PUTPROPS \IPDATALENGTH MACRO (LAMBDA (IP) (IDIFFERENCE (fetch (IP IPTOTALLENGTH) of IP) (LLSH (fetch (IP IPHEADERLENGTH) of IP) 2] ) (* "END EXPORTED DEFINITIONS") ) (ADDTOVAR *IP-PROTOCOL-NAME-FROM-NUMBER* (17 . "UDP") (6 . "TCP") (1 . "ICMP")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS *IP-PROTOCOL-NAME-FROM-NUMBER*) ) (* ;; "value in sysout is too small. This is 512-(indexf (fetch epencapsulation))-2. 489 is more correct, but let's leave a word of slop for off-by-ones" ) (RPAQQ \10MBPACKETLENGTH 488) (* ;; "Make it easier to see queuelength without opening up q.") (DEFINEQ (\SYSQUEUE.DEFPRINT [LAMBDA (Q STREAM) (* ; "Edited 8-Sep-89 11:06 by bvm") (\DEFPRINT.BY.NAME Q STREAM (if (fetch (SYSQUEUE SYSQUEUEHEAD) of Q) then (\QUEUELENGTH Q) else "Empty") "SysQueue"]) (\IPSOCKET.DEFPRINT [LAMBDA (SOCKET STREAM) (* ; "Edited 25-Aug-88 17:51 by bvm") (* ;; "Print an object using its name, for example, #. NAME is the object's name (or NIL if this one happens to be nameless), TYPENAME is a string giving the generic name you want to appear in front, e.g., %"FDev%"") (\OUTCHAR STREAM (fetch (READTABLEP HASHMACROCHAR) of *READTABLE*)) (\OUTCHAR STREAM (CHARCODE <)) (LET ((TYPE (CDR (ASSOC (fetch (IPSOCKET PROTOCOL) of SOCKET) *IP-PROTOCOL-NAME-FROM-NUMBER*))) (NUM (fetch (IPSOCKET IPSOCKET) of SOCKET)) (*PRINT-BASE* 10)) (\SOUT (if TYPE then (MKSTRING TYPE) else "IP") STREAM) (\SOUT " Socket" STREAM) (if (if (FIXP NUM) elseif (NULL NUM) then (* ; "I assume this is the master") (SETQ NUM "Head")) then (\OUTCHAR STREAM (CHARCODE SPACE)) (PRIN3 NUM STREAM))) (\OUTCHAR STREAM (CHARCODE /)) (\PRINTADDR SOCKET STREAM) (\OUTCHAR STREAM (CHARCODE >)) T]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (DEFPRINT 'IPSOCKET '\IPSOCKET.DEFPRINT) (DEFPRINT 'SYSQUEUE '\SYSQUEUE.DEFPRINT) ) (RPAQ? IPTRACETIME ) (RPAQ? IPONLYTYPES ) (RPAQ? IPIGNORETYPES ) (RPAQ? IPPRINTMACROS ) (RPAQ? IPTRACEFLG ) (RPAQ? IPTRACEFILE ) (RPAQ? \IP.INIT.FILE ) (RPAQ? \IP.DEFAULT.CONFIGURATION ) (RPAQ? \IP.HOSTNAMES (HASHARRAY 40 1.1)) (RPAQ? \IP.HOSTNUMBERS ) (RPAQ? INTERNET.LOCAL.DOMAIN ) (/DECLAREDATATYPE 'IPSOCKET '(BYTE POINTER BYTE POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER POINTER) '((IPSOCKET 0 (BITS . 7)) (IPSOCKET 0 POINTER) (IPSOCKET 2 (BITS . 7)) (IPSOCKET 2 POINTER) (IPSOCKET 4 (BITS . 15)) (IPSOCKET 5 (BITS . 15)) (IPSOCKET 6 POINTER) (IPSOCKET 8 POINTER) (IPSOCKET 10 POINTER) (IPSOCKET 12 POINTER) (IPSOCKET 14 POINTER) (IPSOCKET 16 POINTER)) '18) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS IPTRACEFILE IPTRACEFLG IPIGNORETYPES IPONLYTYPES IPPRINTMACROS \IP.HOSTNAMES \IP.INIT.FILE INTERNET.LOCAL.DOMAIN \IP.DEFAULT.CONFIGURATION \IP.HOSTNUMBERS) ) (FILESLOAD (SYSLOAD) TCPHTE TCPLLICMP TCPLLAR) (ADDTOVAR \PACKET.PRINTERS (2048 . PRINTIP)) (DEFINEQ (\CANONICALIZE.IP.HOSTNAME [LAMBDA (NAME) (* ; "Edited 12-Apr-88 17:18 by bvm") (AND \IP.READY (IPHOSTADDRESS NAME) NAME]) (DODIP.HOSTP [LAMBDA (NAME) (* ; "Edited 27-Feb-89 21:49 by welch") (COND ((NULL NAME) NIL) ((NUMBERP NAME)) (T (LET [(NAME (\DOMAIN.NAME.QUALIFY.FULLY (U-CASE NAME] (COND ((IPHOSTADDRESS NAME)) (T (if (CL:FBOUNDP 'DOMAIN.LOOKUP.ADDRESS) then (CAR (DOMAIN.LOOKUP.ADDRESS NAME]) (IPHOSTADDRESS [LAMBDA (NAME) (* ; "Edited 19-Jan-88 14:41 by FS") (LET (ENTRY) (* ;; "Hack to handle strings, by canonicalizing NAME") (SETQ NAME (MKATOM (U-CASE NAME))) (SETQ ENTRY (GETHASH NAME \IP.HOSTNAMES)) (COND (ENTRY (LET [(ADDRESS (CAR (fetch (HOSTS.TXT.ENTRY HTE.ADDRESSES) of ENTRY] [COND ((NOT (SASSOC ADDRESS \IP.HOSTNUMBERS)) (push \IP.HOSTNUMBERS (CONS ADDRESS NAME] ADDRESS)) ((\IP.READ.STRING.ADDRESS NAME]) (IPHOSTNAME [LAMBDA (IPADDRESS) (* ejs%: "22-Apr-85 13:54") (OR (CDR (SASSOC IPADDRESS \IP.HOSTNUMBERS)) (MKATOM (\IP.ADDRESS.TO.STRING IPADDRESS]) (IPTRACE [LAMBDA (FLG REGION) (* ; "Edited 13-Sep-88 14:53 by bvm") (MAKE-NETWORK-TRACE-WINDOW 'IPTRACEFLG 'IPTRACEFILE "IP traffic" REGION FLG]) (IPTRACEWINDOW.BUTTONFN [LAMBDA (WINDOW) (* ejs%: " 2-Jun-85 13:05") (COND ((MOUSESTATE (NOT UP)) (SETQ IPTRACEFLG (SELECTQ IPTRACEFLG (NIL T) (T 'PEEK) (PEEK NIL) NIL)) (printout WINDOW T "[Tracing " (SELECTQ IPTRACEFLG (T "on") (PEEK "peek") "off") "]" T]) (PRINTIP [LAMBDA (IP CALLER FILE PRE.NOTE DOFILTER) (* ; "Edited 28-Apr-88 14:05 by bvm") (PROG ((*STANDARD-OUTPUT* (GETSTREAM (OR FILE IPTRACEFILE) 'OUTPUT)) (PROTOCOL (fetch (IP IPPROTOCOL) of IP)) MACRO LENGTH) [COND (DOFILTER (COND ((COND (IPONLYTYPES (NOT (FMEMB PROTOCOL IPONLYTYPES))) (IPIGNORETYPES (FMEMB PROTOCOL IPIGNORETYPES))) (RETURN (PRIN1 (SELECTQ CALLER ((PUT RAWPUT) '!) ((GET RAWGET) '+) '?] (AND PRE.NOTE (printout NIL T PRE.NOTE)) (if CALLER then (* ; "Print GET or PUT") (FRESHLINE) (PRINTOUT NIL CALLER " ")) (printout NIL "From " (\IP.ADDRESS.TO.STRING (fetch (IP IPSOURCEADDRESS) of IP)) " to " (\IP.ADDRESS.TO.STRING (fetch (IP IPDESTINATIONADDRESS) of IP))) (if IPTRACETIME then (LET ((CSECS (\CENTICLOCK IP))) (PRINTOUT NIL " [" |.I4| (IQUOTIENT CSECS 100) "." |.I2..T| (IREMAINDER CSECS 100) "]"))) (TERPRI) [COND ((AND (SETQ MACRO (CDR (FASSOC PROTOCOL IPPRINTMACROS))) (NLISTP MACRO)) (* ;  "Macro is a function to which to dispatch for the printing.") (CL:FUNCALL MACRO IP *STANDARD-OUTPUT*) (RETURN (TERPRI] (printout NIL "Length = " |.P2| (SETQ LENGTH (fetch (IP IPTOTALLENGTH) of IP)) " bytes" " (header + " |.P2| (IDIFFERENCE LENGTH \IPOVLEN) ")" T "Protocol = ") (PRINTCONSTANT PROTOCOL IPPROTOCOLTYPES NIL) (TERPRI) [COND ((IGREATERP LENGTH \IPOVLEN) (* ; "MACRO tells how to print data.") (PRIN1 "Contents: ") (PRINTIPDATA IP (OR MACRO '(BYTES 12 |...|] (TERPRI) (RETURN IP]) (PRINTIPDATA [LAMBDA (IP MACRO OFFSET FILE) (* ejs%: "27-Dec-84 18:43") (* * Prints DATA part of IP starting at OFFSET  (Default zero) according to MACRO. MACRO contains elements describing what  format the data is in -  WORDS, BYTES, CHARS%: print as words, bytes  (numeric) or ascii characters -  %: subsequent commands apply starting at this byte offset -  ...%: print "..." and quit if you still have data at this point) (PROG ((DATA (\IPDATABASE IP)) (LENGTH (\IPDATALENGTH IP))) (PRINTPACKETDATA DATA OFFSET MACRO LENGTH FILE]) (\IPADDRESSCLASS [LAMBDA (IPADDRESS) (* ; "Edited 26-Oct-88 12:49 by bvm") (if (SMALLP IPADDRESS) then (* ; "bogus unless it's broadcastp") '\IP.CLASS.A elseif (EQ \IP.CLASS.C (SETQ IPADDRESS (fetch (IPADDRESS CLASSC) of IPADDRESS))) then '\IP.CLASS.C elseif (EQ \IP.CLASS.B (SETQ IPADDRESS (LRSH IPADDRESS 1))) then '\IP.CLASS.B elseif (EQ \IP.CLASS.A (LRSH IPADDRESS 1)) then '\IP.CLASS.A]) (\IPEVENTFN [LAMBDA (EVENT) (* ; "Edited 13-Sep-88 18:53 by Hiroshi Hayata") (* ;; "If maiko, do nothing. ") (* ;; "Call of \IPINIT with AFTERSYSOUT on maiko cause RAID.") (COND ((EQ \MACHINETYPE \MAIKO) NIL) (T (COND (\IPFLG (\IPINIT EVENT]) (\IPHOSTADDRESS [LAMBDA (IPADDRESS) (* ; "Edited 26-Oct-88 12:43 by bvm") (if (SMALLP IPADDRESS) then (* ; "can only be class a or bogus") (LOGAND IPADDRESS MAX.SMALLP) elseif (EQ (fetch (IPADDRESS CLASSA) of IPADDRESS) \IP.CLASS.A) then (fetch (IPADDRESS CLASSAHOST) of IPADDRESS) elseif (EQ (fetch (IPADDRESS CLASSB) of IPADDRESS) \IP.CLASS.B) then (fetch (IPADDRESS CLASSBHOST) of IPADDRESS) elseif (EQ (fetch (IPADDRESS CLASSC) of IPADDRESS) \IP.CLASS.C) then (fetch (IPADDRESS CLASSCHOST) of IPADDRESS]) (\IPNETADDRESS [LAMBDA (IPADDRESS) (* ; "Edited 26-Oct-88 12:45 by bvm") (if (SMALLP IPADDRESS) then (* ; "bogus unless it's broadcastp") (if (< IPADDRESS 0) then -1 else 0) elseif (EQ (fetch (IPADDRESS CLASSA) of IPADDRESS) \IP.CLASS.A) then (fetch (IPADDRESS CLASSANET) of IPADDRESS) elseif (EQ (fetch (IPADDRESS CLASSB) of IPADDRESS) \IP.CLASS.B) then (fetch (IPADDRESS CLASSBNET) of IPADDRESS) elseif (EQ (fetch (IPADDRESS CLASSC) of IPADDRESS) \IP.CLASS.C) then (fetch (IPADDRESS CLASSCNET) of IPADDRESS]) (\IP.ADDRESS.TO.STRING [LAMBDA (IPADDRESS) (* ejs%: "28-Dec-84 08:43") (RESETFORM (RADIX 10) (CONCAT (LDB (BYTE 8 24) IPADDRESS) "." (LDB (BYTE 8 16) IPADDRESS) "." (LDB (BYTE 8 8) IPADDRESS) "." (LDB (BYTE 8 0) IPADDRESS]) (\IP.BROADCAST.ADDRESS [LAMBDA (IPADDRESS) (* ; "Edited 26-Oct-88 14:59 by bvm") (* ;;  "0's in the host field are now considered broadcasts, so this code works with Berkeley Unix") (LET (HOST MASK) (if (SMALLP IPADDRESS) then (OR (EQ IPADDRESS 0) (EQ IPADDRESS -1)) elseif (EQ (fetch (IPADDRESS CLASSA) of IPADDRESS) \IP.CLASS.A) then [if (AND \IP.SUBNET.MASKS (ASSOC (fetch (IPADDRESS CLASSANET) of IPADDRESS) \IP.LOCAL.NETWORKS)) then (* ;  "If it's our subnet, check only the subnetted host part. The LOGOR patches bogus subnet masks") [SETQ HOST (LOGAND IPADDRESS (SETQ MASK (LOGXOR (LOGOR (CDAR \IP.SUBNET.MASKS ) -16777216) -1] (OR (EQ HOST 0) (EQL HOST MASK)) else (SETQ HOST (fetch (IPADDRESS CLASSAHOST) of IPADDRESS)) (OR (EQ HOST 0) (EQL HOST (MASK.1'S 0 24] elseif (EQ (fetch (IPADDRESS CLASSB) of IPADDRESS) \IP.CLASS.B) then [if (AND \IP.SUBNET.MASKS (ASSOC (fetch (IPADDRESS CLASSBNET) of IPADDRESS) \IP.LOCAL.NETWORKS)) then [SETQ HOST (LOGAND IPADDRESS (SETQ MASK (LOGXOR (LOGOR (CDAR \IP.SUBNET.MASKS ) -65536) -1] (OR (EQ HOST 0) (EQ HOST MASK)) else (SETQ HOST (fetch (IPADDRESS CLASSBHOST) of IPADDRESS)) (OR (EQ HOST 0) (EQ HOST (MASK.1'S 0 16] elseif (EQ (fetch (IPADDRESS CLASSC) of IPADDRESS) \IP.CLASS.C) then (SETQ HOST (fetch (IPADDRESS CLASSCHOST) of IPADDRESS)) (* ; "No subnetting here") (OR (EQ HOST 0) (EQ HOST (MASK.1'S 0 8))) elseif (EQ (fetch (IPADDRESS CLASSBNET) of IPADDRESS) MAX.SMALLP) then (* ;  "Sort of illegal, but recognize all ones as broadcast") (EQ (fetch (IPADDRESS CLASSBHOST) of IPADDRESS) MAX.SMALLP]) (\IP.LEGAL.ADDRESS [LAMBDA (ADDRESS) (* ejs%: "25-Mar-86 16:00") (AND (NOT (EQ ADDRESS 0)) (NOT (EQ ADDRESS -1)) (OR (EQ \IP.CLASS.C (SETQ ADDRESS (LRSH ADDRESS 29))) (EQ \IP.CLASS.B (SETQ ADDRESS (LRSH ADDRESS 1))) (EQ \IP.CLASS.A (LRSH ADDRESS 1]) (\IP.MAKE.BROADCAST.ADDRESS [LAMBDA (IPADDRESS) (* ejs%: " 3-Jun-85 01:02") (SELECTQ (\IPADDRESSCLASS IPADDRESS) (\IP.CLASS.A (LOGOR (MASK.1'S 0 24) IPADDRESS)) (\IP.CLASS.B (LOGOR (MASK.1'S 0 16) IPADDRESS)) (\IP.CLASS.C (LOGOR (MASK.1'S 0 8) IPADDRESS)) (SHOULDNT]) (\IP.PRINT.ADDRESS [LAMBDA (IPADDRESS FILE) (* ejs%: "28-Dec-84 08:42") (RESETFORM (RADIX 10) (PRIN1 (LDB (BYTE 8 24) IPADDRESS) FILE) (PRIN1 "." FILE) (PRIN1 (LDB (BYTE 8 16) IPADDRESS) FILE) (PRIN1 "." FILE) (PRIN1 (LDB (BYTE 8 8) IPADDRESS) FILE) (PRIN1 "." FILE) (PRIN1 (LDB (BYTE 8 0) IPADDRESS) FILE) IPADDRESS]) (\IP.READ.STRING.ADDRESS [LAMBDA (STRING.OR.ATOM) (* ; "Edited 21-Apr-88 14:41 by bvm") (for CHAR instring (MKSTRING STRING.OR.ATOM) bind (RESULT _ (NCREATE 'FIXP)) (INDEX _ 0) BYTE do (if (> INDEX 3) then (* ;  "Got 3 parts and there's still more to go, must be bad") (RETURN NIL) elseif (EQ CHAR (CHARCODE %.)) then (if BYTE then (\PUTBASEBYTE RESULT INDEX BYTE)) (SETQ BYTE NIL) (add INDEX 1) elseif (AND (SETQ CHAR (CL:DIGIT-CHAR-P (CL:INT-CHAR CHAR))) (< (SETQ BYTE (+ (if BYTE then (TIMES BYTE 10) else 0) CHAR)) 256)) then (* ;  "Accumulated decimal digit, and we haven't overflowed a byte yet") else (* ; "Malformed") (RETURN NIL)) finally (if BYTE then (\PUTBASEBYTE RESULT INDEX BYTE) (add INDEX 1)) (RETURN (AND (EQ INDEX 4) RESULT]) (\DOMAIN.NAME.QUALIFY.FULLY [LAMBDA (NAME) (* ; "Edited 29-Aug-90 16:27 by gadener") (* Make a fully qualified domain  name from a partial one) (if (OR (NULL INTERNET.LOCAL.DOMAIN) (STRPOS "." NAME)) then NAME else (MKATOM (CONCAT NAME "." INTERNET.LOCAL.DOMAIN]) ) (* ;; "Startup and shutdown") (RPAQ? *IP-DEFAULT-HOSTS-FILE* ) (RPAQ? TCP.ALWAYS.READ.HOSTS.FILE T) (RPAQ? \TCP.LAST.HOSTS.FILE.DATE ) (RPAQ? \TCP.LAST.HOSTS.FILE.READ ) (RPAQ? \IPFLG ) (RPAQ? \IP.READY ) (RPAQ? \IP.READY.EVENT (CREATE.EVENT "IP Ready")) (RPAQ? \IP.WAKEUP.TIMER ) (RPAQ? IPTRACEFLG ) (RPAQ? \IP.WAKEUP.EVENT (CREATE.EVENT "IP Wakeup")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \IPFLG \IP.READY \IP.READY.EVENT \IP.WAKEUP.TIMER \IP.WAKEUP.EVENT TCP.ALWAYS.READ.HOSTS.FILE \TCP.LAST.HOSTS.FILE.DATE \TCP.LAST.HOSTS.FILE.READ *IP-DEFAULT-HOSTS-FILE*) ) (DEFINEQ (STOPIP [LAMBDA NIL (* ejs%: "28-Dec-84 08:10") (\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.IP)) (\DEL.PACKET.FILTER (FUNCTION \HANDLE.RAW.AR)) (DEL.PROCESS '\IPLISTENER) (SETQ \IPFLG (SETQ \IP.READY NIL]) (\IPINIT [LAMBDA (EVENT) (* ; "Edited 18-Mar-88 17:22 by bvm") (* ;; "Initialize IP protocol. Called with EVENT NIL for explicit restart, RESTART from RESTART.ETHER, otherwise from usual around exit events via \ETHEREVENTFN and RESTARTETHERFNS after Pup and/an \icmp.echo.reply") (* ;; "or NS turned on.") (SELECTQ EVENT ((NIL RESTART AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM) (if (AND (NULL \IPFLG) (NOT (NULL EVENT))) then (* ;  "Nothing to do. Only turn IP on for explicit call to \IPINIT") NIL elseif [OR (NULL EVENT) (NULL \IP.DEFAULT.CONFIGURATION) (NOT (EQUAL \MY.NSHOSTNUMBER (fetch (IPINIT LOCAL.NSHOSTNUMBER) of \IP.DEFAULT.CONFIGURATION] then (* ;  "Machine changed, or caller explicitly wants us to reread the init file") (SETQ \IP.DEFAULT.CONFIGURATION NIL) (SETQ \IP.LOCAL.ADDRESSES NIL) (SETQ \IP.LOCAL.NETWORKS NIL) (SETQ \IP.SUBNET.MASKS NIL) (DEL.PROCESS '\IPLISTENER) [SELECTQ EVENT ((NIL RESTART) (* ; "Can do it here--explicit manual restart. Otherwise spawn process, so that we can do arbitrary things like rely on other devices initialized later than ether") (\IP.REINITIALIZE.FROM.SCRATCH)) (ADD.PROCESS `(\IP.REINITIALIZE.FROM.SCRATCH ',EVENT] else (\IP.RESTART.FROM.CONFIGURATION EVENT))) NIL]) (\IPLISTENER [LAMBDA NIL (* ejs%: "25-Jun-85 18:52") (* * IP background process) (SETQ \IP.WAKEUP.TIMER (SETUPTIMER \IP.WAKEUP.INTERVAL)) (bind [\AR.WAKEUP.TIMER _ (SETUPTIMER (CONSTANT (ITIMES 4 \IP.WAKEUP.INTERVAL] while T do (AWAIT.EVENT \IP.WAKEUP.EVENT \IP.WAKEUP.INTERVAL) (\IP.CHECK.REASSEMBLY.TIMEOUTS) (COND ((TIMEREXPIRED? \AR.WAKEUP.TIMER) (\AR.DAEMON) (SETQ \AR.WAKEUP.TIMER (SETUPTIMER (CONSTANT (ITIMES 4 \IP.WAKEUP.INTERVAL)) \AR.WAKEUP.TIMER]) (\IP.REINITIALIZE.FROM.SCRATCH [LAMBDA (EVENT) (* ; "Edited 20-Jan-89 18:35 by bvm") (DECLARE (GLOBALVARS \IP.DEFAULT.CONFIGURATION \IP.LOCAL.ADDRESSES)) (* ;; "Called when we have never enabled IP, or the machine's address has changed.") (RESETBUFS (PROG (FILE ADDRESS.STRING HOSTS.FILE HOSTNAME ADDRESSES) (* ;;  "This is a kludge until we know more about IP routing and reverse address resolution (??)") [SETQ \IP.DEFAULT.CONFIGURATION (COND ((AND (SETQ FILE (INFILEP '{DSK}IP.INIT)) (\IP.READ.INIT.FILE FILE))) ((IP.DEFAULT.CONFIGURATION)) ((AND (SETQ FILE (\IP.PROMPT.FOR.FILE.NAME "Please enter the name of the IP initialization file for this host: " )) (\IP.READ.INIT.FILE FILE))) (T (* ;  "User declined to specify, or init file failed, so give up") (PRINTOUT T "IP not initialized" T) (RETURN NIL] (COND ((SETQ FILE (OR (fetch (IPINIT HTE.FILE) of \IP.DEFAULT.CONFIGURATION ) *IP-DEFAULT-HOSTS-FILE*)) (* ;;  "there is a hosts file in the configuration. Now see if we really want to read it.") (\IP.MAYBE.READ.HOSTS.TXT T FILE))) (COND ([AND (NOT (SETQ HOSTNAME (fetch (IPINIT HOSTNAME) of \IP.DEFAULT.CONFIGURATION ))) (SETQ HOSTNAME (AND (EQ \PUP.READY T) (U-CASE (ETHERHOSTNAME] (replace (IPINIT HOSTNAME) of \IP.DEFAULT.CONFIGURATION with HOSTNAME))) [COND [(SETQ ADDRESSES (fetch (IPINIT LOCAL.ADDRESSES) of \IP.DEFAULT.CONFIGURATION )) (SETQ \IP.LOCAL.ADDRESSES (for ADDR in ADDRESSES collect (\IP.READ.STRING.ADDRESS ADDR] ((AND HOSTNAME (SETQ ADDRESSES (DODIP.HOSTP HOSTNAME))) (SETQ \IP.LOCAL.ADDRESSES (LIST ADDRESSES))) (T (until (SETQ ADDRESS.STRING (PROMPTFORWORD "Please enter this machine's IP host address (e.g. 39.9.0.9)" ))) (SETQ \IP.LOCAL.ADDRESSES (LIST (\IP.READ.STRING.ADDRESS ADDRESS.STRING))) (COND (HOSTNAME (* ;  "Associate name with local address(es)") (PUTHASH HOSTNAME [create HOSTS.TXT.ENTRY HTE.TYPE _ 'HOST HTE.ADDRESSES _ \IP.LOCAL.ADDRESSES HTE.NAMES _ (LIST HOSTNAME) HTE.MACHINE.TYPE _ (SELECTQ (MACHINETYPE) (DOVE 'XEROX-1185) (DANDELION 'XEROX-1108) (DOLPHIN 'XEROX-1100) (DORADO 'XEROX-1132) 'XEROX-11XX) HTE.OS.TYPE _ 'INTERLISP HTE.PROTOCOLS _ '((TCP) (IP] \IP.HOSTNAMES] (\IP.RESTART.FROM.CONFIGURATION EVENT T]) (\IP.RESTART.FROM.CONFIGURATION [LAMBDA (EVENT NEW.INIT) (* ; "Edited 26-Feb-89 21:28 by welch") (* ;; "Reinitialize IP after logout, etc, from the info in the default configuration. This is the only place that sets \IP.READY true.") (GLOBALVARS INTERNET.LOCAL.DOMAIN) (PROG ((GATE (fetch (IPINIT DEFAULT.GATEWAY) of \IP.DEFAULT.CONFIGURATION)) (NETS (fetch (IPINIT LOCAL.NETWORKS) of \IP.DEFAULT.CONFIGURATION)) PROC NDB) (SETQ \IP.DEFAULT.GATEWAY (AND GATE (\IP.READ.STRING.ADDRESS GATE))) (SETQ \IP.ROUTING.TABLE (CONS)) (SETQ \AR.IP.TO.10MB.ALIST NIL) (SETQ INTERNET.LOCAL.DOMAIN (fetch (IPINIT LOCAL.DOMAIN) of \IP.DEFAULT.CONFIGURATION )) [COND [(EQLENGTH NETS (LENGTH \IP.LOCAL.ADDRESSES)) (* ;;  "List tells net numbers of each directly connected net. Each element = (%"net.number%" . type).") (SETQ \IP.LOCAL.NETWORKS (bind NDB for NET.AND.TYPE in NETS as ADDRESS in \IP.LOCAL.ADDRESSES collect (LET* [(TYPE (CDR NET.AND.TYPE)) [NET (\IPNETADDRESS (\IP.READ.STRING.ADDRESS (CAR NET.AND.TYPE] (NDB (SELECTQ TYPE (3 \3MBLOCALNDB) (10 \10MBLOCALNDB) (SHOULDNT] (replace (NDB NDBIPNET#) of NDB with NET) (replace (NDB NDBIPHOST#) of NDB with ADDRESS) (CONS NET NDB] ((NULL \IP.LOCAL.ADDRESSES) (RETURN (CL:WARN "Error in IP init file. No local host address specified"))) ((AND (NULL (CDR \IP.LOCAL.ADDRESSES)) (NULL (fetch (NDB NDBNEXT) of \LOCALNDBS))) (* ;  "Only one address, so it goes with our one net") [SETQ \IP.LOCAL.NETWORKS (LIST (CONS (\IPNETADDRESS (CAR \IP.LOCAL.ADDRESSES)) (SETQ NDB (OR \10MBLOCALNDB \3MBLOCALNDB] (replace (NDB NDBIPNET#) of NDB with (CAAR \IP.LOCAL.NETWORKS)) (replace (NDB NDBIPHOST#) of NDB with (CAR \IP.LOCAL.ADDRESSES))) (T (RETURN (CL:WARN "Error in IP init file. Network list and local address list do not correlate." ] [SETQ \IP.SUBNET.MASKS (for LOCALADDR in \IP.LOCAL.ADDRESSES as MASK in (fetch (IPINIT SUBNETMASK) of \IP.DEFAULT.CONFIGURATION ) as NETADDRESS in NETS collect (CONS LOCALADDR (\IP.READ.STRING.ADDRESS (OR MASK (CAR NETADDRESS] (COND ((BOUNDP '\DOMAIN.NAMESERVERS) (\DOMAIN.INIT EVENT))) (\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.IP)) (\ADD.PACKET.FILTER (FUNCTION \HANDLE.RAW.AR)) (SETQ \IPFLG T) (\IP.ADD.PROTOCOL \ICMP.PROTOCOL (FUNCTION TRUE) (FUNCTION NILL) (FUNCTION \ICMP.INPUT)) (COND ((SETQ PROC (FIND.PROCESS '\IPLISTENER)) (RESTART.PROCESS PROC)) (T (ADD.PROCESS '(\IPLISTENER) 'RESTARTABLE 'SYSTEM 'AFTEREXIT \IP.READY.EVENT))) (if (NOT NEW.INIT) then (* ; "Finally, check for new hosts.txt file, but we can do this in background. If NEW.INIT, the configuration code has already read it.") (ADD.PROCESS '(\IP.MAYBE.READ.HOSTS.TXT T) 'AFTEREXIT 'DELETE)) (SETQ \IP.READY T) (NOTIFY.EVENT \IP.READY.EVENT) (\ICMP.REQUEST.ADDRESS.MASK) (RETURN T]) (\IP.MAYBE.READ.HOSTS.TXT [LAMBDA (AFTEREXIT FILE) (* ; "Edited 20-Jan-89 11:56 by bvm") (* ;; "Read the hosts.txt file if it has changed") (if AFTEREXIT then (* ;  "Have to wait until all devices are happy") (until \PROC.READY do (AWAIT.EVENT \PROCESS.AFTEREXIT.EVENT 10000))) (LET (FULLNAME) (COND ((NULL FILE)) (TCP.ALWAYS.READ.HOSTS.FILE (* ;  "the user wants us to always read it fresh.") (\HTE.READ.FILE FILE)) ((NULL (SETQ FULLNAME (INFILEP FILE))) (CL:FORMAT PROMPTWINDOW "~%%Couldn't find hosts file ~A" FILE)) ([AND \TCP.LAST.HOSTS.FILE.DATE (STRING-EQUAL FULLNAME \TCP.LAST.HOSTS.FILE.READ) (EQUAL \TCP.LAST.HOSTS.FILE.DATE (GETFILEINFO FILE 'ICREATIONDATE] (* ;  "the file names and the file write dates are the same, don't re-read the hosts file.") NIL) (T (* ;  "Haven't read this particular file before, so snarf it") (\HTE.READ.FILE FILE]) (\IP.READ.INIT.FILE [LAMBDA (FILE) (* ; "Edited 18-Mar-88 18:34 by bvm") (CL:MULTIPLE-VALUE-BIND (CONFIGURATION CONDITION) [IGNORE-ERRORS (LET ((*UPPER-CASE-FILE-NAMES* NIL) (*READTABLE* (FIND-READTABLE "INTERLISP"))) (CL:WITH-OPEN-FILE (S FILE) (READ S] (if CONDITION then (PRINTOUT T "Failed to read init file because: " CONDITION) NIL else (LET ((HOST (fetch (IPINIT LOCAL.NSHOSTNUMBER) of CONFIGURATION))) (if (NULL HOST) then (* ;  "Old file that doesn't have its processor identification in it") (create IPINIT using CONFIGURATION LOCAL.NSHOSTNUMBER _ \MY.NSHOSTNUMBER) elseif (EQUAL HOST \MY.NSHOSTNUMBER) then (* ; "Good, init file for same host") CONFIGURATION else (PRINTOUT T FILE " gives configuration for host " ( \COERCE.TO.NSADDRESS HOST) " but this is machine " (\COERCE.TO.NSADDRESS \MY.NSHOSTNUMBER) T) NIL]) (\IP.PROMPT.FOR.FILE.NAME [LAMBDA (PROMPT DEFAULT) (* ; "Edited 18-Mar-88 18:14 by bvm") (* ;; "Prompts for a file name from user and returns its full name if it is infilep") (bind NAME do (if [NULL (SETQ NAME (PROG1 (PROMPTFORWORD PROMPT DEFAULT NIL NIL NIL NIL (CHARCODE (CR))) (TERPRI] then (RETURN NIL) elseif (SETQ NAME (INFILEP NAME)) then (RETURN NAME) else (PRINTOUT T "File not found" T]) ) (ADDTOVAR RESTARTETHERFNS \IPEVENTFN) (* ;; "Early IP reception functions") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (RPAQQ IPADDRESSTYPES ((\IP.CLASS.A 0) (\IP.CLASS.A.BYTESPEC (BYTE 1 31)) (\IP.CLASS.A.NET.BYTESPEC (BYTE 8 24)) (\IP.CLASS.A.HOST.BYTESPEC (BYTE 24 0)) (\IP.CLASS.B 2) (\IP.CLASS.B.BYTESPEC (BYTE 2 30)) (\IP.CLASS.B.NET.BYTESPEC (BYTE 16 16)) (\IP.CLASS.B.HOST.BYTESPEC (BYTE 16 0)) (\IP.CLASS.C 6) (\IP.CLASS.C.BYTESPEC (BYTE 3 29)) (\IP.CLASS.C.NET.BYTESPEC (BYTE 24 8)) (\IP.CLASS.C.HOST.BYTESPEC (BYTE 8 0)))) (DECLARE%: EVAL@COMPILE (RPAQQ \IP.CLASS.A 0) (RPAQ \IP.CLASS.A.BYTESPEC (BYTE 1 31)) (RPAQ \IP.CLASS.A.NET.BYTESPEC (BYTE 8 24)) (RPAQ \IP.CLASS.A.HOST.BYTESPEC (BYTE 24 0)) (RPAQQ \IP.CLASS.B 2) (RPAQ \IP.CLASS.B.BYTESPEC (BYTE 2 30)) (RPAQ \IP.CLASS.B.NET.BYTESPEC (BYTE 16 16)) (RPAQ \IP.CLASS.B.HOST.BYTESPEC (BYTE 16 0)) (RPAQQ \IP.CLASS.C 6) (RPAQ \IP.CLASS.C.BYTESPEC (BYTE 3 29)) (RPAQ \IP.CLASS.C.NET.BYTESPEC (BYTE 24 8)) (RPAQ \IP.CLASS.C.HOST.BYTESPEC (BYTE 8 0)) (CONSTANTS (\IP.CLASS.A 0) (\IP.CLASS.A.BYTESPEC (BYTE 1 31)) (\IP.CLASS.A.NET.BYTESPEC (BYTE 8 24)) (\IP.CLASS.A.HOST.BYTESPEC (BYTE 24 0)) (\IP.CLASS.B 2) (\IP.CLASS.B.BYTESPEC (BYTE 2 30)) (\IP.CLASS.B.NET.BYTESPEC (BYTE 16 16)) (\IP.CLASS.B.HOST.BYTESPEC (BYTE 16 0)) (\IP.CLASS.C 6) (\IP.CLASS.C.BYTESPEC (BYTE 3 29)) (\IP.CLASS.C.NET.BYTESPEC (BYTE 24 8)) (\IP.CLASS.C.HOST.BYTESPEC (BYTE 8 0))) ) (* "END EXPORTED DEFINITIONS") ) (RPAQ? \IP.LOCAL.ADDRESSES ) (RPAQ? \IP.SUBNET.MASKS ) (RPAQ? \IP.GATEWAY.FLG ) (RPAQ \IP.ADDRESS.BOX (\CREATECELL \FIXP)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \IP.LOCAL.ADDRESSES \IP.SUBNET.MASKS \IP.GATEWAY.FLG \IP.ADDRESS.BOX) ) (DECLARE%: EVAL@COMPILE [PUTPROPS \IP.FIX.DEST.HOST MACRO (LAMBDA (IP NDB) (* ejs%: "26-Dec-84 15:07") (replace (IP IPDESTINATIONHOST) of IP with (ffetch (NDB NDBIPHOST#) of NDB] [PUTPROPS \IP.FIX.DEST.NET MACRO (LAMBDA (IP NDB) (* ejs%: "26-Dec-84 15:08") (* * Put the IP net# corresponding to the given NDB into the destination net  field of the dest address of the IP packet) (replace (IP IPDESTINATIONADDRESS) of IP with (LOGOR (fetch (IP IPDESTINATIONADDRESS) of IP) (LLSH (fetch (NDB NDBIPNET#) of NDB) (SELECTQ (\IPADDRESSCLASS (fetch (NDB NDBIPHOST#) of NDB)) (\IP.CLASS.A 24) (\IP.CLASS.B 16) (\IP.CLASS.C 8) (SHOULDNT] [PUTPROPS \IP.FIX.SOURCE.HOST MACRO (LAMBDA (IP NDB) (* ejs%: "26-Dec-84 15:07") (replace (IP IPSOURCEHOST) of IP with (ffetch (NDB NDBIPHOST#) of NDB] [PUTPROPS \IP.FIX.SOURCE.NET MACRO (LAMBDA (IP NDB) (* ejs%: "26-Dec-84 15:08") (* * Put the IP net# corresponding to the given NDB into the destination net  field of the dest address of the IP packet) (replace (IP IPSOURCENET) of IP with (ffetch (NDB NDBIPNET#) of NDB] ) (DEFINEQ (\HANDLE.RAW.IP [LAMBDA (IP TYPE) (* ejs%: " 3-Feb-86 11:01") (PROG ((NDB (ffetch (ETHERPACKET EPNETWORK) of IP))) (COND ((NOT (type? NDB NDB)) (ERROR "No NDB in ETHERPACKET!" IP))) (SELECTQ (ffetch (NDB NETTYPE) of NDB) (10 (COND ((NEQ TYPE \EPT.IP) (RETURN)))) (3 (COND ((NEQ TYPE \EET.IP) (RETURN)))) (ERROR "Unknown net type" (ffetch (NDB NETTYPE) of NDB))) [COND ((NOT \IP.READY) (\RELEASE.ETHERPACKET IP)) ([NOT (\IP.CHECKSUM.OK (\IPCHECKSUM IP (ffetch (IP IPBASE) of IP) (TIMES (ffetch (IP IPHEADERLENGTH) of IP) BYTESPERCELL] (AND IPTRACEFLG (PRINTPACKET IP 'GET IPTRACEFILE "[Packet dropped--bad IP header checksum]")) (\RELEASE.ETHERPACKET IP)) ((ZEROP (ffetch (IP IPTIMETOLIVE) of IP)) (\ICMP.TIME.EXCEEDED IP \ICMP.TRANSIT.TIME.EXCEEDED) (\RELEASE.ETHERPACKET IP)) ((\IP.PROCESS.OPTIONS IP) (COND ((NOT (\IP.LOCAL.DESTINATION IP)) (\FORWARD.IP IP)) [(\IP.FRAGMENTED.PACKET IP) (COND ((SETQ IP (\HANDLE.RAW.IP.FRAGMENT IP)) [COND (IPTRACEFLG (COND ((EQ IPTRACEFLG T) (PRINTIP IP 'GETFRAGMENT IPTRACEFILE NIL T)) (T (PRIN1 "+" IPTRACEFILE] (\IP.HAND.TO.PROTOCOL IP] (T [COND (IPTRACEFLG (COND ((EQ IPTRACEFLG T) (PRINTIP IP 'GET IPTRACEFILE NIL T)) (T (PRIN1 "+" IPTRACEFILE] (\IP.HAND.TO.PROTOCOL IP] (RETURN T]) (\FORWARD.IP [LAMBDA (IP) (* ejs%: "10-Feb-86 11:32") (DECLARE (GLOBALVARS \IP.GATEWAY.FLG \IP.GATEWAY.FORWARDING.FUNCTIONS)) (COND [\IP.GATEWAY.FLG (LET* ((DESTADDRESS (ffetch (IP IPDESTINATIONADDRESS) of IP)) (NETADDRESS (\IPNETADDRESS DESTADDRESS)) (NDB (fetch (ETHERPACKET EPNETWORK) of IP)) (SOURCEADDRESS (fetch NDBIPHOST# of NDB)) (SUBNETMASK (CDR (SASSOC SOURCEADDRESS \IP.SUBNET.MASKS))) SUBNETINUSE ROUTE FORWARDING.FUNCTION) [COND [(AND NDB SUBNETMASK (OR (EQP (LOGAND SOURCEADDRESS SUBNETMASK) (LOGAND DESTADDRESS SUBNETMASK)) (PROGN (SETQ SUBNETINUSE T) NIL] ((NULL NDB) (COND ((SETQ ROUTE (CDR (SASSOC NETADDRESS \IP.ROUTING.TABLE))) (SETQ NDB (CDR (SASSOC (\IPNETADDRESS ROUTE) \IP.LOCAL.NETWORKS] (COND [NDB (replace EPREQUEUE of IP with 'FREE) (add (ffetch (IP IPTIMETOLIVE) of IP) -1) [SETQ NETADDRESS (COND (SUBNETINUSE (LOGAND DESTADDRESS SUBNETMASK )) (T (BITCLEAR DESTADDRESS (\IPHOSTADDRESS DESTADDRESS] (COND ((SETQ FORWARDING.FUNCTION (CDR (SASSOC NETADDRESS \IP.GATEWAY.FORWARDING.FUNCTIONS ))) (APPLY* FORWARDING.FUNCTION IP NDB NETADDRESS ROUTE)) (T (\RELEASE.ETHERPACKET IP] (T (\ICMP.REDIRECT IP \ICMP.REDIRECT.NET] (T (\RELEASE.ETHERPACKET IP]) (\IP.LOCAL.DESTINATION [LAMBDA (IP) (* ejs%: "25-Mar-86 16:03") (* * Return T if IP packet is destined for us) (UNINTERRUPTABLY (\BLT \IP.ADDRESS.BOX (LOCF (fetch (IP IPDESTINATIONADDRESS) of IP)) WORDSPERCELL) [LET [(LOCALNETADDRESS (fetch NDBIPNET# of (fetch EPNETWORK of IP] (COND ((MEMBER \IP.ADDRESS.BOX \IP.LOCAL.ADDRESSES) T) ((AND (\IP.BROADCAST.ADDRESS \IP.ADDRESS.BOX) (EQP LOCALNETADDRESS (\IPNETADDRESS \IP.ADDRESS.BOX))) T) ((NOT (\IP.LEGAL.ADDRESS \IP.ADDRESS.BOX)) (* Bogus destination address) NIL) ((EQP 0 (\IPNETADDRESS \IP.ADDRESS.BOX)) (* Source doesn't know its network?) (SELECTQ (INTEGERLENGTH LOCALNETADDRESS) (8 (\PUTBASEBYTE \IP.ADDRESS.BOX 0 LOCALNETADDRESS)) (16 (\PUTBASE \IP.ADDRESS.BOX 0 LOCALNETADDRESS)) (24 [for I from 0 to 2 do (\PUTBASEBYTE \IP.ADDRESS.BOX I (LOGAND 255 (LRSH LOCALNETADDRESS (ITIMES 8 (IDIFFERENCE 2 I]) NIL) (COND ((\IP.BROADCAST.ADDRESS \IP.ADDRESS.BOX) T) ((MEMBER \IP.ADDRESS.BOX \IP.LOCAL.ADDRESSES) T])]) (\IPCHECKSUM [LAMBDA (ETHERPACKET CHECKSUMBASE NBYTES IGNOREDWORD) (* ejs%: "31-Dec-84 13:53") (* * Compute a general checksum for a packet starting at CHECKSUMBASE and  extending NBYTES. If NBYTES is odd, a 0 byte is padded on the end.  The IGNOREDWORD field is the LOCF of the field which will contain the checksum,  and is to be considered 0 for the calculation.) (PROG ((MAXINDEX (SUB1 (FOLDHI NBYTES BYTESPERWORD))) (CHECKSUM 0) (ODDFLG (ODDP NBYTES)) DIFF WORDCONTENTS) (AND IGNOREDWORD (\PUTBASE IGNOREDWORD 0 0)) [for WORD from 0 to MAXINDEX do (SETQ CHECKSUM (COND [(AND ODDFLG (EQ WORD MAXINDEX)) (COND ([ILEQ CHECKSUM (SETQ DIFF (IDIFFERENCE MAX.SMALL.INTEGER (SETQ WORDCONTENTS (LOGAND (\GETBASE CHECKSUMBASE WORD) (MASK.1'S 8 8] (IPLUS CHECKSUM WORDCONTENTS)) (T (IDIFFERENCE CHECKSUM DIFF] (T (COND ([ILEQ CHECKSUM (SETQ DIFF (IDIFFERENCE MAX.SMALL.INTEGER (SETQ WORDCONTENTS (\GETBASE CHECKSUMBASE WORD] (IPLUS CHECKSUM WORDCONTENTS)) (T (IDIFFERENCE CHECKSUM DIFF] (RETURN CHECKSUM]) (\IP.CHECKSUM.OK [LAMBDA (CHECKSUM) (* ejs%: "28-Dec-84 19:40") (OR (EQ CHECKSUM (MASK.1'S 0 16)) (EQ CHECKSUM 0]) (\IP.SET.CHECKSUM [LAMBDA (PACKET CHECKSUMBASE NBYTES CHECKSUMWORD) (* ejs%: " 4-Jun-85 22:47") (PROG ((CHECKSUM (\IPCHECKSUM PACKET CHECKSUMBASE NBYTES CHECKSUMWORD))) (\PUTBASE CHECKSUMWORD 0 (COND ((EQ CHECKSUM (MASK.1'S 0 16)) CHECKSUM) (T (LOGAND (LOGNOT CHECKSUM) (MASK.1'S 0 16]) ) (* ;; "Protocol Distribution") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (RPAQQ IPPROTOCOLTYPES ((\ICMP.PROTOCOL 1) (\TCP.PROTOCOL 6) (\UDP.PROTOCOL 17))) (DECLARE%: EVAL@COMPILE (RPAQQ \ICMP.PROTOCOL 1) (RPAQQ \TCP.PROTOCOL 6) (RPAQQ \UDP.PROTOCOL 17) (CONSTANTS (\ICMP.PROTOCOL 1) (\TCP.PROTOCOL 6) (\UDP.PROTOCOL 17)) ) (* "END EXPORTED DEFINITIONS") ) (RPAQ? \IP.PROTOCOLS ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \IP.PROTOCOLS) ) (DEFINEQ (\IP.HAND.TO.PROTOCOL [LAMBDA (IP) (* ejs%: "31-Mar-86 15:39") (PROG ((PROTOCOL (ffetch (IP IPPROTOCOL) of IP)) PROTOCOLCHAIN IPSOCKET) (COND ((NOT (SETQ PROTOCOLCHAIN (\IP.FIND.PROTOCOL PROTOCOL \IP.PROTOCOLS))) (OR (\IP.BROADCAST.ADDRESS (fetch (IP IPDESTINATIONADDRESS) of IP)) (\ICMP.DEST.UNREACHABLE IP \ICMP.PROTOCOL.UNREACHABLE))) ((NOT (SETQ IPSOCKET (\IP.FIND.PROTOCOL.SOCKET IP PROTOCOLCHAIN))) (APPLY* (ffetch (IPSOCKET IPSNOSOCKETFN) of PROTOCOLCHAIN) IP)) (T (APPLY* (ffetch (IPSOCKET IPSINPUTFN) of (COND ((type? IPSOCKET IPSOCKET) IPSOCKET) (T PROTOCOLCHAIN))) IP IPSOCKET]) (\IP.DEFAULT.INPUTFN [LAMBDA (IP IPSOCKET) (* ejs%: " 3-Feb-85 19:19") (COND ((EQ (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET) (fetch (IPSOCKET IPSQUEUEALLOC) of IPSOCKET)) (\RELEASE.ETHERPACKET IP)) (T (UNINTERRUPTABLY (\ENQUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET) IP) (add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET) 1) (NOTIFY.EVENT (fetch (IPSOCKET IPSEVENT) of IPSOCKET)))]) (\IP.DEFAULT.NOSOCKETFN [LAMBDA (IP) (* ejs%: " 2-Feb-86 11:38") (COND ([OR (NEQ 0 (fetch (IP IPDESTINATIONHOST) of IP)) (NOT (\IP.BROADCAST.ADDRESS (fetch (IP IPDESTINATIONADDRESS) of IP] (\ICMP.DEST.UNREACHABLE IP \ICMP.PORT.UNREACHABLE)) (T (\RELEASE.ETHERPACKET IP]) (\IP.ADD.PROTOCOL [LAMBDA (PROTOCOL SOCKETCOMPAREFN NOSOCKETFN INPUTFN ICMPFN) (* ; "Edited 25-Aug-88 12:10 by bvm") (* ;;; "Find an existing protocol, or create a new one, and return the socket chain head. If the protocol already exists, the remaining arguments redefine the current slots.") (LET* [(FOUND (find SOCKET in \IP.PROTOCOLS suchthat (EQ (fetch (IPSOCKET PROTOCOL) of SOCKET) PROTOCOL))) (SOCKET (OR FOUND (create IPSOCKET PROTOCOL _ PROTOCOL IPSQUEUE _ NIL IPSQUEUEALLOC _ 0 IPSEVENT _ NIL] (replace (IPSOCKET IPSDESTSOCKETCOMPAREFN) of SOCKET with SOCKETCOMPAREFN) (replace (IPSOCKET IPSINPUTFN) of SOCKET with (OR INPUTFN (FUNCTION \IP.DEFAULT.INPUTFN ))) (replace (IPSOCKET IPSNOSOCKETFN) of SOCKET with (OR NOSOCKETFN (FUNCTION \IP.DEFAULT.NOSOCKETFN))) (replace (IPSOCKET IPSICMPFN) of SOCKET with (OR ICMPFN (FUNCTION \RELEASE.ETHERPACKET)) ) (if (NOT FOUND) then (* ;  "Now that it's all filled in, add it to the protocol set") (push \IP.PROTOCOLS SOCKET)) SOCKET]) (\IP.DELETE.PROTOCOL [LAMBDA (PROTOCOL) (* ejs%: "10-Apr-85 16:24") (LET ((PROTOCOLCHAIN (\IP.FIND.PROTOCOL PROTOCOL))) (COND (PROTOCOLCHAIN (until (NULL (fetch (IPSOCKET IPSLINK) of PROTOCOLCHAIN)) do (\IP.CLOSE.SOCKET (fetch (IPSOCKET IPSOCKET) of (fetch (IPSOCKET IPSLINK) of PROTOCOLCHAIN)) PROTOCOL)) (SETQ \IP.PROTOCOLS (DREMOVE PROTOCOLCHAIN \IP.PROTOCOLS)) T]) (\IP.FIND.PROTOCOL [LAMBDA (PROTOCOL) (* ejs%: "27-Dec-84 11:18") (* * Find the protocol chain for this protocol#) (CAR (SOME \IP.PROTOCOLS (FUNCTION (LAMBDA (IPSOCKET) (EQ (ffetch (IPSOCKET PROTOCOL) of IPSOCKET) PROTOCOL]) (\IP.FIND.PROTOCOL.SOCKET [LAMBDA (IP PROTOCOLCHAIN) (* ; "Edited 26-Aug-88 12:44 by bvm") (* ;; "Find the socket specified by IP packet. PROTOCOLCHAIN is the head of the socket chain for this protocol; if NIL we look it up.") (LET ([SOCKET (OR PROTOCOLCHAIN (\IP.FIND.PROTOCOL (ffetch (IP IPPROTOCOL) of IP] RESULT) (* ;; "Note that we start the comparisons with the dummy head, even though we expect that to fail. This is so that a socketless protocol, such as ICMP can use this dummy head as the sole handler of the protocol.") (AND SOCKET (when (SETQ RESULT (CL:FUNCALL (ffetch (IPSOCKET IPSDESTSOCKETCOMPAREFN) of SOCKET) IP SOCKET)) do (RETURN (COND ((EQ RESULT T) SOCKET) (T (* ; "This is a little strange. Non-T comparison result will be passed as the second arg to the chain head's inputfn when a packet arrives here.") RESULT))) repeatwhile (SETQ SOCKET (ffetch (IPSOCKET IPSLINK ) of SOCKET]) (\IP.FIND.SOCKET [LAMBDA (SOCKET# SOCKETCHAIN) (* ejs%: "27-Dec-84 11:39") (* * Called to find the socket open on the socketchain, or NIL if no such open  socket. Socketchain comes from \IP.FIND.PROTOCOL) (while SOCKETCHAIN until (COND ((EQUAL SOCKET# (ffetch (IPSOCKET IPSOCKET) of SOCKETCHAIN )) SOCKETCHAIN) (T (SETQ SOCKETCHAIN (ffetch (IPSOCKET IPSLINK) of SOCKETCHAIN)) NIL)) finally (RETURN SOCKETCHAIN]) (\IP.OPEN.SOCKET [LAMBDA (PROTOCOL SOCKET NOERRORFLG DESTSOCKETCOMPAREFN NOSOCKETFN INPUTFN ICMPFN) (* ; "Edited 25-Aug-88 12:43 by bvm") (* ;;; "Open a new socket for a protocol. The last 4 fns default to those specified when the protocol was enabled.") (* ;; "Keeping NOSOCKETFN for back compatibility, but it doesn't really make any sense --bvm.") (LET ((MASTERSOC (\IP.FIND.PROTOCOL PROTOCOL)) OLDSOC NEWSOC) (COND [(NOT (type? IPSOCKET MASTERSOC)) (COND ((NOT NOERRORFLG) (ERROR "Attempt to open socket in unknown protocol" PROTOCOL SOCKET] [(if SOCKET then (SETQ OLDSOC (\IP.FIND.SOCKET SOCKET MASTERSOC)) else (* ;  "Pick a random socket that is smallp but not very small, so as to avoid well-known sockets") (SETQ SOCKET (LOGOR (LOGAND (DAYTIME) 65535) 32768)) (while (\IP.FIND.SOCKET SOCKET MASTERSOC) do (SETQ SOCKET (- SOCKET 1))) NIL) (COND (NOERRORFLG OLDSOC) (T (ERROR "Attempt to open an existing socket" OLDSOC] (T [SETQ NEWSOC (create IPSOCKET IPSLINK _ (ffetch (IPSOCKET IPSLINK) of MASTERSOC) IPSOCKET _ SOCKET PROTOCOL _ PROTOCOL IPSDESTSOCKETCOMPAREFN _ (OR DESTSOCKETCOMPAREFN (ffetch (IPSOCKET IPSDESTSOCKETCOMPAREFN ) of MASTERSOC )) IPSNOSOCKETFN _ (OR NOSOCKETFN (ffetch (IPSOCKET IPSNOSOCKETFN ) of MASTERSOC )) IPSINPUTFN _ (OR INPUTFN (ffetch (IPSOCKET IPSINPUTFN) of MASTERSOC)) IPSICMPFN _ (OR ICMPFN (ffetch (IPSOCKET IPSICMPFN) of MASTERSOC] (freplace (IPSOCKET IPSLINK) of MASTERSOC with NEWSOC) NEWSOC]) (\IP.CLOSE.SOCKET [LAMBDA (SOCKET PROTOCOL NOERRORFLG) (* ; "Edited 26-Aug-88 12:33 by bvm") (* ;;; "Close the given socket. Call this only after the higher level protocol has finished doing its closing operations.") (* ;; "For some silly reason, this fn was defined to take not an IPSOCKET object but rather the socket number, or whatever was in the socket slot. For backward compatibility, let's do both (sigh).") (LET ((PREV (\IP.FIND.PROTOCOL PROTOCOL)) NEXT) (COND [(AND PREV (while (SETQ NEXT (ffetch (IPSOCKET IPSLINK) of PREV)) do (if (OR (EQ SOCKET NEXT) (EQ SOCKET (ffetch (IPSOCKET IPSOCKET) of NEXT)) ) then (* ; "Found it, so splice it out") (freplace (IPSOCKET IPSLINK) of PREV with (ffetch (IPSOCKET IPSLINK) of NEXT)) (freplace (IPSOCKET IPSLINK) of NEXT with NIL) (RETURN T)) (SETQ PREV NEXT] ((NOT NOERRORFLG) (ERROR "Socket not found" SOCKET]) ) (* ;; "Fragmentation Handling") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (RECORD AssemblyRecord (Packet FirstHole Fragments Timeout) Packet _ (\ALLOCATE.ETHERPACKET) FirstHole _ 0) (RECORD FragmentRecord (Start Length LastFragment)) (RECORD FragmentID (AssemblyRecord SourceAddress ID Protocol . DestinationAddress)) ) (* "END EXPORTED DEFINITIONS") ) (RPAQ? \IP.FRAGMENT.LIST ) (RPAQ? \IP.FRAGMENT.LOCK (CREATE.MONITORLOCK "IP Fragment Processing Lock")) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \IP.FRAGMENT.LIST \IP.FRAGMENT.LOCK) ) (DECLARE%: EVAL@COMPILE (RPAQQ \IP.FRAGMENTATION.UNIT 8) (CONSTANTS (\IP.FRAGMENTATION.UNIT 8)) ) (DEFINEQ (\HANDLE.RAW.IP.FRAGMENT [LAMBDA (IP) (* ejs%: " 1-Feb-86 14:24") (* * Add the next fragment to a packet under assembly.  If this fragment completes a packet, return the completed packet to be  processed by higher-level protocol routines.) (WITH.MONITOR \IP.FRAGMENT.LOCK (LET ((AssemblyRecord (\IP.FIND.MATCHING.FRAGMENTS IP))) (COND (AssemblyRecord (\IP.ADD.FRAGMENT AssemblyRecord IP)) (T (\IP.NEW.FRAGMENT.LST IP) NIL))))]) (\IP.NEW.FRAGMENT.LST [LAMBDA (IP) (* ejs%: " 3-Feb-86 10:57") (* * Add a new fragment to the fragment list) (PROG ((Source (ffetch (IP IPSOURCEADDRESS) of IP)) (Dest (ffetch (IP IPDESTINATIONADDRESS) of IP)) (Protocol (ffetch (IP IPPROTOCOL) of IP)) (ID (ffetch (IP IPID) of IP)) NewFragmentID FragmentRecord AssemblyPacket AssemblyRecord) [SETQ NewFragmentID (create FragmentID SourceAddress _ Source ID _ ID Protocol _ Protocol DestinationAddress _ Dest AssemblyRecord _ (SETQ AssemblyRecord (create AssemblyRecord Timeout _ (SETUPTIMER (ITIMES 1000 (ffetch (IP IPTIMETOLIVE) of IP))) Fragments _ (LIST (SETQ FragmentRecord (create FragmentRecord Start _ (UNFOLD (ffetch (IP IPFRAGMENTOFFSET ) of IP) \IP.FRAGMENTATION.UNIT) Length _ (IDIFFERENCE (ffetch (IP IPTOTALLENGTH) of IP) (UNFOLD (ffetch (IP IPHEADERLENGTH ) of IP) BYTESPERCELL] (COND ((EQ IPTRACEFLG T) (\IP.PRINT.FRAGMENT NewFragmentID IP IPTRACEFILE))) (SETQ AssemblyPacket (fetch (AssemblyRecord Packet) of AssemblyRecord)) (\IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER AssemblyPacket IP) (* * Copy the packet data to the packet) (\BLT (\ADDBASE (\IPDATABASE AssemblyPacket) (FOLDLO (fetch (FragmentRecord Start) of FragmentRecord) BYTESPERWORD)) (\IPDATABASE IP) (FOLDLO (fetch (FragmentRecord Length) of FragmentRecord) BYTESPERWORD)) (\RELEASE.ETHERPACKET IP) (push \IP.FRAGMENT.LIST NewFragmentID]) (\IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER [LAMBDA (Packet Fragment) (* ejs%: " 1-Feb-86 14:14") (* * Copy information from the header of the fragment packet into the header of  the reassembled packet) (\MOVEBYTES (fetch (IP IPBASE) of Fragment) 0 (fetch (IP IPBASE) of Packet) 0 (UNFOLD (fetch (IP IPHEADERLENGTH) of Fragment) BYTESPERCELL]) (\IP.ADD.FRAGMENT [LAMBDA (FragmentID NewIP) (* ejs%: " 1-Feb-86 18:41") (* * Called to add a fragment to a fragment list.  The fragment is added in order. If the fragment completes a fragmented IP  packet, a new packet is assembled and returned, else NIL is returned) (LET* ((AssemblyRecord (fetch (FragmentID AssemblyRecord) of FragmentID)) [NewFrag (create FragmentRecord Start _ (UNFOLD (ffetch (IP IPFRAGMENTOFFSET) of NewIP) \IP.FRAGMENTATION.UNIT) Length _ (IDIFFERENCE (ffetch (IP IPTOTALLENGTH) of NewIP) (UNFOLD (ffetch (IP IPHEADERLENGTH) of NewIP) BYTESPERCELL)) LastFragment _ (NOT (fetch (IP IPMOREFRAGMENTS) of NewIP] (Fragments (fetch (AssemblyRecord Fragments) of AssemblyRecord)) Status NextHole AssemblyPacket) (COND ((EQ IPTRACEFLG T) (\IP.PRINT.FRAGMENT FragmentID NewIP IPTRACEFILE))) (SETQ AssemblyPacket (fetch (AssemblyRecord Packet) of AssemblyRecord)) (replace (AssemblyRecord Timeout) of AssemblyRecord with (SETUPTIMER (ITIMES 1000 (ffetch (IP IPTIMETOLIVE) of NewIP)) (fetch (AssemblyRecord Timeout) of AssemblyRecord))) [SETQ Status (COND ((ILESSP (fetch (FragmentRecord Start) of NewFrag) (fetch (FragmentRecord Start) of (CAR Fragments))) (* Earlier than the earliest  existing fragment) (SETQ Fragments (push (fetch (AssemblyRecord Fragments) of AssemblyRecord ) NewFrag)) 'INSERTED.FRAGMENT) ((EQ (fetch (FragmentRecord Start) of NewFrag) (fetch (FragmentRecord Start) of (CAR Fragments))) (* Duplicate of earliest fragment) 'DUPLICATE) (T (* Have to search) (for OldFragTail on Fragments while (CDR OldFragTail) thereis (COND ((EQ (fetch (FragmentRecord Start) of NewFrag) (fetch (FragmentRecord Start) of (CADR OldFragTail ))) (* Duplicate) (SETQ Status 'DUPLICATE) T) ((ILESSP (fetch (FragmentRecord Start) of NewFrag) (fetch (FragmentRecord Start) of (CADR OldFragTail))) (* Found the hole to insert) T)) finally (COND (Status (* Duplicate) (RETURN Status)) ((CDR OldFragTail) (* Inserted in middle of list) (RPLACD OldFragTail (CONS NewFrag (CDR OldFragTail) )) (RETURN 'INSERTED.FRAGMENT)) (T (* Inserted at end of list) (NCONC1 OldFragTail NewFrag) (RETURN 'INSERTED.FRAGMENT] (PROG1 (SELECTQ Status (DUPLICATE NIL) (INSERTED.FRAGMENT (* Copy bytes into assembly) (\MOVEBYTES (\IPDATABASE NewIP) 0 (\IPDATABASE AssemblyPacket) (fetch (FragmentRecord Start) of NewFrag) (fetch (FragmentRecord Length) of NewFrag)) (add (ffetch (IP IPTOTALLENGTH) of AssemblyPacket) (fetch (FragmentRecord Length) of NewFrag)) (* Update Assembly record) [COND ((ILESSP (fetch (FragmentRecord Start) of NewFrag) (fetch (AssemblyRecord FirstHole) of AssemblyRecord)) (ERROR "Error in IP fragment reassembly!" NewFrag)) (T (COND ((EQ [bind End Status for FragTail on Fragments while (CDR FragTail) thereis [COND ((NEQ [SETQ End (IPLUS (fetch ( FragmentRecord Start) of (CAR FragTail)) (fetch ( FragmentRecord Length) of (CAR FragTail] (fetch (FragmentRecord Start) of (CADR FragTail))) (replace (AssemblyRecord FirstHole) of AssemblyRecord with End) (SETQ Status 'FOUND.HOLE] finally (RETURN (COND [(NULL Status) (COND ((fetch (FragmentRecord LastFragment) of (CAR FragTail)) (COND ((EQ IPTRACEFLG T) (printout IPTRACEFILE T "Complete IP Fragment received" T))) 'COMPLETE.PACKET) (T (replace (AssemblyRecord FirstHole) of AssemblyRecord with End) 'INCOMPLETE.BUT.NO.HOLES] (T Status] 'COMPLETE.PACKET) (\IP.DELETE.FRAGMENT FragmentID) AssemblyPacket]) NIL) (\RELEASE.ETHERPACKET NewIP]) (\IP.FIND.MATCHING.FRAGMENTS [LAMBDA (IP) (* ejs%: " 1-Feb-86 14:41") (* * Find the list of fragments matching this IP packet, or NIL if none exists) (DECLARE (GLOBALVARS \IP.FRAGMENT.LIST)) (LET* ((Source (ffetch (IP IPSOURCEADDRESS) of IP)) (Dest (ffetch (IP IPDESTINATIONADDRESS) of IP)) (Protocol (ffetch (IP IPPROTOCOL) of IP)) (ID (ffetch (IP IPID) of IP)) (FragmentEntry)) (for FragmentID in \IP.FRAGMENT.LIST thereis (AND (EQP (fetch (FragmentID SourceAddress ) of FragmentID) Source) (EQ (fetch (FragmentID ID) of FragmentID) ID) (EQ (fetch (FragmentID Protocol) of FragmentID) Protocol) (EQP (fetch (FragmentID DestinationAddress ) of FragmentID) Dest]) (\IP.FRAGMENTED.PACKET [LAMBDA (IP) (* ejs%: " 1-Feb-86 16:50") (* * Return T if IP packet is a fragment) (OR (ffetch (IP IPMOREFRAGMENTS) of IP) (NEQ 0 (ffetch (IP IPFRAGMENTOFFSET) of IP]) (\IP.CHECK.REASSEMBLY.TIMEOUTS [LAMBDA NIL (* ejs%: " 3-Feb-86 11:00") (* * Kill any fragments in the process of reassembly if their timeout has  expired. Report timeout via ICMP) (WITH.MONITOR \IP.FRAGMENT.LOCK (bind AssemblyRecord for Fragment in \IP.FRAGMENT.LIST when [TIMEREXPIRED? (fetch (AssemblyRecord Timeout) of (SETQ AssemblyRecord (fetch (FragmentID AssemblyRecord ) of Fragment] do (COND ((EQ IPTRACEFLG T) (printout IPTRACEFILE T "IP Fragment timeout expired" T))) (\ICMP.TIME.EXCEEDED (fetch (AssemblyRecord Packet) of AssemblyRecord) \ICMP.FRAGMENT.TIME.EXCEEDED) (\IP.DELETE.FRAGMENT Fragment T)))]) (\IP.DELETE.FRAGMENT [LAMBDA (FragmentID FreePacketToo) (* ejs%: " 3-Feb-86 10:59") (* * Delete FragmentID from the list of Fragment ID's) (PROG [(IP (fetch (AssemblyRecord Packet) of (fetch (FragmentID AssemblyRecord) of FragmentID] (SETQ \IP.FRAGMENT.LIST (DREMOVE FragmentID \IP.FRAGMENT.LIST)) (AND FreePacketToo (\RELEASE.ETHERPACKET IP]) (\IP.PRINT.FRAGMENT [LAMBDA (FragmentID IPFragment File) (* ejs%: " 2-Feb-86 10:39") (* * Print information about this fragement to File) (printout File T "Received IP Fragment:" T "Source " (\IP.ADDRESS.TO.STRING (fetch (FragmentID SourceAddress) of FragmentID)) " Dest " (\IP.ADDRESS.TO.STRING (fetch (FragmentID DestinationAddress) of FragmentID)) T "Protocol ") (PRINTCONSTANT (fetch (FragmentID Protocol) of FragmentID) IPPROTOCOLTYPES File) (printout File " ID " (fetch (FragmentID ID) of FragmentID) T "Covering [" (UNFOLD (ffetch (IP IPFRAGMENTOFFSET) of IPFragment) \IP.FRAGMENTATION.UNIT) ".." (IPLUS (UNFOLD (ffetch (IP IPFRAGMENTOFFSET) of IPFragment) \IP.FRAGMENTATION.UNIT) (IDIFFERENCE (ffetch (IP IPTOTALLENGTH) of IPFragment) (UNFOLD (ffetch (IP IPHEADERLENGTH) of IPFragment) BYTESPERCELL))) "]" T) (bind C for I from 0 to [SUB1 (IMIN 40 (IDIFFERENCE (ffetch (IP IPTOTALLENGTH ) of IPFragment) (UNFOLD (ffetch (IP IPHEADERLENGTH ) of IPFragment) BYTESPERCELL] do (SETQ C (\GETBASEBYTE (\IPDATABASE IPFragment) I)) (COND ((AND (IGEQ C (CHARCODE SPACE)) (ILEQ C 126)) (BOUT File C)) (T (printout File "[" C "]"]) ) (* ;; "Option Processing") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (RPAQQ IPOPTIONTYPES ((IPOPT.END 0) (IPOPT.NOP 1) (IPOPT.SECURITY 2) (IPOPT.LSRR 3) (IPOPT.TIMESTAMP 4) (IPOPT.RECRT 7) (IPOPT.STREAMID 8) (IPOPT.SSSR 9))) (DECLARE%: EVAL@COMPILE (RPAQQ IPOPT.END 0) (RPAQQ IPOPT.NOP 1) (RPAQQ IPOPT.SECURITY 2) (RPAQQ IPOPT.LSRR 3) (RPAQQ IPOPT.TIMESTAMP 4) (RPAQQ IPOPT.RECRT 7) (RPAQQ IPOPT.STREAMID 8) (RPAQQ IPOPT.SSSR 9) (CONSTANTS (IPOPT.END 0) (IPOPT.NOP 1) (IPOPT.SECURITY 2) (IPOPT.LSRR 3) (IPOPT.TIMESTAMP 4) (IPOPT.RECRT 7) (IPOPT.STREAMID 8) (IPOPT.SSSR 9)) ) (DECLARE%: EVAL@COMPILE (RPAQ IP.OPTION.NUMBER.BYTESPEC (BYTE 5 0)) (CONSTANTS (IP.OPTION.NUMBER.BYTESPEC (BYTE 5 0))) ) (* "END EXPORTED DEFINITIONS") ) (DEFINEQ (\IP.PROCESS.OPTIONS [LAMBDA (IP) (* ; "Edited 20-Jan-89 12:24 by bvm") (* ;;; "Process option fields in IP header. Return T if OK, else handle internally needed actions like redirection or reporting of parameter problems") (bind (OPTIONSSTART _ (LOCF (ffetch (IP IPOPTIONSSTART) of IP))) (INDEX _ 0) (RESULT _ T) REROUTING OPTION until (OR (>= INDEX (- (UNFOLD (fetch (IP IPHEADERLENGTH) of IP) BYTESPERCELL) \IPOVLEN)) (EQ (SETQ OPTION (LDB (BYTE 5 0) (\GETBASEBYTE OPTIONSSTART INDEX))) IPOPT.END)) do (if (EQ OPTION IPOPT.NOP) then (* ;  "This is the only one-byte option we know of other than IPOPT.END") (add INDEX 1) else (SELECTC OPTION ((LIST IPOPT.LSRR IPOPT.SSSR) (COND (REROUTING (SETQ RESULT INDEX)) ((NEQ (SETQ RESULT (\IP.OPTION.STRICT.SOURCE.ROUTE IP INDEX) ) 'REROUTE) (SETQ REROUTING T)))) (IPOPT.RECRT (SETQ RESULT (\IP.OPTION.RECORD.ROUTE IP INDEX))) (IPOPT.TIMESTAMP (\IP.OPTION.TIMESTAMP IP INDEX)) (IPOPT.SECURITY) (IPOPT.STREAMID) (PROGN (* ;  "Unknown option code-- we can't continue, since it could be some unknown 1-byte option") (RETURN NIL))) (COND ((NUMBERP RESULT) (* ;;  "If the result is a number then there was a parameter problem. We could process them here.") (RETURN NIL))) (add INDEX (\GETBASEBYTE OPTIONSSTART (ADD1 INDEX))) (* ; "Increment by the length field") ) finally (RETURN RESULT]) (\IP.OPTION.RECORD.ROUTE [LAMBDA (IP INDEX) (* ; "Edited 2-Aug-88 14:57 by atm") (LET* [(OPTIONSSTART (LOCF (ffetch (IP IPOPTIONSSTART) of IP))) (LENGTH (\GETBASEBYTE OPTIONSSTART (IPLUS INDEX 1))) (PTR (\GETBASEBYTE OPTIONSSTART (IPLUS INDEX 2] (* ;; "From RFC 791: If the route data area is already full just forward. If there is room , but not enough for a full address to be inserted, signal an ICMP error. Otherwise insert the address into the datagram and update PTR.") (COND ((IGREATERP PTR LENGTH) NIL) ((ILESSP (IDIFFERENCE LENGTH PTR) 3) INDEX) (T (\PUTBASEFIXP OPTIONSSTART (IPLUS INDEX PTR) (CAR \IP.LOCAL.ADDRESSES)) (\PUTBASEBYTE OPTIONSSTART (IPLUS INDEX 2) (LDB (BYTE 8 0) (IPLUS PTR 4))) T]) (\IP.OPTION.STRICT.SOURCE.ROUTE [LAMBDA (IP INDEX) (* ; "Edited 8-Aug-88 12:05 by atm") (LET* ((OPTIONSSTART (LOCF (ffetch (IP IPOPTIONSSTART) of IP))) (LENGTH (\GETBASEBYTE OPTIONSSTART (IPLUS INDEX 1))) (PTR (\GETBASEBYTE OPTIONSSTART (IPLUS INDEX 2))) (DESTINATIONADDRESSLOC (LOCF (ffetch (IP IPDESTINATIONADDRESS) of IP))) (DESTINATIONADDRESS (\GETBASEFIXP DESTINATIONADDRESSLOC 0))) (* ;; "From RFC 791: If the address in the destination field has been reached and PTR is not greater than LENGTH, the next address in the source route replaces the address in the destination address field, and the recorded route address replaces the source address just used, and PTR is increased by four.") (COND ((IGREATERP PTR LENGTH) NIL) ((ILESSP (IDIFFERENCE LENGTH PTR) 3) INDEX) (T (COND ((MEMBER DESTINATIONADDRESS \IP.LOCAL.ADDRESSES) (\PUTBASEFIXP OPTIONSSTART (IPLUS PTR INDEX 4) DESTINATIONADDRESS) (\PUTBASEFIXP DESTINATIONADDRESSLOC 0 (\GETBASEFIXP OPTIONSSTART (IPLUS PTR INDEX ))) (\PUTBASEBYTE OPTIONSSTART (IPLUS INDEX 2) (LDB (BYTE 8 0) (IPLUS PTR 4))) 'REROUTE) (T]) (\IP.OPTION.TIMESTAMP [LAMBDA (IP INDEX) (* ; "Edited 8-Aug-88 12:08 by atm") (LET* ((OPTIONSSTART (LOCF (ffetch (IP IPOPTIONSSTART) of IP))) (LENGTH (\GETBASEBYTE OPTIONSSTART (IPLUS INDEX 1))) (PTR (\GETBASEBYTE OPTIONSSTART (IPLUS INDEX 2))) (OFLW/FLG (\GETBASEBYTE OPTIONSSTART (IPLUS INDEX 3))) FLAG) (* ;; "From RFC 791: If the timestamp area is already full then increment the overflow flag and forward the datagram without inserting the timestamp. If there is room but not enough for a full timestamp to be inserted then signal an ICMP error. Otherwise insert the timestamp or the timestamp and the internet address depending on the flag; 0 indicates timestamp only, 1 indicates timestamp and address, 3 indicates that the address is prespecified.") (COND ((IGREATERP PTR LENGTH) (\PUTBASEBYTE OPTIONSSTART (IPLUS INDEX 3) (IPLUS OFLW/FLG (LSH 1 4))) T) (T (SELECTQ (LOGAND 15 OFLW/FLG) (0 (COND ((ILESSP (IDIFFERENCE LENGTH PTR) 3) INDEX) (T (\PUTBASEFIXP OPTIONSSTART (IPLUS INDEX PTR) (\CLOCK0 (\CREATECELL \FIXP))) (\PUTBASEBYTE OPTIONSSTART (IPLUS INDEX 2) (LDB (BYTE 8 0) (IPLUS PTR 4))) T))) (1 (COND ((IGREATERP 8 (IDIFFERENCE LENGTH (SUB1 PTR))) INDEX) (T (\PUTBASEFIXP OPTIONSSTART (IPLUS INDEX PTR) (CAR \IP.LOCAL.ADDRESSES)) (\PUTBASEFIXP OPTIONSSTART (IPLUS INDEX PTR 4) (\CLOCK0 (\CREATECELL \FIXP))) (\PUTBASEBYTE OPTIONSSTART (IPLUS INDEX 2) (LDB (BYTE 8 0) (IPLUS PTR 8))) T))) (3 [COND ((IGREATERP 8 (IDIFFERENCE LENGTH (SUB1 PTR))) INDEX) (T (COND ((MEMBER (\GETBASEFIXP OPTIONSSTART (IPLUS INDEX PTR)) \IP.LOCAL.ADDRESSES) (\PUTBASEFIXP OPTIONSSTART (IPLUS INDEX PTR 4) (\CLOCK0 (\CREATECELL \FIXP))) (\PUTBASEBYTE OPTIONSSTART (IPLUS INDEX 2) (LDB (BYTE 8 0) (IPLUS PTR 8))) T) (T NIL]) INDEX]) ) (* ;; "Packet Transmission and routing") (RPAQ? \IP.ROUTING.TABLE (CONS)) (RPAQ? \IP.DEFAULT.GATEWAY ) (RPAQ? \IP.LOCAL.NETWORKS ) (RPAQ? \IP.GATEWAY.FORWARDING.FUNCTIONS ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \IP.ROUTING.TABLE \IP.DEFAULT.GATEWAY \IP.LOCAL.NETWORKS \IP.GATEWAY.FORWARDING.FUNCTIONS ) ) (DEFINEQ (\IP.SETUPIP [LAMBDA (IP DESTHOST ID SOCKET REQUEUE) (* ejs%: "31-Mar-86 15:01") (* * Initialize IP header of packet.) (OR IP (SETQ IP (\ALLOCATE.ETHERPACKET))) (replace (IP IPVERSION) of IP with \IP.PROTOCOLVERSION) (freplace (IP IPHEADERLENGTH) of IP with (FOLDHI \IPOVLEN BYTESPERCELL)) (freplace (IP IPTOTALLENGTH) of IP with \IPOVLEN) [freplace (IP IPID) of IP with (OR (SMALLP ID) (LOGAND (DAYTIME) (MASK.1'S 0 16] (freplace (IP IPMOREFRAGMENTS) of IP with NIL) (freplace (IP IPFRAGMENTOFFSET) of IP with 0) (freplace (IP IPTIMETOLIVE) of IP with \IP.DEFAULT.TIME.TO.LIVE) (freplace (IP IPPROTOCOL) of IP with (fetch (IPSOCKET PROTOCOL) of SOCKET)) (freplace (IP IPSOURCEADDRESS) of IP with (CAR \IP.LOCAL.ADDRESSES)) (freplace (IP IPDESTINATIONADDRESS) of IP with DESTHOST) (freplace EPREQUEUE of IP with REQUEUE) IP]) (\IP.TRANSMIT [LAMBDA (IP ROUTINGREADONLY) (* ejs%: "27-Jan-86 15:59") (* * Sends an IP packet, after first computing the IP header checksum) (PROG (NDB) (SETQ IP (\DTEST IP 'ETHERPACKET)) (until \IP.READY do (AWAIT.EVENT \IP.READY.EVENT)) (\RCLK (LOCF (ffetch EPTIMESTAMP of IP))) (replace EPTYPE of IP with \EPT.IP) (RETURN (COND ((ffetch EPTRANSMITTING of IP) (AND IPTRACEFLG (printout IPTRACEFILE "[Put fails--packet already being transmitted]")) 'AlreadyQueued) ((NOT (SETQ NDB (\IP.ROUTE.PACKET IP ROUTINGREADONLY))) (AND IPTRACEFLG (PRINTPACKET IP 'PUT IPTRACEFILE "[Put fails--no routing]")) (\REQUEUE.ETHERPACKET IP) 'NoRouting) (T (\IP.SET.CHECKSUM IP (ffetch (IP IPBASE) of IP) (LLSH (ffetch (IP IPHEADERLENGTH) of IP) 2) (LOCF (ffetch (IP IPHEADERCHECKSUM) of IP))) [COND (IPTRACEFLG (COND ((EQ IPTRACEFLG T) (PRINTPACKET IP 'PUT IPTRACEFILE)) (T (PRIN1 "!" IPTRACEFILE] (TRANSMIT.ETHERPACKET NDB IP) NIL]) (\IP.ROUTE.PACKET [LAMBDA (IP READONLY) (* ; "Edited 19-Jan-89 18:00 by bvm") (* ;; "Encapsulates XIP, choosing the right network and immediate destination host. Returns an NDB for the transmission. Unless READONLY is true, defaults source and destination nets if needed") (DECLARE (GLOBALVARS \10MBLOCALNDB \3MBLOCALNDB \IP.LOCAL.NETWORKS \IP.DEFAULT.GATEWAY)) (PROG ((DESTADDRESS (fetch (IP IPDESTINATIONADDRESS) of IP)) DESTNET SUBNETMASK SOURCEHOSTADDRESS SUBNETINUSE PDH ROUTE NDB EPTYPE BROADCASTP) (SETQ DESTNET (\IPNETADDRESS DESTADDRESS)) (* ;; "Try to resolve a destination network of 0.0 If we have two attached networks, fail.") [COND ((AND (EQ 0 DESTADDRESS) \10MBLOCALNDB \3MBLOCALNDB) (RETURN)) ((EQ 0 DESTADDRESS) '[SETQ DESTADDRESS (\IP.MAKE.BROADCAST.ADDRESS (fetch NDBIPHOST# of (OR \10MBLOCALNDB \3MBLOCALNDB] (SETQ DESTADDRESS -1) (SETQ BROADCASTP T) '(SETQ DESTNET (\IPNETADDRESS DESTADDRESS)) (SETQ DESTNET (CAAR \IP.LOCAL.NETWORKS] (* ;; "First see if the destination network is one of our local networks") [COND [(AND (SETQ NDB (CDR (SASSOC DESTNET \IP.LOCAL.NETWORKS))) (SETQ SUBNETMASK (CDR (SASSOC (SETQ SOURCEHOSTADDRESS (fetch (NDB NDBIPHOST#) of NDB)) \IP.SUBNET.MASKS))) (OR (AND (\IP.BROADCAST.ADDRESS DESTADDRESS) (SETQ BROADCASTP T)) (EQP (LOGAND SOURCEHOSTADDRESS SUBNETMASK) (LOGAND DESTADDRESS SUBNETMASK)) (PROGN (SETQ SUBNETINUSE T) NIL))) (* ;; "A local net. Try to find the Ethernet address of the host") (COND [(SETQ PDH (SELECTQ (fetch (NDB NETTYPE) of NDB) (10 (SETQ EPTYPE \EPT.IP) (COND (BROADCASTP BROADCASTNSHOSTNUMBER) (T (\AR.TRANSLATE.TO.10MB DESTADDRESS)))) (3 (SETQ EPTYPE \EET.IP) (\AR.TRANSLATE.TO.3MB DESTADDRESS)) (SHOULDNT] (T (* ; "Nope") (RETURN] (T (* ;; "The host is not on a local net. See if we have a route to that host, or use the default route if necessary") (COND [(SETQ ROUTE (OR [COND (SUBNETINUSE (CDR (SASSOC (LOGAND DESTADDRESS SUBNETMASK) \IP.ROUTING.TABLE))) (T (CDR (SASSOC DESTNET \IP.ROUTING.TABLE] \IP.DEFAULT.GATEWAY)) (* ;; "We've got the IP address of the gateway") (COND [(SETQ NDB (CDR (SASSOC (\IPNETADDRESS ROUTE) \IP.LOCAL.NETWORKS))) (* ;; "We know what network it's on") (COND [(SETQ PDH (SELECTQ (fetch (NDB NETTYPE) of NDB) (10 (SETQ EPTYPE \EPT.IP) (\AR.TRANSLATE.TO.10MB ROUTE)) (3 (SETQ EPTYPE \EET.IP) (\AR.TRANSLATE.TO.3MB ROUTE)) (SHOULDNT] (T (RETURN] (T (ERROR "IP routing table contains non-local gateway address for network" DESTNET] (T (RETURN] (freplace EPNETWORK of IP with NDB) (ENCAPSULATE.ETHERPACKET NDB IP PDH (ffetch (IP IPTOTALLENGTH) of IP) EPTYPE) (replace EPTYPE of IP with EPTYPE) [COND ((NOT READONLY) (COND ((EQ 0 (fetch (IP IPDESTINATIONADDRESS) of IP)) (freplace (IP IPDESTINATIONADDRESS) of IP with DESTADDRESS))) (freplace (IP IPSOURCEADDRESS) of IP with (fetch NDBIPHOST# of NDB] (RETURN NDB]) ) (DEFINEQ (IP.GET [LAMBDA (IPSOCKET WAIT) (* ejs%: "31-Mar-86 14:30") (* * Returns the next IP packet on the queue, or NIL if none exist and WAIT is  NIL. If WAIT is T, this function waits forever.  If WAIT is an integer, it is interpreted as the number of milliseconds to wait  before returning NIL or a packet which arrives during that time.  This function therefore is like GETXIP and GETPUP) (PROG ((QUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET)) IP TIMER) LP (UNINTERRUPTABLY (COND ((SETQ IP (\DEQUEUE QUEUE)) (add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET) -1)))) [COND ((NULL IP) (COND (WAIT (COND ((EQ WAIT T)) [TIMER (COND ((TIMEREXPIRED? TIMER) (RETURN] (T (OR (FIXP WAIT) (LISPERROR "NON-NUMERIC ARG" WAIT)) (SETQ TIMER (SETUPTIMER WAIT)) T)) (AWAIT.EVENT (fetch (IPSOCKET IPSEVENT) of IPSOCKET) TIMER T) (GO LP)) (T (BLOCK] (RETURN IP]) (IP.SEND [LAMBDA (IP) (* ejs%: "31-Mar-86 15:07") (\IP.TRANSMIT IP]) (IP.PACKET.WATCHER [LAMBDA (IPSOCKET PACKET.FUNCTION) (* ejs%: "31-Mar-86 15:50") (* * Infinite loop which waits for packet on IPSOCKET, and calls  PACKET.FUNCTION whenever one arrives) (COND ((NOT (type? IPSOCKET IPSOCKET)) (ERROR "ARG NOT IPSOCKET" IPSOCKET)) ((NOT (FNTYP PACKET.FUNCTION)) (ERROR "UNDEFINED FUNCTION" PACKET.FUNCTION)) (T (while T do (APPLY* PACKET.FUNCTION (IP.GET IPSOCKET T) IPSOCKET]) ) (DECLARE%: EVAL@COMPILE [PUTPROPS IP.SEND MACRO (LAMBDA (IP) (* ejs%: "31-Mar-86 15:07") (\IP.TRANSMIT IP] ) (* ;; "Client functions for building packets") (DEFINEQ (\IP.APPEND.BYTE [LAMBDA (IP BYTE INHEADER) (* ejs%: "28-Dec-84 08:23") (* * Append a byte to an IP packet. If INHEADER is not NIL, we adjust the  header length field as well.) (PROG (NEWLENGTH) (\PUTBASEBYTE (fetch (IP IPBASE) of IP) (fetch (IP IPTOTALLENGTH) of IP) BYTE) (SETQ NEWLENGTH (add (ffetch (IP IPTOTALLENGTH) of IP) 1)) [COND (INHEADER (freplace (IP IPHEADERLENGTH) of IP with (FOLDHI NEWLENGTH 4] (RETURN NEWLENGTH]) (\IP.APPEND.CELL [LAMBDA (IP CELL INHEADER) (* ejs%: "28-Dec-84 08:33") (* * Append a cell to an IP packet. If INHEADER is not NIL, we adjust the  header length field as well.) (PROG (NEWLENGTH (OFFSET (fetch (IP IPTOTALLENGTH) of IP))) [COND ((EVENP OFFSET) (\PUTBASEFIXP (fetch (IP IPBASE) of IP) (FOLDLO OFFSET 2) CELL)) (T (\PUTBASEBYTE (fetch (IP IPBASE) of IP) OFFSET (LDB (BYTE 8 24) CELL)) (\PUTBASEBYTE (fetch (IP IPBASE) of IP) (\ADDBASE OFFSET 1) (LDB (BYTE 8 16) CELL)) (\PUTBASEBYTE (fetch (IP IPBASE) of IP) (\ADDBASE OFFSET 2) (LDB (BYTE 8 8) CELL)) (\PUTBASEBYTE (fetch (IP IPBASE) of IP) (\ADDBASE OFFSET 3) (LDB (BYTE 8 0) CELL] (SETQ NEWLENGTH (add (ffetch (IP IPTOTALLENGTH) of IP) 4)) (COND (INHEADER (add (ffetch (IP IPHEADERLENGTH) of IP) 1))) (RETURN NEWLENGTH]) (\IP.APPEND.STRING [LAMBDA (IP STRING) (* ejs%: " 9-Feb-85 19:44") (PROG ((LENGTH (fetch (STRINGP LENGTH) of STRING))) (\MOVEBYTES (fetch (STRINGP BASE) of STRING) (fetch (STRINGP OFFST) of STRING) (fetch (IP IPBASE) of IP) (fetch (IP IPTOTALLENGTH) of IP) LENGTH) (RETURN (add (ffetch (IP IPTOTALLENGTH) of IP) LENGTH]) (\IP.APPEND.WORD [LAMBDA (IP WORD INHEADER) (* ejs%: "28-Dec-84 08:28") (* * Append a word to an IP packet. If INHEADER is not NIL, we adjust the  header length field as well.) (PROG (NEWLENGTH (OFFSET (fetch (IP IPTOTALLENGTH) of IP))) [COND ((EVENP OFFSET) (\PUTBASE (fetch (IP IPBASE) of IP) (FOLDLO OFFSET 2) WORD)) (T (\PUTBASEBYTE (fetch (IP IPBASE) of IP) OFFSET (LDB (BYTE 8 8) WORD)) (\PUTBASEBYTE (fetch (IP IPBASE) of IP) (\ADDBASE OFFSET 1) (LDB (BYTE 8 0) WORD] (SETQ NEWLENGTH (add (ffetch (IP IPTOTALLENGTH) of IP) 2)) [COND (INHEADER (freplace (IP IPHEADERLENGTH) of IP with (FOLDHI NEWLENGTH 4] (RETURN NEWLENGTH]) (\IP.GET.BYTE [LAMBDA (IP BYTE INHEADER) (* ejs%: "30-Mar-86 14:49") (* * Retrieve a byte from an IP packet.  If INHEADER is T, BYTE is an offset from the start of the packet, else it's an  offset from the start of the IP data section) (\GETBASEBYTE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTE]) (\IP.GET.CELL [LAMBDA (IP CELL INHEADER) (* ejs%: "30-Mar-86 15:07") (* * Retrieve a cell from an IP packet.  If INHEADER is not NIL, the cell is written to the header portion of the IP  packet, else it's written to the data portion.  CELL is the offset, in 16-bit units) (\GETBASEFIXP (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) CELL]) (\IP.GET.STRING [LAMBDA (IP BYTEOFFSET NCHARS INHEADER) (* ejs%: "30-Mar-86 15:13") (* * Retrieve a string from an IP packet.  If INHEADER is T, BYTEOFFSET is an offset from the start of the packet, else  it's an offset from the start of the IP data section) (\GETBASESTRING (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTEOFFSET NCHARS]) (\IP.GET.WORD [LAMBDA (IP WORD INHEADER) (* ejs%: "30-Mar-86 14:51") (* * Retrieve a word from an IP packet.  If INHEADER is T, WORD is an offset from the start of the packet, else it's an  offset from the start of the IP data section) (\GETBASE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) WORD]) (\IP.PUT.BYTE [LAMBDA (IP BYTE VALUE INHEADER) (* ejs%: "30-Mar-86 14:52") (* * Store a byte in an IP packet. If INHEADER is T, BYTE is an offset from the  start of the packet, else it's an offset from the start of the IP data section) (\PUTBASEBYTE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTE VALUE]) (\IP.PUT.CELL [LAMBDA (IP CELL VALUE INHEADER) (* ejs%: "30-Mar-86 15:06") (* * Store a cell in an IP packet. If INHEADER is not NIL, the cell is written  to the header portion of the IP packet, else it's written to the data portion.  CELL is the offset, in 16-bit units) (\PUTBASEFIXP (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) CELL VALUE]) (\IP.PUT.STRING [LAMBDA (IP BYTEOFFSET STRING INHEADER) (* ejs%: "30-Mar-86 15:13") (* * Store a string ib an IP packet. If INHEADER is T, BYTEOFFSET is an offset  from the start of the packet, else it's an offset from the start of the IP data  section) (\PUTBASESTRING (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTEOFFSET STRING]) (\IP.PUT.WORD [LAMBDA (IP WORD VALUE INHEADER) (* ejs%: "30-Mar-86 14:50") (* * Store a word in an IP packet. If INHEADER is T, WORD is an offset from the  start of the packet, else it's an offset from the start of the IP data section) (\PUTBASE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) WORD VALUE]) ) (DECLARE%: EVAL@COMPILE [PUTPROPS \IP.GET.BYTE DMACRO (LAMBDA (IP BYTE INHEADER) (* ejs%: "30-Mar-86 14:49") (* * Retrieve a byte from an IP packet.  If INHEADER is T, BYTE is an offset from the start of the packet, else it's an  offset from the start of the IP data section) (\GETBASEBYTE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTE] [PUTPROPS \IP.GET.CELL DMACRO (LAMBDA (IP CELL INHEADER) (* ejs%: "30-Mar-86 15:07") (* * Retrieve a cell from an IP packet.  If INHEADER is not NIL, the cell is written to the header portion of the IP  packet, else it's written to the data portion.  CELL is the offset, in 16-bit units) (\GETBASEFIXP (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) CELL] [PUTPROPS \IP.GET.STRING DMACRO (LAMBDA (IP BYTEOFFSET NCHARS INHEADER) (* ejs%: "30-Mar-86 15:13") (* * Retrieve a string from an IP packet.  If INHEADER is T, BYTEOFFSET is an offset from the start of the packet, else  it's an offset from the start of the IP data section) (\GETBASESTRING (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTEOFFSET NCHARS] [PUTPROPS \IP.GET.WORD DMACRO (LAMBDA (IP WORD INHEADER) (* ejs%: "30-Mar-86 14:51") (* * Retrieve a word from an IP packet.  If INHEADER is T, WORD is an offset from the start of the packet, else it's an  offset from the start of the IP data section) (\GETBASE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) WORD] [PUTPROPS \IP.PUT.BYTE DMACRO (LAMBDA (IP BYTE VALUE INHEADER) (* ejs%: "30-Mar-86 14:52") (* * Store a byte in an IP packet. If INHEADER is T, BYTE is an offset from the  start of the packet, else it's an offset from the start of the IP data section) (\PUTBASEBYTE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTE VALUE] [PUTPROPS \IP.PUT.CELL DMACRO (LAMBDA (IP CELL VALUE INHEADER) (* ejs%: "30-Mar-86 15:06") (* * Store a cell in an IP packet. If INHEADER is not NIL, the cell is written  to the header portion of the IP packet, else it's written to the data portion.  CELL is the offset, in 16-bit units) (\PUTBASEFIXP (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) CELL VALUE] [PUTPROPS \IP.PUT.STRING DMACRO (LAMBDA (IP BYTEOFFSET STRING INHEADER) (* ejs%: "30-Mar-86 15:13") (* * Store a string ib an IP packet. If INHEADER is T, BYTEOFFSET is an offset  from the start of the packet, else it's an offset from the start of the IP data  section) (\PUTBASESTRING (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) BYTEOFFSET STRING] [PUTPROPS \IP.PUT.WORD DMACRO (LAMBDA (IP WORD VALUE INHEADER) (* ejs%: "30-Mar-86 14:50") (* * Store a word in an IP packet. If INHEADER is T, WORD is an offset from the  start of the packet, else it's an offset from the start of the IP data section) (\PUTBASE (COND (INHEADER (fetch (IP IPBASE) of IP)) (T (\IPDATABASE IP))) WORD VALUE] ) (MOVD? 'NILL 'IP.DEFAULT.CONFIGURATION) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \IP.LOCAL.NETWORKS \IP.DEFAULT.GATEWAY \IP.INIT.FILE \IP.SUBNET.MASKS \PROCESS.AFTEREXIT.EVENT \PROC.READY \AR.IP.TO.10MB.ALIST) ) ) (PUTPROPS TCPLLIP COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (33488 35161 (\SYSQUEUE.DEFPRINT 33498 . 33847) (\IPSOCKET.DEFPRINT 33849 . 35159)) ( 36483 52693 (\CANONICALIZE.IP.HOSTNAME 36493 . 36686) (DODIP.HOSTP 36688 . 37144) (IPHOSTADDRESS 37146 . 37814) (IPHOSTNAME 37816 . 38028) (IPTRACE 38030 . 38227) (IPTRACEWINDOW.BUTTONFN 38229 . 38826) ( PRINTIP 38828 . 41424) (PRINTIPDATA 41426 . 42106) (\IPADDRESSCLASS 42108 . 42705) (\IPEVENTFN 42707 . 43055) (\IPHOSTADDRESS 43057 . 43873) (\IPNETADDRESS 43875 . 44739) (\IP.ADDRESS.TO.STRING 44741 . 45229) (\IP.BROADCAST.ADDRESS 45231 . 48921) (\IP.LEGAL.ADDRESS 48923 . 49271) ( \IP.MAKE.BROADCAST.ADDRESS 49273 . 49713) (\IP.PRINT.ADDRESS 49715 . 50333) (\IP.READ.STRING.ADDRESS 50335 . 52200) (\DOMAIN.NAME.QUALIFY.FULLY 52202 . 52691)) (53342 70901 (STOPIP 53352 . 53628) ( \IPINIT 53630 . 55639) (\IPLISTENER 55641 . 56413) (\IP.REINITIALIZE.FROM.SCRATCH 56415 . 61690) ( \IP.RESTART.FROM.CONFIGURATION 61692 . 66877) (\IP.MAYBE.READ.HOSTS.TXT 66879 . 68355) ( \IP.READ.INIT.FILE 68357 . 70174) (\IP.PROMPT.FOR.FILE.NAME 70176 . 70899)) (75225 84872 ( \HANDLE.RAW.IP 75235 . 77533) (\FORWARD.IP 77535 . 80265) (\IP.LOCAL.DESTINATION 80267 . 82052) ( \IPCHECKSUM 82054 . 84204) (\IP.CHECKSUM.OK 84206 . 84382) (\IP.SET.CHECKSUM 84384 . 84870)) (85442 97726 (\IP.HAND.TO.PROTOCOL 85452 . 86504) (\IP.DEFAULT.INPUTFN 86506 . 87105) (\IP.DEFAULT.NOSOCKETFN 87107 . 87491) (\IP.ADD.PROTOCOL 87493 . 89620) (\IP.DELETE.PROTOCOL 89622 . 90351) ( \IP.FIND.PROTOCOL 90353 . 90740) (\IP.FIND.PROTOCOL.SOCKET 90742 . 92342) (\IP.FIND.SOCKET 92344 . 93234) (\IP.OPEN.SOCKET 93236 . 96216) (\IP.CLOSE.SOCKET 96218 . 97724)) (98507 118821 ( \HANDLE.RAW.IP.FRAGMENT 98517 . 99124) (\IP.NEW.FRAGMENT.LST 99126 . 102391) ( \IP.COPY.FRAGMENT.HEADER.TO.PACKET.HEADER 102393 . 102894) (\IP.ADD.FRAGMENT 102896 . 111986) ( \IP.FIND.MATCHING.FRAGMENTS 111988 . 114409) (\IP.FRAGMENTED.PACKET 114411 . 114700) ( \IP.CHECK.REASSEMBLY.TIMEOUTS 114702 . 116007) (\IP.DELETE.FRAGMENT 116009 . 116501) ( \IP.PRINT.FRAGMENT 116503 . 118819)) (119865 128230 (\IP.PROCESS.OPTIONS 119875 . 122592) ( \IP.OPTION.RECORD.ROUTE 122594 . 123607) (\IP.OPTION.STRICT.SOURCE.ROUTE 123609 . 125209) ( \IP.OPTION.TIMESTAMP 125211 . 128228)) (128581 136430 (\IP.SETUPIP 128591 . 129761) (\IP.TRANSMIT 129763 . 131402) (\IP.ROUTE.PACKET 131404 . 136428)) (136431 138607 (IP.GET 136441 . 137907) (IP.SEND 137909 . 138041) (IP.PACKET.WATCHER 138043 . 138605)) (138832 146433 (\IP.APPEND.BYTE 138842 . 139504) (\IP.APPEND.CELL 139506 . 140978) (\IP.APPEND.STRING 140980 . 141518) (\IP.APPEND.WORD 141520 . 142611) (\IP.GET.BYTE 142613 . 143077) (\IP.GET.CELL 143079 . 143589) (\IP.GET.STRING 143591 . 144084) (\IP.GET.WORD 144086 . 144538) (\IP.PUT.BYTE 144540 . 144994) (\IP.PUT.CELL 144996 . 145496) ( \IP.PUT.STRING 145498 . 145987) (\IP.PUT.WORD 145989 . 146431))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPNAMES b/obsolete/tcp/TCPNAMES new file mode 100644 index 00000000..13c7aa25 --- /dev/null +++ b/obsolete/tcp/TCPNAMES @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10) (FILECREATED " 8-Oct-90 17:23:42" |{LISPDEV:LAIR:OHIO-STATE}TCPNAMES.;2| 70558 changes to%: (VARS TCPNAMESCOMS) (FNS REPACKFILENAME.STRING REPACKFILENAME.STRING.D REPACKFILENAME.STRING.MSDOS REPACKFILENAME.STRING.TI REPACKFILENAME.STRING.VMS REPACKFILENAME.STRING.3600 REPACKFILENAME.STRING.TOPS20 REPACKFILENAME.STRING.UNIX \REPACKFILENAME.NEW.TRANSLATION \REPACKFILENAME.NEW.TRANSLATIONS) previous date%: "12-Sep-90 17:37:35" {DSK}gadener>medley>work>tcp>tcpnames.;2) (* ; " Copyright (c) 1985, 1987, 1988, 1989, 1990 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPNAMESCOMS) (RPAQQ TCPNAMESCOMS [(PROP MAKEFILE-ENVIRONMENT TCPNAMES) (PROP FILETYPE TCPNAMES) (FNS REPACKFILENAME.STRING REPACKFILENAME.STRING.D REPACKFILENAME.STRING.MSDOS REPACKFILENAME.STRING.TI REPACKFILENAME.STRING.VMS REPACKFILENAME.STRING.3600 REPACKFILENAME.STRING.TOPS20 REPACKFILENAME.STRING.UNIX \REPACKFILENAME.NEW.TRANSLATION \REPACKFILENAME.NEW.TRANSLATIONS) (INITVARS (\REPACKFILENAME.OSTYPE.TABLE (HASHARRAY 30 1.1))) (GLOBALVARS \REPACKFILENAME.OSTYPE.TABLE) (P (\REPACKFILENAME.NEW.TRANSLATIONS (INTERLISP IFS) REPACKFILENAME.STRING.D (TOPS-20 TOPS20) REPACKFILENAME.STRING.TOPS20 (SYMBOLICS-3600 LISPM GENERA) REPACKFILENAME.STRING.3600 VMS REPACKFILENAME.STRING.VMS UNIX REPACKFILENAME.STRING.UNIX MS-DOS REPACKFILENAME.STRING.MSDOS)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA \REPACKFILENAME.NEW.TRANSLATIONS) (NLAML) (LAMA REPACKFILENAME.STRING.UNIX REPACKFILENAME.STRING.TOPS20 REPACKFILENAME.STRING.3600 REPACKFILENAME.STRING.VMS REPACKFILENAME.STRING.TI REPACKFILENAME.STRING.MSDOS REPACKFILENAME.STRING.D]) (PUTPROPS TCPNAMES MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP" :BASE 10)) (PUTPROPS TCPNAMES FILETYPE :BCOMPL) (DEFINEQ (REPACKFILENAME.STRING [LAMBDA (NAME FOROSTYPE) (* ; "Edited 29-Sep-90 11:47 by welch") (DECLARE (GLOBALVARS \REPACKFILENAME.OSTYPE.TABLE)) (LET ((REPACKFUNCTION (GETHASH FOROSTYPE \REPACKFILENAME.OSTYPE.TABLE))) (COND ((NULL REPACKFUNCTION) NAME) (T (APPLY REPACKFUNCTION (UNPACKFILENAME.STRING NAME]) (REPACKFILENAME.STRING.D [LAMBDA N (* ; "Edited 8-Oct-90 16:23 by welch") (* * Convert file names to native format) (if (AND (EQ N 1) (LISTP (ARG N 1))) then (* spread argument list) (APPLY (FUNCTION REPACKFILENAME.STRING.D) (ARG N 1)) else (PROG ((BLIP "") (I 1) HOST DEVICE STRUCTURE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY DIR NAME EXTENSION VERSION PACKLIST VAR VAL TEMP) (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION)) LP (COND ((NOT (IGREATERP I N)) (COND ((LISTP (SETQ VAR (ARG N I))) (SETQ VAL (CDR VAR)) (SETQ VAR (CAR VAR))) ((NOT (IGREATERP (SETQ I (ADD1 I)) N)) (SETQ VAL (ARG N I))) (T (SETQ VAL))) (OR (STRINGP VAL) (ATOM VAL) (ERRORX (LIST 27 VAL))) (* fields must be atom) (SELECTQ VAR (BODY (MAP (UNPACKFILENAME.STRING (COND ((LISTP VAL) (* PACKFILENAME.STRING for error  checking of fields) (REPACKFILENAME.STRING.D VAL)) (T VAL))) [FUNCTION (LAMBDA (X) (* NIL => not yet seen, BLIP => seen  as NIL.) (OR (EVALV (CAR X)) (SET (CAR X) (OR (CADR X) BLIP] (FUNCTION CDDR))) (HOST (OR HOST (SETQ HOST (if VAL then (SELCHARQ (CHCON1 VAL) (({ %[ %() (SUBSTRING VAL 2 (SELCHARQ (NTHCHARCODE VAL -1) ((} %] %)) -2) -1))) VAL) else BLIP)))) (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (RELATIVEDIRECTORY (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (DIRECTORY (OR DIRECTORY (SETQ DIRECTORY (OR VAL BLIP)))) ((DEVICE HOST NAME EXTENSION VERSION) (OR (EVALV VAR) (SET VAR (OR VAL BLIP)))) (\ILLEGAL.ARG VAR)) (SETQ I (ADD1 I)) (GO LP))) (RETURN (CONCATLIST (NCONC (AND HOST (NEQ HOST BLIP) (LIST "{" HOST "}")) [AND DEVICE (NEQ DEVICE BLIP) (SELCHARQ (NTHCHARCODE DEVICE -1) (%: (LIST DEVICE)) (LIST DEVICE '%:] (AND DIRECTORY (NEQ DIRECTORY BLIP) (PROGN (SETQ DIRECTORY (CONCAT DIRECTORY)) [for C from 1 to (NCHARS DIRECTORY) do (COND ([FMEMB (NTHCHARCODE DIRECTORY C) (CONSTANT (LIST (CHARCODE \) (CHARCODE /] (RPLCHARCODE DIRECTORY C (CHARCODE >] (LIST "<" DIRECTORY ">")) (LIST "<" DIRECTORY ">")) (AND SUBDIRECTORY (NEQ SUBDIRECTORY BLIP) (PROGN (SETQ SUBDIRECTORY (CONCAT SUBDIRECTORY)) [for C from 1 to (NCHARS SUBDIRECTORY) do (COND ([FMEMB (NTHCHARCODE SUBDIRECTORY C) (CONSTANT (CHARCODE >) (LIST (CHARCODE \) (CHARCODE /] (RPLCHARCODE SUBDIRECTORY C (CHARCODE >] (LIST "<" SUBDIRECTORY ">")) (LIST "<" SUBDIRECTORY ">")) (AND RELATIVEDIRECTORY (NEQ RELATIVEDIRECTORY BLIP) (PROGN (SETQ RELATIVEDIRECTORY (CONCAT RELATIVEDIRECTORY)) [for C from 1 to (NCHARS RELATIVEDIRECTORY) do (COND ([FMEMB (NTHCHARCODE RELATIVEDIRECTORY C) (CONSTANT (CHARCODE >) (LIST (CHARCODE \) (CHARCODE /] (RPLCHARCODE RELATIVEDIRECTORY C (CHARCODE >] (LIST "<" RELATIVEDIRECTORY ">")) (LIST "<" RELATIVEDIRECTORY ">")) (AND NAME (NEQ NAME BLIP) (LIST NAME)) (AND (OR (AND EXTENSION (NEQ EXTENSION BLIP)) (AND VERSION (NEQ VERSION BLIP))) (LIST (COND ((AND EXTENSION (EQ (CHCON1 EXTENSION) (CHARCODE %.))) BLIP) (T '%.)) (OR EXTENSION BLIP))) (AND VERSION (NEQ VERSION BLIP) (COND ((FIXP VERSION) (LIST '; VERSION)) (T (SELCHARQ (CHCON1 VERSION) (; (LIST VERSION)) ((%. !) (LIST '; (SUBSTRING VERSION 2 -1))) (LIST '; VERSION]) (REPACKFILENAME.STRING.MSDOS [LAMBDA N (* ; "Edited 8-Oct-90 16:48 by welch") (if (AND (EQ N 1) (LISTP (ARG N 1))) then (* spread argument list) (APPLY (FUNCTION REPACKFILENAME.STRING.MSDOS) (ARG N 1)) else (PROG ((BLIP "") (I 1) HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION PACKLIST VAR RELATIVEDIRECTORY SUBDIRECTORY VAL TEMP) (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY NAME EXTENSION VERSION)) LP (COND ((NOT (IGREATERP I N)) (COND ((LISTP (SETQ VAR (ARG N I))) (SETQ VAL (CDR VAR)) (SETQ VAR (CAR VAR))) ((NOT (IGREATERP (SETQ I (ADD1 I)) N)) (SETQ VAL (ARG N I))) (T (SETQ VAL))) (OR (STRINGP VAL) (ATOM VAL) (ERRORX (LIST 27 VAL))) (* fields must be atom) (SELECTQ VAR (BODY (MAP (UNPACKFILENAME.STRING (COND ((LISTP VAL) (* PACKFILENAME.STRING for error  checking of fields) (REPACKFILENAME.STRING.MSDOS VAL)) (T VAL))) [FUNCTION (LAMBDA (X) (* NIL => not yet seen, BLIP => seen  as NIL.) (OR (EVALV (CAR X)) (SET (CAR X) (OR (CADR X) BLIP] (FUNCTION CDDR))) (HOST (OR HOST (SETQ HOST (if VAL then (SELCHARQ (CHCON1 VAL) (({ %[ %() (SUBSTRING VAL 2 (SELCHARQ (NTHCHARCODE VAL -1) ((} %] %)) -2) -1))) VAL) else BLIP)))) (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (RELATIVEDIRECTORY (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (DIRECTORY (OR DIRECTORY (SETQ DIRECTORY (OR VAL BLIP)))) ((DEVICE HOST NAME EXTENSION VERSION) (OR (EVALV VAR) (SET VAR (OR VAL BLIP)))) (\ILLEGAL.ARG VAR)) (SETQ I (ADD1 I)) (GO LP))) (RETURN (CONCATLIST (NCONC (AND HOST (NEQ HOST BLIP) (LIST "{" HOST "}")) (AND DEVICE (NEQ DEVICE BLIP) (LIST ":" DEVICE)) (AND DIRECTORY (NEQ DIRECTORY BLIP) (PROGN (SETQ DIRECTORY (CONCAT DIRECTORY)) [for C from 1 to (NCHARS DIRECTORY) do (COND ([FMEMB (NTHCHARCODE DIRECTORY C) (CONSTANT (LIST (CHARCODE >) (CHARCODE %.) (CHARCODE /] (RPLCHARCODE DIRECTORY C (CHARCODE \] (LIST "\" DIRECTORY "\")) (LIST "\" DIRECTORY "\")) (AND SUBDIRECTORY (NEQ SUBDIRECTORY BLIP) (PROGN (SETQ SUBDIRECTORY (CONCAT SUBDIRECTORY)) [for C from 1 to (NCHARS SUBDIRECTORY) do (COND ([FMEMB (NTHCHARCODE SUBDIRECTORY C) (CONSTANT (LIST (CHARCODE >) (CHARCODE %.) (CHARCODE /] (RPLCHARCODE SUBDIRECTORY C (CHARCODE \] (LIST "\" SUBDIRECTORY "\")) (LIST "\" SUBDIRECTORY "\")) (AND RELATIVEDIRECTORY (NEQ RELATIVEDIRECTORY BLIP) (PROGN (SETQ RELATIVEDIRECTORY (CONCAT RELATIVEDIRECTORY)) [for C from 1 to (NCHARS RELATIVEDIRECTORY) do (COND ([FMEMB (NTHCHARCODE RELATIVEDIRECTORY C) (CONSTANT (LIST (CHARCODE >) (CHARCODE %.) (CHARCODE /] (RPLCHARCODE RELATIVEDIRECTORY C (CHARCODE \] (LIST "\" RELATIVEDIRECTORY "\")) (LIST "\" RELATIVEDIRECTORY "\")) (AND NAME (NEQ NAME BLIP) (LIST NAME)) (AND (OR (AND EXTENSION (NEQ EXTENSION BLIP)) (AND VERSION (NEQ VERSION BLIP))) (LIST (COND ((OR (AND EXTENSION (EQ (CHCON1 EXTENSION) (CHARCODE %.))) (OR (NULL EXTENSION) (EQ EXTENSION BLIP) (STREQUAL EXTENSION ""))) BLIP) (T '%.)) (OR EXTENSION BLIP]) (REPACKFILENAME.STRING.TI [LAMBDA N (* ; "Edited 8-Oct-90 16:59 by welch") (* * Can you believe this???) (if (AND (EQ N 1) (LISTP (ARG N 1))) then (* spread argument list) (APPLY (FUNCTION REPACKFILENAME.STRING.TI) (ARG N 1)) else (PROG ((BLIP "") (I 1) HOST DEVICE STRUCTURE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY NAME EXTENSION VERSION PACKLIST VAR VAL TEMP) (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY NAME EXTENSION VERSION)) LP (COND ((NOT (IGREATERP I N)) (COND ((LISTP (SETQ VAR (ARG N I))) (SETQ VAL (CDR VAR)) (SETQ VAR (CAR VAR))) ((NOT (IGREATERP (SETQ I (ADD1 I)) N)) (SETQ VAL (ARG N I))) (T (SETQ VAL))) (OR (STRINGP VAL) (ATOM VAL) (ERRORX (LIST 27 VAL))) (* fields must be atom) (SELECTQ VAR (BODY (MAP (UNPACKFILENAME.STRING (COND ((LISTP VAL) (* PACKFILENAME.STRING for error  checking of fields) (REPACKFILENAME.STRING.TI VAL)) (T VAL))) [FUNCTION (LAMBDA (X) (* NIL => not yet seen, BLIP => seen  as NIL.) (OR (EVALV (CAR X)) (SET (CAR X) (OR (CADR X) BLIP] (FUNCTION CDDR))) (HOST (OR HOST (SETQ HOST (if VAL then (SELCHARQ (CHCON1 VAL) (({ %[ %() (SUBSTRING VAL 2 (SELCHARQ (NTHCHARCODE VAL -1) ((} %] %)) -2) -1))) VAL) else BLIP)))) (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (RELATIVEDIRECTORY (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (DIRECTORY (OR DIRECTORY (SETQ DIRECTORY (OR VAL BLIP)))) ((DEVICE HOST NAME EXTENSION VERSION) (OR (EVALV VAR) (SET VAR (OR VAL BLIP)))) (\ILLEGAL.ARG VAR)) (SETQ I (ADD1 I)) (GO LP))) (RETURN (CONCATLIST (NCONC (AND HOST (NEQ HOST BLIP) (LIST HOST ":")) (AND DEVICE (NEQ DEVICE BLIP) (SELCHARQ (NTHCHARCODE DEVICE -1) (%: (LIST DEVICE)) (LIST DEVICE |':|))) (AND DIRECTORY (NEQ DIRECTORY BLIP) (PROGN (SETQ DIRECTORY (CONCAT DIRECTORY)) [for C from 1 to (NCHARS DIRECTORY) do (COND ([FMEMB (NTHCHARCODE DIRECTORY C) (CONSTANT (LIST (CHARCODE >) (CHARCODE /) (CHARCODE \] (RPLCHARCODE DIRECTORY C (CHARCODE %.] (LIST DIRECTORY ";"))) (AND SUBDIRECTORY (NEQ SUBDIRECTORY BLIP) (PROGN (SETQ SUBDIRECTORY (CONCAT SUBDIRECTORY)) [for C from 1 to (NCHARS SUBDIRECTORY) do (COND ([FMEMB (NTHCHARCODE SUBDIRECTORY C) (CONSTANT (LIST (CHARCODE >) (CHARCODE /) (CHARCODE \] (RPLCHARCODE SUBDIRECTORY C (CHARCODE %.] (LIST SUBDIRECTORY ";"))) (AND RELATIVEDIRECTORY (NEQ RELATIVEDIRECTORY BLIP) (PROGN (SETQ RELATIVEDIRECTORY (CONCAT RELATIVEDIRECTORY)) [for C from 1 to (NCHARS RELATIVEDIRECTORY) do (COND ([FMEMB (NTHCHARCODE RELATIVEDIRECTORY C) (CONSTANT (LIST (CHARCODE >) (CHARCODE /) (CHARCODE \] (RPLCHARCODE RELATIVEDIRECTORY C (CHARCODE %.] (LIST RELATIVEDIRECTORY ";"))) (AND NAME (NEQ NAME BLIP) (LIST NAME)) (AND (OR (AND EXTENSION (NEQ EXTENSION BLIP)) (AND VERSION (NEQ VERSION BLIP))) (LIST (COND ((AND EXTENSION (EQ (CHCON1 EXTENSION) (CHARCODE %.))) BLIP) (T '%.)) (OR EXTENSION BLIP))) (AND VERSION (NEQ VERSION BLIP) (COND ((FIXP VERSION) (LIST '%# VERSION)) (T (SELCHARQ (CHCON1 VERSION) (%# (LIST VERSION)) ((%. ! ;) (LIST '%# (SUBSTRING VERSION 2 -1))) (L (LIST '%# 'OLDEST)) ((H 0) (LIST '%# '>)) (LIST '%# VERSION]) (REPACKFILENAME.STRING.VMS [LAMBDA N (* ; "Edited 8-Oct-90 16:52 by welch") (if (AND (EQ N 1) (LISTP (ARG N 1))) then (* spread argument list) (APPLY (FUNCTION REPACKFILENAME.STRING.VMS) (ARG N 1)) else (PROG ((BLIP "") (I 1) HOST DEVICE STRUCTURE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY NAME EXTENSION VERSION TEMPORARY PROTECTION ACCOUNT PACKLIST VAR VAL TEMP) (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY NAME EXTENSION VERSION TEMPORARY PROTECTION ACCOUNT)) LP (COND ((NOT (IGREATERP I N)) (COND ((LISTP (SETQ VAR (ARG N I))) (SETQ VAL (CDR VAR)) (SETQ VAR (CAR VAR))) ((NOT (IGREATERP (SETQ I (ADD1 I)) N)) (SETQ VAL (ARG N I))) (T (SETQ VAL))) (OR (STRINGP VAL) (ATOM VAL) (ERRORX (LIST 27 VAL))) (* fields must be atom) (SELECTQ VAR (BODY (MAP (UNPACKFILENAME.STRING (COND ((LISTP VAL) (* PACKFILENAME.STRING for error  checking of fields) (REPACKFILENAME.STRING.VMS VAL)) (T VAL))) [FUNCTION (LAMBDA (X) (* NIL => not yet seen, BLIP => seen  as NIL.) (OR (EVALV (CAR X)) (SET (CAR X) (OR (CADR X) BLIP] (FUNCTION CDDR))) (HOST (OR HOST (SETQ HOST (if VAL then (SELCHARQ (CHCON1 VAL) (({ %[ %() (SUBSTRING VAL 2 (SELCHARQ (NTHCHARCODE VAL -1) ((} %] %)) -2) -1))) VAL) else BLIP)))) (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (RELATIVEDIRECTORY (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (DIRECTORY (OR DIRECTORY (SETQ DIRECTORY (OR VAL BLIP)))) ((DEVICE HOST NAME EXTENSION VERSION) (OR (EVALV VAR) (SET VAR (OR VAL BLIP)))) (\ILLEGAL.ARG VAR)) (SETQ I (ADD1 I)) (GO LP))) (RETURN (CONCATLIST (NCONC (AND HOST (NEQ HOST BLIP) (LIST "{" HOST "}")) [AND DEVICE (NEQ DEVICE BLIP) (SELCHARQ (NTHCHARCODE DEVICE -1) (%: (LIST DEVICE)) (LIST DEVICE '%:] (AND DIRECTORY (NEQ DIRECTORY BLIP) (PROGN (SETQ DIRECTORY (CONCAT DIRECTORY)) [for C from 1 to (NCHARS DIRECTORY) do (COND ([FMEMB (NTHCHARCODE DIRECTORY C) (CONSTANT (LIST (CHARCODE /) (CHARCODE >] (RPLCHARCODE DIRECTORY C (CHARCODE %.] (LIST "[" DIRECTORY "]"))) (AND SUBDIRECTORY (NEQ SUBDIRECTORY BLIP) (PROGN (SETQ SUBDIRECTORY (CONCAT SUBDIRECTORY)) [for C from 1 to (NCHARS SUBDIRECTORY) do (COND ([FMEMB (NTHCHARCODE SUBDIRECTORY C) (CONSTANT (LIST (CHARCODE /) (CHARCODE >] (RPLCHARCODE SUBDIRECTORY C (CHARCODE %.] (LIST "[" SUBDIRECTORY "]"))) (AND RELATIVEDIRECTORY (NEQ RELATIVEDIRECTORY BLIP) (PROGN (SETQ RELATIVEDIRECTORY (CONCAT RELATIVEDIRECTORY)) [for C from 1 to (NCHARS RELATIVEDIRECTORY) do (COND ([FMEMB (NTHCHARCODE RELATIVEDIRECTORY C) (CONSTANT (LIST (CHARCODE /) (CHARCODE >] (RPLCHARCODE RELATIVEDIRECTORY C (CHARCODE %.] (LIST "[" RELATIVEDIRECTORY "]"))) (AND NAME (NEQ NAME BLIP) (LIST NAME)) (AND (OR (AND EXTENSION (NEQ EXTENSION BLIP)) (AND VERSION (NEQ VERSION BLIP))) (LIST (COND ((AND EXTENSION (EQ (CHCON1 EXTENSION) (CHARCODE %.))) BLIP) (T '%.)) (OR EXTENSION BLIP))) (AND VERSION (NEQ VERSION BLIP) (COND ((FIXP VERSION) (LIST '; VERSION)) (T (SELCHARQ (CHCON1 VERSION) (; (LIST VERSION)) ((%. !) (LIST '; (SUBSTRING VERSION 2 -1))) (LIST '; VERSION]) (REPACKFILENAME.STRING.3600 [LAMBDA N (* ; "Edited 8-Oct-90 16:46 by welch") (* * Can you believe this???) (if (AND (EQ N 1) (LISTP (ARG N 1))) then (* spread argument list) (APPLY (FUNCTION REPACKFILENAME.STRING.3600) (ARG N 1)) else (PROG ((BLIP "") (I 1) HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION PACKLIST VAR VAL TEMP RELATIVEDIRECTORY SUBDIRECTORY) (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION SUBDIRECTORY RELATIVEDIRECTORY)) LP (COND ((NOT (IGREATERP I N)) (COND ((LISTP (SETQ VAR (ARG N I))) (SETQ VAL (CDR VAR)) (SETQ VAR (CAR VAR))) ((NOT (IGREATERP (SETQ I (ADD1 I)) N)) (SETQ VAL (ARG N I))) (T (SETQ VAL))) (OR (STRINGP VAL) (ATOM VAL) (ERRORX (LIST 27 VAL))) (* fields must be atom) (SELECTQ VAR (BODY (MAP (UNPACKFILENAME.STRING (COND ((LISTP VAL) (* PACKFILENAME.STRING for error  checking of fields) (REPACKFILENAME.STRING.3600 VAL)) (T VAL))) [FUNCTION (LAMBDA (X) (* NIL => not yet seen, BLIP => seen  as NIL.) (OR (EVALV (CAR X)) (SET (CAR X) (OR (CADR X) BLIP] (FUNCTION CDDR))) (HOST (OR HOST (SETQ HOST (if VAL then (SELCHARQ (CHCON1 VAL) (({ %[ %() (SUBSTRING VAL 2 (SELCHARQ (NTHCHARCODE VAL -1) ((} %] %)) -2) -1))) VAL) else BLIP)))) (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (RELATIVEDIRECTORY (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (DIRECTORY (OR DIRECTORY (SETQ DIRECTORY (OR VAL BLIP)))) ((DEVICE HOST NAME EXTENSION VERSION) (OR (EVALV VAR) (SET VAR (OR VAL BLIP)))) (\ILLEGAL.ARG VAR)) (SETQ I (ADD1 I)) (GO LP))) (RETURN (CONCATLIST (NCONC (AND HOST (NEQ HOST BLIP) (LIST HOST ":")) [AND DEVICE (NEQ DEVICE BLIP) (SELCHARQ (NTHCHARCODE DEVICE -1) (%: (LIST DEVICE)) (LIST DEVICE '%:] (AND DIRECTORY (NEQ DIRECTORY BLIP) (PROGN (SETQ DIRECTORY (CONCAT DIRECTORY)) [for C from 1 to (NCHARS DIRECTORY) do (COND ([FMEMB (NTHCHARCODE DIRECTORY C) (CONSTANT (LIST (CHARCODE /) (CHARCODE %.) (CHARCODE /) (CHARCODE \] (RPLCHARCODE DIRECTORY C (CHARCODE >] (LIST ">" DIRECTORY ">"))) (AND SUBDIRECTORY (NEQ SUBDIRECTORY BLIP) (PROGN (SETQ SUBDIRECTORY (CONCAT SUBDIRECTORY)) [for C from 1 to (NCHARS SUBDIRECTORY) do (COND ([FMEMB (NTHCHARCODE SUBDIRECTORY C) (CONSTANT (LIST (CHARCODE /) (CHARCODE %.) (CHARCODE /) (CHARCODE \] (RPLCHARCODE SUBDIRECTORY C (CHARCODE >] (LIST ">" SUBDIRECTORY ">"))) (AND RELATIVEDIRECTORY (NEQ RELATIVEDIRECTORY BLIP) (PROGN (SETQ RELATIVEDIRECTORY (CONCAT RELATIVEDIRECTORY)) [for C from 1 to (NCHARS RELATIVEDIRECTORY) do (COND ([FMEMB (NTHCHARCODE RELATIVEDIRECTORY C) (CONSTANT (LIST (CHARCODE /) (CHARCODE %.) (CHARCODE /) (CHARCODE \] (RPLCHARCODE RELATIVEDIRECTORY C (CHARCODE >] (LIST ">" RELATIVEDIRECTORY ">"))) (AND NAME (NEQ NAME BLIP) (LIST NAME)) (AND (OR (AND EXTENSION (NEQ EXTENSION BLIP)) (AND VERSION (NEQ VERSION BLIP))) (LIST (COND ((AND EXTENSION (EQ (CHCON1 EXTENSION) (CHARCODE %.))) BLIP) (T '%.)) (OR EXTENSION BLIP))) (AND VERSION (NEQ VERSION BLIP) (COND ((FIXP VERSION) (LIST '%. VERSION)) (T (SELCHARQ (CHCON1 VERSION) (; (LIST VERSION)) ((%. !) (LIST '%. (SUBSTRING VERSION 2 -1))) (L (LIST '%. 'OLDEST)) ((H 0) (LIST '%. 'NEWEST)) (LIST '%. VERSION]) (REPACKFILENAME.STRING.TOPS20 [LAMBDA N (* ; "Edited 8-Oct-90 16:42 by welch") (if (AND (EQ N 1) (LISTP (ARG N 1))) then (* spread argument list) (APPLY (FUNCTION REPACKFILENAME.STRING.TOPS20) (ARG N 1)) else (PROG ((BLIP "") (I 1) HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION TEMPORARY RELATIVEDIRECTORY SUBDIRECTORY PROTECTION ACCOUNT PACKLIST VAR VAL TEMP) (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME EXTENSION VERSION TEMPORARY PROTECTION ACCOUNT)) LP (COND ((NOT (IGREATERP I N)) (COND ((LISTP (SETQ VAR (ARG N I))) (SETQ VAL (CDR VAR)) (SETQ VAR (CAR VAR))) ((NOT (IGREATERP (SETQ I (ADD1 I)) N)) (SETQ VAL (ARG N I))) (T (SETQ VAL))) (OR (STRINGP VAL) (ATOM VAL) (ERRORX (LIST 27 VAL))) (* fields must be atom) (SELECTQ VAR (BODY (MAP (UNPACKFILENAME.STRING (COND ((LISTP VAL) (* PACKFILENAME.STRING for error  checking of fields) (REPACKFILENAME.STRING.TOPS20 VAL)) (T VAL))) [FUNCTION (LAMBDA (X) (* NIL => not yet seen, BLIP => seen  as NIL.) (OR (EVALV (CAR X)) (SET (CAR X) (OR (CADR X) BLIP] (FUNCTION CDDR))) (HOST (OR HOST (SETQ HOST (if VAL then (SELCHARQ (CHCON1 VAL) (({ %[ %() (SUBSTRING VAL 2 (SELCHARQ (NTHCHARCODE VAL -1) ((} %] %)) -2) -1))) VAL) else BLIP)))) (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (RELATIVEDIRECTORY (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" (CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (DIRECTORY (OR DIRECTORY (SETQ DIRECTORY (OR VAL BLIP)))) ((DEVICE HOST NAME EXTENSION VERSION) (OR (EVALV VAR) (SET VAR (OR VAL BLIP)))) (\ILLEGAL.ARG VAR)) (SETQ I (ADD1 I)) (GO LP))) (SELECTQ TEMPORARY ((T S ;S) (* hack for Interlisp-D!) (OR HOST DEVICE (PROGN (SETQ HOST 'CORE) (SETQ TEMPORARY)))) NIL) (RETURN (CONCATLIST (NCONC (AND HOST (NEQ HOST BLIP) (LIST "{" HOST "}")) [AND DEVICE (NEQ DEVICE BLIP) (SELCHARQ (NTHCHARCODE DEVICE -1) (%: (LIST DEVICE)) (LIST DEVICE '%:] (AND DIRECTORY (NEQ DIRECTORY BLIP) (PROGN (SETQ DIRECTORY (CONCAT DIRECTORY)) [for C from 1 to (NCHARS DIRECTORY) do (COND ([FMEMB (NTHCHARCODE DIRECTORY C) (CONSTANT (LIST (CHARCODE /) (CHARCODE >] (RPLCHARCODE DIRECTORY C (CHARCODE %.] (LIST "<" DIRECTORY ">"))) (AND SUBDIRECTORY (NEQ SUBDIRECTORY BLIP) (PROGN (SETQ SUBDIRECTORY (CONCAT SUBDIRECTORY)) [for C from 1 to (NCHARS SUBDIRECTORY) do (COND ([FMEMB (NTHCHARCODE SUBDIRECTORY C) (CONSTANT (LIST (CHARCODE /) (CHARCODE >] (RPLCHARCODE SUBDIRECTORY C (CHARCODE %.] (LIST "<" SUBDIRECTORY ">"))) (AND RELATIVEDIRECTORY (NEQ RELATIVEDIRECTORY BLIP) (PROGN (SETQ RELATIVEDIRECTORY (CONCAT RELATIVEDIRECTORY)) [for C from 1 to (NCHARS RELATIVEDIRECTORY) do (COND ([FMEMB (NTHCHARCODE RELATIVEDIRECTORY C) (CONSTANT (LIST (CHARCODE /) (CHARCODE >] (RPLCHARCODE RELATIVEDIRECTORY C (CHARCODE %.] (LIST "<" RELATIVEDIRECTORY ">"))) (AND NAME (NEQ NAME BLIP) (LIST NAME)) (AND (OR (AND EXTENSION (NEQ EXTENSION BLIP)) (AND VERSION (NEQ VERSION BLIP))) (LIST (COND ((AND EXTENSION (EQ (CHCON1 EXTENSION) (CHARCODE %.))) BLIP) (T '%.)) (OR EXTENSION BLIP))) [AND VERSION (NEQ VERSION BLIP) (COND ((FIXP VERSION) (LIST '%. VERSION)) (T (SELCHARQ (CHCON1 VERSION) (; (LIST VERSION)) ((%. !) (LIST '%. (SUBSTRING VERSION 2 -1))) (L (LIST '%. -2)) (H (LIST '%. 0)) (LIST '%. VERSION] (AND TEMPORARY (NEQ TEMPORARY BLIP) (LIST '; (SELECTQ TEMPORARY ((S ;S) 'S) T]) (REPACKFILENAME.STRING.UNIX [LAMBDA N (* ; "Edited 8-Oct-90 16:48 by welch") (if (AND (EQ N 1) (LISTP (ARG N 1))) then (* spread argument list) (APPLY (FUNCTION REPACKFILENAME.STRING.UNIX) (ARG N 1)) else (PROG ((BLIP "") (I 1) HOST DEVICE STRUCTURE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY DIR NAME EXTENSION VERSION PACKLIST VAR VAL TEMP) (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY NAME RELATIVEDIRECTORY SUBDIRECTORY EXTENSION VERSION)) LP (COND ((NOT (IGREATERP I N)) (COND ((LISTP (SETQ VAR (ARG N I))) (SETQ VAL (CDR VAR)) (SETQ VAR (CAR VAR))) ((NOT (IGREATERP (SETQ I (ADD1 I)) N)) (SETQ VAL (ARG N I))) (T (SETQ VAL))) (OR (STRINGP VAL) (ATOM VAL) (ERRORX (LIST 27 VAL))) (* fields must be atom) (SELECTQ VAR (BODY (MAP (UNPACKFILENAME.STRING (COND ((LISTP VAL) (* PACKFILENAME.STRING for error  checking of fields) (REPACKFILENAME.STRING.UNIX VAL)) (T VAL))) [FUNCTION (LAMBDA (X)(* NIL => not yet seen, BLIP => seen  as NIL.) (OR (EVALV (CAR X)) (SET (CAR X) (OR (CADR X) BLIP] (FUNCTION CDDR))) (HOST (OR HOST (SETQ HOST (if VAL then (SELCHARQ (CHCON1 VAL) (({ %[ %() (SUBSTRING VAL 2 (SELCHARQ (NTHCHARCODE VAL -1) ((} %] %)) -2) -1))) VAL) else BLIP)))) (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (if VAL then (CONCAT ( CL:STRING-LEFT-TRIM "<" ( CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (RELATIVEDIRECTORY (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (if VAL then (CONCAT (CL:STRING-LEFT-TRIM "<" ( CL:DIRECTORY-NAMESTRING *DEFAULT-PATHNAME-DEFAULTS* )) VAL) else BLIP)))) (DIRECTORY (OR DIRECTORY (SETQ DIRECTORY (OR VAL BLIP)))) ((DEVICE HOST NAME EXTENSION VERSION) (OR (EVALV VAR) (SET VAR (OR VAL BLIP)))) (\ILLEGAL.ARG VAR)) (SETQ I (ADD1 I)) (GO LP))) (RETURN (CONCATLIST (NCONC (AND HOST (NEQ HOST BLIP) (LIST "{" HOST "}")) (AND DEVICE (NEQ DEVICE BLIP) (LIST "/" DEVICE)) (AND DIRECTORY (NEQ DIRECTORY BLIP) (PROGN (SETQ DIRECTORY (CONCAT DIRECTORY)) [for C from 1 to (NCHARS DIRECTORY) do (COND ((EQ (NTHCHARCODE DIRECTORY C) (CONSTANT (CHARCODE >))) (RPLCHARCODE DIRECTORY C (CHARCODE /] (LIST "/" DIRECTORY "/")) (LIST "/" DIRECTORY "/")) (AND SUBDIRECTORY (NEQ SUBDIRECTORY BLIP) (PROGN (SETQ SUBDIRECTORY (CONCAT SUBDIRECTORY)) [for C from 1 to (NCHARS SUBDIRECTORY) do (COND ((EQ (NTHCHARCODE SUBDIRECTORY C) (CONSTANT (CHARCODE >))) (RPLCHARCODE SUBDIRECTORY C (CHARCODE /] (LIST "/" SUBDIRECTORY "/")) (LIST "/" SUBDIRECTORY "/")) (AND RELATIVEDIRECTORY (NEQ RELATIVEDIRECTORY BLIP) (PROGN (SETQ RELATIVEDIRECTORY (CONCAT RELATIVEDIRECTORY)) [for C from 1 to (NCHARS RELATIVEDIRECTORY ) do (COND ((EQ (NTHCHARCODE RELATIVEDIRECTORY C) (CONSTANT (CHARCODE >))) (RPLCHARCODE RELATIVEDIRECTORY C (CHARCODE /] (LIST "/" RELATIVEDIRECTORY "/")) (LIST "/" RELATIVEDIRECTORY "/")) (AND NAME (NEQ NAME BLIP) (LIST NAME)) (AND (OR (AND EXTENSION (NEQ EXTENSION BLIP)) (AND VERSION (NEQ VERSION BLIP))) (LIST (COND ((OR (AND EXTENSION (EQ (CHCON1 EXTENSION) (CHARCODE %.))) (OR (NULL EXTENSION) (EQ EXTENSION BLIP) (STREQUAL EXTENSION ""))) BLIP) (T '%.)) (OR EXTENSION BLIP]) (\REPACKFILENAME.NEW.TRANSLATION [LAMBDA (OSTYPE FUNCTION) (DECLARE (GLOBALVARS \REPACKFILENAME.OSTYPE.TABLE)) (* ejs%: "27-Apr-85 13:36") (PUTHASH OSTYPE FUNCTION \REPACKFILENAME.OSTYPE.TABLE]) (\REPACKFILENAME.NEW.TRANSLATIONS [NLAMBDA NAMES (* ejs%: "27-Apr-85 13:36") (* * Supply a property-list format argument of ostypes and translating  functions to be added to ostype table) (for TAIL on NAMES by (CDDR TAIL) do (for OSTYPE inside (CAR TAIL) do (\REPACKFILENAME.NEW.TRANSLATION OSTYPE (CADR TAIL]) ) (RPAQ? \REPACKFILENAME.OSTYPE.TABLE (HASHARRAY 30 1.1)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \REPACKFILENAME.OSTYPE.TABLE) ) (\REPACKFILENAME.NEW.TRANSLATIONS (INTERLISP IFS) REPACKFILENAME.STRING.D (TOPS-20 TOPS20) REPACKFILENAME.STRING.TOPS20 (SYMBOLICS-3600 LISPM GENERA) REPACKFILENAME.STRING.3600 VMS REPACKFILENAME.STRING.VMS UNIX REPACKFILENAME.STRING.UNIX MS-DOS REPACKFILENAME.STRING.MSDOS) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA \REPACKFILENAME.NEW.TRANSLATIONS) (ADDTOVAR NLAML ) (ADDTOVAR LAMA REPACKFILENAME.STRING.UNIX REPACKFILENAME.STRING.TOPS20 REPACKFILENAME.STRING.3600 REPACKFILENAME.STRING.VMS REPACKFILENAME.STRING.TI REPACKFILENAME.STRING.MSDOS REPACKFILENAME.STRING.D) ) (PUTPROPS TCPNAMES COPYRIGHT ("Xerox Corporation" 1985 1987 1988 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2757 69593 (REPACKFILENAME.STRING 2767 . 3171) (REPACKFILENAME.STRING.D 3173 . 12368) ( REPACKFILENAME.STRING.MSDOS 12370 . 21255) (REPACKFILENAME.STRING.TI 21257 . 30611) ( REPACKFILENAME.STRING.VMS 30613 . 39537) (REPACKFILENAME.STRING.3600 39539 . 49180) ( REPACKFILENAME.STRING.TOPS20 49182 . 58763) (REPACKFILENAME.STRING.UNIX 58765 . 68684) ( \REPACKFILENAME.NEW.TRANSLATION 68686 . 68967) (\REPACKFILENAME.NEW.TRANSLATIONS 68969 . 69591))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPOPS b/obsolete/tcp/TCPOPS new file mode 100644 index 00000000..5e47a466 --- /dev/null +++ b/obsolete/tcp/TCPOPS @@ -0,0 +1,212 @@ +(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") +(FILECREATED "22-May-90 10:55:20" |{DSK}/home/neptune/jds/TCPOPS.;17| 14660 + + |changes| |to:| (FNS TCP-ACCEPT TCP-LISTEN UDP-RECV) + + |previous| |date:| " 3-May-90 11:40:39" |{DSK}/home/neptune/jds/TCPOPS.;16|) + + +; Copyright (c) 1989, 1990 by Savoir, Inc.. All rights reserved. + +(PRETTYCOMPRINT TCPOPSCOMS) + +(RPAQQ TCPOPSCOMS ((FILES CHARDEVICE) (ADDVARS (\\INITSUBRS (TCP 144))) (COMS (* |;;| "TCP Streams") (FNS \\TCP-DEV-INIT \\TCP-OPENFILE \\TCP-FORCEOUTPUT \\TCP-GETNEXTBUFFER \\TCP-EOFP \\TCP-CLOSEFILE \\TCP-EVENTFN \\TCP.BUFFERED.BOUTS) (P (\\TCP-DEV-INIT))) (COMS (* |;;| "User-level TCP operations") (FNS TCP OPENTCPSTREAM TCP-ACCEPT TCP-LISTEN TCP-CLOSE) (FNS UDP-LISTEN UDP-SEND UDP-RECV) (FNS GETHOSTFROMNAME GETHOSTFROMADDR GETHOSTFROMSOCKET GETHOSTNAME)) (DECLARE\: EVAL@LOAD DONTCOPY (COMS (* |;;| "Debugging functions &c") (VARS (BUFFER (\\ALLOCBLOCK 100))) (FNS TCPRECV TCPSEND SEEBUFFER FOON))))) + +(FILESLOAD CHARDEVICE) + +(ADDTOVAR \\INITSUBRS (TCP 144)) + + + +(* |;;| "TCP Streams") + +(DEFINEQ + +(\\TCP-DEV-INIT +(LAMBDA NIL (* \; "Edited 20-Feb-90 12:51 by jds") (* |;;| "Initialization for buffered Unix-character-oriented device (e.g. for TCP streams on SUN)") (SETQ \\TCP-FDEV (|create| FDEV DEVICENAME _ "TCP" FDBINABLE _ T FDBOUTABLE _ T BUFFERED _ T BIN _ (FUNCTION \\BUFFERED.BIN) BOUT _ (FUNCTION \\BUFFCHAR-OTHER-BOUT) OPENFILE _ (FUNCTION \\BUFFCHAR-DEV-OPENFILE) EVENTFN _ (FUNCTION \\CHAR-DEV-EVENTFN) REOPENFILE _ (FUNCTION \\BUFFCHAR-DEV-OPENFILE) CLOSEFILE _ (FUNCTION \\TCP-CLOSEFILE) FORCEOUTPUT _ (FUNCTION \\TCP-FORCEOUTPUT) EOFP _ (FUNCTION \\TCP-EOFP) BLOCKIN _ (FUNCTION \\BUFFERED.BINS) BLOCKOUT _ (FUNCTION \\TCP.BUFFERED.BOUTS) READP _ (FUNCTION \\GENERIC.READP) PEEKBIN _ (FUNCTION \\BUFFERED.PEEKBIN) GETNEXTBUFFER _ (FUNCTION \\TCP-GETNEXTBUFFER))) (\\DEFINEDEVICE (QUOTE TCP) \\TCP-FDEV)) +) + +(\\TCP-OPENFILE +(LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV) (* \; "Edited 7-Mar-90 10:11 by jds") (LET ((UNIX-NAME (SUBSTRING NAME (ADD1 (STRPOS "}" NAME)))) (ERRNO (CREATECELL \\FIXP)) IODESCRIPTOR ACCESS-VALUE STREAM OTHER-STREAM) (SETQ STREAM (|create| STREAM BINABLE _ T BOUTABLE _ NIL DEVICE _ FDEV FULLFILENAME _ NAME USERCLOSEABLE _ T USERVISIBLE _ T EOLCONVENTION _ LF.EOLC)) (SELECTQ ACCESS (INPUT (|replace| (STREAM STRMBINFN) |of| STREAM |with| (FUNCTION \\BUFFERED.BIN)) (SETQ ACCESS-VALUE 0)) (OUTPUT (|replace| (STREAM STRMBOUTFN) |of| STREAM |with| (FUNCTION \\BUFFCHAR-OTHER-BOUT)) (REPLACE F2 OF STREAM WITH (SETQ OTHER-STREAM (|create| STREAM BINABLE _ NIL BOUTABLE _ NIL DEVICE _ FDEV FULLFILENAME _ NAME STRMBOUTFN _ (FUNCTION \\BUFFERED.BOUT) USERCLOSEABLE _ T USERVISIBLE _ T EOLCONVENTION _ LF.EOLC))) (SETQ ACCESS-VALUE 1)) (BOTH (|replace| (STREAM STRMBINFN) |of| STREAM |with| (FUNCTION \\BUFFERED.BIN)) (|replace| (STREAM STRMBOUTFN) |of| STREAM |with| (FUNCTION \\BUFFCHAR-OTHER-BOUT)) (REPLACE F2 OF STREAM WITH (SETQ OTHER-STREAM (|create| STREAM BINABLE _ NIL BOUTABLE _ NIL DEVICE _ FDEV FULLFILENAME _ NAME STRMBOUTFN _ (FUNCTION \\BUFFERED.BOUT) USERCLOSEABLE _ T USERVISIBLE _ T EOLCONVENTION _ LF.EOLC))) (SETQ ACCESS-VALUE 2)) (APPEND (\\ILLEGAL.ARG ACCESS)) (\\ILLEGAL.ARG ACCESS)) (COND ((SETQ IODESCRIPTOR (SUBRCALL CHAR-OPENFILE UNIX-NAME ACCESS-VALUE ERRNO)) (* |;;| "Open happened, so put things together.") (|replace| (STREAM F1) |of| STREAM |with| IODESCRIPTOR) (COND (OTHER-STREAM (|replace| (STREAM F1) |of| OTHER-STREAM |with| IODESCRIPTOR)))) (T (\\CHAR-ERROR ERRNO NAME))) STREAM)) +) + +(\\TCP-FORCEOUTPUT + (LAMBDA (STREAM WAIT) (* \; "Edited 15-Dec-89 16:09 by jds") + +(* |;;;| "Generic buffer refiller for Buffered character streams (e.g. TCP streams on Sun, or the Lisp side of a shell CHAT, eventually)") + + (PROG (ERRCODE (OTHER-STREAM (|fetch| F2 |of| STREAM)) + (ERRNO (\\CREATECELL \\FIXP)) + BUFFER) + (COND + ((NULL (|fetch| CPPTR |of| OTHER-STREAM)) + + (* |;;| "No buffer allocated yet; create one.") + + (REPLACE CPPTR OF OTHER-STREAM WITH (NCREATE 'VMEMPAGEP)) + (REPLACE CBUFSIZE OF OTHER-STREAM WITH 512) + (REPLACE CBUFMAXSIZE OF OTHER-STREAM WITH 512) + (REPLACE COFFSET OF OTHER-STREAM WITH 0) + T) + ((ZEROP (|fetch| COFFSET |of| OTHER-STREAM)) + T) + ((SETQ ERRCODE (\\CHAR-BOUTS OTHER-STREAM (|fetch| CPPTR |of| OTHER-STREAM) + 0 + (|fetch| COFFSET |of| OTHER-STREAM) + NIL)) + + (* |;;| "WRITE HAPPENED.") + + (|replace| CBUFSIZE |of| OTHER-STREAM |with| 512) + (|replace| CBUFMAXSIZE |of| OTHER-STREAM |with| 512) + (|replace| COFFSET |of| OTHER-STREAM |with| 0) + T))))) + +(\\TCP-GETNEXTBUFFER +(LAMBDA (STREAM WHATFOR NOERRORFLG EOF-TEST) (* \; "Edited 20-Feb-90 12:43 by jds") (* |;;;| "Generic buffer refiller for Buffered character streams (e.g. TCP streams on Sun, or the Lisp side of a shell CHAT, eventually).") (PROG (ERRCODE (ERRNO (\\CREATECELL \\FIXP)) BUFFER) READ-LOOP (RETURN (SELECTQ WHATFOR (READ (* |;;| "READING; GET A FRESH BUFFER FULL OF UN-READ CHARACTERS.") (SETQ BUFFER (OR (FETCH (STREAM CPPTR) OF STREAM) (NCREATE (QUOTE VMEMPAGEP)))) (|replace| CPPTR |of| STREAM |with| BUFFER) (COND ((ZEROP (SETQ ERRCODE (TCP 6 (|fetch| (STREAM F1) |of| STREAM) BUFFER 512))) (AND (NULL NOERRORFLG) (\\EOF.ACTION STREAM)) NIL) ((EQ ERRCODE T) (AND EOF-TEST (RETURN T)) (BLOCK) (GO READ-LOOP)) (ERRCODE (* |;;| "Read succeeded, and ERRCODE has # of chars read.") (|replace| CPPTR |of| STREAM |with| BUFFER) (|replace| COFFSET |of| STREAM |with| 0) (|replace| CBUFSIZE |of| STREAM |with| ERRCODE) (|replace| CBUFMAXSIZE |of| STREAM |with| ERRCODE) T) ((NULL NOERRORFLG) (\\CHAR-ERROR ERRNO STREAM)))) (WRITE (COND ((NULL (FETCH CPPTR OF STREAM)) (* |;;| "No buffer allocated yet; create one.") (REPLACE CPPTR OF STREAM WITH (NCREATE (QUOTE VMEMPAGEP))) (REPLACE CBUFSIZE OF STREAM WITH 512) (REPLACE CBUFMAXSIZE OF STREAM WITH 512) (REPLACE COFFSET OF STREAM WITH 0) T) ((ZEROP (FETCH COFFSET OF STREAM)) T) ((SETQ ERRCODE (\\CHAR-BOUTS STREAM (FETCH CPPTR OF STREAM) 0 (FETCH COFFSET OF STREAM) NOERRORFLG)) (* |;;| "WRITE HAPPENED.") (REPLACE CBUFSIZE OF STREAM WITH 512) (REPLACE CBUFMAXSIZE OF STREAM WITH 512) (REPLACE COFFSET OF STREAM WITH 0) T))) (SHOULDNT))))) +) + +(\\TCP-EOFP +(LAMBDA (STREAM) (* \; "Edited 20-Feb-90 12:42 by jds") (* |;;| "T if there will be no more data on the stream") (AND (OR (NOT (|fetch| (STREAM CPPTR) |of| STREAM)) (IEQP (FETCH (STREAM COFFSET) OF STREAM) (FETCH (STREAM CBUFSIZE) OF STREAM))) (NOT (\\TCP-GETNEXTBUFFER STREAM (QUOTE READ) T T)))) +) + +(\\TCP-CLOSEFILE + (LAMBDA (STREAM) (* \; "Edited 18-Dec-89 11:17 by jds") + + (* |;;| "Close a TCP connection or listening-socket cleanly.") + + (TCP 3 (|fetch| (STREAM F1) |of| STREAM)) + STREAM)) + +(\\TCP-EVENTFN + (LAMBDA (FDEV EVENT) (* \; "Edited 30-Jan-90 13:56 by jds") + (SELECTQ EVENT + ((BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS BEFORESAVEVM) + (* |;;| + "Clean up existing connections, and remember any LISTENS in progress") + + ) + ((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM) + + (* |;;| +"Try to reopen streams that had been open, and re-establish any LISTENs in progress when we exited.") + + ) + NIL))) + +(\\TCP.BUFFERED.BOUTS +(LAMBDA (STREAM SBASE OFFSET NBYTES) (\\BUFFERED.BOUTS (FETCH F2 OF STREAM) SBASE OFFSET NBYTES))) +) + +(\\TCP-DEV-INIT) + + + +(* |;;| "User-level TCP operations") + +(DEFINEQ + +(TCP +(LAMBDA (A B C D E F G H I J K L M) (* \; "Edited 4-Apr-90 17:29 by jds") (* |;;| "Generic TCP-operation hider function. Hides the fact of TCP ops being SUBRCALLs.") (* |;;| "Returns whatever result the TCP operation returns.") (SUBRCALL TCP A B C D E F G H I J K L M)) +) + +(OPENTCPSTREAM +(LAMBDA (HOST PORT) (* \; "Edited 3-May-90 11:38 by jds") (LET ((ERRNO (CREATECELL \\FIXP)) IODESCRIPTOR ACCESS-VALUE STREAM OTHER-STREAM) (SETQ STREAM (|create| STREAM BINABLE _ T BOUTABLE _ T DEVICE _ \\TCP-FDEV FULLFILENAME _ HOST USERCLOSEABLE _ T USERVISIBLE _ T EOLCONVENTION _ LF.EOLC)) (|replace| (STREAM ACCESS) |of| STREAM |with| (QUOTE BOTH)) (|replace| (STREAM STRMBINFN) |of| STREAM |with| (FUNCTION \\BUFFERED.BIN)) (|replace| (STREAM STRMBOUTFN) |of| STREAM |with| (FUNCTION \\BUFFCHAR-OTHER-BOUT)) (|replace| F2 |of| STREAM |with| (SETQ OTHER-STREAM (|create| STREAM BINABLE _ T BOUTABLE _ T DEVICE _ \\TCP-FDEV FULLFILENAME _ HOST STRMBOUTFN _ (FUNCTION \\BUFFERED.BOUT) USERCLOSEABLE _ NIL USERVISIBLE _ NIL EOLCONVENTION _ LF.EOLC))) (COND ((SETQ IODESCRIPTOR (TCP 4 HOST PORT)) (* |;;| "Open happened, so put things together.") (|replace| (STREAM F1) |of| STREAM |with| IODESCRIPTOR) (|replace| (STREAM F1) |of| OTHER-STREAM |with| IODESCRIPTOR)) (T (\\CHAR-ERROR ERRNO HOST))) STREAM)) +) + +(TCP-ACCEPT +(LAMBDA (WAITING-SOCKET) (* \; "Edited 22-May-90 10:18 by jhb") (LET ((ERRNO (CREATECELL \\FIXP)) IODESCRIPTOR ACCESS-VALUE STREAM OTHER-STREAM SOCKET) (|while| (OR (NOT SOCKET) (< SOCKET 0)) |do| (BLOCK) (SETQ SOCKET (TCP 8 WAITING-SOCKET))) (PRINTOUT *TRACE-OUTPUT* "SOCKET ACCEPTED " SOCKET T) (SETQ STREAM (|create| STREAM BINABLE _ T BOUTABLE _ T DEVICE _ \\TCP-FDEV FULLFILENAME _ (GETHOSTFROMSOCKET SOCKET) USERCLOSEABLE _ T USERVISIBLE _ T EOLCONVENTION _ LF.EOLC)) (|replace| (STREAM ACCESS) |of| STREAM |with| (QUOTE BOTH)) (|replace| (STREAM STRMBINFN) |of| STREAM |with| (FUNCTION \\BUFFERED.BIN)) (|replace| (STREAM STRMBOUTFN) |of| STREAM |with| (FUNCTION \\BUFFCHAR-OTHER-BOUT)) (|replace| F2 |of| STREAM |with| (SETQ OTHER-STREAM (|create| STREAM BINABLE _ T BOUTABLE _ T DEVICE _ \\TCP-FDEV FULLFILENAME _ HOST STRMBOUTFN _ (FUNCTION \\BUFFERED.BOUT) USERCLOSEABLE _ NIL USERVISIBLE _ NIL EOLCONVENTION _ LF.EOLC))) (COND (SOCKET (* |;;| "Open happened, so put things together.") (|replace| (STREAM F1) |of| STREAM |with| SOCKET) (|replace| (STREAM F1) |of| OTHER-STREAM |with| SOCKET)) (T (\\CHAR-ERROR ERRNO HOST))) STREAM)) +) + +(TCP-LISTEN +(LAMBDA (SOCKET-NUMBER ACCEPT-FUNCTION ACCEPT-DATA) (* \; "Edited 22-May-90 10:54 by jhb") (LET ((SOCKET (TCP 7 SOCKET-NUMBER))) (SETQ \\MAIKO.IO-INTERRUPT-VECTOR (CONS (LIST (LLSH 1 SOCKET) ACCEPT-FUNCTION SOCKET ACCEPT-DATA) \\MAIKO.IO-INTERRUPT-VECTOR)) SOCKET)) +) + +(TCP-CLOSE +(LAMBDA (DESCRIPTOR-NUMBER) (* \; "Edited 4-Apr-90 14:51 by jds") (LET ((ACCEPTOR (ASSOC (LLSH 1 DESCRIPTOR-NUMBER) \\MAIKO.IO-INTERRUPT-VECTOR))) (TCP 3 DESCRIPTOR-NUMBER) (* \; "Close the TCP connection") (DREMOVE ACCEPTOR \\MAIKO.IO-INTERRUPT-VECTOR) (* \; "REmove any acceptor.") DESCRIPTOR-NUMBER)) +) +) +(DEFINEQ + +(UDP-LISTEN +(LAMBDA (SOCKET-NUMBER ACCEPT-FUNCTION ACCEPT-INFO) (* \; "Edited 4-Apr-90 15:49 by jds") (* |;;| "Listen on a particular UDP socket for incoming packet traffic. Also has the effect of opening the socket for outgoing traffic.") (LET ((SOCKET (TCP 128 SOCKET-NUMBER))) (SETQ \\MAIKO.IO-INTERRUPT-VECTOR (CONS (LIST (LLSH 1 SOCKET) ACCEPT-FUNCTION SOCKET ACCEPT-INFO) \\MAIKO.IO-INTERRUPT-VECTOR)) SOCKET)) +) + +(UDP-SEND +(LAMBDA (SOCKET BUFFER LEN ADDR PORT) (TCP 130 SOCKET ADDR PORT BUFFER LEN))) + +(UDP-RECV +(LAMBDA (SOCKET) (* \; "Edited 3-May-90 11:40 by jds") (* |;;| "Xall recvfrom() to get an incoming packet on a UDP socket.") (* |;;| "Returns 4 results:") (* |;;| " The 1500-byte buffer containing the packet") (* |;;| " The length of the incoming packet") (* |;;| " The address of the guy who sent it") (* |;;| " The port to answer him on (or where he sent it from)") (LET ((BUFFER (NCREATE (QUOTE VMEMPAGEP))) LEN (ADDR (\\CREATECELL \\FIXP)) (PORT (\\CREATECELL \\FIXP))) (SETQ LEN (TCP 131 SOCKET BUFFER 512 ADDR PORT)) (CL:VALUES BUFFER LEN ADDR PORT))) +) +) +(DEFINEQ + +(GETHOSTFROMNAME + (LAMBDA (NAME) (* \; "Edited 1-Feb-90 11:26 by jds") + + (* |;;| + "Given a host name, return the IP address for that host. If the host isn't found, return NIL.") + + (TCP 0 NAME))) + +(GETHOSTFROMADDR +(LAMBDA (ADDR) (* \; "Edited 6-Apr-90 20:23 by jds") (* |;;| "Given a host's IP address, return the string name of the host, or NIL if it can't be found.") (LET* ((BUF (\\ALLOCBLOCK 100 NIL)) (LEN (TCP 66 ADDR BUF))) (COND ((ZEROP LEN) NIL) (T (\\GETBASESTRING BUF 0 LEN))))) +) + +(GETHOSTFROMSOCKET + (LAMBDA (SOCKET) (* \; "Edited 1-Feb-90 11:30 by jds") + + (* |;;| "Given the socket FD of a TCP connection, return the NAME of the remote host, or NIL if it can't be found.") + + (LET* ((BUF (\\ALLOCBLOCK 100 NIL)) + (LEN (TCP 65 SOCKET BUF))) + (COND + ((ZEROP LEN) + NIL) + (T (CONCATLIST (FOR I FROM 0 TO (SUB1 LEN) COLLECT (\\GETBASEBYTE BUF I) + ))))))) + +(GETHOSTNAME +(LAMBDA NIL (* \; "Edited 6-Apr-90 20:25 by jds") (* |;;| "Given a host's IP address, return the string name of the host, or NIL if it can't be found.") (LET* ((BUF (\\ALLOCBLOCK 100 NIL)) (LEN (TCP 67 BUF))) (COND ((ZEROP LEN) NIL) (T (\\GETBASESTRING BUF 0 LEN))))) +) +) +(DECLARE\: EVAL@LOAD DONTCOPY + + + +(* |;;| "Debugging functions &c") + + +(RPAQ BUFFER (\\ALLOCBLOCK 100)) +(DEFINEQ + +(TCPRECV + (LAMBDA (PORT) + (LET ((LEN (TCP 6 PORT BUFFER 100))) + (|for| I |from| 0 |to| (SUB1 LEN) |do| (PRIN1 (CHARACTER (\\GETBASEBYTE + BUFFER I)))) + (TERPRI)))) + +(TCPSEND + (LAMBDA (PORT BASE LEN) (* \; "Edited 15-Dec-89 15:13 by jds") + (TCP 5 PORT BASE OFFSET LEN))) + +(SEEBUFFER +(LAMBDA (BUF) (|for| I |from| 0 |to| 11 |do| (PRIN1 (CHARACTER (\\GETBASEBYTE BUF I)))))) + +(FOON +(LAMBDA (INFO) (* \; "Edited 4-Apr-90 17:35 by jds") (LET ((RES (CL:MULTIPLE-VALUE-LIST (UDP-RECV (CADDR INFO))))) (AND (CADR RES) (SETQ RESULT RES)))) +) +) +) +(PUTPROPS TCPOPS COPYRIGHT ("Savoir, Inc." 1989 1990)) +(DECLARE\: DONTCOPY + (FILEMAP (NIL (1081 8055 (\\TCP-DEV-INIT 1091 . 1918) (\\TCP-OPENFILE 1920 . 3557) (\\TCP-FORCEOUTPUT +3559 . 5060) (\\TCP-GETNEXTBUFFER 5062 . 6672) (\\TCP-EOFP 6674 . 6989) (\\TCP-CLOSEFILE 6991 . 7259) +(\\TCP-EVENTFN 7261 . 7927) (\\TCP.BUFFERED.BOUTS 7929 . 8053)) (8119 11214 (TCP 8129 . 8411) ( +OPENTCPSTREAM 8413 . 9441) (TCP-ACCEPT 9443 . 10604) (TCP-LISTEN 10606 . 10889) (TCP-CLOSE 10891 . +11212)) (11215 12328 (UDP-LISTEN 11225 . 11649) (UDP-SEND 11651 . 11742) (UDP-RECV 11744 . 12326)) ( +12329 13743 (GETHOSTFROMNAME 12339 . 12608) (GETHOSTFROMADDR 12610 . 12909) (GETHOSTFROMSOCKET 12911 + . 13452) (GETHOSTNAME 13454 . 13741)) (13851 14580 (TCPRECV 13861 . 14149) (TCPSEND 14151 . 14306) ( +SEEBUFFER 14308 . 14412) (FOON 14414 . 14578))))) +STOP diff --git a/obsolete/tcp/TCPTFTP b/obsolete/tcp/TCPTFTP new file mode 100644 index 00000000..9f1b3327 --- /dev/null +++ b/obsolete/tcp/TCPTFTP @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "12-Jun-90 17:44:14" {DSK}local>lde>lispcore>library>TCPTFTP.;2 53424 changes to%: (VARS TCPTFTPCOMS) previous date%: " 1-Jul-87 10:52:03" {DSK}local>lde>lispcore>library>TCPTFTP.;1) (* ; " Copyright (c) 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPTFTPCOMS) (RPAQQ TCPTFTPCOMS ((COMS (* ;; "Trivial File Transfer Protocol") (INITVARS (\TFTP.DEVICE) (TFTP.MAXRETRIES 20)) (GLOBALVARS \TFTP.DEVICE TFTP.MAXRETRIES) (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TFTPCON TFTP TFTPSTREAM) (CONSTANTS (\TFTPOVLEN 4) (\TFTP.SOCKET 69)) (CONSTANTS * TFTPOPCODES))) (INITVARS (TFTP.MAXRETRIES 20)) (FNS \TFTP.ACKNOWLEDGE \TFTP.CLOSEFILE \TFTP.EOFP \TFTP.ERROR \TFTP.GETNEXTBUFFER \TFTP.INIT \TFTP.INPUT.BUFFER \TFTP.OPENFILE \TFTP.READP \TFTP.SEND.ERROR \TFTP.SETUP) (FILES (SYSLOAD) TCPUDP)) (COMS (* ;; "TFTP Server functions") (INITVARS (\TFTP.SERVER.CONNECTIONS)) (GLOBALVARS \TFTP.SERVER.CONNECTIONS) (FNS TFTP.SERVER.PROCESS \TFTP.GET.FILE \TFTP.SEND.FILE)) (COMS (* ;; "User functions") (FNS TFTP.SERVER TFTP.GET TFTP.PUT)) (COMS (* ;; "Tracing functions") (FNS PRINTTFTP \TFTP.PRINT.ACK \TFTP.PRINT.DATA \TFTP.PRINT.ERROR \TFTP.PRINT.REQUEST)) (P (\TFTP.INIT)))) (* ;; "Trivial File Transfer Protocol") (RPAQ? \TFTP.DEVICE ) (RPAQ? TFTP.MAXRETRIES 20) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \TFTP.DEVICE TFTP.MAXRETRIES) ) (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (RECORD TFTPCON (UDPSOCKET DESTSOCKET STREAM HOST)) (ACCESSFNS TFTP ((TFTPBASE (fetch (UDP UDPCONTENTS) of DATUM))) (BLOCKRECORD TFTPBASE ((OPCODE WORD) (BLOCK# WORD))) [ACCESSFNS TFTP ((TFTPCONTENTS (\ADDBASE (fetch (UDP UDPCONTENTS) of DATUM) (FOLDHI \TFTPOVLEN BYTESPERWORD] (BLOCKRECORD TFTPBASE ((NIL WORD) (ERRORCODE WORD)))) (ACCESSFNS TFTPSTREAM ((TFTPCON (fetch (STREAM F1) of DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (LASTPACKETIN (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE)))) ) (DECLARE%: EVAL@COMPILE (RPAQQ \TFTPOVLEN 4) (RPAQQ \TFTP.SOCKET 69) (CONSTANTS (\TFTPOVLEN 4) (\TFTP.SOCKET 69)) ) (RPAQQ TFTPOPCODES ((\TFTP.RRQ 1) (\TFTP.WRQ 2) (\TFTP.DATA 3) (\TFTP.ACK 4) (\TFTP.ERROR 5))) (DECLARE%: EVAL@COMPILE (RPAQQ \TFTP.RRQ 1) (RPAQQ \TFTP.WRQ 2) (RPAQQ \TFTP.DATA 3) (RPAQQ \TFTP.ACK 4) (RPAQQ \TFTP.ERROR 5) (CONSTANTS (\TFTP.RRQ 1) (\TFTP.WRQ 2) (\TFTP.DATA 3) (\TFTP.ACK 4) (\TFTP.ERROR 5)) ) (* "END EXPORTED DEFINITIONS") ) (RPAQ? TFTP.MAXRETRIES 20) (DEFINEQ (\TFTP.ACKNOWLEDGE [LAMBDA (STREAM ACK#) (* MPL " 2-Jun-85 17:07") (LET ((TFTPCON (fetch (TFTPSTREAM TFTPCON) of STREAM)) (ACK (\ALLOCATE.ETHERPACKET))) (\TFTP.SETUP ACK TFTPCON \TFTP.ACK 'FREE) (UDP.APPEND.WORD ACK ACK#) (UDP.SEND (fetch (TFTPCON UDPSOCKET) of TFTPCON) ACK) (BLOCK) (COND ((AND (EQ (fetch (STREAM ACCESS) of STREAM) 'INPUT) (fetch (TFTPSTREAM LASTPACKETIN) of STREAM)) (UDP.CLOSE.SOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON]) (\TFTP.CLOSEFILE [LAMBDA (STREAM) (* ejs%: " 9-Feb-85 23:47") (LET ((TFTPCON (fetch (TFTPSTREAM TFTPCON) of STREAM))) (SELECTQ (fetch (STREAM ACCESS) of STREAM) (OUTPUT [COND ((AND (fetch (STREAM CBUFPTR) of STREAM) (NOT (fetch (TFTPSTREAM LASTPACKETIN) of STREAM))) (\TFTP.GETNEXTBUFFER STREAM 'WRITE]) NIL) (UDP.CLOSE.SOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON) T) (replace (STREAM ACCESS) of STREAM with NIL) STREAM]) (\TFTP.EOFP [LAMBDA (STREAM) (* ejs%: " 9-Feb-85 21:23") (OR (NULL (fetch (STREAM CBUFPTR) of STREAM)) (AND (fetch (TFTPSTREAM LASTPACKETIN) of STREAM) (EQ (fetch (STREAM COFFSET) of STREAM) (fetch (STREAM CBUFSIZE) of STREAM]) (\TFTP.ERROR [LAMBDA (TFTP TFTPCON) (* ejs%: " 9-Feb-85 19:04") (* * Called upon receipt of error packet in TFTP stream) (LET [(ERRORSTRING (ALLOCSTRING (IDIFFERENCE (fetch (UDP UDPLENGTH) of TFTP) (CONSTANT (IPLUS \UDPOVLEN (ADD1 \TFTPOVLEN] (\MOVEBYTES (fetch (TFTP TFTPCONTENTS) of TFTP) 0 (fetch (STRINGP BASE) of ERRORSTRING) (fetch (STRINGP OFFST) of ERRORSTRING) (fetch (STRINGP LENGTH) of ERRORSTRING)) (ERROR (CONCAT "TFTP error message: " ERRORSTRING " for code") (fetch (TFTP ERRORCODE) of TFTP]) (\TFTP.GETNEXTBUFFER [LAMBDA (STREAM WHATFOR NOERRORFLG) (* MPL " 2-Jun-85 19:48") (DECLARE (GLOBALVARS TFTP.MAXRETRIES)) (LET* ((TFTPCON (fetch (TFTPSTREAM TFTPCON) of STREAM)) (IPSOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON)) (RETRYCOUNT 0) (BUFFER (fetch (STREAM CBUFPTR) of STREAM)) UDP) (SELECTQ WHATFOR (READ [COND [(fetch (TFTPSTREAM LASTPACKETIN) of STREAM) (replace (STREAM ACCESS) of STREAM with NIL) (\RELEASE.ETHERPACKET (fetch (STREAM CBUFPTR) of STREAM)) (replace (STREAM CBUFPTR) of STREAM with NIL) (COND (NOERRORFLG NIL) (T (\EOF.ACTION STREAM] (T (PROG [(NEXT# (COND (BUFFER (ADD1 (fetch (TFTP BLOCK#) of BUFFER))) (T 1] LP [for I from 1 to TFTP.MAXRETRIES until UDP do (SETQ UDP (UDP.GET IPSOCKET \ETHERTIMEOUT)) (COND ((NOT UDP) (\TFTP.ACKNOWLEDGE STREAM (SUB1 NEXT#] (COND [UDP (COND [(EQ (fetch (TFTP OPCODE) of UDP) \TFTP.DATA) (COND ((IEQP (fetch (TFTP BLOCK#) of UDP) NEXT#) (\TFTP.INPUT.BUFFER STREAM UDP) (\TFTP.ACKNOWLEDGE STREAM NEXT#) (RETURN T)) [(ILESSP (fetch (TFTP BLOCK#) of UDP) NEXT#) [COND (IPTRACEFLG (COND ((EQ IPTRACEFLG T) (printout IPTRACEFILE "Retransmitting ACK for block " (SUB1 NEXT#) T)) (T (PRIN1 "R" IPTRACEFILE] (\TFTP.ACKNOWLEDGE STREAM (SUB1 NEXT#)) (\RELEASE.ETHERPACKET UDP) (SETQ UDP NIL) (COND ((EQ (add RETRYCOUNT 1) TFTP.MAXRETRIES) (\TFTP.SEND.ERROR TFTPCON 0 "Timeout awaiting next data packet; aborting") (replace (STREAM STRMBINFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN)) (ERROR "Timeout awaiting next data packet; aborting" STREAM)) (T (GO LP] (T (\TFTP.SEND.ERROR TFTPCON 0 "Protocol error: Block # too high. Aborting...") (replace (STREAM STRMBINFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN)) (ERROR "Protocol error: Block # too high. Aborting..." STREAM] ((EQ (fetch (TFTP OPCODE) of UDP) \TFTP.ERROR) (replace (STREAM STRMBINFN) of STREAM with (FUNCTION STREAM.NOT.OPEN)) (\TFTP.ERROR UDP TFTPCON)) (T [\TFTP.SEND.ERROR TFTPCON 0 (CONCAT "Protocol error: Illegal TFTP opcode, expected DATA but got " (SELECTC (fetch (TFTP OPCODE) of UDP) (\TFTP.RRQ "read request.") (\TFTP.WRQ "write request.") (\TFTP.ACK "ack.") (CONCAT "unknown type " (fetch (TFTP OPCODE) of UDP) "."] (replace (STREAM STRMBINFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN)) (ERROR "Illegal TFTP opcode rec'd" STREAM] (T (\TFTP.SEND.ERROR TFTPCON 0 "Timeout awaiting next data packet; aborting") (replace (STREAM STRMBINFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN)) (ERROR "Timeout awaiting next data packet; aborting" STREAM]) (WRITE [COND [(fetch (TFTPSTREAM LASTPACKETIN) of STREAM) (replace (STREAM ACCESS) of STREAM with NIL) (COND (NOERRORFLG NIL) (T (\EOF.ACTION STREAM] (T (PROG (ACK# NBYTES) (SETQ ACK# (fetch (TFTP BLOCK#) of BUFFER)) (SETQ NBYTES (IDIFFERENCE (fetch (STREAM COFFSET) of STREAM) (UNFOLD (IDIFFERENCE (\LOLOC (fetch (TFTP TFTPCONTENTS ) of BUFFER)) (\LOLOC BUFFER)) BYTESPERWORD))) [replace (IP IPTOTALLENGTH) of BUFFER with (IPLUS NBYTES (CONSTANT (IPLUS \UDPOVLEN \TFTPOVLEN \IPOVLEN] [replace (UDP UDPLENGTH) of BUFFER with (IPLUS NBYTES (CONSTANT (IPLUS \UDPOVLEN \TFTPOVLEN ] (COND ((ILESSP NBYTES 512) (replace (TFTPSTREAM LASTPACKETIN) of STREAM with T))) LP (for I from 1 to TFTP.MAXRETRIES until UDP do (SETQ UDP (UDP.EXCHANGE IPSOCKET BUFFER))) (COND [(AND UDP (EQ (fetch (TFTP OPCODE) of UDP) \TFTP.ACK)) (COND ((EQ (fetch (TFTP BLOCK#) of UDP) ACK#) [COND ((EQ NBYTES 512) (\TFTP.SETUP UDP TFTPCON \TFTP.DATA NIL) (UDP.APPEND.WORD UDP (ADD1 ACK#)) (replace (UDP UDPLENGTH) of UDP with (CONSTANT (IPLUS 512 \UDPOVLEN \TFTPOVLEN))) (\TFTP.INPUT.BUFFER STREAM UDP)) (T (replace (STREAM CBUFPTR) of STREAM with NIL) (replace (STREAM ACCESS) of STREAM with NIL) (UDP.CLOSE.SOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON] (RETURN T)) [(ILESSP (fetch (TFTP BLOCK#) of UDP) ACK#) [COND (IPTRACEFLG (COND ((EQ IPTRACEFLG T) (printout IPTRACEFILE "TFTP retransmission on block# " ACK# T )) (T (PRIN1 "R" IPTRACEFILE] (\RELEASE.ETHERPACKET UDP) (SETQ UDP NIL) (COND [(EQ (add RETRYCOUNT 1) TFTP.MAXRETRIES) (\TFTP.SEND.ERROR TFTPCON 0 "Timeout awaiting acknowledgement. Aborting...") (replace (STREAM STRMBOUTFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN)) (COND (NOERRORFLG NIL) (T (\EOF.ACTION STREAM] (T (GO LP] (T (\TFTP.SEND.ERROR TFTPCON 0 "Protocol error: Block # too high. Aborting...") (replace (STREAM STRMBOUTFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN)) (COND (NOERRORFLG NIL) (T (\EOF.ACTION STREAM] ((AND UDP (EQ (fetch (TFTP OPCODE) of UDP) \TFTP.ERROR)) (replace (STREAM STRMBOUTFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN)) (\TFTP.ERROR UDP TFTPCON)) [UDP [\TFTP.SEND.ERROR TFTPCON 0 (CONCAT "Protocol error: Illegal TFTP opcode, expected ACK but got " (SELECTC (fetch (TFTP OPCODE) of UDP) (\TFTP.RRQ "read request.") (\TFTP.WRQ "write request.") (\TFTP.DATA "data.") (CONCAT "unknown type " (fetch (TFTP OPCODE) of UDP) "."] (replace (STREAM STRMBOUTFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN)) (COND (NOERRORFLG NIL) (T (\EOF.ACTION STREAM] (T (\TFTP.SEND.ERROR TFTPCON 0 "Protocol error, aborting...") (replace (STREAM STRMBOUTFN) of STREAM with (FUNCTION \STREAM.NOT.OPEN)) (COND (NOERRORFLG NIL) (T (\EOF.ACTION STREAM]) (ERROR "Illegal ACCESS" WHATFOR]) (\TFTP.INIT [LAMBDA NIL (* ejs%: " 2-Feb-86 12:00") (DECLARE (GLOBALVARS \TFTP.DEVICE)) (OR \TFTP.DEVICE (\DEFINEDEVICE NIL (SETQ \TFTP.DEVICE (create FDEV FDBINABLE _ T FDBOUTABLE _ T NODIRECTORIES _ T RESETABLE _ NIL RANDOMACCESSP _ NIL BUFFERED _ T PAGEMAPPED _ NIL DEVICENAME _ 'TFTP HOSTNAMEP _ (FUNCTION NILL) EVENTFN _ (FUNCTION NILL) FORCEOUTPUT _ (FUNCTION NILL) BIN _ (FUNCTION \BUFFERED.BIN) BOUT _ (FUNCTION \BUFFERED.BOUT) GETNEXTBUFFER _ (FUNCTION \TFTP.GETNEXTBUFFER) READP _ (FUNCTION \TFTP.READP) EOFP _ (FUNCTION \TFTP.EOFP) CLOSEFILE _ (FUNCTION \TFTP.CLOSEFILE]) (\TFTP.INPUT.BUFFER [LAMBDA (STREAM UDP) (* ejs%: " 9-Feb-85 20:51") (* * Sets up the fields of the stream necessary to support buffered operation,  with UDP as the next packet) (LET [(OFFSET (UNFOLD (IDIFFERENCE (\LOLOC (fetch (TFTP TFTPCONTENTS) of UDP)) (\LOLOC UDP)) BYTESPERWORD)) (LENGTH (IDIFFERENCE (fetch (UDP UDPLENGTH) of UDP) (CONSTANT (IPLUS \UDPOVLEN \TFTPOVLEN] [COND ((type? ETHERPACKET (fetch (STREAM CBUFPTR) of STREAM)) (\RELEASE.ETHERPACKET (fetch (STREAM CBUFPTR) of STREAM] (replace (STREAM CBUFPTR) of STREAM with UDP) (replace (STREAM COFFSET) of STREAM with OFFSET) (replace (STREAM CBUFSIZE) of STREAM with (replace (STREAM CBUFMAXSIZE) of STREAM with (IPLUS OFFSET LENGTH))) (COND ((ILESSP LENGTH 512) (replace (TFTPSTREAM LASTPACKETIN) of STREAM with T]) (\TFTP.OPENFILE [LAMBDA (FILENAME ACCESS RECOG PARAMETERS) (* ejs%: "15-Sep-85 17:48") (* * Open a file using TFTP) (LET* ((HOSTNAME (FILENAMEFIELD FILENAME 'HOST)) [DEVICE (COND ((DODIP.HOSTP HOSTNAME) (create FDEV using \TFTP.DEVICE DEVICENAME _ HOSTNAME)) (T (ERROR "Unknown IP host: " HOSTNAME] (STREAM (create STREAM DEVICE _ DEVICE)) [TFTPCON (replace (FDEV DEVICEINFO) of DEVICE with (create TFTPCON UDPSOCKET _ (UDP.OPEN.SOCKET) STREAM _ STREAM HOST _ (DODIP.HOSTP HOSTNAME] (UDP (\ALLOCATE.ETHERPACKET)) UDPIN) (RESETLST (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (SOCKET) (AND RESETSTATE (UDP.CLOSE.SOCKET SOCKET T] (fetch (TFTPCON UDPSOCKET) of TFTPCON))) (replace (TFTPCON DESTSOCKET) of TFTPCON with \TFTP.SOCKET) (\TFTP.SETUP UDP TFTPCON (SELECTQ ACCESS (INPUT \TFTP.RRQ) (OUTPUT \TFTP.WRQ) (ERROR "ACCESS must be INPUT or OUTPUT" ACCESS))) (UDP.APPEND.STRING UDP (SUBATOM FILENAME (STRPOS '} FILENAME NIL NIL NIL T))) (UDP.APPEND.BYTE UDP 0) (UDP.APPEND.STRING UDP (COND ((EQ (CADR (FASSOC 'TYPE PARAMETERS)) 'BINARY) "OCTET") (T "NETASCII"))) (UDP.APPEND.BYTE UDP 0) (for I from 1 to \MAXETHERTRIES do (SETQ UDPIN (UDP.EXCHANGE (fetch (TFTPCON UDPSOCKET ) of TFTPCON) UDP)) until UDPIN finally (\RELEASE.ETHERPACKET UDP)) (COND [UDPIN (SELECTC (fetch (TFTP OPCODE) of UDPIN) (\TFTP.ACK (COND ((AND (EQ ACCESS 'OUTPUT) (EQ (fetch (TFTP BLOCK#) of UDPIN) 0)) (replace (TFTPSTREAM TFTPCON) of STREAM with TFTPCON) (replace (STREAM ACCESS) of STREAM with ACCESS) (replace (STREAM FULLFILENAME) of STREAM with FILENAME) (replace (TFTPCON DESTSOCKET) of TFTPCON with (fetch (UDP UDPSOURCEPORT) of UDPIN)) (\TFTP.SETUP UDPIN TFTPCON \TFTP.DATA NIL) (UDP.APPEND.WORD UDPIN 1) (add (fetch (UDP UDPLENGTH) of UDPIN) 512) (\TFTP.INPUT.BUFFER STREAM UDPIN) STREAM))) (\TFTP.DATA (COND ((AND (EQ ACCESS 'INPUT) (EQ (fetch (TFTP BLOCK#) of UDPIN) 1)) (replace (TFTPSTREAM TFTPCON) of STREAM with TFTPCON) (replace (STREAM ACCESS) of STREAM with ACCESS) (replace (STREAM FULLFILENAME) of STREAM with FILENAME ) (replace (TFTPCON DESTSOCKET) of TFTPCON with (fetch (UDP UDPSOURCEPORT) of UDPIN)) (\TFTP.INPUT.BUFFER STREAM UDPIN) (\TFTP.ACKNOWLEDGE STREAM 1) STREAM))) (\TFTP.ERROR (\TFTP.ERROR UDPIN)) (ERROR "Unknown TFTP opcode" (fetch (TFTP OPCODE) of UDPIN] (T (UDP.CLOSE.SOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON) T) NIL]) (\TFTP.READP [LAMBDA (STREAM) (* ejs%: " 9-Feb-85 20:48") (ILESSP (fetch (STREAM COFFSET) of STREAM) (fetch (STREAM CBUFSIZE) of STREAM]) (\TFTP.SEND.ERROR [LAMBDA (TFTPCON ERRORCODE ERRORSTRING) (* ejs%: " 1-Jun-85 15:34") (* * Send an error back to the requestor) (LET ((TFTP (\ALLOCATE.ETHERPACKET))) (\TFTP.SETUP TFTP TFTPCON \TFTP.ERROR NIL) (UDP.APPEND.WORD TFTP ERRORCODE) (UDP.APPEND.STRING TFTP ERRORSTRING) (UDP.APPEND.BYTE TFTP 0) (UDP.SEND (fetch (TFTPCON UDPSOCKET) of TFTPCON) TFTP]) (\TFTP.SETUP [LAMBDA (UDP TFTPCON OPCODE REQUEUE) (* ejs%: " 9-Feb-85 20:32") (UDP.SETUP UDP (fetch (TFTPCON HOST) of TFTPCON) (fetch (TFTPCON DESTSOCKET) of TFTPCON) 0 (fetch (TFTPCON UDPSOCKET) of TFTPCON)) (replace EPREQUEUE of UDP with REQUEUE) (UDP.APPEND.WORD UDP OPCODE]) ) (FILESLOAD (SYSLOAD) TCPUDP) (* ;; "TFTP Server functions") (RPAQ? \TFTP.SERVER.CONNECTIONS ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \TFTP.SERVER.CONNECTIONS) ) (DEFINEQ (TFTP.SERVER.PROCESS [LAMBDA (LOGSTREAM) (* ejs%: " 3-Jun-85 01:52") (* * A server for TFTP file transfer) (DECLARE (GLOBALVARS \TFTP.SERVER.CONNECTIONS)) (LET* ((DEVICE (create FDEV using \TFTP.DEVICE DEVICENAME _ 'TFTPSERVER)) (SERVERSOCKET (UDP.OPEN.SOCKET \TFTP.SOCKET T)) CONNECTION) [COND ((NULL LOGSTREAM) (COND ((NOT (HASTTYWINDOWP)) (\CREATE.TTYDISPLAYSTREAM))) (SETQ LOGSTREAM (TTYDISPLAYSTREAM] (SETQ \TFTP.SERVER.CONNECTIONS NIL) (COND (SERVERSOCKET (RESETLST (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (SOCKET) (UDP.CLOSE.SOCKET SOCKET T] SERVERSOCKET)) (while T do (LET ((UDP (UDP.GET SERVERSOCKET T))) (SETQ CONNECTION (CONS (fetch (IP IPSOURCEADDRESS) of UDP) (fetch (UDP UDPSOURCEPORT) of UDP))) (COND [(NOT (MEMBER CONNECTION \TFTP.SERVER.CONNECTIONS)) (push \TFTP.SERVER.CONNECTIONS CONNECTION) (SELECTC (fetch (TFTP OPCODE) of UDP) (\TFTP.RRQ (ADD.PROCESS `(\TFTP.SEND.FILE %, UDP (QUOTE %, (create TFTPCON UDPSOCKET _ (UDP.OPEN.SOCKET) )) %, DEVICE %, LOGSTREAM))) (\TFTP.WRQ (ADD.PROCESS `(\TFTP.GET.FILE %, UDP (QUOTE %, (create TFTPCON UDPSOCKET _ (UDP.OPEN.SOCKET) )) %, DEVICE %, LOGSTREAM))) (PROGN (printout LOGSTREAM "TFTP Server: Unexpected opcode " (fetch (TFTP OPCODE) of UDP) T) (SETQ \TFTP.SERVER.CONNECTIONS (DREMOVE CONNECTION \TFTP.SERVER.CONNECTIONS )) (\RELEASE.ETHERPACKET UDP] (T (* Duplicate request) (\RELEASE.ETHERPACKET UDP]) (\TFTP.GET.FILE [LAMBDA (UDP TFTPCON DEVICE LOGSTREAM) (* ; "Edited 14-Apr-87 20:19 by FS") (* ;; "Try to start receiving a file from the requestor as directed by the contents of the received UDP packet") (DECLARE (GLOBALVARS \TFTP.SERVER.CONNECTIONS)) (LET* ([FILENAMELENGTH (for I from BYTESPERWORD until (EQ 0 (\GETBASEBYTE (fetch (TFTP TFTPBASE) of UDP) I)) finally (RETURN (IDIFFERENCE I BYTESPERWORD] (FILENAME (ALLOCSTRING FILENAMELENGTH)) [MODELENGTH (for I from (IPLUS BYTESPERWORD FILENAMELENGTH 1) until (EQ 0 (\GETBASEBYTE (fetch (TFTP TFTPBASE) of UDP) I)) finally (RETURN (IDIFFERENCE I (IPLUS BYTESPERWORD FILENAMELENGTH 1] (MODE (ALLOCSTRING MODELENGTH)) (HOST (fetch (IP IPSOURCEADDRESS) of UDP)) FILE TYPE TFTPSTREAM RESULT) (RESETLST (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (TFTPCON) (LET* [(UDPSOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON)) (CONNECTION (CONS (fetch (TFTPCON HOST) of TFTPCON) (fetch (TFTPCON DESTSOCKET ) of TFTPCON] (SETQ \TFTP.SERVER.CONNECTIONS (REMOVE CONNECTION \TFTP.SERVER.CONNECTIONS)) (AND RESETSTATE (UDP.CLOSE.SOCKET UDPSOCKET T] TFTPCON)) (replace (TFTPCON DESTSOCKET) of TFTPCON with (fetch (UDP UDPSOURCEPORT) of UDP)) (replace (TFTPCON HOST) of TFTPCON with HOST) (* ;; "Read the filename out of the packet") (\MOVEBYTES (fetch (TFTP TFTPBASE) of UDP) BYTESPERWORD (fetch (STRINGP BASE) of FILENAME) (fetch (STRINGP OFFST) of FILENAME) FILENAMELENGTH) (* ;; "Read the mode out of the packet") (\MOVEBYTES (fetch (TFTP TFTPBASE) of UDP) (IPLUS BYTESPERWORD FILENAMELENGTH 1) (fetch (STRINGP BASE) of MODE) (fetch (STRINGP OFFST) of MODE) MODELENGTH) (SETQ MODE (U-CASE MODE)) (printout LOGSTREAM "TFTP Server: Will attempt to receive " FILENAME " in " MODE " mode from host " (\IP.ADDRESS.TO.STRING HOST) T) (SETQ RESULT (COND [[AND (SETQ TYPE (COND ((STREQUAL MODE "NETASCII") 'TEXT) ((STREQUAL MODE "OCTET") 'BINARY) (T (\TFTP.SEND.ERROR TFTPCON 0 (CONCAT "Unknown transfer type--" MODE)) NIL))) (SETQ FILE (LET [(OUTSTREAM (CAR (NLSETQ (OPENSTREAM FILENAME 'OUTPUT 'NEW (LIST (LIST 'TYPE TYPE] (COND ((NULL OUTSTREAM) (\TFTP.SEND.ERROR TFTPCON 1 (CONCAT "Can't open file--" FILENAME)) NIL) (T OUTSTREAM] (* ;; "Mode is OK, and file is open for input. Open the TFTP stream back to the requestor") (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (FILE) (COND (RESETSTATE (CLOSEF? FILE) (DELFILE (FULLNAME FILE] FILE)) (SETQ TFTPSTREAM (create STREAM DEVICE _ DEVICE)) (replace (TFTPCON STREAM) of TFTPCON with TFTPSTREAM) (replace (STREAM ACCESS) of TFTPSTREAM with 'INPUT) (replace (TFTPSTREAM TFTPCON) of TFTPSTREAM with TFTPCON) (* ;; "Send the first acknowledgement") (\TFTP.ACKNOWLEDGE TFTPSTREAM 0) (\RELEASE.ETHERPACKET UDP) (printout LOGSTREAM "TFTP Server: receiving " (FULLNAME FILE) T) (COND ((NLSETQ (COPYBYTES TFTPSTREAM FILE)) (printout LOGSTREAM "TFTP Server: Done receiving " (FULLNAME FILE) T) (CLOSEF? FILE)) (T (printout LOGSTREAM "TFTP Server: Failed to receive " (FULLNAME FILE) T) (DELFILE (FULLNAME (CLOSEF? FILE] (T (printout LOGSTREAM "TFTP Server: Failed to receive " (FULLNAME FILE) T) (\RELEASE.ETHERPACKET UDP) NIL))) (* ;; "Remove connection from list.") (LET (UDPSOCKET CONNECTION) (SETQ UDPSOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON)) (SETQ CONNECTION (CONS (fetch (TFTPCON HOST) of TFTPCON) (fetch (UDP UDPDESTPORT) of UDPSOCKET))) (SETQ \TFTP.SERVER.CONNECTIONS (REMOVE CONNECTION \TFTP.SERVER.CONNECTIONS))) RESULT]) (\TFTP.SEND.FILE [LAMBDA (UDP TFTPCON DEVICE LOGSTREAM) (* ; "Edited 30-Jun-87 22:12 by scp") (* ;; "Try to start sending a file to the requestor as directed by the contents of the received UDP packet") (DECLARE (GLOBALVARS \TFTP.SERVER.CONNECTIONS)) (LET* ([FILENAMELENGTH (for I from BYTESPERWORD until (EQ 0 (\GETBASEBYTE (fetch (TFTP TFTPBASE) of UDP) I)) finally (RETURN (IDIFFERENCE I BYTESPERWORD] (FILENAME (ALLOCSTRING FILENAMELENGTH)) [MODELENGTH (for I from (IPLUS BYTESPERWORD FILENAMELENGTH 1) until (EQ 0 (\GETBASEBYTE (fetch (TFTP TFTPBASE) of UDP) I)) finally (RETURN (IDIFFERENCE I (IPLUS BYTESPERWORD FILENAMELENGTH 1] (MODE (ALLOCSTRING MODELENGTH)) (HOST (fetch (IP IPSOURCEADDRESS) of UDP)) FILE TYPE TFTPSTREAM RESULT) (RESETLST (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (TFTPCON) (LET* [(UDPSOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON)) (CONNECTION (CONS (fetch (TFTPCON HOST) of TFTPCON) (fetch (TFTPCON DESTSOCKET) of TFTPCON] (SETQ \TFTP.SERVER.CONNECTIONS (REMOVE CONNECTION \TFTP.SERVER.CONNECTIONS )) (AND RESETSTATE (UDP.CLOSE.SOCKET UDPSOCKET T] TFTPCON)) (replace (TFTPCON DESTSOCKET) of TFTPCON with (fetch (UDP UDPSOURCEPORT) of UDP)) (replace (TFTPCON HOST) of TFTPCON with HOST) (* ;; "Read the filename out of the packet") (\MOVEBYTES (fetch (TFTP TFTPBASE) of UDP) BYTESPERWORD (fetch (STRINGP BASE) of FILENAME) (fetch (STRINGP OFFST) of FILENAME) FILENAMELENGTH) (* ;; "Read the mode out of the packet") (\MOVEBYTES (fetch (TFTP TFTPBASE) of UDP) (IPLUS BYTESPERWORD FILENAMELENGTH 1) (fetch (STRINGP BASE) of MODE) (fetch (STRINGP OFFST) of MODE) MODELENGTH) (SETQ MODE (U-CASE MODE)) (printout LOGSTREAM "TFTP Server: Will attempt to send " FILENAME " in " MODE " mode to host " (\IP.ADDRESS.TO.STRING HOST) T) (SETQ RESULT (COND ([AND (SETQ TYPE (COND ((STREQUAL MODE "NETASCII") 'TEXT) ((STREQUAL MODE "OCTET") 'BINARY) (T (\TFTP.SEND.ERROR TFTPCON 0 (CONCAT "Unknown transfer type--" MODE)) NIL))) (SETQ FILE (LET* [(FULLFILENAME (INFILEP FILENAME)) (INSTREAM (AND FULLFILENAME (CAR (NLSETQ (OPENSTREAM FULLFILENAME 'INPUT 'OLD (LIST (LIST 'TYPE TYPE] (COND ((NULL INSTREAM) (\TFTP.SEND.ERROR TFTPCON 1 (CONCAT "Can't open file--" FILENAME)) NIL) (T INSTREAM] (* ;; "Mode is OK, and file is open for input. Open the TFTP stream back to the requestor") (SETQ TFTPSTREAM (create STREAM DEVICE _ DEVICE)) (replace (TFTPCON STREAM) of TFTPCON with TFTPSTREAM) (replace (STREAM ACCESS) of TFTPSTREAM with 'OUTPUT) (replace (TFTPSTREAM TFTPCON) of TFTPSTREAM with TFTPCON) (* ;; "Use the incoming packet as the first data packet on the way out") (\TFTP.SETUP UDP TFTPCON \TFTP.DATA NIL) (* ;; "This is block number 1") (UDP.APPEND.WORD UDP 1) (add (fetch (UDP UDPLENGTH) of UDP) 512) (\TFTP.INPUT.BUFFER TFTPSTREAM UDP) (printout LOGSTREAM "TFTP Server: Sending " FILENAME T) (COND ((NLSETQ (PROGN (COPYBYTES FILE TFTPSTREAM) (\TFTP.GETNEXTBUFFER TFTPSTREAM 'WRITE T) (\TFTP.CLOSEFILE TFTPSTREAM))) (printout LOGSTREAM "TFTP Server: Done sending " FILENAME T)) (T (printout LOGSTREAM "TFTP Server: Failed to send " FILENAME T))) (CLOSEF? FILE)) (T (printout LOGSTREAM "TFTP Server: Failed to send " FILENAME T) (\RELEASE.ETHERPACKET UDP) NIL))) (* ;; "Remove connection from list.") (LET (UDPSOCKET CONNECTION) (SETQ UDPSOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON)) (SETQ CONNECTION (CONS (fetch (TFTPCON HOST) of TFTPCON) (fetch (UDP UDPDESTPORT) of UDPSOCKET))) (SETQ \TFTP.SERVER.CONNECTIONS (REMOVE CONNECTION \TFTP.SERVER.CONNECTIONS))) RESULT]) ) (* ;; "User functions") (DEFINEQ (TFTP.SERVER [LAMBDA (LOGSTREAM) (* MPL " 2-Jun-85 19:39") (* * Create a new TFTP server. LOGSTREAM defaults to a popup window) (ADD.PROCESS `(TFTP.SERVER.PROCESS %, LOGSTREAM) 'RESTARTABLE 'HARDRESET]) (TFTP.GET [LAMBDA (FROM TO PARAMETERS) (* MPL " 2-Jun-85 17:15") (LET ((EOLCONVENTION (CADR (FASSOC 'EOLCONVENTION PARAMETERS))) (TYPE (FASSOC 'TYPE PARAMETERS)) (FROMNAME FROM) (TONAME TO)) (RESETLST [SETQ TO (OPENSTREAM TO 'OUTPUT 'NEW NIL (COND (TYPE (LIST TYPE] (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM) (COND ((AND STREAM RESETSTATE) (CLOSEF? STREAM) (DELFILE (FULLNAME STREAM] TO)) (SETQ FROM (\TFTP.OPENFILE FROM 'INPUT 'OLD PARAMETERS)) (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM) (AND STREAM RESETSTATE (CLOSEF STREAM] FROM)) (COND (EOLCONVENTION (replace (STREAM EOLCONVENTION) of FROM with EOLCONVENTION))) (COND ((AND FROM TO) (COPYCHARS FROM TO) (AND (OPENP FROM) (CLOSEF FROM)) (FULLNAME (CLOSEF TO))) (TO (ERRORX (LIST 9 FROMNAME))) (FROM (ERRORX (LIST 9 TONAME]) (TFTP.PUT [LAMBDA (FROM TO PARAMETERS) (* ; "Edited 15-Apr-87 20:55 by FS") (LET ((EOLCONVENTION (CADR (FASSOC 'EOLCONVENTION PARAMETERS))) (TYPE (FASSOC 'TYPE PARAMETERS))) (* ;; "Why is TYPE not used anywhere?") (RESETLST (SETQ FROM (OPENSTREAM FROM 'INPUT 'OLD)) (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM) (AND RESETSTATE (CLOSEF STREAM] FROM)) (SETQ TO (\TFTP.OPENFILE TO 'OUTPUT 'NEW PARAMETERS)) (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM) (AND RESETSTATE (CLOSEF STREAM] TO)) (COND (EOLCONVENTION (replace (STREAM EOLCONVENTION) of TO with EOLCONVENTION))) (COPYCHARS FROM TO) (CLOSEF FROM) (* ;; "Removed (FULLNAME (CLOSEF TO))") (CLOSEF TO]) ) (* ;; "Tracing functions") (DEFINEQ (PRINTTFTP [LAMBDA (TFTP FILE) (* ejs%: " 2-Jun-85 14:00") (DECLARE (GLOBALVARS TFTPOPCODES)) (PRINTCONSTANT (fetch (TFTP OPCODE) of TFTP) TFTPOPCODES FILE "TFTP Opcode: ") (SELECTC (fetch (TFTP OPCODE) of TFTP) (\TFTP.RRQ (printout FILE " ") (\TFTP.PRINT.REQUEST TFTP FILE)) (\TFTP.WRQ (printout FILE " ") (\TFTP.PRINT.REQUEST TFTP FILE)) (\TFTP.ACK (printout FILE " ") (\TFTP.PRINT.ACK TFTP FILE)) (\TFTP.DATA (printout FILE " ") (\TFTP.PRINT.DATA TFTP FILE)) (\TFTP.ERROR (printout FILE " ") (\TFTP.PRINT.ERROR TFTP FILE)) NIL) (TERPRI FILE) (TERPRI FILE]) (\TFTP.PRINT.ACK [LAMBDA (TFTP FILE) (* ejs%: " 2-Jun-85 12:48") (printout FILE "Block #: " (fetch (TFTP BLOCK#) of TFTP) T]) (\TFTP.PRINT.DATA [LAMBDA (TFTP FILE) (* ejs%: " 2-Jun-85 14:00") (printout FILE "Block #: " (fetch (TFTP BLOCK#) of TFTP) T) (PRINTPACKETDATA (fetch (TFTP TFTPCONTENTS) of TFTP) \TFTPOVLEN '(CHARS 12 |...|) (IDIFFERENCE (fetch (UDP UDPLENGTH) of TFTP) (CONSTANT (IPLUS \TFTPOVLEN \UDPOVLEN]) (\TFTP.PRINT.ERROR [LAMBDA (TFTP FILE) (* ejs%: " 2-Jun-85 13:15") (printout FILE "Error code: " (fetch (TFTP ERRORCODE) of TFTP) T) (PRINTPACKETDATA (fetch (TFTP TFTPCONTENTS) of TFTP) 0 '(CHARS |...|) (IDIFFERENCE (fetch (UDP UDPLENGTH) of TFTP) (CONSTANT (IPLUS \UDPOVLEN \TFTPOVLEN))) FILE]) (\TFTP.PRINT.REQUEST [LAMBDA (TFTP FILE) (* ejs%: " 2-Jun-85 13:16") (* * Try to start sending a file to the requestor as directed by the contents  of the received TFTP packet) (LET* ([FILENAMELENGTH (for I from BYTESPERWORD until (EQ 0 (\GETBASEBYTE (fetch (TFTP TFTPBASE) of TFTP) I)) finally (RETURN (IDIFFERENCE I BYTESPERWORD] (FILENAME (ALLOCSTRING FILENAMELENGTH)) [MODELENGTH (for I from (IPLUS BYTESPERWORD FILENAMELENGTH 1) until (EQ 0 (\GETBASEBYTE (fetch (TFTP TFTPBASE) of TFTP) I)) finally (RETURN (IDIFFERENCE I (IPLUS BYTESPERWORD FILENAMELENGTH 1] (MODE (ALLOCSTRING MODELENGTH))) (* * Read the filename out of the packet) (\MOVEBYTES (fetch (TFTP TFTPBASE) of TFTP) BYTESPERWORD (fetch (STRINGP BASE) of FILENAME) (fetch (STRINGP OFFST) of FILENAME) FILENAMELENGTH) (* * Read the mode out of the packet) (\MOVEBYTES (fetch (TFTP TFTPBASE) of TFTP) (IPLUS BYTESPERWORD FILENAMELENGTH 1) (fetch (STRINGP BASE) of MODE) (fetch (STRINGP OFFST) of MODE) MODELENGTH) (printout FILE (SELECTC (fetch (TFTP OPCODE) of TFTP) (\TFTP.RRQ "Read request for ") (\TFTP.WRQ "Write request for ") (SHOULDNT)) FILENAME " in mode " MODE T]) ) (\TFTP.INIT) (PUTPROPS TCPTFTP COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (3785 28418 (\TFTP.ACKNOWLEDGE 3795 . 4474) (\TFTP.CLOSEFILE 4476 . 5171) (\TFTP.EOFP 5173 . 5530) (\TFTP.ERROR 5532 . 6308) (\TFTP.GETNEXTBUFFER 6310 . 19593) (\TFTP.INIT 19595 . 20684) ( \TFTP.INPUT.BUFFER 20686 . 21902) (\TFTP.OPENFILE 21904 . 27296) (\TFTP.READP 27298 . 27522) ( \TFTP.SEND.ERROR 27524 . 28019) (\TFTP.SETUP 28021 . 28416)) (28610 46223 (TFTP.SERVER.PROCESS 28620 . 31874) (\TFTP.GET.FILE 31876 . 39527) (\TFTP.SEND.FILE 39529 . 46221)) (46256 49207 (TFTP.SERVER 46266 . 46555) (TFTP.GET 46557 . 48098) (TFTP.PUT 48100 . 49205)) (49243 53309 (PRINTTFTP 49253 . 50082) (\TFTP.PRINT.ACK 50084 . 50285) (\TFTP.PRINT.DATA 50287 . 50726) (\TFTP.PRINT.ERROR 50728 . 51181) (\TFTP.PRINT.REQUEST 51183 . 53307))))) STOP \ No newline at end of file diff --git a/obsolete/tcp/TCPUDP b/obsolete/tcp/TCPUDP new file mode 100644 index 00000000..9f0f5b90 --- /dev/null +++ b/obsolete/tcp/TCPUDP @@ -0,0 +1 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "12-Jun-90 17:46:11" {DSK}local>lde>lispcore>library>TCPUDP.;2 11429 changes to%: (VARS TCPUDPCOMS) previous date%: " 6-Jan-89 16:37:55" {DSK}local>lde>lispcore>library>TCPUDP.;1) (* ; " Copyright (c) 1985, 1986, 1987, 1989, 1990 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT TCPUDPCOMS) (RPAQQ TCPUDPCOMS [(COMS (* ;; "User Datagram Protocol --- Definitions") [DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS UDP) (CONSTANTS (\UDPOVLEN 8] (FILES (SYSLOAD) TCPLLIP)) (COMS (* ;; "Internal functions") (FNS UDP.GET.BYTE UDP.GET.CELL UDP.GET.STRING UDP.GET.WORD \UDP.FLUSH.SOCKET.QUEUE \UDP.PORTCOMPARE \UDP.CHECKSUM \UDP.SET.CHECKSUM) (FNS \UDP.HANDLE.ICMP)) (COMS (* ;; "External functions") (FNS PRINTUDP UDP.INIT UDP.STOP UDP.OPEN.SOCKET UDP.CLOSE.SOCKET UDP.SOCKET.EVENT UDP.SOCKET.NUMBER UDP.GET UDP.SEND UDP.EXCHANGE UDP.SETUP UDP.APPEND.BYTE UDP.APPEND.CELL UDP.APPEND.STRING UDP.APPEND.WORD UDP.INCREMENT.LENGTH) (ADDVARS (IPPRINTMACROS (17 . PRINTUDP))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD? 'NILL 'PRINTRPCDATA) (UDP.INIT]) (* ;; "User Datagram Protocol --- Definitions") (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED") (DECLARE%: EVAL@COMPILE (ACCESSFNS UDP ((UDPBASE (\IPDATABASE DATUM))) (BLOCKRECORD UDPBASE ((UDPSOURCEPORT WORD) (UDPDESTPORT WORD) (UDPLENGTH WORD) (UDPCHECKSUM WORD))) [ACCESSFNS UDP ((UDPCONTENTS (\ADDBASE (\IPDATABASE DATUM) (FOLDHI \UDPOVLEN BYTESPERWORD]) ) (DECLARE%: EVAL@COMPILE (RPAQQ \UDPOVLEN 8) (CONSTANTS (\UDPOVLEN 8)) ) (* "END EXPORTED DEFINITIONS") ) (FILESLOAD (SYSLOAD) TCPLLIP) (* ;; "Internal functions") (DEFINEQ (UDP.GET.BYTE (LAMBDA (UDP BYTE#) (* ejs%: "25-Jun-85 21:04") (* * Return a byte from the UDP data area) (COND ((AND (IGEQ BYTE# 0) (ILESSP BYTE# (fetch (UDP UDPLENGTH) of UDP))) (\GETBASEBYTE (fetch (UDP UDPCONTENTS) of UDP) BYTE#)))) ) (UDP.GET.CELL (LAMBDA (UDP CELL#) (* ejs%: "25-Jun-85 21:09") (* * Return a cell from the UDP data area) (COND ((AND (IGEQ CELL# 0) (ILESSP CELL# (FOLDLO (fetch (UDP UDPLENGTH) of UDP) BYTESPERCELL))) (\MAKENUMBER (\GETBASE (fetch (UDP UDPCONTENTS) of UDP) (UNFOLD CELL# WORDSPERCELL)) (\GETBASE (fetch (UDP UDPCONTENTS) of UDP) (ADD1 (UNFOLD CELL# WORDSPERCELL))))))) ) (UDP.GET.STRING (LAMBDA (UDP OFFSET) (* ejs%: "25-Jun-85 21:12") (* * Fetch a string out of the UDP packet) (OR (SMALLP OFFSET) (SETQ OFFSET 0)) (LET* ((LENGTH (IDIFFERENCE (fetch (UDP UDPLENGTH) of UDP) OFFSET)) (STRING (ALLOCSTRING LENGTH))) (\MOVEBYTES (fetch (UDP UDPCONTENTS) of UDP) OFFSET (fetch (STRINGP BASE) of STRING) (fetch (STRINGP OFFST) of STRING) LENGTH) STRING)) ) (UDP.GET.WORD (LAMBDA (UDP WORD#) (* ejs%: "25-Jun-85 21:06") (* * Return a word from the UDP data area) (COND ((AND (IGEQ WORD# 0) (ILESSP WORD# (FOLDLO (fetch (UDP UDPLENGTH) of UDP) BYTESPERWORD))) (\GETBASE (fetch (UDP UDPCONTENTS) of UDP) WORD#)))) ) (\UDP.FLUSH.SOCKET.QUEUE (LAMBDA (IPSOCKET) (* ; "Edited 25-Aug-88 12:57 by bvm") (* ;;; "Called to flush input packet queue on an IPSOCKET") (LET ((QUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET)) PACKET) (UNINTERRUPTABLY (while (SETQ PACKET (\DEQUEUE QUEUE)) do (\RELEASE.ETHERPACKET PACKET) finally (replace (IPSOCKET IPSQUEUELENGTH) of IPSOCKET with 0))))) ) (\UDP.PORTCOMPARE (LAMBDA (UDP IPSOCKET) (* ejs%: " 9-Feb-85 14:37") (* * Compare IPSOCKET until we find the one this UDP was destined for) (EQ (fetch (UDP UDPDESTPORT) of UDP) (fetch (IPSOCKET IPSOCKET) of IPSOCKET))) ) (\UDP.CHECKSUM (LAMBDA (UDP ZeroCheckSumIsOK) (* HAS%: "19-Aug-86 16:47") (* * Compute the UDP checksum for the packet UDP. The packet is assumed to have been setup by UDP.SETUP so that source and destination addresses, protocol, and UDP length have already been set.) (COND ((AND ZeroCheckSumIsOK (EQ (fetch (UDP UDPCHECKSUM) of UDP) 0)) (* * BSD Unix strikes again!) 0) (T (LET ((SOURCE (fetch (IP IPSOURCEADDRESS) of UDP)) (DEST (fetch (IP IPDESTINATIONADDRESS) of UDP)) (LENGTH (fetch (UDP UDPLENGTH) of UDP)) CHECKSUM) (SETQ CHECKSUM (IPLUS (bind (BASE _ (LOCF (fetch (IP IPSOURCEADDRESS) of UDP))) for I from 0 to (CONSTANT (SUB1 (TIMES 2 WORDSPERCELL))) sum (\GETBASE BASE I)) (ffetch (IP IPPROTOCOL) of UDP) LENGTH (\IPCHECKSUM UDP (\IPDATABASE UDP) LENGTH))) (SETQ CHECKSUM (IPLUS (LDB (BYTE 16 16) CHECKSUM) (LDB (BYTE 16 0) CHECKSUM))) (COND ((NOT (EQ (LDB (BYTE 16 16) CHECKSUM) 0)) (SETQ CHECKSUM (IPLUS (LDB (BYTE 16 16) CHECKSUM) (LDB (BYTE 16 0) CHECKSUM))))) CHECKSUM)))) ) (\UDP.SET.CHECKSUM (LAMBDA (UDP) (* ejs%: " 3-Jun-85 00:19") (* * Called to set the UDP checksum in a packet ready to be transmitted) (LET (CHECKSUM) (replace (UDP UDPCHECKSUM) of UDP with 0) (SETQ CHECKSUM (\UDP.CHECKSUM UDP)) (replace (UDP UDPCHECKSUM) of UDP with (COND ((NEQ CHECKSUM MAX.SMALLP) (LOGAND (LOGNOT CHECKSUM) (CONSTANT (MASK.1'S 0 16)))) (T MAX.SMALLP))))) ) ) (DEFINEQ (\UDP.HANDLE.ICMP (LAMBDA (ICMP SENTIP PROTOCOL) (* ; "Edited 13-Sep-88 14:26 by bvm") (* ;; "Handle an ICMP packet sent to a UDP socket. We allow each UDP client to decide how to handle these.") (LET ((SOCKET (\IP.FIND.SOCKET (ffetch (UDP UDPSOURCEPORT) of SENTIP) PROTOCOL)) FN) (if (OR (NULL SOCKET) (EQ (SETQ FN (ffetch (IPSOCKET IPSICMPFN) of SOCKET)) (QUOTE \UDP.HANDLE.ICMP))) then (* ; "Sender went away already, or else didn't specify a handler (so inherited the default)") (\RELEASE.ETHERPACKET ICMP) else (CL:FUNCALL FN ICMP SENTIP SOCKET)))) ) ) (* ;; "External functions") (DEFINEQ (PRINTUDP (LAMBDA (UDP FILE) (* ; "Edited 6-Jan-89 16:18 by Briggs") (printout FILE "UDP Source port: " (fetch (UDP UDPSOURCEPORT) of UDP) " Dest port: " (fetch (UDP UDPDESTPORT) of UDP) T "Length: " (fetch (UDP UDPLENGTH) of UDP) " Checksum: " (fetch (UDP UDPCHECKSUM) of UDP) T) (COND ((OR (EQ (fetch (UDP UDPDESTPORT) of UDP) \TFTP.SOCKET) (EQ (fetch (UDP UDPSOURCEPORT) of UDP) \TFTP.SOCKET)) (PRINTTFTP UDP FILE)) (T (PRINTRPCDATA (fetch (UDP UDPCONTENTS) of UDP) (- (fetch (UDP UDPLENGTH) of UDP) \UDPOVLEN) FILE)))) ) (UDP.INIT (LAMBDA NIL (* ; "Edited 25-Aug-88 12:54 by bvm") (COND ((OR \IPFLG (SELECTQ (ASKUSER 15 (QUOTE Y) "IP is not running. Shall I attempt to initialize it? ") (Y (\IPINIT) \IPFLG) NIL)) (\IP.ADD.PROTOCOL \UDP.PROTOCOL (FUNCTION \UDP.PORTCOMPARE) NIL NIL (FUNCTION \UDP.HANDLE.ICMP))))) ) (UDP.STOP (LAMBDA NIL (* ejs%: " 9-Feb-85 14:43") (\IP.DELETE.PROTOCOL \UDP.PROTOCOL))) (UDP.OPEN.SOCKET (LAMBDA (SKT# IFCLASH ICMPFN) (* ; "Edited 25-Aug-88 13:03 by bvm") (LET ((UDPCHAIN (\IP.FIND.PROTOCOL \UDP.PROTOCOL))) (if (OR UDPCHAIN (SETQ UDPCHAIN (UDP.INIT))) then (if (NULL SKT#) then (* ; "Open any free socket") (\IP.OPEN.SOCKET \UDP.PROTOCOL NIL NIL NIL NIL NIL ICMPFN) else (* ; "Check for clash") (LET ((IPSOCKET (\IP.FIND.SOCKET SKT# UDPCHAIN))) (if (NULL IPSOCKET) then (\IP.OPEN.SOCKET \UDP.PROTOCOL SKT# NIL NIL NIL NIL ICMPFN) else (SELECTQ IFCLASH ((T ACCEPT) (\UDP.FLUSH.SOCKET.QUEUE IPSOCKET) IPSOCKET) ((DON'T FAIL) NIL) (ERROR "UDP Port is already in use" SKT#))))) else (* ; "IP not inited") (SELECTQ IFCLASH ((DON'T FAIL) NIL) (ERROR!))))) ) (UDP.CLOSE.SOCKET (LAMBDA (IPSOCKET NOERRORFLG) (* ejs%: " 9-Feb-85 15:00") (\UDP.FLUSH.SOCKET.QUEUE IPSOCKET) (\IP.CLOSE.SOCKET (fetch (IPSOCKET IPSOCKET) of IPSOCKET) \UDP.PROTOCOL NOERRORFLG)) ) (UDP.SOCKET.EVENT (LAMBDA (IPSOCKET) (* ejs%: " 9-Feb-85 15:07") (fetch (IPSOCKET IPSEVENT) of IPSOCKET))) (UDP.SOCKET.NUMBER (LAMBDA (IPSOCKET) (* ejs%: " 9-Feb-85 15:08") (fetch (IPSOCKET IPSOCKET) of IPSOCKET))) (UDP.GET (LAMBDA (IPSOCKET WAIT) (* ; "Edited 13-Sep-88 11:59 by bvm") (* ;;; "Returns the next UDP packet on the queue, or NIL if none exist and WAIT is NIL. If WAIT is T, this function waits forever. If WAIT is an integer, it is interpreted as the number of milliseconds to wait before returning NIL or a packet which arrives during that time. This function therefore is like GETXIP and GETPUP") (PROG ((QUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET)) UDP TIMER) LP (UNINTERRUPTABLY (COND ((SETQ UDP (\DEQUEUE QUEUE)) (add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET) -1)))) (COND ((NULL UDP) (COND (WAIT (COND ((EQ WAIT T) (* ; "Wait forever")) (TIMER (COND ((TIMEREXPIRED? TIMER) (RETURN)))) (T (OR (FIXP WAIT) (LISPERROR "NON-NUMERIC ARG" WAIT)) (SETQ TIMER (SETUPTIMER WAIT)) T)) (AWAIT.EVENT (fetch (IPSOCKET IPSEVENT) of IPSOCKET) TIMER T) (GO LP)) (T (BLOCK)))) ((AND (EQ (fetch (IP IPPROTOCOL) of UDP) \UDP.PROTOCOL) (NEQ (fetch (UDP UDPCHECKSUM) of UDP) 0) (NOT (\IP.CHECKSUM.OK (\UDP.CHECKSUM UDP)))) (* ; "Bad checksum on UDP packet. Any other kind of packet must have been put there by someone else") (\RELEASE.ETHERPACKET UDP) (GO LP))) (RETURN UDP))) ) (UDP.SEND (LAMBDA (IPSOCKET UDP) (* ejs%: " 9-Feb-85 15:24") (* * Sends a UDP packet. IP and UDP header assumed set up by UDP.SETUP and \IP.SETUPIP) (\UDP.SET.CHECKSUM UDP) (\IP.TRANSMIT UDP)) ) (UDP.EXCHANGE (LAMBDA (IPSOCKET OUTUDP TIMEOUT) (* ejs%: " 9-Feb-85 22:28") (* * Send a UDP packet and wait for TIMEOUT to receive a packet (TIMEOUT defaults to \ETHERTIMEOUT)) (\UDP.FLUSH.SOCKET.QUEUE IPSOCKET) (UDP.SEND IPSOCKET OUTUDP) (BLOCK) (UDP.GET IPSOCKET (OR (FIXP TIMEOUT) \ETHERTIMEOUT))) ) (UDP.SETUP (LAMBDA (UDP DESTHOST DESTSOCKET ID IPSOCKET REQUEUE) (* ejs%: " 9-Feb-85 16:04") (\IP.SETUPIP UDP DESTHOST ID IPSOCKET REQUEUE) (add (fetch (IP IPTOTALLENGTH) of UDP) \UDPOVLEN) (AND (SMALLP DESTSOCKET) (replace (UDP UDPDESTPORT) of UDP with DESTSOCKET)) (replace (UDP UDPSOURCEPORT) of UDP with (fetch (IPSOCKET IPSOCKET) of IPSOCKET)) (replace (UDP UDPLENGTH) of UDP with \UDPOVLEN) UDP) ) (UDP.APPEND.BYTE (LAMBDA (UDP BYTE) (* ejs%: " 9-Feb-85 16:07") (\IP.APPEND.BYTE UDP BYTE) (add (fetch (UDP UDPLENGTH) of UDP) 1)) ) (UDP.APPEND.CELL (LAMBDA (UDP CELL) (* ejs%: " 9-Feb-85 16:06") (\IP.APPEND.CELL UDP CELL) (add (fetch (UDP UDPLENGTH) of UDP) BYTESPERCELL)) ) (UDP.APPEND.STRING (LAMBDA (UDP STRING) (* ejs%: " 9-Feb-85 16:10") (OR (STRINGP STRING) (SETQ STRING (MKSTRING STRING))) (\IP.APPEND.STRING UDP STRING) (add (fetch (UDP UDPLENGTH) of UDP) (NCHARS STRING))) ) (UDP.APPEND.WORD (LAMBDA (UDP WORD) (* ejs%: " 9-Feb-85 16:07") (\IP.APPEND.WORD UDP WORD) (add (fetch (UDP UDPLENGTH) of UDP) WORDSPERCELL)) ) (UDP.INCREMENT.LENGTH (LAMBDA (UDP INCREMENT) (* ejs%: "12-Apr-86 18:50") (add (fetch (IP IPTOTALLENGTH) of UDP) INCREMENT) (add (fetch (UDP UDPLENGTH) of UDP) INCREMENT) INCREMENT) ) ) (ADDTOVAR IPPRINTMACROS (17 . PRINTUDP)) (DECLARE%: DONTEVAL@LOAD DOCOPY (MOVD? 'NILL 'PRINTRPCDATA) (UDP.INIT) ) (PUTPROPS TCPUDP COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1989 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (2357 5603 (UDP.GET.BYTE 2367 . 2608) (UDP.GET.CELL 2610 . 2984) (UDP.GET.STRING 2986 . 3371) (UDP.GET.WORD 3373 . 3632) (\UDP.FLUSH.SOCKET.QUEUE 3634 . 3998) (\UDP.PORTCOMPARE 4000 . 4224) (\UDP.CHECKSUM 4226 . 5220) (\UDP.SET.CHECKSUM 5222 . 5601)) (5604 6176 (\UDP.HANDLE.ICMP 5614 . 6174) ) (6213 11197 (PRINTUDP 6223 . 6752) (UDP.INIT 6754 . 7053) (UDP.STOP 7055 . 7146) (UDP.OPEN.SOCKET 7148 . 7833) (UDP.CLOSE.SOCKET 7835 . 8036) (UDP.SOCKET.EVENT 8038 . 8148) (UDP.SOCKET.NUMBER 8150 . 8261) (UDP.GET 8263 . 9439) (UDP.SEND 9441 . 9639) (UDP.EXCHANGE 9641 . 9947) (UDP.SETUP 9949 . 10356) (UDP.APPEND.BYTE 10358 . 10494) (UDP.APPEND.CELL 10496 . 10643) (UDP.APPEND.STRING 10645 . 10857) ( UDP.APPEND.WORD 10859 . 11006) (UDP.INCREMENT.LENGTH 11008 . 11195))))) STOP \ No newline at end of file From 50dc0a9269d372f65f66fcde03933896589b2d79 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Tue, 17 Oct 2023 21:54:17 -0700 Subject: [PATCH 29/37] Remove calls to openfile (#1333) * Remove calls to OPENFILE OPENFILE is a residual Interlisp function that returns a litatom instead of a stream. In almost all cases, this immediate causes an error that litatom files are no longer supported. I have found (FINDCALLERS) all the examples in lispusers/sources/library/ and replaced OPENFILE with OPENSTREAM (except for the calls from \PEEKPUP and \PEEKNS, that I didn't track down). There was a trivai call in COMPILE.FILECHECK in COMPILE, but that function is not called anywhere. So I removed it. * ADIR: remove OPENFILE calls, also another stab at \COPYSYS With respect to \COPYSYS, this replaces the draft PR #1263. This applies TRUEFILENAME at the start, but remembers whether it was in fact a pseudohost and restores that for the return value. So if you start in a pseudo world you end up there. --------- Co-authored-by: Larry Masinter --- lispusers/BITMAPFNS.LCOM | Bin 2831 -> 2868 bytes lispusers/READAIS | 395 +++++++++++++++++++++++++++++++--- lispusers/READAIS.LCOM | Bin 27602 -> 27243 bytes lispusers/READINTERPRESS | 87 ++++++-- lispusers/READINTERPRESS.LCOM | Bin 11212 -> 11097 bytes lispusers/SHOWTIME | 148 +++++++++---- lispusers/SHOWTIME.LCOM | Bin 22879 -> 22917 bytes lispusers/UNDIGESTIFY | 62 +++--- lispusers/UNDIGESTIFY.LCOM | Bin 7204 -> 7294 bytes lispusers/bitmapfns | 206 +++++++++--------- sources/ADIR | 117 +++++----- sources/ADIR.LCOM | Bin 19583 -> 19540 bytes sources/CMLCOMPILE | 131 ++++++++--- sources/CMLCOMPILE.LCOM | Bin 14373 -> 14056 bytes sources/COMPILE | 120 +++++------ sources/COMPILE.LCOM | Bin 28327 -> 28113 bytes sources/HARDCOPY | 105 +++++---- sources/HARDCOPY.LCOM | Bin 47249 -> 47266 bytes sources/PRINTFN | 51 ++--- sources/PRINTFN.LCOM | Bin 5163 -> 5037 bytes 20 files changed, 990 insertions(+), 432 deletions(-) diff --git a/lispusers/BITMAPFNS.LCOM b/lispusers/BITMAPFNS.LCOM index 78c2d74f95e5c40ecda0dd486c5dd19582e79b81..9d09d57e3577c01b9bb85f483c7394c8a7afe9d3 100644 GIT binary patch delta 1097 zcma)4%Wl&^6m3Ey(y3Tg1PQ8eWl?HZa^>+O4~vaskK3X4*m#^qVS`#)K}BCGAdo85 z6$@4fnGN57#0GuD$K+;h&{d+vSP_|iC$J>pYFRG$V!rOc0@ z89VNpvqC_kEG0=mc`QLQA&!?iz2L9wp2G=XO+iS`6T}f-E{OgN_3rb1wbKG@=8ah0yydeet~F53?os9>!yZjT zCkET=pzL+!Lj`3wtM+vyD`=3=l>7^NTD_+t*=T|9k#*3!z*C_XLJLYM(es!ama;#q zkDExoC?D{&guJ-)@)nY@28;~Af~cRy{j^XjDh(&Vx#?plfKlKHAZ35zO0`eZYYT|c zAg^TNlcQ-GF7h&SLIRxHcGj#N-LUN?Hy{q{$EqJCAzuPt>`s~gSeu`l`gNr`RT<1b zni5}e%w|7orza*B9WyLk?pUMV%RK~ab;c=k5*gj`ouQ8-JjvpTn5K=g9di`4+oPa0 z4y-Pa`$-ZdV2(kejwmLq9ENaC$L-OCgsYl=jH;6b9tzyW%Y)!lbEBktx zE}l78nihjDmX4E@r}>t}fJ=*TeWNOzd|y`-PJWkd?@>dR!jPCw{Zvi delta 1124 zcma)5U2oE06dr8M4b$6QD3X)LWn~JXZ)qvrLQTCcICCFE$y3QDgefpepzU+P2TQW^mQ|h)NyGjFSj?K%9 zLB3J~wj`AViIizz=-%XFIvja@n2dpj>xOf7b37W(r@hI{tNLIu_h$2IcX)ZxnZ6y* z3rB1YD4K}*)5RzdD@#N~JsP^c*65%QLzL3J{&M79!5y(sDA3UFT;g5#k8`|4Ds+yz zZx=YcVVoBQ-!98Zdax`|oWhX+0x65oJMWB_ z18)wO6A2hyuG^*qwpBkl%Td4}6EK#BWh;)8gXzqBH=HcyfjbFfAko!?Na&8`|LbZ# zNBN>P)j&^ZX$L()wjolhABm3%YSl?fk0>TbwQbc^VpdH0ntYk37*2p@LwNMEDLEY>READAIS.;1 48154 - changes to%: (FNS AISBLT AISBLT1TO1 24BITCOLORTO8BITMAP AISBLT8TO4MODUL AISBLT8TOLESSFSA AISBLT8TO4TRUNC AISBLT8TO8 AISBLT4TO4 AISBLT8TO4LESSFSA AISBLT8TO1FSA AISBLT8TO1TRUNC CLOSEST.COLOR GRAPHAISHISTOGRAM AISHISTOGRAM SMOOTHEDFILTER SLOW.COLOR.DISTANCE FAST.COLOR.DISTANCE INSUREAISFILE SHOWCOLORAIS SHOWCOLORAIS1 WRITEAIS WRITEAIS1 \GETBASENYBBLE \PUTBASENYBBLE) - (VARS READAISCOMS) +(FILECREATED "24-Sep-2023 14:35:09" {WMEDLEY}READAIS.;2 63146 - previous date%: "27-Apr-88 12:12:58" {QV}LISP>MEDLEY>READAIS.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS AISHISTOGRAM) + + :PREVIOUS-DATE "28-Apr-88 17:04:57" {WMEDLEY}READAIS.;1) -(* " -Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved. +(* ; " +Copyright (c) 1982-1988 by Xerox Corporation. ") (PRETTYCOMPRINT READAISCOMS) -(RPAQQ READAISCOMS ((DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NYBBLESPERWORD 4))) (* ;; "fixed INSUREAISFILE, AISBLT, AISBLT8TO8. nhb 27-Apr-88 01:58:56") (FNS 24BITCOLORTO8BITMAP AISBLT AISBLT1TO1 AISBLT8TO4MODUL AISBLT8TOLESSFSA AISBLT8TO4TRUNC AISBLT8TO8 AISBLT4TO4 AISBLT8TO4LESSFSA AISBLT8TO1FSA AISBLT8TO1TRUNC CLOSEST.COLOR GRAPHAISHISTOGRAM AISHISTOGRAM SMOOTHEDFILTER SLOW.COLOR.DISTANCE FAST.COLOR.DISTANCE INSUREAISFILE SHOWCOLORAIS SHOWCOLORAIS1 WRITEAIS WRITEAIS1 \GETBASENYBBLE \PUTBASENYBBLE) (MACROS .GET.4BIT.AND.SPREAD.ERR. .GET.1BIT.AND.SPREAD.ERR. .GET.NBIT.AND.SPREAD.ERR. .GET.LEFTMOST.4BIT .GET.LEFTMOST.BIT. .GET.BESTCOLOR.AND.SPREAD.ERR. .4BIT.MODULATE.INTENSITY.VALUE. .MODULATE.INTENSITY.VALUE. SQUARE) (P (MOVD? (QUOTE FAST.COLOR.DISTANCE) (QUOTE COLOR.DISTANCE))) (VARS AISDIRECTORIES) (GLOBALVARS AISDIRECTORIES))) +(RPAQQ READAISCOMS + ((DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NYBBLESPERWORD 4))) + + (* ;; "fixed INSUREAISFILE, AISBLT, AISBLT8TO8. nhb 27-Apr-88 01:58:56") + + (FNS 24BITCOLORTO8BITMAP AISBLT AISBLT1TO1 AISBLT8TO4MODUL AISBLT8TOLESSFSA AISBLT8TO4TRUNC + AISBLT8TO8 AISBLT4TO4 AISBLT8TO4LESSFSA AISBLT8TO1FSA AISBLT8TO1TRUNC CLOSEST.COLOR + GRAPHAISHISTOGRAM AISHISTOGRAM SMOOTHEDFILTER SLOW.COLOR.DISTANCE FAST.COLOR.DISTANCE + INSUREAISFILE SHOWCOLORAIS SHOWCOLORAIS1 WRITEAIS WRITEAIS1 \GETBASENYBBLE + \PUTBASENYBBLE) + (MACROS .GET.4BIT.AND.SPREAD.ERR. .GET.1BIT.AND.SPREAD.ERR. .GET.NBIT.AND.SPREAD.ERR. + .GET.LEFTMOST.4BIT .GET.LEFTMOST.BIT. .GET.BESTCOLOR.AND.SPREAD.ERR. + .4BIT.MODULATE.INTENSITY.VALUE. .MODULATE.INTENSITY.VALUE. SQUARE) + (P (MOVD? 'FAST.COLOR.DISTANCE 'COLOR.DISTANCE)) + (VARS AISDIRECTORIES) + (GLOBALVARS AISDIRECTORIES))) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE -(RPAQQ NYBBLESPERWORD 4) +(RPAQQ NYBBLESPERWORD 4) (CONSTANTS (NYBBLESPERWORD 4)) @@ -83,8 +100,59 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. Al ) (AISHISTOGRAM -(LAMBDA (FILE REGION) (* kbr%: "13-Jul-85 19:28") (* returns an array that have the number of pixels in FILE that have each intensity.) (PROG (STREAM DATABEG AISHISTOGRAM TMP BITSPERSAMPLE SFILEWIDTH SFILEHEIGHT SFILEBYTESPERLINE LEFT BOTTOM RIGHT TOP WIDTH HEIGHT BEG END) (COND ((OR (SETQ STREAM (FINDFILE FILE NIL AISDIRECTORIES)) (SETQ STREAM FILE)) (SETQ STREAM (GETSTREAM (OPENFILE STREAM (QUOTE INPUT)) (QUOTE INPUT))))) (SETQ TMP (INSUREAISFILE STREAM)) (SETQ BITSPERSAMPLE (CAR TMP)) (SETQ SFILEWIDTH (CADR TMP)) (SETQ SFILEHEIGHT (CADDR TMP)) (SETQ SFILEBYTESPERLINE (LLSH (CADDDR TMP) 1)) (SETQ DATABEG (GETFILEPTR STREAM)) (SETQ AISHISTOGRAM (ARRAY (EXPT 2 BITSPERSAMPLE) NIL 0 0)) (COND (REGION (SETQ LEFT (IMAX (IMIN (fetch (REGION LEFT) of REGION) (SUB1 SFILEWIDTH)) 0)) (SETQ RIGHT (IMAX (IMIN SFILEWIDTH (fetch (REGION PRIGHT) of REGION)) 0)) (COND ((IGEQ LEFT RIGHT) (RETURN AISHISTOGRAM)) (T (SETQ WIDTH (IDIFFERENCE RIGHT LEFT)))) (SETQ BOTTOM (IMIN (fetch (REGION BOTTOM) of REGION) (SUB1 SFILEHEIGHT))) (SETQ TOP (IMIN SFILEHEIGHT (fetch (REGION PTOP) of REGION))) (COND ((IGREATERP BOTTOM TOP) (RETURN AISHISTOGRAM))) (SETQ BEG (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE SFILEHEIGHT TOP)) LEFT))) (SETQ END (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE SFILEHEIGHT BOTTOM)) LEFT))) (for LINE from BEG to END by SFILEBYTESPERLINE do (\SETFILEPTR STREAM LINE) (for BIT from 1 to WIDTH do (SETA AISHISTOGRAM (SETQ TMP (\BIN STREAM)) (ADD1 (ELT AISHISTOGRAM TMP)))))) (T (for LINE from 1 to SFILEHEIGHT do (for BIT from 1 to SFILEBYTESPERLINE do (SETA AISHISTOGRAM (SETQ TMP (\BIN STREAM)) (ADD1 (ELT AISHISTOGRAM TMP))))))) (CLOSEF STREAM) (RETURN AISHISTOGRAM))) -) + [LAMBDA (FILE REGION) (* ; "Edited 24-Sep-2023 14:34 by rmk") + (* kbr%: "13-Jul-85 19:28") + (* ; + "returns an array that have the number of pixels in FILE that have each intensity.") + (PROG (STREAM DATABEG AISHISTOGRAM TMP BITSPERSAMPLE SFILEWIDTH SFILEHEIGHT SFILEBYTESPERLINE + LEFT BOTTOM RIGHT TOP WIDTH HEIGHT BEG END) + [COND + ((OR (SETQ STREAM (FINDFILE FILE NIL AISDIRECTORIES)) + (SETQ STREAM FILE)) + (SETQ STREAM (OPENSTREAM STREAM 'INPUT] + (SETQ TMP (INSUREAISFILE STREAM)) + (SETQ BITSPERSAMPLE (CAR TMP)) + (SETQ SFILEWIDTH (CADR TMP)) + (SETQ SFILEHEIGHT (CADDR TMP)) + (SETQ SFILEBYTESPERLINE (LLSH (CADDDR TMP) + 1)) + (SETQ DATABEG (GETFILEPTR STREAM)) + (SETQ AISHISTOGRAM (ARRAY (EXPT 2 BITSPERSAMPLE) + NIL 0 0)) + [COND + [REGION (SETQ LEFT (IMAX (IMIN (fetch (REGION LEFT) of REGION) + (SUB1 SFILEWIDTH)) + 0)) + (SETQ RIGHT (IMAX (IMIN SFILEWIDTH (fetch (REGION PRIGHT) of REGION)) + 0)) + [COND + ((IGEQ LEFT RIGHT) + (RETURN AISHISTOGRAM)) + (T (SETQ WIDTH (IDIFFERENCE RIGHT LEFT] + (SETQ BOTTOM (IMIN (fetch (REGION BOTTOM) of REGION) + (SUB1 SFILEHEIGHT))) + (SETQ TOP (IMIN SFILEHEIGHT (fetch (REGION PTOP) of REGION))) + (COND + ((IGREATERP BOTTOM TOP) + (RETURN AISHISTOGRAM))) + (SETQ BEG (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE + SFILEHEIGHT TOP) + ) + LEFT))) + (SETQ END (IPLUS DATABEG (IPLUS (ITIMES SFILEBYTESPERLINE (IDIFFERENCE + SFILEHEIGHT + BOTTOM)) + LEFT))) + (for LINE from BEG to END by SFILEBYTESPERLINE + do (\SETFILEPTR STREAM LINE) + (for BIT from 1 to WIDTH do (SETA AISHISTOGRAM (SETQ TMP (\BIN STREAM)) + (ADD1 (ELT AISHISTOGRAM TMP] + (T (for LINE from 1 to SFILEHEIGHT + do (for BIT from 1 to SFILEBYTESPERLINE + do (SETA AISHISTOGRAM (SETQ TMP (\BIN STREAM)) + (ADD1 (ELT AISHISTOGRAM TMP] + (CLOSEF STREAM) + (RETURN AISHISTOGRAM]) (SMOOTHEDFILTER (LAMBDA (HISTOGRAM) (* kbr%: "13-Jul-85 15:05") (* returns a 256 to 256 mapping array that maximally distributes the intensity values by looking at the histogram array HISTOGRAM) (PROG (ARSIZE SMOOTHARRAY TOTALPOINTS POINTSLESS FILEINTENSITY NEWINTENSITY POINTSPAST BUCKETSIZE NTOMOVE NPTS) (SETQ ARSIZE (ARRAYSIZE HISTOGRAM)) (SETQ POINTSLESS 0) (SETQ NEWINTENSITY 0) (SETQ POINTSPAST 0) (SETQ SMOOTHARRAY (ARRAY ARSIZE NIL 0 0)) (SETQ TOTALPOINTS (for I from 0 to (SUB1 ARSIZE) sum (ELT HISTOGRAM I))) (SETQ BUCKETSIZE (IQUOTIENT TOTALPOINTS 256)) (for I from 0 to (SUB1 ARSIZE) do (SETQ NPTS (ELT HISTOGRAM I)) (SETQ POINTSLESS (IPLUS POINTSLESS NPTS)) (COND ((IGREATERP POINTSLESS BUCKETSIZE) (SETQ NTOMOVE (IQUOTIENT POINTSLESS BUCKETSIZE)) (SETA SMOOTHARRAY I (IPLUS NEWINTENSITY (IQUOTIENT NTOMOVE 2))) (SETQ NEWINTENSITY (COND ((IGREATERP NEWINTENSITY 255) 255) (T (IPLUS NEWINTENSITY NTOMOVE)))) (SETQ POINTSLESS (IDIFFERENCE POINTSLESS (ITIMES NTOMOVE BUCKETSIZE)))) (T (SETA SMOOTHARRAY I NEWINTENSITY)))) (RETURN SMOOTHARRAY))) @@ -128,41 +196,308 @@ Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. Al ) (DECLARE%: EVAL@COMPILE -(PUTPROPS .GET.4BIT.AND.SPREAD.ERR. MACRO ((STREAM) (PROGN (* returns the 4 most significant bits taking into account the error and spreads the error into the appropriate places.) (SETQ BYTE (IPLUS (\BIN STREAM) THISPIXELERROR)) (PROG1 (COND ((IGREATERP BYTE 255) (* overflow case) 15) (T (LRSH BYTE 4))) (SETQ ERR (LOGAND BYTE 15)) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELERROR (IPLUS (\GETBASE ERRTABLEPTR 1) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASE ERRTABLEPTR 1 (LRSH ERR 1)) (* |3/8| to one below) (\PUTBASE ERRTABLEPTR 0 (IPLUS (\GETBASE ERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1)))) (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 1)))))) +(PUTPROPS .GET.4BIT.AND.SPREAD.ERR. MACRO [(STREAM) + (PROGN -(PUTPROPS .GET.1BIT.AND.SPREAD.ERR. MACRO ((STREAM) (PROGN (* returns the most significant bit taking into account the error and spreads the error into the appropriate places.) (SETQ BYTE (IPLUS (\BIN STREAM) THISPIXELERROR)) (PROG1 (SETQ VAL (COND ((IGREATERP BYTE 255) (* overflow case) 0) ((IGREATERP 0 BYTE) (* overflow case) 1) (T (LOGXOR (LRSH BYTE 7) 1)))) (SETQ ERR (IDIFFERENCE BYTE (\GETBASE INTENSITYBASE VAL))) (* put |3/8| of error into next pixel, |3/8| to one below and |1/4| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) 2) 64)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THREEEIGHTSERR (IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) 1) 128))) (SETQ THISPIXELERROR (IPLUS (\GETBASEPTR ERRTABLEPTR 2) THREEEIGHTSERR)) (* |1/4| of error to next one down to right.) (\PUTBASEPTR ERRTABLEPTR 2 ERR) (* |3/8| to one below) (\PUTBASEPTR ERRTABLEPTR 0 (IPLUS (\GETBASEPTR ERRTABLEPTR 0) THREEEIGHTSERR)) (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2)))))) + (* returns the 4 most significant bits taking into account the error and spreads + the error into the appropriate places.) -(PUTPROPS .GET.NBIT.AND.SPREAD.ERR. MACRO ((STREAM) (PROGN (* returns the NBITS most significant bits taking into account the error and spreads the error into the appropriate places.) (SETQ BYTE (IPLUS (IDIFFERENCE 255 (\BIN STREAM)) THISPIXELERROR)) (PROG1 (SETQ VAL (COND ((IGREATERP BYTE 255) (* overflow case) MAXVALUE) ((IGREATERP 0 BYTE) 0) (T (LRSH BYTE DELBITS)))) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (SETQ ERR (IDIFFERENCE BYTE (\GETBASE INTENSITYBASE VAL))) (* calculate |1/4| of error.) (SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) 2) 64)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THREEEIGHTSERR (IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) 1) 128))) (SETQ THISPIXELERROR (IPLUS (\GETBASEPTR ERRTABLEPTR 2) THREEEIGHTSERR)) (* |1/8| of error to next one down to right.) (\PUTBASEPTR ERRTABLEPTR 2 ERR) (* |3/8| to one below) (\PUTBASEPTR ERRTABLEPTR 0 (IPLUS (\GETBASEPTR ERRTABLEPTR 0) THREEEIGHTSERR)) (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2)))))) + (SETQ BYTE (IPLUS (\BIN STREAM) + THISPIXELERROR)) + (PROG1 (COND + ((IGREATERP BYTE 255) + (* overflow case) + 15) + (T (LRSH BYTE 4))) + (SETQ ERR (LOGAND BYTE 15)) -(PUTPROPS .GET.LEFTMOST.4BIT MACRO ((STREAM) (* returns the 4 most significant bits) (LRSH (\BIN STREAM) 4))) + (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below + and to the right.) + (* calculate |1/4| of error.) + (SETQ ERR (LRSH ERR 2)) + (* |3/8| of error to next pixel plus + error from previous line) + [SETQ THISPIXELERROR + (IPLUS (\GETBASE ERRTABLEPTR 1) + (IPLUS ERR (LRSH ERR 1] + (* |1/8| of error to next one down to + right.) + (\PUTBASE ERRTABLEPTR 1 (LRSH ERR 1)) + (* |3/8| to one below) + [\PUTBASE ERRTABLEPTR 0 + (IPLUS (\GETBASE ERRTABLEPTR 0) + (IPLUS ERR (LRSH ERR 1] + (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 1)))]) -(PUTPROPS .GET.LEFTMOST.BIT. MACRO ((STREAM) (* returns the most significant bit from an 8 bit sample. It also inverts the sign of the bit since 1 is black and 0 white. NIL) (COND ((IGREATERP (COND (FILTERARRAY (ELT FILTERARRAY (\BIN STREAM))) (T (\BIN STREAM))) 127) 0) (T 1)))) +(PUTPROPS .GET.1BIT.AND.SPREAD.ERR. MACRO [(STREAM) + (PROGN -(PUTPROPS .GET.BESTCOLOR.AND.SPREAD.ERR. MACRO (NIL (PROGN (* returns the best matching color bits taking into account the error and spreads the error into the appropriate places.) (SETQ COLOR (CLOSEST.COLOR COLORMAP (SETQ REDBYTE (IPLUS (\BIN REDSTREAM) THISPIXELREDERROR)) (SETQ GREENBYTE (IPLUS (\BIN GREENSTREAM) THISPIXELGREENERROR)) (SETQ BLUEBYTE (IPLUS (\BIN BLUESTREAM) THISPIXELBLUEERROR)))) (SETQ RGB (ELT COLORMAP COLOR)) (PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB RED) of RGB) REDBYTE)) (COND ((IGREATERP ERR -1) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELREDERROR (IPLUS (\GETBASEPTR REDERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR REDERRTABLEPTR 2 (LRSH ERR 1)) (* |3/8| to one below) (\PUTBASEPTR REDERRTABLEPTR 0 (IPLUS (\GETBASEPTR REDERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1))))) (T (* error is negative, do things differently.) (* calculate |1/4| of error.) (SETQ ERR (LRSH (IMINUS ERR) 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELREDERROR (IDIFFERENCE (\GETBASEPTR REDERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR REDERRTABLEPTR 2 (IMINUS (LRSH ERR 1))) (* |3/8| to one below) (\PUTBASEPTR REDERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR REDERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1)))))) (SETQ REDERRTABLEPTR (\ADDBASE REDERRTABLEPTR 2))) (PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB GREEN) of RGB) GREENBYTE)) (COND ((IGREATERP ERR -1) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELGREENERROR (IPLUS (\GETBASEPTR GREENERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR GREENERRTABLEPTR 2 (LRSH ERR 1)) (* |3/8| to one below) (\PUTBASEPTR GREENERRTABLEPTR 0 (IPLUS (\GETBASEPTR GREENERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1))))) (T (* error is negative, do things differently.) (* calculate |1/4| of error.) (SETQ ERR (LRSH (IMINUS ERR) 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELGREENERROR (IDIFFERENCE (\GETBASEPTR GREENERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR GREENERRTABLEPTR 2 (IMINUS (LRSH ERR 1))) (* |3/8| to one below) (\PUTBASEPTR GREENERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR GREENERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1)))))) (SETQ GREENERRTABLEPTR (\ADDBASE GREENERRTABLEPTR 2))) (PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB BLUE) of RGB) BLUEBYTE)) (COND ((IGREATERP ERR -1) (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below and to the right.) (* calculate |1/4| of error.) (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELBLUEERROR (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR BLUEERRTABLEPTR 2 (LRSH ERR 1)) (* |3/8| to one below) (\PUTBASEPTR BLUEERRTABLEPTR 0 (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1))))) (T (* error is negative, do things differently.) (* calculate |1/4| of error.) (SETQ ERR (LRSH (IMINUS ERR) 2)) (* |3/8| of error to next pixel plus error from previous line) (SETQ THISPIXELBLUEERROR (IDIFFERENCE (\GETBASEPTR BLUEERRTABLEPTR 2) (IPLUS ERR (LRSH ERR 1)))) (* |1/8| of error to next one down to right.) (\PUTBASEPTR BLUEERRTABLEPTR 2 (IMINUS (LRSH ERR 1))) (* |3/8| to one below) (\PUTBASEPTR BLUEERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR BLUEERRTABLEPTR 0) (IPLUS ERR (LRSH ERR 1)))))) (SETQ BLUEERRTABLEPTR (\ADDBASE BLUEERRTABLEPTR 2))) COLOR))) + (* returns the most significant bit taking into account the error and spreads the + error into the appropriate places.) -(PUTPROPS .4BIT.MODULATE.INTENSITY.VALUE. MACRO ((STREAM) (LOGAND (IMIN 255 (IMAX (IPLUS (\BIN STREAM) (RAND MODMIN MODMAX)) 0)) 240))) + (SETQ BYTE (IPLUS (\BIN STREAM) + THISPIXELERROR)) + (PROG1 [SETQ VAL (COND + ((IGREATERP BYTE 255) + (* overflow case) + 0) + ((IGREATERP 0 BYTE) + (* overflow case) + 1) + (T (LOGXOR (LRSH BYTE 7) + 1] + (SETQ ERR (IDIFFERENCE BYTE (\GETBASE + INTENSITYBASE + VAL))) -(PUTPROPS .MODULATE.INTENSITY.VALUE. MACRO ((STREAM) (IMIN 255 (IMAX (IPLUS (\BIN STREAM) (RAND MODMIN MODMAX)) 0)))) + (* put |3/8| of error into next pixel, |3/8| to one below and |1/4| to one below + and to the right.) + (* calculate |1/4| of error.) + (SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) + 2) + 64)) + (* |3/8| of error to next pixel plus + error from previous line) + (SETQ THREEEIGHTSERR + (IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) + 1) + 128))) + (SETQ THISPIXELERROR (IPLUS (\GETBASEPTR + ERRTABLEPTR + 2) + THREEEIGHTSERR)) + (* |1/4| of error to next one down to + right.) + (\PUTBASEPTR ERRTABLEPTR 2 ERR) + (* |3/8| to one below) + (\PUTBASEPTR ERRTABLEPTR 0 + (IPLUS (\GETBASEPTR ERRTABLEPTR 0) + THREEEIGHTSERR)) + (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2)))]) -(PUTPROPS SQUARE MACRO (LAMBDA (X) (* coded this way because negative arith is not is microcode for ITIMES) (COND ((IGREATERP X -1) (ITIMES X X)) (T (ITIMES (SETQ X (IMINUS X)) X))))) +(PUTPROPS .GET.NBIT.AND.SPREAD.ERR. MACRO [(STREAM) + (PROGN + + (* returns the NBITS most significant bits taking into account the error and + spreads the error into the appropriate places.) + + (SETQ BYTE (IPLUS (IDIFFERENCE 255 (\BIN STREAM)) + THISPIXELERROR)) + (PROG1 [SETQ VAL (COND + ((IGREATERP BYTE 255) + (* overflow case) + MAXVALUE) + ((IGREATERP 0 BYTE) + 0) + (T (LRSH BYTE DELBITS] + + (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below + and to the right.) + + (SETQ ERR (IDIFFERENCE BYTE (\GETBASE + INTENSITYBASE + VAL))) + (* calculate |1/4| of error.) + (SETQ ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) + 2) + 64)) + (* |3/8| of error to next pixel plus + error from previous line) + (SETQ THREEEIGHTSERR + (IPLUS ERR (IDIFFERENCE (LRSH (IPLUS 256 ERR) + 1) + 128))) + (SETQ THISPIXELERROR (IPLUS (\GETBASEPTR + ERRTABLEPTR + 2) + THREEEIGHTSERR)) + (* |1/8| of error to next one down to + right.) + (\PUTBASEPTR ERRTABLEPTR 2 ERR) + (* |3/8| to one below) + (\PUTBASEPTR ERRTABLEPTR 0 + (IPLUS (\GETBASEPTR ERRTABLEPTR 0) + THREEEIGHTSERR)) + (SETQ ERRTABLEPTR (\ADDBASE ERRTABLEPTR 2)))]) + +(PUTPROPS .GET.LEFTMOST.4BIT MACRO ((STREAM) (* returns the 4 most significant bits) + (LRSH (\BIN STREAM) + 4))) + +(PUTPROPS .GET.LEFTMOST.BIT. MACRO ((STREAM) + + (* returns the most significant bit from an 8 bit sample. + It also inverts the sign of the bit since 1 is black and 0 white. + NIL) + + (COND + ((IGREATERP (COND + (FILTERARRAY (ELT FILTERARRAY (\BIN STREAM))) + (T (\BIN STREAM))) + 127) + 0) + (T 1)))) + +(PUTPROPS .GET.BESTCOLOR.AND.SPREAD.ERR. MACRO + (NIL (PROGN + + (* returns the best matching color bits taking into account the error and spreads + the error into the appropriate places.) + + [SETQ COLOR (CLOSEST.COLOR COLORMAP (SETQ REDBYTE (IPLUS (\BIN REDSTREAM) + THISPIXELREDERROR)) + (SETQ GREENBYTE (IPLUS (\BIN GREENSTREAM) + THISPIXELGREENERROR)) + (SETQ BLUEBYTE (IPLUS (\BIN BLUESTREAM) + THISPIXELBLUEERROR] + (SETQ RGB (ELT COLORMAP COLOR)) + (PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB RED) of RGB) + REDBYTE)) + [COND + [(IGREATERP ERR -1) + + (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below + and to the right.) + (* calculate |1/4| of error.) + (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus + error from previous line) + [SETQ THISPIXELREDERROR (IPLUS (\GETBASEPTR REDERRTABLEPTR 2) + (IPLUS ERR (LRSH ERR 1] + (* |1/8| of error to next one down to + right.) + (\PUTBASEPTR REDERRTABLEPTR 2 (LRSH ERR 1)) + (* |3/8| to one below) + (\PUTBASEPTR REDERRTABLEPTR 0 (IPLUS (\GETBASEPTR REDERRTABLEPTR 0) + (IPLUS ERR (LRSH ERR 1] + (T (* error is negative, do things + differently.) + (* calculate |1/4| of error.) + (SETQ ERR (LRSH (IMINUS ERR) + 2)) (* |3/8| of error to next pixel plus + error from previous line) + [SETQ THISPIXELREDERROR (IDIFFERENCE (\GETBASEPTR REDERRTABLEPTR 2 + ) + (IPLUS ERR (LRSH ERR 1] + (* |1/8| of error to next one down to + right.) + (\PUTBASEPTR REDERRTABLEPTR 2 (IMINUS (LRSH ERR 1))) + (* |3/8| to one below) + (\PUTBASEPTR REDERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR + REDERRTABLEPTR 0 + ) + (IPLUS ERR (LRSH ERR 1] + (SETQ REDERRTABLEPTR (\ADDBASE REDERRTABLEPTR 2))) + (PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB GREEN) of RGB) + GREENBYTE)) + [COND + [(IGREATERP ERR -1) + + (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below + and to the right.) + (* calculate |1/4| of error.) + (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus + error from previous line) + [SETQ THISPIXELGREENERROR (IPLUS (\GETBASEPTR GREENERRTABLEPTR 2) + (IPLUS ERR (LRSH ERR 1] + (* |1/8| of error to next one down to + right.) + (\PUTBASEPTR GREENERRTABLEPTR 2 (LRSH ERR 1)) + (* |3/8| to one below) + (\PUTBASEPTR GREENERRTABLEPTR 0 (IPLUS (\GETBASEPTR GREENERRTABLEPTR + 0) + (IPLUS ERR (LRSH ERR 1] + (T (* error is negative, do things + differently.) + (* calculate |1/4| of error.) + (SETQ ERR (LRSH (IMINUS ERR) + 2)) (* |3/8| of error to next pixel plus + error from previous line) + [SETQ THISPIXELGREENERROR (IDIFFERENCE (\GETBASEPTR + GREENERRTABLEPTR 2) + (IPLUS ERR (LRSH ERR 1] + (* |1/8| of error to next one down to + right.) + (\PUTBASEPTR GREENERRTABLEPTR 2 (IMINUS (LRSH ERR 1))) + (* |3/8| to one below) + (\PUTBASEPTR GREENERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR + GREENERRTABLEPTR + 0) + (IPLUS ERR (LRSH ERR 1] + (SETQ GREENERRTABLEPTR (\ADDBASE GREENERRTABLEPTR 2))) + (PROGN (SETQ ERR (IDIFFERENCE (fetch (RGB BLUE) of RGB) + BLUEBYTE)) + [COND + [(IGREATERP ERR -1) + + (* put |3/8| of error into next pixel, |3/8| to one below and |1/8| to one below + and to the right.) + (* calculate |1/4| of error.) + (SETQ ERR (LRSH ERR 2)) (* |3/8| of error to next pixel plus + error from previous line) + [SETQ THISPIXELBLUEERROR (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 2) + (IPLUS ERR (LRSH ERR 1] + (* |1/8| of error to next one down to + right.) + (\PUTBASEPTR BLUEERRTABLEPTR 2 (LRSH ERR 1)) + (* |3/8| to one below) + (\PUTBASEPTR BLUEERRTABLEPTR 0 (IPLUS (\GETBASEPTR BLUEERRTABLEPTR 0 + ) + (IPLUS ERR (LRSH ERR 1] + (T (* error is negative, do things + differently.) + (* calculate |1/4| of error.) + (SETQ ERR (LRSH (IMINUS ERR) + 2)) (* |3/8| of error to next pixel plus + error from previous line) + [SETQ THISPIXELBLUEERROR (IDIFFERENCE (\GETBASEPTR BLUEERRTABLEPTR + 2) + (IPLUS ERR (LRSH ERR 1] + (* |1/8| of error to next one down to + right.) + (\PUTBASEPTR BLUEERRTABLEPTR 2 (IMINUS (LRSH ERR 1))) + (* |3/8| to one below) + (\PUTBASEPTR BLUEERRTABLEPTR 0 (IDIFFERENCE (\GETBASEPTR + BLUEERRTABLEPTR + 0) + (IPLUS ERR (LRSH ERR 1] + (SETQ BLUEERRTABLEPTR (\ADDBASE BLUEERRTABLEPTR 2))) + COLOR))) + +(PUTPROPS .4BIT.MODULATE.INTENSITY.VALUE. MACRO ((STREAM) + (LOGAND (IMIN 255 (IMAX (IPLUS (\BIN STREAM) + (RAND MODMIN MODMAX)) + 0)) + 240))) + +(PUTPROPS .MODULATE.INTENSITY.VALUE. MACRO ((STREAM) + (IMIN 255 (IMAX (IPLUS (\BIN STREAM) + (RAND MODMIN MODMAX)) + 0)))) + +(PUTPROPS SQUARE MACRO [LAMBDA (X) (* coded this way because negative + arith is not is microcode for ITIMES) + (COND + ((IGREATERP X -1) + (ITIMES X X)) + (T (ITIMES (SETQ X (IMINUS X)) + X]) ) -(MOVD? (QUOTE FAST.COLOR.DISTANCE) (QUOTE COLOR.DISTANCE)) +(MOVD? 'FAST.COLOR.DISTANCE 'COLOR.DISTANCE) -(RPAQQ AISDIRECTORIES (T {CORE} {DSK} {CYAN})) +(RPAQQ AISDIRECTORIES (T {CORE} {DSK} {CYAN})) (DECLARE%: DOEVAL@COMPILE DONTCOPY - (GLOBALVARS AISDIRECTORIES) ) (PUTPROPS READAIS COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1827 40089 (24BITCOLORTO8BITMAP 1837 . 3843) (AISBLT 3845 . 10524) (AISBLT1TO1 10526 . -11817) (AISBLT8TO4MODUL 11819 . 13524) (AISBLT8TOLESSFSA 13526 . 15610) (AISBLT8TO4TRUNC 15612 . 16848 -) (AISBLT8TO8 16850 . 19104) (AISBLT4TO4 19106 . 21591) (AISBLT8TO4LESSFSA 21593 . 23620) ( -AISBLT8TO1FSA 23622 . 26181) (AISBLT8TO1TRUNC 26183 . 27872) (CLOSEST.COLOR 27874 . 28236) ( -GRAPHAISHISTOGRAM 28238 . 28847) (AISHISTOGRAM 28849 . 30585) (SMOOTHEDFILTER 30587 . 31648) ( -SLOW.COLOR.DISTANCE 31650 . 31948) (FAST.COLOR.DISTANCE 31950 . 32242) (INSUREAISFILE 32244 . 33441) ( -SHOWCOLORAIS 33443 . 35628) (SHOWCOLORAIS1 35630 . 37166) (WRITEAIS 37168 . 39031) (WRITEAIS1 39033 . -39353) (\GETBASENYBBLE 39355 . 39642) (\PUTBASENYBBLE 39644 . 40087))))) + (FILEMAP (NIL (1582 41465 (24BITCOLORTO8BITMAP 1592 . 3598) (AISBLT 3600 . 10279) (AISBLT1TO1 10281 . +11572) (AISBLT8TO4MODUL 11574 . 13279) (AISBLT8TOLESSFSA 13281 . 15365) (AISBLT8TO4TRUNC 15367 . 16603 +) (AISBLT8TO8 16605 . 18859) (AISBLT4TO4 18861 . 21346) (AISBLT8TO4LESSFSA 21348 . 23375) ( +AISBLT8TO1FSA 23377 . 25936) (AISBLT8TO1TRUNC 25938 . 27627) (CLOSEST.COLOR 27629 . 27991) ( +GRAPHAISHISTOGRAM 27993 . 28602) (AISHISTOGRAM 28604 . 31961) (SMOOTHEDFILTER 31963 . 33024) ( +SLOW.COLOR.DISTANCE 33026 . 33324) (FAST.COLOR.DISTANCE 33326 . 33618) (INSUREAISFILE 33620 . 34817) ( +SHOWCOLORAIS 34819 . 37004) (SHOWCOLORAIS1 37006 . 38542) (WRITEAIS 38544 . 40407) (WRITEAIS1 40409 . +40729) (\GETBASENYBBLE 40731 . 41018) (\PUTBASENYBBLE 41020 . 41463))))) STOP diff --git a/lispusers/READAIS.LCOM b/lispusers/READAIS.LCOM index 78920ee10ced1db800733135b068c8e7bc4058df..1f558c6f3717630873239bcd53869b8001572454 100644 GIT binary patch delta 1617 zcmah|U2Icj7*5B4d0STTy6%miC->{Q)=1dfFb=p3|Ol+ODJjYdg!pl?@Z3 zz+7U`s0q{88x1kKJMc!GiHTk~e_~>yG7X90LNxJ$3$`%45|!xt78Oj0o{Q)G`QGn& z|Gx9>cZTbi4YT2CjbeNgNJUVf#Q9oL( zu!+Z+nLU+`iNUCtIlcdAeX8-qRCRKy9~puHNwe?ct&B7C!d)I-@H+*+%VTEc$?88u z)sv0Msp&`j3@=3_O;^HdAjaxQA4*1}>|O%9-EL-;(g{p|KW4YfZ2jLh9KQRNE#F%= z>l2)=KIRvLl5RVgVUx$knSU@6ki(*8(-me3$r|^sa;?lCSH+a1BsE(Q2l%qVwC%q} z+>@iCuu9`kI z%=>n}NGG3Ld5XJbTQ(RtxVHBi8kZamG7j*+8RlTW&F}|^sG^A>=5?`vss=L5)5pZ& zxX$`KEPVGCvP!a+#OEMs#Dsa65*H(~rlT*$oE{dE6*O zqDrEMhgMFDDT*EuDOwj*<_~(g`7hk>Qj6{09WduP($r?K^K)K}hVqlYiw1jZ;3XQ@ z3xl7a06F{(B8$`zpN-5R?vf58o|USIOHu_facBh5(UO4MhdNO+4pGFhp#tJpLpq{q zd=JP`H)_vB%ZMj+x*dxV>w8UHOm2fOi(#~9Q*O9XT?;GfX1FXH(Q`8!hDMD8kJ5!! zK4(F#9WH7e@QTudo_Caf#1)0uruF=q>_JIp9DEojhdD8dcs4=$auW?D2Crk13+g)b z{g6t+g0{Yu{ylg|qw4-B^}=j=9bC}7Xnm~gY~!uX4_niT=T7-o^&;v6Nor-L=!0U_ z2se^c(E1dO<#?*RhLhsaqz19ncKAI-Z0oKNQve@!1i+&5g>z}?xfmANnv2N#Da z$e1Z1PG#bVpJk{E%LtA1xe+Sz`bZja@GwPQY@#tsF*B)Pb9@U~V=I>pi!hVxhUM%K z9-YcHD}ZsJFFIys|mX%-kSwZnycH%yee z);6bv^IwvOpr_o`$}IEEa1VX@E#rz&>5{Z@tYznRzvvFZ-gzAkFG%#EnM zA#a5%W9#7;wF7RCQ8xp%zqfg&wh`aUX7q1_O!+~&mlLRW)F#Ggjf-Q%TTDCPOsx|h zEtt_NDVyMU88M_D+_^ ziv>Edk2>g~klAyjeY`w9nV*;{b|9IVE>2B%K$4KGnw~b^MTtX@+|ilwN-AGKkOE?> zgXS>P`1S%VL!x-GFg{y+k_uk8JX69zkH_Png^>gBlH-Aw=K`D%5d99M2t(%#OGciYWvCDvyd1?-gl&Y{a{-RGg*_jA7cRxt7G%==_X16I*c0JNlOU$^Y zSrH`!%36v+nW84^NS~ov3Z$p^2~XL)N@sgz!=(3=3uo z6*-PjM z*Qa3ERplGN54uMIY4{Z2h43KYmPirs*+>EKdL#{~sL1El!7Ac`PCN;ATdiX>s;nj+ z++ucktbsij6(Q(Mc_+IX^#W_`$pP9;O!jjRJ`#^1-pDtxSM_b|`0g!mx~qGc9`^t{ zU)aFj801+)Z#DZmz8*Zshn=h@(FQD<=m0#L!264dJm8I>jJ^Lcr1MGIZkqz~F*_g2wPKOMvVcx(DOEo`X z4g>$LQvWCUD0{)$Tun02ewS=26dv2iKDUApQk}v^_oguXtJG)}p#oJ5gWVb2#_lH9 zu)V!o;S1~S1iaWgQbU#&!9_)v%SBkQ58s^c8v$I?uLBPCV>jpfcLO#JVDe`M`T)Nl zz{p@4@k-uZQSnZ?7EX(Lh;c(}tMpjPq)x)PYycaNBu|vmD^vy+Lm^y zX0Ei3?I@y1IPgD5>tG%m*y%zo>&ZR}UfW2By_;zQ_GLzdQg#9>k75Eo$IX>+liwWP zI9IA=*%GeeU%7gAw&VkLt%Onf7~Y*48?_S}*Ftf*-{qnlOcq9aZ4BE?luf`>kaplan>Local>medley3.5>git-medley>lispusers>READINTERPRESS.;4 10412 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS PRINTSEQUENCE) +(FILECREATED "24-Sep-2023 13:52:48" {WMEDLEY}READINTERPRESS.;6 11350 - previous date%: "22-Jun-2021 10:35:30" -{DSK}kaplan>Local>medley3.5>git-medley>lispusers>READINTERPRESS.;3) + :EDIT-BY rmk + + :CHANGES-TO (FNS SHOWFILE) + + :PREVIOUS-DATE "22-Jun-2021 10:52:34" {WMEDLEY}READINTERPRESS.;4) (* ; " @@ -122,8 +123,53 @@ Copyright (c) 1983-1986, 1988, 2021 by Xerox Corporation. ) (SHOWFILE -(LAMBDA (IPFILE OUTPUTFILE MAXZEROLINES) (* rmk%: "16-Jun-84 15:29") (OR MAXZEROLINES (SETQ MAXZEROLINES 5)) (RESETLST (PROG (STREAM) (RESETSAVE (SETQ STREAM (OPENFILE IPFILE (QUOTE INPUT))) (QUOTE (PROGN (CLOSEF? OLDVALUE)))) (SETQ STREAM (GETSTREAM STREAM)) (* Don't do an OPENSTREAM until (OPENP stream) is NIL if stream is closed.) (RESETSAVE (OUTPUT)) (RESETSAVE (SETQ OUTPUTFILE (OPENFILE OUTPUTFILE (QUOTE OUTPUT))) (QUOTE (PROGN (CLOSEF? OLDVALUE) (AND RESETSTATE (DELFILE OLDVALUE))))) (OUTPUT OUTPUTFILE) (printout NIL .FONT DEFAULTFONT (OPENP STREAM (QUOTE INPUT)) T T) (for I B1 B2 B3 B4 B5 B6 B7 B8 (NZEROLINES _ 0) from 1 by 8 until (\EOFP STREAM) do (printout NIL |.I5| I %,,) (SETQ B1 (SHOWBYTE STREAM)) (SETQ B2 (SHOWBYTE STREAM)) (SETQ B3 (SHOWBYTE STREAM)) (SETQ B4 (SHOWBYTE STREAM)) (printout NIL %,,) (SETQ B5 (SHOWBYTE STREAM)) (SETQ B6 (SHOWBYTE STREAM)) (SETQ B7 (SHOWBYTE STREAM)) (SETQ B8 (SHOWBYTE STREAM)) (TAB 23) (COND (B1 (printout NIL |.I4| B1))) (COND (B2 (printout NIL |.I4| B2))) (COND (B3 (printout NIL |.I4| B3))) (COND (B4 (printout NIL |.I4| B4))) (printout NIL %,,) (COND (B5 (printout NIL |.I4| B5))) (COND (B6 (printout NIL |.I4| B6))) (COND (B7 (printout NIL |.I4| B7))) (COND (B8 (printout NIL |.I4| B8 T)))) (RETURN (LIST (CLOSEF IPFILE) (CLOSEF OUTPUTFILE)))))) -) + [LAMBDA (IPFILE OUTPUTFILE MAXZEROLINES) (* ; "Edited 24-Sep-2023 13:52 by rmk") + (* rmk%: "16-Jun-84 15:29") + (OR MAXZEROLINES (SETQ MAXZEROLINES 5)) + (RESETLST + [PROG (STREAM) + [RESETSAVE (SETQ STREAM (OPENSTREAM IPFILE 'INPUT)) + '(PROGN (CLOSEF? OLDVALUE] (* Don't do an OPENSTREAM until + (OPENP stream) is NIL if stream is + closed.) + (RESETSAVE (OUTPUT)) + [RESETSAVE (SETQ OUTPUTFILE (OPENSTREAM OUTPUTFILE 'OUTPUT)) + '(PROGN (CLOSEF? OLDVALUE) + (AND RESETSTATE (DELFILE OLDVALUE] + (OUTPUT OUTPUTFILE) + (printout NIL .FONT DEFAULTFONT (OPENP STREAM 'INPUT) + T T) + [for I B1 B2 B3 B4 B5 B6 B7 B8 (NZEROLINES _ 0) from 1 by 8 until (\EOFP STREAM) + do (printout NIL .I5 I %,,) + (SETQ B1 (SHOWBYTE STREAM)) + (SETQ B2 (SHOWBYTE STREAM)) + (SETQ B3 (SHOWBYTE STREAM)) + (SETQ B4 (SHOWBYTE STREAM)) + (printout NIL %,,) + (SETQ B5 (SHOWBYTE STREAM)) + (SETQ B6 (SHOWBYTE STREAM)) + (SETQ B7 (SHOWBYTE STREAM)) + (SETQ B8 (SHOWBYTE STREAM)) + (TAB 23) + (COND + (B1 (printout NIL .I4 B1))) + (COND + (B2 (printout NIL .I4 B2))) + (COND + (B3 (printout NIL .I4 B3))) + (COND + (B4 (printout NIL .I4 B4))) + (printout NIL %,,) + (COND + (B5 (printout NIL .I4 B5))) + (COND + (B6 (printout NIL .I4 B6))) + (COND + (B7 (printout NIL .I4 B7))) + (COND + (B8 (printout NIL .I4 B8 T] + (RETURN (LIST (CLOSEF IPFILE) + (CLOSEF OUTPUTFILE])]) (SHOWBYTE (LAMBDA (STREAM) (* rmk%: "13-JUL-82 18:01") (PROG ((BYTE (COND ((NOT (\EOFP STREAM)) (\BIN STREAM))))) (COND (BYTE (PRIN1 (COND ((AND (IGEQ BYTE (CHARCODE SPACE)) (ILESSP BYTE (CHARCODE DEL)) (NEQ BYTE 96)) (CHARACTER BYTE)) (T (QUOTE %.)))))) (RETURN BYTE))) @@ -132,14 +178,14 @@ Copyright (c) 1983-1986, 1988, 2021 by Xerox Corporation. (DECLARE%: EVAL@COMPILE (PUTPROPS BIN.RIP MACRO [ARGS (LET ((ISTREAM (CAR ARGS)) - (OSTREAM (CADR ARGS))) - `(LET [(C (BIN ,ISTREAM] - (COND - ((IGREATERP (POSITION ,OSTREAM) - 15) - (printout ,OSTREAM 5 "|" 8))) - (printout ,OSTREAM .I3 C " ") - C]) + (OSTREAM (CADR ARGS))) + `(LET [(C (BIN ,ISTREAM] + (COND + ((IGREATERP (POSITION ,OSTREAM) + 15) + (printout ,OSTREAM 5 "|" 8))) + (printout ,OSTREAM .I3 C " ") + C]) ) (DECLARE%: EVAL@COMPILE DONTCOPY @@ -156,8 +202,9 @@ Copyright (c) 1983-1986, 1988, 2021 by Xerox Corporation. ) (PUTPROPS READINTERPRESS COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986 1988 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1210 1896 (PRINTMASTER 1220 . 1894)) (1897 9430 (OPCODE 1907 . 2032) (TOKEN 2034 . 2606 -) (FINDNONPRIMNAME 2608 . 2713) (FINDOPNAME 2715 . 2972) (SHORTINT 2974 . 3167) (TOKENFORMAT 3169 . -3411) (FINDSEQUENCETYPE 3413 . 3617) (PRINTTOKEN 3619 . 4570) (PRINTSEQUENCE 4572 . 7449) ( -SEARCHIPLIST 7451 . 7583) (READINT.IP 7585 . 7824) (SHOWFILE 7826 . 9150) (SHOWBYTE 9152 . 9428))))) + (FILEMAP (NIL (1158 1844 (PRINTMASTER 1168 . 1842)) (1845 10432 (OPCODE 1855 . 1980) (TOKEN 1982 . +2554) (FINDNONPRIMNAME 2556 . 2661) (FINDOPNAME 2663 . 2920) (SHORTINT 2922 . 3115) (TOKENFORMAT 3117 + . 3359) (FINDSEQUENCETYPE 3361 . 3565) (PRINTTOKEN 3567 . 4518) (PRINTSEQUENCE 4520 . 7397) ( +SEARCHIPLIST 7399 . 7531) (READINT.IP 7533 . 7772) (SHOWFILE 7774 . 10152) (SHOWBYTE 10154 . 10430)))) +) STOP diff --git a/lispusers/READINTERPRESS.LCOM b/lispusers/READINTERPRESS.LCOM index c9323e9b662b1c93df98a8a9e6d5cb7b8783ad0c..06b8e147b22f078d25dbf3e2f9c980d34635a4c1 100644 GIT binary patch delta 1006 zcmZuvy^hmB5LO~++|j`m$7H1oaZV22_4-#J-84?>{?ksrf$ z;`Sc8djd!hWnvHpX+l2UxYh5vsQ{|VlGG|5_Xfhvga?FiC7nzarZNqv=IG4f7J(Ld zdUiTJc`-SLvzI{N-FRPkp*VPdFW;_j%?%kO!n6&OX%3RPN#JNUDXEh;)7h&X2hx5# zE|S6tYWc%3getew=@2+Re2uxT64g18|En3UF8Xqj4-BAG(^YVU7i3EJ0A{DpL2`P1 zH`)`alEu*SqqHne1}7PaQ4kMP#lzm@_iHz$%aV02E$sT2+jYwF-;J-e&-o|PSbQgW zZBA{#ZYP5PIAwrmltsgR&}?3DOtaz`YQ^Ciq&PT{f~Hj&D7(>8D-mW@BFywSWNsIj z!I%H(9%KTTu2&pxR2}h8Y<8^1(dKa5J%S);fSKD445z+yu&1@I5iY zZN&;#uWb{8XsM#EX&AgvrhFAdE^zE2?*Aj;GNv##*sxbPDgrv&1em$OIN3FsVagKY zFV>jijF(uKCD66}S92?Wd(Bw}w!j!;CJj2lzeNo%`lcbL?ah%||k6oC-R zf)79_pHhKXAn^li5#ks42PCfZa1DY5%;M_YnLB6BJu~xd?{iyG>cX;Jk+*C|H-qx#o!8jU?D^J5=FYH&GK_~20j-$g~^nw-i%29WcUu2cped+3y ztH@5y*eNS>vrIK)do+p?{^ev zES2V-O6>Hj^#0}=)n;$jKS=Lp4SD@SZ|RphcQWbe2ju zPbJJ)olR*enV)^Sm7gvo5i@l#F?6UoO;1=rilqcnbJahgG=W5)%a32U3C)&pTVNVc zYgFA$VKrSJN;n<(t-uF^&I{r{0$g9rPJOfkHihr`_-(cUosCK28hmkt8(`JN9uSW1 zEh{t*wj1-Iy-Q|XT_Unv#Lak31fP+;5BOb}$R diff --git a/lispusers/SHOWTIME b/lispusers/SHOWTIME index 601f12ea..fc797fd5 100644 --- a/lispusers/SHOWTIME +++ b/lispusers/SHOWTIME @@ -1,18 +1,48 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "10-Apr-89 18:56:29" {ERINYES}MEDLEY>SHOWTIME.;1 24672 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS SHOWTIME.READ.LISPBM) +(FILECREATED "24-Sep-2023 14:29:56" {WMEDLEY}SHOWTIME.;2 26541 - previous date%: "13-May-88 16:31:25" {POOH/N}LISP>MEDLEY>LISPUSERS>SHOWTIME;1) + :EDIT-BY rmk + + :CHANGES-TO (VARS SHOWTIMECOMS SHOWTIME.ICON SHOWTIME.MASK) + (FNS INFORES SHOWTIME.READ.PRESS) + + :PREVIOUS-DATE "10-Apr-89 18:56:29" {WMEDLEY}SHOWTIME.;1) -(* " -Copyright (c) 1986, 1987, 1988, 1989 by Xerox Corporation. All rights reserved. +(* ; " +Copyright (c) 1986-1989 by Xerox Corporation. ") (PRETTYCOMPRINT SHOWTIMECOMS) -(RPAQQ SHOWTIMECOMS ((* ;;; "Mitch Gaarnat and (Mike?) Gocek wrote the original versions of these fns in 1985. They were later modified added to by T. Bigham in 1986 and 1987. Ron Fischer at Xerox AI Systems made a quick pass to convert the file to run in Medley XAIE.") (FNS GET.SHOWTIME.MENU MAKEBRUSH MAKEBRUSH.HEADER&BITMAP INFORES READ.RES SHOWTIME SHOWTIME.BUTTONEVENTFN SHOWTIME.GET.NAME SHOWTIME.ICONFN SHOWTIME.LOAD.BITMAP SHOWTIME.LOAD.BRUSH SHOWTIME.LOAD.DIF.FILE SHOWTIME.LOAD.RES.FILE SHOWTIME.MAKE.RES SHOWTIME.MAKE.RES.HEADER SHOWTIME.MAKE.RES.TAIL SHOWTIME.READ.BRUSH SHOWTIME.READ.LISPBM SHOWTIME.READ.PRESS SHOWTIME.READ.RES SHOWTIME.RES.CHECK&MASSAGE SHOWTIME.RESHAPE.WINDOW SHOWTIME.SAVE.BITMAP SHOWTIME.SAVE.LISPBM SHOWTIME.SCALE.BITMAP SHOWTIME.ADD.FORMAT SHOWTIME.SETUP.WINDOWPROPS SHOWTIME.SHOW.BITMAP SHOWTIME.WRITEBM) (VARS SHOWTIME.ICON SHOWTIME.MASK (SHOWTIME.LOAD.SUBITEMS) (SHOWTIME.SAVE.SUBITEMS) (SHOWTIME.MENU) (SHOWTIMETITLEREGION (QUOTE (7 7 56 29))) (SHOWTIME.DEFAULT.FORMAT (QUOTE LISP)) (BackgroundMenu) (SHOWTIME.FORMAT.FNS (QUOTE (SHOWTIME.FORMAT.FNS (RES READ.RES SHOWTIME.MAKE.RES) (LISP SHOWTIME.READ.LISPBM SHOWTIME.SAVE.LISPBM) (DIF SHOWTIME.LOAD.DIF.FILE NIL) (BRUSH SHOWTIME.LOAD.BRUSH MAKEBRUSH) (PRESS READPRESS PRESSBITMAP))))) (APPENDVARS (BackgroundMenuCommands (Showtime (QUOTE (SHOWTIME)) "Opens a showtime window for use."))) (FILES BITMAPFNS SCALEBITMAP READBRUSH) (P (SHOWTIME.ADD.FORMAT)))) +(RPAQQ SHOWTIMECOMS + ( + +(* ;;; "Mitch Gaarnat and (Mike?) Gocek wrote the original versions of these fns in 1985. They were later modified added to by T. Bigham in 1986 and 1987. Ron Fischer at Xerox AI Systems made a quick pass to convert the file to run in Medley XAIE.") + + (FNS GET.SHOWTIME.MENU MAKEBRUSH MAKEBRUSH.HEADER&BITMAP INFORES READ.RES SHOWTIME + SHOWTIME.BUTTONEVENTFN SHOWTIME.GET.NAME SHOWTIME.ICONFN SHOWTIME.LOAD.BITMAP + SHOWTIME.LOAD.BRUSH SHOWTIME.LOAD.DIF.FILE SHOWTIME.LOAD.RES.FILE SHOWTIME.MAKE.RES + SHOWTIME.MAKE.RES.HEADER SHOWTIME.MAKE.RES.TAIL SHOWTIME.READ.BRUSH SHOWTIME.READ.LISPBM + SHOWTIME.READ.PRESS SHOWTIME.READ.RES SHOWTIME.RES.CHECK&MASSAGE SHOWTIME.RESHAPE.WINDOW + SHOWTIME.SAVE.BITMAP SHOWTIME.SAVE.LISPBM SHOWTIME.SCALE.BITMAP SHOWTIME.ADD.FORMAT + SHOWTIME.SETUP.WINDOWPROPS SHOWTIME.SHOW.BITMAP SHOWTIME.WRITEBM) + [VARS SHOWTIME.ICON SHOWTIME.MASK (SHOWTIME.LOAD.SUBITEMS) + (SHOWTIME.SAVE.SUBITEMS) + (SHOWTIME.MENU) + (SHOWTIMETITLEREGION '(7 7 56 29)) + (SHOWTIME.DEFAULT.FORMAT 'LISP) + (BackgroundMenu) + (SHOWTIME.FORMAT.FNS '(SHOWTIME.FORMAT.FNS (RES READ.RES SHOWTIME.MAKE.RES) + (LISP SHOWTIME.READ.LISPBM SHOWTIME.SAVE.LISPBM) + (DIF SHOWTIME.LOAD.DIF.FILE NIL) + (BRUSH SHOWTIME.LOAD.BRUSH MAKEBRUSH) + (PRESS READPRESS PRESSBITMAP] + (APPENDVARS (BackgroundMenuCommands (Showtime '(SHOWTIME) + "Opens a showtime window for use."))) + (FILES BITMAPFNS SCALEBITMAP READBRUSH) + (P (SHOWTIME.ADD.FORMAT)))) @@ -35,8 +65,35 @@ Copyright (c) 1986, 1987, 1988, 1989 by Xerox Corporation. All rights reserved. ) (INFORES -(LAMBDA (FILE) (* ; "Edited 13-May-88 16:01 by raf") (LET (STREAM PATTERN WIDTH HEIGHT HI.X LO.X HI.Y LO.Y REAL.X REAL.Y (Header (QUOTE Interpress/Xerox/2.1/RasterEncoding/1.0% ))) (* ; "Return the width, height, bits per pixel and address of the first data byte as a list.") (SETQ STREAM (GETSTREAM (OPENFILE FILE (QUOTE INPUT)) (QUOTE INPUT))) (if (EQ Header (PACK (for X from 1 to 40 collect (CHARACTER (\BIN STREAM))))) then (* ; "bypass BEGIN 254/720000 DUP 2 MAKEVEC") (until (EQUAL (NTH (REVERSE PATTERN) (IDIFFERENCE (LENGTH PATTERN) 4)) (QUOTE (181 15 162 161 27))) do (SETQ PATTERN (push PATTERN (\BIN STREAM)))) (SETQ HI.X (\BIN STREAM)) (SETQ LO.X (\BIN STREAM)) (SETQ HI.Y (\BIN STREAM)) (SETQ LO.Y (\BIN STREAM)) (SETQ REAL.X (IDIFFERENCE (PLUS (LSH HI.X 8) LO.X) 4000)) (SETQ REAL.Y (IDIFFERENCE (PLUS (LSH HI.Y 8) LO.Y) 4000)) (LIST REAL.X REAL.Y STREAM) else (CLOSEF STREAM) NIL))) -) + [LAMBDA (FILE) (* ; "Edited 24-Sep-2023 14:28 by rmk") + (* ; "Edited 13-May-88 16:01 by raf") + (LET (STREAM PATTERN WIDTH HEIGHT HI.X LO.X HI.Y LO.Y REAL.X REAL.Y (Header + ' + Interpress/Xerox/2.1/RasterEncoding/1.0% + )) + (* ; + "Return the width, height, bits per pixel and address of the first data byte as a list.") + (SETQ STREAM (OPENSTREAM FILE 'INPUT)) + (if [EQ Header (PACK (for X from 1 to 40 collect (CHARACTER (\BIN STREAM] + then (* ; + "bypass BEGIN 254/720000 DUP 2 MAKEVEC") + [until (EQUAL (NTH (REVERSE PATTERN) + (IDIFFERENCE (LENGTH PATTERN) + 4)) + '(181 15 162 161 27)) do (SETQ PATTERN (push PATTERN (\BIN STREAM] + (SETQ HI.X (\BIN STREAM)) + (SETQ LO.X (\BIN STREAM)) + (SETQ HI.Y (\BIN STREAM)) + (SETQ LO.Y (\BIN STREAM)) + (SETQ REAL.X (IDIFFERENCE (PLUS (LSH HI.X 8) + LO.X) + 4000)) + (SETQ REAL.Y (IDIFFERENCE (PLUS (LSH HI.Y 8) + LO.Y) + 4000)) + (LIST REAL.X REAL.Y STREAM) + else (CLOSEF STREAM) + NIL]) (READ.RES (LAMBDA (FILE) (* ; "Edited 13-May-88 16:02 by raf") (LET (STREAM A B BITMAP BASE WORDS Attributes WIDTH HEIGHT) (if (SETQ FILE (FULLNAME FILE)) then (* ; "If the file exists, check to see if it's RES format.") (if (SETQ Attributes (INFORES FILE)) then (SETQ WIDTH (CAR Attributes)) (SETQ HEIGHT (CADR Attributes)) (SETQ STREAM (CADDR Attributes)) (SETQ BITMAP (BITMAPCREATE WIDTH HEIGHT 1)) (SETQ BASE (fetch (BITMAP BITMAPBASE) of BITMAP)) (* ; "RESINFO leaves the file open at byte 62.0 Image data begins at byte 95") (for X from 63 to 94 do (\BIN STREAM)) (for X from 1 to (IQUOTIENT (ITIMES WIDTH HEIGHT) 16) do (SETQ A (\BIN STREAM)) (SETQ B (\BIN STREAM)) (\PUTBASE BASE 0 (LOGOR (LLSH A 8) B)) (SETQ BASE (\ADDBASE BASE 1)) (ZEROP (LOGAND X 1023))) (CLOSEF STREAM) BITMAP else (printout PROMPTWINDOW T FILE "isn't an RES file")) else (printout PROMPTWINDOW T "Can't find " FILE) NIL))) @@ -93,7 +150,9 @@ Copyright (c) 1986, 1987, 1988, 1989 by Xerox Corporation. All rights reserved. ) (SHOWTIME.READ.PRESS -(LAMBDA (FILENAME) (* TBigham "30-Dec-86 11:59") (READPRESS (OPENFILE FILENAME (QUOTE INPUT))))) + [LAMBDA (FILENAME) (* ; "Edited 24-Sep-2023 14:29 by rmk") + (* TBigham "30-Dec-86 11:59") + (READPRESS FILENAME]) (SHOWTIME.READ.RES (LAMBDA (FILENAME) (* TBigham "30-Dec-86 12:03") (* load an RES image and makes it into a lisp bitmap) (DECLARE (GLOBALVARS WAITINGCURSOR)) (LET (BITMAP) (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) (SETQ BITMAP (READ.RES FILENAME))))) @@ -136,41 +195,48 @@ Copyright (c) 1986, 1987, 1988, 1989 by Xerox Corporation. All rights reserved. ) ) -(RPAQQ SHOWTIME.ICON #*(80 84)@C@@@@@@@@@@@@@@@@@@@CO@@@@@@@@@@@@@@@@@@COO@@@@@@@@@@@@@@@@@CMOO@@@@@@@@@@@@@@@@GLAOO@@@@@@@@@@@@@@@GL@AOO@@@@@@@@@@@@@@GN@@OOO@@@@@@@@@@@@@GN@@OOOO@@@@@@@@@@@@ON@@GOMOO@@@@@@@@@@@ON@@GOLAOO@@@@@@@@@@OO@@GOL@AOO@@@@@@@@@OO@@GON@@OOO@@@@@@@AOO@@CON@@OOOO@@@@@@AOO@@CON@@GOMOO@@@@@AOOH@CON@@GOLAOO@@@@AOOH@COO@@GOL@AOO@@@AOOH@AOO@@GON@@OOO@@@AOO@AOO@@CON@@OOOO@@@AOOAOO@@CON@@OOMOO@@@AOOOOH@CON@@GOLAO@@@@AOOOH@COO@@GOL@C@@@@@AOOH@AOO@@GON@C@@@@@@AOO@AOO@@GON@G@@@@@@@AOOAOO@@CON@F@@@@@@@@AOOOOH@CON@F@@@@@@@@@AOOOH@COO@F@@@@@@@@@@AOOH@COO@N@@@@@@@@@@@AOO@AOO@L@@@@@@@@@@@@AOOAOO@L@@@@@@@@@@@@@AOOOOHL@@@@@@@@@@@@@@AOOOIL@@@@@@@@@@@@@@@AOOIH@@@@@@@@@@@@@@@@AOIH@@@@@@@@@@@@@@@@@AOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOHGALF@LGLD@DDOND@GHOGKKNMOFONMKFNGLNOGHOGOKNMOFNNOKNNCHNOOHOGOKNMOFFLOKNNKJNOOHOHGH@MOGFMOKNNIBN@OHOOKKNMOGFMOKNNMFNOOHOOKKNMOG@AOKNNLFNOOHOGKKNMOGKKOKNNNNNOGHOHGALF@OKKOALDGLD@GHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOH) - -(RPAQQ SHOWTIME.MASK #*(80 84)@C@@@@@@@@@@@@@@@@@@@CO@@@@@@@@@@@@@@@@@@COO@@@@@@@@@@@@@@@@@COOO@@@@@@@@@@@@@@@@GOOOO@@@@@@@@@@@@@@@GOOOOO@@@@@@@@@@@@@@GOOOOOO@@@@@@@@@@@@@GOOOOOOO@@@@@@@@@@@@OOOOOOOOO@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@OOOOOOOOOOO@@@@@@@@@OOOOOOOOOOOO@@@@@@@AOOOOOOOOOOOOO@@@@@@AOOOOOOOOOOOOOO@@@@@AOOOOOOOOOOOOOOO@@@@AOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOO@@@@AOOOOOOOOOOOOOOO@@@@@AOOOOOOOOOOOOOO@@@@@@AOOOOOOOOOOOOO@@@@@@@AOOOOOOOOOOON@@@@@@@@AOOOOOOOOOON@@@@@@@@@AOOOOOOOOON@@@@@@@@@@AOOOOOOOON@@@@@@@@@@@AOOOOOOOL@@@@@@@@@@@@AOOOOOOL@@@@@@@@@@@@@AOOOOOL@@@@@@@@@@@@@@AOOOOL@@@@@@@@@@@@@@@AOOOH@@@@@@@@@@@@@@@@AOOH@@@@@@@@@@@@@@@@@AOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOH) - -(RPAQQ SHOWTIME.LOAD.SUBITEMS NIL) - -(RPAQQ SHOWTIME.SAVE.SUBITEMS NIL) - -(RPAQQ SHOWTIME.MENU NIL) - -(RPAQQ SHOWTIMETITLEREGION (7 7 56 29)) - -(RPAQQ SHOWTIME.DEFAULT.FORMAT LISP) - -(RPAQQ BackgroundMenu NIL) - -(RPAQQ SHOWTIME.FORMAT.FNS (SHOWTIME.FORMAT.FNS (RES READ.RES SHOWTIME.MAKE.RES) (LISP SHOWTIME.READ.LISPBM SHOWTIME.SAVE.LISPBM) (DIF SHOWTIME.LOAD.DIF.FILE NIL) (BRUSH SHOWTIME.LOAD.BRUSH MAKEBRUSH) (PRESS READPRESS PRESSBITMAP))) - -(APPENDTOVAR BackgroundMenuCommands (Showtime (QUOTE (SHOWTIME)) "Opens a showtime window for use.") +(RPAQQ SHOWTIME.ICON #*(80 84)@C@@@@@@@@@@@@@@@@@@@CO@@@@@@@@@@@@@@@@@@COO@@@@@@@@@@@@@@@@@CMOO@@@@@@@@@@@@@@@@GLAOO@@@@@@@@@@@@@@@GL@AOO@@@@@@@@@@@@@@GN@@OOO@@@@@@@@@@@@@GN@@OOOO@@@@@@@@@@@@ON@@GOMOO@@@@@@@@@@@ON@@GOLAOO@@@@@@@@@@OO@@GOL@AOO@@@@@@@@@OO@@GON@@OOO@@@@@@@AOO@@CON@@OOOO@@@@@@AOO@@CON@@GOMOO@@@@@AOOH@CON@@GOLAOO@@@@AOOH@COO@@GOL@AOO@@@AOOH@AOO@@GON@@OOO@@@AOO@AOO@@CON@@OOOO@@@AOOAOO@@CON@@OOMOO@@@AOOOOH@CON@@GOLAO@@@@AOOOH@COO@@GOL@C@@@@@AOOH@AOO@@GON@C@@@@@@AOO@AOO@@GON@G@@@@@@@AOOAOO@@CON@F@@@@@@@@AOOOOH@CON@F@@@@@@@@@AOOOH@COO@F@@@@@@@@@@AOOH@COO@N@@@@@@@@@@@AOO@AOO@L@@@@@@@@@@@@AOOAOO@L@@@@@@@@@@@@@AOOOOHL@@@@@@@@@@@@@@AOOOIL@@@@@@@@@@@@@@@AOOIH@@@@@@@@@@@@@@@@AOIH@@@@@@@@@@@@@@@@@AOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOHGALF@LGLD@DDOND@GHOGKKNMOFONMKFNGLNOGHOGOKNMOFNNOKNNCHNOOHOGOKNMOFFLOKNNKJNOOHOHGH@MOGFMOKNNIBN@OHOOKKNMOGFMOKNNMFNOOHOOKKNMOG@AOKNNLFNOOHOGKKNMOGKKOKNNNNNOGHOHGALF@OKKOALDGLD@GHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHL@@@@@@@@@@@@@@@@@AHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOH ) +(RPAQQ SHOWTIME.MASK #*(80 84)@C@@@@@@@@@@@@@@@@@@@CO@@@@@@@@@@@@@@@@@@COO@@@@@@@@@@@@@@@@@COOO@@@@@@@@@@@@@@@@GOOOO@@@@@@@@@@@@@@@GOOOOO@@@@@@@@@@@@@@GOOOOOO@@@@@@@@@@@@@GOOOOOOO@@@@@@@@@@@@OOOOOOOOO@@@@@@@@@@@OOOOOOOOOO@@@@@@@@@@OOOOOOOOOOO@@@@@@@@@OOOOOOOOOOOO@@@@@@@AOOOOOOOOOOOOO@@@@@@AOOOOOOOOOOOOOO@@@@@AOOOOOOOOOOOOOOO@@@@AOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOOO@@@AOOOOOOOOOOOOOOOO@@@@AOOOOOOOOOOOOOOO@@@@@AOOOOOOOOOOOOOO@@@@@@AOOOOOOOOOOOOO@@@@@@@AOOOOOOOOOOON@@@@@@@@AOOOOOOOOOON@@@@@@@@@AOOOOOOOOON@@@@@@@@@@AOOOOOOOON@@@@@@@@@@@AOOOOOOOL@@@@@@@@@@@@AOOOOOOL@@@@@@@@@@@@@AOOOOOL@@@@@@@@@@@@@@AOOOOL@@@@@@@@@@@@@@@AOOOH@@@@@@@@@@@@@@@@AOOH@@@@@@@@@@@@@@@@@AOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOHOOOOOOOOOOOOOOOOOOOH +) + +(RPAQQ SHOWTIME.LOAD.SUBITEMS NIL) + +(RPAQQ SHOWTIME.SAVE.SUBITEMS NIL) + +(RPAQQ SHOWTIME.MENU NIL) + +(RPAQQ SHOWTIMETITLEREGION (7 7 56 29)) + +(RPAQQ SHOWTIME.DEFAULT.FORMAT LISP) + +(RPAQQ BackgroundMenu NIL) + +(RPAQQ SHOWTIME.FORMAT.FNS (SHOWTIME.FORMAT.FNS (RES READ.RES SHOWTIME.MAKE.RES) + (LISP SHOWTIME.READ.LISPBM SHOWTIME.SAVE.LISPBM) + (DIF SHOWTIME.LOAD.DIF.FILE NIL) + (BRUSH SHOWTIME.LOAD.BRUSH MAKEBRUSH) + (PRESS READPRESS PRESSBITMAP))) + +(APPENDTOVAR BackgroundMenuCommands (Showtime '(SHOWTIME) + "Opens a showtime window for use.")) + (FILESLOAD BITMAPFNS SCALEBITMAP READBRUSH) -(SHOWTIME.ADD.FORMAT) +(SHOWTIME.ADD.FORMAT) (PUTPROPS SHOWTIME COPYRIGHT ("Xerox Corporation" 1986 1987 1988 1989)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2126 20535 (GET.SHOWTIME.MENU 2136 . 2931) (MAKEBRUSH 2933 . 3123) ( -MAKEBRUSH.HEADER&BITMAP 3125 . 3863) (INFORES 3865 . 4778) (READ.RES 4780 . 5689) (SHOWTIME 5691 . -6711) (SHOWTIME.BUTTONEVENTFN 6713 . 8306) (SHOWTIME.GET.NAME 8308 . 9067) (SHOWTIME.ICONFN 9069 . -9407) (SHOWTIME.LOAD.BITMAP 9409 . 10592) (SHOWTIME.LOAD.BRUSH 10594 . 10692) (SHOWTIME.LOAD.DIF.FILE -10694 . 11765) (SHOWTIME.LOAD.RES.FILE 11767 . 12032) (SHOWTIME.MAKE.RES 12034 . 12411) ( -SHOWTIME.MAKE.RES.HEADER 12413 . 14913) (SHOWTIME.MAKE.RES.TAIL 14915 . 15214) (SHOWTIME.READ.BRUSH -15216 . 15322) (SHOWTIME.READ.LISPBM 15324 . 15541) (SHOWTIME.READ.PRESS 15543 . 15664) ( -SHOWTIME.READ.RES 15666 . 15926) (SHOWTIME.RES.CHECK&MASSAGE 15928 . 16392) (SHOWTIME.RESHAPE.WINDOW -16394 . 16681) (SHOWTIME.SAVE.BITMAP 16683 . 17478) (SHOWTIME.SAVE.LISPBM 17480 . 17703) ( -SHOWTIME.SCALE.BITMAP 17705 . 18394) (SHOWTIME.ADD.FORMAT 18396 . 19125) (SHOWTIME.SETUP.WINDOWPROPS -19127 . 19376) (SHOWTIME.SHOW.BITMAP 19378 . 19835) (SHOWTIME.WRITEBM 19837 . 20533))))) + (FILEMAP (NIL (2589 22191 (GET.SHOWTIME.MENU 2599 . 3394) (MAKEBRUSH 3396 . 3586) ( +MAKEBRUSH.HEADER&BITMAP 3588 . 4326) (INFORES 4328 . 6301) (READ.RES 6303 . 7212) (SHOWTIME 7214 . +8234) (SHOWTIME.BUTTONEVENTFN 8236 . 9829) (SHOWTIME.GET.NAME 9831 . 10590) (SHOWTIME.ICONFN 10592 . +10930) (SHOWTIME.LOAD.BITMAP 10932 . 12115) (SHOWTIME.LOAD.BRUSH 12117 . 12215) ( +SHOWTIME.LOAD.DIF.FILE 12217 . 13288) (SHOWTIME.LOAD.RES.FILE 13290 . 13555) (SHOWTIME.MAKE.RES 13557 + . 13934) (SHOWTIME.MAKE.RES.HEADER 13936 . 16436) (SHOWTIME.MAKE.RES.TAIL 16438 . 16737) ( +SHOWTIME.READ.BRUSH 16739 . 16845) (SHOWTIME.READ.LISPBM 16847 . 17064) (SHOWTIME.READ.PRESS 17066 . +17320) (SHOWTIME.READ.RES 17322 . 17582) (SHOWTIME.RES.CHECK&MASSAGE 17584 . 18048) ( +SHOWTIME.RESHAPE.WINDOW 18050 . 18337) (SHOWTIME.SAVE.BITMAP 18339 . 19134) (SHOWTIME.SAVE.LISPBM +19136 . 19359) (SHOWTIME.SCALE.BITMAP 19361 . 20050) (SHOWTIME.ADD.FORMAT 20052 . 20781) ( +SHOWTIME.SETUP.WINDOWPROPS 20783 . 21032) (SHOWTIME.SHOW.BITMAP 21034 . 21491) (SHOWTIME.WRITEBM 21493 + . 22189))))) STOP diff --git a/lispusers/SHOWTIME.LCOM b/lispusers/SHOWTIME.LCOM index 7847488ccf9bbd7e884624692ab20e281f872b5b..ccdab5176d9407191fe0a4acfc5deea886fd077b 100644 GIT binary patch delta 1160 zcma)5Piz!b7~cU3>_fLSrCX~AUna85SZA4;{nK^=VW&H9b_Zu>mz~)^HSs{(btRRy zS#2UQDi^q!6rKlSA_fjzFc=s}Ku#JDdNC3pA#k8rFo;VuI>uNn}zHb*9!S8_+c4xd2p#;;+6`?k=Ag_I5d9*NDV4g>IWh2+CvFhGoIT( zB*?SHcrroIYo&27tGuqn>+6sWdFe}}7k$%vs|QIX)DgCrRN1|O&(==oF+4K(3nnw+ z)hDa&NPle(^P_X{6Q89cdU&`hPV%IL`ZHVF)rZ!y`Yk(?GBLE2%3)rVl)mCsmy|fK zx{MQ~KFdrmCvA ze3Tp+++Ml;FTCrH_Oh@JrTE+!U{Cbl(T_7m{n=kRgJm>_@~1iLrBsUD9X+}dciEY- zFR=D4<2r_-KldKs8QT6o@Q^H=nWW6un+zJH?Bvm*UJh($Mr delta 1277 zcmZWnO>7%Q7_}3n)Ky1KBBe$RG@llltXu77cm22C1UDP+*xuH=cD;7(9FWM58zPz5 zit9?Hje?MhK%AoCQ1yZuP!9!)V5OdVfC?dTL~zK7B7Tk>P?1`M6!DFtq!C#1^Y_iX z`R2Xnx#0&NeHj!*i)L+?N?E%=CELvw;bfVbR>hnxP!MdlLdyl)D+!xJBO4JSa#{un z6>5Q?#w4%NmQpcLbt4)#qKW{bu-JN|z0zzfL2DHRxMq3h*Qc8+o%UjDt&!$Mx6@eb zq`iExR#f)$+PG&Yu+jjN!=C9}KCiLxvU zurz-euM(cEs*0g#Ml2=#Ppu-E?KMeHakcS;p`}nAE!*xK_134k$*M=oUfQ8nfzBP& z2U;wV)L>)r_4(E1Mh7mpP8lF(T@T2<3m%%xhs-(=XsH`_`e+cVE{d(N0aQ2 zk$d}lpVQ<=uX}=iD-iY+?#7UGy;KP%rAH# z%McHAFd(8m?x=*0JW!SWNZ41CFQQk^R1`(+c|9QO-JYaB@#23}!Y>X*pCYD5Ek7Ik zy0@Sv{j-Ui+|9QBVQ-In+Ug@B`z)OB-!tCkxgCAw9H-RI{)Wx;%oexw$ow^Ul8EJ! zdEo-=y_`(Z@jw($!_?Fi5cYHCF&_KTsv@4I3y5+(%s!^GSbZ@OW;?VOMD|temEq&; zVb;Rxx!fhh)g0%4pIaOt{K>MR>==8Y9%q}v2;0h+aqoV8hQ;kMtg7}nD!OjpJJe4i z#Ft9D1^elufV;t(F#2DiyHDJ;3lYqtHi4{5wU-g!ubn`=Q>!8F)VPk@`7?-{^# diff --git a/lispusers/UNDIGESTIFY b/lispusers/UNDIGESTIFY index 64d6d31c..1f49658d 100644 --- a/lispusers/UNDIGESTIFY +++ b/lispusers/UNDIGESTIFY @@ -1,25 +1,30 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "29-Jul-87 08:47:18" {PHYLUM}LYRIC>UNDIGESTIFY.;2 16839 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS INSTALL-UNDIGESTIFY) +(FILECREATED "24-Sep-2023 14:26:57" {WMEDLEY}UNDIGESTIFY.;3 17040 - previous date%: "16-May-86 10:55:33" {PHYLUM}LYRIC>UNDIGESTIFY.;1) + :EDIT-BY rmk + + :CHANGES-TO (VARS UNDIGESTIFYCOMS) + (FNS OPEN-SPACE-IN-FILE) + + :PREVIOUS-DATE "29-Jul-87 08:47:18" {WMEDLEY}UNDIGESTIFY.;1) -(* " -Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved. +(* ; " +Copyright (c) 1986-1987 by Xerox Corporation. ") (PRETTYCOMPRINT UNDIGESTIFYCOMS) -(RPAQQ UNDIGESTIFYCOMS ((INITVARS *DELETE-DIGEST-FLAG* *MOVE-TO-FIRST-DIGEST-MESSAGE-FLAG* - *DONT-UPDATE-HEADERS-FLAG* SEPARATOR1 SEPARATOR2) - (FNS INSTALL-UNDIGESTIFY LAFITE-DISPLAY LAFITE-TRUNCATE-FILE - LAFITE-UNDIGESTIFY MOVE-TO-EOL OPEN-SPACE-IN-FILE - PARSE-AND-MAYBE-MERGE-HEADER SKIP-EOLS BACKUP-PTR - TEDIT.FIND.NOT.CASELESS) - (DECLARE%: EVAL@COMPILE DONTCOPY (FILES {ERIS}SOURCES>LAFITEDECLS)) - (P (INSTALL-UNDIGESTIFY)))) +(RPAQQ UNDIGESTIFYCOMS + ((INITVARS *DELETE-DIGEST-FLAG* *MOVE-TO-FIRST-DIGEST-MESSAGE-FLAG* *DONT-UPDATE-HEADERS-FLAG* + SEPARATOR1 SEPARATOR2) + (FNS INSTALL-UNDIGESTIFY LAFITE-DISPLAY LAFITE-TRUNCATE-FILE LAFITE-UNDIGESTIFY MOVE-TO-EOL + OPEN-SPACE-IN-FILE PARSE-AND-MAYBE-MERGE-HEADER SKIP-EOLS BACKUP-PTR + TEDIT.FIND.NOT.CASELESS) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM library/LAFITE) + LAFITEDECLS)) + (P (INSTALL-UNDIGESTIFY)))) (RPAQ? *DELETE-DIGEST-FLAG* NIL) @@ -249,12 +254,16 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved. (GETFILEPTR TEXTSTREAM]) (OPEN-SPACE-IN-FILE - [LAMBDA (FILE POSITION NCHARS) (* SCB%: "25-Mar-86 12:52") - - (* Open a space in file starting at POSITION for length NCHARS by sliding the - rest of the file down.) + [LAMBDA (FILE POSITION NCHARS) (* ; "Edited 24-Sep-2023 14:25 by rmk") + (* SCB%: "25-Mar-86 12:52") - (LET [(TEMP (OPENFILE '{NODIRCORE} 'BOTH] + (* ;; + "Open a space in file starting at POSITION for length NCHARS by sliding the rest of the file down.") + + (* Open a space in file starting at POSITION for length NCHARS by sliding the + rest of the file down.) + + (LET [(TEMP (OPENSTREAM '{NODIRCORE} 'BOTH] (COPYBYTES FILE TEMP POSITION (GETEOFPTR FILE)) (SETFILEPTR FILE (IPLUS POSITION NCHARS)) (SETFILEPTR TEMP 0) @@ -302,13 +311,16 @@ Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved. (TEDIT.FIND TEXTOBJ TARGETSTRING START# END# WILDCARDS?]) ) (DECLARE%: EVAL@COMPILE DONTCOPY -(FILESLOAD {ERIS}SOURCES>LAFITEDECLS) + +(FILESLOAD (FROM library/LAFITE) + LAFITEDECLS) ) -(INSTALL-UNDIGESTIFY) + +(INSTALL-UNDIGESTIFY) (PUTPROPS UNDIGESTIFY COPYRIGHT ("Xerox Corporation" 1986 1987)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1217 16647 (INSTALL-UNDIGESTIFY 1227 . 3240) (LAFITE-DISPLAY 3242 . 3541) ( -LAFITE-TRUNCATE-FILE 3543 . 3954) (LAFITE-UNDIGESTIFY 3956 . 13612) (MOVE-TO-EOL 13614 . 14074) ( -OPEN-SPACE-IN-FILE 14076 . 14578) (PARSE-AND-MAYBE-MERGE-HEADER 14580 . 15800) (SKIP-EOLS 15802 . -16113) (BACKUP-PTR 16115 . 16277) (TEDIT.FIND.NOT.CASELESS 16279 . 16645))))) + (FILEMAP (NIL (1183 16831 (INSTALL-UNDIGESTIFY 1193 . 3206) (LAFITE-DISPLAY 3208 . 3507) ( +LAFITE-TRUNCATE-FILE 3509 . 3920) (LAFITE-UNDIGESTIFY 3922 . 13578) (MOVE-TO-EOL 13580 . 14040) ( +OPEN-SPACE-IN-FILE 14042 . 14762) (PARSE-AND-MAYBE-MERGE-HEADER 14764 . 15984) (SKIP-EOLS 15986 . +16297) (BACKUP-PTR 16299 . 16461) (TEDIT.FIND.NOT.CASELESS 16463 . 16829))))) STOP diff --git a/lispusers/UNDIGESTIFY.LCOM b/lispusers/UNDIGESTIFY.LCOM index 139bcc310022906ac8e57d3debf8b8b1d921604f..c9b599291a5c272affe17264dedccc9ae373f33c 100644 GIT binary patch delta 803 zcma)(U2D@&7{_UCCmgSabzM7O9s_D}kuFIyn*~u%o0Ij-G>J)Csp7?I3l_V!R0YQv z^UfP@M(+h-_X_(0yYpg->=XDUb|ZrLv~@2?FTD9D{Ll09JO8t5{5Eci7PGm_WScuo z=C19*RiBm~&=m#(cOw=!JoJT~*-W`eLk6lM5h9L?O97)1vp~>vIc)W1P0{k8>ZW$v zTq+143eS4${dT9-gkBc}*nCuBmc!~>cXr;UxAPJZLCc>uYI#%5n>sc&2Cb9M)|>v| z+Tm()ACE80?8eC6=b3GSA7%DK9KG)sf1w_vHc;86FG3jM zt5-0uWhi=48FbimJ&Ok=FJN0}OJvy1UP+7zDs%5f1P7^W!=v4Ll0iOS3G$1Pw+4BCWvpNpcW5aKJ)nUo%g8zDc+9oAsM42nv58Ei&{jf&$1I>~S`mIv$)`cpjdae)XcQ#c z=sxbX+I|zd9iT9>#J%x)yEW)Fx_!S87Q=zx9~5ei#qTiT@p3(ROO=68O;_#?+tYSA zL&J_)3cF#q_DU049hlH9zuEQ=K+7oRa4$3_lSvBAoqe1}f2-=6v8Ea6JUts&%TFih zIar$pR&@+m-K^WSt?_!eW=$|x6zsaoOMeH{K+R6{R2~|Sb~=0h0QS4f21sQ`0O5}C zOxsre*hq$6-+$8T4hPe8Xr*da+1fc!^ekY!OvXs1{&%)2{~Qs_N9Je9$#UfN%nS)m z&wWL{pKT-Ms2?M?S>_&7EL_7j>tI+qk%H}oRPZ_a0zHlM$9VbTg~=s6p3facP+M8} zhFo2|5fo$FSiOp!Lioe@Zh0tHyiG{M$f;P|Emd4LMp-7ohxoPGu=&ZG%ZFi*)x|^P zyTx5(eCaLnLIBRARY>BITMAPFNS.;6 6278 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to: (MACROS RPCHK) - (FNS READPRESS) +(FILECREATED "24-Sep-2023 13:54:45" {WMEDLEY}bitmapfns.;2 5976 - previous date: " 2-Jun-86 22:35:15" {ERIS}LIBRARY>BITMAPFNS.;5) + :EDIT-BY rmk + + :CHANGES-TO (FNS READPRESS) + + :PREVIOUS-DATE " 3-Jun-86 14:13:59" {WMEDLEY}bitmapfns.;1) -(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.) +(* ; " +Copyright (c) 1983-1986 by Xerox Corporation. +") (PRETTYCOMPRINT BITMAPFNSCOMS) (RPAQQ BITMAPFNSCOMS ((FNS READBINARYBITMAP WRITEBINARYBITMAP WRITEBM WRITEBMLST READBMLST READBM READPRESS WINDOWBM) - (DECLARE: DONTCOPY (MACROS RPCHK)))) + (DECLARE%: DONTCOPY (MACROS RPCHK)))) (DEFINEQ (READBINARYBITMAP - [LAMBDA (WIDTH HEIGHT FILE) (* lmm " 4-JAN-83 00:19") - (* reads a bitmap from the output file.) - (PROG ((BM (BITMAPCREATE WIDTH HEIGHT))) - (\BINS (GETSTREAM FILE (QUOTE INPUT)) - (fetch BITMAPBASE of BM) - 0 - (ITIMES (fetch BITMAPRASTERWIDTH of BM) - (fetch BITMAPHEIGHT of BM) - 2)) - (RETURN BM]) + [LAMBDA (WIDTH HEIGHT FILE) (* lmm " 4-JAN-83 00:19") + (* reads a bitmap from the output + file.) + (PROG ((BM (BITMAPCREATE WIDTH HEIGHT))) + (\BINS (GETSTREAM FILE 'INPUT) + (fetch BITMAPBASE of BM) + 0 + (ITIMES (fetch BITMAPRASTERWIDTH of BM) + (fetch BITMAPHEIGHT of BM) + 2)) + (RETURN BM]) (WRITEBINARYBITMAP - [LAMBDA (BITMAP FILE) (* JWogulis "26-Dec-84 15:06") - (\BOUTS FILE [ffetch BITMAPBASE of (SETQ BITMAP (\DTEST BITMAP (QUOTE BITMAP] - 0 - (ITIMES (ffetch BITMAPHEIGHT of BITMAP) - (ffetch BITMAPRASTERWIDTH of BITMAP) - BYTESPERWORD]) + [LAMBDA (BITMAP FILE) (* JWogulis "26-Dec-84 15:06") + (\BOUTS FILE [ffetch BITMAPBASE of (SETQ BITMAP (\DTEST BITMAP 'BITMAP] + 0 + (ITIMES (ffetch BITMAPHEIGHT of BITMAP) + (ffetch BITMAPRASTERWIDTH of BITMAP) + BYTESPERWORD]) (WRITEBM - [LAMBDA (FILE BITMAP) (* lmm " 6-Jun-85 16:46") - [BOUT16 FILE (ffetch BITMAPWIDTH of (SETQ BITMAP (\DTEST BITMAP (QUOTE BITMAP] - (BOUT16 FILE (ffetch BITMAPHEIGHT of BITMAP)) + [LAMBDA (FILE BITMAP) (* lmm " 6-Jun-85 16:46") + [BOUT16 FILE (ffetch BITMAPWIDTH of (SETQ BITMAP (\DTEST BITMAP 'BITMAP] + (BOUT16 FILE (ffetch BITMAPHEIGHT of BITMAP)) (WRITEBINARYBITMAP BITMAP FILE]) (WRITEBMLST - [LAMBDA (FILE LST) (* JWogulis "26-Dec-84 15:06") - (PROG [(F (OPENSTREAM FILE (QUOTE OUTPUT) - (QUOTE NEW] + [LAMBDA (FILE LST) (* JWogulis "26-Dec-84 15:06") + (PROG [(F (OPENSTREAM FILE 'OUTPUT 'NEW] (for I in LST do (WRITEBM F I)) - (CLOSEF F]) + (CLOSEF F]) (READBMLST - [LAMBDA (FILE) (* JWogulis "26-Dec-84 15:08") - (bind (F _(OPENSTREAM FILE (QUOTE INPUT) - (QUOTE OLD))) - until (EOFP F) collect (READBM F) finally (CLOSEF F]) + [LAMBDA (FILE) (* JWogulis "26-Dec-84 15:08") + (bind (F _ (OPENSTREAM FILE 'INPUT 'OLD)) until (EOFP F) collect (READBM F) + finally (CLOSEF F]) (READBM - [LAMBDA (FILE) (* lmm " 6-Jun-85 16:46") - (READBINARYBITMAP (BIN16 FILE) - (BIN16 FILE) - FILE]) + [LAMBDA (FILE) (* lmm " 6-Jun-85 16:46") + (READBINARYBITMAP (BIN16 FILE) + (BIN16 FILE) + FILE]) (READPRESS - [LAMBDA (FILENAME) (* lmm " 2-Jun-86 22:34") - (RESETLST (PROG (WW HT MICAWIDTH MICAHEIGHT BITMAP TOTCOUNT (OFD (GETSTREAM (OPENFILE - FILENAME - (QUOTE INPUT) - (QUOTE OLD)) - (QUOTE INPUT))) - X WIDTH) - (RESETSAVE NIL (LIST (QUOTE CLOSEF) - OFD)) - (RPCHK 256) (* Edotcode) - (SETQ WW (IQUOTIENT (BIN16 OFD) - 16)) (* Width) - (SETQ HT (BIN16 OFD)) (* Height) - (until (SELECTC (SETQ X (BIN16 OFD)) - ((IPLUS 512 3) - (* Edotmode and 3) - (RPCHK 2) (* Edotsize) - (SETQ MICAWIDTH (BIN16 OFD)) - (SETQ MICAHEIGHT (BIN16 OFD)) - NIL) - (1 (* Edotwindow) - (BIN16 OFD) - (SETQ WIDTH (BIN16 OFD)) - (RPCHK 0) - (RPCHK HT) - NIL) - (3 T) - (GO ERROR))) - [\BINS OFD (fetch BITMAPBASE of (SETQ BITMAP (BITMAPCREATE (ITIMES WW 16) - HT))) - 0 - (ITIMES 2 (SETQ TOTCOUNT (ITIMES HT WW] - (RPCHK 0) (* Entity list terminator) - [COND - (NIL (* more checks, not necessary) - (PROGN (RPCHK (IPLUS 65280 238)) (* Nop, setx) - (RPCHK 0) - (RPCHK (IPLUS 65280 239)) (* Nop, sety) - (RPCHK 0) - (RPCHK (IPLUS 65280 252)) (* Nop, show dots) - (RPCHK 0] - (RETURN BITMAP) - ERROR - (ERROR "Sorry, unrecognized PRESS file format. READPRESS isn't very general."]) + [LAMBDA (FILENAME) (* ; "Edited 24-Sep-2023 13:54 by rmk") + (* lmm " 2-Jun-86 22:34") + (RESETLST + (PROG (WW HT MICAWIDTH MICAHEIGHT BITMAP TOTCOUNT (OFD (OPENSTREAM FILENAME 'INPUT + 'OLD)) + X WIDTH) + (RESETSAVE NIL (LIST 'CLOSEF OFD)) + (RPCHK 256) (* Edotcode) + (SETQ WW (IQUOTIENT (BIN16 OFD) + 16)) (* Width) + (SETQ HT (BIN16 OFD)) (* Height) + (until (SELECTC (SETQ X (BIN16 OFD)) + ((IPLUS 512 3) (* Edotmode and 3) + (RPCHK 2) (* Edotsize) + (SETQ MICAWIDTH (BIN16 OFD)) + (SETQ MICAHEIGHT (BIN16 OFD)) + NIL) + (1 (* Edotwindow) + (BIN16 OFD) + (SETQ WIDTH (BIN16 OFD)) + (RPCHK 0) + (RPCHK HT) + NIL) + (3 T) + (GO ERROR))) + [\BINS OFD (fetch BITMAPBASE of (SETQ BITMAP (BITMAPCREATE (ITIMES WW 16) + HT))) + 0 + (ITIMES 2 (SETQ TOTCOUNT (ITIMES HT WW] + (RPCHK 0) (* Entity list terminator) + [COND + (NIL (* more checks, not necessary) + (PROGN (RPCHK (IPLUS 65280 238)) (* Nop, setx) + (RPCHK 0) + (RPCHK (IPLUS 65280 239)) (* Nop, sety) + (RPCHK 0) + (RPCHK (IPLUS 65280 252)) (* Nop, show dots) + (RPCHK 0] + (RETURN BITMAP) + ERROR + (ERROR "Sorry, unrecognized PRESS file format. READPRESS isn't very general.")))]) (WINDOWBM - [LAMBDA (BITMAP POSITION) (* JWogulis "26-Dec-84 15:37") - (IF (AND POSITION (NOT (POSITIONP POSITION))) - THEN (ERROR "NOT A POSITION" POSITION)) - [IF (NOT POSITION) - THEN (SETQ POSITION (GETBOXPOSITION (IPLUS 8 (BITMAPWIDTH BITMAP)) - (IPLUS 8 (BITMAPHEIGHT BITMAP] - (PROG ((WIND (CREATEW (LIST (CAR POSITION) - (CDR POSITION) - (IPLUS 8 (BITMAPWIDTH BITMAP)) - (IPLUS 8 (BITMAPHEIGHT BITMAP))) - NIL 4))) - (BITBLT BITMAP 0 0 WIND) - (RETURN WIND]) + [LAMBDA (BITMAP POSITION) (* JWogulis "26-Dec-84 15:37") + (IF (AND POSITION (NOT (POSITIONP POSITION))) + THEN (ERROR "NOT A POSITION" POSITION)) + [IF (NOT POSITION) + THEN (SETQ POSITION (GETBOXPOSITION (IPLUS 8 (BITMAPWIDTH BITMAP)) + (IPLUS 8 (BITMAPHEIGHT BITMAP] + (PROG ((WIND (CREATEW (LIST (CAR POSITION) + (CDR POSITION) + (IPLUS 8 (BITMAPWIDTH BITMAP)) + (IPLUS 8 (BITMAPHEIGHT BITMAP))) + NIL 4))) + (BITBLT BITMAP 0 0 WIND) + (RETURN WIND]) ) -(DECLARE: DONTCOPY -(DECLARE: EVAL@COMPILE -[PUTPROPS RPCHK MACRO ((N) +(DECLARE%: DONTCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS RPCHK MACRO ((N) (OR (EQ (BIN16 OFD) N) - (GO ERROR] + (GO ERROR)))) ) ) (PUTPROPS BITMAPFNS COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986)) -(DECLARE: DONTCOPY - (FILEMAP (NIL (564 5993 (READBINARYBITMAP 574 . 1075) (WRITEBINARYBITMAP 1077 . 1437) (WRITEBM 1439 . -1752) (WRITEBMLST 1754 . 2028) (READBMLST 2030 . 2305) (READBM 2307 . 2492) (READPRESS 2494 . 5342) ( -WINDOWBM 5344 . 5991))))) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (589 5676 (READBINARYBITMAP 599 . 1213) (WRITEBINARYBITMAP 1215 . 1585) (WRITEBM 1587 . +1874) (WRITEBMLST 1876 . 2112) (READBMLST 2114 . 2351) (READBM 2353 . 2536) (READPRESS 2538 . 4970) ( +WINDOWBM 4972 . 5674))))) STOP diff --git a/sources/ADIR b/sources/ADIR index 4669db0c..444d2d8d 100644 --- a/sources/ADIR +++ b/sources/ADIR @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-May-2023 21:39:25" {DSK}c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;2 65907 +(FILECREATED "14-Sep-2023 23:20:17" {WMEDLEY}ADIR.;30 67297 - :EDIT-BY "lmm" + :EDIT-BY rmk - :CHANGES-TO (FNS OPENFILE) + :CHANGES-TO (FNS \COPYSYS) - :PREVIOUS-DATE "31-Oct-2022 23:50:03" -{DSK}c>Users>Larry>home>il>MEDLEY>SOURCES>ADIR.;1) + :PREVIOUS-DATE "14-Sep-2023 22:56:19" {WMEDLEY}ADIR.;29) (PRETTYCOMPRINT ADIRCOMS) @@ -79,16 +78,18 @@ (\GETFILENAME X RECOG]) (INFILE - [LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:23") - (INPUT (OPENFILE FILE 'INPUT 'OLD]) + [LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:40 by rmk") + (* rmk%: " 3-OCT-79 14:23") + (INPUT (OPENSTREAM FILE 'INPUT 'OLD]) (INFILEP [LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39") (\GETFILENAME FILE 'OLD]) (IOFILE - [LAMBDA (FILE) (* rmk%: " 5-SEP-81 13:54") - (OPENFILE FILE 'BOTH 'OLD]) + [LAMBDA (FILE) (* ; "Edited 14-Sep-2023 22:56 by rmk") + (* rmk%: " 5-SEP-81 13:54") + (OPENSTREAM FILE 'BOTH 'OLD]) (OPENFILE [LAMBDA (FILE ACCESS RECOG PARAMETERS OPTIONAL) (* ; "Edited 11-May-2023 21:05 by lmm") @@ -167,8 +168,9 @@ (RETURN STREAM]) (OUTFILE - [LAMBDA (FILE) (* rmk%: " 3-OCT-79 14:24") - (OUTPUT (OPENFILE FILE 'OUTPUT 'NEW]) + [LAMBDA (FILE) (* ; "Edited 13-Sep-2023 17:59 by rmk") + (* rmk%: " 3-OCT-79 14:24") + (OUTPUT (OPENSTREAM FILE 'OUTPUT 'NEW]) (OUTFILEP [LAMBDA (FILE) (* rmk%: " 9-OCT-79 22:39") @@ -195,50 +197,69 @@ (fetch (IFPAGE NActivePages) of \InterfacePage]) (\COPYSYS - [LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 31-Oct-2022 23:49 by rmk") + [LAMBDA (FILE SYSNAME DONTSAVE) (* ; "Edited 14-Sep-2023 23:19 by rmk") + (* ; "Edited 3-Jul-2023 19:21 by rmk") + (* ; "Edited 1-Jul-2023 12:34 by rmk") + (* ; "Edited 29-Jun-2023 11:41 by rmk") + (* ; "Edited 31-Oct-2022 23:49 by rmk") (* ; "Edited 16-Mar-2021 19:46 by larry") - (PROG (FULLNAME VAL TFILE THOST) + (PROG (TEMPNAME VAL TARGETFILE TARGETHOST PSEUDOHOSTP) RETRY - (SETQ FILE (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY \CONNECTED.DIRECTORY)) - (SETQ TFILE (TRUEFILENAME FILE)) - [SELECTQ [SETQ THOST (U-CASE (FILENAMEFIELD TFILE 'HOST] - (DSK [SETQ FULLNAME (PACKFILENAME.STRING 'HOST THOST 'NAME 'tmp 'EXTENSION 'SYSOUT + + + (* ;; "RMK: Get the full target name, including version in particular for DSK, at the outset so we know what the RENAMEFILE will do and we can return that value.") + + (* ;; "We try to make the temp file on the same device, so that the RENAMEFILE (hopefully) won't do a copy. ") + + (* ;; "The reason for all this fooling around is because \FLUSHVM doesn't like version numbers.") + + (* ;; "") + + (* ;; "Perhaps we should also check the value of RENAMEFILE to make sure it succeeded?") + + (SETQ FILE (OUTFILEP (PACKFILENAME.STRING 'BODY FILE 'BODY "WORK.SYSOUT" 'BODY + \CONNECTED.DIRECTORY))) + (SETQ PSEUDOHOSTP (PSEUDOHOSTP FILE)) (* ; + "In order to return the expected name at the end.") + (SETQ TARGETFILE (TRUEFILENAME FILE)) + [SELECTQ [SETQ TARGETHOST (U-CASE (FILENAMEFIELD TARGETFILE 'HOST] + (DSK [SETQ TEMPNAME (PACKFILENAME.STRING 'HOST TARGETHOST 'NAME 'tmp 'EXTENSION + 'SYSOUT 'BODY - (\UFS.RECOGNIZE.FILE TFILE 'NON (\GETDEVICEFROMNAME THOST] - (SETQ VAL (\FLUSHVM FULLNAME)) - (SETQ FULLNAME (RENAMEFILE FULLNAME FILE))) - (UNIX [SETQ FULLNAME (CONCAT "{" THOST "}" (\UFS.RECOGNIZE.FILE TFILE 'NON ( - \GETDEVICEFROMNAME - THOST] + (\UFS.RECOGNIZE.FILE TARGETFILE 'NON (\GETDEVICEFROMNAME + TARGETHOST] + (SETQ VAL (\FLUSHVM TEMPNAME))) + (UNIX [SETQ TEMPNAME (CONCAT "{" TARGETHOST "}" (\UFS.RECOGNIZE.FILE TARGETFILE + 'NON + (\GETDEVICEFROMNAME TARGETHOST] (* ; "\DOFLUSHVM ") - (SETQ VAL (\FLUSHVM FULLNAME)) - (SETQ FULLNAME (RENAMEFILE FULLNAME FILE))) + (SETQ VAL (\FLUSHVM TEMPNAME))) (PROGN (SETQ VAL (\FLUSHVM)) - (LET ((UNIXVAR (UNIX-GETENV "LDEDESTSYSOUT"))) + (LET ((LDEDEST (UNIX-GETENV "LDEDESTSYSOUT"))) (* ; - "\FLSUVM saves image to Unix enviroment var or lisp.virtualmem") - (SETQ FULLNAME (COPYFILE (COND - (UNIXVAR (CONCAT "{DSK}" UNIXVAR)) + "\FLUSHVM saves image to Unix enviroment var or lisp.virtualmem. LDEDEST is assumed to be DSK??") + (SETQ TEMPNAME (COPYFILE (COND + (LDEDEST (CONCAT "{DSK}" LDEDEST)) (T "{DSK}~/lisp.virtualmem")) - FILE + TARGETFILE '((TYPE BINARY] (COND - ((NULL VAL) - - (* ;; "First clause of OR is T when resuming this vmem; second is starting the sysout. Unless \COPYSYS1 itself does a \FLUSHVM, the second never returns T, yes? NIL is normal return (continuing in same image), is error return") - (* ; "Continuing in the current image") + ((NULL VAL) (* ; "Continuing in the current image") + (CL:WHEN TARGETFILE (RENAMEFILE TEMPNAME TARGETFILE)) (\DAYTIME0 \LASTUSERACTION) - (RETURN FULLNAME)) + (RETURN (CL:IF PSEUDOHOSTP + (PSEUDOFILENAME TARGETFILE) + TARGETFILE))) ((AND (SMALLP VAL) (IGREATERP 0 VAL)) (* ;  "Error occurred while making sysout.") (LISPERROR (IMINUS VAL) - FULLNAME) + TEMPNAME) (GO RETRY)) - (T (* ; "Starting sysout") + (T (* ; "Restarting sysout") (\CLEARSYSBUF T) (* ; "Get rid of any spurious typeahead") (\RESETKEYBOARD) (* ; "Enable keyhandler") - (RETURN (LIST FULLNAME]) + (RETURN (LIST (OR FILE TEMPNAME]) (\FLUSHVM [LAMBDA (MAIKO.SYSOUTFILE) (* ; "Edited 16-Mar-2021 10:59 by larry") @@ -1229,14 +1250,14 @@ (ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3175 14373 (DELFILE 3185 . 3346) (FULLNAME 3348 . 3715) (INFILE 3717 . 3865) (INFILEP -3867 . 4002) (IOFILE 4004 . 4144) (OPENFILE 4146 . 4449) (OPENSTREAM 4451 . 8791) (OUTFILE 8793 . 8944 -) (OUTFILEP 8946 . 9082) (RENAMEFILE 9084 . 9390) (SIMPLE.FINDFILE 9392 . 9802) (VMEMSIZE 9804 . 9971) - (\COPYSYS 9973 . 13092) (\FLUSHVM 13094 . 14166) (\LOGOUT0 14168 . 14371)) (14831 36736 ( -UNPACKFILENAME.STRING 14841 . 34115) (\UPF.DIRECTORY 34117 . 36734)) (38264 40936 (UNPACKFILENAME -38274 . 38460) (LASTCHPOS 38462 . 39156) (FILENAMEFIELD 39158 . 39643) (FILENAMEFIELD.STRING 39645 . -40224) (PACKFILENAME 40226 . 40569) (PACKFILENAME.STRING 40571 . 40934)) (55406 56319 ( -FILEDIRCASEARRAY 55416 . 56317)) (56486 63666 (LOGOUT 56496 . 57413) (MAKESYS 57415 . 59044) (SYSOUT -59046 . 60598) (SAVEVM 60600 . 61400) (HERALD 61402 . 61562) (INTERPRET.REM.CM 61564 . 63289) ( -\USEREVENT 63291 . 63664)) (63848 65575 (USERNAME 63858 . 64814) (SETUSERNAME 64816 . 65573))))) + (FILEMAP (NIL (3106 15763 (DELFILE 3116 . 3277) (FULLNAME 3279 . 3646) (INFILE 3648 . 3907) (INFILEP +3909 . 4044) (IOFILE 4046 . 4297) (OPENFILE 4299 . 4602) (OPENSTREAM 4604 . 8944) (OUTFILE 8946 . 9208 +) (OUTFILEP 9210 . 9346) (RENAMEFILE 9348 . 9654) (SIMPLE.FINDFILE 9656 . 10066) (VMEMSIZE 10068 . +10235) (\COPYSYS 10237 . 14482) (\FLUSHVM 14484 . 15556) (\LOGOUT0 15558 . 15761)) (16221 38126 ( +UNPACKFILENAME.STRING 16231 . 35505) (\UPF.DIRECTORY 35507 . 38124)) (39654 42326 (UNPACKFILENAME +39664 . 39850) (LASTCHPOS 39852 . 40546) (FILENAMEFIELD 40548 . 41033) (FILENAMEFIELD.STRING 41035 . +41614) (PACKFILENAME 41616 . 41959) (PACKFILENAME.STRING 41961 . 42324)) (56796 57709 ( +FILEDIRCASEARRAY 56806 . 57707)) (57876 65056 (LOGOUT 57886 . 58803) (MAKESYS 58805 . 60434) (SYSOUT +60436 . 61988) (SAVEVM 61990 . 62790) (HERALD 62792 . 62952) (INTERPRET.REM.CM 62954 . 64679) ( +\USEREVENT 64681 . 65054)) (65238 66965 (USERNAME 65248 . 66204) (SETUSERNAME 66206 . 66963))))) STOP diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM index 3da091708c16dd54cdf4927a06e5a4eff03583af..f77f1d8a7428ac1dcb3ca8d50b29e87e811287b0 100644 GIT binary patch delta 1176 zcmZ`&ZEMp|6mB)lJRa03)rIooEg&yqVQmKSad}Lm}hEkXQ-qPQ<3XFy>_! zC;l;z+7-hl*8dMet=_?bx%@a6NVtvUi3*|bLIu2_6AKKK3hDE~y9fR*sD+}L<$Ly) ziNS-L3j%f)JA|>=XwiGPJsB7}y)Bm;+&#NB{Wc7{hI9D4kjq~0C(?a|L-|^27EbO+ zUS7H^b6;K`P45?utR^q%ko4az$Y)l6?rCPX3o>#qvs>A7hYY;+dP?hYvz2AnW@RWt zt@)2ynK9ZL^|t0;k6rb?K5Jg}KK2V=eg8Dqugk`*O}rUwUfDmonk#Cm1v3%jOiZ$* z7CMm&nyR5VeC9;>C)DBwPzwXT$2%;F!U(8Ip~G41hEffI(`G;otZM(;i7X?yhjVNqqM2Nl_rRk8qDDD}cRS7wdpVdDgl0>=ga0Z4B8yht|CY7Rrh+?)8 z1l?F)ycu%Q0o)69AhT%WC^9;>imIU%T*G&`h&hX#y70mPh*5<=zV&LhG7w_+1B5^= zbQ2(|0eEk0h$aCxjVIv}Y8h~Iei1AJ*@o2$$mw7j;POeRSbdk`OuTD4JW}4HL$N55 y4uhH(I8jn60mTbUj*OQKP*xCiN5SLkp!hCx85jMr3X-ItV2)Ib-h+|Pr+xxl@*`vb delta 1288 zcmbtU-EPxJ6izn$HINlQ0t7NeFIinF7|HUfaL|)otaX8dj-CjIX-8;@67jk#(zD||Mxim zXkm&foyE-xR}P~TpKLG_%=vTyywuX_b>G~mzO5Py92XtChLRA zy6G=YCY$EUcr-AFYi5TyK1od)CXr33X*ph0y@+Lykn*{Sq8nH>P(y-SlRo&XZ4X|IB)M4TXgeZSOdPi8JB3)2 zU{}!e2NXeF)0GAk4dQrlrImuTHX2D_*sc}K5n72uD7ORpNr((aHzM<1n9z#DHU*N3 zDq(+vyWYXT?9dcLQGd#2Bo`gxXKxOi-g=Yoi;04_zW(m2J>4gVp zzAd-H*cH{Sw}sil`OoEmTw~}kiFe^F%q|wLY;7Do{mTV;e=b)z*4?+9W6!J@$2=6# zO&*mF@bOkI`(x&O-pl@(xqSS!J6q(*XG5{<-xq3DF8)6KlvWP$>T5wX!^7Sa5&Hu5 zP{gxhJj|=FyqCY;|ZG}@SasW4L(6fDFMKqfB#Ocau%>F&1?f|nwC~K(ThBStH4cJczYK`pABgV-(l*@72CD8H$ sD@tXVT_Yuf(mA;alDOOw^Sus|?+}O3c&CvBh{=-f^BHXoO7G170Ukd`IRF3v diff --git a/sources/CMLCOMPILE b/sources/CMLCOMPILE index 0ffceec7..9d3854ee 100644 --- a/sources/CMLCOMPILE +++ b/sources/CMLCOMPILE @@ -1,20 +1,48 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED " 2-Jul-90 20:24:02" |{PELE:MV:ENVOS}SOURCES>CMLCOMPILE.;7| 21037 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS COMPILE-FILE-EXPRESSION FAKE-COMPILE-FILE COMPILE-FILE-SCAN-FIRST) +(FILECREATED "24-Sep-2023 14:11:25" {WMEDLEY}CMLCOMPILE.;2 22597 - previous date%: "30-Jun-90 18:55:12" |{PELE:MV:ENVOS}SOURCES>CMLCOMPILE.;6|) + :EDIT-BY rmk + + :CHANGES-TO (FNS COMPILE-IN-CORE) + + :PREVIOUS-DATE " 2-Jul-90 20:24:02" {WMEDLEY}CMLCOMPILE.;1) (* ; " -Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1985-1987, 1990 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT CMLCOMPILECOMS) -(RPAQQ CMLCOMPILECOMS ((COMS (FUNCTIONS CL:DISASSEMBLE) (FNS FAKE-COMPILE-FILE INTERLISP-FORMAT-P INTERLISP-NLAMBDA-FUNCTION-P COMPILE-FILE-EXPRESSION COMPILE-FILE-WALK-FUNCTION ARGTYPE.STATE COMPILE.CHECK.ARGTYPE COMPILE.FILE.DEFINEQ COMPILE-FILE-SETF-SYMBOL-FUNCTION COMPILE-FILE-EX/IMPORT COMPILE.FILE.APPLY COMPILE.FILE.RESET COMPILE-IN-CORE) (FNS COMPILE-FILE-SCAN-FIRST) (* ; "This function is support for AR#11185") (VARS ARGTYPE.VARS) (PROP COMPILE-FILE-EXPRESSION DEFINEQ * SETF-SYMBOL-FUNCTION PRETTYCOMPRINT) (FUNCTIONS COMPILE-FILE-DECLARE%:)) (COMS (FNS NEWDEFC) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD (QUOTE NEWDEFC) (QUOTE DEFC))))) (PROP FILETYPE CMLCOMPILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA FAKE-COMPILE-FILE))))) +(RPAQQ CMLCOMPILECOMS + [(COMS (FUNCTIONS CL:DISASSEMBLE) + (FNS FAKE-COMPILE-FILE INTERLISP-FORMAT-P INTERLISP-NLAMBDA-FUNCTION-P + COMPILE-FILE-EXPRESSION COMPILE-FILE-WALK-FUNCTION ARGTYPE.STATE + COMPILE.CHECK.ARGTYPE COMPILE.FILE.DEFINEQ COMPILE-FILE-SETF-SYMBOL-FUNCTION + COMPILE-FILE-EX/IMPORT COMPILE.FILE.APPLY COMPILE.FILE.RESET COMPILE-IN-CORE) + (FNS COMPILE-FILE-SCAN-FIRST) + (* ; + "This function is support for AR#11185") + (VARS ARGTYPE.VARS) + (PROP COMPILE-FILE-EXPRESSION DEFINEQ * SETF-SYMBOL-FUNCTION PRETTYCOMPRINT) + (FUNCTIONS COMPILE-FILE-DECLARE%:)) + [COMS (FNS NEWDEFC) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MOVD 'NEWDEFC 'DEFC] + (PROP FILETYPE CMLCOMPILE) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA FAKE-COMPILE-FILE]) -(CL:DEFUN CL:DISASSEMBLE (NAME-OR-COMPILED-FUNCTION &KEY LEVEL-P (RADIX 8) (OUTPUT *STANDARD-OUTPUT*) FIRST-BYTE MARKED-PC) (PRINTCODE (if (CCODEP NAME-OR-COMPILED-FUNCTION) then NAME-OR-COMPILED-FUNCTION else (CL:COMPILE NIL (if (CL:SYMBOLP NAME-OR-COMPILED-FUNCTION) then (CL:SYMBOL-FUNCTION NAME-OR-COMPILED-FUNCTION) else NAME-OR-COMPILED-FUNCTION))) LEVEL-P RADIX OUTPUT FIRST-BYTE MARKED-PC)) +(CL:DEFUN CL:DISASSEMBLE (NAME-OR-COMPILED-FUNCTION &KEY LEVEL-P (RADIX 8) + (OUTPUT *STANDARD-OUTPUT*) + FIRST-BYTE MARKED-PC) + (PRINTCODE (if (CCODEP NAME-OR-COMPILED-FUNCTION) + then NAME-OR-COMPILED-FUNCTION + else (CL:COMPILE NIL (if (CL:SYMBOLP NAME-OR-COMPILED-FUNCTION) + then (CL:SYMBOL-FUNCTION NAME-OR-COMPILED-FUNCTION) + else NAME-OR-COMPILED-FUNCTION))) + LEVEL-P RADIX OUTPUT FIRST-BYTE MARKED-PC)) (DEFINEQ (FAKE-COMPILE-FILE @@ -132,18 +160,24 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r (COMPILE-IN-CORE [LAMBDA (fn-name fn-expr fn-type NOSAVE) (DECLARE (SPECVARS LCFIL LAPFLG STRF SVFLG LSTFIL SPECVARS LOCALVARS DONT-TRANSFER-PUTD)) + (* ; "Edited 24-Sep-2023 14:11 by rmk") (* lmm " 2-Jun-86 22:04") + (* ;; "in-core compiling for functions and forms, without the interview. if X is a list, we assume that we are being called merely to display the lap and machine code. the form is compiled as the definition of FOO but the compiled CODE is thrown away. --- if X is a litatom, then saving, redefining, and printing is controlled by the flags.") + (* in-core compiling for functions and forms, without the interview. - if X is a list, we assume that we are being called merely to display the lap - and machine code. the form is compiled as the definition of FOO but the - compiled :CODE is thrown away. - - if X is a litatom, then saving, redefining, and printing is controlled by the - flags.) + if X is a list, we assume that we are being called merely to display the lap and + machine code. the form is compiled as the definition of FOO but the compiled + :CODE is thrown away. - + if X is a litatom, then saving, redefining, and printing is controlled by the + flags.) (LET ((NOREDEFINE NIL) (PRINTLAP NIL) (DONT-TRANSFER-PUTD T)) + + (* ;; "RMK: Is it really worth saving NULLFILE from one invocation to the next?") + (RESETVARS [(NLAMA NLAMA) (NLAML NLAML) (LAMS LAMS) @@ -155,10 +189,9 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r (STREAMP NULLFILE) (OPENP NULLFILE)) NULLFILE) - (T (SETQ NULLFILE (OPENFILE '{NULL} 'OUTPUT] - (RETURN (RESETLST (* RESETLST to provide reset context - for macros under COMPILE1 as - generated e.g. by DECL.) + (T (SETQ NULLFILE (OPENSTREAM '{NULL} 'OUTPUT] + (RETURN (RESETLST (* ; + "RESETLST to provide reset context for macros under COMPILE1 as generated e.g. by DECL.") [PROG ((LCFIL) [LAPFLG (AND PRINTLAP (COND (BYTECOMPFLG T) @@ -186,17 +219,46 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r (* ; "This function is support for AR#11185") -(RPAQQ ARGTYPE.VARS ((1 NLAML "NLAMBDA spread") (2 LAMA "LAMBDA nospread") (0 LAMS "LAMBDA spread") (3 NLAMA "NLAMBDA no-spread"))) +(RPAQQ ARGTYPE.VARS ((1 NLAML "NLAMBDA spread") + (2 LAMA "LAMBDA nospread") + (0 LAMS "LAMBDA spread") + (3 NLAMA "NLAMBDA no-spread"))) -(PUTPROPS DEFINEQ COMPILE-FILE-EXPRESSION COMPILE.FILE.DEFINEQ) +(PUTPROPS DEFINEQ COMPILE-FILE-EXPRESSION COMPILE.FILE.DEFINEQ) -(PUTPROPS * COMPILE-FILE-EXPRESSION NILL) +(PUTPROPS * COMPILE-FILE-EXPRESSION NILL) -(PUTPROPS SETF-SYMBOL-FUNCTION COMPILE-FILE-EXPRESSION COMPILE-FILE-SETF-SYMBOL-FUNCTION) +(PUTPROPS SETF-SYMBOL-FUNCTION COMPILE-FILE-EXPRESSION COMPILE-FILE-SETF-SYMBOL-FUNCTION) -(PUTPROPS PRETTYCOMPRINT COMPILE-FILE-EXPRESSION NILL) +(PUTPROPS PRETTYCOMPRINT COMPILE-FILE-EXPRESSION NILL) -(CL:DEFUN COMPILE-FILE-DECLARE%: (FORM COMPILED.FILE EVAL@COMPILE DOCOPY DEFER) (CL:DO ((TAIL (CDR FORM) (CDR TAIL))) ((CL:ENDP TAIL)) (CL:IF (CL:SYMBOLP (CAR TAIL)) (CASE (CAR TAIL) ((EVAL@LOAD DOEVAL@LOAD DONTEVAL@LOAD) NIL) ((EVAL@LOADWHEN) (CL:POP TAIL)) ((EVAL@COMPILE DOEVAL@COMPILE) (SETQ EVAL@COMPILE T)) ((DONTEVAL@COMPILE) (SETQ EVAL@COMPILE NIL)) ((EVAL@COMPILEWHEN) (SETQ EVAL@COMPILE (EVAL (CAR (SETQ TAIL (CDR TAIL)))))) ((COPY DOCOPY) (SETQ DOCOPY T)) ((DONTCOPY) (SETQ DOCOPY NIL)) ((COPYWHEN) (SETQ DOCOPY (EVAL (CAR (SETQ TAIL (CDR TAIL)))))) ((FIRST)) ((NOTFIRST COMPILERVARS)) (CL:OTHERWISE (CL:FORMAT COUTFILE "Warning: Ignoring unrecognized DECLARE: tag: ~S~%%" (CAR TAIL)))) (COND ((EQ (QUOTE DECLARE%:) (CAR (CAR TAIL))) (COMPILE-FILE-DECLARE%: (CAR TAIL) COMPILED.FILE EVAL@COMPILE DOCOPY DEFER)) (T (CL:WHEN EVAL@COMPILE (EVAL (CAR TAIL))) (CL:WHEN DOCOPY (COMPILE-FILE-EXPRESSION (CAR TAIL) COMPILED.FILE EVAL@COMPILE DEFER))))))) +(CL:DEFUN COMPILE-FILE-DECLARE%: (FORM COMPILED.FILE EVAL@COMPILE DOCOPY DEFER) + (CL:DO ((TAIL (CDR FORM) + (CDR TAIL))) + ((CL:ENDP TAIL)) + (CL:IF (CL:SYMBOLP (CAR TAIL)) + (CASE (CAR TAIL) + ((EVAL@LOAD DOEVAL@LOAD DONTEVAL@LOAD) NIL) + ((EVAL@LOADWHEN) (CL:POP TAIL)) + ((EVAL@COMPILE DOEVAL@COMPILE) (SETQ EVAL@COMPILE T)) + ((DONTEVAL@COMPILE) (SETQ EVAL@COMPILE NIL)) + ((EVAL@COMPILEWHEN) [SETQ EVAL@COMPILE (EVAL (CAR (SETQ TAIL (CDR TAIL]) + ((COPY DOCOPY) (SETQ DOCOPY T)) + ((DONTCOPY) (SETQ DOCOPY NIL)) + ((COPYWHEN) [SETQ DOCOPY (EVAL (CAR (SETQ TAIL (CDR TAIL]) + ((FIRST) ) + ((NOTFIRST COMPILERVARS) ) + (CL:OTHERWISE (CL:FORMAT COUTFILE "Warning: Ignoring unrecognized DECLARE: tag: ~S~%%" + (CAR TAIL)))) + [COND + ((EQ 'DECLARE%: (CAR (CAR TAIL))) + (COMPILE-FILE-DECLARE%: (CAR TAIL) + COMPILED.FILE EVAL@COMPILE DOCOPY DEFER)) + (T (CL:WHEN EVAL@COMPILE + (EVAL (CAR TAIL))) + (CL:WHEN DOCOPY + (COMPILE-FILE-EXPRESSION (CAR TAIL) + COMPILED.FILE EVAL@COMPILE DEFER))]))) (DEFINEQ (NEWDEFC @@ -228,25 +290,26 @@ Copyright (c) 1985, 1986, 1987, 1990 by Venue & Xerox Corporation. All rights r ) (DECLARE%: DONTEVAL@LOAD DOCOPY -(MOVD (QUOTE NEWDEFC) (QUOTE DEFC)) +(MOVD 'NEWDEFC 'DEFC) ) -(PUTPROPS CMLCOMPILE FILETYPE CL:COMPILE-FILE) +(PUTPROPS CMLCOMPILE FILETYPE CL:COMPILE-FILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS -(ADDTOVAR NLAMA) +(ADDTOVAR NLAMA ) -(ADDTOVAR NLAML) +(ADDTOVAR NLAML ) -(ADDTOVAR LAMA FAKE-COMPILE-FILE) +(ADDTOVAR LAMA FAKE-COMPILE-FILE) ) (PUTPROPS CMLCOMPILE COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1990)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1675 16480 (FAKE-COMPILE-FILE 1685 . 5121) (INTERLISP-FORMAT-P 5123 . 5341) ( -INTERLISP-NLAMBDA-FUNCTION-P 5343 . 5577) (COMPILE-FILE-EXPRESSION 5579 . 8929) ( -COMPILE-FILE-WALK-FUNCTION 8931 . 9178) (ARGTYPE.STATE 9180 . 9340) (COMPILE.CHECK.ARGTYPE 9342 . -11334) (COMPILE.FILE.DEFINEQ 11336 . 11829) (COMPILE-FILE-SETF-SYMBOL-FUNCTION 11831 . 12425) ( -COMPILE-FILE-EX/IMPORT 12427 . 12755) (COMPILE.FILE.APPLY 12757 . 13017) (COMPILE.FILE.RESET 13019 . -13880) (COMPILE-IN-CORE 13882 . 16478)) (16481 18210 (COMPILE-FILE-SCAN-FIRST 16491 . 18208)) (19612 -20676 (NEWDEFC 19622 . 20674))))) + (FILEMAP (NIL (1636 2253 (CL:DISASSEMBLE 1636 . 2253)) (2254 17523 (FAKE-COMPILE-FILE 2264 . 5700) ( +INTERLISP-FORMAT-P 5702 . 5920) (INTERLISP-NLAMBDA-FUNCTION-P 5922 . 6156) (COMPILE-FILE-EXPRESSION +6158 . 9508) (COMPILE-FILE-WALK-FUNCTION 9510 . 9757) (ARGTYPE.STATE 9759 . 9919) ( +COMPILE.CHECK.ARGTYPE 9921 . 11913) (COMPILE.FILE.DEFINEQ 11915 . 12408) ( +COMPILE-FILE-SETF-SYMBOL-FUNCTION 12410 . 13004) (COMPILE-FILE-EX/IMPORT 13006 . 13334) ( +COMPILE.FILE.APPLY 13336 . 13596) (COMPILE.FILE.RESET 13598 . 14459) (COMPILE-IN-CORE 14461 . 17521)) +(17524 19253 (COMPILE-FILE-SCAN-FIRST 17534 . 19251)) (19796 21163 (COMPILE-FILE-DECLARE%: 19796 . +21163)) (21164 22228 (NEWDEFC 21174 . 22226))))) STOP diff --git a/sources/CMLCOMPILE.LCOM b/sources/CMLCOMPILE.LCOM index dadd93be882c1bf0f2ec231a0ae4613aefe12293..6e4008f2fb58b0c5e0750f0cf30f6b9d66c237bb 100644 GIT binary patch delta 4207 zcma)9Yj7J^71qjj+$fDB$%^C1c^oT_BPErheQ717G+s+9YZGaAvnyM66Jy*siA)|2 zNjm+Jwg&pA@B^A`k}}hzLp#%f2BuhuObHEWIs*egN{1gX!!Q(v@E9lqV}>a|3WGU! zACi-1I%r0B@1A?^xo6MgJLkT3_Rpt>qj{+yD^k25m!!C?6ja!ziMfN~m;@17sYrTB zHnhm4z~b`BTT{ zVBriz;9|8bSY-o{*fiJ?a?TrkZrP(YeL?Dt=%NkLJ95NSydE8wXFO^_5 zdm@pDz})Nwl>PuQJQs<5tdc=j%X_pcFu*W;Mu4o8mn-qnDL8lfBxG|%Q5lnrctwS% zub>#XQ~&Sp zJW+w=0Rtir0wX}Kq#9BI1UdtnjzI)M()`Cj_)sdvAk&1TV<4sYB;=(MISx`B55&ca zSjHFD6|f&tOa_(GrbeeKl7Vj=j7gS;T1AIcQZSR;W|mJ2AZl7^3V5D(&*nJ}Bo)7q zXH#Gtlr=-r^qiVUF+7tY`xZHt1yz$2qk@W;(GY1{+m_Lb_&t)278AgbDiu|m5KF+K zU{u0=qw%v<)zZn*o=x(rg)(U#NIH?vB`mZheqI^0DVm@C{Cqy0i zWSYF-)Br9+Ltd5e%n>IFfJ>*`;L~j$fkPwaN}?|9%mRms>Y8}y5O7Qy6sd|&7Dm-d z5jZ*x7fG-_W8`$Pk}D=kC=?bsnsqF;9|OR4p`^zpWkS|fr7WTESaeh=haUhehKN05 zGQ1_9$s_?|MjNjHBM5j@ehMdyt7Jl&#D$aq_(VI)s)BDckN~jee5lPzER@hCG_;x7 zP+#MVqC*&SdBet75~9({lqSKbtcdy)NrI2$hLZ>WQR)D~)nrjNDkQc!D2Zjmih42= zV?dqQ-sSZi3s9buvw^qQ7f*TL`rg3<|9rLX`Bp7J_2B#W@090CgmBAT3WPSl*+jY@ z=`+FRjK8S{=Ttvgy=}f1*hIh8oDT$g=VykSgd^OX>2IpxIkn&7Xx3(i15~K`SaqbD zuNDH_Ky}oN22+b8Cx1CxUlC_dkOW%3R<>UAR>F?7@F@+K!nkRUvNE{o?YQ+XmGgU|ESCWi za6qRstwg2Kv4)(@TD}=qssDfw{r_5N(>(vnpHV=xGKChR$)opQGq*^!}{`lioOK$6Cm~j|h{C5q*j3C6` zHlh-M(513EAt5?2tH71PaKr`#O9%!BV}Ub`T|jHbBwbq4E;KaISiMQf!C8uRXFToB z#<&&{k+BWqH0_GYxRS7_*n%+p?MVuu+!D%iwu>MEVeyQ&7Ox@e9~zKA_zgFc@fT^J$GytI~yAD8v7lfvEoIlv**stpE;2Q zr)@e17itSno~T`bhz~NX`Fvy-MVm{J!LZNCq=W^Tc6uDL9qCh~Q#278`_Y%$W=*YC)dF z)~jT}Iy%cDkPLDtG>|sc!u=R{raIPosLFV?r|Pc;t0D7Cu|)ULhpT;oL9h9ZJp+Kg zxF6Bb%Pyc{*`aoCS-iJ7;H;{yVRZw$UqB$rV8I(#@)|lFL->A)T-q&-7<3mEY;T^y z_87>7IF4Xe%Lh&;X_+vp0gJ*+!yh!8yPq0$Di}6JPIrbD`F~A=wm8z+ZO-o5JU9`y z(zoh&obVwgC5k2lgi|%kXHKjmJ@SA^8zL9yKy6#PRHl#)Qu5p&MvR7)~U}lN4x>5t85{l*;}WcEmL#s$TH&Kf6SZlfyH0j ztXFD}*F8T|oQ*e{W$(0&nn=EFvs|uwmXy}?HJ2C3UvaiwBirhpFW5}4yBt@V^M{wt z+eEW=c&X+tTyK_D_ngB^y3KKQ{&wxilH~F<_O*o1->FS4J>tAJb~pm(Cztviwcfyh ze=#vnT{o${Lz}QpD>+rkG1vmyFo+#p+G?DKu)%7rve-JioTSgQ+5naj%p)EBoxmoO z=GDDX#0?e!l7z2&`(tUQ-GMg#vbTdGts8@Y^%9@LoR87RaeRSB7%<3cQr33mqDuik3q!)%?Xd*Pp*=7O5%Q zDCm<9auYY%VL|AZ z@7sJ8H?LW`Xj8A$aK7N~ys>KMnx#pbrE$p7u~Bp<`*o{?7O8cl=9?d|{F?Vk)g;%J z@VZpWb`HbyW}tIZ(5i@dD=esbS;TfMoiU%~!bM+{;qU^{x*Ra{eRl^YNs!WuW4e-Iw+vZ}`a0JWw*EdT%j delta 4661 zcma)AZ){uD75B5#v{ZAN7t*A-q&;z))`r=A|NRF@^I|_IFR|Zq{p>iQg*J^tZ3s!1 zG@z-p9!#3{foWSGEz<I@{O^Y#1E420YebbnRrio9i8xnjXXwszdVcog!`Pn8x z)BNGS^X@tK+;h)8=XcKY$4~$Cd?1iiQmUqeQfgWWsai^h135)b=H>CU0)AD?E4j34 zWc}Z#_f~`601-=|Kwe3LpA$n<^UI-F6qs0C6yu`chk$=!<>~X4rNt7gEQ22|CXMM! z4=+{L&M&O2E{?9PtgkLCu8k%#>4cuiqPFluY!JMDo(W~)KS$)l;jkY{^A~VOe|we{<6I;zMEzTh1}-$Uz7&cvWFt<9 zGn^luyO>qdN<1?YSF{=3xb!eNazf83qlR9{B^1N5_mE?7D2hL6BPd4Boa;u>67 z8HocrM>EXlJ@?Tmd0Gi|+HM~7_-4TFxmLvH}{K%gQHC zfWWh$DMb)C3C8vOBoZuKBq?*rNaW;vVlqq;9I65@PfJJVDDe7)v+vrJPx_Z7 zK7E9y`irB*u`?u1isQ7fznC;PX{q|iQ-7VW-5s4jM;M#eGS;h{S#rPsSnV#;oPJsF zvBmTrWMG!veXzypvp5gyeT36jyBlb61}sioA0V88+T9~9j<2cBw^T)z4;PgvD}fts z&)fgfgSwDX(@ z@oY{Yr)PQv9HKssElG-T-c7$^%2@8~s1)Wbd;U)mQi4*+F^hh5esXU6#5>4(+$qtqvu8 z&L(nhf`l*P02XQ6hCdE{v#qY`9U75=g@fNI~~X)Uy7%08dZ-gN@^cQv-E++xOdcIP21Mdq!8 zN2-l7iEu0@$2zba>q$<@=raoNSgSfl+DSjkE!v1&Lwuw2J> zEZeaNJ=c;#-?eD;UW*pnnlMw*cES7z4r>CB&FQoAYiNfbySXU%F_*`aGOS^rHed2% zOBO>8J|!0X#rf6c%JR85G@IL1xKLhMKUcm0elM_0%$ylMO2y2}!^7An{djmEjyHzu z?WFsK+ixe`5B)zvUhGi8YNVR*WH;Z+>@hWy)pL0}X@7YrbY_)bA%Z53Evkm?3HB?kmJWpv znAeXkO`wBFt&4!Br_@<&cGHN?DZoNa-U)=*6S2-(=z83<(?#VAR-Vihdy2j0Y9PFO zkYrx5j~;fLFFtTT>fDO1QLa@0umv%1kNB#hXf-~>3D`1ObQS{>?Dh&t7W;#OmdxTk zN4RYoCDQ0MqY@sHS6VM+L!kwrhv0t3tCL3x)DN>rt>DmV0cn*wcLW+RvFz34&eZ_pY_rLTU5b z19UaUZaZ&OYIzVF&(<+Iu9x^p+O`hkz3r!V@?g98#f!!ssuc(fMgosr962~b9zLZJ*uLE3Sp1c%}ioW#Y<@`Hb2d8W_Khc!bbr^F=Pl0* zHR`o7s$?B{^Yt3F-WYS!)Q*hpfO~7y3mK}!j}ewDgSDz#vqi6K%{5mWl}Br?5AE5P z%1FQOuwHFs+>hCX4X1BaZJ8@rYnn=sZ0SMzm8QyTWL?emoh>`P)To@?c-EdY%O^LM zoPAzt?{jiv#um6*xlul~p*kY<waYgBHQ=Qfz;UiG6*g_YTj`mic zmqHcl2j*WwhX?V(wS=xEI1te31kUkRVysDr_xsyCUW~Qmc%j*l@jQzksr$MBQQv$r z9Qdj?AYhRo$>4nM^Ozv*PXP`)I44Z%wXlaGJv0}Kn2!q*qRMB-p1^UIAz; zXKSuM+d|hJ33T4suA1wnJ$Q&J zK4pv43r&maX@^MI*KmWAcYNdua8dJ5KA)GvYHW47oWua0bdct-eB-w@wujgqV(nv0 zjrSG20Z#aWTd|*Y+=_sPOFF;CIQ;h0$hTmQ^u^c(G%2fgX6K5NiiR*Im>c{X)^+d< zxel)vzof9EO<4I>e@#dc-2YgNBklt#@n1d?xNN}cVrlV-%JO0t|MLMy=sz(0>_8X*| diff --git a/sources/COMPILE b/sources/COMPILE index 07bed40c..d87ed2bb 100644 --- a/sources/COMPILE +++ b/sources/COMPILE @@ -1,11 +1,13 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10 FORMAT XCCS) -(FILECREATED " 5-Jul-2021 13:46:39"  -{DSK}kaplan>Local>medley3.5>git-medley>sources>COMPILE.;4 77731 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS BCOMPL BCOMPL.BODY) +(FILECREATED "24-Sep-2023 13:59:34" {WMEDLEY}COMPILE.;5 77344 - previous date%: " 5-Jul-2021 09:31:55" -{DSK}kaplan>Local>medley3.5>git-medley>sources>COMPILE.;3) + :EDIT-BY rmk + + :CHANGES-TO (VARS COMPILECOMS) + (FNS COMPSET) + + :PREVIOUS-DATE " 5-Jul-2021 13:46:39" {WMEDLEY}COMPILE.;4) (* ; " @@ -22,7 +24,7 @@ with the terms of said license. [(FNS BCOMPL BCOMPL.BODY PRINT-COMPILE-HEADER RESETOPENFILES BCOMPL1A BCOMPL2 BCOMPL3 BLOCK%: BRECOMPILE BRECOMPILE1 BRECOMPILE2 BRECOMPILE3 BLOCKCOMPILE BLOCKCOMPILE1 COMPSET COMPSETREAD COMPSETY COMPSETF RCOMP3 TCOMPL RECOMPILE RECOMP? COMPILE COMPILE1 COMPILE1A - SHOULD-BE-DWIMIFIED? COMPILE.FILECHECK COMPEM GETCFILE SPECVARS LOCALVARS GLOBALVARS) + SHOULD-BE-DWIMIFIED? COMPEM GETCFILE SPECVARS LOCALVARS GLOBALVARS) (ADDVARS (NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE EDITL) (LINKFNS) @@ -72,7 +74,7 @@ with the terms of said license. (CL:PROCLAIM '(CL:SPECIAL COMPVARMACROHASH)) (CL:PROCLAIM '(GLOBAL SYSSPECVARS SYSLOCALVARS COMPILE.EXT NOTCOMPILEDFILES CLISPARRAY FILERDTBL DWIMFLG DWIMWAIT LISPXHISTORY] - (COMS (* ; "COMPILEMODE") + (COMS (* ; "COMPILEMODE") (PROP VARTYPE COMPILEMODELST) (FNS COMPILEMODE)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS @@ -1018,26 +1020,19 @@ with the terms of said license. (RETURN (OR TEM BLKNAME]) (COMPSET - (LAMBDA (FILE FLG) (* bvm%: " 2-Aug-86 16:58") - - (* If FILE is not NIL, COMPSET doesn't ask any questions but simply initializes - the output FILE, LCFIL. If FLG is T (AND FILE IS NIL) COMPSET doesn't ask for - an output FILE, but does set up LAPFLG, STRF, SVFLG, and LSTFIL. - - - - - BCOMPL and BRECOMPILE both call COMPSET twice, once with FILE NIL and FLG T, - and once with FILE set to their output FILE. - - - COMPILE calls COMPSET only once, with both arguments NIL.) + [LAMBDA (FILE FLG) (* ; "Edited 24-Sep-2023 13:59 by rmk") + (* bvm%: " 2-Aug-86 16:58") + + (* ;; "If FILE is not NIL, COMPSET doesn't ask any questions but simply initializes the output FILE, LCFIL. If FLG is T (AND FILE IS NIL) COMPSET doesn't ask for an output FILE, but does set up LAPFLG, STRF, SVFLG, and LSTFIL. --- --- BCOMPL and BRECOMPILE both call COMPSET twice, once with FILE NIL and FLG T, and once with FILE set to their output FILE. --- COMPILE calls COMPSET only once, with both arguments NIL.") (PROG (OLDO) (COND (FILE (GO NT))) - (SELECTQ (SETQ FILE (COMPSETREAD '"listing? " COMPSETKEYLST (OR FLG '(S T % -)))) - (S (COND + [SELECTQ [SETQ FILE (COMPSETREAD '"listing? " COMPSETKEYLST (OR FLG '(S T % +] + (S [COND (LAPFLG (PRIN1 '"file: " T) - (SETQ LSTFIL (COMPSETF (COMPSETREAD))))) + (SETQ LSTFIL (COMPSETF (COMPSETREAD] (GO NOCHANGE)) ((ST STF) (SETQ LAPFLG NIL) @@ -1055,34 +1050,33 @@ with the terms of said license. (PRIN1 '"file: " T) (SETQ FILE (COMPSETREAD))) NIL) - (SETQ LSTFIL (COMPSETF FILE))))) - (COND - ((SETQ STRF (COMPSETY (COMPSETREAD '"redefine? "))) - (SETQ SVFLG (COMPSETY (COMPSETREAD '"save exprs? "))))) + (SETQ LSTFIL (COMPSETF FILE] + [COND + ([SETQ STRF (COMPSETY (COMPSETREAD '"redefine? "] + (SETQ SVFLG (COMPSETY (COMPSETREAD '"save exprs? "] NOCHANGE (COND - ((AND LAPFLG (NEQ LSTFIL 'T) - (NOT (OPENP LSTFIL 'OUTPUT))) - (SETQ LSTFIL1 (SETQ LSTFIL (OPENFILE LSTFIL 'OUTPUT 'NEW NIL '((TYPE TEXT))))) - - (* LSTFIL1 is set when the file is opened for this compilation. - in this case it will be closed when the compilation is finished or aborttd.) + ([AND LAPFLG (NEQ LSTFIL 'T) + (NOT (OPENP LSTFIL 'OUTPUT] + [SETQ LSTFIL1 (SETQ LSTFIL (OPENSTREAM LSTFIL 'OUTPUT 'NEW '((TYPE TEXT] + + (* ;; "LSTFIL1 is set when the file is opened for this compilation. in this case it will be closed when the compilation is finished or aborttd.") ) (T (SETQ LSTFIL1 NIL))) (COND - ((AND (NULL FLG) + ([AND (NULL FLG) (COMPSETY (COMPSETREAD '"output file? " NIL '(N % -)))) +] (PRIN1 '"file name: " T) (SETQ FILE (COMPSETREAD))) (T (SETQ FILE NIL))) - NT (COND + NT [COND ((AND (SETQ LCFIL (COMPSETF FILE)) (NEQ LCFIL T)) (SETQ LCFIL (OR (OPENP LCFIL 'OUTPUT) - (OPENSTREAM LCFIL 'OUTPUT 'NEW NIL '((TYPE BINARY))))))) - (RETURN 'DONE)))) + (OPENSTREAM LCFIL 'OUTPUT 'NEW '((TYPE BINARY] + (RETURN 'DONE]) (COMPSETREAD (LAMBDA (MESS KEYLST DEFAULT) (* wt%: "23-AUG-80 01:29") @@ -1309,10 +1303,6 @@ with the terms of said license. FINALLY (RETURN (EQ (CAR FORM) 'CLISP%:]) -(COMPILE.FILECHECK - (LAMBDA (FILE) (* lmm "11-Jul-84 17:27") - (OPENFILE FILE 'INPUT))) - (COMPEM (LAMBDA (X Y ERRORFLG FL) (* wt%: " 7-JUL-78 13:07") @@ -1414,15 +1404,13 @@ with the terms of said license. THEN (SETQ GLOBALVARS (UNION A GLOBALVARS]) ) -(ADDTOVAR NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE - EDITL) +(ADDTOVAR NOLINKFNS HELP ERRORX ERRORSET EVALV FAULTEVAL INTERRUPT SEARCHPDL MAPDL BREAK1 EDITE EDITL) (ADDTOVAR LINKFNS ) (ADDTOVAR FREEVARS ) -(ADDTOVAR SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS - GLOBALVARS) +(ADDTOVAR SYSSPECVARS HELPCLOCK LISPXHIST RESETSTATE OLDVALUE UNDOSIDE0 SPECVARS LOCALVARS GLOBALVARS) (ADDTOVAR SYSLOCALVARS ) @@ -1455,16 +1443,16 @@ with the terms of said license. (RPAQ? COMPSETLST '(ST F STF S Y N 1 2 NIL T)) (RPAQ? COMPSETKEYLST '((ST "ore and redefine " KEYLST ("" (F . "orget exprs"))) - (S . "ame as last time") - (F . "ile only") - (T . "o terminal") - (1) - (2) - (Y . "es") - (N . "o"))) + (S . "ame as last time") + (F . "ile only") + (T . "o terminal") + (1) + (2) + (Y . "es") + (N . "o"))) (RPAQ? COMPSETDEFAULTKEYLST '((Y . "es") - (N . "o"))) + (N . "o"))) (RPAQ? BCOMPL.SCRATCH '{CORE}BCOMPL.SCRATCH) @@ -1490,8 +1478,8 @@ with the terms of said license. (DECLARE%: EVAL@COMPILE (PUTPROPS DIGITCHARP MACRO [LAMBDA (CHAR) - (AND (IGEQ CHAR (CHARCODE 0)) - (ILEQ CHAR (CHARCODE 9]) + (AND (IGEQ CHAR (CHARCODE 0)) + (ILEQ CHAR (CHARCODE 9]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -1546,14 +1534,14 @@ with the terms of said license. ) (PUTPROPS COMPILE COPYRIGHT ("Venue & Xerox Corporation" T 1984 1985 1986 1987 1988 1989 1990 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3770 74020 (BCOMPL 3780 . 5430) (BCOMPL.BODY 5432 . 12011) (PRINT-COMPILE-HEADER 12013 - . 13076) (RESETOPENFILES 13078 . 13431) (BCOMPL1A 13433 . 19446) (BCOMPL2 19448 . 26263) (BCOMPL3 -26265 . 27614) (BLOCK%: 27616 . 28248) (BRECOMPILE 28250 . 43239) (BRECOMPILE1 43241 . 49093) ( -BRECOMPILE2 49095 . 49897) (BRECOMPILE3 49899 . 51275) (BLOCKCOMPILE 51277 . 53137) (BLOCKCOMPILE1 -53139 . 58224) (COMPSET 58226 . 60989) (COMPSETREAD 60991 . 62302) (COMPSETY 62304 . 62428) (COMPSETF -62430 . 62596) (RCOMP3 62598 . 64305) (TCOMPL 64307 . 64606) (RECOMPILE 64608 . 64691) (RECOMP? 64693 - . 65153) (COMPILE 65155 . 67144) (COMPILE1 67146 . 67734) (COMPILE1A 67736 . 69383) ( -SHOULD-BE-DWIMIFIED? 69385 . 70074) (COMPILE.FILECHECK 70076 . 70222) (COMPEM 70224 . 70948) (GETCFILE - 70950 . 72681) (SPECVARS 72683 . 73238) (LOCALVARS 73240 . 73814) (GLOBALVARS 73816 . 74018)) (76481 -77430 (COMPILEMODE 76491 . 77428))))) + (FILEMAP (NIL (3708 73744 (BCOMPL 3718 . 5368) (BCOMPL.BODY 5370 . 11949) (PRINT-COMPILE-HEADER 11951 + . 13014) (RESETOPENFILES 13016 . 13369) (BCOMPL1A 13371 . 19384) (BCOMPL2 19386 . 26201) (BCOMPL3 +26203 . 27552) (BLOCK%: 27554 . 28186) (BRECOMPILE 28188 . 43177) (BRECOMPILE1 43179 . 49031) ( +BRECOMPILE2 49033 . 49835) (BRECOMPILE3 49837 . 51213) (BLOCKCOMPILE 51215 . 53075) (BLOCKCOMPILE1 +53077 . 58162) (COMPSET 58164 . 60861) (COMPSETREAD 60863 . 62174) (COMPSETY 62176 . 62300) (COMPSETF +62302 . 62468) (RCOMP3 62470 . 64177) (TCOMPL 64179 . 64478) (RECOMPILE 64480 . 64563) (RECOMP? 64565 + . 65025) (COMPILE 65027 . 67016) (COMPILE1 67018 . 67606) (COMPILE1A 67608 . 69255) ( +SHOULD-BE-DWIMIFIED? 69257 . 69946) (COMPEM 69948 . 70672) (GETCFILE 70674 . 72405) (SPECVARS 72407 . +72962) (LOCALVARS 72964 . 73538) (GLOBALVARS 73540 . 73742)) (76094 77043 (COMPILEMODE 76104 . 77041)) +))) STOP diff --git a/sources/COMPILE.LCOM b/sources/COMPILE.LCOM index b8258da8d04afe4b7e3559704f5b14dc9f07ee2c..7bcb18ddfc8d6fbd4879729a0b91263202f88361 100644 GIT binary patch delta 1567 zcma)6O>Ep$5Y9HDB`+nkC?QQE=)`SO8?n)@?aekzn$&AQXRUZ`$Mz<%sE{`MpZ!V5 zk5s9uA}Vo5dRHXi09-hvS`{JnfH=UhQqEN`T(}g86KBRwH(4Yq;ludN%=c!#`LVx$ z5j%Mv`$9hw2;p_Zq^e65pK8E~a@?!z#>IpvK~l=37BZ5|0ne3o+PjTbr3^bA;NZbV zo@yoy9xm?h9PX7W`%9{wcQDS}M=1daCram0L@9%T$K*n+Dx?vZ*xQ1P1PHbZ8^$n7{OBa63zWsUZ;=qNg zR|f7r8GQ6Orm{gQ#QtD$`qRz$TH~+ot+mq_|VH!xu1#n!$N`jP_?|A}Ll07AY ziRl#BLub+1OZ|r%gqPAHSabuV`83!C-zoT*Rz5q*5_`I`wMux9(rMs%KX52y4NGwY zLBPxsa8+C}=oH(P3@(|tFb}*1Gep2+0=S*SgWbae2r8yW*eb=aBthctu zgFe4$tBQFJI=`4TS4|`9hU?M?cd3u1_FE9AIF1=aX7+GpN^~#fq;L7 zi;5$>>nLl>;5k%{eg{6*`f~eyq(9u8e6#0f)8+TjwAxIe{H*yg$`{RzbNBViY&dN+ zf7+5ze%smK!k+E0deKha&3jUAt7-H5`O^m)^Xy%1;HL>XXeek`OW-h z_oqkUdq0P7YeSgREITi`Ft;Vk4jOfM~`#T6Df zw$knFG}>Mjy4x5Oc~^1PZ(ZK(dAq$#tF+TDZD)*brPR)JylUIKDMk~STBE->vNFBy zV7KD+GP0E~46$1D(h`5XR4kQFV6`L*Zrpv)h|bLzZS52d`+>Qi{+(9NMN~ z0EkD3qtPe})lwgEvXg!xk&Z8?V{w*`4F65P|Gm9YcMwS?lcE5XdTG1n^`PIyCOFM> zAUpg=D?IG%dhay4gI)j~Bag8VTS<#TI+6HaQx9N?d?YLHJqUlDo%$erGW6KYbZGUP z$KU%ZtdfruKKvW`PWkrYD;tgdJ$|DW!Y4w--uaOcce zg0Ofpc{;d`ZZEl^eQ|-|#N-l~>NTvi0@kKm*mOZmAcg~VDM50%@;bwTn2G_%xy6DC zS>2TEBF}>;B!KmC#bLYD@hAuJl@xF$%riWyabUZH{?4EeH0BCDP737DocRI+oC9tU zCM*HlZuI(%?HWe#%-)-8xoHY88hm4Gs=N+qB^BXxhyiu+5Mpp(;nkyYPlq@mcGwxu za0$>&Y-R7x)@P@}4AHKaP=0#7jPi+6k<4tJo1w!zR)yRwrSaUTzd@$UkuwNUvsLw~ zWIH@?0!xFZ-dXlKsjoYS7A% zwJJ9iBtR4=!}9o$VbwXy$T)7=8n~G1T-A&mkYB57m=^V(C7NeG#h8|RfLNiC4v@QE z{&{q3`WAj8hU3OSHgu=p+LDPE5XPt7Q z?8J#vbPP*Am>ff_#&eT-S!3PMvo>9+i5wdjo!(DwH_iHARDCOPY.;11 104907 +(FILECREATED "24-Sep-2023 15:25:20" {WMEDLEY}HARDCOPY.;13 105614 :EDIT-BY rmk - :CHANGES-TO (FNS MakeMenuOfPrinters) + :CHANGES-TO (FNS CONVERT.FILE.TO.TYPE.FOR.PRINTER) - :PREVIOUS-DATE " 3-Mar-2023 23:49:09" {WMEDLEY}HARDCOPY.;10) + :PREVIOUS-DATE "14-Sep-2023 22:58:42" {WMEDLEY}HARDCOPY.;12) (* ; " @@ -365,8 +365,31 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. ) (CONVERT.FILE.TO.TYPE.FOR.PRINTER -(LAMBDA (FILE FILETYPE PRINTERTYPE HEADING PRINTOPTIONS) (* ; "Edited 29-Dec-88 15:39 by jds") (* ;; "Convert FILE to the kind of hardcopy file (Interpress, Press, 4045HQ, etc) appropriate to PRINTERTYPE.") (SETQ FILETYPE (OR FILETYPE (QUOTE TEXT))) (PROG ((SCRATCH (CLOSEF (OPENFILE (PRINTER.SCRATCH.FILE FILE PRINTERTYPE) (QUOTE OUTPUT) (QUOTE NEW))))) (* ; "Doing the open & close gets us a guaranteed version number, so that all files are truly unique.") (APPLY* (OR (LISTGET (PRINTERPROP PRINTERTYPE (QUOTE CONVERSION)) FILETYPE) (for CANPRINT in (PRINTERPROP PRINTERTYPE (QUOTE CANPRINT)) bind CONVERTER when (SETQ CONVERTER (LISTGET (PRINTFILEPROP CANPRINT (QUOTE CONVERSION)) FILETYPE)) do (RETURN CONVERTER)) (ERROR (CONCAT "Can't convert a " FILETYPE " for a " PRINTERTYPE " printer") (FULLNAME FILE))) FILE SCRATCH (LISTGET PRINTOPTIONS (QUOTE FONTS)) HEADING NIL PRINTOPTIONS) (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (SCRATCH) (CLOSEF? SCRATCH) (DELFILE SCRATCH))) SCRATCH)) (RETURN SCRATCH))) -) + [LAMBDA (FILE FILETYPE PRINTERTYPE HEADING PRINTOPTIONS) (* ; "Edited 24-Sep-2023 15:25 by rmk") + (* ; "Edited 14-Sep-2023 22:58 by rmk") + (* ; "Edited 29-Dec-88 15:39 by jds") + + (* ;; "Convert FILE to the kind of hardcopy file (Interpress, Press, 4045HQ, etc) appropriate to PRINTERTYPE.") + + (SETQ FILETYPE (OR FILETYPE 'TEXT)) + (PROG [(SCRATCH (CLOSEF (OPENSTREAM (PRINTER.SCRATCH.FILE FILE PRINTERTYPE) + 'OUTPUT + 'NEW] (* ; + "Doing the open & close gets us a guaranteed version number, so that all files are truly unique.") + (APPLY* (OR (LISTGET (PRINTERPROP PRINTERTYPE 'CONVERSION) + FILETYPE) + (for CANPRINT in (PRINTERPROP PRINTERTYPE 'CANPRINT) bind CONVERTER + when (SETQ CONVERTER (LISTGET (PRINTFILEPROP CANPRINT 'CONVERSION) + FILETYPE)) do (RETURN CONVERTER)) + (ERROR (CONCAT "Can't convert a " FILETYPE " for a " PRINTERTYPE " printer") + (FULLNAME FILE))) + FILE SCRATCH (LISTGET PRINTOPTIONS 'FONTS) + HEADING NIL PRINTOPTIONS) + (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (SCRATCH) + (CLOSEF? SCRATCH) + (DELFILE SCRATCH] + SCRATCH)) + (RETURN SCRATCH]) (EMPRESS (LAMBDA (FILE %#COPIES HOST HEADING %#SIDES PRINTOPTIONS) (* ; "Edited 26-Aug-87 14:17 by Snow") (SEND.FILE.TO.PRINTER FILE HOST (NCONC (COND (HEADING (LIST (QUOTE HEADING) HEADING))) (COND (%#COPIES (LIST (QUOTE %#COPIES) %#COPIES))) (COND (%#SIDES (LIST (QUOTE %#SIDES) %#SIDES))) PRINTOPTIONS))) @@ -1102,40 +1125,40 @@ Copyright (c) 1984-1993, 1999, 2018, 2021-2022 by Venue & Xerox Corporation. (PUTPROPS HARDCOPY COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1999 2018 2021 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6322 11088 (HARDCOPY.SOMEHOW 6332 . 7690) (HARDCOPYIMAGEW 7692 . 7844) ( -HARDCOPYIMAGEW.TOFILE 7846 . 8154) (HARDCOPYIMAGEW.TOPRINTER 8156 . 9403) (HARDCOPYREGION.TOFILE 9405 - . 9703) (HARDCOPYREGION.TOPRINTER 9705 . 10327) (COPY.WINDOW.TO.BITMAP 10329 . 11086)) (11160 22017 ( -MakeMenuOfPrinters 11170 . 12702) (PRINTERS.WHENSELECTEDFN 12704 . 14446) (MakeMenuOfImageTypes 14448 - . 14966) (GetNewPrinterFromUser 14968 . 15396) (PopUpWindowAndGetAtom 15398 . 16783) ( -PopUpWindowAndGetList 16785 . 18351) (NewPrinter 18353 . 19301) (GetPrinterName 19303 . 19583) ( -GetImageFile 19585 . 21872) (FetchDefaultPrinter 21874 . 22015)) (22052 22590 ( -ExtensionForPrintFileType 22062 . 22255) (PRINTFILETYPE.FROM.EXTENSION 22257 . 22588)) (22645 39029 ( -DEFAULTPRINTER 22655 . 22815) (CAN.PRINT.DIRECTLY 22817 . 22973) (CONVERT.FILE.TO.TYPE.FOR.PRINTER -22975 . 24019) (EMPRESS 24021 . 24334) (HARDCOPYW 24336 . 27296) (LISTFILES1 27298 . 27471) ( -PRINTER.BITMAPFILE 27473 . 27720) (PRINTER.BITMAPSCALE 27722 . 27987) (PRINTER.SCRATCH.FILE 27989 . -28112) (PRINTERPROP 28114 . 28297) (PRINTERSTATUS 28299 . 28488) (PRINTERTYPE 28490 . 30799) ( -PRINTERNAME 30801 . 31103) (PRINTFILEPROP 31105 . 31296) (PRINTFILETYPE 31298 . 33242) ( -\EXPECTED.FILE.TYPE 33244 . 34026) (SEND.FILE.TO.PRINTER 34028 . 39027)) (39030 44012 (PRINTERDEVICE -39040 . 44010)) (44847 53086 (TEXTTOIMAGEFILE 44857 . 47047) (COPY.TEXT.TO.IMAGE 47049 . 53084)) ( -53087 54222 (\BLTSHADE.GENERICPRINTER 53097 . 54220)) (54350 73102 (MAKEHARDCOPYSTREAM 54360 . 55364) -(UNMAKEHARDCOPYSTREAM 55366 . 56050) (HARDCOPYSTREAMTYPE 56052 . 56331) (\CHARWIDTH.HDCPYDISPLAY 56333 - . 56764) (\DSPFONT.HDCPYDISPLAY 56766 . 58171) (\DSPRIGHTMARGIN.HDCPYDISPLAY 58173 . 58750) ( -\DSPXPOSITION.HDCPYDISPLAY 58752 . 59013) (\DSPYPOSITION.HDCPYDISPLAY 59015 . 59276) ( -\STRINGWIDTH.HDCPYDISPLAY 59278 . 59785) (\STRINGWIDTH.HCPYDISPLAYAUX 59787 . 62119) (\HDCPYBLTCHAR -62121 . 64656) (\HDCPYDISPLAY.FIX.XPOS 64658 . 65078) (\HDCPYDISPLAY.FIX.YPOS 65080 . 65500) ( -\HDCPYDISPLAYINIT 65502 . 66279) (\HDCPYDSPPRINTCHAR 66281 . 68441) (\SLOWHDCPYBLTCHAR 68443 . 71946) -(\CHANGECHARSET.HDCPYDISPLAY 71948 . 73100)) (73603 73744 (\MICASTOPTS 73603 . 73744)) (73915 104212 ( -MAKEHARDCOPYMODESTREAM 73925 . 75834) (UNMAKEHARDCOPYMODESTREAM 75836 . 76914) (\BLTSHADE.HCPYMODE -76916 . 77363) (\BITBLT.HCPYMODE 77365 . 77987) (\BRUSHCONVERT.HCPYMODE 77989 . 78226) ( -\CHANGECHARSET.HCPYMODE 78228 . 79995) (\DASHINGCONVERT.HCPYMODE 79997 . 80260) (\CHARWIDTH.HCPYMODE -80262 . 80549) (\DRAWLINE.HCPYMODE 80551 . 80863) (\DRAWCURVE.HCPYMODE 80865 . 81294) ( -\DRAWCIRCLE.HCPYMODE 81296 . 81691) (\DRAWELLIPSE.HCPYMODE 81693 . 82205) (\DSPFONT.HCPYMODE 82207 . -83363) (\DSPLEFTMARGIN.HCPYMODE 83365 . 83949) (\DSPLINEFEED.HCPYMODE 83951 . 84361) ( -\DSPRIGHTMARGIN.HCPYMODE 84363 . 84992) (\DSPSPACEFACTOR.HCPYMODE 84994 . 85515) ( -\DSPXPOSITION.HCPYMODE 85517 . 86098) (\DSPYPOSITION.HCPYMODE 86100 . 86505) (\MOVETO.HCPYMODE 86507 - . 86659) (\FONTCREATE.HCPYMODE.PRESS 86661 . 87673) (\CREATECHARSET.HCPYMODE.PRESS 87675 . 88646) ( -\FONTCREATE.HCPYMODE.INTERPRESS 88648 . 89682) (\CREATECHARSET.HCPYMODE.INTERPRESS 89684 . 90672) ( -\STRINGWIDTH.HCPYMODE 90674 . 91108) (\HCPYMODEBLTCHAR 91110 . 94079) (\HCPYMODEDISPLAYINIT 94081 . -97012) (\HCPYMODEDSPPRINTCHAR 97014 . 99195) (\SLOWHCPYMODEBLTCHAR 99197 . 102711) (\SFFixY.HCPYMODE -102713 . 104210))))) + (FILEMAP (NIL (6336 11102 (HARDCOPY.SOMEHOW 6346 . 7704) (HARDCOPYIMAGEW 7706 . 7858) ( +HARDCOPYIMAGEW.TOFILE 7860 . 8168) (HARDCOPYIMAGEW.TOPRINTER 8170 . 9417) (HARDCOPYREGION.TOFILE 9419 + . 9717) (HARDCOPYREGION.TOPRINTER 9719 . 10341) (COPY.WINDOW.TO.BITMAP 10343 . 11100)) (11174 22031 ( +MakeMenuOfPrinters 11184 . 12716) (PRINTERS.WHENSELECTEDFN 12718 . 14460) (MakeMenuOfImageTypes 14462 + . 14980) (GetNewPrinterFromUser 14982 . 15410) (PopUpWindowAndGetAtom 15412 . 16797) ( +PopUpWindowAndGetList 16799 . 18365) (NewPrinter 18367 . 19315) (GetPrinterName 19317 . 19597) ( +GetImageFile 19599 . 21886) (FetchDefaultPrinter 21888 . 22029)) (22066 22604 ( +ExtensionForPrintFileType 22076 . 22269) (PRINTFILETYPE.FROM.EXTENSION 22271 . 22602)) (22659 39736 ( +DEFAULTPRINTER 22669 . 22829) (CAN.PRINT.DIRECTLY 22831 . 22987) (CONVERT.FILE.TO.TYPE.FOR.PRINTER +22989 . 24726) (EMPRESS 24728 . 25041) (HARDCOPYW 25043 . 28003) (LISTFILES1 28005 . 28178) ( +PRINTER.BITMAPFILE 28180 . 28427) (PRINTER.BITMAPSCALE 28429 . 28694) (PRINTER.SCRATCH.FILE 28696 . +28819) (PRINTERPROP 28821 . 29004) (PRINTERSTATUS 29006 . 29195) (PRINTERTYPE 29197 . 31506) ( +PRINTERNAME 31508 . 31810) (PRINTFILEPROP 31812 . 32003) (PRINTFILETYPE 32005 . 33949) ( +\EXPECTED.FILE.TYPE 33951 . 34733) (SEND.FILE.TO.PRINTER 34735 . 39734)) (39737 44719 (PRINTERDEVICE +39747 . 44717)) (45554 53793 (TEXTTOIMAGEFILE 45564 . 47754) (COPY.TEXT.TO.IMAGE 47756 . 53791)) ( +53794 54929 (\BLTSHADE.GENERICPRINTER 53804 . 54927)) (55057 73809 (MAKEHARDCOPYSTREAM 55067 . 56071) +(UNMAKEHARDCOPYSTREAM 56073 . 56757) (HARDCOPYSTREAMTYPE 56759 . 57038) (\CHARWIDTH.HDCPYDISPLAY 57040 + . 57471) (\DSPFONT.HDCPYDISPLAY 57473 . 58878) (\DSPRIGHTMARGIN.HDCPYDISPLAY 58880 . 59457) ( +\DSPXPOSITION.HDCPYDISPLAY 59459 . 59720) (\DSPYPOSITION.HDCPYDISPLAY 59722 . 59983) ( +\STRINGWIDTH.HDCPYDISPLAY 59985 . 60492) (\STRINGWIDTH.HCPYDISPLAYAUX 60494 . 62826) (\HDCPYBLTCHAR +62828 . 65363) (\HDCPYDISPLAY.FIX.XPOS 65365 . 65785) (\HDCPYDISPLAY.FIX.YPOS 65787 . 66207) ( +\HDCPYDISPLAYINIT 66209 . 66986) (\HDCPYDSPPRINTCHAR 66988 . 69148) (\SLOWHDCPYBLTCHAR 69150 . 72653) +(\CHANGECHARSET.HDCPYDISPLAY 72655 . 73807)) (74310 74451 (\MICASTOPTS 74310 . 74451)) (74622 104919 ( +MAKEHARDCOPYMODESTREAM 74632 . 76541) (UNMAKEHARDCOPYMODESTREAM 76543 . 77621) (\BLTSHADE.HCPYMODE +77623 . 78070) (\BITBLT.HCPYMODE 78072 . 78694) (\BRUSHCONVERT.HCPYMODE 78696 . 78933) ( +\CHANGECHARSET.HCPYMODE 78935 . 80702) (\DASHINGCONVERT.HCPYMODE 80704 . 80967) (\CHARWIDTH.HCPYMODE +80969 . 81256) (\DRAWLINE.HCPYMODE 81258 . 81570) (\DRAWCURVE.HCPYMODE 81572 . 82001) ( +\DRAWCIRCLE.HCPYMODE 82003 . 82398) (\DRAWELLIPSE.HCPYMODE 82400 . 82912) (\DSPFONT.HCPYMODE 82914 . +84070) (\DSPLEFTMARGIN.HCPYMODE 84072 . 84656) (\DSPLINEFEED.HCPYMODE 84658 . 85068) ( +\DSPRIGHTMARGIN.HCPYMODE 85070 . 85699) (\DSPSPACEFACTOR.HCPYMODE 85701 . 86222) ( +\DSPXPOSITION.HCPYMODE 86224 . 86805) (\DSPYPOSITION.HCPYMODE 86807 . 87212) (\MOVETO.HCPYMODE 87214 + . 87366) (\FONTCREATE.HCPYMODE.PRESS 87368 . 88380) (\CREATECHARSET.HCPYMODE.PRESS 88382 . 89353) ( +\FONTCREATE.HCPYMODE.INTERPRESS 89355 . 90389) (\CREATECHARSET.HCPYMODE.INTERPRESS 90391 . 91379) ( +\STRINGWIDTH.HCPYMODE 91381 . 91815) (\HCPYMODEBLTCHAR 91817 . 94786) (\HCPYMODEDISPLAYINIT 94788 . +97719) (\HCPYMODEDSPPRINTCHAR 97721 . 99902) (\SLOWHCPYMODEBLTCHAR 99904 . 103418) (\SFFixY.HCPYMODE +103420 . 104917))))) STOP diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM index ace4369d8e170d5b702c796e511ecb2f70613252..b77be8b8165ebd7621ece9d1847689fc58129bc5 100644 GIT binary patch delta 285 zcmbREk!jIKrU?!W9R)%I1v-RtZH5Is&jF2Twt&GgAOe~cY zN|N()3v$#`6f*M^l-xpnd=!w?>FMbyDWoKpq^2lf(Qj&|q{*e>=IP_=9OUX4;_8B_ z2xyOi(!?4$4xob!Ow9~UCfhSAOrB(^psA@~6%gba=II|Atm^{Qte|9wj7F2UGuAVkTNq8YWJ&_l^O*cV^yc?W7v$N3LxA@CZa%COB*JWNX|P$s Pd_NnIVYvC0?e;1F-sVcG delta 294 zcmZ4Vk!j*brU?r0iv-Rr@H5Is&jEoSHM#fgAmR5%5 zN(v>(`MCu->M07Dc?wEyp*}te$m;a;^pq4*5=&B36tL(wGFH;$(s1+iadi%IbqsNJ zK~-dEZe?s}Wo)4|u||%=P{Gi^#L~cgvOS}Mg>PbZs&8susef8PQD$CAYEiMKf>l6} zYnZ2hXt1se&?p5Z1!G;`#3G1afX+3sv@)=qSS`l`J+q;q#bghrBrv^}$qz(t j{>OAdo(1HZ%~zCyM3@bY%rkaplan>Local>medley3.5>working-medley>sources>PRINTFN.;34 13484 +(FILECREATED "14-Sep-2023 22:53:09" {WMEDLEY}PRINTFN.;35 13520 - :CHANGES-TO (FNS PFCOPYBYTES) + :EDIT-BY rmk - :PREVIOUS-DATE "15-Mar-2022 00:20:04" -{DSK}kaplan>Local>medley3.5>working-medley>sources>PRINTFN.;33) + :CHANGES-TO (FNS PF) + + :PREVIOUS-DATE "19-Jun-2022 00:02:19" {WMEDLEY}PRINTFN.;34) (* ; " @@ -31,50 +31,51 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (PF - [NLAMBDA FN (* ; "Edited 4-Apr-2018 11:13 by rmk:") + [NLAMBDA FN (* ; "Edited 14-Sep-2023 22:52 by rmk") + (* ; "Edited 4-Apr-2018 11:13 by rmk:") - (* ;; "RMK; Fixed to skip compiled files, also to use FUNCTIONS as well as FNS. That might not help, if FUNCTIONS are not included in the filemap.") + (* ;; "RMK; Fixed to skip compiled files, also to use FUNCTIONS as well as FNS. That might not help, if FUNCTIONS are not included in the filemap.") - (* ;; "Print from files known to masterscope database before looking at whereis database. Note, however, that it also prefers the masterscope database to incore files") + (* ;; "Print from files known to masterscope database before looking at whereis database. Note, however, that it also prefers the masterscope database to incore files") - (* ;; "If FN is NIL, prints the function named by LASTWORD") + (* ;; "If FN is NIL, prints the function named by LASTWORD") - (* ;; "If FN is a list, then extra args are interpreted as:") + (* ;; "If FN is a list, then extra args are interpreted as:") - (* ;; " OUTPUT FILE") + (* ;; " OUTPUT FILE") - (* ;; "...") + (* ;; "...") (RESETLST (PROG (OUT OTHERARGS IFILES) - (SETQ FN (NLAMBDA.ARGS FN)) (* ; "Grab the args as a list") + (SETQ FN (NLAMBDA.ARGS FN)) (* ; "Grab the args as a list") [COND - ((LISTP FN) (* ; - "If it's a list, take the first element as the function name.") + ((LISTP FN) (* ; + "If it's a list, take the first element as the function name.") (SETQ OTHERARGS (CDR FN)) (SETQ FN (CAR FN] (COND - (FN (* ; "FN name specified; use it.") + (FN (* ; "FN name specified; use it.") (SETQ LASTWORD FN)) - (T (* ; "Not specified, use LASTWORD") + (T (* ; "Not specified, use LASTWORD") (SETQ FN LASTWORD))) [SETQ IFILES (OR (CAR OTHERARGS) (APPEND (WHEREIS FN 'FNS T) (WHEREIS FN 'FUNCTIONS T] [RESETSAVE (OUTPUT (COND - ((CADR OTHERARGS) (* ; - "An output file was specified; if not open for output, open it.") + ((CADR OTHERARGS) (* ; + "An output file was specified; if not open for output, open it.") (OR (OPENP (CADR OTHERARGS) 'OUTPUT) (WINDOWP (CADR OTHERARGS)) - (PROGN [RESETSAVE (SETQ OUT (OPENFILE (CADR OTHERARGS) + (PROGN [RESETSAVE (SETQ OUT (OPENSTREAM (CADR OTHERARGS) 'OUTPUT)) '(PROGN (CLOSEF? OLDVALUE] OUT))) - (T (* ; "otherwise, use primary output.") - T] (* ; "skip compiled files") + (T (* ; "otherwise, use primary output.") + T] (* ; "skip compiled files") (FOR FILE INSIDE IFILES UNLESS (MEMB (FILENAMEFIELD FILE 'EXTENSION) - *COMPILED-EXTENSIONS*) + *COMPILED-EXTENSIONS*) DO (PRINTFN FN FILE))))]) (PF* @@ -288,6 +289,6 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation. ) (PUTPROPS PRINTFN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1999 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1115 11618 (PF 1125 . 3820) (PF* 3822 . 4116) (PRINTFN 4118 . 4688) (PRINTFNDEF 4690 . -5873) (FINDFNDEF 5875 . 7247) (PFCOPYBYTES 7249 . 11368) (DISPLAYP 11370 . 11616))))) + (FILEMAP (NIL (1044 11654 (PF 1054 . 3856) (PF* 3858 . 4152) (PRINTFN 4154 . 4724) (PRINTFNDEF 4726 . +5909) (FINDFNDEF 5911 . 7283) (PFCOPYBYTES 7285 . 11404) (DISPLAYP 11406 . 11652))))) STOP diff --git a/sources/PRINTFN.LCOM b/sources/PRINTFN.LCOM index 50686fc3e4f30cb46888515156095242e95efdf0..cde90dd385047814b92ceeaf2e5a9ed7f6537808 100644 GIT binary patch delta 336 zcmZ3ju~vOTM7@b_aB6|Bk%5u1f{~Gxsj-!TrILb%QgVK7L1s>Bib8&#f|5dYxUZ{= zk85PDO>ur{QF3arT|khhUx=HZp0%;5rUI9eA*wM(W>&^VN(xCusc>^rD+-E=Rjm{P z+!Qi_M!JRi_$UB%)x&Mq)6-K@NJ%UK+KJ6LOC?P%4L468SLYyC#}HQ+3`J0<<8`Wn zp|Povfr6E*i)Vo)bGh-49o>-t?h SS6Tf~-_-s(cXhuvJ@^Gx7L5P^ From cb8eab788af06b3efb4f0d1477b0e182d7769375 Mon Sep 17 00:00:00 2001 From: Matt Heffron Date: Tue, 17 Oct 2023 23:40:26 -0700 Subject: [PATCH 30/37] Modify launcher to enable --title STRING option to work when STRING has embedded spaces (multiple words). --- run-medley | 4 +++- scripts/medley/medley.command | 2 +- scripts/medley/medley_args.sh | 4 +++- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/run-medley b/run-medley index 05f5c395..63862ca3 100755 --- a/run-medley +++ b/run-medley @@ -113,7 +113,9 @@ while [ "$#" -ne 0 ]; do shift ;; -title) - title="$2" + if [ -n "$2" ] ; then + title="$2" + fi shift ;; -vmem | --vmem | -vmfile) diff --git a/scripts/medley/medley.command b/scripts/medley/medley.command index 3fb17e22..14b922a3 100755 --- a/scripts/medley/medley.command +++ b/scripts/medley/medley.command @@ -139,7 +139,7 @@ mkdir -p ${LOGINDIR}/vmem if [[ ( ${darwin} = true ) || (( ${wsl} = false || ${use_vnc} = false ) && ${docker} = false) ]]; then # If not using vnc, just call run-medley - ${MEDLEYDIR}/run-medley -id "${run_id}" ${geometry} ${screensize} ${run_args[@]} + ${MEDLEYDIR}/run-medley -id "${run_id}" -title "${title}" ${geometry} ${screensize} ${run_args[@]} else # do the vnc thing on wsl or docker source ${SCRIPTDIR}/medley_vnc.sh diff --git a/scripts/medley/medley_args.sh b/scripts/medley/medley_args.sh index 6687ad7a..f78b7e8a 100755 --- a/scripts/medley/medley_args.sh +++ b/scripts/medley/medley_args.sh @@ -28,6 +28,7 @@ run_id="default" screensize="" sysout_flag=false sysout_arg="" +title="" use_vnc=false windows=false @@ -112,7 +113,8 @@ do ;; -t | --title) check_for_dash_or_end "$1" "$2" - run_args+=(-title $2) + #run_args+=(-title $2) + title="$2" shift ;; -v | --vnc) From fbb5a8f6f565c58002796354875188135cd388b9 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Wed, 18 Oct 2023 07:38:27 -0700 Subject: [PATCH 31/37] Expose useful subfunctions in REGIONMANAGER (#1336) * Expose useful subfunctions * REGISTER-TYPED-REGION creates a new TYPED-REGIONS entry If a window is closed whose region is of an as-yet-unknown type, a new entry will be added implicitly to TYPED-REGIONS to that that region and future regions of that type can be recycled. * If a window with a typed-region is reshaped and then closed, the typed-region is also reshaped for reuse Also, the typed-region of a window is pushed on the front of the TYPED-REGIONS list when the window is closed, so the most recent region of that type will be used the next time. Recency seems more intuitive than primacy --- lispusers/REGIONMANAGER | 233 ++++++++++++++++++++-------------- lispusers/REGIONMANAGER.LCOM | Bin 9115 -> 9480 bytes lispusers/REGIONMANAGER.TEDIT | 43 ++++--- 3 files changed, 158 insertions(+), 118 deletions(-) diff --git a/lispusers/REGIONMANAGER b/lispusers/REGIONMANAGER index 0e05334e..463a38c9 100644 --- a/lispusers/REGIONMANAGER +++ b/lispusers/REGIONMANAGER @@ -1,12 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "27-Feb-2022 08:48:09"  -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;116 37561 +(FILECREATED "10-Oct-2023 22:19:05" {WMEDLEY}REGIONMANAGER.;129 40525 - :CHANGES-TO (FNS \RELCREATEREGION.REF \RELCREATEREGION.SIZE) + :EDIT-BY rmk - :PREVIOUS-DATE "28-Jan-2022 23:52:21" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>REGIONMANAGER.;113) + :PREVIOUS-DATE "10-Oct-2023 22:17:47" {MEDLEY}REGIONMANAGER.;9) (PRETTYCOMPRINT REGIONMANAGERCOMS) @@ -15,12 +13,12 @@ [ (* ;; "Typed regions") - [COMS (FNS SET-TYPED-REGIONS) + [COMS (FNS SET-TYPED-REGIONS GRAB-TYPED-REGION REGISTER-TYPED-REGION REGION-TYPE) (FNS RM-CREATEW RM-CLOSEW RM-GETREGION CLOSE-TYPED-W) (INITVARS (TYPED-REGIONS)) (GLOBALVARS TYPED-REGIONS) - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TYPED-REGION REGION-SOURCE)) - (INITRECORDS TYPED-REGION REGION-SOURCE) + (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TYPED-REGION)) + (INITRECORDS TYPED-REGION) (P (MOVD? 'CREATEW 'CREATEW.ORIG) (MOVD? 'CLOSEW 'CLOSEW.ORIG) (MOVD? 'GETREGION 'GETREGION.ORIG) @@ -86,120 +84,170 @@ REGIONS (NCONC REGIONS (CDR PREV)))] else (push TYPED-REGIONS (CONS TYPE REGIONS]) + +(GRAB-TYPED-REGION + [LAMBDA (REGION-TYPE MINWIDTH MINHEIGHT) (* ; "Edited 10-Oct-2023 13:41 by rmk") + (* ; "Edited 14-Sep-2023 07:30 by rmk") + + (* ;; "Returns a REGIONTYPE region that satisfies MINWIDTH and MINHEIGHT, if specified") + + (for R in (CDR (ASSOC REGION-TYPE TYPED-REGIONS)) unless (fetch REGION-INUSE of R) + when [AND (OR (NULL MINWIDTH) + (ILEQ MINWIDTH (fetch WIDTH of R))) + (OR (NULL MINHEIGHT) + (ILEQ MINHEIGHT (fetch HEIGHT of R] do + + (* ;; "We don't mark it as inuse here, leave that gets done by INSTALL-TYPED-REGION when ownership is given to a window. The only downside is that the region could be reallocated before that happens, and 2 window would come up in the same place.") + + (RETURN R]) + +(REGISTER-TYPED-REGION + [LAMBDA (REGION REGION-TYPE WINDOW) (* ; "Edited 10-Oct-2023 13:30 by rmk") + (* ; "Edited 29-Sep-2023 13:33 by rmk") + (* ; "Edited 14-Sep-2023 10:03 by rmk") + + (* ;; "REGION was passed as the REGION argument to the original CREATEW. If that was NIL, CREATEW created its own region, but it didn't do it through GETREGION (=RM.GETREGION) so it hasn't been registered according to the specified type. We set up the arrangements here. ") + + (CL:WHEN REGION-TYPE + (CL:UNLESS REGION + (SETQ REGION (WINDOWREGION WINDOW))) + (LET [(TREGIONLIST (OR (ASSOC REGION-TYPE TYPED-REGIONS) + (CAR (PUSH TYPED-REGIONS (CONS REGION-TYPE] + (CL:UNLESS (MEMB REGION (CDR TREGIONLIST)) + (NCONC1 TREGIONLIST REGION)) + (replace REGION-INUSE of REGION with T) + + (* ;; "We keep the original separate from the window's region WINDOWPROP so that RM-CLOSEW can update if the user reshapes.") + + (WINDOWPROP WINDOW 'TYPED-REGION (CONS REGION-TYPE REGION)) + REGION))]) + +(REGION-TYPE + [LAMBDA (X TYPE) (* ; "Edited 10-Oct-2023 14:30 by rmk") + (* ; "Edited 16-Sep-2023 08:41 by rmk") + + (* ;; + "Value is the type of X if it is a region of type TYPE or a region of any type if TYPE is NIL.") + + (CL:WHEN (REGIONP X) + [if TYPE + then (CL:WHEN (MEMB X (CDR (ASSOC TYPE TYPED-REGIONS))) + TYPE) + else (CAR (find TYPELIST in TYPED-REGIONS suchthat (MEMB X TYPELIST])]) ) (DEFINEQ (RM-CREATEW - [LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS) (* ; "Edited 1-Jan-2022 23:12 by rmk") + [LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS) (* ; "Edited 24-Sep-2023 20:38 by rmk") + (* ; "Edited 14-Sep-2023 22:23 by rmk") + (* ; "Edited 1-Jan-2022 23:12 by rmk") (* ; "Edited 29-Dec-2021 19:25 by rmk") - (* ;; "Generic CREATEW function for managed regions. If REGIONTYPE is specified (as REGION or in PROPS), then we try to find a previous region for that type that is currently unused, create one if needed.") + (* ;; "Generic CREATEW function for managed regions. If REGION-TYPE is specified (as REGION or in PROPS), then we try to find a previous region for that type that is currently unused, create one if needed.") (* ;; "We have to bracket the original window creation because the we have to mark that the window uses that region, to put it back in the pool when the window is closed.") - (LET (WINDOW REGIONTYPE TYPEDREGION TYPELIST) - [SETQ REGIONTYPE (if (AND REGION (LITATOM REGION)) - then (PROG1 REGION (SETQ REGION NIL)) - else (LISTGET PROPS 'REGION-TYPE] - (SETQ TYPELIST (ASSOC REGIONTYPE TYPED-REGIONS)) + (LET [WINDOW (REGION-TYPE (if (AND (LITATOM REGION) + REGION) + then (PROG1 REGION (SETQ REGION NIL)) + else (LISTGET PROPS 'REGION-TYPE] - (* ;; "We have REGIONTYPE, but maybe also a region that already has a source. Maybe we should make sure that the source is of that type?") + (* ;; "We have REGION-TYPE, but maybe also a region that already has a source. Maybe we should make sure that the source is of that type?") (* ;; "Note: REGION can also be a screenregion, that falls through.") - (IF (REGIONP REGION) - THEN (SETQ TYPEDREGION (FETCH REGION-SOURCE OF REGION)) - ELSEIF TYPELIST - THEN - (* ;; - "If we don't find an unused region, CREATEW will create one in the ordinary way. We type it below.") - - [SETQ TYPEDREGION (FIND R FOUND in (CDR TYPELIST) - SUCHTHAT (NOT (fetch REGION-INUSE of R] - (SETQ REGION TYPEDREGION)) + (CL:WHEN REGION-TYPE + (SETQ REGION (GRAB-TYPED-REGION REGION-TYPE))) (SETQ WINDOW (CREATEW.ORIG REGION TITLE BORDERSIZE NOOPENFLG PROPS)) - - (* ;; "CREATEW doesn't call the user-entry GETREGION, so we have to trap and install its return region here.") - - (CL:WHEN (AND TYPELIST (NULL TYPEDREGION)) (* ; - "If not, we don't record this even if typed.") - (SETQ TYPEDREGION (OR (FETCH REGION-SOURCE OF (SETQ REGION (WINDOWREGION WINDOW))) - (COPY REGION))) - (NCONC1 TYPELIST TYPEDREGION)) - (CL:WHEN TYPEDREGION - (replace REGION-INUSE of TYPEDREGION with T) - (WINDOWPROP WINDOW 'TYPED-REGION TYPEDREGION) - (WINDOWPROP WINDOW 'REGION-TYPE REGIONTYPE)) + (CL:WHEN REGION-TYPE (REGISTER-TYPED-REGION REGION REGION-TYPE WINDOW)) WINDOW]) (RM-CLOSEW - [LAMBDA (WINDOW) (* ; "Edited 29-Dec-2021 15:44 by rmk") - (* ; "Edited 28-Dec-2021 11:02 by rmk") - (* ; "Edited 27-Nov-2021 10:00 by rmk:") - (* ; "Edited 26-Oct-2021 21:54 by rmk:") - (* ; - "Edited 25-Apr-94 10:08 by sybalsky") - (* ; "") + [LAMBDA (WINDOW) (* ; "Edited 10-Oct-2023 22:11 by rmk") (* ;;  "Makes the window's typed region available for reuse, if the window is marked with a TYPEDREGION.") (* ;; "It's possible that the window exists and can be reopened after it has been closed. The glitch in that case is that we may have decided to make the window's region available to another window, and if this window is opened again it will come on top of that other one (if it hasn't moved). Oh well.") - (LET [(TYPEDREGION (WINDOWPROP WINDOW 'TYPED-REGION] - (CL:WHEN (AND (CLOSEW.ORIG WINDOW) - TYPEDREGION) - (REPLACE REGION-INUSE OF TYPEDREGION WITH NIL) - (WINDOWPROP WINDOW 'TYPED-REGION NIL) - T)]) + (* ;; "This replaces the particular typed-region in TYPED-REGIONS with the region that the window ended up with, perhaps after the user reshaped it. But (WINDOWPROP WINDOW 'REGION) doesn't include the prompt window, if it's there, and (WINDOWREGION WINDOW) would union in all of the attached windows (menus etc.) This code assumes that the promptwindow was taken out of the original region (lots of funky code does that), so it unions it back in to the REGION property to reconstruct the original typed-region. The alternative would be to have the windows region copy the original grabbed region and restore only that. But then we would be ignoring any reshaping adjustments.") + + (LET* [CLOSEVAL (TYPEDREGION (WINDOWPROP WINDOW 'TYPED-REGION)) + (REGIONTYPE (CAR TYPEDREGION)) + (TREGION (CDR TYPEDREGION)) + [PWINDOW (WINDOWP (CAR (MKLIST (WINDOWPROP WINDOW 'PROMPTWINDOW] + [WREGION (CL:IF PWINDOW + (UNIONREGIONS (WINDOWPROP WINDOW 'REGION) + (WINDOWPROP PWINDOW 'REGION)) + (WINDOWPROP WINDOW 'REGION))] + (TREGIONLIST (AND REGIONTYPE (OR (ASSOC REGIONTYPE TYPED-REGIONS) + (CAR (PUSH TYPED-REGIONS (CONS REGIONTYPE] + (CL:WHEN (AND (SETQ CLOSEVAL (CLOSEW.ORIG WINDOW)) + TYPEDREGION) + (CL:UNLESS (EQUAL TREGION WREGION) + + (* ;; "The user reshaped the window after the region was taken from TYPED-REGIONS. Assume that the new shape is what should be offered when this is recycled. Important to keep the same structure") + + (with REGION TREGION (SETQ LEFT (fetch (REGION LEFT) of WREGION)) + (SETQ BOTTOM (fetch (REGION BOTTOM) of WREGION)) + (SETQ WIDTH (fetch (REGION WIDTH) of WREGION)) + (SETQ HEIGHT (fetch (REGION HEIGHT) of WREGION)))) + + (* ;; "Move TREGION to the front so most recently closed will be recycled first") + + (CL:WHEN TREGIONLIST + (change (CDR TREGIONLIST) + (CONS TREGION (DREMOVE TREGION DATUM)))) + (replace REGION-INUSE of TREGION with NIL) + (WINDOWPROP WINDOW 'TYPED-REGION NIL)) + CLOSEVAL]) (RM-GETREGION - [LAMBDA (MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS) + [LAMBDA (MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG INITCORNERS) + (* ; "Edited 10-Oct-2023 12:39 by rmk") + (* ; "Edited 14-Sep-2023 07:50 by rmk") (* ; "Edited 1-Jan-2022 21:49 by rmk") - (* ;; "If INITREGION is a type atom and a region of that type is available, then use it as the INITREGION. Otherwise, add a copy of the new region to the available list, and assert that the new region has the copy as its source.") + (* ;; "If INITREGION is a type atom:") - (* ;; "We don't know what will happen to the new region, but if it ends up as a region for CREATEW, the source information enables us to mark its source as inuse.") + (* ;; " If a region of that type is available, then a (copy) is returned.") - (* ;; "This allows for the possibility that the application is actually asking the user for a constellation region that will be shrunk in anticipation of future satellite attachments. A future retrieval will return the original size and position, and it will then presumably be shrunk in the same way.") + (* ;; " Otherwise, the user is asked for a new region, that is added to the type list, and again a copy is returned.") - (LET (REGION (TYPELIST (ASSOC (CL:WHEN (AND INITREGION (LITATOM INITREGION)) - INITREGION) - TYPED-REGIONS))) - (FOR R in (CDR TYPELIST) UNLESS (fetch REGION-INUSE of R) - WHEN [AND (OR (NULL MINWIDTH) - (ILEQ MINWIDTH (FETCH WIDTH OF R))) - (OR (NULL MINHEIGHT) - (ILEQ MINHEIGHT (FETCH HEIGHT OF R] - DO - (* ;; "Copy so the caller can update the region without affecting the recyclable source, but remember what it is based on. We don't mark it as used here, maybe a window won't be built around it and it will fade away. However, there is the risk that another GETREGION will find the same source before it is given to a window, in which case 2 windows might open up in the same place.") + (* ;; "We return a copy because we don't know what will happen to this region, whether it will be changed by future operations (e.g. by a constellation operation). A future retrieval will return the original size and position, and it will then presumably be shrunk in the same way.") - (SETQ REGION (COPY R)) - (REPLACE REGION-SOURCE OF REGION WITH R) - (RETURN)) - - (* ;; "If we found a good one, we're done. Otherwise, run the normal code, but save the new region if it is typed.") + (* ;; " If INITREGION is not a typeatom, it is passed through to the original GETREGION, and the new region will not be managed.") + (LET (REGION TYPELIST (REGION-TYPE (AND (LITATOM INITREGION) + INITREGION))) + (SETQ REGION (GRAB-TYPED-REGION REGION-TYPE MINWIDTH MINHEIGHT)) (CL:UNLESS REGION - (SETQ REGION (GETREGION.ORIG MINWIDTH MINHEIGHT INITREGION NEWREGIONFN NEWREGIONFNARG - INITCORNERS)) - (CL:WHEN TYPELIST - (* ;; - "The new region is based on a typed region. The saved source is a copy of what we return.") + (* ;; "If we found a good one, INITREGIONS must have been a type, and we're done. Otherwise, run the normal code, but save the new region as a new instance if its typed.") - (NCONC1 TYPELIST (REPLACE REGION-SOURCE OF REGION WITH (COPY REGION))))) + (SETQ REGION (GETREGION.ORIG MINWIDTH MINHEIGHT (CL:IF REGION-TYPE + NIL + INITREGION) + NEWREGIONFN NEWREGIONFNARG INITCORNERS)) + (CL:WHEN REGION-TYPE + + (* ;; "A new typed region to add to the list . ") + + (NCONC1 [OR (ASSOC REGION-TYPE TYPED-REGIONS) + (CAR (PUSH TYPED-REGIONS (CONS REGION-TYPE] + REGION))) REGION]) (CLOSE-TYPED-W - [LAMBDA (TYPE) (* ; "Edited 29-Dec-2021 15:58 by rmk") - (* ; "Edited 27-Nov-2021 11:50 by rmk:") + [LAMBDA (TYPE) (* ; "Edited 14-Sep-2023 07:39 by rmk") + (* ; "Edited 29-Dec-2021 15:58 by rmk") + (* ; "Edited 27-Nov-2021 11:50 by rmk:") - (* ;; "Closes all windows of REGIONTYPE inside TYPE") + (* ;; "Closes all windows whose regions are of type TYPE") (CL:WHEN TYPE - (for W R in (OPENWINDOWS) when (AND (SETQ WT (WINDOWPROP W 'REGION-TYPE)) - (EQMEMB WT TYPE)) do (CLOSEW W)))]) + (for W R in (OPENWINDOWS) eachtime [SETQ WT (CAR (WINDOWPROP W 'TYPED-REGION] + when (AND WT (EQMEMB WT TYPE)) do (CLOSEW W)))]) ) (RPAQ? TYPED-REGIONS ) @@ -211,27 +259,17 @@ (DECLARE%: EVAL@COMPILE (HASHLINK TYPED-REGION (REGION-INUSE REGION-INUSE-HASH)) - -(HASHLINK REGION-SOURCE (REGION-SOURCE REGION-SOURCE-HASH)) ) (DECLARE%: EVAL@COMPILE (GLOBALVARS REGION-INUSE-HASH)) (SETUPHASHARRAY 'REGION-INUSE-HASH NIL) - -(DECLARE%: EVAL@COMPILE (GLOBALVARS REGION-SOURCE-HASH)) - -(SETUPHASHARRAY 'REGION-SOURCE-HASH NIL) ) (DECLARE%: EVAL@COMPILE (GLOBALVARS REGION-INUSE-HASH)) (SETUPHASHARRAY 'REGION-INUSE-HASH NIL) -(DECLARE%: EVAL@COMPILE (GLOBALVARS REGION-SOURCE-HASH)) - -(SETUPHASHARRAY 'REGION-SOURCE-HASH NIL) - (MOVD? 'CREATEW 'CREATEW.ORIG) (MOVD? 'CLOSEW 'CLOSEW.ORIG) @@ -683,10 +721,11 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1672 3859 (SET-TYPED-REGIONS 1682 . 3857)) (3860 10861 (RM-CREATEW 3870 . 6377) ( -RM-CLOSEW 6379 . 7780) (RM-GETREGION 7782 . 10368) (CLOSE-TYPED-W 10370 . 10859)) (11777 19256 ( -RELCREATEREGION 11787 . 16410) (RELGETREGION 16412 . 19019) (RELCREATEPOSITION 19021 . 19254)) (19257 -26061 (\RELCREATEREGION.REF 19267 . 23018) (\RELCREATEREGION.SIZE 23020 . 26059)) (26114 35456 ( -RM-ATTACHWINDOW 26124 . 35454)) (35457 37191 (CLOSEWITH 35467 . 35994) (CLOSEWITH.DOIT 35996 . 36276) -(MOVEWITH 36278 . 36801) (MOVEWITH.DOIT 36803 . 37189))))) + (FILEMAP (NIL (1573 6691 (SET-TYPED-REGIONS 1583 . 3758) (GRAB-TYPED-REGION 3760 . 4786) ( +REGISTER-TYPED-REGION 4788 . 6085) (REGION-TYPE 6087 . 6689)) (6692 14098 (RM-CREATEW 6702 . 8325) ( +RM-CLOSEW 8327 . 11345) (RM-GETREGION 11347 . 13496) (CLOSE-TYPED-W 13498 . 14096)) (14741 22220 ( +RELCREATEREGION 14751 . 19374) (RELGETREGION 19376 . 21983) (RELCREATEPOSITION 21985 . 22218)) (22221 +29025 (\RELCREATEREGION.REF 22231 . 25982) (\RELCREATEREGION.SIZE 25984 . 29023)) (29078 38420 ( +RM-ATTACHWINDOW 29088 . 38418)) (38421 40155 (CLOSEWITH 38431 . 38958) (CLOSEWITH.DOIT 38960 . 39240) +(MOVEWITH 39242 . 39765) (MOVEWITH.DOIT 39767 . 40153))))) STOP diff --git a/lispusers/REGIONMANAGER.LCOM b/lispusers/REGIONMANAGER.LCOM index f6dd79e8f33be064cfadcba6492dcb0c8ac8d72d..4784c2a4c266c22915b8bf1d17fa7854b6847cd5 100644 GIT binary patch delta 2337 zcmZuzOKcle6rCBT4sly*x1nh*n%tOAZB&Q(`71st5 z=Z?Rse7tm{ElOg#zHu!ri?RZ;T$Bn$DVKm`V&m$SH#aX|?84PIAOY9gHPfh?Ywy0~ zc7%9eE~Frm2yT_sqLO7>uhE^C&vs!GH!iMJs}RgvSXf9v_tk57@MHGNY9bX$E|RKQ zZkT$@G{%!Wd}8LvK|qUg0aP&~XP{^rq?InM!CO}@L8Rz3%nPKx(o7q8+M|c%iYgX+ zJy6?ezOeI-@B!biH1txswdR;cx?xsG-G-u(k0c4mP$RZwl8V&=0up^{6QgC}g9u(K z+m`~aC~#az>u~sYQi#QPD>RtsMfo)riO}%QjDAZeg24ZMr*yl73tW9oqLwhdy7eoU zl=DzATbACmur0FUW+&(SOz0x$(>?kD*!K5ZA*pL8|O^^!XfxVX2ZPw5c*Ah!(ZCb?+m66ZBpt0`kKCf?2 zYkq^gM(m!@qa9kaM|HS&oR9K%HNsl+1sVLax%HPNtZx0uB{PawqO5wK8NUn%ktoVI zIFNFIfLynI1=P}>N!lJ-2es(aOcfBI*)=B4_g_ZrhqSJuJ^V}?hz8^4ECo7i!j1S)K|gQA3c-;m19PPM{S`h?5;<}sL0?0T&OoDNd-%jRQFOi(MNs) z`g9-zZSNTzP{G-&0voXxm;H(;k(lN&W9)q`Lb+ORniupcW6L`NDf?xTsx``KtYF4O ztUn(j{0~I%~D z2B87;N7zeT-K~)A@^bCpoy2mDKQ&wyYC@lV;zIBibVZl;;LLKbL-#WRh90~gd$6L* zUE7mc{Pb|^KF$VF0j$4PzhI)CpHF|* zqC>?@K=i12D5wVlI2`e+n&V#$`LXYrrQP+(>E~n?XQPnnCLkGa$sF%~GTG@nA&v`| zs7H1~rP#b+X*z5ET6Zv`>DJBOduSB%XqZxT*BVR^&+bUSHBLVn&BLwVxnwT0H`x?6 z&%J9sE+mYM-ZU?cUNwjv85kc~I3LFYYQa4|^}>3CnSqXWF98-ofp&|&eL_6PYrDsu zpm1q5{@Z8Y3H(NQd%CGT{8kHn+0>rCMVQiubVf0^yEmr9Bf(pDexBl|&+H=}0fzne zk$Yoy`Xt?xg5)C7*4Q6Y?t?QDA916z8Fz8^+*}GXBE%->@p8RkG{@>of&2YzH5v&D z7dN=q6QWy~n?D@!M+=SpmN@HvI;Y~%Kh2$T@6VlgAMoc~0}3+{yj^d#^s+S?2n>_^ jIXIa8{xc`s|G;`OLdS+yMk(PB4{+`I4|kqTyv_d)Uj!z$ delta 1826 zcmb7F&u<$=6yCL)wAmfh7(5I%U`d;8v- zdEfW#>?g+8^Y=;xF(S;>DuNgkMG#bCvJwkMeSr7f-dx{WU8_~W<_7Qq?%iZQ{oWhJ zo!a)!^qrNhwUv$O%;xQtwdwU*b**++nhH&?-xX|U8cnieK^P7IpBOsoE{ZWpiHQ(* zt8CZ0{cG=RZSTAq1IXjKfS!9VG{7p}ajuxjfZpnp-nnnEmEKx?NS{vx($TA9;8q-I_4kuUBbVg(;I5t!kgKTRlk|^)VXRH(I>0 ziZdDvGf49GQ*?8q*U_ny8g|uxy5(-4sV`TU<`?XnxXS7K?Lzza)#kH|tNAO#Lj{6) zt&oc6Qvil!U=<7Ym{!ij5XkVwh^XL5!zq9wxRp(q*@OsSPy`9nS^`nI+fWf5%p6R^ zQQ#0TW#;sGAP2jtV#Gn)!qS70u;U4OwwTuh`*^a_iQb`{Kq+KXCOG|}D0MP=>Xc|F zm^X{LgwqYz+Eqet6h@DA%mWC~(|%tgcuX65R}2Bb$SlLKD&>KaeLI@N}- z+8O4DRQr@ZtlL68nyRDC=5Opx8l@=gO{!n2X_t%rbI%w5Dvm8;j;5)~m(pb-VMoKw z`-W?|`8n327(JRFMr=7LN>?KhsjIf|5mKSBohVBr(dLwbMua5FC$X$xYy$K(@6{K+ zlTK2Ej2>|lqa|`fKu`jNdx9foUU4(%FK+zGa%;p;4Ymgl|9{~JZHV=BPBo2K)4$-sm5X+%)FnR9yVFI`SS>V#h3t>R6F?7#A ziSC0}&@cY89N-ts#pDd&Idtgf(ci#}9{EpuNCWZ!@YjnbzFs+GT^&QZS4Qu9FX1hB zy))#ifvx9Wa}=K|UMR#9DO+*QX*qP=XQ4l?p2k_<`3h&X#dtLfQ2U=RpxBvhE diff --git a/lispusers/REGIONMANAGER.TEDIT b/lispusers/REGIONMANAGER.TEDIT index a53f7e02..cf4e717b 100644 --- a/lispusers/REGIONMANAGER.TEDIT +++ b/lispusers/REGIONMANAGER.TEDIT @@ -3,7 +3,7 @@ Medley REGIONMANAGER 2 1 REGIONMANAGER 1 4 - By Ron Kaplan This document created in December 2021. + By Ron Kaplan This document created in December 2021, last edited September 2023. Medley comes equipped with a core set of functions for specifying regions and creating the windows that occupy those regions on the screen. But it can be disruptive if not irritating to have to draw out a new ghost region for every invocation of a particular application. Thus the common applications (e.g. TEDIT, SEDIT, DINFO...) implement particular strategies to reduce the number of times that a user has to sweep out a new region. They instead default to regions that were allocated for earlier invocations that are no longer active. TEDIT for example recycles the region of a session that was recently shut down, SEDIT allocates from a list of previous regions, DINFO always uses the same region, but FILEBROWSER always prompts for a new one. Applications that do recycle their regions tend to do so indiscrimately, without regard to the current arrangement of other windows on the screen or the role that those windows may play in higher-level applications. The REGIONMANAGER package provides simple extensions to the core region and window functions. These are aimed at giving users and application implementors more flexible and systematic control over the specification and reuse of screen regions. It introduces three new notions: A "typed region" allows the regions of particular applications to be specified, classified, and recycled according to their types. @@ -13,15 +13,21 @@ REGIONMANAGER is innocuous in that explicit user action is required to change th Typed regions REGIONMANAGER adds overlay veneers to the core CREATEW, CLOSEW, and GETREGION functions to make it easier to predict and control how different applications arrange their windows on the screen without always needing to respond to a ghost-region prompt. The REGION/INITREGION arguments may now be region-type atoms in addition to either NIL or particular regions as CREATEW and GETREGION otherwise allow. The type-atom will resolve to a region drawn from a predefined pool of regions associated with that type, if the pool has at least one that is not currently allocated to another window. If the pool has no available regions, then the pool will be enlarged with a region that the user produces from a normal ghost-region prompt, and the type-atom will then resolve to the newly installed region. -A typed-region is marked as "inuse" and therefore unavailable when CREATEW assigns it to a window, and the extended CLOSEW marks it as again available when the window is closed. +A typed-region is marked as "inuse" and therefore unavailable when CREATEW assigns it to a window, and the extended CLOSEW marks it as again available when the window is closed. The region of the most recently closed window will be offered the next time a region of its type is requested. An example of how an application can take advantage of this facility is the TEDIT-PF-SEE package. This provides lightweight alternatives to the PF and SEE commands that print their output to scrollable read-only Tedit windows, specifying PF-TEDIT and SEE-TEDIT as their region types. The user can predefine a preference-ordered sequence of recyclable regions that bring up multiple output windows in a predictable tiled arrangement, without region-prompting for each invocation. The global variable TYPED-REGIONS is an alist that maintains the relationship between atomic type-names and the list of regions that belong to each type. The list is ordered according to preferences set by the user, and a type-atom is always resolved to the first unused region in its list. If the user is asked to sweep out a new region, that region is added at the end, as the least preferable. The function SET-TYPED-REGIONS is provided to add or replace TYPED-REGION entries. (SET-TYPED-REGIONS TYPELISTS REPLACE) [Function] TYPELISTS is an alist of the form ((type1 . regions1)(type2 . regions2)...) -where each regioni is a possibly empty list of regions. For convenience, if TYPELISTS is just a literal type-atom, it is interpreted as ((type)), and if it is a list (type . regions) begining with an atom, it is interpreted as ((type . regions). The new regions replace preexisting regions if REPLACE, otherwise they are added at the front. +where each regionsi is a possibly empty list of regions. For convenience, if TYPELISTS is just a literal type-atom, it is interpreted as ((type)), and if it is a list (type . regions) begining with an atom, it is interpreted as ((type . regions). The new regions replace preexisting regions if REPLACE, otherwise they are added at the front. Typically, a call to SET-TYPED-REGIONS would be placed in a user's INIT file to set up the preference order for the regions that the user wants to participate in this reallocation scheme. If an application uses a type that is not on TYPED-REGIONS, then that type-atom is treated as NIL and always gives rise to the normal ghost-region prompting. Thus a user will observe no change in system behavior if TYPED-REGIONS is left with its initial value NIL. A type that is added with an empty region list (as opposed to not being on the list at all) will allow new regions to accumulate for recycling. - +The function REGION-TYPE returns NIL if X is not a typed-region or not a region of type TYPE. +(REGION-TYPE X TYPE) [Function] +In most scenarios the interpretation of a typed region specification is handled automatically by the extended CREATEW and GETREGION functions. Sometimes it may be useful to perform to for the regions dimensions to be entered into other calculations before it is installed in a window. The function GRAB-TYPED-REGION recycles an existing REGION-TYPE window if one meets the optional minimum width and height requirements, otherwise a new region is returned. +(GRAB-TYPED-REGION REGION-TYPE MINWIDTH MINHEIGHT) [Function] +A type can be assigned to an untyped region and installed in a window by the function REGISTER-TYPED-REGION. That region will then be recycled when the window is closed. +(REGISTER-TYPED-REGION REGION REGION-TYPE WINDOW) [Function] +If REGION is NIL, the (presumably) untyped region of WINDOW will be registered. An entry in TYPED-REGIONS will be created for REGION-TYPE if it is not already present. Relative regions Two functions are provided to make it easy to create regions relative and oriented with respect to a specified reference point. These may be useful for constructing an application that includes a constellation of windows arranged in a particular relative way. (RELCREATEREGION WIDTH HEIGHT CORNERX CORNERY REFX REFY ONSCREEN) [Function] @@ -48,7 +54,7 @@ Applications are often set up as a constellation of windows, a central or primar Each of these applications is constructed by anticipating the subregions that the satellite windows will occupy after they are attached, decreasing the constellation region by their estimated (using WIDTHIFWINDOW HEIGHTIFWINDOW) or actual sizes, and then using remainder as the region for the central window. An alternative approach is to construct the central window first, giving it the entire constellation region, and then to have ATTACHWINDOW reshape that window to accomodate the satellite windows as they are attached in sequence. This leads to the same final configuration, but there is no need for separate calculations to pre-adjust the region of the central window. REGIONMANAGER provides an overlay veneer for ATTACHWINDOW that implements this strategy. If the new argument TAKEFROMCENTRAL is true, then the region of the WINDOWTOATTACH will be substracted from the region of the existing central window according to the EDGE parameter of the attachment. -(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function] +(ATTACHWINDOW WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION TAKEFROMCENTRAL) [Function] This behavior is also triggered if the UNDERCONSTRUCTION property of the central window is true. Thus, a constellation can be set up by creating all of the satellites and the central window, marking the central window as under construction, and then doing the sequence of attachments. The property can be reset to NIL when the construction is complete, so the central window does not shrink if other other attachments (e.g. expanded menus) by later user actions. A somewhat weaker form of a constellation is a collection of windows that are not attached around a central window but stand in a parent-child relationship at least with respect to closing and moving. A parent windows spawns children that respond independently to ordinary window commands (move, shape, close). But the children close when the parent closes, and the children move when the parent moves so that they continue to appear in the same relative positions. These primitives allow the construction of a tree of windows that are dependent in this way. @@ -62,19 +68,14 @@ Establishes a link between the PARENT window and any number of CHILDREN windows If NEWPOS is the new position of PARENT, moves each of the move-children so that they stand in the same relation to PARENT after it moves as before. -(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) 4È$È4È$È4È$È4È$È4È$È1 $È$1 È$4È$È1È$1ŠŠ8$1ŠŠ8$JÈ$È PAGEHEADING RUNNINGHEADTERMINALÿüTERMINALÿü -TIMESROMAN$TERMINALMODERN MODERN -   HRULE.GETFNMODERN -   HRULE.GETFNMODERN -  HRULE.GETFNMODERN - - - HRULE.GETFNMODERN   HRULE.GETFNMODERN   (È„•‘}/ ¯[ ChT Û Á%   - -; 3o) MA  &MmJS-f= -3E -" - -0: /3 -t2C ƒ "O= - , l¬ 9™¤Ç S~ æ- 4!U™'—2 µ " (  M.U}zº \ No newline at end of file +(LIST ((PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC) STARTINGPAGE# 1) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))) (PAGE NIL (PAPERSIZE Letter FOLIOINFO (ARABIC)) (0 0 612 792) ((FOLIO NIL (PARALOOKS (QUAD CENTERED) CHARLOOKS (SUPERSCRIPT 0 INVISIBLE OFF SELECTPOINT OFF PROTECTED OFF SIZE 10 FAMILY MODERN OVERLINE OFF STRIKEOUT OFF UNDERLINE OFF EXPANSION REGULAR SLOPE REGULAR WEIGHT MEDIUM INVERTED OFF USERINFO NIL STYLE NIL) FORMATINFO (ARABIC)) (174 36 288 36) NIL) (HEADING NIL (HEADINGTYPE RUNNINGHEAD) (84 744 528 36) NIL) (TEXT NIL NIL (84 96 456 600) NIL))))) 1$4È$È4È$È1 $È$1 È$4È$È4È$È4È$È4È$È1È$1ŠŠ8$1ŠŠ8$JÈ$È PAGEHEADING RUNNINGHEADMODERN +rd(DEFAULTFONT 1 (TERMINAL 12) (TERMINAL 8) (TERMINAL 8) (PDF (TERMINAL 8)) (POSTSCRIPT (TERMINAL 8))) TERMINALMODERN TERMINALÿüTERMINALÿü +TIMESROMAN$  HRULE.GETFN   HRULE.GETFN  HRULE.GETFN   HRULE.GETFN  HRULE.GETFN +DÈ „ • ‘}/ ¯[ C×T Û Á1  + +; 3o)Ä ž  ’   4 n © o2 V@1 %!  A  &MmJS-f= +3E +" + +l /3 +t2C ƒ "O=  , l¬)9™¤Ç S~ æ- 4!Uh'—2&µ$"&( )MDATE:fï1¶2Șzº \ No newline at end of file From db084c628118e6509ddb35c3bf2b9740654f825d Mon Sep 17 00:00:00 2001 From: Frank Halasz Date: Wed, 18 Oct 2023 20:53:24 -0700 Subject: [PATCH 32/37] Add copy-full.sh to loadup-full.sh script to copy loadup products from the tmp directory into MEDLEYDIR/loadups - make loadup-full akin to loadup-all (#1359) --- scripts/copy-full.sh | 24 ++++++++++++++++++++++++ scripts/loadup-full.sh | 11 ++++++++++- 2 files changed, 34 insertions(+), 1 deletion(-) create mode 100755 scripts/copy-full.sh diff --git a/scripts/copy-full.sh b/scripts/copy-full.sh new file mode 100755 index 00000000..14f084e1 --- /dev/null +++ b/scripts/copy-full.sh @@ -0,0 +1,24 @@ +#!/bin/sh + +if [ ! -x run-medley ] ; then + echo run from MEDLEYDIR + exit 1 +fi + +. scripts/loadup-setup.sh + +echo ">>>>> START ${script_name}" + +./scripts/cpv "${LOADUP_WORKDIR}"/full.sysout "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g" +./scripts/cpv "${LOADUP_WORKDIR}"/lisp.sysout "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g" + +./scripts/cpv "${LOADUP_WORKDIR}"/init.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g" +./scripts/cpv "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g" +./scripts/cpv "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g" + +./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS library | sed -e "s#${MEDLEYDIR}/##g" +./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS.LCOM library | sed -e "s#${MEDLEYDIR}/##g" + +echo "<<<<< END ${script_name}" +echo "" +exit 0 diff --git a/scripts/loadup-full.sh b/scripts/loadup-full.sh index a49fdd5a..a5938705 100755 --- a/scripts/loadup-full.sh +++ b/scripts/loadup-full.sh @@ -10,5 +10,14 @@ fi ./scripts/loadup-init.sh && \ ./scripts/loadup-mid-from-init.sh && \ ./scripts/loadup-lisp-from-mid.sh && \ -./scripts/loadup-full-from-lisp.sh +./scripts/loadup-full-from-lisp.sh && \ +./scripts/copy-full.sh + +if [ $? -eq 0 ]; +then + echo "+++++ loadup-full.sh: SUCCESS +++++" +else + echo "----- loadup-full.sh: FAILURE -----" +fi + From 45513f563baed84bb8c61dfe340ad9480568320e Mon Sep 17 00:00:00 2001 From: Frank Halasz Date: Thu, 19 Oct 2023 17:04:40 -0700 Subject: [PATCH 33/37] Extend changes made in PR#1356 to medley/sh et al to handle -title arguments with space; extend to handle vnc case and well as without vnc case. (#1358) --- scripts/medley/medley_args.sh | 5 ++--- scripts/medley/medley_vnc.sh | 1 + 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/scripts/medley/medley_args.sh b/scripts/medley/medley_args.sh index f78b7e8a..82c9a742 100755 --- a/scripts/medley/medley_args.sh +++ b/scripts/medley/medley_args.sh @@ -28,7 +28,7 @@ run_id="default" screensize="" sysout_flag=false sysout_arg="" -title="" +title="Medley Interlisp" use_vnc=false windows=false @@ -113,8 +113,7 @@ do ;; -t | --title) check_for_dash_or_end "$1" "$2" - #run_args+=(-title $2) - title="$2" + if [ -n "$2" ]; then title="$2"; fi shift ;; -v | --vnc) diff --git a/scripts/medley/medley_vnc.sh b/scripts/medley/medley_vnc.sh index 60dbc584..6be2a1a1 100755 --- a/scripts/medley/medley_vnc.sh +++ b/scripts/medley/medley_vnc.sh @@ -164,6 +164,7 @@ -SecurityTypes None \ -NeverShared \ -DisconnectClients=0 \ + -desktop "${title}" \ --MaxDisconnectionTime=10 \ >> ${LOG} 2>&1 & From bcfeda62e136a77f8e8047f58330c758daf515d1 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 23 Oct 2023 21:18:57 -0700 Subject: [PATCH 34/37] EQUALALL tests equivalence of bitmaps and big bitmaps (#1302) * EQUALALL tests equivalence of bitmaps and big bitmaps * Oops, off by one --------- Co-authored-by: Larry Masinter --- library/BIGBITMAPS | 52 ++++++++----- library/BIGBITMAPS.LCOM | Bin 21511 -> 21468 bytes sources/HPRINT | 54 +++++++------- sources/HPRINT.LCOM | Bin 25562 -> 25641 bytes sources/LLDISPLAY | 119 +++++++++++++++++------------- sources/LLDISPLAY.LCOM | 158 ++++++++++++++++++++-------------------- 6 files changed, 206 insertions(+), 177 deletions(-) diff --git a/library/BIGBITMAPS b/library/BIGBITMAPS index d8638ffe..a9484032 100644 --- a/library/BIGBITMAPS +++ b/library/BIGBITMAPS @@ -1,15 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED " 9-Jul-2022 09:41:26"  -|{DSK}kaplan>Local>medley3.5>working-medley>library>BIGBITMAPS.;12| 108851 +(FILECREATED "31-Jul-2023 13:39:50" |{WMEDLEY}BIGBITMAPS.;13| 109376 + + :EDIT-BY |rmk| :CHANGES-TO (VARS BIGBITMAPSCOMS) - (FNS \\GENERIC.DSPCREATE.DESTINATION.BITMAP?.BIGBM \\GENERIC.DSPCREATE.BIGBM - \\DSPCREATE.BIGBM) - (MACROS |\\SFInvert|) + (FNS BIGBITMAPEQUAL) - :PREVIOUS-DATE "26-Oct-2021 14:51:38" -|{DSK}kaplan>local>medley3.5>working-medley>library>BIGBITMAPS.;6|) + :PREVIOUS-DATE " 9-Jul-2022 09:41:26" |{WMEDLEY}BIGBITMAPS.;12|) ; Copyright (c) 1991, 1993-1994 by Venue. @@ -24,8 +22,8 @@ (MACROS |GetNewFragment|) (MACROS |\\SFInvert|)) (INITRECORDS BIGBM) - (FNS BIGBITMAPP BITBLT.BIGBM BITMAPCREATE.BIGBM BITMAPCREATE BITMAPCOPY BLTSHADE.BIGBM BITBLT - \\ORG.BITBLT \\BLTSHADE.DISPLAY \\RESHOWBORDER1) + (FNS BIGBITMAPP BITBLT.BIGBM BITMAPCREATE.BIGBM BITMAPCREATE BITMAPCOPY BIGBITMAPEQUAL + BLTSHADE.BIGBM BITBLT \\ORG.BITBLT \\BLTSHADE.DISPLAY \\RESHOWBORDER1) (FNS \\DRAWCIRCLE.BIGBM \\FILLCIRCLE.BIGBM \\DRAWELLIPSE.BIGBM \\DRAWCURVE.BIGBM \\DRAWLINE.BIGBM.DASH \\DRAWLINE.BIGBM.NODASH) (FNS \\GENERIC.DSPCREATE.DESTINATION.BITMAP?.BIGBM) @@ -353,6 +351,20 @@ 0 0 NIL NIL 'INPUT 'REPLACE 0) (RETURN NEWBITMAP)))) +(BIGBITMAPEQUAL + (LAMBDA (BM1 BM2) (* \; "Edited 31-Jul-2023 13:08 by rmk") + + (* |;;| "Fields may not be SMALLP") + + (AND (|type?| BIGBM |of| BM1) + (|type?| BIGBM |of| BM2) + (IEQP (|ffetch| (BIGBM BIGBMWIDTH) |of| BM1) + (|ffetch| (BIGBM BIGBMWIDTH) |of| BM2)) + (IEQP (|ffetch| (BIGBM BIGBMHEIGHT) |of| BM1) + (|ffetch| (BIGBM BIGBMHEIGHT) |of| BM2)) + (|for| B1 |in| (|ffetch| (BIGBM BIGBMLIST) |of| BM1) |as| B2 + |in| (|ffetch| (BIGBM BIGBMLIST) |of| BM2) |always| (EQUALBITMAPP B1 B2))))) + (BLTSHADE.BIGBM (LAMBDA (TEXTURE DESTINATION DESTLEFT DESTBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION) (* \; "Edited 17-Oct-89 19:01 by takeshi") @@ -1699,15 +1711,15 @@ ) (PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (3546 48244 (BIGBITMAPP 3556 . 3702) (BITBLT.BIGBM 3704 . 14527) (BITMAPCREATE.BIGBM -14529 . 15871) (BITMAPCREATE 15873 . 17475) (BITMAPCOPY 17477 . 18012) (BLTSHADE.BIGBM 18014 . 21150) -(BITBLT 21152 . 22800) (\\ORG.BITBLT 22802 . 34371) (\\BLTSHADE.DISPLAY 34373 . 43611) ( -\\RESHOWBORDER1 43613 . 48242)) (48245 71523 (\\DRAWCIRCLE.BIGBM 48255 . 51618) (\\FILLCIRCLE.BIGBM -51620 . 55666) (\\DRAWELLIPSE.BIGBM 55668 . 60188) (\\DRAWCURVE.BIGBM 60190 . 64040) ( -\\DRAWLINE.BIGBM.DASH 64042 . 68401) (\\DRAWLINE.BIGBM.NODASH 68403 . 71521)) (71524 71893 ( -\\GENERIC.DSPCREATE.DESTINATION.BITMAP?.BIGBM 71534 . 71891)) (72025 85168 (DSPDESTINATION 72035 . -75933) (|\\SFFixY| 75935 . 81657) (|\\SFFixDestination| 81659 . 82842) (|\\SFFixClippingRegion| 82844 - . 85166)) (85169 93255 (\\SW2BM 85179 . 90203) (BITMAPHEIGHT 90205 . 90703) (BITMAPWIDTH 90705 . -91197) (|\\SFFixFont| 91199 . 92171) (BITSPERPIXEL 92173 . 93253)) (93256 108609 (COLORIZEBITMAP 93266 - . 96076) (\\BWTOCOLORBLT 96078 . 102671) (UNCOLORIZEBITMAP 102673 . 108607))))) + (FILEMAP (NIL (3364 48769 (BIGBITMAPP 3374 . 3520) (BITBLT.BIGBM 3522 . 14345) (BITMAPCREATE.BIGBM +14347 . 15689) (BITMAPCREATE 15691 . 17293) (BITMAPCOPY 17295 . 17830) (BIGBITMAPEQUAL 17832 . 18537) +(BLTSHADE.BIGBM 18539 . 21675) (BITBLT 21677 . 23325) (\\ORG.BITBLT 23327 . 34896) (\\BLTSHADE.DISPLAY + 34898 . 44136) (\\RESHOWBORDER1 44138 . 48767)) (48770 72048 (\\DRAWCIRCLE.BIGBM 48780 . 52143) ( +\\FILLCIRCLE.BIGBM 52145 . 56191) (\\DRAWELLIPSE.BIGBM 56193 . 60713) (\\DRAWCURVE.BIGBM 60715 . 64565 +) (\\DRAWLINE.BIGBM.DASH 64567 . 68926) (\\DRAWLINE.BIGBM.NODASH 68928 . 72046)) (72049 72418 ( +\\GENERIC.DSPCREATE.DESTINATION.BITMAP?.BIGBM 72059 . 72416)) (72550 85693 (DSPDESTINATION 72560 . +76458) (|\\SFFixY| 76460 . 82182) (|\\SFFixDestination| 82184 . 83367) (|\\SFFixClippingRegion| 83369 + . 85691)) (85694 93780 (\\SW2BM 85704 . 90728) (BITMAPHEIGHT 90730 . 91228) (BITMAPWIDTH 91230 . +91722) (|\\SFFixFont| 91724 . 92696) (BITSPERPIXEL 92698 . 93778)) (93781 109134 (COLORIZEBITMAP 93791 + . 96601) (\\BWTOCOLORBLT 96603 . 103196) (UNCOLORIZEBITMAP 103198 . 109132))))) STOP diff --git a/library/BIGBITMAPS.LCOM b/library/BIGBITMAPS.LCOM index a6454f3840ead9b654d27af69a6ff4dd576adf7e..4783daae8491a4015d13810a57f266b8a6abcb42 100644 GIT binary patch delta 744 zcmZuuOKTHR7@e7fLa(S1l^_Uy9V*Nqlg=Ya)3Iu1GLvR%Ci6;C3f;6OU~2jxDkx3~ z3gTA1e?V8d6w-o^rMQ@%Ah@u&aH;+Ry~$WeA$M~=F87@8oO7SOrN6zQpL=~p5|;0G z1zD68kQ7x}P;(*+9D8eLYq!&Fw_s-*SO_1j*rri6SN9gXosHgl@8NabTGFk$t+_$w zs-%QGAXX8_wC2@pPR&Y$yU}YOsf7@>AMEz-sv*SuJ`pgzhE|2JvmF9kZd9uVm!sVQ=dWS*w;R zT5ZV;gt`M{qeMKYu5UIirx6GSG4{eae>u+rn&@N9hCKMr zOi%ZZ>W$k`jRN9aP(YW#1sQY+ERaCAWr89>i3iF{QWR7COp&vn(_$2g5v4`c*UjJi zY%yZAh#8J)ElL)n5rAfL9&ygKP}%xL;CC6Lds%3RG9bg4k<2QfRT&% zzg<$dM2rxFHsoR){5UaHI(f`8{#l#Fe=eNEmmK#jT3a)GZKc%kn`S0v;wMg)M))r+ z;A>tE)65l`$EVym#FI1X6X88qe7Ts$U)+o2<)JI!)1E}8qBnryRKF$0C&EC)_ delta 669 zcmbV}J#W)c6o%!6s%9vNN=0JmsTb_QCU)XBbt?XX*#G*y1fm7B+uRp1bkwLDWrq!D>BaY{d$o^pj%sG(__ll%A z(Pzxk*81rgv$**7!)23v>2k|)+;V$(*RX8Kaxij@`@oX3F1kkf1LK|<29Z7Gr}@Zh z&=YS`n=X;7zDiyN4;O^<7X+xru;c}*laENG(GMh(&z?el2dgCYmxzE@m*@w)$O7IE WJ$fnC!)xTLzd~N)E2lsGU(6q%e$BA} diff --git a/sources/HPRINT b/sources/HPRINT index 80eef590..a2a83474 100644 --- a/sources/HPRINT +++ b/sources/HPRINT @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 3-Aug-2022 21:31:57" {DSK}larry>medley>sources>HPRINT.;3 58021 +(FILECREATED "31-Jul-2023 13:33:10" {WMEDLEY}HPRINT.;5 57926 - :CHANGES-TO (VARS HPRINTCOMS) - (FNS HPRINT) + :EDIT-BY rmk - :PREVIOUS-DATE "17-Oct-2021 13:54:11" {DSK}larry>medley>sources>HPRINT.;1) + :CHANGES-TO (FNS EQUALALL) + + :PREVIOUS-DATE " 3-Aug-2022 21:31:57" {WMEDLEY}HPRINT.;2) (* ; " @@ -901,8 +902,8 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation (DEFINEQ (EQUALALL - [LAMBDA (X Y) (* ; - "Edited 26-Apr-2021 14:34 by rmk:") + [LAMBDA (X Y) (* ; "Edited 31-Jul-2023 13:31 by rmk") + (* ; "Edited 26-Apr-2021 14:34 by rmk:") (OR (EQ X Y) (PROG ((TY (TYPENAME Y)) TEM) @@ -925,7 +926,7 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation (ARRAYSIZE Y)) (for I from (ARRAYORIG X) as J to TEM always (EQUALALL (ELT X I) - (ELT Y I]) + (ELT Y I]) ((ONED-ARRAY TWOD-ARRAY GENERAL-ARRAY) (* ; "RMK: Added CL arrays") [AND (EQUAL (CL:ARRAY-DIMENSIONS X) @@ -939,14 +940,12 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation (EQP (CL:FILL-POINTER X) (CL:FILL-POINTER Y))) (NOT (CL:ARRAY-HAS-FILL-POINTER-P Y))) - (FOR I FROM 0 TO (SUB1 (CL:ARRAY-TOTAL-SIZE - X)) + (FOR I FROM 0 TO (SUB1 (CL:ARRAY-TOTAL-SIZE X)) ALWAYS (EQUALALL (XCL:ROW-MAJOR-AREF X I) - (XCL:ROW-MAJOR-AREF Y I]) + (XCL:ROW-MAJOR-AREF Y I]) (HARRAYP (EQUALHASH X Y)) - (READTABLEP (for I from 0 to 127 - always (EQUALALL (GETSYNTAX I X) - (GETSYNTAX I Y)))) + (READTABLEP (for I from 0 to 127 always (EQUALALL (GETSYNTAX I X) + (GETSYNTAX I Y)))) (TERMTABLEP [AND (EQ (GETCONTROL X) (GETCONTROL Y)) (EQ (GETRAISE X) @@ -965,18 +964,19 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation Y] (for I from 0 to 31 always (EQ (ECHOCONTROL I NIL X) - (ECHOCONTROL I NIL Y))) + (ECHOCONTROL I NIL Y))) (EVERY ORIGDELETECONTROL (FUNCTION (LAMBDA (Z) (EQUAL (DELETECONTROL (CAR Z) NIL X) (DELETECONTROL (CAR Z) NIL Y]) + ((BITMAP BIGBM) + (BITMAPEQUAL X Y)) (OR (EQP X Y) (AND (SETQ TY (GETDESCRIPTORS TY)) - (for FIELD in TY always (EQUALALL - (FETCHFIELD FIELD X) - (FETCHFIELD FIELD Y]) + (for FIELD in TY always (EQUALALL (FETCHFIELD FIELD X) + (FETCHFIELD FIELD Y]) (EQUALHASH [LAMBDA (AR1 AR2) @@ -1118,14 +1118,14 @@ Copyright (c) 1982-1988, 1990-1991, 1993-1994, 2022 by Venue & Xerox Corporation (PUTPROPS HPRINT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 1993 1994 2022)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3694 6232 (MAKEHVPRETTYCOMS 3704 . 4991) (READVARS 4993 . 5559) (HPRINT0 5561 . 6230)) -(6234 6567 (READVARS-FROM-STRINGS 6234 . 6567)) (6569 6956 (READVARS-FROM-STREAM 6569 . 6956)) (6957 -8885 (READVAR-FROM-STRING 6967 . 7373) (READVARS-FROM-STRING 7375 . 7611) (HPRINT-TO-STRING 7613 . -7819) (HPRINT-TO-STRINGS 7821 . 8883)) (9696 38289 (HPRINT 9706 . 11697) (HPRINT1 11699 . 23201) ( -HPRINTEND 23203 . 24239) (RPTPRINT 24241 . 24479) (RPTEND 24481 . 24640) (RPTPUT 24642 . 25140) ( -HPRINTSP 25142 . 25206) (HPERR 25208 . 25305) (HVFWDCDREAD 25307 . 25686) (HVBAKREAD 25688 . 33733) ( -HVREADCHECKGETFN 33735 . 35134) (HVREADEND 35136 . 35488) (HVRPTREAD 35490 . 36016) (HVFWDREAD 36018 - . 36872) (HREAD 36874 . 37196) (HPINITRDTBL 37198 . 38032) (HVREADERR 38034 . 38147) (HPRINSP 38149 - . 38287)) (38290 47172 (COPYALL 38300 . 42203) (\COPYDATATYPE 42205 . 42894) (HCOPYALL 42896 . 43206) - (HCOPYALL1 43208 . 47170)) (47173 54520 (EQUALALL 47183 . 52841) (EQUALHASH 52843 . 54518))))) + (FILEMAP (NIL (3652 6190 (MAKEHVPRETTYCOMS 3662 . 4949) (READVARS 4951 . 5517) (HPRINT0 5519 . 6188)) +(6192 6525 (READVARS-FROM-STRINGS 6192 . 6525)) (6527 6914 (READVARS-FROM-STREAM 6527 . 6914)) (6915 +8843 (READVAR-FROM-STRING 6925 . 7331) (READVARS-FROM-STRING 7333 . 7569) (HPRINT-TO-STRING 7571 . +7777) (HPRINT-TO-STRINGS 7779 . 8841)) (9654 38247 (HPRINT 9664 . 11655) (HPRINT1 11657 . 23159) ( +HPRINTEND 23161 . 24197) (RPTPRINT 24199 . 24437) (RPTEND 24439 . 24598) (RPTPUT 24600 . 25098) ( +HPRINTSP 25100 . 25164) (HPERR 25166 . 25263) (HVFWDCDREAD 25265 . 25644) (HVBAKREAD 25646 . 33691) ( +HVREADCHECKGETFN 33693 . 35092) (HVREADEND 35094 . 35446) (HVRPTREAD 35448 . 35974) (HVFWDREAD 35976 + . 36830) (HREAD 36832 . 37154) (HPINITRDTBL 37156 . 37990) (HVREADERR 37992 . 38105) (HPRINSP 38107 + . 38245)) (38248 47130 (COPYALL 38258 . 42161) (\COPYDATATYPE 42163 . 42852) (HCOPYALL 42854 . 43164) + (HCOPYALL1 43166 . 47128)) (47131 54425 (EQUALALL 47141 . 52746) (EQUALHASH 52748 . 54423))))) STOP diff --git a/sources/HPRINT.LCOM b/sources/HPRINT.LCOM index 24b13d5b5167bf2247582f62be30aaa63ec097e0..56f075ffa4caa773c24b42aa893ca904f31f5f25 100644 GIT binary patch delta 2681 zcmaJ@Ux-vy7~fep!$mZ;Z7DbVy8dCd-1VMw|4${}ow>6!GBbC)bNA1PikrJxHtUM3 z6)ZMB^biq|+{hk!5-NPNCZVSUA&Pntf{Y3ZsrMx4DX`x;_ukpD#DU>_-*>+A{r{bF zfBHIe`J2qUGfj<+?LXTZ<0{vPX*o^HF;$_ga%^ew)Jv^}d0IM23a!jky+Xxno_ltA z>Fnua3(I>;^`Kk}$Dc7qX;9JB9wSyxH*z|=@a5KauY7!bT%q~7Gcb8CeOnnF%ofWP zFCTbr=oO%J&&ci*2^p5dP0D$NayT~8q|-+iU#48Xpm$)(t+A2aW)U&FZ?op|_A^woyPB|S3C zqv4I?g6@0oZA-TE{LpTpU_=)l zc~h<(&CLbq(CZMtF{JzK78fd=+&JU zGgmtscU|xAZ{6v9pS_%En~X|zF9?X~x7v@XFvR4ti%%Mpy zEO?E4P_Bo5(7?nw4heM*(l)74ck`YQTdQJ=OAQ98sU{k2FoxDWsheFDZV4aKW25fn zg)PpyyDTQdiE>zV>)2C`bdNi$q!pWnOKx_(aKomGpNGug?d~aURTT(IQsIoFJV>hn z9~?fq41uMlI%`@bT?={aJES|`RBQuXqswvVw!@fk`CHsz3M52so^ z=Tt80(rDH~cb1syXsdgwt=+X}vAbBV_o%|AXkqlq?hS3ElE&qrUyuiGx#5w6j&(OM zDA*8DRs90?j8$unF8!v3a5O8as>8H&q#RX}BK?qT$L@)&ZR@?Pt(iTWHn)>z*lIc) z77~+jg=mXqCP7NZkZG0NMu{v~748^WC~h*4R@a<`E*C3aZ8B^_mzjh)iqE0ViMH7t zYSV#BHwfHjJ@D&fT4;%68|8x@*mN?@7&rn%Ch845#TlD`j8_Q@WH@N_fjSwco$j_n zaGKaA0~kzv8z`zc%gI1NQlX}%LWC~^2%9j*tgc3a3>@o1LU(wq>j&jY((Qzkq3fm* zV}O&+Q{d=KC4VZcPlcqbu}4N4#v~DH-F!89e~6|+0YHx10y>Ev6icQ{Xuw#K3Ac5E zeNpi?aZ4917q3P=42YXf>WQPfy*ub{5(C$}P32weauq#~trAPXkLOTVNx;m_hn~Qi zoUhawV?!*p$+{!v7}0xscw2++IUwI=l-@KPjT0g?dfJ@?fr$dopd!o57)SJ?&`h=L zltTM!z5oxTxKp~c8Uvji(~^jfv4ts+U~1!9ac~zP>}u#vpgLruu+qAP0^)@&BytP# zbC}~48O&8xTooqnB!AiqiWPr`Odui|V$#vVc%Df&Oe&UV>!j-zAmO_qNX@23*hXU~ z!EhC}HAkft(vWA|ZN*_>5(GWBH4I`?uk>^k#Wo3tgt6pcIUKbR`Nf9-Odov0VN07=&R!~Sr zS=kOsHJs>UW)3h_Q=?zmQ?8?NY=sKh@T9C16f#W{L`eZ?#Q7$^AcO=KH55XDJ+yfc z9~R^IJ8EY?zcsRXl=|i#?CZ-%9d1 zpPm2ghiJLEV3M!1uAYN3paXPNNKC{ ad-LF$Axk$PoSdkl9af5g&fdcxuKgFY&Zlbt delta 2612 zcma)8O>7ip81AZ9r2j;U|GK zxK}S4bz->a#l!=i2pf$z5)Nu&V&Vy-#)F9`6C~(?qtExv>~t_5=%Mreeed7%zTdYu zzAOCvZQ+C2Go+2Xm(PrIm2={(tg*6TDKw@mub(^r=Gy8Ct-nnQZB)b8uN^(Rer|Pg zZRx^=tCQzeSJqaqPF`HUd|`R@;$*!OG}_U`D_V()O5PP zmM$T{|JmD0sW?_^G`&jTxsg|W)Mzu$$IgokyQ^|W!SjOd-QU$HfZ*_OMSio> zyY~+=7XP)Y)YJF8By6;JdGEXOdv9-Be0#6%yCXas@s^Rh^84F}FTOqXz}k*ys7BnO zQ!RHcsyEu`Q&6IOT%Sd4!hJv4ahZ2WL^eD|KWb`0Q8{=3~;EB>;0^UrwU z@b$t^y$6Ty3=YngdtZ&+D0I1rUV1@5OlLX;oycofL93FM6N5fF4%NJfD;c#A zF&JXVxswc{RK2Dbc@@7M1%4BH)cs!(*K3+p_zkWt);rCd)RvS}sMKJ;JFhr?VVQI^$$n{UNbX zpv)^mM=hQvnJ}`zx*OKXf>#lak%=a!gK4Jjx|~eFU2A&nsi+Q`5#~vrGXZzsIvZ}& zKu9+T-1$!6cgWNMjby{df=4D2N<$?JB$mlQLx(==@N|Cwi zTCz5rG^f8nnq`nb9d)K7(##|x1EprdtX@stBSIfcICjE5W#fDoq{)v6nF*`*nAovFuEuY$gU3*=vN5Uv z7}W&z4k$4iil``Qb4iF0QrQ?26jD<*4uMj+9)HcuA;&S|2keMzI~FvNLKb?dY*ZEO zA_GxZNEaSA=J69oNZ?RIRf=#2z!aJwrAW5jTjakVd;#yPMW?D!H9Wtxyn15k;%bQo zPH!&^6pnA%`NH7raD39AA2xwYXWnf#OT~7h+55)-ep_KA{%Gcp!oK**?CrvAY|qsS zPsQE2zn?zt7R5XK<-@vsisx2t-HSh+A8j3J51zjH>%f?W!SYT{yG^*m)n?`&S_=)# dy}K5gj&aRDyB1~}w@B}~g@vKsdyAiJ`xhY`o_+uT diff --git a/sources/LLDISPLAY b/sources/LLDISPLAY index dc0b0564..634f7a05 100644 --- a/sources/LLDISPLAY +++ b/sources/LLDISPLAY @@ -1,17 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 9-Jul-2022 12:08:02"  -{DSK}kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;16 269372 +(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}LLDISPLAY.;19 270570 - :CHANGES-TO (FNS \COMMON.DSPCREATE) + :EDIT-BY rmk - :PREVIOUS-DATE " 8-Jul-2022 23:44:51" -{DSK}kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;13) + :CHANGES-TO (FNS BITMAPEQUAL) + :PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}LLDISPLAY.;18) -(* ; " -Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT LLDISPLAYCOMS) @@ -33,8 +29,8 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation. (DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CursorBitMap (\CreateCursorBitMap] [COMS (* ; "bitmap functions.") (FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY BITMAPCREATE BITMAPBIT - BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING \SLOWBLTCHAR - TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP + BITMAPEQUAL BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING + \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP \INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (FUNCTIONS FINISH-READING-BITMAP) @@ -1022,6 +1018,29 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation.  "anything outside the clipping region returns 0.") 0]) +(BITMAPEQUAL + [LAMBDA (BM1 BM2) (* ; "Edited 31-Jul-2023 14:50 by rmk") + + (* ;; "T if BM1 and BM2 are both bitmaps of the same shape and contents. The numeric fields are all SMALLP's") + + (if (AND (type? BITMAP BM1) + (type? BITMAP BM2)) + then (CL:WHEN (AND (EQ (ffetch (BITMAP BITMAPWIDTH) of BM1) + (ffetch (BITMAP BITMAPWIDTH) of BM2)) + (EQ (ffetch (BITMAP BITMAPHEIGHT) of BM1) + (ffetch (BITMAP BITMAPHEIGHT) of BM2)) + (EQ (ffetch (BITMAP BITMAPRASTERWIDTH) of BM1) + (ffetch (BITMAP BITMAPRASTERWIDTH) of BM2)) + (EQ (ffetch (BITMAP BITMAPBITSPERPIXEL) of BM1) + (ffetch (BITMAP BITMAPBITSPERPIXEL) of BM2))) + (for I (BASE1 _ (ffetch (BITMAP BITMAPBASE) of BM1)) + (BASE2 _ (ffetch (BITMAP BITMAPBASE) of BM2)) from 0 + to (SUB1 (ITIMES (ffetch (BITMAP BITMAPRASTERWIDTH) of BM1) + (ffetch (BITMAP BITMAPHEIGHT) of BM1))) + always (EQ (\GETBASE BASE1 I) + (\GETBASE BASE2 I)))) + else (BIGBITMAPEQUAL BM1 BM2]) + (BLTCHAR [LAMBDA (CHARCODE DISPLAYSTREAM) (* rmk%: " 4-Apr-85 11:45") (* ; "user entry --- seldom used") @@ -4553,46 +4572,44 @@ Copyright (c) 1981-1990, 1993-1994, 2021 by Venue & Xerox Corporation. (ADDTOVAR LAMA ) ) -(PUTPROPS LLDISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 -1989 1990 1993 1994 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (20598 23266 (\FBITMAPBIT 20608 . 21068) (\FBITMAPBIT.UFN 21070 . 22089) ( -\NEWPAGE.DISPLAY 22091 . 22226) (INITBITMASKS 22228 . 23264)) (25191 25700 (\CreateCursorBitMap 25201 - . 25698)) (25817 84905 (BITBLT 25827 . 36217) (BLTSHADE 36219 . 36997) (\BITBLTSUB 36999 . 47134) ( -\GETPILOTBBTSCRATCHBM 47136 . 47751) (BITMAPCOPY 47753 . 48329) (BITMAPCREATE 48331 . 49891) ( -BITMAPBIT 49893 . 58280) (BLTCHAR 58282 . 58898) (\BLTCHAR 58900 . 59402) (\MEDW.BLTCHAR 59404 . 64282 -) (\CHANGECHARSET.DISPLAY 64284 . 67242) (\INDICATESTRING 67244 . 68440) (\SLOWBLTCHAR 68442 . 75538) -(TEXTUREP 75540 . 75810) (INVERT.TEXTURE 75812 . 76086) (INVERT.TEXTURE.BITMAP 76088 . 77623) ( -BITMAPWIDTH 77625 . 77997) (READBITMAP 77999 . 80509) (\INSUREBITSPERPIXEL 80511 . 80806) ( -MAXIMUMCOLOR 80808 . 80949) (OPPOSITECOLOR 80951 . 81130) (MAXIMUMSHADE 81132 . 81343) (OPPOSITESHADE -81345 . 81524) (\MEDW.BITBLT 81526 . 84903)) (84907 90093 (FINISH-READING-BITMAP 84907 . 90093)) ( -91215 91696 (BITMAPBIT.EXPANDER 91225 . 91694)) (91697 140231 (\BITBLT.DISPLAY 91707 . 114946) ( -\BITBLT.BITMAP 114948 . 124047) (\BITBLT.MERGE 124049 . 126302) (\BLTSHADE.DISPLAY 126304 . 133404) ( -\BLTSHADE.BITMAP 133406 . 140229)) (140232 149552 (\BITBLT.BITMAP.SLOW 140242 . 149550)) (149553 -165934 (\PUNT.BLTSHADE.BITMAP 149563 . 156659) (\PUNT.BITBLT.BITMAP 156661 . 165932)) (165935 169375 ( -\SCALEDBITBLT.DISPLAY 165945 . 167578) (\BACKCOLOR.DISPLAY 167580 . 169373)) (173230 175503 ( -DISPLAYSTREAMP 173240 . 173848) (DSPSOURCETYPE 173850 . 174859) (DSPXOFFSET 174861 . 175180) ( -DSPYOFFSET 175182 . 175501)) (175504 189699 (DSPDESTINATION 175514 . 178617) (DSPTEXTURE 178619 . -178781) (\DISPLAYSTREAMINCRXPOSITION 178783 . 179070) (\SFFixDestination 179072 . 180250) ( -\SFFixClippingRegion 180252 . 182424) (\SFFixFont 182426 . 183476) (\SFFIXLINELENGTH 183478 . 184974) -(\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 184976 . 186789) (\SFFixY 186791 . 189697)) (189700 193547 ( -\SIMPLE.DSPCREATE 189710 . 190260) (\COMMON.DSPCREATE 190262 . 193545)) (193648 195842 (\MEDW.XOFFSET -193658 . 194799) (\MEDW.YOFFSET 194801 . 195840)) (195843 203769 (\DSPCLIPPINGREGION.DISPLAY 195853 . -196599) (\DSPFONT.DISPLAY 196601 . 198971) (\DISPLAY.PILOTBITBLT 198973 . 199122) ( -\DSPLINEFEED.DISPLAY 199124 . 199695) (\DSPLEFTMARGIN.DISPLAY 199697 . 200428) (\DSPOPERATION.DISPLAY -200430 . 201454) (\DSPRIGHTMARGIN.DISPLAY 201456 . 202301) (\DSPXPOSITION.DISPLAY 202303 . 203160) ( -\DSPYPOSITION.DISPLAY 203162 . 203767)) (207957 212993 (TTYDISPLAYSTREAM 207967 . 212991)) (213296 -214326 (DSPSCROLL 213306 . 214006) (PAGEHEIGHT 214008 . 214324)) (214371 217393 (\DSPRESET.DISPLAY -214381 . 217391)) (217429 217952 (\MAYBE-DRIBBLE-CHAR 217429 . 217952)) (217953 238591 (\DSPPRINTCHAR -217963 . 225801) (\DSPPRINTCR/LF 225803 . 238589)) (238592 239184 (\TTYBACKGROUND 238602 . 239182)) ( -239185 242472 (DSPBACKUP 239195 . 242470)) (242656 242912 (COLORDISPLAYP 242666 . 242910)) (242913 -244984 (DISPLAYBEFOREEXIT 242923 . 243749) (DISPLAYAFTERENTRY 243751 . 244982)) (245356 249888 ( -\DSPCLIPTRANSFORMX 245366 . 245955) (\DSPCLIPTRANSFORMY 245957 . 246682) (\DSPTRANSFORMREGION 246684 - . 247216) (\DSPUNTRANSFORMY 247218 . 247478) (\DSPUNTRANSFORMX 247480 . 247740) ( -\OFFSETCLIPPINGREGION 247742 . 249886)) (251202 253789 (UPDATESCREENDIMENSIONS 251212 . 251841) ( -\CreateScreenBitMap 251843 . 253787)) (254348 267507 (\CoerceToDisplayDevice 254358 . 254771) ( -\CREATEDISPLAY 254773 . 256613) (DISPLAYSTREAMINIT 256615 . 259759) (\STARTDISPLAY 259761 . 262672) ( -\MOVE.WINDOWS.ONTO.SCREEN 262674 . 264866) (\UPDATE.PBT.RASTERWIDTHS 264868 . 266650) (\STOPDISPLAY -266652 . 267144) (\DEFINEDISPLAYINFO 267146 . 267505)) (268115 268876 (INITIALIZEDISPLAYSTREAMS 268125 - . 268874))))) + (FILEMAP (NIL (20459 23127 (\FBITMAPBIT 20469 . 20929) (\FBITMAPBIT.UFN 20931 . 21950) ( +\NEWPAGE.DISPLAY 21952 . 22087) (INITBITMASKS 22089 . 23125)) (25052 25561 (\CreateCursorBitMap 25062 + . 25559)) (25678 86230 (BITBLT 25688 . 36078) (BLTSHADE 36080 . 36858) (\BITBLTSUB 36860 . 46995) ( +\GETPILOTBBTSCRATCHBM 46997 . 47612) (BITMAPCOPY 47614 . 48190) (BITMAPCREATE 48192 . 49752) ( +BITMAPBIT 49754 . 58141) (BITMAPEQUAL 58143 . 59605) (BLTCHAR 59607 . 60223) (\BLTCHAR 60225 . 60727) +(\MEDW.BLTCHAR 60729 . 65607) (\CHANGECHARSET.DISPLAY 65609 . 68567) (\INDICATESTRING 68569 . 69765) ( +\SLOWBLTCHAR 69767 . 76863) (TEXTUREP 76865 . 77135) (INVERT.TEXTURE 77137 . 77411) ( +INVERT.TEXTURE.BITMAP 77413 . 78948) (BITMAPWIDTH 78950 . 79322) (READBITMAP 79324 . 81834) ( +\INSUREBITSPERPIXEL 81836 . 82131) (MAXIMUMCOLOR 82133 . 82274) (OPPOSITECOLOR 82276 . 82455) ( +MAXIMUMSHADE 82457 . 82668) (OPPOSITESHADE 82670 . 82849) (\MEDW.BITBLT 82851 . 86228)) (86232 91418 ( +FINISH-READING-BITMAP 86232 . 91418)) (92540 93021 (BITMAPBIT.EXPANDER 92550 . 93019)) (93022 141556 ( +\BITBLT.DISPLAY 93032 . 116271) (\BITBLT.BITMAP 116273 . 125372) (\BITBLT.MERGE 125374 . 127627) ( +\BLTSHADE.DISPLAY 127629 . 134729) (\BLTSHADE.BITMAP 134731 . 141554)) (141557 150877 ( +\BITBLT.BITMAP.SLOW 141567 . 150875)) (150878 167259 (\PUNT.BLTSHADE.BITMAP 150888 . 157984) ( +\PUNT.BITBLT.BITMAP 157986 . 167257)) (167260 170700 (\SCALEDBITBLT.DISPLAY 167270 . 168903) ( +\BACKCOLOR.DISPLAY 168905 . 170698)) (174555 176828 (DISPLAYSTREAMP 174565 . 175173) (DSPSOURCETYPE +175175 . 176184) (DSPXOFFSET 176186 . 176505) (DSPYOFFSET 176507 . 176826)) (176829 191024 ( +DSPDESTINATION 176839 . 179942) (DSPTEXTURE 179944 . 180106) (\DISPLAYSTREAMINCRXPOSITION 180108 . +180395) (\SFFixDestination 180397 . 181575) (\SFFixClippingRegion 181577 . 183749) (\SFFixFont 183751 + . 184801) (\SFFIXLINELENGTH 184803 . 186299) (\UPDATE-SYNONYM-STREAM-LINELENGTH-FIELD 186301 . 188114 +) (\SFFixY 188116 . 191022)) (191025 194872 (\SIMPLE.DSPCREATE 191035 . 191585) (\COMMON.DSPCREATE +191587 . 194870)) (194973 197167 (\MEDW.XOFFSET 194983 . 196124) (\MEDW.YOFFSET 196126 . 197165)) ( +197168 205094 (\DSPCLIPPINGREGION.DISPLAY 197178 . 197924) (\DSPFONT.DISPLAY 197926 . 200296) ( +\DISPLAY.PILOTBITBLT 200298 . 200447) (\DSPLINEFEED.DISPLAY 200449 . 201020) (\DSPLEFTMARGIN.DISPLAY +201022 . 201753) (\DSPOPERATION.DISPLAY 201755 . 202779) (\DSPRIGHTMARGIN.DISPLAY 202781 . 203626) ( +\DSPXPOSITION.DISPLAY 203628 . 204485) (\DSPYPOSITION.DISPLAY 204487 . 205092)) (209282 214318 ( +TTYDISPLAYSTREAM 209292 . 214316)) (214621 215651 (DSPSCROLL 214631 . 215331) (PAGEHEIGHT 215333 . +215649)) (215696 218718 (\DSPRESET.DISPLAY 215706 . 218716)) (218754 219277 (\MAYBE-DRIBBLE-CHAR +218754 . 219277)) (219278 239916 (\DSPPRINTCHAR 219288 . 227126) (\DSPPRINTCR/LF 227128 . 239914)) ( +239917 240509 (\TTYBACKGROUND 239927 . 240507)) (240510 243797 (DSPBACKUP 240520 . 243795)) (243981 +244237 (COLORDISPLAYP 243991 . 244235)) (244238 246309 (DISPLAYBEFOREEXIT 244248 . 245074) ( +DISPLAYAFTERENTRY 245076 . 246307)) (246681 251213 (\DSPCLIPTRANSFORMX 246691 . 247280) ( +\DSPCLIPTRANSFORMY 247282 . 248007) (\DSPTRANSFORMREGION 248009 . 248541) (\DSPUNTRANSFORMY 248543 . +248803) (\DSPUNTRANSFORMX 248805 . 249065) (\OFFSETCLIPPINGREGION 249067 . 251211)) (252527 255114 ( +UPDATESCREENDIMENSIONS 252537 . 253166) (\CreateScreenBitMap 253168 . 255112)) (255673 268832 ( +\CoerceToDisplayDevice 255683 . 256096) (\CREATEDISPLAY 256098 . 257938) (DISPLAYSTREAMINIT 257940 . +261084) (\STARTDISPLAY 261086 . 263997) (\MOVE.WINDOWS.ONTO.SCREEN 263999 . 266191) ( +\UPDATE.PBT.RASTERWIDTHS 266193 . 267975) (\STOPDISPLAY 267977 . 268469) (\DEFINEDISPLAYINFO 268471 . +268830)) (269440 270201 (INITIALIZEDISPLAYSTREAMS 269450 . 270199))))) STOP diff --git a/sources/LLDISPLAY.LCOM b/sources/LLDISPLAY.LCOM index 9659fefc..7aba939d 100644 --- a/sources/LLDISPLAY.LCOM +++ b/sources/LLDISPLAY.LCOM @@ -1,12 +1,9 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 9-Jul-2022 12:08:03" ("compiled on " -{DSK}kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;16) " 8-Jul-2022 23:54:51" -"COMPILE-FILEd" in "FULL 8-Jul-2022 ..." dated " 8-Jul-2022 23:54:57") -(FILECREATED " 9-Jul-2022 12:08:02" -{DSK}kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;16 269372 :CHANGES-TO (FNS -\COMMON.DSPCREATE) :PREVIOUS-DATE " 8-Jul-2022 23:44:51" -{DSK}kaplan>local>medley3.5>working-medley>sources>LLDISPLAY.;13) +(FILECREATED "31-Jul-2023 14:50:58" ("compiled on " {WMEDLEY}LLDISPLAY.;19) +"31-Jul-2023 14:48:17" "COMPILE-FILEd" in "FULL 31-Jul-2023 ..." dated "31-Jul-2023 14:48:24") +(FILECREATED "31-Jul-2023 14:50:58" {WMEDLEY}LLDISPLAY.;19 270570 :EDIT-BY rmk :CHANGES-TO ( +FNS BITMAPEQUAL) :PREVIOUS-DATE "31-Jul-2023 14:45:32" {WMEDLEY}LLDISPLAY.;18) (RPAQQ LLDISPLAYCOMS ((DECLARE%: DONTCOPY (EXPORT (RECORDS PILOTBBT \DISPLAYDATA DISPLAYSTATE DISPLAYINFO) (MACROS \GETDISPLAYDATA))) (* ; "User-visible records are on ADISPLAY --- must be init'ed here") (INITRECORDS BITMAP PILOTBBT REGION @@ -16,12 +13,12 @@ OPTIMIZERS \FBITMAPBIT) (EXPORT (DECLARE%: DONTCOPY (MACROS \BITMASK \4BITMASK \ WORDMASK 65535)))) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INITBITMASKS)))) (COMS (* ; "init cursor") (FNS \CreateCursorBitMap) (DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (CursorBitMap (\CreateCursorBitMap))))) ( COMS (* ; "bitmap functions.") (FNS BITBLT BLTSHADE \BITBLTSUB \GETPILOTBBTSCRATCHBM BITMAPCOPY -BITMAPCREATE BITMAPBIT BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY \INDICATESTRING -\SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP \INSUREBITSPERPIXEL -MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (FUNCTIONS FINISH-READING-BITMAP) -(CONSTANTS (MINIMUMCOLOR 0) (MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE \BITMAPBIT))) ( -DECLARE%: DONTCOPY (EXPORT (MACROS \INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT BITMAPP) (FNS -BITMAPBIT.EXPANDER) (FNS \BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY +BITMAPCREATE BITMAPBIT BITMAPEQUAL BLTCHAR \BLTCHAR \MEDW.BLTCHAR \CHANGECHARSET.DISPLAY +\INDICATESTRING \SLOWBLTCHAR TEXTUREP INVERT.TEXTURE INVERT.TEXTURE.BITMAP BITMAPWIDTH READBITMAP +\INSUREBITSPERPIXEL MAXIMUMCOLOR OPPOSITECOLOR MAXIMUMSHADE OPPOSITESHADE \MEDW.BITBLT) (FUNCTIONS +FINISH-READING-BITMAP) (CONSTANTS (MINIMUMCOLOR 0) (MINIMUMSHADE 0)) (P (MOVD (QUOTE BITMAPBIT) (QUOTE + \BITMAPBIT))) (DECLARE%: DONTCOPY (EXPORT (MACROS \INVALIDATEDISPLAYCACHE))) (OPTIMIZERS BITMAPBIT +BITMAPP) (FNS BITMAPBIT.EXPANDER) (FNS \BITBLT.DISPLAY \BITBLT.BITMAP \BITBLT.MERGE \BLTSHADE.DISPLAY \BLTSHADE.BITMAP) (FNS (* ;; "For SunLoadup") \BITBLT.BITMAP.SLOW) (FNS (* ;; " punt case for C funcs.bitblt_bitmap,bitshade.bitmap") \PUNT.BLTSHADE.BITMAP \PUNT.BITBLT.BITMAP) ( FNS (* ;; "from SUMEX-AIM") \SCALEDBITBLT.DISPLAY \BACKCOLOR.DISPLAY) (DECLARE%: DONTCOPY (CONSTANTS ( @@ -123,18 +120,18 @@ NIL $l dk () (RPAQ CursorBitMap (\CreateCursorBitMap)) BITBLT :D8 -(L (11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTINATION 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCE) F 19 \SOFTCURSORUPP F 20 \CURSORDESTINATION F 21 \SCREENBITMAPS) ¢ D£jb¿E£jb +(L (11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTINATION 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCE) F 19 \SOFTCURSORP F 20 \SOFTCURSORUPP F 21 \CURSORDESTINATION F 22 \SCREENBITMAPS) œ D£jb¿E£jb ¿Ggð²NCdò¿GCDEFGGG gh HÉ.ɹGHDEFGGGlIð@@dò]¿A£jb¿B£jb¿@¹AºB»Fµ3@Èb ¿Gµ@Èb¿±É@ÈBÙ½dMñ²ì¿M°è@ÈAÙ¼dLñ²É¿L°Ågh É0X¢±…A¦HÉ b¿B§HÉ -b¿HɹAHÉØbHÈ"¾dNñ¡¿NºBHÉØbHÈ$_¿dOñ¢¿O»FµNHÈ#JÙb ¿Gµ%HÈ%KÙb¿G¥HÉ6b¿Fjñ´ Gjñ³4hHÈ%KÙ_¿dOñ²Ö¿O°ÑHÈ#JÙ_¿dOñ²­¿O°¨Cdâ±É¿@ ¢±¤h__¿`²8W&´h@gh -W(ð_²`È_¿`jÍ¿¿@gh _`ð³hO -W*—O ¿IABCDEFGGGGGJK O´‚±X¿`OÍ¿±DIABCDEFGGGGGJK gh _@Cð’±ê@ ¢±àC ¢±Ï@dC -¢±Ä¿h__ _"¿`²8W&´h@gh -W(ð_"²`È_ ¿`jÍ¿¿@gh _`ð³hO -W*—O ¿IABFG +b¿HɹAHÉØbHÈ"¾dNñ¡¿NºBHÉØbHÈ$_¿dOñ¢¿O»FµNHÈ#JÙb ¿Gµ%HÈ%KÙb¿G¥HÉ6b¿Fjñ´ Gjñ³4hHÈ%KÙ_¿dOñ²Ö¿O°ÑHÈ#JÙ_¿dOñ²­¿O°¨Cdâ±Æ¿@ ¢±¡h__¿W&²8W(´h@gh +W*ð_²`È_¿`jÍ¿¿@gh _`ð³hO +W,—O ¿IABCDEFGGGGGJK O´‚±U¿`OÍ¿±AIABCDEFGGGGGJK gh _@Cð’±ç@ ¢±ÝC ¢±Ì@dC +¢±Á¿h__ _"¿W&²8W(´h@gh +W*ð_"²`È_ ¿`jÍ¿¿@gh _`ð³hO +W,—O ¿IABFG _jdFGgg -¿O"Ÿ¿`O Í¿OjdODEFGGGGG @ ¿OÉ.É_$¿IABODEFGGGGGJKlO$h(881 TOTOPW 874 BKBITBLT 838 \SOFTCURSORUPCURRENT 829 BKBITBLT 806 BITMAPCREATE 794 \TOTOPWDS 783 DSPDESTINATION 765 \GETSTREAM 752 \SOFTCURSORDOWN 721 DSPDESTINATION 716 \GETSTREAM 679 WOVERLAPP 667 WINDOWP 657 WINDOWP 642 \GETSTREAM 630 \BITBLT.BITMAP 591 \SOFTCURSORUPCURRENT 578 \BITBLT.BITMAP 552 \TOTOPWDS 541 DSPDESTINATION 523 \GETSTREAM 510 \SOFTCURSORDOWN 479 DSPDESTINATION 474 \GETSTREAM 440 WINDOWP 214 \GETSTREAM 61 \GETSTREAM 49 \BLTSHADE.BITMAP) -(896 IMAGEOPS 889 STREAM 844 \EM.DISPINTERRUPT 823 REPLACE 818 INPUT 772 \TOPWDS 759 OUTPUT 743 \EM.DISPINTERRUPT 733 \EM.DISPINTERRUPT 710 OUTPUT 697 \SOFTCURSORP 636 OUTPUT 597 \EM.DISPINTERRUPT 530 \TOPWDS 517 OUTPUT 501 \EM.DISPINTERRUPT 491 \EM.DISPINTERRUPT 468 OUTPUT 455 \SOFTCURSORP 429 BITMAP 404 \DISPLAYDATA 380 \DISPLAYDATA 345 \DISPLAYDATA 328 \DISPLAYDATA 305 \DISPLAYDATA 294 \DISPLAYDATA 277 \DISPLAYDATA 266 \DISPLAYDATA 256 \DISPLAYDATA 226 \DISPLAYDATA 219 STREAM 208 OUTPUT 189 BITMAP 169 BITMAP 155 BITMAP 140 BITMAP 110 BITMAP 77 IMAGEOPS 70 STREAM 55 OUTPUT 28 BITMAP 18 TEXTURE) +¿O"Ÿ¿`O Í¿OjdODEFGGGGG @ ¿OÉ.É_$¿IABODEFGGGGGJKlO$h(875 TOTOPW 868 BKBITBLT 832 \SOFTCURSORUPCURRENT 823 BKBITBLT 800 BITMAPCREATE 788 \TOTOPWDS 777 DSPDESTINATION 759 \GETSTREAM 746 \SOFTCURSORDOWN 715 DSPDESTINATION 710 \GETSTREAM 676 WOVERLAPP 664 WINDOWP 654 WINDOWP 639 \GETSTREAM 627 \BITBLT.BITMAP 588 \SOFTCURSORUPCURRENT 575 \BITBLT.BITMAP 549 \TOTOPWDS 538 DSPDESTINATION 520 \GETSTREAM 507 \SOFTCURSORDOWN 476 DSPDESTINATION 471 \GETSTREAM 440 WINDOWP 214 \GETSTREAM 61 \GETSTREAM 49 \BLTSHADE.BITMAP) +(890 IMAGEOPS 883 STREAM 838 \EM.DISPINTERRUPT 817 REPLACE 812 INPUT 766 \TOPWDS 753 OUTPUT 737 \EM.DISPINTERRUPT 727 \EM.DISPINTERRUPT 704 OUTPUT 633 OUTPUT 594 \EM.DISPINTERRUPT 527 \TOPWDS 514 OUTPUT 498 \EM.DISPINTERRUPT 488 \EM.DISPINTERRUPT 465 OUTPUT 429 BITMAP 404 \DISPLAYDATA 380 \DISPLAYDATA 345 \DISPLAYDATA 328 \DISPLAYDATA 305 \DISPLAYDATA 294 \DISPLAYDATA 277 \DISPLAYDATA 266 \DISPLAYDATA 256 \DISPLAYDATA 226 \DISPLAYDATA 219 STREAM 208 OUTPUT 189 BITMAP 169 BITMAP 155 BITMAP 140 BITMAP 110 BITMAP 77 IMAGEOPS 70 STREAM 55 OUTPUT 28 BITMAP 18 TEXTURE) () BLTSHADE :D8 (L (7 CLIPPINGREGION 6 OPERATION 5 HEIGHT 4 WIDTH 3 DESTINATIONBOTTOM 2 DESTINATIONLEFT 1 DESTINATION 0 TEXTURE)) [Adò¿@ABµjCµjDEFG gh HÉ.ɹ@HBµjCµjDEFd¥H @@ -171,7 +168,7 @@ BITMAPCREATE :D8 NIL ( 102 "bits in BITMAP -- too big" 88 131066) BITMAPBIT :D8 -(P 15 SOFTCURSORUP P 14 DISPINTERRUPT P 13 DD P 12 TY P 11 TX P 6 bitmapbase P 5 oldword P 4 HEIGHT P 3 OLDVALUE P 2 WORDX P 1 BITX P 0 NBITS I 3 NEWVALUE I 2 Y I 1 X I 0 BITMAP F 16 \SOFTCURSORUPP F 17 \CURSORDESTINATION F 18 \SCREENBITMAPS) ì° +(P 15 SOFTCURSORUP P 14 DISPINTERRUPT P 13 DD P 12 TY P 11 TX P 6 bitmapbase P 5 oldword P 4 HEIGHT P 3 OLDVALUE P 2 WORDX P 1 BITX P 0 NBITS I 3 NEWVALUE I 2 Y I 1 X I 0 BITMAP F 16 \SOFTCURSORP F 17 \SOFTCURSORUPP F 18 \CURSORDESTINATION F 19 \SCREENBITMAPS) é° @â±+@ÈXjAñ’± A@Èýñ¢±üjBñ’±õB@È\ýñ¢±åHkð²[Cdjð²¿@ÉABkLkÙ@Èh8³@ÉABlLkÙ@Èh8@ÉABlLkÙ@Èh8@É@ÈBÙkÙ@ÈÚÐ^C²jCñ¯C@È ñ–C ¿Hdkð²c¿AââââZNJÐÈ]`Alå_¿_ÉOl OØÐÈYCµ MIåjð² jjðNJÐMImÿæåÍ¿°èNJÐMIäÍ¿°Ýklð²mAlçYdââââZNJÐÈ]d`Alå_¿_ÉOl OØÐÈå[C²NJÐMKæCllAlåÙÚ @@ -180,27 +177,32 @@ BITMAPBIT :D8 [C—NAC KoH 0 @gh bÉ0_AO _BO -_O¢±þºd¢±þµ `²-W ´ h@ -W"ð_²`È_¿`jÍ¿¿@`ð³h@ -W$–@ ¿OÉOOCû_¿Ož¿`OÍO(733 \SOFTCURSORUPCURRENT 705 \TOTOPWDS 695 DSPDESTINATION 678 \SOFTCURSORDOWN 647 DSPDESTINATION 613 \DSPCLIPTRANSFORMY 603 \DSPCLIPTRANSFORMX 579 \GETSTREAM 563 ERROR 550 \PUTBASE24 539 \GETBASE24 435 LRSH 415 LLSH 382 \GETBASEFIXP 275 \GETBASEFIXP 220 \ILLEGAL.ARG 212 MAXIMUMCOLOR) -(739 \EM.DISPINTERRUPT 713 \DISPLAYDATA 685 \TOPWDS 669 \EM.DISPINTERRUPT 659 \EM.DISPINTERRUPT 634 \SOFTCURSORP 593 \DISPLAYDATA 586 STREAM 573 OUTPUT 375 ARRAYP 366 ARRAYP 352 4BITMASKARRAY 268 ARRAYP 259 ARRAYP 245 BITMASKARRAY 205 BITMAP 186 BITMAP 174 BITMAP 166 BITMAP 154 BITMAP 139 BITMAP 127 BITMAP 112 BITMAP 98 BITMAP 84 BITMAP 57 BITMAP 35 BITMAP 18 BITMAP 8 BITMAP) +_O¢±þºd¢±þµ W ²-W"´ h@ +W$ð_²`È_¿`jÍ¿¿@`ð³h@ +W&–@ ¿OÉOOCû_¿Ož¿`OÍO(730 \SOFTCURSORUPCURRENT 702 \TOTOPWDS 692 DSPDESTINATION 675 \SOFTCURSORDOWN 644 DSPDESTINATION 613 \DSPCLIPTRANSFORMY 603 \DSPCLIPTRANSFORMX 579 \GETSTREAM 563 ERROR 550 \PUTBASE24 539 \GETBASE24 435 LRSH 415 LLSH 382 \GETBASEFIXP 275 \GETBASEFIXP 220 \ILLEGAL.ARG 212 MAXIMUMCOLOR) +(736 \EM.DISPINTERRUPT 710 \DISPLAYDATA 682 \TOPWDS 666 \EM.DISPINTERRUPT 656 \EM.DISPINTERRUPT 593 \DISPLAYDATA 586 STREAM 573 OUTPUT 375 ARRAYP 366 ARRAYP 352 4BITMASKARRAY 268 ARRAYP 259 ARRAYP 245 BITMASKARRAY 205 BITMAP 186 BITMAP 174 BITMAP 166 BITMAP 154 BITMAP 139 BITMAP 127 BITMAP 112 BITMAP 98 BITMAP 84 BITMAP 57 BITMAP 35 BITMAP 18 BITMAP 8 BITMAP) ( 557 "unknown bits per pixel size.") +BITMAPEQUAL :D8 +(P 3 BASE2 P 2 BASE1 P 1 I I 1 BM2 I 0 BM1) k@ò\AòT@ÈAÈð´J@ÈAÈð´A@ÈAÈð´8@ÈAÈð´/@È@ÈÚkÙj@ÉAÉIHó³JIÐÈKIÐÈð¡hIkÔY°êi@A +(104 BIGBITMAPEQUAL) +(13 BITMAP 5 BITMAP) +() BLTCHAR :D8 (I 1 DISPLAYSTREAM I 0 CHARCODE) 2@d—¿j@ñ¡@…@ Adgh É0 (47 \BLTCHAR 30 \GETSTREAM 17 \ILLEGAL.ARG) (42 \DISPLAYDATA 35 STREAM 24 OUTPUT) () \BLTCHAR :D8 -(P 0 A0448 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM) +(P 0 A0229 I 2 DISPLAYDATA I 1 DISPLAYSTREAM I 0 CHARCODE) (Agh bÉ.ÉZ@ABlH(11 \GETSTREAM) (25 IMAGEOPS 18 STREAM 5 OUTPUT) () \MEDW.BLTCHAR :D8 -(L (2 DISPLAYDATA 1 DISPLAYSTREAM 0 CHARCODE) F 7 \SOFTCURSORUPP F 8 \CURSORDESTINATION F 9 \SCREENBITMAPS) p@lÿå\¿BdÉ>@ãð¨@ã +(L (2 DISPLAYDATA 1 DISPLAYSTREAM 0 CHARCODE) F 7 \SOFTCURSORP F 8 \SOFTCURSORUPP F 9 \CURSORDESTINATION F 10 \SCREENBITMAPS)  p@lÿå\¿BdÉ>@ãð¨@ã ¿BÉ—@A BÉ[BÉ0LÐÈØYBÉñŸKBÉñ™l A -°ÃBKBÉLÐÈØ¿BɸKHØ»IHØYBÈ#Xñ‘H¹KBÈ"Xñ‘K€HºIJñ´‚±“BÉ*XÈ jð’±h]¾`²*W´ hA -Wð^²`Ƚ`jÍ¿¿A`ð³hA -W–A ¿HJÍ¿HIJÙÍ¿HBÉLÐÈJØKÙÍ¿Hjv¿N¿`MÍih(255 \SOFTCURSORUPCURRENT 216 \TOTOPWDS 206 DSPDESTINATION 189 \SOFTCURSORDOWN 161 DSPDESTINATION 68 \DSPPRINTCR/LF 35 \SLOWBLTCHAR 23 \CHANGECHARSET.DISPLAY) -(261 \EM.DISPINTERRUPT 196 \TOPWDS 180 \EM.DISPINTERRUPT 172 \EM.DISPINTERRUPT 148 \SOFTCURSORP 132 PILOTBBT) +°ÃBKBÉLÐÈØ¿BɸKHØ»IHØYBÈ#Xñ‘H¹KBÈ"Xñ‘K€HºIJñ´‚±ŽBÉ*XÈ jð³}h]¾W²*W´ hA +Wð^²`Ƚ`jÍ¿¿A`ð³hA +W–A ¿HJÍ¿HIJÙÍ¿HBÉLÐÈJØKÙÍ¿Hjv¿N¿`MÍih(250 \SOFTCURSORUPCURRENT 211 \TOTOPWDS 201 DSPDESTINATION 184 \SOFTCURSORDOWN 156 DSPDESTINATION 68 \DSPPRINTCR/LF 35 \SLOWBLTCHAR 23 \CHANGECHARSET.DISPLAY) +(256 \EM.DISPINTERRUPT 191 \TOPWDS 175 \EM.DISPINTERRUPT 167 \EM.DISPINTERRUPT 132 PILOTBBT) () \CHANGECHARSET.DISPLAY :D8 (P 4 \INTERRUPTABLE P 2 BM P 1 CSINFO P 0 PBT I 1 CHARSET I 0 DISPLAYDATA) Š@É*@É ÉAàÐɵ A@É h "@IÉ¿@IÉ¿@IÉ0¿@A>¿IɺHJÈàààànÿÿåÍ¿@È'IÈ @@ -218,17 +220,17 @@ BLTCHAR :D8 (75 ^ 52 %# 16 SI::RESETUNWIND) ( 81 "" 58 "") \SLOWBLTCHAR :D8 -(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 17 \SOFTCURSORUPP F 18 \CURSORDESTINATION F 19 \SCREENBITMAPS) N@@lÿåYAÉ0ZdÉ È Xdj𢱀 JÉ_JÉIÐÈØ\JÉñ²l A -¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢±OÈ jð’±M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ `²-W"´ hA -W$ð_²`È_¿`jÍ¿¿A`ð³hA -W&–A ¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±·0JÉ_¿JÉIÐÈ_¿JÉ É@ãàÐɵ @ãJÉ h _ ¿HdlZð²;¿AOOØ +(P 16 CSINFO P 15 HEIGHTMOVED P 14 YPOS P 13 SOFTCURSORUP P 12 DISPINTERRUPT P 11 SOURCEBIT P 10 WIDTH P 9 DESTBIT P 8 PILOTBBT P 7 CURX P 6 RIGHT P 5 LEFT P 4 NEWX P 2 DD P 1 CHAR8CODE P 0 ROTATION I 1 DISPLAYSTREAM I 0 CHARCODE F 17 \SOFTCURSORP F 18 \SOFTCURSORUPP F 19 \CURSORDESTINATION F 20 \SCREENBITMAPS) K@@lÿåYAÉ0ZdÉ È Xdjð¢±~€ JÉ_JÉIÐÈØ\JÉñ²l A +¿JÉ_JÉIÐÈؼJL¿OJÉØ_¿JÈ"dOñ¢¿O½JÈ#LJÉØ»dKñ‘¿K¾JÉ*_¿NMñ¢± OÈ jð’±M_¿NMÙ_¿JÉIÐÈMØOÙ_¿JÉÈdkð³adlð²¿Oàà_¿Oàà_¿Oàà_°Ddlð²¿Oààà_¿Oààà_¿Oààà_°$lð²lOÚ_¿lOÚ_¿lOÚ_„¿ W"²-W$´ hA +W&ð_²`È_¿`jÍ¿¿A`ð³hA +W(–A ¿OOÍ¿OOÍ¿OOÍ¿Ojv¿OŸ¿`OÍ¿±·0JÉ_¿JÉIÐÈ_¿JÉ É@ãàÐɵ @ãJÉ h _ ¿HdlZð²;¿AOOØ ¿O ÉjJÉIÐÈAJÉO È ÙkØOO È O È ØO °Hnð²8AOOÙ ¿O ÉjJÉIÐÈAJÉO È ÙJÉO È -O È ØO ‰o h(586 ERROR 575 BKBITBLT 533 \DSPYPOSITION.DISPLAY 514 BKBITBLT 471 \DSPYPOSITION.DISPLAY 449 \CREATECHARSET 390 \SOFTCURSORUPCURRENT 355 \TOTOPWDS 345 DSPDESTINATION 328 \SOFTCURSORDOWN 297 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF) -(396 \EM.DISPINTERRUPT 335 \TOPWDS 319 \EM.DISPINTERRUPT 309 \EM.DISPINTERRUPT 284 \SOFTCURSORP 111 \DISPLAYDATA 83 \DISPLAYDATA) -( 581 "Not implemented to rotate by other than 0, 90 or 270") +O È ØO ‰o h(583 ERROR 572 BKBITBLT 530 \DSPYPOSITION.DISPLAY 511 BKBITBLT 468 \DSPYPOSITION.DISPLAY 446 \CREATECHARSET 387 \SOFTCURSORUPCURRENT 352 \TOTOPWDS 342 DSPDESTINATION 325 \SOFTCURSORDOWN 294 DSPDESTINATION 275 SHOULDNT 55 \DSPPRINTCR/LF) +(393 \EM.DISPINTERRUPT 332 \TOPWDS 316 \EM.DISPINTERRUPT 306 \EM.DISPINTERRUPT 111 \DISPLAYDATA 83 \DISPLAYDATA) +( 578 "Not implemented to rotate by other than 0, 90 or 270") TEXTUREP :D8 (I 0 OBJECT) @d3 ³ô@Èkð´@NIL (18 BITMAP 10 BITMAP) @@ -276,7 +278,7 @@ OPPOSITESHADE :D8 NIL () \MEDW.BITBLT :D8 -(P 9 A0451 P 8 A0450 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0449 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)  +(P 9 A0232 P 8 A0231 P 7 SOURCEBOTTOMTRANSFORMED P 6 SOURCELEFTTRANSFORMED P 3 SRCWIN P 2 A0230 P 1 DD P 0 DSTWIN I 11 CLIPPINGREGION I 10 TEXTURE I 9 OPERATION I 8 SOURCETYPE I 7 HEIGHT I 6 WIDTH I 5 DESTINATIONBOTTOM I 4 DESTINATIONLEFT I 3 DESTINATION I 2 SOURCEBOTTOM I 1 SOURCELEFT I 0 SOURCE F 10 \SCREENBITMAPS)   @ ³C ªo ¿@òZ@²WCi Cgh É0HÉ2ÉHºHÉ2@ABCDEFGGGGGABlJ±–Cô‚±¯C´‚±¨@i !@gh É0AIÉصABIÉصBKÉ2ÉJ_¿KÉ2IÉNOCDEFGGGGGNIÈ"¼dLñ¡¿LOIÈ$½dMñ¡¿MlO±Þ@ @@ -315,28 +317,28 @@ BITMAPBIT.EXPANDER :D8 NIL ( 32 (OPCODES MISC4 6)) \BITBLT.DISPLAY :D8 -(L (11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTINATION 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCEBITMAP) F 48 \SCREENBITMAPS F 49 \SOFTCURSORUPP F 50 \CURSORDESTINATION) 0 ðð@dò[¿A£jb¿B£jb¿AºB»Fµ3@Èb ¿Gµ@Èb¿±Í@ÈBÙ½dMñ²ì¿M°è@ÈAÙ¼dLñ²É¿L°Ågh É0X¢±‰@¹A¦HÉ +(L (11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTINATION 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCEBITMAP) F 48 \SCREENBITMAPS F 49 \SOFTCURSORP F 50 \SOFTCURSORUPP F 51 \CURSORDESTINATION) x0 ðð@dò[¿A£jb¿B£jb¿AºB»Fµ3@Èb ¿Gµ@Èb¿±Í@ÈBÙ½dMñ²ì¿M°è@ÈAÙ¼dLñ²É¿L°Ågh É0X¢±‰@¹A¦HÉ b¿B§HÉ -b¿HÉb¿AHÉØbHÈ"¾dNñ¡¿NºBHÉØbHÈ$_¿dOñ¢¿O»FµNHÈ#JÙb ¿Gµ%HÈ%KÙb¿G¥HÉ6b¿Fjñ´ Gjñ³4hHÈ%KÙ_¿dOñ²Ö¿O°ÑHÈ#JÙ_¿dOñ²­¿O°¨Cdâ±É¿I ¢±¤h__¿`²8Wb´h@gh -Wdð_²`È_¿`jÍ¿¿@gh _`ð³hO -W`—O ¿@ABCDEFGGGGGJK O´‚±”¿`OÍ¿±€@ABCDEFGGGGGJK gh _IdCð’± ³I¢±&Id ¢±¿C ¢±òIdC -¢±ç¿I ÉÉ.C ÉÉ.ð¢±Âh__ _"¿`²8Wb´hIgh -Wdð_"²`È_ ¿`jÍ¿¿Igh _`ð³hO +b¿HÉb¿AHÉØbHÈ"¾dNñ¡¿NºBHÉØbHÈ$_¿dOñ¢¿O»FµNHÈ#JÙb ¿Gµ%HÈ%KÙb¿G¥HÉ6b¿Fjñ´ Gjñ³4hHÈ%KÙ_¿dOñ²Ö¿O°ÑHÈ#JÙ_¿dOñ²­¿O°¨Cdâ±Æ¿I ¢±¡h__¿Wb²8Wd´h@gh +Wfð_²`È_¿`jÍ¿¿@gh _`ð³hO +W`—O ¿@ABCDEFGGGGGJK O´‚±Ž¿`OÍ¿±z@ABCDEFGGGGGJK gh _IdCð’± ³I¢±#Id ¢±¿C ¢±ïIdC +¢±ä¿I ÉÉ.C ÉÉ.𢱿h__ _"¿Wb²8Wd´hIgh +Wfð_"²`È_ ¿`jÍ¿¿Igh _`ð³hO W`—O ¿@ABFG _jdFGgg ¿O"Ÿ¿`O Í¿OjdODEFGGGGG I ¿I²hI hO -ð¢±ö°)OÉ0_JÉ_L¿O`ð³hO +ð¢±ó°)OÉ0_JÉ_L¿O`ð³hO W`—O ¿DOJÉØb¿EOJÉØb -¿OJÈ"_B¿OJÈ$_F¿OJÈ#_H¿OJÈ%_D¿G²nOBGOJÉØ_(¿dO(ñ¢¿O(_B¿OFGOJÉØ_*¿dO*ñ¢¿O*_F¿OHO(GØ_$¿dO$ñ’¿O$_H¿ODO*GØ_&¿dO&ñ’¿O&_D¿OLÈ_N¿@È_PONð³2OPkð²@jON ON °ONkð¢±Ë@ON -b¿DdOBñ¢¿OB_B¿EdOFñ¢¿OF_F¿FDFØdOHñ’¿OH_H¿GžEGØdODñ’¿OD_D¿DAÙ_>¿EBÙ_@¿JOBO>Ù_,¿dO,ñ¢¿O,djñ¡¿j_B¿KOFO@Ù_.¿dO.ñ¢¿O.djñ¡¿j_F¿@ÈOHO>Ù_0¿dO0ñ’¿O0JFØ_2¿dO2ñ’¿O2_H¿@ÈODO@Ù_4¿dO4ñ’¿O4KGØ_6¿dO6ñ’¿O6_D¿OHOBñ¢±ïODOFñ¢±æG¦OJÉb¿ON _R¿Gdgð²~¿Gd²¿ONkð™G bG£OR°JGd3 —ORåORæ°<òG`µld +¿OJÈ"_B¿OJÈ$_F¿OJÈ#_H¿OJÈ%_D¿G²nOBGOJÉØ_(¿dO(ñ¢¿O(_B¿OFGOJÉØ_*¿dO*ñ¢¿O*_F¿OHO(GØ_$¿dO$ñ’¿O$_H¿ODO*GØ_&¿dO&ñ’¿O&_D¿OLÈ_N¿@È_PONð³2OPkð²@jON ON °ONkð¢±È@ON +b¿DdOBñ¢¿OB_B¿EdOFñ¢¿OF_F¿FDFØdOHñ’¿OH_H¿GžEGØdODñ’¿OD_D¿DAÙ_>¿EBÙ_@¿JOBO>Ù_,¿dO,ñ¢¿O,djñ¡¿j_B¿KOFO@Ù_.¿dO.ñ¢¿O.djñ¡¿j_F¿@ÈOHO>Ù_0¿dO0ñ’¿O0JFØ_2¿dO2ñ’¿O2_H¿@ÈODO@Ù_4¿dO4ñ’¿O4KGØ_6¿dO6ñ’¿O6_D¿OHOBñ¢±ìODOFñ¢±ãG¦OJÉb¿ON _R¿Gdgð²~¿Gd²¿ONkð™G bG£OR°JGd3 —ORåORæ°<òG`µld  °ONkð©GON †G b¿ONdkð³)¿GON -°gð²ONdkðœ¿G b¿ONkð³ONOBÚ_B¿ONOHÚ_H¿ONO>Ú_>¿h_8_:¿`².Wb´ hO -Wdð_:²`È_8¿`jÍ¿¿O`ð³hO -W`—O ¿`/ODOFÙ_T¿OHOBÙ_V¿OLÈODO@ØÙ_X¿OBO>Ø_Z¿@ÈODÙ_\¿OB_^¿`OVÍ¿`OTÍ ¿Ggð²"`@O^O\OLOZOXOVOTGG ° `@O^O\OLOZOXOTGGG O:Ÿ¿`O8Í¿°.OÉ.É_<¿@ABODEFGGGGGJKlO<h(1859 \SOFTCURSORUPCURRENT 1850 \BITBLTSUB 1818 \BITBLT.MERGE 1683 \TOTOPWDS 1672 DSPDESTINATION 1653 \SOFTCURSORDOWN 1622 DSPDESTINATION 1564 INSURE.B&W.TEXTURE 1540 COLORTEXTUREFROMCOLOR# 1520 \ILLEGAL.ARG 1512 COLORNUMBERP 1496 INVERT.TEXTURE.BITMAP 1486 BITMAPCREATE 1438 INSURE.B&W.TEXTURE 1404 MAXIMUMSHADE 1171 UNCOLORIZEBITMAP 1166 COLORMAP 1148 COLORIZEBITMAP 1141 MAXIMUMCOLOR 915 \TOTOPWDS 904 DSPDESTINATION 857 DSPDESTINATION 849 DSPDESTINATION 838 TOTOPW 831 BKBITBLT 795 \SOFTCURSORUPCURRENT 786 BKBITBLT 763 BITMAPCREATE 751 \TOTOPWDS 740 DSPDESTINATION 722 \GETSTREAM 709 \SOFTCURSORDOWN 678 DSPDESTINATION 673 \GETSTREAM 627 \INSUREWINDOW 612 \INSUREWINDOW 601 WOVERLAPP 589 WINDOWP 578 WFROMDS 564 WINDOWP 549 \GETSTREAM 537 \BITBLT.BITMAP 498 \SOFTCURSORUPCURRENT 485 \BITBLT.BITMAP 459 \TOTOPWDS 448 DSPDESTINATION 430 \GETSTREAM 417 \SOFTCURSORDOWN 386 DSPDESTINATION 381 \GETSTREAM 347 WINDOWP 117 \GETSTREAM) -(1887 IMAGEOPS 1880 STREAM 1865 \EM.DISPINTERRUPT 1825 \SYSPILOTBBT 1793 \SYSPILOTBBT 1785 MERGE 1773 PILOTBBT 1768 \SYSPILOTBBT 1758 PILOTBBT 1753 \SYSPILOTBBT 1735 BITMAP 1710 BITMAP 1661 \TOPWDS 1644 \EM.DISPINTERRUPT 1634 \EM.DISPINTERRUPT 1608 \SOFTCURSORP 1547 TEXTURE 1491 \BBSCRATCHTEXTURE 1476 \BBSCRATCHTEXTURE 1467 BITMAP 1415 MERGE 1111 BITMAP 1038 \DISPLAYDATA 1008 \DISPLAYDATA 987 \DISPLAYDATA 975 \DISPLAYDATA 963 \DISPLAYDATA 951 \DISPLAYDATA 938 \DISPLAYDATA 924 \DISPLAYDATA 893 \TOPWDS 881 \DISPLAYDATA 872 STREAM 801 \EM.DISPINTERRUPT 780 REPLACE 775 INPUT 729 \TOPWDS 716 OUTPUT 700 \EM.DISPINTERRUPT 690 \EM.DISPINTERRUPT 667 OUTPUT 654 \SOFTCURSORP 634 STREAM 619 STREAM 543 OUTPUT 504 \EM.DISPINTERRUPT 437 \TOPWDS 424 OUTPUT 408 \EM.DISPINTERRUPT 398 \EM.DISPINTERRUPT 375 OUTPUT 362 \SOFTCURSORP 336 BITMAP 311 \DISPLAYDATA 287 \DISPLAYDATA 252 \DISPLAYDATA 235 \DISPLAYDATA 212 \DISPLAYDATA 201 \DISPLAYDATA 184 \DISPLAYDATA 173 \DISPLAYDATA 161 \DISPLAYDATA 129 \DISPLAYDATA 122 STREAM 111 OUTPUT 92 BITMAP 72 BITMAP 58 BITMAP 43 BITMAP 15 BITMAP) +°gð²ONdkðœ¿G b¿ONkð³ONOBÚ_B¿ONOHÚ_H¿ONO>Ú_>¿h_8_:¿Wb².Wd´ hO +Wfð_:²`È_8¿`jÍ¿¿O`ð³hO +W`—O ¿`/ODOFÙ_T¿OHOBÙ_V¿OLÈODO@ØÙ_X¿OBO>Ø_Z¿@ÈODÙ_\¿OB_^¿`OVÍ¿`OTÍ ¿Ggð²"`@O^O\OLOZOXOVOTGG ° `@O^O\OLOZOXOTGGG O:Ÿ¿`O8Í¿°.OÉ.É_<¿@ABODEFGGGGGJKlO<h(1850 \SOFTCURSORUPCURRENT 1841 \BITBLTSUB 1809 \BITBLT.MERGE 1674 \TOTOPWDS 1663 DSPDESTINATION 1644 \SOFTCURSORDOWN 1613 DSPDESTINATION 1558 INSURE.B&W.TEXTURE 1534 COLORTEXTUREFROMCOLOR# 1514 \ILLEGAL.ARG 1506 COLORNUMBERP 1490 INVERT.TEXTURE.BITMAP 1480 BITMAPCREATE 1432 INSURE.B&W.TEXTURE 1398 MAXIMUMSHADE 1165 UNCOLORIZEBITMAP 1160 COLORMAP 1142 COLORIZEBITMAP 1135 MAXIMUMCOLOR 909 \TOTOPWDS 898 DSPDESTINATION 851 DSPDESTINATION 843 DSPDESTINATION 832 TOTOPW 825 BKBITBLT 789 \SOFTCURSORUPCURRENT 780 BKBITBLT 757 BITMAPCREATE 745 \TOTOPWDS 734 DSPDESTINATION 716 \GETSTREAM 703 \SOFTCURSORDOWN 672 DSPDESTINATION 667 \GETSTREAM 624 \INSUREWINDOW 609 \INSUREWINDOW 598 WOVERLAPP 586 WINDOWP 575 WFROMDS 561 WINDOWP 546 \GETSTREAM 534 \BITBLT.BITMAP 495 \SOFTCURSORUPCURRENT 482 \BITBLT.BITMAP 456 \TOTOPWDS 445 DSPDESTINATION 427 \GETSTREAM 414 \SOFTCURSORDOWN 383 DSPDESTINATION 378 \GETSTREAM 347 WINDOWP 117 \GETSTREAM) +(1878 IMAGEOPS 1871 STREAM 1856 \EM.DISPINTERRUPT 1816 \SYSPILOTBBT 1784 \SYSPILOTBBT 1776 MERGE 1764 PILOTBBT 1759 \SYSPILOTBBT 1749 PILOTBBT 1744 \SYSPILOTBBT 1726 BITMAP 1701 BITMAP 1652 \TOPWDS 1635 \EM.DISPINTERRUPT 1625 \EM.DISPINTERRUPT 1541 TEXTURE 1485 \BBSCRATCHTEXTURE 1470 \BBSCRATCHTEXTURE 1461 BITMAP 1409 MERGE 1105 BITMAP 1032 \DISPLAYDATA 1002 \DISPLAYDATA 981 \DISPLAYDATA 969 \DISPLAYDATA 957 \DISPLAYDATA 945 \DISPLAYDATA 932 \DISPLAYDATA 918 \DISPLAYDATA 887 \TOPWDS 875 \DISPLAYDATA 866 STREAM 795 \EM.DISPINTERRUPT 774 REPLACE 769 INPUT 723 \TOPWDS 710 OUTPUT 694 \EM.DISPINTERRUPT 684 \EM.DISPINTERRUPT 661 OUTPUT 631 STREAM 616 STREAM 540 OUTPUT 501 \EM.DISPINTERRUPT 434 \TOPWDS 421 OUTPUT 405 \EM.DISPINTERRUPT 395 \EM.DISPINTERRUPT 372 OUTPUT 336 BITMAP 311 \DISPLAYDATA 287 \DISPLAYDATA 252 \DISPLAYDATA 235 \DISPLAYDATA 212 \DISPLAYDATA 201 \DISPLAYDATA 184 \DISPLAYDATA 173 \DISPLAYDATA 161 \DISPLAYDATA 129 \DISPLAYDATA 122 STREAM 111 OUTPUT 92 BITMAP 72 BITMAP 58 BITMAP 43 BITMAP 15 BITMAP) () \BITBLT.BITMAP :D8 (L (13 CLIPPEDSOURCEBOTTOM 12 CLIPPEDSOURCELEFT 11 CLIPPINGREGION 10 TEXTURE 9 OPERATION 8 SOURCETYPE 7 HEIGHT 6 WIDTH 5 DESTINATIONBOTTOM 4 DESTINATIONLEFT 3 DESTBITMAP 2 SOURCEBOTTOM 1 SOURCELEFT 0 SOURCEBITMAP) P 18 \INTERRUPTABLE) ð0CÈ[CÈ\j]d^@È_CÈZG²QMG_¿dOñ¢¿O½NG_¿dOñ¢¿O¾JGGØ_¿dOñ’¿OºKGGØ_¿dOñ’¿O»DdMñ¡¿M½EdNñ¡¿N¾F™DFØdJñ‘¿JºGšEGØdKñ‘¿K»DAÙXEBÙYGdjñ¡¿jMHÙ_¿dOñ¢¿O½Gdjñ¡¿jNIÙ_¿dOñ¢¿O¾@ÈJHÙ_¿dOñ’¿OGFØ_¿dOñ’¿Oº@ÈKIÙ_ ¿dO ñ’¿O GGØ_"¿dO"ñ’¿O"[JMñ´dNñ¡hGgð²WGµnÿÿ°K3 ›Gnÿÿånÿÿæ° ¸``ó«``ó–H ¿HŒdI µò`` +(P 2 \INTERRUPTABLE P 1 W P 0 OLDWINDOWS F 3 \MAINSCREEN F 4 \WINDOWWORLD F 5 \CURSORDESTINATION F 6 WINDOWBACKGROUNDSHADE F 7 \CURSORDESTWIDTH F 8 \CURSORDESTHEIGHT F 9 \CURSORDESTRASTERWIDTH) <``ðœ``ð³AT²> ¸``ó«``ó–H ¿HŒdI µò`` É`È -¿ijd``hSµ;`c -`c`c`Èc H²P` ¿H °:`¿S`¿S`¿°ždI µò``h(291 \OPENW1 235 REVERSE 228 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS) -(316 \OLDSCREENWIDTH 311 SCREENWIDTH 306 \OLDSCREENHEIGHT 301 SCREENHEIGHT 275 SCREENHEIGHT 270 SCREEN 261 SCREENWIDTH 256 SCREEN 247 ScreenBitMap 242 SCREEN 223 WINDOWBACKGROUNDSHADE 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH) +¿ijd``hSµ7`c +`c`c`ÈcH²LV ¿H °:`¿S`¿S`¿°¢dI µò``h(287 \OPENW1 231 REVERSE 224 CHANGEBACKGROUND 142 SHOWDISPLAY 113 \CreateScreenBitMap 90 \CLOSEW1 76 \MOVE.WINDOWS.ONTO.SCREEN 45 REVERSE 40 OPENWINDOWS 7 UPDATESCREENDIMENSIONS) +(312 \OLDSCREENWIDTH 307 SCREENWIDTH 302 \OLDSCREENHEIGHT 297 SCREENHEIGHT 271 SCREENHEIGHT 266 SCREEN 257 SCREENWIDTH 252 SCREEN 243 ScreenBitMap 238 SCREEN 211 BITMAP 206 ScreenBitMap 199 SCREENHEIGHT 192 SCREENWIDTH 185 ScreenBitMap 177 WHOLESCREEN 172 WHOLEDISPLAY 162 SCREENHEIGHT 157 SCREENWIDTH 149 \DisplayStarted 135 BITMAP 130 ScreenBitMap 123 BITMAP 118 ScreenBitMap 108 SCREENHEIGHT 103 SCREENWIDTH 68 SCREENHEIGHT 63 \OLDSCREENHEIGHT 56 SCREENWIDTH 51 \OLDSCREENWIDTH 29 \OLDSCREENHEIGHT 24 SCREENHEIGHT 17 \OLDSCREENWIDTH 12 SCREENWIDTH) () \MOVE.WINDOWS.ONTO.SCREEN :D8 (P 4 REG P 3 YFACTOR P 2 XFACTOR P 1 W I 0 WINDOWS) Ú@Hµ+h´&```ëZ``ë[@HµAhYÉLLØmÿØ`óµLLØmÿØ`ó•Iµ¥i°¢HX°™Yd ð²\Ii @@ -794,6 +796,4 @@ hdg cgkPh (INITIALIZEDISPLAYSTREAMS) (DISPLAYSTREAMINIT 1000) (PUTPROPS LLDISPLAY FILETYPE COMPILE-FILE) -(PUTPROPS LLDISPLAY COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 -1989 1990 1993 1994 2021)) NIL From 5e83d635676f5cdacf2faef83687a4e6c0543910 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Sat, 28 Oct 2023 14:21:32 -0700 Subject: [PATCH 35/37] VIRTUALKEYBOARD: fix loadup (#1262) * VIRTUALKEYBOARD: fix loadup * Reorganizing VIRTUALKEYBOARDS as described in #1267 * KEYBOARDEDITOR: fixed one bug, still is out of step * Move KEYBOARDCONFIGS KEYBOARDEDIT to library/virtualkeyboards This collects all files relevant to VIRTUALKEYBOARDS into the same subdirectory --- library/DANDELIONKEYBOARDS | 171 --- library/DORADOKEYBOARDS | 171 --- library/DOVEKEYBOARDS | 171 --- library/KEYBOARDEDITOR.LCOM | Bin 28389 -> 0 bytes library/MAIKOKEYBOARDS | Bin 9256 -> 0 bytes library/VIRTUALKEYBOARDS.LCOM | Bin 49495 -> 0 bytes library/virtualkeyboards/DANDELIONKEYBOARDS | 625 +++++++++++ library/virtualkeyboards/DORADOKEYBOARDS | 624 +++++++++++ library/virtualkeyboards/DOVEKEYBOARDS | 631 +++++++++++ .../{ => virtualkeyboards}/KEYBOARDCONFIGS | 979 +++++++++--------- library/{ => virtualkeyboards}/KEYBOARDEDITOR | 95 +- library/virtualkeyboards/KEYBOARDEDITOR.LCOM | Bin 0 -> 28327 bytes .../{ => virtualkeyboards}/VIRTUALKEYBOARDS | 416 +++----- .../virtualkeyboards/VIRTUALKEYBOARDS.LCOM | Bin 0 -> 48819 bytes .../VIRTUALKEYBOARDS.TEDIT} | Bin library/virtualkeyboards/XKEYBOARDS | Bin 0 -> 17050 bytes 16 files changed, 2582 insertions(+), 1301 deletions(-) delete mode 100644 library/DANDELIONKEYBOARDS delete mode 100644 library/DORADOKEYBOARDS delete mode 100644 library/DOVEKEYBOARDS delete mode 100644 library/KEYBOARDEDITOR.LCOM delete mode 100644 library/MAIKOKEYBOARDS delete mode 100644 library/VIRTUALKEYBOARDS.LCOM create mode 100644 library/virtualkeyboards/DANDELIONKEYBOARDS create mode 100644 library/virtualkeyboards/DORADOKEYBOARDS create mode 100644 library/virtualkeyboards/DOVEKEYBOARDS rename library/{ => virtualkeyboards}/KEYBOARDCONFIGS (68%) rename library/{ => virtualkeyboards}/KEYBOARDEDITOR (93%) create mode 100644 library/virtualkeyboards/KEYBOARDEDITOR.LCOM rename library/{ => virtualkeyboards}/VIRTUALKEYBOARDS (91%) create mode 100644 library/virtualkeyboards/VIRTUALKEYBOARDS.LCOM rename library/{VIRTUAL.TEDIT => virtualkeyboards/VIRTUALKEYBOARDS.TEDIT} (100%) create mode 100644 library/virtualkeyboards/XKEYBOARDS diff --git a/library/DANDELIONKEYBOARDS b/library/DANDELIONKEYBOARDS deleted file mode 100644 index cb8dba3d..00000000 --- a/library/DANDELIONKEYBOARDS +++ /dev/null @@ -1,171 +0,0 @@ -((EUROPEAN ((100 (53 197 NOLOCKSHIFT)) (101 (52 196 NOLOCKSHIFT)) (102 (54 198 NOLOCKSHIFT)) (103 ( -61887 61759 LOCKSHIFT)) (104 (55 199 NOLOCKSHIFT)) (105 (61888 61760 LOCKSHIFT)) (106 (61872 61744 -LOCKSHIFT)) (107 (61860 61732 LOCKSHIFT)) (108 (48 126 NOLOCKSHIFT)) (109 (61892 61764 LOCKSHIFT)) ( -110 (203 207 NOLOCKSHIFT)) (111 (61919 61791 LOCKSHIFT)) (112 (47 191 NOLOCKSHIFT)) (115 (8 8 -NOLOCKSHIFT) . IGNORE) (116 (51 195 NOLOCKSHIFT)) (117 (50 194 NOLOCKSHIFT)) (118 (61873 61745 -LOCKSHIFT)) (119 (61858 61730 LOCKSHIFT)) (120 (61874 61746 LOCKSHIFT)) (121 (61859 61731 LOCKSHIFT)) -(122 (57 202 NOLOCKSHIFT)) (123 (61886 61758 LOCKSHIFT)) (124 (61864 61736 LOCKSHIFT)) (125 (61903 -61775 LOCKSHIFT)) (126 (61908 61780 LOCKSHIFT)) (127 (241 225 LOCKSHIFT)) (128 (187 170 LOCKSHIFT)) ( -129 (249 233 LOCKSHIFT)) (132 (49 193 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (61905 61777 LOCKSHIFT)) (137 (61869 61741 LOCKSHIFT)) (138 (61877 61749 -LOCKSHIFT)) (139 (61906 61778 LOCKSHIFT)) (140 (251 90 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 ( -250 234 LOCKSHIFT)) (143 (59 58 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (171 186 LOCKSHIFT -)) (148 (61904 61776 LOCKSHIFT)) (149 (61920 61792 LOCKSHIFT)) (150 (61921 61793 LOCKSHIFT)) (151 ( -61857 61729 LOCKSHIFT)) (152 (61863 61735 LOCKSHIFT)) (153 (56 200 NOLOCKSHIFT)) (154 (61900 61772 -LOCKSHIFT)) (155 (239 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 ( -246 230 LOCKSHIFT)) (159 (207 176 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DANDELION) (logic ((100 ( -53 37 NOLOCKSHIFT)) (101 (52 164 NOLOCKSHIFT)) (102 (54 126 NOLOCKSHIFT)) (103 (61258 61260 -NOLOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (61292 61293 NOLOCKSHIFT)) (106 (61271 61270 NOLOCKSHIFT) -) (107 (61284 61285 NOLOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (61307 61306 NOLOCKSHIFT)) (110 (45 -177 NOLOCKSHIFT)) (111 (61269 61268 LOCKSHIFT)) (112 (172 174 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . -IGNORE) (116 (51 35 NOLOCKSHIFT)) (117 (50 64 NOLOCKSHIFT)) (118 (61240 61241 NOLOCKSHIFT)) (119 ( -61234 61235 NOLOCKSHIFT)) (120 (61266 61262 NOLOCKSHIFT)) (121 (61365 61365 NOLOCKSHIFT)) (122 (57 40 -NOLOCKSHIFT)) (123 (61275 61274 NOLOCKSHIFT)) (124 (61300 61299 NOLOCKSHIFT)) (125 (61273 61272 -NOLOCKSHIFT)) (126 (61282 61283 NOLOCKSHIFT)) (127 (61256 61257 NOLOCKSHIFT)) (128 (61356 61356 -NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) - (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (61250 61251 NOLOCKSHIFT)) (137 (61298 61297 NOLOCKSHIFT)) (138 - (61305 61303 NOLOCKSHIFT)) (139 (61265 61264 NOLOCKSHIFT)) (140 (61364 61364 NOLOCKSHIFT)) (141 -1SHIFTDOWN . 1SHIFTUP) (142 (61281 233 NOLOCKSHIFT)) (143 (61351 61351 NOLOCKSHIFT)) (144 (13 13 -NOLOCKSHIFT) . IGNORE) (145 (61357 61357 NOLOCKSHIFT)) (148 (61279 61278 NOLOCKSHIFT)) (149 (61239 -61238 NOLOCKSHIFT)) (150 (61290 61290 NOLOCKSHIFT)) (151 (61263 61261 NOLOCKSHIFT)) (152 (61295 61295 -NOLOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (61252 61253 NOLOCKSHIFT)) (155 (61254 61255 NOLOCKSHIFT) -) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (91 123 NOLOCKSHIFT)) (159 (61 43 -NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DANDELION) (MATH ((100 (53 37 NOLOCKSHIFT)) (101 (52 36 -NOLOCKSHIFT)) (102 (54 126 NOLOCKSHIFT)) (103 (61284 61285 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 -(100 68 LOCKSHIFT)) (106 (174 61245 NOLOCKSHIFT)) (107 (61369 61363 NOLOCKSHIFT)) (108 (48 41 -NOLOCKSHIFT)) (109 (61254 61255 NOLOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (173 61246 LOCKSHIFT)) ( -112 (47 61300 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) (116 (51 35 NOLOCKSHIFT)) (117 (50 64 -NOLOCKSHIFT)) (118 (61282 61283 LOCKSHIFT)) (119 (61287 61286 NOLOCKSHIFT)) (120 (61301 61302 -NOLOCKSHIFT)) (121 (61351 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (175 61247 LOCKSHIFT)) (124 ( -180 184 LOCKSHIFT)) (125 (172 61244 LOCKSHIFT)) (126 (61256 61257 LOCKSHIFT)) (127 (44 61250 -NOLOCKSHIFT)) (128 (61298 61253 NOLOCKSHIFT)) (129 (93 61265 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) ( -133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 ( -61356 61362 LOCKSHIFT)) (138 (61254 61291 NOLOCKSHIFT)) (139 (98 61360 NOLOCKSHIFT)) (140 (61309 177 -LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (46 61251 NOLOCKSHIFT)) (143 (61299 61252 NOLOCKSHIFT)) ( -144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (95 94 NOLOCKSHIFT)) (148 (61358 82 LOCKSHIFT)) (149 (61296 -61266 NOLOCKSHIFT)) (150 (61305 61303 NOLOCKSHIFT)) (151 (61308 61267 LOCKSHIFT)) (152 (61288 72 -LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (61357 61361 NOLOCKSHIFT)) (155 (61292 61293 LOCKSHIFT)) ( -156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (91 61264 NOLOCKSHIFT)) (159 (61 43 -NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DANDELION) (OFFICE ((100 (61397 61381 NOLOCKSHIFT)) (101 ( -61396 61380 NOLOCKSHIFT)) (102 (61398 61382 NOLOCKSHIFT)) (103 (8557 8554 NOLOCKSHIFT)) (104 (61399 -61383 NOLOCKSHIFT)) (105 (61232 8743 NOLOCKSHIFT)) (106 (61346 8571 NOLOCKSHIFT)) (107 (188 86 -NOLOCKSHIFT)) (108 (61402 61386 NOLOCKSHIFT)) (109 (210 8738 NOLOCKSHIFT)) (110 (61437 61438 -NOLOCKSHIFT)) (111 (163 8558 NOLOCKSHIFT)) (112 (61248 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . -IGNORE) (116 (61395 61379 NOLOCKSHIFT)) (117 (61394 61378 NOLOCKSHIFT)) (118 (185 8553 NOLOCKSHIFT)) ( -119 (176 8546 NOLOCKSHIFT)) (120 (167 8744 NOLOCKSHIFT)) (121 (97 8745 NOLOCKSHIFT)) (122 (61401 61385 - NOLOCKSHIFT)) (123 (162 8570 NOLOCKSHIFT)) (124 (61437 88 NOLOCKSHIFT)) (125 (111 8569 NOLOCKSHIFT)) -(126 (61289 8737 NOLOCKSHIFT)) (127 (44 60 NOLOCKSHIFT)) (128 (39 34 NOLOCKSHIFT)) (129 (93 125 -NOLOCKSHIFT)) (132 (61393 61377 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (61233 8742 NOLOCKSHIFT)) (137 (61438 67 NOLOCKSHIFT)) (138 (8739 74 -NOLOCKSHIFT)) (139 (190 61436 NOLOCKSHIFT)) (140 (189 90 NOLOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) ( -142 (61249 62 NOLOCKSHIFT)) (143 (61352 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (95 -61280 NOLOCKSHIFT)) (148 (212 8574 NOLOCKSHIFT)) (149 (61354 8573 NOLOCKSHIFT)) (150 (61286 8741 -NOLOCKSHIFT)) (151 (165 8572 NOLOCKSHIFT)) (152 (61368 8740 NOLOCKSHIFT)) (153 (61400 61384 -NOLOCKSHIFT)) (154 (173 175 NOLOCKSHIFT)) (155 (172 174 NOLOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 - 32 NOLOCKSHIFT) . IGNORE) (158 (91 123 NOLOCKSHIFT)) (159 (61406 61368 NOLOCKSHIFT)) (160 2SHIFTDOWN - . 2SHIFTUP)) DANDELION) (DVORAK ((100 (49 42 NOLOCKSHIFT)) (101 (51 41 NOLOCKSHIFT)) (102 (57 37 -NOLOCKSHIFT)) (103 (46 62 NOLOCKSHIFT)) (104 (48 38 NOLOCKSHIFT)) (105 (101 69 LOCKSHIFT)) (106 (103 -71 LOCKSHIFT)) (107 (107 75 LOCKSHIFT)) (108 (54 45 NOLOCKSHIFT)) (109 (116 84 LOCKSHIFT)) (110 (56 95 - NOLOCKSHIFT)) (111 (108 76 LOCKSHIFT)) (112 (122 90 LOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) (116 - (53 40 NOLOCKSHIFT)) (117 (55 35 NOLOCKSHIFT)) (118 (44 60 NOLOCKSHIFT)) (119 (63 47 NOLOCKSHIFT)) ( -120 (111 79 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (52 164 NOLOCKSHIFT)) (123 (99 67 LOCKSHIFT)) ( -124 (113 81 LOCKSHIFT)) (125 (114 82 LOCKSHIFT)) (126 (110 78 LOCKSHIFT)) (127 (119 87 LOCKSHIFT)) ( -128 (44 186 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (33 64 NOLOCKSHIFT)) (133 (92 124 -NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (117 85 LOCKSHIFT)) (137 (106 74 -LOCKSHIFT)) (138 (104 72 LOCKSHIFT)) (139 (120 88 LOCKSHIFT)) (140 (59 58 NOLOCKSHIFT)) (141 -1SHIFTDOWN . 1SHIFTUP) (142 (118 86 LOCKSHIFT)) (143 (115 83 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . -IGNORE) (145 (169 170 NOLOCKSHIFT)) (148 (112 80 LOCKSHIFT)) (149 (121 89 LOCKSHIFT)) (150 (105 73 -LOCKSHIFT)) (151 (102 70 LOCKSHIFT)) (152 (100 68 LOCKSHIFT)) (153 (50 162 NOLOCKSHIFT)) (154 (98 66 -LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 ( -91 123 NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DANDELION) (GREEK ((100 ( -53 37 NOLOCKSHIFT)) (101 (52 36 NOLOCKSHIFT)) (102 (54 126 NOLOCKSHIFT)) (103 (9830 69 LOCKSHIFT)) ( -104 (55 38 NOLOCKSHIFT)) (105 (9829 9797 LOCKSHIFT)) (106 (9849 9817 LOCKSHIFT)) (107 (115 9814 -LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (9837 9805 LOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (9843 - 9811 LOCKSHIFT)) (112 (47 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) (116 (51 35 NOLOCKSHIFT)) - (117 (50 64 NOLOCKSHIFT)) (118 (9853 9821 LOCKSHIFT)) (119 (9835 9803 LOCKSHIFT)) (120 (9846 9814 -LOCKSHIFT)) (121 (9825 9793 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (9836 9804 LOCKSHIFT)) (124 ( -9851 9819 LOCKSHIFT)) (125 (9842 9810 LOCKSHIFT)) (126 (9838 9806 LOCKSHIFT)) (127 (44 60 NOLOCKSHIFT) -) (128 (39 34 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 124 -NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (9850 9818 LOCKSHIFT)) (137 (9841 9809 -LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 (9826 66 LOCKSHIFT)) (140 (9833 9801 LOCKSHIFT)) (141 -1SHIFTDOWN . 1SHIFTUP) (142 (46 62 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . -IGNORE) (145 (95 94 NOLOCKSHIFT)) (148 (9845 9813 LOCKSHIFT)) (149 (9848 9816 LOCKSHIFT)) (150 (9828 -9796 LOCKSHIFT)) (151 (9852 9820 LOCKSHIFT)) (152 (9834 9802 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) ( -154 (9840 9808 LOCKSHIFT)) (155 (9839 9807 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT -) . IGNORE) (158 (91 123 NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) -DANDELION) (ITALIAN ((100 (53 61903 NOLOCKSHIFT)) (101 (52 61886 NOLOCKSHIFT)) (102 (54 61919 -NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) (106 (117 85 - LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (107 75 LOCKSHIFT)) (110 (45 45 -NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) (112 (204 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) ( -116 (51 61872 NOLOCKSHIFT)) (117 (50 61858 NOLOCKSHIFT)) (118 (119 87 LOCKSHIFT)) (119 (113 81 -LOCKSHIFT)) (120 (115 83 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (105 73 -LOCKSHIFT)) (124 (120 88 LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 LOCKSHIFT)) (127 (44 171 -NOLOCKSHIFT)) (128 (39 186 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 - 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (99 67 -LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 LOCKSHIFT)) (141 1SHIFTDOWN - . 1SHIFTUP) (142 (46 187 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) ( -145 (95 170 NOLOCKSHIFT)) (148 (114 82 LOCKSHIFT)) (149 (116 84 LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) ( -151 (121 89 LOCKSHIFT)) (152 (104 72 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) ( -155 (109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (91 123 -NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DANDELION) (SPANISH ((100 (53 -61904 NOLOCKSHIFT)) (101 (52 61887 NOLOCKSHIFT)) (102 (54 61920 NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) - (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) (106 (117 85 LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) -(108 (48 41 NOLOCKSHIFT)) (109 (107 75 LOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) -(112 (204 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) (116 (51 61873 NOLOCKSHIFT)) (117 (50 -61858 NOLOCKSHIFT)) (118 (119 87 LOCKSHIFT)) (119 (113 81 LOCKSHIFT)) (120 (115 83 LOCKSHIFT)) (121 ( -97 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (105 73 LOCKSHIFT)) (124 (120 88 LOCKSHIFT)) (125 ( -111 79 LOCKSHIFT)) (126 (108 76 LOCKSHIFT)) (127 (44 171 NOLOCKSHIFT)) (128 (59 58 NOLOCKSHIFT)) (129 -(203 187 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (99 67 LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 -(98 66 LOCKSHIFT)) (140 (122 90 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (46 187 NOLOCKSHIFT)) ( -143 (61900 61772 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (161 191 NOLOCKSHIFT)) (148 (114 -82 LOCKSHIFT)) (149 (116 84 LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) (151 (121 89 LOCKSHIFT)) (152 (104 72 - LOCKSHIFT)) (153 (56 61925 NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) (156 -LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (44 171 NOLOCKSHIFT)) (159 (61 43 -NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DANDELION) (FRENCH ((100 (53 61905 NOLOCKSHIFT)) (101 (52 -61888 NOLOCKSHIFT)) (102 (54 61921 NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) ( -105 (100 68 LOCKSHIFT)) (106 (117 85 LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) ( -109 (107 75 LOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) (112 (204 63 NOLOCKSHIFT)) -(115 (8 8 NOLOCKSHIFT) . IGNORE) (116 (51 61874 NOLOCKSHIFT)) (117 (50 61859 NOLOCKSHIFT)) (118 (119 -87 LOCKSHIFT)) (119 (113 81 LOCKSHIFT)) (120 (115 83 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 -NOLOCKSHIFT)) (123 (105 73 LOCKSHIFT)) (124 (120 88 LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 -LOCKSHIFT)) (127 (44 171 NOLOCKSHIFT)) (128 (39 61857 NOLOCKSHIFT)) (129 (61872 61892 LOCKSHIFT)) (132 - (49 33 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 -70 LOCKSHIFT)) (137 (99 67 LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 -LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (46 187 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 -13 NOLOCKSHIFT) . IGNORE) (145 (61869 61741 LOCKSHIFT)) (148 (114 82 LOCKSHIFT)) (149 (116 84 -LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) (151 (121 89 LOCKSHIFT)) (152 (104 72 LOCKSHIFT)) (153 (56 61919 -NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 -NOLOCKSHIFT) . IGNORE) (158 (61873 61877 LOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . -2SHIFTUP)) DANDELION) (GERMAN ((100 (53 37 NOLOCKSHIFT)) (101 (52 36 NOLOCKSHIFT)) (102 (54 126 -NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) (106 (117 85 - LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (107 75 LOCKSHIFT)) (110 (45 45 -NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) (112 (251 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) ( -116 (51 35 NOLOCKSHIFT)) (117 (50 64 NOLOCKSHIFT)) (118 (119 87 LOCKSHIFT)) (119 (113 81 LOCKSHIFT)) ( -120 (115 83 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (105 73 LOCKSHIFT)) ( -124 (120 88 LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 LOCKSHIFT)) (127 (44 60 NOLOCKSHIFT)) ( -128 (39 34 NOLOCKSHIFT)) (129 (61863 61735 LOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 124 -NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (99 67 LOCKSHIFT -)) (138 (106 74 LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 LOCKSHIFT)) (141 1SHIFTDOWN . -1SHIFTUP) (142 (46 62 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 -(95 94 NOLOCKSHIFT)) (148 (114 82 LOCKSHIFT)) (149 (116 84 LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) (151 ( -121 89 LOCKSHIFT)) (152 (104 72 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) (155 ( -109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (61908 61780 -LOCKSHIFT)) (159 (61925 61797 LOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DANDELION) (STANDARD-RUSSIAN (( -100 (34 52 NOLOCKSHIFT)) (101 (47 51 NOLOCKSHIFT)) (102 (58 53 NOLOCKSHIFT)) (103 (10085 10037 -LOCKSHIFT)) (104 (44 54 NOLOCKSHIFT)) (105 (10067 10019 LOCKSHIFT)) (106 (10068 10020 LOCKSHIFT)) (107 - (10078 10030 LOCKSHIFT)) (108 (63 57 NOLOCKSHIFT)) (109 (10077 10029 LOCKSHIFT)) (110 (37 48 -NOLOCKSHIFT)) (111 (10073 10025 LOCKSHIFT)) (112 (10071 10023 LOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . -IGNORE) (116 (45 50 NOLOCKSHIFT)) (117 (61352 49 NOLOCKSHIFT)) (118 (10088 10040 LOCKSHIFT)) (119 ( -10075 10027 LOCKSHIFT)) (120 (10093 10045 LOCKSHIFT)) (121 (10086 10038 LOCKSHIFT)) (122 (95 56 -NOLOCKSHIFT)) (123 (10090 10042 LOCKSHIFT)) (124 (10089 10041 LOCKSHIFT)) (125 (10091 10043 LOCKSHIFT) -) (126 (10069 10021 LOCKSHIFT)) (127 (10066 10018 LOCKSHIFT)) (128 (10095 10047 LOCKSHIFT)) (129 ( -10092 10044 LOCKSHIFT)) (132 (167 43 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (10065 10017 LOCKSHIFT)) (137 (10083 10035 LOCKSHIFT)) (138 (10080 10032 -LOCKSHIFT)) (139 (10074 10026 LOCKSHIFT)) (140 (10097 10049 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) ( -142 (10096 10048 LOCKSHIFT)) (143 (10072 10024 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (41 - 40 NOLOCKSHIFT)) (148 (10076 10028 LOCKSHIFT)) (149 (10070 10022 LOCKSHIFT)) (150 (10081 10033 -LOCKSHIFT)) (151 (10079 10031 LOCKSHIFT)) (152 (10082 10034 LOCKSHIFT)) (153 (46 55 NOLOCKSHIFT)) (154 - (10084 10036 LOCKSHIFT)) (155 (10094 10046 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 -NOLOCKSHIFT) . IGNORE) (158 (10087 10039 LOCKSHIFT)) (159 (33 61 NOLOCKSHIFT)) (160 2SHIFTDOWN . -2SHIFTUP)) DANDELION)) \ No newline at end of file diff --git a/library/DORADOKEYBOARDS b/library/DORADOKEYBOARDS deleted file mode 100644 index 932aee54..00000000 --- a/library/DORADOKEYBOARDS +++ /dev/null @@ -1,171 +0,0 @@ -((EUROPEAN ((100 (53 197 NOLOCKSHIFT)) (101 (52 196 NOLOCKSHIFT)) (102 (54 198 NOLOCKSHIFT)) (103 ( -61887 61759 LOCKSHIFT)) (104 (55 199 NOLOCKSHIFT)) (105 (61888 61760 LOCKSHIFT)) (106 (61872 61744 -LOCKSHIFT)) (107 (61860 61732 LOCKSHIFT)) (108 (48 126 NOLOCKSHIFT)) (109 (61892 61764 LOCKSHIFT)) ( -110 (203 207 NOLOCKSHIFT)) (111 (61919 61791 LOCKSHIFT)) (112 (47 191 NOLOCKSHIFT)) (115 (1 1 -NOLOCKSHIFT) . IGNORE) (116 (51 195 NOLOCKSHIFT)) (117 (50 194 NOLOCKSHIFT)) (118 (61873 61745 -LOCKSHIFT)) (119 (61858 61730 LOCKSHIFT)) (120 (61874 61746 LOCKSHIFT)) (121 (61859 61731 LOCKSHIFT)) -(122 (57 202 NOLOCKSHIFT)) (123 (61886 61758 LOCKSHIFT)) (124 (61864 61736 LOCKSHIFT)) (125 (61903 -61775 LOCKSHIFT)) (126 (61908 61780 LOCKSHIFT)) (127 (241 225 LOCKSHIFT)) (128 (187 170 LOCKSHIFT)) ( -129 (249 233 LOCKSHIFT)) (132 (49 193 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (61905 61777 LOCKSHIFT)) (137 (61869 61741 LOCKSHIFT)) (138 (61877 61749 -LOCKSHIFT)) (139 (61906 61778 LOCKSHIFT)) (140 (251 90 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 ( -250 234 LOCKSHIFT)) (143 (59 58 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (171 186 LOCKSHIFT -)) (148 (61904 61776 LOCKSHIFT)) (149 (61920 61792 LOCKSHIFT)) (150 (61921 61793 LOCKSHIFT)) (151 ( -61857 61729 LOCKSHIFT)) (152 (61863 61735 LOCKSHIFT)) (153 (56 200 NOLOCKSHIFT)) (154 (61900 61772 -LOCKSHIFT)) (155 (239 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 ( -246 230 LOCKSHIFT)) (159 (207 176 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DORADO) (logic ((100 ( -53 37 NOLOCKSHIFT)) (101 (52 164 NOLOCKSHIFT)) (102 (54 126 NOLOCKSHIFT)) (103 (61258 61260 -NOLOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (61292 61293 NOLOCKSHIFT)) (106 (61271 61270 NOLOCKSHIFT) -) (107 (61284 61285 NOLOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (61307 61306 NOLOCKSHIFT)) (110 (45 -177 NOLOCKSHIFT)) (111 (61269 61268 LOCKSHIFT)) (112 (172 174 NOLOCKSHIFT)) (115 (1 1 NOLOCKSHIFT) . -IGNORE) (116 (51 35 NOLOCKSHIFT)) (117 (50 64 NOLOCKSHIFT)) (118 (61240 61241 NOLOCKSHIFT)) (119 ( -61234 61235 NOLOCKSHIFT)) (120 (61266 61262 NOLOCKSHIFT)) (121 (61365 61365 NOLOCKSHIFT)) (122 (57 40 -NOLOCKSHIFT)) (123 (61275 61274 NOLOCKSHIFT)) (124 (61300 61299 NOLOCKSHIFT)) (125 (61273 61272 -NOLOCKSHIFT)) (126 (61282 61283 NOLOCKSHIFT)) (127 (61256 61257 NOLOCKSHIFT)) (128 (61356 61356 -NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) - (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (61250 61251 NOLOCKSHIFT)) (137 (61298 61297 NOLOCKSHIFT)) (138 - (61305 61303 NOLOCKSHIFT)) (139 (61265 61264 NOLOCKSHIFT)) (140 (61364 61364 NOLOCKSHIFT)) (141 -1SHIFTDOWN . 1SHIFTUP) (142 (61281 233 NOLOCKSHIFT)) (143 (61351 61351 NOLOCKSHIFT)) (144 (13 13 -NOLOCKSHIFT) . IGNORE) (145 (61357 61357 NOLOCKSHIFT)) (148 (61279 61278 NOLOCKSHIFT)) (149 (61239 -61238 NOLOCKSHIFT)) (150 (61290 61290 NOLOCKSHIFT)) (151 (61263 61261 NOLOCKSHIFT)) (152 (61295 61295 -NOLOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (61252 61253 NOLOCKSHIFT)) (155 (61254 61255 NOLOCKSHIFT) -) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (91 123 NOLOCKSHIFT)) (159 (61 43 -NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DORADO) (MATH ((100 (53 37 NOLOCKSHIFT)) (101 (52 36 -NOLOCKSHIFT)) (102 (54 126 NOLOCKSHIFT)) (103 (61284 61285 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 -(100 68 LOCKSHIFT)) (106 (174 61245 NOLOCKSHIFT)) (107 (61369 61363 NOLOCKSHIFT)) (108 (48 41 -NOLOCKSHIFT)) (109 (61254 61255 NOLOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (173 61246 LOCKSHIFT)) ( -112 (47 61300 NOLOCKSHIFT)) (115 (1 1 NOLOCKSHIFT) . IGNORE) (116 (51 35 NOLOCKSHIFT)) (117 (50 64 -NOLOCKSHIFT)) (118 (61282 61283 LOCKSHIFT)) (119 (61287 61286 NOLOCKSHIFT)) (120 (61301 61302 -NOLOCKSHIFT)) (121 (61351 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (175 61247 LOCKSHIFT)) (124 ( -180 184 LOCKSHIFT)) (125 (172 61244 LOCKSHIFT)) (126 (61256 61257 LOCKSHIFT)) (127 (44 61250 -NOLOCKSHIFT)) (128 (61298 61253 NOLOCKSHIFT)) (129 (93 61265 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) ( -133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 ( -61356 61362 LOCKSHIFT)) (138 (61254 61291 NOLOCKSHIFT)) (139 (98 61360 NOLOCKSHIFT)) (140 (61309 177 -LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (46 61251 NOLOCKSHIFT)) (143 (61299 61252 NOLOCKSHIFT)) ( -144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (95 94 NOLOCKSHIFT)) (148 (61358 82 LOCKSHIFT)) (149 (61296 -61266 NOLOCKSHIFT)) (150 (61305 61303 NOLOCKSHIFT)) (151 (61308 61267 LOCKSHIFT)) (152 (61288 72 -LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (61357 61361 NOLOCKSHIFT)) (155 (61292 61293 LOCKSHIFT)) ( -156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (91 61264 NOLOCKSHIFT)) (159 (61 43 -NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DORADO) (OFFICE ((100 (61397 61381 NOLOCKSHIFT)) (101 ( -61396 61380 NOLOCKSHIFT)) (102 (61398 61382 NOLOCKSHIFT)) (103 (8557 8554 NOLOCKSHIFT)) (104 (61399 -61383 NOLOCKSHIFT)) (105 (61232 8743 NOLOCKSHIFT)) (106 (61346 8571 NOLOCKSHIFT)) (107 (188 86 -NOLOCKSHIFT)) (108 (61402 61386 NOLOCKSHIFT)) (109 (210 8738 NOLOCKSHIFT)) (110 (61437 61438 -NOLOCKSHIFT)) (111 (163 8558 NOLOCKSHIFT)) (112 (61248 63 NOLOCKSHIFT)) (115 (1 1 NOLOCKSHIFT) . -IGNORE) (116 (61395 61379 NOLOCKSHIFT)) (117 (61394 61378 NOLOCKSHIFT)) (118 (185 8553 NOLOCKSHIFT)) ( -119 (176 8546 NOLOCKSHIFT)) (120 (167 8744 NOLOCKSHIFT)) (121 (97 8745 NOLOCKSHIFT)) (122 (61401 61385 - NOLOCKSHIFT)) (123 (162 8570 NOLOCKSHIFT)) (124 (61437 88 NOLOCKSHIFT)) (125 (111 8569 NOLOCKSHIFT)) -(126 (61289 8737 NOLOCKSHIFT)) (127 (44 60 NOLOCKSHIFT)) (128 (39 34 NOLOCKSHIFT)) (129 (93 125 -NOLOCKSHIFT)) (132 (61393 61377 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (61233 8742 NOLOCKSHIFT)) (137 (61438 67 NOLOCKSHIFT)) (138 (8739 74 -NOLOCKSHIFT)) (139 (190 61436 NOLOCKSHIFT)) (140 (189 90 NOLOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) ( -142 (61249 62 NOLOCKSHIFT)) (143 (61352 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (95 -61280 NOLOCKSHIFT)) (148 (212 8574 NOLOCKSHIFT)) (149 (61354 8573 NOLOCKSHIFT)) (150 (61286 8741 -NOLOCKSHIFT)) (151 (165 8572 NOLOCKSHIFT)) (152 (61368 8740 NOLOCKSHIFT)) (153 (61400 61384 -NOLOCKSHIFT)) (154 (173 175 NOLOCKSHIFT)) (155 (172 174 NOLOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 - 32 NOLOCKSHIFT) . IGNORE) (158 (91 123 NOLOCKSHIFT)) (159 (61406 61368 NOLOCKSHIFT)) (160 2SHIFTDOWN - . 2SHIFTUP)) DORADO) (DVORAK ((100 (49 42 NOLOCKSHIFT)) (101 (51 41 NOLOCKSHIFT)) (102 (57 37 -NOLOCKSHIFT)) (103 (46 62 NOLOCKSHIFT)) (104 (48 38 NOLOCKSHIFT)) (105 (101 69 LOCKSHIFT)) (106 (103 -71 LOCKSHIFT)) (107 (107 75 LOCKSHIFT)) (108 (54 45 NOLOCKSHIFT)) (109 (116 84 LOCKSHIFT)) (110 (56 95 - NOLOCKSHIFT)) (111 (108 76 LOCKSHIFT)) (112 (122 90 LOCKSHIFT)) (115 (1 1 NOLOCKSHIFT) . IGNORE) (116 - (53 40 NOLOCKSHIFT)) (117 (55 35 NOLOCKSHIFT)) (118 (44 60 NOLOCKSHIFT)) (119 (63 47 NOLOCKSHIFT)) ( -120 (111 79 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (52 164 NOLOCKSHIFT)) (123 (99 67 LOCKSHIFT)) ( -124 (113 81 LOCKSHIFT)) (125 (114 82 LOCKSHIFT)) (126 (110 78 LOCKSHIFT)) (127 (119 87 LOCKSHIFT)) ( -128 (44 186 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (33 64 NOLOCKSHIFT)) (133 (92 124 -NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (117 85 LOCKSHIFT)) (137 (106 74 -LOCKSHIFT)) (138 (104 72 LOCKSHIFT)) (139 (120 88 LOCKSHIFT)) (140 (59 58 NOLOCKSHIFT)) (141 -1SHIFTDOWN . 1SHIFTUP) (142 (118 86 LOCKSHIFT)) (143 (115 83 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . -IGNORE) (145 (169 170 NOLOCKSHIFT)) (148 (112 80 LOCKSHIFT)) (149 (121 89 LOCKSHIFT)) (150 (105 73 -LOCKSHIFT)) (151 (102 70 LOCKSHIFT)) (152 (100 68 LOCKSHIFT)) (153 (50 162 NOLOCKSHIFT)) (154 (98 66 -LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 ( -91 123 NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DORADO) (GREEK ((100 ( -53 37 NOLOCKSHIFT)) (101 (52 36 NOLOCKSHIFT)) (102 (54 126 NOLOCKSHIFT)) (103 (9830 69 LOCKSHIFT)) ( -104 (55 38 NOLOCKSHIFT)) (105 (9829 9797 LOCKSHIFT)) (106 (9849 9817 LOCKSHIFT)) (107 (115 9814 -LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (9837 9805 LOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (9843 - 9811 LOCKSHIFT)) (112 (47 63 NOLOCKSHIFT)) (115 (1 1 NOLOCKSHIFT) . IGNORE) (116 (51 35 NOLOCKSHIFT)) - (117 (50 64 NOLOCKSHIFT)) (118 (9853 9821 LOCKSHIFT)) (119 (9835 9803 LOCKSHIFT)) (120 (9846 9814 -LOCKSHIFT)) (121 (9825 9793 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (9836 9804 LOCKSHIFT)) (124 ( -9851 9819 LOCKSHIFT)) (125 (9842 9810 LOCKSHIFT)) (126 (9838 9806 LOCKSHIFT)) (127 (44 60 NOLOCKSHIFT) -) (128 (39 34 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 124 -NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (9850 9818 LOCKSHIFT)) (137 (9841 9809 -LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 (9826 66 LOCKSHIFT)) (140 (9833 9801 LOCKSHIFT)) (141 -1SHIFTDOWN . 1SHIFTUP) (142 (46 62 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . -IGNORE) (145 (95 94 NOLOCKSHIFT)) (148 (9845 9813 LOCKSHIFT)) (149 (9848 9816 LOCKSHIFT)) (150 (9828 -9796 LOCKSHIFT)) (151 (9852 9820 LOCKSHIFT)) (152 (9834 9802 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) ( -154 (9840 9808 LOCKSHIFT)) (155 (9839 9807 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT -) . IGNORE) (158 (91 123 NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) -DORADO) (ITALIAN ((100 (53 61903 NOLOCKSHIFT)) (101 (52 61886 NOLOCKSHIFT)) (102 (54 61919 -NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) (106 (117 85 - LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (107 75 LOCKSHIFT)) (110 (45 45 -NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) (112 (204 63 NOLOCKSHIFT)) (115 (1 1 NOLOCKSHIFT) . IGNORE) ( -116 (51 61872 NOLOCKSHIFT)) (117 (50 61858 NOLOCKSHIFT)) (118 (119 87 LOCKSHIFT)) (119 (113 81 -LOCKSHIFT)) (120 (115 83 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (105 73 -LOCKSHIFT)) (124 (120 88 LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 LOCKSHIFT)) (127 (44 171 -NOLOCKSHIFT)) (128 (39 186 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 - 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (99 67 -LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 LOCKSHIFT)) (141 1SHIFTDOWN - . 1SHIFTUP) (142 (46 187 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) ( -145 (95 170 NOLOCKSHIFT)) (148 (114 82 LOCKSHIFT)) (149 (116 84 LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) ( -151 (121 89 LOCKSHIFT)) (152 (104 72 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) ( -155 (109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (91 123 -NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DORADO) (SPANISH ((100 (53 -61904 NOLOCKSHIFT)) (101 (52 61887 NOLOCKSHIFT)) (102 (54 61920 NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) - (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) (106 (117 85 LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) -(108 (48 41 NOLOCKSHIFT)) (109 (107 75 LOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) -(112 (204 63 NOLOCKSHIFT)) (115 (1 1 NOLOCKSHIFT) . IGNORE) (116 (51 61873 NOLOCKSHIFT)) (117 (50 -61858 NOLOCKSHIFT)) (118 (119 87 LOCKSHIFT)) (119 (113 81 LOCKSHIFT)) (120 (115 83 LOCKSHIFT)) (121 ( -97 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (105 73 LOCKSHIFT)) (124 (120 88 LOCKSHIFT)) (125 ( -111 79 LOCKSHIFT)) (126 (108 76 LOCKSHIFT)) (127 (44 171 NOLOCKSHIFT)) (128 (59 58 NOLOCKSHIFT)) (129 -(203 187 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (99 67 LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 -(98 66 LOCKSHIFT)) (140 (122 90 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (46 187 NOLOCKSHIFT)) ( -143 (61900 61772 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (161 191 NOLOCKSHIFT)) (148 (114 -82 LOCKSHIFT)) (149 (116 84 LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) (151 (121 89 LOCKSHIFT)) (152 (104 72 - LOCKSHIFT)) (153 (56 61925 NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) (156 -LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (44 171 NOLOCKSHIFT)) (159 (61 43 -NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DORADO) (FRENCH ((100 (53 61905 NOLOCKSHIFT)) (101 (52 -61888 NOLOCKSHIFT)) (102 (54 61921 NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) ( -105 (100 68 LOCKSHIFT)) (106 (117 85 LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) ( -109 (107 75 LOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) (112 (204 63 NOLOCKSHIFT)) -(115 (1 1 NOLOCKSHIFT) . IGNORE) (116 (51 61874 NOLOCKSHIFT)) (117 (50 61859 NOLOCKSHIFT)) (118 (119 -87 LOCKSHIFT)) (119 (113 81 LOCKSHIFT)) (120 (115 83 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 -NOLOCKSHIFT)) (123 (105 73 LOCKSHIFT)) (124 (120 88 LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 -LOCKSHIFT)) (127 (44 171 NOLOCKSHIFT)) (128 (39 61857 NOLOCKSHIFT)) (129 (61872 61892 LOCKSHIFT)) (132 - (49 33 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 -70 LOCKSHIFT)) (137 (99 67 LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 -LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (46 187 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 -13 NOLOCKSHIFT) . IGNORE) (145 (61869 61741 LOCKSHIFT)) (148 (114 82 LOCKSHIFT)) (149 (116 84 -LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) (151 (121 89 LOCKSHIFT)) (152 (104 72 LOCKSHIFT)) (153 (56 61919 -NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 -NOLOCKSHIFT) . IGNORE) (158 (61873 61877 LOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . -2SHIFTUP)) DORADO) (GERMAN ((100 (53 37 NOLOCKSHIFT)) (101 (52 36 NOLOCKSHIFT)) (102 (54 126 -NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) (106 (117 85 - LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (107 75 LOCKSHIFT)) (110 (45 45 -NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) (112 (251 63 NOLOCKSHIFT)) (115 (1 1 NOLOCKSHIFT) . IGNORE) ( -116 (51 35 NOLOCKSHIFT)) (117 (50 64 NOLOCKSHIFT)) (118 (119 87 LOCKSHIFT)) (119 (113 81 LOCKSHIFT)) ( -120 (115 83 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (105 73 LOCKSHIFT)) ( -124 (120 88 LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 LOCKSHIFT)) (127 (44 60 NOLOCKSHIFT)) ( -128 (39 34 NOLOCKSHIFT)) (129 (61863 61735 LOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (133 (92 124 -NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (99 67 LOCKSHIFT -)) (138 (106 74 LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 LOCKSHIFT)) (141 1SHIFTDOWN . -1SHIFTUP) (142 (46 62 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 -(95 94 NOLOCKSHIFT)) (148 (114 82 LOCKSHIFT)) (149 (116 84 LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) (151 ( -121 89 LOCKSHIFT)) (152 (104 72 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) (155 ( -109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (61908 61780 -LOCKSHIFT)) (159 (61925 61797 LOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DORADO) (STANDARD-RUSSIAN (( -100 (34 52 NOLOCKSHIFT)) (101 (47 51 NOLOCKSHIFT)) (102 (58 53 NOLOCKSHIFT)) (103 (10085 10037 -LOCKSHIFT)) (104 (44 54 NOLOCKSHIFT)) (105 (10067 10019 LOCKSHIFT)) (106 (10068 10020 LOCKSHIFT)) (107 - (10078 10030 LOCKSHIFT)) (108 (63 57 NOLOCKSHIFT)) (109 (10077 10029 LOCKSHIFT)) (110 (37 48 -NOLOCKSHIFT)) (111 (10073 10025 LOCKSHIFT)) (112 (10071 10023 LOCKSHIFT)) (115 (1 1 NOLOCKSHIFT) . -IGNORE) (116 (45 50 NOLOCKSHIFT)) (117 (61352 49 NOLOCKSHIFT)) (118 (10088 10040 LOCKSHIFT)) (119 ( -10075 10027 LOCKSHIFT)) (120 (10093 10045 LOCKSHIFT)) (121 (10086 10038 LOCKSHIFT)) (122 (95 56 -NOLOCKSHIFT)) (123 (10090 10042 LOCKSHIFT)) (124 (10089 10041 LOCKSHIFT)) (125 (10091 10043 LOCKSHIFT) -) (126 (10069 10021 LOCKSHIFT)) (127 (10066 10018 LOCKSHIFT)) (128 (10095 10047 LOCKSHIFT)) (129 ( -10092 10044 LOCKSHIFT)) (132 (167 43 NOLOCKSHIFT)) (133 (92 124 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (10065 10017 LOCKSHIFT)) (137 (10083 10035 LOCKSHIFT)) (138 (10080 10032 -LOCKSHIFT)) (139 (10074 10026 LOCKSHIFT)) (140 (10097 10049 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) ( -142 (10096 10048 LOCKSHIFT)) (143 (10072 10024 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (145 (41 - 40 NOLOCKSHIFT)) (148 (10076 10028 LOCKSHIFT)) (149 (10070 10022 LOCKSHIFT)) (150 (10081 10033 -LOCKSHIFT)) (151 (10079 10031 LOCKSHIFT)) (152 (10082 10034 LOCKSHIFT)) (153 (46 55 NOLOCKSHIFT)) (154 - (10084 10036 LOCKSHIFT)) (155 (10094 10046 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 -NOLOCKSHIFT) . IGNORE) (158 (10087 10039 LOCKSHIFT)) (159 (33 61 NOLOCKSHIFT)) (160 2SHIFTDOWN . -2SHIFTUP)) DORADO)) \ No newline at end of file diff --git a/library/DOVEKEYBOARDS b/library/DOVEKEYBOARDS deleted file mode 100644 index 364c1256..00000000 --- a/library/DOVEKEYBOARDS +++ /dev/null @@ -1,171 +0,0 @@ -((EUROPEAN ((100 (53 197 NOLOCKSHIFT)) (101 (52 196 NOLOCKSHIFT)) (102 (54 198 NOLOCKSHIFT)) (103 ( -61887 61759 LOCKSHIFT)) (104 (55 199 NOLOCKSHIFT)) (105 (61888 61760 LOCKSHIFT)) (106 (61872 61744 -LOCKSHIFT)) (107 (61860 61732 LOCKSHIFT)) (108 (48 126 NOLOCKSHIFT)) (109 (61892 61764 LOCKSHIFT)) ( -110 (203 207 NOLOCKSHIFT)) (111 (61919 61791 LOCKSHIFT)) (112 (47 191 NOLOCKSHIFT)) (115 (8 8 -NOLOCKSHIFT) . IGNORE) (116 (51 195 NOLOCKSHIFT)) (117 (50 194 NOLOCKSHIFT)) (118 (61873 61745 -LOCKSHIFT)) (119 (61858 61730 LOCKSHIFT)) (120 (61874 61746 LOCKSHIFT)) (121 (61859 61731 LOCKSHIFT)) -(122 (57 202 NOLOCKSHIFT)) (123 (61886 61758 LOCKSHIFT)) (124 (61864 61736 LOCKSHIFT)) (125 (61903 -61775 LOCKSHIFT)) (126 (61908 61780 LOCKSHIFT)) (127 (241 225 LOCKSHIFT)) (171 (187 170 LOCKSHIFT)) ( -129 (249 233 LOCKSHIFT)) (132 (49 193 NOLOCKSHIFT)) (165 (27 27 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (61905 61777 LOCKSHIFT)) (137 (61869 61741 LOCKSHIFT)) (138 (61877 61749 -LOCKSHIFT)) (139 (61906 61778 LOCKSHIFT)) (140 (251 90 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 ( -250 234 LOCKSHIFT)) (143 (59 58 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (208 (171 186 LOCKSHIFT -)) (148 (61904 61776 LOCKSHIFT)) (149 (61920 61792 LOCKSHIFT)) (150 (61921 61793 LOCKSHIFT)) (151 ( -61857 61729 LOCKSHIFT)) (152 (61863 61735 LOCKSHIFT)) (153 (56 200 NOLOCKSHIFT)) (154 (61900 61772 -LOCKSHIFT)) (155 (239 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 ( -246 230 LOCKSHIFT)) (159 (207 176 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DOVE) (logic ((100 (53 37 - NOLOCKSHIFT)) (101 (52 164 NOLOCKSHIFT)) (102 (54 126 NOLOCKSHIFT)) (103 (61258 61260 NOLOCKSHIFT)) ( -104 (55 38 NOLOCKSHIFT)) (105 (61292 61293 NOLOCKSHIFT)) (106 (61271 61270 NOLOCKSHIFT)) (107 (61284 -61285 NOLOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (61307 61306 NOLOCKSHIFT)) (110 (45 177 NOLOCKSHIFT -)) (111 (61269 61268 LOCKSHIFT)) (112 (172 174 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) (116 (51 - 35 NOLOCKSHIFT)) (117 (50 64 NOLOCKSHIFT)) (118 (61240 61241 NOLOCKSHIFT)) (119 (61234 61235 -NOLOCKSHIFT)) (120 (61266 61262 NOLOCKSHIFT)) (121 (61365 61365 NOLOCKSHIFT)) (122 (57 40 NOLOCKSHIFT) -) (123 (61275 61274 NOLOCKSHIFT)) (124 (61300 61299 NOLOCKSHIFT)) (125 (61273 61272 NOLOCKSHIFT)) (126 - (61282 61283 NOLOCKSHIFT)) (127 (61256 61257 NOLOCKSHIFT)) (171 (61356 61356 NOLOCKSHIFT)) (129 (93 -125 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (165 (27 27 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) - . IGNORE) (135 (61250 61251 NOLOCKSHIFT)) (137 (61298 61297 NOLOCKSHIFT)) (138 (61305 61303 -NOLOCKSHIFT)) (139 (61265 61264 NOLOCKSHIFT)) (140 (61364 61364 NOLOCKSHIFT)) (141 1SHIFTDOWN . -1SHIFTUP) (142 (61281 233 NOLOCKSHIFT)) (143 (61351 61351 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . -IGNORE) (208 (61357 61357 NOLOCKSHIFT)) (148 (61279 61278 NOLOCKSHIFT)) (149 (61239 61238 NOLOCKSHIFT) -) (150 (61290 61290 NOLOCKSHIFT)) (151 (61263 61261 NOLOCKSHIFT)) (152 (61295 61295 NOLOCKSHIFT)) (153 - (56 42 NOLOCKSHIFT)) (154 (61252 61253 NOLOCKSHIFT)) (155 (61254 61255 NOLOCKSHIFT)) (156 LOCKDOWN . -LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (91 123 NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 -2SHIFTDOWN . 2SHIFTUP)) DOVE) (MATH ((100 (53 37 NOLOCKSHIFT)) (101 (52 36 NOLOCKSHIFT)) (102 (54 126 -NOLOCKSHIFT)) (103 (61284 61285 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) (106 ( -174 61245 NOLOCKSHIFT)) (107 (61369 61363 NOLOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (61254 61255 -NOLOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (173 61246 LOCKSHIFT)) (112 (47 61300 NOLOCKSHIFT)) (115 -(8 8 NOLOCKSHIFT) . IGNORE) (116 (51 35 NOLOCKSHIFT)) (117 (50 64 NOLOCKSHIFT)) (118 (61282 61283 -LOCKSHIFT)) (119 (61287 61286 NOLOCKSHIFT)) (120 (61301 61302 NOLOCKSHIFT)) (121 (61351 65 LOCKSHIFT)) - (122 (57 40 NOLOCKSHIFT)) (123 (175 61247 LOCKSHIFT)) (124 (180 184 LOCKSHIFT)) (125 (172 61244 -LOCKSHIFT)) (126 (61256 61257 LOCKSHIFT)) (127 (44 61250 NOLOCKSHIFT)) (171 (61298 61253 NOLOCKSHIFT)) - (129 (93 61265 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (165 (27 27 NOLOCKSHIFT) . IGNORE) (134 (9 9 -NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (61356 61362 LOCKSHIFT)) (138 (61254 61291 -NOLOCKSHIFT)) (139 (98 61360 NOLOCKSHIFT)) (140 (61309 177 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) ( -142 (46 61251 NOLOCKSHIFT)) (143 (61299 61252 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (208 ( -95 94 NOLOCKSHIFT)) (148 (61358 82 LOCKSHIFT)) (149 (61296 61266 NOLOCKSHIFT)) (150 (61305 61303 -NOLOCKSHIFT)) (151 (61308 61267 LOCKSHIFT)) (152 (61288 72 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 -(61357 61361 NOLOCKSHIFT)) (155 (61292 61293 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 -NOLOCKSHIFT) . IGNORE) (158 (91 61264 NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . -2SHIFTUP)) DOVE) (OFFICE ((100 (61397 61381 NOLOCKSHIFT)) (101 (61396 61380 NOLOCKSHIFT)) (102 (61398 -61382 NOLOCKSHIFT)) (103 (8557 8554 NOLOCKSHIFT)) (104 (61399 61383 NOLOCKSHIFT)) (105 (61232 8743 -NOLOCKSHIFT)) (106 (61346 8571 NOLOCKSHIFT)) (107 (188 86 NOLOCKSHIFT)) (108 (61402 61386 NOLOCKSHIFT) -) (109 (210 8738 NOLOCKSHIFT)) (110 (61437 61438 NOLOCKSHIFT)) (111 (163 8558 NOLOCKSHIFT)) (112 ( -61248 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) (116 (61395 61379 NOLOCKSHIFT)) (117 (61394 -61378 NOLOCKSHIFT)) (118 (185 8553 NOLOCKSHIFT)) (119 (176 8546 NOLOCKSHIFT)) (120 (167 8744 -NOLOCKSHIFT)) (121 (97 8745 NOLOCKSHIFT)) (122 (61401 61385 NOLOCKSHIFT)) (123 (162 8570 NOLOCKSHIFT)) - (124 (61437 88 NOLOCKSHIFT)) (125 (111 8569 NOLOCKSHIFT)) (126 (61289 8737 NOLOCKSHIFT)) (127 (44 60 -NOLOCKSHIFT)) (171 (39 34 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (61393 61377 NOLOCKSHIFT)) ( -165 (27 27 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (61233 8742 NOLOCKSHIFT)) (137 - (61438 67 NOLOCKSHIFT)) (138 (8739 74 NOLOCKSHIFT)) (139 (190 61436 NOLOCKSHIFT)) (140 (189 90 -NOLOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (61249 62 NOLOCKSHIFT)) (143 (61352 58 NOLOCKSHIFT)) ( -144 (13 13 NOLOCKSHIFT) . IGNORE) (208 (95 61280 NOLOCKSHIFT)) (148 (212 8574 NOLOCKSHIFT)) (149 ( -61354 8573 NOLOCKSHIFT)) (150 (61286 8741 NOLOCKSHIFT)) (151 (165 8572 NOLOCKSHIFT)) (152 (61368 8740 -NOLOCKSHIFT)) (153 (61400 61384 NOLOCKSHIFT)) (154 (173 175 NOLOCKSHIFT)) (155 (172 174 NOLOCKSHIFT)) -(156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (91 123 NOLOCKSHIFT)) (159 (61406 -61368 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DOVE) (DVORAK ((100 (49 42 NOLOCKSHIFT)) (101 (51 41 -NOLOCKSHIFT)) (102 (57 37 NOLOCKSHIFT)) (103 (46 62 NOLOCKSHIFT)) (104 (48 38 NOLOCKSHIFT)) (105 (101 -69 LOCKSHIFT)) (106 (103 71 LOCKSHIFT)) (107 (107 75 LOCKSHIFT)) (108 (54 45 NOLOCKSHIFT)) (109 (116 -84 LOCKSHIFT)) (110 (56 95 NOLOCKSHIFT)) (111 (108 76 LOCKSHIFT)) (112 (122 90 LOCKSHIFT)) (115 (8 8 -NOLOCKSHIFT) . IGNORE) (116 (53 40 NOLOCKSHIFT)) (117 (55 35 NOLOCKSHIFT)) (118 (44 60 NOLOCKSHIFT)) ( -119 (63 47 NOLOCKSHIFT)) (120 (111 79 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (52 164 NOLOCKSHIFT)) ( -123 (99 67 LOCKSHIFT)) (124 (113 81 LOCKSHIFT)) (125 (114 82 LOCKSHIFT)) (126 (110 78 LOCKSHIFT)) (127 - (119 87 LOCKSHIFT)) (171 (44 186 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (33 64 NOLOCKSHIFT)) ( -165 (27 27 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (117 85 LOCKSHIFT)) (137 (106 -74 LOCKSHIFT)) (138 (104 72 LOCKSHIFT)) (139 (120 88 LOCKSHIFT)) (140 (59 58 NOLOCKSHIFT)) (141 -1SHIFTDOWN . 1SHIFTUP) (142 (118 86 LOCKSHIFT)) (143 (115 83 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . -IGNORE) (208 (169 170 NOLOCKSHIFT)) (148 (112 80 LOCKSHIFT)) (149 (121 89 LOCKSHIFT)) (150 (105 73 -LOCKSHIFT)) (151 (102 70 LOCKSHIFT)) (152 (100 68 LOCKSHIFT)) (153 (50 162 NOLOCKSHIFT)) (154 (98 66 -LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 ( -91 123 NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DOVE) (GREEK ((100 (53 37 -NOLOCKSHIFT)) (101 (52 36 NOLOCKSHIFT)) (102 (54 126 NOLOCKSHIFT)) (103 (9830 69 LOCKSHIFT)) (104 (55 -38 NOLOCKSHIFT)) (105 (9829 9797 LOCKSHIFT)) (106 (9849 9817 LOCKSHIFT)) (107 (115 9814 LOCKSHIFT)) ( -108 (48 41 NOLOCKSHIFT)) (109 (9837 9805 LOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (9843 9811 -LOCKSHIFT)) (112 (47 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) (116 (51 35 NOLOCKSHIFT)) (117 -(50 64 NOLOCKSHIFT)) (118 (9853 9821 LOCKSHIFT)) (119 (9835 9803 LOCKSHIFT)) (120 (9846 9814 LOCKSHIFT -)) (121 (9825 9793 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (9836 9804 LOCKSHIFT)) (124 (9851 9819 -LOCKSHIFT)) (125 (9842 9810 LOCKSHIFT)) (126 (9838 9806 LOCKSHIFT)) (127 (44 60 NOLOCKSHIFT)) (171 (39 - 34 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (165 (27 27 NOLOCKSHIFT) . -IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (9850 9818 LOCKSHIFT)) (137 (9841 9809 LOCKSHIFT)) (138 -(106 74 LOCKSHIFT)) (139 (9826 66 LOCKSHIFT)) (140 (9833 9801 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) -(142 (46 62 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (208 (95 94 -NOLOCKSHIFT)) (148 (9845 9813 LOCKSHIFT)) (149 (9848 9816 LOCKSHIFT)) (150 (9828 9796 LOCKSHIFT)) (151 - (9852 9820 LOCKSHIFT)) (152 (9834 9802 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (9840 9808 -LOCKSHIFT)) (155 (9839 9807 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) ( -158 (91 123 NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DOVE) (ITALIAN ((171 -(39 34 NOLOCKSHIFT)) (100 (53 61903 NOLOCKSHIFT)) (101 (52 61886 NOLOCKSHIFT)) (102 (54 61919 -NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) (106 (117 85 - LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (107 75 LOCKSHIFT)) (110 (45 45 -NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) (112 (95 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) (116 - (51 61872 NOLOCKSHIFT)) (117 (50 61857 NOLOCKSHIFT)) (118 (119 87 LOCKSHIFT)) (119 (113 81 LOCKSHIFT) -) (120 (115 83 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (105 73 LOCKSHIFT)) -(124 (120 88 LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 LOCKSHIFT)) (127 (44 171 NOLOCKSHIFT)) -(171 (39 186 NOLOCKSHIFT)) (129 (93 125 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (165 (27 27 -NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (99 67 LOCKSHIFT -)) (138 (106 74 LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 LOCKSHIFT)) (141 1SHIFTDOWN . -1SHIFTUP) (142 (46 187 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (208 - (95 170 NOLOCKSHIFT)) (148 (114 82 LOCKSHIFT)) (149 (116 84 LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) (151 - (121 89 LOCKSHIFT)) (152 (104 72 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) (155 -(109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (91 123 -NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DOVE) (SPANISH ((208 (161 191 -NOLOCKSHIFT)) (171 (59 58 NOLOCKSHIFT)) (100 (53 61904 NOLOCKSHIFT)) (101 (52 61887 NOLOCKSHIFT)) (102 - (54 61920 NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) ( -106 (117 85 LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (107 75 LOCKSHIFT)) ( -110 (45 45 NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) (112 (95 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . -IGNORE) (116 (51 61873 NOLOCKSHIFT)) (117 (50 61858 NOLOCKSHIFT)) (118 (119 87 LOCKSHIFT)) (119 (113 -81 LOCKSHIFT)) (120 (115 83 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (105 73 - LOCKSHIFT)) (124 (120 88 LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 LOCKSHIFT)) (127 (44 171 -NOLOCKSHIFT)) (171 (59 58 NOLOCKSHIFT)) (129 (185 186 NOLOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (165 (27 - 27 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (99 67 -LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 LOCKSHIFT)) (141 1SHIFTDOWN - . 1SHIFTUP) (142 (46 187 NOLOCKSHIFT)) (143 (61900 61772 LOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . -IGNORE) (208 (161 191 NOLOCKSHIFT)) (148 (114 82 LOCKSHIFT)) (149 (116 84 LOCKSHIFT)) (150 (103 71 -LOCKSHIFT)) (151 (121 89 LOCKSHIFT)) (152 (104 72 LOCKSHIFT)) (153 (56 61925 NOLOCKSHIFT)) (154 (110 -78 LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) ( -158 (169 170 NOLOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DOVE) (FRENCH ((208 -(61869 61741 NOLOCKSHIFT)) (171 (39 61857 NOLOCKSHIFT)) (100 (53 61905 NOLOCKSHIFT)) (101 (52 61888 -NOLOCKSHIFT)) (102 (54 61921 NOLOCKSHIFT)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 ( -100 68 LOCKSHIFT)) (106 (117 85 LOCKSHIFT)) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 ( -107 75 LOCKSHIFT)) (110 (45 45 NOLOCKSHIFT)) (111 (112 80 LOCKSHIFT)) (112 (95 63 NOLOCKSHIFT)) (115 ( -1 1 NOLOCKSHIFT) . IGNORE) (116 (51 61874 NOLOCKSHIFT)) (117 (50 61859 NOLOCKSHIFT)) (118 (119 87 -LOCKSHIFT)) (119 (113 81 LOCKSHIFT)) (120 (115 83 LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 -NOLOCKSHIFT)) (123 (105 73 LOCKSHIFT)) (124 (120 88 LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 -LOCKSHIFT)) (127 (44 171 NOLOCKSHIFT)) (171 (39 61857 NOLOCKSHIFT)) (129 (61872 61892 LOCKSHIFT)) (132 - (49 33 NOLOCKSHIFT)) (165 (27 27 NOLOCKSHIFT) . IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 - LOCKSHIFT)) (137 (99 67 LOCKSHIFT)) (138 (106 74 LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 -LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (46 187 NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 -13 NOLOCKSHIFT) . IGNORE) (208 (61869 61741 LOCKSHIFT)) (148 (114 82 LOCKSHIFT)) (149 (116 84 -LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) (151 (121 89 LOCKSHIFT)) (152 (104 72 LOCKSHIFT)) (153 (56 61919 -NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) (156 LOCKDOWN . LOCKUP) (157 (32 32 -NOLOCKSHIFT) . IGNORE) (158 (61873 61877 LOCKSHIFT)) (159 (61 43 NOLOCKSHIFT)) (160 2SHIFTDOWN . -2SHIFTUP)) DOVE) (GERMAN ((100 (53 37 NOLOCKSHIFT)) (101 (52 36 NOLOCKSHIFT)) (102 (54 126 NOLOCKSHIFT -)) (103 (101 69 LOCKSHIFT)) (104 (55 38 NOLOCKSHIFT)) (105 (100 68 LOCKSHIFT)) (106 (117 85 LOCKSHIFT) -) (107 (118 86 LOCKSHIFT)) (108 (48 41 NOLOCKSHIFT)) (109 (107 75 LOCKSHIFT)) (110 (45 45 NOLOCKSHIFT) -) (111 (112 80 LOCKSHIFT)) (112 (251 63 NOLOCKSHIFT)) (115 (8 8 NOLOCKSHIFT) . IGNORE) (116 (51 35 -NOLOCKSHIFT)) (117 (50 64 NOLOCKSHIFT)) (118 (119 87 LOCKSHIFT)) (119 (113 81 LOCKSHIFT)) (120 (115 83 - LOCKSHIFT)) (121 (97 65 LOCKSHIFT)) (122 (57 40 NOLOCKSHIFT)) (123 (105 73 LOCKSHIFT)) (124 (120 88 -LOCKSHIFT)) (125 (111 79 LOCKSHIFT)) (126 (108 76 LOCKSHIFT)) (127 (44 60 NOLOCKSHIFT)) (171 (39 34 -NOLOCKSHIFT)) (129 (61863 61735 LOCKSHIFT)) (132 (49 33 NOLOCKSHIFT)) (165 (27 27 NOLOCKSHIFT) . -IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (102 70 LOCKSHIFT)) (137 (99 67 LOCKSHIFT)) (138 (106 74 - LOCKSHIFT)) (139 (98 66 LOCKSHIFT)) (140 (122 90 LOCKSHIFT)) (141 1SHIFTDOWN . 1SHIFTUP) (142 (46 62 -NOLOCKSHIFT)) (143 (59 58 NOLOCKSHIFT)) (144 (13 13 NOLOCKSHIFT) . IGNORE) (208 (95 94 NOLOCKSHIFT)) ( -148 (114 82 LOCKSHIFT)) (149 (116 84 LOCKSHIFT)) (150 (103 71 LOCKSHIFT)) (151 (121 89 LOCKSHIFT)) ( -152 (104 72 LOCKSHIFT)) (153 (56 42 NOLOCKSHIFT)) (154 (110 78 LOCKSHIFT)) (155 (109 77 LOCKSHIFT)) ( -156 LOCKDOWN . LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (61908 61780 LOCKSHIFT)) (159 (61925 -61797 LOCKSHIFT)) (160 2SHIFTDOWN . 2SHIFTUP)) DOVE) (STANDARD-RUSSIAN ((208 (41 40 NOLOCKSHIFT)) (171 - (10073 10025 NOLOCKSHIFT)) (100 (34 52 NOLOCKSHIFT)) (101 (47 51 NOLOCKSHIFT)) (102 (58 53 -NOLOCKSHIFT)) (103 (10085 10037 LOCKSHIFT)) (104 (44 54 NOLOCKSHIFT)) (105 (10067 10019 LOCKSHIFT)) ( -106 (10068 10020 LOCKSHIFT)) (107 (10078 10030 LOCKSHIFT)) (108 (63 57 NOLOCKSHIFT)) (109 (10077 10029 - LOCKSHIFT)) (110 (37 48 NOLOCKSHIFT)) (111 (10073 10025 LOCKSHIFT)) (112 (10071 10023 LOCKSHIFT)) ( -115 (8 8 NOLOCKSHIFT) . IGNORE) (116 (45 50 NOLOCKSHIFT)) (117 (61352 49 NOLOCKSHIFT)) (118 (10088 -10040 LOCKSHIFT)) (119 (10075 10027 LOCKSHIFT)) (120 (10093 10045 LOCKSHIFT)) (121 (10086 10038 -LOCKSHIFT)) (122 (95 56 NOLOCKSHIFT)) (123 (10090 10042 LOCKSHIFT)) (124 (10089 10041 LOCKSHIFT)) (125 - (10091 10043 LOCKSHIFT)) (126 (10069 10021 LOCKSHIFT)) (127 (10066 10018 LOCKSHIFT)) (171 (10095 -10047 LOCKSHIFT)) (129 (10092 10044 LOCKSHIFT)) (132 (167 43 NOLOCKSHIFT)) (165 (27 27 NOLOCKSHIFT) . -IGNORE) (134 (9 9 NOLOCKSHIFT) . IGNORE) (135 (10065 10017 LOCKSHIFT)) (137 (10083 10035 LOCKSHIFT)) ( -138 (10080 10032 LOCKSHIFT)) (139 (10074 10026 LOCKSHIFT)) (140 (10097 10049 LOCKSHIFT)) (141 -1SHIFTDOWN . 1SHIFTUP) (142 (10096 10048 LOCKSHIFT)) (143 (10072 10024 LOCKSHIFT)) (144 (13 13 -NOLOCKSHIFT) . IGNORE) (208 (41 40 NOLOCKSHIFT)) (148 (10076 10028 LOCKSHIFT)) (149 (10070 10022 -LOCKSHIFT)) (150 (10081 10033 LOCKSHIFT)) (151 (10079 10031 LOCKSHIFT)) (152 (10082 10034 LOCKSHIFT)) -(153 (46 55 NOLOCKSHIFT)) (154 (10084 10036 LOCKSHIFT)) (155 (10094 10046 LOCKSHIFT)) (156 LOCKDOWN . -LOCKUP) (157 (32 32 NOLOCKSHIFT) . IGNORE) (158 (10087 10039 LOCKSHIFT)) (159 (33 61 NOLOCKSHIFT)) ( -160 2SHIFTDOWN . 2SHIFTUP)) DOVE)) \ No newline at end of file diff --git a/library/KEYBOARDEDITOR.LCOM b/library/KEYBOARDEDITOR.LCOM deleted file mode 100644 index afef840cd973a3c199adccd072c797255f11f72e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 28389 zcmeHvZERy#dY(vmy!ONzOEZdAR=wjB?ye(khO+pfPj78rk(78Pl2<0Fku;vQ!V&2q zM;ubs$9f0dB2ADM8#FPkN#dip-F0&M2k{7B|_2JaIX9yyf`Z&3rjOIOYy~! zm<;W;?jO_})rx2}MM(U^RB`qIHrCZzgiJ>bh}{{lA>5j=W^+S z$XV<7^(HetJslF2@-e1hPH}!I8eNJkhAvn|d?^-Pip}<$^-SMc$Hi zihu?~y{XxMUeT!`8ZGJMSM1fzf>pAeyjV&t3{Bc%M#$p4l}k^Fffoh_1_Fr}@jEa) zFgYuyN;Rg{9GP9hdMQ&wc{@8aIW@#f;(E!9m0wL$jqpt?yP1{)ZGbt1RV-3@QQ&S~ zIAZlgpqj*2ZipK^He zOgxm$V2XBrOW1gtb2f`68e5`P#t1;K;^v7L)i^nqWV~m$6TyJ2`s6Iy9vQxrtxc@gTGZ?%Zu^a_{Y!MwmW^`qCU^VV!@zfS z!^!rD_(IkW1_NX71v}dBUTNo@E3csXU0r>vJu-6{wNZcfYCG#(9orptuJR0V?+kZ! zG1}(ZS!Z;@xjHefregDAcs}U;Mcw-edLPQ#vb!1M6Iz_W;>6hQ^~$4bj*z2?wsRd%u6K;K8&VSu2A$CNvQCI5C?5#!fR!@ONj z&Xz`ouTtlM-LIhIue|ypez@1~P$_OOnRO;g7Q1S%Swoj-=W4^eo&2Ciq8HaZw^4vX z7PGNP4`E!f(-0UbXS0y7WHxOTw#4jAM5GGooO3fR;;{u$D(yhsLj{OX;e0U;*|yn@z7;S;3nxX_^l8|iHT6U zd0agd&FTkgK}#VKi~7oGd6P#|VktBvqBC=5lS=jd@=4*q#B2G<79o7dF+W&L2{lN1XZ|2%G7dc0k+lYH~n&qI3cPjmy4 zW!AE_B+D_&d6G*qc9J!lrB%yo?Zm@@-wC{12?neuAEvl|FtF2J3*LJ8^xINHe3)3~ z^3z|}&3@2M$dP6J)76fO^G3yGOo#pj#)5&<>$2h>Czh$?)kjzAzvF2UIa|^t(K+HI zJ0F32w5WJWYL)0ryuYYN7Ut!{m2@eYVIAOESJ-oyIx>1vt|D`ajY$Bp6Rv?JP9edf zos|YwL}0H;H$XEfp1Afqv)cih^{yVp?F{UT-p^g1o>BbiVC^t zL{zD2Tw#Ie+bMFwmBwS|gr`LkWR*%`*HfACWJh~^?&xAxEW__waq=a2fPZr-Fc5%; zBAvi@&tFb3OEGJle9r;_Q`up}z=z;mQ{RfnVoX@66caSE5EITu8ZKUBex68cB{Q1yAybl5 z@o*MyDVssf>TwX4xipiuS2HCzwV;0opTeu1?__Rm6r@end#@t}0iz~0YCoGB73o3& z9Je6rb(uwy4G4p$mTl6gc_{q_p)N@<);5bJdu0daZC;dM>=zfbl_Rob;C-MC>~u0q zW*8nanQE`ou3#X(D8BvNAhj*+Y^1;ZZJ`Y*+ed90NPiH|v&owilarzK>H}e?LQ){7 z5MNS(v^qy2EwWUel2%HTkB;hhoA;~D~DYc=1m-#s}j zAHz0I_Y`csP#q-2#0m?sPj(|56`?AdL?V5G_;}M5Ea@Sq< zOlwhd1MJ~uF1O=pesYOqQ70F4D0S%Z)gWR@_(4*S-x-im<#q+0LM9j(&)_fptBv#4 zCg?hlAzi#9YjTN=njDQR_z?_5?MY{2=K}4*xPXAN3u%H_ZeZ>c1*L2h91&sV!x6J& z1FU2j<|SyIzs+`re;St>FE=(C>(VA*&TR^tU+ngLWrakSU1~6XMM^Y`ww-$3QJ%SF2VasTRNSyitB(Gyp5&-iCbcD z4LA(*Z69DB(?15P1&;OAa2Wy)atc}i0TtK<7mK72@poPnBKU(44!-~`@Eb){szTA$ zDqYM-ix6JPTB}T8-w^Pe|K69h56un51&2&G_v;UN59sqE9YvDR)9@*haWyI1$M^* zXn3P%!?B)|7!B@@K72X_j6|+;tk19$y@nkR?v6kF-~V%9G7dW~LxDKdtGc3)p2LGU z7!=qqZXgA^Fa`itK90dBS66TiRK*y=aa9OkTV27QQCA3JRmG^=PZXhpd>n;8t*++4 zz$!*@pF$LMW56F$!-AvT`9=^9%SI7*x)?>Z!ECeX{3>FD`33iCMm2!+>jh9q#KDoC zbYxLK>+d}&{f1e?ziEpPtJE|-*Kv*p23-FrOjej- zf}*ooNE*W^2T6{(0-ed)dOh!K`OIB%&70a#jm)Q#G+r;>Hxcu~gByP23WV0>ZD0#zXN=7Sd z#x<)aZn(pxQm@J|N!Df~2m3}4RF{7vLz1jh1lk@!Fk)?4uuzhQ6q@_Ppa`~58bn5tWUrKZsa~@3EDwl;P~4VB9JYe-lV`J0>CSu zx@i|mn^snH2&`&kRt>AmV2o8@LlbcdfFgh>Q~!rUM#}IFpx^ZIEZJLacZ_&a5nR)Fh`FnVrNI5EinNn40Z7t zfx3~tA~B}w3c)~BESLB8?;f^Jnw4C&d6I11zh7=vj_@ef@d(Vi6ATUn;qzGq=85gf zBfCNl-&wrPe**#L$R}rCX(s~Y0ZM0S=X{uN5;cjo|MNufm46lta$S^7yxy+uJx>nQ zthk+rWGAEKffu3ZoFrTjc>xL`GFCG$k}lBKc%u9plQAIqIm;vvG^!Y=!fPF1AMdpa z{{f)D^Ju)pe^>-Y;Hg$@U<+3(_0gBwmHpA@HK_0zFoSA&xsBDpqImuv&3;yIwh`LS z!7X${Tg_;^jFiKB3rCID0e#9S3Qz-quo&Q$orGJcc#T_7w_)1#BGip93hqszyps>Z zw=9I&qM&uD=&=)1>zjS4B|Tq{P)tkKBKw~-p8I$EkJY2+H4T}%pM}zxZ!5(O=-0sh;dLgA<(RX)INh+LY z$fs>82Qopfh9Pen=a-&&ftCsb-~(#G&E94Qn`-DLZ?nXj_!8u`F&Kcn!sGtvhN0#w zXUZ--`M&hHrP)}Pf8OMpwMwzZTQovz|ExOusCtK{Sa`;7$fV3k`=0ml}z{*KrcqYC6q0q0V|d(VEs?~6Fw zQAe`yp>RM2;8d63v4D#hDpngv7hsUZ1yzn);!ahZ9N}2Me1t53`ftjSV**er#e`5cx4LgO77$xIFMkBS+4g>o+xPqImIfgg1O zOC`xuA`cPW;CVOArJ8&jkY$r}M$uEA4D0_-Dbud*90| z59(}`4o1!Dum9fKA7q1p;BVmv<>PHN@agp}8O*iyU*`U;D?By>y))Xmj{wA14u1sR zFoNKs3*gQxI7x$5M7anMCBFl*pg5X!xl&qMJ4wX_`2}kg zM7s--0bv}m_)jSbYR)@ZC%Mkt0OmxxgmDki^>nPBr@>uCa^bxiRyONEpZQFV(zXx} zu4k|!d1G9r^$3Y<6c~D_RI46V1;e9a@8s|h0IWD-IfleS>ZV1qRz586(Lv+~kYGYl zC01LlxEN`F60_W7#U$1a!TfeV=8% zeDYmpp3}EFtE+>3_4qaY_`9;V-<6FYeSurQ0>^?QLkgaxzX^1aHfa+e4bG8qh18Ke zVViU<;DP7TB?}>#NR|p&0BXFOM9v71_(|EvwCrn&Jk&|q+mrye@ip}~B>--@cVb!% zIYqG6Bn`lWPV-os8&e1l#UzcVis=%?fVNRR!ZT1$vgRKiqnU#@zJ#$F!xeT{_dnSk<|#PCP<)hXbN;e(r8e>2PqOn{>dyEK$-Fq~{~B ztMUT!uM8~RtCJc!rS;q}ij#bPC@T?9C$RI0y=6D2NXIlGxm>dY9pQ^JIycIqymmG4l@3foGbqY_j1zjfpP~;GaA& z;DS&8g#U2G+AH?({$oQ5CfW&yY(GEU9k+O`4zjlVosqFZ*f!`^j>m9$q+F9C8%5%6^ugt%Dt4% ztBX`FXiyRniz%5dii*R24I@I~zXKhLYzqUKnoh#cV4kAfsaXS;z$wADVy3XO5~g}M z$R~cJBrDT+`?}D1PEw@I&VkD?H%AtcUBS8l!rm>Q5lq>WP=bU!f$s{%B1k0jOQ{dy z@rEaZ6-8JULfWlJwVGAJ1AzyHL>cbDohp2B9M>Kn)~nxyokuZ<6xu4+fg3K@kMEZc zj@UIv=B)A!j;hD*v4~u&0*+*=tUeK0fX}0%WF^XkBN@m7<#)POl#k2@C7k6ER;Ti0 zqa?ZsD3P*B$o1aZaOm6w5R6Po%31{^wz_@zQYu_ONCdt!M8_!q<|V-N0p|2uEE0e8 z0wiT%cepM8Ug5&V3ljT#3?|>b>WqH+`_9$hbVhIULq|Hd+y@tY-;s8NOaAe_$Eqzq zd)yd(ygS||K^m_(W1s#$GAX~2&DAP0FGGfj?@jtK>oo3V|FC${m5uQ|-`wlE|18`jlfMkqv zseGA`F^HDeOaY+2o|T1)A?Ht?b~Dq)5c+oX1miB#O=57WjjGYk>=V*9{r8uB6|kxU^|j-wk-E->$`PU7 zVnDFG&F#k%IJPl3MCU2E&V$@;1b{lPCWhdO@@itpOHDcXUoD9k_NkCAW~_}gq23^# zt{Vm6s4g9!c{8~naEpS|lUO3X7XgdKZFN!w>(nBOT<9x03mBgc3TRkB9qtf-wWI`T zZ5f5B>G4!<3uR5Y52tl15u{LGf`h&1E<<@#qqHOA&Ih{EOCDh}4vm-x?_Cqc37|LB z1%v`|irDycUU4Wk$Zh9!s@7*tzki=>5OE9|V!MVjHf(SxP2dtzh1PY75S^q&Ag`g~ zL3OYGzD{Z4Hf|+q1=#9?db85{zy~YAy3=bs8iMBFn9dKBjatE_-$fl*8bEemg0(NJ zOg1H~%{TbocodK&#zUx6uUx6`%~uJO$9ypL}%$xQ;09646h$4(whLjt?H;?RUMlF))sBbr8_g zNMOK3$@ViZUm;KxxQ~$u8!@xV84WOl79|F1$X@v_s{@?xlJZP1@?Bm*zKbQTt())S zZQ}(=FF5Bml3w5vdRRSPSAw%7lU`=KcZCpHsSc&Zz!o3@UIOnrNk(r^{{$FTG+hZW zx}BH%BJ1UErVFL8y%Hvr0|+ORiQ+RfFwh;|B*o=ks@vDFOTm%hfrN}K)QdEaz9k6pcoQ0sTYmv zn4F+#VE7d7a!nn_5)C-(?_+rZS{@6nA*qNmzZyt*xqIyl^3Ok1L1a6lB2UiaGL@HF zwnuCPM7$LBfafd;qO&x;ggZKd=}O{L?cIebv*BuU&;wDkB%_CGqtqlzAJeKxGmCcu zB%(x~`3?v2Hb>}NAQ8o|fyU^)X5gQW3rs3sog6Db1R(oox(%{Nr5XOCSH_^n73vXt309@LbHu zkiZd{+75FnYv3&xvj!BVtl@uoj`_dKzNu9slSRry-y;EoVN5w8oP+m~PYYn+J+gyn z>Zkzw)mxzc60aul+iISs*|EIqca@->EdbPb)Laipxx2+wlj8Q{HQ@Ha>>u*oZ}abX zTT0;R*H!aJ@%8hlnS0u{|4deCs~S2>m4FBK>}$gTH-i;ppZ!Z!Ur(WZ`jFJJ63yPK zC8A$*>Sp(d#_xUEqj=$W)d65LA}(J>c`p6&ty)JyC4$&#f5kxt1KpfL5u97gX(mo;H~O;;vpXha+m8F$Q&(Dyi4MwS%P*;R52f}?I7hE3}( z?B}!?$ItK+{dp#eTv{0-Ig=^Sm3Gph{(L?;i@)d5Vb$ZjYI#WKNupjM09W4%VYIpz zgLG%tTOp0ye-WKi^I~O!{QY~Q5mkkclFc?XIjd+ISH%)oN)p)%0XIWAux;#EBc$I0 z2|RARsIP;8$1*`>r}F4>MIJtqRfAK*q-8np8PMYtm_sjcfd3^TnCFgyUdicrb(!Dz zaC6g%Y^Faz)Sv*%pq*Z_?gs~T!=Iv^)JBpw-Rey&uUz6T+-?m+7!o8`fV5l zr5?d`=&cbHg>m4t!0hdwGizA-(g-E(}tiCnz3Q(n$vkS%Pxeh!*G=m9LQ^vWa)T z2YwkMJDAx2M85WC{gf_o8ub{Qi>Nr~q+CZ}asw))w1aq#Jcp8-96*fi6i{3QgB3Qc zci!po2(QV|cNvPJBSj8bjFZ$e1d|{eWIu zp~#Ag4r&jM>U%QNLNv-qb~wHvKB(3AYILZ3#3-*k#x3KWnH!>dyf+;h!pQpL2mVcG zUZA3BxYPd61$dA2A&~j*NRRhO{V&ILH-`e2nG@b4qG!(+FO2S0oaQy^k(ZD4Nqh)I zr*As&ia6H66HRS{+#r>FHAqtMNF3l4{HTieV?9E-_JVt4mG&9gg>uqdQ_G?WgL(a^ zr+qOnwyNLjt#%PUX@A$gBwOv7VjQ6vnx+(SK(xrBAxLQS4!8q7FF3 z=(96f&+E+GW+q{m8|T$^sp1AS!WhG}c1B3&HScony+=M*$LQ1N40zQI8|O2`J!^QD z$LQFv$-sV;xONlgXkyaqq(8bP@TTab(cJ}SS&>;(b^G+tGzGQAXJ>jpmuTB;BuZMu zZSQ`DL_@0TWEc~oYP0~aZburf&d|jgjj5ZbYXEDejP`mAb^h&jOjbi>avD8pwm0H0 z(!D+nAz2K1!Wbrp6Fr9 z5^bgdsV38S{Ysa4wCL8GU`sIOP$*e$H1I(nSW?#pR2kNt7F%_^MS)Kv-9I>%>4`c| zk!qW{iZ=u@zX1cII`SWtrRHxkc%34nikfxiMIy=3qi;WMneyP$5KUWt=c$-=tW>v8 zq5Tl<*4u$Ee{B-@|6**)>HRO$yV&Vlo=^1pm&`mXC%QbNgXE59ba+MwNr7i{_*Ycw;re-1Kb17foeXAj(R>oiRwAET zwybO_ZzXJJS=C?lm1kC$SLJ+GlUQ+f*}`w0ejH~-j@wl(>vI*~Pe#?}wc6R`WG0h` zi+N#ArSTo3{=-g3m|D5Ih#{Hb-CcC=V zn7?~%Ui2^TH7d&b`W5}^4=IG@ZNp)@zy~k&sD6Q`jbKPRPDb}#PB(=_7u0eCqwY!< zL`ObYSR3?v`}>5FsFfB4SG>Z&Izl~os0Jo0P&0DdQBZ`F@hh!kiBCm z`qnHh$X&7SouEjHXC!p$@}(~@rP#km4S$e|FA-VAq;0=p7o9hfNxOuX;#+tjS6GdM z8a^R}cUcgkZJadsj!*crKOsTz#!zStFYgy0+`rSp%p)RfR^cZ48NCjJPumg(jb$8* z8G5U}tB2_4>>(~U^tjrjyqPR!)d_pALfQJ=^6|-G_2`CJJuDvpoJQ~X_QZ|u1uC&YujZYM+AZk<;t#uvZ-MF-`4TF$Rs(cR{TdgrT$QetrH8PZ}phR=`?MUDO*^5^xapVcRlKBK2( ztp6u;SW!%D{NZseqd;A9dB6Iyjttrn=+Uh)f887Z~2(4*Y#f`q}S&zJOrmT~~u zk6E6v=#I-B#Mp?kv#6Z0vR*l&bFPAC39}rC1pd(v`gi;Jd5{+LlmX_!KbC>C{EX!; z($cejuNWHZT_vQ&9Tl(+ZW-|)q~&KQ$9xsi;;&EZ;C{NtRY(g~=x?HsmjCPWp8;v{ z4QwDSzku@Y^n|?ER zR?Zaoh3)7wdOoA4!2{3uN)qE49iGv_5R1=$CSf)z>% diff --git a/library/MAIKOKEYBOARDS b/library/MAIKOKEYBOARDS deleted file mode 100644 index 46e72759e8a547a48ddb0d9ec898e549e38599e7..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 9256 zcmbW7Ta#T?5yyQ#pP~~Svm-O+oW0KlA|wo%OHMK~Cpj~jgjgDa#CwT?cpdyM1S}K? zBo4@sxvw5^SISCJa-$a9$x?%?a9JD8ML~)x&>GP z9`@kEQ7Jl|r(|1_bw41*x8!`N_$sW zRc}u|?iWS>6c$7`pzwnM7Cs@z_Bkyno|bc|mUStJ;;sK7vv=KBqzn~@AdcOdA}_BzacxRh7BpcDqCqEH}jZ0oc3WFPcqLm?L8yKS7amY zJ1fO;IpXKWe!eDW(vjOzJRy^`Z%2ynFwY}t?>TmKKPSE5)dGB8*3-ee4DRm9$NX6O zzbvQc$96hWoHs9dzz@cBzb^cH}vk2l(X zhw;|cbJNM0)n!iH{PlH2lB>K|id%BsYsZD(mRr78{l?akXuxecomy_EdU2e8%iq&J z9OsC<>9sCP(bUg1ACacMho6aV+^VVHGi>TH+^f@R>T8BBc@%eQ>R%c5kjL{WO8Q{xlRY#i$sOLzLg0Yy{XIG^bpS3)VEFNK_|cW>}0P1exFa)r9avVEP?y?%Wd-YU;n3&PTn@os-j5Jr`or zZ!@{`F+~2xBM?zjUpI|ie!8QEdYbxqLqF>0gMga)hG9LA!9q>_L&FM>!A4E}tYHT{ z1}l9?40NlA5gu;*zF)rb)l1|GiF%JQb zd`FJ^UdZZkv@5k_`45(I1x)SJ&5T7n4RSk2^sw*Bj2wDv4$2V8g*?Ojpux;;rf3#g z)>o&S7FdWOP5oC!H}#cN#*)E!32gnteCrx`Isbj_<&u0RKMz~}T__6MxeHrs1EvHNinpJ4n@XyM_*Z>PM_m zU{sn|Ri&rVs~Od2b_&s}+$ij*n%hwbO4zsI!91$OJfwiOp9-6C6T;ah7A~Q3i-olf zt>R`Xw^^9m@NmJEyI{Cm(Lq>J&n-#0Lme+68#2i@snk{z%kj?g#(0)jE*uh`gNe+% z@Bd#UnNi`L3@hXgZo2S@)GRAxMh>3c;l4p224#qzupAiB$?vqGIV2el4afFkdITBk zY)sb25Qc@VYA{+X2YrdH#wm#OLFxA(p)yruXL-Yh_C^DbXk$F9}aXb2+}mcfT8VrNj7fCunZ%hOt%`i z(nfG9VUFG)+boP}V<5HA_PrLU(~xc)(XFx(R#S*mKt?uv*wt+WBeD*>F0|PU(61rz zYiv~%(hdI`#om$jj@e4+$4i60>~cxh4H?C=8;<;nA>}Y4>L4z-v)h=>gYnqdeztGO z*^urqjOb?bK+s`Cu*+UIJO9aS9>~nbLV9j3mcc7lvXjsb{TRsHq#@$aI+i-y&J)dL znC%8iH_0lVca_ZnsR!Mytz;uQo$Zj}SA*dq#&)k?rm@CrVTrhx+bHa>6U1E(Gxal8 zv1JgGtnKIHlv}RJt6o3RBWxgUk+|emKm-XoXD-vvu8d%!V~A1KWNt?|F&)Er>G@F; zP;5l6C72$0fm;b-MaPs;3$2>}ohJcxxFnBQ_!MzSxsDj8joX^$PD-k#a}W%+^mLFB z?B?=L`z#1sYB?ZV?w!Q1rOzJwHX*Vpx3>_#0$5_04i3qFfHO0-sz+E%rWZ0*q{On8 z)6;=YAL9rNg`wPpkxFOb10PAwwk64ayiv|L!CL}@a9S43YxTUvD){eG)Yc6Uf)3+=ZW2eRlm!d`%Q*#Lin3+88_Hx*QqaA4J zS^!)|MtT{Kip#R~d5g6wgUyGzPSYc6nJC80-ab?jcg^nSnOOiYIDFsMzze`_ zktf{3rz7ZYEpztC+S>R8rmlIDs;h_qcK$G(Q;WCT2$mUI$2QE`CQ*Z~mRqw`x0w)Z`r&^CW#nm5X^)(nlqX ziuGHw4`Ho_DyJO<;oDl=%}o;%DSg^9O?F}-9XDBmcre;3PZ;iGR8<*_sLBbpB_w9i zxia&PWK@p27_E-T&I?kyYWvMoBWOuQDmmqM2pPR+>M~c`(D-AQs_!JEv+IL~_DPSS zo_*qYsDy^&4p~!0E}q#Ktn@_KLpIwirK)0rU15mszTmFs!j-3YW#wu3>$-vY+k!;u z{V;7RNBD-f7GBW(;}veUS>lA_m2F;7<#cWtRIrlZo)y&Zbj3WX)Pe<;n?G@qM5=;> zOktkc+aoPZ7HF>G72qa|Nma=~*koD6-sNVBU+~$_3BsU1Gm+evV+vKV@(W%J3jINt zDKpwm2mbseg;Y0F$eMz^#C`DIaf1TE>Y!fV-A+c8+h>-y#@lUbwC@Kc_;0?JpG1cL z?fu^AK#2R4IV0=nx0O&YbQ_v~-@i*C(ZjQ^DBS^AP@ST z5#0E2sYPzLC5>s6yHE$o)8NGZS`{SGpursykbtM41{oScTY_@KCThzh1i1_>UNt3f zEu6b$X>C)dg;<%^)t`b9P)yQ7juY&3LNGZZTBUKI)|dIpU7&dRA;4z z$97zn8sf<%QCD)upe0mQN*NTTnt&&2Esj9x*+W;0tH|-Fr-9%SDXpz4Xi8C?fP{}| zWVTk)@&wk(sxHV50e(!u@cPDs^ecediup4(tbYTM#Y!!_qLvpi4QWH7Hv0OK=wF*S zt+NnO;tu+!7zwUCqBUDpZQJ1j64fNy3X*ElaCHf&Wn0~=nF?8G0&3M(K@I%;LZ+U; zTC`Qg=25tR0um+^)KrYdf1C*6;<)Ii*7@BSL1~!a?VbM-3CyL+a9$cp7|De2mx5d- L4cX}&=xOXfV@L)I diff --git a/library/VIRTUALKEYBOARDS.LCOM b/library/VIRTUALKEYBOARDS.LCOM deleted file mode 100644 index 3e108720298645fd9013711ef211bc1218752fe3..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 49495 zcmeHwdvIJ?d1rUauVF?;l0C+w7;`MZ$Oaj8w_1`-GSd&W+^v3Gxw|#8Joad0w+6|U zC9kAmn8K-r6jV}`kc8(95JCZgge4?x$(@A(Mn!6?wz7}fN8$F@7yH!VN;WlCOQnl=KbxV1bgG(F(ZOS#{ZuA{@3rih>Wjq&#^x^##0I0IDi%AH z7(F#K(x>|SF0EX>wzxE3S1Ze^Pjy~@&seqai$6cLHov;|@Rhl1OLNN)7gsLLEj@g7 zzP>d7O#DRR;ibj3YnN75=kaiHb#C>Uhab&XYE!9VAv=?{QkAjliFZT?uOCBoCkIm3 zR?+6*po)&38jPNb$Eb~qtMjJW>+1UayRWUTox;QN%KF0M@;mXgxO`ppmAFBL7S;Gu zOG~Qy%-YIR>*%~QkP|0P^r`Fhx%K(_b=Bz^V|3(H?BuDT(Y|{F#H%=P6&;F>oQ$jM zmlo!h-#NdA@vN_4eEpq|rYcqC2Uf-^A+eAiJCVl3o~~F^<*|WMwmdaZol56xS@X4Q zl?O7pRAnGlt>#ack)u`}D5lccVpVl=`RROl%$g1=o6lHfX`_^?7F5X^%ce55yj89q zQ~i}}#=@j2GkwTAoiV_S`FAa@JVgT|&|_#G$P;$OP7Mvcdf0UG zIwrAXJv#P?>OV7O)w1gRdDGkMqX5Ks8RIZttm2seqrW)5%lPeLQb;Er>%^KH^9@{` z8XN8GpH!nNqbAj$Dx_;OlUbElQRRVHIaQ)mWYEij6UNm^g{7RDD%O1UaxLRnv33Ee zE@NdY8JVKcpWYVZ7UL_RY8CruQF+ba(Hu_I5Pq7J8ZorhDq2$!#xe-+X}cU+8GgE_6jA;l@|^ z{WYjDwDEh%@Ws$p7Fvx@u6~8Dbo10P=9n}LAhZJ-dCFpbf{gdlREY)zL342-L4^ki`QP&7C_HWHYQCXRJZR;*06T0LQE zH&Y)|r^g>4{6iGJkV`w*y+(+>KaI$eQ z$xok~*G<5Ji7B!%f8V855v?gcN$(Sd7B<^`l=$RK*M<^kE7?7Ds zL<4aw9t9D}m#b5itW1lF4Jmn|p4u%C&W(t)bxad^~e5CA-XzA{xV=gX%J+!Xb}1xLnU z<_B#6qUjiq!^KR1)p1S9@aURL4M#x5Mt_G^X=)c$AfN(oLiloa+FqJK_mA%cx_2i# zlJ$?o_dF-qJ=5$;K0)Zk82rV>4_pi_Y`=HmQ!A8~n5tx}S@-0E0G-a(a;a)gfypzV@jl?;0ctcRU%=cai`iP%hK3q(VS)e*NQ4Tw z14AcOwo;7}0q5>5gY?0!l;QAk+-@54{9rf~3U_yfc#h82Z{C;8@w5?`N6m_IsH&#G zlh)+G)T9leDhn{jI?MSY(PCfw`EtG{Js1a`U7ucDuCF{@nqPh@vvT$7+;Sa433#ah zKTsYT2Wq>DK}-!LLLkSCWRu)o`Mnep#AAfypEC=+__xr@nHDbXz_75=&z~=2?lUn^ z1KkIg}xP~VhEks`6Y5(|CnMF9&Urd$KV=2{-Dd?|G=WCf9FheA9Ra1bYnm&eq zokc5UOGab)>SQrBGj2hOOhG=6nrV%yYW~!zip`fh7>oL?W;WP&R7G#d9F-aS|vCzKp6d ztDI#7#Tz)PRVqOrnN%bckcNUszy+iZ=vKu`T-7S6GCdJCvWU)DTubMeioDR<5eh#+OlwnEP-8!_olq_k?vC!rcQmi=Bfj%LIZOAE-KCCZ z$1mLo@7Z^mQy7Ir%t|(ocX#d4`R=!RB;&XC>6E?JK}q@1Lf1lFXj3N`YbbOv#93~H ze>41ich_tAWqPQ0k%`vyaBp`3eWU{*yKi49a^c30 zZ_#jM_}<|hu=;(&IckP;ScbD3!)big-Njctn#R43=GST7UuT^V;e{rBd!Z{lyPrk~ zeQne`X|o6FT1)!yR^y1()eF6eTlx*E=Abob9bkx1J^x_!L}q(#{AfEoOVm{V3##(F%pwp z2}l{PT#5LgD_0!i^4-`@OvSOl&Yw?BPG-wv#6w5!nm-C90p=iAr($YMxGvbkF#5#u zLMD~TWyfsVFbpM7uUeJBScCE;62nd&$p3+P21nbZYpU;Scc@KUL!)i-L$e8LcL-1k zP8W&qguh+Lw1N2{GzO-}+q4TRACx~1)laiA6(=1J5`*UYZU%$7HT5#>)^yadU#WN- zfX0DpK@G=FYVF@Q;8+`g#vpA6*3$-{vEkr}i6w#&BGv|=G01g+?Ha3tzyDx;LHVOV z2m|QokcW?Y03D47!z&8*ZV>;ZnM=2Muc}7c*iG6%2(%%nqj95ydn-4?@~Io(+X0oZ zJd6qG&lFFI7IeaeSz69HrlOdOyJtDp2~300+%Rlgnj*c%C0#;B@Y(J>cDn&9J(11S zAi_Qj{UDr-;Qw0N?Cy!=I+};~i5lA6FMnN(BHR@|muFJDm5ZEh{8^~qU{H`?sIdOn z&_T25Y50(jg1YEd3m5_4frh20^l`K7X>B>7-SDsp~x2k2nkEDFPITQ))Nct47WGbEU zDq9gKTWqp1$`&c+tZWV2x|UmGbo9hYML>mrgv7-{4S(Y5EV?=jwqsTDr}O1h(UI`P zbcD~g$tT!cOH3=El)Vf{Rwe!;26~M1KkV8O3O)Lz=`NOBECGPKMIK9cft| z(8JlL#;UN?Z1{?p2FRenh+=5t-PQ!iFHL9$zLOJUaG8u{RUE2_FNuwHE*mJ;8<{m7 z8zFZ_D=@HYa?gFs&vE?N@(lA&YE$DAOb5|X7;J2V!J1lLSyxZevg?BsbyD?}SKyja z?^;}4e`;>Y&ZnM)vk&=J)%r8n=21a3F{t_srL5u|@|)|uQ$dF58-vGhY3`XdHK(q^ z*23l2V3)W={yMwvwLY?YX+KP`CF0mI1)G1LF^CxZlD1T~pb?uY$)G3z(>^Jzre2_V z*cbtCcClKskPI)>$wC9{)NH>6C1^T^j6&z7g~5%J8mYf{m;<{bRA`1QUP)~&zZin; zi@PE!z}e=2<`7TNsuayB$qQ)vW;bW#54;$=oJY~H8vi!b59VyBoRK`)pGzysYvgvU zag6A;KquK-#sU4b|l@H?}`G=&}F zWD_73q)pm`pxeZmuuRD2I-ajoYme}>Rk8p9M1n_vJ8#FFMKDuL=N3fSUEta1+(q-m zL=)D_`|HWnA`?|0l<9W>Jp)@R6;d^;L?#A^Wgu*@jZMR+iY~_n$;Y7`3iu*~2Oq#- z>}4Q}a(V757OYtktqr-%bZm8J6VFtcY8*hbHOMMt=7Aamk3Sw@Xino#R8_`m=^~!U z{v)vi#~CPGL8h2Zm0^BGmrJk+5#y`YfHfsNdg(N|FjIrk#4up^solov!BAw7bys#x z?-ilv@s7<*nGq7N)ed$T_zbUNDtyfK5rY7sTqZ z{h6(a9?rFJsb}j=yTV=HC^YXYF7!V3eB(bAkAA)J@4=p6B0Yb;^e9U%V#ZI6fgwOy zDdZ=s*-0kkRdq6|YS{`Hkpij{KZ>dmGmFBWhS}Z(OQ(W$etfD}WZ;AS08B8r!P=C- zBBjd3Ru7}8j>y0)lK@_=!8%w=(4{ZV^LCl`Ts6A_YA!~&u8P(4SO9!C9oQkJ1MXO5g)r2~gN?Vm0 z9<}Mc6%Wm7gO%ImY6pIuRJ9b0&19@AkfCx|706zfAa{`AFnEu--^pC3JBTN{*Ccz& zQj$p^*;B7-%}NJ&L9-3CN^2ZwZq_&>H_->0DIn{&G1eVP9yb5*&=+Bl<~K$p{t?%Z zc98Q*?$)V%?#EoqgE`(p8 z%(HvN$kTn~HCESbPsc`I+3JCfD7?L~&)RFjRutZTHns5vtEY5u3s#@TUvVWR?Q{^% zu&)?7f8)-3NCqPz)|QBYz*FLwiUJqG``Afk6giS@TKE7A1!nfi7h$g$tRANCt+Ovw z2>wh978{@m0*ZoJ0f~8mJc8u7;15_V^ucjpMF;&UFg692g(5DPOKx1w5!`i{n2F79S!7Np9oMEO_BLMSr9Xm9b8GNv) z^AfD)WI@$7V!SfCyCX0d@7&iI3_oAv2$hZf6LneH+g~)f$r}7USN{He`*>!iSoGos zwyMswEkHdZwh}%USkt$#@&IX}Oi}ns>}3;$JHuuXQG_qJX;>611ppvUGD4vfr27C_ zbv2N4h;4(#5I^_u5bzqkaFwxhwa8s0^l)?$*%E?Q2oPMsde)bDYISvfd0kyuUU_=i z5#80?>bzQ8M^s;3Em9;P(58jwv_Y5lOot}&l`x%vhHS1Q7~*9XJ~Iwu7Oz)_2_(V# zA}%K2umh1q?tveWUI9b7=9UTyp*``&4j9mJSx^uSHNiwYil$VUSDvXhg<=ZA<0%TI zcr;t7QY;>*?y3CvK=v%mF;ymH79tmdD4E|4YzxRDe}Y3o3lbObz@$}WHj2c!CvpP` zcHj-3Z5#T)c=0sevEtd;Os|;d48-c45UVrI`*@{Z+*OY!x1Y=KvbwnIy_wH0bS0ln zXL!kNrEb0`U$!!14pZK0{1vX9i@yxX#g(ZgOAn*A45}j9iTh} zP<9v%h2h8QNGi>=Zvl7+y5XNC)3d!T6~>l+UWm1ZJ- zMQ~_=@r-|_yADLAd$g3)+lz=f&iDqV@ zRfs&+_-Og)g~mUDRX`_}SRSl=c>w1p+)<-YA|PxNB>`0t9~hh_cK8je@^Bd#NXk3J zkRn2S^h);VXuwZmL7Ej%8@X(83^6;=K``GU^c>Po72G!n*PhHlMTJ}d1&0yG&r@J{ zyS}4?Dxr4Ycs)poC3F4tGfyq9U#B<|#F%hREoK*kIH1#vEQAt7q;*6jP{J9s4_$x) z^+?zldp7n731^678ZL(3oBU*Q=>dNKP_ir8Jjk=%d~>q7SDqx2k)IDV_a-Y82^)s> zo`m=ro%~N^r2l&+Jswy?B+j0J9&s9OQSf<;OQ1egC7ls!UBZM60`ez~bImQ}RF#px zWn9{XRaJm4!^(){p3ei!!3Ztv*h0765K}BOro((3vIKj*ry?8hqpCuh7UV1XgYZ>) zMZgk%hluD`vZpE57_V^!qj;`{rAHr+&HK z{idC%-$591WGhX+mn74_Nb@K!>oiY#ntneA(AFj&W$(QG-K`?K$40lEC2eTRU|@T4E^NYCuiEvvuzuyu5y zclLPWq-6hd9_W}ZrQfKq^JtzI8qZrtkIwdQVKzQ!9q;L#-4AuSxzE~<3VRSr!GY&D zetgl|e{{BItMQNFSrsk{{%ky?qhV$bZ&`;><}k_}n(f`PI3VK3XRX6WXAhwa(E}_& zia;JVP6l8xc@V7(7Vt1+^|KY2ZpiRM4-mcO0g5a?#N!mVG&z$h7F8UH_A`Z2==9hq z8JHwbY=k6P{YV7@_Vmb-flj)Br#k|JDtSyE{-$fdOnwv>SRNPn01zRfB(Ye z?af?iXGinrSunBFmv(G#9`q(%*}h5CqbZdZ!lKz08s~T&Y+mF+?GAGDlt0>@wdQ(85j( z9yf?d#To1Zf*gjNzA+%)zcmr$r)Gg0PeXQ=S`4a#_s2n{7-#}< zUQuy`sne?A{>yTtX@CbmKZbZwgf$KeE00lxR!c@W5V=Oz!V@6GVp`2;{bE!q*UGe= z#3V(M7z%5*?y0?cqnPrR4n(2gv?hYuwIrGdA0YrTQgTE2n*jwqf1XMcLh^hvKdEFexhxBJa5s3~VV>~3V;#vmhXevJY|KiL$%+_)*iV6}S}=q~ z7s%;?ADl`RUI9jF*9M4$(j6ckAmN5Y`)&CWq@LtUk~uX+Aehoz8WKQ&#S|L$00{pj zympaf_nDnWs1HA%kA%OT2VB2_pGf$dh`dZqT)9=aa;vx$`ECjSF{t?Ga;K18oq_)> z{PV8V1ajl=U;Oi~t<(e+qvGa?GZe3Inw<#^P}RspPgibHaa6-;b|$Gw=i?g8cT;x> z)#~ifN^aa4fEWS@>6rwKA$L@=2;R?R6*S6P_AFxb$#jPBg&+(287i9qQwPMF=*Fosq#A>eq$P9Z z!~;CK7_Xucd+x{=sV7f?2Ae4b<$cL1^(`u&U7e*Vn{(>vCv8rslryzalVYaV$V`}0 zlF+Pa=|5fp1)69I0K>*)d+P};PEIl0h>^jx4Yl63T$?oAbusRQ-?1|cn<3BylO?E; zY3>pK$zw}<3Y>InW~oO%ol7f$W#=T~0cf>uH$ zMF|jJA0rs&cxCTmkb7liFV|&M^2-CcOHT;D!_AH<$-;mkRE|R#fZtOrxzmWJMO2hW zC?h`aOCjfjH_tG%95%KZDGY2{@J5pXihq>^K^2O7_0>V13~#N7?e(TaX&HViiHtYR@e z1Ij^+new8Kl1eYoHz7smQj=Lv9?&P9Oql>CPggXX1vN93Mgcz88}Nw>7>UlvU%>)< z6v!s>D$cGT2Zoj_+vEnCNpAQxD7(=HB$2{B*_a9YsV~LEReKfBD1=pCiV;!`=s}ce z8)sji8i7K~fo*+?!si~rSzAzc6+YA@t#IsPKf63 z3IE<|{PAKJDV95mF2%Co(i%5{w8kw_At$t+`_hUiJ33m_ObUANt#w2l`cjPk(yEG* z=avyzf6}uSH5k+eGvSKkQieQ`=>mEI(8x$bWPjl-#P})QWyA}>t6$N!RbPrRt2zB}1X&}UQHU*j-;4|kl42sOA#WtS%9sd4EV9^I8J3?ZK+YE=Ey*eDozP}_^VK89gsy}mpK8DPI-)ky|~A)d^HjD-#p24>2=34ji5T9ux*hA?Y|#muu; z3fE+H6uKrHuT@0pK&~a}nTRabJLX-UVTOXVsyj>Ci%WGef^Coo18JhW&{~z^I1MKf z0l@jJ0?KnbgYM1XMl! zm@nYjm8xG!X8}3B^X_Ei=D{Ry4cwXRKC-9W(R>Z>EBy!BVz_s!WbJ)%GhYf{`7V4P z^b-j$MQ-5_|7EnX_TmG~;_}Pscync7B%AGO?k-0jZ+sRfE5PVahr;}DMbF_Y zw>X71#G_IY>K7=jmUgw{xhARwPG8Y2_GyBGvUyG|@q z^NgjJfHlUbjzd`WMxz{pC}pRkQIj4AuQcg#P;EOM0;Qb}G18>NMQxH{tu(3F7-~|X zOY78D%8iv}Xg2$I&49^}!1UFG3y@=xmZ58FAQ5&XnIfc-dWd+Oz6y~BNe6{zuPak` zo9=U^IL?AjCh!q(hrGjr^tFyK{Ey;KL=gXAWCB~d(m-+1?;_{O5dVo3FOW?0ethA7 z;fuSH8J#6Ov-y@}%Aw;dPH_RraF*%#%*MDWOxj#ks?66rHr`y1Y#a$sh!!kI?ZAlT zdGDGC%ZIKUp3-9yw?y^~bJ~cZqy$O=7IRGm3PBnQqU>ai4NM2_FwJJ)ElwCHj@v>G zp(-0ky-Xr%f*IKX>@5Ph#xM}GXNW{3`#dwA3i~V-jRtVAL0LmSj$s9&wu(l^mh6-; zouHU@uldnf$ep}e*x@4siaO3{AWtFt8k$ZNs@a8u!fa9tM07X6HSdb5sWJ;wbl?J} z1B?p#8L0*)ApomwJT~?kMrrD|ECsy!*9tIr2GMOhyA=h>R3hPyo2Asv2@%%M%Ac8B ze*06GY*lgJH9OmPZ9!+l$7XrXbD4Bp8JvfFQL{gu> zg7}YQIQ3lwSkMoCmm+_0i!EaOWI9A<0Tl1y>to2TAOE^w?P3v ze-TrF?a@P@AHg=yh%6)Y)D>!kfQycaj^_OfJsUrlZ+0wpg&z~``D2CV-!C?PFcCS| z_-l$o`cvL*grmvwV_6b&?**o2bQ)6~sM_R2hz1B8MdT6^lQ&BE3GJ;lqCJC1jxO?U zr)8HeO|pg%BEJPf?Hn}R)Dd1U0uJVeALNyj6UIl_ew(%YV4d7$L!*9~!D-U{5@_bt z?={jJlQ%DKsSf}-&H%ajmQ<218KamZAKI=p#F@GlB%(gdg2Y)C(yX)c&~dj5 z8-p;0H4R8Wo;U+UH2Q=6qpZ)kWF69JP>Ysz$dC`kMf+m7YP^7v8~Mi=@iDG{gnp?# zj$&=$Dd>*v=pNinB#8cn8%JqM_CS0WHwi@SFaimBzFBVW!M>B(z3(d>eE}2oJ!@~z zV^085q3$F1QRLHG_L(}kp7V03;5meCC3!{SYq*icd62r|*&gh1=_wrevel#8DD-|^ z4v4%-U3iVPU*}Bb3PtRN5uQXy^4G5Je_R`(Bx!+FX!kRaIYxoN9Yq~8pZ*PV(tI8oy9zn_!G-4FGaSXCkM>5UgkSq`< zK2+$`N10v|ZT>qT7p-xj&1U$1>U(blN_O@-Q|{Sq#2OJgHx2?Cf@z6;S=>d0f+vJ0 zZ*k%i$PnUwZ{=LizHdZj5$H=&dsM+PClBD5@?fGmuwzKhn>I5FbQSCf3<$@3BLY~W zinaWJpjFR1@Xq~?5(*k@pL%+3O|8yfU3nKaobWbBI{pqPORuYyC;gjKP9Q(P?(CO^ zwcZY7w~x$QUr`t5?K)4GNOrGxR-*@IC`CIJ6Tkzle1aQ@_~8{@RA_oPp(%(NL_TH) z-Gd#u-_7?h%w_BOQtV21&#qGOho8$eA1ce2uTM1Z!wC-OzSj6o;pp>?{{ji|tM9Le z%e_QQ|4-@4cP=oe$DUdVXhKj4Jpe#3lX9mGzXO`N-&_Rbi+UtuVxlzQh9c<#%r-ZPi0n~k)tSbi7#n8?BQ!ZgBEXsCr z+gV!w9ZO4lhgzsz8(Qj>@Q7u)EC`b#sT5WJpmOXAIDjBTyS$0fcXWkF#&OFzt$RxJ zc;O+X$mt=Dp9Vk1GlgO5(>W zRaxUCa;frEDV?ntNf)i$gLf#7YN(eH;*iOKO_94o-LPER>RO(aga{PT59vs0 z1P_Axc!YUO7nax>{G&TW-Jm5Ut7E1vOX=9Yyzuj6N_LUD>~+a)oK`Dev8u#D^9@q) z>G)v$pZ{|!_-P$CMl0xxq(6<=I)Q>~k0mOvrfc@KX@QgQ3zm>pNz=q=8zTs1H0OJn zG_S7&(R$pTUk-64dzl)=^N}DXQDoQ_YRm}c;5bJXbZ~|jrQ3~d-$UT2n<50f-P4*& z)Y^xI5lPks&dm;ycZ`HaJ85bX2?&txqb@); z!)9U03^Luvtr(iALs#_FAaWF_!3ZIkg1Pwx!iiM#)D!p{;-96RORrs;T#B(KKpafe zI~F9uOh}jZ@C$Q6U=L!+Yx!CcaZspz8v8KZzD_Ks)-^`^Iy}lnKQR9^PK`|AKtq`> zAdzU-MglI;)fpN$sUc@&w5X7p+KK7NfwydR z5`=6bm-?On&%-o=yFJVGWmvalcmfDQzf)cbSwk7+)G@V$2C z1DGoSUJ*Y?OL1PjR1oQKTF?=G^hEpW^prTyU~A?b9tQh-W@P zj~GCsB)03w{ZDQ=a-Np_UW*iF5WK9>Gk8m>XIN1P;-Q9W*6GubJ>gQOH;7S)r1D*<-4R9)n*Ynn9Jny=>7Rmqv!(4+y&_jg01xAc<*h)yb%23wvxgC$HBv=?S3C zmJ8d>76}~mUqA|iZtC}T*~fEV<@Tmrn;eskBcg@);4b2F|GD`ro_5<;y@ zj1@JQAJ5~I5{P1kiwEj$+)vs>46G#@MRSA)I`G+RH*x&ciZaOaE+OA~1Bk~n7ifML<3q-WAIkR~%z4;)+C>7?_ zXtG4Yxc=yEz>~-66!cP=w#V`UdA=-vv59r#U*U%n8w>hlN&X_-<~jVw-`+bxaX0nP zXnOFw`tP$_jEs#p`_exy>A&jkF-be$ym4oJg0{W>#5KKe<4%;QVN~Nn6x;AbA*WLw zdFlI+k2blr`OvO}u@(EPGBJiN=~{gCr$dR?n^f(1ZPUvZW(<1Cd9h|`C!vrR#xoqp z1{TfaM!$pR;&5sNq6uc|RHDB~#Bd2+B{2#+g}W$)M0(z_|(v~{|>>q#9LCO?UqwXUSZU4Zb zWFm2H91)9$%kHtT%}SIM>1rb{%!t3?=1M>``R2m`ap#-ITup2q%5#T=C2u_F`t))6 z@&WmCu70yqTH^db4%&N=E>vf#=_!QhB2M4oQ*`_-qlJ%|c*B?t*P#%omKo=>Z@CUy zokm8X-C?a+?UVfdMrIt*irlPT1-9YCUTR5@mz*#jA0;rVwOy#zb`Pl>a6(JoEi|#c zL=I`qRSo=kWYu*j5^Z(nMqIcY#UXRPSZzLRkd_9mJ>Eg9Pl0t5N7D>)h%9du9BK^h z8Z(x>y4C{kmvG2cd)vJhgtR4Y`;*49+B^X9Q44)7(jMHwF&-Nv75I_lnU^d^88u%< z^&@@ob|tca!012l$Ivf-I!=_8v*l2hwm0@==9cNS={io5 zTA$~8tLpPl&ONn+Q|0viRq)v9=x*Qgyc-0KUnT&6E%$vIy)i}xBSihXCe|3+R*sX`X4huqctxoDlH&saTzMY=SAso$kI?KxvCGvy&{ zNP<-0kQVP8=&94P7^15AQfDm#Ff~1ZO z6;bxivK{BY^0snDAt&}kkjPw|$@~bU14NUKiLHnY(KbEeB0f2-(sx4wQ5gR*__od3 zPg}Id&tW0n)7jD|h93+wz9&pOA!G654sZ4kesiMwJ$M_akwA$Ud*=%WY zGa8F=&p@9nE7G`x2B0jTT?N`fw8c|hRUwr~ii4L@6dLOPeGQQkUdKEa%{}6OfT1_d zCrEuD)zN$)-TcMr0~dGP2>nr*vmW|VDk2XXf6IUQ9^V{4;{2vJ?t(}7uzqcJyPNP#*O~8)IRgu zX$NyI?r6L*?U=E)8vD~7&DV2AeW~#1zVrsrLr7&~vd-TQZS3Dl&xAeoe9v9Yf2O;F z(+E6svTT3Y>iU|*gnc>RJj3Xn|J;o`BPsmE@=~!V7jN3i)l)KLPKe~WReqLXA%K44 zJ;@aQ$h+%^{ol^Havx}9ySwg7A|KblnVZLCy4WP@O74+lCuO#$c|XldPvpj(vrZ2h zxAU;R^`g$+gIl22LuSvfXuUurm-wKDv`3rFXOxcU_aPG{?Mi~|V%V93k>xIQzUdwUFpj=^Kr{W0RvFih7<3NC^;uvi{hRTW$LK)!Q60JQ3 zI%%hZD0(ka1=Emhq+^?GbU(0Xh0`uf(4m>Vz z2x4iQFJ?b-yTE}Vu-P_6!Mxghfx_A5i{5SRP`kK3G|-izy@IZkw&wuS-Dw04CogUH z2f_&95e^aqBKeab5DOytF43lqM}Z%3p}oHn+S(nQR|k_hy@~=$i4vn5kWFAOvR{Bn z_A|6^``K(B@Usg5hw>Pj3_jz2g;OsG0e~E0jKLMEB)85%a(!}f8G&cExQcsEaF|oy zT{6&}@Mkdq;TD=p1K7li=xlnrxe^>i&bP#zfLWJzvqoS-e8Qn*1WJm;Byi|#xI4WI zr&o6tdc=-<5JyfwE%2c-V$Tb!%H|Y^UuHr-cvHCd12`2($VA!;VU-+c(3nfEef{tVF zm>Uvj)eqR_MfnXYMMtr8Y10AQv)N&GOm+O_egKBdN$kGC`G`9Kg>(DNYxiz!Z=_A= z-!e(eH7<9jJFPDHa?9E;QFi2W!T%9xuM35D(}9NJ$?m}iDE&tG5jw?tXL#d{TbC!o zw>N(dr-LuucYAZc*lZov^S%jqx-dNlE_@k(=)q%|4*tmIUIwYPm)Rv4Zf_4&hE2kQ#D`>aD9&9~y}(1QeZhPw^Vzn=vwbsPP+C-_cpM)%c-3q|YrhK1N$q zf9;hIs3C|I?v^o~#+dX9l#v;CyUd0jDMqZ(?43N=h8ZkS@!q(zrU#58 zEA<>=z#pOk|H@A=V3i5l5Vfzv&GmbRot*&M4?XxZVC$V## z>DDOB7Oc$@)aE`UMMnENe`7M*W& zfu-|CyE5%J;)0_TvolpDip-b1>li$Y9yicnr0u@N=@PIusNC2Tp9N;!IRxOmxcvlo;8Po>a4Gj!R{CE707XP?;0^2 z&3FrC*$YF4VZB4fADba@$xzO;<|?wDQvjR(i?0obAg=2rLVv>3hnY0$5RUFRoi6wK zeaU*Hd+vcUE^GmHwDxy=_(u5K*cbB(#H=n zMc#f+zfynCgLtnMibTW5^I#hnnwN_8C3XAbTT6F}x4&5YZ%engH{Kvz@B-x;^O5#O zTs}(okMf_5!>$7Rdhb!!Lf! zI=K0U#SZ|ojlWsgd=MLznCCXTEu1+&+l2!duwCiKkA7hF9ED2TcoBjcXo9oO6OeiJ zIv*mDSFQ^if|6z~ks2cDS0~dUz(8k0b$y&Zoj>5zHiQ5-QyZKWj!z_x^GBU*acoY~ z*+>J_wa20Im`3UDUXzTSM!rVl&=Op=AvoXE2I0_YGzMKyjNYh|aMueg<($AcEE=R#1Okq)Ww7weu|wPpF(tw|=uwfUbI=d(>dUv?>UW2BkH+3tfZYHz7f3`0}1eBs7nBF&5Bpy-n`&?VAU# z%q?zzDF16$=9>5ODxL131H5XP_`1;^I0Rm{KmsYSU5^zqU|jXy7v zB^q(fY#9K%Wj8#o>0I z1n9b+ckD&?yaOQw>b!&6T^0OL?wrgTRX@!gdxcK$G$KX^A1afnGiQ{~#90LosjB|| zah#YRC;nHJnl-i`btpGySMRiCx9ngdG zYx*hgqqOd%TJJ^E_jGt+C^g>gj#RFZZ&Y;;*jVCC zk3~5Ra!sJ2P8uJV<_o+$*E~AOrYgBDi__&6o!0yTx9gZ@{8y-OJ$Jv^#m<8GFw==D z-vpxp-lB8MVEh*|XpnMs-XrQbNzT}4J%CtGYRmZ+Qivm(?QZGP(!PUxj5PLTI#Q6& zr8dXwNgHOTfkWsyt4a25K=6D5Sfovp7YXjuF?9W&gBZ91_aOz6z>Gj+L_gIkv+p|dm>5)~H2H7d7oCPc22j$B-lch+_9a=;Ji_w1@2gd zCW>U|1=JT^$WPXAp*=3BG0!C&;|^155fU8!$b~j^$pub*r@L*4&sqgwAyVXN9OeVO z(4TP#`1}|no{3u|ahXz;A$OVqT=`nIL=DJkIGQ8#<{i#m!d@7B zbqN#FOxs>?DI*AYpd)^M{_eN--(%Ok-3s;r7<%ZM7DHaNJpkI48y=Dhh_@!{VK|Tk zBt$mDz3@P$?DYs!_1HL-;h`AQMC6EPW&rIR+X3_OP=<+R5CBjJD|1(uxc}DBu9a&`Ii}=?G6nOAW}^X*z1~(9_HI5byxN>9J|g z?I^@}k9EpG+>XK4PWrw|&z!owU^8wdN)_4Io`kbGk{ zlz?KYlpaf|ep(QnEs{U&-Y8HF(nURQG)@_&%M+u`n=S&PQyfgACE4j<*%*ZWECP&^ zBrAic(p^A2pFD?zH{6a)4Pl3^&7z*;>ij!YCxW?_melh6)8Z6cTwh#SR*O$^RM*N< zU9Bw7tA)8bj#ijoR+o@>zK*?rgfkGqNM|ag@#|=J_$DJoV!mK$4Xl&N;%d5YFcZDk7(NBQKS@6@J>RTnuVGjdx`K&K_eAI#mqPpu^~J%`%J_V zcqAs8h~fTJB!ZPDVxxE@mXwH{#FJRMqx4;vE6m(@78aX`QN6-w6R|j+ncXH5RIz5Y zi4iIb2BzPK2dP?SyonKN3!nIHI68>8PR)Z8Ba{u_^!sp>nibBR7^R%TpNFH=1&1#u zM!9=#Ry`c0o;f@^F&d+#kGh?-;V6N{;ogZ+D&ywi!%-SkRde#hDCO7u9Cvo%#jx_k zC}kv8Zc>IBe8SihqZ%CYIvk~85}QwqYGBaIaEwMsoIf$D;Xp6LfIZ;?%K$zmZA1Vt z2p8*NmuMlK8JjAVX4pM%R1}lQF6GozkwQ4kO*5TXIE+5HlxC8wPk3iy!B!Q#XjWxE z@u9sAOXetayO7Inz}P8;2}Z}&^>@7EIyU}3b@l2q>dD3VrTUs$TTx5%%kNxYQ0wzJ zq-AY=5oF`(mDMY2L=LD2;Boe4iMY!cyCiAQFowZ2)~_#7?C%sPjpuPMrCtg)?RF79 zvoVjCncZa`=PVNtd)zD)N#A+6vkLT)Z$dWEaeef|VivnXXe*4#>W0aziFytA=*+gy zFy!=2rWlmYp1*d|VNm^;1qz>lBwO%Hk1T6U7PB=9r*PL!G~bE20ICvFx>%d%J3hgN zIW_4N&}7@23l1$BD{Nqz%K1e!A#+TEnFqC%Rc%WedU?W`2d}`%Yn??;>@}}Gy|{j9 z!H&`BGu(oR>Iuzf?X*t6Ek~Gxu4I0V`5D4J)Z8WFaBFnR5S=*05g@B`^%I1}rpdYG zx~ea(U0a%a#%Z-PsM(fQHB;)mw}$6dv9esPNjHfZ+mR^}UM-z*MXZ1oFVk^HPpu&l zM=8yztMkiGo#-PD*f%EG!Mm4S1Gty|le8j`>om0l^{EEPX#m|rpBS=qwYWX1H5;tV zB3ovY#g|rto+Cz?ok>6g+})$!jzOBKQajS+OTjmt^F$X{Akr8ZuYtxb&D&iH#xL$t zi%IexdX%bTjyd2+WGgz}N=M0~;gzR=Ymm682PahiNlc{qs(}BXwgC0o+|_xtOg{)v znp;|(pQ}Hk&&a}|SDfRSwe|U{5Nb###Ti%<;G`DU5r_|_Y7{!)Mr9soed#4e8$4K& zX$U*aqBD~~La%!k&<36B6*LPD90c!|Fb`|$n(456PIyIj_5plvQ}vbQx2)U4y8BGs zrSC+nUb6Sxz?wAfRh8z0?_VOct{B#dS0uL@C7fP z$GaIb`}@UP&%b~MolwN5t>KwW2W$etGg;+1FhD=UaNQ}EdY!4iMS$#NE<24O<0K`PfPW(4HMrGQX<5}2xA{{gxCVFL4>FcYOz*Ym zD@f)htg@nhQlYgoxJw>};beJ*V(d>W$2vVQwn;)YPbXai2^N@ue_A6nVxCvZqfY+R zinjLv04GcE_<0$!u&d49?Z99Q8$`dnzxC3raYbatwC1Nmu~ zPas{3;Oh+S6^|a&%`N-C3>f@0$invk0Bv&Txxb5OOpEpv$;LkR#~!yg9`DDA42i*G zR`9=EaI%#vCWHQ^ewNN)`6-0M>7bcJKij4!b7Se0=O=lZ@_UjvN4xa$UGul=Ptw;a zUb&vr_nba1?Y7C^+HOwrr~CuXze?#+e`~vz#qdn}A*$i|Dy6q;_hqIBEq9#3`)bjF zpxz*@E&b{AY7-R8pk6UCd%2DOEI&h_?d1FnK0kwx3kQCNCjyMNa4^K|5xtopI5_Cu z0(?Y@Yz_SZy>tf%y;SUtaTuCd8k^j@qHf?T#*Q$=0Kz;2(+mA!gNuC{lRR*mb9NIO zb!@{7${G8N*lzS;s$}NDH~PbQ$uEp|`eVQAtW(u&g?bgmcl(($*>5^$r%8ypvc^1F zW4=n`uAFgC&bZ_xsTx|jM2Oryut@tm?ekSxJq?U2>g;DNfP;Tf{mTf_A)6Ci_%AC) zha+NmY|f?$)Zz)!>68#1_78KI4u*}rAsEsm0t@q%8d@|?@G5o(P0rw$mK=fx`W}T( zb6y=)XXjT}-mNk#tJhXm=g5Cc`}J`(DSn3O2d8+Q#NMaqN$k1APmF%zsuRDI2OAr) PFLQ)`MgekYf}Q^lfCI7~ diff --git a/library/virtualkeyboards/DANDELIONKEYBOARDS b/library/virtualkeyboards/DANDELIONKEYBOARDS new file mode 100644 index 00000000..e958d19c --- /dev/null +++ b/library/virtualkeyboards/DANDELIONKEYBOARDS @@ -0,0 +1,625 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 6-Jul-2023 08:52:09" {WMEDLEY}virtualkeyboards>DANDELIONKEYBOARDS.;3 33795 + + :EDIT-BY rmk + + :CHANGES-TO (VARS DANDELIONKEYBOARDSCOMS) + + :PREVIOUS-DATE " 4-Jul-2023 23:18:05" {WMEDLEY}virtualkeyboards>DANDELIONKEYBOARDS.;2 +) + + +(PRETTYCOMPRINT DANDELIONKEYBOARDSCOMS) + +(RPAQQ DANDELIONKEYBOARDSCOMS ((ALISTS (VKBD.LOADED-KEYBOARDS DANDELION)))) + +(ADDTOVAR VKBD.LOADED-KEYBOARDS + (DANDELION (EUROPEAN ((100 (53 197 NOLOCKSHIFT)) + (101 (52 196 NOLOCKSHIFT)) + (102 (54 198 NOLOCKSHIFT)) + (103 (61887 61759 LOCKSHIFT)) + (104 (55 199 NOLOCKSHIFT)) + (105 (61888 61760 LOCKSHIFT)) + (106 (61872 61744 LOCKSHIFT)) + (107 (61860 61732 LOCKSHIFT)) + (108 (48 126 NOLOCKSHIFT)) + (109 (61892 61764 LOCKSHIFT)) + (110 (203 207 NOLOCKSHIFT)) + (111 (61919 61791 LOCKSHIFT)) + (112 (47 191 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 195 NOLOCKSHIFT)) + (117 (50 194 NOLOCKSHIFT)) + (118 (61873 61745 LOCKSHIFT)) + (119 (61858 61730 LOCKSHIFT)) + (120 (61874 61746 LOCKSHIFT)) + (121 (61859 61731 LOCKSHIFT)) + (122 (57 202 NOLOCKSHIFT)) + (123 (61886 61758 LOCKSHIFT)) + (124 (61864 61736 LOCKSHIFT)) + (125 (61903 61775 LOCKSHIFT)) + (126 (61908 61780 LOCKSHIFT)) + (127 (241 225 LOCKSHIFT)) + (128 (187 170 LOCKSHIFT)) + (129 (249 233 LOCKSHIFT)) + (132 (49 193 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (61905 61777 LOCKSHIFT)) + (137 (61869 61741 LOCKSHIFT)) + (138 (61877 61749 LOCKSHIFT)) + (139 (61906 61778 LOCKSHIFT)) + (140 (251 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (250 234 LOCKSHIFT)) + (143 (59 58 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (171 186 LOCKSHIFT)) + (148 (61904 61776 LOCKSHIFT)) + (149 (61920 61792 LOCKSHIFT)) + (150 (61921 61793 LOCKSHIFT)) + (151 (61857 61729 LOCKSHIFT)) + (152 (61863 61735 LOCKSHIFT)) + (153 (56 200 NOLOCKSHIFT)) + (154 (61900 61772 LOCKSHIFT)) + (155 (239 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (246 230 LOCKSHIFT)) + (159 (207 176 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (logic ((100 (53 37 NOLOCKSHIFT)) + (101 (52 164 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (61258 61260 NOLOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (61292 61293 NOLOCKSHIFT)) + (106 (61271 61270 NOLOCKSHIFT)) + (107 (61284 61285 NOLOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (61307 61306 NOLOCKSHIFT)) + (110 (45 177 NOLOCKSHIFT)) + (111 (61269 61268 LOCKSHIFT)) + (112 (172 174 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (61240 61241 NOLOCKSHIFT)) + (119 (61234 61235 NOLOCKSHIFT)) + (120 (61266 61262 NOLOCKSHIFT)) + (121 (61365 61365 NOLOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (61275 61274 NOLOCKSHIFT)) + (124 (61300 61299 NOLOCKSHIFT)) + (125 (61273 61272 NOLOCKSHIFT)) + (126 (61282 61283 NOLOCKSHIFT)) + (127 (61256 61257 NOLOCKSHIFT)) + (128 (61356 61356 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (61250 61251 NOLOCKSHIFT)) + (137 (61298 61297 NOLOCKSHIFT)) + (138 (61305 61303 NOLOCKSHIFT)) + (139 (61265 61264 NOLOCKSHIFT)) + (140 (61364 61364 NOLOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (61281 233 NOLOCKSHIFT)) + (143 (61351 61351 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (61357 61357 NOLOCKSHIFT)) + (148 (61279 61278 NOLOCKSHIFT)) + (149 (61239 61238 NOLOCKSHIFT)) + (150 (61290 61290 NOLOCKSHIFT)) + (151 (61263 61261 NOLOCKSHIFT)) + (152 (61295 61295 NOLOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (61252 61253 NOLOCKSHIFT)) + (155 (61254 61255 NOLOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (MATH ((100 (53 37 NOLOCKSHIFT)) + (101 (52 36 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (61284 61285 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (174 61245 NOLOCKSHIFT)) + (107 (61369 61363 NOLOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (61254 61255 NOLOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (173 61246 LOCKSHIFT)) + (112 (47 61300 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (61282 61283 LOCKSHIFT)) + (119 (61287 61286 NOLOCKSHIFT)) + (120 (61301 61302 NOLOCKSHIFT)) + (121 (61351 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (175 61247 LOCKSHIFT)) + (124 (180 184 LOCKSHIFT)) + (125 (172 61244 LOCKSHIFT)) + (126 (61256 61257 LOCKSHIFT)) + (127 (44 61250 NOLOCKSHIFT)) + (128 (61298 61253 NOLOCKSHIFT)) + (129 (93 61265 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (61356 61362 LOCKSHIFT)) + (138 (61254 61291 NOLOCKSHIFT)) + (139 (98 61360 NOLOCKSHIFT)) + (140 (61309 177 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 61251 NOLOCKSHIFT)) + (143 (61299 61252 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 94 NOLOCKSHIFT)) + (148 (61358 82 LOCKSHIFT)) + (149 (61296 61266 NOLOCKSHIFT)) + (150 (61305 61303 NOLOCKSHIFT)) + (151 (61308 61267 LOCKSHIFT)) + (152 (61288 72 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (61357 61361 NOLOCKSHIFT)) + (155 (61292 61293 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 61264 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (OFFICE ((100 (61397 61381 NOLOCKSHIFT)) + (101 (61396 61380 NOLOCKSHIFT)) + (102 (61398 61382 NOLOCKSHIFT)) + (103 (8557 8554 NOLOCKSHIFT)) + (104 (61399 61383 NOLOCKSHIFT)) + (105 (61232 8743 NOLOCKSHIFT)) + (106 (61346 8571 NOLOCKSHIFT)) + (107 (188 86 NOLOCKSHIFT)) + (108 (61402 61386 NOLOCKSHIFT)) + (109 (210 8738 NOLOCKSHIFT)) + (110 (61437 61438 NOLOCKSHIFT)) + (111 (163 8558 NOLOCKSHIFT)) + (112 (61248 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (61395 61379 NOLOCKSHIFT)) + (117 (61394 61378 NOLOCKSHIFT)) + (118 (185 8553 NOLOCKSHIFT)) + (119 (176 8546 NOLOCKSHIFT)) + (120 (167 8744 NOLOCKSHIFT)) + (121 (97 8745 NOLOCKSHIFT)) + (122 (61401 61385 NOLOCKSHIFT)) + (123 (162 8570 NOLOCKSHIFT)) + (124 (61437 88 NOLOCKSHIFT)) + (125 (111 8569 NOLOCKSHIFT)) + (126 (61289 8737 NOLOCKSHIFT)) + (127 (44 60 NOLOCKSHIFT)) + (128 (39 34 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (61393 61377 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (61233 8742 NOLOCKSHIFT)) + (137 (61438 67 NOLOCKSHIFT)) + (138 (8739 74 NOLOCKSHIFT)) + (139 (190 61436 NOLOCKSHIFT)) + (140 (189 90 NOLOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (61249 62 NOLOCKSHIFT)) + (143 (61352 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 61280 NOLOCKSHIFT)) + (148 (212 8574 NOLOCKSHIFT)) + (149 (61354 8573 NOLOCKSHIFT)) + (150 (61286 8741 NOLOCKSHIFT)) + (151 (165 8572 NOLOCKSHIFT)) + (152 (61368 8740 NOLOCKSHIFT)) + (153 (61400 61384 NOLOCKSHIFT)) + (154 (173 175 NOLOCKSHIFT)) + (155 (172 174 NOLOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61406 61368 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (DVORAK ((100 (49 42 NOLOCKSHIFT)) + (101 (51 41 NOLOCKSHIFT)) + (102 (57 37 NOLOCKSHIFT)) + (103 (46 62 NOLOCKSHIFT)) + (104 (48 38 NOLOCKSHIFT)) + (105 (101 69 LOCKSHIFT)) + (106 (103 71 LOCKSHIFT)) + (107 (107 75 LOCKSHIFT)) + (108 (54 45 NOLOCKSHIFT)) + (109 (116 84 LOCKSHIFT)) + (110 (56 95 NOLOCKSHIFT)) + (111 (108 76 LOCKSHIFT)) + (112 (122 90 LOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (53 40 NOLOCKSHIFT)) + (117 (55 35 NOLOCKSHIFT)) + (118 (44 60 NOLOCKSHIFT)) + (119 (63 47 NOLOCKSHIFT)) + (120 (111 79 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (52 164 NOLOCKSHIFT)) + (123 (99 67 LOCKSHIFT)) + (124 (113 81 LOCKSHIFT)) + (125 (114 82 LOCKSHIFT)) + (126 (110 78 LOCKSHIFT)) + (127 (119 87 LOCKSHIFT)) + (128 (44 186 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (33 64 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (117 85 LOCKSHIFT)) + (137 (106 74 LOCKSHIFT)) + (138 (104 72 LOCKSHIFT)) + (139 (120 88 LOCKSHIFT)) + (140 (59 58 NOLOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (118 86 LOCKSHIFT)) + (143 (115 83 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (169 170 NOLOCKSHIFT)) + (148 (112 80 LOCKSHIFT)) + (149 (121 89 LOCKSHIFT)) + (150 (105 73 LOCKSHIFT)) + (151 (102 70 LOCKSHIFT)) + (152 (100 68 LOCKSHIFT)) + (153 (50 162 NOLOCKSHIFT)) + (154 (98 66 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (GREEK ((100 (53 37 NOLOCKSHIFT)) + (101 (52 36 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (9830 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (9829 9797 LOCKSHIFT)) + (106 (9849 9817 LOCKSHIFT)) + (107 (115 9814 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (9837 9805 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (9843 9811 LOCKSHIFT)) + (112 (47 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (9853 9821 LOCKSHIFT)) + (119 (9835 9803 LOCKSHIFT)) + (120 (9846 9814 LOCKSHIFT)) + (121 (9825 9793 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (9836 9804 LOCKSHIFT)) + (124 (9851 9819 LOCKSHIFT)) + (125 (9842 9810 LOCKSHIFT)) + (126 (9838 9806 LOCKSHIFT)) + (127 (44 60 NOLOCKSHIFT)) + (128 (39 34 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (9850 9818 LOCKSHIFT)) + (137 (9841 9809 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (9826 66 LOCKSHIFT)) + (140 (9833 9801 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 62 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 94 NOLOCKSHIFT)) + (148 (9845 9813 LOCKSHIFT)) + (149 (9848 9816 LOCKSHIFT)) + (150 (9828 9796 LOCKSHIFT)) + (151 (9852 9820 LOCKSHIFT)) + (152 (9834 9802 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (9840 9808 LOCKSHIFT)) + (155 (9839 9807 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (ITALIAN ((100 (53 61903 NOLOCKSHIFT)) + (101 (52 61886 NOLOCKSHIFT)) + (102 (54 61919 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (204 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 61872 NOLOCKSHIFT)) + (117 (50 61858 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 171 NOLOCKSHIFT)) + (128 (39 186 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 187 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 170 NOLOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (SPANISH ((100 (53 61904 NOLOCKSHIFT)) + (101 (52 61887 NOLOCKSHIFT)) + (102 (54 61920 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (204 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 61873 NOLOCKSHIFT)) + (117 (50 61858 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 171 NOLOCKSHIFT)) + (128 (59 58 NOLOCKSHIFT)) + (129 (203 187 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 187 NOLOCKSHIFT)) + (143 (61900 61772 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (161 191 NOLOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 61925 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (44 171 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (FRENCH ((100 (53 61905 NOLOCKSHIFT)) + (101 (52 61888 NOLOCKSHIFT)) + (102 (54 61921 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (204 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 61874 NOLOCKSHIFT)) + (117 (50 61859 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 171 NOLOCKSHIFT)) + (128 (39 61857 NOLOCKSHIFT)) + (129 (61872 61892 LOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 187 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (61869 61741 LOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 61919 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (61873 61877 LOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (GERMAN ((100 (53 37 NOLOCKSHIFT)) + (101 (52 36 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (251 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 60 NOLOCKSHIFT)) + (128 (39 34 NOLOCKSHIFT)) + (129 (61863 61735 LOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 62 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 94 NOLOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (61908 61780 LOCKSHIFT)) + (159 (61925 61797 LOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION) + (STANDARD-RUSSIAN ((100 (34 52 NOLOCKSHIFT)) + (101 (47 51 NOLOCKSHIFT)) + (102 (58 53 NOLOCKSHIFT)) + (103 (10085 10037 LOCKSHIFT)) + (104 (44 54 NOLOCKSHIFT)) + (105 (10067 10019 LOCKSHIFT)) + (106 (10068 10020 LOCKSHIFT)) + (107 (10078 10030 LOCKSHIFT)) + (108 (63 57 NOLOCKSHIFT)) + (109 (10077 10029 LOCKSHIFT)) + (110 (37 48 NOLOCKSHIFT)) + (111 (10073 10025 LOCKSHIFT)) + (112 (10071 10023 LOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (45 50 NOLOCKSHIFT)) + (117 (61352 49 NOLOCKSHIFT)) + (118 (10088 10040 LOCKSHIFT)) + (119 (10075 10027 LOCKSHIFT)) + (120 (10093 10045 LOCKSHIFT)) + (121 (10086 10038 LOCKSHIFT)) + (122 (95 56 NOLOCKSHIFT)) + (123 (10090 10042 LOCKSHIFT)) + (124 (10089 10041 LOCKSHIFT)) + (125 (10091 10043 LOCKSHIFT)) + (126 (10069 10021 LOCKSHIFT)) + (127 (10066 10018 LOCKSHIFT)) + (128 (10095 10047 LOCKSHIFT)) + (129 (10092 10044 LOCKSHIFT)) + (132 (167 43 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (10065 10017 LOCKSHIFT)) + (137 (10083 10035 LOCKSHIFT)) + (138 (10080 10032 LOCKSHIFT)) + (139 (10074 10026 LOCKSHIFT)) + (140 (10097 10049 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (10096 10048 LOCKSHIFT)) + (143 (10072 10024 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (41 40 NOLOCKSHIFT)) + (148 (10076 10028 LOCKSHIFT)) + (149 (10070 10022 LOCKSHIFT)) + (150 (10081 10033 LOCKSHIFT)) + (151 (10079 10031 LOCKSHIFT)) + (152 (10082 10034 LOCKSHIFT)) + (153 (46 55 NOLOCKSHIFT)) + (154 (10084 10036 LOCKSHIFT)) + (155 (10094 10046 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (10087 10039 LOCKSHIFT)) + (159 (33 61 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DANDELION))) +(DECLARE%: DONTCOPY + (FILEMAP (NIL))) +STOP diff --git a/library/virtualkeyboards/DORADOKEYBOARDS b/library/virtualkeyboards/DORADOKEYBOARDS new file mode 100644 index 00000000..565c4bec --- /dev/null +++ b/library/virtualkeyboards/DORADOKEYBOARDS @@ -0,0 +1,624 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 6-Jul-2023 08:52:15" {WMEDLEY}virtualkeyboards>DORADOKEYBOARDS.;4 33578 + + :EDIT-BY rmk + + :CHANGES-TO (VARS DORADOKEYBOARDSCOMS) + + :PREVIOUS-DATE " 4-Jul-2023 23:15:23" {WMEDLEY}virtualkeyboards>DORADOKEYBOARDS.;2) + + +(PRETTYCOMPRINT DORADOKEYBOARDSCOMS) + +(RPAQQ DORADOKEYBOARDSCOMS ((ALISTS (VKBD.LOADED-KEYBOARDS DORADO)))) + +(ADDTOVAR VKBD.LOADED-KEYBOARDS + (DORADO (EUROPEAN ((100 (53 197 NOLOCKSHIFT)) + (101 (52 196 NOLOCKSHIFT)) + (102 (54 198 NOLOCKSHIFT)) + (103 (61887 61759 LOCKSHIFT)) + (104 (55 199 NOLOCKSHIFT)) + (105 (61888 61760 LOCKSHIFT)) + (106 (61872 61744 LOCKSHIFT)) + (107 (61860 61732 LOCKSHIFT)) + (108 (48 126 NOLOCKSHIFT)) + (109 (61892 61764 LOCKSHIFT)) + (110 (203 207 NOLOCKSHIFT)) + (111 (61919 61791 LOCKSHIFT)) + (112 (47 191 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (51 195 NOLOCKSHIFT)) + (117 (50 194 NOLOCKSHIFT)) + (118 (61873 61745 LOCKSHIFT)) + (119 (61858 61730 LOCKSHIFT)) + (120 (61874 61746 LOCKSHIFT)) + (121 (61859 61731 LOCKSHIFT)) + (122 (57 202 NOLOCKSHIFT)) + (123 (61886 61758 LOCKSHIFT)) + (124 (61864 61736 LOCKSHIFT)) + (125 (61903 61775 LOCKSHIFT)) + (126 (61908 61780 LOCKSHIFT)) + (127 (241 225 LOCKSHIFT)) + (128 (187 170 LOCKSHIFT)) + (129 (249 233 LOCKSHIFT)) + (132 (49 193 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (61905 61777 LOCKSHIFT)) + (137 (61869 61741 LOCKSHIFT)) + (138 (61877 61749 LOCKSHIFT)) + (139 (61906 61778 LOCKSHIFT)) + (140 (251 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (250 234 LOCKSHIFT)) + (143 (59 58 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (171 186 LOCKSHIFT)) + (148 (61904 61776 LOCKSHIFT)) + (149 (61920 61792 LOCKSHIFT)) + (150 (61921 61793 LOCKSHIFT)) + (151 (61857 61729 LOCKSHIFT)) + (152 (61863 61735 LOCKSHIFT)) + (153 (56 200 NOLOCKSHIFT)) + (154 (61900 61772 LOCKSHIFT)) + (155 (239 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (246 230 LOCKSHIFT)) + (159 (207 176 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (logic ((100 (53 37 NOLOCKSHIFT)) + (101 (52 164 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (61258 61260 NOLOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (61292 61293 NOLOCKSHIFT)) + (106 (61271 61270 NOLOCKSHIFT)) + (107 (61284 61285 NOLOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (61307 61306 NOLOCKSHIFT)) + (110 (45 177 NOLOCKSHIFT)) + (111 (61269 61268 LOCKSHIFT)) + (112 (172 174 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (61240 61241 NOLOCKSHIFT)) + (119 (61234 61235 NOLOCKSHIFT)) + (120 (61266 61262 NOLOCKSHIFT)) + (121 (61365 61365 NOLOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (61275 61274 NOLOCKSHIFT)) + (124 (61300 61299 NOLOCKSHIFT)) + (125 (61273 61272 NOLOCKSHIFT)) + (126 (61282 61283 NOLOCKSHIFT)) + (127 (61256 61257 NOLOCKSHIFT)) + (128 (61356 61356 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (61250 61251 NOLOCKSHIFT)) + (137 (61298 61297 NOLOCKSHIFT)) + (138 (61305 61303 NOLOCKSHIFT)) + (139 (61265 61264 NOLOCKSHIFT)) + (140 (61364 61364 NOLOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (61281 233 NOLOCKSHIFT)) + (143 (61351 61351 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (61357 61357 NOLOCKSHIFT)) + (148 (61279 61278 NOLOCKSHIFT)) + (149 (61239 61238 NOLOCKSHIFT)) + (150 (61290 61290 NOLOCKSHIFT)) + (151 (61263 61261 NOLOCKSHIFT)) + (152 (61295 61295 NOLOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (61252 61253 NOLOCKSHIFT)) + (155 (61254 61255 NOLOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (MATH ((100 (53 37 NOLOCKSHIFT)) + (101 (52 36 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (61284 61285 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (174 61245 NOLOCKSHIFT)) + (107 (61369 61363 NOLOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (61254 61255 NOLOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (173 61246 LOCKSHIFT)) + (112 (47 61300 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (61282 61283 LOCKSHIFT)) + (119 (61287 61286 NOLOCKSHIFT)) + (120 (61301 61302 NOLOCKSHIFT)) + (121 (61351 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (175 61247 LOCKSHIFT)) + (124 (180 184 LOCKSHIFT)) + (125 (172 61244 LOCKSHIFT)) + (126 (61256 61257 LOCKSHIFT)) + (127 (44 61250 NOLOCKSHIFT)) + (128 (61298 61253 NOLOCKSHIFT)) + (129 (93 61265 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (61356 61362 LOCKSHIFT)) + (138 (61254 61291 NOLOCKSHIFT)) + (139 (98 61360 NOLOCKSHIFT)) + (140 (61309 177 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 61251 NOLOCKSHIFT)) + (143 (61299 61252 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 94 NOLOCKSHIFT)) + (148 (61358 82 LOCKSHIFT)) + (149 (61296 61266 NOLOCKSHIFT)) + (150 (61305 61303 NOLOCKSHIFT)) + (151 (61308 61267 LOCKSHIFT)) + (152 (61288 72 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (61357 61361 NOLOCKSHIFT)) + (155 (61292 61293 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 61264 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (OFFICE ((100 (61397 61381 NOLOCKSHIFT)) + (101 (61396 61380 NOLOCKSHIFT)) + (102 (61398 61382 NOLOCKSHIFT)) + (103 (8557 8554 NOLOCKSHIFT)) + (104 (61399 61383 NOLOCKSHIFT)) + (105 (61232 8743 NOLOCKSHIFT)) + (106 (61346 8571 NOLOCKSHIFT)) + (107 (188 86 NOLOCKSHIFT)) + (108 (61402 61386 NOLOCKSHIFT)) + (109 (210 8738 NOLOCKSHIFT)) + (110 (61437 61438 NOLOCKSHIFT)) + (111 (163 8558 NOLOCKSHIFT)) + (112 (61248 63 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (61395 61379 NOLOCKSHIFT)) + (117 (61394 61378 NOLOCKSHIFT)) + (118 (185 8553 NOLOCKSHIFT)) + (119 (176 8546 NOLOCKSHIFT)) + (120 (167 8744 NOLOCKSHIFT)) + (121 (97 8745 NOLOCKSHIFT)) + (122 (61401 61385 NOLOCKSHIFT)) + (123 (162 8570 NOLOCKSHIFT)) + (124 (61437 88 NOLOCKSHIFT)) + (125 (111 8569 NOLOCKSHIFT)) + (126 (61289 8737 NOLOCKSHIFT)) + (127 (44 60 NOLOCKSHIFT)) + (128 (39 34 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (61393 61377 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (61233 8742 NOLOCKSHIFT)) + (137 (61438 67 NOLOCKSHIFT)) + (138 (8739 74 NOLOCKSHIFT)) + (139 (190 61436 NOLOCKSHIFT)) + (140 (189 90 NOLOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (61249 62 NOLOCKSHIFT)) + (143 (61352 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 61280 NOLOCKSHIFT)) + (148 (212 8574 NOLOCKSHIFT)) + (149 (61354 8573 NOLOCKSHIFT)) + (150 (61286 8741 NOLOCKSHIFT)) + (151 (165 8572 NOLOCKSHIFT)) + (152 (61368 8740 NOLOCKSHIFT)) + (153 (61400 61384 NOLOCKSHIFT)) + (154 (173 175 NOLOCKSHIFT)) + (155 (172 174 NOLOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61406 61368 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (DVORAK ((100 (49 42 NOLOCKSHIFT)) + (101 (51 41 NOLOCKSHIFT)) + (102 (57 37 NOLOCKSHIFT)) + (103 (46 62 NOLOCKSHIFT)) + (104 (48 38 NOLOCKSHIFT)) + (105 (101 69 LOCKSHIFT)) + (106 (103 71 LOCKSHIFT)) + (107 (107 75 LOCKSHIFT)) + (108 (54 45 NOLOCKSHIFT)) + (109 (116 84 LOCKSHIFT)) + (110 (56 95 NOLOCKSHIFT)) + (111 (108 76 LOCKSHIFT)) + (112 (122 90 LOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (53 40 NOLOCKSHIFT)) + (117 (55 35 NOLOCKSHIFT)) + (118 (44 60 NOLOCKSHIFT)) + (119 (63 47 NOLOCKSHIFT)) + (120 (111 79 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (52 164 NOLOCKSHIFT)) + (123 (99 67 LOCKSHIFT)) + (124 (113 81 LOCKSHIFT)) + (125 (114 82 LOCKSHIFT)) + (126 (110 78 LOCKSHIFT)) + (127 (119 87 LOCKSHIFT)) + (128 (44 186 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (33 64 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (117 85 LOCKSHIFT)) + (137 (106 74 LOCKSHIFT)) + (138 (104 72 LOCKSHIFT)) + (139 (120 88 LOCKSHIFT)) + (140 (59 58 NOLOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (118 86 LOCKSHIFT)) + (143 (115 83 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (169 170 NOLOCKSHIFT)) + (148 (112 80 LOCKSHIFT)) + (149 (121 89 LOCKSHIFT)) + (150 (105 73 LOCKSHIFT)) + (151 (102 70 LOCKSHIFT)) + (152 (100 68 LOCKSHIFT)) + (153 (50 162 NOLOCKSHIFT)) + (154 (98 66 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (GREEK ((100 (53 37 NOLOCKSHIFT)) + (101 (52 36 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (9830 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (9829 9797 LOCKSHIFT)) + (106 (9849 9817 LOCKSHIFT)) + (107 (115 9814 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (9837 9805 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (9843 9811 LOCKSHIFT)) + (112 (47 63 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (9853 9821 LOCKSHIFT)) + (119 (9835 9803 LOCKSHIFT)) + (120 (9846 9814 LOCKSHIFT)) + (121 (9825 9793 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (9836 9804 LOCKSHIFT)) + (124 (9851 9819 LOCKSHIFT)) + (125 (9842 9810 LOCKSHIFT)) + (126 (9838 9806 LOCKSHIFT)) + (127 (44 60 NOLOCKSHIFT)) + (128 (39 34 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (9850 9818 LOCKSHIFT)) + (137 (9841 9809 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (9826 66 LOCKSHIFT)) + (140 (9833 9801 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 62 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 94 NOLOCKSHIFT)) + (148 (9845 9813 LOCKSHIFT)) + (149 (9848 9816 LOCKSHIFT)) + (150 (9828 9796 LOCKSHIFT)) + (151 (9852 9820 LOCKSHIFT)) + (152 (9834 9802 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (9840 9808 LOCKSHIFT)) + (155 (9839 9807 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (ITALIAN ((100 (53 61903 NOLOCKSHIFT)) + (101 (52 61886 NOLOCKSHIFT)) + (102 (54 61919 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (204 63 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (51 61872 NOLOCKSHIFT)) + (117 (50 61858 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 171 NOLOCKSHIFT)) + (128 (39 186 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 187 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 170 NOLOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (SPANISH ((100 (53 61904 NOLOCKSHIFT)) + (101 (52 61887 NOLOCKSHIFT)) + (102 (54 61920 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (204 63 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (51 61873 NOLOCKSHIFT)) + (117 (50 61858 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 171 NOLOCKSHIFT)) + (128 (59 58 NOLOCKSHIFT)) + (129 (203 187 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 187 NOLOCKSHIFT)) + (143 (61900 61772 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (161 191 NOLOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 61925 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (44 171 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (FRENCH ((100 (53 61905 NOLOCKSHIFT)) + (101 (52 61888 NOLOCKSHIFT)) + (102 (54 61921 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (204 63 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (51 61874 NOLOCKSHIFT)) + (117 (50 61859 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 171 NOLOCKSHIFT)) + (128 (39 61857 NOLOCKSHIFT)) + (129 (61872 61892 LOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 187 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (61869 61741 LOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 61919 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (61873 61877 LOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (GERMAN ((100 (53 37 NOLOCKSHIFT)) + (101 (52 36 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (251 63 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 60 NOLOCKSHIFT)) + (128 (39 34 NOLOCKSHIFT)) + (129 (61863 61735 LOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 62 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (95 94 NOLOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (61908 61780 LOCKSHIFT)) + (159 (61925 61797 LOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO) + (STANDARD-RUSSIAN ((100 (34 52 NOLOCKSHIFT)) + (101 (47 51 NOLOCKSHIFT)) + (102 (58 53 NOLOCKSHIFT)) + (103 (10085 10037 LOCKSHIFT)) + (104 (44 54 NOLOCKSHIFT)) + (105 (10067 10019 LOCKSHIFT)) + (106 (10068 10020 LOCKSHIFT)) + (107 (10078 10030 LOCKSHIFT)) + (108 (63 57 NOLOCKSHIFT)) + (109 (10077 10029 LOCKSHIFT)) + (110 (37 48 NOLOCKSHIFT)) + (111 (10073 10025 LOCKSHIFT)) + (112 (10071 10023 LOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (45 50 NOLOCKSHIFT)) + (117 (61352 49 NOLOCKSHIFT)) + (118 (10088 10040 LOCKSHIFT)) + (119 (10075 10027 LOCKSHIFT)) + (120 (10093 10045 LOCKSHIFT)) + (121 (10086 10038 LOCKSHIFT)) + (122 (95 56 NOLOCKSHIFT)) + (123 (10090 10042 LOCKSHIFT)) + (124 (10089 10041 LOCKSHIFT)) + (125 (10091 10043 LOCKSHIFT)) + (126 (10069 10021 LOCKSHIFT)) + (127 (10066 10018 LOCKSHIFT)) + (128 (10095 10047 LOCKSHIFT)) + (129 (10092 10044 LOCKSHIFT)) + (132 (167 43 NOLOCKSHIFT)) + (133 (92 124 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (10065 10017 LOCKSHIFT)) + (137 (10083 10035 LOCKSHIFT)) + (138 (10080 10032 LOCKSHIFT)) + (139 (10074 10026 LOCKSHIFT)) + (140 (10097 10049 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (10096 10048 LOCKSHIFT)) + (143 (10072 10024 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (145 (41 40 NOLOCKSHIFT)) + (148 (10076 10028 LOCKSHIFT)) + (149 (10070 10022 LOCKSHIFT)) + (150 (10081 10033 LOCKSHIFT)) + (151 (10079 10031 LOCKSHIFT)) + (152 (10082 10034 LOCKSHIFT)) + (153 (46 55 NOLOCKSHIFT)) + (154 (10084 10036 LOCKSHIFT)) + (155 (10094 10046 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (10087 10039 LOCKSHIFT)) + (159 (33 61 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DORADO))) +(DECLARE%: DONTCOPY + (FILEMAP (NIL))) +STOP diff --git a/library/virtualkeyboards/DOVEKEYBOARDS b/library/virtualkeyboards/DOVEKEYBOARDS new file mode 100644 index 00000000..e1799dc7 --- /dev/null +++ b/library/virtualkeyboards/DOVEKEYBOARDS @@ -0,0 +1,631 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 6-Jul-2023 08:52:04" {WMEDLEY}virtualkeyboards>DOVEKEYBOARDS.;3 33268 + + :EDIT-BY rmk + + :CHANGES-TO (VARS DOVEKEYBOARDSCOMS) + + :PREVIOUS-DATE " 4-Jul-2023 23:19:33" {WMEDLEY}virtualkeyboards>DOVEKEYBOARDS.;2) + + +(PRETTYCOMPRINT DOVEKEYBOARDSCOMS) + +(RPAQQ DOVEKEYBOARDSCOMS ((ALISTS (VKBD.LOADED-KEYBOARDS DOVE)))) + +(ADDTOVAR VKBD.LOADED-KEYBOARDS + (DOVE (EUROPEAN ((100 (53 197 NOLOCKSHIFT)) + (101 (52 196 NOLOCKSHIFT)) + (102 (54 198 NOLOCKSHIFT)) + (103 (61887 61759 LOCKSHIFT)) + (104 (55 199 NOLOCKSHIFT)) + (105 (61888 61760 LOCKSHIFT)) + (106 (61872 61744 LOCKSHIFT)) + (107 (61860 61732 LOCKSHIFT)) + (108 (48 126 NOLOCKSHIFT)) + (109 (61892 61764 LOCKSHIFT)) + (110 (203 207 NOLOCKSHIFT)) + (111 (61919 61791 LOCKSHIFT)) + (112 (47 191 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 195 NOLOCKSHIFT)) + (117 (50 194 NOLOCKSHIFT)) + (118 (61873 61745 LOCKSHIFT)) + (119 (61858 61730 LOCKSHIFT)) + (120 (61874 61746 LOCKSHIFT)) + (121 (61859 61731 LOCKSHIFT)) + (122 (57 202 NOLOCKSHIFT)) + (123 (61886 61758 LOCKSHIFT)) + (124 (61864 61736 LOCKSHIFT)) + (125 (61903 61775 LOCKSHIFT)) + (126 (61908 61780 LOCKSHIFT)) + (127 (241 225 LOCKSHIFT)) + (171 (187 170 LOCKSHIFT)) + (129 (249 233 LOCKSHIFT)) + (132 (49 193 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (61905 61777 LOCKSHIFT)) + (137 (61869 61741 LOCKSHIFT)) + (138 (61877 61749 LOCKSHIFT)) + (139 (61906 61778 LOCKSHIFT)) + (140 (251 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (250 234 LOCKSHIFT)) + (143 (59 58 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (171 186 LOCKSHIFT)) + (148 (61904 61776 LOCKSHIFT)) + (149 (61920 61792 LOCKSHIFT)) + (150 (61921 61793 LOCKSHIFT)) + (151 (61857 61729 LOCKSHIFT)) + (152 (61863 61735 LOCKSHIFT)) + (153 (56 200 NOLOCKSHIFT)) + (154 (61900 61772 LOCKSHIFT)) + (155 (239 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (246 230 LOCKSHIFT)) + (159 (207 176 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (logic ((100 (53 37 NOLOCKSHIFT)) + (101 (52 164 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (61258 61260 NOLOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (61292 61293 NOLOCKSHIFT)) + (106 (61271 61270 NOLOCKSHIFT)) + (107 (61284 61285 NOLOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (61307 61306 NOLOCKSHIFT)) + (110 (45 177 NOLOCKSHIFT)) + (111 (61269 61268 LOCKSHIFT)) + (112 (172 174 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (61240 61241 NOLOCKSHIFT)) + (119 (61234 61235 NOLOCKSHIFT)) + (120 (61266 61262 NOLOCKSHIFT)) + (121 (61365 61365 NOLOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (61275 61274 NOLOCKSHIFT)) + (124 (61300 61299 NOLOCKSHIFT)) + (125 (61273 61272 NOLOCKSHIFT)) + (126 (61282 61283 NOLOCKSHIFT)) + (127 (61256 61257 NOLOCKSHIFT)) + (171 (61356 61356 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (61250 61251 NOLOCKSHIFT)) + (137 (61298 61297 NOLOCKSHIFT)) + (138 (61305 61303 NOLOCKSHIFT)) + (139 (61265 61264 NOLOCKSHIFT)) + (140 (61364 61364 NOLOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (61281 233 NOLOCKSHIFT)) + (143 (61351 61351 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (61357 61357 NOLOCKSHIFT)) + (148 (61279 61278 NOLOCKSHIFT)) + (149 (61239 61238 NOLOCKSHIFT)) + (150 (61290 61290 NOLOCKSHIFT)) + (151 (61263 61261 NOLOCKSHIFT)) + (152 (61295 61295 NOLOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (61252 61253 NOLOCKSHIFT)) + (155 (61254 61255 NOLOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (MATH ((100 (53 37 NOLOCKSHIFT)) + (101 (52 36 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (61284 61285 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (174 61245 NOLOCKSHIFT)) + (107 (61369 61363 NOLOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (61254 61255 NOLOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (173 61246 LOCKSHIFT)) + (112 (47 61300 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (61282 61283 LOCKSHIFT)) + (119 (61287 61286 NOLOCKSHIFT)) + (120 (61301 61302 NOLOCKSHIFT)) + (121 (61351 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (175 61247 LOCKSHIFT)) + (124 (180 184 LOCKSHIFT)) + (125 (172 61244 LOCKSHIFT)) + (126 (61256 61257 LOCKSHIFT)) + (127 (44 61250 NOLOCKSHIFT)) + (171 (61298 61253 NOLOCKSHIFT)) + (129 (93 61265 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (61356 61362 LOCKSHIFT)) + (138 (61254 61291 NOLOCKSHIFT)) + (139 (98 61360 NOLOCKSHIFT)) + (140 (61309 177 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 61251 NOLOCKSHIFT)) + (143 (61299 61252 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (95 94 NOLOCKSHIFT)) + (148 (61358 82 LOCKSHIFT)) + (149 (61296 61266 NOLOCKSHIFT)) + (150 (61305 61303 NOLOCKSHIFT)) + (151 (61308 61267 LOCKSHIFT)) + (152 (61288 72 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (61357 61361 NOLOCKSHIFT)) + (155 (61292 61293 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 61264 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (OFFICE ((100 (61397 61381 NOLOCKSHIFT)) + (101 (61396 61380 NOLOCKSHIFT)) + (102 (61398 61382 NOLOCKSHIFT)) + (103 (8557 8554 NOLOCKSHIFT)) + (104 (61399 61383 NOLOCKSHIFT)) + (105 (61232 8743 NOLOCKSHIFT)) + (106 (61346 8571 NOLOCKSHIFT)) + (107 (188 86 NOLOCKSHIFT)) + (108 (61402 61386 NOLOCKSHIFT)) + (109 (210 8738 NOLOCKSHIFT)) + (110 (61437 61438 NOLOCKSHIFT)) + (111 (163 8558 NOLOCKSHIFT)) + (112 (61248 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (61395 61379 NOLOCKSHIFT)) + (117 (61394 61378 NOLOCKSHIFT)) + (118 (185 8553 NOLOCKSHIFT)) + (119 (176 8546 NOLOCKSHIFT)) + (120 (167 8744 NOLOCKSHIFT)) + (121 (97 8745 NOLOCKSHIFT)) + (122 (61401 61385 NOLOCKSHIFT)) + (123 (162 8570 NOLOCKSHIFT)) + (124 (61437 88 NOLOCKSHIFT)) + (125 (111 8569 NOLOCKSHIFT)) + (126 (61289 8737 NOLOCKSHIFT)) + (127 (44 60 NOLOCKSHIFT)) + (171 (39 34 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (61393 61377 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (61233 8742 NOLOCKSHIFT)) + (137 (61438 67 NOLOCKSHIFT)) + (138 (8739 74 NOLOCKSHIFT)) + (139 (190 61436 NOLOCKSHIFT)) + (140 (189 90 NOLOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (61249 62 NOLOCKSHIFT)) + (143 (61352 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (95 61280 NOLOCKSHIFT)) + (148 (212 8574 NOLOCKSHIFT)) + (149 (61354 8573 NOLOCKSHIFT)) + (150 (61286 8741 NOLOCKSHIFT)) + (151 (165 8572 NOLOCKSHIFT)) + (152 (61368 8740 NOLOCKSHIFT)) + (153 (61400 61384 NOLOCKSHIFT)) + (154 (173 175 NOLOCKSHIFT)) + (155 (172 174 NOLOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61406 61368 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (DVORAK ((100 (49 42 NOLOCKSHIFT)) + (101 (51 41 NOLOCKSHIFT)) + (102 (57 37 NOLOCKSHIFT)) + (103 (46 62 NOLOCKSHIFT)) + (104 (48 38 NOLOCKSHIFT)) + (105 (101 69 LOCKSHIFT)) + (106 (103 71 LOCKSHIFT)) + (107 (107 75 LOCKSHIFT)) + (108 (54 45 NOLOCKSHIFT)) + (109 (116 84 LOCKSHIFT)) + (110 (56 95 NOLOCKSHIFT)) + (111 (108 76 LOCKSHIFT)) + (112 (122 90 LOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (53 40 NOLOCKSHIFT)) + (117 (55 35 NOLOCKSHIFT)) + (118 (44 60 NOLOCKSHIFT)) + (119 (63 47 NOLOCKSHIFT)) + (120 (111 79 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (52 164 NOLOCKSHIFT)) + (123 (99 67 LOCKSHIFT)) + (124 (113 81 LOCKSHIFT)) + (125 (114 82 LOCKSHIFT)) + (126 (110 78 LOCKSHIFT)) + (127 (119 87 LOCKSHIFT)) + (171 (44 186 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (33 64 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (117 85 LOCKSHIFT)) + (137 (106 74 LOCKSHIFT)) + (138 (104 72 LOCKSHIFT)) + (139 (120 88 LOCKSHIFT)) + (140 (59 58 NOLOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (118 86 LOCKSHIFT)) + (143 (115 83 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (169 170 NOLOCKSHIFT)) + (148 (112 80 LOCKSHIFT)) + (149 (121 89 LOCKSHIFT)) + (150 (105 73 LOCKSHIFT)) + (151 (102 70 LOCKSHIFT)) + (152 (100 68 LOCKSHIFT)) + (153 (50 162 NOLOCKSHIFT)) + (154 (98 66 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (GREEK ((100 (53 37 NOLOCKSHIFT)) + (101 (52 36 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (9830 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (9829 9797 LOCKSHIFT)) + (106 (9849 9817 LOCKSHIFT)) + (107 (115 9814 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (9837 9805 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (9843 9811 LOCKSHIFT)) + (112 (47 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (9853 9821 LOCKSHIFT)) + (119 (9835 9803 LOCKSHIFT)) + (120 (9846 9814 LOCKSHIFT)) + (121 (9825 9793 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (9836 9804 LOCKSHIFT)) + (124 (9851 9819 LOCKSHIFT)) + (125 (9842 9810 LOCKSHIFT)) + (126 (9838 9806 LOCKSHIFT)) + (127 (44 60 NOLOCKSHIFT)) + (171 (39 34 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (9850 9818 LOCKSHIFT)) + (137 (9841 9809 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (9826 66 LOCKSHIFT)) + (140 (9833 9801 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 62 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (95 94 NOLOCKSHIFT)) + (148 (9845 9813 LOCKSHIFT)) + (149 (9848 9816 LOCKSHIFT)) + (150 (9828 9796 LOCKSHIFT)) + (151 (9852 9820 LOCKSHIFT)) + (152 (9834 9802 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (9840 9808 LOCKSHIFT)) + (155 (9839 9807 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (ITALIAN ((171 (39 34 NOLOCKSHIFT)) + (100 (53 61903 NOLOCKSHIFT)) + (101 (52 61886 NOLOCKSHIFT)) + (102 (54 61919 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (95 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 61872 NOLOCKSHIFT)) + (117 (50 61857 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 171 NOLOCKSHIFT)) + (171 (39 186 NOLOCKSHIFT)) + (129 (93 125 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 187 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (95 170 NOLOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (91 123 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (SPANISH ((208 (161 191 NOLOCKSHIFT)) + (171 (59 58 NOLOCKSHIFT)) + (100 (53 61904 NOLOCKSHIFT)) + (101 (52 61887 NOLOCKSHIFT)) + (102 (54 61920 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (95 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 61873 NOLOCKSHIFT)) + (117 (50 61858 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 171 NOLOCKSHIFT)) + (171 (59 58 NOLOCKSHIFT)) + (129 (185 186 NOLOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 187 NOLOCKSHIFT)) + (143 (61900 61772 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (161 191 NOLOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 61925 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (169 170 NOLOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (FRENCH ((208 (61869 61741 NOLOCKSHIFT)) + (171 (39 61857 NOLOCKSHIFT)) + (100 (53 61905 NOLOCKSHIFT)) + (101 (52 61888 NOLOCKSHIFT)) + (102 (54 61921 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (95 63 NOLOCKSHIFT)) + (115 (1 1 NOLOCKSHIFT) . IGNORE) + (116 (51 61874 NOLOCKSHIFT)) + (117 (50 61859 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 171 NOLOCKSHIFT)) + (171 (39 61857 NOLOCKSHIFT)) + (129 (61872 61892 LOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 187 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (61869 61741 LOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 61919 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (61873 61877 LOCKSHIFT)) + (159 (61 43 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (GERMAN ((100 (53 37 NOLOCKSHIFT)) + (101 (52 36 NOLOCKSHIFT)) + (102 (54 126 NOLOCKSHIFT)) + (103 (101 69 LOCKSHIFT)) + (104 (55 38 NOLOCKSHIFT)) + (105 (100 68 LOCKSHIFT)) + (106 (117 85 LOCKSHIFT)) + (107 (118 86 LOCKSHIFT)) + (108 (48 41 NOLOCKSHIFT)) + (109 (107 75 LOCKSHIFT)) + (110 (45 45 NOLOCKSHIFT)) + (111 (112 80 LOCKSHIFT)) + (112 (251 63 NOLOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (51 35 NOLOCKSHIFT)) + (117 (50 64 NOLOCKSHIFT)) + (118 (119 87 LOCKSHIFT)) + (119 (113 81 LOCKSHIFT)) + (120 (115 83 LOCKSHIFT)) + (121 (97 65 LOCKSHIFT)) + (122 (57 40 NOLOCKSHIFT)) + (123 (105 73 LOCKSHIFT)) + (124 (120 88 LOCKSHIFT)) + (125 (111 79 LOCKSHIFT)) + (126 (108 76 LOCKSHIFT)) + (127 (44 60 NOLOCKSHIFT)) + (171 (39 34 NOLOCKSHIFT)) + (129 (61863 61735 LOCKSHIFT)) + (132 (49 33 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (102 70 LOCKSHIFT)) + (137 (99 67 LOCKSHIFT)) + (138 (106 74 LOCKSHIFT)) + (139 (98 66 LOCKSHIFT)) + (140 (122 90 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (46 62 NOLOCKSHIFT)) + (143 (59 58 NOLOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (95 94 NOLOCKSHIFT)) + (148 (114 82 LOCKSHIFT)) + (149 (116 84 LOCKSHIFT)) + (150 (103 71 LOCKSHIFT)) + (151 (121 89 LOCKSHIFT)) + (152 (104 72 LOCKSHIFT)) + (153 (56 42 NOLOCKSHIFT)) + (154 (110 78 LOCKSHIFT)) + (155 (109 77 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (61908 61780 LOCKSHIFT)) + (159 (61925 61797 LOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE) + (STANDARD-RUSSIAN ((208 (41 40 NOLOCKSHIFT)) + (171 (10073 10025 NOLOCKSHIFT)) + (100 (34 52 NOLOCKSHIFT)) + (101 (47 51 NOLOCKSHIFT)) + (102 (58 53 NOLOCKSHIFT)) + (103 (10085 10037 LOCKSHIFT)) + (104 (44 54 NOLOCKSHIFT)) + (105 (10067 10019 LOCKSHIFT)) + (106 (10068 10020 LOCKSHIFT)) + (107 (10078 10030 LOCKSHIFT)) + (108 (63 57 NOLOCKSHIFT)) + (109 (10077 10029 LOCKSHIFT)) + (110 (37 48 NOLOCKSHIFT)) + (111 (10073 10025 LOCKSHIFT)) + (112 (10071 10023 LOCKSHIFT)) + (115 (8 8 NOLOCKSHIFT) . IGNORE) + (116 (45 50 NOLOCKSHIFT)) + (117 (61352 49 NOLOCKSHIFT)) + (118 (10088 10040 LOCKSHIFT)) + (119 (10075 10027 LOCKSHIFT)) + (120 (10093 10045 LOCKSHIFT)) + (121 (10086 10038 LOCKSHIFT)) + (122 (95 56 NOLOCKSHIFT)) + (123 (10090 10042 LOCKSHIFT)) + (124 (10089 10041 LOCKSHIFT)) + (125 (10091 10043 LOCKSHIFT)) + (126 (10069 10021 LOCKSHIFT)) + (127 (10066 10018 LOCKSHIFT)) + (171 (10095 10047 LOCKSHIFT)) + (129 (10092 10044 LOCKSHIFT)) + (132 (167 43 NOLOCKSHIFT)) + (165 (27 27 NOLOCKSHIFT) . IGNORE) + (134 (9 9 NOLOCKSHIFT) . IGNORE) + (135 (10065 10017 LOCKSHIFT)) + (137 (10083 10035 LOCKSHIFT)) + (138 (10080 10032 LOCKSHIFT)) + (139 (10074 10026 LOCKSHIFT)) + (140 (10097 10049 LOCKSHIFT)) + (141 1SHIFTDOWN . 1SHIFTUP) + (142 (10096 10048 LOCKSHIFT)) + (143 (10072 10024 LOCKSHIFT)) + (144 (13 13 NOLOCKSHIFT) . IGNORE) + (208 (41 40 NOLOCKSHIFT)) + (148 (10076 10028 LOCKSHIFT)) + (149 (10070 10022 LOCKSHIFT)) + (150 (10081 10033 LOCKSHIFT)) + (151 (10079 10031 LOCKSHIFT)) + (152 (10082 10034 LOCKSHIFT)) + (153 (46 55 NOLOCKSHIFT)) + (154 (10084 10036 LOCKSHIFT)) + (155 (10094 10046 LOCKSHIFT)) + (156 LOCKDOWN . LOCKUP) + (157 (32 32 NOLOCKSHIFT) . IGNORE) + (158 (10087 10039 LOCKSHIFT)) + (159 (33 61 NOLOCKSHIFT)) + (160 2SHIFTDOWN . 2SHIFTUP)) + DOVE))) +(DECLARE%: DONTCOPY + (FILEMAP (NIL))) +STOP diff --git a/library/KEYBOARDCONFIGS b/library/virtualkeyboards/KEYBOARDCONFIGS similarity index 68% rename from library/KEYBOARDCONFIGS rename to library/virtualkeyboards/KEYBOARDCONFIGS index f4dedee0..aae4e82f 100644 --- a/library/KEYBOARDCONFIGS +++ b/library/virtualkeyboards/KEYBOARDCONFIGS @@ -1,31 +1,35 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED " 7-Feb-97 12:13:28" {DSK}medley2.0>library>KEYBOARDCONFIGS.;8 61718 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - previous date%: "22-Jan-97 15:26:41" {DSK}medley2.0>library>KEYBOARDCONFIGS.;7) +(FILECREATED " 6-Jul-2023 13:18:46" {WMEDLEY}virtualkeyboards>KEYBOARDCONFIGS.;3 59739 + + :EDIT-BY rmk + + :CHANGES-TO (VARS KEYBOARDCONFIGSCOMS) + + :PREVIOUS-DATE " 7-Feb-97 12:13:28" {WMEDLEY}virtualkeyboards>KEYBOARDCONFIGS.;1) (* ; " -Copyright (c) 1996, 1997 by Xerox Corporation. All rights reserved. +Copyright (c) 1996-1997 by Xerox Corporation. ") (PRETTYCOMPRINT KEYBOARDCONFIGSCOMS) (RPAQQ KEYBOARDCONFIGSCOMS ( - (* ;; "Configuration variables/values for VIRTUALKEYBOARDS package. Loaded when VIRTUALKEYBOARDS is loaded.") + (* ;; "Configuration variables/values for VIRTUALKEYBOARDS package. Loaded when VIRTUALKEYBOARDS is loaded.") - [INITVARS (DEFAULTVIRTUALKEYBOARDTYPE 'MAIKO) + [INITVARS (DEFAULTVIRTUALKEYBOARDTYPE 'X) (DEFAULTKEYBOARDDISPLAYFONT '(CLASSIC 12)) (DEFAULTKEYBOARDLABELSFONT '(HELVETICA 5)) - (KEYBOARDCONFIGCOERCIONS '((SUN4 MAIKO) + (KEYBOARDCONFIGCOERCIONS '((SUN4 X) (SUN5 FULL-IBMPC) - (SUN3 MAIKO) - (X MAIKO) - (MAIKO DORADO) + (SUN3 X) + (X DORADO) (FULL-IBMPC IBMPC] (VARS VKBD.COMMONCHARLABELS VKBD.COMMONKEYLABELS VKBD.COMMONDEFAULTASSIGNMENT) (INITVARS (VKBD.DEFAULT-CONFIGURATION-NAME (KEYBOARDTYPE))) - (ALISTS (VKBD.CONFIGURATIONS MAIKO DORADO DANDELION DOVE FULL-IBMPC MAIKO-EUROPEAN)))) + (ALISTS (VKBD.CONFIGURATIONS X DORADO DANDELION DOVE FULL-IBMPC X-EUROPEAN)))) @@ -34,24 +38,23 @@ Copyright (c) 1996, 1997 by Xerox Corporation. All rights reserved. ) -(RPAQ? DEFAULTVIRTUALKEYBOARDTYPE 'MAIKO) +(RPAQ? DEFAULTVIRTUALKEYBOARDTYPE 'X) (RPAQ? DEFAULTKEYBOARDDISPLAYFONT '(CLASSIC 12)) (RPAQ? DEFAULTKEYBOARDLABELSFONT '(HELVETICA 5)) -(RPAQ? KEYBOARDCONFIGCOERCIONS '((SUN4 MAIKO) - (SUN5 FULL-IBMPC) - (SUN3 MAIKO) - (X MAIKO) - (MAIKO DORADO) - (FULL-IBMPC IBMPC))) +(RPAQ? KEYBOARDCONFIGCOERCIONS '((SUN4 X) + (SUN5 FULL-IBMPC) + (SUN3 X) + (X DORADO) + (FULL-IBMPC IBMPC))) (RPAQQ VKBD.COMMONCHARLABELS ((1 BS) - (2 BREAK) - BS TAB LF CR ESC SPACE (21 ".") - (23 DEL) - HELP SCRL NUMLK CLEAR HOME PGUP END PGDN INS DOIT)) + (2 BREAK) + BS TAB LF CR ESC SPACE (21 ".") + (23 DEL) + HELP SCRL NUMLK CLEAR HOME PGUP END PGDN INS DOIT)) (RPAQQ VKBD.COMMONKEYLABELS ((ESC ESC) @@ -126,361 +129,361 @@ Copyright (c) 1996, 1997 by Xerox Corporation. All rights reserved. (RPAQ? VKBD.DEFAULT-CONFIGURATION-NAME (KEYBOARDTYPE)) (ADDTOVAR VKBD.CONFIGURATIONS - (MAIKO NIL ((HELP (10 10 61 29)) - (FIND (10 42 29 29)) - (CUT (42 42 29 29)) - (OPEN (10 74 29 29)) - (PASTE (42 74 29 29)) - (FRONT (10 106 29 29)) - (COPY (42 106 29 29)) - (PROPS (10 138 29 29)) - (UNDO (42 138 29 29)) - (STOP (10 170 29 29)) - (AGAIN (42 170 29 29)) - (INS (618 10 61 29)) - (NUMERIC. (522 170 61 29)) - (ENTER (714 10 29 61)) - (NUMERIC1 (618 42 29 29)) - (NUMERIC2 (650 42 29 29)) - (NUMERIC3 (682 42 29 29)) - (NUMERIC4 (618 74 29 29)) - (NUMERIC5 (650 74 29 29)) - (NUMERIC6 (682 74 29 29)) - (NUMERIC+ (714 74 29 61)) - (NUMERIC7 (618 106 29 29)) - (NUMERIC8 (650 106 29 29)) - (NUMERIC9 (682 106 29 29)) - (NUMERIC= (618 138 29 29)) - (NUMERIC/ (650 138 29 29)) - (NUMERIC* (682 138 29 29)) - (NUMERIC- (714 138 29 29)) - (PAUSE (618 170 29 29)) - (PRTSCR (650 170 29 29)) - (SCRLLOCK (682 170 29 29)) - (NUMLOCK (714 170 29 29)) - (LOCK (106 10 29 29)) - (ALT (138 10 29 29)) - (LDIAMOND (170 10 29 29)) - (SPACE (202 10 285 29)) - (RDIAMOND (490 10 29 29)) - (NEXT (522 10 29 29)) - (ALTGRAPH (554 10 29 29)) - (LSHIFT (106 42 69 29)) - (Z (178 42 29 29)) - (X (210 42 29 29)) - (C (242 42 29 29)) - (V (274 42 29 29)) - (B (306 42 29 29)) - (N (338 42 29 29)) - (M (370 42 29 29)) - (< (402 42 29 29)) - (> (434 42 29 29)) - (? (466 42 29 29)) - (RSHIFT (498 42 53 29)) - (LINEFEED (554 42 29 29)) - (CONTROL (106 74 53 29)) - (A (162 74 29 29)) - (S (194 74 29 29)) - (D (226 74 29 29)) - (F (258 74 29 29)) - (G (290 74 29 29)) - (H (322 74 29 29)) - (J (354 74 29 29)) - (K (386 74 29 29)) - (L (418 74 29 29)) - (%: (450 74 29 29)) - (%" (482 74 29 29)) - (%` (514 74 29 29)) - (RETURN (546 74 37 32) - (538 106 45 29)) - (=> (106 106 45 29)) - (Q (154 106 29 29)) - (W (186 106 29 29)) - (E (218 106 29 29)) - (R (250 106 29 29)) - (T (282 106 29 29)) - (Y (314 106 29 29)) - (U (346 106 29 29)) - (I (378 106 29 29)) - (O (410 106 29 29)) - (P (442 106 29 29)) - ({ (474 106 29 29)) - (} (506 106 29 29)) - (ESC (106 138 29 29)) - (! (138 138 29 29)) - (@ (170 138 29 29)) - (%# (202 138 29 29)) - ($ (234 138 29 29)) - (%% (266 138 29 29)) - (|6| (298 138 29 29)) - (& (330 138 29 29)) - (* (362 138 29 29)) - (%( (394 138 29 29)) - (%) (426 138 29 29)) - (- (458 138 29 29)) - (+ (490 138 29 29)) - (<- (522 138 61 29)) - (F1 (106 170 29 29)) - (F2 (138 170 29 29)) - (F3 (170 170 29 29)) - (F4 (202 170 29 29)) - (F5 (234 170 29 29)) - (F6 (266 170 29 29)) - (F7 (298 170 29 29)) - (F8 (330 170 29 29)) - (F9 (362 170 29 29)) - (F10 (394 170 29 29)) - (F11 (426 170 29 29)) - (F12 (458 170 29 29)) - (\ (490 170 29 29)) - (NUMERIC. (554 170 29 29))) - NIL - ((%" (%' %" NLS)) - (+ (= + NLS)) - (- (- _ NLS)) - (%: (; %: NLS)) - (< (%, < NLS)) - (> (%. > NLS)) - (? (/ ? NLS)) - (LDIAMOND METADOWN . METAUP) - (ALT IGNORE . IGNORE) - (ALTGRAPH (2,24 2,64 NLS)) - (LINEFEED (LF LF)) - (LOCK LOCKTOGGLE) - (CONTROL CTRLDOWN . CTRLUP) - (ENTER (2,13 2,53 NLS)) - (INS (INS |0| NLS)) - (NEXT (2,22 2,62 NLS)) - (NUMERIC* (* *)) - (NUMERIC+ (+ +)) - (NUMERIC- (- -)) - (NUMERIC. (23 21 NLS)) - (NUMERIC/ (/ /)) - (NUMERIC0 (INS |0| NLS)) - (NUMERIC1 (END |1| NLS)) - (NUMERIC2 (¯ |2| NLS)) - (NUMERIC3 (PGDN |3| NLS)) - (NUMERIC4 (¬ |4| NLS)) - (NUMERIC5 (|5| |5|)) - (NUMERIC6 (® |6| NLS)) - (NUMERIC7 (HOME |7| NLS)) - (NUMERIC8 (­ |8| NLS)) - (NUMERIC9 (PGUP |9| NLS)) - (NUMERIC= (= =)) - (RETURN (CR CR)) - (%[ (%[ { NLS)) - (\ (\ %| NLS)) - (%` (%` ~ NLS)) - (%] (%] } NLS)) - (F1 (CENTER NOTCENTER NLS)) - (F2 (BOLD NOTBOLD NLS)) - (F3 (ITALIC NOTITALIC NLS)) - (F4 (UCASE LCASE NLS)) - (F5 (STRIKEOUT NOTSTRIKEOUT NLS)) - (F6 (UNDERLINE NOTUNDERLINE NLS)) - (F7 (SUBSCRIPT SUPERSCRIPT NLS)) - (F8 (SMALLER LARGER NLS)) - (F9 (MARGINS NOTMARGINS NLS)) - (F10 (LOOKS NOTLOOKS NLS)) - (F11 (F11 NOTF11 NLS)) - (F12 (F12 NOTF12 NLS))) - ((%` 45 B) - (~ 45 T) - (|6| 2 B) - (^ 2 T) - (%% 0 T) - (|5| 0 B) - ($ 1 T) - (|4| 1 B) - (E 3) - (e 3) - (& 4 T) - (|7| 4 B) - (D 5) - (d 5) - (U 6) - (u 6) - (V 7) - (v 7) - (%) 8 T) - (|0| 8 B) - (K 9) - (k 9) - (- 10 B) - (P 11) - (p 11) - (? 12 T) - (/ 12 B) - (CUT 46) - (NUMERIC. 13) - (FRONT 14) - (<- 15) - (BS 15) - (%# 16 T) - (|3| 16 B) - (@ 17 T) - (|2| 17 B) - (W 18) - (w 18) - (Q 19) - (q 19) - (S 20) - (s 20) - (A 21) - (a 21) - (%( 22 T) - (|9| 22 B) - (I 23) - (i 23) - (X 24) - (x 24) - (O 25) - (o 25) - (L 26) - (l 26) - (< 27 T) - (%, 27 B) - (%" 28 T) - (%' 28 B) - (} 29 T) - (%] 29 B) - (ALT 31) - (! 32 T) - (|1| 32 B) - (ESC 33) - (=> 34) - (TAB 34) - (F 35) - (f 35) - (CONTROL 36) - (C 37) - (c 37) - (J 38) - (j 38) - (B 39) - (b 39) - (Z 40) - (z 40) - (LSHIFT 41) - (> 42 T) - (%. 42 B) - (%: 43 T) - (; 43 B) - (RETURN 44) - (CR 44) - (NEXT 47) - (SKIP 47) - (R 48) - (r 48) - (T 49) - (t 49) - (G 50) - (g 50) - (Y 51) - (y 51) - (H 52) - (h 52) - (* 53 T) - (|8| 53 B) - (N 54) - (n 54) - (M 55) - (m 55) - (LOCK 56) - (SPACE 57) - ({ 58 T) - (%[ 58 B) - (+ 59 T) - (= 59 B) - (RSHIFT 60) - (STOP 61) - (PASTE 62) - (UNDO 63) - (NUMERIC= 64) - (NUMERIC/ 65) - (F7 66) - (F4 67) - (F5 68) - (NUMERIC2 69) - (NUMERIC3 70) - (LINEFEED 71) - (NUMLOCK 73) - (SCRLLOCK 74) - (PAUSE 75) - (ENTER 76) - (F9 80) - (NUMERIC7 81) - (NUMERIC8 82) - (NUMERIC9 83) - (NUMERIC4 84) - (NUMERIC5 85) - (LDIAMOND 86) - (NUMERIC6 87) - (RDIAMOND 88) - (COPY 89) - (FIND 90) - (AGAIN 91) - (HELP 92) - (ALTGRAPH 93) - (NUMERIC1 94) - (NUMERIC* 95) - (NUMERIC- 96) - (F1 97) - (INS 98) - (NUMERIC0 98) - (F2 99) - (F3 100) - (F6 101) - (NUMERIC+ 102) - (F8 104) - (\ 105 B) - (%| 105 T) - (F10 106) - (F11 107) - (F12 108) - (PROPS 109) - (PRTSCR 110) - (OPEN 111) - (ZERO |0|) - (ONE |1|) - (TWO |2|) - (THREE |3|) - (FOUR |4|) - (FIVE |5|) - (SIX |6|) - (SEVEN |7|) - (EIGHT |8|) - (NINE |9|)) - MAIKO - ((<- "BACK SPACE") - (=> "TAB") - (AGAIN "AGAIN") - (ALT ALT) - (ALTGRAPH NEXT) - (CONTROL "CTRL") - (COPY "COPY") - (CUT "CUT") - (ENTER "ENTER") - (FIND "FIND") - (FRONT SAME) - (HELP "HELP") - (LDIAMOND "META") - (NEXT EXPAND) - (NUMERIC. DELETE% WORD) - (OPEN "OPEN") - (PASTE MOVE) - (PAUSE "PAUSE") - (PROPS "PROPS") - (PRTSCR "PR SC") - (RDIAMOND "RDMND") - (RETURN "RTRN") - (SCRLLOCK ("SCRL" "LOCK")) - (STOP "STOP") - (UNDO "UNDO")) - (HELVETICA 6) - 23130 - (CLASSIC 10) - NIL) + (X NIL ((HELP (10 10 61 29)) + (FIND (10 42 29 29)) + (CUT (42 42 29 29)) + (OPEN (10 74 29 29)) + (PASTE (42 74 29 29)) + (FRONT (10 106 29 29)) + (COPY (42 106 29 29)) + (PROPS (10 138 29 29)) + (UNDO (42 138 29 29)) + (STOP (10 170 29 29)) + (AGAIN (42 170 29 29)) + (INS (618 10 61 29)) + (NUMERIC. (522 170 61 29)) + (ENTER (714 10 29 61)) + (NUMERIC1 (618 42 29 29)) + (NUMERIC2 (650 42 29 29)) + (NUMERIC3 (682 42 29 29)) + (NUMERIC4 (618 74 29 29)) + (NUMERIC5 (650 74 29 29)) + (NUMERIC6 (682 74 29 29)) + (NUMERIC+ (714 74 29 61)) + (NUMERIC7 (618 106 29 29)) + (NUMERIC8 (650 106 29 29)) + (NUMERIC9 (682 106 29 29)) + (NUMERIC= (618 138 29 29)) + (NUMERIC/ (650 138 29 29)) + (NUMERIC* (682 138 29 29)) + (NUMERIC- (714 138 29 29)) + (PAUSE (618 170 29 29)) + (PRTSCR (650 170 29 29)) + (SCRLLOCK (682 170 29 29)) + (NUMLOCK (714 170 29 29)) + (LOCK (106 10 29 29)) + (ALT (138 10 29 29)) + (LDIAMOND (170 10 29 29)) + (SPACE (202 10 285 29)) + (RDIAMOND (490 10 29 29)) + (NEXT (522 10 29 29)) + (ALTGRAPH (554 10 29 29)) + (LSHIFT (106 42 69 29)) + (Z (178 42 29 29)) + (X (210 42 29 29)) + (C (242 42 29 29)) + (V (274 42 29 29)) + (B (306 42 29 29)) + (N (338 42 29 29)) + (M (370 42 29 29)) + (< (402 42 29 29)) + (> (434 42 29 29)) + (? (466 42 29 29)) + (RSHIFT (498 42 53 29)) + (LINEFEED (554 42 29 29)) + (CONTROL (106 74 53 29)) + (A (162 74 29 29)) + (S (194 74 29 29)) + (D (226 74 29 29)) + (F (258 74 29 29)) + (G (290 74 29 29)) + (H (322 74 29 29)) + (J (354 74 29 29)) + (K (386 74 29 29)) + (L (418 74 29 29)) + (%: (450 74 29 29)) + (%" (482 74 29 29)) + (%` (514 74 29 29)) + (RETURN (546 74 37 32) + (538 106 45 29)) + (=> (106 106 45 29)) + (Q (154 106 29 29)) + (W (186 106 29 29)) + (E (218 106 29 29)) + (R (250 106 29 29)) + (T (282 106 29 29)) + (Y (314 106 29 29)) + (U (346 106 29 29)) + (I (378 106 29 29)) + (O (410 106 29 29)) + (P (442 106 29 29)) + ({ (474 106 29 29)) + (} (506 106 29 29)) + (ESC (106 138 29 29)) + (! (138 138 29 29)) + (@ (170 138 29 29)) + (%# (202 138 29 29)) + ($ (234 138 29 29)) + (%% (266 138 29 29)) + (|6| (298 138 29 29)) + (& (330 138 29 29)) + (* (362 138 29 29)) + (%( (394 138 29 29)) + (%) (426 138 29 29)) + (- (458 138 29 29)) + (+ (490 138 29 29)) + (<- (522 138 61 29)) + (F1 (106 170 29 29)) + (F2 (138 170 29 29)) + (F3 (170 170 29 29)) + (F4 (202 170 29 29)) + (F5 (234 170 29 29)) + (F6 (266 170 29 29)) + (F7 (298 170 29 29)) + (F8 (330 170 29 29)) + (F9 (362 170 29 29)) + (F10 (394 170 29 29)) + (F11 (426 170 29 29)) + (F12 (458 170 29 29)) + (\ (490 170 29 29)) + (NUMERIC. (554 170 29 29))) + NIL + ((%" (%' %" NLS)) + (+ (= + NLS)) + (- (- _ NLS)) + (%: (; %: NLS)) + (< (%, < NLS)) + (> (%. > NLS)) + (? (/ ? NLS)) + (LDIAMOND METADOWN . METAUP) + (ALT IGNORE . IGNORE) + (ALTGRAPH (2,24 2,64 NLS)) + (LINEFEED (LF LF)) + (LOCK LOCKTOGGLE) + (CONTROL CTRLDOWN . CTRLUP) + (ENTER (2,13 2,53 NLS)) + (INS (INS |0| NLS)) + (NEXT (2,22 2,62 NLS)) + (NUMERIC* (* *)) + (NUMERIC+ (+ +)) + (NUMERIC- (- -)) + (NUMERIC. (23 21 NLS)) + (NUMERIC/ (/ /)) + (NUMERIC0 (INS |0| NLS)) + (NUMERIC1 (END |1| NLS)) + (NUMERIC2 (¯ |2| NLS)) + (NUMERIC3 (PGDN |3| NLS)) + (NUMERIC4 (¬ |4| NLS)) + (NUMERIC5 (|5| |5|)) + (NUMERIC6 (® |6| NLS)) + (NUMERIC7 (HOME |7| NLS)) + (NUMERIC8 (­ |8| NLS)) + (NUMERIC9 (PGUP |9| NLS)) + (NUMERIC= (= =)) + (RETURN (CR CR)) + (%[ (%[ { NLS)) + (\ (\ %| NLS)) + (%` (%` ~ NLS)) + (%] (%] } NLS)) + (F1 (CENTER NOTCENTER NLS)) + (F2 (BOLD NOTBOLD NLS)) + (F3 (ITALIC NOTITALIC NLS)) + (F4 (UCASE LCASE NLS)) + (F5 (STRIKEOUT NOTSTRIKEOUT NLS)) + (F6 (UNDERLINE NOTUNDERLINE NLS)) + (F7 (SUBSCRIPT SUPERSCRIPT NLS)) + (F8 (SMALLER LARGER NLS)) + (F9 (MARGINS NOTMARGINS NLS)) + (F10 (LOOKS NOTLOOKS NLS)) + (F11 (F11 NOTF11 NLS)) + (F12 (F12 NOTF12 NLS))) + ((%` 45 B) + (~ 45 T) + (|6| 2 B) + (^ 2 T) + (%% 0 T) + (|5| 0 B) + ($ 1 T) + (|4| 1 B) + (E 3) + (e 3) + (& 4 T) + (|7| 4 B) + (D 5) + (d 5) + (U 6) + (u 6) + (V 7) + (v 7) + (%) 8 T) + (|0| 8 B) + (K 9) + (k 9) + (- 10 B) + (P 11) + (p 11) + (? 12 T) + (/ 12 B) + (CUT 46) + (NUMERIC. 13) + (FRONT 14) + (<- 15) + (BS 15) + (%# 16 T) + (|3| 16 B) + (@ 17 T) + (|2| 17 B) + (W 18) + (w 18) + (Q 19) + (q 19) + (S 20) + (s 20) + (A 21) + (a 21) + (%( 22 T) + (|9| 22 B) + (I 23) + (i 23) + (X 24) + (x 24) + (O 25) + (o 25) + (L 26) + (l 26) + (< 27 T) + (%, 27 B) + (%" 28 T) + (%' 28 B) + (} 29 T) + (%] 29 B) + (ALT 31) + (! 32 T) + (|1| 32 B) + (ESC 33) + (=> 34) + (TAB 34) + (F 35) + (f 35) + (CONTROL 36) + (C 37) + (c 37) + (J 38) + (j 38) + (B 39) + (b 39) + (Z 40) + (z 40) + (LSHIFT 41) + (> 42 T) + (%. 42 B) + (%: 43 T) + (; 43 B) + (RETURN 44) + (CR 44) + (NEXT 47) + (SKIP 47) + (R 48) + (r 48) + (T 49) + (t 49) + (G 50) + (g 50) + (Y 51) + (y 51) + (H 52) + (h 52) + (* 53 T) + (|8| 53 B) + (N 54) + (n 54) + (M 55) + (m 55) + (LOCK 56) + (SPACE 57) + ({ 58 T) + (%[ 58 B) + (+ 59 T) + (= 59 B) + (RSHIFT 60) + (STOP 61) + (PASTE 62) + (UNDO 63) + (NUMERIC= 64) + (NUMERIC/ 65) + (F7 66) + (F4 67) + (F5 68) + (NUMERIC2 69) + (NUMERIC3 70) + (LINEFEED 71) + (NUMLOCK 73) + (SCRLLOCK 74) + (PAUSE 75) + (ENTER 76) + (F9 80) + (NUMERIC7 81) + (NUMERIC8 82) + (NUMERIC9 83) + (NUMERIC4 84) + (NUMERIC5 85) + (LDIAMOND 86) + (NUMERIC6 87) + (RDIAMOND 88) + (COPY 89) + (FIND 90) + (AGAIN 91) + (HELP 92) + (ALTGRAPH 93) + (NUMERIC1 94) + (NUMERIC* 95) + (NUMERIC- 96) + (F1 97) + (INS 98) + (NUMERIC0 98) + (F2 99) + (F3 100) + (F6 101) + (NUMERIC+ 102) + (F8 104) + (\ 105 B) + (%| 105 T) + (F10 106) + (F11 107) + (F12 108) + (PROPS 109) + (PRTSCR 110) + (OPEN 111) + (ZERO |0|) + (ONE |1|) + (TWO |2|) + (THREE |3|) + (FOUR |4|) + (FIVE |5|) + (SIX |6|) + (SEVEN |7|) + (EIGHT |8|) + (NINE |9|)) + X + ((<- "BACK SPACE") + (=> "TAB") + (AGAIN "AGAIN") + (ALT ALT) + (ALTGRAPH NEXT) + (CONTROL "CTRL") + (COPY "COPY") + (CUT "CUT") + (ENTER "ENTER") + (FIND "FIND") + (FRONT SAME) + (HELP "HELP") + (LDIAMOND "META") + (NEXT EXPAND) + (NUMERIC. DELETE% WORD) + (OPEN "OPEN") + (PASTE MOVE) + (PAUSE "PAUSE") + (PROPS "PROPS") + (PRTSCR "PR SC") + (RDIAMOND "RDMND") + (RETURN "RTRN") + (SCRLLOCK ("SCRL" "LOCK")) + (STOP "STOP") + (UNDO "UNDO")) + (HELVETICA 6) + 23130 + (CLASSIC 10) + NIL) (DORADO NIL ((|5| (178 154 29 33)) (|4| (146 154 29 33)) (|6| (210 154 29 33)) @@ -1447,116 +1450,116 @@ Copyright (c) 1996, 1997 by Xerox Corporation. All rights reserved. 23130 (CLASSIC 10) NIL) - (MAIKO-EUROPEAN NIL ((HELP (10 10 61 29)) - (FIND (10 42 29 29)) - (CUT (42 42 29 29)) - (OPEN (10 74 29 29)) - (PASTE (42 74 29 29)) - (FRONT (10 106 29 29)) - (COPY (42 106 29 29)) - (PROPS (10 138 29 29)) - (UNDO (42 138 29 29)) - (STOP (10 170 29 29)) - (AGAIN (42 170 29 29)) - (NUMERIC0 (618 10 61 29)) - (NUMERIC. (682 10 29 29)) - (ENTER (714 10 29 61)) - (NUMERIC1 (618 42 29 29)) - (NUMERIC2 (650 42 29 29)) - (NUMERIC3 (682 42 29 29)) - (NUMERIC4 (618 74 29 29)) - (NUMERIC5 (650 74 29 29)) - (NUMERIC6 (682 74 29 29)) - (NUMERIC+ (714 74 29 61)) - (NUMERIC7 (618 106 29 29)) - (NUMERIC8 (650 106 29 29)) - (NUMERIC9 (682 106 29 29)) - (NUMERIC= (618 138 29 29)) - (NUMERIC/ (650 138 29 29)) - (NUMERIC* (682 138 29 29)) - (NUMERIC- (714 138 29 29)) - (PAUSE (618 170 29 29)) - (PRTSCR (650 170 29 29)) - (SCRLLOCK (682 170 29 29)) - (NUMLOCK (714 170 29 29)) - (CAPSLOCK (106 10 29 29)) - (ALT (138 10 29 29)) - (LDIAMOND (170 10 29 29)) - (SPACE (202 10 285 29)) - (RDIAMOND (490 10 29 29)) - (COMPOSE (522 10 29 29)) - (ALTGRAPH (554 10 29 29)) - (LSHIFT (106 42 37 29)) - (%[ (146 42 29 29)) - (Y (178 42 29 29)) - (X (210 42 29 29)) - (C (242 42 29 29)) - (V (274 42 29 29)) - (B (306 42 29 29)) - (N (338 42 29 29)) - (M (370 42 29 29)) - (; (402 42 29 29)) - (%: (434 42 29 29)) - (_ (466 42 29 29)) - (RSHIFT (498 42 53 29)) - (LINEFEED (554 42 29 29)) - (CONTROL (106 74 53 29)) - (A (162 74 29 29)) - (S (194 74 29 29)) - (D (226 74 29 29)) - (F (258 74 29 29)) - (G (290 74 29 29)) - (H (322 74 29 29)) - (J (354 74 29 29)) - (K (386 74 29 29)) - (L (418 74 29 29)) - (OUMLAUT (450 74 29 29)) - (AUMLAUT (482 74 29 29)) - (DEADTILDE (514 74 29 29)) - (CR (546 74 37 32) - (538 106 45 29)) - (TAB (106 106 45 29)) - (Q (154 106 29 29)) - (W (186 106 29 29)) - (E (218 106 29 29)) - (R (250 106 29 29)) - (T (282 106 29 29)) - (Z (314 106 29 29)) - (U (346 106 29 29)) - (I (378 106 29 29)) - (O (410 106 29 29)) - (P (442 106 29 29)) - (UUMLAUT (474 106 29 29)) - (DEADACUTE (506 106 29 29)) - (ESC (106 138 29 29)) - (|1| (138 138 29 29)) - (|2| (170 138 29 29)) - (|3| (202 138 29 29)) - (|4| (234 138 29 29)) - (|5| (266 138 29 29)) - (|6| (298 138 29 29)) - (|7| (330 138 29 29)) - (|8| (362 138 29 29)) - (|9| (394 138 29 29)) - (|0| (426 138 29 29)) - (? (458 138 29 29)) - (DEADGRAVE (490 138 29 29)) - (BACKSPACE (522 138 61 29)) - (F1 (106 170 29 29)) - (F2 (138 170 29 29)) - (F3 (170 170 29 29)) - (F4 (202 170 29 29)) - (F5 (234 170 29 29)) - (F6 (266 170 29 29)) - (F7 (298 170 29 29)) - (F8 (330 170 29 29)) - (F9 (362 170 29 29)) - (F10 (394 170 29 29)) - (F11 (426 170 29 29)) - (F12 (458 170 29 29)) - ({ (490 170 29 29)) - (} (522 170 29 29)) - (DELETE (554 170 29 29))) + (X-EUROPEAN NIL ((HELP (10 10 61 29)) + (FIND (10 42 29 29)) + (CUT (42 42 29 29)) + (OPEN (10 74 29 29)) + (PASTE (42 74 29 29)) + (FRONT (10 106 29 29)) + (COPY (42 106 29 29)) + (PROPS (10 138 29 29)) + (UNDO (42 138 29 29)) + (STOP (10 170 29 29)) + (AGAIN (42 170 29 29)) + (NUMERIC0 (618 10 61 29)) + (NUMERIC. (682 10 29 29)) + (ENTER (714 10 29 61)) + (NUMERIC1 (618 42 29 29)) + (NUMERIC2 (650 42 29 29)) + (NUMERIC3 (682 42 29 29)) + (NUMERIC4 (618 74 29 29)) + (NUMERIC5 (650 74 29 29)) + (NUMERIC6 (682 74 29 29)) + (NUMERIC+ (714 74 29 61)) + (NUMERIC7 (618 106 29 29)) + (NUMERIC8 (650 106 29 29)) + (NUMERIC9 (682 106 29 29)) + (NUMERIC= (618 138 29 29)) + (NUMERIC/ (650 138 29 29)) + (NUMERIC* (682 138 29 29)) + (NUMERIC- (714 138 29 29)) + (PAUSE (618 170 29 29)) + (PRTSCR (650 170 29 29)) + (SCRLLOCK (682 170 29 29)) + (NUMLOCK (714 170 29 29)) + (CAPSLOCK (106 10 29 29)) + (ALT (138 10 29 29)) + (LDIAMOND (170 10 29 29)) + (SPACE (202 10 285 29)) + (RDIAMOND (490 10 29 29)) + (COMPOSE (522 10 29 29)) + (ALTGRAPH (554 10 29 29)) + (LSHIFT (106 42 37 29)) + (%[ (146 42 29 29)) + (Y (178 42 29 29)) + (X (210 42 29 29)) + (C (242 42 29 29)) + (V (274 42 29 29)) + (B (306 42 29 29)) + (N (338 42 29 29)) + (M (370 42 29 29)) + (; (402 42 29 29)) + (%: (434 42 29 29)) + (_ (466 42 29 29)) + (RSHIFT (498 42 53 29)) + (LINEFEED (554 42 29 29)) + (CONTROL (106 74 53 29)) + (A (162 74 29 29)) + (S (194 74 29 29)) + (D (226 74 29 29)) + (F (258 74 29 29)) + (G (290 74 29 29)) + (H (322 74 29 29)) + (J (354 74 29 29)) + (K (386 74 29 29)) + (L (418 74 29 29)) + (OUMLAUT (450 74 29 29)) + (AUMLAUT (482 74 29 29)) + (DEADTILDE (514 74 29 29)) + (CR (546 74 37 32) + (538 106 45 29)) + (TAB (106 106 45 29)) + (Q (154 106 29 29)) + (W (186 106 29 29)) + (E (218 106 29 29)) + (R (250 106 29 29)) + (T (282 106 29 29)) + (Z (314 106 29 29)) + (U (346 106 29 29)) + (I (378 106 29 29)) + (O (410 106 29 29)) + (P (442 106 29 29)) + (UUMLAUT (474 106 29 29)) + (DEADACUTE (506 106 29 29)) + (ESC (106 138 29 29)) + (|1| (138 138 29 29)) + (|2| (170 138 29 29)) + (|3| (202 138 29 29)) + (|4| (234 138 29 29)) + (|5| (266 138 29 29)) + (|6| (298 138 29 29)) + (|7| (330 138 29 29)) + (|8| (362 138 29 29)) + (|9| (394 138 29 29)) + (|0| (426 138 29 29)) + (? (458 138 29 29)) + (DEADGRAVE (490 138 29 29)) + (BACKSPACE (522 138 61 29)) + (F1 (106 170 29 29)) + (F2 (138 170 29 29)) + (F3 (170 170 29 29)) + (F4 (202 170 29 29)) + (F5 (234 170 29 29)) + (F6 (266 170 29 29)) + (F7 (298 170 29 29)) + (F8 (330 170 29 29)) + (F9 (362 170 29 29)) + (F10 (394 170 29 29)) + (F11 (426 170 29 29)) + (F12 (458 170 29 29)) + ({ (490 170 29 29)) + (} (522 170 29 29)) + (DELETE (554 170 29 29))) NIL ((ZERO (|0| = NLS)) (ONE (|1| + NLS)) @@ -1770,7 +1773,7 @@ Copyright (c) 1996, 1997 by Xerox Corporation. All rights reserved. (SEVEN |7|) (EIGHT |8|) (NINE |9|)) - MAIKO + X ((AGAIN "AGAIN") (ALT "ALT") (ALTGRAPH "CMPSE") diff --git a/library/KEYBOARDEDITOR b/library/virtualkeyboards/KEYBOARDEDITOR similarity index 93% rename from library/KEYBOARDEDITOR rename to library/virtualkeyboards/KEYBOARDEDITOR index 5704ecce..1d71c5f5 100644 --- a/library/KEYBOARDEDITOR +++ b/library/virtualkeyboards/KEYBOARDEDITOR @@ -1,13 +1,16 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "25-May-95 14:32:35" {DSK}medley2.0>library>KEYBOARDEDITOR.;4 51139 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS EDITKEYBOARD VKBD.EDIT.CREATE-DISPLAY) +(FILECREATED " 6-Jul-2023 16:23:12" {WMEDLEY}KEYBOARDEDITOR.;3 50717 - previous date%: "25-May-95 11:35:16" {DSK}medley2.0>library>KEYBOARDEDITOR.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS VKBD.EDIT.CREATE-CHARACTERS-MENU) + + :PREVIOUS-DATE "25-May-95 14:32:35" {WMEDLEY}KEYBOARDEDITOR.;1) (* ; " -Copyright (c) 1985, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights reserved. +Copyright (c) 1985, 1987, 1990, 1995 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT KEYBOARDEDITORCOMS) @@ -15,14 +18,14 @@ Copyright (c) 1985, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r (RPAQQ KEYBOARDEDITORCOMS ((FILES VIRTUALKEYBOARDS) (COMS - (* ;; "Editor for Configurations -- the description of the physical key layout, which keys are assignable, etc.") + (* ;; "Editor for Configurations -- the description of the physical key layout, which keys are assignable, etc.") (FNS EDITCONFIGURATION VKBD.CONF.CHANGE-KEY-VALUE VKBD.CONF.DISPLAY-FIELD-VALUE VKBD.CONF.DISPLAY-INFO-KEYBOARD VKBD.CONF.DISPLAY-KEY-INFO VKBD.CONF.EDIT-DEFAULT-ASSIGNMENTS VKBD.CONF.ICONFN VKBD.CONF.PARSE-CONFIGURATION) (BITMAPS VKBD.CONF.ICON)) - (* ;; "EEditor for keyboard layouts per se:") + (* ;; "EEditor for keyboard layouts per se:") (FNS EDITKEYBOARD VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU VKBD.EDIT.CREATE-COMMAND-MENU VKBD.EDIT.CREATE-NON-CHAR-ASSIGMENTS-MENU VKBD.EDIT-KEYBOARD-COMMAND @@ -459,7 +462,8 @@ Copyright (c) 1985, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r ITEMWIDTH _ 29]) (VKBD.EDIT.CREATE-CHARACTERS-MENU - [LAMBDA (CHAR-SET-NUMBER FONT) (* sm "15-Aug-85 12:15") + [LAMBDA (CHAR-SET-NUMBER FONT) (* ; "Edited 6-Jul-2023 16:23 by rmk") + (* sm "15-Aug-85 12:15") (PROG (EXISTING-MENU-INFO NEW-MENU) [SETQ EXISTING-MENU-INFO (for CHARSET-FONT-MENU in VKBD.EDIT.CASH-MENUES thereis (AND (EQP (CAR CHARSET-FONT-MENU) @@ -468,21 +472,17 @@ Copyright (c) 1985, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r FONT] (if EXISTING-MENU-INFO then (RETURN (CADDR EXISTING-MENU-INFO))) - (PRINTOUT PROMPTWINDOW T "Wait. Bitmaps for character set " (OCTALSTRING CHAR-SET-NUMBER) - " are being retrieved. ") + (PRINTOUT PROMPTWINDOW T "Retrieving bitmaps for character set " (OCTALSTRING + CHAR-SET-NUMBER)) (SETQ NEW-MENU (create MENU ITEMS _ (for I from 0 to 255 bind CODE bind ROTATED-I - collect (PROGN (SETQ ROTATED-I (SUB1 ( - VKBD.EDIT.ROTATED-NUMBER - (ADD1 I) - 16 16))) - (LIST (GETCHARBITMAP (SETQ CODE - (VKBD.PARSE-CHAR-CODE - (LIST - CHAR-SET-NUMBER - ROTATED-I))) - FONT) - CODE))) + collect (SETQ ROTATED-I (SUB1 (VKBD.EDIT.ROTATED-NUMBER + (ADD1 I) + 16 16))) + (SETQ CODE (LOGOR (LLSH CHAR-SET-NUMBER 8) + I)) + (LIST (GETCHARBITMAP CODE FONT) + CODE)) MENUCOLUMNS _ 16 CENTERFLG _ T ITEMHEIGHT _ 25 @@ -717,16 +717,16 @@ Copyright (c) 1985, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r ("Accented Characters" 241))) (RPAQQ VKBD.EDIT.MENU-ITEMS (("CharSet" VKBD.EDIT.SWITCH-CHAR-SET-COMMAND "Pops up a menu of all possible character set number. Selecting one will switch the displayed character set." - ) - ("Stop" VKBD.EDIT.STOP-COMMAND + ) + ("Stop" VKBD.EDIT.STOP-COMMAND "Exit from the keyboard editor. Returns the new keyboard, but does not modify the original one." - ) - ("Quit" VKBD.EDIT.QUIT-COMMAND + ) + ("Quit" VKBD.EDIT.QUIT-COMMAND "Exit from the keyboard editor. Modifies the roriginal keyboard and returns it ." - ) - ("Define" VKBD.EDIT.DEFINE-COMMAND + ) + ("Define" VKBD.EDIT.DEFINE-COMMAND "Adds the edited keyboard in its current state to the set of known keyboards." - ))) + ))) (RPAQQ VKBD.EDIT.NON-CHAR-ASSIGNMENTS (SHIFT CTRL META LOCK LOCKDOWN LOCKUP EVENT)) @@ -744,27 +744,26 @@ Copyright (c) 1985, 1987, 1990, 1995 by Venue & Xerox Corporation. All rights r VKBD.EDIT.MASK) ) -(VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU (LIST "Edit" '(ADD.PROCESS '( - VKBD.EDIT-KEYBOARD-COMMAND - T)) - "Calls the keyboard editor. Will prompt for name for the new keyboard, and will use the default keyboard as the initial keyboard" - VKBD.EDIT.BACKGROUND-MENU-SUBITEMS) +(VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU (LIST "Edit" '(ADD.PROCESS '(VKBD.EDIT-KEYBOARD-COMMAND + T)) + "Calls the keyboard editor. Will prompt for name for the new keyboard, and will use the default keyboard as the initial keyboard" + VKBD.EDIT.BACKGROUND-MENU-SUBITEMS) "Keyboard") (PUTPROPS KEYBOARDEDITOR COPYRIGHT ("Venue & Xerox Corporation" 1985 1987 1990 1995)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3451 17311 (EDITCONFIGURATION 3461 . 3784) (VKBD.CONF.CHANGE-KEY-VALUE 3786 . 8411) ( -VKBD.CONF.DISPLAY-FIELD-VALUE 8413 . 10186) (VKBD.CONF.DISPLAY-INFO-KEYBOARD 10188 . 12135) ( -VKBD.CONF.DISPLAY-KEY-INFO 12137 . 12894) (VKBD.CONF.EDIT-DEFAULT-ASSIGNMENTS 12896 . 14277) ( -VKBD.CONF.ICONFN 14279 . 15020) (VKBD.CONF.PARSE-CONFIGURATION 15022 . 17309)) (19637 42746 ( -EDITKEYBOARD 19647 . 21947) (VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU 21949 . 22875) ( -VKBD.EDIT.CREATE-COMMAND-MENU 22877 . 23227) (VKBD.EDIT.CREATE-NON-CHAR-ASSIGMENTS-MENU 23229 . 23692) - (VKBD.EDIT-KEYBOARD-COMMAND 23694 . 25067) (VKBD.EDIT.ASSIGN-CHARACTER 25069 . 27743) ( -VKBD.EDIT.ASSIGN-NON-CHARACTER 27745 . 28363) (VKBD.EDIT.CREATE-CHARACTER-SETS-MENU 28365 . 29404) ( -VKBD.EDIT.CREATE-CHARACTERS-MENU 29406 . 31987) (VKBD.EDIT.CREATE-DISPLAY 31989 . 35222) ( -VKBD.EDIT.DEFINE-COMMAND 35224 . 35626) (VKBD.EDIT.DO-MENU-COMMAND 35628 . 35838) (VKBD.EDIT.ICONFN -35840 . 36489) (VKBD.EDIT.INVERT-IF-LOCKED 36491 . 36924) (VKBD.EDIT.KEYBOARD-REPAINTFN 36926 . 37496) - (VKBD.EDIT.LARGE-WINDOW-REPAINTFN 37498 . 38093) (VKBD.EDIT.MAKE-CURRENT-KEY 38095 . 40147) ( -VKBD.EDIT.QUIT-COMMAND 40149 . 40502) (VKBD.EDIT.STOP-COMMAND 40504 . 40730) ( -VKBD.EDIT.SWITCH-CHAR-SET-COMMAND 40732 . 41658) (VKBD.EDIT.SWITCH-CHARACTER-SET 41660 . 42443) ( -VKBD.EDIT.ROTATED-NUMBER 42445 . 42744))))) + (FILEMAP (NIL (3425 17285 (EDITCONFIGURATION 3435 . 3758) (VKBD.CONF.CHANGE-KEY-VALUE 3760 . 8385) ( +VKBD.CONF.DISPLAY-FIELD-VALUE 8387 . 10160) (VKBD.CONF.DISPLAY-INFO-KEYBOARD 10162 . 12109) ( +VKBD.CONF.DISPLAY-KEY-INFO 12111 . 12868) (VKBD.CONF.EDIT-DEFAULT-ASSIGNMENTS 12870 . 14251) ( +VKBD.CONF.ICONFN 14253 . 14994) (VKBD.CONF.PARSE-CONFIGURATION 14996 . 17283)) (19611 42442 ( +EDITKEYBOARD 19621 . 21921) (VKBD.EDIT.ADD-SUBITEM-TO-BACKGROUND-MENU 21923 . 22849) ( +VKBD.EDIT.CREATE-COMMAND-MENU 22851 . 23201) (VKBD.EDIT.CREATE-NON-CHAR-ASSIGMENTS-MENU 23203 . 23666) + (VKBD.EDIT-KEYBOARD-COMMAND 23668 . 25041) (VKBD.EDIT.ASSIGN-CHARACTER 25043 . 27717) ( +VKBD.EDIT.ASSIGN-NON-CHARACTER 27719 . 28337) (VKBD.EDIT.CREATE-CHARACTER-SETS-MENU 28339 . 29378) ( +VKBD.EDIT.CREATE-CHARACTERS-MENU 29380 . 31683) (VKBD.EDIT.CREATE-DISPLAY 31685 . 34918) ( +VKBD.EDIT.DEFINE-COMMAND 34920 . 35322) (VKBD.EDIT.DO-MENU-COMMAND 35324 . 35534) (VKBD.EDIT.ICONFN +35536 . 36185) (VKBD.EDIT.INVERT-IF-LOCKED 36187 . 36620) (VKBD.EDIT.KEYBOARD-REPAINTFN 36622 . 37192) + (VKBD.EDIT.LARGE-WINDOW-REPAINTFN 37194 . 37789) (VKBD.EDIT.MAKE-CURRENT-KEY 37791 . 39843) ( +VKBD.EDIT.QUIT-COMMAND 39845 . 40198) (VKBD.EDIT.STOP-COMMAND 40200 . 40426) ( +VKBD.EDIT.SWITCH-CHAR-SET-COMMAND 40428 . 41354) (VKBD.EDIT.SWITCH-CHARACTER-SET 41356 . 42139) ( +VKBD.EDIT.ROTATED-NUMBER 42141 . 42440))))) STOP diff --git a/library/virtualkeyboards/KEYBOARDEDITOR.LCOM b/library/virtualkeyboards/KEYBOARDEDITOR.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..8b7ec70fcd4664453c9b51ecefd7636eeb9b206c GIT binary patch literal 28327 zcmeHvZERy#dY(vmytd*QOEZdAR=wjB?#7iiLs|UN$9TKu6-kj-B6($!8cE|>D;$v? zam1lieXMuTEz$&Su|X3Q2%3#I*<^tt{jZTnKz6Yk{^*|s$dCMRfbj+hkfdnQA1$UZ ziUI}N$@9MFoO{pZhsNG)f&iI;P2GF$`Fzj&`JDIO$#iDPE@r|@c0Lofi%X8Ux@x6X ztZYVv>|!NT%G>4DkhogPSm}zjnC~cFw8|L~nVA|Inxr05s8-3OMM%tsmyes_=u9*w zBD2?{vFnj&NKA&d_wMaCn)RC4YoXG=STAJK`ON0O{7SQN`=EMo|EnvR%|*v5r88-} z;*_S}j7^E5kcfMo&CFbn&R&nthQ#fIy4zd*8~X=`KYv}^SXoR@Q`>1dlW;0$m8=w& zQ4SX}#Wm5uuuE(CyfFKmo}Lbgp<49_^Xf5JA`+VVRLlDm%Mpp0xyYQjPIC+|Zi<6@ zyW%<~SG`2aTg(VqT(koVTbs;1VZDJ<7mIfO;^fpt-V&}Smq|6kH>~_xMh>(pBJ;v3m#Mrga5pE4nRU9D z6?tnhljp*OaPsLe-_xVGDAJ#pC|Ikjb}>sgQQa;gQfsABrdXlU8CAMKW7yduxS&Ek z&g)8H2!OSgr^-BXxRl9)3RGv-t>cv?RDW@S`Jzrttd^X@YK3MT73+2}?eOH8cqp5} z6z$@=u<^8j{mM`?TSNr2BT?C|WC~Lv_{A#&1A`;0&sj|3o3%Sc=^^?FytCZki;WsT z+st{-ZY6^OS@rR0v^_F>A-^-Rva?6cUgEZ2%iBLg7j4<7Aa4q{t~>~QTQ{6+kBHCZ z?O-r4_HMAF{nn*+(Yf>rs^8Jo*V`jAL#U1VTbJ8;=knOruydJbh0zwb;;peHo=A3UR=GckVU!N9NUu{SXGhp#H(Y8WrqQRgO`cB>n(FDcBFFRuV%1M~F>+$LJk>ShK zd0^{H==e*oet;kD^;=Ym8%$<}iIT^z+RN6(3$$}P!@QmRV24C6u6b^?1Pv_`u}BYL zT(UC|7%687NLVVLu}bSuKM|2GWeU!XjEKkPMWwO{?GF_o;*o?<4`NaCL2Sl-5S^Qm zLy-*IX(%j~X3`L45slA^)wPNg0SE=;A+Be}WZA7wb!qZxYt2 zi<9xWxKbl*31b*ss-$RQRwydOlxhTt*pfkyMTOQe5hk+KFAHj3Qa4JCMWhjldD1O* z8XIJ6tkP**1HCA%!&Ar1zy)@}#-o;`flxZE+4@9f} zzFN@rkch!_8|AdT$wOG4&_xlQnKd8P>hD#Ln@4zxW|7!}`Rt&6r?Jtv#e$quB5?7!fq@Gn zB9MNb#OjZq8yOi~9z1JZQTIdo!NkXD7B>EQ)V%O$qh_c0=8vC;^x7Zm1|-X@Wp`36 z$1LY5F3H&`)@+tmEw8nc4+efU@J=llupWPq=K8_FW_vk!^TCsEN)7Qra*@kVeo;63 zUOOpAmi14v9Tn${ii?;I{R@l*11DEy#otaYQpu|iFExJE(;{-Vq)Vc+#7TBBBBF@} z#ZywNL}%jtMLjYgA2^Q_FG_WE9 zdri8j;=po4Y|5+fD)R!00hg7`MrEy(5%X~&y*t%tc1GN?i)B1gBgW^%qFsS&ux_U- zIS~g>;imSNK6!ZK~9=wISOY&%5nrwl$7PjoFTc1IFyr=+z5OWDWQN>$?u z3q;>0$1trl9y=#IEs`LsQVF}B%8VyF+T(La7YVTlziY`UR^S2t#f88?03M2T0^d1% zIms-=tl5@^Ylqoxry(uZ#xIhfy;kFDqtCT#cSpzRXQEwO8y#*-(HI@m7eZgW+P+(B z{nC>fjOfI~4{Q0+q4v$YwVWq{&7oyOLZt}S8vJ*&CLJA~2$x7dW7)o2n_!W&o53}{ zFe>sr3j|DMhYpbhMFDomRI8+Tgw>aC-Yp0RG$s@|)k5lg==%U5sLn<1$isLbN#)!WVbTL>0C z4Kg)#kz$un<50Brj>OSUT~K#o?>$i!yRE(VTVl6<|Mp(>peDBWTJJUP93NDVU>m1< z3btOT4w7PGiG|oFyAh6xP?b$05z33=x&jWxl&(D-*o8eD9GMAPEGsO=o8PgmW{{uq#7Ux{jW&4z#<+4=p8kU zJ@h=-QBKtL-{3w;smi3~ld?!CAFGRZ1-OWZSSrC?VP7dW*D27-uw_cXF2Y=qBFV0S z!D92XN~dc-mcm`r5i=KLloNN(E{I9&44fQoHnbBcjf*rkKK}8D!|;HrANEXZS#tyI z;aZ`v>1lp)iDXeH7j!6f=<#e2F(v#UsmE^*$f$Co22UXu42 zyeVsPiH({Zjm!(0ELN($U6`=d&2zL1;{pQ8E~E)!xq-P)6qK@2a72Wa4;(vfu&|Ov zn3te+_7>Y2{%KxlzT8}Gu1K4JImFeW^die1TLA)p?Dq;5Uk@RE46gEM3e< zix6JQTUjQsZwPqKe{qR8W+v!z%-PijleC?b$V8jTEU$NlgMpjik-+BihhwUm@3At- z+`<3*QixSf61hdJQ`s+!}xI|Nrm6WE^%}h5~V@S9L`pJ%?I5%Zf3$2C8BV;kYV(CmmVP z&-!~$O21*&@Gl$yBSohoauxs=Pmu#}j*|u?8AZ$-pTRZil#ME4ajhb3*%~oCq#H{%cr=YNf*8~&KHY+6 zQx|>q!wq3l@EP-&3L9~0T1azYRK6kTiS;F^F>QG>Hzeq*)HFTUagGKCT>mIcR+wRe zva?o78N(im<2a~n`_+a37Yq8|x(?u1)-#q(@ zb@syI*)LeN->rQ|8JmX}tjZWGmYZiUvlY^}$?M7 zYgSL(aFa`=UX@{ztj$Ia_KhH@F8@Y`BzdO{v^|1g#9Fstp(G6{H1~%=5p1C}h`I`# z-Hs{%3Oh^4`yg*X**w}3eKey3mN|`s^$A$Ojoe3qpdIuDj=x1A0@>2(H40230KAIn z8+NI(X5}@9z^XZ6ahq`7*>mh@#MXBN_N&RT6uT71yqOR0`2Ai zb5Pz3S?>q{(-2pneznc!#Ue}$1F0m8gLrlkXKUG#vsO&Y^C)e;$&qJEOuz|4U3^BM zZlteBjH$XpFc1}s)$QFo2Ybh@TA|)LPVL>hS8de}@hH~u2+X<}3=Rb0^I0Y4iH+Jr zyG9P*X}ryU0|Dm9$EROvCj;aGN@r>FY?yD7I}&aG_sQTZ|1KEhx+t4?y}h&jJULJa zajOW)PDRNBFGJBeDYzi=0u(}ItY%&&U7)Y=MB#rXV?go?mPsIJR54J8*E+yH-fK1f z13-c2(R_*jun3I6Q?1#+7B1Hsqc62oYIdsC?B6!~OR zh6ZR|QOBFaPE4(@_obHfd_6)jEm@1~e%yTS&vzfGN6%{-GIgJZ(wO9f%}~}AEB6s{ z!Nt=ILIOYW2nm4Qm7{5CFTFEdoKYB0{X|d)d!Vs$yPsP1TuQs5@9v_KR5;I&Puo-u zWP)4`L*6vbFFo@DEfog92h@U_y~PeT)zD4eVu>~JCCF=YFaUXl$Nk|oL(SJtm0fuJ zUFmU4v#}`uyva3pYULf?vWpCJ^P`Q2!up=q&&`J;x#fRjm1zf~Xx!$aAOOV9{RgU(=?YcNV#36q55C{E@qeivqVJ`3O9WW?Uui-)K zPDsF>=;IB-Y3Mnff4Ke8K?nIQscMT69csuusN)W|CY(9I*1hMnQ#}&*_m0K;)fO7> z3F^deANW+-;Bm!g36rJxu-U)?U@0Ip-jR_^+#vs`oU@lG0YmX5n-mxLQ76!}mF)SD z5HdTm!C6AA*ujN=_BnEK_Mewnj|?9a2eKLYn!!WwkQ?-CwZQjRf`K2{Iez{_RxYQX zPx4|Y^MSi}{g3s!JFPfj2y-EJC`Xm=qp zAdDjx|0yLw%|$2gq*j<4z??{zFzz9`o{rV?G`OowF1%O6%I6*EGoQ&(+7{x$^$b=d zZ;Z>d9wCuM8juK8cIpRp!SJZqK0Y`A04okzjv=v-x@nQxsUB3f=^*lbNHC$O605D( zT#U3oiCJ#)ViIeIa`i$j=wnR9D42qJ{pSM!j*>NfdiGmVo1WZKr*-;1&wTm#+sr&C zU+t`}4))dK*Yx9W%iexXHh%ayZv6@z3yusac#{4m&_&v$HGniYN5&OWM~Z}P(zSpG zUdU7|gkU07DdhpE@oo}1BS7LOWgpYBuPO3SCuMI_#BF>{{Y?pgTkf5hRzpq^tTjmk z@SxK?*4pY6fqScR$`5<|#PCP<)hXbM~@xX=mcyALVyHy7l16FFBW9 z|HG62jdNOn1x~7B<;xY=(5#5+oDY@n{>dyEK$-Fq~{~BtMUT!uMDi= zh0!Uk=Y~<7ASm}9uXt>AVL4c*2WW#wruYD)-K-R=CLWZCAEyCbEG&T!4S^a-r+Z?~Pxm+9QJ z7u!B14*F580RDZ~6CdW^qANVaznh*bnY3&&+dPel&kx|AJR{(OPkx90@G5p*v4?jb z8H_*CPX47c{9m@lEnb*|RIQ1vv9>dMHcH7{Tceyyw)+vGqF;8#Uf&vRpZqUK00EAw$5QUcqgI#wylWN&)gHRp%*BLICv-W(*7hUT-ba;!gY_ps#}+x(NBKEx%|t{=q-NeNPm?3 z;DYZuQuTAmzq?Z|>r}1JoPPg4Dd>vg_5(JN#Uc}L; zG228h+W}z`9Z(XCCif3f?DYX8rpQwOP5t>&hd|hf z;w};WbnAfI72)`-5Dt3Rn-&A(h%g6%7L5c3Okis__wpseLE%^#$*U1F0h|MPGtN+A zpoZ*~qLLlp6qU4RdXb{?3Q|-oX>HvU6>l5Q$y346w2`NRkj;bF1tl1&Je5TEt`LYS z)uFT)*aGCNORQYywdn2XpR>Y>rYmPfxAW3fWWC~zOsNvKm%;>00F+d2UMC>Ko1`qD zI(!9le;K*Z5v~!<) z?+OCl=H$rWg*>pC*LQ}I2Q2dwmCGpu>9)Q5(f60{{kM;PaPlXGR^azlmAs@hYsPlI zIsDNN3(YTl^rMrrfk^F(W|2Gh{Y8%&Dw_7gNj{P?)lY|9v;+|1SHcR*mEn zDGz;7e1l;O;F8J1`^W%447^8n5KW=`*stCK^#^#Hh+i=CG|i^vUB9CQ?Q|YE#KYD~ zK+4@srkWJDA1(uG59WW9@BTIaj<=-*o_s|$e;8jmi<;@8ZTt6RmA0y(6H5s=V9$PM zIN&CoV(ioZtm^A2v`-$8T2`XjTeU>=n@Qd59?_7yFX0pMdxv)%GrXkfE^&%Pl}+n0 zfXK-RCpOq#At(9noD*D>yx zAEEDoa3HY>8R#k>1;J6b4#TE(7xr^nj1yz{iT>0OMJ}xjkx$7K=*kr7P=7w3oWUbQ?|^CVHP5E!X%g)my(i$R96>#dMR?!So6sd=$7Be_1mQ-h!i(jYTu>@KD&b%v8xnb-m&!5skElVYM4XVknuCAFS!tzJL+G6 z?{6lTxt`U$+Pt9EEwm|4kn{^I2ueMI>(E;xC<@~Mz;Ae(&<)%I+z632Upkn@+fFV! z3S^!6bu7X^<)UH_eP%R{$bz!{m|ne4JbS0;g9+FrrgKMb?7eSAxr^SBqQoHO>*&l| z`UpVrxROpf3&;~>%SN?J?qDGi36lZ;9Nw-1t;w~ z0+V<}AK43#EAkvF?s+~9?vzkm2B2D6wcdWa$0NMiLf=y;i;k=|BpyyuQ!)8v@#dTO zHiC*LDSIJhzEyHa37iyB)#``a2aSDt(}W@`D%#(G7~QKl&1=*nl^*Mp_z;LrpON5sajb(Un%V}r zK`Qw+kEGzC*vG;3VI8ludW3TA1^38o_mqUdZjf9lW(k9N{U}N8i-EZ{X**=jtm;V- zM$V=){lsmiv#<03GLgZ1+^H#yquw5C=+Gx!-KhOHG*Jf}V)WUWU*~mZZZj{h%Z>Bu zx>Ruk8j~)jwKGCGuX&eq?>+LlI>x+x&VX0luyH;^+_Q#fd5n(znhfkmxn?);vWS@U zI_ZyY3B24nX>@nanN=i#s&1binx>$(cw(mabBVSkB2m&JZhQC3AsSLuhq;&#Rig!X zbvrU=by6+XXiVKaD+5?FWwh60s3U8yW3n15`O@e~v%L|2k?!?r2+3m56UHzFNCQdU--(w)hOu+iMO!nlp(u(|}Y{8N4y2%RE|i z>rJpF7;`9;sy3U4Y)M@kP-j?oTC6wl;=}#{zH)RVGYWNTA=zCsz3`eqvNm8~R7c99 zvef(;1vjsd(io{(XDVZ8$RI{PZkh7n(hyBse!!@lcdT@`Poez~-ZpOszWC)y;QtG; zDW~_pT<>D1Z+S7<>t8DOteoibj1H1Jp3&hM9V7*w(c$li4%uFs8*=xV%aizEg`Lc$ z`3J8|<bdiL-h+u$Km=#RX?3F%AFi$a^8HBi&nCjUbL)yx@aYBXHnJ9`pR?J z#jKo9HiZ@E7cKl2>Bn)Fk?tf8UVmhUu9E(Xtl*V9g+(qH{;N{S%h=8}~Doo9yadWB%^7dC|YT*QhA#>sR!v zKco!q2)u3P}Gh zJpcW@eQ~^x@5A70G{+j9)9*%f=0J!FVgdJs38Y`j=)rjBsdunIRLOh;FJe=ErY6l# zN()5?4s)8w)u4BqRNdvm*c_E*59;+@w3?@z)cpg5p^a_a zFVMZ7ehd>UG!D1x&1SV#-#b1O%hi2cAzW2ekna?kB}gZft+(n2K$MAMmHPHhi}7XM z6F&VLm1CV>FGBTb4nv`Q<4*PH_@I7xO=J(M`v9lWJHAqgm-ncQ##w6AoA}*3xQCbQ z+!^6j37U|#y^R-)Kp^)703UY32Pu29jsa4DDX2xcj;}*`ywwk*8w#!NA=}v}!(eE! zzlX0x0XrAlz8vV*@x9yigK1Ib*PcioT`@j)E0wV&yW_=F?@!EC~EZgkUy(O{j5Hb^cg)RWBt9*VM#Hu@rTE?i~@DZ z<^Af*Ix=WSphvgH{B>{qm&+HqL635`3lavSK3~!gTFL=rKW2H(qB|~k5Mv|C&ZBb9 z%6sLA&bbPnCCzdm68J|y=-=(h9Tl(+ zZW-|)q~%kTW4;P$@zL#-t&>JKJ|&G zy8bbLc9r_%#rHJznGuy({BdP%9#Q`wHBc;Fdd zNn$*s!!tSkaplan>Local>medley3.5>lispcore>library>VIRTUALKEYBOARDS.;10| 141793 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) - |changes| |to:| (VARS VIRTUALKEYBOARDSCOMS VKBD.BACKGROUND-MENU-SUBITEMS - VKBD.NON-CHAR-ASSIGNMENTS-LABELS VKBD.WINDOW-MENU-SUBITEMS VKBD.ICON - VKBD.MASK MODEACTIONS) - (RECORDS KEYBOARDCONFIGURATION VIRTUALKEYBOARD) +(FILECREATED " 6-Jul-2023 15:55:10" |{WMEDLEY}VIRTUALKEYBOARDS>VIRTUALKEYBOARDS.;16| 140655 - |previous| |date:| "22-Dec-2018 22:52:44" -|{DSK}kaplan>Local>medley3.5>lispcore>library>VIRTUALKEYBOARDS.;9|) + :EDIT-BY |rmk| + + :CHANGES-TO (VARS VIRTUALKEYBOARDSCOMS) + (FNS VKBD.INIT VKBD.LOAD-KEYBOARD-FILE METASHIFT) + + :PREVIOUS-DATE "28-Jun-2023 11:52:23" |{WMEDLEY}virtualkeyboards>VIRTUALKEYBOARDS.;9| +) -; Copyright (c) 1985, 1986, 1987, 1988, 1990, 1992, 1993, 1995, 1996, 2017, 2018 by Venue & Xerox Corporation. All rights reserved. +; Copyright (c) 1985-1988, 1990, 1992-1993, 1995-1996, 2017-2018 by Venue & Xerox Corporation. (PRETTYCOMPRINT VIRTUALKEYBOARDSCOMS) @@ -50,7 +50,8 @@ UNDERLINE NOTUNDERLINE SUBSCRIPT SUPERSCRIPT SMALLER LARGER MARGINS NOTMARGINS LOOKS NOTLOOKS F11 NOTF11 F12 NOTF12)) (RECORDS KEYBOARDCONFIGURATION VIRTUALKEYBOARD) - (INITVARS (VKBD.KNOWN-KEYBOARDS NIL)) + (INITVARS (VKBD.LOADED-KEYBOARDS NIL) + (VKBD.KNOWN-KEYBOARDS NIL)) (FILES (SOURCE) KEYBOARDCONFIGS) (VARS VKBD.BACKGROUND-MENU-SUBITEMS VKBD.NON-CHAR-ASSIGNMENTS-LABELS @@ -60,6 +61,7 @@ VKBD.KNOWN-KEYBOARDS VKBD.NON-CHAR-ASSIGNMENTS-LABELS VKBD.ICON VKBD.MASK CURRENTKEYBOARDCONFIG VKBD.CONFIGURATIONS VKBD.COMMONCODELABELS VKBD.COMMONKEYLABELS VKBD.COMMONDEFAULTASSIGNMENT) + (INITVARS (CURRENTKEYBOARDCONFIG NIL)) (COMS (DECLARE\: FIRST (P (MOVD? '\\KEYBOARDEVENTFN '\\OLDKEYBOARDEVENTFN))) (INITVARS (\\ORIGINALDEFAULTKEYACTION)) (FNS VKBD.\\KEYBOARDEVENTFN VKBD.RESETKEYACTIONTABLES) @@ -75,11 +77,12 @@ 'DEFAULT))) (FNS FIXKEYBOARD FIXKEYBOARDCONFIG FIXKEYASSIGNMENTS) (DECLARE\: DONTEVAL@LOAD DOCOPY (P (VKBD.INIT))) - (COMS (FNS METASHIFT) - (* \; - "Call new definition if the old one had been called") - (P (AND (MEMB (MACHINETYPE) - '(MAIKO DORADO)) + (COMS (P (MOVD? 'METASHIFT 'OLDMETASHIFT)) + (FNS METASHIFT) + (* \; + "Call new definition if the old one had been called") + (P (AND (MEMB (KEYBOARDTYPE) + '(X DORADO)) (EQUAL (KEYACTION 'BLANK-BOTTOM) '(METADOWN . METAUP)) (METASHIFT T)))) @@ -217,61 +220,34 @@ 'DEFAULT))))))) (VKBD.CREATE-KEYACTION-TABLE - - (LAMBDA (NEW-KEYBOARD OLDTABLE) (* \; "Edited 29-Feb-96 12:32 by rmk") - + (LAMBDA (NEW-KEYBOARD OLDTABLE) (* \; "Edited 28-Jun-2023 11:52 by rmk") + (* \; "Edited 29-Feb-96 12:32 by rmk") (PROG (KEYBOARDNAME FOUND KEYACTION-TABLE CONFIG) - (CL:UNLESS (COND - ((AND (ATOM NEW-KEYBOARD) - (SETQ FOUND (FINDVIRTUALKEYBOARD NEW-KEYBOARD))) - (SETQ NEW-KEYBOARD FOUND)) - ((MEMB NEW-KEYBOARD VKBD.KNOWN-KEYBOARDS))) - - - (* |;;| "Use FOUND to preserve NEW-KEYBOARD for error") - - + (* |;;| "Use FOUND to preserve NEW-KEYBOARD for error") (ERROR "INVALID KEYBOARD" NEW-KEYBOARD)) - (SETQ KEYBOARDNAME (FETCH (VIRTUALKEYBOARD KEYBOARDNAME) OF NEW-KEYBOARD)) - (COND - (OLDTABLE (SETQ KEYACTION-TABLE (RESETKEYACTION OLDTABLE))) - ((SETQ KEYACTION-TABLE (GETPROP KEYBOARDNAME 'KEYACTIONTABLE)) - (RETURN KEYACTION-TABLE)) - (T (SETQ KEYACTION-TABLE (KEYACTIONTABLE)))) - (SETQ NEW-KEYBOARD (VKBD.COMPLETE-KEYBOARD NEW-KEYBOARD)) - (SETQ CONFIG (VKBD.GET-CONFIGURATION (FETCH (VIRTUALKEYBOARD KEYBOARDCONFIGURATION) - - OF NEW-KEYBOARD))) - - (FOR KEY-ASSIGNMENT IN (FETCH (VIRTUALKEYBOARD COMPLETEKEYASSIGNMENTS) - - OF NEW-KEYBOARD) DO (OLDKEYACTION (CAR - - KEY-ASSIGNMENT - - ) - - (CDR KEY-ASSIGNMENT) - - KEYACTION-TABLE)) - + OF NEW-KEYBOARD))) + (FOR KEY-ASSIGNMENT IN (FETCH (VIRTUALKEYBOARD COMPLETEKEYASSIGNMENTS) OF NEW-KEYBOARD) + DO (CL:UNLESS (MEMB (CAR KEY-ASSIGNMENT) + '(31 86)) + (OLDKEYACTION (CAR KEY-ASSIGNMENT) + (CDR KEY-ASSIGNMENT) + KEYACTION-TABLE))) (PUTPROP KEYBOARDNAME 'KEYACTIONTABLE KEYACTION-TABLE) - (RETURN KEYACTION-TABLE)))) (vkbd.windowmenufn @@ -414,7 +390,9 @@ (setq |BackgroundMenu| nil))) (VKBD.INIT - (LAMBDA NIL (* \; "Edited 14-Jun-2017 14:22 by kaplan") + (LAMBDA NIL (* \; "Edited 6-Jul-2023 15:14 by rmk") + (* \; "Edited 28-Jun-2023 10:40 by rmk") + (* \; "Edited 14-Jun-2017 14:22 by kaplan") (* \; "Edited 16-Jun-92 11:14 by kaplan") (* |;;| "Reads virtual keyboard file for current type (or default type), if it can be found. Keyboards that don't match current keyboard can be displayed but not installed (via PROCESS.KEYBOARD)") @@ -423,35 +401,22 @@ (SETQ \\ORIGINALDEFAULTKEYACTION (KEYACTIONTABLE \\DEFAULTKEYACTION))) (SETQ VKBD.COMMONCODELABELS (FOR X IN VKBD.COMMONCHARLABELS COLLECT (IF (LISTP X) - THEN (IF (SMALLP (CAR X)) - THEN X - ELSE (LIST (CHARCODE.DECODE - (CAR X)) - (CADR X))) - ELSE (LIST (CHARCODE.DECODE X) - X)))) + THEN (IF (SMALLP (CAR X)) + THEN X + ELSE (LIST (CHARCODE.DECODE (CAR X)) + (CADR X))) + ELSE (LIST (CHARCODE.DECODE X) + X)))) (VKBD.ADD-ITEM-TO-BACKGROUND-MENU "Keyboard" ''(SWITCHKEYBOARDS T NIL) "Displays a menu for switching keyboards" VKBD.BACKGROUND-MENU-SUBITEMS) (VKBD.WINDOWMENUINIT) - (LET (FILE (KT (KEYBOARDTYPE))) + (LET ((KT (KEYBOARDTYPE))) (SETQ CURRENTKEYBOARDCONFIG (VKBD.GET-CONFIGURATION KT)) - (COND - ((SETQ FILE (COND - ((AND KT (FINDFILE (PACK* KT "KEYBOARDS") - T))) - (T (FINDFILE (PACK* DEFAULTVIRTUALKEYBOARDTYPE "KEYBOARDS") - T)))) - (VKBD.LOAD-KEYBOARD-FILE FILE) + (CL:WHEN (VKBD.LOAD-KEYBOARD-FILE KT) (* |;;| "Loading a keyboard file may change our notion of KEYBOARDTYPE, because of new coercion paths. The default keyboard will be added for the new type") - (VKBD.ADD-DEFAULT-KEYBOARD)) - (T - (* |;;| "Special printing here to avoid file-not-found error in case where user calls VKBD.LOAD-KEYBOARD-FILE directly") - - (PROMPTPRINT "Note: virtual keyboard file for type " (OR (KEYBOARDTYPE) - DEFAULTVIRTUALKEYBOARDTYPE) - " keyboards not found")))))) + (VKBD.ADD-DEFAULT-KEYBOARD))))) (VKBD.CREATE-DEFAULT-KEYBOARD @@ -474,9 +439,10 @@ OF CONFIGURATION))))) (VKBD.ADD-DEFAULT-KEYBOARD - (LAMBDA (KEYBOARDTYPE) (* \; "Edited 23-May-95 17:04 by rmk:") + (LAMBDA (KEYBOARDTYPE) (* \; "Edited 28-Jun-2023 10:45 by rmk") + (* \; "Edited 23-May-95 17:04 by rmk:") -(* |;;;| "It is useful practice to be able to switch back to the original key assignments. Thus the program is adding one special keyboard with the name DEFAULT which is the current keyboardtype's default keyboard.") +(* |;;;| "It is useful practice to be able to switch back to the original key assignments. Thus the program is adding one special keyboard with the name DEFAULT which is the current keyboardtype's default keyboard.") (SETQ KEYBOARDTYPE (OR KEYBOARDTYPE (KEYBOARDTYPE))) (BIND DEFAULT WHILE (SETQ DEFAULT (FINDVIRTUALKEYBOARD 'DEFAULT KEYBOARDTYPE)) @@ -504,114 +470,55 @@ THEN (VKBD.LOAD-KEYBOARD-FILE F REDEFINE? DELETE-FIRST? T))))) (VKBD.LOAD-KEYBOARD-FILE + (LAMBDA (KEYBOARDTYPE REDEFINE? DELETE-CURRENT-DEFINITIONS?) + (* \; "Edited 6-Jul-2023 15:11 by rmk") + (* \; "Edited 4-Jul-2023 23:22 by rmk") + (CL:UNLESS KEYBOARDTYPE (SETQ KEYBOARDTYPE DEFAULTVIRTUALKEYBOARDTYPE)) - (LAMBDA (FILENAME REDEFINE? DELETE-CURRENT-DEFINITIONS? PROMPTPRINT) + (* |;;| "Returns T if keyboards of type KEYBOARDTYPE found. Prints prompt warning and returns NIL if not found.") - (* \; "Edited 4-Mar-96 10:53 by rmk") + (* |;;| "Note: Can't switch to READFILE, since it uses OLD-INTERLISP readtable which doesn't honor vertical bars around numeric atoms.") + (LET (FILE (VKBDDIRS (CONS (MEDLEYDIR "library/virtualkeyboards/") + LISPUSERSDIRECTORIES)) + (NEWKEYBOARDS (CDR (ASSOC KEYBOARDTYPE VKBD.LOADED-KEYBOARDS)))) + (CL:UNLESS NEWKEYBOARDS + (* |;;| "If keyboards of type KEYBOARDTYPE have not previously been loaded, we look for a file KEYBOARDS (e.g. XKEYBOARDS, SDLKEYBOARDS), defaulting to the directory that VIRTUALKEYBOARDS is coming from. It is assumed that that file will add the desired keyboards to VKBD.LOADED-KEYBOARDS,") - (* |;;| "Note: Can't switch to READFILE, since it uses OLD-INTERLISP readtable which doesn't honor vertical bars around numeric atoms.") + (CL:WHEN (SETQ FILE (FINDFILE (PACK* KEYBOARDTYPE "KEYBOARDS") + T VKBDDIRS)) + (LOAD FILE T) + (SETQ NEWKEYBOARDS (CDR (ASSOC KEYBOARDTYPE VKBD.LOADED-KEYBOARDS))))) + (|if| NEWKEYBOARDS + |then| (COND + (DELETE-CURRENT-DEFINITIONS? (SETQ VKBD.KNOWN-KEYBOARDS NEWKEYBOARDS) + (VKBD.ADD-DEFAULT-KEYBOARD)) + (T (FOR NEWKEYBOARD KN KC IN NEWKEYBOARDS + DO + (* |;;| + "To make sure that COMPLETEDASSIGNMENTS cell (or any other new cells) exist--backward compatibility") + (SETQ NEWKEYBOARD (CREATE VIRTUALKEYBOARD USING NEWKEYBOARD)) + (SETQ KN (FETCH KEYBOARDNAME OF NEWKEYBOARD)) + (SETQ KC (FETCH KEYBOARDCONFIGURATION OF NEWKEYBOARD)) + (FOR TAIL OLDKEYBOARD ON VKBD.KNOWN-KEYBOARDS + WHEN (AND (EQ KN (FETCH KEYBOARDNAME OF (SETQ OLDKEYBOARD + (CAR TAIL)))) + (EQ KC (FETCH KEYBOARDCONFIGURATION OF OLDKEYBOARD))) + DO + (* |;;| "If REDEFINE?, then replace one with same name and configuration. Otherwise, keep the old one instead of installing the new one.") - (LET ((NEWKEYBOARDS (CL:WITH-OPEN-FILE (STREAM FILENAME :DIRECTION :INPUT) - - (BIND KB DATE (*PACKAGE* _ *INTERLISP-PACKAGE*) - - (RDTBL _ (FIND-READTABLE "INTERLISP")) - - FIRST (SETQ DATE (READ STREAM RDTBL)) - - (CL:UNLESS (LISTP DATE) - - (CL:WHEN (STRINGP DATE) - - (SETQ DATE (CONCAT "Keyboards from " (FULLNAME STREAM - - ) - - " [" DATE "]")) - - (IF PROMPTPRINT - - THEN (PROMPTPRINT DATE) - - ELSE (PRINTOUT T DATE T))) - - (SETQ DATE NIL)) WHILE (SKIPSEPRCODES STREAM RDTBL) - - UNTIL (EQ 'STOP (SETQ KB (READ STREAM RDTBL))) COLLECT - - KB - - FINALLY (CL:WHEN DATE - - - - (* |;;| - - "Was a LISTP date, must have been a keyboard") - - - - (PUSH DATE $$VAL)))))) - - (COND - - (DELETE-CURRENT-DEFINITIONS? (SETQ VKBD.KNOWN-KEYBOARDS NEWKEYBOARDS) - - (VKBD.ADD-DEFAULT-KEYBOARD)) - - (T (FOR NEWKEYBOARD KN KC IN NEWKEYBOARDS - - DO - - - - (* |;;| - -"To make sure that COMPLETEDASSIGNMENTS cell (or any other new cells) exist--backward compatibility") - - - - (SETQ NEWKEYBOARD (CREATE VIRTUALKEYBOARD USING NEWKEYBOARD)) - - (SETQ KN (FETCH KEYBOARDNAME OF NEWKEYBOARD)) - - (SETQ KC (FETCH KEYBOARDCONFIGURATION OF NEWKEYBOARD)) - - (FOR TAIL OLDKEYBOARD ON VKBD.KNOWN-KEYBOARDS - - WHEN (AND (EQ KN (FETCH KEYBOARDNAME OF (SETQ OLDKEYBOARD - - (CAR TAIL)))) - - (EQ KC (FETCH KEYBOARDCONFIGURATION OF OLDKEYBOARD)) - - ) DO - - - - (* |;;| "If REDEFINE?, then replace one with same name and configuration. Otherwise, keep the old one instead of installing the new one.") - - - - (COND - - (REDEFINE? (RPLACA TAIL NEWKEYBOARD)) - - (T (RETURN))) FINALLY (SETQ - - VKBD.KNOWN-KEYBOARDS - - (NCONC1 - - VKBD.KNOWN-KEYBOARDS - - NEWKEYBOARD)))) - - ))))) + (COND + (REDEFINE? (RPLACA TAIL NEWKEYBOARD)) + (T (RETURN))) FINALLY (SETQ VKBD.KNOWN-KEYBOARDS + (NCONC1 VKBD.KNOWN-KEYBOARDS + NEWKEYBOARD)))))) + T + |else| (PROMPTPRINT "Note: Can't find virtual keyboard file for " KEYBOARDTYPE + " keyboards") + NIL)))) (vkbd.store-file-command (lambda (f) (* \; "Edited 15-Dec-87 16:31 by Snow") @@ -2412,29 +2319,29 @@ (NOTF12 621)) (DECLARE\: EVAL@COMPILE -(RECORD KEYBOARDCONFIGURATION (CONFIGURATIONNAME KBCDUMMY1 KEYREGIONS KBCDUMMY2 DEFAULTASSIGNMENT - KEYNAMESMAPPING KEYBOARDTYPE KEYLABELS KEYLABELSFONT - BACKGROUNDSHADE KEYBOARDDISPLAYFONT CHARLABELS) +(RECORD KEYBOARDCONFIGURATION (CONFIGURATIONNAME KBCDUMMY1 KEYREGIONS KBCDUMMY2 DEFAULTASSIGNMENT + KEYNAMESMAPPING KEYBOARDTYPE KEYLABELS KEYLABELSFONT + BACKGROUNDSHADE KEYBOARDDISPLAYFONT CHARLABELS) - (* |;;| "Dummy fields so length test still works") + (* |;;| "Dummy fields so length test still works") - (TYPE? (EQLENGTH DATUM (CONSTANT (LENGTH (RECORDFIELDNAMES - - ' - KEYBOARDCONFIGURATION - ))))) - KEYBOARDTYPE _ (KEYBOARDTYPE) - KEYLABELSFONT _ DEFAULTKEYBOARDLABELSFONT BACKGROUNDSHADE _ 23130 - KEYBOARDDISPLAYFONT _ DEFAULTKEYBOARDDISPLAYFONT) + (TYPE? (EQLENGTH DATUM (CONSTANT (LENGTH (RECORDFIELDNAMES + 'KEYBOARDCONFIGURATION) + )))) + KEYBOARDTYPE _ (KEYBOARDTYPE) + KEYLABELSFONT _ DEFAULTKEYBOARDLABELSFONT BACKGROUNDSHADE _ 23130 + KEYBOARDDISPLAYFONT _ DEFAULTKEYBOARDDISPLAYFONT) (RECORD VIRTUALKEYBOARD (KEYBOARDNAME KEYASSIGNMENTS KEYBOARDCONFIGURATION KEYBOARDDISPLAYFONT) - (HASHLINK VIRTUALKEYBOARD (COMPLETEKEYASSIGNMENTS VKBDHASHARRAY 20))) + (HASHLINK VIRTUALKEYBOARD (COMPLETEKEYASSIGNMENTS VKBDHASHARRAY 20))) ) (DECLARE\: EVAL@COMPILE (GLOBALVARS VKBDHASHARRAY)) (SETUPHASHARRAY 'VKBDHASHARRAY 20) +(RPAQ? VKBD.LOADED-KEYBOARDS NIL) + (RPAQ? VKBD.KNOWN-KEYBOARDS NIL) (FILESLOAD (SOURCE) @@ -2485,11 +2392,11 @@ ))))) (RPAQQ VKBD.NON-CHAR-ASSIGNMENTS-LABELS ((SHIFT SHIFT) - (CTRL CTRL) - (META META) - (LOCK LOCK) - (LOCKUP LOCKUP) - (LOCKDOWN LOCKDOWN))) + (CTRL CTRL) + (META META) + (LOCK LOCK) + (LOCKUP LOCKUP) + (LOCKDOWN LOCKDOWN))) (RPAQQ VKBD.WINDOW-MENU-SUBITEMS (SUBITEMS ("Switch keyboard" (FUNCTION (LAMBDA (W) @@ -2549,6 +2456,8 @@ VKBD.NON-CHAR-ASSIGNMENTS-LABELS VKBD.ICON VKBD.MASK CURRENTKEYBOARDCONFIG VKBD.CONFIGURATIONS VKBD.COMMONCODELABELS VKBD.COMMONKEYLABELS VKBD.COMMONDEFAULTASSIGNMENT) ) + +(RPAQ? CURRENTKEYBOARDCONFIG NIL) (DECLARE\: FIRST (MOVD? '\\KEYBOARDEVENTFN '\\OLDKEYBOARDEVENTFN) @@ -2858,18 +2767,18 @@ (RPAQ? MODEKEYS ) -(RPAQQ MODEACTIONS (EVENT CTRLUP CTRLDOWN 1SHIFTUP 1SHIFTDOWN 2SHIFTUP 2SHIFTDOWN LOCKUP LOCKDOWN - LOCKTOGGLE METAUP METADOWN FONTUP FONTDOWN FONTTOGGLE USERMODE1UP - USERMODE1DOWN USERMODE1TOGGLE USERMODE2UP USERMODE2DOWN USERMODE2TOGGLE - USERMODE3UP USERMODE3DOWN USERMODE3TOGGLE)) +(RPAQQ MODEACTIONS (EVENT CTRLUP CTRLDOWN 1SHIFTUP 1SHIFTDOWN 2SHIFTUP 2SHIFTDOWN LOCKUP LOCKDOWN + LOCKTOGGLE METAUP METADOWN FONTUP FONTDOWN FONTTOGGLE USERMODE1UP + USERMODE1DOWN USERMODE1TOGGLE USERMODE2UP USERMODE2DOWN USERMODE2TOGGLE + USERMODE3UP USERMODE3DOWN USERMODE3TOGGLE)) (DECLARE\: DOEVAL@COMPILE DONTCOPY (GLOBALVARS MODEKEYS MODEACTIONS) ) (ADDTOVAR BREAKRESETFORMS ((LAMBDA (K) - (PROCESS.KEYBOARD NIL K)) - 'DEFAULT)) + (PROCESS.KEYBOARD NIL K)) + 'DEFAULT)) (DEFINEQ (FIXKEYBOARD @@ -3390,12 +3299,15 @@ (VKBD.INIT) ) + +(MOVD? 'METASHIFT 'OLDMETASHIFT) (DEFINEQ (METASHIFT - (LAMBDA FLG (* \; "Edited 16-Jun-92 08:44 by rmk:") + (LAMBDA FLG (* \; "Edited 6-Jul-2023 09:21 by rmk") + (* \; "Edited 16-Jun-92 08:44 by rmk:") - (* |;;| "Sets interpretation of swat key to first arg, where T means meta-shift, NIL means original setting. Returns previous setting. This differs from LLKEY version in that it changes the \\DORADOKEYACTIONS and \\DEFAULTKEYACTION table to insure that the metashift remains in effect across keyboard switches.") + (* |;;| "Sets interpretation of swat key to first arg, where T means meta-shift, NIL means original setting. Returns previous setting. This differs from LLKEY version in that it changes the \\DORADOKEYACTIONS and \\DEFAULTKEYACTION table to insure that the metashift remains in effect across keyboard switches.") (PROG* ((METASTATUS '(METADOWN . METAUP)) (ARGUMENT (AND (IGREATERP FLG 0) @@ -3408,19 +3320,19 @@ OLDSETTING) (SETQ OLDSETTING (KEYACTION 'BLANK-BOTTOM ARGUMENT)) - (* |;;| - "Update \\doradokeyactions table so we don't lose the change when we repalce the keyaction table.") + (* |;;| + "Update \\doradokeyactions table so we don't lose the change when we repalce the keyaction table.") - (AND (EQ (MACHINETYPE) - 'DORADO) - (COND - (ARGUMENT (PUTASSOC 'BLANK-BOTTOM ARGUMENT \\DORADOKEYACTIONS) - (KEYACTION 'BLANK-BOTTOM ARGUMENT \\DEFAULTKEYACTION)) - (T (SETQ \\DORADOKEYACTIONS (|for| X |in| \\DORADOKEYACTIONS - |join| (AND (NEQ (CAR X) - 'BLANK-BOTTOM) - (LIST X)))) - (KEYACTION 'BLANK-BOTTOM NIL \\DEFAULTKEYACTION)))) + (CL:WHEN (EQ (KEYBOARDTYPE) + 'DORADO) + (COND + (ARGUMENT (PUTASSOC 'BLANK-BOTTOM ARGUMENT \\DORADOKEYACTIONS) + (KEYACTION 'BLANK-BOTTOM ARGUMENT \\DEFAULTKEYACTION)) + (T (SETQ \\DORADOKEYACTIONS (|for| X |in| \\DORADOKEYACTIONS + |join| (AND (NEQ (CAR X) + 'BLANK-BOTTOM) + (LIST X)))) + (KEYACTION 'BLANK-BOTTOM NIL \\DEFAULTKEYACTION)))) (RETURN (COND ((EQUAL OLDSETTING METASTATUS) T) @@ -3432,8 +3344,8 @@ (* \; "Call new definition if the old one had been called") -(AND (MEMB (MACHINETYPE) - '(MAIKO DORADO)) +(AND (MEMB (KEYBOARDTYPE) + '(X DORADO)) (EQUAL (KEYACTION 'BLANK-BOTTOM) '(METADOWN . METAUP)) (METASHIFT T)) @@ -3450,38 +3362,38 @@ (PUTPROPS VIRTUALKEYBOARDS COPYRIGHT ("Venue & Xerox Corporation" 1985 1986 1987 1988 1990 1992 1993 1995 1996 2017 2018)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (5486 14142 (FINDVIRTUALKEYBOARD 5496 . 8650) (PROCESS.KEYBOARD 8652 . 11328) ( -VKBD.CREATE-KEYACTION-TABLE 11330 . 13246) (VKBD.WINDOWMENUFN 13248 . 13515) (VKBD.WINDOWMENUINIT -13517 . 14140)) (14143 19504 (LOADKEYBOARDDISPLAYFONTS 14153 . 19502)) (19613 20837 (DEFINEKEYBOARD -19623 . 20835)) (20838 25256 (VKBD.ADD-ITEM-TO-BACKGROUND-MENU 20848 . 21256) (VKBD.INIT 21258 . 23796 -) (VKBD.CREATE-DEFAULT-KEYBOARD 23798 . 24390) (VKBD.ADD-DEFAULT-KEYBOARD 24392 . 25254)) (25257 31597 - (VKBD.LOAD-FILE-COMMAND 25267 . 25721) (VKBD.LOAD-KEYBOARD-FILE 25723 . 29558) ( -VKBD.STORE-FILE-COMMAND 29560 . 29901) (VKBD.STORE-KEYBOARD-FILE 29903 . 31595)) (31598 40899 ( -SWITCHKEYBOARDS 31608 . 33086) (VKBD.POP-MENU-AND-SWITCH-KEYBOARDS 33088 . 33458) ( -VKBD.POP-UP-KEYBOARDS-MENU 33460 . 34842) (VKBD.GET-CONFIGURATION 34844 . 35762) ( -VKBD.SUBCONFIGURATION 35764 . 40897)) (40900 81185 (VKBD.BUTTONEVENTFN 40910 . 43817) ( -VKBD.CENTER-BITMAP-IN-REGION 43819 . 45343) (VKBD.CLEAR-KEY-DISPLAY 45345 . 47476) ( -VKBD.CREATE-KEYBOARD-BITMAP 47478 . 49522) (VKBD.CREATE-KEYBOARD-DISPLAY 49524 . 52653) ( -VKBD.CURSORMOVEDFN 52655 . 54559) (VKBD.DISPLAY-CHARACTER 54561 . 56519) (VKBD.DISPLAY-EMPTY-KEY-CAP -56521 . 67059) (VKBD.DISPLAY-KEY 67061 . 70268) (VKBD.DISPLAY-KEY-CHARACTERS 70270 . 71463) ( -VKBD.DRAW-KEY-CAPS 71465 . 73653) (VKBD.ERASE-FRAME 73655 . 73978) (VKBD.EXTEND-REGION 73980 . 74569) -(VKBD.GET-KEY-AND-REGIONS-OF-CURSOR-POSITION 74571 . 75186) (VKBD.GET-KEY-REGIONS 75188 . 75444) ( -VKBD.INVERT-KEY 75446 . 75736) (VKBD.INVERT-REGION 75738 . 76429) (VKBD.KEYBOARD-WINDOW-REPAINTFN -76431 . 78388) (VKBD.LOWER-HALF-REGION 78390 . 78790) (VKBD.POSITION-IS-IN-KEY-REGION 78792 . 79076) ( -VKBD.REMOVE-KEYBOARD-COMMAND 79078 . 79535) (VKBD.UNION-REGIONS 79537 . 80682) (VKBD.UPPER-HALF-REGION - 80684 . 81183)) (81186 100744 (VKBD.KEY-ASSOC 81196 . 81696) (VKBD.CHAR-ASSIGNMENTP 81698 . 81862) ( -VKBD.COMPLETE-KEYBOARD 81864 . 84523) (VKBD.CTRL-ASSIGNMENTP 84525 . 84768) (VKBD.EVENT-ASSIGNMENTP -84770 . 85010) (VKBD.META-ASSIGNMENTP 85012 . 85255) (VKBD.FRAME-KEY 85257 . 87134) ( -VKBD.GET-CURRENT-KEY-ASSIGNMENT 87136 . 87505) (VKBD.GET-NON-CHAR-LABEL 87507 . 88162) (VKBD.ICONFN -88164 . 88900) (VKBD.INVERT-LOCK-KEYS 88902 . 89580) (VKBD.INVERT-SHIFT-KEYS 89582 . 90264) ( -VKBD.TRANSLATE-KEY-ID 90266 . 90945) (VKBD.KEY-ID-TO-KEY-NAMES 90947 . 91433) ( -VKBD.KEYBOARD-IS-KEYBOARDTYPE-KEYBOARD 91435 . 92033) (VKBD.LOCK-ASSIGNMENTP 92035 . 92482) ( -VKBD.LOCK-KEYP 92484 . 92802) (VKBD.LOCK/NOLOCK 92804 . 92963) (VKBD.LOCKDOWN-ASSIGNMENTP 92965 . -93259) (VKBD.LOCKUP-ASSIGNMENTP 93261 . 93551) (VKBD.PARSE-CHAR-CODE 93553 . 94052) ( -VKBD.PARSE-KEY-ASSIGNMENT 94054 . 97510) (VKBD.RESET-KEYBOARD-WINDOW 97512 . 98105) ( -VKBD.SEND-CHARACTER 98107 . 99616) (VKBD.SHIFT-ASSIGNMENTP 99618 . 100012) (VKBD.SHIFTED-CHAR 100014 - . 100172) (VKBD.UNDEFINE-KEYBOARD 100174 . 100581) (VKBD.UNSHIFTED-CHAR 100583 . 100742)) (113812 -116258 (VKBD.\\KEYBOARDEVENTFN 113822 . 115025) (VKBD.RESETKEYACTIONTABLES 115027 . 116256)) (116364 -122515 (NEWKEYACTION 116374 . 122513)) (123170 139358 (FIXKEYBOARD 123180 . 124300) (FIXKEYBOARDCONFIG - 124302 . 131526) (FIXKEYASSIGNMENTS 131528 . 139356)) (139411 141267 (METASHIFT 139421 . 141265))))) + (FILEMAP (NIL (5390 13914 (FINDVIRTUALKEYBOARD 5400 . 8554) (PROCESS.KEYBOARD 8556 . 11232) ( +VKBD.CREATE-KEYACTION-TABLE 11234 . 13018) (VKBD.WINDOWMENUFN 13020 . 13287) (VKBD.WINDOWMENUINIT +13289 . 13912)) (13915 19276 (LOADKEYBOARDDISPLAYFONTS 13925 . 19274)) (19385 20609 (DEFINEKEYBOARD +19395 . 20607)) (20610 24555 (VKBD.ADD-ITEM-TO-BACKGROUND-MENU 20620 . 21028) (VKBD.INIT 21030 . 22982 +) (VKBD.CREATE-DEFAULT-KEYBOARD 22984 . 23576) (VKBD.ADD-DEFAULT-KEYBOARD 23578 . 24553)) (24556 30484 + (VKBD.LOAD-FILE-COMMAND 24566 . 25020) (VKBD.LOAD-KEYBOARD-FILE 25022 . 28445) ( +VKBD.STORE-FILE-COMMAND 28447 . 28788) (VKBD.STORE-KEYBOARD-FILE 28790 . 30482)) (30485 39786 ( +SWITCHKEYBOARDS 30495 . 31973) (VKBD.POP-MENU-AND-SWITCH-KEYBOARDS 31975 . 32345) ( +VKBD.POP-UP-KEYBOARDS-MENU 32347 . 33729) (VKBD.GET-CONFIGURATION 33731 . 34649) ( +VKBD.SUBCONFIGURATION 34651 . 39784)) (39787 80072 (VKBD.BUTTONEVENTFN 39797 . 42704) ( +VKBD.CENTER-BITMAP-IN-REGION 42706 . 44230) (VKBD.CLEAR-KEY-DISPLAY 44232 . 46363) ( +VKBD.CREATE-KEYBOARD-BITMAP 46365 . 48409) (VKBD.CREATE-KEYBOARD-DISPLAY 48411 . 51540) ( +VKBD.CURSORMOVEDFN 51542 . 53446) (VKBD.DISPLAY-CHARACTER 53448 . 55406) (VKBD.DISPLAY-EMPTY-KEY-CAP +55408 . 65946) (VKBD.DISPLAY-KEY 65948 . 69155) (VKBD.DISPLAY-KEY-CHARACTERS 69157 . 70350) ( +VKBD.DRAW-KEY-CAPS 70352 . 72540) (VKBD.ERASE-FRAME 72542 . 72865) (VKBD.EXTEND-REGION 72867 . 73456) +(VKBD.GET-KEY-AND-REGIONS-OF-CURSOR-POSITION 73458 . 74073) (VKBD.GET-KEY-REGIONS 74075 . 74331) ( +VKBD.INVERT-KEY 74333 . 74623) (VKBD.INVERT-REGION 74625 . 75316) (VKBD.KEYBOARD-WINDOW-REPAINTFN +75318 . 77275) (VKBD.LOWER-HALF-REGION 77277 . 77677) (VKBD.POSITION-IS-IN-KEY-REGION 77679 . 77963) ( +VKBD.REMOVE-KEYBOARD-COMMAND 77965 . 78422) (VKBD.UNION-REGIONS 78424 . 79569) (VKBD.UPPER-HALF-REGION + 79571 . 80070)) (80073 99631 (VKBD.KEY-ASSOC 80083 . 80583) (VKBD.CHAR-ASSIGNMENTP 80585 . 80749) ( +VKBD.COMPLETE-KEYBOARD 80751 . 83410) (VKBD.CTRL-ASSIGNMENTP 83412 . 83655) (VKBD.EVENT-ASSIGNMENTP +83657 . 83897) (VKBD.META-ASSIGNMENTP 83899 . 84142) (VKBD.FRAME-KEY 84144 . 86021) ( +VKBD.GET-CURRENT-KEY-ASSIGNMENT 86023 . 86392) (VKBD.GET-NON-CHAR-LABEL 86394 . 87049) (VKBD.ICONFN +87051 . 87787) (VKBD.INVERT-LOCK-KEYS 87789 . 88467) (VKBD.INVERT-SHIFT-KEYS 88469 . 89151) ( +VKBD.TRANSLATE-KEY-ID 89153 . 89832) (VKBD.KEY-ID-TO-KEY-NAMES 89834 . 90320) ( +VKBD.KEYBOARD-IS-KEYBOARDTYPE-KEYBOARD 90322 . 90920) (VKBD.LOCK-ASSIGNMENTP 90922 . 91369) ( +VKBD.LOCK-KEYP 91371 . 91689) (VKBD.LOCK/NOLOCK 91691 . 91850) (VKBD.LOCKDOWN-ASSIGNMENTP 91852 . +92146) (VKBD.LOCKUP-ASSIGNMENTP 92148 . 92438) (VKBD.PARSE-CHAR-CODE 92440 . 92939) ( +VKBD.PARSE-KEY-ASSIGNMENT 92941 . 96397) (VKBD.RESET-KEYBOARD-WINDOW 96399 . 96992) ( +VKBD.SEND-CHARACTER 96994 . 98503) (VKBD.SHIFT-ASSIGNMENTP 98505 . 98899) (VKBD.SHIFTED-CHAR 98901 . +99059) (VKBD.UNDEFINE-KEYBOARD 99061 . 99468) (VKBD.UNSHIFTED-CHAR 99470 . 99629)) (112553 114999 ( +VKBD.\\KEYBOARDEVENTFN 112563 . 113766) (VKBD.RESETKEYACTIONTABLES 113768 . 114997)) (115105 121256 ( +NEWKEYACTION 115115 . 121254)) (121893 138081 (FIXKEYBOARD 121903 . 123023) (FIXKEYBOARDCONFIG 123025 + . 130249) (FIXKEYASSIGNMENTS 130251 . 138079)) (138168 140132 (METASHIFT 138178 . 140130))))) STOP diff --git a/library/virtualkeyboards/VIRTUALKEYBOARDS.LCOM b/library/virtualkeyboards/VIRTUALKEYBOARDS.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..f1d1688681028bd56987dee059b30a2f3a1fda39 GIT binary patch literal 48819 zcmeHwdu&|SdFR}rUZyRDq+~{B73GR?6w(Q0&J2g7ls29RhnnF$E;Tb0MVT^9X=sxo zMS4ZLju91`6b)LSO?BQtBu$z$O*gJLkUUjx0OIHh)BkhxeX)p5OV-_de(Jjb+AjrOd#1u8aA(gCT%*bGWdwU<1O(R1!GiLUh!vhmf zuM9*7qcJlQKNXLkiVXIeeZ7~~t~|B0vQRVER*|Xw+WV%9nXy7<<`;f;W$EJ8`K!;q z=WMQAok|w+nVFQ8ERR*15>C83GJLHcrH7m*1_w_?hffU+_nOx(UR}_QTtfp3?|tg( z`l)N?wbiwa#ii9J@wBvh&FmeYDiln26(>%dKF;?Yyl zSnxFc{L+IMgX5X193-!;=>aJwYW=hrZ5<0EF zScNhFM}KjAPo}Fm%PA&>RAPTSaCpoI8}roIXnWtJIclcONpsN5r>ZlP88c@_%(PV+ z&z+tsC#lL(vPh}Opb(D}#?6x^mPT@_Q1#WzwTuJx?E+F=+RBvEs1NfI`m=k&p>VSC zrbJug(S0HOYwVit>YU$$_sPfUeetE4w#K=|#?Q*zHy&+kTwH9NNPaY#-MR6O?DV1T zaA)T}>p)v$ezB|3J>6CNbarQP=f-`U|3X`1Zm}aAHtJvD_jc46+Wca|xER{5f5vzz zF=6cdR(1jzcAlST++3=EJQuG2rtytL!Pxmk0m+{)H2!$0{#-s>{}p4dV>@AWa21V@ zSqH*%2kO6Sd@E5hc0NAcRiZkcD|HmZ^HWKEZBgshmOCxg?6BEjj=k-&5`(Z7GPY^5`m$_YJ#dg`O*xHVN8!}N2%1Y3lP z5k{zDj1qQH!UXl<;b~x%HI4cFR$C|(PBiXeXxES3L-77^qJB8RPal^*e|n;^mos!8 z3ny#8#h=dCKFWV*8uw?Pq*4OstNh&IPLiU3x{tFT+P5v=a`#f9?JTEm_Hi+O-uj=e z=YPyK_A;8iS#tBIBo}S$m8LLxqxQfsK7eF6N|WUVN+cdNnLc3DCFB?y^t?t#&1!Y# zgn|yfM?Md=YUT`d>PNGuLKt|o!UaR)Z$ z$&)Chh=EfIjksP0?G}eeodyBG+1c_`sgx_7)^Iba4=y+|1~c()0T4yUcpL-CN+ox? zR7C%Q)iFiM@aURL1xG-|Mt_G^DQXunK|lrGgz%-zw7oQe?qAvsbni^GC2B9O>|>05 zQBZuQ(UEwZaEuebu=K%;p~ao|FMe{3(h{7woiNTN8}S;W9jBacTwvsUN$R*5s)495 z5WX;zMSpT(-()ET%eeG7zyNQNjmM%VM&UKQRT?*xnbx8u8Vv2`P0pSuQ7MOdzu_ z4;Co*)JJPkA;1tZ`|#iBaKAY;O0wPAWFa?ZqbfukE-EVu_=S#WGU{Lt^GPCz_Zy** z(b*B=i9J`laZe)4b49Z;s@I}Jj}-(bt;vC@NgIBZ0cxjze<@cWD(-8aMH$BZabW1R z>7~`$+B3z4)u+>ISFX&j*4D3?;KDLs=`~k3P?<{Qs+nR1U!(3~kQ_tt5C}PA<|KDl zelLXtTN&l}=geXc{w?-!ro~IUFf8EJ>}&~`k&c3n0Fxl!kN|8}uq3TCRx#+&wY-vw zu9@x^d^BT2W^a0Ne)Y+Pb#r5J!PN4TIlsQXc4>*EPxG0jjYWK1TE`QO7IJCyB&55k z5(__OUm;mcjU~-KOhI2|I#*3+fdL{dn^hBVG^hLVZ$Alt`pXyu_(F1K+$vQo$-%+F zh@RGnS;?I`^-wyAY6i-g>QuQjFkZHb53#t!-^Qkj#hHO|t31HD9%7g#@f+i^r2>}I znE_zZR0h!P35Ua>r9@}gC@(JYdcCx3vFFkrn*&8m0)w3L4G>;Wj;-3L^rKW}iJ8g?p_=gFfEHX!Jm$aTZg7LnN&N6#OS@ zK7>9(CxBcz09^nIQ+Xf-sRaC_Lh}R;%o8OuFjwKc9BB=+<_I7{cTy~Vah+b>=>_8q*;DU3oQpd}g)b$0Ai z`R=v4B;&Uas+0rPVM+PnV#i`lXw!bM=+i< z>}+y!GE*8O9y)Tz{1K=Zad&fQd`!45*uyaTBtls-oz0Bdv|$+Pqhfew+!oxtdE)V5 zCl54-pnBqiN|Z|b%7T3cj6}P(+7johlX3Ex5y7+G_Zb9`JnU| zL|nzj%ou5hkQfx#cQY6>2971=nRY8W>QYu>EdUw=ss%M1J*n&lz6pr70BCfiMgA55 zjSdG-OcY{!V1J;>1*Su;3ryGc3V;8>`hxODfDjtcks%Ks^#D2&3x-z&>|G=NNj;Zt zGgrkNX<>0`0U^+appM40_U^4*56h=|fNuv>!tyXCpf6oGB|6dx7iK9rryu6yp;yV$ zzaN+e^R;H!wlqb0jZ3kl6}7V~oNa3yJt(?s zme%=eL$ueXQ7pd4sK(WbEk8qWWf>a#MXq*!}uJKtg)Wy81WSzFd21!WjByx>WgPt zzPi-D4Fk#af%=J>@o25>(=}tav30+gH6Ss4kTc~mvaiB6mtE{R|AFlBuYtk;`9v3s zRgSL7PmECah462m{X=FDu7(T9;|;O%k(#Y3InAybhpkzIcPhRR;07S$7B9*sB!fCT zY+D4_&K=SG&an$Hyicm??}S>wSAt*K8q1s*%g`UNkftQR5reEBQ3w{ck&e|{r3ai; z#M6hxj?O=#sjEyM+EmjA6UgYW**mth{?y9+v+L%(c?G5f^NF>q<~r2wOXMN4b@KII z6KqB~D1sI3{(f@=^=W-yn@^MpuW3HmjzKDl3`DsefK)x0ZbKW!ZgjBJzL+o;Yh-}H zG`E^6&;y7rsvW#2^GP5wC1~=Zt5VGIsEHeiWUe{`F8F7`8H^3~MIAK14!duR++?S&jIuU=2|u zh_o`IF*31hqP-8I4KD*fJsoM09=G*F^EHxUSfTByYVT8)HeQ+Rb|rn6$g4e1<4kpd zyJT$~&y_3HN0|1OGnjC&yGJlH55oc%#(XgOSQJHWkzu}n56uQs4p`>yttFC6Oj&?U zy59j*0VKDWPgboWsm~BOij!5?eWtDQ7_bWq5*BM^X2%zy2KWGN-ChIc6Y%evtMgYD zPMN(59|IavqlD$m<@f`GK515yFkq1ZAWy~*P$IGc#K}0VkrnSyLEvu2L&W`oYymQD zV*nR`1!Y0Nrw9p=NTOWipd(;LfP4y=3|ifSUJi(O=1^2z#wsb}bx(F_V1e zQQsp4v2XvU+%hZPy=I60w6z&(!}W*BRMcXlv|R>M$-C#W4QQ|H)67=*go+ zXCd;F7}fI^jBioqxdWn?b{=cDI_A3CHhW7}7t~r~XY-(Sz=C>f?7WcNe5=(}JiHA> zwf;9;Nm1EJrE>=h;o0lA-^as{!Ehssz`iJy6~U~@GGYs0ymH%AA@stC&$f8-!+<&Q zGgc{0f~hHcAcccPo0dFd1~fp5V0ehEv=U-~SpZjwMwR63U+>Yu7J@N($O0(@ImYON zV~dYK7xt#WClOSZZ1GWavDeLPq8M*)X>9`wCq2LVjt#7&)tads?RG|4U&OI`O*l1r zZKUiaziY1wqj=cwpMO~MrV0>I1$uZW4qMKEo?ysA1o!?2I- zK3E?#UaGPyfAi2p&0q?@^97xoj9=e%xMMjR~0kvsn%M@s%XptJ|)nLaDuzx`w^S*68tgz!9jy8zpK~+!UxEiunVe= zo1nz@#A~xh3kXF>TCiZzqtU{%#KR>qpC_|Lp{NOY;uQIu&w@vSBSX_SPvyo3GUuRu zR>-M#%7Q<4stWFZN_Z%8F%`3tH+F`a;M3J4p@ABAKXca+UETX2a&v%1&0%@oEEq7WGb^DUHx9Z^6AB1k8*&{`lD3@amrk71aIw7j;f zjVhsb-*zoXuOaK?wKGpIZCoR_I$Y|Eg3T5atb zD86Jsmy^|8d4p*NSb!k32(<5Din*-rt3#Gxp7gY%S1dYTCS?%v75zb+AH5r!DalB?oeotw(ev;cll!b_Ui51wac~62X`lb z2l1NW?G%}s6HNcYjpMwmQ#|SQ2WrNJnvwnCtq&Vtg*un};jNG04;c~vd)i%Sf(r@z zss9}L6!(-23f#PT<@U||txq^FUoVB}gM68|^;_=Om&pD2Csc1|@?Hu&h3`7FWp#AT zCSea}94+9hdZZ`H*`Zz4@3VTkIMJQKliORC%X6(#D(Kx?73By>Va1k|TlxnYMysI9 z>TPQrT>e20L{@T4E^NY~u)ZL6>G9_#pG&)h@xlal=} zd7xvelzOAW&ZB-_tiNO(KR(yDjoJ8+^-x#O+##sijf2)9RM-X2F-PcL|ItP3(DAvh z?fSnMbEZ)c{Mmd!IsfO5Zd*rC<|xV>nd{lM*#G;ZbJo%0b4O5y=mC}>g=!9C<>)0x z4ihU4@;D65;zeGG~AGkK0xdK3m%`x)xH{Y&L3rMXFLM-TVs~bR8qpzzyBvaQ8x#kWuoHzr2VzoT#*9KNYG%h#Xh;F6 z5Pq6dBXCU2&W@kYNR+p~gApuU6k@!pR7o`_P2ZbxlIwM48C8QqHa{K@SmOggamag) z!UZ|3xnBs3ZcYUGsaoL1(~zB|7LDrQ{V`A}hNVE9S5yoe3TV}E=VUq3G{9k*8$);; zqPT{Il}9Ncr77dE(y?3%Pk>;X2b;fWmCCg;BZvv-o{)Iy+0H2_bntp&5Ep95E`*7BhqpR*T6=?Dv8_hA9_| zu_Wh!pzHW@5^@xJioKk3l5~?QLU>&dh2YM;TuUX5Bv_fOrk7X3-@Pf1NDLc4*nDSN z*745f{o6^MjlaG8a{U-D&Yh3qL;ZgIaJs9eMJda<_A>!s8%xwo!hq zRR@R%NOTp^ep|i-sVDi8WKIQgf+@|VCIJLkViAfx0K$I_M@~4=d1kj3>W!CjVdLvL z!1WvW2^-%;pjmQa`DT9kW??1#auNSAsQBmdej&Rm1OHk4w>`-T`nNsX$q6b( z#q|?sC@gcDoe2$4)yPCo%QvYws^K&{lhma0aSi&ruDgh8Rd#44*KZF%3;~4HOajJ` zJIWcvDyK6hG|Fn`972-GjHY<6vpqu0CNhtj3G;>xAAcQ!EPqa;I8R4$z@8=`Q4z4G zI5?UWT0Kry!f{CX&HmaKFegUme!W|LI_^sS>0bjgX`zGwmTB;L*i+718DjnY##N zKs9+LXs}KO<$cvD^(`u&T^;ijvrPtyh9ON;DQ9XUif-A{t7Rrp>ay0f^q)05o@k19 zfz8W~w5P?%DViHGG5|*y^`O?%{>3p(rZ*GEd zL1`_8flYhZ0fqay_yJsVO?6<=_-aKcqciV2Sg&6$+^tP!3|ulox%JRC{=U;MA}Nk#!T2xeJMJO)T?+#;LG- zg+jYe>2i)j`)IBa@hYOw0{_sZ@{v;d%SyXFU)y|Ny*DdF^NYg2x9fkr)Io~nu7XRk z%)7M4%^~u=Jdo)EdI8W#OG9LT;Vi`XDV;n+N=gk<{$T1sPM7kCO-e`*Rl+tf2dH~d267S?#4Z0OX?0A=QfXyfq(NqF!3{D zgw7_@%*{IzX=fETI_;dy@XO5VxmF1LIzWxwIXqXb6jiJd;1Z2m@gszUy7r`Cc{HOM z=31&_S5mH|RtDJbSY?s{p@}CmA&uOaFfdc@O#pOgkDm0@A8KkVEP9^3Qn(_kqtG?s zc&#Ap1Trj1&qQRg-ZAg;3^NpTN!3{reO;=Hqqo=^rtQIiS3`6c^jfb|_#(mpIB)6( z4HOz@d=)Cn*GOG?2|v&*NuA8*0@agk{^_IlpH9#C!REDXtAn16<(r&BKUBfX zTrsTeG-{Q_l_5ZVbLaF|=497^x_uIabCzi@6H-U@PdudQXFPEvhI6wk%`}(0D;l26U$UTW9h|V zjnS&(5LUg`D2E_Q+39Fhr^mo6b$Sd`+fIi-X{SSs)ah_h>tt9fbt?A3=~U>_Dz%w% zV`XWY&Hi0IU@{~yebwOtyf>9trgLlq5q6Zyp!3Xuj$2ZiU*GN$e}-DgV? zcJEUZnvZ}xoP?e3N zUM3OI!Hnzx_7;I$qZx=c2ZQ+xlwdQVP7d%?kPxnUi1JK9SwlXKZUv$?^DAvjrqPN^ zPIrQW5WVI{Z6SB^Dq)9rNEcw zv?Y>ajuVPUV@zowR7-YT4J{vtXFRX8x&@8(1|HAZB_8Qf_Xcqx0K9~f3AoXNe)J%m z{M<6)KN3drWdvBz4}Mp|e|3{BV*I2#L}mdO*Yuv4LY?B(e`l>sEnR}K(&pLbtx>?w zU&It(d-TxfM|M%4d2OMmu23TcT(nKJHSS&P+WeVZqYc{+9u@8R`F!J_mg?W12%oS2 z9mOI28E-(r8BV#e42ijS15-UZg{clyZE_-B6A(Bvbb!E`Aa9iL6WU6sMSBL3oYdmo zJ;*Lynq&o`K@Fi+4jOLi7_S!r2Xn&@@yf{x<0EXp#ae!_PVTayQNQ%y6zP5yH1q2B z3hA}Uo0qqZXAdzzZoDIzpiQmvOL)d8=E#S(YYlOxt_6vx54|9(I13OvOYr;R!KL?oNvF8M+SKqFU8JIe8n}<(h?^6U!Y$qkE2*y zcnUhByE+H=5(%PzM*TQV$v%kh;wFKJZ6J`K>zk#?edQ~~($s^5SJ2%Q@T0j2$ zJXvf58#;cpf`PC$B-O!t7nw<@iBG;283h2 z5dkbw#e$0z%j|gv-nrjV!h{CfYd$l-ZeCruvi9@XaPq{}wJUtu*UHlRhPn2He{;$S zvK4tHy4=~dr&##GXS0n5O7i9F6ODVYv;F+n>fgy9f2sao zAR&JBmug0-hluI_E-ruP0(1J4I-m(bB^22N0O2q*?zHB2Kr{Edv&fo-?&d}IHed%9 z*)kZLh)f)MqM4g(y}_y0dc6T1l#XSuFN)+w5l8LDL3w;A0!tb|-FL~lVlZ6{-MBaD z5{3*>wi7$f()w>$TFN`rL`_>NYi=2Zl}Se{niNT;VD=4~PAWE}hiKz3G5WTS5S91T z(X^*TjTatLiku$e_-WW4m;u{6P@MW@hpi12hJ`4NX6O$nC?ZjF7UdRU6)$Rl1|8~* z?1qH+F5#<2=doRQE9v8|=wp_GRo;_>ix-Wdbkn5SLA1)MM**e6lKVJa< z))9duUVh%4|8vOxHA?*yQYEf$w$b*>sLB5Fn~)22oO<9f9riIR!Cw(DC+C)oD)}xj z8-gFenpw}+tf)z}BY!FqDHG8g!4pSA*9HsWPs-HeObP4?2E*=U!c!%PshH4oh4w)R-6uB$Z4eO|-uH_MH z5r-rCA)UR8s6J31k1#L1d>#JLU7~K#l9JUiQaYgebLU9CwfhBd|Q4$knRbi1(~W36I4dO{xduuzw% zbr1_9oTv$$8*L)V)A=130XhzQCB=ugka?T+d7lYU^+GgVXElT3U*HAFl=gWhjUCeT zkNt9EuT%#UnUb%YS1&>!Sb}O=b9#><3E8x6JPQ&=A1*~7v7g!*4i=0O*qi8)4!~wz z#$Cb_AME;|gZyD_>c#))s21uaA|PV8i-4*@GIg!DpM*v`X=)M)2$1fjE9A|;57 zxADb;El@WV=LFAd1_ef;$cN1ywarOGplP5y!=fzzJC0O(;XoH5j&I;ln`BTmQk()l zMSf%2gu{ofYI{7}yZYJQ#go=JMkY40upk0}&OepZd$YCY6`w))UMuqf%oTvXh##b- zI4@o*i1dNn7@b%~PqeR28MPhm7)*>&3Uo2<7%MM^$>WROc1GGLkUH04VBck8=i>$x znf;{5%rN%-L;m=A+Sb~dx47kL^h)d*2$#{%w42m^(UwX_P=>e8c@Y@fdxz2GqaoT1 zs^wZs3*^SfF3b`MoDZ}k^7(6 zcH}%I`Mn7#%piDKqi67zQqQoW5X3_bRjt#fA$!85Om7gQ5XXZDB}NgA?E^ebY&O8D zBzk`>_Yfmf5~wrRE>?RKoeKwhB)b_C1x_t!hAnL?!P{$SBAVe7sg;OrpJndQ4C?H| zC5!&JG&1ylK-fKLWHf&SNla_APNw1Ep=zz>3I)x!o{nardCpm*}HYP*e3ZC_5@`rSkg{-s-==}5@g zMvacdjs1*g!X^mO29@ds-b_`yj+fI+pN?A36$+Wtu!K++_71iG^R|vA>E=gtDA_eL-n!0 z?}5E^T*6a(61BGQSHvi$*d;DmP{QWS*5TCF{S2d|!K+bc2^+X4=3T&($LP@KVu`lL z@&b9OB!97qb@M;qhZF0I>SIyh3W~JKwy1dt-vOz5duWee3$|2vNg`!i5O7;fX@74`MpuM?Tu*#x$Y%gN}gYW9c1q zrF{&6C3K9Tzb0)=_NPOMm(C&L40NB)$w43rSKY*nK`%Kk5mHEhLS7ip%qRp^&pT)? z&f-NN8lAkH&Z}HRf02mcI*Ae3DcnUVB+~Pa9Zysh1x~n1A$FV+A+g(u=ogNB!Erl~ z(D(ug`-^XZf$~FSe$`xb6c#NII@gJp1#Hkt08u>5?A=di$J;BKayzR;FXZ6pR<)8T zIKkd8M+C^0(WfBR&^;C|Y4zOZn^lOgit80mjC$b}=8FRMWRMpSs;1ao7R8v7rnT~*M@{u_E32E0d6FMELAl>04jjb*y zs>S4_I83JEIax-#Rbf#DDTezT77pd(bMZYUkha{Z)omBo|I;>7rkEOa9t$h`2M#3@ ziF5OqSUg;IkHsBUqNGSi3wdEi{0%qO0;0*c-V+dazSZw)V(UnbJ0vW5^M2Q-kI9!0 z%AfPK8~ddt&JX0Ey$7j$Wu}svLWnLxgd9E<(F(UOBE%cUtOIQ*1gdGqu^mCt7h0WK zMxotd%~|b(%V~C;bp;C^S4_GSZ5wDV=)+!WNi-*N!gzd?z^LZpVBd`Vx*TvqN#0E~ zv9&}FY0Xs){CQ;6btn>Tb>>D~xE$d_2R*Uch%WR+Z^Lp+HguW(e5ANV7j}4Lv{7CZ5OBSPy=r5z{ zkv{mkrqRgh6-MYn1Cn7Ogoq3qAi_4g)wm|5I*Nuw%9|tU$xuEivVklI{(T&+gqXVW zIg(f-9Qnhy>_DguI?)xpQao@RvWJmr1Ec@IA5Fjf>9_|#F8n}Q+TPfU(-&9QHq07M zlG<2c$6amViTS5jaH^cT*asdvwH?*BJnsZS?UxAvVAI8jT5pV!LAjh{8BuKA1k~}d z%vqE4$k|y&Y>kg6Qn)__clba9#b>%It<}lbn28r~a2?{GBz{wf*3Q;j^urt5X6M{{#2Brd_7ts^??LG|!O_4mdjoO5z#YlI(oCi#h{m|q{Ky3UAOhM)NpXX+qd zZbVyZnWJNTqD=AiS|p1o6Jg*npmfQVw-~fMMIbw{fT`Z4IPE!OEYsy7 zY)FDs;E)#Y9H^<|1wu-a+?3{y^XWH3r@`MtOdA*qk78Fjl&MU34|!{gkfZExF_TuiJxncM>D-LQ zV%*cvC(ToeOK1Sf^4V3O9Yk9^)$yUnL{c2Ql%mj3|8F~y5?;qV7ma=5e}JJk#V1I8 zFxl3)FV*;k>F$fWu801};H*c!lnl$m=0EUXzVI~5k2t^SZF}GmKB`_Doj5(8zsULG zM)Cnf7=APBI?A{^{8;jpt@}$al=829u2gvC#YD2m!rwOeu>OcnYuxNhN$oSgopLbe z;;#DJQjQsGyM8Fu)_4nNRJX5=9!zZlJ%m)&Cu{ue$mXH#)QsV&=ezD|{xe;wnnK{2 zlV#__R>#*QChW_(#u-L$9P500B#EDBPAV4V;=%1~Eh$6hgm8{qO(-`M3to+~}9-Vw0#Vxl59rl)0|Py)-Xf;p?~0IX$S~%E9{9 zgF1T-Z-ZVB={>)q^#YMx;)6M)JlbSFqjVfEHKe1YT}hB#G&|F|uuBCbn^$HGemwgb z(lMk-bx8A{|0s{hR_|mJ~(zNS!=2=Mw^eJvf_hK26(qbYmb6X+NmIl z-s>g7G$b48*g6|sr0QAWv2Ie>Ik6oJFZOWXZ{FhY2Q zgG7Ny{v-&*f=IsGhNGC~zz-3qIlfA0Yj<#76-?&zDgrDeN{kvHo4{UVzW|f$XK3H{ zv)(-5XBPkt<r(O^O06D}MgBv4BZk>nZilf63cxH>MI2#;?IrZKlL;rr9 z=!O9Zw@_Rfz$RYAN8RHuIEb8Yi8%qYF79QGK!^AkID;5Uio_&v=&aG1+Jn=p_vgFB zj(ZqKPCq6*`b(v678>^_5TI03s@Tb2ROA8+9IDF3Sdje9PJ6W zM$61#DS2fo+j-;~i;|nvh#*(-eF9j09OHx&fiW;_TEj1VQuw9Y#-PvO3CG?sHzXUc zdcZa>%CA`|I*O%Bn-18X%|4fYv+b`B0Wf4vV)qTsN8Al4oIj{vJNIIHBW*(ewoYQM zak(?K-|CPrH?2bwWk)_2{2zh#s*tgl4m30-I|uKh^y|hWbc*+GWAkm>mnV!{TR(%- z!B_6NwRK2rwhrt0zyv&9n4aznU&bH0lP249u0EWHb$51W>)`^+SIaw_raY|-{_xh9 z)Z@uppDM^P9y`BN4CfDT^WA|DV`C;Y{PxS(dUsD-0qx#gO_>BHODa(Vsse%xlK zV9>qQXZ2WJ+@{k-^l1)P3UoJmtiy=R?&d=em%oDp4iQj2*Kz$v-?I)MpX=VPf1jG> z!k=5b{-b}P+JE%-6l1*?UCF{9**L%;wGJ@51jFs=qROyonNLtW{EKvMVmF@Ts4j?Q zbjp}cV@zrV%E+|4U1md#6eCt>_9PFst_MpWus`tijrX8;yw`89s{!N4N;QWV@N+ca zU->Zx4D*Qm(_=p1j5&cV#Ban@{l1Wh=XuTCNx1CQ=VF-Opr^A?Bi)p?7dMdyv~>vP^{SEl_&TyT_P zc5u%+C^Fw^tzz&n`d)07L-bFJZ!wrZTYbY!_t7DWCJy{GtJ9WQ&6YDTuUJ!b{71H`mIeQMbypt!pc`h{z!aOSu1JzmGZi5X6%yE=q9O=S%^Cj5}L(o;568!E$ ziA#pcrVOMa>p2Cm>A&zMBLs0>EfM--Odn;^s6se8V|2RQTMi~_;m-N{O1SI=)X_TB z_TlTspJQLl16V?jPIMmQD{0@3LuGg64NyrO171^+pC4I#U^`FO%P!M4f~LKa|B>)w{XwMIcB{Pf@k7jLc3xDk)ZbYU@AZ6vX!v*z zY~w=XQlYkD-ul?~%I(6fFBJak%B`Kvw+a`$K)J?zq`e-KkJA0){Acs1tH42Df%g{} zY}E2+um9*T|G&45BZCujhub!fT8FJeJ6ngWZtJk|%JbIYt+y_H5Rk3^{o>aB*r>!j zx6x_g%=x(v9Ke9>O4on*eXHv@RNDG05Y#{uoOK?D%&XS<5Q)5UgVYd|G&wIHvJ^?b zDwz%e209a}tK;X6UK1aUA*VPI}@7=tI*$r*(n!v0;f<960Y$;Uy5D|lQT;3rN|Ooa-p0d1sX zb^6>Dpi+=2iiczmfi^!4k!Fh{1PNrv@uE|*5rD3Gpt}%Y z!nDc=js~UGx(i){5M)9ks3_Z|og2!;7x&?s^##O{vEYVlZ?czf-RNGPU)p&t_iM}Z zjeB|ZPIuA4-n;l&4paOF+fZa_Z=TI>9+q#@9byxaw|X2q0;fCbZ><^Uh3M=o?%dct zfy)fqUMMx*UYtAd7zu-a2U>TjL*f<|rw>ULh1@HjT zc2@;AlshL~HU%a|Q^!uB6FiFu(ZPrEWb(`z(|3hg1uUdu_Vtb9!2BSO3oIkvOGsEx zZeeC^=a1rQSBI+kQpnWWk1JleQEHQJ`qHpd5#bc@ip$gbDDPQXc2cePT3viUU9eKg z0_TuUc`j~-ABzVC{BvCws}iNgJ6&bTHL_t?>Xto?+7PdMEV^lsX95ki)A+bF--$;T z_&|k~i~pQtU6ovx#p!a1PILZ%%XM@!{!4PWo;zRcVrM~knC?VHu80-zG^yM&82`Nt z3Zz_}_k=o5k|Q>n&mUHk+H|~y6bjx#8u(3NjdTu16Nu3IbUkT9Z!~b|JlCU>z55S5 zp8yuAR_8^6`)~|ZzvmnVuE2dpfh6!&5xr4_lL)+2->aOh=FA0U*4rVt23Hh_`&~)G zoP;t=mYUB(lzN-@wsJAOwY2$YIR4yfyC;A2Zc>zHns)cOk%oc5hGH&H)8sNJPpXM+ z+RY|4H*Fl?I+}Mba59m_=Bk~YJr1mu@l7Vk*&M>P(8T$+YjC>SA0W?iZoCe4&@`+$ z?uT>xO~5i_f{Q;OT6$>DYRgb$u9jPOY-tLTx=*fG9WNraQwCxl&5)umzF<;r$RGaZ zN>r1pPZ*aLf(wagloMau&AQd+UCvZ-$;~u!jdKB26O%h0rte7c~oxGW~ zVC0)TjQ|UTHQ`|lyF5V2S;20vq{{^gn=j-cP~vDF@a0@pog+jcZ9?vFR!d=wUiojX ziuTg(oB7jlzTT;GlRY4mdur?^9E zEi9&`eiDVcpd4}KFkeZn{5beIfytjlS{jcDwamPrzDNdYbI zf#wG6W$9pjMGj?BoLFQNx$aEee@+d^5e4=tMa!}Ti`XZF&wfec&YjRgf(LRE0w5sr zgW>MF&fASREA=YaJ)lJ;_nfJbD^md!F=boesw5QG z*TNrnXQ+iXm<&k1B^8Q9Az4g~CCxrs zH%-a|?f=MAyV662V)iiGl~q(6Q_YT@COaEyazH!=y&;1Tly z3W^^6&nZkj_3424X!qYFXdpp|FYh+QTYGD8GH3z2NxF=iV9oGV31vYC8!t*ggCy#s zzeN7&)djnDYFjkYN0fZ$QQnx2v=f?DE!6CoXoOD-+L=*Q%*;9-9l|5C?07VeM`GOZ zDDK`xBG`94I*LbPgYoD|Jc)5VLf?g7A0MH%@QL4sBZGKrSA0J{LfP<5y$?sIS&;_fqm)x*g5d~t!I1^xquf2W zcrYBHo;h+sd^Acpg1Viw;Ru1nkr?8mRK_hg3`b~C6(v2yM=8IOA#hC?UbOfSAEk^W zKIoKT2A>EM@lgd1c^!_>FiEtCk1Al$%W#xNNYX}pRKbB>h5>uR1(rK}%wLNgprOtlnjTF*q&11DN!SmK^> z&iQGLceryVD8P7fsz4`QbB!{vKv>LSBMR-l(OKOvnbU!`0Uw>&_KA~D-(-rx9BtjJ zl|&j;KW2d5MCk2Aq18&R}|a z9f>&KY2LiDu=@0g-gX+sm}CcQUvUlKZu(CGkU*|o*AmpHDj=r-bQgVM$kKi1_Ndlv zurd>EnoUNMW;3HBnd$9PKm%MTq~7`=>{O^7>GGxE>(_ar3u};gG>q3l1y>gAE(PNk zcd5xxdKW!P)-cB$1tp>vow=n#_tEg$)4(+dWYmKbX6^}0r2c9G|3Qxd>h<|63+5{Q zAZluUuF95ACy~=2V z2TM{9VTWFHdJ@`wvw$|}u(6<7aNr<#zk+#KH=oiScFzf~$o5`7xNQqS9$Te>HWKy9XvzXLE44*`!@U#xu-S1 zvXSBT zUN0=vYGUNY{xkF0wWn2|+-!(Rg!4v zpGSPWlNq(IPeKUz7tkOF3?Bi9XEH9ZmXBxh74XJP^$c@*yZ8@O0^26Eufg8~p{1`$ zc(rfxvrSObXsJnnY-cVzjRtYN6HCB9mhc+fYO}O#R!wg6CrWS)?z|slES2cqE74bw z%uQHjMg6!!YkP2)JPgCh@;b%XA6t%fdZ4YHgle8nx&{&~FcDw&$_-vAk2?7iE85-# z0Guqr<9CEzWy99ulOGJWutD_8OU_@Dw9A@Xu(a#+wdH&|S%QaSPiMQ?Y9K!e^9iJD z5`3MZz3$P2y18Zl*8qc`1X=hl03a(>yqI?ojcL(peba!O}-wRj)hAsxVD6J%E$5B$y8$cETOIliC%ut~-~ zL`ohw%{g+4%|5p221Xri!4d0@Is=vrLHK5eppg3*@AQYu(u2xMw-QmWBKU4Ub0+&u zOH!7H^UGxNwIFfm@Bi`)r8(aJLMj4?u zuOTStb;ks?o6g1%^u+EJnP%PIW(f;w@54?PsO6IgCCrtph(dB4*c1eWlW4LCQs_Mk z59xw=+&s5%b?v=odhO~{YggyV8%#$M;PzGg4ATz|Dm#hoU6GU6R*Ih}{lv_6{8Aq5 R-Ne?@5&9WLZ?L}F{~vxk8}tAG literal 0 HcmV?d00001 diff --git a/library/VIRTUAL.TEDIT b/library/virtualkeyboards/VIRTUALKEYBOARDS.TEDIT similarity index 100% rename from library/VIRTUAL.TEDIT rename to library/virtualkeyboards/VIRTUALKEYBOARDS.TEDIT diff --git a/library/virtualkeyboards/XKEYBOARDS b/library/virtualkeyboards/XKEYBOARDS new file mode 100644 index 0000000000000000000000000000000000000000..8442d293fa20be5da3070a98e4e935fad0e3ad5d GIT binary patch literal 17050 zcmd5^Ta#2*6&B0lfgh1t5JxtKhCb)?B_U);&-9t0p{IN3?g0i%2?#2JqC<#cCjOU@ zSWy!auws=OO}yZxOsddS-jxTfiZ9lAu}brB{MOq03^U^l=R5i$Rhdnw_3gFx+L!gM zwf7m2Lbyna((s zsJ?I4uAMua_Av{=N!pb?(yAT1ex(-I<3#FD9Ezet_4*#!`HAOGEu`Iky8Oc7E0@l% zoLjju{oJLMXRn{Ta{1zo^HgCvhtP7YyUQTv@@7b$F<2&+{w;pEDt)F9WIRb!NOf`ag_NjO2{CZ(?x}cFv0XvK(V1yYN-C zDxclorw2V|NPo)dRnmKZDM#a)sfBY9NZ1?e)9J#n9xSw`}h zxG%|3MiTpawXrHMbK{5fvoc}&?Th=W3>Zo5ne#HkNaBE4kr5-gDDH~%8Oamkj>ti7 z^f+(6CW}n3IHj-3kdd5-yCKVr;uD0Sj>XBzsmx*190r**?ZQ1 zpY4Bu+{;In-?LMRIGktqOwEv0Gc+yWd%s|{Acp7JpG?bHRtutep4~Le9u|YBo@akB z%p!|He9yBV7$&AMAwNJ$@mtmhJ_$k6@*5U`10&D=Y?eL4S~fX4N_7n&bNLmm=Tu17 ze#s(0Nb>BqSypE)1KG&4mkskt76aOmXLk$}u^6zAJo~O;9E$-D$+H&?vzx_$k$gmD zTnO?ZBL*}3HtS;LFs~v%r^4m);{G9jgeK;h(~QPN8J-DmPH@DdeJW zal#-}@5vEP7L?@zJg&rmvKptsMab(3N6BMvUx)mCR$dosHQwd0T#Ie3k-B_|J1pAb zz`45-QF-ysr=tZU_2B7w_80V)XBRj2xeZ%auKv))i)s9bokmRov2MBZz^RkZ%ICNl zH1}4aCf>bUlC$dWMf?GuD)E&=QqXAaj~bC^Q;*6QfkRGUkeI13IAjAV-SP@zMgew~ zDQJ3|nuJZ*Tn1?|^(+TQuhQ+<6eKaB094x)G`vj>0)m5CAx*C(Vzhv08^mjg7%iA% zgLr2}jI%(Q4brl)L@i=0V9W+-dq|srfH*6pRX0dnCm^6d2Js$?8IOU{8YJ;r5<&|I zt&PP)A_f9JYg)XMW5&s#vj*`_ju|JfF;nU=a-gNEq3s=9HXAr*`6J|4lE?)D# zWrhHvXbQZe62?*Bi3ai0kucK%nrINeO%i6CfF&xV=|>(hBj56@uY3;oCb(l-D_%|Q z72NnR@!u*^4~uf*s_-CjRfv!laA_taxFWQRAXGbi4$FNDiK)1C z*_fv>NV^t1pOQv|XdW|5OsT;g z>ojUNDS%cz&4@(7YgX5SP;48kZQyMU1Cf6UZaP4E3i3Wt5z;`|7fXBv{QoD$AJFguU#h1 z)_&~w$0%P|@O#ty0cS9?roa--6MjrB&bAOQZCD`4);36}#>`vt24x)hsCQlPIA}66 zCU8=3QdqeSZsmfUDh!0#8t!ZcJvCjepo?5fpr{6m!pM-AF(U&_RahLfq22cIdr-^7 z)0ooIjhp%m7_f2!P;+fKPb--*gPQ(qi8qI)%6xdCGbt*T-mgUzVjT4FYKANLNrXwV z&g)Fb2|U^Zn1eb{X%AqI7G={1y+xSV@^zq98SOpB9`BUStrld?TkkOfGtqlsDQlDx zr)1gsaRt|CJlJxjm?Dx_3Z8B)sMm?tHV$$94ZoesYZ9)A=0%`vQj=E%^8!VMS69UH zb^N!~VMQQc#{)|-A&Tq9v?W7PPKPu4HSf0aXzCDwZ+YSJ5`YVlHwq~NchI;HdSe_j zqw>XAMBG5+BPyzCy~MU`!Cp~cA~p*`)a!om)BzPjQykWOOoa;9TLeq1q_Jr43vzmF4&+hCYQ z6o!>*D|3ng6{4{24Mmajjc9z+=739hMI*9ypWt~j<#)v5_st-3j*BR)bzkTq7dqlF zSyK{+_)BIxkhOO~e!=J^y;nQ zBd)5tR-N`LeddyIMLA$K-S$Y&9TJrFC}TtJ9b?kWScVJ3J0Lhe#itOI3ecJ#Tjy+q z3CVT>&*8Hf=8G7xo9}r0$s-EX=4W^=M0M^{Y`*cG-_;Gvs?0(;_>rV z9}A5aJA>Z1$eQWr*PeJ(e7yMobEy=vF6u@0g}9M(_Fa|eTa|Y=zpJXgv?rZG7vBWdMoZ)IgKN?TwoMan z4N$BrPwUrzCa2tfw>-u9bPcFwC42*-Z{DcMcmPytuf~EuqCs>jORd(R_>1l}1tSqf zgLAkN7#V_sl_{eE>#u}HwqUBw$>7G>{EHJvf#K14nQcH8H6?buHz_Kd2N*_Wg*i1$( zv=UgKL@C((jDlq)us)6gSQB5op;QIk~0G+u|FjL?tkC1O;n#2MzNmcKx38S;G<0FH0-Vlx7XM%_G0F zexOvTo0^J1js_R(m4*u@r(kSiG$<3V1D6vz+)v`y9nAJSqZHe!I~+`Ahl|Uo{@O2& TSm@w{LQPhGkHUB|T-^0 Date: Sat, 28 Oct 2023 14:34:25 -0700 Subject: [PATCH 36/37] Patch TEDIT.DEACTIVATE.WINDOW in old Tedit (#1361) --- library/tedit/TEDIT-WINDOW | 225 ++++++++++++++++---------------- library/tedit/TEDIT-WINDOW.LCOM | Bin 56543 -> 56474 bytes 2 files changed, 114 insertions(+), 111 deletions(-) diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW index 5fb985f9..062703fa 100644 --- a/library/tedit/TEDIT-WINDOW +++ b/library/tedit/TEDIT-WINDOW @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 16:55:53"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-WINDOW.;1 180402 +(FILECREATED "20-Oct-2023 21:46:58" {MEDLEY}tedit>TEDIT-WINDOW.;7 180689 - :PREVIOUS-DATE "14-Jul-2022 11:08:01" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-WINDOW.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS TEDIT.DEACTIVATE.WINDOW) + + :PREVIOUS-DATE "14-Jul-2022 16:55:53" {MEDLEY}tedit>TEDIT-WINDOW.;5) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) @@ -1631,113 +1633,114 @@ (DEFINEQ (TEDIT.DEACTIVATE.WINDOW - [LAMBDA (W FORCEFLG DISCONNECTONLYFLG) (* ; "Edited 16-Oct-2021 18:51 by rmk:") + [LAMBDA (W FORCEFLG DISCONNECTONLYFLG) (* ; "Edited 20-Oct-2023 21:46 by rmk") + (* ; "Edited 16-Oct-2021 18:51 by rmk:") (* ;; "Deactivate the various button fns for this window") (PROG [(TEXTOBJ (WINDOWPROP W 'TEXTOBJ] (* ;  "Can't be a call to TEXTOBJ, since window may NOT have a textobj on it.") - (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T) - [COND - ((AND TEXTOBJ (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)) - - (* ;; "If something is going on, DON'T CLOSE THE WINDOW") - - (TEDIT.PROMPTPRINT TEXTOBJ "Not closed; edit operation in progress" T) - (RETURN 'DON'T)) - ((AND TEXTOBJ (PROCESSP (WINDOWPROP W 'PROCESS)) - (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) - (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - (NOT FORCEFLG)) (* ; - "This is an un-quit TEdit window. Try to QUIT out of TEdit.") - (COND - ((\TEDIT.QUIT W T)) - (T - (* ;; "Always return DON'T: If we didn't quit, we don't want to close the window; if we did quit, the window is closed already, and will be reopened to reclose it.") - - (RETURN 'DON'T] - (COND - ([AND TEXTOBJ (OR FORCEFLG (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ) - (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - (NOT (PROCESSP (WINDOWPROP W 'PROCESS] - (* ; - "Only do this if it's a TEdit window, and has been QUIT out of.") + (CL:WHEN TEXTOBJ + (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T) [COND - ((AND (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ) - (OPENWP (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) - (CLEARW (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ] - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) (* ; - "Before the window is closed, make SURE that the caret is down, or the window will reappear.") + ((fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) + + (* ;; "If something is going on, DON'T CLOSE THE WINDOW") + + (TEDIT.PROMPTPRINT TEXTOBJ "Not closed; edit operation in progress" T) + (RETURN 'DON'T)) + ((AND (PROCESSP (WINDOWPROP W 'PROCESS)) + (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) + (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) + (NOT FORCEFLG)) (* ; + "This is an un-quit TEdit window. Try to QUIT out of TEdit.") + (COND + ((\TEDIT.QUIT W T)) + (T + (* ;; "Always return DON'T: If we didn't quit, we don't want to close the window; if we did quit, the window is closed already, and will be reopened to reclose it.") + + (RETURN 'DON'T] (COND - ((AND (\TEDIT.WINDOW.TITLE TEXTOBJ) - (OPENWP (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ)) - (OPENWP W) - (EQ W (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) - (NOT DISCONNECTONLYFLG)) - (\TEDIT.WINDOW.TITLE TEXTOBJ "Edit Window [Inactive]") + ([OR FORCEFLG (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ) + (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) + (NOT (PROCESSP (WINDOWPROP W 'PROCESS] (* ; + "Only do this if it's a TEdit window, and has been QUIT out of.") + [COND + ((AND (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ) + (OPENWP (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) + (CLEARW (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ] + (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + NIL NIL) (* ; + "Before the window is closed, make SURE that the caret is down, or the window will reappear.") + (COND + ((AND (\TEDIT.WINDOW.TITLE TEXTOBJ) + (OPENWP (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ)) + (OPENWP W) + (EQ W (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) + (NOT DISCONNECTONLYFLG)) + (\TEDIT.WINDOW.TITLE TEXTOBJ "Edit Window [Inactive]") (* ;  "Reset the window's title to a known 'inactive' value") - )) - [COND - ((NOT DISCONNECTONLYFLG) - (for PANE in (REVERSE (CDR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) - do - (* ;; "Run thru any split-off sub-panes, and reattach them, so we get a whole window back before the end of the world.") + )) + [COND + ((NOT DISCONNECTONLYFLG) + (for PANE in (REVERSE (CDR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) + do + (* ;; "Run thru any split-off sub-panes, and reattach them, so we get a whole window back before the end of the world.") - (\TEDIT.UNSPLITW PANE)) - (replace (TEXTOBJ \WINDOW) of TEXTOBJ with NIL) - (COND - ((type? STREAM (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) + (\TEDIT.UNSPLITW PANE)) + (replace (TEXTOBJ \WINDOW) of TEXTOBJ with NIL) + (COND + ((type? STREAM (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) (* ;  "Close the file that this window was open on.") - (COND - ((NOT (WINDOWPROP W 'TEDIT-CLOSING-FILE T)) - (CLOSEF? (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (WINDOWPROP W 'TEDIT-CLOSING-FILE NIL] - (WINDOWPROP W 'TEXTOBJ NIL) (* ; + (COND + ((NOT (WINDOWPROP W 'TEDIT-CLOSING-FILE T)) + (CLOSEF? (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) + (WINDOWPROP W 'TEDIT-CLOSING-FILE NIL] + (WINDOWPROP W 'TEXTOBJ NIL) (* ;  "Detach the edit data structures from the window") - (WINDOWPROP W 'TEXTSTREAM NIL) - (WINDOWPROP W 'LINES NIL) - (WINDOWPROP W 'THISLINE NIL) - (WINDOWPROP W 'PROCESS.EXITFN NIL) - (WINDOWPROP W 'PROCESS.IDLEFN NIL) - (WINDOWPROP W 'CURSOROUTFN NIL) - (WINDOWPROP W 'CURSORMOVEDFN NIL) - (WINDOWPROP W 'BUTTONEVENTFN 'TOTOPW) (* ; "And the button functions") - (WINDOWPROP W 'RIGHTBUTTONFN 'DOWINDOWCOM) - (WINDOWDELPROP W 'CLOSEFN 'TEDIT.DEACTIVATE.WINDOW) - (WINDOWPROP W 'SCROLLFN NIL) - (WINDOWDELPROP W 'RESHAPEFN '\EDITRESHAPEFN) - (AND (NOT DISCONNECTONLYFLG) - (WINDOWPROP W 'PROCESS) - (\TEDIT.INTERRUPT.SETUP (WINDOWPROP W 'PROCESS) - T)) (* ; + (WINDOWPROP W 'TEXTSTREAM NIL) + (WINDOWPROP W 'LINES NIL) + (WINDOWPROP W 'THISLINE NIL) + (WINDOWPROP W 'PROCESS.EXITFN NIL) + (WINDOWPROP W 'PROCESS.IDLEFN NIL) + (WINDOWPROP W 'CURSOROUTFN NIL) + (WINDOWPROP W 'CURSORMOVEDFN NIL) + (WINDOWPROP W 'BUTTONEVENTFN 'TOTOPW) (* ; "And the button functions") + (WINDOWPROP W 'RIGHTBUTTONFN 'DOWINDOWCOM) + (WINDOWDELPROP W 'CLOSEFN 'TEDIT.DEACTIVATE.WINDOW) + (WINDOWPROP W 'SCROLLFN NIL) + (WINDOWDELPROP W 'RESHAPEFN '\EDITRESHAPEFN) + (AND (NOT DISCONNECTONLYFLG) + (WINDOWPROP W 'PROCESS) + (\TEDIT.INTERRUPT.SETUP (WINDOWPROP W 'PROCESS) + T)) (* ;  "Make sure any disarmed interrupts are restored.") - (for MENUW in (ATTACHEDWINDOWS W) when (AND (WINDOWPROP MENUW 'TEDITMENU) - (WINDOWPROP MENUW 'TEXTOBJ)) - do (* ; + (for MENUW in (ATTACHEDWINDOWS W) when (AND (WINDOWPROP MENUW 'TEDITMENU) + (WINDOWPROP MENUW 'TEXTOBJ)) + do (* ;  "Detach all the TEDITMENU windows that belong to this window.") - (replace (TEXTOBJ EDITFINISHEDFLG) of (TEXTOBJ MENUW) with T) + (replace (TEXTOBJ EDITFINISHEDFLG) of (TEXTOBJ MENUW) with T) (* ; "Mark it finished") - (WINDOWPROP MENUW 'TEDITMENU NIL) (* ; + (WINDOWPROP MENUW 'TEDITMENU NIL) (* ;  "And mark it no longer a menu window") - (GIVE.TTY.PROCESS MENUW) (* ; + (GIVE.TTY.PROCESS MENUW) (* ;  "Then give it a chance to kill itself off") - (DISMISS 300)) - (COND - ((NOT DISCONNECTONLYFLG) - (GIVE.TTY.PROCESS W) - (DISMISS 300))) - [replace (TEXTOBJ \WINDOW) of TEXTOBJ with (COND - ((LISTP (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ)) + (DISMISS 300)) + (COND + ((NOT DISCONNECTONLYFLG) + (GIVE.TTY.PROCESS W) + (DISMISS 300))) + [replace (TEXTOBJ \WINDOW) of TEXTOBJ with (COND + ((LISTP (fetch (TEXTOBJ \WINDOW) + of TEXTOBJ)) (* ; "It's a list; remove this window") - (DREMOVE W (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ] + (DREMOVE W (fetch (TEXTOBJ \WINDOW) + of TEXTOBJ] (* ;  "Disconnect the window from the edit data structures as well.") - ]) + )))]) (\TEDIT.REPAINTFN [LAMBDA (W) (* ; "Edited 30-May-91 23:34 by jds") @@ -2726,25 +2729,25 @@ (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS TEDIT.ICON.TITLE.REGION NIL)) )) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7116 90052 (TEDIT.CREATEW 7126 . 9899) (\TEDIT.CREATEW.FROM.REGION 9901 . 10881) ( -TEDIT.CURSORMOVEDFN 10883 . 20782) (TEDIT.CURSOROUTFN 20784 . 21327) (TEDIT.WINDOW.SETUP 21329 . 23154 -) (TEDIT.MINIMAL.WINDOW.SETUP 23156 . 30934) (\TEDIT.ACTIVE.WINDOWP 30936 . 31929) ( -\TEDIT.BUTTONEVENTFN 31931 . 55639) (\TEDIT.WINDOW.OPS 55641 . 58853) (\TEDIT.EXPANDFN 58855 . 59418) -(\TEDIT.MAINW 59420 . 60717) (\TEDIT.PRIMARYW 60719 . 61880) (\TEDIT.COPYINSERTFN 61882 . 62678) ( -\TEDIT.NEWREGIONFN 62680 . 65196) (\TEDIT.SET.WINDOW.EXTENT 65198 . 70741) (\TEDIT.SHRINK.ICONCREATE -70743 . 72944) (\TEDIT.SHRINKFN 72946 . 73505) (\TEDIT.SPLITW 73507 . 78972) (\TEDIT.UNSPLITW 78974 . -83830) (\TEDIT.WINDOW.SETUP 83832 . 89655) (\SAFE.FIRST 89657 . 90050)) (91382 92293 (TEDITWINDOWP -91392 . 92291)) (92330 95120 (TEDIT.GETINPUT 92340 . 94400) (\TEDIT.MAKEFILENAME 94402 . 95118)) ( -95169 101597 (TEDIT.PROMPTPRINT 95179 . 98114) (TEDIT.PROMPTFLASH 98116 . 100025) ( -\TEDIT.PROMPT.PAGEFULLFN 100027 . 101595)) (101832 105804 (TEXTSTREAM.TITLE 101842 . 102467) ( -\TEDIT.ORIGINAL.WINDOW.TITLE 102469 . 104391) (\TEDIT.WINDOW.TITLE 104393 . 105047) ( -\TEXTSTREAM.FILENAME 105049 . 105802)) (105847 147324 (TEDIT.DEACTIVATE.WINDOW 105857 . 112821) ( -\TEDIT.REPAINTFN 112823 . 115671) (\TEDIT.RESHAPEFN 115673 . 120517) (\TEDIT.SCROLLFN 120519 . 147322) -) (147366 149497 (\TEDIT.PROCIDLEFN 147376 . 148671) (\TEDIT.PROCENTRYFN 148673 . 149118) ( -\TEDIT.PROCEXITFN 149120 . 149495)) (149576 160542 (\EDIT.DOWNCARET 149586 . 150255) (\EDIT.FLIPCARET -150257 . 151776) (TEDIT.FLASHCARET 151778 . 153059) (\EDIT.UPCARET 153061 . 153486) ( -TEDIT.NORMALIZECARET 153488 . 159185) (\SETCARET 159187 . 160115) (\TEDIT.CARET 160117 . 160540)) ( -160576 174370 (TEDIT.ADD.MENUITEM 160586 . 162877) (TEDIT.DEFAULT.MENUFN 162879 . 171849) ( -TEDIT.REMOVE.MENUITEM 171851 . 172848) (\TEDIT.CREATEMENU 172850 . 173287) (\TEDIT.MENU.WHENHELDFN -173289 . 174055) (\TEDIT.MENU.WHENSELECTEDFN 174057 . 174368))))) + (FILEMAP (NIL (7098 90034 (TEDIT.CREATEW 7108 . 9881) (\TEDIT.CREATEW.FROM.REGION 9883 . 10863) ( +TEDIT.CURSORMOVEDFN 10865 . 20764) (TEDIT.CURSOROUTFN 20766 . 21309) (TEDIT.WINDOW.SETUP 21311 . 23136 +) (TEDIT.MINIMAL.WINDOW.SETUP 23138 . 30916) (\TEDIT.ACTIVE.WINDOWP 30918 . 31911) ( +\TEDIT.BUTTONEVENTFN 31913 . 55621) (\TEDIT.WINDOW.OPS 55623 . 58835) (\TEDIT.EXPANDFN 58837 . 59400) +(\TEDIT.MAINW 59402 . 60699) (\TEDIT.PRIMARYW 60701 . 61862) (\TEDIT.COPYINSERTFN 61864 . 62660) ( +\TEDIT.NEWREGIONFN 62662 . 65178) (\TEDIT.SET.WINDOW.EXTENT 65180 . 70723) (\TEDIT.SHRINK.ICONCREATE +70725 . 72926) (\TEDIT.SHRINKFN 72928 . 73487) (\TEDIT.SPLITW 73489 . 78954) (\TEDIT.UNSPLITW 78956 . +83812) (\TEDIT.WINDOW.SETUP 83814 . 89637) (\SAFE.FIRST 89639 . 90032)) (91364 92275 (TEDITWINDOWP +91374 . 92273)) (92312 95102 (TEDIT.GETINPUT 92322 . 94382) (\TEDIT.MAKEFILENAME 94384 . 95100)) ( +95151 101579 (TEDIT.PROMPTPRINT 95161 . 98096) (TEDIT.PROMPTFLASH 98098 . 100007) ( +\TEDIT.PROMPT.PAGEFULLFN 100009 . 101577)) (101814 105786 (TEXTSTREAM.TITLE 101824 . 102449) ( +\TEDIT.ORIGINAL.WINDOW.TITLE 102451 . 104373) (\TEDIT.WINDOW.TITLE 104375 . 105029) ( +\TEXTSTREAM.FILENAME 105031 . 105784)) (105829 147611 (TEDIT.DEACTIVATE.WINDOW 105839 . 113108) ( +\TEDIT.REPAINTFN 113110 . 115958) (\TEDIT.RESHAPEFN 115960 . 120804) (\TEDIT.SCROLLFN 120806 . 147609) +) (147653 149784 (\TEDIT.PROCIDLEFN 147663 . 148958) (\TEDIT.PROCENTRYFN 148960 . 149405) ( +\TEDIT.PROCEXITFN 149407 . 149782)) (149863 160829 (\EDIT.DOWNCARET 149873 . 150542) (\EDIT.FLIPCARET +150544 . 152063) (TEDIT.FLASHCARET 152065 . 153346) (\EDIT.UPCARET 153348 . 153773) ( +TEDIT.NORMALIZECARET 153775 . 159472) (\SETCARET 159474 . 160402) (\TEDIT.CARET 160404 . 160827)) ( +160863 174657 (TEDIT.ADD.MENUITEM 160873 . 163164) (TEDIT.DEFAULT.MENUFN 163166 . 172136) ( +TEDIT.REMOVE.MENUITEM 172138 . 173135) (\TEDIT.CREATEMENU 173137 . 173574) (\TEDIT.MENU.WHENHELDFN +173576 . 174342) (\TEDIT.MENU.WHENSELECTEDFN 174344 . 174655))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index 4ce1b6a0dcb562391981e72e2d25d79d35d3e652..192e965ad1372ce75c03f8ca71d31f2ebc40cfb0 100644 GIT binary patch delta 1697 zcmZuxOK;p%6wad{br4bz2?~M5(FoK8X$Iey?J zRBMEH&Kgvs3@EXiJbJxpY(cF)??<@B zxy6h++#VcF9gjZ0KRA8U%6=TY`e7e~bW-1kdADY>S%<@0XPD&w;&E2rs%>^WU$$du zE9t<6q_bk@i@Rn3F*V(6fh8SJHFox4aQ9QFS#8%2c4g8~A#8Sn1gl!7TVO@8-1EXT zX*iex>V!9Le0H3xL4lwY!V;_wwfPK-Vnmmo^@o37Sy))!{%8SzwfynY;(~kl)8nOk z&*yLbRqYSAu%5nmzUrP7*bDiy@L1Wtn%hsC#ozfGW2!dVD6K!Ol~4Zt!5-<`{UZ4J zU-sy&DGAUT{eHZ+WNR&OyrkJo%dqw4aM<2z=8KvGYyi+_f!w4VF1pmj1!st zvb(X4PGKa2UIY|3cVcR0w({HBkZJ@D5;yE6(#L%em`mDm4~Q}KBB=j(N+KYr#>Iva z?Ekog_ft>dAkEl1t&maOvRVw-jZ~Cf|Mj_V2kS%ADDkcgQXIVeZ9I4=$kawD3h$Cd z&DjabPsSc3&r#Zfp**=du}oY$lAQnq_*n7)c#8rq zM6ng^unQb3jlEr0?W9VD0XlI*fC^O@_0ZIy#8Li0<%hz6b{Z#PobQU0BdBJHglWOZ zds^;b)5Dt+DJ~~CJY!7W^a`4WSzIsiy+8uPqH-evW|ZCm_E~i36?!PU3(EF zn8?9s_TcoDAu(XWpVNxrtuP@{Y~s}BbNHOj1dEt(2(I|l*7?lFWuD@=HHG~S-X{e2 sb#hSjzU0W4Fxb^rhX delta 1800 zcmbVMOOM-B6rPz>NSy@&G0>I*Ix<4Ei&(z*`kA6IX?&+~actwqxK*d1bP}efZZeak z3>89=_yr(~O?R+j+YUnNf+dTxV$FuXz?Kyp$8l!rVbv_0L}$>kl4G2IEQdUT;6`4V&p` zx0g2W5BllgArqD6;b?p>8Sd2!q?x&^Z_UVMSQnma!5YM9NSXk5#)D;#!I%5v$$JeL zj;4391SHsVE3$1knJS8+0R7$+IsIQvLWRrgm$odMw|(9Uxd{TveqB9BUXVEuU6LgV z4bSJ>mKz0i6RTERlZK=>B=SNErOBOfZ~U-1930|DCDSI7w!(UBIi`Ci7O&8we^&oZ zgg?)$tkgF5R`9o;KVDs3>AaL1$%fSF|M+Nnb&&qTakADXfOS2ZIco(t)OcK0ceE6HEWxTVR%#Ye7DVW zP*T8)!a2hjK@U`2hLGO~-K*C@)v_Pljhd>m?4b3UsmdCdKJU8Q98{t#E31-vy0T(O z&pFWXNx-lUl7dfbUUpiEhsRGPbIlrY!{I&K_r+)QNJwt35s zaZ#3O1dm}cEFLbeQ8^_d=_QkoBP)bl*?f^ED$%EN95;Ph$UL4jTAc|GaR4=#&1~jFoIn=R$yBW2N_A_MgYtx Date: Sun, 29 Oct 2023 10:00:59 -0700 Subject: [PATCH 37/37] Add dribble file to app-from-full loadup (#1371) --- scripts/copy-all.sh | 4 ++++ scripts/loadup-apps-from-full.sh | 4 +++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/scripts/copy-all.sh b/scripts/copy-all.sh index f04a5e7f..547f81d8 100755 --- a/scripts/copy-all.sh +++ b/scripts/copy-all.sh @@ -22,6 +22,10 @@ fi ./scripts/cpv "${LOADUP_WORKDIR}"/lisp.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g" ./scripts/cpv "${LOADUP_WORKDIR}"/full.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g" ./scripts/cpv "${LOADUP_WORKDIR}"/whereis.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g" +if [ "${1}" = "-apps" ]; then + ./scripts/cpv "${LOADUP_WORKDIR}"/apps.dribble "${LOADUP_OUTDIR}" | sed -e "s#${MEDLEYDIR}/##g" +fi + ./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS library | sed -e "s#${MEDLEYDIR}/##g" ./scripts/cpv "${LOADUP_WORKDIR}"/RDSYS.LCOM library | sed -e "s#${MEDLEYDIR}/##g" diff --git a/scripts/loadup-apps-from-full.sh b/scripts/loadup-apps-from-full.sh index 86a59d47..7db94018 100755 --- a/scripts/loadup-apps-from-full.sh +++ b/scripts/loadup-apps-from-full.sh @@ -28,8 +28,9 @@ cat >"${cmfile}" <<"EOF" (PROGN (IL:MEDLEY-INIT-VARS 'IL:GREET) - (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE NOTECARDSDIR))(QUOTE |/system/NOTECARDS.LCOM|)) 'IL:SYSLOAD) + (IL:DRIBBLE (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.dribble)))) (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE ROOMSDIR))(QUOTE /ROOMS)) 'IL:SYSLOAD) + (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE NOTECARDSDIR))(QUOTE |/system/NOTECARDS.LCOM|)) 'IL:SYSLOAD) (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE CLOSDIR))(QUOTE /DEFSYS.DFASL)) 'IL:SYSLOAD) (IL:LOAD (IL:CONCAT (QUOTE {DSK}) (IL:UNIX-GETENV(QUOTE MEDLEYDIR))(QUOTE |lispusers/BUTTONS.LCOM|)) 'IL:SYSLOAD) (IL:LOAD @@ -43,6 +44,7 @@ SHH (IL:ENDLOADUP) (CLOS::LOAD-CLOS) (IL:|Apps.LOADUP|) + (IL:DRIBBLE) (IL:MAKESYS (IL:CONCAT (QUOTE {DSK})(IL:UNIX-GETENV(QUOTE LOADUP_WORKDIR))(IL:L-CASE (QUOTE /apps.sysout))) :APPS)