From 1b49bf1df342d5fec95e2291c38188468d19d16c Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Thu, 11 Sep 2025 20:58:35 -0700 Subject: [PATCH 1/2] Hardcopy to printer --- sources/COREIO | 71 ++-- sources/COREIO.LCOM | Bin 17045 -> 16778 bytes sources/FILEIO | 120 +++--- sources/FILEIO.LCOM | Bin 45833 -> 45945 bytes sources/HARDCOPY | 871 +++++++++++++++++++----------------------- sources/HARDCOPY.LCOM | Bin 47628 -> 45595 bytes 6 files changed, 484 insertions(+), 578 deletions(-) diff --git a/sources/COREIO b/sources/COREIO index 480027788..72ff5f565 100644 --- a/sources/COREIO +++ b/sources/COREIO @@ -1,17 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Jun-2022 00:14:07"  -{DSK}kaplan>local>medley3.5>working-medley>sources>COREIO.;17 57355 +(FILECREATED "11-Sep-2025 16:49:07" {WMEDLEY}COREIO.;18 56903 - :CHANGES-TO (FNS \CORE.OPENFILE) + :EDIT-BY rmk - :PREVIOUS-DATE " 4-Jun-2022 16:30:20" -{DSK}kaplan>local>medley3.5>working-medley>sources>COREIO.;16) + :CHANGES-TO (FNS \CORE.DIRECTORYNAMEP) + :PREVIOUS-DATE " 5-Jun-2022 00:14:07" {WMEDLEY}COREIO.;17) -(* ; " -Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT COREIOCOMS) @@ -91,8 +87,13 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (RETURN (fetch IOFILEFULLNAME of INFOBLOCK]) (\CORE.DIRECTORYNAMEP - [LAMBDA (DIRNAME DEV) (* ; "Edited 18-Jan-2022 11:17 by rmk") - (* ; "Edited 10-Jan-2022 22:33 by rmk") + [LAMBDA (DIRNAME DEV) + + (* ;; "Edited 11-Sep-2025 16:48 by rmk") + + (* ;; "Edited 18-Jan-2022 11:17 by rmk") + + (* ;; "Edited 10-Jan-2022 22:33 by rmk") (* ;;  "Edited 9-Jan-2022 12:42 by rmk: Using the new FILEDIRCASEARRAY so that slashes and brackets match") @@ -103,22 +104,20 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (CL:WHEN DIRNAME - (* ;; "The DIRNAME could be just {CORE}, which always is OK, or {CORE}xxx. If the latter, then we want it to be a directory and not a file (assuming that xxx and xxx> can't both exist.") + (* ;; "Returns NIL for a DIRNAME of just {CORE}, or {CORE}xxx. If the latter, then we want it to be a directory and not a file (assuming that xxx and xxx> can't both exist.") - (IF (EQ (CHARCODE }) - (NTHCHARCODE DIRNAME -1)) - ELSE (CL:UNLESS (MEMB (NTHCHARCODE DIRNAME -1) - (CHARCODE (> /))) - (SETQ DIRNAME (CONCAT DIRNAME ">"))) + [LET [(DIR (FILENAMEFIELD DIRNAME 'DIRECTORY] + (CL:WHEN DIR + (SETQ DIR (CONCAT DIR ">")) - (* ;; "DIRPOS because caller may not have stripped off the device. This will match the first < or / (or >)") + (* ;; "DIRPOS because caller may not have stripped off the device. This will match the first < or / (or >)") - (FOR ENTRY (DIRPOS _ (STRPOS "<" DIRNAME 1 NIL NIL NIL FILEDIRCASEARRAY)) - FIRST (CL:UNLESS (EQ DIRPOS 1) - (SETQ DIRNAME (SUBSTRING DIRNAME DIRPOS))) - IN (CDR (FETCH COREDIRECTORY OF DEV)) WHEN (STRPOS DIRNAME (CAR ENTRY) - 1 NIL T NIL FILEDIRCASEARRAY) - DO (RETURN T))))]) + (FOR ENTRY (DIRPOS _ (STRPOS "<" DIRNAME 1 NIL NIL NIL FILEDIRCASEARRAY)) + FIRST (CL:UNLESS (EQ DIRPOS 1) + (SETQ DIRNAME (SUBSTRING DIRNAME DIRPOS))) + IN (CDR (FETCH COREDIRECTORY OF DEV)) + WHEN (STRPOS DIRNAME (CAR ENTRY) + 1 NIL T NIL FILEDIRCASEARRAY) DO (RETURN T)))])]) (\CORE.FINDPAGE [LAMBDA (STREAM PN) (* bvm%: "20-Apr-85 13:32") @@ -997,19 +996,17 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation. (LOCALVARS . T) ) ) -(PUTPROPS COREIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 -1993 1999 2018)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1717 46448 (\CORE.CLOSEFILE 1727 . 2500) (\CORE.DELETEFILE 2502 . 4488) ( -\CORE.DIRECTORYNAMEP 4490 . 6171) (\CORE.FINDPAGE 6173 . 9402) (\CORE.GENERATEFILES 9404 . 11991) ( -\CORE.NEXTFILEFN 11993 . 12492) (\CORE.FILEINFOFN 12494 . 12723) (\CORE.GETFILEHANDLE 12725 . 14879) ( -\CORE.GETFILEINFO 14881 . 15844) (\CORE.GETFILEINFO.FROM.INFOBLOCK 15846 . 17383) (\CORE.GETFILENAME -17385 . 19674) (\CORE.GETINFOBLOCK 19676 . 22299) (\CORE.NAMESCAN 22301 . 23848) (\CORE.NAMESEGMENT -23850 . 24287) (\CORE.OPENFILE 24289 . 27681) (\COREFILE.SETPARAMETERS 27683 . 29864) ( -\CORE.PACKFILENAME 29866 . 30261) (\CORE.RELEASEPAGES 30263 . 30864) (\CORE.SETFILEPTR 30866 . 31965) -(\CORE.UPDATEOF 31967 . 33596) (\CORE.BACKFILEPTR 33598 . 35806) (\CORE.SETEOFPTR 35808 . 37677) ( -\CORE.SETACCESSTIME 37679 . 38304) (\CORE.SETFILEINFO 38306 . 40608) (\CORE.GETNEXTBUFFER 40610 . -44566) (\CORE.UNPACKFILENAME 44568 . 46446)) (46449 50082 (COREDEVICE 46459 . 46630) ( -\CREATECOREDEVICE 46632 . 50080)) (50083 52497 (\NODIRCOREFDEV 50093 . 50690) (\NODIRCORE.OPENFILE -50692 . 52495))))) + (FILEMAP (NIL (1572 46115 (\CORE.CLOSEFILE 1582 . 2355) (\CORE.DELETEFILE 2357 . 4343) ( +\CORE.DIRECTORYNAMEP 4345 . 5838) (\CORE.FINDPAGE 5840 . 9069) (\CORE.GENERATEFILES 9071 . 11658) ( +\CORE.NEXTFILEFN 11660 . 12159) (\CORE.FILEINFOFN 12161 . 12390) (\CORE.GETFILEHANDLE 12392 . 14546) ( +\CORE.GETFILEINFO 14548 . 15511) (\CORE.GETFILEINFO.FROM.INFOBLOCK 15513 . 17050) (\CORE.GETFILENAME +17052 . 19341) (\CORE.GETINFOBLOCK 19343 . 21966) (\CORE.NAMESCAN 21968 . 23515) (\CORE.NAMESEGMENT +23517 . 23954) (\CORE.OPENFILE 23956 . 27348) (\COREFILE.SETPARAMETERS 27350 . 29531) ( +\CORE.PACKFILENAME 29533 . 29928) (\CORE.RELEASEPAGES 29930 . 30531) (\CORE.SETFILEPTR 30533 . 31632) +(\CORE.UPDATEOF 31634 . 33263) (\CORE.BACKFILEPTR 33265 . 35473) (\CORE.SETEOFPTR 35475 . 37344) ( +\CORE.SETACCESSTIME 37346 . 37971) (\CORE.SETFILEINFO 37973 . 40275) (\CORE.GETNEXTBUFFER 40277 . +44233) (\CORE.UNPACKFILENAME 44235 . 46113)) (46116 49749 (COREDEVICE 46126 . 46297) ( +\CREATECOREDEVICE 46299 . 49747)) (49750 52164 (\NODIRCOREFDEV 49760 . 50357) (\NODIRCORE.OPENFILE +50359 . 52162))))) STOP diff --git a/sources/COREIO.LCOM b/sources/COREIO.LCOM index 8b866251f5d573aa64aa28fe2176e8cb085229dd..f011a7be1aeccc6df7b433fe92ed83bc00e0c860 100644 GIT binary patch delta 510 zcmaKoQA@&56vv&G4}*H|?QkK`hmCtTH+2q4w`<&*n{87OdPyB2rIVQuMEDTC^c09+ zqX+#6L9czKW{~wDo`(bH!1@3G=eL}5uP@wNdq#-h1!FDeH*s5LDM{>zA>h@gM-5J%XhPcX{znHsaG;nIpvO+dR}*%uuY zwTR^-(5T6Lq1u6Hc(-`xP8Of~v6%&};nEg!nx0_B4lxErxR{PMtR%o#Be@?|dkpex zJ$aRaAjKt;XZ;nsO~l1-T7RX7+hOr>c-buy@O-!7c%Z7_HLLN!>~m10-?gNI;n+sS u2O`7fal2BdHAXEn1|dsOGieJ7utghhA%_9!2qXfijMnq?vUFfGi~k0iuY>&n delta 784 zcmbVKO>fgc5RIvNz*jCkjx2$aLo9#WaVsmSy-7?{+t^N_s1iyOtFr3Yk&}p4QI$i* z1qlf$;><7LLd6;J8~7t!Il(Lq5D8A*!`qps-I+IU_w_aN?iKU)=`l$4$MdW%36cb& zY%01bY8+I#VKJVhSu%nm2M*YU6CGUb&8JB@way2VY>-=7F&t#pI2mQhrOd0=%c49_ z^RxObW39e050-d!v%Y95vMEVe@3c(*bVx2HSvpK-+2unMPVA7hVq*ItambNt6G%}& zyWi`MH!+v4EzWT z1ET&uCa%{3UHMHbD%iefw_=cGI3$PrAj#mxUGyQeeTRT3Y^LbHsz4jx5F^ke;PyCB z1mG-uF9WK`D0;27cJ1c-_M6>BHR#7d=m!yYqITmJ9EWbF8{>yOO7eLEkKkES78hU_ w<)kPFv$V)L5F3U_0e^7AkSQn>R0FILEIO.;138 166550 +(FILECREATED "11-Sep-2025 20:49:24"  +{DSK}kaplan>Local>medley3.5>working-medley>sources>FILEIO.;140 166949 :EDIT-BY rmk - :CHANGES-TO (FNS SETFILEINFO \DO.PARAMS.AT.OPEN \RENAMEFILE) + :CHANGES-TO (FNS COPYCHARS) - :PREVIOUS-DATE "18-Dec-2024 21:08:09" {WMEDLEY}FILEIO.;135) + :PREVIOUS-DATE "24-Apr-2025 22:16:47" +{DSK}kaplan>Local>medley3.5>working-medley>sources>FILEIO.;139) (PRETTYCOMPRINT FILEIOCOMS) @@ -2223,31 +2225,32 @@ update the map") ]) (COPYCHARS - [LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited 13-Aug-2021 18:39 by rmk:") - (* ; "Edited 14-Jun-2021 22:08 by rmk:") - (* ; "Edited 8-Dec-95 16:38 by rmk:") - (* ; "Edited 26-Mar-99 12:13 by rmk:") + [LAMBDA (SRCFIL DSTFIL START END) (* ; "Edited 11-Sep-2025 20:47 by rmk") + (* ; "Edited 13-Aug-2021 18:39 by rmk:") + (* ; "Edited 14-Jun-2021 22:08 by rmk:") + (* ; "Edited 8-Dec-95 16:38 by rmk:") + (* ; "Edited 26-Mar-99 12:13 by rmk:") - (* ;; "This is similar to COPYBYTES except that conversion is done between the EOL convention and externalformat of the input and the EOL convention/external format of the output") + (* ;; "This is similar to COPYBYTES except that conversion is done between the EOL convention and externalformat of the input and the EOL convention/external format of the output. This assumes that an ANY.EOLC source file is actually the same as the destination.") [PROG ((SRCSTRM (\GETSTREAM SRCFIL)) (DSTSTRM (\GETSTREAM DSTFIL)) (ACTUALSTART 0) RAP ACTUALEND EOF SRCEOLC DSTEOLC CH) - (CL:WHEN (AND (EQ (SETQ SRCEOLC (fetch EOLCONVENTION of SRCSTRM)) - (SETQ DSTEOLC (fetch EOLCONVENTION of DSTSTRM))) + (CL:WHEN (AND (OR (EQ (SETQ SRCEOLC (fetch EOLCONVENTION of SRCSTRM)) + (SETQ DSTEOLC (fetch EOLCONVENTION of DSTSTRM))) + (EQ ANY.EOLC (fetch EOLCONVENTION of SRCSTRM))) (EQ (FETCH EXTERNALFORMAT OF SRCSTRM) (FETCH EXTERNALFORMAT OF DSTSTRM))) (RETURN (COPYBYTES SRCSTRM DSTSTRM START END))) - (* ;; "Format or EOL convention are different. So first decode the START END specification") + (* ;; "Format or EOL convention are different. So first decode the START END specification") [COND ((SETQ RAP (fetch RANDOMACCESSP of (fetch DEVICE of SRCSTRM))) (SETQ EOF (\GETEOFPTR SRCSTRM] (COND - [END (OR RAP (ERROR "COPYCHARS: Source file is not random access" (fetch - FULLFILENAME + [END (OR RAP (ERROR "COPYCHARS: Source file is not random access" (fetch FULLFILENAME of SRCSTRM))) (OR (type? BYTEPTR (SETQ ACTUALSTART (FIX START))) (LISPERROR "ILLEGAL ARG" START)) @@ -2265,21 +2268,20 @@ update the map") (RAP (SETQ ACTUALSTART (\GETFILEPTR SRCSTRM)) (SETQ ACTUALEND EOF)) (T - (* ;; - "Not random access and START and END are both NIL, just copy to the end of file,no need to count.") + (* ;; + "Not random access and START and END are both NIL, just copy to the end of file,no need to count.") (until (\EOFP SRCSTRM) do (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM SRCEOLC))) (RETURN))) (CL:UNLESS (IGEQ ACTUALEND ACTUALSTART) (ERROR "Negative number of bytes to copy" (IDIFFERENCE ACTUALEND ACTUALSTART))) - (* ;; "We now know which bytes we need to copy, in the case that there is an EOL/format mismatch. If we assume that this is fairly unusual and that we don't want to assume here that we know how the CR and LF are byte-coded, we don't try to optimize for an EOL-only change. We just go generic.") + (* ;; "We now know which bytes we need to copy, in the case that there is an EOL/format mismatch. If we assume that this is fairly unusual and that we don't want to assume here that we know how the CR and LF are byte-coded, we don't try to optimize for an EOL-only change. We just go generic.") - (* ;; "The \INCCODE.EOLC and \OUTCHAR handle all format and EOL issues.") + (* ;; "The \INCCODE.EOLC and \OUTCHAR handle all format and EOL issues.") (BIND (CNT _ (IDIFFERENCE ACTUALEND ACTUALSTART)) DECLARE (SPECVARS CNT) - WHILE (IGREATERP CNT 0) DO (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM NIL - 'CNT CNT] + WHILE (IGREATERP CNT 0) DO (\OUTCHAR DSTSTRM (\INCCODE.EOLC SRCSTRM NIL 'CNT CNT] T]) (COPYFILE @@ -2440,10 +2442,11 @@ update the map") OLDVAL]) (ACCESS-CHARSET - [LAMBDA (STREAM NEWVALUE DONTMARKFILE) (* ; "Edited 8-Dec-2023 15:05 by rmk") + [LAMBDA (STREAM NEWVALUE DONTMARKFILE) (* ; "Edited 24-Apr-2025 22:15 by rmk") + (* ; "Edited 8-Dec-2023 15:05 by rmk") (* ; "Edited 11-Sep-87 15:46 by bvm:") - (* ;; "Unless DONTMARKSTREAM, if STREAM is open for output, the external format function may modify the backing file as well as the stream, e.g. put in XCCS shifting bytes.") + (* ;; "Unless DONTMARKSTREAM, if STREAM is open for output, the external format function may modify the backing file as well as the stream, e.g. put in MCCS shifting bytes.") (FDEVOP 'CHARSETFN (fetch (STREAM DEVICE) of STREAM) STREAM NEWVALUE DONTMARKFILE]) @@ -2715,10 +2718,11 @@ update the map") (\BACKCCODE.EOLC STRM)))])]) (\GENERIC.CHARSET - [LAMBDA (STREAM NEWVALUE DONTMARKSTREAM) (* ; "Edited 8-Dec-2023 15:17 by rmk") + [LAMBDA (STREAM NEWVALUE DONTMARKSTREAM) (* ; "Edited 24-Apr-2025 22:16 by rmk") + (* ; "Edited 8-Dec-2023 15:17 by rmk") (* ; "Edited 11-Sep-87 16:20 by bvm:") -(* ;;; "sets or returns the current numeric character set for this stream. This applies the stream's FORMATCHARSETFN if it has one, and (if MARKSTREAM) that may change an output backing stream in some way (e.g. write XCCS charset shift bytes). Otherwise, this just sets the charset stream parameter to influence subsequent reading and writing behavior. Charset doesn't exist in some formats (e.g. UTF-8), the format function would be a noop in that case.") +(* ;;; "sets or returns the current numeric character set for this stream. This applies the stream's FORMATCHARSETFN if it has one, and (if MARKSTREAM) that may change an output backing stream in some way (e.g. write MCCS charset shift bytes). Otherwise, this just sets the charset stream parameter to influence subsequent reading and writing behavior. Charset doesn't exist in some formats (e.g. UTF-8), the format function would be a noop in that case.") (\DTEST STREAM 'STREAM) (LET ((EFORMAT (ffetch (STREAM EXTERNALFORMAT) of STREAM)) @@ -3162,39 +3166,39 @@ update the map") (ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (27735 31851 (STREAMPROP 27745 . 28179) (GETSTREAMPROP 28181 . 28930) (PUTSTREAMPROP -28932 . 31699) (STREAMP 31701 . 31849)) (31894 35273 (\DEFPRINT.BY.NAME 31904 . 33056) ( -\STREAM.DEFPRINT 33058 . 34966) (\FDEV.DEFPRINT 34968 . 35271)) (35531 40572 (\GETACCESS 35541 . 35995 -) (\SETACCESS 35997 . 40570)) (60798 66767 (\DEFINEDEVICE 60808 . 63124) (\GETDEVICEFROMNAME 63126 . -63599) (\GETDEVICEFROMHOSTNAME 63601 . 64645) (\REMOVEDEVICE 64647 . 65770) (\REMOVEDEVICE.NAMES 65772 - . 66765)) (66807 94538 (\CLOSEFILE 66817 . 67642) (\DELETEFILE 67644 . 67938) (\DEVICEEVENT 67940 . -69710) (\GENERATEFILES 69712 . 70659) (\GENERATENEXTFILE 70661 . 71312) (\GENERATEFILEINFO 71314 . -71775) (\GETFILENAME 71777 . 72166) (\GENERIC.OUTFILEP 72168 . 72638) (\OPENFILE 72640 . 75218) ( -\DO.PARAMS.AT.OPEN 75220 . 79416) (\RENAMEFILE 79418 . 80374) (\REVALIDATEFILE 80376 . 82978) ( -\PAGED.REVALIDATEFILELST 82980 . 84538) (\PAGED.REVALIDATEFILES 84540 . 86259) (\PAGED.REVALIDATEFILE -86261 . 88544) (\BUFFERED.REVALIDATEFILE 88546 . 90832) (\BUFFERED.REVALIDATEFILELST 90834 . 92018) ( -\PRINT-REVALIDATION-RESULT 92020 . 92862) (\TRUNCATEFILE 92864 . 93255) (\FILE-CONFLICT 93257 . 94536) -) (94574 99237 (\GENERATENOFILES 94584 . 96680) (\NULLFILEGENERATOR 96682 . 96926) (\NOFILESNEXTFILEFN - 96928 . 98919) (\NOFILESINFOFN 98921 . 99235)) (99356 101264 (\FILE.NOT.OPEN 99366 . 99879) ( -\FILE.WONT.OPEN 99881 . 100209) (\ILLEGAL.DEVICEOP 100211 . 100493) (\IS.NOT.RANDACCESSP 100495 . -100941) (\STREAM.NOT.OPEN 100943 . 101262)) (101399 103697 (\FDEVINSTANCE 101409 . 103695)) (104899 -112273 (CNDIR 104909 . 106214) (DIRECTORYNAME 106216 . 110399) (DIRECTORYNAMEP 110401 . 111017) ( -HOSTNAMEP 111019 . 111826) (\ADD.CONNECTED.DIR 111828 . 112271)) (112318 140973 (\BACKFILEPTR 112328 - . 112516) (\BACKPEEKBIN 112518 . 112879) (\BACKBIN 112881 . 113232) (BIN 113234 . 113451) (\BIN -113453 . 113730) (\BINS 113732 . 114018) (BOUT 114020 . 114382) (\BOUT 114384 . 114699) (\BOUTS 114701 - . 115012) (COPYBYTES 115014 . 118346) (COPYCHARS 118348 . 122014) (COPYFILE 122016 . 123325) ( -\COPYOPENFILE 123327 . 126526) (\INFER.FILE.TYPE 126528 . 127482) (EOFP 127484 . 127781) (FORCEOUTPUT -127783 . 128030) (\FLUSH.OPEN.STREAMS 128032 . 128388) (CHARSET 128390 . 129749) (ACCESS-CHARSET -129751 . 130279) (GETEOFPTR 130281 . 130531) (GETFILEINFO 130533 . 133726) (\TYPE.FROM.FILETYPE 133728 - . 134198) (\FILETYPE.FROM.TYPE 134200 . 134379) (GETFILEPTR 134381 . 134633) (SETFILEINFO 134635 . -138872) (SETFILEPTR 138874 . 140593) (BOUT16 140595 . 140780) (BIN16 140782 . 140971)) (141076 148147 -(\GENERIC.BINS 141086 . 141366) (\GENERIC.BOUTS 141368 . 141633) (\GENERIC.RENAMEFILE 141635 . 143883) - (\GENERIC.OPENP 143885 . 145200) (\GENERIC.READP 145202 . 146354) (\GENERIC.CHARSET 146356 . 148145)) - (148148 148487 (\MAP-OPEN-STREAMS 148158 . 148485)) (150342 152422 (\EOF.ACTION 150352 . 150603) ( -\EOSERROR 150605 . 150798) (\GETEOFPTR 150800 . 150982) (\INCFILEPTR 150984 . 151334) (\PEEKBIN 151336 - . 151527) (\SETCLOSEDFILELENGTH 151529 . 151863) (\SETEOFPTR 151865 . 152053) (\SETFILEPTR 152055 . -152420)) (152423 152965 (\FIXPOUT 152433 . 152733) (\FIXPIN 152735 . 152963)) (152966 153532 (\BOUTEOL - 152976 . 153530)) (156428 166292 (\BUFFERED.BIN 156438 . 157290) (\BUFFERED.PEEKBIN 157292 . 158074) -(\BUFFERED.BOUT 158076 . 158936) (\BUFFERED.BINS 158938 . 162623) (\BUFFERED.BOUTS 162625 . 164426) ( -\BUFFERED.COPYBYTES 164428 . 166290))))) + (FILEMAP (NIL (27784 31900 (STREAMPROP 27794 . 28228) (GETSTREAMPROP 28230 . 28979) (PUTSTREAMPROP +28981 . 31748) (STREAMP 31750 . 31898)) (31943 35322 (\DEFPRINT.BY.NAME 31953 . 33105) ( +\STREAM.DEFPRINT 33107 . 35015) (\FDEV.DEFPRINT 35017 . 35320)) (35580 40621 (\GETACCESS 35590 . 36044 +) (\SETACCESS 36046 . 40619)) (60847 66816 (\DEFINEDEVICE 60857 . 63173) (\GETDEVICEFROMNAME 63175 . +63648) (\GETDEVICEFROMHOSTNAME 63650 . 64694) (\REMOVEDEVICE 64696 . 65819) (\REMOVEDEVICE.NAMES 65821 + . 66814)) (66856 94587 (\CLOSEFILE 66866 . 67691) (\DELETEFILE 67693 . 67987) (\DEVICEEVENT 67989 . +69759) (\GENERATEFILES 69761 . 70708) (\GENERATENEXTFILE 70710 . 71361) (\GENERATEFILEINFO 71363 . +71824) (\GETFILENAME 71826 . 72215) (\GENERIC.OUTFILEP 72217 . 72687) (\OPENFILE 72689 . 75267) ( +\DO.PARAMS.AT.OPEN 75269 . 79465) (\RENAMEFILE 79467 . 80423) (\REVALIDATEFILE 80425 . 83027) ( +\PAGED.REVALIDATEFILELST 83029 . 84587) (\PAGED.REVALIDATEFILES 84589 . 86308) (\PAGED.REVALIDATEFILE +86310 . 88593) (\BUFFERED.REVALIDATEFILE 88595 . 90881) (\BUFFERED.REVALIDATEFILELST 90883 . 92067) ( +\PRINT-REVALIDATION-RESULT 92069 . 92911) (\TRUNCATEFILE 92913 . 93304) (\FILE-CONFLICT 93306 . 94585) +) (94623 99286 (\GENERATENOFILES 94633 . 96729) (\NULLFILEGENERATOR 96731 . 96975) (\NOFILESNEXTFILEFN + 96977 . 98968) (\NOFILESINFOFN 98970 . 99284)) (99405 101313 (\FILE.NOT.OPEN 99415 . 99928) ( +\FILE.WONT.OPEN 99930 . 100258) (\ILLEGAL.DEVICEOP 100260 . 100542) (\IS.NOT.RANDACCESSP 100544 . +100990) (\STREAM.NOT.OPEN 100992 . 101311)) (101448 103746 (\FDEVINSTANCE 101458 . 103744)) (104948 +112322 (CNDIR 104958 . 106263) (DIRECTORYNAME 106265 . 110448) (DIRECTORYNAMEP 110450 . 111066) ( +HOSTNAMEP 111068 . 111875) (\ADD.CONNECTED.DIR 111877 . 112320)) (112367 141263 (\BACKFILEPTR 112377 + . 112565) (\BACKPEEKBIN 112567 . 112928) (\BACKBIN 112930 . 113281) (BIN 113283 . 113500) (\BIN +113502 . 113779) (\BINS 113781 . 114067) (BOUT 114069 . 114431) (\BOUT 114433 . 114748) (\BOUTS 114750 + . 115061) (COPYBYTES 115063 . 118395) (COPYCHARS 118397 . 122195) (COPYFILE 122197 . 123506) ( +\COPYOPENFILE 123508 . 126707) (\INFER.FILE.TYPE 126709 . 127663) (EOFP 127665 . 127962) (FORCEOUTPUT +127964 . 128211) (\FLUSH.OPEN.STREAMS 128213 . 128569) (CHARSET 128571 . 129930) (ACCESS-CHARSET +129932 . 130569) (GETEOFPTR 130571 . 130821) (GETFILEINFO 130823 . 134016) (\TYPE.FROM.FILETYPE 134018 + . 134488) (\FILETYPE.FROM.TYPE 134490 . 134669) (GETFILEPTR 134671 . 134923) (SETFILEINFO 134925 . +139162) (SETFILEPTR 139164 . 140883) (BOUT16 140885 . 141070) (BIN16 141072 . 141261)) (141366 148546 +(\GENERIC.BINS 141376 . 141656) (\GENERIC.BOUTS 141658 . 141923) (\GENERIC.RENAMEFILE 141925 . 144173) + (\GENERIC.OPENP 144175 . 145490) (\GENERIC.READP 145492 . 146644) (\GENERIC.CHARSET 146646 . 148544)) + (148547 148886 (\MAP-OPEN-STREAMS 148557 . 148884)) (150741 152821 (\EOF.ACTION 150751 . 151002) ( +\EOSERROR 151004 . 151197) (\GETEOFPTR 151199 . 151381) (\INCFILEPTR 151383 . 151733) (\PEEKBIN 151735 + . 151926) (\SETCLOSEDFILELENGTH 151928 . 152262) (\SETEOFPTR 152264 . 152452) (\SETFILEPTR 152454 . +152819)) (152822 153364 (\FIXPOUT 152832 . 153132) (\FIXPIN 153134 . 153362)) (153365 153931 (\BOUTEOL + 153375 . 153929)) (156827 166691 (\BUFFERED.BIN 156837 . 157689) (\BUFFERED.PEEKBIN 157691 . 158473) +(\BUFFERED.BOUT 158475 . 159335) (\BUFFERED.BINS 159337 . 163022) (\BUFFERED.BOUTS 163024 . 164825) ( +\BUFFERED.COPYBYTES 164827 . 166689))))) STOP diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM index 2e96bcf117556b71e37a1fefd075e89bcd96d1b0..a50f65aa6267a3c82397078caae5adcd60b8b48a 100644 GIT binary patch delta 845 zcmb_aO>fgc5T&Waq2f|;{L7N-pvtp8^W60;g!OmMdeEjZFT%~1YPKQM{oSR-g8fNA!9cSqqBFN@xUQQ?T zV}6O4Ren;A(#mvPkGj6_5J_SOxXpG*G31445Rvh}EYo$z^mS2I4-ByU!J)O^4MLbO z4NmNNuvsn$0te&aE2i;3TE?n#ot<{m+zMznqW0CK)u__qx@H5UD7vJBL2WnU_YR?) zO~GLD`#l=+kq=BvKm0pW2aG{L4~|_w4tbji1P)7lwWN-oe7bYi zlAmq8ua%?r?&tmS%^U1|yS1Bbe?PnT<^07_ytU9&Nc=czmJUS2khp!z@@*H{gl^CSq$-evG-~V^L;>5C28ri}gJnJ<%J0hCEYg(r zXheOdNmTXPNjjM-gVm3K$OIgl9srRP2qWg}6Tq6d#IQ=%7{M!yed<*n!up@9t}LV4 q8d27CvQ}RtooynL`e$e z1Cl?1E2rig5P#Bt;Krs+(+E{?SZVgnyf^b^_xEM%%Vq1^;gWJQtS2V5sRL+B?n)*I zbjV~jJwJV0pTO)42z)v`P+_7*pPwye@8^?x@jQwX6=&8{WWs#)vO3Ebb5;&gM zTb=sD`F!zMLZQklZW?89dbR`-4UzevMHswitRF4DA~X(YXl)UT3{6 l!m;tk#yu)TGaWzLN8#$f=rPYhK^dT<&(75rtBdik!5=I%y3YUr diff --git a/sources/HARDCOPY b/sources/HARDCOPY index 28bf7c316..4011c0022 100644 --- a/sources/HARDCOPY +++ b/sources/HARDCOPY @@ -1,18 +1,28 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2025 23:00:56" {WMEDLEY}HARDCOPY.;20 156777 +(FILECREATED "11-Sep-2025 17:08:34" {WMEDLEY}HARDCOPY.;47 148569 :EDIT-BY rmk - :CHANGES-TO (FNS \DSPFONT.HCPYMODE) + :CHANGES-TO (FNS PRINTERDEVICE.OPENFN) - :PREVIOUS-DATE " 5-Jul-2025 18:52:09" {WMEDLEY}HARDCOPY.;19) + :PREVIOUS-DATE "11-Sep-2025 12:40:56" {WMEDLEY}HARDCOPY.;46) (PRETTYCOMPRINT HARDCOPYCOMS) (RPAQQ HARDCOPYCOMS - [(COMS (* ; "exported functionality") + [[EXPORT (CONSTANTS (MICASPERINCH 2540) + (PTSPERINCH 72) + (MICASPERPT (FQUOTIENT MICASPERINCH PTSPERINCH)) + (IHALFMICASPERPT (FIX (FQUOTIENT MICASPERPT 2))) + (IMICASPERPT (FIX MICASPERPT)) + (PTSPERCM (FQUOTIENT PTSPERINCH 2.54)) + (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) + (PTSPERPICA 12) + (PICASPERINCH (QUOTIENT PTSPERINCH PTSPERPICA)) + (DEFAULTTAB (IQUOTIENT PTSPERINCH 2] + (COMS (* ; "exported functionality") (FNS HARDCOPY.SOMEHOW HARDCOPYIMAGEW HARDCOPYIMAGEW.TOFILE HARDCOPYIMAGEW.TOPRINTER HARDCOPYREGION.TOFILE HARDCOPYREGION.TOPRINTER COPY.WINDOW.TO.BITMAP) (* ; "user interface jazz") @@ -21,36 +31,32 @@ GetNewPrinterFromUser PopUpWindowAndGetAtom PopUpWindowAndGetList NewPrinter GetPrinterName GetImageFile FetchDefaultPrinter) (* ; "filename diddlers") - (FNS ExtensionForPrintFileType PRINTFILETYPE.FROM.EXTENSION)) + (FNS EXTENSIONS.FOR.PRINTFILETYPE PRINTFILETYPE.FROM.EXTENSION)) (COMS (* ;  "Interface for PRINTERS and IMAGEFILES") (FNS DEFAULTPRINTER CAN.PRINT.DIRECTLY CONVERT.FILE.TO.TYPE.FOR.PRINTER EMPRESS HARDCOPYW LISTFILES1 PRINTER.BITMAPFILE PRINTER.BITMAPSCALE PRINTER.SCRATCH.FILE PRINTERPROP PRINTERSTATUS PRINTERTYPE PRINTERNAME PRINTFILEPROP PRINTFILETYPE \EXPECTED.FILE.TYPE SEND.FILE.TO.PRINTER) - (FNS PRINTERDEVICE) + (FNS PRINTERDEVICE PRINTERDEVICE.OPENFN PRINTERDEVICE.CLOSEFN) [DECLARE%: DONTEVAL@LOAD DOCOPY (P (PRINTERDEVICE 'LPT] - (P (* ; "for backward compatibility") - (MOVD? 'NILL 'PRINTERMODE)) (INITVARS (DEFAULTPRINTINGHOST) - (DEFAULTPRINTERTYPE 'INTERPRESS) + (DEFAULTPRINTERTYPE 'PDF) (EMPRESS.SCRATCH) (EMPRESS#SIDES T) (PRINTFILETYPES NIL)) (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES PRINTFILETYPES)) + (FNS SCALEREGION) (COMS (* ;  "Converting text files to imagestreams") - (INITVARS (TEXTDEFAULTTABS (LIST 20320)) - (TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765))) - (* ; - "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") - (GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION) + [INITVARS (TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25 + 9.75] + (GLOBALVARS TEXTDEFAULTPAGEREGION) (FNS TEXTTOIMAGEFILE COPY.TEXT.TO.IMAGE)) - (COMS (FNS \BLTSHADE.GENERICPRINTER) - (* ; + (COMS (* ;  "hack for printers that can't really BLTSHADE") - ) + (FNS \BLTSHADE.GENERICPRINTER)) [COMS (* ;  "stuff to support hardcopy streams on the display.") (FNS MAKEHARDCOPYSTREAM UNMAKEHARDCOPYSTREAM HARDCOPYSTREAMTYPE \CHARWIDTH.HDCPYDISPLAY @@ -58,33 +64,58 @@ \DSPYPOSITION.HDCPYDISPLAY \STRINGWIDTH.HDCPYDISPLAY \STRINGWIDTH.HCPYDISPLAYAUX \HDCPYBLTCHAR \HDCPYDISPLAY.FIX.XPOS \HDCPYDISPLAY.FIX.YPOS \HDCPYDISPLAYINIT \HDCPYDSPPRINTCHAR \SLOWHDCPYBLTCHAR \CHANGECHARSET.HDCPYDISPLAY) - [DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) - (IHALFMICASPERPT 17) - (IMICASPERPT 35) - (DEFAULTTAB 36] - (* ; "screen-points: 1/2 inch") - (DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (FUNCTIONS \MICASTOPTS))) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HDCPYDISPLAYINIT] - [COMS (* ; + (DECLARE%: DONTCOPY DOEVAL@COMPILE (EXPORT (MACROS \MICASTOPTS] + (COMS (* ;  "Stuff to support MICA-unit hardcopy streams on the display") - (FNS MAKEHARDCOPYMODESTREAM UNMAKEHARDCOPYMODESTREAM \BLTSHADE.HCPYMODE - \BITBLT.HCPYMODE \BRUSHCONVERT.HCPYMODE \CHANGECHARSET.HCPYMODE + (FNS MAKEHARDCOPYMODESTREAM UNMAKEHARDCOPYMODESTREAM \HCPYDISPLAYIMAGEOPS + \BLTSHADE.HCPYMODE \BITBLT.HCPYMODE \BRUSHCONVERT.HCPYMODE \CHANGECHARSET.HCPYMODE \DASHINGCONVERT.HCPYMODE \CHARWIDTH.HCPYMODE \DRAWLINE.HCPYMODE \DRAWCURVE.HCPYMODE \DRAWCIRCLE.HCPYMODE \DRAWELLIPSE.HCPYMODE \DSPFONT.HCPYMODE \DSPLEFTMARGIN.HCPYMODE \DSPLINEFEED.HCPYMODE \DSPRIGHTMARGIN.HCPYMODE \DSPSPACEFACTOR.HCPYMODE \DSPXPOSITION.HCPYMODE \DSPYPOSITION.HCPYMODE - \MOVETO.HCPYMODE \FONTCREATE.HCPYMODE.PRESS \CREATECHARSET.HCPYMODE.PRESS - \FONTCREATE.HCPYMODE.INTERPRESS \CREATECHARSET.HCPYMODE.INTERPRESS - \STRINGWIDTH.HCPYMODE \HCPYMODEBLTCHAR \HCPYMODEDISPLAYINIT \HCPYMODEDSPPRINTCHAR - \SLOWHCPYMODEBLTCHAR \SFFixY.HCPYMODE) - [ADDVARS (IMAGESTREAMTYPES (PRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.PRESS) - (CREATECHARSET \CREATECHARSET.HCPYMODE.PRESS)) - (INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.INTERPRESS) - (CREATECHARSET \CREATECHARSET.HCPYMODE.INTERPRESS] - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\HCPYMODEDISPLAYINIT] + \MOVETO.HCPYMODE \FONTCREATE.HCPYMODE \CREATECHARSET.HCPYMODE + \STRINGWIDTH.HCPYMODE \HCPYMODEBLTCHAR \HCPYMODEDSPPRINTCHAR \SLOWHCPYMODEBLTCHAR + \SFFixY.HCPYMODE)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(RPAQQ MICASPERINCH 2540) + +(RPAQQ PTSPERINCH 72) + +(RPAQ MICASPERPT (FQUOTIENT MICASPERINCH PTSPERINCH)) + +(RPAQ IHALFMICASPERPT (FIX (FQUOTIENT MICASPERPT 2))) + +(RPAQ IMICASPERPT (FIX MICASPERPT)) + +(RPAQ PTSPERCM (FQUOTIENT PTSPERINCH 2.54)) + +(RPAQ PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) + +(RPAQQ PTSPERPICA 12) + +(RPAQ PICASPERINCH (QUOTIENT PTSPERINCH PTSPERPICA)) + +(RPAQ DEFAULTTAB (IQUOTIENT PTSPERINCH 2)) + + +(CONSTANTS (MICASPERINCH 2540) + (PTSPERINCH 72) + (MICASPERPT (FQUOTIENT MICASPERINCH PTSPERINCH)) + (IHALFMICASPERPT (FIX (FQUOTIENT MICASPERPT 2))) + (IMICASPERPT (FIX MICASPERPT)) + (PTSPERCM (FQUOTIENT PTSPERINCH 2.54)) + (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) + (PTSPERPICA 12) + (PICASPERINCH (QUOTIENT PTSPERINCH PTSPERPICA)) + (DEFAULTTAB (IQUOTIENT PTSPERINCH 2))) +) + +(* "END EXPORTED DEFINITIONS") + @@ -370,26 +401,25 @@ (MENU (MakeMenuOfPrinters "Which printer?"]) (GetImageFile - [LAMBDA (W) (* ; "Edited 27-Apr-98 16:44 by rmk:") + [LAMBDA (W) (* ; "Edited 10-Sep-2025 14:50 by rmk") + (* ; "Edited 27-Apr-98 16:44 by rmk:") (* ; "Edited 18-Jan-96 11:17 by ") (* ; "Edited 17-Jan-96 10:42 by rmk") (PROG (FILE PRINTFILETYPE FILETYPEMENU) (* ;; "Strip candidate version so overwrites must be explicitly indicated each time. Use previous file as candidate, and if no previous one, apply function associated with the window to the window and the extension associated with the defaultprinting host. Such a function on a TEDIT window, for example, could suggest the image-type file named after the underlying TEDIT file.") - [SETQ FILE - (PopUpWindowAndGetAtom - "File name (Clear to abort): " - (OR [AND (WINDOWPROP W 'HARDCOPYFILE) - (PACKFILENAME 'VERSION NIL 'BODY (WINDOWPROP W 'HARDCOPYFILE] - (AND (WINDOWPROP W 'HARDCOPYFILEFN) - (APPLY* (WINDOWPROP W 'HARDCOPYFILEFN) - W - (CAR (MKLIST (CADR (ASSOC 'EXTENSION - (CDR (ASSOC (OR (CADDR (LISTP (DEFAULTPRINTER)) - ) - (PRINTERTYPE)) - PRINTFILETYPES] + [SETQ FILE (PopUpWindowAndGetAtom + "File name (Clear to abort): " + (OR [AND (WINDOWPROP W 'HARDCOPYFILE) + (PACKFILENAME 'VERSION NIL 'BODY (WINDOWPROP W 'HARDCOPYFILE] + (AND (WINDOWPROP W 'HARDCOPYFILEFN) + (APPLY* (WINDOWPROP W 'HARDCOPYFILEFN) + W + (CAR (EXTENSIONS.FOR.PRINTFILETYPE (OR (CADDR (LISTP ( + DEFAULTPRINTER + ))) + (PRINTERTYPE] (CL:UNLESS (AND FILE (SETQ FILE (OUTFILEP FILE))) (* ; "Keep directory etc for reuse") (RETURN)) (WINDOWPROP W 'HARDCOPYFILE FILE) (* ; @@ -419,10 +449,11 @@ (DEFINEQ -(ExtensionForPrintFileType - [LAMBDA (TYPE) (* ; "Edited 26-Aug-87 14:11 by Snow") +(EXTENSIONS.FOR.PRINTFILETYPE + [LAMBDA (TYPE) (* ; "Edited 10-Sep-2025 14:43 by rmk") + (* ; "Edited 26-Aug-87 14:11 by Snow") (DECLARE (GLOBALVARS PRINTFILETYPES)) - (CAADR (ASSOC 'EXTENSION (CDR (ASSOC TYPE PRINTFILETYPES]) + (CAR (MKLIST (GETMULTI PRINTFILETYPES TYPE 'EXTENSION]) (PRINTFILETYPE.FROM.EXTENSION [LAMBDA (FILE) (* ; "Edited 26-Aug-87 14:11 by Snow") @@ -798,83 +829,82 @@ (DEFINEQ (PRINTERDEVICE - [LAMBDA (NAME) (* ; "Edited 5-Dec-96 11:23 by rmk:") + [LAMBDA (NAME) (* ; "Edited 11-Sep-2025 12:40 by rmk") + (* ; "Edited 5-Dec-96 11:23 by rmk:") (* ; "Edited 4-Dec-86 16:32 by hdj") - (* ;; "This defines an LPT device. An LPT file is a file that gets sent to printer and deleted when it is closed. This must be defined on a CORE device only because we have no way of inheriting the previous CLOSEFILE function that this function is replacing but needs to call internally. We have \CORE.CLOSEFILE explicit in this code.") + (* ;; "This defines an LPT device. An LPT file is a file that gets sent to printer and deleted when it is closed. This must be defined on a CORE device only because we have no way of inheriting the previous CLOSEFILE function that this function is replacing but needs to call internally. PRINTERDEVICE.CLOSEFN calls\CORE.CLOSEFILE explicitly.") (LET ((DEV (\CREATECOREDEVICE NAME))) - [replace (FDEV OPENFILE) of DEV - with (FUNCTION (LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) - (LET ((STRM (\CORE.OPENFILE NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) - )) + (replace (FDEV OPENFILE) of DEV with (FUNCTION PRINTERDEVICE.OPENFN)) + (replace (FDEV CLOSEFILE) of DEV with (FUNCTION PRINTERDEVICE.CLOSEFN)) + (\DEFINEDEVICE NAME DEV) + NAME]) - (* ;; "Mark the original name of the printer on the stream. Unless the user overrides this by changing the PRINTERNAME property, SEND.FILE.TO.PRINTER in the close function will get the user's original spelling, without any case conversions that might otherwise be done by \CORE.OPENFILE. ") +(PRINTERDEVICE.OPENFN + [LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* ; "Edited 11-Sep-2025 17:03 by rmk") + (LET [(STRM (\CORE.OPENFILE NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM)) + (PRINTERNAME (FILENAMEFIELD NAME 'NAME] - (STREAMPROP STRM 'PRINTERNAME (FILENAMEFIELD NAME 'NAME)) - STRM] - [replace (FDEV CLOSEFILE) of DEV - with (FUNCTION (LAMBDA (STREAM) - (LET [(SDEV (fetch (STREAM DEVICE) of STREAM)) - (PRINTOPTIONS (STREAMPROP STREAM 'PRINTOPTIONS] + (* ;; "Mark the original name of the printer on the stream. Unless the user overrides this by changing the PRINTERNAME property, SEND.FILE.TO.PRINTER in the close function will get the user's original spelling, without any case conversions that might otherwise be done by \CORE.OPENFILE. ") - (* ;; - "Get PRINTOPTIONS property before closing the stream, in case the closing throws them away") + (STREAMPROP STRM 'PRINTERNAME (CL:UNLESS (EQ PRINTERNAME '%.) + PRINTERNAME)) + STRM]) - (* ;; "") +(PRINTERDEVICE.CLOSEFN + [LAMBDA (STREAM) (* ; "Edited 11-Sep-2025 12:37 by rmk") + (LET [(SDEV (fetch (STREAM DEVICE) of STREAM)) + (PRINTOPTIONS (STREAMPROP STREAM 'PRINTOPTIONS] - (* ;; "If we could save away and get at the previous CLOSEFILE method (e.g. by an FDEVPROP), this could be replaced by the generic (FDEVOP (QUOTE CLOSEFILE) SDEV STREAM)") + (* ;; + "Get PRINTOPTIONS property before closing the stream, in case the closing throws them away") - (COND - [(AND (NOT RESETSTATE) - (OPENP STREAM 'OUTPUT) - (IGREATERP (GETEOFPTR STREAM) - 0)) + (* ;; "") - (* ;; "Close and send to printer only if open for output. If open for input, then we must already have started printing. Don't close until after getting EOF ptr.") + (* ;; "If we could save away and get at the previous CLOSEFILE method (e.g. by an FDEVPROP), this could be replaced by the generic (FDEVOP (QUOTE CLOSEFILE) SDEV STREAM). We know that SDEV is a CORE device, we call \CORE.CLOSEFILE directly") - (\CORE.CLOSEFILE STREAM) - (replace (STREAM ACCESS) of STREAM with NIL) - (* ; + (COND + [(AND (NOT RESETSTATE) + (OPENP STREAM 'OUTPUT) + (IGREATERP (GETEOFPTR STREAM) + 0)) + + (* ;; "Close and send to printer only if open for output. If open for input, then we must already have started printing. Don't close until after getting EOF ptr.") + + (\CORE.CLOSEFILE STREAM) + (replace (STREAM ACCESS) of STREAM with NIL) (* ;  "Hack, cause this is usually done later in the generic \CLOSEFILE.") - (* ;; "The PRINTERNAME might be marked explicitly on the stream. Otherwise let SEND.FILE.TO.PRINTER choose the host if it is the generic printer LPT, or use the name in the devicename field.") - - (SEND.FILE.TO.PRINTER - STREAM - [IF (STREAMPROP STREAM 'PRINTERNAME) - ELSEIF (NEQ 'LPT (fetch (FDEV DEVICENAME) of SDEV)) - THEN (fetch (FDEV DEVICENAME) of SDEV) - ELSE (LET ((NAME (fetch (STREAM FULLNAME) of STREAM)) - POS POS2) - (AND (SETQ POS (STRPOS "}" NAME)) - (SETQ POS2 (STRPOS "." NAME (ADD1 POS))) - (SUBATOM NAME (ADD1 POS) - (SUB1 POS2] - (APPEND '(DELETE T) - PRINTOPTIONS - '(HEADING T] - (T - - (* ;; "Error while creating the file, if the user had wrapped a RESETLST/CLOSEF around his code. Presumably, he doesn't want the file printed") - - (\CORE.CLOSEFILE STREAM) - (FDEVOP 'DELETEFILE SDEV STREAM SDEV T] - (\DEFINEDEVICE NAME DEV) - NAME]) + (* ;; "The PRINTERNAME might be marked explicitly on the stream. Otherwise let SEND.FILE.TO.PRINTER choose the host if it is the generic printer LPT, or use the name in the devicename field.") + + (SEND.FILE.TO.PRINTER STREAM (IF (STREAMPROP STREAM 'PRINTERNAME) + ELSEIF (NEQ 'LPT (fetch (FDEV DEVICENAME) of SDEV)) + THEN (fetch (FDEV DEVICENAME) of SDEV) + ELSE [LET ((NAME (fetch (STREAM FULLNAME) of STREAM)) + POS POS2) + (AND (SETQ POS (STRPOS "}" NAME)) + (SETQ POS2 (STRPOS "." NAME (ADD1 POS))) + (SUBATOM NAME (ADD1 POS) + (SUB1 POS2] + NIL) + (APPEND '(DELETE T) + PRINTOPTIONS + '(HEADING T] + (T + (* ;; "Error while creating the file, if the user had wrapped a RESETLST/CLOSEF around his code. Presumably, he doesn't want the file printed") + + (\CORE.CLOSEFILE STREAM) + (FDEVOP 'DELETEFILE SDEV STREAM SDEV T]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (PRINTERDEVICE 'LPT) ) - (* ; "for backward compatibility") - -(MOVD? 'NILL 'PRINTERMODE) - (RPAQ? DEFAULTPRINTINGHOST ) -(RPAQ? DEFAULTPRINTERTYPE 'INTERPRESS) +(RPAQ? DEFAULTPRINTERTYPE 'PDF) (RPAQ? EMPRESS.SCRATCH ) @@ -885,23 +915,27 @@ (GLOBALVARS DEFAULTPRINTINGHOST DEFAULTPRINTERTYPE EMPRESS#SIDES PRINTERTYPES PRINTFILETYPES) ) +(DEFINEQ +(SCALEREGION + [LAMBDA (SCALE REGION) (* rmk%: "21-JUL-82 13:06") + (* ; "Scales a region") + (create REGION + LEFT _ (FIX (FTIMES SCALE (fetch (REGION LEFT) of REGION))) + BOTTOM _ (FIX (FTIMES SCALE (fetch (REGION BOTTOM) of REGION))) + WIDTH _ (FIX (FTIMES SCALE (fetch (REGION WIDTH) of REGION))) + HEIGHT _ (FIX (FTIMES SCALE (fetch (REGION HEIGHT) of REGION]) +) -(* ; "Converting text files to imagestreams") - - -(RPAQ? TEXTDEFAULTTABS (LIST 20320)) - -(RPAQ? TEXTDEFAULTPAGEREGION (CREATEREGION 2794 1905 18415 24765)) - +(* ; "Converting text files to imagestreams") -(* ; "TEXTDEFAULTTABS Hack, mica equivalent of 8 inches. NOT USED ANYWHERE") +(RPAQ? TEXTDEFAULTPAGEREGION (SCALEREGION MICASPERINCH (CREATEREGION 1.1 0.75 7.25 9.75))) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS TEXTDEFAULTTABS TEXTDEFAULTPAGEREGION) +(GLOBALVARS TEXTDEFAULTPAGEREGION) ) (DEFINEQ @@ -1031,6 +1065,11 @@ (\OUTCHAR IMAGESTREAM C] (SETFILEINFO INSTRM 'ENDOFSTREAMOP EOSP]) ) + + + +(* ; "hack for printers that can't really BLTSHADE") + (DEFINEQ (\BLTSHADE.GENERICPRINTER @@ -1064,19 +1103,16 @@ -(* ; "hack for printers that can't really BLTSHADE") - - - - (* ; "stuff to support hardcopy streams on the display.") (DEFINEQ (MAKEHARDCOPYSTREAM - [LAMBDA (DISPLAYSTREAM IMAGETYPE) (* ; "Edited 26-Aug-87 14:23 by Snow") + [LAMBDA (DISPLAYSTREAM IMAGETYPE) (* ; "Edited 9-Sep-2025 15:11 by rmk") + (* ; "Edited 26-Aug-87 14:23 by Snow") -(* ;;; "creates a hardcopy stream from a display stream.") +(* ;;; +"creates a hardcopy stream from a display stream. Seems to be called only from SK.SET.HARDCOPY.MODE") (DECLARE (GLOBALVARS \HDCPYDISPLAYIMAGEOPS)) (PROG [(DS (COND @@ -1124,26 +1160,30 @@ (RETURN DS]) (HARDCOPYSTREAMTYPE - [LAMBDA (IMAGESTREAM) (* ; "Edited 26-Aug-87 14:24 by Snow") + [LAMBDA (IMAGESTREAM) (* ; "Edited 9-Sep-2025 13:40 by rmk") + (* ; "Edited 26-Aug-87 14:24 by Snow") -(* ;;; "returns the type of a hard copy stream which is either PRESS or INTERPRESS.") +(* ;;; "returns the type of a hard copy stream.") (LET ((STREAM (\OUTSTREAMARG IMAGESTREAM T))) (AND STREAM (STREAMPROP STREAM 'HARDCOPYIMAGETYPE]) (\CHARWIDTH.HDCPYDISPLAY - [LAMBDA (STREAM CHARCODE) (* ; "Edited 26-Aug-87 14:24 by Snow") + [LAMBDA (STREAM CHARCODE) (* ; "Edited 10-Sep-2025 23:48 by rmk") + (* ; "Edited 26-Aug-87 14:24 by Snow") (* ;  "gets the width of a character code in a hardcopy stream. Should be updated for spacefactor") (IQUOTIENT (IPLUS (\FGETCHARIMAGEWIDTH (FONTCREATE (ffetch (\DISPLAYDATA DDFONT) of (ffetch IMAGEDATA of STREAM)) NIL NIL NIL (STREAMPROP STREAM 'HARDCOPYIMAGETYPE)) CHARCODE) - (CONSTANT IHALFMICASPERPT)) - (CONSTANT IMICASPERPT]) + IHALFMICASPERPT) + IMICASPERPT]) (\DSPFONT.HDCPYDISPLAY - [LAMBDA (HDCPYDSTREAM FONT) (* ; "Edited 12-Jan-88 16:18 by jds") + [LAMBDA (HDCPYDSTREAM FONT) (* ; "Edited 10-Sep-2025 23:48 by rmk") + (* ; "Edited 2-Sep-2025 22:34 by rmk") + (* ; "Edited 12-Jan-88 16:18 by jds") (* ;; "changes the font of a hardcopy display stream. Does what the display does then puts the hardcopy widths where they can be found {FOR NOW USE THE DDCHARIMAGEWIDTHS FIELD}") @@ -1154,10 +1194,9 @@  "For now, use a streamprop instead of a special field in the dispay data") (* ; "Scale widths to printer device units, so we don't have to fetch the constants to scale by for every char we print") (replace DDCHARIMAGEWIDTHS of DD - with (PROG (W OLDWIDTH (SCALE (FONTPROP FD 'SCALE)) - (CSINFO (\GETCHARSETINFO (fetch (STREAM CHARSET) - of HDCPYDSTREAM) - FD))) + with (PROG [W OLDWIDTH (SCALE (FONTPROP FD 'SCALE)) + (CSINFO (\INSURECHARSETINFO FD (fetch (STREAM CHARSET) + of HDCPYDSTREAM] (* ;; "set linefeed from scaled height. This may be off by almost half a pixel per line but it is better than not doing so.") @@ -1166,19 +1205,19 @@ of FD) SCALE] [COND - ((EQP SCALE (CONSTANT MICASPERPT)) + ((EQP SCALE MICASPERPT) (RETURN (fetch (CHARSETINFO WIDTHS) of CSINFO] (SETQ W (\CREATECSINFOELEMENT)) (SETQ OLDWIDTH (fetch (CHARSETINFO WIDTHS) of CSINFO)) - (SETQ SCALE (FQUOTIENT (CONSTANT MICASPERPT) - SCALE)) + (SETQ SCALE (FQUOTIENT MICASPERPT SCALE)) [for I from 0 to \MAXTHINCHAR do (\FSETWIDTH W I (FIXR (FTIMES (\FGETWIDTH OLDWIDTH I) SCALE] (RETURN W])]) (\DSPRIGHTMARGIN.HDCPYDISPLAY - [LAMBDA (DISPLAYSTREAM XPOSITION) (* ; "Edited 26-Aug-87 14:25 by Snow") + [LAMBDA (DISPLAYSTREAM XPOSITION) (* ; "Edited 10-Sep-2025 23:49 by rmk") + (* ; "Edited 26-Aug-87 14:25 by Snow") (* ;;; "Sets the right margin that determines when a cr is inserted by print for the hardcopy display stream.") @@ -1187,7 +1226,7 @@ (PROG1 (\DSPRIGHTMARGIN.DISPLAY DISPLAYSTREAM XPOSITION) [AND XPOSITION (replace (\DISPLAYDATA DDMICARIGHTMARGIN) of (fetch IMAGEDATA of DISPLAYSTREAM ) - with (FIX (FTIMES XPOSITION (CONSTANT MICASPERPT])]) + with (FIX (FTIMES XPOSITION MICASPERPT])]) (\DSPXPOSITION.HDCPYDISPLAY [LAMBDA (HARDCOPYSTREAM XPOSITION) (* ; "Edited 26-Aug-87 14:25 by Snow") @@ -1202,7 +1241,8 @@ (AND YPOSITION (\HDCPYDISPLAY.FIX.YPOS HARDCOPYSTREAM)))]) (\STRINGWIDTH.HDCPYDISPLAY - [LAMBDA (STREAM STR RDTBL) (* ; "Edited 26-Aug-87 14:25 by Snow") + [LAMBDA (STREAM STR RDTBL) (* ; "Edited 10-Sep-2025 23:49 by rmk") + (* ; "Edited 26-Aug-87 14:25 by Snow") (* ;  "Returns the width of for the current font/spacefactor in hardcopy stream STREAM.") (LET [(HARDCOPYFD (FONTCREATE (ffetch (\DISPLAYDATA DDFONT) of (ffetch IMAGEDATA of STREAM)) @@ -1210,11 +1250,12 @@ (IQUOTIENT (IPLUS (\STRINGWIDTH.GENERIC STR HARDCOPYFD RDTBL (\FGETCHARIMAGEWIDTH HARDCOPYFD (CHARCODE SPACE))) - (CONSTANT IHALFMICASPERPT)) - (CONSTANT IMICASPERPT]) + IHALFMICASPERPT) + IMICASPERPT]) (\STRINGWIDTH.HCPYDISPLAYAUX - [LAMBDA (STR FONT RDTBL SPACEWIDTH) (* ; "Edited 3-Apr-87 13:48 by jop") + [LAMBDA (STR FONT RDTBL SPACEWIDTH) (* ; "Edited 2-Sep-2025 22:35 by rmk") + (* ; "Edited 3-Apr-87 13:48 by jop") (* ;; "Returns the width of STR with SPACEWIDTH for the width of spaces. RDTBL has already been coerced, so no FLG is needed") @@ -1232,7 +1273,7 @@ ((NEQ CSET (\CHARSET C)) (SETQ CSET (\CHARSET C)) (SETQ WIDTHSBASE (ffetch (CHARSETINFO IMAGEWIDTHS) - of (\GETCHARSETINFO CSET FONT] + of (\INSURECHARSETINFO FONT CSET] (COND ((EQ C (CHARCODE SPACE)) SPACEWIDTH) @@ -1255,7 +1296,7 @@  "Get the widths vector for this character set") (SETQ CSET (\CHARSET C)) (SETQ WIDTHSBASE (ffetch (CHARSETINFO IMAGEWIDTHS) - of (\GETCHARSETINFO CSET FONT] + of (\INSURECHARSETINFO FONT CSET] (add TOTAL (COND ((EQ C (CHARCODE SPACE)) SPACEWIDTH) @@ -1284,15 +1325,16 @@ (SETQ WIDTHSBASE (ffetch (CHARSETINFO IMAGEWIDTHS ) - of (\GETCHARSETINFO CSET FONT - ))) + of (\INSURECHARSETINFO FONT + CSET))) (\FGETIMAGEWIDTH WIDTHSBASE (\CHAR8CODE CC] STR RDTBL RDTBL *PRINT-LEVEL* *PRINT-LENGTH*) TOTALWIDTH]) (\HDCPYBLTCHAR - [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; "Edited 26-Aug-87 14:26 by Snow") + [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; "Edited 10-Sep-2025 23:49 by rmk") + (* ; "Edited 26-Aug-87 14:26 by Snow") (* ;; "puts a character on a hardcopy display stream. Much of the information needed by the BitBlt microcode is prestored by the routines that change it. This is kept in the BitBltTable.") (* ; @@ -1330,12 +1372,10 @@ (* ;; "update the display stream x position. Make sure that there is at least one point width for each character.") - [freplace DDXPOSITION of DISPLAYDATA with (IMAX (ADD1 CURX) - (IQUOTIENT (IPLUS MICARIGHT (CONSTANT - - IHALFMICASPERPT - )) - (CONSTANT IMICASPERPT] + (freplace DDXPOSITION of DISPLAYDATA with (IMAX (ADD1 CURX) + (IQUOTIENT (IPLUS MICARIGHT IHALFMICASPERPT + ) + IMICASPERPT))) (* ;  "transforms an x coordinate into the destination coordinate.") (SETQ CURX (IPLUS CURX (ffetch DDXOFFSET of DISPLAYDATA))) @@ -1365,29 +1405,32 @@ T]) (\HDCPYDISPLAY.FIX.XPOS - [LAMBDA (HARDCOPYSTREAM) (* ; "Edited 26-Aug-87 14:26 by Snow") + [LAMBDA (HARDCOPYSTREAM) (* ; "Edited 10-Sep-2025 23:49 by rmk") + (* ; "Edited 26-Aug-87 14:26 by Snow") (* ;;; "updates the mica X position from the x position in the display stream. This is called whenever the X position changes in a hardcopy stream.") (PROG ((DD (fetch IMAGEDATA of HARDCOPYSTREAM))) (replace (\DISPLAYDATA DDMICAXPOS) of DD with (FIX (FTIMES (fetch (\DISPLAYDATA DDXPOSITION ) of DD) - (CONSTANT MICASPERPT]) + MICASPERPT]) (\HDCPYDISPLAY.FIX.YPOS - [LAMBDA (HARDCOPYSTREAM) (* ; "Edited 26-Aug-87 14:26 by Snow") + [LAMBDA (HARDCOPYSTREAM) (* ; "Edited 10-Sep-2025 23:49 by rmk") + (* ; "Edited 26-Aug-87 14:26 by Snow") (* ;;; "updates the mica Y position from the Y position in the display stream. This is called whenever the Y position changes in a hardcopy stream.") - (PROG ((DD (fetch IMAGEDATA of HARDCOPYSTREAM))) - (replace (\DISPLAYDATA DDMICAYPOS) of DD with (FIX (FTIMES (fetch (\DISPLAYDATA DDYPOSITION - ) of DD) - (CONSTANT MICASPERPT]) + (LET ((DD (fetch IMAGEDATA of HARDCOPYSTREAM))) + (replace (\DISPLAYDATA DDMICAYPOS) of DD with (FIX (FTIMES (fetch (\DISPLAYDATA DDYPOSITION) + of DD) + MICASPERPT]) (\HDCPYDISPLAYINIT - [LAMBDA NIL (* ; "Edited 26-Aug-87 14:26 by Snow") + [LAMBDA NIL (* ; "Edited 9-Sep-2025 13:42 by rmk") + (* ; "Edited 26-Aug-87 14:26 by Snow") -(* ;;; "Initializes global variables for the hardcopy Display device. This device appears to the user as an INTERPRESS or PRESS device meaning units in micas but outputs to the screen. Much of this code was borrowed from the display case.") +(* ;;; "Initializes global variables for the hardcopy Display device. This device appears to the user as a hardcopy device meaning units in micas but outputs to the screen. Much of this code was borrowed from the display case.") (DECLARE (GLOBALVARS \HDCPYDISPLAYIMAGEOPS)) (SETQ \HDCPYDISPLAYIMAGEOPS (create IMAGEOPS using \DISPLAYIMAGEOPS IMAGETYPE _ @@ -1490,7 +1533,8 @@ (SHOULDNT]) (\SLOWHDCPYBLTCHAR - [LAMBDA (CHARCODE DISPLAYSTREAM) (* ; "Edited 9-Nov-89 14:37 by gadener") + [LAMBDA (CHARCODE DISPLAYSTREAM) (* ; "Edited 2-Sep-2025 22:35 by rmk") + (* ; "Edited 9-Nov-89 14:37 by gadener") (* ;;; "IS THIS CODE JUST GOING TO DUPLICATE AND GET OUT OF SYNC WITH \SLOWBLTCHAR? KBR 1-FEB-86. *") @@ -1554,8 +1598,8 @@ (PROG (YPOS HEIGHTMOVED CSINFO) (SETQ YPOS (ffetch (\DISPLAYDATA DDYPOSITION) of DD)) (SETQ HEIGHTMOVED (\DSPGETCHARWIDTH CHAR8CODE DD)) - (SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE) - (ffetch (\DISPLAYDATA DDFONT) of DD))) + (SETQ CSINFO (\INSURECHARSETINFO (ffetch (\DISPLAYDATA DDFONT) of DD) + (\CHARSET CHARCODE))) (COND ((EQ ROTATION 90) (* ; "don't force CR for rotated fonts.") (\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED)) @@ -1586,7 +1630,9 @@ (T (ERROR "Not implemented to rotate by other than 0, 90 or 270"]) (\CHANGECHARSET.HDCPYDISPLAY - [LAMBDA (DISPLAYDATA CHARSET HDCPYDSTREAM) (* ; "Edited 26-Aug-87 14:27 by Snow") + [LAMBDA (DISPLAYDATA CHARSET HDCPYDSTREAM) (* ; "Edited 10-Sep-2025 23:50 by rmk") + (* ; "Edited 2-Sep-2025 22:35 by rmk") + (* ; "Edited 26-Aug-87 14:27 by Snow") (* ;; "Called when the character set information cached in a display stream doesn't correspond to CHARSET Only sets those field that are different from the regular DISPLAY case and uses the regular display case to get the rest.") @@ -1599,14 +1645,13 @@  "Scale widths to micas, so we don't have to fetch the constants to scale by for every char we print") (replace DDCHARIMAGEWIDTHS of DISPLAYDATA with (PROG (W OLDWIDTH (SCALE (FONTPROP FD 'SCALE)) - (CSINFO (\GETCHARSETINFO CHARSET FD))) + (CSINFO (\INSURECHARSETINFO FD CHARSET))) (SETQ OLDWIDTH (fetch (CHARSETINFO WIDTHS) of CSINFO)) (COND - ((EQP SCALE (CONSTANT MICASPERPT)) + ((EQP SCALE MICASPERPT) (RETURN OLDWIDTH))) (SETQ W (\CREATECSINFOELEMENT)) - (SETQ SCALE (FQUOTIENT (CONSTANT MICASPERPT) - SCALE)) + (SETQ SCALE (FQUOTIENT MICASPERPT SCALE)) [for I from 0 to \MAXTHINCHAR do (\FSETWIDTH W I (FIXR (FTIMES (\FGETWIDTH OLDWIDTH I) SCALE] @@ -1615,19 +1660,8 @@ (DECLARE%: DONTCOPY DOEVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -(RPAQ MICASPERPT (FQUOTIENT 2540 72)) - -(RPAQQ IHALFMICASPERPT 17) - -(RPAQQ IMICASPERPT 35) - -(RPAQQ DEFAULTTAB 36) - - -(CONSTANTS (MICASPERPT (FQUOTIENT 2540 72)) - (IHALFMICASPERPT 17) - (IMICASPERPT 35) - (DEFAULTTAB 36)) +(PUTPROPS \MICASTOPTS MACRO ((MICAS) + (QUOTIENT MICAS MICASPERPT))) ) (* "END EXPORTED DEFINITIONS") @@ -1636,52 +1670,30 @@ -(* ; "screen-points: 1/2 inch") - -(DECLARE%: DONTCOPY DOEVAL@COMPILE -(* "FOLLOWING DEFINITIONS EXPORTED") -(DEFMACRO \MICASTOPTS (MICAS) - [COND - ((NUMBERP MICAS) - (QUOTIENT MICAS MICASPERPT)) - (T `(QUOTIENT ,MICAS MICASPERPT]) - -(* "END EXPORTED DEFINITIONS") - -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(\HDCPYDISPLAYINIT) -) - - - (* ; "Stuff to support MICA-unit hardcopy streams on the display") (DEFINEQ (MAKEHARDCOPYMODESTREAM - [LAMBDA (DISPLAYSTREAM IMAGETYPE) (* ; "Edited 1-Apr-88 11:25 by jds") + [LAMBDA (DISPLAYSTREAM IMAGETYPE) (* ; "Edited 9-Sep-2025 13:33 by rmk") + (* ; "Edited 1-Apr-88 11:25 by jds") (* ;;; "Creates a hardcopy-mode display stream from a normal one. That stream operates in units of micas, but displays on the screen as usual.") - (DECLARE (GLOBALVARS \HCPYMODEDISPLAYIMAGEOPS.PRESS \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS)) - (PROG [(DS (COND + (CL:UNLESS IMAGETYPE + [SETQ IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE) + 'CANPRINT]) + (LET* ([DS (COND ((DISPLAYSTREAMP DISPLAYSTREAM)) ((WINDOWP DISPLAYSTREAM) (WINDOWPROP DISPLAYSTREAM 'DSP)) ((NULL DISPLAYSTREAM) (DSPCREATE)) (T (\ILLEGAL.ARG DISPLAYSTREAM] - (SELECTQ [OR IMAGETYPE (SETQ IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE) - 'CANPRINT] - (PRESS (* ; - "Give the stream PRESS-style imageops, so it will deal with press fonts right.") - (replace (STREAM IMAGEOPS) of DS with \HCPYMODEDISPLAYIMAGEOPS.PRESS)) - (INTERPRESS (* ; - "Give the stream INTERPRESS-style operations, so it will deal with Interpress fonts right.") - (replace (STREAM IMAGEOPS) of DS with \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS)) - NIL) + (IMAGEOPSVAR (PACK* "\HCPYMODEDISPLAYIMAGEOPS." IMAGETYPE))) + (CL:UNLESS (type? IMAGEOPS (GETATOMVAL IMAGEOPSVAR)) + (SETATOMVAL IMAGEOPSVAR (\HCPYDISPLAYIMAGEOPS IMAGETYPE))) + (replace (STREAM IMAGEOPS) of DS with (GETATOMVAL IMAGEOPSVAR)) (STREAMPROP DS 'HARDCOPYIMAGETYPE IMAGETYPE) (* ;  "set the bout fn to one that updates the mica fields and sets the position from them.") (replace (STREAM STRMBOUTFN) of DS with (FUNCTION \HCPYMODEDSPPRINTCHAR)) @@ -1704,38 +1716,75 @@ MICASPERPT)) DS) (* ; "And reuse the right margin") (DSPSPACEFACTOR 1 DS) - (RETURN DS]) + DS]) (UNMAKEHARDCOPYMODESTREAM - [LAMBDA (DISPLAYSTREAM) (* ; "Edited 26-Aug-87 14:28 by Snow") + [LAMBDA (DISPLAYSTREAM) (* ; "Edited 9-Sep-2025 13:29 by rmk") + (* ; "Edited 26-Aug-87 14:28 by Snow") (* ;;; "returns a hardcopy stream to a display stream.") (DECLARE (GLOBALVARS \DISPLAYIMAGEOPS)) - (PROG [(DS (COND - ((DISPLAYSTREAMP DISPLAYSTREAM)) - ((WINDOWP DISPLAYSTREAM) - (WINDOWPROP DISPLAYSTREAM 'DSP)) - (T (\ILLEGAL.ARG DISPLAYSTREAM] - (COND - ((FMEMB 'HARDCOPY (IMAGESTREAMTYPE DS)) (* ; - "Make sure the stream really WAS a hardcopy-mode stream.") - ) - (T (* ; - "It wasn't a hardcopy-mode stream. Don't make any changes") - (RETURN DS))) - (replace (STREAM IMAGEOPS) of DS with \DISPLAYIMAGEOPS) + (LET [(DS (COND + ((DISPLAYSTREAMP DISPLAYSTREAM)) + ((WINDOWP DISPLAYSTREAM) + (WINDOWPROP DISPLAYSTREAM 'DSP)) + (T (\ILLEGAL.ARG DISPLAYSTREAM] + (CL:WHEN (FMEMB 'HARDCOPY (IMAGESTREAMTYPE DS)) + + (* ;; "Do nothing if it's not a hardcopy-mode stream") + + (replace (STREAM IMAGEOPS) of DS with \DISPLAYIMAGEOPS) (* ; "Give it back the usual operations") - (STREAMPROP DS 'HARDCOPYIMAGETYPE NIL) (* ; "restore the bout fn") - (replace (STREAM STRMBOUTFN) of DS with (FUNCTION \DSPPRINTCHAR)) - (replace (STREAM OUTCHARFN) of DS with (FUNCTION \DSPPRINTCHAR)) - (DSPXPOSITION 0 DS) - (DSPYPOSITION 0 DS) - (DSPRIGHTMARGIN (OR (STREAMPROP DISPLAYSTREAM 'DSPRIGHTMARGIN) - (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL DS))) - NIL DS) (* ; + (STREAMPROP DS 'HARDCOPYIMAGETYPE NIL) (* ; "restore the bout fn") + (replace (STREAM STRMBOUTFN) of DS with (FUNCTION \DSPPRINTCHAR)) + (replace (STREAM OUTCHARFN) of DS with (FUNCTION \DSPPRINTCHAR)) + (DSPXPOSITION 0 DS) + (DSPYPOSITION 0 DS) + (DSPRIGHTMARGIN (OR (STREAMPROP DISPLAYSTREAM 'DSPRIGHTMARGIN) + (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL DS))) + NIL DS)) (* ;  "Reset the right margin back to points") - (RETURN DS]) + DS]) + +(\HCPYDISPLAYIMAGEOPS + [LAMBDA (IMAGETYPE) (* ; "Edited 9-Sep-2025 15:13 by rmk") + + (* ;; "Same code for all types, except for the IMFONTCREATE function (used only for this purpose, or SK.CHOOSE.TEXT.FONT.") + + (* ;; "This assumes a canonical name \[IMAGETYPE]IMAGEOPS for the IMAGEOPS of IMAGETYPE, so that it can get the IMSCALE function.") + + (create IMAGEOPS using \DISPLAYIMAGEOPS IMAGETYPE _ '(HARDCOPY DISPLAY) + IMFONT _ (FUNCTION \DSPFONT.HCPYMODE) + IMRIGHTMARGIN _ (FUNCTION \DSPRIGHTMARGIN.HCPYMODE) + IMLEFTMARGIN _ (FUNCTION \DSPLEFTMARGIN.HCPYMODE) + IMLINEFEED _ (FUNCTION \DSPLINEFEED.HCPYMODE) + IMDRAWLINE _ (FUNCTION \DRAWLINE.HCPYMODE) + IMDRAWCURVE _ (FUNCTION \DRAWCURVE.HCPYMODE) + IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.HCPYMODE) + IMDRAWELLIPSE _ (FUNCTION \DRAWELLIPSE.HCPYMODE) + IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.HCPYMODE) + IMBLTSHADE _ (FUNCTION \BLTSHADE.HCPYMODE) + IMBITBLT _ (FUNCTION \BITBLT.HCPYMODE) + IMXPOSITION _ (FUNCTION \DSPXPOSITION.HCPYMODE) + IMYPOSITION _ (FUNCTION \DSPYPOSITION.HCPYMODE) + IMMOVETO _ (FUNCTION \MOVETO.HCPYMODE) + IMSTRINGWIDTH _ (FUNCTION \STRINGWIDTH.HCPYMODE) + IMCHARWIDTH _ (FUNCTION \CHARWIDTH.HCPYMODE) + IMFONTCREATE _ (PACK* IMAGETYPE 'DISPLAY) + IMSCALE _ (fetch (IMAGEOPS IMSCALE) of (GETATOMVAL (PACK* "\" IMAGETYPE + "IMAGEOPS"))) + IMNEWPAGE _ [FUNCTION (LAMBDA (STREAM) + (LET ((WINDOW (AND \WINDOWWORLD (WFROMDS STREAM))) + WINDOWFN) + (COND + ([AND WINDOW (SETQ WINDOWFN + (WINDOWPROP WINDOW + 'PAGEFULLFN] + (APPLY* WINDOWFN STREAM)) + (T (PAGEFULLFN STREAM))) + (CLEARW STREAM] + IMSPACEFACTOR _ (FUNCTION \DSPSPACEFACTOR.HCPYMODE]) (\BLTSHADE.HCPYMODE [LAMBDA (TEXTURE STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT OPERATION CLIPPINGREGION) @@ -1772,14 +1821,17 @@ (T BB]) (\CHANGECHARSET.HCPYMODE - [LAMBDA (DISPLAYDATA CHARSET) (* ; "Edited 26-Aug-87 14:29 by Snow") + [LAMBDA (DISPLAYDATA CHARSET) (* ; "Edited 2-Sep-2025 22:36 by rmk") + (* ; "Edited 26-Aug-87 14:29 by Snow") (* ;  "Called when the character set information cached in a display stream doesn't correspond to CHARSET") - (PROG [BM (PBT (ffetch DDPILOTBBT of DISPLAYDATA)) - (CSINFO (\GETCHARSETINFO CHARSET (ffetch DDFONT of DISPLAYDATA))) - (CSDINFO (\GETCHARSETINFO CHARSET (FONTCOPY (ffetch DDFONT of DISPLAYDATA) - 'DEVICE - 'DISPLAY] + (PROG (BM (PBT (ffetch DDPILOTBBT of DISPLAYDATA)) + (CSINFO (\INSURECHARSETINFO (ffetch DDFONT of DISPLAYDATA) + CHARSET)) + (CSDINFO (\INSURECHARSETINFO (FONTCOPY (ffetch DDFONT of DISPLAYDATA) + 'DEVICE + 'DISPLAY) + CHARSET))) (UNINTERRUPTABLY (freplace DDWIDTHSCACHE of DISPLAYDATA with (ffetch (CHARSETINFO WIDTHS) of CSINFO)) (freplace DDOFFSETSCACHE of DISPLAYDATA with (ffetch (CHARSETINFO OFFSETS) of CSINFO)) @@ -1996,115 +2048,68 @@ (\DSPXPOSITION.HCPYMODE STREAM X) (\DSPYPOSITION.HCPYMODE STREAM Y]) -(\FONTCREATE.HCPYMODE.PRESS - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 26-Aug-87 14:36 by Snow") - (* ; - "Create a font descriptor for a display stream that is mimicing an PRESS device") - (PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'DISPLAY)) - (HFONT (create FONTDESCRIPTOR using (FONTCREATE FAMILY SIZE FACE ROTATION 'PRESS) - FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR))) - (CS0DINFO (\GETCHARSETINFO \DEFAULTCHARSET DFONT))) - (replace FONTDEVICE of HFONT with 'PRESSDISPLAY) - [replace OTHERDEVICEFONTPROPS of HFONT with (LIST 'WIDTHS (fetch (CHARSETINFO WIDTHS) - of CS0DINFO) - 'ASCENT - (fetch (CHARSETINFO CHARSETASCENT) - of CS0DINFO) - 'DESCENT - (fetch (CHARSETINFO CHARSETDESCENT) - of CS0DINFO) - 'HEIGHT - (IPLUS (fetch (CHARSETINFO CHARSETASCENT - ) of CS0DINFO) - (fetch (CHARSETINFO - CHARSETDESCENT) - of CS0DINFO] - - (* ;; "Cache the DISPLAY info, for the various X- and Y-position updating tasks that affect the display bitmap itself") - - (RETURN HFONT]) - -(\CREATECHARSET.HCPYMODE.PRESS - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC)(* ; "Edited 26-Aug-87 14:36 by Snow") - (* ; - "Build the CHARSETINFO for an PRESSDISPLAY font") - (PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'DISPLAY)) - (HFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'PRESS)) - (CSDINFO (\GETCHARSETINFO CHARSET DFONT)) - (CSHINFO (\GETCHARSETINFO CHARSET HFONT)) - (CSINFO (CREATE CHARSETINFO USING CSHINFO))) - (replace (CHARSETINFO OFFSETS) of CSINFO with (fetch (CHARSETINFO OFFSETS) of CSDINFO)) +(\FONTCREATE.HCPYMODE + [LAMBDA (FONTSPEC) (* ; "Edited 2-Sep-2025 22:37 by rmk") + (* ; "Edited 26-Aug-87 14:36 by Snow") + +(* ;;; "Create a font descriptor for a display stream that is mimicing a hardcopy device") + + (LET* ((DFONT (FONTCREATE FONTSPEC NIL NIL NIL 'DISPLAY)) + (HFONT (create FONTDESCRIPTOR using (FONTCREATE FONTSPEC) + FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR))) + (CS0DINFO (\INSURECHARSETINFO DFONT \DEFAULTCHARSET))) + [replace OTHERDEVICEFONTPROPS of HFONT with (LIST 'WIDTHS (fetch (CHARSETINFO WIDTHS) + of CS0DINFO) + 'ASCENT + (fetch (CHARSETINFO CHARSETASCENT) + of CS0DINFO) + 'DESCENT + (fetch (CHARSETINFO CHARSETDESCENT) + of CS0DINFO) + 'HEIGHT + (IPLUS (fetch (CHARSETINFO CHARSETASCENT) + of CS0DINFO) + (fetch (CHARSETINFO CHARSETDESCENT + ) of CS0DINFO] + + (* ;; "Cache the DISPLAY info, for the various X- and Y-position updating tasks that affect the display bitmap itself") + + HFONT]) + +(\CREATECHARSET.HCPYMODE + [LAMBDA (FONTSPEC FONT CHARSET) (* ; "Edited 9-Sep-2025 15:26 by rmk") + (* ; "Edited 2-Sep-2025 22:37 by rmk") + (* ; "Edited 26-Aug-87 14:37 by Snow") + +(* ;;; "Build the CHARSETINFO for a hardcopy display font, corresponding to the FONTSPEC's FSDEVICE.") + + (LET* ((DFONT (FONTCREATE FONTSPEC NIL NIL NIL 'DISPLAY)) + (HFONT (FONTCREATE FONTSPEC)) + (CSDINFO (\INSURECHARSETINFO DFONT CHARSET)) + (CSHINFO (\INSURECHARSETINFO HFONT CHARSET)) + (CSINFO (CREATE CHARSETINFO USING CSHINFO))) + (replace (CHARSETINFO OFFSETS) of CSINFO with (fetch (CHARSETINFO OFFSETS) of CSDINFO)) (* ;  "Fill in the right offsets from the display font--into the hcpy font, and its Charset-0 info block") - (replace (CHARSETINFO CHARSETBITMAP) of CSINFO with (fetch (CHARSETINFO CHARSETBITMAP) - of CSDINFO)) + (replace (CHARSETINFO CHARSETBITMAP) of CSINFO with (fetch (CHARSETINFO CHARSETBITMAP) + of CSDINFO)) (* ; "Likewise the character rasters") - (replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with (fetch (CHARSETINFO IMAGEWIDTHS) - of CSDINFO)) + (replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with (fetch (CHARSETINFO IMAGEWIDTHS) + of CSDINFO)) (* ;  "And the raster widths (as distinct from the nominal mica widths)") - (RETURN CSINFO]) - -(\FONTCREATE.HCPYMODE.INTERPRESS - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE) (* ; "Edited 26-Aug-87 14:36 by Snow") - -(* ;;; "Create a font descriptor for a display stream that is mimicing an INTERPRESS device") - - (PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'DISPLAY)) - (HFONT (create FONTDESCRIPTOR using (FONTCREATE FAMILY SIZE FACE ROTATION 'INTERPRESS) - FONTCHARSETVECTOR _ (\CREATEFONTCHARSETVECTOR))) - (CS0DINFO (\GETCHARSETINFO \DEFAULTCHARSET DFONT))) - (replace FONTDEVICE of HFONT with 'INTERPRESSDISPLAY) - [replace OTHERDEVICEFONTPROPS of HFONT with (LIST 'WIDTHS (fetch (CHARSETINFO WIDTHS) - of CS0DINFO) - 'ASCENT - (fetch (CHARSETINFO CHARSETASCENT) - of CS0DINFO) - 'DESCENT - (fetch (CHARSETINFO CHARSETDESCENT) - of CS0DINFO) - 'HEIGHT - (IPLUS (fetch (CHARSETINFO CHARSETASCENT - ) of CS0DINFO) - (fetch (CHARSETINFO - CHARSETDESCENT) - of CS0DINFO] - - (* ;; "Cache the DISPLAY info, for the various X- and Y-position updating tasks that affect the display bitmap itself") - - (RETURN HFONT]) - -(\CREATECHARSET.HCPYMODE.INTERPRESS - [LAMBDA (FAMILY SIZE FACE ROTATION DEVICE CHARSET FONTDESC)(* ; "Edited 26-Aug-87 14:37 by Snow") - -(* ;;; "Build the CHARSETINFO for an INTERPRESSDISPLAY font") - - (PROG* ((DFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'DISPLAY)) - (HFONT (FONTCREATE FAMILY SIZE FACE ROTATION 'INTERPRESS)) - (CSDINFO (\GETCHARSETINFO CHARSET DFONT)) - (CSHINFO (\GETCHARSETINFO CHARSET HFONT)) - (CSINFO (CREATE CHARSETINFO USING CSHINFO))) - (replace (CHARSETINFO OFFSETS) of CSINFO with (fetch (CHARSETINFO OFFSETS) of CSDINFO)) - (* ; - "Fill in the right offsets from the display font--into the hcpy font, and its Charset-0 info block") - (replace (CHARSETINFO CHARSETBITMAP) of CSINFO with (fetch (CHARSETINFO CHARSETBITMAP) - of CSDINFO)) - (* ; "Likewise the character rasters") - (replace (CHARSETINFO IMAGEWIDTHS) of CSINFO with (fetch (CHARSETINFO IMAGEWIDTHS) - of CSDINFO)) - (* ; - "And the raster widths (as distinct from the nominal mica widths)") - (RETURN CSINFO]) + CSINFO]) (\STRINGWIDTH.HCPYMODE - [LAMBDA (STREAM STR RDTBL) (* ; "Edited 26-Aug-87 14:38 by Snow") + [LAMBDA (STREAM STR RDTBL) (* ; "Edited 10-Sep-2025 23:50 by rmk") + (* ; "Edited 26-Aug-87 14:38 by Snow") (* ;  "Returns the width of for the current font/spacefactor in hardcopy stream STREAM.") (LET [(WIDTHSBASE (ffetch (\DISPLAYDATA DDCHARIMAGEWIDTHS) of (ffetch IMAGEDATA of STREAM] (IQUOTIENT (IPLUS (\STRINGWIDTH.GENERIC STR WIDTHSBASE RDTBL (\FGETWIDTH WIDTHSBASE (CHARCODE SPACE))) - (CONSTANT IHALFMICASPERPT)) - (CONSTANT IMICASPERPT]) + IHALFMICASPERPT) + IMICASPERPT]) (\HCPYMODEBLTCHAR [LAMBDA (CHARCODE DISPLAYSTREAM DISPLAYDATA) (* ; "Edited 1-Apr-88 11:35 by jds") @@ -2187,98 +2192,6 @@ ) T]) -(\HCPYMODEDISPLAYINIT - [LAMBDA NIL (* ; "Edited 1-Apr-88 11:36 by jds") - -(* ;;; "Initializes global variables for the hardcopy Display device. This device appears to the user as an INTERPRESS or PRESS device meaning units in micas but outputs to the screen. Much of this code was borrowed from the display case.") - - (DECLARE (GLOBALVARS \HCPYMODEDISPLAYIMAGEOPS.PRESS \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS)) - (SETQ \HCPYMODEDISPLAYIMAGEOPS.PRESS (create IMAGEOPS - using \DISPLAYIMAGEOPS IMAGETYPE _ '(HARDCOPY DISPLAY) - IMFONT _ (FUNCTION \DSPFONT.HCPYMODE) - IMRIGHTMARGIN _ (FUNCTION \DSPRIGHTMARGIN.HCPYMODE) - IMLEFTMARGIN _ (FUNCTION \DSPLEFTMARGIN.HCPYMODE) - IMLINEFEED _ (FUNCTION \DSPLINEFEED.HCPYMODE) - IMDRAWLINE _ (FUNCTION \DRAWLINE.HCPYMODE) - IMDRAWCURVE _ (FUNCTION \DRAWCURVE.HCPYMODE) - IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.HCPYMODE) - IMDRAWELLIPSE _ (FUNCTION \DRAWELLIPSE.HCPYMODE) - IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.HCPYMODE) - IMBLTSHADE _ (FUNCTION \BLTSHADE.HCPYMODE) - IMBITBLT _ (FUNCTION \BITBLT.HCPYMODE) - IMXPOSITION _ (FUNCTION \DSPXPOSITION.HCPYMODE) - IMYPOSITION _ (FUNCTION \DSPYPOSITION.HCPYMODE) - IMMOVETO _ (FUNCTION \MOVETO.HCPYMODE) - IMSTRINGWIDTH _ (FUNCTION \STRINGWIDTH.HCPYMODE) - IMCHARWIDTH _ (FUNCTION \CHARWIDTH.HCPYMODE) - IMFONTCREATE _ (FUNCTION PRESSDISPLAY) - IMSCALE _ [FUNCTION (LAMBDA NIL - (CONSTANT (FQUOTIENT - MICASPERINCH - 72] - IMNEWPAGE _ - [FUNCTION (LAMBDA (STREAM) - (LET ((WINDOW (AND \WINDOWWORLD - (WFROMDS STREAM))) - WINDOWFN) - (COND - ([AND WINDOW - (SETQ WINDOWFN - (WINDOWPROP WINDOW - 'PAGEFULLFN] - (APPLY* WINDOWFN STREAM)) - (T (PAGEFULLFN STREAM))) - (CLEARW STREAM] - IMSPACEFACTOR _ (FUNCTION \DSPSPACEFACTOR.HCPYMODE) - )) - (SETQ \HCPYMODEDISPLAYIMAGEOPS.INTERPRESS (create IMAGEOPS - using \DISPLAYIMAGEOPS IMAGETYPE _ - '(HARDCOPY DISPLAY) - IMFONT _ (FUNCTION \DSPFONT.HCPYMODE) - IMRIGHTMARGIN _ (FUNCTION - \DSPRIGHTMARGIN.HCPYMODE) - IMLEFTMARGIN _ (FUNCTION - \DSPLEFTMARGIN.HCPYMODE) - IMLINEFEED _ (FUNCTION \DSPLINEFEED.HCPYMODE) - IMDRAWLINE _ (FUNCTION \DRAWLINE.HCPYMODE) - IMDRAWCURVE _ (FUNCTION \DRAWCURVE.HCPYMODE) - IMDRAWCIRCLE _ (FUNCTION \DRAWCIRCLE.HCPYMODE) - IMDRAWELLIPSE _ (FUNCTION - \DRAWELLIPSE.HCPYMODE) - IMFILLCIRCLE _ (FUNCTION \FILLCIRCLE.HCPYMODE) - IMBLTSHADE _ (FUNCTION \BLTSHADE.HCPYMODE) - IMBITBLT _ (FUNCTION \BITBLT.HCPYMODE) - IMXPOSITION _ (FUNCTION \DSPXPOSITION.HCPYMODE - ) - IMYPOSITION _ (FUNCTION \DSPYPOSITION.HCPYMODE - ) - IMMOVETO _ (FUNCTION \MOVETO.HCPYMODE) - IMSTRINGWIDTH _ (FUNCTION - \STRINGWIDTH.HCPYMODE) - IMCHARWIDTH _ (FUNCTION \CHARWIDTH.HCPYMODE) - IMFONTCREATE _ (FUNCTION INTERPRESSDISPLAY) - IMSCALE _ [FUNCTION (LAMBDA NIL - (CONSTANT (FQUOTIENT - MICASPERINCH - 72] - IMNEWPAGE _ - [FUNCTION (LAMBDA (STREAM) - (LET - ((WINDOW (AND \WINDOWWORLD - (WFROMDS STREAM))) - WINDOWFN) - (COND - ([AND WINDOW - (SETQ WINDOWFN - (WINDOWPROP - WINDOW - 'PAGEFULLFN] - (APPLY* WINDOWFN STREAM)) - (T (PAGEFULLFN STREAM))) - (CLEARW STREAM] - IMSPACEFACTOR _ (FUNCTION - \DSPSPACEFACTOR.HCPYMODE]) - (\HCPYMODEDSPPRINTCHAR [LAMBDA (STREAM CHARCODE) (* ; "Edited 26-Aug-87 14:39 by Snow") @@ -2365,7 +2278,8 @@ (SHOULDNT]) (\SLOWHCPYMODEBLTCHAR - [LAMBDA (CHARCODE DISPLAYSTREAM) (* ; "Edited 26-Aug-87 14:39 by Snow") + [LAMBDA (CHARCODE DISPLAYSTREAM) (* ; "Edited 2-Sep-2025 22:37 by rmk") + (* ; "Edited 26-Aug-87 14:39 by Snow") (* ;;; "IS THIS CODE JUST GOING TO DUPLICATE AND GET OUT OF SYNC WITH \SLOWBLTCHAR? KBR 1-FEB-86. *") @@ -2429,8 +2343,8 @@ (PROG (YPOS HEIGHTMOVED CSINFO) (SETQ YPOS (ffetch (\DISPLAYDATA DDYPOSITION) of DD)) (SETQ HEIGHTMOVED (\DSPGETCHARWIDTH CHAR8CODE DD)) - (SETQ CSINFO (\GETCHARSETINFO (\CHARSET CHARCODE) - (ffetch (\DISPLAYDATA DDFONT) of DD))) + (SETQ CSINFO (\INSURECHARSETINFO (ffetch (\DISPLAYDATA DDFONT) of DD) + (\CHARSET CHARCODE))) (COND ((EQ ROTATION 90) (* ; "don't force CR for rotated fonts.") (\DSPYPOSITION.DISPLAY DISPLAYSTREAM (IPLUS YPOS HEIGHTMOVED)) @@ -2501,15 +2415,6 @@ (ffetch DDClippingBottom of DISPLAYDATA))) 0]) ) - -(ADDTOVAR IMAGESTREAMTYPES (PRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.PRESS) - (CREATECHARSET \CREATECHARSET.HCPYMODE.PRESS)) - (INTERPRESSDISPLAY (FONTCREATE \FONTCREATE.HCPYMODE.INTERPRESS) - (CREATECHARSET \CREATECHARSET.HCPYMODE.INTERPRESS))) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(\HCPYMODEDISPLAYINIT) -) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) @@ -2519,40 +2424,40 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6233 12071 (HARDCOPY.SOMEHOW 6243 . 7609) (HARDCOPYIMAGEW 7611 . 7832) ( -HARDCOPYIMAGEW.TOFILE 7834 . 8142) (HARDCOPYIMAGEW.TOPRINTER 8144 . 9391) (HARDCOPYREGION.TOFILE 9393 - . 9935) (HARDCOPYREGION.TOPRINTER 9937 . 11050) (COPY.WINDOW.TO.BITMAP 11052 . 12069)) (12143 23930 ( -MakeMenuOfPrinters 12153 . 13685) (PRINTERS.WHENSELECTEDFN 13687 . 15310) (MakeMenuOfImageTypes 15312 - . 16131) (GetNewPrinterFromUser 16133 . 16575) (PopUpWindowAndGetAtom 16577 . 18028) ( -PopUpWindowAndGetList 18030 . 19600) (NewPrinter 19602 . 21101) (GetPrinterName 21103 . 21391) ( -GetImageFile 21393 . 23678) (FetchDefaultPrinter 23680 . 23928)) (23965 24730 ( -ExtensionForPrintFileType 23975 . 24222) (PRINTFILETYPE.FROM.EXTENSION 24224 . 24728)) (24785 45169 ( -DEFAULTPRINTER 24795 . 25035) (CAN.PRINT.DIRECTLY 25037 . 25233) (CONVERT.FILE.TO.TYPE.FOR.PRINTER -25235 . 26972) (EMPRESS 26974 . 27549) (HARDCOPYW 27551 . 32553) (LISTFILES1 32555 . 32732) ( -PRINTER.BITMAPFILE 32734 . 33123) (PRINTER.BITMAPSCALE 33125 . 33609) (PRINTER.SCRATCH.FILE 33611 . -33781) (PRINTERPROP 33783 . 34033) (PRINTERSTATUS 34035 . 34310) (PRINTERTYPE 34312 . 36882) ( -PRINTERNAME 36884 . 37305) (PRINTFILEPROP 37307 . 37563) (PRINTFILETYPE 37565 . 39521) ( -\EXPECTED.FILE.TYPE 39523 . 40313) (SEND.FILE.TO.PRINTER 40315 . 45167)) (45170 49789 (PRINTERDEVICE -45180 . 49787)) (50624 58869 (TEXTTOIMAGEFILE 50634 . 52830) (COPY.TEXT.TO.IMAGE 52832 . 58867)) ( -58870 60613 (\BLTSHADE.GENERICPRINTER 58880 . 60611)) (60741 96742 (MAKEHARDCOPYSTREAM 60751 . 62303) -(UNMAKEHARDCOPYSTREAM 62305 . 63235) (HARDCOPYSTREAMTYPE 63237 . 63571) (\CHARWIDTH.HDCPYDISPLAY 63573 - . 64305) (\DSPFONT.HDCPYDISPLAY 64307 . 67019) (\DSPRIGHTMARGIN.HDCPYDISPLAY 67021 . 67777) ( -\DSPXPOSITION.HDCPYDISPLAY 67779 . 68154) (\DSPYPOSITION.HDCPYDISPLAY 68156 . 68531) ( -\STRINGWIDTH.HDCPYDISPLAY 68533 . 69400) (\STRINGWIDTH.HCPYDISPLAYAUX 69402 . 74624) (\HDCPYBLTCHAR -74626 . 79618) (\HDCPYDISPLAY.FIX.XPOS 79620 . 80278) (\HDCPYDISPLAY.FIX.YPOS 80280 . 80938) ( -\HDCPYDISPLAYINIT 80940 . 82533) (\HDCPYDSPPRINTCHAR 82535 . 88448) (\SLOWHDCPYBLTCHAR 88450 . 94954) -(\CHANGECHARSET.HDCPYDISPLAY 94956 . 96740)) (97243 97384 (\MICASTOPTS 97243 . 97384)) (97555 156213 ( -MAKEHARDCOPYMODESTREAM 97565 . 100598) (UNMAKEHARDCOPYMODESTREAM 100600 . 102361) (\BLTSHADE.HCPYMODE -102363 . 103029) (\BITBLT.HCPYMODE 103031 . 103779) (\BRUSHCONVERT.HCPYMODE 103781 . 104330) ( -\CHANGECHARSET.HCPYMODE 104332 . 107427) (\DASHINGCONVERT.HCPYMODE 107429 . 107770) ( -\CHARWIDTH.HCPYMODE 107772 . 108209) (\DRAWLINE.HCPYMODE 108211 . 108740) (\DRAWCURVE.HCPYMODE 108742 - . 109329) (\DRAWCIRCLE.HCPYMODE 109331 . 109816) (\DRAWELLIPSE.HCPYMODE 109818 . 110502) ( -\DSPFONT.HCPYMODE 110504 . 113188) (\DSPLEFTMARGIN.HCPYMODE 113190 . 113932) (\DSPLINEFEED.HCPYMODE -113934 . 114567) (\DSPRIGHTMARGIN.HCPYMODE 114569 . 115637) (\DSPSPACEFACTOR.HCPYMODE 115639 . 116414) - (\DSPXPOSITION.HCPYMODE 116416 . 117434) (\DSPYPOSITION.HCPYMODE 117436 . 118086) (\MOVETO.HCPYMODE -118088 . 118302) (\FONTCREATE.HCPYMODE.PRESS 118304 . 120441) (\CREATECHARSET.HCPYMODE.PRESS 120443 . -122065) (\FONTCREATE.HCPYMODE.INTERPRESS 122067 . 124141) (\CREATECHARSET.HCPYMODE.INTERPRESS 124143 - . 125665) (\STRINGWIDTH.HCPYMODE 125667 . 126374) (\HCPYMODEBLTCHAR 126376 . 132126) ( -\HCPYMODEDISPLAYINIT 132128 . 140260) (\HCPYMODEDSPPRINTCHAR 140262 . 146196) (\SLOWHCPYMODEBLTCHAR -146198 . 152715) (\SFFixY.HCPYMODE 152717 . 156211))))) + (FILEMAP (NIL (6508 12346 (HARDCOPY.SOMEHOW 6518 . 7884) (HARDCOPYIMAGEW 7886 . 8107) ( +HARDCOPYIMAGEW.TOFILE 8109 . 8417) (HARDCOPYIMAGEW.TOPRINTER 8419 . 9666) (HARDCOPYREGION.TOFILE 9668 + . 10210) (HARDCOPYREGION.TOPRINTER 10212 . 11325) (COPY.WINDOW.TO.BITMAP 11327 . 12344)) (12418 24340 + (MakeMenuOfPrinters 12428 . 13960) (PRINTERS.WHENSELECTEDFN 13962 . 15585) (MakeMenuOfImageTypes +15587 . 16406) (GetNewPrinterFromUser 16408 . 16850) (PopUpWindowAndGetAtom 16852 . 18303) ( +PopUpWindowAndGetList 18305 . 19875) (NewPrinter 19877 . 21376) (GetPrinterName 21378 . 21666) ( +GetImageFile 21668 . 24088) (FetchDefaultPrinter 24090 . 24338)) (24375 25249 ( +EXTENSIONS.FOR.PRINTFILETYPE 24385 . 24741) (PRINTFILETYPE.FROM.EXTENSION 24743 . 25247)) (25304 45688 + (DEFAULTPRINTER 25314 . 25554) (CAN.PRINT.DIRECTLY 25556 . 25752) (CONVERT.FILE.TO.TYPE.FOR.PRINTER +25754 . 27491) (EMPRESS 27493 . 28068) (HARDCOPYW 28070 . 33072) (LISTFILES1 33074 . 33251) ( +PRINTER.BITMAPFILE 33253 . 33642) (PRINTER.BITMAPSCALE 33644 . 34128) (PRINTER.SCRATCH.FILE 34130 . +34300) (PRINTERPROP 34302 . 34552) (PRINTERSTATUS 34554 . 34829) (PRINTERTYPE 34831 . 37401) ( +PRINTERNAME 37403 . 37824) (PRINTFILEPROP 37826 . 38082) (PRINTFILETYPE 38084 . 40040) ( +\EXPECTED.FILE.TYPE 40042 . 40832) (SEND.FILE.TO.PRINTER 40834 . 45686)) (45689 50126 (PRINTERDEVICE +45699 . 46676) (PRINTERDEVICE.OPENFN 46678 . 47398) (PRINTERDEVICE.CLOSEFN 47400 . 50124)) (50482 +51040 (SCALEREGION 50492 . 51038)) (51264 59509 (TEXTTOIMAGEFILE 51274 . 53470) (COPY.TEXT.TO.IMAGE +53472 . 59507)) (59571 61314 (\BLTSHADE.GENERICPRINTER 59581 . 61312)) (61381 98547 ( +MAKEHARDCOPYSTREAM 61391 . 63107) (UNMAKEHARDCOPYSTREAM 63109 . 64039) (HARDCOPYSTREAMTYPE 64041 . +64448) (\CHARWIDTH.HDCPYDISPLAY 64450 . 65270) (\DSPFONT.HDCPYDISPLAY 65272 . 68067) ( +\DSPRIGHTMARGIN.HDCPYDISPLAY 68069 . 68924) (\DSPXPOSITION.HDCPYDISPLAY 68926 . 69301) ( +\DSPYPOSITION.HDCPYDISPLAY 69303 . 69678) (\STRINGWIDTH.HDCPYDISPLAY 69680 . 70635) ( +\STRINGWIDTH.HCPYDISPLAYAUX 70637 . 75977) (\HDCPYBLTCHAR 75979 . 80876) (\HDCPYDISPLAY.FIX.XPOS 80878 + . 81635) (\HDCPYDISPLAY.FIX.YPOS 81637 . 82378) (\HDCPYDISPLAYINIT 82380 . 84070) (\HDCPYDSPPRINTCHAR + 84072 . 89985) (\SLOWHDCPYBLTCHAR 89987 . 96603) (\CHANGECHARSET.HDCPYDISPLAY 96605 . 98545)) (98862 +148413 (MAKEHARDCOPYMODESTREAM 98872 . 101593) (UNMAKEHARDCOPYMODESTREAM 101595 . 103185) ( +\HCPYDISPLAYIMAGEOPS 103187 . 106007) (\BLTSHADE.HCPYMODE 106009 . 106675) (\BITBLT.HCPYMODE 106677 . +107425) (\BRUSHCONVERT.HCPYMODE 107427 . 107976) (\CHANGECHARSET.HCPYMODE 107978 . 111240) ( +\DASHINGCONVERT.HCPYMODE 111242 . 111583) (\CHARWIDTH.HCPYMODE 111585 . 112022) (\DRAWLINE.HCPYMODE +112024 . 112553) (\DRAWCURVE.HCPYMODE 112555 . 113142) (\DRAWCIRCLE.HCPYMODE 113144 . 113629) ( +\DRAWELLIPSE.HCPYMODE 113631 . 114315) (\DSPFONT.HCPYMODE 114317 . 117001) (\DSPLEFTMARGIN.HCPYMODE +117003 . 117745) (\DSPLINEFEED.HCPYMODE 117747 . 118380) (\DSPRIGHTMARGIN.HCPYMODE 118382 . 119450) ( +\DSPSPACEFACTOR.HCPYMODE 119452 . 120227) (\DSPXPOSITION.HCPYMODE 120229 . 121247) ( +\DSPYPOSITION.HCPYMODE 121249 . 121899) (\MOVETO.HCPYMODE 121901 . 122115) (\FONTCREATE.HCPYMODE +122117 . 124074) (\CREATECHARSET.HCPYMODE 124076 . 125799) (\STRINGWIDTH.HCPYMODE 125801 . 126596) ( +\HCPYMODEBLTCHAR 126598 . 132348) (\HCPYMODEDSPPRINTCHAR 132350 . 138284) (\SLOWHCPYMODEBLTCHAR 138286 + . 144915) (\SFFixY.HCPYMODE 144917 . 148411))))) STOP diff --git a/sources/HARDCOPY.LCOM b/sources/HARDCOPY.LCOM index f8dc7103c47295686215d4e7c9edeeada82bdc8d..6880c316f28f9980748332658a8a668641662961 100644 GIT binary patch delta 9530 zcmeHNdu&_Rc_*odZOW!anwDuzZb0(YTE*iwT@1Xo+S)AhvU%Z5<|OMd8jJ(6v}6Zz+nb z!@TdDd-;^wAwd6Y42buhbH4NVUcc}A&h^vp>%RCC-Lu*4JijMBb#{-y32wxD2RYxM z(``jI>+v%WpFKG zL`F)5r7<}qIdD=+L=x!aX=IIz#$u>`9f!kVMUzL*!)7aP;J4cKwrvqPCWTUxn32M$ z@fgafUG$V|TwcVxd~T1QoX{fAN@uX6!DI>!g-6qS!mwJ?V#1({?AKa#E)RKD*F}D* zoz}Ts!hp4&3OY4Y2crp{=7C&*LW+in)bEmblTTfvDY=U zO`h(NJ3Ks!ONmi9sh`~L*{X91MBBT`>J(6NG?SGRVVq5-a1w;%MR+trIfn-4Mda$0 zF5d4!(s)Knq-C5)J0dvcU~E#V%tTT`e!e1m*7R}YXzwT13my~|Q{fO!PEbm+sxPN= zddXDZH{tI6k1bZa{` zHo=S1VmggOz^eKNsucJd1IUHQ2U|B3BU^v9N#_xY2fg2GBhLgbaLw5XR=FbDnvZn9C`!nR31Kr(YQDv@9Ir=M= z=Inm*odez5=C+=pj0}&QT4WsM{(`>7PTgXy(uNb{*9UwXy(kyLDM{4>m<(uuBliY2 z_95QqMmaGFE*%!2!PPZ9JbB{a1+A0(=fNWdH?l<~F)SyBP{xjUk005>5?HCknob|G zg5&do3t9gNTs$2TV^T^Q0<%_hCWFq@Hnl)D4kow*&aMlH+Mi7?21K3us6N@tiEjAU zxmuHuV|w^2-Y1?j>9TEPHr*qNcc^O1ee&&vvgY-zs%)SsD+X+AX&oL}h?zB|n8{Rb z6=&}K>%zQd#<)1s|IeU$w})JuaF|?f6v2s1SW1Udax#Nch+LcKCWkV;oPcCR-4)?j zI4g%UQE2&57Jhvwl$H|_46k57lwEjpk}qX!g>}G_I62pKVsf%hyX)GhqKw;gs;5Ok z#XnRHgEMMdMwp%zJ7umIRR+J?dil+Xa^JARqO4d0G>2tIWo&7W#TOF5V!~v!>PM!d z1x7Nj$A*7m#&pZvRl){lCTzwRaHq0}W_En$-b~Blsl|U`gn3h`I+Qn;*bHp=dEQW( zxi@Xpt;H7H^^B; zF!F(2#bP)VgufBQyPZfn1cI#+a4zz}D316*tN?9kDZ^yT1G+Y}DS$Mp%I|FM@jA(K zW1%g)--n!Thv4%Q@dkGN=PX=gxrE+GRt-alksU?NKr^NoQaQtnROab3M~y$k^Y?FeMP2%pS-F$dCVE zkM-(iU0vt&(pQ-sU7T;p`$|oHWlest zgnbX+Tg1XlE3@Inya%WVf4_O~J{ZEDyMU#a@qI7iLF@y&{0x1*op;^A14~6ecHPMj zFm?vmQTo+${^9-o1sAC4`OxfEY{M=E9)f=fZ`P%+Vi(@N^gQ1Asp-WZD(=mw=Br{9lu>=08aabgdRuzM1t@t~AKP9KkQLsBLvLJXA00VTkyD}-^{ zi=3`n4~|5@{E+~uLDL3;&}=9G;~pBlz)Yz#`N+u!wm#tUEWY zL7I^W0@qBzLl)U+gFuDI`s-WTM2_QK#Wx@LT1)3Hh`W{e#u<%Ta`sqP>x6kwEB_t^Uo5jUs8hlIcYK0gEwj-7~W3WvwubuBW zJUI=Xrk#?@8so>;CFF8v6s&SFZ;;EDyK~($>qKV8B^ZC8HdvCefdaV-@~w;CmglXL ziMwAZCGwpmdA`4Z4b`!?CP(f*R~iA(mdgX+tpLlNG;R0=HqWn_UIKsk3GU1T^h5ux zyalLC^bELjF>x#34b9c_ZIh>#isIx<>(boj67ITvo041LVJYEmcy!NhpIN;$*G-4m zm=^{sqcHp#mJ64RXnl6~+@7rCwY4V{zOvj>zHe^J5gPI4HTfRWdt_Td=y^e8PF{lG z(REWtAC{Y|>7)B*J3OW@lyKjdl{MK^+yilC!-ngc1tVvY%ep**V>3yDKZ2YCcfOS? z_r(>Tj;ZJpza5XMk#Qs5iERsb0Az{>3a0$_((vTW;ib8KB@rWRT~u^{x0lQmrb@m#R4jmzzLds04zwU z6l5E2FNcC7U{JwW1_F$aTpRD|L~hPs>xByD>iDKj$R#X?9S=tqW;QX?%-{@8X2WU7 zT-_*~PExOs6Jmy@VFJX%IzxxL1o}MQWn>U3(@{Jc3n$<(;0dq{3oxP7-dF^pkPG~{ z2^O3l5Ax=uxTDc!og8?JdLY3E*tLv8@cPNK9p;_DYL3p0i4#!9i3s4Tz74yAkUZp_ zhrg{YkxQo!u2NGy^3Lgk)yu0%2E@XKBm)40CK)hs>P%*`_J0lOwWoV7`0lN zY5Z@fD|}N{96+%gCD~Ah%?|SJ*-sZ-992g;DTbto7^0b|;B?Y1hGB6rH6(-5Xc9!T zDghXTu~1A-0#FXA>9qh-Z<;|pD-|QF@~SOX3F~dV zkMXv?Ud+6kC)dtd*11@Oh5C>MSm?=uN|be>-r=j2IOB#@>9o3634GqF`2aBri3#RQ z)Sv~JTg^|w53S_q=Qg)N?KGMo2a21>z*z%%=@FCm1@eVMygc`yVlE69&5n{%Cn!~H zNf~06Xx`b-vX!QlN~roIyUzEIGj1E0b+WD|Q{n+_8dS@O>THDbQH|7WgtVoOjPMXY zo6L(s4|FLw0{J}x3#>@U)imVwSB5+u5`Q#kS;1l;|A0c>_`*8_&8Aen603O=&F)yr6O7Y@2Z~lG;aSz{t`)E@^25ja z3x0qlU7$P=D6fV4AgHQE7FerQwRl^sRMjo=@WKd0)e(~ksF_gM4-?&om~8A{ZR}hV zh?h0y&fXF{b!HQNw3@k6Kr|mH#mntbe#WqYTzR~^kWdt&VS6c!d3}AOqrRb6DLNL} z6#~6RfJ!(pzbihkUwSbxABfL)EWHwlD`-4x#|DV~hItS{@Vy1dx0HkecmDm&Hs!ql z$~dgdgNiTh9RfFrbobvhB2r_ zDthD_)z3pY#401uBj?%Pqz>d=UJCljcb?izzV~N4h~cw=LUkj!`%=sRUTSg#nY{si z-qI{HxI$*22`LX?N3an)g13Ve?5N$y8MRO>sg%~r#a2*vJ4pWfv%bUF%)C9W_kcBwV1q3egR(@zV)Yj4>#R6fj%3g4x;{KYfD`h z4fy?^M80OLr};^v9~66^yVOG7Jh!&^(B!zT_}-TTx{s>kkE-L}!|GW4s5*uVt>1NZ zTzvm)c^&!j^)174A{2%DJr`$3wqyokAKVW@k5_q}2M%D192&(LnPv(4N;e~{ z%^}7)bHN7Dww|~`3rh%gJFF?!^)TY)!GSJn%~>ldl*fdq%!RU@NoH4qkR98~t9 zr=&CV$|^}Zg{R!nw<^E3DtmRC)n?EI)NBCmK!J;u$brFDyIqe+>XqTH$~RY*ePa~S2erE^)okPE)245x>Q_lpoZCr0 z_-0>+oRBkciIE1uk)<1E@+YtMtV)I>R1oC)tJ}4D@{g~&Nyk;kUS*-mSLigQh$Pa= zXD;QM0eV6>4ogvX$=Frb5q$=}WUB&A!i|Y~9bseN#?(f=0$~AG$*V)WgGZbLqO#Wk z5#0}OU|X=uPz(pf7#y1Tj_|9Lgt{^6Us(-T}1Wx0z;$PfvfB(9qWjwiBtl)bmKr9wfckPXt$ZPywTqRKt;GWj>Lag L&_e$&f&Tvh-wP8Z delta 10413 zcmeG?YfxKPdb$^|9bpp$GS~$0vG4=22H%IS9@vX@k*=%@SGuwu#t>4O0Eqz^Y>b`6 zUROz)*3&jGbGFTP+h)6Q)_FLd#U}ZYq#I>BX^XPsjMLqj;%#@Xt>0@0JLq}3WlU>@>@KCDj@aRZt^f9qR z>Uv~qdSYzy;dTSkb!_VR^zi7huAm(C`}9bE$1Z`hBU=eRu`?}sIz=83%n*dB?IUOm z@C6c@hKgr)badFz$j}U&XXOrL1Gmj?ZVjlK;)^PBT=63t?I*4; zP3b?qJAb;f&zbKLIK)d%m&=6@GRQUPk3|A{INlNTMfyX!U$LXkNL1Oc>WNspA9e?F zNQKRLcc&zDa-OrNn#*~Q-Hf^NI=oldge|Pf3KAYg(Jj%7y5&W)Ts)PPSks+BG`3Mt_P;+;8*4vS(7B0w8qIe6J zWvWeKRWrBp+)8|o0y^M6Q2u+3P4kaz`e8jQit{no_bMu7j)P-TG_zfLS1V&Ot@6s< zKEJYV6``huF$E2L1y)p&fnc?%Rdk|Q9KIMLf5#%>LO+rdNtUFI_Ty&3g|y&G=1d zKaHQ>)6kFz8f#g4;HB5{-MQWP{XGrn%}rBeK~L|*BE84pn^mN(O8#n#bBn}gRsSAZAQG?fd=JBL<#!^#JfC29jAa#c~39`{<-(y4hL!tDzaY< z??rJt2%j6Z`V|lag?2?ZvVp!5nX;X>;d{S4yTc%e;6ec)5aK}=4H+wtiw6;3THLFl+pAN)FzFQ$eAIy5B| z^T{CNpcQyuqLrz{Clifn#^g0{27w!YpW`8CVHlON#1JHUC^(`q{9*YSdg!(i$nseJ z3gtb$S2ehTR%5ZPQO6CQE|^1qOSyl|T9*k;nbN>ly89o64G}QS#ZtFYWs4Jw|3K#@ zt1|hKWOathLFi}SN!=Q^ux8z=*Zj*o(yMgqRlOR17EGZ}>8dNHjBcIyLDD++<66C{ z#>&+K*#r^zq#lTZIEWwtnx^}@H^NUZ*hvpk_5ooWz$-d~7jW|Ndi=qDx9Sm)4~#@i ziBm#?NhuE!H-pi^PY-M|=apD+;0yO>djt<^qoUicDf<=^p9p?Awjs8*FC|<9{A( zsCDYqHg9XfX-*+%ctwwhj~S;o`9 z(URtX3A4VrO?s=&5glDHb-xHL+tRmmPT#ULt8aUJeDMcK8(^4NOgb*zI<4D44jmG| zf-gvPxzN_Fax^OUw-dL~9!`Y1l_*FG*s8rsyjvzV?LY*HqGx$xJAon*tWJKZ9teP# zLWr@F@krpYoUC2P6S)NQM%<)`hmxCW1P6z}9r)vNH*uJPfbjDJn;2pKm&x;GxNNv- zElZW|)A2=X=b`zJhKE+Ai;M~{p`fDf4aP(Ieh5&A3Zedp9wRLfeLWEOC89AsnurjH zfc$DKLcK6R;sgXI(i2gi(yh`ihw}EzgFvI=2H1@vs;0-gyU83^BZ?A?&~zeA36O?_ z!b;x(XgKiH*L${eXt01f0>Uf+#S4%`gu(=T{ph)K+O%LwZoorB zo6{YQe<)Mc%YezPxx$i%^~xIZsJpTX9^)r6dc!x2J?T%Jht+29_@G%E)@7-n?kg zT}Rnf<2lmEzyuvFn6FJN!VGA@f90ayypEn}E;z|lEnRlg)z|L2y7C&F^tQ#nJB436 zT(uDb10@;-OD{<-)ZGh`)2+pk#7p?<;reO^#G1=Mha?hUodYzb)EFbt;lb~l>rx`< z%wSxP>ybWx4D7B0L99-MUk%G~h&qwrb`^^+M7jWzoVQH_{}v1C3C$md!w86k{M4xX zqC2$!M027f;j<6c-Ya-0LW)jsxe2UHaJuo$$@N>wGSE>??uVp6M&P81`>+X;oFe|{ z#ZEjr^%V0C{&Z>&+YrRuk+cmQqv1RuoXojb!@F`oF7U1{9)El!zOKZbV*gP`Rk26p zMEpBP?YJqr8ei8D^G}$Gw0q^Ztdw_!c$RsP9WjE%Kg}4C1r@b9YYtchvvy=~a{5Ug zd>jxY7Lk2QK=u(oEr7KH5Va;DIl5N`vhul0fS<;X>((@oYQ+>DxKR{B^X}U=;hhu} zv4bjQAn&Ae4io^AM7AYy15II;+kn1kZ^?acKBA=Iy2Fi|_YJIf(Z$8b<{cb9JhNdP z#3IIWu(d7%*#cM0Lm=14Cp&6L2CqUAA(HW6=J>{K)G9+p7>kiyDYwS$Mn!P9G1YC% zaxKqty5N*#p(G-o9HufyBt-y>`B=wpPK5EXEub)F1g`kVeqB+ffL?Mf{Jy*^&-` z`DDG>HZL)KvJp_^+A=(Ic8?9JS9`$d_0#~2N;UnV8Bc!M?mG{WT~@3p+B9wKYH3+* zsb1sNvLzi`R=f z3+CcZWpT%BOb0uB2>*M!Dy=P;mtOELc(sMfrPsWgVTR|nhqER?>CJZk@G5x2UW!7m z`kN~i%kA%9DL+JFdCX$Y%C8VNVJTUY7i)HuAS~j&Y}T`bxUnC zF_s`T%Tb5ONrjF8Swe9}AV5xC+6P6WK@nIO(1@bsK_H?Ci9%Wd#V6`fG6>=;$9!an z_qa-icn@y`MlncUz(TFeH^3kmMjP}Qw1+0^h#00E6l6FDB!)+gRS^S^r2N$Rqfb0u z(fIonL@o`sau&WUmxZq#kT1{Rb!Y5M4|bhtVJ#{iISz|`anm>bA~jLeC{ zFP+&j|H+v%6{|X^S-^*$v8Ta|8mCf`h@yJj@N6m)5Ex?x(pLxs)dA7~zQ`d}>xZz7 zI3F<92`!$ZlO36^tYJ(Qq})NpYaN^!Dju8J6_9rh5_k`ls}!5Mg@61^1KSv!eRg{p z=oD^z_COjU>yqRMoOy}c0xpM*3E-dLm_&+b9gb%7%RLYk;t`4&$%EG{?elqo;GKEd zN$1i@h#-hWP_6?*O4dPnDlZT#WQ=$-8YzQ7Ks{omK!74p(&zb~R|A46m!!5pIpZtk zWu+^LOKABD0taqz?&NdZ@=W}*=e!X3=cfaor2JW-{om&w|r$`X!)eE_BufmUz?R3gVyJB~cFp|Ydk zp1)8t*Z+Z<73hCwU2CTmpMSc52N*|tKm zn{R{bbb!Gl>BqeVIwJ=Mb^Fb~w{gD%Vwt-T4V<$GG11*d!DB=8Q`j@Fo1#lZ_>(8B zWunu8H(#t5AtgqGq;?h83vs0AfCRQUvnU!8T^OC*ut6ljzmfMB4e}lwIcaSaA+Q^S zR}h*{jrugDXadLM^vU{00cy&F{;1rya)RI%G4say23o-*6Ernkv|fM=E63XoqEAi)s*e=k7FUlbtkR)C!U=*1+9UwcW#n=9(^pHytbwsSif zGv0Tu5l^1$vYHDY3(%MI@O=lu@1OHwR8z+w-0*T_m)VY5+t4m#dk9|KPYxX(MI&P) z@X^QgF&m5o!ZD=W?G-1_2Zx3y9vPY*LFD6) zp_#D<$5LZ6kCAP`)A;wG)_n;b-YJ7)*8pa8z|2y2ML*531DHey`{A`CYQ@a1TKx9; zrXn9nCYbS$&Tql&D-yZ)rCQwc%6(0AljUz0$Sj{8f-T5J&G@UYIMQ+Wm?4)_!z&*c z($pA~A~+E~VP`W8@eYF?A_G;5=WTr^*qp$9q|EpJj!C>i|wfNm{SEU6B-fX!9aw;__Yk`pJ zlVcGj3a_1b7rCig1Q8{G6v%=^CtL?WR6vdmPmhjHwjY^-uRM-*BE;_$=&{KG{fbYM zqsrD!&Hpm5kG#xGW*+gEHLvMU#-XQU+A#XIHEL6Fyl)nt+?)u zpQnui3^JGIuFLU2Zg`Lc2?mD?LxtdJMdo|QDds__k;02bT9a6wfn66H&4q{=3exrX z;6-cNd|T}fNGbdMhP=~2#3;FvSOjFWBxYzWoED<2JDi-(h7HZ7sY8JVX_A#MAJQNK zl@s!L&|Ptv?})5GCct<%gr)e@o@G1+qYFZ0CQ?Mi$E)eGA4G{tR4W*lI|Ws+8sw)5 zpSxIBWd>=1a-|ZbG{k>>(T@LPPTG2RgHvR0@Ru%m&4r8L$x8< Date: Fri, 12 Sep 2025 12:22:53 -0700 Subject: [PATCH 2/2] Use CLOSEF? instead of CLOSEF in COPYFILE resetsave --- sources/FILEIO | 79 ++++++++++++++++++++++---------------------- sources/FILEIO.LCOM | Bin 45945 -> 45873 bytes 2 files changed, 40 insertions(+), 39 deletions(-) diff --git a/sources/FILEIO b/sources/FILEIO index 189bad26a..2c5fb1ede 100644 --- a/sources/FILEIO +++ b/sources/FILEIO @@ -1,11 +1,10 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Sep-2025 20:49:24"  -{DSK}kaplan>Local>medley3.5>working-medley>sources>FILEIO.;140 166949 +(FILECREATED "12-Sep-2025 08:19:06" {WMEDLEY}FILEIO.;141 166968 :EDIT-BY rmk - :CHANGES-TO (FNS COPYCHARS) + :CHANGES-TO (FNS COPYFILE COPYCHARS) :PREVIOUS-DATE "24-Apr-2025 22:16:47" {DSK}kaplan>Local>medley3.5>working-medley>sources>FILEIO.;139) @@ -2287,6 +2286,8 @@ update the map") (COPYFILE [LAMBDA (FROMFILE TOFILE) + (* ;; "Edited 12-Sep-2025 08:18 by rmk") + (* ;; "Edited 18-Dec-2024 21:07 by rmk") (* ;; "Edited 8-Jul-2022 10:41 by rmk") @@ -2306,7 +2307,7 @@ update the map") `((SEQUENTIAL T) (DON'TCACHE T) (CREATIONDATE ,(GETFILEINFO FROMSTREAM 'CREATIONDATE] - '(AND RESETSTATE (SETQ OLDVALUE (CLOSEF OLDVALUE)) + '(AND RESETSTATE (SETQ OLDVALUE (CLOSEF? OLDVALUE)) (DELFILE OLDVALUE] (COPYBYTES FROMSTREAM TOSTREAM) (CLOSEF FROMSTREAM) @@ -3166,39 +3167,39 @@ update the map") (ADDTOVAR LAMA \IS.NOT.RANDACCESSP \ILLEGAL.DEVICEOP STREAMPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (27784 31900 (STREAMPROP 27794 . 28228) (GETSTREAMPROP 28230 . 28979) (PUTSTREAMPROP -28981 . 31748) (STREAMP 31750 . 31898)) (31943 35322 (\DEFPRINT.BY.NAME 31953 . 33105) ( -\STREAM.DEFPRINT 33107 . 35015) (\FDEV.DEFPRINT 35017 . 35320)) (35580 40621 (\GETACCESS 35590 . 36044 -) (\SETACCESS 36046 . 40619)) (60847 66816 (\DEFINEDEVICE 60857 . 63173) (\GETDEVICEFROMNAME 63175 . -63648) (\GETDEVICEFROMHOSTNAME 63650 . 64694) (\REMOVEDEVICE 64696 . 65819) (\REMOVEDEVICE.NAMES 65821 - . 66814)) (66856 94587 (\CLOSEFILE 66866 . 67691) (\DELETEFILE 67693 . 67987) (\DEVICEEVENT 67989 . -69759) (\GENERATEFILES 69761 . 70708) (\GENERATENEXTFILE 70710 . 71361) (\GENERATEFILEINFO 71363 . -71824) (\GETFILENAME 71826 . 72215) (\GENERIC.OUTFILEP 72217 . 72687) (\OPENFILE 72689 . 75267) ( -\DO.PARAMS.AT.OPEN 75269 . 79465) (\RENAMEFILE 79467 . 80423) (\REVALIDATEFILE 80425 . 83027) ( -\PAGED.REVALIDATEFILELST 83029 . 84587) (\PAGED.REVALIDATEFILES 84589 . 86308) (\PAGED.REVALIDATEFILE -86310 . 88593) (\BUFFERED.REVALIDATEFILE 88595 . 90881) (\BUFFERED.REVALIDATEFILELST 90883 . 92067) ( -\PRINT-REVALIDATION-RESULT 92069 . 92911) (\TRUNCATEFILE 92913 . 93304) (\FILE-CONFLICT 93306 . 94585) -) (94623 99286 (\GENERATENOFILES 94633 . 96729) (\NULLFILEGENERATOR 96731 . 96975) (\NOFILESNEXTFILEFN - 96977 . 98968) (\NOFILESINFOFN 98970 . 99284)) (99405 101313 (\FILE.NOT.OPEN 99415 . 99928) ( -\FILE.WONT.OPEN 99930 . 100258) (\ILLEGAL.DEVICEOP 100260 . 100542) (\IS.NOT.RANDACCESSP 100544 . -100990) (\STREAM.NOT.OPEN 100992 . 101311)) (101448 103746 (\FDEVINSTANCE 101458 . 103744)) (104948 -112322 (CNDIR 104958 . 106263) (DIRECTORYNAME 106265 . 110448) (DIRECTORYNAMEP 110450 . 111066) ( -HOSTNAMEP 111068 . 111875) (\ADD.CONNECTED.DIR 111877 . 112320)) (112367 141263 (\BACKFILEPTR 112377 - . 112565) (\BACKPEEKBIN 112567 . 112928) (\BACKBIN 112930 . 113281) (BIN 113283 . 113500) (\BIN -113502 . 113779) (\BINS 113781 . 114067) (BOUT 114069 . 114431) (\BOUT 114433 . 114748) (\BOUTS 114750 - . 115061) (COPYBYTES 115063 . 118395) (COPYCHARS 118397 . 122195) (COPYFILE 122197 . 123506) ( -\COPYOPENFILE 123508 . 126707) (\INFER.FILE.TYPE 126709 . 127663) (EOFP 127665 . 127962) (FORCEOUTPUT -127964 . 128211) (\FLUSH.OPEN.STREAMS 128213 . 128569) (CHARSET 128571 . 129930) (ACCESS-CHARSET -129932 . 130569) (GETEOFPTR 130571 . 130821) (GETFILEINFO 130823 . 134016) (\TYPE.FROM.FILETYPE 134018 - . 134488) (\FILETYPE.FROM.TYPE 134490 . 134669) (GETFILEPTR 134671 . 134923) (SETFILEINFO 134925 . -139162) (SETFILEPTR 139164 . 140883) (BOUT16 140885 . 141070) (BIN16 141072 . 141261)) (141366 148546 -(\GENERIC.BINS 141376 . 141656) (\GENERIC.BOUTS 141658 . 141923) (\GENERIC.RENAMEFILE 141925 . 144173) - (\GENERIC.OPENP 144175 . 145490) (\GENERIC.READP 145492 . 146644) (\GENERIC.CHARSET 146646 . 148544)) - (148547 148886 (\MAP-OPEN-STREAMS 148557 . 148884)) (150741 152821 (\EOF.ACTION 150751 . 151002) ( -\EOSERROR 151004 . 151197) (\GETEOFPTR 151199 . 151381) (\INCFILEPTR 151383 . 151733) (\PEEKBIN 151735 - . 151926) (\SETCLOSEDFILELENGTH 151928 . 152262) (\SETEOFPTR 152264 . 152452) (\SETFILEPTR 152454 . -152819)) (152822 153364 (\FIXPOUT 152832 . 153132) (\FIXPIN 153134 . 153362)) (153365 153931 (\BOUTEOL - 153375 . 153929)) (156827 166691 (\BUFFERED.BIN 156837 . 157689) (\BUFFERED.PEEKBIN 157691 . 158473) -(\BUFFERED.BOUT 158475 . 159335) (\BUFFERED.BINS 159337 . 163022) (\BUFFERED.BOUTS 163024 . 164825) ( -\BUFFERED.COPYBYTES 164827 . 166689))))) + (FILEMAP (NIL (27752 31868 (STREAMPROP 27762 . 28196) (GETSTREAMPROP 28198 . 28947) (PUTSTREAMPROP +28949 . 31716) (STREAMP 31718 . 31866)) (31911 35290 (\DEFPRINT.BY.NAME 31921 . 33073) ( +\STREAM.DEFPRINT 33075 . 34983) (\FDEV.DEFPRINT 34985 . 35288)) (35548 40589 (\GETACCESS 35558 . 36012 +) (\SETACCESS 36014 . 40587)) (60815 66784 (\DEFINEDEVICE 60825 . 63141) (\GETDEVICEFROMNAME 63143 . +63616) (\GETDEVICEFROMHOSTNAME 63618 . 64662) (\REMOVEDEVICE 64664 . 65787) (\REMOVEDEVICE.NAMES 65789 + . 66782)) (66824 94555 (\CLOSEFILE 66834 . 67659) (\DELETEFILE 67661 . 67955) (\DEVICEEVENT 67957 . +69727) (\GENERATEFILES 69729 . 70676) (\GENERATENEXTFILE 70678 . 71329) (\GENERATEFILEINFO 71331 . +71792) (\GETFILENAME 71794 . 72183) (\GENERIC.OUTFILEP 72185 . 72655) (\OPENFILE 72657 . 75235) ( +\DO.PARAMS.AT.OPEN 75237 . 79433) (\RENAMEFILE 79435 . 80391) (\REVALIDATEFILE 80393 . 82995) ( +\PAGED.REVALIDATEFILELST 82997 . 84555) (\PAGED.REVALIDATEFILES 84557 . 86276) (\PAGED.REVALIDATEFILE +86278 . 88561) (\BUFFERED.REVALIDATEFILE 88563 . 90849) (\BUFFERED.REVALIDATEFILELST 90851 . 92035) ( +\PRINT-REVALIDATION-RESULT 92037 . 92879) (\TRUNCATEFILE 92881 . 93272) (\FILE-CONFLICT 93274 . 94553) +) (94591 99254 (\GENERATENOFILES 94601 . 96697) (\NULLFILEGENERATOR 96699 . 96943) (\NOFILESNEXTFILEFN + 96945 . 98936) (\NOFILESINFOFN 98938 . 99252)) (99373 101281 (\FILE.NOT.OPEN 99383 . 99896) ( +\FILE.WONT.OPEN 99898 . 100226) (\ILLEGAL.DEVICEOP 100228 . 100510) (\IS.NOT.RANDACCESSP 100512 . +100958) (\STREAM.NOT.OPEN 100960 . 101279)) (101416 103714 (\FDEVINSTANCE 101426 . 103712)) (104916 +112290 (CNDIR 104926 . 106231) (DIRECTORYNAME 106233 . 110416) (DIRECTORYNAMEP 110418 . 111034) ( +HOSTNAMEP 111036 . 111843) (\ADD.CONNECTED.DIR 111845 . 112288)) (112335 141282 (\BACKFILEPTR 112345 + . 112533) (\BACKPEEKBIN 112535 . 112896) (\BACKBIN 112898 . 113249) (BIN 113251 . 113468) (\BIN +113470 . 113747) (\BINS 113749 . 114035) (BOUT 114037 . 114399) (\BOUT 114401 . 114716) (\BOUTS 114718 + . 115029) (COPYBYTES 115031 . 118363) (COPYCHARS 118365 . 122163) (COPYFILE 122165 . 123525) ( +\COPYOPENFILE 123527 . 126726) (\INFER.FILE.TYPE 126728 . 127682) (EOFP 127684 . 127981) (FORCEOUTPUT +127983 . 128230) (\FLUSH.OPEN.STREAMS 128232 . 128588) (CHARSET 128590 . 129949) (ACCESS-CHARSET +129951 . 130588) (GETEOFPTR 130590 . 130840) (GETFILEINFO 130842 . 134035) (\TYPE.FROM.FILETYPE 134037 + . 134507) (\FILETYPE.FROM.TYPE 134509 . 134688) (GETFILEPTR 134690 . 134942) (SETFILEINFO 134944 . +139181) (SETFILEPTR 139183 . 140902) (BOUT16 140904 . 141089) (BIN16 141091 . 141280)) (141385 148565 +(\GENERIC.BINS 141395 . 141675) (\GENERIC.BOUTS 141677 . 141942) (\GENERIC.RENAMEFILE 141944 . 144192) + (\GENERIC.OPENP 144194 . 145509) (\GENERIC.READP 145511 . 146663) (\GENERIC.CHARSET 146665 . 148563)) + (148566 148905 (\MAP-OPEN-STREAMS 148576 . 148903)) (150760 152840 (\EOF.ACTION 150770 . 151021) ( +\EOSERROR 151023 . 151216) (\GETEOFPTR 151218 . 151400) (\INCFILEPTR 151402 . 151752) (\PEEKBIN 151754 + . 151945) (\SETCLOSEDFILELENGTH 151947 . 152281) (\SETEOFPTR 152283 . 152471) (\SETFILEPTR 152473 . +152838)) (152841 153383 (\FIXPOUT 152851 . 153151) (\FIXPIN 153153 . 153381)) (153384 153950 (\BOUTEOL + 153394 . 153948)) (156846 166710 (\BUFFERED.BIN 156856 . 157708) (\BUFFERED.PEEKBIN 157710 . 158492) +(\BUFFERED.BOUT 158494 . 159354) (\BUFFERED.BINS 159356 . 163041) (\BUFFERED.BOUTS 163043 . 164844) ( +\BUFFERED.COPYBYTES 164846 . 166708))))) STOP diff --git a/sources/FILEIO.LCOM b/sources/FILEIO.LCOM index a50f65aa6267a3c82397078caae5adcd60b8b48a..2b24260f3601eb23b6008399cc25c6339808d601 100644 GIT binary patch delta 236 zcmezQjA`RDrU?--M!LbN1-eECMy3h|7FLFqRt9ED3K~ku`MCv|IjJcM`FRRT3f1Ah zt}Z^Vk+n9(`K3k4sl|3~o<6Rg{(9DiCWe{{TuO$92xAP*tV|88j180&Cf=1`0V$mL zOOcUlvNWT5B39e*nyz4IW@c$-pMR g;Orj|39@SQVaCs~jP{f7r^rw4sd3&ck&qY+0FV6g(Oq?q&$CXr+3YSc+C@3mcwNh~Q4~TU3a108bctLUECv{;=Lrp-2XqXr%7@C<` znpi4Wxw?3U=sHCz6y;_sSON9=xw{7IhWIORX}I|XZ?0ne96Nb>iu~r@_$9#r{5CZ&